Index: palm/trunk/SOURCE/Makefile
===================================================================
--- palm/trunk/SOURCE/Makefile	(revision 4901)
+++ palm/trunk/SOURCE/Makefile	(revision 1)
@@ -1,195 +1,54 @@
-#--------------------------------------------------------------------------------------------------#
-# This file is part of the PALM model system.
-#
-# 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-2021  Leibniz Universitaet Hannover
-#--------------------------------------------------------------------------------------------------#
-#
+#------------------------------------------------------------------------------!
 # WARNING: don't write filenames with extension .f90 in this header!!!!
 #
-# Current revisions:
-# ------------------
-#
+# Actual revisions:
+# -----------------
+# 
 #
 # Former revisions:
 # -----------------
-# $Id$
-# add dependency for init_3d_model
-#
-# 4828 2021-01-05 11:21:41Z Giersch
-# Add depedency for indoor model
-#
-# 4778 2020-11-09 13:40:05Z raasch
-# particle output routine and dependencies added
-#
-# 4750 2020-10-16 14:27:48Z suehring
-# Bugfix, missing dependency on indoor_model_mod added
-#
-# 4677 2020-09-14 07:55:28Z raasch
-# file re-formatted to follow the PALM coding standard
-#
-# 4655 2020-08-28 14:28:34Z pavelkrc
-# Bugfix: Add possibility to output surface data during spinup
-#
-# 4652 2020-08-27 08:51:55Z raasch
-# routine posix_calls_from_fortran merged into posix_interface_mod
-#
-# 4628 2020-07-29 07:23:03Z raasch
-# dependencies for particle data MPI-I/O added
-# 
-# 4564 2020-06-12 14:03:36Z raasch
-# Vertical nesting method of Huq et al. (2019) removed
-# 
-# 4534 2020-05-14 18:35:22Z raasch
-# shared_memory_io_mod included and respective dependencies added
-# 
-# 4525 2020-05-10 17:05:07Z raasch
-# dependency for salsa_mod updated
-# 
-# 4522 2020-05-06 14:17:05Z suehring
-# routine user_init_flight renamed to user_init_flight_mod
-# 
-# 4518 2020-05-04 15:44:28Z suehring
-# Remove dependency of read_restart_data_mod on diagnostic_output_quantities_mod
-# 
-# 4517 2020-05-03 14:29:30Z raasch
-# dependencies for MPI-IO added
-# 
-# 4513 2020-04-30 13:45:47Z raasch
-# dependencies from chemistry modules updated
-# 
-# 4508 2020-04-24 13:32:20Z raasch
-# dependencies for salsa_mod updated
-# 
-# 4495 2020-04-13 20:11:20Z raasch
-# added routines and dependencies for restart data with MPI-IO
-# 
-# 4493 2020-04-10 09:49:43Z pavelkrc
-# cpu measures in advec_ws added
-#
-# 4458 2020-03-11 15:37:31Z raasch
-# bugfix for r4457: missing dependency added
-#
-# 4457 2020-03-11 14:20:43Z raasch
-# exchange horiz has been modularized and exchange horiz 2d has been merged, dependencies updated
-# accordingly
-#
-# 4453 2020-03-11 08:10:13Z raasch
-# dependencies for exchange horiz modified
-#
-# 4434 2020-03-03 10:02:18Z oliver.maas
-# Added output control for wind turbine model
-#
-# 4414 2020-02-19 20:16:04Z suehring
-# Move dependencies for init grid from advection scheme and multigrid solver
-# to module_interface
-#
-# 4411 2020-02-18 14:28:02Z maronga
-# Added output routines for WTM
-#
-# 4400 2020-02-10 20:32:41Z suehring
-# Add dependency for data-output module
-#
-# 4392 2020-01-31 16:14:57Z pavelkrc
-# add dependency on fft for transpose
-#
-# 4347 2019-12-18 13:18:33Z suehring
-# add dependency to basic_constants_and_equations_mod for dynamics_mod
-#
-# 4331 2019-12-10 18:25:02Z suehring
-# Move diagnostic surface output to diagnostic_output_quantities
-#
-# 4309 2019-11-26 18:49:59Z suehring
-# Add dependency to parallel random generator for synthetic turbulence generator
-#
-# 4286 2019-10-30 16:01:14Z resler
-# delete boundary_conds, added missing dependencies
-#
-# 4270 2019-10-23 10:46:20Z monakurppa
-# - Implement offline nesting for salsa and add dependency of nesting_offl_mod
-#   on salsa_mod
-#   set-up in which self-nesting is applied for the flow but the offline nesting
-#   for salsa
-# - Add dependency on basic_constants_and_equations_mod for salsa_mod
-#
-# 4258 2019-10-07 13:29:08Z suehring
-# Add dependency of land-surface model on pmc_handle_communicator and cpu_log
-#
-# 4245 2019-09-30 08:40:37Z pavelkrc
-# Remove no longer needed dependencies on surface_mod
-#
-# 4227 2019-09-10 18:04:34Z gronemeier
-# Add palm_date_time_mod, remove date_and_time_mod
-#
-# 4223 2019-09-10 09:20:47Z gronemeier
-# Corrected "Former revisions" section
-#
-# 4174 2019-08-20 12:41:13Z gronemeier
-# bugfix: add missing dependencies for vdi_internal_controls
-#
-# 4173 2019-08-20 12:04:06Z gronemeier
-# add vdi_internal_controls
-#
-# 4168 2019-08-16 13:50:17Z suehring
-# Remove some dependencies on surface_mod that are no longer required without
-# get_topography_top_index functions
-#
-# 4167 2019-08-16 11:01:48Z suehring
-# Remove no longer needed dependencies on surface_mod
-#
-# 4127 2019-07-30 14:47:10Z suehring
-# Add dependency of data_output_3d on plant_canopy_model_mod
-# (merge from branch resler)
-#
-# 4106 2019-07-19 08:54:42Z gronemeier
-# Remove dependency on pmc_interface for boundary_conds
-#
-# 4070 2019-07-03 13:51:40Z gronemeier
-# Add new data output modules
-#
-# 4048 2019-06-21 21:00:21Z knoop
-# Moved turbulence_closure_mod calls into module_interface
-#
-# 4047 2019-06-21 18:58:09Z knoop
-# Introduction of the dynamics module and dissolution of swap_timelevel
-#
-# 4043 2019-06-18 16:59:00Z schwenkel
-# Delete droplet_interactions_ptq
-#
-# 4039 2019-06-18 10:32:41Z suehring
-# add dependency for diagnostic output quantities
-#
-# 4017 2019-06-06 12:16:46Z schwenkel
-# add dependency for init_pegrid
-#
-# 3994 2019-05-22 18:08:09Z suehring
-# new module for calculation and output of diagnostic quantities added
-#
-# 3988 2019-05-22 11:32:37Z kanani
-# Add dependencies for virtual_measurement_mod
-#
-# 3880 2019-04-08 21:43:02Z knoop
-# Add Netcdf data output for indoor model
-# Remove some dependencies
-#
-# 3744 2019-02-15 18:38:58Z suehring
-# Enable mesoscale offline nesting for chemistry variables as well as
-# initialization of chemistry via dynamic input file.
-#
-# 3727 2019-02-08 14:52:10Z gronemeier
-# surface_data_output_mod depends on netcdf_interface_mod
-#
-# 3700 2019-01-26 17:03:42Z knoop
-# Rename surface_output_mod into surface_data_output_mod
+# $Log: Makefile,v $
+# Revision 1.13  2006/08/04 14:45:31  raasch
+# +data_output_ptseries
+#
+# Revision 1.12  2006/04/26 15:10:49  raasch
+# modules.o added to dependencies of user_interface.o
+#
+# Revision 1.11  2006/02/23 13:17:11  raasch
+# +average_3d_data, data_log, sum_up_3d_data,
+# plot_.. renamed data_output_..
+#
+# Revision 1.10  2005/06/26 20:00:15  raasch
+# +interaction_droplets_ptq
+#
+# Revision 1.9  2005/05/18 14:52:20  raasch
+# +netcdf
+#
+# Revision 1.8  2004/04/30 13:15:46  raasch
+# dependencies for calc_spectra changed, +read_3d_binary,
+# leap_frog changed to time_integration, fft_for_1d_decomp to fft_xy,
+# init_pegrid and pres now depend on poisfft, all transpose routines joined
+# to one file transpose, local_getenv depends on modules
+#
+# Revision 1.7  2004/01/28 14:58:55  raasch
+# +timestep_scheme_steering
+#
+# Revision 1.6  2003/10/29 08:21:40  raasch
+# advec_particles, disturb_field, init_particles, init_3d_model, random_gauss
+# and write_3d_binary are using module random_function_mod
+#
+# Revision 1.5  2003/05/09 14:04:39  raasch
+# poisfft depends on fft_for_1d_decomp and no more on singleton,
+# init_pegrid depends on fft_for_1d_decomp, temperton_fft depends on modules
+#
+# Revision 1.4  2003/03/13 08:46:52  raasch
+# fft_for_1d_decomp has to depend on temperton_fft
+#
+# Revision 1.3  2003/03/12 15:57:37  raasch
+# modules and user_interface now depend on the f90 files, dependency of
+# singleton added, LDFLAGS moved to the end of PROG rule, +temperton_fft
+#
+# Revision 1.2  2003/01/06 08:48:19  raasch
+# +local_stop, check_cpu_time renamed to check_for_restart
 #
 # Revision 1.1  2002/06/11 13:42:20  raasch
@@ -205,161 +64,62 @@
 PROG =  palm
 
-SOURCES = \
-	advec_s_bc.f90 \
-	advec_s_pw.f90 \
-	advec_s_up.f90 \
-	advec_u_pw.f90 \
-	advec_u_up.f90 \
-	advec_v_pw.f90 \
-	advec_v_up.f90 \
-	advec_w_pw.f90 \
-	advec_ws.f90 \
-	advec_w_up.f90 \
-	average_3d_data.f90 \
-	basic_constants_and_equations_mod.f90 \
-	biometeorology_mod.f90 \
-	buoyancy.f90 \
-	calc_mean_profile.f90 \
-	check_for_restart.f90 \
-	check_open.f90 \
-	check_parameters.f90 \
-	chem_emissions_mod.f90 \
-	chem_gasphase_mod.f90 \
-	chemistry_model_mod.f90 \
-	chem_modules.f90 \
-	chem_photolysis_mod.f90 \
-	close_file.f90 \
-	compute_vpt.f90 \
-	coriolis.f90 \
-	cpulog_mod.f90 \
-	cuda_fft_interfaces.f90 \
-	data_log.f90 \
-	data_output_binary_module.f90 \
-	data_output_module.f90 \
-	data_output_netcdf4_module.f90 \
-	data_output_2d.f90 \
-	data_output_3d.f90 \
-	data_output_flight.f90\
-	data_output_mask.f90 \
-	data_output_particle_mod.f90 \
-	data_output_profiles.f90 \
-	data_output_spectra.f90 \
-	data_output_tseries.f90 \
-	diagnostic_output_quantities_mod.f90 \
-	diffusion_s.f90 \
-	diffusion_u.f90 \
-	diffusion_v.f90 \
-	diffusion_w.f90 \
-	disturb_field.f90 \
-	disturb_heatflux.f90 \
-	dynamics_mod.f90 \
-	exchange_horiz_mod.f90 \
-	fft_xy_mod.f90 \
-	flow_statistics.f90 \
-	global_min_max.f90 \
-	gust_mod.f90 \
-	header.f90 \
-	indoor_model_mod.f90 \
-	inflow_turbulence.f90 \
-	init_3d_model.f90 \
-	init_advec.f90 \
-	init_coupling.f90 \
-	init_grid.f90 \
-	init_masks.f90 \
-	init_pegrid.f90 \
-	init_pt_anomaly.f90 \
-	init_rankine.f90 \
-	init_slope.f90 \
-	init_vertical_profiles.f90 \
-	lagrangian_particle_model_mod.f90 \
-	land_surface_model_mod.f90 \
-	large_scale_forcing_nudging_mod.f90 \
-	local_stop.f90 \
-	local_system.f90 \
-	local_tremain.f90 \
-	local_tremain_ini.f90 \
-	message.f90 \
-	bulk_cloud_model_mod.f90 \
-	model_1d_mod.f90 \
-	module_interface.f90 \
-	mod_kinds.f90 \
-	mod_particle_attributes.f90 \
-	modules.f90 \
-	multi_agent_system_mod.f90 \
-	netcdf_data_input_mod.f90 \
-	netcdf_interface_mod.f90 \
-	nesting_offl_mod.f90 \
-	ocean_mod.f90 \
-	outflow_turbulence.f90 \
-	palm.f90 \
-	palm_date_time_mod.f90 \
-	parin.f90 \
-	plant_canopy_model_mod.f90 \
-	pmc_child_mod.f90 \
-	pmc_general_mod.f90 \
-	pmc_handle_communicator_mod.f90 \
-	pmc_interface_mod.f90 \
-	pmc_mpi_wrapper_mod.f90 \
-	pmc_parent_mod.f90 \
-	pmc_particle_interface.f90 \
-	poisfft_mod.f90 \
-	poismg_mod.f90 \
-	poismg_noopt_mod.f90 \
-	posix_interface_mod.f90 \
-	pres.f90 \
-	print_1d.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_restart_data_mod.f90 \
-	restart_data_mpi_io_mod.f90 \
-	run_control.f90 \
-	salsa_mod.f90 \
-	shared_memory_io_mod.f90 \
-	singleton_mod.f90 \
-	sor.f90 \
-	spectra_mod.f90 \
-	subsidence_mod.f90 \
-	sum_up_3d_data.f90 \
-	surface_coupler.f90 \
-	surface_layer_fluxes_mod.f90 \
-	surface_mod.f90 \
-	surface_data_output_mod.f90 \
-	synthetic_turbulence_generator_mod.f90 \
-	temperton_fft_mod.f90 \
-	time_integration.f90 \
-	time_integration_spinup.f90 \
-	timestep.f90 \
-	timestep_scheme_steering.f90 \
-	time_to_string.f90 \
-	transpose.f90 \
-	tridia_solver_mod.f90 \
-	turbulence_closure_mod.f90 \
-	urban_surface_mod.f90 \
-	user_data_output_mask.f90 \
-	user_flight.f90\
-	user_init_3d_model.f90 \
-	user_init_flight_mod.f90 \
-	user_init_grid.f90 \
-	user_init_land_surface.f90 \
-	user_init_plant_canopy.f90 \
-	user_init_radiation.f90 \
-	user_init_urban_surface.f90 \
-	user_lpm_advec.f90 \
-	user_lpm_init.f90 \
-	user_module.f90 \
-	user_spectra.f90 \
-	vdi_internal_controls.f90 \
-	virtual_flight_mod.f90 \
-	virtual_measurement_mod.f90 \
-	wind_turbine_model_mod.f90 \
-	wrd_write_string.f90 \
-	write_restart_data_mod.f90
-
-
-OBJS=$(SOURCES:.f90=.o)
+RCS = advec_particles.f90 advec_s_bc.f90 advec_s_pw.f90 advec_s_up.f90 \
+	advec_s_ups.f90 advec_u_pw.f90 advec_u_up.f90 advec_u_ups.f90 \
+	advec_v_pw.f90 advec_v_up.f90 advec_v_ups.f90 advec_w_pw.f90 \
+	advec_w_up.f90 advec_w_ups.f90 asselin_filter.f90 average_3d_data.f90 \
+	boundary_conds.f90 buoyancy.f90 calc_liquid_water_content.f90 \
+	calc_precipitation.f90 calc_radiation.f90 calc_spectra.f90 \
+	check_for_restart.f90 check_open.f90 check_parameters.f90 \
+	close_file.f90 compute_vpt.f90 coriolis.f90 cpu_log.f90 \
+	cpu_statistics.f90 data_log.f90 data_output_dvrp.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.f90 diffusion_s.f90 diffusion_u.f90 \
+	diffusion_v.f90 diffusion_w.f90 diffusivities.f90 disturb_field.f90 \
+	disturb_heatflux.f90 \exchange_horiz.f90 exchange_horiz_2d.f90 \
+	fft_xy.f90 flow_statistics.f90 global_min_max.f90 header.f90 \
+	impact_of_latent_heat.f90 init_1d_model.f90 init_3d_model.f90 \
+	init_advec.f90 init_cloud_physics.f90 init_dvrp.f90 init_grid.f90 \
+	init_particles.f90 init_pegrid.f90 init_pt_anomaly.f90 \
+	init_rankine.f90 init_slope.f90 interaction_droplets_ptq.f90 \
+	local_getenv.f90 local_stop.f90 local_system.f90 local_tremain.f90 \
+	local_tremain_ini.f90 modules.f90 netcdf.f90 package_parin.f90 \
+	palm.f90 parin.f90 poisfft.f90 poisfft_hybrid.f90 poismg.f90 \
+	prandtl_fluxes.f90 pres.f90 print_1d.f90 production_e.f90 \
+	prognostic_equations.f90 random_function.f90 random_gauss.f90 \
+	read_3d_binary.f90 read_var_list.f90 run_control.f90 singleton.f90 \
+	sor.f90 spline_x.f90 spline_y.f90 spline_z.f90 sum_up_3d_data.f90 \
+	swap_timelevel.f90 temperton_fft.f90 time_integration.f90 \
+	time_to_string.f90 timestep.f90 timestep_scheme_steering.f90 \
+	transpose.f90 user_interface.f90 write_3d_binary.f90 \
+	write_compressed.f90 write_var_list.f90
+
+OBJS =  advec_particles.o advec_s_bc.o advec_s_pw.o advec_s_up.o \
+	advec_s_ups.o advec_u_pw.o advec_u_up.o advec_u_ups.o \
+	advec_v_pw.o advec_v_up.o advec_v_ups.o advec_w_pw.o \
+	advec_w_up.o advec_w_ups.o asselin_filter.o average_3d_data.o \
+	boundary_conds.o buoyancy.o calc_liquid_water_content.o \
+	calc_precipitation.o calc_radiation.o calc_spectra.o \
+	check_for_restart.o check_open.o check_parameters.o close_file.o \
+	compute_vpt.o coriolis.o cpu_log.o cpu_statistics.o data_log.o \
+	data_output_dvrp.o data_output_profiles.o data_output_ptseries.o \
+	data_output_spectra.o data_output_tseries.o data_output_2d.o \
+	data_output_3d.o diffusion_e.o diffusion_s.o diffusion_u.o \
+	diffusion_v.o diffusion_w.o diffusivities.o disturb_field.o \
+	disturb_heatflux.o exchange_horiz.o exchange_horiz_2d.o fft_xy.o \
+	flow_statistics.o global_min_max.o header.o impact_of_latent_heat.o \
+	init_1d_model.o init_3d_model.o init_advec.o init_cloud_physics.o \
+	init_dvrp.o init_grid.o init_particles.o init_pegrid.o \
+	init_pt_anomaly.o init_rankine.o init_slope.o \
+	interaction_droplets_ptq.o local_getenv.o local_stop.o \
+	local_system.o local_tremain.o local_tremain_ini.o modules.o netcdf.o \
+	package_parin.o palm.o parin.o poisfft.o poisfft_hybrid.o poismg.o \
+	prandtl_fluxes.o pres.o print_1d.o production_e.o \
+	prognostic_equations.o random_function.o random_gauss.o \
+	read_3d_binary.o read_var_list.o run_control.o singleton.o sor.o \
+	spline_x.o spline_y.o spline_z.o sum_up_3d_data.o swap_timelevel.o \
+	temperton_fft.o time_integration.o time_to_string.o timestep.o \
+	timestep_scheme_steering.o transpose.o user_interface.o \
+	write_3d_binary.o write_compressed.o write_var_list.o
 
 CC = cc
@@ -371,10 +131,5 @@
 LDFLAGS =
 
-
-# The following line is needed for palm_simple_install, don't remove it!
-#to_be_replaced_by_include
-
-.SUFFIXES:
-.SUFFIXES: .o .f90
+.SUFFIXES: $(SUFFIXES) .f90
 
 
@@ -385,5 +140,5 @@
 
 clean:
-	rm -f $(PROG) $(OBJS) *.mod *.smod *.i *.lst
+	rm -f $(PROG) $(OBJS) *.mod *.i *.lst
 
 .f90.o:
@@ -391,1049 +146,111 @@
 
 
-advec_s_bc.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o
-advec_s_pw.o: \
-	mod_kinds.o \
-	modules.o
-advec_s_up.o: \
-	mod_kinds.o \
-	modules.o
-advec_u_pw.o: \
-	mod_kinds.o \
-	modules.o
-advec_u_up.o: \
-	mod_kinds.o \
-	modules.o
-advec_v_pw.o: \
-	mod_kinds.o \
-	modules.o
-advec_v_up.o: \
-	mod_kinds.o \
-	modules.o
-advec_ws.o: \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o
-advec_w_pw.o: \
-	mod_kinds.o \
-	modules.o
-advec_w_up.o: \
-	mod_kinds.o \
-	modules.o
-average_3d_data.o: \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	module_interface.o \
-	modules.o
-basic_constants_and_equations_mod.o: \
-	mod_kinds.o
-biometeorology_mod.o: \
-	basic_constants_and_equations_mod.o \
-	modules.o \
-	mod_kinds.o \
-	netcdf_data_input_mod.o \
-	palm_date_time_mod.o \
-	radiation_model_mod.o \
-	restart_data_mpi_io_mod.o
-bulk_cloud_model_mod.o: \
-	basic_constants_and_equations_mod.o \
-	cpulog_mod.o \
-	advec_ws.o \
-	advec_s_bc.o \
-	advec_s_pw.o \
-	advec_s_up.o \
-	diffusion_s.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o \
-	restart_data_mpi_io_mod.o \
-	surface_mod.o
-buoyancy.o: \
-	basic_constants_and_equations_mod.o \
-	mod_kinds.o \
-	modules.o
-calc_mean_profile.o: \
-	mod_kinds.o \
-	modules.o
-check_for_restart.o: \
-	mod_kinds.o \
-	modules.o \
-	pmc_interface_mod.o
-check_open.o: \
-	mod_kinds.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	posix_interface_mod.o
-check_parameters.o: \
-	basic_constants_and_equations_mod.o \
-	init_vertical_profiles.o \
-	model_1d_mod.o \
-	module_interface.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	netcdf_interface_mod.o \
-	pmc_interface_mod.o \
-	subsidence_mod.o
-chem_emissions_mod.o: \
-	chem_gasphase_mod.o \
-	chem_modules.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	palm_date_time_mod.o \
-	surface_mod.o
-chemistry_model_mod.o: \
-	advec_ws.o \
-	chem_emissions_mod.o \
-	chem_gasphase_mod.o \
-	chem_modules.o \
-	chem_photolysis_mod.o \
-	diffusion_s.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	palm_date_time_mod.o \
-	radiation_model_mod.o \
-	restart_data_mpi_io_mod.o \
-	surface_mod.o
-chem_gasphase_mod.o: \
-	mod_kinds.o \
-	modules.o
-chem_modules.o: \
-	mod_kinds.o \
-	modules.o
-chem_photolysis_mod.o: \
-	basic_constants_and_equations_mod.o \
-	chem_gasphase_mod.o \
-	chem_modules.o \
-	mod_kinds.o \
-	modules.o \
-	palm_date_time_mod.o \
-	radiation_model_mod.o
-close_file.o: \
-	mod_kinds.o \
-	modules.o \
-	netcdf_interface_mod.o
-compute_vpt.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	mod_kinds.o \
-	modules.o
-coriolis.o: \
-	mod_kinds.o \
-	modules.o
-cpulog_mod.o: \
-	mod_kinds.o \
-	modules.o
-cpu_statistics.o: \
-	mod_kinds.o \
-	modules.o
-cuda_fft_interfaces.o: \
-	modules.o \
-	mod_kinds.o
-data_log.o: \
-	mod_kinds.o \
-	modules.o
-data_output_binary_module.o: \
-	mod_kinds.o
-data_output_mask.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	chemistry_model_mod.o \
-	cpulog_mod.o \
-	diagnostic_output_quantities_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	mod_particle_attributes.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	salsa_mod.o
-data_output_module.o: \
-	data_output_binary_module.o \
-	data_output_netcdf4_module.o \
-	mod_kinds.o
-data_output_netcdf4_module.o: \
-	mod_kinds.o
-data_output_particle_mod.o: \
-	data_output_netcdf4_module.o \
-	modules.o \
-	mod_kinds.o \
-	mod_particle_attributes.o \
-	shared_memory_io_mod.o
-data_output_profiles.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_interface_mod.o
-data_output_spectra.o: \
-	basic_constants_and_equations_mod.o \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	spectra_mod.o
-data_output_tseries.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_interface_mod.o
-data_output_flight.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	virtual_flight_mod.o
-data_output_2d.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	land_surface_model_mod.o \
-	mod_kinds.o \
-	mod_particle_attributes.o \
-	module_interface.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	surface_mod.o \
-	urban_surface_mod.o
-data_output_3d.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	land_surface_model_mod.o \
-	mod_kinds.o \
-	mod_particle_attributes.o \
-	module_interface.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	plant_canopy_model_mod.o \
-	radiation_model_mod.o \
-	urban_surface_mod.o
-diagnostic_output_quantities_mod.o: \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o \
-	restart_data_mpi_io_mod.o \
-	surface_layer_fluxes_mod.o
-diffusion_s.o: \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o
-diffusion_u.o: \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o
-diffusion_v.o: \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o
-diffusion_w.o: \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o
-disturb_field.o: \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o \
-	random_function_mod.o \
-	random_generator_parallel_mod.o
-disturb_heatflux.o: \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o \
-	random_generator_parallel_mod.o \
-	surface_mod.o
-dynamics_mod.o: \
-	basic_constants_and_equations_mod.o \
-	mod_kinds.o \
-	surface_mod.o \
-	pmc_interface_mod.o \
-	modules.o
-exchange_horiz_mod.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o
-fft_xy_mod.o: \
-	cuda_fft_interfaces.o \
-	mod_kinds.o \
-	modules.o \
-	singleton_mod.o \
-	temperton_fft_mod.o
-flow_statistics.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	chem_modules.o \
-	cpulog_mod.o \
-	land_surface_model_mod.o \
-	large_scale_forcing_nudging_mod.o \
-	mod_kinds.o \
-	module_interface.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	radiation_model_mod.o \
-	surface_mod.o
-global_min_max.o: \
-	mod_kinds.o \
-	modules.o
-gust_mod.o: \
-	mod_kinds.o \
-	modules.o
-header.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	cpulog_mod.o \
-	model_1d_mod.o \
-	module_interface.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	ocean_mod.o \
-	palm_date_time_mod.o \
-	plant_canopy_model_mod.o \
-	pmc_handle_communicator_mod.o \
-	pmc_interface_mod.o \
-	subsidence_mod.o \
-	surface_mod.o
-indoor_model_mod.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	palm_date_time_mod.o \
-	surface_mod.o \
-	urban_surface_mod.o
-inflow_turbulence.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o
-init_3d_model.o: \
-	advec_ws.o \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	chem_modules.o \
-	cpulog_mod.o \
-	disturb_heatflux.o \
-	exchange_horiz_mod.o \
-	large_scale_forcing_nudging_mod.o \
-	model_1d_mod.o \
-	mod_kinds.o \
-	modules.o \
-	multi_agent_system_mod.o \
-	netcdf_data_input_mod.o \
-	netcdf_interface_mod.o \
-	nesting_offl_mod.o \
-	pmc_interface_mod.o \
-	radiation_model_mod.o \
-	random_function_mod.o \
-	random_generator_parallel_mod.o \
-	read_restart_data_mod.o \
-	palm_date_time_mod.o \
-	surface_layer_fluxes_mod.o \
-	surface_mod.o \
-	surface_data_output_mod.o \
-	synthetic_turbulence_generator_mod.o
-init_advec.o: \
-	mod_kinds.o \
-	modules.o
-init_coupling.o: \
-	mod_kinds.o \
-	modules.o
-init_grid.o: \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	netcdf_interface_mod.o
-init_masks.o: \
-	bulk_cloud_model_mod.o \
-	mod_kinds.o \
-	module_interface.o \
-	modules.o \
-	netcdf_interface_mod.o
-init_pegrid.o: \
-	mod_kinds.o \
-	modules.o \
-	pmc_interface_mod.o \
-	spectra_mod.o \
-	synthetic_turbulence_generator_mod.o
-init_pt_anomaly.o: \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o
-init_rankine.o: \
-	basic_constants_and_equations_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o
-init_slope.o: \
-	basic_constants_and_equations_mod.o \
-	mod_kinds.o \
-	modules.o
-init_vertical_profiles.o: \
-	modules.o \
-	mod_kinds.o
-lagrangian_particle_model_mod.o: \
-	basic_constants_and_equations_mod.o \
-	cpulog_mod.o \
-	data_output_particle_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	mod_particle_attributes.o \
-	modules.o \
-	pmc_interface_mod.o \
-	pmc_particle_interface.o \
-	netcdf_interface_mod.o \
-	random_function_mod.o \
-	random_generator_parallel_mod.o \
-	restart_data_mpi_io_mod.o \
-	surface_mod.o
-land_surface_model_mod.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	calc_mean_profile.o \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	pmc_handle_communicator_mod.o \
-	pmc_interface_mod.o \
-	radiation_model_mod.o \
-	surface_mod.o
-large_scale_forcing_nudging_mod.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o
-local_stop.o: \
-	mod_kinds.o \
-	modules.o \
-	pmc_interface_mod.o
-local_tremain.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o
-local_tremain_ini.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o
-message.o: \
-	mod_kinds.o \
-	modules.o \
-	pmc_interface_mod.o
-model_1d_mod.o: \
-	basic_constants_and_equations_mod.o \
-	mod_kinds.o \
-	modules.o \
-	time_to_string.o
-module_interface.o: \
-	mod_kinds.o \
-	modules.o \
-	biometeorology_mod.o \
-	bulk_cloud_model_mod.o \
-	chemistry_model_mod.o \
-	data_output_module.o \
-	diagnostic_output_quantities_mod.o \
-	dynamics_mod.o \
-	gust_mod.o \
-	indoor_model_mod.o \
-	lagrangian_particle_model_mod.o \
-	land_surface_model_mod.o \
-	large_scale_forcing_nudging_mod.o \
-	mod_particle_attributes.o \
-	multi_agent_system_mod.o \
-	nesting_offl_mod.o \
-	ocean_mod.o \
-	plant_canopy_model_mod.o \
-	poismg_noopt_mod.o \
-	radiation_model_mod.o \
-	salsa_mod.o \
-	spectra_mod.o \
-	surface_data_output_mod.o \
-	surface_mod.o \
-	synthetic_turbulence_generator_mod.o \
-	turbulence_closure_mod.o \
-	urban_surface_mod.o \
-	user_module.o \
-	vdi_internal_controls.o \
-	virtual_flight_mod.o \
-	virtual_measurement_mod.o \
-	wind_turbine_model_mod.o
-modules.o: \
-	mod_kinds.o
-multi_agent_system_mod.o: \
-	basic_constants_and_equations_mod.o \
-	biometeorology_mod.o \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	random_function_mod.o
-mod_kinds.o: \
-
-mod_particle_attributes.o: \
-	modules.o \
-	mod_kinds.o
-nesting_offl_mod.o: \
-	chem_modules.o \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	salsa_mod.o
-netcdf_data_input_mod.o: \
-	chem_modules.o \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o   \
-	surface_mod.o
-netcdf_interface_mod.o: \
-	basic_constants_and_equations_mod.o \
-	biometeorology_mod.o \
-	chemistry_model_mod.o \
-	diagnostic_output_quantities_mod.o \
-	gust_mod.o \
-	indoor_model_mod.o \
-	land_surface_model_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	ocean_mod.o \
-	palm_date_time_mod.o \
-	radiation_model_mod.o \
-	salsa_mod.o \
-	spectra_mod.o \
-	turbulence_closure_mod.o \
-	urban_surface_mod.o \
-	user_module.o
-ocean_mod.o: \
-	advec_s_pw.o \
-	advec_s_up.o \
-	advec_ws.o \
-	basic_constants_and_equations_mod.o \
-	diffusion_s.o \
-	init_vertical_profiles.o \
-	mod_kinds.o \
-	modules.o \
-	pmc_interface_mod.o \
-	restart_data_mpi_io_mod.o \
-	surface_mod.o
-outflow_turbulence.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o
-palm.o: \
-	bulk_cloud_model_mod.o \
-	cpulog_mod.o \
-	diagnostic_output_quantities_mod.o \
-	exchange_horiz_mod.o \
-	land_surface_model_mod.o \
-	mod_kinds.o \
-	module_interface.o \
-	modules.o \
-	multi_agent_system_mod.o \
-	netcdf_data_input_mod.o \
-	pmc_interface_mod.o \
-	pmc_particle_interface.o \
-	restart_data_mpi_io_mod.o \
-	surface_layer_fluxes_mod.o \
-	surface_data_output_mod.o \
-	time_to_string.o \
-	write_restart_data_mod.o
-palm_date_time_mod.o: \
-	mod_kinds.o \
-	modules.o
-parin.o: \
-	chem_modules.o \
-	cpulog_mod.o \
-	model_1d_mod.o \
-	mod_kinds.o \
-	module_interface.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	pmc_interface_mod.o \
-	progress_bar_mod.o \
-	read_restart_data_mod.o \
-	turbulence_closure_mod.o
-plant_canopy_model_mod.o: \
-	bulk_cloud_model_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	restart_data_mpi_io_mod.o \
-	surface_mod.o
-pmc_particle_interface.o: \
-	mod_particle_attributes.o \
-	modules.o \
-	pmc_child_mod.o \
-	pmc_interface_mod.o \
-	pmc_parent_mod.o
-pmc_interface_mod.o: \
-	bulk_cloud_model_mod.o \
-	chem_modules.o \
-	chemistry_model_mod.o \
-	chem_gasphase_mod.o \
-	mod_kinds.o \
-	mod_particle_attributes.o \
-	modules.o \
-	pmc_child_mod.o \
-	pmc_general_mod.o \
-	pmc_handle_communicator_mod.o \
-	pmc_mpi_wrapper_mod.o \
-	pmc_parent_mod.o \
-	salsa_mod.o \
-	surface_mod.o
-pmc_child_mod.o: \
-	mod_kinds.o \
-	pmc_general_mod.o \
-	pmc_handle_communicator_mod.o \
-	pmc_mpi_wrapper_mod.o
-pmc_general_mod.o: \
-	mod_kinds.o
-pmc_handle_communicator_mod.o: \
-	mod_kinds.o \
-	modules.o \
-	pmc_general_mod.o
-pmc_mpi_wrapper_mod.o: \
-	pmc_handle_communicator_mod.o
-pmc_parent_mod.o: \
-	pmc_general_mod.o \
-	pmc_handle_communicator_mod.o \
-	pmc_mpi_wrapper_mod.o
-poisfft_mod.o: \
-	cpulog_mod.o \
-	fft_xy_mod.o \
-	mod_kinds.o \
-	modules.o \
-	tridia_solver_mod.o
-poismg_mod.o: \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o
-poismg_noopt_mod.o: \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o
-posix_interface_mod.o: \
-	mod_kinds.o
-pres.o: \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o \
-	pmc_interface_mod.o \
-	poisfft_mod.o \
-	poismg_mod.o \
-	poismg_noopt_mod.o \
-	surface_mod.o
-print_1d.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o
-prognostic_equations.o: \
-	advec_s_bc.o \
-	advec_s_pw.o \
-	advec_s_up.o \
-	advec_u_pw.o \
-	advec_u_up.o \
-	advec_v_pw.o \
-	advec_v_up.o \
-	advec_w_pw.o \
-	advec_ws.o \
-	advec_w_up.o \
-	buoyancy.o \
-	coriolis.o \
-	cpulog_mod.o \
-	cpulog_mod.o \
-	diffusion_s.o \
-	diffusion_u.o \
-	diffusion_v.o \
-	diffusion_w.o \
-	large_scale_forcing_nudging_mod.o \
-	mod_kinds.o \
-	mod_kinds.o \
-	module_interface.o \
-	modules.o \
-	ocean_mod.o \
-	plant_canopy_model_mod.o \
-	radiation_model_mod.o \
-	subsidence_mod.o \
-	surface_mod.o \
-	surface_mod.o \
-	wind_turbine_model_mod.o
-progress_bar_mod.o: \
-	mod_kinds.o \
-	modules.o
-radiation_model_mod.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	calc_mean_profile.o \
-	exchange_horiz_mod.o \
-	mod_particle_attributes.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	palm_date_time_mod.o \
-	plant_canopy_model_mod.o \
-	restart_data_mpi_io_mod.o \
-	surface_mod.o
-random_function_mod.o: \
-	mod_kinds.o
-random_gauss.o: \
-	mod_kinds.o \
-	random_function_mod.o \
-	random_generator_parallel_mod.o
-random_generator_parallel_mod.o: \
-	mod_kinds.o \
-	modules.o \
-	posix_interface_mod.o
-read_restart_data_mod.o: \
-	bulk_cloud_model_mod.o \
-	chem_modules.o \
-	cpulog_mod.o \
-	gust_mod.o \
-	indoor_model_mod.o \
-	mod_kinds.o \
-	model_1d_mod.o \
-	module_interface.o \
-	modules.o \
-	mod_particle_attributes.o \
-	netcdf_interface_mod.o \
-	palm_date_time_mod.o \
-	radiation_model_mod.o \
-	random_function_mod.o\
-	random_generator_parallel_mod.o \
-	restart_data_mpi_io_mod.o \
-	spectra_mod.o \
-	surface_mod.o \
-	user_module.o \
-	virtual_measurement_mod.o
-restart_data_mpi_io_mod.o: \
-	exchange_horiz_mod.o \
-	modules.o \
-	mod_kinds.o \
-	mod_particle_attributes.o \
-	posix_interface_mod.o \
-	shared_memory_io_mod.o
-run_control.o: \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o
-salsa_mod.o: \
-	modules.o \
-	mod_kinds.o \
-	advec_ws.o \
-	advec_s_pw.o \
-	advec_s_up.o \
-	basic_constants_and_equations_mod.o \
-	chem_gasphase_mod.o \
-	chem_modules.o \
-	diffusion_s.o \
-	exchange_horiz_mod.o \
-	netcdf_data_input_mod.o \
-	palm_date_time_mod.o \
-	plant_canopy_model_mod.o \
-	restart_data_mpi_io_mod.o \
-	surface_mod.o \
-	netcdf_data_input_mod.o
-singleton_mod.o: \
-	mod_kinds.o
-shared_memory_io_mod.o: \
-	modules.o
-sor.o: \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o
-spectra_mod.o: \
-	cpulog_mod.o \
-	fft_xy_mod.o \
-	mod_kinds.o \
-	modules.o
-subsidence_mod.o: \
-	mod_kinds.o \
-	modules.o
-sum_up_3d_data.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	cpulog_mod.o \
-	mod_kinds.o \
-	module_interface.o \
-	modules.o \
-	surface_mod.o \
-	urban_surface_mod.o
-surface_coupler.o: \
-	basic_constants_and_equations_mod.o \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o
-surface_layer_fluxes_mod.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	chem_gasphase_mod.o \
-	chem_modules.o \
-	exchange_horiz_mod.o \
-	land_surface_model_mod.o \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o \
-	urban_surface_mod.o
-surface_mod.o: \
-	chem_gasphase_mod.o \
-	chem_modules.o \
-	model_1d_mod.o \
-	mod_kinds.o \
-	modules.o \
-	restart_data_mpi_io_mod.o
-surface_data_output_mod.o: \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	netcdf_interface_mod.o \
-	restart_data_mpi_io_mod.o \
-	surface_mod.o
-synthetic_turbulence_generator_mod.o: \
-	basic_constants_and_equations_mod.o \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	modules.o \
-	nesting_offl_mod.o \
-	pmc_interface_mod.o \
-	random_generator_parallel_mod.o \
-	restart_data_mpi_io_mod.o \
-	surface_mod.o
-temperton_fft_mod.o: \
-	mod_kinds.o \
-	modules.o
-time_integration.o: \
-	advec_ws.o \
-	biometeorology_mod.o \
-	bulk_cloud_model_mod.o \
-	buoyancy.o \
-	calc_mean_profile.o \
-	chem_emissions_mod.o \
-	chem_gasphase_mod.o \
-	chem_modules.o \
-	cpulog_mod.o \
-	data_output_flight.o \
-	diagnostic_output_quantities_mod.o \
-	disturb_heatflux.o \
-	exchange_horiz_mod.o \
-	indoor_model_mod.o \
-	lagrangian_particle_model_mod.o \
-	land_surface_model_mod.o \
-	large_scale_forcing_nudging_mod.o \
-	mod_kinds.o \
-	modules.o \
-	multi_agent_system_mod.o \
-	nesting_offl_mod.o \
-	ocean_mod.o \
-	palm_date_time_mod.o \
-	pmc_interface_mod.o \
-	prognostic_equations.o \
-	progress_bar_mod.o \
-	radiation_model_mod.o \
-	salsa_mod.o \
-	spectra_mod.o \
-	surface_layer_fluxes_mod.o \
-	surface_mod.o \
-	surface_data_output_mod.o \
-	synthetic_turbulence_generator_mod.o \
-	time_to_string.o \
-	turbulence_closure_mod.o\
-	urban_surface_mod.o \
-	virtual_flight_mod.o \
-	virtual_measurement_mod.o \
-	wind_turbine_model_mod.o
-time_integration_spinup.o: \
-	basic_constants_and_equations_mod.o \
-	cpulog_mod.o \
-	diagnostic_output_quantities_mod.o \
-	exchange_horiz_mod.o \
-	land_surface_model_mod.o \
-	indoor_model_mod.o \
-	mod_kinds.o \
-	modules.o \
-	palm_date_time_mod.o \
-	pmc_interface_mod.o \
-	radiation_model_mod.o \
-	surface_data_output_mod.o \
-	surface_layer_fluxes_mod.o \
-	time_to_string.o \
-	urban_surface_mod.o
-time_to_string.o: \
-	mod_kinds.o
-timestep.o: \
-	bulk_cloud_model_mod.o \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	pmc_interface_mod.o
-timestep_scheme_steering.o: \
-	mod_kinds.o \
-	modules.o
-transpose.o: \
-	cpulog_mod.o \
-	fft_xy_mod.o \
-	mod_kinds.o \
-	modules.o
-tridia_solver_mod.o: \
-	basic_constants_and_equations_mod.o \
-	mod_kinds.o \
-	modules.o
-turbulence_closure_mod.o: \
-	advec_s_bc.o \
-	advec_s_pw.o \
-	advec_s_up.o \
-	advec_ws.o \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	cpulog_mod.o \
-	exchange_horiz_mod.o \
-	mod_kinds.o \
-	mod_particle_attributes.o \
-	modules.o \
-	ocean_mod.o \
-	plant_canopy_model_mod.o \
-	pmc_interface_mod.o \
-	surface_layer_fluxes_mod.o \
-	surface_mod.o
-urban_surface_mod.o: \
-	basic_constants_and_equations_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	palm_date_time_mod.o \
-	radiation_model_mod.o \
-	restart_data_mpi_io_mod.o \
-	surface_mod.o
-user_data_output_mask.o: \
-	mod_kinds.o \
-	modules.o \
-	user_module.o
-user_flight.o: \
-	mod_kinds.o \
-	modules.o \
-	user_module.o
-user_init_3d_model.o: \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o \
-	user_module.o
-user_init_flight_mod.o: \
-	mod_kinds.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	user_module.o
-user_init_grid.o: \
-	mod_kinds.o \
-	modules.o \
-	user_module.o
-user_init_land_surface.o: \
-	land_surface_model_mod.o \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o
-user_init_plant_canopy.o: \
-	mod_kinds.o \
-	modules.o \
-	plant_canopy_model_mod.o \
-	user_module.o
-user_init_radiation.o: \
-	mod_kinds.o \
-	modules.o \
-	radiation_model_mod.o \
-	user_module.o
-user_init_urban_surface.o: \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o \
-	urban_surface_mod.o \
-	user_module.o
-user_lpm_advec.o: \
-	mod_kinds.o \
-	modules.o \
-	user_module.o
-user_lpm_init.o: \
-	mod_kinds.o \
-	modules.o \
-	user_module.o
-user_module.o: \
-	mod_kinds.o \
-	modules.o \
-	surface_mod.o
-user_spectra.o: \
-	mod_kinds.o \
-	modules.o \
-	spectra_mod.o \
-	user_module.o
-vdi_internal_controls.o: \
-	mod_kinds.o \
-	modules.o \
-	pmc_interface_mod.o
-virtual_flight_mod.o: \
-	basic_constants_and_equations_mod.o \
-	bulk_cloud_model_mod.o \
-	cpulog_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_interface_mod.o \
-	restart_data_mpi_io_mod.o \
-	user_flight.o \
-	user_init_flight_mod.o
-virtual_measurement_mod.o: \
-	basic_constants_and_equations_mod.o \
-	cpulog_mod.o \
-	chem_modules.o \
-	chem_gasphase_mod.o \
-	data_output_module.o \
-	land_surface_model_mod.o \
-	mod_kinds.o \
-	modules.o \
-	netcdf_data_input_mod.o \
-	radiation_model_mod.o \
-	surface_mod.o \
-	urban_surface_mod.o
-wind_turbine_model_mod.o: \
-	basic_constants_and_equations_mod.o \
-	cpulog_mod.o \
-	data_output_module.o \
-	exchange_horiz_mod.o \
-	netcdf_data_input_mod.o \
-	mod_kinds.o \
-	modules.o \
-	restart_data_mpi_io_mod.o
-wrd_write_string.o: \
-	mod_kinds.o
-write_restart_data_mod.o: \
-	bulk_cloud_model_mod.o \
-	gust_mod.o \
-	indoor_model_mod.o \
-	mod_kinds.o \
-	model_1d_mod.o \
-	module_interface.o \
-	modules.o \
-	mod_particle_attributes.o \
-	netcdf_interface_mod.o \
-	palm_date_time_mod.o \
-	radiation_model_mod.o \
-	random_function_mod.o \
-	random_generator_parallel_mod.o \
-	restart_data_mpi_io_mod.o \
-	spectra_mod.o \
-	surface_mod.o \
-	user_module.o \
-	virtual_measurement_mod.o
+
+advec_particles.o: modules.o random_function.o
+advec_s_bc.o: modules.o
+advec_s_pw.o: modules.o
+advec_s_up.o: modules.o
+advec_s_ups.o: modules.o
+advec_u_pw.o: modules.o
+advec_u_up.o: modules.o
+advec_u_ups.o: modules.o
+advec_v_pw.o: modules.o
+advec_v_up.o: modules.o
+advec_v_ups.o: modules.o
+advec_w_pw.o: modules.o
+advec_w_up.o: modules.o
+advec_w_ups.o: modules.o
+asselin_filter.o: modules.o
+average_3d_data.o: modules.o
+boundary_conds.o: modules.o
+buoyancy.o: modules.o
+calc_liquid_water_content.o: modules.o
+calc_precipitation.o: modules.o
+calc_radiation.o: modules.o
+calc_spectra.o: modules.o fft_xy.o
+check_for_restart.o: modules.o
+check_open.o: modules.o
+check_parameters.o: modules.o
+close_file.o: modules.o
+compute_vpt.o: modules.o
+coriolis.o: modules.o
+cpu_log.o: modules.o
+cpu_statistics.o: modules.o
+data_log.o: modules.o
+data_output_dvrp.o: modules.o
+data_output_profiles.o: modules.o
+data_output_ptseries.o: modules.o
+data_output_spectra.o: modules.o
+data_output_tseries.o: modules.o
+data_output_2d.o: modules.o
+data_output_3d.o: modules.o
+diffusion_e.o: modules.o
+diffusion_s.o: modules.o
+diffusion_u.o: modules.o
+diffusion_v.o: modules.o
+diffusion_w.o: modules.o
+diffusivities.o: modules.o
+disturb_field.o: modules.o random_function.o
+disturb_heatflux.o: modules.o
+exchange_horiz.o: modules.o
+exchange_horiz_2d.o: modules.o
+fft_xy.o: modules.o singleton.o temperton_fft.o
+flow_statistics.o: modules.o
+global_min_max.o: modules.o
+header.o: modules.o
+impact_of_latent_heat.o: modules.o
+init_1d_model.o: modules.o
+init_3d_model.o: modules.o random_function.o
+init_advec.o: modules.o
+init_cloud_physics.o: modules.o
+init_dvrp.o: modules.o
+init_grid.o: modules.o
+init_particles.o: modules.o random_function.o
+init_pegrid.o: modules.o fft_xy.o poisfft.o poisfft_hybrid.o
+init_pt_anomaly.o: modules.o
+init_rankine.o: modules.o
+init_slope.o: modules.o
+interaction_droplets_ptq.o: modules.o
+local_getenv.o: modules.o
+local_stop.o: modules.o
+local_tremain.o: modules.o
+local_tremain_ini.o: modules.o
+modules.o: modules.f90
+netcdf.o: modules.o
+package_parin.o: modules.o
+palm.o: modules.o
+parin.o: modules.o
+poisfft.o: modules.o fft_xy.o
+poisfft_hybrid.o: modules.o fft_xy.o
+poismg.o: modules.o
+prandtl_fluxes.o: modules.o
+pres.o: modules.o poisfft.o poisfft_hybrid.o
+print_1d.o: modules.o
+production_e.o: modules.o
+prognostic_equations.o: modules.o advec_s_pw.o advec_s_up.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  \
+	buoyancy.o calc_precipitation.o calc_radiation.o coriolis.o \
+	diffusion_e.o diffusion_s.o diffusion_u.o diffusion_v.o diffusion_w.o \
+	impact_of_latent_heat.o production_e.o user_interface.o
+random_gauss.o: random_function.o
+read_3d_binary.o: modules.o random_function.o
+read_var_list.o: modules.o
+run_control.o: modules.o
+singleton.o: singleton.f90
+sor.o: modules.o
+spline_x.o: modules.o
+spline_y.o: modules.o
+spline_z.o: modules.o
+sum_up_3d_data.o: modules.o
+swap_timelevel.o: modules.o
+temperton_fft.o: modules.o
+time_integration.o: modules.o prognostic_equations.o user_interface.o \
+	interaction_droplets_ptq.o
+timestep.o: modules.o
+timestep_scheme_steering.o: modules.o
+transpose.o: modules.o
+user_interface.o: modules.o user_interface.f90
+write_3d_binary.o: modules.o random_function.o
+write_compressed.o: modules.o
+write_var_list.o: modules.o
+
Index: palm/trunk/SOURCE/advec_particles.f90
===================================================================
--- palm/trunk/SOURCE/advec_particles.f90	(revision 1)
+++ palm/trunk/SOURCE/advec_particles.f90	(revision 1)
@@ -0,0 +1,3319 @@
+ SUBROUTINE advec_particles
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! TEST: PRINT statements on unit 9 (commented out)
+!
+! Former revisions:
+! -----------------
+! $Log: advec_particles.f90,v $
+! Revision 1.32  2007/02/11 12:48:20  raasch
+! Allways the lower level k is used for interpolation
+! Bugfix: new particles are released only if end_time_prel > simulated_time
+! Bugfix: transfer of particles when x < -0.5*dx (0.0 before), etc.,
+!         index i,j used instead of cartesian (x,y) coordinate to check for
+!         transfer because this failed under very rare conditions
+! Bugfix: calculation of number of particles with same radius as the current
+!         particle (cloud droplet code)
+!
+! Revision 1.31  2006/08/17 09:21:01  raasch
+! Two more compilation errors removed from the last revision
+!
+! Revision 1.30  2006/08/17 09:11:17  raasch
+! Two compilation errors removed from the last revision
+!
+! Revision 1.29  2006/08/04 14:05:01  raasch
+! Subgrid scale velocities are (optionally) included for calculating the
+! particle advection, new counters trlp_count_sum, etc. for accumulating
+! the number of particles exchanged between the subdomains during all
+! sub-timesteps (if sgs velocities are included), +3d-arrays de_dx/y/z,
+! izuf renamed iran, output of particle time series
+!
+! Revision 1.28  2006/02/23 09:41:21  raasch
+! Only a fraction of the particles may have tails, therefore output for unit
+! 85 and 90 has changed,
+! sorting of particles in gridbox order after each timestep, optimization of
+! the droplet growth by collision,
+! 0.5 replaced by 0.4999999999 in setting the random fluctuations,
+! psl, psr, pdx, etc. are now 1d arrays, i.e. they depend on the particle group,
+! improve particle release at PE boundaries, nt_anz renamed
+! current_timestep_number, idum (particle_type) renamed tail_id,
+! error number argument for handle_netcdf_error,
+!
+! Revision 1.27  2005/10/20 14:04:15  raasch
+! droplet growth by collision completed (still has to be optimized for speed),
+! new routine collision_efficiency (see end of this file),
+! 2*r replaced by r in the exponential terms (momentum equation for particles),
+! number of particles really used is additionally output on the netcdf particle
+! data file,
+! test print statement removed
+!
+! Revision 1.26  2005/06/26 19:50:14  raasch
+! Cloud droplet features added, radius is used instead of diameter,
+! particle type initial data assignment extended,
+! output on unit 80 for non-parallel runs
+!
+! Revision 1.25  2005/05/18 14:53:11  raasch
+! Extensions for NetCDF output
+!
+! Revision 1.24  2005/04/23 08:24:58  raasch
+! Revised calculation of output time counters regarding a possible decrease of
+! the output time interval in case of restart runs
+!
+! Revision 1.23  2005/03/26 14:20:05  raasch
+! calculation of vertical particle velocity (with inertia) corrected, exp_arg
+! had a wrong sign
+!
+! Revision 1.22  2004/04/30 07:48:57  raasch
+! Particle type initial data assignment extended
+!
+! Revision 1.21  2004/01/28 15:00:48  raasch
+! Output of particle infos in subroutine allocate_prt_memory on demand only
+!
+! Revision 1.20  2003/10/29 08:38:52  raasch
+! Module random_function_mod is used, modifications for new particle group
+! feature, version number is written on binary file
+!
+! Revision 1.19  2003/03/16 09:19:32  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.18  2003/03/14 13:36:31  raasch
+! Error in reflection boundary condition removed: particle speed must also
+! be inverted
+!
+! Revision 1.17  2003/03/04 11:23:20  raasch
+! Error in particle inertia part removed (exp_arg must not contain the timestep)
+! Particle velocities are also stored in particles in case of zero density ratio
+!
+! Revision 1.16  2002/09/12 12:55:29  raasch
+! Transport of particles with inertia implemented, write density_ratio to
+! restart file
+!
+! Revision 1.15  2002/06/11 12:11:56  raasch
+! Declaration of u_int_l, u_int_u, v_int_l, v_int_u added
+!
+! Revision 1.14  2002/05/02  18:46:34  18:46:34  raasch (Siegfried Raasch)
+! Horizontal velocity components for particle advection are now interpolated
+! between horizontal grid levels
+! 
+! Revision 1.13  2002/04/24  18:46:11  18:46:11  raasch (Siegfried Raasch)
+! Temporary particle-arrays trlp, trnp, trrp and trsp are now allocatable arrays
+! 
+! Revision 1.12  2002/04/16 07:44:07  raasch
+! Additional boundary conditions added, particle data for later analysis can be
+! written on file
+!
+! Revision 1.11  2001/11/09 13:38:20  raasch
+! Colour information for particle tails is stored in array
+! particle_tail_coordinates, adding information to the particle tails
+! moved after call of user_particle_attributes
+!
+! Revision 1.10  2001/08/21 08:19:48  raasch
+! Storage of particle tails, precision of vertical advection improved,
+! particle attributes (e.g. size and color) can be defined by the user
+!
+! Revision 1.9  2001/07/12 12:01:27  raasch
+! Random start positions of initial particles possible
+!
+! Revision 1.8  2001/03/29 17:27:10  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.7  2001/02/13 10:24:00  raasch
+! Particle advection possible in case of galilei transformation
+!
+! Revision 1.6  2001/01/25 06:51:04  raasch
+! Module test_variables removed, writing of particle informations is optional
+! now
+!
+! Revision 1.5  2001/01/02 17:15:29  raasch
+! Unit 80 is immediately closed after usage every time. Particle positions
+! are written on unit 90 instead of 81 (subroutine write_particles).
+!
+! Revision 1.4  2000/12/28 12:43:54  raasch
+! Packing of particles-array is done explicitly (not by PACK-function, which
+! seems to have problems when a large number of PEs is used)
+! Missing translations included,
+! code is used only optionally (cpp-directives are added)
+!
+! Revision 1.3  2000/01/20 08:51:37  letzel
+! All comments translated into English
+!
+! Revision 1.2  1999/11/25 16:41:48  raasch
+! Indexfehler im nichtparallelen Teil korrigiert
+!
+! Revision 1.1  1999/11/25 16:16:06  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Particle advection
+!------------------------------------------------------------------------------!
+#if defined( __particles )
+
+    USE arrays_3d
+    USE cloud_parameters
+    USE constants
+    USE control_parameters
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE netcdf_control
+    USE particle_attributes
+    USE pegrid
+    USE random_function_mod
+    USE statistics
+
+    IMPLICIT NONE
+
+    INTEGER ::  deleted_particles, deleted_tails, i, ie, ii, inc, is, j, jj,   &
+                js, k, kk, kw, m, n, nc, nn, psi, tlength, trlp_count,         &
+                trlp_count_sum, trlp_count_recv, trlp_count_recv_sum,          &
+                trlpt_count, trlpt_count_recv, trnp_count, trnp_count_sum,     &
+                trnp_count_recv, trnp_count_recv_sum, trnpt_count,             &
+                trnpt_count_recv, trrp_count, trrp_count_sum, trrp_count_recv, &
+                trrp_count_recv_sum, trrpt_count, trrpt_count_recv,            &
+                trsp_count, trsp_count_sum, trsp_count_recv,                   &
+                trsp_count_recv_sum, trspt_count, trspt_count_recv, nd
+
+    LOGICAL ::  dt_3d_reached, dt_3d_reached_l, prt_position
+
+    REAL    ::  aa, arg, bb, cc, dd, delta_r, dens_ratio, de_dx_int,           &
+                de_dx_int_l, de_dx_int_u, de_dy_int, de_dy_int_l, de_dy_int_u, &
+                de_dz_int, de_dz_int_l, de_dz_int_u, diss_int, diss_int_l,     &
+                diss_int_u, distance, dt_gap, dt_particle, d_radius, e_a,      &
+                e_int, e_int_l, e_int_u, e_mean_int, e_s, exp_arg, exp_term,   &
+                fs_int, gg, lagr_timescale, mean_r, new_r, p_int, pt_int,      &
+                pt_int_l, pt_int_u, q_int, q_int_l, q_int_u, ql_int, ql_int_l, &
+                ql_int_u, random_gauss, sl_r3, sl_r4, s_r3, s_r4, t_int,       &
+                u_int, u_int_l, u_int_u, vv_int, v_int, v_int_l, v_int_u,      &
+                w_int, w_int_l, w_int_u, x, y
+
+    REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ::  de_dx, de_dy, de_dz
+
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  trlpt, trnpt, trrpt, trspt
+
+    TYPE(particle_type) ::  tmp_particle
+
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trlp, trnp, trrp, trsp
+
+
+    CALL cpu_log( log_point(25), 'advec_particles', 'start' )
+
+!    IF ( number_of_particles /= number_of_tails )  THEN
+!       WRITE (9,*) '--- advec_particles: #1'
+!       WRITE (9,*) '    #of p=',number_of_particles,' #of t=',number_of_tails
+       CALL FLUSH_( 9 )
+!    ENDIF
+!
+!-- Write particle data on file for later analysis.
+!-- This has to be done here (before particles are advected) in order
+!-- to allow correct output in case of dt_write_particle_data = dt_prel =
+!-- particle_maximum_age. Otherwise (if output is done at the end of this
+!-- subroutine), the relevant particles would have been already deleted.
+!-- The MOD function allows for changes in the output interval with restart
+!-- runs.
+!-- Attention: change version number for unit 85 (in routine check_open)
+!--            whenever the output format for this unit is changed!
+    time_write_particle_data = time_write_particle_data + dt_3d
+    IF ( time_write_particle_data >= dt_write_particle_data )  THEN
+
+       CALL cpu_log( log_point_s(40), 'advec_part_io', 'start' )
+       CALL check_open( 85 )
+       WRITE ( 85 )  simulated_time, maximum_number_of_particles, &
+                     number_of_particles
+       WRITE ( 85 )  particles
+       WRITE ( 85 )  maximum_number_of_tailpoints, maximum_number_of_tails, &
+                     number_of_tails
+       WRITE ( 85 )  particle_tail_coordinates
+       CALL close_file( 85 )
+
+       IF ( netcdf_output )  CALL output_particles_netcdf
+
+       time_write_particle_data = MOD( time_write_particle_data, &
+                                  MAX( dt_write_particle_data, dt_3d ) )
+       CALL cpu_log( log_point_s(40), 'advec_part_io', 'stop' )
+    ENDIF
+
+!
+!-- Calculate exponential term used in case of particle inertia for each
+!-- of the particle groups
+    CALL cpu_log( log_point_s(41), 'advec_part_exp', 'start' )
+    DO  m = 1, number_of_particle_groups
+       IF ( particle_groups(m)%density_ratio /= 0.0 )  THEN
+          particle_groups(m)%exp_arg  =                                        &
+                    4.5 * particle_groups(m)%density_ratio *                   &
+                    molecular_viscosity / ( particle_groups(m)%radius )**2
+          particle_groups(m)%exp_term = EXP( -particle_groups(m)%exp_arg * &
+                                             dt_3d )
+       ENDIF
+    ENDDO
+    CALL cpu_log( log_point_s(41), 'advec_part_exp', 'stop' )
+
+!    WRITE ( 9, * ) '*** advec_particles: ##0.3'
+!    CALL FLUSH_( 9 )
+!    nd = 0
+!    DO  n = 1, number_of_particles
+!       IF ( .NOT. particle_mask(n) )  nd = nd + 1
+!    ENDDO
+!    IF ( nd /= deleted_particles ) THEN
+!       WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+!       CALL FLUSH_( 9 )
+!       CALL MPI_ABORT( comm2d, 9999, ierr )
+!    ENDIF
+
+!
+!-- Particle (droplet) growth by condensation/evaporation and collision
+    IF ( cloud_droplets )  THEN
+
+!
+!--    Reset summation arrays
+       ql_c = 0.0;  ql_v = 0.0;  ql_vp = 0.0
+
+!
+!--    Particle growth by condensation/evaporation
+       CALL cpu_log( log_point_s(42), 'advec_part_cond', 'start' )
+       DO  n = 1, number_of_particles
+!
+!--       Interpolate temperature and humidity.
+!--       First determine left, south, and bottom index of the arrays.
+          i = particles(n)%x * ddx
+          j = particles(n)%y * ddy
+          k = ( particles(n)%z + 0.5 * dz ) / dz  ! only exact if equidistant
+
+          x  = particles(n)%x - i * dx
+          y  = particles(n)%y - j * dy
+          aa = x**2          + y**2
+          bb = ( dx - x )**2 + y**2
+          cc = x**2          + ( dy - y )**2
+          dd = ( dx - x )**2 + ( dy - y )**2
+          gg = aa + bb + cc + dd
+
+          pt_int_l = ( ( gg - aa ) * pt(k,j,i)   + ( gg - bb ) * pt(k,j,i+1)   &
+                     + ( gg - cc ) * pt(k,j+1,i) + ( gg - dd ) * pt(k,j+1,i+1) &
+                     ) / ( 3.0 * gg )
+
+          pt_int_u = ( ( gg-aa ) * pt(k+1,j,i)   + ( gg-bb ) * pt(k+1,j,i+1)   &
+                     + ( gg-cc ) * pt(k+1,j+1,i) + ( gg-dd ) * pt(k+1,j+1,i+1) &
+                     ) / ( 3.0 * gg )
+
+          pt_int = pt_int_l + ( particles(n)%z - zu(k) ) / dz * &
+                              ( pt_int_u - pt_int_l )
+
+          q_int_l = ( ( gg - aa ) * q(k,j,i)   + ( gg - bb ) * q(k,j,i+1)   &
+                    + ( gg - cc ) * q(k,j+1,i) + ( gg - dd ) * q(k,j+1,i+1) &
+                    ) / ( 3.0 * gg )
+
+          q_int_u = ( ( gg-aa ) * q(k+1,j,i)   + ( gg-bb ) * q(k+1,j,i+1)   &
+                    + ( gg-cc ) * q(k+1,j+1,i) + ( gg-dd ) * q(k+1,j+1,i+1) &
+                    ) / ( 3.0 * gg )
+
+          q_int = q_int_l + ( particles(n)%z - zu(k) ) / dz * &
+                              ( q_int_u - q_int_l )
+
+          ql_int_l = ( ( gg - aa ) * ql(k,j,i)   + ( gg - bb ) * ql(k,j,i+1)   &
+                     + ( gg - cc ) * ql(k,j+1,i) + ( gg - dd ) * ql(k,j+1,i+1) &
+                     ) / ( 3.0 * gg )
+
+          ql_int_u = ( ( gg-aa ) * ql(k+1,j,i)   + ( gg-bb ) * ql(k+1,j,i+1)   &
+                     + ( gg-cc ) * ql(k+1,j+1,i) + ( gg-dd ) * ql(k+1,j+1,i+1) &
+                     ) / ( 3.0 * gg )
+
+          ql_int = ql_int_l + ( particles(n)%z - zu(k) ) / dz * &
+                                ( ql_int_u - ql_int_l )
+
+!
+!--       Calculate real temperature and saturation vapor pressure
+          p_int = hydro_press(k) + ( particles(n)%z - zu(k) ) / dz * &
+                                   ( hydro_press(k+1) - hydro_press(k) )
+          t_int = pt_int * ( p_int / 100000.0 )**0.286
+
+          e_s = 611.0 * EXP( l_d_rv * ( 3.6609E-3 - 1.0 / t_int ) )
+
+!
+!--       Current vapor pressure
+          e_a = q_int * p_int / ( 0.378 * q_int + 0.622 )
+
+!
+!--       Change in radius by condensation/evaporation
+!--       ATTENTION: this is only an approximation for large radii
+          arg = particles(n)%radius**2 + 2.0 * dt_3d *                     &
+                        ( e_a / e_s - 1.0 ) /                              &
+                        ( ( l_d_rv / t_int - 1.0 ) * l_v * rho_l / t_int / &
+                          thermal_conductivity_l +                         &
+                          rho_l * r_v * t_int / diff_coeff_l / e_s )
+          IF ( arg < 1.0E-14 )  THEN
+             new_r = 1.0E-7
+          ELSE
+             new_r = SQRT( arg )
+          ENDIF
+
+          delta_r = new_r - particles(n)%radius
+
+! NOTE: this is the correct formula (indipendent of radius).
+!       nevertheless, it give wrong results for large timesteps
+!          d_radius =  1.0 / particles(n)%radius
+!          delta_r = d_radius * ( e_a / e_s - 1.0 - 3.3E-7 / t_int * d_radius + &
+!                                 b_cond * d_radius**3 ) /                      &
+!                    ( ( l_d_rv / t_int - 1.0 ) * l_v * rho_l / t_int /         &
+!                      thermal_conductivity_l +                                 &
+!                      rho_l * r_v * t_int / diff_coeff_l / e_s ) * dt_3d
+
+!          new_r = particles(n)%radius + delta_r
+!          IF ( new_r < 1.0E-7 )  new_r = 1.0E-7
+
+!
+!--       Sum up the change in volume of liquid water for the respective grid
+!--       volume (this is needed later on for calculating the release of
+!--       latent heat)
+          i = ( particles(n)%x + 0.5 * dx ) * ddx
+          j = ( particles(n)%y + 0.5 * dy ) * ddy
+          k = particles(n)%z / dz + 1  ! only exact if equidistant
+
+          ql_c(k,j,i) = ql_c(k,j,i) + particles(n)%weight_factor *            &
+                                      rho_l * 1.33333333 * pi *               &
+                                      ( new_r**3 - particles(n)%radius**3 ) / &
+                                      ( rho_surface * dx * dy * dz )
+          IF ( ql_c(k,j,i) > 100.0 )  THEN
+             print*,'+++ advec_particles k=',k,' j=',j,' i=',i, &
+                          ' ql_c=',ql_c(k,j,i), ' part(',n,')%wf=', &
+                          particles(n)%weight_factor,' delta_r=',delta_r
+#if defined( __parallel )
+             CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+             STOP
+#endif
+          ENDIF
+
+!
+!--       Change the droplet radius
+          IF ( ( new_r - particles(n)%radius ) < 0.0  .AND.  new_r < 0.0 ) &
+          THEN
+             print*,'+++ advec_particles #1 k=',k,' j=',j,' i=',i, &
+                          ' e_s=',e_s, ' e_a=',e_a,' t_int=',t_int, &
+                          ' d_radius=',d_radius,' delta_r=',delta_r,&
+                          ' particle_radius=',particles(n)%radius
+#if defined( __parallel )
+             CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+             STOP
+#endif
+          ENDIF
+          particles(n)%radius = new_r
+
+!
+!--       Sum up the total volume of liquid water (needed below for
+!--       re-calculating the weighting factors)
+          ql_v(k,j,i) = ql_v(k,j,i) + particles(n)%weight_factor * &
+                                      particles(n)%radius**3
+       ENDDO
+       CALL cpu_log( log_point_s(42), 'advec_part_cond', 'stop' )
+
+!
+!--    Particle growth by collision
+       CALL cpu_log( log_point_s(43), 'advec_part_coll', 'start' )
+       
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+!
+!--             Collision requires at least two particles in the box
+                IF ( prt_count(k,j,i) > 1 )  THEN
+!
+!--                First, sort particles within the gridbox by their size,
+!--                using Shell's method (see Numerical Recipes)
+!--                NOTE: In case of using particle tails, the re-sorting of
+!--                ----  tails would have to be included here!
+                   psi = prt_start_index(k,j,i) - 1
+                   inc = 1
+                   DO WHILE ( inc <= prt_count(k,j,i) )
+                      inc = 3 * inc + 1
+                   ENDDO
+
+                   DO WHILE ( inc > 1 )
+                      inc = inc / 3
+                      DO  is = inc+1, prt_count(k,j,i)
+                         tmp_particle = particles(psi+is)
+                         js = is
+                         DO WHILE ( particles(psi+js-inc)%radius > &
+                                    tmp_particle%radius )
+                            particles(psi+js) = particles(psi+js-inc)
+                            js = js - inc
+                            IF ( js <= inc )  EXIT
+                         ENDDO
+                         particles(psi+js) = tmp_particle
+                      ENDDO
+                   ENDDO
+
+!
+!--                Calculate the mean radius of all those particles which
+!--                are of smaller or equal size than the current particle
+!--                and use this radius for calculating the collision efficiency
+                   psi = prt_start_index(k,j,i)
+                   s_r3 = 0.0
+                   s_r4 = 0.0
+                   DO  n = psi, psi+prt_count(k,j,i)-1
+!
+!--                   There may be some particles of size equal to the
+!--                   current particle but with larger index
+                      sl_r3 = 0.0
+                      sl_r4 = 0.0
+		      DO is = n, psi+prt_count(k,j,i)-2
+			 IF ( particles(is+1)%radius == &
+			      particles(is)%radius ) THEN
+                            sl_r3 = sl_r3 + particles(is+1)%radius**3
+                            sl_r4 = sl_r4 + particles(is+1)%radius**4
+		         ELSE
+			    EXIT
+			 ENDIF
+		      ENDDO
+
+                      IF ( ( s_r3 + sl_r3 ) > 0.0 )  THEN
+
+                         mean_r = ( s_r4 + sl_r4 ) / ( s_r3 + sl_r3 )
+
+                         CALL collision_efficiency( mean_r,              &
+                                                    particles(n)%radius, &
+                                                    effective_coll_efficiency )
+
+                      ELSE
+                         effective_coll_efficiency = 0.0
+                      ENDIF
+       
+!
+!--                   Contribution of the current particle to the next one
+                      s_r3 = s_r3 + particles(n)%radius**3
+                      s_r4 = s_r4 + particles(n)%radius**4
+
+                      IF ( effective_coll_efficiency > 1.0  .OR. &
+                           effective_coll_efficiency < 0.0 )     &
+                      THEN
+                         print*,'+++ advec_particles  collision_efficiency ', &
+                                   'out of range:', effective_coll_efficiency
+#if defined( __parallel )
+                         CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+                         STOP
+#endif
+                      ENDIF
+
+!
+!--                   Interpolation of ...
+                      ii = particles(n)%x * ddx
+                      jj = particles(n)%y * ddy
+                      kk = ( particles(n)%z + 0.5 * dz ) / dz
+
+                      x  = particles(n)%x - ii * dx
+                      y  = particles(n)%y - jj * dy
+                      aa = x**2          + y**2
+                      bb = ( dx - x )**2 + y**2
+                      cc = x**2          + ( dy - y )**2
+                      dd = ( dx - x )**2 + ( dy - y )**2
+                      gg = aa + bb + cc + dd
+
+                      ql_int_l = ( ( gg-aa ) * ql(kk,jj,ii)   + ( gg-bb ) *    &
+                                                              ql(kk,jj,ii+1)   &
+                                 + ( gg-cc ) * ql(kk,jj+1,ii) + ( gg-dd ) *    &
+                                                              ql(kk,jj+1,ii+1) &
+                                 ) / ( 3.0 * gg )
+
+                      ql_int_u = ( ( gg-aa ) * ql(kk+1,jj,ii)   + ( gg-bb ) *  &
+                                                            ql(kk+1,jj,ii+1)   &
+                                 + ( gg-cc ) * ql(kk+1,jj+1,ii) + ( gg-dd ) *  &
+                                                            ql(kk+1,jj+1,ii+1) &
+                                 ) / ( 3.0 * gg )
+
+                      ql_int = ql_int_l + ( particles(n)%z - zu(kk) ) / dz * &
+                                          ( ql_int_u - ql_int_l )
+
+!
+!--                   Interpolate u velocity-component
+                      ii = ( particles(n)%x + 0.5 * dx ) * ddx
+                      jj =   particles(n)%y * ddy
+                      kk = ( particles(n)%z + 0.5 * dz ) / dz  ! only if eq.dist
+
+                      IF ( ( particles(n)%z - zu(kk) ) > ( 0.5*dz ) )  kk = kk+1
+
+                      x  = particles(n)%x + ( 0.5 - ii ) * dx
+                      y  = particles(n)%y - jj * dy
+                      aa = x**2          + y**2
+                      bb = ( dx - x )**2 + y**2
+                      cc = x**2          + ( dy - y )**2
+                      dd = ( dx - x )**2 + ( dy - y )**2
+                      gg = aa + bb + cc + dd
+
+                      u_int_l = ( ( gg-aa ) * u(kk,jj,ii)   + ( gg-bb ) *     &
+                                                              u(kk,jj,ii+1)   &
+                                + ( gg-cc ) * u(kk,jj+1,ii) + ( gg-dd ) *     &
+                                                              u(kk,jj+1,ii+1) &
+                                ) / ( 3.0 * gg ) - u_gtrans
+                      IF ( kk+1 == nzt+1 )  THEN
+                         u_int = u_int_l
+                      ELSE
+                         u_int_u = ( ( gg-aa ) * u(kk+1,jj,ii)   + ( gg-bb ) * &
+                                                             u(kk+1,jj,ii+1)   &
+                                   + ( gg-cc ) * u(kk+1,jj+1,ii) + ( gg-dd ) * &
+                                                             u(kk+1,jj+1,ii+1) &
+                                   ) / ( 3.0 * gg ) - u_gtrans
+                         u_int = u_int_l + ( particles(n)%z - zu(kk) ) / dz * &
+                                           ( u_int_u - u_int_l )
+                      ENDIF
+
+!
+!--                   Same procedure for interpolation of the v velocity-compo-
+!--                   nent (adopt index k from u velocity-component)
+                      ii =   particles(n)%x * ddx
+                      jj = ( particles(n)%y + 0.5 * dy ) * ddy
+
+                      x  = particles(n)%x - ii * dx
+                      y  = particles(n)%y + ( 0.5 - jj ) * dy
+                      aa = x**2          + y**2
+                      bb = ( dx - x )**2 + y**2
+                      cc = x**2          + ( dy - y )**2
+                      dd = ( dx - x )**2 + ( dy - y )**2
+                      gg = aa + bb + cc + dd
+
+                      v_int_l = ( ( gg-aa ) * v(kk,jj,ii)   + ( gg-bb ) *      &
+                                                               v(kk,jj,ii+1)   &
+                                + ( gg-cc ) * v(kk,jj+1,ii) + ( gg-dd ) *      &
+                                                               v(kk,jj+1,ii+1) &
+                                ) / ( 3.0 * gg ) - v_gtrans
+                      IF ( kk+1 == nzt+1 )  THEN
+                         v_int = v_int_l
+                      ELSE
+                         v_int_u = ( ( gg-aa ) * v(kk+1,jj,ii)   + ( gg-bb ) * &
+                                                               v(kk+1,jj,ii+1) &
+                                   + ( gg-cc ) * v(kk+1,jj+1,ii) + ( gg-dd ) * &
+                                                             v(kk+1,jj+1,ii+1) &
+                                ) / ( 3.0 * gg ) - v_gtrans
+                         v_int = v_int_l + ( particles(n)%z - zu(kk) ) / dz * &
+                                           ( v_int_u - v_int_l )
+                      ENDIF
+
+!
+!--                   Same procedure for interpolation of the w velocity-compo-
+!--                   nent (adopt index i from v velocity-component)
+                      jj = particles(n)%y * ddy
+                      kk = particles(n)%z / dz
+
+                      x  = particles(n)%x - ii * dx
+                      y  = particles(n)%y - jj * dy
+                      aa = x**2          + y**2
+                      bb = ( dx - x )**2 + y**2
+                      cc = x**2          + ( dy - y )**2
+                      dd = ( dx - x )**2 + ( dy - y )**2
+                      gg = aa + bb + cc + dd
+
+                      w_int_l = ( ( gg-aa ) * w(kk,jj,ii)   + ( gg-bb ) *      &
+                                                                 w(kk,jj,ii+1) &
+                                + ( gg-cc ) * w(kk,jj+1,ii) + ( gg-dd ) *      &
+                                                               w(kk,jj+1,ii+1) &
+                                ) / ( 3.0 * gg )
+                      IF ( kk+1 == nzt+1 )  THEN
+                         w_int = w_int_l
+                      ELSE
+                         w_int_u = ( ( gg-aa ) * w(kk+1,jj,ii)   + ( gg-bb ) * &
+                                                               w(kk+1,jj,ii+1) &
+                                   + ( gg-cc ) * w(kk+1,jj+1,ii) + ( gg-dd ) * &
+                                                             w(kk+1,jj+1,ii+1) &
+                                   ) / ( 3.0 * gg )
+                         w_int = w_int_l + ( particles(n)%z - zw(kk) ) / dz * &
+                                           ( w_int_u - w_int_l )
+                      ENDIF
+
+!
+!--                   Change in radius due to collision
+                      delta_r = effective_coll_efficiency * &
+                                ql_int * rho_surface / ( 1.0 - ql_int ) *   &
+                                0.25 / rho_l *                              &
+                                SQRT( ( u_int - particles(n)%speed_x )**2 + &
+                                      ( v_int - particles(n)%speed_y )**2 + &
+                                      ( w_int - particles(n)%speed_z )**2   &
+                                    ) * dt_3d
+
+                      particles(n)%radius = particles(n)%radius + delta_r
+
+                      ql_vp(k,j,i) = ql_vp(k,j,i) + particles(n)%radius**3
+
+                   ENDDO
+
+                ENDIF
+
+!
+!--             Re-calculate the weighting factor (total liquid water content
+!--             must be conserved during collision)
+                IF ( ql_vp(k,j,i) /= 0.0 )  THEN
+
+                   ql_vp(k,j,i) = ql_v(k,j,i) / ql_vp(k,j,i)
+!
+!--                Re-assign this weighting factor to the particles of the
+!--                current gridbox
+                   psi = prt_start_index(k,j,i)
+                   DO  n = psi, psi + prt_count(k,j,i)-1
+                      particles(n)%weight_factor = ql_vp(k,j,i)
+                   ENDDO
+
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+       CALL cpu_log( log_point_s(43), 'advec_part_coll', 'stop' )
+
+    ENDIF
+
+
+!
+!-- Particle advection.
+!-- In case of including the SGS velocities, the LES timestep has probably
+!-- to be split into several smaller timesteps because of the Lagrangian
+!-- timescale condition. Because the number of timesteps to be carried out is
+!-- not known at the beginning, these steps are carried out in an infinite loop
+!-- with exit condition.
+!
+!-- If SGS velocities are used, gradients of the TKE have to be calculated and
+!-- boundary conditions have to be set first. Also, horizontally averaged
+!-- profiles of the SGS TKE and the resolved-scale velocity variances are
+!-- needed.
+    IF ( use_sgs_for_particles )  THEN
+
+!
+!--    TKE gradient along x and y
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb, nzt+1
+                de_dx(k,j,i) = sgs_wfu_part * ( e(k,j,i+1) - e(k,j,i-1) ) * ddx
+                de_dy(k,j,i) = sgs_wfv_part * ( e(k,j+1,i) - e(k,j-1,i) ) * ddy
+             ENDDO
+          ENDDO
+       ENDDO
+
+!
+!--    TKE gradient along z, including bottom and top boundary conditions
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb+2, nzt-1
+                de_dz(k,j,i) = 2.0 * sgs_wfw_part * &
+                               ( e(k+1,j,i) - e(k-1,j,i) ) / ( zu(k+1)-zu(k-1) )
+             ENDDO
+             de_dz(nzb,j,i)   = 0.0
+             de_dz(nzb+1,j,i) = 2.0 * sgs_wfw_part *              &
+                                ( e(nzb+2,j,i) - e(nzb+1,j,i) ) / &
+                                ( zu(nzb+2) - zu(nzb+1) )
+             de_dz(nzt,j,i)   = 0.0
+             de_dz(nzt+1,j,i) = 0.0
+          ENDDO
+       ENDDO              
+
+!
+!--    Lateral boundary conditions
+       CALL exchange_horiz( de_dx, 0, 0 )
+       CALL exchange_horiz( de_dy, 0, 0 )
+       CALL exchange_horiz( de_dz, 0, 0 )
+       CALL exchange_horiz( diss,  0, 0 )
+
+!
+!--    Calculate the horizontally averaged profiles of SGS TKE and resolved
+!--    velocity variances (they may have been already calculated in routine
+!--    flow_statistics).
+       IF ( .NOT. flow_statistics_called )  THEN
+!
+!--       First calculate horizontally averaged profiles of the horizontal
+!--       velocities.
+          sums_l(:,1,0) = 0.0
+          sums_l(:,2,0) = 0.0
+
+          DO  i = nxl, nxr
+             DO  j =  nys, nyn
+                DO  k = nzb_s_outer(j,i), nzt+1
+                   sums_l(k,1,0)  = sums_l(k,1,0)  + u(k,j,i)
+                   sums_l(k,2,0)  = sums_l(k,2,0)  + v(k,j,i)
+                ENDDO
+             ENDDO
+          ENDDO
+
+#if defined( __parallel )
+!
+!--       Compute total sum from local sums
+          CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), nzt+2-nzb, &
+                              MPI_REAL, MPI_SUM, comm2d, ierr )
+          CALL MPI_ALLREDUCE( sums_l(nzb,2,0), sums(nzb,2), nzt+2-nzb, &
+                              MPI_REAL, MPI_SUM, comm2d, ierr )
+#else
+                   sums(:,1) = sums_l(:,1,0)
+                   sums(:,2) = sums_l(:,2,0)
+#endif
+
+!
+!--       Final values are obtained by division by the total number of grid
+!--       points used for the summation. 
+          hom(:,1,1,0) = sums(:,1) / ngp_2dh_outer(:,0)   ! u
+          hom(:,1,2,0) = sums(:,2) / ngp_2dh_outer(:,0)   ! v
+
+!
+!--       Now calculate the profiles of SGS TKE and the resolved-scale
+!--       velocity variances
+          sums_l(:,8,0)  = 0.0
+          sums_l(:,30,0) = 0.0
+          sums_l(:,31,0) = 0.0
+          sums_l(:,32,0) = 0.0
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                DO  k = nzb_s_outer(j,i), nzt+1
+                   sums_l(k,8,0)  = sums_l(k,8,0)  + e(k,j,i)
+                   sums_l(k,30,0) = sums_l(k,30,0) + &
+                                    ( u(k,j,i) - hom(k,1,1,0) )**2
+                   sums_l(k,31,0) = sums_l(k,31,0) + &
+                                    ( v(k,j,i) - hom(k,1,2,0) )**2
+                   sums_l(k,32,0) = sums_l(k,32,0) + w(k,j,i)**2
+                ENDDO
+             ENDDO
+          ENDDO
+
+#if defined( __parallel )
+!
+!--       Compute total sum from local sums
+          CALL MPI_ALLREDUCE( sums_l(nzb,8,0), sums(nzb,8), nzt+2-nzb, &
+                              MPI_REAL, MPI_SUM, comm2d, ierr )
+          CALL MPI_ALLREDUCE( sums_l(nzb,30,0), sums(nzb,30), nzt+2-nzb, &
+                              MPI_REAL, MPI_SUM, comm2d, ierr )
+          CALL MPI_ALLREDUCE( sums_l(nzb,31,0), sums(nzb,31), nzt+2-nzb, &
+                              MPI_REAL, MPI_SUM, comm2d, ierr )
+          CALL MPI_ALLREDUCE( sums_l(nzb,32,0), sums(nzb,32), nzt+2-nzb, &
+                              MPI_REAL, MPI_SUM, comm2d, ierr )
+                  
+#else
+          sums(:,8)  = sums_l(:,8,0)
+          sums(:,30) = sums_l(:,30,0)
+          sums(:,31) = sums_l(:,31,0)
+          sums(:,32) = sums_l(:,32,0)
+#endif
+
+!
+!--       Final values are obtained by division by the total number of grid
+!--       points used for the summation.
+          hom(:,1,8,0)  = sums(:,8)  / ngp_2dh_outer(:,0)   ! e
+          hom(:,1,30,0) = sums(:,30) / ngp_2dh_outer(:,0)   ! u*2
+          hom(:,1,31,0) = sums(:,31) / ngp_2dh_outer(:,0)   ! v*2 
+          hom(:,1,32,0) = sums(:,32) / ngp_2dh_outer(:,0)   ! w*2
+
+       ENDIF
+
+    ENDIF 
+
+!
+!-- Initialize variables used for accumulating the number of particles
+!-- exchanged between the subdomains during all sub-timesteps (if sgs
+!-- velocities are included). These data are output further below on the
+!-- particle statistics file.
+    trlp_count_sum      = 0
+    trlp_count_recv_sum = 0
+    trrp_count_sum      = 0
+    trrp_count_recv_sum = 0
+    trsp_count_sum      = 0
+    trsp_count_recv_sum = 0
+    trnp_count_sum      = 0
+    trnp_count_recv_sum = 0
+
+!
+!-- Initialize the variable storing the total time that a particle has advanced
+!-- within the timestep procedure
+    particles(1:number_of_particles)%dt_sum = 0.0
+
+!
+!-- Timestep loop.
+!-- This loop has to be repeated until the advection time of every particle
+!-- (in the total domain!) has reached the LES timestep (dt_3d)
+    DO
+
+       CALL cpu_log( log_point_s(44), 'advec_part_advec', 'start' )
+
+!
+!--    Initialize the switch used for the loop exit condition checked at the
+!--    end of this loop.
+!--    If at least one particle has failed to reach the LES timestep, this
+!--    switch will be set false.
+       dt_3d_reached_l = .TRUE.
+
+!
+!--    Initialize variables for the (sub-) timestep, i.e. for marking those
+!--    particles to be deleted after the timestep
+       particle_mask     = .TRUE.
+       deleted_particles = 0
+       trlp_count_recv   = 0
+       trnp_count_recv   = 0
+       trrp_count_recv   = 0
+       trsp_count_recv   = 0
+       IF ( use_particle_tails )  THEN
+          tail_mask     = .TRUE.
+          deleted_tails = 0
+       ENDIF
+
+
+       DO  n = 1, number_of_particles
+!
+!--       Move particles only if the LES timestep has not (approximately) been
+!--       reached
+          IF ( ( dt_3d - particles(n)%dt_sum ) < 1E-8 )  CYCLE
+
+!
+!--       Interpolate u velocity-component, determine left, front, bottom
+!--       index of u-array
+          i = ( particles(n)%x + 0.5 * dx ) * ddx
+          j =   particles(n)%y * ddy
+          k = ( particles(n)%z + 0.5 * dz ) / dz  ! only exact if equidistant
+                                               
+!
+!--       Interpolation of the velocity components in the xy-plane
+          x  = particles(n)%x + ( 0.5 - i ) * dx
+          y  = particles(n)%y - j * dy
+          aa = x**2          + y**2
+          bb = ( dx - x )**2 + y**2
+          cc = x**2          + ( dy - y )**2
+          dd = ( dx - x )**2 + ( dy - y )**2
+          gg = aa + bb + cc + dd
+
+          u_int_l = ( ( gg - aa ) * u(k,j,i)   + ( gg - bb ) * u(k,j,i+1)   &
+                    + ( gg - cc ) * u(k,j+1,i) + ( gg - dd ) * u(k,j+1,i+1) &
+                    ) / ( 3.0 * gg ) - u_gtrans
+          IF ( k+1 == nzt+1 )  THEN
+             u_int = u_int_l
+          ELSE
+             u_int_u = ( ( gg-aa ) * u(k+1,j,i)   + ( gg-bb ) * u(k+1,j,i+1) &
+                    + ( gg-cc ) * u(k+1,j+1,i) + ( gg-dd ) * u(k+1,j+1,i+1)  &
+                    ) / ( 3.0 * gg ) - u_gtrans
+             u_int = u_int_l + ( particles(n)%z - zu(k) ) / dz * &
+                               ( u_int_u - u_int_l )
+          ENDIF
+
+!
+!--       Same procedure for interpolation of the v velocity-component (adopt
+!--       index k from u velocity-component)
+          i =   particles(n)%x * ddx
+          j = ( particles(n)%y + 0.5 * dy ) * ddy
+
+          x  = particles(n)%x - i * dx
+          y  = particles(n)%y + ( 0.5 - j ) * dy
+          aa = x**2          + y**2
+          bb = ( dx - x )**2 + y**2
+          cc = x**2          + ( dy - y )**2
+          dd = ( dx - x )**2 + ( dy - y )**2
+          gg = aa + bb + cc + dd
+
+          v_int_l = ( ( gg - aa ) * v(k,j,i)   + ( gg - bb ) * v(k,j,i+1)   &
+                    + ( gg - cc ) * v(k,j+1,i) + ( gg - dd ) * v(k,j+1,i+1) &
+                    ) / ( 3.0 * gg ) - v_gtrans
+          IF ( k+1 == nzt+1 )  THEN
+             v_int = v_int_l
+          ELSE
+             v_int_u = ( ( gg-aa ) * v(k+1,j,i)   + ( gg-bb ) * v(k+1,j,i+1) &
+                    + ( gg-cc ) * v(k+1,j+1,i) + ( gg-dd ) * v(k+1,j+1,i+1)  &
+                    ) / ( 3.0 * gg ) - v_gtrans
+             v_int = v_int_l + ( particles(n)%z - zu(k) ) / dz * &
+                               ( v_int_u - v_int_l )
+          ENDIF
+
+!
+!--       Same procedure for interpolation of the w velocity-component (adopt
+!--       index i from v velocity-component)
+          IF ( vertical_particle_advection )  THEN
+             j = particles(n)%y * ddy
+             k = particles(n)%z / dz
+
+             x  = particles(n)%x - i * dx
+             y  = particles(n)%y - j * dy
+             aa = x**2          + y**2
+             bb = ( dx - x )**2 + y**2
+             cc = x**2          + ( dy - y )**2
+             dd = ( dx - x )**2 + ( dy - y )**2
+             gg = aa + bb + cc + dd
+
+             w_int_l = ( ( gg - aa ) * w(k,j,i)   + ( gg - bb ) * w(k,j,i+1) &
+                    + ( gg - cc ) * w(k,j+1,i) + ( gg - dd ) * w(k,j+1,i+1)  &
+                       ) / ( 3.0 * gg )
+             IF ( k+1 == nzt+1 )  THEN
+                w_int = w_int_l
+             ELSE
+                w_int_u = ( ( gg-aa ) * w(k+1,j,i)   + &
+                            ( gg-bb ) * w(k+1,j,i+1) + &
+                            ( gg-cc ) * w(k+1,j+1,i) + &
+                            ( gg-dd ) * w(k+1,j+1,i+1) &
+                           ) / ( 3.0 * gg )
+                w_int = w_int_l + ( particles(n)%z - zw(k) ) / dz * &
+                                  ( w_int_u - w_int_l )
+             ENDIF
+          ELSE
+             w_int = 0.0
+          ENDIF
+
+!
+!--       Interpolate and calculate quantities needed for calculating the SGS
+!--       velocities
+          IF ( use_sgs_for_particles )  THEN
+!
+!--          Interpolate TKE
+             i = particles(n)%x * ddx
+             j = particles(n)%y * ddy
+             k = ( particles(n)%z + 0.5 * dz ) / dz  ! only exact if eq.dist
+
+             x  = particles(n)%x - i * dx
+             y  = particles(n)%y - j * dy
+             aa = x**2          + y**2
+             bb = ( dx - x )**2 + y**2
+             cc = x**2          + ( dy - y )**2
+             dd = ( dx - x )**2 + ( dy - y )**2
+             gg = aa + bb + cc + dd
+
+             e_int_l = ( ( gg-aa ) * e(k,j,i)   + ( gg-bb ) * e(k,j,i+1)   &
+                       + ( gg-cc ) * e(k,j+1,i) + ( gg-dd ) * e(k,j+1,i+1) &
+                       ) / ( 3.0 * gg )
+
+             IF ( k+1 == nzt+1 )  THEN
+                e_int = e_int_l
+             ELSE
+                e_int_u = ( ( gg - aa ) * e(k+1,j,i)   + &
+                            ( gg - bb ) * e(k+1,j,i+1) + &
+                            ( gg - cc ) * e(k+1,j+1,i) + &
+                            ( gg - dd ) * e(k+1,j+1,i+1) &
+                          ) / ( 3.0 * gg )
+                e_int = e_int_l + ( particles(n)%z - zu(k) ) / dz * &
+                                  ( e_int_u - e_int_l )
+             ENDIF
+
+!
+!--          Interpolate the TKE gradient along x (adopt incides i,j,k and all
+!--          position variables from above (TKE))
+             de_dx_int_l = ( ( gg - aa ) * de_dx(k,j,i)   + &
+                             ( gg - bb ) * de_dx(k,j,i+1) + &
+                             ( gg - cc ) * de_dx(k,j+1,i) + &
+                             ( gg - dd ) * de_dx(k,j+1,i+1) &
+                           ) / ( 3.0 * gg )
+
+             IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
+                de_dx_int = de_dx_int_l
+             ELSE
+                de_dx_int_u = ( ( gg - aa ) * de_dx(k+1,j,i)   + &
+                                ( gg - bb ) * de_dx(k+1,j,i+1) + &
+                                ( gg - cc ) * de_dx(k+1,j+1,i) + &
+                                ( gg - dd ) * de_dx(k+1,j+1,i+1) &
+                              ) / ( 3.0 * gg )
+                de_dx_int = de_dx_int_l + ( particles(n)%z - zu(k) ) / dz * &
+                                          ( de_dx_int_u - de_dx_int_l )
+             ENDIF
+
+!
+!--          Interpolate the TKE gradient along y
+             de_dy_int_l = ( ( gg - aa ) * de_dy(k,j,i)   + &
+                             ( gg - bb ) * de_dy(k,j,i+1) + &
+                             ( gg - cc ) * de_dy(k,j+1,i) + &
+                             ( gg - dd ) * de_dy(k,j+1,i+1) &
+                           ) / ( 3.0 * gg )
+             IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
+                de_dy_int = de_dy_int_l
+             ELSE
+                de_dy_int_u = ( ( gg - aa ) * de_dy(k+1,j,i)   + &
+                                ( gg - bb ) * de_dy(k+1,j,i+1) + &
+                                ( gg - cc ) * de_dy(k+1,j+1,i) + &
+                                ( gg - dd ) * de_dy(k+1,j+1,i+1) &
+                              ) / ( 3.0 * gg )
+                de_dy_int = de_dy_int_l + ( particles(n)%z - zu(k) ) / dz * &
+                                          ( de_dy_int_u - de_dy_int_l )
+             ENDIF
+
+!
+!--          Interpolate the TKE gradient along z
+             de_dz_int_l = ( ( gg - aa ) * de_dz(k,j,i)   + &
+                             ( gg - bb ) * de_dz(k,j,i+1) + &
+                             ( gg - cc ) * de_dz(k,j+1,i) + &
+                             ( gg - dd ) * de_dz(k,j+1,i+1) &
+                           ) / ( 3.0 * gg )
+
+             IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
+                de_dz_int = de_dz_int_l
+             ELSE
+                de_dz_int_u = ( ( gg - aa ) * de_dz(k+1,j,i)   + &
+                                ( gg - bb ) * de_dz(k+1,j,i+1) + &
+                                ( gg - cc ) * de_dz(k+1,j+1,i) + &
+                                ( gg - dd ) * de_dz(k+1,j+1,i+1) &
+                              ) / ( 3.0 * gg )
+                de_dz_int = de_dz_int_l + ( particles(n)%z - zu(k) ) / dz * &
+                                          ( de_dz_int_u - de_dz_int_l )
+             ENDIF
+
+!
+!--          Interpolate the dissipation of TKE
+             diss_int_l = ( ( gg - aa ) * diss(k,j,i)   + &
+                            ( gg - bb ) * diss(k,j,i+1) + &
+                            ( gg - cc ) * diss(k,j+1,i) + &
+                            ( gg - dd ) * diss(k,j+1,i+1) &
+                           ) / ( 3.0 * gg )
+
+             IF ( k+1 == nzt+1 )  THEN
+                diss_int = diss_int_l
+             ELSE
+                diss_int_u = ( ( gg - aa ) * diss(k+1,j,i)   + &
+                               ( gg - bb ) * diss(k+1,j,i+1) + &
+                               ( gg - cc ) * diss(k+1,j+1,i) + &
+                               ( gg - dd ) * diss(k+1,j+1,i+1) &
+                              ) / ( 3.0 * gg )
+                diss_int = diss_int_l + ( particles(n)%z - zu(k) ) / dz * &
+                                        ( diss_int_u - diss_int_l )
+             ENDIF
+
+!
+!--          Vertically interpolate the horizontally averaged SGS TKE and
+!--          resolved-scale velocity variances and use the interpolated values
+!--          to calculate the coefficient fs, which is a measure of the ratio
+!--          of the subgrid-scale turbulent kinetic energy to the total amount
+!--          of turbulent kinetic energy.
+             IF ( k == 0 )  THEN
+                e_mean_int = hom(0,1,8,0)
+             ELSE
+                e_mean_int = hom(k,1,8,0) +                                    &
+                                           ( hom(k+1,1,8,0) - hom(k,1,8,0) ) / &
+                                           ( zu(k+1) - zu(k) ) *               &
+                                           ( particles(n)%z - zu(k) )
+             ENDIF
+
+             kw = particles(n)%z / dz
+
+             IF ( k == 0 )  THEN
+                aa  = hom(k+1,1,30,0)  * ( particles(n)%z / &
+                                         ( 0.5 * ( zu(k+1) - zu(k) ) ) )
+                bb  = hom(k+1,1,31,0)  * ( particles(n)%z / &
+                                         ( 0.5 * ( zu(k+1) - zu(k) ) ) )
+                cc  = hom(kw+1,1,32,0) * ( particles(n)%z / &
+                                         ( 1.0 * ( zw(kw+1) - zw(kw) ) ) )
+             ELSE
+                aa  = hom(k,1,30,0) + ( hom(k+1,1,30,0) - hom(k,1,30,0) ) * &
+                           ( ( particles(n)%z - zu(k) ) / ( zu(k+1) - zu(k) ) )
+                bb  = hom(k,1,31,0) + ( hom(k+1,1,31,0) - hom(k,1,31,0) ) * &
+                           ( ( particles(n)%z - zu(k) ) / ( zu(k+1) - zu(k) ) )
+                cc  = hom(kw,1,32,0) + ( hom(kw+1,1,32,0)-hom(kw,1,32,0) ) *&
+                           ( ( particles(n)%z - zw(kw) ) / ( zw(kw+1)-zw(kw) ) )
+             ENDIF
+
+             vv_int = ( 1.0 / 3.0 ) * ( aa + bb + cc )
+
+             fs_int = ( 2.0 / 3.0 ) * e_mean_int / &
+                         ( vv_int + ( 2.0 / 3.0 ) * e_mean_int )
+
+!
+!--          Calculate the Lagrangian timescale according to the suggestion of
+!--          Weil et al. (2004).
+             lagr_timescale = ( 4.0 * e_int ) / &
+                              ( 3.0 * fs_int * c_0 * diss_int )
+
+!
+!--          Calculate the next particle timestep. dt_gap is the time needed to
+!--          complete the current LES timestep.
+             dt_gap = dt_3d - particles(n)%dt_sum
+             dt_particle = MIN( dt_3d, 0.025 * lagr_timescale, dt_gap )
+
+!
+!--          The particle timestep should not be too small in order to prevent
+!--          the number of particle timesteps of getting too large
+             IF ( dt_particle < dt_min_part   .AND.  dt_min_part < dt_gap ) &
+             THEN
+                dt_particle = dt_min_part 
+             ENDIF
+
+!
+!--          Calculate the SGS velocity components
+             IF ( particles(n)%age == 0.0 )  THEN
+!
+!--             For new particles the SGS components are derived from the SGS
+!--             TKE. Limit the Gaussian random number to the interval
+!--             [-5.0*sigma, 5.0*sigma] in order to prevent the SGS velocities
+!--             from becoming unrealistically large.
+                particles(n)%speed_x_sgs = SQRT( 2.0 * sgs_wfu_part * e_int ) *&
+                                           ( random_gauss( iran_part, 5.0 )    &
+                                             - 1.0 )
+                particles(n)%speed_y_sgs = SQRT( 2.0 * sgs_wfv_part * e_int ) *&
+                                           ( random_gauss( iran_part, 5.0 )    &
+                                             - 1.0 )
+                particles(n)%speed_z_sgs = SQRT( 2.0 * sgs_wfw_part * e_int ) *&
+                                           ( random_gauss( iran_part, 5.0 )    &
+                                             - 1.0 )
+
+             ELSE
+!
+!--             For old particles the SGS components are correlated with the
+!--             values from the previous timestep. Random numbers have also to
+!--             be limited (see above).
+                particles(n)%speed_x_sgs = particles(n)%speed_x_sgs -          &
+                       fs_int * c_0 * diss_int * particles(n)%speed_x_sgs *    &
+                       dt_particle / ( 4.0 * sgs_wfu_part * e_int ) +          &
+                       ( ( 2.0 * sgs_wfu_part * ( e_int - particles(n)%e_m ) / &
+                         dt_particle ) * particles(n)%speed_x_sgs /            &
+                         ( 2.0 * sgs_wfu_part * e_int ) + de_dx_int            &
+                       ) * dt_particle / 2.0                        +          &
+                       SQRT( fs_int * c_0 * diss_int ) *                       &
+                       ( random_gauss( iran_part, 5.0 ) - 1.0 ) *              &
+                       SQRT( dt_particle )
+
+                particles(n)%speed_y_sgs = particles(n)%speed_y_sgs -          &
+                       fs_int * c_0 * diss_int * particles(n)%speed_y_sgs *    &
+                       dt_particle / ( 4.0 * sgs_wfv_part * e_int ) +          &
+                       ( ( 2.0 * sgs_wfv_part * ( e_int - particles(n)%e_m ) / &
+                         dt_particle ) * particles(n)%speed_y_sgs /            &
+                         ( 2.0 * sgs_wfv_part * e_int ) + de_dy_int            &
+                       ) * dt_particle / 2.0                        +          &
+                       SQRT( fs_int * c_0 * diss_int ) *                       &
+                       ( random_gauss( iran_part, 5.0 ) - 1.0 ) *              &
+                       SQRT( dt_particle )
+
+                particles(n)%speed_z_sgs = particles(n)%speed_z_sgs -          &
+                       fs_int * c_0 * diss_int * particles(n)%speed_z_sgs *    &
+                       dt_particle / ( 4.0 * sgs_wfw_part * e_int ) +          &
+                       ( ( 2.0 * sgs_wfw_part * ( e_int - particles(n)%e_m ) / &
+                         dt_particle ) * particles(n)%speed_z_sgs /            &
+                         ( 2.0 * sgs_wfw_part * e_int ) + de_dz_int            &
+                       ) * dt_particle / 2.0                        +          &
+                       SQRT( fs_int * c_0 * diss_int ) *                       &
+                       ( random_gauss( iran_part, 5.0 ) - 1.0 ) *              &
+                       SQRT( dt_particle )
+
+             ENDIF
+
+             u_int = u_int + particles(n)%speed_x_sgs
+             v_int = v_int + particles(n)%speed_y_sgs
+             w_int = w_int + particles(n)%speed_z_sgs
+
+!
+!--          Store the SGS TKE of the current timelevel which is needed for
+!--          for calculating the SGS particle velocities at the next timestep
+             particles(n)%e_m = e_int
+
+          ELSE
+!
+!--          If no SGS velocities are used, only the particle timestep has to
+!--          be set
+             dt_particle = dt_3d
+
+          ENDIF
+
+!
+!--       Particle advection
+          IF ( particle_groups(particles(n)%group)%density_ratio == 0.0 )  THEN
+!
+!--          Pure passive transport (without particle inertia)
+             particles(n)%x = particles(n)%x + u_int * dt_particle
+             particles(n)%y = particles(n)%y + v_int * dt_particle
+             particles(n)%z = particles(n)%z + w_int * dt_particle
+
+             particles(n)%speed_x = u_int
+             particles(n)%speed_y = v_int
+             particles(n)%speed_z = w_int
+
+          ELSE
+!
+!--          Transport of particles with inertia
+             particles(n)%x = particles(n)%x + particles(n)%speed_x * &
+                                               dt_particle
+             particles(n)%y = particles(n)%y + particles(n)%speed_y * &
+                                               dt_particle
+             particles(n)%z = particles(n)%z + particles(n)%speed_z * &
+                                               dt_particle
+
+!
+!--          Update of the particle velocity
+             dens_ratio = particle_groups(particles(n)%group)%density_ratio
+             IF ( cloud_droplets )  THEN
+                exp_arg  = 4.5 * dens_ratio * molecular_viscosity /        &
+                           ( particles(n)%radius )**2 /                    &
+                           ( 1.0 + 0.15 * ( 2.0 * particles(n)%radius *    &
+                             SQRT( ( u_int - particles(n)%speed_x )**2 +   &
+                                   ( v_int - particles(n)%speed_y )**2 +   &
+                                   ( w_int - particles(n)%speed_z )**2 ) / &
+                                            molecular_viscosity )**0.687   &
+                           )
+                exp_term = EXP( -exp_arg * dt_particle )
+             ELSEIF ( use_sgs_for_particles )  THEN
+                exp_arg  = particle_groups(particles(n)%group)%exp_arg
+                exp_term = EXP( -exp_arg * dt_particle )
+             ELSE
+                exp_arg  = particle_groups(particles(n)%group)%exp_arg
+                exp_term = particle_groups(particles(n)%group)%exp_term
+             ENDIF
+             particles(n)%speed_x = particles(n)%speed_x * exp_term + &
+                                    u_int * ( 1.0 - exp_term )
+              particles(n)%speed_y = particles(n)%speed_y * exp_term + &
+                                    v_int * ( 1.0 - exp_term )
+              particles(n)%speed_z = particles(n)%speed_z * exp_term +       &
+                              ( w_int - ( 1.0 - dens_ratio ) * g / exp_arg ) &
+                                    * ( 1.0 - exp_term )
+          ENDIF
+
+!
+!--       Increment the particle age and the total time that the particle
+!--       has advanced within the particle timestep procedure
+          particles(n)%age    = particles(n)%age    + dt_particle
+          particles(n)%dt_sum = particles(n)%dt_sum + dt_particle
+
+!
+!--       Check whether there is still a particle that has not yet completed 
+!--       the total LES timestep
+          IF ( ( dt_3d - particles(n)%dt_sum ) > 1E-8 )  THEN
+             dt_3d_reached_l = .FALSE.
+          ENDIF
+
+       ENDDO   ! advection loop
+
+!
+!--    Find out, if all particles on every PE have completed the LES timestep
+!--    and set the switch corespondingly
+#if defined( __parallel )
+       CALL MPI_ALLREDUCE( dt_3d_reached_l, dt_3d_reached, 1, MPI_LOGICAL, &
+                           MPI_LAND, comm2d, ierr )
+#else
+       dt_3d_reached = dt_3d_reached_l
+#endif     
+
+       CALL cpu_log( log_point_s(44), 'advec_part_advec', 'stop' )
+
+!
+!--    Increment time since last release
+       IF ( dt_3d_reached )  time_prel = time_prel + dt_3d
+
+!    WRITE ( 9, * ) '*** advec_particles: ##0.4'
+!    CALL FLUSH_( 9 )
+!    nd = 0
+!    DO  n = 1, number_of_particles
+!       IF ( .NOT. particle_mask(n) )  nd = nd + 1
+!    ENDDO
+!    IF ( nd /= deleted_particles ) THEN
+!       WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+!       CALL FLUSH_( 9 )
+!       CALL MPI_ABORT( comm2d, 9999, ierr )
+!    ENDIF
+
+!
+!--    If necessary, release new set of particles
+       IF ( time_prel >= dt_prel  .AND.  end_time_prel > simulated_time  .AND. &
+            dt_3d_reached )  THEN
+
+!
+!--       Check, if particle storage must be extended
+          IF ( number_of_particles + number_of_initial_particles > &
+               maximum_number_of_particles  )  THEN
+             IF ( netcdf_output )  THEN
+                PRINT*, '+++ advec_particles:  maximum_number_of_particles ', &
+                                               'needs to be increased'
+                PRINT*, '                      but this is not allowed with ', &
+                                               'NetCDF output switched on'
+#if defined( __parallel )
+                CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+                CALL local_stop
+#endif
+             ELSE
+!    WRITE ( 9, * ) '*** advec_particles: before allocate_prt_memory dt_prel'
+!    CALL FLUSH_( 9 )
+                CALL allocate_prt_memory( number_of_initial_particles )
+!    WRITE ( 9, * ) '*** advec_particles: after allocate_prt_memory dt_prel'
+!    CALL FLUSH_( 9 )
+             ENDIF
+          ENDIF
+
+!
+!--       Check, if tail storage must be extended
+          IF ( use_particle_tails )  THEN
+             IF ( number_of_tails + number_of_initial_tails > &
+                  maximum_number_of_tails  )  THEN
+                IF ( netcdf_output )  THEN
+                   PRINT*, '+++ advec_particles:  maximum_number_of_tails ', &
+                                                  'needs to be increased'
+                   PRINT*, '                      but this is not allowed wi', &
+                                                  'th NetCDF output switched on'
+#if defined( __parallel )
+                   CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+                   CALL local_stop
+#endif
+                ELSE
+!    WRITE ( 9, * ) '*** advec_particles: before allocate_tail_memory dt_prel'
+!    CALL FLUSH_( 9 )
+                   CALL allocate_tail_memory( number_of_initial_tails )
+!    WRITE ( 9, * ) '*** advec_particles: after allocate_tail_memory dt_prel'
+!    CALL FLUSH_( 9 )
+                ENDIF
+             ENDIF
+          ENDIF
+
+!
+!--       The MOD function allows for changes in the output interval with
+!--       restart runs.
+          time_prel = MOD( time_prel, MAX( dt_prel, dt_3d ) )
+          IF ( number_of_initial_particles /= 0 )  THEN
+             is = number_of_particles+1
+             ie = number_of_particles+number_of_initial_particles
+             particles(is:ie) = initial_particles(1:number_of_initial_particles)
+!
+!--          Add random fluctuation to particle positions. Particles should
+!--          remain in the subdomain.
+             IF ( random_start_position )  THEN
+                DO  n = is, ie
+                   IF ( psl(particles(n)%group) /= psr(particles(n)%group) ) &
+                   THEN
+                      particles(n)%x = particles(n)%x + &
+                                       ( random_function( iran ) - 0.5 ) * &
+                                       pdx(particles(n)%group)
+                      IF ( particles(n)%x  <=  ( nxl - 0.5 ) * dx )  THEN
+                         particles(n)%x = ( nxl - 0.4999999999 ) * dx
+                      ELSEIF ( particles(n)%x  >=  ( nxr + 0.5 ) * dx )  THEN
+                         particles(n)%x = ( nxr + 0.4999999999 ) * dx
+                      ENDIF
+                   ENDIF
+                   IF ( pss(particles(n)%group) /= psn(particles(n)%group) ) &
+                   THEN
+                      particles(n)%y = particles(n)%y + &
+                                       ( random_function( iran ) - 0.5 ) * &
+                                       pdy(particles(n)%group)
+                      IF ( particles(n)%y  <=  ( nys - 0.5 ) * dy )  THEN
+                         particles(n)%y = ( nys - 0.4999999999 ) * dy
+                      ELSEIF ( particles(n)%y  >=  ( nyn + 0.5 ) * dy )  THEN
+                         particles(n)%y = ( nyn + 0.4999999999 ) * dy
+                      ENDIF
+                   ENDIF
+                   IF ( psb(particles(n)%group) /= pst(particles(n)%group) ) &
+                   THEN
+                      particles(n)%z = particles(n)%z + &
+                                       ( random_function( iran ) - 0.5 ) * &
+                                       pdz(particles(n)%group)
+                   ENDIF
+                ENDDO
+             ENDIF
+
+!
+!--          Set the beginning of the new particle tails and their age
+             IF ( use_particle_tails )  THEN
+                DO  n = is, ie
+!
+!--                New particles which should have a tail, already have got a
+!--                provisional tail id unequal zero (see init_particles)
+                   IF ( particles(n)%tail_id /= 0 )  THEN
+                      number_of_tails = number_of_tails + 1
+                      nn = number_of_tails
+                      particles(n)%tail_id = nn   ! set the final tail id
+                      particle_tail_coordinates(1,1,nn) = particles(n)%x
+                      particle_tail_coordinates(1,2,nn) = particles(n)%y
+                      particle_tail_coordinates(1,3,nn) = particles(n)%z
+                      particle_tail_coordinates(1,4,nn) = particles(n)%color
+                      particles(n)%tailpoints = 1
+                      IF ( minimum_tailpoint_distance /= 0.0 )  THEN
+                         particle_tail_coordinates(2,1,nn) = particles(n)%x
+                         particle_tail_coordinates(2,2,nn) = particles(n)%y
+                         particle_tail_coordinates(2,3,nn) = particles(n)%z
+                         particle_tail_coordinates(2,4,nn) = particles(n)%color
+                         particle_tail_coordinates(1:2,5,nn) = 0.0
+                         particles(n)%tailpoints = 2
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDIF
+!    WRITE ( 9, * ) '*** advec_particles: after setting the beginning of new tails'
+!    CALL FLUSH_( 9 )
+
+             number_of_particles = number_of_particles + &
+                                   number_of_initial_particles
+          ENDIF
+
+       ENDIF
+
+!    WRITE ( 9, * ) '*** advec_particles: ##0.5'
+!    CALL FLUSH_( 9 )
+!    nd = 0
+!    DO  n = 1, number_of_particles
+!       IF ( .NOT. particle_mask(n) )  nd = nd + 1
+!    ENDDO
+!    IF ( nd /= deleted_particles ) THEN
+!       WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+!       CALL FLUSH_( 9 )
+!       CALL MPI_ABORT( comm2d, 9999, ierr )
+!    ENDIF
+
+!    IF ( number_of_particles /= number_of_tails )  THEN
+!       WRITE (9,*) '--- advec_particles: #2'
+!       WRITE (9,*) '    #of p=',number_of_particles,' #of t=',number_of_tails
+!       CALL FLUSH_( 9 )
+!    ENDIF
+!    DO  n = 1, number_of_particles
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+
+#if defined( __parallel )
+!
+!--    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 run 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.
+       trlp_count  = 0
+       trlpt_count = 0
+       trrp_count  = 0
+       trrpt_count = 0
+       IF ( pdims(1) /= 1 )  THEN
+!
+!--       First calculate the storage necessary for sending and receiving the
+!--       data
+          DO  n = 1, number_of_particles
+	     i = ( particles(n)%x + 0.5 * dx ) * ddx
+!
+!--          Above calculation does not work for indices less than zero
+	     IF ( particles(n)%x < -0.5 * dx )  i = -1
+
+             IF ( i < nxl )  THEN
+                trlp_count = trlp_count + 1
+                IF ( particles(n)%tail_id /= 0 )  trlpt_count = trlpt_count + 1
+             ELSEIF ( i > nxr )  THEN
+                trrp_count = trrp_count + 1
+                IF ( particles(n)%tail_id /= 0 )  trrpt_count = trrpt_count + 1
+             ENDIF
+          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 = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+                                0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+                                0, 0, 0, 0 )
+          trrp = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+                                0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+                                0, 0, 0, 0 )
+
+          IF ( use_particle_tails )  THEN
+             ALLOCATE( trlpt(maximum_number_of_tailpoints,5,trlpt_count), &
+                       trrpt(maximum_number_of_tailpoints,5,trrpt_count) )
+             tlength = maximum_number_of_tailpoints * 5
+          ENDIF
+
+          trlp_count  = 0
+          trlpt_count = 0
+          trrp_count  = 0
+          trrpt_count = 0
+
+       ENDIF
+
+!    WRITE ( 9, * ) '*** advec_particles: ##1'
+!    CALL FLUSH_( 9 )
+!    nd = 0
+!    DO  n = 1, number_of_particles
+!       IF ( .NOT. particle_mask(n) )  nd = nd + 1
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+!    IF ( nd /= deleted_particles ) THEN
+!       WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+!       CALL FLUSH_( 9 )
+!       CALL MPI_ABORT( comm2d, 9999, ierr )
+!    ENDIF
+
+       DO  n = 1, number_of_particles
+
+          nn = particles(n)%tail_id
+
+	  i = ( particles(n)%x + 0.5 * dx ) * ddx
+!
+!--       Above calculation does not work for indices less than zero
+	  IF ( particles(n)%x < - 0.5 * 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
+                      IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                         i  = particles(n)%tailpoints
+                         particle_tail_coordinates(1:i,1,nn) = ( nx + 1 ) * dx &
+                                           + particle_tail_coordinates(1:i,1,nn)
+                      ENDIF
+                   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
+                      particle_mask(n)  = .FALSE.
+                      deleted_particles = deleted_particles + 1
+
+                      IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                         trlpt_count = trlpt_count + 1
+                         trlpt(:,:,trlpt_count) = &
+                                               particle_tail_coordinates(:,:,nn)
+                         trlpt(:,1,trlpt_count) = ( nx + 1 ) * dx + &
+                                                  trlpt(:,1,trlpt_count)
+                         tail_mask(nn) = .FALSE.
+                         deleted_tails = deleted_tails + 1
+                      ENDIF
+                   ENDIF
+
+                ELSEIF ( ibc_par_lr == 1 )  THEN
+!
+!--                Particle absorption
+                   particle_mask(n) = .FALSE.
+                   deleted_particles = deleted_particles + 1
+                   IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                      tail_mask(nn) = .FALSE.
+                      deleted_tails = deleted_tails + 1
+                   ENDIF
+
+                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)
+                particle_mask(n) = .FALSE.
+                deleted_particles = deleted_particles + 1
+
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   trlpt_count = trlpt_count + 1
+                   trlpt(:,:,trlpt_count) = particle_tail_coordinates(:,:,nn)
+                   tail_mask(nn) = .FALSE.
+                   deleted_tails = deleted_tails + 1
+                ENDIF
+            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
+                      IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                         i = particles(n)%tailpoints
+                         particle_tail_coordinates(1:i,1,nn) = - ( nx+1 ) * dx &
+                                           + particle_tail_coordinates(1:i,1,nn)
+                      ENDIF
+                   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
+                      particle_mask(n) = .FALSE.
+                      deleted_particles = deleted_particles + 1
+
+                      IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                         trrpt_count = trrpt_count + 1
+                         trrpt(:,:,trrpt_count) = &
+                                               particle_tail_coordinates(:,:,nn)
+                         trrpt(:,1,trrpt_count) = trrpt(:,1,trrpt_count) - &
+                                                  ( nx + 1 ) * dx
+                         tail_mask(nn) = .FALSE.
+                         deleted_tails = deleted_tails + 1
+                      ENDIF
+                   ENDIF
+
+                ELSEIF ( ibc_par_lr == 1 )  THEN
+!
+!--                Particle absorption
+                   particle_mask(n) = .FALSE.
+                   deleted_particles = deleted_particles + 1
+                   IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                      tail_mask(nn) = .FALSE.
+                      deleted_tails = deleted_tails + 1
+                   ENDIF
+
+                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)
+                particle_mask(n) = .FALSE.
+                deleted_particles = deleted_particles + 1
+
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   trrpt_count = trrpt_count + 1
+                   trrpt(:,:,trrpt_count) = particle_tail_coordinates(:,:,nn)
+                   tail_mask(nn) = .FALSE.
+                   deleted_tails = deleted_tails + 1
+                ENDIF
+             ENDIF
+
+          ENDIF
+       ENDDO
+
+!    WRITE ( 9, * ) '*** advec_particles: ##2'
+!    CALL FLUSH_( 9 )
+!    nd = 0
+!    DO  n = 1, number_of_particles
+!       IF ( .NOT. particle_mask(n) )  nd = nd + 1
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+!    IF ( nd /= deleted_particles ) THEN
+!       WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+!       CALL FLUSH_( 9 )
+!       CALL MPI_ABORT( comm2d, 9999, ierr )
+!    ENDIF
+
+!
+!--    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 cpu_log( log_point_s(23), 'sendrcv_particles', 'start' )
+          CALL MPI_SENDRECV( trlp_count,      1, MPI_INTEGER, pleft,  0, &
+                             trrp_count_recv, 1, MPI_INTEGER, pright, 0, &
+                             comm2d, status, ierr )
+
+          IF ( number_of_particles + trrp_count_recv > &
+               maximum_number_of_particles )           &
+          THEN
+             IF ( netcdf_output )  THEN
+                PRINT*, '+++ advec_particles:  maximum_number_of_particles ', &
+                                               'needs to be increased'
+                PRINT*, '                      but this is not allowed with ', &
+                                               'NetCDF output switched on'
+                CALL MPI_ABORT( comm2d, 9999, ierr )
+             ELSE
+!    WRITE ( 9, * ) '*** advec_particles: before allocate_prt_memory trrp'
+!    CALL FLUSH_( 9 )
+                CALL allocate_prt_memory( trrp_count_recv )
+!    WRITE ( 9, * ) '*** advec_particles: after allocate_prt_memory trrp'
+!    CALL FLUSH_( 9 )
+             ENDIF
+          ENDIF
+
+          CALL MPI_SENDRECV( trlp, trlp_count, mpi_particle_type, pleft, 1,    &
+                             particles(number_of_particles+1), trrp_count_recv,&
+                             mpi_particle_type, pright, 1,                     &
+                             comm2d, status, ierr )
+
+          IF ( use_particle_tails )  THEN
+
+             CALL MPI_SENDRECV( trlpt_count,      1, MPI_INTEGER, pleft,  0, &
+                                trrpt_count_recv, 1, MPI_INTEGER, pright, 0, &
+                                comm2d, status, ierr )
+
+             IF ( number_of_tails+trrpt_count_recv > maximum_number_of_tails ) &
+             THEN
+                IF ( netcdf_output )  THEN
+                   PRINT*, '+++ advec_particles:  maximum_number_of_tails ', &
+                                                  'needs to be increased'
+                   PRINT*, '                      but this is not allowed wi', &
+                                                  'th NetCDF output switched on'
+                   CALL MPI_ABORT( comm2d, 9999, ierr )
+                ELSE
+!    WRITE ( 9, * ) '*** advec_particles: before allocate_tail_memory trrpt'
+!    CALL FLUSH_( 9 )
+                   CALL allocate_tail_memory( trrpt_count_recv )
+!    WRITE ( 9, * ) '*** advec_particles: after allocate_tail_memory trrpt'
+!    CALL FLUSH_( 9 )
+                ENDIF
+             ENDIF
+
+             CALL MPI_SENDRECV( trlpt, trlpt_count*tlength, MPI_REAL, pleft, 1,&
+                             particle_tail_coordinates(1,1,number_of_tails+1), &
+                                trrpt_count_recv*tlength, MPI_REAL, pright, 1, &
+                                comm2d, status, ierr )
+!
+!--          Update the tail ids for the transferred particles
+             nn = number_of_tails
+             DO  n = number_of_particles+1, number_of_particles+trrp_count_recv
+                IF ( particles(n)%tail_id /= 0 )  THEN
+                   nn = nn + 1
+                   particles(n)%tail_id = nn
+                ENDIF
+             ENDDO
+
+          ENDIF
+
+          number_of_particles = number_of_particles + trrp_count_recv
+          number_of_tails     = number_of_tails     + trrpt_count_recv
+!       IF ( number_of_particles /= number_of_tails )  THEN
+!          WRITE (9,*) '--- advec_particles: #3'
+!          WRITE (9,*) '    #of p=',number_of_particles,' #of t=',number_of_tails
+!          CALL FLUSH_( 9 )
+!       ENDIF
+
+!
+!--       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 )
+
+          IF ( number_of_particles + trlp_count_recv > &
+               maximum_number_of_particles )           &
+          THEN
+             IF ( netcdf_output )  THEN
+                PRINT*, '+++ advec_particles:  maximum_number_of_particles ', &
+                                               'needs to be increased'
+                PRINT*, '                      but this is not allowed with ', &
+                                               'NetCDF output switched on'
+                CALL MPI_ABORT( comm2d, 9999, ierr )
+             ELSE
+!    WRITE ( 9, * ) '*** advec_particles: before allocate_prt_memory trlp'
+!    CALL FLUSH_( 9 )
+                CALL allocate_prt_memory( trlp_count_recv )
+!    WRITE ( 9, * ) '*** advec_particles: after allocate_prt_memory trlp'
+!    CALL FLUSH_( 9 )
+             ENDIF
+          ENDIF
+
+          CALL MPI_SENDRECV( trrp, trrp_count, mpi_particle_type, pright, 1,   &
+                             particles(number_of_particles+1), trlp_count_recv,&
+                             mpi_particle_type, pleft, 1,                      &
+                             comm2d, status, ierr )
+
+          IF ( use_particle_tails )  THEN
+
+             CALL MPI_SENDRECV( trrpt_count,      1, MPI_INTEGER, pright, 0, &
+                                trlpt_count_recv, 1, MPI_INTEGER, pleft,  0, &
+                                comm2d, status, ierr )
+
+             IF ( number_of_tails+trlpt_count_recv > maximum_number_of_tails ) &
+             THEN
+                IF ( netcdf_output )  THEN
+                   PRINT*, '+++ advec_particles:  maximum_number_of_tails ', &
+                                                  'needs to be increased'
+                   PRINT*, '                      but this is not allowed wi', &
+                                                  'th NetCDF output switched on'
+                   CALL MPI_ABORT( comm2d, 9999, ierr )
+                ELSE
+!    WRITE ( 9, * ) '*** advec_particles: before allocate_tail_memory trlpt'
+!    CALL FLUSH_( 9 )
+                   CALL allocate_tail_memory( trlpt_count_recv )
+!    WRITE ( 9, * ) '*** advec_particles: after allocate_tail_memory trlpt'
+!    CALL FLUSH_( 9 )
+                ENDIF
+             ENDIF
+
+             CALL MPI_SENDRECV( trrpt, trrpt_count*tlength, MPI_REAL, pright,  &
+                          1, particle_tail_coordinates(1,1,number_of_tails+1), &
+                                trlpt_count_recv*tlength, MPI_REAL, pleft, 1,  &
+                                comm2d, status, ierr )
+!
+!--          Update the tail ids for the transferred particles
+             nn = number_of_tails
+             DO  n = number_of_particles+1, number_of_particles+trlp_count_recv
+                IF ( particles(n)%tail_id /= 0 )  THEN
+                   nn = nn + 1
+                   particles(n)%tail_id = nn
+                ENDIF
+             ENDDO
+
+          ENDIF
+
+          number_of_particles = number_of_particles + trlp_count_recv
+          number_of_tails     = number_of_tails     + trlpt_count_recv
+!       IF ( number_of_particles /= number_of_tails )  THEN
+!          WRITE (9,*) '--- advec_particles: #4'
+!          WRITE (9,*) '    #of p=',number_of_particles,' #of t=',number_of_tails
+!          CALL FLUSH_( 9 )
+!       ENDIF
+
+          IF ( use_particle_tails )  THEN
+             DEALLOCATE( trlpt, trrpt )
+          ENDIF
+          DEALLOCATE( trlp, trrp ) 
+
+          CALL cpu_log( log_point_s(23), 'sendrcv_particles', 'pause' )
+
+       ENDIF
+
+!    WRITE ( 9, * ) '*** advec_particles: ##3'
+!    CALL FLUSH_( 9 )
+!    nd = 0
+!    DO  n = 1, number_of_particles
+!       IF ( .NOT. particle_mask(n) )  nd = nd + 1
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+!    IF ( nd /= deleted_particles ) THEN
+!       WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+!       CALL FLUSH_( 9 )
+!       CALL MPI_ABORT( comm2d, 9999, ierr )
+!    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  = 0
+       trspt_count = 0
+       trnp_count  = 0
+       trnpt_count = 0
+       IF ( pdims(2) /= 1 )  THEN
+!
+!--       First calculate the storage necessary for sending and receiving the
+!--       data
+          DO  n = 1, number_of_particles
+             IF ( particle_mask(n) )  THEN
+	        j = ( particles(n)%y + 0.5 * dy ) * ddy
+!
+!--             Above calculation does not work for indices less than zero
+	        IF ( particles(n)%y < -0.5 * dy )  j = -1
+
+                IF ( j < nys )  THEN
+                   trsp_count = trsp_count + 1
+                   IF ( particles(n)%tail_id /= 0 )  trspt_count = trspt_count+1
+                ELSEIF ( j > nyn )  THEN
+                   trnp_count = trnp_count + 1
+                   IF ( particles(n)%tail_id /= 0 )  trnpt_count = trnpt_count+1
+                ENDIF
+             ENDIF
+          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 = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+                                0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+                                0, 0, 0, 0 )
+          trnp = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+                                0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+                                0, 0, 0, 0 )
+
+          IF ( use_particle_tails )  THEN
+             ALLOCATE( trspt(maximum_number_of_tailpoints,5,trspt_count), &
+                       trnpt(maximum_number_of_tailpoints,5,trnpt_count) )
+             tlength = maximum_number_of_tailpoints * 5
+          ENDIF
+
+          trsp_count  = 0
+          trspt_count = 0
+          trnp_count  = 0
+          trnpt_count = 0
+
+       ENDIF
+
+!    WRITE ( 9, * ) '*** advec_particles: ##4'
+!    CALL FLUSH_( 9 )
+!    nd = 0
+!    DO  n = 1, number_of_particles
+!       IF ( .NOT. particle_mask(n) )  nd = nd + 1
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+!    IF ( nd /= deleted_particles ) THEN
+!       WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+!       CALL FLUSH_( 9 )
+!       CALL MPI_ABORT( comm2d, 9999, ierr )
+!    ENDIF
+
+       DO  n = 1, number_of_particles
+
+          nn = particles(n)%tail_id
+!
+!--       Only those particles that have not been marked as 'deleted' may be 
+!--       moved.
+          IF ( particle_mask(n) )  THEN
+	     j = ( particles(n)%y + 0.5 * dy ) * ddy
+!
+!--          Above calculation does not work for indices less than zero
+	     IF ( particles(n)%y < -0.5 * 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
+                         IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                            i = particles(n)%tailpoints
+                            particle_tail_coordinates(1:i,2,nn) = ( ny+1 ) * dy&
+                                           + particle_tail_coordinates(1:i,2,nn)
+                         ENDIF
+                      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
+                         particle_mask(n) = .FALSE.
+                         deleted_particles = deleted_particles + 1
+
+                         IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                            trspt_count = trspt_count + 1
+                            trspt(:,:,trspt_count) = &
+                                               particle_tail_coordinates(:,:,nn)
+                            trspt(:,2,trspt_count) = ( ny + 1 ) * dy + &
+                                                     trspt(:,2,trspt_count)
+                            tail_mask(nn) = .FALSE.
+                            deleted_tails = deleted_tails + 1
+                         ENDIF
+                      ENDIF
+
+                   ELSEIF ( ibc_par_ns == 1 )  THEN
+!
+!--                   Particle absorption
+                      particle_mask(n) = .FALSE.
+                      deleted_particles = deleted_particles + 1
+                      IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                         tail_mask(nn) = .FALSE.
+                         deleted_tails = deleted_tails + 1
+                      ENDIF
+
+                   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)
+                   particle_mask(n) = .FALSE.
+                   deleted_particles = deleted_particles + 1
+
+                   IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                      trspt_count = trspt_count + 1
+                      trspt(:,:,trspt_count) = particle_tail_coordinates(:,:,nn)
+                      tail_mask(nn) = .FALSE.
+                      deleted_tails = deleted_tails + 1
+                   ENDIF
+                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
+                         IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                            i = particles(n)%tailpoints
+                            particle_tail_coordinates(1:i,2,nn) = - (ny+1) * dy&
+                                           + particle_tail_coordinates(1:i,2,nn)
+                         ENDIF
+                      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
+                         particle_mask(n) = .FALSE.
+                         deleted_particles = deleted_particles + 1
+
+                         IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                            trnpt_count = trnpt_count + 1
+                            trnpt(:,:,trnpt_count) = &
+                                               particle_tail_coordinates(:,:,nn)
+                            trnpt(:,2,trnpt_count) = trnpt(:,2,trnpt_count) - &
+                                                     ( ny + 1 ) * dy
+                            tail_mask(nn) = .FALSE.
+                            deleted_tails = deleted_tails + 1
+                         ENDIF
+                      ENDIF
+
+                   ELSEIF ( ibc_par_ns == 1 )  THEN
+!
+!--                   Particle absorption
+                      particle_mask(n) = .FALSE.
+                      deleted_particles = deleted_particles + 1
+                      IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                         tail_mask(nn) = .FALSE.
+                         deleted_tails = deleted_tails + 1
+                      ENDIF
+
+                   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)
+                   particle_mask(n) = .FALSE.
+                   deleted_particles = deleted_particles + 1
+
+                   IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                      trnpt_count = trnpt_count + 1
+                      trnpt(:,:,trnpt_count) = particle_tail_coordinates(:,:,nn)
+                      tail_mask(nn) = .FALSE.
+                      deleted_tails = deleted_tails + 1
+                   ENDIF
+                ENDIF
+
+             ENDIF
+          ENDIF
+       ENDDO
+
+!    WRITE ( 9, * ) '*** advec_particles: ##5'
+!    CALL FLUSH_( 9 )
+!    nd = 0
+!    DO  n = 1, number_of_particles
+!       IF ( .NOT. particle_mask(n) )  nd = nd + 1
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+!    IF ( nd /= deleted_particles ) THEN
+!       WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+!       CALL FLUSH_( 9 )
+!       CALL MPI_ABORT( comm2d, 9999, ierr )
+!    ENDIF
+
+!
+!--    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 cpu_log( log_point_s(23), 'sendrcv_particles', 'continue' )
+          CALL MPI_SENDRECV( trsp_count,      1, MPI_INTEGER, psouth, 0, &
+                             trnp_count_recv, 1, MPI_INTEGER, pnorth, 0, &
+                             comm2d, status, ierr )
+
+          IF ( number_of_particles + trnp_count_recv > &
+               maximum_number_of_particles )           &
+          THEN
+             IF ( netcdf_output )  THEN
+                PRINT*, '+++ advec_particles:  maximum_number_of_particles ', &
+                                               'needs to be increased'
+                PRINT*, '                      but this is not allowed with ', &
+                                               'NetCDF output switched on'
+                CALL MPI_ABORT( comm2d, 9999, ierr )
+             ELSE
+!    WRITE ( 9, * ) '*** advec_particles: before allocate_prt_memory trnp'
+!    CALL FLUSH_( 9 )
+                CALL allocate_prt_memory( trnp_count_recv )
+!    WRITE ( 9, * ) '*** advec_particles: after allocate_prt_memory trnp'
+!    CALL FLUSH_( 9 )
+             ENDIF
+          ENDIF
+
+          CALL MPI_SENDRECV( trsp, trsp_count, mpi_particle_type, psouth, 1,   &
+                             particles(number_of_particles+1), trnp_count_recv,&
+                             mpi_particle_type, pnorth, 1,                     &
+                             comm2d, status, ierr )
+
+          IF ( use_particle_tails )  THEN
+
+             CALL MPI_SENDRECV( trspt_count,      1, MPI_INTEGER, pleft,  0, &
+                                trnpt_count_recv, 1, MPI_INTEGER, pright, 0, &
+                                comm2d, status, ierr )
+
+             IF ( number_of_tails+trnpt_count_recv > maximum_number_of_tails ) &
+             THEN
+                IF ( netcdf_output )  THEN
+                   PRINT*, '+++ advec_particles:  maximum_number_of_tails ', &
+                                                  'needs to be increased'
+                   PRINT*, '                      but this is not allowed wi', &
+                                                  'th NetCDF output switched on'
+                   CALL MPI_ABORT( comm2d, 9999, ierr )
+                ELSE
+!    WRITE ( 9, * ) '*** advec_particles: before allocate_tail_memory trnpt'
+!    CALL FLUSH_( 9 )
+                   CALL allocate_tail_memory( trnpt_count_recv )
+!    WRITE ( 9, * ) '*** advec_particles: after allocate_tail_memory trnpt'
+!    CALL FLUSH_( 9 )
+                ENDIF
+             ENDIF
+
+             CALL MPI_SENDRECV( trspt, trspt_count*tlength, MPI_REAL, psouth,  &
+                          1, particle_tail_coordinates(1,1,number_of_tails+1), &
+                                trnpt_count_recv*tlength, MPI_REAL, pnorth, 1, &
+                                comm2d, status, ierr )
+!
+!--          Update the tail ids for the transferred particles
+             nn = number_of_tails
+             DO  n = number_of_particles+1, number_of_particles+trnp_count_recv
+                IF ( particles(n)%tail_id /= 0 )  THEN
+                   nn = nn + 1
+                   particles(n)%tail_id = nn
+                ENDIF
+             ENDDO
+
+          ENDIF
+
+          number_of_particles = number_of_particles + trnp_count_recv
+          number_of_tails     = number_of_tails     + trnpt_count_recv
+!       IF ( number_of_particles /= number_of_tails )  THEN
+!          WRITE (9,*) '--- advec_particles: #5'
+!          WRITE (9,*) '    #of p=',number_of_particles,' #of t=',number_of_tails
+!          CALL FLUSH_( 9 )
+!       ENDIF
+
+!
+!--       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 )
+
+          IF ( number_of_particles + trsp_count_recv > &
+               maximum_number_of_particles )           &
+          THEN
+             IF ( netcdf_output )  THEN
+                PRINT*, '+++ advec_particles:  maximum_number_of_particles ', &
+                                               'needs to be increased'
+                PRINT*, '                      but this is not allowed with ', &
+                                               'NetCDF output switched on'
+                CALL MPI_ABORT( comm2d, 9999, ierr )
+             ELSE
+!    WRITE ( 9, * ) '*** advec_particles: before allocate_prt_memory trsp'
+!    CALL FLUSH_( 9 )
+                CALL allocate_prt_memory( trsp_count_recv )
+!    WRITE ( 9, * ) '*** advec_particles: after allocate_prt_memory trsp'
+!    CALL FLUSH_( 9 )
+             ENDIF
+          ENDIF
+
+          CALL MPI_SENDRECV( trnp, trnp_count, mpi_particle_type, pnorth, 1,   &
+                             particles(number_of_particles+1), trsp_count_recv,&
+                             mpi_particle_type, psouth, 1,                     &
+                             comm2d, status, ierr )
+
+          IF ( use_particle_tails )  THEN
+
+             CALL MPI_SENDRECV( trnpt_count,      1, MPI_INTEGER, pright, 0, &
+                                trspt_count_recv, 1, MPI_INTEGER, pleft,  0, &
+                                comm2d, status, ierr )
+
+             IF ( number_of_tails+trspt_count_recv > maximum_number_of_tails ) &
+             THEN
+                IF ( netcdf_output )  THEN
+                   PRINT*, '+++ advec_particles:  maximum_number_of_tails ', &
+                                                  'needs to be increased'
+                   PRINT*, '                      but this is not allowed wi', &
+                                                  'th NetCDF output switched on'
+                   CALL MPI_ABORT( comm2d, 9999, ierr )
+                ELSE
+!    WRITE ( 9, * ) '*** advec_particles: before allocate_tail_memory trspt'
+!    CALL FLUSH_( 9 )
+                   CALL allocate_tail_memory( trspt_count_recv )
+!    WRITE ( 9, * ) '*** advec_particles: after allocate_tail_memory trspt'
+!    CALL FLUSH_( 9 )
+                ENDIF
+             ENDIF
+
+             CALL MPI_SENDRECV( trnpt, trnpt_count*tlength, MPI_REAL, pnorth,  &
+                          1, particle_tail_coordinates(1,1,number_of_tails+1), &
+                                trspt_count_recv*tlength, MPI_REAL, psouth, 1, &
+                                comm2d, status, ierr )
+!
+!--          Update the tail ids for the transferred particles
+             nn = number_of_tails
+             DO  n = number_of_particles+1, number_of_particles+trsp_count_recv
+                IF ( particles(n)%tail_id /= 0 )  THEN
+                   nn = nn + 1
+                   particles(n)%tail_id = nn
+                ENDIF
+             ENDDO
+
+          ENDIF
+
+          number_of_particles = number_of_particles + trsp_count_recv
+          number_of_tails     = number_of_tails     + trspt_count_recv
+!       IF ( number_of_particles /= number_of_tails )  THEN
+!          WRITE (9,*) '--- advec_particles: #6'
+!          WRITE (9,*) '    #of p=',number_of_particles,' #of t=',number_of_tails
+!          CALL FLUSH_( 9 )
+!       ENDIF
+
+          IF ( use_particle_tails )  THEN
+             DEALLOCATE( trspt, trnpt )
+          ENDIF
+          DEALLOCATE( trsp, trnp )
+
+          CALL cpu_log( log_point_s(23), 'sendrcv_particles', 'stop' )
+
+       ENDIF
+
+!    WRITE ( 9, * ) '*** advec_particles: ##6'
+!    CALL FLUSH_( 9 )
+!    nd = 0
+!    DO  n = 1, number_of_particles
+!       IF ( .NOT. particle_mask(n) )  nd = nd + 1
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+!    IF ( nd /= deleted_particles ) THEN
+!       WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+!       CALL FLUSH_( 9 )
+!       CALL MPI_ABORT( comm2d, 9999, ierr )
+!    ENDIF
+
+#else
+
+!
+!--    Apply boundary conditions
+       DO  n = 1, number_of_particles
+
+          nn = particles(n)%tail_id
+
+          IF ( particles(n)%x < -0.5 * 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
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   i = particles(n)%tailpoints
+                   particle_tail_coordinates(1:i,1,nn) = ( nx + 1 ) * dx + &
+                                             particle_tail_coordinates(1:i,1,nn)
+                ENDIF
+             ELSEIF ( ibc_par_lr == 1 )  THEN
+!
+!--             Particle absorption
+                particle_mask(n) = .FALSE.
+                deleted_particles = deleted_particles + 1
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   tail_mask(nn) = .FALSE.
+                   deleted_tails = deleted_tails + 1
+                ENDIF
+             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 ) * 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
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   i = particles(n)%tailpoints
+                   particle_tail_coordinates(1:i,1,nn) = - ( nx + 1 ) * dx + &
+                                             particle_tail_coordinates(1:i,1,nn)
+                ENDIF
+             ELSEIF ( ibc_par_lr == 1 )  THEN
+!
+!--             Particle absorption
+                particle_mask(n) = .FALSE.
+                deleted_particles = deleted_particles + 1
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   tail_mask(nn) = .FALSE.
+                   deleted_tails = deleted_tails + 1
+                ENDIF
+             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 * 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
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   i = particles(n)%tailpoints
+                   particle_tail_coordinates(1:i,2,nn) = ( ny + 1 ) * dy + &
+                                             particle_tail_coordinates(1:i,2,nn)
+                ENDIF
+             ELSEIF ( ibc_par_ns == 1 )  THEN
+!
+!--             Particle absorption
+                particle_mask(n) = .FALSE.
+                deleted_particles = deleted_particles + 1
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   tail_mask(nn) = .FALSE.
+                   deleted_tails = deleted_tails + 1
+                ENDIF
+             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 ) * 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
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   i = particles(n)%tailpoints
+                   particle_tail_coordinates(1:i,2,nn) = - ( ny + 1 ) * dy + &
+                                             particle_tail_coordinates(1:i,2,nn)
+                ENDIF
+             ELSEIF ( ibc_par_ns == 1 )  THEN
+!
+!--             Particle absorption
+                particle_mask(n) = .FALSE.
+                deleted_particles = deleted_particles + 1
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   tail_mask(nn) = .FALSE.
+                   deleted_tails = deleted_tails + 1
+                ENDIF
+             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
+
+!
+!--    Apply boundary conditions to those particles that have crossed the top or
+!--    bottom boundary and delete those particles, which are older than allowed
+       DO  n = 1, number_of_particles
+
+          nn = particles(n)%tail_id
+
+          IF ( particles(n)%age > particle_maximum_age  .AND.  &
+               particle_mask(n) )                              &
+          THEN
+             particle_mask(n)  = .FALSE.
+             deleted_particles = deleted_particles + 1
+             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                tail_mask(nn) = .FALSE.
+                deleted_tails = deleted_tails + 1
+             ENDIF
+          ENDIF
+
+          IF ( particles(n)%z >= zu(nz)  .AND.  particle_mask(n) )  THEN
+             IF ( ibc_par_t == 1 )  THEN
+!
+!--             Particle absorption
+                particle_mask(n)  = .FALSE.
+                deleted_particles = deleted_particles + 1
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   tail_mask(nn) = .FALSE.
+                   deleted_tails = deleted_tails + 1
+                ENDIF
+             ELSEIF ( ibc_par_t == 2 )  THEN
+!
+!--             Particle reflection
+                particles(n)%z       = 2.0 * zu(nz) - particles(n)%z
+                particles(n)%speed_z = -particles(n)%speed_z
+                IF ( use_sgs_for_particles  .AND. &
+                     particles(n)%speed_z_sgs > 0.0 )  THEN
+                   particles(n)%speed_z_sgs = -particles(n)%speed_z_sgs
+                ENDIF
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   particle_tail_coordinates(1,3,nn) = 2.0 * zu(nz) - &
+                                               particle_tail_coordinates(1,3,nn)
+                ENDIF
+             ENDIF
+          ENDIF
+          IF ( particles(n)%z < 0.0  .AND.  particle_mask(n) )  THEN
+             IF ( ibc_par_b == 1 )  THEN
+!
+!--             Particle absorption
+                particle_mask(n)  = .FALSE.
+                deleted_particles = deleted_particles + 1
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   tail_mask(nn) = .FALSE.
+                   deleted_tails = deleted_tails + 1
+                ENDIF
+             ELSEIF ( ibc_par_b == 2 )  THEN
+!
+!--             Particle reflection
+                particles(n)%z       = -particles(n)%z
+                particles(n)%speed_z = -particles(n)%speed_z
+                IF ( use_sgs_for_particles  .AND. &
+                     particles(n)%speed_z_sgs < 0.0 )  THEN
+                   particles(n)%speed_z_sgs = -particles(n)%speed_z_sgs
+                ENDIF
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   particle_tail_coordinates(1,3,nn) = 2.0 * zu(nz) - &
+                                               particle_tail_coordinates(1,3,nn)
+                ENDIF
+                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
+                   particle_tail_coordinates(1,3,nn) = &
+                                              -particle_tail_coordinates(1,3,nn)
+                ENDIF
+             ENDIF
+          ENDIF
+       ENDDO
+
+!    WRITE ( 9, * ) '*** advec_particles: ##7'
+!    CALL FLUSH_( 9 )
+!    nd = 0
+!    DO  n = 1, number_of_particles
+!       IF ( .NOT. particle_mask(n) )  nd = nd + 1
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+!    IF ( nd /= deleted_particles ) THEN
+!       WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+!       CALL FLUSH_( 9 )
+!       CALL MPI_ABORT( comm2d, 9999, ierr )
+!    ENDIF
+
+!
+!--    Pack particles (eliminate those marked for deletion),
+!--    determine new number of particles
+       IF ( number_of_particles > 0  .AND.  deleted_particles > 0 )  THEN
+          nn = 0
+          nd = 0
+          DO  n = 1, number_of_particles
+             IF ( particle_mask(n) )  THEN
+                nn = nn + 1
+                particles(nn) = particles(n)
+             ELSE
+                nd = nd + 1
+             ENDIF
+          ENDDO
+!       IF ( nd /= deleted_particles ) THEN
+!          WRITE (9,*) '*** advec_part nd=',nd,' deleted_particles=',deleted_particles
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+
+          number_of_particles = number_of_particles - deleted_particles
+!
+!--       Pack the tails, store the new tail ids and re-assign it to the
+!--       respective
+!--       particles
+          IF ( use_particle_tails )  THEN
+             nn = 0
+             nd = 0
+             DO  n = 1, number_of_tails
+                IF ( tail_mask(n) )  THEN
+                   nn = nn + 1
+                   particle_tail_coordinates(:,:,nn) = &
+                                                particle_tail_coordinates(:,:,n)
+                   new_tail_id(n) = nn
+                ELSE
+                   nd = nd + 1
+!                WRITE (9,*) '+++ n=',n,' (of ',number_of_tails,' #oftails)'
+!                WRITE (9,*) '    id=',new_tail_id(n)
+!                CALL FLUSH_( 9 )
+                ENDIF
+             ENDDO
+          ENDIF
+
+!       IF ( nd /= deleted_tails  .AND.  use_particle_tails ) THEN
+!          WRITE (9,*) '*** advec_part nd=',nd,' deleted_tails=',deleted_tails
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+
+          number_of_tails = number_of_tails - deleted_tails
+
+!     nn = 0
+          DO  n = 1, number_of_particles
+             IF ( particles(n)%tail_id /= 0 )  THEN
+!     nn = nn + 1
+!     IF (  particles(n)%tail_id<0 .OR. particles(n)%tail_id > number_of_tails )  THEN
+!        WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!        WRITE (9,*) '    tail_id=',particles(n)%tail_id
+!        WRITE (9,*) '    new_tail_id=', new_tail_id(particles(n)%tail_id), &
+!                         ' of (',number_of_tails,')'
+!        CALL FLUSH_( 9 )
+!     ENDIF
+                particles(n)%tail_id = new_tail_id(particles(n)%tail_id)
+             ENDIF
+          ENDDO
+
+!     IF ( nn /= number_of_tails  .AND.  use_particle_tails ) THEN
+!        WRITE (9,*) '*** advec_part #of_tails=',number_of_tails,' nn=',nn
+!        CALL FLUSH_( 9 )
+!        DO  n = 1, number_of_particles
+!           WRITE (9,*) 'prt# ',n,' tail_id=',particles(n)%tail_id, &
+!                       ' x=',particles(n)%x, ' y=',particles(n)%y, &
+!                       ' z=',particles(n)%z
+!        ENDDO
+!        CALL MPI_ABORT( comm2d, 9999, ierr )
+!     ENDIF
+
+       ENDIF
+
+!    IF ( number_of_particles /= number_of_tails )  THEN
+!       WRITE (9,*) '--- advec_particles: #7'
+!       WRITE (9,*) '    #of p=',number_of_particles,' #of t=',number_of_tails
+!       CALL FLUSH_( 9 )
+!    ENDIF
+!    WRITE ( 9, * ) '*** advec_particles: ##8'
+!    CALL FLUSH_( 9 )
+!    DO  n = 1, number_of_particles
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+
+!
+!--    Sort particles in the sequence the gridboxes are stored in the memory
+       CALL sort_particles
+
+!    WRITE ( 9, * ) '*** advec_particles: ##9'
+!    CALL FLUSH_( 9 )
+!    DO  n = 1, number_of_particles
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+
+!
+!--    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
+
+       IF ( dt_3d_reached )  EXIT
+
+    ENDDO   ! timestep loop
+
+
+!
+!-- Re-evaluate the weighting factors. After advection, particles within a
+!-- grid box may have different weighting factors if some have been advected
+!-- from a neighbouring box. The factors are re-evaluated so that they are
+!-- the same for all particles of one box. This procedure must conserve the
+!-- liquid water content within one box.
+    IF ( cloud_droplets )  THEN
+
+       CALL cpu_log( log_point_s(45), 'advec_part_reeval_we', 'start' )
+
+       ql = 0.0;  ql_v = 0.0;  ql_vp = 0.0
+
+!
+!--    Re-calculate the weighting factors and calculate the liquid water content
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb, nzt+1
+
+!
+!--             Calculate the total volume of particles in the boxes (ql_vp) as
+!--             well as the real volume (ql_v, weighting factor has to be
+!--             included)
+                psi = prt_start_index(k,j,i)
+                DO  n = psi, psi+prt_count(k,j,i)-1
+                   ql_vp(k,j,i) = ql_vp(k,j,i) + particles(n)%radius**3
+
+                   ql_v(k,j,i)  = ql_v(k,j,i)  + particles(n)%weight_factor * &
+                                                 particles(n)%radius**3
+                ENDDO
+
+!
+!--             Re-calculate the weighting factors and calculate the liquid
+!--             water content
+                IF ( ql_vp(k,j,i) /= 0.0 )  THEN
+                   ql_vp(k,j,i) = ql_v(k,j,i) / ql_vp(k,j,i)
+                   ql(k,j,i) = ql(k,j,i) + rho_l * 1.33333333 * pi * &
+                                           ql_v(k,j,i) /             &
+                                           ( rho_surface * dx * dy * dz )
+                ELSE
+                   ql(k,j,i) = 0.0
+                ENDIF
+
+!
+!--             Re-assign the weighting factor to the particles
+                DO  n = psi, psi+prt_count(k,j,i)-1
+                   particles(n)%weight_factor = ql_vp(k,j,i)
+                ENDDO
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+       CALL cpu_log( log_point_s(45), 'advec_part_reeval_we', 'stop' )
+
+    ENDIF
+
+!
+!-- Set particle attributes defined by the user
+    CALL user_particle_attributes
+!    WRITE ( 9, * ) '*** advec_particles: ##10'
+!    CALL FLUSH_( 9 )
+!    DO  n = 1, number_of_particles
+!       IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+!       THEN
+!          WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+!          WRITE (9,*) '    id=',particles(n)%tail_id,' of (',number_of_tails,')'
+!          CALL FLUSH_( 9 )
+!          CALL MPI_ABORT( comm2d, 9999, ierr )
+!       ENDIF
+!    ENDDO
+
+!
+!-- If necessary, add the actual particle positions to the particle tails
+    IF ( use_particle_tails )  THEN
+
+       distance = 0.0
+       DO  n = 1, number_of_particles
+
+          nn = particles(n)%tail_id
+
+          IF ( nn /= 0 )  THEN
+!
+!--          Calculate the distance between the actual particle position and the
+!--          next tailpoint
+!             WRITE ( 9, * ) '*** advec_particles: ##10.1  nn=',nn
+!             CALL FLUSH_( 9 )
+             IF ( minimum_tailpoint_distance /= 0.0 )  THEN
+                distance = ( particle_tail_coordinates(1,1,nn) -      &
+                             particle_tail_coordinates(2,1,nn) )**2 + &
+                           ( particle_tail_coordinates(1,2,nn) -      &
+                             particle_tail_coordinates(2,2,nn) )**2 + &
+                           ( particle_tail_coordinates(1,3,nn) -      &
+                             particle_tail_coordinates(2,3,nn) )**2
+             ENDIF
+!             WRITE ( 9, * ) '*** advec_particles: ##10.2'
+!             CALL FLUSH_( 9 )
+!
+!--          First, increase the index of all existings tailpoints by one
+             IF ( distance >= minimum_tailpoint_distance )  THEN
+                DO i = particles(n)%tailpoints, 1, -1
+                   particle_tail_coordinates(i+1,:,nn) = &
+                                               particle_tail_coordinates(i,:,nn)
+                ENDDO
+!
+!--             Increase the counter which contains the number of tailpoints.
+!--             This must always be smaller than the given maximum number of
+!--             tailpoints because otherwise the index bounds of
+!--             particle_tail_coordinates would be exceeded
+                IF ( particles(n)%tailpoints < maximum_number_of_tailpoints-1 )&
+                THEN
+                   particles(n)%tailpoints = particles(n)%tailpoints + 1
+                ENDIF
+             ENDIF
+!             WRITE ( 9, * ) '*** advec_particles: ##10.3'
+!             CALL FLUSH_( 9 )
+!
+!--          In any case, store the new point at the beginning of the tail
+             particle_tail_coordinates(1,1,nn) = particles(n)%x
+             particle_tail_coordinates(1,2,nn) = particles(n)%y
+             particle_tail_coordinates(1,3,nn) = particles(n)%z
+             particle_tail_coordinates(1,4,nn) = particles(n)%color
+!             WRITE ( 9, * ) '*** advec_particles: ##10.4'
+!             CALL FLUSH_( 9 )
+!
+!--          Increase the age of the tailpoints
+             IF ( minimum_tailpoint_distance /= 0.0 )  THEN
+                particle_tail_coordinates(2:particles(n)%tailpoints,5,nn) =    &
+                   particle_tail_coordinates(2:particles(n)%tailpoints,5,nn) + &
+                   dt_3d
+!
+!--             Delete the last tailpoint, if it has exceeded its maximum age
+                IF ( particle_tail_coordinates(particles(n)%tailpoints,5,nn) > &
+                     maximum_tailpoint_age )  THEN
+                   particles(n)%tailpoints = particles(n)%tailpoints - 1
+                ENDIF
+             ENDIF
+!             WRITE ( 9, * ) '*** advec_particles: ##10.5'
+!             CALL FLUSH_( 9 )
+
+          ENDIF
+
+       ENDDO
+
+    ENDIF
+!    WRITE ( 9, * ) '*** advec_particles: ##11'
+!    CALL FLUSH_( 9 )
+
+!
+!-- Write particle statistics on file
+    IF ( write_particle_statistics )  THEN
+       CALL check_open( 80 )
+#if defined( __parallel )
+       WRITE ( 80, 8000 )  current_timestep_number+1, simulated_time+dt_3d, &
+                           number_of_particles, pleft, trlp_count_sum,      &
+                           trlp_count_recv_sum, pright, trrp_count_sum,     &
+                           trrp_count_recv_sum, psouth, trsp_count_sum,     &
+                           trsp_count_recv_sum, pnorth, trnp_count_sum,     &
+                           trnp_count_recv_sum, maximum_number_of_particles
+       CALL close_file( 80 )
+#else
+       WRITE ( 80, 8000 )  current_timestep_number+1, simulated_time+dt_3d, &
+                           number_of_particles, maximum_number_of_particles
+#endif
+    ENDIF
+
+    CALL cpu_log( log_point(25), 'advec_particles', 'stop' )
+
+!
+!-- Formats
+8000 FORMAT (I6,1X,F7.2,4X,I6,5X,4(I3,1X,I4,'/',I4,2X),6X,I6)
+
+#endif
+ END SUBROUTINE advec_particles
+
+
+ SUBROUTINE allocate_prt_memory( number_of_new_particles )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Extend particle memory
+!------------------------------------------------------------------------------!
+#if defined( __particles )
+
+    USE particle_attributes
+
+    IMPLICIT NONE
+
+    INTEGER ::  new_maximum_number, number_of_new_particles
+
+    LOGICAL, DIMENSION(:), ALLOCATABLE ::  tmp_particle_mask
+
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  tmp_particles
+
+
+    new_maximum_number = maximum_number_of_particles + &
+                   MAX( 5*number_of_new_particles, number_of_initial_particles )
+
+    IF ( write_particle_statistics )  THEN
+       CALL check_open( 80 )
+       WRITE ( 80, '(''*** Request: '', I7, '' new_maximum_number(prt)'')' ) &
+                            new_maximum_number
+       CALL close_file( 80 )
+    ENDIF
+
+    ALLOCATE( tmp_particles(maximum_number_of_particles), &
+              tmp_particle_mask(maximum_number_of_particles) )
+    tmp_particles     = particles
+    tmp_particle_mask = particle_mask
+
+    DEALLOCATE( particles, particle_mask )
+    ALLOCATE( particles(new_maximum_number), &
+              particle_mask(new_maximum_number) )
+    maximum_number_of_particles = new_maximum_number
+
+    particles(1:number_of_particles) = tmp_particles(1:number_of_particles)
+    particle_mask(1:number_of_particles) = &
+                                  tmp_particle_mask(1:number_of_particles)
+    particle_mask(number_of_particles+1:maximum_number_of_particles) = .TRUE.
+    DEALLOCATE( tmp_particles, tmp_particle_mask )
+
+#endif
+ END SUBROUTINE allocate_prt_memory
+
+
+ SUBROUTINE allocate_tail_memory( number_of_new_tails )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Extend tail memory
+!------------------------------------------------------------------------------!
+#if defined( __particles )
+
+    USE particle_attributes
+
+    IMPLICIT NONE
+
+    INTEGER ::  new_maximum_number, number_of_new_tails
+
+    LOGICAL, DIMENSION(maximum_number_of_tails) ::  tmp_tail_mask
+
+    REAL, DIMENSION(maximum_number_of_tailpoints,5,maximum_number_of_tails) :: &
+                                                    tmp_tail
+
+
+    new_maximum_number = maximum_number_of_tails + &
+                         MAX( 5*number_of_new_tails, number_of_initial_tails )
+
+    IF ( write_particle_statistics )  THEN
+       CALL check_open( 80 )
+       WRITE ( 80, '(''*** Request: '', I5, '' new_maximum_number(tails)'')' ) &
+                            new_maximum_number
+       CALL close_file( 80 )
+    ENDIF
+    WRITE (9,*) '*** Request: ',new_maximum_number,' new_maximum_number(tails)'
+    CALL FLUSH_( 9 )
+
+    tmp_tail(:,:,1:number_of_tails)  = &
+                                particle_tail_coordinates(:,:,1:number_of_tails)
+    tmp_tail_mask(1:number_of_tails) = tail_mask(1:number_of_tails)
+
+    DEALLOCATE( new_tail_id, particle_tail_coordinates, tail_mask )
+    ALLOCATE( new_tail_id(new_maximum_number),                          &
+              particle_tail_coordinates(maximum_number_of_tailpoints,5, &
+              new_maximum_number),                                      &
+              tail_mask(new_maximum_number) )
+    maximum_number_of_tails = new_maximum_number
+
+    particle_tail_coordinates = 0.0
+    particle_tail_coordinates(:,:,1:number_of_tails) = &
+                                                 tmp_tail(:,:,1:number_of_tails)
+    tail_mask(1:number_of_tails) = tmp_tail_mask(1:number_of_tails)
+    tail_mask(number_of_tails+1:maximum_number_of_tails) = .TRUE.
+
+#endif
+ END SUBROUTINE allocate_tail_memory
+
+
+ SUBROUTINE output_particles_netcdf
+#if defined( __netcdf )
+
+    USE control_parameters
+    USE netcdf_control
+    USE particle_attributes
+
+    IMPLICIT NONE
+
+
+    CALL check_open( 108 )
+
+!
+!-- Update the NetCDF time axis
+    prt_time_count = prt_time_count + 1
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_time_prt, (/ simulated_time /), &
+                            start = (/ prt_time_count /), count = (/ 1 /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 1 )
+
+!
+!-- Output the real number of particles used
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_rnop_prt, &
+                            (/ number_of_particles /),   &
+                            start = (/ prt_time_count /), count = (/ 1 /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 2 )
+
+!
+!-- Output all particle attributes
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(1), particles%age,         &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 3 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(2), particles%dvrp_psize,  &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 4 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(3), particles%origin_x,    &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 5 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(4), particles%origin_y,    &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 6 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(5), particles%origin_z,    &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 7 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(6), particles%radius,      &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 8 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(7), particles%speed_x,     &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 9 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(8), particles%speed_y,     &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 10 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(9), particles%speed_z,     &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 11 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt,id_var_prt(10),particles%weight_factor,&
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 12 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(11), particles%x,           &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 13 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(12), particles%y,          & 
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 14 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(13), particles%z,          &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 15 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(14), particles%color,      &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 16 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(15), particles%group,      &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 17 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(16), particles%tailpoints, &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 18 )
+
+    nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(17), particles%tail_id,    &
+                            start = (/ 1, prt_time_count /),                  &
+                            count = (/ maximum_number_of_particles /) )
+    IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 19 )
+
+#endif
+ END SUBROUTINE output_particles_netcdf
+
+
+ SUBROUTINE write_particles
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Write particle data on restart file
+!------------------------------------------------------------------------------!
+#if defined( __particles )
+
+    USE control_parameters
+    USE particle_attributes
+    USE pegrid
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=10) ::  particle_binary_version
+
+!
+!-- First open the output unit.
+    IF ( myid_char == '' )  THEN
+       OPEN ( 90, FILE='PARTICLE_RESTART_DATA_OUT'//myid_char, &
+                  FORM='UNFORMATTED')
+    ELSE
+       IF ( myid == 0 )  CALL local_system( 'mkdir PARTICLE_RESTART_DATA_OUT' )
+#if defined( __parallel )
+!
+!--    Set a barrier in order to allow that thereafter all other processors
+!--    in the directory created by PE0 can open their file
+       CALL MPI_BARRIER( comm2d, ierr )
+#endif
+       OPEN ( 90, FILE='PARTICLE_RESTART_DATA_OUT/'//myid_char, &
+                  FORM='UNFORMATTED' )
+    ENDIF
+
+!
+!-- Write the version number of the binary format.
+!-- Attention: After changes to the following output commands the version
+!-- ---------  number of the variable particle_binary_version must be changed!
+!--            Also, the version number and the list of arrays to be read in
+!--            init_particles must be adjusted accordingly.
+    particle_binary_version = '3.0'
+    WRITE ( 90 )  particle_binary_version
+
+!
+!-- Write some particle parameters, the size of the particle arrays as well as
+!-- other dvrp-plot variables.
+    WRITE ( 90 )  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t,                    &
+                  maximum_number_of_particles, maximum_number_of_tailpoints,   &
+                  maximum_number_of_tails, number_of_initial_particles,        &
+                  number_of_particles, number_of_particle_groups,              &
+                  number_of_tails, particle_groups, time_prel,                 &
+                  time_write_particle_data, uniform_particles
+
+    IF ( number_of_initial_particles /= 0 )  WRITE ( 90 )  initial_particles
+
+    WRITE ( 90 )  prt_count, prt_start_index
+    WRITE ( 90 )  particles
+
+    IF ( use_particle_tails )  THEN
+       WRITE ( 90 )  particle_tail_coordinates
+    ENDIF
+
+    CLOSE ( 90 )
+
+#endif
+ END SUBROUTINE write_particles
+
+
+ SUBROUTINE collision_efficiency( mean_r, r, e)
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Interpolate collision efficiency from table
+!------------------------------------------------------------------------------!
+#if defined( __particles )
+
+    IMPLICIT NONE
+
+    INTEGER       ::  i, j, k
+
+    LOGICAL, SAVE ::  first = .TRUE.
+
+    REAL          ::  aa, bb, cc, dd, dx, dy, e, gg, mean_r, mean_rm, r, rm, &
+                      x, y
+
+    REAL, DIMENSION(1:9), SAVE      ::  collected_r = 0.0
+    REAL, DIMENSION(1:19), SAVE     ::  collector_r = 0.0
+    REAL, DIMENSION(1:9,1:19), SAVE ::  ef = 0.0
+
+    mean_rm = mean_r * 1.0E06
+    rm      = r      * 1.0E06
+
+    IF ( first )  THEN
+       collected_r = (/ 2.0, 3.0, 4.0, 6.0, 8.0, 10.0, 15.0, 20.0, 25.0 /)
+       collector_r = (/ 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, 80.0, 100.0, 150.0,&
+                        200.0, 300.0, 400.0, 500.0, 600.0, 1000.0, 1400.0,     &
+                        1800.0, 2400.0, 3000.0 /)
+       ef(:,1) = (/0.017, 0.027, 0.037, 0.052, 0.052, 0.052, 0.052, 0.0,  0.0 /)
+       ef(:,2) = (/0.001, 0.016, 0.027, 0.060, 0.12,  0.17,  0.17,  0.17, 0.0 /)
+       ef(:,3) = (/0.001, 0.001, 0.02,  0.13,  0.28,  0.37,  0.54,  0.55, 0.47/)
+       ef(:,4) = (/0.001, 0.001, 0.02,  0.23,  0.4,   0.55,  0.7,   0.75, 0.75/)
+       ef(:,5) = (/0.01,  0.01,  0.03,  0.3,   0.4,   0.58,  0.73,  0.75, 0.79/)
+       ef(:,6) = (/0.01,  0.01,  0.13,  0.38,  0.57,  0.68,  0.80,  0.86, 0.91/)
+       ef(:,7) = (/0.01,  0.085, 0.23,  0.52,  0.68,  0.76,  0.86,  0.92, 0.95/)
+       ef(:,8) = (/0.01,  0.14,  0.32,  0.60,  0.73,  0.81,  0.90,  0.94, 0.96/)
+       ef(:,9) = (/0.025, 0.25,  0.43,  0.66,  0.78,  0.83,  0.92,  0.95, 0.96/)
+       ef(:,10)= (/0.039, 0.3,   0.46,  0.69,  0.81,  0.87,  0.93,  0.95, 0.96/)
+       ef(:,11)= (/0.095, 0.33,  0.51,  0.72,  0.82,  0.87,  0.93,  0.96, 0.97/)
+       ef(:,12)= (/0.098, 0.36,  0.51,  0.73,  0.83,  0.88,  0.93,  0.96, 0.97/)
+       ef(:,13)= (/0.1,   0.36,  0.52,  0.74,  0.83,  0.88,  0.93,  0.96, 0.97/)
+       ef(:,14)= (/0.17,  0.4,   0.54,  0.72,  0.83,  0.88,  0.94,  0.98, 1.0 /)
+       ef(:,15)= (/0.15,  0.37,  0.52,  0.74,  0.82,  0.88,  0.94,  0.98, 1.0 /)
+       ef(:,16)= (/0.11,  0.34,  0.49,  0.71,  0.83,  0.88,  0.94,  0.95, 1.0 /)
+       ef(:,17)= (/0.08,  0.29,  0.45,  0.68,  0.8,   0.86,  0.96,  0.94, 1.0 /)
+       ef(:,18)= (/0.04,  0.22,  0.39,  0.62,  0.75,  0.83,  0.92,  0.96, 1.0 /)
+       ef(:,19)= (/0.02,  0.16,  0.33,  0.55,  0.71,  0.81,  0.90,  0.94, 1.0 /)
+    ENDIF
+
+    DO  k = 1, 8
+       IF ( collected_r(k) <= mean_rm )  i = k
+    ENDDO
+
+    DO  k = 1, 18
+       IF ( collector_r(k) <= rm )  j = k
+    ENDDO
+
+    IF ( rm < 10.0 )  THEN
+       e = 0.0
+    ELSEIF ( mean_rm < 2.0 )  THEN
+       e = 0.001
+    ELSEIF ( mean_rm >= 25.0 )  THEN
+       IF( j <= 3 )  e = 0.55
+       IF( j == 4 )  e = 0.8
+       IF( j == 5 )  e = 0.9
+       IF( j >=6  )  e = 1.0
+    ELSEIF ( rm >= 3000.0 )  THEN
+       e = 1.0
+    ELSE
+       x  = mean_rm - collected_r(i)
+       y  = rm - collected_r(j)
+       dx = collected_r(i+1) - collected_r(i) 
+       dy = collector_r(j+1) - collector_r(j) 
+       aa = x**2 + y**2
+       bb = ( dx - x )**2 + y**2
+       cc = x**2 + ( dy - y )**2
+       dd = ( dx - x )**2 + ( dy - y )**2
+       gg = aa + bb + cc + dd
+
+       e = ( (gg-aa)*ef(i,j) + (gg-bb)*ef(i+1,j) + (gg-cc)*ef(i,j+1) + &
+             (gg-dd)*ef(i+1,j+1) ) / (3.0*gg)
+    ENDIF
+
+#endif
+ END SUBROUTINE collision_efficiency 
+
+
+
+ SUBROUTINE sort_particles
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Sort particles in the sequence the grid boxes are stored in memory
+!------------------------------------------------------------------------------!
+#if defined( __particles )
+
+    USE arrays_3d
+    USE control_parameters
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE particle_attributes
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, ilow, j, k, n
+
+    TYPE(particle_type), DIMENSION(1:number_of_particles) ::  particles_temp
+
+
+    CALL cpu_log( log_point_s(47), 'sort_particles', 'start' )
+
+!
+!-- Initialize the array used for counting and indexing the particles
+    prt_count = 0
+
+!
+!-- Count the particles per gridbox
+    DO  n = 1, number_of_particles
+
+       i = ( particles(n)%x + 0.5 * dx ) * ddx
+       j = ( particles(n)%y + 0.5 * dy ) * ddy
+       k = particles(n)%z / dz + 1  ! only exact if equidistant
+
+       prt_count(k,j,i) = prt_count(k,j,i) + 1
+
+       IF ( i < nxl .OR. i > nxr .OR. j < nys .OR. j > nyn .OR. k < nzb+1 .OR. &
+            k > nzt )  THEN
+          PRINT*, '+++ sort_particles: particle out of range: i=', i, ' j=', &
+                                       j, ' k=', k
+          PRINT*, '                    nxl=', nxl, ' nxr=', nxr, &
+                                     ' nys=', nys, ' nyn=', nyn, &
+                                     ' nzb=', nzb, ' nzt=', nzt
+       ENDIF
+
+    ENDDO
+
+!
+!-- Calculate the lower indices of those ranges of the particles-array
+!-- containing particles which belong to the same gridpox i,j,k
+    ilow = 1
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             prt_start_index(k,j,i) = ilow
+             ilow = ilow + prt_count(k,j,i)
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Sorting the particles
+    DO  n = 1, number_of_particles
+
+       i = ( particles(n)%x + 0.5 * dx ) * ddx
+       j = ( particles(n)%y + 0.5 * dy ) * ddy
+       k = particles(n)%z / dz + 1  ! only exact if equidistant
+
+       particles_temp(prt_start_index(k,j,i)) = particles(n)
+
+       prt_start_index(k,j,i) = prt_start_index(k,j,i) + 1
+
+    ENDDO
+
+    particles(1:number_of_particles) = particles_temp
+
+!
+!-- Reset the index array to the actual start position
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             prt_start_index(k,j,i) = prt_start_index(k,j,i) - prt_count(k,j,i)
+          ENDDO
+       ENDDO
+    ENDDO
+
+    CALL cpu_log( log_point_s(47), 'sort_particles', 'stop' )
+
+#endif
+ END SUBROUTINE sort_particles
Index: palm/trunk/SOURCE/advec_s_bc.f90
===================================================================
--- palm/trunk/SOURCE/advec_s_bc.f90	(revision 4901)
+++ palm/trunk/SOURCE/advec_s_bc.f90	(revision 1)
@@ -1,46 +1,56 @@
-!> @file advec_s_bc.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-! -------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE advec_s_bc( sk, sk_char )
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Implement snow and graupel (bulk microphysics)
-! 
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-! 
-! 4488 2020-04-03 11:34:29Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4429 2020-02-27 15:24:30Z raasch
-! bugfix: cpp-directives added for serial mode
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! unused variables removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! nopointer option removed
+! $Log: advec_s_bc.f90,v $
+! Revision 1.22  2006/02/23 09:42:08  raasch
+! anz renamed ngp
+!
+! Revision 1.21  2003/03/16 09:22:13  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.20  2002/12/19 13:41:50  raasch
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.19  2001/03/29 17:29:52  raasch
+! Result is stored as tendency on tend, sk_p is now a local array, rho is
+! replaced by d
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.18  2001/01/22 04:25:52  raasch
+! Module test_variables removed
+!
+! Revision 1.17  2000/07/03 12:54:35  raasch
+! Arguments rho, sk and sk_p now declared as pointers
+!
+! Revision 1.16  2000/04/27 07:03:07  raasch
+! Treatment at cyclic boundaries is simplified by adding one additional
+! ghost layer to tend at each cyclic boundary. Result is that most of
+! mpi_sendrecv-calls (for polynom-coefficients, switches and fluxes) are no
+! more necessary so that much cpu-time is spared.
+! Adjustment of cyclic boundaries in x-direction in case of a sloping surface
+! (temperature only).
+! Vertical boundary conditions for humidity added.
+!
+! Revision 1.15  2000/01/20 09:07:01  letzel
+! All comments translated into English
+!
+! Revision 1.14  1999/02/17 09:01:38  raasch
+! Verfahren erweitert fuer TKE-Advektion
+! Dichteberechnung (Korrekturverfahren) korrigiert (Galilei-Abzug war falsch)
+!
+! Revision 1.10  1998/04/21 15:51:34  raasch
+! Galilei-Transformation eingebaut
+!
+! Revision 1.4  1997/09/08 10:42:35  raasch
+! Optimierungen im Exponentialteil, MIN/MAX-Bildung aus progn. Gleichung
+! entfernt, sw und m1 auf t3e einfach genau definiert, ffmax aus progn.
+! Gleichung entfernt (Skalarfeld wird glatter im gradientschwachen Bereich)
+! Geschwindigkeitsgewinn: ca 32%
 !
 ! Revision 1.1  1997/08/29 08:53:46  raasch
@@ -50,807 +60,746 @@
 ! 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:  bc_pt_t_val, bc_q_t_val, bc_s_t_val, dt_3d, ibc_pt_b, ibc_pt_t, ibc_q_t, ibc_s_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, nxr, nyn, nys, 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) ::  sr        !<
+! 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!
+!-------------------------------------------------------------------------------!
+
+    USE advection
+    USE arrays_3d
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE statistics
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  sk_char
+
+    INTEGER ::  i, ix, j, k, ngp, sr, type_xz_2
+
+    REAL ::  cim, cimf, cip, cipf, d_new, ffmax, fminus, fplus, f2, f4, f8, &
+             f12, f24, f48, f1920, im, ip, m2, m3, nenner, snenn, sterm,    &
+             tendenz, t1, t2, zaehler
+    REAL ::  fmax(2), fmax_l(2)
+    REAL, DIMENSION(:,:,:), POINTER ::  sk
+
+    REAL, DIMENSION(:,:), ALLOCATABLE ::  a0, a1, a12, a2, a22, immb, imme,  &
+                                          impb, impe, ipmb, ipme, ippb, ippe
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  sk_p
+
+#if defined( __t3eb ) || defined( __t3eh ) || defined( __t3ej2 ) || defined( __t3ej5 )
+    REAL (kind=4) ::  m1n, m1z  !Wichtig: Division
+    REAL (kind=4), DIMENSION(:,:), ALLOCATABLE :: m1, sw
+#else
+    REAL ::  m1n, m1z
+    REAL, DIMENSION(:,:), ALLOCATABLE :: m1, sw
+#endif
+
+
+!
+!-- Array sk_p requires 2 extra elements for each dimension
+    ALLOCATE( sk_p(nzb-2:nzt+2,nys-3:nyn+3,nxl-3:nxr+3) )
+    sk_p = 0.0
+
+!
+!-- Assign reciprocal values in order to avoid divisions later
+    f2    = 0.5
+    f4    = 0.25
+    f8    = 0.125
+    f12   = 0.8333333333333333E-01
+    f24   = 0.4166666666666666E-01
+    f48   = 0.2083333333333333E-01
+    f1920 = 0.5208333333333333E-03
+
+!
+!-- 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+1, nzt-1
+             sk_p(k,j,i) = sk(k,j,i)
+          ENDDO
+       ENDDO
+    ENDDO
 #if defined( __parallel )
-       INTEGER(iwp) ::  ngp       !<
-       INTEGER(iwp) ::  type_xz_2 !<
+    ngp = 2 * ( nzt - nzb + 5 ) * ( 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
-       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) ::  m1n       !<
-       REAL(wp) ::  m1z       !<
-       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) !<
-
-       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 ::  m1   !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sw   !<
-
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  sk_p !<
-
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk !<
-
-
-!
-!--    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
+
+!
+!-- 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
+
+!
+!-- Determine maxima of the first and second derivative in x-direction
+    fmax_l = 0.0
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt-1
+             zaehler = ABS( sk_p(k,j,i+1) - 2.0 * sk_p(k,j,i) + sk_p(k,j,i-1) )
+             nenner  = ABS( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
+             fmax_l(1) = MAX( fmax_l(1) , zaehler )
+             fmax_l(2) = MAX( fmax_l(2) , nenner  )
+          ENDDO
+       ENDDO
+    ENDDO
+#if defined( __parallel )
+    CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
+#else
+    fmax = fmax_l
+#endif
+
+    fmax = 0.04 * fmax
+
+!
+!-- Allocate temporary arrays
+    ALLOCATE( a0(nzb+1:nzt-1,nxl-1:nxr+1),   a1(nzb+1:nzt-1,nxl-1:nxr+1),   &
+              a2(nzb+1:nzt-1,nxl-1:nxr+1),   a12(nzb+1:nzt-1,nxl-1:nxr+1),  &
+              a22(nzb+1:nzt-1,nxl-1:nxr+1),  immb(nzb+1:nzt-1,nxl-1:nxr+1), &
+              imme(nzb+1:nzt-1,nxl-1:nxr+1), impb(nzb+1:nzt-1,nxl-1:nxr+1), &
+              impe(nzb+1:nzt-1,nxl-1:nxr+1), ipmb(nzb+1:nzt-1,nxl-1:nxr+1), &
+              ipme(nzb+1:nzt-1,nxl-1:nxr+1), ippb(nzb+1:nzt-1,nxl-1:nxr+1), &
+              ippe(nzb+1:nzt-1,nxl-1:nxr+1), m1(nzb+1:nzt-1,nxl-2:nxr+2),   &
+              sw(nzb+1:nzt-1,nxl-1:nxr+1)                                   &
+            )
+    imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0
+
+!
+!-- 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  j = nys, nyn
-             DO  k = nzb, nzt+1
-                sk_p(k,j,i) = sk(k,j,i)
+          DO  k = nzb+1, nzt-1
+             a12(k,i) = 0.5 * ( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
+             a22(k,i) = 0.5 * ( sk_p(k,j,i+1) - 2.0 * sk_p(k,j,i) &
+                                              + sk_p(k,j,i-1) )
+             a0(k,i) = ( 9.0 * sk_p(k,j,i+2) - 116.0 * sk_p(k,j,i+1)    &
+                         + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k,j,i-1) &
+                         + 9.0 * sk_p(k,j,i-2) ) * f1920
+             a1(k,i) = ( -5.0 * sk_p(k,j,i+2) + 34.0 * sk_p(k,j,i+1)  &
+                         - 34.0 * sk_p(k,j,i-1) + 5.0 * sk_p(k,j,i-2) &
+                       ) * f48
+             a2(k,i) = ( -3.0 * sk_p(k,j,i+2) + 36.0 * sk_p(k,j,i+1) &
+                         - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k,j,i-1) &
+                         - 3.0 * 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-1
+             cip  =  MAX( 0.0, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
+             cim  = -MIN( 0.0, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
+             cipf = 1.0 - 2.0 * cip
+             cimf = 1.0 - 2.0 * cim
+             ip   =   a0(k,i)   * f2  * ( 1.0 - cipf )             &
+                    + a1(k,i)   * f8  * ( 1.0 - cipf*cipf )        &
+                    + a2(k,i)   * f24 * ( 1.0 - cipf*cipf*cipf )
+             im   =   a0(k,i+1) * f2  * ( 1.0 - cimf )             &
+                    - a1(k,i+1) * f8  * ( 1.0 - cimf*cimf )        &
+                    + a2(k,i+1) * f24 * ( 1.0 - cimf*cimf*cimf )
+             ip   = MAX( ip, 0.0 )
+             im   = MAX( im, 0.0 )
+             ippb(k,i) = ip * MIN( 1.0, sk_p(k,j,i)   / (ip+im+1E-15) )
+             impb(k,i) = im * MIN( 1.0, sk_p(k,j,i+1) / (ip+im+1E-15) )
+
+             cip  =  MAX( 0.0, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
+             cim  = -MIN( 0.0, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
+             cipf = 1.0 - 2.0 * cip
+             cimf = 1.0 - 2.0 * cim
+             ip   =   a0(k,i-1) * f2  * ( 1.0 - cipf )             &
+                    + a1(k,i-1) * f8  * ( 1.0 - cipf*cipf )        &
+                    + a2(k,i-1) * f24 * ( 1.0 - cipf*cipf*cipf )
+             im   =   a0(k,i)   * f2  * ( 1.0 - cimf )             &
+                    - a1(k,i)   * f8  * ( 1.0 - cimf*cimf )        &
+                    + a2(k,i)   * f24 * ( 1.0 - cimf*cimf*cimf )
+             ip   = MAX( ip, 0.0 )
+             im   = MAX( im, 0.0 )
+             ipmb(k,i) = ip * MIN( 1.0, sk_p(k,j,i-1) / (ip+im+1E-15) )
+             immb(k,i) = im * MIN( 1.0, sk_p(k,j,i)   / (ip+im+1E-15) )
+          ENDDO
+       ENDDO
+
+!
+!--    Compute monitor function m1
+       DO  i = nxl-2, nxr+2
+          DO  k = nzb+1, nzt-1
+             m1z = ABS( sk_p(k,j,i+1) - 2.0 * 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  .AND.  m1n >= m1z )  THEN
+                m1(k,i) = m1z / m1n
+                IF ( m1(k,i) /= 2.0  .AND.  m1n < fmax(2) )  m1(k,i) = 0.0
+             ELSEIF ( m1n < m1z )  THEN
+                m1(k,i) = -1.0
+             ELSE
+                m1(k,i) = 0.0
+             ENDIF
+          ENDDO
+       ENDDO
+
+!
+!--    Compute switch sw
+       sw = 0.0
+       DO  i = nxl-1, nxr+1
+          DO  k = nzb+1, nzt-1
+             m2 = 2.0 * ABS( a1(k,i) - a12(k,i) ) / &
+                  MAX( ABS( a1(k,i) + a12(k,i) ), 1E-35 )
+             IF ( ABS( a1(k,i) + a12(k,i) ) < fmax(2) )  m2 = 0.0
+
+             m3 = 2.0 * ABS( a2(k,i) - a22(k,i) ) / &
+                  MAX( ABS( a2(k,i) + a22(k,i) ), 1E-35 )
+             IF ( ABS( a2(k,i) + a22(k,i) ) < fmax(1) )  m3 = 0.0
+
+             t1 = 0.35
+             t2 = 0.35
+             IF ( m1(k,i) == -1.0 )  t2 = 0.12
+
+!--          *VOCL STMT,IF(10)
+             IF ( m1(k,i-1) == 1.0 .OR. m1(k,i) == 1.0 .OR. m1(k,i+1) == 1.0 &
+                  .OR.  m2 > t2  .OR.  m3 > T2  .OR.                         &
+                  ( m1(k,i) > t1  .AND.  m1(k,i-1) /= -1.0  .AND.            &
+                    m1(k,i) /= -1.0  .AND.  m1(k,i+1) /= -1.0 )              &
+                )  sw(k,i) = 1.0
+          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-1
+
+!--          *VOCL STMT,IF(10)
+             IF ( sw(k,i) == 1.0 )  THEN
+                snenn = sk_p(k,j,i+1) - sk_p(k,j,i-1)
+                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
+                sterm = ( sk_p(k,j,i) - sk_p(k,j,i-1) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cip =  MAX( 0.0, ( 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 * ( 1.0 - 2.0 * cip ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  ippe(k,i) = sk_p(k,j,i) * cip
+                IF ( sterm == 0.9999 )  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 )  snenn = 1E-9
+                sterm = ( sk_p(k,j,i) - sk_p(k,j,i+1) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cim = -MIN( 0.0, ( 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 * ( 1.0 - 2.0 * cim ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  imme(k,i) = sk_p(k,j,i) * cim
+                IF ( sterm == 0.9999 )  imme(k,i) = sk_p(k,j,i) * cim
+             ENDIF
+
+!--          *VOCL STMT,IF(10)
+             IF ( sw(k,i+1) == 1.0 )  THEN
+                snenn = sk_p(k,j,i) - sk_p(k,j,i+2)
+                IF ( ABS( snenn ) .LT. 1E-9 )  snenn = 1E-9
+                sterm = ( sk_p(k,j,i+1) - sk_p(k,j,i+2) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cim = -MIN( 0.0, ( 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 * ( 1.0 - 2.0 * cim ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  impe(k,i) = sk_p(k,j,i+1) * cim
+                IF ( sterm == 0.9999 )  impe(k,i) = sk_p(k,j,i+1) * cim
+             ENDIF
+
+!--          *VOCL STMT,IF(10)
+             IF ( sw(k,i-1) == 1.0 )  THEN
+                snenn = sk_p(k,j,i) - sk_p(k,j,i-2)
+                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
+                sterm = ( sk_p(k,j,i-1) - sk_p(k,j,i-2) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cip = MAX( 0.0, ( 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 * ( 1.0 - 2.0 * cip ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  ipme(k,i) = sk_p(k,j,i-1) * cip
+                IF ( sterm == 0.9999 )  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-1
+             fplus  = ( 1.0 - sw(k,i)   ) * ippb(k,i) + sw(k,i)   * ippe(k,i) &
+                    - ( 1.0 - sw(k,i+1) ) * impb(k,i) - sw(k,i+1) * impe(k,i)
+             fminus = ( 1.0 - sw(k,i-1) ) * ipmb(k,i) + sw(k,i-1) * ipme(k,i) &
+                    - ( 1.0 - sw(k,i)   ) * immb(k,i) - sw(k,i)   * imme(k,i)
+             tendenz = fplus - fminus
+!
+!--           Removed in order to optimize speed
+!             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
+!             IF ( ( ABS( tendenz ) / ffmax ) < 1E-7 )  tendenz = 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 + d(k,j,i) ) * sk_p(k,j,i) - tendenz ) / &
+                           ( 1.0 + 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 + 5 ) * ( nyn - nys + 7 )
+    CALL MPI_TYPE_VECTOR( nxr-nxl+7, 3*(nzt-nzb+5), 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-1
+          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
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt-1
+             zaehler = ABS( sk_p(k,j+1,i) - 2.0 * sk_p(k,j,i) + sk_p(k,j-1,i) )
+             nenner  = ABS( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
+             fmax_l(1) = MAX( fmax_l(1) , zaehler )
+             fmax_l(2) = MAX( fmax_l(2) , nenner  )
+          ENDDO
+       ENDDO
+    ENDDO
+#if defined( __parallel )
+    CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
+#else
+    fmax = fmax_l
+#endif
+
+    fmax = 0.04 * fmax
+
+!
+!-- Allocate temporary arrays
+    ALLOCATE( a0(nzb+1:nzt-1,nys-1:nyn+1),   a1(nzb+1:nzt-1,nys-1:nyn+1),   &
+              a2(nzb+1:nzt-1,nys-1:nyn+1),   a12(nzb+1:nzt-1,nys-1:nyn+1),  &
+              a22(nzb+1:nzt-1,nys-1:nyn+1),  immb(nzb+1:nzt-1,nys-1:nyn+1), &
+              imme(nzb+1:nzt-1,nys-1:nyn+1), impb(nzb+1:nzt-1,nys-1:nyn+1), &
+              impe(nzb+1:nzt-1,nys-1:nyn+1), ipmb(nzb+1:nzt-1,nys-1:nyn+1), &
+              ipme(nzb+1:nzt-1,nys-1:nyn+1), ippb(nzb+1:nzt-1,nys-1:nyn+1), &
+              ippe(nzb+1:nzt-1,nys-1:nyn+1), m1(nzb+1:nzt-1,nys-2:nyn+2),   &
+              sw(nzb+1:nzt-1,nys-1:nyn+1)                                   &
+            )
+    imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0
+
+!
+!-- Outer loop of all i
+    DO  i = nxl, nxr
+
+!
+!--    Compute polynomial coefficients
+       DO  j = nys-1, nyn+1
+          DO  k = nzb+1, nzt-1
+             a12(k,j) = 0.5 * ( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
+             a22(k,j) = 0.5 * ( sk_p(k,j+1,i) - 2.0 * sk_p(k,j,i) &
+                                              + sk_p(k,j-1,i) )
+             a0(k,j) = ( 9.0 * sk_p(k,j+2,i) - 116.0 * sk_p(k,j+1,i)    &
+                         + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k,j-1,i) &
+                         + 9.0 * sk_p(k,j-2,i) ) * f1920
+             a1(k,j) = ( -5.0 * sk_p(k,j+2,i) + 34.0 * sk_p(k,j+1,i)  &
+                         - 34.0 * sk_p(k,j-1,i) + 5.0 * sk_p(k,j-2,i) &
+                       ) * f48
+             a2(k,j) = ( -3.0 * sk_p(k,j+2,i) + 36.0 * sk_p(k,j+1,i) &
+                         - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k,j-1,i) &
+                         - 3.0 * 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-1
+             cip  =  MAX( 0.0, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
+             cim  = -MIN( 0.0, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
+             cipf = 1.0 - 2.0 * cip
+             cimf = 1.0 - 2.0 * cim
+             ip   =   a0(k,j)   * f2  * ( 1.0 - cipf )             &
+                    + a1(k,j)   * f8  * ( 1.0 - cipf*cipf )        &
+                    + a2(k,j)   * f24 * ( 1.0 - cipf*cipf*cipf )
+             im   =   a0(k,j+1) * f2  * ( 1.0 - cimf )             &
+                    - a1(k,j+1) * f8  * ( 1.0 - cimf*cimf )        &
+                    + a2(k,j+1) * f24 * ( 1.0 - cimf*cimf*cimf )
+             ip   = MAX( ip, 0.0 )
+             im   = MAX( im, 0.0 )
+             ippb(k,j) = ip * MIN( 1.0, sk_p(k,j,i)   / (ip+im+1E-15) )
+             impb(k,j) = im * MIN( 1.0, sk_p(k,j+1,i) / (ip+im+1E-15) )
+
+             cip  =  MAX( 0.0, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
+             cim  = -MIN( 0.0, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
+             cipf = 1.0 - 2.0 * cip
+             cimf = 1.0 - 2.0 * cim
+             ip   =   a0(k,j-1) * f2  * ( 1.0 - cipf )             &
+                    + a1(k,j-1) * f8  * ( 1.0 - cipf*cipf )        &
+                    + a2(k,j-1) * f24 * ( 1.0 - cipf*cipf*cipf )
+             im   =   a0(k,j)   * f2  * ( 1.0 - cimf )             &
+                    - a1(k,j)   * f8  * ( 1.0 - cimf*cimf )        &
+                    + a2(k,j)   * f24 * ( 1.0 - cimf*cimf*cimf )
+             ip   = MAX( ip, 0.0 )
+             im   = MAX( im, 0.0 )
+             ipmb(k,j) = ip * MIN( 1.0, sk_p(k,j-1,i) / (ip+im+1E-15) )
+             immb(k,j) = im * MIN( 1.0, sk_p(k,j,i)   / (ip+im+1E-15) )
+          ENDDO
+       ENDDO
+
+!
+!--    Compute monitor function m1
+       DO  j = nys-2, nyn+2
+          DO  k = nzb+1, nzt-1
+             m1z = ABS( sk_p(k,j+1,i) - 2.0 * 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  .AND.  m1n >= m1z )  THEN
+                m1(k,j) = m1z / m1n
+                IF ( m1(k,j) /= 2.0  .AND.  m1n < fmax(2) )  m1(k,j) = 0.0
+             ELSEIF ( m1n < m1z )  THEN
+                m1(k,j) = -1.0
+             ELSE
+                m1(k,j) = 0.0
+             ENDIF
+          ENDDO
+       ENDDO
+
+!
+!--    Compute switch sw
+       sw = 0.0
+       DO  j = nys-1, nyn+1
+          DO  k = nzb+1, nzt-1
+             m2 = 2.0 * ABS( a1(k,j) - a12(k,j) ) / &
+                  MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35 )
+             IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) )  m2 = 0.0
+
+             m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / &
+                  MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35 )
+             IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) )  m3 = 0.0
+
+             t1 = 0.35
+             t2 = 0.35
+             IF ( m1(k,j) == -1.0 )  t2 = 0.12
+
+!--          *VOCL STMT,IF(10)
+             IF ( m1(k,j-1) == 1.0 .OR. m1(k,j) == 1.0 .OR. m1(k,j+1) == 1.0 &
+                  .OR.  m2 > t2  .OR.  m3 > T2  .OR.                         &
+                  ( m1(k,j) > t1  .AND.  m1(k,j-1) /= -1.0  .AND.            &
+                    m1(k,j) /= -1.0  .AND.  m1(k,j+1) /= -1.0 )              &
+                )  sw(k,j) = 1.0
+          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-1
+
+!--          *VOCL STMT,IF(10)
+             IF ( sw(k,j) == 1.0 )  THEN
+                snenn = sk_p(k,j+1,i) - sk_p(k,j-1,i)
+                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
+                sterm = ( sk_p(k,j,i) - sk_p(k,j-1,i) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cip =  MAX( 0.0, ( 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 * ( 1.0 - 2.0 * cip ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  ippe(k,j) = sk_p(k,j,i) * cip
+                IF ( sterm == 0.9999 )  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 )  snenn = 1E-9
+                sterm = ( sk_p(k,j,i) - sk_p(k,j+1,i) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cim = -MIN( 0.0, ( 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 * ( 1.0 - 2.0 * cim ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  imme(k,j) = sk_p(k,j,i) * cim
+                IF ( sterm == 0.9999 )  imme(k,j) = sk_p(k,j,i) * cim
+             ENDIF
+
+!--          *VOCL STMT,IF(10)
+             IF ( sw(k,j+1) == 1.0 )  THEN
+                snenn = sk_p(k,j,i) - sk_p(k,j+2,i)
+                IF ( ABS( snenn ) .LT. 1E-9 )  snenn = 1E-9
+                sterm = ( sk_p(k,j+1,i) - sk_p(k,j+2,i) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cim = -MIN( 0.0, ( 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 * ( 1.0 - 2.0 * cim ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  impe(k,j) = sk_p(k,j+1,i) * cim
+                IF ( sterm == 0.9999 )  impe(k,j) = sk_p(k,j+1,i) * cim
+             ENDIF
+
+!--          *VOCL STMT,IF(10)
+             IF ( sw(k,j-1) == 1.0 )  THEN
+                snenn = sk_p(k,j,i) - sk_p(k,j-2,i)
+                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
+                sterm = ( sk_p(k,j-1,i) - sk_p(k,j-2,i) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cip = MAX( 0.0, ( 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 * ( 1.0 - 2.0 * cip ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  ipme(k,j) = sk_p(k,j-1,i) * cip
+                IF ( sterm == 0.9999 )  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-1
+             fplus  = ( 1.0 - sw(k,j)   ) * ippb(k,j) + sw(k,j)   * ippe(k,j) &
+                    - ( 1.0 - sw(k,j+1) ) * impb(k,j) - sw(k,j+1) * impe(k,j)
+             fminus = ( 1.0 - sw(k,j-1) ) * ipmb(k,j) + sw(k,j-1) * ipme(k,j) &
+                    - ( 1.0 - sw(k,j)   ) * immb(k,j) - sw(k,j)   * imme(k,j)
+             tendenz = fplus - fminus
+!
+!--           Removed in order to optimise speed
+!             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
+!             IF ( ( ABS( tendenz ) / ffmax ) < 1E-7 )  tendenz = 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 + d(k,j,i) ) * sk_p(k,j,i) - tendenz ) / &
+                           ( 1.0 + 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
+
+!
+!-- 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
-       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' )
-
-       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
-          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
-                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
-
-                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
-
-                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
-
-                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
-
-       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
-          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
-
-                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
-
-                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
-
-                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
-
-                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
+
+       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+1,j,i)
+                sk_p(nzb-2,j,i) = sk_p(nzb+1,j,i)
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+!
+!--    Temperature boundary condition at the top boundary
+       IF ( ibc_pt_t == 0 )  THEN
+!
+!--       Dirichlet
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzt+1,j,i)   = sk_p(nzt,j,i)
+                sk_p(nzt+2,j,i)   = sk_p(nzt,j,i)
+             ENDDO
+          ENDDO
+
+       ELSE
+!
+!--       Neumann: dzu(nzt+2) is not defined, thus instead dzu(nzt+1) is used
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzt,j,i)     = sk_p(nzt-1,j,i) + bc_pt_t_val * dzu(nzt)
+                sk_p(nzt+1,j,i)   = sk_p(nzt,j,i)   + bc_pt_t_val * dzu(nzt+1)
+                sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i) + bc_pt_t_val * dzu(nzt+1)
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+    ELSEIF ( sk_char == 'q' )  THEN
+
+!
+!--    Temperature boundary condition at the bottom boundary
+       IF ( ibc_q_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)
@@ -858,416 +807,347 @@
           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)
+       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)
+                sk_p(nzb-1,j,i) = sk_p(nzb+1,j,i)
+                sk_p(nzb-2,j,i) = sk_p(nzb+1,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)
+       ENDIF
+
+!
+!--    Temperature boundary condition at the top boundary
+       IF ( ibc_q_t == 0 )  THEN
+!
+!--       Dirichlet
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzt+1,j,i)   = sk_p(nzt,j,i)
+                sk_p(nzt+2,j,i)   = sk_p(nzt,j,i)
+             ENDDO
+          ENDDO
+
+       ELSE
+!
+!--       Neumann: dzu(nzt+2) is not defined, thus instead dzu(nzt+1) is used
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzt,j,i)     = sk_p(nzt-1,j,i) + bc_q_t_val * dzu(nzt)
+                sk_p(nzt+1,j,i)   = sk_p(nzt,j,i)   + bc_q_t_val * dzu(nzt+1)
+                sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i) + bc_q_t_val * dzu(nzt+1)
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+    ELSEIF ( sk_char == 'e' )  THEN
+
+!
+!--    TKE boundary condition at bottom and top boundary (generally Neumann)
+       sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
+       sk_p(nzb-1,j,i) = sk_p(nzb+1,j,i)
+       sk_p(nzb-2,j,i) = sk_p(nzb+1,j,i)
+       sk_p(nzt,j,i)   = sk_p(nzt-1,j,i)
+       sk_p(nzt+1,j,i) = sk_p(nzt-1,j,i)
+       sk_p(nzt+2,j,i) = sk_p(nzt-1,j,i)
+
+    ELSE
+
+       IF ( myid == 0 )  PRINT*,'+++ advec_s_bc:  no vertical boundary condi', &
+                                'tion for variable "', sk_char, '"'
+       CALL local_stop
+
+    ENDIF
+
+!
+!-- Determine the maxima of the first and second derivative in z-direction
+    fmax_l = 0.0
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb, nzt
+             zaehler = ABS( sk_p(k+1,j,i) - 2.0 * sk_p(k,j,i) + sk_p(k-1,j,i) )
+             nenner  = ABS( sk_p(k+1,j,i+1) - sk_p(k-1,j,i) )
+             fmax_l(1) = MAX( fmax_l(1) , zaehler )
+             fmax_l(2) = MAX( fmax_l(2) , nenner  )
+          ENDDO
+       ENDDO
+    ENDDO
+#if defined( __parallel )
+    CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
+#else
+    fmax = fmax_l
+#endif
+
+    fmax = 0.04 * fmax
+
+!
+!-- Allocate temporary arrays
+    ALLOCATE( a0(nzb:nzt,nys:nyn),       a1(nzb:nzt,nys:nyn),       &
+              a2(nzb:nzt,nys:nyn),       a12(nzb:nzt,nys:nyn),      &
+              a22(nzb:nzt,nys:nyn),      immb(nzb+1:nzt-1,nys:nyn), &
+              imme(nzb+1:nzt-1,nys:nyn), impb(nzb+1:nzt-1,nys:nyn), &
+              impe(nzb+1:nzt-1,nys:nyn), ipmb(nzb+1:nzt-1,nys:nyn), &
+              ipme(nzb+1:nzt-1,nys:nyn), ippb(nzb+1:nzt-1,nys:nyn), &
+              ippe(nzb+1:nzt-1,nys:nyn), m1(nzb-1:nzt+1,nys:nyn),   &
+              sw(nzb:nzt,nys:nyn)                                   &
+            )
+    imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0
+
+!
+!-- Outer loop of all i
+    DO  i = nxl, nxr
+
+!
+!--    Compute polynomial coefficients
+       DO  j = nys, nyn
+          DO  k = nzb, nzt
+             a12(k,j) = 0.5 * ( sk_p(k+1,j,i) - sk_p(k-1,j,i) )
+             a22(k,j) = 0.5 * ( sk_p(k+1,j,i) - 2.0 * sk_p(k,j,i) &
+                                              + sk_p(k-1,j,i) )
+             a0(k,j) = ( 9.0 * sk_p(k+2,j,i) - 116.0 * sk_p(k+1,j,i)    &
+                         + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k-1,j,i) &
+                         + 9.0 * sk_p(k-2,j,i) ) * f1920
+             a1(k,j) = ( -5.0 * sk_p(k+2,j,i) + 34.0 * sk_p(k+1,j,i)  &
+                         - 34.0 * sk_p(k-1,j,i) + 5.0 * sk_p(k-2,j,i) &
+                       ) * f48
+             a2(k,j) = ( -3.0 * sk_p(k+2,j,i) + 36.0 * sk_p(k+1,j,i) &
+                         - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k-1,j,i) &
+                         - 3.0 * 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-1
+             cip  =  MAX( 0.0, w(k,j,i) * dt_3d * ddzw(k) )
+             cim  = -MIN( 0.0, w(k,j,i) * dt_3d * ddzw(k) )
+             cipf = 1.0 - 2.0 * cip
+             cimf = 1.0 - 2.0 * cim
+             ip   =   a0(k,j)   * f2  * ( 1.0 - cipf )             &
+                    + a1(k,j)   * f8  * ( 1.0 - cipf*cipf )        &
+                    + a2(k,j)   * f24 * ( 1.0 - cipf*cipf*cipf )
+             im   =   a0(k+1,j) * f2  * ( 1.0 - cimf )             &
+                    - a1(k+1,j) * f8  * ( 1.0 - cimf*cimf )        &
+                    + a2(k+1,j) * f24 * ( 1.0 - cimf*cimf*cimf )
+             ip   = MAX( ip, 0.0 )
+             im   = MAX( im, 0.0 )
+             ippb(k,j) = ip * MIN( 1.0, sk_p(k,j,i)   / (ip+im+1E-15) )
+             impb(k,j) = im * MIN( 1.0, sk_p(k+1,j,i) / (ip+im+1E-15) )
+
+             cip  =  MAX( 0.0, w(k-1,j,i) * dt_3d * ddzw(k) )
+             cim  = -MIN( 0.0, w(k-1,j,i) * dt_3d * ddzw(k) )
+             cipf = 1.0 - 2.0 * cip
+             cimf = 1.0 - 2.0 * cim
+             ip   =   a0(k-1,j) * f2  * ( 1.0 - cipf )             &
+                    + a1(k-1,j) * f8  * ( 1.0 - cipf*cipf )        &
+                    + a2(k-1,j) * f24 * ( 1.0 - cipf*cipf*cipf )
+             im   =   a0(k,j)   * f2  * ( 1.0 - cimf )             &
+                    - a1(k,j)   * f8  * ( 1.0 - cimf*cimf )        &
+                    + a2(k,j)   * f24 * ( 1.0 - cimf*cimf*cimf )
+             ip   = MAX( ip, 0.0 )
+             im   = MAX( im, 0.0 )
+             ipmb(k,j) = ip * MIN( 1.0, sk_p(k-1,j,i) / (ip+im+1E-15) )
+             immb(k,j) = im * MIN( 1.0, sk_p(k,j,i)   / (ip+im+1E-15) )
+          ENDDO
+       ENDDO
+
+!
+!--    Compute monitor function m1
+       DO  j = nys, nyn
+          DO  k = nzb-1, nzt+1
+             m1z = ABS( sk_p(k+1,j,i) - 2.0 * 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  .AND.  m1n >= m1z )  THEN
+                m1(k,j) = m1z / m1n
+                IF ( m1(k,j) /= 2.0  .AND.  m1n < fmax(2) )  m1(k,j) = 0.0
+             ELSEIF ( m1n < m1z )  THEN
+                m1(k,j) = -1.0
+             ELSE
+                m1(k,j) = 0.0
+             ENDIF
+          ENDDO
+       ENDDO
+
+!
+!--    Compute switch sw
+       sw = 0.0
+       DO  j = nys, nyn
+          DO  k = nzb, nzt
+             m2 = 2.0 * ABS( a1(k,j) - a12(k,j) ) / &
+                  MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35 )
+             IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) )  m2 = 0.0
+
+             m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / &
+                  MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35 )
+             IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) )  m3 = 0.0
+
+             t1 = 0.35
+             t2 = 0.35
+             IF ( m1(k,j) == -1.0 )  t2 = 0.12
+
+!--          *VOCL STMT,IF(10)
+             IF ( m1(k-1,j) == 1.0 .OR. m1(k,j) == 1.0 .OR. m1(k+1,j) == 1.0 &
+                  .OR.  m2 > t2  .OR.  m3 > T2  .OR.                         &
+                  ( m1(k,j) > t1  .AND.  m1(k-1,j) /= -1.0  .AND.            &
+                    m1(k,j) /= -1.0  .AND.  m1(k+1,j) /= -1.0 )              &
+                )  sw(k,j) = 1.0
+          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-1
+
+!--          *VOCL STMT,IF(10)
+             IF ( sw(k,j) == 1.0 )  THEN
+                snenn = sk_p(k+1,j,i) - sk_p(k-1,j,i)
+                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
+                sterm = ( sk_p(k,j,i) - sk_p(k-1,j,i) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cip =  MAX( 0.0, 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 * ( 1.0 - 2.0 * cip ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  ippe(k,j) = sk_p(k,j,i) * cip
+                IF ( sterm == 0.9999 )  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 )  snenn = 1E-9
+                sterm = ( sk_p(k,j,i) - sk_p(k+1,j,i) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cim = -MIN( 0.0, 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 * ( 1.0 - 2.0 * cim ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  imme(k,j) = sk_p(k,j,i) * cim
+                IF ( sterm == 0.9999 )  imme(k,j) = sk_p(k,j,i) * cim
+             ENDIF
+
+!--          *VOCL STMT,IF(10)
+             IF ( sw(k+1,j) == 1.0 )  THEN
+                snenn = sk_p(k,j,i) - sk_p(k+2,j,i)
+                IF ( ABS( snenn ) .LT. 1E-9 )  snenn = 1E-9
+                sterm = ( sk_p(k+1,j,i) - sk_p(k+2,j,i) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cim = -MIN( 0.0, 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 * ( 1.0 - 2.0 * cim ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  impe(k,j) = sk_p(k+1,j,i) * cim
+                IF ( sterm == 0.9999 )  impe(k,j) = sk_p(k+1,j,i) * cim
+             ENDIF
+
+!--          *VOCL STMT,IF(10)
+             IF ( sw(k-1,j) == 1.0 )  THEN
+                snenn = sk_p(k,j,i) - sk_p(k-2,j,i)
+                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
+                sterm = ( sk_p(k-1,j,i) - sk_p(k-2,j,i) ) / snenn
+                sterm = MIN( sterm, 0.9999 )
+                sterm = MAX( sterm, 0.0001 )
+
+                ix = INT( sterm * 1000 ) + 1
+
+                cip = MAX( 0.0, 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 * ( 1.0 - 2.0 * cip ) ) &
+                                                                )              &
+                                                          )
+                IF ( sterm == 0.0001 )  ipme(k,j) = sk_p(k-1,j,i) * cip
+                IF ( sterm == 0.9999 )  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-1
+             fplus  = ( 1.0 - sw(k,j)   ) * ippb(k,j) + sw(k,j)   * ippe(k,j) &
+                    - ( 1.0 - sw(k+1,j) ) * impb(k,j) - sw(k+1,j) * impe(k,j)
+             fminus = ( 1.0 - sw(k-1,j) ) * ipmb(k,j) + sw(k-1,j) * ipme(k,j) &
+                    - ( 1.0 - sw(k,j)   ) * immb(k,j) - sw(k,j)   * imme(k,j)
+             tendenz = fplus - fminus
+!
+!--           Removed in order to optimise speed
+!             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
+!             IF ( ( ABS( tendenz ) / ffmax ) < 1E-7 )  tendenz = 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 + d(k,j,i) ) * sk_p(k,j,i) - tendenz ) / &
+                           ( 1.0 + 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-1
+                   sums_wsts_bc_l(k,sr) = sums_wsts_bc_l(k,sr) + &
+                                          m1(k,j) * rmask(j,i,sr)
                 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 == 's' )  THEN
-!
-!--       Specific scalar 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 scalar boundary condition at the top boundary
-          IF ( ibc_s_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_s_t_val * dzu(nzt+1)
-                   sk_p(nzt+3,j,i)   = sk_p(nzt+2,j,i) + bc_s_t_val * dzu(nzt+1)
-                ENDDO
-             ENDDO
-
-          ENDIF
-!
-!--    Specific boundary condition for bulk cloud species at the bottom boundary.
-       ELSEIF ( sk_char == 'qc'  .OR.  sk_char == 'qg'  .OR.  sk_char == 'qi'  .OR. &
-                sk_char == 'qr'  .OR.  sk_char == 'qs'  .OR.  sk_char == 'nc'  .OR. &
-                sk_char == 'ng'  .OR.  sk_char == 'ni'  .OR.  sk_char == 'nr'  .OR. &
-                sk_char == 'ns')  THEN
-!
-!--       Bulk species boundary condition at the bottom boundary:
-!--       Dirichlet (fixed mixing ratio or number concenctration).
-          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
-
-!
-!--       Bulk species 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 condition for variable "', sk_char, '"'
-          CALL message( 'advec_s_bc', 'PA0158', 1, 2, 0, 6, 0 )
-
+          ENDDO
        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
-
-       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
-          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
-
-                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
-
-                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
-
-                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
-
-                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 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
+    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-1
+             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
Index: palm/trunk/SOURCE/advec_s_pw.f90
===================================================================
--- palm/trunk/SOURCE/advec_s_pw.f90	(revision 4901)
+++ palm/trunk/SOURCE/advec_s_pw.f90	(revision 1)
@@ -1,40 +1,48 @@
-!> @file advec_s_pw.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE advec_s_pw_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: advec_s_pw.f90,v $
+! Revision 1.12  2006/02/23 09:42:55  raasch
+! nzb_2d replaced by nzb_s_inner
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.11  2004/01/30 10:10:03  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
 !
-! 3927 2019-04-23 13:24:29Z raasch
-! pointer attribute removed from scalar 3d-array for performance reasons
+! Revision 1.10  2003/03/12 16:15:32  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
 !
-! 3665 2019-01-10 08:28:24Z raasch
-! unused variables removed
+! Revision 1.9  2002/06/11 12:22:14  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+! Array sk now declared as a pointer.
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! nopointer option removed
+! Revision 1.8  2001/03/29 17:30:14  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.7  2001/01/22 04:41:39  raasch
+! Module test_variables removed
+!
+! Revision 1.6  2000/01/20 09:13:33  letzel
+! All comments translated into English
+!
+! Revision 1.5  1998/07/06 12:03:09  raasch
+! + USE test_variables
+!
+! Revision 1.4  1998/04/21 15:51:53  raasch
+! Galilei-Transformation eingebaut
+!
+! Revision 1.3  1998/02/10 14:57:53  raasch
+! Es wird jetzt grundsaetzlich die Form C3 verwendet
+!
+! Revision 1.2  1997/09/09 08:27:10  raasch
+! Kehrwerte der Gitterweiten implementiert
 !
 ! Revision 1.1  1997/08/29 08:54:20  raasch
@@ -44,12 +52,11 @@
 ! 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
-
+! 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!
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -60,136 +67,76 @@
        MODULE PROCEDURE advec_s_pw_ij
     END INTERFACE
-
+ 
  CONTAINS
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_s_pw( sk )
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_pw( sk )
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  dd2zu, tend, u, u_stokes_zu, v, v_stokes_zu, w
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
+       IMPLICIT NONE
 
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
+       INTEGER ::  i, j, k
 
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
+       REAL, DIMENSION(:,:,:), POINTER ::  sk
+ 
 
-    USE kinds
+       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)                                      &
+              -0.5 * ( ( 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 * ( ( 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
 
 
-    IMPLICIT NONE
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_pw_ij( i, j, sk )
 
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
-    REAL(wp)     ::  gu  !< local additional advective velocity
-    REAL(wp)     ::  gv  !< local additional advective velocity
+       IMPLICIT NONE
 
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk
+       INTEGER ::  i, j, k
+
+       REAL, DIMENSION(:,:,:), POINTER ::  sk
 
 
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
+       DO  k = nzb_s_inner(j,i)+1, nzt-1
+          tend(k,j,i) = tend(k,j,i)                                            &
+              -0.5 * ( ( 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 * ( ( 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
 
-!
-!--          Galilean transformation + Stokes drift velocity (ocean only)
-             gu = u_gtrans - u_stokes_zu(k)
-             gv = v_gtrans - v_stokes_zu(k)
-
-             tend(k,j,i) = tend(k,j,i) +                                                           &
-                                  ( -0.5_wp * ( ( u(k,j,i+1)  - gu        ) *                      &
-                                                ( sk(k,j,i+1) - sk(k,j,i) )                        &
-                                              - ( u(k,j,i)    - gu        ) *                      &
-                                                ( sk(k,j,i-1) - sk(k,j,i) )                        &
-                                              ) * ddx                                              &
-                                    -0.5_wp * ( ( v(k,j+1,i)  - gv        ) *                      &
-                                                ( sk(k,j+1,i) - sk(k,j,i) )                        &
-                                              - ( v(k,j,i)    - gv        ) *                      &
-                                                ( 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, u_stokes_zu, v, v_stokes_zu, w
-
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
-
-    REAL(wp)     ::  gu  !< local additional advective velocity
-    REAL(wp)     ::  gv  !< local additional advective velocity
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk
-
-
-    DO  k = nzb+1, nzt
-
-!
-!--    Galilean transformation + Stokes drift velocity (ocean only)
-       gu = u_gtrans - u_stokes_zu(k)
-       gv = v_gtrans - v_stokes_zu(k)
-
-       tend(k,j,i) = tend(k,j,i) +                                                                 &
-                                 ( -0.5_wp * ( ( u(k,j,i+1)  - gu        ) *                       &
-                                               ( sk(k,j,i+1) - sk(k,j,i) )                         &
-                                             - ( u(k,j,i)    - gu        ) *                       &
-                                               ( sk(k,j,i-1) - sk(k,j,i) )                         &
-                                             ) * ddx                                               &
-                                   -0.5_wp * ( ( v(k,j+1,i)  - gv        ) *                       &
-                                               ( sk(k,j+1,i) - sk(k,j,i) )                         &
-                                             - ( v(k,j,i)    - gv        ) *                       &
-                                               ( 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 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 4901)
+++ palm/trunk/SOURCE/advec_s_up.f90	(revision 1)
@@ -1,40 +1,45 @@
-!> @file advec_s_up.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE advec_s_up_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
-! Former revisions:
+!
+! Forner revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: advec_s_up.f90,v $
+! Revision 1.11  2006/02/23 09:43:44  raasch
+! nzb_2d replaced by nzb_s_inner
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.10  2004/01/30 10:10:39  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
 !
-! 3927 2019-04-23 13:24:29Z raasch
-! pointer attribute removed from scalar 3d-array for performance reasons
+! Revision 1.9  2003/03/12 16:16:25  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
 !
-! 3665 2019-01-10 08:28:24Z raasch
-! unused variables removed
+! Revision 1.8  2002/06/11 12:23:31  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+! Array sk now declared as a pointer.
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! nopointer option removed
+! Revision 1.7  2001/03/29 17:30:31  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.6  2001/01/22 04:43:56  raasch
+! Module test_variables removed
+!
+! Revision 1.5  2000/01/20 09:16:59  letzel
+! All comments translated into English
+!
+! Revision 1.4  1998/07/06 12:03:46  raasch
+! + USE test_variables
+!
+! Revision 1.3  1998/04/21 15:52:14  raasch
+! Galilei-Transformation eingebaut
+!
+! Revision 1.2  1997/09/09 08:27:24  raasch
+! Kehrwerte der Gitterweiten implementiert
 !
 ! Revision 1.1  1997/08/29 08:54:33  raasch
@@ -44,10 +49,8 @@
 ! 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
-
+! 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!
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -62,138 +65,116 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_s_up( sk )
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_up( sk )
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, tend, u, v, w
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
+       IMPLICIT NONE
 
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
+       INTEGER ::  i, j, k
 
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
-
-    USE kinds
+       REAL ::  ukomp, vkomp, wkomp
+       REAL, DIMENSION(:,:,:), POINTER ::  sk
 
 
-    IMPLICIT NONE
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt
+!
+!--             x-direction
+                ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
+                IF ( ukomp > 0.0 )  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 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
+                IF ( vkomp > 0.0 )  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 * ( w(k,j,i) + w(k-1,j,i) )
+                IF ( wkomp > 0.0 )  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
 
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
+             ENDDO
+          ENDDO
+       ENDDO
 
-    REAL(wp) ::  ukomp !< advection velocity along x-direction
-    REAL(wp) ::  vkomp !< advection velocity along y-direction
-    REAL(wp) ::  wkomp !< advection velocity along z-direction
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !< treated scalar
+    END SUBROUTINE advec_s_up
 
 
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+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
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_up_ij( i, j, sk )
 
-          ENDDO
-       ENDDO
-    ENDDO
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
- END SUBROUTINE advec_s_up
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+
+       REAL ::  ukomp, vkomp, wkomp
+       REAL, DIMENSION(:,:,:), POINTER ::  sk
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_s_up_ij( i, j, sk )
+       DO  k = nzb_s_inner(j,i)+1, nzt
+!
+!--       x-direction
+          ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
+          IF ( ukomp > 0.0 )  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 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
+          IF ( vkomp > 0.0 )  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 * ( w(k,j,i) + w(k-1,j,i) )
+          IF ( wkomp > 0.0 )  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
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, tend, u, v, w
+       ENDDO
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
-
-    REAL(wp) ::  ukomp !< advection velocity along x-direction
-    REAL(wp) ::  vkomp !< advection velocity along y-direction
-    REAL(wp) ::  wkomp !< advection velocity along z-direction
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !< treated scalar
-
-
-    DO  k = nzb+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 SUBROUTINE advec_s_up_ij
 
  END MODULE advec_s_up_mod
Index: palm/trunk/SOURCE/advec_s_ups.f90
===================================================================
--- palm/trunk/SOURCE/advec_s_ups.f90	(revision 1)
+++ palm/trunk/SOURCE/advec_s_ups.f90	(revision 1)
@@ -0,0 +1,199 @@
+ SUBROUTINE advec_s_ups( s, var_char )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: advec_s_ups.f90,v $
+! Revision 1.6  2004/04/30 08:02:43  raasch
+! Enlarged transposition arrays introduced
+!
+! Revision 1.5  2003/03/16 09:23:56  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.4  2001/03/29 17:34:05  raasch
+! v_ad is now allocated locally, several temporary arrays removed from
+! argument lists of spline_* and long_filter_*
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.3  2001/01/22 04:46:10  raasch
+! Module test_variables removed
+!
+! Revision 1.2  2000/01/20 09:28:52  letzel
+! All comments translated into English
+!
+! Revision 1.1  1999/02/05 08:44:47  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-Spline advection of scalar quantities (potential temperature,
+! turbulent kinetic energy). The advection process is divided into three 
+! subsequent steps, one for each of the dimensions. The result is stored as a 
+! tendency in array tend. The computation of the cubic splines and the possible
+! execution of the Long-filter require that all grid points of the relevant 
+! dimension are available. For model runs on more than one PE therefore both the
+! advected and the advecting quantities are transposed accordingly.
+!
+! Actual arguments:
+! s        = scalar quantity to be advected (remains unchanged in this UP)
+! var_char = character string specifying the quantity to be advected
+!
+! Internally used arrays:
+! v_ad     = scalar quantity to be advected, initialized = s at the beginning,
+!            also being used as temporary storage after each time step
+! d        = advecting component (u, v, or w)
+!------------------------------------------------------------------------------!
+
+    USE advection
+    USE arrays_3d
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  var_char
+
+    INTEGER ::  i, j, k
+    REAL    ::  s(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  v_ad
+
+    CALL cpu_log( log_point_s(16), 'advec_s_ups', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Advection of the scalar in x-direction:
+!-- Store the scalar in temporary array v_ad (component to be advected,
+!-- boundaries are not used because they disturb the transposition)
+    ALLOCATE( v_ad(nzb+1:nzta,nys:nyna,nxl:nxra) )
+    v_ad = 0.0
+    v_ad(nzb+1:nzt,nys:nyn,nxl:nxr) = s(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+       DEALLOCATE( tend )
+       ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+    ENDIF
+
+!
+!-- Transpose the component to be advected: z --> x
+    CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
+
+#else
+
+!
+!-- Advection of the scalar in x-direction:
+!-- Store the scalar in temporary array v_ad (component to be advected)
+    ALLOCATE( v_ad(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    v_ad(:,:,:) = s(:,:,:)
+
+#endif
+
+!
+!-- Advecting component (u) must be averaged out on the scalar's grid
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+              d(k,j,i) = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
+          ENDDO
+       ENDDO
+    ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting componnet: z --> x
+    CALL transpose_zx( d, tend, d, tend, d )
+
+#endif
+
+!
+!-- Upstream-Spline advection of the scalar in x-direction
+    CALL spline_x( v_ad, d, var_char )
+
+!
+!-- Advection of the scalar in y-direction:
+!-- advecting component (v) must be averaged out on the scalar's grid
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+              d(k,j,i) = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
+          ENDDO
+       ENDDO
+    ENDDO
+
+#if defined( __parallel )
+    
+!
+!-- Transpose the advecting component: z --> y
+    CALL transpose_zx( d, tend, d, tend, d )
+    CALL transpose_xy( d, tend, d, tend, d )
+
+!
+!-- Transpose the component to be advected: x --> y
+    CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
+
+#endif
+
+!
+!-- Upstream-Spline advection of the scalar in y-direction
+    CALL spline_y( v_ad, d, var_char )
+
+!
+!-- Advection of the scalar in z-direction:
+!-- the advecting component (w) must be averaged out on the scalar's grid
+!-- (weighted for non-equidistant grid)
+    d = 0.0
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             d(k,j,i) =  ( w(k,j,i) * ( zu(k) - zw(k-1) ) + &
+                           w(k-1,j,i) * ( zw(k) - zu(k) ) ) * ddzw(k)
+          ENDDO
+       ENDDO
+    ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
+    CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
+    CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
+
+!
+!-- Resize tend to its normal size
+    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+       DEALLOCATE( tend )
+       ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    ENDIF
+
+#endif
+
+!
+!-- Upstream-Spline advection of the scalar in z-direction
+    CALL spline_z( v_ad, d, dzu, spl_tri_zu, var_char )
+
+!
+!-- Compute the tendency term
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             tend(k,j,i) = ( v_ad(k,j,i) - s(k,j,i) ) / dt_3d 
+          ENDDO
+       ENDDO
+    ENDDO
+
+    DEALLOCATE( v_ad )
+
+    CALL cpu_log( log_point_s(16), 'advec_s_ups', 'stop' )
+
+ END SUBROUTINE advec_s_ups
Index: palm/trunk/SOURCE/advec_u_pw.f90
===================================================================
--- palm/trunk/SOURCE/advec_u_pw.f90	(revision 4901)
+++ palm/trunk/SOURCE/advec_u_pw.f90	(revision 1)
@@ -1,34 +1,42 @@
-!> @file advec_u_pw.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE advec_u_pw_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: advec_u_pw.f90,v $
+! Revision 1.15  2006/02/23 09:44:21  raasch
+! nzb_2d replaced by nzb_u_inner
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.14  2005/03/26 14:49:31  raasch
+! Extension of horizontal loop upper bounds for non-cyclic boundary conditions
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! variables documented
+! Revision 1.13  2004/01/30 10:11:21  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.12  2003/03/12 16:17:06  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.11  2002/06/11 12:25:00  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.10  2001/03/29 17:34:21  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.9  2001/01/22 04:55:36  raasch
+! Module test_variables removed
+!
+! Revision 1.8  2000/01/20 09:34:26  letzel
+! All comments translated into English
+!
+! Revision 1.7  1998/08/05 06:47:04  raasch
+! Alle Gitterpunkte gleich behandelt (keine zentralen Differenzenquotienten
+! mehr bei Vertikaladvektion bei k=1)
 !
 ! Revision 1.1  1997/08/11 06:09:21  raasch
@@ -38,11 +46,9 @@
 ! 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
-
+! 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.
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -53,104 +59,74 @@
        MODULE PROCEDURE advec_u_pw_ij
     END INTERFACE advec_u_pw
-
+ 
  CONTAINS
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_u_pw
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_pw
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzw, tend, u, v, w
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
+       IMPLICIT NONE
 
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
+       INTEGER ::  i, j, k
+       REAL    ::  gu, gv
+ 
+       gu = 2.0 * u_gtrans
+       gv = 2.0 * v_gtrans
+       DO  i = nxl, nxr+uxrp
+          DO  j = nys, nyn
+             DO  k = nzb_u_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) - 0.25 * (                           &
+                         ( 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
 
-    USE indices,                                                                                   &
-        ONLY:  nxlu, nxr, nyn, nys, nzb, nzt
-
-    USE kinds
+    END SUBROUTINE advec_u_pw
 
 
-    IMPLICIT NONE
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_pw_ij( i, j )
 
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
-    REAL(wp)     ::  gu !< Galilei-transformation velocity along x
-    REAL(wp)     ::  gv !< Galilei-transformation velocity along y
+       IMPLICIT NONE
 
-    gu = 2.0_wp * u_gtrans
-    gv = 2.0_wp * v_gtrans
-    DO  i = nxlu, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+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
+       INTEGER ::  i, j, k
+       REAL    ::  gu, gv
+
+       gu = 2.0 * u_gtrans
+       gv = 2.0 * v_gtrans
+       DO  k = nzb_u_inner(j,i)+1, nzt
+          tend(k,j,i) = tend(k,j,i) - 0.25 * (                                 &
+                         ( 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
 
- 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, nzt
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
-
-    REAL(wp)     ::  gu !< Galilei-transformation velocity along x
-    REAL(wp)     ::  gv !< Galilei-transformation velocity along y
-
-    gu = 2.0_wp * u_gtrans
-    gv = 2.0_wp * v_gtrans
-    DO  k = nzb+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 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 4901)
+++ palm/trunk/SOURCE/advec_u_up.f90	(revision 1)
@@ -1,34 +1,47 @@
-!> @file advec_u_up.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE advec_u_up_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: advec_u_up.f90,v $
+! Revision 1.12  2006/02/23 09:45:04  raasch
+! nzb_2d replaced by nzb_u_inner
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.11  2005/03/26 14:50:43  raasch
+! Extension of horizontal loop upper bounds for non-cyclic boundary conditions
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! variables documented
+! Revision 1.10  2004/01/30 10:11:47  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.9  2003/03/12 16:17:42  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.8  2002/06/11 12:25:43  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.7  2001/03/29 17:35:08  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.6  2001/01/22 04:57:23  raasch
+! Module test_variables removed
+!
+! Revision 1.5  2000/01/20 09:40:00  letzel
+! All comments translated into English
+!
+! Revision 1.4  1998/07/06 12:04:43  raasch
+! + USE test_variables
+!
+! Revision 1.3  1998/04/21 15:52:51  raasch
+! Galilei-Transformation eingebaut
+!
+! Revision 1.2  1997/09/09 08:27:49  raasch
+! Kehrwerte der Gitterweiten implementiert
 !
 ! Revision 1.1  1997/08/29 08:55:25  raasch
@@ -38,10 +51,8 @@
 ! 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
-
+! 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!
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -56,134 +67,117 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_u_up
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_up
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, tend, u, v, w
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
+       IMPLICIT NONE
 
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
+       INTEGER ::  i, j, k
 
-    USE indices,                                                                                   &
-        ONLY:  nxlu, nxr, nyn, nys, nzb, nzt
-
-    USE kinds
+       REAL ::  ukomp, vkomp, wkomp
 
 
-    IMPLICIT NONE
+       DO  i = nxl, nxr+uxrp
+          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 )  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 * ( 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 )  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 * ( w(k,j,i)   + w(k-1,j,i) + &
+                                 w(k,j,i-1) + w(k-1,j,i-1) )
+                IF ( wkomp > 0.0 )  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
 
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
+             ENDDO
+          ENDDO
+       ENDDO
 
-    REAL(wp) ::  ukomp !< advection velocity along x-direction
-    REAL(wp) ::  vkomp !< advection velocity along y-direction
-    REAL(wp) ::  wkomp !< advection velocity along z-direction
+    END SUBROUTINE advec_u_up
 
 
-    DO  i = nxlu, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+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
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_up_ij( i, j )
 
-          ENDDO
-       ENDDO
-    ENDDO
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
- END SUBROUTINE advec_u_up
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+
+       REAL ::  ukomp, vkomp, wkomp
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_u_up_ij( i, j )
+       DO  k = nzb_u_inner(j,i)+1, nzt
+!
+!--       x-direction
+          ukomp = u(k,j,i) - u_gtrans
+          IF ( ukomp > 0.0 )  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 * ( 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 )  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 * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
+          IF ( wkomp > 0.0 )  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
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, tend, u, v, w
+       ENDDO
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nzb, nzt
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
-
-    REAL(wp) ::  ukomp !< advection velocity along x-direction
-    REAL(wp) ::  vkomp !< advection velocity along y-direction
-    REAL(wp) ::  wkomp !< advection velocity along z-direction
-
-
-    DO  k = nzb+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 SUBROUTINE advec_u_up_ij
 
  END MODULE advec_u_up_mod
Index: palm/trunk/SOURCE/advec_u_ups.f90
===================================================================
--- palm/trunk/SOURCE/advec_u_ups.f90	(revision 1)
+++ palm/trunk/SOURCE/advec_u_ups.f90	(revision 1)
@@ -0,0 +1,192 @@
+ SUBROUTINE advec_u_ups 
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: advec_u_ups.f90,v $
+! Revision 1.6  2004/04/30 08:03:19  raasch
+! Enlarged transposition arrays introduced
+!
+! Revision 1.5  2003/03/16 09:25:07  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.4  2001/03/29 17:35:32  raasch
+! v_ad is now allocated locally, several temporary arrays removed from
+! argument lists of spline_* and long_filter_*
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.3  2001/01/22 04:59:29  raasch
+! Module test_variables removed
+!
+! Revision 1.2  2000/01/20 09:46:52  letzel
+! All comments translated into English
+!
+! Revision 1.1  1999/02/05 08:49:08  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-Spline advection of the u velocity-component. The advection process
+! is divided into three subsequent steps, one for each of the dimensions. The
+! results is stored as a tendency in array tend. The computation of the cubic
+! splines and the possible execution of the Long-filter require that all grid
+! points of the relevant dimension are available. For model runs on more than
+! one PE therefore both the advected and the advecting quantities are
+! transposed accordingly.
+!
+! Internally used arrays:
+! v_ad = scalar quantity to be advected, initialised = u at the beginning,
+!        also being used as temporary storage after each time step
+! d    = advecting component (u, v, or w)
+!------------------------------------------------------------------------------!
+
+    USE advection
+    USE arrays_3d
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    INTEGER :: i, j, k
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  v_ad
+
+    
+    CALL cpu_log( log_point_s(17), 'advec_u_ups', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Advection of u in x-direction:
+!-- Store u in temporary array v_ad (component to be advected, boundaries
+!-- are not used because they disturb the transposition)
+    ALLOCATE( v_ad(nzb+1:nzta,nys:nyna,nxl:nxra) )
+    v_ad = 0.0
+    v_ad(nzb+1:nzt,nys:nyn,nxl:nxr) = u(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+       DEALLOCATE( tend )
+       ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+    ENDIF
+
+!
+!-- Transpose the component to be advected: z --> x
+    CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
+
+!
+!-- Advecting component (d) = component to be advected (v_ad) (variable d is
+!-- used for storage, because it is the only one having suitable dimensions).
+!-- NOTE: here x is the first dimension and lies completely on the PE.
+    d = v_ad - u_gtrans
+
+#else
+
+!
+!-- Advection of u in x-direction:
+!-- Store u in temporary array v_ad (component to be advected)
+    ALLOCATE( v_ad(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    v_ad(:,:,:) = u(:,:,:)
+
+!
+!-- Advecting component (d) = component to be advected (u) (variable d is used
+!-- for storage, because it is the only one having suitable dimensions. This is 
+!-- done for for reasons of compatibility with the parallel part.)
+    d(:,:,:) = u(nzb+1:nzt,nys:nyn,nxl:nxr) - u_gtrans
+
+#endif
+
+!
+!-- Upstream-Spline advection of u in x-direction. Array tend comes out
+!-- as v_ad before the advection step including cyclic boundaries.
+!-- It is needed for the long filter.
+    CALL spline_x( v_ad, d, 'u' )
+
+!
+!-- Advection of u in y-direction:
+!-- advecting component (v) must be averaged out on the u grid
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+              d(k,j,i) = 0.25 * ( v(k,j,i-1) + v(k,j+1,i-1) + &
+                                  v(k,j,i)   + v(k,j+1,i) ) - v_gtrans
+          ENDDO
+       ENDDO
+    ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting component: z --> y
+    CALL transpose_zx( d, tend, d, tend, d )
+    CALL transpose_xy( d, tend, d, tend, d )
+
+!
+!-- Transpose the component to be advected: x --> y
+    CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
+
+#endif
+
+!
+!-- Upstream-Spline advection of u in y-direction
+    CALL spline_y( v_ad, d, 'u' )
+
+!
+!-- Advection of u in z-direction:
+!-- the advecting component (w) must be averaged out on the u grid
+!-- (weighted for non-equidistant grid)
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             d(k,j,i) =  ( 0.5 * ( w(k,j,i)   + w(k,j,i-1)   ) * &
+                                 ( zu(k) - zw(k-1) )             &
+                         + 0.5 * ( w(k-1,j,i) + w(k-1,j,i-1) ) * &
+                                 ( zw(k) - zu(k)   )             &
+                         ) * ddzw(k)
+          ENDDO
+       ENDDO
+    ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
+    CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
+    CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
+
+!
+!-- Resize tend to its normal size
+    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+       DEALLOCATE( tend )
+       ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    ENDIF
+
+#endif
+
+!
+!-- Upstream-Spline advection of u in z-direction
+    CALL spline_z( v_ad, d, dzu, spl_tri_zu, 'u' )
+
+!
+!-- Compute the tendency term
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             tend(k,j,i) = ( v_ad(k,j,i) - u(k,j,i) ) / dt_3d 
+          ENDDO
+       ENDDO
+    ENDDO
+
+    DEALLOCATE( v_ad )
+
+    CALL cpu_log( log_point_s(17), 'advec_u_ups', 'stop' )
+
+ END SUBROUTINE advec_u_ups
Index: palm/trunk/SOURCE/advec_v_pw.f90
===================================================================
--- palm/trunk/SOURCE/advec_v_pw.f90	(revision 4901)
+++ palm/trunk/SOURCE/advec_v_pw.f90	(revision 1)
@@ -1,34 +1,42 @@
-!> @file advec_v_pw.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE advec_v_pw_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: advec_v_pw.f90,v $
+! Revision 1.15  2006/02/23 09:46:08  raasch
+! nzb_2d replaced by nzb_v_inner
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-! 
-! 3655 2019-01-07 16:51:22Z knoop
-! variables documented
+! Revision 1.14  2005/03/26 14:52:51  raasch
+! Extension of horizontal loop upper bounds for non-cyclic boundary conditions
+!
+! Revision 1.13  2004/01/30 10:12:25  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.12  2003/03/12 16:18:19  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.11  2002/06/11 12:26:18  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.10  2001/03/29 17:36:06  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.9  2001/01/22 05:14:48  raasch
+! Module test_variables removed
+!
+! Revision 1.8  2000/01/20 10:16:37  letzel
+! All comments translated into English
+!
+! Revision 1.7  1998/08/05 06:49:43  raasch
+! Alle Gitterpunkte gleich behandelt (keine zentralen Differenzenquotienten mehr
+! bei Vertikaladvektion bei k=1)
 !
 ! Revision 1.1  1997/08/11 06:09:57  raasch
@@ -38,11 +46,9 @@
 ! 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
- 
+! 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.
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -57,102 +63,72 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_v_pw
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_v_pw
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzw, tend, u, v, w
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
+       IMPLICIT NONE
 
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
+       INTEGER ::  i, j, k
+       REAL    ::  gu, gv
+ 
 
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nyn, nysv, nzb, nzt
+       gu = 2.0 * u_gtrans
+       gv = 2.0 * v_gtrans
+       DO  i = nxl, nxr
+          DO  j = nys, nyn+vynp
+             DO  k = nzb_v_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) - 0.25 * (                           &
+                         ( 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
 
-    USE kinds
+    END SUBROUTINE advec_v_pw
 
 
-    IMPLICIT NONE
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_v_pw_ij( i, j )
 
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
-    
-    REAL(wp)     ::  gu !< Galilei-transformation velocity along x
-    REAL(wp)     ::  gv !< Galilei-transformation velocity along y
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+       REAL    ::  gu, gv
 
 
-    gu = 2.0_wp * u_gtrans
-    gv = 2.0_wp * v_gtrans
-    DO  i = nxl, nxr
-       DO  j = nysv, nyn
-          DO  k = nzb+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
+       gu = 2.0 * u_gtrans
+       gv = 2.0 * v_gtrans
+       DO  k = nzb_v_inner(j,i)+1, nzt
+          tend(k,j,i) = tend(k,j,i) - 0.25 * (                              &
+                         ( 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
-
- 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, nzt
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
-    
-    REAL(wp)     ::  gu !< Galilei-transformation velocity along x
-    REAL(wp)     ::  gv !< Galilei-transformation velocity along y
-
-
-    gu = 2.0_wp * u_gtrans
-    gv = 2.0_wp * v_gtrans
-    DO  k = nzb+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 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 4901)
+++ palm/trunk/SOURCE/advec_v_up.f90	(revision 1)
@@ -1,34 +1,47 @@
-!> @file advec_v_up.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE advec_v_up_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: advec_v_up.f90,v $
+! Revision 1.12  2006/02/23 09:46:37  raasch
+! nzb_2d replaced by nzb_v_inner
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-! 
-! 3655 2019-01-07 16:51:22Z knoop
-! variables documented
+! Revision 1.11  2005/03/26 14:55:59  raasch
+! Extension of horizontal loop upper bounds for non-cyclic boundary conditions
+!
+! Revision 1.10  2004/01/30 10:12:45  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.9  2003/03/12 16:19:00  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.8  2002/06/11 12:26:48  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.7  2001/03/29 17:36:22  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.6  2001/01/22 05:16:19  raasch
+! Module test_variables removed
+!
+! Revision 1.5  2000/01/20 10:20:31  letzel
+! All comments translated into English
+!
+! Revision 1.4  1998/07/06 12:05:37  raasch
+! + USE test_variables
+!
+! Revision 1.3  1998/04/21 15:53:36  raasch
+! Galilei-Transformation eingebaut
+!
+! Revision 1.2  1997/09/09 08:28:21  raasch
+! Kehrwerte der Gitterweiten implementiert
 !
 ! Revision 1.1  1997/08/29 08:56:05  raasch
@@ -38,10 +51,8 @@
 ! 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
- 
+! 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!
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -56,134 +67,116 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_v_up
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_v_up
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, tend, u, v, w
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
+       IMPLICIT NONE
 
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nyn, nysv, nzb, nzt
-
-    USE kinds
+       INTEGER ::  i, j, k
+       REAL    ::  ukomp, vkomp, wkomp
 
 
-    IMPLICIT NONE
+       DO  i = nxl, nxr
+          DO  j = nys, nyn+vynp
+             DO  k = nzb_v_inner(j,i)+1, nzt
+!
+!--             x-direction
+                ukomp = 0.25 * ( 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 )  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 )  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 * ( w(k,j,i)  + w(k-1,j,i) + &
+                                 w(k,j-1,i) + w(k-1,j-1,i) )
+                IF ( wkomp > 0.0 )  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
 
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
+             ENDDO
+          ENDDO
+       ENDDO
 
-    REAL(wp) ::  ukomp !< advection velocity along x-direction 
-    REAL(wp) ::  vkomp !< advection velocity along y-direction 
-    REAL(wp) ::  wkomp !< advection velocity along z-direction       
+    END SUBROUTINE advec_v_up
 
 
-    DO  i = nxl, nxr
-       DO  j = nysv, nyn
-          DO  k = nzb+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
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_v_up_ij( i, j )
 
-          ENDDO
-       ENDDO
-    ENDDO
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
- END SUBROUTINE advec_v_up
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+
+       REAL ::  ukomp, vkomp, wkomp
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_v_up_ij( i, j )
+       DO  k = nzb_v_inner(j,i)+1, nzt
+!
+!--       x-direction
+          ukomp = 0.25 * ( 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 )  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 )  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 * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )
+          IF ( wkomp > 0.0 )  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
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, tend, u, v, w
+       ENDDO
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nzb, nzt
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
-
-    REAL(wp) ::  ukomp !< advection velocity along x-direction 
-    REAL(wp) ::  vkomp !< advection velocity along y-direction 
-    REAL(wp) ::  wkomp !< advection velocity along z-direction 
-
-
-    DO  k = nzb+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 SUBROUTINE advec_v_up_ij
 
  END MODULE advec_v_up_mod
Index: palm/trunk/SOURCE/advec_v_ups.f90
===================================================================
--- palm/trunk/SOURCE/advec_v_ups.f90	(revision 1)
+++ palm/trunk/SOURCE/advec_v_ups.f90	(revision 1)
@@ -0,0 +1,194 @@
+ SUBROUTINE advec_v_ups
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: advec_v_ups.f90,v $
+! Revision 1.7  2004/04/30 08:03:52  raasch
+! Enlarged transposition arrays introduced
+!
+! Revision 1.6  2003/03/16 09:25:59  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.5  2001/03/29 17:36:43  raasch
+! v_ad is now allocated locally, several temporary arrays removed from
+! argument lists of spline_* and long_filter_*
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.4  2001/01/22 08:31:10  raasch
+! Module test_variables removed
+!
+!
+! Revision 1.2  2000/01/20 09:52:54  letzel
+! All comments translated into English
+!
+! Revision 1.1  1999/02/05 08:50:32  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-Spline advection of the v velocity-component. The advection process
+! is divided into three subsequent steps, one for each of the dimensions. The
+! result is stored as a tendency in array tend. The computation of the cubic
+! splines and the possible execution of the Long-filter require that all grid
+! points of the relevant dimension are available. For model runs on more than
+! one PE therefore both the advected and the advecting quantities are
+! transposed accordingly.
+!
+! Internally used arrays:
+! v_ad = scalar quantity to be advected, initialised = v at the beginning,
+!        also being used as temporary storage after each time step
+! d    = advecting component (u, v, or w)
+!------------------------------------------------------------------------------!
+
+    USE advection
+    USE arrays_3d
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  v_ad
+
+
+    CALL cpu_log( log_point_s(18), 'advec_v_ups', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Advection of v in x-direction:
+!-- Store v in temporary array v_ad (component to be advected, boundaries
+!-- are not used because they disturb the transposition)
+    ALLOCATE( v_ad(nzb+1:nzta,nys:nyna,nxl:nxra) )
+    v_ad = 0.0
+    v_ad(nzb+1:nzt,nys:nyn,nxl:nxr) = v(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+       DEALLOCATE( tend )
+       ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+    ENDIF
+
+!
+!-- Transpose the component to be advected: z --> x
+    CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
+
+#else
+
+!
+!-- Advection of v in x-direction:
+!-- Store v in temporary array v_ad (component to be advected)
+    ALLOCATE( v_ad(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    v_ad(:,:,:) = v(:,:,:)
+
+#endif
+
+!
+!-- Advecting component (u) must be averaged out on the v grid
+    d = 0.0
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             d(k,j,i) = 0.25 * ( u(k,j-1,i) + u(k,j-1,i+1) + &
+                                 u(k,j,i+1) + u(k,j,i) ) - u_gtrans
+          ENDDO
+       ENDDO
+    ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting component: z --> x
+    CALL transpose_zx( d, tend, d, tend, d )
+
+#endif
+
+!
+!-- Upstream-Spline advection of v in x-direction. Array tend comes out
+!-- as v_ad before the advection step including cyclic boundaries.
+!-- It is needed for the long filter.
+    CALL spline_x( v_ad, d, 'v' )
+
+!
+!-- Advection of v in y-direction:
+!-- advecting component (d) = component to be advected (v)
+    d(nzb+1:nzt,nys:nyn,nxl:nxr) = v(nzb+1:nzt,nys:nyn,nxl:nxr) - v_gtrans
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting component: z --> y
+    CALL transpose_zx( d, tend, d, tend, d )
+    CALL transpose_xy( d, tend, d, tend, d )
+
+!
+!-- Transpose the component to be advected: x --> y
+    CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
+
+#endif
+
+!
+!-- Upstream-Spline advection of v in y-direction
+    CALL spline_y( v_ad, d, 'v' )
+
+!
+!-- Advection of v in z-direction:
+!-- the advecting component (w) must be averaged out on the v grid
+!-- (weighted for non-equidistant grid)
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             d(k,j,i) =  ( 0.5 * ( w(k-1,j-1,i) + w(k-1,j,i) ) * &
+                                 ( zw(k) - zu(k) ) + &
+                           0.5 * ( w(k,j,i) + w(k,j-1,i) ) * &
+                                 ( zu(k) - zw(k-1) ) &
+                         ) * ddzw(k)
+          ENDDO
+       ENDDO
+    ENDDO
+
+#if defined( __parallel )
+    
+!
+!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
+    CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
+    CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
+
+!
+!-- Resize tend to its normal size
+    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+       DEALLOCATE( tend )
+       ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    ENDIF
+
+#endif
+
+!
+!-- Upstream-Spline advection of v in z-direction
+    CALL spline_z( v_ad, d, dzu, spl_tri_zu, 'v' )
+
+!
+!-- Compute the tendency term
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             tend(k,j,i) = ( v_ad(k,j,i) - v(k,j,i) ) / dt_3d 
+          ENDDO
+       ENDDO
+    ENDDO
+
+    DEALLOCATE( v_ad )
+
+    CALL cpu_log( log_point_s(18), 'advec_v_ups', 'stop' )
+
+ END SUBROUTINE advec_v_ups
Index: palm/trunk/SOURCE/advec_w_pw.f90
===================================================================
--- palm/trunk/SOURCE/advec_w_pw.f90	(revision 4901)
+++ palm/trunk/SOURCE/advec_w_pw.f90	(revision 1)
@@ -1,34 +1,39 @@
-!> @file advec_w_pw.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE advec_w_pw_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: advec_w_pw.f90,v $
+! Revision 1.15  2006/02/23 09:47:01  raasch
+! nzb_2d replaced by nzb_w_inner
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-! 
-! 3655 2019-01-07 16:51:22Z knoop
-! variables documented
+! Revision 1.14  2004/01/30 10:13:07  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.13  2003/03/12 16:19:29  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.12  2002/06/11 12:27:33  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.11  2001/03/29 17:37:10  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.10  2001/01/22 05:19:42  raasch
+! Module test_variables removed
+!
+! Revision 1.9  2000/01/20 10:18:31  letzel
+! All comments translated into English
+!
+! Revision 1.8  1998/08/05 06:51:10  raasch
+! Alle Gitterpunkte werden gleich behandelt (keine zentralen Differenzenquotien-
+! ten mehr bei Vertikaladvektion bei k=1)
 !
 ! Revision 1.1  1997/08/11 06:10:29  raasch
@@ -38,11 +43,9 @@
 ! 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
- 
+! 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.
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -57,100 +60,72 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_w_pw
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_pw
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, tend, u, v, w
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
+       IMPLICIT NONE
 
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
+       INTEGER ::  i, j, k
+       REAL    ::  gu, gv
 
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
+ 
+       gu = 2.0 * u_gtrans
+       gv = 2.0 * 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 * (                           &
+                         ( 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
 
-    USE kinds
+    END SUBROUTINE advec_w_pw
 
 
-    IMPLICIT NONE
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_pw_ij( i, j )
 
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
-    
-    REAL(wp)     ::  gu !< Galilei-transformation velocity along x
-    REAL(wp)     ::  gv !< Galilei-transformation velocity along y
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+       REAL    ::  gu, gv
 
 
-    gu = 2.0_wp * u_gtrans
-    gv = 2.0_wp * v_gtrans
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+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
+       gu = 2.0 * u_gtrans
+       gv = 2.0 * v_gtrans
+       DO  k = nzb_w_inner(j,i)+1, nzt
+          tend(k,j,i) = tend(k,j,i) - 0.25 * (                              &
+                         ( 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
 
- 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, nzt
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
-    
-    REAL(wp)     ::  gu !< Galilei-transformation velocity along x
-    REAL(wp)     ::  gv !< Galilei-transformation velocity along y
-
-    gu = 2.0_wp * u_gtrans
-    gv = 2.0_wp * v_gtrans
-    DO  k = nzb+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 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 4901)
+++ palm/trunk/SOURCE/advec_w_up.f90	(revision 1)
@@ -1,34 +1,44 @@
-!> @file advec_w_up.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE advec_w_up_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-! 
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-! 
-! 3655 2019-01-07 16:51:22Z knoop
-! variables documented
+! $Log: advec_w_up.f90,v $
+! Revision 1.11  2006/02/23 09:47:23  raasch
+! *** empty log message ***
+!
+! Revision 1.10  2004/01/30 10:13:31  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.9  2003/03/12 16:20:07  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.8  2002/06/11 12:28:33  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.7  2001/03/29 17:37:31  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.6  2001/01/22 05:21:01  raasch
+! Module test_variables removed
+!
+! Revision 1.5  2000/01/20 10:22:08  letzel
+! All comments translated into English
+!
+! Revision 1.4  1998/07/06 12:06:25  raasch
+! + USE test_variables
+!
+! Revision 1.3  1998/04/21 15:54:20  raasch
+! Galilei-Transformation eingebaut
+!
+! Revision 1.2  1997/09/09 08:28:55  raasch
+! Kehrwerte der Gitterweiten implementiert
 !
 ! Revision 1.1  1997/08/29 08:56:33  raasch
@@ -38,10 +48,8 @@
 ! 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
- 
+! 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!
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -56,130 +64,114 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_w_up
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_up
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzw, tend, u, v, w
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
+       IMPLICIT NONE
 
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
-
-    USE kinds
+       INTEGER ::  i, j, k
+       REAL    ::  ukomp, vkomp
 
 
-    IMPLICIT NONE
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_w_inner(j,i)+1, nzt-1
+!
+!--             x-direction
+                ukomp = 0.25 * ( 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 )  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 * ( 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 )  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 )  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
 
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
+             ENDDO
+          ENDDO
+       ENDDO
 
-    REAL(wp) ::  ukomp !< advection velocity along x-direction 
-    REAL(wp) ::  vkomp !< advection velocity along y-direction 
+    END SUBROUTINE advec_w_up
 
 
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+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
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_up_ij( i, j )
 
-          ENDDO
-       ENDDO
-    ENDDO
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
- END SUBROUTINE advec_w_up
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+       REAL    ::  ukomp, vkomp
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_w_up_ij( i, j )
+       DO  k = nzb_w_inner(j,i)+1, nzt-1
+!
+!--       x-direction
+          ukomp = 0.25 * ( 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 )  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 * ( 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 )  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 )  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
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzw, tend, u, v, w
+       ENDDO
 
-    USE control_parameters,                                                                        &
-        ONLY:  u_gtrans, v_gtrans
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nzb, nzt
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !< grid index along x-direction
-    INTEGER(iwp) ::  j !< grid index along y-direction
-    INTEGER(iwp) ::  k !< grid index along z-direction
-
-    REAL(wp) ::  ukomp !< advection velocity along x-direction 
-    REAL(wp) ::  vkomp !< advection velocity along y-direction 
-
-
-    DO  k = nzb+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 SUBROUTINE advec_w_up_ij
 
  END MODULE advec_w_up_mod
Index: palm/trunk/SOURCE/advec_w_ups.f90
===================================================================
--- palm/trunk/SOURCE/advec_w_ups.f90	(revision 1)
+++ palm/trunk/SOURCE/advec_w_ups.f90	(revision 1)
@@ -0,0 +1,189 @@
+ SUBROUTINE advec_w_ups
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: advec_w_ups.f90,v $
+! Revision 1.6  2004/04/30 08:05:05  raasch
+! Enlarged transposition arrays introduced
+!
+! Revision 1.5  2003/03/16 09:26:46  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.4  2001/03/29 17:37:53  raasch
+! v_ad is now allocated locally, several temporary arrays removed from
+! argument lists of spline_* and long_filter_*
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.3  2001/01/22 05:23:31  raasch
+! Module test_variables removed
+!
+! Revision 1.2  2000/01/20 09:57:15  letzel
+! All comments translated into English
+!
+! Revision 1.1  1999/02/05 08:52:09  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-Spline advection of the w velocity-component. The advection process
+! is divided into three subsequent steps, one for each of the dimensions. The
+! result is stored as a tendency in array tend. The computation of the cubic
+! splines and the possible execution of the Long-filter require that all grid
+! points of the relevant dimension are available. For model runs on more than
+! one PE therefore both the advected and the advecting quantities are
+! transposed accordingly.
+!
+! Internally used arrays:
+! v_ad = scalar quantity to be advected, initialised = w at the beginning, also
+!        being used as temporary storage after each time step
+! d    = advecting component (u, v, or w)
+!------------------------------------------------------------------------------!
+
+    USE advection
+    USE arrays_3d
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    INTEGER ::  i,j,k
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  v_ad
+
+
+    CALL cpu_log( log_point_s(19), 'advec_w_ups', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Advection of w in x-direction:
+!-- Store w in temporary array v_ad (component to be advected, boundaries
+!-- are not used because they disturb the transposition)
+    ALLOCATE( v_ad(nzb+1:nzta,nys:nyna,nxl:nxra) )
+    v_ad = 0.0
+    v_ad(nzb+1:nzt,nys:nyn,nxl:nxr) = w(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+       DEALLOCATE( tend )
+       ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+    ENDIF
+
+!
+!-- Transpose the component to be advected: z --> x
+    CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
+
+#else
+
+!
+!-- Advection of w in x-direction:
+!-- Store w in temporary array v_ad (component to be advected)
+    ALLOCATE( v_ad(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    v_ad(:,:,:) = w(:,:,:)
+
+#endif
+
+!
+!-- Advecting component (u) must be averaged out on the w grid
+    d = 0.0
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             d(k,j,i) = 0.25 * ( u(k,j,i) + u(k,j,i+1) +   &
+                                 u(k+1,j,i+1) + u(k+1,j,i) ) - u_gtrans
+          ENDDO
+       ENDDO
+    ENDDO
+    
+#if defined( __parallel )
+
+!
+!-- Transpose the component to be advected: z --> x
+    CALL transpose_zx( d, tend, d, tend, d )
+
+#endif
+
+!
+!-- Upstream-Spline advection of w in x-direction. Array tend comes out
+!-- as v_ad before the advection step including cyclic boundaries.
+!-- It is needed for the long filter.
+    CALL spline_x( v_ad, d, 'w' )
+
+!
+!-- Advection of w in y-direction:
+!-- advecting component (v) must be averaged out on the w grid
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             d(k,j,i) = 0.25 * ( v(k,j,i) + v(k,j+1,i) +   &
+                                 v(k+1,j+1,i) + v(k+1,j,i) ) - v_gtrans
+          ENDDO
+       ENDDO
+    ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting component: z --> y
+    CALL transpose_zx( d, tend, d, tend, d )
+    CALL transpose_xy( d, tend, d, tend, d )
+
+!
+!-- Transpose the component to be advected: x --> y
+    CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
+
+#endif
+
+!
+!-- Upstream-Spline advection of w in y-direction
+    CALL spline_y( v_ad, d, 'w' )
+
+!
+!-- Advection of w in z-direction:
+!-- advecting component (d) = component to be advected (v_ad)
+    d(nzb+1:nzt,nys:nyn,nxl:nxr) = w(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+#if defined( __parallel )
+
+!
+!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
+    CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
+    CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
+
+!
+!-- Resize tend to its normal size
+    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+       DEALLOCATE( tend )
+       ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    ENDIF
+
+#endif
+
+!
+!-- Upstream-Spline advection of w in z-direction
+    CALL spline_z( v_ad, d, dzw, spl_tri_zw, 'w' )
+
+!
+!-- Compute the tendency term
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             tend(k,j,i) = ( v_ad(k,j,i) - w(k,j,i) ) / dt_3d
+          ENDDO
+       ENDDO
+    ENDDO
+
+    DEALLOCATE( v_ad )
+
+    CALL cpu_log( log_point_s(19), 'advec_w_ups', 'stop' )
+
+ END SUBROUTINE advec_w_ups
Index: palm/trunk/SOURCE/advec_ws.f90
===================================================================
--- palm/trunk/SOURCE/advec_ws.f90	(revision 4901)
+++ 	(revision )
@@ -1,6020 +1,0 @@
-!> @file advec_ws.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Implement snow and graupel (bulk microphysics)
-!
-! 4697 2020-09-25 08:24:29Z suehring
-! To avoid numerical oscillations which may lead to a built-up of passive scalar near non-cyclic
-! boundaries, employ a first-order scheme at the 3 grid points next to the boundary for passive
-! scalars
-! 
-! 4581 2020-06-29 08:49:58Z suehring
-! Enable output of resolved-scale vertical fluxes of chemical species.
-! 
-! 4509 2020-04-26 15:57:55Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-! 
-! 4469 2020-03-23 14:31:00Z suehring
-! fix mistakenly committed version
-!
-! 4468 2020-03-23 13:49:05Z suehring
-! - bugfix for last commit in openacc branch
-! - some loop bounds revised (only to be consistent with cache version)
-! - setting of nzb_max_l for advection of the w-component revised
-!
-! 4466 2020-03-20 16:14:41Z suehring
-! - vector branch further optimized (linear dependencies along z removed and loops are splitted)
-! - topography closed channel flow with symmetric boundaries also implemented in vector branch
-! - some formatting adjustments made and comments added
-! - cpu measures for vector branch added
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4414 2020-02-19 20:16:04Z suehring
-! Move call for initialization of control flags to ws_init
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4340 2019-12-16 08:17:03Z Giersch
-! Topography closed channel flow with symmetric boundaries implemented
-!
-! 4330 2019-12-10 16:16:33Z knoop
-! Bugix: removed syntax error introduced by last commit
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4328 2019-12-09 18:53:04Z suehring
-! Minor formatting adjustments
-!
-! 4327 2019-12-06 14:48:31Z Giersch
-! Setting of advection flags for vertical fluxes of w revised, air density for vertical flux
-! calculation of w at k=1 is considered now
-!
-! 4325 2019-12-06 07:14:04Z Giersch
-! Vertical fluxes of w are now set to zero at nzt and nzt+1, setting of advection flags for fluxes
-! in z-direction revised, comments extended
-!
-! 4324 2019-12-06 07:11:33Z Giersch
-! Indirect indexing for calculating vertical fluxes close to boundaries is only used for loop
-! indizes where it is really necessary
-!
-! 4317 2019-12-03 12:43:22Z Giersch
-! Comments revised/added, formatting improved, fluxes for u,v, and scalars are explicitly set to
-! zero at nzt+1, fluxes of w-component are now calculated only until nzt-1 (Prognostic equation for
-! w-velocity component ends at nzt-1)
-!
-! 4204 2019-08-30 12:30:17Z knoop
-! Bugfix: Changed sk_num initialization default to avoid implicit SAVE-Attribut
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4110 2019-07-22 17:05:21Z suehring
-! - Separate initialization of advection flags for momentum and scalars. In this context, resort the
-!   bits and do some minor formatting.
-! - Make flag initialization for scalars more flexible, introduce an arguemnt list to indicate
-!   non-cyclic boundaries (required for decycled scalars such as chemical species or aerosols)
-! - Introduce extended 'degradation zones', where horizontal advection of passive scalars is
-!   discretized by first-order scheme at all grid points that in the vicinity of buildings (<= 3
-!   grid points). Even though no building is within the numerical stencil, first-order scheme is
-!   used. At fourth and fifth grid point the order of the horizontal advection scheme is
-!   successively upgraded. These extended degradation zones are used to avoid stationary numerical
-!   oscillations, which are responsible for high concentration maxima that may appear under
-!   shear-free stable conditions.
-! - Change interface for scalar advection routine.
-! - Bugfix, avoid uninitialized value sk_num in vector version of scalar
-!   advection
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! Implementation of a flux limiter according to Skamarock (2006) for the vertical scalar advection.
-! Please note, this is only implemented for the cache-optimized version at the moment.
-! Implementation for the vector-optimized version will follow after critical issues concerning
-! vectorization are fixed.
-!
-! 3873 2019-04-08 15:44:30Z knoop
-! Moved ocean_mode specific code to ocean_mod
-!
-! 3872 2019-04-08 15:03:06Z knoop
-! Moved all USE statements to module level + removed salsa dependency
-!
-! 3871 2019-04-08 14:38:39Z knoop
-! Moving initialization of bcm specific flux arrays into bulk_cloud_model_mod
-!
-! 3864 2019-04-05 09:01:56Z monakurppa
-! Remove tailing white spaces
-!
-! 3696 2019-01-24 16:37:35Z suehring
-! Bugfix in degradation height
-!
-! 3661 2019-01-08 18:22:50Z suehring
-! - Minor bugfix in divergence correction (only has implications at downward-facing wall surfaces)
-! - Remove setting of Neumann condition for horizontal velocity variances
-! - Split loops for tendency calculation and divergence correction in order to reduce bit queries
-! - Introduce new parameter nzb_max_l to better control order degradation at non-cyclic boundaries
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! OpenACC port for SPEC
-!
-! 411 2009-12-11 12:31:43 Z suehring
-! Initial revision
-!
-! Authors:
-! --------
-! @author Matthias 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 could lead to numerical instabilities.
-!>
-!> @todo Implement monotonic flux limiter also for vector version.
-!> @todo Move 3d arrays advc_flag, advc_flags_m from modules to advec_ws
-!> @todo Move arrays flux_l_x from modules to advec_ws
-!--------------------------------------------------------------------------------------------------!
- MODULE advec_ws
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, ddzw, tend, u, v, w,                                                          &
-               diss_l_diss, diss_l_e, diss_l_pt, diss_l_q,                                         &
-               diss_l_s, diss_l_u, diss_l_v, diss_l_w,                                             &
-               diss_s_diss, diss_s_e, diss_s_pt, diss_s_q, diss_s_s,                               &
-               diss_s_u, diss_s_v, diss_s_w,                                                       &
-               drho_air, drho_air_zw, rho_air, rho_air_zw,                                         &
-               flux_l_diss, flux_l_e, flux_l_pt, flux_l_q, flux_l_s,                               &
-               flux_l_u, flux_l_v, flux_l_w,                                                       &
-               flux_s_diss, flux_s_e, flux_s_pt, flux_s_q, flux_s_s,                               &
-               flux_s_u, flux_s_v, flux_s_w,                                                       &
-               u_stokes_zu, v_stokes_zu
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               dt_3d,                                                                              &
-               humidity,                                                                           &
-               intermediate_timestep_count,                                                        &
-               loop_optimization,                                                                  &
-               passive_scalar,                                                                     &
-               rans_tke_e,                                                                         &
-               symmetry_flag,                                                                      &
-               u_gtrans,                                                                           &
-               v_gtrans,                                                                           &
-               ws_scheme_mom,                                                                      &
-               ws_scheme_sca
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_int
-
-    USE indices,                                                                                   &
-        ONLY:  advc_flags_m,                                                                       &
-               advc_flags_s,                                                                       &
-               nbgp,                                                                               &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxlu,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               ny,                                                                                 &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nysv,                                                                               &
-               nzb,                                                                                &
-               nzb_max,                                                                            &
-               nzt,                                                                                &
-               wall_flags_total_0
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE kinds
-
-    USE pegrid,                                                                                    &
-        ONLY:  threads_per_task
-
-    USE statistics,                                                                                &
-        ONLY:  hom,                                                                                &
-               sums_salsa_ws_l,                                                                    &
-               sums_us2_ws_l,                                                                      &
-               sums_vs2_ws_l,                                                                      &
-               sums_ws2_ws_l,                                                                      &
-               sums_wschs_ws_l,                                                                    &
-               sums_wsncs_ws_l,                                                                    &
-               sums_wsnrs_ws_l,                                                                    &
-               sums_wspts_ws_l,                                                                    &
-               sums_wsqs_ws_l,                                                                     &
-               sums_wsss_ws_l,                                                                     &
-               sums_wsqcs_ws_l,                                                                    &
-               sums_wsqrs_ws_l,                                                                    &
-               sums_wsqis_ws_l,                                                                    &
-               sums_wsnis_ws_l,                                                                    &
-               sums_wsqgs_ws_l,                                                                    &
-               sums_wsngs_ws_l,                                                                    &
-               sums_wsqss_ws_l,                                                                    &
-               sums_wsnss_ws_l,                                                                    &
-               sums_wssas_ws_l,                                                                    &
-               sums_wsus_ws_l,                                                                     &
-               sums_wsvs_ws_l,                                                                     &
-               weight_substep
-
-
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  adv_mom_1            !< 1/4 - constant used in 5th-order advection scheme for momentum advection (1st-order part)
-    REAL(wp) ::  adv_mom_3            !< 1/24 - constant used in 5th-order advection scheme for momentum advection (3rd-order part)
-    REAL(wp) ::  adv_mom_5            !< 1/120 - constant used in 5th-order advection scheme for momentum advection (5th-order part)
-    REAL(wp) ::  adv_sca_1            !< 1/2 - constant used in 5th-order advection scheme for scalar advection (1st-order part)
-    REAL(wp) ::  adv_sca_3            !< 1/12 - constant used in 5th-order advection scheme for scalar advection (3rd-order part)
-    REAL(wp) ::  adv_sca_5            !< 1/60 - constant used in 5th-order advection scheme for scalar advection (5th-order part)
-
-    PRIVATE
-    PUBLIC   advec_s_ws, advec_u_ws, advec_v_ws, advec_w_ws, ws_init, ws_init_flags_momentum,      &
-             ws_init_flags_scalar, ws_statistics
-
-    INTERFACE ws_init
-       MODULE PROCEDURE ws_init
-    END INTERFACE ws_init
-
-    INTERFACE ws_init_flags_momentum
-       MODULE PROCEDURE ws_init_flags_momentum
-    END INTERFACE ws_init_flags_momentum
-
-    INTERFACE ws_init_flags_scalar
-       MODULE PROCEDURE ws_init_flags_scalar
-    END INTERFACE ws_init_flags_scalar
-
-    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_v_ws
-       MODULE PROCEDURE advec_v_ws
-       MODULE PROCEDURE advec_v_ws_ij
-    END INTERFACE advec_v_ws
-
-    INTERFACE advec_w_ws
-       MODULE PROCEDURE advec_w_ws
-       MODULE PROCEDURE advec_w_ws_ij
-    END INTERFACE advec_w_ws
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of WS-scheme
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ws_init
-
-!
-!-- Set 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  )  THEN
-          ALLOCATE( sums_wsqs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-          sums_wsqs_ws_l = 0.0_wp
-       ENDIF
-
-       IF ( passive_scalar )  THEN
-          ALLOCATE( sums_wsss_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-          sums_wsss_ws_l = 0.0_wp
-       ENDIF
-
-    ENDIF
-
-!
-!-- Arrays needed for reasons of speed optimization
-    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
-!
-!-- For the vector version the buffer arrays for scalars are not necessary, since internal arrays
-!-- are used in the vector version.
-    IF ( loop_optimization /= 'vector' )  THEN
-       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 ( rans_tke_e )  THEN
-             ALLOCATE( flux_s_diss(nzb+1:nzt,0:threads_per_task-1),                                &
-                       diss_s_diss(nzb+1:nzt,0:threads_per_task-1) )
-             ALLOCATE( flux_l_diss(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                        &
-                       diss_l_diss(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-          ENDIF
-
-          IF ( humidity )  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 ( passive_scalar )  THEN
-             ALLOCATE( flux_s_s(nzb+1:nzt,0:threads_per_task-1),                                   &
-                       diss_s_s(nzb+1:nzt,0:threads_per_task-1) )
-             ALLOCATE( flux_l_s(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                           &
-                       diss_l_s(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-          ENDIF
-
-       ENDIF
-    ENDIF
-!
-!-- Initialize the flag arrays controlling degradation near walls, i.e. to decrease the numerical
-!-- stencil appropriately. The order of the scheme is degraded near solid walls as well as near
-!-- non-cyclic inflow and outflow boundaries. Do this separately for momentum and scalars.
-    IF ( ws_scheme_mom )  CALL ws_init_flags_momentum
-
-    IF ( ws_scheme_sca )  THEN
-       ALLOCATE( advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       advc_flags_s = 0
-       CALL ws_init_flags_scalar( bc_dirichlet_l  .OR.  bc_radiation_l,                            &
-                                  bc_dirichlet_n  .OR.  bc_radiation_n,                            &
-                                  bc_dirichlet_r  .OR.  bc_radiation_r,                            &
-                                  bc_dirichlet_s  .OR.  bc_radiation_s,                            &
-                                  advc_flags_s )
-    ENDIF
-
- END SUBROUTINE ws_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of flags to control the order of the advection scheme near solid walls and
-!> non-cyclic inflow boundaries, where the order is sucessively degraded.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ws_init_flags_momentum
-
-
-    INTEGER(iwp) ::  i     !< index variable along x
-    INTEGER(iwp) ::  j     !< index variable along y
-    INTEGER(iwp) ::  k     !< index variable along z
-    INTEGER(iwp) ::  k_mm  !< dummy index along z
-    INTEGER(iwp) ::  k_pp  !< dummy index along z
-    INTEGER(iwp) ::  k_ppp !< dummy index along z
-
-    LOGICAL      ::  flag_set !< steering variable for advection flags
-
-    ALLOCATE( advc_flags_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    advc_flags_m = 0
-!
-!-- Set advc_flags_m to steer the degradation of the advection scheme in advec_ws near
-!-- topography, inflow- and outflow boundaries as well as bottom and top of model domain.
-!-- advc_flags_m remains zero for all non-prognostic grid points.
-!-- u-component
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-!
-!--          At first, set flags to WS1.
-!--          Since fluxes are swapped in advec_ws.f90, this is necessary to
-!--          in order to handle the left/south flux.
-!--          near vertical walls.
-             advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 0 )
-             advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 3 )
-!
-!--          u component - x-direction
-!--          WS1 (0), WS3 (1), WS5 (2)
-             IF ( .NOT. BTEST(wall_flags_total_0(k,j,i+1),1)  .OR.                                 &
-                      ( ( bc_dirichlet_l .OR. bc_radiation_l ) .AND. i <= nxlu  )  .OR.            &
-                      ( ( bc_dirichlet_r .OR. bc_radiation_r ) .AND. i == nxr   ) )                &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 0 )
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+2),1) .AND.                           &
-                              BTEST(wall_flags_total_0(k,j,i+1),1) .OR.                            &
-                        .NOT. BTEST(wall_flags_total_0(k,j,i-1),1) )                               &
-                                              .OR.                                                 &
-                      ( ( bc_dirichlet_r .OR. bc_radiation_r ) .AND. i == nxr-1 )  .OR.            &
-                      ( ( bc_dirichlet_l .OR. bc_radiation_l ) .AND. i == nxlu+1) )                &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 1 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 0 )
-             ELSEIF ( BTEST(wall_flags_total_0(k,j,i+1),1)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j,i+2),1)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j,i-1),1) )                                       &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 2 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 0 )
-             ENDIF
-!
-!--          u component - y-direction
-!--          WS1 (3), WS3 (4), WS5 (5)
-             IF ( .NOT. BTEST(wall_flags_total_0(k,j+1,i),1)  .OR.                                 &
-                      ( ( bc_dirichlet_s .OR. bc_radiation_s ) .AND. j == nys   ) .OR.             &
-                      ( ( bc_dirichlet_n .OR. bc_radiation_n ) .AND. j == nyn   ) )                &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 3 )
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j+2,i),1) .AND.                           &
-                              BTEST(wall_flags_total_0(k,j+1,i),1) .OR.                            &
-                        .NOT. BTEST(wall_flags_total_0(k,j-1,i),1) )                               &
-                                              .OR.                                                 &
-                      ( ( bc_dirichlet_s .OR. bc_radiation_s ) .AND. j == nysv  ) .OR.             &
-                      ( ( bc_dirichlet_n .OR. bc_radiation_n ) .AND. j == nyn-1 ) )                &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 4 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 3 )
-             ELSEIF ( BTEST(wall_flags_total_0(k,j+1,i),1)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j+2,i),1)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j-1,i),1) )                                       &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 5 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 3 )
-             ENDIF
-!
-!--          u component - z-direction. Fluxes are calculated on w-grid level. Boundary u-values
-!--          at/within walls aren't used.
-!--          WS1 (6), WS3 (7), WS5 (8)
-             IF ( k == nzb+1 )  THEN
-                k_mm = nzb
-             ELSE
-                k_mm = k - 2
-             ENDIF
-             IF ( k > nzt-1 )  THEN
-                k_pp = nzt+1
-             ELSE
-                k_pp = k + 2
-             ENDIF
-             IF ( k > nzt-2 )  THEN
-                k_ppp = nzt+1
-             ELSE
-                k_ppp = k + 3
-             ENDIF
-
-             flag_set = .FALSE.
-             IF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),1)       .AND.                         &
-                          BTEST(wall_flags_total_0(k,j,i),1)         .AND.                         &
-                          BTEST(wall_flags_total_0(k+1,j,i),1) )     .OR.                          &
-                  ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),1)      .AND.                         &
-                          BTEST(wall_flags_total_0(k+1,j,i),1)       .AND.                         &
-                          BTEST(wall_flags_total_0(k,j,i),1) )       .OR.                          &
-                  ( k == nzt .AND. symmetry_flag == 0 ) )                                          &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 6 )
-                flag_set = .TRUE.
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k_mm,j,i),1)    .OR.                        &
-                        .NOT. BTEST(wall_flags_total_0(k_ppp,j,i),1) ) .AND.                       &
-                              BTEST(wall_flags_total_0(k-1,j,i),1)     .AND.                       &
-                              BTEST(wall_flags_total_0(k,j,i),1)       .AND.                       &
-                              BTEST(wall_flags_total_0(k+1,j,i),1)     .AND.                       &
-                              BTEST(wall_flags_total_0(k_pp,j,i),1)    .AND.                       &
-                        .NOT. flag_set                                 .OR.                        &
-                      ( k == nzt - 1 .AND. symmetry_flag == 0 ) )                                  &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 7 )
-                flag_set = .TRUE.
-             ELSEIF ( BTEST(wall_flags_total_0(k_mm,j,i),1)            .AND.                       &
-                      BTEST(wall_flags_total_0(k-1,j,i),1)             .AND.                       &
-                      BTEST(wall_flags_total_0(k,j,i),1)               .AND.                       &
-                      BTEST(wall_flags_total_0(k+1,j,i),1)             .AND.                       &
-                      BTEST(wall_flags_total_0(k_pp,j,i),1)            .AND.                       &
-                      BTEST(wall_flags_total_0(k_ppp,j,i),1)           .AND.                       &
-                      .NOT. flag_set )                                                             &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 8 )
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- v-component
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-!
-!--          At first, set flags to WS1.
-!--          Since fluxes are swapped in advec_ws.f90, this is necessary to in order to handle the
-!--          left/south flux.
-             advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 9  )
-             advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 12 )
-!
-!--          v component - x-direction
-!--          WS1 (9), WS3 (10), WS5 (11)
-             IF ( .NOT. BTEST(wall_flags_total_0(k,j,i+1),2)                       .OR.            &
-                      ( ( bc_dirichlet_l .OR. bc_radiation_l ) .AND. i == nxl   )  .OR.            &
-                      ( ( bc_dirichlet_r .OR. bc_radiation_r ) .AND. i == nxr   ) )                &
-            THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 9 )
-!
-!--          WS3
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+2),2)   .AND.                         &
-                              BTEST(wall_flags_total_0(k,j,i+1),2) ) .OR.                          &
-                        .NOT. BTEST(wall_flags_total_0(k,j,i-1),2)                                 &
-                                              .OR.                                                 &
-                      ( ( bc_dirichlet_r .OR. bc_radiation_r ) .AND. i == nxr-1 )  .OR.            &
-                      ( ( bc_dirichlet_l .OR. bc_radiation_l ) .AND. i == nxlu  ) )                &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 10 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 9 )
-             ELSEIF ( BTEST(wall_flags_total_0(k,j,i+1),2)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j,i+2),2)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j,i-1),2) )                                       &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 11 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 9 )
-             ENDIF
-!
-!--          v component - y-direction
-!--          WS1 (12), WS3 (13), WS5 (14)
-             IF ( .NOT. BTEST(wall_flags_total_0(k,j+1,i),2)                      .OR.             &
-                      ( ( bc_dirichlet_s .OR. bc_radiation_s ) .AND. j <= nysv  ) .OR.             &
-                      ( ( bc_dirichlet_n .OR. bc_radiation_n ) .AND. j == nyn   ) )                &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 12 )
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j+2,i),2)  .AND.                          &
-                              BTEST(wall_flags_total_0(k,j+1,i),2)  .OR.                           &
-                        .NOT. BTEST(wall_flags_total_0(k,j-1,i),2) )                               &
-                                              .OR.                                                 &
-                      ( (  bc_dirichlet_s .OR. bc_radiation_s ) .AND. j == nysv+1) .OR.            &
-                      ( (  bc_dirichlet_n .OR. bc_radiation_n ) .AND. j == nyn-1 ) )               &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 13 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 12 )
-             ELSEIF ( BTEST(wall_flags_total_0(k,j+1,i),2)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j+2,i),2)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j-1,i),2) )                                       &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 14 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 12 )
-             ENDIF
-!
-!--          v component - z-direction. Fluxes are calculated on w-grid level. Boundary v-values
-!--          at/within walls aren't used.
-!--          WS1 (15), WS3 (16), WS5 (17)
-             IF ( k == nzb+1 )  THEN
-                k_mm = nzb
-             ELSE
-                k_mm = k - 2
-             ENDIF
-             IF ( k > nzt-1 )  THEN
-                k_pp = nzt+1
-             ELSE
-                k_pp = k + 2
-             ENDIF
-             IF ( k > nzt-2 )  THEN
-                k_ppp = nzt+1
-             ELSE
-                k_ppp = k + 3
-             ENDIF
-
-             flag_set = .FALSE.
-             IF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),2)         .AND.                       &
-                          BTEST(wall_flags_total_0(k,j,i),2)           .AND.                       &
-                          BTEST(wall_flags_total_0(k+1,j,i),2) )       .OR.                        &
-                  ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),2)        .AND.                       &
-                          BTEST(wall_flags_total_0(k+1,j,i),2)         .AND.                       &
-                          BTEST(wall_flags_total_0(k,j,i),2) )         .OR.                        &
-                  ( k == nzt .AND. symmetry_flag == 0 ) )                                          &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 15 )
-                flag_set = .TRUE.
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k_mm,j,i),2)    .OR.                        &
-                        .NOT. BTEST(wall_flags_total_0(k_ppp,j,i),2) ) .AND.                       &
-                              BTEST(wall_flags_total_0(k-1,j,i),2)     .AND.                       &
-                              BTEST(wall_flags_total_0(k,j,i),2)       .AND.                       &
-                              BTEST(wall_flags_total_0(k+1,j,i),2)     .AND.                       &
-                              BTEST(wall_flags_total_0(k_pp,j,i),2)    .AND.                       &
-                        .NOT. flag_set                                  .OR.                       &
-                      ( k == nzt - 1 .AND. symmetry_flag == 0 ) )                                  &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 16 )
-                flag_set = .TRUE.
-             ELSEIF ( BTEST(wall_flags_total_0(k_mm,j,i),2)            .AND.                       &
-                      BTEST(wall_flags_total_0(k-1,j,i),2)             .AND.                       &
-                      BTEST(wall_flags_total_0(k,j,i),2)               .AND.                       &
-                      BTEST(wall_flags_total_0(k+1,j,i),2)             .AND.                       &
-                      BTEST(wall_flags_total_0(k_pp,j,i),2)            .AND.                       &
-                      BTEST(wall_flags_total_0(k_ppp,j,i),2)           .AND.                       &
-                      .NOT. flag_set )                                                             &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 17 )
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- w - component
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-!
-!--          At first, set flags to WS1.
-!--          Since fluxes are swapped in advec_ws.f90, this is necessary to in order to handle the
-!--          left/south flux.
-             advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 18 )
-             advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 21 )
-!
-!--          w component - x-direction
-!--          WS1 (18), WS3 (19), WS5 (20)
-             IF ( .NOT. BTEST(wall_flags_total_0(k,j,i+1),3)                        .OR.           &
-                      ( (  bc_dirichlet_l .OR. bc_radiation_l ) .AND. i == nxl   )  .OR.           &
-                      ( (  bc_dirichlet_r .OR. bc_radiation_r ) .AND. i == nxr   ) )               &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 18 )
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+2),3)  .AND.                          &
-                              BTEST(wall_flags_total_0(k,j,i+1),3)  .OR.                           &
-                        .NOT. BTEST(wall_flags_total_0(k,j,i-1),3) )                               &
-                                              .OR.                                                 &
-                      ( ( bc_dirichlet_r .OR. bc_radiation_r )  .AND. i == nxr-1 )  .OR.           &
-                      ( ( bc_dirichlet_l .OR.  bc_radiation_l ) .AND. i == nxlu  ) )               &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 19 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 18 )
-             ELSEIF ( BTEST(wall_flags_total_0(k,j,i+1),3)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j,i+2),3)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j,i-1),3) )                                       &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i),20 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 18 )
-             ENDIF
-!
-!--          w component - y-direction
-!--          WS1 (21), WS3 (22), WS5 (23)
-             IF ( .NOT. BTEST(wall_flags_total_0(k,j+1,i),3)                       .OR.            &
-                      ( ( bc_dirichlet_s .OR. bc_radiation_s ) .AND. j == nys   )  .OR.            &
-                      ( ( bc_dirichlet_n .OR. bc_radiation_n ) .AND. j == nyn   ) )                &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 21 )
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j+2,i),3)  .AND.                          &
-                              BTEST(wall_flags_total_0(k,j+1,i),3)  .OR.                           &
-                        .NOT. BTEST(wall_flags_total_0(k,j-1,i),3) )                               &
-                                              .OR.                                                 &
-                      ( ( bc_dirichlet_s .OR. bc_radiation_s ) .AND. j == nysv  )  .OR.            &
-                      ( ( bc_dirichlet_n .OR. bc_radiation_n ) .AND. j == nyn-1 ) )                &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 22 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 21 )
-             ELSEIF ( BTEST(wall_flags_total_0(k,j+1,i),3)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j+2,i),3)  .AND.                                  &
-                      BTEST(wall_flags_total_0(k,j-1,i),3) )                                       &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 23 )
-!
-!--             Clear flag for WS1
-                advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 21 )
-             ENDIF
-!
-!--          w component - z-direction. Fluxes are calculated on scalar grid level. Boundary
-!--          w-values at walls are used. Flux at k=i is defined at scalar position k=i+1 with i
-!--          being an integer.
-!--          WS1 (24), WS3 (25), WS5 (26)
-             IF ( k == nzb+1 )  THEN
-                k_mm = nzb
-             ELSE
-                k_mm = k - 2
-             ENDIF
-             IF ( k > nzt-1 )  THEN
-                k_pp = nzt+1
-             ELSE
-                k_pp = k + 2
-             ENDIF
-             IF ( k > nzt-2 )  THEN
-                k_ppp = nzt+1
-             ELSE
-                k_ppp = k + 3
-             ENDIF
-
-             flag_set = .FALSE.
-             IF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i),3)          .AND.                        &
-                          BTEST(wall_flags_total_0(k+1,j,i),3) )      .OR.                         &
-                  ( .NOT. BTEST(wall_flags_total_0(k+1,j,i),3)        .AND.                        &
-                          BTEST(wall_flags_total_0(k,j,i),3) )        .OR.                         &
-                  k == nzt -1 )                                                                    &
-             THEN
-!
-!--             Please note, at k == nzb_w_inner(j,i) a flag is explicitly set, although this is not
-!--             a prognostic level. However, contrary to the advection of u,v and s this is
-!--             necessary because flux_t(nzb_w_inner(j,i)) is used for the tendency at k ==
-!--             0nzb_w_inner(j,i)+1.
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 24 )
-                flag_set = .TRUE.
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),3)    .AND.                        &
-                              BTEST(wall_flags_total_0(k,j,i),3)      .AND.                        &
-                              BTEST(wall_flags_total_0(k+1,j,i),3)    .AND.                        &
-                              BTEST(wall_flags_total_0(k_pp,j,i),3) ) .OR.                         &
-                      ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),3)   .AND.                        &
-                              BTEST(wall_flags_total_0(k+1,j,i),3)    .AND.                        &
-                              BTEST(wall_flags_total_0(k,j,i),3)      .AND.                        &
-                              BTEST(wall_flags_total_0(k-1,j,i),3) )  .AND.                        &
-                        .NOT. flag_set                                .OR.                         &
-                      k == nzt - 2 )                                                               &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 25 )
-                flag_set = .TRUE.
-             ELSEIF ( BTEST(wall_flags_total_0(k-1,j,i),3)            .AND.                        &
-                      BTEST(wall_flags_total_0(k,j,i),3)              .AND.                        &
-                      BTEST(wall_flags_total_0(k+1,j,i),3)            .AND.                        &
-                      BTEST(wall_flags_total_0(k_pp,j,i),3)           .AND.                        &
-                      .NOT. flag_set )                                                             &
-             THEN
-                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 26 )
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Exchange ghost points for advection flags
-    CALL exchange_horiz_int( advc_flags_m, nys, nyn, nxl, nxr, nzt, nbgp )
-!
-!-- Set boundary flags at inflow and outflow boundary in case of
-!-- non-cyclic boundary conditions.
-    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-       advc_flags_m(:,:,nxl-1) = advc_flags_m(:,:,nxl)
-    ENDIF
-
-    IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-       advc_flags_m(:,:,nxr+1) = advc_flags_m(:,:,nxr)
-    ENDIF
-
-    IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-       advc_flags_m(:,nyn+1,:) = advc_flags_m(:,nyn,:)
-    ENDIF
-
-    IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-       advc_flags_m(:,nys-1,:) = advc_flags_m(:,nys,:)
-    ENDIF
-
- END SUBROUTINE ws_init_flags_momentum
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of flags to control the order of the advection scheme near solid walls and
-!> non-cyclic inflow boundaries, where the order is sucessively degraded.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ws_init_flags_scalar( non_cyclic_l, non_cyclic_n, non_cyclic_r, non_cyclic_s,          &
-                                  advc_flag, extensive_degrad )
-
-
-    INTEGER(iwp) ::  i     !< index variable along x
-    INTEGER(iwp) ::  j     !< index variable along y
-    INTEGER(iwp) ::  k     !< index variable along z
-    INTEGER(iwp) ::  k_mm  !< dummy index along z
-    INTEGER(iwp) ::  k_pp  !< dummy index along z
-    INTEGER(iwp) ::  k_ppp !< dummy index along z
-
-    INTEGER(iwp), INTENT(INOUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::                       &
-                                           advc_flag !< flag array to control order of scalar advection
-
-    LOGICAL ::  flag_set     !< steering variable for advection flags
-    LOGICAL ::  non_cyclic_l !< flag that indicates non-cyclic boundary on the left
-    LOGICAL ::  non_cyclic_n !< flag that indicates non-cyclic boundary on the north
-    LOGICAL ::  non_cyclic_r !< flag that indicates non-cyclic boundary on the right
-    LOGICAL ::  non_cyclic_s !< flag that indicates non-cyclic boundary on the south
-
-    LOGICAL, OPTIONAL ::  extensive_degrad !< flag indicating that extensive degradation is required, e.g. for
-                                           !< passive scalars nearby topography along the horizontal directions,
-                                           !< as no monotonic limiter can be applied there
-!
-!-- Set flags to steer the degradation of the advection scheme in advec_ws near topography, inflow-
-!-- and outflow boundaries as well as bottom and top of model domain. advc_flags_m remains zero for
-!-- all non-prognostic grid points.
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             IF ( .NOT.  BTEST(wall_flags_total_0(k,j,i),0) )  CYCLE
-!
-!--          scalar - x-direction
-!--          WS1 (0), WS3 (1), WS5 (2)
-             IF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+1),0)      .OR.                           &
-                    .NOT. BTEST(wall_flags_total_0(k,j,i+2),0)      .OR.                           &
-                    .NOT. BTEST(wall_flags_total_0(k,j,i-1),0) )    .OR.                           &
-                    ( non_cyclic_l  .AND.  i == 0  )                .OR.                           &
-                    ( non_cyclic_r  .AND.  i == nx ) )                                             &
-             THEN
-                advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 0 )
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+3),0)  .AND.                          &
-                              BTEST(wall_flags_total_0(k,j,i+1),0)  .AND.                          &
-                              BTEST(wall_flags_total_0(k,j,i+2),0)  .AND.                          &
-                              BTEST(wall_flags_total_0(k,j,i-1),0)                                 &
-                      )                       .OR.                                                 &
-                      ( .NOT. BTEST(wall_flags_total_0(k,j,i-2),0)  .AND.                          &
-                              BTEST(wall_flags_total_0(k,j,i+1),0)  .AND.                          &
-                              BTEST(wall_flags_total_0(k,j,i+2),0)  .AND.                          &
-                              BTEST(wall_flags_total_0(k,j,i-1),0)                                 &
-                      )                       .OR.                                                 &
-                      ( non_cyclic_r  .AND.  i == nx-1 )            .OR.                           &
-                      ( non_cyclic_l  .AND.  i == 1    ) )                                         &
-             THEN
-                advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 1 )
-             ELSEIF ( BTEST(wall_flags_total_0(k,j,i+1),0)           .AND.                         &
-                      BTEST(wall_flags_total_0(k,j,i+2),0)           .AND.                         &
-                      BTEST(wall_flags_total_0(k,j,i+3),0)           .AND.                         &
-                      BTEST(wall_flags_total_0(k,j,i-1),0)           .AND.                         &
-                      BTEST(wall_flags_total_0(k,j,i-2),0) )                                       &
-             THEN
-                advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 2 )
-             ENDIF
-!
-!--          scalar - y-direction
-!--          WS1 (3), WS3 (4), WS5 (5)
-             IF ( ( .NOT. BTEST(wall_flags_total_0(k,j+1,i),0)        .OR.                         &
-                    .NOT. BTEST(wall_flags_total_0(k,j+2,i),0)        .OR.                         &
-                    .NOT. BTEST(wall_flags_total_0(k,j-1,i),0))       .OR.                         &
-                  ( non_cyclic_s  .AND.  j == 0  )                    .OR.                         &
-                  ( non_cyclic_n  .AND.  j == ny ) )                                               &
-             THEN
-                advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 3 )
-!
-!--          WS3
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j+3,i),0)    .AND.                        &
-                              BTEST(wall_flags_total_0(k,j+1,i),0)    .AND.                        &
-                              BTEST(wall_flags_total_0(k,j+2,i),0)    .AND.                        &
-                              BTEST(wall_flags_total_0(k,j-1,i),0)                                 &
-                      )                       .OR.                                                 &
-                      ( .NOT. BTEST(wall_flags_total_0(k,j-2,i),0)    .AND.                        &
-                              BTEST(wall_flags_total_0(k,j+1,i),0)    .AND.                        &
-                              BTEST(wall_flags_total_0(k,j+2,i),0)    .AND.                        &
-                              BTEST(wall_flags_total_0(k,j-1,i),0)                                 &
-                      )                       .OR.                                                 &
-                      ( non_cyclic_s  .AND.  j == 1    )  .OR.                                     &
-                      ( non_cyclic_n  .AND.  j == ny-1 ) )                                         &
-             THEN
-                advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 4 )
-!
-!--          WS5
-             ELSEIF ( BTEST(wall_flags_total_0(k,j+1,i),0)           .AND.                         &
-                      BTEST(wall_flags_total_0(k,j+2,i),0)           .AND.                         &
-                      BTEST(wall_flags_total_0(k,j+3,i),0)           .AND.                         &
-                      BTEST(wall_flags_total_0(k,j-1,i),0)           .AND.                         &
-                      BTEST(wall_flags_total_0(k,j-2,i),0) )                                       &
-             THEN
-                advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 5 )
-             ENDIF
-!
-!--          Near topography, set horizontal advection scheme to 1st order for passive scalars, even
-!--          if only one direction may be blocked by topography. These locations will be identified
-!--          by wall_flags_total_0 bit 31. Note, since several modules define advection flags but
-!--          may apply different scalar boundary conditions, bit 31 is temporarily stored on
-!--          advc_flags.
-!--          Moreover, note that this extended degradtion for passive scalars is not required for
-!--          the vertical direction as there the monotonic limiter can be applied.
-             IF ( PRESENT( extensive_degrad ) )  THEN
-                IF ( extensive_degrad )  THEN
-!
-!--                At all grid points that are within a three-grid point range to topography, set
-!--                1st-order scheme.
-                   IF( BTEST( advc_flag(k,j,i), 31 ) )  THEN
-!
-!--                   Clear flags that might indicate higher-order advection along x- and
-!--                   y-direction.
-                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 1 )
-                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 2 )
-                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 4 )
-                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 5 )
-!
-!--                   Set flags that indicate 1st-order advection along x- and y-direction.
-                      advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 0 )
-                      advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 3 )
-                   ENDIF
-!
-!--                Adjacent to this extended degradation zone, successively upgrade the order of the
-!--                scheme if this grid point isn't flagged with bit 31 (indicating extended
-!--                degradation zone).
-                   IF ( .NOT. BTEST( advc_flag(k,j,i), 31 ) )  THEN
-!
-!--                   x-direction. First, clear all previous settings, then set flag for 3rd-order
-!--                   scheme.
-                      IF ( BTEST( advc_flag(k,j,i-1), 31 )  .AND.                                  &
-                           BTEST( advc_flag(k,j,i+1), 31 ) )  THEN
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 0 )
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 1 )
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 2 )
-
-                         advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 1 )
-                      ENDIF
-!
-!--                   x-direction. First, clear all previous settings, then set flag for 5rd-order
-!--                   scheme.
-                      IF ( .NOT. BTEST( advc_flag(k,j,i-1), 31 )  .AND.                            &
-                                 BTEST( advc_flag(k,j,i-2), 31 )  .AND.                            &
-                           .NOT. BTEST( advc_flag(k,j,i+1), 31 )  .AND.                            &
-                                 BTEST( advc_flag(k,j,i+2), 31 ) )  THEN
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 0 )
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 1 )
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 2 )
-
-                         advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 2 )
-                      ENDIF
-!
-!--                   y-direction. First, clear all previous settings, then set flag for 3rd-order
-!--                   scheme.
-                      IF ( BTEST( advc_flag(k,j-1,i), 31 )  .AND.                                  &
-                           BTEST( advc_flag(k,j+1,i), 31 ) )  THEN
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 3 )
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 4 )
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 5 )
-
-                         advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 4 )
-                      ENDIF
-!
-!--                   y-direction. First, clear all previous settings, then set flag for 5rd-order
-!--                   scheme.
-                      IF ( .NOT. BTEST( advc_flag(k,j-1,i), 31 )  .AND.                            &
-                                 BTEST( advc_flag(k,j-2,i), 31 )  .AND.                            &
-                           .NOT. BTEST( advc_flag(k,j+1,i), 31 )  .AND.                            &
-                                 BTEST( advc_flag(k,j+2,i), 31 ) )  THEN
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 3 )
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 4 )
-                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 5 )
-
-                         advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 5 )
-                      ENDIF
-                   ENDIF
-
-                ENDIF
-
-!
-!--             Near lateral boundaries set the flags again. In order to avoid strong numerical 
-!--             oscillations near the boundaries, which may lead to scalar built-up, also employ
-!--             extended degradation zones here.
-!--             x-direction
-                IF ( ( non_cyclic_l  .AND.  i <= 3  )  .OR.                                        &
-                     ( non_cyclic_r  .AND.  i >= nx-3 ) )  THEN
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 0 )
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 1 )
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 2 )
-
-                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 0 )
-                ENDIF
-
-                IF ( ( non_cyclic_l  .AND.  i == 4    )  .OR.                                      &
-                     ( non_cyclic_r  .AND.  i == nx-4 ) )  THEN
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 0 )
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 1 )
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 2 )
-
-                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 1 )
-                ENDIF
-!
-!--             y-direction
-                IF ( ( non_cyclic_n  .AND.  j <= 3  )  .OR.                                        &
-                     ( non_cyclic_s  .AND.  j >= ny-3 ) )  THEN
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 3 )
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 4 )
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 5 )
-
-                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 3 )
-                ENDIF
-
-                IF ( ( non_cyclic_n  .AND.  j == 4    )  .OR.                                      &
-                     ( non_cyclic_s  .AND.  j == ny-4 ) )  THEN
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 3 )
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 4 )
-                   advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 5 )
-
-                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 4 )
-                ENDIF
-
-             ENDIF
-!
-!--          scalar - z-direction. Fluxes are calculated on w-grid level. Boundary values at/within
-!--          walls aren't used.
-!--          WS1 (6), WS3 (7), WS5 (8)
-             IF ( k == nzb+1 )  THEN
-                k_mm = nzb
-             ELSE
-                k_mm = k - 2
-             ENDIF
-             IF ( k > nzt-1 )  THEN
-                k_pp = nzt+1
-             ELSE
-                k_pp = k + 2
-             ENDIF
-             IF ( k > nzt-2 )  THEN
-                k_ppp = nzt+1
-             ELSE
-                k_ppp = k + 3
-             ENDIF
-
-             flag_set = .FALSE.
-             IF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),0)       .AND.                         &
-                          BTEST(wall_flags_total_0(k,j,i),0)         .AND.                         &
-                          BTEST(wall_flags_total_0(k+1,j,i),0) )     .OR.                          &
-                  ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),0)      .AND.                         &
-                          BTEST(wall_flags_total_0(k+1,j,i),0)       .AND.                         &
-                          BTEST(wall_flags_total_0(k,j,i),0) )       .OR.                          &
-                  ( k == nzt .AND. symmetry_flag == 0 ) )                                          &
-             THEN
-                advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 6 )
-                flag_set = .TRUE.
-             ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k_mm,j,i),0)    .OR.                        &
-                        .NOT. BTEST(wall_flags_total_0(k_ppp,j,i),0) ) .AND.                       &
-                              BTEST(wall_flags_total_0(k-1,j,i),0)     .AND.                       &
-                              BTEST(wall_flags_total_0(k,j,i),0)       .AND.                       &
-                              BTEST(wall_flags_total_0(k+1,j,i),0)     .AND.                       &
-                              BTEST(wall_flags_total_0(k_pp,j,i),0)    .AND.                       &
-                        .NOT. flag_set                                  .OR.                       &
-                      ( k == nzt - 1 .AND. symmetry_flag == 0 ) )                                  &
-             THEN
-                advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 7 )
-                flag_set = .TRUE.
-             ELSEIF ( BTEST(wall_flags_total_0(k_mm,j,i),0)         .AND.                          &
-                      BTEST(wall_flags_total_0(k-1,j,i),0)          .AND.                          &
-                      BTEST(wall_flags_total_0(k,j,i),0)            .AND.                          &
-                      BTEST(wall_flags_total_0(k+1,j,i),0)          .AND.                          &
-                      BTEST(wall_flags_total_0(k_pp,j,i),0)         .AND.                          &
-                      BTEST(wall_flags_total_0(k_ppp,j,i),0)        .AND.                          &
-                     .NOT. flag_set )                                                              &
-             THEN
-                advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 8 )
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Exchange 3D integer wall_flags.
-!
-!-- Exchange ghost points for advection flags
-    CALL exchange_horiz_int( advc_flag, nys, nyn, nxl, nxr, nzt, nbgp )
-!
-!-- Set boundary flags at inflow and outflow boundary in case of non-cyclic boundary conditions.
-    IF ( non_cyclic_l )  THEN
-       advc_flag(:,:,nxl-1) = advc_flag(:,:,nxl)
-    ENDIF
-
-    IF ( non_cyclic_r )  THEN
-      advc_flag(:,:,nxr+1) = advc_flag(:,:,nxr)
-    ENDIF
-
-    IF ( non_cyclic_n )  THEN
-       advc_flag(:,nyn+1,:) = advc_flag(:,nyn,:)
-    ENDIF
-
-    IF ( non_cyclic_s )  THEN
-       advc_flag(:,nys-1,:) = advc_flag(:,nys,:)
-    ENDIF
-
-
-
- END SUBROUTINE ws_init_flags_scalar
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize variables used for storing statistic quantities (fluxes, variances)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ws_statistics
-
-
-!
-!-- The arrays needed for statistical evaluation are set to to 0 at the beginning of
-!-- prognostic_equations.
-    IF ( ws_scheme_mom )  THEN
-       !$ACC KERNELS PRESENT(sums_wsus_ws_l, sums_wsvs_ws_l) &
-       !$ACC PRESENT(sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l)
-       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
-       !$ACC END KERNELS
-    ENDIF
-
-    IF ( ws_scheme_sca )  THEN
-       !$ACC KERNELS PRESENT(sums_wspts_ws_l)
-       sums_wspts_ws_l = 0.0_wp
-       !$ACC END KERNELS
-       IF ( humidity       )  sums_wsqs_ws_l = 0.0_wp
-       IF ( passive_scalar )  sums_wsss_ws_l = 0.0_wp
-
-    ENDIF
-
- END SUBROUTINE ws_statistics
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Scalar advection - Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_s_ws_ij( advc_flag, i, j, sk, sk_char, swap_flux_y_local, swap_diss_y_local,     &
-                           swap_flux_x_local, swap_diss_x_local, i_omp, tn, non_cyclic_l,          &
-                           non_cyclic_n, non_cyclic_r, non_cyclic_s, flux_limitation )
-
-
-    CHARACTER (LEN = *), INTENT(IN) ::  sk_char !< string identifier, used for assign fluxes to the
-                                                !<correct dimension in the analysis array
-
-    INTEGER(iwp) ::  i         !< grid index along x-direction
-    INTEGER(iwp) ::  i_omp     !< leftmost index on subdomain, or in case of OpenMP, on thread
-    INTEGER(iwp) ::  j         !< grid index along y-direction
-    INTEGER(iwp) ::  k         !< grid index along z-direction
-    INTEGER(iwp) ::  k_mm      !< k-2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_mmm     !< k-3 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
-    INTEGER(iwp) ::  tn        !< number of OpenMP thread
-
-    INTEGER(iwp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::                          &
-                                        advc_flag !< flag array to control order of scalar advection
-
-    LOGICAL           ::  limiter         !< control flag indicating the application of flux limitation
-    LOGICAL           ::  non_cyclic_l    !< flag that indicates non-cyclic boundary on the left
-    LOGICAL           ::  non_cyclic_n    !< flag that indicates non-cyclic boundary on the north
-    LOGICAL           ::  non_cyclic_r    !< flag that indicates non-cyclic boundary on the right
-    LOGICAL           ::  non_cyclic_s    !< flag that indicates non-cyclic boundary on the south
-    LOGICAL, OPTIONAL ::  flux_limitation !< flag indicating flux limitation of the vertical advection
-
-    REAL(wp) ::  diss_d        !< artificial dissipation term at grid box bottom
-    REAL(wp) ::  div           !< velocity diverence on scalar grid
-    REAL(wp) ::  div_in        !< vertical flux divergence of ingoing fluxes
-    REAL(wp) ::  div_out       !< vertical flux divergence of outgoing fluxes
-    REAL(wp) ::  f_corr_d      !< correction flux at grid-cell bottom, i.e. the difference between high and low-order flux
-    REAL(wp) ::  f_corr_t      !< correction flux at grid-cell top, i.e. the difference between high and low-order flux
-    REAL(wp) ::  f_corr_d_in   !< correction flux of ingoing flux part at grid-cell bottom
-    REAL(wp) ::  f_corr_t_in   !< correction flux of ingoing flux part at grid-cell top
-    REAL(wp) ::  f_corr_d_out  !< correction flux of outgoing flux part at grid-cell bottom
-    REAL(wp) ::  f_corr_t_out  !< correction flux of outgoing flux part at grid-cell top
-    REAL(wp) ::  fac_correction!< factor to limit the in- and outgoing fluxes
-    REAL(wp) ::  flux_d        !< 6th-order flux at grid box bottom
-    REAL(wp) ::  ibit0         !< flag indicating 1st-order scheme along x-direction
-    REAL(wp) ::  ibit1         !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp) ::  ibit2         !< flag indicating 5th-order scheme along x-direction
-    REAL(wp) ::  ibit3         !< flag indicating 1st-order scheme along y-direction
-    REAL(wp) ::  ibit4         !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp) ::  ibit5         !< flag indicating 5th-order scheme along y-direction
-    REAL(wp) ::  ibit6         !< flag indicating 1st-order scheme along z-direction
-    REAL(wp) ::  ibit7         !< flag indicating 3rd-order scheme along z-direction
-    REAL(wp) ::  ibit8         !< flag indicating 5th-order scheme along z-direction
-    REAL(wp) ::  max_val       !< maximum value of the quanitity along the numerical stencil (in vertical direction)
-    REAL(wp) ::  min_val       !< maximum value of the quanitity along the numerical stencil (in vertical direction)
-    REAL(wp) ::  mon           !< monotone solution of the advection equation using 1st-order fluxes
-    REAL(wp) ::  u_comp        !< advection velocity along x-direction
-    REAL(wp) ::  v_comp        !< advection velocity along y-direction
-
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_n     !< discretized artificial dissipation at northward-side
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_r     !< discretized artificial dissipation at rightward-side
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_t     !< discretized artificial dissipation at top
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_n     !< discretized 6th-order flux at northward-side
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_r     !< discretized 6th-order flux at rightward-side
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t     !< discretized 6th-order flux at top
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t_1st !< discretized 1st-order flux at top
-
-    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_diss_y_local !< discretized artificial dissipation at southward-side
-    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_flux_y_local !< discretized 6th-order flux at northward-side
-    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_diss_x_local !< discretized artificial dissipation at leftward-side
-    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_flux_x_local !< discretized 6th-order flux at leftward-side
-
-!
-!-- sk is an array from parameter list. It should not be a pointer, because in that case the
-!-- compiler can not assume a stride 1 and cannot perform a strided one vector load. Adding the
-!-- CONTIGUOUS keyword makes things even worse, because the compiler cannot assume strided one in
-!-- the caller side.
-    REAL(wp), INTENT(IN),DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !< advected scalar
-
-!
-!-- Used local modified copy of nzb_max (used to degrade order of discretization) at non-cyclic
-!-- boundaries. Modify only at relevant points instead of the entire subdomain. This should lead to
-!-- betterload balance between boundary and non-boundary PEs.
-    IF( non_cyclic_l  .AND.  i <= nxl + 2  .OR.                                                    &
-        non_cyclic_r  .AND.  i >= nxr - 2  .OR.                                                    &
-        non_cyclic_s  .AND.  j <= nys + 2  .OR.                                                    &
-        non_cyclic_n  .AND.  j >= nyn - 2 )  THEN
-       nzb_max_l = nzt
-    ELSE
-       nzb_max_l = nzb_max
-    END IF
-!
-!-- Set control flag for flux limiter
-    limiter = .FALSE.
-    IF ( PRESENT( flux_limitation) )  limiter = flux_limitation
-!
-!-- 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_l
-
-          ibit5 = REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp )
-          ibit4 = REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp )
-          ibit3 = REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )
-
-          v_comp                  = v(k,j,i) - v_gtrans + v_stokes_zu(k)
-          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_l+1, nzt
-
-          v_comp                  = v(k,j,i) - v_gtrans + v_stokes_zu(k)
-          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_l
-
-          ibit2 = REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp )
-          ibit1 = REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp )
-          ibit0 = REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )
-
-          u_comp                    = u(k,j,i) - u_gtrans + u_stokes_zu(k)
-          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_l+1, nzt
-
-          u_comp                    = u(k,j,i) - u_gtrans + u_stokes_zu(k)
-          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
-!
-!-- Now compute the fluxes for the horizontal termns up to the highest
-!-- topography.
-    DO  k = nzb+1, nzb_max_l
-
-       ibit2 = REAL( IBITS(advc_flag(k,j,i),2,1), KIND = wp )
-       ibit1 = REAL( IBITS(advc_flag(k,j,i),1,1), KIND = wp )
-       ibit0 = REAL( IBITS(advc_flag(k,j,i),0,1), KIND = wp )
-
-       u_comp    = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
-       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 = REAL( IBITS(advc_flag(k,j,i),5,1), KIND = wp )
-       ibit4 = REAL( IBITS(advc_flag(k,j,i),4,1), KIND = wp )
-       ibit3 = REAL( IBITS(advc_flag(k,j,i),3,1), KIND = wp )
-
-       v_comp    = v(k,j+1,i) - v_gtrans + v_stokes_zu(k)
-       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) )                &
-                                     )
-    ENDDO
-!
-!-- Now compute the fluxes for the horizontal terms above the topography
-!-- where no degradation along the horizontal parts is necessary (except
-!-- for the non-cyclic lateral boundaries treated by nzb_max_l).
-    DO  k = nzb_max_l+1, nzt
-
-       u_comp    = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
-       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 + v_stokes_zu(k)
-       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
-
-    ENDDO
-!
-!-- Now, compute vertical fluxes. Split loop into a part treating the lowest grid points with
-!-- indirect indexing, a main loop without indirect indexing, and a loop for the uppermost grid
-!-- points with indirect indexing. This allows better vectorization for the main loop.
-!-- First, compute the flux at model surface, which need has to be calculated explicetely for the
-!-- tendency at the first w-level. For topography wall this is done implicitely by advc_flag.
-    flux_t(nzb) = 0.0_wp
-    diss_t(nzb) = 0.0_wp
-
-    DO  k = nzb+1, nzb+1
-       ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
-       ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
-       ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
-!
-!--    k index has to be modified near bottom and top, else array subscripts will be exceeded.
-       k_ppp = k + 3 * ibit8
-       k_pp  = k + 2 * ( 1 - ibit6 )
-       k_mm  = k - 2 * ibit8
-
-       flux_t(k) = w(k,j,i)  * rho_air_zw(k) * (                                                   &
-                   (  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) ) * rho_air_zw(k) * (                                           &
-                   (  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) )             &
-                                                       )
-    ENDDO
-
-    DO  k = nzb+2, nzt-2
-       ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
-       ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
-       ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
-
-       flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                                                    &
-                   (  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+2,j,i)  + sk(k-1,j,i) )               &
-                   + (          ibit8 * adv_sca_5 ) * ( sk(k+3,j,i)  + sk(k-2,j,i) )               &
-                                              )
-
-       diss_t(k) = - ABS( w(k,j,i) ) * rho_air_zw(k) * (                                           &
-                   (  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+2,j,i) - sk(k-1,j,i) )                &
-                   + (          ibit8 * adv_sca_5 ) * ( sk(k+3,j,i) - sk(k-2,j,i) )                &
-                                                       )
-    ENDDO
-
-    DO  k = nzt-1, nzt-symmetry_flag
-       ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
-       ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
-       ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
-!
-!--    k index has to be modified near bottom and top, else array subscripts will be exceeded.
-       k_ppp = k + 3 * ibit8
-       k_pp  = k + 2 * ( 1 - ibit6  )
-       k_mm  = k - 2 * ibit8
-
-
-       flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                                                    &
-                   (  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) ) * rho_air_zw(k) * (                                           &
-                   (  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) )             &
-                                                       )
-    ENDDO
-
-!
-!-- Set resolved/turbulent flux at model top to zero (w-level). In case that a symmetric behavior
-!-- between bottom and top shall be guaranteed (closed channel flow), the flux at nzt is also set to
-!-- zero.
-    IF ( symmetry_flag == 1 ) THEN
-       flux_t(nzt) = 0.0_wp
-       diss_t(nzt) = 0.0_wp
-    ENDIF
-    flux_t(nzt+1) = 0.0_wp
-    diss_t(nzt+1) = 0.0_wp
-
-
-    IF ( limiter )  THEN
-!
-!--    Compute monotone first-order fluxes which are required for mononteflux limitation.
-       flux_t_1st(nzb) = 0.0_wp
-       DO  k = nzb+1, nzb_max_l
-          flux_t_1st(k) = (      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) ) )                        &
-                          * rho_air_zw(k) * adv_sca_1
-!
-!--       In flux limitation the total flux will be corrected. For the sake of cleariness the
-!--       higher-order advective and disspative fluxes will be merged onto flux_t.
-          flux_t(k) = flux_t(k) + diss_t(k)
-          diss_t(k) = 0.0_wp
-       ENDDO
-!
-!--    Flux limitation of vertical fluxes according to Skamarock (2006).
-!--    Please note, as flux limitation implies linear dependencies of fluxes, flux limitation is
-!--    only made for the vertical advection term. Limitation of the horizontal terms cannot be
-!--    parallelized.
-!--    Due to the linear dependency, the following loop will not be vectorized.
-!--    Further, note that the flux limiter is only applied within the urban layer, i.e up to the
-!--    topography top.
-       DO  k = nzb+1, nzb_max_l
-!
-!--       Compute one-dimensional divergence along the vertical direction, which is used to correct
-!--       the advection discretization. This is necessary as in one-dimensional space the advection
-!--       velocity should actually be constant.
-          div = ( w(k,j,i)   * rho_air_zw(k)                                                       &
-                - w(k-1,j,i) * rho_air_zw(k-1)                                                     &
-                ) * drho_air(k) * ddzw(k)
-!
-!--       Compute monotone solution of the advection equation from 1st-order fluxes. Please note,
-!--       the advection equation is corrected by the divergence term (in 1D the advective flow
-!--       should be divergence free). Moreover, please note, as time-increment the full timestep is
-!--       used, even though a Runge-Kutta scheme will be used. However, the length of the actual
-!--       time increment is not important at all since it cancels out later when the fluxes are
-!--       limited.
-          mon = sk(k,j,i) + ( - ( flux_t_1st(k) - flux_t_1st(k-1) )                                &
-                          * drho_air(k) * ddzw(k)                                                  &
-                          + div * sk(k,j,i)                                                        &
-                            ) * dt_3d
-!
-!--       Determine minimum and maximum values along the numerical stencil.
-          k_mmm = MAX( k - 3, nzb + 1 )
-          k_ppp = MIN( k + 3, nzt + 1 )
-
-          min_val = MINVAL( sk(k_mmm:k_ppp,j,i) )
-          max_val = MAXVAL( sk(k_mmm:k_ppp,j,i) )
-!
-!--       Compute difference between high- and low-order fluxes, which may act as correction fluxes
-          f_corr_t = flux_t(k)   - flux_t_1st(k)
-          f_corr_d = flux_t(k-1) - flux_t_1st(k-1)
-!
-!--       Determine outgoing fluxes, i.e. the part of the fluxes which can decrease the value within
-!--       the grid box
-          f_corr_t_out = MAX( 0.0_wp, f_corr_t )
-          f_corr_d_out = MIN( 0.0_wp, f_corr_d )
-!
-!--       Determine ingoing fluxes, i.e. the part of the fluxes which can  increase the value within
-!--       the grid box
-          f_corr_t_in = MIN( 0.0_wp, f_corr_t)
-          f_corr_d_in = MAX( 0.0_wp, f_corr_d)
-!
-!--       Compute divergence of outgoing correction fluxes
-          div_out = - ( f_corr_t_out - f_corr_d_out ) * drho_air(k) * ddzw(k) * dt_3d
-!
-!--       Compute divergence of ingoing correction fluxes
-          div_in = - ( f_corr_t_in - f_corr_d_in ) * drho_air(k) * ddzw(k) * dt_3d
-!
-!--       Check if outgoing fluxes can lead to undershoots, i.e. values smaller than the minimum
-!--       value within the numerical stencil. If so, limit them.
-          IF ( mon - min_val < - div_out  .AND.  ABS( div_out ) > 0.0_wp )  THEN
-             fac_correction = ( mon - min_val ) / ( - div_out )
-             f_corr_t_out = f_corr_t_out * fac_correction
-             f_corr_d_out = f_corr_d_out * fac_correction
-          ENDIF
-!
-!--       Check if ingoing fluxes can lead to overshoots, i.e. values larger than the maximum value
-!--       within the numerical stencil. If so, limit them.
-          IF ( mon - max_val > - div_in  .AND.  ABS( div_in ) > 0.0_wp )  THEN
-             fac_correction = ( mon - max_val ) / ( - div_in )
-             f_corr_t_in = f_corr_t_in * fac_correction
-             f_corr_d_in = f_corr_d_in * fac_correction
-          ENDIF
-!
-!--       Finally add the limited fluxes to the original ones. If no flux limitation was done, the
-!--       fluxes equal the original ones.
-          flux_t(k)   = flux_t_1st(k)   + f_corr_t_out + f_corr_t_in
-          flux_t(k-1) = flux_t_1st(k-1) + f_corr_d_out + f_corr_d_in
-       ENDDO
-    ENDIF
-!
-!-- Now compute the tendency term including divergence correction.
-    DO  k = nzb+1, nzb_max_l
-
-       flux_d    = flux_t(k-1)
-       diss_d    = diss_t(k-1)
-
-       ibit2 = REAL( IBITS(advc_flag(k,j,i),2,1), KIND = wp )
-       ibit1 = REAL( IBITS(advc_flag(k,j,i),1,1), KIND = wp )
-       ibit0 = REAL( IBITS(advc_flag(k,j,i),0,1), KIND = wp )
-
-       ibit5 = REAL( IBITS(advc_flag(k,j,i),5,1), KIND = wp )
-       ibit4 = REAL( IBITS(advc_flag(k,j,i),4,1), KIND = wp )
-       ibit3 = REAL( IBITS(advc_flag(k,j,i),3,1), KIND = wp )
-
-       ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
-       ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
-       ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
-!
-!--    Calculate the divergence of the velocity field. A respective correction is needed to overcome
-!--    numerical instabilities introduced by an insufficient reduction of divergences near
-!--    topography.
-       div         =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )                                    &
-                       - u(k,j,i)   * (                                                            &
-                       REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )                            &
-                     + REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp )                            &
-                     + REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp )                            &
-                                      )                                                            &
-                       ) * ddx                                                                     &
-                     + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )                                    &
-                       - v(k,j,i)   * (                                                            &
-                       REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )                            &
-                     + REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp )                            &
-                     + REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp )                            &
-                                      )                                                            &
-                       ) * ddy                                                                     &
-                     + ( w(k,j,i)   * rho_air_zw(k) * ( ibit6 + ibit7 + ibit8 )                    &
-                       - w(k-1,j,i) * rho_air_zw(k-1) *                                            &
-                                      (                                                            &
-                       REAL( IBITS(advc_flag(k-1,j,i),6,1), KIND = wp )                            &
-                     + REAL( IBITS(advc_flag(k-1,j,i),7,1), KIND = wp )                            &
-                     + REAL( IBITS(advc_flag(k-1,j,i),8,1), KIND = wp )                            &
-                                      )                                                            &
-                       ) * drho_air(k) * 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 )                           &
-                       )             * drho_air(k) * 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)
-
-    ENDDO
-
-    DO  k = nzb_max_l+1, nzt
-
-       flux_d    = flux_t(k-1)
-       diss_d    = diss_t(k-1)
-!
-!--    Calculate the divergence of the velocity field. A respective correction is needed to overcome
-!--    numerical instabilities introduced by an insufficient 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)   * rho_air_zw(k)                                                &
-                       - w(k-1,j,i) * rho_air_zw(k-1)                                              &
-                                               ) * drho_air(k) * 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 )                           &
-                                                 ) * drho_air(k) * 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)
-
-    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) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )     &
-                                                 * ( w(k,j,i) - hom(k,1,3,0)                 )     &
-                                     + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )     &
-                                                 *   ABS( w(k,j,i) - hom(k,1,3,0)            )     &
-                                     ) * 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) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )     &
-                                                 * ( w(k,j,i)    - hom(k,1,3,0)              )     &
-                                     + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )     &
-                                                 *   ABS( w(k,j,i) - hom(k,1,3,0)            )     &
-                                     ) * 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) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )     &
-                                                 * ( w(k,j,i) - hom(k,1,3,0)                 )     &
-                                     + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )     &
-                                                 *   ABS( w(k,j,i) - hom(k,1,3,0)            )     &
-                                     ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-       CASE ( 'qc' )
-
-          DO  k = nzb, nzt
-             sums_wsqcs_ws_l(k,tn)  = sums_wsqcs_ws_l(k,tn) +                                      &
-                                      ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-       CASE ( 'qg' )
-
-          DO  k = nzb, nzt
-             sums_wsqgs_ws_l(k,tn)  = sums_wsqgs_ws_l(k,tn) +                                      &
-                                      ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-       CASE ( 'qi' )
-
-          DO  k = nzb, nzt
-             sums_wsqis_ws_l(k,tn)  = sums_wsqis_ws_l(k,tn) +                                      &
-                                      ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * 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) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-       CASE ( 'qs' )
-
-          DO  k = nzb, nzt
-             sums_wsqss_ws_l(k,tn)  = sums_wsqss_ws_l(k,tn) +                                      &
-                                      ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-       CASE ( 'nc' )
-
-          DO  k = nzb, nzt
-             sums_wsncs_ws_l(k,tn)  = sums_wsncs_ws_l(k,tn) +                                      &
-                                      ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-       CASE ( 'ng' )
-
-          DO  k = nzb, nzt
-             sums_wsngs_ws_l(k,tn)  = sums_wsngs_ws_l(k,tn) +                                      &
-                                      ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-
-       CASE ( 'ni' )
-
-          DO  k = nzb, nzt
-             sums_wsnis_ws_l(k,tn)  = sums_wsnis_ws_l(k,tn) +                                      &
-                                      ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * 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) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-       CASE ( 'ns' )
-
-          DO  k = nzb, nzt
-             sums_wsnss_ws_l(k,tn)  = sums_wsnss_ws_l(k,tn) +                                      &
-                                      ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-       CASE ( 's' )
-
-          DO  k = nzb, nzt
-             sums_wsss_ws_l(k,tn)  = sums_wsss_ws_l(k,tn) +                                        &
-                                     ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )     &
-                                                 * ( w(k,j,i) - hom(k,1,3,0)                 )     &
-                                     + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )     &
-                                                 *   ABS( w(k,j,i) - hom(k,1,3,0)            )     &
-                                     ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-       CASE ( 'aerosol_mass', 'aerosol_number', 'salsa_gas' )
-
-          DO  k = nzb, nzt
-             sums_salsa_ws_l(k,tn)  = sums_salsa_ws_l(k,tn) +                                      &
-                                      ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * weight_substep(intermediate_timestep_count)
-          ENDDO
-
-       CASE ( 'kc' )
-          DO  k = nzb, nzt
-             sums_wschs_ws_l(k,tn)  = sums_wschs_ws_l(k,tn) +                                      &
-                                      ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )    &
-                                                  * ( w(k,j,i) - hom(k,1,3,0)                 )    &
-                                      + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp              )    &
-                                                  *   ABS( w(k,j,i) - hom(k,1,3,0)            )    &
-                                      ) * 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 )
-
-
-    INTEGER(iwp) ::  i         !< grid index along x-direction
-    INTEGER(iwp) ::  i_omp     !< leftmost index on subdomain, or in case of OpenMP, on thread
-    INTEGER(iwp) ::  j         !< grid index along y-direction
-    INTEGER(iwp) ::  k         !< grid index along z-direction
-    INTEGER(iwp) ::  k_mm      !< k-2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
-    INTEGER(iwp) ::  tn        !< number of OpenMP thread
-
-    REAL(wp)    ::  diss_d   !< artificial dissipation term at grid box bottom
-    REAL(wp)    ::  div      !< diverence on u-grid
-    REAL(wp)    ::  flux_d   !< 6th-order flux at grid box bottom
-    REAL(wp)    ::  gu       !< Galilei-transformation velocity along x
-    REAL(wp)    ::  gv       !< Galilei-transformation velocity along y
-    REAL(wp)    ::  ibit0   !< flag indicating 1st-order scheme along x-direction
-    REAL(wp)    ::  ibit1   !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp)    ::  ibit2   !< flag indicating 5th-order scheme along x-direction
-    REAL(wp)    ::  ibit3   !< flag indicating 1st-order scheme along y-direction
-    REAL(wp)    ::  ibit4   !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp)    ::  ibit5   !< flag indicating 5th-order scheme along y-direction
-    REAL(wp)    ::  ibit6   !< flag indicating 1st-order scheme along z-direction
-    REAL(wp)    ::  ibit7   !< flag indicating 3rd-order scheme along z-direction
-    REAL(wp)    ::  ibit8   !< flag indicating 5th-order scheme along z-direction
-    REAL(wp)    ::  u_comp_l !< advection velocity along x at leftmost grid point on subdomain
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_t !< discretized artificial dissipation at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_t !< discretized 6th-order flux at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  u_comp !< advection velocity along x
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  v_comp !< advection velocity along y
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  w_comp !< advection velocity along z
-!
-!-- Used local modified copy of nzb_max (used to degrade order of discretization) at non-cyclic
-!-- boundaries. Modify only at relevant points instead of the entire subdomain. This should lead to
-!-- better load balance between boundary and non-boundary PEs.
-    IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR.                        &
-        ( bc_dirichlet_r  .OR.  bc_radiation_r )  .AND.  i >= nxr - 2  .OR.                        &
-        ( bc_dirichlet_s  .OR.  bc_radiation_s )  .AND.  j <= nys + 2  .OR.                        &
-        ( bc_dirichlet_n  .OR.  bc_radiation_n )  .AND.  j >= nyn - 2 )  THEN
-       nzb_max_l = nzt
-    ELSE
-       nzb_max_l = nzb_max
-    END IF
-
-    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_l
-
-          ibit5 = REAL( IBITS(advc_flags_m(k,j-1,i),5,1), KIND = wp )
-          ibit4 = REAL( IBITS(advc_flags_m(k,j-1,i),4,1), KIND = wp )
-          ibit3 = REAL( IBITS(advc_flags_m(k,j-1,i),3,1), KIND = wp )
-
-          v_comp(k)      = v(k,j,i) + v(k,j,i-1) - gv
-          flux_s_u(k,tn) = v_comp(k) * (                                                           &
-                           (  37.0_wp * ibit5 * adv_mom_5                                          &
-                           +   7.0_wp * ibit4 * adv_mom_3                                          &
-                           +            ibit3 * adv_mom_1 ) * ( u(k,j,i)    + u(k,j-1,i) )         &
-                           - ( 8.0_wp * ibit5 * adv_mom_5                                          &
-                           +            ibit4 * adv_mom_3 ) * ( u(k,j+1,i)  + u(k,j-2,i) )         &
-                           + (          ibit5 * adv_mom_5 ) *  ( u(k,j+2,i) + u(k,j-3,i) )         &
-                                       )
-
-          diss_s_u(k,tn) = - ABS ( v_comp(k) ) * (                                                 &
-                           (  10.0_wp * ibit5 * adv_mom_5                                          &
-                           +   3.0_wp * ibit4 * adv_mom_3                                          &
-                           +            ibit3 * adv_mom_1 ) * ( u(k,j,i)   - u(k,j-1,i) )          &
-                           - ( 5.0_wp * ibit5 * adv_mom_5                                          &
-                           +            ibit4 * adv_mom_3 ) * ( u(k,j+1,i) - u(k,j-2,i) )          &
-                           + (          ibit5 * adv_mom_5 ) * ( u(k,j+2,i) - u(k,j-3,i) )          &
-                                                )
-
-       ENDDO
-
-       DO  k = nzb_max_l+1, nzt
-
-          v_comp(k)      = v(k,j,i) + v(k,j,i-1) - gv
-          flux_s_u(k,tn) = v_comp(k) * (                                                           &
-                             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(k)) * (                                                    &
-                                    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  .OR.  i == nxlu )  THEN
-
-       DO  k = nzb+1, nzb_max_l
-
-          ibit2 = REAL( IBITS(advc_flags_m(k,j,i-1),2,1), KIND = wp )
-          ibit1 = REAL( IBITS(advc_flags_m(k,j,i-1),1,1), KIND = wp )
-          ibit0 = REAL( IBITS(advc_flags_m(k,j,i-1),0,1), KIND = wp )
-
-          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 * ibit2 * adv_mom_5                                        &
-                             +   7.0_wp * ibit1 * adv_mom_3                                        &
-                             +            ibit0 * adv_mom_1 ) * ( u(k,j,i)   + u(k,j,i-1) )        &
-                             - ( 8.0_wp * ibit2 * adv_mom_5                                        &
-                             +            ibit1 * adv_mom_3 ) * ( u(k,j,i+1) + u(k,j,i-2) )        &
-                             + (          ibit2 * 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 * ibit2 * adv_mom_5                                        &
-                             +   3.0_wp * ibit1 * adv_mom_3                                        &
-                             +           ibit0  * adv_mom_1 ) * ( u(k,j,i)   - u(k,j,i-1) )        &
-                             - ( 5.0_wp * ibit2 * adv_mom_5                                        &
-                             +            ibit1 * adv_mom_3 ) * ( u(k,j,i+1) - u(k,j,i-2) )        &
-                             + (          ibit2 * adv_mom_5 ) * ( u(k,j,i+2) - u(k,j,i-3) )        &
-                                                 )
-
-       ENDDO
-
-       DO  k = nzb_max_l+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
-!
-!-- Now compute the fluxes tendency terms for the horizontal and vertical parts.
-    DO  k = nzb+1, nzb_max_l
-
-       ibit2 = REAL( IBITS(advc_flags_m(k,j,i),2,1), KIND = wp )
-       ibit1 = REAL( IBITS(advc_flags_m(k,j,i),1,1), KIND = wp )
-       ibit0 = REAL( IBITS(advc_flags_m(k,j,i),0,1), KIND = wp )
-
-       u_comp(k) = u(k,j,i+1) + u(k,j,i)
-       flux_r(k) = ( u_comp(k) - gu ) * (                                                          &
-                   (  37.0_wp * ibit2 * adv_mom_5                                                  &
-                   +   7.0_wp * ibit1 * adv_mom_3                                                  &
-                   +            ibit0 * adv_mom_1 ) * ( u(k,j,i+1) + u(k,j,i)   )                  &
-                   - ( 8.0_wp * ibit2 * adv_mom_5                                                  &
-                   +            ibit1 * adv_mom_3 ) * ( u(k,j,i+2) + u(k,j,i-1) )                  &
-                   + (          ibit2 * adv_mom_5 ) * ( u(k,j,i+3) + u(k,j,i-2) )                  &
-                                        )
-
-       diss_r(k) = - ABS( u_comp(k) - gu ) * (                                                     &
-                   (  10.0_wp * ibit2 * adv_mom_5                                                  &
-                   +   3.0_wp * ibit1 * adv_mom_3                                                  &
-                   +            ibit0 * adv_mom_1 ) * ( u(k,j,i+1) - u(k,j,i)   )                  &
-                   - ( 5.0_wp * ibit2 * adv_mom_5                                                  &
-                   +            ibit1 * adv_mom_3 ) * ( u(k,j,i+2) - u(k,j,i-1) )                  &
-                   + (          ibit2 * adv_mom_5 ) * ( u(k,j,i+3) - u(k,j,i-2) )                  &
-                                             )
-
-       ibit5 = REAL( IBITS(advc_flags_m(k,j,i),5,1), KIND = wp )
-       ibit4 = REAL( IBITS(advc_flags_m(k,j,i),4,1), KIND = wp )
-       ibit3 = REAL( IBITS(advc_flags_m(k,j,i),3,1), KIND = wp )
-
-       v_comp(k) = v(k,j+1,i) + v(k,j+1,i-1) - gv
-       flux_n(k) = v_comp(k) * (                                                                   &
-                   (  37.0_wp * ibit5 * adv_mom_5                                                  &
-                   +   7.0_wp * ibit4 * adv_mom_3                                                  &
-                   +            ibit3 * adv_mom_1 ) * ( u(k,j+1,i) + u(k,j,i)   )                  &
-                   - ( 8.0_wp * ibit5 * adv_mom_5                                                  &
-                   +            ibit4 * adv_mom_3 ) * ( u(k,j+2,i) + u(k,j-1,i) )                  &
-                   + (          ibit5 * adv_mom_5 ) * ( u(k,j+3,i) + u(k,j-2,i) )                  &
-                               )
-
-       diss_n(k) = - ABS ( v_comp(k) ) * (                                                         &
-                   (  10.0_wp * ibit5 * adv_mom_5                                                  &
-                   +   3.0_wp * ibit4 * adv_mom_3                                                  &
-                   +    ibit3 * adv_mom_1 ) * ( u(k,j+1,i) - u(k,j,i)   )                          &
-                   - ( 5.0_wp * ibit5 * adv_mom_5                                                  &
-                   +    ibit4 * adv_mom_3 ) * ( u(k,j+2,i) - u(k,j-1,i) )                          &
-                   + (  ibit5 * adv_mom_5 ) * ( u(k,j+3,i) - u(k,j-2,i) )                          &
-                                         )
-    ENDDO
-
-    DO  k = nzb_max_l+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(k) = v(k,j+1,i) + v(k,j+1,i-1) - gv
-       flux_n(k) = v_comp(k) * (                                                                   &
-                      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(k) ) * (                                                          &
-                      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
-
-    ENDDO
-!
-!-- Now, compute vertical fluxes. Split loop into a part treating the lowest grid points with
-!-- indirect indexing, a main loop without indirect indexing, and a loop for the uppermost grid
-!-- points with indirect indexing. This allows better vectorization for the main loop.
-!-- First, compute the flux at model surface, which need has to be calculated explicitly for the
-!-- tendency at the first w-level. For topography wall this is done implicitely by advc_flags_m.
-    flux_t(nzb) = 0.0_wp
-    diss_t(nzb) = 0.0_wp
-    w_comp(nzb) = 0.0_wp
-
-    DO  k = nzb+1, nzb+1
-!
-!--    k index has to be modified near bottom and top, else array subscripts will be exceeded.
-       ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
-       ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
-       ibit6 = REAL( IBITS(advc_flags_m(k,j,i),6,1), KIND = wp )
-
-       k_ppp = k + 3 * ibit8
-       k_pp  = k + 2 * ( 1 - ibit6 )
-       k_mm  = k - 2 * ibit8
-
-       w_comp(k) = w(k,j,i) + w(k,j,i-1)
-       flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                                   &
-                   (  37.0_wp * ibit8 * adv_mom_5                                                  &
-                   +   7.0_wp * ibit7 * adv_mom_3                                                  &
-                   +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)   + u(k,j,i)    )               &
-                   - ( 8.0_wp * ibit8 * adv_mom_5                                                  &
-                   +            ibit7 * adv_mom_3 ) * ( u(k_pp,j,i)  + u(k-1,j,i)  )               &
-                   + (          ibit8 * adv_mom_5 ) * ( u(k_ppp,j,i) + u(k_mm,j,i) )               &
-                                               )
-
-       diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                          &
-                   (  10.0_wp * ibit8 * adv_mom_5                                                  &
-                   +   3.0_wp * ibit7 * adv_mom_3                                                  &
-                   +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)   - u(k,j,i)    )               &
-                   - ( 5.0_wp * ibit8 * adv_mom_5                                                  &
-                   +            ibit7 * adv_mom_3 ) * ( u(k_pp,j,i)  - u(k-1,j,i)  )               &
-                   + (          ibit8 * adv_mom_5 ) * ( u(k_ppp,j,i) - u(k_mm,j,i) )               &
-                                                        )
-    ENDDO
-
-    DO  k = nzb+2, nzt-2
-
-       ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
-       ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
-       ibit6 = REAL( IBITS(advc_flags_m(k,j,i),6,1), KIND = wp )
-
-       w_comp(k) = w(k,j,i) + w(k,j,i-1)
-       flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                                   &
-                   (  37.0_wp * ibit8 * adv_mom_5                                                  &
-                   +   7.0_wp * ibit7 * adv_mom_3                                                  &
-                   +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)  + u(k,j,i)  )                  &
-                   - ( 8.0_wp * ibit8 * adv_mom_5                                                  &
-                   +            ibit7 * adv_mom_3 ) * ( u(k+2,j,i) + u(k-1,j,i) )                  &
-                   + (          ibit8 * adv_mom_5 ) * ( u(k+3,j,i) + u(k-2,j,i) )                  &
-                                               )
-
-       diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                          &
-                   (  10.0_wp * ibit8 * adv_mom_5                                                  &
-                   +   3.0_wp * ibit7 * adv_mom_3                                                  &
-                   +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)  - u(k,j,i)   )                 &
-                   - ( 5.0_wp * ibit8 * adv_mom_5                                                  &
-                   +            ibit7 * adv_mom_3 ) * ( u(k+2,j,i)  - u(k-1,j,i) )                 &
-                   + (          ibit8 * adv_mom_5 ) * ( u(k+3,j,i) - u(k-2,j,i)  )                 &
-                                                        )
-    ENDDO
-
-    DO  k = nzt-1, nzt-symmetry_flag
-!
-!--    k index has to be modified near bottom and top, else array subscripts will be exceeded.
-       ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
-       ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
-       ibit6 = REAL( IBITS(advc_flags_m(k,j,i),6,1), KIND = wp )
-
-       k_ppp = k + 3 * ibit8
-       k_pp  = k + 2 * ( 1 - ibit6 )
-       k_mm  = k - 2 * ibit8
-
-       w_comp(k) = w(k,j,i) + w(k,j,i-1)
-       flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                                   &
-                   (  37.0_wp * ibit8 * adv_mom_5                                                  &
-                   +   7.0_wp * ibit7 * adv_mom_3                                                  &
-                   +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)   + u(k,j,i)    )               &
-                   - ( 8.0_wp * ibit8 * adv_mom_5                                                  &
-                   +            ibit7 * adv_mom_3 ) * ( u(k_pp,j,i)  + u(k-1,j,i)  )               &
-                   + (          ibit8 * adv_mom_5 ) * ( u(k_ppp,j,i) + u(k_mm,j,i) )               &
-                                               )
-
-       diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                          &
-                   (  10.0_wp * ibit8 * adv_mom_5                                                  &
-                   +   3.0_wp * ibit7 * adv_mom_3                                                  &
-                   +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)   - u(k,j,i)    )               &
-                   - ( 5.0_wp * ibit8 * adv_mom_5                                                  &
-                   +            ibit7 * adv_mom_3 ) * ( u(k_pp,j,i)  - u(k-1,j,i)  )               &
-                   + (          ibit8 * adv_mom_5 ) * ( u(k_ppp,j,i) - u(k_mm,j,i) )               &
-                                                        )
-    ENDDO
-
-!
-!-- Set resolved/turbulent flux at model top to zero (w-level). In case that a symmetric behavior
-!-- between bottom and top shall be guaranteed (closed channel flow), the flux at nzt is also set to
-!-- zero.
-    IF ( symmetry_flag == 1 )  THEN
-       flux_t(nzt) = 0.0_wp
-       diss_t(nzt) = 0.0_wp
-       w_comp(nzt) = 0.0_wp
-    ENDIF
-    flux_t(nzt+1) = 0.0_wp
-    diss_t(nzt+1) = 0.0_wp
-    w_comp(nzt+1) = 0.0_wp
-
-    DO  k = nzb+1, nzb_max_l
-
-       flux_d    = flux_t(k-1)
-       diss_d    = diss_t(k-1)
-
-       ibit2 = REAL( IBITS(advc_flags_m(k,j,i),2,1), KIND = wp )
-       ibit1 = REAL( IBITS(advc_flags_m(k,j,i),1,1), KIND = wp )
-       ibit0 = REAL( IBITS(advc_flags_m(k,j,i),0,1), KIND = wp )
-
-       ibit5 = REAL( IBITS(advc_flags_m(k,j,i),5,1), KIND = wp )
-       ibit4 = REAL( IBITS(advc_flags_m(k,j,i),4,1), KIND = wp )
-       ibit3 = REAL( IBITS(advc_flags_m(k,j,i),3,1), KIND = wp )
-
-       ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
-       ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
-       ibit6 = REAL( IBITS(advc_flags_m(k,j,i),6,1), KIND = wp )
-!
-!--    Calculate the divergence of the velocity field. A respective correction is needed to overcome
-!--    numerical instabilities introduced by an insufficient reduction of divergences near
-!--    topography.
-       div = ( ( u_comp(k)       * ( ibit0 + ibit1 + ibit2 )                                       &
-             - ( u(k,j,i)   + u(k,j,i-1)   )                                                       &
-                                 * (                                                               &
-                  REAL( IBITS(advc_flags_m(k,j,i-1),0,1), KIND = wp )                              &
-                + REAL( IBITS(advc_flags_m(k,j,i-1),1,1), KIND = wp )                              &
-                + REAL( IBITS(advc_flags_m(k,j,i-1),2,1), KIND = wp )                              &
-                                   )                                                               &
-               ) * ddx                                                                             &
-             + ( ( v_comp(k) + gv ) * ( ibit3 + ibit4 + ibit5 )                                    &
-               - ( v(k,j,i)   + v(k,j,i-1 )  )                                                     &
-                                 * (                                                               &
-                  REAL( IBITS(advc_flags_m(k,j-1,i),3,1), KIND = wp )                              &
-                + REAL( IBITS(advc_flags_m(k,j-1,i),4,1), KIND = wp )                              &
-                + REAL( IBITS(advc_flags_m(k,j-1,i),5,1), KIND = wp )                              &
-                                   )                                                               &
-               ) * ddy                                                                             &
-             + ( w_comp(k)   * rho_air_zw(k) * ( ibit6 + ibit7 + ibit8 )                           &
-             -   w_comp(k-1) * rho_air_zw(k-1)                                                     &
-                                 * (                                                               &
-                  REAL( IBITS(advc_flags_m(k-1,j,i),6,1), KIND = wp )                              &
-                + REAL( IBITS(advc_flags_m(k-1,j,i),7,1), KIND = wp )                              &
-                + REAL( IBITS(advc_flags_m(k-1,j,i),8,1), KIND = wp )                              &
-                                   )                                                               &
-               ) * drho_air(k) * 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    )                                               &
-                         )                         * drho_air(k) * 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)
-!
-!--    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 + SIGN( 1.0E-20_wp, u_comp(k) - gu ) )           &
-                             + 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)                                                          &
-                                * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )          &
-                                / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )          &
-                              + diss_t(k)                                                          &
-                                *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )          &
-                                / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )          &
-                              ) *   weight_substep(intermediate_timestep_count)
-    ENDDO
-
-    DO  k = nzb_max_l+1, nzt
-
-       flux_d    = flux_t(k-1)
-       diss_d    = diss_t(k-1)
-!
-!--    Calculate the divergence of the velocity field. A respective correction is needed to overcome
-!--    numerical instabilities introduced by an insufficient reduction of divergences near
-!--    topography.
-       div = ( ( u_comp(k)       - ( u(k,j,i)   + u(k,j,i-1) ) ) * ddx                             &
-             + ( v_comp(k) + gv  - ( v(k,j,i)   + v(k,j,i-1) ) ) * ddy                             &
-             + ( w_comp(k)   * rho_air_zw(k)                                                       &
-             -   w_comp(k-1) * rho_air_zw(k-1)                                                     &
-               )                                   * drho_air(k) * 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    )                                               &
-                                                 ) * drho_air(k) * 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)
-!
-!--    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 + SIGN( 1.0E-20_wp, u_comp(k) - gu ) )           &
-                             + 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)                                                          &
-                                * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )          &
-                                / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )          &
-                              + diss_t(k)                                                          &
-                                *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )          &
-                                / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )          &
-                              ) *   weight_substep(intermediate_timestep_count)
-    ENDDO
-
-
-
- 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 )
-
-
-    INTEGER(iwp)  ::  i         !< grid index along x-direction
-    INTEGER(iwp)  ::  i_omp     !< leftmost index on subdomain, or in case of OpenMP, on thread
-    INTEGER(iwp)  ::  j         !< grid index along y-direction
-    INTEGER(iwp)  ::  k         !< grid index along z-direction
-    INTEGER(iwp)  ::  k_mm      !< k-2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp)  ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp)  ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp)  ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
-    INTEGER(iwp)  ::  tn        !< number of OpenMP thread
-
-    REAL(wp)      ::  diss_d   !< artificial dissipation term at grid box bottom
-    REAL(wp)      ::  div      !< divergence on v-grid
-    REAL(wp)      ::  flux_d   !< 6th-order flux at grid box bottom
-    REAL(wp)      ::  gu       !< Galilei-transformation velocity along x
-    REAL(wp)      ::  gv       !< Galilei-transformation velocity along y
-    REAL(wp)      ::  ibit9    !< flag indicating 1st-order scheme along x-direction
-    REAL(wp)      ::  ibit10   !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp)      ::  ibit11   !< flag indicating 5th-order scheme along x-direction
-    REAL(wp)      ::  ibit12   !< flag indicating 1st-order scheme along y-direction
-    REAL(wp)      ::  ibit13   !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp)      ::  ibit14   !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp)      ::  ibit15   !< flag indicating 1st-order scheme along z-direction
-    REAL(wp)      ::  ibit16   !< flag indicating 3rd-order scheme along z-direction
-    REAL(wp)      ::  ibit17   !< flag indicating 3rd-order scheme along z-direction
-    REAL(wp)      ::  v_comp_l !< advection velocity along y on leftmost grid point on subdomain
-
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_t !< discretized artificial dissipation at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_t !< discretized 6th-order flux at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  u_comp !< advection velocity along x
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  v_comp !< advection velocity along y
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  w_comp !< advection velocity along z
-!
-!-- Used local modified copy of nzb_max (used to degrade order of discretization) at non-cyclic
-!-- boundaries. Modify only at relevant points instead of the entire subdomain. This should lead to
-!-- better load balance between boundary and non-boundary PEs.
-    IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR.                        &
-        ( bc_dirichlet_r  .OR.  bc_radiation_r )  .AND.  i >= nxr - 2  .OR.                        &
-        ( bc_dirichlet_s  .OR.  bc_radiation_s )  .AND.  j <= nys + 2  .OR.                        &
-        ( bc_dirichlet_n  .OR.  bc_radiation_n )  .AND.  j >= nyn - 2 )  THEN
-       nzb_max_l = nzt
-    ELSE
-       nzb_max_l = nzb_max
-    END IF
-
-    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_l
-
-          ibit11 = REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )
-          ibit10 = REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )
-          ibit9  = REAL( IBITS(advc_flags_m(k,j,i-1),9,1),  KIND = wp )
-
-          u_comp(k)        = u(k,j-1,i) + u(k,j,i) - gu
-          flux_l_v(k,j,tn) = u_comp(k) * (                                                         &
-                             (  37.0_wp * ibit11 * adv_mom_5                                       &
-                             +   7.0_wp * ibit10 * adv_mom_3                                       &
-                             +            ibit9  * adv_mom_1 ) * ( v(k,j,i)   + v(k,j,i-1) )       &
-                             - ( 8.0_wp * ibit11 * adv_mom_5                                       &
-                             +            ibit10 * adv_mom_3 ) * ( v(k,j,i+1) + v(k,j,i-2) )       &
-                             + (          ibit11 * adv_mom_5 ) * ( v(k,j,i+2) + v(k,j,i-3) )       &
-                                         )
-
-          diss_l_v(k,j,tn) = - ABS( u_comp(k) ) * (                                                &
-                             (  10.0_wp * ibit11 * adv_mom_5                                       &
-                             +   3.0_wp * ibit10 * adv_mom_3                                       &
-                             +            ibit9  * adv_mom_1 ) * ( v(k,j,i)   - v(k,j,i-1) )       &
-                             - ( 5.0_wp * ibit11 * adv_mom_5                                       &
-                             +            ibit10 * adv_mom_3 ) * ( v(k,j,i+1) - v(k,j,i-2) )       &
-                             + (          ibit11 * adv_mom_5 ) * ( v(k,j,i+2) - v(k,j,i-3) )       &
-                                                  )
-
-       ENDDO
-
-       DO  k = nzb_max_l+1, nzt
-
-          u_comp(k)        = u(k,j-1,i) + u(k,j,i) - gu
-          flux_l_v(k,j,tn) = u_comp(k) * (                                                         &
-                               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(k) ) * (                                                &
-                               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_l
-
-          ibit14 = REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )
-          ibit13 = REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )
-          ibit12 = REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )
-
-          v_comp_l       = v(k,j,i) + v(k,j-1,i) - gv
-          flux_s_v(k,tn) = v_comp_l * (                                                            &
-                         (  37.0_wp * ibit14 * adv_mom_5                                           &
-                         +   7.0_wp * ibit13 * adv_mom_3                                           &
-                         +            ibit12 * adv_mom_1 ) * ( v(k,j,i)   + v(k,j-1,i) )           &
-                         - ( 8.0_wp * ibit14 * adv_mom_5                                           &
-                         +            ibit13 * adv_mom_3 ) * ( v(k,j+1,i) + v(k,j-2,i) )           &
-                         + (          ibit14 * 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 * ibit14 * adv_mom_5                                         &
-                           +   3.0_wp * ibit13 * adv_mom_3                                         &
-                           +            ibit12 * adv_mom_1 ) * ( v(k,j,i)   - v(k,j-1,i) )         &
-                           - ( 5.0_wp * ibit14 * adv_mom_5                                         &
-                           +            ibit13 * adv_mom_3 ) * ( v(k,j+1,i) - v(k,j-2,i) )         &
-                           + (          ibit14 * adv_mom_5 ) * ( v(k,j+2,i) - v(k,j-3,i) )         &
-                                               )
-
-       ENDDO
-
-       DO  k = nzb_max_l+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
-!
-!--    Now compute the fluxes and tendency terms for the horizontal and
-!--    verical parts.
-    DO  k = nzb+1, nzb_max_l
-
-       ibit11 = REAL( IBITS(advc_flags_m(k,j,i),11,1), KIND = wp )
-       ibit10 = REAL( IBITS(advc_flags_m(k,j,i),10,1), KIND = wp )
-       ibit9  = REAL( IBITS(advc_flags_m(k,j,i),9,1),  KIND = wp )
-
-       u_comp(k) = u(k,j-1,i+1) + u(k,j,i+1) - gu
-       flux_r(k) = u_comp(k) * (                                                                   &
-                  (  37.0_wp * ibit11 * adv_mom_5                                                  &
-                  +   7.0_wp * ibit10 * adv_mom_3                                                  &
-                  +            ibit9  * adv_mom_1 ) * ( v(k,j,i+1) + v(k,j,i)   )                  &
-                  - ( 8.0_wp * ibit11 * adv_mom_5                                                  &
-                  +            ibit10 * adv_mom_3 ) * ( v(k,j,i+2) + v(k,j,i-1) )                  &
-                  + (          ibit11 * adv_mom_5 ) * ( v(k,j,i+3) + v(k,j,i-2) )                  &
-                               )
-
-       diss_r(k) = - ABS( u_comp(k) ) * (                                                          &
-                  (  10.0_wp * ibit11 * adv_mom_5                                                  &
-                  +   3.0_wp * ibit10 * adv_mom_3                                                  &
-                  +            ibit9  * adv_mom_1 ) * ( v(k,j,i+1) - v(k,j,i)  )                   &
-                  - ( 5.0_wp * ibit11 * adv_mom_5                                                  &
-                  +            ibit10 * adv_mom_3 ) * ( v(k,j,i+2) - v(k,j,i-1) )                  &
-                  + (          ibit11 * adv_mom_5 ) * ( v(k,j,i+3) - v(k,j,i-2) )                  &
-                                        )
-
-       ibit14 = REAL( IBITS(advc_flags_m(k,j,i),14,1), KIND = wp )
-       ibit13 = REAL( IBITS(advc_flags_m(k,j,i),13,1), KIND = wp )
-       ibit12 = REAL( IBITS(advc_flags_m(k,j,i),12,1), KIND = wp )
-
-
-       v_comp(k) = v(k,j+1,i) + v(k,j,i)
-       flux_n(k) = ( v_comp(k) - gv ) * (                                                          &
-                   (  37.0_wp * ibit14 * adv_mom_5                                                 &
-                   +   7.0_wp * ibit13 * adv_mom_3                                                 &
-                   +            ibit12 * adv_mom_1 ) * ( v(k,j+1,i) + v(k,j,i)   )                 &
-                   - ( 8.0_wp * ibit14 * adv_mom_5                                                 &
-                   +            ibit13 * adv_mom_3 ) * ( v(k,j+2,i) + v(k,j-1,i) )                 &
-                   + (          ibit14 * adv_mom_5 ) * ( v(k,j+3,i) + v(k,j-2,i) )                 &
-                                        )
-
-       diss_n(k) = - ABS( v_comp(k) - gv ) * (                                                     &
-                   (  10.0_wp * ibit14 * adv_mom_5                                                 &
-                   +   3.0_wp * ibit13 * adv_mom_3                                                 &
-                   +            ibit12 * adv_mom_1 ) * ( v(k,j+1,i) - v(k,j,i)   )                 &
-                   - ( 5.0_wp * ibit14 * adv_mom_5                                                 &
-                   +            ibit13 * adv_mom_3 ) * ( v(k,j+2,i) - v(k,j-1,i) )                 &
-                   + (          ibit14 * adv_mom_5 ) * ( v(k,j+3,i) - v(k,j-2,i) )                 &
-                                             )
-    ENDDO
-
-    DO  k = nzb_max_l+1, nzt
-
-       u_comp(k) = u(k,j-1,i+1) + u(k,j,i+1) - gu
-       flux_r(k) = u_comp(k) * (                                                                   &
-                     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(k) ) * (                                                          &
-                     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
-    ENDDO
-!
-!--    Now, compute vertical fluxes. Split loop into a part treating the lowest grid points with
-!--    indirect indexing, a main loop without indirect indexing, and a loop for the uppermost grid
-!--    points with indirect indexing. This allows better vectorization for the main loop.
-!--    First, compute the flux at model surface, which need has to be calculated explicitly for the
-!--    tendency at the first w-level. For topography wall this is done implicitely by advc_flags_m.
-    flux_t(nzb) = 0.0_wp
-    diss_t(nzb) = 0.0_wp
-    w_comp(nzb) = 0.0_wp
-
-    DO  k = nzb+1, nzb+1
-!
-!--    k index has to be modified near bottom and top, else array
-!--    subscripts will be exceeded.
-       ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
-       ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
-       ibit15 = REAL( IBITS(advc_flags_m(k,j,i),15,1), KIND = wp )
-
-       k_ppp = k + 3 * ibit17
-       k_pp  = k + 2 * ( 1 - ibit15  )
-       k_mm  = k - 2 * ibit17
-
-       w_comp(k) = w(k,j-1,i) + w(k,j,i)
-       flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                                   &
-                   (  37.0_wp * ibit17 * adv_mom_5                                                 &
-                   +   7.0_wp * ibit16 * adv_mom_3                                                 &
-                   +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i)   + v(k,j,i)    )              &
-                   - ( 8.0_wp * ibit17 * adv_mom_5                                                 &
-                   +            ibit16 * adv_mom_3 ) * ( v(k_pp,j,i)  + v(k-1,j,i)  )              &
-                   + (          ibit17 * adv_mom_5 ) * ( v(k_ppp,j,i) + v(k_mm,j,i) )              &
-                                               )
-
-       diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                          &
-                   (  10.0_wp * ibit17 * adv_mom_5                                                 &
-                   +   3.0_wp * ibit16 * adv_mom_3                                                 &
-                   +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i)   - v(k,j,i)    )              &
-                   - ( 5.0_wp * ibit17 * adv_mom_5                                                 &
-                   +            ibit16 * adv_mom_3 ) * ( v(k_pp,j,i)  - v(k-1,j,i)  )              &
-                   + (          ibit17 * adv_mom_5 ) * ( v(k_ppp,j,i) - v(k_mm,j,i) )              &
-                                                        )
-    ENDDO
-
-    DO  k = nzb+2, nzt-2
-
-       ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
-       ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
-       ibit15 = REAL( IBITS(advc_flags_m(k,j,i),15,1), KIND = wp )
-
-       w_comp(k) = w(k,j-1,i) + w(k,j,i)
-       flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                                   &
-                  (  37.0_wp * ibit17 * adv_mom_5                                                  &
-                  +   7.0_wp * ibit16 * adv_mom_3                                                  &
-                  +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i) + v(k,j,i)   )                  &
-                  - ( 8.0_wp * ibit17 * adv_mom_5                                                  &
-                  +            ibit16 * adv_mom_3 ) * ( v(k+2,j,i) + v(k-1,j,i) )                  &
-                  + (          ibit17 * adv_mom_5 ) * ( v(k+3,j,i) + v(k-2,j,i) )                  &
-                                               )
-
-       diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                          &
-                   (  10.0_wp * ibit17 * adv_mom_5                                                 &
-                   +   3.0_wp * ibit16 * adv_mom_3                                                 &
-                   +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i) - v(k,j,i)   )                 &
-                   - ( 5.0_wp * ibit17 * adv_mom_5                                                 &
-                   +            ibit16 * adv_mom_3 ) * ( v(k+2,j,i) - v(k-1,j,i) )                 &
-                   + (          ibit17 * adv_mom_5 ) * ( v(k+3,j,i) - v(k-2,j,i) )                 &
-                                                        )
-    ENDDO
-
-    DO  k = nzt-1, nzt-symmetry_flag
-!
-!--    k index has to be modified near bottom and top, else array subscripts will be exceeded.
-       ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
-       ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
-       ibit15 = REAL( IBITS(advc_flags_m(k,j,i),15,1), KIND = wp )
-
-       k_ppp = k + 3 * ibit17
-       k_pp  = k + 2 * ( 1 - ibit15  )
-       k_mm  = k - 2 * ibit17
-
-       w_comp(k) = w(k,j-1,i) + w(k,j,i)
-       flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                                   &
-                   (  37.0_wp * ibit17 * adv_mom_5                                                 &
-                   +   7.0_wp * ibit16 * adv_mom_3                                                 &
-                   +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i)   + v(k,j,i)    )              &
-                   - ( 8.0_wp * ibit17 * adv_mom_5                                                 &
-                   +            ibit16 * adv_mom_3 ) * ( v(k_pp,j,i)  + v(k-1,j,i)  )              &
-                   + (          ibit17 * adv_mom_5 ) * ( v(k_ppp,j,i) + v(k_mm,j,i) )              &
-                                               )
-
-       diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                          &
-                   (  10.0_wp * ibit17 * adv_mom_5                                                 &
-                   +   3.0_wp * ibit16 * adv_mom_3                                                 &
-                   +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i)   - v(k,j,i)    )              &
-                   - ( 5.0_wp * ibit17 * adv_mom_5                                                 &
-                   +            ibit16 * adv_mom_3 ) * ( v(k_pp,j,i)  - v(k-1,j,i)  )              &
-                   + (          ibit17 * adv_mom_5 ) * ( v(k_ppp,j,i) - v(k_mm,j,i) )              &
-                                                        )
-    ENDDO
-
-!
-!-- Set resolved/turbulent flux at model top to zero (w-level). In case that a symmetric behavior
-!-- between bottom and top shall be guaranteed (closed channel flow), the flux at nzt is also set to
-!-- zero.
-    IF ( symmetry_flag == 1 ) THEN
-       flux_t(nzt) = 0.0_wp
-       diss_t(nzt) = 0.0_wp
-       w_comp(nzt) = 0.0_wp
-    ENDIF
-    flux_t(nzt+1) = 0.0_wp
-    diss_t(nzt+1) = 0.0_wp
-    w_comp(nzt+1) = 0.0_wp
-
-    DO  k = nzb+1, nzb_max_l
-
-       flux_d    = flux_t(k-1)
-       diss_d    = diss_t(k-1)
-
-       ibit11 = REAL( IBITS(advc_flags_m(k,j,i),11,1), KIND = wp )
-       ibit10 = REAL( IBITS(advc_flags_m(k,j,i),10,1), KIND = wp )
-       ibit9  = REAL( IBITS(advc_flags_m(k,j,i),9,1),  KIND = wp )
-
-       ibit14 = REAL( IBITS(advc_flags_m(k,j,i),14,1), KIND = wp )
-       ibit13 = REAL( IBITS(advc_flags_m(k,j,i),13,1), KIND = wp )
-       ibit12 = REAL( IBITS(advc_flags_m(k,j,i),12,1), KIND = wp )
-
-       ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
-       ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
-       ibit15 = REAL( IBITS(advc_flags_m(k,j,i),15,1), KIND = wp )
-!
-!--    Calculate the divergence of the velocity field. A respective correction is needed to overcome
-!--    numerical instabilities introduced by an insufficient reduction of divergences near
-!--    topography.
-       div = ( ( ( u_comp(k)     + gu )                                                            &
-                                    * ( ibit9 + ibit10 + ibit11 )                                  &
-               - ( u(k,j-1,i) + u(k,j,i) )                                                         &
-                                    * (                                                            &
-                     REAL( IBITS(advc_flags_m(k,j,i-1),9,1),  KIND = wp )                          &
-                   + REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )                          &
-                   + REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )                          &
-                                      )                                                            &
-               ) * ddx                                                                             &
-             + ( v_comp(k)                                                                         &
-                                    * ( ibit12 + ibit13 + ibit14 )                                 &
-             - ( v(k,j,i)     + v(k,j-1,i) )                                                       &
-                                    * (                                                            &
-                     REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )                          &
-                   + REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )                          &
-                   + REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )                          &
-                                      )                                                            &
-               ) * ddy                                                                             &
-             + ( w_comp(k)   * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 )                        &
-             -   w_comp(k-1) * rho_air_zw(k-1)                                                     &
-                                    * (                                                            &
-                     REAL( IBITS(advc_flags_m(k-1,j,i),15,1), KIND = wp )                          &
-                   + REAL( IBITS(advc_flags_m(k-1,j,i),16,1), KIND = wp )                          &
-                   + REAL( IBITS(advc_flags_m(k-1,j,i),17,1), KIND = wp )                          &
-                                      )                                                            &
-                ) * drho_air(k) * 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    )                                                  &
-                                                ) * drho_air(k) * 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)
-!
-!--    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 + SIGN( 1.0E-20_wp, v_comp(k) - gv ) )           &
-                             + 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'u'.
-       sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn) +                                               &
-                              ( flux_t(k)                                                          &
-                                * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )          &
-                                / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )          &
-                              + diss_t(k)                                                          &
-                                *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )          &
-                                / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )          &
-                              ) *   weight_substep(intermediate_timestep_count)
-
-    ENDDO
-
-    DO  k = nzb_max_l+1, nzt
-
-       flux_d    = flux_t(k-1)
-       diss_d    = diss_t(k-1)
-!
-!--    Calculate the divergence of the velocity field. A respective correction is needed to overcome
-!--    numerical instabilities introduced by an insufficient reduction of divergences near
-!--    topography.
-       div = ( ( u_comp(k) + 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(k)   * rho_air_zw(k)                                                       &
-             -   w_comp(k-1) * rho_air_zw(k-1)                                                     &
-               ) * drho_air(k) * 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    )                                                  &
-                                                ) * drho_air(k) * 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)
-!
-!--    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 + SIGN( 1.0E-20_wp, v_comp(k) - gv ) )           &
-                             + 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'u'.
-       sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn) +                                               &
-                              ( flux_t(k)                                                          &
-                                * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )          &
-                                / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )          &
-                              + diss_t(k)                                                          &
-                                *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )          &
-                                / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )          &
-                              ) *   weight_substep(intermediate_timestep_count)
-
-    ENDDO
-
-
- 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 )
-
-
-    INTEGER(iwp) ::  i         !< grid index along x-direction
-    INTEGER(iwp) ::  i_omp     !< leftmost index on subdomain, or in case of OpenMP, on thread
-    INTEGER(iwp) ::  j         !< grid index along y-direction
-    INTEGER(iwp) ::  k         !< grid index along z-direction
-    INTEGER(iwp) ::  k_mm      !< k-2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
-    INTEGER(iwp) ::  tn        !< number of OpenMP thread
-
-    REAL(wp)    ::  diss_d  !< discretized artificial dissipation at top of the grid box
-    REAL(wp)    ::  div     !< divergence on w-grid
-    REAL(wp)    ::  flux_d  !< discretized 6th-order flux at top of the grid box
-    REAL(wp)    ::  gu      !< Galilei-transformation velocity along x
-    REAL(wp)    ::  gv      !< Galilei-transformation velocity along y
-    REAL(wp)    ::  ibit18  !< flag indicating 1st-order scheme along x-direction
-    REAL(wp)    ::  ibit19  !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp)    ::  ibit20  !< flag indicating 5th-order scheme along x-direction
-    REAL(wp)    ::  ibit21  !< flag indicating 1st-order scheme along y-direction
-    REAL(wp)    ::  ibit22  !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp)    ::  ibit23  !< flag indicating 5th-order scheme along y-direction
-    REAL(wp)    ::  ibit24  !< flag indicating 1st-order scheme along z-direction
-    REAL(wp)    ::  ibit25  !< flag indicating 3rd-order scheme along z-direction
-    REAL(wp)    ::  ibit26  !< flag indicating 5th-order scheme along z-direction
-
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_t !< discretized artificial dissipation at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_t !< discretized 6th-order flux at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  u_comp !< advection velocity along x
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  v_comp !< advection velocity along y
-    REAL(wp), DIMENSION(nzb:nzt+1)  ::  w_comp !< advection velocity along z
-!
-!-- Used local modified copy of nzb_max (used to degrade order of discretization) at non-cyclic
-!-- boundaries. Modify only at relevant points instead of the entire subdomain. This should lead to
-!-- better load balance between boundary and non-boundary PEs.
-    IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR.                        &
-        ( bc_dirichlet_r  .OR.  bc_radiation_r )  .AND.  i >= nxr - 2  .OR.                        &
-        ( bc_dirichlet_s  .OR.  bc_radiation_s )  .AND.  j <= nys + 2  .OR.                        &
-        ( bc_dirichlet_n  .OR.  bc_radiation_n )  .AND.  j >= nyn - 2 )  THEN
-       nzb_max_l = nzt - 1
-    ELSE
-       nzb_max_l = nzb_max
-    END IF
-
-    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_l
-          ibit23 = REAL( IBITS(advc_flags_m(k,j-1,i),23,1), KIND = wp )
-          ibit22 = REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp )
-          ibit21 = REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )
-
-          v_comp(k)      = v(k+1,j,i) + v(k,j,i) - gv
-          flux_s_w(k,tn) = v_comp(k) * (                                                           &
-                           (  37.0_wp * ibit23 * adv_mom_5                                         &
-                           +   7.0_wp * ibit22 * adv_mom_3                                         &
-                           +            ibit21 * adv_mom_1 ) * ( w(k,j,i)   + w(k,j-1,i) )         &
-                           - ( 8.0_wp * ibit23 * adv_mom_5                                         &
-                           +            ibit22 * adv_mom_3 ) * ( w(k,j+1,i) + w(k,j-2,i) )         &
-                           + (          ibit23 * adv_mom_5 ) * ( w(k,j+2,i) + w(k,j-3,i) )         &
-                                       )
-
-          diss_s_w(k,tn) = - ABS( v_comp(k) ) * (                                                  &
-                           (  10.0_wp * ibit23 * adv_mom_5                                         &
-                           +   3.0_wp * ibit22 * adv_mom_3                                         &
-                           +            ibit21 * adv_mom_1 ) * ( w(k,j,i)   - w(k,j-1,i) )         &
-                           - ( 5.0_wp * ibit23 * adv_mom_5                                         &
-                           +            ibit22 * adv_mom_3 ) * ( w(k,j+1,i) - w(k,j-2,i) )         &
-                           + (          ibit23 * adv_mom_5 ) * ( w(k,j+2,i) - w(k,j-3,i) )         &
-                                                )
-
-       ENDDO
-
-       DO  k = nzb_max_l+1, nzt-1
-
-          v_comp(k)      = v(k+1,j,i) + v(k,j,i) - gv
-          flux_s_w(k,tn) = v_comp(k) * (                                                           &
-                             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(k) ) * (                                                  &
-                             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_l
-
-          ibit20 = REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp )
-          ibit19 = REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp )
-          ibit18 = REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )
-
-          u_comp(k)        = u(k+1,j,i) + u(k,j,i) - gu
-          flux_l_w(k,j,tn) = u_comp(k) * (                                                         &
-                             (  37.0_wp * ibit20 * adv_mom_5                                       &
-                             +   7.0_wp * ibit19 * adv_mom_3                                       &
-                             +            ibit18 * adv_mom_1 ) * ( w(k,j,i)   + w(k,j,i-1) )       &
-                             - ( 8.0_wp * ibit20 * adv_mom_5                                       &
-                             +            ibit19 * adv_mom_3 ) * ( w(k,j,i+1) + w(k,j,i-2) )       &
-                             + (          ibit20 * adv_mom_5 ) * ( w(k,j,i+2) + w(k,j,i-3) )       &
-                                         )
-
-          diss_l_w(k,j,tn) = - ABS( u_comp(k) ) * (                                                &
-                             (  10.0_wp * ibit20 * adv_mom_5                                       &
-                             +   3.0_wp * ibit19 * adv_mom_3                                       &
-                             +            ibit18 * adv_mom_1 ) * ( w(k,j,i)   - w(k,j,i-1) )       &
-                             - ( 5.0_wp * ibit20 * adv_mom_5                                       &
-                             +            ibit19 * adv_mom_3 ) * ( w(k,j,i+1) - w(k,j,i-2) )       &
-                             + (          ibit20 * adv_mom_5 ) * ( w(k,j,i+2) - w(k,j,i-3) )       &
-                                                  )
-
-       ENDDO
-
-       DO  k = nzb_max_l+1, nzt-1
-
-          u_comp(k)        = u(k+1,j,i) + u(k,j,i) - gu
-          flux_l_w(k,j,tn) = u_comp(k) * (                                                         &
-                               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(k) ) * (                                                &
-                               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
-!
-!-- Now compute the fluxes and tendency terms for the horizontal and vertical parts.
-    DO  k = nzb+1, nzb_max_l
-
-       ibit20 = REAL( IBITS(advc_flags_m(k,j,i),20,1), KIND = wp )
-       ibit19 = REAL( IBITS(advc_flags_m(k,j,i),19,1), KIND = wp )
-       ibit18 = REAL( IBITS(advc_flags_m(k,j,i),18,1), KIND = wp )
-
-       u_comp(k) = u(k+1,j,i+1) + u(k,j,i+1) - gu
-       flux_r(k) = u_comp(k) * (                                                                   &
-                   (  37.0_wp * ibit20 * adv_mom_5                                                 &
-                   +   7.0_wp * ibit19 * adv_mom_3                                                 &
-                   +            ibit18 * adv_mom_1 ) * ( w(k,j,i+1) + w(k,j,i)   )                 &
-                   - ( 8.0_wp * ibit20 * adv_mom_5                                                 &
-                   +            ibit19 * adv_mom_3 ) * ( w(k,j,i+2) + w(k,j,i-1) )                 &
-                   + (          ibit20 * adv_mom_5 ) * ( w(k,j,i+3) + w(k,j,i-2) )                 &
-                               )
-
-       diss_r(k) = - ABS( u_comp(k) ) * (                                                          &
-                   (  10.0_wp * ibit20 * adv_mom_5                                                 &
-                   +   3.0_wp * ibit19 * adv_mom_3                                                 &
-                   +            ibit18 * adv_mom_1 ) * ( w(k,j,i+1) - w(k,j,i)   )                 &
-                   - ( 5.0_wp * ibit20 * adv_mom_5                                                 &
-                   +            ibit19 * adv_mom_3 ) * ( w(k,j,i+2) - w(k,j,i-1) )                 &
-                   + (          ibit20 * adv_mom_5 ) * ( w(k,j,i+3) - w(k,j,i-2) )                 &
-                                        )
-
-       ibit23 = REAL( IBITS(advc_flags_m(k,j,i),23,1), KIND = wp )
-       ibit22 = REAL( IBITS(advc_flags_m(k,j,i),22,1), KIND = wp )
-       ibit21 = REAL( IBITS(advc_flags_m(k,j,i),21,1), KIND = wp )
-
-       v_comp(k) = v(k+1,j+1,i) + v(k,j+1,i) - gv
-       flux_n(k) = v_comp(k) * (                                                                   &
-                  (  37.0_wp * ibit23 * adv_mom_5                                                  &
-                  +   7.0_wp * ibit22 * adv_mom_3                                                  &
-                  +            ibit21 * adv_mom_1 ) * ( w(k,j+1,i) + w(k,j,i)   )                  &
-                  - ( 8.0_wp * ibit23 * adv_mom_5                                                  &
-                  +            ibit22 * adv_mom_3 ) * ( w(k,j+2,i) + w(k,j-1,i) )                  &
-                  + (          ibit23 * adv_mom_5)  * ( w(k,j+3,i) + w(k,j-2,i) )                  &
-                               )
-
-       diss_n(k) = - ABS( v_comp(k) ) * (                                                          &
-                   (  10.0_wp * ibit23 * adv_mom_5                                                 &
-                   +   3.0_wp * ibit22 * adv_mom_3                                                 &
-                   +            ibit21 * adv_mom_1 ) * ( w(k,j+1,i) - w(k,j,i)   )                 &
-                   - ( 5.0_wp * ibit23 * adv_mom_5                                                 &
-                   +            ibit22 * adv_mom_3 ) * ( w(k,j+2,i)  - w(k,j-1,i) )                &
-                   + (          ibit23 * adv_mom_5 ) * ( w(k,j+3,i)  - w(k,j-2,i) )                &
-                                        )
-    ENDDO
-
-    DO  k = nzb_max_l+1, nzt-1
-
-       u_comp(k) = u(k+1,j,i+1) + u(k,j,i+1) - gu
-       flux_r(k) = u_comp(k) * (                                                                   &
-                     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(k) ) * (                                                          &
-                     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(k) = v(k+1,j+1,i) + v(k,j+1,i) - gv
-       flux_n(k) = v_comp(k) * (                                                                   &
-                     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(k) ) * (                                                          &
-                     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
-    ENDDO
-
-!
-!--    Now, compute vertical fluxes. Split loop into a part treating the lowest grid points with
-!--    indirect indexing, a main loop without indirect indexing, and a loop for the uppermost grid
-!--    points with indirect indexing. This allows better vectorization for the main loop.
-!--    First, compute the flux at model surface, which need has to be calculated explicitly for the
-!--    tendency at the first w-level. For topography wall this is done implicitely by advc_flags_m.
-!--    First, compute flux at lowest level, located at z=dz/2.
-    k         = nzb + 1
-    w_comp(k) = w(k,j,i) + w(k-1,j,i)
-    flux_t(0) =  w_comp(k)       * rho_air(k) * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1
-    diss_t(0) = - ABS(w_comp(k)) * rho_air(k) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1
-
-    DO  k = nzb+1, nzb+1
-!
-!--    k index has to be modified near bottom and top, else array subscripts will be exceeded.
-       ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
-       ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
-       ibit24 = REAL( IBITS(advc_flags_m(k,j,i),24,1), KIND = wp )
-
-       k_ppp = k + 3 * ibit26
-       k_pp  = k + 2 * ( 1 - ibit24  )
-       k_mm  = k - 2 * ibit26
-
-       w_comp(k) = w(k+1,j,i) + w(k,j,i)
-       flux_t(k) = w_comp(k) * rho_air(k+1) * (                                                    &
-                   (  37.0_wp * ibit26 * adv_mom_5                                                 &
-                   +   7.0_wp * ibit25 * adv_mom_3                                                 &
-                   +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i)   + w(k,j,i)    )              &
-                   - ( 8.0_wp * ibit26 * adv_mom_5                                                 &
-                   +            ibit25 * adv_mom_3 ) * ( w(k_pp,j,i)  + w(k-1,j,i)  )              &
-                   + (          ibit26 * adv_mom_5 ) * ( w(k_ppp,j,i) + w(k_mm,j,i) )              &
-                                              )
-
-       diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                                           &
-                   (  10.0_wp * ibit26 * adv_mom_5                                                 &
-                   +   3.0_wp * ibit25 * adv_mom_3                                                 &
-                   +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i)   - w(k,j,i)    )              &
-                   - ( 5.0_wp * ibit26 * adv_mom_5                                                 &
-                   +            ibit25 * adv_mom_3 ) * ( w(k_pp,j,i)  - w(k-1,j,i)  )              &
-                   + (          ibit26 * adv_mom_5 ) * ( w(k_ppp,j,i) - w(k_mm,j,i) )              &
-                                                       )
-    ENDDO
-
-    DO  k = nzb+2, nzt-2
-
-       ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
-       ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
-       ibit24 = REAL( IBITS(advc_flags_m(k,j,i),24,1), KIND = wp )
-
-       w_comp(k) = w(k+1,j,i) + w(k,j,i)
-       flux_t(k) = w_comp(k) * rho_air(k+1) * (                                                    &
-                   (  37.0_wp * ibit26 * adv_mom_5                                                 &
-                   +   7.0_wp * ibit25 * adv_mom_3                                                 &
-                   +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i)  + w(k,j,i)   )                &
-                   - ( 8.0_wp * ibit26 * adv_mom_5                                                 &
-                   +            ibit25 * adv_mom_3 ) * ( w(k+2,j,i)  + w(k-1,j,i) )                &
-                   + (          ibit26 * adv_mom_5 ) * ( w(k+3,j,i)  + w(k-2,j,i) )                &
-                                              )
-
-       diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                                           &
-                   (  10.0_wp * ibit26 * adv_mom_5                                                 &
-                   +   3.0_wp * ibit25 * adv_mom_3                                                 &
-                   +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i) - w(k,j,i)    )                &
-                   - ( 5.0_wp * ibit26 * adv_mom_5                                                 &
-                   +            ibit25 * adv_mom_3 ) * ( w(k+2,j,i) - w(k-1,j,i)  )                &
-                   + (          ibit26 * adv_mom_5 ) * ( w(k+3,j,i) - w(k-2,j,i)  )                &
-                                                       )
-    ENDDO
-
-    DO  k = nzt-1, nzt-1
-!
-!--    k index has to be modified near bottom and top, else array subscripts will be exceeded.
-       ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
-       ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
-       ibit24 = REAL( IBITS(advc_flags_m(k,j,i),24,1), KIND = wp )
-
-       k_ppp = k + 3 * ibit26
-       k_pp  = k + 2 * ( 1 - ibit24  )
-       k_mm  = k - 2 * ibit26
-
-       w_comp(k) = w(k+1,j,i) + w(k,j,i)
-       flux_t(k) = w_comp(k) * rho_air(k+1) * (                                                    &
-                   (  37.0_wp * ibit26 * adv_mom_5                                                 &
-                   +   7.0_wp * ibit25 * adv_mom_3                                                 &
-                   +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i)   + w(k,j,i)    )              &
-                   - ( 8.0_wp * ibit26 * adv_mom_5                                                 &
-                   +            ibit25 * adv_mom_3 ) * ( w(k_pp,j,i)  + w(k-1,j,i)  )              &
-                   + (          ibit26 * adv_mom_5 ) * ( w(k_ppp,j,i) + w(k_mm,j,i) )              &
-                                              )
-
-       diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                                           &
-                   (  10.0_wp * ibit26 * adv_mom_5                                                 &
-                   +   3.0_wp * ibit25 * adv_mom_3                                                 &
-                   +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i)   - w(k,j,i)    )              &
-                   - ( 5.0_wp * ibit26 * adv_mom_5                                                 &
-                   +            ibit25 * adv_mom_3 ) * ( w(k_pp,j,i)  - w(k-1,j,i)  )              &
-                   + (          ibit26 * adv_mom_5 ) * ( w(k_ppp,j,i) - w(k_mm,j,i) )              &
-                                                       )
-    ENDDO
-
-!
-!-- Set resolved/turbulent flux at model top to zero (w-level). Hint: The flux at nzt is defined at
-!-- the scalar grid point nzt+1. Therefore, the flux at nzt+1 is already outside of the model
-!-- domain.
-    flux_t(nzt) = 0.0_wp
-    diss_t(nzt) = 0.0_wp
-    w_comp(nzt) = 0.0_wp
-
-    flux_t(nzt+1) = 0.0_wp
-    diss_t(nzt+1) = 0.0_wp
-    w_comp(nzt+1) = 0.0_wp
-
-    DO  k = nzb+1, nzb_max_l
-
-       flux_d    = flux_t(k-1)
-       diss_d    = diss_t(k-1)
-
-       ibit20 = REAL( IBITS(advc_flags_m(k,j,i),20,1), KIND = wp )
-       ibit19 = REAL( IBITS(advc_flags_m(k,j,i),19,1), KIND = wp )
-       ibit18 = REAL( IBITS(advc_flags_m(k,j,i),18,1), KIND = wp )
-
-       ibit23 = REAL( IBITS(advc_flags_m(k,j,i),23,1), KIND = wp )
-       ibit22 = REAL( IBITS(advc_flags_m(k,j,i),22,1), KIND = wp )
-       ibit21 = REAL( IBITS(advc_flags_m(k,j,i),21,1), KIND = wp )
-
-       ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
-       ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
-       ibit24 = REAL( IBITS(advc_flags_m(k,j,i),24,1), KIND = wp )
-!
-!--    Calculate the divergence of the velocity field. A respective correction is needed to overcome
-!--    numerical instabilities introduced by an insufficient reduction of divergences near
-!--    topography.
-       div = ( ( ( u_comp(k) + gu ) * ( ibit18 + ibit19 + ibit20 )                                 &
-               - ( u(k+1,j,i) + u(k,j,i)   )                                                       &
-                                 * (                                                               &
-                  REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )                             &
-                + REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp )                             &
-                + REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp )                             &
-                                   )                                                               &
-               ) * ddx                                                                             &
-             + ( ( v_comp(k) + gv ) * ( ibit21 + ibit22 + ibit23 )                                 &
-               - ( v(k+1,j,i) + v(k,j,i)   )                                                       &
-                                 * (                                                               &
-                  REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )                             &
-                + REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp )                             &
-                + REAL( IBITS(advc_flags_m(k,j-1,i),23,1), KIND = wp )                             &
-                                   )                                                               &
-               ) * ddy                                                                             &
-             + ( w_comp(k)               * rho_air(k+1)                                            &
-                                         * ( ibit24 + ibit25 + ibit26 )                            &
-             - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k)                                              &
-                                 * (                                                               &
-                  REAL( IBITS(advc_flags_m(k-1,j,i),24,1), KIND = wp )                             &
-                + REAL( IBITS(advc_flags_m(k-1,j,i),25,1), KIND = wp )                             &
-                + REAL( IBITS(advc_flags_m(k-1,j,i),26,1), KIND = wp )                             &
-                                   )                                                               &
-               ) * drho_air_zw(k) * 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    )                                                   &
-                                           ) * drho_air_zw(k) * 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)
-!
-!--    Statistical Evaluation of w'w'.
-       sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn) +                                                &
-                              ( flux_t(k)                                                          &
-                              * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                )               &
-                              / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )        )               &
-                               + diss_t(k)                                                         &
-                              *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)           )               &
-                              / ( ABS( w_comp(k) ) + 1.0E-20_wp                    )               &
-                              ) *   weight_substep(intermediate_timestep_count)
-
-    ENDDO
-
-    DO  k = nzb_max_l+1, nzt-1
-
-       flux_d    = flux_t(k-1)
-       diss_d    = diss_t(k-1)
-!
-!--    Calculate the divergence of the velocity field. A respective correction is needed to overcome
-!--    numerical instabilities introduced by an insufficient reduction of divergences near
-!--    topography.
-       div = ( ( u_comp(k) + gu - ( u(k+1,j,i) + u(k,j,i)   ) ) * ddx                              &
-             + ( v_comp(k) + gv - ( v(k+1,j,i) + v(k,j,i)   ) ) * ddy                              &
-             + ( w_comp(k)               * rho_air(k+1)                                            &
-             - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k)                                              &
-               ) * drho_air_zw(k) * 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    )                                                 &
-                                              ) * drho_air_zw(k) * 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)
-!
-!--    Statistical Evaluation of w'w'.
-       sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn) +                                                &
-                              ( flux_t(k)                                                          &
-                                * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                )             &
-                                / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )        )             &
-                              + diss_t(k)                                                          &
-                                *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)           )             &
-                                / ( ABS( w_comp(k) ) + 1.0E-20_wp                    )             &
-                              ) *   weight_substep(intermediate_timestep_count)
-
-    ENDDO
-
- END SUBROUTINE advec_w_ws_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Scalar advection - Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_s_ws( advc_flag, sk, sk_char,                                                    &
-                        non_cyclic_l, non_cyclic_n,                                                &
-                        non_cyclic_r, non_cyclic_s )
-
-
-    CHARACTER (LEN = *), INTENT(IN) ::  sk_char !< string identifier, used for assign fluxes
-                                                !< to the correct dimension in the analysis array
-
-    INTEGER(iwp) ::  i         !< grid index along x-direction
-    INTEGER(iwp) ::  j         !< grid index along y-direction
-    INTEGER(iwp) ::  k         !< grid index along z-direction
-    INTEGER(iwp) ::  k_mm      !< k-2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
-    INTEGER(iwp) ::  sk_num    !< integer identifier, used for assign fluxes to the correct dimension in the analysis array
-    INTEGER(iwp) ::  tn = 0    !< number of OpenMP thread (is always zero here)
-
-    INTEGER(iwp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::                          &
-                                               advc_flag !< flag array to control order of scalar advection
-
-    LOGICAL  ::  non_cyclic_l    !< flag that indicates non-cyclic boundary on the left
-    LOGICAL  ::  non_cyclic_n    !< flag that indicates non-cyclic boundary on the north
-    LOGICAL  ::  non_cyclic_r    !< flag that indicates non-cyclic boundary on the right
-    LOGICAL  ::  non_cyclic_s    !< flag that indicates non-cyclic boundary on the south
-
-    REAL(wp) ::  diss_d        !< artificial dissipation term at grid box bottom
-    REAL(wp) ::  div           !< velocity diverence on scalar grid
-    REAL(wp) ::  flux_d        !< 6th-order flux at grid box bottom
-    REAL(wp) ::  ibit0         !< flag indicating 1st-order scheme along x-direction
-    REAL(wp) ::  ibit1         !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp) ::  ibit2         !< flag indicating 5th-order scheme along x-direction
-    REAL(wp) ::  ibit3         !< flag indicating 1st-order scheme along y-direction
-    REAL(wp) ::  ibit4         !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp) ::  ibit5         !< flag indicating 5th-order scheme along y-direction
-    REAL(wp) ::  ibit6         !< flag indicating 1st-order scheme along z-direction
-    REAL(wp) ::  ibit7         !< flag indicating 3rd-order scheme along z-direction
-    REAL(wp) ::  ibit8         !< flag indicating 5th-order scheme along z-direction
-#ifdef _OPENACC
-    REAL(wp) ::  ibit0_l  !< flag indicating 1st-order scheme along x-direction
-    REAL(wp) ::  ibit1_l  !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp) ::  ibit2_l  !< flag indicating 5th-order scheme along x-direction
-    REAL(wp) ::  ibit3_s  !< flag indicating 1st-order scheme along y-direction
-    REAL(wp) ::  ibit4_s  !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp) ::  ibit5_s  !< flag indicating 5th-order scheme along y-direction
-#endif
-    REAL(wp) ::  u_comp        !< advection velocity along x-direction
-    REAL(wp) ::  v_comp        !< advection velocity along y-direction
-#ifdef _OPENACC
-    REAL(wp) ::  u_comp_l !< advection velocity along x-direction
-    REAL(wp) ::  v_comp_s !< advection velocity along y-direction
-#endif
-!
-!--    sk is an array from parameter list. It should not be a pointer, because in that case the
-!--    compiler can not assume a stride 1 and cannot perform a strided one vector load. Adding the
-!--    CONTIGUOUS keyword makes things even worse, because the compiler cannot assume strided one in
-!--    the caller side.
-
-
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_n     !< discretized artificial dissipation at northward-side
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_r     !< discretized artificial dissipation at rightward-side
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_t     !< discretized artificial dissipation at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_n     !< discretized 6th-order flux at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_r     !< discretized 6th-order flux at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t     !< discretized 6th-order flux at top of the grid box
-
-    REAL(wp), DIMENSION(nzb+1:nzt)         ::  diss_l            !< discretized artificial dissipation at leftward-side
-    REAL(wp), DIMENSION(nzb+1:nzt)         ::  diss_s            !< discretized artificial dissipation at southward-side
-    REAL(wp), DIMENSION(nzb+1:nzt)         ::  flux_l            !< discretized 6th-order flux at leftward-side
-    REAL(wp), DIMENSION(nzb+1:nzt)         ::  flux_s            !< discretized 6th-order flux at southward-side
-#ifndef _OPENACC
-    REAL(wp), DIMENSION(nzb+1:nzt)         ::  swap_diss_y_local !< discretized artificial dissipation at southward-side
-    REAL(wp), DIMENSION(nzb+1:nzt)         ::  swap_flux_y_local !< discretized 6th-order flux at northward-side
-
-    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local !< discretized artificial dissipation at leftward-side
-    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local !< discretized 6th-order flux at leftward-side
-#endif
-
-    REAL(wp), INTENT(IN),DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<  advected scalar
-
-    CALL cpu_log( log_point_s(49), 'advec_s_ws', 'start' )
-
-    SELECT CASE ( sk_char )
-
-        CASE ( 'pt' )
-           sk_num = 1
-        CASE ( 'sa' )
-           sk_num = 2
-        CASE ( 'q' )
-           sk_num = 3
-        CASE ( 'qc' )
-           sk_num = 4
-        CASE ( 'qr' )
-           sk_num = 5
-        CASE ( 'nc' )
-           sk_num = 6
-        CASE ( 'nr' )
-           sk_num = 7
-        CASE ( 's' )
-           sk_num = 8
-        CASE ( 'aerosol_mass', 'aerosol_number', 'salsa_gas' )
-           sk_num = 9
-        CASE ( 'ni' )
-           sk_num = 10
-        CASE ( 'qi' )
-           sk_num = 11
-        CASE ( 'ng' )
-           sk_num = 12
-        CASE ( 'qg' )
-           sk_num = 13
-        CASE ( 'ns' )
-           sk_num = 14
-        CASE ( 'qs' )
-           sk_num = 15
-        CASE DEFAULT
-           sk_num = 0
-
-    END SELECT
-
-    !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, sk_num) &
-    !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) &
-    !$ACC PRIVATE(ibit0, ibit1, ibit2, ibit3, ibit4, ibit5) &
-    !$ACC PRIVATE(ibit0_l, ibit1_l, ibit2_l) &
-    !$ACC PRIVATE(ibit3_s, ibit4_s, ibit5_s) &
-    !$ACC PRIVATE(ibit6, ibit7, ibit8) &
-    !$ACC PRIVATE(nzb_max_l) &
-    !$ACC PRIVATE(diss_l, diss_r, flux_l, flux_r) &
-    !$ACC PRIVATE(diss_n, diss_s, flux_s, flux_n) &
-    !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) &
-    !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s) &
-    !$ACC PRESENT(advc_flag) &
-    !$ACC PRESENT(sk, u, v, w, u_stokes_zu, v_stokes_zu) &
-    !$ACC PRESENT(drho_air, rho_air_zw, ddzw) &
-    !$ACC PRESENT(tend) &
-    !$ACC PRESENT(hom(:,1,1:3,0)) &
-    !$ACC PRESENT(weight_substep(intermediate_timestep_count)) &
-    !$ACC PRESENT(sums_wspts_ws_l, sums_wssas_ws_l) &
-    !$ACC PRESENT(sums_wsqs_ws_l, sums_wsqcs_ws_l) &
-    !$ACC PRESENT(sums_wsqrs_ws_l, sums_wsncs_ws_l) &
-    !$ACC PRESENT(sums_wsnrs_ws_l, sums_wsss_ws_l) &
-    !$ACC PRESENT(sums_wsnis_ws_l, sums_wsqis_ws_l) &
-    !$ACC PRESENT(sums_wsngs_ws_l, sums_wsqgs_ws_l) &
-    !$ACC PRESENT(sums_wsnss_ws_l, sums_wsqss_ws_l) &
-    !$ACC PRESENT(sums_salsa_ws_l)
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-!
-!--       Used local modified copy of nzb_max (used to degrade order of discretization) at
-!--       non-cyclic boundaries. Modify only at relevant points instead of the entire subdomain.
-!--       This should lead to better load balance between boundary and non-boundary PEs.
-          IF( non_cyclic_l  .AND.  i <= nxl + 2  .OR.                                              &
-              non_cyclic_r  .AND.  i >= nxr - 2  .OR.                                              &
-              non_cyclic_s  .AND.  j <= nys + 2  .OR.                                              &
-              non_cyclic_n  .AND.  j >= nyn - 2 )  THEN
-             nzb_max_l = nzt
-          ELSE
-             nzb_max_l = nzb_max
-          END IF
-#ifndef _OPENACC
-!
-!--       Compute leftside fluxes of the respective PE bounds.
-          IF ( i == nxl )  THEN
-
-             DO  k = nzb+1, nzb_max_l
-
-                ibit2 = REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp )
-                ibit1 = REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp )
-                ibit0 = REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )
-
-                u_comp                    = u(k,j,i) - u_gtrans + u_stokes_zu(k)
-                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_l+1, nzt
-
-                u_comp                    = u(k,j,i) - u_gtrans + u_stokes_zu(k)
-                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
-
-          ENDIF
-!
-!--       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_l
-
-                ibit5 = REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp )
-                ibit4 = REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp )
-                ibit3 = REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )
-
-                v_comp                  = v(k,j,i) - v_gtrans + v_stokes_zu(k)
-                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_l+1, nzt
-
-                v_comp                  = v(k,j,i) - v_gtrans + v_stokes_zu(k)
-                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
-
-          ENDIF
-#endif
-!
-!--       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_l
-!
-!--          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 = REAL( IBITS(advc_flag(k,j,i),2,1), KIND = wp )
-             ibit1 = REAL( IBITS(advc_flag(k,j,i),1,1), KIND = wp )
-             ibit0 = REAL( IBITS(advc_flag(k,j,i),0,1), KIND = wp )
-
-             u_comp    = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
-             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) )        &
-                                           )
-#ifdef _OPENACC
-!
-!--          Recompute the left fluxes.
-             ibit2_l = REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp )
-             ibit1_l = REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp )
-             ibit0_l = REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )
-
-             u_comp_l                  = u(k,j,i) - u_gtrans + u_stokes_zu(k)
-             flux_l(k)                 = u_comp_l * (                                              &
-                                           ( 37.0_wp * ibit2_l * adv_sca_5                         &
-                                         +    7.0_wp * ibit1_l * adv_sca_3                         &
-                                         +             ibit0_l * adv_sca_1                         &
-                                           ) *                                                     &
-                                           ( sk(k,j,i)   + sk(k,j,i-1)    )                        &
-                                         - (  8.0_wp * ibit2_l * adv_sca_5                         &
-                                         +              ibit1_l * adv_sca_3                        &
-                                           ) *                                                     &
-                                           ( sk(k,j,i+1) + sk(k,j,i-2)    )                        &
-                                         + (           ibit2_l * adv_sca_5                         &
-                                           ) *                                                     &
-                                           ( sk(k,j,i+2) + sk(k,j,i-3)    )                        &
-                                                    )
-
-             diss_l(k)                 = - ABS( u_comp_l ) * (                                     &
-                                           ( 10.0_wp * ibit2_l * adv_sca_5                         &
-                                         +    3.0_wp * ibit1_l * adv_sca_3                         &
-                                         +             ibit0_l * adv_sca_1                         &
-                                           ) *                                                     &
-                                           ( sk(k,j,i)   - sk(k,j,i-1) )                           &
-                                         - (  5.0_wp * ibit2_l * adv_sca_5                         &
-                                         +              ibit1_l * adv_sca_3                        &
-                                           ) *                                                     &
-                                           ( sk(k,j,i+1) - sk(k,j,i-2) )                           &
-                                         + (           ibit2_l * adv_sca_5                         &
-                                           ) *                                                     &
-                                           ( sk(k,j,i+2) - sk(k,j,i-3) )                           &
-                                                             )
-#else
-             flux_l(k) = swap_flux_x_local(k,j)
-             diss_l(k) = swap_diss_x_local(k,j)
-#endif
-             ibit5 = REAL( IBITS(advc_flag(k,j,i),5,1), KIND = wp )
-             ibit4 = REAL( IBITS(advc_flag(k,j,i),4,1), KIND = wp )
-             ibit3 = REAL( IBITS(advc_flag(k,j,i),3,1), KIND = wp )
-
-             v_comp    = v(k,j+1,i) - v_gtrans + v_stokes_zu(k)
-             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) )          &
-                                           )
-#ifdef _OPENACC
-!
-!--          Recompute the south fluxes.
-             ibit5_s = REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp )
-             ibit4_s = REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp )
-             ibit3_s = REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )
-
-             v_comp_s                = v(k,j,i) - v_gtrans + v_stokes_zu(k)
-             flux_s(k)               = v_comp_s * (                                                &
-                                         ( 37.0_wp * ibit5_s * adv_sca_5                           &
-                                       +    7.0_wp * ibit4_s * adv_sca_3                           &
-                                       +             ibit3_s * adv_sca_1                           &
-                                         ) *                                                       &
-                                       ( sk(k,j,i)   + sk(k,j-1,i)     )                           &
-                                       - (  8.0_wp * ibit5_s * adv_sca_5                           &
-                                       +             ibit4_s * adv_sca_3                           &
-                                         ) *                                                       &
-                                       ( sk(k,j+1,i) + sk(k,j-2,i)    )                            &
-                                       + (           ibit5_s * adv_sca_5                           &
-                                         ) *                                                       &
-                                       ( sk(k,j+2,i) + sk(k,j-3,i)    )                            &
-                                                  )
-
-             diss_s(k)               = - ABS( v_comp_s ) * (                                       &
-                                         ( 10.0_wp * ibit5_s * adv_sca_5                           &
-                                       +    3.0_wp * ibit4_s * adv_sca_3                           &
-                                       +             ibit3_s * adv_sca_1                           &
-                                         ) *                                                       &
-                                       ( sk(k,j,i)   - sk(k,j-1,i)    )                            &
-                                       - (  5.0_wp * ibit5_s * adv_sca_5                           &
-                                       +             ibit4_s * adv_sca_3                           &
-                                         ) *                                                       &
-                                       ( sk(k,j+1,i) - sk(k,j-2,i)    )                            &
-                                       + (           ibit5_s * adv_sca_5                           &
-                                          ) *                                                      &
-                                       ( sk(k,j+2,i) - sk(k,j-3,i)    )                            &
-                                                          )
-#else
-             flux_s(k) = swap_flux_y_local(k)
-             diss_s(k) = swap_diss_y_local(k)
-#endif
-          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 still needed.
-          DO  k = nzb_max_l+1, nzt
-
-             u_comp    = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
-             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
-#ifdef _OPENACC
-!
-!--          Recompute the left fluxes.
-             u_comp_l  = u(k,j,i) - u_gtrans + u_stokes_zu(k)
-             flux_l(k) = u_comp_l * (                                                              &
-                           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
-
-             diss_l(k) = - ABS( u_comp_l ) * (                                                     &
-                            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
-#else
-             flux_l(k) = swap_flux_x_local(k,j)
-             diss_l(k) = swap_diss_x_local(k,j)
-
-#endif
-
-             v_comp    = v(k,j+1,i) - v_gtrans + v_stokes_zu(k)
-             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
-#ifdef _OPENACC
-!
-!--          Recompute the south fluxes.
-             v_comp_s  = v(k,j,i) - v_gtrans + v_stokes_zu(k)
-             flux_s(k) = v_comp_s  * (                                                             &
-                           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
-             diss_s(k) = - ABS( v_comp_s ) * (                                                     &
-                           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
-#else
-             flux_s(k) = swap_flux_y_local(k)
-             diss_s(k) = swap_diss_y_local(k)
-#endif
-          ENDDO
-!
-!--       Now, compute vertical fluxes. Split loop into a part treating the lowest grid points with
-!--       indirect indexing, a main loop without indirect indexing, and a loop for the uppermost
-!--       grid points with indirect indexing. This allows better vectorization for the main loop.
-!--       First, compute the flux at model surface, which need has to be calculated explicetely for
-!--       the tendency at the first w-level. For topography wall this is done implicitely by
-!--       advc_flag.
-          flux_t(nzb) = 0.0_wp
-          diss_t(nzb) = 0.0_wp
-
-          DO  k = nzb+1, nzb+1
-             ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
-             ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
-             ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
-!
-!--          k index has to be modified near bottom and top, else array subscripts will be exceeded.
-             k_ppp = k + 3 * ibit8
-             k_pp  = k + 2 * ( 1 - ibit6  )
-             k_mm  = k - 2 * ibit8
-
-
-             flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                                              &
-                         (  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) ) * rho_air_zw(k) * (                                     &
-                         (  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) )       &
-                                                             )
-          ENDDO
-
-          DO  k = nzb+2, nzt-2
-             ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
-             ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
-             ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
-
-             flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                                              &
-                         (  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+2,j,i) + sk(k-1,j,i) )          &
-                         + (          ibit8 * adv_sca_5 ) * ( sk(k+3,j,i) + sk(k-2,j,i) )          &
-                                                    )
-
-             diss_t(k) = - ABS( w(k,j,i) ) * rho_air_zw(k) * (                                     &
-                         (  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+2,j,i)  - sk(k-1,j,i)  )        &
-                         + (          ibit8 * adv_sca_5 ) * ( sk(k+3,j,i) - sk(k-2,j,i) )          &
-                                                             )
-          ENDDO
-
-          DO  k = nzt-1, nzt-symmetry_flag
-             ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
-             ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
-             ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
-!
-!--          k index has to be modified near bottom and top, else array subscripts will be exceeded.
-             k_ppp = k + 3 * ibit8
-             k_pp  = k + 2 * ( 1 - ibit6  )
-             k_mm  = k - 2 * ibit8
-
-             flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                                              &
-                         (  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) ) * rho_air_zw(k) * (                                     &
-                         (  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) )       &
-                                                             )
-          ENDDO
-
-!
-!--       Set resolved/turbulent flux at model top to zero (w-level). In case that a symmetric
-!--       behavior between bottom and top shall be guaranteed (closed channel flow), the flux at nzt
-!--       is also set to zero.
-          IF ( symmetry_flag == 1 ) THEN
-             flux_t(nzt) = 0.0_wp
-             diss_t(nzt) = 0.0_wp
-          ENDIF
-          flux_t(nzt+1) = 0.0_wp
-          diss_t(nzt+1) = 0.0_wp
-
-          DO  k = nzb+1, nzb_max_l
-
-             flux_d = flux_t(k-1)
-             diss_d = diss_t(k-1)
-
-             ibit2 = REAL( IBITS(advc_flag(k,j,i),2,1), KIND = wp )
-             ibit1 = REAL( IBITS(advc_flag(k,j,i),1,1), KIND = wp )
-             ibit0 = REAL( IBITS(advc_flag(k,j,i),0,1), KIND = wp )
-
-             ibit5 = REAL( IBITS(advc_flag(k,j,i),5,1), KIND = wp )
-             ibit4 = REAL( IBITS(advc_flag(k,j,i),4,1), KIND = wp )
-             ibit3 = REAL( IBITS(advc_flag(k,j,i),3,1), KIND = wp )
-
-             ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
-             ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
-             ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
-!
-!--          Calculate the divergence of the velocity field. A respective correction is needed to
-!--          overcome numerical instabilities introduced by an insufficient reduction of divergences
-!--          near topography.
-             div         =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )                              &
-                             - u(k,j,i)   * (                                                      &
-                             REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )                      &
-                           + REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp )                      &
-                           + REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp )                      &
-                                            )                                                      &
-                             ) * ddx                                                               &
-                           + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )                              &
-                             - v(k,j,i)   * (                                                      &
-                             REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )                      &
-                           + REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp )                      &
-                           + REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp )                      &
-                                            )                                                      &
-                             ) * ddy                                                               &
-                           + ( w(k,j,i)   * rho_air_zw(k)   *                                      &
-                                            ( ibit6 + ibit7 + ibit8 )                              &
-                             - w(k-1,j,i) * rho_air_zw(k-1) *                                      &
-                                            (                                                      &
-                             REAL( IBITS(advc_flag(k-1,j,i),6,1), KIND = wp )                      &
-                           + REAL( IBITS(advc_flag(k-1,j,i),7,1), KIND = wp )                      &
-                           + REAL( IBITS(advc_flag(k-1,j,i),8,1), KIND = wp )                      &
-                                            )                                                      &
-                             ) * drho_air(k) * ddzw(k)
-
-             tend(k,j,i) = tend(k,j,i) - (                                                         &
-                             ( flux_r(k) + diss_r(k) -                                             &
-                               flux_l(k) - diss_l(k) ) * ddx                                       &
-                           + ( flux_n(k) + diss_n(k) -                                             &
-                               flux_s(k) - diss_s(k) ) * ddy                                       &
-                           + ( flux_t(k) + diss_t(k) -                                             &
-                               flux_d    - diss_d    ) * drho_air(k) * ddzw(k)                     &
-                                         ) + sk(k,j,i) * div
-
-#ifndef _OPENACC
-             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)
-#endif
-
-          ENDDO
-
-          DO  k = nzb_max_l+1, nzt
-
-             flux_d = flux_t(k-1)
-             diss_d = diss_t(k-1)
-!
-!--          Calculate the divergence of the velocity field. A respective correction is needed to
-!--          overcome numerical instabilities introduced by an insufficient 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)   * rho_air_zw(k)                                          &
-                             - w(k-1,j,i) * rho_air_zw(k-1)                                        &
-                                                     ) * drho_air(k) * ddzw(k)
-
-             tend(k,j,i) = tend(k,j,i) - (                                                         &
-                             ( flux_r(k) + diss_r(k) -                                             &
-                               flux_l(k) - diss_l(k) ) * ddx                                       &
-                           + ( flux_n(k) + diss_n(k) -                                             &
-                               flux_s(k) - diss_s(k) ) * ddy                                       &
-                           + ( flux_t(k) + diss_t(k) -                                             &
-                               flux_d    - diss_d    ) * drho_air(k) * ddzw(k)                     &
-                                         ) + sk(k,j,i) * div
-
-#ifndef _OPENACC
-             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)
-#endif
-          ENDDO
-
-!
-!--       Evaluation of statistics.
-          DO  k = nzb+1, nzt
-             SELECT CASE ( sk_num )
-
-                CASE ( 1 )
-                   !$ACC ATOMIC
-                   sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn) +                                 &
-                                           ( flux_t(k)                                             &
-                                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )       &
-                                               * ( w(k,j,i) - hom(k,1,3,0)                 )       &
-                                           + diss_t(k)                                             &
-                                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )       &
-                                               *   ABS(w(k,j,i)  - hom(k,1,3,0)            )       &
-                                           ) * weight_substep(intermediate_timestep_count)
-                CASE ( 2 )
-                   !$ACC ATOMIC
-                   sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn) +                                 &
-                                           ( flux_t(k)                                             &
-                                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )       &
-                                               * ( w(k,j,i) - hom(k,1,3,0)                 )       &
-                                           + diss_t(k)                                             &
-                                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )       &
-                                               *   ABS(w(k,j,i)  - hom(k,1,3,0)            )       &
-                                           ) * weight_substep(intermediate_timestep_count)
-                CASE ( 3 )
-                   !$ACC ATOMIC
-                   sums_wsqs_ws_l(k,tn)  = sums_wsqs_ws_l(k,tn) +                                  &
-                                           ( flux_t(k)                                             &
-                                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )       &
-                                               * ( w(k,j,i) - hom(k,1,3,0)                 )       &
-                                           + diss_t(k)                                             &
-                                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )       &
-                                               *   ABS(w(k,j,i)  - hom(k,1,3,0)            )       &
-                                           ) * weight_substep(intermediate_timestep_count)
-                CASE ( 4 )
-                   !$ACC ATOMIC
-                   sums_wsqcs_ws_l(k,tn)  = sums_wsqcs_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i)  - hom(k,1,3,0)            )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-                CASE ( 5 )
-                   !$ACC ATOMIC
-                   sums_wsqrs_ws_l(k,tn)  = sums_wsqrs_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i)  - hom(k,1,3,0)            )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-                CASE ( 6 )
-                   !$ACC ATOMIC
-                   sums_wsncs_ws_l(k,tn)  = sums_wsncs_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i)  - hom(k,1,3,0)            )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-                CASE ( 7 )
-                   !$ACC ATOMIC
-                   sums_wsnrs_ws_l(k,tn)  = sums_wsnrs_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i)  - hom(k,1,3,0)            )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-                CASE ( 8 )
-                   !$ACC ATOMIC
-                   sums_wsss_ws_l(k,tn)  = sums_wsss_ws_l(k,tn) +                                  &
-                                           ( flux_t(k)                                             &
-                                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )       &
-                                               * ( w(k,j,i) - hom(k,1,3,0)                 )       &
-                                           + diss_t(k)                                             &
-                                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )       &
-                                               *   ABS(w(k,j,i) - hom(k,1,3,0)             )       &
-                                           ) * weight_substep(intermediate_timestep_count)
-                CASE ( 9 )
-                   !$ACC ATOMIC
-                   sums_salsa_ws_l(k,tn)  = sums_salsa_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i)  - hom(k,1,3,0)            )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-                CASE ( 10 )
-                   !$ACC ATOMIC
-                   sums_wsnis_ws_l(k,tn)  = sums_wsnis_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-                CASE ( 11 )
-                   !$ACC ATOMIC
-                   sums_wsqis_ws_l(k,tn)  = sums_wsqis_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-                CASE ( 12 )
-                   !$ACC ATOMIC
-                   sums_wsngs_ws_l(k,tn)  = sums_wsngs_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-                CASE ( 13 )
-                   !$ACC ATOMIC
-                   sums_wsqgs_ws_l(k,tn)  = sums_wsqgs_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-
-                CASE ( 14 )
-                   !$ACC ATOMIC
-                   sums_wsnss_ws_l(k,tn)  = sums_wsnss_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-                CASE ( 15 )
-                   !$ACC ATOMIC
-                   sums_wsqss_ws_l(k,tn)  = sums_wsqss_ws_l(k,tn) +                                &
-                                            ( flux_t(k)                                            &
-                                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )      &
-                                                * ( w(k,j,i) - hom(k,1,3,0)                 )      &
-                                            + diss_t(k)                                            &
-                                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )      &
-                                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )      &
-                                            ) * weight_substep(intermediate_timestep_count)
-
-
-             END SELECT
-
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL cpu_log( log_point_s(49), 'advec_s_ws', 'stop' )
-
- END SUBROUTINE advec_s_ws
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of u - Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_u_ws
-
-
-    INTEGER(iwp) ::  i         !< grid index along x-direction
-    INTEGER(iwp) ::  j         !< grid index along y-direction
-    INTEGER(iwp) ::  k         !< grid index along z-direction
-    INTEGER(iwp) ::  k_mm      !< k-2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
-    INTEGER(iwp) ::  tn = 0    !< number of OpenMP thread (is always zero here)
-
-    REAL(wp)    ::  ibit0 !< flag indicating 1st-order scheme along x-direction
-    REAL(wp)    ::  ibit1 !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp)    ::  ibit2 !< flag indicating 5th-order scheme along x-direction
-#ifdef _OPENACC
-    REAL(wp)    ::  ibit0_l !< flag indicating 1st-order scheme along x-direction
-    REAL(wp)    ::  ibit1_l !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp)    ::  ibit2_l !< flag indicating 5th-order scheme along x-direction
-#endif
-    REAL(wp)    ::  ibit3 !< flag indicating 1st-order scheme along y-direction
-    REAL(wp)    ::  ibit4 !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp)    ::  ibit5 !< flag indicating 5th-order scheme along y-direction
-#ifdef _OPENACC
-    REAL(wp)    ::  ibit3_s !< flag indicating 1st-order scheme along y-direction
-    REAL(wp)    ::  ibit4_s !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp)    ::  ibit5_s !< flag indicating 5th-order scheme along y-direction
-#endif
-    REAL(wp)    ::  diss_d !< artificial dissipation term at grid box bottom
-    REAL(wp)    ::  div    !< diverence on u-grid
-    REAL(wp)    ::  flux_d !< 6th-order flux at grid box bottom
-    REAL(wp)    ::  gu     !< Galilei-transformation velocity along x
-    REAL(wp)    ::  gv     !< Galilei-transformation velocity along y
-    REAL(wp)    ::  ibit6  !< flag indicating 1st-order scheme along z-direction
-    REAL(wp)    ::  ibit7  !< flag indicating 3rd-order scheme along z-direction
-    REAL(wp)    ::  ibit8  !< flag indicating 5th-order scheme along z-direction
-    REAL(wp)    ::  u_comp_l !<
-    REAL(wp)    ::  v_comp_s !< advection velocity along y
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_t !< discretized artificial dissipation at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_t !< discretized 6th-order flux at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  u_comp !< advection velocity along x
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  v_comp !< advection velocity along y
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  w_comp !< advection velocity along z
-
-    CALL cpu_log( log_point_s(68), 'advec_u_ws', 'start' )
-
-    gu = 2.0_wp * u_gtrans
-    gv = 2.0_wp * v_gtrans
-
-    !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) &
-    !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) &
-    !$ACC PRIVATE(ibit0, ibit1, ibit2, ibit3, ibit4, ibit5) &
-    !$ACC PRIVATE(ibit0_l, ibit1_l, ibit2_l) &
-    !$ACC PRIVATE(ibit3_s, ibit4_s, ibit5_s) &
-    !$ACC PRIVATE(nzb_max_l) &
-    !$ACC PRIVATE(ibit6, ibit7, ibit8) &
-    !$ACC PRIVATE(flux_r, diss_r) &
-    !$ACC PRIVATE(flux_n, diss_n) &
-    !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) &
-    !$ACC PRIVATE(flux_l_u, diss_l_u, flux_s_u, diss_s_u) &
-    !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) &
-    !$ACC PRESENT(advc_flags_m) &
-    !$ACC PRESENT(u, v, w) &
-    !$ACC PRESENT(drho_air, rho_air_zw, ddzw) &
-    !$ACC PRESENT(tend) &
-    !$ACC PRESENT(hom(:,1,1:3,0)) &
-    !$ACC PRESENT(weight_substep(intermediate_timestep_count)) &
-    !$ACC PRESENT(sums_us2_ws_l, sums_wsus_ws_l)
-    DO  i = nxlu, nxr
-
-       DO  j = nys, nyn
-!
-!--       Used local modified copy of nzb_max (used to degrade order of discretization) at
-!--       non-cyclic boundaries. Modify only at relevant points instead of the entire subdomain.
-!--       This should lead to better load balance between boundary and non-boundary PEs.
-          IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR.                  &
-              ( bc_dirichlet_r  .OR.  bc_radiation_r )  .AND.  i >= nxr - 2  .OR.                  &
-              ( bc_dirichlet_s  .OR.  bc_radiation_s )  .AND.  j <= nys + 2  .OR.                  &
-              ( bc_dirichlet_n  .OR.  bc_radiation_n )  .AND.  j >= nyn - 2 )  THEN
-             nzb_max_l = nzt
-          ELSE
-             nzb_max_l = nzb_max
-          END IF
-#ifndef _OPENACC
-!
-!--       Compute southside fluxes for the respective boundary of PE
-          IF ( j == nys  )  THEN
-
-             DO  k = nzb+1, nzb_max_l
-
-                ibit5 = REAL( IBITS(advc_flags_m(k,j-1,i),5,1), KIND = wp )
-                ibit4 = REAL( IBITS(advc_flags_m(k,j-1,i),4,1), KIND = wp )
-                ibit3 = REAL( IBITS(advc_flags_m(k,j-1,i),3,1), KIND = wp )
-
-                v_comp_s       = v(k,j,i) + v(k,j,i-1) - gv
-                flux_s_u(k,tn) = v_comp_s * (                                                      &
-                               (  37.0_wp * ibit5 * adv_mom_5                                      &
-                               +   7.0_wp * ibit4 * adv_mom_3                                      &
-                               +            ibit3 * adv_mom_1 ) * ( u(k,j,i)   + u(k,j-1,i) )      &
-                               - ( 8.0_wp * ibit5 * adv_mom_5                                      &
-                               +            ibit4 * adv_mom_3 ) * ( u(k,j+1,i) + u(k,j-2,i) )      &
-                               + (          ibit5 * adv_mom_5 ) * ( u(k,j+2,i) + u(k,j-3,i) )      &
-                                            )
-
-                diss_s_u(k,tn) = - ABS ( v_comp_s ) * (                                            &
-                               (  10.0_wp * ibit5 * adv_mom_5                                      &
-                               +   3.0_wp * ibit4 * adv_mom_3                                      &
-                               +            ibit3 * adv_mom_1 ) * ( u(k,j,i)   - u(k,j-1,i) )      &
-                               - ( 5.0_wp * ibit5 * adv_mom_5                                      &
-                               +            ibit4 * adv_mom_3 ) * ( u(k,j+1,i) - u(k,j-2,i) )      &
-                               + (          ibit5 * adv_mom_5 ) * ( u(k,j+2,i) - u(k,j-3,i) )      &
-                                                      )
-
-             ENDDO
-
-             DO  k = nzb_max_l+1, nzt
-
-                v_comp_s       = v(k,j,i) + v(k,j,i-1) - gv
-                flux_s_u(k,tn) = v_comp_s * (                                                      &
-                                 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_s ) * (                                             &
-                                 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 == nxlu )  THEN
-
-             DO  k = nzb+1, nzb_max_l
-
-                ibit2 = REAL( IBITS(advc_flags_m(k,j,i-1),2,1), KIND = wp )
-                ibit1 = REAL( IBITS(advc_flags_m(k,j,i-1),1,1), KIND = wp )
-                ibit0 = REAL( IBITS(advc_flags_m(k,j,i-1),0,1), KIND = wp )
-
-                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 * ibit2 * adv_mom_5                                    &
-                                 +   7.0_wp * ibit1 * adv_mom_3                                    &
-                                 +            ibit0 * adv_mom_1 ) * ( u(k,j,i)   + u(k,j,i-1) )    &
-                                 - ( 8.0_wp * ibit2 * adv_mom_5                                    &
-                                 +            ibit1 * adv_mom_3 ) * ( u(k,j,i+1) + u(k,j,i-2) )    &
-                                 + (          ibit2 * 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 * ibit2 * adv_mom_5                                    &
-                                 +   3.0_wp * ibit1 * adv_mom_3                                    &
-                                 +           ibit0  * adv_mom_1 ) * ( u(k,j,i)   - u(k,j,i-1) )    &
-                                 - ( 5.0_wp * ibit2 * adv_mom_5                                    &
-                                 +            ibit1 * adv_mom_3 ) * ( u(k,j,i+1) - u(k,j,i-2) )    &
-                                 + (          ibit2 * adv_mom_5 ) * ( u(k,j,i+2) - u(k,j,i-3) )    &
-                                                       )
-
-             ENDDO
-
-             DO  k = nzb_max_l+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
-#endif
-
-!
-!--       Now compute the fluxes for the horizontal and parts.
-          DO  k = nzb+1, nzb_max_l
-
-             ibit2 = REAL( IBITS(advc_flags_m(k,j,i),2,1), KIND = wp )
-             ibit1 = REAL( IBITS(advc_flags_m(k,j,i),1,1), KIND = wp )
-             ibit0 = REAL( IBITS(advc_flags_m(k,j,i),0,1), KIND = wp )
-
-             u_comp(k) = u(k,j,i+1) + u(k,j,i)
-             flux_r(k) = ( u_comp(k) - gu ) * (                                                    &
-                         (  37.0_wp * ibit2 * adv_mom_5                                            &
-                         +   7.0_wp * ibit1 * adv_mom_3                                            &
-                         +            ibit0 * adv_mom_1 ) * ( u(k,j,i+1) + u(k,j,i)   )            &
-                         - ( 8.0_wp * ibit2 * adv_mom_5                                            &
-                         +            ibit1 * adv_mom_3 ) * ( u(k,j,i+2) + u(k,j,i-1) )            &
-                         + (          ibit2 * adv_mom_5 ) * ( u(k,j,i+3) + u(k,j,i-2) )            &
-                                              )
-
-             diss_r(k) = - ABS( u_comp(k) - gu ) * (                                               &
-                         (  10.0_wp * ibit2 * adv_mom_5                                            &
-                         +   3.0_wp * ibit1 * adv_mom_3                                            &
-                         +            ibit0 * adv_mom_1 ) * ( u(k,j,i+1) - u(k,j,i)   )            &
-                         - ( 5.0_wp * ibit2 * adv_mom_5                                            &
-                         +            ibit1 * adv_mom_3 ) * ( u(k,j,i+2) - u(k,j,i-1) )            &
-                         + (          ibit2 * adv_mom_5 ) * ( u(k,j,i+3) - u(k,j,i-2) )            &
-                                                   )
-
-#ifdef _OPENACC
-!
-!--          Recompute the left fluxes.
-             ibit2_l = REAL( IBITS(advc_flags_m(k,j,i-1),2,1), KIND = wp )
-             ibit1_l = REAL( IBITS(advc_flags_m(k,j,i-1),1,1), KIND = wp )
-             ibit0_l = REAL( IBITS(advc_flags_m(k,j,i-1),0,1), KIND = wp )
-
-             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 * ibit2_l * adv_mom_5                                  &
-                                 +   7.0_wp * ibit1_l * adv_mom_3                                  &
-                                 +            ibit0_l * adv_mom_1 ) * ( u(k,j,i)   + u(k,j,i-1) )  &
-                                 - ( 8.0_wp * ibit2_l * adv_mom_5                                  &
-                                 +            ibit1_l * adv_mom_3 ) * ( u(k,j,i+1) + u(k,j,i-2) )  &
-                                 + (          ibit2_l * 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 * ibit2_l * adv_mom_5                                  &
-                                 +   3.0_wp * ibit1_l * adv_mom_3                                  &
-                                 +           ibit0_l  * adv_mom_1 ) * ( u(k,j,i)   - u(k,j,i-1) )  &
-                                 - ( 5.0_wp * ibit2_l * adv_mom_5                                  &
-                                 +            ibit1_l * adv_mom_3 ) * ( u(k,j,i+1) - u(k,j,i-2) )  &
-                                 + (          ibit2_l * adv_mom_5 ) * ( u(k,j,i+2) - u(k,j,i-3) )  &
-                                                     )
-#endif
-
-
-             ibit5 = REAL( IBITS(advc_flags_m(k,j,i),5,1), KIND = wp )
-             ibit4 = REAL( IBITS(advc_flags_m(k,j,i),4,1), KIND = wp )
-             ibit3 = REAL( IBITS(advc_flags_m(k,j,i),3,1), KIND = wp )
-
-             v_comp(k) = v(k,j+1,i) + v(k,j+1,i-1) - gv
-             flux_n(k) = v_comp(k) * (                                                             &
-                         (  37.0_wp * ibit5 * adv_mom_5                                            &
-                         +   7.0_wp * ibit4 * adv_mom_3                                            &
-                         +            ibit3 * adv_mom_1 ) * ( u(k,j+1,i) + u(k,j,i)   )            &
-                         - ( 8.0_wp * ibit5 * adv_mom_5                                            &
-                         +            ibit4 * adv_mom_3 ) * ( u(k,j+2,i) + u(k,j-1,i) )            &
-                         + (          ibit5 * adv_mom_5 ) * ( u(k,j+3,i) + u(k,j-2,i) )            &
-                                     )
-
-             diss_n(k) = - ABS ( v_comp(k) ) * (                                                   &
-                         (  10.0_wp * ibit5 * adv_mom_5                                            &
-                         +   3.0_wp * ibit4 * adv_mom_3                                            &
-                         +            ibit3 * adv_mom_1 ) * ( u(k,j+1,i) - u(k,j,i)   )            &
-                         - ( 5.0_wp * ibit5 * adv_mom_5                                            &
-                         +            ibit4 * adv_mom_3 ) * ( u(k,j+2,i) - u(k,j-1,i) )            &
-                         + (          ibit5 * adv_mom_5 ) * ( u(k,j+3,i) - u(k,j-2,i) )            &
-                                               )
-
-#ifdef _OPENACC
-!
-!--          Recompute the south fluxes.
-             ibit5_s = REAL( IBITS(advc_flags_m(k,j-1,i),5,1), KIND = wp )
-             ibit4_s = REAL( IBITS(advc_flags_m(k,j-1,i),4,1), KIND = wp )
-             ibit3_s = REAL( IBITS(advc_flags_m(k,j-1,i),3,1), KIND = wp )
-
-             v_comp_s         = v(k,j,i) + v(k,j,i-1) - gv
-             flux_s_u(k,tn)   = v_comp_s * (                                                       &
-                                (  37.0_wp * ibit5_s * adv_mom_5                                   &
-                                +   7.0_wp * ibit4_s * adv_mom_3                                   &
-                                +            ibit3_s * adv_mom_1 ) * ( u(k,j,i)   + u(k,j-1,i) )   &
-                                - ( 8.0_wp * ibit5_s * adv_mom_5                                   &
-                                +            ibit4_s * adv_mom_3 ) * ( u(k,j+1,i) + u(k,j-2,i) )   &
-                                + (          ibit5_s * adv_mom_5 ) * ( u(k,j+2,i) + u(k,j-3,i) )   &
-                                           )
-
-             diss_s_u(k,tn)   = - ABS ( v_comp_s ) * (                                             &
-                                (  10.0_wp * ibit5_s * adv_mom_5                                   &
-                                +   3.0_wp * ibit4_s * adv_mom_3                                   &
-                                +            ibit3_s * adv_mom_1 ) * ( u(k,j,i)   - u(k,j-1,i) )   &
-                                - ( 5.0_wp * ibit5_s * adv_mom_5                                   &
-                                +            ibit4_s * adv_mom_3 ) * ( u(k,j+1,i) - u(k,j-2,i) )   &
-                                + (          ibit5_s * adv_mom_5 ) * ( u(k,j+2,i) - u(k,j-3,i) )   &
-                                                     )
-#endif
-          ENDDO
-
-          DO  k = nzb_max_l+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
-#ifdef _OPENACC
-!
-!--          Recompute the left fluxes.
-             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
-
-#endif
-             v_comp(k) = v(k,j+1,i) + v(k,j+1,i-1) - gv
-             flux_n(k) = v_comp(k) * (                                                             &
-                            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(k) ) * (                                                    &
-                            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
-#ifdef _OPENACC
-!
-!--          Recompute the south fluxes.
-             v_comp_s         = v(k,j,i) + v(k,j,i-1) - gv
-             flux_s_u(k,tn)   = v_comp_s * (                                                       &
-                                  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_s ) * (                                              &
-                                   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
-#endif
-          ENDDO
-!
-!--       Now, compute vertical fluxes. Split loop into a part treating the lowest 2 grid points
-!--       with indirect indexing, a main loop without indirect indexing, and a loop for the
-!--       uppermost 2 grid points with indirect indexing. This allows better vectorization for the
-!--       main loop. First, compute the flux at model surface, which need has to be calculated
-!--       explicetely for the tendency at the first w-level. For topography wall this is done
-!--       implicitely by advc_flags_m.
-          flux_t(nzb) = 0.0_wp
-          diss_t(nzb) = 0.0_wp
-          w_comp(nzb) = 0.0_wp
-          DO  k = nzb+1, nzb+1
-!
-!--          k index has to be modified near bottom and top, else array subscripts will be exceeded.
-             ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
-             ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
-             ibit6 = REAL( IBITS(advc_flags_m(k,j,i),6,1), KIND = wp )
-
-             k_ppp = k + 3 * ibit8
-             k_pp  = k + 2 * ( 1 - ibit6 )
-             k_mm  = k - 2 * ibit8
-
-             w_comp(k) = w(k,j,i) + w(k,j,i-1)
-             flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                             &
-                        (  37.0_wp * ibit8 * adv_mom_5                                             &
-                        +   7.0_wp * ibit7 * adv_mom_3                                             &
-                        +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)   + u(k,j,i)    )          &
-                        - ( 8.0_wp * ibit8 * adv_mom_5                                             &
-                        +            ibit7 * adv_mom_3 ) * ( u(k_pp,j,i)  + u(k-1,j,i)  )          &
-                        + (          ibit8 * adv_mom_5 ) * ( u(k_ppp,j,i) + u(k_mm,j,i) )          &
-                                                     )
-
-             diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                    &
-                        (  10.0_wp * ibit8 * adv_mom_5                                             &
-                        +   3.0_wp * ibit7 * adv_mom_3                                             &
-                        +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)   - u(k,j,i)    )          &
-                        - ( 5.0_wp * ibit8 * adv_mom_5                                             &
-                        +            ibit7 * adv_mom_3 ) * ( u(k_pp,j,i)  - u(k-1,j,i)  )          &
-                        + (          ibit8 * adv_mom_5 ) * ( u(k_ppp,j,i) - u(k_mm,j,i) )          &
-                                                              )
-          ENDDO
-
-          DO  k = nzb+2, nzt-2
-
-             ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
-             ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
-             ibit6 = REAL( IBITS(advc_flags_m(k,j,i),6,1), KIND = wp )
-
-             w_comp(k) = w(k,j,i) + w(k,j,i-1)
-             flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                             &
-                        (  37.0_wp * ibit8 * adv_mom_5                                             &
-                        +   7.0_wp * ibit7 * adv_mom_3                                             &
-                        +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)  + u(k,j,i)   )            &
-                        - ( 8.0_wp * ibit8 * adv_mom_5                                             &
-                        +            ibit7 * adv_mom_3 ) * ( u(k+2,j,i)  + u(k-1,j,i) )            &
-                        + (          ibit8 * adv_mom_5 ) * ( u(k+3,j,i)  + u(k-2,j,i) )            &
-                                                     )
-
-             diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                    &
-                         (  10.0_wp * ibit8 * adv_mom_5                                            &
-                         +   3.0_wp * ibit7 * adv_mom_3                                            &
-                         +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)  - u(k,j,i)    )          &
-                         - ( 5.0_wp * ibit8 * adv_mom_5                                            &
-                         +            ibit7 * adv_mom_3 ) * ( u(k+2,j,i)  - u(k-1,j,i)  )          &
-                         + (          ibit8 * adv_mom_5 ) * ( u(k+3,j,i)  - u(k-2,j,i)  )          &
-                                                              )
-          ENDDO
-
-          DO  k = nzt-1, nzt-symmetry_flag
-!
-!--          k index has to be modified near bottom and top, else array subscripts will be exceeded.
-             ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
-             ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
-             ibit6 = REAL( IBITS(advc_flags_m(k,j,i),6,1), KIND = wp )
-
-             k_ppp = k + 3 * ibit8
-             k_pp  = k + 2 * ( 1 - ibit6 )
-             k_mm  = k - 2 * ibit8
-
-             w_comp(k) = w(k,j,i) + w(k,j,i-1)
-             flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                             &
-                         (  37.0_wp * ibit8 * adv_mom_5                                            &
-                         +   7.0_wp * ibit7 * adv_mom_3                                            &
-                         +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)   + u(k,j,i)    )         &
-                         - ( 8.0_wp * ibit8 * adv_mom_5                                            &
-                         +            ibit7 * adv_mom_3 ) * ( u(k_pp,j,i)  + u(k-1,j,i)  )         &
-                         + (          ibit8 * adv_mom_5 ) * ( u(k_ppp,j,i) + u(k_mm,j,i) )         &
-                                                     )
-
-             diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                    &
-                         (  10.0_wp * ibit8 * adv_mom_5                                            &
-                         +   3.0_wp * ibit7 * adv_mom_3                                            &
-                         +            ibit6 * adv_mom_1 ) * ( u(k+1,j,i)   - u(k,j,i)    )         &
-                         - ( 5.0_wp * ibit8 * adv_mom_5                                            &
-                         +            ibit7 * adv_mom_3 ) * ( u(k_pp,j,i)  - u(k-1,j,i)  )         &
-                         + (          ibit8 * adv_mom_5 ) * ( u(k_ppp,j,i) - u(k_mm,j,i) )         &
-                                                              )
-          ENDDO
-!
-!--       Set resolved/turbulent flux at model top to zero (w-level). In case that a symmetric
-!--       behavior between bottom and top shell be guaranteed (closed channel flow), the flux at nzt
-!--       is also set to zero.
-          IF ( symmetry_flag == 1 )  THEN
-             flux_t(nzt) = 0.0_wp
-             diss_t(nzt) = 0.0_wp
-             w_comp(nzt) = 0.0_wp
-          ENDIF
-          flux_t(nzt+1) = 0.0_wp
-          diss_t(nzt+1) = 0.0_wp
-          w_comp(nzt+1) = 0.0_wp
-
-          DO  k = nzb+1, nzb_max_l
-
-             flux_d    = flux_t(k-1)
-             diss_d    = diss_t(k-1)
-
-             ibit2 = REAL( IBITS(advc_flags_m(k,j,i),2,1), KIND = wp )
-             ibit1 = REAL( IBITS(advc_flags_m(k,j,i),1,1), KIND = wp )
-             ibit0 = REAL( IBITS(advc_flags_m(k,j,i),0,1), KIND = wp )
-
-             ibit5 = REAL( IBITS(advc_flags_m(k,j,i),5,1), KIND = wp )
-             ibit4 = REAL( IBITS(advc_flags_m(k,j,i),4,1), KIND = wp )
-             ibit3 = REAL( IBITS(advc_flags_m(k,j,i),3,1), KIND = wp )
-
-             ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
-             ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
-             ibit6 = REAL( IBITS(advc_flags_m(k,j,i),6,1), KIND = wp )
-!
-!--          Calculate the divergence of the velocity field. A respective correction is needed to
-!--          overcome numerical instabilities introduced by an insufficient reduction of divergences
-!--          near topography.
-             div =   ( ( u_comp(k)        * ( ibit0 + ibit1 + ibit2 )                              &
-                     - ( u(k,j,i)   + u(k,j,i-1)   )                                               &
-                                       * (                                                         &
-                        REAL( IBITS(advc_flags_m(k,j,i-1),0,1), KIND = wp )                        &
-                      + REAL( IBITS(advc_flags_m(k,j,i-1),1,1), KIND = wp )                        &
-                      + REAL( IBITS(advc_flags_m(k,j,i-1),2,1), KIND = wp )                        &
-                                         )                                                         &
-                     ) * ddx                                                                       &
-                   + ( ( v_comp(k) + gv ) * ( ibit3 + ibit4 + ibit5 )                              &
-                     - ( v(k,j,i)   + v(k,j,i-1 )  )                                               &
-                                       * (                                                         &
-                        REAL( IBITS(advc_flags_m(k,j-1,i),3,1), KIND = wp )                        &
-                      + REAL( IBITS(advc_flags_m(k,j-1,i),4,1), KIND = wp )                        &
-                      + REAL( IBITS(advc_flags_m(k,j-1,i),5,1), KIND = wp )                        &
-                                         )                                                         &
-                     ) * ddy                                                                       &
-                   + ( w_comp(k)   * rho_air_zw(k) * ( ibit6 + ibit7 + ibit8 )                     &
-                   -   w_comp(k-1) * rho_air_zw(k-1)                                               &
-                                       * (                                                         &
-                        REAL( IBITS(advc_flags_m(k-1,j,i),6,1), KIND = wp )                        &
-                      + REAL( IBITS(advc_flags_m(k-1,j,i),7,1), KIND = wp )                        &
-                      + REAL( IBITS(advc_flags_m(k-1,j,i),8,1), KIND = wp )                        &
-                                         )                                                         &
-                     ) * drho_air(k) * 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    )           ) * drho_air(k) * ddzw(k)     &
-                                         ) + div * u(k,j,i)
-#ifndef _OPENACC
-!
-!--          Swap fluxes. Note, in the OPENACC case these are computed again.
-             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)
-#endif
-!
-!--          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 + SIGN( 1.0E-20_wp, u_comp(k) - gu ) )     &
-                                   + 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)                                                    &
-                                      * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )    &
-                                      / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )    &
-                                    + diss_t(k)                                                    &
-                                      *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )    &
-                                      / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )    &
-                                    ) *   weight_substep(intermediate_timestep_count)
-          ENDDO
-
-          DO  k = nzb_max_l+1, nzt
-
-             flux_d    = flux_t(k-1)
-             diss_d    = diss_t(k-1)
-!
-!--          Calculate the divergence of the velocity field. A respective correction is needed to
-!--          overcome numerical instabilities introduced by an insufficient reduction of divergences
-!--          near topography.
-             div = ( ( u_comp(k)       - ( u(k,j,i)   + u(k,j,i-1) ) ) * ddx                       &
-                   + ( v_comp(k) + gv  - ( v(k,j,i)   + v(k,j,i-1) ) ) * ddy                       &
-                   + ( w_comp(k)   * rho_air_zw(k)                                                 &
-                   -   w_comp(k-1) * rho_air_zw(k-1)                                               &
-                     ) * drho_air(k) * 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    ) ) * drho_air(k) * ddzw(k)               &
-                                         ) + div * u(k,j,i)
-#ifndef _OPENACC
-             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)
-#endif
-!
-!--          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 + SIGN( 1.0E-20_wp, u_comp(k) - gu ) )     &
-                                   + 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)                                                    &
-                                      * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )    &
-                                      / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )    &
-                                    + diss_t(k)                                                    &
-                                      *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )    &
-                                      / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )    &
-                                    ) *   weight_substep(intermediate_timestep_count)
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL cpu_log( log_point_s(68), 'advec_u_ws', 'stop' )
-
- END SUBROUTINE advec_u_ws
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of v - Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_v_ws
-
-
-    INTEGER(iwp) ::  i         !< grid index along x-direction
-    INTEGER(iwp) ::  j         !< grid index along y-direction
-    INTEGER(iwp) ::  k         !< grid index along z-direction
-    INTEGER(iwp) ::  k_mm      !< k-2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
-    INTEGER(iwp) ::  tn = 0    !< number of OpenMP thread
-
-    REAL(wp)    ::  diss_d   !< artificial dissipation term at grid box bottom
-    REAL(wp)    ::  div      !< diverence on v-grid
-    REAL(wp)    ::  flux_d   !< artificial 6th-order flux at grid box bottom
-    REAL(wp)    ::  gu       !< Galilei-transformation velocity along x
-    REAL(wp)    ::  gv       !< Galilei-transformation velocity along y
-    REAL(wp)    ::  ibit9 !< flag indicating 1st-order scheme along x-direction
-    REAL(wp)    ::  ibit10 !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp)    ::  ibit11 !< flag indicating 5th-order scheme along x-direction
-#ifdef _OPENACC
-    REAL(wp)    ::  ibit9_l !< flag indicating 1st-order scheme along x-direction
-    REAL(wp)    ::  ibit10_l !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp)    ::  ibit11_l !< flag indicating 5th-order scheme along x-direction
-#endif
-    REAL(wp)    ::  ibit12 !< flag indicating 1st-order scheme along y-direction
-    REAL(wp)    ::  ibit13 !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp)    ::  ibit14 !< flag indicating 5th-order scheme along y-direction
-#ifdef _OPENACC
-    REAL(wp)    ::  ibit12_s !< flag indicating 1st-order scheme along y-direction
-    REAL(wp)    ::  ibit13_s !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp)    ::  ibit14_s !< flag indicating 5th-order scheme along y-direction
-#endif
-    REAL(wp)    ::  ibit15   !< flag indicating 1st-order scheme along z-direction
-    REAL(wp)    ::  ibit16   !< flag indicating 3rd-order scheme along z-direction
-    REAL(wp)    ::  ibit17   !< flag indicating 5th-order scheme along z-direction
-#ifdef _OPENACC
-    REAL(wp)    ::  u_comp_l !< advection velocity along x at leftward side
-    REAL(wp)    ::  v_comp_s !< advection velocity along y at southward side
-#endif
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_t !< discretized artificial dissipation at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_t !< discretized 6th-order flux at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  u_comp !< advection velocity along x
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  v_comp !< advection velocity along y
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  w_comp !< advection velocity along z
-
-    CALL cpu_log( log_point_s(69), 'advec_v_ws', 'start' )
-
-    gu = 2.0_wp * u_gtrans
-    gv = 2.0_wp * v_gtrans
-
-    !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) &
-    !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) &
-    !$ACC PRIVATE(ibit9, ibit10, ibit11, ibit12, ibit13, ibit14) &
-    !$ACC PRIVATE(ibit15, ibit16, ibit17) &
-    !$ACC PRIVATE(ibit9_l, ibit10_l, ibit11_l) &
-    !$ACC PRIVATE(ibit12_s, ibit13_s, ibit14_s) &
-    !$ACC PRIVATE(nzb_max_l) &
-    !$ACC PRIVATE(flux_r, diss_r) &
-    !$ACC PRIVATE(flux_n, diss_n) &
-    !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) &
-    !$ACC PRIVATE(flux_l_v, diss_l_v, flux_s_v, diss_s_v) &
-    !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) &
-    !$ACC PRESENT(advc_flags_m) &
-    !$ACC PRESENT(u, v, w) &
-    !$ACC PRESENT(drho_air, rho_air_zw, ddzw) &
-    !$ACC PRESENT(tend) &
-    !$ACC PRESENT(hom(:,1,1:3,0)) &
-    !$ACC PRESENT(weight_substep(intermediate_timestep_count)) &
-    !$ACC PRESENT(sums_vs2_ws_l, sums_wsvs_ws_l)
-    DO  i = nxl, nxr
-       DO  j = nysv, nyn
-!
-!--       Used local modified copy of nzb_max (used to degrade order of discretization) at
-!--       non-cyclic boundaries. Modify only at relevant points instead of the entire subdomain.
-!--       This should lead to better load balance between boundary and non-boundary PEs.
-          IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR. &
-              ( bc_dirichlet_r  .OR.  bc_radiation_r )  .AND.  i >= nxr - 2  .OR. &
-              ( bc_dirichlet_s  .OR.  bc_radiation_s )  .AND.  j <= nys + 2  .OR. &
-              ( bc_dirichlet_n  .OR.  bc_radiation_n )  .AND.  j >= nyn - 2 )  THEN
-             nzb_max_l = nzt
-          ELSE
-             nzb_max_l = nzb_max
-          END IF
-
-#ifndef _OPENACC
-          IF ( i == nxl )  THEN
-             DO  k = nzb+1, nzb_max_l
-
-                ibit11 = REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )
-                ibit10 = REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )
-                ibit9  = REAL( IBITS(advc_flags_m(k,j,i-1),9,1),  KIND = wp )
-
-                u_comp(k)        = u(k,j-1,i) + u(k,j,i) - gu
-                flux_l_v(k,j,tn) = u_comp(k) * (                                                   &
-                                   (  37.0_wp * ibit11 * adv_mom_5                                 &
-                                   +   7.0_wp * ibit10 * adv_mom_3                                 &
-                                   +             ibit9 * adv_mom_1 ) * ( v(k,j,i)   + v(k,j,i-1) ) &
-                                   - ( 8.0_wp * ibit11 * adv_mom_5                                 &
-                                   +            ibit10 * adv_mom_3 ) * ( v(k,j,i+1) + v(k,j,i-2) ) &
-                                   + (          ibit11 * adv_mom_5 ) * ( v(k,j,i+2) + v(k,j,i-3) ) &
-                                               )
-
-                diss_l_v(k,j,tn) = - ABS( u_comp(k) ) * (                                          &
-                                   (  10.0_wp * ibit11 * adv_mom_5                                 &
-                                   +   3.0_wp * ibit10 * adv_mom_3                                 &
-                                   +             ibit9 * adv_mom_1 ) * ( v(k,j,i)   - v(k,j,i-1) ) &
-                                   - ( 5.0_wp * ibit11 * adv_mom_5                                 &
-                                   +            ibit10 * adv_mom_3 ) * ( v(k,j,i+1) - v(k,j,i-2) ) &
-                                   + (          ibit11 * adv_mom_5 ) * ( v(k,j,i+2) - v(k,j,i-3) ) &
-                                                        )
-
-             ENDDO
-
-             DO  k = nzb_max_l+1, nzt
-
-                u_comp(k)        = u(k,j-1,i) + u(k,j,i) - gu
-                flux_l_v(k,j,tn) = u_comp(k) * (                                                   &
-                                     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(k) ) * (                                          &
-                                     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
-
-          IF ( j == nysv )  THEN
-             DO  k = nzb+1, nzb_max_l
-
-                ibit14 = REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )
-                ibit13 = REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )
-                ibit12 = REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )
-
-                v_comp(k)      = v(k,j,i) + v(k,j-1,i) - gv
-                flux_s_v(k,tn) = v_comp(k) * (                                                     &
-                                 (  37.0_wp * ibit14 * adv_mom_5                                   &
-                                 +   7.0_wp * ibit13 * adv_mom_3                                   &
-                                 +            ibit12 * adv_mom_1 ) * ( v(k,j,i)   + v(k,j-1,i) )   &
-                                 - ( 8.0_wp * ibit14 * adv_mom_5                                   &
-                                 +            ibit13 * adv_mom_3 ) * ( v(k,j+1,i) + v(k,j-2,i) )   &
-                                 + (          ibit14 * adv_mom_5 ) * ( v(k,j+2,i) + v(k,j-3,i) )   &
-                                             )
-
-                diss_s_v(k,tn) = - ABS( v_comp(k) ) * (                                            &
-                                   (  10.0_wp * ibit14 * adv_mom_5                                 &
-                                   +   3.0_wp * ibit13 * adv_mom_3                                 &
-                                   +            ibit12 * adv_mom_1 ) * ( v(k,j,i)   - v(k,j-1,i) ) &
-                                   - ( 5.0_wp * ibit14 * adv_mom_5                                 &
-                                   +            ibit13 * adv_mom_3 ) * ( v(k,j+1,i) - v(k,j-2,i) ) &
-                                   + (          ibit14 * adv_mom_5 ) * ( v(k,j+2,i) - v(k,j-3,i) ) &
-                                                      )
-
-             ENDDO
-
-             DO  k = nzb_max_l+1, nzt
-
-                v_comp(k)      = v(k,j,i) + v(k,j-1,i) - gv
-                flux_s_v(k,tn) = 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
-                diss_s_v(k,tn) = - 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
-          ENDIF
-#endif
-
-          DO  k = nzb+1, nzb_max_l
-
-             ibit11 = REAL( IBITS(advc_flags_m(k,j,i),11,1), KIND = wp )
-             ibit10 = REAL( IBITS(advc_flags_m(k,j,i),10,1), KIND = wp )
-             ibit9  = REAL( IBITS(advc_flags_m(k,j,i),9,1),  KIND = wp )
-
-             u_comp(k) = u(k,j-1,i+1) + u(k,j,i+1) - gu
-             flux_r(k) = u_comp(k) * (                                                             &
-                         (  37.0_wp * ibit11 * adv_mom_5                                           &
-                         +   7.0_wp * ibit10 * adv_mom_3                                           &
-                         +             ibit9 * adv_mom_1 ) * ( v(k,j,i+1) + v(k,j,i)   )           &
-                         - ( 8.0_wp * ibit11 * adv_mom_5                                           &
-                         +            ibit10 * adv_mom_3 ) * ( v(k,j,i+2) + v(k,j,i-1) )           &
-                         + (          ibit11 * adv_mom_5 ) * ( v(k,j,i+3) + v(k,j,i-2) )           &
-                                     )
-
-             diss_r(k) = - ABS( u_comp(k) ) * (                                                    &
-                         (  10.0_wp * ibit11 * adv_mom_5                                           &
-                         +   3.0_wp * ibit10 * adv_mom_3                                           &
-                         +             ibit9 * adv_mom_1 ) * ( v(k,j,i+1) - v(k,j,i)  )            &
-                         - ( 5.0_wp * ibit11 * adv_mom_5                                           &
-                         +            ibit10 * adv_mom_3 ) * ( v(k,j,i+2) - v(k,j,i-1) )           &
-                         + (          ibit11 * adv_mom_5 ) * ( v(k,j,i+3) - v(k,j,i-2) )           &
-                                              )
-
-#ifdef _OPENACC
-!
-!--          Recompute the left fluxes.
-             ibit11_l = REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )
-             ibit10_l = REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )
-             ibit9_l  = REAL( IBITS(advc_flags_m(k,j,i-1),9,1),  KIND = wp )
-
-             u_comp_l          = u(k,j-1,i) + u(k,j,i) - gu
-             flux_l_v(k,j,tn)  = u_comp_l * (                                                      &
-                                 (  37.0_wp * ibit11_l * adv_mom_5                                 &
-                                 +   7.0_wp * ibit10_l * adv_mom_3                                 &
-                                 +             ibit9_l * adv_mom_1 ) * ( v(k,j,i)   + v(k,j,i-1) ) &
-                                 - ( 8.0_wp * ibit11_l * adv_mom_5                                 &
-                                 +            ibit10_l * adv_mom_3 ) * ( v(k,j,i+1) + v(k,j,i-2) ) &
-                                 + (          ibit11_l * adv_mom_5 ) * ( v(k,j,i+2) + v(k,j,i-3) ) &
-                                            )
-
-              diss_l_v(k,j,tn) = - ABS( u_comp_l ) * (                                             &
-                                 (  10.0_wp * ibit11_l * adv_mom_5                                 &
-                                 +   3.0_wp * ibit10_l * adv_mom_3                                 &
-                                 +             ibit9_l * adv_mom_1 ) * ( v(k,j,i)   - v(k,j,i-1) ) &
-                                 - ( 5.0_wp * ibit11_l * adv_mom_5                                 &
-                                 +            ibit10_l * adv_mom_3 ) * ( v(k,j,i+1) - v(k,j,i-2) ) &
-                                 + (          ibit11_l * adv_mom_5 ) * ( v(k,j,i+2) - v(k,j,i-3) ) &
-                                                     )
-#endif
-
-             ibit14 = REAL( IBITS(advc_flags_m(k,j,i),14,1), KIND = wp )
-             ibit13 = REAL( IBITS(advc_flags_m(k,j,i),13,1), KIND = wp )
-             ibit12 = REAL( IBITS(advc_flags_m(k,j,i),12,1), KIND = wp )
-
-             v_comp(k) = v(k,j+1,i) + v(k,j,i)
-             flux_n(k) = ( v_comp(k) - gv ) * (                                                    &
-                         (  37.0_wp * ibit14 * adv_mom_5                                           &
-                         +   7.0_wp * ibit13 * adv_mom_3                                           &
-                         +            ibit12 * adv_mom_1 ) * ( v(k,j+1,i) + v(k,j,i)   )           &
-                         - ( 8.0_wp * ibit14 * adv_mom_5                                           &
-                         +            ibit13 * adv_mom_3 ) * ( v(k,j+2,i) + v(k,j-1,i) )           &
-                         + (          ibit14 * adv_mom_5 ) * ( v(k,j+3,i) + v(k,j-2,i) )           &
-                                              )
-
-             diss_n(k) = - ABS( v_comp(k) - gv ) * (                                               &
-                         (  10.0_wp * ibit14 * adv_mom_5                                           &
-                         +   3.0_wp * ibit13 * adv_mom_3                                           &
-                         +            ibit12 * adv_mom_1 ) * ( v(k,j+1,i) - v(k,j,i)  )            &
-                         - ( 5.0_wp * ibit14 * adv_mom_5                                           &
-                         +            ibit13 * adv_mom_3 ) * ( v(k,j+2,i) - v(k,j-1,i) )           &
-                         + (          ibit14 * adv_mom_5 ) * ( v(k,j+3,i) - v(k,j-2,i) )           &
-                                                   )
-
-#ifdef _OPENACC
-!
-!--          Recompute the south fluxes.
-             ibit14_s = REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )
-             ibit13_s = REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )
-             ibit12_s = REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )
-
-             v_comp_s         = v(k,j,i) + v(k,j-1,i) - gv
-             flux_s_v(k,tn)   = v_comp_s * (                                                       &
-                                (  37.0_wp * ibit14_s * adv_mom_5                                  &
-                                +   7.0_wp * ibit13_s * adv_mom_3                                  &
-                                +            ibit12_s * adv_mom_1 ) * ( v(k,j,i)   + v(k,j-1,i) )  &
-                                - ( 8.0_wp * ibit14_s * adv_mom_5                                  &
-                                +            ibit13_s * adv_mom_3 ) * ( v(k,j+1,i) + v(k,j-2,i) )  &
-                                + (          ibit14_s * adv_mom_5 ) * ( v(k,j+2,i) + v(k,j-3,i) )  &
-                                           )
-
-            diss_s_v(k,tn)   = - ABS( v_comp_s ) * (                                               &
-                               (  10.0_wp * ibit14_s * adv_mom_5                                   &
-                               +   3.0_wp * ibit13_s * adv_mom_3                                   &
-                               +            ibit12_s * adv_mom_1 ) * ( v(k,j,i)   - v(k,j-1,i) )   &
-                               - ( 5.0_wp * ibit14_s * adv_mom_5                                   &
-                               +            ibit13_s * adv_mom_3 ) * ( v(k,j+1,i) - v(k,j-2,i) )   &
-                               + (          ibit14_s * adv_mom_5 ) * ( v(k,j+2,i) - v(k,j-3,i) )   &
-                                                   )
-#endif
-          ENDDO
-
-          DO  k = nzb_max_l+1, nzt
-
-             u_comp(k) = u(k,j-1,i+1) + u(k,j,i+1) - gu
-             flux_r(k) = u_comp(k) * (                                                             &
-                           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(k) ) * (                                                    &
-                           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
-
-#ifdef _OPENACC
-!
-!--          Recompute the left fluxes.
-             u_comp_l           = u(k,j-1,i) + u(k,j,i) - gu
-             flux_l_v(k,j,tn)   = u_comp_l * (                                                     &
-                                    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_l ) * (                                            &
-                                    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
-#endif
-
-             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
-
-#ifdef _OPENACC
-!
-!--          Recompute the south fluxes.
-             v_comp_s = v(k,j,i) + v(k,j-1,i) - gv
-             flux_s_v(k,tn)   = v_comp_s  * (                                                      &
-                                  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_s ) * (                                              &
-                                  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
-#endif
-          ENDDO
-!
-!--       Now, compute vertical fluxes. Split loop into a part treating the lowest 2 grid points
-!--       with indirect indexing, a main loop without indirect indexing, and a loop for the
-!--       uppermost 2 grid points with indirect indexing. This allows better vectorization for the
-!--       main loop.
-!--       First, compute the flux at model surface, which has to be calculated explicetely for the
-!--       tendency at the first w-level. For topography wall this is done implicitely by
-!--       advc_flags_m.
-          flux_t(nzb) = 0.0_wp
-          diss_t(nzb) = 0.0_wp
-          w_comp(nzb) = 0.0_wp
-          DO  k = nzb+1, nzb+1
-!
-!--          k index has to be modified near bottom and top, else array subscripts will be exceeded.
-             ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
-             ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
-             ibit15 = REAL( IBITS(advc_flags_m(k,j,i),15,1), KIND = wp )
-
-             k_ppp = k + 3 * ibit17
-             k_pp  = k + 2 * ( 1 - ibit15  )
-             k_mm  = k - 2 * ibit17
-
-             w_comp(k) = w(k,j-1,i) + w(k,j,i)
-             flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                             &
-                         (  37.0_wp * ibit17 * adv_mom_5                                           &
-                         +   7.0_wp * ibit16 * adv_mom_3                                           &
-                         +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i)   + v(k,j,i)    )        &
-                         - ( 8.0_wp * ibit17 * adv_mom_5                                           &
-                         +            ibit16 * adv_mom_3 ) * ( v(k_pp,j,i)  + v(k-1,j,i)  )        &
-                         + (          ibit17 * adv_mom_5 ) * ( v(k_ppp,j,i) + v(k_mm,j,i) )        &
-                                                     )
-
-             diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                    &
-                         (  10.0_wp * ibit17 * adv_mom_5                                           &
-                         +   3.0_wp * ibit16 * adv_mom_3                                           &
-                         +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i)   - v(k,j,i)    )        &
-                         - ( 5.0_wp * ibit17 * adv_mom_5                                           &
-                         +            ibit16 * adv_mom_3 ) * ( v(k_pp,j,i)  - v(k-1,j,i)  )        &
-                         + (          ibit17 * adv_mom_5 ) * ( v(k_ppp,j,i) - v(k_mm,j,i) )        &
-                                                              )
-          ENDDO
-
-          DO  k = nzb+2, nzt-2
-             ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
-             ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
-             ibit15 = REAL( IBITS(advc_flags_m(k,j,i),15,1), KIND = wp )
-
-             w_comp(k) = w(k,j-1,i) + w(k,j,i)
-             flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                             &
-                       (  37.0_wp * ibit17 * adv_mom_5                                             &
-                       +   7.0_wp * ibit16 * adv_mom_3                                             &
-                       +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i)  + v(k,j,i)    )           &
-                       - ( 8.0_wp * ibit17 * adv_mom_5                                             &
-                       +            ibit16 * adv_mom_3 ) * ( v(k+2,j,i) + v(k-1,j,i)   )           &
-                       + (          ibit17 * adv_mom_5 ) * ( v(k+3,j,i) + v(k-2,j,i)   )           &
-                                                     )
-
-             diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                    &
-                         (  10.0_wp * ibit17 * adv_mom_5                                           &
-                         +   3.0_wp * ibit16 * adv_mom_3                                           &
-                         +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i) - v(k,j,i)     )         &
-                         - ( 5.0_wp * ibit17 * adv_mom_5                                           &
-                         +            ibit16 * adv_mom_3 ) * ( v(k+2,j,i) - v(k-1,j,i)   )         &
-                         + (          ibit17 * adv_mom_5 ) * ( v(k+3,j,i) - v(k-2,j,i)   )         &
-                                                              )
-          ENDDO
-
-          DO  k = nzt-1, nzt-symmetry_flag
-!
-!--          k index has to be modified near bottom and top, else array subscripts will be exceeded.
-             ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
-             ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
-             ibit15 = REAL( IBITS(advc_flags_m(k,j,i),15,1), KIND = wp )
-
-             k_ppp = k + 3 * ibit17
-             k_pp  = k + 2 * ( 1 - ibit15  )
-             k_mm  = k - 2 * ibit17
-
-             w_comp(k) = w(k,j-1,i) + w(k,j,i)
-             flux_t(k) = w_comp(k) * rho_air_zw(k) * (                                             &
-                         (  37.0_wp * ibit17 * adv_mom_5                                           &
-                         +   7.0_wp * ibit16 * adv_mom_3                                           &
-                         +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i)   + v(k,j,i)    )        &
-                         - ( 8.0_wp * ibit17 * adv_mom_5                                           &
-                         +            ibit16 * adv_mom_3 ) * ( v(k_pp,j,i)  + v(k-1,j,i)  )        &
-                         + (          ibit17 * adv_mom_5 ) * ( v(k_ppp,j,i) + v(k_mm,j,i) )        &
-                                                     )
-
-             diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                                    &
-                         (  10.0_wp * ibit17 * adv_mom_5                                           &
-                         +   3.0_wp * ibit16 * adv_mom_3                                           &
-                         +            ibit15 * adv_mom_1 ) * ( v(k+1,j,i)   - v(k,j,i)    )        &
-                         - ( 5.0_wp * ibit17 * adv_mom_5                                           &
-                         +            ibit16 * adv_mom_3 ) * ( v(k_pp,j,i)  - v(k-1,j,i)  )        &
-                         + (          ibit17 * adv_mom_5 ) * ( v(k_ppp,j,i) - v(k_mm,j,i) )        &
-                                                              )
-          ENDDO
-
-!
-!--       Set resolved/turbulent flux at model top to zero (w-level). In case that a symmetric
-!--       behavior between bottom and top shall be guaranteed (closed channel flow), the flux at nzt
-!--       is also set to zero.
-          IF ( symmetry_flag == 1 ) THEN
-             flux_t(nzt) = 0.0_wp
-             diss_t(nzt) = 0.0_wp
-             w_comp(nzt) = 0.0_wp
-          ENDIF
-          flux_t(nzt+1) = 0.0_wp
-          diss_t(nzt+1) = 0.0_wp
-          w_comp(nzt+1) = 0.0_wp
-
-          DO k = nzb+1, nzb_max_l
-
-             flux_d    = flux_t(k-1)
-             diss_d    = diss_t(k-1)
-
-             ibit11 = REAL( IBITS(advc_flags_m(k,j,i),11,1), KIND = wp )
-             ibit10 = REAL( IBITS(advc_flags_m(k,j,i),10,1), KIND = wp )
-             ibit9  = REAL( IBITS(advc_flags_m(k,j,i),9,1),  KIND = wp )
-
-             ibit14 = REAL( IBITS(advc_flags_m(k,j,i),14,1), KIND = wp )
-             ibit13 = REAL( IBITS(advc_flags_m(k,j,i),13,1), KIND = wp )
-             ibit12 = REAL( IBITS(advc_flags_m(k,j,i),12,1), KIND = wp )
-
-             ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
-             ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
-             ibit15 = REAL( IBITS(advc_flags_m(k,j,i),15,1), KIND = wp )
-!
-!--          Calculate the divergence of the velocity field. A respective correction is needed to
-!--          overcome numerical instabilities caused by an insufficient reduction of divergences
-!--          near topography.
-             div = ( ( ( u_comp(k)     + gu )                                                      &
-                                          * ( ibit9 + ibit10 + ibit11 )                            &
-                   - ( u(k,j-1,i)   + u(k,j,i) )                                                   &
-                                          * (                                                      &
-                           REAL( IBITS(advc_flags_m(k,j,i-1),9,1), KIND = wp )                     &
-                         + REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )                    &
-                         + REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )                    &
-                                            )                                                      &
-                     ) * ddx                                                                       &
-                   + ( v_comp(k)                                                                   &
-                                          * ( ibit12 + ibit13 + ibit14 )                           &
-                   - ( v(k,j,i)     + v(k,j-1,i) )                                                 &
-                                          * (                                                      &
-                           REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )                    &
-                         + REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )                    &
-                         + REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )                    &
-                                            )                                                      &
-                     ) * ddy                                                                       &
-                   + ( w_comp(k) * rho_air_zw(k)                                                   &
-                                          * ( ibit15 + ibit16 + ibit17 )                           &
-                   - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1)                               &
-                                          * (                                                      &
-                           REAL( IBITS(advc_flags_m(k-1,j,i),15,1), KIND = wp )                    &
-                         + REAL( IBITS(advc_flags_m(k-1,j,i),16,1), KIND = wp )                    &
-                         + REAL( IBITS(advc_flags_m(k-1,j,i),17,1), KIND = wp )                    &
-                                            )                                                      &
-                      ) * drho_air(k) * 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 ) ) * drho_air(k) * ddzw(k)         &
-                                                  )  + v(k,j,i) * div
-
-#ifndef _OPENACC
-!
-!--          Swap fluxes. Note, in the OPENACC case these are computed again.
-             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)
-#endif
-
-!
-!--          Statistical Evaluation of v'v'. The factor has to be applied for right evaluation when
-!--          gallilei_trans = .T. .
-             !$ACC ATOMIC
-             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 + SIGN( 1.0E-20_wp, v_comp(k) - gv ) )     &
-                                   + 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'u'.
-             !$ACC ATOMIC
-             sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn) +                                         &
-                                    ( flux_t(k)                                                    &
-                                      * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )    &
-                                      / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )    &
-                                    + diss_t(k)                                                    &
-                                      *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )    &
-                                      / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )    &
-                                    ) *   weight_substep(intermediate_timestep_count)
-
-          ENDDO
-
-          DO  k = nzb_max_l+1, nzt
-
-             flux_d    = flux_t(k-1)
-             diss_d    = diss_t(k-1)
-!
-!--          Calculate the divergence of the velocity field. A respective correction is needed to
-!--          overcome numerical instabilities caused by an insufficient reduction of divergences
-!--          near topography.
-             div = (  ( u_comp(k) + 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(k)                     * rho_air_zw(k) -                            &
-                        ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1)                            &
-                      ) * drho_air(k) * 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 ) ) * drho_air(k) * ddzw(k)                       &
-                                         )  + v(k,j,i) * div
-
-#ifndef _OPENACC
-!
-!--          Swap fluxes. Note, in the OPENACC case these are computed again.
-             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)
-#endif
-
-!
-!--          Statistical Evaluation of v'v'. The factor has to be applied for right evaluation when
-!--          gallilei_trans = .T. .
-             !$ACC ATOMIC
-             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 + SIGN( 1.0E-20_wp, v_comp(k) - gv ) )     &
-                                   +   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'u'.
-             !$ACC ATOMIC
-             sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn) +                                         &
-                                    ( flux_t(k)                                                    &
-                                      * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )    &
-                                      / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )    &
-                                    + diss_t(k)                                                    &
-                                      *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )    &
-                                      / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )    &
-                                    ) *  weight_substep(intermediate_timestep_count)
-
-          ENDDO
-
-       ENDDO
-    ENDDO
-
-    CALL cpu_log( log_point_s(69), 'advec_v_ws', 'stop' )
-
- END SUBROUTINE advec_v_ws
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of w - Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE advec_w_ws
-
-
-    INTEGER(iwp) ::  i         !< grid index along x-direction
-    INTEGER(iwp) ::  j         !< grid index along y-direction
-    INTEGER(iwp) ::  k         !< grid index along z-direction
-    INTEGER(iwp) ::  k_mm      !< k-2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
-    INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
-    INTEGER(iwp) ::  tn = 0    !< number of OpenMP thread
-
-    REAL(wp)    ::  diss_d   !< artificial dissipation term at grid box bottom
-    REAL(wp)    ::  div      !< divergence on w-grid
-    REAL(wp)    ::  flux_d   !< 6th-order flux at grid box bottom
-    REAL(wp)    ::  gu       !< Galilei-transformation velocity along x
-    REAL(wp)    ::  gv       !< Galilei-transformation velocity along y
-    REAL(wp)    ::  ibit18 !< flag indicating 1st-order scheme along x-direction
-    REAL(wp)    ::  ibit19 !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp)    ::  ibit20 !< flag indicating 5th-order scheme along x-direction
-#ifdef _OPENACC
-    REAL(wp)    ::  ibit18_l !< flag indicating 1st-order scheme along x-direction
-    REAL(wp)    ::  ibit19_l !< flag indicating 3rd-order scheme along x-direction
-    REAL(wp)    ::  ibit20_l !< flag indicating 5th-order scheme along x-direction
-#endif
-    REAL(wp)    ::  ibit21 !< flag indicating 1st-order scheme along y-direction
-    REAL(wp)    ::  ibit22 !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp)    ::  ibit23 !< flag indicating 5th-order scheme along y-direction
-#ifdef _OPENACC
-    REAL(wp)    ::  ibit21_s !< flag indicating 1st-order scheme along y-direction
-    REAL(wp)    ::  ibit22_s !< flag indicating 3rd-order scheme along y-direction
-    REAL(wp)    ::  ibit23_s !< flag indicating 5th-order scheme along y-direction
-#endif
-    REAL(wp)    ::  ibit24   !< flag indicating 1st-order scheme along z-direction
-    REAL(wp)    ::  ibit25   !< flag indicating 3rd-order scheme along z-direction
-    REAL(wp)    ::  ibit26   !< flag indicating 5th-order scheme along z-direction
-#ifdef _OPENACC
-    REAL(wp)    ::  u_comp_l !< advection velocity along x
-    REAL(wp)    ::  v_comp_s !< advection velocity along y
-#endif
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_t !< discretized artificial dissipation at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_t !< discretized 6th-order flux at top of the grid box
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  u_comp !< advection velocity along x
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  v_comp !< advection velocity along y
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  w_comp !< advection velocity along z
-
-
-    CALL cpu_log( log_point_s(87), 'advec_w_ws', 'start' )
-
-    gu = 2.0_wp * u_gtrans
-    gv = 2.0_wp * v_gtrans
-
-    !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) &
-    !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) &
-    !$ACC PRIVATE(ibit18, ibit19, ibit20, ibit21, ibit22, ibit23) &
-    !$ACC PRIVATE(ibit24, ibit25, ibit26) &
-    !$ACC PRIVATE(ibit18_l, ibit19_l, ibit20_l) &
-    !$ACC PRIVATE(ibit21_s, ibit22_s, ibit23_s) &
-    !$ACC PRIVATE(nzb_max_l) &
-    !$ACC PRIVATE(flux_r, diss_r) &
-    !$ACC PRIVATE(flux_n, diss_n) &
-    !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) &
-    !$ACC PRIVATE(flux_l_w, diss_l_w, flux_s_w, diss_s_w) &
-    !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) &
-    !$ACC PRESENT(advc_flags_m) &
-    !$ACC PRESENT(u, v, w) &
-    !$ACC PRESENT(drho_air, rho_air_zw, ddzw) &
-    !$ACC PRESENT(tend) &
-    !$ACC PRESENT(hom(:,1,1:3,0)) &
-    !$ACC PRESENT(weight_substep(intermediate_timestep_count)) &
-    !$ACC PRESENT(sums_ws2_ws_l)
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-!
-!--       Used local modified copy of nzb_max (used to degrade order of discretization) at
-!--       non-cyclic boundaries. Modify only at relevant points instead of the entire subdomain.
-!--       This should lead to better load balance between boundary and non-boundary PEs.
-          IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR.                  &
-              ( bc_dirichlet_r  .OR.  bc_radiation_r )  .AND.  i >= nxr - 2  .OR.                  &
-              ( bc_dirichlet_s  .OR.  bc_radiation_s )  .AND.  j <= nys + 2  .OR.                  &
-              ( bc_dirichlet_n  .OR.  bc_radiation_n )  .AND.  j >= nyn - 2 )  THEN
-             nzb_max_l = nzt - 1
-          ELSE
-             nzb_max_l = nzb_max
-          END IF
-
-#ifndef _OPENACC
-          IF ( i == nxl )  THEN
-             DO  k = nzb+1, nzb_max_l
-                ibit20 = REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp )
-                ibit19 = REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp )
-                ibit18 = REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )
-
-                u_comp(k)        = u(k+1,j,i) + u(k,j,i) - gu
-                flux_l_w(k,j,tn) = u_comp(k) * (                                                   &
-                                   (  37.0_wp * ibit20 * adv_mom_5                                 &
-                                   +   7.0_wp * ibit19 * adv_mom_3                                 &
-                                   +            ibit18 * adv_mom_1 ) * ( w(k,j,i)   + w(k,j,i-1) ) &
-                                   - ( 8.0_wp * ibit20 * adv_mom_5                                 &
-                                   +            ibit19 * adv_mom_3 ) * ( w(k,j,i+1) + w(k,j,i-2) ) &
-                                   + (          ibit20 * adv_mom_5 ) * ( w(k,j,i+2) + w(k,j,i-3) ) &
-                                               )
-
-                diss_l_w(k,j,tn) = - ABS( u_comp(k) ) * (                                          &
-                                   (  10.0_wp * ibit20 * adv_mom_5                                 &
-                                   +   3.0_wp * ibit19 * adv_mom_3                                 &
-                                   +            ibit18 * adv_mom_1 ) * ( w(k,j,i)   - w(k,j,i-1) ) &
-                                   - ( 5.0_wp * ibit20 * adv_mom_5                                 &
-                                   +            ibit19 * adv_mom_3 ) * ( w(k,j,i+1) - w(k,j,i-2) ) &
-                                   + (          ibit20 * adv_mom_5 ) * ( w(k,j,i+2) - w(k,j,i-3) ) &
-                                                        )
-
-             ENDDO
-
-             DO  k = nzb_max_l+1, nzt-1
-
-                u_comp(k)        = u(k+1,j,i) + u(k,j,i) - gu
-                flux_l_w(k,j,tn) = u_comp(k) * (                                                   &
-                                     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(k) ) * (                                          &
-                                     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
-
-          IF ( j == nys )  THEN
-             DO  k = nzb+1, nzb_max_l
-
-                ibit23 = REAL( IBITS(advc_flags_m(k,j-1,i),23,1), KIND = wp )
-                ibit22 = REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp )
-                ibit21 = REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )
-
-                v_comp(k)      = v(k+1,j,i) + v(k,j,i) - gv
-                flux_s_w(k,tn) = v_comp(k) * (                                                     &
-                                 (  37.0_wp * ibit23 * adv_mom_5                                   &
-                                 +   7.0_wp * ibit22 * adv_mom_3                                   &
-                                 +            ibit21 * adv_mom_1 ) * ( w(k,j,i)   + w(k,j-1,i) )   &
-                                 - ( 8.0_wp * ibit23 * adv_mom_5                                   &
-                                 +            ibit22 * adv_mom_3 ) * ( w(k,j+1,i) + w(k,j-2,i) )   &
-                                 + (          ibit23 * adv_mom_5 ) * ( w(k,j+2,i) + w(k,j-3,i) )   &
-                                             )
-
-                diss_s_w(k,tn) = - ABS( v_comp(k) ) * (                                            &
-                                 (  10.0_wp * ibit23 * adv_mom_5                                   &
-                                 +   3.0_wp * ibit22 * adv_mom_3                                   &
-                                 +            ibit21 * adv_mom_1 ) * ( w(k,j,i)   - w(k,j-1,i) )   &
-                                 - ( 5.0_wp * ibit23 * adv_mom_5                                   &
-                                 +            ibit22 * adv_mom_3 ) * ( w(k,j+1,i) - w(k,j-2,i) )   &
-                                 + (          ibit23 * adv_mom_5 ) * ( w(k,j+2,i) - w(k,j-3,i) )   &
-                                                      )
-
-             ENDDO
-
-             DO  k = nzb_max_l+1, nzt-1
-
-                v_comp(k)      = v(k+1,j,i) + v(k,j,i) - gv
-                flux_s_w(k,tn) = v_comp(k) * (                                                     &
-                                   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(k) ) * (                                            &
-                                   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
-#endif
-          DO  k = nzb+1, nzb_max_l
-
-             ibit20 = REAL( IBITS(advc_flags_m(k,j,i),20,1), KIND = wp )
-             ibit19 = REAL( IBITS(advc_flags_m(k,j,i),19,1), KIND = wp )
-             ibit18 = REAL( IBITS(advc_flags_m(k,j,i),18,1), KIND = wp )
-
-             u_comp(k) = u(k+1,j,i+1) + u(k,j,i+1) - gu
-             flux_r(k) = u_comp(k) * (                                                             &
-                         (  37.0_wp * ibit20 * adv_mom_5                                           &
-                         +   7.0_wp * ibit19 * adv_mom_3                                           &
-                         +            ibit18 * adv_mom_1 ) * ( w(k,j,i+1) + w(k,j,i)   )           &
-                         - ( 8.0_wp * ibit20 * adv_mom_5                                           &
-                         +            ibit19 * adv_mom_3 ) * ( w(k,j,i+2) + w(k,j,i-1) )           &
-                         + (          ibit20 * adv_mom_5 ) * ( w(k,j,i+3) + w(k,j,i-2) )           &
-                                     )
-
-             diss_r(k) = - ABS( u_comp(k) ) * (                                                    &
-                         (  10.0_wp * ibit20 * adv_mom_5                                           &
-                         +   3.0_wp * ibit19 * adv_mom_3                                           &
-                         +            ibit18 * adv_mom_1 ) * ( w(k,j,i+1) - w(k,j,i)  )            &
-                         - ( 5.0_wp * ibit20 * adv_mom_5                                           &
-                         +            ibit19 * adv_mom_3 ) * ( w(k,j,i+2) - w(k,j,i-1) )           &
-                         + (          ibit20 * adv_mom_5 ) * ( w(k,j,i+3) - w(k,j,i-2) )           &
-                                              )
-
-#ifdef _OPENACC
-!
-!--          Recompute the left fluxes.
-             ibit20_l = REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp )
-             ibit19_l = REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp )
-             ibit18_l = REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )
-
-             u_comp_l           = u(k+1,j,i) + u(k,j,i) - gu
-             flux_l_w(k,j,tn)   = u_comp_l * (                                                     &
-                                  (  37.0_wp * ibit20_l * adv_mom_5                                &
-                                  +   7.0_wp * ibit19_l * adv_mom_3                                &
-                                  +            ibit18_l * adv_mom_1 ) * ( w(k,j,i)   + w(k,j,i-1) )&
-                                  - ( 8.0_wp * ibit20_l * adv_mom_5                                &
-                                  +            ibit19_l * adv_mom_3 ) * ( w(k,j,i+1) + w(k,j,i-2) )&
-                                  + (          ibit20_l * adv_mom_5 ) * ( w(k,j,i+2) + w(k,j,i-3) )&
-                                             )
-
-             diss_l_w(k,j,tn)   = - ABS( u_comp_l ) * (                                            &
-                                  (  10.0_wp * ibit20_l * adv_mom_5                                &
-                                  +   3.0_wp * ibit19_l * adv_mom_3                                &
-                                  +            ibit18_l * adv_mom_1 ) * ( w(k,j,i)   - w(k,j,i-1) )&
-                                  - ( 5.0_wp * ibit20_l * adv_mom_5                                &
-                                  +            ibit19_l * adv_mom_3 ) * ( w(k,j,i+1) - w(k,j,i-2) )&
-                                  + (          ibit20_l * adv_mom_5 ) * ( w(k,j,i+2) - w(k,j,i-3) )&
-                                                      )
-#endif
-
-
-             ibit23 = REAL( IBITS(advc_flags_m(k,j,i),23,1), KIND = wp )
-             ibit22 = REAL( IBITS(advc_flags_m(k,j,i),22,1), KIND = wp )
-             ibit21 = REAL( IBITS(advc_flags_m(k,j,i),21,1), KIND = wp )
-
-             v_comp(k) = v(k+1,j+1,i) + v(k,j+1,i) - gv
-             flux_n(k) = v_comp(k) * (                                                             &
-                         (  37.0_wp * ibit23 * adv_mom_5                                           &
-                         +   7.0_wp * ibit22 * adv_mom_3                                           &
-                         +            ibit21 * adv_mom_1 ) * ( w(k,j+1,i) + w(k,j,i)   )           &
-                         - ( 8.0_wp * ibit23 * adv_mom_5                                           &
-                         +            ibit22 * adv_mom_3 ) * ( w(k,j+2,i) + w(k,j-1,i) )           &
-                         + (          ibit23 * adv_mom_5 ) * ( w(k,j+3,i) + w(k,j-2,i) )           &
-                                     )
-
-             diss_n(k) = - ABS( v_comp(k) ) * (                                                    &
-                       (  10.0_wp * ibit23 * adv_mom_5                                             &
-                       +   3.0_wp * ibit22 * adv_mom_3                                             &
-                       +            ibit21 * adv_mom_1 ) * ( w(k,j+1,i) - w(k,j,i)  )              &
-                       - ( 5.0_wp * ibit23 * adv_mom_5                                             &
-                       +            ibit22 * adv_mom_3 ) * ( w(k,j+2,i) - w(k,j-1,i) )             &
-                       + (          ibit23 * adv_mom_5 ) * ( w(k,j+3,i) - w(k,j-2,i) )             &
-                                              )
-
-#ifdef _OPENACC
-!
-!--          Recompute the south fluxes.
-             ibit23_s = REAL( IBITS(advc_flags_m(k,j-1,i),23,1), KIND = wp )
-             ibit22_s = REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp )
-             ibit21_s = REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )
-
-             v_comp_s         = v(k+1,j,i) + v(k,j,i) - gv
-             flux_s_w(k,tn)   = v_comp_s * (                                                       &
-                                (  37.0_wp * ibit23_s * adv_mom_5                                  &
-                                +   7.0_wp * ibit22_s * adv_mom_3                                  &
-                                +            ibit21_s * adv_mom_1 ) * ( w(k,j,i)   + w(k,j-1,i) )  &
-                                - ( 8.0_wp * ibit23_s * adv_mom_5                                  &
-                                +            ibit22_s * adv_mom_3 ) * ( w(k,j+1,i) + w(k,j-2,i) )  &
-                                + (          ibit23_s * adv_mom_5 ) * ( w(k,j+2,i) + w(k,j-3,i) )  &
-                                           )
-
-             diss_s_w(k,tn)   = - ABS( v_comp_s ) * (                                              &
-                                (  10.0_wp * ibit23_s * adv_mom_5                                  &
-                                +   3.0_wp * ibit22_s * adv_mom_3                                  &
-                                +            ibit21_s * adv_mom_1 ) * ( w(k,j,i)   - w(k,j-1,i) )  &
-                                - ( 5.0_wp * ibit23_s * adv_mom_5                                  &
-                                +            ibit22_s * adv_mom_3 ) * ( w(k,j+1,i) - w(k,j-2,i) )  &
-                                + (          ibit23_s * adv_mom_5 ) * ( w(k,j+2,i) - w(k,j-3,i) )  &
-                                                    )
-#endif
-          ENDDO
-
-          DO  k = nzb_max_l+1, nzt-1
-
-             u_comp(k) = u(k+1,j,i+1) + u(k,j,i+1) - gu
-             flux_r(k) = u_comp(k) * (                                                             &
-                           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(k) ) * (                                                    &
-                           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
-
-#ifdef _OPENACC
-!
-!--          Recompute the left fluxes.
-             u_comp_l           = u(k+1,j,i) + u(k,j,i) - gu
-             flux_l_w(k,j,tn)   = u_comp_l * (                                                     &
-                                    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_l ) * (                                            &
-                                    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
-#endif
-
-             v_comp(k) = v(k+1,j+1,i) + v(k,j+1,i) - gv
-             flux_n(k) = v_comp(k) * (                                                             &
-                           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(k) ) * (                                                    &
-                           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
-
-#ifdef _OPENACC
-!
-!--          Recompute the south fluxes.
-             v_comp_s         = v(k+1,j,i) + v(k,j,i) - gv
-             flux_s_w(k,tn)   = v_comp_s * (                                                       &
-                                  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_s ) * (                                              &
-                                  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
-#endif
-          ENDDO
-!
-!--       Now, compute vertical fluxes. Split loop into a part treating the lowest grid points with
-!--       indirect indexing, a main loop without indirect indexing, and a loop for the uppermost
-!--       grid points with indirect indexing. This allows better vectorization for the main loop.
-!--       First, compute the flux at model surface, which need has to be calculated explicitly for
-!--       the tendency at the first w-level. For topography wall this is done implicitely by
-!--       advc_flags_m.
-          k         = nzb + 1
-          w_comp(k) = w(k,j,i) + w(k-1,j,i)
-          flux_t(0) =  w_comp(k)       * rho_air(k) * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1
-          diss_t(0) = - ABS(w_comp(k)) * rho_air(k) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1
-
-          DO  k = nzb+1, nzb+1
-!
-!--          k index has to be modified near bottom and top, else array subscripts will be exceeded.
-             ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
-             ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
-             ibit24 = REAL( IBITS(advc_flags_m(k,j,i),24,1), KIND = wp )
-
-             k_ppp = k + 3 * ibit26
-             k_pp  = k + 2 * ( 1 - ibit24  )
-             k_mm  = k - 2 * ibit26
-
-             w_comp(k) = w(k+1,j,i) + w(k,j,i)
-             flux_t(k) = w_comp(k) * rho_air(k+1) * (                                              &
-                        (  37.0_wp * ibit26 * adv_mom_5                                            &
-                        +   7.0_wp * ibit25 * adv_mom_3                                            &
-                        +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i)   + w(k,j,i)    )         &
-                        - ( 8.0_wp * ibit26 * adv_mom_5                                            &
-                        +            ibit25 * adv_mom_3 ) * ( w(k_pp,j,i)  + w(k-1,j,i)  )         &
-                        + (          ibit26 * adv_mom_5 ) * ( w(k_ppp,j,i) + w(k_mm,j,i) )         &
-                                                    )
-
-             diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                                     &
-                         (  10.0_wp * ibit26 * adv_mom_5                                           &
-                         +   3.0_wp * ibit25 * adv_mom_3                                           &
-                         +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i)   - w(k,j,i)    )        &
-                         - ( 5.0_wp * ibit26 * adv_mom_5                                           &
-                         +            ibit25 * adv_mom_3 ) * ( w(k_pp,j,i)  - w(k-1,j,i)  )        &
-                         + (          ibit26 * adv_mom_5 ) * ( w(k_ppp,j,i) - w(k_mm,j,i) )        &
-                                                             )
-          ENDDO
-
-          DO  k = nzb+2, nzt-2
-
-             ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
-             ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
-             ibit24 = REAL( IBITS(advc_flags_m(k,j,i),24,1), KIND = wp )
-
-             w_comp(k) = w(k+1,j,i) + w(k,j,i)
-             flux_t(k) = w_comp(k) * rho_air(k+1) * (                                              &
-                        (  37.0_wp * ibit26 * adv_mom_5                                            &
-                        +   7.0_wp * ibit25 * adv_mom_3                                            &
-                        +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i)  + w(k,j,i)   )           &
-                        - ( 8.0_wp * ibit26 * adv_mom_5                                            &
-                        +            ibit25 * adv_mom_3 ) * ( w(k+2,j,i)  + w(k-1,j,i) )           &
-                        + (          ibit26 * adv_mom_5 ) * ( w(k+3,j,i)  + w(k-2,j,i) )           &
-                                                    )
-
-             diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                                     &
-                         (  10.0_wp * ibit26 * adv_mom_5                                           &
-                         +   3.0_wp * ibit25 * adv_mom_3                                           &
-                         +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i) - w(k,j,i)    )          &
-                         - ( 5.0_wp * ibit26 * adv_mom_5                                           &
-                         +            ibit25 * adv_mom_3 ) * ( w(k+2,j,i) - w(k-1,j,i)  )          &
-                         + (          ibit26 * adv_mom_5 ) * ( w(k+3,j,i) - w(k-2,j,i)  )          &
-                                                             )
-          ENDDO
-
-          DO  k = nzt-1, nzt-1
-!
-!--          k index has to be modified near bottom and top, else array subscripts will be exceeded.
-             ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
-             ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
-             ibit24 = REAL( IBITS(advc_flags_m(k,j,i),24,1), KIND = wp )
-
-             k_ppp = k + 3 * ibit26
-             k_pp  = k + 2 * ( 1 - ibit24  )
-             k_mm  = k - 2 * ibit26
-
-             w_comp(k) = w(k+1,j,i) + w(k,j,i)
-             flux_t(k) = w_comp(k) * rho_air(k+1) * (                                              &
-                         (  37.0_wp * ibit26 * adv_mom_5                                           &
-                         +   7.0_wp * ibit25 * adv_mom_3                                           &
-                         +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i)   + w(k,j,i)    )        &
-                         - ( 8.0_wp * ibit26 * adv_mom_5                                           &
-                         +            ibit25 * adv_mom_3 ) * ( w(k_pp,j,i)  + w(k-1,j,i)  )        &
-                         + (          ibit26 * adv_mom_5 ) * ( w(k_ppp,j,i) + w(k_mm,j,i) )        &
-                                                    )
-
-             diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                                     &
-                         (  10.0_wp * ibit26 * adv_mom_5                                           &
-                         +   3.0_wp * ibit25 * adv_mom_3                                           &
-                         +            ibit24 * adv_mom_1 ) * ( w(k+1,j,i)   - w(k,j,i)    )        &
-                         - ( 5.0_wp * ibit26 * adv_mom_5                                           &
-                         +            ibit25 * adv_mom_3 ) * ( w(k_pp,j,i)  - w(k-1,j,i)  )        &
-                         + (          ibit26 * adv_mom_5 ) * ( w(k_ppp,j,i) - w(k_mm,j,i) )        &
-                                                             )
-          ENDDO
-
-!
-!--       Set resolved/turbulent flux at model top to zero (w-level). Hint: The flux at nzt is
-!--       defined at the scalar grid point nzt+1. Therefore, the flux at nzt+1 is already outside of
-!--       the model domain
-          flux_t(nzt) = 0.0_wp
-          diss_t(nzt) = 0.0_wp
-          w_comp(nzt) = 0.0_wp
-
-          flux_t(nzt+1) = 0.0_wp
-          diss_t(nzt+1) = 0.0_wp
-          w_comp(nzt+1) = 0.0_wp
-
-          DO  k = nzb+1, nzb_max_l
-
-             flux_d    = flux_t(k-1)
-             diss_d    = diss_t(k-1)
-
-             ibit20 = REAL( IBITS(advc_flags_m(k,j,i),20,1), KIND = wp )
-             ibit19 = REAL( IBITS(advc_flags_m(k,j,i),19,1), KIND = wp )
-             ibit18 = REAL( IBITS(advc_flags_m(k,j,i),18,1), KIND = wp )
-
-             ibit23 = REAL( IBITS(advc_flags_m(k,j,i),23,1), KIND = wp )
-             ibit22 = REAL( IBITS(advc_flags_m(k,j,i),22,1), KIND = wp )
-             ibit21 = REAL( IBITS(advc_flags_m(k,j,i),21,1), KIND = wp )
-
-             ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
-             ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
-             ibit24 = REAL( IBITS(advc_flags_m(k,j,i),24,1), KIND = wp )
-!
-!--          Calculate the divergence of the velocity field. A respective correction is needed to
-!--          overcome numerical instabilities introduced by an insufficient reduction of divergences
-!--          near topography.
-             div = ( ( ( u_comp(k) + gu ) * ( ibit18 + ibit19 + ibit20 )                           &
-                     - ( u(k+1,j,i) + u(k,j,i)   )                                                 &
-                                       * (                                                         &
-                        REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )                       &
-                      + REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp )                       &
-                      + REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp )                       &
-                                         )                                                         &
-                     ) * ddx                                                                       &
-                   + ( ( v_comp(k) + gv ) * ( ibit21 + ibit22 + ibit23 )                           &
-                     - ( v(k+1,j,i) + v(k,j,i)   )                                                 &
-                                       * (                                                         &
-                        REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )                       &
-                      + REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp )                       &
-                      + REAL( IBITS(advc_flags_m(k,j-1,i),23,1), KIND = wp )                       &
-                                         )                                                         &
-                     ) * ddy                                                                       &
-                   + ( w_comp(k)               * rho_air(k+1)                                      &
-                                               * ( ibit24 + ibit25 + ibit26 )                      &
-                   - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k)                                        &
-                                       * (                                                         &
-                        REAL( IBITS(advc_flags_m(k-1,j,i),24,1), KIND = wp )                       &
-                      + REAL( IBITS(advc_flags_m(k-1,j,i),25,1), KIND = wp )                       &
-                      + REAL( IBITS(advc_flags_m(k-1,j,i),26,1), KIND = wp )                       &
-                                         )                                                         &
-                     ) * drho_air_zw(k) * 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    ) ) * drho_air_zw(k) * ddzu(k+1)           &
-                                         ) + div * w(k,j,i)
-#ifndef _OPENACC
-             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)
-#endif
-!
-!--          Statistical Evaluation of w'w'.
-             sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn) +                                          &
-                                    ( flux_t(k)                                                    &
-                                      * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)           )            &
-                                      / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )   )            &
-                                    + diss_t(k)                                                    &
-                                      *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)      )            &
-                                      / ( ABS( w_comp(k) ) + 1.0E-20_wp               )            &
-                                    ) *   weight_substep(intermediate_timestep_count)
-
-          ENDDO
-
-          DO  k = nzb_max_l+1, nzt-1
-
-             flux_d    = flux_t(k-1)
-             diss_d    = diss_t(k-1)
-!
-!--          Calculate the divergence of the velocity field. A respective correction is needed to
-!--          overcome numerical instabilities introduced by an insufficient reduction of divergences
-!--          near topography.
-             div = ( ( u_comp(k) + gu - ( u(k+1,j,i) + u(k,j,i)   ) ) * ddx                        &
-                   + ( v_comp(k) + gv - ( v(k+1,j,i) + v(k,j,i)   ) ) * ddy                        &
-                   + ( w_comp(k)               * rho_air(k+1)                                      &
-                   - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k)                                        &
-                     ) * drho_air_zw(k) * 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    ) ) * drho_air_zw(k) * ddzu(k+1)            &
-                                         ) + div * w(k,j,i)
-#ifndef _OPENACC
-             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)
-#endif
-!
-!--          Statistical Evaluation of w'w'.
-             sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn) +                                          &
-                                    ( flux_t(k)                                                    &
-                                      * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)          )             &
-                                      / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )  )             &
-                                    + diss_t(k)                                                    &
-                                      *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)     )             &
-                                      / ( ABS( w_comp(k) ) + 1.0E-20_wp              )             &
-                                    ) *   weight_substep(intermediate_timestep_count)
-
-          ENDDO
-
-       ENDDO
-    ENDDO
-
-    CALL cpu_log( log_point_s(87), 'advec_w_ws', 'stop' )
-
- END SUBROUTINE advec_w_ws
-
- END MODULE advec_ws
Index: palm/trunk/SOURCE/asselin_filter.f90
===================================================================
--- palm/trunk/SOURCE/asselin_filter.f90	(revision 1)
+++ palm/trunk/SOURCE/asselin_filter.f90	(revision 1)
@@ -0,0 +1,123 @@
+ SUBROUTINE asselin_filter
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! ---------------------
+! $Log: asselin_filter.f90,v $
+! Revision 1.8  2004/01/30 10:14:02  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.7  2003/03/16 09:26:58  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.6  2003/03/14 13:37:38  raasch
+! Do loop constructs only for IBM, otherwise array notation re-introduced
+!
+! Revision 1.5  2002/12/19 13:45:57  raasch
+! Array notation changed to do-loop constructs due to better performance,
+! OpenMP directives added
+!
+! Revision 1.4  2002/05/15 10:00:18  raasch
+! Nothing changed
+!
+! Revision 1.3  2002/05/02  19:39:07  19:39:07  raasch (Siegfried Raasch)
+! Use of module interfaces included
+! 
+! Revision 1.2  2002/05/02 14:06:02  raasch
+! *** empty log message ***
+!
+! Revision 1.1  2002/05/02  13:43:53  13:43:53  raasch (Siegfried Raasch)
+! Initial revision
+! 
+!
+! Description:
+! -------------
+! Time filter needed for the leap-frog method
+!-------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE cpulog 
+    USE indices
+    USE interfaces
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k
+
+
+    CALL cpu_log( log_point(9), 'timefilter', 'start' )
+
+!
+!-- Return to the calling routine, if time filter is not to be applied
+    IF ( asselin_filter_factor == 0.0 )  RETURN
+
+!
+!-- Apply the time filter
+#if defined( __ibm )
+!$OMP PARALLEL PRIVATE (i,j,k)
+!$OMP DO
+    DO  i = nxl-1, nxr+1
+       DO  j = nys-1, nyn+1
+
+          DO  k = nzb_2d(j,i), nzt+1
+             u(k,j,i) = u(k,j,i) + asselin_filter_factor * &
+                                   ( u_p(k,j,i) - 2.0 * u(k,j,i) + u_m(k,j,i) )
+             v(k,j,i) = v(k,j,i) + asselin_filter_factor * &
+                                   ( v_p(k,j,i) - 2.0 * v(k,j,i) + v_m(k,j,i) )
+             w(k,j,i) = w(k,j,i) + asselin_filter_factor * &
+                                   ( w_p(k,j,i) - 2.0 * w(k,j,i) + w_m(k,j,i) )
+          ENDDO
+
+          IF ( scalar_advec /= 'bc-scheme' )  THEN
+             DO  k = nzb_2d(j,i), nzt+1
+                pt(k,j,i) = pt(k,j,i) + asselin_filter_factor * &
+                            ( pt_p(k,j,i) - 2.0 * pt(k,j,i) + pt_m(k,j,i) )
+             ENDDO
+          ENDIF
+
+          IF ( .NOT. constant_diffusion  .AND.  scalar_advec /= 'bc-scheme' ) &
+          THEN
+             DO  k = nzb_2d(j,i), nzt+1
+                e(k,j,i) = e(k,j,i) + asselin_filter_factor * &
+                           ( e_p(k,j,i) - 2.0 * e(k,j,i) + e_m(k,j,i) )
+             ENDDO
+          ENDIF
+
+          IF ( ( moisture .OR. passive_scalar )  .AND. &
+             scalar_advec /= 'bc-scheme' )  THEN
+             DO  k = nzb_2d(j,i), nzt+1
+                q(k,j,i) = q(k,j,i) + asselin_filter_factor * &
+                           ( q_p(k,j,i) - 2.0 * q(k,j,i) + q_m(k,j,i) )
+             ENDDO
+          ENDIF
+
+       ENDDO
+    ENDDO
+!$OMP END PARALLEL
+#else
+    u = u + asselin_filter_factor * ( u_p - 2.0 * u + u_m )
+    v = v + asselin_filter_factor * ( v_p - 2.0 * v + v_m )
+    w = w + asselin_filter_factor * ( w_p - 2.0 * w + w_m )
+
+    IF ( scalar_advec /= 'bc-scheme' )  THEN
+       pt = pt + asselin_filter_factor * ( pt_p - 2.0 * pt + pt_m )
+    ENDIF
+
+    IF ( .NOT. constant_diffusion  .AND.  scalar_advec /= 'bc-scheme' )  THEN
+       e = e + asselin_filter_factor * ( e_p - 2.0 * e + e_m )
+    ENDIF
+
+    IF ( ( moisture .OR. passive_scalar )  .AND. &
+         scalar_advec /= 'bc-scheme' )  THEN
+       q = q + asselin_filter_factor * ( q_p - 2.0 * q + q_m )
+    ENDIF
+#endif
+
+    CALL cpu_log( log_point(9), 'timefilter', 'stop' )
+
+ END SUBROUTINE asselin_filter
Index: palm/trunk/SOURCE/average_3d_data.f90
===================================================================
--- palm/trunk/SOURCE/average_3d_data.f90	(revision 4901)
+++ palm/trunk/SOURCE/average_3d_data.f90	(revision 1)
@@ -1,63 +1,12 @@
-!> @file average_3d_data.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE average_3d_data
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! bugfix: average_count_3d is set to integer 0
-! 
-! 4514 2020-04-30 16:29:59Z suehring
-! Enable output of qsurf and ssurf
-! 
-! 4509 2020-04-26 15:57:55Z raasch
-! file re-formatted to follow the PALM coding standard
-! 
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added,
-! bugfix for call of exchange horiz 2d
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Move 2-m potential temperature output to diagnostic_output_quantities
-! 
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-! 
-! 4048 2019-06-21 21:00:21Z knoop
-! Moved tcm_3d_data_averaging to module_interface
-! 
-! 4039 2019-06-18 10:32:41Z suehring
-! Modularize diagnostic output
-! 
-! 3994 2019-05-22 18:08:09Z suehring
-! output of turbulence intensity added
-! 
-! 3933 2019-04-25 12:33:20Z kanani
-! Bugfix in CASE theta_2m*, removal of redundant code
-! 
-! 3773 2019-03-01 08:56:57Z maronga
-! Added output of theta_2m*_xy_av
-! 
-! 3655 2019-01-07 16:51:22Z knoop
-! Implementation of the PALM module interface
-!
+! $Log: average_3d_data.f90,v $
 ! Revision 1.1  2006/02/23 09:48:58  raasch
 ! Initial revision
@@ -66,39 +15,18 @@
 ! Description:
 ! ------------
-!> Time-averaging of 3d-data-arrays.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE average_3d_data
- 
-
+! Time-averaging of 3d-data-arrays.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
     USE averaging
-
-    USE control_parameters,                                                                        &
-        ONLY:  average_count_3d, doav, doav_n, varnamelength
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_2d
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
-
-    USE kinds
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_3d_data_averaging
-
-
-
+    USE cloud_parameters
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i   !< loop index
-    INTEGER(iwp) ::  ii  !< loop index
-    INTEGER(iwp) ::  j   !< loop index
-    INTEGER(iwp) ::  k   !< loop index
-
-    CHARACTER (LEN=varnamelength) ::  trimvar  !< TRIM of output-variable string
+    INTEGER ::  i, ii, j, k
 
 
@@ -113,350 +41,178 @@
     DO  ii = 1, doav_n
 
-       trimvar = TRIM( doav(ii) )
-
 !
 !--    Store the array chosen on the temporary array.
-       SELECT CASE ( trimvar )
+       SELECT CASE ( TRIM( doav(ii) ) )
 
           CASE ( 'e' )
-             IF ( ALLOCATED( e_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         e_av(k,j,i) = e_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ghf*' )
-             IF ( ALLOCATED( ghf_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      ghf_av(j,i) = ghf_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( ghf_av )
-             ENDIF
-
-          CASE ( 'qsws*' )
-             IF ( ALLOCATED( qsws_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      qsws_av(j,i) = qsws_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( qsws_av )
-             ENDIF
-
-          CASE ( 'thetal' )
-             IF ( ALLOCATED( lpt_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         lpt_av(k,j,i) = lpt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      e_av(k,j,i) = e_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'lwp*' )
-             IF ( ALLOCATED( lwp_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      lwp_av(j,i) = lwp_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-         CASE ( 'ol*' )
-             IF ( ALLOCATED( ol_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      ol_av(j,i) = ol_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( ol_av )
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   lwp_av(j,i) = lwp_av(j,i) / REAL( average_count_3d )
+                ENDDO
+             ENDDO
 
           CASE ( 'p' )
-             IF ( ALLOCATED( p_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         p_av(k,j,i) = p_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      p_av(k,j,i) = p_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'pc' )
-             IF ( ALLOCATED( pc_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         pc_av(k,j,i) = pc_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      pc_av(k,j,i) = pc_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'pr' )
-             IF ( ALLOCATED( pr_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         pr_av(k,j,i) = pr_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'theta' )
-             IF ( ALLOCATED( pt_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         pt_av(k,j,i) = pt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      pr_av(k,j,i) = pr_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'pt' )
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      pt_av(k,j,i) = pt_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'q' )
-             IF ( ALLOCATED( q_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
+             
           CASE ( 'ql' )
-             IF ( ALLOCATED( ql_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'ql_c' )
-             IF ( ALLOCATED( ql_c_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         ql_c_av(k,j,i) = ql_c_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      ql_c_av(k,j,i) = ql_c_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'ql_v' )
-             IF ( ALLOCATED( ql_v_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         ql_v_av(k,j,i) = ql_v_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      ql_v_av(k,j,i) = ql_v_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'ql_vp' )
-             IF ( ALLOCATED( ql_vp_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         ql_vp_av(k,j,i) = ql_vp_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      ql_vp_av(k,j,i) = ql_vp_av(k,j,i) / &
+                                        REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'qv' )
-             IF ( ALLOCATED( qv_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         qv_av(k,j,i) = qv_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-         CASE ( 'qsurf*' )
-             IF ( ALLOCATED( qsurf_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      qsurf_av(j,i) = qsurf_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( qsurf_av )
-             ENDIF
-
-         CASE ( 'r_a*' )
-             IF ( ALLOCATED( r_a_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      r_a_av(j,i) = r_a_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( r_a_av )
-             ENDIF
-
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      qv_av(k,j,i) = qv_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
+             
           CASE ( 's' )
-             IF ( ALLOCATED( s_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         s_av(k,j,i) = s_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-         CASE ( 'shf*' )
-             IF ( ALLOCATED( shf_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      shf_av(j,i) = shf_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( shf_av )
-             ENDIF
-
-          CASE ( 'ssurf*' )
-             IF ( ALLOCATED( ssurf_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      ssurf_av(j,i) = ssurf_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( ssurf_av )
-             ENDIF
-
-          CASE ( 'ssws*' )
-             IF ( ALLOCATED( ssws_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      ssws_av(j,i) = ssws_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( ssws_av )
-             ENDIF
-
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      s_av(k,j,i) = s_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
+             
           CASE ( 't*' )
-             IF ( ALLOCATED( ts_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      ts_av(j,i) = ts_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( ts_av )
-             ENDIF
-
-         CASE ( 'tsurf*' )
-             IF ( ALLOCATED( tsurf_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      tsurf_av(j,i) = tsurf_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( tsurf_av )
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   ts_av(j,i) = ts_av(j,i) / REAL( average_count_3d )
+                ENDDO
+             ENDDO
 
           CASE ( 'u' )
-             IF ( ALLOCATED( u_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'us*' )
-             IF ( ALLOCATED( us_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      us_av(j,i) = us_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( us_av )
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'u*' )
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   us_av(j,i) = us_av(j,i) / REAL( average_count_3d )
+                ENDDO
+             ENDDO
 
           CASE ( 'v' )
-             IF ( ALLOCATED( v_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'thetav' )
-             IF ( ALLOCATED( vpt_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         vpt_av(k,j,i) = vpt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'vpt' )
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      vpt_av(k,j,i) = vpt_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'w' )
-             IF ( ALLOCATED( w_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'z0*' )
-             IF ( ALLOCATED( z0_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      z0_av(j,i) = z0_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( z0_av )
-             ENDIF
-
-          CASE ( 'z0h*' )
-             IF ( ALLOCATED( z0h_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      z0h_av(j,i) = z0h_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( z0h_av )
-             ENDIF
-
-          CASE ( 'z0q*' )
-             IF ( ALLOCATED( z0q_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      z0q_av(j,i) = z0q_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( z0q_av )
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d )
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE DEFAULT
 !
-!--          Averaging of data from all other modules
-             CALL module_interface_3d_data_averaging( 'average', trimvar )
+!--          User-defined quantity
+             CALL user_3d_data_averaging( 'average', doav(ii) )
 
        END SELECT
@@ -466,7 +222,7 @@
 !
 !-- Reset the counter
-    average_count_3d = 0_iwp
-
-    CALL cpu_log( log_point(35), 'average_3d_data', 'stop' )
+    average_count_3d = 0.0
+
+    CALL cpu_log (log_point(35),'average_3d_data','stop','nobarrier')
 
 
Index: palm/trunk/SOURCE/basic_constants_and_equations_mod.f90
===================================================================
--- palm/trunk/SOURCE/basic_constants_and_equations_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,644 +1,0 @@
-!> @file basic_constants_and_equations_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Implement snow and graupel (bulk microphysics)
-! 
-! 4509 2020-04-26 15:57:55Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-!
-! 4400 2020-02-10 20:32:41Z suehring
-! Move routine to transform coordinates from netcdf_interface_mod to
-! basic_constants_and_equations_mod
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4088 2019-07-11 13:57:56Z Giersch
-! Comment of barometric formula improved, function for ideal gas law revised
-!
-! 4084 2019-07-10 17:09:11Z knoop
-! Changed precomputed fractions to be variable based
-!
-! 4055 2019-06-27 09:47:29Z suehring
-! Added rgas_univ (universal gas constant) (E.C. Chan)
-!
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! OpenACC port for SPEC
-! 3361 2018-10-16 20:39:37Z knoop
-! New module (introduced with modularization of bulk cloud physics model)
-!
-!
-!
-!
-! Description:
-! ------------
-!> This module contains all basic (physical) constants and functions for the calculation of
-!> diagnostic quantities.
-!-                    -----------------------------------------------------------------------------!
- MODULE basic_constants_and_equations_mod
-
-
-    USE kinds
-
-    IMPLICIT NONE
-
-
-    REAL(wp), PARAMETER ::  c_p = 1005.0_wp                           !< heat capacity of dry air (J kg-1 K-1)
-    REAL(wp), PARAMETER ::  c_w = 4185.0_wp                           !< heat capacity of water at 0Â°C (J kg-1 K-1)
-    REAL(wp), PARAMETER ::  degc_to_k = 273.15_wp                     !< temperature (in K) of 0 deg C (K)
-    REAL(wp), PARAMETER ::  g = 9.81_wp                               !< gravitational acceleration (m s-2)
-    REAL(wp), PARAMETER ::  kappa = 0.4_wp                            !< von Karman constant
-    REAL(wp), PARAMETER ::  l_m = 0.33E+06_wp                         !< latent heat of water melting (J kg-1)
-    REAL(wp), PARAMETER ::  l_v = 2.5E+06_wp                          !< latent heat of water vaporization (J kg-1)
-    REAL(wp), PARAMETER ::  l_s = l_m + l_v                           !< latent heat of water sublimation (J kg-1)
-    REAL(wp), PARAMETER ::  molecular_weight_of_nacl = 0.05844_wp     !< mol. m. NaCl (kg mol-1)
-    REAL(wp), PARAMETER ::  molecular_weight_of_c3h4o4 = 0.10406_wp   !< mol. m. malonic acid (kg mol-1)
-    REAL(wp), PARAMETER ::  molecular_weight_of_nh4no3 = 0.08004_wp   !< mol. m. ammonium sulfate (kg mol-1)
-    REAL(wp), PARAMETER ::  molecular_weight_of_water = 0.01801528_wp !< mol. m. H2O (kg mol-1)
-    REAL(wp), PARAMETER ::  pi = 3.141592654_wp                       !< PI
-    !$ACC DECLARE COPYIN(pi)
-    REAL(wp), PARAMETER ::  rgas_univ = 8.31446261815324_wp           !< universal gas constant (J K-1 mol-1)
-    REAL(wp), PARAMETER ::  rho_i = 916.7_wp                          !> density of pure ice (kg m-3)
-    REAL(wp), PARAMETER ::  rho_l = 1.0E3_wp                          !< density of water (kg m-3)
-    REAL(wp), PARAMETER ::  rho_nacl = 2165.0_wp                      !< density of NaCl (kg m-3)
-    REAL(wp), PARAMETER ::  rho_c3h4o4 = 1600.0_wp                    !< density of malonic acid (kg m-3)
-    REAL(wp), PARAMETER ::  rho_nh4no3 = 1720.0_wp                    !< density of ammonium sulfate (kg m-3)
-    REAL(wp), PARAMETER ::  r_d = 287.0_wp                            !< sp. gas const. dry air (J kg-1 K-1)
-    REAL(wp), PARAMETER ::  r_v = 461.51_wp                           !< sp. gas const. water vapor (J kg-1 K-1)
-    REAL(wp), PARAMETER ::  sigma_sb = 5.67037E-08_wp                 !< Stefan-Boltzmann constant
-    REAL(wp), PARAMETER ::  solar_constant = 1368.0_wp                !< solar constant at top of atmosphere
-    REAL(wp), PARAMETER ::  vanthoff_nacl = 2.0_wp                    !< van't Hoff factor for NaCl
-    REAL(wp), PARAMETER ::  vanthoff_c3h4o4 = 1.37_wp                 !< van't Hoff factor for malonic acid
-    REAL(wp), PARAMETER ::  vanthoff_nh4no3 = 2.31_wp                 !< van't Hoff factor for ammonium sulfate
-
-    REAL(wp), PARAMETER ::  p_0 = 100000.0_wp                         !< standard pressure reference state
-
-    REAL(wp), PARAMETER ::  cp_d_rd = c_p / r_d   !< precomputed c_p / r_d
-    REAL(wp), PARAMETER ::  g_d_cp  = g   / c_p   !< precomputed g / c_p
-    REAL(wp), PARAMETER ::  lv_d_cp = l_v / c_p   !< precomputed l_v / c_p
-    REAL(wp), PARAMETER ::  ls_d_cp = l_s / c_p   !< precomputed l_s / c_p
-    REAL(wp), PARAMETER ::  lv_d_rd = l_v / r_d   !< precomputed l_v / r_d
-    REAL(wp), PARAMETER ::  rd_d_rv = r_d / r_v   !< precomputed r_d / r_v
-    REAL(wp), PARAMETER ::  rd_d_cp = r_d / c_p   !< precomputed r_d / c_p
-
-    REAL(wp) ::  molecular_weight_of_solute = molecular_weight_of_nacl  !< mol. m. NaCl (kg mol-1)
-    REAL(wp) ::  rho_s = rho_nacl                                       !< density of NaCl (kg m-3)
-    REAL(wp) ::  vanthoff = vanthoff_nacl                               !< van't Hoff factor for NaCl
-
-    SAVE
-
-    PRIVATE magnus_0d,                                                                             &
-            magnus_1d,                                                                             &
-            magnus_tl_0d,                                                                          &
-            magnus_tl_1d,                                                                          &
-            magnus_0d_ice,                                                                         &
-            magnus_1d_ice,                                                                         &
-            ideal_gas_law_rho_0d,                                                                  &
-            ideal_gas_law_rho_1d,                                                                  &
-            ideal_gas_law_rho_pt_0d,                                                               &
-            ideal_gas_law_rho_pt_1d,                                                               &
-            exner_function_0d,                                                                     &
-            exner_function_1d,                                                                     &
-            exner_function_invers_0d,                                                              &
-            exner_function_invers_1d,                                                              &
-            barometric_formula_0d,                                                                 &
-            barometric_formula_1d
-
-
-    INTERFACE convert_utm_to_geographic
-       MODULE PROCEDURE convert_utm_to_geographic
-    END INTERFACE convert_utm_to_geographic
-
-    INTERFACE magnus
-       MODULE PROCEDURE magnus_0d
-       MODULE PROCEDURE magnus_1d
-    END INTERFACE magnus
-
-    INTERFACE magnus_tl
-       MODULE PROCEDURE magnus_tl_0d
-       MODULE PROCEDURE magnus_tl_1d
-    END INTERFACE magnus_tl
-
-    INTERFACE magnus_ice
-       MODULE PROCEDURE magnus_0d_ice
-       MODULE PROCEDURE magnus_1d_ice
-    END INTERFACE magnus_ice
-
-    INTERFACE ideal_gas_law_rho
-       MODULE PROCEDURE ideal_gas_law_rho_0d
-       MODULE PROCEDURE ideal_gas_law_rho_1d
-    END INTERFACE ideal_gas_law_rho
-
-    INTERFACE ideal_gas_law_rho_pt
-       MODULE PROCEDURE ideal_gas_law_rho_pt_0d
-       MODULE PROCEDURE ideal_gas_law_rho_pt_1d
-    END INTERFACE ideal_gas_law_rho_pt
-
-    INTERFACE exner_function
-       MODULE PROCEDURE exner_function_0d
-       MODULE PROCEDURE exner_function_1d
-    END INTERFACE exner_function
-
-    INTERFACE exner_function_invers
-       MODULE PROCEDURE exner_function_invers_0d
-       MODULE PROCEDURE exner_function_invers_1d
-    END INTERFACE exner_function_invers
-
-    INTERFACE barometric_formula
-       MODULE PROCEDURE barometric_formula_0d
-       MODULE PROCEDURE barometric_formula_1d
-    END INTERFACE barometric_formula
-!
-!-- Public routines
-    PUBLIC convert_utm_to_geographic
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Convert UTM coordinates into geographic latitude and longitude. Conversion is based on the work
-!> of KrÃŒger (1912) DOI: 10.2312/GFZ.b103-krueger28 and Karney (2013) DOI: 10.1007/s00190-012-0578-z
-!> Based on a JavaScript of the geodesy function library written by chrisveness
-!> https://github.com/chrisveness/geodesy
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE convert_utm_to_geographic( crs, eutm, nutm, lon, lat )
-
-    INTEGER(iwp) ::  j   !< loop index
-
-    REAL(wp), INTENT(in)  ::  eutm !< easting (UTM)
-    REAL(wp), INTENT(out) ::  lat  !< geographic latitude in degree
-    REAL(wp), INTENT(out) ::  lon  !< geographic longitude in degree
-    REAL(wp), INTENT(in)  ::  nutm !< northing (UTM)
-
-    REAL(wp) ::  a           !< 2*pi*a is the circumference of a meridian
-    REAL(wp) ::  cos_eta_s   !< cos(eta_s)
-    REAL(wp) ::  delta_i     !<
-    REAL(wp) ::  delta_tau_i !<
-    REAL(wp) ::  e           !< eccentricity
-    REAL(wp) ::  eta         !<
-    REAL(wp) ::  eta_s       !<
-    REAL(wp) ::  n           !< 3rd flattening
-    REAL(wp) ::  n2          !< n^2
-    REAL(wp) ::  n3          !< n^3
-    REAL(wp) ::  n4          !< n^4
-    REAL(wp) ::  n5          !< n^5
-    REAL(wp) ::  n6          !< n^6
-    REAL(wp) ::  nu          !<
-    REAL(wp) ::  nu_s        !<
-    REAL(wp) ::  sin_eta_s   !< sin(eta_s)
-    REAL(wp) ::  sinh_nu_s   !< sinush(nu_s)
-    REAL(wp) ::  tau_i       !<
-    REAL(wp) ::  tau_i_s     !<
-    REAL(wp) ::  tau_s       !<
-    REAL(wp) ::  x           !< adjusted easting
-    REAL(wp) ::  y           !< adjusted northing
-
-    REAL(wp), DIMENSION(6) ::  beta !< 6th order KrÃŒger expressions
-
-    REAL(wp), DIMENSION(8), INTENT(in) ::  crs !< coordinate reference system, consists of
-                                               !< (/semi_major_axis,
-                                               !<   inverse_flattening,
-                                               !<   longitude_of_prime_meridian,
-                                               !<   longitude_of_central_meridian,
-                                               !<   scale_factor_at_central_meridian,
-                                               !<   latitude_of_projection_origin,
-                                               !<   false_easting,
-                                               !<   false_northing /)
-
-    x = eutm - crs(7)  ! remove false easting
-    y = nutm - crs(8)  ! remove false northing
-!
-!-- From Karney 2011 Eq 15-22, 36:
-    e = SQRT( 1.0_wp / crs(2) * ( 2.0_wp - 1.0_wp / crs(2) ) )
-    n = 1.0_wp / crs(2) / ( 2.0_wp - 1.0_wp / crs(2) )
-    n2 = n * n
-    n3 = n * n2
-    n4 = n * n3
-    n5 = n * n4
-    n6 = n * n5
-
-    a = crs(1) / ( 1.0_wp + n ) * ( 1.0_wp + 0.25_wp * n2 + 0.015625_wp * n4 + 3.90625E-3_wp * n6 )
-
-    nu  = x / ( crs(5) * a )
-    eta = y / ( crs(5) * a )
-
-!-- According to KrÃŒger (1912), eq. 26*
-    beta(1) =          0.5_wp                  * n                                                 &
-              -        2.0_wp /         3.0_wp * n2                                                &
-              +       37.0_wp /        96.0_wp * n3                                                &
-              -        1.0_wp /       360.0_wp * n4                                                &
-              -       81.0_wp /       512.0_wp * n5                                                &
-              +    96199.0_wp /    604800.0_wp * n6
-
-    beta(2) =          1.0_wp /        48.0_wp * n2                                                &
-              +        1.0_wp /        15.0_wp * n3                                                &
-              -      437.0_wp /      1440.0_wp * n4                                                &
-              +       46.0_wp /       105.0_wp * n5                                                &
-              -  1118711.0_wp /   3870720.0_wp * n6
-
-    beta(3) =         17.0_wp /       480.0_wp * n3                                                &
-              -       37.0_wp /       840.0_wp * n4                                                &
-              -      209.0_wp /      4480.0_wp * n5                                                &
-              +     5569.0_wp /     90720.0_wp * n6
-
-    beta(4) =       4397.0_wp /    161280.0_wp * n4                                                &
-              -       11.0_wp /       504.0_wp * n5                                                &
-              -   830251.0_wp /   7257600.0_wp * n6
-
-    beta(5) =       4583.0_wp /    161280.0_wp * n5                                                &
-              -   108847.0_wp /   3991680.0_wp * n6
-
-    beta(6) =   20648693.0_wp / 638668800.0_wp * n6
-
-    eta_s = eta
-    nu_s  = nu
-    DO  j = 1, 6
-      eta_s = eta_s - beta(j) * SIN(2.0_wp * j * eta) * COSH(2.0_wp * j * nu)
-      nu_s  = nu_s  - beta(j) * COS(2.0_wp * j * eta) * SINH(2.0_wp * j * nu)
-    ENDDO
-
-    sinh_nu_s = SINH( nu_s )
-    sin_eta_s = SIN( eta_s )
-    cos_eta_s = COS( eta_s )
-
-    tau_s = sin_eta_s / SQRT( sinh_nu_s**2 + cos_eta_s**2 )
-
-    tau_i = tau_s
-    delta_tau_i = 1.0_wp
-
-    DO WHILE ( ABS( delta_tau_i ) > 1.0E-12_wp )
-
-      delta_i = SINH( e * ATANH( e * tau_i / SQRT( 1.0_wp + tau_i**2 ) ) )
-
-      tau_i_s = tau_i   * SQRT( 1.0_wp + delta_i**2 ) - delta_i * SQRT( 1.0_wp + tau_i**2 )
-
-      delta_tau_i = ( tau_s - tau_i_s ) / SQRT( 1.0_wp + tau_i_s**2 )                              &
-                    * ( 1.0_wp + ( 1.0_wp - e**2 ) * tau_i**2 )                                    &
-                    / ( ( 1.0_wp - e**2 ) * SQRT( 1.0_wp + tau_i**2 ) )
-
-      tau_i = tau_i + delta_tau_i
-
-    ENDDO
-
-    lat = ATAN( tau_i ) / pi * 180.0_wp
-    lon = ATAN2( sinh_nu_s, cos_eta_s ) / pi * 180.0_wp + crs(4)
-
- END SUBROUTINE convert_utm_to_geographic
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the magnus formula (Press et al., 1992).
-!> The magnus formula is needed to calculate the saturation vapor pressure.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION magnus_0d( t )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN) ::  t  !< temperature (K)
-
-    REAL(wp) ::  magnus_0d
-
-!
-!-- Saturation vapor pressure for a specific temperature:
-    magnus_0d =  611.2_wp * EXP( 17.62_wp * ( t - degc_to_k ) / ( t - 29.65_wp  ) )
-
- END FUNCTION magnus_0d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the magnus formula (Press et al., 1992).
-!> The magnus formula is needed to calculate the saturation vapor pressure.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION magnus_1d( t )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN), DIMENSION(:) ::  t  !< temperature (K)
-
-    REAL(wp), DIMENSION(size(t)) ::  magnus_1d
-
-!
-!-- Saturation vapor pressure for a specific temperature:
-    magnus_1d =  611.2_wp * EXP( 17.62_wp * ( t - degc_to_k ) / ( t - 29.65_wp  ) )
-
- END FUNCTION magnus_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the magnus formula (Press et al., 1992) using the (ice-) liquid water
-!> potential temperature.
-!> The magnus formula is needed to calculate the saturation vapor pressure over a plane liquid water
-!> surface.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION magnus_tl_0d( t_l )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN) ::  t_l  !< liquid water temperature (K)
-
-    REAL(wp) ::  magnus_tl_0d
-
-!
-!-- Saturation vapor pressure for a specific temperature:
-    magnus_tl_0d =  610.78_wp * EXP( 17.269_wp * ( t_l - 273.16_wp ) / ( t_l - 35.86_wp  ) )
-
- END FUNCTION magnus_tl_0d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the magnus formula (Press et al., 1992) using the (ice-) liquid water
-!> potential temperature.
-!> The magnus formula is needed to calculate the saturation vapor pressure over a plane liquid water
-!> surface.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION magnus_tl_1d( t_l )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN), DIMENSION(:) ::  t_l  !< liquid water temperature (K)
-
-    REAL(wp), DIMENSION(size(t_l)) ::  magnus_tl_1d
-!
-!-- Saturation vapor pressure for a specific temperature:
-    magnus_tl_1d =  610.78_wp * EXP( 17.269_wp * ( t_l - 273.16_wp ) / ( t_l - 35.86_wp  ) )
-
- END FUNCTION magnus_tl_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the magnus formula (Press et al., 1992).
-!> The magnus formula is needed to calculate the saturation vapor pressure over a plane ice surface.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION magnus_0d_ice( t )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN) ::  t  !< temperature (K)
-
-    REAL(wp) ::  magnus_0d_ice
-
-!
-!-- Saturation vapor pressure for a specific temperature:
-    !magnus_0d_ice =  611.2_wp * EXP( 22.46_wp * ( t - degc_to_k ) / ( t - 0.53_wp  ) )
-    magnus_0d_ice =  610.78_wp * EXP( 21.875_wp * ( t - degc_to_k ) / ( t - 7.66_wp  ) )
-
-
- END FUNCTION magnus_0d_ice
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the magnus formula (Press et al., 1992).
-!> The magnus formula is needed to calculate the saturation vapor pressure over a plane ice surface.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION magnus_1d_ice( t )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN), DIMENSION(:) ::  t  !< temperature (K)
-
-    REAL(wp), DIMENSION(size(t)) ::  magnus_1d_ice
-
-!
-!-- Saturation vapor pressure for a specific temperature:
-    !magnus_1d_ice =  611.2_wp * EXP( 22.46_wp * ( t - degc_to_k ) / ( t - 0.53_wp  ) )
-    magnus_1d_ice =  610.78_wp * EXP( 21.875_wp * ( t - degc_to_k ) / ( t - 7.66_wp  ) )
-
-
- END FUNCTION magnus_1d_ice
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the ideal gas law for scalar arguments.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION ideal_gas_law_rho_0d( p, t )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN) ::  p  !< pressure (Pa)
-    REAL(wp), INTENT(IN) ::  t  !< temperature (K)
-
-    REAL(wp) ::  ideal_gas_law_rho_0d
-
-!
-!-- Compute density according to ideal gas law:
-    ideal_gas_law_rho_0d = p / (r_d * t)
-
- END FUNCTION ideal_gas_law_rho_0d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the ideal gas law for 1-D array arguments.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION ideal_gas_law_rho_1d( p, t )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN), DIMENSION(:) ::  p  !< pressure (Pa)
-    REAL(wp), INTENT(IN), DIMENSION(:) ::  t  !< temperature (K)
-
-    REAL(wp), DIMENSION(size(p)) ::  ideal_gas_law_rho_1d
-
-!
-!-- Compute density according to ideal gas law:
-    ideal_gas_law_rho_1d = p / (r_d * t)
-
- END FUNCTION ideal_gas_law_rho_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the ideal gas law for scalar arguments.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION ideal_gas_law_rho_pt_0d( p, t )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN) ::  p  !< pressure (Pa)
-    REAL(wp), INTENT(IN) ::  t  !< temperature (K)
-
-    REAL(wp) ::  ideal_gas_law_rho_pt_0d
-
-!
-!-- Compute density according to ideal gas law:
-    ideal_gas_law_rho_pt_0d = p / (r_d * exner_function(p) * t)
-
- END FUNCTION ideal_gas_law_rho_pt_0d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the ideal gas law for 1-D array arguments.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION ideal_gas_law_rho_pt_1d( p, t )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN), DIMENSION(:) ::  p  !< pressure (Pa)
-    REAL(wp), INTENT(IN), DIMENSION(:) ::  t  !< temperature (K)
-
-    REAL(wp), DIMENSION(size(p)) ::  ideal_gas_law_rho_pt_1d
-
-!
-!-- Compute density according to ideal gas law:
-    ideal_gas_law_rho_pt_1d = p / (r_d * exner_function(p) * t)
-
- END FUNCTION ideal_gas_law_rho_pt_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the exner function for scalar arguments.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION exner_function_0d( p )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN) ::  p    !< pressure (Pa)
-
-    REAL(wp) ::  exner_function_0d
-
-!
-!-- Compute exner function:
-    exner_function_0d = ( p / p_0 )**( rd_d_cp )
-
- END FUNCTION exner_function_0d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the exner function for 1-D array arguments.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION exner_function_1d( p )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN), DIMENSION(:) ::  p  !< pressure (Pa)
-
-    REAL(wp), DIMENSION(size(p)) ::  exner_function_1d
-
-!
-!-- Compute exner function:
-    exner_function_1d = ( p / p_0 )**( rd_d_cp )
-
- END FUNCTION exner_function_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the exner function for scalar arguments.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION exner_function_invers_0d( p )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN) ::  p    !< pressure (Pa)
-
-    REAL(wp) ::  exner_function_invers_0d
-
-!
-!-- Compute exner function:
-    exner_function_invers_0d = ( p_0 / p )**( rd_d_cp )
-
- END FUNCTION exner_function_invers_0d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the exner function for 1-D array arguments.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION exner_function_invers_1d( p )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN), DIMENSION(:) ::  p  !< pressure (Pa)
-
-    REAL(wp), DIMENSION(size(p)) ::  exner_function_invers_1d
-
-!
-!-- Compute exner function:
-    exner_function_invers_1d = ( p_0 / p )**( rd_d_cp )
-
- END FUNCTION exner_function_invers_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the barometric formula for scalar arguments. The calculation is based on the assumption
-!> of a polytropic atmosphere and neutral stratification, where the temperature lapse rate is g/cp.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION barometric_formula_0d( z, t_0, p_0)
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN) ::  z    !< height (m)
-    REAL(wp), INTENT(IN) ::  t_0  !< temperature reference state (K)
-    REAL(wp), INTENT(IN) ::  p_0  !< surface pressure (Pa)
-
-    REAL(wp) ::  barometric_formula_0d
-
-!
-!-- Compute barometric formula:
-    barometric_formula_0d =  p_0 * ( (t_0 - g_d_cp * z) / t_0 )**( cp_d_rd )
-
- END FUNCTION barometric_formula_0d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the barometric formula for 1-D array arguments. The calculation is based on the
-!> assumption of a polytropic atmosphere and neutral stratification, where the temperature lapse
-!> rate is g/cp.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION barometric_formula_1d( z, t_0, p_0)
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(IN), DIMENSION(:) ::  z  !< height (m)
-    REAL(wp), INTENT(IN) ::  t_0              !< temperature reference state (K)
-    REAL(wp), INTENT(IN) ::  p_0              !< surface pressure (Pa)
-
-    REAL(wp), DIMENSION(size(z)) ::  barometric_formula_1d
-
-!
-!-- Compute barometric formula:
-    barometric_formula_1d =  p_0 * ( (t_0 - g_d_cp * z) / t_0 )**( cp_d_rd )
-
- END FUNCTION barometric_formula_1d
-
- END MODULE basic_constants_and_equations_mod
Index: palm/trunk/SOURCE/biometeorology_mod.f90
===================================================================
--- palm/trunk/SOURCE/biometeorology_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,4617 +1,0 @@
-!> @file biometeorology_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of PALM-4U.
-!
-! PALM-4U 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-4U 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 2018-2021 Deutscher Wetterdienst (DWD)
-! Copyright 2018-2021 Institute of Computer Science, Academy of Sciences, Prague
-! Copyright 2018-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4807 2020-12-02 21:02:28Z gronemeier
-! Add checks for setup of UV exposure (only workaround!); corrected formatting errors.
-!
-! 4806 2020-12-02 21:00:32Z gronemeier
-! Enable 3D data output also with 64-bit precision
-!
-! 4633 2020-08-05 14:21:14Z suehring
-! Bugfix in check for humidity
-!
-! 4590 2020-07-06 14:34:59Z suehring
-! Enable restart via mpi-IO. Therefore, allocated array mrt_av_grid as 3D array instead of an
-! 1D array.
-!
-! 4577 2020-06-25 09:53:58Z raasch
-! further re-formatting concerning Fortran parameter variables
-!
-! 4540 2020-05-18 15:23:29Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO for reading local arrays
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4493 2020-04-10 09:49:43Z pavelkrc
-! Revise bad formatting
-!
-! 4286 2019-10-30 16:01:14Z resler
-! implement new palm_date_time_mod
-!
-! 4223 2019-09-10 09:20:47Z gronemeier
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4144 2019-08-06 09:11:47Z raasch
-! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
-!
-! 4127 2019-07-30 14:47:10Z suehring
-! Output for bio_mrt added (merge from branch resler)
-!
-! 4126 2019-07-30 11:09:11Z gronemeier
-! renamed vitd3_exposure_av into vitd3_dose,
-! renamed uvem_calc_exposure into bio_calculate_uv_exposure
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3753 2019-02-19 14:48:54Z dom_dwd_user
-! - Added automatic setting of mrt_nlevels in case it was not part of radiation_parameters namelist
-!   (or set to 0 accidentially).
-! - Minor speed improvoemnts in perceived temperature calculations.
-! - Perceived temperature regression arrays now declared as PARAMETERs.
-!
-! 3750 2019-02-19 07:29:39Z dom_dwd_user
-! - Added addittional safety meassures to bio_calculate_thermal_index_maps.
-! - Replaced several REAL (un-)equality comparisons.
-!
-! 3742 2019-02-14 11:25:22Z dom_dwd_user
-! - Allocation of the input _av grids was moved to the "sum" section of bio_3d_data_averaging to
-!   make sure averaging is only done once!
-! - Moved call of bio_calculate_thermal_index_maps from biometeorology module to time_integration to
-!   make sure averaged input is updated before calculating.
-!
-! 3740 2019-02-13 12:35:12Z dom_dwd_user
-! - Added safety-meassure to catch the case that 'bio_mrt_av' is stated after 'bio_<index>' in the
-!   output section of the p3d file.
-!
-! 3739 2019-02-13 08:05:17Z dom_dwd_user
-! - Auto-adjusting thermal_comfort flag if not set by user, but thermal_indices set as output
-!   quantities.
-! - Renamed flags "bio_<index>" to "do_calculate_<index>" for better readability
-! - Removed everything related to "time_bio_results" as this is never used.
-! - Moved humidity warning to check_data_output.
-! - Fixed bug in mrt calculation introduced with my commit yesterday.
-!
-! 3735 2019-02-12 09:52:40Z dom_dwd_user
-! - Fixed auto-setting of thermal index calculation flags by output as originally proposed by
-!   resler.
-! - removed bio_pet and outher configuration variables.
-! - Updated namelist.
-!
-! 3711 2019-01-31 13:44:26Z knoop
-! Introduced interface routine bio_init_checks + small error message changes
-!
-! 3693 2019-01-23 15:20:53Z dom_dwd_user
-! Added usage of time_averaged mean radiant temperature, together with calculation, grid and restart
-! routines. General cleanup and commenting.
-!
-! 3685 2019-01-21 01:02:11Z knoop
-! Some interface calls moved to module_interface + cleanup
-!
-! 3650 2019-01-04 13:01:33Z kanani
-! Bugfixes and additions for enabling restarts with biometeorology
-!
-! 3448 2018-10-29 18:14:31Z kanani
-! Initial revision
-!
-!
-!
-! Authors:
-! --------
-! @author Dominik Froehlich <dominik.froehlich@dwd.de>, thermal indices
-! @author Jaroslav Resler <resler@cs.cas.cz>, mean radiant temperature
-! @author Michael Schrempf <schrempf@muk.uni-hannover.de>, uv exposure
-!
-!
-! Description:
-! ------------
-!> Biometeorology module consisting of two parts:
-!> 1.: Human thermal comfort module calculating thermal perception of a sample human being under the
-!> current meteorological conditions.
-!> 2.: Calculation of vitamin-D weighted UV exposure
-!>
-!> @todo Alphabetical sorting of "USE ..." lists, "ONLY" list, variable declarations
-!>       (per subroutine: first all CHARACTERs, then INTEGERs, LOGICALs, REALs, )
-!> @todo Comments start with capital letter --> "!-- Include..."
-!> @todo uv_vitd3dose-->new output type necessary (cumulative)
-!> @todo consider upwelling radiation in UV
-!> @todo re-design module to work with PALM's module interface and reduce number of workarounds
-!>
-!> @note nothing now
-!>
-!> @bug  checks for proper parameter settings and required input data are missing. Currently
-!<       implemented only by a workaround!
-!--------------------------------------------------------------------------------------------------!
- MODULE biometeorology_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  pt, p, u, v, w, q
-
-    USE averaging,                                                                                 &
-        ONLY:  pt_av, q_av, u_av, v_av, w_av
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY: degc_to_k, c_p, l_v, magnus, pi, sigma_sb
-
-    USE control_parameters,                                                                        &
-        ONLY:  average_count_3d,                                                                   &
-               biometeorology,                                                                     &
-               debug_output,                                                                       &
-               dz,                                                                                 &
-               dz_stretch_factor,                                                                  &
-               dz_stretch_level,                                                                   &
-               humidity,                                                                           &
-               initializing_actions, message_string,                                               &
-               nz_do3d,                                                                            &
-               restart_data_format_output,                                                         &
-               surface_pressure
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, dx, ddy, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nys, nyn, nzb, nzt, nys, nyn, nxl, nxr, nxlg, nxrg, nysg, nyng,           &
-               topo_top_ind
-
-    USE kinds  !< Set precision of INTEGER and REAL arrays according to PALM
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY: building_obstruction_f,                                                              &
-              input_file_uvem,                                                                     &
-              input_pids_uvem,                                                                     &
-              netcdf_data_input_uvem,                                                              &
-              uvem_integration_f,                                                                  &
-              uvem_irradiance_f,                                                                   &
-              uvem_projarea_f,                                                                     &
-              uvem_radiance_f
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  get_date_time
-!
-!-- Import radiation model to obtain input for mean radiant temperature
-    USE radiation_model_mod,                                                                       &
-        ONLY:  id, ix, iy, iz, mrt_include_sw, mrt_nlevels,                                        &
-               mrtbl, mrtinlw, mrtinsw, nmrtbl, radiation,                                         &
-               rad_lw_in, rad_lw_out, rad_sw_in, rad_sw_out, radiation_interactions
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rrd_mpi_io,                                                                         &
-               rd_mpi_io_check_array,                                                              &
-               wrd_mpi_io
-
-
-    IMPLICIT NONE
-
-!
-!-- Declare all global variables within the module (alphabetical order)
-    REAL(wp), PARAMETER ::  bio_fill_value = -9999.0_wp  !< set module fill value, replace by global fill value as soon as available
-    REAL(wp), PARAMETER ::  human_absorb = 0.7_wp  !< SW absorbtivity of a human body (Fanger 1972)
-    REAL(wp), PARAMETER ::  human_emiss = 0.97_wp  !< LW emissivity of a human body after (Fanger 1972)
-
-    INTEGER(iwp) ::  bio_cell_level     !< cell level biom calculates for
-
-    LOGICAL ::  thermal_comfort        = .FALSE.  !< Enables or disables the entire thermal comfort part
-    LOGICAL ::  do_average_theta       = .FALSE.  !< switch: do theta averaging in this module? (if .FALSE. this is done globally)
-    LOGICAL ::  do_average_q           = .FALSE.  !< switch: do e averaging in this module?
-    LOGICAL ::  do_average_u           = .FALSE.  !< switch: do u averaging in this module?
-    LOGICAL ::  do_average_v           = .FALSE.  !< switch: do v averaging in this module?
-    LOGICAL ::  do_average_w           = .FALSE.  !< switch: do w averaging in this module?
-    LOGICAL ::  do_average_mrt         = .FALSE.  !< switch: do mrt averaging in this module?
-    LOGICAL ::  average_trigger_perct  = .FALSE.  !< update averaged input on call to bio_perct?
-    LOGICAL ::  average_trigger_utci   = .FALSE.  !< update averaged input on call to bio_utci?
-    LOGICAL ::  average_trigger_pet    = .FALSE.  !< update averaged input on call to bio_pet?
-    LOGICAL ::  average_trigger_mrt    = .FALSE.  !< update averaged input on call to bio_pet?
-    LOGICAL ::  do_calculate_perct     = .FALSE.  !< Turn index PT (instant. input) on or off
-    LOGICAL ::  do_calculate_perct_av  = .FALSE.  !< Turn index PT (averaged input) on or off
-    LOGICAL ::  do_calculate_pet       = .FALSE.  !< Turn index PET (instant. input) on or off
-    LOGICAL ::  do_calculate_pet_av    = .FALSE.  !< Turn index PET (averaged input) on or off
-    LOGICAL ::  do_calculate_utci      = .FALSE.  !< Turn index UTCI (instant. input) on or off
-    LOGICAL ::  do_calculate_utci_av   = .FALSE.  !< Turn index UTCI (averaged input) on or off
-    LOGICAL ::  do_calculate_mrt2d     = .FALSE.  !< Turn index MRT 2D (averaged or inst) on or off
-
-    REAL(wp)    ::  bio_output_height  !< height output is calculated in m
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  perct      !< PT results   (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pet        !< PET results  (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmrt_grid  !< tmrt results (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  utci       !< UTCI results (degree_C)
-!
-!-- Grids for averaged thermal indices
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  perct_av      !< PT results (aver. input)   (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pet_av        !< PET results (aver. input)  (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmrt_av_grid  !< tmrt results (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  utci_av       !< UTCI results (aver. input) (degree_C)
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  mrt_av_grid   !< time average mean radiant temperature
-
-!
-!-- UVEM parameters from here
-    INTEGER(iwp) ::  ai                      = 0  !< loop index in azimuth direction
-    INTEGER(iwp) ::  bi                      = 0  !< loop index of bit location within an 8bit-integer (one Byte)
-    INTEGER(iwp) ::  bio_nmrtbl
-    INTEGER(iwp) ::  clothing                = 1  !< clothing (0=unclothed, 1=Arms,Hands,Face free, 3=Hand,Face free)
-    INTEGER(iwp) ::  iq                      = 0  !< loop index of irradiance quantity
-    INTEGER(iwp) ::  pobi                    = 0  !< loop index of the position of corresponding byte within ibset byte vektor
-    INTEGER(iwp) ::  obstruction_direct_beam = 0  !< Obstruction information for direct beam
-    INTEGER(iwp) ::  zi                      = 0  !< loop index in zenith direction
-
-    INTEGER(KIND=1), DIMENSION(0:44)  ::  obstruction_temp1 = 0  !< temporary obstruction information stored with ibset
-    INTEGER(iwp),    DIMENSION(0:359) ::  obstruction_temp2 = 0  !< restored temporary obstruction information from ibset file
-
-    INTEGER(iwp), DIMENSION(0:35,0:9) ::  obstruction       = 1  !< final 2D obstruction information array
-
-    LOGICAL ::  consider_obstructions = .TRUE.   !< namelist parameter (see documentation)
-    LOGICAL ::  sun_in_south          = .FALSE.  !< namelist parameter (see documentation)
-    LOGICAL ::  turn_to_sun           = .TRUE.   !< namelist parameter (see documentation)
-    LOGICAL ::  uv_exposure           = .FALSE.  !< namelist parameter (see documentation)
-
-    REAL(wp) ::  diffuse_exposure            =   0.0_wp  !< calculated exposure by diffuse radiation
-    REAL(wp) ::  direct_exposure             =   0.0_wp  !< calculated exposure by direct solar beam
-    REAL(wp) ::  orientation_angle           =   0.0_wp  !< orientation of front/face of the human model
-    REAL(wp) ::  projection_area_direct_beam =   0.0_wp  !< projection area for direct solar beam
-    REAL(wp) ::  saa                         = 180.0_wp  !< solar azimuth angle
-    REAL(wp) ::  startpos_human              =   0.0_wp  !< start value for azimuth interpolation of human geometry array
-    REAL(wp) ::  startpos_saa_float          =   0.0_wp  !< start value for azimuth interpolation of radiance array
-    REAL(wp) ::  sza                         =  20.0_wp  !< solar zenith angle
-    REAL(wp) ::  xfactor                     =   0.0_wp  !< relative x-position used for interpolation
-    REAL(wp) ::  yfactor                     =   0.0_wp  !< relative y-position used for interpolation
-
-    REAL(wp), DIMENSION(0:2)  ::  irradiance =   0.0_wp  !< iradiance values extracted from irradiance lookup table
-
-    REAL(wp), DIMENSION(0:2,0:90) ::  irradiance_lookup_table      = 0.0_wp  !< irradiance lookup table
-    REAL(wp), DIMENSION(0:35,0:9) ::  integration_array            = 0.0_wp  !< solid angle factors for hemispherical integration
-    REAL(wp), DIMENSION(0:35,0:9) ::  projection_area              = 0.0_wp  !< projection areas of a human (all directions)
-    REAL(wp), DIMENSION(0:35,0:9) ::  projection_area_lookup_table = 0.0_wp  !< human geometry lookup table (projection areas)
-    REAL(wp), DIMENSION(0:71,0:9) ::  projection_area_direct_temp  = 0.0_wp  !< temporary projection area for direct solar beam
-    REAL(wp), DIMENSION(0:71,0:9) ::  projection_area_temp         = 0.0_wp  !< temporary projection area for all directions
-    REAL(wp), DIMENSION(0:35,0:9) ::  radiance_array               = 0.0_wp  !< radiance extracted from radiance_lookup_table
-    REAL(wp), DIMENSION(0:71,0:9) ::  radiance_array_temp          = 0.0_wp  !< temporary radiance data
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vitd3_exposure  !< result variable for instantaneous vitamin-D weighted exposures
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vitd3_dose      !< result variable for summation of vitamin-D weighted exposures
-
-    REAL(wp), DIMENSION(0:35,0:9,0:90) ::  radiance_lookup_table   = 0.0_wp  !< radiance lookup table
-
-
-    PRIVATE
-
-!
-!-- INTERFACES that must be available to other modules (alphabetical order)
-    PUBLIC bio_3d_data_averaging,  bio_calculate_mrt_grid, bio_calculate_thermal_index_maps,       &
-           bio_calc_ipt, bio_check_data_output, bio_check_parameters,                              &
-           bio_data_output_2d, bio_data_output_3d,  bio_define_netcdf_grid,                        &
-           bio_get_thermal_index_input_ij, bio_header, bio_init, bio_init_checks, bio_nmrtbl,      &
-           bio_parin, bio_rrd_global, bio_rrd_local, bio_wrd_global, bio_wrd_local, thermal_comfort
-!
-!-- UVEM PUBLIC variables and methods
-    PUBLIC bio_calculate_uv_exposure, uv_exposure
-
-!
-!-- PALM interfaces:
-!
-!-- 3D averaging for HTCM _INPUT_ variables
-    INTERFACE bio_3d_data_averaging
-       MODULE PROCEDURE bio_3d_data_averaging
-    END INTERFACE bio_3d_data_averaging
-!
-!-- Calculate mtr from rtm fluxes and assign into 2D grid
-    INTERFACE bio_calculate_mrt_grid
-       MODULE PROCEDURE bio_calculate_mrt_grid
-    END INTERFACE bio_calculate_mrt_grid
-!
-!-- Calculate static thermal indices PT, UTCI and/or PET
-    INTERFACE bio_calculate_thermal_index_maps
-       MODULE PROCEDURE bio_calculate_thermal_index_maps
-    END INTERFACE bio_calculate_thermal_index_maps
-!
-!-- Calculate the dynamic index iPT (to be caled by the agent model)
-    INTERFACE bio_calc_ipt
-       MODULE PROCEDURE bio_calc_ipt
-    END INTERFACE bio_calc_ipt
-!
-!-- Data output checks for 2D/3D data to be done in check_parameters
-    INTERFACE bio_check_data_output
-       MODULE PROCEDURE bio_check_data_output
-    END INTERFACE bio_check_data_output
-!
-!-- Input parameter checks to be done in check_parameters
-    INTERFACE bio_check_parameters
-       MODULE PROCEDURE bio_check_parameters
-    END INTERFACE bio_check_parameters
-!
-!-- Data output of 2D quantities
-    INTERFACE bio_data_output_2d
-       MODULE PROCEDURE bio_data_output_2d
-    END INTERFACE bio_data_output_2d
-!
-!-- no 3D data, thus, no averaging of 3D data, removed
-    INTERFACE bio_data_output_3d
-       MODULE PROCEDURE bio_data_output_3d
-    END INTERFACE bio_data_output_3d
-!
-!-- Definition of data output quantities
-    INTERFACE bio_define_netcdf_grid
-       MODULE PROCEDURE bio_define_netcdf_grid
-    END INTERFACE bio_define_netcdf_grid
-!
-!-- Obtains all relevant input values to estimate local thermal comfort/stress
-    INTERFACE bio_get_thermal_index_input_ij
-       MODULE PROCEDURE bio_get_thermal_index_input_ij
-    END INTERFACE bio_get_thermal_index_input_ij
-!
-!-- Output of information to the header file
-    INTERFACE bio_header
-       MODULE PROCEDURE bio_header
-    END INTERFACE bio_header
-!
-!-- Initialization actions
-    INTERFACE bio_init
-       MODULE PROCEDURE bio_init
-    END INTERFACE bio_init
-!
-!-- Initialization checks
-    INTERFACE bio_init_checks
-       MODULE PROCEDURE bio_init_checks
-    END INTERFACE bio_init_checks
-!
-!-- Reading of NAMELIST parameters
-    INTERFACE bio_parin
-       MODULE PROCEDURE bio_parin
-    END INTERFACE bio_parin
-!
-!-- Read global restart parameters
-    INTERFACE bio_rrd_global
-       MODULE PROCEDURE bio_rrd_global_ftn
-       MODULE PROCEDURE bio_rrd_global_mpi
-    END INTERFACE bio_rrd_global
-!
-!-- Read local restart parameters
-    INTERFACE bio_rrd_local
-       MODULE PROCEDURE bio_rrd_local_ftn
-       MODULE PROCEDURE bio_rrd_local_mpi
-    END INTERFACE bio_rrd_local
-!
-!-- Write global restart parameters
-    INTERFACE bio_wrd_global
-       MODULE PROCEDURE bio_wrd_global
-    END INTERFACE bio_wrd_global
-!
-!-- Write local restart parameters
-    INTERFACE bio_wrd_local
-       MODULE PROCEDURE bio_wrd_local
-    END INTERFACE bio_wrd_local
-!
-!-- Calculate UV exposure grid
-    INTERFACE bio_calculate_uv_exposure
-       MODULE PROCEDURE bio_calculate_uv_exposure
-    END INTERFACE bio_calculate_uv_exposure
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sum up and time-average biom input quantities as well as allocate the array necessary for storing
-!> the average.
-!> There is a considerable difference to the 3d_data_averaging subroutines used by other modules:
-!> For the thermal indices, the module needs to average the input conditions, not the result!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_3d_data_averaging( mode, variable )
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  mode     !< Averaging mode: allocate, sum, or average
-    CHARACTER (LEN=*) ::  variable !< The variable in question
-
-    INTEGER(iwp) ::  i        !< Running index, x-direction
-    INTEGER(iwp) ::  j        !< Running index, y-direction
-    INTEGER(iwp) ::  k        !< Running index, z-direction
-    INTEGER(iwp) ::  l        !< index used to link radiation arrays to 3d grid arrays
-
-
-    IF ( mode == 'allocate' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'bio_mrt' )
-
-                IF ( .NOT. ALLOCATED( mrt_av_grid ) )  THEN
-                   ALLOCATE( mrt_av_grid(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                mrt_av_grid = 0.0_wp
-                do_average_mrt = .FALSE.  !< Overwrite if that was enabled somehow
-
-
-          CASE ( 'bio_perct*', 'bio_utci*', 'bio_pet*', 'bio_mrt*' )
-
-!
-!--          Averaging, as well as the allocation of the required grids must be done only once,
-!--          independent of for how many thermal indices averaged output is desired.
-!--          Therefore we need to memorize which index is the one that controls the averaging
-!--          (what must be the first thermal index called).
-!--          Indices are in unknown order as depending on the input file, determine first index to
-!--          average und update only once.
-!
-!--          Only proceed here if this was not done for any index before. This is done only once
-!--          during the whole model run.
-             IF ( .NOT. average_trigger_perct  .AND.                                               &
-                  .NOT. average_trigger_utci   .AND.                                               &
-                  .NOT. average_trigger_pet    .AND.                                               &
-                  .NOT. average_trigger_mrt )  THEN
-!
-!--             Memorize the first index called to control averaging
-                IF ( TRIM( variable ) == 'bio_perct*' )  THEN
-                    average_trigger_perct = .TRUE.
-                ENDIF
-                IF ( TRIM( variable ) == 'bio_utci*' )  THEN
-                    average_trigger_utci = .TRUE.
-                ENDIF
-                IF ( TRIM( variable ) == 'bio_pet*' )  THEN
-                    average_trigger_pet = .TRUE.
-                ENDIF
-                IF ( TRIM( variable ) == 'bio_mrt*' )  THEN
-                    average_trigger_mrt = .TRUE.
-                ENDIF
-             ENDIF
-!
-!--          Allocation of the input _av grids was moved to the "sum" section to make sure averaging
-!--          is only done once!
-
-          CASE ( 'uvem_vitd3dose*' )
-
-             IF ( .NOT. ALLOCATED( vitd3_dose ) )  THEN
-                ALLOCATE( vitd3_dose(nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             vitd3_dose = 0.0_wp
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'sum' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'bio_mrt' )
-!
-!--          Consider the case 'bio_mrt' is called after some thermal index. In that case
-!            do_average_mrt will be .TRUE. leading to a double-averaging.
-             IF ( .NOT. do_average_mrt  .AND.  ALLOCATED( mrt_av_grid ) )  THEN
-
-                IF ( mrt_include_sw )  THEN
-                   DO  l = 1, nmrtbl
-                      i = mrtbl(ix,l)
-                      j = mrtbl(iy,l)
-                      k = mrtbl(iz,l)
-                      mrt_av_grid(k,j,i) = mrt_av_grid(k,j,i)  +                                   &
-                                    ( ( human_absorb * mrtinsw(l) +                                &
-                                    mrtinlw(l) ) / ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k
-                   ENDDO
-                ELSE
-                   DO  l = 1, nmrtbl
-                      i = mrtbl(ix,l)
-                      j = mrtbl(iy,l)
-                      k = mrtbl(iz,l)
-                      mrt_av_grid(k,j,i) = mrt_av_grid(k,j,i)  +                                   &
-                                    ( mrtinlw(l) / ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k
-                   ENDDO
-                ENDIF
-             ENDIF
-
-          CASE ( 'bio_perct*', 'bio_utci*', 'bio_pet*', 'bio_mrt*' )
-!
-!--          Only continue if the current index is the one to trigger the input averaging, see
-!--          above.
-             IF ( average_trigger_perct  .AND.  TRIM( variable ) /= 'bio_perct*')    RETURN
-             IF ( average_trigger_utci   .AND.  TRIM( variable ) /= 'bio_utci*' )    RETURN
-             IF ( average_trigger_pet    .AND.  TRIM( variable ) /= 'bio_pet*'  )    RETURN
-             IF ( average_trigger_mrt    .AND.  TRIM( variable ) /= 'bio_mrt*'  )    RETURN
-!
-!--          Now memorize which of the input grids are not averaged by other modules. Set averaging
-!--          switch to .TRUE. and allocate the respective grid in that case.
-             IF ( .NOT. ALLOCATED( pt_av ) )  THEN  !< if not averaged by other module
-                ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                do_average_theta = .TRUE.  !< memorize, that bio is responsible
-                pt_av = 0.0_wp
-             ENDIF
-             IF ( ALLOCATED( pt_av )  .AND.  do_average_theta )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( .NOT. ALLOCATED( q_av ) )  THEN
-                ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                do_average_q = .TRUE.
-                q_av = 0.0_wp
-             ENDIF
-             IF ( ALLOCATED( q_av )  .AND.  do_average_q )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-!
-!--          u_av, v_av and w_av are always allocated
-             IF ( .NOT. ALLOCATED( u_av ) )  THEN
-                ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                do_average_u = .TRUE.
-                u_av = 0.0_wp
-             ENDIF
-             IF ( ALLOCATED( u_av )  .AND.  do_average_u )  THEN
-                DO  i = nxlg, nxrg       !< yes, ghost points are required here!
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( .NOT. ALLOCATED( v_av ) )  THEN
-                ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                do_average_v = .TRUE.
-                v_av = 0.0_wp
-             ENDIF
-             IF ( ALLOCATED( v_av )  .AND.  do_average_v )  THEN
-                DO  i = nxlg, nxrg       !< yes, ghost points are required here!
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( .NOT. ALLOCATED( w_av ) )  THEN
-                ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                do_average_w = .TRUE.
-                w_av = 0.0_wp
-             ENDIF
-             IF ( ALLOCATED( w_av )  .AND.  do_average_w )  THEN
-                DO  i = nxlg, nxrg       !< yes, ghost points are required here!
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( .NOT. ALLOCATED( mrt_av_grid ) )  THEN
-                ALLOCATE( mrt_av_grid(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                do_average_mrt = .TRUE.
-                mrt_av_grid = 0.0_wp
-             ENDIF
-             IF ( ALLOCATED( mrt_av_grid )  .AND.  do_average_mrt )  THEN
-
-                IF ( mrt_include_sw )  THEN
-                   DO  l = 1, nmrtbl
-                      i = mrtbl(ix,l)
-                      j = mrtbl(iy,l)
-                      k = mrtbl(iz,l)
-                      mrt_av_grid(k,j,i) = mrt_av_grid(k,j,i)  +                                   &
-                                    ( ( human_absorb * mrtinsw(l) +                                &
-                                    mrtinlw(l) ) /                                                 &
-                                      ( human_emiss  * sigma_sb ) )**0.25_wp - degc_to_k
-                   ENDDO
-                ELSE
-                   DO  l = 1, nmrtbl
-                      i = mrtbl(ix,l)
-                      j = mrtbl(iy,l)
-                      k = mrtbl(iz,l)
-                      mrt_av_grid(k,j,i) = mrt_av_grid(k,j,i) +                                    &
-                                    ( mrtinlw(l) /                                                 &
-                                    ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k
-                   ENDDO
-                ENDIF
-             ENDIF
-!
-!--       This is a cumulated dose. No mode == 'average' for this quantity.
-          CASE ( 'uvem_vitd3dose*' )
-             IF ( ALLOCATED( vitd3_dose ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      vitd3_dose(j,i) = vitd3_dose(j,i) + vitd3_exposure(j,i)
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'average' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'bio_mrt' )
-!
-!--          Consider the case 'bio_mrt' is called after some thermal index. In that case
-!--          do_average_mrt will be .TRUE. leading to a double-averaging.
-             IF ( .NOT. do_average_mrt  .AND.  ALLOCATED( mrt_av_grid ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         mrt_av_grid(k,j,i) = mrt_av_grid(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'bio_perct*', 'bio_utci*', 'bio_pet*', 'bio_mrt*' )
-!
-!--          Only continue if update index, see above
-             IF ( average_trigger_perct  .AND.                                                     &
-                TRIM( variable ) /= 'bio_perct*' )  RETURN
-             IF ( average_trigger_utci  .AND.                                                      &
-                TRIM( variable ) /= 'bio_utci*' )  RETURN
-             IF ( average_trigger_pet   .AND.                                                      &
-                TRIM( variable ) /= 'bio_pet*' )  RETURN
-             IF ( average_trigger_mrt   .AND.                                                      &
-                TRIM( variable ) /= 'bio_mrt*' )  RETURN
-
-             IF ( ALLOCATED( pt_av )  .AND.  do_average_theta )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         pt_av(k,j,i) = pt_av(k,j,i) /  REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( ALLOCATED( q_av )  .AND.  do_average_q )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( ALLOCATED( u_av )  .AND.  do_average_u )  THEN
-                DO  i = nxlg, nxrg       !< yes, ghost points are required here!
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( ALLOCATED( v_av )  .AND.  do_average_v )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( ALLOCATED( w_av )  .AND.  do_average_w )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( ALLOCATED( mrt_av_grid )  .AND.  do_average_mrt )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         mrt_av_grid(k,j,i) = mrt_av_grid(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-!
-!--     No averaging for UVEM since we are calculating a dose (only sum is calculated and saved to
-!--     av.nc file)
-        END SELECT
-
-    ENDIF
-
-
- END SUBROUTINE bio_3d_data_averaging
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output for biometeorology model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_check_data_output( var, unit, i, j, ilen, k )
-
-    USE control_parameters,                                                                        &
-        ONLY: data_output, message_string
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  unit     !< The unit for the variable var
-    CHARACTER (LEN=*) ::  var      !< The variable in question
-
-    INTEGER(iwp), INTENT(IN) ::  i     !< Current element of data_output
-    INTEGER(iwp), INTENT(IN) ::  j     !< Average quantity? 0 = no, 1 = yes
-    INTEGER(iwp), INTENT(IN) ::  ilen  !< Length of current entry in data_output
-    INTEGER(iwp), INTENT(IN) ::  k     !< Output is xy mode? 0 = no, 1 = yes
-
-    SELECT CASE ( TRIM( var ) )
-!
-!--    Allocate a temporary array with the desired output dimensions.
-!--    Arrays for time-averaged thermal indices are also allocated here because they are not running
-!--    through the standard averaging procedure in bio_3d_data_averaging as the values of the
-!--    averaged thermal indices are derived in a single step based on priorly averaged arrays (see
-!--    bio_calculate_thermal_index_maps).
-       CASE ( 'bio_mrt', 'bio_mrt*' )
-          unit = 'degree_C'
-          thermal_comfort = .TRUE.  !< enable thermal_comfort if user forgot to do so
-          IF ( .NOT. ALLOCATED( tmrt_grid ) )  THEN
-             ALLOCATE( tmrt_grid (nys:nyn,nxl:nxr) )
-             tmrt_grid = REAL( bio_fill_value, KIND = wp )
-          ENDIF
-          IF ( TRIM( var ) == 'bio_mrt*' )  THEN
-             do_calculate_mrt2d = .TRUE.
-          END IF
-
-       CASE ( 'bio_perct*' )
-          unit = 'degree_C'
-          thermal_comfort = .TRUE.
-          IF ( j == 0 )  THEN                !< if instantaneous input
-             do_calculate_perct = .TRUE.
-             IF ( .NOT. ALLOCATED( perct ) )  THEN
-                ALLOCATE( perct (nys:nyn,nxl:nxr) )
-                perct = REAL( bio_fill_value, KIND = wp )
-             ENDIF
-          ELSE                               !< if averaged input
-             do_calculate_perct_av = .TRUE.
-             IF ( .NOT. ALLOCATED( perct_av ) )  THEN
-                ALLOCATE( perct_av (nys:nyn,nxl:nxr) )
-                perct_av = REAL( bio_fill_value, KIND = wp )
-             ENDIF
-          ENDIF
-
-       CASE ( 'bio_utci*' )
-          unit = 'degree_C'
-          thermal_comfort = .TRUE.
-          IF ( j == 0 )  THEN
-             do_calculate_utci = .TRUE.
-             IF ( .NOT. ALLOCATED( utci ) )  THEN
-                ALLOCATE( utci (nys:nyn,nxl:nxr) )
-                utci = REAL( bio_fill_value, KIND = wp )
-             ENDIF
-          ELSE
-             do_calculate_utci_av = .TRUE.
-             IF ( .NOT. ALLOCATED( utci_av ) )  THEN
-                ALLOCATE( utci_av (nys:nyn,nxl:nxr) )
-                utci_av = REAL( bio_fill_value, KIND = wp )
-             ENDIF
-          ENDIF
-
-       CASE ( 'bio_pet*' )
-          unit = 'degree_C'
-          thermal_comfort = .TRUE.
-          IF ( j == 0 )  THEN
-             do_calculate_pet = .TRUE.
-             IF ( .NOT. ALLOCATED( pet ) )  THEN
-                ALLOCATE( pet (nys:nyn,nxl:nxr) )
-                pet = REAL( bio_fill_value, KIND = wp )
-             ENDIF
-          ELSE
-             do_calculate_pet_av = .TRUE.
-             IF ( .NOT. ALLOCATED( pet_av ) )  THEN
-                ALLOCATE( pet_av (nys:nyn,nxl:nxr) )
-                pet_av = REAL( bio_fill_value, KIND = wp )
-             ENDIF
-          ENDIF
-
-
-       CASE ( 'uvem_vitd3*' )
-          IF ( .NOT. uv_exposure )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requires uv_exposure = .TRUE.' // &
-                              '&in namelist "biometeorology_parameters"'
-             CALL message( 'uvem_check_data_output', 'PA0512', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
-             message_string = 'illegal value for data_output: "' //                                &
-                              TRIM( var ) // '" & only 2d-horizontal ' //                          &
-                              'cross sections are allowed for this value'
-             CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
-          ENDIF
-          unit = 'IU/s'
-          IF ( .NOT. ALLOCATED( vitd3_exposure ) )  THEN
-             ALLOCATE( vitd3_exposure(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          vitd3_exposure = 0.0_wp
-
-       CASE ( 'uvem_vitd3dose*' )
-          IF (  .NOT.  uv_exposure )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requires uv_exposure = .TRUE.' // &
-                              '&in namelist "biometeorology_parameters"'
-             CALL message( 'uvem_check_data_output', 'PA0512', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
-             message_string = 'illegal value for data_output: "' //                                &
-                              TRIM( var ) // '" & only 2d-horizontal ' //                          &
-                              'cross sections are allowed for this value'
-             CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
-          ENDIF
-          unit = 'IU/av-h'
-          IF ( .NOT. ALLOCATED( vitd3_dose ) )  THEN
-             ALLOCATE( vitd3_dose(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          vitd3_dose = 0.0_wp
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-!
-!-- Further checks if thermal comfort output is desired.
-    IF ( thermal_comfort  .AND.  unit(1:6) == 'degree' )  THEN
-!
-!--    Break if required modules "radiation" is not available.
-       IF ( .NOT.  radiation )  THEN
-          message_string = 'output of "' // TRIM( var ) // '" require' // 's radiation = .TRUE.'
-          CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
-          unit = 'illegal'
-       ENDIF
-!
-!--    All "thermal_comfort" outputs except from 'bio_mrt' will also need  humidity input. Check
-!--    also for that.
-       IF ( TRIM( var ) /= 'bio_mrt' )  THEN
-          IF ( .NOT.  humidity )  THEN
-             message_string = 'The estimation of thermal comfort '    //                           &
-                              'requires air humidity information, but ' //                         &
-                              'humidity module is disabled!'
-             CALL message( 'check_parameters', 'PA0561', 1, 2, 0, 6, 0 )
-             unit = 'illegal'
-          ENDIF
-       ENDIF
-
-
-    ENDIF
-
- END SUBROUTINE bio_check_data_output
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for biom module
-!> Currently unused but might come in handy for future checks?
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_check_parameters
-
-
-    IMPLICIT NONE
-
-!
-!-- Check settings for UV exposure part
-    IF ( uv_exposure )  THEN
-
-!
-!--    Input file not present
-       IF ( .NOT. input_pids_uvem )  THEN
-          WRITE( message_string, * ) 'uv_exposure = .TRUE. but input file "' //                    &
-                                     TRIM( input_file_uvem ) // '" is not present.&' //            &
-                                     'Calculating UV exposure impossible.'
-          CALL message( 'bio_check_parameters', 'PA0513', 1, 2, 0, 6, 0 )
-       ELSE
-
-!
-!--       Required variables not given in input file
-          IF ( .NOT. uvem_integration_f%from_file  .OR.  .NOT. uvem_irradiance_f%from_file  .OR.   &
-               .NOT. uvem_projarea_f%from_file  .OR.  .NOT. uvem_radiance_f%from_file )  THEN
-             WRITE( message_string, * ) 'uv_exposure = .TRUE. but one or more required input ' //  &
-                                        'varaibles are not present in file "' //                   &
-                                        TRIM( input_file_uvem ) // '".&' //                        &
-                                        'Calculating UV exposure impossible.'
-             CALL message( 'bio_check_parameters', 'PA0514', 1, 2, 0, 6, 0 )
-          ENDIF
-
-!
-!--       Obstruction requested but not given
-          IF ( consider_obstructions  .AND.  .NOT. building_obstruction_f%from_file )  THEN
-             WRITE( message_string, * ) 'consider_obstructions = .TRUE. but varaible ' //          &
-                                        '"obstruction" is not present in file "' //                &
-                                        TRIM( input_file_uvem ) // '".&' //                        &
-                                        'Calculating UV exposure impossible.'
-             CALL message( 'bio_check_parameters', 'PA0515', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-
- END SUBROUTINE bio_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining 2D output variables
-!> data_output_2d 1188ff
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_data_output_2d( av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do)
-
-
-    USE kinds
-
-
-    IMPLICIT NONE
-!
-!-- Input variables
-    CHARACTER (LEN=*), INTENT(IN) ::  variable    !< Char identifier to select var for output
-    INTEGER(iwp), INTENT(IN)      ::  av          !< Use averaged data? 0 = no, 1 = yes?
-    INTEGER(iwp), INTENT(IN)      ::  nzb_do      !< Unused. 2D. nz bottom to nz top
-    INTEGER(iwp), INTENT(IN)      ::  nzt_do      !< Unused.
-!
-!-- Output variables
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid   !< Grid type (always "zu1" for biom)
-
-    LOGICAL, INTENT(OUT)           ::  found  !< Output found?
-    LOGICAL, INTENT(OUT)           ::  two_d  !< Flag parameter that indicates 2D variables,
-                                              !< horizontal cross sections, must be .TRUE. for thermal indices and uv
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< Temp. result grid to return
-!
-!-- Internal variables
-    INTEGER(iwp) ::  i        !< Running index, x-dir
-    INTEGER(iwp) ::  j        !< Running index, y-dir
-    INTEGER(iwp) ::  k        !< Running index, z-dir
-    INTEGER(iwp) ::  l        !< Running index, radiation grid
-
-
-    found = .TRUE.
-    local_pf = bio_fill_value
-
-    SELECT CASE ( TRIM( variable ) )
-
-
-        CASE ( 'bio_mrt_xy' )
-           grid = 'zu1'
-           two_d = .FALSE.  !< can be calculated for several levels
-           local_pf = REAL( bio_fill_value, KIND = wp )
-           DO  l = 1, nmrtbl
-              i = mrtbl(ix,l)
-              j = mrtbl(iy,l)
-              k = mrtbl(iz,l)
-              IF ( k < nzb_do  .OR.  k > nzt_do  .OR.  j < nys  .OR.                               &
-                 j > nyn  .OR.  i < nxl  .OR.  i > nxr )  CYCLE
-              IF ( av == 0 )  THEN
-                 IF ( mrt_include_sw )  THEN
-                    local_pf(i,j,k) = ( ( human_absorb * mrtinsw(l) +                              &
-                                      mrtinlw(l) ) /                                               &
-                                      ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k
-                 ELSE
-                    local_pf(i,j,k) = ( mrtinlw(l) /                                               &
-                                      ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k
-                 ENDIF
-              ELSE
-                 local_pf(i,j,k) = mrt_av_grid(k,j,i)
-              ENDIF
-           ENDDO
-
-        CASE ( 'bio_mrt*_xy' )        ! 2d-array
-           grid = 'zu1'
-           two_d = .TRUE.
-           IF ( av == 0 )  THEN
-              DO  i = nxl, nxr
-                 DO  j = nys, nyn
-                    local_pf(i,j,nzb+1) = tmrt_grid(j,i)
-                 ENDDO
-              ENDDO
-           ELSE
-              DO  i = nxl, nxr
-                 DO  j = nys, nyn
-                    local_pf(i,j,nzb+1) = tmrt_av_grid(j,i)
-                 ENDDO
-              ENDDO
-           ENDIF
-
-
-        CASE ( 'bio_perct*_xy' )        ! 2d-array
-           grid = 'zu1'
-           two_d = .TRUE.
-           IF ( av == 0 )  THEN
-              DO  i = nxl, nxr
-                 DO  j = nys, nyn
-                    local_pf(i,j,nzb+1) = perct(j,i)
-                 ENDDO
-              ENDDO
-           ELSE
-              DO  i = nxl, nxr
-                 DO  j = nys, nyn
-                    local_pf(i,j,nzb+1) = perct_av(j,i)
-                 ENDDO
-              ENDDO
-           ENDIF
-
-
-        CASE ( 'bio_utci*_xy' )        ! 2d-array
-           grid = 'zu1'
-           two_d = .TRUE.
-           IF ( av == 0 )  THEN
-              DO  i = nxl, nxr
-                 DO  j = nys, nyn
-                    local_pf(i,j,nzb+1) = utci(j,i)
-                 ENDDO
-              ENDDO
-           ELSE
-              DO  i = nxl, nxr
-                 DO  j = nys, nyn
-                    local_pf(i,j,nzb+1) = utci_av(j,i)
-                 ENDDO
-              ENDDO
-           ENDIF
-
-
-        CASE ( 'bio_pet*_xy' )        ! 2d-array
-           grid = 'zu1'
-           two_d = .TRUE.
-           IF ( av == 0 )  THEN
-              DO  i = nxl, nxr
-                 DO  j = nys, nyn
-                    local_pf(i,j,nzb+1) = pet(j,i)
-                 ENDDO
-              ENDDO
-           ELSE
-              DO  i = nxl, nxr
-                 DO  j = nys, nyn
-                    local_pf(i,j,nzb+1) = pet_av(j,i)
-                 ENDDO
-              ENDDO
-           ENDIF
-
-!
-!--    Before data is transfered to local_pf, transfer is in 2D dummy variable and exchange ghost
-!--    points therein. However, at this point this is only required for instantaneous arrays,
-!--    time-averaged quantities are already exchanged.
-       CASE ( 'uvem_vitd3*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = vitd3_exposure(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'uvem_vitd3dose*_xy' )        ! 2d-array
-          IF ( av == 1 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = vitd3_dose(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-
-       CASE DEFAULT
-          found = .FALSE.
-          grid  = 'none'
-
-    END SELECT
-
-
- END SUBROUTINE bio_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining 3D output variables (dummy, always 2d!)
-!> data_output_3d 709ff
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-
-    USE indices
-
-    USE kinds
-
-
-    IMPLICIT NONE
-!
-!-- Input variables
-    CHARACTER (LEN=*), INTENT(IN) ::  variable   !< Char identifier to select var for output
-
-    INTEGER(iwp), INTENT(IN) ::  av       !< Use averaged data? 0 = no, 1 = yes?
-    INTEGER(iwp), INTENT(IN) ::  nzb_do   !< Unused. 2D. nz bottom to nz top
-    INTEGER(iwp), INTENT(IN) ::  nzt_do   !< Unused.
-!
-!-- Output variables
-    LOGICAL, INTENT(OUT) ::  found   !< Output found?
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf   !< Temp. result grid to return
-!
-!-- Internal variables
-    INTEGER(iwp) ::  l    !< Running index, radiation grid
-    INTEGER(iwp) ::  i    !< Running index, x-dir
-    INTEGER(iwp) ::  j    !< Running index, y-dir
-    INTEGER(iwp) ::  k    !< Running index, z-dir
-
-!    REAL(wp) ::  mrt  !< Buffer for mean radiant temperature
-
-    found = .TRUE.
-
-    SELECT CASE ( TRIM( variable ) )
-
-        CASE ( 'bio_mrt' )
-            local_pf = REAL( bio_fill_value, KIND = sp )
-            DO  l = 1, nmrtbl
-               i = mrtbl(ix,l)
-               j = mrtbl(iy,l)
-               k = mrtbl(iz,l)
-               IF ( k < nzb_do  .OR.  k > nzt_do  .OR.  j < nys  .OR.                              &
-                  j > nyn  .OR.  i < nxl  .OR.  i > nxr )  CYCLE
-               IF ( av == 0 )  THEN
-                  IF ( mrt_include_sw )  THEN
-                     local_pf(i,j,k) = REAL( ( ( human_absorb * mrtinsw(l) +                       &
-                                       mrtinlw(l) ) /                                              &
-                                       ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k,          &
-                                         KIND = sp )
-                  ELSE
-                     local_pf(i,j,k) = REAL( ( mrtinlw(l) /                                        &
-                                       ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k,          &
-                                         KIND = sp )
-                  ENDIF
-               ELSE
-                  local_pf(i,j,k) = REAL( mrt_av_grid(k,j,i), KIND = sp )
-               ENDIF
-            ENDDO
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE bio_data_output_3d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining appropriate grid for netcdf variables.
-!> It is called out from subroutine netcdf_interface_mod.
-!> netcdf_interface_mod 918ff
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-    IMPLICIT NONE
-!
-!-- Input variables
-    CHARACTER (LEN=*), INTENT(IN)  ::  var      !< Name of output variable
-!
-!-- Output variables
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_x   !< x grid of output variable
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y   !< y grid of output variable
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z   !< z grid of output variable
-
-    LOGICAL, INTENT(OUT)           ::  found    !< Flag if output var is found
-!
-!-- Local variables
-    INTEGER(iwp) :: l     !< Length of the var array
-
-    LOGICAL      :: is2d  !< Var is 2d?
-
-    found  = .FALSE.
-    grid_x = 'none'
-    grid_y = 'none'
-    grid_z = 'none'
-
-    l = MAX( 2, LEN_TRIM( var ) )
-    is2d = ( var(l-1:l) == 'xy' )
-
-    IF ( var(1:4) == 'bio_' )  THEN
-       found  = .TRUE.
-       grid_x = 'x'
-       grid_y = 'y'
-       grid_z = 'zu'
-       IF ( is2d  .AND.  var(1:7) /= 'bio_mrt' )  grid_z = 'zu1'
-    ENDIF
-
-    IF ( is2d  .AND.  var(1:4) == 'uvem' )  THEN
-       grid_x = 'x'
-       grid_y = 'y'
-       grid_z = 'zu1'
-    ENDIF
-
- END SUBROUTINE bio_define_netcdf_grid
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for biom module
-!> header 982
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_header( io )
-
-    IMPLICIT NONE
-!
-!-- Input variables
-    INTEGER(iwp), INTENT(IN) ::  io           !< Unit of the output file
-!
-!-- Internal variables
-    CHARACTER (LEN=86) ::  output_height_chr  !< String for output height
-
-    WRITE( output_height_chr, '(F8.1,7X)' )  bio_output_height
-!
-!-- Write biom header
-    WRITE( io, 1 )
-    WRITE( io, 2 )  TRIM( output_height_chr )
-    WRITE( io, 3 )  TRIM( ACHAR( bio_cell_level ) )
-
-1   FORMAT (//' Human thermal comfort module information:'/                                        &
-              ' ------------------------------'/)
-2   FORMAT ('    --> All indices calculated for a height of (m): ', A )
-3   FORMAT ('    --> This corresponds to cell level : ', A )
-
- END SUBROUTINE bio_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the HTCM
-!> init_3d_model 1987ff
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_init
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  netcdf_data_input_uvem
-
-    IMPLICIT NONE
-!
-!-- Internal vriables
-    REAL ( wp )  :: height  !< current height in meters
-
-    IF ( debug_output )  CALL debug_message( 'bio_init', 'start' )
-!
-!-- Determine cell level corresponding to 1.1 m above ground level (gravimetric center of sample
-!-- human)
-
-    bio_cell_level = 0_iwp
-    bio_output_height = 0.5_wp * dz(1)
-    height = 0.0_wp
-
-    bio_cell_level = INT( 1.099_wp / dz(1) )
-    bio_output_height = bio_output_height + bio_cell_level * dz(1)
-!
-!-- Set radiation level if not done by user
-    IF ( mrt_nlevels == 0 )  THEN
-       mrt_nlevels = bio_cell_level + 1_iwp
-    ENDIF
-!
-!-- Init UVEM and load lookup tables
-    IF ( uv_exposure )  CALL netcdf_data_input_uvem
-
-!
-!-- Check parameters
-!-- WARNING This is a WORKAROUND! Due to the design of the module, checks are called at this point
-!-- rather than within module_interface_check_parameters.
-    CALL bio_check_parameters
-
-    IF ( debug_output )  CALL debug_message( 'bio_init', 'end' )
-
- END SUBROUTINE bio_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Checks done after the Initialization
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_init_checks
-
-    USE control_parameters,                                                                        &
-        ONLY: message_string
-
-    IF ( (.NOT. radiation_interactions) .AND. ( thermal_comfort ) )  THEN
-       message_string = 'The mrt calculation requires ' //                                         &
-                        'enabled radiation_interactions but it ' //                                &
-                        'is disabled!'
-       CALL message( 'bio_init_checks', 'PAHU03', 1, 2, 0, 6, 0 )
-    ENDIF
-
-
- END SUBROUTINE bio_init_checks
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &biometeorology_parameters for reading biomet parameters
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_parin
-
-    IMPLICIT NONE
-
-!
-!-- Internal variables
-    CHARACTER (LEN=100) ::  line  !< Dummy string for current line in parameter file
-
-    INTEGER(iwp) ::  io_status   !< Status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /biometeorology_parameters/  clothing,                                                &
-                                          consider_obstructions,                                   &
-                                          orientation_angle,                                       &
-                                          sun_in_south,                                            &
-                                          switch_off_module,                                       &
-                                          thermal_comfort,                                         &
-                                          turn_to_sun,                                             &
-                                          uv_exposure
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist named
-!-- biometeorology_parameters.
-    REWIND( 11 )
-    READ( 11, biometeorology_parameters, IOSTAT=io_status )
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    biometeorology_parameters namelist was found and read correctly. Set flag that
-!--    biometeorology_mod is switched on.
-       IF ( .NOT. switch_off_module )  biometeorology = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    biometeorology_parameters namelist was found, but contained errors. Print an error message
-!--    containing the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'biometeorology_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE bio_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_rrd_global_ftn( found )
-
-    USE control_parameters,                                                                        &
-        ONLY:  length, restart_string
-
-
-    IMPLICIT NONE
-
-    LOGICAL, INTENT(OUT) ::  found      !< variable found? yes = .T., no = .F.
-
-    found = .TRUE.
-
-
-    SELECT CASE ( restart_string(1:length) )
-
-!
-!--    Read control flags to determine if input grids need to be averaged.
-       CASE ( 'do_average_theta' )
-          READ ( 13 )  do_average_theta
-
-       CASE ( 'do_average_q' )
-          READ ( 13 )  do_average_q
-
-       CASE ( 'do_average_u' )
-          READ ( 13 )  do_average_u
-
-       CASE ( 'do_average_v' )
-          READ ( 13 )  do_average_v
-
-       CASE ( 'do_average_w' )
-          READ ( 13 )  do_average_w
-
-       CASE ( 'do_average_mrt' )
-          READ ( 13 )  do_average_mrt
-
-!
-!--    Read control flags to determine which thermal index needs to trigger averaging.
-       CASE ( 'average_trigger_perct' )
-          READ ( 13 )  average_trigger_perct
-
-       CASE ( 'average_trigger_utci' )
-          READ ( 13 )  average_trigger_utci
-
-       CASE ( 'average_trigger_pet' )
-          READ ( 13 )  average_trigger_pet
-
-       CASE ( 'average_trigger_mrt' )
-          READ ( 13 )  average_trigger_mrt
-
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE bio_rrd_global_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_rrd_global_mpi
-
-
-!
-!--  Read control flags to determine if input grids need to be averaged
-     CALL rrd_mpi_io( 'do_average_theta', do_average_theta )
-     CALL rrd_mpi_io( 'do_average_q', do_average_q )
-     CALL rrd_mpi_io( 'do_average_u', do_average_u )
-     CALL rrd_mpi_io( 'do_average_v', do_average_v )
-     CALL rrd_mpi_io( 'do_average_w', do_average_w )
-     CALL rrd_mpi_io( 'do_average_mrt', do_average_mrt )
-!
-!--  Rad control flags to determine which thermal index needs to trigger averaging
-     CALL rrd_mpi_io( 'average_trigger_perct', average_trigger_perct )
-     CALL rrd_mpi_io( 'average_trigger_utci', average_trigger_utci )
-     CALL rrd_mpi_io( 'average_trigger_pet', average_trigger_pet )
-     CALL rrd_mpi_io( 'average_trigger_mrt', average_trigger_mrt )
-
- END SUBROUTINE bio_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_rrd_local_ftn( found )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  length, restart_string
-
-
-    IMPLICIT NONE
-
-
-    LOGICAL, INTENT(OUT) ::  found      !< variable found? yes = .TRUE., no = .FALSE.
-
-    found = .TRUE.
-
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'mrt_av_grid' )
-          IF ( .NOT. ALLOCATED( mrt_av_grid ) )  THEN
-             ALLOCATE( mrt_av_grid(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             mrt_av_grid = 0.0_wp
-          ENDIF
-          READ ( 13 )  mrt_av_grid
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE bio_rrd_local_ftn
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!------------------------------------------------------------------------------!
- SUBROUTINE bio_rrd_local_mpi
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    LOGICAL      ::  array_found  !<
-
-    CALL rd_mpi_io_check_array( 'mrt_av_grid' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( mrt_av_grid ) )  ALLOCATE( mrt_av_grid(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'mrt_av_grid', mrt_av_grid )
-    ENDIF
-
- END SUBROUTINE bio_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write global restart data for the biometeorology module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_wrd_global
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL wrd_write_string( 'do_average_theta' )
-       WRITE ( 14 )  do_average_theta
-       CALL wrd_write_string( 'do_average_q' )
-       WRITE ( 14 )  do_average_q
-       CALL wrd_write_string( 'do_average_u' )
-       WRITE ( 14 )  do_average_u
-       CALL wrd_write_string( 'do_average_v' )
-       WRITE ( 14 )  do_average_v
-       CALL wrd_write_string( 'do_average_w' )
-       WRITE ( 14 )  do_average_w
-       CALL wrd_write_string( 'do_average_mrt' )
-       WRITE ( 14 )  do_average_mrt
-       CALL wrd_write_string( 'average_trigger_perct' )
-       WRITE ( 14 )  average_trigger_perct
-       CALL wrd_write_string( 'average_trigger_utci' )
-       WRITE ( 14 )  average_trigger_utci
-       CALL wrd_write_string( 'average_trigger_pet' )
-       WRITE ( 14 )  average_trigger_pet
-       CALL wrd_write_string( 'average_trigger_mrt' )
-       WRITE ( 14 )  average_trigger_mrt
-
-    ELSEIF ( TRIM( restart_data_format_output(1:3) ) == 'mpi' )  THEN
-
-       CALL wrd_mpi_io( 'do_average_theta', do_average_theta )
-       CALL wrd_mpi_io( 'do_average_q', do_average_q )
-       CALL wrd_mpi_io( 'do_average_u', do_average_u )
-       CALL wrd_mpi_io( 'do_average_v', do_average_v )
-       CALL wrd_mpi_io( 'do_average_w', do_average_w )
-       CALL wrd_mpi_io( 'do_average_mrt', do_average_mrt )
-       CALL wrd_mpi_io( 'average_trigger_perct', average_trigger_perct )
-       CALL wrd_mpi_io( 'average_trigger_utci', average_trigger_utci )
-       CALL wrd_mpi_io( 'average_trigger_pet', average_trigger_pet )
-       CALL wrd_mpi_io( 'average_trigger_mrt', average_trigger_mrt )
-
-    ENDIF
-
- END SUBROUTINE bio_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write local restart data for the biometeorology module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_wrd_local
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       IF ( ALLOCATED( mrt_av_grid ) )  THEN
-          CALL wrd_write_string( 'mrt_av_grid' )
-          WRITE ( 14 )  mrt_av_grid
-       ENDIF
-
-    ELSEIF ( TRIM( restart_data_format_output(1:3) ) == 'mpi' )  THEN
-
-       IF ( ALLOCATED( mrt_av_grid ) )  CALL wrd_mpi_io( 'mrt_av_grid', mrt_av_grid )
-
-    ENDIF
-
- END SUBROUTINE bio_wrd_local
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate biometeorology MRT for all 2D grid
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_calculate_mrt_grid ( av )
-
-    IMPLICIT NONE
-
-    LOGICAL, INTENT(IN)         ::  av    !< use averaged input?
-!
-!-- Internal variables
-    INTEGER(iwp)                ::  i     !< Running index, x-dir, radiation coordinates
-    INTEGER(iwp)                ::  j     !< Running index, y-dir, radiation coordinates
-    INTEGER(iwp)                ::  k     !< Running index, y-dir, radiation coordinates
-    INTEGER(iwp)                ::  l     !< Running index, radiation coordinates
-
-
-!
-!-- We need to differentiate if averaged input is desired (av == .TRUE.) or not.
-    IF ( av )  THEN
-!
-!--    Make sure tmrt_av_grid is present and initialize with the fill value
-       IF ( .NOT. ALLOCATED( tmrt_av_grid ) )  THEN
-          ALLOCATE( tmrt_av_grid(nys:nyn,nxl:nxr) )
-       ENDIF
-       tmrt_av_grid = REAL( bio_fill_value, KIND = wp )
-
-!
-!--    mrt_av_grid should always be allcoated here, but better make sure ist actually is.
-       IF ( ALLOCATED( mrt_av_grid ) )  THEN
-!
-!--       Iterate over the radiation grid (radiation coordinates) and fill the tmrt_av_grid
-!--       (x, y coordinates) where appropriate: tmrt_av_grid is written for all i / j if level (k)
-!--       matches output height.
-          DO  l = 1, nmrtbl
-             i = mrtbl(ix,l)
-             j = mrtbl(iy,l)
-             k = mrtbl(iz,l)
-             IF ( k - topo_top_ind(j,i,0) == bio_cell_level + 1_iwp)  THEN
-!
-!--             Averaging was done before, so we can just copy the result here.
-                tmrt_av_grid(j,i) = mrt_av_grid(k,j,i)
-
-             ENDIF
-          ENDDO
-       ENDIF
-
-!
-!-- In case instantaneous input is desired, mrt values will be re-calculated.
-    ELSE
-!
-!--    Calculate biometeorology MRT from local radiation fluxes calculated by RTM and assign into 2D
-!--    grid. Depending on selected output quantities, tmrt_grid might not have been allocated in
-!--    bio_check_data_output yet.
-       IF ( .NOT. ALLOCATED( tmrt_grid ) )  THEN
-          ALLOCATE( tmrt_grid (nys:nyn,nxl:nxr) )
-       ENDIF
-       tmrt_grid = REAL( bio_fill_value, KIND = wp )
-
-       DO  l = 1, nmrtbl
-          i = mrtbl(ix,l)
-          j = mrtbl(iy,l)
-          k = mrtbl(iz,l)
-          IF ( k - topo_top_ind(j,i,0) == bio_cell_level + 1_iwp)  THEN
-             IF ( mrt_include_sw )  THEN
-                tmrt_grid(j,i) = ( ( human_absorb * mrtinsw(l) +                                   &
-                                 mrtinlw(l) )  /                                                   &
-                                 ( human_emiss * sigma_sb ) )**0.25_wp -                           &
-                                 degc_to_k
-             ELSE
-                tmrt_grid(j,i) = ( mrtinlw(l)  /                                                   &
-                                 ( human_emiss * sigma_sb ) )**0.25_wp -                           &
-                                 degc_to_k
-             ENDIF
-          ENDIF
-       ENDDO
-    ENDIF
-
- END SUBROUTINE bio_calculate_mrt_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate static thermal indices for 2D grid point i, j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_get_thermal_index_input_ij( average_input, i, j, ta, vp, ws, pair, tmrt )
-
-    IMPLICIT NONE
-!
-!-- Input variables
-    LOGICAL,      INTENT ( IN ) ::  average_input  !< Determine averaged input conditions?
-    INTEGER(iwp), INTENT ( IN ) ::  i     !< Running index, x-dir
-    INTEGER(iwp), INTENT ( IN ) ::  j     !< Running index, y-dir
-!
-!-- Output parameters
-    REAL(wp), INTENT ( OUT )    ::  pair  !< Air pressure                    (hPa)
-    REAL(wp), INTENT ( OUT )    ::  ta    !< Air temperature                 (degree_C)
-    REAL(wp), INTENT ( OUT )    ::  tmrt  !< Mean radiant temperature        (degree_C)
-    REAL(wp), INTENT ( OUT )    ::  vp    !< Vapour pressure                 (hPa)
-    REAL(wp), INTENT ( OUT )    ::  ws    !< Wind speed    (local level)     (m/s)
-!
-!-- Internal variables
-    INTEGER(iwp)                ::  k     !< Running index, z-dir
-    INTEGER(iwp)                ::  k_wind  !< Running index, z-dir, wind speed only
-
-    REAL(wp)                    ::  vp_sat  !< Saturation vapor pressure     (hPa)
-
-!
-!-- Determine cell level closest to 1.1m above ground by making use of truncation due to int cast.
-    k = INT( topo_top_ind(j,i,0) + bio_cell_level )  !< Vertical cell center closest to 1.1m
-
-!
-!-- Avoid non-representative horizontal u and v of 0.0 m/s too close to ground
-    k_wind = k
-    IF ( bio_cell_level < 1_iwp )  THEN
-       k_wind = k + 1_iwp
-    ENDIF
-!
-!-- Determine local values:
-    IF ( average_input )  THEN
-!
-!--    Calculate ta from Tp assuming dry adiabatic laps rate
-       ta = bio_fill_value
-       IF ( ALLOCATED( pt_av ) )  THEN
-          ta = pt_av(k,j,i) - ( 0.0098_wp * dz(1) * ( k + 0.5_wp ) ) - degc_to_k
-       ENDIF
-
-       vp = bio_fill_value
-       IF ( humidity  .AND.  ALLOCATED( q_av ) )  THEN
-          vp = q_av(k,j,i)
-       ENDIF
-
-       ws = bio_fill_value
-       IF ( ALLOCATED( u_av )  .AND.  ALLOCATED( v_av )  .AND.                                     &
-          ALLOCATED( w_av ) )  THEN
-             ws = ( 0.5_wp * ABS( u_av(k_wind,j,i) + u_av(k_wind,j,i+1) ) +                        &
-                    0.5_wp * ABS( v_av(k_wind,j,i) + v_av(k_wind,j+1,i) ) +                        &
-                    0.5_wp * ABS( w_av(k_wind,j,i) + w_av(k_wind+1,j,i) ) )
-       ENDIF
-    ELSE
-!
-!--    Calculate ta from Tp assuming dry adiabatic laps rate
-       ta = pt(k,j,i) - ( 0.0098_wp * dz(1) * (  k + 0.5_wp ) ) - degc_to_k
-
-       vp = bio_fill_value
-       IF ( humidity )  THEN
-          vp = q(k,j,i)
-       ENDIF
-
-       ws = ( 0.5_wp * ABS( u(k_wind,j,i) + u(k_wind,j,i+1) )  +                                   &
-              0.5_wp * ABS( v(k_wind,j,i) + v(k_wind,j+1,i) )  +                                   &
-              0.5_wp * ABS( w(k_wind,j,i) + w(k_wind+1,j,i) ) )
-
-    ENDIF
-!
-!-- Local air pressure
-    pair = surface_pressure
-!
-!-- Calculate water vapour pressure at saturation and convert to hPa.
-!-- The magnus formula is limited to temperatures up to 333.15 K to avoid negative values of vp_sat.
-    IF ( vp > -998.0_wp )  THEN
-       vp_sat = 0.01_wp * magnus( MIN( ta + degc_to_k, 333.15_wp ) )
-       vp  = vp * pair / ( vp + 0.622_wp )
-       IF ( vp > vp_sat )  vp = vp_sat
-    ENDIF
-!
-!-- Local mtr value at [i,j]
-    tmrt = bio_fill_value  !< this can be a valid result (e.g. for inside some ostacle)
-    IF ( .NOT. average_input )  THEN
-!
-!--    Use MRT from RTM precalculated in tmrt_grid
-       tmrt = tmrt_grid(j,i)
-    ELSE
-       tmrt = tmrt_av_grid(j,i)
-    ENDIF
-
- END SUBROUTINE bio_get_thermal_index_input_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate static thermal indices for any point within a 2D grid time_integration.f90: 1065ff
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_calculate_thermal_index_maps( av )
-
-    IMPLICIT NONE
-!
-!-- Input attributes
-    LOGICAL, INTENT ( IN ) ::  av  !< Calculate based on averaged input conditions?
-!
-!-- Internal variables
-    INTEGER(iwp) ::  i, j     !< Running index
-
-    REAL(wp) ::  clo          !< Clothing index                (no dimension)
-    REAL(wp) ::  pair         !< Air pressure                     (hPa)
-    REAL(wp) ::  perct_ij     !< Perceived temperature            (degree_C)
-    REAL(wp) ::  pet_ij       !< Physiologically equivalent temperature  (degree_C)
-    REAL(wp) ::  ta           !< Air temperature                  (degree_C)
-    REAL(wp) ::  tmrt_ij      !< Mean radiant temperature         (degree_C)
-    REAL(wp) ::  utci_ij      !< Universal thermal climate index  (degree_C)
-    REAL(wp) ::  vp           !< Vapour pressure                  (hPa)
-    REAL(wp) ::  ws           !< Wind speed    (local level)      (m/s)
-
-!
-!-- Check if some thermal index is desired. Don't do anything if, e.g. only bio_mrt is desired.
-    IF ( do_calculate_perct    .OR.  do_calculate_perct_av  .OR.  do_calculate_utci    .OR.        &
-         do_calculate_utci_av  .OR.  do_calculate_pet       .OR.  do_calculate_pet_av  .OR.        &
-         do_calculate_mrt2d )  THEN
-
-!
-!--    fill out the MRT 2D grid from appropriate source (RTM, RRTMG,...)
-       CALL bio_calculate_mrt_grid ( av )
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-!
-!--          Determine local input conditions
-             tmrt_ij = bio_fill_value
-             vp      = bio_fill_value
-!
-!--          Determine local meteorological conditions
-             CALL bio_get_thermal_index_input_ij ( av, i, j, ta, vp, ws, pair, tmrt_ij )
-!
-!--          Only proceed if input is available
-             pet_ij   = bio_fill_value   !< set fail value, e.g. valid for
-             perct_ij = bio_fill_value   !< within some obstacle
-             utci_ij  = bio_fill_value
-             IF ( .NOT. ( tmrt_ij <= -998.0_wp  .OR.  vp <= -998.0_wp  .OR.   ws <= -998.0_wp  .OR.&
-                  ta <= -998.0_wp ) )  THEN
-!
-!--             Calculate static thermal indices based on local tmrt
-                clo = bio_fill_value
-
-                IF ( do_calculate_perct  .OR.  do_calculate_perct_av )  THEN
-!
-!--                Estimate local perceived temperature
-                   CALL calculate_perct_static( ta, vp, ws, tmrt_ij, pair, clo, perct_ij )
-                ENDIF
-
-                IF ( do_calculate_utci  .OR.  do_calculate_utci_av )  THEN
-!
-!--                Estimate local universal thermal climate index
-                   CALL calculate_utci_static( ta, vp, ws, tmrt_ij, bio_output_height, utci_ij )
-                ENDIF
-
-                IF ( do_calculate_pet  .OR.  do_calculate_pet_av )  THEN
-!
-!--                Estimate local physiologically equivalent temperature
-                   CALL calculate_pet_static( ta, vp, ws, tmrt_ij, pair, pet_ij )
-                ENDIF
-             ENDIF
-
-
-             IF ( av )  THEN
-!
-!--             Write results for selected averaged indices
-                IF ( do_calculate_perct_av )  THEN
-                   perct_av(j, i) = perct_ij
-                ENDIF
-                IF ( do_calculate_utci_av )  THEN
-                   utci_av(j, i) = utci_ij
-                ENDIF
-                IF ( do_calculate_pet_av )  THEN
-                   pet_av(j, i)  = pet_ij
-                ENDIF
-             ELSE
-!
-!--             Write result for selected indices
-                IF ( do_calculate_perct )  THEN
-                   perct(j, i) = perct_ij
-                ENDIF
-                IF ( do_calculate_utci )  THEN
-                   utci(j, i) = utci_ij
-                ENDIF
-                IF ( do_calculate_pet )  THEN
-                   pet(j, i)  = pet_ij
-                ENDIF
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE bio_calculate_thermal_index_maps
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate dynamic thermal indices (currently only iPT, but expandable)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_calc_ipt( ta, vp, ws, pair, tmrt, dt, energy_storage, t_clo, clo, actlev, age,     &
-                          weight, height, work, sex, ipt )
-
-    IMPLICIT NONE
-!
-!-- Input parameters
-    INTEGER(iwp), INTENT ( IN ) ::  sex  !< Sex of agent (1 = male, 2 = female)
-
-    REAL(wp), INTENT ( IN )  ::  age     !< Age of agent                     (y)
-    REAL(wp), INTENT ( IN )  ::  dt      !< Time past since last calculation (s)
-    REAL(wp), INTENT ( IN )  ::  height  !< Height of agent                  (m)
-    REAL(wp), INTENT ( IN )  ::  pair    !< Air pressure                     (hPa)
-    REAL(wp), INTENT ( IN )  ::  ta      !< Air temperature                  (degree_C)
-    REAL(wp), INTENT ( IN )  ::  tmrt    !< Mean radiant temperature         (degree_C)
-    REAL(wp), INTENT ( IN )  ::  vp      !< Vapour pressure                  (hPa)
-    REAL(wp), INTENT ( IN )  ::  weight  !< Weight of agent                  (Kg)
-    REAL(wp), INTENT ( IN )  ::  work    !< Mechanical workload of agent  (without metabolism!) (W)
-    REAL(wp), INTENT ( IN )  ::  ws      !< Wind speed  (local level)        (m/s)
-
-!
-!-- Both, input and output parameters
-    Real(wp), INTENT ( INOUT )  ::  actlev            !< Individuals activity level
-                                                      !< per unit surface area      (W/mÂ²)
-    Real(wp), INTENT ( INOUT )  ::  clo               !< Current clothing in sulation
-    Real(wp), INTENT ( INOUT )  ::  energy_storage    !< Energy storage   (W/mÂ²)
-    Real(wp), INTENT ( INOUT )  ::  t_clo             !< Clothing temperature       (degree_C)
-!
-!-- Output parameters
-    REAL(wp), INTENT ( OUT ) ::  ipt    !< Instationary perceived temp.   (degree_C)
-!
-!-- Return immediatelly if nothing to do!
-    IF ( .NOT. thermal_comfort )  THEN
-        RETURN
-    ENDIF
-!
-!-- If clo equals the initial value, this is the initial call
-    IF ( clo <= -998.0_wp )  THEN
-!
-!--    Initialize instationary perceived temperature with personalized PT as an initial guess, set
-!--    actlev and clo
-       CALL ipt_init( age, weight, height, sex, work, actlev, clo, ta, vp, ws, tmrt, pair, dt,     &
-                      energy_storage, t_clo, ipt )
-    ELSE
-!
-!--    Estimate local instatinoary perceived temperature
-       CALL ipt_cycle ( ta, vp, ws, tmrt, pair, dt, energy_storage, t_clo, clo, actlev, work, ipt )
-    ENDIF
-
- END SUBROUTINE bio_calc_ipt
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> SUBROUTINE for calculating UTCI Temperature (UTCI)
-!> computed by a 6th order approximation
-!>
-!> UTCI regression equation according to
-!> BrÃ¶de P, Fiala D, Blazejczyk K, HolmÃ©r I, Jendritzky G, Kampmann B, Tinz B, Havenith G (2012)
-!> Deriving the operational procedure for the Universal Thermal Climate Index (UTCI). International
-!> Journal of Biometeorology 56 (3):481-494. doi:10.1007/s00484-011-0454-1
-!>
-!> original source available at:
-!> www.utci.org
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calculate_utci_static( ta_in, vp, ws_hag, tmrt, hag, utci_ij )
-
-    IMPLICIT NONE
-!
-!-- Type of input of the argument list
-    REAL(WP), INTENT ( IN )  ::  hag      !< Height of wind speed input (m)
-    REAL(WP), INTENT ( IN )  ::  ta_in    !< Local air temperature (degree_C)
-    REAL(WP), INTENT ( IN )  ::  tmrt     !< Local mean radiant temperature (degree_C)
-    REAL(WP), INTENT ( IN )  ::  vp       !< Loacl vapour pressure (hPa)
-    REAL(WP), INTENT ( IN )  ::  ws_hag   !< Incident wind speed (m/s)
-!
-!-- Type of output of the argument list
-    REAL(WP) ::  d_tmrt       !< delta-tmrt               (degree_C)
-    REAL(WP) ::  d_tmrt2      !< 2 times d_tmrt
-    REAL(WP) ::  d_tmrt3      !< 3 times d_tmrt
-    REAL(WP) ::  d_tmrt4      !< 4 times d_tmrt
-    REAL(WP) ::  d_tmrt5      !< 5 times d_tmrt
-    REAL(WP) ::  d_tmrt6      !< 6 times d_tmrt
-    REAL(WP) ::  offset       !< utci deviation by ta cond. exceeded      (degree_C)
-    REAL(WP) ::  pa           !< air pressure in kPa      (kPa)
-    REAL(WP) ::  pa2          !< 2 times pa
-    REAL(WP) ::  pa3          !< 3 times pa
-    REAL(WP) ::  pa4          !< 4 times pa
-    REAL(WP) ::  pa5          !< 5 times pa
-    REAL(WP) ::  pa6          !< 6 times pa
-    REAL(WP) ::  part_d_tmrt  !< Mean radiant temp. related part of the reg.
-    REAL(WP) ::  part_pa      !< Air pressure related part of the regression
-    REAL(WP) ::  part_pa2     !< Air pressure^2 related part of the regression
-    REAL(WP) ::  part_pa3     !< Air pressure^3 related part of the regression
-    REAL(WP) ::  part_pa46    !< Air pressure^4-6 related part of the regression
-    REAL(WP) ::  part_ta      !< Air temperature related part of the regression
-    REAL(WP) ::  part_va      !< Vapour pressure related part of the regression
-    REAL(WP) ::  ta           !< air temperature modified by offset (degree_C)
-    REAL(WP) ::  ta2          !< 2 times ta
-    REAL(WP) ::  ta3          !< 3 times ta
-    REAL(WP) ::  ta4          !< 4 times ta
-    REAL(WP) ::  ta5          !< 5 times ta
-    REAL(WP) ::  ta6          !< 6 times ta
-    REAL(WP) ::  va           !< wind speed at 10 m above ground level    (m/s)
-    REAL(WP) ::  va2          !< 2 times va
-    REAL(WP) ::  va3          !< 3 times va
-    REAL(WP) ::  va4          !< 4 times va
-    REAL(WP) ::  va5          !< 5 times va
-    REAL(WP) ::  va6          !< 6 times va
-
-
-    REAL(wp), INTENT ( OUT ) ::  utci_ij  !< Universal Thermal Climate Index (degree_C)
-
-!
-!-- Initialize
-    offset = 0.0_wp
-    ta = ta_in
-    d_tmrt = tmrt - ta_in
-!
-!-- Use vapour pressure in kpa
-    pa = vp / 10.0_wp
-!
-!-- Wind altitude correction from hag to 10m after Broede et al. (2012), eq.3
-!-- z(0) is set to 0.01 according to UTCI profile definition
-    va = ws_hag *  log ( 10.0_wp / 0.01_wp ) / log ( hag / 0.01_wp )
-!
-!-- Check if input values in range after Broede et al. (2012)
-    IF ( ( d_tmrt > 70.0_wp )  .OR.  ( d_tmrt < -30.0_wp )  .OR.  ( vp >= 50.0_wp ) )  THEN
-       utci_ij = bio_fill_value
-       RETURN
-    ENDIF
-!
-!-- Apply eq. 2 in Broede et al. (2012) for ta out of bounds
-    IF ( ta > 50.0_wp )  THEN
-       offset = ta - 50.0_wp
-       ta = 50.0_wp
-    ENDIF
-    IF ( ta < -50.0_wp )  THEN
-       offset = ta + 50.0_wp
-       ta = -50.0_wp
-    ENDIF
-!
-!-- For routine application. For wind speeds and relative humidity values below 0.5 m/s or 5%,
-!-- respectively, the user is advised to use the lower bounds for the calculations.
-    IF ( va < 0.5_wp )  va = 0.5_wp
-    IF ( va > 17.0_wp )  va = 17.0_wp
-
-!
-!-- Pre-calculate multiples of input parameters to save time later
-    ta2 = ta  * ta
-    ta3 = ta2 * ta
-    ta4 = ta3 * ta
-    ta5 = ta4 * ta
-    ta6 = ta5 * ta
-
-    va2 = va  * va
-    va3 = va2 * va
-    va4 = va3 * va
-    va5 = va4 * va
-    va6 = va5 * va
-
-    d_tmrt2 = d_tmrt  * d_tmrt
-    d_tmrt3 = d_tmrt2 * d_tmrt
-    d_tmrt4 = d_tmrt3 * d_tmrt
-    d_tmrt5 = d_tmrt4 * d_tmrt
-    d_tmrt6 = d_tmrt5 * d_tmrt
-
-    pa2 = pa  * pa
-    pa3 = pa2 * pa
-    pa4 = pa3 * pa
-    pa5 = pa4 * pa
-    pa6 = pa5 * pa
-
-!
-!-- Pre-calculate parts of the regression equation
-    part_ta = (  6.07562052e-01_wp )       +                                                       &
-              ( -2.27712343e-02_wp ) * ta  +                                                       &
-              (  8.06470249e-04_wp ) * ta2 +                                                       &
-              ( -1.54271372e-04_wp ) * ta3 +                                                       &
-              ( -3.24651735e-06_wp ) * ta4 +                                                       &
-              (  7.32602852e-08_wp ) * ta5 +                                                       &
-              (  1.35959073e-09_wp ) * ta6
-
-    part_va = ( -2.25836520e+00_wp ) *       va  +                                                 &
-              (  8.80326035e-02_wp ) * ta  * va  +                                                 &
-              (  2.16844454e-03_wp ) * ta2 * va  +                                                 &
-              ( -1.53347087e-05_wp ) * ta3 * va  +                                                 &
-              ( -5.72983704e-07_wp ) * ta4 * va  +                                                 &
-              ( -2.55090145e-09_wp ) * ta5 * va  +                                                 &
-              ( -7.51269505e-01_wp ) *       va2 +                                                 &
-              ( -4.08350271e-03_wp ) * ta  * va2 +                                                 &
-              ( -5.21670675e-05_wp ) * ta2 * va2 +                                                 &
-              (  1.94544667e-06_wp ) * ta3 * va2 +                                                 &
-              (  1.14099531e-08_wp ) * ta4 * va2 +                                                 &
-              (  1.58137256e-01_wp ) *       va3 +                                                 &
-              ( -6.57263143e-05_wp ) * ta  * va3 +                                                 &
-              (  2.22697524e-07_wp ) * ta2 * va3 +                                                 &
-              ( -4.16117031e-08_wp ) * ta3 * va3 +                                                 &
-              ( -1.27762753e-02_wp ) *       va4 +                                                 &
-              (  9.66891875e-06_wp ) * ta  * va4 +                                                 &
-              (  2.52785852e-09_wp ) * ta2 * va4 +                                                 &
-              (  4.56306672e-04_wp ) *       va5 +                                                 &
-              ( -1.74202546e-07_wp ) * ta  * va5 +                                                 &
-              ( -5.91491269e-06_wp ) * va6
-
-    part_d_tmrt = (  3.98374029e-01_wp ) *             d_tmrt  +                                   &
-                  (  1.83945314e-04_wp ) * ta  *       d_tmrt  +                                   &
-                  ( -1.73754510e-04_wp ) * ta2 *       d_tmrt  +                                   &
-                  ( -7.60781159e-07_wp ) * ta3 *       d_tmrt  +                                   &
-                  (  3.77830287e-08_wp ) * ta4 *       d_tmrt  +                                   &
-                  (  5.43079673e-10_wp ) * ta5 *       d_tmrt  +                                   &
-                  ( -2.00518269e-02_wp ) *       va  * d_tmrt  +                                   &
-                  (  8.92859837e-04_wp ) * ta  * va  * d_tmrt  +                                   &
-                  (  3.45433048e-06_wp ) * ta2 * va  * d_tmrt  +                                   &
-                  ( -3.77925774e-07_wp ) * ta3 * va  * d_tmrt  +                                   &
-                  ( -1.69699377e-09_wp ) * ta4 * va  * d_tmrt  +                                   &
-                  (  1.69992415e-04_wp ) *       va2 * d_tmrt  +                                   &
-                  ( -4.99204314e-05_wp ) * ta  * va2 * d_tmrt  +                                   &
-                  (  2.47417178e-07_wp ) * ta2 * va2 * d_tmrt  +                                   &
-                  (  1.07596466e-08_wp ) * ta3 * va2 * d_tmrt  +                                   &
-                  (  8.49242932e-05_wp ) *       va3 * d_tmrt  +                                   &
-                  (  1.35191328e-06_wp ) * ta  * va3 * d_tmrt  +                                   &
-                  ( -6.21531254e-09_wp ) * ta2 * va3 * d_tmrt  +                                   &
-                  ( -4.99410301e-06_wp ) * va4 *       d_tmrt  +                                   &
-                  ( -1.89489258e-08_wp ) * ta  * va4 * d_tmrt  +                                   &
-                  (  8.15300114e-08_wp ) *       va5 * d_tmrt  +                                   &
-                  (  7.55043090e-04_wp ) *             d_tmrt2 +                                   &
-                  ( -5.65095215e-05_wp ) * ta  *       d_tmrt2 +                                   &
-                  ( -4.52166564e-07_wp ) * ta2 *       d_tmrt2 +                                   &
-                  (  2.46688878e-08_wp ) * ta3 *       d_tmrt2 +                                   &
-                  (  2.42674348e-10_wp ) * ta4 *       d_tmrt2 +                                   &
-                  (  1.54547250e-04_wp ) *       va  * d_tmrt2 +                                   &
-                  (  5.24110970e-06_wp ) * ta  * va  * d_tmrt2 +                                   &
-                  ( -8.75874982e-08_wp ) * ta2 * va  * d_tmrt2 +                                   &
-                  ( -1.50743064e-09_wp ) * ta3 * va  * d_tmrt2 +                                   &
-                  ( -1.56236307e-05_wp ) *       va2 * d_tmrt2 +                                   &
-                  ( -1.33895614e-07_wp ) * ta  * va2 * d_tmrt2 +                                   &
-                  (  2.49709824e-09_wp ) * ta2 * va2 * d_tmrt2 +                                   &
-                  (  6.51711721e-07_wp ) *       va3 * d_tmrt2 +                                   &
-                  (  1.94960053e-09_wp ) * ta  * va3 * d_tmrt2 +                                   &
-                  ( -1.00361113e-08_wp ) *       va4 * d_tmrt2 +                                   &
-                  ( -1.21206673e-05_wp ) *             d_tmrt3 +                                   &
-                  ( -2.18203660e-07_wp ) * ta  *       d_tmrt3 +                                   &
-                  (  7.51269482e-09_wp ) * ta2 *       d_tmrt3 +                                   &
-                  (  9.79063848e-11_wp ) * ta3 *       d_tmrt3 +                                   &
-                  (  1.25006734e-06_wp ) *       va  * d_tmrt3 +                                   &
-                  ( -1.81584736e-09_wp ) * ta  * va  * d_tmrt3 +                                   &
-                  ( -3.52197671e-10_wp ) * ta2 * va  * d_tmrt3 +                                   &
-                  ( -3.36514630e-08_wp ) *       va2 * d_tmrt3 +                                   &
-                  (  1.35908359e-10_wp ) * ta  * va2 * d_tmrt3 +                                   &
-                  (  4.17032620e-10_wp ) *       va3 * d_tmrt3 +                                   &
-                  ( -1.30369025e-09_wp ) *             d_tmrt4 +                                   &
-                  (  4.13908461e-10_wp ) * ta  *       d_tmrt4 +                                   &
-                  (  9.22652254e-12_wp ) * ta2 *       d_tmrt4 +                                   &
-                  ( -5.08220384e-09_wp ) *       va  * d_tmrt4 +                                   &
-                  ( -2.24730961e-11_wp ) * ta  * va  * d_tmrt4 +                                   &
-                  (  1.17139133e-10_wp ) *       va2 * d_tmrt4 +                                   &
-                  (  6.62154879e-10_wp ) *             d_tmrt5 +                                   &
-                  (  4.03863260e-13_wp ) * ta  *       d_tmrt5 +                                   &
-                  (  1.95087203e-12_wp ) *       va  * d_tmrt5 +                                   &
-                  ( -4.73602469e-12_wp ) *             d_tmrt6
-
-    part_pa = (  5.12733497e+00_wp ) *                       pa +                                  &
-              ( -3.12788561e-01_wp ) * ta  *                 pa +                                  &
-              ( -1.96701861e-02_wp ) * ta2 *                 pa +                                  &
-              (  9.99690870e-04_wp ) * ta3 *                 pa +                                  &
-              (  9.51738512e-06_wp ) * ta4 *                 pa +                                  &
-              ( -4.66426341e-07_wp ) * ta5 *                 pa +                                  &
-              (  5.48050612e-01_wp ) *       va  *           pa +                                  &
-              ( -3.30552823e-03_wp ) * ta  * va  *           pa +                                  &
-              ( -1.64119440e-03_wp ) * ta2 * va  *           pa +                                  &
-              ( -5.16670694e-06_wp ) * ta3 * va  *           pa +                                  &
-              (  9.52692432e-07_wp ) * ta4 * va  *           pa +                                  &
-              ( -4.29223622e-02_wp ) *       va2 *           pa +                                  &
-              (  5.00845667e-03_wp ) * ta  * va2 *           pa +                                  &
-              (  1.00601257e-06_wp ) * ta2 * va2 *           pa +                                  &
-              ( -1.81748644e-06_wp ) * ta3 * va2 *           pa +                                  &
-              ( -1.25813502e-03_wp ) *       va3 *           pa +                                  &
-              ( -1.79330391e-04_wp ) * ta  * va3 *           pa +                                  &
-              (  2.34994441e-06_wp ) * ta2 * va3 *           pa +                                  &
-              (  1.29735808e-04_wp ) *       va4 *           pa +                                  &
-              (  1.29064870e-06_wp ) * ta  * va4 *           pa +                                  &
-              ( -2.28558686e-06_wp ) *       va5 *           pa +                                  &
-              ( -3.69476348e-02_wp ) *             d_tmrt  * pa +                                  &
-              (  1.62325322e-03_wp ) * ta  *       d_tmrt  * pa +                                  &
-              ( -3.14279680e-05_wp ) * ta2 *       d_tmrt  * pa +                                  &
-              (  2.59835559e-06_wp ) * ta3 *       d_tmrt  * pa +                                  &
-              ( -4.77136523e-08_wp ) * ta4 *       d_tmrt  * pa +                                  &
-              (  8.64203390e-03_wp ) *       va  * d_tmrt  * pa +                                  &
-              ( -6.87405181e-04_wp ) * ta  * va  * d_tmrt  * pa +                                  &
-              ( -9.13863872e-06_wp ) * ta2 * va  * d_tmrt  * pa +                                  &
-              (  5.15916806e-07_wp ) * ta3 * va  * d_tmrt  * pa +                                  &
-              ( -3.59217476e-05_wp ) *       va2 * d_tmrt  * pa +                                  &
-              (  3.28696511e-05_wp ) * ta  * va2 * d_tmrt  * pa +                                  &
-              ( -7.10542454e-07_wp ) * ta2 * va2 * d_tmrt  * pa +                                  &
-              ( -1.24382300e-05_wp ) *       va3 * d_tmrt  * pa +                                  &
-              ( -7.38584400e-09_wp ) * ta  * va3 * d_tmrt  * pa +                                  &
-              (  2.20609296e-07_wp ) *       va4 * d_tmrt  * pa +                                  &
-              ( -7.32469180e-04_wp ) *             d_tmrt2 * pa +                                  &
-              ( -1.87381964e-05_wp ) * ta  *       d_tmrt2 * pa +                                  &
-              (  4.80925239e-06_wp ) * ta2 *       d_tmrt2 * pa +                                  &
-              ( -8.75492040e-08_wp ) * ta3 *       d_tmrt2 * pa +                                  &
-              (  2.77862930e-05_wp ) *       va  * d_tmrt2 * pa +                                  &
-              ( -5.06004592e-06_wp ) * ta  * va  * d_tmrt2 * pa +                                  &
-              (  1.14325367e-07_wp ) * ta2 * va  * d_tmrt2 * pa +                                  &
-              (  2.53016723e-06_wp ) *       va2 * d_tmrt2 * pa +                                  &
-              ( -1.72857035e-08_wp ) * ta  * va2 * d_tmrt2 * pa +                                  &
-              ( -3.95079398e-08_wp ) *       va3 * d_tmrt2 * pa +                                  &
-              ( -3.59413173e-07_wp ) *             d_tmrt3 * pa +                                  &
-              (  7.04388046e-07_wp ) * ta  *       d_tmrt3 * pa +                                  &
-              ( -1.89309167e-08_wp ) * ta2 *       d_tmrt3 * pa +                                  &
-              ( -4.79768731e-07_wp ) *       va  * d_tmrt3 * pa +                                  &
-              (  7.96079978e-09_wp ) * ta  * va  * d_tmrt3 * pa +                                  &
-              (  1.62897058e-09_wp ) *       va2 * d_tmrt3 * pa +                                  &
-              (  3.94367674e-08_wp ) *             d_tmrt4 * pa +                                  &
-              ( -1.18566247e-09_wp ) * ta *        d_tmrt4 * pa +                                  &
-              (  3.34678041e-10_wp ) *       va  * d_tmrt4 * pa +                                  &
-              ( -1.15606447e-10_wp ) *             d_tmrt5 * pa
-
-    part_pa2 = ( -2.80626406e+00_wp ) *                       pa2 +                                &
-               (  5.48712484e-01_wp ) * ta  *                 pa2 +                                &
-               ( -3.99428410e-03_wp ) * ta2 *                 pa2 +                                &
-               ( -9.54009191e-04_wp ) * ta3 *                 pa2 +                                &
-               (  1.93090978e-05_wp ) * ta4 *                 pa2 +                                &
-               ( -3.08806365e-01_wp ) *       va *            pa2 +                                &
-               (  1.16952364e-02_wp ) * ta  * va *            pa2 +                                &
-               (  4.95271903e-04_wp ) * ta2 * va *            pa2 +                                &
-               ( -1.90710882e-05_wp ) * ta3 * va *            pa2 +                                &
-               (  2.10787756e-03_wp ) *       va2 *           pa2 +                                &
-               ( -6.98445738e-04_wp ) * ta  * va2 *           pa2 +                                &
-               (  2.30109073e-05_wp ) * ta2 * va2 *           pa2 +                                &
-               (  4.17856590e-04_wp ) *       va3 *           pa2 +                                &
-               ( -1.27043871e-05_wp ) * ta  * va3 *           pa2 +                                &
-               ( -3.04620472e-06_wp ) *       va4 *           pa2 +                                &
-               (  5.14507424e-02_wp ) *             d_tmrt  * pa2 +                                &
-               ( -4.32510997e-03_wp ) * ta  *       d_tmrt  * pa2 +                                &
-               (  8.99281156e-05_wp ) * ta2 *       d_tmrt  * pa2 +                                &
-               ( -7.14663943e-07_wp ) * ta3 *       d_tmrt  * pa2 +                                &
-               ( -2.66016305e-04_wp ) *       va  * d_tmrt  * pa2 +                                &
-               (  2.63789586e-04_wp ) * ta  * va  * d_tmrt  * pa2 +                                &
-               ( -7.01199003e-06_wp ) * ta2 * va  * d_tmrt  * pa2 +                                &
-               ( -1.06823306e-04_wp ) *       va2 * d_tmrt  * pa2 +                                &
-               (  3.61341136e-06_wp ) * ta  * va2 * d_tmrt  * pa2 +                                &
-               (  2.29748967e-07_wp ) *       va3 * d_tmrt  * pa2 +                                &
-               (  3.04788893e-04_wp ) *             d_tmrt2 * pa2 +                                &
-               ( -6.42070836e-05_wp ) * ta  *       d_tmrt2 * pa2 +                                &
-               (  1.16257971e-06_wp ) * ta2 *       d_tmrt2 * pa2 +                                &
-               (  7.68023384e-06_wp ) *       va  * d_tmrt2 * pa2 +                                &
-               ( -5.47446896e-07_wp ) * ta  * va  * d_tmrt2 * pa2 +                                &
-               ( -3.59937910e-08_wp ) *       va2 * d_tmrt2 * pa2 +                                &
-               ( -4.36497725e-06_wp ) *             d_tmrt3 * pa2 +                                &
-               (  1.68737969e-07_wp ) * ta  *       d_tmrt3 * pa2 +                                &
-               (  2.67489271e-08_wp ) *       va  * d_tmrt3 * pa2 +                                &
-               (  3.23926897e-09_wp ) *             d_tmrt4 * pa2
-
-    part_pa3 = ( -3.53874123e-02_wp ) *                       pa3 +                                &
-               ( -2.21201190e-01_wp ) * ta  *                 pa3 +                                &
-               (  1.55126038e-02_wp ) * ta2 *                 pa3 +                                &
-               ( -2.63917279e-04_wp ) * ta3 *                 pa3 +                                &
-               (  4.53433455e-02_wp ) *       va  *           pa3 +                                &
-               ( -4.32943862e-03_wp ) * ta  * va  *           pa3 +                                &
-               (  1.45389826e-04_wp ) * ta2 * va  *           pa3 +                                &
-               (  2.17508610e-04_wp ) *       va2 *           pa3 +                                &
-               ( -6.66724702e-05_wp ) * ta  * va2 *           pa3 +                                &
-               (  3.33217140e-05_wp ) *       va3 *           pa3 +                                &
-               ( -2.26921615e-03_wp ) *             d_tmrt  * pa3 +                                &
-               (  3.80261982e-04_wp ) * ta  *       d_tmrt  * pa3 +                                &
-               ( -5.45314314e-09_wp ) * ta2 *       d_tmrt  * pa3 +                                &
-               ( -7.96355448e-04_wp ) *       va  * d_tmrt  * pa3 +                                &
-               (  2.53458034e-05_wp ) * ta  * va  * d_tmrt  * pa3 +                                &
-               ( -6.31223658e-06_wp ) *       va2 * d_tmrt  * pa3 +                                &
-               (  3.02122035e-04_wp ) *             d_tmrt2 * pa3 +                                &
-               ( -4.77403547e-06_wp ) * ta  *       d_tmrt2 * pa3 +                                &
-               (  1.73825715e-06_wp ) *       va  * d_tmrt2 * pa3 +                                &
-               ( -4.09087898e-07_wp ) *             d_tmrt3 * pa3
-
-    part_pa46 = (  6.14155345e-01_wp ) *                       pa4 +                               &
-                ( -6.16755931e-02_wp ) * ta  *                 pa4 +                               &
-                (  1.33374846e-03_wp ) * ta2 *                 pa4 +                               &
-                (  3.55375387e-03_wp ) *       va  *           pa4 +                               &
-                ( -5.13027851e-04_wp ) * ta  * va  *           pa4 +                               &
-                (  1.02449757e-04_wp ) *       va2 *           pa4 +                               &
-                ( -1.48526421e-03_wp ) *             d_tmrt  * pa4 +                               &
-                ( -4.11469183e-05_wp ) * ta  *       d_tmrt  * pa4 +                               &
-                ( -6.80434415e-06_wp ) *       va  * d_tmrt  * pa4 +                               &
-                ( -9.77675906e-06_wp ) *             d_tmrt2 * pa4 +                               &
-                (  8.82773108e-02_wp ) *                       pa5 +                               &
-                ( -3.01859306e-03_wp ) * ta  *                 pa5 +                               &
-                (  1.04452989e-03_wp ) *       va  *           pa5 +                               &
-                (  2.47090539e-04_wp ) *             d_tmrt  * pa5 +                               &
-                (  1.48348065e-03_wp ) *                       pa6
-!
-!-- Calculate 6th order polynomial as approximation
-    utci_ij = ta + part_ta + part_va + part_d_tmrt + part_pa + part_pa2 + part_pa3 + part_pa46
-!
-!-- Consider offset in result
-    utci_ij = utci_ij + offset
-
- END SUBROUTINE calculate_utci_static
-
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate_perct_static: Estimation of perceived temperature (PT, degree_C)
-!> Value of perct is the Perceived Temperature, degree centigrade
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calculate_perct_static( ta, vp, ws, tmrt, pair, clo, perct_ij )
-
-    IMPLICIT NONE
-!
-!-- Type of input of the argument list
-    REAL(wp), INTENT ( IN )  :: pair !< Local barometric air pressure (hPa)
-    REAL(wp), INTENT ( IN )  :: ta   !< Local air temperature (degC)
-    REAL(wp), INTENT ( IN )  :: tmrt !< Local mean radiant temperature (degC)
-    REAL(wp), INTENT ( IN )  :: vp   !< Local vapour pressure (hPa)
-    REAL(wp), INTENT ( IN )  :: ws   !< Local wind velocitry (m/s)
-!
-!-- Type of output of the argument list
-    REAL(wp), INTENT ( OUT ) :: clo       !< Clothing index (dimensionless)
-    REAL(wp), INTENT ( OUT ) :: perct_ij  !< Perceived temperature (degC)
-!
-!-- Parameters for standard "Klima-Michel"
-    REAL(wp), PARAMETER :: actlev = 134.6862_wp  !< Workload by activity per standardized surface (A_Du)
-    REAL(wp), PARAMETER :: eta = 0.0_wp          !< Mechanical work efficiency for walking on flat
-                                                 !< ground (compare to Fanger (1972) pp 24f)
-!
-!-- Type of program variables
-    REAL(wp), PARAMETER :: eps = 0.0005  !< Accuracy in clothing insulation (clo) for evaluation the root of Fanger's PMV (pmva=0)
-
-    INTEGER(iwp) :: ncount      !< running index
-    INTEGER(iwp) :: nerr_cold   !< error number (cold conditions)
-    INTEGER(iwp) :: nerr        !< error number
-
-    LOGICAL :: sultrieness
-
-    REAL(wp) ::  clon           !< clo for neutral conditions   (clo)
-    REAL(wp) ::  d_pmv          !< PMV deviation (dimensionless --> PMV)
-    REAL(wp) ::  dgtcm          !< Mean deviation dependent on perct
-    REAL(wp) ::  dgtcstd        !< Mean deviation plus its standard deviation
-    REAL(wp) ::  d_std          !< factor to threshold for sultriness
-    REAL(wp) ::  ireq_minimal   !< Minimal required clothing insulation (clo)
-    REAL(wp) ::  pmv_s          !< Fangers predicted mean vote for summer clothing
-    REAL(wp) ::  pmv_w          !< Fangers predicted mean vote for winter clothing
-    REAL(wp) ::  pmva           !< adjusted predicted mean vote
-    REAL(wp) ::  pmvs           !< pred. mean vote considering sultrieness
-    REAL(wp) ::  ptc            !< perceived temp. for cold conditions (degree_C)
-    REAL(wp) ::  sclo           !< summer clothing insulation
-    REAL(wp) ::  svp_ta         !< saturation vapor pressure    (hPa)
-    REAL(wp) ::  sult_lim       !< threshold for sultrieness    (hPa)
-    REAL(wp) ::  wclo           !< winter clothing insulation
-
-!
-!-- Initialise
-    perct_ij = bio_fill_value
-
-    nerr     = 0_iwp
-    ncount   = 0_iwp
-    sultrieness  = .FALSE.
-!
-!-- Tresholds: clothing insulation (account for model inaccuracies)
-!-- Summer clothing
-    sclo     = 0.44453_wp
-!
-!-- Winter clothing
-    wclo     = 1.76267_wp
-!
-!-- Eecision: first calculate for winter or summer clothing
-    IF ( ta <= 10.0_wp )  THEN
-!
-!--    First guess: winter clothing insulation: cold stress
-       clo = wclo
-       CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta, pmva )
-       pmv_w = pmva
-
-       IF ( pmva > 0.0_wp )  THEN
-!
-!--       Case summer clothing insulation: heat load ?
-          clo = sclo
-          CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta, pmva )
-          pmv_s = pmva
-          IF ( pmva <= 0.0_wp )  THEN
-!
-!--          Case: comfort achievable by varying clothing insulation between winter and summer set
-!--                values
-             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo, pmv_s, wclo, pmv_w, eps, &
-                               pmva, ncount, clo )
-             IF ( ncount < 0_iwp )  THEN
-                nerr = -1_iwp
-                RETURN
-             ENDIF
-          ELSE IF ( pmva > 0.06_wp )  THEN
-             clo = 0.5_wp
-             CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta,  pmva )
-          ENDIF
-       ELSE IF ( pmva < - 0.11_wp )  THEN
-          clo = 1.75_wp
-          CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta, pmva )
-       ENDIF
-    ELSE
-!
-!--    First guess: summer clothing insulation: heat load
-       clo = sclo
-       CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta, pmva )
-       pmv_s = pmva
-
-       IF ( pmva < 0.0_wp )  THEN
-!
-!--       Case winter clothing insulation: cold stress ?
-          clo = wclo
-          CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta, pmva )
-          pmv_w = pmva
-
-          IF ( pmva >= 0.0_wp )  THEN
-!
-!--          Case: comfort achievable by varying clothing insulation between winter and summer set
-!--                values
-             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo, pmv_s, wclo, pmv_w, eps, &
-                               pmva, ncount, clo )
-             IF ( ncount < 0_iwp )  THEN
-                nerr = -1_iwp
-                RETURN
-             ENDIF
-          ELSE IF ( pmva < - 0.11_wp )  THEN
-             clo = 1.75_wp
-             CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta, pmva )
-          ENDIF
-       ELSE IF ( pmva > 0.06_wp )  THEN
-          clo = 0.5_wp
-          CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta, pmva )
-       ENDIF
-
-    ENDIF
-!
-!-- Determine perceived temperature by regression equation + adjustments
-    pmvs = pmva
-    CALL perct_regression( pmva, clo, perct_ij )
-    ptc = perct_ij
-    IF ( clo >= 1.75_wp  .AND.  pmva <= - 0.11_wp )  THEN
-!
-!--    Adjust for cold conditions according to Gagge 1986
-       CALL dpmv_cold ( pmva, ta, ws, tmrt, nerr_cold, d_pmv )
-       IF ( nerr_cold > 0_iwp )  nerr = -5_iwp
-       pmvs = pmva - d_pmv
-       IF ( pmvs > - 0.11_wp )  THEN
-          d_pmv  = 0.0_wp
-          pmvs   = - 0.11_wp
-       ENDIF
-       CALL perct_regression( pmvs, clo, perct_ij )
-    ENDIF
-!     clo_fanger = clo
-    clon = clo
-    IF ( clo > 0.5_wp  .AND.  perct_ij <= 8.73_wp )  THEN
-!
-!--    Required clothing insulation (ireq) is exclusively defined for perceived temperatures (perct)
-!--    less 10 (C) for a reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s.
-       clon = ireq_neutral ( perct_ij, ireq_minimal, nerr )
-       clo = clon
-    ENDIF
-    CALL calc_sultr( ptc, dgtcm, dgtcstd, sult_lim )
-    sultrieness    = .FALSE.
-    d_std = -99.0_wp
-    IF ( pmva > 0.06_wp  .AND.  clo <= 0.5_wp )  THEN
-!
-!--    Adjust for warm/humid conditions according to Gagge 1986
-       CALL saturation_vapor_pressure ( ta, svp_ta )
-       d_pmv  = deltapmv ( pmva, ta, vp, svp_ta, tmrt, ws, nerr )
-       pmvs   = pmva + d_pmv
-       CALL perct_regression( pmvs, clo, perct_ij )
-       IF ( sult_lim < 99.0_wp )  THEN
-          IF ( (perct_ij - ptc) > sult_lim )  sultrieness = .TRUE.
-!
-!--       Set factor to threshold for sultriness
-          IF ( ABS( dgtcstd ) > 0.00001_wp )  THEN
-             d_std = ( ( perct_ij - ptc ) - dgtcm ) / dgtcstd
-          ENDIF
-       ENDIF
-    ENDIF
-
- END SUBROUTINE calculate_perct_static
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> The SUBROUTINE calculates the (saturation) water vapour pressure (hPa = hecto Pascal) for a given
-!> temperature ta (degC).
-!>'ta' can be the air temperature or the dew point temperature. The first will result in the current
-!> vapor pressure (hPa), the latter will calulate the saturation vapor pressure (hPa).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE saturation_vapor_pressure( ta, svp_ta )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT ( IN )  ::  ta     !< ambient air temperature (degC)
-    REAL(wp), INTENT ( OUT ) ::  svp_ta !< water vapour pressure (hPa)
-
-    REAL(wp)      ::  b
-    REAL(wp)      ::  c
-
-
-    IF ( ta < 0.0_wp )  THEN
-!
-!--    ta  < 0 (degC): water vapour pressure over ice
-       b = 17.84362_wp
-       c = 245.425_wp
-    ELSE
-!
-!--    ta >= 0 (degC): water vapour pressure over water
-       b = 17.08085_wp
-       c = 234.175_wp
-    ENDIF
-!
-!-- Saturation water vapour pressure
-    svp_ta = 6.1078_wp * EXP( b * ta / ( c + ta ) )
-
- END SUBROUTINE saturation_vapor_pressure
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Find the clothing insulation value clo_res (clo) to make Fanger's Predicted Mean Vote (PMV) equal
-!> comfort (pmva=0) for actual meteorological conditions (ta,tmrt, vp, ws, pair) and values of
-!> individual's activity level.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE iso_ridder( ta, tmrt, vp, ws, pair, actlev, eta, sclo, pmv_s, wclo, pmv_w, eps, pmva,  &
-                        nerr, clo_res )
-
-    IMPLICIT NONE
-!
-!-- Input variables of argument list:
-    REAL(wp), INTENT ( IN )  :: actlev   !< Individuals activity level per unit surface area (W/m2)
-    REAL(wp), INTENT ( IN )  :: eps      !< (0.05) accuracy in clothing insulation (clo) for evaluation the root of Fanger's PMV (pmva=0)
-    REAL(wp), INTENT ( IN )  :: eta      !< Individuals work efficiency (dimensionless)
-    REAL(wp), INTENT ( IN )  :: pair     !< Barometric air pressure (hPa)
-    REAL(wp), INTENT ( IN )  :: pmv_s    !< Fanger's PMV corresponding to sclo
-    REAL(wp), INTENT ( IN )  :: pmv_w    !< Fanger's PMV corresponding to wclo
-    REAL(wp), INTENT ( IN )  :: sclo     !< Lower threshold of bracketing clothing insulation (clo)
-    REAL(wp), INTENT ( IN )  :: ta       !< Ambient temperature (degC)
-    REAL(wp), INTENT ( IN )  :: tmrt     !< Mean radiant temperature (degC)
-    REAL(wp), INTENT ( IN )  :: vp       !< Water vapour pressure (hPa)
-    REAL(wp), INTENT ( IN )  :: wclo     !< Upper threshold of bracketing clothing insulation (clo)
-    REAL(wp), INTENT ( IN )  :: ws       !< Wind speed (m/s) 1 m above ground
-!
-!-- Output variables of argument list:
-    INTEGER(iwp), INTENT ( OUT ) :: nerr !< Error status / quality flag
-                                         !< nerr >= 0, o.k., and nerr is the number of iterations for convergence
-                                         !< nerr = -1: error = malfunction of Ridder's convergence method
-                                         !< nerr = -2: error = maximum iterations (max_iteration) exceeded
-                                         !< nerr = -3: error = root not bracketed between sclo and wclo
-
-    REAL(wp), INTENT ( OUT ) :: clo_res  !< Resulting clothing insulation value (clo)
-    REAL(wp), INTENT ( OUT ) :: pmva     !< 0 (set to zero, because clo is evaluated for comfort)
-!
-!-- Type of program variables
-    INTEGER(iwp), PARAMETER  ::  max_iteration = 15_iwp       !< max number of iterations
-
-    REAL(wp),     PARAMETER  ::  guess_0       = -1.11e30_wp  !< initial guess
-
-    INTEGER(iwp) ::  j       !< running index
-
-    REAL(wp) ::  clo_lower   !< lower limit of clothing insulation      (clo)
-    REAL(wp) ::  clo_upper   !< upper limit of clothing insulation      (clo)
-    REAL(wp) ::  sroot       !< sqrt of PMV-guess
-    REAL(wp) ::  x_average   !< average of x_lower and x_upper          (clo)
-    REAL(wp) ::  x_lower     !< lower guess for clothing insulation     (clo)
-    REAL(wp) ::  x_new       !< preliminary result for clothing insulation (clo)
-    REAL(wp) ::  x_ridder    !< current guess for clothing insulation   (clo)
-    REAL(wp) ::  x_upper     !< upper guess for clothing insulation     (clo)
-    REAL(wp) ::  y_average   !< average of y_lower and y_upper
-    REAL(wp) ::  y_new       !< preliminary result for pred. mean vote
-    REAL(wp) ::  y_lower     !< predicted mean vote for summer clothing
-    REAL(wp) ::  y_upper     !< predicted mean vote for winter clothing
-!
-!-- Initialise
-    nerr    = 0_iwp
-!
-!-- Set pmva = 0 (comfort): Root of PMV depending on clothing insulation
-    x_ridder    = bio_fill_value
-    pmva        = 0.0_wp
-    clo_lower   = sclo
-    y_lower     = pmv_s
-    clo_upper   = wclo
-    y_upper     = pmv_w
-    IF ( ( y_lower > 0.0_wp .AND. y_upper < 0.0_wp )  .OR.                                         &
-         ( y_lower < 0.0_wp .AND. y_upper > 0.0_wp ) )  THEN
-       x_lower  = clo_lower
-       x_upper  = clo_upper
-       x_ridder = guess_0
-
-       DO  j = 1_iwp, max_iteration
-          x_average = 0.5_wp * ( x_lower + x_upper )
-          CALL fanger ( ta, tmrt, vp, ws, pair, x_average, actlev, eta, y_average )
-          sroot = SQRT( y_average**2 - y_lower * y_upper )
-          IF ( ABS( sroot ) < 0.00001_wp )  THEN
-             clo_res = x_average
-             nerr = j
-             RETURN
-          ENDIF
-          x_new = x_average + ( x_average - x_lower ) *                                            &
-                  ( SIGN ( 1.0_wp, y_lower - y_upper ) * y_average / sroot )
-          IF ( ABS( x_new - x_ridder ) <= eps )  THEN
-             clo_res = x_ridder
-             nerr       = j
-             RETURN
-          ENDIF
-          x_ridder = x_new
-          CALL fanger ( ta, tmrt, vp, ws, pair, x_ridder, actlev, eta, y_new )
-          IF ( ABS( y_new ) < 0.00001_wp )  THEN
-             clo_res = x_ridder
-             nerr       = j
-             RETURN
-          ENDIF
-          IF ( ABS( SIGN( y_average, y_new ) - y_average ) > 0.00001_wp )  THEN
-             x_lower = x_average
-             y_lower = y_average
-             x_upper  = x_ridder
-             y_upper  = y_new
-          ELSE IF ( ABS( SIGN( y_lower, y_new ) - y_lower ) > 0.00001_wp )  THEN
-             x_upper  = x_ridder
-             y_upper  = y_new
-          ELSE IF ( ABS( SIGN( y_upper, y_new ) - y_upper ) > 0.00001_wp )  THEN
-             x_lower = x_ridder
-             y_lower = y_new
-          ELSE
-!
-!--          Never get here in x_ridder: singularity in y
-             nerr    = -1_iwp
-             clo_res = x_ridder
-             RETURN
-          ENDIF
-          IF ( ABS( x_upper - x_lower ) <= eps )  THEN
-             clo_res = x_ridder
-             nerr    = j
-             RETURN
-          ENDIF
-       ENDDO
-!
-!--    x_ridder exceed maximum iterations
-       nerr       = -2_iwp
-       clo_res = y_new
-       RETURN
-    ELSE IF ( ABS( y_lower ) < 0.00001_wp )  THEN
-       x_ridder = clo_lower
-    ELSE IF ( ABS( y_upper ) < 0.00001_wp )  THEN
-       x_ridder = clo_upper
-    ELSE
-!
-!--    x_ridder not bracketed by u_clo and o_clo
-       nerr = -3_iwp
-       clo_res = x_ridder
-       RETURN
-    ENDIF
-
- END SUBROUTINE iso_ridder
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Regression relations between perceived temperature (perct) and (adjusted) PMV. The regression
-!> presumes the Klima-Michel settings for reference individual and reference environment.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE perct_regression( pmv, clo, perct_ij )
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT ( IN ) ::  clo   !< clothing insulation index (clo)
-    REAL(wp), INTENT ( IN ) ::  pmv   !< Fangers predicted mean vote (dimensionless)
-
-    REAL(wp), INTENT ( OUT ) ::  perct_ij   !< perct (degC) corresponding to given PMV / clo
-
-    IF ( pmv <= - 0.11_wp )  THEN
-       perct_ij = 5.805_wp + 12.6784_wp * pmv
-    ELSE
-       IF ( pmv >= + 0.01_wp )  THEN
-          perct_ij = 16.826_wp + 6.163_wp * pmv
-       ELSE
-          perct_ij = 21.258_wp - 9.558_wp * clo
-       ENDIF
-    ENDIF
-
- END SUBROUTINE perct_regression
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> FANGER.F90
-!>
-!> SI-VERSION: ACTLEV W m-2, VAPOUR PRESSURE hPa
-!> Calculates the current Predicted Mean Vote according to Fanger.
-!> The case of free convection (ws < 0.1 m/s) is dealt with ws = 0.1 m/s
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE fanger( ta, tmrt, pa, in_ws, pair, in_clo, actlev, eta, pmva )
-
-    IMPLICIT NONE
-!
-!-- Input variables of argument list:
-    REAL(wp), INTENT ( IN ) ::  actlev   !< Individuals activity level per unit surface area (W/m2)
-    REAL(wp), INTENT ( IN ) ::  eta      !< Individuals mechanical work efficiency (dimensionless)
-    REAL(wp), INTENT ( IN ) ::  in_clo   !< Clothing insulation (clo)
-    REAL(wp), INTENT ( IN ) ::  in_ws    !< Wind speed (m/s) 1 m above ground
-    REAL(wp), INTENT ( IN ) ::  pa       !< Water vapour pressure (hPa)
-    REAL(wp), INTENT ( IN ) ::  pair     !< Barometric pressure (hPa) at site
-    REAL(wp), INTENT ( IN ) ::  ta       !< Ambient air temperature (degC)
-    REAL(wp), INTENT ( IN ) ::  tmrt     !< Mean radiant temperature (degC)
-
-!
-!-- Output variables of argument list:
-    REAL(wp), INTENT ( OUT ) ::  pmva    !< Actual Predicted Mean Vote (PMV,
-                                         !< dimensionless) according to Fanger corresponding to meteorological
-                                         !< (ta,tmrt,pa,ws,pair) and individual variables (clo, actlev, eta)
-!
-!-- Internal variables
-    INTEGER(iwp) :: i         !< running index
-
-    REAL(wp) ::  activity     !< persons activity  (must stay == actlev, W)
-    REAL(wp) ::  bc           !< preliminary result storage
-    REAL(wp) ::  cc           !< preliminary result storage
-    REAL(wp) ::  clo          !< clothing insulation index              (clo)
-    REAL(wp) ::  dc           !< preliminary result storage
-    REAL(wp) ::  ec           !< preliminary result storage
-    REAL(wp) ::  f_cl         !< Increase in surface due to clothing    (factor)
-    REAL(wp) ::  gc           !< preliminary result storage
-    REAL(wp) ::  heat_convection  !< energy loss by autocnvection       (W)
-    REAL(wp) ::  hr           !< radiational heat resistence
-    REAL(wp) ::  t_clothing   !< clothing temperature                   (degree_C)
-    REAL(wp) ::  t_skin_aver  !< average skin temperature               (degree_C)
-    REAL(wp) ::  ws           !< wind speed                             (m/s)
-    REAL(wp) ::  z1           !< Empiric factor for the adaption of the heat
-                              !< ballance equation to the psycho-physical scale (Equ. 40 in FANGER)
-    REAL(wp) ::  z2           !< Water vapour diffution through the skin
-    REAL(wp) ::  z3           !< Sweat evaporation from the skin surface
-    REAL(wp) ::  z4           !< Loss of latent heat through respiration
-    REAL(wp) ::  z5           !< Loss of radiational heat
-    REAL(wp) ::  z6           !< Heat loss through forced convection
-
-!
-!-- Clo must be > 0. to avoid div. by 0!
-    clo = in_clo
-    IF ( clo <= 0.0_wp )  clo = .001_wp
-!
-!-- f_cl = increase in surface due to clothing
-    f_cl = 1.0_wp + 0.15_wp * clo
-!
-!-- Case of free convection (ws < 0.1 m/s ) not considered
-    ws = in_ws
-    IF ( ws < 0.1_wp )  THEN
-       ws = 0.1_wp
-    ENDIF
-!
-!-- Heat_convection = forced convection
-    heat_convection = 12.1_wp * SQRT( ws * pair / 1013.25_wp )
-!
-!-- Activity = inner heat production per standardized surface
-    activity = actlev * ( 1.0_wp - eta )
-!
-!-- t_skin_aver = average skin temperature
-    t_skin_aver = 35.7_wp - 0.0275_wp * activity
-!
-!-- Calculation of constants for evaluation below
-    bc = 0.155_wp * clo * 3.96_wp * 10.0_wp**( -8 ) * f_cl
-    cc = f_cl * heat_convection
-    ec = 0.155_wp * clo
-    dc = ( 1.0_wp + ec * cc ) / bc
-    gc = ( t_skin_aver + bc * ( tmrt + degc_to_k )**4 + ec * cc * ta ) / bc
-!
-!-- Calculation of clothing surface temperature (t_clothing) based on Newton-approximation with air
-!-- temperature as initial guess.
-    t_clothing = ta
-    DO  i = 1, 3
-       t_clothing = t_clothing - ( ( t_clothing + degc_to_k )**4 + t_clothing * dc - gc ) /        &
-                    ( 4.0_wp * ( t_clothing + degc_to_k )**3 + dc )
-    ENDDO
-!
-!-- Empiric factor for the adaption of the heat ballance equation to the psycho-physical scale (Equ.
-!-- 40 in FANGER)
-    z1 = ( 0.303_wp * EXP( - 0.036_wp * actlev ) + 0.0275_wp )
-!
-!-- Water vapour diffution through the skin
-    z2 = 0.31_wp * ( 57.3_wp - 0.07_wp * activity-pa )
-!
-!-- Sweat evaporation from the skin surface
-    z3 = 0.42_wp * ( activity - 58.0_wp )
-!
-!-- Loss of latent heat through respiration
-    z4 = 0.0017_wp * actlev * ( 58.7_wp - pa ) + 0.0014_wp * actlev *                              &
-         ( 34.0_wp - ta )
-!
-!-- Loss of radiational heat
-    z5 = 3.96e-8_wp * f_cl * ( ( t_clothing + degc_to_k )**4 - ( tmrt + degc_to_k )**4 )
-    IF ( ABS( t_clothing - tmrt ) > 0.0_wp )  THEN
-       hr = z5 / f_cl / ( t_clothing - tmrt )
-    ELSE
-       hr = 0.0_wp
-    ENDIF
-!
-!-- Heat loss through forced convection cc*(t_clothing-TT)
-    z6 = cc * ( t_clothing - ta )
-!
-!-- Predicted Mean Vote
-    pmva = z1 * ( activity - z2 - z3 - z4 - z5 - z6 )
-
- END SUBROUTINE fanger
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> For pmva > 0 and clo =0.5 the increment (deltapmv) is calculated that converts pmva into Gagge's
-!> et al. (1986) PMV*.
-!--------------------------------------------------------------------------------------------------!
- REAL(wp) FUNCTION deltapmv( pmva, ta, vp, svp_ta, tmrt, ws, nerr )
-
-    IMPLICIT NONE
-
-!
-!-- Input variables of argument list:
-    REAL(wp),     INTENT ( IN )  :: pmva     !< Actual Predicted Mean Vote (PMV) according to Fanger
-    REAL(wp),     INTENT ( IN )  :: svp_ta   !< Saturation water vapour pressure (hPa) at ta
-    REAL(wp),     INTENT ( IN )  :: ta       !< Ambient temperature (degC) at screen level
-    REAL(wp),     INTENT ( IN )  :: tmrt     !< Mean radiant temperature (degC) at screen level
-    REAL(wp),     INTENT ( IN )  :: vp       !< Water vapour pressure (hPa) at screen level
-    REAL(wp),     INTENT ( IN )  :: ws       !< Wind speed (m/s) 1 m above ground
-
-!
-!-- Output variables of argument list:
-    INTEGER(iwp), INTENT ( OUT ) :: nerr     !< Error status / quality flag
-                                             !<  0 = o.k.
-                                             !< -2 = pmva outside valid regression range
-                                             !< -3 = rel. humidity set to 5 % or 95 %, respectively
-                                             !< -4 = deltapmv set to avoid pmvs < 0
-
-!
-!-- Internal variables:
-    INTEGER(iwp) :: nreg      !<
-
-    REAL(wp) ::  apa          !< natural logarithm of pa (with hard lower border)
-    REAL(wp) ::  dapa         !< difference of apa and pa_p50
-    REAL(wp) ::  dpmv_1       !<
-    REAL(wp) ::  dpmv_2       !<
-    REAL(wp) ::  dtmrt        !< difference mean radiation to air temperature
-    REAL(wp) ::  pa           !< vapor pressure (hPa) with hard bounds
-    REAL(wp) ::  pa_p50       !< ratio actual water vapour pressure to that of relative humidity of
-                              !< 50 %
-    REAL(wp) ::  pmv          !< temp storage og predicted mean vote
-    REAL(wp) ::  pmvs         !<
-    REAL(wp) ::  p10          !< lower bound for pa
-    REAL(wp) ::  p95          !< upper bound for pa
-    REAL(wp) ::  sqvel        !< square root of local wind velocity
-    REAL(wp) ::  weight       !<
-    REAL(wp) ::  weight2      !<
-
-!
-!-- Regression coefficients:
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bpmv = (/                                              &
-     - 0.0556602_wp, - 0.1528680_wp, - 0.2336104_wp, - 0.2789387_wp,                               &
-     - 0.3551048_wp, - 0.4304076_wp, - 0.4884961_wp, - 0.4897495_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bpa_p50 = (/                                           &
-     - 0.1607154_wp, - 0.4177296_wp, - 0.4120541_wp, - 0.0886564_wp,                               &
-       0.4285938_wp,   0.6281256_wp,   0.5067361_wp,   0.3965169_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bpa = (/                                               &
-       0.0580284_wp,   0.0836264_wp,   0.1009919_wp,   0.1020777_wp,                               &
-       0.0898681_wp,   0.0839116_wp,   0.0853258_wp,   0.0866589_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bapa = (/                                              &
-     - 1.7838788_wp, - 2.9306231_wp, - 1.6350334_wp,    0.6211547_wp,                              &
-       3.3918083_wp,   5.5521025_wp,   8.4897418_wp,   16.6265851_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bdapa = (/                                             &
-       1.6752720_wp,   2.7379504_wp,   1.2940526_wp, -  1.0985759_wp,                              &
-     - 3.9054732_wp, - 6.0403012_wp, - 8.9437119_wp, - 17.0671201_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bsqvel = (/                                            &
-     - 0.0315598_wp, - 0.0286272_wp, - 0.0009228_wp,   0.0483344_wp,                               &
-       0.0992366_wp,   0.1491379_wp,   0.1951452_wp,   0.2133949_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bta = (/                                               &
-       0.0953986_wp,   0.1524760_wp,   0.0564241_wp, - 0.0893253_wp,                               &
-     - 0.2398868_wp, - 0.3515237_wp, - 0.5095144_wp, - 0.9469258_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bdtmrt = (/                                            &
-     - 0.0004672_wp, - 0.0000514_wp, - 0.0018037_wp, - 0.0049440_wp,                               &
-     - 0.0069036_wp, - 0.0075844_wp, - 0.0079602_wp, - 0.0089439_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  aconst = (/                                            &
-       1.8686215_wp,   3.4260713_wp,    2.0116185_wp, -  0.7777552_wp,                             &
-     - 4.6715853_wp, - 7.7314281_wp, - 11.7602578_wp, - 23.5934198_wp /)
-
-
-!
-!-- Test for compliance with regression range
-    IF ( pmva < -1.0_wp  .OR.  pmva > 7.0_wp )  THEN
-       nerr = -2_iwp
-    ELSE
-       nerr = 0_iwp
-    ENDIF
-!
-!-- Initialise classic PMV
-    pmv  = pmva
-!
-!-- Water vapour pressure of air
-    p10  = 0.05_wp * svp_ta
-    p95  = 1.00_wp * svp_ta
-    IF ( vp >= p10  .AND.  vp <= p95 )  THEN
-       pa = vp
-    ELSE
-       nerr = -3_iwp
-       IF ( vp < p10 )  THEN
-!
-!--       Due to conditions of regression: r.H. >= 5 %
-          pa = p10
-       ELSE
-!
-!--       Due to conditions of regression: r.H. <= 95 %
-          pa = p95
-       ENDIF
-    ENDIF
-    IF ( pa > 0.0_wp )  THEN
-!
-!--    Natural logarithm of pa
-       apa = LOG( pa )
-    ELSE
-       apa = -5.0_wp
-    ENDIF
-!
-!-- Ratio actual water vapour pressure to that of a r.H. of 50 %
-    pa_p50   = 0.5_wp * svp_ta
-    IF ( pa_p50 > 0.0_wp  .AND.  pa > 0.0_wp )  THEN
-       dapa   = apa - LOG( pa_p50 )
-       pa_p50 = pa / pa_p50
-    ELSE
-       dapa   = -5.0_wp
-       pa_p50 = 0.0_wp
-    ENDIF
-!
-!-- Square root of wind velocity
-    IF ( ws >= 0.0_wp )  THEN
-       sqvel = SQRT( ws )
-    ELSE
-       sqvel = 0.0_wp
-    ENDIF
-!
-!-- Difference mean radiation to air temperature
-    dtmrt = tmrt - ta
-!
-!-- Select the valid regression coefficients
-    nreg = INT( pmv )
-    IF ( nreg < 0_iwp )  THEN
-!
-!--    Value of the FUNCTION in the case pmv <= -1
-       deltapmv = 0.0_wp
-       RETURN
-    ENDIF
-    weight = MOD ( pmv, 1.0_wp )
-    IF ( weight < 0.0_wp )  weight = 0.0_wp
-    IF ( nreg > 5_iwp )  THEN
-       nreg  = 5_iwp
-       weight   = pmv - 5.0_wp
-       weight2  = pmv - 6.0_wp
-       IF ( weight2 > 0_iwp )  THEN
-          weight = ( weight - weight2 ) / weight
-       ENDIF
-    ENDIF
-!
-!-- Regression valid for 0. <= pmv <= 6., bounds are checked above
-    dpmv_1 =                                                                                       &
-             + bpa(nreg)     * pa                                                                  &
-             + bpmv(nreg)    * pmv                                                                 &
-             + bapa(nreg)    * apa                                                                 &
-             + bta(nreg)     * ta                                                                  &
-             + bdtmrt(nreg)  * dtmrt                                                               &
-             + bdapa(nreg)   * dapa                                                                &
-             + bsqvel(nreg)  * sqvel                                                               &
-             + bpa_p50(nreg) * pa_p50                                                              &
-             + aconst(nreg)
-
-!    dpmv_2 = 0.0_wp
-!    IF ( nreg < 6_iwp )  THEN  !< nreg is always <= 5, see above
-    dpmv_2 =                                                                                       &
-             + bpa(nreg+1_iwp)     * pa                                                            &
-             + bpmv(nreg+1_iwp)    * pmv                                                           &
-             + bapa(nreg+1_iwp)    * apa                                                           &
-             + bta(nreg+1_iwp)     * ta                                                            &
-             + bdtmrt(nreg+1_iwp)  * dtmrt                                                         &
-             + bdapa(nreg+1_iwp)   * dapa                                                          &
-             + bsqvel(nreg+1_iwp)  * sqvel                                                         &
-             + bpa_p50(nreg+1_iwp) * pa_p50                                                        &
-             + aconst(nreg+1_iwp)
-!    ENDIF
-!
-!-- Calculate pmv modification
-    deltapmv = ( 1.0_wp - weight ) * dpmv_1 + weight * dpmv_2
-    pmvs = pmva + deltapmv
-    IF ( ( pmvs ) < 0.0_wp )  THEN
-!
-!--    Prevent negative pmv* due to problems with clothing insulation
-       nerr = -4_iwp
-       IF ( pmvs > -0.11_wp )  THEN
-!
-!--       Threshold from perct_regression for winter clothing insulation
-          deltapmv = deltapmv + 0.11_wp
-       ELSE
-!
-!--       Set pmvs to "0" for compliance with summer clothing insulation
-          deltapmv = -1.0_wp * pmva
-       ENDIF
-    ENDIF
-
- END FUNCTION deltapmv
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> The subroutine "calc_sultr" returns a threshold value to perceived temperature allowing to decide
-!> whether the actual perceived temperature is linked to perecption of sultriness. The threshold
-!> values depends on the Fanger's classical PMV, expressed here as perceived temperature perct.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_sultr( perct_ij, dperctm, dperctstd, sultr_res )
-
-    IMPLICIT NONE
-!
-!-- Input of the argument list:
-    REAL(wp), INTENT ( IN )  ::  perct_ij   !< Classical perceived temperature: Base is Fanger's PMV
-!
-!-- Additional output variables of argument list:
-    REAL(wp), INTENT ( OUT ) ::  dperctm    !< Mean deviation perct (classical gt) to gt* (rational
-                                            !< gt calculated based on Gagge's rational PMV*)
-    REAL(wp), INTENT ( OUT ) ::  dperctstd  !< dperctm plus its standard deviation times a factor
-                                            !< determining the significance to perceive sultriness
-    REAL(wp), INTENT ( OUT ) ::  sultr_res
-!
-!-- Types of coefficients mean deviation: third order polynomial
-    REAL(wp), PARAMETER ::  dperctka =   7.5776086_wp
-    REAL(wp), PARAMETER ::  dperctkb = - 0.740603_wp
-    REAL(wp), PARAMETER ::  dperctkc =   0.0213324_wp
-    REAL(wp), PARAMETER ::  dperctkd = - 0.00027797237_wp
-!
-!-- Types of coefficients mean deviation plus standard deviation
-!-- regression coefficients: third order polynomial
-    REAL(wp), PARAMETER ::  dperctsa =   0.0268918_wp
-    REAL(wp), PARAMETER ::  dperctsb =   0.0465957_wp
-    REAL(wp), PARAMETER ::  dperctsc = - 0.00054709752_wp
-    REAL(wp), PARAMETER ::  dperctsd =   0.0000063714823_wp
-!
-!-- Factor to mean standard deviation defining SIGNificance for
-!-- sultriness
-    REAL(wp), PARAMETER :: faktor = 1.0_wp
-!
-!-- Initialise
-    sultr_res = 99.0_wp
-    dperctm   = 0.0_wp
-    dperctstd = 999999.0_wp
-
-    IF ( perct_ij < 16.826_wp  .OR.  perct_ij > 56.0_wp )  THEN
-!
-!--    Unallowed value of classical perct!
-       RETURN
-    ENDIF
-!
-!-- Mean deviation dependent on perct
-    dperctm = dperctka + dperctkb * perct_ij + dperctkc * perct_ij**2.0_wp + dperctkd *            &
-              perct_ij**3.0_wp
-!
-!-- Mean deviation plus its standard deviation
-    dperctstd = dperctsa + dperctsb * perct_ij + dperctsc * perct_ij**2.0_wp + dperctsd *          &
-                perct_ij**3.0_wp
-!
-!-- Value of the FUNCTION
-    sultr_res = dperctm + faktor * dperctstd
-    IF ( ABS( sultr_res ) > 99.0_wp )  sultr_res = +99.0_wp
-
- END SUBROUTINE calc_sultr
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Multiple linear regression to calculate an increment delta_cold, to adjust Fanger's classical PMV
-!> (pmva) by Gagge's 2 node model, applying Fanger's convective heat transfer coefficient, hcf.
-!> Wind velocitiy of the reference environment is 0.10 m/s
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dpmv_cold( pmva, ta, ws, tmrt, nerr, dpmv_cold_res )
-
-    IMPLICIT NONE
-!
-!-- Type of input arguments
-    REAL(wp), INTENT ( IN ) ::  pmva   !< Fanger's classical predicted mean vote
-    REAL(wp), INTENT ( IN ) ::  ta     !< Air temperature 2 m above ground (degC)
-    REAL(wp), INTENT ( IN ) ::  tmrt   !< Mean radiant temperature (degC)
-    REAL(wp), INTENT ( IN ) ::  ws     !< Relative wind velocity 1 m above ground (m/s)
-!
-!-- Type of output argument
-    INTEGER(iwp), INTENT ( OUT ) ::  nerr !< Error indicator: 0 = o.k., +1 = denominator for
-                                          !< intersection = 0
-
-    REAL(wp),     INTENT ( OUT ) ::  dpmv_cold_res    !< Increment to adjust pmva according to the
-                                                      !< results of Gagge's 2 node model depending on the input
-!
-!-- Type of program variables
-    INTEGER(iwp) ::  i          !< running index
-    INTEGER(iwp) ::  i_bin      !< result row number
-
-    REAL(wp) ::  delta_cold(3)
-    REAL(wp) ::  dtmrt          !< delta mean radiant temperature
-    REAL(wp) ::  pmv_cross(2)
-    REAL(wp) ::  reg_a(3)
-    REAL(wp) ::  r_denominator  !< the regression equations denominator
-    REAL(wp) ::  sqrt_ws        !< sqare root of wind speed
-
-!    REAL(wp) ::  coeff(3,5)  !< unsafe! array is (re-)writable!
-!    coeff(1,1:5) =                                                             &
-!       (/ +0.161_wp,   +0.130_wp, -1.125E-03_wp, +1.106E-03_wp, -4.570E-04_wp /)
-!    coeff(2,1:5) =                                                             &
-!       (/  0.795_wp,    0.713_wp, -8.880E-03_wp, -1.803E-03_wp, -2.816E-03_wp /)
-!    coeff(3,1:5) =                                                             &
-!       (/ +0.05761_wp, +0.458_wp, -1.829E-02_wp, -5.577E-03_wp, -1.970E-03_wp /)
-
-!
-!-- Coefficient of the 3 regression lines:
-!      1:const      2:*pmva    3:*ta          4:*sqrt_ws     5:*dtmrt
-    REAL(wp), DIMENSION(1:3,1:5), PARAMETER ::  coeff = RESHAPE( (/                                &
-        0.161_wp,   0.130_wp, -1.125E-03_wp,  1.106E-03_wp, -4.570E-04_wp,                         &
-        0.795_wp,   0.713_wp, -8.880E-03_wp, -1.803E-03_wp, -2.816E-03_wp,                         &
-        0.05761_wp, 0.458_wp, -1.829E-02_wp, -5.577E-03_wp, -1.970E-03_wp                          &
-       /), SHAPE( coeff ), order=(/ 2, 1 /)                    )
-!
-!-- Initialise
-    nerr           = 0_iwp
-    dpmv_cold_res  = 0.0_wp
-    dtmrt          = tmrt - ta
-    sqrt_ws        = ws
-    IF ( sqrt_ws < 0.1_wp )  THEN
-       sqrt_ws = 0.1_wp
-    ELSE
-       sqrt_ws = SQRT( sqrt_ws )
-    ENDIF
-
-    delta_cold = 0.0_wp
-    pmv_cross = pmva
-
-!
-!-- Determine regression constant for given meteorological conditions
-    DO  i = 1, 3
-       reg_a(i) = coeff(i,1) + coeff(i,3) * ta + coeff(i,4) * sqrt_ws + coeff(i,5)*dtmrt
-       delta_cold(i) = reg_a(i) + coeff(i,2) * pmva
-    ENDDO
-!
-!-- Intersection points of regression lines in terms of Fanger's PMV
-    DO  i = 1, 2
-       r_denominator = coeff(i,2) - coeff(i+1,2)
-       IF ( ABS( r_denominator ) > 0.00001_wp )  THEN
-          pmv_cross(i) = ( reg_a(i+1) - reg_a(i) ) / r_denominator
-       ELSE
-          nerr = 1_iwp
-          RETURN
-       ENDIF
-    ENDDO
-!
-!-- Select result row number
-    i_bin = 3
-    DO  i = 1, 2
-       IF ( pmva > pmv_cross(i) )  THEN
-          i_bin = i
-          EXIT
-       ENDIF
-    ENDDO
-!
-!-- Adjust to operative temperature scaled according to classical PMV (Fanger)
-    dpmv_cold_res = delta_cold(i_bin) - dpmv_cold_adj(pmva)
-
- END SUBROUTINE dpmv_cold
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates the summand dpmv_cold_adj adjusting to the operative temperature scaled according to
-!> classical PMV (Fanger) for cold conditions. Valid for reference environment: v (1m) = 0.10 m/s,
-!> dTMRT = 0 K, r.h. = 50 %
-!--------------------------------------------------------------------------------------------------!
- REAL(wp) FUNCTION dpmv_cold_adj( pmva )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)  ::  i       !< running index
-    INTEGER(iwp)  ::  thr     !< thermal range
-
-    REAL(wp), INTENT ( IN ) ::  pmva        !< (adjusted) Predicted Mean Vote
-
-    REAL(wp)  ::  pmv     !< pmv-part of the regression
-
-!
-!-- Provide regression coefficients for three thermal ranges:
-!--                                                    slightly cold  cold           very cold
-    REAL(wp), DIMENSION(1:3,0:3), PARAMETER ::  coef = RESHAPE( (/                                 &
-                                                       0.0941540_wp, -0.1506620_wp, -0.0871439_wp, &
-                                                       0.0783162_wp, -1.0612651_wp,  0.1695040_wp, &
-                                                       0.1350144_wp, -1.0049144_wp, -0.0167627_wp, &
-                                                       0.1104037_wp, -0.2005277_wp, -0.0003230_wp  &
-                                                                 /), SHAPE(coef), order=(/ 1, 2 /) )
-!
-!-- Select thermal range
-    IF ( pmva <= -2.1226_wp )  THEN     !< very cold
-       thr = 3_iwp
-    ELSE IF ( pmva <= -1.28_wp )  THEN  !< cold
-       thr = 2_iwp
-    ELSE                                !< slightly cold
-       thr = 1_iwp
-    ENDIF
-!
-!-- Initialize
-    dpmv_cold_adj = coef(thr,0)
-    pmv           = 1.0_wp
-!
-!-- Calculate pmv adjustment (dpmv_cold_adj)
-    DO  i = 1, 3
-       pmv           = pmv * pmva
-       dpmv_cold_adj = dpmv_cold_adj + coef(thr,i) * pmv
-    ENDDO
-
-    RETURN
- END FUNCTION dpmv_cold_adj
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Based on perceived temperature (perct) as input, ireq_neutral determines the required clothing
-!> insulation (clo) for thermally neutral conditions (neither body cooling nor body heating). It is
-!> related to the Klima-Michel activity level (134.682 W/m2). IREQ_neutral is only defined for perct
-!> < 10 (degC)
-!--------------------------------------------------------------------------------------------------!
- REAL(wp) FUNCTION ireq_neutral( perct_ij, ireq_minimal, nerr )
-
-    IMPLICIT NONE
-!
-!-- Type declaration of arguments
-    INTEGER(iwp), INTENT ( OUT ) ::  nerr
-
-    REAL(wp),     INTENT ( IN )  ::  perct_ij
-    REAL(wp),     INTENT ( OUT ) ::  ireq_minimal
-!
-!-- Type declaration for internal varables
-    REAL(wp)                     ::  perct02
-!
-!-- Initialise
-    nerr = 0_iwp
-!
-!-- Convert perceived temperature from basis 0.1 m/s to basis 0.2 m/s
-    perct02 = 1.8788_wp + 0.9296_wp * perct_ij
-!
-!-- IREQ neutral conditions (thermal comfort)
-    ireq_neutral = 1.62_wp - 0.0564_wp * perct02
-!
-!-- Regression only defined for perct <= 10 (degC)
-    IF ( ireq_neutral < 0.5_wp )  THEN
-       IF ( ireq_neutral < 0.48_wp )  THEN
-          nerr = 1_iwp
-       ENDIF
-       ireq_neutral = 0.5_wp
-    ENDIF
-!
-!-- Minimal required clothing insulation: maximal acceptable body cooling
-    ireq_minimal = 1.26_wp - 0.0588_wp * perct02
-    IF ( nerr > 0_iwp )  THEN
-       ireq_minimal = ireq_neutral
-    ENDIF
-
-    RETURN
- END FUNCTION ireq_neutral
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> The SUBROUTINE surface area calculates the surface area of the individual according to its height
-!> (m), weight (kg), and age (y)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_area( height_cm, weight, age, surf )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(in)  ::  age
-
-    REAL(wp)    , INTENT(in)  ::  height_cm
-    REAL(wp)    , INTENT(in)  ::  weight
-
-    REAL(wp)    , INTENT(out) ::  surf
-
-    REAL(wp)                  ::  height
-
-    height = height_cm * 100.0_wp
-!
-!-- According to Gehan-George, for children
-    IF ( age < 19_iwp )  THEN
-       IF ( age < 5_iwp )  THEN
-          surf = 0.02667_wp * height**0.42246_wp * weight**0.51456_wp
-          RETURN
-       ENDIF
-       surf = 0.03050_wp * height**0.35129_wp * weight**0.54375_wp
-       RETURN
-    ENDIF
-!
-!-- DuBois D, DuBois EF: A formula to estimate the approximate surface area if height and weight be
-!>  known. In: Arch. Int. Med.. 17, 1916, pp. 863:871.
-    surf = 0.007184_wp * height**0.725_wp * weight**0.425_wp
-    RETURN
-
- END SUBROUTINE surface_area
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> The SUBROUTINE persdat calculates
-!>  - the total internal energy production = metabolic + workload,
-!>  - the total internal energy production for a standardized surface (actlev)
-!>  - the DuBois - area (a_surf [m2])
-!> from
-!>  - the persons age (years),
-!>  - weight (kg),
-!>  - height (m),
-!>  - sex (1 = male, 2 = female),
-!>  - work load (W)
-!> for a sample human.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE persdat( age, weight, height, sex, work, a_surf, actlev )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(in) ::  sex
-
-
-    REAL(wp), INTENT(in) ::  age
-    REAL(wp), INTENT(in) ::  height
-    REAL(wp), INTENT(in) ::  weight
-    REAL(wp), INTENT(in) ::  work
-
-    REAL(wp), INTENT(out) ::  actlev
-
-    REAL(wp) ::  a_surf
-    REAL(wp) ::  basic_heat_prod
-    REAL(wp) ::  energy_prod
-    REAL(wp) ::  factor
-    REAL(wp) ::  s
-
-
-    CALL surface_area( height, weight, INT( age ), a_surf )
-    s = height * 100.0_wp / ( weight**( 1.0_wp / 3.0_wp ) )
-    factor = 1.0_wp + .004_wp  * ( 30.0_wp - age )
-    basic_heat_prod = 0.0_wp
-    IF ( sex == 1_iwp )  THEN
-       basic_heat_prod = 3.45_wp * weight**( 3.0_wp / 4.0_wp ) * ( factor + 0.01_wp                &
-                         * ( s - 43.4_wp ) )
-    ELSE IF ( sex == 2_iwp )  THEN
-       basic_heat_prod = 3.19_wp * weight**( 3.0_wp / 4.0_wp ) * ( factor + 0.018_wp               &
-                         * ( s - 42.1_wp ) )
-    ENDIF
-
-    energy_prod = work + basic_heat_prod
-    actlev = energy_prod / a_surf
-
- END SUBROUTINE persdat
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> SUBROUTINE ipt_init
-!> initializes the instationary perceived temperature
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE ipt_init( age, weight, height, sex, work, actlev, clo, ta, vp, ws, tmrt, pair, dt,     &
-                      storage, t_clothing, ipt )
-
-    IMPLICIT NONE
-!
-!-- Input parameters
-
-    INTEGER(iwp), INTENT(in)  :: sex    !< Persons sex (1 = male, 2 = female)
-
-    REAL(wp), INTENT(in) ::  age        !< Persons age          (years)
-    REAL(wp), INTENT(in) ::  dt         !< Timestep             (s)
-    REAL(wp), INTENT(in) ::  height     !< Persons height       (m)7
-    REAL(wp), INTENT(in) ::  pair       !< Air pressure         (hPa)
-    REAL(wp), INTENT(in) ::  ta         !< Air Temperature      (degree_C)
-    REAL(wp), INTENT(in) ::  tmrt       !< Mean radiant temperature   (degree_C)
-    REAL(wp), INTENT(in) ::  vp         !< Vapor pressure       (hPa)
-    REAL(wp), INTENT(in) ::  weight     !< Persons weight       (kg)
-    REAL(wp), INTENT(in) ::  work       !< Current workload     (W)
-    REAL(wp), INTENT(in) ::  ws         !< Wind speed in approx. 1.1m (m/s)
-!
-!-- Output parameters
-    REAL(wp), INTENT(out) ::  actlev
-    REAL(wp), INTENT(out) ::  clo
-    REAL(wp), INTENT(out) ::  ipt
-    REAL(wp), INTENT(out) ::  storage
-    REAL(wp), INTENT(out) ::  t_clothing
-!
-!-- Internal variables
-    REAL(wp), PARAMETER :: eps = 0.0005_wp
-    REAL(wp), PARAMETER :: eta = 0.0_wp
-
-    INTEGER(iwp) ::  ncount
-    INTEGER(iwp) ::  nerr_cold
-    INTEGER(iwp) ::  nerr
-
-    LOGICAL ::  sultrieness
-
-!    REAL(wp) ::  acti
-    REAL(wp) ::  a_surf
-!    REAL(wp) ::  clo_fanger
-    REAL(wp) ::  clon
-    REAL(wp) ::  d_pmv
-    REAL(wp) ::  d_std
-    REAL(wp) ::  dgtcm
-    REAL(wp) ::  dgtcstd
-    REAL(wp) ::  ireq_minimal
-    REAL(wp) ::  pmv_s
-    REAL(wp) ::  pmv_w
-    REAL(wp) ::  pmva
-    REAL(wp) ::  pmvs
-    REAL(wp) ::  ptc
-    REAL(wp) ::  sclo
-    REAL(wp) ::  sult_lim
-    REAL(wp) ::  svp_ta
-    REAL(wp) ::  wclo
-
-
-    storage = 0.0_wp
-    CALL persdat( age, weight, height, sex, work, a_surf, actlev )
-!
-!-- Initialise
-    t_clothing = bio_fill_value
-    ipt        = bio_fill_value
-    nerr       = 0_wp
-    ncount     = 0_wp
-    sultrieness    = .FALSE.
-!
-!-- Tresholds: clothing insulation (account for model inaccuracies)
-!-- Summer clothing
-    sclo     = 0.44453_wp
-!-- Winter clothing
-    wclo     = 1.76267_wp
-!
-!-- Decision: firstly calculate for winter or summer clothing
-    IF ( ta <= 10.0_wp )  THEN
-!
-!--    First guess: winter clothing insulation: cold stress
-       clo = wclo
-       t_clothing = bio_fill_value  ! force initial run
-       CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt,    &
-                            pmva )
-       pmv_w = pmva
-
-       IF ( pmva > 0.0_wp )  THEN
-!
-!--       Case summer clothing insulation: heat load ?
-          clo = sclo
-          t_clothing = bio_fill_value  ! force initial run
-          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt, &
-                               pmva )
-          pmv_s = pmva
-          IF ( pmva <= 0.0_wp )  THEN
-!
-!--          Case: comfort achievable by varying clothing insulation between winter and summer set
-!--                values
-             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta , sclo, pmv_s, wclo, pmv_w, eps,&
-                               pmva, ncount, clo )
-             IF ( ncount < 0_iwp )  THEN
-                nerr = -1_iwp
-                RETURN
-             ENDIF
-          ELSE IF ( pmva > 0.06_wp )  THEN
-             clo = 0.5_wp
-             t_clothing = bio_fill_value
-             CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage,  &
-                                  dt, pmva )
-          ENDIF
-       ELSE IF ( pmva < - 0.11_wp )  THEN
-          clo = 1.75_wp
-          t_clothing = bio_fill_value
-          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt, &
-                               pmva )
-       ENDIF
-
-    ELSE
-!
-!--    First guess: summer clothing insulation: heat load
-       clo = sclo
-       t_clothing = bio_fill_value
-       CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt,    &
-                            pmva )
-       pmv_s = pmva
-
-       IF ( pmva < 0.0_wp )  THEN
-!
-!--       Case winter clothing insulation: cold stress ?
-          clo = wclo
-          t_clothing = bio_fill_value
-          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt, &
-                               pmva )
-          pmv_w = pmva
-
-          IF ( pmva >= 0.0_wp )  THEN
-!
-!--          Case: comfort achievable by varying clothing insulation between winter and summer set
-!--                values
-             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo, pmv_s, wclo, pmv_w, eps, &
-                               pmva, ncount, clo )
-             IF ( ncount < 0_wp )  THEN
-                nerr = -1_iwp
-                RETURN
-             ENDIF
-          ELSE IF ( pmva < - 0.11_wp )  THEN
-             clo = 1.75_wp
-             t_clothing = bio_fill_value
-             CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage,  &
-                                  dt, pmva )
-          ENDIF
-       ELSE IF ( pmva > 0.06_wp )  THEN
-          clo = 0.5_wp
-          t_clothing = bio_fill_value
-          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt, &
-                               pmva )
-       ENDIF
-
-    ENDIF
-!
-!-- Determine perceived temperature by regression equation + adjustments
-    pmvs = pmva
-    CALL perct_regression( pmva, clo, ipt )
-    ptc = ipt
-    IF ( clo >= 1.75_wp  .AND.  pmva <= - 0.11_wp )  THEN
-!
-!--    Adjust for cold conditions according to Gagge 1986
-       CALL dpmv_cold ( pmva, ta, ws, tmrt, nerr_cold, d_pmv )
-       IF ( nerr_cold > 0_iwp )  nerr = -5_iwp
-       pmvs = pmva - d_pmv
-       IF ( pmvs > - 0.11_wp )  THEN
-          d_pmv  = 0.0_wp
-          pmvs   = - 0.11_wp
-       ENDIF
-       CALL perct_regression( pmvs, clo, ipt )
-    ENDIF
-!     clo_fanger = clo
-    clon = clo
-    IF ( clo > 0.5_wp  .AND.  ipt <= 8.73_wp )  THEN
-!
-!--    Required clothing insulation (ireq) is exclusively defined for perceived temperatures (ipt)
-!--    less 10 (C) for a reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s
-       clon = ireq_neutral ( ipt, ireq_minimal, nerr )
-       clo = clon
-    ENDIF
-    CALL calc_sultr( ptc, dgtcm, dgtcstd, sult_lim )
-    sultrieness    = .FALSE.
-    d_std      = - 99.0_wp
-    IF ( pmva > 0.06_wp  .AND.  clo <= 0.5_wp )  THEN
-!
-!--    Adjust for warm/humid conditions according to Gagge 1986
-       CALL saturation_vapor_pressure ( ta, svp_ta )
-       d_pmv  = deltapmv ( pmva, ta, vp, svp_ta, tmrt, ws, nerr )
-       pmvs   = pmva + d_pmv
-       CALL perct_regression( pmvs, clo, ipt )
-       IF ( sult_lim < 99.0_wp )  THEN
-          IF ( (ipt - ptc) > sult_lim )  sultrieness = .TRUE.
-       ENDIF
-    ENDIF
-
-
- END SUBROUTINE ipt_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> SUBROUTINE ipt_cycle
-!> Calculates one timestep for the instationary version of perceived temperature (iPT, degree_C) for
-!>  - standard measured/predicted meteorological values and TMRT as input;
-!>  - regressions for determination of PT;
-!>  - adjustment to Gagge's PMV* (2-node-model, 1986) as base of PT under warm/humid conditions
-!>    (Icl= 0.50 clo) and under cold conditions (Icl= 1.75 clo)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ipt_cycle( ta, vp, ws, tmrt, pair, dt, storage, t_clothing, clo, actlev, work, ipt )
-
-    IMPLICIT NONE
-!
-!-- Type of input of the argument list
-    REAL(wp), INTENT ( IN )  ::  actlev  !< Internal heat production    (W)
-    REAL(wp), INTENT ( IN )  ::  clo     !< Clothing index              (no dim)
-    REAL(wp), INTENT ( IN )  ::  dt      !< Timestep                    (s)
-    REAL(wp), INTENT ( IN )  ::  pair    !< Air pressure                (hPa)
-    REAL(wp), INTENT ( IN )  ::  ta      !< Air temperature             (degree_C)
-    REAL(wp), INTENT ( IN )  ::  tmrt    !< Mean radiant temperature    (degree_C)
-    REAL(wp), INTENT ( IN )  ::  vp      !< Vapor pressure              (hPa)
-    REAL(wp), INTENT ( IN )  ::  work    !< Mechanical work load        (W)
-    REAL(wp), INTENT ( IN )  ::  ws      !< Wind speed                  (m/s)
-!
-!-- In and output parameters
-    REAL(wp), INTENT (INOUT) ::  storage     !< Heat storage            (W)
-    REAL(wp), INTENT (INOUT) ::  t_clothing  !< Clothig temperature     (degree_C)
-!
-!-- Type of output of the argument list
-    REAL(wp), INTENT ( OUT ) ::  ipt  !< Instationary perceived temperature (degree_C)
-!
-!-- Type of internal variables
-    INTEGER(iwp) ::  nerr
-    INTEGER(iwp) ::  nerr_cold
-
-    LOGICAL ::  sultrieness
-
-    REAL(wp) ::  d_pmv
-    REAL(wp) ::  d_std
-    REAL(wp) ::  dgtcm
-    REAL(wp) ::  dgtcstd
-    REAL(wp) ::  pmva
-    REAL(wp) ::  pmvs
-    REAL(wp) ::  ptc
-    REAL(wp) ::  sult_lim
-    REAL(wp) ::  svp_ta
-!
-!-- Initialise
-    ipt = bio_fill_value
-
-    nerr     = 0_iwp
-    sultrieness  = .FALSE.
-!
-!-- Determine pmv_adjusted for current conditions
-    CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt, pmva )
-!
-!-- Determine perceived temperature by regression equation + adjustments
-    CALL perct_regression( pmva, clo, ipt )
-!
-!-- Consider cold conditions
-    IF ( clo >= 1.75_wp  .AND.  pmva <= -0.11_wp )  THEN
-!
-!--    Adjust for cold conditions according to Gagge 1986
-       CALL dpmv_cold ( pmva, ta, ws, tmrt, nerr_cold, d_pmv )
-       IF ( nerr_cold > 0_iwp )  nerr = -5_iwp
-       pmvs = pmva - d_pmv
-       IF ( pmvs > - 0.11_wp )  THEN
-          d_pmv  = 0.0_wp
-          pmvs   = - 0.11_wp
-       ENDIF
-       CALL perct_regression( pmvs, clo, ipt )
-    ENDIF
-!
-!-- Consider sultriness if appropriate
-    ptc = ipt
-    CALL calc_sultr( ptc, dgtcm, dgtcstd, sult_lim )
-    sultrieness = .FALSE.
-    d_std       = - 99.0_wp
-    IF ( pmva > 0.06_wp  .AND.  clo <= 0.5_wp )  THEN
-!
-!--    Adjust for warm/humid conditions according to Gagge 1986
-       CALL saturation_vapor_pressure ( ta, svp_ta )
-       d_pmv = deltapmv ( pmva, ta, vp, svp_ta, tmrt, ws, nerr )
-       pmvs  = pmva + d_pmv
-       CALL perct_regression( pmvs, clo, ipt )
-       IF ( sult_lim < 99.0_wp )  THEN
-          IF ( (ipt - ptc) > sult_lim )  sultrieness = .TRUE.
-       ENDIF
-    ENDIF
-
- END SUBROUTINE ipt_cycle
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> SUBROUTINE fanger_s calculates the actual Predicted Mean Vote (dimensionless) according to Fanger
-!> corresponding to meteorological (ta,tmrt,pa,ws,pair) and individual variables (clo, actlev, eta)
-!> considering a storage and clothing temperature for a given timestep.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE fanger_s_acti( ta, tmrt, pa, in_ws, pair, in_clo, actlev, activity, t_cloth, s, dt,    &
-                           pmva )
-
-    IMPLICIT NONE
-!
-!--  Input argument types
-    REAL(wp), INTENT ( IN )  ::  activity !< Work load                (W/mÂ²)
-    REAL(wp), INTENT ( IN )  ::  actlev   !< Metabolic + work energy  (W/mÂ²)
-    REAL(wp), INTENT ( IN )  ::  dt       !< Timestep                 (s)
-    REAL(wp), INTENT ( IN )  ::  in_clo   !< Clothing index (clo)     (no dim)
-    REAL(wp), INTENT ( IN )  ::  in_ws    !< Wind speed               (m/s)
-    REAL(wp), INTENT ( IN )  ::  pa       !< Vapour pressure          (hPa)
-    REAL(wp), INTENT ( IN )  ::  pair     !< Air pressure             (hPa)
-    REAL(wp), INTENT ( IN )  ::  ta       !< Air temperature          (degree_C)
-    REAL(wp), INTENT ( IN )  ::  tmrt     !< Mean radiant temperature (degree_C)
-!
-!-- Output argument types
-    REAL(wp), INTENT ( OUT ) ::  pmva  !< actual Predicted Mean Vote (no dim)
-
-    REAL(wp), INTENT (INOUT) ::  s  !< storage var. of energy balance (W/m2)
-    REAL(wp), INTENT (INOUT) ::  t_cloth  !< clothing temperature (degree_C)
-!
-!-- Internal variables
-    REAL(wp), PARAMETER  ::  time_equil = 7200.0_wp
-
-    INTEGER(iwp) :: i         !< running index
-    INTEGER(iwp) ::  niter    !< Running index
-
-    REAL(wp) ::  adjustrate        !< Max storage adjustment rate
-    REAL(wp) ::  adjustrate_cloth  !< max clothing temp. adjustment rate
-    REAL(wp) ::  bc                !< preliminary result storage
-    REAL(wp) ::  cc                !< preliminary result storage
-    REAL(wp) ::  clo               !< clothing insulation index              (clo)
-    REAL(wp) ::  d_s               !< Storage delta                          (W)
-    REAL(wp) ::  dc                !< preliminary result storage
-    REAL(wp) ::  en                !< Energy ballance                        (W)
-    REAL(wp) ::  ec                !< preliminary result storage
-    REAL(wp) ::  f_cl              !< Increase in surface due to clothing    (factor)
-    REAL(wp) ::  gc                !< preliminary result storage
-    REAL(wp) ::  heat_convection   !< energy loss by autocnvection       (W)
-!    REAL(wp) ::  hr                !< radiational heat resistence
-    REAL(wp) ::  t_clothing        !< clothing temperature                   (degree_C)
-    REAL(wp) ::  t_skin_aver       !< average skin temperature               (degree_C)
-    REAL(wp) ::  ws                !< wind speed                             (m/s)
-    REAL(wp) ::  z1                !< Empiric factor for the adaption of the heat
-                                   !< ballance equation to the psycho-physical scale
-                                   !< (Equ. 40 in FANGER)
-    REAL(wp) ::  z2                !< Water vapour diffution through the skin
-    REAL(wp) ::  z3                !< Sweat evaporation from the skin surface
-    REAL(wp) ::  z4                !< Loss of latent heat through respiration
-    REAL(wp) ::  z5                !< Loss of radiational heat
-    REAL(wp) ::  z6                !< Heat loss through forced convection
-
-
-
-
-!
-!-- Clo must be > 0. to avoid div. by 0!
-    clo = in_clo
-    IF ( clo < 001.0_wp )  clo = 0.001_wp
-!
-!-- Increase in surface due to clothing
-    f_cl = 1.0_wp + 0.15_wp * clo
-!
-!-- Case of free convection (ws < 0.1 m/s ) not considered
-    ws = in_ws
-    IF ( ws < 0.1_wp )  THEN
-       ws = 0.1_wp
-    ENDIF
-!
-!-- Heat_convection = forced convection
-    heat_convection = 12.1_wp * SQRT( ws * pair / 1013.25_wp )
-!
-!-- Average skin temperature
-    t_skin_aver = 35.7_wp - 0.0275_wp * activity
-!
-!-- Calculation of constants for evaluation below
-    bc = 0.155_wp * clo * 3.96_wp * 10.0_wp**( -8.0_wp ) * f_cl
-    cc = f_cl * heat_convection
-    ec = 0.155_wp * clo
-    dc = ( 1.0_wp + ec * cc ) / bc
-    gc = ( t_skin_aver + bc * ( tmrt + 273.2_wp )**4.0_wp + ec * cc * ta ) / bc
-!
-!-- Calculation of clothing surface temperature (t_clothing) based on Newton-approximation with air
-!-- temperature as initial guess
-    niter = INT( dt * 10.0_wp, KIND=iwp )
-    IF ( niter < 1 )  niter = 1_iwp
-    adjustrate = 1.0_wp - EXP( -1.0_wp * ( 10.0_wp / time_equil ) * dt )
-    IF ( adjustrate >= 1.0_wp )  adjustrate = 1.0_wp
-    adjustrate_cloth = adjustrate * 30.0_wp
-    t_clothing = t_cloth
-!
-!-- Set initial values for niter, adjustrates and t_clothing if this is the first call
-    IF ( t_cloth <= -998.0_wp )  THEN  ! If initial run
-       niter = 3_iwp
-       adjustrate = 1.0_wp
-       adjustrate_cloth = 1.0_wp
-       t_clothing = ta
-    ENDIF
-!
-!-- Update clothing temperature
-    DO  i = 1, niter
-       t_clothing = t_clothing - adjustrate_cloth * ( ( t_clothing + 273.2_wp )**4.0_wp  +         &
-                    t_clothing * dc - gc ) / ( 4.0_wp * ( t_clothing + 273.2_wp )**3.0_wp + dc )
-    ENDDO
-!
-!-- Empiric factor for the adaption of the heat ballance equation to the psycho-physical scale
-!-- (Equ. 40 in FANGER)
-    z1 = ( 0.303_wp * EXP( - 0.036_wp * actlev ) + 0.0275_wp )
-!
-!-- Water vapour diffution through the skin
-    z2 = 0.31_wp * ( 57.3_wp - 0.07_wp * activity-pa )
-!
-!-- Sweat evaporation from the skin surface
-    z3 = 0.42_wp * ( activity - 58.0_wp )
-!
-!-- Loss of latent heat through respiration
-    z4 = 0.0017_wp * actlev * ( 58.7_wp - pa ) + 0.0014_wp * actlev * ( 34.0_wp - ta )
-!
-!-- Loss of radiational heat
-    z5 = 3.96e-8_wp * f_cl * ( ( t_clothing + 273.2_wp )**4 - ( tmrt + 273.2_wp )**4 )
-!
-!-- Heat loss through forced convection
-    z6 = cc * ( t_clothing - ta )
-!
-!-- Write together as energy ballance
-    en = activity - z2 - z3 - z4 - z5 - z6
-!
-!-- Manage storage
-    d_s = adjustrate * en + ( 1.0_wp - adjustrate ) * s
-!
-!-- Predicted Mean Vote
-    pmva = z1 * d_s
-!
-!-- Update storage
-    s = d_s
-    t_cloth = t_clothing
-
- END SUBROUTINE fanger_s_acti
-
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Physiologically Equivalent Temperature (PET),
-!> stationary (calculated based on MEMI),
-!> Subroutine based on PETBER vers. 1.5.1996 by P. Hoeppe
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE calculate_pet_static( ta, vpa, v, tmrt, pair, pet_ij )
-
-    IMPLICIT NONE
-!
-!-- Input arguments:
-    REAL(wp), INTENT( IN ) ::  pair  !< Air pressure                (hPa)
-    REAL(wp), INTENT( IN ) ::  ta    !< Air temperature             (degree_C)
-    REAL(wp), INTENT( IN ) ::  tmrt  !< Mean radiant temperature    (degree_C)
-    REAL(wp), INTENT( IN ) ::  v     !< Wind speed                  (m/s)
-    REAL(wp), INTENT( IN ) ::  vpa   !< Vapor pressure              (hPa)
-!
-!-- Output arguments:
-    REAL(wp), INTENT ( OUT ) ::  pet_ij  !< PET                     (degree_C)
-!
-!-- Internal variables:
-    REAL(wp) ::  acl        !< clothing area                        (mÂ²)
-    REAL(wp) ::  adu        !< Du Bois area                         (mÂ²)
-    REAL(wp) ::  aeff       !< effective area                       (mÂ²)
-    REAL(wp) ::  ere        !< energy ballance                      (W)
-    REAL(wp) ::  erel       !< latent energy ballance               (W)
-    REAL(wp) ::  esw        !< Energy-loss through sweat evap.      (W)
-    REAL(wp) ::  facl       !< Surface area extension through clothing (factor)
-    REAL(wp) ::  feff       !< Surface modification by posture      (factor)
-    REAL(wp) ::  rdcl       !< Diffusion resistence of clothing     (factor)
-    REAL(wp) ::  rdsk       !< Diffusion resistence of skin         (factor)
-    REAL(wp) ::  rtv
-    REAL(wp) ::  vpts       !< Sat. vapor pressure over skin        (hPa)
-    REAL(wp) ::  tcl        !< Clothing temperature                 (degree_C)
-    REAL(wp) ::  tsk        !< Skin temperature                     (degree_C)
-    REAL(wp) ::  wetsk      !< Fraction of wet skin                 (factor)
-!
-!-- Variables:
-    REAL(wp) :: int_heat    !< Internal heat        (W)
-!
-!-- MEMI configuration
-    REAL(wp) :: age         !< Persons age          (a)
-    REAL(wp) :: clo         !< Clothing insulation index (clo)
-    REAL(wp) :: eta         !< Work efficiency      (dimensionless)
-    REAL(wp) :: fcl         !< Surface area modification by clothing (factor)
-    REAL(wp) :: ht          !< Persons height       (m)
-    REAL(wp) :: mbody       !< Persons body mass    (kg)
-    REAL(wp) :: work        !< Work load            (W)
-!    INTEGER(iwp) :: pos     !< Posture: 1 = standing, 2 = sitting
-!    INTEGER(iwp) :: sex     !< Sex: 1 = male, 2 = female
-!
-!-- Configuration, keep standard parameters!
-    age   = 35.0_wp
-    mbody = 75.0_wp
-    ht    =  1.75_wp
-    work  = 80.0_wp
-    eta   =  0.0_wp
-    clo   =  0.9_wp
-    fcl   =  1.15_wp
-!
-!-- Call subfunctions
-    CALL in_body( age, eta, ere, erel, ht, int_heat, mbody, pair, rtv, ta, vpa, work )
-
-    CALL heat_exch( acl, adu, aeff, clo, ere, erel, esw, facl, fcl, feff, ht, int_heat, mbody,     &
-                    pair, rdcl, rdsk, ta, tcl, tmrt, tsk, v, vpa, vpts, wetsk )
-
-    CALL pet_iteration( acl, adu, aeff, esw, facl, feff, int_heat, pair, rdcl, rdsk, rtv, ta, tcl, &
-                        tsk, pet_ij, vpts, wetsk )
-
-
- END SUBROUTINE calculate_pet_static
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate internal energy ballance
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE in_body( age, eta, ere, erel, ht, int_heat, mbody, pair, rtv, ta, vpa, work )
-!
-!-- Input arguments:
-    REAL(wp), INTENT( IN )  ::  age       !< Persons age              (a)
-    REAL(wp), INTENT( IN )  ::  eta       !< Work efficiency     (dimensionless)
-    REAL(wp), INTENT( IN )  ::  ht        !< Persons height           (m)
-    REAL(wp), INTENT( IN )  ::  mbody     !< Persons body mass        (kg)
-    REAL(wp), INTENT( IN )  ::  pair      !< air pressure             (hPa)
-    REAL(wp), INTENT( IN )  ::  ta        !< air temperature          (degree_C)
-    REAL(wp), INTENT( IN )  ::  vpa       !< vapor pressure           (hPa)
-    REAL(wp), INTENT( IN )  ::  work      !< Work load                (W)
-!
-!-- Output arguments:
-    REAL(wp), INTENT( OUT ) ::  ere       !< energy ballance          (W)
-    REAL(wp), INTENT( OUT ) ::  erel      !< latent energy ballance   (W)
-    REAL(wp), INTENT( OUT ) ::  int_heat  !< internal heat production (W)
-    REAL(wp), INTENT( OUT ) ::  rtv       !< respiratory volume
-!
-!-- Internal variables:
-    REAL(wp) ::  eres                     !< Sensible respiratory heat flux (W)
-    REAL(wp) ::  met
-    REAL(wp) ::  tex
-    REAL(wp) ::  vpex
-
-!
-!-- Metabolic heat production
-    met = 3.45_wp * mbody**( 3.0_wp / 4.0_wp ) * (1.0_wp + 0.004_wp *                              &
-          ( 30.0_wp - age) + 0.010_wp * ( ( ht * 100.0_wp /                                        &
-          ( mbody**( 1.0_wp / 3.0_wp ) ) ) - 43.4_wp ) )
-    met = work + met
-    int_heat = met * (1.0_wp - eta)
-!
-!-- Sensible respiration energy
-    tex  = 0.47_wp * ta + 21.0_wp
-    rtv  = 1.44_wp * 10.0_wp**(-6.0_wp) * met
-    eres = c_p * (ta - tex) * rtv
-!
-!-- Latent respiration energy
-    vpex = 6.11_wp * 10.0_wp**( 7.45_wp * tex / ( 235.0_wp + tex ) )
-    erel = 0.623_wp * l_v / pair * ( vpa - vpex ) * rtv
-!
-!-- Sum of the results
-    ere = eres + erel
-
- END SUBROUTINE in_body
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate heat gain or loss
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE heat_exch( acl, adu, aeff, clo, ere, erel, esw, facl, fcl, feff, ht, int_heat, mbody,  &
-                       pair, rdcl, rdsk, ta, tcl, tmrt, tsk, v, vpa, vpts, wetsk )
-
-!
-!-- Input arguments:
-    REAL(wp), INTENT( IN )  ::  clo    !< clothing insulation      (clo)
-    REAL(wp), INTENT( IN )  ::  fcl    !< factor for surface area increase by clothing
-    REAL(wp), INTENT( IN )  ::  ere    !< Energy ballance          (W)
-    REAL(wp), INTENT( IN )  ::  erel   !< Latent energy ballance   (W)
-    REAL(wp), INTENT( IN )  ::  ht     !< height                   (m)
-    REAL(wp), INTENT( IN )  ::  int_heat  !< internal heat production (W)
-    REAL(wp), INTENT( IN )  ::  mbody  !< body mass                (kg)
-    REAL(wp), INTENT( IN )  ::  pair   !< Air pressure             (hPa)
-    REAL(wp), INTENT( IN )  ::  ta     !< Air temperature          (degree_C)
-    REAL(wp), INTENT( IN )  ::  tmrt   !< Mean radiant temperature (degree_C)
-    REAL(wp), INTENT( IN )  ::  v      !< Wind speed               (m/s)
-    REAL(wp), INTENT( IN )  ::  vpa    !< Vapor pressure           (hPa)
-!
-!-- Output arguments:
-    REAL(wp), INTENT( OUT ) ::  acl    !< Clothing surface area        (mÂ²)
-    REAL(wp), INTENT( OUT ) ::  adu    !< Du-Bois area                 (mÂ²)
-    REAL(wp), INTENT( OUT ) ::  aeff   !< Effective surface area       (mÂ²)
-    REAL(wp), INTENT( OUT ) ::  esw    !< Energy-loss through sweat evap. (W)
-    REAL(wp), INTENT( OUT ) ::  facl   !< Surface area extension through clothing (factor)
-    REAL(wp), INTENT( OUT ) ::  feff   !< Surface modification by posture (factor)
-    REAL(wp), INTENT( OUT ) ::  rdcl   !< Diffusion resistence of clothing (factor)
-    REAL(wp), INTENT( OUT ) ::  rdsk   !< Diffusion resistence of skin (factor)
-    REAL(wp), INTENT( OUT ) ::  tcl    !< Clothing temperature         (degree_C)
-    REAL(wp), INTENT( OUT ) ::  tsk    !< Skin temperature             (degree_C)
-    REAL(wp), INTENT( OUT ) ::  vpts   !< Sat. vapor pressure over skin (hPa)
-    REAL(wp), INTENT( OUT ) ::  wetsk  !< Fraction of wet skin (dimensionless)
-!
-!-- Cconstants:
-!     REAL(wp), PARAMETER :: cair = 1010.0_wp      !< replaced by c_p
-    REAL(wp), PARAMETER :: cb   = 3640.0_wp        !<
-    REAL(wp), PARAMETER :: emcl =    0.95_wp      !< Longwave emission coef. of cloth
-    REAL(wp), PARAMETER :: emsk =    0.99_wp      !< Longwave emission coef. of skin
-!    REAL(wp), PARAMETER :: evap = 2.42_wp * 10.0_wp **6.0_wp  !< replaced by l_v
-    REAL(wp), PARAMETER :: food =    0.0_wp        !< Heat gain by food        (W)
-    REAL(wp), PARAMETER :: po   = 1013.25_wp      !< Air pressure at sea level (hPa)
-    REAL(wp), PARAMETER :: rob  =    1.06_wp      !<
-!
-!-- Internal variables
-    INTEGER(iwp) ::  count1     !< running index
-    INTEGER(iwp) ::  count3     !< running index
-    INTEGER(iwp) ::  j          !< running index
-    INTEGER(iwp) ::  i          !< running index
-
-    LOGICAL ::  skipincreasecount   !< iteration control flag
-
-    REAL(wp) ::  cbare          !< Convection through bare skin
-    REAL(wp) ::  cclo           !< Convection through clothing
-    REAL(wp) ::  csum           !< Convection in total
-    REAL(wp) ::  di             !< difference between r1 and r2
-    REAL(wp) ::  ed             !< energy transfer by diffusion     (W)
-    REAL(wp) ::  enbal          !< energy ballance                  (W)
-    REAL(wp) ::  enbal2         !< energy ballance (storage, last cycle)
-    REAL(wp) ::  eswdif         !< difference between sweat production and evaporation potential
-    REAL(wp) ::  eswphy         !< sweat created by physiology
-    REAL(wp) ::  eswpot         !< potential sweat evaporation
-    REAL(wp) ::  fec            !<
-    REAL(wp) ::  hc             !<
-    REAL(wp) ::  he             !<
-    REAL(wp) ::  htcl           !<
-    REAL(wp) ::  r1             !<
-    REAL(wp) ::  r2             !<
-    REAL(wp) ::  rbare          !< Radiational loss of bare skin    (W/mÂ²)
-    REAL(wp) ::  rcl            !<
-    REAL(wp) ::  rclo           !< Radiational loss of clothing     (W/mÂ²)
-    REAL(wp) ::  rclo2          !< Longwave radiation gain or loss  (W/mÂ²)
-    REAL(wp) ::  rsum           !< Radiational loss or gain         (W/mÂ²)
-    REAL(wp) ::  sw             !<
-!    REAL(wp) ::  swf            !< female factor, currently unused
-    REAL(wp) ::  swm            !<
-    REAL(wp) ::  tbody          !<
-    REAL(wp) ::  vb             !<
-    REAL(wp) ::  vb1            !<
-    REAL(wp) ::  vb2            !<
-    REAL(wp) ::  wd             !<
-    REAL(wp) ::  wr             !<
-    REAL(wp) ::  ws             !<
-    REAL(wp) ::  wsum           !<
-    REAL(wp) ::  xx             !< modification step                (K)
-    REAL(wp) ::  y              !< fraction of bare skin
-
-    REAL(wp) ::  c(0:10)        !< Core temperature array           (degree_C)
-    REAL(wp) ::  tcore(1:7)     !<
-
-!
-!-- Initialize
-    wetsk = 0.0_wp  !< skin is dry everywhere on init (no non-evaporated sweat)
-!
-!-- Set Du Bois Area for the sample person
-    adu = 0.203_wp * mbody**0.425_wp * ht**0.725_wp
-!
-!-- Initialize convective heat considering local air preassure
-    hc = 2.67_wp + ( 6.5_wp * v**0.67_wp )
-    hc = hc * ( pair / po )**0.55_wp
-!
-!-- Set surface modification by posture (the person will always stand)
-    feff = 0.725_wp                     !< Posture: 0.725 for stading
-!
-!-- Set surface modification by clothing
-    facl = ( - 2.36_wp + 173.51_wp * clo - 100.76_wp * clo * clo + 19.28_wp * ( clo**3.0_wp ) )    &
-           / 100.0_wp
-    IF ( facl > 1.0_wp )  facl = 1.0_wp
-!
-!-- Initialize heat resistences
-    rcl = ( clo / 6.45_wp ) / facl
-    IF ( clo >= 2.0_wp )  y  = 1.0_wp
-    IF ( ( clo > 0.6_wp )   .AND.  ( clo < 2.0_wp ) )   y = ( ht - 0.2_wp ) / ht
-    IF ( ( clo <= 0.6_wp )  .AND.  ( clo > 0.3_wp ) )  y = 0.5_wp
-    IF ( ( clo <= 0.3_wp )  .AND.  ( clo > 0.0_wp ) )   y = 0.1_wp
-    r2   = adu * ( fcl - 1.0_wp + facl ) / ( 2.0_wp * 3.14_wp * ht * y )
-    r1   = facl * adu / ( 2.0_wp * 3.14_wp * ht * y )
-    di   = r2 - r1
-
-!
-!-- Estimate skin temperatur
-    DO  j = 1, 7
-
-       tsk    = 34.0_wp
-       count1 = 0_iwp
-       tcl    = ( ta + tmrt + tsk ) / 3.0_wp
-       count3 = 1_iwp
-       enbal2 = 0.0_wp
-
-       DO  i = 1, 100  ! allow for 100 iterations max
-          acl   = adu * facl + adu * ( fcl - 1.0_wp )
-          rclo2 = emcl * sigma_sb * ( ( tcl + degc_to_k )**4.0_wp -                                &
-                  ( tmrt + degc_to_k )**4.0_wp ) * feff
-          htcl  = 6.28_wp * ht * y * di / ( rcl * LOG( r2 / r1 ) * acl )
-          tsk   = 1.0_wp / htcl * ( hc * ( tcl - ta ) + rclo2 ) + tcl
-!
-!--       Radiation saldo
-          aeff  = adu * feff
-          rbare = aeff * ( 1.0_wp - facl ) * emsk * sigma_sb *                                     &
-                  ( ( tmrt + degc_to_k )**4.0_wp - ( tsk + degc_to_k )**4.0_wp )
-          rclo  = feff * acl * emcl * sigma_sb *                                                   &
-                  ( ( tmrt + degc_to_k )**4.0_wp - ( tcl + degc_to_k )**4.0_wp )
-          rsum  = rbare + rclo
-!
-!--       Convection
-          cbare = hc * ( ta - tsk ) * adu * ( 1.0_wp - facl )
-          cclo  = hc * ( ta - tcl ) * acl
-          csum  = cbare + cclo
-!
-!--       Core temperature
-          c(0)  = int_heat + ere
-          c(1)  = adu * rob * cb
-          c(2)  = 18.0_wp - 0.5_wp * tsk
-          c(3)  = 5.28_wp * adu * c(2)
-          c(4)  = 0.0208_wp * c(1)
-          c(5)  = 0.76075_wp * c(1)
-          c(6)  = c(3) - c(5) - tsk * c(4)
-          c(7)  = - c(0) * c(2) - tsk * c(3) + tsk * c(5)
-          c(8)  = c(6) * c(6) - 4.0_wp * c(4) * c(7)
-          c(9)  = 5.28_wp * adu - c(5) - c(4) * tsk
-          c(10) = c(9) * c(9) - 4.0_wp * c(4) * ( c(5) * tsk - c(0) - 5.28_wp * adu * tsk )
-
-          IF ( ABS( tsk - 36.0_wp ) < 0.00001_wp )  tsk = 36.01_wp
-          tcore(7) = c(0) / ( 5.28_wp * adu + c(1) * 6.3_wp / 3600.0_wp ) + tsk
-          tcore(3) = c(0) / ( 5.28_wp * adu + ( c(1) * 6.3_wp / 3600.0_wp ) /   &
-                     ( 1.0_wp + 0.5_wp * ( 34.0_wp - tsk ) ) ) + tsk
-          IF ( c(10) >= 0.0_wp )  THEN
-             tcore(6) = ( - c(9) - c(10)**0.5_wp ) / ( 2.0_wp * c(4) )
-             tcore(1) = ( - c(9) + c(10)**0.5_wp ) / ( 2.0_wp * c(4) )
-          ENDIF
-
-          IF ( c(8) >= 0.0_wp )  THEN
-             tcore(2) = ( - c(6) + ABS( c(8) )**0.5_wp ) / ( 2.0_wp * c(4) )
-             tcore(5) = ( - c(6) - ABS( c(8) )**0.5_wp ) / ( 2.0_wp * c(4) )
-             tcore(4) = c(0) / ( 5.28_wp * adu + c(1) * 1.0_wp / 40.0_wp ) + tsk
-          ENDIF
-!
-!--       Transpiration
-          tbody = 0.1_wp * tsk + 0.9_wp * tcore(j)
-          swm   = 304.94_wp * ( tbody - 36.6_wp ) * adu / 3600000.0_wp
-          vpts  = 6.11_wp * 10.0_wp**( 7.45_wp * tsk / ( 235.0_wp + tsk ) )
-
-          IF ( tbody <= 36.6_wp )  swm = 0.0_wp  !< no need for sweating
-
-          sw = swm
-          eswphy = - sw * l_v
-          he     = 0.633_wp * hc / ( pair * c_p )
-          fec    = 1.0_wp / ( 1.0_wp + 0.92_wp * hc * rcl )
-          eswpot = he * ( vpa - vpts ) * adu * l_v * fec
-          wetsk  = eswphy / eswpot
-
-          IF ( wetsk > 1.0_wp )  wetsk = 1.0_wp
-!
-!--       Sweat production > evaporation?
-          eswdif = eswphy - eswpot
-
-          IF ( eswdif <= 0.0_wp )  esw = eswpot     !< Limit is evaporation
-          IF ( eswdif > 0.0_wp )   esw = eswphy     !< Limit is sweat production
-          IF ( esw  > 0.0_wp )     esw = 0.0_wp     !< Sweat can't be evaporated, no more cooling
-                                                    !< effect
-!
-!--       Diffusion
-          rdsk = 0.79_wp * 10.0_wp**7.0_wp
-          rdcl = 0.0_wp
-          ed   = l_v / ( rdsk + rdcl ) * adu * ( 1.0_wp - wetsk ) * ( vpa - vpts )
-!
-!--       Max vb
-          vb1 = 34.0_wp - tsk
-          vb2 = tcore(j) - 36.6_wp
-
-          IF ( vb2 < 0.0_wp )  vb2 = 0.0_wp
-          IF ( vb1 < 0.0_wp )  vb1 = 0.0_wp
-          vb = ( 6.3_wp + 75.0_wp * vb2 ) / ( 1.0_wp + 0.5_wp * vb1 )
-!
-!--       Energy ballence
-          enbal = int_heat + ed + ere + esw + csum + rsum + food
-!
-!--       Clothing temperature
-          xx = 0.001_wp
-          IF ( count1 == 0_iwp )  xx = 1.0_wp
-          IF ( count1 == 1_iwp )  xx = 0.1_wp
-          IF ( count1 == 2_iwp )  xx = 0.01_wp
-          IF ( count1 == 3_iwp )  xx = 0.001_wp
-
-          IF ( enbal > 0.0_wp )  tcl = tcl + xx
-          IF ( enbal < 0.0_wp )  tcl = tcl - xx
-
-          skipincreasecount = .FALSE.
-          IF ( ( (enbal <= 0.0_wp )  .AND.  (enbal2 > 0.0_wp ) )  .OR.                             &
-             ( ( enbal >= 0.0_wp )   .AND.  ( enbal2 < 0.0_wp ) ) )  THEN
-             skipincreasecount = .TRUE.
-          ELSE
-             enbal2 = enbal
-             count3 = count3 + 1_iwp
-          ENDIF
-
-          IF ( ( count3 > 200_iwp )  .OR.  skipincreasecount )  THEN
-             IF ( count1 < 3_iwp )  THEN
-                count1 = count1 + 1_iwp
-                enbal2 = 0.0_wp
-             ELSE
-                EXIT
-             ENDIF
-          ENDIF
-       ENDDO
-
-       IF ( count1 == 3_iwp )  THEN
-          SELECT CASE ( j )
-             CASE ( 2, 5)
-                IF ( .NOT. ( ( tcore(j) >= 36.6_wp )  .AND.  ( tsk <= 34.050_wp ) ) )  CYCLE
-             CASE ( 6, 1 )
-                IF ( c(10) < 0.0_wp ) CYCLE
-                IF ( .NOT. ( ( tcore(j) >= 36.6_wp )  .AND.  ( tsk > 33.850_wp ) ) )  CYCLE
-             CASE ( 3 )
-                IF ( .NOT. ( ( tcore(j) < 36.6_wp )  .AND.  ( tsk <= 34.000_wp ) ) )  CYCLE
-             CASE ( 7 )
-                IF ( .NOT. ( ( tcore(j) < 36.6_wp )  .AND.  ( tsk > 34.000_wp ) ) )  CYCLE
-             CASE default
-          END SELECT
-       ENDIF
-
-       IF ( ( j /= 4_iwp )  .AND.  ( vb >= 91.0_wp ) )  CYCLE
-       IF ( ( j == 4_iwp )  .AND.  ( vb < 89.0_wp ) )  CYCLE
-       IF ( vb > 90.0_wp ) vb = 90.0_wp
-!
-!--    Loses by water
-       ws = sw * 3600.0_wp * 1000.0_wp
-       IF ( ws > 2000.0_wp )  ws = 2000.0_wp
-       wd = ed / l_v * 3600.0_wp * ( -1000.0_wp )
-       wr = erel / l_v * 3600.0_wp * ( -1000.0_wp )
-
-       wsum = ws + wr + wd
-
-       RETURN
-    ENDDO
- END SUBROUTINE heat_exch
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate PET
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pet_iteration( acl, adu, aeff, esw, facl, feff, int_heat, pair, rdcl, rdsk, rtv, ta,   &
-                           tcl, tsk, pet_ij, vpts, wetsk )
-!
-!-- Input arguments:
-    REAL(wp), INTENT( IN ) ::  acl       !< clothing surface area        (mÂ²)
-    REAL(wp), INTENT( IN ) ::  adu       !< Du-Bois area                 (mÂ²)
-    REAL(wp), INTENT( IN ) ::  esw       !< energy-loss through sweat evap. (W)
-    REAL(wp), INTENT( IN ) ::  facl      !< surface area extension through clothing (factor)
-    REAL(wp), INTENT( IN ) ::  feff      !< surface modification by posture (factor)
-    REAL(wp), INTENT( IN ) ::  int_heat  !< internal heat production (W)
-    REAL(wp), INTENT( IN ) ::  pair      !< air pressure                 (hPa)
-    REAL(wp), INTENT( IN ) ::  rdcl      !< diffusion resistence of clothing (factor)
-    REAL(wp), INTENT( IN ) ::  rdsk      !< diffusion resistence of skin (factor)
-    REAL(wp), INTENT( IN ) ::  rtv       !< respiratory volume
-    REAL(wp), INTENT( IN ) ::  ta        !< air temperature              (degree_C)
-    REAL(wp), INTENT( IN ) ::  tcl       !< clothing temperature         (degree_C)
-    REAL(wp), INTENT( IN ) ::  tsk       !< skin temperature             (degree_C)
-    REAL(wp), INTENT( IN ) ::  vpts      !< sat. vapor pressure over skin (hPa)
-    REAL(wp), INTENT( IN ) ::  wetsk     !< fraction of wet skin (dimensionless)
-!
-!-- Output arguments:
-    REAL(wp), INTENT( OUT ) ::  aeff     !< effective surface area       (mÂ²)
-    REAL(wp), INTENT( OUT ) ::  pet_ij   !< PET                          (degree_C)
-!
-!-- Cconstants:
-    REAL(wp), PARAMETER :: emcl =    0.95_wp      !< Longwave emission coef. of cloth
-    REAL(wp), PARAMETER :: emsk =    0.99_wp      !< Longwave emission coef. of skin
-    REAL(wp), PARAMETER :: po   = 1013.25_wp      !< Air pressure at sea level (hPa)
-!
-!-- Internal variables
-    INTEGER ( iwp ) ::  count1        !< running index
-    INTEGER ( iwp ) ::  i             !< running index
-
-    REAL ( wp ) ::  cbare             !< Convection through bare skin
-    REAL ( wp ) ::  cclo              !< Convection through clothing
-    REAL ( wp ) ::  csum              !< Convection in total
-    REAL ( wp ) ::  ed                !< Diffusion                      (W)
-    REAL ( wp ) ::  enbal             !< Energy ballance                (W)
-    REAL ( wp ) ::  enbal2            !< Energy ballance (last iteration cycle)
-    REAL ( wp ) ::  ere               !< Energy ballance result         (W)
-    REAL ( wp ) ::  erel              !< Latent energy ballance         (W)
-    REAL ( wp ) ::  eres              !< Sensible respiratory heat flux (W)
-    REAL ( wp ) ::  hc                !<
-    REAL ( wp ) ::  rbare             !< Radiational loss of bare skin  (W/mÂ²)
-    REAL ( wp ) ::  rclo              !< Radiational loss of clothing   (W/mÂ²)
-    REAL ( wp ) ::  rsum              !< Radiational loss or gain       (W/mÂ²)
-    REAL ( wp ) ::  tex               !< Temperat. of exhaled air       (degree_C)
-    REAL ( wp ) ::  vpex              !< Vapor pressure of exhaled air  (hPa)
-    REAL ( wp ) ::  xx                !< Delta PET per iteration        (K)
-
-
-    pet_ij = ta
-    enbal2 = 0.0_wp
-
-    DO  count1 = 0, 3
-       DO  i = 1, 125  ! 500 / 4
-          hc = 2.67_wp + 6.5_wp * 0.1_wp**0.67_wp
-          hc = hc * ( pair / po )**0.55_wp
-!
-!--       Radiation
-          aeff  = adu * feff
-          rbare = aeff * ( 1.0_wp - facl ) * emsk * sigma_sb *                  &
-                  ( ( pet_ij + degc_to_k )**4.0_wp - ( tsk + degc_to_k )**4.0_wp )
-          rclo  = feff * acl * emcl * sigma_sb *                               &
-                  ( ( pet_ij + degc_to_k )**4.0_wp - ( tcl + degc_to_k )**4.0_wp )
-          rsum  = rbare + rclo
-!
-!--       Covection
-          cbare = hc * ( pet_ij - tsk ) * adu * ( 1.0_wp - facl )
-          cclo  = hc * ( pet_ij - tcl ) * acl
-          csum  = cbare + cclo
-!
-!--       Diffusion
-          ed = l_v / ( rdsk + rdcl ) * adu * ( 1.0_wp - wetsk ) * ( 12.0_wp - vpts )
-!
-!--       Respiration
-          tex  = 0.47_wp * pet_ij + 21.0_wp
-          eres = c_p * ( pet_ij - tex ) * rtv
-          vpex = 6.11_wp * 10.0_wp**( 7.45_wp * tex / ( 235.0_wp + tex ) )
-          erel = 0.623_wp * l_v / pair * ( 12.0_wp - vpex ) * rtv
-          ere  = eres + erel
-!
-!--       Energy ballance
-          enbal = int_heat + ed + ere + esw + csum + rsum
-!
-!--       Iteration concerning ta
-          xx = 0.001_wp
-          IF ( count1 == 0_iwp )  xx = 1.0_wp
-          IF ( count1 == 1_iwp )  xx = 0.1_wp
-          IF ( count1 == 2_iwp )  xx = 0.01_wp
-!           IF ( count1 == 3_iwp )  xx = 0.001_wp
-          IF ( enbal > 0.0_wp )  pet_ij = pet_ij - xx
-          IF ( enbal < 0.0_wp )  pet_ij = pet_ij + xx
-          IF ( ( enbal <= 0.0_wp )  .AND.  ( enbal2 > 0.0_wp ) )  EXIT
-          IF ( ( enbal >= 0.0_wp )  .AND.  ( enbal2 < 0.0_wp ) )  EXIT
-
-          enbal2 = enbal
-       ENDDO
-    ENDDO
- END SUBROUTINE pet_iteration
-
-!
-!-- UVEM specific subroutines
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Module-specific routine for new module
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE uvem_solar_position
-
-    USE control_parameters,                                                                        &
-       ONLY:  latitude, longitude, time_since_reference_point
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  day_of_year = 0       !< day of year
-
-    REAL(wp) ::  alpha         = 0.0_wp    !< solar azimuth angle in radiant
-    REAL(wp) ::  declination   = 0.0_wp    !< declination
-    REAL(wp) ::  dtor          = 0.0_wp    !< factor to convert degree to radiant
-    REAL(wp) ::  js            = 0.0_wp    !< parameter for solar position calculation
-    REAL(wp) ::  lat           = 52.39_wp  !< latitude
-    REAL(wp) ::  lon           = 9.7_wp    !< longitude
-    REAL(wp) ::  second_of_day = 0.0_wp    !< current second of the day
-    REAL(wp) ::  thetar        = 0.0_wp    !< angle for solar zenith angle calculation
-    REAL(wp) ::  thetasr       = 0.0_wp    !< angle for solar azimuth angle calculation
-    REAL(wp) ::  zgl           = 0.0_wp    !< calculated exposure by direct beam
-    REAL(wp) ::  woz           = 0.0_wp    !< calculated exposure by diffuse radiation
-    REAL(wp) ::  wsp           = 0.0_wp    !< calculated exposure by direct beam
-
-
-    CALL get_date_time( time_since_reference_point, day_of_year = day_of_year,                     &
-                        second_of_day = second_of_day )
-    dtor = pi / 180.0_wp
-    lat = latitude
-    lon = longitude
-!
-!-- Calculation of js, necessary for calculation of equation of time (zgl) :
-    js=  72.0_wp * ( REAL( day_of_year, KIND = wp ) + ( second_of_day / 86400.0_wp ) ) / 73.0_wp
-!
-!-- Calculation of equation of time (zgl):
-    zgl = 0.0066_wp + 7.3525_wp * COS( ( js + 85.9_wp ) * dtor ) + 9.9359_wp *                     &
-    COS( ( 2.0_wp * js + 108.9_wp ) * dtor ) + 0.3387_wp * COS( ( 3 * js + 105.2_wp ) * dtor )
-!
-!-- Calculation of apparent solar time woz:
-    woz = ( ( second_of_day / 3600.0_wp ) - ( 4.0_wp * ( 15.0_wp - lon ) ) / 60.0_wp ) +           &
-          ( zgl / 60.0_wp )
-!
-!-- Calculation of hour angle (wsp):
-    wsp = ( woz - 12.0_wp ) * 15.0_wp
-!
-!-- Calculation of declination:
-    declination = 0.3948_wp - 23.2559_wp * COS( ( js + 9.1_wp ) * dtor ) -                         &
-                  0.3915_wp * COS( ( 2.0_wp * js + 5.4_wp ) * dtor ) - 0.1764_wp *                 &
-                  COS( ( 3.0_wp * js + 26.0_wp ) * dtor )
-!
-!-- Calculation of solar zenith angle
-    thetar  = ACOS( SIN( lat * dtor) * SIN( declination * dtor ) + COS( wsp * dtor ) *             &
-              COS( lat * dtor ) * COS( declination * dtor ) )
-    thetasr = ASIN( SIN( lat * dtor) * SIN( declination * dtor ) + COS( wsp * dtor ) *             &
-              COS( lat * dtor ) * COS( declination * dtor ) )
-    sza = thetar / dtor
-!
-!-- calculation of solar azimuth angle
-    IF (woz <= 12.0_wp) alpha = pi - ACOS( ( SIN(thetasr) * SIN( lat * dtor ) -                    &
-                                SIN( declination * dtor ) ) / ( COS(thetasr) * COS( lat * dtor ) ) )
-    IF (woz > 12.0_wp)  alpha = pi + ACOS( ( SIN(thetasr) * SIN( lat * dtor ) -                    &
-                                SIN( declination * dtor ) ) / ( COS(thetasr) * COS( lat * dtor ) ) )
-    saa = alpha / dtor
-
- END SUBROUTINE uvem_solar_position
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Module-specific routine for new module
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bio_calculate_uv_exposure
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nyn, nys
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !< loop index in x direction
-    INTEGER(iwp) ::  j     !< loop index in y direction
-    INTEGER(iwp) ::  szai  !< loop index for different sza values
-
-    CALL uvem_solar_position
-
-    IF (sza  >=  90)  THEN
-       vitd3_exposure(:,:) = 0.0_wp
-    ELSE
-
-       DO  ai = 0, 35
-          DO  zi = 0, 9
-             projection_area_lookup_table(ai,zi) = uvem_projarea_f%var(clothing,zi,ai)
-          ENDDO
-       ENDDO
-       DO  ai = 0, 35
-          DO  zi = 0, 9
-             integration_array(ai,zi) = uvem_integration_f%var(zi,ai)
-          ENDDO
-       ENDDO
-       DO  ai = 0, 2
-          DO  zi = 0, 90
-             irradiance_lookup_table(ai,zi) = uvem_irradiance_f%var(zi,ai)
-          ENDDO
-       ENDDO
-       DO  ai = 0, 35
-          DO  zi = 0, 9
-             DO  szai = 0, 90
-                radiance_lookup_table(ai,zi,szai) = uvem_radiance_f%var(szai,zi,ai)
-             ENDDO
-          ENDDO
-       ENDDO
-
-
-!--    Rotate 3D-Model human to desired direction
-       projection_area_temp( 0:35,:) = projection_area_lookup_table
-       projection_area_temp(36:71,:) = projection_area_lookup_table
-       IF (  .NOT.  turn_to_sun ) startpos_human = orientation_angle / 10.0_wp
-       IF (       turn_to_sun ) startpos_human = saa / 10.0_wp
-       DO  ai = 0, 35
-          xfactor = ( startpos_human ) - INT( startpos_human )
-          DO  zi = 0, 9
-             projection_area(ai,zi) = ( projection_area_temp( 36 -                                 &
-                                                               INT( startpos_human ) - 1 + ai , zi)&
-                                        * ( xfactor ) )                                            &
-                                      + ( projection_area_temp( 36 -                               &
-                                                                INT( startpos_human ) + ai , zi)   &
-                                        * ( 1.0_wp - xfactor ) )
-          ENDDO
-       ENDDO
-!
-!
-!--    Interpolate to accurate Solar Zenith Angle
-       DO  ai = 0, 35
-          xfactor = ( sza )-INT( sza )
-          DO  zi = 0, 9
-             radiance_array(ai,zi) = ( radiance_lookup_table(ai, zi, INT( sza ) ) *                &
-                                     ( 1.0_wp - xfactor) ) +                                       &
-                                     ( radiance_lookup_table(ai,zi,INT( sza ) + 1) * xfactor )
-          ENDDO
-       ENDDO
-       DO  iq = 0, 2
-          irradiance(iq) = ( irradiance_lookup_table(iq, INT( sza ) ) * ( 1.0_wp - xfactor)) +     &
-                           ( irradiance_lookup_table(iq, INT( sza ) + 1) * xfactor )
-       ENDDO
-!
-!--    Interpolate to accurate Solar Azimuth Angle
-       IF ( sun_in_south )  THEN
-          startpos_saa_float = 180.0_wp / 10.0_wp
-       ELSE
-          startpos_saa_float = saa / 10.0_wp
-       ENDIF
-       radiance_array_temp( 0:35,:) = radiance_array
-       radiance_array_temp(36:71,:) = radiance_array
-       xfactor = (startpos_saa_float) - INT( startpos_saa_float )
-       DO  ai = 0, 35
-          DO  zi = 0, 9
-             radiance_array(ai,zi) = ( radiance_array_temp(36 -                                    &
-                                                           INT( startpos_saa_float ) - 1 + ai, zi) &
-                                       * ( xfactor ) )                                             &
-                                     + ( radiance_array_temp(36 -                                  &
-                                                             INT( startpos_saa_float ) + ai, zi)   &
-                                       * ( 1.0_wp - xfactor ) )
-          ENDDO
-       ENDDO
-
-!
-!--    Calculate Projectionarea for direct beam
-       projection_area_direct_temp( 0:35,:) = projection_area
-       projection_area_direct_temp(36:71,:) = projection_area
-       yfactor = ( sza / 10.0_wp ) - INT( sza / 10.0_wp )
-       xfactor = ( startpos_saa_float ) - INT( startpos_saa_float )
-       projection_area_direct_beam = ( projection_area_direct_temp( INT(startpos_saa_float)    ,INT(sza/10.0_wp)  ) * &
-                                     ( 1.0_wp - xfactor ) * ( 1.0_wp - yfactor ) ) +                                  &
-                                     ( projection_area_direct_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp)  ) * &
-                                     (          xfactor ) * ( 1.0_wp - yfactor ) ) +                                  &
-                                     ( projection_area_direct_temp( INT(startpos_saa_float)    ,INT(sza/10.0_wp)+1) * &
-                                     ( 1.0_wp - xfactor ) * (          yfactor ) ) +                                  &
-                                     ( projection_area_direct_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp)+1) * &
-                                     (          xfactor ) * (          yfactor ) )
-
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-!
-!--          Extract obstruction from IBSET-Integer_Array
-             IF (consider_obstructions )  THEN
-                obstruction_temp1 = building_obstruction_f%var_3d(:,j,i)
-                IF ( obstruction_temp1(0)  /=  9 )  THEN
-                   DO  pobi = 0, 44
-                      DO  bi = 0, 7
-                         IF ( BTEST( obstruction_temp1(pobi), bi )  .EQV.  .TRUE.)  THEN
-                            obstruction_temp2( ( pobi * 8 ) + bi ) = 1
-                         ELSE
-                            obstruction_temp2( ( pobi * 8 ) + bi ) = 0
-                         ENDIF
-                      ENDDO
-                   ENDDO
-                   DO  zi = 0, 9
-                      obstruction(:,zi) = obstruction_temp2( zi * 36 :( zi * 36) + 35 )
-                   ENDDO
-                ELSE
-                   obstruction(:,:) = 0
-                ENDIF
-             ENDIF
-!
-!--          Calculated human exposure
-             diffuse_exposure = SUM( radiance_array * projection_area * integration_array *        &
-                                     obstruction )
-
-             obstruction_direct_beam = obstruction( NINT( startpos_saa_float),                     &
-                                                    NINT( sza / 10.0_wp ) )
-             IF (sza  >=  89.99_wp)  THEN
-                sza = 89.99999_wp
-             ENDIF
-!
-!--          Calculate direct normal irradiance (direct beam)
-             direct_exposure = ( irradiance(1) / COS( pi * sza / 180.0_wp ) ) *                    &
-                               projection_area_direct_beam * obstruction_direct_beam
-
-             vitd3_exposure(j,i) = ( diffuse_exposure + direct_exposure ) / 1000.0_wp * 70.97_wp
-!            unit = international units vitamin D per second
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE bio_calculate_uv_exposure
-
- END MODULE biometeorology_mod
Index: palm/trunk/SOURCE/boundary_conds.f90
===================================================================
--- palm/trunk/SOURCE/boundary_conds.f90	(revision 1)
+++ palm/trunk/SOURCE/boundary_conds.f90	(revision 1)
@@ -0,0 +1,316 @@
+ SUBROUTINE boundary_conds( range )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: boundary_conds.f90,v $
+! Revision 1.15  2006/02/23 09:54:55  raasch
+! Surface boundary conditions in case of topography: nzb replaced by
+! 2d-k-index-arrays (nzb_w_inner, etc.). Conditions for u and v remain
+! unchanged (still using nzb) because a non-flat topography must use a
+! Prandtl-layer, which don't requires explicit setting of the surface values.
+!
+! Revision 1.14  2005/06/29 09:49:40  steinfeld
+! Baroclinicity considered in the Dirichlet boundary condition for u and v at
+! the top boundary
+!
+! Revision 1.13  2005/04/23 08:35:30  raasch
+! Error removed in Dirichlet bottom boundary conditions for pt and q in case
+! of Runge-Kutta schemes. So far, new surface values have been taken from
+! timelevel t-dt, which does not exist in case of Runge-Kutta schemes.
+!
+! Revision 1.12  2005/03/26 14:58:24  raasch
+! Non-cyclic boundary conditions included, argument range added
+!
+! Revision 1.11  2001/03/30 06:54:18  raasch
+! Timelevel t+dt replaced by timelevel t,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.10  2001/01/29 12:19:27  raasch
+! Passive scalar is considered
+!
+! Revision 1.9  2001/01/22 05:25:56  raasch
+! Module test_variables removed
+!
+! Revision 1.8  2000/07/04 14:07:59  raasch
+! Missing diriclet boundary conditions for temperature and total water
+! content added
+!
+! Revision 1.7  2000/04/13 13:56:05  schroeter
+! Boundaray conditions for total water content
+!
+! Revision 1.6  2000/01/20  10:44:48  10:44:48  letzel (Marcus Letzel)
+! All comments translated into English
+! 
+! Revision 1.5  2000/01/10 09:28:53  raasch
+! Variablenuebergabe jetzt per Modul
+! Randbedingungen fuer w im Rahmen der pointer-Einfuehrung
+!
+! Revision 1.4  1998/07/06 12:07:05  raasch
+! + USE test_variables
+!
+! Revision 1.3  1998/03/10 07:19:37  raasch
+! Beschreibung ergaenzt um Randbedingung fuer TKE
+!
+! Revision 1.2  1997/09/19 07:39:03  raasch
+! Randbedingungen fuer TKE
+!
+! Revision 1.1  1997/09/12 06:21:34  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Boundary conditions for the prognostic quantities (range='main').
+! In case of non-cyclic lateral boundaries the conditions for velocities at
+! the outflow are set after the pressure solver has been called (range=
+! 'outflow_uvw').
+! One additional bottom boundary condition is applied for the TKE (=(u*)**2)
+! in prandtl_fluxes. The cyclic lateral boundary conditions are implicitly
+! handled in routine exchange_horiz. Pressure boundary conditions are
+! explicitly set in routines pres, poisfft, poismg and sor.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE pegrid
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  range
+
+    INTEGER ::  i, j, k
+
+
+    IF ( range == 'main')  THEN
+!
+!--    Bottom boundary
+       IF ( ibc_uv_b == 0 )  THEN
+          u(nzb,:,:) = -u(nzb+1,:,:)  ! satisfying the Dirichlet condition with
+          v(nzb,:,:) = -v(nzb+1,:,:)  ! an extra layer below the surface where
+       ELSE                           ! the u and v component change their sign
+          u(nzb,:,:) = u(nzb+1,:,:)
+          v(nzb,:,:) = v(nzb+1,:,:)
+       ENDIF
+       DO  i = nxl-1, nxr+1
+          DO  j = nys-1, nyn+1
+             w(nzb_w_inner(j,i),j,i) = 0.0
+          ENDDO
+       ENDDO
+
+!
+!--    Top boundary
+       IF ( ibc_uv_t == 0 )  THEN
+          u(nzt+1,:,:) = ug(nzt+1)
+          v(nzt+1,:,:) = vg(nzt+1)
+       ELSE
+          u(nzt+1,:,:) = u(nzt,:,:)
+          v(nzt+1,:,:) = v(nzt,:,:)
+       ENDIF
+       w(nzt:nzt+1,:,:) = 0.0  ! nzt is not a prognostic level (but cf. pres)
+
+!
+!--    Temperature at bottom boundary
+       IF ( ibc_pt_b == 0 )  THEN
+          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   pt(nzb_s_inner(j,i),j,i) = pt_m(nzb_s_inner(j,i),j,i)
+                ENDDO
+             ENDDO
+          ELSE
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   pt(nzb_s_inner(j,i),j,i) = pt_p(nzb_s_inner(j,i),j,i)  
+                                            ! pt_m is not used for Runge-Kutta
+                ENDDO
+             ENDDO
+          ENDIF
+       ELSE
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                pt(nzb_s_inner(j,i),j,i) = pt(nzb_s_inner(j,i)+1,j,i)
+             ENDDO
+          ENDDO
+       ENDIF
+
+!
+!--    Temperature at top boundary
+       IF ( ibc_pt_t == 1 )  THEN
+          pt(nzt,:,:)   = pt(nzt-1,:,:) + bc_pt_t_val * dzu(nzt)
+          pt(nzt+1,:,:) = pt(nzt,:,:)   + bc_pt_t_val * dzu(nzt+1)
+       ENDIF
+
+!
+!--    Boundary conditions for TKE
+!--    Generally Neumann conditions with de/dz=0 are assumed
+       IF ( .NOT. constant_diffusion )  THEN
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                e(nzb_s_inner(j,i),j,i) = e(nzb_s_inner(j,i)+1,j,i)
+             ENDDO
+          ENDDO
+          e(nzt,:,:)   = e(nzt-1,:,:)
+          e(nzt+1,:,:) = e(nzt,:,:)
+       ENDIF
+
+!
+!--    Boundary conditions for total water content or scalar,
+!--    bottom and surface boundary (see also temperature)
+       IF ( moisture  .OR.  passive_scalar )  THEN
+!
+!--       Surface conditions for constant_moisture_flux
+          IF ( ibc_q_b == 0 ) THEN
+             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+                DO  i = nxl-1, nxr+1
+                   DO  j = nys-1, nyn+1
+                      q(nzb_s_inner(j,i),j,i) = q_m(nzb_s_inner(j,i),j,i)
+                   ENDDO
+                ENDDO
+             ELSE
+                DO  i = nxl-1, nxr+1
+                   DO  j = nys-1, nyn+1
+                      q(nzb_s_inner(j,i),j,i) = q_p(nzb_s_inner(j,i),j,i)
+                   ENDDO                      ! q_m is not used for Runge-Kutta
+                ENDDO
+             ENDIF
+          ELSE
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   q(nzb_s_inner(j,i),j,i) = q(nzb_s_inner(j,i)+1,j,i)
+                ENDDO
+             ENDDO
+          ENDIF
+!
+!--       Top boundary
+          q(nzt,:,:)   = q(nzt-1,:,:) + bc_q_t_val * dzu(nzt)
+          q(nzt+1,:,:) = q(nzt,:,:)   + bc_q_t_val * dzu(nzt+1)
+       ENDIF
+
+!
+!--    Lateral boundary conditions at the inflow. Quasi Neumann conditions
+!--    are needed for the wall normal velocity in order to ensure zero
+!--    divergence. Dirichlet conditions are used for all other quantities.
+       IF ( inflow_s )  THEN
+          v(:,nys,:) = v(:,nys-1,:)
+       ELSEIF ( inflow_n ) THEN
+          v(:,nyn+vynp,:) = v(:,nyn+vynp+1,:)
+       ELSEIF ( inflow_l ) THEN
+          u(:,:,nxl) = u(:,:,nxl-1)
+       ELSEIF ( inflow_r ) THEN
+          u(:,:,nxr+uxrp) = u(:,:,nxr+uxrp+1)
+       ENDIF
+
+!
+!--    Lateral boundary conditions for scalar quantities at the outflow
+       IF ( outflow_s )  THEN
+          pt(:,nys-1,:)     = pt(:,nys,:)
+          IF ( .NOT. constant_diffusion     )  e(:,nys-1,:) = e(:,nys,:)
+          IF ( moisture .OR. passive_scalar )  q(:,nys-1,:) = q(:,nys,:)
+       ELSEIF ( outflow_n )  THEN
+          pt(:,nyn+1,:)     = pt(:,nyn,:)
+          IF ( .NOT. constant_diffusion     )  e(:,nyn+1,:) = e(:,nyn,:)
+          IF ( moisture .OR. passive_scalar )  q(:,nyn+1,:) = q(:,nyn,:)
+       ELSEIF ( outflow_l )  THEN
+          pt(:,:,nxl-1)     = pt(:,:,nxl)
+          IF ( .NOT. constant_diffusion     )  e(:,:,nxl-1) = e(:,:,nxl)
+          IF ( moisture .OR. passive_scalar )  q(:,:,nxl-1) = q(:,:,nxl)      
+       ELSEIF ( outflow_r )  THEN
+          pt(:,:,nxr+1)     = pt(:,:,nxr)
+          IF ( .NOT. constant_diffusion     )  e(:,:,nxr+1) = e(:,:,nxr)
+          IF ( moisture .OR. passive_scalar )  q(:,:,nxr+1) = q(:,:,nxr)
+       ENDIF
+
+    ENDIF
+
+    IF ( range == 'outflow_uvw' ) THEN
+!
+!--    Horizontal boundary conditions for the velocities at the outflow.
+!--    A Neumann condition is used for the wall normal velocity. The vertical
+!--    velocity is assumed as zero and a horizontal average along the wall is
+!--    used for the wall parallel horizontal velocity. The combination of all
+!--    three conditions ensures that the velocity field is free of divergence
+!--    at the outflow (uvmean_outflow_l is calculated in pres).
+       IF ( outflow_s ) THEN
+          v(:,nys-1,:) = v(:,nys,:)
+          w(:,nys-1,:) = 0.0
+!
+!--       Compute the mean horizontal wind parallel to and within the outflow
+!--       wall and use this as boundary condition for u
+#if defined( __parallel )
+          CALL MPI_ALLREDUCE( uvmean_outflow_l, uvmean_outflow, nzt-nzb+2, &
+                              MPI_REAL, MPI_SUM, comm1dx, ierr )
+          uvmean_outflow = uvmean_outflow / ( nx + 1.0 )
+#else
+          uvmean_outflow = uvmean_outflow_l / ( nx + 1.0 )
+#endif
+          DO  k = nzb, nzt+1
+             u(k,nys-1,:) = uvmean_outflow(k)
+          ENDDO
+       ENDIF
+
+       IF ( outflow_n ) THEN
+          v(:,nyn+vynp+1,:) = v(:,nyn+vynp,:)
+          w(:,nyn+1,:)      = 0.0
+!
+!--       Compute the mean horizontal wind parallel to and within the outflow
+!--       wall and use this as boundary condition for u
+#if defined( __parallel )
+          CALL MPI_ALLREDUCE( uvmean_outflow_l, uvmean_outflow, nzt-nzb+2, &
+                              MPI_REAL, MPI_SUM, comm1dx, ierr )
+          uvmean_outflow = uvmean_outflow / ( nx + 1.0 )
+#else
+          uvmean_outflow = uvmean_outflow_l / ( nx + 1.0 )
+#endif
+          DO  k = nzb, nzt+1
+             u(k,nyn+1,:) = uvmean_outflow(k)
+          ENDDO
+       ENDIF
+
+       IF ( outflow_l ) THEN
+          u(:,:,nxl-1) = u(:,:,nxl)
+          w(:,:,nxl-1) = 0.0
+!
+!--       Compute the mean horizontal wind parallel to and within the outflow
+!--       wall and use this as boundary condition for v
+#if defined( __parallel )
+          CALL MPI_ALLREDUCE( uvmean_outflow_l, uvmean_outflow, nzt-nzb+2, &
+                              MPI_REAL, MPI_SUM, comm1dy, ierr )
+          uvmean_outflow = uvmean_outflow / ( ny + 1.0 )
+#else
+          uvmean_outflow = uvmean_outflow_l / ( ny + 1.0 )
+#endif
+          DO  k = nzb, nzt+1
+             v(k,:,nxl-1) = uvmean_outflow(k)
+          ENDDO    
+
+       ENDIF
+
+       IF ( outflow_r ) THEN
+          u(:,:,nxr+uxrp+1) = u(:,:,nxr+uxrp)
+          w(:,:,nxr+1) = 0.0
+!
+!--       Compute the mean horizontal wind parallel to and within the outflow
+!--       wall and use this as boundary condition for v
+#if defined( __parallel )
+          CALL MPI_ALLREDUCE( uvmean_outflow_l, uvmean_outflow, nzt-nzb+2, &
+                              MPI_REAL, MPI_SUM, comm1dy, ierr )
+          uvmean_outflow = uvmean_outflow / ( ny + 1.0 )
+#else
+          uvmean_outflow = uvmean_outflow_l / ( ny + 1.0 )
+#endif
+          DO  k = nzb, nzt+1
+             v(k,:,nxr+1) = uvmean_outflow(k)
+          ENDDO    
+       ENDIF
+
+    ENDIF
+
+ 
+ END SUBROUTINE boundary_conds
Index: palm/trunk/SOURCE/bulk_cloud_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/bulk_cloud_model_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,13344 +1,0 @@
-!> @file bulk_cloud_model_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! internal switch removed from namelist
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Enable 3D data output also with 64-bit precision
-!
-! 4755 2020-10-21 15:09:15Z schwenkel
-! Minor reformatting
-!
-! 4742 2020-10-14 15:11:02Z schwenkel
-! Implement snow and graupel (bulk microphysics)
-!
-! 4731 2020-10-07 13:25:11Z schwenkel
-! Move exchange_horiz from time_integration to modules
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-! 
-! 4577 2020-06-25 09:53:58Z raasch
-! further re-formatting concerning Fortran parameter variables
-!
-! 4542 2020-05-19 15:45:12Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4533 2020-05-14 14:46:46Z schwenkel
-! Reformat intrinsic function
-!
-! 4532 2020-05-14 13:41:35Z schwenkel
-! Calculate mean droplet radius assuming gamma distibution for condensation
-!
-! 4521 2020-05-06 11:39:49Z schwenkel
-! Rename variable
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO for reading local arrays
-!
-! 4506 2020-04-21 10:57:45Z schwenkel
-! Use correct magnus formula for liquid water temperature
-!
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4418 2020-02-21 09:41:13Z raasch
-! bugfix for raindrop number adjustment
-!
-! 4370 2020-01-10 14:00:44Z raasch
-! vector directives added to force vectorization on Intel19 compiler
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static
-! topography information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4289 2019-11-05 14:33:41Z knoop
-! Removed parameters precipitation and precipitation_amount_interval from namelist
-!
-! 4268 2019-10-17 11:29:38Z schwenkel
-! Introducing bcm_boundary_conditions
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4110 2019-07-22 17:05:21Z suehring
-! Pass integer flag array as well as boundary flags to WS scalar advection
-! routine
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! Added microphyics scheme 'morrision_no_rain'
-!
-! 3931 2019-04-24 16:34:28Z schwenkel
-! Added bcm_exchange_horiz which is called after non_transport_physics
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction
-! of additional debug messages
-!
-! 3874 2019-04-08 16:53:48Z knoop
-! Implemented non_transport_physics module interfaces
-!
-! 3870 2019-04-08 13:44:34Z knoop
-! Moving prognostic equations of bcm into bulk_cloud_model_mod
-!
-! 3869 2019-04-08 11:54:20Z knoop
-! moving the furniture around ;-)
-!
-! 3786 2019-03-06 16:58:03Z raasch
-! unsed variables removed
-!
-! 3767 2019-02-27 08:18:02Z raasch
-! unused variable for file index removed from rrd-subroutines parameter list
-!
-! 3724 2019-02-06 16:28:23Z kanani
-! Correct double-used log_point_s unit
-!
-! 3700 2019-01-26 17:03:42Z knoop
-! nopointer option removed
-! 1053 2012-11-13 17:11:03Z hoffmann
-! initial revision
-!
-! Description:
-! ------------
-!> Calculate bulk cloud microphysics.
-!--------------------------------------------------------------------------------------------------!
- MODULE bulk_cloud_model_mod
-
-
-    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_ws,                                                                                  &
-        ONLY:  advec_s_ws
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  diss_s_qc, diss_s_qr, diss_s_nc, diss_s_nr,                                         &
-               diss_l_qc, diss_l_qr, diss_l_nc, diss_l_nr,                                         &
-               diss_l_qi, diss_l_ni, diss_s_qi, diss_s_ni,                                         &
-               diss_l_qg, diss_l_ng, diss_s_qg, diss_s_ng,                                         &
-               diss_l_qs, diss_l_ns, diss_s_qs, diss_s_ns,                                         &
-               ddzu, diss, dzu, dzw, hyp, hyrho,                                                   &
-               exner, zu, tnc_m, tnr_m, tqc_m, tqr_m, tend, rdf_sc,                                &
-               flux_l_qc, flux_l_qr, flux_l_nc, flux_l_nr,                                         &
-               flux_l_qi, flux_l_ni, flux_s_qi, flux_s_ni,                                         &
-               flux_l_qg, flux_l_ng, flux_s_qg, flux_s_ng,                                         &
-               flux_l_qs, flux_l_ns, flux_s_qs, flux_s_ns,                                         &
-               flux_s_qc, flux_s_qr, flux_s_nc, flux_s_nr,                                         &
-               nc, nc_1, nc_2, nc_3, nc_p, nr, nr_1, nr_2, nr_3, nr_p,                             &
-               ni, ni_1, ni_2, ni_3, ni_p, tni_m,                                                  &
-               ng, ng_1, ng_2, ng_3, ng_p, tng_m,                                                  &
-               ns, ns_1, ns_2, ns_3, ns_p, tns_m,                                                  &
-               precipitation_amount, prr, pt, d_exner, pt_init, q, qf, qf_1, ql, ql_1,             &
-               qc, qc_1, qc_2, qc_3, qc_p, qr, qr_1, qr_2, qr_3, qr_p,                             &
-               qi, qi_1, qi_2, qi_3, qi_p, tqi_m,                                                  &
-               qg, qg_1, qg_2, qg_3, qg_p, tqg_m,                                                  &
-               qs, qs_1, qs_2, qs_3, qs_p, tqs_m
-
-
-
-    USE averaging,                                                                                 &
-        ONLY:  nc_av, ng_av, ni_av, nr_av, ns_av, prr_av, qc_av, ql_av, qg_av, qi_av, qr_av, qs_av
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  c_p, c_w, g, lv_d_cp, lv_d_rd, l_m, l_v, magnus, magnus_ice, magnus_tl,             &
-               exner_function, exner_function_invers, ideal_gas_law_rho,                           &
-               ideal_gas_law_rho_pt, barometric_formula, rd_d_rv, l_s,                             &
-               ls_d_cp,                                                                            &
-               molecular_weight_of_solute,                                                         &
-               molecular_weight_of_water, pi, rho_i, rho_l, rho_s, r_d, r_v, vanthoff
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               debug_output,                                                                       &
-               dt_3d, dt_do2d_xy, intermediate_timestep_count,                                     &
-               intermediate_timestep_count_max, large_scale_forcing,                               &
-               loop_optimization, simulated_time,                                                  &
-               lsf_surf, pt_surface, restart_data_format_output, rho_surface,                      &
-               surface_pressure,                                                                   &
-               time_do2d_xy, message_string, initializing_actions,                                 &
-               ws_scheme_sca, scalar_advec, timestep_scheme, tsc
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point, log_point_s
-
-    USE diffusion_s_mod,                                                                           &
-        ONLY:  diffusion_s
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  advc_flags_s,                                                                       &
-               nbgp, nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt,                         &
-               topo_top_ind,                                                                       &
-               wall_flags_total_0
-
-    USE kinds
-
-    USE pegrid,                                                                                    &
-        ONLY:  threads_per_task
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_check_array, rrd_mpi_io, wrd_mpi_io
-
-    USE statistics,                                                                                &
-        ONLY:  sums_wsncs_ws_l, sums_wsngs_ws_l, sums_wsnis_ws_l, sums_wsnrs_ws_l, sums_wsnss_ws_l,&
-               sums_wsqcs_ws_l, sums_wsqgs_ws_l, sums_wsqis_ws_l, sums_wsqrs_ws_l, sums_wsqss_ws_l,&
-               weight_pres, weight_substep
-
-    USE surface_mod,                                                                               &
-        ONLY :  bc_h,                                                                              &
-                surf_bulk_cloud_model,                                                             &
-                surf_microphysics_morrison, surf_microphysics_seifert,                             &
-                surf_microphysics_ice_phase,                                                       &
-                surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,                        &
-                surf_usm_v
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=20)   ::  aerosol_bulk = 'nacl'                        !< namelist parameter
-    CHARACTER (LEN=20)   ::  cloud_scheme = 'saturation_adjust'           !< namelist parameter
-
-    LOGICAL ::  aerosol_nacl =.TRUE.                         !< nacl aerosol for bulk scheme
-    LOGICAL ::  aerosol_c3h4o4 =.FALSE.                      !< malonic acid aerosol for bulk scheme
-    LOGICAL ::  aerosol_nh4no3 =.FALSE.                      !< malonic acid aerosol for bulk scheme
-    LOGICAL ::  bulk_cloud_model = .FALSE.                   !< namelist parameter
-    LOGICAL ::  call_microphysics_at_all_substeps = .FALSE.  !< namelist parameter
-    LOGICAL ::  cloud_water_sedimentation = .FALSE.          !< cloud water sedimentation
-    LOGICAL ::  collision_turbulence = .FALSE.               !< turbulence effects
-    LOGICAL ::  curvature_solution_effects_bulk = .FALSE.    !< flag for considering koehler theory
-    LOGICAL ::  ice_crystal_sedimentation = .FALSE.          !< flag for ice crystal sedimentation
-    LOGICAL ::  limiter_sedimentation = .TRUE.               !< sedimentation limiter
-    LOGICAL ::  microphysics_ice_phase = .FALSE.             !< use ice microphysics scheme
-    LOGICAL ::  microphysics_kessler = .FALSE.               !< use kessler bulk scheme?
-    LOGICAL ::  microphysics_morrison = .FALSE.              !< use 2-moment Morrison
-                                                             !< (add. prog. eq. for nc and qc)
-    LOGICAL ::  microphysics_morrison_no_rain = .FALSE.      !< use 2-moment Morrison
-    LOGICAL ::  microphysics_sat_adjust = .FALSE.            !< use saturation adjust bulk scheme?
-    LOGICAL ::  microphysics_seifert = .FALSE.               !< use 2-moment Seifert and Beheng
-                                                             !< scheme
-    LOGICAL ::  precipitation = .FALSE.                      !< namelist parameter
-    LOGICAL ::  snow = .FALSE.                               !< namelist parameter
-    LOGICAL ::  snow_sedimentation = .TRUE.                  !< namelist parameter
-    LOGICAL ::  graupel_sedimentation = .TRUE.               !< namelist parameter
-    LOGICAL ::  graupel = .FALSE.                            !< namelist parameter
-    LOGICAL ::  ventilation_effect = .TRUE.                  !< ventilation effect
-    LOGICAL ::  ice_multiplication = .TRUE.                  !< Turn on ice multiplication (Hallet Mossop process)
-    LOGICAL ::  enhanced_melting = .TRUE.                    !< Turn on ice enhacement of melting during riming
-
-    REAL(wp), PARAMETER ::  a_1 = 8.69E-4_wp                    !< coef. in turb. parametrization    (cm-2 s3)
-    REAL(wp), PARAMETER ::  a_2 = -7.38E-5_wp                   !< coef. in turb. parametrization    (cm-2 s3)
-    REAL(wp), PARAMETER ::  a_3 = -1.40E-2_wp                   !< coef. in turb. parametrization
-    REAL(wp), PARAMETER ::  a_term = 9.65_wp                    !< coef. for terminal velocity       (m s-1)
-    REAL(wp), PARAMETER ::  a_vent = 0.78_wp                    !< coef. for ventilation effect
-    REAL(wp), PARAMETER ::  b_1 = 11.45E-6_wp                   !< coef. in turb. parametrization    (m)
-    REAL(wp), PARAMETER ::  b_2 = 9.68E-6_wp                    !< coef. in turb. parametrization    (m)
-    REAL(wp), PARAMETER ::  b_3 = 0.62_wp                       !< coef. in turb. parametrization
-    REAL(wp), PARAMETER ::  b_term = 9.8_wp                     !< coef. for terminal velocity       (m s-1)
-    REAL(wp), PARAMETER ::  b_vent = 0.308_wp                   !< coef. for ventilation effect
-    REAL(wp), PARAMETER ::  beta_cc = 3.09E-4_wp                !< coef. in turb. parametrization    (cm-2 s3)
-    REAL(wp), PARAMETER ::  c_1 = 4.82E-6_wp                    !< coef. in turb. parametrization    (m)
-    REAL(wp), PARAMETER ::  c_2 = 4.8E-6_wp                     !< coef. in turb. parametrization    (m)
-    REAL(wp), PARAMETER ::  c_3 = 0.76_wp                       !< coef. in turb. parametrization
-    REAL(wp), PARAMETER ::  c_const = 0.93_wp                   !< const. in Taylor-microscale Reynolds number
-    REAL(wp), PARAMETER ::  c_evap = 0.7_wp                     !< constant in evaporation
-    REAL(wp), PARAMETER ::  c_term = 600.0_wp                   !< coef. for terminal velocity       (m-1)
-    REAL(wp), PARAMETER ::  diff_coeff_l = 0.23E-4_wp           !< diffusivity of water vapor        (m2 s-1)
-    REAL(wp), PARAMETER ::  eps_sb = 1.0E-10_wp                 !< threshold in two-moments scheme
-    REAL(wp), PARAMETER ::  eps_sb_coll = 1.0E-7_wp             !< q-threshold for collection 1e-4 g/m3
-    REAL(wp), PARAMETER ::  eps_sb_n = 1.0E-20_wp               !< add small psi to number concentration
-    REAL(wp), PARAMETER ::  eps_mr = 0.0_wp                     !< threshold for morrison scheme
-    REAL(wp), PARAMETER ::  k_cc = 9.44E09_wp                   !< const. cloud-cloud kernel         (m3 kg-2 s-1)
-    REAL(wp), PARAMETER ::  k_cr0 = 4.33_wp                     !< const. cloud-rain kernel          (m3 kg-1 s-1)
-    REAL(wp), PARAMETER ::  k_rr = 7.12_wp                      !< const. rain-rain kernel           (m3 kg-1 s-1)
-    REAL(wp), PARAMETER ::  k_br = 1000.0_wp                    !< const. in breakup parametrization (m-1)
-    REAL(wp), PARAMETER ::  k_st = 1.2E8_wp                     !< const. in drizzle parametrization (m-1 s-1)
-    REAL(wp), PARAMETER ::  kin_vis_air = 1.4086E-5_wp          !< kin. viscosity of air             (m2 s-1)
-    REAL(wp), PARAMETER ::  ql_crit = 0.0005_wp                 !< coef. in Kessler scheme           (kg kg-1)
-    REAL(wp), PARAMETER ::  rho_0 = 1.225_wp                    !< reference air densitiy following SB2006
-    REAL(wp), PARAMETER ::  schmidt_p_1d3 = 0.8921121_wp        !< Schmidt number**0.33333, 0.71**0.33333
-    REAL(wp), PARAMETER ::  t3 = 273.15_wp                      !< temperature of freezing point
-    REAL(wp), PARAMETER ::  thermal_conductivity_l = 2.43E-2_wp !< therm. cond. air         (J m-1 s-1 K-1)
-    REAL(wp), PARAMETER ::  w_precipitation = 9.65_wp           !< maximum terminal velocity         (m s-1)
-    REAL(wp), PARAMETER ::  x0 = 2.6E-10_wp                     !< separating drop mass              (kg)
-    REAL(wp), PARAMETER ::  ximin = 4.42E-14_wp                 !< minimum mass of ice crystal       (kg) (D~10Âµm)
-    REAL(wp), PARAMETER ::  ximax = 1.0E-7_wp                   !< maximum rain drop site            (kg)
-    REAL(wp), PARAMETER ::  xcmax = 2.6E-10_wp                  !< maximum cloud drop size           (kg)
-    REAL(wp), PARAMETER ::  xcmin = 4.18E-15_wp                 !< minimum cloud drop size           (kg) (~ 1Âµm)
-    REAL(wp), PARAMETER ::  xgmax = 1.0E-4_wp                   !< maximum graupel drop size         (kg)
-    REAL(wp), PARAMETER ::  xgmin = 2.6E-10_wp                  !< minimum graupel drop size         (kg)
-    REAL(wp), PARAMETER ::  xsmax = 1.0E-7_wp                   !< minimum snow size                 (kg)
-    REAL(wp), PARAMETER ::  xsmin = 1.73E-9_wp                  !< minimum snow size                 (kg)
-    REAL(wp), PARAMETER ::  xrmin = 2.6E-10_wp                  !< minimum rain drop size            (kg)
-    REAL(wp), PARAMETER ::  xrmax = 5.0E-6_wp                   !< maximum rain drop site            (kg)
-    REAL(wp), PARAMETER ::  q_thres = 1.0E-6_wp                 !< q threshold for riming            (kg/kg)
-    REAL(wp), PARAMETER ::  qr_crit = 1.0E-5_wp                 !< q-threshold for riming ice- rain
-    REAL(wp), PARAMETER ::  dc_coll = 40.0E-6_wp                !< upper bound for diameter in collision efficiency
-    REAL(wp), PARAMETER ::  dig_conv = 200.0E-6_wp              !< diameter threshold for conversion of ice to graupel (m)
-    REAL(wp), PARAMETER ::  dsg_conv = 200.0E-6_wp              !< diameter threshold for conversion of snow to graupel (m)
-    REAL(wp), PARAMETER ::  dc_crit = 10.0E-6_wp                !< critical diameter of cloud droplets for riming (m)
-    REAL(wp), PARAMETER ::  df_crit = 100.0E-6_wp               !< critical diameter of graupel for riming (m)
-    REAL(wp), PARAMETER ::  ecoll_min = 0.01_wp                 !< minimum efficences for riming of cloud droplets
-    REAL(wp), PARAMETER ::  temp_mult_min = 265.0_wp            !< minimum temperature for splintering (K)
-    REAL(wp), PARAMETER ::  temp_mult_max = 270.0_wp            !< maximum temperature for splintering (K)
-    REAL(wp), PARAMETER ::  temp_mult_opt = 268.0_wp            !< optimal temperature splintering
-    REAL(wp), PARAMETER ::  c_mult = 3.5E8_wp                   !< coeffiecnt for splintering
-    REAL(wp), PARAMETER ::  x_conv = 0.1E-9_wp                  !< minimum mass of conversion due to riming
-    REAL(wp), PARAMETER ::  alpha_spacefilling = 0.01_wp        !< space filling coefficient (max. 0.68)
-
-    REAL(wp) ::  c_sedimentation = 2.0_wp        !< Courant number of sedimentation process
-    REAL(wp) ::  a1_ven_coeff_snow               !< 1st coefficient for ventilation of snow
-    REAL(wp) ::  b1_ven_coeff_snow               !< 2nd coefficient for ventilation of snow
-    REAL(wp) ::  a1_ven_coeff_graupel            !< 1st coefficient for ventilation of graupel
-    REAL(wp) ::  b1_ven_coeff_graupel            !< 2nd coefficient for ventilation of graupel
-    REAL(wp) ::  cz_cloud                        !< coefficient for homogeneous freezing of cloud droplets
-    REAL(wp) ::  coll_coeff_graupel_self         !< pre-calculated collision coefficient for graupel selfcollection
-    REAL(wp) ::  coll_coeff_snow_self_delta      !< pre-calculated collision coefficient for snow selfcollection
-    REAL(wp) ::  coll_coeff_snow_self_theta      !< pre-calculated collision coefficient for snow selfcollection
-    REAL(wp) ::  coll_coeff_ice_self_delta_n     !< pre-calculated collision coefficient for ice selfcollection
-    REAL(wp) ::  coll_coeff_ice_self_delta_q     !< pre-calculated collision coefficient for ice selfcollection
-    REAL(wp) ::  coll_coeff_ice_self_theta_n     !< pre-calculated collision coefficient for ice selfcollection
-    REAL(wp) ::  coll_coeff_ice_self_theta_q     !< pre-calculated collision coefficient for ice selfcollection
-    REAL(wp) ::  coll_graupel_ice_delta_n_aa     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_delta_n_bb     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_delta_n_ab     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_delta_q_aa     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_delta_q_bb     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_delta_q_ab     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_theta_n_aa     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_theta_n_bb     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_theta_n_ab     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_theta_q_aa     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_theta_q_bb     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_graupel_ice_theta_q_ab     !< pre-calculated collision coefficient for graupel-ice collection
-    REAL(wp) ::  coll_snow_ice_delta_n_aa        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_delta_n_bb        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_delta_n_ab        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_delta_q_aa        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_delta_q_bb        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_delta_q_ab        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_theta_n_aa        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_theta_n_bb        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_theta_n_ab        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_theta_q_aa        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_theta_q_bb        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_snow_ice_theta_q_ab        !< pre-calculated collision coefficient for snow-ice collection
-    REAL(wp) ::  coll_graupel_snow_delta_n_aa    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_delta_n_bb    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_delta_n_ab    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_delta_q_aa    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_delta_q_bb    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_delta_q_ab    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_theta_n_aa    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_theta_n_bb    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_theta_n_ab    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_theta_q_aa    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_theta_q_bb    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  coll_graupel_snow_theta_q_ab    !< pre-calculated collision coefficient for graupel-snow collection
-    REAL(wp) ::  rime_graupel_cloud_delta_n_aa   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_delta_n_ab   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_delta_n_bb   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_delta_q_aa   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_delta_q_ab   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_delta_q_ba   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_delta_q_bb   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_theta_n_aa   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_theta_n_ab   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_theta_n_bb   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_theta_q_aa   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_theta_q_ab   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_theta_q_ba   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_cloud_theta_q_bb   !< pre-calculated riming coefficient for graupel-cloud
-    REAL(wp) ::  rime_graupel_rain_delta_n_aa    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_delta_n_ab    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_delta_n_bb    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_delta_q_aa    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_delta_q_ab    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_delta_q_ba    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_delta_q_bb    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_theta_n_aa    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_theta_n_ab    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_theta_n_bb    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_theta_q_aa    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_theta_q_ab    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_theta_q_ba    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_graupel_rain_theta_q_bb    !< pre-calculated riming coefficient for graupel-rain
-    REAL(wp) ::  rime_ice_cloud_delta_n_aa       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_delta_n_ab       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_delta_n_bb       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_delta_q_aa       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_delta_q_ab       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_delta_q_ba       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_delta_q_bb       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_theta_n_aa       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_theta_n_ab       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_theta_n_bb       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_theta_q_aa       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_theta_q_ab       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_theta_q_ba       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_cloud_theta_q_bb       !< pre-calculated riming coefficient for ice-cloud
-    REAL(wp) ::  rime_ice_rain_delta_n_aa        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_delta_n_ab        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_delta_n_bb        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_delta_q_aa        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_delta_q_ab        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_delta_q_ba        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_delta_q_bb        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_theta_n_aa        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_theta_n_ab        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_theta_n_bb        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_theta_q_aa        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_theta_q_ab        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_theta_q_ba        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_ice_rain_theta_q_bb        !< pre-calculated riming coefficient for ice-rain
-    REAL(wp) ::  rime_snow_cloud_delta_n_aa      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_delta_n_ab      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_delta_n_bb      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_delta_q_aa      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_delta_q_ab      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_delta_q_bb      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_theta_n_aa      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_theta_n_ab      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_theta_n_bb      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_theta_q_aa      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_theta_q_ab      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_cloud_theta_q_bb      !< pre-calculated riming coefficient for snow-cloud
-    REAL(wp) ::  rime_snow_rain_delta_n_aa       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_delta_n_ab       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_delta_n_bb       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_delta_q_aa       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_delta_q_ab       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_delta_q_ba       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_delta_q_bb       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_theta_n_aa       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_theta_n_ab       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_theta_n_bb       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_theta_q_aa       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_theta_q_ab       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_theta_q_ba       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  rime_snow_rain_theta_q_bb       !< pre-calculated riming coefficient for snow-rain
-    REAL(wp) ::  dpirho_l                        !< 6.0 / ( pi * rho_l )
-    REAL(wp) ::  dry_aerosol_radius = 0.05E-6_wp !< dry aerosol radius
-    REAL(wp) ::  dt_micro                        !< microphysics time step
-    REAL(wp) ::  dt_precipitation = 100.0_wp     !< timestep precipitation (s)
-    REAL(wp) ::  e_s                             !< saturation water vapor pressure
-    REAL(wp) ::  e_si                            !< saturation water vapor pressure over ice
-    REAL(wp) ::  in_init = 1000.0_wp             !< initial number of potential ice nucleii
-    REAL(wp) ::  na_init = 100.0E6_wp            !< Total particle/aerosol concentration (cm-3)
-    REAL(wp) ::  nc_const = 70.0E6_wp            !< cloud droplet concentration
-    REAL(wp) ::  pirho_l                         !< pi * rho_l / 6.0
-    REAL(wp) ::  prec_time_const = 0.001_wp      !< coef. in Kessler scheme           (s-1)
-    REAL(wp) ::  precipitation_amount_interval = 9999999.9_wp     !< namelist parameter
-    REAL(wp) ::  q_s                             !< saturation mixing ratio
-    REAL(wp) ::  q_si                            !< saturation mixing ratio over ice
-    REAL(wp) ::  sat                             !< supersaturation
-    REAL(wp) ::  sat_ice                         !< supersaturation over ice
-    REAL(wp) ::  start_ice_microphysics = 0.0_wp !< time from which on ice microhysics are executed
-    REAL(wp) ::  sed_qc_const                    !< const. for sedimentation of cloud water
-    REAL(wp) ::  sigma_bulk = 2.0_wp             !< width of aerosol spectrum
-    REAL(wp) ::  sigma_gc = 1.3_wp               !< geometric standard deviation cloud droplets
-    REAL(wp) ::  t_l                             !< liquid-(ice) water temperature
-
-    TYPE ::  cloud_coefficients                !< coefficients for each cloud species
-       REAL(wp) ::  a                          !< a coefficient (pre-factor in diameter-mass relation, Table 1 in SB2006)
-       REAL(wp) ::  b                          !< b coefficient (exponent in diameter-mass relation, Table 1 in SB2006)
-       REAL(wp) ::  alpha                      !< alpha coefficient (pre-factor in power law fall speed, Table 1 in SB2006)
-       REAL(wp) ::  beta                       !< beta coefficient (exponent in power law fall speed, Table 1 in SB2006)
-       REAL(wp) ::  nu                         !< nu coefficient (first shape parameter of size distribution, Table 1 in SB2006)
-       REAL(wp) ::  mu                         !< mu coefficient (second shape parameter of size distribution, Table 1in SB2006)
-       REAL(wp) ::  sigma_v                    !< variance of fall speed (see SB2006, List of symbols)
-       REAL(wp) ::  a_ven                      !< a ventilation coefficient
-       REAL(wp) ::  b_ven                      !< b ventilation coefficient
-       REAL(wp) ::  cap                        !< capacity of particle
-       REAL(wp) ::  x_min                      !< minimum (mean) mass of particle in SB-scheme
-       REAL(wp) ::  x_max                      !< maximum (mean) mass of particle in SB-scheme
-       REAL(wp) ::  coll_eff                   !< maximum collision efficiency with cloud droplets
-    END TYPE cloud_coefficients
-
-    TYPE ::  cloud_species_def                  !< definition class for each ice species
-       TYPE(cloud_coefficients) ::  cloud       !< cloud
-       TYPE(cloud_coefficients) ::  rain        !< rain
-       TYPE(cloud_coefficients) ::  graupel     !< graupel
-       TYPE(cloud_coefficients) ::  ice         !< ice
-       TYPE(cloud_coefficients) ::  snow        !< snow
-    END TYPE
-
-    TYPE(cloud_species_def) ::  cloud_species  !< ice species
-
-    REAL, ALLOCATABLE, DIMENSION(:,:,:) ::  dep_rate_ice       !< 3D-field of ice deposition rates
-    REAL, ALLOCATABLE, DIMENSION(:,:,:) ::  dep_rate_snow      !< 3D-field of ice deposition rates
-    REAL, ALLOCATABLE, DIMENSION(:,:,:) ::  rime_ice_cloud     !< 3D-field of ice-cloud riming rates
-    REAL, ALLOCATABLE, DIMENSION(:,:,:) ::  rime_ice_rain      !< 3D-field of ice rain riming rates
-    REAL, ALLOCATABLE, DIMENSION(:,:,:) ::  rime_snow_cloud    !< 3D-field of ice-cloud riming rates
-    REAL, ALLOCATABLE, DIMENSION(:,:,:) ::  rime_snow_rain     !< 3D-field of ice rain riming rates
-
-    SAVE
-
-    PRIVATE
-
-    PUBLIC bcm_parin,                                                                              &
-           bcm_check_parameters,                                                                   &
-           bcm_check_data_output,                                                                  &
-           bcm_check_data_output_pr,                                                               &
-           bcm_init_arrays,                                                                        &
-           bcm_init,                                                                               &
-           bcm_header,                                                                             &
-           bcm_actions,                                                                            &
-           bcm_non_advective_processes,                                                            &
-           bcm_exchange_horiz,                                                                     &
-           bcm_prognostic_equations,                                                               &
-           bcm_boundary_conditions,                                                                &
-           bcm_3d_data_averaging,                                                                  &
-           bcm_data_output_2d,                                                                     &
-           bcm_data_output_3d,                                                                     &
-           bcm_swap_timelevel,                                                                     &
-           bcm_rrd_global,                                                                         &
-           bcm_rrd_local,                                                                          &
-           bcm_wrd_global,                                                                         &
-           bcm_wrd_local,                                                                          &
-           calc_liquid_water_content
-
-    PUBLIC bulk_cloud_model,                                                                       &
-           call_microphysics_at_all_substeps,                                                      &
-           cloud_water_sedimentation,                                                              &
-           cloud_scheme,                                                                           &
-           collision_turbulence,                                                                   &
-           dt_precipitation,                                                                       &
-           ice_crystal_sedimentation,                                                              &
-           in_init,                                                                                &
-           microphysics_morrison,                                                                  &
-           microphysics_morrison_no_rain,                                                          &
-           microphysics_sat_adjust,                                                                &
-           microphysics_seifert,                                                                   &
-           microphysics_ice_phase,                                                                 &
-           na_init,                                                                                &
-           nc_const,                                                                               &
-           precipitation,                                                                          &
-           sigma_gc,                                                                               &
-           snow,                                                                                   &
-           graupel,                                                                                &
-           start_ice_microphysics
-
-    INTERFACE bcm_parin
-       MODULE PROCEDURE bcm_parin
-    END INTERFACE bcm_parin
-
-    INTERFACE bcm_check_parameters
-       MODULE PROCEDURE bcm_check_parameters
-    END INTERFACE bcm_check_parameters
-
-    INTERFACE bcm_check_data_output
-       MODULE PROCEDURE bcm_check_data_output
-    END INTERFACE bcm_check_data_output
-
-    INTERFACE bcm_check_data_output_pr
-       MODULE PROCEDURE bcm_check_data_output_pr
-    END INTERFACE bcm_check_data_output_pr
-
-    INTERFACE bcm_init_arrays
-       MODULE PROCEDURE bcm_init_arrays
-    END INTERFACE bcm_init_arrays
-
-    INTERFACE bcm_init
-       MODULE PROCEDURE bcm_init
-    END INTERFACE bcm_init
-
-    INTERFACE bcm_header
-       MODULE PROCEDURE bcm_header
-    END INTERFACE bcm_header
-
-    INTERFACE bcm_actions
-       MODULE PROCEDURE bcm_actions
-       MODULE PROCEDURE bcm_actions_ij
-    END INTERFACE bcm_actions
-
-    INTERFACE bcm_non_advective_processes
-       MODULE PROCEDURE bcm_non_advective_processes
-       MODULE PROCEDURE bcm_non_advective_processes_ij
-    END INTERFACE bcm_non_advective_processes
-
-    INTERFACE bcm_exchange_horiz
-       MODULE PROCEDURE bcm_exchange_horiz
-    END INTERFACE bcm_exchange_horiz
-
-    INTERFACE bcm_prognostic_equations
-       MODULE PROCEDURE bcm_prognostic_equations
-       MODULE PROCEDURE bcm_prognostic_equations_ij
-    END INTERFACE bcm_prognostic_equations
-
-    INTERFACE bcm_boundary_conditions
-       MODULE PROCEDURE bcm_boundary_conditions
-    END INTERFACE bcm_boundary_conditions
-
-    INTERFACE bcm_swap_timelevel
-       MODULE PROCEDURE bcm_swap_timelevel
-    END INTERFACE bcm_swap_timelevel
-
-    INTERFACE bcm_3d_data_averaging
-       MODULE PROCEDURE bcm_3d_data_averaging
-    END INTERFACE bcm_3d_data_averaging
-
-    INTERFACE bcm_data_output_2d
-       MODULE PROCEDURE bcm_data_output_2d
-    END INTERFACE bcm_data_output_2d
-
-    INTERFACE bcm_data_output_3d
-       MODULE PROCEDURE bcm_data_output_3d
-    END INTERFACE bcm_data_output_3d
-
-    INTERFACE bcm_rrd_global
-       MODULE PROCEDURE bcm_rrd_global_ftn
-       MODULE PROCEDURE bcm_rrd_global_mpi
-    END INTERFACE bcm_rrd_global
-
-    INTERFACE bcm_rrd_local
-       MODULE PROCEDURE bcm_rrd_local_ftn
-       MODULE PROCEDURE bcm_rrd_local_mpi
-    END INTERFACE bcm_rrd_local
-
-    INTERFACE bcm_wrd_global
-       MODULE PROCEDURE bcm_wrd_global
-    END INTERFACE bcm_wrd_global
-
-    INTERFACE bcm_wrd_local
-       MODULE PROCEDURE bcm_wrd_local
-    END INTERFACE bcm_wrd_local
-
-    INTERFACE calc_liquid_water_content
-       MODULE PROCEDURE calc_liquid_water_content
-    END INTERFACE calc_liquid_water_content
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &bulk_cloud_parameters for the bulk cloud module
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bcm_parin
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100)  ::  line  !< Dummy string that contains the current line of the parameter
-                                  !< file
-
-    INTEGER(iwp)  ::  io_status   !< Status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /bulk_cloud_parameters/                                                               &
-       aerosol_bulk,                                                                               &
-       c_sedimentation,                                                                            &
-       call_microphysics_at_all_substeps,                                                          &
-       cloud_scheme,                                                                               &
-       cloud_water_sedimentation,                                                                  &
-       collision_turbulence,                                                                       &
-       curvature_solution_effects_bulk,                                                            &
-       dry_aerosol_radius,                                                                         &
-       graupel,                                                                                    &
-       ice_crystal_sedimentation,                                                                  &
-       in_init,                                                                                    &
-       limiter_sedimentation,                                                                      &
-       microphysics_ice_phase,                                                                     &
-       na_init,                                                                                    &
-       nc_const,                                                                                   &
-       sigma_bulk,                                                                                 &
-       snow,                                                                                       &
-       start_ice_microphysics,                                                                     &
-       switch_off_module,                                                                          &
-       ventilation_effect
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, bulk_cloud_parameters, IOSTAT=io_status )
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    bulk_cloud_parameters namelist was found and read correctly. Set flag that
-!--    bulk_cloud_model_mod is switched on.
-       IF ( .NOT. switch_off_module )  bulk_cloud_model = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    bulk_cloud_parameters namelist was found, but contained errors. Print an error message
-!--    containing the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'bulk_cloud_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE bcm_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for bulk cloud module
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_check_parameters
-
-
-       IMPLICIT NONE
-!
-!--    Check cloud scheme
-!--    This scheme considers only saturation adjustment, i.e. water vapor surplus is converted into
-!--    liquid water. No other microphysical processes are considered.
-       IF ( cloud_scheme == 'saturation_adjust' )  THEN
-          microphysics_sat_adjust = .TRUE.
-          microphysics_seifert    = .FALSE.
-          microphysics_kessler    = .FALSE.
-          precipitation           = .FALSE.
-          microphysics_morrison_no_rain = .FALSE.
-!
-!--    This scheme includes all process of the seifert beheng scheme (2001,2006). Especially rain
-!--    processes are considered with prognostic quantities of qr and nr.
-!--    Cloud droplet concentration is assumed to be constant and qc is diagnostic.
-!--    Technical remark: The switch 'microphysics_seifert' allocates fields of qr and nr and enables
-!--    all rain processes.
-       ELSEIF ( cloud_scheme == 'seifert_beheng' )  THEN
-          microphysics_sat_adjust = .FALSE.
-          microphysics_seifert    = .TRUE.
-          microphysics_kessler    = .FALSE.
-          microphysics_morrison  = .FALSE.
-          precipitation           = .TRUE.
-          microphysics_morrison_no_rain = .FALSE.
-!
-!--    The kessler scheme is a simplified scheme without any prognostic quantities for microphyical
-!--    variables but considering autoconversion.
-       ELSEIF ( cloud_scheme == 'kessler' )  THEN
-          microphysics_sat_adjust = .FALSE.
-          microphysics_seifert    = .FALSE.
-          microphysics_kessler    = .TRUE.
-          microphysics_morrison   = .FALSE.
-          precipitation           = .TRUE.
-          microphysics_morrison_no_rain = .FALSE.
-!
-!--    The morrison scheme is an extension of the seifer beheng scheme including also relevant
-!--    processes for cloud droplet size particles such as activation and an diagnostic mehtod for
-!--    diffusional growth.
-!--    I.e. here all processes of Seifert and Beheng as well as of the morrision scheme are used.
-!--    Therefore, ztis includes prognostic quantities for qc and nc.
-!--    Technical remark: The switch 'microphysics_morrison' allocates fields of qc and nc and
-!--    enables diagnostic diffusional growth and activation.
-       ELSEIF ( cloud_scheme == 'morrison' )  THEN
-          microphysics_sat_adjust = .FALSE.
-          microphysics_seifert    = .TRUE.
-          microphysics_kessler    = .FALSE.
-          microphysics_morrison   = .TRUE.
-          precipitation           = .TRUE.
-          microphysics_morrison_no_rain = .FALSE.
-!
-!--    The 'morrision_no_rain' scheme includes only processes of morrision scheme without the rain
-!--    processes of seifert beheng. Therfore, the prog. quantities of qr and nr remain unallocated.
-!--    This might be appropiate for cloud in which the size distribution is narrow, e.g. fog.
-       ELSEIF ( cloud_scheme == 'morrison_no_rain' )  THEN
-          microphysics_sat_adjust = .FALSE.
-          microphysics_seifert    = .FALSE.
-          microphysics_kessler    = .FALSE.
-          microphysics_morrison   = .TRUE.
-          microphysics_morrison_no_rain = .TRUE.
-          precipitation           = .FALSE.
-       ELSE
-          message_string = 'unknown cloud microphysics scheme cloud_scheme ="' //                  &
-                           TRIM( cloud_scheme ) // '"'
-          CALL message( 'check_parameters', 'PA0357', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    The use of snow and graupel are only implemented together
-       IF ( snow  .AND.  .NOT. graupel  .OR.  .NOT.  snow  .AND. graupel )  THEN
-          message_string = 'either snow and graupel must be both turned on or both switched off'
-          CALL message( 'check_parameters', 'PA0399', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Mixed phase microphysics can be steered with the cloud scheme 'seifert_beheng' or 'morrison'
-       IF ( microphysics_ice_phase  .AND.  cloud_scheme == 'saturation_adjust'  .OR.               &
-            microphysics_ice_phase  .AND.  cloud_scheme == 'kessler'            .OR.               &
-            microphysics_ice_phase  .AND.  cloud_scheme == 'morrison_no_rain' )  THEN
-          message_string = 'Mixed phase microphysics can be steered with the cloud scheme ' //     &
-                           '"seifert_beheng" and "morrison" '
-          CALL message( 'check_parameters', 'PA0399', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    Set the default value for the integration interval of precipitation amount
-       IF ( microphysics_seifert  .OR.  microphysics_kessler )  THEN
-          IF ( precipitation_amount_interval == 9999999.9_wp )  THEN
-             precipitation_amount_interval = dt_do2d_xy
-          ELSE
-             IF ( precipitation_amount_interval > dt_do2d_xy )  THEN
-                WRITE( message_string, * )  'precipitation_amount_interval = ',                    &
-                   precipitation_amount_interval, ' must not be larger than ',                     &
-                   'dt_do2d_xy = ', dt_do2d_xy
-                CALL message( 'check_parameters', 'PA0090', 1, 2, 0, 6, 0 )
-             ENDIF
-          ENDIF
-       ENDIF
-
-       ! TODO: find better solution for circular dependency problem
-       surf_bulk_cloud_model = bulk_cloud_model
-       surf_microphysics_morrison = microphysics_morrison
-       surf_microphysics_seifert = microphysics_seifert
-       surf_microphysics_ice_phase = microphysics_ice_phase
-!
-!--    Check aerosol
-       IF ( aerosol_bulk == 'nacl' )  THEN
-          aerosol_nacl   = .TRUE.
-          aerosol_c3h4o4 = .FALSE.
-          aerosol_nh4no3 = .FALSE.
-       ELSEIF ( aerosol_bulk == 'c3h4o4' )  THEN
-          aerosol_nacl   = .FALSE.
-          aerosol_c3h4o4 = .TRUE.
-          aerosol_nh4no3 = .FALSE.
-       ELSEIF ( aerosol_bulk == 'nh4no3' )  THEN
-          aerosol_nacl   = .FALSE.
-          aerosol_c3h4o4 = .FALSE.
-          aerosol_nh4no3 = .TRUE.
-       ELSE
-          message_string = 'unknown aerosol = "' // TRIM( aerosol_bulk ) // '"'
-          CALL message( 'check_parameters', 'PA0469', 1, 2, 0, 6, 0 )
-       ENDIF
-
-
-    END SUBROUTINE bcm_check_parameters
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output for bulk cloud module
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_check_data_output( var, unit )
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  unit  !<
-       CHARACTER (LEN=*) ::  var   !<
-
-       SELECT CASE ( TRIM( var ) )
-
-          CASE ( 'nc' )
-             IF ( .NOT.  microphysics_morrison )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'requires ' //            &
-                                 'cloud_scheme = "morrison"'
-                CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = '1/m3'
-
-          CASE ( 'ng' )
-             IF ( .NOT.  microphysics_ice_phase  .OR.  .NOT.  graupel )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'requires ' //            &
-                                 'microphysics_ice_phase = ".TRUE."'
-                CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = '1/m3'
-
-          CASE ( 'ni' )
-             IF ( .NOT.  microphysics_ice_phase )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'requires ' //            &
-                                 'microphysics_ice_phase = ".TRUE."'
-                CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = '1/m3'
-
-          CASE ( 'nr' )
-             IF ( .NOT.  microphysics_seifert )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'requires ' //            &
-                                 'cloud_scheme = "seifert_beheng"'
-                CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = '1/m3'
-
-          CASE ( 'ns' )
-             IF ( .NOT.  microphysics_ice_phase  .OR.  .NOT. snow )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'requires ' //            &
-                                 'microphysics_ice_phase = ".TRUE."'
-                CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = '1/m3'
-
-          CASE ( 'prr' )
-             IF ( microphysics_sat_adjust )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'is not available for ' //&
-                                 'cloud_scheme = "saturation_adjust"'
-                CALL message( 'check_parameters', 'PA0423', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'kg/kg m/s'
-
-          CASE ( 'qc' )
-             unit = 'kg/kg'
-
-          CASE ( 'qg' )
-             IF ( .NOT.  microphysics_ice_phase  .OR.  .NOT.  graupel  ) THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'requires ' //            &
-                                 'microphysics_ice_phase = ".TRUE."'
-                CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'kg/kg'
-
-          CASE ( 'qi' )
-             IF ( .NOT.  microphysics_ice_phase ) THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'requires ' //            &
-                                 'microphysics_ice_phase = ".TRUE."'
-                CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'kg/kg'
-
-          CASE ( 'qr' )
-             IF ( .NOT.  microphysics_seifert ) THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'requires ' //            &
-                                 'cloud_scheme = "seifert_beheng"'
-                CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'kg/kg'
-
-          CASE ( 'qs' )
-             IF ( .NOT.  microphysics_ice_phase  .OR.  .NOT. snow ) THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'requires ' //            &
-                                 'microphysics_ice_phase = ".TRUE."'
-                CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'kg/kg'
-
-
-          CASE ( 'pra*' )
-             IF ( .NOT. microphysics_kessler  .AND.  .NOT. microphysics_seifert )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" ' // 'requires ' //            &
-                                 'cloud_scheme = "kessler" or "seifert_beheng"'
-                CALL message( 'check_parameters', 'PA0112', 1, 2, 0, 6, 0 )
-             ENDIF
-! TODO: find sollution (maybe connected to flow_statistics redesign?)
-!             IF ( j == 1 )  THEN
-!                message_string = 'temporal averaging of precipitation ' //                        &
-!                                 'amount "' // TRIM( var ) // '" is not possible'
-!                CALL message( 'check_parameters', 'PA0113', 1, 2, 0, 6, 0 )
-!             ENDIF
-             unit = 'mm'
-
-          CASE ( 'prr*' )
-             IF ( .NOT. microphysics_kessler  .AND.  .NOT. microphysics_seifert )  THEN
-                message_string = 'output of "' // TRIM( var ) // '"' // ' requires' //             &
-                                 ' cloud_scheme = "kessler" or "seifert_beheng"'
-                CALL message( 'check_parameters', 'PA0112', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'mm/s'
-
-          CASE DEFAULT
-             unit = 'illegal'
-
-       END SELECT
-
-
-    END SUBROUTINE bcm_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output of profiles for bulk cloud module
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-       USE arrays_3d,                                                                              &
-           ONLY: zu
-
-       USE control_parameters,                                                                     &
-           ONLY: data_output_pr
-
-       USE profil_parameter,                                                                       &
-           ONLY: dopr_index
-
-       USE statistics,                                                                             &
-           ONLY: hom, statistic_regions
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  unit      !<
-       CHARACTER (LEN=*) ::  variable  !<
-       CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
-
-       INTEGER(iwp) ::  var_count      !<
-       INTEGER(iwp) ::  pr_index       !<
-
-       SELECT CASE ( TRIM( variable ) )
-
-! TODO: make index generic: pr_index = pr_palm+1
-
-          CASE ( 'nc' )
-             IF ( .NOT.  microphysics_morrison )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) //       &
-                                 ' is not implemented for' // ' cloud_scheme /= morrison'
-                CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
-             ENDIF
-             pr_index = 123
-             dopr_index(var_count) = pr_index
-             dopr_unit     = '1/m3'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'ni' )
-             IF ( .NOT.  microphysics_ice_phase )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) //       &
-                                 ' is not implemented for' // ' microphysics_ice_phase = ".F."'
-                CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
-             ENDIF
-             pr_index = 124
-             dopr_index(var_count) = pr_index
-             dopr_unit     = '1/m3'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'ng' )
-             IF ( .NOT.  microphysics_ice_phase  .OR.  .NOT.  graupel )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) //       &
-                                 ' is not implemented for' // ' microphysics_ice_phase = ".F."' // &
-                                 ' or graupel = ".F." '
-                CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
-             ENDIF
-             pr_index = 126
-             dopr_index(var_count) = pr_index
-             dopr_unit     = '1/m3'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'ns' )
-             IF ( .NOT.  microphysics_ice_phase  .OR.  .NOT.  snow )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) //       &
-                                 ' is not implemented for' // ' microphysics_ice_phase = ".F."' // &
-                                 ' or snow = ".F." '
-                CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
-             ENDIF
-             pr_index = 128
-             dopr_index(var_count) = pr_index
-             dopr_unit     = '1/m3'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'nr' )
-             IF ( .NOT.  microphysics_seifert )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) //       &
-                                 ' is not implemented for' // ' cloud_scheme /= seifert_beheng'
-                CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
-             ENDIF
-             pr_index = 73
-             dopr_index(var_count) = pr_index
-             dopr_unit     = '1/m3'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'prr' )
-             IF ( microphysics_sat_adjust )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) //       &
-                                 ' is not available for' // ' cloud_scheme = saturation_adjust'
-                CALL message( 'check_parameters', 'PA0422', 1, 2, 0, 6, 0 )
-             ENDIF
-             pr_index = 76
-             dopr_index(var_count) = pr_index
-             dopr_unit     = 'kg/kg m/s'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'qc' )
-             pr_index = 75
-             dopr_index(var_count) = pr_index
-             dopr_unit     = 'kg/kg'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'qi' )
-             IF ( .NOT.  microphysics_ice_phase )  THEN
-                message_string = 'data_output_pr = ' //  TRIM( data_output_pr(var_count) ) //      &
-                                 ' is not implemented for' // ' microphysics_ice_phase = ".F."'
-                CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
-             ENDIF
-             pr_index = 125
-             dopr_index(var_count) = pr_index
-             dopr_unit     = 'kg/kg'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'qg' )
-             IF ( .NOT.  microphysics_ice_phase  .OR.  .NOT.  graupel )  THEN
-                message_string = 'data_output_pr = ' //  TRIM( data_output_pr(var_count) ) //      &
-                                 ' is not implemented for' // ' microphysics_ice_phase = ".F."' // &
-                                 ' or graupel = ".F." '
-                CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
-             ENDIF
-             pr_index = 127
-             dopr_index(var_count) = pr_index
-             dopr_unit     = 'kg/kg'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'qs' )
-             IF ( .NOT.  microphysics_ice_phase  .OR.  .NOT.  snow )  THEN
-                message_string = 'data_output_pr = ' //  TRIM( data_output_pr(var_count) ) //      &
-                                 ' is not implemented for' // ' microphysics_ice_phase = ".F."' // &
-                                 ' or snow = ".F." '
-                CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
-             ENDIF
-             pr_index = 129
-             dopr_index(var_count) = pr_index
-             dopr_unit     = 'kg/kg'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'qr' )
-             IF ( .NOT.  microphysics_seifert )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) //       &
-                                 ' is not implemented for' // ' cloud_scheme /= seifert_beheng'
-                CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
-             ENDIF
-             pr_index = 74
-             dopr_index(var_count) = pr_index
-             dopr_unit     = 'kg/kg'
-             unit = dopr_unit
-             hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE DEFAULT
-             unit = 'illegal'
-
-       END SELECT
-
-    END SUBROUTINE bcm_check_data_output_pr
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate bulk cloud module arrays and define pointers
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_init_arrays
-
-       USE indices,                                                                                &
-           ONLY:  nxlg, nxrg, nysg, nyng, nzb, nzt
-
-
-       IMPLICIT NONE
-
-!
-!--    Liquid water content
-       ALLOCATE ( ql_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!
-!--    Frozen water content
-       ALLOCATE ( qf_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!
-!--    3D-cloud water content
-       IF ( .NOT. microphysics_morrison )  THEN
-          ALLOCATE( qc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-!
-!--    Precipitation amount and rate (only needed if output is switched)
-       ALLOCATE( precipitation_amount(nysg:nyng,nxlg:nxrg) )
-
-!
-!--    3d-precipitation rate
-       ALLOCATE( prr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-       IF ( microphysics_morrison )  THEN
-!
-!--       3D-cloud drop water content, cloud drop concentration arrays
-          ALLOCATE( nc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    nc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    nc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    qc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    qc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    qc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-
-       IF ( microphysics_seifert )  THEN
-!
-!--       3D-rain water content, rain drop concentration arrays
-          ALLOCATE( nr_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    nr_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    nr_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    qr_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    qr_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    qr_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-
-       IF ( microphysics_ice_phase )  THEN
-!
-!--       3D-ice crystal content, ice crystal concentration arrays
-          ALLOCATE( ni_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    ni_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    ni_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    qi_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    qi_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                           &
-                    qi_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-          IF ( snow )  THEN
-!
-!--          3D-snow content, snow concentration arrays
-             ALLOCATE( ns_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                       ns_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                       ns_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                       qs_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                       qs_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                       qs_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-          ENDIF
-
-          IF ( graupel )  THEN
-!
-!--          3D-graupel content, graupel concentration arrays
-             ALLOCATE( ng_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                       ng_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                       ng_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                       qg_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                       qg_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                       qg_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-          ENDIF
-
-       ENDIF
-
-       IF ( ws_scheme_sca )  THEN
-          IF ( microphysics_morrison )  THEN
-             ALLOCATE( sums_wsqcs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-             ALLOCATE( sums_wsncs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-             sums_wsqcs_ws_l = 0.0_wp
-             sums_wsncs_ws_l = 0.0_wp
-          ENDIF
-          IF ( 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 ( microphysics_ice_phase )  THEN
-             ALLOCATE( sums_wsqis_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-             ALLOCATE( sums_wsnis_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-             sums_wsqis_ws_l = 0.0_wp
-             sums_wsnis_ws_l = 0.0_wp
-             IF ( snow )  THEN
-                ALLOCATE( sums_wsqss_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-                ALLOCATE( sums_wsnss_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-                sums_wsqss_ws_l = 0.0_wp
-                sums_wsnss_ws_l = 0.0_wp
-             ENDIF
-             IF ( graupel )  THEN
-                ALLOCATE( sums_wsqgs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-                ALLOCATE( sums_wsngs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-                sums_wsqgs_ws_l = 0.0_wp
-                sums_wsngs_ws_l = 0.0_wp
-             ENDIF
-          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_sca )  THEN
-             IF ( microphysics_morrison )  THEN
-                ALLOCATE( flux_s_qc(nzb+1:nzt,0:threads_per_task-1),                               &
-                          diss_s_qc(nzb+1:nzt,0:threads_per_task-1),                               &
-                          flux_s_nc(nzb+1:nzt,0:threads_per_task-1),                               &
-                          diss_s_nc(nzb+1:nzt,0:threads_per_task-1) )
-                ALLOCATE( flux_l_qc(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                       &
-                          diss_l_qc(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                       &
-                          flux_l_nc(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                       &
-                          diss_l_nc(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-             ENDIF
-             IF ( 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 ( microphysics_ice_phase )  THEN
-                ALLOCATE( flux_s_qi(nzb+1:nzt,0:threads_per_task-1),                               &
-                          diss_s_qi(nzb+1:nzt,0:threads_per_task-1),                               &
-                          flux_s_ni(nzb+1:nzt,0:threads_per_task-1),                               &
-                          diss_s_ni(nzb+1:nzt,0:threads_per_task-1) )
-                ALLOCATE( flux_l_qi(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                       &
-                          diss_l_qi(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                       &
-                          flux_l_ni(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                       &
-                          diss_l_ni(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-                IF ( snow )  THEN
-                   ALLOCATE( flux_s_qs(nzb+1:nzt,0:threads_per_task-1),                            &
-                             diss_s_qs(nzb+1:nzt,0:threads_per_task-1),                            &
-                             flux_s_ns(nzb+1:nzt,0:threads_per_task-1),                            &
-                             diss_s_ns(nzb+1:nzt,0:threads_per_task-1) )
-                   ALLOCATE( flux_l_qs(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                    &
-                             diss_l_qs(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                    &
-                             flux_l_ns(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                    &
-                             diss_l_ns(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-                ENDIF
-                IF ( graupel ) THEN
-                   ALLOCATE( flux_s_qg(nzb+1:nzt,0:threads_per_task-1),                            &
-                             diss_s_qg(nzb+1:nzt,0:threads_per_task-1),                            &
-                             flux_s_ng(nzb+1:nzt,0:threads_per_task-1),                            &
-                             diss_s_ng(nzb+1:nzt,0:threads_per_task-1) )
-                   ALLOCATE( flux_l_qg(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                    &
-                             diss_l_qg(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                    &
-                             flux_l_ng(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                    &
-                             diss_l_ng(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-                ENDIF
-             ENDIF
-          ENDIF
-       ENDIF
-
-!
-!--   Allocate arrays needed for riming process
-      ALLOCATE( dep_rate_ice(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                       &
-                dep_rate_snow(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                      &
-                rime_ice_cloud(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                     &
-                rime_ice_rain(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                      &
-                rime_snow_cloud(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                    &
-                rime_snow_rain(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!
-!--    Initial assignment of the pointers
-       ql => ql_1
-       qf => qf_1
-       IF ( .NOT. microphysics_morrison )  THEN
-          qc => qc_1
-       ENDIF
-       IF ( microphysics_morrison )  THEN
-          qc => qc_1;  qc_p  => qc_2;  tqc_m  => qc_3
-          nc => nc_1;  nc_p  => nc_2;  tnc_m  => nc_3
-       ENDIF
-       IF ( microphysics_seifert )  THEN
-          qr => qr_1;  qr_p  => qr_2;  tqr_m  => qr_3
-          nr => nr_1;  nr_p  => nr_2;  tnr_m  => nr_3
-       ENDIF
-       IF ( microphysics_ice_phase )  THEN
-          qi => qi_1;  qi_p  => qi_2;  tqi_m  => qi_3
-          ni => ni_1;  ni_p  => ni_2;  tni_m  => ni_3
-          IF ( snow )  THEN
-             qs => qs_1;  qs_p  => qs_2;  tqs_m  => qs_3
-             ns => ns_1;  ns_p  => ns_2;  tns_m  => ns_3
-          ENDIF
-          IF ( graupel )  THEN
-             qg => qg_1;  qg_p  => qg_2;  tqg_m  => qg_3
-             ng => ng_1;  ng_p  => ng_2;  tng_m  => ng_3
-          ENDIF
-       ENDIF
-
-    END SUBROUTINE bcm_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the bulk cloud module
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_init
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-
-       IF ( debug_output )  CALL debug_message( 'bcm_init', 'start' )
-
-       IF ( bulk_cloud_model )  THEN
-          IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-!
-!--          Initialize the remaining quantities
-             IF ( microphysics_morrison )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      qc(:,j,i) = 0.0_wp
-                      nc(:,j,i) = 0.0_wp
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( microphysics_seifert )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      qr(:,j,i) = 0.0_wp
-                      nr(:,j,i) = 0.0_wp
-                   ENDDO
-                ENDDO
-             ENDIF
-!
-!--          Initialize the remaining quantities
-             IF ( microphysics_ice_phase )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      qi(:,j,i) = 0.0_wp
-                      ni(:,j,i) = 0.0_wp
-                   ENDDO
-                ENDDO
-                IF ( snow )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         qs(:,j,i) = 0.0_wp
-                         ns(:,j,i) = 0.0_wp
-                      ENDDO
-                   ENDDO
-                ENDIF
-                IF ( graupel ) THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         qg(:,j,i) = 0.0_wp
-                         ng(:,j,i) = 0.0_wp
-                      ENDDO
-                   ENDDO
-                ENDIF
-             ENDIF
-!
-!--          Liquid water content and precipitation amount are zero at beginning of the simulation.
-             ql = 0.0_wp
-             qf = 0.0_wp
-             qc = 0.0_wp
-             precipitation_amount = 0.0_wp
-             prr = 0.0_wp
-!
-!--          Initialize old and new time levels.
-             IF ( microphysics_morrison )  THEN
-                tqc_m = 0.0_wp
-                tnc_m = 0.0_wp
-                qc_p  = qc
-                nc_p  = nc
-             ENDIF
-             IF ( microphysics_seifert )  THEN
-                tqr_m = 0.0_wp
-                tnr_m = 0.0_wp
-                qr_p  = qr
-                nr_p  = nr
-             ENDIF
-             IF ( microphysics_ice_phase )  THEN
-                tqi_m = 0.0_wp
-                tni_m = 0.0_wp
-                qi_p  = qi
-                ni_p  = ni
-                IF ( snow )  THEN
-                   tqs_m = 0.0_wp
-                   tns_m = 0.0_wp
-                   qs_p  = qs
-                   ns_p  = ns
-                ENDIF
-                IF ( graupel ) THEN
-                   tqg_m = 0.0_wp
-                   tng_m = 0.0_wp
-                   qg_p  = qg
-                   ng_p  = ng
-                ENDIF
-             ENDIF
-          ENDIF ! Only if not read_restart_data
-!
-!--       Constant for the sedimentation of cloud water (2-moment cloud physics)
-          sed_qc_const = k_st * ( 3.0_wp / ( 4.0_wp * pi * rho_l ) )**( 2.0_wp / 3.0_wp ) *        &
-                         EXP( 5.0_wp * LOG( sigma_gc )**2 )
-
-!
-!--       Calculate timestep according to precipitation
-          IF ( microphysics_seifert )  THEN
-             dt_precipitation = c_sedimentation * MINVAL( dzu(nzb+2:nzt) ) / w_precipitation
-          ENDIF
-
-!
-!--       Set constants for certain aerosol type
-          IF ( microphysics_morrison )  THEN
-             IF ( aerosol_nacl ) THEN
-                molecular_weight_of_solute = 0.05844_wp
-                rho_s                      = 2165.0_wp
-                vanthoff                   = 2.0_wp
-             ELSEIF ( aerosol_c3h4o4 ) THEN
-                molecular_weight_of_solute = 0.10406_wp
-                rho_s                      = 1600.0_wp
-                vanthoff                   = 1.37_wp
-             ELSEIF ( aerosol_nh4no3 ) THEN
-                molecular_weight_of_solute = 0.08004_wp
-                rho_s                      = 1720.0_wp
-                vanthoff                   = 2.31_wp
-             ENDIF
-          ENDIF
-!
-!--       Pre-calculate frequently calculated fractions of pi and rho_l
-          pirho_l  = pi * rho_l / 6.0_wp
-          dpirho_l = 1.0_wp / pirho_l
-!
-!--       Calculate collision integrals: First, define the coefficients of the species (Here values of
-!--       SB2006, Table 1 are used). Second, calculate the collision integrals as described in SB2006
-!--       (Eq. 90-93, see their Appendix C).
-          CALL define_cloud_coefficients
-          CALL init_collision_integrals
-          CALL init_coefficients
-
-          IF ( debug_output )  CALL debug_message( 'bcm_init', 'end' )
-
-       ELSE
-
-          IF ( debug_output )  CALL debug_message( 'bcm_init skipped', 'end' )
-
-       ENDIF
-
-    END SUBROUTINE bcm_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for bulk cloud module
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_header ( io )
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp), INTENT(IN) ::  io  !< Unit of the output file
-
-!
-!--    Write bulk cloud module header
-       WRITE ( io, 1 )
-
-       WRITE ( io, 2 )
-       WRITE ( io, 3 )
-
-       IF ( microphysics_kessler )  THEN
-          WRITE ( io, 4 ) 'Kessler-Scheme'
-       ENDIF
-
-       IF ( microphysics_seifert )  THEN
-          WRITE ( io, 4 ) 'Seifert-Beheng-Scheme'
-          IF ( cloud_water_sedimentation )  WRITE ( io, 5 )
-          IF ( collision_turbulence )  WRITE ( io, 6 )
-          IF ( ventilation_effect )  WRITE ( io, 7 )
-          IF ( limiter_sedimentation )  WRITE ( io, 8 )
-       ENDIF
-
-       WRITE ( io, 20 )
-       WRITE ( io, 21 ) surface_pressure
-       WRITE ( io, 22 ) r_d
-       WRITE ( io, 23 ) rho_surface
-       WRITE ( io, 24 ) c_p
-       WRITE ( io, 25 ) l_v
-
-       IF ( microphysics_seifert )  THEN
-          WRITE ( io, 26 ) 1.0E-6_wp * nc_const
-          WRITE ( io, 27 ) c_sedimentation
-       ENDIF
-
-
-1   FORMAT ( //' Bulk cloud module information:'/ ' ------------------------------------------'/ )
-2   FORMAT ( '--> Bulk scheme with liquid water potential temperature and'/                        &
-             '    total water content is used.' )
-3   FORMAT ( '--> Condensation is parameterized via 0% - or 100% scheme.' )
-4   FORMAT ( '--> Precipitation parameterization via ', A )
-
-5   FORMAT ( '--> Cloud water sedimentation parameterization via Stokes law' )
-6   FORMAT ( '--> Turbulence effects on precipitation process' )
-7   FORMAT ( '--> Ventilation effects on evaporation of rain drops' )
-8   FORMAT ( '--> Slope limiter used for sedimentation process' )
-
-20  FORMAT ( '--> Essential parameters:' )
-21  FORMAT ( '       Surface pressure             :   p_0   = ', F7.2, ' hPa')
-22  FORMAT ( '       Gas constant                 :   R     = ', F5.1, ' J/(kg K)')
-23  FORMAT ( '       Density of air               :   rho_0 = ', F6.3, ' kg/m**3')
-24  FORMAT ( '       Specific heat cap.           :   c_p   = ', F6.1, ' J/(kg K)')
-25  FORMAT ( '       Vapourization heat           :   L_v   = ', E9.2, ' J/kg')
-26  FORMAT ( '       Droplet density              :   N_c   = ', F6.1, ' 1/cm**3' )
-27  FORMAT ( '       Sedimentation Courant number :   C_s   = ', F4.1 )
-
-
-    END SUBROUTINE bcm_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Control of microphysics for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_actions( location )
-
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-    SELECT CASE ( location )
-
-       CASE ( 'before_timestep' )
-
-          IF ( ws_scheme_sca )  THEN
-
-             IF ( microphysics_morrison )  THEN
-                sums_wsqcs_ws_l = 0.0_wp
-                sums_wsncs_ws_l = 0.0_wp
-             ENDIF
-             IF ( microphysics_seifert )  THEN
-                sums_wsqrs_ws_l = 0.0_wp
-                sums_wsnrs_ws_l = 0.0_wp
-             ENDIF
-             IF ( microphysics_ice_phase )  THEN
-                sums_wsqis_ws_l = 0.0_wp
-                sums_wsnis_ws_l = 0.0_wp
-                IF ( snow )  THEN
-                   sums_wsqss_ws_l = 0.0_wp
-                   sums_wsnss_ws_l = 0.0_wp
-                ENDIF
-                IF ( graupel )  THEN
-                   sums_wsqgs_ws_l = 0.0_wp
-                   sums_wsngs_ws_l = 0.0_wp
-                ENDIF
-             ENDIF
-
-          ENDIF
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
-    END SUBROUTINE bcm_actions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Control of microphysics for grid points i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_actions_ij( i, j, location )
-
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location  !< call location string
-
-    INTEGER(iwp)  ::  dummy                !< call location string
-
-    INTEGER(iwp), INTENT(IN) ::  i         !< grid index in x-direction
-    INTEGER(iwp), INTENT(IN) ::  j         !< grid index in y-direction
-
-
-    IF ( bulk_cloud_model )   dummy = i + j
-
-    SELECT CASE ( location )
-
-       CASE ( 'before_timestep' )
-
-          IF ( ws_scheme_sca )  THEN
-             IF ( microphysics_morrison )  THEN
-                sums_wsqcs_ws_l = 0.0_wp
-                sums_wsncs_ws_l = 0.0_wp
-             ENDIF
-             IF ( microphysics_seifert )  THEN
-                sums_wsqrs_ws_l = 0.0_wp
-                sums_wsnrs_ws_l = 0.0_wp
-             ENDIF
-             IF ( microphysics_ice_phase )  THEN
-                sums_wsqis_ws_l = 0.0_wp
-                sums_wsnis_ws_l = 0.0_wp
-                IF ( snow )  THEN
-                   sums_wsqss_ws_l = 0.0_wp
-                   sums_wsnss_ws_l = 0.0_wp
-                ENDIF
-                IF ( graupel )  THEN
-                   sums_wsqgs_ws_l = 0.0_wp
-                   sums_wsngs_ws_l = 0.0_wp
-                ENDIF
-             ENDIF
-          ENDIF
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
-
-    END SUBROUTINE bcm_actions_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Control of microphysics for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_non_advective_processes
-
-
-       CALL cpu_log( log_point(51), 'microphysics', 'start' )
-
-       IF ( .NOT. microphysics_sat_adjust  .AND.  ( intermediate_timestep_count == 1  .OR.         &
-            call_microphysics_at_all_substeps ) )                                                  &
-       THEN
-
-          IF ( large_scale_forcing  .AND.  lsf_surf ) THEN
-!
-!--          Calculate vertical profile of the hydrostatic pressure (hyp)
-             hyp    = barometric_formula(zu, pt_surface *                                          &
-                      exner_function(surface_pressure * 100.0_wp), surface_pressure * 100.0_wp)
-             d_exner = exner_function_invers(hyp)
-             exner = 1.0_wp / exner_function_invers(hyp)
-             hyrho  = ideal_gas_law_rho_pt(hyp, pt_init)
-!
-!--          Compute reference density
-             rho_surface = ideal_gas_law_rho(surface_pressure * 100.0_wp,                          &
-                           pt_surface * exner_function(surface_pressure * 100.0_wp))
-          ENDIF
-
-!
-!--       Compute length of time step
-          IF ( call_microphysics_at_all_substeps )  THEN
-             dt_micro = dt_3d * weight_pres(intermediate_timestep_count)
-          ELSE
-             dt_micro = dt_3d
-          ENDIF
-!
-!--       Reset precipitation rate
-          IF ( intermediate_timestep_count == 1 )  prr = 0.0_wp
-!
-!--       Compute cloud physics.
-!--       Here the the simple kessler scheme is used.
-          IF ( microphysics_kessler )  THEN
-             CALL autoconversion_kessler
-             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud
-!
-!--       Here the seifert beheng scheme is used. Cloud concentration is assumed to a constant value
-!--       an qc a diagnostic value.
-          ELSEIF ( microphysics_seifert  .AND.  .NOT. microphysics_morrison )  THEN
-             CALL adjust_cloud
-             IF ( microphysics_ice_phase  .AND.  simulated_time > start_ice_microphysics )  THEN
-                 CALL adjust_ice
-                 CALL nucleation_ice
-                 CALL homogeneous_freezing_cloud
-                 CALL deposition_ice
-                 IF ( snow  .AND.  graupel ) THEN
-                    CALL deposition_snow
-                    CALL deposition_graupel
-                    CALL selfcollection_ice
-                    CALL selfcollection_snow
-                    CALL selfcollection_graupel
-                    CALL collection_graupel_ice
-                    CALL collection_snow_ice
-                    CALL collection_graupel_snow
-                    CALL riming_graupel_cloud
-                    CALL riming_graupel_rain
-                    CALL riming_ice_cloud
-                    CALL riming_ice_rain
-                    CALL riming_snow_cloud
-                    CALL riming_snow_rain
-                    CALL heterogeneous_freezing_rain
-                    CALL melting_ice
-                    CALL melting_snow
-                    CALL melting_graupel
-                    CALL evaporation_graupel
-                    CALL evaporation_snow
-                 ENDIF
-             ENDIF
-             CALL autoconversion
-             CALL accretion
-             CALL selfcollection_breakup_rain
-             CALL evaporation_rain
-             CALL sedimentation_rain
-             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud
-             IF ( microphysics_ice_phase  .AND.  simulated_time > start_ice_microphysics )  THEN
-                 IF ( ice_crystal_sedimentation )             CALL sedimentation_ice
-                 IF ( snow_sedimentation  .AND.  snow )       CALL sedimentation_snow
-                 IF ( graupel_sedimentation  .AND.  graupel ) CALL sedimentation_graupel
-             ENDIF
-!
-!--       Here the morrison scheme is used. No rain processes are considered and qr and nr are not
-!--       allocated.
-          ELSEIF ( microphysics_morrison_no_rain  .AND.  .NOT. microphysics_seifert )  THEN
-             CALL activation_cloud
-             CALL condensation_cloud
-             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud
-!
-!--       Here the full morrison scheme is used and all processes of Seifert and Beheng are included
-          ELSEIF ( microphysics_morrison  .AND.  microphysics_seifert )  THEN
-             CALL adjust_cloud
-             CALL activation_cloud
-             CALL condensation_cloud
-             IF ( microphysics_ice_phase  .AND.  simulated_time > start_ice_microphysics )  THEN
-                 CALL adjust_ice
-                 CALL nucleation_ice
-                 CALL homogeneous_freezing_cloud
-                 CALL deposition_ice
-                 IF ( snow  .AND.  graupel ) THEN
-                    CALL deposition_snow
-                    CALL deposition_graupel
-                    CALL selfcollection_ice
-                    CALL selfcollection_snow
-                    CALL selfcollection_graupel
-                    CALL collection_graupel_ice
-                    CALL collection_snow_ice
-                    CALL collection_graupel_snow
-                    CALL riming_graupel_cloud
-                    CALL riming_graupel_rain
-                    CALL riming_ice_cloud
-                    CALL riming_ice_rain
-                    CALL riming_snow_cloud
-                    CALL riming_snow_rain
-                    CALL heterogeneous_freezing_rain
-                    CALL melting_ice
-                    CALL melting_snow
-                    CALL melting_graupel
-                    CALL evaporation_graupel
-                    CALL evaporation_snow
-                 ENDIF
-             ENDIF
-             CALL autoconversion
-             CALL accretion
-             CALL selfcollection_breakup_rain
-             CALL evaporation_rain
-             CALL sedimentation_rain
-             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud
-             IF ( microphysics_ice_phase  .AND.  simulated_time > start_ice_microphysics )  THEN
-                 IF ( ice_crystal_sedimentation )             CALL sedimentation_ice
-                 IF ( snow_sedimentation  .AND.  snow )       CALL sedimentation_snow
-                 IF ( graupel_sedimentation  .AND.  graupel ) CALL sedimentation_graupel
-             ENDIF
-
-          ENDIF
-
-          CALL calc_precipitation_amount
-
-       ENDIF
-
-       CALL cpu_log( log_point(51), 'microphysics', 'stop' )
-
-    END SUBROUTINE bcm_non_advective_processes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Control of microphysics for grid points i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_non_advective_processes_ij( i, j )
-
-
-       INTEGER(iwp) ::  i                 !<
-       INTEGER(iwp) ::  j                 !<
-
-       IF ( .NOT. microphysics_sat_adjust  .AND.  ( intermediate_timestep_count == 1  .OR.         &
-            call_microphysics_at_all_substeps ) )                                                  &
-       THEN
-
-          IF ( large_scale_forcing  .AND.  lsf_surf ) THEN
-!
-!--          Calculate vertical profile of the hydrostatic pressure (hyp)
-             hyp    = barometric_formula(zu, pt_surface *                                          &
-                      exner_function(surface_pressure * 100.0_wp), surface_pressure * 100.0_wp)
-             d_exner = exner_function_invers(hyp)
-             exner = 1.0_wp / exner_function_invers(hyp)
-             hyrho  = ideal_gas_law_rho_pt(hyp, pt_init)
-!
-!--          Compute reference density
-             rho_surface = ideal_gas_law_rho(surface_pressure * 100.0_wp,                          &
-                           pt_surface * exner_function(surface_pressure * 100.0_wp))
-          ENDIF
-
-!
-!--       Compute length of time step
-          IF ( call_microphysics_at_all_substeps )  THEN
-             dt_micro = dt_3d * weight_pres(intermediate_timestep_count)
-          ELSE
-             dt_micro = dt_3d
-          ENDIF
-!
-!--       Reset precipitation rate
-          IF ( intermediate_timestep_count == 1 )  prr(:,j,i) = 0.0_wp
-!
-!--       Compute cloud physics
-!--       Here the the simple kessler scheme is used.
-          IF( microphysics_kessler )  THEN
-             CALL autoconversion_kessler_ij( i, j )
-             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud_ij( i, j )
-!
-!--       Here the seifert beheng scheme is used. Cloud concentration is assumed to a constant value
-!--       an qc a diagnostic value.
-          ELSEIF ( microphysics_seifert  .AND.  .NOT. microphysics_morrison )  THEN
-             CALL adjust_cloud_ij( i, j )
-             IF ( microphysics_ice_phase  .AND.  simulated_time > start_ice_microphysics )  THEN
-                 CALL adjust_ice_ij( i, j )
-                 CALL nucleation_ice_ij( i, j )
-                 CALL homogeneous_freezing_cloud_ij( i, j )
-                 CALL deposition_ice_ij( i, j )
-                 IF ( snow  .AND.  graupel )  THEN
-                    CALL deposition_snow_ij( i, j )
-                    CALL deposition_graupel_ij( i, j )
-                    CALL selfcollection_ice_ij( i, j )
-                    CALL selfcollection_snow_ij( i, j )
-                    CALL selfcollection_graupel_ij( i, j )
-                    CALL collection_graupel_ice_ij( i, j )
-                    CALL collection_snow_ice_ij( i, j )
-                    CALL collection_graupel_snow_ij( i, j )
-                    CALL riming_graupel_cloud_ij( i, j )
-                    CALL riming_graupel_rain_ij( i, j )
-                    CALL riming_ice_cloud_ij( i, j )
-                    CALL riming_ice_rain_ij( i, j )
-                    CALL riming_snow_cloud_ij( i, j )
-                    CALL riming_snow_rain_ij( i, j )
-                    CALL heterogeneous_freezing_rain_ij( i, j )
-                    CALL melting_ice_ij( i, j )
-                    CALL melting_snow_ij( i, j )
-                    CALL melting_graupel_ij( i, j )
-                    CALL evaporation_graupel_ij( i, j )
-                    CALL evaporation_snow_ij( i, j )
-                 ENDIF
-             ENDIF
-             CALL autoconversion_ij( i, j )
-             CALL accretion_ij( i, j )
-             CALL selfcollection_breakup_rain_ij( i, j )
-             CALL evaporation_rain_ij( i, j )
-             CALL sedimentation_rain_ij( i, j )
-             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud_ij( i ,j )
-             IF ( microphysics_ice_phase  .AND.  simulated_time > start_ice_microphysics )  THEN
-                 IF ( ice_crystal_sedimentation )             CALL sedimentation_ice_ij( i, j )
-                 IF ( snow_sedimentation  .AND.  snow )       CALL sedimentation_snow_ij( i, j )
-                 IF ( graupel_sedimentation .AND.  graupel )  CALL sedimentation_graupel_ij( i, j )
-             ENDIF
-!
-!--       Here the morrison scheme is used. No rain processes are considered and qr and nr are not
-!--       allocated.
-          ELSEIF ( microphysics_morrison_no_rain  .AND.  .NOT. microphysics_seifert )  THEN
-             CALL activation_cloud_ij( i, j )
-             CALL condensation_cloud_ij( i, j )
-             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud_ij( i, j )
-!
-!--       Here the full morrison scheme is used and all processes of Seifert and Beheng are included
-          ELSEIF ( microphysics_morrison  .AND.  microphysics_seifert )  THEN
-             CALL adjust_cloud_ij( i, j )
-             CALL activation_cloud_ij( i, j )
-             CALL condensation_cloud_ij( i, j )
-             IF ( microphysics_ice_phase  .AND.  simulated_time > start_ice_microphysics )  THEN
-                 CALL adjust_ice_ij( i, j )
-                 CALL nucleation_ice_ij( i, j )
-                 CALL homogeneous_freezing_cloud_ij( i, j )
-                 CALL deposition_ice_ij( i, j )
-                 IF ( snow  .AND.  graupel )  THEN
-                    CALL deposition_snow_ij( i, j )
-                    CALL deposition_graupel_ij( i, j )
-                    CALL selfcollection_ice_ij( i, j )
-                    CALL selfcollection_snow_ij( i, j )
-                    CALL selfcollection_graupel_ij( i, j )
-                    CALL collection_graupel_ice_ij( i, j )
-                    CALL collection_snow_ice_ij( i, j )
-                    CALL collection_graupel_snow_ij( i, j )
-                    CALL riming_graupel_cloud_ij( i, j )
-                    CALL riming_graupel_rain_ij( i, j )
-                    CALL riming_ice_cloud_ij( i, j )
-                    CALL riming_ice_rain_ij( i, j )
-                    CALL riming_snow_cloud_ij( i, j )
-                    CALL riming_snow_rain_ij( i, j )
-                    CALL heterogeneous_freezing_rain_ij( i, j )
-                    CALL melting_ice_ij( i, j )
-                    CALL melting_snow_ij( i, j )
-                    CALL melting_graupel_ij( i, j )
-                    CALL evaporation_graupel_ij( i, j )
-                    CALL evaporation_snow_ij( i, j )
-                 ENDIF
-             ENDIF
-             CALL autoconversion_ij( i, j )
-             CALL accretion_ij( i, j )
-             CALL selfcollection_breakup_rain_ij( i, j )
-             CALL evaporation_rain_ij( i, j )
-             CALL sedimentation_rain_ij( i, j )
-             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud_ij( i, j )
-             IF ( microphysics_ice_phase  .AND.  simulated_time > start_ice_microphysics )  THEN
-                 IF ( ice_crystal_sedimentation )              CALL sedimentation_ice_ij( i, j )
-                 IF ( snow_sedimentation  .AND.  snow )        CALL sedimentation_snow_ij( i, j )
-                 IF ( graupel_sedimentation  .AND.  graupel )  CALL sedimentation_graupel_ij( i, j )
-             ENDIF
-
-          ENDIF
-
-          CALL calc_precipitation_amount_ij( i, j )
-
-       ENDIF
-
-    END SUBROUTINE bcm_non_advective_processes_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exchange ghostpoints
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_exchange_horiz( location )
-
-       USE exchange_horiz_mod,                                                                     &
-           ONLY:  exchange_horiz
-
-       CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-       SELECT CASE ( location )
-
-          CASE ( 'before_prognostic_equation' )
-
-             IF ( .NOT. microphysics_sat_adjust  .AND.  ( intermediate_timestep_count == 1  .OR.   &
-                  call_microphysics_at_all_substeps ) )                                            &
-             THEN
-                IF ( microphysics_morrison )  THEN
-                   CALL exchange_horiz( nc, nbgp )
-                   CALL exchange_horiz( qc, nbgp )
-                ENDIF
-                IF ( microphysics_seifert ) THEN
-                   CALL exchange_horiz( qr, nbgp )
-                   CALL exchange_horiz( nr, nbgp )
-                ENDIF
-                IF ( microphysics_ice_phase ) THEN
-                   CALL exchange_horiz( qi, nbgp )
-                   CALL exchange_horiz( ni, nbgp )
-                   IF ( snow )  THEN
-                      CALL exchange_horiz( qs, nbgp )
-                      CALL exchange_horiz( ns, nbgp )
-                   ENDIF
-                   IF ( graupel )  THEN
-                      CALL exchange_horiz( qg, nbgp )
-                      CALL exchange_horiz( ng, nbgp )
-                   ENDIF
-                ENDIF
-                CALL exchange_horiz( q, nbgp )
-                CALL exchange_horiz( pt, nbgp )
-             ENDIF
-
-          CASE ( 'after_prognostic_equation' )
-
-             IF ( microphysics_morrison )  THEN
-                CALL exchange_horiz( qc_p, nbgp )
-                CALL exchange_horiz( nc_p, nbgp )
-             ENDIF
-             IF ( microphysics_seifert )  THEN
-                CALL exchange_horiz( qr_p, nbgp )
-                CALL exchange_horiz( nr_p, nbgp )
-             ENDIF
-             IF ( microphysics_ice_phase )  THEN
-                CALL exchange_horiz( qi_p, nbgp )
-                CALL exchange_horiz( ni_p, nbgp )
-                IF ( snow )  THEN
-                   CALL exchange_horiz( qs_p, nbgp )
-                   CALL exchange_horiz( ns_p, nbgp )
-                ENDIF
-                IF ( graupel )  THEN
-                   CALL exchange_horiz( qg_p, nbgp )
-                   CALL exchange_horiz( ng_p, nbgp )
-                ENDIF
-             ENDIF
-
-          CASE ( 'after_anterpolation' )
-
-             IF ( microphysics_morrison )  THEN
-                CALL exchange_horiz( qc, nbgp )
-                CALL exchange_horiz( nc, nbgp )
-             ENDIF
-             IF ( microphysics_seifert )  THEN
-                CALL exchange_horiz( qr, nbgp )
-                CALL exchange_horiz( nr, nbgp )
-             ENDIF
-             IF ( microphysics_ice_phase )  THEN
-                CALL exchange_horiz( qi, nbgp )
-                CALL exchange_horiz( ni, nbgp )
-                IF ( snow )  THEN
-                   CALL exchange_horiz( qs_p, nbgp )
-                   CALL exchange_horiz( ns_p, nbgp )
-                ENDIF
-                IF ( graupel )  THEN
-                   CALL exchange_horiz( qg_p, nbgp )
-                   CALL exchange_horiz( ng_p, nbgp )
-                ENDIF
-             ENDIF
-
-       END SELECT
-
-    END SUBROUTINE bcm_exchange_horiz
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Control of microphysics for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_prognostic_equations
-
-
-       INTEGER(iwp) ::  i         !< grid index in x-direction
-       INTEGER(iwp) ::  j         !< grid index in y-direction
-       INTEGER(iwp) ::  k         !< grid index in z-direction
-
-       REAL(wp)     ::  sbt  !<
-
-       CALL cpu_log( log_point(67), 'all_bmc-prog_equation', 'start' )
-!
-!--    If required, calculate prognostic equations for cloud water content and cloud drop
-!--    concentration.
-       IF ( microphysics_morrison )  THEN
-!
-!--       Calculate prognostic equation for cloud 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( qc, 'qc' )
-
-          ENDIF
-!
-!--       qc-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( advc_flags_s, qc, 'qc',                                        &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( qc )
-                ENDIF
-             ELSE
-                CALL advec_s_up( qc )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( qc,                                                                    &
-                            surf_def_h(0)%qcsws, surf_def_h(1)%qcsws,                              &
-                            surf_def_h(2)%qcsws,                                                   &
-                            surf_lsm_h(0)%qcsws, surf_lsm_h(1)%qcsws,                              &
-                            surf_usm_h(0)%qcsws, surf_usm_h(1)%qcsws,                              &
-                            surf_def_v(0)%qcsws, surf_def_v(1)%qcsws,                              &
-                            surf_def_v(2)%qcsws, surf_def_v(3)%qcsws,                              &
-                            surf_lsm_v(0)%qcsws, surf_lsm_v(1)%qcsws,                              &
-                            surf_lsm_v(2)%qcsws, surf_lsm_v(3)%qcsws,                              &
-                            surf_usm_v(0)%qcsws, surf_usm_v(1)%qcsws,                              &
-                            surf_usm_v(2)%qcsws, surf_usm_v(3)%qcsws )
-
-!
-!--       Prognostic equation for cloud water content
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                !following directive is required to vectorize on Intel19
-                !DIR$ IVDEP
-                DO  k = nzb+1, nzt
-                   qc_p(k,j,i) = qc(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +                       &
-                                                      tsc(3) * tqc_m(k,j,i) )                      &
-                                                    - tsc(5) * rdf_sc(k) *                         &
-                                                               qc(k,j,i)                           &
-                                             )                                                     &
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )   &
-                                         )
-                   IF ( qc_p(k,j,i) < 0.0_wp )  qc_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+1, nzt
-                         tqc_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+1, nzt
-                         tqc_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tqc_m(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-!
-!--       Calculate prognostic equation for cloud 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( nc, 'nc' )
-
-          ENDIF
-
-!
-!--       nc-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( advc_flags_s, nc, 'nc',                                        &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( nc )
-                ENDIF
-             ELSE
-                CALL advec_s_up( nc )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( nc,                                                                    &
-                            surf_def_h(0)%ncsws, surf_def_h(1)%ncsws,                              &
-                            surf_def_h(2)%ncsws,                                                   &
-                            surf_lsm_h(0)%ncsws, surf_lsm_h(1)%ncsws,                              &
-                            surf_usm_h(0)%ncsws, surf_usm_h(1)%ncsws,                              &
-                            surf_def_v(0)%ncsws, surf_def_v(1)%ncsws,                              &
-                            surf_def_v(2)%ncsws, surf_def_v(3)%ncsws,                              &
-                            surf_lsm_v(0)%ncsws, surf_lsm_v(1)%ncsws,                              &
-                            surf_lsm_v(2)%ncsws, surf_lsm_v(3)%ncsws,                              &
-                            surf_usm_v(0)%ncsws, surf_usm_v(1)%ncsws,                              &
-                            surf_usm_v(2)%ncsws, surf_usm_v(3)%ncsws )
-
-!
-!--       Prognostic equation for cloud drop concentration
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                !following directive is required to vectorize on Intel19
-                !DIR$ IVDEP
-                DO  k = nzb+1, nzt
-                   nc_p(k,j,i) = nc(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +                       &
-                                                      tsc(3) * tnc_m(k,j,i) )                      &
-                                                    - tsc(5) * rdf_sc(k) *                         &
-                                                               nc(k,j,i)                           &
-                                             )                                                     &
-                                   * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )  &
-                                          )
-                   IF ( nc_p(k,j,i) < 0.0_wp )  nc_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+1, nzt
-                         tnc_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+1, nzt
-                         tnc_m(k,j,i) =  -9.5625_wp * tend(k,j,i) + 5.3125_wp * tnc_m(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-       ENDIF
-
-!
-!--    If required, calculate prognostic equations for ice crystal content and ice crystal
-!--    concentration
-       IF ( microphysics_ice_phase )  THEN
-!
-!--       Calculate prognostic equation for ice crystal 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( qi, 'qi' )
-
-          ENDIF
-
-!
-!--       qi-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( advc_flags_s, qi, 'qi',                                        &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( qi )
-                ENDIF
-             ELSE
-                CALL advec_s_up( qi )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( qi,                                                                    &
-                            surf_def_h(0)%qisws, surf_def_h(1)%qisws,                              &
-                            surf_def_h(2)%qisws,                                                   &
-                            surf_lsm_h(0)%qisws, surf_lsm_h(1)%qisws,                              &
-                            surf_usm_h(0)%qisws, surf_usm_h(1)%qisws,                              &
-                            surf_def_v(0)%qisws, surf_def_v(1)%qisws,                              &
-                            surf_def_v(2)%qisws, surf_def_v(3)%qisws,                              &
-                            surf_lsm_v(0)%qisws, surf_lsm_v(1)%qisws,                              &
-                            surf_lsm_v(2)%qisws, surf_lsm_v(3)%qisws,                              &
-                            surf_usm_v(0)%qisws, surf_usm_v(1)%qisws,                              &
-                            surf_usm_v(2)%qisws, surf_usm_v(3)%qisws )
-
-!
-!--       Prognostic equation for ice crystal mixing ratio
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                !following directive is required to vectorize on Intel19
-                !DIR$ IVDEP
-                DO  k = nzb+1, nzt
-                   qi_p(k,j,i) = qi(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +                       &
-                                                      tsc(3) * tqi_m(k,j,i) )                      &
-                                                    - tsc(5) * rdf_sc(k) *                         &
-                                                               qi(k,j,i)                           &
-                                             )                                                     &
-                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) &
-                                          )
-                   IF ( qi_p(k,j,i) < 0.0_wp )  qi_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+1, nzt
-                         tqi_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+1, nzt
-                         tqi_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tqi_m(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-!
-!--       Calculate prognostic equation for ice crystal 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( ni, 'ni' )
-
-          ENDIF
-
-!
-!--       ni-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( advc_flags_s, ni, 'ni',                                        &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( ni )
-                ENDIF
-             ELSE
-                CALL advec_s_up( ni )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( ni,                                                                    &
-                            surf_def_h(0)%nisws, surf_def_h(1)%nisws,                              &
-                            surf_def_h(2)%nisws,                                                   &
-                            surf_lsm_h(0)%nisws, surf_lsm_h(1)%nisws,                              &
-                            surf_usm_h(0)%nisws, surf_usm_h(1)%nisws,                              &
-                            surf_def_v(0)%nisws, surf_def_v(1)%nisws,                              &
-                            surf_def_v(2)%nisws, surf_def_v(3)%nisws,                              &
-                            surf_lsm_v(0)%nisws, surf_lsm_v(1)%nisws,                              &
-                            surf_lsm_v(2)%nisws, surf_lsm_v(3)%nisws,                              &
-                            surf_usm_v(0)%nisws, surf_usm_v(1)%nisws,                              &
-                            surf_usm_v(2)%nisws, surf_usm_v(3)%nisws )
-
-!
-!--       Prognostic equation for ice crystal concentration
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                !following directive is required to vectorize on Intel19
-                !DIR$ IVDEP
-                DO  k = nzb+1, nzt
-                   ni_p(k,j,i) = ni(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +                       &
-                                                      tsc(3) * tni_m(k,j,i) )                      &
-                                                    - tsc(5) * rdf_sc(k) *                         &
-                                                               ni(k,j,i)                           &
-                                             )                                                     &
-                                   * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )  &
-                                          )
-                   IF ( ni_p(k,j,i) < 0.0_wp )  ni_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+1, nzt
-                         tni_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+1, nzt
-                         tni_m(k,j,i) =  -9.5625_wp * tend(k,j,i) + 5.3125_wp * tni_m(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-!
-!--    If required, calculate prognostic equations for snow content and snow
-!--    concentration
-       IF ( microphysics_ice_phase  .AND.  snow )  THEN
-!
-!--       Calculate prognostic equation for ice crystal 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( qs, 'qs' )
-
-          ENDIF
-
-!
-!--       qs-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( advc_flags_s, qs, 'qs',                                        &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( qs )
-                ENDIF
-             ELSE
-                CALL advec_s_up( qs )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( qs,                                                                    &
-                            surf_def_h(0)%qisws, surf_def_h(1)%qisws,                              &
-                            surf_def_h(2)%qisws,                                                   &
-                            surf_lsm_h(0)%qisws, surf_lsm_h(1)%qisws,                              &
-                            surf_usm_h(0)%qisws, surf_usm_h(1)%qisws,                              &
-                            surf_def_v(0)%qisws, surf_def_v(1)%qisws,                              &
-                            surf_def_v(2)%qisws, surf_def_v(3)%qisws,                              &
-                            surf_lsm_v(0)%qisws, surf_lsm_v(1)%qisws,                              &
-                            surf_lsm_v(2)%qisws, surf_lsm_v(3)%qisws,                              &
-                            surf_usm_v(0)%qisws, surf_usm_v(1)%qisws,                              &
-                            surf_usm_v(2)%qisws, surf_usm_v(3)%qisws )
-
-!
-!--       Prognostic equation for snow mixing ratio
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                !following directive is required to vectorize on Intel19
-                !DIR$ IVDEP
-                DO  k = nzb+1, nzt
-                   qs_p(k,j,i) = qs(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +                       &
-                                                      tsc(3) * tqs_m(k,j,i) )                      &
-                                                    - tsc(5) * rdf_sc(k) *                         &
-                                                               qs(k,j,i)                           &
-                                             )                                                     &
-                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) &
-                                          )
-                   IF ( qs_p(k,j,i) < 0.0_wp )  qs_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+1, nzt
-                         tqs_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+1, nzt
-                         tqs_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tqs_m(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-!
-!--       Calculate prognostic equation for ice crystal 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( ns, 'ns' )
-
-          ENDIF
-
-!
-!--       ni-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( advc_flags_s, ns, 'ns',                                        &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( ns )
-                ENDIF
-             ELSE
-                CALL advec_s_up( ns )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( ns,                                                                    &
-                            surf_def_h(0)%nisws, surf_def_h(1)%nisws,                              &
-                            surf_def_h(2)%nisws,                                                   &
-                            surf_lsm_h(0)%nisws, surf_lsm_h(1)%nisws,                              &
-                            surf_usm_h(0)%nisws, surf_usm_h(1)%nisws,                              &
-                            surf_def_v(0)%nisws, surf_def_v(1)%nisws,                              &
-                            surf_def_v(2)%nisws, surf_def_v(3)%nisws,                              &
-                            surf_lsm_v(0)%nisws, surf_lsm_v(1)%nisws,                              &
-                            surf_lsm_v(2)%nisws, surf_lsm_v(3)%nisws,                              &
-                            surf_usm_v(0)%nisws, surf_usm_v(1)%nisws,                              &
-                            surf_usm_v(2)%nisws, surf_usm_v(3)%nisws )
-
-!
-!--       Prognostic equation for snow number concentration
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                !following directive is required to vectorize on Intel19
-                !DIR$ IVDEP
-                DO  k = nzb+1, nzt
-                   ns_p(k,j,i) = ns(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +                       &
-                                                      tsc(3) * tns_m(k,j,i) )                      &
-                                                    - tsc(5) * rdf_sc(k) *                         &
-                                                               ns(k,j,i)                           &
-                                             )                                                     &
-                                   * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )  &
-                                          )
-                   IF ( ns_p(k,j,i) < 0.0_wp )  ns_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+1, nzt
-                         tns_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+1, nzt
-                         tns_m(k,j,i) =  -9.5625_wp * tend(k,j,i) + 5.3125_wp * tns_m(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-       ENDIF
-
-!
-!--    If required, calculate prognostic equations for ice crystal content and ice crystal
-!--    concentration
-       IF ( microphysics_ice_phase   .AND.  graupel )  THEN
-!
-!--       Calculate prognostic equation for graupel 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( qg, 'qg' )
-
-          ENDIF
-
-!
-!--       qg-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( advc_flags_s, qg, 'qg',                                        &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( qg )
-                ENDIF
-             ELSE
-                CALL advec_s_up( qg )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( qg,                                                                    &
-                            surf_def_h(0)%qisws, surf_def_h(1)%qisws,                              &
-                            surf_def_h(2)%qisws,                                                   &
-                            surf_lsm_h(0)%qisws, surf_lsm_h(1)%qisws,                              &
-                            surf_usm_h(0)%qisws, surf_usm_h(1)%qisws,                              &
-                            surf_def_v(0)%qisws, surf_def_v(1)%qisws,                              &
-                            surf_def_v(2)%qisws, surf_def_v(3)%qisws,                              &
-                            surf_lsm_v(0)%qisws, surf_lsm_v(1)%qisws,                              &
-                            surf_lsm_v(2)%qisws, surf_lsm_v(3)%qisws,                              &
-                            surf_usm_v(0)%qisws, surf_usm_v(1)%qisws,                              &
-                            surf_usm_v(2)%qisws, surf_usm_v(3)%qisws )
-
-!
-!--       Prognostic equation for graupel mixing ratio
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                !following directive is required to vectorize on Intel19
-                !DIR$ IVDEP
-                DO  k = nzb+1, nzt
-                   qg_p(k,j,i) = qg(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +                       &
-                                                      tsc(3) * tqg_m(k,j,i) )                      &
-                                                    - tsc(5) * rdf_sc(k) *                         &
-                                                               qg(k,j,i)                           &
-                                             )                                                     &
-                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) &
-                                          )
-                   IF ( qg_p(k,j,i) < 0.0_wp )  qg_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+1, nzt
-                         tqg_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+1, nzt
-                         tqg_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tqg_m(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-!
-!--       Calculate prognostic equation for graupel number 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( ng, 'ng ' )
-
-          ENDIF
-
-!
-!--       ng-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( advc_flags_s, ng, 'ng',                                        &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( ng )
-                ENDIF
-             ELSE
-                CALL advec_s_up( ng )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( ng,                                                                    &
-                            surf_def_h(0)%nisws, surf_def_h(1)%nisws,                              &
-                            surf_def_h(2)%nisws,                                                   &
-                            surf_lsm_h(0)%nisws, surf_lsm_h(1)%nisws,                              &
-                            surf_usm_h(0)%nisws, surf_usm_h(1)%nisws,                              &
-                            surf_def_v(0)%nisws, surf_def_v(1)%nisws,                              &
-                            surf_def_v(2)%nisws, surf_def_v(3)%nisws,                              &
-                            surf_lsm_v(0)%nisws, surf_lsm_v(1)%nisws,                              &
-                            surf_lsm_v(2)%nisws, surf_lsm_v(3)%nisws,                              &
-                            surf_usm_v(0)%nisws, surf_usm_v(1)%nisws,                              &
-                            surf_usm_v(2)%nisws, surf_usm_v(3)%nisws )
-
-!
-!--       Prognostic equation for ice crystal concentration
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                !following directive is required to vectorize on Intel19
-                !DIR$ IVDEP
-                DO  k = nzb+1, nzt
-                   ng_p(k,j,i) = ng(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +                       &
-                                                      tsc(3) * tng_m(k,j,i) )                      &
-                                                    - tsc(5) * rdf_sc(k) *                         &
-                                                               ng(k,j,i)                           &
-                                             )                                                     &
-                                   * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )  &
-                                          )
-                   IF ( ng_p(k,j,i) < 0.0_wp )  ng_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+1, nzt
-                         tng_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+1, nzt
-                         tng_m(k,j,i) =  -9.5625_wp * tend(k,j,i) + 5.3125_wp * tng_m(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-       ENDIF
-
-
-!
-!--    If required, calculate prognostic equations for rain water content and rain drop
-!--    concentration.
-       IF ( microphysics_seifert )  THEN
-!
-!--       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( advc_flags_s, qr, 'qr',                                        &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( qr )
-                ENDIF
-             ELSE
-                CALL advec_s_up( qr )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( qr,                                                                    &
-                            surf_def_h(0)%qrsws, surf_def_h(1)%qrsws,                              &
-                            surf_def_h(2)%qrsws,                                                   &
-                            surf_lsm_h(0)%qrsws, surf_lsm_h(1)%qrsws,                              &
-                            surf_usm_h(0)%qrsws, surf_usm_h(1)%qrsws,                              &
-                            surf_def_v(0)%qrsws, surf_def_v(1)%qrsws,                              &
-                            surf_def_v(2)%qrsws, surf_def_v(3)%qrsws,                              &
-                            surf_lsm_v(0)%qrsws, surf_lsm_v(1)%qrsws,                              &
-                            surf_lsm_v(2)%qrsws, surf_lsm_v(3)%qrsws,                              &
-                            surf_usm_v(0)%qrsws, surf_usm_v(1)%qrsws,                              &
-                            surf_usm_v(2)%qrsws, surf_usm_v(3)%qrsws )
-
-!
-!--       Prognostic equation for rain water content
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                !following directive is required to vectorize on Intel19
-                !DIR$ IVDEP
-                DO  k = nzb+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)                           &
-                                             )                                                     &
-                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) &
-                                          )
-                   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+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+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
-!
-!--       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( advc_flags_s, nr, 'nr',                                        &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( nr )
-                ENDIF
-             ELSE
-                CALL advec_s_up( nr )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( nr,                                                                    &
-                            surf_def_h(0)%nrsws, surf_def_h(1)%nrsws,                              &
-                            surf_def_h(2)%nrsws,                                                   &
-                            surf_lsm_h(0)%nrsws, surf_lsm_h(1)%nrsws,                              &
-                            surf_usm_h(0)%nrsws, surf_usm_h(1)%nrsws,                              &
-                            surf_def_v(0)%nrsws, surf_def_v(1)%nrsws,                              &
-                            surf_def_v(2)%nrsws, surf_def_v(3)%nrsws,                              &
-                            surf_lsm_v(0)%nrsws, surf_lsm_v(1)%nrsws,                              &
-                            surf_lsm_v(2)%nrsws, surf_lsm_v(3)%nrsws,                              &
-                            surf_usm_v(0)%nrsws, surf_usm_v(1)%nrsws,                              &
-                            surf_usm_v(2)%nrsws, surf_usm_v(3)%nrsws )
-
-!
-!--       Prognostic equation for rain drop concentration
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                !following directive is required to vectorize on Intel19
-                !DIR$ IVDEP
-                DO  k = nzb+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)                           &
-                                             )                                                     &
-                                   * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )  &
-                                          )
-                   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+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+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
-       ENDIF
-
-       CALL cpu_log( log_point(67), 'all_bmc-prog_equation', 'stop' )
-
-    END SUBROUTINE bcm_prognostic_equations
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Control of microphysics for grid points i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_prognostic_equations_ij( i, j, i_omp_start, tn )
-
-
-       INTEGER(iwp), INTENT(IN) ::  i            !< grid index in x-direction
-       INTEGER(iwp), INTENT(IN) ::  i_omp_start  !< first loop index of i-loop in
-                                                 !< prognostic_equations
-       INTEGER(iwp), INTENT(IN) ::  j            !< grid index in y-direction
-       INTEGER(iwp)             ::  k            !< grid index in z-direction
-       INTEGER(iwp), INTENT(IN) ::  tn           !< task number of openmp task
-
-!
-!--    If required, calculate prognostic equations for cloud water content and cloud drop
-!--    concentration.
-       IF ( microphysics_morrison )  THEN
-!
-!--       Calculate prognostic equation for cloud water content
-          tend(:,j,i) = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' ) &
-          THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( advc_flags_s, i, j, qc, 'qc', flux_s_qc,                          &
-                                 diss_s_qc, flux_l_qc, diss_l_qc,                                  &
-                                 i_omp_start, tn,                                                  &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( i, j, qc )
-             ENDIF
-          ELSE
-             CALL advec_s_up( i, j, qc )
-          ENDIF
-          CALL diffusion_s( i, j, qc,                                                              &
-                            surf_def_h(0)%qcsws, surf_def_h(1)%qcsws,                              &
-                            surf_def_h(2)%qcsws,                                                   &
-                            surf_lsm_h(0)%qcsws, surf_lsm_h(1)%qcsws,                              &
-                            surf_usm_h(0)%qcsws, surf_usm_h(1)%qcsws,                              &
-                            surf_def_v(0)%qcsws, surf_def_v(1)%qcsws,                              &
-                            surf_def_v(2)%qcsws, surf_def_v(3)%qcsws,                              &
-                            surf_lsm_v(0)%qcsws, surf_lsm_v(1)%qcsws,                              &
-                            surf_lsm_v(2)%qcsws, surf_lsm_v(3)%qcsws,                              &
-                            surf_usm_v(0)%qcsws, surf_usm_v(1)%qcsws,                              &
-                            surf_usm_v(2)%qcsws, surf_usm_v(3)%qcsws )
-
-!
-!--       Prognostic equation for cloud water content
-          DO  k = nzb+1, nzt
-             qc_p(k,j,i) = qc(k,j,i) + ( dt_3d *                                                   &
-                                                ( tsc(2) * tend(k,j,i) +                           &
-                                                  tsc(3) * tqc_m(k,j,i) )                          &
-                                                - tsc(5) * rdf_sc(k)                               &
-                                                         * qc(k,j,i)                               &
-                                       )                                                           &
-                                 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )    &
-                                        )
-             IF ( qc_p(k,j,i) < 0.0_wp )  qc_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+1, nzt
-                   tqc_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb+1, nzt
-                   tqc_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tqc_m(k,j,i)
-                ENDDO
-             ENDIF
-          ENDIF
-
-!
-!--       Calculate prognostic equation for cloud drop concentration.
-          tend(:,j,i) = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( advc_flags_s, i, j, nc, 'nc', flux_s_nc,                          &
-                                 diss_s_nc, flux_l_nc, diss_l_nc,                                  &
-                                 i_omp_start, tn,                                                  &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( i, j, nc )
-             ENDIF
-          ELSE
-             CALL advec_s_up( i, j, nc )
-          ENDIF
-          CALL diffusion_s( i, j, nc,                                                              &
-                            surf_def_h(0)%ncsws, surf_def_h(1)%ncsws,                              &
-                            surf_def_h(2)%ncsws,                                                   &
-                            surf_lsm_h(0)%ncsws, surf_lsm_h(1)%ncsws,                              &
-                            surf_usm_h(0)%ncsws, surf_usm_h(1)%ncsws,                              &
-                            surf_def_v(0)%ncsws, surf_def_v(1)%ncsws,                              &
-                            surf_def_v(2)%ncsws, surf_def_v(3)%ncsws,                              &
-                            surf_lsm_v(0)%ncsws, surf_lsm_v(1)%ncsws,                              &
-                            surf_lsm_v(2)%ncsws, surf_lsm_v(3)%ncsws,                              &
-                            surf_usm_v(0)%ncsws, surf_usm_v(1)%ncsws,                              &
-                            surf_usm_v(2)%ncsws, surf_usm_v(3)%ncsws )
-
-!
-!--       Prognostic equation for cloud drop concentration
-          DO  k = nzb+1, nzt
-             nc_p(k,j,i) = nc(k,j,i) + ( dt_3d *                                                   &
-                                                ( tsc(2) * tend(k,j,i) +                           &
-                                                  tsc(3) * tnc_m(k,j,i) )                          &
-                                                - tsc(5) * rdf_sc(k)                               &
-                                                         * nc(k,j,i)                               &
-                                       )                                                           &
-                                 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )    &
-                                        )
-             IF ( nc_p(k,j,i) < 0.0_wp )  nc_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+1, nzt
-                   tnc_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb+1, nzt
-                   tnc_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tnc_m(k,j,i)
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-!
-!--    If required, calculate prognostic equations for ice crystal mixing ratio and ice crystal
-!--    concentration.
-       IF ( microphysics_ice_phase )  THEN
-!
-!--       Calculate prognostic equation for ice crystal mixing ratio
-          tend(:,j,i) = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' ) &
-          THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( advc_flags_s, i, j, qi, 'qi', flux_s_qi,                          &
-                                 diss_s_qi, flux_l_qi, diss_l_qi,                                  &
-                                 i_omp_start, tn,                                                  &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( i, j, qi )
-             ENDIF
-          ELSE
-             CALL advec_s_up( i, j, qi )
-          ENDIF
-          CALL diffusion_s( i, j, qi,                                                              &
-                            surf_def_h(0)%qisws, surf_def_h(1)%qisws,                              &
-                            surf_def_h(2)%qisws,                                                   &
-                            surf_lsm_h(0)%qisws, surf_lsm_h(1)%qisws,                              &
-                            surf_usm_h(0)%qisws, surf_usm_h(1)%qisws,                              &
-                            surf_def_v(0)%qisws, surf_def_v(1)%qisws,                              &
-                            surf_def_v(2)%qisws, surf_def_v(3)%qisws,                              &
-                            surf_lsm_v(0)%qisws, surf_lsm_v(1)%qisws,                              &
-                            surf_lsm_v(2)%qisws, surf_lsm_v(3)%qisws,                              &
-                            surf_usm_v(0)%qisws, surf_usm_v(1)%qisws,                              &
-                            surf_usm_v(2)%qisws, surf_usm_v(3)%qisws )
-
-!
-!--       Prognostic equation for ice crystal mixing ratio
-          DO  k = nzb+1, nzt
-             qi_p(k,j,i) = qi(k,j,i) + ( dt_3d *                                                   &
-                                                ( tsc(2) * tend(k,j,i) +                           &
-                                                  tsc(3) * tqi_m(k,j,i) )                          &
-                                                - tsc(5) * rdf_sc(k)                               &
-                                                         * qi(k,j,i)                               &
-                                       )                                                           &
-                                 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )    &
-                                        )
-             IF ( qi_p(k,j,i) < 0.0_wp )  qi_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+1, nzt
-                   tqi_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb+1, nzt
-                   tqi_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tqi_m(k,j,i)
-                ENDDO
-             ENDIF
-          ENDIF
-
-!
-!--       Calculate prognostic equation for ice crystal concentration.
-          tend(:,j,i) = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( advc_flags_s, i, j, ni, 'ni', flux_s_ni,                          &
-                                 diss_s_ni, flux_l_ni, diss_l_ni,                                  &
-                                 i_omp_start, tn,                                                  &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( i, j, ni )
-             ENDIF
-          ELSE
-             CALL advec_s_up( i, j, ni )
-          ENDIF
-          CALL diffusion_s( i, j, ni,                                                              &
-                            surf_def_h(0)%nisws, surf_def_h(1)%nisws,                              &
-                            surf_def_h(2)%nisws,                                                   &
-                            surf_lsm_h(0)%nisws, surf_lsm_h(1)%nisws,                              &
-                            surf_usm_h(0)%nisws, surf_usm_h(1)%nisws,                              &
-                            surf_def_v(0)%nisws, surf_def_v(1)%nisws,                              &
-                            surf_def_v(2)%nisws, surf_def_v(3)%nisws,                              &
-                            surf_lsm_v(0)%nisws, surf_lsm_v(1)%nisws,                              &
-                            surf_lsm_v(2)%nisws, surf_lsm_v(3)%nisws,                              &
-                            surf_usm_v(0)%nisws, surf_usm_v(1)%nisws,                              &
-                            surf_usm_v(2)%nisws, surf_usm_v(3)%nisws )
-
-!
-!--       Prognostic equation for ice crystal concentration
-          DO  k = nzb+1, nzt
-             ni_p(k,j,i) = ni(k,j,i) + ( dt_3d *                                                   &
-                                                ( tsc(2) * tend(k,j,i) +                           &
-                                                  tsc(3) * tni_m(k,j,i) )                          &
-                                                - tsc(5) * rdf_sc(k)                               &
-                                                         * ni(k,j,i)                               &
-                                       )                                                           &
-                                 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )    &
-                                        )
-             IF ( ni_p(k,j,i) < 0.0_wp )  ni_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+1, nzt
-                   tni_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb+1, nzt
-                   tni_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tni_m(k,j,i)
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-!
-!--    If required, calculate prognostic equations for ice crystal mixing ratio and ice crystal
-!--    concentration.
-       IF ( microphysics_ice_phase  .AND.  snow )  THEN
-!
-!--       Calculate prognostic equation for ice crystal mixing ratio
-          tend(:,j,i) = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' ) &
-          THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( advc_flags_s, i, j, qs, 'qs', flux_s_qs,                          &
-                                 diss_s_qs, flux_l_qs, diss_l_qs,                                  &
-                                 i_omp_start, tn,                                                  &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( i, j, qs )
-             ENDIF
-          ELSE
-             CALL advec_s_up( i, j, qs )
-          ENDIF
-          CALL diffusion_s( i, j, qs,                                                              &
-                            surf_def_h(0)%qisws, surf_def_h(1)%qisws,                              &
-                            surf_def_h(2)%qisws,                                                   &
-                            surf_lsm_h(0)%qisws, surf_lsm_h(1)%qisws,                              &
-                            surf_usm_h(0)%qisws, surf_usm_h(1)%qisws,                              &
-                            surf_def_v(0)%qisws, surf_def_v(1)%qisws,                              &
-                            surf_def_v(2)%qisws, surf_def_v(3)%qisws,                              &
-                            surf_lsm_v(0)%qisws, surf_lsm_v(1)%qisws,                              &
-                            surf_lsm_v(2)%qisws, surf_lsm_v(3)%qisws,                              &
-                            surf_usm_v(0)%qisws, surf_usm_v(1)%qisws,                              &
-                            surf_usm_v(2)%qisws, surf_usm_v(3)%qisws )
-
-!
-!--       Prognostic equation for snow  mixing ratio
-          DO  k = nzb+1, nzt
-             qs_p(k,j,i) = qs(k,j,i) + ( dt_3d *                                                   &
-                                                ( tsc(2) * tend(k,j,i) +                           &
-                                                  tsc(3) * tqs_m(k,j,i) )                          &
-                                                - tsc(5) * rdf_sc(k)                               &
-                                                         * qs(k,j,i)                               &
-                                       )                                                           &
-                                 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )    &
-                                        )
-             IF ( qs_p(k,j,i) < 0.0_wp )  qs_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+1, nzt
-                   tqs_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb+1, nzt
-                   tqs_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tqs_m(k,j,i)
-                ENDDO
-             ENDIF
-          ENDIF
-
-!
-!--       Calculate prognostic equation for snow number concentration.
-          tend(:,j,i) = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( advc_flags_s, i, j, ns, 'ns', flux_s_ns,                          &
-                                 diss_s_ns, flux_l_ns, diss_l_ns,                                  &
-                                 i_omp_start, tn,                                                  &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( i, j, ns )
-             ENDIF
-          ELSE
-             CALL advec_s_up( i, j, ns )
-          ENDIF
-          CALL diffusion_s( i, j, ns,                                                              &
-                            surf_def_h(0)%nisws, surf_def_h(1)%nisws,                              &
-                            surf_def_h(2)%nisws,                                                   &
-                            surf_lsm_h(0)%nisws, surf_lsm_h(1)%nisws,                              &
-                            surf_usm_h(0)%nisws, surf_usm_h(1)%nisws,                              &
-                            surf_def_v(0)%nisws, surf_def_v(1)%nisws,                              &
-                            surf_def_v(2)%nisws, surf_def_v(3)%nisws,                              &
-                            surf_lsm_v(0)%nisws, surf_lsm_v(1)%nisws,                              &
-                            surf_lsm_v(2)%nisws, surf_lsm_v(3)%nisws,                              &
-                            surf_usm_v(0)%nisws, surf_usm_v(1)%nisws,                              &
-                            surf_usm_v(2)%nisws, surf_usm_v(3)%nisws )
-
-!
-!--       Prognostic equation for snow number concentration
-          DO  k = nzb+1, nzt
-             ns_p(k,j,i) = ns(k,j,i) + ( dt_3d *                                                   &
-                                                ( tsc(2) * tend(k,j,i) +                           &
-                                                  tsc(3) * tns_m(k,j,i) )                          &
-                                                - tsc(5) * rdf_sc(k)                               &
-                                                         * ns(k,j,i)                               &
-                                       )                                                           &
-                                 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )    &
-                                        )
-             IF ( ns_p(k,j,i) < 0.0_wp )  ns_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+1, nzt
-                   tns_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb+1, nzt
-                   tns_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tns_m(k,j,i)
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-!
-!--    If required, calculate prognostic equations for graupel mixing ratio and graupel number
-!--    concentration.
-       IF ( microphysics_ice_phase  .AND.  graupel )  THEN
-!
-!--       Calculate prognostic equation for graupel mixing ratio
-          tend(:,j,i) = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' ) &
-          THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( advc_flags_s, i, j, qg, 'qg', flux_s_qg,                          &
-                                 diss_s_qg, flux_l_qg, diss_l_qg,                                  &
-                                 i_omp_start, tn,                                                  &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( i, j, qg )
-             ENDIF
-          ELSE
-             CALL advec_s_up( i, j, qg )
-          ENDIF
-          CALL diffusion_s( i, j, qg,                                                              &
-                            surf_def_h(0)%qisws, surf_def_h(1)%qisws,                              &
-                            surf_def_h(2)%qisws,                                                   &
-                            surf_lsm_h(0)%qisws, surf_lsm_h(1)%qisws,                              &
-                            surf_usm_h(0)%qisws, surf_usm_h(1)%qisws,                              &
-                            surf_def_v(0)%qisws, surf_def_v(1)%qisws,                              &
-                            surf_def_v(2)%qisws, surf_def_v(3)%qisws,                              &
-                            surf_lsm_v(0)%qisws, surf_lsm_v(1)%qisws,                              &
-                            surf_lsm_v(2)%qisws, surf_lsm_v(3)%qisws,                              &
-                            surf_usm_v(0)%qisws, surf_usm_v(1)%qisws,                              &
-                            surf_usm_v(2)%qisws, surf_usm_v(3)%qisws )
-
-!
-!--       Prognostic equation for ice crystal mixing ratio
-          DO  k = nzb+1, nzt
-             qg_p(k,j,i) = qg(k,j,i) + ( dt_3d *                                                   &
-                                                ( tsc(2) * tend(k,j,i) +                           &
-                                                  tsc(3) * tqg_m(k,j,i) )                          &
-                                                - tsc(5) * rdf_sc(k)                               &
-                                                         * qg(k,j,i)                               &
-                                       )                                                           &
-                                 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )    &
-                                        )
-             IF ( qg_p(k,j,i) < 0.0_wp )  qg_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+1, nzt
-                   tqg_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb+1, nzt
-                   tqg_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tqg_m(k,j,i)
-                ENDDO
-             ENDIF
-          ENDIF
-
-!
-!--       Calculate prognostic equation for graupel number concentration.
-          tend(:,j,i) = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( advc_flags_s, i, j, ng, 'ng', flux_s_ng,                          &
-                                 diss_s_ng, flux_l_ng, diss_l_ng,                                  &
-                                 i_omp_start, tn,                                                  &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( i, j, ng )
-             ENDIF
-          ELSE
-             CALL advec_s_up( i, j, ng )
-          ENDIF
-          CALL diffusion_s( i, j, ng,                                                              &
-                            surf_def_h(0)%nisws, surf_def_h(1)%nisws,                              &
-                            surf_def_h(2)%nisws,                                                   &
-                            surf_lsm_h(0)%nisws, surf_lsm_h(1)%nisws,                              &
-                            surf_usm_h(0)%nisws, surf_usm_h(1)%nisws,                              &
-                            surf_def_v(0)%nisws, surf_def_v(1)%nisws,                              &
-                            surf_def_v(2)%nisws, surf_def_v(3)%nisws,                              &
-                            surf_lsm_v(0)%nisws, surf_lsm_v(1)%nisws,                              &
-                            surf_lsm_v(2)%nisws, surf_lsm_v(3)%nisws,                              &
-                            surf_usm_v(0)%nisws, surf_usm_v(1)%nisws,                              &
-                            surf_usm_v(2)%nisws, surf_usm_v(3)%nisws )
-
-!
-!--       Prognostic equation for graupel number concentration
-          DO  k = nzb+1, nzt
-             ng_p(k,j,i) = ng(k,j,i) + ( dt_3d *                                                   &
-                                                ( tsc(2) * tend(k,j,i) +                           &
-                                                  tsc(3) * tng_m(k,j,i) )                          &
-                                                - tsc(5) * rdf_sc(k)                               &
-                                                         * ng(k,j,i)                               &
-                                       )                                                           &
-                                 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )    &
-                                        )
-             IF ( ng_p(k,j,i) < 0.0_wp )  ng_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+1, nzt
-                   tng_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb+1, nzt
-                   tng_m(k,j,i) =   -9.5625_wp * tend(k,j,i) + 5.3125_wp * tng_m(k,j,i)
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-!
-!--    If required, calculate prognostic equations for rain water content and rain drop
-!--    concentration
-       IF ( 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( advc_flags_s, i, j, qr, 'qr', flux_s_qr,                          &
-                                 diss_s_qr, flux_l_qr, diss_l_qr,                                  &
-                                 i_omp_start, tn,                                                  &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( i, j, qr )
-             ENDIF
-          ELSE
-             CALL advec_s_up( i, j, qr )
-          ENDIF
-          CALL diffusion_s( i, j, qr,                                                              &
-                            surf_def_h(0)%qrsws, surf_def_h(1)%qrsws,                              &
-                            surf_def_h(2)%qrsws,                                                   &
-                            surf_lsm_h(0)%qrsws, surf_lsm_h(1)%qrsws,                              &
-                            surf_usm_h(0)%qrsws, surf_usm_h(1)%qrsws,                              &
-                            surf_def_v(0)%qrsws, surf_def_v(1)%qrsws,                              &
-                            surf_def_v(2)%qrsws, surf_def_v(3)%qrsws,                              &
-                            surf_lsm_v(0)%qrsws, surf_lsm_v(1)%qrsws,                              &
-                            surf_lsm_v(2)%qrsws, surf_lsm_v(3)%qrsws,                              &
-                            surf_usm_v(0)%qrsws, surf_usm_v(1)%qrsws,                              &
-                            surf_usm_v(2)%qrsws, surf_usm_v(3)%qrsws )
-
-!
-!--       Prognostic equation for rain water content
-          DO  k = nzb+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)                               &
-                                       )                                                           &
-                                 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )    &
-                                        )
-             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+1, nzt
-                   tqr_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb+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( advc_flags_s, i, j, nr, 'nr', flux_s_nr,                          &
-                                 diss_s_nr, flux_l_nr, diss_l_nr,                                  &
-                                 i_omp_start, tn,                                                  &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( i, j, nr )
-             ENDIF
-          ELSE
-             CALL advec_s_up( i, j, nr )
-          ENDIF
-          CALL diffusion_s( i, j, nr,                                                              &
-                            surf_def_h(0)%nrsws, surf_def_h(1)%nrsws,                              &
-                            surf_def_h(2)%nrsws,                                                   &
-                            surf_lsm_h(0)%nrsws, surf_lsm_h(1)%nrsws,                              &
-                            surf_usm_h(0)%nrsws, surf_usm_h(1)%nrsws,                              &
-                            surf_def_v(0)%nrsws, surf_def_v(1)%nrsws,                              &
-                            surf_def_v(2)%nrsws, surf_def_v(3)%nrsws,                              &
-                            surf_lsm_v(0)%nrsws, surf_lsm_v(1)%nrsws,                              &
-                            surf_lsm_v(2)%nrsws, surf_lsm_v(3)%nrsws,                              &
-                            surf_usm_v(0)%nrsws, surf_usm_v(1)%nrsws,                              &
-                            surf_usm_v(2)%nrsws, surf_usm_v(3)%nrsws )
-
-!
-!--       Prognostic equation for rain drop concentration
-          DO  k = nzb+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)                               &
-                                       )                                                           &
-                                 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )    &
-                                        )
-             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+1, nzt
-                   tnr_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb+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
-
-    END SUBROUTINE bcm_prognostic_equations_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Swapping of timelevels
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_swap_timelevel ( mod_count )
-
-       IMPLICIT NONE
-
-       INTEGER, INTENT(IN) :: mod_count
-
-       IF ( bulk_cloud_model )  THEN
-
-          SELECT CASE ( mod_count )
-
-             CASE ( 0 )
-
-                IF ( microphysics_morrison )  THEN
-                   qc => qc_1;    qc_p => qc_2
-                   nc => nc_1;    nc_p => nc_2
-                ENDIF
-                IF ( microphysics_seifert )  THEN
-                   qr => qr_1;    qr_p => qr_2
-                   nr => nr_1;    nr_p => nr_2
-                ENDIF
-                IF ( microphysics_ice_phase )  THEN
-                   qi => qi_1;    qi_p => qi_2
-                   ni => ni_1;    ni_p => ni_2
-                   IF ( snow )  THEN
-                      qs => qs_1;    qs_p => qs_2
-                      ns => ns_1;    ns_p => ns_2
-                   ENDIF
-                   IF ( graupel )  THEN
-                      qg => qg_1;    qg_p => qg_2
-                      ng => ng_1;    ng_p => ng_2
-                   ENDIF
-                ENDIF
-
-
-             CASE ( 1 )
-
-                IF ( microphysics_morrison )  THEN
-                   qc => qc_2;    qc_p => qc_1
-                   nc => nc_2;    nc_p => nc_1
-                ENDIF
-                IF ( microphysics_seifert )  THEN
-                   qr => qr_2;    qr_p => qr_1
-                   nr => nr_2;    nr_p => nr_1
-                ENDIF
-                IF ( microphysics_ice_phase )  THEN
-                   qi => qi_2;    qi_p => qi_1
-                   ni => ni_2;    ni_p => ni_1
-                   IF ( snow )  THEN
-                      qs => qs_2;    qs_p => qs_1
-                      ns => ns_2;    ns_p => ns_1
-                   ENDIF
-                   IF ( graupel )  THEN
-                      qg => qg_2;    qg_p => qg_1
-                      ng => ng_2;    ng_p => ng_1
-                   ENDIF
-                ENDIF
-
-
-          END SELECT
-
-       ENDIF
-
-    END SUBROUTINE bcm_swap_timelevel
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description: Boundary conditions of the bulk cloud module variables
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_boundary_conditions
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-       INTEGER(iwp) ::  m !<
-       INTEGER(iwp) ::  l !<
-
-       IF ( microphysics_morrison )  THEN
-!
-!--       Surface conditions cloud water (Dirichlet).
-!--       Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
-!--       belongs to the atmospheric grid point, therefore, set qr_p and nr_p at upward (k-1) and
-!--       downward-facing (k+1) walls.
-          DO  l = 0, 1
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, bc_h(l)%ns
-                i = bc_h(l)%i(m)
-                j = bc_h(l)%j(m)
-                k = bc_h(l)%k(m)
-                qc_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-                nc_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-             ENDDO
-          ENDDO
-!
-!--       Top boundary condition for cloud water (Dirichlet)
-          qc_p(nzt+1,:,:) = 0.0_wp
-          nc_p(nzt+1,:,:) = 0.0_wp
-
-       ENDIF
-
-       IF ( microphysics_ice_phase )  THEN
-!
-!--       Surface conditions ice crysral, snow and graupel (Dirichlet).
-!--       Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
-!--       belongs to the atmospheric grid point, therefore, set q*_p and n*_p at upward (k-1) and
-!--       downward-facing (k+1) walls
-          DO  l = 0, 1
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, bc_h(l)%ns
-                i = bc_h(l)%i(m)
-                j = bc_h(l)%j(m)
-                k = bc_h(l)%k(m)
-                qi_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-                ni_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-             ENDDO
-          ENDDO
-!
-!--       Top boundary condition for ice crystal (Dirichlet)
-          qi_p(nzt+1,:,:) = 0.0_wp
-          ni_p(nzt+1,:,:) = 0.0_wp
-
-          IF ( snow )  THEN
-             DO  l = 0, 1
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-                DO  m = 1, bc_h(l)%ns
-                   i = bc_h(l)%i(m)
-                   j = bc_h(l)%j(m)
-                   k = bc_h(l)%k(m)
-                   qs_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-                   ns_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-                ENDDO
-             ENDDO
-!
-!--          Top boundary condition for snow (Dirichlet)
-             qs_p(nzt+1,:,:) = 0.0_wp
-             ns_p(nzt+1,:,:) = 0.0_wp
-          ENDIF
-          IF ( graupel )  THEN
-!
-!--       Top boundary condition for ice crystal (Dirichlet)
-          qg_p(nzt+1,:,:) = 0.0_wp
-          ng_p(nzt+1,:,:) = 0.0_wp
-             DO  l = 0, 1
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-                DO  m = 1, bc_h(l)%ns
-                   i = bc_h(l)%i(m)
-                   j = bc_h(l)%j(m)
-                   k = bc_h(l)%k(m)
-                   qg_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-                   ng_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-                ENDDO
-             ENDDO
-!
-!--          Top boundary condition for snow (Dirichlet)
-             qg_p(nzt+1,:,:) = 0.0_wp
-             ng_p(nzt+1,:,:) = 0.0_wp
-          ENDIF
-
-       ENDIF
-
-       IF ( microphysics_seifert )  THEN
-!
-!--       Surface conditions rain water (Dirichlet).
-!--       Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
-!--       belongs to the atmospheric grid point, therefore, set qr_p and nr_p at upward (k-1) and
-!--       downward-facing (k+1) walls
-          DO  l = 0, 1
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, bc_h(l)%ns
-                i = bc_h(l)%i(m)
-                j = bc_h(l)%j(m)
-                k = bc_h(l)%k(m)
-                qr_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-                nr_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-             ENDDO
-          ENDDO
-!
-!--       Top boundary condition for rain water (Dirichlet)
-          qr_p(nzt+1,:,:) = 0.0_wp
-          nr_p(nzt+1,:,:) = 0.0_wp
-
-       ENDIF
-
-!
-!--    Lateral boundary conditions for scalar quantities at the outflow.
-!--    Lateral oundary conditions for TKE and dissipation are set in tcm_boundary_conds.
-       IF ( bc_radiation_s )  THEN
-          IF ( microphysics_morrison )  THEN
-             qc_p(:,nys-1,:) = qc_p(:,nys,:)
-             nc_p(:,nys-1,:) = nc_p(:,nys,:)
-          ENDIF
-          IF ( microphysics_seifert )  THEN
-             qr_p(:,nys-1,:) = qr_p(:,nys,:)
-             nr_p(:,nys-1,:) = nr_p(:,nys,:)
-          ENDIF
-          IF ( microphysics_ice_phase )  THEN
-             qi_p(:,nys-1,:) = qi_p(:,nys,:)
-             ni_p(:,nys-1,:) = ni_p(:,nys,:)
-             IF ( snow )  THEN
-                qs_p(:,nys-1,:) = qs_p(:,nys,:)
-                ns_p(:,nys-1,:) = ns_p(:,nys,:)
-             ENDIF
-             IF ( graupel )  THEN
-                qg_p(:,nys-1,:) = qg_p(:,nys,:)
-                ng_p(:,nys-1,:) = ng_p(:,nys,:)
-             ENDIF
-          ENDIF
-       ELSEIF ( bc_radiation_n )  THEN
-          IF ( microphysics_morrison )  THEN
-             qc_p(:,nyn+1,:) = qc_p(:,nyn,:)
-             nc_p(:,nyn+1,:) = nc_p(:,nyn,:)
-          ENDIF
-          IF ( microphysics_seifert )  THEN
-             qr_p(:,nyn+1,:) = qr_p(:,nyn,:)
-             nr_p(:,nyn+1,:) = nr_p(:,nyn,:)
-          ENDIF
-          IF ( microphysics_ice_phase )  THEN
-             qi_p(:,nyn+1,:) = qi_p(:,nyn,:)
-             ni_p(:,nyn+1,:) = ni_p(:,nyn,:)
-             IF ( snow )  THEN
-                qs_p(:,nyn+1,:) = qs_p(:,nyn,:)
-                ns_p(:,nyn+1,:) = ns_p(:,nyn,:)
-             ENDIF
-             IF ( graupel )  THEN
-                qg_p(:,nyn+1,:) = qg_p(:,nyn,:)
-                ng_p(:,nyn+1,:) = ng_p(:,nyn,:)
-             ENDIF
-          ENDIF
-       ELSEIF ( bc_radiation_l )  THEN
-          IF ( microphysics_morrison )  THEN
-             qc_p(:,:,nxl-1) = qc_p(:,:,nxl)
-             nc_p(:,:,nxl-1) = nc_p(:,:,nxl)
-          ENDIF
-          IF ( microphysics_seifert )  THEN
-             qr_p(:,:,nxl-1) = qr_p(:,:,nxl)
-             nr_p(:,:,nxl-1) = nr_p(:,:,nxl)
-          ENDIF
-          IF ( microphysics_ice_phase )  THEN
-             qi_p(:,:,nxl-1) = qi_p(:,:,nxl)
-             ni_p(:,:,nxl-1) = ni_p(:,:,nxl)
-             IF ( snow )  THEN
-                qs_p(:,:,nxl-1) = qs_p(:,:,nxl)
-                ns_p(:,:,nxl-1) = ns_p(:,:,nxl)
-             ENDIF
-             IF ( graupel )  THEN
-                qg_p(:,:,nxl-1) = qg_p(:,:,nxl)
-                ng_p(:,:,nxl-1) = ng_p(:,:,nxl)
-             ENDIF
-          ENDIF
-       ELSEIF ( bc_radiation_r )  THEN
-          IF ( microphysics_morrison )  THEN
-             qc_p(:,:,nxr+1) = qc_p(:,:,nxr)
-             nc_p(:,:,nxr+1) = nc_p(:,:,nxr)
-          ENDIF
-          IF ( microphysics_seifert )  THEN
-             qr_p(:,:,nxr+1) = qr_p(:,:,nxr)
-             nr_p(:,:,nxr+1) = nr_p(:,:,nxr)
-          ENDIF
-          IF ( microphysics_ice_phase )  THEN
-             qi_p(:,:,nxr+1) = qi_p(:,:,nxr)
-             ni_p(:,:,nxr+1) = ni_p(:,:,nxr)
-             IF ( snow )  THEN
-                qs_p(:,:,nxr+1) = qs_p(:,:,nxr)
-                ns_p(:,:,nxr+1) = ns_p(:,:,nxr)
-             ENDIF
-             IF ( graupel )  THEN
-                qg_p(:,:,nxr+1) = qg_p(:,:,nxr)
-                ng_p(:,:,nxr+1) = ng_p(:,:,nxr)
-             ENDIF
-          ENDIF
-       ENDIF
-
-    END SUBROUTINE bcm_boundary_conditions
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine for averaging 3D data
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_3d_data_averaging( mode, variable )
-
-       USE control_parameters,                                                                     &
-           ONLY:  average_count_3d
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  mode     !<
-       CHARACTER (LEN=*) ::  variable !<
-
-       INTEGER(iwp) ::  i       !< local index
-       INTEGER(iwp) ::  j       !< local index
-       INTEGER(iwp) ::  k       !< local index
-
-       IF ( mode == 'allocate' )  THEN
-
-          SELECT CASE ( TRIM( variable ) )
-
-             CASE ( 'nc' )
-                IF ( .NOT. ALLOCATED( nc_av ) )  THEN
-                   ALLOCATE( nc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                nc_av = 0.0_wp
-
-             CASE ( 'ng' )
-                IF ( .NOT. ALLOCATED( ng_av ) )  THEN
-                   ALLOCATE( ng_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ng_av = 0.0_wp
-
-             CASE ( 'ni' )
-                IF ( .NOT. ALLOCATED( ni_av ) )  THEN
-                   ALLOCATE( ni_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ni_av = 0.0_wp
-
-             CASE ( 'nr' )
-                IF ( .NOT. ALLOCATED( nr_av ) )  THEN
-                   ALLOCATE( nr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                nr_av = 0.0_wp
-
-             CASE ( 'ns' )
-                IF ( .NOT. ALLOCATED( ns_av ) )  THEN
-                   ALLOCATE( ns_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ns_av = 0.0_wp
-
-             CASE ( 'prr' )
-                IF ( .NOT. ALLOCATED( prr_av ) )  THEN
-                   ALLOCATE( prr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                prr_av = 0.0_wp
-
-             CASE ( 'qc' )
-                IF ( .NOT. ALLOCATED( qc_av ) )  THEN
-                   ALLOCATE( qc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qc_av = 0.0_wp
-
-             CASE ( 'qg' )
-                IF ( .NOT. ALLOCATED( qg_av ) )  THEN
-                   ALLOCATE( qg_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qg_av = 0.0_wp
-
-             CASE ( 'qi' )
-                IF ( .NOT. ALLOCATED( qi_av ) )  THEN
-                   ALLOCATE( qi_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qi_av = 0.0_wp
-
-             CASE ( 'ql' )
-                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
-                   ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ql_av = 0.0_wp
-
-             CASE ( 'qr' )
-                IF ( .NOT. ALLOCATED( qr_av ) )  THEN
-                   ALLOCATE( qr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qr_av = 0.0_wp
-
-             CASE ( 'qs' )
-                IF ( .NOT. ALLOCATED( qs_av ) )  THEN
-                   ALLOCATE( qs_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qs_av = 0.0_wp
-
-             CASE DEFAULT
-                CONTINUE
-
-          END SELECT
-
-       ELSEIF ( mode == 'sum' )  THEN
-
-          SELECT CASE ( TRIM( variable ) )
-
-             CASE ( 'nc' )
-                IF ( ALLOCATED( nc_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            nc_av(k,j,i) = nc_av(k,j,i) + nc(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'ng' )
-                IF ( ALLOCATED( ng_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            ng_av(k,j,i) = ng_av(k,j,i) + ng(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'ni' )
-                IF ( ALLOCATED( ni_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            ni_av(k,j,i) = ni_av(k,j,i) + ni(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'nr' )
-                IF ( ALLOCATED( nr_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            nr_av(k,j,i) = nr_av(k,j,i) + nr(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'ns' )
-                IF ( ALLOCATED( ns_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            ns_av(k,j,i) = ns_av(k,j,i) + ns(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'prr' )
-                IF ( ALLOCATED( prr_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            prr_av(k,j,i) = prr_av(k,j,i) + prr(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'qc' )
-                IF ( ALLOCATED( qc_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            qc_av(k,j,i) = qc_av(k,j,i) + qc(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'qg' )
-                IF ( ALLOCATED( qg_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            qg_av(k,j,i) = qg_av(k,j,i) + qg(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'qi' )
-                IF ( ALLOCATED( qi_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            qi_av(k,j,i) = qi_av(k,j,i) + qi(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'ql' )
-                IF ( ALLOCATED( ql_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'qr' )
-                IF ( ALLOCATED( qr_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            qr_av(k,j,i) = qr_av(k,j,i) + qr(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'qs' )
-                IF ( ALLOCATED( qs_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            qs_av(k,j,i) = qs_av(k,j,i) + qs(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE DEFAULT
-                CONTINUE
-
-          END SELECT
-
-       ELSEIF ( mode == 'average' )  THEN
-
-          SELECT CASE ( TRIM( variable ) )
-
-             CASE ( 'nc' )
-                IF ( ALLOCATED( nc_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            nc_av(k,j,i) = nc_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'ng' )
-                IF ( ALLOCATED( ng_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            ng_av(k,j,i) = ng_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'ni' )
-                IF ( ALLOCATED( ni_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            ni_av(k,j,i) = ni_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'nr' )
-                IF ( ALLOCATED( nr_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            nr_av(k,j,i) = nr_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'ns' )
-                IF ( ALLOCATED( ns_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            ns_av(k,j,i) = ns_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'prr' )
-                IF ( ALLOCATED( prr_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            prr_av(k,j,i) = prr_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'qc' )
-                IF ( ALLOCATED( qc_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            qc_av(k,j,i) = qc_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'qg' )
-                IF ( ALLOCATED( qg_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            qg_av(k,j,i) = qg_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'qi' )
-                IF ( ALLOCATED( qi_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            qi_av(k,j,i) = qi_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'ql' )
-                IF ( ALLOCATED( ql_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'qr' )
-                IF ( ALLOCATED( qr_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            qr_av(k,j,i) = qr_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'qs' )
-                IF ( ALLOCATED( qs_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            qs_av(k,j,i) = qs_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-
-             CASE DEFAULT
-                CONTINUE
-
-          END SELECT
-
-       ENDIF
-
-    END SUBROUTINE bcm_3d_data_averaging
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define 2D output variables.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bcm_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*), INTENT(INOUT) ::  grid       !< name of vertical grid
-    CHARACTER (LEN=*), INTENT(IN)    ::  mode       !< either 'xy', 'xz' or 'yz'
-    CHARACTER (LEN=*), INTENT(IN)    ::  variable   !< name of variable
-
-    INTEGER(iwp), INTENT(IN) ::  av        !< flag for (non-)average output
-    INTEGER(iwp), INTENT(IN) ::  nzb_do    !< vertical output index (bottom)
-    INTEGER(iwp), INTENT(IN) ::  nzt_do    !< vertical output index (top)
-
-    INTEGER(iwp) ::  flag_nr   !< number of masking flag
-    INTEGER(iwp) ::  i         !< loop index along x-direction
-    INTEGER(iwp) ::  j         !< loop index along y-direction
-    INTEGER(iwp) ::  k         !< loop index along z-direction
-
-    LOGICAL ::  resorted  !< flag if output is already resorted
-
-    LOGICAL, INTENT(INOUT) ::  found   !< flag if output variable is found
-    LOGICAL, INTENT(INOUT) ::  two_d   !< flag parameter that indicates 2D variables
-                                       !<  (horizontal cross sections)
-
-
-    REAL(wp), PARAMETER ::  fill_value = -999.0_wp  !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(INOUT) ::  local_pf !< local
-                                                        !< array to which output data is resorted to
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
-
-    found = .TRUE.
-    resorted = .FALSE.
-!
-!-- Set masking flag for topography for not resorted arrays
-    flag_nr = 0    ! 0 = scalar, 1 = u, 2 = v, 3 = w
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'nc_xy', 'nc_xz', 'nc_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => nc
-          ELSE
-             IF ( .NOT. ALLOCATED( nc_av ) )  THEN
-                ALLOCATE( nc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                nc_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => nc_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'ng_xy', 'ng_xz', 'ng_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ng
-          ELSE
-             IF ( .NOT. ALLOCATED( ng_av ) )  THEN
-                ALLOCATE( ng_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ng_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ng_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'ni_xy', 'ni_xz', 'ni_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ni
-          ELSE
-             IF ( .NOT. ALLOCATED( ni_av ) )  THEN
-                ALLOCATE( ni_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ni_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ni_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'nr_xy', 'nr_xz', 'nr_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => nr
-          ELSE
-             IF ( .NOT. ALLOCATED( nr_av ) )  THEN
-                ALLOCATE( nr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                nr_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => nr_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'ns_xy', 'ns_xz', 'ns_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ns
-          ELSE
-             IF ( .NOT. ALLOCATED( ns_av ) )  THEN
-                ALLOCATE( ns_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ns_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ns_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-
-       CASE ( 'pra*_xy' )        ! 2d-array / integral quantity => no av
-!                CALL exchange_horiz_2d( precipitation_amount )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                local_pf(i,j,nzb+1) =  precipitation_amount(j,i)
-             ENDDO
-          ENDDO
-          precipitation_amount = 0.0_wp   ! reset for next integ. interval
-          resorted = .TRUE.
-          two_d = .TRUE.
-          IF ( mode == 'xy' ) grid = 'zu1'
-
-       CASE ( 'prr_xy', 'prr_xz', 'prr_yz' )
-          IF ( av == 0 )  THEN
-!                   CALL exchange_horiz( prr, nbgp )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb, nzt+1
-                      local_pf(i,j,k) = prr(k,j,i) * hyrho(nzb+1)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( prr_av ) )  THEN
-                ALLOCATE( prr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                prr_av = REAL( fill_value, KIND = wp )
-             ENDIF
-!                   CALL exchange_horiz( prr_av, nbgp )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb, nzt+1
-                      local_pf(i,j,k) = prr_av(k,j,i) * hyrho(nzb+1)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          resorted = .TRUE.
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'qc_xy', 'qc_xz', 'qc_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => qc
-          ELSE
-             IF ( .NOT. ALLOCATED( qc_av ) )  THEN
-                ALLOCATE( qc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                qc_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => qc_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'qg_xy', 'qg_xz', 'qg_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => qg
-          ELSE
-             IF ( .NOT. ALLOCATED( qg_av ) )  THEN
-                ALLOCATE( qg_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                qg_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => qg_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'qi_xy', 'qi_xz', 'qi_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => qi
-          ELSE
-             IF ( .NOT. ALLOCATED( qi_av ) )  THEN
-                ALLOCATE( qi_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                qi_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => qi_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ql
-          ELSE
-             IF ( .NOT. ALLOCATED( ql_av ) )  THEN
-                ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ql_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ql_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'qr_xy', 'qr_xz', 'qr_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => qr
-          ELSE
-             IF ( .NOT. ALLOCATED( qr_av ) )  THEN
-                ALLOCATE( qr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                qr_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => qr_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'qs_xy', 'qs_xz', 'qs_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => qs
-          ELSE
-             IF ( .NOT. ALLOCATED( qs_av ) )  THEN
-                ALLOCATE( qs_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                qs_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => qs_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE DEFAULT
-          found = .FALSE.
-          grid  = 'none'
-
-    END SELECT
-
-    IF ( found .AND. .NOT. resorted )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_do, nzt_do
-                local_pf(i,j,k) = MERGE(                                                           &
-                                         to_be_resorted(k,j,i),                                    &
-                                         REAL( fill_value, KIND = wp ),                            &
-                                         BTEST( wall_flags_total_0(k,j,i), flag_nr )               &
-                                       )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE bcm_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define 3D output variables.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE bcm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*), INTENT(IN) ::  variable   !< name of variable
-
-    INTEGER(iwp), INTENT(IN) ::  av       !< flag for (non-)average output
-    INTEGER(iwp), INTENT(IN) ::  nzb_do   !< lower limit of the data output (usually 0)
-    INTEGER(iwp), INTENT(IN) ::  nzt_do   !< vertical upper limit of the data output
-                                          !< (usually nz_do3d)
-
-    INTEGER(iwp) ::  flag_nr   !< number of masking flag
-    INTEGER(iwp) ::  i         !< loop index along x-direction
-    INTEGER(iwp) ::  j         !< loop index along y-direction
-    INTEGER(iwp) ::  k         !< loop index along z-direction
-
-    LOGICAL      ::  resorted  !< flag if output is already resorted
-
-    LOGICAL, INTENT(INOUT) ::  found     !< flag if output variable is found
-
-    REAL(wp) ::  fill_value = -999.0_wp  !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(INOUT) ::  local_pf   !< local
-                                                        !< array to which output data is resorted to
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
-
-    found = .TRUE.
-    resorted = .FALSE.
-!
-!-- Set masking flag for topography for not resorted arrays
-    flag_nr = 0    ! 0 = scalar, 1 = u, 2 = v, 3 = w
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'nc' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => nc
-          ELSE
-             IF ( .NOT. ALLOCATED( nc_av ) ) THEN
-                ALLOCATE( nc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                nc_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => nc_av
-          ENDIF
-
-       CASE ( 'ng' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ng
-          ELSE
-             IF ( .NOT. ALLOCATED( ng_av ) )  THEN
-                ALLOCATE( ng_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ng_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ng_av
-          ENDIF
-
-       CASE ( 'ni' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ni
-          ELSE
-             IF ( .NOT. ALLOCATED( ni_av ) )  THEN
-                ALLOCATE( ni_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ni_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ni_av
-          ENDIF
-
-       CASE ( 'nr' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => nr
-          ELSE
-             IF ( .NOT. ALLOCATED( nr_av ) )  THEN
-                ALLOCATE( nr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                nr_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => nr_av
-          ENDIF
-
-       CASE ( 'ns' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ns
-          ELSE
-             IF ( .NOT. ALLOCATED( ns_av ) )  THEN
-                ALLOCATE( ns_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ns_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ns_av
-          ENDIF
-
-       CASE ( 'prr' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = prr(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( prr_av ) )  THEN
-                ALLOCATE( prr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                prr_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = prr_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          resorted = .TRUE.
-
-       CASE ( 'qc' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => qc
-          ELSE
-             IF ( .NOT. ALLOCATED( qc_av ) )  THEN
-                ALLOCATE( qc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                qc_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => qc_av
-          ENDIF
-
-       CASE ( 'qg' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => qg
-          ELSE
-             IF ( .NOT. ALLOCATED( qg_av ) )  THEN
-                ALLOCATE( qg_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                qg_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => qg_av
-          ENDIF
-
-       CASE ( 'qi' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => qi
-          ELSE
-             IF ( .NOT. ALLOCATED( qi_av ) )  THEN
-                ALLOCATE( qi_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                qi_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => qi_av
-          ENDIF
-
-       CASE ( 'ql' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ql
-          ELSE
-             IF ( .NOT. ALLOCATED( ql_av ) )  THEN
-                ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ql_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ql_av
-          ENDIF
-
-       CASE ( 'qr' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => qr
-          ELSE
-             IF ( .NOT. ALLOCATED( qr_av ) )  THEN
-                ALLOCATE( qr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                qr_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => qr_av
-          ENDIF
-
-       CASE ( 'qs' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => qs
-          ELSE
-             IF ( .NOT. ALLOCATED( qs_av ) )  THEN
-                ALLOCATE( qs_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                qs_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => qs_av
-          ENDIF
-
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
-
-    IF ( found .AND. .NOT. resorted )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_do, nzt_do
-                local_pf(i,j,k) = MERGE(                                                           &
-                                     to_be_resorted(k,j,i),                                        &
-                                     REAL( fill_value, KIND = wp ),                                &
-                                     BTEST( wall_flags_total_0(k,j,i), flag_nr )                   &
-                                       )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE bcm_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_rrd_global_ftn( found )
-
-
-       USE control_parameters,                                                                     &
-           ONLY: length, restart_string
-
-
-       IMPLICIT NONE
-
-       LOGICAL, INTENT(OUT)  ::  found
-
-
-       found = .TRUE.
-
-       SELECT CASE ( restart_string(1:length) )
-
-          CASE ( 'c_sedimentation' )
-             READ ( 13 )  c_sedimentation
-
-          CASE ( 'bulk_cloud_model' )
-             READ ( 13 )  bulk_cloud_model
-
-          CASE ( 'cloud_scheme' )
-             READ ( 13 )  cloud_scheme
-
-          CASE ( 'cloud_water_sedimentation' )
-             READ ( 13 )  cloud_water_sedimentation
-
-          CASE ( 'collision_turbulence' )
-             READ ( 13 )  collision_turbulence
-
-          CASE ( 'limiter_sedimentation' )
-             READ ( 13 )  limiter_sedimentation
-
-          CASE ( 'nc_const' )
-             READ ( 13 )  nc_const
-
-          CASE ( 'precipitation' )
-             READ ( 13 ) precipitation
-
-          CASE ( 'ventilation_effect' )
-             READ ( 13 )  ventilation_effect
-
-          CASE ( 'na_init' )
-             READ ( 13 )  na_init
-
-          CASE ( 'dry_aerosol_radius' )
-             READ ( 13 )  dry_aerosol_radius
-
-          CASE ( 'sigma_bulk' )
-             READ ( 13 )  sigma_bulk
-
-          CASE ( 'aerosol_bulk' )
-             READ ( 13 )  aerosol_bulk
-
-          CASE ( 'curvature_solution_effects_bulk' )
-             READ ( 13 )  curvature_solution_effects_bulk
-
-          CASE ( 'microphysics_ice_phase' )
-             READ ( 13 )  microphysics_ice_phase
-
-          CASE ( 'ice_crystal_sedimentation' )
-             READ ( 13 )  ice_crystal_sedimentation
-
-          CASE ( 'in_init' )
-             READ ( 13 )  in_init
-
-          CASE ( 'start_ice_microphysics' )
-             READ ( 13 )  start_ice_microphysics
-
-          CASE ( 'snow' )
-             READ ( 13 )  snow
-
-          CASE ( 'graupel' )
-             READ ( 13 )  graupel
-
-          CASE DEFAULT
-
-             found = .FALSE.
-
-       END SELECT
-
-
-    END SUBROUTINE bcm_rrd_global_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_rrd_global_mpi
-
-       CALL rrd_mpi_io( 'c_sedimentation', c_sedimentation )
-       CALL rrd_mpi_io( 'bulk_cloud_model', bulk_cloud_model )
-       CALL rrd_mpi_io( 'cloud_scheme', cloud_scheme )
-       CALL rrd_mpi_io( 'cloud_water_sedimentation', cloud_water_sedimentation )
-       CALL rrd_mpi_io( 'collision_turbulence', collision_turbulence )
-       CALL rrd_mpi_io( 'limiter_sedimentation', limiter_sedimentation )
-       CALL rrd_mpi_io( 'nc_const', nc_const )
-       CALL rrd_mpi_io( 'precipitation', precipitation )
-       CALL rrd_mpi_io( 'ventilation_effect', ventilation_effect )
-       CALL rrd_mpi_io( 'na_init', na_init )
-       CALL rrd_mpi_io( 'dry_aerosol_radius', dry_aerosol_radius )
-       CALL rrd_mpi_io( 'sigma_bulk', sigma_bulk )
-       CALL rrd_mpi_io( 'aerosol_bulk', aerosol_bulk )
-       CALL rrd_mpi_io( 'curvature_solution_effects_bulk', curvature_solution_effects_bulk )
-       CALL rrd_mpi_io( 'start_ice_microphysics', start_ice_microphysics )
-       CALL rrd_mpi_io( 'microphysics_ice_phase', microphysics_ice_phase )
-       CALL rrd_mpi_io( 'in_init', in_init )
-       CALL rrd_mpi_io( 'ice_crystal_sedimentation', ice_crystal_sedimentation )
-       CALL rrd_mpi_io( 'snow', snow )
-       CALL rrd_mpi_io( 'graupel', graupel )
-
-
-    END SUBROUTINE bcm_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, &
-                                  nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d, found )
-
-
-       USE control_parameters
-
-       USE indices
-
-       USE pegrid
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  k               !<
-       INTEGER(iwp) ::  nxlc            !<
-       INTEGER(iwp) ::  nxlf            !<
-       INTEGER(iwp) ::  nxl_on_file     !<
-       INTEGER(iwp) ::  nxrc            !<
-       INTEGER(iwp) ::  nxrf            !<
-       INTEGER(iwp) ::  nxr_on_file     !<
-       INTEGER(iwp) ::  nync            !<
-       INTEGER(iwp) ::  nynf            !<
-       INTEGER(iwp) ::  nyn_on_file     !<
-       INTEGER(iwp) ::  nysc            !<
-       INTEGER(iwp) ::  nysf            !<
-       INTEGER(iwp) ::  nys_on_file     !<
-
-       LOGICAL, INTENT(OUT)  ::  found
-
-       REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d   !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
-
-
-       found = .TRUE.
-
-       SELECT CASE ( restart_string(1:length) )
-
-          CASE ( 'nc' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             nc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'nc_av' )
-             IF ( .NOT. ALLOCATED( nc_av ) )  THEN
-                ALLOCATE( nc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             nc_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'ng' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             ng(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'ng_av' )
-             IF ( .NOT. ALLOCATED( ng_av ) )  THEN
-                ALLOCATE( ng_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             ng_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'ni' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             ni(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'ni_av' )
-             IF ( .NOT. ALLOCATED( ni_av ) )  THEN
-                ALLOCATE( ni_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             ni_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'nr' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             nr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'nr_av' )
-             IF ( .NOT. ALLOCATED( nr_av ) )  THEN
-                ALLOCATE( nr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             nr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'ns' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             ns(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'ns_av' )
-             IF ( .NOT. ALLOCATED( ns_av ) )  THEN
-                ALLOCATE( ns_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             ns_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'precipitation_amount' )
-             IF ( k == 1 )  READ ( 13 )  tmp_2d
-             precipitation_amount(nysc-nbgp:nync+nbgp, nxlc-nbgp:nxrc+nbgp) =                      &
-                tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'prr' )
-             IF ( .NOT. ALLOCATED( prr ) )  THEN
-                ALLOCATE( prr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             prr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                      &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'prr_av' )
-             IF ( .NOT. ALLOCATED( prr_av ) )  THEN
-                ALLOCATE( prr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             prr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                   &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qc' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qg' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qg(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qg_av' )
-             IF ( .NOT. ALLOCATED( qg_av ) )  THEN
-                ALLOCATE( qg_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qg_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qi' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qi(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qi_av' )
-             IF ( .NOT. ALLOCATED( qi_av ) )  THEN
-                ALLOCATE( qi_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qi_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qc_av' )
-             IF ( .NOT. ALLOCATED( qc_av ) )  THEN
-                ALLOCATE( qc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qc_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qf' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qf(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'ql' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             ql(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'ql_av' )
-             IF ( .NOT. ALLOCATED( ql_av ) )  THEN
-                ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             ql_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qr' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qr_av' )
-             IF ( .NOT. ALLOCATED( qr_av ) )  THEN
-                ALLOCATE( qr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qs' )
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qs(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'qs_av' )
-             IF ( .NOT. ALLOCATED( qs_av ) )  THEN
-                ALLOCATE( qs_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             qs_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-!
-          CASE DEFAULT
-
-             found = .FALSE.
-
-          END SELECT
-
-
-    END SUBROUTINE bcm_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_rrd_local_mpi
-
-       LOGICAL ::  array_found  !<
-
-
-       CALL rd_mpi_io_check_array( 'prr' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( prr ) )  ALLOCATE( prr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'prr', prr )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'prr_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( prr_av ) )  ALLOCATE( prr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'prr_av', prr_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'precipitation_amount' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( precipitation_amount ) )  THEN
-             ALLOCATE( precipitation_amount(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          CALL rrd_mpi_io( 'precipitation_amount', precipitation_amount )
-       ENDIF
-
-       CALL rrd_mpi_io( 'qf', qf )
-
-       CALL rrd_mpi_io( 'ql', ql )
-
-       CALL rd_mpi_io_check_array( 'ql_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( ql_av ) )  ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'ql_av', ql_av )
-       ENDIF
-
-       CALL rrd_mpi_io( 'qc', qc )
-
-       CALL rd_mpi_io_check_array( 'qc_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( qc_av ) )  ALLOCATE( qc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'qc_av', qc_av )
-       ENDIF
-
-       IF ( microphysics_morrison )  THEN
-
-          CALL rrd_mpi_io( 'nc', nc )
-
-          CALL rd_mpi_io_check_array( 'nc_av' , found = array_found )
-          IF ( array_found )  THEN
-             IF ( .NOT. ALLOCATED( nc_av ) )  ALLOCATE( nc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             CALL rrd_mpi_io( 'nc_av', nc_av )
-          ENDIF
-
-       ENDIF
-
-       IF ( microphysics_seifert )  THEN
-
-          CALL rrd_mpi_io( 'nr', nr )
-
-          CALL rd_mpi_io_check_array( 'nr_av' , found = array_found )
-          IF ( array_found )  THEN
-             IF ( .NOT. ALLOCATED( nr_av ) )  ALLOCATE( nr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             CALL rrd_mpi_io( 'nr_av', nr_av )
-          ENDIF
-
-          CALL rrd_mpi_io( 'qr', qr )
-
-          CALL rd_mpi_io_check_array( 'qr_av' , found = array_found )
-          IF ( array_found )  THEN
-             IF ( .NOT. ALLOCATED( qr_av ) )  ALLOCATE( qr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             CALL rrd_mpi_io( 'qr_av', qr_av )
-          ENDIF
-
-       ENDIF
-
-       IF ( microphysics_ice_phase )  THEN
-
-          CALL rrd_mpi_io( 'ni', ni )
-
-          CALL rd_mpi_io_check_array( 'ni_av' , found = array_found )
-          IF ( array_found )  THEN
-             IF ( .NOT. ALLOCATED( ni_av ) )  ALLOCATE( ni_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             CALL rrd_mpi_io( 'ni_av', ni_av )
-          ENDIF
-
-          CALL rrd_mpi_io( 'qi', qi )
-
-          CALL rd_mpi_io_check_array( 'qi_av' , found = array_found )
-          IF ( array_found )  THEN
-             IF ( .NOT. ALLOCATED( qi_av ) )  ALLOCATE( qi_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             CALL rrd_mpi_io( 'qi_av', qi_av )
-          ENDIF
-
-          IF ( snow .OR. graupel )  THEN
-             CALL rrd_mpi_io( 'ng', ng )
-             CALL rrd_mpi_io( 'ns', ns )
-             CALL rrd_mpi_io( 'qg', qg )
-             CALL rrd_mpi_io( 'qs', qs )
-
-             CALL rd_mpi_io_check_array( 'ng_av' , found = array_found )
-             IF ( array_found )  THEN
-                IF ( .NOT. ALLOCATED( ng_av ) )  ALLOCATE( ng_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                CALL rrd_mpi_io( 'ng_av', ng_av )
-             ENDIF
-
-             CALL rd_mpi_io_check_array( 'ns_av' , found = array_found )
-             IF ( array_found )  THEN
-                IF ( .NOT. ALLOCATED( ns_av ) )  ALLOCATE( ns_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                CALL rrd_mpi_io( 'ns_av', ns_av )
-             ENDIF
-
-             CALL rd_mpi_io_check_array( 'qg_av' , found = array_found )
-             IF ( array_found )  THEN
-                IF ( .NOT. ALLOCATED( qg_av ) )  ALLOCATE( qg_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                CALL rrd_mpi_io( 'qg_av', qg_av )
-             ENDIF
-
-             CALL rd_mpi_io_check_array( 'qs_av' , found = array_found )
-             IF ( array_found )  THEN
-                IF ( .NOT. ALLOCATED( qs_av ) )  ALLOCATE( qs_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                CALL rrd_mpi_io( 'qs_av', qs_av )
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-
-    END SUBROUTINE bcm_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data for the bulk cloud module.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_wrd_global
-
-
-       IMPLICIT NONE
-
-
-       IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-          CALL wrd_write_string( 'c_sedimentation' )
-          WRITE ( 14 )  c_sedimentation
-
-          CALL wrd_write_string( 'bulk_cloud_model' )
-          WRITE ( 14 )  bulk_cloud_model
-
-          CALL wrd_write_string( 'cloud_scheme' )
-          WRITE ( 14 )  cloud_scheme
-
-          CALL wrd_write_string( 'cloud_water_sedimentation' )
-          WRITE ( 14 )  cloud_water_sedimentation
-
-          CALL wrd_write_string( 'collision_turbulence' )
-          WRITE ( 14 )  collision_turbulence
-
-          CALL wrd_write_string( 'limiter_sedimentation' )
-          WRITE ( 14 )  limiter_sedimentation
-
-          CALL wrd_write_string( 'nc_const' )
-          WRITE ( 14 )  nc_const
-
-          CALL wrd_write_string( 'precipitation' )
-          WRITE ( 14 )  precipitation
-
-          CALL wrd_write_string( 'ventilation_effect' )
-          WRITE ( 14 )  ventilation_effect
-
-          CALL wrd_write_string( 'na_init' )
-          WRITE ( 14 )  na_init
-
-          CALL wrd_write_string( 'dry_aerosol_radius' )
-          WRITE ( 14 )  dry_aerosol_radius
-
-          CALL wrd_write_string( 'sigma_bulk' )
-          WRITE ( 14 )  sigma_bulk
-
-          CALL wrd_write_string( 'aerosol_bulk' )
-          WRITE ( 14 )  aerosol_bulk
-
-          CALL wrd_write_string( 'curvature_solution_effects_bulk' )
-          WRITE ( 14 )  curvature_solution_effects_bulk
-
-          CALL wrd_write_string( 'start_ice_microphysics' )
-          WRITE ( 14 )  start_ice_microphysics
-
-          CALL wrd_write_string( 'microphysics_ice_phase' )
-          WRITE ( 14 )  microphysics_ice_phase
-
-          CALL wrd_write_string( 'in_init' )
-          WRITE ( 14 )  in_init
-
-          CALL wrd_write_string( 'ice_crystal_sedimentation' )
-          WRITE ( 14 )  ice_crystal_sedimentation
-
-          CALL wrd_write_string( 'snow' )
-          WRITE ( 14 )  snow
-
-          CALL wrd_write_string( 'graupel' )
-          WRITE ( 14 )  graupel
-
-       ELSEIF ( TRIM( restart_data_format_output(1:3) ) == 'mpi' )  THEN
-
-          CALL wrd_mpi_io( 'c_sedimentation', c_sedimentation )
-          CALL wrd_mpi_io( 'bulk_cloud_model', bulk_cloud_model )
-          CALL wrd_mpi_io( 'cloud_scheme', cloud_scheme )
-          CALL wrd_mpi_io( 'cloud_water_sedimentation', cloud_water_sedimentation )
-          CALL wrd_mpi_io( 'collision_turbulence', collision_turbulence )
-          CALL wrd_mpi_io( 'limiter_sedimentation', limiter_sedimentation )
-          CALL wrd_mpi_io( 'nc_const', nc_const )
-          CALL wrd_mpi_io( 'precipitation', precipitation )
-          CALL wrd_mpi_io( 'ventilation_effect', ventilation_effect )
-          CALL wrd_mpi_io( 'na_init', na_init )
-          CALL wrd_mpi_io( 'dry_aerosol_radius', dry_aerosol_radius )
-          CALL wrd_mpi_io( 'sigma_bulk', sigma_bulk )
-          CALL wrd_mpi_io( 'aerosol_bulk', aerosol_bulk )
-          CALL wrd_mpi_io( 'curvature_solution_effects_bulk', curvature_solution_effects_bulk )
-          CALL wrd_mpi_io( 'start_ice_microphysics', start_ice_microphysics )
-          CALL wrd_mpi_io( 'microphysics_ice_phase', microphysics_ice_phase )
-          CALL wrd_mpi_io( 'in_init', in_init )
-          CALL wrd_mpi_io( 'ice_crystal_sedimentation', ice_crystal_sedimentation )
-          CALL wrd_mpi_io( 'snow', snow )
-          CALL wrd_mpi_io( 'graupel', graupel )
-
-       ENDIF
-
-    END SUBROUTINE bcm_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data for the bulk cloud module.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE bcm_wrd_local
-
-
-       IMPLICIT NONE
-
-
-       IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-          IF ( ALLOCATED( prr ) )  THEN
-             CALL wrd_write_string( 'prr' )
-             WRITE ( 14 )  prr
-          ENDIF
-
-          IF ( ALLOCATED( prr_av ) )  THEN
-             CALL wrd_write_string( 'prr_av' )
-             WRITE ( 14 )  prr_av
-          ENDIF
-
-          IF ( ALLOCATED( precipitation_amount ) )  THEN
-             CALL wrd_write_string( 'precipitation_amount' )
-             WRITE ( 14 )  precipitation_amount
-          ENDIF
-
-          CALL wrd_write_string( 'qf' )
-          WRITE ( 14 )  qf
-
-          CALL wrd_write_string( 'ql' )
-          WRITE ( 14 )  ql
-
-          IF ( ALLOCATED( ql_av ) )  THEN
-             CALL wrd_write_string( 'ql_av' )
-             WRITE ( 14 )  ql_av
-          ENDIF
-
-          CALL wrd_write_string( 'qc' )
-          WRITE ( 14 )  qc
-
-          IF ( ALLOCATED( qc_av ) )  THEN
-             CALL wrd_write_string( 'qc_av' )
-             WRITE ( 14 )  qc_av
-          ENDIF
-
-          IF ( microphysics_morrison )  THEN
-
-             CALL wrd_write_string( 'nc' )
-             WRITE ( 14 )  nc
-
-             IF ( ALLOCATED( nc_av ) )  THEN
-                CALL wrd_write_string( 'nc_av' )
-                WRITE ( 14 )  nc_av
-             ENDIF
-
-          ENDIF
-
-          IF ( microphysics_ice_phase )  THEN
-
-             CALL wrd_write_string( 'ni' )
-             WRITE ( 14 )  ni
-
-             IF ( ALLOCATED( ni_av ) )  THEN
-                CALL wrd_write_string( 'ni_av' )
-                WRITE ( 14 )  ni_av
-             ENDIF
-
-             CALL wrd_write_string( 'qi' )
-             WRITE ( 14 )  qi
-
-             IF ( ALLOCATED( qi_av ) )  THEN
-                CALL wrd_write_string( 'qi_av' )
-                WRITE ( 14 )  qi_av
-             ENDIF
-
-             IF ( snow  .OR.  graupel  )  THEN
-                CALL wrd_write_string( 'ng' )
-                WRITE ( 14 )  ng
-                CALL wrd_write_string( 'ns' )
-                WRITE ( 14 )  ns
-                CALL wrd_write_string( 'qg' )
-                WRITE ( 14 )  qg
-                CALL wrd_write_string( 'qs' )
-                WRITE ( 14 )  qs
-
-                IF ( ALLOCATED( ng_av ) )  THEN
-                   CALL wrd_write_string( 'ng_av' )
-                   WRITE ( 14 )  ng_av
-                ENDIF
-                IF ( ALLOCATED( ns_av ) )  THEN
-                   CALL wrd_write_string( 'ns_av' )
-                   WRITE ( 14 )  ns_av
-                ENDIF
-                IF ( ALLOCATED( qg_av ) )  THEN
-                   CALL wrd_write_string( 'qg_av' )
-                   WRITE ( 14 )  qg_av
-                ENDIF
-                IF ( ALLOCATED( qs_av ) )  THEN
-                   CALL wrd_write_string( 'qs_av' )
-                   WRITE ( 14 )  qs_av
-                ENDIF
-             ENDIF
-
-          ENDIF
-
-
-          IF ( microphysics_seifert )  THEN
-
-             CALL wrd_write_string( 'nr' )
-             WRITE ( 14 )  nr
-
-             IF ( ALLOCATED( nr_av ) )  THEN
-                CALL wrd_write_string( 'nr_av' )
-                WRITE ( 14 )  nr_av
-             ENDIF
-
-             CALL wrd_write_string( 'qr' )
-             WRITE ( 14 )  qr
-
-             IF ( ALLOCATED( qr_av ) )  THEN
-                CALL wrd_write_string( 'qr_av' )
-                WRITE ( 14 )  qr_av
-             ENDIF
-
-          ENDIF
-
-       ELSEIF ( TRIM( restart_data_format_output(1:3) ) == 'mpi' )  THEN
-
-          IF ( ALLOCATED( prr ) )  CALL wrd_mpi_io( 'prr', prr )
-          IF ( ALLOCATED( prr_av ) )  CALL wrd_mpi_io( 'prr_av', prr_av )
-          IF ( ALLOCATED( precipitation_amount ) )  THEN
-             CALL wrd_mpi_io( 'precipitation_amount', precipitation_amount )
-          ENDIF
-          CALL wrd_mpi_io( 'qf', qf )
-          CALL wrd_mpi_io( 'ql', ql )
-          IF ( ALLOCATED( ql_av ) )  CALL wrd_mpi_io( 'ql_av', ql_av )
-          CALL wrd_mpi_io( 'qc', qc )
-          IF ( ALLOCATED( qc_av ) )  CALL wrd_mpi_io( 'qc_av', qc_av )
-          IF ( microphysics_morrison )  THEN
-             CALL wrd_mpi_io( 'nc', nc )
-             IF ( ALLOCATED( nc_av ) )  CALL wrd_mpi_io( 'nc_av', nc_av )
-          ENDIF
-          IF ( microphysics_seifert )  THEN
-             CALL wrd_mpi_io( 'nr', nr )
-             IF ( ALLOCATED( nr_av ) )  CALL wrd_mpi_io( 'nr_av', nr_av )
-             CALL wrd_mpi_io( 'qr', qr )
-             IF ( ALLOCATED( qr_av ) )  CALL wrd_mpi_io( 'qr_av', qr_av )
-          ENDIF
-          IF ( microphysics_ice_phase )  THEN
-             CALL wrd_mpi_io( 'ni', ni )
-             IF ( ALLOCATED( ni_av ) )  CALL wrd_mpi_io( 'ni_av', ni_av )
-             CALL wrd_mpi_io( 'qi', qi )
-             IF ( ALLOCATED( qi_av ) )  CALL wrd_mpi_io( 'qi_av', qi_av )
-             IF ( snow  .OR.  graupel  )  THEN
-                CALL wrd_mpi_io( 'ng', ng )
-                CALL wrd_mpi_io( 'ns', ns )
-                CALL wrd_mpi_io( 'qg', qg )
-                CALL wrd_mpi_io( 'qs', qs )
-                IF ( ALLOCATED( ng_av ) )  CALL wrd_mpi_io( 'ng_av', ng_av )
-                IF ( ALLOCATED( ns_av ) )  CALL wrd_mpi_io( 'ns_av', ns_av )
-                IF ( ALLOCATED( qg_av ) )  CALL wrd_mpi_io( 'qg_av', qg_av )
-                IF ( ALLOCATED( qs_av ) )  CALL wrd_mpi_io( 'qs_av', qs_av )
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-    END SUBROUTINE bcm_wrd_local
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> In this routine the cloued coefficients as given in Table 1 in SB2006 are defined. Right now a
-!> namelist steering is not implemented. Accordingly, values must be directly changed in the code.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE define_cloud_coefficients
-!
-!--    Define values corresponding Table 1 in SB2006 for cloud species
-       cloud_species%cloud%a     = 0.124_wp
-       cloud_species%cloud%b     = 1.0_wp / 3.0_wp
-       cloud_species%cloud%alpha = 3.75E5_wp
-       cloud_species%cloud%beta  = 2.0_wp / 3.0_wp
-       cloud_species%cloud%nu    = 1.0_wp
-       cloud_species%cloud%mu    = 1.0_wp
-       cloud_species%cloud%a_ven = 1.0_wp
-       cloud_species%cloud%b_ven = 1.0_wp
-       cloud_species%cloud%cap   = 1.0_wp
-       cloud_species%cloud%x_min = 4.2E-15_wp
-       cloud_species%cloud%x_max = 2.6E-10_wp
-!
-!--    Define values corresponding Table 1 in SB2006 for cloud species
-       cloud_species%rain%a     = 0.124_wp
-       cloud_species%rain%b     = 1.0_wp / 3.0_wp
-       cloud_species%rain%alpha = 159.0_wp
-       cloud_species%rain%beta  = 0.266_wp
-       cloud_species%rain%nu    = -2.0_wp / 3.0_wp
-       cloud_species%rain%mu    = 1.0_wp / 3.0_wp
-       cloud_species%rain%a_ven = 1.0_wp
-       cloud_species%rain%b_ven = 1.0_wp
-       cloud_species%rain%cap   = 1.0_wp
-       cloud_species%rain%x_min = 2.6E-10_wp
-       cloud_species%rain%x_max = 5.0E-6_wp
-!
-!--    Define values corresponding Table 1 in SB2006 for graupel species
-       cloud_species%graupel%a        = 0.19_wp
-       cloud_species%graupel%b        = 0.323_wp
-       cloud_species%graupel%alpha    = 40.0_wp
-       cloud_species%graupel%beta     = 0.23_wp
-       cloud_species%graupel%nu       = 1.0_wp
-       cloud_species%graupel%mu       = 1.0_wp / 3.0_wp
-       cloud_species%graupel%a_ven    = 0.78_wp
-       cloud_species%graupel%b_ven    = 0.308_wp
-       cloud_species%graupel%cap      = 2.0_wp
-       cloud_species%graupel%x_min    = 2.6E-10_wp
-       cloud_species%graupel%x_max    = 1.0E-4_wp
-       cloud_species%graupel%coll_eff = 0.8_wp
-!
-!--    Define values corresponding Table 1 in SB2006 for ice species
-       cloud_species%ice%a        = 0.217_wp
-       cloud_species%ice%b        = 0.302_wp
-       cloud_species%ice%alpha    = 317.0_wp
-       cloud_species%ice%beta     = 0.363_wp
-       cloud_species%ice%nu       = 1.0_wp
-       cloud_species%ice%mu       = 1.0_wp / 3.0_wp
-       cloud_species%ice%sigma_v  = 0.2_wp
-       cloud_species%ice%a_ven    = 0.86_wp
-       cloud_species%ice%b_ven    = 0.28_wp
-       cloud_species%ice%cap      = 2.0_wp
-       cloud_species%ice%x_min    = 1.0E-12_wp
-       cloud_species%ice%x_max    = 1.0E-7_wp
-       cloud_species%ice%coll_eff = 0.8_wp
-!
-!--    Define values corresponding Table 1 in SB2006 for snow species
-       cloud_species%snow%a        = 8.156_wp
-       cloud_species%snow%b        = 0.526_wp
-       cloud_species%snow%alpha    = 27.7_wp
-       cloud_species%snow%beta     = 0.216_wp
-       cloud_species%snow%nu       = 1.0_wp
-       cloud_species%snow%mu       = 1.0_wp / 3.0_wp
-       cloud_species%snow%sigma_v  = 0.2_wp
-       cloud_species%snow%a_ven    = 0.78_wp
-       cloud_species%snow%b_ven    = 0.308_wp
-       cloud_species%snow%cap      = 2.0_wp
-       cloud_species%snow%x_min    = 1.73E-9_wp
-       cloud_species%snow%x_max    = 1.0E-7_wp
-       cloud_species%snow%coll_eff = 0.8_wp
-
-    END SUBROUTINE define_cloud_coefficients
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> In this routine the collection integrals are calculated at the beginning of the simulation to
-!> avoid the calculation at each timestep. This dimensionless constants, depending on the diameter-
-!> mass and velocity-mass relations of particle type "a" and "b". Quations are given in Seifert and
-!> Beheng, 2006 (Appendix C Eq. 90 - 94 ).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE init_collision_integrals
-
-       REAL(wp) ::  delta_n                     !< collision integral
-       REAL(wp) ::  theta_n                     !< collision integral
-
-       REAL(wp) ::  delta_n_11                  !< collision integral
-       REAL(wp) ::  delta_n_12                  !< collision integral
-       REAL(wp) ::  delta_n_22                  !< collision integral
-       REAL(wp) ::  theta_n_11                  !< collision integral
-       REAL(wp) ::  theta_n_12                  !< collision integral
-       REAL(wp) ::  theta_n_22                  !< collision integral
-       REAL(wp) ::  delta_q_11                  !< collision integral
-       REAL(wp) ::  delta_q_12                  !< collision integral
-       REAL(wp) ::  delta_q_22                  !< collision integral
-       REAL(wp) ::  theta_q_11                  !< collision integral
-       REAL(wp) ::  theta_q_12                  !< collision integral
-       REAL(wp) ::  theta_q_22                  !< collision integral
-!
-!--    Calculate collision integrals, last argument is always the moment:
-!--    0-th moment: number concentration
-!--    1-th moment: mass mixing ratio
-!
-!---   For graupel selfcollection
-       delta_n_11 = collision_integral_delta_b(cloud_species%graupel, 0)
-       theta_n_11 = collision_integral_theta_b(cloud_species%graupel, 0)
-       delta_n_12 = collision_integral_delta_ba(cloud_species%graupel, cloud_species%graupel, 0)
-       theta_n_12 = collision_integral_theta_ba(cloud_species%graupel, cloud_species%graupel, 0)
-
-       delta_n = ( 2.0_wp * delta_n_11 + delta_n_12 )
-       theta_n = ( 2.0_wp * theta_n_11 - theta_n_12 )**0.5
-
-       coll_coeff_graupel_self  = pi / 8.0_wp * delta_n * theta_n
-!
-!--    For snow selfcollection
-       delta_n_11 = collision_integral_delta_b(cloud_species%snow, 0)
-       theta_n_11 = collision_integral_theta_b(cloud_species%snow, 0)
-       delta_n_12 = collision_integral_delta_ba(cloud_species%snow, cloud_species%snow, 0)
-       theta_n_12 = collision_integral_theta_ba(cloud_species%snow, cloud_species%snow, 0)
-
-       coll_coeff_snow_self_delta = ( 2.0_wp * delta_n_11 + delta_n_12 )
-       coll_coeff_snow_self_theta = ( 2.0_wp * theta_n_11 - theta_n_12 )
-!
-!--    Ice selfcollection
-       delta_n_11 = collision_integral_delta_b(cloud_species%ice, 0)
-       delta_n_22 = collision_integral_delta_b(cloud_species%ice, 0)
-       delta_q_11 = collision_integral_delta_b(cloud_species%ice, 0)
-       delta_q_22 = collision_integral_delta_b(cloud_species%ice, 1)
-       delta_n_12 = collision_integral_delta_ba(cloud_species%ice, cloud_species%ice, 0)
-       delta_q_12 = collision_integral_delta_ba(cloud_species%ice, cloud_species%ice, 1)
-
-       theta_n_11 = collision_integral_theta_b(cloud_species%ice, 0)
-       theta_n_12 = collision_integral_theta_b(cloud_species%ice, 0)
-       theta_n_22 = collision_integral_theta_b(cloud_species%ice, 0)
-       theta_q_11 = collision_integral_theta_b(cloud_species%ice, 1)
-       theta_q_12 = collision_integral_theta_ba(cloud_species%ice, cloud_species%ice, 0)
-       theta_q_22 = collision_integral_theta_ba(cloud_species%ice, cloud_species%ice, 1)
-
-       coll_coeff_ice_self_delta_n = delta_n_11 + delta_n_12 + delta_n_22
-       coll_coeff_ice_self_delta_q = delta_q_11 + delta_q_12 + delta_q_22
-       coll_coeff_ice_self_theta_n = theta_n_11 - theta_n_12 + theta_n_22
-       coll_coeff_ice_self_theta_q = theta_q_11 - theta_q_12 + theta_q_22
-!
-!--    For particle particle collection ( a + b -> a ), Here: graupel + ice -> graupel
-       coll_graupel_ice_delta_n_aa = collision_integral_delta_b(cloud_species%graupel, 0)
-       coll_graupel_ice_delta_n_bb = collision_integral_delta_b(cloud_species%ice, 0)
-       coll_graupel_ice_delta_n_ab = collision_integral_delta_ba(cloud_species%graupel, cloud_species%ice, 0)
-       coll_graupel_ice_delta_q_aa = collision_integral_delta_b(cloud_species%graupel, 0) !@TODO: unclear why 0 here, but checked with ICON code
-       coll_graupel_ice_delta_q_bb = collision_integral_delta_b(cloud_species%ice, 1)
-       coll_graupel_ice_delta_q_ab = collision_integral_delta_ba(cloud_species%graupel, cloud_species%ice, 1)
-       coll_graupel_ice_theta_n_aa = collision_integral_theta_b(cloud_species%graupel, 0)
-       coll_graupel_ice_theta_n_bb = collision_integral_theta_b(cloud_species%ice, 0)
-       coll_graupel_ice_theta_n_ab = collision_integral_theta_ba(cloud_species%graupel, cloud_species%ice, 0)
-       coll_graupel_ice_theta_q_aa = collision_integral_theta_b(cloud_species%graupel, 0) !@TODO: unclear why 0 here, but checked with ICON code
-       coll_graupel_ice_theta_q_bb = collision_integral_theta_b(cloud_species%ice, 1)
-       coll_graupel_ice_theta_q_ab = collision_integral_theta_ba(cloud_species%graupel, cloud_species%ice, 1)
-!
-!--    For particle particle collection ( a + b -> a ), Here: snow + ice -> snow
-       coll_snow_ice_delta_n_aa = collision_integral_delta_b(cloud_species%snow, 0)
-       coll_snow_ice_delta_n_bb = collision_integral_delta_b(cloud_species%ice, 0)
-       coll_snow_ice_delta_n_ab = collision_integral_delta_ba(cloud_species%snow, cloud_species%ice, 0)
-       coll_snow_ice_delta_q_aa = collision_integral_delta_b(cloud_species%snow, 0) !@TODO: unclear why 0 here, but checked with ICON code
-       coll_snow_ice_delta_q_bb = collision_integral_delta_b(cloud_species%ice, 1)
-       coll_snow_ice_delta_q_ab = collision_integral_delta_ba(cloud_species%snow, cloud_species%ice, 1)
-       coll_snow_ice_theta_n_aa = collision_integral_theta_b(cloud_species%snow, 0)
-       coll_snow_ice_theta_n_bb = collision_integral_theta_b(cloud_species%ice, 0)
-       coll_snow_ice_theta_n_ab = collision_integral_theta_ba(cloud_species%snow, cloud_species%ice, 0)
-       coll_snow_ice_theta_q_aa = collision_integral_theta_b(cloud_species%snow, 0) !@TODO: unclear why 0 here, but checked with ICON code
-       coll_snow_ice_theta_q_bb = collision_integral_theta_b(cloud_species%ice, 1)
-       coll_snow_ice_theta_q_ab = collision_integral_theta_ba(cloud_species%snow, cloud_species%ice, 1)
-!
-!--    For particle particle collection ( a + b -> a ), Here: graupel + snow -> graupel
-       coll_graupel_snow_delta_n_aa = collision_integral_delta_b(cloud_species%graupel, 0)
-       coll_graupel_snow_delta_n_bb = collision_integral_delta_b(cloud_species%snow, 0)
-       coll_graupel_snow_delta_n_ab = collision_integral_delta_ba(cloud_species%graupel, cloud_species%snow, 0)
-       coll_graupel_snow_delta_q_aa = collision_integral_delta_b(cloud_species%graupel, 0) !@TODO: unclear why 0 here, but checked with ICON code
-       coll_graupel_snow_delta_q_bb = collision_integral_delta_b(cloud_species%snow, 1)
-       coll_graupel_snow_delta_q_ab = collision_integral_delta_ba(cloud_species%graupel, cloud_species%snow, 1)
-       coll_graupel_snow_theta_n_aa = collision_integral_theta_b(cloud_species%graupel, 0)
-       coll_graupel_snow_theta_n_bb = collision_integral_theta_b(cloud_species%snow, 0)
-       coll_graupel_snow_theta_n_ab = collision_integral_theta_ba(cloud_species%graupel, cloud_species%snow, 0)
-       coll_graupel_snow_theta_q_aa = collision_integral_theta_b(cloud_species%graupel, 0) !@TODO: unclear why 0 here, but checked with ICON code
-       coll_graupel_snow_theta_q_bb = collision_integral_theta_b(cloud_species%snow, 1)
-       coll_graupel_snow_theta_q_ab = collision_integral_theta_ba(cloud_species%graupel, cloud_species%snow, 1)
-!
-!--    For graupel - cloud riming
-       rime_graupel_cloud_delta_n_aa = collision_integral_delta_b(cloud_species%graupel, 0)
-       rime_graupel_cloud_delta_n_ab = collision_integral_delta_ba(cloud_species%graupel, cloud_species%cloud, 0)
-       rime_graupel_cloud_delta_n_bb = collision_integral_delta_b(cloud_species%cloud, 0)
-       rime_graupel_cloud_delta_q_aa = collision_integral_delta_b(cloud_species%graupel, 1) ! mass weighted
-       rime_graupel_cloud_delta_q_ab = collision_integral_delta_ba(cloud_species%graupel, cloud_species%cloud, 1)
-       rime_graupel_cloud_delta_q_ba = collision_integral_delta_ba(cloud_species%cloud, cloud_species%graupel, 1)
-       rime_graupel_cloud_delta_q_bb = collision_integral_delta_b(cloud_species%cloud, 1)
-
-       rime_graupel_cloud_theta_n_aa = collision_integral_theta_b(cloud_species%graupel, 0)
-       rime_graupel_cloud_theta_n_ab = collision_integral_theta_ba(cloud_species%graupel, cloud_species%cloud, 0)
-       rime_graupel_cloud_theta_n_bb = collision_integral_theta_b(cloud_species%cloud, 0)
-       rime_graupel_cloud_theta_q_aa = collision_integral_theta_b(cloud_species%graupel, 1) ! mass weighted
-       rime_graupel_cloud_theta_q_ab = collision_integral_theta_ba(cloud_species%graupel, cloud_species%cloud, 1)
-       rime_graupel_cloud_theta_q_ba = collision_integral_theta_ba(cloud_species%cloud, cloud_species%graupel, 1)
-       rime_graupel_cloud_theta_q_bb = collision_integral_theta_b(cloud_species%cloud, 1)
-!
-!--    For graupel - rain riming
-       rime_graupel_rain_delta_n_aa = collision_integral_delta_b(cloud_species%graupel, 0)
-       rime_graupel_rain_delta_n_ab = collision_integral_delta_ba(cloud_species%graupel, cloud_species%rain, 0)
-       rime_graupel_rain_delta_n_bb = collision_integral_delta_b(cloud_species%rain, 0)
-       rime_graupel_rain_delta_q_aa = collision_integral_delta_b(cloud_species%graupel, 1) ! mass weighted
-       rime_graupel_rain_delta_q_ab = collision_integral_delta_ba(cloud_species%graupel, cloud_species%rain, 1)
-       rime_graupel_rain_delta_q_ba = collision_integral_delta_ba(cloud_species%rain, cloud_species%graupel, 1)
-       rime_graupel_rain_delta_q_bb = collision_integral_delta_b(cloud_species%rain, 1)
-
-       rime_graupel_rain_theta_n_aa = collision_integral_theta_b(cloud_species%graupel, 0)
-       rime_graupel_rain_theta_n_ab = collision_integral_theta_ba(cloud_species%graupel, cloud_species%rain, 0)
-       rime_graupel_rain_theta_n_bb = collision_integral_theta_b(cloud_species%rain, 0)
-       rime_graupel_rain_theta_q_aa = collision_integral_theta_b(cloud_species%graupel, 1) ! mass weighted
-       rime_graupel_rain_theta_q_ab = collision_integral_theta_ba(cloud_species%graupel, cloud_species%rain, 1)
-       rime_graupel_rain_theta_q_ba = collision_integral_theta_ba(cloud_species%rain, cloud_species%graupel, 1)
-       rime_graupel_rain_theta_q_bb = collision_integral_theta_b(cloud_species%rain, 1)
-!
-!--    For ice - cloud riming
-       rime_ice_cloud_delta_n_aa = collision_integral_delta_b(cloud_species%ice, 0)
-       rime_ice_cloud_delta_n_ab = collision_integral_delta_ba(cloud_species%ice, cloud_species%cloud, 0)
-       rime_ice_cloud_delta_n_bb = collision_integral_delta_b(cloud_species%cloud, 0)
-       rime_ice_cloud_delta_q_aa = collision_integral_delta_b(cloud_species%ice, 1) ! mass weighted
-       rime_ice_cloud_delta_q_ab = collision_integral_delta_ba(cloud_species%ice, cloud_species%cloud, 1)
-       rime_ice_cloud_delta_q_ba = collision_integral_delta_ba(cloud_species%cloud, cloud_species%ice, 1)
-       rime_ice_cloud_delta_q_bb = collision_integral_delta_b(cloud_species%cloud, 1)
-
-       rime_ice_cloud_theta_n_aa = collision_integral_theta_b(cloud_species%ice, 0)
-       rime_ice_cloud_theta_n_ab = collision_integral_theta_ba(cloud_species%ice, cloud_species%cloud, 0)
-       rime_ice_cloud_theta_n_bb = collision_integral_theta_b(cloud_species%cloud, 0)
-       rime_ice_cloud_theta_q_aa = collision_integral_theta_b(cloud_species%ice, 1) ! mass weighted
-       rime_ice_cloud_theta_q_ab = collision_integral_theta_ba(cloud_species%ice, cloud_species%cloud, 1)
-       rime_ice_cloud_theta_q_ba = collision_integral_theta_ba(cloud_species%cloud, cloud_species%ice, 1)
-       rime_ice_cloud_theta_q_bb = collision_integral_theta_b(cloud_species%cloud, 1)
-!
-!--    For ice - rain riming
-       rime_ice_rain_delta_n_aa = collision_integral_delta_b(cloud_species%ice, 0)
-       rime_ice_rain_delta_n_ab = collision_integral_delta_ba(cloud_species%ice, cloud_species%rain, 0)
-       rime_ice_rain_delta_n_bb = collision_integral_delta_b(cloud_species%rain, 0)
-       rime_ice_rain_delta_q_aa = collision_integral_delta_b(cloud_species%ice, 1) ! mass weighted
-       rime_ice_rain_delta_q_ab = collision_integral_delta_ba(cloud_species%ice, cloud_species%rain, 1)
-       rime_ice_rain_delta_q_ba = collision_integral_delta_ba(cloud_species%rain, cloud_species%ice, 1)
-       rime_ice_rain_delta_q_bb = collision_integral_delta_b(cloud_species%rain, 1)
-       rime_ice_rain_theta_n_aa = collision_integral_theta_b(cloud_species%ice, 0)
-       rime_ice_rain_theta_n_ab = collision_integral_theta_ba(cloud_species%ice, cloud_species%rain, 0)
-       rime_ice_rain_theta_n_bb = collision_integral_theta_b(cloud_species%rain, 0)
-       rime_ice_rain_theta_q_aa = collision_integral_theta_b(cloud_species%ice, 1) ! mass weighted
-       rime_ice_rain_theta_q_ab = collision_integral_theta_ba(cloud_species%ice, cloud_species%rain, 1)
-       rime_ice_rain_theta_q_ba = collision_integral_theta_ba(cloud_species%rain, cloud_species%ice, 1)
-       rime_ice_rain_theta_q_bb = collision_integral_theta_b(cloud_species%rain, 1)
-!
-!--    For snow - cloud riming
-       rime_snow_cloud_delta_n_aa = collision_integral_delta_b(cloud_species%snow, 0)
-       rime_snow_cloud_delta_n_ab = collision_integral_delta_ba(cloud_species%snow,cloud_species%cloud,0)
-       rime_snow_cloud_delta_n_bb = collision_integral_delta_b(cloud_species%cloud,0)
-       rime_snow_cloud_delta_q_aa = collision_integral_delta_b(cloud_species%snow, 0)
-       rime_snow_cloud_delta_q_ab = collision_integral_delta_ba(cloud_species%snow,cloud_species%cloud,1)
-       rime_snow_cloud_delta_q_bb = collision_integral_delta_b(cloud_species%cloud, 1)
-
-       rime_snow_cloud_theta_n_aa = collision_integral_theta_b(cloud_species%snow, 0)
-       rime_snow_cloud_theta_n_ab = collision_integral_theta_ba(cloud_species%snow,cloud_species%cloud,0)
-       rime_snow_cloud_theta_n_bb = collision_integral_theta_b(cloud_species%cloud, 0)
-       rime_snow_cloud_theta_q_aa = collision_integral_theta_b(cloud_species%snow,  0)
-       rime_snow_cloud_theta_q_ab = collision_integral_theta_ba(cloud_species%snow,cloud_species%cloud,1)
-       rime_snow_cloud_theta_q_bb = collision_integral_theta_b(cloud_species%cloud, 1)
-!
-!--    For snow - rain riming
-       rime_snow_rain_delta_n_aa = collision_integral_delta_b(cloud_species%snow, 0)
-       rime_snow_rain_delta_n_ab = collision_integral_delta_ba(cloud_species%snow, cloud_species%rain, 0)
-       rime_snow_rain_delta_n_bb = collision_integral_delta_b(cloud_species%rain, 0)
-       rime_snow_rain_delta_q_aa = collision_integral_delta_b(cloud_species%snow, 1) ! mass weighted
-       rime_snow_rain_delta_q_ab = collision_integral_delta_ba(cloud_species%snow, cloud_species%rain, 1)
-       rime_snow_rain_delta_q_ba = collision_integral_delta_ba(cloud_species%rain, cloud_species%snow, 1)
-       rime_snow_rain_delta_q_bb = collision_integral_delta_b(cloud_species%rain, 1)
-
-       rime_snow_rain_theta_n_aa = collision_integral_theta_b(cloud_species%snow, 0)
-       rime_snow_rain_theta_n_ab = collision_integral_theta_ba(cloud_species%snow, cloud_species%rain, 0)
-       rime_snow_rain_theta_n_bb = collision_integral_theta_b(cloud_species%rain, 0)
-       rime_snow_rain_theta_q_aa = collision_integral_theta_b(cloud_species%snow, 1) ! mass weighted
-       rime_snow_rain_theta_q_ab = collision_integral_theta_ba(cloud_species%snow, cloud_species%rain, 1)
-       rime_snow_rain_theta_q_ba = collision_integral_theta_ba(cloud_species%rain, cloud_species%snow, 1)
-       rime_snow_rain_theta_q_bb = collision_integral_theta_b(cloud_species%rain, 1)
-
-    END SUBROUTINE init_collision_integrals
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize coefficients such as for ventilation and other processes
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE init_coefficients
-
-!
-!--    Calculate ventilation coefficients for snow calling function
-       a1_ven_coeff_snow = ventilation_coeff_a( cloud_species%snow, 1)
-       b1_ven_coeff_snow = ventilation_coeff_b( cloud_species%snow, 1) *                           &
-                           schmidt_p_1d3 / SQRT(kin_vis_air)
-!
-!--    Calculate ventilation coefficients for graupel calling function
-       a1_ven_coeff_graupel = ventilation_coeff_a( cloud_species%graupel, 1)
-       b1_ven_coeff_graupel = ventilation_coeff_b( cloud_species%graupel, 1) *                     &
-                           schmidt_p_1d3 / SQRT(kin_vis_air)
-!
-!--    calculate coefficient for homogeneous freezing proportional to 2nd moment of distribution
-       cz_cloud = moment_gamma( cloud_species%cloud, 2 )
-
-    END SUBROUTINE init_coefficients
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Adjust number of raindrops to avoid nonlinear effects in sedimentation and evaporation of rain
-!> drops due to too small or too big weights of rain drops (Stevens and Seifert, 2008).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE adjust_cloud
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !<
-       INTEGER(iwp) ::  j                 !<
-       INTEGER(iwp) ::  k                 !<
-
-       REAL(wp) ::  flag                  !< flag to indicate first grid level above
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                IF ( .NOT. microphysics_morrison_no_rain )  THEN
-                   IF ( qr(k,j,i) <= eps_sb )  THEN
-                      qr(k,j,i) = 0.0_wp
-                      nr(k,j,i) = 0.0_wp
-                   ELSE
-                      IF ( nr(k,j,i) * xrmin > qr(k,j,i) * hyrho(k) )  THEN
-                         nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmin * flag
-                      ELSEIF ( nr(k,j,i) * xrmax < qr(k,j,i) * hyrho(k) )  THEN
-                         nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmax * flag
-                      ENDIF
-                   ENDIF
-                ENDIF
-
-                IF ( microphysics_morrison )  THEN
-                   IF ( qc(k,j,i) <= eps_sb )  THEN
-                      qc(k,j,i) = 0.0_wp
-                      nc(k,j,i) = 0.0_wp
-                   ELSE
-                      IF ( nc(k,j,i) * xcmin > qc(k,j,i) * hyrho(k) )  THEN
-                         nc(k,j,i) = qc(k,j,i) * hyrho(k) / xcmin * flag
-                      ENDIF
-                   ENDIF
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE adjust_cloud
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Adjust number of raindrops to avoid nonlinear effects in sedimentation and evaporation of rain
-!> drops due to too small or too big weights of rain drops (Stevens and Seifert, 2008).
-!> The same procedure is applied to cloud droplets if they are determined prognostically. Call for
-!> grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE adjust_cloud_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !<
-       INTEGER(iwp) ::  j                 !<
-       INTEGER(iwp) ::  k                 !<
-
-       REAL(wp) ::  flag                  !< flag to indicate first grid level above surface
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          IF ( .NOT. microphysics_morrison_no_rain )  THEN
-             IF ( qr(k,j,i) <= eps_sb )  THEN
-                qr(k,j,i) = 0.0_wp
-                nr(k,j,i) = 0.0_wp
-             ELSE
-!
-!--             Adjust number of raindrops to avoid nonlinear effects in sedimentation and
-!--             evaporation of rain drops due to too small or too big weights of rain drops
-!--            (Stevens and Seifert, 2008).
-                IF ( nr(k,j,i) * xrmin > qr(k,j,i) * hyrho(k) )  THEN
-                   nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmin * flag
-                ELSEIF ( nr(k,j,i) * xrmax < qr(k,j,i) * hyrho(k) )  THEN
-                   nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmax * flag
-                ENDIF
-             ENDIF
-          ENDIF
-
-          IF ( microphysics_morrison )  THEN
-             IF ( qc(k,j,i) <= eps_sb )  THEN
-                qc(k,j,i) = 0.0_wp
-                nc(k,j,i) = 0.0_wp
-             ELSE
-                IF ( nc(k,j,i) * xcmin > qc(k,j,i) * hyrho(k) )  THEN
-                   nc(k,j,i) = qc(k,j,i) * hyrho(k) / xcmin * flag
-                ENDIF
-             ENDIF
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE adjust_cloud_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Adjust number of ice crystal to avoid nonlinear effects in sedimentation and evaporation of ice
-!> crytals due to too small or too big weights of ice crytals (Stevens and Seifert, 2008).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE adjust_ice
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !<
-       INTEGER(iwp) ::  j                 !<
-       INTEGER(iwp) ::  k                 !<
-
-       REAL(wp) ::  flag                  !< flag to indicate first grid level above
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                IF ( qi(k,j,i) <= ximin )  THEN
-                   qi(k,j,i) = 0.0_wp
-                   ni(k,j,i) = 0.0_wp
-                ELSE
-                   IF ( ni(k,j,i) * ximin > qi(k,j,i) * hyrho(k) )  THEN
-                      ni(k,j,i) = qi(k,j,i) * hyrho(k) / ximin * flag
-                   ELSEIF ( ni(k,j,i) * ximax < qi(k,j,i) * hyrho(k) )  THEN
-                      ni(k,j,i) = qi(k,j,i) * hyrho(k) / ximax * flag
-                   ENDIF
-                ENDIF
-                IF ( snow  .OR.  graupel )  THEN
-!
-!--                snow adjust
-                   IF ( qs(k,j,i) <= xsmin )  THEN
-                      qs(k,j,i) = 0.0_wp
-                      ns(k,j,i) = 0.0_wp
-                   ELSE
-                      IF ( ns(k,j,i) * xsmin > qs(k,j,i) * hyrho(k) )  THEN
-                         ns(k,j,i) = qs(k,j,i) * hyrho(k) / xsmin * flag
-                      ELSEIF ( ns(k,j,i) * xsmax < qs(k,j,i) * hyrho(k) )  THEN
-                         ns(k,j,i) = qs(k,j,i) * hyrho(k) / xsmax * flag
-                      ENDIF
-                   ENDIF
-!
-!--                graupel adjust
-                   IF ( qg(k,j,i) <= eps_sb )  THEN
-                      qg(k,j,i) = 0.0_wp
-                      ng(k,j,i) = 0.0_wp
-                   ELSE
-                      IF ( ng(k,j,i) * xgmin > qg(k,j,i) * hyrho(k) )  THEN
-                         ng(k,j,i) = qg(k,j,i) * hyrho(k) / xgmin * flag
-                      ELSEIF ( ng(k,j,i) * xgmax < qg(k,j,i) * hyrho(k) )  THEN
-                         ng(k,j,i) = qg(k,j,i) * hyrho(k) / xgmax * flag
-                      ENDIF
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE adjust_ice
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Adjust number of of ice crystal to avoid nonlinear effects in sedimentation and evaporation of
-!> ice crystals due to too small or too big weights of ice crytals (Stevens and Seifert, 2008).
-!> The same procedure is applied to cloud droplets if they are determined prognostically. Call for
-!> grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE adjust_ice_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !<
-       INTEGER(iwp) ::  j                 !<
-       INTEGER(iwp) ::  k                 !<
-
-       REAL(wp) ::  flag                  !< flag to indicate first grid level above surface
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       ice adjust
-          IF ( qi(k,j,i) <= ximin )  THEN
-             qi(k,j,i) = 0.0_wp
-             ni(k,j,i) = 0.0_wp
-          ELSE
-             IF ( ni(k,j,i) * ximin > qi(k,j,i) * hyrho(k) )  THEN
-                ni(k,j,i) = qi(k,j,i) * hyrho(k) / ximin * flag
-             ELSEIF ( ni(k,j,i) * ximax < qi(k,j,i) * hyrho(k) )  THEN
-                ni(k,j,i) = qi(k,j,i) * hyrho(k) / ximax * flag
-             ENDIF
-          ENDIF
-          IF ( snow  .OR.  graupel )  THEN
-!
-!--          snow adjust
-             IF ( qs(k,j,i) <= xsmin )  THEN
-                qs(k,j,i) = 0.0_wp
-                ns(k,j,i) = 0.0_wp
-             ELSE
-                IF ( ns(k,j,i) * xsmin > qs(k,j,i) * hyrho(k) )  THEN
-                   ns(k,j,i) = qs(k,j,i) * hyrho(k) / xsmin * flag
-                ELSEIF ( ns(k,j,i) * xsmax < qs(k,j,i) * hyrho(k) )  THEN
-                   ns(k,j,i) = qs(k,j,i) * hyrho(k) / xsmax * flag
-                ENDIF
-             ENDIF
-!
-!--          graupel adjust
-             IF ( qg(k,j,i) <= eps_sb )  THEN
-                qg(k,j,i) = 0.0_wp
-                ng(k,j,i) = 0.0_wp
-             ELSE
-                IF ( ng(k,j,i) * xgmin > qg(k,j,i) * hyrho(k) )  THEN
-                   ng(k,j,i) = qg(k,j,i) * hyrho(k) / xgmin * flag
-                ELSEIF ( ng(k,j,i) * xgmax < qg(k,j,i) * hyrho(k) )  THEN
-                   ng(k,j,i) = qg(k,j,i) * hyrho(k) / xgmax * flag
-                ENDIF
-             ENDIF
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE adjust_ice_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate number of activated condensation nucleii after simple activation
-!> scheme of Twomey, 1959.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE activation_cloud
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !<
-       INTEGER(iwp) ::  j                 !<
-       INTEGER(iwp) ::  k                 !<
-
-       REAL(wp)     ::  activ             !<
-       REAL(wp)     ::  afactor           !<
-       REAL(wp)     ::  beta_act          !<
-       REAL(wp)     ::  bfactor           !<
-       REAL(wp)     ::  flag              !< flag to indicate first grid level above
-       REAL(wp)     ::  k_act             !<
-       REAL(wp)     ::  n_act             !<
-       REAL(wp)     ::  n_ccn             !<
-       REAL(wp)     ::  s_0               !<
-       REAL(wp)     ::  sat_max           !<
-       REAL(wp)     ::  sigma             !<
-       REAL(wp)     ::  sigma_act         !<
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Call calculation of supersaturation located in subroutine
-                CALL supersaturation ( i, j, k )
-!
-!--             Prescribe parameters for activation (see: Bott + Trautmann, 2002, Atm. Res., 64)
-                k_act  = 0.7_wp
-                activ  = 0.0_wp
-
-
-                IF ( sat > 0.0  .AND.  .NOT. curvature_solution_effects_bulk )  THEN
-!
-!--                Compute the number of activated Aerosols
-!--                (see: Twomey, 1959, Pure and applied Geophysics, 43)
-                   n_act     = na_init * sat**k_act
-!
-!--                Compute the number of cloud droplets (see: Morrison + Grabowski, 2007, JAS, 64)
-!                  activ = MAX( n_act - nc(k,j,i), 0.0_wp) / dt_micro
-
-!
-!--                Compute activation rate after Khairoutdinov and Kogan
-!--                (see: Khairoutdinov + Kogan, 2000, Mon. Wea. Rev., 128)
-                   sat_max = 1.0_wp / 100.0_wp
-                   activ   = MAX( 0.0_wp, ( (na_init + nc(k,j,i) ) *                               &
-                             MIN( 1.0_wp, ( sat / sat_max )**k_act) - nc(k,j,i) ) ) / dt_micro
-!
-!--                Apply activation
-                   nc(k,j,i) = MIN( (nc(k,j,i) + activ * dt_micro * flag), na_init)
-!
-!--             If curvature and solution effects are considered
-                ELSEIF ( sat > 0.0  .AND.  curvature_solution_effects_bulk )  THEN
-!
-!--                Curvature effect (afactor) with surface tension parameterization by Straka (2009)
-                   sigma = 0.0761_wp - 0.000155_wp * ( t_l - 273.15_wp )
-                   afactor = 2.0_wp * sigma / ( rho_l * r_v * t_l )
-!
-!--                Solute effect (bfactor)
-                   bfactor = vanthoff * molecular_weight_of_water * rho_s /                        &
-                             ( molecular_weight_of_solute * rho_l )
-
-!
-!--                Prescribe power index that describes the soluble fraction of an aerosol particle
-!--                (beta) (see: Morrison + Grabowski, 2007, JAS, 64)
-                   beta_act  = 0.5_wp
-                   sigma_act = sigma_bulk**( 1.0_wp + beta_act )
-!
-!--                Calculate mean geometric supersaturation (s_0) with parameterization by
-!--                Khvorostyanov and Curry (2006)
-                   s_0 = dry_aerosol_radius **(- ( 1.0_wp + beta_act ) ) * ( 4.0_wp * afactor**3 / &
-                         ( 27.0_wp * bfactor ) )**0.5_wp
-
-!
-!--                Calculate number of activated CCN as a function of supersaturation and taking
-!--                Koehler theory into account (see: Khvorostyanov + Curry, 2006, J. Geo. Res., 111)
-                   n_ccn = ( na_init / 2.0_wp ) * ( 1.0_wp - ERF(                                  &
-                           LOG( s_0 / sat ) / ( SQRT(2.0_wp) * LOG(sigma_act) ) ) )
-                   activ = MAX( ( n_ccn - nc(k,j,i) ) / dt_micro, 0.0_wp )
-!
-!--                Apply activation
-                   nc(k,j,i) = MIN( (nc(k,j,i) + activ * dt_micro * flag), na_init)
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE activation_cloud
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate number of activated condensation nucleii after simple activation scheme of
-!> Twomey, 1959.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE activation_cloud_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !<
-       INTEGER(iwp) ::  j                 !<
-       INTEGER(iwp) ::  k                 !<
-
-       REAL(wp)     ::  activ             !<
-       REAL(wp)     ::  afactor           !<
-       REAL(wp)     ::  beta_act          !<
-       REAL(wp)     ::  bfactor           !<
-       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
-       REAL(wp)     ::  k_act             !<
-       REAL(wp)     ::  n_act             !<
-       REAL(wp)     ::  n_ccn             !<
-       REAL(wp)     ::  s_0               !<
-       REAL(wp)     ::  sat_max           !<
-       REAL(wp)     ::  sigma             !<
-       REAL(wp)     ::  sigma_act         !<
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Call calculation of supersaturation
-          CALL supersaturation ( i, j, k )
-!
-!--       Prescribe parameters for activation (see: Bott + Trautmann, 2002, Atm. Res., 64)
-          k_act  = 0.7_wp
-          activ  = 0.0_wp
-
-          IF ( sat > 0.0 .AND. .NOT. curvature_solution_effects_bulk )  THEN
-!
-!--          Compute the number of activated Aerosols
-!--          (see: Twomey, 1959, Pure and applied Geophysics, 43)
-             n_act     = na_init * sat**k_act
-!
-!--          Compute activation rate after Khairoutdinov and Kogan
-!--          (see: Khairoutdinov + Kogan, 2000, Mon. Wea. Rev., 128)
-             sat_max = 0.8_wp / 100.0_wp
-             activ   = MAX( 0.0_wp, ( (na_init + nc(k,j,i) ) *                                     &
-                       MIN( 1.0_wp, ( sat / sat_max )**k_act) - nc(k,j,i) ) ) / dt_micro
-
-             nc(k,j,i) = MIN( (nc(k,j,i) + activ * dt_micro), na_init)
-          ELSEIF ( sat > 0.0  .AND.  curvature_solution_effects_bulk )  THEN
-!
-!--          Curvature effect (afactor) with surface tension parameterization by Straka (2009)
-             sigma = 0.0761_wp - 0.000155_wp * ( t_l - 273.15_wp )
-             afactor = 2.0_wp * sigma / ( rho_l * r_v * t_l )
-!
-!--          Solute effect (bfactor)
-             bfactor = vanthoff * molecular_weight_of_water * rho_s /                              &
-                       ( molecular_weight_of_solute * rho_l )
-
-!
-!--          Prescribe power index that describes the soluble fraction of an aerosol particle
-!--          (beta). (see: Morrison + Grabowski, 2007, JAS, 64)
-             beta_act  = 0.5_wp
-             sigma_act = sigma_bulk**( 1.0_wp + beta_act )
-!
-!--          Calculate mean geometric supersaturation (s_0) with parameterization by Khvorostyanov
-!--          and Curry (2006)
-             s_0   = dry_aerosol_radius **(- ( 1.0_wp + beta_act ) ) *                             &
-                     ( 4.0_wp * afactor**3 / ( 27.0_wp * bfactor ) )**0.5_wp
-
-!
-!--          Calculate number of activated CCN as a function of supersaturation and taking Koehler
-!--          theory into account (see: Khvorostyanov + Curry, 2006, J. Geo. Res., 111)
-             n_ccn = ( na_init / 2.0_wp ) * ( 1.0_wp - ERF(                                        &
-                     LOG( s_0 / sat ) / ( SQRT(2.0_wp) * LOG(sigma_act) ) ) )
-             activ = MAX( ( n_ccn ) / dt_micro, 0.0_wp )
-
-             nc(k,j,i) = MIN( (nc(k,j,i) + activ * dt_micro * flag), na_init)
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE activation_cloud_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate ice nucleation by applying the deposition-condensation formula as given by
-!> Meyers et al 1992 and as described in Seifert and Beheng 2006
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE nucleation_ice
-
-       INTEGER(iwp) ::  i             !< loop index
-       INTEGER(iwp) ::  j             !< loop index
-       INTEGER(iwp) ::  k             !< loop index
-
-       LOGICAL :: isdac = .FALSE.
-
-       REAL(wp) ::  a_m92 = -0.639_wp !< parameter for nucleation
-       REAL(wp) ::  b_m92 = 12.96_wp  !< parameter for nucleation
-       REAL(wp) ::  flag              !< flag to indicate first grid level
-       REAL(wp) ::  n_in              !< number of ice nucleii
-       REAL(wp) ::  nucle = 0.0_wp    !< nucleation rate
-
-       IF  ( isdac )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-!
-!--                Predetermine flag to mask topography
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--                Call calculation of supersaturation located in subroutine
-                   CALL supersaturation_ice ( i, j, k )
-                   nucle = 0.0_wp
-                   IF ( sat_ice >= 0.05_wp  .OR.  ql(k,j,i) >= 0.001E-3_wp  )  THEN
-!
-!--                   Calculate ice nucleation
-                      nucle = MAX( ( in_init - ni(k,j,i) ) / dt_micro, 0.0_wp )
-                      ni(k,j,i) = MIN( (ni(k,j,i) + nucle * dt_micro * flag), in_init)
-                   ENDIF
-
-                ENDDO
-             ENDDO
-          ENDDO
-       ELSE
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-!
-!--                Predetermine flag to mask topography
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--                Call calculation of supersaturation located in subroutine
-                   CALL supersaturation_ice ( i, j, k )
-                   nucle = 0.0_wp
-                   IF ( sat_ice > 0.0_wp  .AND.  sat_ice < 2.0_wp ) THEN
-!
-!--                   Calculate ice nucleation
-                      n_in = in_init * EXP( a_m92 + b_m92 * sat_ice )
-                      nucle = MAX( ( n_in - ni(k,j,i) ) / dt_micro, 0.0_wp )
-                   ENDIF
-                   ni(k,j,i) = MIN( (ni(k,j,i) + nucle * dt_micro * flag), in_init )
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-
-    END SUBROUTINE nucleation_ice
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate ice nucleation by applying the deposition-condensation formula as given by
-!> Meyers et al 1992 and as described in Seifert and Beheng 2006.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE nucleation_ice_ij( i, j )
-
-       INTEGER(iwp) ::  i             !< loop index
-       INTEGER(iwp) ::  j             !< loop index
-       INTEGER(iwp) ::  k             !< loop index
-
-       LOGICAL :: isdac = .FALSE.
-
-       REAL(wp) ::  a_m92 = -0.639_wp !< parameter for nucleation
-       REAL(wp) ::  b_m92 = 12.96_wp  !< parameter for nucleation
-       REAL(wp) ::  flag              !< flag to indicate first grid level
-       REAL(wp) ::  n_in              !< number of ice nucleii
-       REAL(wp) ::  nucle = 0.0_wp    !< nucleation rate
-
-       IF ( isdac )  THEN
-          DO  k = nzb+1, nzt
-!
-!--          Predetermine flag to mask topography
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--          Call calculation of supersaturation located in subroutine
-             CALL supersaturation_ice ( i, j, k )
-             nucle = 0.0_wp
-             IF ( sat_ice >= 0.05_wp  .OR.  ql(k,j,i) >= 0.001E-3_wp )  THEN
-!
-!--             Calculate ice nucleation
-                nucle = MAX( ( in_init - ni(k,j,i) ) / dt_micro, 0.0_wp )
-                ni(k,j,i) = MIN( (ni(k,j,i) + nucle * dt_micro * flag), in_init)
-             ENDIF
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt
-!
-!--          Predetermine flag to mask topography
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--          Call calculation of supersaturation located in subroutine
-             CALL supersaturation_ice ( i, j, k )
-             nucle = 0.0_wp
-             IF ( sat_ice > 0.0_wp  .AND.  sat_ice < 2.0_wp )  THEN
-!
-!--             Calculate ice nucleation
-                n_in = in_init * EXP( a_m92 + b_m92 * sat_ice )
-                nucle = MAX( ( n_in - ni(k,j,i) ) / dt_micro, 0.0_wp )
-             ENDIF
-             ni(k,j,i) = MIN( (ni(k,j,i) + nucle * dt_micro * flag), in_init )
-          ENDDO
-       ENDIF
-
-
-    END SUBROUTINE nucleation_ice_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate condensation/evaporation rate for cloud water (after Khairoutdinov and Kogan, 2000),
-!> assuming a gamma size distribution for droplets, with shape nu=1. This is also applied in
-!> Seifert and Stevens, 2008.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE condensation_cloud
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp)     ::  alpha_rc = 1.0_wp !< Tuning parameter see (Seifert and Stevens, 2010)
-       REAL(wp)     ::  cond              !< condensation rate
-       REAL(wp)     ::  cond_max          !< maximum condensation rate
-       REAL(wp)     ::  evap              !< evaporation rate
-       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
-       REAL(wp)     ::  g_fac             !< factor 1 / Fk + Fd
-       REAL(wp)     ::  nu = 1.0_wp       !< Shape parameter of gernerlized gama distribution
-       REAL(wp)     ::  rc                !< mean cloud droplets radius assuming gamma distribution
-       REAL(wp)     ::  temp              !< actual temperature
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Call calculation of supersaturation
-                CALL supersaturation ( i, j, k )
-!
-!--             Actual temperature, t_l is calculated directly before in supersaturation
-                IF ( microphysics_ice_phase ) THEN
-                   temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-                ELSE
-                   temp = t_l + lv_d_cp * ql(k,j,i)
-                ENDIF
-
-                g_fac  = 1.0_wp / ( ( l_v / ( r_v * temp ) - 1.0_wp ) *                            &
-                                      l_v / ( thermal_conductivity_l  * temp )                     &
-                                    + r_v * temp / ( diff_coeff_l * e_s )                          &
-                                  )
-!
-!--             Mean weight of cloud drops
-                IF ( nc(k,j,i) <= 0.0_wp ) CYCLE
-!
-!--             Calculating mean radius of cloud droplets assuming gamma distribution with shape
-!--             parameter nu=1 (Seifert and Beheng, 2006). Tuning factor alpha_rc (introduced
-!--             in Seifert and Stevens, 2010 ) is switched off. Minimum radius is set to 1ÃÂµm
-!--             following (Seifert and Beheng, 2006, Kogan and Khairoutdinov, 2000,
-!--             Seifert and Stevens, 2010)
-                rc = MAX( alpha_rc  * GAMMA( nu + 1.33_wp ) / GAMMA( nu + 1.0_wp ) *               &
-                          ( 3.0_wp * qc(k,j,i) /                                                   &
-                                   ( 4.0_wp * pi * rho_l  * ( nu + 2.0_wp ) * nc(k,j,i) )          &
-                          )**0.33_wp, 1.0E-6_wp )
-!
-!--             Condensation needs only to be calculated in supersaturated regions
-                IF ( sat > 0.0_wp )  THEN
-!
-!--                Condensation rate of cloud water content after KK scheme.
-!--                (see: Khairoutdinov + Kogan, 2000, Mon. Wea. Rev.,128, Morrison and Grabowski,
-!--                2007, and Seifert and Stevens, 2010)
-                   cond      = 4.0_wp * pi * nc(k,j,i) * g_fac * sat * rc / hyrho(k)
-                   IF ( microphysics_seifert )  THEN
-                      cond_max  = q(k,j,i) - q_s - qc(k,j,i) - qr(k,j,i)
-                   ELSEIF ( microphysics_morrison_no_rain )  THEN
-                      cond_max  = q(k,j,i) - q_s - qc(k,j,i)
-                   ENDIF
-                   cond      = MIN( cond, cond_max / dt_micro )
-
-                   qc(k,j,i) = qc(k,j,i) + cond * dt_micro * flag
-                ELSEIF ( sat < 0.0_wp )  THEN
-                   evap      = 4.0_wp * pi * nc(k,j,i) * g_fac * sat * rc / hyrho(k)
-                   evap      = MAX( evap, -qc(k,j,i) / dt_micro )
-
-                   qc(k,j,i) = qc(k,j,i) + evap * dt_micro * flag
-                ENDIF
-                IF ( nc(k,j,i) * xcmin > qc(k,j,i) * hyrho(k) )  THEN
-                   nc(k,j,i) = qc(k,j,i) * hyrho(k) / xcmin
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE condensation_cloud
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate condensation/evaporation rate for cloud water (after Khairoutdinov and Kogan, 2000),
-!> assuming a gamma size distribution for droplets, with shape nu=1. This is also applied in
-!> Seifert and Stevens, 2008.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE condensation_cloud_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp)     ::  alpha_rc = 1.0_wp !< Tuning parameter see (Seifert and Stevens, 2010)
-       REAL(wp)     ::  cond              !< condensation rate
-       REAL(wp)     ::  cond_max          !< maximum condensation rate
-       REAL(wp)     ::  evap              !< evaporation rate
-       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
-       REAL(wp)     ::  g_fac             !< factor 1 / Fk + Fd
-       REAL(wp)     ::  nu = 1.0_wp       !< Shape parameter of gernerlized gama distribution
-       REAL(wp)     ::  rc                !< mean cloud droplets radius assuming gamma distribution
-       REAL(wp)     ::  temp              !< actual temperature
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Call calculation of supersaturation
-          CALL supersaturation ( i, j, k )
-!
-!--       Actual temperature, t_l is calculated directly before in supersaturation
-          IF ( microphysics_ice_phase ) THEN
-             temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qi(k,j,i)
-          ELSE
-             temp = t_l + lv_d_cp * ql(k,j,i)
-          ENDIF
-
-          g_fac  = 1.0_wp / ( ( l_v / ( r_v * temp ) - 1.0_wp ) *                                  &
-                                l_v / ( thermal_conductivity_l  * temp )                           &
-                              + r_v * temp / ( diff_coeff_l * e_s )                                &
-                            )
-!
-!--       Mean weight of cloud drops
-          IF ( nc(k,j,i) <= 0.0_wp)  CYCLE
-!
-!--       Calculating mean radius of cloud droplets assuming gamma distribution with shape
-!--       parameter nu=1 (Seifert and Beheng, 2006). Tuning factor alpha_rc (introduced
-!--       in Seifert and Stevens, 2010 ) is switched off. Minimum radius is set to 1ÃÂµm following
-!--       (Seifert and Beheng, 2006, Kogan and Khairoutdinov, 2000, Seifert and Stevens, 2010)
-          rc = MAX( alpha_rc  * GAMMA( nu + 1.33_wp ) / GAMMA( nu + 1.0_wp ) *                     &
-                    ( 3.0_wp * qc(k,j,i) / ( 4.0_wp * pi * rho_l  * ( nu + 2.0_wp ) * nc(k,j,i) )  &
-                  )**0.33_wp, 1.0E-6_wp )
-!
-!--       Condensation needs only to be calculated in supersaturated regions
-          IF ( sat > 0.0_wp )  THEN
-!
-!--          Condensation rate of cloud water content after KK scheme.
-!--          (see: Khairoutdinov + Kogan, 2000, Mon. Wea. Rev.,128, Morrison and Grabowski, 2007
-!--          and Seifert and Stevens, 2010)
-             cond      = 4.0_wp * pi * nc(k,j,i) * g_fac * sat * rc / hyrho(k)
-             IF ( microphysics_seifert )  THEN
-                cond_max  = q(k,j,i) - q_s - qc(k,j,i) - qr(k,j,i)
-             ELSEIF ( microphysics_morrison_no_rain )  THEN
-                cond_max  = q(k,j,i) - q_s - qc(k,j,i)
-             ENDIF
-             cond      = MIN( cond, cond_max / dt_micro )
-
-             qc(k,j,i) = qc(k,j,i) + cond * dt_micro * flag
-          ELSEIF ( sat < 0.0_wp )  THEN
-             evap      = 4.0_wp * pi * nc(k,j,i) * g_fac * sat * rc / hyrho(k)
-             evap      = MAX( evap, -qc(k,j,i) / dt_micro )
-
-             qc(k,j,i) = qc(k,j,i) + evap * dt_micro * flag
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE condensation_cloud_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the growth/shrink of ice particles by water vapor deposition/sublimation
-!> (after Seifert and Beheng, 2006) assuming gamam size distribution. Right now ventilation is
-!> neglected.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE deposition_ice
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp) ::  ac = 0.09_wp        !< parameter for ice capacitance
-       REAL(wp) ::  bc = 0.33_wp        !< parameter for ice capacitance
-       REAL(wp) ::  deposition_rate = 0.0_wp !< depositions rate
-       REAL(wp) ::  deposition_rate_max !< maximum deposition rate
-       REAL(wp) ::  fac_gamma = 0.76_wp !< parameter to describe spectral distribution, here
-                                        !< following gamma size distribution with Âµ =1/3 and nu=0
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  gfac_dep            !< factor
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  xi                  !< mean mass of ice crystal
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Call calculation of supersaturation over a plane ice surface
-                CALL supersaturation_ice ( i, j, k )
-!
-!--             Actual temperature:
-                temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--             calculating gfac_dep ( 1/ (Fk + Fd) ) see e.g. Rogers and Yau, 1989
-                gfac_dep  = 1.0_wp / ( ( l_s / ( r_v * temp ) - 1.0_wp ) *                         &
-                                         l_s / ( thermal_conductivity_l  * temp )                  &
-                                    + r_v * temp / ( diff_coeff_l * e_si )                         &
-                                     )
-!
-!--             If there is nothing nucleated, than there is also no deposition (above -38Â°C)
-                IF ( ni(k,j,i) <= 0.0_wp )  CYCLE
-!
-!--             calculate mean mass of ice crystal
-                xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-!
-!--             Condensation needs only to be calculated in supersaturated regions (regarding ice)
-                IF ( sat_ice > 0.0_wp )  THEN
-!
-!--                Calculate deposition rate assuming ice crystal shape as prescribed in
-!--                Ovchinnikov et al., 2014 and a gamma size distribution according to
-!--                Seifert and Beheng with Âµ =1/3 and nu=0
-                   deposition_rate  = 4.0_wp * pi * sat_ice * gfac_dep * fac_gamma * ac * xi**bc * &
-                                      ni(k,j,i)
-                   IF ( microphysics_seifert )  THEN
-                      deposition_rate_max  = q(k,j,i) - q_si - qr(k,j,i) - qi(k,j,i)
-                   ELSEIF ( microphysics_morrison_no_rain ) THEN
-                      deposition_rate_max  = q(k,j,i) - q_si - qc(k,j,i) - qi(k,j,i)
-                   ENDIF
-                   deposition_rate = MIN( deposition_rate, deposition_rate_max / dt_micro )
-                   qi(k,j,i) = qi(k,j,i) + deposition_rate * dt_micro * flag
-                ELSEIF ( sat_ice < 0.0_wp )  THEN
-                   deposition_rate = 4.0_wp * pi * sat_ice * gfac_dep * fac_gamma * ac * xi**bc * &
-                                      ni(k,j,i)
-                   deposition_rate = MAX( deposition_rate, - qi(k,j,i) / dt_micro )
-                   qi(k,j,i) = qi(k,j,i) + deposition_rate * dt_micro * flag
-                ENDIF
-!
-!--             Store deposition rate ice for riming process
-                dep_rate_ice(k,j,i) = deposition_rate
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE deposition_ice
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the growth/shrink of ice particles by water vapor deposition/sublimation
-!> (after Seifert and Beheng, 2006) assuming gamam size distribution. Right now ventilation is
-!> neglected.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE deposition_ice_ij( i, j )
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp) ::  ac = 0.09_wp        !< parameter for ice capacitance
-       REAL(wp) ::  bc = 0.33_wp        !< parameter for ice capacitance
-       REAL(wp) ::  deposition_rate = 0.0_wp !< depositions rate
-       REAL(wp) ::  deposition_rate_max !< maximum deposition rate
-       REAL(wp) ::  fac_gamma = 0.76_wp !< parameter to describe spectral distribution, here
-                                        !< following gamma size distribution with nu=1, v=0
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  gfac_dep            !< factor
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  xi                  !< mean mass of ice crystal
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Call calculation of supersaturation over a plane ice surface
-          CALL supersaturation_ice( i, j, k )
-!
-!--       Actual temperature, t_l is calcualted in supersaturation_ice routine:
-          temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--       Calculating gfac_dep ( 1/ (Fk + Fd) ) see e.g.
-!--       Rogers and Yau, 1989
-          gfac_dep  = 1.0_wp / ( ( l_s / ( r_v * temp ) - 1.0_wp ) *                               &
-                                   l_s / ( thermal_conductivity_l  * temp )                        &
-                                 + r_v * temp / ( diff_coeff_l * e_si )                            &
-                               )
-!
-!--       If there is nothing nucleated, than there is also no deposition (above -38Â°C)
-          IF ( ni(k,j,i) > 0.0_wp )  THEN
-!
-!--          calculate mean mass of ice crystal
-             xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-!
-!--          Water vapor deposition in supersaturated regions (regarding ice)
-             IF ( sat_ice > 0.0_wp )  THEN
-!
-!--             Calculate deposition rate assuming ice crystal shape as prescribed in
-!--             Ovchinnikov et al., 2014 and a gamma size distribution according to
-!--             Seifert and Beheng with Âµ =1/3 and nu=0
-                deposition_rate  = 4.0_wp * pi * sat_ice * gfac_dep * fac_gamma * ac * xi**bc *    &
-                                   ni(k,j,i)
-                deposition_rate_max  = q(k,j,i) - q_si - qc(k,j,i) - qr(k,j,i) - qf(k,j,i)
-                deposition_rate = MIN( deposition_rate, deposition_rate_max / dt_micro )
-
-                qi(k,j,i) = qi(k,j,i) + deposition_rate * dt_micro * flag
-!
-!--          Water vapor sublimation in supersaturated regions (regarding ice)
-             ELSEIF ( sat_ice < 0.0_wp )  THEN
-                deposition_rate = 4.0_wp * pi * sat_ice * gfac_dep * fac_gamma * ac * xi**bc *    &
-                                   ni(k,j,i)
-                deposition_rate = MAX( deposition_rate, - qi(k,j,i) / dt_micro )
-                qi(k,j,i) = qi(k,j,i) + deposition_rate * dt_micro * flag
-             ENDIF
-          ENDIF
-!
-!--       Store deposition rate ice for riming process
-          dep_rate_ice(k,j,i) = deposition_rate
-       ENDDO
-
-    END SUBROUTINE deposition_ice_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the growth/shrink of snowflakes by water vapor deposition/sublimation
-!> (after Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE deposition_snow
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       LOGICAL :: ventilation_snow = .TRUE.
-
-       REAL(wp) ::  ds                  !< mean diameter of snow
-       REAL(wp) ::  deposition_rate     !< depositions rate
-       REAL(wp) ::  deposition_rate_max !< maximum deposition rate
-       REAL(wp) ::  fac_gamma = 1.0_wp  !< parameter to describe spectral distribution,
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  f_vent              !< ventilation coefficient
-       REAL(wp) ::  gfac_dep            !< factor
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vs                  !< mean fall velocity of snow
-       REAL(wp) ::  xs                  !< mean mass of snow
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Call calculation of supersaturation over a plane ice surface
-                CALL supersaturation_ice( i, j, k )
-!
-!--             Actual temperature, t_l is calcualted in supersaturation_ice routine:
-                temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--             Calculating gfac_dep ( 1/ (Fk + Fd) ) see e.g.
-!--             Rogers and Yau, 1989
-                gfac_dep  = 1.0_wp / ( ( l_s / ( r_v * temp ) - 1.0_wp ) *                         &
-                                         l_s / ( thermal_conductivity_l  * temp )                  &
-                                       + r_v * temp / ( diff_coeff_l * e_si )                      &
-                                     )
-!
-!--             If there is nothing nucleated, than there is also no deposition (above -38Â°C)
-                IF ( ns(k,j,i) > 0.0_wp )  THEN
-!
-!--                calculate mean mass of snow crystal
-                   xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-
-!
-!--                Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1) and
-!--                mean diameter of snow
-                   vs = terminal_fall_velocity( cloud_species%snow, xs, hyrho(k) )
-                   ds = mean_diameter( cloud_species%snow, xs )
-
-                   IF ( ventilation_snow )  THEN
-                      f_vent  = a1_ven_coeff_snow + b1_ven_coeff_snow * SQRT( ds * vs )
-                      f_vent  = MAX( f_vent, a1_ven_coeff_snow / cloud_species%snow%a_ven )
-                   ELSE
-                      f_vent = 1.0_wp
-                   ENDIF
-!
-!--                Water vapor deposition in supersaturated regions (regarding ice)
-                   IF ( sat_ice > 0.0_wp )  THEN
-!
-!--                   Calculate deposition rate assuming snow crystal shape
-                      deposition_rate  = 4.0_wp * pi / cloud_species%snow%cap * sat_ice *          &
-                                         gfac_dep * fac_gamma * ds * f_vent * ns(k,j,i)
-                      deposition_rate_max  = q(k,j,i) - q_si - qc(k,j,i) - qr(k,j,i) - qf(k,j,i)
-                      deposition_rate = MIN( deposition_rate, deposition_rate_max / dt_micro )
-
-                      qs(k,j,i) = qs(k,j,i) + deposition_rate * dt_micro * flag
-!
-!--                Water vapor sublimation in supersaturated regions (regarding ice)
-                   ELSEIF ( sat_ice < 0.0_wp )  THEN
-                      deposition_rate = 4.0_wp * pi / cloud_species%snow%cap * sat_ice *           &
-                                        gfac_dep * fac_gamma * ds * f_vent * ns(k,j,i)
-                      deposition_rate = MAX( deposition_rate, - qs(k,j,i) / dt_micro )
-                      qs(k,j,i) = qs(k,j,i) + deposition_rate * dt_micro * flag
-                   ENDIF
-!
-!--                Store deposition rate ice for riming process
-                   dep_rate_snow(k,j,i) = deposition_rate
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE deposition_snow
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the growth/shrink of snowflakes by water vapor deposition/sublimation
-!> (after Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE deposition_snow_ij( i, j )
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       LOGICAL :: ventilation_snow = .TRUE.
-
-       REAL(wp) ::  ds                  !< mean diameter of snow
-       REAL(wp) ::  deposition_rate     !< depositions rate
-       REAL(wp) ::  deposition_rate_max !< maximum deposition rate
-       REAL(wp) ::  fac_gamma = 1.0_wp  !< parameter to describe spectral distribution,
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  f_vent              !< ventilation coefficient
-       REAL(wp) ::  gfac_dep            !< factor
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vs                  !< mean fall velocity of snow
-       REAL(wp) ::  xs                  !< mean mass of snow
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Call calculation of supersaturation over a plane ice surface
-          CALL supersaturation_ice( i, j, k )
-!
-!--       Actual temperature, t_l is calcualted in supersaturation_ice routine:
-          temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--       Calculating gfac_dep ( 1/ (Fk + Fd) ) see e.g.
-!--       Rogers and Yau, 1989
-          gfac_dep  = 1.0_wp / ( ( l_s / ( r_v * temp ) - 1.0_wp ) *                               &
-                                   l_s / ( thermal_conductivity_l  * temp )                        &
-                                 + r_v * temp / ( diff_coeff_l * e_si )                            &
-                               )
-!
-!--       If there is nothing nucleated, than there is also no deposition (above -38Â°C)
-          IF ( ns(k,j,i) > 0.0_wp )  THEN
-!
-!--          calculate mean mass of snow crystal
-             xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-
-!
-!--          Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1) and mean
-!--          diameter of snow
-             vs = terminal_fall_velocity( cloud_species%snow, xs, hyrho(k) )
-             ds = mean_diameter( cloud_species%snow, xs )
-
-             IF ( ventilation_snow )  THEN
-                f_vent  = a1_ven_coeff_snow + b1_ven_coeff_snow * SQRT( ds * vs )
-                f_vent  = MAX( f_vent, a1_ven_coeff_snow / cloud_species%snow%a_ven )
-             ELSE
-                f_vent = 1.0_wp
-             ENDIF
-!
-!--          Water vapor deposition in supersaturated regions (regarding ice)
-             IF ( sat_ice > 0.0_wp )  THEN
-!
-!--             Calculate deposition rate assuming snow crystal shape
-                deposition_rate  = 4.0_wp * pi / cloud_species%snow%cap * sat_ice * gfac_dep *     &
-                                   fac_gamma * ds * f_vent * ns(k,j,i)
-                deposition_rate_max  = q(k,j,i) - q_si - qc(k,j,i) - qr(k,j,i) - qf(k,j,i)
-                deposition_rate = MIN( deposition_rate, deposition_rate_max / dt_micro )
-
-                qs(k,j,i) = qs(k,j,i) + deposition_rate * dt_micro * flag
-!
-!--          Water vapor sublimation in supersaturated regions (regarding ice)
-             ELSEIF ( sat_ice < 0.0_wp )  THEN
-                deposition_rate = 4.0_wp * pi / cloud_species%snow%cap * sat_ice * gfac_dep *     &
-                                   fac_gamma * ds * f_vent * ns(k,j,i)
-                deposition_rate = MAX( deposition_rate, - qs(k,j,i) / dt_micro )
-                qs(k,j,i) = qs(k,j,i) + deposition_rate * dt_micro * flag
-             ENDIF
-!
-!--          Store deposition rate ice for riming process
-             dep_rate_snow(k,j,i) = deposition_rate
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE deposition_snow_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the growth/shrink of graupel by water vapor deposition/sublimation
-!> (after Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE deposition_graupel
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       LOGICAL :: ventilation_graupel = .TRUE.  !< Turn on/off ventilation effects during sublimation
-
-       REAL(wp) ::  dg                  !< mean diameter of graupel
-       REAL(wp) ::  deposition_rate     !< depositions rate
-       REAL(wp) ::  deposition_rate_max !< maximum deposition rate
-       REAL(wp) ::  fac_gamma = 1.0_wp  !< parameter to describe spectral distribution,
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  f_vent              !< ventilation coefficient
-       REAL(wp) ::  gfac_dep            !< factor
-       REAL(wp) ::  sublimation_rate    !< sublimations rate
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vg                  !< mean fall velocity of graupel
-       REAL(wp) ::  xg                  !< mean mass of graupel
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Call calculation of supersaturation over a plane ice surface
-                CALL supersaturation_ice( i, j, k )
-!
-!--             Actual temperature, t_l is calcualted in supersaturation_ice routine:
-                temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--             Calculating gfac_dep ( 1/ (Fk + Fd) ) see e.g.
-!--             Rogers and Yau, 1989
-                gfac_dep  = 1.0_wp / ( ( l_s / ( r_v * temp ) - 1.0_wp ) *                         &
-                                         l_s / ( thermal_conductivity_l  * temp )                  &
-                                       + r_v * temp / ( diff_coeff_l * e_si )                      &
-                                     )
-!
-!--             If there is nothing nucleated, than there is also no deposition (above -38Â°C)
-                IF ( ng(k,j,i) > 0.0_wp )  THEN
-!
-!--                calculate mean mass of graupel
-                   xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-!
-!--                Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1) and
-!--                mean diameter of graupel
-                   vg = terminal_fall_velocity( cloud_species%graupel, xg, hyrho(k) )
-                   dg = mean_diameter( cloud_species%graupel, xg )
-
-                   IF ( ventilation_graupel )  THEN
-                      f_vent  = a1_ven_coeff_graupel + b1_ven_coeff_graupel * SQRT( dg * vg )
-                      f_vent  = MAX( f_vent, a1_ven_coeff_graupel / cloud_species%graupel%a_ven )
-                   ELSE
-                      f_vent = 1.0_wp
-                   ENDIF
-!
-!--                Water vapor deposition in supersaturated regions (regarding ice)
-                   IF ( sat_ice > 0.0_wp )  THEN
-!
-!--                   Calculate deposition rate assuming graupel crystal shape
-                      deposition_rate  = 4.0_wp * pi / cloud_species%graupel%cap * sat_ice *       &
-                                         gfac_dep * fac_gamma * dg * f_vent * ng(k,j,i)
-                      deposition_rate_max  = q(k,j,i) - q_si - qc(k,j,i) - qr(k,j,i) - qf(k,j,i)
-                      deposition_rate = MIN( deposition_rate, deposition_rate_max / dt_micro )
-
-                      qg(k,j,i) = qg(k,j,i) + deposition_rate * dt_micro * flag
-!
-!--                Water vapor sublimation in supersaturated regions (regarding ice)
-                   ELSEIF ( sat_ice < 0.0_wp )  THEN
-                      sublimation_rate = 4.0_wp * pi / cloud_species%graupel%cap * sat_ice *       &
-                                         gfac_dep * fac_gamma * dg * f_vent * ng(k,j,i)
-                      sublimation_rate = MAX( sublimation_rate, - qg(k,j,i) / dt_micro )
-                      qg(k,j,i) = qg(k,j,i) + sublimation_rate * dt_micro * flag
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE deposition_graupel
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the growth/shrink of graupel by water vapor deposition/sublimation
-!> (after Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE deposition_graupel_ij( i, j )
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       LOGICAL :: ventilation_graupel = .TRUE.  !< Turn on/off ventilation effects during sublimation
-
-       REAL(wp) ::  dg                  !< mean diameter of graupel
-       REAL(wp) ::  deposition_rate     !< depositions rate
-       REAL(wp) ::  deposition_rate_max !< maximum deposition rate
-       REAL(wp) ::  fac_gamma = 1.0_wp  !< parameter to describe spectral distribution,
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  f_vent              !< ventilation coefficient
-       REAL(wp) ::  gfac_dep            !< factor
-       REAL(wp) ::  sublimation_rate    !< sublimations rate
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vg                  !< mean fall velocity of graupel
-       REAL(wp) ::  xg                  !< mean mass of graupel
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Call calculation of supersaturation over a plane ice surface
-          CALL supersaturation_ice( i, j, k )
-!
-!--       Actual temperature, t_l is calcualted in supersaturation_ice routine:
-          temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--       Calculating gfac_dep ( 1/ (Fk + Fd) ) see e.g.
-!--       Rogers and Yau, 1989
-          gfac_dep  = 1.0_wp / ( ( l_s / ( r_v * temp ) - 1.0_wp ) *                               &
-                                   l_s / ( thermal_conductivity_l  * temp )                        &
-                                 + r_v * temp / ( diff_coeff_l * e_si )                            &
-                               )
-!
-!--       If there is nothing nucleated, than there is also no deposition (above -38Â°C)
-          IF ( ng(k,j,i) > 0.0_wp )  THEN
-!
-!--          calculate mean mass of graupel
-             xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-!
-!--          Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1) and mean
-!--          diameter of graupel
-             vg = terminal_fall_velocity( cloud_species%graupel, xg, hyrho(k) )
-             dg = mean_diameter( cloud_species%graupel, xg )
-
-             IF ( ventilation_graupel )  THEN
-                f_vent  = a1_ven_coeff_graupel + b1_ven_coeff_graupel * SQRT( dg * vg )
-                f_vent  = MAX( f_vent, a1_ven_coeff_graupel / cloud_species%graupel%a_ven )
-             ELSE
-                f_vent = 1.0_wp
-             ENDIF
-!
-!--          Water vapor deposition in supersaturated regions (regarding ice)
-             IF ( sat_ice > 0.0_wp )  THEN
-!
-!--             Calculate deposition rate assuming graupel crystal shape
-                deposition_rate  = 4.0_wp * pi / cloud_species%graupel%cap * sat_ice * gfac_dep *  &
-                                   fac_gamma * dg * f_vent * ng(k,j,i)
-                deposition_rate_max  = q(k,j,i) - q_si - qc(k,j,i) - qr(k,j,i) - qf(k,j,i)
-                deposition_rate = MIN( deposition_rate, deposition_rate_max / dt_micro )
-
-                qg(k,j,i) = qg(k,j,i) + deposition_rate * dt_micro * flag
-!
-!--          Water vapor sublimation in supersaturated regions (regarding ice)
-             ELSEIF ( sat_ice < 0.0_wp )  THEN
-                sublimation_rate = 4.0_wp * pi / cloud_species%graupel%cap * sat_ice * gfac_dep *  &
-                                   fac_gamma * dg * f_vent * ng(k,j,i)
-                sublimation_rate = MAX( sublimation_rate, - qg(k,j,i) / dt_micro )
-                qg(k,j,i) = qg(k,j,i) + sublimation_rate * dt_micro * flag
-             ENDIF
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE deposition_graupel_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Calculates melting of ice particles after SB2006. Ice particles melting immeaditely if temperature
-! is high enough.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE melting_ice
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp) ::  melting_rate_n     !< melting rate for k = zeroth moment (i.e. number concentration)
-       REAL(wp) ::  melting_rate_q     !< melting rate fof k = first moment (i.e. mixing ratio )
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  xi                  !< mean mass of ice crystal
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Actual temperature:
-                temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-
-                IF ( temp > t3  .AND.  qi(k,j,i) > 0.0_wp )  THEN
-!
-!--                Calculate mean mass of ice crystal
-                   xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-!
-!--                set ice to zero, as it's melting immeaditely
-                   melting_rate_q = qi(k,j,i)
-                   melting_rate_n = ni(k,j,i)
-
-                   qi(k,j,i) = qi(k,j,i) - melting_rate_q
-                   ni(k,j,i) = ni(k,j,i) - melting_rate_n
-!
-!--                Add number of ice crystals to rain or cloud in dependency of size
-                   IF ( xi > xrmin )  THEN
-                      qr(k,j,i) = qr(k,j,i) + melting_rate_q
-                      nr(k,j,i) = nr(k,j,i) + melting_rate_n
-                   ELSE
-                      qc(k,j,i) = qc(k,j,i) + melting_rate_q
-                      IF ( microphysics_morrison )  THEN
-                         nc(k,j,i) = nc(k,j,i) + melting_rate_n
-                      ENDIF
-                   ENDIF
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE melting_ice
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Calculates melting of ice particles after SB2006. Ice particles melting immeaditely if temperature
-! is high enough.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE melting_ice_ij( i, j )
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp) ::  melting_rate_n     !< melting rate for k = zeroth moment (i.e. number concentration)
-       REAL(wp) ::  melting_rate_q     !< melting rate fof k = first moment (i.e. mixing ratio )
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  xi                  !< mean mass of ice crystal
-
-       DO  k = nzb+1, nzt
-!
-!--       Actual temperature:
-          temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-
-          IF ( temp > t3  .AND.  qi(k,j,i) > 0.0_wp )  THEN
-!
-!--          Calculate mean mass of ice crystal
-             xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-!
-!--          set ice to zero, as it's melting immeaditely
-             melting_rate_q = qi(k,j,i)
-             melting_rate_n = ni(k,j,i)
-
-             qi(k,j,i) = qi(k,j,i) - melting_rate_q
-             ni(k,j,i) = ni(k,j,i) - melting_rate_n
-!
-!--          Add number of ice crystals to rain or cloud in dependency of size
-             IF ( xi > xrmin )  THEN
-                qr(k,j,i) = qr(k,j,i) + melting_rate_q
-                nr(k,j,i) = nr(k,j,i) + melting_rate_n
-             ELSE
-                qc(k,j,i) = qc(k,j,i) + melting_rate_q
-                IF ( microphysics_morrison )  THEN
-                   nc(k,j,i) = nc(k,j,i) + melting_rate_n
-                ENDIF
-             ENDIF
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE melting_ice_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Calculates melting of graupel after SB2006
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE melting_graupel
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  dg                  !< power law normalised mean graupel diameter
-       REAL(wp) ::  e_a                 !< water vapor pressure
-       REAL(wp) ::  e_s0                !< saturation vapor pressure at freezing point
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  fv_q                !< ventilation coefficient
-       REAL(wp) ::  fh_q                !< ventilation coefficient
-       REAL(wp) ::  melt_fac            !< melting rate factor
-       REAL(wp) ::  melt_h              !< melting rate factor
-       REAL(wp) ::  melt_v              !< melting rate factor
-       REAL(wp) ::  melting_rate_n      !< melting rate for  number concentration
-       REAL(wp) ::  melting_rate_q      !< melting rate for mixing ratio
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vg                  !< fall velocity graupel
-       REAL(wp) ::  xg                  !< mean mass of graupel
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Actual temperature:
-                temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-
-                IF ( temp > t3  .AND.  qg(k,j,i) > 0.0_wp  .AND.  ng(k,j,i) > 0.0_wp )  THEN
-!
-!--                Calculate water vapor pressure at freezing point
-                   e_s0 = magnus_tl ( t3 )
-!
-!--                Current vapor pressure
-                   e_a = (   q(k,j,i) - ql(k,j,i) - qf(k,j,i) ) * hyp(k) /                         &
-                         ( ( q(k,j,i) - ql(k,j,i) - qf(k,j,i) ) + rd_d_rv )
-!
-!--                Calculate mean mass of graupel crystal, limit to minimum and maximum value
-!--                concerning SB-scheme
-                   xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-!
-!--                Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1) and
-!--                mean diameter
-                   vg = terminal_fall_velocity( cloud_species%graupel, xg, hyrho(k) )
-                   dg = mean_diameter( cloud_species%graupel, xg )
-!
-!--                Calculate averaged ventilation coefficient for graupel
-                   fv_q = a1_ven_coeff_graupel + b1_ven_coeff_graupel * SQRT( vg * dg )
-!
-!--                Regarding on Rasmussen and Heymsfield (1987) the ratio fh/fv is 1.05
-                   fh_q = 1.05_wp * fv_q
-!
-!--                Calculate factors for melting rate
-                   melt_fac = 2.0_wp * pi / l_m * dg * ng(k,j,i)
-                   melt_h = melt_fac * thermal_conductivity_l * (temp - t3)
-                   melt_v = melt_fac * diff_coeff_l * l_s / r_d * ( e_a / temp - e_s0 / t3 )
-!
-!--                Calculate melting rates
-                   melting_rate_q = ( melt_h * fh_q + melt_v * fv_q )
-!
-!--                Assuming that xg is constant during melting
-                   melting_rate_n = MIN( MAX( ( melting_rate_q - qg(k,j,i) / dt_micro ) / xg +     &
-                                                ng(k,j,i), 0.0_wp ), ng(k,j,i) / dt_micro )
-!
-!--                Limit the melting rate to current number of graupel and graupel mass
-                   melting_rate_q = MAX( MIN( qg(k,j,i) / dt_micro, melting_rate_q ), 0.0_wp )
-                   melting_rate_n = MAX( MIN( ng(k,j,i) / dt_micro, melting_rate_n ), 0.0_wp )
-!
-!--                Add/substract gain/loss due to melting of ice crystals
-                   qg(k,j,i) = qg(k,j,i) - melting_rate_q * dt_micro * flag
-                   ng(k,j,i) = ng(k,j,i) - melting_rate_n * dt_micro * flag
-
-                   qr(k,j,i) = qr(k,j,i) + melting_rate_q * dt_micro * flag
-                   nr(k,j,i) = nr(k,j,i) + melting_rate_n * dt_micro * flag
-!
-!--                Adapt number of graupel
-                   ng(k,j,i) = MAX( ng(k,j,i), qg(k,j,i) / xgmax )
-
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE melting_graupel
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Calculates melting of graupel after SB2006
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE melting_graupel_ij( i, j )
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  dg                  !< power law normalised mean graupel diameter
-       REAL(wp) ::  e_a                 !< water vapor pressure
-       REAL(wp) ::  e_s0                !< saturation vapor pressure at freezing point
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  fv_q                !< ventilation coefficient
-       REAL(wp) ::  fh_q                !< ventilation coefficient
-       REAL(wp) ::  melt_fac            !< melting rate factor
-       REAL(wp) ::  melt_h              !< melting rate factor
-       REAL(wp) ::  melt_v              !< melting rate factor
-       REAL(wp) ::  melting_rate_n      !< melting rate for  number concentration
-       REAL(wp) ::  melting_rate_q      !< melting rate for mixing ratio
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vg                  !< fall velocity graupel
-       REAL(wp) ::  xg                  !< mean mass of graupel
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Actual temperature:
-          temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-
-          IF ( temp > t3  .AND.  qg(k,j,i) > 0.0_wp  .AND.  ng(k,j,i) > 0.0_wp )  THEN
-!
-!--          Calculate water vapor pressure at freezing point
-             e_s0 = magnus_tl ( t3 )
-!
-!--          Current vapor pressure
-             e_a = (   q(k,j,i) - ql(k,j,i) - qf(k,j,i) ) * hyp(k) /                               &
-                   ( ( q(k,j,i) - ql(k,j,i) - qf(k,j,i) ) + rd_d_rv )
-!
-!--          Calculate mean mass of graupel crystal, limit to minimum and maximum value concerning
-!--          SB-scheme
-             xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-!
-!--          Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1) and mean
-!--          diameter
-             vg = terminal_fall_velocity( cloud_species%graupel, xg, hyrho(k) )
-             dg = mean_diameter( cloud_species%graupel, xg )
-!
-!--          Calculate averaged ventilation coefficient for graupel
-             fv_q = a1_ven_coeff_graupel + b1_ven_coeff_graupel * SQRT( vg * dg )
-!
-!--          Regarding on Rasmussen and Heymsfield (1987) the ratio fh/fv is 1.05
-             fh_q = 1.05_wp * fv_q
-!
-!--          Calculate factors for melting rate
-             melt_fac = 2.0_wp * pi / l_m * dg * ng(k,j,i)
-             melt_h = melt_fac * thermal_conductivity_l * (temp - t3)
-             melt_v = melt_fac * diff_coeff_l * l_s / r_d * ( e_a / temp - e_s0 / t3 )
-!
-!--          Calculate melting rates
-             melting_rate_q = ( melt_h * fh_q + melt_v * fv_q )
-!
-!--          Assuming that xg is constant during melting
-             melting_rate_n = MIN( MAX( ( melting_rate_q - qg(k,j,i) / dt_micro ) / xg +           &
-                                          ng(k,j,i), 0.0_wp ), ng(k,j,i) / dt_micro )
-!
-!--          Limit the melting rate to current number of graupel and graupel mass
-             melting_rate_q = MAX( MIN( qg(k,j,i) / dt_micro, melting_rate_q ), 0.0_wp )
-             melting_rate_n = MAX( MIN( ng(k,j,i) / dt_micro, melting_rate_n ), 0.0_wp )
-!
-!--          Add/substract gain/loss due to melting of ice crystals
-             qg(k,j,i) = qg(k,j,i) - melting_rate_q * dt_micro * flag
-             ng(k,j,i) = ng(k,j,i) - melting_rate_n * dt_micro * flag
-
-             qr(k,j,i) = qr(k,j,i) + melting_rate_q * dt_micro * flag
-             nr(k,j,i) = nr(k,j,i) + melting_rate_n * dt_micro * flag
-!
-!--          Adapt number of graupel
-             ng(k,j,i) = MAX( ng(k,j,i), qg(k,j,i) / xgmax )
-
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE melting_graupel_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Calculates melting of snow after SB2006
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE melting_snow
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  ds                  !< power law normalised mean graupel diameter
-       REAL(wp) ::  e_a                 !< water vapor pressure
-       REAL(wp) ::  e_s0                !< saturation vapor pressure at freezing point
-       REAL(wp) ::  fv_q                !<
-       REAL(wp) ::  fh_q                !<
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  melt_fac            !< melting factor
-       REAL(wp) ::  melt_h              !< metling factor
-       REAL(wp) ::  melt_v              !< metling factor
-       REAL(wp) ::  melting_rate_n      !< melting rate for mixing ratio
-       REAL(wp) ::  melting_rate_q      !< melting rate for number concentration
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vs                  !< fall velocity graupel
-       REAL(wp) ::  xs                  !< mean mass of graupel
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Actual temperature:
-                temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--             Melting occurs above 0Â°C and if snow is present
-                IF ( temp > t3  .AND.  qs(k,j,i) > 0.0_wp  .AND.  ns(k,j,i) > 0.0_wp )  THEN
-!
-!--                calculate water vapor pressure at freezing point
-                   e_s0 = magnus_tl ( t3 )
-!
-!--                Current vapor pressure
-                   e_a = (   q(k,j,i) - ql(k,j,i) - qf(k,j,i) ) * hyp(k) /                          &
-                         ( ( q(k,j,i) - ql(k,j,i) - qf(k,j,i) ) + rd_d_rv )
-!
-!--                Calculate mean mass of graupel crystal, limit to minimum and maximum value
-!--                concerning SB-scheme
-                   xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-!
-!--                Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1)
-                   vs = terminal_fall_velocity( cloud_species%snow, xs, hyrho(k) )
-                   ds = mean_diameter( cloud_species%snow, xs )
-!
-!--                Calculate ventilation coefficients
-                   fv_q = a1_ven_coeff_snow + b1_ven_coeff_snow * SQRT( vs * ds )
-!
-!--                Regarding on Rasmussen and Heymsfield (1987) the ratio fh/fv is 1.05
-                   fh_q = 1.05_wp * fv_q
-!
-!--                Calculate melting factor and rates
-                   melt_fac = 2.0_wp * pi / l_m * ds * ns(k,j,i)
-                   melt_h = melt_fac * thermal_conductivity_l * (temp - t3)
-                   melt_v = melt_fac * diff_coeff_l * l_s / r_d * ( e_a / temp - e_s0 / t3)
-!
-!--                Assuming that xs is constant during melting
-                   melting_rate_q = ( melt_h * fh_q + melt_v * fv_q )
-                   melting_rate_n = MIN ( MAX( ( melting_rate_q - qs(k,j,i) ) / xs + &
-                                              ns(k,j,i), 0.0_wp ),  ns(k,j,i) )
-!
-!--                Limit melting rates
-                   melting_rate_q = MIN( qs(k,j,i) / dt_micro, MAX( melting_rate_q, 0.0_wp ) )
-                   melting_rate_n = MIN( ns(k,j,i) / dt_micro, MAX( melting_rate_n, 0.0_wp ) )
-!
-!--                snow melts instantaneously at 10Â°C
-                   IF ( temp - t3 > 10.0_wp) THEN
-                     melting_rate_q = qs(k,j,i) / dt_micro
-                     melting_rate_n = ns(k,j,i) / dt_micro
-                   ENDIF
-!
-!--                Substract snow due to melting
-                   qs(k,j,i) = qs(k,j,i) - melting_rate_q * dt_micro * flag
-                   qr(k,j,i) = qr(k,j,i) + melting_rate_q * dt_micro * flag
-
-                   ns(k,j,i) = ns(k,j,i) - melting_rate_n * dt_micro * flag
-                   nr(k,j,i) = nr(k,j,i) + melting_rate_n * dt_micro * flag
-!
-!--                Adapt number of snow crystals
-                   ns(k,j,i) = MAX( ns(k,j,i), qs(k,j,i) / xsmax )
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE melting_snow
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Calculates melting of snow after SB2006
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE melting_snow_ij( i, j )
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  ds                  !< power law normalised mean graupel diameter
-       REAL(wp) ::  e_a                 !< water vapor pressure
-       REAL(wp) ::  e_s0                !< saturation vapor pressure at freezing point
-       REAL(wp) ::  fv_q                !<
-       REAL(wp) ::  fh_q                !<
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  melt_fac            !< melting factor
-       REAL(wp) ::  melt_h              !< metling factor
-       REAL(wp) ::  melt_v              !< metling factor
-       REAL(wp) ::  melting_rate_n      !< melting rate for mixing ratio
-       REAL(wp) ::  melting_rate_q      !< melting rate for number concentration
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vs                  !< fall velocity graupel
-       REAL(wp) ::  xs                  !< mean mass of graupel
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Actual temperature:
-          temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--       Melting occurs above 0Â°C and if snow is present
-          IF ( temp > t3  .AND.  qs(k,j,i) > 0.0_wp  .AND.  ns(k,j,i) > 0.0_wp )  THEN
-!
-!--          calculate water vapor pressure at freezing point
-             e_s0 = magnus_tl ( t3 )
-!
-!--          Current vapor pressure
-             e_a = (   q(k,j,i) - ql(k,j,i) - qf(k,j,i) ) * hyp(k) /                               &
-                   ( ( q(k,j,i) - ql(k,j,i) - qf(k,j,i) ) + rd_d_rv )
-!
-!--          Calculate mean mass of graupel crystal, limit to minimum and maximum value concerning
-!--          SB-scheme
-             xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-!
-!--          Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1)
-             vs = terminal_fall_velocity( cloud_species%snow, xs, hyrho(k) )
-             ds = mean_diameter( cloud_species%snow, xs )
-!
-!--          Calculate ventilation coefficients
-             fv_q = a1_ven_coeff_snow + b1_ven_coeff_snow * SQRT( vs * ds )
-!
-!--          Regarding on Rasmussen and Heymsfield (1987) the ratio fh/fv is 1.05
-             fh_q = 1.05_wp * fv_q
-!
-!--          Calculate melting factor and rates
-             melt_fac = 2.0_wp * pi / l_m * ds * ns(k,j,i)
-             melt_h = melt_fac * thermal_conductivity_l * (temp - t3)
-             melt_v = melt_fac * diff_coeff_l * l_s / r_d * ( e_a / temp - e_s0 / t3)
-!
-!--          Assuming that xs is constant during melting
-             melting_rate_q = ( melt_h * fh_q + melt_v * fv_q )
-             melting_rate_n = MIN ( MAX( ( melting_rate_q - qs(k,j,i) ) / xs + ns(k,j,i), 0.0_wp ),&
-                                    ns(k,j,i) )
-!
-!--          Limit melting rates
-             melting_rate_q = MIN( qs(k,j,i) / dt_micro, MAX( melting_rate_q, 0.0_wp ) )
-             melting_rate_n = MIN( ns(k,j,i) / dt_micro, MAX( melting_rate_n, 0.0_wp ) )
-!
-!--          snow melts instantaneously at 10Â°C
-             IF ( temp - t3 > 10.0_wp) THEN
-               melting_rate_q = qs(k,j,i) / dt_micro
-               melting_rate_n = ns(k,j,i) / dt_micro
-             ENDIF
-!
-!--          Substract snow due to melting
-             qs(k,j,i) = qs(k,j,i) - melting_rate_q * dt_micro * flag
-             qr(k,j,i) = qr(k,j,i) + melting_rate_q * dt_micro * flag
-
-             ns(k,j,i) = ns(k,j,i) - melting_rate_n * dt_micro * flag
-             nr(k,j,i) = nr(k,j,i) + melting_rate_n * dt_micro * flag
-!
-!--          Adapt number of snow crystals
-             ns(k,j,i) = MAX( ns(k,j,i), qs(k,j,i) / xsmax )
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE melting_snow_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Calculates evaporation of melting graupel particles after SB2006
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE evaporation_graupel
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  dg                  !< power law normalised mean graupel diameter
-       REAL(wp) ::  evap_graupel        !< evaporation rate
-       REAL(wp) ::  f_v                 !< ventilation coefficient
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  g_fac               !< factor for evaporation
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vg                  !< fall velocity graupel
-       REAL(wp) ::  xg                  !< mean mass of graupel
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Actual temperature:
-                temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-
-                IF ( qg(k,j,i) > 0.0_wp  .AND.  ng(k,j,i) > 0.0_wp  .AND.  temp > t3 )  THEN
-!
-!--                Call calculation of supersaturation over liquid water
-                   CALL supersaturation ( i, j, k )
-                   g_fac = 4.0_wp * pi / ( l_s**2 / ( thermal_conductivity_l * r_d * t3**2 ) +     &
-                           r_d * t3 / ( diff_coeff_l * e_s ) )
-
-!--                Calculate mean mass of graupel, limit to minimum and maximum value concerning
-!--                SB-scheme
-                   xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-!
-!--                Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1) and
-!--                mean diameter
-                   vg = terminal_fall_velocity( cloud_species%graupel, xg, hyrho(k) )
-                   dg = mean_diameter( cloud_species%graupel, xg )
-!
-!--                ventilation coefficient
-                   f_v = a1_ven_coeff_graupel + b1_ven_coeff_graupel * SQRT( vg * dg )
-!
-!--                evapoartion rate
-                   evap_graupel = g_fac * ng(k,j,i) / cloud_species%graupel%cap * dg * f_v * sat
-!
-!--                Limit evaporation rate
-                   evap_graupel = MIN( MAX( -evap_graupel, 0.0_wp ), qg(k,j,i) / dt_micro )
-!
-!--                Evaporation of graupel
-                   qg(k,j,i) = qg(k,j,i) - evap_graupel * dt_micro * flag
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE evaporation_graupel
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Calculates evaporation of melting graupel particles after SB2006
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE evaporation_graupel_ij( i, j )
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  dg                  !< power law normalised mean graupel diameter
-       REAL(wp) ::  evap_graupel        !< evaporation rate
-       REAL(wp) ::  f_v                 !< ventilation coefficient
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  g_fac               !< factor for evaporation
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vg                  !< fall velocity graupel
-       REAL(wp) ::  xg                  !< mean mass of graupel
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Actual temperature:
-          temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-
-          IF ( qg(k,j,i) > 0.0_wp  .AND.  ng(k,j,i) > 0.0_wp  .AND.  temp > t3 )  THEN
-!
-!--          Call calculation of supersaturation over liquid water
-             CALL supersaturation ( i, j, k )
-             g_fac = 4.0_wp * pi / ( l_s**2 / ( thermal_conductivity_l * r_d * t3**2 ) +           &
-                     r_d * t3 / ( diff_coeff_l * e_s ) )
-
-!--          Calculate mean mass of graupel, limit to minimum and maximum value concerning
-!--          SB-scheme
-             xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-!
-!--          Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1) and
-!--          mean diameter
-             vg = terminal_fall_velocity( cloud_species%graupel, xg, hyrho(k) )
-             dg = mean_diameter( cloud_species%graupel, xg )
-!
-!--          ventilation coefficient
-             f_v = a1_ven_coeff_graupel + b1_ven_coeff_graupel * SQRT( vg * dg )
-!
-!--          evapoartion rate
-             evap_graupel = g_fac * ng(k,j,i) / cloud_species%graupel%cap * dg * f_v * sat
-!
-!--          Limit evaporation rate
-             evap_graupel = MIN( MAX( -evap_graupel, 0.0_wp ), qg(k,j,i) / dt_micro )
-!
-!--          Evaporation of graupel
-             qg(k,j,i) = qg(k,j,i) - evap_graupel * dt_micro * flag
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE evaporation_graupel_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Calculates evaporation of melting snow particles after SB2006
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE evaporation_snow
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  ds                  !< power law normalised mean snow diameter
-       REAL(wp) ::  evap_snow           !< evaporation rate
-       REAL(wp) ::  f_v                 !< ventilation coefficient
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  g_fac               !< factor for evaporation
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vs                  !< fall velocity snow
-       REAL(wp) ::  xs                  !< mean mass of snow
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Actual temperature:
-                temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-
-                IF ( qs(k,j,i) > 0.0_wp  .AND.  ns(k,j,i) > 0.0_wp  .AND.  temp > t3 )  THEN
-!
-!--                Call calculation of supersaturation over liquid water
-                   CALL supersaturation ( i, j, k )
-                   g_fac = 4.0_wp * pi / ( l_s**2 / ( thermal_conductivity_l * r_d * t3**2 ) + &
-                           r_d * t3 / ( diff_coeff_l * e_s ) )
-
-!--                Calculate mean mass of snow crystal, limit to minimum and maximum value concerning
-!--                SB-scheme
-                   xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-!
-!--                Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1) and
-!--                mean diameter
-                   vs = terminal_fall_velocity( cloud_species%snow, xs, hyrho(k) )
-                   ds = mean_diameter( cloud_species%snow, xs )
-!
-!--                ventilation coefficient
-                   f_v = a1_ven_coeff_snow + b1_ven_coeff_snow * SQRT( vs * ds )
-!
-!--                evapoartion rate
-                   evap_snow = g_fac * ns(k,j,i) / cloud_species%snow%cap * ds * f_v * sat
-!
-!--                Limit evaporation rate
-                   evap_snow = MIN( MAX( -evap_snow, 0.0_wp ), qs(k,j,i) / dt_micro )
-!
-!--                Evaporation of snow
-                   qs(k,j,i) = qs(k,j,i) - evap_snow * dt_micro * flag
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE evaporation_snow
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Calculates evaporation of melting snow particles after SB2006
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE evaporation_snow_ij( i, j )
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  ds                  !< power law normalised mean snow diameter
-       REAL(wp) ::  evap_snow           !< evaporation rate
-       REAL(wp) ::  f_v                 !< ventilation coefficient
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  g_fac               !< factor for evaporation
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vs                  !< fall velocity snow
-       REAL(wp) ::  xs                  !< mean mass of snow
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Actual temperature:
-          temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-
-          IF ( qs(k,j,i) > 0.0_wp  .AND.  ns(k,j,i) > 0.0_wp  .AND.  temp > t3 )  THEN
-!
-!--          Call calculation of supersaturation over liquid water
-             CALL supersaturation ( i, j, k )
-             g_fac = 4.0_wp * pi / ( l_s**2 / ( thermal_conductivity_l * r_d * t3**2 ) + &
-                     r_d * t3 / ( diff_coeff_l * e_s ) )
-
-!--          Calculate mean mass of snow crystal, limit to minimum and maximum value concerning
-!--          SB-scheme
-             xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-!
-!--          Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1) and
-!--          mean diameter
-             vs = terminal_fall_velocity( cloud_species%snow, xs, hyrho(k) )
-             ds = mean_diameter( cloud_species%snow, xs )
-!
-!--          ventilation coefficient
-             f_v = a1_ven_coeff_snow + b1_ven_coeff_snow * SQRT( vs * ds )
-!
-!--          evapoartion rate
-             evap_snow = g_fac * ns(k,j,i) / cloud_species%snow%cap * ds * f_v * sat
-!
-!--          Limit evaporation rate
-             evap_snow = MIN( MAX( -evap_snow, 0.0_wp ), qs(k,j,i) / dt_micro )
-!
-!--          Evaporation of snow
-             qs(k,j,i) = qs(k,j,i) - evap_snow * dt_micro * flag
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE evaporation_snow_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Heteorogenous freezing of rain droplets (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE heterogeneous_freezing_rain
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  a_het = 0.2_wp      !< factor freezing 0.2 kg-1 s-1
-       REAL(wp) ::  b_het = 0.65_wp     !< factor freezing K^-1
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  freezing_rate_n     !< freezing rate number concentratration
-       REAL(wp) ::  freezing_rate_q     !< freezing rate mixing ratio
-       REAL(wp) ::  j_het               !< factor of temperature dependent heteorogenous freezing function
-       REAL(wp) ::  temp                !< temperature
-       REAL(wp) ::  xr                  !< average mass rain droplet
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Actual temperature:
-                temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--             Freezing occurs below 273.15K
-                IF ( temp < t3 )  THEN
-
-                   IF ( qr(k,j,i) >= eps_sb )  THEN
-!
-!--                   Mean weight of rain drops
-                      xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-!
-!--                   factor of temperature dependent heteorogenous freezing function
-                      j_het = MAX( a_het * EXP( b_het * ( t3 - temp ) - 1.0_wp ) / rho_l , 0.0_wp )
-!
-!--                   Calculate freezing rate according Seifert and Beheng, 2006 Eq.44-47
-                      freezing_rate_n = qr(k,j,i) * j_het
-                      freezing_rate_q = 20.0_wp * qr(k,j,i) * xr * j_het
-
-                      freezing_rate_n = MIN( freezing_rate_n, nr(k,j,i) / dt_micro )
-                      freezing_rate_q = MIN( freezing_rate_q, qr(k,j,i) / dt_micro )
-
-                      nr(k,j,i) = nr(k,j,i) - freezing_rate_n * dt_micro * flag
-                      qr(k,j,i) = qr(k,j,i) - freezing_rate_q * dt_micro * flag
-
-                      ng(k,j,i) = ng(k,j,i) + freezing_rate_n * dt_micro * flag
-                      qg(k,j,i) = qg(k,j,i) + freezing_rate_q * dt_micro * flag
-
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE heterogeneous_freezing_rain
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Heteorogenous freezing of rain droplets (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE heterogeneous_freezing_rain_ij( i, j )
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  a_het = 0.2_wp      !< factor freezing 0.2 kg-1 s-1
-       REAL(wp) ::  b_het = 0.65_wp     !< factor freezing K^-1
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  freezing_rate_n     !< freezing rate number concentratration
-       REAL(wp) ::  freezing_rate_q     !< freezing rate mixing ratio
-       REAL(wp) ::  j_het               !< factor of temperature dependent heteorogenous freezing function
-       REAL(wp) ::  temp                !< temperature
-       REAL(wp) ::  xr                  !< average mass rain droplet
-
-       DO  k = nzb+1, nzt
-
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Actual temperature:
-          temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--       Freezing occurs below 273.15K
-          IF ( temp < t3 )  THEN
-
-             IF ( qr(k,j,i) >= eps_sb )  THEN
-!
-!--             Mean weight of rain drops
-                xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-!
-!--             factor of temperature dependent heteorogenous freezing function
-                j_het = MAX( a_het * EXP( b_het * ( t3 - temp ) - 1.0_wp ) / rho_l , 0.0_wp )
-!
-!--             Calculate freezing rate according Seifert and Beheng, 2006 Eq.44-47
-                freezing_rate_n = qr(k,j,i) * j_het
-                freezing_rate_q = 20.0_wp * qr(k,j,i) * xr * j_het
-
-                freezing_rate_n = MIN( freezing_rate_n, nr(k,j,i) / dt_micro )
-                freezing_rate_q = MIN( freezing_rate_q, qr(k,j,i) / dt_micro )
-
-                nr(k,j,i) = nr(k,j,i) - freezing_rate_n * dt_micro * flag
-                qr(k,j,i) = qr(k,j,i) - freezing_rate_q * dt_micro * flag
-
-                ng(k,j,i) = ng(k,j,i) + freezing_rate_n * dt_micro * flag
-                qg(k,j,i) = qg(k,j,i) + freezing_rate_q * dt_micro * flag
-
-             ENDIF
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE heterogeneous_freezing_rain_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Homogeneous freezing of cloud droplets (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE homogeneous_freezing_cloud
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  nc_c                  !< local dummy number concentration clouds
-       REAL(wp) ::  tc                    !< actual temperature in Â°C
-       REAL(wp) ::  temp                  !< actual temperature
-       REAL(wp) ::  j_hom                 !< Jhom temperature dependent freezing function (kg-1 s-1)
-       REAL(wp) ::  freezing_rate_n      !< freezing rate for zeroth moment (m-3 s-1)
-       REAL(wp) ::  freezing_rate_q      !< freezing rate for first moment (kg kg-1 s-1)
-       REAL(wp) ::  flag                  !< flag to indicate first grid level above
-       REAL(wp) ::  xc                    !< mean mass cloud droplets
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Actual temperature:
-                temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--             Freezing occurs below 273.15K
-                IF ( temp < t3 )  THEN
-                   tc = temp - t3
-                   IF ( microphysics_morrison )  THEN
-                      nc_c = nc(k,j,i)
-                   ELSE
-                      nc_c = nc_const
-                   ENDIF
-                   IF ( qc(k,j,i) > eps_sb  .AND.  nc_c > 0.0_wp  .AND.  tc < -30.0_wp ) THEN
-!
-!--                   Instantaneous freezing below -50Â°C
-                      IF ( tc < -50.0_wp )  THEN
-                         qi(k,j,i) = qi(k,j,i) + qc(k,j,i)
-                         ni(k,j,i) = ni(k,j,i) + nc_c
-                         qc(k,j,i) = 0.0_wp
-                         IF ( microphysics_morrison )  THEN
-                            nc(k,j,i) = 0.0_wp
-                         ENDIF
-                      ELSE
-!
-!--                      Mean weight of cloud drops
-                         xc = mean_mass( cloud_species%cloud, qc(k,j,i), nc_c, hyrho(k) )
-!
-!--                      Calculate temperature dependent function for homogeneous freezing cloud
-!--                      after Jeffrey und Austin (1997) and Cotton und Field (2002)
-                         IF ( tc > -30.0_wp )  THEN
-                            j_hom = 1.0E6_wp / rho_l * 10**( -7.63_wp -2.996_wp * ( tc + 30.0_wp ))
-                         ELSE
-                            j_hom = 1.0E6_wp / rho_l * 10**( -243.4_wp -14.75_wp * tc -0.307_wp *  &
-                                    tc**2 -0.00287_wp *tc**3 -0.0000102_wp * tc**4 )
-                         ENDIF
-                         j_hom = MERGE( j_hom, 0.0_wp, j_hom > 1.0E-20_wp )
-!
-!--                      Calculate freezing rate according Seifert and Beheng, 2006 Eq.49-50
-                         freezing_rate_n = j_hom * qc(k,j,i)
-                         freezing_rate_q = j_hom * qc(k,j,i) * xc * cz_cloud
-!
-!--                      Limit freezing rates to available water content
-                         freezing_rate_n = MIN( freezing_rate_n, nc_c / dt_micro )
-                         freezing_rate_q = MIN( freezing_rate_q, qc(k,j,i) / dt_micro )
-!
-!--                      Substract/Add liquid and ice to species
-                         qc(k,j,i) = qc(k,j,i) - freezing_rate_q * dt_micro * flag
-                         IF ( microphysics_morrison )  THEN
-                            nc(k,j,i) = nc(k,j,i) - freezing_rate_n * dt_micro * flag
-                         ENDIF
-                         ni(k,j,i) = ni(k,j,i) + freezing_rate_n * dt_micro * flag
-                         qi(k,j,i) = qi(k,j,i) + freezing_rate_q * dt_micro * flag
-                      ENDIF
-
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE homogeneous_freezing_cloud
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Homogeneous freezing of cloud droplets (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE homogeneous_freezing_cloud_ij( i, j )
-
-       INTEGER(iwp) ::  i               !< loop index
-       INTEGER(iwp) ::  j               !< loop index
-       INTEGER(iwp) ::  k               !< loop index
-
-       REAL(wp) ::  nc_c                  !< local dummy number concentration clouds
-       REAL(wp) ::  j_hom                 !< Jhom temperature dependent freezing function (kg-1 s-1)
-       REAL(wp) ::  freezing_rate_n       !< freezing rate for zeroth moment (number concentration, m-3 s-1)
-       REAL(wp) ::  freezing_rate_q       !< freezing rate for first moment (mixing ratio, kg kg-1 s-1)
-       REAL(wp) ::  flag                  !< flag to indicate first grid level above
-       REAL(wp) ::  tc                    !< actual temperature in Â°C
-       REAL(wp) ::  temp                  !< actual temperature
-       REAL(wp) ::  xc                    !< mean mass cloud droplets
-
-       DO  k = nzb+1, nzt
-
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Actual temperature:
-          temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--       Freezing occurs below 273.15K
-          IF ( temp < t3 )  THEN
-             tc = temp - t3
-             IF ( microphysics_morrison )  THEN
-                nc_c = nc(k,j,i)
-             ELSE
-                nc_c = nc_const
-             ENDIF
-             IF ( qc(k,j,i) > eps_sb  .AND.  nc_c > 0.0_wp  .AND.  tc < -30.0_wp )  THEN
-!
-!--             Instantaneous freezing below -50Â°C
-                IF ( tc < -50.0_wp )  THEN
-                   qi(k,j,i) = qi(k,j,i) + qc(k,j,i)
-                   ni(k,j,i) = ni(k,j,i) + nc_c
-                   qc(k,j,i) = 0.0_wp
-                   IF ( microphysics_morrison )  THEN
-                      nc(k,j,i) = 0.0_wp
-                   ENDIF
-                ELSE
-!
-!--                Mean weight of cloud drops
-                   xc = mean_mass( cloud_species%cloud, qc(k,j,i), nc_c, hyrho(k) )
-!
-!--                Calculate temperature dependent function for homogeneous freezing cloud
-!--                after Jeffrey und Austin (1997) and Cotton und Field (2002)
-                   IF ( tc > -30.0_wp )  THEN
-                      j_hom = 1.0E6_wp / rho_l * 10**( -7.63_wp -2.996_wp * ( tc + 30.0_wp ))
-                   ELSE
-                      j_hom = 1.0E6_wp / rho_l * 10**( -243.4_wp - 14.75_wp * tc - 0.307_wp *      &
-                              tc**2 - 0.00287_wp * tc**3 -0.0000102_wp * tc**4 )
-                   ENDIF
-                   j_hom = MERGE( j_hom, 0.0_wp, j_hom > 1.0E-20_wp )
-!
-!--                Calculate freezing rate according Seifert and Beheng, 2006 Eq.49-50
-                   freezing_rate_n = j_hom * qc(k,j,i)
-                   freezing_rate_q = j_hom * qc(k,j,i) * xc * cz_cloud
-!
-!--                Limit freezing rates to available water content
-                   freezing_rate_n = MIN( freezing_rate_n, nc_c / dt_micro )
-                   freezing_rate_q = MIN( freezing_rate_q, qc(k,j,i) / dt_micro )
-!
-!--                Substract/Add liquid and ice to species
-                   qc(k,j,i) = qc(k,j,i) - freezing_rate_q * dt_micro * flag
-                   IF ( microphysics_morrison )  THEN
-                      nc(k,j,i) = nc(k,j,i) - freezing_rate_n * dt_micro * flag
-                   ENDIF
-                   ni(k,j,i) = ni(k,j,i) + freezing_rate_n * dt_micro * flag
-                   qi(k,j,i) = qi(k,j,i) + freezing_rate_q * dt_micro * flag
-                ENDIF
-
-             ENDIF
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE homogeneous_freezing_cloud_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Autoconversion rate (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE autoconversion
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp)     ::  alpha_cc          !<
-       REAL(wp)     ::  autocon           !<
-       REAL(wp)     ::  dissipation       !<
-       REAL(wp)     ::  flag              !< flag to mask topography grid points
-       REAL(wp)     ::  k_au              !<
-       REAL(wp)     ::  l_mix             !<
-       REAL(wp)     ::  nc_c              !<
-       REAL(wp)     ::  nu_c              !<
-       REAL(wp)     ::  phi_au            !<
-       REAL(wp)     ::  r_cc              !<
-       REAL(wp)     ::  rc                !<
-       REAL(wp)     ::  re_lambda         !<
-       REAL(wp)     ::  sigma_cc          !<
-       REAL(wp)     ::  tau_cloud         !<
-       REAL(wp)     ::  xc                !<
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                IF ( microphysics_morrison )  THEN
-                   nc_c = nc(k,j,i)
-                ELSE
-                   nc_c = nc_const
-                ENDIF
-
-                IF ( qc(k,j,i) > eps_sb  .AND.  nc_c > eps_mr )  THEN
-
-                   k_au = k_cc / ( 20.0_wp * x0 )
-!
-!--                Intern time scale of coagulation (Seifert and Beheng, 2006):
-!--                (1.0_wp - qc(k,j,i) / ( qc(k,j,i) + qr(k,j,i) ))
-                   tau_cloud = MAX( 1.0_wp - qc(k,j,i) / ( qr(k,j,i) + qc(k,j,i) ), 0.0_wp )
-!
-!--                Universal function for autoconversion process
-!--                (Seifert and Beheng, 2006):
-                   phi_au = 600.0_wp * tau_cloud**0.68_wp * ( 1.0_wp - tau_cloud**0.68_wp )**3
-!
-!--                Shape parameter of gamma distribution (Geoffroy et al., 2010):
-!--                (Use constant nu_c = 1.0_wp instead?)
-                   nu_c = 1.0_wp !MAX( 0.0_wp, 1580.0_wp * hyrho(k) * qc(k,j,i) - 0.28_wp )
-!
-!--                Mean weight of cloud droplets:
-                   xc = hyrho(k) * qc(k,j,i) / nc_c
-!
-!--                Parameterized turbulence effects on autoconversion
-!--                (Seifert, Nuijens and Stevens, 2010)
-                   IF ( collision_turbulence )  THEN
-!
-!--                   Weight averaged radius of cloud droplets:
-                      rc = 0.5_wp * ( xc * dpirho_l )**( 1.0_wp / 3.0_wp )
-
-                      alpha_cc = ( a_1 + a_2 * nu_c ) / ( 1.0_wp + a_3 * nu_c )
-                      r_cc     = ( b_1 + b_2 * nu_c ) / ( 1.0_wp + b_3 * nu_c )
-                      sigma_cc = ( c_1 + c_2 * nu_c ) / ( 1.0_wp + c_3 * nu_c )
-!
-!--                   Mixing length (neglecting distance to ground and stratification)
-                      l_mix = ( dx * dy * dzu(k) )**( 1.0_wp / 3.0_wp )
-!
-!--                   Limit dissipation rate according to Seifert, Nuijens and Stevens (2010)
-                      dissipation = MIN( 0.06_wp, diss(k,j,i) )
-!
-!--                   Compute Taylor-microscale Reynolds number:
-                      re_lambda = 6.0_wp / 11.0_wp * ( l_mix / c_const )**( 2.0_wp / 3.0_wp ) *    &
-                                  SQRT( 15.0_wp / kin_vis_air ) * dissipation**( 1.0_wp / 6.0_wp )
-!
-!--                   The factor of 1.0E4 is needed to convert the dissipation rate from m2 s-3 to
-!--                   cm2 s-3.
-                      k_au = k_au * ( 1.0_wp +                                                     &
-                                      dissipation * 1.0E4_wp *                                     &
-                                      ( re_lambda * 1.0E-3_wp )**0.25_wp *                         &
-                                      ( alpha_cc * EXP( -1.0_wp * ( ( rc -                         &
-                                                                      r_cc ) /                     &
-                                                        sigma_cc )**2                              &
-                                                      ) + beta_cc                                  &
-                                      )                                                            &
-                                    )
-                   ENDIF
-!
-!--                Autoconversion rate (Seifert and Beheng, 2006):
-                   autocon = k_au * ( nu_c + 2.0_wp ) * ( nu_c + 4.0_wp )    /                     &
-                             ( nu_c + 1.0_wp )**2 * qc(k,j,i)**2 * xc**2     *                     &
-                             ( 1.0_wp + phi_au / ( 1.0_wp - tau_cloud )**2 ) * rho_surface
-                   autocon = MIN( autocon, qc(k,j,i) / dt_micro )
-
-                   qr(k,j,i) = qr(k,j,i) + autocon * dt_micro * flag
-                   qc(k,j,i) = qc(k,j,i) - autocon * dt_micro * flag
-                   nr(k,j,i) = nr(k,j,i) + autocon / x0 * hyrho(k) * dt_micro * flag
-                   IF ( microphysics_morrison )  THEN
-                      nc(k,j,i) = nc(k,j,i) - MIN( nc(k,j,i), 2.0_wp *                             &
-                                  autocon / x0 * hyrho(k) * dt_micro * flag )
-                   ENDIF
-
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE autoconversion
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Autoconversion rate (Seifert and Beheng, 2006). Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE autoconversion_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp)     ::  alpha_cc          !<
-       REAL(wp)     ::  autocon           !<
-       REAL(wp)     ::  dissipation       !<
-       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
-       REAL(wp)     ::  k_au              !<
-       REAL(wp)     ::  l_mix             !<
-       REAL(wp)     ::  nc_c              !<
-       REAL(wp)     ::  nu_c              !<
-       REAL(wp)     ::  phi_au            !<
-       REAL(wp)     ::  r_cc              !<
-       REAL(wp)     ::  rc                !<
-       REAL(wp)     ::  re_lambda         !<
-       REAL(wp)     ::  sigma_cc          !<
-       REAL(wp)     ::  tau_cloud         !<
-       REAL(wp)     ::  xc                !<
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-          IF ( microphysics_morrison ) THEN
-             nc_c = nc(k,j,i)
-          ELSE
-             nc_c = nc_const
-          ENDIF
-
-          IF ( qc(k,j,i) > eps_sb  .AND.  nc_c > eps_mr )  THEN
-
-             k_au = k_cc / ( 20.0_wp * x0 )
-!
-!--          Intern time scale of coagulation (Seifert and Beheng, 2006):
-!--          (1.0_wp - qc(k,j,i) / ( qc(k,j,i) + qr(k,j,i) ))
-             tau_cloud = MAX( 1.0_wp - qc(k,j,i) / ( qr(k,j,i) + qc(k,j,i) ), 0.0_wp )
-!
-!--          Universal function for autoconversion process (Seifert and Beheng, 2006):
-             phi_au = 600.0_wp * tau_cloud**0.68_wp * ( 1.0_wp - tau_cloud**0.68_wp )**3
-!
-!--          Shape parameter of gamma distribution (Geoffroy et al., 2010):
-!--          (Use constant nu_c = 1.0_wp instead?)
-             nu_c = 1.0_wp !MAX( 0.0_wp, 1580.0_wp * hyrho(k) * qc(k,j,i) - 0.28_wp )
-!
-!--          Mean weight of cloud droplets:
-             xc = hyrho(k) * qc(k,j,i) / nc_c
-!
-!--          Parameterized turbulence effects on autoconversion (Seifert, Nuijens and Stevens, 2010)
-             IF ( collision_turbulence )  THEN
-!
-!--             Weight averaged radius of cloud droplets:
-                rc = 0.5_wp * ( xc * dpirho_l )**( 1.0_wp / 3.0_wp )
-
-                alpha_cc = ( a_1 + a_2 * nu_c ) / ( 1.0_wp + a_3 * nu_c )
-                r_cc     = ( b_1 + b_2 * nu_c ) / ( 1.0_wp + b_3 * nu_c )
-                sigma_cc = ( c_1 + c_2 * nu_c ) / ( 1.0_wp + c_3 * nu_c )
-!
-!--             Mixing length (neglecting distance to ground and stratification)
-                l_mix = ( dx * dy * dzu(k) )**( 1.0_wp / 3.0_wp )
-!
-!--             Limit dissipation rate according to Seifert, Nuijens and Stevens (2010)
-                dissipation = MIN( 0.06_wp, diss(k,j,i) )
-!
-!--             Compute Taylor-microscale Reynolds number:
-                re_lambda = 6.0_wp / 11.0_wp * ( l_mix / c_const )**( 2.0_wp / 3.0_wp ) *          &
-                            SQRT( 15.0_wp / kin_vis_air ) * dissipation**( 1.0_wp / 6.0_wp )
-!
-!--             The factor of 1.0E4 is needed to convert the dissipation rate from m2 s-3 to
-!--             cm2 s-3.
-                k_au = k_au * ( 1.0_wp +                                                           &
-                                dissipation * 1.0E4_wp *                                           &
-                                ( re_lambda * 1.0E-3_wp )**0.25_wp *                               &
-                                ( alpha_cc * EXP( -1.0_wp * ( ( rc - r_cc ) /                      &
-                                                  sigma_cc )**2                                    &
-                                                ) + beta_cc                                        &
-                                )                                                                  &
-                              )
-             ENDIF
-!
-!--          Autoconversion rate (Seifert and Beheng, 2006):
-             autocon = k_au * ( nu_c + 2.0_wp ) * ( nu_c + 4.0_wp )    /                           &
-                       ( nu_c + 1.0_wp )**2 * qc(k,j,i)**2 * xc**2     *                           &
-                       ( 1.0_wp + phi_au / ( 1.0_wp - tau_cloud )**2 ) * rho_surface
-             autocon = MIN( autocon, qc(k,j,i) / dt_micro )
-             qr(k,j,i) = qr(k,j,i) + autocon * dt_micro                 * flag
-             qc(k,j,i) = qc(k,j,i) - autocon * dt_micro                 * flag
-             nr(k,j,i) = nr(k,j,i) + autocon / x0 * hyrho(k) * dt_micro * flag
-             IF ( microphysics_morrison )  THEN
-                nc(k,j,i) = nc(k,j,i) - MIN( nc(k,j,i), 2.0_wp *                                   &
-                            autocon / x0 * hyrho(k) * dt_micro * flag )
-             ENDIF
-
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE autoconversion_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Autoconversion process (Kessler, 1969).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE autoconversion_kessler
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !< loop index
-       INTEGER(iwp) ::  j      !< loop index
-       INTEGER(iwp) ::  k      !< loop index
-       INTEGER(iwp) ::  k_wall !< topgraphy top index
-
-       REAL(wp)    ::  dqdt_precip !<
-       REAL(wp)    ::  flag        !< flag to mask topography grid points
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-!
-!--          Determine vertical index of topography top
-             k_wall = topo_top_ind(j,i,0)
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                IF ( qc(k,j,i) > ql_crit )  THEN
-                   dqdt_precip = prec_time_const * ( qc(k,j,i) - ql_crit )
-                ELSE
-                   dqdt_precip = 0.0_wp
-                ENDIF
-
-                qc(k,j,i) = qc(k,j,i) - dqdt_precip * dt_micro * flag
-                q(k,j,i)  = q(k,j,i)  - dqdt_precip * dt_micro * flag
-                pt(k,j,i) = pt(k,j,i) + dqdt_precip * dt_micro * lv_d_cp *                         &
-                                        d_exner(k)             * flag
-!
-!--             Compute the rain rate (stored on surface grid point)
-                prr(k_wall,j,i) = prr(k_wall,j,i) + dqdt_precip * dzw(k) * flag
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-   END SUBROUTINE autoconversion_kessler
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Autoconversion process (Kessler, 1969).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE autoconversion_kessler_ij( i, j )
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !< loop index
-       INTEGER(iwp) ::  j      !< loop index
-       INTEGER(iwp) ::  k      !< loop index
-       INTEGER(iwp) ::  k_wall !< topography top index
-
-       REAL(wp)    ::  dqdt_precip       !<
-       REAL(wp)    ::  flag              !< flag to indicate first grid level above surface
-
-!
-!--    Determine vertical index of topography top
-       k_wall = topo_top_ind(j,i,0)
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          IF ( qc(k,j,i) > ql_crit )  THEN
-             dqdt_precip = prec_time_const * ( qc(k,j,i) - ql_crit )
-          ELSE
-             dqdt_precip = 0.0_wp
-          ENDIF
-
-          qc(k,j,i) = qc(k,j,i) - dqdt_precip * dt_micro * flag
-          q(k,j,i)  = q(k,j,i)  - dqdt_precip * dt_micro * flag
-          pt(k,j,i) = pt(k,j,i) + dqdt_precip * dt_micro * lv_d_cp * d_exner(k) * flag
-!
-!--       Compute the rain rate (stored on surface grid point)
-          prr(k_wall,j,i) = prr(k_wall,j,i) + dqdt_precip * dzw(k) * flag
-
-       ENDDO
-
-    END SUBROUTINE autoconversion_kessler_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Accretion rate (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE accretion
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp)     ::  accr              !<
-       REAL(wp)     ::  flag              !< flag to mask topography grid points
-       REAL(wp)     ::  k_cr              !<
-       REAL(wp)     ::  nc_c              !<
-       REAL(wp)     ::  phi_ac            !<
-       REAL(wp)     ::  tau_cloud         !<
-       REAL(wp)     ::  xc                !<
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                IF ( microphysics_morrison )  THEN
-                   nc_c = nc(k,j,i)
-                ELSE
-                   nc_c = nc_const
-                ENDIF
-
-                IF ( ( qc(k,j,i) > eps_sb )  .AND.  ( qr(k,j,i) > eps_sb )                         &
-                                             .AND.  ( nc_c > eps_mr   ) )  THEN
-!
-!--                Intern time scale of coagulation (Seifert and Beheng, 2006):
-                   tau_cloud = 1.0_wp - qc(k,j,i) / ( qc(k,j,i) + qr(k,j,i) )
-!
-!--                Universal function for accretion process (Seifert and
-!--                Beheng, 2001):
-                   phi_ac = ( tau_cloud / ( tau_cloud + 5.0E-5_wp ) )**4
-!--                Mean weight of cloud droplets:
-                   xc = MAX( hyrho(k) * qc(k,j,i) / nc_c, xcmin)
-
-!
-!--                Parameterized turbulence effects on autoconversion
-!--                (Seifert, Nuijens and Stevens, 2010). The factor of 1.0E4 is needed to convert
-!--                the dissipation rate (diss) from m2 s-3 to cm2 s-3.
-                   IF ( collision_turbulence )  THEN
-                      k_cr = k_cr0 * ( 1.0_wp + 0.05_wp *                                          &
-                                       MIN( 600.0_wp, diss(k,j,i) * 1.0E4_wp )**0.25_wp            &
-                                     )
-                   ELSE
-                      k_cr = k_cr0
-                   ENDIF
-!
-!--                Accretion rate (Seifert and Beheng, 2006):
-                   accr = k_cr * qc(k,j,i) * qr(k,j,i) * phi_ac * SQRT( rho_surface * hyrho(k) )
-                   accr = MIN( accr, qc(k,j,i) / dt_micro )
-                   qr(k,j,i) = qr(k,j,i) + accr * dt_micro * flag
-                   qc(k,j,i) = qc(k,j,i) - accr * dt_micro * flag
-                   IF ( microphysics_morrison )  THEN
-                      nc(k,j,i) = nc(k,j,i) - MIN( nc(k,j,i),                                      &
-                                                   accr / xc * hyrho(k) * dt_micro * flag)
-                   ENDIF
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE accretion
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Accretion rate (Seifert and Beheng, 2006). Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE accretion_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp)     ::  accr              !<
-       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
-       REAL(wp)     ::  k_cr              !<
-       REAL(wp)     ::  nc_c              !<
-       REAL(wp)     ::  phi_ac            !<
-       REAL(wp)     ::  tau_cloud         !<
-       REAL(wp)     ::  xc                !<
-
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-          IF ( microphysics_morrison )  THEN
-             nc_c = nc(k,j,i)
-          ELSE
-             nc_c = nc_const
-          ENDIF
-
-          IF ( ( qc(k,j,i) > eps_sb )  .AND.  ( qr(k,j,i) > eps_sb )  .AND.                        &
-               ( nc_c > eps_mr   ) )  THEN
-!
-!--          Intern time scale of coagulation (Seifert and Beheng, 2006):
-             tau_cloud = 1.0_wp - qc(k,j,i) / ( qc(k,j,i) + qr(k,j,i) )
-!
-!--          Universal function for accretion process (Seifert and Beheng, 2001):
-             phi_ac = ( tau_cloud / ( tau_cloud + 5.0E-5_wp ) )**4
-
-!
-!--          Mean weight of cloud drops
-             !xc = mean_mass( cloud_species%cloud, qc(k,j,i), nc_c, hyrho(k) )
-             xc = MAX( hyrho(k) * qc(k,j,i) / nc_c, xcmin)
-
-!
-!--          Parameterized turbulence effects on autoconversion
-!--          (Seifert, Nuijens and Stevens, 2010). The factor of 1.0E4 is needed to convert the
-!--          dissipation rate (diss) from m2 s-3 to cm2 s-3.
-             IF ( collision_turbulence )  THEN
-                k_cr = k_cr0 * ( 1.0_wp + 0.05_wp *                                                &
-                                 MIN( 600.0_wp, diss(k,j,i) * 1.0E4_wp )**0.25_wp                  &
-                               )
-             ELSE
-                k_cr = k_cr0
-             ENDIF
-!
-!--          Accretion rate (Seifert and Beheng, 2006):
-             accr = k_cr * qc(k,j,i) * qr(k,j,i) * phi_ac * SQRT( rho_surface * hyrho(k) )
-             accr = MIN( accr, qc(k,j,i) / dt_micro )
-             qr(k,j,i) = qr(k,j,i) + accr * dt_micro * flag
-             qc(k,j,i) = qc(k,j,i) - accr * dt_micro * flag
-             IF ( microphysics_morrison )  THEN
-                nc(k,j,i) = nc(k,j,i) - MIN( nc(k,j,i), accr / xc * hyrho(k) * dt_micro * flag )
-             ENDIF
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE accretion_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Collisional breakup rate of rain droplets (Seifert, 2008) and rain selfcollection.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE selfcollection_breakup_rain
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp)     ::  breakup           !<
-       REAL(wp)     ::  dr                !<
-       REAL(wp)     ::  flag              !< flag to mask topography grid points
-       REAL(wp)     ::  phi_br            !<
-       REAL(wp)     ::  selfcoll          !<
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                IF ( qr(k,j,i) > eps_sb  .AND.  nr(k,j,i) > 0.0_wp  )  THEN
-!
-!--                Selfcollection rate (Seifert and Beheng, 2001):
-                   selfcoll = k_rr * nr(k,j,i) * qr(k,j,i) * SQRT( hyrho(k) * rho_surface )
-!
-!--                Weight averaged diameter of rain drops:
-                   dr = ( hyrho(k) * qr(k,j,i) / nr(k,j,i) * dpirho_l )**( 1.0_wp / 3.0_wp )
-!
-!--                Collisional breakup rate (Seifert, 2008):
-                   IF ( dr >= 0.3E-3_wp )  THEN
-                      phi_br  = k_br * ( dr - 1.1E-3_wp )
-                      breakup = selfcoll * ( phi_br + 1.0_wp )
-                   ELSE
-                      breakup = 0.0_wp
-                   ENDIF
-
-                   selfcoll = MAX( breakup - selfcoll, -nr(k,j,i) / dt_micro )
-                   nr(k,j,i) = nr(k,j,i) + selfcoll * dt_micro * flag
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE selfcollection_breakup_rain
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Collisional breakup rate of rain droplets (Seifert, 2008) and rain selfcollection.
-!> Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE selfcollection_breakup_rain_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp)     ::  breakup           !<
-       REAL(wp)     ::  dr                !<
-       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
-       REAL(wp)     ::  phi_br            !<
-       REAL(wp)     ::  selfcoll          !<
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          IF ( qr(k,j,i) > eps_sb  .AND.  nr(k,j,i) > 0.0_wp )  THEN
-!
-!--          Selfcollection rate (Seifert and Beheng, 2001):
-             selfcoll = k_rr * nr(k,j,i) * qr(k,j,i) * SQRT( hyrho(k) * rho_surface )
-!
-!--          Weight averaged diameter of rain drops:
-             dr = ( hyrho(k) * qr(k,j,i) / nr(k,j,i) * dpirho_l )**( 1.0_wp / 3.0_wp )
-!
-!--          Collisional breakup rate (Seifert, 2008):
-             IF ( dr >= 0.3E-3_wp )  THEN
-                phi_br  = k_br * ( dr - 1.1E-3_wp )
-                breakup = selfcoll * ( phi_br + 1.0_wp )
-             ELSE
-                breakup = 0.0_wp
-             ENDIF
-
-             selfcoll = MAX( breakup - selfcoll, -nr(k,j,i) / dt_micro )
-             nr(k,j,i) = nr(k,j,i) + selfcoll * dt_micro * flag
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE selfcollection_breakup_rain_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Selfcollection graupel (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE selfcollection_graupel
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp) ::  dg                  !< power law normalised mean graupel diameter
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  selfcollection_rate !< selfcollection rate
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vg                  !< fall velocity graupel
-       REAL(wp) ::  xg                  !< mean mass of graupel
-
-       REAL(wp), PARAMETER ::  ecoll_gg     = 0.10_wp  !< collision efficiency for graupel selfcollection
-       REAL(wp), PARAMETER ::  ecoll_gg_wet = 0.40_wp  !< in case of wet graupel (T>273.15K)
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                IF ( qg(k,j,i) > eps_sb  .AND.  ng(k,j,i) > 0.0_wp )  THEN
-
-!--                Calculate mean mass of graupel crystal, limit to minimum and maximum value
-!--                SB-scheme
-                   xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-!
-!--                Calculate temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1)
-                   vg = terminal_fall_velocity(cloud_species%graupel, xg, hyrho(k) )
-                   dg = mean_diameter( cloud_species%graupel, xg )
-!
-!                  graupel_coeffs%sc_coll_n  = pi / 8.0_wp * delta_n * theta_n
-                   selfcollection_rate = coll_coeff_graupel_self * ng(k,j,i)**2 * dg**2 * vg
-!
-!--                sticking efficiency does only distinguish dry and wet based on T_3
-                   selfcollection_rate = selfcollection_rate *                                     &
-                                            MERGE( ecoll_gg_wet, ecoll_gg, temp > t3 )
-!
-!--                Limit selfcollection rate
-                   selfcollection_rate = MIN( selfcollection_rate, ng(k,j,i) / dt_micro )
-!
-!--                Reduction of number concentration due to selfcollection
-                   ng(k,j,i) = ng(k,j,i) - selfcollection_rate * dt_micro * flag
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE selfcollection_graupel
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Selfcollection graupel (Seifert and Beheng, 2006). Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE selfcollection_graupel_ij( i, j )
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp) ::  dg                  !< power law normalised mean graupel diameter
-       REAL(wp) ::  flag                !< flag to indicate first grid level above
-       REAL(wp) ::  selfcollection_rate !< selfcollection rate
-       REAL(wp) ::  temp                !< actual temperature
-       REAL(wp) ::  vg                  !< fall velocity graupel
-       REAL(wp) ::  xg                  !< mean mass of graupel
-
-       REAL(wp), PARAMETER ::  ecoll_gg     = 0.10_wp  !< collision efficiency for graupel selfcollection
-       REAL(wp), PARAMETER ::  ecoll_gg_wet = 0.40_wp  !< in case of wet graupel (T>273.15K)
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          IF ( qg(k,j,i) > eps_sb  .AND.  ng(k,j,i) > 0.0_wp )  THEN
-
-!--          Calculate mean mass of graupel crystal, limit to minimum and maximum value concerning
-!--          SB-scheme
-             xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-!
-!--          Calculate temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Calculate mean fall velocity (Seifert and Beheng, 2006: Eq.:33 and Table 1)
-             vg = terminal_fall_velocity(cloud_species%graupel, xg, hyrho(k) )
-             dg = mean_diameter( cloud_species%graupel, xg )
-!
-!            graupel_coeffs%sc_coll_n  = pi / 8.0_wp * delta_n * theta_n
-             selfcollection_rate = coll_coeff_graupel_self * ng(k,j,i)**2 * dg**2 * vg
-!
-!--          sticking efficiency does only distinguish dry and wet based on T_3
-             selfcollection_rate = selfcollection_rate * MERGE( ecoll_gg_wet, ecoll_gg, temp > t3 )
-!
-!--          Limit selfcollection rate
-             selfcollection_rate = MIN( selfcollection_rate, ng(k,j,i) / dt_micro )
-!
-!--          Reduction of number concentration due to selfcollection
-             ng(k,j,i) = ng(k,j,i) - selfcollection_rate * dt_micro * flag
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE selfcollection_graupel_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Selfcollection ice (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE selfcollection_ice
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp) ::  di                      !< diameter ice
-       REAL(wp) ::  di_crit = 100.0E-6_wp   !< critical diameter ice for selfcollection
-       REAL(wp) ::  d_conv_ii = 75.0E-6_wp  !< diameter for conversion to snow
-       REAL(wp) ::  e_coll                  !< collision efficences
-       REAL(wp) ::  flag                    !< flag to indicate first grid level above topography
-       REAL(wp) ::  q_crit_ii = 1.0E-6_wp   !< critical mass
-       REAL(wp) ::  selfcollection_rate_n   !< selfcollection rate number concentration
-       REAL(wp) ::  selfcollection_rate_q   !< selfcollection rate mixing ratio
-       REAL(wp) ::  temp                    !< actual temperature
-       REAL(wp) ::  vi                      !< terminal fall velocity ice crystal
-       REAL(wp) ::  xi                      !< mean mass ice
-       REAL(wp) ::  x_conv_ii               !< mass for conversion to snow
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                IF ( qi(k,j,i) > q_crit_ii  .AND.  ni(k,j,i) > 0.0_wp )  THEN
-!
-!--                Calculate mean mass
-                   xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-!
-!--                Calculate mean diameter of ice particle
-                   di = mean_diameter( cloud_species%ice, xi )
-!
-!--                Selfcollection only takes place if ice particles are large enough
-                   IF ( di < di_crit )  CYCLE
-
-                   x_conv_ii = ( d_conv_ii / cloud_species%snow%a )**(1.0_wp / cloud_species%snow%b )
-!
-!--                Calculate temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Calculate temperaute dependent collision efficiency after Cotton et al., 1986
-                   e_coll = MIN( 10**( 0.035_wp * ( temp - t3 ) - 0.7_wp ), 0.2_wp )
-!
-!--                Calculate terminal fall velocity of ice particles
-                   vi = terminal_fall_velocity(cloud_species%ice, xi, hyrho(k) )
-!
-!--                calcualte self collection rates
-                   selfcollection_rate_n = pi / 4.0_wp * e_coll * coll_coeff_ice_self_delta_n *    &
-                           ni(k,j,i)**2 * di**2  * SQRT( coll_coeff_ice_self_theta_n * vi**2  +    &
-                           2.0_wp * cloud_species%ice%sigma_v**2 )
-
-                   selfcollection_rate_q = pi / 4.0_wp * e_coll * coll_coeff_ice_self_delta_q *    &
-                           ni(k,j,i)* qi(k,j,i) * di**2  * SQRT( coll_coeff_ice_self_theta_q *     &
-                           vi**2  +  2.0_wp * cloud_species%ice%sigma_v**2 )
-!
-!--                Limit selfcollection rates
-                   selfcollection_rate_q = MIN( selfcollection_rate_q, qi(k,j,i) / dt_micro )
-                   selfcollection_rate_n = MIN( MIN( selfcollection_rate_n,                        &
-                                                     qi(k,j,i) / x_conv_ii ),                      &
-                                                ni(k,j,i) / dt_micro )
-!
-!--                Mass transformation to snow and number concentration reduction due to
-!--                selfcollection
-                   qi(k,j,i) = qi(k,j,i) - selfcollection_rate_q * dt_micro * flag
-                   qs(k,j,i) = qs(k,j,i) + selfcollection_rate_q * dt_micro * flag
-
-                   ni(k,j,i) = ni(k,j,i) - selfcollection_rate_n * dt_micro * flag
-                   ns(k,j,i) = ns(k,j,i) + selfcollection_rate_n * dt_micro * flag / 2.0_wp
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE selfcollection_ice
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Selfcollection ice (Seifert and Beheng, 2006). Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE selfcollection_ice_ij( i, j )
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp) ::  di                      !< diameter ice
-       REAL(wp) ::  di_crit = 100.0E-6_wp   !< critical diameter ice for selfcollection
-       REAL(wp) ::  d_conv_ii = 75.0E-6_wp  !< diameter for conversion to snow
-       REAL(wp) ::  e_coll                  !< collision efficences
-       REAL(wp) ::  flag                    !< flag to indicate first grid level above topography
-       REAL(wp) ::  q_crit_ii = 1.0E-6_wp   !< critical mass
-       REAL(wp) ::  selfcollection_rate_n   !< selfcollection rate number concentration
-       REAL(wp) ::  selfcollection_rate_q   !< selfcollection rate mixing ratio
-       REAL(wp) ::  temp                    !< actual temperature
-       REAL(wp) ::  vi                      !< terminal fall velocity ice crystal
-       REAL(wp) ::  xi                      !< mean mass ice
-       REAL(wp) ::  x_conv_ii               !< mass for conversion to snow
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          IF ( qi(k,j,i) > q_crit_ii  .AND.  ni(k,j,i) > 0.0_wp )  THEN
-!
-!--          Calculate mean mass
-             xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-!
-!--          Calculate mean diameter of ice particle
-             di = mean_diameter( cloud_species%ice, xi )
-!
-!--          Selfcollection only takes place if ice particles are large enough
-             IF ( di < di_crit )  CYCLE
-
-             x_conv_ii = ( d_conv_ii / cloud_species%snow%a )**(1.0_wp / cloud_species%snow%b )
-!
-!--          Calculate temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Calculate temperaute dependent collision efficiency after Cotton et al., 1986
-             e_coll = MIN( 10**( 0.035_wp * ( temp - t3 ) - 0.7_wp ), 0.2_wp )
-!
-!--          Calculate terminal fall velocity of ice particles
-             vi = terminal_fall_velocity(cloud_species%ice, xi, hyrho(k) )
-!
-!--          calcualte self collection rates
-             selfcollection_rate_n = pi / 4.0_wp * e_coll * coll_coeff_ice_self_delta_n *          &
-                     ni(k,j,i)**2 * di**2  * SQRT( coll_coeff_ice_self_theta_n * vi**2  +          &
-                     2.0_wp * cloud_species%ice%sigma_v**2 )
-
-             selfcollection_rate_q = pi / 4.0_wp * e_coll * coll_coeff_ice_self_delta_q *          &
-                     ni(k,j,i)* qi(k,j,i) * di**2  * SQRT( coll_coeff_ice_self_theta_q * vi**2  +  &
-                     2.0_wp * cloud_species%ice%sigma_v**2 )
-!
-!--          Limit selfcollection rates
-             selfcollection_rate_q = MIN( selfcollection_rate_q, qi(k,j,i) / dt_micro )
-             selfcollection_rate_n = MIN( MIN( selfcollection_rate_n, qi(k,j,i) / x_conv_ii ),     &
-                                          ni(k,j,i) / dt_micro )
-!
-!--          Mass transformation to snow and number concentration reduction due to selfcollection
-             qi(k,j,i) = qi(k,j,i) - selfcollection_rate_q * dt_micro * flag
-             qs(k,j,i) = qs(k,j,i) + selfcollection_rate_q * dt_micro * flag
-
-             ni(k,j,i) = ni(k,j,i) - selfcollection_rate_n * dt_micro * flag
-             ns(k,j,i) = ns(k,j,i) + selfcollection_rate_n * dt_micro * flag / 2.0_wp
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE selfcollection_ice_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Selfcollection snow (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE selfcollection_snow
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp) ::  ds                      !< diameter snow
-       REAL(wp) ::  e_coll                  !< collision efficiency
-       REAL(wp) ::  flag                    !< flag to indicate first grid level above topography
-       REAL(wp) ::  selfcollection_rate_n   !< selfcollection rate number concentration
-       REAL(wp) ::  temp                    !< actual temperature
-       REAL(wp) ::  vs                      !< terminal fall velocites snow
-       REAL(wp) ::  xs                      !< mean mass snow
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                IF ( qs(k,j,i) > eps_sb  .AND.  ns(k,j,i) > 0.0_wp )  THEN
-!
-!--                Calculate temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Temperature depending collision efficiency
-                   e_coll = MAX( 0.1_wp, MIN( EXP( 0.09_wp * (temp - t3) ), 1.0_wp ) )
-!
-!--                Calculate mean mass
-                   xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-!
-!--                Calculate mean diameter of ice particle
-                   ds = mean_diameter( cloud_species%snow, xs )
-!
-!--                Calculate terminal fall velocity of ice particles
-                   vs = terminal_fall_velocity(cloud_species%snow, xs, hyrho(k) )
-!
-!--                Calculate selfcollection
-                   selfcollection_rate_n = pi / 8.0_wp * e_coll * ns(k,j,i)**2 *                   &
-                      coll_coeff_snow_self_delta * ds**2 *                                         &
-                      SQRT( coll_coeff_snow_self_theta * vs**2 + 2.0_wp *                          &
-                            cloud_species%snow%sigma_v**2 )
-!
-!--                Limit selfcollection rate
-                   selfcollection_rate_n = MIN( selfcollection_rate_n, ns(k,j,i) / dt_micro )
-!
-!--                Reduction of number concentration due to selfcollection
-                   ns(k,j,i) = ns(k,j,i) - selfcollection_rate_n * dt_micro * flag
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE selfcollection_snow
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Selfcollection snow (Seifert and Beheng, 2006). Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE selfcollection_snow_ij( i, j )
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp) ::  ds                      !< diameter snow
-       REAL(wp) ::  e_coll                  !< collision efficiency
-       REAL(wp) ::  flag                    !< flag to indicate first grid level above topography
-       REAL(wp) ::  selfcollection_rate_n   !< selfcollection rate number concentration
-       REAL(wp) ::  temp                    !< actual temperature
-       REAL(wp) ::  vs                      !< terminal fall velocites snow
-       REAL(wp) ::  xs                      !< mean mass snow
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          IF ( qs(k,j,i) > eps_sb  .AND.  ns(k,j,i) > 0.0_wp )  THEN
-!
-!--          Calculate temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Temperature depending collision efficiency
-             e_coll = MAX( 0.1_wp, MIN( EXP( 0.09_wp * (temp - t3) ), 1.0_wp ) )
-!
-!--          Calculate mean mass
-             xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-!
-!--          Calculate mean diameter of ice particle
-             ds = mean_diameter( cloud_species%snow, xs )
-!
-!--          Calculate terminal fall velocity of ice particles
-             vs = terminal_fall_velocity(cloud_species%snow, xs, hyrho(k) )
-!
-!--          Calculate selfcollection
-             selfcollection_rate_n = pi / 8.0_wp * e_coll * ns(k,j,i)**2 *                         &
-                coll_coeff_snow_self_delta * ds**2 *                                               &
-                SQRT( coll_coeff_snow_self_theta * vs**2 + 2.0_wp * cloud_species%snow%sigma_v**2 )
-!
-!--          Limit selfcollection rate
-             selfcollection_rate_n = MIN( selfcollection_rate_n, ns(k,j,i) / dt_micro )
-!
-!--          Reduction of number concentration due to selfcollection
-             ns(k,j,i) = ns(k,j,i) - selfcollection_rate_n * dt_micro * flag
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE selfcollection_snow_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Collection of type a + b -> a. Here: graupel + ice -> graupel (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE collection_graupel_ice
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  coll_rate_n   !< collection rate for number concentration
-       REAL(wp) ::  coll_rate_q   !< collection factor for mixing ratio
-       REAL(wp) ::  di            !< diameter ice
-       REAL(wp) ::  dg            !< diameter graupel
-       REAL(wp) ::  e_coll        !< collection efficiency
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vg            !< terminal fall velocitiy graupel
-       REAL(wp) ::  vi            !< terminal fall velocitiy ice
-       REAL(wp) ::  xg            !< mean mass graupel
-       REAL(wp) ::  xi            !< mean mass ice
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Apply collection only above threshold
-                IF ( qi(k,j,i) > eps_sb_coll  .AND.  qg(k,j,i) > eps_sb_coll )  THEN
-!
-!--                Calculate temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Sticking efficiency of Lin (1983)
-                   e_coll = MIN( EXP( 0.09_wp * (temp - t3) ), 1.0_wp )
-!
-!--                Calculate mean mass, mean diameter and mean terminal fall velocites for both ice
-!--                and graupel
-                   xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-                   xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-
-                   di = mean_diameter( cloud_species%ice, xi )
-                   dg = mean_diameter( cloud_species%graupel, xg )
-
-                   vi = terminal_fall_velocity(cloud_species%ice, xi, hyrho(k) )
-                   vg = terminal_fall_velocity(cloud_species%graupel, xg, hyrho(k) )
-!
-!--                Calculate collection rate for number concentration
-                   coll_rate_n = pi / 4.0_wp * ng(k,j,i) * ni(k,j,i) * e_coll *                    &
-                             ( coll_graupel_ice_delta_n_aa * dg**2 +                               &
-                               coll_graupel_ice_delta_n_ab * dg * di +                             &
-                               coll_graupel_ice_delta_n_bb * di**2                                 &
-                             ) *                                                                   &
-                         SQRT( coll_graupel_ice_theta_n_aa * vg**2 -                               &
-                               coll_graupel_ice_theta_n_ab * vg * vi +                             &
-                               coll_graupel_ice_theta_n_bb * vi**2 +                               &
-                               cloud_species%ice%sigma_v**2                                        &
-                             )
-!
-!--                Calculate collection rate for mixing ratio
-                   coll_rate_q = pi / 4.0_wp * ng(k,j,i) * qi(k,j,i) * e_coll *                    &
-                             ( coll_graupel_ice_delta_q_aa * dg**2 +                               &
-                               coll_graupel_ice_delta_q_ab * dg * di +                             &
-                               coll_graupel_ice_delta_q_bb * di**2                                 &
-                             ) *                                                                   &
-                         SQRT( coll_graupel_ice_theta_q_aa * vg**2 -                               &
-                               coll_graupel_ice_theta_q_ab * vg * vi +                             &
-                               coll_graupel_ice_theta_q_bb * vi**2 +                               &
-                               cloud_species%ice%sigma_v**2                                        &
-                             )
-!
-!--                Limit collection rates
-                   coll_rate_n = MIN( ni(k,j,i) / dt_micro, coll_rate_n )
-                   coll_rate_q = MIN( qi(k,j,i) / dt_micro, coll_rate_q )
-!
-!--                Add/substract rates from species
-                   qg(k,j,i) = qg(k,j,i) + coll_rate_q * dt_micro * flag
-                   qi(k,j,i) = qi(k,j,i) - coll_rate_q * dt_micro * flag
-                   ni(k,j,i) = ni(k,j,i) - coll_rate_n * dt_micro * flag
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE collection_graupel_ice
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Collection of type a + b -> a. Here: graupel + ice -> graupel (Seifert and Beheng, 2006).
-!> Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE collection_graupel_ice_ij( i, j )
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  coll_rate_n   !< collection rate for number concentration
-       REAL(wp) ::  coll_rate_q   !< collection factor for mixing ratio
-       REAL(wp) ::  di            !< diameter ice
-       REAL(wp) ::  dg            !< diameter graupel
-       REAL(wp) ::  e_coll        !< collection efficiency
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vg            !< terminal fall velocitiy graupel
-       REAL(wp) ::  vi            !< terminal fall velocitiy ice
-       REAL(wp) ::  xg            !< mean mass graupel
-       REAL(wp) ::  xi            !< mean mass ice
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Apply collection only above threshold
-          IF ( qi(k,j,i) > eps_sb_coll  .AND.  qg(k,j,i) > eps_sb_coll )  THEN
-!
-!--          Calculate temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Sticking efficiency of Lin (1983)
-             e_coll = MIN( EXP( 0.09_wp * (temp - t3) ), 1.0_wp )
-!
-!--          Calculate mean mass, mean diameter and mean terminal fall velocites for both ice
-!--          and graupel
-             xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-             xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-
-             di = mean_diameter( cloud_species%ice, xi )
-             dg = mean_diameter( cloud_species%graupel, xg )
-
-             vi = terminal_fall_velocity(cloud_species%ice, xi, hyrho(k) )
-             vg = terminal_fall_velocity(cloud_species%graupel, xg, hyrho(k) )
-!
-!--          Calculate collection rate for number concentration
-             coll_rate_n = pi / 4.0_wp * ng(k,j,i) * ni(k,j,i) * e_coll *                          &
-                       ( coll_graupel_ice_delta_n_aa * dg**2 +                                     &
-                         coll_graupel_ice_delta_n_ab * dg * di +                                   &
-                         coll_graupel_ice_delta_n_bb * di**2                                       &
-                       ) *                                                                         &
-                   SQRT( coll_graupel_ice_theta_n_aa * vg**2 -                                     &
-                         coll_graupel_ice_theta_n_ab * vg * vi +                                   &
-                         coll_graupel_ice_theta_n_bb * vi**2 +                                     &
-                         cloud_species%ice%sigma_v**2                                              &
-                       )
-!
-!--          Calculate collection rate for mixing ratio
-             coll_rate_q = pi / 4.0_wp * ng(k,j,i) * qi(k,j,i) * e_coll *                          &
-                       ( coll_graupel_ice_delta_q_aa * dg**2 +                                     &
-                         coll_graupel_ice_delta_q_ab * dg * di +                                   &
-                         coll_graupel_ice_delta_q_bb * di**2                                       &
-                       ) *                                                                         &
-                   SQRT( coll_graupel_ice_theta_q_aa * vg**2 -                                     &
-                         coll_graupel_ice_theta_q_ab * vg * vi +                                   &
-                         coll_graupel_ice_theta_q_bb * vi**2 +                                     &
-                         cloud_species%ice%sigma_v**2                                              &
-                       )
-!
-!--          Limit collection rates
-             coll_rate_n = MIN( ni(k,j,i) / dt_micro, coll_rate_n )
-             coll_rate_q = MIN( qi(k,j,i) / dt_micro, coll_rate_q )
-!
-!--          Add/substract rates from species
-             qg(k,j,i) = qg(k,j,i) + coll_rate_q * dt_micro * flag
-             qi(k,j,i) = qi(k,j,i) - coll_rate_q * dt_micro * flag
-             ni(k,j,i) = ni(k,j,i) - coll_rate_n * dt_micro * flag
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE collection_graupel_ice_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Collection of type a + b -> a. Here: snow + ice -> snow (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE collection_snow_ice
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  coll_rate_n   !< collection rate for number concentration
-       REAL(wp) ::  coll_rate_q   !< collection factor for mixing ratio
-       REAL(wp) ::  di            !< diameter ice
-       REAL(wp) ::  ds            !< diameter snow
-       REAL(wp) ::  e_coll        !< collection efficiency
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vs            !< terminal fall velocitiy snow
-       REAL(wp) ::  vi            !< terminal fall velocitiy ice
-       REAL(wp) ::  xs            !< mean mass snow
-       REAL(wp) ::  xi            !< mean mass ice
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Apply collection only above threshold
-                IF ( qi(k,j,i) > eps_sb_coll  .AND.  qs(k,j,i) > eps_sb_coll )  THEN
-!
-!--                Calculate temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Sticking efficiency of Lin (1983)
-                   e_coll = MIN( EXP( 0.09_wp * (temp - t3) ), 1.0_wp )
-!
-!--                Calculate mean mass, mean diameter and mean terminal fall velocites for both ice
-!--                and snow
-                   xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-                   xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-
-                   di = mean_diameter( cloud_species%ice,  xi )
-                   ds = mean_diameter( cloud_species%snow, xs )
-
-                   vi = terminal_fall_velocity(cloud_species%ice,  xi, hyrho(k) )
-                   vs = terminal_fall_velocity(cloud_species%snow, xs, hyrho(k) )
-!
-!--                Calculate collection rate for number concentration
-                   coll_rate_n = pi / 4.0_wp * ns(k,j,i) * ni(k,j,i) * e_coll *                    &
-                             ( coll_snow_ice_delta_n_aa * ds**2 +                                  &
-                               coll_snow_ice_delta_n_ab * ds * di +                                &
-                               coll_snow_ice_delta_n_bb * di**2                                    &
-                             ) *                                                                   &
-                         SQRT( coll_snow_ice_theta_n_aa * vs**2 -                                  &
-                               coll_snow_ice_theta_n_ab * vs * vi +                                &
-                               coll_snow_ice_theta_n_bb * vi**2 +                                  &
-                               cloud_species%ice%sigma_v**2                                        &
-                             )
-!
-!--                Calculate collection rate for mixing ratio
-                   coll_rate_q = pi / 4.0_wp * ns(k,j,i) * qi(k,j,i) * e_coll *                    &
-                             ( coll_snow_ice_delta_q_aa * ds**2 +                                  &
-                               coll_snow_ice_delta_q_ab * ds * di +                                &
-                               coll_snow_ice_delta_q_bb * di**2                                    &
-                             ) *                                                                   &
-                         SQRT( coll_snow_ice_theta_q_aa * vs**2 -                                  &
-                               coll_snow_ice_theta_q_ab * vs * vi +                                &
-                               coll_snow_ice_theta_q_bb * vi**2 +                                  &
-                               cloud_species%ice%sigma_v**2                                        &
-                             )
-!
-!--                Limit collection rates
-                   coll_rate_n = MIN( ni(k,j,i) / dt_micro, coll_rate_n )
-                   coll_rate_q = MIN( qi(k,j,i) / dt_micro, coll_rate_q )
-!
-!--                Add/substract rates from species
-                   qs(k,j,i) = qs(k,j,i) + coll_rate_q * dt_micro * flag
-                   qi(k,j,i) = qi(k,j,i) - coll_rate_q * dt_micro * flag
-                   ni(k,j,i) = ni(k,j,i) - coll_rate_n * dt_micro * flag
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE collection_snow_ice
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Collection of type a + b -> a. Here: snow + ice -> snow (Seifert and Beheng, 2006).
-!> Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE collection_snow_ice_ij( i, j )
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  coll_rate_n   !< collection rate for number concentration
-       REAL(wp) ::  coll_rate_q   !< collection factor for mixing ratio
-       REAL(wp) ::  di            !< diameter ice
-       REAL(wp) ::  ds            !< diameter snow
-       REAL(wp) ::  e_coll        !< collection efficiency
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vs            !< terminal fall velocitiy snow
-       REAL(wp) ::  vi            !< terminal fall velocitiy ice
-       REAL(wp) ::  xs            !< mean mass snow
-       REAL(wp) ::  xi            !< mean mass ice
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Apply collection only above threshold
-          IF ( qi(k,j,i) > eps_sb_coll  .AND.  qs(k,j,i) > eps_sb_coll )  THEN
-!
-!--          Calculate temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Sticking efficiency of Lin (1983)
-             e_coll = MIN( EXP( 0.09_wp * (temp - t3) ), 1.0_wp )
-!
-!--          Calculate mean mass, mean diameter and mean terminal fall velocites for both ice
-!--          and snow
-             xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-             xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-
-             di = mean_diameter( cloud_species%ice,  xi )
-             ds = mean_diameter( cloud_species%snow, xs )
-
-             vi = terminal_fall_velocity(cloud_species%ice,  xi, hyrho(k) )
-             vs = terminal_fall_velocity(cloud_species%snow, xs, hyrho(k) )
-!
-!--          Calculate collection rate for number concentration
-             coll_rate_n = pi / 4.0_wp * ns(k,j,i) * ni(k,j,i) * e_coll *                          &
-                       ( coll_snow_ice_delta_n_aa * ds**2 +                                        &
-                         coll_snow_ice_delta_n_ab * ds * di +                                      &
-                         coll_snow_ice_delta_n_bb * di**2                                          &
-                       ) *                                                                         &
-                   SQRT( coll_snow_ice_theta_n_aa * vs**2 -                                        &
-                         coll_snow_ice_theta_n_ab * vs * vi +                                      &
-                         coll_snow_ice_theta_n_bb * vi**2 +                                        &
-                         cloud_species%ice%sigma_v**2                                              &
-                       )
-!
-!--          Calculate collection rate for mixing ratio
-             coll_rate_q = pi / 4.0_wp * ns(k,j,i) * qi(k,j,i) * e_coll *                          &
-                       ( coll_snow_ice_delta_q_aa * ds**2 +                                        &
-                         coll_snow_ice_delta_q_ab * ds * di +                                      &
-                         coll_snow_ice_delta_q_bb * di**2                                          &
-                       ) *                                                                         &
-                   SQRT( coll_snow_ice_theta_q_aa * vs**2 -                                        &
-                         coll_snow_ice_theta_q_ab * vs * vi +                                      &
-                         coll_snow_ice_theta_q_bb * vi**2 +                                        &
-                         cloud_species%ice%sigma_v**2                                              &
-                       )
-!
-!--          Limit collection rates
-             coll_rate_n = MIN( ni(k,j,i) / dt_micro, coll_rate_n )
-             coll_rate_q = MIN( qi(k,j,i) / dt_micro, coll_rate_q )
-!
-!--          Add/substract rates from species
-             qs(k,j,i) = qs(k,j,i) + coll_rate_q * dt_micro * flag
-             qi(k,j,i) = qi(k,j,i) - coll_rate_q * dt_micro * flag
-             ni(k,j,i) = ni(k,j,i) - coll_rate_n * dt_micro * flag
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE collection_snow_ice_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Collection of type a + b -> a. Here: graupel + snow -> snow (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE collection_graupel_snow
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  coll_rate_n   !< collection rate for number concentration
-       REAL(wp) ::  coll_rate_q   !< collection factor for mixing ratio
-       REAL(wp) ::  dg            !< diameter graupel
-       REAL(wp) ::  ds            !< diameter snow
-       REAL(wp) ::  e_coll        !< collection efficiency
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vg            !< terminal fall velocitiy graupel
-       REAL(wp) ::  vs            !< terminal fall velocitiy snow
-       REAL(wp) ::  xg            !< mean mass graupel
-       REAL(wp) ::  xs            !< mean mass snow
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Apply collection only above threshold
-                IF ( qg(k,j,i) > eps_sb_coll  .AND.  qs(k,j,i) > eps_sb_coll )  THEN
-!
-!--                Calculate temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Sticking efficiency of Lin (1983)
-                   e_coll = MIN( EXP( 0.09_wp * (temp - t3) ), 1.0_wp )
-!
-!--                Calculate mean mass, mean diameter and mean terminal fall velocites for both
-!--                graupel and snow
-                   xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-                   xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-
-                   dg = mean_diameter( cloud_species%graupel,  xg )
-                   ds = mean_diameter( cloud_species%snow,     xs )
-
-                   vg = terminal_fall_velocity(cloud_species%graupel,  xg, hyrho(k) )
-                   vs = terminal_fall_velocity(cloud_species%snow,     xs, hyrho(k) )
-!
-!--                Calculate collection rate for number concentration
-                   coll_rate_n = pi / 4.0_wp * ng(k,j,i) * ns(k,j,i) * e_coll *                    &
-                             ( coll_graupel_snow_delta_n_aa * dg**2 +                              &
-                               coll_graupel_snow_delta_n_ab * dg * ds +                            &
-                               coll_graupel_snow_delta_n_bb * ds**2                                &
-                             ) *                                                                   &
-                         SQRT( coll_graupel_snow_theta_n_aa * vg**2 -                              &
-                               coll_graupel_snow_theta_n_ab * vg * vs +                            &
-                               coll_graupel_snow_theta_n_bb * vs**2 +                              &
-                               cloud_species%snow%sigma_v**2                                       &
-                             )
-!
-!--                Calculate collection rate for mixing ratio
-                   coll_rate_q = pi / 4.0_wp * ng(k,j,i) * qs(k,j,i) * e_coll *                    &
-                             ( coll_graupel_snow_delta_q_aa * dg**2 +                              &
-                               coll_graupel_snow_delta_q_ab * dg * ds +                            &
-                               coll_graupel_snow_delta_q_bb * ds**2                                &
-                             ) *                                                                   &
-                         SQRT( coll_graupel_snow_theta_q_aa * vg**2 -                              &
-                               coll_graupel_snow_theta_q_ab * vg * vs +                            &
-                               coll_graupel_snow_theta_q_bb * vs**2 +                              &
-                               cloud_species%snow%sigma_v**2                                       &
-                             )
-!
-!--                Limit collection rates
-                   coll_rate_n = MIN( ns(k,j,i) / dt_micro, coll_rate_n )
-                   coll_rate_q = MIN( qs(k,j,i) / dt_micro, coll_rate_q )
-!
-!--                Add/substract rates from species
-                   qg(k,j,i) = qg(k,j,i) + coll_rate_q * dt_micro * flag
-                   qs(k,j,i) = qs(k,j,i) - coll_rate_q * dt_micro * flag
-                   ns(k,j,i) = ns(k,j,i) - coll_rate_n * dt_micro * flag
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE collection_graupel_snow
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Collection of type a + b -> a. Here: graupel + snow -> snow (Seifert and Beheng, 2006).
-!> Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE collection_graupel_snow_ij( i, j )
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  coll_rate_n   !< collection rate for number concentration
-       REAL(wp) ::  coll_rate_q   !< collection factor for mixing ratio
-       REAL(wp) ::  dg            !< diameter graupel
-       REAL(wp) ::  ds            !< diameter snow
-       REAL(wp) ::  e_coll        !< collection efficiency
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vg            !< terminal fall velocitiy graupel
-       REAL(wp) ::  vs            !< terminal fall velocitiy snow
-       REAL(wp) ::  xg            !< mean mass graupel
-       REAL(wp) ::  xs            !< mean mass snow
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Apply collection only above threshold
-          IF ( qg(k,j,i) > eps_sb_coll  .AND.  qs(k,j,i) > eps_sb_coll )  THEN
-!
-!--          Calculate temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Sticking efficiency of Lin (1983)
-             e_coll = MIN( EXP( 0.09_wp * (temp - t3) ), 1.0_wp )
-!
-!--          Calculate mean mass, mean diameter and mean terminal fall velocites for both graupel
-!--          and snow
-             xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-             xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-
-             dg = mean_diameter( cloud_species%graupel,  xg )
-             ds = mean_diameter( cloud_species%snow,     xs )
-
-             vg = terminal_fall_velocity(cloud_species%graupel,  xg, hyrho(k) )
-             vs = terminal_fall_velocity(cloud_species%snow,     xs, hyrho(k) )
-!
-!--          Calculate collection rate for number concentration
-             coll_rate_n = pi / 4.0_wp * ng(k,j,i) * ns(k,j,i) * e_coll *                              &
-                       ( coll_graupel_snow_delta_n_aa * dg**2 +                                        &
-                         coll_graupel_snow_delta_n_ab * dg * ds +                                      &
-                         coll_graupel_snow_delta_n_bb * ds**2                                          &
-                       ) *                                                                             &
-                   SQRT( coll_graupel_snow_theta_n_aa * vg**2 -                                        &
-                         coll_graupel_snow_theta_n_ab * vg * vs +                                      &
-                         coll_graupel_snow_theta_n_bb * vs**2 +                                        &
-                         cloud_species%snow%sigma_v**2                                                 &
-                       )
-!
-!--          Calculate collection rate for mixing ratio
-             coll_rate_q = pi / 4.0_wp * ng(k,j,i) * qs(k,j,i) * e_coll *                              &
-                       ( coll_graupel_snow_delta_q_aa * dg**2 +                                        &
-                         coll_graupel_snow_delta_q_ab * dg * ds +                                      &
-                         coll_graupel_snow_delta_q_bb * ds**2                                          &
-                       ) *                                                                             &
-                   SQRT( coll_graupel_snow_theta_q_aa * vg**2 -                                        &
-                         coll_graupel_snow_theta_q_ab * vg * vs +                                      &
-                         coll_graupel_snow_theta_q_bb * vs**2 +                                        &
-                         cloud_species%snow%sigma_v**2                                                 &
-                       )
-!
-!--          Limit collection rates
-             coll_rate_n = MIN( ns(k,j,i) / dt_micro, coll_rate_n )
-             coll_rate_q = MIN( qs(k,j,i) / dt_micro, coll_rate_q )
-!
-!--          Add/substract rates from species
-             qg(k,j,i) = qg(k,j,i) + coll_rate_q * dt_micro * flag
-             qs(k,j,i) = qs(k,j,i) - coll_rate_q * dt_micro * flag
-             ns(k,j,i) = ns(k,j,i) - coll_rate_n * dt_micro * flag
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE collection_graupel_snow_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of cloud and graupel (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_graupel_cloud
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  dc            !< diameter cloud
-       REAL(wp) ::  dg            !< diameter graupel
-       REAL(wp) ::  const1        !< constant for riming efficiency
-       REAL(wp) ::  e_coll_n      !< collision efficences for number concentration
-       REAL(wp) ::  e_coll_q      !< collision efficences for mixing ratio
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  melt_n        !< melting rate number concentration
-       REAL(wp) ::  melt_q        !< melting rate mixing ratio
-       REAL(wp) ::  mult_n        !< ice multiplaction for number concentration
-       REAL(wp) ::  mult_q        !< ice multiplaction
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  nc_c          !< dummy number concentration cloud
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_q !< riming rate mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vc            !< terminal fall velocitiy cloud
-       REAL(wp) ::  vg            !< terminal fall velocitiy graupel
-       REAL(wp) ::  xc            !< mean mass cloud
-       REAL(wp) ::  xg            !< mean mass graupel
-
-       REAL(wp), PARAMETER ::  const0 = 1.0 / ( dc_coll - dc_crit )             !< constant for riming
-       REAL(wp), PARAMETER ::  const2 = 1.0 / ( temp_mult_opt - temp_mult_min ) !< constant for ice multiplaction
-       REAL(wp), PARAMETER ::  const3 = 1.0 / ( temp_mult_opt - temp_mult_max ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const4 = c_w / l_m                               !< constant for melting
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                IF ( microphysics_morrison )  THEN
-                   nc_c = nc(k,j,i)
-                ELSE
-                   nc_c = nc_const
-                ENDIF
-!
-!--             Calculate mean mass, mean diameter for both graupel and cloud
-                xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-                xc = mean_mass( cloud_species%cloud,   qc(k,j,i), nc_c, hyrho(k) )
-
-                dg = mean_diameter( cloud_species%graupel,  xg )
-                dc = mean_diameter( cloud_species%cloud,    xc )
-!
-!--             Apply riming only above threshold
-                IF ( qc(k,j,i) > q_thres  .AND.  qg(k,j,i) > q_thres  .AND.                        &
-                     dc > dc_crit  .AND.  dg > df_crit )  THEN
-
-                   const1 = const0 * cloud_species%graupel%coll_eff
-!
-!--                Calculate terminal velocites
-                   vg = terminal_fall_velocity(cloud_species%graupel,  xg, hyrho(k) )
-                   vc = terminal_fall_velocity(cloud_species%cloud,    xc, hyrho(k) )
-!
-!--                Calcualte collision_effciens
-                   e_coll_n = MIN( cloud_species%graupel%coll_eff, MAX( const1 * ( dc - dc_crit ), &
-                                                                        ecoll_min ) )
-                   e_coll_q = e_coll_n
-!
-!--                Calculate riming rates
-                   riming_rate_n = pi / 4.0_wp * e_coll_n * ng(k,j,i) * nc_c *                     &
-                            ( rime_graupel_cloud_delta_n_aa * dg**2 +                              &
-                              rime_graupel_cloud_delta_n_ab * dg * dc +                            &
-                              rime_graupel_cloud_delta_n_bb * dc**2 ) *                            &
-                        SQRT( rime_graupel_cloud_theta_n_aa * vg**2 -                              &
-                              rime_graupel_cloud_theta_n_ab * vg * vc +                            &
-                              rime_graupel_cloud_theta_n_bb * vc**2 )
-
-                   riming_rate_q = pi / 4.0_wp * e_coll_q * ng(k,j,i) * qc(k,j,i) *                &
-                            ( rime_graupel_cloud_delta_q_aa * dg**2 +                              &
-                              rime_graupel_cloud_delta_q_ab * dg * dc +                            &
-                              rime_graupel_cloud_delta_q_bb * dc**2) *                             &
-                        SQRT( rime_graupel_cloud_theta_q_aa * vg**2 -                              &
-                              rime_graupel_cloud_theta_q_ab * vg * vc +                            &
-                              rime_graupel_cloud_theta_q_bb * vc**2 )
-!
-!--                Limit riming rates
-                   riming_rate_q = MIN( qc(k,j,i) / dt_micro, riming_rate_q )
-                   riming_rate_n = MIN( nc_c / dt_micro, riming_rate_n )
-!
-!--                Add/substract riming rates
-                   qg(k,j,i) = qg(k,j,i) + riming_rate_q * dt_micro * flag
-                   qc(k,j,i) = qc(k,j,i) - riming_rate_q * dt_micro * flag
-                   IF ( microphysics_morrison )  THEN
-                       nc(k,j,i) = nc(k,j,i) - riming_rate_n * dt_micro * flag
-                   ENDIF
-!
-!--                Calcualte temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Ice multiplication based on Hallet and Mossop
-                   IF ( temp < t3  .AND.  ice_multiplication )  THEN
-                      mult_1 = const2 * ( temp - temp_mult_min )
-                      mult_2 = const3 * ( temp - temp_mult_max )
-                      mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp ) )
-                      mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp ) )
-                      mult_n = c_mult * mult_1 * mult_2 * riming_rate_q
-                      mult_q = mult_n * cloud_species%ice%x_min
-                      mult_q = MIN( riming_rate_q, mult_q )
-!
-!--                   Apply Hallet Mossop process
-                      ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                      qi(k,j,i) = qi(k,j,i) + mult_q * dt_micro * flag
-                      qg(k,j,i) = qg(k,j,i) - mult_q * dt_micro * flag
-                   ENDIF
-!
-!--                Enhancement of melting
-                   IF ( temp > t3  .AND.  enhanced_melting )  THEN
-                      melt_q = const4 * ( temp - t3 ) * riming_rate_q
-                      melt_n = melt_q / xg
-                      melt_q = MIN( qg(k,j,i) / dt_micro, melt_q )
-                      melt_n = MIN( ng(k,j,i) / dt_micro, melt_n )
-!
-!--                   Apply enhancement due to melting
-                      qg(k,j,i) = qg(k,j,i) - melt_q * dt_micro * flag
-                      qr(k,j,i) = qr(k,j,i) + melt_q * dt_micro * flag
-                      ng(k,j,i) = ng(k,j,i) - melt_n * dt_micro * flag
-                      nr(k,j,i) = nr(k,j,i) + melt_n * dt_micro * flag
-                   ENDIF
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE riming_graupel_cloud
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of cloud and graupel (Seifert and Beheng, 2006).
-!> Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_graupel_cloud_ij( i, j )
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  dc            !< diameter cloud
-       REAL(wp) ::  dg            !< diameter graupel
-       REAL(wp) ::  const1        !< constant for riming efficiency
-       REAL(wp) ::  e_coll_n      !< collision efficences for number concentration
-       REAL(wp) ::  e_coll_q      !< collision efficences for mixing ratio
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  melt_n        !< melting rate number concentration
-       REAL(wp) ::  melt_q        !< melting rate mixing ratio
-       REAL(wp) ::  mult_n        !< ice multiplaction for number concentration
-       REAL(wp) ::  mult_q        !< ice multiplaction
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  nc_c          !< dummy number concentration cloud
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_q !< riming rate mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vc            !< terminal fall velocitiy cloud
-       REAL(wp) ::  vg            !< terminal fall velocitiy graupel
-       REAL(wp) ::  xc            !< mean mass cloud
-       REAL(wp) ::  xg            !< mean mass graupel
-
-       REAL(wp), PARAMETER ::  const0 = 1.0 / ( dc_coll - dc_crit )             !< constant for riming
-       REAL(wp), PARAMETER ::  const2 = 1.0 / ( temp_mult_opt - temp_mult_min ) !< constant for ice multiplaction
-       REAL(wp), PARAMETER ::  const3 = 1.0 / ( temp_mult_opt - temp_mult_max ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const4 = c_w / l_m                               !< constant for melting
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-          IF ( microphysics_morrison )  THEN
-             nc_c = nc(k,j,i)
-          ELSE
-             nc_c = nc_const
-          ENDIF
-!
-!--       Calculate mean mass, mean diameter for both graupel and cloud
-          xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-          xc = mean_mass( cloud_species%cloud,   qc(k,j,i), nc_c, hyrho(k) )
-
-          dg = mean_diameter( cloud_species%graupel,  xg )
-          dc = mean_diameter( cloud_species%cloud,    xc )
-!
-!--       Apply riming only above threshold
-          IF ( qc(k,j,i) > q_thres  .AND.  qg(k,j,i) > q_thres  .AND.                              &
-               dc > dc_crit  .AND.  dg > df_crit )  THEN
-
-             const1 = const0 * cloud_species%graupel%coll_eff
-!
-!--          Calculate terminal velocites
-             vg = terminal_fall_velocity(cloud_species%graupel,  xg, hyrho(k) )
-             vc = terminal_fall_velocity(cloud_species%cloud,    xc, hyrho(k) )
-!
-!--          Calcualte collision_effciens
-             e_coll_n = MIN( cloud_species%graupel%coll_eff, MAX( const1 * ( dc - dc_crit ),       &
-                                                                  ecoll_min ) )
-             e_coll_q = e_coll_n
-!
-!--          Calculate riming rates
-             riming_rate_n = pi / 4.0_wp * e_coll_n * ng(k,j,i) * nc_c *                           &
-                      ( rime_graupel_cloud_delta_n_aa * dg**2 +                                    &
-                        rime_graupel_cloud_delta_n_ab * dg * dc +                                  &
-                        rime_graupel_cloud_delta_n_bb * dc**2 ) *                                  &
-                  SQRT( rime_graupel_cloud_theta_n_aa * vg**2 -                                    &
-                        rime_graupel_cloud_theta_n_ab * vg * vc +                                  &
-                        rime_graupel_cloud_theta_n_bb * vc**2 )
-
-             riming_rate_q = pi / 4.0_wp * e_coll_q * ng(k,j,i) * qc(k,j,i) *                      &
-                      ( rime_graupel_cloud_delta_q_aa * dg**2 +                                    &
-                        rime_graupel_cloud_delta_q_ab * dg * dc +                                  &
-                        rime_graupel_cloud_delta_q_bb * dc**2) *                                   &
-                  SQRT( rime_graupel_cloud_theta_q_aa * vg**2 -                                    &
-                        rime_graupel_cloud_theta_q_ab * vg * vc +                                  &
-                        rime_graupel_cloud_theta_q_bb * vc**2 )
-!
-!--          Limit riming rates
-             riming_rate_q = MIN( qc(k,j,i) / dt_micro, riming_rate_q )
-             riming_rate_n = MIN( nc_c / dt_micro, riming_rate_n )
-!
-!--          Add/substract riming rates
-             qg(k,j,i) = qg(k,j,i) + riming_rate_q * dt_micro * flag
-             qc(k,j,i) = qc(k,j,i) - riming_rate_q * dt_micro * flag
-             IF ( microphysics_morrison )  THEN
-                 nc(k,j,i) = nc(k,j,i) - riming_rate_n * dt_micro * flag
-             ENDIF
-!
-!--          Calcualte temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Ice multiplication based on Hallet and Mossop
-             IF ( temp < t3  .AND.  ice_multiplication )  THEN
-                mult_1 = const2 * ( temp - temp_mult_min )
-                mult_2 = const3 * ( temp - temp_mult_max )
-                mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp ) )
-                mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp ) )
-                mult_n = c_mult * mult_1 * mult_2 * riming_rate_q
-                mult_q = mult_n * cloud_species%ice%x_min
-                mult_q = MIN( riming_rate_q, mult_q )
-!
-!--             Apply Hallet Mossop process
-                ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                qi(k,j,i) = qi(k,j,i) + mult_q * dt_micro * flag
-                qg(k,j,i) = qg(k,j,i) - mult_q * dt_micro * flag
-             ENDIF
-!
-!--          Enhancement of melting
-             IF ( temp > t3  .AND.  enhanced_melting )  THEN
-                melt_q = const4 * ( temp - t3 ) * riming_rate_q
-                melt_n = melt_q / xg
-                melt_q = MIN( qg(k,j,i) / dt_micro, melt_q )
-                melt_n = MIN( ng(k,j,i) / dt_micro, melt_n )
-!
-!--             Apply enhancement due to melting
-                qg(k,j,i) = qg(k,j,i) - melt_q * dt_micro * flag
-                qr(k,j,i) = qr(k,j,i) + melt_q * dt_micro * flag
-                ng(k,j,i) = ng(k,j,i) - melt_n * dt_micro * flag
-                nr(k,j,i) = nr(k,j,i) + melt_n * dt_micro * flag
-             ENDIF
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE riming_graupel_cloud_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of rain and graupel (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_graupel_rain
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  dg            !< diameter graupel
-       REAL(wp) ::  dr            !< diameter rain
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  melt_n        !< melting rate number concentration
-       REAL(wp) ::  melt_q        !< melting rate mixing ratio
-       REAL(wp) ::  mult_n        !< ice multiplaction for number concentration
-       REAL(wp) ::  mult_q        !< ice multiplaction
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_q !< riming rate mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vg            !< terminal fall velocitiy graupel
-       REAL(wp) ::  vr            !< terminal fall velocitiy rain
-       REAL(wp) ::  xg            !< mean mass graupel
-       REAL(wp) ::  xr            !< mean mass rain
-
-       REAL(wp), PARAMETER ::  const2 = 1.0 / ( temp_mult_opt - temp_mult_min ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const3 = 1.0 / ( temp_mult_opt - temp_mult_max ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const4 = c_w / l_m                               !< constant for melting
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Apply riming only above threshold
-                IF ( qr(k,j,i) > eps_sb_coll  .AND.  qg(k,j,i) > eps_sb_coll                       &
-                                              .AND.  ng(k,j,i) > 0.0_wp )  THEN
-!
-!--                Calculate mean mass, mean diameter for both graupel and rain
-                   xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-                   xr = mean_mass( cloud_species%rain,    qr(k,j,i), nr(k,j,i), hyrho(k) )
-
-                   dg = mean_diameter( cloud_species%graupel,  xg )
-                   dr = mean_diameter( cloud_species%rain,     xr )
-!
-!--                Calculate terminal velocites
-                   vg = terminal_fall_velocity(cloud_species%graupel,  xg, hyrho(k) )
-                   vr = terminal_fall_velocity(cloud_species%rain,     xr, hyrho(k) )
-
-!--                Calculate riming rates
-                   riming_rate_n = pi / 4.0_wp *  ng(k,j,i) * nr(k,j,i) *                          &
-                            ( rime_graupel_rain_delta_n_aa * dg**2 +                               &
-                              rime_graupel_rain_delta_n_ab * dg * dr +                             &
-                              rime_graupel_rain_delta_n_bb * dr**2 ) *                             &
-                        SQRT( rime_graupel_rain_theta_n_aa * vg**2 -                               &
-                              rime_graupel_rain_theta_n_ab * vg * vr +                             &
-                              rime_graupel_rain_theta_n_bb * vr**2 )
-
-                   riming_rate_q = pi / 4.0_wp *  ng(k,j,i) * qr(k,j,i) *                          &
-                            ( rime_graupel_rain_delta_q_aa * dg**2 +                               &
-                              rime_graupel_rain_delta_q_ab * dg * dr +                             &
-                              rime_graupel_rain_delta_q_bb * dr**2) *                              &
-                        SQRT( rime_graupel_rain_theta_q_aa * vg**2 -                               &
-                              rime_graupel_rain_theta_q_ab * vg * vr +                             &
-                              rime_graupel_rain_theta_q_bb * vr**2 )
-
-!
-!--                Limit riming rates
-                   riming_rate_q = MIN( qr(k,j,i) / dt_micro, MAX( riming_rate_q, 0.0_wp ) )
-                   riming_rate_n = MIN( nr(k,j,i) / dt_micro, MAX( riming_rate_n, 0.0_wp ) )
-!
-!--                Add/substract riming rates
-                   qg(k,j,i) = qg(k,j,i) + riming_rate_q * dt_micro * flag
-                   qr(k,j,i) = qr(k,j,i) - riming_rate_q * dt_micro * flag
-                   nr(k,j,i) = nr(k,j,i) - riming_rate_n * dt_micro * flag
-!
-!--                Calcualte temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Ice multiplication based on Hallet and Mossop
-                   IF ( temp < t3  .AND.  ice_multiplication )  THEN
-                      mult_1 = const2 * ( temp - temp_mult_min )
-                      mult_2 = const3 * ( temp - temp_mult_max )
-                      mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp ) )
-                      mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp ) )
-                      mult_n = c_mult * mult_1 * mult_2 * riming_rate_q
-                      mult_q = mult_n * cloud_species%ice%x_min
-                      mult_q = MIN( riming_rate_q, mult_q )
-!
-!--                   Apply Hallet Mossop process
-                      ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                      qi(k,j,i) = qi(k,j,i) + mult_q * dt_micro * flag
-                      qg(k,j,i) = qg(k,j,i) - mult_q * dt_micro * flag
-                   ENDIF
-!
-!--                Enhancement of melting
-                   IF ( temp > t3  .AND.  enhanced_melting )  THEN
-                      melt_q = const4 * ( temp - t3 ) * riming_rate_q
-                      melt_n = melt_q / xg
-                      melt_q = MIN( qg(k,j,i) / dt_micro, melt_q )
-                      melt_n = MIN( ng(k,j,i) / dt_micro, melt_n )
-!
-!--                   Apply enhancement due to melting
-                      qg(k,j,i) = qg(k,j,i) - melt_q * dt_micro * flag
-                      qr(k,j,i) = qr(k,j,i) + melt_q * dt_micro * flag
-                      ng(k,j,i) = ng(k,j,i) - melt_n * dt_micro * flag
-                      nr(k,j,i) = nr(k,j,i) + melt_n * dt_micro * flag
-                   ENDIF
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE riming_graupel_rain
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of rain and graupel (Seifert and Beheng, 2006).
-!> Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_graupel_rain_ij( i, j )
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  dg            !< diameter graupel
-       REAL(wp) ::  dr            !< diameter rain
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  melt_n        !< melting rate number concentration
-       REAL(wp) ::  melt_q        !< melting rate mixing ratio
-       REAL(wp) ::  mult_n        !< ice multiplaction for number concentration
-       REAL(wp) ::  mult_q        !< ice multiplaction
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_q !< riming rate mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vg            !< terminal fall velocitiy graupel
-       REAL(wp) ::  vr            !< terminal fall velocitiy rain
-       REAL(wp) ::  xg            !< mean mass graupel
-       REAL(wp) ::  xr            !< mean mass rain
-
-       REAL(wp), PARAMETER ::  const2 = 1.0 / ( temp_mult_opt - temp_mult_min ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const3 = 1.0 / ( temp_mult_opt - temp_mult_max ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const4 = c_w / l_m                               !< constant for melting
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Apply riming only above threshold
-          IF ( qr(k,j,i) > eps_sb_coll  .AND.  qg(k,j,i) > eps_sb_coll                             &
-                                        .AND.  ng(k,j,i) > 0.0_wp )  THEN
-!
-!--          Calculate mean mass, mean diameter for both graupel and rain
-             xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-             xr = mean_mass( cloud_species%rain,    qr(k,j,i), nr(k,j,i), hyrho(k) )
-
-             dg = mean_diameter( cloud_species%graupel,  xg )
-             dr = mean_diameter( cloud_species%rain,     xr )
-!
-!--          Calculate terminal velocites
-             vg = terminal_fall_velocity(cloud_species%graupel,  xg, hyrho(k) )
-             vr = terminal_fall_velocity(cloud_species%rain,     xr, hyrho(k) )
-
-!--          Calculate riming rates
-             riming_rate_n = pi / 4.0_wp *  ng(k,j,i) * nr(k,j,i) *                                &
-                      ( rime_graupel_rain_delta_n_aa * dg**2 +                                     &
-                        rime_graupel_rain_delta_n_ab * dg * dr +                                   &
-                        rime_graupel_rain_delta_n_bb * dr**2 ) *                                   &
-                  SQRT( rime_graupel_rain_theta_n_aa * vg**2 -                                     &
-                        rime_graupel_rain_theta_n_ab * vg * vr +                                   &
-                        rime_graupel_rain_theta_n_bb * vr**2 )
-
-             riming_rate_q = pi / 4.0_wp *  ng(k,j,i) * qr(k,j,i) *                                &
-                      ( rime_graupel_rain_delta_q_aa * dg**2 +                                     &
-                        rime_graupel_rain_delta_q_ab * dg * dr +                                   &
-                        rime_graupel_rain_delta_q_bb * dr**2) *                                    &
-                  SQRT( rime_graupel_rain_theta_q_aa * vg**2 -                                     &
-                        rime_graupel_rain_theta_q_ab * vg * vr +                                   &
-                        rime_graupel_rain_theta_q_bb * vr**2 )
-
-!
-!--          Limit riming rates
-             riming_rate_q = MIN( qr(k,j,i) / dt_micro, MAX( riming_rate_q, 0.0_wp ) )
-             riming_rate_n = MIN( nr(k,j,i) / dt_micro, MAX( riming_rate_n, 0.0_wp ) )
-!
-!--          Add/substract riming rates
-             qg(k,j,i) = qg(k,j,i) + riming_rate_q * dt_micro * flag
-             qr(k,j,i) = qr(k,j,i) - riming_rate_q * dt_micro * flag
-             nr(k,j,i) = nr(k,j,i) - riming_rate_n * dt_micro * flag
-!
-!--          Calcualte temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Ice multiplication based on Hallet and Mossop
-             IF ( temp < t3  .AND.  ice_multiplication )  THEN
-                mult_1 = const2 * ( temp - temp_mult_min )
-                mult_2 = const3 * ( temp - temp_mult_max )
-                mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp ) )
-                mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp ) )
-                mult_n = c_mult * mult_1 * mult_2 * riming_rate_q
-                mult_q = mult_n * cloud_species%ice%x_min
-                mult_q = MIN( riming_rate_q, mult_q )
-!
-!--             Apply Hallet Mossop process
-                ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                qi(k,j,i) = qi(k,j,i) + mult_q * dt_micro * flag
-                qg(k,j,i) = qg(k,j,i) - mult_q * dt_micro * flag
-             ENDIF
-!
-!--          Enhancement of melting
-             IF ( temp > t3  .AND.  enhanced_melting )  THEN
-                melt_q = const4 * ( temp - t3 ) * riming_rate_q
-                melt_n = melt_q / xg
-                melt_q = MIN( qg(k,j,i) / dt_micro, melt_q )
-                melt_n = MIN( ng(k,j,i) / dt_micro, melt_n )
-!
-!--             Apply enhancement due to melting
-                qg(k,j,i) = qg(k,j,i) - melt_q * dt_micro * flag
-                qr(k,j,i) = qr(k,j,i) + melt_q * dt_micro * flag
-                ng(k,j,i) = ng(k,j,i) - melt_n * dt_micro * flag
-                nr(k,j,i) = nr(k,j,i) + melt_n * dt_micro * flag
-             ENDIF
-
-          ENDIF
-       ENDDO
-
-    END SUBROUTINE riming_graupel_rain_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of cloud and ice (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_ice_cloud
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wP) ::  coll_eff      !< collision efficiency
-       REAL(wp) ::  dc            !< diameter cloud
-       REAL(wp) ::  di            !< diameter ice
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  mult_n        !< ice multiplaction for number concentration
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  nc_c          !< dummy number concentration cloud droplets
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_q !< riming rate mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vc            !< terminal fall velocitiy cloud
-       REAL(wp) ::  vi            !< terminal fall velocitiy ice
-       REAL(wp) ::  xc            !< mean mass cloud
-       REAL(wp) ::  xi            !< mean mass ice
-       REAL(wp) ::  conv_n        !< conversion rate ice graupel number concentration
-       REAL(wp) ::  conv_q        !< conversion rate ice graupel mixing ratio
-       REAL(wp) ::  const1        !< constant for riming
-
-       REAL(wp), PARAMETER ::  const0 = 1.0_wp / ( dc_coll - dc_crit )  !< constant for riming calculation
-       REAL(wp), PARAMETER ::  const3 = 1.0_wp / ( temp_mult_opt - temp_mult_min ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const4 = 1.0_wp / ( temp_mult_opt - temp_mult_max ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const5 = alpha_spacefilling * rho_l / rho_i
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                IF ( microphysics_morrison )  THEN
-                   nc_c = nc(k,j,i)
-                ELSE
-                   nc_c = nc_const
-                ENDIF
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Calculate mean mass, mean diameter for both graupel and rain
-                xc = mean_mass( cloud_species%cloud, qc(k,j,i), nc_c, hyrho(k) )
-                xi = mean_mass( cloud_species%ice,   qi(k,j,i), ni(k,j,i), hyrho(k) )
-
-                dc = mean_diameter( cloud_species%cloud,  xc )
-                di = mean_diameter( cloud_species%ice,    xi )
-!
-!--             Apply riming only above threshold
-                IF ( qc(k,j,i) > q_thres  .AND.  qi(k,j,i) > eps_sb_coll  .AND.                    &
-                     dc > dc_crit  .AND.  di > df_crit )  THEN
-!
-!--                Calcualte temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Calculate terminal velocites
-                   vc = terminal_fall_velocity(cloud_species%cloud,   xc, hyrho(k) )
-                   vi = terminal_fall_velocity(cloud_species%ice,     xi, hyrho(k) )
-!
-!--                Calculate collision efficiency
-                   const1 = const0 * cloud_species%ice%coll_eff
-                   coll_eff = MIN( cloud_species%ice%coll_eff,                                     &
-                                   MAX( const1 * ( dc - dc_crit ), ecoll_min) )
-!
-!--                Calcualte riming rates
-                   riming_rate_n = pi / 4.0_wp * coll_eff * ni(k,j,i) * nc_c *                     &
-                                ( rime_ice_cloud_delta_n_aa * di**2   +                            &
-                                  rime_ice_cloud_delta_n_ab * di * dc +                            &
-                                  rime_ice_cloud_delta_n_bb * dc**2)  *                            &
-                            SQRT( rime_ice_cloud_theta_n_aa * vi**2   -                            &
-                                  rime_ice_cloud_theta_n_ab * vi * vc +                            &
-                                  rime_ice_cloud_theta_n_bb * vc**2   +                            &
-                                  cloud_species%ice%sigma_v**2 )
-
-                   riming_rate_q = pi / 4.0_wp * coll_eff * ni(k,j,i) * qc(k,j,i) *                &
-                                ( rime_ice_cloud_delta_q_aa * di**2 +                              &
-                                  rime_ice_cloud_delta_q_ab * di * dc +                            &
-                                  rime_ice_cloud_delta_q_bb * dc**2) *                             &
-                            SQRT( rime_ice_cloud_theta_q_aa * vi**2 -                              &
-                                  rime_ice_cloud_theta_q_ab * vi * vc +                            &
-                                  rime_ice_cloud_theta_q_bb * vc**2 +                              &
-                                  cloud_species%ice%sigma_v**2 )
-!
-!--                Limit riming rates
-                   riming_rate_q = MIN( qc(k,j,i) / dt_micro, MAX( riming_rate_q, 0.0_wp ) )
-                   riming_rate_n = MIN( nc_c / dt_micro, MAX( riming_rate_n, 0.0_wp ) )
-!
-!--                Apply riming ice - cloud
-                   qi(k,j,i) = qi(k,j,i) + riming_rate_q * dt_micro * flag
-                   qc(k,j,i) = qc(k,j,i) - riming_rate_q * dt_micro * flag
-                   IF ( microphysics_morrison )  THEN
-                      nc(k,j,i) = nc(k,j,i) - riming_rate_n * dt_micro * flag
-                   ENDIF
-!
-!--                Store riming rate for rain riming
-                   rime_ice_cloud(k,j,i) = riming_rate_q
-!
-!--                Ice multiplication during riming
-                   IF ( temp < t3 .AND. ice_multiplication )  THEN
-                      mult_1 = ( temp - temp_mult_min ) * const3
-                      mult_2 = ( temp - temp_mult_max ) * const4
-                      mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp ) )
-                      mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp ) )
-                      mult_n = c_mult * mult_1 * mult_2 * riming_rate_q
-
-                      ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                   ENDIF
-!
-!--                If deposition is negative or deposition is smaller than riming, conversion from
-!--                ice to graupel takes place. Note, that here the riming rate of ice-rain is from
-!--                the last time-step. However, the error is assumed to be small
-                   IF ( dep_rate_ice(k,j,i) < 0.0_wp  .OR.                                         &
-                        dep_rate_ice(k,j,i) < rime_ice_cloud(k,j,i) + rime_ice_rain(k,j,i) )  THEN
-!
-!--                    Conversion from ice to graupel if diameter small enough and riming rates are
-!--                    larger than deposition. If deposition is larger ice stay
-!--                    factor alpha_spacefilling after SB 2006 and icon model
-                       IF ( di > dig_conv ) THEN
-                         conv_q =  riming_rate_q /                                                 &
-                                  ( const5 * ( pi / 6.0_wp * rho_i * di**3 / xi - 1.0_wp ) )
-                         conv_q = MIN( qi(k,j,i) / dt_micro , conv_q )
-                         conv_n = conv_q / MAX( xi, x_conv )
-                         conv_n = MIN( ni(k,j,i) / dt_micro, conv_n )
-                      ELSE
-                         conv_q = 0.0_wp
-                         conv_n = 0.0_wp
-                      ENDIF
-!
-!--                   Apply conversion from ice to grauppel
-                      qi(k,j,i) = qi(k,j,i) - conv_q * dt_micro * flag
-                      qg(k,j,i) = qg(k,j,i) + conv_q * dt_micro * flag
-                      ni(k,j,i) = ni(k,j,i) - conv_n * dt_micro * flag
-                      ng(k,j,i) = ng(k,j,i) + conv_n * dt_micro * flag
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE riming_ice_cloud
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of cloud and ice (Seifert and Beheng, 2006).
-!> Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_ice_cloud_ij( i, j )
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wP) ::  coll_eff      !< collision efficiency
-       REAL(wp) ::  dc            !< diameter cloud
-       REAL(wp) ::  di            !< diameter ice
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  mult_n        !< ice multiplaction for number concentration
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  nc_c          !< dummy number concentration cloud droplets
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_q !< riming rate mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vc            !< terminal fall velocitiy cloud
-       REAL(wp) ::  vi            !< terminal fall velocitiy ice
-       REAL(wp) ::  xc            !< mean mass cloud
-       REAL(wp) ::  xi            !< mean mass ice
-       REAL(wp) ::  conv_n        !< conversion rate ice graupel number concentration
-       REAL(wp) ::  conv_q        !< conversion rate ice graupel mixing ratio
-       REAL(wp) ::  const1        !< constant for riming
-
-       REAL(wp), PARAMETER ::  const0 = 1.0_wp / ( dc_coll - dc_crit )  !< constant for riming calculation
-       REAL(wp), PARAMETER ::  const3 = 1.0_wp / ( temp_mult_opt - temp_mult_min ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const4 = 1.0_wp / ( temp_mult_opt - temp_mult_max ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const5 = alpha_spacefilling * rho_l / rho_i
-
-       DO  k = nzb+1, nzt
-          IF ( microphysics_morrison )  THEN
-             nc_c = nc(k,j,i)
-          ELSE
-             nc_c = nc_const
-          ENDIF
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Calculate mean mass, mean diameter for both graupel and rain
-          xc = mean_mass( cloud_species%cloud, qc(k,j,i), nc_c, hyrho(k) )
-          xi = mean_mass( cloud_species%ice,   qi(k,j,i), ni(k,j,i), hyrho(k) )
-
-          dc = mean_diameter( cloud_species%cloud,  xc )
-          di = mean_diameter( cloud_species%ice,    xi )
-!
-!--       Apply riming only above threshold
-          IF ( qc(k,j,i) > q_thres  .AND.  qi(k,j,i) > eps_sb_coll  .AND.                          &
-               dc > dc_crit  .AND.  di > df_crit )  THEN
-!
-!--          Calcualte temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Calculate terminal velocites
-             vc = terminal_fall_velocity(cloud_species%cloud,   xc, hyrho(k) )
-             vi = terminal_fall_velocity(cloud_species%ice,     xi, hyrho(k) )
-!
-!--          Calculate collision efficiency
-             const1 = const0 * cloud_species%ice%coll_eff
-             coll_eff = MIN( cloud_species%ice%coll_eff,                                           &
-                             MAX( const1 * ( dc - dc_crit ), ecoll_min) )
-!
-!--          Calcualte riming rates
-             riming_rate_n = pi / 4.0_wp * coll_eff * ni(k,j,i) * nc_c *                           &
-                          ( rime_ice_cloud_delta_n_aa * di**2   +                                  &
-                            rime_ice_cloud_delta_n_ab * di * dc +                                  &
-                            rime_ice_cloud_delta_n_bb * dc**2)  *                                  &
-                      SQRT( rime_ice_cloud_theta_n_aa * vi**2   -                                  &
-                            rime_ice_cloud_theta_n_ab * vi * vc +                                  &
-                            rime_ice_cloud_theta_n_bb * vc**2   +                                  &
-                            cloud_species%ice%sigma_v**2 )
-
-             riming_rate_q = pi / 4.0_wp * coll_eff * ni(k,j,i) * qc(k,j,i) *                      &
-                          ( rime_ice_cloud_delta_q_aa * di**2 +                                    &
-                            rime_ice_cloud_delta_q_ab * di * dc +                                  &
-                            rime_ice_cloud_delta_q_bb * dc**2) *                                   &
-                      SQRT( rime_ice_cloud_theta_q_aa * vi**2 -                                    &
-                            rime_ice_cloud_theta_q_ab * vi * vc +                                  &
-                            rime_ice_cloud_theta_q_bb * vc**2 +                                    &
-                            cloud_species%ice%sigma_v**2 )
-!
-!--          Limit riming rates
-             riming_rate_q = MIN( qc(k,j,i) / dt_micro, MAX( riming_rate_q, 0.0_wp ) )
-             riming_rate_n = MIN( nc_c / dt_micro, MAX( riming_rate_n, 0.0_wp ) )
-!
-!--          Apply riming ice - cloud
-             qi(k,j,i) = qi(k,j,i) + riming_rate_q * dt_micro * flag
-             qc(k,j,i) = qc(k,j,i) - riming_rate_q * dt_micro * flag
-             IF ( microphysics_morrison )  THEN
-                nc(k,j,i) = nc(k,j,i) - riming_rate_n * dt_micro * flag
-             ENDIF
-!
-!--          Store riming rate for rain riming
-             rime_ice_cloud(k,j,i) = riming_rate_q
-!
-!--          Ice multiplication during riming
-             IF ( temp < t3 .AND. ice_multiplication )  THEN
-                mult_1 = ( temp - temp_mult_min ) * const3
-                mult_2 = ( temp - temp_mult_max ) * const4
-                mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp ) )
-                mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp ) )
-                mult_n = c_mult * mult_1 * mult_2 * riming_rate_q
-
-                ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-             ENDIF
-!
-!--          If deposition is negative or deposition is smaller than riming, conversion from ice
-!--          ice to graupel takes place. Note, that here the riming rate of ice-rain is from the
-!--          last time-step. However, the error is assumed to be small
-             IF ( dep_rate_ice(k,j,i) < 0.0_wp  .OR.                                               &
-                  dep_rate_ice(k,j,i) < rime_ice_cloud(k,j,i) + rime_ice_rain(k,j,i) )  THEN
-!
-!--              Conversion from ice to graupel if diameter small enough and riming rates are larger
-!--              than deposition. If deposition is larger ice stay
-!--              factor alpha_spacefilling after SB 2006 and icon model
-                 IF ( di > dig_conv ) THEN
-                   conv_q =  riming_rate_q /                                                       &
-                            ( const5 * ( pi / 6.0_wp * rho_i * di**3 / xi - 1.0_wp ) )
-                   conv_q = MIN( qi(k,j,i) / dt_micro , conv_q )
-                   conv_n = conv_q / MAX( xi, x_conv )
-                   conv_n = MIN( ni(k,j,i) / dt_micro, conv_n )
-                ELSE
-                   conv_q = 0.0_wp
-                   conv_n = 0.0_wp
-                ENDIF
-!
-!--             Apply conversion from ice to grauppel
-                qi(k,j,i) = qi(k,j,i) - conv_q * dt_micro * flag
-                qg(k,j,i) = qg(k,j,i) + conv_q * dt_micro * flag
-                ni(k,j,i) = ni(k,j,i) - conv_n * dt_micro * flag
-                ng(k,j,i) = ng(k,j,i) + conv_n * dt_micro * flag
-             ENDIF
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE riming_ice_cloud_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of rain and ice (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_ice_rain
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  dr            !< diameter rain
-       REAL(wp) ::  di            !< diameter ice
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  mult_n        !< ice multiplaction for number concentration
-       REAL(wp) ::  mult_q        !< ice multiplaction
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_qi!< riming rate ice mixing ratio
-       REAL(wp) ::  riming_rate_qr!< riming rate rain mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vr            !< terminal fall velocitiy rain
-       REAL(wp) ::  vi            !< terminal fall velocitiy ice
-       REAL(wp) ::  xr            !< mean mass rain
-       REAL(wp) ::  xi            !< mean mass ice
-
-       REAL(wp), PARAMETER ::  const3 = 1.0_wp / ( temp_mult_opt - temp_mult_min ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const4 = 1.0_wp / ( temp_mult_opt - temp_mult_max ) !< constant for ice multiplication
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Calculate mean mass, mean diameter for both graupel and rain
-                xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-                xi = mean_mass( cloud_species%ice,  qi(k,j,i), ni(k,j,i), hyrho(k) )
-
-                dr = mean_diameter( cloud_species%rain,  xr )
-                di = mean_diameter( cloud_species%ice,   xi )
-!
-!--             Apply ice-rain riming only above thresholds
-                IF ( qr(k,j,i) > eps_sb_coll  .AND.  qi(k,j,i) > qr_crit  .AND.  di > df_crit      &
-                     .AND.  nr(k,j,i) > 0.0_wp  .AND.  ni(k,j,i) > 0.0_wp  )  THEN
-!
-!--                Calcualte temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Calculate terminal velocites
-                   vr = terminal_fall_velocity(cloud_species%rain, xr, hyrho(k) )
-                   vi = terminal_fall_velocity(cloud_species%ice,  xi, hyrho(k) )
-!
-!--                Calcualte riming rates
-                   riming_rate_n = pi / 4.0_wp * ni(k,j,i) * nr(k,j,i) *                           &
-                                ( rime_ice_rain_delta_n_aa * di**2   +                             &
-                                  rime_ice_rain_delta_n_ab * di * dr +                             &
-                                  rime_ice_rain_delta_n_bb * dr**2 ) *                             &
-                            SQRT( rime_ice_rain_theta_n_aa * vi**2   -                             &
-                                  rime_ice_rain_theta_n_ab * vi * vr +                             &
-                                  rime_ice_rain_theta_n_bb * vr**2   +                             &
-                                  cloud_species%ice%sigma_v**2 )
-
-                   riming_rate_qr = pi / 4.0_wp * ni(k,j,i) * qr(k,j,i) *                          &
-                                ( rime_ice_rain_delta_n_aa * di**2 +                               &
-                                  rime_ice_rain_delta_q_ab * di * dr +                             &
-                                  rime_ice_rain_delta_q_bb * dr**2 ) *                             &
-                            SQRT( rime_ice_rain_theta_n_aa * vi**2 -                               &
-                                  rime_ice_rain_theta_q_ab * vi * vr +                             &
-                                  rime_ice_rain_theta_q_bb * vr**2 +                               &
-                                  cloud_species%ice%sigma_v**2 )
-
-                   riming_rate_qi = pi / 4.0_wp * nr(k,j,i) * qi(k,j,i) *                          &
-                                ( rime_ice_rain_delta_q_aa * di**2 +                               &
-                                  rime_ice_rain_delta_q_ab * di * dr +                             &
-                                  rime_ice_rain_delta_q_bb * dr**2 ) *                             &
-                            SQRT( rime_ice_rain_theta_n_aa * vi**2 -                               &
-                                  rime_ice_rain_theta_q_ab * vi * vr +                             &
-                                  rime_ice_rain_theta_q_bb * vr**2 +                               &
-                                  cloud_species%ice%sigma_v**2 )
-
-!Q TODO hi      er muss noch ein fehler behoben werden, evtl wird die wurzel negativ
-!                    riming_rate_qi = pi / 4.0_wp * nr(k,j,i) * qi(k,j,i) *                                &
-!                                 ( rime_ice_rain_delta_q_aa * di**2 +                                     &
-!                                   rime_ice_rain_delta_q_ab * di * dr +                                   &
-!                                   rime_ice_rain_delta_n_bb * dr**2 ) *                                   &
-!                             SQRT( rime_ice_rain_theta_q_aa * vi**2 -                                     &
-!                                   rime_ice_rain_theta_q_ab * vi * vr +                                   &
-!                                   rime_ice_rain_theta_n_bb * vr**2 +                                     &
-!                                   cloud_species%ice%sigma_v**2 )
-!
-!                 rime_qi = pi4 * n_r * q_a * dt &
-!                      &  *     (  coeffs%delta_q_aa * D_a * D_a &
-!                      &         + coeffs%delta_q_ba * D_a * D_r &
-!                      &         + coeffs%delta_n_bb * D_r * D_r) &
-!                      &  * SQRT(  coeffs%theta_q_aa * v_a * v_a &
-!                      &         - coeffs%theta_q_ba * v_a * v_r &
-!                      &         + coeffs%theta_n_bb * v_r * v_r &
-!                      &         + ptype%s_vel**2)
-
-!--                Limit riming rates
-                   riming_rate_qr = MIN( qr(k,j,i) / dt_micro, MAX( riming_rate_qr, 0.0_wp ) )
-                   riming_rate_qi = MIN( qi(k,j,i) / dt_micro, MAX( riming_rate_qi, 0.0_wp ) )
-                   riming_rate_n  = MIN( nr(k,j,i) / dt_micro, MAX( riming_rate_n,  0.0_wp ) )
-!
-!--                store ice-rain riming rate for ice-cloud riming
-                   rime_ice_rain(k,j,i) = riming_rate_qr
-!
-!--                If deposition is larger than riming ice stays ice
-                   IF ( dep_rate_ice(k,j,i) > 0.0_wp  .AND.                                        &
-                        dep_rate_ice(k,j,i) < rime_ice_rain(k,j,i) + rime_ice_cloud(k,j,i) ) THEN
-!
-!--                   Apply riming ice - rain
-                      qi(k,j,i) = qi(k,j,i) + riming_rate_qr * dt_micro * flag
-                      qr(k,j,i) = qr(k,j,i) - riming_rate_qr * dt_micro * flag
-                      nr(k,j,i) = nr(k,j,i) - riming_rate_n  * dt_micro * flag
-!
-!--                   Ice multiplication during riming
-                      IF ( temp < t3 .AND. ice_multiplication )  THEN
-                         mult_1 = ( temp - temp_mult_min ) * const3
-                         mult_2 = ( temp - temp_mult_max ) * const4
-                         mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp ) )
-                         mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp ) )
-                         mult_n = c_mult * mult_1 * mult_2 * riming_rate_qr
-
-                         ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                      ENDIF
-!
-!--                If deposition is negative (i.e. sublimation or riming is stronger, a different
-!--                treatment is conducted: ice might convert to graupel
-                   ELSE
-!
-!--                   Ensure that riming rate is also not larger than ni
-                      riming_rate_n  = MIN( MIN( nr(k,j,i) / dt_micro, ni(k,j,i) / dt_micro ),     &
-                                             MAX( riming_rate_n,  0.0_wp ) )
-!
-!--                   Substract all riming rates, those riming rates are added to species (either
-!--                   ice again or graupel furhter down)
-                      qi(k,j,i) = qi(k,j,i) - riming_rate_qi * dt_micro * flag
-                      qr(k,j,i) = qr(k,j,i) - riming_rate_qr * dt_micro * flag
-                      ni(k,j,i) = ni(k,j,i) - riming_rate_n  * dt_micro * flag
-                      nr(k,j,i) = nr(k,j,i) - riming_rate_n  * dt_micro * flag
-!
-!--                   Ice multiplication
-                      mult_q = 0.0_wp
-                      mult_n = 0.0_wp
-                      IF ( temp < t3  .AND.  ice_multiplication )  THEN
-                         mult_1 = ( temp - temp_mult_min ) * const3
-                         mult_2 = ( temp - temp_mult_max ) * const4
-                         mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp) )
-                         mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp) )
-                         mult_n = c_mult * mult_1 * mult_2 * riming_rate_qr
-                         mult_q = mult_n * cloud_species%ice%x_min
-                         mult_q = MIN( riming_rate_qr, mult_q )
-                      ENDIF
-!
-!--                   shedding of rain at warm temperatures
-                      IF ( temp >= t3 )  THEN
-!
-!--                      but with modified nr
-                         xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-                         nr(k,j,i) = nr(k,j,i) + riming_rate_qr / xr * dt_micro * flag
-                         ni(k,j,i) = ni(k,j,i) + riming_rate_n  * dt_micro * flag
-                         qi(k,j,i) = qi(k,j,i) + riming_rate_qi * dt_micro * flag
-                         qr(k,j,i) = qr(k,j,i) + riming_rate_qr * dt_micro * flag
-!
-!--                   at tempatures below freezing point graupel is generated
-                      ELSE
-!
-!--                      new ice particles from multiplication
-                         ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                         qi(k,j,i) = qi(k,j,i) + mult_q * dt_micro * flag
-!
-!--                      and riming to graupel
-                         ng(k,j,i) = ng(k,j,i) + riming_rate_n * dt_micro * flag
-                         qg(k,j,i) = qg(k,j,i) + ( riming_rate_qi + riming_rate_qr - mult_q ) *    &
-                                                                                     dt_micro * flag
-                      END IF
-
-                   ENDIF ! loop if deposition or riming is stronger
-                ENDIF ! loop if thresholds for riming are exceeded, otherwise nothings happen
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE riming_ice_rain
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of rain and ice (Seifert and Beheng, 2006).
-!> Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_ice_rain_ij( i, j )
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  dr            !< diameter rain
-       REAL(wp) ::  di            !< diameter ice
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  mult_n        !< ice multiplaction for number concentration
-       REAL(wp) ::  mult_q        !< ice multiplaction
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_qi!< riming rate ice mixing ratio
-       REAL(wp) ::  riming_rate_qr!< riming rate rain mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vr            !< terminal fall velocitiy rain
-       REAL(wp) ::  vi            !< terminal fall velocitiy ice
-       REAL(wp) ::  xr            !< mean mass rain
-       REAL(wp) ::  xi            !< mean mass ice
-
-       REAL(wp), PARAMETER ::  const3 = 1.0_wp / ( temp_mult_opt - temp_mult_min ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const4 = 1.0_wp / ( temp_mult_opt - temp_mult_max ) !< constant for ice multiplication
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Calculate mean mass, mean diameter for both graupel and rain
-          xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-          xi = mean_mass( cloud_species%ice,  qi(k,j,i), ni(k,j,i), hyrho(k) )
-
-          dr = mean_diameter( cloud_species%rain,  xr )
-          di = mean_diameter( cloud_species%ice,   xi )
-!
-!--       Apply ice-rain riming only above thresholds
-          IF ( qr(k,j,i) > eps_sb_coll  .AND.  qi(k,j,i) > qr_crit  .AND.  di > df_crit            &
-               .AND.  nr(k,j,i) > 0.0_wp  .AND.  ni(k,j,i) > 0.0_wp  )  THEN
-!
-!--          Calcualte temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Calculate terminal velocites
-             vr = terminal_fall_velocity(cloud_species%rain, xr, hyrho(k) )
-             vi = terminal_fall_velocity(cloud_species%ice,  xi, hyrho(k) )
-!
-!--          Calcualte riming rates
-             riming_rate_n = pi / 4.0_wp * ni(k,j,i) * nr(k,j,i) *                                 &
-                          ( rime_ice_rain_delta_n_aa * di**2   +                                   &
-                            rime_ice_rain_delta_n_ab * di * dr +                                   &
-                            rime_ice_rain_delta_n_bb * dr**2 ) *                                   &
-                      SQRT( rime_ice_rain_theta_n_aa * vi**2   -                                   &
-                            rime_ice_rain_theta_n_ab * vi * vr +                                   &
-                            rime_ice_rain_theta_n_bb * vr**2   +                                   &
-                            cloud_species%ice%sigma_v**2 )
-
-             riming_rate_qr = pi / 4.0_wp * ni(k,j,i) * qr(k,j,i) *                                &
-                          ( rime_ice_rain_delta_n_aa * di**2 +                                     &
-                            rime_ice_rain_delta_q_ab * di * dr +                                   &
-                            rime_ice_rain_delta_q_bb * dr**2 ) *                                   &
-                      SQRT( rime_ice_rain_theta_n_aa * vi**2 -                                     &
-                            rime_ice_rain_theta_q_ab * vi * vr +                                   &
-                            rime_ice_rain_theta_q_bb * vr**2 +                                     &
-                            cloud_species%ice%sigma_v**2 )
-
-             riming_rate_qi = pi / 4.0_wp * nr(k,j,i) * qi(k,j,i) *                                &
-                          ( rime_ice_rain_delta_q_aa * di**2 +                                     &
-                            rime_ice_rain_delta_q_ab * di * dr +                                   &
-                            rime_ice_rain_delta_q_bb * dr**2 ) *                                   &
-                      SQRT( rime_ice_rain_theta_n_aa * vi**2 -                                     &
-                            rime_ice_rain_theta_q_ab * vi * vr +                                   &
-                            rime_ice_rain_theta_q_bb * vr**2 +                                     &
-                            cloud_species%ice%sigma_v**2 )
-
-!Q TODO hier muss noch ein fehler behoben werden, evtl wird die wurzel negativ
-!              riming_rate_qi = pi / 4.0_wp * nr(k,j,i) * qi(k,j,i) *                                &
-!                           ( rime_ice_rain_delta_q_aa * di**2 +                                     &
-!                             rime_ice_rain_delta_q_ab * di * dr +                                   &
-!                             rime_ice_rain_delta_n_bb * dr**2 ) *                                   &
-!                       SQRT( rime_ice_rain_theta_q_aa * vi**2 -                                     &
-!                             rime_ice_rain_theta_q_ab * vi * vr +                                   &
-!                             rime_ice_rain_theta_n_bb * vr**2 +                                     &
-!                             cloud_species%ice%sigma_v**2 )
-!
-!           rime_qi = pi4 * n_r * q_a * dt &
-!                &  *     (  coeffs%delta_q_aa * D_a * D_a &
-!                &         + coeffs%delta_q_ba * D_a * D_r &
-!                &         + coeffs%delta_n_bb * D_r * D_r) &
-!                &  * SQRT(  coeffs%theta_q_aa * v_a * v_a &
-!                &         - coeffs%theta_q_ba * v_a * v_r &
-!                &         + coeffs%theta_n_bb * v_r * v_r &
-!                &         + ptype%s_vel**2)
-
-!--          Limit riming rates
-             riming_rate_qr = MIN( qr(k,j,i) / dt_micro, MAX( riming_rate_qr, 0.0_wp ) )
-             riming_rate_qi = MIN( qi(k,j,i) / dt_micro, MAX( riming_rate_qi, 0.0_wp ) )
-             riming_rate_n  = MIN( nr(k,j,i) / dt_micro, MAX( riming_rate_n,  0.0_wp ) )
-!
-!--          store ice-rain riming rate for ice-cloud riming
-             rime_ice_rain(k,j,i) = riming_rate_qr
-!
-!--          If deposition is larger than riming ice stays ice
-             IF ( dep_rate_ice(k,j,i) > 0.0_wp  .AND.                                             &
-                  dep_rate_ice(k,j,i) < rime_ice_rain(k,j,i) + rime_ice_cloud(k,j,i) ) THEN
-!
-!--             Apply riming ice - rain
-                qi(k,j,i) = qi(k,j,i) + riming_rate_qr * dt_micro * flag
-                qr(k,j,i) = qr(k,j,i) - riming_rate_qr * dt_micro * flag
-                nr(k,j,i) = nr(k,j,i) - riming_rate_n  * dt_micro * flag
-!
-!--             Ice multiplication during riming
-                IF ( temp < t3 .AND. ice_multiplication )  THEN
-                   mult_1 = ( temp - temp_mult_min ) * const3
-                   mult_2 = ( temp - temp_mult_max ) * const4
-                   mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp ) )
-                   mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp ) )
-                   mult_n = c_mult * mult_1 * mult_2 * riming_rate_qr
-
-                   ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                ENDIF
-!
-!--          If deposition is negative (i.e. sublimation or riming is stronger, a different
-!--          treatment is conducted: ice might convert to graupel
-             ELSE
-!
-!--             Ensure that riming rate is also not larger than ni
-                riming_rate_n  = MIN( MIN( nr(k,j,i) / dt_micro, ni(k,j,i) / dt_micro ),          &
-                                       MAX( riming_rate_n,  0.0_wp ) )
-!
-!--             Substract all riming rates, those riming rates are added to species (either ice
-!--             again or graupel furhter down)
-                qi(k,j,i) = qi(k,j,i) - riming_rate_qi * dt_micro * flag
-                qr(k,j,i) = qr(k,j,i) - riming_rate_qr * dt_micro * flag
-                ni(k,j,i) = ni(k,j,i) - riming_rate_n  * dt_micro * flag
-                nr(k,j,i) = nr(k,j,i) - riming_rate_n  * dt_micro * flag
-!
-!--             Ice multiplication
-                mult_q = 0.0_wp
-                mult_n = 0.0_wp
-                IF ( temp < t3  .AND.  ice_multiplication )  THEN
-                   mult_1 = ( temp - temp_mult_min ) * const3
-                   mult_2 = ( temp - temp_mult_max ) * const4
-                   mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp) )
-                   mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp) )
-                   mult_n = c_mult * mult_1 * mult_2 * riming_rate_qr
-                   mult_q = mult_n * cloud_species%ice%x_min
-                   mult_q = MIN( riming_rate_qr, mult_q )
-                ENDIF
-!
-!--             shedding of rain at warm temperatures
-                IF ( temp >= t3 )  THEN
-!
-!--                but with modified nr
-                   xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-                   nr(k,j,i) = nr(k,j,i) + riming_rate_qr / xr * dt_micro * flag
-                   ni(k,j,i) = ni(k,j,i) + riming_rate_n  * dt_micro * flag
-                   qi(k,j,i) = qi(k,j,i) + riming_rate_qi * dt_micro * flag
-                   qr(k,j,i) = qr(k,j,i) + riming_rate_qr * dt_micro * flag
-!
-!--             at tempatures below freezing point graupel is generated
-                ELSE
-!
-!--                new ice particles from multiplication
-                   ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                   qi(k,j,i) = qi(k,j,i) + mult_q * dt_micro * flag
-!
-!--                and riming to graupel
-                   ng(k,j,i) = ng(k,j,i) + riming_rate_n * dt_micro * flag
-                   qg(k,j,i) = qg(k,j,i) + ( riming_rate_qi + riming_rate_qr - mult_q ) *          &
-                                                                                     dt_micro * flag
-                END IF
-
-             ENDIF ! loop if deposition or riming is stronger
-          ENDIF ! loop if thresholds for riming are exceeded, otherwise nothings happen
-
-       ENDDO
-
-    END SUBROUTINE riming_ice_rain_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of cloud and snow (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_snow_cloud
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wP) ::  coll_eff      !< collision efficiency
-       REAL(wp) ::  dc            !< diameter cloud
-       REAL(wp) ::  ds            !< diameter snow
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  mult_n        !< ice multiplaction for number concentration
-       REAL(wp) ::  mult_q        !< ice multiplaction
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  nc_c          !< dummy number concentration cloud dro
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_q !< riming rate mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vc            !< terminal fall velocitiy cloud
-       REAL(wp) ::  vs            !< terminal fall velocitiy snow
-       REAL(wp) ::  xc            !< mean mass cloud
-       REAL(wp) ::  xs            !< mean mass snow
-       REAL(wp) ::  conv_n        !< conversion rate snow number concentration
-       REAL(wp) ::  conv_q        !< conversion rate snow mixing ratio
-       REAL(wp) ::  const1        !< constant for riming
-
-       REAL(wp), PARAMETER ::  const0 = 1.0_wp / ( dc_coll - dc_crit )  !< constant for riming calculation
-       REAL(wp), PARAMETER ::  const3 = 1.0_wp / ( temp_mult_opt - temp_mult_min ) !< constant for snow multiplication
-       REAL(wp), PARAMETER ::  const4 = 1.0_wp / ( temp_mult_opt - temp_mult_max ) !< constant for snow multiplication
-       REAL(wp), PARAMETER ::  const5 = alpha_spacefilling * rho_l / rho_i
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                IF ( microphysics_morrison )  THEN
-                   nc_c = nc(k,j,i)
-                ELSE
-                   nc_c = nc_const
-                ENDIF
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Calculate mean mass, mean diameter for both graupel and rain
-                xc = mean_mass( cloud_species%cloud, qc(k,j,i), nc_c     , hyrho(k) )
-                xs = mean_mass( cloud_species%snow,  qs(k,j,i), ns(k,j,i), hyrho(k) )
-
-                dc = mean_diameter( cloud_species%cloud,  xc )
-                ds = mean_diameter( cloud_species%ice,    xs )
-!
-!--             Apply riming only above threshold
-                IF ( qc(k,j,i) > q_thres  .AND.  qs(k,j,i) > eps_sb_coll  .AND.                    &
-                     dc > dc_crit  .AND.  ds > df_crit )  THEN
-!
-!--                Calcualte temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Calculate terminal velocites
-                   vc = terminal_fall_velocity(cloud_species%cloud, xc, hyrho(k) )
-                   vs = terminal_fall_velocity(cloud_species%snow,  xs, hyrho(k) )
-!
-!--                Calculate collision efficiency
-                   const1 = const0 * cloud_species%snow%coll_eff
-                   coll_eff = MIN( cloud_species%snow%coll_eff,                                    &
-                                   MAX( const1 * ( dc - dc_crit ), ecoll_min) )
-!
-!--                Calcualte riming rates
-                   riming_rate_n = pi / 4.0_wp * coll_eff * ns(k,j,i) * nc_c *                     &
-                                ( rime_snow_cloud_delta_n_aa * ds**2   +                           &
-                                  rime_snow_cloud_delta_n_ab * ds * dc +                           &
-                                  rime_snow_cloud_delta_n_bb * dc**2)  *                           &
-                            SQRT( rime_snow_cloud_theta_n_aa * vs**2   -                           &
-                                  rime_snow_cloud_theta_n_ab * vs * vc +                           &
-                                  rime_snow_cloud_theta_n_bb * vc**2   +                           &
-                                  cloud_species%snow%sigma_v**2 )
-
-                   riming_rate_q = pi / 4.0_wp * coll_eff * ns(k,j,i) * qc(k,j,i) *                &
-                                ( rime_snow_cloud_delta_q_aa * ds**2 +                             &
-                                  rime_snow_cloud_delta_q_ab * ds * dc +                           &
-                                  rime_snow_cloud_delta_q_bb * dc**2) *                            &
-                            SQRT( rime_snow_cloud_theta_q_aa * vs**2 -                             &
-                                  rime_snow_cloud_theta_q_ab * vs * vc +                           &
-                                  rime_snow_cloud_theta_q_bb * vc**2 +                             &
-                                  cloud_species%snow%sigma_v**2 )
-!
-!--                Limit riming rates
-                   riming_rate_q = MIN( qc(k,j,i) / dt_micro, MAX( riming_rate_q, 0.0_wp ) )
-                   riming_rate_n = MIN( nc_c      / dt_micro, MAX( riming_rate_n, 0.0_wp ) )
-!
-!--                Apply riming snow - cloud
-                   qs(k,j,i) = qs(k,j,i) + riming_rate_q * dt_micro * flag
-                   qc(k,j,i) = qc(k,j,i) - riming_rate_q * dt_micro * flag
-                   IF ( microphysics_morrison )  THEN
-                      nc(k,j,i) = nc(k,j,i) - riming_rate_n * dt_micro * flag
-                   ENDIF
-!
-!--                Store riming rate for rain riming
-                   rime_snow_cloud(k,j,i) = riming_rate_q
-!
-!--                Ice multiplication during riming
-                   mult_q = 0.0
-                   IF ( temp <  t3  .AND.  ice_multiplication )  THEN
-                      mult_1 = ( temp - temp_mult_min ) * const3
-                      mult_2 = ( temp - temp_mult_max ) * const4
-                      mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp ) )
-                      mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp ) )
-                      mult_n = c_mult * mult_1 * mult_2 * riming_rate_q
-                      mult_q = mult_n * cloud_species%snow%x_min
-                      mult_q = MIN( riming_rate_q, mult_q )
-
-                      ni(k,j,i) = ni(k,j,i) + mult_n
-                      qi(k,j,i) = qi(k,j,i) + mult_q
-                      qs(k,j,i) = qs(k,j,i) - mult_q
-                    ENDIF
-!
-!--                If deposition is negative or deposition is smaller than riming, conversion from snow
-!--                to graupel takes place. Note, that here the riming rate of snow-rain is from the
-!--                last time-step. However, the error is assumed to be small.
-                   IF ( dep_rate_snow(k,j,i) < 0.0_wp  .OR.                                        &
-                       dep_rate_snow(k,j,i) < rime_snow_cloud(k,j,i) + rime_snow_rain(k,j,i) )  THEN
-!
-!--                    Conversion from ice to graupel if diameter small enough and riming rates are larger
-!--                    than deposition. If deposition is larger ice stay
-!--                    factor alpha_spacefilling after SB 2006 and icon model
-                       IF ( ds > dsg_conv ) THEN
-                         conv_q = ( riming_rate_q - mult_q ) /                                     &
-                                  ( const5 * ( pi / 6.0_wp * rho_i * ds**3 / xs - 1.0_wp ) )
-                         conv_q = MIN( qs(k,j,i) / dt_micro , conv_q )
-                         conv_n = conv_q / MAX( xs, x_conv )
-                         conv_n = MIN( ns(k,j,i) / dt_micro, conv_n )
-                      ELSE
-                         conv_q = 0.0_wp
-                         conv_n = 0.0_wp
-                      ENDIF
-!
-!--                   Apply conversion from ice to grauppel
-                      qs(k,j,i) = qs(k,j,i) - conv_q * dt_micro * flag
-                      qg(k,j,i) = qg(k,j,i) + conv_q * dt_micro * flag
-                      ns(k,j,i) = ns(k,j,i) - conv_n * dt_micro * flag
-                      ng(k,j,i) = ng(k,j,i) + conv_n * dt_micro * flag
-                   ENDIF
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE riming_snow_cloud
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of cloud and snow (Seifert and Beheng, 2006).
-!> Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_snow_cloud_ij( i, j )
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wP) ::  coll_eff      !< collision efficiency
-       REAL(wp) ::  dc            !< diameter cloud
-       REAL(wp) ::  ds            !< diameter snow
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  mult_n        !< ice multiplaction for number concentration
-       REAL(wp) ::  mult_q        !< ice multiplaction
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  nc_c          !< dummy number concentration cloud dro
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_q !< riming rate mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vc            !< terminal fall velocitiy cloud
-       REAL(wp) ::  vs            !< terminal fall velocitiy snow
-       REAL(wp) ::  xc            !< mean mass cloud
-       REAL(wp) ::  xs            !< mean mass snow
-       REAL(wp) ::  conv_n        !< conversion rate snow number concentration
-       REAL(wp) ::  conv_q        !< conversion rate snow mixing ratio
-       REAL(wp) ::  const1        !< constant for riming
-
-       REAL(wp), PARAMETER ::  const0 = 1.0_wp / ( dc_coll - dc_crit )  !< constant for riming calculation
-       REAL(wp), PARAMETER ::  const3 = 1.0_wp / ( temp_mult_opt - temp_mult_min ) !< constant for snow multiplication
-       REAL(wp), PARAMETER ::  const4 = 1.0_wp / ( temp_mult_opt - temp_mult_max ) !< constant for snow multiplication
-       REAL(wp), PARAMETER ::  const5 = alpha_spacefilling * rho_l / rho_i
-
-       DO  k = nzb+1, nzt
-          IF ( microphysics_morrison )  THEN
-             nc_c = nc(k,j,i)
-          ELSE
-             nc_c = nc_const
-          ENDIF
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Calculate mean mass, mean diameter for both graupel and rain
-          xc = mean_mass( cloud_species%cloud, qc(k,j,i), nc_c     , hyrho(k) )
-          xs = mean_mass( cloud_species%snow,  qs(k,j,i), ns(k,j,i), hyrho(k) )
-
-          dc = mean_diameter( cloud_species%cloud,  xc )
-          ds = mean_diameter( cloud_species%ice,    xs )
-!
-!--       Apply riming only above threshold
-          IF ( qc(k,j,i) > q_thres  .AND.  qs(k,j,i) > eps_sb_coll  .AND.                          &
-               dc > dc_crit  .AND.  ds > df_crit )  THEN
-!
-!--          Calcualte temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Calculate terminal velocites
-             vc = terminal_fall_velocity(cloud_species%cloud, xc, hyrho(k) )
-             vs = terminal_fall_velocity(cloud_species%snow,  xs, hyrho(k) )
-!
-!--          Calculate collision efficiency
-             const1 = const0 * cloud_species%snow%coll_eff
-             coll_eff = MIN( cloud_species%snow%coll_eff,                                          &
-                             MAX( const1 * ( dc - dc_crit ), ecoll_min) )
-!
-!--          Calcualte riming rates
-             riming_rate_n = pi / 4.0_wp * coll_eff * ns(k,j,i) * nc_c *                           &
-                          ( rime_snow_cloud_delta_n_aa * ds**2   +                                 &
-                            rime_snow_cloud_delta_n_ab * ds * dc +                                 &
-                            rime_snow_cloud_delta_n_bb * dc**2)  *                                 &
-                      SQRT( rime_snow_cloud_theta_n_aa * vs**2   -                                 &
-                            rime_snow_cloud_theta_n_ab * vs * vc +                                 &
-                            rime_snow_cloud_theta_n_bb * vc**2   +                                 &
-                            cloud_species%snow%sigma_v**2 )
-
-             riming_rate_q = pi / 4.0_wp * coll_eff * ns(k,j,i) * qc(k,j,i) *                      &
-                          ( rime_snow_cloud_delta_q_aa * ds**2 +                                   &
-                            rime_snow_cloud_delta_q_ab * ds * dc +                                 &
-                            rime_snow_cloud_delta_q_bb * dc**2) *                                  &
-                      SQRT( rime_snow_cloud_theta_q_aa * vs**2 -                                   &
-                            rime_snow_cloud_theta_q_ab * vs * vc +                                 &
-                            rime_snow_cloud_theta_q_bb * vc**2 +                                   &
-                            cloud_species%snow%sigma_v**2 )
-!
-!--          Limit riming rates
-             riming_rate_q = MIN( qc(k,j,i) / dt_micro, MAX( riming_rate_q, 0.0_wp ) )
-             riming_rate_n = MIN( nc_c      / dt_micro, MAX( riming_rate_n, 0.0_wp ) )
-!
-!--          Apply riming snow - cloud
-             qs(k,j,i) = qs(k,j,i) + riming_rate_q * dt_micro * flag
-             qc(k,j,i) = qc(k,j,i) - riming_rate_q * dt_micro * flag
-             IF ( microphysics_morrison )  THEN
-                nc(k,j,i) = nc(k,j,i) - riming_rate_n * dt_micro * flag
-             ENDIF
-!
-!--          Store riming rate for rain riming
-             rime_snow_cloud(k,j,i) = riming_rate_q
-!
-!--          Ice multiplication during riming
-             mult_q = 0.0
-             IF ( temp <  t3  .AND.  ice_multiplication )  THEN
-                mult_1 = ( temp - temp_mult_min ) * const3
-                mult_2 = ( temp - temp_mult_max ) * const4
-                mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp ) )
-                mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp ) )
-                mult_n = c_mult * mult_1 * mult_2 * riming_rate_q
-                mult_q = mult_n * cloud_species%snow%x_min
-                mult_q = MIN( riming_rate_q, mult_q )
-
-                ni(k,j,i) = ni(k,j,i) + mult_n
-                qi(k,j,i) = qi(k,j,i) + mult_q
-                qs(k,j,i) = qs(k,j,i) - mult_q
-              ENDIF
-!
-!--          If deposition is negative or deposition is smaller than riming, conversion from snow
-!--          to graupel takes place. Note, that here the riming rate of snow-rain is from the
-!--          last time-step. However, the error is assumed to be small.
-             IF ( dep_rate_snow(k,j,i) < 0.0_wp  .OR.                                              &
-                  dep_rate_snow(k,j,i) < rime_snow_cloud(k,j,i) + rime_snow_rain(k,j,i) )  THEN
-!
-!--              Conversion from ice to graupel if diameter small enough and riming rates are larger
-!--              than deposition. If deposition is larger ice stay
-!--              factor alpha_spacefilling after SB 2006 and icon model
-                 IF ( ds > dsg_conv ) THEN
-                   conv_q = ( riming_rate_q - mult_q ) /                                           &
-                            ( const5 * ( pi / 6.0_wp * rho_i * ds**3 / xs - 1.0_wp ) )
-                   conv_q = MIN( qs(k,j,i) / dt_micro , conv_q )
-                   conv_n = conv_q / MAX( xs, x_conv )
-                   conv_n = MIN( ns(k,j,i) / dt_micro, conv_n )
-                ELSE
-                   conv_q = 0.0_wp
-                   conv_n = 0.0_wp
-                ENDIF
-!
-!--             Apply conversion from ice to grauppel
-                qs(k,j,i) = qs(k,j,i) - conv_q * dt_micro * flag
-                qg(k,j,i) = qg(k,j,i) + conv_q * dt_micro * flag
-                ns(k,j,i) = ns(k,j,i) - conv_n * dt_micro * flag
-                ng(k,j,i) = ng(k,j,i) + conv_n * dt_micro * flag
-             ENDIF
-
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE riming_snow_cloud_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of rain and snow (Seifert and Beheng, 2006).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_snow_rain
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  dr            !< diameter rain
-       REAL(wp) ::  ds            !< diameter snow
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  mult_n        !< snow multiplaction for number concentration
-       REAL(wp) ::  mult_q        !< ice multiplaction
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_qs!< riming rate snow mixing ratio
-       REAL(wp) ::  riming_rate_qr!< riming rate rain mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vr            !< terminal fall velocitiy rain
-       REAL(wp) ::  vs            !< terminal fall velocitiy snow
-       REAL(wp) ::  xr            !< mean mass rain
-       REAL(wp) ::  xs            !< mean mass snow
-
-       REAL(wp), PARAMETER ::  const3 = 1.0_wp / ( temp_mult_opt - temp_mult_min ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const4 = 1.0_wp / ( temp_mult_opt - temp_mult_max ) !< constant for ice multiplication
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Calculate mean mass, mean diameter for both graupel and rain
-                xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-                xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-
-                dr = mean_diameter( cloud_species%rain, xr )
-                ds = mean_diameter( cloud_species%snow, xs )
-!
-!--             Apply ice-rain riming only above thresholds
-                IF ( qr(k,j,i) > eps_sb_coll  .AND.  qs(k,j,i) > qr_crit  .AND.  ds > df_crit      &
-                     .AND.  nr(k,j,i) > 0.0_wp  .AND.  ns(k,j,i) > 0.0_wp  )  THEN
-!
-!--                Calcualte temperature
-                   temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--                Calculate terminal velocites
-                   vr = terminal_fall_velocity(cloud_species%rain, xr, hyrho(k) )
-                   vs = terminal_fall_velocity(cloud_species%snow, xs, hyrho(k) )
-!
-!--                Calcualte riming rates
-                   riming_rate_n = pi / 4.0_wp * ns(k,j,i) * nr(k,j,i) *                           &
-                                ( rime_snow_rain_delta_n_aa * ds**2   +                            &
-                                  rime_snow_rain_delta_n_ab * ds * dr +                            &
-                                  rime_snow_rain_delta_n_bb * dr**2 ) *                            &
-                            SQRT( rime_snow_rain_theta_n_aa * vs**2   -                            &
-                                  rime_snow_rain_theta_n_ab * vs * vr +                            &
-                                  rime_snow_rain_theta_n_bb * vr**2   +                            &
-                                  cloud_species%snow%sigma_v**2 )
-
-                   riming_rate_qr = pi / 4.0_wp * ns(k,j,i) * qr(k,j,i) *                          &
-                                ( rime_snow_rain_delta_n_aa * ds**2 +                              &
-                                  rime_snow_rain_delta_q_ab * ds * dr +                            &
-                                  rime_snow_rain_delta_q_bb * dr**2 ) *                            &
-                            SQRT( rime_snow_rain_theta_n_aa * vs**2 -                              &
-                                  rime_snow_rain_theta_q_ab * vs * vr +                            &
-                                  rime_snow_rain_theta_q_bb * vr**2 +                              &
-                                  cloud_species%snow%sigma_v**2 )
-
-                   riming_rate_qs = pi / 4.0_wp * nr(k,j,i) * qs(k,j,i) *                          &
-                                ( rime_snow_rain_delta_q_aa * ds**2 +                              &
-                                  rime_snow_rain_delta_q_ab * ds * dr +                            &
-                                  rime_snow_rain_delta_q_bb * dr**2 ) *                            &
-                            SQRT( rime_snow_rain_theta_n_aa * vs**2 -                              &
-                                  rime_snow_rain_theta_q_ab * vs * vr +                            &
-                                  rime_snow_rain_theta_q_bb * vr**2 +                              &
-                                  cloud_species%snow%sigma_v**2 )
-
-!                    riming_rate_qs = pi / 4.0_wp * nr(k,j,i) * qs(k,j,i) *                          &
-!                                 ( rime_snow_rain_delta_q_aa * ds**2 +                              &
-!                                   rime_snow_rain_delta_q_ab * ds * dr +                            &
-!                                   rime_snow_rain_delta_n_bb * dr**2 ) *                            &
-!                             SQRT( rime_snow_rain_theta_q_aa * vs**2 -                              &
-!                                   rime_snow_rain_theta_q_ab * vs * vr +                            &
-!                                   rime_snow_rain_theta_n_bb * vr**2 +                              &
-!                                   cloud_species%ice%sigma_v**2 )
-!
-!--                Limit riming rates
-                   riming_rate_qr = MIN( qr(k,j,i) / dt_micro, MAX( riming_rate_qr, 0.0_wp ) )
-                   riming_rate_qs = MIN( qs(k,j,i) / dt_micro, MAX( riming_rate_qs, 0.0_wp ) )
-                   riming_rate_n  = MIN( nr(k,j,i) / dt_micro, MAX( riming_rate_n,  0.0_wp ) )
-!
-!--                store snow-rain riming rate for ice-cloud riming
-                   rime_snow_rain(k,j,i) = riming_rate_qr
-!
-!--                If deposition is larger than riming snow stays snow
-                   IF ( dep_rate_ice(k,j,i) > 0.0_wp  .AND.                                        &
-                        dep_rate_ice(k,j,i) < rime_snow_rain(k,j,i) + rime_snow_cloud(k,j,i) ) THEN
-!
-!--                   Apply riming snow - rain
-                      qs(k,j,i) = qs(k,j,i) + riming_rate_qr * dt_micro * flag
-                      qr(k,j,i) = qr(k,j,i) - riming_rate_qr * dt_micro * flag
-                      nr(k,j,i) = nr(k,j,i) - riming_rate_n  * dt_micro * flag
-!
-!--                   Ice multiplication during riming snow - rain
-                      mult_q = 0.0
-                      IF ( temp < t3  .AND.  ice_multiplication )  THEN
-                         mult_1 = ( temp - temp_mult_min ) * const3
-                         mult_2 = ( temp - temp_mult_max ) * const4
-                         mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp) )
-                         mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp) )
-                         mult_n = c_mult * mult_1 * mult_2 * riming_rate_qr
-                         mult_q = mult_n * cloud_species%ice%x_min
-                         mult_q = MIN( riming_rate_qr, mult_q )
-
-                         ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                         qi(k,j,i) = qi(k,j,i) + mult_q * dt_micro * flag
-                         qs(k,j,i) = qs(k,j,i) - mult_q * dt_micro * flag
-                      ENDIF
-!
-!--                If deposition is negative (i.e. sublimation or riming is stronger, a different
-!--                treatment is conducted: ice might convert to graupel
-                   ELSE
-!
-!--                   Ensure that riming rate is also not larger than ni
-                      riming_rate_n  = MIN( MIN( nr(k,j,i) / dt_micro, ns(k,j,i) / dt_micro ),     &
-                                             MAX( riming_rate_n,  0.0_wp ) )
-!
-!--                   Substract all riming rates, those riming rates are added to species (either
-!--                   snow again or graupel furhter down)
-                      qs(k,j,i) = qs(k,j,i) - riming_rate_qs * dt_micro * flag
-                      qr(k,j,i) = qr(k,j,i) - riming_rate_qr * dt_micro * flag
-                      ns(k,j,i) = ns(k,j,i) - riming_rate_n  * dt_micro * flag
-                      nr(k,j,i) = nr(k,j,i) - riming_rate_n  * dt_micro * flag
-!
-!--                   Ice multiplication
-                      mult_q = 0.0_wp
-                      mult_n = 0.0_wp
-                      IF ( temp < t3  .AND.  ice_multiplication )  THEN
-                         mult_1 = ( temp - temp_mult_min ) * const3
-                         mult_2 = ( temp - temp_mult_max ) * const4
-                         mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp) )
-                         mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp) )
-                         mult_n = c_mult * mult_1 * mult_2 * riming_rate_qr
-                         mult_q = mult_n * cloud_species%ice%x_min
-                         mult_q = MIN( riming_rate_qr, mult_q )
-                      ENDIF
-!
-!--                   shedding of rain at warm temperatures
-                      IF ( temp >= t3 )  THEN
-!
-!--                      but with modified nr
-                         xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-                         nr(k,j,i) = nr(k,j,i) + riming_rate_qr / xr * dt_micro * flag
-                         ns(k,j,i) = ns(k,j,i) + riming_rate_n  * dt_micro * flag
-                         qs(k,j,i) = qs(k,j,i) + riming_rate_qs * dt_micro * flag
-                         qr(k,j,i) = qr(k,j,i) + riming_rate_qr * dt_micro * flag
-!
-!--                   at tempatures below freezing point graupel is generated
-                      ELSE
-!
-!--                      new ice particles from multiplication
-                         ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                         qi(k,j,i) = qi(k,j,i) + mult_q * dt_micro * flag
-!
-!--                      and riming to graupel
-                         ng(k,j,i) = ng(k,j,i) + riming_rate_n * dt_micro * flag
-                         qg(k,j,i) = qg(k,j,i) + ( riming_rate_qs + riming_rate_qr - mult_q ) *     &
-                                                                                      dt_micro * flag
-                      END IF
-
-                   ENDIF ! loop if deposition or riming is stronger
-                ENDIF ! loop if thresholds for riming are exceeded, otherwise nothings happen
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE riming_snow_rain
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Riming of rain and snow (Seifert and Beheng, 2006).
-!> Call for grid point i,j.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE riming_snow_rain_ij( i, j )
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-
-       REAL(wp) ::  dr            !< diameter rain
-       REAL(wp) ::  ds            !< diameter snow
-       REAL(wp) ::  flag          !< flag to mask topography grid points
-       REAL(wp) ::  mult_n        !< snow multiplaction for number concentration
-       REAL(wp) ::  mult_q        !< ice multiplaction
-       REAL(wp) ::  mult_1        !< factor for ice multiplaction
-       REAL(wp) ::  mult_2        !< factor for ice multiplaction
-       REAL(wp) ::  riming_rate_n !< riming rate number concentration
-       REAL(wp) ::  riming_rate_qs!< riming rate snow mixing ratio
-       REAL(wp) ::  riming_rate_qr!< riming rate rain mixing ratio
-       REAL(wp) ::  temp          !< air temperature
-       REAL(wp) ::  vr            !< terminal fall velocitiy rain
-       REAL(wp) ::  vs            !< terminal fall velocitiy snow
-       REAL(wp) ::  xr            !< mean mass rain
-       REAL(wp) ::  xs            !< mean mass snow
-
-       REAL(wp), PARAMETER ::  const3 = 1.0_wp / ( temp_mult_opt - temp_mult_min ) !< constant for ice multiplication
-       REAL(wp), PARAMETER ::  const4 = 1.0_wp / ( temp_mult_opt - temp_mult_max ) !< constant for ice multiplication
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Calculate mean mass, mean diameter for both graupel and rain
-          xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-          xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-
-          dr = mean_diameter( cloud_species%rain, xr )
-          ds = mean_diameter( cloud_species%snow, xs )
-!
-!--       Apply ice-rain riming only above thresholds
-          IF ( qr(k,j,i) > eps_sb_coll  .AND.  qs(k,j,i) > qr_crit  .AND.  ds > df_crit            &
-               .AND.  nr(k,j,i) > 0.0_wp  .AND.  ns(k,j,i) > 0.0_wp  )  THEN
-!
-!--          Calcualte temperature
-             temp = exner(k) * pt(k,j,i) + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--          Calculate terminal velocites
-             vr = terminal_fall_velocity(cloud_species%rain, xr, hyrho(k) )
-             vs = terminal_fall_velocity(cloud_species%snow, xs, hyrho(k) )
-!
-!--          Calcualte riming rates
-             riming_rate_n = pi / 4.0_wp * ns(k,j,i) * nr(k,j,i) *                                 &
-                          ( rime_snow_rain_delta_n_aa * ds**2   +                                  &
-                            rime_snow_rain_delta_n_ab * ds * dr +                                  &
-                            rime_snow_rain_delta_n_bb * dr**2 ) *                                  &
-                      SQRT( rime_snow_rain_theta_n_aa * vs**2   -                                  &
-                            rime_snow_rain_theta_n_ab * vs * vr +                                  &
-                            rime_snow_rain_theta_n_bb * vr**2   +                                  &
-                            cloud_species%snow%sigma_v**2 )
-
-             riming_rate_qr = pi / 4.0_wp * ns(k,j,i) * qr(k,j,i) *                                &
-                          ( rime_snow_rain_delta_n_aa * ds**2 +                                    &
-                            rime_snow_rain_delta_q_ab * ds * dr +                                  &
-                            rime_snow_rain_delta_q_bb * dr**2 ) *                                  &
-                      SQRT( rime_snow_rain_theta_n_aa * vs**2 -                                    &
-                            rime_snow_rain_theta_q_ab * vs * vr +                                  &
-                            rime_snow_rain_theta_q_bb * vr**2 +                                    &
-                            cloud_species%snow%sigma_v**2 )
-
-             riming_rate_qs = pi / 4.0_wp * nr(k,j,i) * qs(k,j,i) *                                &
-                          ( rime_snow_rain_delta_q_aa * ds**2 +                                    &
-                            rime_snow_rain_delta_q_ab * ds * dr +                                  &
-                            rime_snow_rain_delta_q_bb * dr**2 ) *                                  &
-                      SQRT( rime_snow_rain_theta_n_aa * vs**2 -                                    &
-                            rime_snow_rain_theta_q_ab * vs * vr +                                  &
-                            rime_snow_rain_theta_q_bb * vr**2 +                                    &
-                            cloud_species%snow%sigma_v**2 )
-
-!              riming_rate_qs = pi / 4.0_wp * nr(k,j,i) * qs(k,j,i) *                                &
-!                           ( rime_snow_rain_delta_q_aa * ds**2 +                                    &
-!                             rime_snow_rain_delta_q_ab * ds * dr +                                  &
-!                             rime_snow_rain_delta_n_bb * dr**2 ) *                                  &
-!                       SQRT( rime_snow_rain_theta_q_aa * vs**2 -                                    &
-!                             rime_snow_rain_theta_q_ab * vs * vr +                                  &
-!                             rime_snow_rain_theta_n_bb * vr**2 +                                    &
-!                             cloud_species%ice%sigma_v**2 )
-!
-!--          Limit riming rates
-             riming_rate_qr = MIN( qr(k,j,i) / dt_micro, MAX( riming_rate_qr, 0.0_wp ) )
-             riming_rate_qs = MIN( qs(k,j,i) / dt_micro, MAX( riming_rate_qs, 0.0_wp ) )
-             riming_rate_n  = MIN( nr(k,j,i) / dt_micro, MAX( riming_rate_n,  0.0_wp ) )
-!
-!--          store snow-rain riming rate for ice-cloud riming
-             rime_snow_rain(k,j,i) = riming_rate_qr
-!
-!--          If deposition is larger than riming snow stays snow
-             IF ( dep_rate_ice(k,j,i) > 0.0_wp  .AND.                                             &
-                  dep_rate_ice(k,j,i) < rime_snow_rain(k,j,i) + rime_snow_cloud(k,j,i) ) THEN
-!
-!--             Apply riming snow - rain
-                qs(k,j,i) = qs(k,j,i) + riming_rate_qr * dt_micro * flag
-                qr(k,j,i) = qr(k,j,i) - riming_rate_qr * dt_micro * flag
-                nr(k,j,i) = nr(k,j,i) - riming_rate_n  * dt_micro * flag
-!
-!--             Ice multiplication during riming snow - rain
-                mult_q = 0.0
-                IF ( temp < t3  .AND.  ice_multiplication )  THEN
-                   mult_1 = ( temp - temp_mult_min ) * const3
-                   mult_2 = ( temp - temp_mult_max ) * const4
-                   mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp) )
-                   mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp) )
-                   mult_n = c_mult * mult_1 * mult_2 * riming_rate_qr
-                   mult_q = mult_n * cloud_species%ice%x_min
-                   mult_q = MIN( riming_rate_qr, mult_q )
-
-                   ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                   qi(k,j,i) = qi(k,j,i) + mult_q * dt_micro * flag
-                   qs(k,j,i) = qs(k,j,i) - mult_q * dt_micro * flag
-                ENDIF
-!
-!--          If deposition is negative (i.e. sublimation or riming is stronger, a different
-!--          treatment is conducted: ice might convert to graupel
-             ELSE
-!
-!--             Ensure that riming rate is also not larger than ni
-                riming_rate_n  = MIN( MIN( nr(k,j,i) / dt_micro, ns(k,j,i) / dt_micro ),          &
-                                       MAX( riming_rate_n,  0.0_wp ) )
-!
-!--             Substract all riming rates, those riming rates are added to species (either snow
-!--             again or graupel furhter down)
-                qs(k,j,i) = qs(k,j,i) - riming_rate_qs * dt_micro * flag
-                qr(k,j,i) = qr(k,j,i) - riming_rate_qr * dt_micro * flag
-                ns(k,j,i) = ns(k,j,i) - riming_rate_n  * dt_micro * flag
-                nr(k,j,i) = nr(k,j,i) - riming_rate_n  * dt_micro * flag
-!
-!--             Ice multiplication
-                mult_q = 0.0_wp
-                mult_n = 0.0_wp
-                IF ( temp < t3  .AND.  ice_multiplication )  THEN
-                   mult_1 = ( temp - temp_mult_min ) * const3
-                   mult_2 = ( temp - temp_mult_max ) * const4
-                   mult_1 = MAX( 0.0_wp, MIN( mult_1, 1.0_wp) )
-                   mult_2 = MAX( 0.0_wp, MIN( mult_2, 1.0_wp) )
-                   mult_n = c_mult * mult_1 * mult_2 * riming_rate_qr
-                   mult_q = mult_n * cloud_species%ice%x_min
-                   mult_q = MIN( riming_rate_qr, mult_q )
-                ENDIF
-!
-!--             shedding of rain at warm temperatures
-                IF ( temp >= t3 )  THEN
-!
-!--                but with modified nr
-                   xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-                   nr(k,j,i) = nr(k,j,i) + riming_rate_qr / xr * dt_micro * flag
-                   ns(k,j,i) = ns(k,j,i) + riming_rate_n  * dt_micro * flag
-                   qs(k,j,i) = qs(k,j,i) + riming_rate_qs * dt_micro * flag
-                   qr(k,j,i) = qr(k,j,i) + riming_rate_qr * dt_micro * flag
-!
-!--             at tempatures below freezing point graupel is generated
-                ELSE
-!
-!--                new ice particles from multiplication
-                   ni(k,j,i) = ni(k,j,i) + mult_n * dt_micro * flag
-                   qi(k,j,i) = qi(k,j,i) + mult_q * dt_micro * flag
-!
-!--                and riming to graupel
-                   ng(k,j,i) = ng(k,j,i) + riming_rate_n * dt_micro * flag
-                   qg(k,j,i) = qg(k,j,i) + ( riming_rate_qs + riming_rate_qr - mult_q ) *          &
-                                                                                     dt_micro * flag
-                END IF
-
-             ENDIF ! loop if deposition or riming is stronger
-          ENDIF ! loop if thresholds for riming are exceeded, otherwise nothings happen
-
-       ENDDO
-
-    END SUBROUTINE riming_snow_rain_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Evaporation of precipitable water. Condensation is neglected for precipitable water.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE evaporation_rain
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp)     ::  dr                !<
-       REAL(wp)     ::  evap              !<
-       REAL(wp)     ::  evap_nr           !<
-       REAL(wp)     ::  f_vent            !<
-       REAL(wp)     ::  flag              !< flag to mask topography grid points
-       REAL(wp)     ::  g_evap            !<
-       REAL(wp)     ::  lambda_r          !<
-       REAL(wp)     ::  mu_r              !<
-       REAL(wp)     ::  mu_r_2            !<
-       REAL(wp)     ::  mu_r_5d2          !<
-       REAL(wp)     ::  nr_0              !<
-       REAL(wp)     ::  temp              !<
-       REAL(wp)     ::  xr                !<
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                IF ( qr(k,j,i) > eps_sb  .AND.  nr(k,j,i) > 0.0_wp )  THEN
-!
-!--                Call calculation of supersaturation
-                   CALL supersaturation ( i, j, k )
-!
-!--                Evaporation needs only to be calculated in subsaturated regions
-                   IF ( sat < 0.0_wp )  THEN
-!
-!--                   Actual temperature:
-                      temp = t_l + lv_d_cp * ( qc(k,j,i) + qr(k,j,i) )
-
-                      g_evap = 1.0_wp / ( ( l_v / ( r_v * temp ) - 1.0_wp ) *                      &
-                                            l_v / ( thermal_conductivity_l  * temp )               &
-                                          + r_v * temp / ( diff_coeff_l * e_s )                    &
-                                        )
-!
-!--                   Mean weight of rain drops
-                      !xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-                      xr = hyrho(k) * qr(k,j,i) / nr(k,j,i)
-!
-!--                   Weight averaged diameter of rain drops:
-                      dr = ( xr * dpirho_l )**( 1.0_wp / 3.0_wp )
-!
-!--                   Compute ventilation factor and intercept parameter
-!--                   (Seifert and Beheng, 2006; Seifert, 2008):
-                      IF ( ventilation_effect )  THEN
-!
-!--                      Shape parameter of gamma distribution (Milbrandt and Yau,
-!--                      2005; Stevens and Seifert, 2008):
-                         mu_r = 10.0_wp * ( 1.0_wp + TANH( 1.2E3_wp * ( dr - 1.4E-3_wp ) ) )
-!
-!--                      Slope parameter of gamma distribution (Seifert, 2008):
-                         lambda_r = ( ( mu_r + 3.0_wp ) * ( mu_r + 2.0_wp ) * ( mu_r + 1.0_wp )    &
-                                    )**( 1.0_wp / 3.0_wp ) / dr
-
-                         mu_r_2   = mu_r + 2.0_wp
-                         mu_r_5d2 = mu_r + 2.5_wp
-
-                         f_vent = a_vent * gamm( mu_r_2 ) *                                        &
-                                  lambda_r**( -mu_r_2 ) + b_vent *                                 &
-                                  schmidt_p_1d3 * SQRT( a_term / kin_vis_air ) *                   &
-                                  gamm( mu_r_5d2 ) * lambda_r**( -mu_r_5d2 ) *                     &
-                                  ( 1.0_wp -                                                       &
-                                    0.5_wp       * ( b_term / a_term ) *                           &
-                                    ( lambda_r / ( c_term + lambda_r ) )**mu_r_5d2          -      &
-                                    0.125_wp     * ( b_term / a_term )**2 *                        &
-                                    ( lambda_r / ( 2.0_wp * c_term + lambda_r ) )**mu_r_5d2 -      &
-                                    0.0625_wp    * ( b_term / a_term )**3 *                        &
-                                    ( lambda_r / ( 3.0_wp * c_term + lambda_r ) )**mu_r_5d2 -      &
-                                    0.0390625_wp * ( b_term / a_term )**4 *                        &
-                                    ( lambda_r / ( 4.0_wp * c_term + lambda_r ) )**mu_r_5d2        &
-                                  )
-
-                         nr_0   = nr(k,j,i) * lambda_r**( mu_r + 1.0_wp ) /    &
-                                  gamm( mu_r + 1.0_wp )
-                      ELSE
-                         f_vent = 1.0_wp
-                         nr_0   = nr(k,j,i) * dr
-                      ENDIF
-!
-!--                   Evaporation rate of rain water content (Seifert and Beheng, 2006):
-                      evap    = 2.0_wp * pi * nr_0 * g_evap * f_vent * sat / hyrho(k)
-                      evap    = MAX( evap, -qr(k,j,i) / dt_micro )
-                      evap_nr = MAX( c_evap * evap / xr * hyrho(k), - nr(k,j,i) / dt_micro )
-                      qr(k,j,i) = qr(k,j,i) + evap    * dt_micro * flag
-                      nr(k,j,i) = nr(k,j,i) + evap_nr * dt_micro * flag
-
-                   ENDIF
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE evaporation_rain
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Evaporation of precipitable water. Condensation is neglected for precipitable water. Call for
-!> grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE evaporation_rain_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< loop index
-       INTEGER(iwp) ::  j                 !< loop index
-       INTEGER(iwp) ::  k                 !< loop index
-
-       REAL(wp)     ::  dr                !<
-       REAL(wp)     ::  evap              !<
-       REAL(wp)     ::  evap_nr           !<
-       REAL(wp)     ::  f_vent            !<
-       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
-       REAL(wp)     ::  g_evap            !<
-       REAL(wp)     ::  lambda_r          !<
-       REAL(wp)     ::  mu_r              !<
-       REAL(wp)     ::  mu_r_2            !<
-       REAL(wp)     ::  mu_r_5d2          !<
-       REAL(wp)     ::  nr_0              !<
-       REAL(wp)     ::  temp              !<
-       REAL(wp)     ::  xr                !<
-
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          IF ( qr(k,j,i) > eps_sb  .AND.  nr(k,j,i) > 0.0_wp )  THEN
-!
-!--          Call calculation of supersaturation
-             CALL supersaturation ( i, j, k )
-!
-!--          Evaporation needs only to be calculated in subsaturated regions
-             IF ( sat < 0.0_wp )  THEN
-!
-!--             Actual temperature:
-                temp = t_l + lv_d_cp * ( qc(k,j,i) + qr(k,j,i) )
-
-                g_evap = 1.0_wp / ( ( l_v / ( r_v * temp ) - 1.0_wp ) *                            &
-                                      l_v / ( thermal_conductivity_l  * temp )                     &
-                                    + r_v * temp / ( diff_coeff_l * e_s )                          &
-                                  )
-!
-!--             Mean weight of rain drops
-                !xr = mean_mass( cloud_species%rain, qr(k,j,i), nr(k,j,i), hyrho(k) )
-                xr = hyrho(k) * qr(k,j,i) / nr(k,j,i)
-!
-!--             Weight averaged diameter of rain drops:
-                dr = ( xr * dpirho_l )**( 1.0_wp / 3.0_wp )
-!
-!--             Compute ventilation factor and intercept parameter
-!--             (Seifert and Beheng, 2006; Seifert, 2008):
-                IF ( ventilation_effect )  THEN
-!
-!--                Shape parameter of gamma distribution (Milbrandt and Yau, 2005;
-!--                Stevens and Seifert, 2008):
-                   mu_r = 10.0_wp * ( 1.0_wp + TANH( 1.2E3_wp * ( dr - 1.4E-3_wp ) ) )
-!
-!--                Slope parameter of gamma distribution (Seifert, 2008):
-                   lambda_r = ( ( mu_r + 3.0_wp ) * ( mu_r + 2.0_wp ) * ( mu_r + 1.0_wp )          &
-                              )**( 1.0_wp / 3.0_wp ) / dr
-
-                   mu_r_2   = mu_r + 2.0_wp
-                   mu_r_5d2 = mu_r + 2.5_wp
-
-                   f_vent = a_vent * gamm( mu_r_2 ) * lambda_r**( -mu_r_2 ) +                      &
-                            b_vent * schmidt_p_1d3 *                                               &
-                            SQRT( a_term / kin_vis_air ) * gamm( mu_r_5d2 ) *                      &
-                            lambda_r**( -mu_r_5d2 ) *                                              &
-                            ( 1.0_wp -                                                             &
-                              0.5_wp       * ( b_term / a_term ) *                                 &
-                              ( lambda_r / ( c_term + lambda_r ) )**mu_r_5d2          -            &
-                              0.125_wp     * ( b_term / a_term )**2 *                              &
-                              ( lambda_r / ( 2.0_wp * c_term + lambda_r ) )**mu_r_5d2 -            &
-                              0.0625_wp    * ( b_term / a_term )**3 *                              &
-                              ( lambda_r / ( 3.0_wp * c_term + lambda_r ) )**mu_r_5d2 -            &
-                              0.0390625_wp * ( b_term / a_term )**4 *                              &
-                              ( lambda_r / ( 4.0_wp * c_term + lambda_r ) )**mu_r_5d2              &
-                            )
-
-                   nr_0   = nr(k,j,i) * lambda_r**( mu_r + 1.0_wp ) / gamm( mu_r + 1.0_wp )
-                ELSE
-                   f_vent = 1.0_wp
-                   nr_0   = nr(k,j,i) * dr
-                ENDIF
-!
-!--             Evaporation rate of rain water content (Seifert and Beheng, 2006):
-                evap    = 2.0_wp * pi * nr_0 * g_evap * f_vent * sat / hyrho(k)
-                evap    = MAX( evap, -qr(k,j,i) / dt_micro )
-                evap_nr = MAX( c_evap * evap / xr * hyrho(k), - nr(k,j,i) / dt_micro )
-                qr(k,j,i) = qr(k,j,i) + evap    * dt_micro * flag
-                nr(k,j,i) = nr(k,j,i) + evap_nr * dt_micro * flag
-
-             ENDIF
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE evaporation_rain_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sedimentation of cloud droplets (Ackermann et al., 2009, MWR).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE sedimentation_cloud
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i             !< loop index
-       INTEGER(iwp) ::  j             !< loop index
-       INTEGER(iwp) ::  k             !< loop index
-
-       REAL(wp) ::  flag              !< flag to mask topography grid points
-       REAL(wp) ::  nc_c              !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_nc !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qc !<
-
-       sed_qc(nzt+1) = 0.0_wp
-       sed_nc(nzt+1) = 0.0_wp
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzt, nzb+1, -1
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                IF ( microphysics_morrison )  THEN
-                   nc_c = nc(k,j,i)
-                ELSE
-                   nc_c = nc_const
-                ENDIF
-
-!
-!--             Sedimentation fluxes for number concentration are only calculated for cloud_scheme =
-!--             'morrison'
-                IF ( microphysics_morrison )  THEN
-                   IF ( qc(k,j,i) > eps_sb  .AND.  nc(k,j,i) > eps_mr )  THEN
-                      sed_nc(k) = sed_qc_const * ( qc(k,j,i) * hyrho(k) )**( 2.0_wp / 3.0_wp ) *   &
-                                  ( nc(k,j,i) )**( 1.0_wp / 3.0_wp )
-                   ELSE
-                      sed_nc(k) = 0.0_wp
-                   ENDIF
-
-                   sed_nc(k) = MIN( sed_nc(k), hyrho(k) * dzu(k+1) *                               &
-                                    nc(k,j,i) / dt_micro + sed_nc(k+1)                             &
-                                  ) * flag
-
-                   nc(k,j,i) = nc(k,j,i) + ( sed_nc(k+1) - sed_nc(k) ) * ddzu(k+1) /               &
-                               hyrho(k) * dt_micro * flag
-                ENDIF
-
-                IF ( qc(k,j,i) > eps_sb .AND.  nc_c > eps_mr )  THEN
-                   sed_qc(k) = sed_qc_const * nc_c**( -2.0_wp / 3.0_wp )  *                     &
-                               ( qc(k,j,i) * hyrho(k) )**( 5.0_wp / 3.0_wp ) * flag
-                ELSE
-                   sed_qc(k) = 0.0_wp
-                ENDIF
-
-                sed_qc(k) = MIN( sed_qc(k), hyrho(k) * dzu(k+1) * q(k,j,i) / dt_micro + sed_qc(k+1)&
-                               ) * flag
-
-                q(k,j,i)  = q(k,j,i)  + ( sed_qc(k+1) - sed_qc(k) ) *                              &
-                                        ddzu(k+1) / hyrho(k) * dt_micro * flag
-                qc(k,j,i) = qc(k,j,i) + ( sed_qc(k+1) - sed_qc(k) ) *                              &
-                                        ddzu(k+1) / hyrho(k) * dt_micro * flag
-                pt(k,j,i) = pt(k,j,i) - ( sed_qc(k+1) - sed_qc(k) ) *                              &
-                                        ddzu(k+1) / hyrho(k) * lv_d_cp *                           &
-                                        d_exner(k) * dt_micro           * flag
-
-!
-!--             Compute the precipitation rate due to cloud (fog) droplets
-                IF ( call_microphysics_at_all_substeps )  THEN
-                   prr(k,j,i) = prr(k,j,i) +  sed_qc(k) / hyrho(k)                                 &
-                                * weight_substep(intermediate_timestep_count)                      &
-                                * flag
-                ELSE
-                   prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) * flag
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE sedimentation_cloud
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sedimentation of cloud droplets (Ackermann et al., 2009, MWR).
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE sedimentation_cloud_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i             !< loop index
-       INTEGER(iwp) ::  j             !< loop index
-       INTEGER(iwp) ::  k             !< loop index
-
-       REAL(wp)     ::  flag    !< flag to indicate first grid level above surface
-       REAL(wp)     ::  nc_c    !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_nc  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qc  !<
-
-       sed_qc(nzt+1) = 0.0_wp
-       sed_nc(nzt+1) = 0.0_wp
-
-
-       DO  k = nzt, nzb+1, -1
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-          IF ( microphysics_morrison )  THEN
-             nc_c = nc(k,j,i)
-          ELSE
-             nc_c = nc_const
-          ENDIF
-!
-!--       Sedimentation fluxes for number concentration are only calculated for cloud_scheme =
-!--       'morrison'
-          IF ( microphysics_morrison )  THEN
-             IF ( qc(k,j,i) > eps_sb  .AND.  nc(k,j,i) > eps_mr )  THEN
-                sed_nc(k) = sed_qc_const * ( qc(k,j,i) * hyrho(k) )**( 2.0_wp / 3.0_wp ) *         &
-                            ( nc(k,j,i) )**( 1.0_wp / 3.0_wp )
-             ELSE
-                sed_nc(k) = 0.0_wp
-             ENDIF
-
-             sed_nc(k) = MIN( sed_nc(k), hyrho(k) * dzu(k+1) *                                     &
-                              nc(k,j,i) / dt_micro + sed_nc(k+1)                                   &
-                            ) * flag
-
-             nc(k,j,i) = nc(k,j,i) + ( sed_nc(k+1) - sed_nc(k) ) * ddzu(k+1) /                     &
-                         hyrho(k) * dt_micro * flag
-          ENDIF
-
-          IF ( qc(k,j,i) > eps_sb  .AND.  nc_c > eps_mr )  THEN
-             sed_qc(k) = sed_qc_const * nc_c**( -2.0_wp / 3.0_wp )   *                          &
-                         ( qc(k,j,i) * hyrho(k) )**( 5.0_wp / 3.0_wp )  * flag
-          ELSE
-             sed_qc(k) = 0.0_wp
-          ENDIF
-
-          sed_qc(k) = MIN( sed_qc(k), hyrho(k) * dzu(k+1) * q(k,j,i) / dt_micro + sed_qc(k+1)      &
-                         ) * flag
-
-          q(k,j,i)  = q(k,j,i)  + ( sed_qc(k+1) - sed_qc(k) ) *                                    &
-                                  ddzu(k+1) / hyrho(k) * dt_micro * flag
-          qc(k,j,i) = qc(k,j,i) + ( sed_qc(k+1) - sed_qc(k) ) *                                    &
-                                  ddzu(k+1) / hyrho(k) * dt_micro * flag
-          pt(k,j,i) = pt(k,j,i) - ( sed_qc(k+1) - sed_qc(k) ) *                                    &
-                                  ddzu(k+1) / hyrho(k) * lv_d_cp * d_exner(k) * dt_micro * flag
-
-!
-!--       Compute the precipitation rate of cloud (fog) droplets
-          IF ( call_microphysics_at_all_substeps )  THEN
-             prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) *                                      &
-                          weight_substep(intermediate_timestep_count) * flag
-          ELSE
-             prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) * flag
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE sedimentation_cloud_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sedimentation of ice crystals
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE sedimentation_ice
-
-       INTEGER(iwp) ::  i             !< loop index
-       INTEGER(iwp) ::  j             !< loop index
-       INTEGER(iwp) ::  k             !< loop index
-
-       REAL(wp) ::  av = 6.39_wp                  !< parameter for calculating fall speed
-       REAL(wp) ::  bv = 0.1666_wp                !< parameter (1/6)
-       REAL(wp) ::  factor_sed_gamma_n = 0.76_wp !< factor for zeroth moment and Âµ =1/3 and nu=0
-       REAL(wp) ::  factor_sed_gamma_q = 1.61_wp !< factor for first moment and Âµ =1/3 and nu=0
-       REAL(wp) ::  flag                          !< flag to indicate first grid level
-       REAL(wp) ::  xi = 0.0_wp                   !< mean mass of ice crystal
-       REAL(wp) ::  vi = 0.0_wp                   !< mean fall speed of ice crystal
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_ni  !< sedimentation rate zeroth moment
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qi  !< sedimentation rate fist moment
-
-       sed_qi(nzt+1) = 0.0_wp
-       sed_ni(nzt+1) = 0.0_wp
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzt, nzb+1, -1
-
-                IF ( ni(k,j,i) <= 0.0_wp )  THEN
-                   xi = 0.0_wp
-                ELSE
-!--                Calculate mean mass of ice crystal
-                   xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-                ENDIF
-!
-!--             Calculate fall speed of ice crystal
-                vi = av * xi**bv
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Calculate sedimentation rate for each grid box
-                IF ( qi(k,j,i) > eps_sb  .AND.  ni(k,j,i) >= 0.0_wp )  THEN
-                   sed_qi(k) = qi(k,j,i) * vi * factor_sed_gamma_q * flag
-                   sed_ni(k) = ni(k,j,i) * vi * factor_sed_gamma_n * flag
-                ELSE
-                   sed_qi(k) = 0.0_wp
-                   sed_ni(k) = 0.0_wp
-                ENDIF
-!
-!--             Calculate sedimentation: divergence of sedimentation flux
-                sed_qi(k) = MIN( sed_qi(k), hyrho(k) * dzu(k+1) * q(k,j,i) / dt_micro + sed_qi(k+1)&
-                               ) * flag
-
-                q(k,j,i)  = q(k,j,i)  + ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1)                    &
-                                      / hyrho(k) * dt_micro * flag
-                qi(k,j,i) = qi(k,j,i) + ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1)                    &
-                                      / hyrho(k) * dt_micro * flag
-                ni(k,j,i) = ni(k,j,i) + ( sed_ni(k+1) - sed_ni(k) ) * ddzu(k+1)                    &
-                                      / hyrho(k) * dt_micro * flag
-
-                pt(k,j,i) = pt(k,j,i) - ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1)                    &
-                                      / hyrho(k) * l_s / c_p * d_exner(k) *                        &
-                                        dt_micro * flag
-!
-!--             Compute the precipitation rate of cloud (fog) droplets
-                IF ( call_microphysics_at_all_substeps )  THEN
-                   prr(k,j,i) = prr(k,j,i) + sed_qi(k) / hyrho(k) *                                &
-                                weight_substep(intermediate_timestep_count) * flag
-                ELSE
-                   prr(k,j,i) = prr(k,j,i) + sed_qi(k) / hyrho(k) * flag
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE sedimentation_ice
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sedimentation of ice crystals
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE sedimentation_ice_ij( i, j )
-
-       INTEGER(iwp) ::  i             !<
-       INTEGER(iwp) ::  j             !<
-       INTEGER(iwp) ::  k             !<
-
-       REAL(wp) ::  av = 6.39_wp   !< parameter for calculating fall speed
-       REAL(wp) ::  bv = 0.1666_wp !<
-       REAL(wp) ::  factor_sed_gamma_n = 0.76_wp
-       REAL(wp) ::  factor_sed_gamma_q = 1.61_wp
-       REAL(wp) ::  flag           !< flag to indicate first grid level
-       REAL(wp) ::  xi = 0.0_wp    !< mean mass of ice crystal
-       REAL(wp) ::  vi = 0.0_wp    !< mean fall speed of ice crystal
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_ni  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qi  !<
-
-       sed_qi(nzt+1) = 0.0_wp
-       sed_ni(nzt+1) = 0.0_wp
-
-       DO  k = nzt, nzb+1, -1
-          IF ( ni(k,j,i) <= 0.0_wp )  THEN
-             xi = 0.0_wp
-          ELSE
-!--          Calculate mean mass of ice crystal limit to minimum and maximum mass
-             xi = mean_mass( cloud_species%ice, qi(k,j,i), ni(k,j,i), hyrho(k) )
-          ENDIF
-!
-!--       calculate fall speed of ice crystal
-          vi = av * xi**bv
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Calculate sedimentation rate for each grid box
-          IF ( qi(k,j,i) > eps_sb  .AND.  ni(k,j,i) >= 0.0_wp )  THEN
-             sed_qi(k) = qi(k,j,i) * vi * factor_sed_gamma_q * flag
-             sed_ni(k) = ni(k,j,i) * vi * factor_sed_gamma_n * flag
-          ELSE
-             sed_qi(k) = 0.0_wp
-             sed_ni(k) = 0.0_wp
-          ENDIF
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          sed_qi(k) = MIN( sed_qi(k), hyrho(k) * dzu(k+1) * qi(k,j,i) / dt_micro + sed_qi(k+1)     &
-                         ) * flag
-          sed_ni(k) = MIN( sed_ni(k), hyrho(k) * dzu(k+1) * ni(k,j,i) / dt_micro + sed_ni(k+1)     &
-                         ) * flag
-
-          q(k,j,i)  = q(k,j,i)  + ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          qi(k,j,i) = qi(k,j,i) + ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          ni(k,j,i) = ni(k,j,i) + ( sed_ni(k+1) - sed_ni(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          pt(k,j,i) = pt(k,j,i) - ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * l_s / c_p * d_exner(k) * dt_micro * flag
-!
-!--       Compute the precipitation rate of ice
-          IF ( call_microphysics_at_all_substeps )  THEN
-             prr(k,j,i) = prr(k,j,i) + sed_qi(k) / hyrho(k) *                                      &
-                          weight_substep(intermediate_timestep_count) * flag
-          ELSE
-             prr(k,j,i) = prr(k,j,i) + sed_qi(k) / hyrho(k) * flag
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE sedimentation_ice_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sedimentation of graupel assuming generalized gamma distibution (Seifert and Beheng, 2006)
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE sedimentation_graupel
-
-       INTEGER(iwp) ::  i             !<
-       INTEGER(iwp) ::  j             !<
-       INTEGER(iwp) ::  k             !<
-
-       REAL(wp) ::  av = 46.4_wp   !< parameter for calculating fall speed
-       REAL(wp) ::  bv = 0.26_wp   !< constant in fall speed relation
-       REAL(wp) ::  factor_sed_gamma_n = 0.88_wp !< corresponds to Âµ=1/3 and v=1 for gamma distribution
-       REAL(wp) ::  factor_sed_gamma_q = 1.21_wp !< corresponds to Âµ=1/3 and v=1 for gamma distribution
-       REAL(wp) ::  flag           !< flag to indicate first grid level
-       REAL(wp) ::  xg = 0.0_wp    !< mean mass of graupel
-       REAL(wp) ::  vg = 0.0_wp    !< mean fall speed of graupel
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_ng  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qg  !<
-
-       sed_qg(nzt+1) = 0.0_wp
-       sed_ng(nzt+1) = 0.0_wp
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzt, nzb+1, -1
-                IF ( ng(k,j,i) <= 0.0_wp )  THEN
-                   xg = 0.0_wp
-                ELSE
-!--                Calculate mean mass of ice crystal
-                   xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-                ENDIF
-!
-!--             calculate fall speed of graupel
-                vg = av * xg**bv
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Calculate sedimentation rate for each grid box, factors are
-!--             calculated using
-                IF ( qg(k,j,i) > eps_sb  .AND.  ng(k,j,i) >= 0.0_wp )  THEN
-                   sed_qg(k) = qg(k,j,i) * vg * factor_sed_gamma_q * flag
-                   sed_ng(k) = ng(k,j,i) * vg * factor_sed_gamma_n * flag
-                ELSE
-                   sed_qg(k) = 0.0_wp
-                   sed_ng(k) = 0.0_wp
-                ENDIF
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                sed_qg(k) = MIN( sed_qg(k), hyrho(k) * dzu(k+1) * qg(k,j,i) / dt_micro +           &
-                                 sed_qg(k+1) ) * flag
-
-                q(k,j,i)  = q(k,j,i)  + ( sed_qg(k+1) - sed_qg(k) ) * ddzu(k+1) /                  &
-                                      hyrho(k) * dt_micro * flag
-                qg(k,j,i) = qg(k,j,i) + ( sed_qg(k+1) - sed_qg(k) ) * ddzu(k+1) /                  &
-                                      hyrho(k) * dt_micro * flag
-                ng(k,j,i) = ng(k,j,i) + ( sed_ng(k+1) - sed_ng(k) ) * ddzu(k+1) /                  &
-                                      hyrho(k) * dt_micro * flag
-                pt(k,j,i) = pt(k,j,i) - ( sed_qg(k+1) - sed_qg(k) ) * ddzu(k+1) /                  &
-                                      hyrho(k) * l_s / c_p * d_exner(k) * dt_micro * flag
-!
-!--             Compute the precipitation rate of graupel
-                IF ( call_microphysics_at_all_substeps )  THEN
-                   prr(k,j,i) = prr(k,j,i) + sed_qg(k) / hyrho(k) *                                &
-                                weight_substep(intermediate_timestep_count) * flag
-                ELSE
-                   prr(k,j,i) = prr(k,j,i) + sed_qg(k) / hyrho(k) * flag
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE sedimentation_graupel
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sedimentation of graupel assuming generalized gamma distibution (Seifert and Beheng, 2006)
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE sedimentation_graupel_ij( i, j )
-
-       INTEGER(iwp) ::  i             !<
-       INTEGER(iwp) ::  j             !<
-       INTEGER(iwp) ::  k             !<
-
-       REAL(wp) ::  av = 46.4_wp   !< parameter for calculating fall speed
-       REAL(wp) ::  bv = 0.26_wp   !< constant in fall speed relation
-       REAL(wp) ::  factor_sed_gamma_n = 0.88_wp !< corresponds to Âµ=1/3 and v=1 for gamma distribution
-       REAL(wp) ::  factor_sed_gamma_q = 1.21_wp !< corresponds to Âµ=1/3 and v=1 for gamma distribution
-       REAL(wp) ::  flag           !< flag to indicate first grid level
-       REAL(wp) ::  xg = 0.0_wp    !< mean mass of graupel
-       REAL(wp) ::  vg = 0.0_wp    !< mean fall speed of graupel
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_ng  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qg  !<
-
-       sed_qg(nzt+1) = 0.0_wp
-       sed_ng(nzt+1) = 0.0_wp
-
-       DO  k = nzt, nzb+1, -1
-          IF ( ng(k,j,i) <= 0.0_wp )  THEN
-             xg = 0.0_wp
-          ELSE
-!--          Calculate mean mass of ice crystal
-             xg = mean_mass( cloud_species%graupel, qg(k,j,i), ng(k,j,i), hyrho(k) )
-          ENDIF
-!
-!--       calculate fall speed of graupel
-          vg = av * xg**bv
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Calculate sedimentation rate for each grid box, factors are
-!--       calculated using
-          IF ( qg(k,j,i) > eps_sb  .AND.  ng(k,j,i) >= 0.0_wp )  THEN
-             sed_qg(k) = qg(k,j,i) * vg * factor_sed_gamma_q * flag
-             sed_ng(k) = ng(k,j,i) * vg * factor_sed_gamma_n * flag
-          ELSE
-             sed_qg(k) = 0.0_wp
-             sed_ng(k) = 0.0_wp
-          ENDIF
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          sed_qg(k) = MIN( sed_qg(k), hyrho(k) * dzu(k+1) * qg(k,j,i) / dt_micro + sed_qg(k+1)     &
-                         ) * flag
-
-          q(k,j,i)  = q(k,j,i)  + ( sed_qg(k+1) - sed_qg(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          qg(k,j,i) = qg(k,j,i) + ( sed_qg(k+1) - sed_qg(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          ng(k,j,i) = ng(k,j,i) + ( sed_ng(k+1) - sed_ng(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          pt(k,j,i) = pt(k,j,i) - ( sed_qg(k+1) - sed_qg(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * l_s / c_p * d_exner(k) * dt_micro * flag
-!
-!--       Compute the precipitation rate of graupel
-          IF ( call_microphysics_at_all_substeps )  THEN
-             prr(k,j,i) = prr(k,j,i) + sed_qg(k) / hyrho(k) *                                      &
-                          weight_substep(intermediate_timestep_count) * flag
-          ELSE
-             prr(k,j,i) = prr(k,j,i) + sed_qg(k) / hyrho(k) * flag
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE sedimentation_graupel_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sedimentation of snow assuming generalized gamma distibution (Seifert and Beheng, 2006)
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE sedimentation_snow
-
-       INTEGER(iwp) ::  i             !<
-       INTEGER(iwp) ::  j             !<
-       INTEGER(iwp) ::  k             !<
-
-       REAL(wp) ::  av = 27.7_wp   !< parameter for calculating fall speed
-       REAL(wp) ::  bv = 0.22_wp   !< constant in fall speed relation
-       REAL(wp) ::  factor_sed_gamma_n = 0.89_wp !< corresponds to Âµ=1/3 and v=1 for gamma distribution
-       REAL(wp) ::  factor_sed_gamma_q = 1.17_wp !< corresponds to Âµ=1/3 and v=1 for gamma distribution
-       REAL(wp) ::  flag           !< flag to indicate first grid level
-       REAL(wp) ::  xs = 0.0_wp    !< mean mass of snow
-       REAL(wp) ::  vs = 0.0_wp    !< mean fall speed of snow
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_ns  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qs  !<
-
-       sed_qs(nzt+1) = 0.0_wp
-       sed_ns(nzt+1) = 0.0_wp
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzt, nzb+1, -1
-                IF ( ns(k,j,i) <= 0.0_wp )  THEN
-                   xs = 0.0_wp
-                ELSE
-!--                Calculate mean mass snow
-                   xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-                ENDIF
-!
-!--             calculate fall speed of snow
-                vs = av * xs**bv
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Calculate sedimentation rate for each grid box, factors are
-!--             calculated using
-                IF ( qs(k,j,i) > eps_sb  .AND.  ns(k,j,i) >= 0.0_wp )  THEN
-                   sed_qs(k) = qs(k,j,i) * vs * factor_sed_gamma_q * flag
-                   sed_ns(k) = ns(k,j,i) * vs * factor_sed_gamma_n * flag
-                ELSE
-                   sed_qs(k) = 0.0_wp
-                   sed_ns(k) = 0.0_wp
-                ENDIF
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                sed_qs(k) = MIN( sed_qs(k), hyrho(k) * dzu(k+1) * qs(k,j,i) / dt_micro +           &
-                                 sed_qs(k+1) ) * flag
-
-                q(k,j,i)  = q(k,j,i)  + ( sed_qs(k+1) - sed_qs(k) ) * ddzu(k+1) /                  &
-                                      hyrho(k) * dt_micro * flag
-                qs(k,j,i) = qs(k,j,i) + ( sed_qs(k+1) - sed_qs(k) ) * ddzu(k+1) /                  &
-                                      hyrho(k) * dt_micro * flag
-                ns(k,j,i) = ns(k,j,i) + ( sed_ns(k+1) - sed_ns(k) ) * ddzu(k+1) /                  &
-                                      hyrho(k) * dt_micro * flag
-                pt(k,j,i) = pt(k,j,i) - ( sed_qs(k+1) - sed_qs(k) ) * ddzu(k+1) /                  &
-                                      hyrho(k) * l_s / c_p * d_exner(k) * dt_micro * flag
-!
-!--             Compute the precipitation rate of snow
-                IF ( call_microphysics_at_all_substeps )  THEN
-                   prr(k,j,i) = prr(k,j,i) + sed_qs(k) / hyrho(k) *                                &
-                                weight_substep(intermediate_timestep_count) * flag
-                ELSE
-                   prr(k,j,i) = prr(k,j,i) + sed_qs(k) / hyrho(k) * flag
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE sedimentation_snow
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sedimentation of snow assuming generalized gamma distibution (Seifert and Beheng, 2006)
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE sedimentation_snow_ij( i, j )
-
-       INTEGER(iwp) ::  i             !<
-       INTEGER(iwp) ::  j             !<
-       INTEGER(iwp) ::  k             !<
-
-       REAL(wp) ::  av = 27.7_wp   !< parameter for calculating fall speed
-       REAL(wp) ::  bv = 0.22_wp   !< constant in fall speed relation
-       REAL(wp) ::  factor_sed_gamma_n = 0.89_wp !< corresponds to Âµ=1/3 and v=1 for gamma distribution
-       REAL(wp) ::  factor_sed_gamma_q = 1.17_wp !< corresponds to Âµ=1/3 and v=1 for gamma distribution
-       REAL(wp) ::  flag           !< flag to indicate first grid level
-       REAL(wp) ::  xs = 0.0_wp    !< mean mass of snow
-       REAL(wp) ::  vs = 0.0_wp    !< mean fall speed of snow
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_ns  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qs  !<
-
-       sed_qs(nzt+1) = 0.0_wp
-       sed_ns(nzt+1) = 0.0_wp
-
-       DO  k = nzt, nzb+1, -1
-          IF ( ns(k,j,i) <= 0.0_wp )  THEN
-             xs = 0.0_wp
-          ELSE
-!--          Calculate mean mass of ice crystal
-             xs = mean_mass( cloud_species%snow, qs(k,j,i), ns(k,j,i), hyrho(k) )
-          ENDIF
-!
-!--       calculate fall speed of ice crystal
-          vs = av * xs**bv
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Calculate sedimentation rate for each grid box, factors are
-!--       calculated using
-          IF ( qs(k,j,i) > eps_sb  .AND.  ns(k,j,i) > 0.0_wp )  THEN
-             sed_qs(k) = qs(k,j,i) * vs * factor_sed_gamma_q * flag
-             sed_ns(k) = ns(k,j,i) * vs * factor_sed_gamma_n * flag
-          ELSE
-             sed_qs(k) = 0.0_wp
-             sed_ns(k) = 0.0_wp
-          ENDIF
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          sed_qs(k) = MIN( sed_qs(k), hyrho(k) * dzu(k+1) * qs(k,j,i) / dt_micro + sed_qs(k+1)     &
-                         ) * flag
-
-          q(k,j,i)  = q(k,j,i)  + ( sed_qs(k+1) - sed_qs(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          qs(k,j,i) = qs(k,j,i) + ( sed_qs(k+1) - sed_qs(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          ns(k,j,i) = ns(k,j,i) + ( sed_ns(k+1) - sed_ns(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          pt(k,j,i) = pt(k,j,i) - ( sed_qs(k+1) - sed_qs(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * l_s / c_p * d_exner(k) * dt_micro * flag
-!
-!--       Compute the precipitation rate of cloud (fog) droplets
-          IF ( call_microphysics_at_all_substeps )  THEN
-             prr(k,j,i) = prr(k,j,i) + sed_qs(k) / hyrho(k) *                                      &
-                          weight_substep(intermediate_timestep_count) * flag
-          ELSE
-             prr(k,j,i) = prr(k,j,i) + sed_qs(k) / hyrho(k) * flag
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE sedimentation_snow_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computation of sedimentation flux. Implementation according to Stevens
-!> and Seifert (2008). Code is based on UCLA-LES.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE sedimentation_rain
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i             !< loop index
-       INTEGER(iwp) ::  j             !< loop index
-       INTEGER(iwp) ::  k             !< loop index
-       INTEGER(iwp) ::  k_run         !<
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
-
-       REAL(wp)     ::  c_run                      !<
-       REAL(wp)     ::  d_max                      !<
-       REAL(wp)     ::  d_mean                     !<
-       REAL(wp)     ::  d_min                      !<
-       REAL(wp)     ::  dr                         !<
-       REAL(wp)     ::  flux                       !<
-       REAL(wp)     ::  flag                       !< flag to mask topography grid points
-       REAL(wp)     ::  lambda_r                   !<
-       REAL(wp)     ::  mu_r                       !<
-       REAL(wp)     ::  z_run                      !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  c_nr     !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  c_qr     !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  nr_slope !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  qr_slope !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_nr   !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qr   !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  w_nr     !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  w_qr     !<
-!
-!--    Compute velocities
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                !IF ( qr(k,j,i) > eps_sb  .AND.  nr(k,j,i) > 0.0_wp )  THEN
-                IF ( qr(k,j,i) > eps_sb )  THEN
-
-!
-!--                Weight averaged diameter of rain drops:
-                   dr = ( hyrho(k) * qr(k,j,i) / nr(k,j,i) * dpirho_l )**( 1.0_wp / 3.0_wp )
-!
-!--                Shape parameter of gamma distribution (Milbrandt and Yau, 2005;
-!--                Stevens and Seifert, 2008):
-                   mu_r = 10.0_wp * ( 1.0_wp + TANH( 1.2E3_wp * ( dr - 1.4E-3_wp ) ) )
-!
-!--                Slope parameter of gamma distribution (Seifert, 2008):
-                   lambda_r = ( ( mu_r + 3.0_wp ) * ( mu_r + 2.0_wp ) *                            &
-                                ( mu_r + 1.0_wp ) )**( 1.0_wp / 3.0_wp ) / dr
-
-                   w_nr(k) = MAX( 0.1_wp, MIN( 20.0_wp,                                            &
-                                               a_term - b_term * ( 1.0_wp +                        &
-                                                  c_term /                                         &
-                                                  lambda_r )**( -1.0_wp *                          &
-                                                  ( mu_r + 1.0_wp ) )                              &
-                                              )                                                    &
-                                ) * flag
-
-                   w_qr(k) = MAX( 0.1_wp, MIN( 20.0_wp,                                            &
-                                               a_term - b_term * ( 1.0_wp +                        &
-                                                  c_term /                                         &
-                                                  lambda_r )**( -1.0_wp *                          &
-                                                  ( mu_r + 4.0_wp ) )                              &
-                                             )                                                     &
-                                ) * flag
-                ELSE
-                   w_nr(k) = 0.0_wp
-                   w_qr(k) = 0.0_wp
-                ENDIF
-             ENDDO
-!
-!--          Adjust boundary values using surface data type.
-!--          Upward-facing
-             surf_s = bc_h(0)%start_index(j,i)
-             surf_e = bc_h(0)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k         = bc_h(0)%k(m)
-                w_nr(k-1) = w_nr(k)
-                w_qr(k-1) = w_qr(k)
-             ENDDO
-!
-!--          Downward-facing
-             surf_s = bc_h(1)%start_index(j,i)
-             surf_e = bc_h(1)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k         = bc_h(1)%k(m)
-                w_nr(k+1) = w_nr(k)
-                w_qr(k+1) = w_qr(k)
-             ENDDO
-!
-!--          Model top boundary value
-             w_nr(nzt+1) = 0.0_wp
-             w_qr(nzt+1) = 0.0_wp
-!
-!--          Compute Courant number
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                c_nr(k) = 0.25_wp * ( w_nr(k-1) + 2.0_wp * w_nr(k) + w_nr(k+1) ) *                 &
-                          dt_micro * ddzu(k) * flag
-                c_qr(k) = 0.25_wp * ( w_qr(k-1) + 2.0_wp * w_qr(k) + w_qr(k+1) ) *                 &
-                          dt_micro * ddzu(k) * flag
-             ENDDO
-!
-!--          Limit slopes with monotonized centered (MC) limiter (van Leer, 1977):
-             IF ( limiter_sedimentation )  THEN
-
-                DO k = nzb+1, nzt
-!
-!--                Predetermine flag to mask topography
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                   d_mean = 0.5_wp * ( qr(k+1,j,i) - qr(k-1,j,i) )
-                   d_min  = qr(k,j,i) - MIN( qr(k+1,j,i), qr(k,j,i), qr(k-1,j,i) )
-                   d_max  = MAX( qr(k+1,j,i), qr(k,j,i), qr(k-1,j,i) ) - qr(k,j,i)
-
-                   qr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0_wp * d_min, 2.0_wp * d_max,      &
-                                                              ABS( d_mean ) )                      &
-                                                      * flag
-
-                   d_mean = 0.5_wp * ( nr(k+1,j,i) - nr(k-1,j,i) )
-                   d_min  = nr(k,j,i) - MIN( nr(k+1,j,i), nr(k,j,i), nr(k-1,j,i) )
-                   d_max  = MAX( nr(k+1,j,i), nr(k,j,i), nr(k-1,j,i) ) - nr(k,j,i)
-
-                   nr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0_wp * d_min, 2.0_wp * d_max,      &
-                                                              ABS( d_mean ) )
-                ENDDO
-
-             ELSE
-
-                nr_slope = 0.0_wp
-                qr_slope = 0.0_wp
-
-             ENDIF
-
-             sed_nr(nzt+1) = 0.0_wp
-             sed_qr(nzt+1) = 0.0_wp
-!
-!--          Compute sedimentation flux
-             DO  k = nzt, nzb+1, -1
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Sum up all rain drop number densities which contribute to the flux
-!--             through k-1/2
-                flux  = 0.0_wp
-                z_run = 0.0_wp ! height above z(k)
-                k_run = k
-                c_run = MIN( 1.0_wp, c_nr(k) )
-                DO WHILE ( c_run > 0.0_wp  .AND.  k_run <= nzt )
-                   flux  = flux + hyrho(k_run) * ( nr(k_run,j,i) + nr_slope(k_run) *               &
-                           ( 1.0_wp - c_run ) * 0.5_wp ) * c_run * dzu(k_run) * flag
-                   z_run = z_run + dzu(k_run) * flag
-                   k_run = k_run + 1          * flag
-                   c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) )   * flag
-                ENDDO
-!
-!--             It is not allowed to sediment more rain drop number density than available.
-                flux = MIN( flux, hyrho(k) * dzu(k+1) * nr(k,j,i) + sed_nr(k+1) * dt_micro )
-
-                sed_nr(k) = flux / dt_micro * flag
-                nr(k,j,i) = nr(k,j,i) + ( sed_nr(k+1) - sed_nr(k) ) *                              &
-                                        ddzu(k+1) / hyrho(k) * dt_micro * flag
-!
-!--             Sum up all rain water content which contributes to the flux through k-1/2
-                flux  = 0.0_wp
-                z_run = 0.0_wp ! height above z(k)
-                k_run = k
-                c_run = MIN( 1.0_wp, c_qr(k) )
-
-                DO WHILE ( c_run > 0.0_wp  .AND.  k_run <= nzt )
-
-                   flux  = flux + hyrho(k_run) * ( qr(k_run,j,i) +                                 &
-                                  qr_slope(k_run) * ( 1.0_wp - c_run ) *                           &
-                                  0.5_wp ) * c_run * dzu(k_run) * flag
-                   z_run = z_run + dzu(k_run)                   * flag
-                   k_run = k_run + 1                            * flag
-                   c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) )                        &
-                                                                * flag
-
-                ENDDO
-!
-!--             It is not allowed to sediment more rain water content than available.
-                flux = MIN( flux, hyrho(k) * dzu(k) * qr(k,j,i) + sed_qr(k+1) * dt_micro )
-
-                sed_qr(k) = flux / dt_micro * flag
-
-                qr(k,j,i) = qr(k,j,i) + ( sed_qr(k+1) - sed_qr(k) ) *                              &
-                                        ddzu(k+1) / hyrho(k) * dt_micro * flag
-                q(k,j,i)  = q(k,j,i)  + ( sed_qr(k+1) - sed_qr(k) ) *                              &
-                                        ddzu(k+1) / hyrho(k) * dt_micro * flag
-                pt(k,j,i) = pt(k,j,i) - ( sed_qr(k+1) - sed_qr(k) ) *                              &
-                                        ddzu(k+1) / hyrho(k) * lv_d_cp *                           &
-                                        d_exner(k) * dt_micro            * flag
-!
-!--             Compute the rain rate
-                IF ( call_microphysics_at_all_substeps )  THEN
-                   prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k)                                  &
-                                * weight_substep(intermediate_timestep_count) * flag
-                ELSE
-                   prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k) * flag
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE sedimentation_rain
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computation of sedimentation flux. Implementation according to Stevens
-!> and Seifert (2008). Code is based on UCLA-LES. Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE sedimentation_rain_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i             !< loop index
-       INTEGER(iwp) ::  j             !< loop index
-       INTEGER(iwp) ::  k             !< loop index
-       INTEGER(iwp) ::  k_run         !<
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
-
-       REAL(wp)     ::  c_run                     !<
-       REAL(wp)     ::  d_max                     !<
-       REAL(wp)     ::  d_mean                    !<
-       REAL(wp)     ::  d_min                     !<
-       REAL(wp)     ::  dr                        !<
-       REAL(wp)     ::  flux                      !<
-       REAL(wp)     ::  flag                      !< flag to indicate first grid level above surface
-       REAL(wp)     ::  lambda_r                  !<
-       REAL(wp)     ::  mu_r                      !<
-       REAL(wp)     ::  z_run                     !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  c_nr     !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  c_qr     !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  nr_slope !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  qr_slope !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_nr   !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qr   !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  w_nr     !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  w_qr     !<
-
-!
-!--    Compute velocities
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-!          IF ( qr(k,j,i) > eps_sb  .AND.  nr(k,j,i) > 0.0_wp )  THEN
-           IF ( qr(k,j,i) > eps_sb )  THEN
-
-!
-!--          Weight averaged diameter of rain drops:
-             dr = ( hyrho(k) * qr(k,j,i) / nr(k,j,i) * dpirho_l )**( 1.0_wp / 3.0_wp )
-!
-!--          Shape parameter of gamma distribution (Milbrandt and Yau, 2005;
-!--          Stevens and Seifert, 2008):
-             mu_r = 10.0_wp * ( 1.0_wp + TANH( 1.2E3_wp * ( dr - 1.4E-3_wp ) ) )
-!
-!--          Slope parameter of gamma distribution (Seifert, 2008):
-             lambda_r = ( ( mu_r + 3.0_wp ) * ( mu_r + 2.0_wp ) *                                  &
-                          ( mu_r + 1.0_wp ) )**( 1.0_wp / 3.0_wp ) / dr
-
-             w_nr(k) = MAX( 0.1_wp, MIN( 20.0_wp,                                                  &
-                                         a_term - b_term * ( 1.0_wp + c_term / lambda_r            &
-                                                           )**( -1.0_wp * ( mu_r + 1.0_wp ) )      &
-                                       )                                                           &
-                          ) * flag
-             w_qr(k) = MAX( 0.1_wp, MIN( 20.0_wp,                                                  &
-                                         a_term - b_term * ( 1.0_wp + c_term / lambda_r            &
-                                                           )**( -1.0_wp * ( mu_r + 4.0_wp ) )      &
-                                       )                                                           &
-                          ) * flag
-          ELSE
-             w_nr(k) = 0.0_wp
-             w_qr(k) = 0.0_wp
-          ENDIF
-       ENDDO
-!
-!--    Adjust boundary values using surface data type.
-!--    Upward facing non-natural
-       surf_s = bc_h(0)%start_index(j,i)
-       surf_e = bc_h(0)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k         = bc_h(0)%k(m)
-          w_nr(k-1) = w_nr(k)
-          w_qr(k-1) = w_qr(k)
-       ENDDO
-!
-!--    Downward facing non-natural
-       surf_s = bc_h(1)%start_index(j,i)
-       surf_e = bc_h(1)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k         = bc_h(1)%k(m)
-          w_nr(k+1) = w_nr(k)
-          w_qr(k+1) = w_qr(k)
-       ENDDO
-!
-!--    Neumann boundary condition at model top
-       w_nr(nzt+1) = 0.0_wp
-       w_qr(nzt+1) = 0.0_wp
-!
-!--    Compute Courant number
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          c_nr(k) = 0.25_wp * ( w_nr(k-1) + 2.0_wp * w_nr(k) + w_nr(k+1) ) *                       &
-                    dt_micro * ddzu(k) * flag
-          c_qr(k) = 0.25_wp * ( w_qr(k-1) + 2.0_wp * w_qr(k) + w_qr(k+1) ) *                       &
-                    dt_micro * ddzu(k) * flag
-       ENDDO
-!
-!--    Limit slopes with monotonized centered (MC) limiter (van Leer, 1977):
-       IF ( limiter_sedimentation )  THEN
-
-          DO k = nzb+1, nzt
-!
-!--          Predetermine flag to mask topography
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-             d_mean = 0.5_wp * ( qr(k+1,j,i) - qr(k-1,j,i) )
-             d_min  = qr(k,j,i) - MIN( qr(k+1,j,i), qr(k,j,i), qr(k-1,j,i) )
-             d_max  = MAX( qr(k+1,j,i), qr(k,j,i), qr(k-1,j,i) ) - qr(k,j,i)
-
-             qr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0_wp * d_min, 2.0_wp * d_max,            &
-                                                        ABS( d_mean ) ) * flag
-
-             d_mean = 0.5_wp * ( nr(k+1,j,i) - nr(k-1,j,i) )
-             d_min  = nr(k,j,i) - MIN( nr(k+1,j,i), nr(k,j,i), nr(k-1,j,i) )
-             d_max  = MAX( nr(k+1,j,i), nr(k,j,i), nr(k-1,j,i) ) - nr(k,j,i)
-
-             nr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0_wp * d_min,  2.0_wp * d_max,           &
-                                                        ABS( d_mean ) ) * flag
-          ENDDO
-
-       ELSE
-
-          nr_slope = 0.0_wp
-          qr_slope = 0.0_wp
-
-       ENDIF
-
-       sed_nr(nzt+1) = 0.0_wp
-       sed_qr(nzt+1) = 0.0_wp
-!
-!--    Compute sedimentation flux
-       DO  k = nzt, nzb+1, -1
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Sum up all rain drop number densities which contribute to the flux through k-1/2
-          flux  = 0.0_wp
-          z_run = 0.0_wp ! height above z(k)
-          k_run = k
-          c_run = MIN( 1.0_wp, c_nr(k) )
-          DO WHILE ( c_run > 0.0_wp  .AND.  k_run <= nzt )
-             flux  = flux + hyrho(k_run) *                                                         &
-                     ( nr(k_run,j,i) + nr_slope(k_run) * ( 1.0_wp - c_run ) * 0.5_wp ) *           &
-                       c_run *  dzu(k_run)         * flag
-             z_run = z_run + dzu(k_run)            * flag
-             k_run = k_run + 1                     * flag
-             c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) ) * flag
-          ENDDO
-!
-!--       It is not allowed to sediment more rain drop number density than available.
-          flux = MIN( flux, hyrho(k) * dzu(k+1) * nr(k,j,i) + sed_nr(k+1) * dt_micro )
-
-          sed_nr(k) = flux / dt_micro * flag
-          nr(k,j,i)  = nr(k,j,i) + ( sed_nr(k+1) - sed_nr(k) ) * ddzu(k+1) /                       &
-                                    hyrho(k) * dt_micro * flag
-!
-!--       Sum up all rain water content which contributes to the flux
-!--       through k-1/2
-          flux  = 0.0_wp
-          z_run = 0.0_wp ! height above z(k)
-          k_run = k
-          c_run = MIN( 1.0_wp, c_qr(k) )
-
-          DO WHILE ( c_run > 0.0_wp  .AND.  k_run <= nzt )
-
-             flux  = flux + hyrho(k_run) *                                                         &
-                     ( qr(k_run,j,i) + qr_slope(k_run) * ( 1.0_wp - c_run ) * 0.5_wp ) *           &
-                       c_run * dzu(k_run)          * flag
-             z_run = z_run + dzu(k_run)            * flag
-             k_run = k_run + 1                     * flag
-             c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) ) * flag
-
-          ENDDO
-!
-!--       It is not allowed to sediment more rain water content than available.
-          flux = MIN( flux, hyrho(k) * dzu(k) * qr(k,j,i) + sed_qr(k+1) * dt_micro )
-
-          sed_qr(k) = flux / dt_micro * flag
-
-          qr(k,j,i) = qr(k,j,i) + ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          q(k,j,i)  = q(k,j,i)  + ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * dt_micro * flag
-          pt(k,j,i) = pt(k,j,i) - ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) /                        &
-                                hyrho(k) * lv_d_cp * d_exner(k) * dt_micro * flag
-!
-!--       Compute the rain rate
-          IF ( call_microphysics_at_all_substeps )  THEN
-             prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k)                                        &
-                          * weight_substep(intermediate_timestep_count) * flag
-          ELSE
-             prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k) * flag
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE sedimentation_rain_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computation of the precipitation amount due to gravitational settling of rain and cloud (fog)
-!> droplets
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE calc_precipitation_amount
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i             !< loop index
-       INTEGER(iwp) ::  j             !< loop index
-       INTEGER(iwp) ::  k             !< loop index
-       INTEGER(iwp) ::  m             !< running index surface elements
-
-       IF ( ( dt_do2d_xy - time_do2d_xy ) < precipitation_amount_interval .AND.                    &
-            ( .NOT. call_microphysics_at_all_substeps .OR.                                         &
-            intermediate_timestep_count == intermediate_timestep_count_max ) )                     &
-       THEN
-!
-!--       Run over all upward-facing surface elements, i.e. non-natural, natural and urban
-          DO  m = 1, bc_h(0)%ns
-             i = bc_h(0)%i(m)
-             j = bc_h(0)%j(m)
-             k = bc_h(0)%k(m)
-             precipitation_amount(j,i) = precipitation_amount(j,i) + prr(k,j,i) * hyrho(k) * dt_3d
-          ENDDO
-
-       ENDIF
-
-    END SUBROUTINE calc_precipitation_amount
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine computes the precipitation amount due to gravitational settling of rain and cloud
-!> (fog) droplets
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE calc_precipitation_amount_ij( i, j )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i             !< loop index
-       INTEGER(iwp) ::  j             !< loop index
-       INTEGER(iwp) ::  k             !< loop index
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
-
-       IF ( ( dt_do2d_xy - time_do2d_xy ) < precipitation_amount_interval .AND.                    &
-            ( .NOT. call_microphysics_at_all_substeps .OR.                                         &
-            intermediate_timestep_count == intermediate_timestep_count_max ) )                     &
-       THEN
-
-          surf_s = bc_h(0)%start_index(j,i)
-          surf_e = bc_h(0)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k                         = bc_h(0)%k(m)
-             precipitation_amount(j,i) = precipitation_amount(j,i) + prr(k,j,i) * hyrho(k) * dt_3d
-          ENDDO
-
-       ENDIF
-
-    END SUBROUTINE calc_precipitation_amount_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computation of the diagnostic supersaturation sat, actual liquid water temperature t_l and
-!> saturation water vapor mixing ratio q_s
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE supersaturation ( i, j, k )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i   !< loop index
-       INTEGER(iwp) ::  j   !< loop index
-       INTEGER(iwp) ::  k   !< loop index
-
-       REAL(wp) ::  alpha   !< correction factor
-!
-!--    Actual liquid water temperature:
-       t_l = exner(k) * pt(k,j,i)
-!
-!--    Calculate water vapor saturation pressure
-       e_s = magnus_tl( t_l )
-!
-!--    Computation of saturation mixing ratio:
-       q_s   = rd_d_rv * e_s / ( hyp(k) - e_s )
-!
-!--    Correction factor
-       alpha = rd_d_rv * lv_d_rd * lv_d_cp / ( t_l * t_l )
-!
-!--    Correction of the approximated value (see: Cuijpers + Duynkerke, 1993, JAS, 23)
-       q_s   = q_s * ( 1.0_wp + alpha * q(k,j,i) ) / ( 1.0_wp + alpha * q_s )
-!
-!--    Only liquid phase
-       IF ( .NOT. microphysics_ice_phase )  THEN
-          IF ( microphysics_seifert )  THEN
-             sat = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp
-          ELSEIF ( microphysics_morrison_no_rain )  THEN
-             sat = ( q(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp
-          ENDIF
-!
-!--    ice phase
-       ELSE
-          IF ( microphysics_seifert .AND.  .NOT. graupel  .OR.  .NOT. snow )  THEN
-             sat = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) - qi(k,j,i) ) / q_s - 1.0_wp
-!
-!--       IF snow and graupel is also turned on
-          ELSE
-             sat = ( q(k,j,i) - qc(k,j,i) - qr(k,j,i) - qi(k,j,i) - qs(k,j,i) - qg(k,j,i) ) / &
-                   q_s - 1.0_wp
-          ENDIF
-       ENDIF
-
-    END SUBROUTINE supersaturation
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computation of the diagnostic supersaturation sat, actual liquid water temperature t_l and
-!> saturation water vapor mixing ratio q_s
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE supersaturation_ice ( i, j, k )
-
-       INTEGER(iwp) ::  i   !< loop index
-       INTEGER(iwp) ::  j   !< loop index
-       INTEGER(iwp) ::  k   !< loop index
-
-       REAL(wp) ::  e_a     !< water vapor pressure
-       REAL(wp) ::  temp    !< actual temperature
-
-!
-!--    Actual liquid water temperature:
-       t_l = exner(k) * pt(k,j,i)
-!
-!--    Actual temperature:
-       temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qf(k,j,i)
-!
-!--    Calculate water vapor saturation pressure with formular using actual temperature
-       e_si = magnus_ice( temp )
-!
-!--    Computation of ice saturation mixing ratio:
-       q_si = rd_d_rv * e_si / ( hyp(k) - e_si )
-!
-!--    Current vapor pressure
-       IF ( .NOT. snow  .AND.  .NOT. graupel )  THEN
-          e_a = (   q(k,j,i) - qr(k,j,i) - qc(k,j,i) - qi(k,j,i) ) * hyp(k) /                      &
-                ( ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) - qi(k,j,i) ) + rd_d_rv )
-       ELSE
-          e_a = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) - qi(k,j,i) - qg(k,j,i) - qs(k,j,i) ) * hyp(k) /&
-                ( ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) - qi(k,j,i) - qg(k,j,i) - qs(k,j,i) ) +       &
-                   rd_d_rv )
-       ENDIF
-!
-!--    Supersaturation:
-!--    Not in case of microphysics_kessler or microphysics_sat_adjust since qr is unallocated
-       sat_ice = e_a / e_si - 1.0_wp
-!
-!--    If temperature of ice is over 273.15Â°C set sat_ice <= 0.0
-       IF ( temp > t3  .AND.  sat_ice > 0.0_wp  ) THEN
-          sat_ice = 0.0_wp
-       ENDIF
-
-    END SUBROUTINE supersaturation_ice
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of the liquid water content (0%-or-100%-scheme). This scheme is used by the one and
-!> the two moment cloud physics scheme. Using the two moment scheme, this calculation results in the
-!> cloud water content.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE calc_liquid_water_content
-
-       INTEGER(iwp) ::  i !< loop index
-       INTEGER(iwp) ::  j !< loop index
-       INTEGER(iwp) ::  k !< loop index
-
-       REAL(wp)     ::  flag !< flag to indicate first grid level above surface
-
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Call calculation of supersaturation located
-                CALL supersaturation( i, j, k )
-!
-!--             Compute the liquid water content
-                IF ( .NOT. microphysics_ice_phase ) THEN
-                   IF ( microphysics_seifert  .AND. .NOT. microphysics_morrison )  THEN
-!--                   Seifert and Beheng scheme: saturation adjustment
-                      IF ( ( q(k,j,i) - q_s - qr(k,j,i) ) > 0.0_wp )  THEN
-                         qc(k,j,i) = ( q(k,j,i) - q_s - qr(k,j,i) ) * flag
-                         ql(k,j,i) = ( qc(k,j,i) + qr(k,j,i) ) * flag
-                      ELSE
-                         IF ( q(k,j,i) < qr(k,j,i) )  q(k,j,i) = qr(k,j,i)
-                         qc(k,j,i) = 0.0_wp
-                         ql(k,j,i) = qr(k,j,i) * flag
-                      ENDIF
-!
-!--                Morrison scheme: explicit condensation (see above)
-                   ELSEIF ( microphysics_morrison  .AND.  microphysics_seifert )  THEN
-                      ql(k,j,i) = qc(k,j,i) + qr(k,j,i) * flag
-!
-!--                Morrison without rain: explicit condensation
-                   ELSEIF ( microphysics_morrison  .AND. .NOT. microphysics_seifert )  THEN
-                      ql(k,j,i) = qc(k,j,i)
-!
-!--                Kessler and saturation adjustment scheme
-                   ELSE
-                      IF ( ( q(k,j,i) - q_s ) > 0.0_wp )  THEN
-                         qc(k,j,i) = ( q(k,j,i) - q_s ) * flag
-                         ql(k,j,i) = qc(k,j,i) * flag
-                      ELSE
-                         qc(k,j,i) = 0.0_wp
-                         ql(k,j,i) = 0.0_wp
-                      ENDIF
-                   ENDIF
-!--             Calculations of liquid water content in case of mixed-phase cloud microphyics
-                ELSE
-                   IF ( microphysics_seifert  .AND. .NOT. microphysics_morrison ) &
-                   THEN
-!
-!--                   Seifert and Beheng scheme: saturation adjustment if mixed phase but no snow
-!--                   and graupel
-                      IF ( .NOT. snow  .AND.  .NOT. graupel ) THEN
-                         IF ( ( q(k,j,i) - q_s - qr(k,j,i) - qi(k,j,i) ) > 0.0_wp )  THEN
-                            qc(k,j,i) = ( q(k,j,i) - q_s - qr(k,j,i) - qi(k,j,i) ) * flag
-                            ql(k,j,i) = ( qc(k,j,i) + qr(k,j,i) ) * flag
-                            qf(k,j,i) = qi(k,j,i)
-                         ELSE
-                            IF ( q(k,j,i) < ( qr(k,j,i) + qi(k,j,i) ) )  THEN
-                               q(k,j,i) = qr(k,j,i) + qi(k,j,i)
-                            ENDIF
-                            qc(k,j,i) = 0.0_wp
-                            ql(k,j,i) = qr(k,j,i) * flag
-                            qf(k,j,i) = qi(k,j,i) * flag
-                         ENDIF
-!
-!--                   Seifert and Beheng scheme: saturation adjustment if mixed phase but with snow
-!--                   and graupel. Note: qs = snow mixing ratio, q_s = saturation mixing ratio
-                      ELSE
-                         IF ( ( q(k,j,i) - q_s - qr(k,j,i) - qi(k,j,i) - qs(k,j,i) - qg(k,j,i) )   &
-                                > 0.0_wp )  THEN
-                            qc(k,j,i) = ( q(k,j,i) - q_s - qr(k,j,i) - qi(k,j,i) - qs(k,j,i)       &
-                                                   - qg(k,j,i) ) * flag
-                            ql(k,j,i) = ( qc(k,j,i) + qr(k,j,i) ) * flag
-                            qf(k,j,i) = qi(k,j,i) + qs(k,j,i) + qg(k,j,i)
-                         ELSE
-                            IF ( q(k,j,i) < ( qr(k,j,i) + qi(k,j,i) + qs(k,j,i) + qg(k,j,i) ) )    &
-                            THEN
-                               q(k,j,i) = qr(k,j,i) + qi(k,j,i) + qs(k,j,i) + qg(k,j,i)
-                            ENDIF
-                            qc(k,j,i) = 0.0_wp
-                            ql(k,j,i) = qr(k,j,i) * flag
-                            qf(k,j,i) = qi(k,j,i) + qs(k,j,i) + qg(k,j,i) * flag
-                         ENDIF
-                      ENDIF
-!
-!--                Morrison scheme: explicit condensation (see above)
-                   ELSEIF ( microphysics_morrison  .AND.  microphysics_seifert )  THEN
-                      ql(k,j,i) = qc(k,j,i) + qr(k,j,i) * flag
-                      qf(k,j,i) = qi(k,j,i) + qs(k,j,i) + qg(k,j,i) * flag
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE calc_liquid_water_content
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the gamma function (Press et al., 1992).
-!> The gamma function is needed for the calculation of the evaporation of rain drops.
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION gamm( xx )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  j            !<
-
-       REAL(wp), PARAMETER  ::  stp = 2.5066282746310005_wp               !<
-       REAL(wp), PARAMETER  ::  cof(6) = (/ 76.18009172947146_wp,                                  &
-                                           -86.50532032941677_wp,                                  &
-                                            24.01409824083091_wp,                                  &
-                                            -1.231739572450155_wp,                                 &
-                                             0.1208650973866179E-2_wp,                             &
-                                            -0.5395239384953E-5_wp /)     !<
-
-       REAL(wp)     ::  gamm         !<
-       REAL(wp)     ::  ser          !<
-       REAL(wp)     ::  tmp          !<
-       REAL(wp)     ::  x_gamm       !<
-       REAL(wp)     ::  xx           !<
-       REAL(wp)     ::  y_gamm       !<
-
-
-       x_gamm = xx
-       y_gamm = x_gamm
-       tmp = x_gamm + 5.5_wp
-       tmp = ( x_gamm + 0.5_wp ) * LOG( tmp ) - tmp
-       ser = 1.000000000190015_wp
-
-       DO  j = 1, 6
-          y_gamm = y_gamm + 1.0_wp
-          ser    = ser + cof( j ) / y_gamm
-       ENDDO
-
-!
-!--    Until this point the algorithm computes the logarithm of the gamma function. Hence, the
-!--    exponential function is used.
-!      gamm = EXP( tmp + LOG( stp * ser / x_gamm ) )
-       gamm = EXP( tmp ) * stp * ser / x_gamm
-
-       RETURN
-
-    END FUNCTION gamm
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the complete mass moment of particle size distribution, Eq (82) of SB2006
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION moment_gamma(specie, n)
-
-       INTEGER, INTENT(in) ::  n                         !<
-       CLASS(cloud_coefficients), INTENT(IN) ::  specie  !<
-       REAL(wp) ::  moment_gamma                         !<
-
-       moment_gamma = GAMMA( ( n + specie%nu + 1.0_wp ) / specie%mu ) /                            &
-                      GAMMA( ( specie%nu + 1.0_wp ) / specie%mu )     *                            &
-                    ( GAMMA( ( specie%nu + 1.0_wp ) / specie%mu )     /                            &
-                      GAMMA( ( specie%nu + 2.0_wp ) / specie%mu )                                  &
-                    )**n
-
-  END FUNCTION moment_gamma
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the collision integrals as given in SB2006, EQ.90
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION collision_integral_delta_b(specie, n)
-
-       INTEGER(iwp), INTENT(IN) :: n
-       CLASS(cloud_coefficients), INTENT(IN) :: specie
-       REAL(wp) ::  collision_integral_delta_b
-!
-!--    Eq. 90 from SB2006
-       collision_integral_delta_b = GAMMA( ( 2.0_wp * specie%b + specie%nu + 1.0_wp + n ) /         &
-                                             specie%mu ) /                                          &
-                            GAMMA( ( specie%nu + 1.0_wp ) / specie%mu ) *                           &
-                            GAMMA( ( specie%nu + 1.0_wp ) / specie%mu )**(2.0_wp * specie%b + n ) / &
-                            GAMMA( ( specie%nu + 2.0_wp ) / specie%mu )**(2.0_wp * specie%b + n)
-       RETURN
-
-     END FUNCTION collision_integral_delta_b
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the collision integrals as given in SB2006, EQ.91
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION collision_integral_delta_ba(specie1, specie2, n)
-
-       INTEGER(iwp), INTENT(IN) :: n
-       CLASS(cloud_coefficients), INTENT(IN) :: specie1
-       CLASS(cloud_coefficients), INTENT(IN) :: specie2
-       REAL(wp) ::  collision_integral_delta_ba
-!
-!--    Eq. 91 from SB2006
-       collision_integral_delta_ba = 2.0_wp *                                                      &
-            GAMMA( ( specie1%b + specie1%nu + 1.0_wp ) / specie1%mu ) /                            &
-            GAMMA( ( specie1%nu + 1.0_wp ) / specie1%mu )              *                           &
-            GAMMA( ( specie1%nu + 1.0_wp ) / specie1%mu )**(specie1%b) /                           &
-            GAMMA( ( specie1%nu + 2.0_wp ) / specie1%mu )**(specie1%b) *                           &
-            GAMMA( ( specie2%b + specie2%nu + 1.0_wp + n ) / specie2%mu ) /                        &
-            GAMMA( ( specie2%nu + 1.0_wp ) / specie2%mu )  *                                       &
-            GAMMA( ( specie2%nu + 1.0_wp ) / specie2%mu )**( specie2%b + n ) /                     &
-            GAMMA( ( specie2%nu + 2.0_wp ) / specie2%mu )**( specie2%b + n )
-       RETURN
-
-     END FUNCTION collision_integral_delta_ba
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the collision integrals as given in SB2006, EQ.92
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION collision_integral_theta_b(specie, n)
-
-       INTEGER(iwp), INTENT(IN) :: n
-       CLASS(cloud_coefficients), INTENT(IN) :: specie
-       REAL(wp) ::  collision_integral_theta_b
-!
-!--    Eq. 92 from SB2006
-       collision_integral_theta_b = &
-                  GAMMA( ( 2.0_wp * specie%beta + 2.0_wp * specie%b + specie%nu + 1.0_wp + n ) /   &
-                          specie%mu ) /                                                            &
-                  GAMMA( ( 2.0_wp * specie%b + specie%nu + 1.0_wp + n) / specie%mu) *              &
-                  GAMMA( ( specie%nu + 1.0_wp ) / specie%mu)**( 2.0_wp * specie%beta ) /           &
-                  GAMMA( ( specie%nu + 2.0_wp ) / specie%mu)**( 2.0_wp * specie%beta )
-       RETURN
-
-    END FUNCTION collision_integral_theta_b
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the collision integrals as given in SB2006, EQ.93
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION collision_integral_theta_ba(specie1, specie2, n)
-
-       INTEGER(iwp), INTENT(IN) :: n
-       CLASS(cloud_coefficients), INTENT(IN) :: specie1
-       CLASS(cloud_coefficients), INTENT(IN) :: specie2
-       REAL(wp) ::  collision_integral_theta_ba
-!
-!--    Eq. 93 from SB2006
-       collision_integral_theta_ba = 2.0_wp *                                                      &
-          GAMMA( ( specie1%beta + 2.0_wp * specie1%b + specie1%nu + 1.0_wp ) / specie1%mu ) /      &
-          GAMMA( ( 2.0_wp * specie1%b + specie1%nu + 1.0_wp ) / specie1%mu ) *                     &
-          GAMMA( ( specie1%nu + 1.0_wp ) / specie1%mu )**(specie1%beta) /                          &
-          GAMMA( ( specie1%nu + 2.0_wp ) / specie1%mu )**(specie1%beta) *                          &
-          GAMMA( ( specie2%beta + 2.0_wp * specie2%b + specie2%nu + 1.0_wp + n ) / specie2%mu ) /  &
-          GAMMA( ( 2.0_wp * specie2%b + specie2%nu + 1.0_wp + n ) / specie2%mu ) *                 &
-          GAMMA( ( specie2%nu + 1.0_wp ) / specie2%mu )**(specie2%beta) /                          &
-          GAMMA( ( specie2%nu + 2.0_wp ) / specie2%mu )**(specie2%beta)
-       RETURN
-
-    END FUNCTION collision_integral_theta_ba
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the bulk ventilation coefficient as in Eq. 88 of SB2006
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION ventilation_coeff_a( specie, n )
-
-       REAL(wp) ::  ventilation_coeff_a  !<
-       INTEGER, INTENT(IN) ::  n         !<
-       CLASS(cloud_coefficients), INTENT(IN) :: specie  !<
-
-       ventilation_coeff_a = specie%a_ven * GAMMA( ( specie%nu + n + specie%b ) / specie%mu ) /    &
-                                            GAMMA((specie%nu + 1.0_wp ) / specie%mu )         *    &
-                                          ( GAMMA((specie%nu + 1.0_wp ) / specie%mu )         /    &
-                                            GAMMA((specie%nu + 2.0_wp ) / specie%mu )              &
-                                          )**( specie%b + n - 1.0_wp)
-       RETURN
-
-    END FUNCTION ventilation_coeff_a
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the bulk ventilation coefficient as in Eq. 89 of SB2006
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION ventilation_coeff_b( specie, n )
-
-       REAL(wp) ::  ventilation_coeff_b !<
-       INTEGER, INTENT(IN) ::  n        !<
-       CLASS(cloud_coefficients), INTENT(IN) :: specie  !<
-
-       REAL(wp), PARAMETER :: m_f = 0.500 ! see PK, S.541.
-
-       ventilation_coeff_b = specie%b_ven *                                                        &
-            GAMMA( ( specie%nu + n + ( m_f + 1.0_wp ) * specie%b + m_f * specie%beta ) /           &
-                     specie%mu ) /                                                                 &
-            GAMMA( ( specie%nu + 1.0_wp ) / specie%mu ) *                                          &
-          ( GAMMA( ( specie%nu + 1.0_wp ) / specie%mu ) /                                          &
-            GAMMA( ( specie%nu + 2.0_wp ) / specie%mu )                                            &
-          )**( ( m_f + 1.0_wp ) * specie%b + m_f * specie%beta + n - 1.0_wp )
-
-       RETURN
-
-    END FUNCTION ventilation_coeff_b
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function gernerically computes the mean mass of specie and limit it to allowed masses from
-!> scheme. A very small number of particles is added to ensure that it will not devided by zero.
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION mean_mass( specie, mixing_ratio, number_concentration, rho_env )
-
-       CLASS(cloud_coefficients), INTENT(IN) :: specie              !<
-       REAL(wp), INTENT(IN) ::  mixing_ratio                        !<
-       REAL(wp), INTENT(IN) ::  number_concentration                !<
-       REAL(wp), INTENT(IN) ::  rho_env                             !<
-       REAL(wp) ::  mean_mass                                       !<
-
-       mean_mass = MIN( MAX( (rho_env * mixing_ratio / ( number_concentration + eps_sb_n ) ),      &
-                            specie%x_min ), specie%x_max )
-       RETURN
-
-    END FUNCTION mean_mass
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the terminal fall velocity as in SB2006 Eq. 28
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION terminal_fall_velocity( specie, particle_mean_mass, rho_env )
-
-       CLASS(cloud_coefficients), INTENT(IN) :: specie              !<
-       REAL(wp), INTENT(IN) ::  particle_mean_mass                  !<
-       REAL(wp), INTENT(IN) ::  rho_env                             !<
-       REAL(wp) ::  terminal_fall_velocity                          !<
-
-       terminal_fall_velocity = specie%alpha * particle_mean_mass**specie%beta *                   &
-                                ( rho_0 / rho_env )**0.5
-
-       RETURN
-
-    END FUNCTION terminal_fall_velocity
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This function computes the mean diameter of the cloud specie as in SB2006 Eq. 32
-!--------------------------------------------------------------------------------------------------!
-    FUNCTION mean_diameter( specie, particle_mean_mass )
-
-       CLASS(cloud_coefficients), INTENT(IN) ::  specie             !<
-       REAL(wp), INTENT(IN) ::  particle_mean_mass                  !<
-       REAL(wp) ::  mean_diameter                                   !<
-
-       mean_diameter = specie%a * particle_mean_mass**specie%b
-       RETURN
-
-    END FUNCTION mean_diameter
-
-
- END MODULE bulk_cloud_model_mod
Index: palm/trunk/SOURCE/buoyancy.f90
===================================================================
--- palm/trunk/SOURCE/buoyancy.f90	(revision 4901)
+++ palm/trunk/SOURCE/buoyancy.f90	(revision 1)
@@ -1,38 +1,73 @@
-!> @file buoyancy.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
+ MODULE buoyancy_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3725 2019-02-07 10:11:02Z raasch
-! unused variables removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! nopointer option removed
+! $Log: buoyancy.f90,v $
+! Revision 1.19  2006/04/26 12:09:56  raasch
+! OpenMP optimization (one dimension added to sums_l)
+!
+! Revision 1.18  2006/02/23 09:55:33  raasch
+! nzb_2d replaced by nzb_s_inner/outer, nanz_2dh(0) replaced by
+! ngp_2dh_outer(:,0)
+!
+! Revision 1.17  2005/12/06 15:29:16  raasch
+! Mean pt profile is calculated only in case of the first intermediate timestep
+!
+! Revision 1.16  2004/01/30 10:14:31  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.15  2003/10/29 08:41:47  raasch
+! Horizontal mean temperature is now taken from array hom instead of array sums
+!
+! Revision 1.14  2003/03/16 09:27:22  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.13  2003/03/12 16:20:47  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.12  2002/12/19 13:47:38  raasch
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.11  2002/06/11 12:33:07  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+! Calculation of the horizontally averaged temperature profile moved to new
+! subroutine calc_mean_pt_profile, which is part of this module.
+!
+! Revision 1.10  2001/03/30 06:54:56  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.9  2001/01/22 05:27:03  raasch
+! Module test_variables removed
+!
+! Revision 1.8  2000/07/03 12:55:56  raasch
+! Argument theta declared as pointer
+!
+! Revision 1.7  2000/04/27 07:04:19  raasch
+! in case of a sloping surface the temperature difference is computed relative
+! to the initial (2D) temperature field
+!
+! Revision 1.6  2000/04/13 14:27:34  schroeter
+! considering the influence of humidity to the buoyancy term
+! (only for sloping_surface = false),
+!
+! Revision 1.5  2000/01/21  16:17:23  16:17:23  letzel (Marcus Letzel)
+! All comments translated into English
+! 
+! Revision 1.4  1998/09/22 17:16:22  raasch
+! Auftriebsterm erweitert fuer Rechnungen mit geneigter Ebene
+!
+! Revision 1.3  1998/07/06 12:07:27  raasch
+! + USE test_variables
+!
+! Revision 1.2  1998/03/30 11:33:29  raasch
+! nanz_2dh in nanz_2dh(0) geaendert
 !
 ! Revision 1.1  1997/08/29 08:56:48  raasch
@@ -42,23 +77,10 @@
 ! 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
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  g
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  pt, pt_slope_ref, ref_state, tend
-
-    USE control_parameters,                                                                        &
-        ONLY:  atmos_ocean_sign, cos_alpha_surface, message_string, pt_surface, sin_alpha_surface, &
-               sloping_surface
-
-    USE kinds
+! Buoyancy term of the third component of the equation of motion.
+! WARNING: humidity is not regarded when using a sloping surface!
+!------------------------------------------------------------------------------!
 
     PRIVATE
-    PUBLIC buoyancy
+    PUBLIC buoyancy, calc_mean_pt_profile
 
     INTERFACE buoyancy
@@ -67,26 +89,26 @@
     END INTERFACE buoyancy
 
+    INTERFACE calc_mean_pt_profile
+       MODULE PROCEDURE calc_mean_pt_profile
+    END INTERFACE calc_mean_pt_profile
+
  CONTAINS
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE buoyancy( var, wind_component )
-
-       USE indices,                                                                                &
-           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzt
-
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE buoyancy( theta, wind_component, pr )
+
+       USE arrays_3d
+       USE control_parameters
+       USE indices
+       USE pegrid
+       USE statistics
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i              !<
-       INTEGER(iwp) ::  j              !<
-       INTEGER(iwp) ::  k              !<
-       INTEGER(iwp) ::  wind_component !<
-
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
+       INTEGER ::  i, j, k, pr, wind_component
+       REAL, DIMENSION(:,:,:), POINTER  ::  theta
 
 
@@ -94,16 +116,11 @@
 !
 !--       Normal case: horizontal surface
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-          !$ACC PRESENT(var) &
-          !$ACC PRESENT(ref_state) &
-          !$ACC PRESENT(tend)
           DO  i = nxl, nxr
              DO  j = nys, nyn
-                DO  k = nzb+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)             &
-                                 )
+                DO  k = nzb_s_inner(j,i)+1, nzt-1
+                    tend(k,j,i) = tend(k,j,i) + g * 0.5 * (                    &
+                        ( theta(k,j,i)   - hom(k,1,pr,0)   ) / hom(k,1,pr,0) + &
+                        ( theta(k+1,j,i) - hom(k+1,1,pr,0) ) / hom(k+1,1,pr,0) &
+                                                          )
                 ENDDO
              ENDDO
@@ -112,18 +129,18 @@
        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.
+!--       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.
+!--       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  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = nzb+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
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *      &
+                           0.5 * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
+                                 - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
+                                 ) / pt_surface
                    ENDDO
                 ENDDO
@@ -134,9 +151,9 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = nzb+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
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *      &
+                           0.5 * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
+                                 - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
+                                 ) / pt_surface
                    ENDDO
                 ENDDO
@@ -145,6 +162,7 @@
           ELSE
 
-             WRITE( message_string, * ) 'no term for component "', wind_component, '"'
-             CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 )
+             IF ( myid == 0 )  PRINT*, '+++ buoyancy: no term for component "',&
+                                       wind_component,'"'
+             CALL local_stop
 
           ENDIF
@@ -155,73 +173,135 @@
 
 
-!--------------------------------------------------------------------------------------------------!
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE buoyancy_ij( i, j, theta, wind_component, pr )
+
+       USE arrays_3d
+       USE control_parameters
+       USE indices
+       USE pegrid
+       USE statistics
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k, pr, wind_component
+       REAL, DIMENSION(:,:,:), POINTER  ::  theta
+
+
+       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) + g * 0.5 * (                          &
+                        ( theta(k,j,i)   - hom(k,1,pr,0)   ) / hom(k,1,pr,0) + &
+                        ( theta(k+1,j,i) - hom(k+1,1,pr,0) ) / hom(k+1,1,pr,0) &
+                                                    )
+          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 * ( ( 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 * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
+                                 - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
+                                 ) / pt_surface
+             ENDDO
+
+          ELSE
+
+             IF ( myid == 0 )  PRINT*, '+++ buoyancy: no term for component "',&
+                                       wind_component,'"'
+             CALL local_stop
+
+          ENDIF
+
+       ENDIF
+
+    END SUBROUTINE buoyancy_ij
+
+
+    SUBROUTINE calc_mean_pt_profile( theta, pr )
+
+!------------------------------------------------------------------------------!
 ! 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 indices,                                                                                &
-           ONLY:  nzb, nzt
+! Calculate the horizontally averaged vertical temperature profile (pr=4 in case
+! of potential temperature and 44 in case of virtual potential temperature).
+!------------------------------------------------------------------------------!
+
+       USE control_parameters
+       USE indices
+       USE pegrid
+       USE statistics
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i              !<
-       INTEGER(iwp) ::  j              !<
-       INTEGER(iwp) ::  k              !<
-       INTEGER(iwp) ::  wind_component !<
-
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
-
-
-       IF ( .NOT. sloping_surface )  THEN
-!
-!--       Normal case: horizontal surface
-          DO  k = nzb+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)                     &
-                                                                          )
+       INTEGER ::  i, j, k, omp_get_thread_num, pr, tn
+       REAL, DIMENSION(:,:,:), POINTER  ::  theta
+
+!
+!--    Computation of the horizontally averaged temperature profile, 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.
+!--    Although this calculation is not required for model runs with a slope,
+!--    it is nevertheless also computed.
+       IF ( .NOT. flow_statistics_called  .AND. &
+            intermediate_timestep_count == 1 )  THEN
+
+!
+!--       Horizontal average of the potential temperature
+          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
+          !$OMP DO
+          DO  i = nxl, nxr
+             DO  j =  nys, nyn
+                DO  k = nzb_s_outer(j,i), nzt+1
+                   sums_l(k,pr,tn) = sums_l(k,pr,tn) + theta(k,j,i)
+                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  k = nzb+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+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
+          !$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 )
+
+          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
+
+          hom(:,1,pr,0) = sums(:,pr) / ngp_2dh_outer(:,0)
 
        ENDIF
 
-    END SUBROUTINE buoyancy_ij
+    END SUBROUTINE calc_mean_pt_profile
 
  END MODULE buoyancy_mod
Index: palm/trunk/SOURCE/calc_liquid_water_content.f90
===================================================================
--- palm/trunk/SOURCE/calc_liquid_water_content.f90	(revision 1)
+++ palm/trunk/SOURCE/calc_liquid_water_content.f90	(revision 1)
@@ -0,0 +1,92 @@
+ SUBROUTINE calc_liquid_water_content
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: calc_liquid_water_content.f90,v $
+! Revision 1.5  2005/03/26 15:22:06  raasch
+! Arguments for non-cyclic boundary conditions added to argument list of
+! routine exchange_horiz,
+! ql calculated for the ghost points, exchange of ghost points removed
+!
+! Revision 1.4  2004/01/30 10:15:13  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.3  2001/01/22 05:30:59  raasch
+! Module test_variables removed
+!
+! Revision 1.2  2000/06/13 07:49:32  schroeter
+! Horizontal boundary conditions (cyclic) of ql will be set now
+!
+! Revision 1.1  2000/04/13 14:50:45  schroeter
+! Initial revision
+!
+!
+!
+! Description:
+! ------------
+! Calculation of the liquid water content (0%-or-100%-scheme)
+!------------------------------------------------------------------------------!
+
+
+    USE arrays_3d
+    USE cloud_parameters
+    USE constants
+    USE grid_variables
+    USE indices
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER :: i, j, k
+
+    REAL :: alpha, e_s, q_s, t_l
+
+    DO  i = nxl-1, nxr+1
+       DO  j = nys-1, nyn+1
+          DO  k = nzb_2d(j,i)+1, nzt
+
+!
+!--          Compute the liquid water temperature
+             t_l = t_d_pt(k) * pt(k,j,i)
+
+!
+!--          Compute saturation water vapor pressure at t_l
+             e_s = 610.78 * EXP( 17.269 * ( t_l - 273.16 ) / &
+                                          ( t_l - 35.86 ) )
+
+!
+!--          Compute approximation of saturation humidity
+             q_s = 0.622 * e_s / &
+                   ( hydro_press(k) - 0.378 * e_s )
+
+!
+!--          Correction factor
+             alpha = 0.622 * l_d_r * l_d_cp / ( t_l * t_l )
+
+!
+!--          Correction of the approximated value
+!--          (see: Cuijpers + Duynkerke, 1993, JAS, 23)
+             q_s = q_s * ( 1.0 + alpha * q(k,j,i) ) / ( 1.0 + alpha * q_s )
+
+!
+!--          Compute the liquid water content
+             IF ( ( q(k,j,i) - q_s ) > 0.0 ) THEN
+                ql(k,j,i) = q(k,j,i) - q_s
+             ELSE
+                ql(k,j,i) = 0.0 
+             ENDIF
+
+          ENDDO
+       ENDDO
+    ENDDO
+    
+!
+!-- Setting boundary values of ql
+!    CALL exchange_horiz( ql, 0, 0 )    
+
+ END SUBROUTINE calc_liquid_water_content
Index: palm/trunk/SOURCE/calc_mean_profile.f90
===================================================================
--- palm/trunk/SOURCE/calc_mean_profile.f90	(revision 4901)
+++ 	(revision )
@@ -1,170 +1,0 @@
-!> @file calc_mean_profile.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Bugfix for last commit
-!
-! 4743 2020-10-14 16:40:58Z suehring
-! Add option to force calculation of horizontal mean profiles independent on data output
-! 
-! 4542 2020-05-19 15:45:12Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static
-! topography information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! nopointer option removed
-!
-! 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, force_calc )
-
-       USE control_parameters,                                                                     &
-           ONLY:  intermediate_timestep_count
-
-       USE indices,                                                                                &
-           ONLY:  ngp_2dh_s_inner, nxl, nxr, nyn, nys, nzb, nzb, nzt, wall_flags_total_0
-
-       USE kinds
-
-       USE pegrid
-
-       USE statistics,                                                                             &
-           ONLY:  flow_statistics_called, hom, sums, sums_l
-
-
-       IMPLICIT NONE
-
-       LOGICAL, OPTIONAL ::  force_calc             !< passed flag used to force calculation of mean profiles independend on data output
-       LOGICAL           ::  force_calc_l = .FALSE. !< control flag
-
-       INTEGER(iwp) ::  i                  !<
-       INTEGER(iwp) ::  j                  !<
-       INTEGER(iwp) ::  k                  !<
-       INTEGER(iwp) ::  pr                 !<
-!$     INTEGER(iwp) ::  omp_get_thread_num !<
-       INTEGER(iwp) ::  tn                 !<
-
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
-
-!
-!--    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. At
-!--    initialization, intermediate_timestep_count = 0 is considered as well.
-!--    Note, calc_mean_profile is also called from the radiation. Especially during the spinup when
-!--    no data output is called, the values in hom do not necessarily reflect horizontal mean.
-!--    The same is also for nested simulations during the spinup, where hom is initialized on a
-!--    ealier point in time than the initialization via the parent domain takes place, meaning
-!--    that hom does not necessarily reflect the horizontal mean during the spinup, too.
-!--    In order to force the computation of horizontal mean profiles independent on data output,
-!--    i.e. independent on flow_statistics, add a special control flag.
-       IF ( PRESENT( force_calc ) )  THEN
-          force_calc_l = force_calc
-       ELSE
-          force_calc_l = .FALSE.
-       ENDIF
-
-       IF ( ( .NOT. flow_statistics_called  .AND.  intermediate_timestep_count <= 1 ) .OR.         &
-            force_calc_l )  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, nzt+1
-                   sums_l(k,pr,tn) = sums_l(k,pr,tn) + var(k,j,i) * MERGE( 1.0_wp, 0.0_wp,         &
-                                                            BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                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_precipitation.f90
===================================================================
--- palm/trunk/SOURCE/calc_precipitation.f90	(revision 1)
+++ palm/trunk/SOURCE/calc_precipitation.f90	(revision 1)
@@ -0,0 +1,112 @@
+ MODULE calc_precipitation_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: calc_precipitation.f90,v $
+! Revision 1.5  2004/01/30 10:15:57  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.4  2003/03/12 16:21:23  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.3  2002/06/11 12:38:58  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.2  2001/01/22 05:32:25  raasch
+! Module test_variables removed
+!
+! Revision 1.1  2000/04/13 14:45:22  schroeter
+! Initial revision
+!
+!
+!
+! Description:
+! ------------
+! Calculate the change of total water content due to precipitation
+! (simplified Kessler scheme)
+!------------------------------------------------------------------------------!
+
+    PRIVATE
+    PUBLIC calc_precipitation
+
+    INTERFACE calc_precipitation
+       MODULE PROCEDURE calc_precipitation
+       MODULE PROCEDURE calc_precipitation_ij
+    END INTERFACE calc_precipitation
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE calc_precipitation
+
+       USE arrays_3d
+       USE cloud_parameters
+       USE constants
+       USE indices
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+       REAL    :: precipitation_rate
+
+ 
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_2d(j,i)+1, nzt-1    
+
+                IF ( ql(k,j,i) > ql_crit )  THEN
+                   precipitation_rate = prec_time_const * &
+                                        ( ql(k,j,i) - ql_crit )
+                ELSE
+                   precipitation_rate = 0.0
+                ENDIF
+                tend(k,j,i) = tend(k,j,i) - precipitation_rate
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE calc_precipitation
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE calc_precipitation_ij( i, j )
+
+       USE arrays_3d
+       USE cloud_parameters
+       USE constants
+       USE indices
+   
+       IMPLICIT NONE
+
+       INTEGER :: i, j, k
+       REAL    :: precipitation_rate
+
+
+       DO  k = nzb_2d(j,i)+1, nzt-1    
+
+          IF ( ql(k,j,i) > ql_crit )  THEN
+             precipitation_rate = prec_time_const * ( ql(k,j,i) - ql_crit )
+          ELSE
+             precipitation_rate = 0.0
+          ENDIF
+          tend(k,j,i) = tend(k,j,i) - precipitation_rate
+
+       ENDDO
+
+    END SUBROUTINE calc_precipitation_ij
+
+ END MODULE calc_precipitation_mod
Index: palm/trunk/SOURCE/calc_radiation.f90
===================================================================
--- palm/trunk/SOURCE/calc_radiation.f90	(revision 1)
+++ palm/trunk/SOURCE/calc_radiation.f90	(revision 1)
@@ -0,0 +1,284 @@
+ MODULE calc_radiation_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: calc_radiation.f90,v $
+! Revision 1.6  2004/01/30 10:17:03  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.5  2003/03/12 16:21:56  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.4  2002/06/11 12:40:33  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+! 1D-arrays lwp_groud,... are only allocated once in the first call.
+!
+! Revision 1.3  2001/03/30 06:55:27  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.2  2001/01/22 05:35:05  raasch
+! Module test_variables removed
+!
+! 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
+!------------------------------------------------------------------------------!
+
+    PRIVATE
+    PUBLIC calc_radiation
+    
+    LOGICAL, SAVE ::  first_call = .TRUE.
+    REAL, SAVE    ::  sigma = 5.67E-08
+
+    REAL, DIMENSION(:), ALLOCATABLE, SAVE ::  lwp_ground, lwp_top, &
+                                              blackbody_emission
+
+    INTERFACE calc_radiation
+       MODULE PROCEDURE calc_radiation
+       MODULE PROCEDURE calc_radiation_ij
+    END INTERFACE calc_radiation
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE calc_radiation
+
+       USE arrays_3d
+       USE cloud_parameters
+       USE control_parameters
+       USE indices
+       USE pegrid
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k, k_help
+ 
+       REAL :: df_p, df_m , effective_emission_up_m, effective_emission_up_p, &
+               effective_emission_down_m, effective_emission_down_p,          &
+               f_up_m, f_up_p, f_down_m, f_down_p, impinging_flux_at_top,     &
+               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
+             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.0
+
+             DO  k = nzb_2d(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.0
+
+             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.0
+
+!
+!--          See Chlond '92, this is just a first guess
+             impinging_flux_at_top = blackbody_emission(nzb) - 100.0
+
+             DO  k = nzb_2d(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 ) THEN
+!
+!--                Compute effective emissivities
+                   effective_emission_up_p   = 1.0 - &
+                                               EXP( -130.0 * lwp_ground(k+1) )
+                   effective_emission_up_m   = 1.0 - &
+                                               EXP( -130.0 * lwp_ground(k-1) )
+                   effective_emission_down_p = 1.0 - &
+                                               EXP( -158.0 * lwp_top(k+1) )
+                   effective_emission_down_m = 1.0 - &
+                                               EXP( -158.0 * 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
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE calc_radiation_ij( i, j )
+
+       USE arrays_3d
+       USE cloud_parameters
+       USE control_parameters
+       USE indices
+       USE pegrid
+   
+       IMPLICIT NONE
+
+       INTEGER :: i, j, k, k_help
+
+       REAL :: df_p, df_m , effective_emission_up_m, effective_emission_up_p, &
+               effective_emission_down_m, effective_emission_down_p,          &
+               f_up_m, f_up_p, f_down_m, f_down_p, impinging_flux_at_top,     &
+               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
+       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.0
+
+       DO  k = nzb_2d(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.0
+
+       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.0
+
+!
+!--    See Chlond '92, this is just a first guess
+       impinging_flux_at_top = blackbody_emission(nzb) - 100.0
+
+       DO  k = nzb_2d(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 ) THEN
+!
+!--          Compute effective emissivities
+             effective_emission_up_p   = 1.0 - &
+                                         EXP( -130.0 * lwp_ground(k+1) )
+             effective_emission_up_m   = 1.0 - &
+                                         EXP( -130.0 * lwp_ground(k-1) )
+             effective_emission_down_p = 1.0 - &
+                                         EXP( -158.0 * lwp_top(k+1) )
+             effective_emission_down_m = 1.0 - &
+                                         EXP( -158.0 * 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/calc_spectra.f90
===================================================================
--- palm/trunk/SOURCE/calc_spectra.f90	(revision 1)
+++ palm/trunk/SOURCE/calc_spectra.f90	(revision 1)
@@ -0,0 +1,444 @@
+ SUBROUTINE calc_spectra
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: calc_spectra.f90,v $
+! Revision 1.9  2006/04/11 14:56:00  raasch
+! pl_spectra renamed data_output_sp
+!
+! Revision 1.8  2005/05/18 15:08:18  raasch
+! n is assigned the number of spectra (formerly, the number of spectra was
+! given by n-1)
+!
+! Revision 1.7  2005/04/23 08:41:39  raasch
+! Abort in case of non-cyclic lateral boundaries
+!
+! Revision 1.6  2004/04/30 08:23:12  raasch
+! Usage of all available FFT-methods is possible, direct transpositions from
+! z to x and from z to y are used, FFT routines renamed, module
+! fft_for_1d_decomp renamed fft_xy, extensions for enlarged subdomain added
+!
+! Revision 1.5  2003/03/16 09:27:35  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.4  2002/06/11 12:44:15  raasch
+! TRIM function added (needed on IBM-systems)
+!
+! Revision 1.3  2001/03/30  06:55:58  06:55:58  raasch (Siegfried Raasch)
+! Work array replaced by tend,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+! 
+! Revision 1.2  2001/01/25 06:52:21  raasch
+! Module singleton moved to modules.f90
+!
+! Revision 1.1  2001/01/05 15:08:07  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Calculate horizontal spectra along x and y. 
+! ATTENTION: 1d-decomposition along y still needs improvement, because in that
+!            case the gridpoint number along z still depends on the PE number
+!            because transpose_xz has to be used (and possibly also
+!            transpose_zyd needs modification).
+!------------------------------------------------------------------------------!
+
+#if defined( __spectra )
+    USE arrays_3d
+    USE control_parameters
+    USE cpulog
+    USE fft_xy
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE spectrum
+
+    IMPLICIT NONE
+
+    INTEGER ::  m, pr
+
+
+    CALL cpu_log( log_point(30), 'calc_spectra', 'start' )
+
+!
+!-- Initialize ffts
+    CALL fft_init
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+       DEALLOCATE( tend )
+       ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+    ENDIF
+
+    m = 1
+    DO WHILE ( data_output_sp(m) /= ' '  .AND.  m <= 10 )
+!
+!--    Transposition from z --> x  ( y --> x in case of a 1d-decomposition
+!--    along x)
+       IF ( INDEX( spectra_direction(m), 'x' ) /= 0 )  THEN
+
+!
+!--       Calculation of spectra works for cyclic boundary conditions only
+          IF ( bc_lr /= 'cyclic' )  THEN
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ calc_spectra:'
+                PRINT*, '    non-cyclic lateral boundaries along x do not ', &
+                             'allow calculation of spectra along x' 
+             ENDIF
+             CALL local_stop
+          ENDIF
+
+          CALL preprocess_spectra( m, pr )
+
+#if defined( __parallel )
+          IF ( pdims(2) /= 1 )  THEN
+             CALL transpose_zx( d, tend, d, tend, d )
+          ELSE
+             CALL transpose_yxd( d, tend, d, tend, d )
+          ENDIF
+          CALL calc_spectra_x( d, pr, m )
+#else
+          PRINT*, '+++ calc_spectra: sorry, calculation of spectra ', &
+                                    'in non parallel mode'
+          PRINT*, '                  is still not realized'
+          CALL local_stop
+#endif
+
+       ENDIF
+
+!
+!--    Transposition from z --> y (d is rearranged only in case of a
+!--    1d-decomposition along x)
+       IF ( INDEX( spectra_direction(m), 'y' ) /= 0 )  THEN
+
+!
+!--       Calculation of spectra works for cyclic boundary conditions only
+          IF ( bc_ns /= 'cyclic' )  THEN
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ calc_spectra:'
+                PRINT*, '    non-cyclic lateral boundaries along y do not ', &
+                             'allow calculation of spectra along y' 
+             ENDIF
+             CALL local_stop
+          ENDIF
+
+          CALL preprocess_spectra( m, pr )
+
+#if defined( __parallel )
+          CALL transpose_zyd( d, tend, d, tend, d )
+          CALL calc_spectra_y( d, pr, m )
+#else
+          PRINT*, '+++ calc_spectra: sorry, calculation of spectra', &
+                                    'in non parallel mode'
+          PRINT*, '                  still not realized'
+          CALL local_stop
+#endif
+
+       ENDIF
+
+!
+!--    Increase counter for next spectrum
+       m = m + 1
+          
+    ENDDO
+
+!
+!-- Increase counter for averaging process in routine plot_spectra
+    average_count_sp = average_count_sp + 1
+
+!
+!-- Resize tend to its normal size
+    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+       DEALLOCATE( tend )
+       ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    ENDIF
+
+    CALL cpu_log( log_point(30), 'calc_spectra', 'stop' )
+
+#endif
+ END SUBROUTINE calc_spectra
+
+
+#if defined( __spectra )
+ SUBROUTINE preprocess_spectra( m, pr )
+
+    USE arrays_3d
+    USE indices
+    USE pegrid
+    USE spectrum
+    USE statistics
+
+    IMPLICIT NONE
+
+    INTEGER :: i, j, k, m, pr
+
+    SELECT CASE ( TRIM( data_output_sp(m) ) )
+          
+    CASE ( 'u' )
+       pr = 1
+       d(nzb+1:nzt,nys:nyn,nxl:nxr) = u(nzb+1:nzt,nys:nyn,nxl:nxr)
+       
+    CASE ( 'v' )
+       pr = 2
+       d(nzb+1:nzt,nys:nyn,nxl:nxr) = v(nzb+1:nzt,nys:nyn,nxl:nxr)
+       
+    CASE ( 'w' )
+       pr = 3
+       d(nzb+1:nzt,nys:nyn,nxl:nxr) = w(nzb+1:nzt,nys:nyn,nxl:nxr)
+       
+    CASE ( 'pt' )
+       pr = 4
+       d(nzb+1:nzt,nys:nyn,nxl:nxr) = pt(nzb+1:nzt,nys:nyn,nxl:nxr)
+       
+    CASE ( 'q' )
+       pr = 41
+       d(nzb+1:nzt,nys:nyn,nxl:nxr) = q(nzb+1:nzt,nys:nyn,nxl:nxr)
+       
+    CASE DEFAULT
+       PRINT*, '+++ preprocess_spectra: Spectra of ', &
+               TRIM( data_output_sp(m) ), ' can not be calculated'
+          
+    END SELECT
+
+!
+!-- Subtract horizontal mean from the array, for which spectra have to be
+!-- calculated
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             d(k,j,i) = d(k,j,i) - sums(k,pr)
+          ENDDO
+       ENDDO
+    ENDDO
+
+ END SUBROUTINE preprocess_spectra
+
+
+ SUBROUTINE calc_spectra_x( ddd, pr, m )
+
+    USE arrays_3d
+    USE constants
+    USE control_parameters
+    USE fft_xy
+    USE grid_variables
+    USE indices
+    USE pegrid
+    USE spectrum
+    USE statistics
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    INTEGER                    ::  i, ishape(1), j, k, m, n, pr
+
+    REAL                       ::  fac, exponent
+    REAL, DIMENSION(0:nx)      ::  work
+    REAL, DIMENSION(0:nx/2)    ::  sums_spectra_l
+    REAL, DIMENSION(0:nx/2,10) ::  sums_spectra
+
+    REAL, DIMENSION(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa) ::  ddd
+
+!
+!-- Exponent for geometric average
+    exponent = 1.0 / ( nx + 1.0 )
+
+!
+!-- Loop over all levels defined by the user
+    n = 1
+    DO WHILE ( comp_spectra_level(n) /= 999999  .AND.  n <= 10 )
+
+       k = comp_spectra_level(n)
+
+!
+!--    Calculate FFT only if the corresponding level is situated on this PE
+       IF ( k >= nzb_x  .AND.  k <= nzt_x )  THEN
+          
+          DO  j = nys_x, nyn_x
+
+             work = ddd(0:nx,j,k)
+             CALL fft_x( work, 'forward' )
+
+             ddd(0,j,k) = dx * work(0)**2
+             DO  i = 1, nx/2
+                ddd(i,j,k) = dx * ( work(i)**2 + work(nx+1-i)**2 )
+             ENDDO
+
+          ENDDO
+
+!
+!--       Local sum and geometric average of these spectra
+!--       (WARNING: no global sum should be performed, because floating
+!--       point overflow may occur)
+          DO  i = 0, nx/2
+
+             sums_spectra_l(i) = 1.0
+             DO  j = nys_x, nyn_x
+                sums_spectra_l(i) = sums_spectra_l(i) * ddd(i,j,k)**exponent
+             ENDDO
+
+          ENDDO
+          
+       ELSE
+
+          sums_spectra_l = 1.0
+
+       ENDIF
+
+!
+!--    Global sum of spectra on PE0 (from where they are written on file) 
+       sums_spectra(:,n) = 0.0
+#if defined( __parallel )   
+       CALL MPI_BARRIER( comm2d, ierr )  ! Necessary?
+       CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), nx/2+1, &
+                        MPI_REAL, MPI_PROD, 0, comm2d, ierr )
+#else
+       sums_spectra(:,n) = sums_spectra_l
+#endif
+
+       n = n + 1
+
+    ENDDO
+    n = n - 1
+
+    IF ( myid == 0 )  THEN
+!
+!--    Sum of spectra for later averaging (see routine plot_spectra)
+!--    Temperton fft results need to be normalized
+       IF ( fft_method == 'temperton-algorithm' )  THEN
+          fac = nx + 1.0
+       ELSE
+          fac = 1.0
+       ENDIF
+       DO  i = 1, nx/2
+          DO k = 1, n
+             spectrum_x(i,k,m) = spectrum_x(i,k,m) + sums_spectra(i,k) * fac
+          ENDDO
+       ENDDO
+
+    ENDIF
+
+!
+!-- n_sp_x is needed by plot_spectra_x
+    n_sp_x = n
+
+ END SUBROUTINE calc_spectra_x
+
+
+ SUBROUTINE calc_spectra_y( ddd, pr, m )
+
+    USE arrays_3d
+    USE constants
+    USE control_parameters
+    USE fft_xy
+    USE grid_variables
+    USE indices
+    USE pegrid
+    USE spectrum
+    USE statistics
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    INTEGER :: i, j, jshape(1), k, m, n, pr
+
+    REAL                       ::  fac, exponent
+    REAL, DIMENSION(0:ny)      ::  work
+    REAL, DIMENSION(0:ny/2)    ::  sums_spectra_l
+    REAL, DIMENSION(0:ny/2,10) ::  sums_spectra
+
+    REAL, DIMENSION(0:nya,nxl_yd:nxr_yda,nzb_yd:nzt_yda) :: ddd
+
+
+!
+!-- Exponent for geometric average
+    exponent = 1.0 / ( nx + 1.0 )
+
+!
+!-- Loop over all levels defined by the user
+    n = 1
+    DO WHILE ( comp_spectra_level(n) /= 999999  .AND.  n <= 10 )
+
+       k = comp_spectra_level(n)
+
+!
+!--    Calculate FFT only if the corresponding level is situated on this PE
+       IF ( k >= nzb_yd  .AND.  k <= nzt_yd )  THEN
+          
+          DO  i = nxl_yd, nxr_yd
+
+             work = ddd(0:ny,i,k)
+             CALL fft_y( work, 'forward' )
+
+             ddd(0,i,k) = dy * work(0)**2
+             DO  j = 1, ny/2
+                ddd(j,i,k) = dy * ( work(j)**2 + work(ny+1-j)**2 )
+             ENDDO
+
+          ENDDO
+
+!
+!--       Local sum and geometric average of these spectra
+!--       (WARNING: no global sum should be performed, because floating
+!--       point overflow may occur)
+          DO  j = 0, ny/2
+
+             sums_spectra_l(j) = 1.0
+             DO  i = nxl_yd, nxr_yd
+                sums_spectra_l(j) = sums_spectra_l(j) * ddd(j,i,k)**exponent
+             ENDDO
+
+          ENDDO
+          
+       ELSE
+
+          sums_spectra_l = 1.0
+
+       ENDIF
+
+!
+!--    Global sum of spectra on PE0 (from where they are written on file) 
+       sums_spectra(:,n) = 0.0
+#if defined( __parallel )   
+       CALL MPI_BARRIER( comm2d, ierr )  ! Necessary?
+       CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), ny/2+1, &
+                        MPI_REAL, MPI_PROD, 0, comm2d, ierr )
+#else
+       sums_spectra(:,n) = sums_spectra_l
+#endif
+
+       n = n + 1
+
+    ENDDO
+    n = n - 1
+
+
+    IF ( myid == 0 )  THEN
+!
+!--    Sum of spectra for later averaging (see routine plot_spectra)
+!--    Temperton fft results need to be normalized
+       IF ( fft_method == 'temperton-algorithm' )  THEN
+          fac = ny + 1.0
+       ELSE
+          fac = 1.0
+       ENDIF
+       DO  j = 1, ny/2
+          DO k = 1, n
+             spectrum_y(j,k,m) = spectrum_y(j,k,m) + sums_spectra(j,k) * fac
+          ENDDO
+       ENDDO
+
+    ENDIF
+
+!
+!-- n_sp_y is needed by plot_spectra_y
+    n_sp_y = n
+
+ END SUBROUTINE calc_spectra_y
+#endif
Index: palm/trunk/SOURCE/check_for_restart.f90
===================================================================
--- palm/trunk/SOURCE/check_for_restart.f90	(revision 4901)
+++ palm/trunk/SOURCE/check_for_restart.f90	(revision 1)
@@ -1,34 +1,46 @@
-!> @file check_for_restart.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE check_for_restart
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: check_for_restart.f90,v $
+! Revision 1.11  2007/02/11 12:55:13  raasch
+! Informative output to the job protocol
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.10  2003/03/16 09:27:49  raasch
+! Two underscores (_) are placed in front of all define-strings
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! Error messages revised
+! Revision 1.9  2002/12/19 13:48:59  raasch
+! Stop flag is also set in case of user forced restarts, routine name
+! changed from check_cpu_time to check_for_restart, the run description
+! header will be written on file CONTINUE_RUN
+!
+! Revision 1.8  2001/08/21 08:22:23  raasch
+! MPI_ALLREDUCE moved out of IF-clause
+!
+! Revision 1.7  2001/03/30 06:56:28  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.6  2001/01/22 05:36:33  raasch
+! Module test_variables removed
+!
+! Revision 1.5  2001/01/02 17:19:27  raasch
+! Initial value of terminate_run_l is set to .FALSE. (undefined before).
+! Flag file will only be created by PE0. Unit 90 is used instead of 91.
+!
+! Revision 1.4  2000/01/21 16:27:59  letzel
+! All comments translated into English
+!
+! Revision 1.3  1998/07/06 12:07:47  raasch
+! + USE test_variables
+!
+! Revision 1.2  1998/03/24 15:24:54  raasch
+! Lauf wird nur dann beendet und Fortsetzungslauf gestartet, falls auch eine
+! Abspeicherung der entsprechenden Binaerdateien vorgesehen ist.
+! Beendigung der Rechnung auf mehreren Prozessoren richtig implementiert.
 !
 ! Revision 1.1  1998/03/18 20:06:51  raasch
@@ -38,30 +50,16 @@
 ! Description:
 ! ------------
-!> Set stop flag, if restart is neccessary because of expiring cpu-time or if it is forced by user.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE check_for_restart
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  coupling_mode, dt_restart, end_time, message_string, run_description_header,        &
-               simulated_time, terminate_coupled, terminate_coupled_remote, terminate_run,         &
-               termination_time_needed, time_restart, time_since_reference_point, write_binary
-
-    USE kinds
+! Set stop flag, if restart is neccessary because of expiring cpu-time or
+! if it is forced by user
+!------------------------------------------------------------------------------!
 
     USE pegrid
-
-    USE pmc_interface,                                                                             &
-        ONLY:  comm_world_nesting, cpl_id, nested_run
+    USE control_parameters
 
     IMPLICIT NONE
 
-    INTEGER ::  global_communicator       !< global communicator to be used here
 
-    LOGICAL ::  terminate_run_l           !<
-    LOGICAL ::  do_stop_now = .FALSE.     !<
-    LOGICAL ::  do_restart_now = .FALSE.  !<
-
-    REAL(wp) ::  remaining_time !<
+    LOGICAL :: terminate_run_l
+    REAL ::  remaining_time
 
 
@@ -73,24 +71,16 @@
 !-- If necessary set a flag to stop the model run
     terminate_run_l = .FALSE.
-    IF ( remaining_time <= termination_time_needed  .AND.  write_binary )  THEN
+    IF ( remaining_time <= termination_time_needed  .AND. &
+         write_binary(1:4) == 'true' )  THEN
 
        terminate_run_l = .TRUE.
     ENDIF
 
-!
-!-- Set the global communicator to be used (depends on the mode in which PALM is running)
-    IF ( nested_run )  THEN
-       global_communicator = comm_world_nesting
-    ELSE
-       global_communicator = comm2d
-    ENDIF
-
 #if defined( __parallel )
 !
-!-- Make a logical OR for all processes. Stop the model run if at least one process has reached the
-!-- time limit.
-    IF ( collective_wait )  CALL MPI_BARRIER( global_communicator, ierr )
-    CALL MPI_ALLREDUCE( terminate_run_l, terminate_run, 1, MPI_LOGICAL, MPI_LOR,                   &
-                        global_communicator, ierr )
+!-- Make a logical OR for all processes. Stop the model run if at least
+!-- one processor has reached the time limit.
+    CALL MPI_ALLREDUCE( terminate_run_l, terminate_run, 1, MPI_LOGICAL, &
+                        MPI_LOR, comm2d, ierr )
 #else
     terminate_run = terminate_run_l
@@ -100,141 +90,42 @@
 !-- Output that job will be terminated
     IF ( terminate_run  .AND.  myid == 0 )  THEN
-       WRITE( message_string, * ) 'run will be terminated because it is ',                         &
-                                  'running out of job cpu limit & ',                               &
-                                  'remaining time:         ', remaining_time, ' s &',              &
-                                  'termination time needed:', termination_time_needed, ' s'
-       CALL message( 'check_for_restart', 'PA0163', 0, 1, 0, 6, 0 )
+       PRINT*, '*** WARNING: run will be terminated because it is running out of job cpu', &
+                    'limit'
+       PRINT*, '             remaining time:         ', remaining_time, ' s'
+       PRINT*, '             termination time needed:', termination_time_needed, ' s'
     ENDIF
 
 !
-!-- In case of coupled runs inform the remote model of the termination and its reason, provided the
-!-- remote model has not already been informed of another termination reason (terminate_coupled > 0)
-!-- before, or vice versa (terminate_coupled_remote > 0).
-    IF ( terminate_run .AND. TRIM( coupling_mode ) /= 'uncoupled'  .AND.                           &
-         terminate_coupled == 0  .AND.  terminate_coupled_remote == 0 )  THEN
-
-       terminate_coupled = 3
-
-#if defined( __parallel )
-       IF ( myid == 0 ) THEN
-          CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER,                             &
-                             target_id, 0,                                                         &
-                             terminate_coupled_remote, 1, MPI_INTEGER,                             &
-                             target_id, 0,                                                         &
-                             comm_inter, status, ierr )
-       ENDIF
-       CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, ierr )
-#endif
-    ENDIF
-
-
+!-- Set the stop flag also, if restart is forced by user
+    IF ( time_restart /= 9999999.9  .AND.  time_restart < simulated_time ) &
+    THEN
 !
-!-- Check if a flag file exists that forces a termination of the model.
-    IF ( myid == 0 )  THEN
-       INQUIRE(FILE="DO_STOP_NOW", EXIST=do_stop_now)
-       INQUIRE(FILE="DO_RESTART_NOW", EXIST=do_restart_now)
-
-       IF ( do_stop_now .OR. do_restart_now )  THEN
-
-          terminate_run_l = .TRUE.
-
-          WRITE( message_string, * ) 'run will be terminated because user ',                       &
-                                     'forced a job finalization using a flag',                     &
-                                     'file:',                                                      &
-                                     '&DO_STOP_NOW: ', do_stop_now,                                &
-                                     '&DO_RESTART_NOW: ', do_restart_now
-          CALL message( 'check_for_restart', 'PA0398', 0, 0, 0, 6, 0 )
-
-       ENDIF
-    ENDIF
-
-
-#if defined( __parallel )
-!
-!-- Make a logical OR for all processes. Stop the model run if a flag file has been detected above.
-    IF ( collective_wait )  CALL MPI_BARRIER( global_communicator, ierr )
-    CALL MPI_ALLREDUCE( terminate_run_l, terminate_run, 1, MPI_LOGICAL, MPI_LOR,                   &
-                        global_communicator, ierr )
-#else
-    terminate_run = terminate_run_l
-#endif
-
-!
-!-- In case of coupled runs inform the remote model of the termination and its reason, provided the
-!-- remote model has not already been informed of another termination reason (terminate_coupled > 0)
-!-- before, or vice versa (terminate_coupled_remote > 0).
-    IF ( terminate_run .AND. coupling_mode /= 'uncoupled' .AND.                                    &
-         terminate_coupled == 0 .AND.  terminate_coupled_remote == 0 )  THEN
-
-       terminate_coupled = 6
-
-#if defined( __parallel )
-       IF ( myid == 0 ) THEN
-          CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER,                             &
-                             target_id,  0,                                                        &
-                             terminate_coupled_remote, 1, MPI_INTEGER,                             &
-                             target_id,  0,                                                        &
-                             comm_inter, status, ierr )
-       ENDIF
-       CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, ierr )
-#endif
-
-    ENDIF
-
-!
-!-- Set the stop flag also, if restart is forced by user settings
-    IF ( time_restart /= 9999999.9_wp  .AND.  time_restart < time_since_reference_point )  THEN
-
-!
-!--    Restart is not neccessary, if the end time of the run (given by the user) has been reached.
+!--    Restart is not neccessary, if the end time of the run (given by
+!--    the user) has been reached
        IF ( simulated_time < end_time )  THEN
           terminate_run = .TRUE.
 !
-!--       Increment restart time, if forced by user, otherwise set restart time to default (no user
-!--       restart).
-          IF ( dt_restart /= 9999999.9_wp )  THEN
+!--       Increment restart time, if forced by user, otherwise set restart
+!--       time to default (no user restart)
+          IF ( dt_restart /= 9999999.9 )  THEN
              time_restart = time_restart + dt_restart
           ELSE
-             time_restart = 9999999.9_wp
+             time_restart = 9999999.9
           ENDIF
 
-          WRITE( message_string, * ) 'run will be terminated due to user ',                        &
-                                     'settings of ',                                               &
-                                     'restart_time / dt_restart, ',                                &
-                                     'new restart time is: ', time_restart, ' s'
-          CALL message( 'check_for_restart', 'PA0164', 0, 0, 0, 6, 0 )
-
-!
-!--       In case of coupled runs inform the remote model of the termination and its reason,
-!--       provided the remote model has not already been informed of another termination reason
-!--       (terminate_coupled > 0) before, or vice versa (terminate_coupled_remote > 0).
-          IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0                           &
-               .AND.  terminate_coupled_remote == 0 )  THEN
-
-             IF ( dt_restart /= 9999999.9_wp )  THEN
-                terminate_coupled = 4
-             ELSE
-                terminate_coupled = 5
-             ENDIF
-#if defined( __parallel )
-             IF ( myid == 0 ) THEN
-                CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER,                       &
-                                   target_id,  0,                                                  &
-                                   terminate_coupled_remote, 1, MPI_INTEGER,                       &
-                                   target_id,  0,                                                  &
-                                   comm_inter, status, ierr )
-             ENDIF
-             CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, ierr )
-#endif
+          IF ( myid == 0 )  THEN
+             PRINT*, '*** INFORMATIVE: run will be terminated due to user settings of'
+             PRINT*, '                 restart_time / dt_restart'
+             PRINT*, '                 new restart time is: ', time_restart, ' s'
           ENDIF
-       ELSE
-          time_restart = 9999999.9_wp
+    ELSE
+          time_restart = 9999999.9
        ENDIF
     ENDIF
 
 !
-!-- If the run is stopped, set a flag file which is necessary to initiate the start of a
-!-- continuation run, except if the user forced to stop the run without restart.
-    IF ( terminate_run  .AND.  myid == 0  .AND.  cpl_id == 1  .AND.  .NOT. do_stop_now)  THEN
+!-- If the run is stopped, set a flag file which is necessary to initiate
+!-- the start of a continuation run
+    IF ( terminate_run  .AND.  myid == 0 )  THEN
 
        OPEN ( 90, FILE='CONTINUE_RUN', FORM='FORMATTED' )
Index: palm/trunk/SOURCE/check_open.f90
===================================================================
--- palm/trunk/SOURCE/check_open.f90	(revision 4901)
+++ palm/trunk/SOURCE/check_open.f90	(revision 1)
@@ -1,71 +1,96 @@
-!> @file check_open.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE check_open( file_id )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! local filename for output of particle time series changed
-!
-! 4652 2020-08-27 08:51:55Z raasch
-! Routine fortran_sleep has been moved to module posix_interface
-! 
-! 4577 2020-06-25 09:53:58Z raasch
-! further re-formatting to follow the PALM coding standard
-!
-! 4546 2020-05-24 12:16:41Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4400 2020-02-10 20:32:41Z suehring
-! Remove binary output for virtual measurements
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4128 2019-07-30 16:28:58Z gronemeier
-! Bugfix for opening the parameter file (unit 11): return error message if file
-! was not found.
-!
-! 4099 2019-07-15 15:29:37Z suehring
-! Bugfix in opening the parameter file (unit 11) in case of ocean precursor
-! runs.
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to
-! avoid runtime error (Loop variable has been modified) in time_integration
-!
-! 3967 2019-05-09 16:04:34Z gronemeier
-! Save binary data of virtual measurements within separate folder
-!
-! 3812 2019-03-25 07:10:12Z gronemeier
-! Open binary surface output data within separate folder
-!
-! 3705 2019-01-29 19:56:39Z suehring
-! Open binary files for virtual measurements
-!
-! 3704 2019-01-29 19:51:41Z suehring
-! Open files for surface data
+! $Log: check_open.f90,v $
+! Revision 1.44  2006/08/22 13:48:34  raasch
+! xz and yz cross sections now up to nzt+1
+!
+! Revision 1.43  2006/08/04 14:05:52  raasch
+! Opening of unit 109 (particle time series)
+!
+! Revision 1.42  2006/03/01 16:39:47  raasch
+! In parallel mode, all PEs are opening the same copy of file PARIN
+!
+! Revision 1.41  2006/02/23 10:05:05  raasch
+! New unit 20 for data logging,
+! new units (111:113,116) for 2d/3d data averaging
+! NetCDF files are allowed a 64 bit offset format,
+! error number argument for handle_netcdf_error
+!
+! Revision 1.40  2005/06/30 10:39:04  raasch
+! No opening of units 101-108 in case of missing netcdf support
+!
+! Revision 1.39  2005/06/26 19:51:36  raasch
+! Data format version number for unit 85 changed
+!
+! Revision 1.38  2005/05/18 15:09:01  raasch
+! Extensions for NetCDF output
+!
+! Revision 1.37  2005/04/23 08:50:18  raasch
+! batch_scp calls is given the remote username as an additional argument
+!
+! Revision 1.36  2004/01/28 15:03:21  raasch
+! In case of opening unit 80, a barrier is set only for the first call of
+! check_open (from routine init_particles), in order to avoid the possibility
+! of hanging jobs, which may occur if unit 80 is opened within routine
+! allocate_prt_memory.
+!
+! Revision 1.35  2003/10/29 08:47:03  raasch
+! Call of batch_scp on IBM corrected, output of data format version and
+! particle group data on unit 85
+!
+! Revision 1.34  2003/05/09 14:06:58  raasch
+! Batch_scp paths for IBM, NEC and linux added
+!
+! Revision 1.33  2003/03/16 09:28:00  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.32  2002/12/19 14:03:15  raasch
+! Unit 18 (CPU_MEASURES) will be opened on PE0 only, unit 14 is opened
+! with special process-id-string myid_char_14 (see routine parin),
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.31  2002/04/24 19:01:15  raasch
+! Unit 85 is allowed to be re-opened. In case that a re-open of a file is not
+! allowed, the subroutine will be exit.
+!
+! Revision 1.30  2002/04/16 08:00:27  raasch
+! ftpcopy replaced by batch_scp, retry of opening CPU_MEASURES/ in case of
+! errors forced by adding ERR-parameter in OPEN statement.
+! New unit 85 for particle data
+!
+! Revision 1.29  2001/07/12 12:07:21  raasch
+! Opening of unit 33 moved out of ELSE-block
+!
+! Revision 1.28  2001/03/30 06:56:49  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.27  2001/01/29 12:21:52  raasch
+! In case of AVS-output: if no path for ftpcopy is given, filenames are set
+! to "unknown"
+!
+! Revision 1.26  2001/01/25 06:54:28  raasch
+! Error concerning initialization of unit 23 removed (initial informations
+! were written also when reopened)
+!
+! Revision 1.25  2001/01/05 15:09:29  raasch
+! New units 81-84 for spectra
+!
+! Revision 1.24  2001/01/02 17:21:11  raasch
+! Re-opening of files is allowed, variable openfile now is of type file_status,
+! new unit 80 for particle informations
+! old revison remarks deleted
+!
+! Revision 1.23  2000/04/27 06:51:12  raasch
+! remote_addres changed to return_addres, old revision remarks deleted
+!
+! Revision 1.22  2000/01/21 17:07:18  letzel
+! All comments translated into English
 !
 ! Revision 1.1  1997/08/11 06:10:55  raasch
@@ -75,57 +100,51 @@
 ! Description:
 ! ------------
-!> Check if file unit is open. If not, open file and, if necessary, write a
-!> header or start other initializing actions, respectively.
-!--------------------------------------------------------------------------------------------------!
-SUBROUTINE check_open( file_id )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  coupling_char, data_output_2d_on_each_pe, max_masks, message_string, openfile,      &
-               run_description_header
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  nz_do3d
-#endif
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxr, ny, nyn, nys, nz, nzb, nzt
-
-    USE kinds
-
-#if defined( __netcdf )
-    USE NETCDF
-#endif
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  id_set_agt, id_set_fl, id_set_mask, id_set_pr,                                      &
-               id_set_pts, id_set_sp, id_set_ts, id_set_xy, id_set_xz,                             &
-               id_set_yz, id_set_3d, nc_stat, netcdf_create_file,                                  &
-               netcdf_data_format, netcdf_define_header, netcdf_handle_error,                      &
-               netcdf_open_write_file
-
-    USE particle_attributes,                                                                       &
-        ONLY:  max_number_of_particle_groups, number_of_particle_groups, particle_groups
-
+! Check if file unit is open. If not, open file and, if necessary, write a
+! header or start other initializing actions, respectively.
+!------------------------------------------------------------------------------!
+
+    USE array_kind
+    USE arrays_3d
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE netcdf_control
+    USE particle_attributes
     USE pegrid
-
-    USE posix_interface,                                                                           &
-        ONLY:  fortran_sleep
-
+    USE profil_parameter
+    USE statistics
 
     IMPLICIT NONE
 
-    CHARACTER (LEN=30)  ::  filename                !<
-    CHARACTER (LEN=4)   ::  mask_char               !<
-    CHARACTER (LEN=80)  ::  rtext                   !<
-
-    INTEGER(iwp) ::  av          !<
-    INTEGER(iwp) ::  file_id     !<
-    INTEGER(iwp) ::  ioerr       !< IOSTAT flag for IO-commands ( 0 = no error )
-    INTEGER(iwp) ::  mid         !< masked output running index
-
-    LOGICAL ::  file_exist       !< file check
-    LOGICAL ::  netcdf_extend    !<
+    CHARACTER (LEN=2)   ::  suffix
+    CHARACTER (LEN=20)  ::  return_addres, return_usern, xtext = 'time in s'
+    CHARACTER (LEN=30)  ::  filename
+    CHARACTER (LEN=40)  ::  avs_coor_file, avs_coor_file_localname, &
+                            avs_data_file_localname
+    CHARACTER (LEN=80)  ::  rtext
+    CHARACTER (LEN=100) ::  avs_coor_file_catalog, avs_data_file_catalog, &
+                            batch_scp, zeile
+    CHARACTER (LEN=400) ::  command
+
+    INTEGER ::  av, anzzeile = 1, cranz, file_id, i, iaddres, ierr1, iusern, &
+                j, k, legpos = 1, timodex = 1
+    INTEGER, DIMENSION(10) ::  cucol, klist, lstyle
+
+    LOGICAL ::  avs_coor_file_found = .FALSE., avs_data_file_found = .FALSE., &
+                datleg = .TRUE., get_filenames, grid = .TRUE., netcdf_extend, &
+                rand = .TRUE., swap = .TRUE., twoxa = .TRUE., twoya = .TRUE.
+
+    REAL ::  ansx = -999.999, ansy = -999.999, gwid = 0.1, rlegfak = 1.5, &
+             sizex = 250.0, sizey = 40.0, texfac = 1.5
+
+    REAL, DIMENSION(:), ALLOCATABLE      ::  eta, ho, hu
+    REAL(spk), DIMENSION(:), ALLOCATABLE ::  xkoor, ykoor, zkoor  
+
+
+    NAMELIST /RAHMEN/  anzzeile, cranz, datleg, rtext, swap
+    NAMELIST /CROSS/   ansx, ansy, cucol, grid, gwid, klist, legpos, lstyle, &
+                       rand, rlegfak, sizex, sizey, texfac, &
+                       timodex, twoxa, twoya, xtext
+                       
 
 !
@@ -135,20 +154,20 @@
 !
 !-- Only certain files are allowed to be re-opened
-!-- NOTE: some of the other files perhaps also could be re-opened, but it has not been checked so
-!-- far, if it works!
+!-- NOTE: some of the other files perhaps also could be re-opened, but it
+!--       has not been checked so far, if it works!
     IF ( openfile(file_id)%opened_before )  THEN
        SELECT CASE ( file_id )
-          CASE ( 13, 14, 21, 22, 23, 80, 85, 117 )
-             IF ( file_id == 14  .AND.  openfile(file_id)%opened_before )  THEN
-                message_string = 're-open of unit ' // '14 is not verified. Please check results!'
-                CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )
-             ENDIF
-
+          CASE ( 14, 21, 22, 23, 80:85 )
+             IF ( file_id == 14 .AND. openfile(file_id)%opened_before )  THEN
+                IF ( myid == 0 )  PRINT*, '+++ check_open: re-open of unit ', &
+                                   ' 14 is not verified. Please check results!'
+             ENDIF
+             CONTINUE
           CASE DEFAULT
-             WRITE( message_string, * ) 're-opening of file-id ', file_id, ' is not allowed'
-             CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )
-
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ check_open: re-opening of file-id ', file_id, &
+                        ' is not allowed'
+             ENDIF
              RETURN
-
        END SELECT
     ENDIF
@@ -158,38 +177,37 @@
     SELECT CASE ( file_id )
 
-       CASE ( 15, 16, 17, 18, 19, 50:59, 104:105, 107, 109, 117 )
+       CASE ( 15, 16, 17, 18, 19, 40:49, 50:59, 81:84, 101:107, 109, 111:113, &
+              116 )
 
           IF ( myid /= 0 )  THEN
-             WRITE( message_string, * ) 'opening file-id ', file_id, ' not allowed for PE ', myid
-             CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
-          ENDIF
-
-       CASE ( 101:103, 106, 111:113, 116, 201:200+2*max_masks )
-
-          IF ( netcdf_data_format < 5 )  THEN
-
+             PRINT*,'+++ check_open: opening file-id ',file_id, &
+                    ' not allowed for PE ',myid
+#if defined( __parallel )
+             CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+             CALL local_stop
+#endif
+          ENDIF
+
+       CASE ( 21, 22, 23 )
+
+          IF ( .NOT.  data_output_2d_on_each_pe )  THEN
              IF ( myid /= 0 )  THEN
-                WRITE( message_string, * ) 'opening file-id ', file_id, ' not allowed for PE ', myid
-                CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
-             ENDIF
-
-          ENDIF
-
-       CASE ( 21, 22, 23 )
-
-          IF ( .NOT. data_output_2d_on_each_pe )  THEN
-             IF ( myid /= 0 )  THEN
-                WRITE( message_string, * ) 'opening file-id ', file_id, ' not allowed for PE ', myid
-                CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
-             END IF
-          ENDIF
-
-       CASE ( 90:99 )
+                PRINT*,'+++ check_open: opening file-id ',file_id, &
+                       ' not allowed for PE ',myid
+#if defined( __parallel )
+                CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+                CALL local_stop
+#endif
+             ENDIF
+          ENDIF
+
+       CASE ( 27, 28, 29, 31, 32, 33, 71:73, 90:99 )
 
 !
 !--       File-ids that are used temporarily in other routines
-          WRITE( message_string, * ) 'opening file-id ', file_id,                                  &
-                                     ' is not allowed since it is used otherwise'
-          CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 )
+          PRINT*,'+++ check_open: opening file-id ',file_id, &
+                 ' is not allowed since it is used otherwise'
 
     END SELECT
@@ -200,48 +218,20 @@
 
        CASE ( 11 )
-!
-!--       Read the parameter file. Therefore, inquire whether the file exist or not. This is
-!--       required for the ocean-atmoshere coupling. For an ocean precursor run palmrun provides a
-!--       PARIN_O file instead of a PARIN file. Actually this should be considered in coupling_char,
-!--       however, in pmc_init the parameter file is already opened to read the nesting parameters
-!--       and decide whether it is a nested run or not, but coupling_char is still not set at that
-!--       moment (must be set after the nesting setup is read).
-!--       This, however, leads to the situation that for ocean precursor runs PARIN is not available
-!--       and the run crashes. Thus, if the file is not there, PARIN_O will be read. An ocean
-!--       precursor run will be the only situation where this can happen.
-          INQUIRE( FILE='PARIN' // TRIM( coupling_char ), EXIST=file_exist )
-
-          IF ( file_exist )  THEN
-             filename = 'PARIN' // TRIM( coupling_char )
-          ELSE
-             filename = 'PARIN_O'
-          ENDIF
-
-          OPEN ( 11, FILE=TRIM( filename ), FORM='FORMATTED', STATUS='OLD', IOSTAT=ioerr )
-
-          IF ( ioerr /= 0 )  THEN
-             message_string = 'namelist file "PARIN' // TRIM( coupling_char ) //                   &
-                              '"  or "PARIN_O" not found!' //                                      &
-                              '&Please have a look at the online description of the ' //           &
-                              'error message for further hints.'
-             CALL message( 'check_open', 'PA0661', 3, 2, 0, 6, 1 )
-          ENDIF
+
+          OPEN ( 11, FILE='PARIN', FORM='FORMATTED', STATUS='OLD' )
 
        CASE ( 13 )
 
           IF ( myid_char == '' )  THEN
-             OPEN ( 13, FILE='BININ' // TRIM( coupling_char ) // myid_char, FORM='UNFORMATTED',    &
+             OPEN ( 13, FILE='BININ'//myid_char, FORM='UNFORMATTED', &
                         STATUS='OLD' )
           ELSE
-!
-!--          First opening of unit 13 openes file _000000 on all PEs because only this file contains
-!--          the global variables.
-             IF ( .NOT. openfile(file_id)%opened_before )  THEN
-                OPEN ( 13, FILE='BININ' // TRIM( coupling_char ) // '/_000000', FORM='UNFORMATTED',&
-                           STATUS='OLD' )
-             ELSE
-                OPEN ( 13, FILE='BININ' // TRIM( coupling_char ) // '/' // myid_char,              &
-                           FORM='UNFORMATTED', STATUS='OLD' )
-             ENDIF
+#if defined( __t3eh ) || defined( __t3eb ) || defined( __t3ej5 )
+!
+!--          Declare a cache layer for faster I/O
+             CALL ASNUNIT ( 13, '-F cachea:512:1:1', ierr1 )
+#endif
+             OPEN ( 13, FILE='BININ/'//myid_char, FORM='UNFORMATTED', &
+                        STATUS='OLD' )
           ENDIF
 
@@ -249,85 +239,150 @@
 
           IF ( myid_char == '' )  THEN
-             OPEN ( 14, FILE='BINOUT' // TRIM( coupling_char ) // myid_char, FORM='UNFORMATTED',   &
+             OPEN ( 14, FILE='BINOUT'//myid_char, FORM='UNFORMATTED', &
                         POSITION='APPEND' )
           ELSE
              IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
-                CALL local_system( 'mkdir  BINOUT' // TRIM( coupling_char ) )
+                CALL local_system( 'mkdir  BINOUT' )
              ENDIF
 #if defined( __parallel )
 !
-!--          Set a barrier in order to allow that all other processors in the directory created by
-!--          PE0 can open their file
+!--          Set a barrier in order to allow that all other processors in the 
+!--          directory created by PE0 can open their file
              CALL MPI_BARRIER( comm2d, ierr )
 #endif
-             ioerr = 1
-             DO WHILE ( ioerr /= 0 )
-                OPEN ( 14, FILE='BINOUT' // TRIM(coupling_char)// '/' // myid_char,                &
-                           FORM='UNFORMATTED', IOSTAT=ioerr )
-                IF ( ioerr /= 0 )  THEN
-                   WRITE( 9, * )  '*** could not open "BINOUT' //                                  &
-                                  TRIM(coupling_char) // '/' // myid_char //                       &
-                                  '"! Trying again in 1 sec.'
-                   CALL fortran_sleep( 1 )
-                ENDIF
+#if defined( __t3eh ) || defined( __t3eb ) || defined( __t3ej5 )
+!
+!--          Declare a cache layer for faster I/O
+             CALL ASNUNIT ( 14, '-F cachea:512:1:1', ierr1 )
+#endif
+             OPEN ( 14, FILE='BINOUT/'//myid_char_14, FORM='UNFORMATTED', &
+                        POSITION='APPEND' )
+          ENDIF
+
+       CASE ( 15 )
+
+          OPEN ( 15, FILE='RUN_CONTROL', FORM='FORMATTED' )
+
+       CASE ( 16 )
+
+          OPEN ( 16, FILE='LIST_PROFIL', FORM='FORMATTED' )
+
+       CASE ( 17 )
+
+          OPEN ( 17, FILE='LIST_PROFIL_1D', FORM='FORMATTED' )
+
+       CASE ( 18 )
+
+          OPEN ( 18, FILE='CPU_MEASURES', FORM='FORMATTED' )
+
+       CASE ( 19 )
+
+          OPEN ( 19, FILE='HEADER', FORM='FORMATTED' )
+
+       CASE ( 20 )
+
+          IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
+             CALL local_system( 'mkdir  DATA_LOG' )
+          ENDIF
+          IF ( myid_char == '' )  THEN
+             OPEN ( 20, FILE='DATA_LOG/_0000', FORM='UNFORMATTED', &
+                        POSITION='APPEND' )
+          ELSE
+#if defined( __parallel )
+!
+!--          Set a barrier in order to allow that all other processors in the 
+!--          directory created by PE0 can open their file
+             CALL MPI_BARRIER( comm2d, ierr )
+#endif
+             OPEN ( 20, FILE='DATA_LOG/'//myid_char, FORM='UNFORMATTED', &
+                        POSITION='APPEND' )
+          ENDIF
+
+       CASE ( 21 )
+
+          IF ( data_output_2d_on_each_pe )  THEN
+             OPEN ( 21, FILE='PLOT2D_XY'//myid_char, FORM='UNFORMATTED', &
+                        POSITION='APPEND' )
+          ELSE
+             OPEN ( 21, FILE='PLOT2D_XY', FORM='UNFORMATTED', &
+                        POSITION='APPEND' )
+          ENDIF
+
+          IF ( myid == 0  .AND.  .NOT. openfile(file_id)%opened_before )  THEN
+!
+!--          Output for combine_plot_fields
+             IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
+                WRITE (21)  -1, nx+1, -1, ny+1    ! total array size
+                WRITE (21)   0, nx+1,  0, ny+1    ! output part
+             ENDIF
+!
+!--          Determine and write ISO2D coordiante header
+             ALLOCATE( eta(0:ny+1), ho(0:nx+1), hu(0:nx+1) )
+             hu = 0.0
+             ho = (ny+1) * dy
+             DO  i = 1, ny
+                eta(i) = REAL( i ) / ( ny + 1.0 )
              ENDDO
-
-          ENDIF
-
-       CASE ( 15 )
-
-          OPEN ( 15, FILE='RUN_CONTROL' // TRIM( coupling_char ), FORM='FORMATTED' )
-
-       CASE ( 16 )
-
-          OPEN ( 16, FILE='LIST_PROFIL' // TRIM( coupling_char ), FORM='FORMATTED' )
-
-       CASE ( 17 )
-
-          OPEN ( 17, FILE='LIST_PROFIL_1D' // TRIM( coupling_char ), FORM='FORMATTED' )
-
-       CASE ( 18 )
-
-          OPEN ( 18, FILE='CPU_MEASURES' // TRIM( coupling_char ), FORM='FORMATTED' )
-
-       CASE ( 19 )
-
-          OPEN ( 19, FILE='HEADER' // TRIM( coupling_char ), FORM='FORMATTED' )
-
-       CASE ( 20 )
-
-          IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
-             CALL local_system( 'mkdir  DATA_LOG' // TRIM( coupling_char ) )
-          ENDIF
-          IF ( myid_char == '' )  THEN
-             OPEN ( 20, FILE='DATA_LOG' // TRIM( coupling_char ) // '/_000000', FORM='UNFORMATTED',&
-                        POSITION='APPEND' )
-          ELSE
-#if defined( __parallel )
-!
-!--          Set a barrier in order to allow that all other processors in the directory created by
-!--          PE0 can open their file
-             CALL MPI_BARRIER( comm2d, ierr )
-#endif
-             ioerr = 1
-             DO WHILE ( ioerr /= 0 )
-                OPEN ( 20, FILE='DATA_LOG' // TRIM( coupling_char ) // '/' // myid_char,           &
-                           FORM='UNFORMATTED', POSITION='APPEND', IOSTAT=ioerr )
-                IF ( ioerr /= 0 )  THEN
-                   WRITE( 9, * )  '*** could not open "DATA_LOG' // TRIM( coupling_char ) // '/' //&
-                                   myid_char // '"! Trying again in 1 sec.'
-                   CALL fortran_sleep( 1 )
-                ENDIF
+             eta(0)    = 0.0
+             eta(ny+1) = 1.0
+
+             WRITE (21)  dx,eta,hu,ho
+             DEALLOCATE( eta, ho, hu )
+
+!
+!--          Create output file for local parameters
+             IF ( iso2d_output )  THEN
+                OPEN ( 27, FILE='PLOT2D_XY_LOCAL', FORM='FORMATTED', &
+                           DELIM='APOSTROPHE' )
+                openfile(27)%opened = .TRUE.
+             ENDIF
+
+          ENDIF
+
+       CASE ( 22 )
+
+          IF ( data_output_2d_on_each_pe )  THEN
+             OPEN ( 22, FILE='PLOT2D_XZ'//myid_char, FORM='UNFORMATTED', &
+                        POSITION='APPEND' )
+          ELSE
+             OPEN ( 22, FILE='PLOT2D_XZ', FORM='UNFORMATTED', &
+                        POSITION='APPEND' )
+          ENDIF
+
+          IF ( myid == 0  .AND.  .NOT. openfile(file_id)%opened_before )  THEN
+!
+!--          Output for combine_plot_fields
+             IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
+                WRITE (22)  -1, nx+1, 0, nz+1    ! total array size
+                WRITE (22)   0, nx+1, 0, nz+1    ! output part
+             ENDIF
+!
+!--          Determine and write ISO2D coordiante header
+             ALLOCATE( eta(0:nz+1), ho(0:nx+1), hu(0:nx+1) )
+             hu = 0.0
+             ho = zu(nz+1)
+             DO  i = 1, nz
+                eta(i) = REAL( zu(i) ) / zu(nz+1)
              ENDDO
-
-          ENDIF
-
-       CASE ( 21 )
+             eta(0)    = 0.0
+             eta(nz+1) = 1.0
+
+             WRITE (22)  dx,eta,hu,ho
+             DEALLOCATE( eta, ho, hu )
+!
+!--          Create output file for local parameters
+             OPEN ( 28, FILE='PLOT2D_XZ_LOCAL', FORM='FORMATTED', &
+                        DELIM='APOSTROPHE' )
+             openfile(28)%opened = .TRUE.
+
+          ENDIF
+
+       CASE ( 23 )
 
           IF ( data_output_2d_on_each_pe )  THEN
-             OPEN ( 21, FILE='PLOT2D_XY' // TRIM( coupling_char ) // myid_char, FORM='UNFORMATTED',&
-                        POSITION='APPEND' )
-          ELSE
-             OPEN ( 21, FILE='PLOT2D_XY' // TRIM( coupling_char ), FORM='UNFORMATTED',             &
+             OPEN ( 23, FILE='PLOT2D_YZ'//myid_char, FORM='UNFORMATTED', &
+                        POSITION='APPEND' )
+          ELSE
+             OPEN ( 23, FILE='PLOT2D_YZ', FORM='UNFORMATTED', &
                         POSITION='APPEND' )
           ENDIF
@@ -335,111 +390,27 @@
           IF ( myid == 0  .AND.  .NOT. openfile(file_id)%opened_before )  THEN
 !
-!--          Write index bounds of total domain for combine_plot_fields
+!--          Output for combine_plot_fields
              IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
-                WRITE (21)   0, nx,  0, ny
-             ENDIF
-
-          ENDIF
-
-       CASE ( 22 )
-
-          IF ( data_output_2d_on_each_pe )  THEN
-             OPEN ( 22, FILE='PLOT2D_XZ' // TRIM( coupling_char ) // myid_char, FORM='UNFORMATTED',&
-                        POSITION='APPEND' )
-          ELSE
-             OPEN ( 22, FILE='PLOT2D_XZ' // TRIM( coupling_char ), FORM='UNFORMATTED',             &
-                        POSITION='APPEND' )
-          ENDIF
-
-          IF ( myid == 0  .AND.  .NOT. openfile(file_id)%opened_before )  THEN
-!
-!--          Write index bounds of total domain for combine_plot_fields
-             IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
-                WRITE (22)   0, nx, 0, nz+1    ! output part
-             ENDIF
-
-          ENDIF
-
-       CASE ( 23 )
-
-          IF ( data_output_2d_on_each_pe )  THEN
-             OPEN ( 23, FILE='PLOT2D_YZ' // TRIM( coupling_char ) // myid_char, FORM='UNFORMATTED',&
-                        POSITION='APPEND' )
-          ELSE
-             OPEN ( 23, FILE='PLOT2D_YZ' // TRIM( coupling_char ), FORM='UNFORMATTED',             &
-                        POSITION='APPEND' )
-          ENDIF
-
-          IF ( myid == 0  .AND.  .NOT. openfile(file_id)%opened_before )  THEN
-!
-!--          Write index bounds of total domain for combine_plot_fields
-             IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
-                WRITE (23)   0, ny, 0, nz+1    ! output part
-             ENDIF
-
-          ENDIF
-
-       CASE ( 25 )
-!
-!--       Binary files for surface data
-          ! OPEN ( 25, FILE='SURFACE_DATA_BIN' // TRIM( coupling_char ) // myid_char,               &
-          !            FORM='UNFORMATTED', POSITION='APPEND' )
-
-          IF ( myid_char == '' )  THEN
-             OPEN ( 25, FILE='SURFACE_DATA_BIN' // TRIM( coupling_char ) // myid_char,             &
-                        FORM='UNFORMATTED', POSITION='APPEND' )
-          ELSE
-             IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
-                CALL local_system( 'mkdir  SURFACE_DATA_BIN' // TRIM( coupling_char ) )
-             ENDIF
-#if defined( __parallel )
-!
-!--          Set a barrier in order to allow that all other processors in the directory created by
-!--          PE0 can open their file
-             CALL MPI_BARRIER( comm2d, ierr )
-#endif
-             ioerr = 1
-             DO WHILE ( ioerr /= 0 )
-                OPEN ( 25, FILE='SURFACE_DATA_BIN' // TRIM(coupling_char) //  '/' // myid_char,    &
-                           FORM='UNFORMATTED', IOSTAT=ioerr )
-                IF ( ioerr /= 0 )  THEN
-                   WRITE( 9, * )  '*** could not open "SURFACE_DATA_BIN'// TRIM(coupling_char) //  &
-                                  '/' // myid_char // '"! Trying again in 1 sec.'
-                   CALL fortran_sleep( 1 )
-                ENDIF
+                WRITE (23)  -1, ny+1, 0, nz+1    ! total array size
+                WRITE (23)   0, ny+1, 0, nz+1    ! output part
+             ENDIF
+!
+!--          Determine and write ISO2D coordiante header
+             ALLOCATE( eta(0:nz+1), ho(0:ny+1), hu(0:ny+1) )
+             hu = 0.0
+             ho = zu(nz+1)
+             DO  i = 1, nz
+                eta(i) = REAL( zu(i) ) / zu(nz+1)
              ENDDO
-
-          ENDIF
-
-       CASE ( 26 )
-!
-!--       Binary files for averaged surface data
-          ! OPEN ( 26, FILE='SURFACE_DATA_AV_BIN' // TRIM( coupling_char ) // myid_char,            &
-          !        FORM='UNFORMATTED', POSITION='APPEND' )
-
-          IF ( myid_char == '' )  THEN
-             OPEN ( 26, FILE='SURFACE_DATA_AV_BIN' // TRIM( coupling_char ) // myid_char,          &
-                        FORM='UNFORMATTED', POSITION='APPEND' )
-          ELSE
-             IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
-                CALL local_system( 'mkdir  SURFACE_DATA_AV_BIN' // TRIM( coupling_char ) )
-             ENDIF
-#if defined( __parallel )
-!
-!--          Set a barrier in order to allow that all other processors in the directory created by
-!--          PE0 can open their file
-             CALL MPI_BARRIER( comm2d, ierr )
-#endif
-             ioerr = 1
-             DO WHILE ( ioerr /= 0 )
-                OPEN ( 26, FILE='SURFACE_DATA_AV_BIN' // TRIM( coupling_char ) // '/' // myid_char,&
-                           FORM='UNFORMATTED', IOSTAT=ioerr )
-                IF ( ioerr /= 0 )  THEN
-                   WRITE( 9, * )  '*** could not open "SURFACE_DATA_AV_BIN' //                     &
-                                  TRIM( coupling_char ) // '/' // myid_char //                     &
-                                  '"! Trying again in 1 sec.'
-                   CALL fortran_sleep( 1 )
-                ENDIF
-             ENDDO
+             eta(0)    = 0.0
+             eta(nz+1) = 1.0
+
+             WRITE (23)  dx,eta,hu,ho
+             DEALLOCATE( eta, ho, hu )
+!
+!--          Create output file for local parameters
+             OPEN ( 29, FILE='PLOT2D_YZ_LOCAL', FORM='FORMATTED', &
+                        DELIM='APOSTROPHE' )
+             openfile(29)%opened = .TRUE.
 
           ENDIF
@@ -447,34 +418,272 @@
        CASE ( 30 )
 
-          OPEN ( 30, FILE='PLOT3D_DATA' // TRIM( coupling_char ) // myid_char, FORM='UNFORMATTED' )
-!
-!--       Specifications for combine_plot_fields
+
+#if defined( __t3eb ) || defined( __t3eh ) || defined( __t3ej5 )
+!
+!--       In case of active data compression 32Bit integer output
+          IF ( do3d_compress )  THEN
+             CALL ASNUNIT( 30, '-F f77 -N ieee_32', ierr1 )
+          ENDIF
+#endif
+
+          OPEN ( 30, FILE='PLOT3D_DATA'//myid_char, FORM='UNFORMATTED' )
+!
+!--       Write coordinate file for AVS
           IF ( myid == 0 )  THEN
 #if defined( __parallel )
-             WRITE ( 30 )  0, nx, 0, ny, 0, nz_do3d
-#endif
-          ENDIF
+!
+!--          Specifications for combine_plot_fields
+             IF ( .NOT. do3d_compress )  THEN
+                WRITE ( 30 )  -1,nx+1,-1,ny+1,0,nz_do3d
+                WRITE ( 30 )  0,nx+1,0,ny+1,0,nz_do3d
+             ENDIF
+#endif
+!
+!--          Write coordinate file for AVS:
+!--          First determine file names (including cyle numbers) of AVS files on
+!--          target machine (to which the files are to be transferred).
+!--          Therefore path information has to be obtained first.
+             IF ( avs_output )  THEN
+                CALL local_getenv( 'return_addres', 13, return_addres, iaddres )
+                CALL local_getenv( 'return_username', 15, return_usern, iusern )
+
+                OPEN ( 3, FILE='OUTPUT_FILE_CONNECTIONS', FORM='FORMATTED' )
+                DO  WHILE ( .NOT. avs_coor_file_found  .OR. &
+                            .NOT. avs_data_file_found )
+
+                   READ ( 3, '(A)', END=1 )  zeile
+
+                   SELECT CASE ( zeile(1:11) )
+
+                      CASE ( 'PLOT3D_COOR' )
+                         READ ( 3, '(A/A)' )  avs_coor_file_catalog, &
+                                              avs_coor_file_localname
+                         avs_coor_file_found = .TRUE.
+
+                      CASE ( 'PLOT3D_DATA' )
+                         READ ( 3, '(A/A)' )  avs_data_file_catalog, &
+                                              avs_data_file_localname
+                         avs_data_file_found = .TRUE.
+
+                      CASE DEFAULT
+                         READ ( 3, '(A/A)' )  zeile, zeile
+
+                   END SELECT
+
+                ENDDO
+!
+!--             Now the cycle numbers on the remote machine must be obtained
+!--             using batch_scp
+       1        CLOSE ( 3 )
+                IF ( .NOT. avs_coor_file_found  .OR. &
+                     .NOT. avs_data_file_found )  THEN
+                   PRINT*, '+++ check_open: no filename for AVS-data-file ', &
+                             'found in MRUN-config-file'
+                   PRINT*, '                filename in FLD-file set to ', &
+                             '"unknown"'
+
+                   avs_coor_file = 'unknown'
+                   avs_data_file = 'unknown'
+                ELSE
+                   get_filenames = .TRUE.
+                   IF ( TRIM( host ) == 'hpmuk'  .OR.  &
+                        TRIM( host ) == 'lcmuk' )  THEN
+                      batch_scp = '/home/raasch/pub/batch_scp'
+                   ELSEIF ( TRIM( host ) == 'nech' )  THEN
+                      batch_scp = '/ipf/b/b323011/pub/batch_scp'
+                   ELSEIF ( TRIM( host ) == 'ibmh'  .OR.  &
+                            TRIM( host ) == 'ibmb' )  THEN
+                      batch_scp = '/home/h/niksiraa/pub/batch_scp'
+                   ELSEIF ( TRIM( host ) == 't3eb' )  THEN
+                      batch_scp = '/home/nhbksira/pub/batch_scp'
+                   ELSE
+                      PRINT*,'+++ check_open: no path for batch_scp on host "',&
+                             TRIM( host ), '"'
+                      get_filenames = .FALSE.
+                   ENDIF
+
+                   IF ( get_filenames )  THEN
+!
+!--                   Determine the coordinate file name.
+!--                   /etc/passwd serves as Dummy-Datei, because it is not 
+!--                   really transferred.
+                      command = TRIM( batch_scp ) // ' -n -u ' // &
+                         return_usern(1:iusern) // ' ' // &
+                         return_addres(1:iaddres) // ' /etc/passwd "' // &
+                         TRIM( avs_coor_file_catalog ) // '" ' // &
+                         TRIM( avs_coor_file_localname ) // ' > REMOTE_FILENAME'
+
+                      CALL local_system( command )
+                      OPEN ( 3, FILE='REMOTE_FILENAME', FORM='FORMATTED' )
+                      READ ( 3, '(A)' )  avs_coor_file
+                      CLOSE ( 3 )
+!
+!--                   Determine the data file name
+                      command = TRIM( batch_scp ) // ' -n -u ' // &
+                         return_usern(1:iusern) // ' ' // &
+                         return_addres(1:iaddres) // ' /etc/passwd "' // &
+                         TRIM( avs_data_file_catalog ) // '" ' // &
+                         TRIM( avs_data_file_localname ) // ' > REMOTE_FILENAME'
+
+                      CALL local_system( command )
+                      OPEN ( 3, FILE='REMOTE_FILENAME', FORM='FORMATTED' )
+                      READ ( 3, '(A)' )  avs_data_file
+                      CLOSE ( 3 )
+
+                   ELSE
+
+                      avs_coor_file = 'unknown'
+                      avs_data_file = 'unknown'
+
+                   ENDIF
+
+                ENDIF
+
+!
+!--             Output of the coordinate file description for FLD-file
+                OPEN ( 33, FILE='PLOT3D_FLD_COOR', FORM='FORMATTED' )
+                openfile(33)%opened = .TRUE.
+                WRITE ( 33, 3300 )  TRIM( avs_coor_file ), &
+                                    TRIM( avs_coor_file ), (nx+2)*4, &
+                                    TRIM( avs_coor_file ), (nx+2)*4+(ny+2)*4
+            
+
+                ALLOCATE( xkoor(0:nx+1), ykoor(0:ny+1), zkoor(0:nz_do3d) )
+                DO  i = 0, nx+1
+                   xkoor(i) = i * dx
+                ENDDO
+                DO  j = 0, ny+1
+                   ykoor(j) = j * dy
+                ENDDO
+                DO  k = 0, nz_do3d
+                   zkoor(k) = zu(k)
+                ENDDO
+
+!
+!--             Create and write on AVS coordinate file
+                OPEN ( 31, FILE='PLOT3D_COOR', FORM='UNFORMATTED' )
+                openfile(31)%opened = .TRUE.
+
+                WRITE (31)  xkoor, ykoor, zkoor
+                DEALLOCATE( xkoor, ykoor, zkoor )
+
+!
+!--             Create FLD file (being written on in close_file)
+                OPEN ( 32, FILE='PLOT3D_FLD', FORM='FORMATTED' )
+                openfile(32)%opened = .TRUE.
+
+!
+!--             Create flag file for compressed 3D output,
+!--             influences output commands in mrun
+                IF ( do3d_compress )  THEN
+                   OPEN ( 3, FILE='PLOT3D_COMPRESSED', FORM='FORMATTED' )
+                   WRITE ( 3, '(1X)' )
+                   CLOSE ( 3 )
+                ENDIF 
+
+             ENDIF
+
+          ENDIF
+
+!
+!--       In case of data compression output of the coordinates of the
+!--       corresponding partial array of a PE only once at the top of the file
+          IF ( avs_output  .AND.  do3d_compress )  THEN
+             WRITE ( 30 )  nxl-1, nxr+1, nys-1, nyn+1, nzb, nz_do3d
+          ENDIF
+
+       CASE ( 40:49 )
+
+          IF ( statistic_regions == 0  .AND.  file_id == 40 )  THEN
+             suffix = ''
+          ELSE
+             WRITE ( suffix, '(''_'',I1)' )  file_id - 40
+          ENDIF
+          OPEN ( file_id, FILE='PLOT1D_DATA'//TRIM( suffix ), FORM='FORMATTED' )
+!
+!--       Write contents comments at the top of the file
+          WRITE ( file_id, 4000 )  TRIM( run_description_header ) // '    ' // &
+                                   TRIM( region( file_id - 40 ) )
+
+       CASE ( 50:59 )
+
+          IF ( statistic_regions == 0  .AND.  file_id == 50 )  THEN
+             suffix = ''
+          ELSE
+             WRITE ( suffix, '(''_'',I1)' )  file_id - 50
+          ENDIF
+          OPEN ( file_id, FILE='PLOTTS_DATA'//TRIM( suffix ), FORM='FORMATTED',&
+                          RECL=496 )
+!
+!--       Write PROFIL parameter file for output of time series
+!--       NOTE: To be on the safe side, this output is done at the beginning of
+!--             the model run (in case of collapse) and it is repeated in
+!--             close_file, then, however, with value ranges for the coordinate
+!--             systems
+!
+!--       Firstly determine the number of the coordinate systems to be drawn
+          cranz = 0
+          DO  j = 1, 10
+             IF ( cross_ts_number_count(j) /= 0 )  cranz = cranz+1
+          ENDDO
+          rtext = '\1.0 ' // TRIM( run_description_header ) // '    ' // &
+                  TRIM( region( file_id - 50 ) )
+!
+!--       Write RAHMEN parameter
+          OPEN ( 90, FILE='PLOTTS_PAR'//TRIM( suffix ), FORM='FORMATTED', &
+                     DELIM='APOSTROPHE' )
+          WRITE ( 90, RAHMEN )
+!
+!--       Determine and write CROSS parameters for the individual coordinate 
+!--       systems
+          DO  j = 1, 10
+             k = cross_ts_number_count(j)
+             IF ( k /= 0 )  THEN
+!
+!--             Store curve numbers, colours and line style
+                klist(1:k) = cross_ts_numbers(1:k,j)
+                klist(k+1:10) = 999999
+                cucol(1:k) = linecolors(1:k)
+                lstyle(1:k) = linestyles(1:k)
+!
+!--             Write CROSS parameter
+                WRITE ( 90, CROSS )
+
+             ENDIF
+          ENDDO
+
+          CLOSE ( 90 )
+!
+!--       Write all labels at the top of the data file, but only during the 
+!--       first run of a sequence of jobs. The following jobs copy the time
+!--       series data to the bottom of that file.
+          IF ( runnr == 0 )  THEN
+             WRITE ( file_id, 5000 )  TRIM( run_description_header ) // &
+                                      '    ' // TRIM( region( file_id - 50 ) )
+          ENDIF
+
 
        CASE ( 80 )
 
           IF ( myid_char == '' )  THEN
-             OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, FORM='FORMATTED',   &
+             OPEN ( 80, FILE='PARTICLE_INFOS'//myid_char, FORM='FORMATTED', &
                         POSITION='APPEND' )
           ELSE
              IF ( myid == 0  .AND.  .NOT. openfile(80)%opened_before )  THEN
-                CALL local_system( 'mkdir  PARTICLE_INFOS' // TRIM( coupling_char ) )
+                CALL local_system( 'mkdir  PARTICLE_INFOS' )
              ENDIF
 #if defined( __parallel )
 !
-!--          Set a barrier in order to allow that thereafter all other processors in the directory
-!--          created by PE0 can open their file.
-!--          WARNING: The following barrier will lead to hanging jobs, if check_open is first called
-!--                   from routine allocate_prt_memory!
+!--          Set a barrier in order to allow that thereafter all other
+!--          processors in the directory created by PE0 can open their file.
+!--          WARNING: The following barrier will lead to hanging jobs, if
+!--                   check_open is first called from routine
+!--                   allocate_prt_memory!
              IF ( .NOT. openfile(80)%opened_before )  THEN
                 CALL MPI_BARRIER( comm2d, ierr )
              ENDIF
 #endif
-             OPEN ( 80, FILE='PARTICLE_INFOS' // TRIM( coupling_char ) // '/' // myid_char,        &
-                        FORM='FORMATTED', POSITION='APPEND' )
+             OPEN ( 80, FILE='PARTICLE_INFOS/'//myid_char, FORM='FORMATTED', &
+                        POSITION='APPEND' )
           ENDIF
 
@@ -483,30 +692,41 @@
           ENDIF
 
+       CASE ( 81 )
+
+             OPEN ( 81, FILE='PLOTSP_X_PAR', FORM='FORMATTED', &
+                        DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
+
+       CASE ( 82 )
+
+             OPEN ( 82, FILE='PLOTSP_X_DATA', FORM='FORMATTED', &
+                        POSITION = 'APPEND' )
+
+       CASE ( 83 )
+
+             OPEN ( 83, FILE='PLOTSP_Y_PAR', FORM='FORMATTED', &
+                        DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
+
+       CASE ( 84 )
+
+             OPEN ( 84, FILE='PLOTSP_Y_DATA', FORM='FORMATTED', &
+                        POSITION='APPEND' )
+
        CASE ( 85 )
 
           IF ( myid_char == '' )  THEN
-             OPEN ( 85, FILE='PARTICLE_DATA' // TRIM(coupling_char) // myid_char,                  &
-                        FORM='UNFORMATTED', POSITION='APPEND' )
+             OPEN ( 85, FILE='PARTICLE_DATA'//myid_char, FORM='UNFORMATTED', &
+                        POSITION='APPEND' )
           ELSE
              IF ( myid == 0  .AND.  .NOT. openfile(85)%opened_before )  THEN
-                CALL local_system( 'mkdir  PARTICLE_DATA' // TRIM( coupling_char ) )
+                CALL local_system( 'mkdir  PARTICLE_DATA' )
              ENDIF
 #if defined( __parallel )
 !
-!--          Set a barrier in order to allow that thereafter all other processors in the directory
-!--          created by PE0 can open their file
+!--          Set a barrier in order to allow that thereafter all other
+!--          processors in the directory created by PE0 can open their file
              CALL MPI_BARRIER( comm2d, ierr )
 #endif
-             ioerr = 1
-             DO WHILE ( ioerr /= 0 )
-                OPEN ( 85, FILE='PARTICLE_DATA' // TRIM( coupling_char ) // '/' // myid_char,      &
-                           FORM='UNFORMATTED', POSITION='APPEND', IOSTAT=ioerr )
-                IF ( ioerr /= 0 )  THEN
-                   WRITE( 9, * )  '*** could not open "PARTICLE_DATA' // TRIM( coupling_char ) //  &
-                                  '/' // myid_char // '"! Trying again in 1 sec.'
-                   CALL fortran_sleep( 1 )
-                ENDIF
-             ENDDO
-
+             OPEN ( 85, FILE='PARTICLE_DATA/'//myid_char, FORM='UNFORMATTED', &
+                        POSITION='APPEND' )
           ENDIF
 
@@ -514,61 +734,12 @@
              WRITE ( 85 )  run_description_header
 !
-!--          Attention: change version number whenever the output format on unit 85 is changed (see
-!--                     also in routine lpm_data_output_particles)
-             rtext = 'data format version 3.1'
+!--          Attention: change version number whenever the output format on
+!--                     unit 85 is changed (see also in routine advec_particles)
+             rtext = 'data format version 3.0'
              WRITE ( 85 )  rtext
-             WRITE ( 85 )  number_of_particle_groups, max_number_of_particle_groups
+             WRITE ( 85 )  number_of_particle_groups, &
+                           max_number_of_particle_groups
              WRITE ( 85 )  particle_groups
-             WRITE ( 85 )  nxl, nxr, nys, nyn, nzb, nzt, nbgp
-          ENDIF
-
-!
-!--    File where sky-view factors and further required data is stored will be read
-       CASE ( 88 )
-
-          IF ( myid_char == '' )  THEN
-             OPEN ( 88, FILE='SVFIN' // TRIM( coupling_char ) // myid_char, FORM='UNFORMATTED',    &
-                        STATUS='OLD', IOSTAT=ioerr )
-          ELSE
-
-             OPEN ( 88, FILE='SVFIN' // TRIM( coupling_char ) // '/' // myid_char,                 &
-                        FORM='UNFORMATTED', STATUS='OLD', IOSTAT=ioerr )
-          ENDIF
-
-!
-!--    File where sky-view factors and further required data is stored will be created
-       CASE ( 89 )
-
-          IF ( myid_char == '' )  THEN
-             OPEN ( 89, FILE='SVFOUT' // TRIM( coupling_char ) // myid_char, FORM='UNFORMATTED',   &
-                        STATUS='NEW' )
-          ELSE
-             IF ( myid == 0  .AND.  .NOT. openfile(file_id)%opened_before )  THEN
-                CALL local_system( 'mkdir  SVFOUT' // TRIM( coupling_char ) )
-             ENDIF
-#if defined( __parallel )
-!
-!--          Set a barrier in order to allow that all other processors in the directory created by
-!--          PE0 can open their file
-             CALL MPI_BARRIER( comm2d, ierr )
-#endif
-             ioerr = 1
-             DO WHILE ( ioerr /= 0 )
-                OPEN ( 89, FILE='SVFOUT' // TRIM( coupling_char ) // '/' // myid_char,             &
-                           FORM='UNFORMATTED', STATUS='NEW', IOSTAT=ioerr )
-                IF ( ioerr /= 0 )  THEN
-                   WRITE( 9, * )  '*** could not open "SVFOUT' // TRIM( coupling_char ) // '/' //  &
-                                  myid_char // '"! Trying again in 1 sec.'
-                   CALL fortran_sleep( 1 )
-                ENDIF
-             ENDDO
-
-          ENDIF
-
-!
-!--    Progress file that is used by the PALM watchdog
-       CASE ( 117 )
-
-          OPEN ( 117, FILE='PROGRESS' // TRIM( coupling_char ), STATUS='REPLACE', FORM='FORMATTED' )
+          ENDIF
 
 #if defined( __netcdf )
@@ -577,22 +748,26 @@
 !--       Set filename depending on unit number
           IF ( file_id == 101 )  THEN
-             filename = 'DATA_2D_XY_NETCDF' // TRIM( coupling_char )
+             filename = 'DATA_2D_XY_NETCDF'
              av = 0
           ELSE
-             filename = 'DATA_2D_XY_AV_NETCDF' // TRIM( coupling_char )
+             filename = 'DATA_2D_XY_AV_NETCDF'
              av = 1
           ENDIF
 !
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its dimensions and variables match the actual run.
+!--       Inquire, if there is a NetCDF file from a previuos run. This should
+!--       be opened for extension, if its dimensions and variables match the
+!--       actual run.
           INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
           IF ( netcdf_extend )  THEN
 !
-!--          Open an existing netCDF file for output
-             CALL netcdf_open_write_file( filename, id_set_xy(av), .TRUE., 20 )
-!
-!--          Read header information and set all ids. If there is a mismatch between the previous
-!--          and the actual run, netcdf_extend is returned as .FALSE.
-             CALL netcdf_define_header( 'xy', netcdf_extend, av )
+!--          Open an existing NetCDF file for output 
+             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_xy(av) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 20 )
+!
+!--          Read header information and set all ids. If there is a mismatch
+!--          between the previuos and the actual run, netcdf_extend is returned
+!--          as .FALSE.
+             CALL define_netcdf_header( 'xy', netcdf_extend, av )
 
 !
@@ -600,34 +775,30 @@
              IF ( .NOT. netcdf_extend )  THEN
                 nc_stat = NF90_CLOSE( id_set_xy(av) )
-                CALL netcdf_handle_error( 'check_open', 21 )
-                IF ( myid == 0 )  CALL local_system( 'rm ' // TRIM( filename ) )
-#if defined( __parallel )
-!
-!--             Set a barrier in order to assure that PE0 deleted the old file before any other
-!--             processor tries to open a new file.
-!--             Barrier is only needed in case of parallel I/O
-                IF ( netcdf_data_format > 4 )  CALL MPI_BARRIER( comm2d, ierr )
-#endif
-             ENDIF
-
-          ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 21 )
+                CALL local_system( 'rm ' // TRIM( filename ) )
+             ENDIF
+
+          ENDIF          
 
           IF ( .NOT. netcdf_extend )  THEN
 !
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_xy(av), .TRUE., 22 )
-
+!--          Create a new NetCDF output file
+             IF ( netcdf_64bit )  THEN
+#if defined( __netcdf_64bit )
+                nc_stat = NF90_CREATE( filename,                               &
+                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+                                       id_set_xy(av) )
+#else
+                IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+                                               'offset allowed on this machine'
+                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xy(av) )
+#endif
+             ELSE
+                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xy(av) )
+             ENDIF
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 22 )
 !
 !--          Define the header
-             CALL netcdf_define_header( 'xy', netcdf_extend, av )
-
-!
-!--          In case of parallel netCDF output, create flag file which tells combine_plot_fields
-!--          that nothing is to do.
-             IF ( myid == 0  .AND.  netcdf_data_format > 4 )  THEN
-                OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XY' )
-                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
-                CLOSE( 99 )
-             ENDIF
+             CALL define_netcdf_header( 'xy', netcdf_extend, av )
 
           ENDIF
@@ -637,23 +808,26 @@
 !--       Set filename depending on unit number
           IF ( file_id == 102 )  THEN
-             filename = 'DATA_2D_XZ_NETCDF' // TRIM( coupling_char )
+             filename = 'DATA_2D_XZ_NETCDF'
              av = 0
           ELSE
-             filename = 'DATA_2D_XZ_AV_NETCDF' // TRIM( coupling_char )
+             filename = 'DATA_2D_XZ_AV_NETCDF'
              av = 1
           ENDIF
 !
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its dimensions and variables match the actual run.
+!--       Inquire, if there is a NetCDF file from a previuos run. This should
+!--       be opened for extension, if its dimensions and variables match the
+!--       actual run.
           INQUIRE( FILE=filename, EXIST=netcdf_extend )
 
           IF ( netcdf_extend )  THEN
 !
-!--          Open an existing netCDF file for output
-             CALL netcdf_open_write_file( filename, id_set_xz(av), .TRUE., 23 )
-!
-!--          Read header information and set all ids. If there is a mismatch between the previous
-!--          and the actual run, netcdf_extend is returned as .FALSE.
-             CALL netcdf_define_header( 'xz', netcdf_extend, av )
+!--          Open an existing NetCDF file for output 
+             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_xz(av) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 23 )
+!
+!--          Read header information and set all ids. If there is a mismatch
+!--          between the previuos and the actual run, netcdf_extend is returned
+!--          as .FALSE.
+             CALL define_netcdf_header( 'xz', netcdf_extend, av )
 
 !
@@ -661,34 +835,30 @@
              IF ( .NOT. netcdf_extend )  THEN
                 nc_stat = NF90_CLOSE( id_set_xz(av) )
-                CALL netcdf_handle_error( 'check_open', 24 )
-                IF ( myid == 0 )  CALL local_system( 'rm ' // TRIM( filename ) )
-#if defined( __parallel )
-!
-!--             Set a barrier in order to assure that PE0 deleted the old file before any other
-!--             processor tries to open a new file.
-!--             Barrier is only needed in case of parallel I/O
-                IF ( netcdf_data_format > 4 )  CALL MPI_BARRIER( comm2d, ierr )
-#endif
-             ENDIF
-
-          ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 24 )
+                CALL local_system( 'rm ' // TRIM( filename ) )
+             ENDIF
+
+          ENDIF          
 
           IF ( .NOT. netcdf_extend )  THEN
 !
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_xz(av), .TRUE., 25 )
-
+!--          Create a new NetCDF output file
+             IF ( netcdf_64bit )  THEN
+#if defined( __netcdf_64bit )
+                nc_stat = NF90_CREATE( filename,                               &
+                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+                                       id_set_xz(av) )
+#else
+                IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+                                               'offset allowed on this machine'
+                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xz(av) )
+#endif
+             ELSE
+                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xz(av) )
+             ENDIF
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 25 )
 !
 !--          Define the header
-             CALL netcdf_define_header( 'xz', netcdf_extend, av )
-
-!
-!--          In case of parallel netCDF output, create flag file which tells combine_plot_fields
-!--          that nothing is to do.
-             IF ( myid == 0  .AND.  netcdf_data_format > 4 )  THEN
-                OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XZ' )
-                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
-                CLOSE( 99 )
-             ENDIF
+             CALL define_netcdf_header( 'xz', netcdf_extend, av )
 
           ENDIF
@@ -698,23 +868,26 @@
 !--       Set filename depending on unit number
           IF ( file_id == 103 )  THEN
-             filename = 'DATA_2D_YZ_NETCDF' // TRIM( coupling_char )
+             filename = 'DATA_2D_YZ_NETCDF'
              av = 0
           ELSE
-             filename = 'DATA_2D_YZ_AV_NETCDF' // TRIM( coupling_char )
+             filename = 'DATA_2D_YZ_AV_NETCDF'
              av = 1
           ENDIF
 !
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its dimensions and variables match the actual run.
+!--       Inquire, if there is a NetCDF file from a previuos run. This should
+!--       be opened for extension, if its dimensions and variables match the
+!--       actual run.
           INQUIRE( FILE=filename, EXIST=netcdf_extend )
 
           IF ( netcdf_extend )  THEN
 !
-!--          Open an existing netCDF file for output
-             CALL netcdf_open_write_file( filename, id_set_yz(av), .TRUE., 26 )
-!
-!--          Read header information and set all ids. If there is a mismatch between the previous
-!--          and the actual run, netcdf_extend is returned as .FALSE.
-             CALL netcdf_define_header( 'yz', netcdf_extend, av )
+!--          Open an existing NetCDF file for output 
+             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_yz(av) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 26 )
+!
+!--          Read header information and set all ids. If there is a mismatch
+!--          between the previuos and the actual run, netcdf_extend is returned
+!--          as .FALSE.
+             CALL define_netcdf_header( 'yz', netcdf_extend, av )
 
 !
@@ -722,34 +895,30 @@
              IF ( .NOT. netcdf_extend )  THEN
                 nc_stat = NF90_CLOSE( id_set_yz(av) )
-                CALL netcdf_handle_error( 'check_open', 27 )
-                IF ( myid == 0 )  CALL local_system( 'rm ' // TRIM( filename ) )
-#if defined( __parallel )
-!
-!--             Set a barrier in order to assure that PE0 deleted the old file before any other
-!--             processor tries to open a new file.
-!--             Barrier is only needed in case of parallel I/O
-                IF ( netcdf_data_format > 4 )  CALL MPI_BARRIER( comm2d, ierr )
-#endif
-             ENDIF
-
-          ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 27 )
+                CALL local_system( 'rm ' // TRIM( filename ) )
+             ENDIF
+
+          ENDIF          
 
           IF ( .NOT. netcdf_extend )  THEN
 !
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_yz(av), .TRUE., 28 )
-
+!--          Create a new NetCDF output file
+             IF ( netcdf_64bit )  THEN
+#if defined( __netcdf_64bit )
+                nc_stat = NF90_CREATE( filename,                               &
+                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET), &
+                                       id_set_yz(av) )
+#else
+                IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+                                               'offset allowed on this machine'
+                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_yz(av) )
+#endif
+             ELSE
+                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_yz(av) )
+             ENDIF
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 28 )
 !
 !--          Define the header
-             CALL netcdf_define_header( 'yz', netcdf_extend, av )
-
-!
-!--          In case of parallel netCDF output, create flag file which tells combine_plot_fields
-!--          that nothing is to do.
-             IF ( myid == 0  .AND.  netcdf_data_format > 4 )  THEN
-                OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_YZ' )
-                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
-                CLOSE( 99 )
-             ENDIF
+             CALL define_netcdf_header( 'yz', netcdf_extend, av )
 
           ENDIF
@@ -757,20 +926,18 @@
        CASE ( 104 )
 !
-!--       Set filename
-          filename = 'DATA_1D_PR_NETCDF' // TRIM( coupling_char )
-
-!
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its variables match the actual run.
-          INQUIRE( FILE=filename, EXIST=netcdf_extend )
+!--       Inquire, if there is a NetCDF file from a previuos run. This should
+!--       be opened for extension, if its variables match the actual run.
+          INQUIRE( FILE='DATA_1D_PR_NETCDF', EXIST=netcdf_extend )
 
           IF ( netcdf_extend )  THEN
 !
-!--          Open an existing netCDF file for output
-             CALL netcdf_open_write_file( filename, id_set_pr, .FALSE., 29 )
-!
-!--          Read header information and set all ids. If there is a mismatch between the previous
-!--          and the actual run, netcdf_extend is returned as .FALSE.
-             CALL netcdf_define_header( 'pr', netcdf_extend, 0 )
+!--          Open an existing NetCDF file for output 
+             nc_stat = NF90_OPEN( 'DATA_1D_PR_NETCDF', NF90_WRITE, id_set_pr )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 29 )
+!
+!--          Read header information and set all ids. If there is a mismatch
+!--          between the previuos and the actual run, netcdf_extend is returned
+!--          as .FALSE.
+             CALL define_netcdf_header( 'pr', netcdf_extend, 0 )
 
 !
@@ -778,17 +945,32 @@
              IF ( .NOT. netcdf_extend )  THEN
                 nc_stat = NF90_CLOSE( id_set_pr )
-                CALL netcdf_handle_error( 'check_open', 30 )
-                CALL local_system( 'rm ' // TRIM( filename ) )
-             ENDIF
-
-          ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 30 )
+                CALL local_system( 'rm DATA_1D_PR_NETCDF' )
+             ENDIF
+
+          ENDIF          
 
           IF ( .NOT. netcdf_extend )  THEN
 !
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_pr, .FALSE., 31 )
+!--          Create a new NetCDF output file
+             IF ( netcdf_64bit )  THEN
+#if defined( __netcdf_64bit )
+                nc_stat = NF90_CREATE( 'DATA_1D_PR_NETCDF',                    &
+                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+                                       id_set_pr )
+#else
+                IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+                                               'offset allowed on this machine'
+                nc_stat = NF90_CREATE( 'DATA_1D_PR_NETCDF', NF90_NOCLOBBER, &
+                                       id_set_pr )
+#endif
+             ELSE
+                nc_stat = NF90_CREATE( 'DATA_1D_PR_NETCDF', NF90_NOCLOBBER, &
+                                       id_set_pr )
+             ENDIF
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 31 )
 !
 !--          Define the header
-             CALL netcdf_define_header( 'pr', netcdf_extend, 0 )
+             CALL define_netcdf_header( 'pr', netcdf_extend, 0 )
 
           ENDIF
@@ -796,20 +978,18 @@
        CASE ( 105 )
 !
-!--       Set filename
-          filename = 'DATA_1D_TS_NETCDF' // TRIM( coupling_char )
-
-!
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its variables match the actual run.
-          INQUIRE( FILE=filename, EXIST=netcdf_extend )
+!--       Inquire, if there is a NetCDF file from a previuos run. This should
+!--       be opened for extension, if its variables match the actual run.
+          INQUIRE( FILE='DATA_1D_TS_NETCDF', EXIST=netcdf_extend )
 
           IF ( netcdf_extend )  THEN
 !
-!--          Open an existing netCDF file for output
-             CALL netcdf_open_write_file( filename, id_set_ts, .FALSE., 32 )
-!
-!--          Read header information and set all ids. If there is a mismatch between the previous
-!--          and the actual run, netcdf_extend is returned as .FALSE.
-             CALL netcdf_define_header( 'ts', netcdf_extend, 0 )
+!--          Open an existing NetCDF file for output 
+             nc_stat = NF90_OPEN( 'DATA_1D_TS_NETCDF', NF90_WRITE, id_set_ts )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 32 )
+!
+!--          Read header information and set all ids. If there is a mismatch
+!--          between the previuos and the actual run, netcdf_extend is returned
+!--          as .FALSE.
+             CALL define_netcdf_header( 'ts', netcdf_extend, 0 )
 
 !
@@ -817,17 +997,32 @@
              IF ( .NOT. netcdf_extend )  THEN
                 nc_stat = NF90_CLOSE( id_set_ts )
-                CALL netcdf_handle_error( 'check_open', 33 )
-                CALL local_system( 'rm ' // TRIM( filename ) )
-             ENDIF
-
-          ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 33 )
+                CALL local_system( 'rm DATA_1D_TS_NETCDF' )
+             ENDIF
+
+          ENDIF          
 
           IF ( .NOT. netcdf_extend )  THEN
 !
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_ts, .FALSE., 34 )
+!--          Create a new NetCDF output file
+             IF ( netcdf_64bit )  THEN
+#if defined( __netcdf_64bit )
+                nc_stat = NF90_CREATE( 'DATA_1D_TS_NETCDF',                    &
+                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+                                       id_set_ts )
+#else
+                IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+                                               'offset allowed on this machine'
+                nc_stat = NF90_CREATE( 'DATA_1D_TS_NETCDF', NF90_NOCLOBBER, &
+                                       id_set_ts )
+#endif
+             ELSE
+                nc_stat = NF90_CREATE( 'DATA_1D_TS_NETCDF', NF90_NOCLOBBER, &
+                                       id_set_ts )
+             ENDIF
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 34 )
 !
 !--          Define the header
-             CALL netcdf_define_header( 'ts', netcdf_extend, 0 )
+             CALL define_netcdf_header( 'ts', netcdf_extend, 0 )
 
           ENDIF
@@ -838,22 +1033,26 @@
 !--       Set filename depending on unit number
           IF ( file_id == 106 )  THEN
-             filename = 'DATA_3D_NETCDF' // TRIM( coupling_char )
+             filename = 'DATA_3D_NETCDF'
              av = 0
           ELSE
-             filename = 'DATA_3D_AV_NETCDF' // TRIM( coupling_char )
+             filename = 'DATA_3D_AV_NETCDF'
              av = 1
           ENDIF
 !
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its dimensions and variables match the actual run.
+!--       Inquire, if there is a NetCDF file from a previuos run. This should
+!--       be opened for extension, if its dimensions and variables match the
+!--       actual run.
           INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
           IF ( netcdf_extend )  THEN
 !
-!--          Open an existing netCDF file for output
-             CALL netcdf_open_write_file( filename, id_set_3d(av), .TRUE., 35 )
-!
-!--          Read header information and set all ids. If there is a mismatch between the previous
-!--          and the actual run, netcdf_extend is returned as .FALSE.
-             CALL netcdf_define_header( '3d', netcdf_extend, av )
+!--          Open an existing NetCDF file for output 
+             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_3d(av) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 35 )
+!
+!--          Read header information and set all ids. If there is a mismatch
+!--          between the previuos and the actual run, netcdf_extend is returned
+!--          as .FALSE.
+             CALL define_netcdf_header( '3d', netcdf_extend, av )
 
 !
@@ -861,34 +1060,30 @@
              IF ( .NOT. netcdf_extend )  THEN
                 nc_stat = NF90_CLOSE( id_set_3d(av) )
-                CALL netcdf_handle_error( 'check_open', 36 )
-                IF ( myid == 0 )  CALL local_system( 'rm ' // TRIM( filename ) )
-#if defined( __parallel )
-!
-!--             Set a barrier in order to assure that PE0 deleted the old file before any other
-!--             processor tries to open a new file.
-!--             Barrier is only needed in case of parallel I/O
-                IF ( netcdf_data_format > 4 )  CALL MPI_BARRIER( comm2d, ierr )
-#endif
-             ENDIF
-
-          ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 36 )
+                CALL local_system('rm ' // TRIM( filename ) )
+             ENDIF
+
+          ENDIF          
 
           IF ( .NOT. netcdf_extend )  THEN
 !
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_3d(av), .TRUE., 37 )
-
+!--          Create a new NetCDF output file
+             IF ( netcdf_64bit )  THEN
+#if defined( __netcdf_64bit )
+                nc_stat = NF90_CREATE( filename,                               &
+                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+                                       id_set_3d(av) )
+#else
+                IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+                                               'offset allowed on this machine'
+                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_3d(av) )
+#endif
+             ELSE
+                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_3d(av) )
+             ENDIF
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 37 )
 !
 !--          Define the header
-             CALL netcdf_define_header( '3d', netcdf_extend, av )
-
-!
-!--          In case of parallel netCDF output, create flag file which tells combine_plot_fields
-!--          that nothing is to do.
-             IF ( myid == 0  .AND.  netcdf_data_format > 4 )  THEN
-                OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_3D' )
-                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
-                CLOSE( 99 )
-             ENDIF
+             CALL define_netcdf_header( '3d', netcdf_extend, av )
 
           ENDIF
@@ -897,21 +1092,18 @@
        CASE ( 107 )
 !
-!--       Set filename
-          filename = 'DATA_1D_SP_NETCDF' // TRIM( coupling_char )
-
-!
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its variables match the actual run.
-          INQUIRE( FILE=filename, EXIST=netcdf_extend )
+!--       Inquire, if there is a NetCDF file from a previuos run. This should
+!--       be opened for extension, if its variables match the actual run.
+          INQUIRE( FILE='DATA_1D_SP_NETCDF', EXIST=netcdf_extend )
 
           IF ( netcdf_extend )  THEN
 !
-!--          Open an existing netCDF file for output
-             CALL netcdf_open_write_file( filename, id_set_sp, .FALSE., 38 )
-
-!
-!--          Read header information and set all ids. If there is a mismatch between the previous
-!--          and the actual run, netcdf_extend is returned as .FALSE.
-             CALL netcdf_define_header( 'sp', netcdf_extend, 0 )
+!--          Open an existing NetCDF file for output 
+             nc_stat = NF90_OPEN( 'DATA_1D_SP_NETCDF', NF90_WRITE, id_set_sp )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 38 )
+!
+!--          Read header information and set all ids. If there is a mismatch
+!--          between the previuos and the actual run, netcdf_extend is returned
+!--          as .FALSE.
+             CALL define_netcdf_header( 'sp', netcdf_extend, 0 )
 
 !
@@ -919,101 +1111,125 @@
              IF ( .NOT. netcdf_extend )  THEN
                 nc_stat = NF90_CLOSE( id_set_sp )
-                CALL netcdf_handle_error( 'check_open', 39 )
-                CALL local_system( 'rm ' // TRIM( filename ) )
-             ENDIF
-
-          ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 39 )
+                CALL local_system( 'rm DATA_1D_SP_NETCDF' )
+             ENDIF
+
+          ENDIF          
 
           IF ( .NOT. netcdf_extend )  THEN
 !
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_sp, .FALSE., 40 )
+!--          Create a new NetCDF output file
+             IF ( netcdf_64bit )  THEN
+#if defined( __netcdf_64bit )
+                nc_stat = NF90_CREATE( 'DATA_1D_SP_NETCDF',                    &
+                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+                                       id_set_sp )
+#else
+                IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+                                               'offset allowed on this machine'
+                nc_stat = NF90_CREATE( 'DATA_1D_SP_NETCDF', NF90_NOCLOBBER, &
+                                       id_set_sp )
+#endif
+             ELSE
+                nc_stat = NF90_CREATE( 'DATA_1D_SP_NETCDF', NF90_NOCLOBBER, &
+                                       id_set_sp )
+             ENDIF
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 40 )
 !
 !--          Define the header
-             CALL netcdf_define_header( 'sp', netcdf_extend, 0 )
-
-          ENDIF
-
-!
-!--     Currently disabled
-!       CASE ( 108 )
-
-!          IF ( myid_char == '' )  THEN
-!             filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char )
-!          ELSE
-!             filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' //   &
-!                        myid_char
-!          ENDIF
-!
-!--       Inquire, if there is a netCDF file from a previous run. This should
+             CALL define_netcdf_header( 'sp', netcdf_extend, 0 )
+
+          ENDIF
+
+
+       CASE ( 108 )
+
+          IF ( myid_char == '' )  THEN
+             filename = 'DATA_PRT_NETCDF'
+          ELSE
+             filename = 'DATA_PRT_NETCDF/' // myid_char
+          ENDIF
+!
+!--       Inquire, if there is a NetCDF file from a previuos run. This should
 !--       be opened for extension, if its variables match the actual run.
-!          INQUIRE( FILE=filename, EXIST=netcdf_extend )
-
-!          IF ( netcdf_extend )  THEN
-!
-!--          Open an existing netCDF file for output
-!             CALL netcdf_open_write_file( filename, id_set_prt, .FALSE., 41 )
+          INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+          IF ( netcdf_extend )  THEN
+!
+!--          Open an existing NetCDF file for output 
+             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_prt )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 41 )
 !
 !--          Read header information and set all ids. If there is a mismatch
-!--          between the previous and the actual run, netcdf_extend is returned
+!--          between the previuos and the actual run, netcdf_extend is returned
 !--          as .FALSE.
-!             CALL netcdf_define_header( 'pt', netcdf_extend, 0 )
+             CALL define_netcdf_header( 'pt', netcdf_extend, 0 )
 
 !
 !--          Remove the local file, if it can not be extended
-!             IF ( .NOT. netcdf_extend )  THEN
-!                nc_stat = NF90_CLOSE( id_set_prt )
-!                CALL netcdf_handle_error( 'check_open', 42 )
-!                CALL local_system( 'rm ' // TRIM( filename ) )
-!             ENDIF
-
-!          ENDIF
-
-!          IF ( .NOT. netcdf_extend )  THEN
+             IF ( .NOT. netcdf_extend )  THEN
+                nc_stat = NF90_CLOSE( id_set_prt )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 42 )
+                CALL local_system( 'rm ' // filename )
+             ENDIF
+
+          ENDIF          
+
+          IF ( .NOT. netcdf_extend )  THEN
 
 !
 !--          For runs on multiple processors create the subdirectory
-!             IF ( myid_char /= '' )  THEN
-!                IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  &
-!                THEN    ! needs modification in case of non-extendable sets
-!                   CALL local_system( 'mkdir  DATA_PRT_NETCDF' //              &
-!                                       TRIM( coupling_char ) // '/' )
-!                ENDIF
+             IF ( myid_char /= '' )  THEN
+                IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before ) &
+                THEN    ! needs modification in case of non-extendable sets
+                   CALL local_system( 'mkdir  DATA_PRT_NETCDF/' )
+                ENDIF
 #if defined( __parallel )
 !
 !--             Set a barrier in order to allow that all other processors in the
 !--             directory created by PE0 can open their file
-!                CALL MPI_BARRIER( comm2d, ierr )
-#endif
-!             ENDIF
-
-!
-!--          Create a new netCDF output file with requested netCDF format
-!             CALL netcdf_create_file( filename, id_set_prt, .FALSE., 43 )
+                CALL MPI_BARRIER( comm2d, ierr )
+#endif
+             ENDIF
+
+!
+!--          Create a new NetCDF output file
+             IF ( netcdf_64bit )  THEN
+#if defined( __netcdf_64bit )
+                nc_stat = NF90_CREATE( filename,                               &
+                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+                                       id_set_prt )
+#else
+                IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+                                               'offset allowed on this machine'
+                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_prt )
+#endif
+             ELSE
+                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_prt )
+             ENDIF
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 43 )
 
 !
 !--          Define the header
-!             CALL netcdf_define_header( 'pt', netcdf_extend, 0 )
-
-!          ENDIF
+             CALL define_netcdf_header( 'pt', netcdf_extend, 0 )
+
+          ENDIF
 
        CASE ( 109 )
 !
-!--       Set filename
-          filename = 'DATA_1D_SPTS_NETCDF' // TRIM( coupling_char )
-
-!
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its variables match the actual run.
-          INQUIRE( FILE=filename, EXIST=netcdf_extend )
+!--       Inquire, if there is a NetCDF file from a previuos run. This should
+!--       be opened for extension, if its variables match the actual run.
+          INQUIRE( FILE='DATA_1D_PTS_NETCDF', EXIST=netcdf_extend )
 
           IF ( netcdf_extend )  THEN
 !
-!--          Open an existing netCDF file for output
-             CALL netcdf_open_write_file( filename, id_set_pts, .FALSE., 393 )
-!
-!--          Read header information and set all ids. If there is a mismatch between the previous
-!--          and the actual run, netcdf_extend is returned as .FALSE.
-             CALL netcdf_define_header( 'ps', netcdf_extend, 0 )
+!--          Open an existing NetCDF file for output 
+             nc_stat = NF90_OPEN( 'DATA_1D_PTS_NETCDF', NF90_WRITE, id_set_pts )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 393 )
+!
+!--          Read header information and set all ids. If there is a mismatch
+!--          between the previuos and the actual run, netcdf_extend is returned
+!--          as .FALSE.
+             CALL define_netcdf_header( 'ps', netcdf_extend, 0 )
 
 !
@@ -1021,173 +1237,37 @@
              IF ( .NOT. netcdf_extend )  THEN
                 nc_stat = NF90_CLOSE( id_set_pts )
-                CALL netcdf_handle_error( 'check_open', 394 )
-                CALL local_system( 'rm ' // TRIM( filename ) )
-             ENDIF
-
-          ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 394 )
+                CALL local_system( 'rm DATA_1D_PTS_NETCDF' )
+             ENDIF
+
+          ENDIF          
 
           IF ( .NOT. netcdf_extend )  THEN
 !
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_pts, .FALSE., 395 )
+!--          Create a new NetCDF output file
+             IF ( netcdf_64bit )  THEN
+#if defined( __netcdf_64bit )
+                nc_stat = NF90_CREATE( 'DATA_1D_PTS_NETCDF',                   &
+                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+                                       id_set_pts )
+#else
+                IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+                                               'offset allowed on this machine'
+                nc_stat = NF90_CREATE( 'DATA_1D_PTS_NETCDF', NF90_NOCLOBBER, &
+                                       id_set_pts )
+#endif
+             ELSE
+                nc_stat = NF90_CREATE( 'DATA_1D_PTS_NETCDF', NF90_NOCLOBBER, &
+                                       id_set_pts )
+             ENDIF
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 395 )
 !
 !--          Define the header
-             CALL netcdf_define_header( 'ps', netcdf_extend, 0 )
-
-          ENDIF
-
-       CASE ( 118 )
-
-          IF ( myid == 0 )  THEN
-             filename = 'DATA_AGT_NETCDF'
-!
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its variables match the actual run.
-          INQUIRE( FILE=filename, EXIST=netcdf_extend )
-
-!
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_agt, .FALSE., 43 )
-
-!
-!--          Define the header
-             CALL netcdf_define_header( 'ag', netcdf_extend, 0 )
-          ENDIF
-
-!           IF ( netcdf_extend )  THEN
-! !
-! !--          Open an existing netCDF file for output
-!              CALL netcdf_open_write_file( filename, id_set_agt, .FALSE., 41 )
-! !
-! !--          Read header information and set all ids. If there is a mismatch
-! !--          between the previous and the actual run, netcdf_extend is returned
-! !--          as .FALSE.
-!              CALL netcdf_define_header( 'ag', netcdf_extend, 0 )
-!
-! !
-! !--          Remove the local file, if it can not be extended
-!              IF ( .NOT. netcdf_extend )  THEN
-!                 nc_stat = NF90_CLOSE( id_set_agt )
-!                 CALL netcdf_handle_error( 'check_open', 42 )
-!                 CALL local_system( 'rm ' // TRIM( filename ) )
-!              ENDIF
-!
-!           ENDIF
-
-          IF ( .NOT. netcdf_extend )  THEN
-
-!
-! !--          For runs on multiple processors create the subdirectory
-!              IF ( myid_char /= '' )  THEN
-!                 IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  &
-!                 THEN    ! needs modification in case of non-extendable sets
-!                    CALL local_system( 'mkdir  DATA_PRT_NETCDF' //              &
-!                                        TRIM( coupling_char ) // '/' )
-!                 ENDIF
-! #if defined( __parallel )
-! !
-! !--             Set a barrier in order to allow that all other processors in the
-! !--             directory created by PE0 can open their file
-!                 CALL MPI_BARRIER( comm2d, ierr )
-! #endif
-!              ENDIF
-
-          ENDIF
-
-
-!
-!--    nc-file for virtual flight measurements
-       CASE ( 199 )
-!
-!--       Set filename
-          filename = 'DATA_1D_FL_NETCDF' // TRIM( coupling_char )
-
-!
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its variables match the actual run.
-          INQUIRE( FILE=filename, EXIST=netcdf_extend )
-
-          IF ( netcdf_extend )  THEN
-!
-!--          Open an existing netCDF file for output
-             CALL netcdf_open_write_file( filename, id_set_fl, .FALSE., 532 )
-!
-!--          Read header information and set all ids. If there is a mismatch between the previous
-!--          and the actual run, netcdf_extend is returned as .FALSE.
-             CALL netcdf_define_header( 'fl', netcdf_extend, 0 )
-
-!
-!--          Remove the local file, if it can not be extended
-             IF ( .NOT. netcdf_extend )  THEN
-                nc_stat = NF90_CLOSE( id_set_fl )
-                CALL netcdf_handle_error( 'check_open', 533 )
-                CALL local_system( 'rm ' // TRIM( filename ) )
-             ENDIF
-
-          ENDIF
-
-          IF ( .NOT. netcdf_extend )  THEN
-!
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_fl, .FALSE., 534 )
-!
-!--          Define the header
-             CALL netcdf_define_header( 'fl', netcdf_extend, 0 )
-
-          ENDIF
-
-
-       CASE ( 201:200+2*max_masks )
-!
-!--       Set filename depending on unit number
-          IF ( file_id <= 200+max_masks )  THEN
-             mid = file_id - 200
-             WRITE ( mask_char,'(A2,I2.2)')  '_M', mid
-             filename = 'DATA_MASK_NETCDF' // TRIM( coupling_char ) // mask_char
-             av = 0
-          ELSE
-             mid = file_id - (200+max_masks)
-             WRITE ( mask_char,'(A2,I2.2)')  '_M', mid
-             filename = 'DATA_MASK_AV_NETCDF' // TRIM( coupling_char ) // mask_char
-             av = 1
-          ENDIF
-!
-!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
-!--       extension, if its dimensions and variables match the actual run.
-          INQUIRE( FILE=filename, EXIST=netcdf_extend )
-
-          IF ( netcdf_extend )  THEN
-!
-!--          Open an existing netCDF file for output
-             CALL netcdf_open_write_file( filename, id_set_mask(mid,av), .TRUE., 456 )
-!
-!--          Read header information and set all ids. If there is a mismatch between the previous
-!--          and the actual run, netcdf_extend is returned as .FALSE.
-             CALL netcdf_define_header( 'ma', netcdf_extend, file_id )
-
-!
-!--          Remove the local file, if it can not be extended
-             IF ( .NOT. netcdf_extend )  THEN
-                nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
-                CALL netcdf_handle_error( 'check_open', 457 )
-                CALL local_system('rm ' // TRIM( filename ) )
-             ENDIF
-
-          ENDIF
-
-          IF ( .NOT. netcdf_extend )  THEN
-!
-!--          Create a new netCDF output file with requested netCDF format
-             CALL netcdf_create_file( filename, id_set_mask(mid,av), .TRUE. , 458 )
-!
-!--          Define the header
-             CALL netcdf_define_header( 'ma', netcdf_extend, file_id )
-
-          ENDIF
-
-
+             CALL define_netcdf_header( 'ps', netcdf_extend, 0 )
+
+          ENDIF
 #else
 
-       CASE ( 101:109, 111:113, 116, 201:200+2*max_masks )
+       CASE ( 101:109, 111:113, 116 )
 
 !
@@ -1199,6 +1279,10 @@
        CASE DEFAULT
 
-          WRITE( message_string, * ) 'no OPEN-statement for file-id ', file_id
-          CALL message( 'check_open', 'PA0172', 2, 2, -1, 6, 1 )
+          PRINT*,'+++ check_open: no OPEN-statement for file-id ',file_id
+#if defined( __parallel )
+          CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+          CALL local_stop
+#endif
 
     END SELECT
@@ -1210,8 +1294,19 @@
 !
 !-- Formats
-8000 FORMAT (A/                                                                                    &
-             '  step    time    # of parts     lPE sent/recv  rPE sent/recv  ',                    &
-             'sPE sent/recv  nPE sent/recv    max # of parts  '/                                   &
-             109('-'))
+3300 FORMAT ('#'/                                                   &
+             'coord 1  file=',A,'  filetype=unformatted'/           &
+             'coord 2  file=',A,'  filetype=unformatted  skip=',I6/ &
+             'coord 3  file=',A,'  filetype=unformatted  skip=',I6/ &
+             '#')
+4000 FORMAT ('# ',A)
+5000 FORMAT ('# ',A/                                                          &
+             '#1 E'/'#2 E*'/'#3 dt'/'#4 u*'/'#5 th*'/'#6 umax'/'#7 vmax'/     &
+             '#8 wmax'/'#9 div_new'/'#10 div_old'/'#11 z_i_wpt'/'#12 z_i_pt'/ &
+             '#13 w*'/'#14 w''pt''0'/'#15 w''pt'''/'#16 wpt'/'#17 pt(0)'/     &
+             '#18 pt(zp)'/'#19 splptx'/'#20 splpty'/'#21 splptz')
+8000 FORMAT (A/                                                            &
+             '  step    time  # of parts   lPE sent/recv  rPE sent/recv  ',&
+             'sPE sent/recv  nPE sent/recv  max # of parts'/               &
+             103('-'))
 
  END SUBROUTINE check_open
Index: palm/trunk/SOURCE/check_parameters.f90
===================================================================
--- palm/trunk/SOURCE/check_parameters.f90	(revision 4901)
+++ palm/trunk/SOURCE/check_parameters.f90	(revision 1)
@@ -1,160 +1,141 @@
-!> @file check_parameters.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE check_parameters
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! number of allowed profiles increased from 400 to 500
-!
-! 4853 2021-01-25 07:56:09Z raasch
-! number of allowed profiles increased from 300 to 400
-!
-! 4844 2021-01-18 09:22:26Z raasch
-! size check for profile output added
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! allow prescribing initial uv_profiles AND geostrophic wind
-! by changing error message PA0347 to an informative message
-!
-! 4685 2020-09-18 11:49:50Z gronemeier
-! filter data_output_pr and data_output list for duplicate entries
-!
-! 4633 2020-08-05 14:21:14Z suehring
-! todo added
-!
-! 4565 2020-06-15 08:30:38Z oliver.maas
-! added check for pt_surface_heating_rate
-!
-! 4564 2020-06-12 14:03:36Z raasch
-! Vertical nesting method of Huq et al. (2019) removed
-!
-! 4562 2020-06-12 08:38:47Z raasch
-! bugfix: revised error message for exceeding allow number of time series
-!
-! 4559 2020-06-11 08:51:48Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4536 2020-05-17 17:24:13Z raasch
-! unneccessary query for restart data format removed
-!
-! 4534 2020-05-14 18:35:22Z raasch
-! adjustments for I/O on reduced number of cores using shared memory MPI
-!
-! 4514 2020-04-30 16:29:59Z suehring
-! Enable output of qsurf and ssurf
-!
-! 4513 2020-04-30 13:45:47Z raasch
-! unused modules removed
-!
-! 4511 2020-04-30 12:20:40Z raasch
-! call of chem_boundary_conds removed (respective settings are now done in the chemistry module)
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! check new restart_data_format parameters
-!
-! 4493 2020-04-10 09:49:43Z pavelkrc
-! Kolmogorov length scale eta added to profile output
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4392 2020-01-31 16:14:57Z pavelkrc
-! Some error numbers revised to prevent double usage
-!
-! 11:55:33Z oliver.maas
-! Checks for closed channel flow implemented
-!
-! 11:55:33Z oliver.maas
-! Move 2-m potential temperature output to diagnostic_output_quantities
-!
-! 11:55:33Z oliver.maas
-! removed message PA0421, concerning old parameter recycling_yshift
-!
-! 11:55:33Z oliver.maas
-! adjust message to the modified parameter recycling_yshift
-!
-! 11:55:33Z oliver.maas
-! Check if a cross section is specified if any output cross-section quantity
-! is given
-!
-! 11:55:33Z oliver.maas
-! Overwrite rotation_angle from namelist by value from static driver
-!
-! 11:55:33Z oliver.maas
-! removed conversion from recycle_absolute_quantities to raq, added check and
-! error message for correct input of recycling_method_for_thermodynamic_quantities
-!
-! 11:55:33Z oliver.maas
-! Corrected "Former revisions" section
-!
-! 11:55:33Z oliver.maas
-! bugfix error message: replaced PA184 by PA0184
-!
-! 11:55:33Z oliver.maas
-! added conversion from recycle_absolute_quantities to raq for recycling of
-! absolute quantities and added error message PA184 for not implemented quantities
-!
-! 4142 2019-08-05 12:38:31Z suehring
-! Consider spinup in number of output timesteps for averaged 2D output (merge
-! from branch resler).
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to
-! avoid runtime error (Loop variable has been modified) in time_integration
-!
-! 4048 2019-06-21 21:00:21Z knoop
-! Moved tcm_check_data_output to module_interface
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! Modularize diagnostic output
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! output of turbulence intensity added
-!
-! 3933 2019-04-25 12:33:20Z kanani
-! Alphabetical resorting in CASE, condense settings for theta_2m* into one IF clause
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction
-! of additional debug messages
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! trim added to avoid truncation compiler warnings
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! unused variables removed
-!
-! 3735 2019-02-12 09:52:40Z dom_dwd_user
-! Passing variable j (averaged output?) to
-! module_interface.f90:chem_check_data_output.
-!
-! 3705 2019-01-29 19:56:39Z suehring
-! bugfix: renamed thetav_t to vtheta_t
-!
-! 3702 2019-01-28 13:19:30Z gronemeier
-! most_method removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Formatting
-!
+! $Log: check_parameters.f90,v $
+! Revision 1.61  2006/08/04 14:20:25  raasch
+! do2d_unit and do3d_unit now defined as 2d-arrays, check of
+! use_upstream_for_tke, default value for dt_dopts,
+! generation of file header moved from routines palm and header to here
+!
+! Revision 1.60  2006/06/02 15:09:15  raasch
+! data_output_xy/xz/yz are set
+!
+! Revision 1.59  2006/03/03 15:55:34  letzel
+! Spelling inconsistency removed
+!
+! Revision 1.58  2006/03/03 08:50:08  raasch
+! Default setting of constant_heatflux now only depends on the value of
+! surface_heatflux again
+!
+! Revision 1.57  2006/02/27 10:16:44  letzel
+! Error removed in initialization of dt_averaging_input_pr
+!
+! Revision 1.56  2006/02/23 10:06:55  raasch
+! Volume flow conservation is not allowed with non-cyclic lateral boundaries,
+! calculation of nzb_diff moved to init_grid, the default setting of
+! constant_heatflux = .F. additionally requires a surface initial temperature
+! change /= 0, check of topography, dissipation_1d, mixing_length_1d,
+! check and setting of new data output steering parameters and user defined
+! output quantities,
+! ebene renamed section, pl1d_anz, plts_anz renamed dopr_n, dots_n,
+! plts, pl1d renamed data_output_ts/1d
+!
+! Revision 1.55  2005/12/06 16:39:34  raasch
+! Output of ql profile is allowed in case of using cloud droplets
+!
+! Revision 1.54  2005/06/30 11:27:33  steinfeld
+! Initialization of the profiles of the geostrophic wind components
+! ug and vg;
+! the usage of the geostrophic wind in a galilei transformation is
+! not allowed with a simultaneous specification of a baroclinicity
+!
+! Revision 1.53  2005/05/18 15:12:36  raasch
+! Check of data_output_format and netcdf precision,
+! abort if poisfft_hybrid is called in a non-parallel environment
+!
+! Revision 1.52  2005/04/23 09:04:10  raasch
+! fcl_factor renamed cfl_factor, default setting of outflow_damping_width
+! corrected, additional check for non-cyclic lateral boundary conditions
+!
+! Revision 1.51  2005/03/26 19:47:32  raasch
+! Check of bc_lr, bc_ns, km_damp_max, inflow_disturbance_begin,
+! inflow_disturbance_end, outflow_damping_width
+!
+! Revision 1.50  2004/04/30 11:20:27  raasch
+! Check of grid_matching, check of time series profiles modified,
+! impulse_advec renamed momentum_advec
+!
+! Revision 1.49  2004/01/28 15:04:56  raasch
+! Additional checks and settings for timestep schemes because of the
+! newly implemented Runge-Kutta schemes
+!
+! Revision 1.48  2003/04/17 07:07:43  raasch
+! Hybrid solver check in parallel environment only
+!
+! Revision 1.47  2003/04/16 09:43:20  raasch
+! Additional checks for hybrid solver and host, Monin Obukhov length added to
+! time series
+!
+! Revision 1.46  2003/03/31 15:43:19  raasch
+! Check for horizontal temperature flux profiles cleaned up
+!
+! Revision 1.45  2003/03/14 13:38:02  raasch
+! Random generator check included
+!
+! Revision 1.44  2003/03/12 16:23:10  raasch
+! Small checks for NEC and temperton-algorithm
+!
+! Revision 1.43  2002/12/19 14:04:26  raasch
+! Setting default values for termination_time_needed and check the
+! value for IBM-regatta, STOP statement replaced by call of subroutine
+! local_stop
+!
+! Revision 1.42  2002/09/12 13:02:25  raasch
+! Error in calculating initial pt and q profiles removed (array bound 10 in
+! *_ind arrays could be exceeded)
+!
+! Revision 1.41  2002/06/11 12:49:33  raasch
+! Hybrid solver allowed for solving the Poisson equation
+!
+! Revision 1.40  2002/05/02  18:48:56  18:48:56  raasch (Siegfried Raasch)
+! SELECT case of cross_normalized_x and ..y requires usage of TRIM-function
+! on IBM
+! 
+! Revision 1.39  2002/04/16 08:03:27  raasch
+! Parameters for scalar transport included, output of scalar profiles changed
+!
+! Revision 1.38  2001/11/28 09:48:32  schroeter
+! Profiles for horizontal heat fluxes and
+! flux divergences allowed (58-72)
+!
+! Revision 1.37  2001/09/04  11:58:55  11:58:55  raasch (Siegfried Raasch)
+! Profiles for vertical flux of resolved/subgrid scale energy and pressure
+! fluctuations allowed (#55-57)
+! 
+! Revision 1.36  2001/07/20 12:52:32  raasch
+! Multigrid method allowed for solving the Poisson equation
+!
+! Revision 1.35  2001/03/30 06:57:38  raasch
+! Asselin filter factor is set to 0, if Euler scheme is used,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.34  2001/02/09 07:04:45  raasch
+! Checking of boundary conditions for pt and q and their combination with
+! prescribed surface fluxes revised
+!
+! Revision 1.33  2001/01/29 12:23:31  raasch
+! New parameter passive_scalar is checked
+!
+! Revision 1.32  2001/01/25 06:55:37  raasch
+! New control-parameters fft_method and use_surface_fluxes are checked
+!
+! Revision 1.31  2000/04/18 11:19:43  schroeter
+! Bott-Chlond Advektionsschema nun auch fuer Rechnungen
+! mit Feuchte/Wolkenphysik zugelassen
+!
+! Revision 1.30  2000/04/13 13:28:56  schroeter
+! + initialize profiles of total water content
+! + check boundary conditions of total water content
+! + initialize output of cloud-physics-profiles
+!
+! Revision 1.29  2000/01/25  14:38:37  14:38:37  letzel (Marcus Letzel)
+! All comments translated into English
+! 
 ! Revision 1.1  1997/08/26 06:29:23  raasch
 ! Initial revision
@@ -163,373 +144,55 @@
 ! Description:
 ! ------------
-!> Check control parameters and deduce further quantities.
-!
-!> @todo Increase character length of unit and corresponding characters to LEN>=8 in order to allow
-!>       units like degree_C (05.08.2020)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE check_parameters
-
+! Check control parameters and deduce further quantities.
+!------------------------------------------------------------------------------!
 
     USE arrays_3d
-
-    USE basic_constants_and_equations_mod
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
+    USE constants
     USE control_parameters
-
     USE grid_variables
-
-    USE kinds
-
     USE indices
-
-    USE model_1d_mod,                                                                              &
-        ONLY:  damp_level_1d, damp_level_ind_1d
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_check_data_output,                                                 &
-               module_interface_check_data_output_pr,                                              &
-               module_interface_check_data_output_ts,                                              &
-               module_interface_check_parameters
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  init_model, input_pids_static, netcdf_data_input_check_dynamic,                     &
-               netcdf_data_input_check_static
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  do2d_unit, do3d_unit, dopr_unit, dots_label, dots_max, dots_num, dots_unit,         &
-               heatflux_output_unit, momentumflux_output_unit, netcdf_data_format,                 &
-               netcdf_data_format_string, waterflux_output_unit
-
-    USE particle_attributes,                                                                       &
-        ONLY:  particle_advection, use_sgs_for_particles
-
+    USE model_1d
+    USE netcdf_control
+    USE particle_attributes
     USE pegrid
-
-    USE pmc_interface,                                                                             &
-        ONLY:  cpl_id, nested_run
-
     USE profil_parameter
-
     USE statistics
-
-    USE subsidence_mod
-
     USE transpose_indices
 
     IMPLICIT NONE
 
-    CHARACTER (LEN=varnamelength)  ::  var           !< variable name
-    CHARACTER (LEN=7)   ::  unit                     !< unit of variable
-    CHARACTER (LEN=8)   ::  date                     !< current date string
-    CHARACTER (LEN=10)  ::  time                     !< current time string
-    CHARACTER (LEN=20)  ::  ensemble_string          !< string containing number of ensemble member
-    CHARACTER (LEN=15)  ::  nest_string              !< string containing id of nested domain
-    CHARACTER (LEN=40)  ::  coupling_string          !< string containing type of coupling
-    CHARACTER (LEN=100) ::  action                   !< flag string
-
-    CHARACTER (LEN=varnamelength), DIMENSION(:), ALLOCATABLE ::  data_output_filtered  !< filtered list of output variables
-
-    INTEGER(iwp) ::  i                               !< loop index
-    INTEGER(iwp) ::  ilen                            !< string length
-    INTEGER(iwp) ::  j                               !< loop index
-    INTEGER(iwp) ::  k                               !< loop index
-    INTEGER(iwp) ::  kk                              !< loop index
-    INTEGER(iwp) ::  mid                             !< masked output running index
-    INTEGER(iwp) ::  netcdf_data_format_save         !< initial value of netcdf_data_format
-    INTEGER(iwp) ::  position                        !< index position of string
-
-    LOGICAL     ::  found                            !< flag, true if output variable is already marked for averaging
-
-    REAL(wp)    ::  gradient                         !< local gradient
-#if defined( __parallel )
-    REAL(wp)    ::  dt_spinup_max                    !< maximum spinup timestep in nested domains
-    REAL(wp)    ::  remote = 0.0_wp                  !< MPI id of remote processor
-    REAL(wp)    ::  spinup_time_max                  !< maximum spinup time in nested domains
-    REAL(wp)    ::  time_to_be_simulated_from_reference_point  !< time to be simulated from reference point
-#endif
-
-
-    CALL location_message( 'checking parameters', 'start' )
-!
-!-- At first, check static and dynamic input for consistency.
-    CALL netcdf_data_input_check_dynamic
-    CALL netcdf_data_input_check_static
-!
-!-- Check for overlap combinations, which are not realized yet
-    IF ( transpose_compute_overlap  .AND. numprocs == 1 )  THEN
-          message_string = 'transpose-compute-overlap not implemented for single PE runs'
-          CALL message( 'check_parameters', 'PA0000', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check the coupling mode
-    IF ( coupling_mode /= 'uncoupled'            .AND.                                             &
-         coupling_mode /= 'precursor_atmos'      .AND.                                             &
-         coupling_mode /= 'precursor_ocean'      .AND.                                             &
-         coupling_mode /= 'atmosphere_to_ocean'  .AND.                                             &
-         coupling_mode /= 'ocean_to_atmosphere' )  THEN
-       message_string = 'illegal coupling mode: ' // TRIM( coupling_mode )
-       CALL message( 'check_parameters', 'PA0002', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check if humidity is set to .TRUE. in case of the atmospheric run (for coupled runs)
-    IF ( coupling_mode == 'atmosphere_to_ocean' .AND. .NOT. humidity) THEN
-       message_string = ' Humidity has to be set to .T. in the _p3d file ' //                      &
-                        'for coupled runs between ocean and atmosphere.'
-       CALL message( 'check_parameters', 'PA0476', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check and set the restart data format variables
-    IF ( TRIM( restart_data_format ) /= 'fortran_binary'  .AND.                                    &
-         TRIM( restart_data_format ) /= 'mpi'             .AND.                                    &
-         TRIM( restart_data_format ) /= 'mpi_shared_memory' )  THEN
-       message_string = 'illegal restart data format "' // TRIM( restart_data_format ) // '"'
-       CALL message( 'check_parameters', 'PA0724', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( TRIM( restart_data_format_input ) == 'undefined' )  THEN
-       restart_data_format_input = restart_data_format
-    ENDIF
-    IF ( TRIM( restart_data_format_output ) == 'undefined' )  THEN
-       restart_data_format_output = restart_data_format
-    ENDIF
-
-    IF ( TRIM( restart_data_format_input ) /= 'fortran_binary'  .AND.                              &
-         TRIM( restart_data_format_input ) /= 'mpi'             .AND.                              &
-         TRIM( restart_data_format_input ) /= 'mpi_shared_memory' )  THEN
-       message_string = 'illegal restart input data format "' //                                   &
-                        TRIM( restart_data_format_input ) // '"'
-       CALL message( 'check_parameters', 'PA0725', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( TRIM( restart_data_format_output ) /= 'fortran_binary'  .AND.                             &
-         TRIM( restart_data_format_output ) /= 'mpi'             .AND.                             &
-         TRIM( restart_data_format_output ) /= 'mpi_shared_memory' )  THEN
-       message_string = 'illegal restart output data format "' //                                  &
-                        TRIM( restart_data_format_output ) // '"'
-       CALL message( 'check_parameters', 'PA0726', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Set flag for including total domain boundaries in the restart data (MPI-IO) in case of
-!-- non-cyclic boundary conditions
-    include_total_domain_boundaries = .NOT. ( bc_lr_cyc  .AND.  bc_ns_cyc )
-
-!
-!-- Check dt_coupling, restart_time, dt_restart, end_time, dx, dy, nx and ny
-    IF ( coupling_mode /= 'uncoupled'        .AND.                                                 &
-         coupling_mode /= 'precursor_atmos'  .AND.                                                 &
-         coupling_mode /= 'precursor_ocean' )  THEN
-
-       IF ( dt_coupling == 9999999.9_wp )  THEN
-          message_string = 'dt_coupling is not set but required for coupling mode "' //            &
-                           TRIM( coupling_mode ) // '"'
-          CALL message( 'check_parameters', 'PA0003', 1, 2, 0, 6, 0 )
-       ENDIF
-
-#if defined( __parallel )
-
-
-       IF ( myid == 0 ) THEN
-          CALL MPI_SEND( dt_coupling, 1, MPI_REAL, target_id, 11, comm_inter, ierr )
-          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 11, comm_inter, status, ierr )
-       ENDIF
-       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
-
-       IF ( dt_coupling /= remote )  THEN
-          WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), '": dt_coupling = ',&
-                 dt_coupling, '& is not equal to ', 'dt_coupling_remote = ', remote
-          CALL message( 'check_parameters', 'PA0004', 1, 2, 0, 6, 0 )
-       ENDIF
-       IF ( dt_coupling <= 0.0_wp )  THEN
-
-          IF ( myid == 0  ) THEN
-             CALL MPI_SEND( dt_max, 1, MPI_REAL, target_id, 19, comm_inter, ierr )
-             CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 19, comm_inter, status, ierr )
-          ENDIF
-          CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
-
-          dt_coupling = MAX( dt_max, remote )
-          WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ),                     &
-                 '": dt_coupling <= 0.0 & is not allowed and is reset to ', 'MAX(dt_max(A,O)) = ', &
-                 dt_coupling
-          CALL message( 'check_parameters', 'PA0005', 0, 1, 0, 6, 0 )
-       ENDIF
-
-       IF ( myid == 0 ) THEN
-          CALL MPI_SEND( restart_time, 1, MPI_REAL, target_id, 12, comm_inter, ierr )
-          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 12, comm_inter, status, ierr )
-       ENDIF
-       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
-
-       IF ( restart_time /= remote )  THEN
-          WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ),                     &
-                 '": restart_time = ', restart_time, '& is not equal to ',                         &
-                 'restart_time_remote = ', remote
-          CALL message( 'check_parameters', 'PA0006', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( myid == 0 ) THEN
-          CALL MPI_SEND( dt_restart, 1, MPI_REAL, target_id, 13, comm_inter, ierr )
-          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 13, comm_inter, status, ierr )
-       ENDIF
-       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
-
-       IF ( dt_restart /= remote )  THEN
-          WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), '": dt_restart = ', &
-                 dt_restart, '& is not equal to ', 'dt_restart_remote = ', remote
-          CALL message( 'check_parameters', 'PA0007', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       time_to_be_simulated_from_reference_point = end_time-coupling_start_time
-
-       IF ( myid == 0 ) THEN
-          CALL MPI_SEND( time_to_be_simulated_from_reference_point, 1, MPI_REAL, target_id, 14,    &
-                         comm_inter, ierr )
-          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 14, comm_inter, status, ierr )
-       ENDIF
-       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
-
-       IF ( time_to_be_simulated_from_reference_point /= remote )  THEN
-          WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ),                     &
-                 '": time_to_be_simulated_from_reference_point = ',                                &
-                 time_to_be_simulated_from_reference_point, '& is not equal ',                     &
-                 'to time_to_be_simulated_from_reference_point_remote = ',                         &
-                 remote
-          CALL message( 'check_parameters', 'PA0008', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( myid == 0 ) THEN
-          CALL MPI_SEND( dx, 1, MPI_REAL, target_id, 15, comm_inter, ierr )
-          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 15, comm_inter, status, ierr )
-       ENDIF
-       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
-
-
-       IF ( coupling_mode == 'atmosphere_to_ocean') THEN
-
-          IF ( dx < remote ) THEN
-             WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ),                  &
-                    '": dx in Atmosphere is not equal to or not larger than dx in ocean'
-             CALL message( 'check_parameters', 'PA0009', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( (nx_a+1)*dx /= (nx_o+1)*remote )  THEN
-             WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ),                  &
-                    '": Domain size in x-direction is not equal in ocean and atmosphere'
-             CALL message( 'check_parameters', 'PA0010', 1, 2, 0, 6, 0 )
-          ENDIF
-
-       ENDIF
-
-       IF ( myid == 0) THEN
-          CALL MPI_SEND( dy, 1, MPI_REAL, target_id, 16, comm_inter, ierr )
-          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 16, comm_inter, status, ierr )
-       ENDIF
-       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
-
-       IF ( coupling_mode == 'atmosphere_to_ocean') THEN
-
-          IF ( dy < remote )  THEN
-             WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ),                  &
-                    '": dy in Atmosphere is not equal to or not larger than dy in ocean'
-             CALL message( 'check_parameters', 'PA0011', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( (ny_a+1)*dy /= (ny_o+1)*remote )  THEN
-             WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ),                  &
-                    '": Domain size in y-direction is not equal in ocean and atmosphere'
-             CALL message( 'check_parameters', 'PA0012', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( MOD( nx_o+1, nx_a+1 ) /= 0 )  THEN
-             WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ),                  &
-                    '": nx+1 in ocean is not divisible by nx+1 in', ' atmosphere without remainder'
-             CALL message( 'check_parameters', 'PA0339', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( MOD(ny_o+1,ny_a+1) /= 0 )  THEN
-             WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ),                  &
-                    '": ny+1 in ocean is not divisible by ny+1 in', ' atmosphere without remainder'
-
-             CALL message( 'check_parameters', 'PA0340', 1, 2, 0, 6, 0 )
-          ENDIF
-
-       ENDIF
-#else
-       WRITE( message_string, * ) 'coupling requires PALM to be compiled with',                    &
-              ' cpp-option "-D__parallel"'
-       CALL message( 'check_parameters', 'PA0141', 1, 2, 0, 6, 0 )
-#endif
-    ENDIF
-
-#if defined( __parallel )
-!
-!-- Exchange via intercommunicator
-    IF ( coupling_mode == 'atmosphere_to_ocean'  .AND.  myid == 0 )  THEN
-       CALL MPI_SEND( humidity, 1, MPI_LOGICAL, target_id, 19, comm_inter, ierr )
-    ELSEIF ( coupling_mode == 'ocean_to_atmosphere'  .AND.  myid == 0)  THEN
-       CALL MPI_RECV( humidity_remote, 1, MPI_LOGICAL, target_id, 19, comm_inter, status, ierr )
-    ENDIF
-    CALL MPI_BCAST( humidity_remote, 1, MPI_LOGICAL, 0, comm2d, ierr)
-
-#endif
-
-!
-!-- User settings for restart times requires that "restart" has been given as file activation
-!-- string. Otherwise, binary output would not be saved by palmrun.
-    IF ( ( restart_time /= 9999999.9_wp  .OR.  dt_restart /= 9999999.9_wp )                        &
-         .AND.  .NOT. write_binary )  THEN
-       WRITE( message_string, * ) 'manual restart settings requires file ',                        &
-                                  'activation string "restart"'
-       CALL message( 'check_parameters', 'PA0001', 1, 2, 0, 6, 0 )
-    ENDIF
-
-
-!
-!-- Generate the file header which is used as a header for most of PALM's output files
-    CALL DATE_AND_TIME( date, time, run_zone )
-    run_date = date(1:4) // '-' // date(5:6) // '-' // date(7:8)
-    run_time = time(1:2) // ':' // time(3:4) // ':' // time(5:6)
-    IF ( coupling_mode == 'uncoupled' )  THEN
-       coupling_string = ''
-    ELSEIF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
-       coupling_string = ' coupled (atmosphere)'
-    ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
-       coupling_string = ' coupled (ocean)'
-    ENDIF
-    IF ( ensemble_member_nr /= 0 )  THEN
-       WRITE( ensemble_string, '(2X,A,I2.2)' )  'en-no: ', ensemble_member_nr
-    ELSE
-       ensemble_string = ''
-    ENDIF
-    IF ( nested_run )  THEN
-       WRITE( nest_string, '(2X,A,I2.2)' )  'nest-id: ', cpl_id
-    ELSE
-       nest_string = ''
-    ENDIF
-
-    WRITE ( run_description_header, '(A,2X,A,2X,A,A,A,I2.2,A,A,A,2X,A,A,2X,A,1X,A)' )              &
-          TRIM( version ), TRIM( revision ), 'run: ', TRIM( run_identifier ), '.', runnr,          &
-          TRIM( coupling_string ), TRIM( nest_string ), TRIM( ensemble_string), 'host: ',          &
-          TRIM( host ), run_date, run_time
-
-!
-!-- Check the general loop optimization method
-    SELECT CASE ( TRIM( loop_optimization ) )
-
-       CASE ( 'cache', 'vector' )
-          CONTINUE
-
-       CASE DEFAULT
-          message_string = 'illegal value given for loop_optimization: "' //                       &
-                           TRIM( loop_optimization ) // '"'
-          CALL message( 'check_parameters', 'PA0013', 1, 2, 0, 6, 0 )
-
-    END SELECT
+    CHARACTER (LEN=1)   ::  sq
+    CHARACTER (LEN=6)   ::  var
+    CHARACTER (LEN=7)   ::  unit
+    CHARACTER (LEN=8)   ::  date
+    CHARACTER (LEN=10)  ::  time
+    CHARACTER (LEN=100) ::  action
+
+    INTEGER ::  i, ilen, intervals, iter, j, k, nnxh, nnyh, position, prec
+    LOGICAL ::  found, ldum
+    REAL    ::  gradient, maxn, maxp
+
+
+!
+!-- Warning, if host is not set
+    IF ( host(1:1) == ' ' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ WARNING: check_parameters:'
+          PRINT*, '    "host" is not set. Please check that environment', &
+                       ' variable "localhost"'
+          PRINT*, '    is set before running PALM'
+       ENDIF
+    ENDIF
+
+!
+!-- Generate the file header which is used as a header for most of PALM's
+!-- output files
+    CALL DATE_AND_TIME( date, time )
+    run_date = date(7:8)//'-'//date(5:6)//'-'//date(3:4)
+    run_time = time(1:2)//':'//time(3:4)//':'//time(5:6)
+
+    WRITE ( run_description_header, '(A,2X,A,A,A,I2.2,2X,A,A,2X,A,1X,A)' )  &
+              TRIM( version ),'run: ', TRIM( run_identifier ), '.', &
+              runnr, 'host: ', TRIM( host ), run_date, run_time
 
 !
@@ -537,11 +200,11 @@
     IF ( topography /= 'flat' )  THEN
        action = ' '
-       IF ( scalar_advec /= 'pw-scheme'  .AND.  scalar_advec /= 'ws-scheme' )  THEN
+       IF ( scalar_advec /= 'pw-scheme' )  THEN
           WRITE( action, '(A,A)' )  'scalar_advec = ', scalar_advec
        ENDIF
-       IF ( momentum_advec /= 'pw-scheme'  .AND.  momentum_advec /= 'ws-scheme' )  THEN
+       IF ( momentum_advec /= 'pw-scheme' )  THEN
           WRITE( action, '(A,A)' )  'momentum_advec = ', momentum_advec
        ENDIF
-       IF ( psolver == 'sor' )  THEN
+       IF ( psolver == 'multigrid'  .OR.  psolver == 'sor' )  THEN
           WRITE( action, '(A,A)' )  'psolver = ', psolver
        ENDIF
@@ -552,157 +215,70 @@
           WRITE( action, '(A)' )  'galilei_transformation = .TRUE.'
        ENDIF
+       IF ( cloud_physics )  THEN
+          WRITE( action, '(A)' )  'cloud_physics = .TRUE.'
+       ENDIF
        IF ( cloud_droplets )  THEN
           WRITE( action, '(A)' )  'cloud_droplets = .TRUE.'
        ENDIF
-       IF ( .NOT. constant_flux_layer  .AND.  topography /= 'closed_channel' )  THEN
-          WRITE( action, '(A)' )  'constant_flux_layer = .FALSE.'
+       IF ( moisture )  THEN
+          WRITE( action, '(A)' )  'moisture = .TRUE.'
+       ENDIF
+       IF ( .NOT. prandtl_layer )  THEN
+          WRITE( action, '(A)' )  'prandtl_layer = .FALSE.'
        ENDIF
        IF ( action /= ' ' )  THEN
-          message_string = 'The specified topography does not allow ' // TRIM( action )
-          CALL message( 'check_parameters', 'PA0014', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Check illegal/untested parameter combinations for closed channel
-       If ( topography == 'closed_channel' )  THEN
-          symmetry_flag = 1
-          message_string = 'Bottom and top boundary are treated equal'
-          CALL message( 'check_parameters', 'PA0699', 0, 0, 0, 6, 0 )
-
-          IF ( dz(1) /= dz(COUNT( dz /= -1.0_wp ))  .OR.  dz_stretch_level /= -9999999.9_wp)  THEN
-             WRITE( message_string, * )  'dz should be equal close to the ' //                     &
-                                         'boundaries due to symmetrical problem'
-             CALL message( 'check_parameters', 'PA0700', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( constant_flux_layer )  THEN
-             WRITE( message_string, * )  'A constant flux layer is not ' //                        &
-                                         'allowed if a closed channel shall be used'
-             CALL message( 'check_parameters', 'PA0701', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( ocean_mode )  THEN
-             WRITE( message_string, * )  'The ocean mode is not allowed if ' //                    &
-                                         'a closed channel shall be used'
-             CALL message( 'check_parameters', 'PA0702', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( momentum_advec /= 'ws-scheme'  .OR.                                                 &
-               scalar_advec /= 'ws-scheme' )  THEN
-             WRITE( message_string, * )  'A closed channel require the upwind scheme of Wicker' // &
-                                         ' and Skamarock as the advection scheme'
-             CALL message( 'check_parameters', 'PA0703', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-
-!
-!-- Check approximation
-    IF ( TRIM( approximation ) /= 'boussinesq'  .AND.  TRIM( approximation ) /= 'anelastic' )  THEN
-       message_string = 'unknown approximation: approximation = "' // TRIM( approximation ) // '"'
-       CALL message( 'check_parameters', 'PA0446', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check approximation requirements
-    IF ( TRIM( approximation ) == 'anelastic'  .AND.  TRIM( momentum_advec ) /= 'ws-scheme' )  THEN
-       message_string = 'Anelastic approximation requires momentum_advec = "ws-scheme"'
-       CALL message( 'check_parameters', 'PA0447', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( TRIM( approximation ) == 'anelastic'  .AND.  TRIM( psolver ) == 'multigrid' )  THEN
-       message_string = 'Anelastic approximation currently only supports psolver = "poisfft", ' // &
-                        'psolver = "sor" and psolver = "multigrid_noopt"'
-       CALL message( 'check_parameters', 'PA0448', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( TRIM( approximation ) == 'anelastic'  .AND.  conserve_volume_flow )  THEN
-       message_string = 'Anelastic approximation is not allowed with ' //                          &
-                        'conserve_volume_flow = .TRUE.'
-       CALL message( 'check_parameters', 'PA0449', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check flux input mode
-    IF ( TRIM( flux_input_mode ) /= 'dynamic'  .AND.  TRIM( flux_input_mode ) /= 'kinematic'       &
-         .AND.  TRIM( flux_input_mode ) /= 'approximation-specific' )  THEN
-       message_string = 'unknown flux input mode: flux_input_mode = "' //                          &
-                        TRIM( flux_input_mode ) // '"'
-       CALL message( 'check_parameters', 'PA0450', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Set flux input mode according to approximation if applicable
-    IF ( TRIM( flux_input_mode ) == 'approximation-specific' )  THEN
-       IF ( TRIM( approximation ) == 'anelastic' )  THEN
-          flux_input_mode = 'dynamic'
-       ELSEIF ( TRIM( approximation ) == 'boussinesq' )  THEN
-          flux_input_mode = 'kinematic'
-       ENDIF
-    ENDIF
-
-!
-!-- Check flux output mode
-    IF ( TRIM( flux_output_mode ) /= 'dynamic'  .AND.  TRIM( flux_output_mode ) /= 'kinematic'     &
-         .AND.  TRIM( flux_output_mode ) /= 'approximation-specific' )  THEN
-       message_string = 'unknown flux output mode: flux_output_mode = "' //                        &
-                        TRIM( flux_output_mode ) // '"'
-       CALL message( 'check_parameters', 'PA0451', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Set flux output mode according to approximation if applicable
-    IF ( TRIM( flux_output_mode ) == 'approximation-specific' )  THEN
-       IF ( TRIM( approximation ) == 'anelastic' )  THEN
-          flux_output_mode = 'dynamic'
-       ELSEIF ( TRIM( approximation ) == 'boussinesq' )  THEN
-          flux_output_mode = 'kinematic'
-       ENDIF
-    ENDIF
-
-
-!
-!-- When the land- or urban-surface model is used, the flux output must be dynamic.
-    IF ( land_surface  .OR.  urban_surface )  THEN
-       flux_output_mode = 'dynamic'
-    ENDIF
-
-!
-!-- Set the flux output units according to flux_output_mode
-    IF ( TRIM( flux_output_mode ) == 'kinematic' )  THEN
-        heatflux_output_unit              = 'K m/s'
-        waterflux_output_unit             = 'kg/kg m/s'
-        momentumflux_output_unit          = 'm2/s2'
-    ELSEIF ( TRIM( flux_output_mode ) == 'dynamic' )  THEN
-        heatflux_output_unit              = 'W/m2'
-        waterflux_output_unit             = 'W/m2'
-        momentumflux_output_unit          = 'N/m2'
-    ENDIF
-
-!
-!-- set time series output units for fluxes
-    dots_unit(14:16) = TRIM( heatflux_output_unit )
-    dots_unit(21)    = TRIM( waterflux_output_unit )
-    dots_unit(19:20) = TRIM( momentumflux_output_unit )
-
-!
-!-- Add other module specific timeseries
-    CALL module_interface_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
-
-!
-!-- Check if maximum number of allowed timeseries is exceeded
-    IF ( dots_num > dots_max )  THEN
-       WRITE( message_string, * ) 'number of time series quantities exceeds',                      &
-                                  ' its maximum of dots_max = ', dots_max,                         &
-                                  '&Please increase dots_max in netcdf_interface_mod.f90.'
-       CALL message( 'check_parameters', 'PA0194', 1, 2, 0, 6, 0 )
-    ENDIF
-
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    a non-flat topography does not allow ', TRIM( action )
+          ENDIF
+          CALL local_stop
+       ENDIF
+    ENDIF
 !
 !-- Check whether there are any illegal values
 !-- Pressure solver:
-    IF ( psolver /= 'poisfft'  .AND.  psolver /= 'sor'  .AND.  psolver /= 'multigrid'  .AND.       &
-         psolver /= 'multigrid_noopt' )  THEN
-       message_string = 'unknown solver for perturbation pressure: psolver' //                     &
-                        ' = "' // TRIM( psolver ) // '"'
-       CALL message( 'check_parameters', 'PA0016', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( psolver(1:9) == 'multigrid' )  THEN
+    IF ( psolver /= 'poisfft'  .AND.  psolver /= 'poisfft_hybrid'  .AND. &
+         psolver /= 'sor'  .AND.  psolver /= 'multigrid' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown solver for perturbation pressure: psolver=', &
+                  psolver
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+#if defined( __parallel )
+    IF ( psolver == 'poisfft_hybrid'  .AND.  pdims(2) /= 1 )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    psolver="', TRIM( psolver ), '" only works for a ', &
+                       '1d domain-decomposition along x'
+          PRINT*, '    please do not set npey/=1 in the parameter file'
+       ENDIF
+       CALL local_stop
+    ENDIF
+    IF ( ( psolver == 'poisfft_hybrid'  .OR.  psolver == 'multigrid' )  .AND.  &
+         ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz ) )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    psolver="', TRIM( psolver ), '" does not work for ', &
+                       'subdomains with unequal size'
+          PRINT*, '    please set grid_matching = ''strict'' in the parameter',&
+                       ' file'
+       ENDIF
+       CALL local_stop
+    ENDIF
+#else
+    IF ( psolver == 'poisfft_hybrid' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    psolver="', TRIM( psolver ), '" only works for a ', &
+                       'parallel environment'
+       ENDIF
+       CALL local_stop
+    ENDIF
+#endif
+
+    IF ( psolver == 'multigrid' )  THEN
        IF ( cycle_mg == 'w' )  THEN
           gamma_mg = 2
@@ -710,60 +286,60 @@
           gamma_mg = 1
        ELSE
-          message_string = 'unknown multigrid cycle: cycle_mg = "' //  TRIM( cycle_mg ) // '"'
-          CALL message( 'check_parameters', 'PA0020', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    IF ( fft_method /= 'singleton-algorithm'  .AND.  fft_method /= 'temperton-algorithm'  .AND.    &
-         fft_method /= 'fftw'                 .AND.  fft_method /= 'system-specific' )  THEN
-       message_string = 'unknown fft-algorithm: fft_method = "' // TRIM( fft_method ) // '"'
-       CALL message( 'check_parameters', 'PA0021', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF( momentum_advec == 'ws-scheme' .AND.  .NOT. call_psolver_at_all_substeps  ) THEN
-        message_string = 'psolver must be called at each RK3 substep when "'//                     &
-                         TRIM(momentum_advec) // ' "is used for momentum_advec'
-        CALL message( 'check_parameters', 'PA0344', 1, 2, 0, 6, 0 )
-    END IF
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    unknown multigrid cycle: cycle_mg=', cycle_mg
+          ENDIF
+          CALL local_stop
+       ENDIF
+    ENDIF
+
+    IF ( fft_method /= 'singleton-algorithm'  .AND.  &
+         fft_method /= 'temperton-algorithm'  .AND.  &
+         fft_method /= 'system-specific' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown fft-algorithm: fft_method=', fft_method
+       ENDIF
+       CALL local_stop
+    ENDIF
+
 !
 !-- Advection schemes:
-    IF ( momentum_advec /= 'pw-scheme'  .AND.  momentum_advec /= 'ws-scheme'  .AND.                &
-         momentum_advec /= 'up-scheme' )  THEN
-       message_string = 'unknown advection scheme: momentum_advec = "' //                          &
-                        TRIM( momentum_advec ) // '"'
-       CALL message( 'check_parameters', 'PA0022', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( ( momentum_advec == 'ws-scheme' .OR. scalar_advec == 'ws-scheme' )                        &
-         .AND. ( timestep_scheme == 'euler' .OR.  timestep_scheme == 'runge-kutta-2' ) )  THEN
-       message_string = 'momentum_advec or scalar_advec = "' // TRIM( momentum_advec ) //          &
-                        '" is not allowed with timestep_scheme = "' //                             &
-                        TRIM( timestep_scheme ) // '"'
-       CALL message( 'check_parameters', 'PA0023', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( scalar_advec /= 'pw-scheme'  .AND.  scalar_advec /= 'ws-scheme'  .AND.                    &
-         scalar_advec /= 'bc-scheme'  .AND.  scalar_advec /= 'up-scheme' )  THEN
-       message_string = 'unknown advection scheme: scalar_advec = "' // TRIM( scalar_advec ) // '"'
-       CALL message( 'check_parameters', 'PA0024', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( scalar_advec == 'bc-scheme'  .AND.  loop_optimization == 'cache' )  THEN
-       message_string = 'advection_scheme scalar_advec = "' // TRIM( scalar_advec ) //             &
-                        '" not implemented for loop_optimization = "' //                           &
-                        TRIM( loop_optimization ) // '"'
-       CALL message( 'check_parameters', 'PA0026', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( use_sgs_for_particles  .AND.  .NOT. cloud_droplets  .AND.  .NOT. use_upstream_for_tke     &
-         .AND.  scalar_advec /= 'ws-scheme' )  THEN
+    IF ( momentum_advec /= 'pw-scheme' .AND. momentum_advec /= 'ups-scheme' ) &
+    THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  unknown advection ', &
+                                 'scheme: momentum_advec=', momentum_advec
+       CALL local_stop
+    ENDIF
+    IF ( ( momentum_advec == 'ups-scheme'  .OR.  scalar_advec == 'ups-scheme' )&
+                                      .AND.  timestep_scheme /= 'euler' )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  momentum_advec=', &
+                                 momentum_advec, ' is not allowed with ', &
+                                 'timestep_scheme=', timestep_scheme
+       CALL local_stop
+    ENDIF
+
+    IF ( scalar_advec /= 'pw-scheme'  .AND.  scalar_advec /= 'bc-scheme'  .AND.&
+         scalar_advec /= 'ups-scheme' )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  unknown advection ', &
+                                 'scheme: scalar_advec=', scalar_advec
+       CALL local_stop
+    ENDIF
+
+    IF ( use_sgs_for_particles  .AND.  .NOT. use_upstream_for_tke )  THEN
        use_upstream_for_tke = .TRUE.
-       message_string = 'use_upstream_for_tke is set to .TRUE. because ' //                        &
-                        'use_sgs_for_particles = .TRUE. and scalar_advec /= ws-scheme'
-       CALL message( 'check_parameters', 'PA0025', 0, 1, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Set LOGICAL switches to enhance performance
-    IF ( momentum_advec == 'ws-scheme' )  ws_scheme_mom = .TRUE.
-    IF ( scalar_advec   == 'ws-scheme' )  ws_scheme_sca = .TRUE.
-
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ WARNING: check_parameters:  use_upstream_for_tke set ', &
+                       '.TRUE. because use_sgs_for_particles = .TRUE.'
+       ENDIF
+    ENDIF
+
+    IF ( use_upstream_for_tke  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:  use_upstream_for_tke = .TRUE. ', &
+                       'not allowed with timestep_scheme=', timestep_scheme
+       ENDIF
+       CALL local_stop
+    ENDIF
 
 !
@@ -773,421 +349,346 @@
        CASE ( 'euler' )
           intermediate_timestep_count_max = 1
+          asselin_filter_factor           = 0.0
+
+       CASE ( 'leapfrog', 'leapfrog+euler' )
+          intermediate_timestep_count_max = 1
 
        CASE ( 'runge-kutta-2' )
           intermediate_timestep_count_max = 2
+          asselin_filter_factor           = 0.0
 
        CASE ( 'runge-kutta-3' )
           intermediate_timestep_count_max = 3
+          asselin_filter_factor           = 0.0
 
        CASE DEFAULT
-          message_string = 'unknown timestep scheme: timestep_scheme = "' //                       &
-                           TRIM( timestep_scheme ) // '"'
-          CALL message( 'check_parameters', 'PA0027', 1, 2, 0, 6, 0 )
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters:  unknown timestep ',&
+                                    'scheme: timestep_scheme=', timestep_scheme
+          CALL local_stop
 
     END SELECT
 
-    IF ( ( momentum_advec /= 'pw-scheme' .AND. momentum_advec /= 'ws-scheme' )                     &
-         .AND.  timestep_scheme(1:5) == 'runge' ) THEN
-       message_string = 'momentum advection scheme "' // TRIM( momentum_advec ) //                 &
-                        '" & does not work with timestep_scheme "' // TRIM( timestep_scheme )      &
-                        // '"'
-       CALL message( 'check_parameters', 'PA0029', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check for proper settings for microphysics
-    IF ( bulk_cloud_model  .AND.  cloud_droplets )  THEN
-       message_string = 'bulk_cloud_model = .TRUE. is not allowed with cloud_droplets = .TRUE.'
-       CALL message( 'check_parameters', 'PA0442', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Initializing actions must have been set by the user
-    IF ( TRIM( initializing_actions ) == '' )  THEN
-       message_string = 'no value specified for initializing_actions'
-       CALL message( 'check_parameters', 'PA0149', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.                                &
-         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
-!
-!--    No restart run: several initialising actions are possible
+    IF ( scalar_advec /= 'pw-scheme'  .AND.  timestep_scheme(1:5) == 'runge' ) &
+    THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:  scalar advection scheme "', &
+                                          TRIM( scalar_advec ), '"'
+          PRINT*, '    does not work with timestep_scheme "', &
+                                          TRIM( timestep_scheme ), '"'
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+    IF ( momentum_advec /= 'pw-scheme' .AND. timestep_scheme(1:5) == 'runge' ) &
+    THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:  momentum advection scheme "', &
+                                          TRIM( momentum_advec ), '"'
+          PRINT*, '    does not work with timestep_scheme "', &
+                                          TRIM( timestep_scheme ), '"'
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+
+    IF ( initializing_actions == ' ' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check parameters:'
+          PRINT*, '    no value found for initializing_actions'
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
+!
+!--    No model continuation run; several initialising actions are possible
        action = initializing_actions
-       DO  WHILE ( TRIM( action ) /= '' )
+       DO WHILE ( TRIM( action ) /= '' )
           position = INDEX( action, ' ' )
           SELECT CASE ( action(1:position-1) )
 
-             CASE ( 'set_constant_profiles', 'set_1d-model_profiles', 'by_user',                   &
-                    'initialize_vortex', 'initialize_ptanom', 'initialize_bubble', 'inifor' )
+             CASE ( 'set_constant_profiles', 'set_1d-model_profiles', &
+                    'initialize_vortex',     'initialize_ptanom' )
                 action = action(position+1:)
 
              CASE DEFAULT
-                message_string = 'initializing_action = "' //                                      &
-                                 TRIM( action ) // '" unknown or not allowed'
-                CALL message( 'check_parameters', 'PA0030', 1, 2, 0, 6, 0 )
+                IF ( myid == 0 )  PRINT*, '+++ check_parameters: initializi', &
+                               'ng_action unkown or not allowed: action = "', &
+                               TRIM(action), '"'
+                CALL local_stop
 
           END SELECT
        ENDDO
     ENDIF
-
-    IF ( TRIM( initializing_actions ) == 'initialize_vortex'  .AND.  conserve_volume_flow ) THEN
-         message_string = 'initializing_actions = "initialize_vortex"' //                          &
-                          ' is not allowed with conserve_volume_flow = .T.'
-       CALL message( 'check_parameters', 'PA0343', 1, 2, 0, 6, 0 )
-    ENDIF
-
-
-    IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0  .AND.                        &
+    IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0  .AND. &
          INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
-       message_string = 'initializing_actions = "set_constant_profiles"' //                        &
-                        ' and "set_1d-model_profiles" are not allowed simultaneously'
-       CALL message( 'check_parameters', 'PA0031', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0  .AND.                        &
-         INDEX( initializing_actions, 'by_user' ) /= 0 )  THEN
-       message_string = 'initializing_actions = "set_constant_profiles"' //                        &
-                        ' and "by_user" are not allowed simultaneously'
-       CALL message( 'check_parameters', 'PA0032', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( INDEX( initializing_actions, 'by_user' ) /= 0  .AND.                                      &
-         INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
-       message_string = 'initializing_actions = "by_user" and ' //                                 &
-                        '"set_1d-model_profiles" are not allowed simultaneously'
-       CALL message( 'check_parameters', 'PA0033', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- In case of spinup and nested run, spinup end time must be identical in order to have
-!-- synchronously running simulations.
-    IF ( nested_run )  THEN
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( spinup_time, spinup_time_max, 1, MPI_REAL, MPI_MAX, MPI_COMM_WORLD,     &
-                           ierr )
-       CALL MPI_ALLREDUCE( dt_spinup,   dt_spinup_max,   1, MPI_REAL, MPI_MAX, MPI_COMM_WORLD,     &
-                           ierr )
-
-       IF ( spinup_time /= spinup_time_max  .OR.  dt_spinup /= dt_spinup_max )  THEN
-          message_string = 'In case of nesting, spinup_time and ' //                               &
-                           'dt_spinup must be identical in all parent and child domains.'
-          CALL message( 'check_parameters', 'PA0489', 3, 2, 0, 6, 0 )
-       ENDIF
-#endif
-    ENDIF
-
-    IF ( bulk_cloud_model  .AND.  .NOT. humidity )  THEN
-       WRITE( message_string, * ) 'bulk_cloud_model = ', bulk_cloud_model,                         &
-              ' is not allowed with humidity = ', humidity
-       CALL message( 'check_parameters', 'PA0034', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( humidity  .AND.  sloping_surface )  THEN
-       message_string = 'humidity = .TRUE. and sloping_surface = .TRUE. ' //                       &
-                        'are not allowed simultaneously'
-       CALL message( 'check_parameters', 'PA0036', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!-- Check the module settings
-    CALL module_interface_check_parameters
-
-!
-!-- In case of no restart run, check initialising parameters and calculate further quantities
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters: initializing_actions', &
+          '"set_constant_profiles" and "set_1d-model_profiles" are not', &
+          ' allowed simultaneously'
+       CALL local_stop
+    ENDIF
+
+    IF ( cloud_physics  .AND.  .NOT. moisture )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters: moisture =', &
+                                 moisture, ' is not allowed with ',  &
+                                 'cloud_physics=', cloud_physics
+       CALL local_stop
+    ENDIF
+
+    IF ( moisture  .AND.  sloping_surface )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters: moisture = TRUE', &
+                                 'and hang = TRUE are not',               &
+                                 ' allowed simultaneously' 
+       CALL local_stop       
+    ENDIF
+
+    IF ( moisture  .AND.  scalar_advec == 'ups-scheme' )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters: UPS-scheme', &
+                                 'is not implemented for moisture'
+       CALL local_stop       
+    ENDIF
+
+    IF ( passive_scalar  .AND.  moisture )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters: moisture = TRUE and', &
+                                 'passive_scalar = TRUE is not allowed ',     &
+                                 'simultaneously'
+       CALL local_stop
+    ENDIF
+
+    IF ( passive_scalar  .AND.  scalar_advec == 'ups-scheme' )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters: UPS-scheme', &
+                                 'is not implemented for passive_scalar'
+       CALL local_stop       
+    ENDIF
+
+    IF ( grid_matching /= 'strict'  .AND.  grid_matching /= 'match' )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters: illegal value "', &
+                                 TRIM( grid_matching ),                   &
+                                 '" found for parameter grid_matching'
+       CALL local_stop       
+    ENDIF
+
+!
+!-- In case of no model continuation run, check initialising parameters and
+!-- deduce further quantities
     IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
 
 !
-!--    Initial profiles for 1D and 3D model, respectively (u,v further below)
+!--    Initial profiles for 1D and 3D model, respectively
+       u_init  = ug_surface
+       v_init  = vg_surface
        pt_init = pt_surface
-       IF ( humidity       )  q_init  = q_surface
-       IF ( passive_scalar )  s_init  = s_surface
-
+       IF ( moisture )        q_init = q_surface
+       IF ( passive_scalar )  q_init = s_surface
+
+!
 !--
-!--    If required, compute initial profile of the geostrophic wind (component ug)
+!--    If required, compute initial profile of the geostrophic wind
+!--    (component ug)
        i = 1
-       gradient = 0.0_wp
-
-       IF ( .NOT. ocean_mode )  THEN
-
-          ug_vertical_gradient_level_ind(1) = 0
-          ug(0) = ug_surface
+       gradient = 0.0
+       ug_vertical_gradient_level_ind(1) = 0
+       ug(0) = ug_surface
+       DO  k = 1, nzt+1
+          IF ( ug_vertical_gradient_level(i) < zu(k)  .AND. &
+               ug_vertical_gradient_level(i) >= 0.0 )  THEN
+             gradient = ug_vertical_gradient(i) / 100.0
+             ug_vertical_gradient_level_ind(i) = k - 1
+             i = i + 1
+             IF ( i > 10 )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: upper bound 10 of array', &
+                           ' "ug_vertical_gradient_level_ind" exceeded'
+                ENDIF
+                CALL local_stop
+             ENDIF
+          ENDIF
+          IF ( gradient /= 0.0 )  THEN
+             IF ( k /= 1 )  THEN
+                ug(k) = ug(k-1) + dzu(k) * gradient
+             ELSE
+                ug(k) = ug_surface + 0.5 * dzu(k) * gradient
+             ENDIF
+          ELSE
+             ug(k) = ug(k-1)
+          ENDIF
+       ENDDO
+
+       u_init = ug
+
+!
+!--    In case of no given gradients for ug, choose a vanishing gradient
+       IF ( ug_vertical_gradient_level(1) == -1.0 )  THEN
+          ug_vertical_gradient_level(1) = 0.0
+       ENDIF  
+
+!
+!--
+!--    If required, compute initial profile of the geostrophic wind
+!--    (component vg)
+       i = 1
+       gradient = 0.0
+       vg_vertical_gradient_level_ind(1) = 0
+       vg(0) = vg_surface
+       DO  k = 1, nzt+1
+          IF ( vg_vertical_gradient_level(i) < zu(k)  .AND. &
+               vg_vertical_gradient_level(i) >= 0.0 )  THEN
+             gradient = vg_vertical_gradient(i) / 100.0
+             vg_vertical_gradient_level_ind(i) = k - 1
+             i = i + 1
+             IF ( i > 10 )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: upper bound 10 of array', &
+                           ' "vg_vertical_gradient_level_ind" exceeded'
+                ENDIF
+                CALL local_stop
+             ENDIF
+          ENDIF
+          IF ( gradient /= 0.0 )  THEN
+             IF ( k /= 1 )  THEN
+                vg(k) = vg(k-1) + dzu(k) * gradient
+             ELSE
+                vg(k) = vg_surface + 0.5 * dzu(k) * gradient
+             ENDIF
+          ELSE
+             vg(k) = vg(k-1)
+          ENDIF
+       ENDDO
+
+       v_init = vg
+ 
+!
+!--    In case of no given gradients for vg, choose a vanishing gradient
+       IF ( vg_vertical_gradient_level(1) == -1.0 )  THEN
+          vg_vertical_gradient_level(1) = 0.0
+       ENDIF
+
+!
+!--    If required, compute initial temperature profile using the given
+!--    temperature gradient
+       i = 1
+       gradient = 0.0
+       pt_vertical_gradient_level_ind(1) = 0
+       DO  k = 1, nzt+1
+          IF ( pt_vertical_gradient_level(i) < zu(k)  .AND. &
+               pt_vertical_gradient_level(i) >= 0.0 )  THEN
+             gradient = pt_vertical_gradient(i) / 100.0
+             pt_vertical_gradient_level_ind(i) = k - 1
+             i = i + 1
+             IF ( i > 10 )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: upper bound 10 of array', &
+                           ' "pt_vertical_gradient_level_ind" exceeded'
+                ENDIF
+                CALL local_stop
+             ENDIF
+          ENDIF
+          IF ( gradient /= 0.0 )  THEN
+             IF ( k /= 1 )  THEN
+                pt_init(k) = pt_init(k-1) + dzu(k) * gradient
+             ELSE
+                pt_init(k) = pt_init(k-1) + 0.5 * dzu(k) * gradient
+             ENDIF
+          ELSE
+             pt_init(k) = pt_init(k-1)
+          ENDIF
+       ENDDO
+
+!
+!--    In case of no given temperature gradients, choose gradient of neutral
+!--    stratification
+       IF ( pt_vertical_gradient_level(1) == -1.0 )  THEN
+          pt_vertical_gradient_level(1) = 0.0
+       ENDIF
+
+!
+!--    Store temperature gradient at the top boundary for possile Neumann
+!--    boundary condition
+       bc_pt_t_val = ( pt_init(nzt) - pt_init(nzt-1) ) / dzu(nzt)
+
+!
+!--    If required, compute initial humidity or scalar profile using the given
+!--    humidity/scalar gradient. In case of scalar transport, initially store
+!--    values of the scalar parameters on humidity parameters
+       IF ( passive_scalar )  THEN
+          bc_q_b                    = bc_s_b
+          bc_q_t                    = bc_s_t
+          q_surface                 = s_surface
+          q_surface_initial_change  = s_surface_initial_change
+          q_vertical_gradient       = s_vertical_gradient
+          q_vertical_gradient_level = s_vertical_gradient_level
+          surface_waterflux         = surface_scalarflux
+       ENDIF
+
+       IF ( moisture  .OR.  passive_scalar )  THEN
+
+          i = 1
+          gradient = 0.0
+          q_vertical_gradient_level_ind(1) = 0
           DO  k = 1, nzt+1
-             IF ( i < 11 )  THEN
-                IF ( ug_vertical_gradient_level(i) < zu(k)  .AND.                                  &
-                     ug_vertical_gradient_level(i) >= 0.0_wp )  THEN
-                   gradient = ug_vertical_gradient(i) / 100.0_wp
-                   ug_vertical_gradient_level_ind(i) = k - 1
-                   i = i + 1
-                ENDIF
-             ENDIF
-             IF ( gradient /= 0.0_wp )  THEN
+             IF ( q_vertical_gradient_level(i) < zu(k)  .AND. &
+                  q_vertical_gradient_level(i) >= 0.0 )  THEN
+                gradient = q_vertical_gradient(i) / 100.0
+                q_vertical_gradient_level_ind(i) = k - 1
+                i = i + 1
+                IF ( i > 10 )  THEN
+                   IF ( myid == 0 )  THEN
+                      PRINT*, '+++ check_parameters: upper bound 10 of arr', &
+                              'ay "q_vertical_gradient_level_ind" exceeded'
+                   ENDIF
+                   CALL local_stop
+                ENDIF
+             ENDIF
+             IF ( gradient /= 0.0 )  THEN
                 IF ( k /= 1 )  THEN
-                   ug(k) = ug(k-1) + dzu(k) * gradient
+                   q_init(k) = q_init(k-1) + dzu(k) * gradient
                 ELSE
-                   ug(k) = ug_surface + dzu(k) * gradient
+                   q_init(k) = q_init(k-1) + 0.5 * dzu(k) * gradient
                 ENDIF
              ELSE
-                ug(k) = ug(k-1)
+                q_init(k) = q_init(k-1)
              ENDIF
           ENDDO
 
-       ELSE
-
-          ug_vertical_gradient_level_ind(1) = nzt+1
-          ug(nzt+1) = ug_surface
-          DO  k = nzt, nzb, -1
-             IF ( i < 11 )  THEN
-                IF ( ug_vertical_gradient_level(i) > zu(k)  .AND.                                  &
-                     ug_vertical_gradient_level(i) <= 0.0_wp )  THEN
-                   gradient = ug_vertical_gradient(i) / 100.0_wp
-                   ug_vertical_gradient_level_ind(i) = k + 1
-                   i = i + 1
-                ENDIF
-             ENDIF
-             IF ( gradient /= 0.0_wp )  THEN
-                IF ( k /= nzt )  THEN
-                   ug(k) = ug(k+1) - dzu(k+1) * gradient
-                ELSE
-                   ug(k)   = ug_surface - 0.5_wp * dzu(k+1) * gradient
-                   ug(k+1) = ug_surface + 0.5_wp * dzu(k+1) * gradient
-                ENDIF
-             ELSE
-                ug(k) = ug(k+1)
-             ENDIF
-          ENDDO
-
-       ENDIF
-
-!
-!--    In case of no given gradients for ug, choose a zero gradient
-       IF ( ug_vertical_gradient_level(1) == -9999999.9_wp )  THEN
-          ug_vertical_gradient_level(1) = 0.0_wp
-       ENDIF
-
-!
-!--
-!--    If required, compute initial profile of the geostrophic wind (component vg)
-       i = 1
-       gradient = 0.0_wp
-
-       IF ( .NOT. ocean_mode )  THEN
-
-          vg_vertical_gradient_level_ind(1) = 0
-          vg(0) = vg_surface
-          DO  k = 1, nzt+1
-             IF ( i < 11 )  THEN
-                IF ( vg_vertical_gradient_level(i) < zu(k)  .AND.                                  &
-                     vg_vertical_gradient_level(i) >= 0.0_wp )  THEN
-                   gradient = vg_vertical_gradient(i) / 100.0_wp
-                   vg_vertical_gradient_level_ind(i) = k - 1
-                   i = i + 1
-                ENDIF
-             ENDIF
-             IF ( gradient /= 0.0_wp )  THEN
-                IF ( k /= 1 )  THEN
-                   vg(k) = vg(k-1) + dzu(k) * gradient
-                ELSE
-                   vg(k) = vg_surface + dzu(k) * gradient
-                ENDIF
-             ELSE
-                vg(k) = vg(k-1)
-             ENDIF
-          ENDDO
-
-       ELSE
-
-          vg_vertical_gradient_level_ind(1) = nzt+1
-          vg(nzt+1) = vg_surface
-          DO  k = nzt, nzb, -1
-             IF ( i < 11 )  THEN
-                IF ( vg_vertical_gradient_level(i) > zu(k)  .AND.                                  &
-                     vg_vertical_gradient_level(i) <= 0.0_wp )  THEN
-                   gradient = vg_vertical_gradient(i) / 100.0_wp
-                   vg_vertical_gradient_level_ind(i) = k + 1
-                   i = i + 1
-                ENDIF
-             ENDIF
-             IF ( gradient /= 0.0_wp )  THEN
-                IF ( k /= nzt )  THEN
-                   vg(k) = vg(k+1) - dzu(k+1) * gradient
-                ELSE
-                   vg(k)   = vg_surface - 0.5_wp * dzu(k+1) * gradient
-                   vg(k+1) = vg_surface + 0.5_wp * dzu(k+1) * gradient
-                ENDIF
-             ELSE
-                vg(k) = vg(k+1)
-             ENDIF
-          ENDDO
-
-       ENDIF
-
-!
-!--    In case of no given gradients for vg, choose a zero gradient
-       IF ( vg_vertical_gradient_level(1) == -9999999.9_wp )  THEN
-          vg_vertical_gradient_level(1) = 0.0_wp
-       ENDIF
-
-!
-!--    Let the initial wind profiles be the calculated ug/vg profiles or interpolate them from wind
-!--    profile data (if given)
-       IF ( u_profile(1) == 9999999.9_wp  .AND.  v_profile(1) == 9999999.9_wp )  THEN
-
-          u_init = ug
-          v_init = vg
-
-       ELSEIF ( u_profile(1) == 0.0_wp  .AND.  v_profile(1) == 0.0_wp )  THEN
-
-          IF ( uv_heights(1) /= 0.0_wp )  THEN
-             message_string = 'uv_heights(1) must be 0.0'
-             CALL message( 'check_parameters', 'PA0345', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( omega /= 0.0_wp )  THEN
-             message_string = 'Coriolis force is switched on (omega /= 0.0) and' //                &
-                              ' initial profiles u_profile and v_profile are prescribed'
-             CALL message( 'check_parameters', 'PA0347', 0, 0, 0, 6, 0 )
-          ENDIF
-
-          use_prescribed_profile_data = .TRUE.
-
-          kk = 1
-          u_init(0) = 0.0_wp
-          v_init(0) = 0.0_wp
-
-          DO  k = 1, nz+1
-
-             IF ( kk < 200 )  THEN
-                DO  WHILE ( uv_heights(kk+1) <= zu(k) )
-                   kk = kk + 1
-                   IF ( kk == 200 )  EXIT
-                ENDDO
-             ENDIF
-
-             IF ( kk < 200  .AND.  uv_heights(kk+1) /= 9999999.9_wp )  THEN
-                u_init(k) = u_profile(kk) + ( zu(k) - uv_heights(kk) ) /                           &
-                                            ( uv_heights(kk+1) - uv_heights(kk) ) *                &
-                                            ( u_profile(kk+1) - u_profile(kk) )
-                v_init(k) = v_profile(kk) + ( zu(k) - uv_heights(kk) ) /                           &
-                                            ( uv_heights(kk+1) - uv_heights(kk) ) *                &
-                                            ( v_profile(kk+1) - v_profile(kk) )
-             ELSE
-                u_init(k) = u_profile(kk)
-                v_init(k) = v_profile(kk)
-             ENDIF
-
-          ENDDO
-
-       ELSE
-
-          message_string = 'u_profile(1) and v_profile(1) must be 0.0'
-          CALL message( 'check_parameters', 'PA0346', 1, 2, 0, 6, 0 )
-
-       ENDIF
-
-!
-!--    Compute initial temperature profile using the given temperature gradients
-       IF (  .NOT.  neutral )  THEN
-          CALL init_vertical_profiles( pt_vertical_gradient_level_ind, pt_vertical_gradient_level, &
-                                       pt_vertical_gradient, pt_init, pt_surface, bc_pt_t_val )
-       ENDIF
-!
-!--    Compute initial humidity profile using the given humidity gradients
-       IF ( humidity )  THEN
-          CALL init_vertical_profiles( q_vertical_gradient_level_ind, q_vertical_gradient_level,   &
-                                       q_vertical_gradient, q_init, q_surface, bc_q_t_val )
-       ENDIF
-!
-!--    Compute initial scalar profile using the given scalar gradients
-       IF ( passive_scalar )  THEN
-          CALL init_vertical_profiles( s_vertical_gradient_level_ind, s_vertical_gradient_level,   &
-                                       s_vertical_gradient, s_init, s_surface, bc_s_t_val )
-       ENDIF
-!
-!--    TODO
-!--    Compute initial chemistry profile using the given chemical species gradients
-!--    Russo: Is done in chem_init --> kanani: Revise
-
-    ENDIF
-
-!
-!-- Check if the control parameter use_subsidence_tendencies is used correctly
-    IF ( use_subsidence_tendencies  .AND.  .NOT.  large_scale_subsidence )  THEN
-       message_string = 'The usage of use_subsidence_tendencies ' //                               &
-                        'requires large_scale_subsidence = .T..'
-       CALL message( 'check_parameters', 'PA0396', 1, 2, 0, 6, 0 )
-    ELSEIF ( use_subsidence_tendencies  .AND.  .NOT. large_scale_forcing )  THEN
-       message_string = 'The usage of use_subsidence_tendencies ' //           &
-                        'requires large_scale_forcing = .T..'
-       CALL message( 'check_parameters', 'PA0397', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Initialize large scale subsidence if required
-    If ( large_scale_subsidence )  THEN
-       IF ( subs_vertical_gradient_level(1) /= -9999999.9_wp  .AND. .NOT. large_scale_forcing )    &
-       THEN
-          CALL init_w_subsidence
-       ENDIF
-!
-!--    In case large_scale_forcing is used, profiles for subsidence velocity are read in from file
-!--    LSF_DATA
-
-       IF ( subs_vertical_gradient_level(1) == -9999999.9_wp  .AND. .NOT. large_scale_forcing )    &
-       THEN
-          message_string = 'There is no default large scale vertical velocity profile set. ' //    &
-                           'Specify the subsidence velocity profile via subs_vertical_gradient' // &
-                           ' and subs_vertical_gradient_level.'
-          CALL message( 'check_parameters', 'PA0380', 1, 2, 0, 6, 0 )
-       ENDIF
-    ELSE
-        IF ( subs_vertical_gradient_level(1) /= -9999999.9_wp )  THEN
-           message_string = 'Enable usage of large scale subsidence by ' //                        &
-                            'setting large_scale_subsidence = .T..'
-          CALL message( 'check_parameters', 'PA0381', 1, 2, 0, 6, 0 )
-        ENDIF
-    ENDIF
-
-!
-!-- Overwrite parameters from namelist if necessary and compute Coriolis parameter.
-!-- @todo - move initialization of f and fs to coriolis_mod.
-    IF ( input_pids_static )  THEN
-       latitude       = init_model%latitude
-       longitude      = init_model%longitude
-       rotation_angle = init_model%rotation_angle
-    ENDIF
-
-    f  = 2.0_wp * omega * SIN( latitude / 180.0_wp * pi )
-    fs = 2.0_wp * omega * COS( latitude / 180.0_wp * pi )
-
-!
-!-- Check and set buoyancy related parameters and switches
-    IF ( reference_state == 'horizontal_average' )  THEN
-       CONTINUE
-    ELSEIF ( reference_state == 'initial_profile' )  THEN
-       use_initial_profile_as_reference = .TRUE.
-    ELSEIF ( reference_state == 'single_value' )  THEN
-       use_single_reference_value = .TRUE.
-       IF ( pt_reference == 9999999.9_wp )  pt_reference = pt_surface
-       vpt_reference = pt_reference * ( 1.0_wp + 0.61_wp * q_surface )
-    ELSE
-       message_string = 'illegal value for reference_state: "' // TRIM( reference_state ) // '"'
-       CALL message( 'check_parameters', 'PA0056', 1, 2, 0, 6, 0 )
-    ENDIF
+!
+!--       In case of no given humidity gradients, choose zero gradient
+!--       conditions
+          IF ( q_vertical_gradient_level(1) == -1.0 )  THEN
+             q_vertical_gradient_level(1) = 0.0
+          ENDIF
+
+!
+!--       Store humidity gradient at the top boundary for possile Neumann
+!--       boundary condition
+          bc_q_t_val = ( q_init(nzt) - q_init(nzt-1) ) / dzu(nzt)
+
+       ENDIF
+
+    ENDIF
+
+!
+!-- Compute Coriolis parameter
+    f  = 2.0 * omega * SIN( phi / 180.0 * pi )
+    fs = 2.0 * omega * COS( phi / 180.0 * pi )
 
 !
 !-- In case of a given slope, compute the relevant quantities
-    IF ( alpha_surface /= 0.0_wp )  THEN
-       IF ( ABS( alpha_surface ) > 90.0_wp )  THEN
-          WRITE( message_string, * ) 'ABS( alpha_surface = ', alpha_surface, ' ) must be < 90.0'
-          CALL message( 'check_parameters', 'PA0043', 1, 2, 0, 6, 0 )
+    IF ( alpha_surface /= 0.0 )  THEN
+       IF ( ABS( alpha_surface ) > 90.0 )  THEN
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters: ABS( alpha_surface',&
+                                    '=', alpha_surface, ' ) must be < 90.0'
+          CALL local_stop
        ENDIF
        sloping_surface = .TRUE.
-       cos_alpha_surface = COS( alpha_surface / 180.0_wp * pi )
-       sin_alpha_surface = SIN( alpha_surface / 180.0_wp * pi )
+       cos_alpha_surface = COS( alpha_surface / 180.0 * pi )
+       sin_alpha_surface = SIN( alpha_surface / 180.0 * pi )
     ENDIF
 
 !
 !-- Check time step and cfl_factor
-    IF ( dt /= -1.0_wp )  THEN
-       IF ( dt <= 0.0_wp )  THEN
-          WRITE( message_string, * ) 'dt = ', dt , ' <= 0.0'
-          CALL message( 'check_parameters', 'PA0044', 1, 2, 0, 6, 0 )
+    IF ( dt /= -1.0 )  THEN
+       IF ( dt <= 0.0  .AND.  dt /= -1.0 )  THEN
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters:  dt=', dt, ' <= 0.0'
+          CALL local_stop
        ENDIF
        dt_3d = dt
@@ -1195,17 +696,25 @@
     ENDIF
 
-    IF ( cfl_factor <= 0.0_wp  .OR.  cfl_factor > 1.0_wp )  THEN
-       IF ( cfl_factor == -1.0_wp )  THEN
-          IF ( timestep_scheme == 'runge-kutta-2' )  THEN
-             cfl_factor = 0.8_wp
-          ELSEIF ( timestep_scheme == 'runge-kutta-3' )  THEN
-             cfl_factor = 0.9_wp
+    IF ( cfl_factor <= 0.0  .OR.  cfl_factor > 1.0 )  THEN
+       IF ( cfl_factor == -1.0 )  THEN
+          IF ( momentum_advec == 'ups-scheme'  .OR.  &
+               scalar_advec == 'ups-scheme' )  THEN
+             cfl_factor = 0.8
           ELSE
-             cfl_factor = 0.9_wp
+             IF ( timestep_scheme == 'runge-kutta-2' )  THEN
+                cfl_factor = 0.8
+             ELSEIF ( timestep_scheme == 'runge-kutta-3' )  THEN
+                cfl_factor = 0.9
+             ELSE
+                cfl_factor = 0.1
+             ENDIF
           ENDIF
        ELSE
-          WRITE( message_string, * ) 'cfl_factor = ', cfl_factor,                                  &
-                 ' out of range &0.0 < cfl_factor <= 1.0 is required'
-          CALL message( 'check_parameters', 'PA0045', 1, 2, 0, 6, 0 )
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters: cfl_factor=', cfl_factor, &
+                         ' out of range'
+             PRINT*, '+++                   0.0 < cfl_factor <= 1.0 is required'
+          ENDIF
+          CALL local_stop
        ENDIF
     ENDIF
@@ -1216,72 +725,106 @@
 
 !
-!-- Store reference time for coupled runs and change the coupling flag, if ...
-    IF ( simulated_time == 0.0_wp )  THEN
-       IF ( coupling_start_time == 0.0_wp )  THEN
-          time_since_reference_point = 0.0_wp
-       ELSEIF ( time_since_reference_point < 0.0_wp )  THEN
-          run_coupled = .FALSE.
-       ENDIF
-    ENDIF
-
-!
 !-- Set wind speed in the Galilei-transformed system
     IF ( galilei_transformation )  THEN
-       IF ( use_ug_for_galilei_tr                    .AND.                                         &
-            ug_vertical_gradient_level(1) == 0.0_wp  .AND.                                         &
-            ug_vertical_gradient(1)       == 0.0_wp  .AND.                                         &
-            vg_vertical_gradient_level(1) == 0.0_wp  .AND.                                         &
-            vg_vertical_gradient(1)       == 0.0_wp )  THEN
-          u_gtrans = ug_surface * 0.6_wp
-          v_gtrans = vg_surface * 0.6_wp
-       ELSEIF ( use_ug_for_galilei_tr  .AND.  ( ug_vertical_gradient_level(1) /= 0.0_wp .OR.       &
-                                                ug_vertical_gradient(1) /= 0.0_wp ) )  THEN
-          message_string = 'baroclinity (ug) not allowed simultaneously' //                        &
-                           ' with galilei transformation'
-          CALL message( 'check_parameters', 'PA0046', 1, 2, 0, 6, 0 )
-       ELSEIF ( use_ug_for_galilei_tr  .AND.  ( vg_vertical_gradient_level(1) /= 0.0_wp  .OR.      &
-                                                vg_vertical_gradient(1) /= 0.0_wp ) )  THEN
-          message_string = 'baroclinity (vg) not allowed simultaneously' //                        &
-                           ' with galilei transformation'
-          CALL message( 'check_parameters', 'PA0047', 1, 2, 0, 6, 0 )
+       IF ( use_ug_for_galilei_tr .AND.                &
+            ug_vertical_gradient_level(1) == 0.0 .AND. & 
+            vg_vertical_gradient_level(1) == 0.0 )  THEN
+          u_gtrans = ug_surface
+          v_gtrans = vg_surface
+       ELSEIF ( use_ug_for_galilei_tr .AND.                &
+                ug_vertical_gradient_level(1) /= 0.0 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    baroclinicity (ug) not allowed'
+             PRINT*, '    simultaneously with galilei transformation'
+          ENDIF
+          CALL local_stop
+       ELSEIF ( use_ug_for_galilei_tr .AND.                &
+                vg_vertical_gradient_level(1) /= 0.0 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    baroclinicity (vg) not allowed'
+             PRINT*, '    simultaneously with galilei transformation'
+          ENDIF
+          CALL local_stop
        ELSE
-          message_string = 'variable translation speed used for Galilei-transformation, which ' // &
-                           'may cause & instabilities in stably stratified regions'
-          CALL message( 'check_parameters', 'PA0048', 0, 1, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-!
-!-- In case of using a prandtl-layer, calculated (or prescribed) surface fluxes have to be used in
-!-- the diffusion-terms
-    IF ( constant_flux_layer )  use_surface_fluxes = .TRUE.
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ WARNING: check_parameters:'
+             PRINT*, '    variable translation speed used for galilei-tran' // &
+                          'sformation, which'
+             PRINT*, '    may cause instabilities in stably stratified regions'
+          ENDIF
+       ENDIF
+    ENDIF
+
+!
+!-- In case of using a prandtl-layer, calculated (or prescribed) surface
+!-- fluxes have to be used in the diffusion-terms
+    IF ( prandtl_layer )  use_surface_fluxes = .TRUE.
 
 !
 !-- Check boundary conditions and set internal variables:
-!-- Attention: the lateral boundary conditions have been already checked in parin
-!
-!-- Non-cyclic lateral boundaries require the multigrid method and Piascek-Willimas or
-!-- Wicker - Skamarock advection scheme. Several schemes and tools do not work with non-cyclic
-!-- boundary conditions.
+!-- Lateral boundary conditions
+    IF ( bc_lr /= 'cyclic'  .AND.  bc_lr /= 'dirichlet/neumann'  .AND. &
+         bc_lr /= 'neumann/dirichlet' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown boundary condition: bc_lr = ', bc_lr
+       ENDIF
+       CALL local_stop
+    ENDIF
+    IF ( bc_ns /= 'cyclic'  .AND.  bc_ns /= 'dirichlet/neumann'  .AND. &
+         bc_ns /= 'neumann/dirichlet' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown boundary condition: bc_ns = ', bc_ns
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+!
+!-- Non-cyclic lateral boundaries require the multigrid method and Piascek-
+!-- Willimas advection scheme. Several schemes and tools do not work with
+!-- non-cyclic boundary conditions.
     IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
-       IF ( psolver(1:9) /= 'multigrid' )  THEN
-          message_string = 'non-cyclic lateral boundaries do not allow ' // 'psolver = "' //       &
-                           TRIM( psolver ) // '"'
-          CALL message( 'check_parameters', 'PA0051', 1, 2, 0, 6, 0 )
-       ENDIF
-       IF ( momentum_advec /= 'pw-scheme'  .AND.  momentum_advec /= 'ws-scheme' )  THEN
-
-          message_string = 'non-cyclic lateral boundaries do not allow momentum_advec = "' //      &
-                           TRIM( momentum_advec ) // '"'
-          CALL message( 'check_parameters', 'PA0052', 1, 2, 0, 6, 0 )
-       ENDIF
-       IF ( scalar_advec /= 'pw-scheme'  .AND.  scalar_advec /= 'ws-scheme' )  THEN
-          message_string = 'non-cyclic lateral boundaries do not allow scalar_advec = "' //        &
-                           TRIM( scalar_advec ) // '"'
-          CALL message( 'check_parameters', 'PA0053', 1, 2, 0, 6, 0 )
+       IF ( psolver /= 'multigrid' )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    non-cyclic lateral boundaries do not allow', &
+                          ' psolver = ', psolver 
+          ENDIF
+          CALL local_stop
+       ENDIF
+       IF ( momentum_advec /= 'pw-scheme' )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    non-cyclic lateral boundaries do not allow', &
+                          ' momentum_advec = ', momentum_advec 
+          ENDIF
+          CALL local_stop
+       ENDIF
+       IF ( scalar_advec /= 'pw-scheme' )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    non-cyclic lateral boundaries do not allow', &
+                          ' scalar_advec = ', scalar_advec 
+          ENDIF
+          CALL local_stop
        ENDIF
        IF ( galilei_transformation )  THEN
-          message_string = 'non-cyclic lateral boundaries do not allow galilei_transformation = .T.'
-          CALL message( 'check_parameters', 'PA0054', 1, 2, 0, 6, 0 )
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    non-cyclic lateral boundaries do not allow', &
+                          ' galilei_transformation = .T.' 
+          ENDIF
+          CALL local_stop
+       ENDIF
+       IF ( conserve_volume_flow )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    non-cyclic lateral boundaries do not allow', &
+                          ' conserve_volume_flow = .T.' 
+          ENDIF
+          CALL local_stop
        ENDIF
     ENDIF
@@ -1291,15 +834,32 @@
     IF ( bc_e_b == 'neumann' )  THEN
        ibc_e_b = 1
+       IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ WARNING: check_parameters:'
+             PRINT*, '    adjust_mixing_length = TRUE and bc_e_b = ', bc_e_b
+          ENDIF
+       ENDIF
     ELSEIF ( bc_e_b == '(u*)**2+neumann' )  THEN
        ibc_e_b = 2
-       IF ( .NOT. constant_flux_layer )  THEN
+       IF ( .NOT. adjust_mixing_length  .AND.  prandtl_layer )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ WARNING: check_parameters:'
+             PRINT*, '    adjust_mixing_length = FALSE and bc_e_b = ', bc_e_b
+          ENDIF
+       ENDIF
+       IF ( .NOT. prandtl_layer )  THEN
           bc_e_b = 'neumann'
           ibc_e_b = 1
-          message_string = 'boundary condition bc_e_b changed to "' // TRIM( bc_e_b ) // '"'
-          CALL message( 'check_parameters', 'PA0057', 0, 1, 0, 6, 0 )
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ WARNING: check_parameters:'
+             PRINT*, '    boundary condition bc_e_b changed to "', bc_e_b, '"'
+          ENDIF
        ENDIF
     ELSE
-       message_string = 'unknown boundary condition: bc_e_b = "' // TRIM( bc_e_b ) // '"'
-       CALL message( 'check_parameters', 'PA0058', 1, 2, 0, 6, 0 )
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown boundary condition: bc_e_b = ', bc_e_b
+       ENDIF
+       CALL local_stop
     ENDIF
 
@@ -1310,173 +870,138 @@
     ELSEIF ( bc_p_b == 'neumann' )  THEN
        ibc_p_b = 1
+    ELSEIF ( bc_p_b == 'neumann+inhomo' )  THEN
+       ibc_p_b = 2
     ELSE
-       message_string = 'unknown boundary condition: bc_p_b = "' // TRIM( bc_p_b ) // '"'
-       CALL message( 'check_parameters', 'PA0059', 1, 2, 0, 6, 0 )
-    ENDIF
-
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown boundary condition: bc_p_b = ', bc_p_b
+       ENDIF
+       CALL local_stop
+    ENDIF
+    IF ( ibc_p_b == 2  .AND.  .NOT. prandtl_layer )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    boundary condition: bc_p_b = ', TRIM( bc_p_b ), &
+                       ' not allowed with'
+          PRINT*, '    prandtl_layer = .FALSE.' 
+       ENDIF
+       CALL local_stop
+    ENDIF
     IF ( bc_p_t == 'dirichlet' )  THEN
        ibc_p_t = 0
-!-- TO_DO: later set bc_p_t to neumann before, in case of nested domain
-    ELSEIF ( bc_p_t == 'neumann' .OR. bc_p_t == 'nested' )  THEN
+    ELSEIF ( bc_p_t == 'neumann' )  THEN
        ibc_p_t = 1
     ELSE
-       message_string = 'unknown boundary condition: bc_p_t = "' // TRIM( bc_p_t ) // '"'
-       CALL message( 'check_parameters', 'PA0061', 1, 2, 0, 6, 0 )
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown boundary condition: bc_p_t = ', bc_p_t
+       ENDIF
+       CALL local_stop
     ENDIF
 
 !
 !-- Boundary conditions for potential temperature
-    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
-       ibc_pt_b = 2
+    IF ( bc_pt_b == 'dirichlet' )  THEN
+       ibc_pt_b = 0
+    ELSEIF ( bc_pt_b == 'neumann' )  THEN
+       ibc_pt_b = 1
     ELSE
-       IF ( bc_pt_b == 'dirichlet' )  THEN
-          ibc_pt_b = 0
-       ELSEIF ( bc_pt_b == 'neumann' )  THEN
-          ibc_pt_b = 1
-       ELSE
-          message_string = 'unknown boundary condition: bc_pt_b = "' // TRIM( bc_pt_b ) // '"'
-          CALL message( 'check_parameters', 'PA0062', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown boundary condition: bc_pt_b = ', bc_pt_b
+       ENDIF
+       CALL local_stop
+    ENDIF
     IF ( bc_pt_t == 'dirichlet' )  THEN
        ibc_pt_t = 0
     ELSEIF ( bc_pt_t == 'neumann' )  THEN
        ibc_pt_t = 1
-    ELSEIF ( bc_pt_t == 'initial_gradient' )  THEN
-       ibc_pt_t = 2
-    ELSEIF ( bc_pt_t == 'nested'  .OR.  bc_pt_t == 'nesting_offline' )  THEN
-       ibc_pt_t = 3
     ELSE
-       message_string = 'unknown boundary condition: bc_pt_t = "' // TRIM( bc_pt_t ) // '"'
-       CALL message( 'check_parameters', 'PA0063', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( ANY( wall_heatflux /= 0.0_wp )  .AND.  surface_heatflux == 9999999.9_wp )  THEN
-       message_string = 'wall_heatflux additionally requires setting of surface_heatflux'
-       CALL message( 'check_parameters', 'PA0443', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!   This IF clause needs revision, got too complex!!
-    IF ( surface_heatflux == 9999999.9_wp  )  THEN
-       constant_heatflux = .FALSE.
-       IF ( large_scale_forcing  .OR.  land_surface  .OR.  urban_surface )  THEN
-          IF ( ibc_pt_b == 0 )  THEN
-             constant_heatflux = .FALSE.
-          ELSEIF ( ibc_pt_b == 1 )  THEN
-             constant_heatflux = .TRUE.
-             surface_heatflux = 0.0_wp
-          ENDIF
-       ENDIF
-    ELSE
-       constant_heatflux = .TRUE.
-    ENDIF
-
-    IF ( top_heatflux     == 9999999.9_wp )  constant_top_heatflux = .FALSE.
-
-    IF ( neutral )  THEN
-
-       IF ( surface_heatflux /= 0.0_wp  .AND.  surface_heatflux /= 9999999.9_wp )  THEN
-          message_string = 'heatflux must not be set for pure neutral flow'
-          CALL message( 'check_parameters', 'PA0351', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( top_heatflux /= 0.0_wp  .AND.  top_heatflux /= 9999999.9_wp )  THEN
-          message_string = 'heatflux must not be set for pure neutral flow'
-          CALL message( 'check_parameters', 'PA0351', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDIF
-
-    IF ( top_momentumflux_u /= 9999999.9_wp  .AND.  top_momentumflux_v /= 9999999.9_wp )  THEN
-       constant_top_momentumflux = .TRUE.
-    ELSEIF ( .NOT. ( top_momentumflux_u == 9999999.9_wp  .AND.                                     &
-           top_momentumflux_v == 9999999.9_wp ) )  THEN
-       message_string = 'both, top_momentumflux_u AND top_momentumflux_v must be set'
-       CALL message( 'check_parameters', 'PA0064', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- A given surface temperature implies Dirichlet boundary condition for temperature. In this case
-!-- specification of a constant heat flux is forbidden.
-    IF ( ibc_pt_b == 0  .AND.  constant_heatflux  .AND.  surface_heatflux /= 0.0_wp )  THEN
-       message_string = 'boundary_condition: bc_pt_b = "' // TRIM( bc_pt_b ) //                    &
-                        '& is not allowed with constant_heatflux = .TRUE.'
-       CALL message( 'check_parameters', 'PA0065', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( constant_heatflux  .AND.  pt_surface_initial_change /= 0.0_wp )  THEN
-       WRITE ( message_string, * )  'constant_heatflux = .TRUE. is not allo',                      &
-               'wed with pt_surface_initial_change (/=0) = ', pt_surface_initial_change
-       CALL message( 'check_parameters', 'PA0066', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( constant_heatflux  .AND.  pt_surface_heating_rate /= 0.0_wp )  THEN
-       WRITE ( message_string, * )  'constant_heatflux = .TRUE. is not allo',                      &
-               'wed with pt_surface_heating_rate (/=0) = ', pt_surface_heating_rate
-       CALL message( 'check_parameters', 'PA0497', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- A given temperature at the top implies Dirichlet boundary condition for temperature. In this
-!-- case specification of a constant heat flux is forbidden.
-    IF ( ibc_pt_t == 0  .AND.  constant_top_heatflux  .AND.  top_heatflux /= 0.0_wp )  THEN
-       message_string = 'boundary_condition: bc_pt_t = "' // TRIM( bc_pt_t ) //                    &
-                        '" is not allowed with constant_top_heatflux = .TRUE.'
-       CALL message( 'check_parameters', 'PA0067', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Set boundary conditions for total water content
-    IF ( humidity )  THEN
-
-       IF ( ANY( wall_humidityflux /= 0.0_wp )  .AND.  surface_waterflux == 9999999.9_wp )  THEN
-          message_string = 'wall_humidityflux additionally requires setting of surface_waterflux'
-          CALL message( 'check_parameters', 'PA0444', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       CALL set_bc_scalars( 'q', bc_q_b, bc_q_t, ibc_q_b, ibc_q_t, 'PA0071', 'PA0072' )
-
-       IF ( surface_waterflux == 9999999.9_wp  )  THEN
-          constant_waterflux = .FALSE.
-          IF ( large_scale_forcing .OR. land_surface )  THEN
-             IF ( ibc_q_b == 0 )  THEN
-                constant_waterflux = .FALSE.
-             ELSEIF ( ibc_q_b == 1 )  THEN
-                constant_waterflux = .TRUE.
-             ENDIF
-          ENDIF
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown boundary condition: bc_pt_t = ', bc_pt_t
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+    IF ( surface_heatflux == 9999999.9 )  constant_heatflux = .FALSE.
+
+!
+!-- A given surface temperature implies Dirichlet boundary condition for
+!-- temperature. In this case specification of a constant heat flux is
+!-- forbidden.
+    IF ( ibc_pt_b == 0  .AND.   constant_heatflux  .AND. &
+         surface_heatflux /= 0.0 )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    boundary_condition: bc_pt_b = ', bc_pt_b
+          PRINT*, '    is not allowed with constant_heatflux = .TRUE.'
+       ENDIF
+       CALL local_stop
+    ENDIF
+    IF ( constant_heatflux  .AND.  pt_surface_initial_change /= 0.0 )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters: constant_heatflux = .TRUE. is not'
+          PRINT*, '    allowed with pt_surface_initial_change (/=0) = ', &
+                  pt_surface_initial_change
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+!
+!-- In case of moisture or passive scalar, set boundary conditions for total 
+!-- water content / scalar
+    IF ( moisture  .OR.  passive_scalar ) THEN
+       IF ( moisture )  THEN
+          sq = 'q'
        ELSE
-          constant_waterflux = .TRUE.
-       ENDIF
-
-       CALL check_bc_scalars( 'q', bc_q_b, ibc_q_b, 'PA0073', 'PA0074', constant_waterflux,        &
-                              q_surface_initial_change )
-
-    ENDIF
-
-    IF ( passive_scalar )  THEN
-
-       IF ( ANY( wall_scalarflux /= 0.0_wp )  .AND.  surface_scalarflux == 9999999.9_wp )  THEN
-          message_string = 'wall_scalarflux additionally requires setting of surface_scalarflux'
-          CALL message( 'check_parameters', 'PA0445', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( surface_scalarflux == 9999999.9_wp )  constant_scalarflux = .FALSE.
-
-       CALL set_bc_scalars( 's', bc_s_b, bc_s_t, ibc_s_b, ibc_s_t, 'PA0071', 'PA0072' )
-
-       CALL check_bc_scalars( 's', bc_s_b, ibc_s_b, 'PA0073', 'PA0074', constant_scalarflux,       &
-                              s_surface_initial_change )
-
-       IF ( top_scalarflux == 9999999.9_wp )  constant_top_scalarflux = .FALSE.
-!
-!--    A fixed scalar concentration at the top implies Dirichlet boundary condition for scalar.
-!--    Hence, in this case specification of a constant scalar flux is forbidden.
-       IF ( ( ibc_s_t == 0 .OR. ibc_s_t == 2 )  .AND.  constant_top_scalarflux  .AND.              &
-              top_scalarflux /= 0.0_wp )  THEN
-          message_string = 'boundary condition: bc_s_t = "' // TRIM( bc_s_t ) //                   &
-                           '" is not allowed with top_scalarflux /= 0.0'
-          CALL message( 'check_parameters', 'PA0441', 1, 2, 0, 6, 0 )
-       ENDIF
+          sq = 's'
+       ENDIF
+       IF ( bc_q_b == 'dirichlet' )  THEN
+          ibc_q_b = 0
+       ELSEIF ( bc_q_b == 'neumann' )  THEN
+          ibc_q_b = 1
+       ELSE
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    unknown boundary condition: bc_', sq, '_b = ', bc_q_b
+          ENDIF
+          CALL local_stop
+       ENDIF
+       IF ( bc_q_t == 'dirichlet' )  THEN
+          ibc_q_t = 0
+       ELSEIF ( bc_q_t == 'neumann' )  THEN
+          ibc_q_t = 1
+       ELSE
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    unknown boundary condition: bc_', sq, '_t = ', bc_q_t
+          ENDIF
+          CALL local_stop
+       ENDIF
+
+       IF ( surface_waterflux == 0.0 )  constant_waterflux = .FALSE.
+
+!
+!--    A given surface humidity implies Dirichlet boundary condition for
+!--    moisture. In this case specification of a constant water flux is
+!--    forbidden.
+       IF ( ibc_q_b == 0  .AND.  constant_waterflux )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    boundary_condition: bc_', sq, '_b = ', bc_q_b
+             PRINT*, '    is not allowed with prescribed surface flux'
+          ENDIF
+          CALL local_stop
+       ENDIF
+       IF ( constant_waterflux  .AND.  q_surface_initial_change /= 0.0 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters: a prescribed surface flux is not'
+             PRINT*, '    allowed with ', sq, '_surface_initial_change (/=0)', &
+                     ' = ', q_surface_initial_change
+          ENDIF
+          CALL local_stop
+       ENDIF
+       
     ENDIF
 
@@ -1487,149 +1012,185 @@
     ELSEIF ( bc_uv_b == 'neumann' )  THEN
        ibc_uv_b = 1
-       IF ( constant_flux_layer )  THEN
-          message_string = 'boundary condition: bc_uv_b = "' // TRIM( bc_uv_b ) //                 &
-                           '" is not allowed with constant_flux_layer = .TRUE.'
-          CALL message( 'check_parameters', 'PA0075', 1, 2, 0, 6, 0 )
+       IF ( prandtl_layer )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    boundary condition: bc_uv_b = ', TRIM( bc_uv_b ), &
+                          ' is not allowed with'
+             PRINT*, '    prandtl_layer = .TRUE.' 
+          ENDIF
+          CALL local_stop
        ENDIF
     ELSE
-       message_string = 'unknown boundary condition: bc_uv_b = "' // TRIM( bc_uv_b ) // '"'
-       CALL message( 'check_parameters', 'PA0076', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- In case of coupled simulations u and v at the ground in atmosphere will be assigned with the u
-!-- and v values of the ocean surface
-    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
-       ibc_uv_b = 2
-    ENDIF
-
-    IF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
-       bc_uv_t = 'neumann'
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown boundary condition: bc_uv_b = ', bc_uv_b
+       ENDIF
+       CALL local_stop
+    ENDIF
+    IF ( bc_uv_t == 'dirichlet' )  THEN
+       ibc_uv_t = 0
+    ELSEIF ( bc_uv_t == 'neumann' )  THEN
        ibc_uv_t = 1
     ELSE
-       IF ( bc_uv_t == 'dirichlet' .OR. bc_uv_t == 'dirichlet_0' )  THEN
-          ibc_uv_t = 0
-          IF ( bc_uv_t == 'dirichlet_0' )  THEN
-!
-!--          Velocities for the initial u,v-profiles are set zero at the top in case of dirichlet_0
-!--          conditions
-             u_init(nzt+1)    = 0.0_wp
-             v_init(nzt+1)    = 0.0_wp
-          ENDIF
-       ELSEIF ( bc_uv_t == 'neumann' )  THEN
-          ibc_uv_t = 1
-       ELSEIF ( bc_uv_t == 'nested'  .OR.  bc_uv_t == 'nesting_offline' )  THEN
-          ibc_uv_t = 3
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown boundary condition: bc_uv_t = ', bc_uv_t
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+!
+!-- Compute and check, respectively, the Rayleigh Damping parameter
+    IF ( rayleigh_damping_factor == -1.0 )  THEN
+       IF ( momentum_advec == 'ups-scheme' )  THEN
+          rayleigh_damping_factor = 0.01
        ELSE
-          message_string = 'unknown boundary condition: bc_uv_t = "' // TRIM( bc_uv_t ) // '"'
-          CALL message( 'check_parameters', 'PA0077', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-!
-!-- Compute and check, respectively, the Rayleigh Damping parameter
-    IF ( rayleigh_damping_factor == -1.0_wp )  THEN
-       rayleigh_damping_factor = 0.0_wp
+          rayleigh_damping_factor = 0.0
+       ENDIF
     ELSE
-       IF ( rayleigh_damping_factor < 0.0_wp  .OR.  rayleigh_damping_factor > 1.0_wp )  THEN
-          WRITE( message_string, * )  'rayleigh_damping_factor = ', rayleigh_damping_factor,       &
-                 ' out of range [0.0,1.0]'
-          CALL message( 'check_parameters', 'PA0078', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    IF ( rayleigh_damping_height == -1.0_wp )  THEN
-       IF ( .NOT. ocean_mode )  THEN
-          rayleigh_damping_height = 0.66666666666_wp * zu(nzt)
-       ELSE
-          rayleigh_damping_height = 0.66666666666_wp * zu(nzb)
-       ENDIF
+       IF ( rayleigh_damping_factor < 0.0 .OR. rayleigh_damping_factor > 1.0 ) &
+       THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    rayleigh_damping_factor = ', rayleigh_damping_factor,&
+                          ' out of range [0.0,1.0]'
+          ENDIF
+          CALL local_stop
+       ENDIF
+    ENDIF
+
+    IF ( rayleigh_damping_height == -1.0 )  THEN
+       rayleigh_damping_height = 0.66666666666 * zu(nzt)
     ELSE
-       IF ( .NOT. ocean_mode )  THEN
-          IF ( rayleigh_damping_height < 0.0_wp  .OR.  rayleigh_damping_height > zu(nzt) )  THEN
-             WRITE( message_string, * )  'rayleigh_damping_height = ',  rayleigh_damping_height,   &
-                    ' out of range [0.0,', zu(nzt), ']'
-             CALL message( 'check_parameters', 'PA0079', 1, 2, 0, 6, 0 )
-          ENDIF
-       ELSE
-          IF ( rayleigh_damping_height > 0.0_wp  .OR.  rayleigh_damping_height < zu(nzb) )  THEN
-             WRITE( message_string, * )  'rayleigh_damping_height = ', rayleigh_damping_height,    &
-                    ' out of range [0.0,', zu(nzb), ']'
-             CALL message( 'check_parameters', 'PA0079', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-
-!
-!-- Check number of chosen statistic regions
-    IF ( statistic_regions < 0 )  THEN
-       WRITE ( message_string, * ) 'number of statistic_regions = ', statistic_regions+1,          &
-               ' is not allowed'
-       CALL message( 'check_parameters', 'PA0082', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( normalizing_region > statistic_regions  .OR.  normalizing_region < 0)  THEN
-       WRITE ( message_string, * ) 'normalizing_region = ', normalizing_region,                    &
-               ' must be >= 0 and <= ',statistic_regions, ' (value of statistic_regions)'
-       CALL message( 'check_parameters', 'PA0083', 1, 2, 0, 6, 0 )
+       IF ( rayleigh_damping_height < 0.0  .OR. &
+            rayleigh_damping_height > zu(nzt) )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:'
+             PRINT*, '    rayleigh_damping_height = ', rayleigh_damping_height,&
+                          ' out of range [0.0,', zu(nzt), ']'
+          ENDIF
+          CALL local_stop
+       ENDIF
+    ENDIF
+
+!
+!-- Check limiters for Upstream-Spline scheme
+    IF ( overshoot_limit_u < 0.0  .OR.  overshoot_limit_v < 0.0  .OR.  &
+         overshoot_limit_w < 0.0  .OR.  overshoot_limit_pt < 0.0  .OR. &
+         overshoot_limit_e < 0.0 )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    overshoot_limit_... < 0.0 is not allowed'
+       ENDIF
+       CALL local_stop
+    ENDIF
+    IF ( ups_limit_u < 0.0 .OR. ups_limit_v < 0.0 .OR. ups_limit_w < 0.0 .OR. &
+         ups_limit_pt < 0.0 .OR. ups_limit_e < 0.0 )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    ups_limit_... < 0.0 is not allowed'
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+!
+!-- Check number of chosen statistic regions. More than 10 regions are not
+!-- allowed, because so far no more than 10 corresponding output files can
+!-- be opened (cf. check_open)
+    IF ( statistic_regions > 9  .OR.  statistic_regions < 0 )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters: Number of statistic_regions = ', &
+                       statistic_regions+1
+          PRINT*, '    Only 10 regions are allowed'
+       ENDIF
+       CALL local_stop
+    ENDIF
+    IF ( normalizing_region > statistic_regions  .OR. &
+         normalizing_region < 0)  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters: normalizing_region = ', &
+                       normalizing_region, ' is unknown'
+          PRINT*, '    Must be <= ', statistic_regions
+       ENDIF
+       CALL local_stop
     ENDIF
 
 !
 !-- Set the default intervals for data output, if necessary
-!-- NOTE: dt_dosp has already been set in spectra_parin
-    IF ( dt_data_output /= 9999999.9_wp )  THEN
-       IF ( dt_dopr           == 9999999.9_wp )  dt_dopr           = dt_data_output
-       IF ( dt_dopts          == 9999999.9_wp )  dt_dopts          = dt_data_output
-       IF ( dt_do2d_xy        == 9999999.9_wp )  dt_do2d_xy        = dt_data_output
-       IF ( dt_do2d_xz        == 9999999.9_wp )  dt_do2d_xz        = dt_data_output
-       IF ( dt_do2d_yz        == 9999999.9_wp )  dt_do2d_yz        = dt_data_output
-       IF ( dt_do3d           == 9999999.9_wp )  dt_do3d           = dt_data_output
-       IF ( dt_data_output_av == 9999999.9_wp )  dt_data_output_av = dt_data_output
-       DO  mid = 1, max_masks
-          IF ( dt_domask(mid) == 9999999.9_wp )  dt_domask(mid)    = dt_data_output
-       ENDDO
+!-- NOTE: dt_dosp has already been set in package_parin
+    IF ( dt_data_output /= 9999999.9 )  THEN
+       IF ( dt_dopr           == 9999999.9 )  dt_dopr           = dt_data_output
+       IF ( dt_dopts          == 9999999.9 )  dt_dopts          = dt_data_output
+       IF ( dt_do2d_xy        == 9999999.9 )  dt_do2d_xy        = dt_data_output
+       IF ( dt_do2d_xz        == 9999999.9 )  dt_do2d_xz        = dt_data_output
+       IF ( dt_do2d_yz        == 9999999.9 )  dt_do2d_yz        = dt_data_output
+       IF ( dt_do3d           == 9999999.9 )  dt_do3d           = dt_data_output
+       IF ( dt_data_output_av == 9999999.9 )  dt_data_output_av = dt_data_output
     ENDIF
 
 !
 !-- Set the default skip time intervals for data output, if necessary
-    IF ( skip_time_dopr    == 9999999.9_wp )  skip_time_dopr    = skip_time_data_output
-    IF ( skip_time_do2d_xy == 9999999.9_wp )  skip_time_do2d_xy = skip_time_data_output
-    IF ( skip_time_do2d_xz == 9999999.9_wp )  skip_time_do2d_xz = skip_time_data_output
-    IF ( skip_time_do2d_yz == 9999999.9_wp )  skip_time_do2d_yz = skip_time_data_output
-    IF ( skip_time_do3d    == 9999999.9_wp )  skip_time_do3d    = skip_time_data_output
-    IF ( skip_time_data_output_av == 9999999.9_wp )                                                &
-                                       skip_time_data_output_av = skip_time_data_output
-    DO  mid = 1, max_masks
-       IF ( skip_time_domask(mid) == 9999999.9_wp )                                                &
-                                       skip_time_domask(mid)    = skip_time_data_output
-    ENDDO
-
-!
-!-- Check the average intervals (first for 3d-data, then for profiles)
+    IF ( skip_time_dopr    == 9999999.9 ) &
+                                       skip_time_dopr    = skip_time_data_output
+    IF ( skip_time_dosp    == 9999999.9 ) &
+                                       skip_time_dosp    = skip_time_data_output
+    IF ( skip_time_do2d_xy == 9999999.9 ) &
+                                       skip_time_do2d_xy = skip_time_data_output
+    IF ( skip_time_do2d_xz == 9999999.9 ) &
+                                       skip_time_do2d_xz = skip_time_data_output
+    IF ( skip_time_do2d_yz == 9999999.9 ) &
+                                       skip_time_do2d_yz = skip_time_data_output
+    IF ( skip_time_do3d    == 9999999.9 ) &
+                                       skip_time_do3d    = skip_time_data_output
+    IF ( skip_time_data_output_av == 9999999.9 ) &
+                                skip_time_data_output_av = skip_time_data_output
+
+!
+!-- Check the average intervals (first for 3d-data, then for profiles and
+!-- spectra)
     IF ( averaging_interval > dt_data_output_av )  THEN
-       WRITE( message_string, * )  'averaging_interval = ', averaging_interval,                    &
-              ' must be <= dt_data_output_av = ', dt_data_output_av
-       CALL message( 'check_parameters', 'PA0085', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( averaging_interval_pr == 9999999.9_wp )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters: average_interval=',              &
+                       averaging_interval, ' must be <= dt_data_output=', &
+                       dt_data_output
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+    IF ( averaging_interval_pr == 9999999.9 )  THEN
        averaging_interval_pr = averaging_interval
     ENDIF
 
     IF ( averaging_interval_pr > dt_dopr )  THEN
-       WRITE( message_string, * )  'averaging_interval_pr = ', averaging_interval_pr,              &
-              ' must be <= dt_dopr = ', dt_dopr
-       CALL message( 'check_parameters', 'PA0086', 1, 2, 0, 6, 0 )
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters: averaging_interval_pr=', &
+                       averaging_interval_pr, ' must be <= dt_dopr=', dt_dopr
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+    IF ( averaging_interval_sp == 9999999.9 )  THEN
+       averaging_interval_sp = averaging_interval
+    ENDIF
+
+    IF ( averaging_interval_sp > dt_dosp )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters: averaging_interval_sp=', &
+                       averaging_interval_sp, ' must be <= dt_dosp=', dt_dosp
+       ENDIF
+       CALL local_stop
     ENDIF
 
 !
 !-- Set the default interval for profiles entering the temporal average
-    IF ( dt_averaging_input_pr == 9999999.9_wp )  THEN
+    IF ( dt_averaging_input_pr == 9999999.9 )  THEN
        dt_averaging_input_pr = dt_averaging_input
     ENDIF
 
 !
-!-- Set the default interval for the output of timeseries to a reasonable value (tries to minimize
-!-- the number of calls of flow_statistics)
-    IF ( dt_dots == 9999999.9_wp )  THEN
-       IF ( averaging_interval_pr == 0.0_wp )  THEN
+!-- Set the default interval for the output of timeseries to a reasonable
+!-- value (tries to minimize the number of calls of flow_statistics)
+    IF ( dt_dots == 9999999.9 )  THEN
+       IF ( averaging_interval_pr == 0.0 )  THEN
           dt_dots = MIN( dt_run_control, dt_dopr )
        ELSE
@@ -1641,23 +1202,25 @@
 !-- Check the sample rate for averaging (first for 3d-data, then for profiles)
     IF ( dt_averaging_input > averaging_interval )  THEN
-       WRITE( message_string, * )  'dt_averaging_input = ', dt_averaging_input,                    &
-              ' must be <= averaging_interval = ', averaging_interval
-       CALL message( 'check_parameters', 'PA0088', 1, 2, 0, 6, 0 )
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters: dt_averaging_input=',                &
+                       dt_averaging_input, ' must be <= averaging_interval=', &
+                       averaging_interval
+       ENDIF
+       CALL local_stop
     ENDIF
 
     IF ( dt_averaging_input_pr > averaging_interval_pr )  THEN
-       WRITE( message_string, * )  'dt_averaging_input_pr = ', dt_averaging_input_pr,              &
-              ' must be <= averaging_interval_pr = ', averaging_interval_pr
-       CALL message( 'check_parameters', 'PA0089', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check data-output variable list for any duplicates and remove them
-    ALLOCATE( data_output_filtered(1:UBOUND( data_output_pr, DIM=1 )) )
-    CALL filter_duplicate_strings( varnamelength, data_output_pr, data_output_filtered )
-    data_output_pr = data_output_filtered
-    DEALLOCATE( data_output_filtered )
-!
-!-- Determine the number of output profiles and check whether they are permissible
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters: dt_averaging_input_pr=', &
+                       dt_averaging_input_pr,                     &
+                       ' must be <= averaging_interval_pr=',      &
+                       averaging_interval_pr
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+!
+!-- Determine the number of output profiles and check whether they are
+!-- permissible
     DO  WHILE ( data_output_pr(dopr_n+1) /= '          ' )
 
@@ -1666,18 +1229,10 @@
 
 !
-!--    Size check. Some arrays in the netcdf interface module are internally limited to 500 elements
-!--    and would need to be increased for output of more than 500 profiles.
-       IF ( dopr_n > 500 )  THEN
-          message_string = 'output of more than 500 profiles requested'
-          CALL message( 'check_parameters', 'PA0017', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    Determine internal profile number (for hom, homs) and store height levels
+!--    Determine internal profile number (for hom, homs)
+!--    and store height levels
        SELECT CASE ( TRIM( data_output_pr(i) ) )
 
           CASE ( 'u', '#u' )
              dopr_index(i) = 1
-             dopr_unit(i)  = 'm/s'
              hom(:,2,1,:)  = SPREAD( zu, 2, statistic_regions+1 )
              IF ( data_output_pr(i)(1:1) == '#' )  THEN
@@ -1689,6 +1244,5 @@
           CASE ( 'v', '#v' )
              dopr_index(i) = 2
-             dopr_unit(i)  = 'm/s'
-             hom(:,2,2,:)  = SPREAD( zu, 2, statistic_regions+1 )
+             hom(:,2,2,:) = SPREAD( zu, 2, statistic_regions+1 )
              IF ( data_output_pr(i)(1:1) == '#' )  THEN
                 dopr_initial_index(i) = 6
@@ -1699,46 +1253,36 @@
           CASE ( 'w' )
              dopr_index(i) = 3
-             dopr_unit(i)  = 'm/s'
-             hom(:,2,3,:)  = SPREAD( zw, 2, statistic_regions+1 )
-
-          CASE ( 'theta', '#theta' )
-             IF ( .NOT. bulk_cloud_model )  THEN
+             hom(:,2,3,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+          CASE ( 'pt', '#pt' )
+             IF ( .NOT. cloud_physics ) THEN
                 dopr_index(i) = 4
-                dopr_unit(i)  = 'K'
                 hom(:,2,4,:)  = SPREAD( zu, 2, statistic_regions+1 )
                 IF ( data_output_pr(i)(1:1) == '#' )  THEN
                    dopr_initial_index(i) = 7
                    hom(:,2,7,:)          = SPREAD( zu, 2, statistic_regions+1 )
-                   hom(nzb,2,7,:)        = 0.0_wp    ! because zu(nzb) is negative
+                   hom(nzb,2,7,:)        = 0.0    ! weil zu(nzb) negativ ist
                    data_output_pr(i)     = data_output_pr(i)(2:)
                 ENDIF
              ELSE
                 dopr_index(i) = 43
-                dopr_unit(i)  = 'K'
                 hom(:,2,43,:)  = SPREAD( zu, 2, statistic_regions+1 )
                 IF ( data_output_pr(i)(1:1) == '#' )  THEN
                    dopr_initial_index(i) = 28
                    hom(:,2,28,:)         = SPREAD( zu, 2, statistic_regions+1 )
-                   hom(nzb,2,28,:)       = 0.0_wp    ! because zu(nzb) is negative
+                   hom(nzb,2,28,:)       = 0.0    ! weil zu(nzb) negativ ist
                    data_output_pr(i)     = data_output_pr(i)(2:)
                 ENDIF
              ENDIF
 
-          CASE ( 'e', '#e' )
+          CASE ( 'e' )
              dopr_index(i)  = 8
-             dopr_unit(i)   = 'm2/s2'
              hom(:,2,8,:)   = SPREAD( zu, 2, statistic_regions+1 )
-             hom(nzb,2,8,:) = 0.0_wp
-             IF ( data_output_pr(i)(1:1) == '#' )  THEN
-                dopr_initial_index(i) = 8
-                hom(:,2,8,:)          = SPREAD( zu, 2, statistic_regions+1 )
-                data_output_pr(i)     = data_output_pr(i)(2:)
-             ENDIF
+             hom(nzb,2,8,:) = 0.0
 
           CASE ( 'km', '#km' )
              dopr_index(i)  = 9
-             dopr_unit(i)   = 'm2/s'
              hom(:,2,9,:)   = SPREAD( zu, 2, statistic_regions+1 )
-             hom(nzb,2,9,:) = 0.0_wp
+             hom(nzb,2,9,:) = 0.0
              IF ( data_output_pr(i)(1:1) == '#' )  THEN
                 dopr_initial_index(i) = 23
@@ -1749,7 +1293,6 @@
           CASE ( 'kh', '#kh' )
              dopr_index(i)   = 10
-             dopr_unit(i)    = 'm2/s'
              hom(:,2,10,:)   = SPREAD( zu, 2, statistic_regions+1 )
-             hom(nzb,2,10,:) = 0.0_wp
+             hom(nzb,2,10,:) = 0.0
              IF ( data_output_pr(i)(1:1) == '#' )  THEN
                 dopr_initial_index(i) = 24
@@ -1760,7 +1303,6 @@
           CASE ( 'l', '#l' )
              dopr_index(i)   = 11
-             dopr_unit(i)    = 'm'
              hom(:,2,11,:)   = SPREAD( zu, 2, statistic_regions+1 )
-             hom(nzb,2,11,:) = 0.0_wp
+             hom(nzb,2,11,:) = 0.0
              IF ( data_output_pr(i)(1:1) == '#' )  THEN
                 dopr_initial_index(i) = 25
@@ -1771,129 +1313,105 @@
           CASE ( 'w"u"' )
              dopr_index(i) = 12
-             dopr_unit(i)  = TRIM ( momentumflux_output_unit )
              hom(:,2,12,:) = SPREAD( zw, 2, statistic_regions+1 )
-             IF ( constant_flux_layer )  hom(nzb,2,12,:) = zu(1)
+             IF ( prandtl_layer )  hom(nzb,2,12,:) = zu(1)
 
           CASE ( 'w*u*' )
              dopr_index(i) = 13
-             dopr_unit(i)  = TRIM ( momentumflux_output_unit )
              hom(:,2,13,:) = SPREAD( zw, 2, statistic_regions+1 )
 
           CASE ( 'w"v"' )
              dopr_index(i) = 14
-             dopr_unit(i)  = TRIM ( momentumflux_output_unit )
              hom(:,2,14,:) = SPREAD( zw, 2, statistic_regions+1 )
-             IF ( constant_flux_layer )  hom(nzb,2,14,:) = zu(1)
+             IF ( prandtl_layer )  hom(nzb,2,14,:) = zu(1)
 
           CASE ( 'w*v*' )
              dopr_index(i) = 15
-             dopr_unit(i)  = TRIM ( momentumflux_output_unit )
              hom(:,2,15,:) = SPREAD( zw, 2, statistic_regions+1 )
 
-          CASE ( 'w"theta"' )
+          CASE ( 'w"pt"' )
              dopr_index(i) = 16
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,16,:) = SPREAD( zw, 2, statistic_regions+1 )
 
-          CASE ( 'w*theta*' )
+          CASE ( 'w*pt*' )
              dopr_index(i) = 17
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,17,:) = SPREAD( zw, 2, statistic_regions+1 )
 
-          CASE ( 'wtheta' )
+          CASE ( 'wpt' )
              dopr_index(i) = 18
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,18,:) = SPREAD( zw, 2, statistic_regions+1 )
 
           CASE ( 'wu' )
              dopr_index(i) = 19
-             dopr_unit(i)  = TRIM ( momentumflux_output_unit )
              hom(:,2,19,:) = SPREAD( zw, 2, statistic_regions+1 )
-             IF ( constant_flux_layer )  hom(nzb,2,19,:) = zu(1)
+             IF ( prandtl_layer )  hom(nzb,2,19,:) = zu(1)
 
           CASE ( 'wv' )
              dopr_index(i) = 20
-             dopr_unit(i)  = TRIM ( momentumflux_output_unit )
              hom(:,2,20,:) = SPREAD( zw, 2, statistic_regions+1 )
-             IF ( constant_flux_layer )  hom(nzb,2,20,:) = zu(1)
-
-          CASE ( 'w*theta*BC' )
+             IF ( prandtl_layer )  hom(nzb,2,20,:) = zu(1)
+
+          CASE ( 'w*pt*BC' )
              dopr_index(i) = 21
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,21,:) = SPREAD( zw, 2, statistic_regions+1 )
 
-          CASE ( 'wthetaBC' )
+          CASE ( 'wptBC' )
              dopr_index(i) = 22
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,22,:) = SPREAD( zw, 2, statistic_regions+1 )
 
           CASE ( 'u*2' )
              dopr_index(i) = 30
-             dopr_unit(i)  = 'm2/s2'
              hom(:,2,30,:) = SPREAD( zu, 2, statistic_regions+1 )
 
           CASE ( 'v*2' )
              dopr_index(i) = 31
-             dopr_unit(i)  = 'm2/s2'
              hom(:,2,31,:) = SPREAD( zu, 2, statistic_regions+1 )
 
           CASE ( 'w*2' )
              dopr_index(i) = 32
-             dopr_unit(i)  = 'm2/s2'
              hom(:,2,32,:) = SPREAD( zw, 2, statistic_regions+1 )
 
-          CASE ( 'theta*2' )
+          CASE ( 'pt*2' )
              dopr_index(i) = 33
-             dopr_unit(i)  = 'K2'
              hom(:,2,33,:) = SPREAD( zu, 2, statistic_regions+1 )
 
           CASE ( 'e*' )
              dopr_index(i) = 34
-             dopr_unit(i)  = 'm2/s2'
              hom(:,2,34,:) = SPREAD( zu, 2, statistic_regions+1 )
 
-          CASE ( 'w*2theta*' )
+          CASE ( 'w*2pt*' )
              dopr_index(i) = 35
-             dopr_unit(i)  = 'K m2/s2'
              hom(:,2,35,:) = SPREAD( zw, 2, statistic_regions+1 )
 
-          CASE ( 'w*theta*2' )
+          CASE ( 'w*pt*2' )
              dopr_index(i) = 36
-             dopr_unit(i)  = 'K2 m/s'
              hom(:,2,36,:) = SPREAD( zw, 2, statistic_regions+1 )
 
           CASE ( 'w*e*' )
              dopr_index(i) = 37
-             dopr_unit(i)  = 'm3/s3'
              hom(:,2,37,:) = SPREAD( zw, 2, statistic_regions+1 )
 
           CASE ( 'w*3' )
              dopr_index(i) = 38
-             dopr_unit(i)  = 'm3/s3'
              hom(:,2,38,:) = SPREAD( zw, 2, statistic_regions+1 )
 
           CASE ( 'Sw' )
              dopr_index(i) = 39
-             dopr_unit(i)  = 'none'
              hom(:,2,39,:) = SPREAD( zw, 2, statistic_regions+1 )
 
-          CASE ( 'p' )
-             dopr_index(i) = 40
-             dopr_unit(i)  = 'Pa'
-             hom(:,2,40,:) = SPREAD( zu, 2, statistic_regions+1 )
-
           CASE ( 'q', '#q' )
-             IF ( .NOT. humidity )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for humidity = .FALSE.'
-                CALL message( 'check_parameters', 'PA0092', 1, 2, 0, 6, 0 )
+             IF ( .NOT. cloud_physics )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for cloud_physics = FALSE'
+                ENDIF
+                CALL local_stop
              ELSE
                 dopr_index(i) = 41
-                dopr_unit(i)  = 'kg/kg'
-                hom(:,2,41,:) = SPREAD( zu, 2, statistic_regions+1 )
+                hom(:,2,41,:)  = SPREAD( zu, 2, statistic_regions+1 )
                 IF ( data_output_pr(i)(1:1) == '#' )  THEN
                    dopr_initial_index(i) = 26
                    hom(:,2,26,:)         = SPREAD( zu, 2, statistic_regions+1 )
-                   hom(nzb,2,26,:)       = 0.0_wp    ! because zu(nzb) is negative
+                   hom(nzb,2,26,:)       = 0.0    ! weil zu(nzb) negativ ist
                    data_output_pr(i)     = data_output_pr(i)(2:)
                 ENDIF
@@ -1902,355 +1420,433 @@
           CASE ( 's', '#s' )
              IF ( .NOT. passive_scalar )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for passive_scalar = .FALSE.'
-                CALL message( 'check_parameters', 'PA0093', 1, 2, 0, 6, 0 )
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for passive_scalar = FALSE'
+                ENDIF
+                CALL local_stop
              ELSE
-                dopr_index(i) = 115
-                dopr_unit(i)  = 'kg/m3'
-                hom(:,2,115,:) = SPREAD( zu, 2, statistic_regions+1 )
-                IF ( data_output_pr(i)(1:1) == '#' )  THEN
-                   dopr_initial_index(i) = 121
-                   hom(:,2,121,:)        = SPREAD( zu, 2, statistic_regions+1 )
-                   hom(nzb,2,121,:)      = 0.0_wp    ! because zu(nzb) is negative
-                   data_output_pr(i)     = data_output_pr(i)(2:)
-                ENDIF
-             ENDIF
-
-          CASE ( 'qv', '#qv' )
-             IF ( .NOT. bulk_cloud_model ) THEN
                 dopr_index(i) = 41
-                dopr_unit(i)  = 'kg/kg'
-                hom(:,2,41,:) = SPREAD( zu, 2, statistic_regions+1 )
+                hom(:,2,41,:)  = SPREAD( zu, 2, statistic_regions+1 )
                 IF ( data_output_pr(i)(1:1) == '#' )  THEN
                    dopr_initial_index(i) = 26
                    hom(:,2,26,:)         = SPREAD( zu, 2, statistic_regions+1 )
-                   hom(nzb,2,26,:)       = 0.0_wp    ! because zu(nzb) is negative
+                   hom(nzb,2,26,:)       = 0.0    ! weil zu(nzb) negativ ist
+                   data_output_pr(i)     = data_output_pr(i)(2:)
+                ENDIF
+             ENDIF
+
+          CASE ( 'qv', '#qv' )
+             IF ( .NOT. cloud_physics ) THEN
+                dopr_index(i) = 41
+                hom(:,2,41,:)  = SPREAD( zu, 2, statistic_regions+1 )
+                IF ( data_output_pr(i)(1:1) == '#' )  THEN
+                   dopr_initial_index(i) = 26
+                   hom(:,2,26,:)         = SPREAD( zu, 2, statistic_regions+1 )
+                   hom(nzb,2,26,:)       = 0.0    ! weil zu(nzb) negativ ist
                    data_output_pr(i)     = data_output_pr(i)(2:)
                 ENDIF
              ELSE
                 dopr_index(i) = 42
-                dopr_unit(i)  = 'kg/kg'
-                hom(:,2,42,:) = SPREAD( zu, 2, statistic_regions+1 )
+                hom(:,2,42,:)  = SPREAD( zu, 2, statistic_regions+1 )
                 IF ( data_output_pr(i)(1:1) == '#' )  THEN
                    dopr_initial_index(i) = 27
                    hom(:,2,27,:)         = SPREAD( zu, 2, statistic_regions+1 )
-                   hom(nzb,2,27,:)       = 0.0_wp   ! because zu(nzb) is negative
+                   hom(nzb,2,27,:)       = 0.0    ! weil zu(nzb) negativ ist
                    data_output_pr(i)     = data_output_pr(i)(2:)
                 ENDIF
              ENDIF
 
-          CASE ( 'thetal', '#thetal' )
-             IF ( .NOT. bulk_cloud_model ) THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for bulk_cloud_model = .FALSE.'
-                CALL message( 'check_parameters', 'PA0094', 1, 2, 0, 6, 0 )
+          CASE ( 'lpt', '#lpt' )
+             IF ( .NOT. cloud_physics ) THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for cloud_physics = FALSE'
+                ENDIF
+                CALL local_stop
              ELSE
                 dopr_index(i) = 4
-                dopr_unit(i)  = 'K'
                 hom(:,2,4,:)  = SPREAD( zu, 2, statistic_regions+1 )
                 IF ( data_output_pr(i)(1:1) == '#' )  THEN
                    dopr_initial_index(i) = 7
                    hom(:,2,7,:)          = SPREAD( zu, 2, statistic_regions+1 )
-                   hom(nzb,2,7,:)        = 0.0_wp    ! because zu(nzb) is negative
+                   hom(nzb,2,7,:)        = 0.0    ! weil zu(nzb) negativ ist
                    data_output_pr(i)     = data_output_pr(i)(2:)
                 ENDIF
              ENDIF
 
-          CASE ( 'thetav', '#thetav' )
+          CASE ( 'vpt', '#vpt' )
              dopr_index(i) = 44
-             dopr_unit(i)  = 'K'
-             hom(:,2,44,:) = SPREAD( zu, 2, statistic_regions+1 )
+             hom(:,2,44,:)  = SPREAD( zu, 2, statistic_regions+1 )
              IF ( data_output_pr(i)(1:1) == '#' )  THEN
                 dopr_initial_index(i) = 29
                 hom(:,2,29,:)         = SPREAD( zu, 2, statistic_regions+1 )
-                hom(nzb,2,29,:)       = 0.0_wp    ! because zu(nzb) is negative
+                hom(nzb,2,29,:)       = 0.0    ! weil zu(nzb) negativ ist
                 data_output_pr(i)     = data_output_pr(i)(2:)
              ENDIF
 
-          CASE ( 'w"thetav"' )
+          CASE ( 'w"vpt"' )
              dopr_index(i) = 45
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,45,:) = SPREAD( zw, 2, statistic_regions+1 )
 
-          CASE ( 'w*thetav*' )
+          CASE ( 'w*vpt*' )
              dopr_index(i) = 46
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,46,:) = SPREAD( zw, 2, statistic_regions+1 )
 
-          CASE ( 'wthetav' )
+          CASE ( 'wvpt' )
              dopr_index(i) = 47
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,47,:) = SPREAD( zw, 2, statistic_regions+1 )
 
           CASE ( 'w"q"' )
-             IF ( .NOT. humidity )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for humidity = .FALSE.'
-                CALL message( 'check_parameters', 'PA0092', 1, 2, 0, 6, 0 )
+             IF ( .NOT. cloud_physics ) THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for cloud_physics = FALSE'
+                ENDIF
+                CALL local_stop
              ELSE
                 dopr_index(i) = 48
-                dopr_unit(i)  = TRIM ( waterflux_output_unit )
                 hom(:,2,48,:) = SPREAD( zw, 2, statistic_regions+1 )
              ENDIF
 
           CASE ( 'w*q*' )
-             IF ( .NOT. humidity )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for humidity = .FALSE.'
-                CALL message( 'check_parameters', 'PA0092', 1, 2, 0, 6, 0 )
+             IF ( .NOT. cloud_physics ) THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for cloud_physics = FALSE'
+                ENDIF
+                CALL local_stop
              ELSE
                 dopr_index(i) = 49
-                dopr_unit(i)  = TRIM ( waterflux_output_unit )
                 hom(:,2,49,:) = SPREAD( zw, 2, statistic_regions+1 )
              ENDIF
 
           CASE ( 'wq' )
-             IF ( .NOT. humidity )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for humidity = .FALSE.'
-                CALL message( 'check_parameters', 'PA0092', 1, 2, 0, 6, 0 )
+             IF ( .NOT. cloud_physics ) THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for cloud_physics = FALSE'
+                ENDIF
+                CALL local_stop
              ELSE
                 dopr_index(i) = 50
-                dopr_unit(i)  = TRIM ( waterflux_output_unit )
                 hom(:,2,50,:) = SPREAD( zw, 2, statistic_regions+1 )
              ENDIF
 
           CASE ( 'w"s"' )
-             IF ( .NOT. passive_scalar )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for passive_scalar = .FALSE.'
-                CALL message( 'check_parameters', 'PA0093', 1, 2, 0, 6, 0 )
+             IF ( .NOT. passive_scalar ) THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for passive_scalar = FALSE'
+                ENDIF
+                CALL local_stop
              ELSE
-                dopr_index(i) = 117
-                dopr_unit(i)  = 'kg/m3 m/s'
-                hom(:,2,117,:) = SPREAD( zw, 2, statistic_regions+1 )
+                dopr_index(i) = 48
+                hom(:,2,48,:) = SPREAD( zw, 2, statistic_regions+1 )
              ENDIF
 
           CASE ( 'w*s*' )
-             IF ( .NOT. passive_scalar )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for passive_scalar = .FALSE.'
-                CALL message( 'check_parameters', 'PA0093', 1, 2, 0, 6, 0 )
+             IF ( .NOT. passive_scalar ) THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for passive_scalar = FALSE'
+                ENDIF
+                CALL local_stop
              ELSE
-                dopr_index(i) = 114
-                dopr_unit(i)  = 'kg/m3 m/s'
-                hom(:,2,114,:) = SPREAD( zw, 2, statistic_regions+1 )
+                dopr_index(i) = 49
+                hom(:,2,49,:) = SPREAD( zw, 2, statistic_regions+1 )
              ENDIF
 
           CASE ( 'ws' )
-             IF ( .NOT. passive_scalar )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for passive_scalar = .FALSE.'
-                CALL message( 'check_parameters', 'PA0093', 1, 2, 0, 6, 0 )
+             IF ( .NOT. passive_scalar ) THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for passive_scalar = FALSE'
+                ENDIF
+                CALL local_stop
              ELSE
-                dopr_index(i) = 118
-                dopr_unit(i)  = 'kg/m3 m/s'
-                hom(:,2,118,:) = SPREAD( zw, 2, statistic_regions+1 )
+                dopr_index(i) = 50
+                hom(:,2,50,:) = SPREAD( zw, 2, statistic_regions+1 )
              ENDIF
 
           CASE ( 'w"qv"' )
-             IF ( humidity  .AND.  .NOT. bulk_cloud_model )  THEN
+             IF ( moisture  .AND.  .NOT. cloud_physics ) &
+             THEN
                 dopr_index(i) = 48
-                dopr_unit(i)  = TRIM ( waterflux_output_unit )
                 hom(:,2,48,:) = SPREAD( zw, 2, statistic_regions+1 )
-             ELSEIF ( humidity  .AND.  bulk_cloud_model )  THEN
+             ELSEIF( moisture .AND. cloud_physics ) THEN
                 dopr_index(i) = 51
-                dopr_unit(i)  = TRIM ( waterflux_output_unit )
                 hom(:,2,51,:) = SPREAD( zw, 2, statistic_regions+1 )
              ELSE
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for bulk_cloud_model = .FALSE. ' //          &
-                                 'and humidity = .FALSE.'
-                CALL message( 'check_parameters', 'PA0095', 1, 2, 0, 6, 0 )
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for cloud_physics = FALSE', &
+                           '    and                    moisture      = FALSE'
+                ENDIF
+                CALL local_stop                   
              ENDIF
 
           CASE ( 'w*qv*' )
-             IF ( humidity  .AND.  .NOT. bulk_cloud_model )  THEN
+             IF ( moisture  .AND.  .NOT. cloud_physics ) &
+             THEN
                 dopr_index(i) = 49
-                dopr_unit(i)  = TRIM ( waterflux_output_unit )
                 hom(:,2,49,:) = SPREAD( zw, 2, statistic_regions+1 )
-             ELSEIF( humidity  .AND.  bulk_cloud_model )  THEN
+             ELSEIF( moisture .AND. cloud_physics ) THEN
                 dopr_index(i) = 52
-                dopr_unit(i)  = TRIM ( waterflux_output_unit )
                 hom(:,2,52,:) = SPREAD( zw, 2, statistic_regions+1 )
              ELSE
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for bulk_cloud_model = .FALSE. ' //          &
-                                 'and humidity = .FALSE.'
-                CALL message( 'check_parameters', 'PA0095', 1, 2, 0, 6, 0 )
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ',         &
+                           data_output_pr(i),                                  &
+                           '    is not implemented for cloud_physics = FALSE', &
+                           '                       and moisture      = FALSE'
+                ENDIF
+                CALL local_stop                   
              ENDIF
 
           CASE ( 'wqv' )
-             IF ( humidity  .AND.  .NOT. bulk_cloud_model )  THEN
+             IF ( moisture  .AND.  .NOT. cloud_physics ) &
+             THEN
                 dopr_index(i) = 50
-                dopr_unit(i)  = TRIM ( waterflux_output_unit )
                 hom(:,2,50,:) = SPREAD( zw, 2, statistic_regions+1 )
-             ELSEIF ( humidity  .AND.  bulk_cloud_model )  THEN
+             ELSEIF( moisture .AND. cloud_physics ) THEN
                 dopr_index(i) = 53
-                dopr_unit(i)  = TRIM ( waterflux_output_unit )
                 hom(:,2,53,:) = SPREAD( zw, 2, statistic_regions+1 )
              ELSE
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for bulk_cloud_model = .FALSE. ' //          &
-                                 'and humidity = .FALSE.'
-                CALL message( 'check_parameters', 'PA0095', 1, 2, 0, 6, 0 )
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ',         &
+                           data_output_pr(i),                                  &
+                           '    is not implemented for cloud_physics = FALSE', &
+                           '                       and moisture      = FALSE'
+                ENDIF
+                CALL local_stop                   
              ENDIF
 
           CASE ( 'ql' )
-             IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for bulk_cloud_model = .FALSE. ' //          &
-                                 'and cloud_droplets = .FALSE.'
-                CALL message( 'check_parameters', 'PA0096', 1, 2, 0, 6, 0 )
+             IF ( .NOT. cloud_physics  .AND.  .NOT. cloud_droplets )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
+                           data_output_pr(i),                          &
+                           '    is not implemented for cloud_physics = FALSE'
+                ENDIF
+                CALL local_stop
              ELSE
                 dopr_index(i) = 54
-                dopr_unit(i)  = 'kg/kg'
                 hom(:,2,54,:)  = SPREAD( zu, 2, statistic_regions+1 )
              ENDIF
 
-          CASE ( 'w*u*u*:dz' )
+          CASE ( 'w*u*u*/dz' )
              dopr_index(i) = 55
-             dopr_unit(i)  = 'm2/s3'
              hom(:,2,55,:) = SPREAD( zu, 2, statistic_regions+1 )
 
-          CASE ( 'w*p*:dz' )
+          CASE ( 'w*p*/dz' )
              dopr_index(i) = 56
-             dopr_unit(i)  = 'm2/s3'
-             hom(:,2,56,:) = SPREAD( zw, 2, statistic_regions+1 )
-
-          CASE ( 'w"e:dz' )
+             hom(:,2,56,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+          CASE ( 'w"e/dz' )
              dopr_index(i) = 57
-             dopr_unit(i)  = 'm2/s3'
              hom(:,2,57,:) = SPREAD( zu, 2, statistic_regions+1 )
 
-          CASE ( 'u"theta"' )
+          CASE ( 'u"pt"' )
              dopr_index(i) = 58
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,58,:) = SPREAD( zu, 2, statistic_regions+1 )
 
-          CASE ( 'u*theta*' )
+          CASE ( 'u*pt*' )
              dopr_index(i) = 59
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,59,:) = SPREAD( zu, 2, statistic_regions+1 )
 
-          CASE ( 'utheta_t' )
+          CASE ( 'upt_t' )
              dopr_index(i) = 60
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,60,:) = SPREAD( zu, 2, statistic_regions+1 )
 
-          CASE ( 'v"theta"' )
+          CASE ( 'v"pt"' )
              dopr_index(i) = 61
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,61,:) = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'v*theta*' )
+             
+          CASE ( 'v*pt*' )
              dopr_index(i) = 62
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,62,:) = SPREAD( zu, 2, statistic_regions+1 )
 
-          CASE ( 'vtheta_t' )
+          CASE ( 'vpt_t' )
              dopr_index(i) = 63
-             dopr_unit(i)  = TRIM ( heatflux_output_unit )
              hom(:,2,63,:) = SPREAD( zu, 2, statistic_regions+1 )
 
-          CASE ( 'w*p*' )
-             dopr_index(i) = 68
-             dopr_unit(i)  = 'm3/s3'
-             hom(:,2,68,:) = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'w"e' )
-             dopr_index(i) = 69
-             dopr_unit(i)  = 'm3/s3'
-             hom(:,2,69,:) = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'q*2' )
-             IF (  .NOT.  humidity )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for humidity = .FALSE.'
-                CALL message( 'check_parameters', 'PA0092', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(i) = 70
-                dopr_unit(i)  = 'kg2/kg2'
-                hom(:,2,70,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-
-          CASE ( 'hyp' )
-             dopr_index(i) = 72
-             dopr_unit(i)  = 'hPa'
-             hom(:,2,72,:) = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'rho' )
-             dopr_index(i)  = 119
-             dopr_unit(i)   = 'kg/m3'
-             hom(:,2,119,:) = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'rho_zw' )
-             dopr_index(i)  = 120
-             dopr_unit(i)   = 'kg/m3'
-             hom(:,2,120,:) = SPREAD( zw, 2, statistic_regions+1 )
-
-          CASE ( 'ug' )
-             dopr_index(i) = 78
-             dopr_unit(i)  = 'm/s'
-             hom(:,2,78,:) = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'vg' )
-             dopr_index(i) = 79
-             dopr_unit(i)  = 'm/s'
-             hom(:,2,79,:) = SPREAD( zu, 2, statistic_regions+1 )
-
-          CASE ( 'w_subs' )
-             IF (  .NOT.  large_scale_subsidence )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for large_scale_subsidence = .FALSE.'
-                CALL message( 'check_parameters', 'PA0382', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(i) = 80
-                dopr_unit(i)  = 'm/s'
-                hom(:,2,80,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-
-          CASE ( 's*2' )
-             IF (  .NOT.  passive_scalar )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(i) ) //               &
-                                 ' is not implemented for passive_scalar = .FALSE.'
-                CALL message( 'check_parameters', 'PA0185', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(i) = 116
-                dopr_unit(i)  = 'kg2/m6'
-                hom(:,2,116,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-
-           CASE ( 'eta' )
-              dopr_index(i) = 121
-              dopr_unit(i)  = 'mm'
-              hom(:,2,121,:) = SPREAD( zu, 2, statistic_regions+1 )
-
-              kolmogorov_length_scale = .TRUE.
 
           CASE DEFAULT
-             unit = 'illegal'
-!
-!--          Check for other modules
-             CALL module_interface_check_data_output_pr( data_output_pr(i), i, unit, dopr_unit(i) )
-
-!
-!--          No valid quantity found
-             IF ( unit == 'illegal' )  THEN
-                IF ( data_output_pr_user(1) /= ' ' )  THEN
-                   message_string = 'illegal value for data_output_pr or ' //                      &
-                                    'data_output_pr_user = "' // TRIM( data_output_pr(i) ) // '"'
-                   CALL message( 'check_parameters', 'PA0097', 1, 2, 0, 6, 0 )
-                ELSE
-                   message_string = 'illegal value for data_output_pr = "' //                      &
-                                    TRIM( data_output_pr(i) ) // '"'
-                   CALL message( 'check_parameters', 'PA0098', 1, 2, 0, 6, 0 )
-                ENDIF
-             ENDIF
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ check_parameters:  unknown output profile:  ', &
+                        'data_output_pr = ', data_output_pr(i)
+             ENDIF
+             CALL local_stop
 
        END SELECT
+!
+!--    Check to which of the predefined coordinate systems the profile belongs
+       DO  k = 1, crmax
+          IF ( INDEX( cross_profiles(k), ' '//TRIM( data_output_pr(i) )//' ' ) &
+               /=0 ) &
+          THEN
+             dopr_crossindex(i) = k
+             EXIT
+          ENDIF
+       ENDDO
+!
+!--    Generate the text for the labels of the PROFIL output file. "-characters
+!--    must be substituted, otherwise PROFIL would interpret them as TeX
+!--    control characters
+       dopr_label(i) = data_output_pr(i)
+       position = INDEX( dopr_label(i) , '"' )
+       DO WHILE ( position /= 0 )
+          dopr_label(i)(position:position) = ''''
+          position = INDEX( dopr_label(i) , '"' )
+       ENDDO
 
     ENDDO
 
+!
+!-- y-value range of the coordinate system (PROFIL).
+!-- x-value range determined in plot_1d.
+    cross_uymin = 0.0
+    IF ( z_max_do1d == -1.0 )  THEN
+       cross_uymax = zu(nzt+1)
+    ELSEIF ( z_max_do1d < zu(nzb+1)  .OR.  z_max_do1d > zu(nzt+1) )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  z_max_do1d=',  &
+                                 z_max_do1d,' must be >= ', zu(nzb+1),  &
+                                 ' or <= ', zu(nzt+1)
+       CALL local_stop
+    ELSE
+       cross_uymax = z_max_do1d
+    ENDIF
+
+!
+!-- Check whether the chosen normalizing factor for the coordinate systems is 
+!-- permissible
+    DO  i = 1, crmax
+       SELECT CASE ( TRIM( cross_normalized_x(i) ) )  ! TRIM required on IBM
+
+          CASE ( '', 'wpt0', 'ws2', 'tsw2', 'ws3', 'ws2tsw', 'wstsw2' )
+             j = 0
+
+          CASE DEFAULT
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ check_parameters: unknown normalize method'
+                PRINT*, '    cross_normalized_x="',cross_normalized_x(i),'"'
+             ENDIF
+             CALL local_stop
+
+       END SELECT
+       SELECT CASE ( TRIM( cross_normalized_y(i) ) )  ! TRIM required on IBM
+
+          CASE ( '', 'z_i' )
+             j = 0
+
+          CASE DEFAULT
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ check_parameters: unknown normalize method'
+                PRINT*, '    cross_normalized_y="',cross_normalized_y(i),'"'
+             ENDIF
+             CALL local_stop
+
+       END SELECT
+    ENDDO
+!
+!-- Check normalized y-value range of the coordinate system (PROFIL)
+    IF ( z_max_do1d_normalized /= -1.0  .AND.  z_max_do1d_normalized <= 0.0 ) &
+    THEN
+       IF ( myid == 0 )  PRINT*,'+++ check_parameters:  z_max_do1d_normalize', &
+                                'd=', z_max_do1d_normalized, ' must be >= 0.0'
+       CALL local_stop
+    ENDIF
+
+!
+!-- Determine parameters for time series output and check whether permissible
+    i = 0
+    DO  WHILE ( data_output_ts(i+1) /= '          '  .AND.  i+1 <= 100 )
+
+       dots_n = dots_n + 1
+       i = i + 1
+!
+!--    Check whether time series is permissible and determine internal number
+       SELECT CASE ( TRIM( data_output_ts(i) ) )
+
+          CASE ( 'E' )
+             dots_index(i) = 1
+          CASE ( 'E*' )
+             dots_index(i) = 2
+          CASE ( 'dt' )
+             dots_index(i) = 3
+          CASE ( 'u*' )
+             dots_index(i) = 4
+          CASE ( 'th*' )
+             dots_index(i) = 5
+          CASE ( 'umax' )
+             dots_index(i) = 6
+          CASE ( 'vmax' )
+             dots_index(i) = 7
+          CASE ( 'wmax' )
+             dots_index(i) = 8
+          CASE ( 'div_new' )
+             dots_index(i) = 9
+          CASE ( 'div_old' )
+             dots_index(i) = 10
+          CASE ( 'z_i_wpt' )
+             dots_index(i) = 11
+          CASE ( 'z_i_pt' )
+             dots_index(i) = 12
+          CASE ( 'w*' )
+             dots_index(i) = 13
+          CASE ( 'w"pt"0' )
+             dots_index(i) = 14
+          CASE ( 'w"pt"' )
+             dots_index(i) = 15
+          CASE ( 'wpt' )
+             dots_index(i) = 16
+          CASE ( 'pt(0)' )
+             dots_index(i) = 17
+          CASE ( 'pt(zp)' )
+             dots_index(i) = 18
+          CASE ( 'splptx'  )
+             dots_index(i) = 19
+          CASE ( 'splpty'  )
+             dots_index(i) = 20
+          CASE ( 'splptz'  )
+             dots_index(i) = 21
+          CASE ( 'L'       )
+             dots_index(i) = 22
+
+          CASE DEFAULT
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ check_parameters:  unknown time series:  ', &
+                             'data_output_ts = ',&
+                        data_output_ts(i)
+             ENDIF
+             CALL local_stop
+
+       END SELECT
+
+!
+!--    Check, to which predefined coordinate system the time series belongs, and
+!--    store corresponding internal number. Furthermore determine, how many and 
+!--    which graphs are being drawn into the corresponding system
+       DO  k = 1, crmax
+          IF ( INDEX( cross_ts_profiles(k), ' ' // TRIM( data_output_ts(i) ) &
+                      // ' ' ) /=0 )  &
+          THEN
+             dots_crossindex(i) = k
+             cross_ts_number_count(k) = cross_ts_number_count(k) + 1
+             cross_ts_numbers(cross_ts_number_count(k),k) = dots_index(i)
+             EXIT
+          ENDIF
+       ENDDO
+
+    ENDDO
 
 !
@@ -2258,13 +1854,16 @@
     IF ( data_output_user(1) /= ' ' )  THEN
        i = 1
-       DO  WHILE ( data_output(i) /= ' '  .AND.  i <= 500 )
+       DO  WHILE ( data_output(i) /= ' '  .AND.  i <= 100 )
           i = i + 1
        ENDDO
        j = 1
-       DO  WHILE ( data_output_user(j) /= ' '  .AND.  j <= 500 )
-          IF ( i > 500 )  THEN
-             message_string = 'number of output quantitities given by data' //                     &
-                              '_output and data_output_user exceeds the limit of 500'
-             CALL message( 'check_parameters', 'PA0102', 1, 2, 0, 6, 0 )
+       DO  WHILE ( data_output_user(j) /= ' '  .AND.  j <= 100 )
+          IF ( i > 100 )  THEN
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ check_parameters: number of output quantitities', &
+                             ' given by data_output and data_output_user'
+                PRINT*, '                      exceeds the limit of 100'
+             ENDIF
+             CALL local_stop
           ENDIF
           data_output(i) = data_output_user(j)
@@ -2273,14 +1872,9 @@
        ENDDO
     ENDIF
-!
-!-- Check data-output variable list for any duplicates and remove them
-    ALLOCATE( data_output_filtered(1:UBOUND( data_output, DIM=1 )) )
-    CALL filter_duplicate_strings( varnamelength, data_output, data_output_filtered )
-    data_output = data_output_filtered
-    DEALLOCATE( data_output_filtered )
+
 !
 !-- Check and set steering parameters for 2d/3d data output and averaging
     i   = 1
-    DO  WHILE ( data_output(i) /= ' '  .AND.  i <= 500 )
+    DO  WHILE ( data_output(i) /= ' '  .AND.  i <= 100 )
 !
 !--    Check for data averaging
@@ -2299,11 +1893,11 @@
        var = data_output(i)(1:ilen)
        IF ( ilen > 3 )  THEN
-          IF ( data_output(i)(ilen-2:ilen) == '_xy'  .OR.  data_output(i)(ilen-2:ilen) == '_xz'    &
-               .OR.  data_output(i)(ilen-2:ilen) == '_yz' )  THEN
+          IF ( data_output(i)(ilen-2:ilen) == '_xy'  .OR. &
+               data_output(i)(ilen-2:ilen) == '_xz'  .OR. &
+               data_output(i)(ilen-2:ilen) == '_yz' )  THEN
              k = 1                                             ! 2d data
              var = data_output(i)(1:ilen-3)
           ENDIF
        ENDIF
-
 !
 !--    Check for allowed value and set units
@@ -2312,40 +1906,43 @@
           CASE ( 'e' )
              IF ( constant_diffusion )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires ' //                  &
-                                 'constant_diffusion = .FALSE.'
-                CALL message( 'check_parameters', 'PA0103', 1, 2, 0, 6, 0 )
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+                                '" requires constant_diffusion = .FALSE.'
+                ENDIF
+                CALL local_stop
              ENDIF
              unit = 'm2/s2'
-
-          CASE ( 'thetal' )
-             IF ( .NOT. bulk_cloud_model )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires ' //                  &
-                                 'bulk_cloud_model = .TRUE.'
-                CALL message( 'check_parameters', 'PA0108', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'K'
 
           CASE ( 'pc', 'pr' )
              IF ( .NOT. particle_advection )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires ' //                  &
-                                 'a "particle_parameters"-NAMELIST in the parameter file (PARIN)'
-                CALL message( 'check_parameters', 'PA0104', 1, 2, 0, 6, 0 )
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+                                '" requires particle package'
+                   PRINT*, '                      (mrun-option "-p particles")'
+                ENDIF
+                CALL local_stop
              ENDIF
              IF ( TRIM( var ) == 'pc' )  unit = 'number'
              IF ( TRIM( var ) == 'pr' )  unit = 'm'
 
-          CASE ( 'q', 'thetav' )
-             IF ( .NOT. humidity )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires humidity = .TRUE.'
-                CALL message( 'check_parameters', 'PA0105', 1, 2, 0, 6, 0 )
+          CASE ( 'q', 'vpt' )
+             IF ( .NOT. moisture )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+                                '" requires moisture = .TRUE.'
+                ENDIF
+                CALL local_stop
              ENDIF
              IF ( TRIM( var ) == 'q'   )  unit = 'kg/kg'
-             IF ( TRIM( var ) == 'thetav' )  unit = 'K'
+             IF ( TRIM( var ) == 'vpt' )  unit = 'K'
 
           CASE ( 'ql' )
-             IF ( .NOT.  ( bulk_cloud_model  .OR.  cloud_droplets ) )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires ' //                  &
-                                 'bulk_cloud_model = .TRUE. or cloud_droplets = .TRUE.'
-                CALL message( 'check_parameters', 'PA0106', 1, 2, 0, 6, 0 )
+             IF ( .NOT. ( cloud_physics  .OR.  cloud_droplets ) )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+                                '" requires cloud_physics = .TRUE.'
+                   PRINT*, '                      or cloud_droplets = .TRUE.'
+                ENDIF
+                CALL local_stop
              ENDIF
              unit = 'kg/kg'
@@ -2353,7 +1950,9 @@
           CASE ( 'ql_c', 'ql_v', 'ql_vp' )
              IF ( .NOT. cloud_droplets )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires ' //                  &
-                                 'cloud_droplets = .TRUE.'
-                CALL message( 'check_parameters', 'PA0107', 1, 2, 0, 6, 0 )
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+                                '" requires cloud_droplets = .TRUE.'
+                ENDIF
+                CALL local_stop
              ENDIF
              IF ( TRIM( var ) == 'ql_c'  )  unit = 'kg/kg'
@@ -2362,8 +1961,10 @@
 
           CASE ( 'qv' )
-             IF ( .NOT. bulk_cloud_model )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires ' //                  &
-                                 'bulk_cloud_model = .TRUE.'
-                CALL message( 'check_parameters', 'PA0108', 1, 2, 0, 6, 0 )
+             IF ( .NOT. cloud_physics )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+                                '" requires cloud_physics = .TRUE.'
+                ENDIF
+                CALL local_stop
              ENDIF
              unit = 'kg/kg'
@@ -2371,13 +1972,35 @@
           CASE ( 's' )
              IF ( .NOT. passive_scalar )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires ' //                  &
-                                 'passive_scalar = .TRUE.'
-                CALL message( 'check_parameters', 'PA0110', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'kg/m3'
-
-          CASE ( 'p', 'theta', 'u', 'v', 'w' )
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+                                '" requires passive_scalar = .TRUE.'
+                ENDIF
+                CALL local_stop
+             ENDIF
+             unit = 'conc'
+
+          CASE ( 'u*', 't*', 'lwp*' )
+             IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:  illegal value for data_',&
+                                'output: "', TRIM( var ), '" is only allowed'
+                   PRINT*, '                       for horizontal cross section'
+                ENDIF
+                CALL local_stop
+             ENDIF
+             IF ( TRIM( var ) == 'lwp*'  .AND.  .NOT. cloud_physics )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+                                '" requires cloud_physics = .TRUE.'
+                ENDIF
+                CALL local_stop
+             ENDIF
+             IF ( TRIM( var ) == 'u*'   )  unit = 'm/s'
+             IF ( TRIM( var ) == 't*'   )  unit = 'K'
+             IF ( TRIM( var ) == 'lwp*' )  unit = 'kg/kg*m'
+
+          CASE ( 'p', 'pt', 'u', 'v', 'w' )
              IF ( TRIM( var ) == 'p'  )  unit = 'Pa'
-             IF ( TRIM( var ) == 'theta' )  unit = 'K'
+             IF ( TRIM( var ) == 'pt' )  unit = 'K'
              IF ( TRIM( var ) == 'u'  )  unit = 'm/s'
              IF ( TRIM( var ) == 'v'  )  unit = 'm/s'
@@ -2385,77 +2008,19 @@
              CONTINUE
 
-          CASE ( 'ghf*', 'lwp*', 'ol*', 'qsurf*', 'qsws*', 'r_a*', 'shf*', 'ssurf*', 'ssws*', 't*',&
-                 'tsurf*', 'us*', 'z0*', 'z0h*', 'z0q*' )
-             IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
-                message_string = 'illegal value for data_output: "' // TRIM( var ) //              &
-                                 '" & only 2d-horizontal cross sections are allowed for this value'
-                CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             IF ( TRIM( var ) == 'lwp*'  .AND.  .NOT. bulk_cloud_model )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires ' //                  &
-                                 'bulk_cloud_model = .TRUE.'
-                CALL message( 'check_parameters', 'PA0108', 1, 2, 0, 6, 0 )
-             ENDIF
-             IF ( TRIM( var ) == 'qsws*'  .AND.  .NOT.  humidity )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires humidity = .TRUE.'
-                CALL message( 'check_parameters', 'PA0322', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             IF ( TRIM( var ) == 'ghf*'  .AND.  .NOT.  land_surface )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires land_surface = .TRUE.'
-                CALL message( 'check_parameters', 'PA0404', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             IF ( (  TRIM( var ) == 'r_a*' .OR. TRIM( var ) == 'ghf*' )  .AND.  .NOT. land_surface &
-                   .AND.  .NOT. urban_surface )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires ' //                  &
-                                 'land_surface = .TRUE. or ' // 'urban_surface = .TRUE.'
-                CALL message( 'check_parameters', 'PA0404', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             IF ( TRIM( var ) == 'ssws*'  .AND.  .NOT. passive_scalar )  THEN
-                message_string = 'output of "' // TRIM( var ) // '" requires ' //                  &
-                                 'passive_scalar = .TRUE.'
-                CALL message( 'check_parameters', 'PA0361', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             IF ( TRIM( var ) == 'ghf*'   )  unit = 'W/m2'
-             IF ( TRIM( var ) == 'lwp*'   )  unit = 'kg/m2'
-             IF ( TRIM( var ) == 'ol*'    )  unit = 'm'
-             IF ( TRIM( var ) == 'qsurf*' )  unit = 'kg/kg'
-             IF ( TRIM( var ) == 'qsws*'  )  unit = 'kgm/kgs'
-             IF ( TRIM( var ) == 'r_a*'   )  unit = 's/m'
-             IF ( TRIM( var ) == 'shf*'   )  unit = 'K*m/s'
-             IF ( TRIM( var ) == 'ssurf*' )  unit = 'kg/kg'
-             IF ( TRIM( var ) == 'ssws*'  )  unit = 'kg/m2*s'
-             IF ( TRIM( var ) == 't*'     )  unit = 'K'
-             IF ( TRIM( var ) == 'tsurf*' )  unit = 'K'
-             IF ( TRIM( var ) == 'us*'    )  unit = 'm/s'
-             IF ( TRIM( var ) == 'z0*'    )  unit = 'm'
-             IF ( TRIM( var ) == 'z0h*'   )  unit = 'm'
-!
-!--          Output of surface latent and sensible heat flux will be in W/m2 in case of natural- and
-!--          urban-type surfaces, even if flux_output_mode is set to kinematic units.
-             IF ( land_surface  .OR.  urban_surface )  THEN
-                IF ( TRIM( var ) == 'shf*'   )  unit = 'W/m2'
-                IF ( TRIM( var ) == 'qsws*'  )  unit = 'W/m2'
-             ENDIF
-
           CASE DEFAULT
-!
-!--          Check for other modules
-             CALL module_interface_check_data_output( var, unit, i, j, ilen, k )
+             CALL user_check_data_output( var, unit )
 
              IF ( unit == 'illegal' )  THEN
-                IF ( data_output_user(1) /= ' ' )  THEN
-                   message_string = 'illegal value for data_output or ' //                         &
-                                    'data_output_user = "' // TRIM( data_output(i) ) // '"'
-                   CALL message( 'check_parameters', 'PA0114', 1, 2, 0, 6, 0 )
-                ELSE
-                   message_string = 'illegal value for data_output = "' //                         &
-                                    TRIM( data_output(i) ) // '"'
-                   CALL message( 'check_parameters', 'PA0115', 1, 2, 0, 6, 0 )
-                ENDIF
+                IF ( myid == 0 )  THEN
+                   IF ( data_output_user(1) /= ' ' )  THEN
+                      PRINT*, '+++ check_parameters:  illegal value for data_',&
+                                   'output or data_output_user: "',            &
+                                   TRIM( data_output(i) ), '"'
+                   ELSE
+                      PRINT*, '+++ check_parameters:  illegal value for data_',&
+                                   'output: "', TRIM( data_output(i) ), '"'
+                   ENDIF
+                ENDIF
+                CALL local_stop
              ENDIF
 
@@ -2500,44 +2065,30 @@
 
 !
-!-- Averaged 2d or 3d output requires that an averaging interval has been set
-    IF ( doav_n > 0  .AND.  averaging_interval == 0.0_wp )  THEN
-       WRITE( message_string, * )  'output of averaged quantity "', TRIM( doav(1) ),               &
-                                   '_av" requires to set a ', 'non-zero averaging interval'
-       CALL message( 'check_parameters', 'PA0323', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check sectional planes and store them in one shared array
-    IF ( ANY( section_xy > nz + 1 ) )  THEN
-       WRITE( message_string, * )  'section_xy must be <= nz + 1 = ', nz + 1
-       CALL message( 'check_parameters', 'PA0319', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( ANY( section_xz > ny + 1 ) )  THEN
-       WRITE( message_string, * )  'section_xz must be <= ny + 1 = ', ny + 1
-       CALL message( 'check_parameters', 'PA0320', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( ANY( section_yz > nx + 1 ) )  THEN
-       WRITE( message_string, * )  'section_yz must be <= nx + 1 = ', nx + 1
-       CALL message( 'check_parameters', 'PA0321', 1, 2, 0, 6, 0 )
-    ENDIF
+!-- Store sectional planes in one shared array
     section(:,1) = section_xy
     section(:,2) = section_xz
     section(:,3) = section_yz
 
-    IF ( ANY( data_output_xy )  .AND.  .NOT. ANY( section(:,1) /= -9999 ) )  THEN
-       WRITE( message_string, * )  'section_xy not defined for requested xy-cross section ' //     &
-                                   'output.&At least one cross section must be given.'
-       CALL message( 'check_parameters', 'PA0681', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( ANY( data_output_xz )  .AND.  .NOT. ANY( section(:,2) /= -9999 ) )  THEN
-       WRITE( message_string, * )  'section_xz not defined for requested xz-cross section ' //     &
-                                   'output.&At least one cross section must be given.'
-       CALL message( 'check_parameters', 'PA0681', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( ANY( data_output_yz )  .AND.  .NOT. ANY( section(:,3) /= -9999 ) )  THEN
-       WRITE( message_string, * )  'section_yz not defined for requested yz-cross section ' //     &
-                                   'output.&At least one cross section must be given.'
-       CALL message( 'check_parameters', 'PA0681', 1, 2, 0, 6, 0 )
-    ENDIF
+!
+!-- Upper plot limit (grid point value) for 1D profiles
+    IF ( z_max_do1d == -1.0 )  THEN
+       nz_do1d = nzt+1
+    ELSE
+       DO  k = nzb+1, nzt+1
+          nz_do1d = k
+          IF ( zw(k) > z_max_do1d )  EXIT
+       ENDDO
+    ENDIF
+
+!
+!-- Upper plot limit for 2D vertical sections
+    IF ( z_max_do2d == -1.0 )  z_max_do2d = zu(nzt)
+    IF ( z_max_do2d < zu(nzb+1)  .OR.  z_max_do2d > zu(nzt) )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  z_max_do2d=',        &
+                                 z_max_do2d, ' must be >= ', zu(nzb+1),       &
+                                 '(zu(nzb+1)) and <= ', zu(nzt), ' (zu(nzt))'
+       CALL local_stop
+    ENDIF
+
 !
 !-- Upper plot limit for 3D arrays
@@ -2545,241 +2096,183 @@
 
 !
-!-- Set output format string (used in header)
-    SELECT CASE ( netcdf_data_format )
-       CASE ( 1 )
-          netcdf_data_format_string = 'netCDF classic'
-       CASE ( 2 )
-          netcdf_data_format_string = 'netCDF 64bit offset'
-       CASE ( 3 )
-          netcdf_data_format_string = 'netCDF4/HDF5'
-       CASE ( 4 )
-          netcdf_data_format_string = 'netCDF4/HDF5 classic'
-       CASE ( 5 )
-          netcdf_data_format_string = 'parallel netCDF4/HDF5'
-       CASE ( 6 )
-          netcdf_data_format_string = 'parallel netCDF4/HDF5 classic'
-
-    END SELECT
-
-!
-!-- Check mask conditions
-    DO mid = 1, max_masks
-       IF ( data_output_masks(mid,1) /= ' '  .OR.  data_output_masks_user(mid,1) /= ' ' )  THEN
-          masks = masks + 1
-       ENDIF
-    ENDDO
-
-    IF ( masks < 0  .OR.  masks > max_masks )  THEN
-       WRITE( message_string, * )  'illegal value: masks must be >= 0 and ', '<= ', max_masks,     &
-              ' (=max_masks)'
-       CALL message( 'check_parameters', 'PA0325', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( masks > 0 )  THEN
-       mask_scale(1) = mask_scale_x
-       mask_scale(2) = mask_scale_y
-       mask_scale(3) = mask_scale_z
-       IF ( ANY( mask_scale <= 0.0_wp ) )  THEN
-          WRITE( message_string, * )  'illegal value: mask_scale_x, mask_scale_y and mask_scale_z',&
-                 'must be > 0.0'
-          CALL message( 'check_parameters', 'PA0326', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Generate masks for masked data output.
-!--    Parallel netcdf output is not tested so far for masked data, hence netcdf_data_format is
-!--    switched back to non-parallel output.
-       netcdf_data_format_save = netcdf_data_format
-       IF ( netcdf_data_format > 4 )  THEN
-          IF ( netcdf_data_format == 5 ) netcdf_data_format = 3
-          IF ( netcdf_data_format == 6 ) netcdf_data_format = 4
-          message_string = 'netCDF file formats '// '5 (parallel netCDF 4) and 6 (parallel ' //    &
-                           'netCDF 4 Classic model) & are currently not supported (not yet ' //    &
-                           'tested) for masked data. &Using respective non-parallel' //            &
-                           ' output for masked data.'
-          CALL message( 'check_parameters', 'PA0383', 0, 0, 0, 6, 0 )
-       ENDIF
-       CALL init_masks
-       netcdf_data_format = netcdf_data_format_save
-    ENDIF
-
-!
-!-- Check the NetCDF data format
-    IF ( netcdf_data_format > 2 )  THEN
-#if defined( __netcdf4 )
-       CONTINUE
-#else
-       message_string = 'netCDF: netCDF4 format requested but no ' //                              &
-                        'cpp-directive __netcdf4 given & switch back to 64-bit offset format'
-       CALL message( 'check_parameters', 'PA0171', 0, 1, 0, 6, 0 )
-       netcdf_data_format = 2
-#endif
-    ENDIF
-    IF ( netcdf_data_format > 4 )  THEN
-#if defined( __netcdf4 ) && defined( __netcdf4_parallel )
-       CONTINUE
-#else
-       message_string = 'netCDF: netCDF4 parallel output requested but no ' //                     &
-                        'cpp-directive __netcdf4_parallel given & switch ' //                      &
-                        'back to netCDF4 non-parallel output'
-       CALL message( 'check_parameters', 'PA0099', 0, 1, 0, 6, 0 )
-       netcdf_data_format = netcdf_data_format - 2
-#endif
-    ENDIF
-
-!
-!-- Calculate fixed number of output time levels for parallel netcdf output.
-!-- The time dimension has to be defined as limited for parallel output, because otherwise the I/O
-!-- performance drops significantly.
-    IF ( netcdf_data_format > 4 )  THEN
-
-!
-!--    Check if any of the follwoing data output interval is 0.0s, which is not allowed for parallel
-!--    output.
-       CALL check_dt_do( dt_do3d,           'dt_do3d'           )
-       CALL check_dt_do( dt_do2d_xy,        'dt_do2d_xy'        )
-       CALL check_dt_do( dt_do2d_xz,        'dt_do2d_xz'        )
-       CALL check_dt_do( dt_do2d_yz,        'dt_do2d_yz'        )
-       CALL check_dt_do( dt_data_output_av, 'dt_data_output_av' )
-
-!--    Set needed time levels (ntdim) to saved time levels + to be saved time levels.
-       ntdim_3d(0) = do3d_time_count(0) + CEILING(                                                 &
-                     ( end_time - MAX(                                                             &
-                         MERGE( skip_time_do3d, skip_time_do3d + spinup_time,                      &
-                                data_output_during_spinup ),                                       &
-                         simulated_time_at_begin )                                                 &
-                     ) / dt_do3d )
-       IF ( do3d_at_begin ) ntdim_3d(0) = ntdim_3d(0) + 1
-
-       ntdim_3d(1) = do3d_time_count(1) + CEILING(                                                 &
-                     ( end_time - MAX(                                                             &
-                         MERGE( skip_time_data_output_av, skip_time_data_output_av + spinup_time,  &
-                                data_output_during_spinup ),                                       &
-                         simulated_time_at_begin )                                                 &
-                     ) / dt_data_output_av )
-
-       ntdim_2d_xy(0) = do2d_xy_time_count(0) + CEILING(                                           &
-                        ( end_time - MAX(                                                          &
-                            MERGE( skip_time_do2d_xy, skip_time_do2d_xy + spinup_time,             &
-                                   data_output_during_spinup ),                                    &
-                            simulated_time_at_begin )                                              &
-                        ) / dt_do2d_xy )
-
-       ntdim_2d_xz(0) = do2d_xz_time_count(0) + CEILING(                                           &
-                        ( end_time - MAX(                                                          &
-                            MERGE( skip_time_do2d_xz, skip_time_do2d_xz + spinup_time,             &
-                                   data_output_during_spinup ),                                    &
-                            simulated_time_at_begin )                                              &
-                        ) / dt_do2d_xz )
-
-       ntdim_2d_yz(0) = do2d_yz_time_count(0) + CEILING(                                           &
-                        ( end_time - MAX(                                                          &
-                            MERGE( skip_time_do2d_yz, skip_time_do2d_yz + spinup_time,             &
-                                   data_output_during_spinup ),                                    &
-                            simulated_time_at_begin )                                              &
-                        ) / dt_do2d_yz )
-
-       IF ( do2d_at_begin )  THEN
-          ntdim_2d_xy(0) = ntdim_2d_xy(0) + 1
-          ntdim_2d_xz(0) = ntdim_2d_xz(0) + 1
-          ntdim_2d_yz(0) = ntdim_2d_yz(0) + 1
-       ENDIF
-!
-!--    Please note, for averaged 2D data skip_time_data_output_av is the relavant output control
-!--    parameter.
-       ntdim_2d_xy(1) = do2d_xy_time_count(1) + CEILING(                                           &
-                        ( end_time - MAX( MERGE( skip_time_data_output_av,                         &
-                                                 skip_time_data_output_av + spinup_time,           &
-                                                 data_output_during_spinup ),                      &
-                                          simulated_time_at_begin )                                &
-                        ) / dt_data_output_av )
-
-       ntdim_2d_xz(1) = do2d_xz_time_count(1) + CEILING(                                           &
-                        ( end_time - MAX( MERGE( skip_time_data_output_av,                         &
-                                                 skip_time_data_output_av + spinup_time,           &
-                                                 data_output_during_spinup ),                      &
-                                          simulated_time_at_begin )                                &
-                        ) / dt_data_output_av )
-
-       ntdim_2d_yz(1) = do2d_yz_time_count(1) + CEILING(                                           &
-                        ( end_time - MAX( MERGE( skip_time_data_output_av,                         &
-                                                 skip_time_data_output_av + spinup_time,           &
-                                                 data_output_during_spinup ),                      &
-                                          simulated_time_at_begin )                                &
-                        ) / dt_data_output_av )
-
-    ENDIF
+!-- Determine and check accuracy for compressed 3D plot output
+    IF ( do3d_compress )  THEN
+!
+!--    Compression only permissible on T3E machines
+       IF ( host(1:3) /= 't3e' )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters: do3d_compress = .TRUE. not allow', &
+                          'ed on host "', TRIM( host ), '"'
+          ENDIF
+          CALL local_stop
+       ENDIF
+
+       i = 1
+       DO  WHILE ( do3d_comp_prec(i) /= ' ' )
+
+          ilen = LEN_TRIM( do3d_comp_prec(i) )
+          IF ( LLT( do3d_comp_prec(i)(ilen:ilen), '0' ) .OR. &
+               LGT( do3d_comp_prec(i)(ilen:ilen), '9' ) )  THEN
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ check_parameters: illegal precision: ', &
+                        'do3d_comp_prec(', i, ')="', TRIM(do3d_comp_prec(i)),'"'
+             ENDIF
+             CALL local_stop
+          ENDIF
+
+          prec = IACHAR( do3d_comp_prec(i)(ilen:ilen) ) - IACHAR( '0' )
+          var = do3d_comp_prec(i)(1:ilen-1)
+
+          SELECT CASE ( var )
+
+             CASE ( 'u' )
+                j = 1
+             CASE ( 'v' )
+                j = 2
+             CASE ( 'w' )
+                j = 3
+             CASE ( 'p' )
+                j = 4
+             CASE ( 'pt' )
+                j = 5
+
+             CASE DEFAULT
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters: unknown variable in ', &
+                               'assignment'
+                   PRINT*, '    do3d_comp_prec(', i, ')="', &
+                           TRIM( do3d_comp_prec(i) ),'"'
+                ENDIF
+                CALL local_stop                
+
+          END SELECT
+
+          plot_3d_precision(j)%precision = prec
+          i = i + 1
+
+       ENDDO
+    ENDIF
+
+!
+!-- Check the data output format(s)
+    IF ( data_output_format(1) == ' ' )  THEN
+!
+!--    Default value
+       netcdf_output = .TRUE.
+    ELSE
+       i = 1
+       DO  WHILE ( data_output_format(i) /= ' ' )
+
+          SELECT CASE ( data_output_format(i) )
+
+             CASE ( 'netcdf' )
+                netcdf_output = .TRUE.
+             CASE ( 'iso2d' )
+                iso2d_output  = .TRUE.
+             CASE ( 'profil' )
+                profil_output = .TRUE.
+             CASE ( 'avs' )
+                avs_output    = .TRUE.
+
+             CASE DEFAULT
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ check_parameters:'
+                   PRINT*, '    unknown value for data_output_format "', &
+                                TRIM( data_output_format(i) ),'"'
+                ENDIF
+                CALL local_stop                
+
+          END SELECT
+
+          i = i + 1
+          IF ( i > 10 )  EXIT
+
+       ENDDO
+
+    ENDIF
+
+!
+!-- Check netcdf precison
+    ldum = .FALSE.
+    CALL define_netcdf_header( 'ch', ldum, 0 )
 
 !
 !-- Check, whether a constant diffusion coefficient shall be used
-    IF ( km_constant /= -1.0_wp )  THEN
-       IF ( km_constant < 0.0_wp )  THEN
-          WRITE( message_string, * )  'km_constant = ', km_constant, ' < 0.0'
-          CALL message( 'check_parameters', 'PA0121', 1, 2, 0, 6, 0 )
+    IF ( km_constant /= -1.0 )  THEN
+       IF ( km_constant < 0.0 )  THEN
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters:  km_constant=', &
+                                    km_constant, ' < 0.0'
+          CALL local_stop
        ELSE
-          IF ( prandtl_number < 0.0_wp )  THEN
-             WRITE( message_string, * )  'prandtl_number = ', prandtl_number, ' < 0.0'
-             CALL message( 'check_parameters', 'PA0122', 1, 2, 0, 6, 0 )
+          IF ( prandtl_number < 0.0 )  THEN
+             IF ( myid == 0 )  PRINT*,'+++ check_parameters:  prandtl_number=',&
+                                      prandtl_number, ' < 0.0'
+             CALL local_stop
           ENDIF
           constant_diffusion = .TRUE.
 
-          IF ( constant_flux_layer )  THEN
-             message_string = 'constant_flux_layer is not allowed with fixed value of km'
-             CALL message( 'check_parameters', 'PA0123', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-
-!
-!-- In case of non-cyclic lateral boundaries and a damping layer for the potential temperature,
-!-- check the width of the damping layer
+          IF ( prandtl_layer )  THEN
+             IF ( myid == 0 )  PRINT*, '+++ check_parameters:  prandtl_layer ',&
+                                       'is not allowed with fixed value of km'
+             CALL local_stop
+          ENDIF
+       ENDIF
+    ENDIF
+
+!
+!-- In case of non-cyclic lateral boundaries, set the default maximum value
+!-- for the horizontal diffusivity used within the outflow damping layer,
+!-- and check/set the width of the damping layer
     IF ( bc_lr /= 'cyclic' ) THEN
-       IF ( pt_damping_width < 0.0_wp  .OR.  pt_damping_width > REAL( (nx+1) * dx ) )  THEN
-          message_string = 'pt_damping_width out of range'
-          CALL message( 'check_parameters', 'PA0124', 1, 2, 0, 6, 0 )
+       IF ( km_damp_max == -1.0 )  THEN
+          km_damp_max = 0.5 * dx
+       ENDIF
+       IF ( outflow_damping_width == -1.0 )  THEN
+          outflow_damping_width = MIN( 20, nx/2 )
+       ENDIF
+       IF ( outflow_damping_width <= 0  .OR.  outflow_damping_width > nx )  THEN
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters: outflow_damping w',&
+                                    'idth out of range'
+          CALL local_stop
        ENDIF
     ENDIF
 
     IF ( bc_ns /= 'cyclic' )  THEN
-       IF ( pt_damping_width < 0.0_wp  .OR.  pt_damping_width > REAL( (ny+1) * dy ) )  THEN
-          message_string = 'pt_damping_width out of range'
-          CALL message( 'check_parameters', 'PA0124', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-!
-!-- Check value range for zeta = z/L
-    IF ( zeta_min >= zeta_max )  THEN
-       WRITE( message_string, * )  'zeta_min = ', zeta_min, ' must be less ', 'than zeta_max = ',  &
-              zeta_max
-       CALL message( 'check_parameters', 'PA0125', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check random generator
-    IF ( (random_generator /= 'system-specific'      .AND.                                         &
-          random_generator /= 'random-parallel'   )  .AND.                                         &
-          random_generator /= 'numerical-recipes' )  THEN
-       message_string = 'unknown random generator: random_generator = "' //                        &
-                        TRIM( random_generator ) // '"'
-       CALL message( 'check_parameters', 'PA0135', 1, 2, 0, 6, 0 )
+       IF ( km_damp_max == -1.0 )  THEN
+          km_damp_max = 0.5 * dy
+       ENDIF
+       IF ( outflow_damping_width == -1.0 )  THEN
+          outflow_damping_width = MIN( 20, ny/2 )
+       ENDIF
+       IF ( outflow_damping_width <= 0  .OR.  outflow_damping_width > ny )  THEN
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters: outflow_damping w',&
+                                    'idth out of range'
+          CALL local_stop
+       ENDIF
+    ENDIF
+
+!
+!-- Check value range for rif
+    IF ( rif_min >= rif_max )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  rif_min=', rif_min, &
+                                 ' must be less than rif_max=', rif_max
+       CALL local_stop
     ENDIF
 
 !
 !-- Determine upper and lower hight level indices for random perturbations
-    IF ( disturbance_level_b == -9999999.9_wp )  THEN
-       IF ( ocean_mode )  THEN
-          disturbance_level_b     = zu((nzt*2)/3)
-          disturbance_level_ind_b = ( nzt * 2 ) / 3
-       ELSE
-          disturbance_level_b     = zu(nzb+3)
-          disturbance_level_ind_b = nzb + 3
-       ENDIF
+    IF ( disturbance_level_b == -1.0 )  THEN
+       disturbance_level_b     = zu(nzb+3)
+       disturbance_level_ind_b = nzb + 3
     ELSEIF ( disturbance_level_b < zu(3) )  THEN
-       WRITE( message_string, * )  'disturbance_level_b = ', disturbance_level_b, ' must be >= ',  &
-              zu(3), '(zu(3))'
-       CALL message( 'check_parameters', 'PA0126', 1, 2, 0, 6, 0 )
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  disturbance_level_b=',&
+                                 disturbance_level_b, ' must be >= ',zu(3),    &
+                                 '(zu(3))'
+       CALL local_stop
     ELSEIF ( disturbance_level_b > zu(nzt-2) )  THEN
-       WRITE( message_string, * )  'disturbance_level_b = ', disturbance_level_b, ' must be <= ',  &
-              zu(nzt-2), '(zu(nzt-2))'
-       CALL message( 'check_parameters', 'PA0127', 1, 2, 0, 6, 0 )
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  disturbance_level_b=',&
+                                 disturbance_level_b, ' must be <= ',zu(nzt-2),&
+                                 '(zu(nzt-2))'
+       CALL local_stop
     ELSE
        DO  k = 3, nzt-2
@@ -2791,20 +2284,17 @@
     ENDIF
 
-    IF ( disturbance_level_t == -9999999.9_wp )  THEN
-       IF ( ocean_mode )  THEN
-          disturbance_level_t     = zu(nzt-3)
-          disturbance_level_ind_t = nzt - 3
-       ELSE
-          disturbance_level_t     = zu(nzt/3)
-          disturbance_level_ind_t = nzt / 3
-       ENDIF
+    IF ( disturbance_level_t == -1.0 )  THEN
+       disturbance_level_t     = zu(nzt/3)
+       disturbance_level_ind_t = nzt / 3
     ELSEIF ( disturbance_level_t > zu(nzt-2) )  THEN
-       WRITE( message_string, * )  'disturbance_level_t = ', disturbance_level_t, ' must be <= ',  &
-              zu(nzt-2), '(zu(nzt-2))'
-       CALL message( 'check_parameters', 'PA0128', 1, 2, 0, 6, 0 )
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  disturbance_level_t=',&
+                                 disturbance_level_t, ' must be <= ',zu(nzt-2),&
+                                 '(zu(nzt-2))'
+       CALL local_stop
     ELSEIF ( disturbance_level_t < disturbance_level_b )  THEN
-       WRITE( message_string, * )  'disturbance_level_t = ', disturbance_level_t,                  &
-             ' must be >= disturbance_level_b = ', disturbance_level_b
-       CALL message( 'check_parameters', 'PA0129', 1, 2, 0, 6, 0 )
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  disturbance_level_t=',&
+                                 disturbance_level_t, ' must be >= ',          &
+                                 'disturbance_level_b=', disturbance_level_b
+       CALL local_stop
     ELSE
        DO  k = 3, nzt-2
@@ -2818,30 +2308,40 @@
 !
 !-- Check again whether the levels determined this way are ok.
-!-- Error may occur at automatic determination and too few grid points in z-direction.
+!-- Error may occur at automatic determination and too few grid points in
+!-- z-direction.
     IF ( disturbance_level_ind_t < disturbance_level_ind_b )  THEN
-       WRITE( message_string, * )  'disturbance_level_ind_t = ', disturbance_level_ind_t,          &
-              ' must be >= ', 'disturbance_level_ind_b = ', disturbance_level_ind_b
-       CALL message( 'check_parameters', 'PA0130', 1, 2, 0, 6, 0 )
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  ',                &
+                                 'disturbance_level_ind_t=',               &
+                                 disturbance_level_ind_t, ' must be >= ',  &
+                                 'disturbance_level_ind_b=',               &
+                                 disturbance_level_ind_b
+       CALL local_stop
     ENDIF
 
 !
 !-- Determine the horizontal index range for random perturbations.
-!-- In case of non-cyclic horizontal boundaries, no perturbations are imposed near the inflow and
-!-- the perturbation area is further limited to ...(1) after the initial phase of the flow.
-
+!-- In case of non-cyclic horizontal boundaries, no perturbations are imposed
+!-- near the inflow and the perturbation area is further limited to ...(1)
+!-- after the initial phase of the flow.
+    dist_nxl = 0;  dist_nxr = nx
+    dist_nys = 0;  dist_nyn = ny
     IF ( bc_lr /= 'cyclic' )  THEN
        IF ( inflow_disturbance_begin == -1 )  THEN
           inflow_disturbance_begin = MIN( 10, nx/2 )
        ENDIF
-       IF ( inflow_disturbance_begin < 0  .OR.  inflow_disturbance_begin > nx )  THEN
-          message_string = 'inflow_disturbance_begin out of range'
-          CALL message( 'check_parameters', 'PA0131', 1, 2, 0, 6, 0 )
+       IF ( inflow_disturbance_begin < 0  .OR.  inflow_disturbance_begin > nx )&
+       THEN
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters: inflow_disturbance',&
+                                    '_begin out of range'
+          CALL local_stop
        ENDIF
        IF ( inflow_disturbance_end == -1 )  THEN
           inflow_disturbance_end = MIN( 100, 3*nx/4 )
        ENDIF
-       IF ( inflow_disturbance_end < 0  .OR.  inflow_disturbance_end > nx )  THEN
-          message_string = 'inflow_disturbance_end out of range'
-          CALL message( 'check_parameters', 'PA0132', 1, 2, 0, 6, 0 )
+       IF ( inflow_disturbance_end < 0  .OR.  inflow_disturbance_end > nx )    &
+       THEN
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters: inflow_disturbance',&
+                                    '_end out of range'
+          CALL local_stop
        ENDIF
     ELSEIF ( bc_ns /= 'cyclic' )  THEN
@@ -2849,125 +2349,45 @@
           inflow_disturbance_begin = MIN( 10, ny/2 )
        ENDIF
-       IF ( inflow_disturbance_begin < 0  .OR.  inflow_disturbance_begin > ny )  THEN
-          message_string = 'inflow_disturbance_begin out of range'
-          CALL message( 'check_parameters', 'PA0131', 1, 2, 0, 6, 0 )
+       IF ( inflow_disturbance_begin < 0  .OR.  inflow_disturbance_begin > ny )&
+       THEN
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters: inflow_disturbance',&
+                                    '_begin out of range'
+          CALL local_stop
        ENDIF
        IF ( inflow_disturbance_end == -1 )  THEN
           inflow_disturbance_end = MIN( 100, 3*ny/4 )
        ENDIF
-       IF ( inflow_disturbance_end < 0  .OR.  inflow_disturbance_end > ny )  THEN
-          message_string = 'inflow_disturbance_end out of range'
-          CALL message( 'check_parameters', 'PA0132', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    IF ( random_generator == 'random-parallel' )  THEN
-       dist_nxl = nxl;  dist_nxr = nxr
-       dist_nys = nys;  dist_nyn = nyn
-       IF ( bc_lr == 'radiation/dirichlet' )  THEN
-          dist_nxr    = MIN( nx - inflow_disturbance_begin, nxr )
-          dist_nxl(1) = MAX( nx - inflow_disturbance_end, nxl )
-       ELSEIF ( bc_lr == 'dirichlet/radiation' )  THEN
-          dist_nxl    = MAX( inflow_disturbance_begin, nxl )
-          dist_nxr(1) = MIN( inflow_disturbance_end, nxr )
-       ELSEIF ( bc_lr == 'nested'  .OR.  bc_lr == 'nesting_offline' )  THEN
-          dist_nxl    = MAX( inflow_disturbance_begin, nxl )
-          dist_nxr    = MIN( nx - inflow_disturbance_begin, nxr )
-       ENDIF
-       IF ( bc_ns == 'dirichlet/radiation' )  THEN
-          dist_nyn    = MIN( ny - inflow_disturbance_begin, nyn )
-          dist_nys(1) = MAX( ny - inflow_disturbance_end, nys )
-       ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
-          dist_nys    = MAX( inflow_disturbance_begin, nys )
-          dist_nyn(1) = MIN( inflow_disturbance_end, nyn )
-       ELSEIF ( bc_ns == 'nested'  .OR.  bc_ns == 'nesting_offline' )  THEN
-          dist_nys    = MAX( inflow_disturbance_begin, nys )
-          dist_nyn    = MIN( ny - inflow_disturbance_begin, nyn )
-       ENDIF
-    ELSE
-       dist_nxl = 0;  dist_nxr = nx
-       dist_nys = 0;  dist_nyn = ny
-       IF ( bc_lr == 'radiation/dirichlet' )  THEN
-          dist_nxr    = nx - inflow_disturbance_begin
-          dist_nxl(1) = nx - inflow_disturbance_end
-       ELSEIF ( bc_lr == 'dirichlet/radiation' )  THEN
-          dist_nxl    = inflow_disturbance_begin
-          dist_nxr(1) = inflow_disturbance_end
-       ELSEIF ( bc_lr == 'nested'  .OR.  bc_lr == 'nesting_offline' )  THEN
-          dist_nxr    = nx - inflow_disturbance_begin
-          dist_nxl    = inflow_disturbance_begin
-       ENDIF
-       IF ( bc_ns == 'dirichlet/radiation' )  THEN
-          dist_nyn    = ny - inflow_disturbance_begin
-          dist_nys(1) = ny - inflow_disturbance_end
-       ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
-          dist_nys    = inflow_disturbance_begin
-          dist_nyn(1) = inflow_disturbance_end
-       ELSEIF ( bc_ns == 'nested'  .OR.  bc_ns == 'nesting_offline' )  THEN
-          dist_nyn    = ny - inflow_disturbance_begin
-          dist_nys    = inflow_disturbance_begin
-       ENDIF
-    ENDIF
-
-!
-!-- A turbulent inflow requires Dirichlet conditions at the respective inflow boundary (so far, a
-!-- turbulent inflow is realized from the left side only).
-    IF ( turbulent_inflow  .AND.  bc_lr /= 'dirichlet/radiation' )  THEN
-       message_string = 'turbulent_inflow = .T. requires a Dirichlet ' //                          &
-                        'condition at the inflow boundary'
-       CALL message( 'check_parameters', 'PA0133', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Turbulent inflow requires that 3d arrays have been cyclically filled with data from prerun in
-!-- the first main run
-    IF ( turbulent_inflow  .AND.  initializing_actions /= 'cyclic_fill'  .AND.                     &
-         initializing_actions /= 'read_restart_data' )  THEN
-       message_string = 'turbulent_inflow = .T. requires ' //                                      &
-                        'initializing_actions = ''cyclic_fill'' or ' //                            &
-                        'initializing_actions = ''read_restart_data'' '
-       CALL message( 'check_parameters', 'PA0055', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- In case of turbulent inflow
-    IF ( turbulent_inflow )  THEN
-
-!
-!--    Calculate the index of the recycling plane
-       IF ( recycling_width <= dx  .OR.  recycling_width >= nx * dx )  THEN
-          WRITE( message_string, * )  'illegal value for recycling_width: ', recycling_width
-          CALL message( 'check_parameters', 'PA0134', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Calculate the index
-       recycling_plane = recycling_width / dx
-!
-!--   Check for correct input of recycling method for thermodynamic quantities
-       IF ( TRIM( recycling_method_for_thermodynamic_quantities ) /= 'turbulent_fluctuation'  .AND.&
-            TRIM( recycling_method_for_thermodynamic_quantities ) /= 'absolute_value' )  THEN
-          WRITE( message_string, * )  'unknown recycling method for thermodynamic quantities: ',   &
-               TRIM( recycling_method_for_thermodynamic_quantities )
-          CALL message( 'check_parameters', 'PA0184', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDIF
-
-
-    IF ( turbulent_outflow )  THEN
-!
-!--    Turbulent outflow requires Dirichlet conditions at the respective inflow boundary (so far, a
-!--    turbulent outflow is realized at the right side only).
-       IF ( bc_lr /= 'dirichlet/radiation' )  THEN
-          message_string = 'turbulent_outflow = .T. requires bc_lr = "dirichlet/radiation"'
-          CALL message( 'check_parameters', 'PA0038', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    The ouflow-source plane must lay inside the model domain
-       IF ( outflow_source_plane < dx  .OR.  outflow_source_plane > nx * dx )  THEN
-          WRITE( message_string, * )  'illegal value for outflow_source'// '_plane: ',             &
-                 outflow_source_plane
-          CALL message( 'check_parameters', 'PA0145', 1, 2, 0, 6, 0 )
-       ENDIF
+       IF ( inflow_disturbance_end < 0  .OR.  inflow_disturbance_end > ny )    &
+       THEN
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters: inflow_disturbance',&
+                                    '_end out of range'
+          CALL local_stop
+       ENDIF
+    ENDIF
+
+    IF ( outflow_l )  THEN
+       dist_nxr    = nx - inflow_disturbance_begin
+       dist_nxl(1) = nx - inflow_disturbance_end
+    ELSEIF ( outflow_r )  THEN
+       dist_nxl    = inflow_disturbance_begin
+       dist_nxr(1) = inflow_disturbance_end
+    ELSEIF ( outflow_s )  THEN
+       dist_nyn    = ny - inflow_disturbance_begin
+       dist_nys(1) = ny - inflow_disturbance_end
+    ELSEIF ( outflow_n )  THEN
+       dist_nys    = inflow_disturbance_begin
+       dist_nyn(1) = inflow_disturbance_end
+    ENDIF
+
+!
+!-- Check random generator
+    IF ( random_generator /= 'system-specific'  .AND. &
+         random_generator /= 'numerical-recipes' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ check_parameters:'
+          PRINT*, '    unknown random generator: random_generator=', &
+                  random_generator
+       ENDIF
+       CALL local_stop
     ENDIF
 
@@ -2975,11 +2395,12 @@
 !-- Determine damping level index for 1D model
     IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
-       IF ( damp_level_1d == -1.0_wp )  THEN
+       IF ( damp_level_1d == -1.0 )  THEN
           damp_level_1d     = zu(nzt+1)
           damp_level_ind_1d = nzt + 1
-       ELSEIF ( damp_level_1d < 0.0_wp  .OR.  damp_level_1d > zu(nzt+1) )  THEN
-          WRITE( message_string, * )  'damp_level_1d = ', damp_level_1d, ' must be >= 0.0 and <= ',&
-                 zu(nzt+1), '(zu(nzt+1))'
-          CALL message( 'check_parameters', 'PA0136', 1, 2, 0, 6, 0 )
+       ELSEIF ( damp_level_1d < 0.0  .OR.  damp_level_1d > zu(nzt+1) )  THEN
+          IF ( myid == 0 )  PRINT*, '+++ check_parameters:  damp_level_1d=', &
+                                    damp_level_1d, ' must be > 0.0 and < ',  &
+                                    'zu(nzt+1)', zu(nzt+1)
+          CALL local_stop
        ELSE
           DO  k = 1, nzt+1
@@ -2991,316 +2412,70 @@
        ENDIF
     ENDIF
-
 !
 !-- Check some other 1d-model parameters
-    IF ( TRIM( mixing_length_1d ) /= 'as_in_3d_model'  .AND.                                       &
+    IF ( TRIM( mixing_length_1d ) /= 'as_in_3d_model'  .AND. &
          TRIM( mixing_length_1d ) /= 'blackadar' )  THEN
-       message_string = 'mixing_length_1d = "' // TRIM( mixing_length_1d ) // '" is unknown'
-       CALL message( 'check_parameters', 'PA0137', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( TRIM( dissipation_1d ) /= 'as_in_3d_model'  .AND.                                         &
-         TRIM( dissipation_1d ) /= 'detering'        .AND.                                         &
-         TRIM( dissipation_1d ) /= 'prognostic' )  THEN
-       message_string = 'dissipation_1d = "' // TRIM( dissipation_1d ) // '" is unknown'
-       CALL message( 'check_parameters', 'PA0138', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( TRIM( mixing_length_1d ) /= 'as_in_3d_model'  .AND.                                       &
-         TRIM( dissipation_1d ) == 'as_in_3d_model' )  THEN
-       message_string = 'dissipation_1d = "' // TRIM( dissipation_1d ) //                          &
-                        '" requires mixing_length_1d = "as_in_3d_model"'
-       CALL message( 'check_parameters', 'PA0485', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Set time for the next user defined restart (time_restart is the internal parameter for steering
-!-- restart events)
-    IF ( restart_time /= 9999999.9_wp )  THEN
-       IF ( restart_time > time_since_reference_point )  THEN
-          time_restart = restart_time
-       ENDIF
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters: mixing_length_1d = "', &
+                                 TRIM( mixing_length_1d ), '" is unknown'
+       CALL local_stop
+    ENDIF
+    IF ( TRIM( dissipation_1d ) /= 'as_in_3d_model'  .AND. &
+         TRIM( dissipation_1d ) /= 'detering' )  THEN
+       IF ( myid == 0 )  PRINT*, '+++ check_parameters: dissipation_1d = "', &
+                                 TRIM( dissipation_1d ), '" is unknown'
+       CALL local_stop
+    ENDIF
+
+!
+!-- Set time for the next user defined restart (time_restart is the
+!-- internal parameter for steering restart events)
+    IF ( restart_time /= 9999999.9 )  THEN
+       IF ( restart_time > simulated_time )  time_restart = restart_time
     ELSE
 !
-!--    In case of a restart run, set internal parameter to default (no restart) if the
-!--    NAMELIST-parameter restart_time is omitted
-       time_restart = 9999999.9_wp
-    ENDIF
-
-!
-!-- Check pressure gradient conditions
-    IF ( dp_external  .AND.  conserve_volume_flow )  THEN
-       WRITE( message_string, * )  'Both dp_external and conserve_volume_flo',                     &
-              'w are .TRUE. but one of them must be .FALSE.'
-       CALL message( 'check_parameters', 'PA0150', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( dp_external )  THEN
-       IF ( dp_level_b < zu(nzb)  .OR.  dp_level_b > zu(nzt) )  THEN
-          WRITE( message_string, * )  'dp_level_b = ', dp_level_b, ' is out ',                     &
-                 ' of range [zu(nzb), zu(nzt)]'
-          CALL message( 'check_parameters', 'PA0151', 1, 2, 0, 6, 0 )
-       ENDIF
-       IF ( .NOT. ANY( dpdxy /= 0.0_wp ) )  THEN
-          WRITE( message_string, * )  'dp_external is .TRUE. but dpdxy is ze',                     &
-                 'ro, i.e. the external pressure gradient will not be applied'
-          CALL message( 'check_parameters', 'PA0152', 0, 1, 0, 6, 0 )
-       ENDIF
-    ENDIF
-    IF ( ANY( dpdxy /= 0.0_wp )  .AND.  .NOT.  dp_external )  THEN
-       WRITE( message_string, * )  'dpdxy is nonzero but dp_external is ',                         &
-              '.FALSE., i.e. the external pressure gradient & will not be applied'
-       CALL message( 'check_parameters', 'PA0153', 0, 1, 0, 6, 0 )
-    ENDIF
-    IF ( conserve_volume_flow )  THEN
-       IF ( TRIM( conserve_volume_flow_mode ) == 'default' )  THEN
-
-          conserve_volume_flow_mode = 'initial_profiles'
-
-       ELSEIF ( TRIM( conserve_volume_flow_mode ) /= 'initial_profiles'  .AND.                     &
-                TRIM( conserve_volume_flow_mode ) /= 'bulk_velocity' )  THEN
-          WRITE( message_string, * )  'unknown conserve_volume_flow_mode: ',                       &
-                 conserve_volume_flow_mode
-          CALL message( 'check_parameters', 'PA0154', 1, 2, 0, 6, 0 )
-       ENDIF
-       IF ( ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic')  .AND.                                   &
-            TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
-          WRITE( message_string, * )  'non-cyclic boundary conditions ',                           &
-                 'require  conserve_volume_flow_mode = ''initial_profiles'''
-          CALL message( 'check_parameters', 'PA0155', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-    IF ( ( u_bulk /= 0.0_wp .OR. v_bulk /= 0.0_wp )  .AND.                                         &
-         ( .NOT. conserve_volume_flow .OR. TRIM( conserve_volume_flow_mode ) /= 'bulk_velocity' ) )&
-    THEN
-       WRITE( message_string, * )  'nonzero bulk velocity requires ',                              &
-              'conserve_volume_flow = .T. and ', 'conserve_volume_flow_mode = ''bulk_velocity'''
-       CALL message( 'check_parameters', 'PA0157', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Prevent empty time records in volume, cross-section and masked data in case of non-parallel
-!-- netcdf-output in restart runs
-    IF ( netcdf_data_format < 5 )  THEN
-       IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
-          do3d_time_count    = 0
-          do2d_xy_time_count = 0
-          do2d_xz_time_count = 0
-          do2d_yz_time_count = 0
-          domask_time_count  = 0
-       ENDIF
-    ENDIF
-
-
-!
-!-- Check roughness length, which has to be smaller than dz/2
-    IF ( ( constant_flux_layer .OR. INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  &
-         .AND.  roughness_length >= 0.5 * dz(1) )  THEN
-       message_string = 'roughness_length must be smaller than dz/2'
-       CALL message( 'check_parameters', 'PA0424', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check if topography is read from file in case of complex terrain simulations
-    IF ( complex_terrain  .AND.  TRIM( topography ) /= 'read_from_file' )  THEN
-       message_string = 'complex_terrain requires topography = ''read_from_file'''
-       CALL message( 'check_parameters', 'PA0295', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check if vertical grid stretching is switched off in case of complex terrain simulations
-    IF ( complex_terrain  .AND.  ANY( dz_stretch_level_start /= -9999999.9_wp ) )  THEN
-       message_string = 'Vertical grid stretching is not allowed for complex_terrain = .TRUE.'
-       CALL message( 'check_parameters', 'PA0473', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    CALL location_message( 'checking parameters', 'finished' )
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check the length of data output intervals. In case of parallel NetCDF output the time levels of
-!> the output files need to be fixed. Therefore setting the output interval to 0.0s (usually used to
-!> output each timestep) is not possible as long as a non-fixed timestep is used.
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE check_dt_do( dt_do, dt_do_name )
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*), INTENT (IN) :: dt_do_name !< parin variable name
-
-       REAL(wp), INTENT (INOUT)       :: dt_do      !< data output interval
-
-       IF ( dt_do == 0.0_wp )  THEN
-          IF ( dt_fixed )  THEN
-             WRITE( message_string, '(A,F9.4,A)' )  'Output at every timestep is wanted (' //      &
-                    dt_do_name // ' = 0.0).&'//                                                    &
-                    'The output interval is set to the fixed timestep dt '// '= ', dt, 's.'
-             CALL message( 'check_parameters', 'PA0060', 0, 0, 0, 6, 0 )
-             dt_do = dt
-          ELSE
-             message_string = dt_do_name // ' = 0.0 while using a ' //                             &
-                              'variable timestep and parallel netCDF4 is not allowed.'
-             CALL message( 'check_parameters', 'PA0081', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-    END SUBROUTINE check_dt_do
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the bottom and top boundary conditions for humidity and scalars.
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE set_bc_scalars( sq, bc_b, bc_t, ibc_b, ibc_t, err_nr_b, err_nr_t )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*)   ::  bc_b       !< bottom boundary condition
-       CHARACTER (LEN=*)   ::  bc_t       !< top boundary condition
-       CHARACTER (LEN=*)   ::  err_nr_b   !< error number if bottom bc is unknown
-       CHARACTER (LEN=*)   ::  err_nr_t   !< error number if top bc is unknown
-       CHARACTER (LEN=1)   ::  sq         !< name of scalar quantity
-
-
-       INTEGER(iwp)        ::  ibc_b      !< index for bottom boundary condition
-       INTEGER(iwp)        ::  ibc_t      !< index for top boundary condition
-
-!
-!--    Set Integer flags and check for possilbe errorneous settings for bottom boundary condition
-       IF ( bc_b == 'dirichlet' )  THEN
-          ibc_b = 0
-       ELSEIF ( bc_b == 'neumann' )  THEN
-          ibc_b = 1
+!--    In case of a restart run, set internal parameter to default (no restart)
+!--    if the NAMELIST-parameter restart_time is omitted
+       time_restart = 9999999.9
+    ENDIF
+
+!
+!-- Set default value of the time needed to terminate a model run
+    IF ( termination_time_needed == -1.0 )  THEN
+       IF ( host(1:3) == 'ibm' )  THEN
+          termination_time_needed = 300.0
        ELSE
-          message_string = 'unknown boundary condition: bc_' // TRIM( sq ) // '_b ="' //           &
-                           TRIM( bc_b ) // '"'
-          CALL message( 'check_parameters', err_nr_b, 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Set Integer flags and check for possilbe errorneous settings for top boundary condition
-       IF ( bc_t == 'dirichlet' )  THEN
-          ibc_t = 0
-       ELSEIF ( bc_t == 'neumann' )  THEN
-          ibc_t = 1
-       ELSEIF ( bc_t == 'initial_gradient' )  THEN
-          ibc_t = 2
-       ELSEIF ( bc_t == 'nested'  .OR.  bc_t == 'nesting_offline' )  THEN
-          ibc_t = 3
-       ELSE
-          message_string = 'unknown boundary condition: bc_' // TRIM( sq ) // '_t ="' //           &
-                           TRIM( bc_t ) // '"'
-          CALL message( 'check_parameters', err_nr_t, 1, 2, 0, 6, 0 )
-       ENDIF
-
-
-    END SUBROUTINE set_bc_scalars
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check for consistent settings of bottom boundary conditions for humidity and scalars.
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE check_bc_scalars( sq, bc_b, ibc_b, err_nr_1, err_nr_2, constant_flux,               &
-                                 surface_initial_change )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*)   ::  bc_b                     !< bottom boundary condition
-       CHARACTER (LEN=*)   ::  err_nr_1                 !< error number of first error
-       CHARACTER (LEN=*)   ::  err_nr_2                 !< error number of second error
-       CHARACTER (LEN=1)   ::  sq                       !< name of scalar quantity
-
-
-       INTEGER(iwp)        ::  ibc_b                    !< index of bottom boundary condition
-
-       LOGICAL             ::  constant_flux            !< flag for constant-flux layer
-
-       REAL(wp)            ::  surface_initial_change   !< value of initial change at the surface
-
-!
-!--    A given surface value implies Dirichlet boundary condition for the respective quantity. In
-!--    this case specification of a constant flux is forbidden. However, an exception is made for
-!--    large-scale forcing as well as land-surface model.
-       IF ( .NOT. land_surface  .AND.  .NOT. large_scale_forcing )  THEN
-          IF ( ibc_b == 0  .AND.  constant_flux )  THEN
-             message_string = 'boundary condition: bc_' // TRIM( sq ) // '_b = "' //               &
-                              TRIM( bc_b ) // '" is not allowed with prescribed surface flux'
-             CALL message( 'check_parameters', err_nr_1, 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-       IF ( constant_flux  .AND.  surface_initial_change /= 0.0_wp )  THEN
-          WRITE( message_string, * )  'a prescribed surface flux is not allo', 'wed with ', sq,    &
-                '_surface_initial_change (/=0) = ', surface_initial_change
-          CALL message( 'check_parameters', err_nr_2, 1, 2, 0, 6, 0 )
-       ENDIF
-
-
-    END SUBROUTINE check_bc_scalars
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Filter a list of strings for duplicates. The output list is of same length but does not contain
-!> any duplicates.
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE filter_duplicate_strings( string_length, string_list, string_list_filtered )
-
-       IMPLICIT NONE
-
-       INTEGER, INTENT(IN) :: string_length  !< length of a single string in list
-
-       CHARACTER (LEN=*),             DIMENSION(:), INTENT(IN)               ::  string_list           !< non-filtered list
-       CHARACTER (LEN=string_length), DIMENSION(:), INTENT(OUT), ALLOCATABLE ::  string_list_filtered  !< filtered list
-
-       CHARACTER (LEN=string_length) ::  string_to_check  !< string to be check for duplicates
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-       INTEGER(iwp) ::  nstrings  !< number of strings in list
-
-       LOGICAL ::  is_duplicate  !< true if string has duplicates in list
-
-
-       nstrings = UBOUND( string_list, DIM=1 )
-       ALLOCATE( string_list_filtered(1:nstrings) )
-       string_list_filtered(:) = ' '
-
-       k = 0
-       DO  i = 1, nstrings
-          string_to_check = string_list(i)
-
-          IF ( string_to_check == ' ' )  EXIT
-
-          is_duplicate = .FALSE.
-          DO  j = 1, nstrings
-             IF ( string_list_filtered(j) == ' ' )  THEN
-                EXIT
-             ELSEIF ( string_to_check == string_list_filtered(j) )  THEN
-                is_duplicate = .TRUE.
-                EXIT
-             ENDIF
-          ENDDO
-
-          IF ( .NOT. is_duplicate )  THEN
-             k = k + 1
-             string_list_filtered(k) = string_to_check
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE filter_duplicate_strings
+          termination_time_needed = 35.0
+       ENDIF
+    ENDIF
+
+!
+!-- Check the time needed to terminate a model run
+    IF ( host(1:3) == 't3e' )  THEN
+!
+!--    Time needed must be at least 30 seconds on all CRAY machines, because
+!--    MPP_TREMAIN gives the remaining CPU time only in steps of 30 seconds
+       IF ( termination_time_needed <= 30.0 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ check_parameters:  termination_time_needed', &
+                      termination_time_needed
+             PRINT*, '                       must be > 30.0 on host "', host, &
+                     '"'
+          ENDIF
+          CALL local_stop
+       ENDIF
+    ELSEIF ( host(1:3) == 'ibm' )  THEN
+!
+!--    On IBM-regatta machines the time should be at least 300 seconds,
+!--    because the job time consumed before executing palm (for compiling,
+!--    copying of files, etc.) has to be regarded
+       IF ( termination_time_needed < 300.0 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ WARNING: check_parameters:  termination_time_',  &
+                         'needed', termination_time_needed
+             PRINT*, '                                should be >= 300.0', &
+                         ' on host "', host, '"'
+          ENDIF
+       ENDIF
+    ENDIF
 
 
Index: palm/trunk/SOURCE/chem_emissions_mod.f90
===================================================================
--- palm/trunk/SOURCE/chem_emissions_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2426 +1,0 @@
-!> @file chem_emissions_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of PALM model system.
-!
-! 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 2018-2021 Leibniz Universitaet Hannover
-! Copyright 2018-2021 Freie Universitaet Berlin
-! Copyright 2018-2021 Karlsruhe Institute of Technology
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Unnecessary comments removed
-!
-! 4828 2021-01-05 11:21:41Z Giersch 
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4559 2020-06-11 08:51:48Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! Implemented on-demand read mode for LOD 2 NB
-!  - added following module global variables
-!    - input_file_chem (namesake in netcdf_data_input_mod is local)
-!    - timestamps
-!  - added following public subroutines / interfaces
-!    - chem_emisisons_header_init
-!    - chem_emisisons_update_on_demand
-!  - added following local subroutines
-!    - chem_emisisons_header_init_lod2
-!    - chem_emisisons_update_on_demand_lod2
-!  - added following local auxiliary subroutines
-!    - chem_emissions_init_species ( )
-!    - chem_emissions_init_timestamps ( )
-!    - chem_emissions_assign_surface_flux ( )
-!  - added following local functions
-!    - chem_emisisons_convert_base_units ( )
-!    - chem_emissions_mass_2_molar_flux ( )
-!    - chem_emissions_locate_species ( )
-!    - chem_emissions_locate_timestep ( )
-!  - added following error messages
-!    - CM0468 - LOD mismatch (namelist / chemistry file)
-!    - CM0469 - Timestamps no in choronological order
-!  - depreciated unused module variable filename_emis
-!
-! 4356 2019-12-20 17:09:33Z suehring
-! Minor formatting adjustment
-!
-! 4242 2019-09-27 12:59:10Z suehring
-! Adjust index_hh access to new definition accompanied with new
-! palm_date_time_mod. Note, this is just a preleminary fix. (E Chan)
-!
-! 4230 2019-09-11 13:58:14Z suehring
-! Bugfix, consider that time_since_reference_point can be also negative when
-! time indices are determined.
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod
-!
-! 4223 2019-09-10 09:20:47Z gronemeier
-! Unused routine chem_emissions_check_parameters commented out due to uninitialized content
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4157 2019-08-14 09:19:12Z suehring
-! Replace global arrays also in mode_emis branch
-!
-! 4154 2019-08-13 13:35:59Z suehring
-! Replace global arrays for emissions by local ones.
-!
-! 4144 2019-08-06 09:11:47Z raasch
-! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
-!
-! 4055 2019-06-27 09:47:29Z suehring
-! - replaced local thermo. constants w/ module definitions in basic_constants_and_equations_mod
-!   (rgas_univ, p_0, r_d_cp)
-! - initialize array emis_distribution immediately following allocation
-! - lots of minor formatting changes based on review sesson in 20190325 (E.C. Chan)
-!
-! 3968 2019-05-13 11:04:01Z suehring
-! - in subroutine chem_emissions_match replace all decision structures relating to mode_emis to
-!   emiss_lod
-! - in subroutine chem_check_parameters replace emt%nspec with emt%n_emiss_species
-! - spring cleaning (E.C. Chan)
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3831 2019-03-28 09:11:22Z forkel
-! added nvar to USE chem_gasphase_mod (chem_modules will not include nvar anymore)
-!
-! 3788 2019-03-07 11:40:09Z banzhafs
-! Removed unused variables from chem_emissions_mod
-!
-! 3772 2019-02-28 15:51:57Z suehring
-! - In case of parametrized emissions, assure that emissions are only on natural surfaces
-!   (i.e. streets) and not on urban surfaces.
-! - some unnecessary if clauses removed
-!
-! 3685 2019 -01-21 01:02:11Z knoop
-! Some interface calls moved to module_interface + cleanup
-! 3286 2018-09-28 07:41:39Z forkel
-!
-! Authors:
-! --------
-! @author Emmanuele Russo (FU-Berlin)
-! @author Sabine Banzhaf  (FU-Berlin)
-! @author Martijn Schaap  (FU-Berlin, TNO Utrecht)
-!
-! Description:
-! ------------
-!>  MODULE for reading-in Chemistry Emissions data
-!>
-!> @note <Enter notes on the module>
-!> @bug  <Enter known bugs here>
-!--------------------------------------------------------------------------------------------------!
-
- MODULE chem_emissions_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  rho_air
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  p_0, rd_d_cp, rgas_univ
-
-    USE control_parameters,                                                                        &
-        ONLY:  debug_output, end_time, initializing_actions, intermediate_timestep_count,          &
-               message_string, dt_3d
-
-    USE indices
-
-    USE kinds
-
-#if defined( __netcdf )
-    USE netcdf
-#endif
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY: chem_emis_att_type, chem_emis_val_type
-
-    USE chem_gasphase_mod,                                                                         &
-        ONLY: nvar, spc_names
-
-    USE chem_modules
-
-    USE statistics,                                                                                &
-        ONLY:  weight_pres
-
-!
-!-- 20200203 NB
-!-- Added new palm_date_time_mod for on-demand emission reading
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  get_date_time
-
-    IMPLICIT NONE
-
-!
-!-- Declare all global variables within the module
-
-!
-!-- 20200203 NB new variables for on-demand read mode
-
-    CHARACTER(LEN=*),   PARAMETER   :: input_file_chem = 'PIDS_CHEM' !< chemistry file
-
-    CHARACTER(LEN=512), ALLOCATABLE, DIMENSION(:) :: timestamps      !< timestamps in chemistry file
-
-
-    INTEGER(iwp) ::  dt_emis         !< Time Step Emissions
-    INTEGER(iwp) ::  i               !< index 1st selected dimension (some dims are not spatial)
-    INTEGER(iwp) ::  j               !< index 2nd selected dimension
-    INTEGER(iwp) ::  i_end           !< Index to end read variable from netcdf in one dims
-    INTEGER(iwp) ::  i_start         !< Index to start read variable from netcdf along one dims
-    INTEGER(iwp) ::  j_end           !< Index to end read variable from netcdf in additional dims
-    INTEGER(iwp) ::  j_start         !< Index to start read variable from netcdf in additional dims
-    INTEGER(iwp) ::  len_index       !< length of index (used for several indices)
-    INTEGER(iwp) ::  len_index_pm    !< length of PMs index
-    INTEGER(iwp) ::  len_index_voc   !< length of voc index
-    INTEGER(iwp) ::  previous_timestamp_index !< index for current timestamp (20200203 ECC)
-    INTEGER(iwp) ::  z_end           !< Index to end read variable from netcdf in additional dims
-    INTEGER(iwp) ::  z_start         !< Index to start read variable from netcdf in additional dims
-
-    REAL(wp) ::  conversion_factor                   !< Units Conversion Factor
-
-    SAVE
-
-!
-!-- Matching Emissions actions
-    INTERFACE chem_emissions_match
-       MODULE PROCEDURE chem_emissions_match
-    END INTERFACE chem_emissions_match
-!
-!-- Initialization actions
-    INTERFACE chem_emissions_init
-       MODULE PROCEDURE chem_emissions_init
-    END INTERFACE chem_emissions_init
-!
-!-- Setup of Emissions
-    INTERFACE chem_emissions_setup
-       MODULE PROCEDURE chem_emissions_setup
-    END INTERFACE chem_emissions_setup
-
-!
-!-- 20200203 NB new interfaces for on-demand mode
-
-!
-!-- initialization actions for on-demand mode
-    INTERFACE chem_emissions_header_init
-       MODULE PROCEDURE chem_emissions_header_init
-    END INTERFACE chem_emissions_header_init
-!
-!-- load emission data for on-demand mode
-    INTERFACE chem_emissions_update_on_demand
-       MODULE PROCEDURE chem_emissions_update_on_demand
-    END INTERFACE chem_emissions_update_on_demand
-
-!
-!-- 20200203 NB update public routines
-
-    PUBLIC chem_emissions_init, chem_emissions_match, chem_emissions_setup,                        &
-           chem_emissions_header_init, chem_emissions_update_on_demand
-!
-!-- Public Variables
-    PUBLIC conversion_factor, len_index, len_index_pm, len_index_voc
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Matching the chemical species indices. The routine checks what are the indices of the emission
-!> input species and the corresponding ones of the model species. The routine gives as output a
-!> vector containing the number of common species: it is important to note that while the model
-!> species are distinct, their values could be given to a single species in input.
-!> For example, in the case of NO2 and NO, values may be passed in input as NOX values.
-!--------------------------------------------------------------------------------------------------!
-
-SUBROUTINE chem_emissions_match( emt_att,len_index )
-
-    INTEGER(iwp)  ::  ind_inp                    !< Parameters for cycling through chemical input species
-    INTEGER(iwp)  ::  ind_mod                    !< Parameters for cycling through chemical model species
-    INTEGER(iwp)  ::  ind_voc                    !< Indices to check whether a split for voc should be done
-    INTEGER(iwp)  ::  ispec                      !< index for cycle over effective number of emission species
-    INTEGER(iwp)  ::  nspec_emis_inp             !< Variable where to store # of emission species in input
-
-    INTEGER(iwp), INTENT(INOUT)  ::  len_index   !< number of common species between input dataset & model species
-
-    TYPE(chem_emis_att_type), INTENT(INOUT) ::  emt_att     !< Chemistry Emission Array (decl. netcdf_data_input.f90)
-
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_match', 'start' )
-
-!
-!-- Number of input emission species
-
-    nspec_emis_inp = emt_att%n_emiss_species
-!    nspec_emis_inp=emt_att%nspec
-
-!
-!-- Check the emission LOD: 0 (PARAMETERIZED), 1 (DEFAULT), 2 (PRE-PROCESSED)
-    SELECT CASE (emiss_lod)
-
-!
-!--    LOD 0 (PARAMETERIZED mode)
-       CASE (0)
-
-          len_index = 0
-!
-!--       Number of species and number of matched species can be different but call is only made if
-!--       both are greater than zero.
-          IF  ( nvar > 0  .AND.  nspec_emis_inp > 0 )  THEN
-
-!
-!--          Cycle over model species
-             DO  ind_mod = 1, nvar
-                ind_inp = 1
-                DO  WHILE ( TRIM( surface_csflux_name(ind_inp) ) /= 'novalue' )    !< 'novalue' is the default
-                   IF  ( TRIM( surface_csflux_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) )  THEN
-                      len_index = len_index + 1
-                   ENDIF
-                   ind_inp = ind_inp + 1
-                ENDDO
-             ENDDO
-
-             IF  ( len_index > 0 )  THEN
-
-!
-!--             Allocation of Arrays of the matched species
-                ALLOCATE ( match_spec_input(len_index) )
-                ALLOCATE ( match_spec_model(len_index) )
-
-!
-!--             Pass species indices to declared arrays
-                len_index = 0
-
-                DO  ind_mod = 1, nvar
-                   ind_inp = 1
-                   DO  WHILE  ( TRIM( surface_csflux_name(ind_inp) ) /= 'novalue' )
-                      IF  ( TRIM( surface_csflux_name(ind_inp) ) == TRIM(spc_names(ind_mod) ) )    &
-                      THEN
-                         len_index = len_index + 1
-                         match_spec_input(len_index) = ind_inp
-                         match_spec_model(len_index) = ind_mod
-                      ENDIF
-                   ind_inp = ind_inp + 1
-                   END DO
-                END DO
-
-!
-!--             Check
-                DO  ispec = 1, len_index
-
-                   IF  ( emiss_factor_main(match_spec_input(ispec) ) < 0    .AND.                  &
-                         emiss_factor_side(match_spec_input(ispec) ) < 0 )  THEN
-
-                      message_string = 'PARAMETERIZED emissions mode selected:'             //     &
-                                       ' EMISSIONS POSSIBLE ONLY ON STREET SURFACES'        //     &
-                                       ' but values of scaling factors for street types'    //     &
-                                       ' emiss_factor_main AND emiss_factor_side'           //     &
-                                       ' not provided for each of the emissions species'    //     &
-                                       ' or not provided at all: PLEASE set a finite value' //     &
-                                       ' for these parameters in the chemistry namelist'
-                      CALL message( 'chem_emissions_matching', 'CM0442', 2, 2, 0, 6, 0 )
-
-                   ENDIF
-
-                END DO
-
-
-             ELSE
-
-                message_string = 'Non of given Emission Species'           //                      &
-                                 ' matches'                                //                      &
-                                 ' model chemical species'                 //                      &
-                                 ' Emission routine is not called'
-                CALL message( 'chem_emissions_matching', 'CM0443', 0, 0, 0, 6, 0 )
-
-             ENDIF
-
-          ELSE
-
-             message_string = 'Array of Emission species not allocated: '             //           &
-                              ' Either no emission species are provided as input or'  //           &
-                              ' no chemical species are used by PALM.'                //           &
-                              ' Emission routine is not called'
-             CALL message( 'chem_emissions_matching', 'CM0444', 0, 2, 0, 6, 0 )
-
-          ENDIF
-
-!
-!--    LOD 1 (DEFAULT mode)
-       CASE (1)
-
-          len_index = 0          ! total number of species (to be accumulated)
-          len_index_voc = 0      ! total number of VOCs (to be accumulated)
-          len_index_pm = 3       ! total number of PMs: PM1, PM2.5, PM10.
-
-!
-!--       Number of model species and input species could be different but process this only when both are
-!--       non-zero
-          IF  ( nvar > 0  .AND.  nspec_emis_inp > 0 )  THEN
-
-!
-!--          Cycle over model species
-             DO  ind_mod = 1, nvar
-
-!
-!--             Cycle over input species
-                DO  ind_inp = 1, nspec_emis_inp
-
-!
-!--                Check for VOC Species
-                   IF  ( TRIM( emt_att%species_name(ind_inp) ) == "VOC" )  THEN
-                      DO  ind_voc= 1, emt_att%nvoc
-
-                         IF  ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) )   &
-                         THEN
-                            len_index = len_index + 1
-                            len_index_voc = len_index_voc + 1
-                         ENDIF
-
-                      END DO
-                   ENDIF
-
-!
-!-- PMs: There is one input species name for all PM. This variable has 3 dimensions, one for PM1,
-!--      PM2.5 and PM10
-                   IF  ( TRIM( emt_att%species_name(ind_inp) ) == "PM" )  THEN
-
-                      IF      ( TRIM( spc_names(ind_mod) ) == "PM1" )   THEN
-                         len_index = len_index + 1
-                      ELSEIF  ( TRIM( spc_names(ind_mod) ) == "PM25" )  THEN
-                         len_index = len_index + 1
-                      ELSEIF  ( TRIM( spc_names(ind_mod) ) == "PM10" )  THEN
-                         len_index = len_index + 1
-                      ENDIF
-
-                   ENDIF
-
-!
-!--                NOX: NO2 and NO
-                   IF  ( TRIM( emt_att%species_name(ind_inp) ) == "NOX" )  THEN
-
-                      IF     ( TRIM( spc_names(ind_mod) ) == "NO"  )  THEN
-                         len_index = len_index + 1
-                      ELSEIF  ( TRIM( spc_names(ind_mod) ) == "NO2" )  THEN
-                         len_index = len_index + 1
-                      ENDIF
-
-                   ENDIF
-
-!
-!--                SOX: SO2 and SO4
-                   IF  ( TRIM( emt_att%species_name(ind_inp) ) == "SOX" )  THEN
-
-                      IF      ( TRIM( spc_names(ind_mod) ) == "SO2" )  THEN
-                         len_index = len_index + 1
-                      ELSEIF  ( TRIM( spc_names(ind_mod) ) == "SO4" )  THEN
-                         len_index = len_index + 1
-                      ENDIF
-
-                   ENDIF
-
-!
-!--                Other Species
-                   IF  ( TRIM( emt_att%species_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) )  THEN
-                      len_index = len_index + 1
-                   ENDIF
-
-                END DO  ! ind_inp ...
-
-             END DO  ! ind_mod ...
-
-
-!
-!--          Allocate arrays
-             IF  ( len_index > 0 )  THEN
-
-                ALLOCATE ( match_spec_input(len_index) )
-                ALLOCATE ( match_spec_model(len_index) )
-
-                IF  ( len_index_voc > 0 )  THEN
-!
-!--                Contains indices of the VOC model species
-                   ALLOCATE( match_spec_voc_model(len_index_voc) )
-!
-!--                Contains the indices of different values of VOC composition of input variable
-!--                VOC_composition
-                   ALLOCATE( match_spec_voc_input(len_index_voc) )
-
-                ENDIF
-
-!
-!--             Pass the species indices to declared arrays
-                len_index = 0
-                len_index_voc = 0
-
-                DO  ind_mod = 1, nvar
-                   DO  ind_inp = 1, nspec_emis_inp
-
-!
-!--                   VOCs
-                      IF  ( TRIM( emt_att%species_name(ind_inp) ) == "VOC"  .AND.                  &
-                            ALLOCATED( match_spec_voc_input ) )  THEN
-
-                         DO  ind_voc = 1, emt_att%nvoc
-
-                            IF  ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) )&
-                            THEN
-
-                               len_index     = len_index + 1
-                               len_index_voc = len_index_voc + 1
-
-                               match_spec_input(len_index) = ind_inp
-                               match_spec_model(len_index) = ind_mod
-
-                               match_spec_voc_input(len_index_voc) = ind_voc
-                               match_spec_voc_model(len_index_voc) = ind_mod
-
-                            ENDIF
-
-                         END DO
-
-                      ENDIF
-
-!
-!--                   PMs
-                      IF  ( TRIM( emt_att%species_name(ind_inp) ) == "PM" )  THEN
-
-                         IF      ( TRIM( spc_names(ind_mod) ) == "PM1"  )  THEN
-                            len_index = len_index + 1
-                            match_spec_input(len_index) = ind_inp
-                            match_spec_model(len_index) = ind_mod
-                         ELSEIF  ( TRIM( spc_names(ind_mod) ) == "PM25" )  THEN
-                            len_index = len_index + 1
-                            match_spec_input(len_index) = ind_inp
-                            match_spec_model(len_index) = ind_mod
-                         ELSEIF  ( TRIM( spc_names(ind_mod) ) == "PM10" )  THEN
-                            len_index = len_index + 1
-                            match_spec_input(len_index) = ind_inp
-                            match_spec_model(len_index) = ind_mod
-                         ENDIF
-
-                      ENDIF
-
-!
-!--                   NOX
-                      IF  ( TRIM( emt_att%species_name(ind_inp) ) == "NOX" )  THEN
-
-                         IF      ( TRIM( spc_names(ind_mod) ) == "NO"  )  THEN
-                            len_index = len_index + 1
-
-                            match_spec_input(len_index) = ind_inp
-                            match_spec_model(len_index) = ind_mod
-
-                         ELSEIF  ( TRIM( spc_names(ind_mod) ) == "NO2" )  THEN
-                            len_index = len_index + 1
-
-                            match_spec_input(len_index) = ind_inp
-                            match_spec_model(len_index) = ind_mod
-
-                         ENDIF
-
-                      ENDIF
-
-
-!
-!--                   SOX
-                      IF  ( TRIM( emt_att%species_name(ind_inp) ) == "SOX" ) THEN
-
-                         IF  ( TRIM( spc_names(ind_mod) ) == "SO2" )  THEN
-                            len_index = len_index + 1
-                            match_spec_input(len_index) = ind_inp
-                            match_spec_model(len_index) = ind_mod
-                         ELSEIF  ( TRIM( spc_names(ind_mod) ) == "SO4" )  THEN
-                            len_index = len_index + 1
-                            match_spec_input(len_index) = ind_inp
-                            match_spec_model(len_index) = ind_mod
-                         ENDIF
-
-                      ENDIF
-
-!
-!--                   Other Species
-                      IF  ( TRIM( emt_att%species_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) )  &
-                      THEN
-                         len_index = len_index + 1
-                         match_spec_input(len_index) = ind_inp
-                         match_spec_model(len_index) = ind_mod
-                      ENDIF
-
-                   END DO  ! inp_ind
-
-                END DO     ! inp_mod
-
-!
-!--          Error reporting (no matching)
-             ELSE
-
-                message_string = 'None of given Emission Species matches'           //             &
-                                 ' model chemical species'                          //             &
-                                 ' Emission routine is not called'
-                CALL message( 'chem_emissions_matching', 'CM0440', 0, 0, 0, 6, 0 )
-
-             ENDIF
-
-!
-!--       Error reporting (no species)
-          ELSE
-
-             message_string = 'Array of Emission species not allocated: '             //           &
-                              ' Either no emission species are provided as input or'  //           &
-                              ' no chemical species are used by PALM:'                //           &
-                              ' Emission routine is not called'
-             CALL message( 'chem_emissions_matching', 'CM0441', 0, 2, 0, 6, 0 )
-
-          ENDIF
-
-!
-!--    LOD 2 (PRE-PROCESSED mode)
-       CASE (2)
-
-          len_index = 0
-          len_index_voc = 0
-
-          IF  ( nvar > 0  .AND.  nspec_emis_inp > 0 )  THEN
-!
-!--          Cycle over model species
-             DO  ind_mod = 1, nvar
-
-!
-!--             Cycle over input species
-                DO  ind_inp = 1, nspec_emis_inp
-
-!
-!--                Check for VOC Species
-                   IF  ( TRIM( emt_att%species_name(ind_inp) ) == "VOC" )  THEN
-                      DO  ind_voc = 1, emt_att%nvoc
-                         IF  ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) )   &
-                         THEN
-                            len_index     = len_index + 1
-                            len_index_voc = len_index_voc + 1
-                         ENDIF
-                      END DO
-                   ENDIF
-
-!
-!--                Other Species
-                   IF  ( TRIM( emt_att%species_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) )  THEN
-                      len_index = len_index + 1
-                   ENDIF
-                ENDDO
-             ENDDO
-
-!
-!--          Allocate array for storing the indices of the matched species
-             IF  ( len_index > 0 )  THEN
-
-                ALLOCATE ( match_spec_input(len_index) )
-
-                ALLOCATE ( match_spec_model(len_index) )
-
-                IF  ( len_index_voc > 0 )  THEN
-!
-!--                Contains indices of the VOC model species
-                   ALLOCATE( match_spec_voc_model(len_index_voc) )
-!
-!--                Contains the indices of different values of VOC composition of input variable
-!--                VOC_composition
-                   ALLOCATE( match_spec_voc_input(len_index_voc) )
-
-                ENDIF
-
-!
-!--             Pass the species indices to declared arrays
-                len_index = 0
-
-!
-!--             Cycle over model species
-                DO  ind_mod = 1, nvar
-
-!
-!--                Cycle over Input species
-                   DO  ind_inp = 1, nspec_emis_inp
-
-!
-!--                   VOCs
-                      IF  ( TRIM( emt_att%species_name(ind_inp) ) == "VOC"  .AND.                  &
-                            ALLOCATED( match_spec_voc_input ) )  THEN
-
-                         DO  ind_voc= 1, emt_att%nvoc
-                            IF  ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) )&
-                            THEN
-                               len_index = len_index + 1
-                               len_index_voc = len_index_voc + 1
-
-                               match_spec_input(len_index) = ind_inp
-                               match_spec_model(len_index) = ind_mod
-
-                               match_spec_voc_input(len_index_voc) = ind_voc
-                               match_spec_voc_model(len_index_voc) = ind_mod
-                            ENDIF
-                         END DO
-                      ENDIF
-
-!
-!--                   Other Species
-                      IF  ( TRIM( emt_att%species_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) )  &
-                      THEN
-                         len_index = len_index + 1
-                         match_spec_input(len_index) = ind_inp
-                         match_spec_model(len_index) = ind_mod
-                      ENDIF
-
-                   END DO  ! ind_inp
-                END DO     ! ind_mod
-
-             ELSE  ! if len_index_voc <= 0
-
-!
-!--             In case there are no species matching (just informational message)
-                message_string = 'Non of given emission species'            //                     &
-                                 ' matches'                                //                      &
-                                 ' model chemical species:'                //                      &
-                                 ' Emission routine is not called'
-                CALL message( 'chem_emissions_matching', 'CM0438', 0, 0, 0, 6, 0 )
-             ENDIF
-
-!
-!--       Error check (no matching)
-          ELSE
-
-!
-!--          Either spc_names is zero or nspec_emis_inp is not allocated
-             message_string = 'Array of Emission species not allocated:'              //           &
-                              ' Either no emission species are provided as input or'  //           &
-                              ' no chemical species are used by PALM:'                //           &
-                              ' Emission routine is not called'
-             CALL message( 'chem_emissions_matching', 'CM0439', 0, 2, 0, 6, 0 )
-
-          ENDIF
-
-!
-!-- If emission module is switched on but mode_emis is not specified or it is given the wrong name
-
-!
-!--    Error check (no species)
-       CASE DEFAULT
-
-          message_string = 'Emission Module switched ON, but'                           //         &
-                           ' either no emission mode specified or incorrectly given :'  //         &
-                           ' please, pass the correct value to the namelist parameter "mode_emis"'
-          CALL message( 'chem_emissions_matching', 'CM0445', 2, 2, 0, 6, 0 )
-
-       END SELECT
-
-       IF  ( debug_output )  CALL debug_message( 'chem_emissions_match', 'end' )
-
- END SUBROUTINE chem_emissions_match
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization:
-!> Netcdf reading, arrays allocation and first calculation of cssws fluxes at timestep 0
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE chem_emissions_init
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  chem_emis, chem_emis_att
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: ispec                        !< running index
-
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_init', 'start' )
-
-!
-!-- Matching
-    CALL  chem_emissions_match( chem_emis_att, n_matched_vars )
-
-    IF  ( n_matched_vars == 0 )  THEN
-
-       emission_output_required = .FALSE.
-
-    ELSE
-
-       emission_output_required = .TRUE.
-
-
-!
-!--    Set molecule masses  (in kg/mol)
-       ALLOCATE( chem_emis_att%xm(n_matched_vars) )
-
-       DO  ispec = 1, n_matched_vars
-          SELECT CASE ( TRIM( spc_names(match_spec_model(ispec)) ) )
-             CASE ( 'SO2'  );  chem_emis_att%xm(ispec) = xm_S + xm_O * 2
-             CASE ( 'SO4'  );  chem_emis_att%xm(ispec) = xm_S + xm_O * 4
-             CASE ( 'NO'   );  chem_emis_att%xm(ispec) = xm_N + xm_O
-             CASE ( 'NO2'  );  chem_emis_att%xm(ispec) = xm_N + xm_O * 2
-             CASE ( 'NH3'  );  chem_emis_att%xm(ispec) = xm_N + xm_H * 3
-             CASE ( 'CO'   );  chem_emis_att%xm(ispec) = xm_C + xm_O
-             CASE ( 'CO2'  );  chem_emis_att%xm(ispec) = xm_C + xm_O * 2
-             CASE ( 'CH4'  );  chem_emis_att%xm(ispec) = xm_C + xm_H * 4
-             CASE ( 'HNO3' );  chem_emis_att%xm(ispec) = xm_H + xm_N + xm_O*3
-             CASE DEFAULT
-                chem_emis_att%xm(ispec) = 1.0_wp
-          END SELECT
-       ENDDO
-
-
-!
-!-- Get emissions for the first time step base on LOD (if defined) or emission mode
-!-- (if no LOD defined)
-
-!
-!-- NOTE - I could use a combined if ( lod = xxx .or. mode = 'XXX' ) type of decision structure but
-!          I think it is much better to implement it this way (i.e., conditional on lod if it is
-!          defined, and mode if not) as we can easily take out the case structure for mode_emis
-!          later on.
-
-       IF   ( emiss_lod < 0 )  THEN  !-- no LOD defined (not likely)
-
-          SELECT CASE ( TRIM( mode_emis ) )
-
-             CASE ( 'PARAMETERIZED' )     ! LOD 0
-
-                IF  ( .NOT. ALLOCATED( emis_distribution) )  THEN
-                   ALLOCATE( emis_distribution(1,nys:nyn,nxl:nxr,n_matched_vars) )
-                ENDIF
-
-                CALL chem_emissions_setup( chem_emis_att, chem_emis, n_matched_vars)
-
-             CASE ( 'DEFAULT' )           ! LOD 1
-
-                IF  ( .NOT. ALLOCATED( emis_distribution) )  THEN
-                   ALLOCATE( emis_distribution(1,nys:nyn,nxl:nxr,n_matched_vars) )
-                ENDIF
-
-                CALL chem_emissions_setup( chem_emis_att, chem_emis, n_matched_vars )
-
-             CASE ( 'PRE-PROCESSED' )     ! LOD 2
-
-                IF  ( .NOT. ALLOCATED( emis_distribution) )  THEN
-!
-!--                Note, at the moment emissions are considered only by surface fluxes rather than
-!--                by volume sources. Therefore, no vertical dimension is required and is thus
-!--                allocated with 1. Later when volume sources are considered, the vertical
-!--                dimension will increase.
-                   !ALLOCATE( emis_distribution(nzb:nzt+1,nys:nyn,nxl:nxr,n_matched_vars) )
-                   ALLOCATE( emis_distribution(1,nys:nyn,nxl:nxr,n_matched_vars) )
-                ENDIF
-
-                CALL chem_emissions_setup( chem_emis_att, chem_emis, n_matched_vars )
-
-          END SELECT
-
-       ELSE  ! if LOD is defined
-
-          SELECT CASE ( emiss_lod )
-
-             CASE ( 0 )     ! parameterized mode
-
-                IF  ( .NOT. ALLOCATED( emis_distribution) )  THEN
-                   ALLOCATE( emis_distribution(1,nys:nyn,nxl:nxr,n_matched_vars) )
-                ENDIF
-
-                CALL chem_emissions_setup( chem_emis_att, chem_emis, n_matched_vars)
-
-             CASE ( 1 )     ! default mode
-
-                IF  ( .NOT. ALLOCATED( emis_distribution) )  THEN
-                   ALLOCATE( emis_distribution(1,nys:nyn,nxl:nxr,n_matched_vars) )
-                ENDIF
-
-                CALL chem_emissions_setup( chem_emis_att, chem_emis, n_matched_vars )
-
-             CASE ( 2 )     ! pre-processed mode
-
-                IF  ( .NOT. ALLOCATED( emis_distribution) )  THEN
-                   ALLOCATE( emis_distribution(nzb:nzt+1,nys:nyn,nxl:nxr,n_matched_vars) )
-                ENDIF
-
-                CALL chem_emissions_setup( chem_emis_att, chem_emis, n_matched_vars )
-
-          END SELECT
-
-       ENDIF
-
-!
-! --   Initialize
-       emis_distribution = 0.0_wp
-
-    ENDIF
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_init', 'end' )
-
- END SUBROUTINE chem_emissions_init
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Routine for Update of Emission values at each timestep.
-!>
-!> @todo Clarify the correct usage of index_dd, index_hh and index_mm. Consider renaming of these
-!>       variables.
-!> @todo Clarify time used in emis_lod=2 mode. ATM, the used time seems strange.
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE chem_emissions_setup( emt_att, emt, n_matched_vars )
-
-   USE surface_mod,                                                                                &
-       ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
-
-   USE netcdf_data_input_mod,                                                                      &
-       ONLY:  street_type_f
-
-   USE arrays_3d,                                                                                  &
-       ONLY: hyp, pt
-
-    USE control_parameters,                                                                        &
-        ONLY: time_since_reference_point
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_day
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  day_of_month                          !< day of the month
-    INTEGER(iwp) ::  day_of_week                           !< day of the week
-    INTEGER(iwp) ::  day_of_year                           !< day of the year
-    INTEGER(iwp) ::  days_since_reference_point            !< days since reference point
-    INTEGER(iwp) ::  i                                     !< running index for grid in x-direction
-    INTEGER(iwp) ::  i_pm_comp                             !< index for number of PM components
-    INTEGER(iwp) ::  icat                                  !< Index for number of categories
-    INTEGER(iwp) ::  index_dd                              !< index day
-    INTEGER(iwp) ::  index_hh                              !< index hour
-    INTEGER(iwp) ::  index_mm                              !< index month
-    INTEGER(iwp) ::  ispec                                 !< index for number of species
-    INTEGER(iwp) ::  ivoc                                  !< Index for number of VOCs
-    INTEGER(iwp) ::  hour_of_day                           !< hour of the day
-    INTEGER(iwp) ::  j                                     !< running index for grid in y-direction
-    INTEGER(iwp) ::  k                                     !< running index for grid in z-direction
-    INTEGER(iwp) ::  m                                     !< running index for horizontal surfaces
-    INTEGER(iwp) ::  month_of_year                         !< month of the year
-
-    INTEGER,INTENT(IN) ::  n_matched_vars                  !< Output of matching routine with number
-                                                           !< of matched species
-
-    REAL(wp) ::  time_utc_init                             !< second of day of initial date
-
-    TYPE(chem_emis_att_type), INTENT(INOUT) ::  emt_att    !< variable to store emission information
-
-    TYPE(chem_emis_val_type), INTENT(INOUT), ALLOCATABLE, DIMENSION(:) ::  emt  !< variable to store emission input values,
-                                                                                !< depending on the considered species
-!
-!-- CONVERSION FACTORS: TIME
-    REAL(wp), PARAMETER ::  hour_per_year =  8760.0_wp                         !< number of hours in a year of 365 days
-    REAL(wp), PARAMETER ::  s_per_hour    =  3600.0_wp                         !< number of sec per hour (s)/(hour)
-    REAL(wp), PARAMETER ::  s_per_day     = 86400.0_wp                         !< number of sec per day (s)/(day)
-
-    REAL(wp), PARAMETER ::  day_to_s      = 1.0_wp/s_per_day                   !< conversion day   -> sec
-    REAL(wp), PARAMETER ::  hour_to_s     = 1.0_wp/s_per_hour                  !< conversion hours -> sec
-    REAL(wp), PARAMETER ::  year_to_s     = 1.0_wp/(s_per_hour*hour_per_year)  !< conversion year  -> sec
-
-
-!
-!-- CONVERSION FACTORS: MASS
-    REAL(wp), PARAMETER ::  g_to_kg       = 1.0E-03_wp     !< Conversion from g to kg (kg/g)
-    REAL(wp), PARAMETER ::  miug_to_kg    = 1.0E-09_wp     !< Conversion from g to kg (kg/g)
-    REAL(wp), PARAMETER ::  tons_to_kg    = 100.0_wp       !< Conversion from tons to kg (kg/tons)
-!
-!-- CONVERSION FACTORS: PPM
-    REAL(wp), PARAMETER ::  ratio2ppm     = 1.0E+06_wp
-
-    REAL(wp), DIMENSION(24)                        ::  par_emis_time_factor    !< time factors for the parameterized mode:
-                                                                               !< fixed houlry profile for example day
-    REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  conv_to_ratio           !< factor used for converting input
-                                                                               !< to concentration ratio
-    REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  tmp_temp                !< temporary variable for abs. temperature
-
-    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  time_factor  !< factor for time scaling of emissions
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  delta_emis   !< incremental emission factor
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  emis         !< emission factor
-
-
-    IF  ( emission_output_required )  THEN
-
-!
-!-- Set emis_dt to be used - since chemistry ODEs can be stiff, the option to solve them at every
-!-- RK substep is present to help improve stability should the need arises
-
-       IF  ( call_chem_at_all_substeps )  THEN
-
-          dt_emis = dt_3d * weight_pres(intermediate_timestep_count)
-
-       ELSE
-
-          dt_emis = dt_3d
-
-       ENDIF
-
- !
- !--    Conversion of units to the ones employed in PALM
- !--    In PARAMETERIZED mode no conversion is performed: in this case input units are fixed
-        IF  ( TRIM( mode_emis ) == "DEFAULT"  .OR.  TRIM( mode_emis ) == "PRE-PROCESSED" )  THEN
-
-          SELECT CASE ( TRIM( emt_att%units ) )
-
-             CASE ( 'kg/m2/s', 'KG/M2/S'    );     conversion_factor = 1.0_wp                   ! kg
-             CASE ( 'kg/m2/hour', 'KG/M2/HOUR' );  conversion_factor = hour_to_s
-             CASE ( 'kg/m2/day', 'KG/M2/DAY'  );   conversion_factor = day_to_s
-             CASE ( 'kg/m2/year', 'KG/M2/YEAR' );  conversion_factor = year_to_s
-
-             CASE ( 'ton/m2/s', 'TON/M2/S'    );     conversion_factor = tons_to_kg             ! tonnes
-             CASE ( 'ton/m2/hour', 'TON/M2/HOUR' );  conversion_factor = tons_to_kg*hour_to_s
-             CASE ( 'ton/m2/year', 'TON/M2/YEAR' );  conversion_factor = tons_to_kg*year_to_s
-
-             CASE ( 'g/m2/s', 'G/M2/S'    );     conversion_factor = g_to_kg                    ! grams
-             CASE ( 'g/m2/hour', 'G/M2/HOUR' );  conversion_factor = g_to_kg*hour_to_s
-             CASE ( 'g/m2/year', 'G/M2/YEAR' );  conversion_factor = g_to_kg*year_to_s
-
-             CASE ( 'micrograms/m2/s', 'MICROGRAMS/M2/S'    );     conversion_factor = miug_to_kg            ! ug
-             CASE ( 'micrograms/m2/hour', 'MICROGRAMS/M2/HOUR' );  conversion_factor = miug_to_kg*hour_to_s
-             CASE ( 'micrograms/m2/year', 'MICROGRAMS/M2/YEAR' );  conversion_factor = miug_to_kg*year_to_s
-
-!
-!--          Error check (need units)
-             CASE DEFAULT
-                message_string = 'The Units of the provided emission input'                 //     &
-                                 ' are not the ones required by PALM-4U: please check '     //     &
-                                 ' emission module documentation.'
-                CALL message( 'chem_emissions_setup', 'CM0446', 2, 2, 0, 6, 0 )
-
-          END SELECT
-
-       ENDIF
-
-!
-!--    Conversion factor to convert  kg/m**2/s to ppm/s
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-
-!
-!--          Derive Temperature from Potential Temperature
-             tmp_temp(nzb:nzt+1,j,i) = pt(nzb:nzt+1,j,i) * ( hyp(nzb:nzt+1) / p_0 )**rd_d_cp
-
-!
-!--          We need to pass to cssws <- (ppm/s) * dz
-!--          Input is Nmole/(m^2*s)
-!--          To go to ppm*dz multiply the input by (m**2/N)*dz
-!--          (m**2/N)*dz == V/N
-!--          V/N = RT/P
-             conv_to_ratio(nzb:nzt+1,j,i) =  rgas_univ *                            &  ! J K-1 mol-1
-                                             tmp_temp(nzb:nzt+1,j,i) /              &  ! K
-                                             hyp(nzb:nzt+1)                            ! Pa
-
-          ENDDO
-       ENDDO
-
-
-!
-!-- LOD 2 (PRE-PROCESSED MODE)
-
-       IF  ( emiss_lod == 2 )  THEN
-
-!
-!--       Update time indices
-          CALL get_date_time( 0.0_wp, second_of_day=time_utc_init )
-          CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), hour=hour_of_day )
-
-          days_since_reference_point = INT( FLOOR( ( time_utc_init +                               &
-                                                     MAX( 0.0_wp, time_since_reference_point ) )   &
-                                            / seconds_per_day ) )
-
-          index_hh = days_since_reference_point * hours_per_day + hour_of_day
-
-!
-!--     LOD 1 (DEFAULT MODE)
-        ELSEIF  ( emiss_lod == 1 )  THEN
-
-!
-!--       Allocate array where to store temporary emission values
-          IF  ( .NOT. ALLOCATED(emis) ) ALLOCATE( emis(nys:nyn,nxl:nxr) )
-
-!
-!--       Allocate time factor per category
-          ALLOCATE( time_factor(emt_att%ncat) )
-
-!
-!--       Read-in hourly emission time factor
-          IF  ( TRIM( time_fac_type ) == "HOUR" )  THEN
-
-!
-!--          Update time indices
-             CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ),                        &
-                                 day_of_year=day_of_year, hour=hour_of_day )
-             index_hh = ( day_of_year - 1_iwp ) * hour_of_day
-
-!
-!--          Check if the index is less or equal to the temporal dimension of HOURLY emission files
-             IF  ( index_hh <= SIZE( emt_att%hourly_emis_time_factor(1,:) ) )  THEN
-
-!
-!--             Read-in the correspondant time factor
-                time_factor(:) = emt_att%hourly_emis_time_factor(:,index_hh+1)
-
-!
-!--          Error check (time out of range)
-             ELSE
-
-                message_string = 'The "HOUR" time-factors in the DEFAULT mode '           //       &
-                                 ' are not provided for each hour of the total simulation time'
-                CALL message( 'chem_emissions_setup', 'CM0448', 2, 2, 0, 6, 0 )
-
-             ENDIF
-
-!
-!--       Read-in MDH emissions time factors
-          ELSEIF  ( TRIM( time_fac_type ) == "MDH" )  THEN
-
-!
-!--          Update time indices
-             CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ),                        &
-                                 month       = month_of_year,                                      &
-                                 day         = day_of_month,                                       &
-                                 hour        = hour_of_day,                                        &
-                                 day_of_week = day_of_week                                         &
-                               )
-             index_mm = month_of_year
-             index_dd = months_per_year + day_of_week
-             SELECT CASE( TRIM( daytype_mdh ) )
-
-                CASE ("workday")
-                   index_hh = months_per_year + days_per_week + hour_of_day
-
-                CASE ("weekend")
-                   index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
-
-                CASE ("holiday")
-                   index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
-
-             END SELECT
-
-!
-!--          Check if the index is less or equal to the temporal dimension of MDH emission files
-             IF  ( ( index_hh + index_dd + index_mm) <= SIZE( emt_att%mdh_emis_time_factor(1,:) ) )&
-             THEN
-!
-!--             Read in corresponding time factor
-                time_factor(:) = emt_att%mdh_emis_time_factor(:,index_mm) *                        &
-                                 emt_att%mdh_emis_time_factor(:,index_dd) *                        &
-                                 emt_att%mdh_emis_time_factor(:,index_hh+1)
-
-!
-!--          Error check (MDH time factor not provided)
-             ELSE
-
-                message_string = 'The "MDH" time-factors in the DEFAULT mode '           //        &
-                           ' are not provided for each hour/day/month  of the total simulation time'
-                CALL message( 'chem_emissions_setup', 'CM0449', 2, 2, 0, 6, 0 )
-
-             ENDIF
-
-!
-!--       Error check (no time factor defined)
-          ELSE
-
-             message_string = 'In the DEFAULT mode the time factor'           //                   &
-                              ' has to be defined in the NAMELIST'
-             CALL message( 'chem_emissions_setup', 'CM0450', 2, 2, 0, 6, 0 )
-
-          ENDIF
-
-!
-!--    PARAMETERIZED MODE
-       ELSEIF ( emiss_lod == 0 )  THEN
-
-
-!
-!--       Assign constant values of time factors, diurnal profile for traffic sector
-          par_emis_time_factor(:) =    (/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039,                &
-                                          0.056, 0.053, 0.051, 0.051, 0.052, 0.055,                &
-                                          0.059, 0.061, 0.064, 0.067, 0.069, 0.069,                &
-                                          0.049, 0.039, 0.039, 0.029, 0.024, 0.019 /)
-
-          IF  ( .NOT. ALLOCATED( time_factor ) )  ALLOCATE( time_factor(1) )
-
-!
-!--       Get time-factor for specific hour
-          CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), hour = hour_of_day )
-
-          index_hh = hour_of_day
-          time_factor(1) = par_emis_time_factor(index_hh+1)
-
-       ENDIF  ! emiss_lod
-
-
-!
-!--  Emission distribution calculation
-
-       IF  ( emiss_lod == 0 )  THEN
-
-          DO  ispec = 1, n_matched_vars
-
-!
-!-- Units are micromoles/m**2*day (or kilograms/m**2*day for PMs)
-             emis_distribution(1,nys:nyn,nxl:nxr,ispec) = surface_csflux( match_spec_input(ispec) )&
-                                                          * time_factor(1) * hour_to_s
-
-          ENDDO
-
-
-!
-!--    LOD 1 (DEFAULT mode)
-       ELSEIF  ( emiss_lod == 1 )  THEN
-
-!
-!--       Allocate array for the emission value corresponding to a specific category and time factor
-          ALLOCATE (delta_emis(nys:nyn,nxl:nxr))
-
-!
-!--       Cycle over categories
-          DO  icat = 1, emt_att%ncat
-
-!
-!--          Cycle over Species: n_matched_vars represents the number of species in common between
-!--                              the emission input data and the chemistry mechanism used
-             DO  ispec = 1, n_matched_vars
-
-                emis(nys:nyn,nxl:nxr) = emt( match_spec_input(ispec) )%                            &
-                                        default_emission_data(icat,nys+1:nyn+1,nxl+1:nxr+1)
-
-!
-!--             NO
-                IF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "NO" )  THEN
-
-                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) *         &         ! kg/m2/s
-                                                 time_factor(icat) *                               &
-                                                 emt_att%nox_comp(icat,1) *                        &
-                                                 conversion_factor * hours_per_day
-
-                   emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                                    &
-                                                         emis_distribution(1,nys:nyn,nxl:nxr,ispec)&
-                                                         + delta_emis(nys:nyn,nxl:nxr)
-!
-!--             NO2
-                ELSEIF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "NO2" )  THEN
-
-                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) *         &         ! kg/m2/s
-                                                 time_factor(icat) *                               &
-                                                 emt_att%nox_comp(icat,2) *                        &
-                                                 conversion_factor * hours_per_day
-
-                   emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                                    &
-                                                        emis_distribution(1,nys:nyn,nxl:nxr,ispec) &
-                                                        + delta_emis(nys:nyn,nxl:nxr)
-
-!
-!--             SO2
-                ELSEIF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "SO2" )  THEN
-
-                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) *         &         ! kg/m2/s
-                                                 time_factor(icat) *                               &
-                                                 emt_att%sox_comp(icat,1) *                        &
-                                                 conversion_factor * hours_per_day
-
-                   emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                                    &
-                                                        emis_distribution(1,nys:nyn,nxl:nxr,ispec) &
-                                                        + delta_emis(nys:nyn,nxl:nxr)
-
-!
-!--             SO4
-                ELSEIF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "SO4" )  THEN
-
-
-                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) *         &         ! kg/m2/s
-                                                 time_factor(icat) *                               &
-                                                 emt_att%sox_comp(icat,2) *                        &
-                                                 conversion_factor * hours_per_day
-
-                   emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                                    &
-                                                        emis_distribution(1,nys:nyn,nxl:nxr,ispec) &
-                                                        + delta_emis(nys:nyn,nxl:nxr)
-
-
-!
-!--             PM1
-                ELSEIF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1" )  THEN
-
-                   DO  i_pm_comp = 1, SIZE( emt_att%pm_comp(1,:,1) )   ! cycle through components
-
-                      delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) *          &     ! kg/m2/s
-                                                    time_factor(icat) *                            &
-                                                    emt_att%pm_comp(icat,i_pm_comp,1) *            &
-                                                    conversion_factor * hours_per_day
-
-                      emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                                 &
-                                                        emis_distribution(1,nys:nyn,nxl:nxr,ispec) &
-                                                        + delta_emis(nys:nyn,nxl:nxr)
-
-                   ENDDO
-
-!
-!--             PM2.5
-                ELSEIF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25" )  THEN
-
-                   DO  i_pm_comp = 1, SIZE( emt_att%pm_comp(1,:,2) )   ! cycle through components
-
-                      delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) *          &     ! kg/m2/s
-                                                    time_factor(icat) *                            &
-                                                    emt_att%pm_comp(icat,i_pm_comp,2) *            &
-                                                    conversion_factor * hours_per_day
-
-                      emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                                 &
-                                                        emis_distribution(1,nys:nyn,nxl:nxr,ispec) &
-                                                        + delta_emis(nys:nyn,nxl:nxr)
-
-                   ENDDO
-
-!
-!--             PM10
-                ELSEIF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" )  THEN
-
-                   DO  i_pm_comp = 1, SIZE( emt_att%pm_comp(1,:,3) )   ! cycle through components
-
-                      delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) *          &     ! kg/m2/s
-                                                    time_factor(icat)     *                        &
-                                                    emt_att%pm_comp(icat,i_pm_comp,3) *            &
-                                                    conversion_factor * hours_per_day
-
-                      emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                                 &
-                                                        emis_distribution(1,nys:nyn,nxl:nxr,ispec) &
-                                                        + delta_emis(nys:nyn,nxl:nxr)
-
-                   ENDDO
-
-!
-!--             VOCs
-                ELSEIF  ( SIZE( match_spec_voc_input ) > 0 )  THEN
-
-                   DO  ivoc = 1, SIZE( match_spec_voc_input )          ! cycle through components
-
-                      IF  ( TRIM( spc_names(match_spec_model(ispec) ) ) ==                         &
-                            TRIM( emt_att%voc_name(ivoc) ) )  THEN
-
-                         delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) *                     &
-                                                       time_factor(icat) *                         &
-                                                       emt_att%voc_comp(icat,match_spec_voc_input(ivoc)) * &
-                                                       conversion_factor * hours_per_day
-
-                         emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                              &
-                                                        emis_distribution(1,nys:nyn,nxl:nxr,ispec) &
-                                                        + delta_emis(nys:nyn,nxl:nxr)
-
-                      ENDIF
-
-                   ENDDO
-
-!
-!--             Any other species
-                ELSE
-
-                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * time_factor(icat) *       &
-                                                 conversion_factor * hours_per_day
-
-                   emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                                    &
-                                                        emis_distribution(1,nys:nyn,nxl:nxr,ispec) &
-                                                        + delta_emis(nys:nyn,nxl:nxr)
-
-                ENDIF  ! TRIM spc_names
-
-                emis = 0
-
-             ENDDO
-
-             delta_emis = 0
-
-          ENDDO
-
-!
-!--    LOD 2 (PRE-PROCESSED mode)
-       ELSEIF  ( emiss_lod == 2 )  THEN
-
-!
-!--       Cycle over species: n_matched_vars represents the number of species in common between the
-!--       emission input data and the chemistry mechanism used
-          DO  ispec = 1, n_matched_vars
-
-! (ecc)
-             emis_distribution(1,nys:nyn,nxl:nxr,ispec) = emt(match_spec_input(ispec))%            &
-                                       preproc_emission_data(index_hh+1,1,nys+1:nyn+1,nxl+1:nxr+1) &
-                                       * conversion_factor
-
-          ENDDO
-
-       ENDIF  ! emiss_lod
-
-
-!
-!-- Cycle to transform x,y coordinates to the one of surface_mod and to assign emission values to
-!-- cssws
-
-!
-!--    LOD 0 (PARAMETERIZED mode)
-!--    Units of inputs are micromoles/m2/s
-       IF  ( emiss_lod == 0 )  THEN
-
-          IF  (street_type_f%from_file)  THEN
-
-!
-!-- Streets are lsm surfaces, hence, no usm surface treatment required.
-!-- However, urban surface may be initialized via default initialization in surface_mod, e.g. at
-!-- horizontal urban walls that are at k == 0 (building is lower than the first grid point). Hence,
-!-- in order to have only emissions at streets, set the surfaces emissions to zero at urban walls.
-             IF  ( surf_usm_h(0)%ns >=1 )  surf_usm_h(0)%cssws = 0.0_wp
-
-!
-!--          Treat land-surfaces.
-             DO  m = 1, surf_lsm_h(0)%ns
-
-                i = surf_lsm_h(0)%i(m)
-                j = surf_lsm_h(0)%j(m)
-                k = surf_lsm_h(0)%k(m)
-
-!
-!--             Set everything to zero then reassign according to street type
-                surf_lsm_h(0)%cssws(:,m) = 0.0_wp
-
-                IF  ( street_type_f%var(j,i) >= main_street_id  .AND.                              &
-                      street_type_f%var(j,i) < max_street_id   )  THEN
-
-!
-!--                Cycle over matched species
-                   DO  ispec = 1, n_matched_vars
-
-!
-!--                   PMs are already in kilograms
-                      IF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1"     .OR.         &
-                            TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25"    .OR.         &
-                            TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" )  THEN
-
-!
-!--                      kg/(m^2*s) * kg/m^3
-                         surf_lsm_h(0)%cssws(match_spec_model(ispec),m) =                          &
-                                   emiss_factor_main(match_spec_input(ispec)) *                    &
-                                   emis_distribution(1,j,i,ispec)             *   &     ! kg/(m^2*s)
-                                   rho_air(k)                                           ! kg/m^3
-
-!
-!--                   Other Species
-!--                   Inputs are micromoles
-                      ELSE
-
-!
-!--                      ppm/s *m *kg/m^3
-                         surf_lsm_h(0)%cssws(match_spec_model(ispec),m) =                          &
-                                   emiss_factor_main( match_spec_input(ispec) ) *                  &
-                                   emis_distribution(1,j,i,ispec) *       &     ! micromoles/(m^2*s)
-                                   conv_to_ratio(k,j,i) *                 &     ! m^3/Nmole
-                                   rho_air(k)                                   ! kg/m^3
-
-                      ENDIF
-
-                   ENDDO  ! ispec
-
-
-                ELSEIF  ( street_type_f%var(j,i) >= side_street_id   .AND.                         &
-                          street_type_f%var(j,i) < main_street_id )  THEN
-
-!
-!--                Cycle over matched species
-                   DO  ispec = 1, n_matched_vars
-
-!
-!--                   PMs are already in kilograms
-                      IF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1"      .OR.        &
-                            TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25"     .OR.        &
-                            TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" )  THEN
-
-!
-!--                      kg/(m^2*s) * kg/m^3
-                         surf_lsm_h(0)%cssws(match_spec_model(ispec),m) =                          &
-                                   emiss_factor_side( match_spec_input(ispec) ) *                  &
-                                   emis_distribution(1,j,i,ispec)               * &     ! kg/(m^2*s)
-                                   rho_air(k)                                           ! kg/m^3
-!
-!--                   Other species
-!--                   Inputs are micromoles
-                      ELSE
-
-!
-!--                      ppm/s *m *kg/m^3
-                         surf_lsm_h(0)%cssws(match_spec_model(ispec),m) =                          &
-                                   emiss_factor_side( match_spec_input(ispec) ) *                  &
-                                   emis_distribution(1,j,i,ispec)        *   &  ! micromoles/(m^2*s)
-                                   conv_to_ratio(k,j,i)                  *   &  ! m^3/Nmole
-                                   rho_air(k)                                  ! kg/m^3
-
-                      ENDIF
-
-                   ENDDO  ! ispec
-
-                ENDIF  ! street type
-
-             ENDDO  ! m
-
-          ENDIF  ! street_type_f%from_file
-
-
-!
-!--    LOD 1 (DEFAULT) and LOD 2 (PRE-PROCESSED)
-       ELSE
-
-
-          DO  ispec = 1, n_matched_vars
-
-!
-!--          Default surfaces
-             DO  m = 1, surf_def_h(0)%ns
-
-                i = surf_def_h(0)%i(m)
-                j = surf_def_h(0)%j(m)
-
-                IF  ( emis_distribution(1,j,i,ispec) > 0.0_wp )  THEN
-
-!
-!--                PMs
-                   IF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1"     .OR.            &
-                         TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25"    .OR.            &
-                         TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" )  THEN
-
-                      surf_def_h(0)%cssws(match_spec_model(ispec),m) =      &     ! kg/m2/s * kg/m3
-                                           emis_distribution(1,j,i,ispec) * &     ! kg/m2/s
-                                           rho_air(nzb)                           ! kg/m^3
-
-                   ELSE
-
-!
-!--                   VOCs
-                      IF  ( len_index_voc > 0  .AND.                                               &
-                            emt_att%species_name(match_spec_input(ispec)) == "VOC" )  THEN
-
-                         surf_def_h(0)%cssws(match_spec_model(ispec),m) =     &  ! ppm/s * m * kg/m3
-                               emis_distribution(1,j,i,ispec) *               &  ! mole/m2/s
-                               conv_to_ratio(nzb,j,i)         *               &  ! m^3/mole
-                               ratio2ppm                      *               &  ! ppm
-                               rho_air(nzb)                                      ! kg/m^3
-
-
-!
-!--                   Other species
-                      ELSE
-
-                         surf_def_h(0)%cssws(match_spec_model(ispec),m) =    &   ! ppm/s * m * kg/m3
-                               emis_distribution(1,j,i,ispec) *              &   ! kg/m2/s
-                               ( 1.0_wp / emt_att%xm(ispec) ) *              &   ! mole/kg
-                               conv_to_ratio(nzb,j,i)         *              &   ! m^3/mole
-                               ratio2ppm                      *              &   ! ppm
-                               rho_air(nzb)                                      !  kg/m^3
-
-                      ENDIF  ! VOC
-
-                   ENDIF  ! PM
-
-                ENDIF  ! emis_distribution > 0
-
-             ENDDO  ! m
-
-!
-!--          LSM surfaces
-             DO  m = 1, surf_lsm_h(0)%ns
-
-                i = surf_lsm_h(0)%i(m)
-                j = surf_lsm_h(0)%j(m)
-                k = surf_lsm_h(0)%k(m)
-
-                IF  ( emis_distribution(1,j,i,ispec) > 0.0_wp )  THEN
-
-!
-!--                PMs
-                   IF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1"     .OR.            &
-                         TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25"    .OR.            &
-                         TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" )  THEN
-
-                      surf_lsm_h(0)%cssws(match_spec_model(ispec),m) =           &    ! kg/m2/s * kg/m3
-                                             emis_distribution(1,j,i,ispec) *    &    ! kg/m2/s
-                                             rho_air(k)                               ! kg/m^3
-
-                   ELSE
-
-!
-!--                   VOCs
-                      IF  ( len_index_voc > 0                                           .AND.      &
-                            emt_att%species_name(match_spec_input(ispec)) == "VOC" )  THEN
-
-                         surf_lsm_h(0)%cssws(match_spec_model(ispec),m) =      &   ! ppm/s * m * kg/m3
-                               emis_distribution(1,j,i,ispec) *                &   ! mole/m2/s
-                               conv_to_ratio(k,j,i)           *                &   ! m^3/mole
-                               ratio2ppm                      *                &   ! ppm
-                               rho_air(k)                                          ! kg/m^3
-
-!
-!--                   Other species
-                      ELSE
-
-                         surf_lsm_h(0)%cssws(match_spec_model(ispec),m) =       &   ! ppm/s * m * kg/m3
-                               emis_distribution(1,j,i,ispec) *                 &   ! kg/m2/s
-                               ( 1.0_wp / emt_att%xm(ispec) ) *                 &   ! mole/kg
-                               conv_to_ratio(k,j,i)           *                 &   ! m^3/mole
-                               ratio2ppm                      *                 &   ! ppm
-                               rho_air(k)                                           ! kg/m^3
-
-                      ENDIF  ! VOC
-
-                   ENDIF  ! PM
-
-                ENDIF  ! emis_distribution
-
-             ENDDO  ! m
-
-
-
-!
-!--          USM surfaces
-             DO  m = 1, surf_usm_h(0)%ns
-
-                i = surf_usm_h(0)%i(m)
-                j = surf_usm_h(0)%j(m)
-                k = surf_usm_h(0)%k(m)
-
-                IF  ( emis_distribution(1,j,i,ispec) > 0.0_wp )  THEN
-
-!
-!--                PMs
-                   IF  ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1"     .OR.            &
-                         TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25"    .OR.            &
-                         TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" )  THEN
-
-                      surf_usm_h(0)%cssws(match_spec_model(ispec),m) =           &    ! kg/m2/s * kg/m3
-                               emis_distribution(1,j,i,ispec) *                  &    ! kg/m2/s
-                               rho_air(k)                                             ! kg/m^3
-
-                   ELSE
-
-!
-!-- VOCs
-                      IF  ( len_index_voc > 0  .AND.                                               &
-                            emt_att%species_name(match_spec_input(ispec)) == "VOC" )  THEN
-
-                         surf_usm_h(0)%cssws(match_spec_model(ispec),m) =       &   ! ppm/s * m * kg/m3
-                               emis_distribution(1,j,i,ispec) *                 &   ! m2/s
-                               conv_to_ratio(k,j,i)           *                 &   ! m^3/mole
-                               ratio2ppm                      *                 &   ! ppm
-                               rho_air(k)                                           ! kg/m^3
-
-!
-!-- Other species
-                      ELSE
-
-                         surf_usm_h(0)%cssws(match_spec_model(ispec),m) =       &   ! ppm/s * m * kg/m3
-                               emis_distribution(1,j,i,ispec) *                 &   ! kg/m2/s
-                               ( 1.0_wp / emt_att%xm(ispec) ) *                 &   ! mole/kg
-                               conv_to_ratio(k,j,i)           *                 &   ! m^3/mole
-                               ratio2ppm                      *                 &   ! ppm
-                               rho_air(k)                                           ! kg/m^3
-
-
-                      ENDIF  ! VOC
-
-                   ENDIF  ! PM
-
-                ENDIF  ! emis_distribution
-
-             ENDDO  ! m
-
-          ENDDO
-
-       ENDIF
-
-!
-!-- Deallocate time_factor in case of DEFAULT mode)
-       IF  ( ALLOCATED( time_factor ) )  DEALLOCATE( time_factor )
-
-   ENDIF
-
- END SUBROUTINE chem_emissions_setup
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!
-!! 20200203 NB - ON DEMAND EMISSION UPDATE MODE
-!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!
-!! WRAPPER / INTERFACE FUNCTIONS
-!!
-!! NOTE - I find using an explicity wrapper provides much better flow control
-!!          over an interface block
-!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!>  interface for initiation of emission arrays based on emission LOD
-!
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE chem_emissions_header_init
-
-    IMPLICIT NONE
-
-    SELECT CASE ( emiss_lod )
-       CASE ( 0 )
-! do nothing at the moment
-       CASE ( 1 )
-! do nothing at the moment
-       CASE ( 2 )
-          CALL chem_emissions_header_init_lod2
-    END SELECT
-
- END SUBROUTINE chem_emissions_header_init
-
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!>  interface for initiation of emission arrays based on emission LOD
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE chem_emissions_update_on_demand
-
-    IMPLICIT NONE
-
-    SELECT CASE ( emiss_lod )
-       CASE ( 0 )
-! do nothing at the moment
-       CASE ( 1 )
-! do nothing at the moment
-       CASE ( 2 )
-          CALL chem_emissions_update_on_demand_lod2
-    END SELECT
-
- END SUBROUTINE        ! chem_emisisons_update_on_demand
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!
-!! SUBROUTINES SPECIFIC FOR LOD 2
-!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!>  Initiates header for emissions data attributes for LOD 2
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE chem_emissions_header_init_lod2
-
-    USE control_parameters,                                                                        &
-        ONLY: coupling_char, message_string
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY: chem_emis_att, close_input_file, get_attribute, get_dimension_length, get_variable,  &
-              open_read_file
-
-
-    IMPLICIT NONE
-
-
-    INTEGER(iwp) ::  att_lod   !<  lod attribute in chemistry file
-    INTEGER(iwp) ::  ncid      !< chemistry file netCDF handle
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_header_init_lod2', 'start' )
-
-!
-!-- Opens _chemistry input file and obtain header information
-    CALL open_read_file ( TRIM( input_file_chem ) // TRIM( coupling_char ), ncid )
-!
-!-- Check if LOD in chemistry file matches LOD in namelist
-    CALL get_attribute ( ncid, 'lod', att_lod, .TRUE. )
-
-    IF  ( att_lod /= emiss_lod )  THEN
-       message_string = ''   ! to get around unused variable warning / error
-       WRITE ( message_string, * ) 'LOD mismatch between namelist (emiss_lod) and',                &
-               CHAR( 10 ), '                    ', 'chemistry input file (global attributes>lod)'
-       CALL message( 'chem_emissions_header_init_lod2', 'CM0468', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Obtain unit conversion factor
-    CALL get_attribute ( ncid, 'units', chem_emis_att%units, .FALSE., "emission_values" )
-    conversion_factor = chem_emissions_convert_base_units ( chem_emis_att%units )
-!
-!-- Obtain header attributes
-    CALL chem_emissions_init_species    ( ncid )
-    CALL chem_emissions_init_timestamps ( ncid )
-!
-!-- Done reading file
-    CALL close_input_file (ncid)
-
-!
-!-- Set previous timestamp index to something different to trigger a read event later on
-    previous_timestamp_index = -1
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_header_init_lod2', 'end' )
-
- END SUBROUTINE chem_emissions_header_init_lod2
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads emission data on demand for LOD2
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE chem_emissions_update_on_demand_lod2
-
-    USE control_parameters,                                                                        &
-        ONLY: coupling_char, time_since_reference_point
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY: chem_emis_att, close_input_file, get_variable, open_read_file
-
-    USE arrays_3d,                                                                                 &
-        ONLY: hyp, pt
-
-    USE surface_mod,                                                                               &
-        ONLY: surf_def_h, surf_lsm_h, surf_usm_h
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=80) ::  this_timestamp    !< writes out timestamp
-
-    INTEGER(iwp) ::  i,j,k,m                !< generic counters
-    INTEGER(iwp) ::  kmatch                 !< index of matched species
-    INTEGER(iwp) ::  ncid                   !< netCDF file handle (chemistry file)
-    INTEGER(iwp) ::  time_index_location    !< location of most recent timestamp
-
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:)       ::  cssws_def_h    !< dummy default surface array
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:)       ::  cssws_lsm_h    !< dummy LSM surface array
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:)       ::  cssws_usm_h    !< dummy USM surface array
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:)       ::  mass2mole      !< conversion factor mass 2 molar (ppm) flux
-
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)     ::  emis_distrib   !< surface emissions
-
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:,:) ::  emissions_raw  !< raw emissions data
-
-    IF  ( debug_output )  CALL debug_message ( 'chem_emissions_update_on_demand_lod2', 'start' )
-!
-!-- Obtain current timestamp and locate index for most recent timestamp element
-!-- end subroutine (RETURN) if it is still the same index as the existing time index
-
-    this_timestamp = ''   ! string must be initiated before using
-    CALL get_date_time( time_since_reference_point, date_time_str=this_timestamp )
-
-    time_index_location = chem_emissions_locate_timestep                                           &
-                                        ( this_timestamp, timestamps, 1, chem_emis_att%dt_emission )
-
-    IF  ( time_index_location == previous_timestamp_index )  RETURN
-
-!
-!-- Begin extract emission data for matched species from netCDF file
-    previous_timestamp_index = time_index_location
-
-    ALLOCATE ( emis_distrib(n_matched_vars,nys:nyn,nxl:nxr) )
-    emis_distrib = 0.0_wp
-
-!
-!-- Open netCDF file and allocate temp memory
-    CALL open_read_file( TRIM( input_file_chem ) // TRIM( coupling_char ), ncid )
-    ALLOCATE( emissions_raw(1,1,nys:nyn,nxl:nxr,1) )
-
-    DO k = 1, n_matched_vars
-!
-!-- Get index for matching species
-       kmatch = chem_emissions_locate_species( spc_names(match_spec_model(k)),                     &
-                                               chem_emis_att%species_name )
-!
-!-- Extract variable as-is
-!-- Note C index notations for nx and ny due to MPI and reversed index dimension order for netCDF
-!-- Fortran API)
-       emissions_raw = 0.0_wp
-
-       CALL get_variable ( ncid, 'emission_values', emissions_raw,                                 &
-                           kmatch, nxl+1, nys+1, 1, time_index_location,                           &
-                           1, nxr-nxl+1, nyn-nys+1, 1, 1, .FALSE. )
-!
-!--    Transfer emission data
-       DO j = nys,nyn
-         DO i = nxl,nxr
-            emis_distrib(k,j,i) = emissions_raw(1,1,j,i,1) * conversion_factor
-         ENDDO
-       ENDDO
-
-    ENDDO  ! k = n_matched_vars
-!
-!-- netCDF handle and temp memory no longer needed
-    DEALLOCATE( emissions_raw )
-    CALL close_input_file( ncid )
-!
-!-- Set emis_dt since chemistry ODEs can be stiff, the option to solve them at every RK substep is
-!-- present to help improve stability should the need arise
-    dt_emis = dt_3d
-
-    IF  ( call_chem_at_all_substeps )  dt_emis = dt_emis * weight_pres(intermediate_timestep_count)
-!
-!-- Calculate conversion factor from mass flux to molar flux (mixing ratio)
-    ALLOCATE ( mass2mole(nys:nyn,nxl:nxr) )
-    mass2mole = 0.0_wp
-
-    DO i = nxl, nxr
-       DO j = nys, nyn
-          mass2mole(j,i) = mass_2_molar_flux ( hyp(nzb), pt(nzb,j,i) )
-       ENDDO
-    ENDDO
-
-!
-!-- Calculate surface fluxes
-!-- NOTE - For some reason I can not pass surf_xxx%cssws as output argument into subroutine
-!--        assign_surface_flux ( ).  The contents got mixed up once the subroutine is finished. I
-!--        don't know why and I don't have time to investigate. As workaround I declared dummy
-!--        variables and reassign them one by one (i.e., in a loop)
-!-- ECC 20200206
-
-!
-!-- Allocate and initialize dummy surface fluxes
-    ALLOCATE( cssws_def_h(n_matched_vars,surf_def_h(0)%ns) )
-    cssws_def_h = 0.0_wp
-
-    ALLOCATE( cssws_lsm_h(n_matched_vars,surf_lsm_h(0)%ns) )
-    cssws_lsm_h = 0.0_wp
-
-    ALLOCATE( cssws_usm_h(n_matched_vars,surf_usm_h(0)%ns) )
-    cssws_usm_h = 0.0_wp
-
-!
-!-- Assign and transfer emissions as surface fluxes
-    CALL assign_surface_flux ( cssws_def_h, surf_def_h(0)%ns,                                      &
-                               surf_def_h(0)%j, surf_def_h(0)%i,                                   &
-                               emis_distrib, mass2mole )
-
-
-    CALL assign_surface_flux ( cssws_lsm_h, surf_lsm_h(0)%ns,                                      &
-                               surf_lsm_h(0)%j, surf_lsm_h(0)%i,                                   &
-                               emis_distrib, mass2mole )
-
-
-    CALL assign_surface_flux ( cssws_usm_h, surf_usm_h(0)%ns,                                      &
-                               surf_usm_h(0)%j, surf_usm_h(0)%i,                                   &
-                               emis_distrib, mass2mole )
-
-    DO k = 1, n_matched_vars
-
-       DO m = 1, surf_def_h(0)%ns
-          surf_def_h(0)%cssws(k,m) = cssws_def_h(k,m)
-       ENDDO
-
-       DO m = 1, surf_lsm_h(0)%ns
-          surf_lsm_h(0)%cssws(k,m)  = cssws_lsm_h(k,m)
-       ENDDO
-
-       DO m = 1, surf_usm_h(0)%ns
-          surf_usm_h(0)%cssws(k,m)    = cssws_usm_h(k,m)
-       ENDDO
-
-    ENDDO
-
-!
-!-- Cleaning up
-    DEALLOCATE( cssws_def_h )
-    DEALLOCATE( cssws_lsm_h )
-    DEALLOCATE( cssws_usm_h )
-
-    DEALLOCATE ( emis_distrib )
-    DEALLOCATE ( mass2mole )
-
-    IF  ( debug_output )  CALL debug_message ( 'chem_emissions_update_on_demand_lod2', 'end' )
-
- END SUBROUTINE        ! chem_emissions_update_on_demand_lod2
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!
-!! AUXILIARY SUBROUTINES
-!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Look for matched species between emissions attributes and selected chemical mechanisms and
-!> determine corresponding molecular weights
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE chem_emissions_init_species ( ncid )
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY: chem_emis_att, close_input_file, get_dimension_length, get_variable, open_read_file
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: ispec  !< generic counter 4 species
-
-    INTEGER(iwp), INTENT(IN) :: ncid   !< netcdf file ID
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_init_species', 'start' )
-!
-!-  Assign species
-    CALL get_dimension_length ( ncid, chem_emis_att%n_emiss_species, 'nspecies' )
-    CALL get_variable ( ncid, 'emission_name', chem_emis_att%species_name,                         &
-                        chem_emis_att%n_emiss_species )
-!
-!-  Backward compatibility for salsa_mod NB
-    chem_emis_att%nspec = chem_emis_att%n_emiss_species
-!
-!-- Get a list of matched species between emission_attributes and selected chemical mechanism
-    emission_output_required = .FALSE.
-    CALL  chem_emissions_match( chem_emis_att, n_matched_vars )
-
-!
-!-- If matched species found (at least 1),
-!-- allocate memory for emission attributes,
-!-- assign molecular masses [kg/mol],
-!-- see chemistry_model_mod.f90 for reference.
-    IF  ( n_matched_vars > 0 )  THEN
-
-       emission_output_required = .TRUE.
-
-       ALLOCATE( chem_emis_att%xm(n_matched_vars) )
-
-       DO  ispec = 1, n_matched_vars
-          chem_emis_att%xm(ispec) = 1.0_wp
-          SELECT CASE ( TRIM( spc_names(match_spec_model(ispec)) ) )
-             CASE ( 'SO2'  );  chem_emis_att%xm(ispec) = xm_S + xm_O * 2
-             CASE ( 'SO4'  );  chem_emis_att%xm(ispec) = xm_S + xm_O * 4
-             CASE ( 'NO'   );  chem_emis_att%xm(ispec) = xm_N + xm_O
-             CASE ( 'NO2'  );  chem_emis_att%xm(ispec) = xm_N + xm_O * 2
-             CASE ( 'NH3'  );  chem_emis_att%xm(ispec) = xm_N + xm_H * 3
-             CASE ( 'CO'   );  chem_emis_att%xm(ispec) = xm_C + xm_O
-             CASE ( 'CO2'  );  chem_emis_att%xm(ispec) = xm_C + xm_O * 2
-             CASE ( 'CH4'  );  chem_emis_att%xm(ispec) = xm_C + xm_H * 4
-             CASE ( 'HNO3' );  chem_emis_att%xm(ispec) = xm_H + xm_N + xm_O*3
-          END SELECT
-       ENDDO
-
-    ENDIF  ! IF ( n_matched_vars > 0 )
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_init_species', 'end' )
-
- END SUBROUTINE chem_emissions_init_species
-
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Extract timestamps from netCDF input
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE chem_emissions_init_timestamps ( ncid )
-
-    USE control_parameters,                                                                        &
-        ONLY: message_string
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY: chem_emis_att, close_input_file, get_dimension_length, get_variable, open_read_file
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  fld_len   !< string field length
-    INTEGER(iwp) ::  itime     !< generic counter (4 species)
-
-    INTEGER(iwp), INTENT(IN) :: ncid   !< netcdf file handle
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_read_timestamps', 'start' )
-!
-!-- Import timestamps from netCDF input
-    CALL get_dimension_length ( ncid, chem_emis_att%dt_emission, 'time' )
-    CALL get_dimension_length ( ncid, fld_len, 'field_length' )
-    CALL get_variable ( ncid, 'timestamp', timestamps, chem_emis_att%dt_emission, fld_len )
-!
-!-- Throw error at first instance of timestamps not in listed in chronological order.
-    DO itime = 2,chem_emis_att%dt_emission
-
-       IF ( timestamps(itime-1) > timestamps(itime) )  THEN
-
-           WRITE( message_string, * )                                                              &
-                  'input timestamps not in chronological order for',                               &
-                  CHAR( 10 ), '                    ',                                              &
-                 'index ', (itime-1), ' : ', TRIM( timestamps(itime-1) ), ' and',                  &
-                  CHAR( 10 ), '                    ',                                              &
-                  'index ', (itime),   ' : ', TRIM( timestamps(itime) )
-
-          CALL message( 'chem_emissions_read_timestamps', 'CM0469', 1, 2, 0, 6, 0 )
-
-       ENDIF
-
-    ENDDO
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_read_timestamps', 'end' )
-
- END SUBROUTINE chem_emissions_init_timestamps
-
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Assign emissions as surface fluxes
-!
-!> NOTE:  For arguments, I originally wanted to use unspecified dimensions, but I could not get
-!>        this to work properly, hence the dimensioned array arguments.
-!--------------------------------------------------------------------------------------------------!
-
-SUBROUTINE assign_surface_flux ( surf_array, nsurfs, surf_j, surf_i, emis_dist, conv_mole )
-
-    USE arrays_3d,                                                                                 &
-        ONLY: rho_air
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY: chem_emis_att
-
-    USE surface_mod   !< for surf_type
-
-    IMPLICIT NONE
-!
-!-- Input arguments
-    INTEGER(iwp),                    INTENT(IN) ::  nsurfs   !< # surfaces in surf_array
-
-    INTEGER(iwp), DIMENSION(nsurfs), INTENT(IN) ::  surf_i   !< i indices 4 surf. elements
-    INTEGER(iwp), DIMENSION(nsurfs), INTENT(IN) ::  surf_j   !< j indices 4 surf. elements
-
-    REAL(wp), DIMENSION(nys:nyn,nxl:nxr),                INTENT(IN)    ::  conv_mole   !< conv. 2 molar flux
-    REAL(wp), DIMENSION(n_matched_vars,nys:nyn,nxl:nxr), INTENT(IN)    ::  emis_dist   !< surf. emissions
-
-    REAL(wp), DIMENSION(n_matched_vars,nsurfs),          INTENT(INOUT) ::  surf_array  !< surface listing
-
-!
-!-- Parameters (magic numbers)
-    CHARACTER(LEN=2),  PARAMETER ::  sp_PM  = 'PM'   !< id string for all PMs
-    CHARACTER(LEN=3),  PARAMETER ::  sp_VOC = 'VOC'  !< id string for VOC
-
-    REAL(wp), PARAMETER ::  mol2ppm = 1.0E+06_wp     !< conversion from mole 2 ppm
-!
-!-- Local variables
-    CHARACTER(LEN=80) ::  this_species_name  !< matched species name
-
-    INTEGER(iwp) ::  i,j,k,m        !< generic counters
-
-    REAL(wp) ::  flux_conv_factor   !< conversion factor
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_header_init_lod2', 'start' )
-
-    DO k = 1, n_matched_vars
-
-       this_species_name = spc_names(k)  !< species already matched
-
-       DO m = 1, nsurfs
-
-          j = surf_j(m)   ! get surface coordinates
-          i = surf_i(m)
-
-!
-!--       Calculate conversion factor depending on emission species type
-          flux_conv_factor = rho_air(nzb)
-!
-!--       Account for conversion to different types of emisison species
-          IF       ( TRIM( this_species_name( 1:LEN( sp_PM ) ) )  == sp_PM  )  THEN
-
-                ! do nothing (use mass flux directly)
-
-          ELSE IF  ( TRIM( this_species_name( 1:LEN( sp_VOC ) ) ) == sp_VOC )  THEN
-
-             flux_conv_factor = flux_conv_factor * conv_mole(j,i) * mol2ppm
-
-          ELSE
-
-             flux_conv_factor = flux_conv_factor * conv_mole(j,i) * mol2ppm / chem_emis_att%xm(k)
-
-          ENDIF
-!
-!--       Finally assign surface flux
-          surf_array(k,m) = emis_dist(k,j,i) * flux_conv_factor
-
-       ENDDO   ! m = 1, nsurfs
-
-    ENDDO   ! k = 1, n_matched_vars
-
-
-    IF  ( debug_output )  CALL debug_message( 'chem_emissions_header_init_lod2', 'end' )
-
-END SUBROUTINE assign_surface_flux
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!
-!! AUXILIARY FUNCTIONS
-!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Given incoming flux units ( mass / area / time ) provide single-valued onversion factor to
-!> ( kg / m2 / s )
-!--------------------------------------------------------------------------------------------------!
-
- FUNCTION chem_emissions_convert_base_units ( units_in ) RESULT ( conv_factor )
-
-    IMPLICIT NONE
-!
-!-- Function arguments
-    CHARACTER(LEN=*), INTENT(IN) ::  units_in      !< incoming units (ie emt_att%units)
-
-    REAL(wp) ::  conv_factor                       !< convertion factor
-
-!
-!-- Parameters (magic numbers)
-    INTEGER(iwp), PARAMETER ::  up2lo = 32         !< convert letter to lower case
-!
-!-- Base unit conversion factors (should be self-explanatory)
-    REAL(wp), PARAMETER ::  hour_per_year =  8760.0_wp
-    REAL(wp), PARAMETER ::  g_to_kg       =     1.0E-03_wp
-    REAL(wp), PARAMETER ::  miug_to_kg    =     1.0E-09_wp
-    REAL(wp), PARAMETER ::  s_per_hour    =  3600.0_wp
-    REAL(wp), PARAMETER ::  s_per_day     = 86400.0_wp
-    REAL(wp), PARAMETER ::  tons_to_kg    =   100.0_wp
-
-    REAL(wp), PARAMETER ::  day_to_s      =     1.0_wp / s_per_day
-    REAL(wp), PARAMETER ::  hour_to_s     =     1.0_wp / s_per_hour
-    REAL(wp), PARAMETER ::  year_to_s     =     1.0_wp / s_per_hour / hour_per_year
-
-
-!
-!-- Local variables
-    CHARACTER(LEN=LEN(units_in)) ::  units_in_lo   !< units in lower case
-
-    INTEGER(iwp) ::  j,k                           !< generic counters
-    INTEGER(iwp) ::  str_len                       !< length of unit string
-!
-!-- Turn units string to lower case
-    units_in_lo = ''
-    str_len = LEN( TRIM( units_in ) )
-
-    DO k = 1,str_len
-       j = IACHAR( units_in(k:k) )
-       units_in_lo(k:k) = ACHAR( j )
-       IF  ( ( j >= IACHAR( "A" ) )  .AND.  ( j <= IACHAR( "Z" ) ) )                               &
-          units_in_lo(k:k) = ACHAR( j + up2lo )
-    ENDDO
-
-    conv_factor = 1.0_wp     !< default value (kg/m2/s)
-
-    SELECT CASE ( TRIM( units_in_lo ) )
-       CASE ( 'kg/m2/s'            );   conv_factor = 1.0_wp
-       CASE ( 'kg/m2/hour'         );   conv_factor = hour_to_s
-       CASE ( 'kg/m2/day'          );   conv_factor = day_to_s
-       CASE ( 'kg/m2/year'         );   conv_factor = year_to_s
-       CASE ( 'ton/m2/s'           );   conv_factor = tons_to_kg
-       CASE ( 'ton/m2/hour'        );   conv_factor = tons_to_kg * hour_to_s
-       CASE ( 'ton/m2/day'         );   conv_factor = tons_to_kg * day_to_s
-       CASE ( 'ton/m2/year'        );   conv_factor = tons_to_kg * year_to_s
-       CASE ( 'g/m2/s'             );   conv_factor = g_to_kg
-       CASE ( 'g/m2/hour'          );   conv_factor = g_to_kg * hour_to_s
-       CASE ( 'g/m2/day'           );   conv_factor = g_to_kg * day_to_s
-       CASE ( 'g/m2/year'          );   conv_factor = g_to_kg * year_to_s
-       CASE ( 'micrograms/m2/s'    );   conv_factor = miug_to_kg
-       CASE ( 'micrograms/m2/hour' );   conv_factor = miug_to_kg * hour_to_s
-       CASE ( 'micrograms/m2/day'  );   conv_factor = miug_to_kg * day_to_s
-       CASE ( 'micrograms/m2/year' );   conv_factor = miug_to_kg * year_to_s
-       CASE DEFAULT
-          message_string = ''   ! to get around unused variable warning / error
-          WRITE ( message_string, * ) 'Specified emission units (', TRIM( units_in ),              &
-                                      ') not recognized in PALM-4U'
-          CALL message ( 'chem_emission_convert_units', 'CM0446', 2, 2, 0, 6, 0 )
-    END SELECT
-
- END FUNCTION chem_emissions_convert_base_units
-
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates conversion factor from mass flux to ppm (molar flux)
-!--------------------------------------------------------------------------------------------------!
-
- FUNCTION mass_2_molar_flux ( rhogh, theta ) RESULT ( conv_factor )
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY: p_0, rd_d_cp, rgas_univ
-
-    IMPLICIT NONE
-!
-!-- Function arguments
-    REAL(wp)             ::  conv_factor   !< conversion factor
-    REAL(wp), INTENT(IN) ::  rhogh         !< hydrostatic pressure
-    REAL(wp), INTENT(IN) ::  theta         !< potential temperature
-
-    conv_factor = ( rgas_univ / rhogh ) * theta * ( ( rhogh / p_0 ) ** rd_d_cp )
-
- END FUNCTION mass_2_molar_flux
-
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Given target sepecies locate index in species array
-!> returns 0 if none is found
-!--------------------------------------------------------------------------------------------------!
-
- FUNCTION chem_emissions_locate_species ( this_species, species_array )  RESULT ( species_index )
-
-    IMPLICIT NONE
-!
-!-- Function arguments
-    INTEGER(iwp) ::  species_index   !> index matching species
-
-    CHARACTER(LEN=25), INTENT(IN) ::  species_array(:)   !> array of species
-    CHARACTER(LEN=*),  INTENT(IN) ::  this_species       !> target species
-!
-!-- Local variables
-    INTEGER(iwp) :: k           !> generic counter
-    INTEGER(iwp) :: n_species   !> number of species in species_array
-
-    n_species = SIZE( species_array, 1 )
-
-    DO k = 1, n_species
-       IF ( TRIM( species_array(k) ) == TRIM( this_species ) )  EXIT
-    ENDDO
-
-    species_index = 0   !> assume no matching index is found
-
-    IF ( TRIM( species_array(k) ) == TRIM( this_species ) )  specieS_index = k
-
- END FUNCTION chem_emissions_locate_species
-
-
-!
-!-- 20200203 NB
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> given target timestamp locate most recent timestep in timestamp array
-!> using bisection search (since array is sorted)
-!--------------------------------------------------------------------------------------------------!
-
- RECURSIVE FUNCTION chem_emissions_locate_timestep                                                 &
-                       ( this_timestamp, timestamp_array, lower_bound, upper_bound )               &
-                       RESULT ( timestamp_index )
-
-!
-!-- Function arguments
-    CHARACTER(LEN=*),   INTENT(IN) ::  this_timestamp       !> target timestamp
-    CHARACTER(LEN=512), INTENT(IN) ::  timestamp_array(:)   !> array of timestamps
-
-    INTEGER(iwp), INTENT(IN) ::  lower_bound, upper_bound   !> timestamp_array index bounds
-
-    INTEGER(iwp)  ::  timestamp_index   !> index for most recent timestamp in timestamp_array
-
-!
-!-- Local variables
-    INTEGER(iwp) :: k0,km,k1          !> lower, central, and upper index bounds
-!
-!-- Assign bounds
-    k0 = lower_bound
-    k1 = upper_bound
-!
-!-- Make sure k1 is always not smaller than k0
-    IF  ( k0 > k1 )  THEN
-       k0 = upper_bound
-       k1 = lower_bound
-    ENDIF
-!
-!-- Make sure k0 and k1 stay within array bounds by timestamp_array
-    IF  ( k0 < 1                       )  k0 = 1
-    IF  ( k1 > SIZE( timestamp_array, 1 ) )  k1 = SIZE( timestamp_array, 1 )
-!
-!-- Terminate if target is contained within 2 consecutive indices otherwise calculate central bound
-!-- (km) and determine new index bounds for the next iteration
-
-    IF ( ( k1 - k0 ) > 1 )  THEN
-       km = ( k0 + k1 ) / 2
-       IF  ( TRIM( this_timestamp ) > TRIM( timestamp_array(km) ) )  THEN
-          k0 = km
-       ELSE
-          k1 = km
-       ENDIF
-       timestamp_index = chem_emissions_locate_timestep( this_timestamp, timestamp_array, k0, k1 )
-    ELSE
-       timestamp_index = k0
-    ENDIF
-
- END FUNCTION chem_emissions_locate_timestep
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!
-!! END OF MODULE
-!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- END MODULE chem_emissions_mod
Index: palm/trunk/SOURCE/chem_gasphase_mod.f90
===================================================================
--- palm/trunk/SOURCE/chem_gasphase_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2400 +1,0 @@
-MODULE chem_gasphase_mod
- 
-!   Mechanism: phstatp
-!
-!------------------------------------------------------------------------------!
-!
-! ******Module chem_gasphase_mod is automatically generated by kpp4palm ******
-!
-!   *********Please do NOT change this Code,it will be ovewritten *********
-!
-!------------------------------------------------------------------------------!
-! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
-! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version 
-! of KP4 (JÃ¶ckel,P.,Kerkweg,A.,Pozzer,A.,Sander,R.,Tost,H.,Riede,
-! H.,Baumgaertner,A.,Gromov,S.,and Kern,B.,2010: Development cycle 2 of
-! the Modular Earth Submodel System (MESSy2),Geosci. Model Dev.,3,717-752,
-! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth 
-! Submodel System (MESSy),which is is available under the  GNU General Public 
-! License (GPL).
-!
-! KPP is free software; you can redistribute it and/or modify it under the terms 
-! of the General Public Licence as published by the Free Software Foundation; 
-! either version 2 of the License,or (at your option) any later version. 
-! KPP 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 Licence for more details. 
-!
-!------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2017-2021 Leibniz Universitaet Hannover
-! Copyright 2016-2021 Klaus Ketelsen
-! Copyright 2017-2021 Karlsruhe Institute of Technology
-!--------------------------------------------------------------------------------!
-!
-!
-! MODULE HEADER TEMPLATE
-!
-!  Initial version (Nov. 2016,ketelsen),for later modifications of module_header 
-!  see comments in kpp4palm/src/create_kpp_module.C
-
-! Set kpp Double Precision to PALM Default Precision
-
-  USE kinds,           ONLY: dp=>wp
-
-  USE pegrid,          ONLY: myid, threads_per_task
-
-  IMPLICIT        NONE
-  PRIVATE
-  !SAVE  ! note: occurs again in automatically generated code ...
-
-! Public variables
-  PUBLIC :: atol
-  PUBLIC :: cs_mech
-  PUBLIC :: eqn_names
-  PUBLIC :: fakt
-  PUBLIC :: nmaxfixsteps
-  PUBLIC :: nphot
-  PUBLIC :: nreact
-  PUBLIC :: nspec
-  PUBLIC :: nvar
-  PUBLIC :: qvap
-  PUBLIC :: phot 
-  PUBLIC :: phot_names
-  PUBLIC :: rconst
-  PUBLIC :: rtol
-  PUBLIC :: spc_names
-  PUBLIC :: temp
-  PUBLIC :: vl_dim                     !< PUBLIC to enable other MODULEs to distiguish between scalar and vec
- 
-! Public routines
-  PUBLIC :: chem_gasphase_integrate
-  PUBLIC :: get_mechanism_name
-  PUBLIC :: initialize
-  PUBLIC :: initialize_kpp_ctrl
-  PUBLIC :: integrate
-  PUBLIC :: update_rconst
-
-! END OF MODULE HEADER TEMPLATE
-                                                                 
-! Variables used for vector mode                                 
-                                                                 
-  LOGICAL, PARAMETER          :: l_vector = .FALSE.            
-  INTEGER, PARAMETER          :: i_lu_di = 2
-  INTEGER, PARAMETER          :: vl_dim = 1
-  INTEGER                     :: vl                              
-                                                                 
-  INTEGER                     :: vl_glo                          
-  INTEGER                     :: is, ie                           
-                                                                 
-                                                                 
-  LOGICAL                     :: data_loaded = .FALSE.             
-  REAL(dp), POINTER, DIMENSION(:), CONTIGUOUS    :: var             
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! Parameter Module File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_Parameters.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-
-
-
-! NSPEC - Number of chemical species
-  INTEGER, PARAMETER :: nspec = 4 
-! NVAR - Number of Variable species
-  INTEGER, PARAMETER :: nvar = 4 
-! NVARACT - Number of Active species
-  INTEGER, PARAMETER :: nvaract = 4 
-! NFIX - Number of Fixed species
-  INTEGER, PARAMETER :: nfix = 1 
-! NREACT - Number of reactions
-  INTEGER, PARAMETER :: nreact = 3 
-! NVARST - Starting of variables in conc. vect.
-  INTEGER, PARAMETER :: nvarst = 1 
-! NFIXST - Starting of fixed in conc. vect.
-  INTEGER, PARAMETER :: nfixst = 5 
-! NONZERO - Number of nonzero entries in Jacobian
-  INTEGER, PARAMETER :: nonzero = 10 
-! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
-  INTEGER, PARAMETER :: lu_nonzero = 10 
-! CNVAR - (NVAR+1) Number of elements in compressed row format
-  INTEGER, PARAMETER :: cnvar = 5 
-! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
-  INTEGER, PARAMETER :: cneqn = 4 
-! NHESS - Length of Sparse Hessian
-  INTEGER, PARAMETER :: nhess = 3 
-! NMASS - Number of atoms to check mass balance
-  INTEGER, PARAMETER :: nmass = 1 
-
-! Index declaration for variable species in C and VAR
-!   VAR(ind_spc) = C(ind_spc)
-
-  INTEGER, PARAMETER, PUBLIC :: ind_pm10 = 1 
-  INTEGER, PARAMETER, PUBLIC :: ind_no = 2 
-  INTEGER, PARAMETER, PUBLIC :: ind_no2 = 3 
-  INTEGER, PARAMETER, PUBLIC :: ind_o3 = 4 
-
-! Index declaration for fixed species in C
-!   C(ind_spc)
-
-
-! Index declaration for fixed species in FIX
-!    FIX(indf_spc) = C(ind_spc) = C(NVAR+indf_spc)
-
-
-! NJVRP - Length of sparse Jacobian JVRP
-  INTEGER, PARAMETER :: njvrp = 4 
-
-! NSTOICM - Length of Sparse Stoichiometric Matrix
-  INTEGER, PARAMETER :: nstoicm = 6 
-
-
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! Global Data Module File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_Global.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-
-
-
-! Declaration of global variables
-
-! C - Concentration of all species
-  REAL(kind=dp), TARGET    :: c(nspec)
-! VAR - Concentrations of variable species (global)
-! REAL(kind=dp):: var(nvar)  var is now POINTER
-! FIX - Concentrations of fixed species (global)
-  REAL(kind=dp):: fix(nfix)
-! VAR,FIX are chunks of array C
-! RCONST - Rate constants (global)
-  REAL(kind=dp):: rconst(nreact)
-! TIME - Current integration time
-  REAL(kind=dp):: time
-! TEMP - Temperature
-  REAL(kind=dp):: temp
-! ATOL - Absolute tolerance
-  REAL(kind=dp):: atol(nvar)
-! RTOL - Relative tolerance
-  REAL(kind=dp):: rtol(nvar)
-! STEPMIN - Lower bound for integration step
-  REAL(kind=dp):: stepmin
-! CFACTOR - Conversion factor for concentration units
-  REAL(kind=dp):: cfactor
-
-! INLINED global variable declarations
-
-! QVAP - Water vapor
-  REAL(kind=dp):: qvap
-! FAKT - Conversion factor
-  REAL(kind=dp):: fakt
-
-! CS_MECH for check of mechanism name with namelist
-  CHARACTER(len=30):: cs_mech
-
-! INLINED global variable declarations
-
-
-
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! Sparse Jacobian Data Structures File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_JacobianSP.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-
-
-
-! Sparse Jacobian Data
-
-
-  INTEGER, PARAMETER, DIMENSION(10):: lu_irow =  (/ &
-       1, 2, 2, 2, 3, 3, 3, 4, 4, 4 /) 
-
-  INTEGER, PARAMETER, DIMENSION(10):: lu_icol =  (/ &
-       1, 2, 3, 4, 2, 3, 4, 2, 3, 4 /) 
-
-  INTEGER, PARAMETER, DIMENSION(5):: lu_crow =  (/ &
-       1, 2, 5, 8, 11 /) 
-
-  INTEGER, PARAMETER, DIMENSION(5):: lu_diag =  (/ &
-       1, 2, 6, 10, 11 /) 
-
-
-
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! Utility Data Module File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_Monitor.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-
-
-  CHARACTER(len=15), PARAMETER, DIMENSION(4):: spc_names =  (/ &
-     'PM10           ','NO             ','NO2            ',&
-     'O3             ' /)
-
-  CHARACTER(len=100), PARAMETER, DIMENSION(3):: eqn_names =  (/ &
-     '    NO2 --> NO + O3                                                                                 ',&
-     'NO + O3 --> NO2                                                                                     ',&
-     '   PM10 --> PM10                                                                                    ' /)
-
-! INLINED global variables
-
-  !   inline f90_data: declaration of global variables for photolysis
-  !   REAL(kind=dp):: phot(nphot)must eventually be moved to global later for 
-  INTEGER, PARAMETER :: nphot = 1
-  !   phot photolysis frequencies 
-  REAL(kind=dp):: phot(nphot)
-
-  INTEGER, PARAMETER, PUBLIC :: j_no2 = 1
-
-  CHARACTER(len=15), PARAMETER, DIMENSION(nphot):: phot_names =   (/ &
-     'J_NO2          '/)
-
-! End INLINED global variables
-
-
-! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
- 
-! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
- 
-! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
- 
-! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
- 
- 
-!  variable definations from  individual module headers 
- 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! Initialization File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_Initialize.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-
-
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! Numerical Integrator (Time-Stepping) File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_Integrator.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! INTEGRATE - Integrator routine
-!   Arguments :
-!      TIN       - Start Time for Integration
-!      TOUT      - End Time for Integration
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
-!  Rosenbrock - Implementation of several Rosenbrock methods:             !
-!               *Ros2                                                    !
-!               *Ros3                                                    !
-!               *Ros4                                                    !
-!               *Rodas3                                                  !
-!               *Rodas4                                                  !
-!  By default the code employs the KPP sparse linear algebra routines     !
-!  Compile with -DFULL_ALGEBRA to use full linear algebra (LAPACK)        !
-!                                                                         !
-!    (C)  Adrian Sandu,August 2004                                       !
-!    Virginia Polytechnic Institute and State University                  !
-!    Contact: sandu@cs.vt.edu                                             !
-!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  !                               !
-!    This implementation is part of KPP - the Kinetic PreProcessor        !
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
-
-
-  SAVE
-  
-!~~~>  statistics on the work performed by the rosenbrock method
-  INTEGER, PARAMETER :: nfun=1, njac=2, nstp=3, nacc=4, &
-                        nrej=5, ndec=6, nsol=7, nsng=8, &
-                        ntexit=1, nhexit=2, nhnew = 3
-
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! Linear Algebra Data and Routines File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_LinearAlgebra.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-
-
-
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! The ODE Jacobian of Chemical Model File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_Jacobian.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-
-
-
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! The ODE Function of Chemical Model File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_Function.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-
-
-! A - Rate for each equation
-  REAL(kind=dp):: a(nreact)
-
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! The Reaction Rates File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_Rates.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-
-
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! 
-! Auxiliary Routines File
-! 
-! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
-!       (http://www.cs.vt.edu/~asandu/Software/KPP)
-! KPP is distributed under GPL,the general public licence
-!       (http://www.gnu.org/copyleft/gpl.html)
-! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
-! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
-!     With important contributions from:
-!        M. Damian,Villanova University,USA
-!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
-! 
-! File                 : chem_gasphase_mod_Util.f90
-! Time                 : Tue Jan 12 18:41:31 2021
-! Working directory    : /home/forkel-r/palmstuff/work/trunk20210112/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
-! Equation file        : chem_gasphase_mod.kpp
-! Output root filename : chem_gasphase_mod
-! 
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-
-
-
-
-  ! header MODULE initialize_kpp_ctrl_template
-
-  ! notes:
-  ! - l_vector is automatically defined by kp4
-  ! - vl_dim is automatically defined by kp4
-  ! - i_lu_di is automatically defined by kp4
-  ! - wanted is automatically defined by xmecca
-  ! - icntrl rcntrl are automatically defined by kpp
-  ! - "USE messy_main_tools" is in MODULE_header of messy_mecca_kpp.f90
-  ! - SAVE will be automatically added by kp4
-
-  !SAVE
-
-  ! for fixed time step control
-  ! ... max. number of fixed time steps (sum must be 1)
-  INTEGER, PARAMETER         :: nmaxfixsteps = 50
-  ! ... switch for fixed time stepping
-  LOGICAL, PUBLIC            :: l_fixed_step = .FALSE.
-  INTEGER, PUBLIC            :: nfsteps = 1
-  ! ... number of kpp control PARAMETERs
-  INTEGER, PARAMETER, PUBLIC :: nkppctrl = 20
-  !
-  ! steering PARAMETERs for chemistry solver (see kpp domumentation)
-  INTEGER, DIMENSION(nkppctrl), PUBLIC      :: icntrl = 0
-  REAL(dp), DIMENSION(nkppctrl), PUBLIC     :: rcntrl = 0.0_dp
-  ! t_steps: fixed time steps in vector mode
-  REAL(dp), DIMENSION(nmaxfixsteps), PUBLIC :: t_steps = 0.0_dp
-
-  ! END header MODULE initialize_kpp_ctrl_template
-
- 
-! Interface Block 
- 
-  INTERFACE            initialize
-    MODULE PROCEDURE   initialize
-  END INTERFACE        initialize
- 
-  INTERFACE            integrate
-    MODULE PROCEDURE   integrate
-  END INTERFACE        integrate
- 
-  INTERFACE            fun
-    MODULE PROCEDURE   fun
-  END INTERFACE        fun
- 
-  INTERFACE            kppsolve
-    MODULE PROCEDURE   kppsolve
-  END INTERFACE        kppsolve
- 
-  INTERFACE            jac_sp
-    MODULE PROCEDURE   jac_sp
-  END INTERFACE        jac_sp
- 
-  INTERFACE            k_arr
-    MODULE PROCEDURE   k_arr
-  END INTERFACE        k_arr
- 
-  INTERFACE            update_rconst
-    MODULE PROCEDURE   update_rconst
-  END INTERFACE        update_rconst
- 
-  INTERFACE            arr2
-    MODULE PROCEDURE   arr2
-  END INTERFACE        arr2
- 
-  INTERFACE            initialize_kpp_ctrl
-    MODULE PROCEDURE   initialize_kpp_ctrl
-  END INTERFACE        initialize_kpp_ctrl
- 
-  INTERFACE            error_output
-    MODULE PROCEDURE   error_output
-  END INTERFACE        error_output
- 
-  INTERFACE            wscal
-    MODULE PROCEDURE   wscal
-  END INTERFACE        wscal
- 
-!INTERFACE not working  INTERFACE            waxpy
-!INTERFACE not working    MODULE PROCEDURE   waxpy
-!INTERFACE not working  END INTERFACE        waxpy
- 
-  INTERFACE            rosenbrock
-    MODULE PROCEDURE   rosenbrock
-  END INTERFACE        rosenbrock
- 
-  INTERFACE            funtemplate
-    MODULE PROCEDURE   funtemplate
-  END INTERFACE        funtemplate
- 
-  INTERFACE            jactemplate
-    MODULE PROCEDURE   jactemplate
-  END INTERFACE        jactemplate
- 
-  INTERFACE            kppdecomp
-    MODULE PROCEDURE   kppdecomp
-  END INTERFACE        kppdecomp
- 
-  INTERFACE            get_mechanism_name
-    MODULE PROCEDURE   get_mechanism_name
-  END INTERFACE        get_mechanism_name
- 
-  INTERFACE            chem_gasphase_integrate
-    MODULE PROCEDURE   chem_gasphase_integrate
-  END INTERFACE        chem_gasphase_integrate
- 
- 
-  ! openmp directives generated by kp4 
- 
-  !$OMP THREADPRIVATE (vl, vl_glo, is, ie, data_loaded)
-  !$OMP THREADPRIVATE (c, var, fix, rconst, time, temp, stepmin, cfactor)
-  !$OMP THREADPRIVATE (qvap, fakt, cs_mech, a, icntrl, rcntrl)
- 
- CONTAINS
- 
-SUBROUTINE initialize()
-
-
- INTEGER         :: k
-
-  INTEGER :: i
-  REAL(kind=dp):: x
-  k = is
-  cfactor = 1.000000e+00_dp
-!  
-! Following line is just to avoid compiler message about unused variables
-   IF ( lu_crow(1) == 1  .OR.  lu_icol(1) == 1  .OR.  lu_irow(1) == 1 )  CONTINUE 
-!  
-
-  x = (0.) * cfactor
-  DO i = 1 , nvar
-  ENDDO
-
-  x = (0.) * cfactor
-  DO i = 1 , nfix
-    fix(i) = x
-  ENDDO
-
-! constant rate coefficients
-! END constant rate coefficients
-
-! INLINED initializations
-
-! End INLINED initializations
-
-      
-END SUBROUTINE initialize
- 
-SUBROUTINE integrate( tin, tout, &
-  icntrl_u, rcntrl_u, istatus_u, rstatus_u, ierr_u)
-
-
-   REAL(kind=dp), INTENT(IN):: tin  ! start time
-   REAL(kind=dp), INTENT(IN):: tout ! END time
-   ! OPTIONAL input PARAMETERs and statistics
-   INTEGER,      INTENT(IN), OPTIONAL :: icntrl_u(20)
-   REAL(kind=dp), INTENT(IN), OPTIONAL :: rcntrl_u(20)
-   INTEGER,      INTENT(OUT), OPTIONAL :: istatus_u(20)
-   REAL(kind=dp), INTENT(OUT), OPTIONAL :: rstatus_u(20)
-   INTEGER,      INTENT(OUT), OPTIONAL :: ierr_u
-
-   REAL(kind=dp):: rcntrl(20), rstatus(20)
-   INTEGER       :: icntrl(20), istatus(20), ierr
-
-
-   icntrl(:) = 0
-   rcntrl(:) = 0.0_dp
-   istatus(:) = 0
-   rstatus(:) = 0.0_dp
-
-    !~~~> fine-tune the integrator:
-   icntrl(1) = 0      ! 0 - non- autonomous, 1 - autonomous
-   icntrl(2) = 0      ! 0 - vector tolerances, 1 - scalars
-
-   ! IF OPTIONAL PARAMETERs are given, and IF they are >0, 
-   ! THEN they overwrite default settings. 
-   IF (PRESENT(icntrl_u))THEN
-     WHERE(icntrl_u(:)> 0)icntrl(:) = icntrl_u(:)
-   ENDIF
-   IF (PRESENT(rcntrl_u))THEN
-     WHERE(rcntrl_u(:)> 0)rcntrl(:) = rcntrl_u(:)
-   ENDIF
-
-
-   CALL rosenbrock(nvar, var, tin, tout,  &
-         atol, rtol,               &
-         rcntrl, icntrl, rstatus, istatus, ierr)
-
-   !~~~> debug option: show no of steps
-   ! ntotal = ntotal + istatus(nstp)
-   ! PRINT*,'NSTEPS=',ISTATUS(Nstp),' (',Ntotal,')','  O3=',VAR(ind_O3)
-
-   stepmin = rstatus(nhexit)
-   ! IF OPTIONAL PARAMETERs are given for output they 
-   ! are updated with the RETURN information
-   IF (PRESENT(istatus_u))istatus_u(:) = istatus(:)
-   IF (PRESENT(rstatus_u))rstatus_u(:) = rstatus(:)
-   IF (PRESENT(ierr_u))  ierr_u       = ierr
-
-END SUBROUTINE integrate
- 
-SUBROUTINE fun(v, f, rct, vdot)
-
-! V - Concentrations of variable species (local)
-  REAL(kind=dp):: v(nvar)
-! F - Concentrations of fixed species (local)
-  REAL(kind=dp):: f(nfix)
-! RCT - Rate constants (local)
-  REAL(kind=dp):: rct(nreact)
-! Vdot - Time derivative of variable species concentrations
-  REAL(kind=dp):: vdot(nvar)
-
-
-! Following line is just to avoid compiler message about unused variables
-   IF ( f(nfix) > 0.0_dp )  CONTINUE
-!  
-! Computation of equation rates
-  a(1) = rct(1) * v(3)
-  a(2) = rct(2) * v(2) * v(4)
-
-! Aggregate function
-  vdot(1) = 0
-  vdot(2) = a(1) - a(2)
-  vdot(3) = - a(1) + a(2)
-  vdot(4) = a(1) - a(2)
-      
-END SUBROUTINE fun
- 
-SUBROUTINE kppsolve(jvs, x)
-
-! JVS - sparse Jacobian of variables
-  REAL(kind=dp):: jvs(lu_nonzero)
-! X - Vector for variables
-  REAL(kind=dp):: x(nvar)
-
-  x(3) = x(3) - jvs(5) * x(2)
-  x(4) = x(4) - jvs(8) * x(2) - jvs(9) * x(3)
-  x(4) = x(4) / jvs(10)
-  x(3) = (x(3) - jvs(7) * x(4)) /(jvs(6))
-  x(2) = (x(2) - jvs(3) * x(3) - jvs(4) * x(4)) /(jvs(2))
-  x(1) = x(1) / jvs(1)
-      
-END SUBROUTINE kppsolve
- 
-SUBROUTINE jac_sp(v, f, rct, jvs)
-
-! V - Concentrations of variable species (local)
-  REAL(kind=dp):: v(nvar)
-! F - Concentrations of fixed species (local)
-  REAL(kind=dp):: f(nfix)
-! RCT - Rate constants (local)
-  REAL(kind=dp):: rct(nreact)
-! JVS - sparse Jacobian of variables
-  REAL(kind=dp):: jvs(lu_nonzero)
-
-
-! Local variables
-! B - Temporary array
-  REAL(kind=dp):: b(4)
-!
-! Following line is just to avoid compiler message about unused variables
-   IF ( f(nfix) > 0.0_dp )  CONTINUE
-
-! B(1) = dA(1)/dV(3)
-  b(1) = rct(1)
-! B(2) = dA(2)/dV(2)
-  b(2) = rct(2) * v(4)
-! B(3) = dA(2)/dV(4)
-  b(3) = rct(2) * v(2)
-! B(4) = dA(3)/dV(1)
-  b(4) = rct(3)
-
-! Construct the Jacobian terms from B's
-! JVS(1) = Jac_FULL(1,1)
-  jvs(1) = 0
-! JVS(2) = Jac_FULL(2,2)
-  jvs(2) = - b(2)
-! JVS(3) = Jac_FULL(2,3)
-  jvs(3) = b(1)
-! JVS(4) = Jac_FULL(2,4)
-  jvs(4) = - b(3)
-! JVS(5) = Jac_FULL(3,2)
-  jvs(5) = b(2)
-! JVS(6) = Jac_FULL(3,3)
-  jvs(6) = - b(1)
-! JVS(7) = Jac_FULL(3,4)
-  jvs(7) = b(3)
-! JVS(8) = Jac_FULL(4,2)
-  jvs(8) = - b(2)
-! JVS(9) = Jac_FULL(4,3)
-  jvs(9) = b(1)
-! JVS(10) = Jac_FULL(4,4)
-  jvs(10) = - b(3)
-      
-END SUBROUTINE jac_sp
- 
-  elemental REAL(kind=dp)FUNCTION k_arr (k_298, tdep, temp)
-    ! arrhenius FUNCTION
-
-    REAL,    INTENT(IN):: k_298 ! k at t = 298.15k
-    REAL,    INTENT(IN):: tdep  ! temperature dependence
-    REAL(kind=dp), INTENT(IN):: temp  ! temperature
-
-    intrinsic exp
-
-    k_arr = k_298 * exp(tdep* (1._dp/temp- 3.3540e-3_dp))! 1/298.15=3.3540e-3
-
-  END FUNCTION k_arr
- 
-SUBROUTINE update_rconst()
- INTEGER         :: k
-
-  k = is
-
-! Begin INLINED RCONST
-
-
-! End INLINED RCONST
-
-  rconst(1) = (phot(j_no2))
-  rconst(2) = (arr2(1.8e-12_dp , 1370.0_dp , temp))
-  rconst(3) = (1.0_dp)
-      
-END SUBROUTINE update_rconst
- 
-!  END FUNCTION ARR2
-REAL(kind=dp)FUNCTION arr2( a0, b0, temp)
-    REAL(kind=dp):: temp
-    REAL(kind=dp):: a0, b0
-    arr2 = a0 * exp( - b0 / temp)
-END FUNCTION arr2
- 
-SUBROUTINE initialize_kpp_ctrl(status)
-
-
-  ! i/o
-  INTEGER,         INTENT(OUT):: status
-
-  ! local
-  REAL(dp):: tsum
-  INTEGER  :: i
-
-  ! check fixed time steps
-  tsum = 0.0_dp
-  DO i=1, nmaxfixsteps
-     IF (t_steps(i)< tiny(0.0_dp))exit
-     tsum = tsum + t_steps(i)
-  ENDDO
-
-  nfsteps = i- 1
-
-  l_fixed_step = (nfsteps > 0).and.((tsum - 1.0)< tiny(0.0_dp))
-
-  IF (l_vector)THEN
-     WRITE(*,*) ' MODE             : VECTOR (LENGTH=',VL_DIM,')'
-  ELSE
-     WRITE(*,*) ' MODE             : SCALAR'
-  ENDIF
-  !
-  WRITE(*,*) ' DE-INDEXING MODE :',I_LU_DI
-  !
-  WRITE(*,*) ' ICNTRL           : ',icntrl
-  WRITE(*,*) ' RCNTRL           : ',rcntrl
-  !
-  ! note: this is ONLY meaningful for vectorized (kp4)rosenbrock- methods
-  IF (l_vector)THEN
-     IF (l_fixed_step)THEN
-        WRITE(*,*) ' TIME STEPS       : FIXED (',t_steps(1:nfsteps),')'
-     ELSE
-        WRITE(*,*) ' TIME STEPS       : AUTOMATIC'
-     ENDIF
-  ELSE
-     WRITE(*,*) ' TIME STEPS       : AUTOMATIC '//&
-          &'(t_steps (CTRL_KPP) ignored in SCALAR MODE)'
-  ENDIF
-  ! mz_pj_20070531- 
-
-  status = 0
-
-
-END SUBROUTINE initialize_kpp_ctrl
- 
-SUBROUTINE error_output(c, ierr, pe)
-
-
-  INTEGER, INTENT(IN):: ierr
-  INTEGER, INTENT(IN):: pe
-  REAL(dp), DIMENSION(:), INTENT(IN):: c
-
-  write(6,*) 'ERROR in chem_gasphase_mod ',ierr,C(1),PE
-
-
-END SUBROUTINE error_output
- 
-      SUBROUTINE wscal(n, alpha, x, incx)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
-!     constant times a vector: x(1:N) <- Alpha*x(1:N) 
-!     only for incX=incY=1
-!     after BLAS
-!     replace this by the function from the optimized BLAS implementation:
-!         CALL SSCAL(N,Alpha,X,1) or  CALL DSCAL(N,Alpha,X,1)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
-
-      INTEGER  :: i, incx, m, mp1, n
-      REAL(kind=dp) :: x(n), alpha
-      REAL(kind=dp), PARAMETER  :: zero=0.0_dp, one=1.0_dp
-!  
-! Following line is just to avoid compiler message about unused variables
-   IF ( incx == 0 )  CONTINUE
-
-      IF (alpha .eq. one)RETURN
-      IF (n .le. 0)RETURN
-
-      m = mod(n, 5)
-      IF ( m .ne. 0)THEN
-        IF (alpha .eq. (- one))THEN
-          DO i = 1, m
-            x(i) = - x(i)
-          ENDDO
-        ELSEIF (alpha .eq. zero)THEN
-          DO i = 1, m
-            x(i) = zero
-          ENDDO
-        ELSE
-          DO i = 1, m
-            x(i) = alpha* x(i)
-          ENDDO
-        ENDIF
-        IF ( n .lt. 5)RETURN
-      ENDIF
-      mp1 = m + 1
-      IF (alpha .eq. (- one))THEN
-        DO i = mp1, n, 5
-          x(i)   = - x(i)
-          x(i + 1) = - x(i + 1)
-          x(i + 2) = - x(i + 2)
-          x(i + 3) = - x(i + 3)
-          x(i + 4) = - x(i + 4)
-        ENDDO
-      ELSEIF (alpha .eq. zero)THEN
-        DO i = mp1, n, 5
-          x(i)   = zero
-          x(i + 1) = zero
-          x(i + 2) = zero
-          x(i + 3) = zero
-          x(i + 4) = zero
-        ENDDO
-      ELSE
-        DO i = mp1, n, 5
-          x(i)   = alpha* x(i)
-          x(i + 1) = alpha* x(i + 1)
-          x(i + 2) = alpha* x(i + 2)
-          x(i + 3) = alpha* x(i + 3)
-          x(i + 4) = alpha* x(i + 4)
-        ENDDO
-      ENDIF
-
-      END SUBROUTINE wscal
- 
-      SUBROUTINE waxpy(n, alpha, x, incx, y, incy)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
-!     constant times a vector plus a vector: y <- y + Alpha*x
-!     only for incX=incY=1
-!     after BLAS
-!     replace this by the function from the optimized BLAS implementation:
-!         CALL SAXPY(N,Alpha,X,1,Y,1) or  CALL DAXPY(N,Alpha,X,1,Y,1)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
-
-      INTEGER  :: i, incx, incy, m, mp1, n
-      REAL(kind=dp):: x(n), y(n), alpha
-      REAL(kind=dp), PARAMETER :: zero = 0.0_dp
-
-!  
-! Following line is just to avoid compiler message about unused variables
-   IF ( incx == 0  .OR.  incy == 0 )  CONTINUE
-      IF (alpha .eq. zero)RETURN
-      IF (n .le. 0)RETURN
-
-      m = mod(n, 4)
-      IF ( m .ne. 0)THEN
-        DO i = 1, m
-          y(i) = y(i) + alpha* x(i)
-        ENDDO
-        IF ( n .lt. 4)RETURN
-      ENDIF
-      mp1 = m + 1
-      DO i = mp1, n, 4
-        y(i) = y(i) + alpha* x(i)
-        y(i + 1) = y(i + 1) + alpha* x(i + 1)
-        y(i + 2) = y(i + 2) + alpha* x(i + 2)
-        y(i + 3) = y(i + 3) + alpha* x(i + 3)
-      ENDDO
-      
-      END SUBROUTINE waxpy
- 
-SUBROUTINE rosenbrock(n, y, tstart, tend, &
-           abstol, reltol,             &
-           rcntrl, icntrl, rstatus, istatus, ierr)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
-!
-!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
-!     T_i = t0 + Alpha(i)*H
-!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
-!     G *K_i = Fun( T_i,Y_i)+ \sum_{j=1}^S C(i,j)/H *K_j +
-!         gamma(i)*dF/dT(t0,Y0)
-!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
-!
-!    For details on Rosenbrock methods and their implementation consult:
-!      E. Hairer and G. Wanner
-!      "Solving ODEs II. Stiff and differential-algebraic problems".
-!      Springer series in computational mathematics,Springer-Verlag,1996.
-!    The codes contained in the book inspired this implementation.
-!
-!    (C)  Adrian Sandu,August 2004
-!    Virginia Polytechnic Institute and State University
-!    Contact: sandu@cs.vt.edu
-!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  
-!    This implementation is part of KPP - the Kinetic PreProcessor
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>   input arguments:
-!
-!-     y(n)  = vector of initial conditions (at t=tstart)
-!-    [tstart, tend]  = time range of integration
-!     (if Tstart>Tend the integration is performed backwards in time)
-!-    reltol, abstol = user precribed accuracy
-!- SUBROUTINE  fun( t, y, ydot) = ode FUNCTION, 
-!                       returns Ydot = Y' = F(T,Y)
-!- SUBROUTINE  jac( t, y, jcb) = jacobian of the ode FUNCTION, 
-!                       returns Jcb = dFun/dY
-!-    icntrl(1:20)  = INTEGER inputs PARAMETERs
-!-    rcntrl(1:20)  = REAL inputs PARAMETERs
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>     output arguments:
-!
-!-    y(n)  - > vector of final states (at t- >tend)
-!-    istatus(1:20) - > INTEGER output PARAMETERs
-!-    rstatus(1:20) - > REAL output PARAMETERs
-!-    ierr            - > job status upon RETURN
-!                        success (positive value) or
-!                        failure (negative value)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>     input PARAMETERs:
-!
-!    Note: For input parameters equal to zero the default values of the
-!       corresponding variables are used.
-!
-!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
-!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
-!
-!    ICNTRL(2) = 0: AbsTol,RelTol are N-dimensional vectors
-!              = 1: AbsTol,RelTol are scalars
-!
-!    ICNTRL(3)  -> selection of a particular Rosenbrock method
-!        = 0 :    Rodas3 (default)
-!        = 1 :    Ros2
-!        = 2 :    Ros3
-!        = 3 :    Ros4
-!        = 4 :    Rodas3
-!        = 5 :    Rodas4
-!
-!    ICNTRL(4)  -> maximum number of integration steps
-!        For ICNTRL(4) =0) the default value of 100000 is used
-!
-!    RCNTRL(1)  -> Hmin,lower bound for the integration step size
-!          It is strongly recommended to keep Hmin = ZERO
-!    RCNTRL(2)  -> Hmax,upper bound for the integration step size
-!    RCNTRL(3)  -> Hstart,starting value for the integration step size
-!
-!    RCNTRL(4)  -> FacMin,lower bound on step decrease factor (default=0.2)
-!    RCNTRL(5)  -> FacMax,upper bound on step increase factor (default=6)
-!    RCNTRL(6)  -> FacRej,step decrease factor after multiple rejections
-!                          (default=0.1)
-!    RCNTRL(7)  -> FacSafe,by which the new step is slightly smaller
-!         than the predicted value  (default=0.9)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!
-!    OUTPUT ARGUMENTS:
-!    -----------------
-!
-!    T           -> T value for which the solution has been computed
-!                     (after successful return T=Tend).
-!
-!    Y(N)        -> Numerical solution at T
-!
-!    IDID        -> Reports on successfulness upon return:
-!                    = 1 for success
-!                    < 0 for error (value equals error code)
-!
-!    ISTATUS(1)  -> No. of function calls
-!    ISTATUS(2)  -> No. of jacobian calls
-!    ISTATUS(3)  -> No. of steps
-!    ISTATUS(4)  -> No. of accepted steps
-!    ISTATUS(5)  -> No. of rejected steps (except at very beginning)
-!    ISTATUS(6)  -> No. of LU decompositions
-!    ISTATUS(7)  -> No. of forward/backward substitutions
-!    ISTATUS(8)  -> No. of singular matrix decompositions
-!
-!    RSTATUS(1)  -> Texit,the time corresponding to the
-!                     computed Y upon return
-!    RSTATUS(2)  -> Hexit,last accepted step before exit
-!    RSTATUS(3)  -> Hnew,last predicted step (not yet taken)
-!                   For multiple restarts,use Hnew as Hstart 
-!                     in the subsequent run
-!
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-!~~~>  arguments
-   INTEGER,      INTENT(IN)  :: n
-   REAL(kind=dp), INTENT(INOUT):: y(n)
-   REAL(kind=dp), INTENT(IN)  :: tstart, tend
-   REAL(kind=dp), INTENT(IN)  :: abstol(n), reltol(n)
-   INTEGER,      INTENT(IN)  :: icntrl(20)
-   REAL(kind=dp), INTENT(IN)  :: rcntrl(20)
-   INTEGER,      INTENT(INOUT):: istatus(20)
-   REAL(kind=dp), INTENT(INOUT):: rstatus(20)
-   INTEGER, INTENT(OUT) :: ierr
-!~~~>  PARAMETERs of the rosenbrock method, up to 6 stages
-   INTEGER ::  ros_s, rosmethod
-   INTEGER, PARAMETER :: rs2=1, rs3=2, rs4=3, rd3=4, rd4=5, rg3=6
-   REAL(kind=dp):: ros_a(15), ros_c(15), ros_m(6), ros_e(6), &
-                    ros_alpha(6), ros_gamma(6), ros_elo
-   LOGICAL :: ros_newf(6)
-   CHARACTER(len=12):: ros_name
-!~~~>  local variables
-   REAL(kind=dp):: roundoff, facmin, facmax, facrej, facsafe
-   REAL(kind=dp):: hmin, hmax, hstart
-   REAL(kind=dp):: texit
-   INTEGER       :: i, uplimtol, max_no_steps
-   LOGICAL       :: autonomous, vectortol
-!~~~>   PARAMETERs
-   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
-   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
-
-!~~~>  initialize statistics
-   istatus(1:8) = 0
-   rstatus(1:3) = zero
-
-!~~~>  autonomous or time dependent ode. default is time dependent.
-   autonomous = .not.(icntrl(1) == 0)
-
-!~~~>  for scalar tolerances (icntrl(2).ne.0) the code uses abstol(1)and reltol(1)
-!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:N) and RelTol(1:N)
-   IF (icntrl(2) == 0)THEN
-      vectortol = .TRUE.
-      uplimtol  = n
-   ELSE
-      vectortol = .FALSE.
-      uplimtol  = 1
-   ENDIF
-
-!~~~>   initialize the particular rosenbrock method selected
-   select CASE (icntrl(3))
-     CASE (1)
-       CALL ros2
-     CASE (2)
-       CALL ros3
-     CASE (3)
-       CALL ros4
-     CASE (0, 4)
-       CALL rodas3
-     CASE (5)
-       CALL rodas4
-     CASE (6)
-       CALL rang3
-     CASE default
-       PRINT *,'Unknown Rosenbrock method: ICNTRL(3) =',ICNTRL(3) 
-       CALL ros_errormsg(- 2, tstart, zero, ierr)
-       RETURN
-   END select
-
-!~~~>   the maximum number of steps admitted
-   IF (icntrl(4) == 0)THEN
-      max_no_steps = 200000
-   ELSEIF (icntrl(4)> 0)THEN
-      max_no_steps=icntrl(4)
-   ELSE
-      PRINT *,'User-selected max no. of steps: ICNTRL(4) =',ICNTRL(4)
-      CALL ros_errormsg(- 1, tstart, zero, ierr)
-      RETURN
-   ENDIF
-
-!~~~>  unit roundoff (1+ roundoff>1)
-   roundoff = epsilon(one)
-
-!~~~>  lower bound on the step size: (positive value)
-   IF (rcntrl(1) == zero)THEN
-      hmin = zero
-   ELSEIF (rcntrl(1)> zero)THEN
-      hmin = rcntrl(1)
-   ELSE
-      PRINT *,'User-selected Hmin: RCNTRL(1) =',RCNTRL(1)
-      CALL ros_errormsg(- 3, tstart, zero, ierr)
-      RETURN
-   ENDIF
-!~~~>  upper bound on the step size: (positive value)
-   IF (rcntrl(2) == zero)THEN
-      hmax = abs(tend-tstart)
-   ELSEIF (rcntrl(2)> zero)THEN
-      hmax = min(abs(rcntrl(2)), abs(tend-tstart))
-   ELSE
-      PRINT *,'User-selected Hmax: RCNTRL(2) =',RCNTRL(2)
-      CALL ros_errormsg(- 3, tstart, zero, ierr)
-      RETURN
-   ENDIF
-!~~~>  starting step size: (positive value)
-   IF (rcntrl(3) == zero)THEN
-      hstart = max(hmin, deltamin)
-   ELSEIF (rcntrl(3)> zero)THEN
-      hstart = min(abs(rcntrl(3)), abs(tend-tstart))
-   ELSE
-      PRINT *,'User-selected Hstart: RCNTRL(3) =',RCNTRL(3)
-      CALL ros_errormsg(- 3, tstart, zero, ierr)
-      RETURN
-   ENDIF
-!~~~>  step size can be changed s.t.  facmin < hnew/hold < facmax
-   IF (rcntrl(4) == zero)THEN
-      facmin = 0.2_dp
-   ELSEIF (rcntrl(4)> zero)THEN
-      facmin = rcntrl(4)
-   ELSE
-      PRINT *,'User-selected FacMin: RCNTRL(4) =',RCNTRL(4)
-      CALL ros_errormsg(- 4, tstart, zero, ierr)
-      RETURN
-   ENDIF
-   IF (rcntrl(5) == zero)THEN
-      facmax = 6.0_dp
-   ELSEIF (rcntrl(5)> zero)THEN
-      facmax = rcntrl(5)
-   ELSE
-      PRINT *,'User-selected FacMax: RCNTRL(5) =',RCNTRL(5)
-      CALL ros_errormsg(- 4, tstart, zero, ierr)
-      RETURN
-   ENDIF
-!~~~>   facrej: factor to decrease step after 2 succesive rejections
-   IF (rcntrl(6) == zero)THEN
-      facrej = 0.1_dp
-   ELSEIF (rcntrl(6)> zero)THEN
-      facrej = rcntrl(6)
-   ELSE
-      PRINT *,'User-selected FacRej: RCNTRL(6) =',RCNTRL(6)
-      CALL ros_errormsg(- 4, tstart, zero, ierr)
-      RETURN
-   ENDIF
-!~~~>   facsafe: safety factor in the computation of new step size
-   IF (rcntrl(7) == zero)THEN
-      facsafe = 0.9_dp
-   ELSEIF (rcntrl(7)> zero)THEN
-      facsafe = rcntrl(7)
-   ELSE
-      PRINT *,'User-selected FacSafe: RCNTRL(7) =',RCNTRL(7)
-      CALL ros_errormsg(- 4, tstart, zero, ierr)
-      RETURN
-   ENDIF
-!~~~>  check IF tolerances are reasonable
-    DO i=1, uplimtol
-      IF ((abstol(i)<= zero).or. (reltol(i)<= 10.0_dp* roundoff)&
-         .or. (reltol(i)>= 1.0_dp))THEN
-        PRINT *,' AbsTol(',i,') = ',AbsTol(i)
-        PRINT *,' RelTol(',i,') = ',RelTol(i)
-        CALL ros_errormsg(- 5, tstart, zero, ierr)
-        RETURN
-      ENDIF
-    ENDDO
-
-
-!~~~>  CALL rosenbrock method
-   CALL ros_integrator(y, tstart, tend, texit,  &
-        abstol, reltol,                         &
-!  Integration parameters
-        autonomous, vectortol, max_no_steps,    &
-        roundoff, hmin, hmax, hstart,           &
-        facmin, facmax, facrej, facsafe,        &
-!  Error indicator
-        ierr)
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-CONTAINS !  SUBROUTINEs internal to rosenbrock
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-   
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
- SUBROUTINE ros_errormsg(code, t, h, ierr)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
-!    Handles all error messages
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
-  
-   REAL(kind=dp), INTENT(IN):: t, h
-   INTEGER, INTENT(IN) :: code
-   INTEGER, INTENT(OUT):: ierr
-   
-   ierr = code
-   print * , &
-     'Forced exit from Rosenbrock due to the following error:' 
-     
-   select CASE (code)
-    CASE (- 1)  
-      PRINT *,'--> Improper value for maximal no of steps'
-    CASE (- 2)  
-      PRINT *,'--> Selected Rosenbrock method not implemented'
-    CASE (- 3)  
-      PRINT *,'--> Hmin/Hmax/Hstart must be positive'
-    CASE (- 4)  
-      PRINT *,'--> FacMin/FacMax/FacRej must be positive'
-    CASE (- 5)
-      PRINT *,'--> Improper tolerance values'
-    CASE (- 6)
-      PRINT *,'--> No of steps exceeds maximum bound'
-    CASE (- 7)
-      PRINT *,'--> Step size too small: T + 10*H = T',&
-            ' or H < Roundoff'
-    CASE (- 8)  
-      PRINT *,'--> Matrix is repeatedly singular'
-    CASE default
-      PRINT *,'Unknown Error code: ',Code
-   END select
-   
-   print * , "t=", t, "and h=", h
-     
- END SUBROUTINE ros_errormsg
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- SUBROUTINE ros_integrator (y, tstart, tend, t, &
-        abstol, reltol,                         &
-!~~~> integration PARAMETERs
-        autonomous, vectortol, max_no_steps,    &
-        roundoff, hmin, hmax, hstart,           &
-        facmin, facmax, facrej, facsafe,        &
-!~~~> error indicator
-        ierr)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!   Template for the implementation of a generic Rosenbrock method
-!      defined by ros_S (no of stages)
-!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-!~~~> input: the initial condition at tstart; output: the solution at t
-   REAL(kind=dp), INTENT(INOUT):: y(n)
-!~~~> input: integration interval
-   REAL(kind=dp), INTENT(IN):: tstart, tend
-!~~~> output: time at which the solution is RETURNed (t=tendIF success)
-   REAL(kind=dp), INTENT(OUT)::  t
-!~~~> input: tolerances
-   REAL(kind=dp), INTENT(IN)::  abstol(n), reltol(n)
-!~~~> input: integration PARAMETERs
-   LOGICAL, INTENT(IN):: autonomous, vectortol
-   REAL(kind=dp), INTENT(IN):: hstart, hmin, hmax
-   INTEGER, INTENT(IN):: max_no_steps
-   REAL(kind=dp), INTENT(IN):: roundoff, facmin, facmax, facrej, facsafe
-!~~~> output: error indicator
-   INTEGER, INTENT(OUT):: ierr
-! ~~~~ Local variables
-   REAL(kind=dp):: ynew(n), fcn0(n), fcn(n)
-   REAL(kind=dp):: k(n* ros_s), dfdt(n)
-#ifdef full_algebra    
-   REAL(kind=dp):: jac0(n, n), ghimj(n, n)
-#else
-   REAL(kind=dp):: jac0(lu_nonzero), ghimj(lu_nonzero)
-#endif
-   REAL(kind=dp):: h, hnew, hc, hg, fac, tau
-   REAL(kind=dp):: err, yerr(n)
-   INTEGER :: pivot(n), direction, ioffset, j, istage
-   LOGICAL :: rejectlasth, rejectmoreh, singular
-!~~~>  local PARAMETERs
-   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
-   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
-!~~~>  locally called FUNCTIONs
-!    REAL(kind=dp) WLAMCH
-!    EXTERNAL WLAMCH
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-!~~~>  initial preparations
-   t = tstart
-   rstatus(nhexit) = zero
-   h = min( max(abs(hmin), abs(hstart)), abs(hmax))
-   IF (abs(h)<= 10.0_dp* roundoff)h = deltamin
-
-   IF (tend  >=  tstart)THEN
-     direction = + 1
-   ELSE
-     direction = - 1
-   ENDIF
-   h = direction* h
-
-   rejectlasth=.FALSE.
-   rejectmoreh=.FALSE.
-
-!~~~> time loop begins below
-
-timeloop: DO WHILE((direction > 0).and.((t- tend) + roundoff <= zero)&
-       .or. (direction < 0).and.((tend-t) + roundoff <= zero))
-
-   IF (istatus(nstp)> max_no_steps)THEN  ! too many steps
-      CALL ros_errormsg(- 6, t, h, ierr)
-      RETURN
-   ENDIF
-   IF (((t+ 0.1_dp* h) == t).or.(h <= roundoff))THEN  ! step size too small
-      CALL ros_errormsg(- 7, t, h, ierr)
-      RETURN
-   ENDIF
-
-!~~~>  limit h IF necessary to avoid going beyond tend
-   h = min(h, abs(tend-t))
-
-!~~~>   compute the FUNCTION at current time
-   CALL funtemplate(t, y, fcn0)
-   istatus(nfun) = istatus(nfun) + 1
-
-!~~~>  compute the FUNCTION derivative with respect to t
-   IF (.not.autonomous)THEN
-      CALL ros_funtimederivative(t, roundoff, y, &
-                fcn0, dfdt)
-   ENDIF
-
-!~~~>   compute the jacobian at current time
-   CALL jactemplate(t, y, jac0)
-   istatus(njac) = istatus(njac) + 1
-
-!~~~>  repeat step calculation until current step accepted
-untilaccepted: do
-
-   CALL ros_preparematrix(h, direction, ros_gamma(1), &
-          jac0, ghimj, pivot, singular)
-   IF (singular)THEN ! more than 5 consecutive failed decompositions
-       CALL ros_errormsg(- 8, t, h, ierr)
-       RETURN
-   ENDIF
-
-!~~~>   compute the stages
-stage: DO istage = 1, ros_s
-
-      ! current istage offset. current istage vector is k(ioffset+ 1:ioffset+ n)
-       ioffset = n* (istage-1)
-
-      ! for the 1st istage the FUNCTION has been computed previously
-       IF (istage == 1)THEN
-         !slim: CALL wcopy(n, fcn0, 1, fcn, 1)
-       fcn(1:n) = fcn0(1:n)
-      ! istage>1 and a new FUNCTION evaluation is needed at the current istage
-       ELSEIF(ros_newf(istage))THEN
-         !slim: CALL wcopy(n, y, 1, ynew, 1)
-       ynew(1:n) = y(1:n)
-         DO j = 1, istage-1
-           CALL waxpy(n, ros_a((istage-1) * (istage-2) /2+ j), &
-            k(n* (j- 1) + 1), 1, ynew, 1)
-         ENDDO
-         tau = t + ros_alpha(istage) * direction* h
-         CALL funtemplate(tau, ynew, fcn)
-         istatus(nfun) = istatus(nfun) + 1
-       ENDIF ! IF istage == 1 ELSEIF ros_newf(istage)
-       !slim: CALL wcopy(n, fcn, 1, k(ioffset+ 1), 1)
-       k(ioffset+ 1:ioffset+ n) = fcn(1:n)
-       DO j = 1, istage-1
-         hc = ros_c((istage-1) * (istage-2) /2+ j) /(direction* h)
-         CALL waxpy(n, hc, k(n* (j- 1) + 1), 1, k(ioffset+ 1), 1)
-       ENDDO
-       IF ((.not. autonomous).and.(ros_gamma(istage).ne.zero))THEN
-         hg = direction* h* ros_gamma(istage)
-         CALL waxpy(n, hg, dfdt, 1, k(ioffset+ 1), 1)
-       ENDIF
-       CALL ros_solve(ghimj, pivot, k(ioffset+ 1))
-
-   END DO stage
-
-
-!~~~>  compute the new solution
-   !slim: CALL wcopy(n, y, 1, ynew, 1)
-   ynew(1:n) = y(1:n)
-   DO j=1, ros_s
-         CALL waxpy(n, ros_m(j), k(n* (j- 1) + 1), 1, ynew, 1)
-   ENDDO
-
-!~~~>  compute the error estimation
-   !slim: CALL wscal(n, zero, yerr, 1)
-   yerr(1:n) = zero
-   DO j=1, ros_s
-        CALL waxpy(n, ros_e(j), k(n* (j- 1) + 1), 1, yerr, 1)
-   ENDDO
-   err = ros_errornorm(y, ynew, yerr, abstol, reltol, vectortol)
-
-!~~~> new step size is bounded by facmin <= hnew/h <= facmax
-   fac  = min(facmax, max(facmin, facsafe/err** (one/ros_elo)))
-   hnew = h* fac
-
-!~~~>  check the error magnitude and adjust step size
-   istatus(nstp) = istatus(nstp) + 1
-   IF ((err <= one).or.(h <= hmin))THEN  !~~~> accept step
-      istatus(nacc) = istatus(nacc) + 1
-      !slim: CALL wcopy(n, ynew, 1, y, 1)
-      y(1:n) = ynew(1:n)
-      t = t + direction* h
-      hnew = max(hmin, min(hnew, hmax))
-      IF (rejectlasth)THEN  ! no step size increase after a rejected step
-         hnew = min(hnew, h)
-      ENDIF
-      rstatus(nhexit) = h
-      rstatus(nhnew) = hnew
-      rstatus(ntexit) = t
-      rejectlasth = .FALSE.
-      rejectmoreh = .FALSE.
-      h = hnew
-      exit untilaccepted ! exit the loop: WHILE step not accepted
-   ELSE           !~~~> reject step
-      IF (rejectmoreh)THEN
-         hnew = h* facrej
-      ENDIF
-      rejectmoreh = rejectlasth
-      rejectlasth = .TRUE.
-      h = hnew
-      IF (istatus(nacc)>= 1) istatus(nrej) = istatus(nrej) + 1
-   ENDIF ! err <= 1
-
-   END DO untilaccepted
-
-   END DO timeloop
-
-!~~~> succesful exit
-   ierr = 1  !~~~> the integration was successful
-
-  END SUBROUTINE ros_integrator
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  REAL(kind=dp)FUNCTION ros_errornorm(y, ynew, yerr, &
-                               abstol, reltol, vectortol)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!~~~> computes the "scaled norm" of the error vector yerr
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-! Input arguments
-   REAL(kind=dp), INTENT(IN):: y(n), ynew(n), &
-          yerr(n), abstol(n), reltol(n)
-   LOGICAL, INTENT(IN)::  vectortol
-! Local variables
-   REAL(kind=dp):: err, scale, ymax
-   INTEGER  :: i
-   REAL(kind=dp), PARAMETER :: zero = 0.0_dp
-
-   err = zero
-   DO i=1, n
-     ymax = max(abs(y(i)), abs(ynew(i)))
-     IF (vectortol)THEN
-       scale = abstol(i) + reltol(i) * ymax
-     ELSE
-       scale = abstol(1) + reltol(1) * ymax
-     ENDIF
-     err = err+ (yerr(i) /scale) ** 2
-   ENDDO
-   err  = sqrt(err/n)
-
-   ros_errornorm = max(err, 1.0d-10)
-
-  END FUNCTION ros_errornorm
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros_funtimederivative(t, roundoff, y, &
-                fcn0, dfdt)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!~~~> the time partial derivative of the FUNCTION by finite differences
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-!~~~> input arguments
-   REAL(kind=dp), INTENT(IN):: t, roundoff, y(n), fcn0(n)
-!~~~> output arguments
-   REAL(kind=dp), INTENT(OUT):: dfdt(n)
-!~~~> local variables
-   REAL(kind=dp):: delta
-   REAL(kind=dp), PARAMETER :: one = 1.0_dp, deltamin = 1.0e-6_dp
-
-   delta = sqrt(roundoff) * max(deltamin, abs(t))
-   CALL funtemplate(t+ delta, y, dfdt)
-   istatus(nfun) = istatus(nfun) + 1
-   CALL waxpy(n, (- one), fcn0, 1, dfdt, 1)
-   CALL wscal(n, (one/delta), dfdt, 1)
-
-  END SUBROUTINE ros_funtimederivative
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros_preparematrix(h, direction, gam, &
-             jac0, ghimj, pivot, singular)
-! --- --- --- --- --- --- --- --- --- --- --- --- ---
-!  Prepares the LHS matrix for stage calculations
-!  1.  Construct Ghimj = 1/(H*ham) - Jac0
-!      "(Gamma H) Inverse Minus Jacobian"
-!  2.  Repeat LU decomposition of Ghimj until successful.
-!       -half the step size if LU decomposition fails and retry
-!       -exit after 5 consecutive fails
-! --- --- --- --- --- --- --- --- --- --- --- --- ---
-
-!~~~> input arguments
-#ifdef full_algebra    
-   REAL(kind=dp), INTENT(IN)::  jac0(n, n)
-#else
-   REAL(kind=dp), INTENT(IN)::  jac0(lu_nonzero)
-#endif   
-   REAL(kind=dp), INTENT(IN)::  gam
-   INTEGER, INTENT(IN)::  direction
-!~~~> output arguments
-#ifdef full_algebra    
-   REAL(kind=dp), INTENT(OUT):: ghimj(n, n)
-#else
-   REAL(kind=dp), INTENT(OUT):: ghimj(lu_nonzero)
-#endif   
-   LOGICAL, INTENT(OUT)::  singular
-   INTEGER, INTENT(OUT)::  pivot(n)
-!~~~> inout arguments
-   REAL(kind=dp), INTENT(INOUT):: h   ! step size is decreased when lu fails
-!~~~> local variables
-   INTEGER  :: i, ising, nconsecutive
-   REAL(kind=dp):: ghinv
-   REAL(kind=dp), PARAMETER :: one  = 1.0_dp, half = 0.5_dp
-
-   nconsecutive = 0
-   singular = .TRUE.
-
-   DO WHILE (singular)
-
-!~~~>    construct ghimj = 1/(h* gam) - jac0
-#ifdef full_algebra    
-     !slim: CALL wcopy(n* n, jac0, 1, ghimj, 1)
-     !slim: CALL wscal(n* n, (- one), ghimj, 1)
-     ghimj = - jac0
-     ghinv = one/(direction* h* gam)
-     DO i=1, n
-       ghimj(i, i) = ghimj(i, i) + ghinv
-     ENDDO
-#else
-     !slim: CALL wcopy(lu_nonzero, jac0, 1, ghimj, 1)
-     !slim: CALL wscal(lu_nonzero, (- one), ghimj, 1)
-     ghimj(1:lu_nonzero) = - jac0(1:lu_nonzero)
-     ghinv = one/(direction* h* gam)
-     DO i=1, n
-       ghimj(lu_diag(i)) = ghimj(lu_diag(i)) + ghinv
-     ENDDO
-#endif   
-!~~~>    compute lu decomposition
-     CALL ros_decomp( ghimj, pivot, ising)
-     IF (ising == 0)THEN
-!~~~>    IF successful done
-        singular = .FALSE.
-     ELSE ! ising .ne. 0
-!~~~>    IF unsuccessful half the step size; IF 5 consecutive fails THEN RETURN
-        istatus(nsng) = istatus(nsng) + 1
-        nconsecutive = nconsecutive+1
-        singular = .TRUE.
-        PRINT*,'Warning: LU Decomposition returned ISING = ',ISING
-        IF (nconsecutive <= 5)THEN ! less than 5 consecutive failed decompositions
-           h = h* half
-        ELSE  ! more than 5 consecutive failed decompositions
-           RETURN
-        ENDIF  ! nconsecutive
-      ENDIF    ! ising
-
-   END DO ! WHILE singular
-
-  END SUBROUTINE ros_preparematrix
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros_decomp( a, pivot, ising)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!  Template for the LU decomposition
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!~~~> inout variables
-#ifdef full_algebra    
-   REAL(kind=dp), INTENT(INOUT):: a(n, n)
-#else   
-   REAL(kind=dp), INTENT(INOUT):: a(lu_nonzero)
-#endif
-!~~~> output variables
-   INTEGER, INTENT(OUT):: pivot(n), ising
-
-#ifdef full_algebra    
-   CALL  dgetrf( n, n, a, n, pivot, ising)
-#else   
-   CALL kppdecomp(a, ising)
-   pivot(1) = 1
-#endif
-   istatus(ndec) = istatus(ndec) + 1
-
-  END SUBROUTINE ros_decomp
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros_solve( a, pivot, b)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!  Template for the forward/backward substitution (using pre-computed LU decomposition)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!~~~> input variables
-#ifdef full_algebra    
-   REAL(kind=dp), INTENT(IN):: a(n, n)
-   INTEGER :: ising
-#else   
-   REAL(kind=dp), INTENT(IN):: a(lu_nonzero)
-#endif
-   INTEGER, INTENT(IN):: pivot(n)
-!~~~> inout variables
-   REAL(kind=dp), INTENT(INOUT):: b(n)
-!  
-! Following line is just to avoid compiler message about unused variables
-   IF ( pivot(1) == 0 )  CONTINUE
-
-#ifdef full_algebra    
-   CALL  DGETRS( 'N',N ,1,A,N,Pivot,b,N,ISING)
-   IF (info < 0)THEN
-      print* , "error in dgetrs. ising=", ising
-   ENDIF  
-#else   
-   CALL kppsolve( a, b)
-#endif
-
-   istatus(nsol) = istatus(nsol) + 1
-
-  END SUBROUTINE ros_solve
-
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros2
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! --- AN L-STABLE METHOD,2 stages,order 2
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-   double precision g
-
-    g = 1.0_dp + 1.0_dp/sqrt(2.0_dp)
-    rosmethod = rs2
-!~~~> name of the method
-    ros_Name = 'ROS-2'
-!~~~> number of stages
-    ros_s = 2
-
-!~~~> the coefficient matrices a and c are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
-
-    ros_a(1) = (1.0_dp) /g
-    ros_c(1) = (- 2.0_dp) /g
-!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-    ros_newf(1) = .TRUE.
-    ros_newf(2) = .TRUE.
-!~~~> m_i = coefficients for new step solution
-    ros_m(1) = (3.0_dp) /(2.0_dp* g)
-    ros_m(2) = (1.0_dp) /(2.0_dp* g)
-! E_i = Coefficients for error estimator
-    ros_e(1) = 1.0_dp/(2.0_dp* g)
-    ros_e(2) = 1.0_dp/(2.0_dp* g)
-!~~~> ros_elo = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus one
-    ros_elo = 2.0_dp
-!~~~> y_stage_i ~ y( t + h* alpha_i)
-    ros_alpha(1) = 0.0_dp
-    ros_alpha(2) = 1.0_dp
-!~~~> gamma_i = \sum_j  gamma_{i, j}
-    ros_gamma(1) = g
-    ros_gamma(2) = -g
-
- END SUBROUTINE ros2
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros3
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! --- AN L-STABLE METHOD,3 stages,order 3,2 function evaluations
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-   rosmethod = rs3
-!~~~> name of the method
-   ros_Name = 'ROS-3'
-!~~~> number of stages
-   ros_s = 3
-
-!~~~> the coefficient matrices a and c are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
-
-   ros_a(1) = 1.0_dp
-   ros_a(2) = 1.0_dp
-   ros_a(3) = 0.0_dp
-
-   ros_c(1) = - 0.10156171083877702091975600115545e+01_dp
-   ros_c(2) =  0.40759956452537699824805835358067e+01_dp
-   ros_c(3) =  0.92076794298330791242156818474003e+01_dp
-!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-   ros_newf(1) = .TRUE.
-   ros_newf(2) = .TRUE.
-   ros_newf(3) = .FALSE.
-!~~~> m_i = coefficients for new step solution
-   ros_m(1) =  0.1e+01_dp
-   ros_m(2) =  0.61697947043828245592553615689730e+01_dp
-   ros_m(3) = - 0.42772256543218573326238373806514_dp
-! E_i = Coefficients for error estimator
-   ros_e(1) =  0.5_dp
-   ros_e(2) = - 0.29079558716805469821718236208017e+01_dp
-   ros_e(3) =  0.22354069897811569627360909276199_dp
-!~~~> ros_elo = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus 1
-   ros_elo = 3.0_dp
-!~~~> y_stage_i ~ y( t + h* alpha_i)
-   ros_alpha(1) = 0.0_dp
-   ros_alpha(2) = 0.43586652150845899941601945119356_dp
-   ros_alpha(3) = 0.43586652150845899941601945119356_dp
-!~~~> gamma_i = \sum_j  gamma_{i, j}
-   ros_gamma(1) = 0.43586652150845899941601945119356_dp
-   ros_gamma(2) = 0.24291996454816804366592249683314_dp
-   ros_gamma(3) = 0.21851380027664058511513169485832e+01_dp
-
-  END SUBROUTINE ros3
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros4
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!     L-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 4 STAGES
-!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
-!
-!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
-!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
-!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
-!      SPRINGER-VERLAG (1990)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-   rosmethod = rs4
-!~~~> name of the method
-   ros_Name = 'ROS-4'
-!~~~> number of stages
-   ros_s = 4
-
-!~~~> the coefficient matrices a and c are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
-
-   ros_a(1) = 0.2000000000000000e+01_dp
-   ros_a(2) = 0.1867943637803922e+01_dp
-   ros_a(3) = 0.2344449711399156_dp
-   ros_a(4) = ros_a(2)
-   ros_a(5) = ros_a(3)
-   ros_a(6) = 0.0_dp
-
-   ros_c(1) = -0.7137615036412310e+01_dp
-   ros_c(2) = 0.2580708087951457e+01_dp
-   ros_c(3) = 0.6515950076447975_dp
-   ros_c(4) = -0.2137148994382534e+01_dp
-   ros_c(5) = -0.3214669691237626_dp
-   ros_c(6) = -0.6949742501781779_dp
-!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-   ros_newf(1) = .TRUE.
-   ros_newf(2) = .TRUE.
-   ros_newf(3) = .TRUE.
-   ros_newf(4) = .FALSE.
-!~~~> m_i = coefficients for new step solution
-   ros_m(1) = 0.2255570073418735e+01_dp
-   ros_m(2) = 0.2870493262186792_dp
-   ros_m(3) = 0.4353179431840180_dp
-   ros_m(4) = 0.1093502252409163e+01_dp
-!~~~> e_i  = coefficients for error estimator
-   ros_e(1) = -0.2815431932141155_dp
-   ros_e(2) = -0.7276199124938920e-01_dp
-   ros_e(3) = -0.1082196201495311_dp
-   ros_e(4) = -0.1093502252409163e+01_dp
-!~~~> ros_elo  = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus 1
-   ros_elo  = 4.0_dp
-!~~~> y_stage_i ~ y( t + h* alpha_i)
-   ros_alpha(1) = 0.0_dp
-   ros_alpha(2) = 0.1145640000000000e+01_dp
-   ros_alpha(3) = 0.6552168638155900_dp
-   ros_alpha(4) = ros_alpha(3)
-!~~~> gamma_i = \sum_j  gamma_{i, j}
-   ros_gamma(1) = 0.5728200000000000_dp
-   ros_gamma(2) = -0.1769193891319233e+01_dp
-   ros_gamma(3) = 0.7592633437920482_dp
-   ros_gamma(4) = -0.1049021087100450_dp
-
-  END SUBROUTINE ros4
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE rodas3
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! --- A STIFFLY-STABLE METHOD,4 stages,order 3
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-   rosmethod = rd3
-!~~~> name of the method
-   ros_Name = 'RODAS-3'
-!~~~> number of stages
-   ros_s = 4
-
-!~~~> the coefficient matrices a and c are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
-
-   ros_a(1) = 0.0_dp
-   ros_a(2) = 2.0_dp
-   ros_a(3) = 0.0_dp
-   ros_a(4) = 2.0_dp
-   ros_a(5) = 0.0_dp
-   ros_a(6) = 1.0_dp
-
-   ros_c(1) = 4.0_dp
-   ros_c(2) = 1.0_dp
-   ros_c(3) = -1.0_dp
-   ros_c(4) = 1.0_dp
-   ros_c(5) = -1.0_dp
-   ros_c(6) = -(8.0_dp/3.0_dp)
-
-!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-   ros_newf(1) = .TRUE.
-   ros_newf(2) = .FALSE.
-   ros_newf(3) = .TRUE.
-   ros_newf(4) = .TRUE.
-!~~~> m_i = coefficients for new step solution
-   ros_m(1) = 2.0_dp
-   ros_m(2) = 0.0_dp
-   ros_m(3) = 1.0_dp
-   ros_m(4) = 1.0_dp
-!~~~> e_i  = coefficients for error estimator
-   ros_e(1) = 0.0_dp
-   ros_e(2) = 0.0_dp
-   ros_e(3) = 0.0_dp
-   ros_e(4) = 1.0_dp
-!~~~> ros_elo  = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus 1
-   ros_elo  = 3.0_dp
-!~~~> y_stage_i ~ y( t + h* alpha_i)
-   ros_alpha(1) = 0.0_dp
-   ros_alpha(2) = 0.0_dp
-   ros_alpha(3) = 1.0_dp
-   ros_alpha(4) = 1.0_dp
-!~~~> gamma_i = \sum_j  gamma_{i, j}
-   ros_gamma(1) = 0.5_dp
-   ros_gamma(2) = 1.5_dp
-   ros_gamma(3) = 0.0_dp
-   ros_gamma(4) = 0.0_dp
-
-  END SUBROUTINE rodas3
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE rodas4
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 6 STAGES
-!
-!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
-!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
-!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
-!      SPRINGER-VERLAG (1996)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-    rosmethod = rd4
-!~~~> name of the method
-    ros_Name = 'RODAS-4'
-!~~~> number of stages
-    ros_s = 6
-
-!~~~> y_stage_i ~ y( t + h* alpha_i)
-    ros_alpha(1) = 0.000_dp
-    ros_alpha(2) = 0.386_dp
-    ros_alpha(3) = 0.210_dp
-    ros_alpha(4) = 0.630_dp
-    ros_alpha(5) = 1.000_dp
-    ros_alpha(6) = 1.000_dp
-
-!~~~> gamma_i = \sum_j  gamma_{i, j}
-    ros_gamma(1) = 0.2500000000000000_dp
-    ros_gamma(2) = -0.1043000000000000_dp
-    ros_gamma(3) = 0.1035000000000000_dp
-    ros_gamma(4) = -0.3620000000000023e-01_dp
-    ros_gamma(5) = 0.0_dp
-    ros_gamma(6) = 0.0_dp
-
-!~~~> the coefficient matrices a and c are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
-!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
-!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
-
-    ros_a(1) = 0.1544000000000000e+01_dp
-    ros_a(2) = 0.9466785280815826_dp
-    ros_a(3) = 0.2557011698983284_dp
-    ros_a(4) = 0.3314825187068521e+01_dp
-    ros_a(5) = 0.2896124015972201e+01_dp
-    ros_a(6) = 0.9986419139977817_dp
-    ros_a(7) = 0.1221224509226641e+01_dp
-    ros_a(8) = 0.6019134481288629e+01_dp
-    ros_a(9) = 0.1253708332932087e+02_dp
-    ros_a(10) = -0.6878860361058950_dp
-    ros_a(11) = ros_a(7)
-    ros_a(12) = ros_a(8)
-    ros_a(13) = ros_a(9)
-    ros_a(14) = ros_a(10)
-    ros_a(15) = 1.0_dp
-
-    ros_c(1) = -0.5668800000000000e+01_dp
-    ros_c(2) = -0.2430093356833875e+01_dp
-    ros_c(3) = -0.2063599157091915_dp
-    ros_c(4) = -0.1073529058151375_dp
-    ros_c(5) = -0.9594562251023355e+01_dp
-    ros_c(6) = -0.2047028614809616e+02_dp
-    ros_c(7) = 0.7496443313967647e+01_dp
-    ros_c(8) = -0.1024680431464352e+02_dp
-    ros_c(9) = -0.3399990352819905e+02_dp
-    ros_c(10) = 0.1170890893206160e+02_dp
-    ros_c(11) = 0.8083246795921522e+01_dp
-    ros_c(12) = -0.7981132988064893e+01_dp
-    ros_c(13) = -0.3152159432874371e+02_dp
-    ros_c(14) = 0.1631930543123136e+02_dp
-    ros_c(15) = -0.6058818238834054e+01_dp
-
-!~~~> m_i = coefficients for new step solution
-    ros_m(1) = ros_a(7)
-    ros_m(2) = ros_a(8)
-    ros_m(3) = ros_a(9)
-    ros_m(4) = ros_a(10)
-    ros_m(5) = 1.0_dp
-    ros_m(6) = 1.0_dp
-
-!~~~> e_i  = coefficients for error estimator
-    ros_e(1) = 0.0_dp
-    ros_e(2) = 0.0_dp
-    ros_e(3) = 0.0_dp
-    ros_e(4) = 0.0_dp
-    ros_e(5) = 0.0_dp
-    ros_e(6) = 1.0_dp
-
-!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-    ros_newf(1) = .TRUE.
-    ros_newf(2) = .TRUE.
-    ros_newf(3) = .TRUE.
-    ros_newf(4) = .TRUE.
-    ros_newf(5) = .TRUE.
-    ros_newf(6) = .TRUE.
-
-!~~~> ros_elo  = estimator of local order - the minimum between the
-!        main and the embedded scheme orders plus 1
-    ros_elo = 4.0_dp
-
-  END SUBROUTINE rodas4
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE rang3
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! STIFFLY-STABLE W METHOD OF ORDER 3,WITH 4 STAGES
-!
-! J. RANG and L. ANGERMANN
-! NEW ROSENBROCK W-METHODS OF ORDER 3
-! FOR PARTIAL DIFFERENTIAL ALGEBRAIC
-!        EQUATIONS OF INDEX 1                                             
-! BIT Numerical Mathematics (2005) 45: 761-787
-!  DOI: 10.1007/s10543-005-0035-y
-! Table 4.1-4.2
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-    rosmethod = rg3
-!~~~> name of the method
-    ros_Name = 'RANG-3'
-!~~~> number of stages
-    ros_s = 4
-
-    ros_a(1) = 5.09052051067020d+00;
-    ros_a(2) = 5.09052051067020d+00;
-    ros_a(3) = 0.0d0;
-    ros_a(4) = 4.97628111010787d+00;
-    ros_a(5) = 2.77268164715849d-02;
-    ros_a(6) = 2.29428036027904d-01;
-
-    ros_c(1) = - 1.16790812312283d+01;
-    ros_c(2) = - 1.64057326467367d+01;
-    ros_c(3) = - 2.77268164715850d-01;
-    ros_c(4) = - 8.38103960500476d+00;
-    ros_c(5) = - 8.48328409199343d-01;
-    ros_c(6) =  2.87009860433106d-01;
-
-    ros_m(1) =  5.22582761233094d+00;
-    ros_m(2) = - 5.56971148154165d-01;
-    ros_m(3) =  3.57979469353645d-01;
-    ros_m(4) =  1.72337398521064d+00;
-
-    ros_e(1) = - 5.16845212784040d+00;
-    ros_e(2) = - 1.26351942603842d+00;
-    ros_e(3) = - 1.11022302462516d-16;
-    ros_e(4) =  2.22044604925031d-16;
-
-    ros_alpha(1) = 0.0d00;
-    ros_alpha(2) = 2.21878746765329d+00;
-    ros_alpha(3) = 2.21878746765329d+00;
-    ros_alpha(4) = 1.55392337535788d+00;
-
-    ros_gamma(1) =  4.35866521508459d-01;
-    ros_gamma(2) = - 1.78292094614483d+00;
-    ros_gamma(3) = - 2.46541900496934d+00;
-    ros_gamma(4) = - 8.05529997906370d-01;
-
-
-!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-    ros_newf(1) = .TRUE.
-    ros_newf(2) = .TRUE.
-    ros_newf(3) = .TRUE.
-    ros_newf(4) = .TRUE.
-
-!~~~> ros_elo  = estimator of local order - the minimum between the
-!        main and the embedded scheme orders plus 1
-    ros_elo = 3.0_dp
-
-  END SUBROUTINE rang3
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!   End of the set of internal Rosenbrock subroutines
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-END SUBROUTINE rosenbrock
- 
-SUBROUTINE funtemplate( t, y, ydot)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!  Template for the ODE function call.
-!  Updates the rate coefficients (and possibly the fixed species) at each call
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!~~~> input variables
-   REAL(kind=dp):: t, y(nvar)
-!~~~> output variables
-   REAL(kind=dp):: ydot(nvar)
-!~~~> local variables
-   REAL(kind=dp):: told
-
-   told = time
-   time = t
-   CALL fun( y, fix, rconst, ydot)
-   time = told
-
-END SUBROUTINE funtemplate
- 
-SUBROUTINE jactemplate( t, y, jcb)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!  Template for the ODE Jacobian call.
-!  Updates the rate coefficients (and possibly the fixed species) at each call
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!~~~> input variables
-    REAL(kind=dp):: t, y(nvar)
-!~~~> output variables
-#ifdef full_algebra    
-    REAL(kind=dp):: jv(lu_nonzero), jcb(nvar, nvar)
-#else
-    REAL(kind=dp):: jcb(lu_nonzero)
-#endif   
-!~~~> local variables
-    REAL(kind=dp):: told
-#ifdef full_algebra    
-    INTEGER :: i, j
-#endif   
-
-    told = time
-    time = t
-#ifdef full_algebra    
-    CALL jac_sp(y, fix, rconst, jv)
-    DO j=1, nvar
-      DO i=1, nvar
-         jcb(i, j) = 0.0_dp
-      ENDDO
-    ENDDO
-    DO i=1, lu_nonzero
-       jcb(lu_irow(i), lu_icol(i)) = jv(i)
-    ENDDO
-#else
-    CALL jac_sp( y, fix, rconst, jcb)
-#endif   
-    time = told
-
-END SUBROUTINE jactemplate
- 
-  SUBROUTINE kppdecomp( jvs, ier)                                    
-  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
-  !        sparse lu factorization                                    
-  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
-  ! loop expansion generated by kp4                                   
-                                                                      
-    INTEGER  :: ier                                                   
-    REAL(kind=dp):: jvs(lu_nonzero), a                         
-                                                                      
-    a = 0.                                                            
-    ier = 0                                                           
-                                                                      
-!   i = 1
-!   i = 2
-!   i = 3
-    jvs(5) = (jvs(5)) / jvs(2) 
-    jvs(6) = jvs(6) - jvs(3) * jvs(5)
-    jvs(7) = jvs(7) - jvs(4) * jvs(5)
-!   i = 4
-    jvs(8) = (jvs(8)) / jvs(2) 
-    a = 0.0; a = a  - jvs(3) * jvs(8)
-    jvs(9) = (jvs(9) + a) / jvs(6) 
-    jvs(10) = jvs(10) - jvs(4) * jvs(8) - jvs(7) * jvs(9)
-    RETURN                                                            
-                                                                      
-  END SUBROUTINE kppdecomp                                            
- 
-SUBROUTINE get_mechanism_name                                       
-                                                                    
-  IMPLICIT NONE                                                     
-
-! Set cs_mech for check with mechanism name from namelist
-    cs_mech = 'phstatp'
-                                                                    
-  RETURN                                                            
-END SUBROUTINE get_mechanism_name                                   
-                                                                    
- 
-SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, &
-                     icntrl_i, rcntrl_i) 
-                                                                    
-  IMPLICIT NONE                                                     
-                                                                    
-  REAL(dp), INTENT(IN)                  :: time_step_len           
-  REAL(dp), DIMENSION(:, :), INTENT(INOUT) :: conc                    
-  REAL(dp), DIMENSION(:, :), INTENT(IN)   :: photo                   
-  REAL(dp), DIMENSION(:), INTENT(IN)     :: tempi                   
-  REAL(dp), DIMENSION(:), INTENT(IN)     :: qvapi                   
-  REAL(dp), DIMENSION(:), INTENT(IN)     :: fakti                   
-  INTEGER, INTENT(OUT), OPTIONAL        :: ierrf(:)               
-  INTEGER, INTENT(OUT), OPTIONAL        :: xnacc(:)               
-  INTEGER, INTENT(OUT), OPTIONAL        :: xnrej(:)               
-  INTEGER, INTENT(INOUT), OPTIONAL      :: istatus(:)             
-  INTEGER, INTENT(IN), OPTIONAL         :: pe                      
-  LOGICAL, INTENT(IN), OPTIONAL         :: l_debug                 
-  INTEGER, DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: icntrl_i         
-  REAL(dp), DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: rcntrl_i         
-                                                                    
-  INTEGER                                 :: k   ! loop variable     
-  REAL(dp)                               :: dt                      
-  INTEGER, DIMENSION(20)                :: istatus_u               
-  INTEGER                                :: ierr_u                  
-  INTEGER                                :: vl_dim_lo               
-                                                                    
-                                                                    
-  IF (PRESENT (istatus)) istatus = 0                             
-  IF (PRESENT (icntrl_i)) icntrl  = icntrl_i                      
-  IF (PRESENT (rcntrl_i)) rcntrl  = rcntrl_i                      
-                                                                    
-  var => c(1:nvar)                                                 
-                                                                    
-  vl_glo = size(tempi, 1)                                           
-                                                                    
-  vl_dim_lo = vl_dim                                                
-  DO k=1, vl_glo, vl_dim_lo                                           
-    is = k                                                          
-    ie = min(k+ vl_dim_lo-1, vl_glo)                                 
-    vl = ie-is+ 1                                                    
-                                                                    
-    c(:) = conc(is, :)                                            
-                                                                    
-    temp = tempi(is)                                             
-                                                                    
-    qvap = qvapi(is)                                             
-                                                                    
-    fakt = fakti(is)                                             
-                                                                    
-    CALL initialize                                                 
-                                                                    
-    phot(:) = photo(is, :)                                            
-                                                                    
-    CALL update_rconst                                              
-                                                                    
-    dt = time_step_len                                              
-                                                                    
-    ! integrate from t=0 to t=dt                                    
-    CALL integrate(0._dp, dt, icntrl, rcntrl, istatus_u = istatus_u, ierr_u=ierr_u)
-                                                                    
-                                                                    
-   IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       
-      IF (l_debug) CALL error_output(conc(is, :), ierr_u, pe)           
-   ENDIF                                                              
-                                                                      
-    conc(is, :) = c(:)                                                
-                                                                    
-    ! RETURN diagnostic information                                 
-                                                                    
-    IF (PRESENT(ierrf))   ierrf(is) = ierr_u                      
-    IF (PRESENT(xnacc))   xnacc(is) = istatus_u(4)               
-    IF (PRESENT(xnrej))   xnrej(is) = istatus_u(5)               
-                                                                    
-    IF (PRESENT (istatus)) THEN                                   
-      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                
-    ENDIF                                                          
-                                                                    
-  END DO                                                            
- 
-                                                                    
-! Deallocate input arrays                                           
-                                                                    
-                                                                    
-  data_loaded = .FALSE.                                             
-                                                                    
-  RETURN                                                            
-END SUBROUTINE chem_gasphase_integrate                              
-
-END MODULE chem_gasphase_mod
- 
Index: palm/trunk/SOURCE/chem_modules.f90
===================================================================
--- palm/trunk/SOURCE/chem_modules.f90	(revision 4901)
+++ 	(revision )
@@ -1,331 +1,0 @@
-!> @file chem_modules.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2018-2021 Leibniz Universitaet Hannover
-! Copyright 2018-2021 Karlsruhe Institute of Technology
-! Copyright 2018-2021 Freie Universitaet Berlin
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! removed unnecessarty namelist parameters
-!
-! 
-! 4828 2021-01-05 11:21:41Z Giersch
-! Enable output of vertical fluxes of chemical species.
-! 
-! 4577 2020-06-25 09:53:58Z raasch
-! further re-formatting concerning Fortran parameter variables
-!
-! 4559 2020-06-11 08:51:48Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4544 2020-05-21 14:43:05Z raasch
-! conc_av changed from pointer to allocatable array
-!
-! 4511 2020-04-30 12:20:40Z raasch
-! new variables for explicit settings of lateral boundary conditions introduced
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! added namelist flag 'emiss_read_legacy_mode' to allow concurrent functioning of new emission read
-! mode under development (ECC)
-!
-! 4273 2019-10-24 13:40:54Z monakurppa
-! Add logical switches nesting_chem and nesting_offline_chem (both .TRUE. by default)
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4110 2019-07-22 17:05:21Z suehring
-! +cs_advc_flags_s
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! - introduced namelist item chem_modules@emiss_lod as future
-! - replacement to chem_modules@mode_emis.  Currently keeping both for backward compatibility.
-!   chem_modules@mode_emis will be depreciated upon migration of all dependent modules (e.g., salsa)
-!   to chem_modules@emiss_lod
-!
-! (ecc) 20190513 replaced nspec_out with n_matched_vars
-!
-! 3877 2019-04-08 19:09:16Z knoop
-! Formatting, clean-up, clarified/corrected comments
-!
-! 3833 2019-03-28 15:04:04Z forkel
-! removed USE chem_gasphase_mod
-!
-! 3827 2019-03-27 17:20:32Z forkel
-! some formatting  and reordering (ecc)
-!
-! 3820 2019-03-27 11:53:41Z forkel
-! renamed do_emis to emissions_anthropogenic, removed USE statistics, variables sorted by type
-!
-! 3780 2019-03-05 11:19:45Z forkel
-! added cs_mech
-!
-! 3652 2019-01-07 15:29:59Z forkel
-! parameter chem_mechanism added (basit)
-!
-! 3282 2018-09-27 10:49:12Z basit
-! Initial revision
-!
-! Authors:
-! --------
-! @author Farah Kanani-Suehring
-! @author Basit Khan
-! @author Sabine Banzhaf
-! @author Emmanuele Russo
-! @author Edward C. Chan
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of global PALM-4U chemistry variables
-!--------------------------------------------------------------------------------------------------!
-!
- MODULE chem_modules
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    REAL, PARAMETER ::  xm_air   =   28.964e-3             !< air      molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_C     =   12.01115e-3           !< C        molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_Ca    =   40.07800e-3           !< Ca       molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_Cd    =  112.41000e-3           !< Cd       molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_Cl    =   35.45300e-3           !< Cl       molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_dummy = 1000.0e-3               !< dummy    molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_F     =   18.99840e-3           !< F        molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_H     =    1.00790e-3           !< H        molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_K     =   39.09800e-3           !< K        molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_Mg    =   24.30500e-3           !< Mg       molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_N     =   14.00670e-3           !< N        molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_Na    =   22.98977e-3           !< Na       molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_O     =   15.99940e-3           !< O        molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_Pb    =  207.20000e-3           !< Pb       molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_Pb210 =  210.00000e-3           !< Pb (210) molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_Rn222 =  222.00000e-3           !< Rn (222) molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_S     =   32.06400e-3           !< S        molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_CO2   = xm_C + xm_O * 2         !< CO2      molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_h2o   = xm_H * 2 + xm_O         !< H2O      molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_HNO3  = xm_H + xm_N + xm_O * 3  !< HNO3     molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_o3    = xm_O * 3                !< O3       molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_N2O5  = xm_N * 2 + xm_O * 5     !< N2O5     molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_NH4   = xm_N + xm_H * 4         !< NH4      molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_NO3   = xm_N + xm_O * 3         !< NO3      molecular weight (kg/mol)
-    REAL, PARAMETER ::  xm_SO4   = xm_S + xm_O * 4         !< SO4      molecular weight (kg/mol)
-
-    CHARACTER (LEN=20) ::  bc_cs_b        = 'dirichlet'         !< namelist parameter: surface
-                                                                !< boundary condition for concentration
-    CHARACTER (LEN=20) ::  bc_cs_l        = 'undefined'         !< left boundary condition
-    CHARACTER (LEN=20) ::  bc_cs_n        = 'undefined'         !< north boundary condition
-    CHARACTER (LEN=20) ::  bc_cs_r        = 'undefined'         !< right boundary condition
-    CHARACTER (LEN=20) ::  bc_cs_s        = 'undefined'         !< south boundary condition
-    CHARACTER (LEN=20) ::  bc_cs_t        = 'initial_gradient'  !< namelist parameter: top boudary
-                                                                !< condition for concentration
-    CHARACTER (LEN=30) ::  chem_mechanism = 'phstatp'           !< namelist parameter: chemistry
-                                                                !< mechanism
-    CHARACTER (LEN=80) ::  daytype_mdh    = 'workday'           !< namelist parameter: type of day
-                                                                !< - workday, weekend, holiday
-    CHARACTER (LEN=80) ::  mode_emis      = 'PARAMETERIZED'     !< namelist parameter: mode of
-                                                                !< chemistry emissions -
-                                                                !< DEFAULT, EXPERT, PARAMETERIZED
-    CHARACTER (LEN=10) ::  photolysis_scheme                    !< 'constant',
-                                                                !< 'simple' (Simple parameterisation from MCM,
-                                                                !< Saunders et al., 2003, Atmos. Chem. Phys., 3, 161-180
-                                                                !< 'fastj'  (Wild et al., 2000, J. Atmos. Chem., 37, 245-282)
-                                                                !< STILL NOT IMPLEMENTED
-    CHARACTER (LEN=80) ::  time_fac_type  = 'MDH'               !< namelist parameter: type of time treatment in the mode_emis
-                                                                !< DEFAULT - HOUR, MDH
-
-    CHARACTER (LEN=11), DIMENSION(99) ::  cs_name             = 'novalue'  !< namelist parameter:
-                                                                           !<names of species with given fluxes
-                                                                           !< (see csflux)
-    CHARACTER (LEN=11), DIMENSION(99) ::  cs_profile_name     = 'novalue'  !< namelist parameter:
-                                                                           !< tbc...???
-    CHARACTER (LEN=11), DIMENSION(99) ::  data_output_pr_cs   = 'novalue'  !< namelist parameter:
-                                                                           !< tbc...???
-    CHARACTER (LEN=11), DIMENSION(99) ::  surface_csflux_name = 'novalue'  !< namelist parameter:
-                                                                           !< tbc...???
-
-    INTEGER(iwp) ::  communicator_chem      !< stores the number of the MPI communicator to be used
-                                            !< for ghost layer data exchange
-                                            !< 1: cyclic, 2: cyclic along x, 3: cyclic along y,
-                                            !< 4: non-cyclic
-
-    INTEGER(iwp) ::  cs_pr_count_fl_res                    = 0      !< counter for vertical flux profiles of chemical species (resolved-scale)
-    INTEGER(iwp) ::  cs_pr_count_fl_sgs                    = 0      !< counter for vertical flux profiles of chemical species (SGS)
-    INTEGER(iwp) ::  cs_pr_count_sp                        = 0      !< counter for chemical species profiles
-    INTEGER(iwp) ::  cs_vertical_gradient_level_ind(99,10) = -9999  !< grid index values of
-                                                                    !< cs_vertical_gradient_level
-    INTEGER(iwp) ::  emiss_lod                             = -1     !< namelist parameter: chem emission LOD (same as mode_emis)
-                                                                    !< -1 = unassigned, 0 = parameterized, 1 = default,
-                                                                    !< 2 = pre-processed
-    INTEGER(iwp) ::  ibc_cs_b                                       !< integer flag for bc_cs_b
-    INTEGER(iwp) ::  ibc_cs_t                                       !< integer flag for bc_cs_t
-    INTEGER(iwp) ::  main_street_id                        = 0      !< namelist parameter: lower bound of main street IDs
-                                                                    !< (OpenStreetMaps) for PARAMETERIZED mode
-    INTEGER(iwp) ::  max_pr_cs                             = 0      !< number of chemistry profiles in output
-    INTEGER(iwp) ::  max_street_id                         = 0      !< namelist parameter: upper bound of main street IDs
-                                                                    !< (OpenStreetMaps) for PARAMETERIZED mode
-    INTEGER(iwp) ::  n_matched_vars                                 !< number of matched emissions
-                                                                    !< variables
-    INTEGER(iwp) ::  side_street_id                        = 0      !< namelist parameter: lower bound of side street IDs
-                                                                    !< (OpenStreetMaps) for PARAMETERIZED mode
-
-    INTEGER(iwp), DIMENSION(99) ::  cs_pr_index_sp      = 0 !< index for chemical species mean profiles
-    INTEGER(iwp), DIMENSION(99) ::  cs_pr_index_fl_res  = 0 !< index for chemical species sgs-flux profiles
-    INTEGER(iwp), DIMENSION(99) ::  cs_pr_index_fl_sgs  = 0 !< index for chemical species resolved-scale flux profiles
-    INTEGER(iwp), DIMENSION(99) ::  hom_index_fl_res    = 0 !< index of the resolved-scale flux profile with respect to the hom array
-    INTEGER(iwp), DIMENSION(99) ::  hom_index_fl_sgs    = 0 !< index of the SGS flux profile with respect to the hom array
-    INTEGER(iwp), DIMENSION(99) ::  hom_index_spec      = 0 !< index of the profile with respect to the hom array
-    INTEGER(iwp), DIMENSION(:)  ::  match_spec_nox(1:2)     !< results of matching the input and model's NOx
-    INTEGER(iwp), DIMENSION(:)  ::  match_spec_pm(1:3)      !< results of matching the input and model's PMs
-    INTEGER(iwp), DIMENSION(:)  ::  match_spec_sox(1:2)     !< results of matching the input and model's SOx!
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_spec_input      !< index of input chem species
-                                                                      !< for matching routine
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_spec_model      !< index of model chem species#
-                                                                      !< for matching routine
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_spec_voc_input  !< index of VOC input
-                                                                      !< components matching the model's VOCs
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_spec_voc_model  !< index of VOC model species
-                                                                      !< matching the input VOCs comp.
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE  ::  cs_advc_flags_s !< flags used to degrade order of advection scheme for
-                                                                     !< chemical species near walls and lateral boundaries
-
-    LOGICAL ::  bc_dirichlet_cs_l         = .FALSE.  !< flag for indicating a dirichlet condition at
-                                                     !< the left boundary
-    LOGICAL ::  bc_dirichlet_cs_n         = .FALSE.  !< flag for indicating a dirichlet condition at
-                                                     !< the north boundary
-    LOGICAL ::  bc_dirichlet_cs_r         = .FALSE.  !< flag for indicating a dirichlet condition at
-                                                     !< the right boundary
-    LOGICAL ::  bc_dirichlet_cs_s         = .FALSE.  !< flag for indicating a dirichlet condition at
-                                                     !< the south boundary
-    LOGICAL ::  bc_radiation_cs_l         = .FALSE.  !< flag for indicating a radiation/neumann
-                                                     !< condition at the left boundary
-    LOGICAL ::  bc_radiation_cs_n         = .FALSE.  !< flag for indicating a radiation/neumann
-                                                     !< condition at the north boundary
-    LOGICAL ::  bc_radiation_cs_r         = .FALSE.  !< flag for indicating a radiation/neumann
-                                                     !< condition at the right boundary
-    LOGICAL ::  bc_radiation_cs_s         = .FALSE.  !< flag for indicating a radiation/neumann
-                                                     !< condition at the south boundary
-    LOGICAL ::  constant_csflux(99)       = .TRUE.   !< internal flag, set to .FALSE. if no
-                                                     !< surface_csflux is prescribed
-    LOGICAL ::  call_chem_at_all_substeps = .FALSE.  !< namelist parameter: Never set true 
-                                                     !< except for tests
-    LOGICAL ::  chem_gasphase_on          = .TRUE.   !< namelist parameter: flag to switch off
-                                                     !< chemical reactions
-    LOGICAL ::  cs_pr_namelist_found      = .FALSE.  !< ...???
-    LOGICAL ::  deposition_dry            = .FALSE.  !< namelist parameter: flag for activation of
-                                                     !< deposition calculation
-    LOGICAL ::  emissions_anthropogenic   = .FALSE.  !< namelist parameter: flag for turning on
-                                                     !< anthropogenic emissions
-    LOGICAL ::  emission_output_required  = .TRUE.   !< internal flag for requiring emission outputs
-    LOGICAL ::  emiss_read_legacy_mode    = .TRUE.   !< namelist parameter: flag to read emission
-                                                     !< data using legacy mode
-    LOGICAL ::  nesting_chem              = .TRUE.   !< apply self-nesting for the chemistry model
-    LOGICAL ::  nesting_offline_chem      = .TRUE.   !< apply offline nesting for the chemistry
-                                                     !< model
-
-    REAL(wp) ::  emiss_factor_main(99)             = -9999.0_wp  !< namelist parameter: weighting  factor
-                                                                 !< for LOD 0 parameterized emissions
-    REAL(wp) ::  emiss_factor_side(99)             = -9999.0_wp  !< namelist parameter: weighting  factor
-                                                                 !< for LOD 0 parameterized emissions
-    REAL(wp) ::  surface_csflux(99)                = 0.0_wp      !< namelist parameter: surface emission 
-                                                                 !< flux or LOD 0 parameterized emissions
-    REAL(wp) ::  wall_csflux(99,0:5)               = 0.0_wp      !< namelist parameter: ...???
-
-    REAL(wp), DIMENSION(99)     ::  cs_surface = 0.0_wp        !< namelist parameter: chem species
-                                                               !< concentration at surface
-    REAL(wp), DIMENSION(99,100) ::  cs_heights = 9999999.9_wp  !< namelist parameter: height levels
-                                                               !< for initial chem species concentrations
-    REAL(wp), DIMENSION(99,100) ::  cs_profile = 9999999.9_wp  !< namelist parameter: chem species
-                                                               !< concentration values at cs_heights levels
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_cs_t_val  !< vertical gradient of chemical species
-                                                         !< near domain top
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  css          !< scaling parameter for chem species
-
-    REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE, TARGET ::  sums_ws_l  !< subdomain sum of vertical chemistry flux w'ch'
-
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  emis_distribution  !< emissions final values (main module output) ???
-
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  cs_1  !< pointer for swapping of
-                                                                !< timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  cs_2  !< pointer for swapping of
-                                                                !< timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  cs_3  !< pointer for swapping of
-                                                                !< timelevels for respective quantity
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  cs     !< pointer: sgs chem spcs  ???
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  cs_p   !< pointer: prognostic value of sgs chem spcs ???
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  tcs_m  !< pointer: to tcs array (temp)
-
-!
-!-  Define chemical variables within chem_species
-    TYPE species_def
-
-       CHARACTER(LEN=15)                            ::  name         !< name of chemical species
-       CHARACTER(LEN=15)                            ::  unit         !< unit (ppm for gases, kg m^-3
-                                                                     !< for aerosol tracers)
-
-       REAL(kind=wp), ALLOCATABLE, DIMENSION(:)     ::  conc_pr_init !< initial profile of chemical
-                                                                     !< species
-
-       REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:)   ::  cssws_av     !< averaged fluxes of trace
-                                                                     !< gases at surface
-       REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:)   ::  flux_s_cs    !< 6th-order advective flux at
-                                                                     !< south face of grid box of chemical species (='cs')
-       REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:)   ::  diss_s_cs    !< artificial numerical dissipation
-                                                                     !< flux at south face of grid box of chemical species
-
-       REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) ::  conc_av      !< averaged concentrations
-       REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) ::  flux_l_cs    !< 6th-order advective flux at
-                                                                     !< left face of grid box of chemical species (='cs')
-       REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) ::  diss_l_cs    !< artificial numerical dissipation
-                                                                     !< flux at left face of grid box of chemical species
-
-       REAL(kind=wp), POINTER, DIMENSION(:,:,:)     ::  conc         !< concentrations of trace
-                                                                     !< gases
-       REAL(kind=wp), POINTER, DIMENSION(:,:,:)     ::  conc_p       !< conc at prognostic time
-                                                                     !< level
-       REAL(kind=wp), POINTER, DIMENSION(:,:,:)     ::  tconc_m      !< weighted tendency of conc
-                                                                     !< for previous sub-timestep (Runge-Kutta)
-
-    END TYPE species_def
-!
-!-- Define photolysis frequencies in phot_frequen
-    TYPE photols_def
-
-       CHARACTER(LEN=15)                            :: name          !< name of pgotolysis frequency
-       CHARACTER(LEN=15)                            :: unit          !< unit (1/s)
-
-       REAL(kind=wp), POINTER, DIMENSION(:,:,:)     :: freq          !< photolysis frequency
-
-    END TYPE photols_def
-
-
-    TYPE(species_def), ALLOCATABLE, DIMENSION(:), TARGET ::  chem_species
-    TYPE(photols_def), ALLOCATABLE, DIMENSION(:), TARGET ::  phot_frequen
-
-    SAVE
-
- END MODULE chem_modules
Index: palm/trunk/SOURCE/chem_photolysis_mod.f90
===================================================================
--- palm/trunk/SOURCE/chem_photolysis_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,283 +1,0 @@
-!> @file chem_photolysis_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2018-2021 Leibniz Universitaet Hannover
-! Copyright 2018-2021 Karlsruhe Institute of Technology
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! removed chem_debug parameter
-! 
-! 
-! 4828 2021-01-05 11:21:41Z Giersch
-! further re-formatting to follow the PALM coding standard
-!
-! 4559 2020-06-11 08:51:48Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! Change call to calc_zenith
-!
-! 4223 2019-09-10 09:20:47Z gronemeier
-! Corrected "Former revisions" section
-!
-! 3876 2019-04-08 18:41:49Z knoop
-! some formatting and comments added
-!
-! 3824 2019-03-27 15:56:16Z pavelkrc
-! unused variables removed
-!
-! 2718 2018-01-02 08:49:38Z maronga
-! Initial revision
-!
-!
-! Authors:
-! --------
-! @author Renate Forkel
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> photolysis models and interfaces (Adapted from photolysis_model_mod.f90)
-!> @todo more complex scheme, add shading
-!--------------------------------------------------------------------------------------------------!
- MODULE chem_photolysis_mod
-
-!   USE arrays_3d,                                                                                  &
-!       ONLY:  dzw, q, ql, zu, zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  time_since_reference_point
-
-    USE pegrid,                                                                                    &
-        ONLY: myid, threads_per_task
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
-
-    USE control_parameters,                                                                        &
-        ONLY:  initializing_actions
-
-    USE chem_gasphase_mod,                                                                         &
-        ONLY: nphot, phot, phot_names
-
-    USE chem_modules,                                                                              &
-        ONLY: phot_frequen, photolysis_scheme
-
-    USE kinds
-
-#if defined ( __netcdf )
-    USE NETCDF
-#endif
-
-
-    IMPLICIT NONE
-
-
-!   LOGICAL ::  unscheduled_photolysis_calls = .TRUE., & !< flag parameter indicating whether additional calls of the photolysis
-!                                                        !< code are allowed
-!               constant_albedo = .FALSE.,             & !< flag parameter indicating whether the albedo may change depending on
-!                                                        !< zenith
-!               force_photolysis_call = .FALSE.,       & !< flag parameter for unscheduled photolysis calls
-!               photolysis = .FALSE.,                  & !< flag parameter indicating whether the photolysis model is used
-!               sun_up    = .TRUE.,                    & !< flag parameter indicating whether the sun is up or down
-!               photolysis = .TRUE.,                   & !< flag parameter indicing whether photolysis shall be calculated
-!               sun_direction = .FALSE.                  !< flag parameter indicing whether solar direction shall be calculated
-
-!
-!-- Parameters for constant photolysis frequencies
-    INTEGER,PARAMETER :: nconst  = 15               !< available predefined photolysis prequencies for constant
-!
-!-- Names for predefined fixed photolysis frequencies at zenith angle 0
-    CHARACTER(LEN=10), PARAMETER, DIMENSION(nconst) :: names_c =  (/                               &
-                     'J_O31D    ','J_O33P    ','J_NO2     ','J_HNO3    ','J_RCHO    ',             &
-                     'J         ','J         ','J         ','J         ','J         ',             &
-                     'J         ','J         ','J         ','J         ','J         ' /)
-!
-!-- Photolysis frequency at zenith angle 0 degrees in 1/s
-    REAL(wp), PARAMETER, DIMENSION(nconst) :: phot0 =  (/                                          &
-                      2.489E-05_wp, 3.556E-04_wp, 8.89E-03_wp,5.334E-07_wp, 3.734E-05_wp,          &
-                      0.0000E00_wp, 0.0000E00_wp, 0.0000E00_wp,0.0000E00_wp, 0.0000E00_wp,         &
-                      0.0000E00_wp, 0.0000E00_wp, 0.0000E00_wp,0.0000E00_wp, 0.0000E00_wp /)
-!
-!-- Parameters for simple photolysis frequencies from MCM (http://mcm.leeds.ac.uk/MCM)
-!-- Saunders et al., 2003, Atmos. Chem. Phys., 3, 161-180
-    INTEGER,PARAMETER :: nsimple = 15               !< available predefined photolysis prequencies for simple parameterisation
-!
-!-- Names for simple photolysis frequencies parameterisation (
-    CHARACTER(LEN=10), PARAMETER, DIMENSION(nsimple) :: names_s =  (/                              &
-                     'J_O31D    ','J_O33P    ','J_H2O2    ','J_NO2     ','J_NO3_A   ',             &
-                     'J_NO3_B   ','J_HONO    ','J_HNO3    ','J_HCHO_A  ','J_HCHO_B  ',             &
-                     'J_CH3CHO  ','J         ','J         ','J         ','J_RCHO    ' /)
-!
-!-- Species dependent parameters for simple photolysis frequencies from MCM
-!-- (http://mcm.leeds.ac.uk/MCM)
-!-- J = l*COSx@m*EXP(-n*SECx)  with l,m,n named par_l etc., x is the zenith angle
-    REAL(wp), PARAMETER, DIMENSION(nconst) :: par_l =  (/                                          &
-                       6.073E-05_wp, 4.775E-04_wp, 1.041E-05_wp, 1.165E-02_wp, 2.485E-02_wp,       &
-                       1.747E-01_wp, 2.644E-03_wp, 9.312E-07_wp, 4.642E-05_wp, 6.853E-05_wp,       &
-                       7.344E-06_wp, 0.0000E00_wp, 0.0000E00_wp, 0.000E00_wp,  6.853E-05_wp /)
-
-    REAL(wp), PARAMETER, DIMENSION(nconst) :: par_m =  (/                                          &
-                           1.743_wp,    0.298_wp,    0.723_wp,    0.244_wp,    0.168_wp,           &
-                           0.155_wp,    0.261_wp,    1.230_wp,    0.762_wp,    0.477_wp,           &
-                           1.202_wp,    0.000_wp,    0.000_wp,    0.000_wp,    0.477_wp /)
-
-    REAL(wp), PARAMETER, DIMENSION(nconst) :: par_n =  (/                                          &
-                           0.474_wp,    0.080_wp,    0.279_wp,    0.267_wp,    0.108_wp,           &
-                           0.125_wp,    0.288_wp,    0.307_wp,    0.353_wp,    0.323_wp,           &
-                           0.417_wp,    0.000_wp,    0.000_wp,    0.000_wp,    0.323_wp /)
-
-
-    REAL(wp)     :: cosz = 0.7_wp                   !< cosine of fixed zenith angle (45 deg, if not
-                                                    !< specified otherwise)
-
-
-    INTERFACE photolysis_constant
-       MODULE PROCEDURE photolysis_constant
-    END INTERFACE photolysis_constant
-
-    INTERFACE photolysis_simple
-       MODULE PROCEDURE photolysis_simple
-    END INTERFACE photolysis_simple
-!
-!   INTERFACE photolysis_fastj
-!      MODULE PROCEDURE photolysis_fastj
-!   END INTERFACE photolysis_fastj
-!
-    INTERFACE photolysis_control
-       MODULE PROCEDURE photolysis_control
-    END INTERFACE photolysis_control
-
-    SAVE
-
-    PRIVATE
-
-    PUBLIC  photolysis_control
-
-    PUBLIC  photolysis_scheme
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine controls the calls of the photolysis schemes.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE photolysis_control
-
-    IMPLICIT NONE
-
-    SELECT CASE ( TRIM( photolysis_scheme ) )
-
-       CASE ( 'constant' )
-          CALL photolysis_constant
-
-       CASE ( 'simple' )
-          CALL photolysis_simple
-
-!      CASE ( 'fastj' )
-!         CALL photolysis_fastj
-
-       CASE DEFAULT
-
-    END SELECT
-
-
- END SUBROUTINE photolysis_control
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This scheme keeps the prescribed net radiation constant during the run.
-!> Default zenith angle is 45 deg
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE photolysis_constant
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: iphot,iav !< loop index for photolysis reaction
-
-    DO  iphot = 1, nphot
-       DO  iav = 1, nconst
-          IF ( TRIM( names_c(iav) ) == TRIM( phot_names(iphot) ) )  THEN
-!--             Prescribe fixed photolysis frequencies  [1/s]
-                phot_frequen(iphot)%freq(nzb+1:nzt,:,:) =  phot0(iav) * cosz
-          ENDIF
-       ENDDO
-    ENDDO
-
-
- END SUBROUTINE photolysis_constant
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This scheme applies a simple parameterisation for clear sky photolysis frequencies from the
-!> Master Chemical Mechanism, MCM v3.2 (http://mcm.leeds.ac.uk/MCM).
-!> Reference: Saunders et al., Atmos. Chem. Phys., 3, 161, 2003
-!> J = l*COSx@m*EXP(-n*SECx)  with l,m,n named par_l etc., x is the zenith angle
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE photolysis_simple
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  get_date_time
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  calc_zenith, cos_zenith
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: day_of_year  !< day of the year
-    INTEGER(iwp) :: iav          !< loop indix for photolysis reaction
-    INTEGER(iwp) :: iphot        !< loop indix for photolysis reaction
-
-    REAL(wp)     :: coszi          !< 1./cosine of zenith angle
-    REAL(wp)     :: second_of_day  !< second of the day
-
-    DO  iphot = 1, nphot
-       phot_frequen(iphot)%freq = 0.0_wp
-    ENDDO
-
-    CALL get_date_time( time_since_reference_point, day_of_year = day_of_year,                     &
-                        second_of_day=second_of_day )
-    CALL calc_zenith( day_of_year, second_of_day )
-
-    IF ( cos_zenith > 0.0_wp )  THEN
-       coszi = 1.0_wp / cos_zenith
-
-       DO iphot = 1, nphot
-          DO iav = 1, nsimple
-             IF ( TRIM( names_s(iav) ) == TRIM( phot_names(iphot) ) )  THEN
-                phot_frequen(iphot)%freq(nzb+1:nzt,:,:) =  par_l(iav) * cos_zenith**par_m(iav) *   &
-                                                           EXP( - par_n(iav) * coszi )
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDIF
-
-
- END SUBROUTINE photolysis_simple
-
- END MODULE chem_photolysis_mod
Index: palm/trunk/SOURCE/chemistry_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/chemistry_model_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,6179 +1,0 @@
-!> @file chemistry_model_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2017-2021 Leibniz Universitaet Hannover
-! Copyright 2017-2021 Karlsruhe Institute of Technology
-! Copyright 2017-2021 Freie Universitaet Berlin
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! removed unnecessary informative messages,
-! removed unused code in chem_depo subroutine
-!
-! 4899 2021-03-04 16:42:21Z raasch
-! small adjustments regarding r4897
-!
-! 4897 2021-03-04 09:08:58Z forkel
-! Few informative messages removed, small changes in comments and chemistry header
-!
-! 4895 2021-03-03 15:39:08Z suehring
-! Remove offset in terrain-following masked output
-!
-! 4887 2021-02-26 16:22:32Z banzhafs
-! Unnecessary comments removed
-!
-! 4881 2021-02-19 22:05:08Z forkel
-! removed unnecessarty namelist parameters and commented output statements
-! and cs_surface_initial_change
-!
-! 4860 2021-02-01 08:10:59Z raasch
-! further re-numbering of message IDs
-!
-! 4852 2021-01-25 07:18:30Z raasch
-! re-numbering of message IDs
-!
-! 4847 2021-01-19 13:44:45Z raasch
-! error message IDs changed from CM to the default PA
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4833 2021-01-07 08:57:54Z raasch
-! openmp bugfix for time measurements of non advective processes
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4768 2020-11-02 19:11:23Z suehring
-! Enable 3D data output also with 64-bit precision
-!
-! 4731 2020-10-07 13:25:11Z schwenkel
-! Move exchange_horiz from time_integration to modules
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4637 2020-08-07 07:49:33Z suehring
-! Avoid usage of omp_lib, instead declare omp_get_thread_num explicitly
-!
-! 4636 2020-08-06 14:10:12Z resler
-! Fix bugs in OpenMP directives
-!
-! 4636 2020-08-06 14:10:12Z suehring
-! - Bugfix in variable name separation in profile-output initialization
-! - Bugfix in counting the number of chemistry profiles
-!
-! 4581 2020-06-29 08:49:58Z suehring
-! Enable output of resolved-scale vertical fluxes of chemical species.
-!
-! 4577 2020-06-25 09:53:58Z raasch
-! further re-formatting to follow the PALM coding standard
-!
-! 4559 2020-06-11 08:51:48Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4550 2020-05-29 15:22:13Z raasch
-! bugfix for reading local restart data
-!
-! 4544 2020-05-21 14:43:05Z raasch
-! conc_av changed from pointer to allocatable array, array spec_conc_av removed
-!
-! 4542 2020-05-19 15:45:12Z raasch
-! redundant if statement removed
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO
-!
-! 4511 2020-04-30 12:20:40Z raasch
-! decycling replaced by explicit setting of lateral boundary conditions
-!
-! 4487 2020-04-03 09:38:20Z raasch
-! bugfix for subroutine calls that contain the decycle_chem switches as arguments
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! use statement for exchange horiz added,
-! bugfix for call of exchange horiz 2d
-!
-! 4442 2020-03-04 19:21:13Z suehring
-! Change order of dimension in surface array %frac to allow for better
-! vectorization.
-!
-! 4441 2020-03-04 19:20:35Z suehring
-! in subroutine chem_init (ECC)
-! - allows different init paths emission data for legacy mode emission and on-demand mode in
-!   subroutine chem_init_internal (ECC)
-! - reads netcdf file only when legacy mode is activated (i.e., emiss_read_legacy_mode = .TRUE.)
-!   otherwise file is read once at the beginning to obtain header information, and emission data
-!   are extracted on an on-demand basis
-!
-! 4372 2020-01-14 10:20:35Z banzhafs
-! chem_parin : added handler for new namelist item emiss_legacy_read_mode (ECC) added messages
-! CM0465 - legacy read mode selection
-! CM0466 - legacy read mode force selection
-! CM0467 - new read mode selection
-!
-! 4370 2020-01-10 14:00:44Z raasch
-! vector directives added to force vectorization on Intel19 compiler
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4306 2019-11-25 12:04:48Z banzhafs
-! Corretion for r4304 commit
-!
-! 4304 2019-11-25 10:43:03Z banzhafs
-! Precision clean-up in drydepo_aero_zhang_vd subroutine
-!
-! 4292 2019-11-11 13:04:50Z banzhafs
-! Bugfix for r4290
-!
-! 4290 2019-11-11 12:06:14Z banzhafs
-! Bugfix in sedimentation resistance calculation in drydepo_aero_zhang_vd subroutine
-!
-! 4273 2019-10-24 13:40:54Z monakurppa
-! Add logical switches nesting_chem and nesting_offline_chem (both .TRUE. by default)
-!
-! 4272 2019-10-23 15:18:57Z schwenkel
-! Further modularization of boundary conditions: moved boundary conditions to respective modules
-!
-! 4268 2019-10-17 11:29:38Z schwenkel
-! Moving module specific boundary conditions from time_integration to module
-!
-! 4230 2019-09-11 13:58:14Z suehring
-! Bugfix, initialize mean profiles also in restart runs. Also initialize array used for Runge-Kutta
-! tendecies in restart runs.
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4167 2019-08-16 11:01:48Z suehring
-! Changed behaviour of masked output over surface to follow terrain and ignore buildings
-! (J.Resler, T.Gronemeier)
-!
-! 4166 2019-08-16 07:54:21Z resler
-! Bugfix in decycling
-!
-! 4115 2019-07-24 12:50:49Z suehring
-! Fix faulty IF statement in decycling initialization
-!
-! 4110 2019-07-22 17:05:21Z suehring
-! - Decycling boundary conditions are only set at the ghost points not on the prognostic grid points
-! - Allocation and initialization of special advection flags cs_advc_flags_s used for chemistry.
-!   These are exclusively used for chemical species in order to distinguish from the usually-used
-!   flags which might be different when decycling is applied in combination with cyclic boundary
-!   conditions.
-!   Moreover, cs_advc_flags_s considers extended zones around buildings where first-order upwind
-!   scheme is applied for the horizontal advection terms, in order to overcome high concentration
-!   peaks due to stationary numerical oscillations caused by horizontal advection discretization.
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! Slightly revise setting of boundary conditions at horizontal walls, use data-structure offset
-! index instead of pre-calculate it for each facing
-!
-! 4080 2019-07-09 18:17:37Z suehring
-! Restore accidantly removed limitation to positive values
-!
-! 4079 2019-07-09 18:04:41Z suehring
-! Application of monotonic flux limiter for the vertical scalar advection up to the topography top
-! (only for the cache-optimized version at the moment).
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to avoid runtime error
-! (Loop variable has been modified) in time_integration
-!
-! 4029 2019-06-14 14:04:35Z raasch
-! nest_chemistry option removed
-!
-! 4004 2019-05-24 11:32:38Z suehring
-! in subroutine chem_parin check emiss_lod / mod_emis only when emissions_anthropogenic is activated
-! in namelist (E.C. Chan)
-!
-! 3968 2019-05-13 11:04:01Z suehring
-! - added "emiss_lod" which serves the same function as "mode_emis" both will be synchronized with
-!   emiss_lod having pirority over mode_emis (see informational messages)
-! - modified existing error message and introduced new informational messages
-!    - CM0436 - now also applies to invalid LOD settings
-!    - CM0463 - emiss_lod take precedence in case of conflict with mod_emis
-!    - CM0464 - emiss_lod valued assigned based on mode_emis if undefined
-!
-! 3930 2019-04-24 14:57:18Z forkel
-! Changed chem_non_transport_physics to chem_non_advective_processes
-!
-! 3929 2019-04-24 12:52:08Z banzhafs
-! Correct/complete module_interface introduction for chemistry model
-! Add subroutine chem_exchange_horiz_bounds
-! Bug fix deposition
-!
-! 3784 2019-03-05 14:16:20Z banzhafs
-! 2D output of emission fluxes
-!
-! 3784 2019-03-05 14:16:20Z banzhafs
-! Bugfix, uncomment erroneous commented variable used for dry deposition.
-! Bugfix in 3D emission output.
-!
-! 3784 2019-03-05 14:16:20Z banzhafs
-! Changes related to global restructuring of location messages and introduction
-! of additional debug messages
-!
-! 3784 2019-03-05 14:16:20Z banzhafs
-! some formatting of the deposition code
-!
-! 3784 2019-03-05 14:16:20Z banzhafs
-! some formatting
-!
-! 3784 2019-03-05 14:16:20Z banzhafs
-! added cs_mech to USE chem_gasphase_mod
-!
-! 3784 2019-03-05 14:16:20Z banzhafs
-! renamed get_mechanismname to get_mechanism_name
-! renamed do_emiss to emissions_anthropogenic and do_depo to deposition_dry (ecc)
-!
-! 3784 2019-03-05 14:16:20Z banzhafs
-! Unused variables removed/taken care of
-!
-! 3784 2019-03-05 14:16:20Z forkel
-! Replaced READ from unit 10 by CALL get_mechanismname also in chem_header
-!
-! 3783 2019-03-05 13:23:50Z forkel
-! Removed forgotte write statements an some unused variables (did not touch the parts related to
-! deposition)
-!
-! 3780 2019-03-05 11:19:45Z forkel
-! Removed READ from unit 10, added CALL get_mechanismname
-!
-! 3767 2019-02-27 08:18:02Z raasch
-! unused variable for file index removed from rrd-subroutines parameter list
-!
-! 3738 2019-02-12 17:00:45Z suehring
-! Clean-up debug prints
-!
-! 3737 2019-02-12 16:57:06Z suehring
-! Enable mesoscale offline nesting for chemistry variables as well as initialization of chemistry
-! via dynamic input file.
-!
-! 3719 2019-02-06 13:10:18Z kanani
-! Resolved cpu logpoint overlap with all progn.equations, moved cpu_log call to prognostic_equations
-! for better overview
-!
-! 3700 2019-01-26 17:03:42Z knoop
-! Some interface calls moved to module_interface + cleanup
-!
-! 3664 2019-01-09 14:00:37Z forkel
-! Replaced misplaced location message by @todo
-!
-! 3654 2019-01-07 16:31:57Z suehring
-! Disable misplaced location message
-!
-! 3652 2019-01-07 15:29:59Z forkel
-! Checks added for chemistry mechanism, parameter chem_mechanism added (basit)
-!
-! 2718 2018-01-02 08:49:38Z maronga
-! Initial revision
-!
-!
-!
-!
-! Authors:
-! --------
-! @author Renate Forkel
-! @author Farah Kanani-Suehring
-! @author Klaus Ketelsen
-! @author Basit Khan
-! @author Sabine Banzhaf
-!
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Chemistry model for PALM-4U
-!> @todo Adjust chem_rrd_local to CASE structure of others modules. It is not allowed to use the
-!>       chemistry model in a precursor run and additionally not using it in a main run
-!> @todo Implement turbulent inflow of chem spcs in inflow_turbulence. Do we need this? Not done for salsa either. 
-!
-!--------------------------------------------------------------------------------------------------!
-
- MODULE chemistry_model_mod
-
-    USE advec_s_pw_mod,                                                                            &
-         ONLY:  advec_s_pw
-
-    USE advec_s_up_mod,                                                                            &
-         ONLY:  advec_s_up
-
-    USE advec_ws,                                                                                  &
-         ONLY:  advec_s_ws, ws_init_flags_scalar
-
-    USE diffusion_s_mod,                                                                           &
-         ONLY:  diffusion_s
-
-    USE kinds,                                                                                     &
-         ONLY:  iwp, wp
-
-    USE indices,                                                                                   &
-         ONLY:  advc_flags_s,                                                                      &
-                nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt,            &
-                wall_flags_total_0
-
-    USE pegrid,                                                                                    &
-         ONLY: myid, threads_per_task
-
-    USE bulk_cloud_model_mod,                                                                      &
-         ONLY:  bulk_cloud_model
-
-    USE control_parameters,                                                                        &
-         ONLY:  air_chemistry,                                                                     &
-                bc_dirichlet_l,                                                                    &
-                bc_dirichlet_n,                                                                    &
-                bc_dirichlet_r,                                                                    &
-                bc_dirichlet_s,                                                                    &
-                bc_radiation_l,                                                                    &
-                bc_lr_cyc,                                                                         &
-                bc_ns_cyc,                                                                         &
-                bc_radiation_n,                                                                    &
-                bc_radiation_r,                                                                    &
-                bc_radiation_s,                                                                    &
-                debug_output,                                                                      &
-                dt_3d,                                                                             &
-                humidity,                                                                          &
-                initializing_actions,                                                              &
-                intermediate_timestep_count,                                                       &
-                intermediate_timestep_count_max,                                                   &
-                max_pr_user,                                                                       &
-                message_string,                                                                    &
-                monotonic_limiter_z,                                                               &
-                nesting_offline,                                                                   &
-                omega,                                                                             &
-                restart_data_format_output,                                                        &
-                scalar_advec,                                                                      &
-                timestep_scheme,                                                                   &
-                tsc,                                                                               &
-                use_prescribed_profile_data,                                                       &
-                ws_scheme_sca
-
-    USE arrays_3d,                                                                                 &
-         ONLY:  exner, hyp, pt, q, ql, rdf_sc, tend, zu
-
-    USE chem_gasphase_mod,                                                                         &
-         ONLY:  atol, chem_gasphase_integrate, cs_mech, get_mechanism_name, nkppctrl,              &
-         nmaxfixsteps, nphot, nreact, nspec, nvar, phot_names, rtol, spc_names, t_steps, vl_dim
-
-    USE chem_modules
-
-    USE chem_photolysis_mod,                                                                       &
-        ONLY:  photolysis_control
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point_s
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rrd_mpi_io, rd_mpi_io_check_array, wrd_mpi_io
-
-    USE statistics
-
-    USE surface_mod,                                                                               &
-         ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
-
-    IMPLICIT NONE
-
-    PRIVATE
-    SAVE
-
-    INTEGER, DIMENSION(nkppctrl)                           ::  icntrl       !< 20 integer parameters for fine tuning KPP code
-
-    REAL(kind=wp), PUBLIC ::  cs_time_step = 0._wp
-
-    REAL(kind=wp), DIMENSION(nkppctrl)                     ::  rcntrl       !< 20 real parameters for fine tuning of KPP code
-                                                                            !< (e.g starting internal timestep of solver)
-
-    REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  spec_conc_1  !< pointer for swapping of timelevels for conc
-    REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  spec_conc_2  !< pointer for swapping of timelevels for conc
-    REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  spec_conc_3  !< pointer for swapping of timelevels for conc
-    REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  freq_1       !< pointer for phtolysis frequncies
-                                                                            !< (only 1 timelevel required) (e.g. solver type)
-
-!
-!-- Parameter needed for Deposition calculation using DEPAC model (van Zanten et al., 2010)
-    INTEGER(iwp), PARAMETER ::  nlu_dep = 15            !< Number of DEPAC landuse classes (lu's)
-    INTEGER(iwp), PARAMETER ::  ncmp = 10               !< Number of DEPAC gas components
-    INTEGER(iwp), PARAMETER ::  nposp = 69              !< Number of possible species for deposition
-!
-!-- DEPAC landuse classes as defined in LOTOS-EUROS model v2.1
-    INTEGER(iwp) ::  ilu_grass              = 1
-    INTEGER(iwp) ::  ilu_arable             = 2
-    INTEGER(iwp) ::  ilu_permanent_crops    = 3
-    INTEGER(iwp) ::  ilu_coniferous_forest  = 4
-    INTEGER(iwp) ::  ilu_deciduous_forest   = 5
-    INTEGER(iwp) ::  ilu_water_sea          = 6
-    INTEGER(iwp) ::  ilu_urban              = 7
-    INTEGER(iwp) ::  ilu_other              = 8
-    INTEGER(iwp) ::  ilu_desert             = 9
-    INTEGER(iwp) ::  ilu_ice                = 10
-    INTEGER(iwp) ::  ilu_savanna            = 11
-    INTEGER(iwp) ::  ilu_tropical_forest    = 12
-    INTEGER(iwp) ::  ilu_water_inland       = 13
-    INTEGER(iwp) ::  ilu_mediterrean_scrub  = 14
-    INTEGER(iwp) ::  ilu_semi_natural_veg   = 15
-
-!
-!-- NH3/SO2 ratio regimes:
-    INTEGER(iwp), PARAMETER ::  iratns_low      = 1       !< low ratio NH3/SO2
-    INTEGER(iwp), PARAMETER ::  iratns_high     = 2       !< high ratio NH3/SO2
-    INTEGER(iwp), PARAMETER ::  iratns_very_low = 3       !< very low ratio NH3/SO2
-!
-!-- Default:
-    INTEGER, PARAMETER ::  iratns_default = iratns_low
-!
-!-- Set alpha for f_light (4.57 is conversion factor from 1./(mumol m-2 s-1) to W m-2
-    REAL(wp), DIMENSION(nlu_dep), PARAMETER ::  alpha   = (/ 0.009, 0.009, 0.009, 0.006, 0.006,    &
-                    -999.0, -999., 0.009, -999.0, -999.0, 0.009, 0.006, -999.0, 0.009, 0.008 /)*4.57
-!
-!-- Set temperatures per land use for f_temp
-    REAL(wp), DIMENSION(nlu_dep), PARAMETER ::  tmin = (/ 12.0,  12.0,  12.0,  0.0,  0.0, -999.0,  &
-                                      -999.0, 12.0, -999.0, -999.0, 12.0,  0.0, -999.0, 12.0,  8.0/)
-    REAL(wp), DIMENSION(nlu_dep), PARAMETER ::  topt = (/ 26.0, 26.0,  26.0, 18.0, 20.0, -999.0,   &
-                                     -999.0, 26.0, -999.0, -999.0, 26.0, 20.0, -999.0, 26.0, 24.0 /)
-    REAL(wp), DIMENSION(nlu_dep), PARAMETER ::  tmax = (/ 40.0, 40.0,  40.0, 36.0, 35.0, -999.0,   &
-                                    -999.0, 40.0, -999.0, -999.0,  40.0, 35.0, -999.0, 40.0, 39.0 /)
-!
-!-- Set f_min:
-    REAL(wp), DIMENSION(nlu_dep), PARAMETER ::  f_min = (/ 0.01, 0.01, 0.01, 0.1, 0.1, -999.0,     &
-                                       -999.0, 0.01, -999.0, -999.0, 0.01, 0.1, -999.0, 0.01, 0.04/)
-
-!
-!-- Set maximal conductance (m/s)
-!-- (R T/P) = 1/41000 mmol/m3 is given for 20 deg C to go from  mmol O3/m2/s to m/s
-    REAL(wp), DIMENSION(nlu_dep), PARAMETER ::  g_max = (/ 270.0, 300.0, 300.0, 140.0, 150.0,      &
-              -999.0, -999.0, 270.0, -999.0, -999.0, 270.0, 150.0, -999.0, 300.0, 422.0 /) / 41000.0
-!
-!-- Set max, min for vapour pressure deficit vpd
-    REAL(wp), DIMENSION(nlu_dep), PARAMETER ::  vpd_max = (/ 1.3, 0.9, 0.9, 0.5, 1.0, -999.0,      &
-                                           -999.0, 1.3, -999.0, -999.0, 1.3, 1.0, -999.0, 0.9, 2.8/)
-    REAL(wp), DIMENSION(nlu_dep), PARAMETER ::  vpd_min = (/ 3.0, 2.8, 2.8, 3.0, 3.25, -999.0,     &
-                                         -999.0, 3.0, -999.0, -999.0, 3.0,  3.25, -999.0, 2.8, 4.5/)
-
-    PUBLIC nreact
-    PUBLIC nspec               !< number of gas phase chemical species including constant compound (e.g. N2)
-    PUBLIC nvar                !< number of variable gas phase chemical species (nvar <= nspec)
-    PUBLIC spc_names           !< names of gas phase chemical species (come from KPP) (come from KPP)
-    PUBLIC spec_conc_2
-!
-!-- Interface section
-    INTERFACE chem_actions
-       MODULE PROCEDURE chem_actions
-       MODULE PROCEDURE chem_actions_ij
-    END INTERFACE chem_actions
-
-    INTERFACE chem_3d_data_averaging
-       MODULE PROCEDURE chem_3d_data_averaging
-    END INTERFACE chem_3d_data_averaging
-
-    INTERFACE chem_boundary_conditions
-       MODULE PROCEDURE chem_boundary_conditions
-    END INTERFACE chem_boundary_conditions
-
-    INTERFACE chem_check_data_output
-       MODULE PROCEDURE chem_check_data_output
-    END INTERFACE chem_check_data_output
-
-    INTERFACE chem_data_output_2d
-       MODULE PROCEDURE chem_data_output_2d
-    END INTERFACE chem_data_output_2d
-
-    INTERFACE chem_data_output_3d
-       MODULE PROCEDURE chem_data_output_3d
-    END INTERFACE chem_data_output_3d
-
-    INTERFACE chem_data_output_mask
-       MODULE PROCEDURE chem_data_output_mask
-    END INTERFACE chem_data_output_mask
-
-    INTERFACE chem_check_data_output_pr
-       MODULE PROCEDURE chem_check_data_output_pr
-    END INTERFACE chem_check_data_output_pr
-
-    INTERFACE chem_check_parameters
-       MODULE PROCEDURE chem_check_parameters
-    END INTERFACE chem_check_parameters
-
-    INTERFACE chem_define_netcdf_grid
-       MODULE PROCEDURE chem_define_netcdf_grid
-    END INTERFACE chem_define_netcdf_grid
-
-    INTERFACE chem_header
-       MODULE PROCEDURE chem_header
-    END INTERFACE chem_header
-
-    INTERFACE chem_init_arrays
-       MODULE PROCEDURE chem_init_arrays
-    END INTERFACE chem_init_arrays
-
-    INTERFACE chem_init
-       MODULE PROCEDURE chem_init
-    END INTERFACE chem_init
-
-    INTERFACE chem_init_profiles
-       MODULE PROCEDURE chem_init_profiles
-    END INTERFACE chem_init_profiles
-
-    INTERFACE chem_integrate
-       MODULE PROCEDURE chem_integrate_ij
-    END INTERFACE chem_integrate
-
-    INTERFACE chem_parin
-       MODULE PROCEDURE chem_parin
-    END INTERFACE chem_parin
-
-    INTERFACE chem_non_advective_processes
-       MODULE PROCEDURE chem_non_advective_processes
-       MODULE PROCEDURE chem_non_advective_processes_ij
-    END INTERFACE chem_non_advective_processes
-
-    INTERFACE chem_exchange_horiz_bounds
-       MODULE PROCEDURE chem_exchange_horiz_bounds
-    END INTERFACE chem_exchange_horiz_bounds
-
-    INTERFACE chem_prognostic_equations
-       MODULE PROCEDURE chem_prognostic_equations
-       MODULE PROCEDURE chem_prognostic_equations_ij
-    END INTERFACE chem_prognostic_equations
-
-    INTERFACE chem_rrd_local
-       MODULE PROCEDURE chem_rrd_local_ftn
-       MODULE PROCEDURE chem_rrd_local_mpi
-    END INTERFACE chem_rrd_local
-
-    INTERFACE chem_statistics
-       MODULE PROCEDURE chem_statistics
-    END INTERFACE chem_statistics
-
-    INTERFACE chem_swap_timelevel
-       MODULE PROCEDURE chem_swap_timelevel
-    END INTERFACE chem_swap_timelevel
-
-    INTERFACE chem_wrd_local
-       MODULE PROCEDURE chem_wrd_local
-    END INTERFACE chem_wrd_local
-
-    INTERFACE chem_depo
-       MODULE PROCEDURE chem_depo
-    END INTERFACE chem_depo
-
-    INTERFACE drydepos_gas_depac
-       MODULE PROCEDURE drydepos_gas_depac
-    END INTERFACE drydepos_gas_depac
-
-    INTERFACE rc_special
-       MODULE PROCEDURE rc_special
-    END INTERFACE rc_special
-
-    INTERFACE  rc_gw
-       MODULE PROCEDURE rc_gw
-    END INTERFACE rc_gw
-
-    INTERFACE rw_so2
-       MODULE PROCEDURE rw_so2
-    END INTERFACE rw_so2
-
-    INTERFACE rw_nh3_sutton
-       MODULE PROCEDURE rw_nh3_sutton
-    END INTERFACE rw_nh3_sutton
-
-    INTERFACE rw_constant
-       MODULE PROCEDURE rw_constant
-    END INTERFACE rw_constant
-
-    INTERFACE rc_gstom
-       MODULE PROCEDURE rc_gstom
-    END INTERFACE rc_gstom
-
-    INTERFACE rc_gstom_emb
-       MODULE PROCEDURE rc_gstom_emb
-    END INTERFACE rc_gstom_emb
-
-    INTERFACE par_dir_diff
-       MODULE PROCEDURE par_dir_diff
-    END INTERFACE par_dir_diff
-
-    INTERFACE rc_get_vpd
-       MODULE PROCEDURE rc_get_vpd
-    END INTERFACE rc_get_vpd
-
-    INTERFACE rc_gsoil_eff
-       MODULE PROCEDURE rc_gsoil_eff
-    END INTERFACE rc_gsoil_eff
-
-    INTERFACE rc_rinc
-       MODULE PROCEDURE rc_rinc
-    END INTERFACE rc_rinc
-
-    INTERFACE rc_rctot
-       MODULE PROCEDURE rc_rctot
-    END INTERFACE rc_rctot
-
-    INTERFACE drydepo_aero_zhang_vd
-       MODULE PROCEDURE drydepo_aero_zhang_vd
-    END INTERFACE drydepo_aero_zhang_vd
-
-    INTERFACE get_rb_cell
-       MODULE PROCEDURE  get_rb_cell
-    END INTERFACE get_rb_cell
-
-
-
-    PUBLIC chem_3d_data_averaging, chem_boundary_conditions, chem_check_data_output,               &
-           chem_check_data_output_pr, chem_check_parameters, chem_data_output_2d,                  &
-           chem_data_output_3d, chem_data_output_mask, chem_define_netcdf_grid, chem_header,       &
-           chem_init, chem_init_arrays, chem_init_profiles, chem_integrate, chem_parin,            &
-           chem_actions, chem_prognostic_equations, chem_rrd_local, chem_statistics,               &
-           chem_swap_timelevel, chem_wrd_local, chem_depo, chem_non_advective_processes,           &
-           chem_exchange_horiz_bounds
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine for averaging 3D data of chemical species. Due to the fact that the averaged chem
-!> arrays are allocated in chem_init, no if-query concerning the allocation is required (in any
-!> mode). Attention: If you just specify an averaged output quantity in the _p3dr file during
-!> restarts the first output includes the time between the beginning of the restart run and the
-!> first output time (not necessarily the whole averaging_interval you have specified in your
-!> _p3d/_p3dr file ).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_3d_data_averaging( mode, variable )
-
-    USE control_parameters
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_2d
-
-
-    CHARACTER (LEN=*) ::  mode     !<
-    CHARACTER (LEN=*) ::  variable !<
-
-    LOGICAL ::  match_def  !< flag indicating default-type surface
-    LOGICAL ::  match_lsm  !< flag indicating natural-type surface
-    LOGICAL ::  match_usm  !< flag indicating urban-type surface
-
-    INTEGER(iwp) ::  i                  !< grid index x direction
-    INTEGER(iwp) ::  j                  !< grid index y direction
-    INTEGER(iwp) ::  k                  !< grid index z direction
-    INTEGER(iwp) ::  lsp                !< running index for chem spcs
-    INTEGER(iwp) ::  m                  !< running index surface type
-
-    IF ( ( variable(1:3) == 'kc_'  .OR.  variable(1:3) == 'em_' )  )  THEN
-
-       IF ( mode == 'allocate' )  THEN
-
-          DO  lsp = 1, nspec
-             IF ( TRIM( variable(1:3) ) == 'kc_'  .AND.                                            &
-                  TRIM( variable(4:) )  == TRIM( chem_species(lsp)%name ) )  THEN
-                IF ( .NOT. ALLOCATED( chem_species(lsp)%conc_av ) )  THEN
-                   ALLOCATE( chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   chem_species(lsp)%conc_av = 0.0_wp
-                ENDIF
-             ENDIF
-          ENDDO
-
-       ELSEIF ( mode == 'sum' )  THEN
-
-          DO  lsp = 1, nspec
-             IF ( TRIM( variable(1:3) ) == 'kc_'  .AND.                                            &
-                  TRIM( variable(4:) )  == TRIM( chem_species(lsp)%name ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         chem_species(lsp)%conc_av(k,j,i) = chem_species(lsp)%conc_av(k,j,i) +     &
-                                                            chem_species(lsp)%conc(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSEIF ( TRIM( variable(4:) ) == TRIM( 'cssws*' ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) +       &
-                                                           surf_def_h(0)%cssws(lsp,m)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) +       &
-                                                           surf_lsm_h(0)%cssws(lsp,m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) +       &
-                                                           surf_usm_h(0)%cssws(lsp,m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDDO
-
-       ELSEIF ( mode == 'average' )  THEN
-
-          DO  lsp = 1, nspec
-             IF ( TRIM( variable(1:3) ) == 'kc_'  .AND.                                            &
-                  TRIM( variable(4:) )  == TRIM( chem_species(lsp)%name ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         chem_species(lsp)%conc_av(k,j,i) = chem_species(lsp)%conc_av(k,j,i) /     &
-                                                            REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             ELSEIF ( TRIM( variable(4:) ) == TRIM( 'cssws*' ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) /          &
-                                                        REAL( average_count_3d, KIND = wp )
-                   ENDDO
-                ENDDO
-                CALL exchange_horiz_2d( chem_species(lsp)%cssws_av )
-             ENDIF
-          ENDDO
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE chem_3d_data_averaging
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to initialize and set all boundary conditions for chemical species
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_boundary_conditions( horizontal_conditions_only )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzu
-
-    USE surface_mod,                                                                               &
-        ONLY:  bc_h
-
-    INTEGER(iwp) ::  i                            !< grid index x direction.
-    INTEGER(iwp) ::  j                            !< grid index y direction.
-    INTEGER(iwp) ::  k                            !< grid index z direction.
-    INTEGER(iwp) ::  l                            !< running index boundary type, for up- and downward-facing walls.
-    INTEGER(iwp) ::  lsp                          !< running index for chem spcs.
-    INTEGER(iwp) ::  m                            !< running index surface elements.
-
-    LOGICAL, OPTIONAL ::  horizontal_conditions_only  !< switch to set horizontal bc only
-
-
-    IF ( .NOT. PRESENT( horizontal_conditions_only ) )  THEN
-!
-!--    Boundary condtions for chemical species at horizontal walls
-       DO  lsp = 1, nspec
-!
-!--       Surface conditions:
-          IF ( ibc_cs_b == 0 )  THEN
-!
-!--          Dirichlet:
-!--          Run loop over all non-natural and natural walls. Note, in wall-datatype the k
-!--          coordinate belongs to the atmospheric grid point, therefore, set s_p at k-1
-             DO  l = 0, 1
-                !$OMP PARALLEL DO PRIVATE( i, j, k )
-                DO  m = 1, bc_h(l)%ns
-                   i = bc_h(l)%i(m)
-                   j = bc_h(l)%j(m)
-                   k = bc_h(l)%k(m)
-                   chem_species(lsp)%conc_p(k+bc_h(l)%koff,j,i) =                                  &
-                                                          chem_species(lsp)%conc(k+bc_h(l)%koff,j,i)
-                ENDDO
-             ENDDO
-
-          ELSEIF ( ibc_cs_b == 1 )  THEN
-!
-!--          Neumann:
-             DO  l = 0, 1
-                !$OMP PARALLEL DO PRIVATE( i, j, k )
-                DO m = 1, bc_h(l)%ns
-                   i = bc_h(l)%i(m)
-                   j = bc_h(l)%j(m)
-                   k = bc_h(l)%k(m)
-                   chem_species(lsp)%conc_p(k+bc_h(l)%koff,j,i) = chem_species(lsp)%conc_p(k,j,i)
-                ENDDO
-             ENDDO
-
-          ENDIF
-
-       ENDDO
-
-!
-!--    Top boundary conditions for chemical species 
-       DO  lsp = 1, nspec
-          IF ( ibc_cs_t == 0 )  THEN
-             chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc(nzt+1,:,:)
-          ELSEIF ( ibc_cs_t == 1 )  THEN
-             chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc_p(nzt,:,:)
-          ELSEIF ( ibc_cs_t == 2 )  THEN
-             chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc_p(nzt,:,:) +             &
-                                                   bc_cs_t_val(lsp) * dzu(nzt+1)
-          ENDIF
-       ENDDO
-
-!
-!--    Lateral boundary conditions.
-!--    Dirichlet conditions have been already set when chem_species concentration is initialized.
-!--    The initially set value is not touched during time integration, hence, this boundary value
-!--    remains at a constant value.
-!--    Neumann conditions:
-       IF ( bc_radiation_cs_s )  THEN
-          DO  lsp = 1, nspec
-             chem_species(lsp)%conc_p(:,nys-1,:) = chem_species(lsp)%conc_p(:,nys,:)
-          ENDDO
-       ENDIF
-       IF ( bc_radiation_cs_n )  THEN
-          DO  lsp = 1, nspec
-             chem_species(lsp)%conc_p(:,nyn+1,:) = chem_species(lsp)%conc_p(:,nyn,:)
-          ENDDO
-       ENDIF
-       IF ( bc_radiation_cs_l )  THEN
-          DO  lsp = 1, nspec
-             chem_species(lsp)%conc_p(:,:,nxl-1) = chem_species(lsp)%conc_p(:,:,nxl)
-          ENDDO
-       ENDIF
-       IF ( bc_radiation_cs_r )  THEN
-          DO  lsp = 1, nspec
-             chem_species(lsp)%conc_p(:,:,nxr+1) = chem_species(lsp)%conc_p(:,:,nxr)
-          ENDDO
-       ENDIF
-
-!--    For testing: set Dirichlet conditions for all boundaries
-!      IF ( bc_dirichlet_cs_s )  THEN
-!         DO  lsp = 1, nspec
-!            DO  i = nxlg, nxrg
-!               DO  j = nysg, nys-1
-!                  DO  k = nzb, nzt
-!                     IF ( k /= nzb )  THEN
-!                        flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!                     ELSE
-!                        flag = 1.0
-!                     ENDIF
-!                     chem_species(lsp)%conc_p(k,j,i) = chem_species(lsp)%conc_pr_init(k) * flag
-!                  ENDDO
-!               ENDDO
-!            ENDDO
-!         ENDDO
-!      ENDIF
-!      IF ( bc_dirichlet_cs_n )  THEN
-!         DO  lsp = 1, nspec
-!            DO  i = nxlg, nxrg
-!               DO  j = nyn+1, nyng
-!                  DO  k = nzb, nzt
-!                     IF ( k /= nzb )  THEN
-!                        flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!                     ELSE
-!                        flag = 1.0
-!                     ENDIF
-!                     chem_species(lsp)%conc_p(k,j,i) = chem_species(lsp)%conc_pr_init(k) * flag
-!                  ENDDO
-!               ENDDO
-!            ENDDO
-!         ENDDO
-!      ENDIF
-!      IF ( bc_dirichlet_cs_l )  THEN
-!         DO  lsp = 1, nspec
-!            DO  i = nxlg, nxl-1
-!               DO  j = nysg, nyng
-!                  DO  k = nzb, nzt
-!                     IF ( k /= nzb )  THEN
-!                        flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!                     ELSE
-!                        flag = 1.0
-!                     ENDIF
-!                     chem_species(lsp)%conc_p(k,j,i) = chem_species(lsp)%conc_pr_init(k) * flag
-!                  ENDDO
-!               ENDDO
-!            ENDDO
-!         ENDDO
-!      ENDIF
-!      IF ( bc_dirichlet_cs_r )  THEN
-!         DO  lsp = 1, nspec
-!            DO  i = nxr+1, nxrg
-!               DO  j = nysg, nyng
-!                  DO  k = nzb, nzt
-!                     IF ( k /= nzb )  THEN
-!                        flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!                     ELSE
-!                        flag = 1.0
-!                     ENDIF
-!                     chem_species(lsp)%conc_p(k,j,i) = chem_species(lsp)%conc_pr_init(k) * flag
-!                  ENDDO
-!               ENDDO
-!            ENDDO
-!         ENDDO
-!      ENDIF
-
-    ELSE
-!
-!--    Lateral Neumann booundary conditions for timelevel t.
-!--    This branch is executed when routine is called after the non-advective processes / before the
-!--    prognostic equations.
-       IF ( bc_radiation_cs_s )  THEN
-          DO  lsp = 1, nspec
-             chem_species(lsp)%conc(:,nys-1,:) = chem_species(lsp)%conc(:,nys,:)
-          ENDDO
-       ENDIF
-       IF ( bc_radiation_cs_n )  THEN
-          DO  lsp = 1, nspec
-             chem_species(lsp)%conc(:,nyn+1,:) = chem_species(lsp)%conc(:,nyn,:)
-          ENDDO
-       ENDIF
-       IF ( bc_radiation_cs_l )  THEN
-          DO  lsp = 1, nspec
-             chem_species(lsp)%conc(:,:,nxl-1) = chem_species(lsp)%conc(:,:,nxl)
-          ENDDO
-       ENDIF
-       IF ( bc_radiation_cs_r )  THEN
-          DO  lsp = 1, nspec
-             chem_species(lsp)%conc(:,:,nxr+1) = chem_species(lsp)%conc(:,:,nxr)
-          ENDDO
-       ENDIF
-
-!--    For testing: set Dirichlet conditions for all boundaries
-!      IF ( bc_dirichlet_cs_s )  THEN
-!         DO  lsp = 1, nspec
-!            DO  i = nxlg, nxrg
-!               DO  j = nysg, nys-1
-!                  DO  k = nzb, nzt
-!                     IF ( k /= nzb )  THEN
-!                        flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!                     ELSE
-!                        flag = 1.0
-!                     ENDIF
-!                     chem_species(lsp)%conc(k,j,i) = chem_species(lsp)%conc_pr_init(k) * flag
-!                  ENDDO
-!               ENDDO
-!            ENDDO
-!         ENDDO
-!      ENDIF
-!      IF ( bc_dirichlet_cs_n )  THEN
-!         DO  lsp = 1, nspec
-!            DO  i = nxlg, nxrg
-!               DO  j = nyn+1, nyng
-!                  DO  k = nzb, nzt
-!                     IF ( k /= nzb )  THEN
-!                        flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!                     ELSE
-!                        flag = 1.0
-!                     ENDIF
-!                     chem_species(lsp)%conc(k,j,i) = chem_species(lsp)%conc_pr_init(k) * flag
-!                  ENDDO
-!               ENDDO
-!            ENDDO
-!         ENDDO
-!      ENDIF
-!      IF ( bc_dirichlet_cs_l )  THEN
-!         DO  lsp = 1, nspec
-!            DO  i = nxlg, nxl-1
-!               DO  j = nysg, nyng
-!                  DO  k = nzb, nzt
-!                     IF ( k /= nzb )  THEN
-!                        flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!                     ELSE
-!                        flag = 1.0
-!                     ENDIF
-!                     chem_species(lsp)%conc(k,j,i) = chem_species(lsp)%conc_pr_init(k) * flag
-!                  ENDDO
-!               ENDDO
-!            ENDDO
-!         ENDDO
-!      ENDIF
-!      IF ( bc_dirichlet_cs_r )  THEN
-!         DO  lsp = 1, nspec
-!            DO  i = nxr+1, nxrg
-!               DO  j = nysg, nyng
-!                  DO  k = nzb, nzt
-!                     IF ( k /= nzb )  THEN
-!                        flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!                     ELSE
-!                        flag = 1.0
-!                     ENDIF
-!                     chem_species(lsp)%conc(k,j,i) = chem_species(lsp)%conc_pr_init(k) * flag
-!                  ENDDO
-!               ENDDO
-!            ENDDO
-!         ENDDO
-!      ENDIF
-
-    ENDIF
-
- END SUBROUTINE chem_boundary_conditions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine for checking data output for chemical species
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_check_data_output( var, unit, i, ilen, k )
-
-
-    CHARACTER (LEN=*) ::  unit     !<
-    CHARACTER (LEN=*) ::  var      !<
-
-    INTEGER(iwp) ::  i
-    INTEGER(iwp) ::  ilen
-    INTEGER(iwp) ::  lsp
-    INTEGER(iwp) ::  k
-
-    CHARACTER(LEN=16)    ::  spec_name
-
-!
-!-- Next statement is to avoid compiler warnings about unused variables
-    IF ( ( i + ilen + k ) > 0  .OR.  var(1:1) == ' ' )  CONTINUE
-
-    unit = 'illegal'
-
-    spec_name = TRIM( var(4:) )             !< var 1:3 is 'kc_' or 'em_'.
-
-    IF ( TRIM( var(1:3) ) == 'em_' )  THEN
-       DO  lsp=1,nspec
-          IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) )  THEN
-             unit = 'mol m-2 s-1'
-          ENDIF
-!
-!--       It is possible to plant PM10 and PM25 into the gasphase chemistry code as passive species
-!--       (e.g. 'passive' in GASPHASE_PREPROC/mechanisms): set unit to micrograms per m**3 for PM10
-!--       and PM25 (PM2.5)
-          IF (spec_name(1:2) == 'PM')  THEN
-             unit = 'kg m-2 s-1'
-          ENDIF
-       ENDDO
-
-    ELSE
-
-       DO  lsp=1,nspec
-          IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) )  THEN
-             unit = 'ppm'
-          ENDIF
-!
-!--       It is possible to plant PM10 and PM25 into the gasphase chemistry code as passive species
-!--       (e.g. 'passive' in GASPHASE_PREPROC/mechanisms): set unit to kilograms per m**3 for PM10
-!--       and PM25 (PM2.5)
-          IF (spec_name(1:2) == 'PM')  THEN
-            unit = 'kg m-3'
-          ENDIF
-       ENDDO
-
-       DO  lsp=1,nphot
-          IF ( TRIM( spec_name ) == TRIM( phot_frequen(lsp)%name ) )  THEN
-             unit = 'sec-1'
-          ENDIF
-       ENDDO
-    ENDIF
-
-
-    RETURN
- END SUBROUTINE chem_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine for checking data output of profiles for chemistry model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-    USE arrays_3d
-
-    USE control_parameters,                                                                        &
-        ONLY:  data_output_pr, message_string
-
-    USE profil_parameter
-
-    USE statistics
-
-
-    CHARACTER (LEN=*)  ::  unit      !< unit
-    CHARACTER (LEN=*)  ::  variable  !< variable name
-    CHARACTER (LEN=*)  ::  dopr_unit !< unit
-    CHARACTER (LEN=16) ::  spec_name !< species name extracted from output string
-
-    INTEGER(iwp) ::  index_start     !< start index of the species name in data-output string
-    INTEGER(iwp) ::  index_end       !< end index of the species name in data-output string
-    INTEGER(iwp) ::  var_count       !< number of data-output quantity
-    INTEGER(iwp) ::  lsp             !< running index over species
-
-    SELECT CASE ( TRIM( variable(1:3 ) ) )
-
-       CASE ( 'kc_' )
-
-          IF ( .NOT. air_chemistry )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) //          &
-                              ' is not implemented for air_chemistry = .FALSE.'
-             CALL message( 'chem_check_data_output_pr', 'PA0293', 1, 2, 0, 6, 0 )
-
-          ENDIF
-!
-!--       Output of total fluxes is not allowed to date.
-          IF ( TRIM( variable(1:4) ) == 'kc_w' )  THEN
-             IF ( TRIM( variable(1:5) ) /= 'kc_w*'  .AND.  TRIM( variable(1:5) ) /= 'kc_w"' )  THEN
-                message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) //       &
-                              ' is currently not implemented. Please output resolved- and '//      &
-                              'subgrid-scale fluxes individually to obtain the total flux.'
-                CALL message( 'chem_check_data_output_pr', 'PA0487', 1, 2, 0, 6, 0 )
-             ENDIF
-          ENDIF
-!
-!--       Check for profile output of first-order moments, i.e. variable(4:) equals a species name.
-          spec_name = TRIM( variable(4:) )
-          DO  lsp = 1, nspec
-             IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) )  THEN
-                cs_pr_count_sp                 = cs_pr_count_sp + 1
-                cs_pr_index_sp(cs_pr_count_sp) = lsp
-                dopr_index(var_count)          = pr_palm + cs_pr_count_sp +                        &
-                                                 cs_pr_count_fl_sgs + cs_pr_count_fl_res
-                dopr_unit                      = 'ppm'
-                IF ( spec_name(1:2) == 'PM')  THEN
-                   dopr_unit = 'kg m-3'
-                ENDIF
-                hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
-                unit                              = dopr_unit
-
-                hom_index_spec(cs_pr_count_sp)    = dopr_index(var_count)
-             ENDIF
-          ENDDO
-!
-!--       Check for profile output of fluxes. variable(index_start:index_end) equals a species name.
-!--       Start with SGS components.
-          IF ( TRIM( variable(1:5) ) == 'kc_w"' )  THEN
-             DO  lsp = 1, nspec
-                index_end   = LEN( TRIM( variable ) ) - 1
-                index_start = 6
-                spec_name = TRIM( variable(index_start:index_end) )
-                IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) )  THEN
-                   cs_pr_count_fl_sgs                     = cs_pr_count_fl_sgs + 1
-                   cs_pr_index_fl_sgs(cs_pr_count_fl_sgs) = lsp
-                   dopr_index(var_count)                  = pr_palm + cs_pr_count_sp +          &
-                                                            cs_pr_count_fl_sgs +                &
-                                                            cs_pr_count_fl_res
-                   dopr_unit                              = 'm ppm s-1'
-                   IF ( spec_name(1:2) == 'PM')  THEN
-                      dopr_unit = 'kg m-2 s-1'
-                   ENDIF
-                   hom(:,2,dopr_index(var_count),:)     = SPREAD( zu, 2, statistic_regions+1 )
-                   unit                                 = dopr_unit
-
-                   hom_index_fl_sgs(cs_pr_count_fl_sgs) = dopr_index(var_count)
-                ENDIF
-             ENDDO
-          ENDIF
-!
-!--       Proceed with resolved-scale fluxes.
-          IF ( TRIM( variable(1:5) ) == 'kc_w*' )  THEN
-             spec_name = TRIM( variable(6:) )
-             DO  lsp = 1, nspec
-                index_start = 6
-                index_end   = LEN( TRIM( variable ) ) - 1
-                spec_name = TRIM( variable(index_start:index_end) )
-                IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) )  THEN
-                   cs_pr_count_fl_res                     = cs_pr_count_fl_res + 1
-                   cs_pr_index_fl_res(cs_pr_count_fl_res) = lsp
-                   dopr_index(var_count)                  = pr_palm + cs_pr_count_sp +             &
-                                                            cs_pr_count_fl_sgs +                   &
-                                                            cs_pr_count_fl_res
-                   dopr_unit                              = 'm ppm s-1'
-                   IF ( spec_name(1:2) == 'PM')  THEN
-                      dopr_unit = 'kg m-2 s-1'
-                   ENDIF
-                   hom(:,2, dopr_index(var_count),:)    = SPREAD( zu, 2, statistic_regions+1 )
-                   unit                                 = dopr_unit
-
-                   hom_index_fl_res(cs_pr_count_fl_res) = dopr_index(var_count)
-                ENDIF
-             ENDDO
-          ENDIF
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
- END SUBROUTINE chem_check_data_output_pr
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for chemistry_model_mod
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_check_parameters
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr, bc_ns
-
-    INTEGER (iwp) ::  lsp          !< running index for chem spcs.
-    INTEGER (iwp) ::  lsp_usr      !< running index for user defined chem spcs
-
-    LOGICAL  ::  found
-
-!
-!-- Check for chemistry time-step
-    IF ( call_chem_at_all_substeps )  THEN
-       message_string =                                                                            &
-       'call_chem_at_all_substeps should only be used for test purposes'
-       CALL message( 'chem_check_parameters', 'PA0522', 0, 1, 0, 6, 0 )
-    ENDIF
-!
-!-- Check for photolysis scheme
-    IF ( ( photolysis_scheme /= 'simple' ) .AND. ( photolysis_scheme /= 'constant' )  )  THEN
-       message_string = 'Incorrect photolysis scheme selected, please check spelling'
-       CALL message( 'chem_check_parameters', 'PA0523', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check for chemical mechanism used
-    CALL get_mechanism_name
-    IF ( chem_mechanism /= TRIM( cs_mech ) )  THEN
-       message_string =                                                                            &
-       'Incorrect chemistry mechanism selected, check spelling in namelist and/or chem_gasphase_mod'
-       CALL message( 'chem_check_parameters', 'PA0551', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check bottom boundary condition and set internal steering parameter
-    IF ( bc_cs_b == 'dirichlet' )  THEN
-       ibc_cs_b = 0
-    ELSEIF ( bc_cs_b == 'neumann' )  THEN
-       ibc_cs_b = 1
-    ELSE
-       message_string = 'unknown boundary condition: bc_cs_b ="' // TRIM( bc_cs_b ) // '"'
-       CALL message( 'chem_check_parameters', 'PA0593', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check top boundary condition and set internal steering parameter
-    IF ( bc_cs_t == 'dirichlet' )  THEN
-       ibc_cs_t = 0
-    ELSEIF ( bc_cs_t == 'neumann' )  THEN
-       ibc_cs_t = 1
-    ELSEIF ( bc_cs_t == 'initial_gradient' )  THEN
-       ibc_cs_t = 2
-    ELSEIF ( bc_cs_t == 'nested' )  THEN
-       ibc_cs_t = 3
-    ELSE
-       message_string = 'unknown boundary condition: bc_c_t ="' // TRIM( bc_cs_t ) // '"'
-       CALL message( 'chem_check_parameters', 'PA0675', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- If nesting_chem = .F., set top boundary condition to its default value
-    IF ( .NOT. nesting_chem  .AND.  ibc_cs_t == 3  )  THEN
-       ibc_cs_t = 2
-       bc_cs_t = 'initial_gradient'
-    ENDIF
-
-!
-!-- Check left and right boundary conditions. First set default value if not set by user.
-    IF ( bc_cs_l == 'undefined' )  THEN
-       IF ( bc_lr == 'cyclic' )  THEN
-          bc_cs_l = 'cyclic'
-       ELSEIF ( bc_lr == 'dirichlet/radiation' )  THEN
-          bc_cs_l = 'dirichlet'
-       ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
-          bc_cs_l = 'neumann'
-       ENDIF
-    ENDIF
-    IF ( bc_cs_r == 'undefined' )  THEN
-       IF ( bc_lr == 'cyclic' )  THEN
-          bc_cs_r = 'cyclic'
-       ELSEIF ( bc_lr == 'dirichlet/radiation' )  THEN
-          bc_cs_r = 'neumann'
-       ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
-          bc_cs_r = 'dirichlet'
-       ENDIF
-    ENDIF
-    IF ( bc_cs_l /= 'dirichlet'  .AND.  bc_cs_l /= 'neumann'  .AND.  bc_cs_l /= 'cyclic' )  THEN
-       message_string = 'unknown boundary condition: bc_cs_l = "' // TRIM( bc_cs_l ) // '"'
-       CALL message( 'chem_check_parameters','PA0505', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( bc_cs_r /= 'dirichlet'  .AND.  bc_cs_r /= 'neumann'  .AND.  bc_cs_r /= 'cyclic' )  THEN
-       message_string = 'unknown boundary condition: bc_cs_r = "' // TRIM( bc_cs_r ) // '"'
-       CALL message( 'chem_check_parameters','PA0505', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check north and south boundary conditions. First set default value if not set by user.
-    IF ( bc_cs_n == 'undefined' )  THEN
-       IF ( bc_ns == 'cyclic' )  THEN
-          bc_cs_n = 'cyclic'
-       ELSEIF ( bc_ns == 'dirichlet/radiation' )  THEN
-          bc_cs_n = 'dirichlet'
-       ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
-          bc_cs_n = 'neumann'
-       ENDIF
-    ENDIF
-    IF ( bc_cs_s == 'undefined' )  THEN
-       IF ( bc_ns == 'cyclic' )  THEN
-          bc_cs_s = 'cyclic'
-       ELSEIF ( bc_ns == 'dirichlet/radiation' )  THEN
-          bc_cs_s = 'neumann'
-       ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
-          bc_cs_s = 'dirichlet'
-       ENDIF
-    ENDIF
-    IF ( bc_cs_n /= 'dirichlet'  .AND.  bc_cs_n /= 'neumann'  .AND.  bc_cs_n /= 'cyclic' )  THEN
-       message_string = 'unknown boundary condition: bc_cs_n = "' // TRIM( bc_cs_n ) // '"'
-       CALL message( 'chem_check_parameters','PA0505', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( bc_cs_s /= 'dirichlet'  .AND.  bc_cs_s /= 'neumann'  .AND.  bc_cs_s /= 'cyclic' )  THEN
-       message_string = 'unknown boundary condition: bc_cs_s = "' // TRIM( bc_cs_s ) // '"'
-       CALL message( 'chem_check_parameters','PA0505', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Cyclic conditions must be set identically at opposing boundaries
-    IF ( ( bc_cs_l == 'cyclic' .AND. bc_cs_r /= 'cyclic' )  .OR.                                   &
-         ( bc_cs_r == 'cyclic' .AND. bc_cs_l /= 'cyclic' ) )  THEN
-       message_string = 'boundary conditions bc_cs_l and bc_cs_r must both be cyclic or non-cyclic'
-       CALL message( 'chem_check_parameters','PA0714', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( ( bc_cs_n == 'cyclic' .AND. bc_cs_s /= 'cyclic' )  .OR.                                   &
-         ( bc_cs_s == 'cyclic' .AND. bc_cs_n /= 'cyclic' ) )  THEN
-       message_string = 'boundary conditions bc_cs_n and bc_cs_s must both be cyclic or non-cyclic'
-       CALL message( 'chem_check_parameters','PA0714', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Set the switches that control application of horizontal boundary conditions at the boundaries
-!-- of the total domain
-    IF ( bc_cs_n == 'dirichlet'  .AND.  nyn == ny )  bc_dirichlet_cs_n = .TRUE.
-    IF ( bc_cs_n == 'neumann'    .AND.  nyn == ny )  bc_radiation_cs_n = .TRUE.
-    IF ( bc_cs_s == 'dirichlet'  .AND.  nys ==  0 )  bc_dirichlet_cs_s = .TRUE.
-    IF ( bc_cs_s == 'neumann'    .AND.  nys ==  0 )  bc_radiation_cs_s = .TRUE.
-    IF ( bc_cs_l == 'dirichlet'  .AND.  nxl ==  0 )  bc_dirichlet_cs_l = .TRUE.
-    IF ( bc_cs_l == 'neumann'    .AND.  nxl ==  0 )  bc_radiation_cs_l = .TRUE.
-    IF ( bc_cs_r == 'dirichlet'  .AND.  nxr == nx )  bc_dirichlet_cs_r = .TRUE.
-    IF ( bc_cs_r == 'neumann'    .AND.  nxr == nx )  bc_radiation_cs_r = .TRUE.
-
-!
-!-- Set the communicator to be used for ghost layer data exchange
-!-- 1: cyclic, 2: cyclic along x, 3: cyclic along y, 4: non-cyclic
-    IF ( bc_cs_l == 'cyclic' )  THEN
-       IF ( bc_cs_s == 'cyclic' )  THEN
-          communicator_chem = 1
-       ELSE
-          communicator_chem = 2
-       ENDIF
-    ELSE
-       IF ( bc_cs_s == 'cyclic' )  THEN
-          communicator_chem = 3
-       ELSE
-          communicator_chem = 4
-       ENDIF
-    ENDIF
-
-!
-!-- chem_check_parameters is called before the array chem_species is allocated!
-!-- temporary switch of this part of the check
-!> TODO: this workaround definitely needs to be removed from here!!!
-    CALL chem_init_internal
-!
-!-- Check for initial chem species input
-    lsp_usr = 1
-    lsp     = 1
-    DO WHILE ( cs_name (lsp_usr) /= 'novalue')
-       found = .FALSE.
-       DO  lsp = 1, nvar
-          IF ( TRIM( cs_name (lsp_usr) ) == TRIM( chem_species(lsp)%name) )  THEN
-             found = .TRUE.
-             EXIT
-          ENDIF
-       ENDDO
-       IF ( .NOT.  found )  THEN
-          message_string = 'Unused/incorrect input for initial surface value: ' //     &
-                            TRIM( cs_name(lsp_usr) )
-          CALL message( 'chem_check_parameters', 'PA0715', 1, 2, 0, 6, 0 )
-       ENDIF
-       lsp_usr = lsp_usr + 1
-    ENDDO
-!
-!-- Check for surface  emission flux chem species
-    lsp_usr = 1
-    lsp     = 1
-    DO WHILE ( surface_csflux_name (lsp_usr) /= 'novalue')
-       found = .FALSE.
-       DO  lsp = 1, nvar
-          IF ( TRIM( surface_csflux_name (lsp_usr) ) == TRIM( chem_species(lsp)%name ) )  THEN
-             found = .TRUE.
-             EXIT
-          ENDIF
-       ENDDO
-       IF ( .NOT.  found )  THEN
-          message_string = 'Unused/incorrect input of chemical species for surface emission fluxes: '  &
-                            // TRIM( surface_csflux_name(lsp_usr) )
-          CALL message( 'chem_check_parameters', 'PA0716', 1, 2, 0, 6, 0 )
-       ENDIF
-       lsp_usr = lsp_usr + 1
-    ENDDO
-
- END SUBROUTINE chem_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining 2D output variables for chemical species
-!> @todo: Remove "mode" from argument list, not used.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do, &
-                                 fill_value )
-
-
-    CHARACTER (LEN=*) ::  grid       !<
-    CHARACTER (LEN=*) ::  mode       !<
-    CHARACTER (LEN=*) ::  variable   !<
-
-    INTEGER(iwp) ::  av              !< flag to control data output of instantaneous or
-                                     !< time-averaged data
-    INTEGER(iwp) ::  nzb_do          !< lower limit of the domain (usually nzb)
-    INTEGER(iwp) ::  nzt_do          !< upper limit of the domain (usually nzt+1)
-
-    LOGICAL      ::  found           !<
-    LOGICAL      ::  two_d           !< flag parameter that indicates 2D variables (horizontal cross
-                                     !< sections)
-
-    REAL(wp)     ::  fill_value
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) ::  local_pf
-
-!
-!-- local variables.
-    CHARACTER(LEN=16)    ::  spec_name
-    INTEGER(iwp) ::  lsp
-    INTEGER(iwp) ::  i               !< grid index along x-direction
-    INTEGER(iwp) ::  j               !< grid index along y-direction
-    INTEGER(iwp) ::  k               !< grid index along z-direction
-    INTEGER(iwp) ::  m               !< running indices for surfaces
-    INTEGER(iwp) ::  char_len        !< length of a character string
-!
-!-- Next statement is to avoid compiler warnings about unused variables
-    IF ( mode(1:1) == ' '  .OR.  two_d )  CONTINUE
-
-    found = .FALSE.
-    char_len  = LEN_TRIM( variable )
-
-    spec_name = TRIM( variable(4:char_len-3) )
-!
-!-- Output of emission values, i.e. surface fluxes cssws.
-    IF ( variable(1:3) == 'em_' )  THEN
-
-       local_pf = 0.0_wp
-
-       DO  lsp = 1, nvar
-          IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name) )  THEN
-!
-!--          No average output for now.
-!--          !!! IT NEEDS TO RETHINK - with fully 3D structure, only lower (upper)
-!--          !!! upward facing horizontal surfaces should be taken into account here
-             DO  m = 1, surf_lsm_h(0)%ns
-                local_pf(surf_lsm_h(0)%i(m),surf_lsm_h(0)%j(m),nzb+1) =                                  &
-                                                   local_pf(surf_lsm_h(0)%i(m),surf_lsm_h(0)%j(m),nzb+1) &
-                                                   + surf_lsm_h(0)%cssws(lsp,m)
-             ENDDO
-             DO  m = 1, surf_usm_h(0)%ns
-                   local_pf(surf_usm_h(0)%i(m),surf_usm_h(0)%j(m),nzb+1) =                               &
-                                                   local_pf(surf_usm_h(0)%i(m),surf_usm_h(0)%j(m),nzb+1) &
-                                                   + surf_usm_h(0)%cssws(lsp,m)
-             ENDDO
-             grid = 'zu'
-             found = .TRUE.
-          ENDIF
-       ENDDO
-
-    ELSE
-
-       DO  lsp=1,nspec
-          IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name )  .AND.                          &
-                ( (variable(char_len-2:) == '_xy')  .OR.                                           &
-                  (variable(char_len-2:) == '_xz')  .OR.                                           &
-                  (variable(char_len-2:) == '_yz') ) )  THEN
-             IF (av == 0)  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                           local_pf(i,j,k) = MERGE(                                                &
-                                              chem_species(lsp)%conc(k,j,i),                       &
-                                              REAL( fill_value, KIND = wp ),                       &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             ELSE
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                           local_pf(i,j,k) = MERGE(                                                &
-                                              chem_species(lsp)%conc_av(k,j,i),                    &
-                                              REAL( fill_value, KIND = wp ),                       &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-             grid = 'zu'
-             found = .TRUE.
-          ENDIF
-       ENDDO
-    ENDIF
-
-    RETURN
-
- END SUBROUTINE chem_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining 3D output variables for chemical species
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-
-
-    USE surface_mod
-
-    CHARACTER (LEN=*)    ::  variable     !<
-
-    INTEGER(iwp)         ::  av         !<
-    INTEGER(iwp) ::  nzb_do             !< lower limit of the data output (usually 0)
-    INTEGER(iwp) ::  nzt_do             !< vertical upper limit of the data output (usually nz_do3d)
-
-    LOGICAL      ::  found                !<
-
-    REAL(wp)             ::  fill_value   !<
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf
-!
-!-- Local variables
-    CHARACTER(LEN=16)    ::  spec_name
-
-    INTEGER(iwp)         ::  i
-    INTEGER(iwp)         ::  j
-    INTEGER(iwp)         ::  k
-    INTEGER(iwp)         ::  m       !< running indices for surfaces
-    INTEGER(iwp)         ::  l
-    INTEGER(iwp)         ::  lsp     !< running index for chem spcs
-
-
-    found = .FALSE.
-    IF ( .NOT. (variable(1:3) == 'kc_' .OR. variable(1:3) == 'em_' ) )  THEN
-       RETURN
-    ENDIF
-
-    spec_name = TRIM( variable(4:) )
-
-    IF ( variable(1:3) == 'em_' )  THEN
-
-       DO  lsp = 1, nvar   !!! cssws - nvar species, chem_species - nspec species !!!
-          IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name) )  THEN
-
-             local_pf = 0.0_wp
-!
-!--          no average for now
-             DO l = 0, 1
-                DO  m = 1, surf_usm_h(l)%ns
-                   local_pf(surf_usm_h(l)%i(m),surf_usm_h(l)%j(m),surf_usm_h(l)%k(m)) =            &
-                                local_pf(surf_usm_h(l)%i(m),surf_usm_h(l)%j(m),surf_usm_h(l)%k(m)) &
-                                + surf_usm_h(l)%cssws(lsp,m)
-                ENDDO
-                DO  m = 1, surf_lsm_h(l)%ns
-                   local_pf(surf_lsm_h(l)%i(m),surf_lsm_h(l)%j(m),surf_lsm_h(l)%k(m)) =            &
-                                local_pf(surf_lsm_h(l)%i(m),surf_lsm_h(l)%j(m),surf_lsm_h(l)%k(m)) &
-                                + surf_lsm_h(l)%cssws(lsp,m)
-                ENDDO
-             ENDDO
-             DO  l = 0, 3
-                DO  m = 1, surf_usm_v(l)%ns
-                   local_pf(surf_usm_v(l)%i(m),surf_usm_v(l)%j(m),surf_usm_v(l)%k(m)) =            &
-                                local_pf(surf_usm_v(l)%i(m),surf_usm_v(l)%j(m),surf_usm_v(l)%k(m)) &
-                                + surf_usm_v(l)%cssws(lsp,m)
-                ENDDO
-                DO  m = 1, surf_lsm_v(l)%ns
-                   local_pf(surf_lsm_v(l)%i(m),surf_lsm_v(l)%j(m),surf_lsm_v(l)%k(m)) =            &
-                                local_pf(surf_lsm_v(l)%i(m),surf_lsm_v(l)%j(m),surf_lsm_v(l)%k(m)) &
-                                + surf_lsm_v(l)%cssws(lsp,m)
-                ENDDO
-             ENDDO
-             found = .TRUE.
-          ENDIF
-       ENDDO
-    ELSE
-      DO  lsp = 1, nspec
-         IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name) )  THEN
-            IF (av == 0)  THEN
-               DO  i = nxl, nxr
-                  DO  j = nys, nyn
-                     DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE(                                                  &
-                                             chem_species(lsp)%conc(k,j,i),                        &
-                                             REAL( fill_value, KIND = wp ),                        &
-                                             BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                     ENDDO
-                  ENDDO
-               ENDDO
-
-            ELSE
-
-               DO  i = nxl, nxr
-                  DO  j = nys, nyn
-                     DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE(                                                  &
-                                             chem_species(lsp)%conc_av(k,j,i),                     &
-                                             REAL( fill_value, KIND = wp ),                        &
-                                             BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                     ENDDO
-                  ENDDO
-               ENDDO
-            ENDIF
-            found = .TRUE.
-         ENDIF
-      ENDDO
-    ENDIF
-
-    RETURN
-
- END SUBROUTINE chem_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining mask output variables for chemical species
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_data_output_mask( av, variable, found, local_pf, mid )
-
-
-    USE control_parameters
-
-    REAL(wp), PARAMETER ::  fill_value = -9999.0_wp    !< value for the _FillValue attribute
-
-    CHARACTER(LEN=16) ::  spec_name
-    CHARACTER(LEN=*)  ::  variable    !<
-
-    INTEGER(iwp) ::  av              !< flag to control data output of instantaneous or
-                                     !< time-averaged data
-    INTEGER(iwp) ::  i               !< grid index along x-direction
-    INTEGER(iwp) ::  im              !< loop index for masked variables
-    INTEGER(iwp) ::  j               !< grid index along y-direction
-    INTEGER(iwp) ::  jm              !< loop index for masked variables
-    INTEGER(iwp) ::  k               !< grid index along z-direction
-    INTEGER(iwp) ::  kk              !< masked output index along z-direction
-    INTEGER(iwp) ::  ktt             !< k index of lowest non-terrain grid point
-    INTEGER(iwp) ::  lsp
-    INTEGER(iwp) ::  mid             !< masked output running index
-
-    LOGICAL ::  found
-
-    REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  local_pf   !<
-
-
-!
-!-- Local variables.
-
-    spec_name = TRIM( variable(4:) )
-    found = .FALSE.
-
-    DO  lsp=1,nspec
-       IF (TRIM( spec_name ) == TRIM( chem_species(lsp)%name) )  THEN
-          IF (av == 0)  THEN
-             IF ( .NOT. mask_surface(mid) )  THEN
-
-                DO  i = 1, mask_size_l(mid,1)
-                   DO  j = 1, mask_size_l(mid,2)
-                      DO  k = 1, mask_size(mid,3)
-                          local_pf(i,j,k) = chem_species(lsp)%conc( mask_k(mid,k),                 &
-                                                                    mask_j(mid,j),                 &
-                                                                    mask_i(mid,i)      )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             ELSE
-!
-!--             Terrain-following masked output
-                DO  i = 1, mask_size_l(mid,1)
-                   DO  j = 1, mask_size_l(mid,2)
-!
-!--                   Get k index of the lowest non-terrain grid point
-                      im = mask_i(mid,i)
-                      jm = mask_j(mid,j)
-                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ),        &
-                                    DIM = 1 ) - 1
-                      DO  k = 1, mask_size_l(mid,3)
-                         kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                      Set value if not in building, else set fill value
-                         IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                            local_pf(i,j,k) = fill_value
-                         ELSE
-                            local_pf(i,j,k) = chem_species(lsp)%conc(kk,jm,im)
-                         ENDIF
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             ENDIF
-          ELSE
-             IF ( .NOT. mask_surface(mid) )  THEN
-
-                DO  i = 1, mask_size_l(mid,1)
-                   DO  j = 1, mask_size_l(mid,2)
-                      DO  k =  1, mask_size_l(mid,3)
-                          local_pf(i,j,k) = chem_species(lsp)%conc_av(  mask_k(mid,k),             &
-                                                                        mask_j(mid,j),             &
-                                                                        mask_i(mid,i)         )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             ELSE
-!
-!--             Terrain-following masked output
-                DO  i = 1, mask_size_l(mid,1)
-                   DO  j = 1, mask_size_l(mid,2)
-!
-!--                   Get k index of the lowest non-terrain grid point
-                      im = mask_i(mid,i)
-                      jm = mask_j(mid,j)
-                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),         &
-                                    DIM = 1 ) - 1
-                      DO  k = 1, mask_size_l(mid,3)
-                         kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                      Set value if not in building, else set fill value
-                         IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                            local_pf(i,j,k) = fill_value
-                         ELSE
-                            local_pf(i,j,k) = chem_species(lsp)%conc_av(kk,jm,im)
-                         ENDIF
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             ENDIF
-
-          ENDIF
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    RETURN
-
- END SUBROUTINE chem_data_output_mask
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining appropriate grid for netcdf variables.
-!> It is called out from subroutine netcdf.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-
-    CHARACTER (LEN=*), INTENT(IN)  ::  var          !<
-
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_x       !<
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y       !<
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z       !<
-
-    LOGICAL, INTENT(OUT)           ::  found        !<
-
-    found  = .TRUE.
-
-    IF ( var(1:3) == 'kc_' .OR. var(1:3) == 'em_' )  THEN                !< always the same grid for
-                                                                         !< chemistry variables
-       grid_x = 'x'
-       grid_y = 'y'
-       grid_z = 'zu'
-    ELSE
-       found  = .FALSE.
-       grid_x = 'none'
-       grid_y = 'none'
-       grid_z = 'none'
-    ENDIF
-
-
- END SUBROUTINE chem_define_netcdf_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining header output for chemistry model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_header( io )
-
-    CHARACTER (LEN=80)  :: docsflux_chr
-    CHARACTER (LEN=80)  :: docsinit_chr
-
-    INTEGER(iwp), INTENT(IN) ::  io            !< Unit of the output file
-
-    INTEGER(iwp)  :: cs_fixed
-    INTEGER(iwp)  :: lsp                       !< running index for chem spcs
-
-!
-!-- Get name of chemical mechanism from chem_gasphase_mod
-    CALL get_mechanism_name
-!
-!-- Write chemistry model  header
-    WRITE( io, 1 )
-!
-!-- Gasphase reaction status
-    IF ( chem_gasphase_on )  THEN
-       WRITE( io, 2 )
-    ELSE
-       WRITE( io, 3 )
-    ENDIF
-!
-!-- Emission mode info
-    WRITE( io, 4 )  emiss_read_legacy_mode
-!
-!-- At the moment the evaluation is done with both emiss_lod and mode_emis but once salsa has been
-!-- migrated to emiss_lod the .OR. mode_emis conditions can be removed
-    IF     ( ( emiss_lod == 1 )  .OR.  ( mode_emis == 'DEFAULT' ) )        THEN
-        WRITE ( io, 5 )
-    ELSEIF ( ( emiss_lod == 0 )  .OR.  ( mode_emis == 'PARAMETERIZED' ) )  THEN
-        WRITE ( io, 6 )
-    ELSEIF ( ( emiss_lod == 2 )  .OR.  ( mode_emis == 'PRE-PROCESSED' ) )  THEN
-        WRITE ( io, 7 )
-    ENDIF
-!
-!-- Photolysis scheme info
-    IF ( photolysis_scheme == "simple" )  THEN
-       WRITE( io, 8 )
-    ELSEIF (photolysis_scheme == "constant" )  THEN
-       WRITE( io, 9 )
-    ENDIF
-!
-!-- Emission flux info
-    lsp = 1
-    docsflux_chr ='Chemical species for surface emission flux: '
-    DO WHILE ( surface_csflux_name(lsp) /= 'novalue' )
-       docsflux_chr = TRIM( docsflux_chr ) // ' ' // TRIM( surface_csflux_name(lsp) ) // ','
-       IF ( LEN_TRIM( docsflux_chr ) >= 75 )  THEN
-          WRITE ( io, 10 )  docsflux_chr
-          docsflux_chr = '       '
-       ENDIF
-       lsp = lsp + 1
-    ENDDO
-
-    IF ( docsflux_chr /= '' )  THEN
-       WRITE ( io, 10 )  docsflux_chr
-    ENDIF
-!
-!-- Initialization of Surface and profile chemical species
-    lsp = 1
-    docsinit_chr ='Chemical species for initial surface and profile emissions: '
-    DO WHILE ( cs_name(lsp) /= 'novalue' )
-       docsinit_chr = TRIM( docsinit_chr ) // ' ' // TRIM( cs_name(lsp) ) // ','
-       IF ( LEN_TRIM( docsinit_chr ) >= 75 )  THEN
-          WRITE ( io, 11 )  docsinit_chr
-          docsinit_chr = '       '
-       ENDIF
-       lsp = lsp + 1
-    ENDDO
-
-    IF ( docsinit_chr /= '' )  THEN
-       WRITE ( io, 11 )  docsinit_chr
-    ENDIF
-
-    IF ( nesting_chem )  WRITE( io, 12 )  nesting_chem
-    IF ( nesting_offline_chem .AND. nesting_offline )  WRITE( io, 13 )  nesting_offline_chem
-
-    WRITE( io, 14 )  TRIM( bc_cs_b ), TRIM( bc_cs_t ), TRIM( bc_cs_s ), TRIM( bc_cs_n ),           &
-                     TRIM( bc_cs_l ), TRIM( bc_cs_r )
-
-!
-!-- Number of variable and fix chemical species and number of reactions
-    cs_fixed = nspec - nvar
-    WRITE ( io, * ) '   --> Chemical Mechanism          : ', cs_mech
-    WRITE ( io, * ) '   --> Chemical species, variable  : ', nvar
-    WRITE ( io, * ) '   --> Chemical species, fixed     : ', cs_fixed
-    WRITE ( io, * ) '   --> Total number of reactions   : ', nreact
-    WRITE ( io, * ) '   --> Gas phase chemistry solver  : ', icntrl(3)
-    WRITE ( io, * ) '   --> Vector length (vector mode if > 1): ', vl_dim
-
-
-1   FORMAT (//' Chemistry model information:'/' ----------------------------'/)
-2   FORMAT ('    --> Chemical reactions are turned on')
-3   FORMAT ('    --> Chemical reactions are turned off')
-4   FORMAT ('    --> Legacy emission read mode: ',L3,/,                                            &
-            '        All emissions data will be loaded prior to start of simulation')
-5   FORMAT ('    --> Emission mode = DEFAULT ')
-6   FORMAT ('    --> Emission mode = PARAMETERIZED (LOD 0)')
-7   FORMAT ('    --> Emission mode = PRE-PROCESSED (LOD 2)')
-8   FORMAT ('    --> Photolysis scheme used =  simple ')
-9   FORMAT ('    --> Photolysis scheme used =  constant ')
-10  FORMAT (/'    ',A)
-11  FORMAT (/'    ',A)
-12  FORMAT (/'    Self nesting for chemistry variables (if nested_run): ', L1 )
-13  FORMAT (/'    Offline nesting for chemistry variables : ', L1 )
-14  FORMAT (/'    Boundary conditions for chemical species:', /                                     &
-             '       bottom/top:   ',A10,' / ',A10, /                                               &
-             '       north/south:  ',A10,' / ',A10, /                                               &
-             '       left/right:   ',A10,' / ',A10)
-
- END SUBROUTINE chem_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine initializating chemistry_model_mod specific arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_init_arrays
-!
-!-- Please use this place to allocate required arrays
-
- END SUBROUTINE chem_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine initializating chemistry_model_mod
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_init
-
-!
-!-- NB introduced additional interfaces for on-demand emission update
-
-!    USE chem_emissions_mod,                                                                        &
-!        ONLY:  chem_emissions_init
-
-    USE chem_emissions_mod,                                                                        &
-        ONLY:  chem_emissions_header_init, chem_emissions_init
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  init_3d
-
-
-    INTEGER(iwp) ::  i !< running index x dimension
-    INTEGER(iwp) ::  j !< running index y dimension
-    INTEGER(iwp) ::  n !< running index for chemical species
-
-
-    IF ( debug_output )  CALL debug_message( 'chem_init', 'start' )
-!
-!-- Next statement is to avoid compiler warning about unused variables
-    IF ( ( ilu_arable + ilu_coniferous_forest + ilu_deciduous_forest + ilu_mediterrean_scrub +     &
-           ilu_permanent_crops + ilu_savanna + ilu_semi_natural_veg + ilu_tropical_forest +        &
-           ilu_urban ) == 0 )  CONTINUE
-
-!
-!-- NB Calls specific emisisons initialization subroutines for legacy mode and on-demand mode
-
-!    IF ( emissions_anthropogenic )  CALL chem_emissions_init
-
-    IF  ( emissions_anthropogenic )  THEN
-
-       IF  ( emiss_read_legacy_mode )  THEN
-          CALL chem_emissions_init
-       ELSE
-          CALL chem_emissions_header_init
-       ENDIF
-
-    ENDIF
-
-
-!
-!-- Chemistry variables will be initialized if availabe from dynamic input file. Note, it is
-!-- possible to initialize only part of the chemistry variables from dynamic input.
-    IF ( INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
-       DO  n = 1, nspec
-          IF ( init_3d%from_file_chem(n) )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   chem_species(n)%conc(:,j,i) = init_3d%chem_init(:,n)
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDDO
-    ENDIF
-
-    IF ( debug_output )  CALL debug_message( 'chem_init', 'end' )
-
- END SUBROUTINE chem_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine initializating chemistry_model_mod
-!> internal workaround for chem_species dependency in chem_check_parameters
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_init_internal
-
-    USE pegrid
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  chem_emis, chem_emis_att, input_pids_dynamic, init_3d,                              &
-               netcdf_data_input_chemistry_data
-
-!
-!-- Local variables
-    INTEGER(iwp) ::  i                 !< running index for for horiz numerical grid points
-    INTEGER(iwp) ::  j                 !< running index for for horiz numerical grid points
-    INTEGER(iwp) ::  lpr_lev           !< running index for chem spcs profile level
-    INTEGER(iwp) ::  lsp               !< running index for chem spcs
-
-    REAL(wp)     ::  flag              !< flag for masking topography/building grid points
-!
-!-- NB reads netcdf data only under legacy mode
-
-!    IF ( emissions_anthropogenic )  THEN
-!       CALL netcdf_data_input_chemistry_data( chem_emis_att, chem_emis )
-!    ENDIF
-
-    IF ( emissions_anthropogenic )  THEN
-       IF ( emiss_read_legacy_mode )  THEN
-          CALL netcdf_data_input_chemistry_data( chem_emis_att, chem_emis )
-       ENDIF
-    ENDIF
-
-!
-!-- Allocate memory for chemical species
-    ALLOCATE( chem_species(nspec) )
-    ALLOCATE( spec_conc_1 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
-    ALLOCATE( spec_conc_2 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
-    ALLOCATE( spec_conc_3 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
-    ALLOCATE( phot_frequen(nphot) )
-    ALLOCATE( freq_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nphot) )
-    ALLOCATE( bc_cs_t_val(nspec) )
-!
-!-- Initialize arrays
-    spec_conc_1 (:,:,:,:) = 0.0_wp
-    spec_conc_2 (:,:,:,:) = 0.0_wp
-    spec_conc_3 (:,:,:,:) = 0.0_wp
-
-!
-!-- Allocate array to store locally summed-up resolved-scale vertical fluxes.
-    IF ( scalar_advec == 'ws-scheme' )  THEN
-       ALLOCATE( sums_ws_l(nzb:nzt+1,0:threads_per_task-1,nspec) )
-       sums_ws_l = 0.0_wp
-    ENDIF
-
-    DO  lsp = 1, nspec
-       chem_species(lsp)%name    = spc_names(lsp)
-
-       chem_species(lsp)%conc   (nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_1 (:,:,:,lsp)
-       chem_species(lsp)%conc_p (nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_2 (:,:,:,lsp)
-       chem_species(lsp)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_3 (:,:,:,lsp)
-
-       ALLOCATE (chem_species(lsp)%cssws_av(nysg:nyng,nxlg:nxrg))
-       chem_species(lsp)%cssws_av    = 0.0_wp
-!
-!--    The following block can be useful when emission module is not applied. &
-!--    If emission module is applied the following block will be overwritten.
-       ALLOCATE (chem_species(lsp)%flux_s_cs(nzb+1:nzt,0:threads_per_task-1))
-       ALLOCATE (chem_species(lsp)%diss_s_cs(nzb+1:nzt,0:threads_per_task-1))
-       ALLOCATE (chem_species(lsp)%flux_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1))
-       ALLOCATE (chem_species(lsp)%diss_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1))
-       chem_species(lsp)%flux_s_cs = 0.0_wp
-       chem_species(lsp)%flux_l_cs = 0.0_wp
-       chem_species(lsp)%diss_s_cs = 0.0_wp
-       chem_species(lsp)%diss_l_cs = 0.0_wp
-!
-!--   Allocate memory for initial concentration profiles (concentration values come from namelist)
-!--   (@todo (FK): Because of this, chem_init is called in palm before check_parameters, since
-!--                conc_pr_init is used there.
-!--                We have to find another solution since chem_init should eventually be called from
-!--                init_3d_model!!)
-       ALLOCATE ( chem_species(lsp)%conc_pr_init(0:nz+1) )
-       chem_species(lsp)%conc_pr_init(:) = 0.0_wp
-
-    ENDDO
-
-!
-!-- For chemistry variables lateral boundary conditions can be set non-cyclic while 
-!-- the other scalars may have cyclic boundary conditions.
-!-- However, large gradients near the boundaries may produce stationary numerical 
-!-- oscillations near the lateral boundaries when a higher-order scheme is
-!-- applied near these boundaries.
-!-- To get rid-off this, set-up additional flags that control the order of the scalar advection
-!-- scheme near the lateral boundaries for passive scalars with non-cyclic bcs
-    IF ( scalar_advec == 'ws-scheme' )  THEN
-       ALLOCATE( cs_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!
-!--    In case of non-cyclic boundary conditions set wall_flags_total_0 bit 31 
-!--    Bit 31 is used to identify extended degradation zones.
-!--    Note, since several also other modules like Salsa or other future one may access this bit but
-!--    may have other boundary conditions, the original value of wall_flags_total_0 bit 31 must not
-!--    be modified. Hence, store the boundary conditions directly on cs_advc_flags_s.
-!--    cs_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used to
-!--    control the numerical order.
-!--    Initialize with flag 31 only.
-       cs_advc_flags_s = 0
-       cs_advc_flags_s = MERGE( IBSET( cs_advc_flags_s, 31 ), 0, BTEST( wall_flags_total_0, 31 ) )
-
-       IF ( bc_dirichlet_cs_n .OR. bc_dirichlet_cs_s )  THEN
-          IF ( nys == 0  )  THEN
-             DO  i = 1, nbgp
-                cs_advc_flags_s(:,nys-i,:) = MERGE(                                                &
-                                                    IBSET( cs_advc_flags_s(:,nys,:), 31 ),         &
-                                                    IBCLR( cs_advc_flags_s(:,nys,:), 31 ),         &
-                                                    BTEST( cs_advc_flags_s(:,nys,:), 31 )          &
-                                                  )
-             ENDDO
-          ENDIF
-          IF ( nyn == ny )  THEN
-             DO  i = 1, nbgp
-                cs_advc_flags_s(:,nyn+i,:) = MERGE(                                                &
-                                                    IBSET( cs_advc_flags_s(:,nyn,:), 31 ),         &
-                                                    IBCLR( cs_advc_flags_s(:,nyn,:), 31 ),         &
-                                                    BTEST( cs_advc_flags_s(:,nyn,:), 31 )          &
-                                                  )
-             ENDDO
-          ENDIF
-       ENDIF
-       IF ( bc_dirichlet_cs_l .OR. bc_dirichlet_cs_r )  THEN
-          IF ( nxl == 0  )  THEN
-             DO  i = 1, nbgp
-                cs_advc_flags_s(:,:,nxl-i) = MERGE(                                                &
-                                                    IBSET( cs_advc_flags_s(:,:,nxl), 31 ),         &
-                                                    IBCLR( cs_advc_flags_s(:,:,nxl), 31 ),         &
-                                                    BTEST( cs_advc_flags_s(:,:,nxl), 31 )          &
-                                                  )
-             ENDDO
-          ENDIF
-          IF ( nxr == nx )  THEN
-             DO  i = 1, nbgp
-                cs_advc_flags_s(:,:,nxr+i) = MERGE(                                                &
-                                                    IBSET( cs_advc_flags_s(:,:,nxr), 31 ), &
-                                                    IBCLR( cs_advc_flags_s(:,:,nxr), 31 ), &
-                                                    BTEST( cs_advc_flags_s(:,:,nxr), 31 )  &
-                                                  )
-             ENDDO
-          ENDIF
-
-       ENDIF
-!
-!--    To initialize advection flags appropriately, pass the boundary flags.
-!--    The last argument indicates that a passive scalar is treated, where the horizontal advection
-!--    terms are degraded already 2 grid points before the lateral boundary to avoid stationary
-!--    oscillations at large-gradients.
-!--    Also, extended degradation zones are applied, where horizontal advection of passive scalars
-!--    is discretized by first-order scheme at all grid points that in the vicinity of buildings
-!--    (<= 3 grid points). Even though no building is within the numerical stencil, first-order
-!--    scheme is used.
-!--    At fourth and fifth grid point the order of the horizontal advection scheme
-!--    is successively upgraded.
-!--    These extended degradation zones are used to avoid stationary numerical oscillations, which
-!--    are responsible for high concentration maxima that may appear under shear-free stable
-!--    conditions.
-       CALL ws_init_flags_scalar( bc_dirichlet_cs_l  .OR.  bc_radiation_cs_l,                      &
-                                  bc_dirichlet_cs_n  .OR.  bc_radiation_cs_n,                      &
-                                  bc_dirichlet_cs_r  .OR.  bc_radiation_cs_r,                      &
-                                  bc_dirichlet_cs_s  .OR.  bc_radiation_cs_s,                      &
-                                  cs_advc_flags_s, .TRUE. )
-    ENDIF
-!
-!-- Initial concentration of profiles is prescribed by parameters cs_profile and cs_heights in the
-!-- namelist &chemistry_parameters.
-    CALL chem_init_profiles
-!
-!-- In case there is dynamic input file, create a list of names for chemistry initial input files.
-!-- Also, initialize array that indicates whether the respective variable is on file or not.
-    IF ( input_pids_dynamic )  THEN
-       ALLOCATE( init_3d%var_names_chem(1:nspec) )
-       ALLOCATE( init_3d%from_file_chem(1:nspec) )
-       init_3d%from_file_chem(:) = .FALSE.
-
-       DO  lsp = 1, nspec
-          init_3d%var_names_chem(lsp) = init_3d%init_char // TRIM( chem_species(lsp)%name )
-       ENDDO
-    ENDIF
-!
-!-- Initialize model variables
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.                                &
-         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
-!
-!--    First model run of a possible job queue.
-!--    Initial profiles of the variables must be computed.
-       IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
-!
-!--       Transfer initial profiles to the arrays of the 3D model
-!--       Concentrations within buildings are set to zero.
-          DO  lsp = 1, nspec
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO lpr_lev = 1, nz + 1
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(lpr_lev,j,i), 0 ) )
-                      chem_species(lsp)%conc(lpr_lev,j,i) = chem_species(lsp)%conc_pr_init(lpr_lev)&
-                                                            * flag
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles') /= 0 )  THEN
-
-          DO  lsp = 1, nspec
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO  lpr_lev = nzb, nz+1
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(lpr_lev,j,i), 0 ) )
-                      chem_species(lsp)%conc(lpr_lev,j,i) = chem_species(lsp)%conc_pr_init(lpr_lev)&
-                                                            * flag
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ENDIF
-!
-    ENDIF
-!
-!-- Initial old and new time levels. Note, this has to be done also in restart runs
-    DO  lsp = 1, nvar
-       chem_species(lsp)%tconc_m = 0.0_wp
-       chem_species(lsp)%conc_p  = chem_species(lsp)%conc
-    ENDDO
-
-    DO  lsp = 1, nphot
-       phot_frequen(lsp)%name = phot_names(lsp)
-       phot_frequen(lsp)%freq(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  =>  freq_1(:,:,:,lsp)
-    ENDDO
-
-!    CALL photolysis_init   ! probably also required for restart
-
-    RETURN
-
- END SUBROUTINE chem_init_internal
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining initial vertical profiles of chemical species (given by namelist parameters
-!> chem_profiles and chem_heights)  --> which should work analogically to parameters u_profile,
-!> v_profile and uv_heights)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_init_profiles
-
-    USE chem_modules
-
-!
-!-- Local variables
-    INTEGER ::  lpr_lev    !< running index for profile level for each chem spcs.
-    INTEGER ::  lsp        !< running index for number of species in derived data type species_def
-    INTEGER ::  lsp_usr    !< running index for number of species (user defined)  in cs_names,
-                           !< cs_profiles etc
-    INTEGER ::  npr_lev    !< the next available profile lev
-!
-!-- Parameter "cs_profile" and "cs_heights" are used to prescribe user defined initial profiles
-!-- and heights. If parameter "cs_profile" is not prescribed then initial surface values
-!-- "cs_surface" are used as constant initial profiles for each species. If "cs_profile" and
-!-- "cs_heights" are prescribed, their values will!override the constant profile given by
-!-- "cs_surface".
-!     IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-    lsp_usr = 1
-    DO  WHILE ( TRIM( cs_name( lsp_usr ) ) /= 'novalue' )   !'novalue' is the default
-       DO  lsp = 1, nspec                                !
-!
-!--       Create initial profile (conc_pr_init) for each chemical species
-          IF ( TRIM( chem_species(lsp)%name ) == TRIM( cs_name(lsp_usr) ) )  THEN
-             IF ( cs_profile(lsp_usr,1) == 9999999.9_wp )  THEN
-!
-!--            Set a vertically constant profile based on the surface conc (cs_surface(lsp_usr)) of
-!--            each species
-                DO lpr_lev = 0, nzt+1
-                   chem_species(lsp)%conc_pr_init(lpr_lev) = cs_surface(lsp_usr)
-                ENDDO
-             ELSE
-                IF ( cs_heights(1,1) /= 0.0_wp )  THEN
-                   message_string = 'The surface value of cs_heights must be 0.0'
-                   CALL message( 'chem_check_parameters', 'PA0717', 1, 2, 0, 6, 0 )
-                ENDIF
-
-                use_prescribed_profile_data = .TRUE.
-
-                npr_lev = 1
-!                chem_species(lsp)%conc_pr_init(0) = 0.0_wp
-                DO  lpr_lev = 1, nz+1
-                   IF ( npr_lev < 100 )  THEN
-                      DO  WHILE ( cs_heights(lsp_usr, npr_lev+1) <= zu(lpr_lev) )
-                         npr_lev = npr_lev + 1
-                         IF ( npr_lev == 100 )  THEN
-                            message_string = 'number of chem spcs exceeding the limit'
-                            CALL message( 'chem_check_parameters', 'PA0730', 1, 2, 0, 6, 0 )
-                            EXIT
-                         ENDIF
-                      ENDDO
-                   ENDIF
-                   IF ( npr_lev < 100  .AND.  cs_heights(lsp_usr,npr_lev+1) /= 9999999.9_wp )  THEN
-                      chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp_usr, npr_lev) +     &
-                           ( zu(lpr_lev) - cs_heights(lsp_usr, npr_lev) ) /                        &
-                           ( cs_heights(lsp_usr, (npr_lev + 1)) - cs_heights(lsp_usr, npr_lev ) ) *&
-                           ( cs_profile(lsp_usr, (npr_lev + 1)) - cs_profile(lsp_usr, npr_lev ) )
-                   ELSE
-                      chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp_usr, npr_lev)
-                   ENDIF
-                ENDDO
-             ENDIF
-!
-!--       If a profile is prescribed explicity using cs_profiles and cs_heights, then
-!--       chem_species(lsp)%conc_pr_init is populated with the specific "lsp" based on the
-!--       cs_profiles(lsp_usr,:)  and cs_heights(lsp_usr,:).
-          ENDIF
-
-       ENDDO
-
-       lsp_usr = lsp_usr + 1
-    ENDDO
-!     ENDIF
-
- END SUBROUTINE chem_init_profiles
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to integrate chemical species in the given chemical mechanism
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_integrate_ij( i, j )
-
-    USE statistics,                                                                                &
-        ONLY:  weight_pres
-
-    USE control_parameters,                                                                        &
-        ONLY:  dt_3d, intermediate_timestep_count, time_since_reference_point
-
-    REAL(wp), PARAMETER              ::  fr2ppm  = 1.0e6_wp              !< Conversion factor fraction to ppm
-!    REAL(wp), PARAMETER              ::  xm_air  = 28.96_wp              !< Mole mass of dry air
-!    REAL(wp), PARAMETER              ::  xm_h2o  = 18.01528_wp           !< Mole mass of water vapor
-    REAL(wp), PARAMETER              ::  p_std   = 101325.0_wp           !< standard pressure (Pa)
-    REAL(wp), PARAMETER              ::  ppm2fr  = 1.0e-6_wp             !< Conversion factor ppm to fraction
-    REAL(wp), PARAMETER              ::  t_std   = 273.15_wp             !< standard pressure (Pa)
-    REAL(wp), PARAMETER              ::  vmolcm  = 22.414e3_wp           !< Mole volume (22.414 l) in cm^3
-    REAL(wp), PARAMETER              ::  xna     = 6.022e23_wp           !< Avogadro number (molecules/mol)
-
-    INTEGER,INTENT(IN)       :: i
-    INTEGER,INTENT(IN)       :: j
-!
-!-- Local variables
-    INTEGER(iwp) ::  lph                                 !< running index for photolysis frequencies
-    INTEGER(iwp) ::  lsp                                 !< running index for chem spcs.
-
-    INTEGER, DIMENSION(20)        :: istatus
-
-    INTEGER,DIMENSION(nzb+1:nzt)  :: nacc          !< Number of accepted steps
-    INTEGER,DIMENSION(nzb+1:nzt)  :: nrej          !< Number of rejected steps
-
-    REAL(wp)                         ::  conv                                !< conversion factor
-    REAL(kind=wp)                    ::  dt_chem
-
-    REAL(wp),DIMENSION(size(rcntrl)) :: rcntrl_local
-
-    REAL(kind=wp), DIMENSION(nzb+1:nzt)                      :: tmp_fact
-    REAL(kind=wp), DIMENSION(nzb+1:nzt)                      :: tmp_fact_i    !< conversion factor between
-                                                                              !< molecules cm^{-3} and ppm
-    REAL(kind=wp), DIMENSION(nzb+1:nzt)                      :: tmp_qvap
-    REAL(kind=wp), DIMENSION(nzb+1:nzt)                      :: tmp_temp
-
-    REAL(kind=wp), DIMENSION(nzb+1:nzt,nspec)                :: tmp_conc
-    REAL(kind=wp), DIMENSION(nzb+1:nzt,nphot)                :: tmp_phot
-
-!
-!-- Set chem_gasphase_on to .FALSE. if you want to skip computation of gas phase chemistry
-    IF (chem_gasphase_on)  THEN
-       nacc = 0
-       nrej = 0
-
-       tmp_temp(:) = pt(nzb+1:nzt,j,i) * exner(nzb+1:nzt)
-!
-!--    Convert ppm to molecules/cm**3
-!--    tmp_fact = 1.e-6_wp*6.022e23_wp/(22.414_wp*1000._wp) * 273.15_wp *
-!--               hyp(nzb+1:nzt)/( 101300.0_wp * tmp_temp )
-       conv = ppm2fr * xna / vmolcm
-       tmp_fact(:) = conv * t_std * hyp(nzb+1:nzt) / (tmp_temp(:) * p_std)
-       tmp_fact_i = 1.0_wp/tmp_fact
-
-       IF ( humidity )  THEN
-          IF ( bulk_cloud_model )  THEN
-             tmp_qvap(:) = ( q(nzb+1:nzt,j,i) - ql(nzb+1:nzt,j,i) ) *                              &
-                             xm_air/xm_h2o * fr2ppm * tmp_fact(:)
-          ELSE
-             tmp_qvap(:) = q(nzb+1:nzt,j,i) * xm_air/xm_h2o * fr2ppm * tmp_fact(:)
-          ENDIF
-       ELSE
-          tmp_qvap(:) = 0.01 * xm_air/xm_h2o * fr2ppm * tmp_fact(:)   !< Constant value for q if
-                                                                      !< water vapor is not computed
-       ENDIF
-
-       DO  lsp = 1,nspec
-          tmp_conc(:,lsp) = chem_species(lsp)%conc(nzb+1:nzt,j,i) * tmp_fact(:)
-       ENDDO
-
-       DO lph = 1,nphot
-          tmp_phot(:,lph) = phot_frequen(lph)%freq(nzb+1:nzt,j,i)
-       ENDDO
-!
-!--    Compute length of time step
-       IF ( call_chem_at_all_substeps )  THEN
-          dt_chem = dt_3d * weight_pres(intermediate_timestep_count)
-       ELSE
-          dt_chem = dt_3d
-       ENDIF
-
-       cs_time_step = dt_chem
-
-       IF ( MAXVAL( rcntrl ) > 0.0 )  THEN    ! Only if rcntrl is set
-          IF( time_since_reference_point <= 2*dt_3d)  THEN
-             rcntrl_local = 0
-          ELSE
-             rcntrl_local = rcntrl
-          ENDIF
-       ELSE
-          rcntrl_local = 0
-       END IF
-
-       CALL chem_gasphase_integrate ( dt_chem, tmp_conc, tmp_temp, tmp_qvap, tmp_fact, tmp_phot,   &
-            icntrl_i = icntrl, rcntrl_i = rcntrl_local, xnacc = nacc, xnrej = nrej, istatus=istatus )
-
-       DO  lsp = 1,nspec
-          chem_species(lsp)%conc (nzb+1:nzt,j,i) = tmp_conc(:,lsp) * tmp_fact_i(:)
-       ENDDO
-
-
-    ENDIF
-
-    RETURN
- END SUBROUTINE chem_integrate_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining parin for &chemistry_parameters for chemistry model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_parin
-
-    USE chem_modules
-    USE control_parameters
-    USE pegrid
-    USE statistics
-
-    CHARACTER(LEN=100) ::  line                        !< dummy string that contains the current
-                                                       !< line of the parameter file
-    CHARACTER(LEN=8)   ::  solver_type
-
-    INTEGER(iwp) ::  i                                 !<
-    INTEGER(iwp) ::  io_status                         !< Status after reading the namelist file
-    INTEGER(iwp) ::  max_pr_cs_tmp                     !<
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    REAL(wp), DIMENSION(nmaxfixsteps) ::   my_steps    !< List of fixed timesteps   my_step(1) = 0.0
-                                                       !< automatic stepping
-
-
-    NAMELIST /chemistry_parameters/                                                                &
-         bc_cs_b,                                                                                  &
-         bc_cs_l,                                                                                  &
-         bc_cs_n,                                                                                  &
-         bc_cs_r,                                                                                  &
-         bc_cs_s,                                                                                  &
-         bc_cs_t,                                                                                  &
-         call_chem_at_all_substeps,                                                                &
-         chem_gasphase_on,                                                                         &
-         chem_mechanism,                                                                           &
-         cs_heights,                                                                               &
-         cs_name,                                                                                  &
-         cs_profile,                                                                               &
-         cs_surface,                                                                               &
-         daytype_mdh,                                                                              &
-         deposition_dry,                                                                           &
-         emissions_anthropogenic,                                                                  &
-         emiss_lod,                                                                                &
-         emiss_factor_main,                                                                        &
-         emiss_factor_side,                                                                        &
-         emiss_read_legacy_mode,                                                                   &
-         icntrl,                                                                                   &
-         main_street_id,                                                                           &
-         max_street_id,                                                                            &
-         mode_emis,                                                                                &
-         my_steps,                                                                                 &
-         nesting_chem,                                                                             &
-         nesting_offline_chem,                                                                     &
-         rcntrl,                                                                                   &
-         side_street_id,                                                                           &
-         photolysis_scheme,                                                                        &
-         wall_csflux,                                                                              &         
-         surface_csflux,                                                                           &
-         surface_csflux_name,                                                                      &
-         switch_off_module,                                                                        &
-         time_fac_type
-!
-!-- Analogically to chem_names(nspj) we could invent chem_surfaceflux(nspj) and chem_topflux(nspj)
-!-- so this way we could prescribe a specific flux value for each species
-    !>  chemistry_parameters for initial profiles
-    !>  cs_names = 'O3', 'NO2', 'NO', ...   to set initial profiles)
-    !>  cs_heights(1,:) = 0.0, 100.0, 500.0, 2000.0, .... (height levels where concs will be prescribed for O3)
-    !>  cs_heights(2,:) = 0.0, 200.0, 400.0, 1000.0, .... (same for NO2 etc.)
-    !>  cs_profiles(1,:) = 10.0, 20.0, 20.0, 30.0, .....  (chem spcs conc at height lvls chem_heights(1,:)) etc.
-    !>  If the respective concentration profile should be constant with height, then use "cs_surface( number of spcs)"
-    !>  then write these cs_surface values to chem_species(lsp)%conc_pr_init(:)
-
-!
-!-- Read chem namelist
-    icntrl    = 0
-    rcntrl    = 0.0_wp
-    my_steps  = 0.0_wp
-    photolysis_scheme = 'simple'
-    atol = 1.0_wp
-    rtol = 0.01_wp
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist named
-!-- chemistry_parameters.
-    REWIND( 11 )
-    READ( 11, chemistry_parameters, IOSTAT=io_status )
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!      chemistry_parameters namelist was found and read correctly. Switch on chemistry model.
-       IF ( .NOT. switch_off_module )  air_chemistry = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    chemistry_parameters namelist was found, but contained errors. Print an error message
-!--    including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'chemistry_parameters', line )
-
-    ENDIF
-
-!
-!-- Synchronize emiss_lod and mod_emis only if emissions_anthropogenic is activated in the namelist.
-!-- Otherwise their values are "don't care"
-    IF ( emissions_anthropogenic )  THEN
-
-!
-!--    Check for emission mode for chem species
-       IF ( emiss_lod < 0 )  THEN   !- if LOD not defined in namelist
-          IF ( ( mode_emis /= 'PARAMETERIZED'  )    .AND.                                          &
-               ( mode_emis /= 'DEFAULT'        )    .AND.                                          &
-               ( mode_emis /= 'PRE-PROCESSED'  ) )  THEN
-             message_string = 'Incorrect mode_emiss  option select. Please check spelling'
-             CALL message( 'chem_parin', 'PA0731', 1, 2, 0, 6, 0 )
-          ENDIF
-       ELSE
-          IF ( ( emiss_lod /= 0 )    .AND.                                                         &
-               ( emiss_lod /= 1 )    .AND.                                                         &
-               ( emiss_lod /= 2 ) )  THEN
-             message_string = 'Invalid value for emiss_lod (0, 1, or 2)'
-             CALL message( 'chem_parin', 'PA0732', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-!
-!--    Conflict resolution for emiss_lod and mode_emis.
-!--    1) if emiss_lod is defined, have mode_emis assume same setting as emiss_lod
-!--    2) if emiss_lod it not defined, have emiss_lod assuem same setting as mode_emis
-!--    This check is in place to retain backward compatibility with salsa until the code is
-!--    migrated completely to emiss_lod.
-       IF  ( emiss_lod >= 0 ) THEN
-
-          SELECT CASE  ( emiss_lod )
-!
-!--          Synchronize mode_emis to defined emiss_lod (mode_emis will be depreciated in
-!--          future releases)
-             CASE (0)  !- parameterized mode
-                mode_emis = 'PARAMETERIZED'
-             CASE (1)  !- default mode
-                mode_emis = 'DEFAULT'
-             CASE (2)  !- preprocessed mode
-                mode_emis = 'PRE-PROCESSED'
-          END SELECT
-
-       ELSE ! if emiss_lod is not set
-
-          SELECT CASE ( mode_emis )
-             CASE ('PARAMETERIZED')
-                emiss_lod = 0
-             CASE ('DEFAULT')
-                emiss_lod = 1
-             CASE ('PRE-PROCESSED')
-                emiss_lod = 2
-          END SELECT
-
-          message_string = 'emiss_lod undefined.  Using existing mod_emiss setting&'    //         &
-                           'NOTE - mode_emis will be depreciated in future releases&'   //         &
-                           'please use emiss_lod to define emission mode'
-          CALL message( 'chem_parin', 'PA0734', 0, 0, 0, 6, 0 )
-       ENDIF
-
-!
-!-- NB input check for emission read mode.
-!--    legacy : business as usual (everything read / set up at start of run)
-!--    new    : emission based on timestamp, and for lod2 data is loaded on an hourly basis
-
-!
-!-- NB handler for emiss_read_legacy_mode
-!-- * emiss_read_legacy_mode is defaulted to TRUE
-!-- * if emiss_read_legacy_mode is TRUE and LOD is 0 or 1,
-!--       force emission_read_legacy_mode to TRUE (not yet implemented)
-
-       IF ( .NOT. emiss_read_legacy_mode )  THEN    !< if new read mode selected
-
-          IF ( emiss_lod < 2 )  THEN            !< check LOD compatibility
-
-             message_string = 'New emission read mode '                    //                      &
-                              'currently unavailable for LODs 0 and 1.&'   //                      &
-                              'Reverting to legacy emission read mode'
-             CALL message( 'chem_parin', 'PA0736', 0, 0, 0, 6, 0 )
-
-             emiss_read_legacy_mode = .TRUE.
-
-          ELSE                                  !< notify new read mode
-
-             message_string = 'New emission read mode activated&'          //                      &
-                              'LOD 2 emissions will be updated on-demand ' //                      &
-                              'according to indicated timestamps'
-             CALL message( 'chem_parin', 'PA0737', 0, 0, 0, 6, 0 )
-
-          ENDIF
-
-       ENDIF ! if emiss_read_legacy_mode
-
-
-    ENDIF  ! if emissions_anthropengic
-
-
-    t_steps = my_steps
-!
-!-- Determine the number of user-defined profiles and append them to the standard data output
-!-- (data_output_pr)
-    max_pr_cs_tmp = 0
-    i = 1
-
-    DO  WHILE ( data_output_pr(i)  /= ' '  .AND.  i <= SIZE( data_output_pr ) )
-       IF ( TRIM( data_output_pr(i)(1:3) ) == 'kc_' )  THEN
-          max_pr_cs_tmp = max_pr_cs_tmp+1
-       ENDIF
-       i = i +1
-    ENDDO
-
-    IF ( max_pr_cs_tmp > 0 )  THEN
-       cs_pr_namelist_found = .TRUE.
-       max_pr_cs = max_pr_cs_tmp
-    ENDIF
-!
-!-- Set Solver Type
-    IF ( icntrl(3) == 0 )  THEN
-       solver_type = 'rodas3'           !Default
-    ELSEIF ( icntrl(3) == 1 )  THEN
-       solver_type = 'ros2'
-    ELSEIF ( icntrl(3) == 2 )  THEN
-       solver_type = 'ros3'
-    ELSEIF ( icntrl(3) == 3 )  THEN
-       solver_type = 'ro4'
-    ELSEIF ( icntrl(3) == 4 )  THEN
-       solver_type = 'rodas3'
-    ELSEIF ( icntrl(3) == 5 )  THEN
-       solver_type = 'rodas4'
-    ELSEIF ( icntrl(3) == 6 )  THEN
-       solver_type = 'Rang3'
-    ELSE
-       message_string = 'illegal Rosenbrock-solver type'
-       CALL message( 'chem_parin', 'PA0506', 1, 2, 0, 6, 0 )
-    END IF
-
-    RETURN
-
- END SUBROUTINE chem_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE chem_actions( location )
-
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-    SELECT CASE ( location )
-
-       CASE ( 'before_prognostic_equations' )
-!
-!--       Chemical reactions and deposition
-          IF ( chem_gasphase_on )  THEN
-!
-!--          If required, calculate photolysis frequencies -
-!--          UNFINISHED: Why not before the intermediate timestep loop?
-             IF ( intermediate_timestep_count ==  1 )  THEN
-                CALL photolysis_control
-             ENDIF
-
-          ENDIF
-
-       CASE ( 'before_timestep' )
-!
-!--       Set array used to sum-up resolved scale fluxes to zero.
-          IF ( ws_scheme_sca )  THEN
-             sums_ws_l = 0.0_wp
-          ENDIF
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
-    END SUBROUTINE chem_actions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid points i,j
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE chem_actions_ij( i, j, location )
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location  !< call location string
-
-    INTEGER(iwp)  ::  dummy                     !< call location string
-
-    INTEGER(iwp),      INTENT(IN) ::  i         !< grid index in x-direction
-    INTEGER(iwp),      INTENT(IN) ::  j         !< grid index in y-direction
-
-    IF ( air_chemistry    )   dummy = i + j
-
-    SELECT CASE ( location )
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
-
-    END SUBROUTINE chem_actions_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE chem_non_advective_processes()
-
-
-      INTEGER(iwp) ::  i  !<
-      INTEGER(iwp) ::  j  !<
-
-!
-!--   Calculation of chemical reactions and deposition.
-      IF ( intermediate_timestep_count == 1  .OR.  call_chem_at_all_substeps )  THEN
-
-         IF ( chem_gasphase_on )  THEN
-            CALL cpu_log( log_point_s(19), 'chem.reactions', 'start' )
-            !$OMP PARALLEL PRIVATE (i,j)
-            !$OMP DO schedule(static,1)
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  CALL chem_integrate( i, j )
-               ENDDO
-            ENDDO
-            !$OMP END PARALLEL
-            CALL cpu_log( log_point_s(19), 'chem.reactions', 'stop' )
-         ENDIF
-
-         IF ( deposition_dry )  THEN
-            CALL cpu_log( log_point_s(24), 'chem.deposition', 'start' )
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  CALL chem_depo( i, j )
-               ENDDO
-            ENDDO
-            CALL cpu_log( log_point_s(24), 'chem.deposition', 'stop' )
-         ENDIF
-
-      ENDIF
-
-    END SUBROUTINE chem_non_advective_processes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid points i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_non_advective_processes_ij( i, j )
-
-
-    INTEGER(iwp), INTENT(IN) ::  i  !< grid index in x-direction
-    INTEGER(iwp), INTENT(IN) ::  j  !< grid index in y-direction
-
-!
-!-- Calculation of chemical reactions and deposition.
-!-- It would have been nice to have time measurements for chemistry and deposition here. 
-!-- Unfortunately measurements within i,j loops degrade performance ince they are calles so often 
-!-- and the counter for this measurement gets extremely huge values. Therefore, no measurements
-!-- here.
-    IF ( intermediate_timestep_count == 1  .OR.  call_chem_at_all_substeps )  THEN
-
-       IF ( chem_gasphase_on )  THEN
-          CALL chem_integrate( i, j )
-       ENDIF
-
-       IF ( deposition_dry )  THEN
-          CALL chem_depo( i, j )
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE chem_non_advective_processes_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> routine for exchange horiz of chemical quantities
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_exchange_horiz_bounds( location )
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-   INTEGER(iwp) ::  lsp       !<
-   INTEGER(iwp) ::  n
-
-   CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-   SELECT CASE ( location )
-
-       CASE ( 'before_prognostic_equation' )
-!
-!--       Loop over chemical species
-          CALL cpu_log( log_point_s(84), 'chem.exch-horiz', 'start' )
-          DO  lsp = 1, nvar
-             CALL exchange_horiz( chem_species(lsp)%conc, nbgp,                                    &
-                                  alternative_communicator = communicator_chem )
-          ENDDO
-
-          CALL chem_boundary_conditions( horizontal_conditions_only = .TRUE. )
-
-          CALL cpu_log( log_point_s(84), 'chem.exch-horiz', 'stop' )
-
-       CASE ( 'after_prognostic_equation' )
-
-          IF ( air_chemistry )  THEN
-             DO  n = 1, nvar
-                CALL exchange_horiz( chem_species(n)%conc_p, nbgp,                                 &
-                                     alternative_communicator = communicator_chem )
-             ENDDO
-          ENDIF
-
-       CASE ( 'after_anterpolation' )
-
-          IF ( air_chemistry )  THEN
-             DO  n = 1, nvar
-                CALL exchange_horiz( chem_species(n)%conc, nbgp,                                   &
-                                     alternative_communicator = communicator_chem )
-             ENDDO
-          ENDIF
-
-    END SELECT
-
- END SUBROUTINE chem_exchange_horiz_bounds
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine calculating prognostic equations for chemical species (vector-optimized).
-!> Routine is called separately for each chemical species over a loop from prognostic_equations.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_prognostic_equations()
-
-
-    INTEGER ::  i   !< running index
-    INTEGER ::  j   !< running index
-    INTEGER ::  k   !< running index
-
-    INTEGER(iwp) ::  ilsp   !<
-
-
-    CALL cpu_log( log_point_s(25), 'chem.advec+diff+prog', 'start' )
-
-    DO  ilsp = 1, nvar
-!
-!--    Tendency terms for chemical species
-       tend = 0.0_wp
-!
-!--    Advection terms
-       IF ( timestep_scheme(1:5) == 'runge' )  THEN
-          IF ( ws_scheme_sca )  THEN
-             sums_wschs_ws_l(nzb:,0:) => sums_ws_l(:,:,ilsp)
-             CALL advec_s_ws( cs_advc_flags_s, chem_species(ilsp)%conc, 'kc',                      &
-                              bc_dirichlet_cs_l  .OR.  bc_radiation_cs_l,                          &
-                              bc_dirichlet_cs_n  .OR.  bc_radiation_cs_n,                          &
-                              bc_dirichlet_cs_r  .OR.  bc_radiation_cs_r,                          &
-                              bc_dirichlet_cs_s  .OR.  bc_radiation_cs_s )
-          ELSE
-             CALL advec_s_pw( chem_species(ilsp)%conc )
-          ENDIF
-       ELSE
-          CALL advec_s_up( chem_species(ilsp)%conc )
-       ENDIF
-!
-!--    Diffusion terms  (the last three arguments are zero)
-       CALL diffusion_s( chem_species(ilsp)%conc,                                                  &
-            surf_def_h(0)%cssws(ilsp,:),                                                           &
-            surf_def_h(1)%cssws(ilsp,:),                                                           &
-            surf_def_h(2)%cssws(ilsp,:),                                                           &
-            surf_lsm_h(0)%cssws(ilsp,:),                                                           &
-            surf_lsm_h(1)%cssws(ilsp,:),                                                           &
-            surf_usm_h(0)%cssws(ilsp,:),                                                           &
-            surf_usm_h(1)%cssws(ilsp,:),                                                           &
-            surf_def_v(0)%cssws(ilsp,:),                                                           &
-            surf_def_v(1)%cssws(ilsp,:),                                                           &
-            surf_def_v(2)%cssws(ilsp,:),                                                           &
-            surf_def_v(3)%cssws(ilsp,:),                                                           &
-            surf_lsm_v(0)%cssws(ilsp,:),                                                           &
-            surf_lsm_v(1)%cssws(ilsp,:),                                                           &
-            surf_lsm_v(2)%cssws(ilsp,:),                                                           &
-            surf_lsm_v(3)%cssws(ilsp,:),                                                           &
-            surf_usm_v(0)%cssws(ilsp,:),                                                           &
-            surf_usm_v(1)%cssws(ilsp,:),                                                           &
-            surf_usm_v(2)%cssws(ilsp,:),                                                           &
-            surf_usm_v(3)%cssws(ilsp,:) )
-!
-!--    Prognostic equation for chemical species
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             !following directive is required to vectorize on Intel19
-             !DIR$ IVDEP
-             DO  k = nzb+1, nzt
-                chem_species(ilsp)%conc_p(k,j,i) =   chem_species(ilsp)%conc(k,j,i)                &
-                     + ( dt_3d  *                                                                  &
-                     (   tsc(2) * tend(k,j,i)                                                      &
-                     + tsc(3) * chem_species(ilsp)%tconc_m(k,j,i)                                  &
-                     )                                                                             &
-                     - tsc(5) * rdf_sc(k)                                                          &
-                     * ( chem_species(ilsp)%conc(k,j,i) - chem_species(ilsp)%conc_pr_init(k) )     &
-                     )                                                                             &
-                     * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                IF ( chem_species(ilsp)%conc_p(k,j,i) < 0.0_wp )  THEN
-                   chem_species(ilsp)%conc_p(k,j,i) = 0.1_wp * chem_species(ilsp)%conc(k,j,i)
-                ENDIF
-             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+1, nzt
-                      chem_species(ilsp)%tconc_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+1, nzt
-                      chem_species(ilsp)%tconc_m(k,j,i) = - 9.5625_wp * tend(k,j,i)                &
-                                                     + 5.3125_wp * chem_species(ilsp)%tconc_m(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-
-    ENDDO
-
-    CALL cpu_log( log_point_s(25), 'chem.advec+diff+prog', 'stop' )
-
- END SUBROUTINE chem_prognostic_equations
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine calculating prognostic equations for chemical species (cache-optimized).
-!> Routine is called separately for each chemical species over a loop from prognostic_equations.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_prognostic_equations_ij( i, j, i_omp_start, tn )
-
-
-    INTEGER(iwp),INTENT(IN) :: i, j, i_omp_start, tn
-
-    INTEGER(iwp) :: ilsp
-!
-!-- local variables
-
-    INTEGER :: k
-
-    DO  ilsp = 1, nvar
-!
-!--    Tendency-terms for chem spcs.
-       tend(:,j,i) = 0.0_wp
-!
-!--    Advection terms
-       IF ( timestep_scheme(1:5) == 'runge' )  THEN
-          IF ( ws_scheme_sca )  THEN
-             sums_wschs_ws_l(nzb:,0:) => sums_ws_l(nzb:nzt+1,0:threads_per_task-1,ilsp)
-             CALL advec_s_ws( cs_advc_flags_s,                                                     &
-                              i,                                                                   &
-                              j,                                                                   &
-                              chem_species(ilsp)%conc,                                             &
-                              'kc',                                                                &
-                              chem_species(ilsp)%flux_s_cs,                                        &
-                              chem_species(ilsp)%diss_s_cs,                                        &
-                              chem_species(ilsp)%flux_l_cs,                                        &
-                              chem_species(ilsp)%diss_l_cs,                                        &
-                              i_omp_start,                                                         &
-                              tn,                                                                  &
-                              bc_dirichlet_cs_l  .OR.  bc_radiation_cs_l,                          &
-                              bc_dirichlet_cs_n  .OR.  bc_radiation_cs_n,                          &
-                              bc_dirichlet_cs_r  .OR.  bc_radiation_cs_r,                          &
-                              bc_dirichlet_cs_s  .OR.  bc_radiation_cs_s,                          &
-                              monotonic_limiter_z )
-          ELSE
-             CALL advec_s_pw( i, j, chem_species(ilsp)%conc )
-          ENDIF
-       ELSE
-          CALL advec_s_up( i, j, chem_species(ilsp)%conc )
-       ENDIF
-!
-!--    Diffusion terms (the last three arguments are zero)
-       CALL diffusion_s( i, j, chem_species(ilsp)%conc,                                            &
-            surf_def_h(0)%cssws(ilsp,:), surf_def_h(1)%cssws(ilsp,:),                              &
-            surf_def_h(2)%cssws(ilsp,:),                                                           &
-            surf_lsm_h(0)%cssws(ilsp,:), surf_lsm_h(1)%cssws(ilsp,:),                              &
-            surf_usm_h(0)%cssws(ilsp,:), surf_usm_h(1)%cssws(ilsp,:),                              &
-            surf_def_v(0)%cssws(ilsp,:), surf_def_v(1)%cssws(ilsp,:),                              &
-            surf_def_v(2)%cssws(ilsp,:), surf_def_v(3)%cssws(ilsp,:),                              &
-            surf_lsm_v(0)%cssws(ilsp,:), surf_lsm_v(1)%cssws(ilsp,:),                              &
-            surf_lsm_v(2)%cssws(ilsp,:), surf_lsm_v(3)%cssws(ilsp,:),                              &
-            surf_usm_v(0)%cssws(ilsp,:), surf_usm_v(1)%cssws(ilsp,:),                              &
-            surf_usm_v(2)%cssws(ilsp,:), surf_usm_v(3)%cssws(ilsp,:) )
-!
-!--    Prognostic equation for chem spcs
-       DO  k = nzb+1, nzt
-          chem_species(ilsp)%conc_p(k,j,i) = chem_species(ilsp)%conc(k,j,i) + ( dt_3d  *           &
-               ( tsc(2) * tend(k,j,i) +                                                            &
-               tsc(3) * chem_species(ilsp)%tconc_m(k,j,i) )                                        &
-               - tsc(5) * rdf_sc(k)                                                                &
-               * ( chem_species(ilsp)%conc(k,j,i) - chem_species(ilsp)%conc_pr_init(k) )           &
-               )                                                                                   &
-               * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 )                      &
-               )
-
-          IF ( chem_species(ilsp)%conc_p(k,j,i) < 0.0_wp )  THEN
-             chem_species(ilsp)%conc_p(k,j,i) = 0.1_wp * chem_species(ilsp)%conc(k,j,i)    !FKS6
-          ENDIF
-       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+1, nzt
-                chem_species(ilsp)%tconc_m(k,j,i) = tend(k,j,i)
-             ENDDO
-          ELSEIF ( intermediate_timestep_count < &
-               intermediate_timestep_count_max )  THEN
-             DO  k = nzb+1, nzt
-                chem_species(ilsp)%tconc_m(k,j,i) = -9.5625_wp * tend(k,j,i) +                     &
-                                                     5.3125_wp * chem_species(ilsp)%tconc_m(k,j,i)
-             ENDDO
-          ENDIF
-       ENDIF
-
-    ENDDO
-
- END SUBROUTINE chem_prognostic_equations_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,   &
-                                nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
-
-    USE control_parameters
-
-    INTEGER(iwp) ::  k               !<
-    INTEGER(iwp) ::  lsp             !<
-    INTEGER(iwp) ::  nxlc            !<
-    INTEGER(iwp) ::  nxlf            !<
-    INTEGER(iwp) ::  nxl_on_file     !<
-    INTEGER(iwp) ::  nxrc            !<
-    INTEGER(iwp) ::  nxrf            !<
-    INTEGER(iwp) ::  nxr_on_file     !<
-    INTEGER(iwp) ::  nync            !<
-    INTEGER(iwp) ::  nynf            !<
-    INTEGER(iwp) ::  nyn_on_file     !<
-    INTEGER(iwp) ::  nysc            !<
-    INTEGER(iwp) ::  nysf            !<
-    INTEGER(iwp) ::  nys_on_file     !<
-
-    LOGICAL, INTENT(OUT) :: found
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) &
-                 :: tmp_3d   !< 3D array to temp store data
-
-
-    found = .FALSE.
-
-
-    IF ( ALLOCATED( chem_species ) )  THEN
-
-       DO  lsp = 1, nspec
-
-          IF ( restart_string(1:length) == TRIM( chem_species(lsp)%name) )  THEN
-
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             chem_species(lsp)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                   &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             found = .TRUE.
-
-          ELSEIF (restart_string(1:length) == TRIM( chem_species(lsp)%name ) // '_av' )  THEN
-
-             IF ( .NOT. ALLOCATED( chem_species(lsp)%conc_av ) )  THEN
-                ALLOCATE( chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ) )
-             ENDIF
-             IF ( k == 1 )  READ ( 13 )  tmp_3d
-             chem_species(lsp)%conc_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             found = .TRUE.
-
-          ENDIF
-
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE chem_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_rrd_local_mpi
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  lsp  !<
-
-    LOGICAL      ::  array_found  !<
-
-
-    DO  lsp = 1, nspec
-
-       CALL rrd_mpi_io( TRIM( chem_species(lsp)%name ), chem_species(lsp)%conc )
-
-       CALL rd_mpi_io_check_array( TRIM( chem_species(lsp)%name )//'_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( chem_species(lsp)%conc_av ) )  THEN
-             ALLOCATE( chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          CALL rrd_mpi_io( TRIM( chem_species(lsp)%name )//'_av', chem_species(lsp)%conc_av )
-       ENDIF
-
-    ENDDO
-
- END SUBROUTINE chem_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-!> Description:
-!> Calculation of horizontally averaged profiles
-!> This routine is called for every statistic region (sr) defined by the user,
-!> but at least for the region "total domain" (sr=0).
-!> quantities.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_statistics( mode, sr, tn )
-
-
-    USE arrays_3d
-
-    USE statistics
-
-    CHARACTER (LEN=*) ::  mode   !<
-
-    INTEGER(iwp) ::  i                   !< running index on x-axis
-    INTEGER(iwp) ::  j                   !< running index on y-axis
-    INTEGER(iwp) ::  k                   !< vertical index counter
-    INTEGER(iwp) ::  l                   !< direction index counter
-    INTEGER(iwp) ::  lpr                 !< running index chem spcs
-    INTEGER(iwp) ::  m                   !< running index for surface elements
-!$  INTEGER(iwp) ::  omp_get_thread_num  !< intrinsic OMP function
-    INTEGER(iwp) ::  sr                  !< statistical region
-    INTEGER(iwp) ::  surf_e              !< end surface index
-    INTEGER(iwp) ::  surf_s              !< start surface index
-    INTEGER(iwp) ::  tn                  !< thread number
-
-    REAL(wp)                                            ::  flag     !< topography masking flag
-    REAL(wp), DIMENSION(nzb:nzt+1,0:threads_per_task-1) ::  sums_tmp !< temporary array used to sum-up profiles
-
-    IF ( mode == 'profiles' )  THEN
-!
-!--    Sum-up profiles for the species
-       tn = 0
-       !$OMP PARALLEL PRIVATE( i, j, k, tn, lpr, sums_tmp )
-       !$ tn = omp_get_thread_num()
-       !$OMP DO
-       DO  lpr = 1, cs_pr_count_sp
-          sums_tmp(:,tn) = 0.0_wp
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb, nzt+1
-                   sums_tmp(k,tn) = sums_tmp(k,tn) +                                               &
-                        chem_species(cs_pr_index_sp(lpr))%conc(k,j,i) *                            &
-                        rmask(j,i,sr)  *                                                           &
-                        MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                ENDDO
-             ENDDO
-          ENDDO
-          sums_l(nzb:nzt+1,hom_index_spec(lpr),tn) = sums_tmp(nzb:nzt+1,tn)
-       ENDDO
-       !$OMP END PARALLEL
-!
-!--    Sum-up profiles for vertical fluxes of the the species. Note, in case of WS5 scheme the
-!--    profiles of resolved-scale fluxes have been already summed-up, while resolved-scale fluxes
-!--    need to be calculated in case of PW scheme.
-!--    For summation employ a temporary array.
-       !$OMP PARALLEL PRIVATE( i, j, k, tn, lpr, sums_tmp, flag )
-       !$ tn = omp_get_thread_num()
-       !$OMP DO
-       DO  lpr = 1, cs_pr_count_fl_sgs
-          sums_tmp(:,tn) = 0.0_wp
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb, nzt
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 23 ) ) *        &
-                          MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 9  ) )
-                   sums_tmp(k,tn) = sums_tmp(k,tn) -                                               &
-                        0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )                                       &
-                               * ( chem_species(cs_pr_index_fl_sgs(lpr))%conc(k+1,j,i) -           &
-                                   chem_species(cs_pr_index_fl_sgs(lpr))%conc(k,j,i) ) *           &
-                        ddzu(k+1) * rmask(j,i,sr)  * flag
-                ENDDO
-!
-!--             Add surface fluxes (?Is the order mandatory or could it be done in one cycle?)
-                DO l = 0, 1
-                   surf_s = surf_def_h(0)%start_index(j,i)
-                   surf_e = surf_def_h(0)%end_index(j,i)
-                   DO  m = surf_s, surf_e
-                      k   = surf_def_h(0)%k(m) + surf_def_h(0)%koff
-                      sums_tmp(k,tn) = sums_tmp(k,tn) + surf_def_h(0)%cssws(cs_pr_index_fl_sgs(lpr),m)
-                   ENDDO
-                ENDDO
-                DO l = 0, 1
-                   surf_s = surf_lsm_h(0)%start_index(j,i)
-                   surf_e = surf_lsm_h(0)%end_index(j,i)
-                   DO  m = surf_s, surf_e
-                      k   = surf_lsm_h(0)%k(m) + surf_lsm_h(0)%koff
-                      sums_tmp(k,tn) = sums_tmp(k,tn) + surf_lsm_h(0)%cssws(cs_pr_index_fl_sgs(lpr),m)
-                   ENDDO
-                ENDDO
-                DO l = 0, 1
-                   surf_s = surf_usm_h(0)%start_index(j,i)
-                   surf_e = surf_usm_h(0)%end_index(j,i)
-                   DO  m = surf_s, surf_e
-                      k   = surf_usm_h(0)%k(m) + surf_usm_h(0)%koff
-                      sums_tmp(k,tn) = sums_tmp(k,tn) + surf_usm_h(0)%cssws(cs_pr_index_fl_sgs(lpr),m)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-          sums_l(nzb:nzt+1,hom_index_fl_sgs(lpr),tn) = sums_tmp(nzb:nzt+1,tn)
-       ENDDO
-       !$OMP END PARALLEL
-!
-!--    Resolved-scale fluxes from the WS5 scheme
-       IF ( ws_scheme_sca )  THEN
-          !$OMP PARALLEL PRIVATE( tn, lpr )
-          !$ tn = omp_get_thread_num()
-          !$OMP DO
-          DO  lpr = 1, cs_pr_count_fl_res
-             sums_l(nzb:nzt+1,hom_index_fl_res(lpr),tn) =                                           &
-                                                      sums_ws_l(nzb:nzt+1,tn,cs_pr_index_fl_res(lpr))
-          ENDDO
-          !$OMP END PARALLEL
-       ENDIF
-
-    ELSEIF ( mode == 'time_series' )  THEN
-!      @todo
-    ENDIF
-
- END SUBROUTINE chem_statistics
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine for swapping of timelevels for chemical species called out from subroutine
-!> swap_timelevel
-!--------------------------------------------------------------------------------------------------!
-
-
- SUBROUTINE chem_swap_timelevel( level )
-
-
-    INTEGER(iwp), INTENT(IN) ::  level
-!
-!-- Local variables
-    INTEGER(iwp)             ::  lsp
-
-
-    IF ( level == 0 )  THEN
-       DO  lsp=1, nvar
-          chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => spec_conc_1(:,:,:,lsp)
-          chem_species(lsp)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => spec_conc_2(:,:,:,lsp)
-       ENDDO
-    ELSE
-       DO  lsp=1, nvar
-          chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => spec_conc_2(:,:,:,lsp)
-          chem_species(lsp)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => spec_conc_1(:,:,:,lsp)
-       ENDDO
-    ENDIF
-
-    RETURN
- END SUBROUTINE chem_swap_timelevel
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to write restart data for chemistry model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_wrd_local
-
-
-    INTEGER(iwp) ::  lsp  !< running index for chem spcs.
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       DO  lsp = 1, nspec
-          CALL wrd_write_string( TRIM( chem_species(lsp)%name ) )
-          WRITE ( 14 )  chem_species(lsp)%conc
-          IF ( ALLOCATED( chem_species(lsp)%conc_av ) )  THEN
-             CALL wrd_write_string( TRIM( chem_species(lsp)%name )//'_av' )
-             WRITE ( 14 )  chem_species(lsp)%conc_av
-          ENDIF
-       ENDDO
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       DO  lsp = 1, nspec
-          CALL wrd_mpi_io( TRIM( chem_species(lsp)%name ), chem_species(lsp)%conc )
-          IF ( ALLOCATED( chem_species(lsp)%conc_av ) )  THEN
-             CALL wrd_mpi_io( TRIM( chem_species(lsp)%name ) // '_av', chem_species(lsp)%conc_av )
-          ENDIF
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE chem_wrd_local
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to calculate the deposition of gases and PMs. For now deposition only takes place on
-!> lsm and usm horizontal upward faceing surfaces. Default surfaces are NOT considered.
-!> The deposition of particlesis derived following Zhang et al., 2001, gases are deposited using
-!>  the DEPAC module (van Zanten et al., 2010).
-!>
-!> @TODO: Consider deposition on vertical surfaces
-!> @TODO: Consider overlaying horizontal surfaces
-!> @TODO: Consider resolved vegetation
-!> @TODO: Check error messages
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE chem_depo( i, j )
-
-    USE control_parameters,                                                                        &
-         ONLY:  dt_3d, intermediate_timestep_count, latitude, time_since_reference_point
-
-    USE arrays_3d,                                                                                 &
-         ONLY:  dzw, rho_air_zw
-
-    USE palm_date_time_mod,                                                                        &
-         ONLY:  get_date_time
-
-    USE surface_mod,                                                                               &
-         ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_lsm_h, surf_type, surf_usm_h
-
-    USE radiation_model_mod,                                                                       &
-         ONLY:  cos_zenith
-
-
-    INTEGER(iwp) ::  day_of_year                   !< current day of the year
-    INTEGER(iwp), INTENT(IN) ::  i
-    INTEGER(iwp) ::  i_pspec                       !< index for matching depac gas component
-    INTEGER(iwp), INTENT(IN) ::  j
-    INTEGER(iwp) ::  k                             !< matching k to surface m at i,j
-    INTEGER(iwp) ::  lsp                           !< running index for chem spcs.
-    INTEGER(iwp) ::  luv_palm                      !< index of PALM LSM vegetation_type at current
-                                                   !< surface element
-    INTEGER(iwp) ::  lup_palm                      !< index of PALM LSM pavement_type at current
-                                                   !< surface element
-    INTEGER(iwp) ::  luw_palm                      !< index of PALM LSM water_type at current
-                                                   !< surface element
-    INTEGER(iwp) ::  luu_palm                      !< index of PALM USM walls/roofs at current
-                                                   !< surface element
-    INTEGER(iwp) ::  lug_palm                      !< index of PALM USM green walls/roofs at current
-                                                   !< surface element
-    INTEGER(iwp) ::  lud_palm                      !< index of PALM USM windows at current surface
-                                                   !< element
-    INTEGER(iwp) ::  luv_dep                       !< matching DEPAC LU to luv_palm
-    INTEGER(iwp) ::  lup_dep                       !< matching DEPAC LU to lup_palm
-    INTEGER(iwp) ::  luw_dep                       !< matching DEPAC LU to luw_palm
-    INTEGER(iwp) ::  luu_dep                       !< matching DEPAC LU to luu_palm
-    INTEGER(iwp) ::  lug_dep                       !< matching DEPAC LU to lug_palm
-    INTEGER(iwp) ::  lud_dep                       !< matching DEPAC LU to lud_palm
-    INTEGER(iwp) ::  m                             !< index for horizontal surfaces
-    INTEGER(iwp) ::  pspec                         !< running index
-!
-!-- Vegetation                                               !<  Assign PALM classes to DEPAC land
-                                                             !<  use classes
-    INTEGER(iwp) ::  ind_luv_user = 0                        !<  ERROR as no class given in PALM
-    INTEGER(iwp) ::  ind_luv_b_soil = 1                      !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_luv_mixed_crops = 2                 !<  assigned to ilu_arable
-    INTEGER(iwp) ::  ind_luv_s_grass = 3                     !<  assigned to ilu_grass
-    INTEGER(iwp) ::  ind_luv_ev_needle_trees = 4             !<  assigned to ilu_coniferous_forest
-    INTEGER(iwp) ::  ind_luv_de_needle_trees = 5             !<  assigned to ilu_coniferous_forest
-    INTEGER(iwp) ::  ind_luv_ev_broad_trees = 6              !<  assigned to ilu_tropical_forest
-    INTEGER(iwp) ::  ind_luv_de_broad_trees = 7              !<  assigned to ilu_deciduous_forest
-    INTEGER(iwp) ::  ind_luv_t_grass = 8                     !<  assigned to ilu_grass
-    INTEGER(iwp) ::  ind_luv_desert = 9                      !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_luv_tundra = 10                     !<  assigned to ilu_other
-    INTEGER(iwp) ::  ind_luv_irr_crops = 11                  !<  assigned to ilu_arable
-    INTEGER(iwp) ::  ind_luv_semidesert = 12                 !<  assigned to ilu_other
-    INTEGER(iwp) ::  ind_luv_ice = 13                        !<  assigned to ilu_ice
-    INTEGER(iwp) ::  ind_luv_marsh = 14                      !<  assigned to ilu_other
-    INTEGER(iwp) ::  ind_luv_ev_shrubs = 15                  !<  assigned to ilu_mediterrean_scrub
-    INTEGER(iwp) ::  ind_luv_de_shrubs = 16                  !<  assigned to ilu_mediterrean_scrub
-    INTEGER(iwp) ::  ind_luv_mixed_forest = 17               !<  assigned to ilu_coniferous_forest(ave(decid+conif))
-    INTEGER(iwp) ::  ind_luv_intrup_forest = 18              !<  assigned to ilu_other (ave(other+decid))
-!
-!-- Water
-    INTEGER(iwp) ::  ind_luw_user = 0                        !<  ERROR as no class given in PALM
-    INTEGER(iwp) ::  ind_luw_lake = 1                        !<  assigned to ilu_water_inland
-    INTEGER(iwp) ::  ind_luw_river = 2                       !<  assigned to ilu_water_inland
-    INTEGER(iwp) ::  ind_luw_ocean = 3                       !<  assigned to ilu_water_sea
-    INTEGER(iwp) ::  ind_luw_pond = 4                        !<  assigned to ilu_water_inland
-    INTEGER(iwp) ::  ind_luw_fountain = 5                    !<  assigned to ilu_water_inland
-!
-!-- Pavement
-    INTEGER(iwp) ::  ind_lup_user = 0                        !<  ERROR as no class given in PALM
-    INTEGER(iwp) ::  ind_lup_asph_conc = 1                   !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_asph = 2                        !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_conc = 3                        !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_sett = 4                        !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_pav_stones = 5                  !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_cobblest = 6                    !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_metal = 7                       !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_wood = 8                        !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_gravel = 9                      !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_f_gravel = 10                   !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_pebblest = 11                   !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_woodchips = 12                  !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_tartan = 13                     !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_art_turf = 14                   !<  assigned to ilu_desert
-    INTEGER(iwp) ::  ind_lup_clay = 15                       !<  assigned to ilu_desert
-!
-!-- Particle parameters according to the respective aerosol classes (PM25, PM10)
-    INTEGER(iwp) ::  ind_p_size = 1     !< index for partsize in particle_pars
-    INTEGER(iwp) ::  ind_p_dens = 2     !< index for rhopart in particle_pars
-    INTEGER(iwp) ::  ind_p_slip = 3     !< index for slipcor in particle_pars
-    INTEGER(iwp) ::  nwet               !< wetness indicator dor DEPAC; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow
-    INTEGER(iwp) ::  part_type          !< index for particle type (PM10 or PM25) in particle_pars
-
-
-    REAL(wp) ::  conc_ijk_ugm3     !< concentration at i, j, k in ug/m3
-    REAL(wp) ::  dens              !< density at layer k at i,j
-    REAL(wp) ::  dh                !< vertical grid size
-    REAL(wp) ::  diffusivity       !< diffusivity
-    REAL(wp) ::  dt_chem           !< length of chem time step
-    REAL(wp) ::  dt_dh             !< dt_chem/dh
-    REAL(wp) ::  inv_dh            !< inverse of vertical grid size
-    REAL(wp) ::  lai               !< leaf area index at current surface element
-    REAL(wp) ::  ppm2ugm3          !< conversion factor from ppm to ug/m3
-    REAL(wp) ::  qv_tmp            !< surface mixing ratio at current surface element
-    REAL(wp) ::  r_aero_surf       !< aerodynamic resistance (s/m) at current surface element
-    REAL(wp) ::  rb                !< quasi-laminar boundary layer resistance (s/m)
-    REAL(wp) ::  rc_tot            !< total canopy resistance (s/m)
-    REAL(wp) ::  rh_surf           !< relative humidity at current surface element
-    REAL(wp) ::  rs                !< Sedimentaion resistance (s/m)
-    REAL(wp) ::  sai               !< surface area index at current surface element assumed to be
-                                   !< lai + 1
-    REAL(wp) ::  slinnfac
-    REAL(wp) ::  solar_rad         !< solar radiation, direct and diffuse, at current surface
-                                   !< element
-    REAL(wp) ::  temp_tmp          !< temperatur at i,j,k
-    REAL(wp) ::  ts                !< surface temperatur in degrees celsius
-    REAL(wp) ::  ustar_surf        !< ustar at current surface element
-    REAL(wp) ::  vd_lu             !< deposition velocity (m/s)
-    REAL(wp) ::  visc              !< Viscosity
-    REAL(wp) ::  vs                !< Sedimentation velocity
-    REAL(wp) ::  z0h_surf          !< roughness length for heat at current surface element
-
-    REAL(wp), DIMENSION(nspec) ::  bud          !< overall budget at current surface element
-    REAL(wp), DIMENSION(nspec) ::  bud_lud      !< budget for USM windows at current surface element
-    REAL(wp), DIMENSION(nspec) ::  bud_lug      !< budget for USM green surfaces at current surface
-                                                !< element
-    REAL(wp), DIMENSION(nspec) ::  bud_lup      !< budget for LSM pavement type at current surface
-                                                !< element
-    REAL(wp), DIMENSION(nspec) ::  bud_luu      !< budget for USM walls/roofs at current surface
-                                                !< element
-    REAL(wp), DIMENSION(nspec) ::  bud_luv      !< budget for LSM vegetation type at current surface
-                                                !< element
-    REAL(wp), DIMENSION(nspec) ::  bud_luw      !< budget for LSM water type at current surface
-                                                !< element
-    REAL(wp), DIMENSION(nspec) ::  ccomp_tot    !< total compensation point (ug/m3), for now kept to
-                                                !< zero for all species!
-    REAL(wp), DIMENSION(nspec) ::  conc_ijk     !< concentration at i,j,k
-
-
-!
-!-- Particle parameters (PM10 (1), PM25 (2)) partsize (diameter in m), rhopart (density in kg/m3),
-!-- slipcor (slip correction factor dimensionless, Seinfeld and Pandis 2006, Table 9.3)
-    REAL(wp), DIMENSION(1:3,1:2), PARAMETER ::  particle_pars = RESHAPE( (/                        &
-                                                         8.0e-6_wp, 1.14e3_wp, 1.016_wp, &   !<  1
-                                                         0.7e-6_wp, 1.14e3_wp, 1.082_wp  &   !<  2
-                                                         /), (/ 3, 2 /) )
-
-    LOGICAL ::  match_lsm     !< flag indicating natural-type surface
-    LOGICAL ::  match_usm     !< flag indicating urban-type surface
-
-!
-!-- List of names of possible tracers
-    CHARACTER(LEN=*), PARAMETER ::  pspecnames(nposp) = (/                                         &
-         'NO2           ', &    !< NO2
-         'NO            ', &    !< NO
-         'O3            ', &    !< O3
-         'CO            ', &    !< CO
-         'form          ', &    !< FORM
-         'ald           ', &    !< ALD
-         'pan           ', &    !< PAN
-         'mgly          ', &    !< MGLY
-         'par           ', &    !< PAR
-         'ole           ', &    !< OLE
-         'eth           ', &    !< ETH
-         'tol           ', &    !< TOL
-         'cres          ', &    !< CRES
-         'xyl           ', &    !< XYL
-         'SO4a_f        ', &    !< SO4a_f
-         'SO2           ', &    !< SO2
-         'HNO2          ', &    !< HNO2
-         'CH4           ', &    !< CH4
-         'NH3           ', &    !< NH3
-         'NO3           ', &    !< NO3
-         'OH            ', &    !< OH
-         'HO2           ', &    !< HO2
-         'N2O5          ', &    !< N2O5
-         'SO4a_c        ', &    !< SO4a_c
-         'NH4a_f        ', &    !< NH4a_f
-         'NO3a_f        ', &    !< NO3a_f
-         'NO3a_c        ', &    !< NO3a_c
-         'C2O3          ', &    !< C2O3
-         'XO2           ', &    !< XO2
-         'XO2N          ', &    !< XO2N
-         'cro           ', &    !< CRO
-         'HNO3          ', &    !< HNO3
-         'H2O2          ', &    !< H2O2
-         'iso           ', &    !< ISO
-         'ispd          ', &    !< ISPD
-         'to2           ', &    !< TO2
-         'open          ', &    !< OPEN
-         'terp          ', &    !< TERP
-         'ec_f          ', &    !< EC_f
-         'ec_c          ', &    !< EC_c
-         'pom_f         ', &    !< POM_f
-         'pom_c         ', &    !< POM_c
-         'ppm_f         ', &    !< PPM_f
-         'ppm_c         ', &    !< PPM_c
-         'na_ff         ', &    !< Na_ff
-         'na_f          ', &    !< Na_f
-         'na_c          ', &    !< Na_c
-         'na_cc         ', &    !< Na_cc
-         'na_ccc        ', &    !< Na_ccc
-         'dust_ff       ', &    !< dust_ff
-         'dust_f        ', &    !< dust_f
-         'dust_c        ', &    !< dust_c
-         'dust_cc       ', &    !< dust_cc
-         'dust_ccc      ', &    !< dust_ccc
-         'tpm10         ', &    !< tpm10
-         'tpm25         ', &    !< tpm25
-         'tss           ', &    !< tss
-         'tdust         ', &    !< tdust
-         'tc            ', &    !< tc
-         'tcg           ', &    !< tcg
-         'tsoa          ', &    !< tsoa
-         'tnmvoc        ', &    !< tnmvoc
-         'SOxa          ', &    !< SOxa
-         'NOya          ', &    !< NOya
-         'NHxa          ', &    !< NHxa
-         'NO2_obs       ', &    !< NO2_obs
-         'tpm10_biascorr', &    !< tpm10_biascorr
-         'tpm25_biascorr', &    !< tpm25_biascorr
-         'O3_biascorr   ' /)    !< o3_biascorr
-!
-!-- Tracer mole mass:
-    REAL(wp), PARAMETER ::  specmolm(nposp) = (/                                                   &
-         xm_O * 2 + xm_N, &                         !< NO2
-         xm_O + xm_N, &                             !< NO
-         xm_O * 3, &                                !< O3
-         xm_C + xm_O, &                             !< CO
-         xm_H * 2 + xm_C + xm_O, &                  !< FORM
-         xm_H * 3 + xm_C * 2 + xm_O, &              !< ALD
-         xm_H * 3 + xm_C * 2 + xm_O * 5 + xm_N, &   !< PAN
-         xm_H * 4 + xm_C * 3 + xm_O * 2, &          !< MGLY
-         xm_H * 3 + xm_C, &                         !< PAR
-         xm_H * 3 + xm_C * 2, &                     !< OLE
-         xm_H * 4 + xm_C * 2, &                     !< ETH
-         xm_H * 8 + xm_C * 7, &                     !< TOL
-         xm_H * 8 + xm_C * 7 + xm_O, &              !< CRES
-         xm_H * 10 + xm_C * 8, &                    !< XYL
-         xm_S + xm_O * 4, &                         !< SO4a_f
-         xm_S + xm_O * 2, &                         !< SO2
-         xm_H + xm_O * 2 + xm_N, &                  !< HNO2
-         xm_H * 4 + xm_C, &                         !< CH4
-         xm_H * 3 + xm_N, &                         !< NH3
-         xm_O * 3 + xm_N, &                         !< NO3
-         xm_H + xm_O, &                             !< OH
-         xm_H + xm_O * 2, &                         !< HO2
-         xm_O * 5 + xm_N * 2, &                     !< N2O5
-         xm_S + xm_O * 4, &                         !< SO4a_c
-         xm_H * 4 + xm_N, &                         !< NH4a_f
-         xm_O * 3 + xm_N, &                         !< NO3a_f
-         xm_O * 3 + xm_N, &                         !< NO3a_c
-         xm_C * 2 + xm_O * 3, &                     !< C2O3
-         xm_dummy, &                                !< XO2
-         xm_dummy, &                                !< XO2N
-         xm_dummy, &                                !< CRO
-         xm_H + xm_O * 3 + xm_N, &                  !< HNO3
-         xm_H * 2 + xm_O * 2, &                     !< H2O2
-         xm_H * 8 + xm_C * 5, &                     !< ISO
-         xm_dummy, &                                !< ISPD
-         xm_dummy, &                                !< TO2
-         xm_dummy, &                                !< OPEN
-         xm_H * 16 + xm_C * 10, &                   !< TERP
-         xm_dummy, &                                !< EC_f
-         xm_dummy, &                                !< EC_c
-         xm_dummy, &                                !< POM_f
-         xm_dummy, &                                !< POM_c
-         xm_dummy, &                                !< PPM_f
-         xm_dummy, &                                !< PPM_c
-         xm_Na, &                                   !< Na_ff
-         xm_Na, &                                   !< Na_f
-         xm_Na, &                                   !< Na_c
-         xm_Na, &                                   !< Na_cc
-         xm_Na, &                                   !< Na_ccc
-         xm_dummy, &                                !< dust_ff
-         xm_dummy, &                                !< dust_f
-         xm_dummy, &                                !< dust_c
-         xm_dummy, &                                !< dust_cc
-         xm_dummy, &                                !< dust_ccc
-         xm_dummy, &                                !< tpm10
-         xm_dummy, &                                !< tpm25
-         xm_dummy, &                                !< tss
-         xm_dummy, &                                !< tdust
-         xm_dummy, &                                !< tc
-         xm_dummy, &                                !< tcg
-         xm_dummy, &                                !< tsoa
-         xm_dummy, &                                !< tnmvoc
-         xm_dummy, &                                !< SOxa
-         xm_dummy, &                                !< NOya
-         xm_dummy, &                                !< NHxa
-         xm_O * 2 + xm_N, &                         !< NO2_obs
-         xm_dummy, &                                !< tpm10_biascorr
-         xm_dummy, &                                !< tpm25_biascorr
-         xm_O * 3 /)                                !< o3_biascorr
-!
-!-- Get current day of the year
-    CALL get_date_time( time_since_reference_point, day_of_year = day_of_year )
-!
-!-- Initialize surface element m
-    m = 0
-    k = 0
-!
-!-- LSM or USM horizintal upward facing surface present at i,j:
-!-- Default surfaces are NOT considered for deposition
-    match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-    match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-!
-!--For LSM surfaces
-    IF ( match_lsm )  THEN
-!
-!--    Get surface element information at i,j:
-       m = surf_lsm_h(0)%start_index(j,i)
-       k = surf_lsm_h(0)%k(m)
-!
-!--    Get needed variables for surface element m
-       ustar_surf  = surf_lsm_h(0)%us(m)
-       z0h_surf    = surf_lsm_h(0)%z0h(m)
-       r_aero_surf = surf_lsm_h(0)%r_a(m)
-       solar_rad   = surf_lsm_h(0)%rad_sw_dir(m) + surf_lsm_h(0)%rad_sw_dif(m)
-
-       lai = surf_lsm_h(0)%lai(m)
-       sai = lai + 1
-!
-!--    For small grid spacing neglect R_a
-       IF ( dzw(k) <= 1.0 )  THEN
-          r_aero_surf = 0.0_wp
-       ENDIF
-!
-!--    Initialize lu's
-       luv_palm = 0
-       luv_dep = 0
-       lup_palm = 0
-       lup_dep = 0
-       luw_palm = 0
-       luw_dep = 0
-!
-!--    Initialize budgets
-       bud_luv = 0.0_wp
-       bud_lup = 0.0_wp
-       bud_luw = 0.0_wp
-!
-!--    Get land use for i,j and assign to DEPAC lu
-       IF ( surf_lsm_h(0)%frac(m,ind_veg_wall) > 0 )  THEN
-          luv_palm = surf_lsm_h(0)%vegetation_type(m)
-          IF ( luv_palm == ind_luv_user )  THEN
-             message_string = 'No lsm-vegetation type defined. Please define vegetation type to' //&
-                              ' enable deposition calculation'
-             CALL message( 'chem_depo', 'PA0738', 1, 2, 0, 6, 0 )
-          ELSEIF ( luv_palm == ind_luv_b_soil )  THEN
-             luv_dep = 9
-          ELSEIF ( luv_palm == ind_luv_mixed_crops )  THEN
-             luv_dep = 2
-          ELSEIF ( luv_palm == ind_luv_s_grass )  THEN
-             luv_dep = 1
-          ELSEIF ( luv_palm == ind_luv_ev_needle_trees )  THEN
-             luv_dep = 4
-          ELSEIF ( luv_palm == ind_luv_de_needle_trees )  THEN
-             luv_dep = 4
-          ELSEIF ( luv_palm == ind_luv_ev_broad_trees )  THEN
-             luv_dep = 12
-          ELSEIF ( luv_palm == ind_luv_de_broad_trees )  THEN
-             luv_dep = 5
-          ELSEIF ( luv_palm == ind_luv_t_grass )  THEN
-             luv_dep = 1
-          ELSEIF ( luv_palm == ind_luv_desert )  THEN
-             luv_dep = 9
-          ELSEIF ( luv_palm == ind_luv_tundra )  THEN
-             luv_dep = 8
-          ELSEIF ( luv_palm == ind_luv_irr_crops )  THEN
-             luv_dep = 2
-          ELSEIF ( luv_palm == ind_luv_semidesert )  THEN
-             luv_dep = 8
-          ELSEIF ( luv_palm == ind_luv_ice )  THEN
-             luv_dep = 10
-          ELSEIF ( luv_palm == ind_luv_marsh )  THEN
-             luv_dep = 8
-          ELSEIF ( luv_palm == ind_luv_ev_shrubs )  THEN
-             luv_dep = 14
-          ELSEIF ( luv_palm == ind_luv_de_shrubs )  THEN
-             luv_dep = 14
-          ELSEIF ( luv_palm == ind_luv_mixed_forest )  THEN
-             luv_dep = 4
-          ELSEIF ( luv_palm == ind_luv_intrup_forest )  THEN
-             luv_dep = 8
-          ENDIF
-       ENDIF
-
-       IF ( surf_lsm_h(0)%frac(m,ind_pav_green) > 0 )  THEN
-          lup_palm = surf_lsm_h(0)%pavement_type(m)
-          IF ( lup_palm == ind_lup_user )  THEN
-             message_string = 'No lsm-pavement type defined. Please define pavement type to ' //   &
-                              'enable deposition calculation'
-             CALL message( 'chem_depo', 'PA0738', 1, 2, 0, 6, 0 )
-          ELSEIF ( lup_palm == ind_lup_asph_conc )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_asph )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_conc )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_sett )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_pav_stones )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_cobblest )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_metal )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_wood )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_gravel )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_f_gravel )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_pebblest )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_woodchips )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_tartan )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_art_turf )  THEN
-             lup_dep = 9
-          ELSEIF ( lup_palm == ind_lup_clay )  THEN
-             lup_dep = 9
-          ENDIF
-       ENDIF
-
-       IF ( surf_lsm_h(0)%frac(m,ind_wat_win) > 0 )  THEN
-          luw_palm = surf_lsm_h(0)%water_type(m)
-          IF ( luw_palm == ind_luw_user )  THEN
-             message_string = 'No lsm-water type defined. Please define water type to enable' //   &
-                              ' deposition calculation'
-             CALL message( 'chem_depo', 'PA0738', 1, 2, 0, 6, 0 )
-          ELSEIF ( luw_palm ==  ind_luw_lake )  THEN
-             luw_dep = 13
-          ELSEIF ( luw_palm == ind_luw_river )  THEN
-             luw_dep = 13
-          ELSEIF ( luw_palm == ind_luw_ocean )  THEN
-             luw_dep = 6
-          ELSEIF ( luw_palm == ind_luw_pond )  THEN
-             luw_dep = 13
-          ELSEIF ( luw_palm == ind_luw_fountain )  THEN
-             luw_dep = 13
-          ENDIF
-       ENDIF
-!
-!--    Set wetness indicator to dry or wet for lsm vegetation or pavement
-       IF ( surf_lsm_h(0)%c_liq(m) > 0 )  THEN
-          nwet = 1
-       ELSE
-          nwet = 0
-       ENDIF
-!
-!--    Compute length of time step
-       IF ( call_chem_at_all_substeps )  THEN
-          dt_chem = dt_3d * weight_pres(intermediate_timestep_count)
-       ELSE
-          dt_chem = dt_3d
-       ENDIF
-
-       dh = dzw(k)
-       inv_dh = 1.0_wp / dh
-       dt_dh = dt_chem/dh
-!
-!--    Concentration at i,j,k
-       DO  lsp = 1, nspec
-          conc_ijk(lsp) = chem_species(lsp)%conc(k,j,i)
-       ENDDO
-
-!--    Temperature at i,j,k
-       temp_tmp = pt(k,j,i) * ( hyp(k) / 100000.0_wp )**0.286_wp
-
-       ts       = temp_tmp - 273.15  !< in degrees celcius
-!
-!--    Viscosity of air
-       visc = 1.496e-6 * temp_tmp**1.5 / (temp_tmp + 120.0)
-!
-!--    Air density at k
-       dens = rho_air_zw(k)
-!
-!--    Calculate relative humidity from specific humidity for DEPAC
-       qv_tmp = MAX( q(k,j,i), 0.0_wp)
-       rh_surf = relativehumidity_from_specifichumidity(qv_tmp, temp_tmp, hyp(k) )
-!
-!-- Check if surface fraction (vegetation, pavement or water) > 0 and calculate vd and budget
-!-- for each surface fraction. Then derive overall budget taking into account the surface fractions.
-!
-!--    Vegetation
-       IF ( surf_lsm_h(0)%frac(m,ind_veg_wall) > 0 )  THEN
-
-!
-!--       No vegetation on bare soil, desert or ice:
-          IF ( ( luv_palm == ind_luv_b_soil )  .OR.  ( luv_palm == ind_luv_desert )  .OR.          &
-               ( luv_palm == ind_luv_ice ) ) THEN
-
-             lai = 0.0_wp
-             sai = 0.0_wp
-
-          ENDIF
-
-          slinnfac = 1.0_wp
-!
-!--       Get deposition velocity vd
-          DO  lsp = 1, nvar
-!
-!--          Initialize
-             vs = 0.0_wp
-             vd_lu = 0.0_wp
-             rs = 0.0_wp
-             rb = 0.0_wp
-             rc_tot = 0.0_wp
-             IF ( spc_names(lsp) == 'PM10' )  THEN
-                part_type = 1
-!
-!--             Sedimentation velocity
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs,                                             &
-                                            vs,                                                    &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            luv_dep,                                               &
-                                            r_aero_surf, ustar_surf )
-
-                bud_luv(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-
-             ELSEIF ( spc_names(lsp) == 'PM25' )  THEN
-                part_type = 2
-!
-!--             Sedimentation velocity
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs,                                             &
-                                            vs,                                                    &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            luv_dep ,                                              &
-                                            r_aero_surf, ustar_surf )
-
-                bud_luv(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-             ELSE !< GASES
-!
-!--             Read spc_name of current species for gas parameter
-                IF ( ANY( pspecnames(:) == spc_names(lsp) ) )  THEN
-                   i_pspec = 0
-                   DO  pspec = 1, nposp
-                      IF ( pspecnames(pspec) == spc_names(lsp) )  THEN
-                         i_pspec = pspec
-                      END IF
-                   ENDDO
-
-                ELSE
-!
-!--             For now species not deposited
-                   CYCLE
-                ENDIF
-!
-!--             Factor used for conversion from ppb to ug/m3 :
-!--             ppb (mole tr)/(mole air)/ppb (kg tr)/(mole tr) (ug tr)/(kg tr) &
-!--                 (mole air)/(kg air) (kg air)/(m3 air) (kg air(ug/m3)/ppb/(kg/mole) = / (kg/mole)
-!--                 c           1e-9              xm_tracer         1e9       /       xm_air            dens
-!--             thus:
-!--                 c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3
-!--             Use density at k:
-                ppm2ugm3 =  (dens/xm_air) * 0.001_wp  !< (mole air)/m3
-!
-!--             Atmospheric concentration in DEPAC is requested in ug/m3:
-                !   ug/m3              ppm          (ug/m3)/ppm/(kg/mole)     kg/mole
-                conc_ijk_ugm3 = conc_ijk(lsp)         * ppm2ugm3 *   specmolm(i_pspec)  ! in ug/m3
-!
-!--             Diffusivity for DEPAC relevant gases
-!--             Use default value
-                diffusivity            = 0.11e-4
-!
-!--             Overwrite with known coefficients of diffusivity from Massman (1998)
-                IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4
-                IF ( spc_names(lsp) == 'NO'  ) diffusivity = 0.199e-4
-                IF ( spc_names(lsp) == 'O3'  ) diffusivity = 0.144e-4
-                IF ( spc_names(lsp) == 'CO'  ) diffusivity = 0.176e-4
-                IF ( spc_names(lsp) == 'SO2' ) diffusivity = 0.112e-4
-                IF ( spc_names(lsp) == 'CH4' ) diffusivity = 0.191e-4
-                IF ( spc_names(lsp) == 'NH3' ) diffusivity = 0.191e-4
-!
-!--             Get quasi-laminar boundary layer resistance rb:
-                CALL get_rb_cell( ( luv_dep == ilu_water_sea )  .OR.                               &
-                                  ( luv_dep == ilu_water_inland ), z0h_surf, ustar_surf,           &
-                                  diffusivity, rb )
-!
-!--             Get rc_tot
-                CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf,    &
-                                         solar_rad, cos_zenith, rh_surf, lai, sai, nwet, luv_dep,  &
-                                         2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3,       &
-                                         diffusivity, r_aero_surf , rb )
-!
-!--             Calculate budget
-                IF ( rc_tot <= 0.0 )  THEN
-
-                   bud_luv(lsp) = 0.0_wp
-
-                ELSE
-
-                   vd_lu = 1.0_wp / ( r_aero_surf + rb + rc_tot )
-
-                   bud_luv(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) *                           &
-                                    ( 1.0_wp - EXP( -vd_lu * dt_dh ) ) * dh
-                ENDIF
-
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!--    Pavement
-       IF ( surf_lsm_h(0)%frac(m,ind_pav_green) > 0 )  THEN
-!
-!--       No vegetation on pavements:
-          lai = 0.0_wp
-          sai = 0.0_wp
-
-          slinnfac = 1.0_wp
-!
-!--       Get vd
-          DO  lsp = 1, nvar
-!
-!--       Initialize
-             vs = 0.0_wp
-             vd_lu = 0.0_wp
-             rs = 0.0_wp
-             rb = 0.0_wp
-             rc_tot = 0.0_wp
-             IF ( spc_names(lsp) == 'PM10' )  THEN
-                part_type = 1
-!
-!--             Sedimentation velocity:
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs,                                             &
-                                            vs,                                                    &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            lup_dep,                                               &
-                                            r_aero_surf, ustar_surf )
-
-                bud_lup(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-
-             ELSEIF ( spc_names(lsp) == 'PM25' )  THEN
-                part_type = 2
-!
-!--             Sedimentation velocity:
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs,                                             &
-                                            vs,                                                    &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            lup_dep,                                               &
-                                            r_aero_surf, ustar_surf )
-
-                bud_lup(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-             ELSE  !<GASES
-!
-!--             Read spc_name of current species for gas parameter
-                IF ( ANY( pspecnames(:) == spc_names(lsp) ) )  THEN
-                   i_pspec = 0
-                   DO  pspec = 1, nposp
-                      IF ( pspecnames(pspec) == spc_names(lsp) )  THEN
-                         i_pspec = pspec
-                      END IF
-                   ENDDO
-
-                ELSE
-!
-!--                For now species not deposited
-                   CYCLE
-                ENDIF
-!
-!--             Factor used for conversion from ppb to ug/m3 :
-!--                 ppb (mole tr)/(mole air)/ppb (kg tr)/(mole tr) (ug tr)/(kg tr) &
-!--                 (mole air)/(kg air) (kg air)/(m3 air) (kg air(ug/m3)/ppb/(kg/mole) = / (kg/mole)
-!--                 c           1e-9               xm_tracer         1e9       /       xm_air            dens
-!--             thus:
-!--                 c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3
-!--             Use density at lowest layer:
-                ppm2ugm3 =  (dens/xm_air) * 0.001_wp  !< (mole air)/m3
-!
-!--             Atmospheric concentration in DEPAC is requested in ug/m3:
-                !   ug/m3              ppm          (ug/m3)/ppm/(kg/mole)     kg/mole
-                conc_ijk_ugm3 = conc_ijk(lsp)         * ppm2ugm3 *   specmolm(i_pspec)  ! in ug/m3
-!
-!--             Diffusivity for DEPAC relevant gases
-!--             Use default value
-                diffusivity            = 0.11e-4
-!
-!--             Overwrite with known coefficients of diffusivity from Massman (1998)
-                IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4
-                IF ( spc_names(lsp) == 'NO'  ) diffusivity = 0.199e-4
-                IF ( spc_names(lsp) == 'O3'  ) diffusivity = 0.144e-4
-                IF ( spc_names(lsp) == 'CO'  ) diffusivity = 0.176e-4
-                IF ( spc_names(lsp) == 'SO2' ) diffusivity = 0.112e-4
-                IF ( spc_names(lsp) == 'CH4' ) diffusivity = 0.191e-4
-                IF ( spc_names(lsp) == 'NH3' ) diffusivity = 0.191e-4
-!
-!--             Get quasi-laminar boundary layer resistance rb:
-                CALL get_rb_cell( ( lup_dep == ilu_water_sea )  .OR.                               &
-                                  ( lup_dep == ilu_water_inland ), z0h_surf, ustar_surf,           &
-                                    diffusivity, rb )
-!
-!--             Get rc_tot
-                CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf,    &
-                                         solar_rad, cos_zenith, rh_surf, lai, sai, nwet, lup_dep,  &
-                                         2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3,       &
-                                         diffusivity, r_aero_surf , rb )
-!
-!--             Calculate budget
-                IF ( rc_tot <= 0.0 )  THEN
-                   bud_lup(lsp) = 0.0_wp
-                ELSE
-                   vd_lu = 1.0_wp / (r_aero_surf + rb + rc_tot )
-                   bud_lup(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) *                           &
-                                  ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-                ENDIF
-
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!--    Water
-       IF ( surf_lsm_h(0)%frac(m,ind_wat_win) > 0 )  THEN
-!
-!--       No vegetation on water:
-          lai = 0.0_wp
-          sai = 0.0_wp
-          slinnfac = 1.0_wp
-!
-!--       Get vd
-          DO  lsp = 1, nvar
-!
-!--          Initialize
-             vs = 0.0_wp
-             vd_lu = 0.0_wp
-             rs = 0.0_wp
-             rb = 0.0_wp
-             rc_tot = 0.0_wp
-             IF ( spc_names(lsp) == 'PM10' )  THEN
-                part_type = 1
-!
-!--             Sedimentation velocity:
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs,                                             &
-                                            vs,                                                    &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            luw_dep,                                               &
-                                            r_aero_surf, ustar_surf )
-
-                bud_luw(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-             ELSEIF ( spc_names(lsp) == 'PM25' )  THEN
-                part_type = 2
-!
-!--             Sedimentation velocity:
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type), &
-                                                        particle_pars(ind_p_slip, part_type), &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs,                                             &
-                                            vs,                                                    &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            luw_dep,                                               &
-                                            r_aero_surf, ustar_surf )
-
-                bud_luw(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-             ELSE  !<GASES
-!
-!--             Read spc_name of current species for gas PARAMETER
-                IF ( ANY(pspecnames(:) == spc_names(lsp) ) )  THEN
-                   i_pspec = 0
-                   DO  pspec = 1, nposp
-                      IF ( pspecnames(pspec) == spc_names(lsp) )  THEN
-                         i_pspec = pspec
-                      END IF
-                   ENDDO
-
-                ELSE
-!
-!--                For now species not deposited
-                   CYCLE
-                ENDIF
-!
-!--             Factor used for conversion from ppb to ug/m3 :
-!--                 ppb (mole tr)/(mole air)/ppb (kg tr)/(mole tr) (ug tr)/(kg tr) &
-!--                 (mole air)/(kg air) (kg air)/(m3 air) (kg air(ug/m3)/ppb/(kg/mole) = / (kg/mole)
-!--                 c           1e-9               xm_tracer         1e9       /       xm_air            dens
-!--             thus:
-!--                 c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3
-!--             Use density at lowest layer:
-                ppm2ugm3 = (dens/xm_air) * 0.001_wp  !< (mole air)/m3
-!
-!--             Atmospheric concentration in DEPAC is requested in ug/m3:
-!--                 ug/m3        ppm          (ug/m3)/ppm/(kg/mole)     kg/mole
-                conc_ijk_ugm3 = conc_ijk(lsp) * ppm2ugm3 *  specmolm(i_pspec)  ! in ug/m3
-!
-!--             Diffusivity for DEPAC relevant gases
-!--             Use default value
-                diffusivity            = 0.11e-4
-!
-!--             Overwrite with known coefficients of diffusivity from Massman (1998)
-                IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4
-                IF ( spc_names(lsp) == 'NO'  ) diffusivity = 0.199e-4
-                IF ( spc_names(lsp) == 'O3'  ) diffusivity = 0.144e-4
-                IF ( spc_names(lsp) == 'CO'  ) diffusivity = 0.176e-4
-                IF ( spc_names(lsp) == 'SO2' ) diffusivity = 0.112e-4
-                IF ( spc_names(lsp) == 'CH4' ) diffusivity = 0.191e-4
-                IF ( spc_names(lsp) == 'NH3' ) diffusivity = 0.191e-4
-!
-!--             Get quasi-laminar boundary layer resistance rb:
-                CALL get_rb_cell( ( luw_dep == ilu_water_sea )  .OR.                               &
-                                  ( luw_dep == ilu_water_inland ), z0h_surf, ustar_surf,           &
-                                    diffusivity, rb )
-
-!--             Get rc_tot
-                CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf,    &
-                                         solar_rad, cos_zenith, rh_surf, lai, sai, nwet, luw_dep,  &
-                                         2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3,       &
-                                         diffusivity, r_aero_surf , rb )
-!
-!--             Calculate budget
-                IF ( rc_tot <= 0.0 )  THEN
-
-                   bud_luw(lsp) = 0.0_wp
-
-                ELSE
-
-                   vd_lu = 1.0_wp / (r_aero_surf + rb + rc_tot )
-
-                   bud_luw(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) *                           &
-                                  ( 1.0_wp - EXP(-vd_lu * dt_dh ) ) * dh
-                ENDIF
-
-             ENDIF
-          ENDDO
-       ENDIF
-
-
-       bud = 0.0_wp
-!
-!--    Calculate overall budget for surface m and adapt concentration
-       DO  lsp = 1, nspec
-
-          bud(lsp) = surf_lsm_h(0)%frac(m,ind_veg_wall)  * bud_luv(lsp) +                             &
-                     surf_lsm_h(0)%frac(m,ind_pav_green) * bud_lup(lsp) +                             &
-                     surf_lsm_h(0)%frac(m,ind_wat_win)   * bud_luw(lsp)
-!
-!--       Compute new concentration:
-          conc_ijk(lsp) = conc_ijk(lsp) + bud(lsp) * inv_dh
-
-          chem_species(lsp)%conc(k,j,i) = MAX( 0.0_wp, conc_ijk(lsp) )
-
-       ENDDO
-
-    ENDIF
-!
-!-- For USM surfaces
-    IF ( match_usm )  THEN
-!
-!--    Get surface element information at i,j:
-       m = surf_usm_h(0)%start_index(j,i)
-       k = surf_usm_h(0)%k(m)
-!
-!--    Get needed variables for surface element m
-       ustar_surf  = surf_usm_h(0)%us(m)
-       z0h_surf    = surf_usm_h(0)%z0h(m)
-       r_aero_surf = surf_usm_h(0)%r_a(m)
-       solar_rad   = surf_usm_h(0)%rad_sw_dir(m) + surf_usm_h(0)%rad_sw_dif(m)
-       lai = surf_usm_h(0)%lai(m)
-       sai = lai + 1
-!
-!--    For small grid spacing neglect R_a
-       IF ( dzw(k) <= 1.0 )  THEN
-          r_aero_surf = 0.0_wp
-       ENDIF
-!
-!--    Initialize lu's
-       luu_palm = 0
-       luu_dep = 0
-       lug_palm = 0
-       lug_dep = 0
-       lud_palm = 0
-       lud_dep = 0
-!
-!--    Initialize budgets
-       bud_luu  = 0.0_wp
-       bud_lug = 0.0_wp
-       bud_lud = 0.0_wp
-!
-!--    Get land use for i,j and assign to DEPAC lu
-       IF ( surf_usm_h(0)%frac(m,ind_pav_green) > 0 )  THEN
-!
-!--       For green urban surfaces (e.g. green roofs assume LU short grass
-          lug_palm = ind_luv_s_grass
-          IF ( lug_palm == ind_luv_user )  THEN
-             message_string = 'No usm-vegetation type defined. Please define vegetation type to' //&
-                              ' enable deposition calculation'
-             CALL message( 'chem_depo', 'PA0738', 1, 2, 0, 6, 0 )
-          ELSEIF ( lug_palm == ind_luv_b_soil )  THEN
-             lug_dep = 9
-          ELSEIF ( lug_palm == ind_luv_mixed_crops )  THEN
-             lug_dep = 2
-          ELSEIF ( lug_palm == ind_luv_s_grass )  THEN
-             lug_dep = 1
-          ELSEIF ( lug_palm == ind_luv_ev_needle_trees )  THEN
-             lug_dep = 4
-          ELSEIF ( lug_palm == ind_luv_de_needle_trees )  THEN
-             lug_dep = 4
-          ELSEIF ( lug_palm == ind_luv_ev_broad_trees )  THEN
-             lug_dep = 12
-          ELSEIF ( lug_palm == ind_luv_de_broad_trees )  THEN
-             lug_dep = 5
-          ELSEIF ( lug_palm == ind_luv_t_grass )  THEN
-             lug_dep = 1
-          ELSEIF ( lug_palm == ind_luv_desert )  THEN
-             lug_dep = 9
-          ELSEIF ( lug_palm == ind_luv_tundra  )  THEN
-             lug_dep = 8
-          ELSEIF ( lug_palm == ind_luv_irr_crops )  THEN
-             lug_dep = 2
-          ELSEIF ( lug_palm == ind_luv_semidesert )  THEN
-             lug_dep = 8
-          ELSEIF ( lug_palm == ind_luv_ice )  THEN
-             lug_dep = 10
-          ELSEIF ( lug_palm == ind_luv_marsh )  THEN
-             lug_dep = 8
-          ELSEIF ( lug_palm == ind_luv_ev_shrubs )  THEN
-             lug_dep = 14
-          ELSEIF ( lug_palm == ind_luv_de_shrubs  )  THEN
-             lug_dep = 14
-          ELSEIF ( lug_palm == ind_luv_mixed_forest )  THEN
-             lug_dep = 4
-          ELSEIF ( lug_palm == ind_luv_intrup_forest )  THEN
-             lug_dep = 8
-          ENDIF
-       ENDIF
-
-       IF ( surf_usm_h(0)%frac(m,ind_veg_wall) > 0 )  THEN
-!
-!--       For walls in USM assume concrete walls/roofs,
-!--       assumed LU class desert as also assumed for pavements in LSM
-          luu_palm = ind_lup_conc
-          IF ( luu_palm == ind_lup_user )  THEN
-             message_string = 'No pavement type defined. Please define pavement type to enable' // &
-                              ' deposition calculation'
-             CALL message( 'chem_depo', 'PA0739', 1, 2, 0, 6, 0 )
-          ELSEIF ( luu_palm == ind_lup_asph_conc )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_asph )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm ==  ind_lup_conc )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm ==  ind_lup_sett )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_pav_stones )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_cobblest )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_metal )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_wood )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_gravel )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_f_gravel )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_pebblest )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_woodchips )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_tartan )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_art_turf )  THEN
-             luu_dep = 9
-          ELSEIF ( luu_palm == ind_lup_clay )  THEN
-             luu_dep = 9
-          ENDIF
-       ENDIF
-
-       IF ( surf_usm_h(0)%frac(m,ind_wat_win) > 0 )  THEN
-!
-!--       For windows in USM assume metal as this is as close as we get, assumed LU class desert as
-!--       also assumed for pavements in LSM.
-          lud_palm = ind_lup_metal
-          IF ( lud_palm == ind_lup_user )  THEN
-             message_string = 'No usm-pavement type defined. Please define pavement type to ' //   &
-                              'enable deposition calculation'
-             CALL message( 'chem_depo', 'PA0738', 1, 2, 0, 6, 0 )
-          ELSEIF ( lud_palm == ind_lup_asph_conc )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_asph )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm ==  ind_lup_conc )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm ==  ind_lup_sett )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_pav_stones )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_cobblest )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_metal )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_wood )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_gravel )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_f_gravel )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_pebblest )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_woodchips )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_tartan )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_art_turf )  THEN
-             lud_dep = 9
-          ELSEIF ( lud_palm == ind_lup_clay )  THEN
-             lud_dep = 9
-          ENDIF
-       ENDIF
-!
-!--    @TODO: Activate these lines as soon as new ebsolver branch is merged:
-!--    Set wetness indicator to dry or wet for usm vegetation or pavement
-       !IF ( surf_usm_h(0)%c_liq(m) > 0 )  THEN
-       !   nwet = 1
-       !ELSE
-       nwet = 0
-       !ENDIF
-!
-!--    Compute length of time step
-       IF ( call_chem_at_all_substeps )  THEN
-          dt_chem = dt_3d * weight_pres(intermediate_timestep_count)
-       ELSE
-          dt_chem = dt_3d
-       ENDIF
-
-       dh = dzw(k)
-       inv_dh = 1.0_wp / dh
-       dt_dh = dt_chem / dh
-!
-!--    Concentration at i,j,k
-       DO  lsp = 1, nspec
-          conc_ijk(lsp) = chem_species(lsp)%conc(k,j,i)
-       ENDDO
-!
-!--    Temperature at i,j,k
-       temp_tmp = pt(k,j,i) * ( hyp(k) / 100000.0_wp )**0.286_wp
-
-       ts       = temp_tmp - 273.15  !< in degrees celcius
-!
-!--    Viscosity of air
-       visc = 1.496e-6 * temp_tmp**1.5 / ( temp_tmp + 120.0 )
-!
-!--    Air density at k
-       dens = rho_air_zw(k)
-!
-!--    Calculate relative humidity from specific humidity for DEPAC
-       qv_tmp = MAX( q(k,j,i), 0.0_wp )
-       rh_surf = relativehumidity_from_specifichumidity( qv_tmp, temp_tmp, hyp(k) )
-!
-!--    Check if surface fraction (vegetation, pavement or water) > 0 and calculate vd and budget for
-!--    each surface fraction. Then derive overall budget taking into account the surface fractions.
-
-!--    Walls/roofs
-       IF ( surf_usm_h(0)%frac(m,ind_veg_wall) > 0 )  THEN
-!
-!--       No vegetation on non-green walls:
-          lai = 0.0_wp
-          sai = 0.0_wp
-
-          slinnfac = 1.0_wp
-!
-!--       Get vd
-          DO  lsp = 1, nvar
-!
-!--          Initialize
-             vs = 0.0_wp
-             vd_lu = 0.0_wp
-             rs = 0.0_wp
-             rb = 0.0_wp
-             rc_tot = 0.0_wp
-             IF (spc_names(lsp) == 'PM10' )  THEN
-                part_type = 1
-!
-!--             Sedimentation velocity
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs,                                             &
-                                            vs,                                                    &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            luu_dep,                                               &
-                                            r_aero_surf, ustar_surf )
-
-                bud_luu(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-             ELSEIF ( spc_names(lsp) == 'PM25' )  THEN
-                part_type = 2
-!
-!--             Sedimentation velocity
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs,                                             &
-                                            vs,                                                    &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            luu_dep ,                                              &
-                                            r_aero_surf, ustar_surf )
-
-                bud_luu(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-             ELSE  !< GASES
-!
-!--             Read spc_name of current species for gas parameter
-                IF ( ANY( pspecnames(:) == spc_names(lsp) ) )  THEN
-                   i_pspec = 0
-                   DO  pspec = 1, nposp
-                      IF ( pspecnames(pspec) == spc_names(lsp) )  THEN
-                         i_pspec = pspec
-                      END IF
-                   ENDDO
-                ELSE
-!
-!--                For now species not deposited
-                   CYCLE
-                ENDIF
-!
-!--             Factor used for conversion from ppb to ug/m3 :
-!--                 ppb (mole tr)/(mole air)/ppb (kg tr)/(mole tr) (ug tr)/(kg tr) &
-!--                 (mole air)/(kg air) (kg air)/(m3 air) (kg air(ug/m3)/ppb/(kg/mole) = / (kg/mole)
-!--                 c           1e-9              xm_tracer         1e9       /       xm_air            dens
-!--             thus:
-!--                 c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3
-!--             Use density at k:
-                ppm2ugm3 =  (dens/xm_air) * 0.001_wp  !< (mole air)/m3
-
-                !
-!--             Atmospheric concentration in DEPAC is requested in ug/m3:
-!--                 ug/m3              ppm          (ug/m3)/ppm/(kg/mole)     kg/mole
-                conc_ijk_ugm3 = conc_ijk(lsp)         * ppm2ugm3 *   specmolm(i_pspec)  ! in ug/m3
-!
-!--             Diffusivity for DEPAC relevant gases
-!--             Use default value
-                diffusivity            = 0.11e-4
-!
-!--             Overwrite with known coefficients of diffusivity from Massman (1998)
-                IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4
-                IF ( spc_names(lsp) == 'NO'  ) diffusivity = 0.199e-4
-                IF ( spc_names(lsp) == 'O3'  ) diffusivity = 0.144e-4
-                IF ( spc_names(lsp) == 'CO'  ) diffusivity = 0.176e-4
-                IF ( spc_names(lsp) == 'SO2' ) diffusivity = 0.112e-4
-                IF ( spc_names(lsp) == 'CH4' ) diffusivity = 0.191e-4
-                IF ( spc_names(lsp) == 'NH3' ) diffusivity = 0.191e-4
-!
-!--             Get quasi-laminar boundary layer resistance rb:
-                CALL get_rb_cell( ( luu_dep == ilu_water_sea )  .OR.                               &
-                                  ( luu_dep == ilu_water_inland ), z0h_surf, ustar_surf,           &
-                                    diffusivity, rb )
-!
-!--             Get rc_tot
-                CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf,    &
-                                         solar_rad, cos_zenith, rh_surf, lai, sai, nwet, luu_dep,  &
-                                         2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3,       &
-                                         diffusivity, r_aero_surf, rb )
-!
-!--             Calculate budget
-                IF ( rc_tot <= 0.0 )  THEN
-
-                   bud_luu(lsp) = 0.0_wp
-
-                ELSE
-
-                   vd_lu = 1.0_wp / (r_aero_surf + rb + rc_tot )
-
-                   bud_luu(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) *                           &
-                                  ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-                ENDIF
-
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!--    Green usm surfaces
-       IF ( surf_usm_h(0)%frac(m,ind_pav_green) > 0 )  THEN
-
-!
-!--       No vegetation on bare soil, desert or ice:
-          IF ( ( lug_palm == ind_luv_b_soil )  .OR.  ( lug_palm == ind_luv_desert ) .OR.           &
-               ( lug_palm == ind_luv_ice ) ) THEN
-
-             lai = 0.0_wp
-             sai = 0.0_wp
-
-          ENDIF
-
-
-          slinnfac = 1.0_wp
-!
-!--       Get vd
-          DO  lsp = 1, nvar
-!
-!--          Initialize
-             vs = 0.0_wp
-             vd_lu = 0.0_wp
-             rs = 0.0_wp
-             rb = 0.0_wp
-             rc_tot = 0.0_wp
-             IF ( spc_names(lsp) == 'PM10' )  THEN
-                part_type = 1
-!
-!--             Sedimentation velocity
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs,                                             &
-                                            vs,                                                    &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            lug_dep,                                               &
-                                            r_aero_surf, ustar_surf )
-
-                bud_lug(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-             ELSEIF ( spc_names(lsp) == 'PM25' )  THEN
-                part_type = 2
-!
-!--             Sedimentation velocity
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs,                                             &
-                                            vs,                                                    &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            lug_dep,                                               &
-                                            r_aero_surf, ustar_surf )
-
-                bud_lug(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-             ELSE  !< GASES
-!
-!--             Read spc_name of current species for gas parameter
-                IF ( ANY( pspecnames(:) == spc_names(lsp) ) )  THEN
-                   i_pspec = 0
-                   DO  pspec = 1, nposp
-                      IF ( pspecnames(pspec) == spc_names(lsp) )  THEN
-                         i_pspec = pspec
-                      END IF
-                   ENDDO
-                ELSE
-!
-!--                For now species not deposited
-                   CYCLE
-                ENDIF
-!
-!--             Factor used for conversion from ppb to ug/m3 :
-!--                 ppb (mole tr)/(mole air)/ppb (kg tr)/(mole tr) (ug tr)/(kg tr) &
-!--                 (mole air)/(kg air) (kg air)/(m3 air) (kg air(ug/m3)/ppb/(kg/mole) = / (kg/mole)
-!--                 c           1e-9               xm_tracer         1e9       /       xm_air            dens
-!--             thus:
-!--                  c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3
-!--             Use density at k:
-                ppm2ugm3 =  (dens/xm_air) * 0.001_wp  ! (mole air)/m3
-!
-!--             Atmospheric concentration in DEPAC is requested in ug/m3:
-                !   ug/m3              ppm          (ug/m3)/ppm/(kg/mole)     kg/mole
-                conc_ijk_ugm3 = conc_ijk(lsp)         * ppm2ugm3 *   specmolm(i_pspec)  ! in ug/m3
-!
-!--             Diffusivity for DEPAC relevant gases
-!--             Use default value
-                diffusivity            = 0.11e-4
-!
-!--             Overwrite with known coefficients of diffusivity from Massman (1998)
-                IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4
-                IF ( spc_names(lsp) == 'NO'  ) diffusivity = 0.199e-4
-                IF ( spc_names(lsp) == 'O3'  ) diffusivity = 0.144e-4
-                IF ( spc_names(lsp) == 'CO'  ) diffusivity = 0.176e-4
-                IF ( spc_names(lsp) == 'SO2' ) diffusivity = 0.112e-4
-                IF ( spc_names(lsp) == 'CH4' ) diffusivity = 0.191e-4
-                IF ( spc_names(lsp) == 'NH3' ) diffusivity = 0.191e-4
-!
-!--             Get quasi-laminar boundary layer resistance rb:
-                CALL get_rb_cell( ( lug_dep == ilu_water_sea )  .OR.                               &
-                                  ( lug_dep == ilu_water_inland ), z0h_surf, ustar_surf,           &
-                                    diffusivity, rb )
-!
-!--             Get rc_tot
-                CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf,    &
-                                         solar_rad, cos_zenith, rh_surf, lai, sai, nwet, lug_dep,  &
-                                         2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3,       &
-                                         diffusivity, r_aero_surf , rb )
-!
-!--             Calculate budget
-                IF ( rc_tot <= 0.0 )  THEN
-
-                   bud_lug(lsp) = 0.0_wp
-
-                ELSE
-
-                   vd_lu = 1.0_wp / ( r_aero_surf + rb + rc_tot )
-
-                   bud_lug(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) *                           &
-                                  ( 1.0_wp - EXP( - vd_lu * dt_dh ) )  * dh
-                ENDIF
-
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!--    Windows
-       IF ( surf_usm_h(0)%frac(m,ind_wat_win) > 0 )  THEN
-!
-!--       No vegetation on windows:
-          lai = 0.0_wp
-          sai = 0.0_wp
-
-          slinnfac = 1.0_wp
-!
-!--       Get vd
-          DO  lsp = 1, nvar
-!
-!--          Initialize
-             vs = 0.0_wp
-             vd_lu = 0.0_wp
-             rs = 0.0_wp
-             rb = 0.0_wp
-             rc_tot = 0.0_wp
-             IF ( spc_names(lsp) == 'PM10' )  THEN
-                part_type = 1
-!
-!--             Sedimentation velocity
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs, vs,                                         &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            lud_dep, r_aero_surf, ustar_surf )
-
-                bud_lud(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-             ELSEIF ( spc_names(lsp) == 'PM25' )  THEN
-                part_type = 2
-!
-!--             Sedimentation velocity
-                vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type),      &
-                                                        particle_pars(ind_p_size, part_type),      &
-                                                        particle_pars(ind_p_slip, part_type),      &
-                                                        visc)
-
-                CALL drydepo_aero_zhang_vd( vd_lu, rs, vs,                                         &
-                                            particle_pars(ind_p_size, part_type),                  &
-                                            particle_pars(ind_p_slip, part_type),                  &
-                                            nwet, temp_tmp, dens, visc,                            &
-                                            lud_dep,                                               &
-                                            r_aero_surf, ustar_surf )
-
-                bud_lud(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh
-
-             ELSE  !< GASES
-!
-!--             Read spc_name of current species for gas PARAMETER
-                IF ( ANY( pspecnames(:) == spc_names(lsp) ) )  THEN
-                   i_pspec = 0
-                   DO  pspec = 1, nposp
-                      IF ( pspecnames(pspec) == spc_names(lsp) )  THEN
-                         i_pspec = pspec
-                      END IF
-                   ENDDO
-                ELSE
-!
-!--                For now species not deposited
-                   CYCLE
-                ENDIF
-!
-!--             Factor used for conversion from ppb to ug/m3 :
-!--                 ppb (mole tr)/(mole air)/ppb (kg tr)/(mole tr) (ug tr)/(kg tr) &
-!--                 (mole air)/(kg air) (kg air)/(m3 air) (kg air(ug/m3)/ppb/(kg/mole) = / (kg/mole)
-!--                 c           1e-9               xm_tracer         1e9       /       xm_air            dens
-!--             thus:
-!--                  c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3
-!--             Use density at k:
-
-                ppm2ugm3 =  (dens/xm_air) * 0.001_wp  ! (mole air)/m3
-!
-!--             Atmospheric concentration in DEPAC is requested in ug/m3:
-!--                 ug/m3              ppm          (ug/m3)/ppm/(kg/mole)     kg/mole
-                conc_ijk_ugm3 = conc_ijk(lsp)         * ppm2ugm3 *   specmolm(i_pspec)  ! in ug/m3
-!
-!--             Diffusivity for DEPAC relevant gases
-!--             Use default value
-                diffusivity = 0.11e-4
-!
-!--             Overwrite with known coefficients of diffusivity from Massman (1998)
-                IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4
-                IF ( spc_names(lsp) == 'NO'  ) diffusivity = 0.199e-4
-                IF ( spc_names(lsp) == 'O3'  ) diffusivity = 0.144e-4
-                IF ( spc_names(lsp) == 'CO'  ) diffusivity = 0.176e-4
-                IF ( spc_names(lsp) == 'SO2' ) diffusivity = 0.112e-4
-                IF ( spc_names(lsp) == 'CH4' ) diffusivity = 0.191e-4
-                IF ( spc_names(lsp) == 'NH3' ) diffusivity = 0.191e-4
-!
-!--             Get quasi-laminar boundary layer resistance rb:
-                CALL get_rb_cell( ( lud_dep == ilu_water_sea )  .OR.                               &
-                                  ( lud_dep == ilu_water_inland ), z0h_surf, ustar_surf,           &
-                                    diffusivity, rb )
-!
-!--             Get rc_tot
-                CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf,    &
-                                         solar_rad, cos_zenith, rh_surf, lai, sai, nwet, lud_dep,  &
-                                         2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3,       &
-                                         diffusivity, r_aero_surf , rb )
-!
-!--             Calculate budget
-                IF ( rc_tot <= 0.0 )  THEN
-
-                   bud_lud(lsp) = 0.0_wp
-
-                ELSE
-
-                   vd_lu = 1.0_wp / (r_aero_surf + rb + rc_tot )
-
-                   bud_lud(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) *                           &
-                                  ( 1.0_wp - EXP( - vd_lu * dt_dh ) )  * dh
-                ENDIF
-
-             ENDIF
-          ENDDO
-       ENDIF
-
-
-       bud = 0.0_wp
-!
-!--    Calculate overall budget for surface m and adapt concentration
-       DO  lsp = 1, nspec
-
-
-          bud(lsp) = surf_usm_h(0)%frac(m,ind_veg_wall)  * bud_luu(lsp) +                             &
-                     surf_usm_h(0)%frac(m,ind_pav_green) * bud_lug(lsp) +                             &
-                     surf_usm_h(0)%frac(m,ind_wat_win)   * bud_lud(lsp)
-!
-!--       Compute new concentration
-          conc_ijk(lsp) = conc_ijk(lsp) + bud(lsp) * inv_dh
-
-          chem_species(lsp)%conc(k,j,i) = MAX( 0.0_wp, conc_ijk(lsp) )
-
-       ENDDO
-
-    ENDIF
-
-
- END SUBROUTINE chem_depo
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to compute total canopy (or surface) resistance Rc for gases
-!>
-!> DEPAC:
-!> Code of the DEPAC routine and corresponding subroutines below from the DEPAC module of the
-!> LOTOS-EUROS model (Manders et al., 2017)
-!>
-!> Original DEPAC routines by RIVM and TNO (2015), for Documentation see van Zanten et al., 2010.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE drydepos_gas_depac( compnam, day_of_year, lat, t, ust, solar_rad, sinphi, rh, lai, sai,&
-                                nwet, lu, iratns, rc_tot, ccomp_tot, p, conc_ijk_ugm3, diffusivity,&
-                                ra, rb )
-!
-!--   Some of depac arguments are OPTIONAL:
-!--    A. compute Rc_tot without compensation points (ccomp_tot will be zero):
-!--        CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot,&
-!--                    ccomp_tot, [smi])
-!--    B. compute Rc_tot with compensation points (used for LOTOS-EUROS):
-!--        CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot,&
-!--                    ccomp_tot, [smi], c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water)
-!--
-!--    C. compute effective Rc based on compensation points (used for OPS):
-!--        CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot,&
-!--                    ccomp_tot, [smi], c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water, ra,  &
-!--                    rb, rc_eff)
-!--    X1. Extra (OPTIONAL) output variables:
-!--        CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot,&
-!--                    ccomp_tot, [smi], c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water, ra,  &
-!--                    rb, rc_eff, gw_out, gstom_out, gsoil_eff_out, cw_out, cstom_out, csoil_out,    &
-!--                    lai_out, sai_out)
-!--    X2. Extra (OPTIONAL) needed for stomatal ozone flux calculation (only sunlit leaves):
-!--        CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot,&
-!--                    ccomp_tot, [smi], c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water, ra,  &
-!--                    rb, rc_eff, gw_out, gstom_out, gsoil_eff_out, cw_out, cstom_out, csoil_out,    &
-!--                    lai_out, sai_out, calc_stom_o3flux, frac_sto_o3_lu, fac_surface_area_2_PLA)
-
-
-    CHARACTER(LEN=*), INTENT(IN) ::  compnam         !< component name
-                                                     !< 'HNO3','NO','NO2','O3','SO2','NH3'
-    INTEGER(iwp), INTENT(IN) ::  day_of_year         !< day of year, 1 ... 365 (366)
-    INTEGER(iwp), INTENT(IN) ::  iratns              !< index for NH3/SO2 ratio used for SO2:
-                                                     !< iratns = 1: low NH3/SO2
-                                                     !< iratns = 2: high NH3/SO2
-                                                     !< iratns = 3: very low NH3/SO2
-    INTEGER(iwp), INTENT(IN) ::  lu                  !< land use type, lu = 1,...,nlu
-    INTEGER(iwp), INTENT(IN) ::  nwet                !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow
-
-    REAL(wp), INTENT(IN) ::  conc_ijk_ugm3           !< actual atmospheric concentration (ug/m3), in
-                                                     !< DEPAC=Catm
-    REAL(wp), INTENT(IN) ::  diffusivity             !< diffusivity
-    REAL(wp), INTENT(IN) ::  lai                     !< one-sidedleaf area index (-)
-    REAL(wp), INTENT(IN) ::  lat                     !< latitude Northern hemisphere (degrees) (S.
-                                                     !< hemisphere not possible)
-    REAL(wp), INTENT(IN) ::  p                       !< pressure (Pa)
-    REAL(wp), INTENT(IN) ::  ra                      !< aerodynamic resistance (s/m)
-    REAL(wp), INTENT(IN) ::  rb                      !< boundary layer resistance (s/m)
-    REAL(wp), INTENT(IN) ::  rh                      !< relative humidity (%)
-    REAL(wp), INTENT(IN) ::  sai                     !< surface area index (-) (lai + branches and
-                                                     !< stems)
-    REAL(wp), INTENT(IN) ::  sinphi                  !< sin of solar elevation angle
-    REAL(wp), INTENT(IN) ::  solar_rad               !< solar radiation, dirict+diffuse (W/m2)
-    REAL(wp), INTENT(IN) ::  t                       !< temperature (C)
-    REAL(wp), INTENT(IN) ::  ust                     !< friction velocity (m/s)
-
-    REAL(wp), INTENT(OUT) ::  ccomp_tot              !< total compensation point (ug/m3)
-!                                                    !< [= 0 for species that don't have a compensation
-    REAL(wp), INTENT(OUT) ::  rc_tot                 !< total canopy resistance Rc (s/m)
-
-!-- Local variables:
-!
-!-- Component number taken from component name, paramteres matched with include files
-    INTEGER(iwp) ::  icmp
-!
-!-- Component numbers:
-    INTEGER(iwp), PARAMETER ::  icmp_o3   = 1
-    INTEGER(iwp), PARAMETER ::  icmp_so2  = 2
-    INTEGER(iwp), PARAMETER ::  icmp_no2  = 3
-    INTEGER(iwp), PARAMETER ::  icmp_no   = 4
-    INTEGER(iwp), PARAMETER ::  icmp_nh3  = 5
-    INTEGER(iwp), PARAMETER ::  icmp_co   = 6
-    INTEGER(iwp), PARAMETER ::  icmp_no3  = 7
-    INTEGER(iwp), PARAMETER ::  icmp_hno3 = 8
-    INTEGER(iwp), PARAMETER ::  icmp_n2o5 = 9
-    INTEGER(iwp), PARAMETER ::  icmp_h2o2 = 10
-
-    LOGICAL ::  ready                                !< Rc has been set:
-                                                     !< = 1 -> constant Rc
-                                                     !< = 2 -> temperature dependent Rc
-!
-!-- Vegetation indicators:
-    LOGICAL ::  lai_present                          !< leaves are present for current land use type
-    LOGICAL ::  sai_present                          !< vegetation is present for current land use
-                                                     !< type
-
-    REAL(wp) ::  csoil                               !< soil compensation point (ug/m3)
-    REAL(wp) ::  cstom                               !< stomatal compensation point (ug/m3)
-    REAL(wp) ::  cw                                  !< external leaf surface compensation point
-                                                     !< (ug/m3)
-    REAL(wp) ::  gc_tot                              !< total canopy conductance (m/s)
-    REAL(wp) ::  gsoil_eff                           !< effective soil conductance (m/s)
-    REAL(wp) ::  gstom                               !< stomatal conductance (m/s)
-    REAL(wp) ::  gw                                  !< external leaf conductance (m/s)
-!    REAL(wp) ::  laimax                              !< maximum leaf area index (-)
-!
-!-- Next statement is just to avoid compiler warning about unused variable
-    IF ( day_of_year == 0  .OR.  ( conc_ijk_ugm3 + lat + ra + rb ) > 0.0_wp )  CONTINUE
-!
-!-- Define component number
-    SELECT CASE ( TRIM( compnam ) )
-
-    CASE ( 'O3', 'o3' )
-       icmp = icmp_o3
-
-    CASE ( 'SO2', 'so2' )
-       icmp = icmp_so2
-
-    CASE ( 'NO2', 'no2' )
-       icmp = icmp_no2
-
-    CASE ( 'NO', 'no' )
-       icmp = icmp_no
-
-    CASE ( 'NH3', 'nh3' )
-       icmp = icmp_nh3
-
-    CASE ( 'CO', 'co' )
-       icmp = icmp_co
-
-    CASE ( 'NO3', 'no3' )
-       icmp = icmp_no3
-
-    CASE ( 'HNO3', 'hno3' )
-       icmp = icmp_hno3
-
-    CASE ( 'N2O5', 'n2o5' )
-       icmp = icmp_n2o5
-
-    CASE ( 'H2O2', 'h2o2' )
-       icmp = icmp_h2o2
-
-    CASE default
-!
-!--    Component not part of DEPAC --> not deposited
-       RETURN
-
-    END SELECT
-
-!
-!-- Inititalize
-    gw        = 0.0_wp
-    gstom     = 0.0_wp
-    gsoil_eff = 0.0_wp
-    gc_tot    = 0.0_wp
-    cw        = 0.0_wp
-    cstom     = 0.0_wp
-    csoil     = 0.0_wp
-!
-!-- Check whether vegetation is present:
-    lai_present = ( lai > 0.0 )
-    sai_present = ( sai > 0.0 )
-!
-!-- Set Rc (i.e. rc_tot) in special cases:
-    CALL rc_special( icmp, compnam, lu, t, nwet, rc_tot, ready, ccomp_tot )
-!
-!-- If Rc is not set:
-    IF ( .NOT. ready ) then
-!
-!--    External conductance:
-       CALL rc_gw( compnam, iratns, t, rh, nwet, sai_present, sai,gw )
-!
-!--    Stomatal conductance:
-       CALL rc_gstom( icmp, compnam, lu, lai_present, lai, solar_rad, sinphi, t, rh, diffusivity,  &
-                      gstom, p )
-!
-!--    Effective soil conductance:
-       CALL rc_gsoil_eff( icmp, lu, sai, ust, nwet, t, gsoil_eff )
-!
-!--    Total canopy conductance (gc_tot) and resistance Rc (rc_tot):
-       CALL rc_rctot( gstom, gsoil_eff, gw, gc_tot, rc_tot )
-
-    ENDIF
-
- END SUBROUTINE drydepos_gas_depac
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to compute total canopy resistance in special cases
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rc_special( icmp, compnam, lu, t, nwet, rc_tot, ready, ccomp_tot )
-
-
-    CHARACTER(LEN=*), INTENT(IN)  ::  compnam     !< component name
-
-    INTEGER(iwp), INTENT(IN)  ::  icmp            !< component index
-    INTEGER(iwp), INTENT(IN)  ::  lu              !< land use type, lu = 1,...,nlu
-    INTEGER(iwp), INTENT(IN)  ::  nwet            !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow
-
-    LOGICAL, INTENT(OUT) ::  ready               !< Rc has been set
-                                                 !< = 1 -> constant Rc
-
-    REAL(wp), INTENT(IN)  ::  t                   !< temperature (C)
-
-    REAL(wp), INTENT(OUT) ::  ccomp_tot          !< total compensation point (ug/m3)
-    REAL(wp), INTENT(OUT) ::  rc_tot             !< total canopy resistance Rc (s/m)
-
-!
-!-- Next line is to avoid compiler warning about unused variable
-    IF ( icmp == 0 )  CONTINUE
-!
-!-- rc_tot is not yet set:
-    ready = .FALSE.
-!
-!-- Default compensation point in special CASEs = 0:
-    ccomp_tot = 0.0_wp
-
-    SELECT CASE( TRIM( compnam ) )
-    CASE( 'HNO3', 'N2O5', 'NO3', 'H2O2' )
-!
-!--    No separate resistances for HNO3; just one total canopy resistance:
-       IF ( t < -5.0_wp .AND. nwet == 9 )  THEN
-!
-!--       T < 5 C and snow:
-          rc_tot = 50.0_wp
-       ELSE
-!
-!--       All other circumstances:
-          rc_tot = 10.0_wp
-       ENDIF
-       ready = .TRUE.
-
-    CASE( 'NO', 'CO' )
-       IF ( lu == ilu_water_sea .OR. lu == ilu_water_inland )  THEN       ! water
-          rc_tot = 2000.0_wp
-          ready = .TRUE.
-       ELSEIF ( nwet == 1 )  THEN  !< wet
-          rc_tot = 2000.0_wp
-          ready = .TRUE.
-       ENDIF
-    CASE( 'NO2', 'O3', 'SO2', 'NH3' )
-!
-!--    snow surface:
-       IF ( nwet == 9 )  THEN
-!
-!--       To be activated when snow is implemented
-          !CALL rc_snow(ipar_snow(icmp),t,rc_tot)
-          ready = .TRUE.
-       ENDIF
-    CASE default
-       message_string = 'Component '// TRIM( compnam ) // ' not supported'
-       CALL message( 'rc_special', 'PA0740', 1, 2, 0, 6, 0 )
-    END SELECT
-
- END SUBROUTINE rc_special
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to compute external conductance
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rc_gw( compnam, iratns, t, rh, nwet, sai_present, sai, gw )
-
-!
-!-- Input/output variables:
-    CHARACTER(LEN=*), INTENT(IN) ::  compnam      !< component name
-    INTEGER(iwp), INTENT(IN) ::  iratns           !< index for NH3/SO2 ratio;
-                                                  !< iratns = 1: low NH3/SO2
-                                                  !< iratns = 2: high NH3/SO2
-                                                  !< iratns = 3: very low NH3/SO2
-
-    INTEGER(iwp), INTENT(IN) ::  nwet             !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow
-
-    LOGICAL, INTENT(IN) ::  sai_present
-
-    REAL(wp), INTENT(IN) ::  rh                   !< relative humidity (%)
-    REAL(wp), INTENT(IN) ::  sai                  !< one-sided leaf area index (-)
-    REAL(wp), INTENT(IN) ::  t                    !< temperature (C)
-
-    REAL(wp), INTENT(OUT) ::  gw                  !< external leaf conductance (m/s)
-
-    SELECT CASE( TRIM( compnam ) )
-
-    CASE( 'NO2' )
-       CALL rw_constant( 2000.0_wp, sai_present, gw )
-
-    CASE( 'NO', 'CO' )
-       CALL rw_constant( -9999.0_wp, sai_present, gw )   !< see Erisman et al, 1994 section 3.2.3
-
-    CASE( 'O3' )
-       CALL rw_constant( 2500.0_wp, sai_present, gw )
-
-    CASE( 'SO2' )
-       CALL rw_so2( t, nwet, rh, iratns, sai_present, gw )
-
-    CASE( 'NH3' )
-       CALL rw_nh3_sutton( t, rh, sai_present, gw )
-!
-!--    Conversion from leaf resistance to canopy resistance by multiplying with sai:
-       gw = sai * gw
-
-    CASE default
-       message_string = 'Component '// TRIM( compnam ) // ' not supported'
-       CALL message( 'rc_gw', 'PA0740', 1, 2, 0, 6, 0 )
-    END SELECT
-
- END SUBROUTINE rc_gw
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to compute external leaf conductance for SO2
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rw_so2( t, nwet, rh, iratns, sai_present, gw )
-
-!
-!-- Input/output variables:
-    INTEGER(iwp), INTENT(IN) ::  iratns      !< index for NH3/SO2 ratio:
-                                             !< iratns = 1: low NH3/SO2
-                                             !< iratns = 2: high NH3/SO2
-                                             !< iratns = 3: very low NH3/SO2
-    INTEGER(iwp), INTENT(IN) ::  nwet        !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow
-
-    LOGICAL, INTENT(IN) ::  sai_present
-
-    REAL(wp), INTENT(IN) ::  rh              !< relative humidity (%)
-    REAL(wp), INTENT(IN) ::  t               !< temperature (C)
-
-    REAL(wp), INTENT(OUT) ::  gw             !< external leaf conductance (m/s)
-!
-!-- Local variables:
-    REAL(wp) ::  rw                          !< external leaf resistance (s/m)
-!
-!-- Check if vegetation present:
-    IF ( sai_present )  THEN
-
-       IF ( nwet == 0 )  THEN
-!
-!--   ------------------------
-!--         dry surface
-!--   ------------------------
-!--         T > -1 C
-          IF ( t > -1.0_wp )  THEN
-             IF ( rh < 81.3_wp )  THEN
-                rw = 25000.0_wp * EXP( -0.0693_wp * rh )
-             ELSE
-                rw = 0.58e12 * EXP( -0.278_wp * rh ) + 10.0_wp
-             ENDIF
-          ELSE
-             ! -5 C < T <= -1 C
-             IF ( t > -5.0_wp )  THEN
-                rw = 200.0_wp
-             ELSE
-                ! T <= -5 C
-                rw = 500.0_wp
-             ENDIF
-          ENDIF
-       ELSE
-!
-!--   ------------------------
-!--         wet surface
-!--   ------------------------
-          rw = 10.0_wp !see Table 5, Erisman et al, 1994 Atm. Environment, 0 is impl. as 10
-       ENDIF
-!
-!--    Very low NH3/SO2 ratio:
-       IF ( iratns == iratns_very_low ) rw = rw + 50.0_wp
-!
-!--      Conductance:
-       gw = 1.0_wp / rw
-    ELSE
-!
-!--      No vegetation:
-       gw = 0.0_wp
-    ENDIF
-
- END SUBROUTINE rw_so2
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to compute external leaf conductance for NH3, following Sutton & Fowler, 1993
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rw_nh3_sutton( tsurf, rh,sai_present, gw )
-
-!
-!-- Input/output variables:
-    LOGICAL, INTENT(IN) ::  sai_present
-
-    REAL(wp), INTENT(IN) ::  rh             !< relative humidity (%)
-    REAL(wp), INTENT(IN) ::  tsurf          !< surface temperature (C)
-
-    REAL(wp), INTENT(OUT) ::  gw            !< external leaf conductance (m/s)
-!
-!-- Local variables:
-    REAL(wp) ::  rw                         !< external leaf resistance (s/m)
-    REAL(wp) ::  sai_grass_haarweg          !< surface area index at experimental site Haarweg
-!
-!-- Fix sai_grass at value valid for Haarweg data for which gamma_w parametrization is derived
-    sai_grass_haarweg = 3.5_wp
-!
-!-- Calculation rw:
-!--                    100 - rh
-!--    rw = 2.0 * exp(----------)
-!--                      12
-
-    IF ( sai_present )  THEN
-!
-!--    External resistance according to Sutton & Fowler, 1993
-       rw = 2.0_wp * EXP( ( 100.0_wp - rh ) / 12.0_wp )
-       rw = sai_grass_haarweg * rw
-!
-!--    Frozen soil (from Depac v1):
-       IF ( tsurf < 0.0_wp ) rw = 200.0_wp
-!
-!--    Conductance:
-       gw = 1.0_wp / rw
-    ELSE
-       ! no vegetation:
-       gw = 0.0_wp
-    ENDIF
-
- END SUBROUTINE rw_nh3_sutton
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to compute external leaf conductance
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rw_constant( rw_val, sai_present, gw )
-
-!
-!-- Input/output variables:
-    LOGICAL, INTENT(IN) ::  sai_present
-
-    REAL(wp), INTENT(IN) ::  rw_val       !< constant value of Rw
-
-    REAL(wp), INTENT(OUT) ::  gw          !< wernal leaf conductance (m/s)
-!
-!-- Compute conductance:
-    IF ( sai_present  .AND.  .NOT. missing(rw_val) )  THEN
-       gw = 1.0_wp / rw_val
-    ELSE
-       gw = 0.0_wp
-    ENDIF
-
- END SUBROUTINE rw_constant
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to compute stomatal conductance
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rc_gstom( icmp, compnam, lu, lai_present, lai, solar_rad, sinphi, t, rh, diffusivity,  &
-                      gstom, p )
-
-!
-!-- input/output variables:
-    CHARACTER(LEN=*), INTENT(IN) ::  compnam       !< component name
-
-    INTEGER(iwp), INTENT(IN) ::  icmp              !< component index
-    INTEGER(iwp), INTENT(IN) ::  lu                !< land use type , lu = 1,...,nlu
-
-    LOGICAL, INTENT(IN) ::  lai_present
-
-    REAL(wp), INTENT(IN) ::  diffusivity           !< diffusion coefficient of the gas involved
-    REAL(wp), INTENT(IN) ::  lai                   !< one-sided leaf area index
-    REAL(wp), INTENT(IN) ::  rh                    !< relative humidity (%)
-    REAL(wp), INTENT(IN) ::  sinphi                !< sin of solar elevation angle
-    REAL(wp), INTENT(IN) ::  solar_rad             !< solar radiation, dirict+diffuse (W/m2)
-    REAL(wp), INTENT(IN) ::  t                     !< temperature (C)
-
-    REAL(wp), OPTIONAL,INTENT(IN) :: p             !< pressure (Pa)
-
-    REAL(wp), INTENT(OUT) ::  gstom                !< stomatal conductance (m/s)
-!
-!-- Local variables
-    REAL(wp), PARAMETER ::  dO3 = 0.13e-4          !< diffusion coefficient of ozon (m2/s)
-
-    REAL(wp) ::  vpd                               !< vapour pressure deficit (kPa)
-
-!
-!-- Next line is to avoid compiler warning about unused variables
-    IF ( icmp == 0 )  CONTINUE
-
-    SELECT CASE( TRIM( compnam ) )
-
-    CASE( 'NO', 'CO' )
-!
-!--    For no stomatal uptake is neglected:
-       gstom = 0.0_wp
-
-    CASE( 'NO2', 'O3', 'SO2', 'NH3' )
-!
-!--    If vegetation present:
-       IF ( lai_present )  THEN
-
-          IF ( solar_rad > 0.0_wp )  THEN
-             CALL rc_get_vpd( t, rh, vpd )
-             CALL rc_gstom_emb( lu, solar_rad, t, vpd, lai_present, lai, sinphi, gstom, p )
-             gstom = gstom * diffusivity / dO3       !< Gstom of Emberson is derived for ozone
-          ELSE
-             gstom = 0.0_wp
-          ENDIF
-       ELSE
-!
-!--       No vegetation; zero conductance (infinite resistance):
-          gstom = 0.0_wp
-       ENDIF
-
-    CASE default
-       message_string = 'Component '// TRIM( compnam ) // ' not supported'
-       CALL message( 'rc_gstom', 'PA0740', 1, 2, 0, 6, 0 )
-    END SELECT
-
- END SUBROUTINE rc_gstom
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine to compute stomatal conductance according to Emberson
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rc_gstom_emb( lu, solar_rad, T, vpd, lai_present, lai, sinp, Gsto, p )
-!
-!>  History
-!>   Original code from Lotos-Euros, TNO, M. Schaap
-!>   2009-08, M.C. van Zanten, Rivm
-!>     Updated and extended.
-!>   2009-09, Arjo Segers, TNO
-!>     Limitted temperature influence to range to avoid floating point exceptions.
-
-!> Method
-
-!>   Code based on Emberson et al, 2000, Env. Poll., 403-413
-!>   Notation conform Unified EMEP Model Description Part 1, ch 8
-!
-!>   In the calculation of f_light the modification of L. Zhang 2001, AE to the PARshade and PARsun
-!>   parametrizations of Norman 1982 are applied
-!>   f_phen and f_SWP are set to 1
-!
-!>   Land use types DEPAC versus Emberson (Table 5.1, EMEP model description)
-!>   DEPAC                     Emberson
-!>     1 = grass                 GR = grassland
-!>     2 = arable land           TC = temperate crops ( lai according to RC = rootcrops)
-!>     3 = permanent crops       TC = temperate crops ( lai according to RC = rootcrops)
-!>     4 = coniferous forest     CF = tempareate/boREAL(wp) coniferous forest
-!>     5 = deciduous forest      DF = temperate/boREAL(wp) deciduous forest
-!>     6 = water                 W  = water
-!>     7 = urban                 U  = urban
-!>     8 = other                 GR = grassland
-!>     9 = desert                DE = desert
-!
-!-- Emberson specific declarations
-!
-!-- Input/output variables:
-    INTEGER(iwp), INTENT(IN) ::  lu             !< land use type, lu = 1,...,nlu
-
-    LOGICAL, INTENT(IN) ::  lai_present
-
-    REAL(wp), INTENT(IN) ::  lai                !< one-sided leaf area index
-    REAL(wp), INTENT(IN) ::  sinp               !< sin of solar elevation angle
-    REAL(wp), INTENT(IN) ::  solar_rad          !< solar radiation, dirict+diffuse (W/m2)
-    REAL(wp), INTENT(IN) ::  t                  !< temperature (C)
-    REAL(wp), INTENT(IN) ::  vpd                !< vapour pressure deficit (kPa)
-
-
-    REAL(wp), OPTIONAL, INTENT(IN) ::  p        !< pressure (Pa)
-
-    REAL(wp), INTENT(OUT) ::  gsto              !< stomatal conductance (m/s)
-!
-!-- Local variables:
-    REAL(wp), PARAMETER ::  p_sealevel = 1.01325e05    !< Pa
-
-    REAL(wp) ::  bt
-    REAL(wp) ::  f_env
-    REAL(wp) ::  f_light
-    REAL(wp) ::  f_phen
-    REAL(wp) ::  f_temp
-    REAL(wp) ::  f_swp
-    REAL(wp) ::  f_vpd
-    REAL(wp) ::  laishade
-    REAL(wp) ::  laisun
-    REAL(wp) ::  pardiff
-    REAL(wp) ::  pardir
-    REAL(wp) ::  parshade
-    REAL(wp) ::  parsun
-    REAL(wp) ::  pres
-    REAL(wp) ::  sinphi
-
-!
-!-- Check whether vegetation is present:
-    IF ( lai_present )  THEN
-
-       ! Calculation of correction factors for stomatal conductance
-       IF ( sinp <= 0.0_wp )  THEN
-          sinphi = 0.0001_wp
-       ELSE
-          sinphi = sinp
-       END IF
-!
-!--    Ratio between actual and sea-level pressure is used to correct for height in the computation
-!--    of par; should not exceed sea-level pressure therefore ...
-       IF (  PRESENT( p ) )  THEN
-          pres = MIN( p, p_sealevel )
-       ELSE
-          pres = p_sealevel
-       ENDIF
-!
-!--    Direct and diffuse par, Photoactive (=visible) radiation:
-       CALL par_dir_diff( solar_rad, sinphi, pres, p_sealevel, pardir, pardiff )
-!
-!--    Par for shaded leaves (canopy averaged):
-       parshade = pardiff * EXP( -0.5 * lai**0.7 ) + 0.07 * pardir * ( 1.1 - 0.1 * lai ) *         &
-                  EXP( -sinphi )     !< Norman,1982
-       IF ( solar_rad > 200.0_wp  .AND.  lai > 2.5_wp )  THEN
-          parshade = pardiff * EXP( -0.5 * lai**0.8 ) + 0.07 * pardir * ( 1.1 - 0.1 * lai ) *      &
-                     EXP( -sinphi )  !< Zhang et al., 2001
-       END IF
-!
-!--    Par for sunlit leaves (canopy averaged):
-!--    alpha -> mean angle between leaves and the sun is fixed at 60 deg -> i.e. cos alpha = 0.5
-       parsun = pardir * 0.5/sinphi + parshade             !< Norman, 1982
-       IF ( solar_rad > 200.0_wp  .AND.  lai > 2.5_wp )  THEN
-          parsun = pardir**0.8 * 0.5 / sinphi + parshade   !< Zhang et al., 2001
-       END IF
-!
-!--    Leaf area index for sunlit and shaded leaves:
-       IF ( sinphi > 0 )  THEN
-          laisun = 2 * sinphi * ( 1 - EXP( -0.5 * lai / sinphi ) )
-          laishade = lai - laisun
-       ELSE
-          laisun = 0
-          laishade = lai
-       END IF
-
-       f_light = ( laisun * ( 1 - EXP( -1.0_wp * alpha(lu) * parsun ) ) +                          &
-                   laishade * ( 1 - EXP( -1.0_wp * alpha(lu) * parshade ) ) ) / lai
-
-       f_light = MAX(f_light,f_min(lu))
-!
-!--    Temperature influence; only non-zero within range [tmin,tmax]:
-       IF ( ( tmin(lu) < t )  .AND.  ( t < tmax(lu) ) )  THEN
-          bt = ( tmax(lu) - topt(lu) ) / ( topt(lu) - tmin(lu) )
-          f_temp = ( ( t - tmin(lu) ) / ( topt(lu) - tmin(lu) ) ) *                                &
-                   ( ( tmax(lu) - t ) / ( tmax(lu) - topt(lu) ) )**bt
-       ELSE
-          f_temp = 0.0_wp
-       END IF
-       f_temp = MAX( f_temp, f_min(lu) )
-!
-!--    Vapour pressure deficit influence
-       f_vpd = MIN( 1.0_wp, ( ( 1.0_wp - f_min(lu) ) * ( vpd_min(lu) - vpd ) /                     &
-                              ( vpd_min(lu) - vpd_max(lu) ) + f_min(lu) ) )
-       f_vpd = MAX( f_vpd, f_min(lu) )
-
-       f_swp = 1.0_wp
-!
-!--    Influence of phenology on stom. conductance
-!--    Ignored for now in DEPAC since influence of f_phen on lu classes in use is negligible.
-!--    When other EMEP classes (e.g. med. broadleaf) are used f_phen might be too important to
-!--    ignore.
-       f_phen = 1.0_wp
-!
-!--    Evaluate total stomatal conductance
-       f_env = f_temp * f_vpd * f_swp
-       f_env = MAX( f_env,f_min(lu) )
-       gsto = g_max(lu) * f_light * f_phen * f_env
-!
-!--    gstom expressed per m2 leafarea;
-!--    This is converted with lai to m2 surface.
-       gsto = lai * gsto    ! in m/s
-
-    ELSE
-       gsto = 0.0_wp
-    ENDIF
-
- END SUBROUTINE rc_gstom_emb
-
-
-!--------------------------------------------------------------------------------------------------!
- !> par_dir_diff
- !>     Weiss, A., Norman, J.M. (1985) Partitioning solar radiation into direct and diffuse, visible
- !>     and near-infrared components. Agric. Forest Meteorol. 34, 205-213.
- !>     From a SUBROUTINE obtained from Leiming Zhang,
- !>     Meteorological Service of Canada
- !>     Leiming uses solar irradiance. This should be equal to global radiation and
- !>     Willem Asman set it to global radiation (here defined as solar radiation, dirict+diffuse)
- !>
- !>     @todo Check/connect/replace with radiation_model_mod variables
- !-------------------------------------------------------------------------------------------------!
- SUBROUTINE par_dir_diff( solar_rad, sinphi, pres, pres_0, par_dir, par_diff )
-
-
-    REAL(wp), INTENT(IN) ::  pres            !< actual pressure (to correct for height) (Pa)
-    REAL(wp), INTENT(IN) ::  pres_0          !< pressure at sea level (Pa)
-    REAL(wp), INTENT(IN) ::  sinphi          !< sine of the solar elevation
-    REAL(wp), INTENT(IN) ::  solar_rad       !< solar radiation, dirict+diffuse (W m-2)
-
-    REAL(wp), INTENT(OUT) ::  par_diff       !< par diffuse: visible (photoactive) diffuse radiation
-                                             !< (W m-2)
-    REAL(wp), INTENT(OUT) ::  par_dir        !< par direct : visible (photoactive) direct beam
-                                             !< radiation (W m-2)
-
-    REAL(wp) ::  fv                          !< par direct beam fraction (dimensionless)
-    REAL(wp) ::  ratio                       !< ratio measured to potential solar radiation
-                                             !< (dimensionless)
-    REAL(wp) ::  rdm                         !< potential direct beam near-infrared radiation
-                                             !< (W m-2); "potential" means clear-sky
-    REAL(wp) ::  rdn                         !< potential diffuse near-infrared radiation (W m-2)
-    REAL(wp) ::  rdu                         !< visible (par) direct beam radiation (W m-2)
-    REAL(wp) ::  rdv                         !< potential visible (par) diffuse radiation (W m-2)
-    REAL(wp) ::  rn                          !< near-infrared radiation (W m-2)
-    REAL(wp) ::  rv                          !< visible radiation (W m-2)
-    REAL(wp) ::  sv                          !< total visible radiation
-    REAL(wp) ::  ww                          !< water absorption in the near infrared for 10 mm of
-                                             !< precipitable water
-
-!
-!-- Calculate visible (PAR) direct beam radiation
-!-- 600 W m-2 represents average amount of par (400-700 nm wavelength) at the top of the atmosphere;
-!-- this is roughly 0.45*solar constant (solar constant=1320 Wm-2)
-    rdu = 600.0_wp* EXP( -0.185_wp * ( pres / pres_0 ) / sinphi ) * sinphi
-!
-!-- Calculate potential visible diffuse radiation
-    rdv = 0.4_wp * ( 600.0_wp - rdu ) * sinphi
-!
-!-- Calculate the water absorption in the-near infrared
-    ww = 1320 * 10**( -1.195_wp + 0.4459_wp * LOG10( 1.0_wp / sinphi ) - 0.0345_wp *               &
-                      ( LOG10( 1.0_wp / sinphi ) )**2 )
-!
-!-- Calculate potential direct beam near-infrared radiation
-    rdm = ( 720.0_wp * EXP( -0.06_wp * ( pres / pres_0) / sinphi ) - ww ) * sinphi  !< 720 = solar
-                                                                                    !< constant - 600
-!
-!-- Calculate potential diffuse near-infrared radiation
-    rdn = 0.6_wp * ( 720 - rdm - ww ) * sinphi
-!
-!-- Compute visible and near-infrared radiation
-    rv = MAX( 0.1_wp, rdu + rdv )
-    rn = MAX( 0.01_wp, rdm + rdn )
-!
-!-- Compute ratio between input global radiation (here defined as solar radiation, dirict+diffuse)
-!-- and total radiation computed here.
-    ratio = MIN( 0.89_wp, solar_rad / ( rv + rn ) )
-!
-!-- Calculate total visible radiation
-    sv = ratio * rv
-!
-!-- Calculate fraction of par in the direct beam
-    fv = MIN( 0.99_wp, ( 0.9_wp - ratio ) / 0.7_wp )              !< help variable
-    fv = MAX( 0.01_wp, rdu / rv * ( 1.0_wp - fv**0.6667_wp ) )    !< fraction of par in the direct
-                                                                  !< beam
-!
-!-- Compute direct and diffuse parts of par
-    par_dir = fv * sv
-    par_diff = sv - par_dir
-
- END SUBROUTINE par_dir_diff
-
-
-!--------------------------------------------------------------------------------------------------!
-!> rc_get_vpd: get vapour pressure deficit (kPa)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rc_get_vpd( temp, rh, vpd )
-
-!
-!-- Input/output variables:
-    REAL(wp), INTENT(IN) ::  rh    !< relative humidity (%)
-    REAL(wp), INTENT(IN) ::  temp    !< temperature (C)
-
-    REAL(wp), INTENT(OUT) ::  vpd    !< vapour pressure deficit (kPa)
-!
-!-- Local variables:
-    REAL(wp) ::  esat
-!
-!-- Fit parameters:
-    REAL(wp), PARAMETER ::  a1 = 6.113718e-01
-    REAL(wp), PARAMETER ::  a2 = 4.43839e-02
-    REAL(wp), PARAMETER ::  a3 = 1.39817e-03
-    REAL(wp), PARAMETER ::  a4 = 2.9295e-05
-    REAL(wp), PARAMETER ::  a5 = 2.16e-07
-    REAL(wp), PARAMETER ::  a6 = 3.0e-09
-!
-!-- esat is saturation vapour pressure (kPa) at temp(C) following Monteith (1973)
-    esat = a1 + a2 * temp + a3 * temp**2 + a4 * temp**3 + a5 * temp**4 + a6 * temp**5
-    vpd  = esat * ( 1 - rh / 100 )
-
- END SUBROUTINE rc_get_vpd
-
-
-!--------------------------------------------------------------------------------------------------!
-!> rc_gsoil_eff: compute effective soil conductance
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rc_gsoil_eff( icmp, lu, sai, ust, nwet, t, gsoil_eff )
-
-!
-!-- Input/output variables:
-    INTEGER(iwp), INTENT(IN) ::  icmp          !< component index
-    INTEGER(iwp), INTENT(IN) ::  nwet          !< index for wetness
-                                               !< nwet = 0 -> dry; nwet = 1 -> wet; nwet = 9 -> snow
-                                               !< N.B. this routine cannot be called with nwet = 9,
-                                               !< nwet = 9 should be handled outside this routine.
-    INTEGER(iwp), INTENT(IN) ::  lu            !< land use type, lu = 1,..., nlu
-
-    REAL(wp), INTENT(IN) ::  sai               !< surface area index
-    REAL(wp), INTENT(IN) ::  t                 !< temperature (C)
-    REAL(wp), INTENT(IN) ::  ust               !< friction velocity (m/s)
-
-    REAL(wp), INTENT(OUT) ::  gsoil_eff        !< effective soil conductance (m/s)
-!
-!-- local variables:
-    REAL(wp) ::  rinc                          !< in canopy resistance  (s/m)
-    REAL(wp) ::  rsoil_eff                     !< effective soil resistance (s/m)
-!
-!-- Soil resistance (numbers matched with lu_classes and component numbers)
-    !     grs    ara    crp    cnf    dec    wat    urb   oth    des    ice    sav    trf    wai    med    sem
-    REAL(wp), PARAMETER ::  rsoil(nlu_dep,ncmp) = RESHAPE( (/                                      &
-         1000.,  200.,  200.,  200.,  200., 2000.,  400., 1000., 2000., 2000., 1000.,  200., 2000.,  200.,  400., &    !< O3
-         1000., 1000., 1000., 1000., 1000.,   10., 1000., 1000., 1000.,  500., 1000., 1000.,   10., 1000., 1000., &    !< SO2
-         1000., 1000., 1000., 1000., 1000., 2000., 1000., 1000., 1000., 2000., 1000., 1000., 2000., 1000., 1000., &    !< NO2
-         -999., -999., -999., -999., -999., 2000., 1000., -999., 2000., 2000., -999., -999., 2000., -999., -999., &    !< NO
-         100.,  100.,  100.,  100.,  100.,   10.,  100.,  100.,  100., 1000.,  100.,  100.,   10.,  100.,  100.,  &    !< NH3
-         -999., -999., -999., -999., -999., 2000., 1000., -999., 2000., 2000., -999., -999., 2000., -999., -999., &    !< CO
-         -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., &    !< NO3
-         -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., &    !< HNO3
-         -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., &    !< N2O5
-         -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999. /),&  !< H2O2
-         (/nlu_dep,ncmp/) )
-!
-!-- For                                          o3    so2   no2     no    nh3     co     no3    hno3   n2o5   h2o2
-    REAL(wp), PARAMETER ::  rsoil_frozen(ncmp) = (/ 2000., 500., 2000., -999., 1000., -999., -999., -999., -999., -999. /)
-    REAL(wp), PARAMETER ::  rsoil_wet(ncmp)    = (/ 2000., 10. , 2000., -999., 10.  , -999., -999., -999., -999., -999. /)
-!
-!-- Compute in canopy (in crop) resistance:
-    CALL rc_rinc( lu, sai, ust, rinc )
-!
-!-- Check for missing deposition path:
-    IF ( missing(rinc) )  THEN
-       rsoil_eff = -9999.0_wp
-    ELSE
-!
-!--    Frozen soil (temperature below 0):
-       IF ( t < 0.0_wp )  THEN
-          IF ( missing( rsoil_frozen( icmp ) ) )  THEN
-             rsoil_eff = -9999.0_wp
-          ELSE
-             rsoil_eff = rsoil_frozen( icmp ) + rinc
-          ENDIF
-       ELSE
-!
-!--       Non-frozen soil; dry:
-          IF ( nwet == 0 )  THEN
-             IF ( missing( rsoil( lu, icmp ) ) )  THEN
-                rsoil_eff = -9999.0_wp
-             ELSE
-                rsoil_eff = rsoil( lu, icmp ) + rinc
-             ENDIF
-!
-!--       Non-frozen soil; wet:
-          ELSEIF ( nwet == 1 )  THEN
-             IF ( missing( rsoil_wet( icmp ) ) )  THEN
-                rsoil_eff = -9999.0_wp
-             ELSE
-                rsoil_eff = rsoil_wet( icmp ) + rinc
-             ENDIF
-          ELSE
-             message_string = 'nwet can only be 0 or 1'
-             CALL message( 'rc_gsoil_eff', 'PA0741', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- Compute conductance:
-    IF ( rsoil_eff > 0.0_wp )  THEN
-       gsoil_eff = 1.0_wp / rsoil_eff
-    ELSE
-       gsoil_eff = 0.0_wp
-    ENDIF
-
- END SUBROUTINE rc_gsoil_eff
-
-
-!--------------------------------------------------------------------------------------------------!
-!> rc_rinc: compute in canopy (or in crop) resistance van Pul and Jacobs, 1993, BLM
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rc_rinc( lu, sai, ust, rinc )
-
-!
-!-- Input/output variables:
-    INTEGER(iwp), INTENT(IN) ::  lu          !< land use class, lu = 1, ..., nlu
-
-    REAL(wp), INTENT(IN) ::  sai             !< surface area index
-    REAL(wp), INTENT(IN) ::  ust             !< friction velocity (m/s)
-
-    REAL(wp), INTENT(OUT) ::  rinc           !< in canopy resistance (s/m)
-!
-!-- b = empirical constant for computation of rinc (in canopy resistance) (= 14 m-1 or -999 if not
-!--     applicable)
-!-- h = vegetation height (m)                     gra  ara crop con dec wat   urb   oth   des   ice   sav   trf  wai  med semi
-    REAL(wp), DIMENSION(nlu_dep), PARAMETER ::  b = (/ -999, 14, 14, 14, 14, -999, -999, -999, -999, -999, -999, 14, -999,  &
-         14, 14 /)
-    REAL(wp), DIMENSION(nlu_dep), PARAMETER ::  h = (/ -999, 1,  1,  20, 20, -999, -999, -999, -999, -999, -999, 20, -999,  &
-         1 ,  1 /)
-!
-!-- Compute Rinc only for arable land, perm. crops, forest; otherwise Rinc = 0:
-    IF ( b(lu) > 0.0_wp )  THEN
-!
-!--    Check for u* > 0 (otherwise denominator = 0):
-       IF ( ust > 0.0_wp )  THEN
-          rinc = b(lu) * h(lu) * sai/ust
-       ELSE
-          rinc = 1000.0_wp
-       ENDIF
-    ELSE
-       IF ( lu == ilu_grass  .OR.  lu == ilu_other )  THEN
-          rinc = -999.0_wp     !< no deposition path for grass, other, and semi-natural
-       ELSE
-          rinc = 0.0_wp        !< no in-canopy resistance
-       ENDIF
-    ENDIF
-
- END SUBROUTINE rc_rinc
-
-
-!--------------------------------------------------------------------------------------------------!
-!> rc_rctot: compute total canopy (or surface) resistance Rc
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rc_rctot( gstom, gsoil_eff, gw, gc_tot, rc_tot )
-
-!
-!-- Input/output variables:
-    REAL(wp), INTENT(IN) ::  gsoil_eff     !< effective soil conductance (s/m)
-    REAL(wp), INTENT(IN) ::  gstom         !< stomatal conductance (s/m)
-    REAL(wp), INTENT(IN) ::  gw            !< external leaf conductance (s/m)
-
-    REAL(wp), INTENT(OUT) ::  gc_tot       !< total canopy conductance (m/s)
-    REAL(wp), INTENT(OUT) ::  rc_tot       !< total canopy resistance Rc (s/m)
-!
-!-- Total conductance:
-    gc_tot = gstom + gsoil_eff + gw
-!
-!-- Total resistance (note: gw can be negative, but no total emission allowed here):
-    IF ( gc_tot <= 0.0_wp .OR. gw < 0.0_wp )  THEN
-       rc_tot = -9999.0_wp
-    ELSE
-       rc_tot = 1.0_wp / gc_tot
-    ENDIF
-
- END SUBROUTINE rc_rctot
-
-
-!--------------------------------------------------------------------------------------------------!
-!> missing: check for data that correspond with a missing deposition path this data is represented
-!>          by -999
-!--------------------------------------------------------------------------------------------------!
- LOGICAL function missing( x )
-
-    REAL(wp), INTENT(IN) ::  x
-
-!
-!-- Bandwidth for checking (in)equalities of floats
-    REAL(wp), PARAMETER :: eps = 1.0e-5
-
-    missing = ( ABS( x + 999.0_wp ) <= eps )
-
- END function missing
-
-
- ELEMENTAL FUNCTION sedimentation_velocity( rhopart, partsize, slipcor, visc ) RESULT( vs )
-
-!
-!-- in/out
-    REAL(wp), INTENT(IN) ::  rhopart                 !< particle density (kg/m3)
-    REAL(wp), INTENT(IN) ::  partsize                !< particle size (m)
-    REAL(wp), INTENT(IN) ::  slipcor                 !< slip correction factor (m)
-    REAL(wp), INTENT(IN) ::  visc                    !< viscosity
-
-    REAL(wp) ::  vs
-!
-!-- acceleration of gravity:
-    REAL(wp), PARAMETER         ::  grav = 9.80665_wp   !< m/s2
-
-!-- sedimentation velocity
-    vs = rhopart * ( partsize**2 ) * grav * slipcor / ( 18.0_wp * visc )
-
- END FUNCTION sedimentation_velocity
-
-
- !-------------------------------------------------------------------------------------------------!
- !> Boundary-layer deposition resistance following Zhang (2001)
- !-------------------------------------------------------------------------------------------------!
- SUBROUTINE drydepo_aero_zhang_vd( vd, rs, vs1, partsize, slipcor, nwet, tsurf, dens1, viscos1,    &
-                                   luc, ftop_lu, ustar )
-
-!
-!-- in/out
-    INTEGER(iwp), INTENT(IN) ::  luc         !< DEPAC LU
-    INTEGER(iwp), INTENT(IN) ::  nwet        !< 1=rain, 9=snowcover
-
-    REAL(wp), INTENT(IN) ::  dens1           !< air density (kg/m3) in lowest layer
-    REAL(wp), INTENT(IN) ::  ftop_lu         !< atmospheric resistnace Ra
-    REAL(wp), INTENT(IN) ::  partsize        !< particle diameter (m)
-    REAL(wp), INTENT(IN) ::  slipcor         !< slip correction factor
-    REAL(wp), INTENT(IN) ::  tsurf           !< surface temperature (K)
-    REAL(wp), INTENT(IN) ::  ustar           !< friction velocity u*
-    REAL(wp), INTENT(IN) ::  viscos1         !< air viscosity in lowest layer
-    REAL(wp), INTENT(IN) ::  vs1             !< sedimentation velocity in lowest layer
-
-    REAL(wp), INTENT(OUT) ::  rs             !< sedimentaion resistance (s/m)
-    REAL(wp), INTENT(OUT) ::  vd             !< deposition velocity (m/s)
-!
-!-- Constants
-    REAL(wp), PARAMETER ::  grav     = 9.80665_wp             !< acceleration of gravity (m/s2)
-    REAL(wp), PARAMETER ::  epsilon0 = 3.0_wp
-    REAL(wp), PARAMETER ::  kb       = 1.38066E-23_wp
-    REAL(wp), PARAMETER ::  pi       = 3.141592654_wp      !< pi
-
-    REAL(wp), PARAMETER :: alfa_lu(nlu_dep) = &
-         (/ 1.2_wp,  1.2_wp,   1.2_wp,  1.0_wp,  1.0_wp,   100.0_wp, 1.5_wp,  1.2_wp, 50.0_wp, 100.0_wp, &
-              1.2_wp, 1.0_wp, 100.0_wp, 1.2_wp, 50.0_wp /)
-    REAL(wp), PARAMETER :: gamma_lu(nlu_dep) = &
-         (/ 0.54_wp, 0.54_wp,  0.54_wp, 0.56_wp, 0.56_wp,  0.50_wp,  0.56_wp, 0.54_wp, 0.58_wp, 0.50_wp, &
-              0.54_wp, 0.56_wp, 0.50_wp, 0.54_wp, 0.54_wp /)
-    REAL(wp), PARAMETER ::A_lu(nlu_dep) = &
-         (/ 3.0_wp,  3.0_wp,   2.0_wp,  2.0_wp,  7.0_wp, -99.0_wp, 10.0_wp, 3.0_wp, -99.0_wp, -99.0_wp,  &
-              3.0_wp, 7.0_wp, -99.0_wp, 2.0_wp, -99.0_wp /)
-!
-!--   grass  arabl crops conif decid  water  urba  othr  desr  ice   sav  trf   wai  med   sem
-!
-!-- local
-    REAL(wp) ::  diff_part
-    REAL(wp) ::  ebrown
-    REAL(wp) ::  eimpac
-    REAL(wp) ::  einterc
-    REAL(wp) ::  kinvisc
-    REAL(wp) ::  reffic
-    REAL(wp) ::  schmidt
-    REAL(wp) ::  stokes
-!
-!-- Kinetic viscosity & diffusivity
-    kinvisc = viscos1 / dens1    !< only needed at surface
-
-    diff_part = kb * tsurf * slipcor / ( 3.0_wp * pi * viscos1 * partsize )
-!
-!-- Schmidt number
-    schmidt = kinvisc / diff_part
-!
-!-- Calculate collection efficiencie E
-    Ebrown = Schmidt**( -gamma_lu(luc) )    !< Brownian diffusion
-!
-!-- Determine Stokes number, interception efficiency and sticking efficiency R (1 = no rebound)
-    IF ( luc == ilu_ice  .OR.  nwet == 9  .OR.  luc == ilu_water_sea  .OR.                         &
-         luc == ilu_water_inland )  THEN
-       stokes = vs1 * ustar**2 / ( grav * kinvisc )
-       einterc = 0.0_wp
-       reffic = 1.0_wp
-    ELSE IF ( luc == ilu_other  .OR.  luc == ilu_desert )  THEN     !<tundra of desert
-       stokes = vs1 * ustar**2 / ( grav * kinvisc )
-       einterc = 0.0_wp
-       reffic = EXP( - stokes**0.5_wp )
-    ELSE
-       stokes = vs1 * ustar / ( grav * a_lu(luc) * 1.0E-3_wp )
-       einterc = 0.5_wp * ( partsize / ( a_lu(luc) * 1.0E-3_wp ) )**2
-       reffic = EXP( - stokes**0.5_wp )
-    END IF
-!
-!-- When surface is wet all particles do not rebound:
-    IF ( nwet == 1 )  reffic = 1.0_wp
-!
-!-- Determine impaction efficiency:
-    eimpac = ( stokes / ( alfa_lu(luc) + stokes ) )**2
-!
-!-- Sedimentation resistance:
-    rs = 1.0_wp / ( epsilon0 * MAX( 1.0E-5_wp, ustar ) * ( ebrown + eimpac + einterc ) * reffic )
-
-!-- Deposition velocity according to Seinfeld and Pandis (2006; eq 19.7):
-!--
-!--              1
-!--      vd = ------------------ + vs
-!--           Ra + Rs + Ra*Rs*vs
-!--
-!-- where: Rs = Rb (in Seinfeld and Pandis, 2006)
-
-    vd = 1.0_wp / ( ftop_lu + rs + ftop_lu * rs * vs1) + vs1
-
-
- END SUBROUTINE drydepo_aero_zhang_vd
-
-
- !-------------------------------------------------------------------------------------------------!
- !> Compute quasi-laminar boundary layer resistance as a function of landuse and tracer
- !> Original EMEP formulation by (Simpson et al, 2003) is used.
- !-------------------------------------------------------------------------------------------------!
- SUBROUTINE get_rb_cell( is_water, z0h, ustar, diffusivity, rb )
-
-!
-!-- in/out
-    LOGICAL , INTENT(IN) ::  is_water
-
-    REAL(wp), INTENT(IN) ::  diffusivity          !< coefficient of diffusivity
-    REAL(wp), INTENT(IN) ::  ustar                !< friction velocity
-    REAL(wp), INTENT(IN) ::  z0h                  !< roughness length for heat
-
-    REAL(wp), INTENT(OUT) ::  rb                  !< boundary layer resistance
-!
-!-- const
-    REAL(wp), PARAMETER ::  kappa_stab = 0.35     !< von Karman constant
-    REAL(wp), PARAMETER ::  thk = 0.19e-4         !< thermal diffusivity of dry air 20 C
-!
-!-- Next line is to avoid compiler warning about unused variable
-    IF ( is_water  .OR.  ( z0h + kappa_stab ) > 0.0_wp )  CONTINUE
-!
-!-- Use Simpson et al. (2003)
-!-- @TODO: Check rb over water calculation, until then leave commented lines
-!--  IF ( is_water )  THEN
-!--   org: rb = 1.0_wp / ( kappa_stab * MAX( 0.01_wp, ustar ) ) * LOG( z0h / diffusivity * kappa_stab * MAX( 0.01_wp, ustar ) )
-!--        rb = 1.0_wp / ( kappa_stab * MAX( 0.1_wp, ustar ) ) *  LOG( z0h / diffusivity * kappa_stab * MAX( 0.1_wp, ustar ) )
-!--  ELSE
-    rb = 5.0_wp / MAX( 0.01_wp, ustar ) * ( thk / diffusivity )**0.67_wp
-!--  END IF
-
- END SUBROUTINE get_rb_cell
-
-
-!--------------------------------------------------------------------------------------------------!
-!>  Compute water vapor partial pressure (e_w) given specific humidity Q [(kg water)/(kg air)].
-!>
-!>  Use that gas law for volume V with temperature T holds for the total mixture as well as the
-!>  water part:
-!>
-!>    R T / V = p_air / n_air = p_water / n_water
-!>
-!>  thus:
-!>
-!>    p_water = p_air n_water / n_air
-!>
-!>  Use:
-!>    n_air =   m_air   /        xm_air
-!>            [kg air]  /  [(kg air)/(mole air)]
-!>  and:
-!>    n_water =  m_air * Q  /     xm_water
-!>              [kg water]  /  [(kg water)/(mole water)]
-!>  thus:
-!>    p_water = p_air Q / (xm_water/xm_air)
-!--------------------------------------------------------------------------------------------------!
-
- ELEMENTAL FUNCTION watervaporpartialpressure( q, p ) RESULT( p_w )
-
-!
-!-- in/out
-    REAL(wp), INTENT(IN) ::  p                      !< air pressure [Pa]
-    REAL(wp), INTENT(IN) ::  q                      !< specific humidity [(kg water)/(kg air)]
-
-    REAL(wp) ::  p_w                                !< water vapor partial pressure [Pa]
-!
-!-- Const
-    REAL(wp), PARAMETER  ::  eps = xm_h2o / xm_air  !< mole mass ratio ~ 0.622
-!
-!-- Partial pressure of water vapor:
-    p_w = p * q / eps
-
- END FUNCTION watervaporpartialpressure
-
-
-!--------------------------------------------------------------------------------------------------!
-!>  Saturation vapor pressure.
-!>  From (Stull 1988, eq. 7.5.2d):
-!>
-!>      e_sat = p0 exp( 17.67 * (T-273.16) / (T-29.66) )     [Pa]
-!>
-!>  where:
-!>      p0 = 611.2 [Pa]   : reference pressure
-!>
-!>  Arguments:
-!>      T  [K]  : air temperature
-!>  Result:
-!>      e_sat_w  [Pa]  : saturation vapor pressure
-!>
-!>  References:
-!>      Roland B. Stull, 1988
-!>      An introduction to boundary layer meteorology.
-!--------------------------------------------------------------------------------------------------!
- ELEMENTAL FUNCTION saturationvaporpressure( t ) RESULT( e_sat_w )
-
-!
-!-- in/out
-    REAL(wp), INTENT(IN) ::  t            !< temperature [K]
-
-    REAL(wp) ::  e_sat_w                  !< saturation vapor pressure  [Pa]
-!
-!-- Const
-    REAL(wp), PARAMETER ::  p0 = 611.2   !< base pressure [Pa]
-!
-!-- Saturation vapor pressure:
-    e_sat_w = p0 * EXP( 17.67_wp * ( t - 273.16_wp ) / ( t - 29.66_wp ) )    !< [Pa]
-
- END FUNCTION saturationvaporpressure
-
-
-!--------------------------------------------------------------------------------------------------!
-!>  Relative humidity RH [%] is by definition:
-!>
-!>           e_w             water vapor partial pressure
-!>    Rh = -------- * 100
-!>         e_sat_w           saturation vapor pressure
-!--------------------------------------------------------------------------------------------------!
-
- ELEMENTAL FUNCTION relativehumidity_from_specifichumidity( q, t, p ) RESULT( rh )
-
-!
-!-- in/out
-    REAL(wp), INTENT(IN) ::  p    !< air pressure [Pa]
-    REAL(wp), INTENT(IN) ::  q    !< specific humidity [(kg water)/(kg air)]
-    REAL(wp), INTENT(IN) ::  t    !< temperature [K]
-
-    REAL(wp) ::  rh               !< relative humidity [%]
-!
-!-- Relative humidity:
-    rh = watervaporpartialpressure( q, p ) / saturationvaporpressure( t ) * 100.0_wp
-
- END FUNCTION relativehumidity_from_specifichumidity
-
-
- END MODULE chemistry_model_mod
Index: palm/trunk/SOURCE/close_file.f90
===================================================================
--- palm/trunk/SOURCE/close_file.f90	(revision 4901)
+++ palm/trunk/SOURCE/close_file.f90	(revision 1)
@@ -1,38 +1,56 @@
-!> @file close_file.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE close_file( file_id )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to
-! avoid runtime error (Loop variable has been modified) in time_integration
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! unused variables and format statements removed
+! $Log: close_file.f90,v $
+! Revision 1.10  2006/08/22 13:50:01  raasch
+! xz and yz cross sections now up to nzt+1
+!
+! Revision 1.9  2006/08/04 14:22:53  raasch
+! Closing unit 109 (particle timeseries)
+!
+! Revision 1.8  2006/02/23 10:08:23  raasch
+! Extensions for 2d/3d data averaging
+! pl2d_.._anz, pl3d_anz renamed do2d_.._n, do3d_avs_n, respectively
+! error number argument for handle_netcdf_error
+!
+! Revision 1.7  2005/05/18 15:13:12  raasch
+! Extensions for NetCDF output
+!
+! Revision 1.6  2005/03/26 19:54:23  raasch
+! +datform in global-namelist (iso2d)
+!
+! Revision 1.5  2003/03/04 11:24:46  raasch
+! AVS data format changed from float to xdr_float (needed on linux machines
+! due to the little/big endian problem)
+!
+! Revision 1.4  2002/12/19 14:06:34  raasch
+! ISO2D parameter dp set to true for ibm hosts
+!
+! Revision 1.3  2001/03/30 06:58:36  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.2  2001/01/22 05:39:06  raasch
+! Module test_variables removed
+!
+! Revision 1.1  2001/01/02 17:23:41  raasch
+! Initial revision
+!
+! Last revision before renaming subroutine  2001/01/01  raasch
+! Subroutine name changed from close_files to close_file. Closing of a single
+! file is allowed by passing its file-id as an argument. Variable openfile now
+! is of type file_status and contains a flag which indicates if a file has
+! been opened before. Old revision remarks deleted.
+!
+! Revision 1.13 (close_files) 2000/12/20 09:10:24  letzel
+! All comments translated into English.
+!
+! Revision 1.12 (close_files) 1999/03/02 09:22:46  raasch
+! FLD-Header fuer komprimierte 3D-Daten
 !
 ! Revision 1.1 (close_files) 1997/08/11 06:11:18  raasch
@@ -42,47 +60,47 @@
 ! Description:
 ! ------------
-!> Close specified file or all open files, if "0" has been given as the calling argument. In that
-!> case, execute last actions for certain unit numbers, if required.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE close_file( file_id )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  max_masks, openfile
-
-    USE kinds
-
-#if defined( __netcdf )
-    USE NETCDF
-#endif
-
-    USE netcdf_interface,                                                      &
-        ONLY:  id_set_mask, id_set_pr, id_set_pts, id_set_sp,  id_set_ts, id_set_xy, id_set_xz,    &
-               id_set_yz, id_set_3d, id_set_fl, nc_stat, netcdf_data_format, netcdf_handle_error
-
+! Close specified file or all open files, if "0" has been given as the
+! calling argument. In that case, execute last actions for certain unit 
+! numbers, if required.
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE netcdf_control
     USE pegrid
+    USE profil_parameter
+    USE statistics
 
     IMPLICIT NONE
 
-    CHARACTER (LEN=10)  ::  datform = 'lit_endian' !<
-    CHARACTER (LEN=80)  ::  title                  !<
-
-    INTEGER(iwp) ::  av           !<
-    INTEGER(iwp) ::  dimx         !<
-    INTEGER(iwp) ::  dimy         !<
-    INTEGER(iwp) ::  fid          !<
-    INTEGER(iwp) ::  file_id      !<
-    INTEGER(iwp) ::  mid          !< masked output running index
-    INTEGER(iwp) ::  planz        !<
-
-    LOGICAL ::  checkuf = .TRUE.  !<
-    LOGICAL ::  datleg = .TRUE.   !<
-    LOGICAL ::  dbp = .FALSE.     !<
-
-    NAMELIST /GLOBAL/  checkuf, datform, dbp, dimx, dimy, planz, title
-    NAMELIST /RAHMEN/  datleg
-
-!
-!-- Close specified unit number (if opened) and set a flag that it has been opened one time at least
+    CHARACTER (LEN=2)   ::  suffix
+    CHARACTER (LEN=10)  ::  datform = 'lit_endian'
+    CHARACTER (LEN=80)  ::  rtext, title, utext = '', xtext = '', ytext = ''
+
+    INTEGER ::  anzzeile, cranz, cross_count, cross_numbers, dimx, dimy, &
+                fid, file_id, j, k, legpos = 1, planz, timodex = 1
+    INTEGER, DIMENSION(100) ::  klist, lstyle, cucol
+
+    LOGICAL ::  checkuf = .TRUE., datleg = .TRUE., dp = .FALSE., &
+                grid = .TRUE., rand = .TRUE., swap, twoxa = .TRUE., &
+                twoya = .TRUE.
+
+    REAL    ::  ansx = -999.999, ansy = -999.999, gwid = 0.1, rlegfak, &
+                sizex, sizey, texfac, utmove = 50.0, uxmax, uxmin, uymax, &
+                uymin, yright
+    REAL, DIMENSION(100) ::  lwid, normx, normy
+
+    NAMELIST /CROSS/   ansx, ansy, cucol, grid, gwid, klist, legpos, lstyle, &
+                       lwid, normx, normy, rand, rlegfak, sizex, sizey, &
+                       texfac, timodex, twoxa, twoya, utext, utmove, uxmax, &
+                       uxmin, uymax, uymin, xtext, ytext
+    NAMELIST /GLOBAL/  checkuf, datform, dimx, dimy, dp, planz, sizex, sizey, &
+                       title, yright
+    NAMELIST /RAHMEN/  anzzeile, cranz, datleg, rtext, swap
+
+!
+!-- Close specified unit number (if opened) and set a flag that it has
+!-- been opened one time at least
     IF ( file_id /= 0 )  THEN
        IF ( openfile(file_id)%opened )  THEN
@@ -96,5 +114,5 @@
 !
 !-- Close all open unit numbers
-    DO  fid = 1, 200+2*max_masks
+    DO  fid = 1, 116
 
        IF ( openfile(fid)%opened .OR. openfile(fid)%opened_before )  THEN
@@ -103,116 +121,396 @@
           SELECT CASE ( fid )
 
+             CASE ( 21 )
+!
+!--             Write ISO2D global parameters
+                IF ( myid == 0  .AND.  iso2d_output )  THEN
+                   planz  = do2d_xy_n
+                   dimx   = nx + 2
+                   dimy   = ny + 2
+                   sizex  = 100.0
+                   sizey  = 100.0
+                   title  = run_description_header
+                   yright = ( ny + 1.0 ) * dy
+                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
+                      checkuf = .FALSE.; dp = .TRUE.
+                   ENDIF
+                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
+                      datform = 'big_endian'
+                   ENDIF
+                   OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED', &
+                              DELIM='APOSTROPHE' )
+                   WRITE ( 90, GLOBAL )
+                   CLOSE ( 90 )
+                ENDIF
+
+             CASE ( 22 )
+!
+!--             Write ISO2D global parameters
+                IF ( myid == 0 )  THEN
+                   planz  = do2d_xz_n
+                   dimx   = nx + 2
+                   dimy   = nz + 2
+                   sizex  = 100.0
+                   sizey  =  65.0
+                   title  = run_description_header
+                   yright = z_max_do2d
+                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
+                      checkuf = .FALSE.; dp = .TRUE.
+                   ENDIF
+                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
+                      datform = 'big_endian'
+                   ENDIF
+                   OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED', &
+                              DELIM='APOSTROPHE' )
+                   WRITE ( 90, GLOBAL )
+                   CLOSE ( 90 )
+                ENDIF
+
+             CASE ( 23 )
+!
+!--             Write ISO2D global parameters
+                IF ( myid == 0 )  THEN
+                   planz  = do2d_yz_n
+                   dimx   = ny + 2
+                   dimy   = nz + 2
+                   sizex  = 100.0
+                   sizey  =  65.0
+                   title  = run_description_header
+                   yright = z_max_do2d
+                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
+                      checkuf = .FALSE.; dp = .TRUE.
+                   ENDIF
+                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
+                      datform = 'big_endian'
+                   ENDIF
+                   OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED', &
+                              DELIM='APOSTROPHE' )
+                   WRITE ( 90, GLOBAL )
+                   CLOSE ( 90 )
+                ENDIF
+
+             CASE ( 32 )
+!
+!--             Write header for FLD-file
+                IF ( do3d_compress )  THEN
+                   WRITE ( 32, 3200)  ' compressed ',                       &
+                                      TRIM( run_description_header ), nx+2, &
+                                      ny+2, nz_do3d+1, do3d_avs_n
+                ELSE
+                   WRITE ( 32, 3200)  ' ', TRIM( run_description_header ), &
+                                      nx+2, ny+2, nz_do3d+1, do3d_avs_n
+                ENDIF
+
+             CASE ( 40:49 )
+!
+!--             Write PROFIL namelist parameters for 1D profiles.
+!--             First determine, how many crosses are to be drawn.
+                IF ( myid == 0 )  THEN
+                   cross_numbers = 0
+                   DO  j = 1, crmax
+                      IF ( cross_profile_number_count(j) /= 0 )  THEN
+                         cross_numbers = cross_numbers + 1
+                      ENDIF
+                   ENDDO
+
+                   IF ( cross_numbers /= 0 )  THEN
+!
+!--                   Determine remaining RAHMEN parameters
+                      swap = .FALSE.
+                      rtext = '\0.5 ' // TRIM( run_description_header ) // &
+                              '    ' // TRIM( region( fid - 40 ) )
+!
+!--                   Write RAHMEN parameters
+                      IF ( statistic_regions == 0  .AND.  fid == 40 )  THEN
+                         suffix = ''
+                      ELSE
+                         WRITE ( suffix, '(''_'',I1)' )  fid - 40
+                      ENDIF
+                      OPEN ( 90, FILE='PLOT1D_PAR' // TRIM( suffix ), &
+                                 FORM='FORMATTED', DELIM='APOSTROPHE' )
+!
+!--                   Subtitle for crosses with time averaging
+                      IF ( averaging_interval_pr /= 0.0 )  THEN
+                         WRITE ( utext, 4000 )  averaging_interval_pr
+                      ENDIF
+!
+!--                   Determine and write CROSS parameters for each individual 
+!--                   cross
+                      cross_count = 0
+                      DO  j = 1, crmax
+                         k = cross_profile_number_count(j)
+                         IF ( k /= 0 )  THEN
+                            cross_count = cross_count + 1
+!
+!--                         Write RAHMEN parameters
+                            IF ( MOD( cross_count-1, &
+                                      profile_rows*profile_columns ) == 0 ) &
+                            THEN
+!
+!--                            Determine number of crosses still to be drawn
+                               cranz = MIN( cross_numbers - cross_count + 1, &
+                                            profile_rows * profile_columns )
+!
+!--                            If the first line cannot be filled with crosses
+!--                            completely, the default number of crosses per 
+!--                            line has to be reduced.
+                               IF ( cranz < profile_columns )  THEN
+                                  anzzeile = cranz
+                               ELSE
+                                  anzzeile = profile_columns
+                               ENDIF
+
+                               WRITE ( 90, RAHMEN )
+
+                            ENDIF
+!
+!--                         Store graph numbers
+                            klist(1:k) = cross_profile_numbers(1:k,j)
+                            klist(k+1:100) = 999999
+!
+!--                         Store graph attributes
+                            cucol  = cross_linecolors(:,j)
+                            lstyle = cross_linestyles(:,j)
+                            lwid = 0.6
+!
+!--                         Sizes, text etc.
+                            sizex = 100.0; sizey = 120.0
+                            rlegfak = 0.7; texfac = 1.0
+!
+!--                         Determine range of x-axis values
+                            IF ( cross_normalized_x(j) == ' ' )  THEN
+!
+!--                            Non-normalized profiles
+                               IF ( cross_uxmin(j) == 0.0  .AND. &
+                                    cross_uxmax(j) == 0.0 )  THEN
+                                  uxmin = cross_uxmin_computed(j)
+                                  uxmax = cross_uxmax_computed(j)
+                                  IF ( uxmin == uxmax )  uxmax = uxmin + 1.0
+                               ELSE
+!
+!--                               Values set in check_parameters are used here
+                                  uxmin = cross_uxmin(j); uxmax = cross_uxmax(j)
+                               ENDIF
+                            ELSE
+!
+!--                            Normalized profiles
+                               IF ( cross_uxmin_normalized(j) == 0.0  .AND. &
+                                    cross_uxmax_normalized(j) == 0.0 )  THEN
+                                  uxmin = cross_uxmin_normalized_computed(j)
+                                  uxmax = cross_uxmax_normalized_computed(j)
+                                  IF ( uxmin == uxmax )  uxmax = uxmin + 1.0
+                               ELSE
+!
+!--                               Values set in check_parameters are used here
+                                  uxmin = cross_uxmin_normalized(j)
+                                  uxmax = cross_uxmax_normalized(j)
+                               ENDIF
+                            ENDIF
+!
+!--                         Range of y-axis values
+!--                         may be re-adjusted during normalization if required
+                            uymin = cross_uymin(j); uymax = cross_uymax(j)
+                            ytext = 'height in m'
+!
+!--                         Normalization of the axes
+                            normx = cross_normx_factor(:,j)
+                            normy = cross_normy_factor(:,j)
+!
+!--                         Labelling of the axes
+                            IF ( cross_normalized_x(j) == ' ' )  THEN
+                               xtext = cross_xtext(j)
+                            ELSE
+                               xtext = TRIM( cross_xtext(j) ) // ' / ' // &
+                                       cross_normalized_x(j)
+                            ENDIF
+                            IF ( cross_normalized_y(j) == ' ' )  THEN
+                               ytext = 'height in m'
+                            ELSE
+                               ytext = 'height in m' // ' / ' // &
+                                       cross_normalized_y(j)
+!
+!--                            Determine upper limit of value range
+                               IF ( z_max_do1d_normalized /= -1.0 )  THEN
+                                  uymax = z_max_do1d_normalized
+                               ENDIF
+                            ENDIF
+
+                            WRITE ( 90, CROSS )
+
+                         ENDIF
+                      ENDDO
+
+                      CLOSE ( 90 )
+                   ENDIF
+                ENDIF
+
+             CASE ( 50:59 )
+!
+!--             Write PROFIL namelist parameters for time series
+!--             first determine number of crosses to be drawn
+                IF ( myid == 0 )  THEN
+                   cranz = 0
+                   DO  j = 1, 12
+                      IF ( cross_ts_number_count(j) /= 0 )  cranz = cranz+1
+                   ENDDO
+
+                   IF ( cranz /= 0 )  THEN
+!
+!--                   Determine RAHMEN parameters
+                      anzzeile = 1
+                      swap = .TRUE.
+                      rtext = '\1.0 ' // TRIM( run_description_header ) // &
+                              '    ' // TRIM( region( fid - 50 ) )
+!
+!--                   Write RAHMEN parameters
+                      IF ( statistic_regions == 0  .AND.  fid == 50 )  THEN
+                         suffix = ''
+                      ELSE
+                         WRITE ( suffix, '(''_'',I1)' )  fid - 50
+                      ENDIF
+                      OPEN ( 90, FILE='PLOTTS_PAR' // TRIM( suffix ), &
+                                 FORM='FORMATTED', DELIM='APOSTROPHE' )
+                      WRITE ( 90, RAHMEN )
+!
+!--                   Determine and write CROSS parameters for each individual 
+!--                   cross
+                      DO  j = 1, 12
+                         k = cross_ts_number_count(j)
+                         IF ( k /= 0 )  THEN
+!
+!--                         Store graph numbers
+                            klist(1:k) = cross_ts_numbers(1:k,j)
+                            klist(k+1:100) = 999999
+!
+!--                         Store graph attributes
+                            cucol(1:k)  = linecolors(1:k)
+                            lstyle(1:k) = linestyles(1:k)
+                            lwid = 0.4
+!
+!--                         Sizes, text etc.
+                            sizex = 250.0; sizey = 40.0
+                            rlegfak = 1.5; texfac = 1.5
+                            xtext = 'time in s'
+                            ytext = ''
+                            utext = ''
+!
+!--                         Determine range of y-axis values
+                            IF ( cross_ts_uymin(j) == 999.999 )  THEN
+                               uymin = cross_ts_uymin_computed(j)
+                            ELSE
+                               uymin = cross_ts_uymin(j)
+                            ENDIF
+                            IF ( cross_ts_uymax(j) == 999.999 )  THEN
+                               uymax = cross_ts_uymax_computed(j)
+                            ELSE
+                               uymax = cross_ts_uymax(j)
+                            ENDIF
+                            IF ( uymin == uymax )  uymax = uymin + 1.0
+!
+!--                         Range of x-axis values
+                            uxmin = 0.0; uxmax = simulated_time
+!
+!--                         Normalizations
+                            normx = 1.0; normy = 1.0
+
+                            WRITE ( 90, CROSS )
+
+                         ENDIF
+                      ENDDO
+
+                      CLOSE ( 90 )
+                   ENDIF
+                ENDIF
+
 #if defined( __netcdf )
              CASE ( 101 )
 
-                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_xy(0) )
-                   CALL netcdf_handle_error( 'close_file', 44 )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 44 )
                 ENDIF
 
              CASE ( 102 )
 
-                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_xz(0) )
-                   CALL netcdf_handle_error( 'close_file', 45 )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 45 )
                 ENDIF
 
              CASE ( 103 )
 
-                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_yz(0) )
-                   CALL netcdf_handle_error( 'close_file', 46 )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 46 )
                 ENDIF
 
              CASE ( 104 )
 
-                IF ( myid == 0 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_pr )
-                   CALL netcdf_handle_error( 'close_file', 47 )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 47 )
                 ENDIF
 
              CASE ( 105 )
 
-                IF ( myid == 0 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_ts )
-                   CALL netcdf_handle_error( 'close_file', 48 )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 48 )
                 ENDIF
 
              CASE ( 106 )
 
-                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_3d(0) )
-                   CALL netcdf_handle_error( 'close_file', 49 )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 49 )
                 ENDIF
 
              CASE ( 107 )
 
-                IF ( myid == 0 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_sp )
-                   CALL netcdf_handle_error( 'close_file', 50 )
-                ENDIF
-
-!
-!--           Currently disabled
-!             CASE ( 108 )
-
-!                nc_stat = NF90_CLOSE( id_set_prt )
-!                CALL netcdf_handle_error( 'close_file', 51 )
-
-             CASE ( 109 )
-
-                nc_stat = NF90_CLOSE( id_set_pts )
-                CALL netcdf_handle_error( 'close_file', 412 )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 50 )
+                ENDIF
+
+             CASE ( 108 )
+
+                IF (  netcdf_output )  THEN
+                   nc_stat = NF90_CLOSE( id_set_prt )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 51 )
+                ENDIF
+
+             CASE ( 109 ) 
+
+                IF (  netcdf_output )  THEN
+                   nc_stat = NF90_CLOSE( id_set_pts )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 412 )
+                ENDIF
 
              CASE ( 111 )
 
-                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_xy(1) )
-                   CALL netcdf_handle_error( 'close_file', 52 )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 52 )
                 ENDIF
 
              CASE ( 112 )
 
-                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_xz(1) )
-                   CALL netcdf_handle_error( 'close_file', 352 )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 352 )
                 ENDIF
 
              CASE ( 113 )
 
-                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_yz(1) )
-                   CALL netcdf_handle_error( 'close_file', 353 )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 353 )
                 ENDIF
 
              CASE ( 116 )
 
-                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
+                IF ( myid == 0  .AND.  netcdf_output )  THEN
                    nc_stat = NF90_CLOSE( id_set_3d(1) )
-                   CALL netcdf_handle_error( 'close_file', 353 )
-                ENDIF
-
-             CASE ( 199 )
-
-                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
-                   nc_stat = NF90_CLOSE( id_set_fl )
-                   CALL netcdf_handle_error( 'close_file', 353 )
-                ENDIF
-
-             CASE ( 201:200+2*max_masks )
-
-                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
-!
-!--                Decompose fid into mid and av
-                   IF ( fid <= 200+max_masks )  THEN
-                      mid = fid - 200
-                      av = 0
-                   ELSE
-                      mid = fid - (200+max_masks)
-                      av = 1
-                   ENDIF
-                   nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
-                   CALL netcdf_handle_error( 'close_file', 459 )
-
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 353 )
                 ENDIF
 
@@ -228,3 +526,19 @@
     ENDDO
 
+!
+!-- Formats
+3200 FORMAT ('# AVS',A,'field file'/ &
+             '#'/                &
+             '# ',A/             &
+             'ndim=3'/           &
+             'dim1=',I5/         &
+             'dim2=',I5/         &
+             'dim3=',I5/         &
+             'nspace=3'/         &
+             'veclen=',I5/       &
+             'data=xdr_float'/   &
+             'field=rectilinear')
+4000 FORMAT ('time averaged over',F7.1,' s')
+
+
  END SUBROUTINE close_file
Index: palm/trunk/SOURCE/compute_vpt.f90
===================================================================
--- palm/trunk/SOURCE/compute_vpt.f90	(revision 4901)
+++ palm/trunk/SOURCE/compute_vpt.f90	(revision 1)
@@ -1,43 +1,21 @@
-!> @file compute_vpt.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE compute_vpt
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Implement snow and graupel (bulk microphysics)
-! 
-! 4559 2020-06-11 08:51:48Z raasch
-! file re-formatted to follow the PALM coding standard
-! 
-! 4521 2020-05-06 11:39:49Z schwenkel
-! Rename variable
-! 
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-! 
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-! 
-! 3655 2019-01-07 16:51:22Z knoop
-! Modularization of all bulk cloud physics code components
+! $Log: compute_vpt.f90,v $
+! Revision 1.5  2001/03/30 06:58:52  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.4  2001/01/22 05:42:55  raasch
+! Minor corrections within file header
+!
+! Revision 1.2  2000/09/07 09:00:36  schroeter
+! Now, vpt will be computed for k=nzb and nzt+1
+! additionally to keep boundary values
 !
 ! Revision 1.1  2000/04/13 14:40:53  schroeter
@@ -47,45 +25,23 @@
 ! Description:
 ! -------------
-!> Computation of the virtual potential temperature 
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE compute_vpt
- 
+! Computation of the virtual potential temperature 
+!-------------------------------------------------------------------------------!
 
-    USE arrays_3d,                                                                                 &
-        ONLY:  d_exner, pt, q, qf, ql, vpt
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  ls_d_cp, lv_d_cp
-
-    USE control_parameters,                                                                        &
-        ONLY:  cloud_droplets
-
-    USE indices,                                                                                   &
-        ONLY:  nzb, nzt
-
-    USE kinds
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model, microphysics_ice_phase
+    USE arrays_3d
+    USE indices
+    USE cloud_parameters
+    USE control_parameters
 
     IMPLICIT NONE
 
-    INTEGER(iwp) :: k   !< 
+    INTEGER :: k
 
-    IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets )  THEN
-       vpt = pt * ( 1.0_wp + 0.61_wp * q )
-    ELSEIF ( bulk_cloud_model  .AND.  .NOT. microphysics_ice_phase )  THEN
+    IF ( .NOT. cloud_physics ) THEN
+       vpt = pt * ( 1.0 + 0.61 * q )
+    ELSE
        DO  k = nzb, nzt+1
-              vpt(k,:,:) = ( pt(k,:,:) + d_exner(k) * lv_d_cp * ql(k,:,:) ) *                      &
-                           ( 1.0_wp + 0.61_wp * q(k,:,:) - 1.61_wp *  ql(k,:,:)  )
+          vpt(k,:,:) = ( pt(k,:,:) + pt_d_t(k) * l_d_cp * ql(k,:,:) ) * &
+                       ( 1.0 + 0.61 * q(k,:,:) - 1.61 * ql(k,:,:) ) 
        ENDDO
-    ELSEIF ( bulk_cloud_model  .AND.  microphysics_ice_phase )  THEN
-       DO  k = nzb, nzt+1
-          vpt(k,:,:) = ( pt(k,:,:) + d_exner(k) * lv_d_cp * ql(k,:,:)   +                          &
-                                     d_exner(k) * ls_d_cp * qf(k,:,:) ) *                          &
-                       ( 1.0_wp + 0.61_wp * q(k,:,:) - 1.61_wp * ( ql(k,:,:) + qf(k,:,:) ) )
-       ENDDO
-    ELSE
-       vpt = pt * ( 1.0_wp + 0.61_wp * q - ql ) 
     ENDIF
 
Index: palm/trunk/SOURCE/coriolis.f90
===================================================================
--- palm/trunk/SOURCE/coriolis.f90	(revision 4901)
+++ palm/trunk/SOURCE/coriolis.f90	(revision 1)
@@ -1,44 +1,48 @@
-!> @file coriolis.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE coriolis_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4196 2019-08-29 11:02:06Z gronemeier
-! Consider rotation of model domain
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! OpenACC port for SPEC
+! $Log: coriolis.f90,v $
+! Revision 1.12  2006/02/23 10:08:57  raasch
+! nzb_2d replaced by nzb_u/v/w_inner
+!
+! Revision 1.11  2005/06/29 10:30:17  steinfeld
+! A potential dependency of the geostrophic wind components ug and vg on height
+! is considered
+!
+! Revision 1.10  2005/03/26 20:02:04  raasch
+! Extension of horizontal loop upper bounds for non-cyclic boundary conditions
+!
+! Revision 1.9  2004/01/30 10:17:34  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.8  2003/03/12 16:23:47  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.7  2002/12/19 14:08:14  raasch
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.6  2002/06/11 12:51:09  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.5  2001/03/30 06:59:09  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.4  2001/01/22 05:44:16  raasch
+! Module test_variables removed
+!
+! Revision 1.3  2000/12/20 09:50:27  letzel
+! All comments translated into English.
+!
+! Revision 1.2  1998/07/06 12:09:54  raasch
+! + USE test_variables
 !
 ! Revision 1.1  1997/08/29 08:57:38  raasch
@@ -48,12 +52,6 @@
 ! Description:
 ! ------------
-!> Computation of all Coriolis terms in the equations of motion.
-!>
-!> @note In this routine the topography is masked, even though this is again done in
-!> prognostic_equations. However, omitting the masking here lead to slightly different results.
-!> Reason unknown.
-!--------------------------------------------------------------------------------------------------!
- MODULE coriolis_mod
-
+! Computation of all Coriolis terms in the equations of motion.
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -68,40 +66,18 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
     SUBROUTINE coriolis( component )
 
-       USE arrays_3d,                                                                              &
-           ONLY:  tend, u, ug, v, vg, w
-
-       USE basic_constants_and_equations_mod,                                                      &
-           ONLY:  pi
-
-       USE control_parameters,                                                                     &
-           ONLY:  f, fs, message_string, rotation_angle
-
-       USE indices,                                                                                &
-           ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzt, wall_flags_total_0
-
-       USE kinds
+       USE arrays_3d
+       USE control_parameters
+       USE indices
+       USE pegrid
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  component      !< component of momentum equation
-       INTEGER(iwp) ::  i              !< running index x direction
-       INTEGER(iwp) ::  j              !< running index y direction
-       INTEGER(iwp) ::  k              !< running index z direction
-
-       REAL(wp)     ::  cos_rot_angle  !< cosine of model rotation angle
-       REAL(wp)     ::  flag           !< flag to mask topography
-       REAL(wp)     ::  sin_rot_angle  !< sine of model rotation angle
-
-!
-!--    Precalculate cosine and sine of rotation angle
-       cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-       sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
+       INTEGER ::  component, i, j, k
+
 
 !
@@ -112,22 +88,14 @@
 !--       u-component
           CASE ( 1 )
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
-             !$ACC PRESENT(wall_flags_total_0) &
-             !$ACC PRESENT(v, w, vg) &
-             !$ACC PRESENT(tend)
-             DO  i = nxlu, nxr
+             DO  i = nxl, nxr+uxrp
                 DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-!
-!--                   Predetermine flag to mask topography
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-
-                      tend(k,j,i) = tend(k,j,i) + flag *                                           &
-                            ( 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 * cos_rot_angle                                                   &
-                              * 0.25_wp * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) )    &
-                            )
+                   DO  k = nzb_u_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *            &
+                                   ( 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 *               &
+                                   ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
+                                     w(k,j,i)   ) &
+                                                          )
                    ENDDO
                 ENDDO
@@ -137,22 +105,10 @@
 !--       v-component
           CASE ( 2 )
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
-             !$ACC PRESENT(wall_flags_total_0) &
-             !$ACC PRESENT(u, w, ug) &
-             !$ACC PRESENT(tend)
              DO  i = nxl, nxr
-                DO  j = nysv, nyn
-                   DO  k = nzb+1, nzt
-!
-!--                   Predetermine flag to mask topography
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-
-                      tend(k,j,i) = tend(k,j,i) - flag *                                           &
-                            ( 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) )                                                          &
-                            + fs * sin_rot_angle                                                   &
-                              * 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )    &
-                            )
+                DO  j = nys, nyn+vynp
+                   DO  k = nzb_v_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *          &
+                                   ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
+                                     u(k,j,i+1) ) - ug(k) )
                    ENDDO
                 ENDDO
@@ -162,22 +118,10 @@
 !--       w-component
           CASE ( 3 )
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
-             !$ACC PRESENT(wall_flags_total_0) &
-             !$ACC PRESENT(u, v) &
-             !$ACC PRESENT(tend)
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-!
-!--                   Predetermine flag to mask topography
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-
-                      tend(k,j,i) = tend(k,j,i)                                                    &
-                                     + fs * 0.25_wp * flag                                         &
-                                       * ( cos_rot_angle                                           &
-                                           * ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + u(k+1,j,i+1) ) &
-                                         + sin_rot_angle                                           &
-                                           * ( v(k,j,i) + v(k+1,j,i) + v(k,j+1,i) + v(k+1,j+1,i) ) &
-                                         )
+                   DO  k = nzb_w_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) + fs * 0.25 *             &
+                                   ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
+                                     u(k+1,j,i+1) )
                    ENDDO
                 ENDDO
@@ -186,6 +130,7 @@
           CASE DEFAULT
 
-             WRITE( message_string, * ) ' wrong component: ', component
-             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
+             IF ( myid == 0 )  PRINT*,'+++ coriolis:  wrong component: ', &
+                                      component
+             CALL local_stop
 
        END SELECT
@@ -194,40 +139,17 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
     SUBROUTINE coriolis_ij( i, j, component )
 
-       USE arrays_3d,                                                                              &
-           ONLY:  tend, u, ug, v, vg, w
-
-       USE basic_constants_and_equations_mod,                                                      &
-           ONLY:  pi
-
-       USE control_parameters,                                                                     &
-           ONLY:  f, fs, message_string, rotation_angle
-
-       USE indices,                                                                                &
-           ONLY:  nzb, nzt, wall_flags_total_0
-
-       USE kinds
+       USE arrays_3d
+       USE control_parameters
+       USE indices
+       USE pegrid
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  component  !< component of momentum equation
-       INTEGER(iwp) ::  i          !< running index x direction
-       INTEGER(iwp) ::  j          !< running index y direction
-       INTEGER(iwp) ::  k          !< running index z direction
-
-       REAL(wp)     ::  cos_rot_angle  !< cosine of model rotation angle
-       REAL(wp)     ::  flag           !< flag to mask topography
-       REAL(wp)     ::  sin_rot_angle  !< sine of model rotation angle
-
-!
-!--    Precalculate cosine and sine of rotation angle
-       cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-       sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
+       INTEGER ::  component, i, j, k
 
 !
@@ -238,16 +160,12 @@
 !--       u-component
           CASE ( 1 )
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-
-                tend(k,j,i) = tend(k,j,i) + flag *                                                 &
-                            ( 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 * cos_rot_angle                                                   &
-                              * 0.25_wp * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) )    &
-                            )
+             DO  k = nzb_u_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *               &
+                                ( 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 *               &
+                                ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
+                                  w(k,j,i)   ) &
+                                                    )
              ENDDO
 
@@ -255,16 +173,8 @@
 !--       v-component
           CASE ( 2 )
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-
-                tend(k,j,i) = tend(k,j,i) - flag *                                                 &
-                              ( 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) )                                                        &
-                              + fs * sin_rot_angle                                                 &
-                                * 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )  &
-                              )
+             DO  k = nzb_v_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *             &
+                                ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
+                                  u(k,j,i+1) ) - ug(k) )
              ENDDO
 
@@ -272,22 +182,15 @@
 !--       w-component
           CASE ( 3 )
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-
-                tend(k,j,i) = tend(k,j,i)                                                          &
-                              + fs * 0.25_wp * flag                                                &
-                                * ( cos_rot_angle                                                  &
-                                    * ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + u(k+1,j,i+1) )        &
-                                  + sin_rot_angle                                                  &
-                                    * ( v(k,j,i) + v(k+1,j,i) + v(k,j+1,i) + v(k+1,j+1,i) )        &
-                                  )
+             DO  k = nzb_w_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) + fs * 0.25 * &
+                                ( 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 )
+             IF ( myid == 0 )  PRINT*,'+++ coriolis:  wrong component: ', &
+                                      component
+             CALL local_stop
 
        END SELECT
Index: palm/trunk/SOURCE/cpu_log.f90
===================================================================
--- palm/trunk/SOURCE/cpu_log.f90	(revision 1)
+++ palm/trunk/SOURCE/cpu_log.f90	(revision 1)
@@ -0,0 +1,168 @@
+ SUBROUTINE cpu_log( log_event, place, modus, barrierwait )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: cpu_log.f90,v $
+! Revision 1.24  2006/06/02 15:12:17  raasch
+! cpp-directives extended for lctit
+!
+! Revision 1.23  2004/01/28 15:08:52  raasch
+! Type log changed to logpoint due to name conflict with intrinsic log
+!
+! Revision 1.22  2003/05/09 14:15:18  raasch
+! Time measurement on linux machines included, measurements on IBM are now using
+! function irtc, which allows correct measurements for jobs running over
+! the 24:00 timeline
+!
+! Revision 1.21  2003/03/16 09:30:04  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.20  2003/03/12 16:24:18  raasch
+! Time measurement on NEC implemented
+!
+! Revision 1.19  2002/12/20 09:38:43  raasch
+! variable first is defined for all hosts
+!
+! Revision 1.18  2002/12/19 14:09:36  raasch
+! Output of warnings in case of negative cpu-times, STOP statement replaced by
+! call of subroutine local_stop
+!
+! Revision 1.17  2002/05/02 18:49:37  raasch
+! Time measurement on IBM implemented
+!
+! Revision 1.16  2001/03/30 07:00:43  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.14  2001/01/25 06:56:49  raasch
+! +cpp-directives for dec-alpha-workstations
+!
+! Revision 1.13  2001/01/22 08:32:46  raasch
+! Module test_variables removed
+!
+! Revision 1.11  2000/12/20 10:18:58  letzel
+! All comments translated into English.
+!
+! Revision 1.9  1999/11/25 16:19:07  raasch
+! TIMEF jetzt als Function-Aufruf
+!
+! Revision 1.8  1999/03/03 09:26:14  raasch
+! Zeitmessung auf T3E grundsaetzlich auf TIMEF umgestellt
+!
+! Revision 1.7  1998/12/15 07:32:39  raasch
+! Messung der wahren I/O-Zeiten auf T3E mit TIMEF moeglich
+!
+! Revision 1.4  1997/09/16 06:37:24  raasch
+! Zeitmessungen auf t3e umgestellt auf tsecnd (schneller als mpi_wtime)
+!
+! Revision 1.1  1997/07/24 11:12:29  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Cpu-time measurements for any program part whatever.
+!-------------------------------------------------------------------------------!
+
+    USE cpulog
+    USE pegrid
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*)           ::  modus, place
+    CHARACTER (LEN=*), OPTIONAL ::  barrierwait
+    LOGICAL, SAVE               ::  first = .TRUE.
+    REAL                        ::  mtime = 0.0, mtimevec = 0.0
+    TYPE(logpoint)              ::  log_event
+
+#if defined( __lcmuk ) || defined( __lctit ) || defined( __hpmuk ) || defined( __decalpha ) || defined( __nec )
+    INTEGER                     ::  count, count_rate
+#elif defined( __ibm )
+    INTEGER(8)                  ::  IRTC
+#elif defined( __t3eb )
+    REAL                        ::  TIMEF
+#endif
+
+
+!
+!-- Initialize and check, respectively, point of measurement
+    IF ( log_event%place == ' ' )  THEN
+       log_event%place = place
+    ELSEIF ( log_event%place /= place )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*,'+++ cpu_log: wrong argument'
+          PRINT*,'    expected: ',log_event%place,'  given: ', place
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+!
+!-- Take current time
+#if defined( __lcmuk ) || defined( __lctit ) || defined( __hpmuk ) || defined( __decalpha ) || defined( __nec )
+    CALL SYSTEM_CLOCK( count, count_rate )
+    mtime = REAL( count ) / REAL( count_rate )
+#elif defined( __ibm )
+    mtime = IRTC( ) * 1E-9
+!#elif defined( __vpp )
+!    CALL CLOCKV ( mtimevec, mtime, 0, 2 )
+#elif defined( __t3eb ) || defined( __t3eh ) || defined( __t3ej2 ) || defined( __t3ej5 )
+#if defined( __parallel )
+    IF ( .NOT. PRESENT( barrierwait ) )  THEN
+       CALL MPI_BARRIER( comm2d, ierr )
+       CONTINUE
+    ENDIF
+#endif
+    mtime = TIMEF( )
+    mtime = mtime * 0.001
+#else
+    IF ( myid == 0 )  THEN
+       PRINT*, '+++ cpu_log: no time measurement defined on this host'
+    ENDIF
+    CALL local_stop
+#endif
+
+!
+!-- Start, stop or pause measurement
+    IF ( modus == 'start'  .OR.  modus == 'continue' )  THEN
+       log_event%mtime    = mtime
+       log_event%mtimevec = mtimevec
+    ELSEIF ( modus == 'pause' )  THEN
+       IF ( ( mtime - log_event%mtime ) < 0.0  .AND.  first )  THEN
+          PRINT*,'+++ WARNING: cpu_log: negative time interval occured'
+          PRINT*,'+++ PE',myid,' L=PAUSE "',TRIM(log_event%place),'" new=', &
+                 mtime,' last=',log_event%mtime
+          first = .FALSE.
+       ENDIF
+       log_event%isum     = log_event%isum + mtime - log_event%mtime
+       log_event%ivect    = log_event%ivect  + mtimevec - log_event%mtimevec
+    ELSEIF ( modus == 'stop' )  THEN
+       IF ( ( mtime - log_event%mtime + log_event%isum ) < 0.0  .AND. &
+            first )  THEN
+          PRINT*,'+++ WARNING: cpu_log: negative time interval occured'
+          PRINT*,'+++ PE',myid,' L=STOP "',TRIM(log_event%place),'" new=', &
+                 mtime,' last=',log_event%mtime,' isum=',log_event%isum
+          first = .FALSE.
+       ENDIF
+       log_event%mtime    = mtime    - log_event%mtime    + log_event%isum
+       log_event%mtimevec = mtimevec - log_event%mtimevec + log_event%ivect
+       log_event%sum      = log_event%sum  + log_event%mtime
+       IF ( log_event%sum < 0.0  .AND.  first )  THEN
+          PRINT*,'+++ WARNING: cpu_log: negative time interval occured'
+          PRINT*,'+++ PE',myid,' L=STOP "',TRIM(log_event%place),'" sum=', &
+                 log_event%sum,' mtime=',log_event%mtime
+          first = .FALSE.
+       ENDIF
+       log_event%vector   = log_event%vector + log_event%mtimevec
+       log_event%counts   = log_event%counts + 1
+       log_event%isum     = 0.0
+       log_event%ivect    = 0.0
+    ELSE
+       PRINT*, '+++ unknown modus of time measurement: ', modus
+    ENDIF
+
+
+ END SUBROUTINE cpu_log
Index: palm/trunk/SOURCE/cpu_statistics.f90
===================================================================
--- palm/trunk/SOURCE/cpu_statistics.f90	(revision 1)
+++ palm/trunk/SOURCE/cpu_statistics.f90	(revision 1)
@@ -0,0 +1,286 @@
+ SUBROUTINE cpu_statistics
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: cpu_statistics.f90,v $
+! Revision 1.13  2006/04/26 12:10:51  raasch
+! Output of number of threads per task, max = min in case of 1 PE
+!
+! Revision 1.12  2003/03/16 09:30:22  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.11  2002/12/19 14:12:08  raasch
+! PE results are collected on PE0 in order to calculate mean cpu statistics.
+! Output format changed.
+!
+! Revision 1.10  2001/03/30 07:01:02  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.9  2001/01/22 05:49:49  raasch
+! Module test_variables removed
+!
+! Revision 1.8  2001/01/02 17:25:23  raasch
+! Unit 18 closed at the end of the subroutine
+!
+! Revision 1.7  2000/12/20 10:10:26  letzel
+! All comments translated into English.
+!
+! Revision 1.1  1997/07/24 11:11:11  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Analysis and output of the cpu-times measured. All PE results are collected
+! on PE0 in order to calculate the mean cpu-time over all PEs and other
+! statistics. The output is sorted according to the amount of cpu-time consumed
+! and output on PE0.
+!-------------------------------------------------------------------------------!
+
+    USE cpulog
+    USE pegrid
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    INTEGER    ::  i, ii(1), iii, lp, sender
+    REAL, SAVE ::  norm = 1.0
+    REAL, DIMENSION(:),   ALLOCATABLE ::  pe_max, pe_min, pe_rms, sum
+    REAL, DIMENSION(:,:), ALLOCATABLE ::  pe_log_points
+
+
+!#if defined( __hpmuk )  &&  ! defined( __chinook )
+!    norm = clock_ticks_per_second()
+!#endif
+
+!
+!-- Compute cpu-times in seconds
+    log_point%mtime  = log_point%mtime  / norm
+    log_point%sum    = log_point%sum    / norm
+    log_point%vector = log_point%vector / norm
+    WHERE ( log_point%counts /= 0 )
+       log_point%mean = log_point%sum / log_point%counts
+    END WHERE
+
+
+!
+!-- Collect cpu-times from all PEs and calculate statistics
+    IF ( myid == 0 )  THEN
+!
+!--    Allocate and initialize temporary arrays needed for statistics
+       ALLOCATE( pe_max( SIZE( log_point ) ), pe_min( SIZE( log_point ) ), &
+                 pe_rms( SIZE( log_point ) ),                              &
+                 pe_log_points( SIZE( log_point ), 0:numprocs-1 ) )
+       pe_min = log_point%sum
+       pe_max = log_point%sum    ! need to be set in case of 1 PE
+       pe_rms = 0.0
+
+#if defined( __parallel )
+!
+!--    Receive data from all PEs
+       DO  i = 1, numprocs-1
+          CALL MPI_RECV( pe_max(1), SIZE( log_point ), MPI_REAL, &
+                         MPI_ANY_SOURCE, MPI_ANY_TAG, comm2d, status, ierr )
+          sender = status(MPI_SOURCE)
+          pe_log_points(:,sender) = pe_max
+       ENDDO
+       pe_log_points(:,0) = log_point%sum   ! Results from PE0
+!
+!--    Calculate mean of all PEs, store it on log_point%sum
+!--    and find minimum and maximum
+       DO  iii = 1, SIZE( log_point )
+          DO  i = 1, numprocs-1
+             log_point(iii)%sum = log_point(iii)%sum + pe_log_points(iii,i)
+             pe_min(iii) = MIN( pe_min(iii), pe_log_points(iii,i) )
+             pe_max(iii) = MAX( pe_max(iii), pe_log_points(iii,i) )
+          ENDDO
+          log_point(iii)%sum = log_point(iii)%sum / numprocs
+!
+!--       Calculate rms
+          DO  i = 0, numprocs-1
+!             IF ( log_point(iii)%place == 'run_control' )  THEN
+!                PRINT*, 'pe_rms=',pe_rms(iii),' plp=',pe_log_points(iii,i), &
+!                        ' lps=',log_point(iii)%sum
+!             ENDIF
+             pe_rms(iii) = pe_rms(iii) + ( &
+                                 pe_log_points(iii,i) - log_point(iii)%sum &
+                                         )**2
+          ENDDO
+          pe_rms(iii) = SQRT( pe_rms(iii) / numprocs )
+       ENDDO
+    ELSE
+!
+!--    Send data to PE0 (pe_max is used as temporary storage to send
+!--    the data in order to avoid sending the data type log)
+       ALLOCATE( pe_max( SIZE( log_point ) ) )
+       pe_max = log_point%sum
+       CALL MPI_SEND( pe_max(1), SIZE( log_point ), MPI_REAL, 0, 0, comm2d, &
+                      ierr )
+#endif
+
+    ENDIF
+
+!
+!-- Write cpu-times
+    IF ( myid == 0 )  THEN
+!
+!--    Re-store sums
+       ALLOCATE( sum( SIZE( log_point ) ) )
+       WHERE ( log_point%counts /= 0 )
+          sum = log_point%sum
+       ELSEWHERE
+          sum = -1.0
+       ENDWHERE
+
+!
+!--    Write cpu-times sorted by size
+       CALL check_open( 18 )
+       WRITE ( 18, 100 )  TRIM( run_description_header ),        &
+                          numprocs * threads_per_task, numprocs, &
+                          threads_per_task
+       DO
+          ii = MAXLOC( sum )
+          i = ii(1)
+          IF ( sum(i) /= -1.0 )  THEN
+             WRITE ( 18, 102 ) &
+	        log_point(i)%place, log_point(i)%sum,                &
+                log_point(i)%sum / log_point(1)%sum * 100.0,         &
+                log_point(i)%counts, pe_min(i), pe_max(i), pe_rms(i)
+             sum(i) = -1.0
+          ELSE
+             EXIT 
+          ENDIF
+       ENDDO
+    ENDIF
+
+
+!
+!-- The same procedure again for the individual measurements.
+!
+!-- Compute cpu-times in seconds
+    log_point_s%mtime  = log_point_s%mtime  / norm
+    log_point_s%sum    = log_point_s%sum    / norm
+    log_point_s%vector = log_point_s%vector / norm
+    WHERE ( log_point_s%counts /= 0 )
+       log_point_s%mean = log_point_s%sum / log_point_s%counts
+    END WHERE
+
+!
+!-- Collect cpu-times from all PEs and calculate statistics
+#if defined( __parallel )
+!
+!-- Set barrier in order to avoid that PE0 receives log_point_s-data
+!-- while still busy with receiving log_point-data (see above)
+    CALL MPI_BARRIER( comm2d, ierr )    
+#endif
+    IF ( myid == 0 )  THEN
+!
+!--    Initialize temporary arrays needed for statistics
+       pe_min = log_point_s%sum
+       pe_max = log_point_s%sum    ! need to be set in case of 1 PE
+       pe_rms = 0.0
+
+#if defined( __parallel )
+!
+!--    Receive data from all PEs
+       DO  i = 1, numprocs-1
+          CALL MPI_RECV( pe_max(1), SIZE( log_point ), MPI_REAL, &
+                         MPI_ANY_SOURCE, MPI_ANY_TAG, comm2d, status, ierr )
+          sender = status(MPI_SOURCE)
+          pe_log_points(:,sender) = pe_max
+       ENDDO
+       pe_log_points(:,0) = log_point_s%sum   ! Results from PE0
+!
+!--    Calculate mean of all PEs, store it on log_point_s%sum
+!--    and find minimum and maximum
+       DO  iii = 1, SIZE( log_point )
+          DO  i = 1, numprocs-1
+             log_point_s(iii)%sum = log_point_s(iii)%sum + pe_log_points(iii,i)
+             pe_min(iii) = MIN( pe_min(iii), pe_log_points(iii,i) )
+             pe_max(iii) = MAX( pe_max(iii), pe_log_points(iii,i) )
+          ENDDO
+          log_point_s(iii)%sum = log_point_s(iii)%sum / numprocs
+!
+!--       Calculate rms
+          DO  i = 0, numprocs-1
+             pe_rms(iii) = pe_rms(iii) + ( &
+                                 pe_log_points(iii,i) - log_point_s(iii)%sum &
+                                         )**2
+          ENDDO
+          pe_rms(iii) = SQRT( pe_rms(iii) / numprocs )
+       ENDDO
+    ELSE
+!
+!--    Send data to PE0 (pe_max is used as temporary storage to send
+!--    the data in order to avoid sending the data type log)
+       pe_max = log_point_s%sum
+       CALL MPI_SEND( pe_max(1), SIZE( log_point ), MPI_REAL, 0, 0, comm2d, &
+                      ierr )
+#endif
+
+    ENDIF
+
+!
+!-- Write cpu-times
+    IF ( myid == 0 )  THEN
+!
+!--    Re-store sums
+       WHERE ( log_point_s%counts /= 0 )
+          sum = log_point_s%sum
+       ELSEWHERE
+          sum = -1.0
+       ENDWHERE
+
+!
+!--    Write cpu-times sorted by size
+       WRITE ( 18, 101 )
+       DO
+          ii = MAXLOC( sum )
+          i = ii(1)
+          IF ( sum(i) /= -1.0 )  THEN
+             WRITE ( 18, 102 ) &
+                log_point_s(i)%place, log_point_s(i)%sum, &
+                log_point_s(i)%sum / log_point(1)%sum * 100.0, &
+                log_point_s(i)%counts, pe_min(i), pe_max(i), pe_rms(i)
+             sum(i) = -1.0
+          ELSE
+             EXIT 
+          ENDIF
+       ENDDO
+
+!
+!--    Empty lines in order to create a gap to the results of the model 
+!--    continuation runs
+       WRITE ( 18, 103 )
+
+!
+!--    Unit 18 is not needed anymore
+       CALL close_file( 18 )
+
+    ENDIF
+
+
+100 FORMAT (A/11('-')//'CPU measures for ',I3,' PEs (',I3,' tasks *',I3,    &
+            &' threads):'/ &
+             &'--------------------------------------------------'//        &
+            &'place:                        mean        counts      min  ', &
+             &'     max       rms'/ &
+            &'                           sec.      %                sec. ', &
+             &'     sec.      sec.'/  &
+            &'-----------------------------------------------------------', &
+             &'-------------------')
+
+101 FORMAT (/'special measures:'/ &
+            &'-----------------------------------------------------------', &
+            &'--------------------')
+
+102 FORMAT (A20,2X,F9.3,2X,F7.2,1X,I7,3(1X,F9.3))
+103 FORMAT (//)
+
+ END SUBROUTINE cpu_statistics
+
Index: palm/trunk/SOURCE/cpulog_mod.f90
===================================================================
--- palm/trunk/SOURCE/cpulog_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,578 +1,0 @@
-!> @file cpulog_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Format descriptor 102 changed again to limit line length to 80 characters
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Format descriptor 102 slightly modified.
-! 
-! 4577 2020-06-25 09:53:58Z raasch
-! further re-formatting concerning Fortran parameter variables
-!
-! 4559 2020-06-11 08:51:48Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4549 2020-05-29 09:27:29Z raasch
-! bugfix for r4539: values for min/max/rms stored in separate arrays
-!
-! 4539 2020-05-18 14:05:17Z raasch
-! code re-structured,
-! cpu time per grid point and timestep does not included initialization and spinup any more
-!
-! 4536 2020-05-17 17:24:13Z raasch
-! restart I/O transfer speed added
-!
-! 4429 2020-02-27 15:24:30Z raasch
-! bugfix: cpp-directives added for serial mode
-!
-! 4378 2020-01-16 13:22:48Z Giersch
-! Format of rms output changed to allow values >= 100
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4015 2019-06-05 13:25:35Z raasch
-! all reals changed to double precision in order to work with 32-bit working precision, otherwise
-! calculated time intervals would mostly give zero
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! output format limited to a maximum line length of 80
-!
-! Revision 1.1  1997/07/24 11:12:29  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> CPU-time measurements for any program part whatever. Results of the measurements are output at
-!> the end of the run in local file CPU_MEASURES.
-!>
-!> To measure the CPU-time (better to say the wallclock time) of a specific code segment, two calls
-!> of cpu_log have to be used as brackets in front and at the end of the segment:
-!>
-!>     CALL cpu_log( log_point(n), 'any identifier', 'start' )
-!>       ... code segment ...
-!>     CALL cpu_log( log_point(n), 'any identifier', 'stop' )
-!>
-!> Parts of the code segment can be excluded from the measurement by additional call of cpu_log:
-!>
-!>       ... first segment to be measured
-!>     CALL cpu_log( log_point(n), 'any identifier', 'pause' )
-!>       ... oart of segment to be excluded from measurement
-!>     CALL cpu_log( log_point(n), 'any identifier', 'continue' )
-!>       ... second segment to be mesasured
-!>
-!> n is an INTEGER within the interval [1,100] defining the id of the specific code segment,
-!> 'any identifier' is a string describing the code segment to be measured. It can be freely chosen
-!> and results will appear under this name in file CPU_MEASURES. ids can only be used once. If you
-!> like to do a measurement of a new part of the code, please look for an id which is unused so far.
-!>
-!> runtime_parameters-parameter cpu_log_barrierwait can be used to set an MPI barrier at the
-!> beginning of the measurement (modus 'start' or 'continue'), to avoid that idle times (due to MPI
-!> calls in the code segment, which are waiting for other processes to be finished) affect the
-!> measurements.
-!> If barriers shall not be used at all, a fourth, optional parameter has to be
-!> given:
-!>
-!>     CALL cpu_log( ..., ..., 'start', cpu_log_nowait )
-!>
-!> Variable log_point should be used for non-overlapping code segments, and they should sum up to
-!> the total cpu-time required by the complete run.
-!> Variable log_point_s can be used for any other special (s) measurements.
-!--------------------------------------------------------------------------------------------------!
- MODULE cpulog
-
-
-    USE control_parameters,                                                                        &
-        ONLY: message_string, nr_timesteps_this_run, restart_data_format_output,                   &
-              restart_file_size, run_description_header, synchronous_exchange, write_binary
-
-    USE indices,                                                                                   &
-        ONLY: ngp_3d, nx, ny, nz
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    PRIVATE
-    PUBLIC   cpu_log, cpu_log_barrierwait, cpu_log_nowait, cpu_statistics, initial_wallclock_time, &
-             log_point, log_point_s
-
-    INTERFACE cpu_log
-       MODULE PROCEDURE cpu_log
-    END INTERFACE cpu_log
-
-    INTERFACE cpu_statistics
-       MODULE PROCEDURE cpu_statistics
-    END INTERFACE cpu_statistics
-
-    INTEGER(iwp), PARAMETER ::  cpu_log_continue = 0  !<
-    INTEGER(iwp), PARAMETER ::  cpu_log_pause = 1     !<
-    INTEGER(iwp), PARAMETER ::  cpu_log_start = 2     !<
-    INTEGER(iwp), PARAMETER ::  cpu_log_stop = 3      !<
-
-    LOGICAL, PARAMETER ::  cpu_log_nowait = .FALSE.       !<
-
-    LOGICAL            ::  cpu_log_barrierwait = .FALSE.  !<
-
-    REAL(dp) ::  initial_wallclock_time  !<
-
-    TYPE logpoint
-       REAL(dp)           ::  isum       !<
-       REAL(dp)           ::  ivect      !<
-       REAL(dp)           ::  mean       !<
-       REAL(dp)           ::  mtime      !<
-       REAL(dp)           ::  mtimevec   !<
-       REAL(dp)           ::  sum        !<
-       REAL(dp)           ::  vector     !<
-       INTEGER(iwp)       ::  counts     !<
-       CHARACTER (LEN=25) ::  place      !<
-    END TYPE logpoint
-
-    TYPE(logpoint), DIMENSION(100) ::  log_point = logpoint( 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp,       &
-                                                             0.0_dp, 0.0_dp, 0.0_dp, 0, ' ' )
-    TYPE(logpoint), DIMENSION(100) ::  log_point_s = logpoint( 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp,     &
-                                                               0.0_dp, 0.0_dp, 0.0_dp, 0, ' ' )
-
-    SAVE
-
- CONTAINS
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
-    SUBROUTINE cpu_log( log_event, place, modus, barrierwait )
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  modus              !<
-       CHARACTER (LEN=*) ::  place              !<
-
-       LOGICAL           ::  wait_allowed       !<
-       LOGICAL, OPTIONAL ::  barrierwait        !<
-       LOGICAL, SAVE     ::  first = .TRUE.     !<
-
-       REAL(dp)          ::  mtime = 0.0_dp     !<
-       REAL(dp)          ::  mtimevec = 0.0_dp  !<
-       TYPE(logpoint)    ::  log_event          !<
-
-       INTEGER(idp)     ::  count        !<
-       INTEGER(idp)     ::  count_rate   !<
-
-
-!
-!--    Initialize and check, respectively, point of measurement
-       IF ( log_event%place == ' ' )  THEN
-          log_event%place = place
-       ELSEIF ( log_event%place /= place )  THEN
-          WRITE( message_string, * ) 'wrong argument expected: ',                                  &
-                                     TRIM(log_event%place), ' given: ',  TRIM( place )
-          CALL message( 'cpu_log', 'PA0174', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    Determine, if barriers are allowed to set
-       IF ( PRESENT( barrierwait ) )  THEN
-          wait_allowed = barrierwait
-       ELSE
-          wait_allowed = .TRUE.
-       ENDIF
-
-!
-!--    MPI barrier, if requested, in order to avoid measuring wait times
-!--    caused by MPI routines waiting for other MPI routines of other
-!--    PEs that have not yet finished
-#if defined( __parallel )
-       IF ( cpu_log_barrierwait  .AND.  wait_allowed  .AND.                                        &
-            ( modus == 'start'  .OR.  modus == 'continue' ) )  THEN
-          CALL MPI_BARRIER( comm2d, ierr )
-       ENDIF
-#endif
-
-!
-!--    Take current time
-       CALL SYSTEM_CLOCK( count, count_rate )
-       mtime = REAL( count, KIND=dp ) / REAL( count_rate, KIND=dp )
-
-!
-!--    Start, stop or pause measurement
-       IF ( modus == 'start'  .OR.  modus == 'continue' )  THEN
-          log_event%mtime    = mtime
-          log_event%mtimevec = mtimevec
-       ELSEIF ( modus == 'pause' )  THEN
-          IF ( ( mtime - log_event%mtime ) < 0.0  .AND.  first )  THEN
-             WRITE( message_string, * ) 'negative time interval occured',                          &
-                                        '&PE',myid,' L=PAUSE "',TRIM(log_event%place),             &
-                                        '" new=', mtime,' last=',log_event%mtime
-             CALL message( 'cpu_log', 'PA0176', 0, 1, -1, 6, 0 )
-             first = .FALSE.
-          ENDIF
-          log_event%isum     = log_event%isum + mtime - log_event%mtime
-          log_event%ivect    = log_event%ivect  + mtimevec - log_event%mtimevec
-       ELSEIF ( modus == 'stop' )  THEN
-          IF ( ( mtime - log_event%mtime + log_event%isum ) < 0.0  .AND. first )  THEN
-             WRITE( message_string, * ) 'negative time interval occured',                          &
-                                        '&PE',myid,' L=STOP "',TRIM(log_event%place),'" new=',     &
-                                        mtime,' last=',log_event%mtime,' isum=',log_event%isum
-             CALL message( 'cpu_log', 'PA0177', 0, 1, -1, 6, 0 )
-             first = .FALSE.
-          ENDIF
-          log_event%mtime    = mtime    - log_event%mtime    + log_event%isum
-          log_event%mtimevec = mtimevec - log_event%mtimevec + log_event%ivect
-          log_event%sum      = log_event%sum  + log_event%mtime
-          IF ( log_event%sum < 0.0  .AND.  first )  THEN
-             WRITE( message_string, * ) 'negative time interval occured',                          &
-                                        '&PE',myid,' L=STOP "',TRIM(log_event%place),'" sum=',     &
-                                        log_event%sum,' mtime=',log_event%mtime
-             CALL message( 'cpu_log', 'PA0178', 0, 1, -1, 6, 0 )
-             first = .FALSE.
-          ENDIF
-          log_event%vector   = log_event%vector + log_event%mtimevec
-          log_event%counts   = log_event%counts + 1
-          log_event%isum     = 0.0_dp
-          log_event%ivect    = 0.0_dp
-       ELSE
-          message_string = 'unknown modus of time measurement: ' // TRIM( modus )
-          CALL message( 'cpu_log', 'PA0179', 0, 1, -1, 6, 0 )
-       ENDIF
-
-    END SUBROUTINE cpu_log
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Analysis and output of the cpu-times measured. All PE results are collected
-!> on PE0 in order to calculate the mean cpu-time over all PEs and other
-!> statistics. The output is sorted according to the amount of cpu-time consumed
-!> and output on PE0.
-!------------------------------------------------------------------------------!
-
-    SUBROUTINE cpu_statistics
-
-       IMPLICIT NONE
-
-       INTEGER(iwp)    ::  i               !<
-       INTEGER(iwp)    ::  ii(1)           !<
-#if defined( __parallel )
-       INTEGER(iwp)    ::  iii             !<
-       INTEGER(iwp)    ::  sender          !<
-#endif
-       REAL(dp)       ::  average_cputime  !<
-       REAL(dp), SAVE ::  norm = 1.0_dp    !<
-       REAL(dp), DIMENSION(:),   ALLOCATABLE ::  pe_max          !<
-       REAL(dp), DIMENSION(:),   ALLOCATABLE ::  pe_max_s        !<
-       REAL(dp), DIMENSION(:),   ALLOCATABLE ::  pe_min          !<
-       REAL(dp), DIMENSION(:),   ALLOCATABLE ::  pe_min_s        !<
-       REAL(dp), DIMENSION(:),   ALLOCATABLE ::  pe_rms          !<
-       REAL(dp), DIMENSION(:),   ALLOCATABLE ::  pe_rms_s        !<
-       REAL(dp), DIMENSION(:),   ALLOCATABLE ::  pe_tmp          !<
-       REAL(dp), DIMENSION(:),   ALLOCATABLE ::  pe_tmp_s        !<
-       REAL(dp), DIMENSION(:),   ALLOCATABLE ::  sum             !<
-       REAL(dp), DIMENSION(:),   ALLOCATABLE ::  sum_s           !<
-       REAL(dp), DIMENSION(:,:), ALLOCATABLE ::  pe_log_points   !<
-       REAL(dp), DIMENSION(:,:), ALLOCATABLE ::  pe_log_points_s !<
-
-
-       CALL location_message( 'calculating cpu statistics', 'start' )
-
-!
-!--    Compute CPU-times in seconds for the global non-overlapping measurements.
-       log_point%mtime  = log_point%mtime  / norm
-       log_point%sum    = log_point%sum    / norm
-       log_point%vector = log_point%vector / norm
-       WHERE ( log_point%counts /= 0 )
-          log_point%mean = log_point%sum / log_point%counts
-       END WHERE
-
-
-!
-!--    Collect CPU-times from all PEs and calculate statistics
-       IF ( myid == 0 )  THEN
-!
-!--       Allocate and initialize temporary arrays needed for statistics
-          ALLOCATE( pe_max( SIZE( log_point ) ), pe_min( SIZE( log_point ) ),                      &
-                    pe_rms( SIZE( log_point ) ), pe_tmp( SIZE( log_point ) ),                      &
-                    pe_log_points( SIZE( log_point ), 0:numprocs-1 ) )
-          pe_min = log_point%sum
-          pe_max = log_point%sum    ! need to be set in case of 1 PE
-          pe_rms = 0.0_dp
-          pe_tmp = 0.0_dp
-
-#if defined( __parallel )
-!
-!--       Receive data from all PEs
-          DO  i = 1, numprocs-1
-             CALL MPI_RECV( pe_tmp(1), SIZE( log_point ), MPI_DOUBLE_PRECISION, i, i, comm2d,      &
-                            status, ierr )
-             sender = status(MPI_SOURCE)
-             pe_log_points(:,sender) = pe_tmp
-          ENDDO
-          pe_log_points(:,0) = log_point%sum   ! Results from PE0
-!
-!--       Calculate mean of all PEs, store it on log_point%sum
-!--       and find minimum and maximum
-          DO  iii = 1, SIZE( log_point )
-             DO  i = 1, numprocs-1
-                log_point(iii)%sum = log_point(iii)%sum + pe_log_points(iii,i)
-                pe_min(iii) = MIN( pe_min(iii), pe_log_points(iii,i) )
-                pe_max(iii) = MAX( pe_max(iii), pe_log_points(iii,i) )
-             ENDDO
-             log_point(iii)%sum = log_point(iii)%sum / numprocs
-!
-!--          Calculate rms
-             DO  i = 0, numprocs-1
-                pe_rms(iii) = pe_rms(iii) + ( pe_log_points(iii,i) - log_point(iii)%sum )**2
-             ENDDO
-             pe_rms(iii) = SQRT( pe_rms(iii) / numprocs )
-          ENDDO
-       ELSE
-!
-!--       Send data to PE0 (pe_max is used as temporary storage to send
-!--       the data in order to avoid sending the data type log)
-          ALLOCATE( pe_max( SIZE( log_point ) ) )
-          pe_max = log_point%sum
-          CALL MPI_SEND( pe_max(1), SIZE( log_point ), MPI_DOUBLE_PRECISION, 0, myid, comm2d, ierr )
-#endif
-
-       ENDIF
-
-!
-!--    The same procedure again for the special measurements.
-!
-!--    Compute cpu-times in seconds
-       log_point_s%mtime  = log_point_s%mtime  / norm
-       log_point_s%sum    = log_point_s%sum    / norm
-       log_point_s%vector = log_point_s%vector / norm
-       WHERE ( log_point_s%counts /= 0 )
-          log_point_s%mean = log_point_s%sum / log_point_s%counts
-       END WHERE
-
-!
-!--    Collect CPU-times from all PEs and calculate statistics
-#if defined( __parallel )
-!
-!--    Set barrier in order to avoid that PE0 receives log_point_s-data
-!--    while still busy with receiving log_point-data (see above)
-       CALL MPI_BARRIER( comm2d, ierr )
-#endif
-       IF ( myid == 0 )  THEN
-!
-!--       Allocate and initialize temporary arrays needed for statistics
-          ALLOCATE( pe_max_s( SIZE( log_point_s ) ), pe_min_s( SIZE( log_point_s ) ),              &
-                    pe_rms_s( SIZE( log_point_s ) ), pe_tmp_s( SIZE( log_point_s ) ),              &
-                    pe_log_points_s( SIZE( log_point_s ), 0:numprocs-1 ) )
-          pe_min_s = log_point_s%sum
-          pe_max_s = log_point_s%sum    ! need to be set in case of 1 PE
-          pe_rms_s = 0.0_dp
-
-#if defined( __parallel )
-!
-!--       Receive data from all PEs
-          DO  i = 1, numprocs-1
-             CALL MPI_RECV( pe_tmp_s(1), SIZE( log_point_s ), MPI_DOUBLE_PRECISION,                &
-                            MPI_ANY_SOURCE, MPI_ANY_TAG, comm2d, status, ierr )
-             sender = status(MPI_SOURCE)
-             pe_log_points_s(:,sender) = pe_tmp_s
-          ENDDO
-          pe_log_points_s(:,0) = log_point_s%sum   ! Results from PE0
-!
-!--       Calculate mean of all PEs, store it on log_point_s%sum
-!--       and find minimum and maximum
-          DO  iii = 1, SIZE( log_point_s )
-             DO  i = 1, numprocs-1
-                log_point_s(iii)%sum = log_point_s(iii)%sum + pe_log_points_s(iii,i)
-                pe_min_s(iii) = MIN( pe_min_s(iii), pe_log_points_s(iii,i) )
-                pe_max_s(iii) = MAX( pe_max_s(iii), pe_log_points_s(iii,i) )
-             ENDDO
-             log_point_s(iii)%sum = log_point_s(iii)%sum / numprocs
-!
-!--          Calculate rms
-             DO  i = 0, numprocs-1
-                pe_rms_s(iii) = pe_rms_s(iii) + ( pe_log_points_s(iii,i) - log_point_s(iii)%sum )**2
-             ENDDO
-             pe_rms_s(iii) = SQRT( pe_rms_s(iii) / numprocs )
-          ENDDO
-       ELSE
-!
-!--       Send data to PE0 (pe_max is used as temporary storage to send
-!--       the data in order to avoid sending the data type log)
-          ALLOCATE( pe_max_s( SIZE( log_point_s ) ) )
-          pe_max_s = log_point_s%sum
-          CALL MPI_SEND( pe_max_s(1), SIZE( log_point_s ), MPI_DOUBLE_PRECISION, 0, 0, comm2d,     &
-                         ierr )
-#endif
-
-       ENDIF
-!
-!--    Write CPU-times for the non-overlapping measurements.
-       IF ( myid == 0 )  THEN
-!
-!--       Re-store sums
-          ALLOCATE( sum( SIZE( log_point ) ) )
-          WHERE ( log_point%counts /= 0 )
-             sum = log_point%sum
-          ELSEWHERE
-             sum = -1.0_dp
-          ENDWHERE
-
-!
-!--       Get total time in order to calculate CPU-time per gridpoint and timestep.
-!--       Time for initialization (2) and spinup (41) are not included here!
-          IF ( nr_timesteps_this_run /= 0 )  THEN
-             average_cputime = log_point_s(10)%sum / REAL( ngp_3d(0), KIND=dp ) /                  &
-                               REAL( nr_timesteps_this_run, KIND=dp ) * 1E6_dp     ! in micro-sec
-          ELSE
-             average_cputime = -1.0_dp
-          ENDIF
-
-!
-!--       Write cpu-times sorted by size
-          CALL check_open( 18 )
-#if defined( __parallel )
-          WRITE ( 18, 100 )  TRIM( run_description_header ), numprocs * threads_per_task,          &
-                             pdims(1), pdims(2), threads_per_task, nx+1, ny+1, nz,                 &
-                             nr_timesteps_this_run, average_cputime
-
-          WRITE ( 18, 110 )
-#else
-          WRITE ( 18, 100 )  TRIM( run_description_header ), numprocs * threads_per_task, 1, 1,    &
-                             threads_per_task, nx+1, ny+1, nz, nr_timesteps_this_run,              &
-                             average_cputime
-
-          WRITE ( 18, 110 )
-#endif
-          DO
-             ii = MAXLOC( sum )
-             i = ii(1)
-             IF ( sum(i) /= -1.0_dp )  THEN
-                WRITE ( 18, 102 )  log_point(i)%place, log_point(i)%sum,                           &
-                                   log_point(i)%sum / log_point(1)%sum * 100.0_dp,                 &
-                                   log_point(i)%counts, pe_min(i), pe_max(i), pe_rms(i)
-                sum(i) = -1.0_dp
-             ELSE
-                EXIT
-             ENDIF
-          ENDDO
-       ENDIF
-
-!
-!--    Write CPU-times for special measurements.
-       IF ( myid == 0 )  THEN
-!
-!--       Re-store sums
-          ALLOCATE( sum_s( SIZE( log_point_s ) ) )
-          WHERE ( log_point_s%counts /= 0 )
-             sum_s = log_point_s%sum
-          ELSEWHERE
-             sum_s = -1.0_dp
-          ENDWHERE
-
-!
-!--       Write cpu-times sorted by size
-          WRITE ( 18, 101 )
-          DO
-             ii = MAXLOC( sum_s )
-             i = ii(1)
-             IF ( sum_s(i) /= -1.0_dp )  THEN
-                WRITE ( 18, 102 )  log_point_s(i)%place, log_point_s(i)%sum,                       &
-                                   log_point_s(i)%sum / log_point(1)%sum * 100.0_dp,               &
-                                   log_point_s(i)%counts, pe_min_s(i), pe_max_s(i), pe_rms_s(i)
-                sum_s(i) = -1.0_dp
-             ELSE
-                EXIT
-             ENDIF
-          ENDDO
-
-!
-!--       Output of handling of MPI operations
-          IF ( collective_wait )  THEN
-             WRITE ( 18, 103 )
-          ELSE
-             WRITE ( 18, 104 )
-          ENDIF
-          IF ( cpu_log_barrierwait )  WRITE ( 18, 111 )
-          IF ( synchronous_exchange )  THEN
-             WRITE ( 18, 105 )
-          ELSE
-             WRITE ( 18, 106 )
-          ENDIF
-!
-!--       Output of restart data transfer speed
-          IF ( write_binary  .AND.  restart_data_format_output(1:3) == 'mpi' )  THEN
-             WRITE ( 18, 107 )  restart_file_size, restart_file_size / log_point(22)%sum
-          ENDIF
-!
-!--       Empty lines in order to create a gap to the results from the next restart run
-          WRITE ( 18, 108 )
-
-!
-!--       Unit 18 is not needed anymore
-          CALL close_file( 18 )
-
-       ENDIF
-
-       CALL location_message( 'calculating cpu statistics', 'finished' )
-
-
-   100 FORMAT (A/11('-')//'CPU measures for ',I5,' PEs (',I5,'(x) * ',I5,'(y',                     &
-               &') tasks *',I5,' threads):'//                                                      &
-               'gridpoints (x/y/z): ',20X,I5,' * ',I5,' * ',I5/                                    &
-               'nr of timesteps: ',22X,I6/                                                         &
-               'cpu time per grid point and timestep: ',5X,F8.5,' * 10**-6 s')
-
-   101 FORMAT (/'special measures:'/ &
-               &'-----------------------------------------------------------',                     &
-               &'---------------------')
-
-   102 FORMAT (A25,1X,F10.3,2X,F7.2,1X,I7,2(1X,F9.2),1X,F6.2)
-   103 FORMAT (/'Barriers are set in front of collective operations')
-   104 FORMAT (/'No barriers are set in front of collective operations')
-   105 FORMAT (/'Exchange of ghostpoints via MPI_SENDRCV')
-   106 FORMAT (/'Exchange of ghostpoints via MPI_ISEND/MPI_IRECV')
-   107 FORMAT (/'Restart file size:   ',F12.1,' MByte'/                                            &
-               &'I/O transfer speed:  ',F12.1,' MByte / sec')
-   108 FORMAT (//)
-   110 FORMAT ('------------------------------------------------------------',                     &
-               &'----------'//                                                                     &
-               &'place:                              mean        counts     ',                     &
-               &' min       max    rms'/                                                           &
-               &'                                sec.      %                ',                     &
-               &'sec.      sec.   sec.'/                                                           &
-               &'-----------------------------------------------------------',                     &
-               &'---------------------')
-   111 FORMAT (/'Barriers are set at beginning (start/continue) of measurements')
-
-    END SUBROUTINE cpu_statistics
-
- END MODULE cpulog
Index: palm/trunk/SOURCE/cuda_fft_interfaces.f90
===================================================================
--- palm/trunk/SOURCE/cuda_fft_interfaces.f90	(revision 4901)
+++ 	(revision )
@@ -1,167 +1,0 @@
-!> @file cuda_fft_interfaces.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! 1683 2015-10-07 23:57:51Z knoop
-!
-!
-! Description:
-! ------------
-!> FORTRAN interfaces for the CUDA fft
-!> Routines for the fft along x and y (forward/backward) using the CUDA fft
-!--------------------------------------------------------------------------------------------------!
- MODULE cuda_fft_interfaces
-
-
-#if defined ( __cuda_fft )
-
-    USE kinds
-
-    INTEGER(iwp) ::  CUFFT_C2C = Z'29'    !< Complex to Complex, interleaved
-    INTEGER(iwp) ::  CUFFT_C2R = Z'2c'    !< Complex (interleaved) to Real
-    INTEGER(iwp) ::  CUFFT_D2Z = Z'6a'    !< Double to Double-Complex
-    INTEGER(iwp) ::  CUFFT_FORWARD = -1   !<
-    INTEGER(iwp) ::  CUFFT_INVERSE =  1   !<
-    INTEGER(iwp) ::  CUFFT_R2C = Z'2a'    !< Real to Complex (interleaved)
-    INTEGER(iwp) ::  CUFFT_Z2D = Z'6c'    !< Double-Complex to Double
-    INTEGER(iwp) ::  CUFFT_Z2Z = Z'69'    !< Double-Complex to Double-Complex
-
-    PUBLIC
-
-
-!
-!-- cufftPlan1d( cufftHandle *plan, int nx, cufftType type, int batch )
-    INTERFACE CUFFTPLAN1D
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-       SUBROUTINE CUFFTPLAN1D( plan, nx, type, batch ) BIND( C, name='cufftPlan1d' )
-
-          USE ISO_C_BINDING
-
-          INTEGER(C_INT)        ::  plan   !<
-          INTEGER(C_INT), VALUE ::  batch  !<
-          INTEGER(C_INT), VALUE ::  nx     !<
-          INTEGER(C_INT), VALUE ::  type   !<
-       END SUBROUTINE CUFFTPLAN1D
-
-    END INTERFACE CUFFTPLAN1D
-
-!
-!-- cufftDestroy( cufftHandle plan )  !!! remove later if not really needed !!!
-    INTERFACE CUFFTDESTROY
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-       SUBROUTINE CUFFTDESTROY( plan ) BIND( C, name='cufftDestroy' )
-
-          USE ISO_C_BINDING
-
-          INTEGER(C_INT), VALUE ::  plan
-
-       END SUBROUTINE CUFFTDESTROY
-
-    END INTERFACE CUFFTDESTROY
-
-
-    INTERFACE CUFFTEXECZ2D
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-       SUBROUTINE CUFFTEXECZ2D( plan, idata, odata ) BIND( C, name='cufftExecZ2D' )
-
-          USE ISO_C_BINDING
-          USE kinds
-
-          COMPLEX(dp), DEVICE   ::  idata(:,:,:)  !<
-
-          INTEGER(C_INT), VALUE ::  plan          !<
-
-          REAL(dp), DEVICE      ::  odata(:,:,:)  !<
-
-       END SUBROUTINE CUFFTEXECZ2D
-
-    END INTERFACE CUFFTEXECZ2D
-
-
-    INTERFACE CUFFTEXECD2Z
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-       SUBROUTINE CUFFTEXECD2Z( plan, idata, odata ) bind( C, name='cufftExecD2Z' )
-
-          USE ISO_C_BINDING
-
-          USE kinds
-
-          COMPLEX(dp), DEVICE   ::  odata(:,:,:)  !<
-
-          INTEGER(C_INT), VALUE ::  plan          !<
-
-          REAL(dp), DEVICE      ::  idata(:,:,:)  !<
-
-       END SUBROUTINE CUFFTEXECD2Z
-
-    END INTERFACE CUFFTEXECD2Z
-
-#else
-
-    INTERFACE CUFFTdummy
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Dummy interface to avoid compiler warnings in case of no bublic objects declared.
-!--------------------------------------------------------------------------------------------------!
-       SUBROUTINE CUFFTdummy( dummy )
-
-          USE kinds
-
-          REAL(wp) ::  dummy  !<
-
-       END SUBROUTINE CUFFTdummy
-
-    END INTERFACE CUFFTdummy
-
-#endif
-
- END MODULE cuda_fft_interfaces
Index: palm/trunk/SOURCE/data_log.f90
===================================================================
--- palm/trunk/SOURCE/data_log.f90	(revision 4901)
+++ palm/trunk/SOURCE/data_log.f90	(revision 1)
@@ -1,38 +1,12 @@
-!> @file data_log.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE data_log( array, i1, i2, j1, j2, k1, k2 )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3725 2019-02-07 10:11:02Z raasch
-! preprocessor directives removed to avoid compiler warnings
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
+! $Log: data_log.f90,v $
 ! Revision 1.1  2006/02/23 10:09:29  raasch
 ! Initial revision
@@ -41,25 +15,16 @@
 ! Description:
 ! ------------
-!> Complete logging of data
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE data_log( array, i1, i2, j1, j2, k1, k2 )
+! Complete logging of data
+!------------------------------------------------------------------------------!
+#if defined( __logging )
 
-    USE control_parameters,                                                                        &
-        ONLY:  log_message, simulated_time
-
-    USE kinds
-
+    USE control_parameters
     USE pegrid
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i1  !<
-    INTEGER(iwp) ::  i2  !<
-    INTEGER(iwp) ::  j1  !<
-    INTEGER(iwp) ::  j2  !<
-    INTEGER(iwp) ::  k1  !<
-    INTEGER(iwp) ::  k2  !<
+    INTEGER ::  i1, i2, j1, j2, k1, k2
 
-    REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) ::  array  !<
+    REAL, DIMENSION(i1:i2,j1:j2,k1:k2) ::  array
 
 
@@ -80,31 +45,26 @@
     WRITE ( 20 )  array
 
+#endif
  END SUBROUTINE data_log
 
 
 
-!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE data_log_2d( array, i1, i2, j1, j2)
+
+!------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Complete logging of data for 2d arrays
-!--------------------------------------------------------------------------------------------------!
+! Same as above, for 2d arrays
+!------------------------------------------------------------------------------!
+#if defined( __logging )
 
- SUBROUTINE data_log_2d( array, i1, i2, j1, j2)
-
-    USE control_parameters,                                                                        &
-        ONLY:  log_message, simulated_time
-
-    USE kinds
-
+    USE control_parameters
     USE pegrid
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i1  !<
-    INTEGER(iwp) ::  i2  !<
-    INTEGER(iwp) ::  j1  !<
-    INTEGER(iwp) ::  j2  !<
+    INTEGER ::  i1, i2, j1, j2
 
-    REAL(wp), DIMENSION(i1:i2,j1:j2) ::  array  !<
+    REAL, DIMENSION(i1:i2,j1:j2) ::  array
 
 
@@ -125,31 +85,26 @@
     WRITE ( 20 )  array
 
+#endif
  END SUBROUTINE data_log_2d
 
 
 
-!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE data_log_2d_int( array, i1, i2, j1, j2)
+
+!------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Complete logging of data for 2d integer arrays
-!--------------------------------------------------------------------------------------------------!
+! Same as above, for 2d integer arrays
+!------------------------------------------------------------------------------!
+#if defined( __logging )
 
- SUBROUTINE data_log_2d_int( array, i1, i2, j1, j2)
-
-    USE control_parameters,                                                                        &
-        ONLY:  log_message, simulated_time
-
-    USE kinds
-
+    USE control_parameters
     USE pegrid
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i1  !<
-    INTEGER(iwp) ::  i2  !<
-    INTEGER(iwp) ::  j1  !<
-    INTEGER(iwp) ::  j2  !<
+    INTEGER ::  i1, i2, j1, j2
 
-    INTEGER(iwp), DIMENSION(i1:i2,j1:j2) ::  array  !<
+    INTEGER, DIMENSION(i1:i2,j1:j2) ::  array
 
 
@@ -170,3 +125,4 @@
     WRITE ( 20 )  array
 
+#endif
  END SUBROUTINE data_log_2d_int
Index: palm/trunk/SOURCE/data_output_2d.f90
===================================================================
--- palm/trunk/SOURCE/data_output_2d.f90	(revision 4901)
+++ palm/trunk/SOURCE/data_output_2d.f90	(revision 1)
@@ -1,88 +1,114 @@
-!> @file data_output_2d.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
+ SUBROUTINE data_output_2d( mode, av )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Implementation of downward facing USM and LSM surfaces
+! $Log: data_output_2d.f90,v $
+! Revision 1.5  2006/08/22 13:50:29  raasch
+! xz and yz cross sections now up to nzt+1
+!
+! Revision 1.4  2006/06/06 07:55:18  raasch
+! Error removed: p is assigned to to_be_resorted instead of w
+!
+! Revision 1.3  2006/06/02 15:18:21  raasch
+! +argument "found" in call of routine user_data_output_2d,
+! immediate return, if no output is requested
+!
+! Revision 1.2  2006/02/23 10:19:22  raasch
+! Output of time-averaged data, output of averages along x, y, or z,
+! output of user-defined quantities,
+! section data are copied from local_pf to local_2d before they are output,
+! output of particle concentration and mean radius,
+! Former subroutine plot_2d renamed data_output_2d, pl2d.. renamed do2d..,
+! anz renamed ngp, ebene renamed section, pl2d_.._anz renamed do2d_.._n
+!
+! Revision 1.1  2006/02/23 10:12:31  raasch
+! Initial revision
+!
+! Revision 1.25  2005/10/20 15:41:41  raasch
+! Error in output of netcdf yz-cross-sections removed
+!
+! Revision 1.24  2005/06/26 20:07:25  raasch
+! +ql_c, ql_v, ql_vp
+!
+! Revision 1.23  2005/05/18 15:46:56  raasch
+! Extensions for NetCDF output, output of vpt, qv and lwp
+!
+! Revision 1.22  2005/03/26 20:47:45  raasch
+! local_2d is allocated with upper bound nzt (former nzt+1 was wrong),
+! additional barrier in case that PE0 gathers data from the other
+! PEs, this barrier had to be set at the end of the gathering because
+! otherwise PE0 may receive wrong data on tag 0.
+!
+! Revision 1.21  2004/04/30 12:32:50  raasch
+! Adjustments for enlarged grids (unequal subdomain sizes)
+!
+! Revision 1.20  2003/03/16 09:42:27  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.19  2002/12/19 15:56:24  raasch
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.18  2002/06/11 13:13:00  raasch
+! TRIM function added (needed on IBM-systems)
+!
+! Revision 1.17  2002/04/16  08:11:16  08:11:16  raasch (Siegfried Raasch)
+! Output of scalar field allowed with strings s_xy, s_xz, s_yz
 ! 
-! 4559 2020-06-11 08:51:48Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4518 2020-05-04 15:44:28Z suehring
-! remove double index
-!
-! 4514 2020-04-30 16:29:59Z suehring
-! Enable output of qsurf and ssurf
-!
-! 4500 2020-04-17 10:12:45Z suehring
-! Unify output conversion of sensible and latent heat flux
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4442 2020-03-04 19:21:13Z suehring
-! Change order of dimension in surface array %frac to allow for better vectorization.
-!
-! 4441 2020-03-04 19:20:35Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4331 2019-12-10 18:25:02Z suehring
-! Move 2-m potential temperature output to diagnostic_output_quantities
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4048 2019-06-21 21:00:21Z knoop
-! Removed turbulence_closure_mod dependency
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! modularize diagnostic output
-!
-! 3994 2019-05-22 18:08:09Z suehring
-! output of turbulence intensity added
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3943 2019-05-02 09:50:41Z maronga
-! Added output of qsws for green roofs.
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introductionof additional debug
-! messages
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! unused variables removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Bugfix: use time_since_reference_point instead of simulated_time (relevant when using wall/soil
-!         spinup)
+! Revision 1.16  2001/03/30 07:44:29  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.15  2001/03/09 21:36:29  letzel
+! All comments translated into English.
+!
+! Revision 1.14  2001/01/29 12:32:07  raasch
+! Passive scalar is considered, xy-plot of q and ql corrected (level_z was
+! missing)
+!
+! Revision 1.13  2001/01/22 07:38:20  raasch
+! Module test_variables removed
+!
+! Revision 1.12  2001/01/02 17:33:39  raasch
+! Plot output file is closed at the end of the subroutine
+!
+! Revision 1.11  2000/04/13 14:01:44  schroeter
+! Plotausgaben fuer Gesamtwasser- und Fluessigwassergehalt
+!
+! Revision 1.10  99/02/05  09:14:06  09:14:06  raasch (Siegfried Raasch)
+! u=v=0 am unteren Rand bei Vertikalschnitten wird jetzt ausschliesslich
+! bei Spiegelungsrandbedingungen verwendet
+! 
+! Revision 1.9  1998/09/22 17:25:58  raasch
+! u*- und theta*-Ausgabe korrigiert (muessen auf nzb+1 des Hilfsfeldes local_2d
+! umgespeichert werden.
+!
+! Revision 1.8  1998/07/06 12:26:06  raasch
+! Exakte Ausgabe der Lage der Schnittebenen fuer die verschiedenen Felder
+! bei Horizontalschnitten, + USE test_variables
+!
+! Revision 1.7  1998/03/09 16:24:19  raasch
+! TRIM( simulated_time_chr )
+!
+! Revision 1.6  1998/02/19 07:10:30  raasch
+! Ausgabe der Teilfelder jetzt auch wieder wahlweise durch die einzelnen PEs
+!
+! Revision 1.5  1998/02/10 15:08:25  raasch
+! Spiegelungsrandbedingung fuer u und v bei Vertikalschnitten durch
+! u=v=0 ersetzt, Ausgabe der Schnittlevel,
+! Empfang der Teilfelder durch PE0 erfolgt in beliebiger Reihenfolge durch
+! Verwendung von MPI_ANY_TAG, Barrieren werden gesetzt, um MPI-Fehler zu umgehen
+!
+! Revision 1.4  1998/01/23 10:05:42  raasch
+! Ausgabe von 2D-Feldern (u*_xy, t*_xy)
+!
+! Revision 1.3  1997/09/08 10:47:23  raasch
+! Prozessor 0 gibt jetzt gesamte Schnittebene des Modells aus
+!
+! Revision 1.2  1997/08/29 09:00:36  raasch
+! Ausgabe der potentiellen Temperatur
 !
 ! Revision 1.1  1997/08/11 06:24:09  raasch
@@ -92,173 +118,76 @@
 ! Description:
 ! ------------
-!> Data output of cross-sections in netCDF format or binary format to be later converted to NetCDF
-!> by helper routine combine_plot_fields.
-!> Attention: The position of the sectional planes is still not always computed correctly. (zu is
-!>            used always)!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE data_output_2d( mode, av )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  d_exner, dzw, e, heatflux_output_conversion, p, pt, q, ql, ql_c, ql_v, s, tend, u,  &
-               v, vpt, w, waterflux_output_conversion, zu, zw
-
+! Data output of horizontal cross-sections in NetCDF format or binary format
+! compatible to old graphic software iso2d.
+! Attention: The position of the sectional planes is still not always computed 
+! ---------  correctly. (zu is used always)!
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
     USE averaging
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  lv_d_cp
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    USE control_parameters,                                                                        &
-        ONLY:  data_output_2d_on_each_pe,                                                          &
-               debug_output_timestep,                                                              &
-               data_output_xy, data_output_xz, data_output_yz,                                     &
-               do2d,                                                                               &
-               do2d_xy_last_time, do2d_xy_time_count,                                              &
-               do2d_xz_last_time, do2d_xz_time_count,                                              &
-               do2d_yz_last_time, do2d_yz_time_count,                                              &
-               ibc_uv_b, io_blocks, io_group, message_string,                                      &
-               ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz,                                              &
-               psolver, section,                                                                   &
-               time_since_reference_point
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nzt,                 &
-               topo_top_ind,                                                                       &
-               wall_flags_total_0
-
-    USE kinds
-
-    USE land_surface_model_mod,                                                                    &
-        ONLY:  zs
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_data_output_2d
-
-#if defined( __netcdf )
-    USE NETCDF
-#endif
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  fill_value, id_set_xy, id_set_xz, id_set_yz, id_var_do2d, id_var_time_xy,           &
-               id_var_time_xz, id_var_time_yz, nc_stat, netcdf_data_format, netcdf_handle_error
-
-    USE particle_attributes,                                                                       &
-        ONLY:  grid_particles, number_of_particles, particle_advection_start, particles, prt_count
-
+    USE cloud_parameters
+    USE control_parameters
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE netcdf_control
+    USE particle_attributes
     USE pegrid
 
-    USE surface_mod,                                                                               &
-        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_def_h, surf_lsm_h, surf_usm_h
-
-
     IMPLICIT NONE
 
-    CHARACTER (LEN=2)  ::  do2d_mode    !< output mode of variable ('xy', 'xz', 'yz')
-    CHARACTER (LEN=2)  ::  mode         !< mode with which the routine is called ('xy', 'xz', 'yz')
-    CHARACTER (LEN=4)  ::  grid         !< string defining the vertical grid
-
-    INTEGER(iwp) ::  av        !< flag for (non-)average output
-    INTEGER(iwp) ::  file_id   !< id of output files
-    INTEGER(iwp) ::  flag_nr   !< number of masking flag
-    INTEGER(iwp) ::  i         !< loop index
-    INTEGER(iwp) ::  is        !< slice index
-    INTEGER(iwp) ::  ivar      !< variable index
-    INTEGER(iwp) ::  j         !< loop index
-    INTEGER(iwp) ::  k         !< loop index
-    INTEGER(iwp) ::  l         !< loop index
-    INTEGER(iwp) ::  layer_xy  !< vertical index of a xy slice in array 'local_pf'
-    INTEGER(iwp) ::  m         !< loop index
-    INTEGER(iwp) ::  n         !< loop index
-    INTEGER(iwp) ::  ngp       !< number of grid points of an output slice
-    INTEGER(iwp) ::  nis       !< number of vertical slices to be written via parallel NetCDF output
-    INTEGER(iwp) ::  ns        !< number of output slices
-    INTEGER(iwp) ::  nzb_do    !< lower limit of the data field (usually nzb)
-    INTEGER(iwp) ::  nzt_do    !< upper limit of the data field (usually nzt+1)
-    INTEGER(iwp) ::  s_ind     !< index of slice types (xy=1, xz=2, yz=3)
+    CHARACTER (LEN=2)  ::  do2d_mode, mode
+    CHARACTER (LEN=4)  ::  grid
+    CHARACTER (LEN=25) ::  section_chr
+    CHARACTER (LEN=50) ::  rtext
+    INTEGER ::  av, ngp, file_id, i, if, is, j, k, l, layer_xy, n, psi, s, &
+                sender, &
+                ind(4)
+    LOGICAL ::  found, resorted, two_d
+    REAL    ::  mean_r, s_r3, s_r4
+    REAL, DIMENSION(:), ALLOCATABLE ::      level_z
+    REAL, DIMENSION(:,:), ALLOCATABLE ::    local_2d, local_2d_l
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
 #if defined( __parallel )
-    INTEGER(iwp) ::  iis       !< vertical index of a xy slice in array 'local_2d_sections'
-    INTEGER(iwp) ::  ind(4)    !< index limits (lower/upper bounds) of array 'local_2d'
-    INTEGER(iwp) ::  sender    !< PE id of sending PE
-#endif
-
-    LOGICAL ::  found          !< true if output variable was found
-    LOGICAL ::  resorted       !< true if variable is resorted
-    LOGICAL ::  two_d          !< true if variable is only two dimensional
-
-    REAL(wp) ::  mean_r        !< mean particle radius
-    REAL(wp) ::  s_r2          !< sum( particle-radius**2 )
-    REAL(wp) ::  s_r3          !< sum( particle-radius**3 )
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE     ::  level_z             !< z levels for output array
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  local_2d            !< local 2-dimensional array
-                                                                    !< containing output values
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  local_2d_l          !< local 2-dimensional array
-                                                                    !< containing output values
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf            !< output array
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_2d_sections   !< local array containing values
-                                                                    !< at all slices
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_2d_sections_l !< local array containing values
-                                                                    !< at all slices
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(:,:),   ALLOCATABLE ::  total_2d    !< same as local_2d
-#endif
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to array which shall be output
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'data_output_2d', 'start' )
-!
-!-- Immediate return, if no output is requested (no respective sections found in parameter
-!-- data_output)
+    REAL, DIMENSION(:,:),   ALLOCATABLE ::  total_2d
+#endif
+    REAL, DIMENSION(:,:,:), POINTER ::  to_be_resorted
+
+    NAMELIST /LOCAL/  rtext
+
+    CALL cpu_log (log_point(3),'data_output_2d','start')
+
+!
+!-- Immediate return, if no output is requested (no respective sections
+!-- found in parameter data_output)
     IF ( mode == 'xy'  .AND.  .NOT. data_output_xy(av) )  RETURN
     IF ( mode == 'xz'  .AND.  .NOT. data_output_xz(av) )  RETURN
     IF ( mode == 'yz'  .AND.  .NOT. data_output_yz(av) )  RETURN
 
-    CALL cpu_log (log_point(3),'data_output_2d','start')
-
-    two_d = .FALSE.    ! local variable to distinguish between output of pure 2D arrays and
-                       ! cross-sections of 3D arrays.
-
-!
-!-- Depending on the orientation of the cross-section, the respective output files have to be
-!-- opened.
+    two_d = .FALSE.    ! local variable to distinguish between output of pure 2D
+                       ! arrays and cross-sections of 3D arrays.
+
+!
+!-- Depending on the orientation of the cross-section, the respective output 
+!-- files have to be opened.
     SELECT CASE ( mode )
 
        CASE ( 'xy' )
-          s_ind = 1
-          ALLOCATE( level_z(nzb:nzt+1), local_2d(nxl:nxr,nys:nyn) )
-
-          IF ( netcdf_data_format > 4 )  THEN
-             ns = 1
-             DO WHILE ( section(ns,s_ind) /= -9999  .AND.  ns <= 100 )
-                ns = ns + 1
-             ENDDO
-             ns = ns - 1
-             ALLOCATE( local_2d_sections(nxl:nxr,nys:nyn,1:ns) )
-             local_2d_sections = 0.0_wp
-          ENDIF
-
-!
-!--       Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
-          IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
-             CALL check_open( 101+av*10 )
-          ENDIF
-          IF ( data_output_2d_on_each_pe  .AND.  netcdf_data_format < 5 )  THEN
+
+          s = 1
+          ALLOCATE( level_z(0:nzt+1), local_2d(nxl-1:nxr+1,nys-1:nyn+1) )
+
+#if defined( __netcdf )
+          IF ( myid == 0  .AND.  netcdf_output )  CALL check_open( 101+av*10 )
+#endif
+
+          IF ( data_output_2d_on_each_pe )  THEN
              CALL check_open( 21 )
           ELSE
              IF ( myid == 0 )  THEN
+                IF ( iso2d_output )  CALL check_open( 21 )
 #if defined( __parallel )
-                ALLOCATE( total_2d(0:nx,0:ny) )
+                ALLOCATE( total_2d(-1:nx+1,-1:ny+1) )
 #endif
              ENDIF
@@ -266,30 +195,19 @@
 
        CASE ( 'xz' )
-          s_ind = 2
-          ALLOCATE( local_2d(nxl:nxr,nzb:nzt+1) )
-
-          IF ( netcdf_data_format > 4 )  THEN
-             ns = 1
-             DO WHILE ( section(ns,s_ind) /= -9999  .AND.  ns <= 100 )
-                ns = ns + 1
-             ENDDO
-             ns = ns - 1
-             ALLOCATE( local_2d_sections(nxl:nxr,1:ns,nzb:nzt+1) )
-             ALLOCATE( local_2d_sections_l(nxl:nxr,1:ns,nzb:nzt+1) )
-             local_2d_sections = 0.0_wp; local_2d_sections_l = 0.0_wp
-          ENDIF
-
-!
-!--       Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
-          IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
-             CALL check_open( 102+av*10 )
-          ENDIF
-
-          IF ( data_output_2d_on_each_pe  .AND.  netcdf_data_format < 5 )  THEN
+
+          s = 2
+          ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) )
+
+#if defined( __netcdf )
+          IF ( myid == 0  .AND.  netcdf_output )  CALL check_open( 102+av*10 )
+#endif
+
+          IF ( data_output_2d_on_each_pe )  THEN
              CALL check_open( 22 )
           ELSE
              IF ( myid == 0 )  THEN
+                IF ( iso2d_output )  CALL check_open( 22 )
 #if defined( __parallel )
-                ALLOCATE( total_2d(0:nx,nzb:nzt+1) )
+                ALLOCATE( total_2d(-1:nx+1,nzb:nzt+1) )
 #endif
              ENDIF
@@ -297,30 +215,19 @@
 
        CASE ( 'yz' )
-          s_ind = 3
-          ALLOCATE( local_2d(nys:nyn,nzb:nzt+1) )
-
-          IF ( netcdf_data_format > 4 )  THEN
-             ns = 1
-             DO WHILE ( section(ns,s_ind) /= -9999  .AND.  ns <= 100 )
-                ns = ns + 1
-             ENDDO
-             ns = ns - 1
-             ALLOCATE( local_2d_sections(1:ns,nys:nyn,nzb:nzt+1) )
-             ALLOCATE( local_2d_sections_l(1:ns,nys:nyn,nzb:nzt+1) )
-             local_2d_sections = 0.0_wp; local_2d_sections_l = 0.0_wp
-          ENDIF
-
-!
-!--       Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
-          IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
-             CALL check_open( 103+av*10 )
-          ENDIF
-
-          IF ( data_output_2d_on_each_pe  .AND.  netcdf_data_format < 5 )  THEN
+
+          s = 3
+          ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) )
+
+#if defined( __netcdf )
+          IF ( myid == 0  .AND.  netcdf_output )  CALL check_open( 103+av*10 )
+#endif
+
+          IF ( data_output_2d_on_each_pe )  THEN
              CALL check_open( 23 )
           ELSE
              IF ( myid == 0 )  THEN
+                IF ( iso2d_output )  CALL check_open( 23 )
 #if defined( __parallel )
-                ALLOCATE( total_2d(0:ny,nzb:nzt+1) )
+                ALLOCATE( total_2d(-1:ny+1,nzb:nzt+1) )
 #endif
              ENDIF
@@ -328,110 +235,48 @@
 
        CASE DEFAULT
-          message_string = 'unknown cross-section: ' // TRIM( mode )
-          CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
+
+          PRINT*,'+++ data_output_2d: unknown cross-section: ',mode
+          CALL local_stop
 
     END SELECT
 
 !
-!-- For parallel netcdf output the time axis must be limited. Return, if this limit is exceeded.
-!-- This could be the case, if the simulated time exceeds the given end time by the length of the
-!-- given output interval.
-    IF ( netcdf_data_format > 4 )  THEN
-       IF ( mode == 'xy'  .AND.  do2d_xy_time_count(av) + 1 > ntdim_2d_xy(av) )  THEN
-          WRITE ( message_string, * ) 'Output of xy cross-sections is not ',                       &
-                 'given at t=', time_since_reference_point, 's because the',                       &
-                 ' maximum number of output time levels is exceeded.'
-          CALL message( 'data_output_2d', 'PA0384', 0, 1, 0, 6, 0 )
-          CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
-          RETURN
-       ENDIF
-       IF ( mode == 'xz'  .AND.  do2d_xz_time_count(av) + 1 >  ntdim_2d_xz(av) )  THEN
-          WRITE ( message_string, * ) 'Output of xz cross-sections is not ',                       &
-                  'given at t=', time_since_reference_point, 's because the',                      &
-                  ' maximum number of output time levels is exceeded.'
-          CALL message( 'data_output_2d', 'PA0385', 0, 1, 0, 6, 0 )
-          CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
-          RETURN
-       ENDIF
-       IF ( mode == 'yz'  .AND.  do2d_yz_time_count(av) + 1 > ntdim_2d_yz(av) )  THEN
-          WRITE ( message_string, * ) 'Output of yz cross-sections is not ',                       &
-                  'given at t=', time_since_reference_point, 's because the',                      &
-                  ' maximum number of output time levels is exceeded.'
-          CALL message( 'data_output_2d', 'PA0386', 0, 1, 0, 6, 0 )
-          CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
-          RETURN
-       ENDIF
-    ENDIF
-
-!
 !-- Allocate a temporary array for resorting (kji -> ijk).
-    ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb:nzt+1) )
-    local_pf = 0.0
+    ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) )
 
 !
 !-- Loop of all variables to be written.
 !-- Output dimensions chosen
-    ivar = 1
-    l = MAX( 2, LEN_TRIM( do2d(av,ivar) ) )
-    do2d_mode = do2d(av,ivar)(l-1:l)
-
-    DO  WHILE ( do2d(av,ivar)(1:1) /= ' ' )
+    if = 1
+    l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
+    do2d_mode = do2d(av,if)(l-1:l)
+
+    DO  WHILE ( do2d(av,if)(1:1) /= ' ' )
 
        IF ( do2d_mode == mode )  THEN
-!
-!--       Set flag to steer output of radiation, land-surface, or user-defined quantities
-          found = .FALSE.
-
-          nzb_do = nzb
-          nzt_do = nzt+1
-!
-!--       Before each output, set array local_pf to fill value
-          local_pf = fill_value
-!
-!--       Set masking flag for topography for not resorted arrays
-          flag_nr = 0
-
 !
 !--       Store the array chosen on the temporary array.
           resorted = .FALSE.
-          SELECT CASE ( TRIM( do2d(av,ivar) ) )
+          SELECT CASE ( TRIM( do2d(av,if) ) )
+
              CASE ( 'e_xy', 'e_xz', 'e_yz' )
                 IF ( av == 0 )  THEN
                    to_be_resorted => e
                 ELSE
-                   IF ( .NOT. ALLOCATED( e_av ) )  THEN
-                      ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      e_av = REAL( fill_value, KIND = wp )
-                   ENDIF
                    to_be_resorted => e_av
                 ENDIF
                 IF ( mode == 'xy' )  level_z = zu
 
-             CASE ( 'thetal_xy', 'thetal_xz', 'thetal_yz' )
-                IF ( av == 0 )  THEN
-                   to_be_resorted => pt
-                ELSE
-                   IF ( .NOT. ALLOCATED( lpt_av ) )  THEN
-                      ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      lpt_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   to_be_resorted => lpt_av
-                ENDIF
-                IF ( mode == 'xy' )  level_z = zu
-
              CASE ( 'lwp*_xy' )        ! 2d-array
                 IF ( av == 0 )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * dzw(1:nzt+1) )
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+1
+                         local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
+                                                    dzw(1:nzt+1) )
                       ENDDO
                    ENDDO
                 ELSE
-                   IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
-                      ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
-                      lwp_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+1
                          local_pf(i,j,nzb+1) = lwp_av(j,i)
                       ENDDO
@@ -442,62 +287,190 @@
                 level_z(nzb+1) = zu(nzb+1)
 
-             CASE ( 'ghf*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i                   = surf_lsm_h(0)%i(m)
-                      j                   = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%ghf(m)
+             CASE ( 'p_xy', 'p_xz', 'p_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => p
+                ELSE
+                   to_be_resorted => p_av
+                ENDIF
+                IF ( mode == 'xy' )  level_z = zu
+
+             CASE ( 'pc_xy', 'pc_xz', 'pc_yz' )  ! particle concentration
+                IF ( av == 0 )  THEN
+                   tend = prt_count
+                   CALL exchange_horiz( tend, 0, 0 )
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+1
+                         DO  k = nzb, nzt+1
+                            local_pf(i,j,k) = tend(k,j,i)
+                         ENDDO
+                      ENDDO
                    ENDDO
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i                   = surf_usm_h(0)%i(m)
-                      j                   = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%frac(m,ind_veg_wall)  *                     &
-                                            surf_usm_h(0)%wghf_eb(m)        +                         &
-                                            surf_usm_h(0)%frac(m,ind_pav_green) *                     &
-                                            surf_usm_h(0)%wghf_eb_green(m)  +                         &
-                                            surf_usm_h(0)%frac(m,ind_wat_win)   *                     &
-                                            surf_usm_h(0)%wghf_eb_window(m)
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( ghf_av ) )  THEN
-                      ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
-                      ghf_av = REAL( fill_value, KIND = wp )
-                   ENDIF
+                   resorted = .TRUE.
+                ELSE
+                   CALL exchange_horiz( pc_av, 0, 0 )
+                   to_be_resorted => pc_av
+                ENDIF
+
+             CASE ( 'pr_xy', 'pr_xz', 'pr_yz' )  ! mean particle radius
+                IF ( av == 0 )  THEN
                    DO  i = nxl, nxr
                       DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) = ghf_av(j,i)
+                         DO  k = nzb, nzt+1
+                            psi = prt_start_index(k,j,i)
+                            s_r3 = 0.0
+                            s_r4 = 0.0
+                            DO  n = psi, psi+prt_count(k,j,i)-1
+                               s_r3 = s_r3 + particles(n)%radius**3
+                               s_r4 = s_r4 + particles(n)%radius**4
+                            ENDDO
+                            IF ( s_r3 /= 0.0 )  THEN
+                               mean_r = s_r4 / s_r3
+                            ELSE
+                               mean_r = 0.0
+                            ENDIF
+                            tend(k,j,i) = mean_r
+                         ENDDO
                       ENDDO
                    ENDDO
-                ENDIF
-
+                   CALL exchange_horiz( tend, 0, 0 )
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+1
+                         DO  k = nzb, nzt+1
+                            local_pf(i,j,k) = tend(k,j,i)
+                         ENDDO
+                      ENDDO
+                   ENDDO
+                   resorted = .TRUE.
+                ELSE
+                   CALL exchange_horiz( pr_av, 0, 0 )
+                   to_be_resorted => pr_av
+                ENDIF
+
+             CASE ( 'pt_xy', 'pt_xz', 'pt_yz' )
+                IF ( av == 0 )  THEN
+                   IF ( .NOT. cloud_physics ) THEN
+                      to_be_resorted => pt
+                   ELSE
+                      DO  i = nxl-1, nxr+1
+                         DO  j = nys-1, nyn+1
+                            DO  k = nzb, nzt+1
+                               local_pf(i,j,k) = pt(k,j,i) + l_d_cp *    &
+                                                             pt_d_t(k) * &
+                                                             ql(k,j,i)
+                            ENDDO
+                         ENDDO
+                      ENDDO
+                      resorted = .TRUE.
+                   ENDIF
+                ELSE
+                   to_be_resorted => pt_av
+                ENDIF
+                IF ( mode == 'xy' )  level_z = zu
+
+             CASE ( 'q_xy', 'q_xz', 'q_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => q
+                ELSE
+                   to_be_resorted => q_av
+                ENDIF
+                IF ( mode == 'xy' )  level_z = zu
+
+             CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => ql
+                ELSE
+                   to_be_resorted => ql_av
+                ENDIF
+                IF ( mode == 'xy' )  level_z = zu
+
+             CASE ( 'ql_c_xy', 'ql_c_xz', 'ql_c_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => ql_c
+                ELSE
+                   to_be_resorted => ql_c_av
+                ENDIF
+                IF ( mode == 'xy' )  level_z = zu
+
+             CASE ( 'ql_v_xy', 'ql_v_xz', 'ql_v_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => ql_v
+                ELSE
+                   to_be_resorted => ql_v_av
+                ENDIF
+                IF ( mode == 'xy' )  level_z = zu
+
+             CASE ( 'ql_vp_xy', 'ql_vp_xz', 'ql_vp_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => ql_vp
+                ELSE
+                   to_be_resorted => ql_vp_av
+                ENDIF
+                IF ( mode == 'xy' )  level_z = zu
+
+             CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
+                IF ( av == 0 )  THEN
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+1
+                         DO  k = nzb, nzt+1
+                            local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
+                         ENDDO
+                      ENDDO
+                   ENDDO
+                   resorted = .TRUE.
+                ELSE
+                   to_be_resorted => qv_av
+                ENDIF
+                IF ( mode == 'xy' )  level_z = zu
+
+             CASE ( 's_xy', 's_xz', 's_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => q
+                ELSE
+                   to_be_resorted => q_av
+                ENDIF
+
+             CASE ( 't*_xy' )        ! 2d-array
+                IF ( av == 0 )  THEN
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+1
+                         local_pf(i,j,nzb+1) = ts(j,i)
+                      ENDDO
+                   ENDDO
+                ELSE
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+1
+                         local_pf(i,j,nzb+1) = ts_av(j,i)
+                      ENDDO
+                   ENDDO
+                ENDIF
                 resorted = .TRUE.
                 two_d = .TRUE.
                 level_z(nzb+1) = zu(nzb+1)
 
-             CASE ( 'ol*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_def_h(0)%ns
-                      i = surf_def_h(0)%i(m)
-                      j = surf_def_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%ol(m)
+             CASE ( 'u_xy', 'u_xz', 'u_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => u
+                ELSE
+                   to_be_resorted => u_av
+                ENDIF
+                IF ( mode == 'xy' )  level_z = zu
+!
+!--             Substitute the values generated by "mirror" boundary condition
+!--             at the bottom boundary by the real surface values.
+                IF ( do2d(av,if) == 'u_xz'  .OR.  do2d(av,if) == 'u_yz' )  THEN
+                   IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0
+                ENDIF
+
+             CASE ( 'u*_xy' )        ! 2d-array
+                IF ( av == 0 )  THEN
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+1
+                         local_pf(i,j,nzb+1) = us(j,i)
+                      ENDDO
                    ENDDO
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i = surf_lsm_h(0)%i(m)
-                      j = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%ol(m)
-                   ENDDO
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i = surf_usm_h(0)%i(m)
-                      j = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%ol(m)
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( ol_av ) )  THEN
-                      ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
-                      ol_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) = ol_av(j,i)
+                ELSE
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+1
+                         local_pf(i,j,nzb+1) = us_av(j,i)
                       ENDDO
                    ENDDO
@@ -507,560 +480,8 @@
                 level_z(nzb+1) = zu(nzb+1)
 
-             CASE ( 'p_xy', 'p_xz', 'p_yz' )
-                IF ( av == 0 )  THEN
-                   IF ( psolver /= 'sor' )  CALL exchange_horiz( p, nbgp )
-                   to_be_resorted => p
-                ELSE
-                   IF ( .NOT. ALLOCATED( p_av ) )  THEN
-                      ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      p_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   IF ( psolver /= 'sor' )  CALL exchange_horiz( p_av, nbgp )
-                   to_be_resorted => p_av
-                ENDIF
-                IF ( mode == 'xy' )  level_z = zu
-
-             CASE ( 'pc_xy', 'pc_xz', 'pc_yz' )  ! particle concentration
-                IF ( av == 0 )  THEN
-                   IF ( time_since_reference_point >= particle_advection_start )  THEN
-                      tend = prt_count
-!                      CALL exchange_horiz( tend, nbgp )
-                   ELSE
-                      tend = 0.0_wp
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb, nzt+1
-                            local_pf(i,j,k) = tend(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                   resorted = .TRUE.
-                ELSE
-                   IF ( .NOT. ALLOCATED( pc_av ) )  THEN
-                      ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      pc_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-!                   CALL exchange_horiz( pc_av, nbgp )
-                   to_be_resorted => pc_av
-                ENDIF
-
-             CASE ( 'pr_xy', 'pr_xz', 'pr_yz' )  ! mean particle radius (effective radius)
-                IF ( av == 0 )  THEN
-                   IF ( time_since_reference_point >= particle_advection_start )  THEN
-                      DO  i = nxl, nxr
-                         DO  j = nys, nyn
-                            DO  k = nzb, nzt+1
-                               number_of_particles = prt_count(k,j,i)
-                               IF (number_of_particles <= 0)  CYCLE
-                               particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                               s_r2 = 0.0_wp
-                               s_r3 = 0.0_wp
-                               DO  n = 1, number_of_particles
-                                  IF ( particles(n)%particle_mask )  THEN
-                                     s_r2 = s_r2 + particles(n)%radius**2 *                        &
-                                            particles(n)%weight_factor
-                                     s_r3 = s_r3 + particles(n)%radius**3 *                        &
-                                            particles(n)%weight_factor
-                                  ENDIF
-                               ENDDO
-                               IF ( s_r2 > 0.0_wp )  THEN
-                                  mean_r = s_r3 / s_r2
-                               ELSE
-                                  mean_r = 0.0_wp
-                               ENDIF
-                               tend(k,j,i) = mean_r
-                            ENDDO
-                         ENDDO
-                      ENDDO
-!                      CALL exchange_horiz( tend, nbgp )
-                   ELSE
-                      tend = 0.0_wp
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb, nzt+1
-                            local_pf(i,j,k) = tend(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                   resorted = .TRUE.
-                ELSE
-                   IF ( .NOT. ALLOCATED( pr_av ) )  THEN
-                      ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      pr_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-!                   CALL exchange_horiz( pr_av, nbgp )
-                   to_be_resorted => pr_av
-                ENDIF
-
-             CASE ( 'theta_xy', 'theta_xz', 'theta_yz' )
-                IF ( av == 0 )  THEN
-                   IF ( .NOT. bulk_cloud_model )  THEN
-                      to_be_resorted => pt
-                   ELSE
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                            DO  k = nzb, nzt+1
-                               local_pf(i,j,k) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                      resorted = .TRUE.
-                   ENDIF
-                ELSE
-                   IF ( .NOT. ALLOCATED( pt_av ) ) THEN
-                      ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      pt_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   to_be_resorted => pt_av
-                ENDIF
-                IF ( mode == 'xy' )  level_z = zu
-
-             CASE ( 'q_xy', 'q_xz', 'q_yz' )
-                IF ( av == 0 )  THEN
-                   to_be_resorted => q
-                ELSE
-                   IF ( .NOT. ALLOCATED( q_av ) )  THEN
-                      ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      q_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   to_be_resorted => q_av
-                ENDIF
-                IF ( mode == 'xy' )  level_z = zu
-
-             CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
-                IF ( av == 0 )  THEN
-                   to_be_resorted => ql
-                ELSE
-                   IF ( .NOT. ALLOCATED( ql_av ) )  THEN
-                      ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ql_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   to_be_resorted => ql_av
-                ENDIF
-                IF ( mode == 'xy' )  level_z = zu
-
-             CASE ( 'ql_c_xy', 'ql_c_xz', 'ql_c_yz' )
-                IF ( av == 0 )  THEN
-                   to_be_resorted => ql_c
-                ELSE
-                   IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
-                      ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ql_c_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   to_be_resorted => ql_c_av
-                ENDIF
-                IF ( mode == 'xy' )  level_z = zu
-
-             CASE ( 'ql_v_xy', 'ql_v_xz', 'ql_v_yz' )
-                IF ( av == 0 )  THEN
-                   to_be_resorted => ql_v
-                ELSE
-                   IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
-                      ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ql_v_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   to_be_resorted => ql_v_av
-                ENDIF
-                IF ( mode == 'xy' )  level_z = zu
-
-             CASE ( 'ql_vp_xy', 'ql_vp_xz', 'ql_vp_yz' )
-                IF ( av == 0 )  THEN
-                   IF ( time_since_reference_point >= particle_advection_start )  THEN
-                      DO  i = nxl, nxr
-                         DO  j = nys, nyn
-                            DO  k = nzb, nzt+1
-                               number_of_particles = prt_count(k,j,i)
-                               IF (number_of_particles <= 0)  CYCLE
-                               particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                               DO  n = 1, number_of_particles
-                                  IF ( particles(n)%particle_mask )  THEN
-                                     tend(k,j,i) =  tend(k,j,i) +                                  &
-                                                    particles(n)%weight_factor / prt_count(k,j,i)
-                                  ENDIF
-                               ENDDO
-                            ENDDO
-                         ENDDO
-                      ENDDO
-!                      CALL exchange_horiz( tend, nbgp )
-                   ELSE
-                      tend = 0.0_wp
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb, nzt+1
-                            local_pf(i,j,k) = tend(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                   resorted = .TRUE.
-                ELSE
-                   IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
-                      ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ql_vp_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-!                   CALL exchange_horiz( ql_vp_av, nbgp )
-                   to_be_resorted => ql_vp_av
-                ENDIF
-                IF ( mode == 'xy' )  level_z = zu
-
-             CASE ( 'qsurf*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_def_h(0)%ns
-                      i                   = surf_def_h(0)%i(m)
-                      j                   = surf_def_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%q_surface(m)
-                   ENDDO
-
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i                   = surf_lsm_h(0)%i(m)
-                      j                   = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%q_surface(m)
-                   ENDDO
-
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i                   = surf_usm_h(0)%i(m)
-                      j                   = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%q_surface(m)
-                   ENDDO
-
-                ELSE
-                   IF ( .NOT. ALLOCATED( qsurf_av ) )  THEN
-                      ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) )
-                      qsurf_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) = qsurf_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted       = .TRUE.
-                two_d          = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
-             CASE ( 'qsws*_xy' )        ! 2d-array
-                IF ( av == 0 ) THEN
-                   local_pf(:,:,nzb+1) = REAL( fill_value, KIND = wp )
-!
-!--                In case of default surfaces, clean-up flux by density.
-!--                In case of land-surfaces, convert fluxes into dynamic units.
-                   DO  m = 1, surf_def_h(0)%ns
-                      i = surf_def_h(0)%i(m)
-                      j = surf_def_h(0)%j(m)
-                      k = surf_def_h(0)%k(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%qsws(m) * waterflux_output_conversion(k)
-                   ENDDO
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i = surf_lsm_h(0)%i(m)
-                      j = surf_lsm_h(0)%j(m)
-                      k = surf_lsm_h(0)%k(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%qsws(m) * waterflux_output_conversion(k)
-                   ENDDO
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i = surf_usm_h(0)%i(m)
-                      j = surf_usm_h(0)%j(m)
-                      k = surf_usm_h(0)%k(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%qsws(m) * waterflux_output_conversion(k)
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
-                      ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
-                      qsws_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) =  qsws_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-                two_d = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
-             CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
-                IF ( av == 0 )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb, nzt+1
-                            local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                   resorted = .TRUE.
-                ELSE
-                   IF ( .NOT. ALLOCATED( qv_av ) )  THEN
-                      ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      qv_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   to_be_resorted => qv_av
-                ENDIF
-                IF ( mode == 'xy' )  level_z = zu
-
-             CASE ( 'r_a*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i                   = surf_lsm_h(0)%i(m)
-                      j                   = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%r_a(m)
-                   ENDDO
-
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i   = surf_usm_h(0)%i(m)
-                      j   = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = ( surf_usm_h(0)%frac(m,ind_veg_wall)  *                   &
-                                              surf_usm_h(0)%r_a(m)       +                            &
-                                              surf_usm_h(0)%frac(m,ind_pav_green) *                   &
-                                              surf_usm_h(0)%r_a_green(m) +                            &
-                                              surf_usm_h(0)%frac(m,ind_wat_win)   *                   &
-                                              surf_usm_h(0)%r_a_window(m) )
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( r_a_av ) )  THEN
-                      ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
-                      r_a_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) = r_a_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted       = .TRUE.
-                two_d          = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
-             CASE ( 's_xy', 's_xz', 's_yz' )
-                IF ( av == 0 )  THEN
-                   to_be_resorted => s
-                ELSE
-                   IF ( .NOT. ALLOCATED( s_av ) )  THEN
-                      ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      s_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   to_be_resorted => s_av
-                ENDIF
-
-             CASE ( 'shf*_xy' )        ! 2d-array
-                IF ( av == 0 ) THEN
-!
-!--                In case of default surfaces, clean-up flux by density.
-!--                In case of land- and urban-surfaces, convert fluxes into dynamic units.
-                   DO  m = 1, surf_def_h(0)%ns
-                      i = surf_def_h(0)%i(m)
-                      j = surf_def_h(0)%j(m)
-                      k = surf_def_h(0)%k(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%shf(m) * heatflux_output_conversion(k)
-                   ENDDO
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i = surf_lsm_h(0)%i(m)
-                      j = surf_lsm_h(0)%j(m)
-                      k = surf_lsm_h(0)%k(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%shf(m) * heatflux_output_conversion(k)
-                   ENDDO
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i = surf_usm_h(0)%i(m)
-                      j = surf_usm_h(0)%j(m)
-                      k = surf_usm_h(0)%k(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%shf(m) * heatflux_output_conversion(k)
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( shf_av ) )  THEN
-                      ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
-                      shf_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) =  shf_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-                two_d = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
-             CASE ( 'ssurf*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         k = topo_top_ind(j,i,0)
-                         local_pf(i,j,nzb+1) = s(k,j,i)
-                      ENDDO
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( ssurf_av ) )  THEN
-                      ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) )
-                      ssurf_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) = ssurf_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted       = .TRUE.
-                two_d          = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
-             CASE ( 'ssws*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_def_h(0)%ns
-                      i = surf_def_h(0)%i(m)
-                      j = surf_def_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%ssws(m)
-                   ENDDO
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i = surf_lsm_h(0)%i(m)
-                      j = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%ssws(m)
-                   ENDDO
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i = surf_usm_h(0)%i(m)
-                      j = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%ssws(m)
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( ssws_av ) )  THEN
-                      ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
-                      ssws_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) =  ssws_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-                two_d = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
-             CASE ( 't*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_def_h(0)%ns
-                      i = surf_def_h(0)%i(m)
-                      j = surf_def_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%ts(m)
-                   ENDDO
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i = surf_lsm_h(0)%i(m)
-                      j = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%ts(m)
-                   ENDDO
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i = surf_usm_h(0)%i(m)
-                      j = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%ts(m)
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( ts_av ) )  THEN
-                      ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
-                      ts_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) = ts_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-                two_d = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
-             CASE ( 'tsurf*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_def_h(0)%ns
-                      i                   = surf_def_h(0)%i(m)
-                      j                   = surf_def_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%pt_surface(m)
-                   ENDDO
-
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i                   = surf_lsm_h(0)%i(m)
-                      j                   = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%pt_surface(m)
-                   ENDDO
-
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i   = surf_usm_h(0)%i(m)
-                      j   = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%pt_surface(m)
-                   ENDDO
-
-                ELSE
-                   IF ( .NOT. ALLOCATED( tsurf_av ) )  THEN
-                      ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
-                      tsurf_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) = tsurf_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted       = .TRUE.
-                two_d          = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
-             CASE ( 'u_xy', 'u_xz', 'u_yz' )
-                flag_nr = 1
-                IF ( av == 0 )  THEN
-                   to_be_resorted => u
-                ELSE
-                   IF ( .NOT. ALLOCATED( u_av ) )  THEN
-                      ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      u_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   to_be_resorted => u_av
-                ENDIF
-                IF ( mode == 'xy' )  level_z = zu
-!
-!--             Substitute the values generated by "mirror" boundary condition at the bottom
-!--             boundary by the real surface values.
-                IF ( do2d(av,ivar) == 'u_xz'  .OR.  do2d(av,ivar) == 'u_yz' )  THEN
-                   IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0_wp
-                ENDIF
-
-             CASE ( 'us*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_def_h(0)%ns
-                      i = surf_def_h(0)%i(m)
-                      j = surf_def_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%us(m)
-                   ENDDO
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i = surf_lsm_h(0)%i(m)
-                      j = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%us(m)
-                   ENDDO
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i = surf_usm_h(0)%i(m)
-                      j = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%us(m)
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( us_av ) )  THEN
-                      ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
-                      us_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) = us_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-                two_d = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
              CASE ( 'v_xy', 'v_xz', 'v_yz' )
-                flag_nr = 2
                 IF ( av == 0 )  THEN
                    to_be_resorted => v
                 ELSE
-                   IF ( .NOT. ALLOCATED( v_av ) )  THEN
-                      ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      v_av = REAL( fill_value, KIND = wp )
-                   ENDIF
                    to_be_resorted => v_av
                 ENDIF
@@ -1069,16 +490,12 @@
 !--             Substitute the values generated by "mirror" boundary condition
 !--             at the bottom boundary by the real surface values.
-                IF ( do2d(av,ivar) == 'v_xz'  .OR.  do2d(av,ivar) == 'v_yz' )  THEN
-                   IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0_wp
-                ENDIF
-
-             CASE ( 'thetav_xy', 'thetav_xz', 'thetav_yz' )
+                IF ( do2d(av,if) == 'v_xz'  .OR.  do2d(av,if) == 'v_yz' )  THEN
+                   IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0
+                ENDIF
+
+             CASE ( 'vpt_xy', 'vpt_xz', 'vpt_yz' )
                 IF ( av == 0 )  THEN
                    to_be_resorted => vpt
                 ELSE
-                   IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
-                      ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      vpt_av = REAL( fill_value, KIND = wp )
-                   ENDIF
                    to_be_resorted => vpt_av
                 ENDIF
@@ -1086,123 +503,16 @@
 
              CASE ( 'w_xy', 'w_xz', 'w_yz' )
-                flag_nr = 3
                 IF ( av == 0 )  THEN
                    to_be_resorted => w
                 ELSE
-                   IF ( .NOT. ALLOCATED( w_av ) )  THEN
-                      ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      w_av = REAL( fill_value, KIND = wp )
-                   ENDIF
                    to_be_resorted => w_av
                 ENDIF
                 IF ( mode == 'xy' )  level_z = zw
 
-             CASE ( 'z0*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_def_h(0)%ns
-                      i = surf_def_h(0)%i(m)
-                      j = surf_def_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%z0(m)
-                   ENDDO
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i = surf_lsm_h(0)%i(m)
-                      j = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%z0(m)
-                   ENDDO
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i = surf_usm_h(0)%i(m)
-                      j = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%z0(m)
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( z0_av ) )  THEN
-                      ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
-                      z0_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) =  z0_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-                two_d = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
-             CASE ( 'z0h*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_def_h(0)%ns
-                      i = surf_def_h(0)%i(m)
-                      j = surf_def_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%z0h(m)
-                   ENDDO
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i = surf_lsm_h(0)%i(m)
-                      j = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%z0h(m)
-                   ENDDO
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i = surf_usm_h(0)%i(m)
-                      j = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%z0h(m)
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( z0h_av ) )  THEN
-                      ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
-                      z0h_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) =  z0h_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-                two_d = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
-             CASE ( 'z0q*_xy' )        ! 2d-array
-                IF ( av == 0 )  THEN
-                   DO  m = 1, surf_def_h(0)%ns
-                      i = surf_def_h(0)%i(m)
-                      j = surf_def_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_def_h(0)%z0q(m)
-                   ENDDO
-                   DO  m = 1, surf_lsm_h(0)%ns
-                      i = surf_lsm_h(0)%i(m)
-                      j = surf_lsm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%z0q(m)
-                   ENDDO
-                   DO  m = 1, surf_usm_h(0)%ns
-                      i = surf_usm_h(0)%i(m)
-                      j = surf_usm_h(0)%j(m)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%z0q(m)
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( z0q_av ) )  THEN
-                      ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
-                      z0q_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         local_pf(i,j,nzb+1) =  z0q_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-                two_d = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
-
              CASE DEFAULT
-
-!
-!--             Quantities of other modules
-                IF ( .NOT. found )  THEN
-                   CALL module_interface_data_output_2d( av, do2d(av,ivar), found, grid, mode,     &
-                                                         local_pf, two_d, nzb_do, nzt_do,          &
-                                                         fill_value                                &
-                                                       )
-                ENDIF
-
+!
+!--             User defined quantity
+                CALL user_data_output_2d( av, do2d(av,if), found, grid, &
+                                          local_pf )
                 resorted = .TRUE.
 
@@ -1211,13 +521,9 @@
                 ELSEIF ( grid == 'zw' )  THEN
                    IF ( mode == 'xy' )  level_z = zw
-                ELSEIF ( grid == 'zu1' ) THEN
-                   IF ( mode == 'xy' )  level_z(nzb+1) = zu(nzb+1)
-                ELSEIF ( grid == 'zs' ) THEN
-                   IF ( mode == 'xy' )  level_z = zs
                 ENDIF
 
                 IF ( .NOT. found )  THEN
-                   message_string = 'no output provided for: ' // TRIM( do2d(av,ivar) )
-                   CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 )
+                   PRINT*, '+++ data_output_2d: no output provided for: ', &
+                                do2d(av,if)
                 ENDIF
 
@@ -1225,13 +531,10 @@
 
 !
-!--       Resort the array to be output, if not done above. Flag topography grid points with fill
-!--       values, using the corresponding maksing flag.
+!--       Resort the array to be output, if not done above
           IF ( .NOT. resorted )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),                              &
-                                               REAL( fill_value, KIND = wp ),                      &
-                                               BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      local_pf(i,j,k) = to_be_resorted(k,j,i)
                    ENDDO
                 ENDDO
@@ -1240,7 +543,8 @@
 
 !
-!--       Output of the individual cross-sections, depending on the cross-section mode chosen.
+!--       Output of the individual cross-sections, depending on the cross- 
+!--       section mode chosen.
           is = 1
-   loop1: DO WHILE ( section(is,s_ind) /= -9999  .OR.  two_d )
+   loop1: DO  WHILE ( section(is,s) /= -9999  .OR.  two_d )
 
              SELECT CASE ( mode )
@@ -1252,28 +556,24 @@
                       layer_xy = nzb+1
                    ELSE
-                      layer_xy = section(is,s_ind)
-                   ENDIF
-
-!
-!--                Exit the loop for layers beyond the data output domain (used for soil model)
-                   IF ( layer_xy > nzt_do )  THEN
-                      EXIT loop1
-                   ENDIF
-
-!
-!--                Update the netCDF xy cross section time axis.
-!--                In case of parallel output, this is only done by PE0 to increase the performance.
-                   IF ( time_since_reference_point /= do2d_xy_last_time(av) )  THEN
-                      do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
-                      do2d_xy_last_time(av)  = time_since_reference_point
-                      IF ( myid == 0 )  THEN
-                         IF ( .NOT. data_output_2d_on_each_pe  .OR.  netcdf_data_format > 4 )  THEN
-#if defined( __netcdf )
-                            nc_stat = NF90_PUT_VAR( id_set_xy(av),                                 &
-                                                    id_var_time_xy(av),                            &
-                                                    (/ time_since_reference_point /),              &
-                                                    start = (/ do2d_xy_time_count(av) /),          &
+                      layer_xy = section(is,s)
+                   ENDIF
+
+!
+!--                Update the NetCDF xy cross section time axis
+                   IF ( myid == 0 )  THEN
+                      IF ( simulated_time /= do2d_xy_last_time(av) )  THEN
+                         do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
+                         do2d_xy_last_time(av)  = simulated_time
+                         IF ( .NOT. data_output_2d_on_each_pe  .AND. &
+                              netcdf_output )  THEN
+#if defined( __netcdf )
+                            nc_stat = NF90_PUT_VAR( id_set_xy(av),             &
+                                                    id_var_time_xy(av),        &
+                                                    (/ simulated_time /),      &
+                                         start = (/ do2d_xy_time_count(av) /), &
                                                     count = (/ 1 /) )
-                            CALL netcdf_handle_error( 'data_output_2d', 53 )
+                            IF ( nc_stat /= NF90_NOERR )  THEN
+                               CALL handle_netcdf_error( 53 )
+                            ENDIF
 #endif
                          ENDIF
@@ -1282,12 +582,12 @@
 !
 !--                If required, carry out averaging along z
-                   IF ( section(is,s_ind) == -1  .AND.  .NOT. two_d )  THEN
-
-                      local_2d = 0.0_wp
+                   IF ( section(is,s) == -1 )  THEN
+
+                      local_2d = 0.0
 !
 !--                   Carry out the averaging (all data are on the PE)
-                      DO  k = nzb_do, nzt_do
-                         DO  j = nys, nyn
-                            DO  i = nxl, nxr
+                      DO  k = nzb, nzt+1
+                         DO  j = nys-1, nyn+1
+                            DO  i = nxl-1, nxr+1
                                local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
                             ENDDO
@@ -1295,5 +595,5 @@
                       ENDDO
 
-                      local_2d = local_2d / ( nzt_do - nzb_do + 1.0_wp)
+                      local_2d = local_2d / ( nzt -nzb + 2.0 )
 
                    ELSE
@@ -1305,171 +605,394 @@
 
 #if defined( __parallel )
-                   IF ( netcdf_data_format > 4 )  THEN
-!
-!--                   Parallel output in netCDF4/HDF5 format.
+                   IF ( data_output_2d_on_each_pe )  THEN
+!
+!--                   Output of partial arrays on each PE
+#if defined( __netcdf )
+                      IF ( netcdf_output  .AND.  myid == 0 )  THEN
+                         WRITE ( 21 )  simulated_time, do2d_xy_time_count(av), &
+                                       av
+                      ENDIF
+#endif
+                      WRITE ( 21 )  nxl-1, nxr+1, nys-1, nyn+1
+                      WRITE ( 21 )  local_2d
+
+                   ELSE
+!
+!--                   PE0 receives partial arrays from all processors and then
+!--                   outputs them. Here a barrier has to be set, because
+!--                   otherwise "-MPI- FATAL: Remote protocol queue full" may
+!--                   occur.
+                      CALL MPI_BARRIER( comm2d, ierr )
+
+                      ngp = ( nxr-nxl+3 ) * ( nyn-nys+3 )
+                      IF ( myid == 0 )  THEN
+!
+!--                      Local array can be relocated directly.
+                         total_2d(nxl-1:nxr+1,nys-1:nyn+1) = local_2d
+!
+!--                      Receive data from all other PEs.
+                         DO  n = 1, numprocs-1
+!
+!--                         Receive index limits first, then array.
+!--                         Index limits are received in arbitrary order from
+!--                         the PEs.
+                            CALL MPI_RECV( ind(1), 4, MPI_INTEGER,            &
+                                           MPI_ANY_SOURCE, 0, comm2d, status, &
+                                           ierr )
+                            sender = status(MPI_SOURCE)
+                            DEALLOCATE( local_2d )
+                            ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
+                            CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp,      &
+                                           MPI_REAL, sender, 1, comm2d,       &
+                                           status, ierr )
+                            total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
+                         ENDDO
+!
+!--                      Output of the total cross-section.
+                         IF ( iso2d_output ) WRITE (21)  total_2d(0:nx+1,0:ny+1)
+!
+!--                      Relocate the local array for the next loop increment
+                         DEALLOCATE( local_2d )
+                         ALLOCATE( local_2d(nxl-1:nxr+1,nys-1:nyn+1) )
+
+#if defined( __netcdf )
+                         IF ( netcdf_output )  THEN
+                            IF ( two_d ) THEN
+                               nc_stat = NF90_PUT_VAR( id_set_xy(av),          &
+                                                       id_var_do2d(av,if),     &
+                                                      total_2d(0:nx+1,0:ny+1), &
+                                start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
+                                                count = (/ nx+2, ny+2, 1, 1 /) )
+                            ELSE
+                               nc_stat = NF90_PUT_VAR( id_set_xy(av),          &
+                                                       id_var_do2d(av,if),     &
+                                                      total_2d(0:nx+1,0:ny+1), &
+                               start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
+                                                count = (/ nx+2, ny+2, 1, 1 /) )
+                            ENDIF
+                            IF ( nc_stat /= NF90_NOERR )  &
+                                                  CALL handle_netcdf_error( 54 )
+                         ENDIF
+#endif
+
+                      ELSE
+!
+!--                      First send the local index limits to PE0
+                         ind(1) = nxl-1; ind(2) = nxr+1
+                         ind(3) = nys-1; ind(4) = nyn+1
+                         CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
+                                        ierr )
+!
+!--                      Send data to PE0
+                         CALL MPI_SEND( local_2d(nxl-1,nys-1), ngp, MPI_REAL, &
+                                        0, 1, comm2d, ierr )
+                      ENDIF
+!
+!--                   A barrier has to be set, because otherwise some PEs may
+!--                   proceed too fast so that PE0 may receive wrong data on
+!--                   tag 0
+                      CALL MPI_BARRIER( comm2d, ierr )
+                   ENDIF
+#else
+                   IF ( iso2d_output )  THEN
+                      WRITE (21)  local_2d(nxl:nxr+1,nys:nyn+1)
+                   ENDIF
+#if defined( __netcdf )
+                   IF ( netcdf_output )  THEN
                       IF ( two_d ) THEN
-                         iis = 1
+                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
+                                                 id_var_do2d(av,if),           &
+                                                local_2d(nxl:nxr+1,nys:nyn+1), &
+                                start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
+                                              count = (/ nx+2, ny+2, 1, 1 /) )
                       ELSE
-                         iis = is
-                      ENDIF
-
-#if defined( __netcdf )
-!
-!--                   For parallel output, all cross sections are first stored here on a local array
-!--                   and will be written to the output file afterwards to increase the performance.
-                      DO  i = nxl, nxr
+                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
+                                                 id_var_do2d(av,if),           &
+                                                local_2d(nxl:nxr+1,nys:nyn+1), &
+                               start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
+                                              count = (/ nx+2, ny+2, 1, 1 /) )
+                      ENDIF
+                      IF ( nc_stat /= NF90_NOERR )  &
+                                                  CALL handle_netcdf_error( 55 )
+                   ENDIF
+#endif
+#endif
+                   do2d_xy_n = do2d_xy_n + 1
+!
+!--                Write LOCAL parameter set for ISO2D.
+                   IF ( myid == 0  .AND.  iso2d_output )  THEN
+                      IF ( section(is,s) /= -1 )  THEN
+                         WRITE ( section_chr, '(''z = '',F7.2,'' m  (GP '',I3, &
+                                               &'')'')'                        &
+                               )  level_z(layer_xy), layer_xy
+                      ELSE
+                         section_chr = 'averaged along z'
+                      ENDIF
+                      IF ( av == 0 )  THEN
+                         rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
+                                 TRIM( simulated_time_chr ) // '  ' // &
+                                 TRIM( section_chr )
+                      ELSE
+                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
+                                 TRIM( simulated_time_chr ) // '  ' //       &
+                                 TRIM( section_chr )
+                      ENDIF
+                      WRITE (27,LOCAL)
+                   ENDIF
+!
+!--                For 2D-arrays (e.g. u*) only one cross-section is available.
+!--                Hence exit loop of output levels.
+                   IF ( two_d )  THEN
+                      two_d = .FALSE.
+                      EXIT loop1
+                   ENDIF
+
+                CASE ( 'xz' )
+!
+!--                Update the NetCDF xy cross section time axis
+                   IF ( myid == 0 )  THEN
+                      IF ( simulated_time /= do2d_xz_last_time(av) )  THEN
+                         do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
+                         do2d_xz_last_time(av)  = simulated_time
+                         IF ( .NOT. data_output_2d_on_each_pe  .AND. &
+                              netcdf_output )  THEN
+#if defined( __netcdf )
+                            nc_stat = NF90_PUT_VAR( id_set_xz(av),             &
+                                                    id_var_time_xz(av),        &
+                                                    (/ simulated_time /),      &
+                                         start = (/ do2d_xz_time_count(av) /), &
+                                                    count = (/ 1 /) )
+                            IF ( nc_stat /= NF90_NOERR )  THEN
+                               CALL handle_netcdf_error( 56 )
+                            ENDIF
+#endif
+                         ENDIF
+                      ENDIF
+                   ENDIF
+!
+!--                If required, carry out averaging along y
+                   IF ( section(is,s) == -1 )  THEN
+
+                      ALLOCATE( local_2d_l(nxl-1:nxr+1,nzb:nzt+1) )
+                      local_2d_l = 0.0
+                      ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
+!
+!--                   First local averaging on the PE
+                      DO  k = nzb, nzt+1
                          DO  j = nys, nyn
-                            local_2d_sections(i,j,iis) = local_2d(i,j)
+                            DO  i = nxl-1, nxr+1
+                               local_2d_l(i,k) = local_2d_l(i,k) + &
+                                                 local_pf(i,j,k)
+                            ENDDO
                          ENDDO
                       ENDDO
-#endif
+#if defined( __parallel )
+!
+!--                   Now do the averaging over all PEs along y
+                      CALL MPI_ALLREDUCE( local_2d_l(nxl-1,nzb),              &
+                                          local_2d(nxl-1,nzb), ngp, MPI_REAL, &
+                                          MPI_SUM, comm1dy, ierr )
+#else
+                      local_2d = local_2d_l
+#endif
+                      local_2d = local_2d / ( ny + 1.0 )
+
+                      DEALLOCATE( local_2d_l )
+
                    ELSE
-
-                      IF ( data_output_2d_on_each_pe )  THEN
-!
-!--                      Output of partial arrays on each PE
-#if defined( __netcdf )
-                         IF ( myid == 0 )  THEN
-                            WRITE ( 21 )  time_since_reference_point, do2d_xy_time_count(av), av
-                         ENDIF
-#endif
-                         DO  i = 0, io_blocks-1
-                            IF ( i == io_group )  THEN
-                               WRITE ( 21 )  nxl, nxr, nys, nyn, nys, nyn
-                               WRITE ( 21 )  local_2d
-                            ENDIF
+!
+!--                   Just store the respective section on the local array
+!--                   (but only if it is available on this PE!)
+                      IF ( section(is,s) >= nys  .AND.  section(is,s) <= nyn ) &
+                      THEN
+                         local_2d = local_pf(:,section(is,s),nzb:nzt+1)
+                      ENDIF
+
+                   ENDIF
+
 #if defined( __parallel )
-                            CALL MPI_BARRIER( comm2d, ierr )
-#endif
-                         ENDDO
-
+                   IF ( data_output_2d_on_each_pe )  THEN
+!
+!--                   Output of partial arrays on each PE. If the cross section
+!--                   does not reside on the PE, output special index values.
+#if defined( __netcdf )
+                      IF ( netcdf_output  .AND.  myid == 0 )  THEN
+                         WRITE ( 22 )  simulated_time, do2d_xz_time_count(av), &
+                                       av
+                      ENDIF
+#endif
+                      IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) .OR.&
+                           ( section(is,s) == -1  .AND.  nys-1 == -1 ) )       &
+                      THEN
+                         WRITE (22)  nxl-1, nxr+1, nzb, nzt+1
+                         WRITE (22)  local_2d
                       ELSE
-!
-!--                      PE0 receives partial arrays from all processors and then outputs them. Here
-!--                      a barrier has to be set, because otherwise "-MPI- FATAL: Remote protocol
-!--                      queue full" may occur.
-                         CALL MPI_BARRIER( comm2d, ierr )
-
-                         ngp = ( nxr-nxl+1 ) * ( nyn-nys+1 )
-                         IF ( myid == 0 )  THEN
-!
-!--                         Local array can be relocated directly.
-                            total_2d(nxl:nxr,nys:nyn) = local_2d
-!
-!--                         Receive data from all other PEs.
-                            DO  n = 1, numprocs-1
-!
-!--                            Receive index limits first, then array.
-!--                            Index limits are received in arbitrary order from
-!--                            the PEs.
-                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER, MPI_ANY_SOURCE, 0, comm2d,   &
-                                              status, ierr )
+                         WRITE (22)  -1, -1, -1, -1
+                      ENDIF
+
+                   ELSE
+!
+!--                   PE0 receives partial arrays from all processors of the 
+!--                   respective cross section and outputs them. Here a 
+!--                   barrier has to be set, because otherwise 
+!--                   "-MPI- FATAL: Remote protocol queue full" may occur.
+                      CALL MPI_BARRIER( comm2d, ierr )
+
+                      ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
+                      IF ( myid == 0 )  THEN
+!
+!--                      Local array can be relocated directly.
+                         IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn )  &
+                            .OR. ( section(is,s) == -1  .AND.  nys-1 == -1 ) ) &
+                         THEN
+                            total_2d(nxl-1:nxr+1,nzb:nzt+1) = local_2d
+                         ENDIF
+!
+!--                      Receive data from all other PEs.
+                         DO  n = 1, numprocs-1
+!
+!--                         Receive index limits first, then array.
+!--                         Index limits are received in arbitrary order from
+!--                         the PEs.
+                            CALL MPI_RECV( ind(1), 4, MPI_INTEGER,            &
+                                           MPI_ANY_SOURCE, 0, comm2d, status, &
+                                           ierr )
+!
+!--                         Not all PEs have data for XZ-cross-section.
+                            IF ( ind(1) /= -9999 )  THEN
                                sender = status(MPI_SOURCE)
                                DEALLOCATE( local_2d )
                                ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
-                               CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, MPI_REAL, sender, 1,   &
-                                              comm2d, status, ierr )
+                               CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
+                                              MPI_REAL, sender, 1, comm2d,  &
+                                              status, ierr )
                                total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
-                            ENDDO
-!
-!--                         Relocate the local array for the next loop increment
-                            DEALLOCATE( local_2d )
-                            ALLOCATE( local_2d(nxl:nxr,nys:nyn) )
-
-#if defined( __netcdf )
-                            IF ( two_d )  THEN
-                               nc_stat = NF90_PUT_VAR( id_set_xy(av),                              &
-                                                       id_var_do2d(av,ivar),                       &
-                                                       total_2d(0:nx,0:ny),                        &
-                                                    start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
-                                                       count = (/ nx+1, ny+1, 1, 1 /) )
-                            ELSE
-                               nc_stat = NF90_PUT_VAR( id_set_xy(av),                              &
-                                                       id_var_do2d(av,ivar),                       &
-                                                       total_2d(0:nx,0:ny),                        &
-                                                   start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
-                                                       count = (/ nx+1, ny+1, 1, 1 /) )
                             ENDIF
-                            CALL netcdf_handle_error( 'data_output_2d', 54 )
-#endif
-
+                         ENDDO
+!
+!--                      Output of the total cross-section.
+                         IF ( iso2d_output )  THEN
+                            WRITE (22)  total_2d(0:nx+1,nzb:nzt+1)
+                         ENDIF
+!
+!--                      Relocate the local array for the next loop increment
+                         DEALLOCATE( local_2d )
+                         ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) )
+
+#if defined( __netcdf )
+                         IF ( netcdf_output )  THEN
+                            nc_stat = NF90_PUT_VAR( id_set_xz(av),             &
+                                                    id_var_do2d(av,if),        &
+                                                    total_2d(0:nx+1,nzb:nzt+1),&
+                               start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
+                                                count = (/ nx+2, 1, nz+2, 1 /) )
+                            IF ( nc_stat /= NF90_NOERR ) &
+                                                  CALL handle_netcdf_error( 57 )
+                         ENDIF
+#endif
+
+                      ELSE
+!
+!--                      If the cross section resides on the PE, send the
+!--                      local index limits, otherwise send -9999 to PE0.
+                         IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn )  &
+                            .OR. ( section(is,s) == -1  .AND.  nys-1 == -1 ) ) &
+                         THEN
+                            ind(1) = nxl-1; ind(2) = nxr+1
+                            ind(3) = nzb;   ind(4) = nzt+1
                          ELSE
-!
-!--                         First send the local index limits to PE0
-                            ind(1) = nxl; ind(2) = nxr
-                            ind(3) = nys; ind(4) = nyn
-                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, ierr )
-!
-!--                         Send data to PE0
-                            CALL MPI_SEND( local_2d(nxl,nys), ngp, MPI_REAL, 0, 1, comm2d, ierr )
-                         ENDIF
-!
-!--                      A barrier has to be set, because otherwise some PEs may proceed too fast so
-!--                      that PE0 may receive wrong data on tag 0.
-                         CALL MPI_BARRIER( comm2d, ierr )
-                      ENDIF
-
+                            ind(1) = -9999; ind(2) = -9999
+                            ind(3) = -9999; ind(4) = -9999
+                         ENDIF
+                         CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
+                                        ierr )
+!
+!--                      If applicable, send data to PE0.
+                         IF ( ind(1) /= -9999 )  THEN
+                            CALL MPI_SEND( local_2d(nxl-1,nzb), ngp, MPI_REAL, &
+                                           0, 1, comm2d, ierr )
+                         ENDIF
+                      ENDIF
+!
+!--                   A barrier has to be set, because otherwise some PEs may
+!--                   proceed too fast so that PE0 may receive wrong data on
+!--                   tag 0
+                      CALL MPI_BARRIER( comm2d, ierr )
                    ENDIF
 #else
-#if defined( __netcdf )
-                   IF ( two_d ) THEN
-                      nc_stat = NF90_PUT_VAR( id_set_xy(av),                                       &
-                                              id_var_do2d(av,ivar),                                &
-                                              local_2d(nxl:nxr,nys:nyn),                           &
-                                              start = (/ 1, 1, 1, do2d_xy_time_count(av) /),       &
-                                              count = (/ nx+1, ny+1, 1, 1 /) )
-                   ELSE
-                      nc_stat = NF90_PUT_VAR( id_set_xy(av),                                       &
-                                              id_var_do2d(av,ivar),                                &
-                                              local_2d(nxl:nxr,nys:nyn),                           &
-                                              start = (/ 1, 1, is, do2d_xy_time_count(av) /),      &
-                                              count = (/ nx+1, ny+1, 1, 1 /) )
-                   ENDIF
-                   CALL netcdf_handle_error( 'data_output_2d', 447 )
-#endif
-#endif
-
-!
-!--                For 2D-arrays (e.g. u*) only one cross-section is available.
-!--                Hence exit loop of output levels.
-                   IF ( two_d )  THEN
-                      IF ( netcdf_data_format < 5 )  two_d = .FALSE.
-                      EXIT loop1
-                   ENDIF
-
-                CASE ( 'xz' )
-!
-!--                Update the netCDF xz cross section time axis.
-!--                In case of parallel output, this is only done by PE0 to increase the performance.
-                   IF ( time_since_reference_point /= do2d_xz_last_time(av) )  THEN
-                      do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
-                      do2d_xz_last_time(av)  = time_since_reference_point
-                      IF ( myid == 0 )  THEN
-                         IF ( .NOT. data_output_2d_on_each_pe  .OR.  netcdf_data_format > 4 )  THEN
-#if defined( __netcdf )
-                            nc_stat = NF90_PUT_VAR( id_set_xz(av),                                 &
-                                                    id_var_time_xz(av),                            &
-                                                    (/ time_since_reference_point /),              &
-                                                    start = (/ do2d_xz_time_count(av) /),          &
+                   IF ( iso2d_output )  THEN
+                      WRITE (22)  local_2d(nxl:nxr+1,nzb:nzt+1)
+                   ENDIF
+#if defined( __netcdf )
+                   IF ( netcdf_output )  THEN
+                      nc_stat = NF90_PUT_VAR( id_set_xz(av),                   &
+                                              id_var_do2d(av,if),              &
+                                              local_2d(nxl:nxr+1,nzb:nzt+1),   &
+                               start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
+                                              count = (/ nx+2, 1, nz+2, 1 /) )
+                      IF ( nc_stat /= NF90_NOERR )  &
+                                                  CALL handle_netcdf_error( 58 )
+                   ENDIF
+#endif
+#endif
+                   do2d_xz_n = do2d_xz_n + 1
+!
+!--                Write LOCAL-parameter set for ISO2D.
+                   IF ( myid == 0  .AND.  iso2d_output )  THEN
+                      IF ( section(is,s) /= -1 )  THEN
+                         WRITE ( section_chr, '(''y = '',F8.2,'' m  (GP '',I3, &
+                                               &'')'')'                        &
+                               )  section(is,s)*dy, section(is,s)
+                      ELSE
+                         section_chr = 'averaged along y'
+                      ENDIF
+                      IF ( av == 0 )  THEN
+                         rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
+                                 TRIM( simulated_time_chr ) // '  ' // &
+                                 TRIM( section_chr )
+                      ELSE
+                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
+                                 TRIM( simulated_time_chr ) // '  ' //       &
+                                 TRIM( section_chr )
+                      ENDIF
+                      WRITE (28,LOCAL)
+                   ENDIF
+
+                CASE ( 'yz' )
+!
+!--                Update the NetCDF xy cross section time axis
+                   IF ( myid == 0 )  THEN
+                      IF ( simulated_time /= do2d_yz_last_time(av) )  THEN
+                         do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
+                         do2d_yz_last_time(av)  = simulated_time
+                         IF ( .NOT. data_output_2d_on_each_pe  .AND. &
+                              netcdf_output )  THEN
+#if defined( __netcdf )
+                            nc_stat = NF90_PUT_VAR( id_set_yz(av),             &
+                                                    id_var_time_yz(av),        &
+                                                    (/ simulated_time /),      &
+                                         start = (/ do2d_yz_time_count(av) /), &
                                                     count = (/ 1 /) )
-                            CALL netcdf_handle_error( 'data_output_2d', 56 )
-#endif
-                         ENDIF
-                      ENDIF
-                   ENDIF
-
-!
-!--                If required, carry out averaging along y
-                   IF ( section(is,s_ind) == -1 )  THEN
-
-                      ALLOCATE( local_2d_l(nxl:nxr,nzb_do:nzt_do) )
-                      local_2d_l = 0.0_wp
-                      ngp = ( nxr-nxl + 1 ) * ( nzt_do-nzb_do + 1 )
+                            IF ( nc_stat /= NF90_NOERR )  THEN
+                               CALL handle_netcdf_error( 59 )
+                            ENDIF
+#endif
+                         ENDIF
+                      ENDIF
+                   ENDIF
+!
+!--                If required, carry out averaging along x
+                   IF ( section(is,s) == -1 )  THEN
+
+                      ALLOCATE( local_2d_l(nys-1:nyn+1,nzb:nzt+1) )
+                      local_2d_l = 0.0
+                      ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
 !
 !--                   First local averaging on the PE
-                      DO  k = nzb_do, nzt_do
-                         DO  j = nys, nyn
+                      DO  k = nzb, nzt+1
+                         DO  j = nys-1, nyn+1
                             DO  i = nxl, nxr
-                               local_2d_l(i,k) = local_2d_l(i,k) + local_pf(i,j,k)
+                               local_2d_l(j,k) = local_2d_l(j,k) + &
+                                                 local_pf(i,j,k)
                             ENDDO
                          ENDDO
@@ -1477,12 +1000,12 @@
 #if defined( __parallel )
 !
-!--                   Now do the averaging over all PEs along y
-                      IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-                      CALL MPI_ALLREDUCE( local_2d_l(nxl,nzb_do), local_2d(nxl,nzb_do), ngp,       &
-                                          MPI_REAL, MPI_SUM, comm1dy, ierr )
+!--                   Now do the averaging over all PEs along x
+                      CALL MPI_ALLREDUCE( local_2d_l(nys-1,nzb),              &
+                                          local_2d(nys-1,nzb), ngp, MPI_REAL, &
+                                          MPI_SUM, comm1dx, ierr )
 #else
                       local_2d = local_2d_l
 #endif
-                      local_2d = local_2d / ( ny + 1.0_wp )
+                      local_2d = local_2d / ( nx + 1.0 )
 
                       DEALLOCATE( local_2d_l )
@@ -1490,8 +1013,9 @@
                    ELSE
 !
-!--                   Just store the respective section on the local array (but only if it is
-!--                   available on this PE!)
-                      IF ( section(is,s_ind) >= nys  .AND.  section(is,s_ind) <= nyn )  THEN
-                         local_2d = local_pf(:,section(is,s_ind),nzb_do:nzt_do)
+!--                   Just store the respective section on the local array
+!--                   (but only if it is available on this PE!)
+                      IF ( section(is,s) >= nxl  .AND.  section(is,s) <= nxr ) &
+                      THEN
+                         local_2d = local_pf(section(is,s),:,nzb:nzt+1)
                       ENDIF
 
@@ -1499,330 +1023,150 @@
 
 #if defined( __parallel )
-                   IF ( netcdf_data_format > 4 )  THEN
-!
-!--                   Output in netCDF4/HDF5 format.
-!--                   Output only on those PEs where the respective cross sections reside. Cross
-!--                   sections averaged along y are output on the respective first PE along y
-!--                   (myidy=0).
-                      IF ( ( section(is,s_ind) >= nys .AND. section(is,s_ind) <= nyn )  .OR.       &
-                           ( section(is,s_ind) == -1 .AND. myidy == 0 ) )  THEN
-#if defined( __netcdf )
-!
-!--                      For parallel output, all cross sections are first stored here on a local
-!--                      array and will be written to the output file afterwards to increase the
-!--                      performance.
-                         DO  i = nxl, nxr
-                            DO  k = nzb_do, nzt_do
-                               local_2d_sections_l(i,is,k) = local_2d(i,k)
-                            ENDDO
+                   IF ( data_output_2d_on_each_pe )  THEN
+!
+!--                   Output of partial arrays on each PE. If the cross section 
+!--                   does not reside on the PE, output special index values.
+#if defined( __netcdf )
+                      IF ( netcdf_output  .AND.  myid == 0 )  THEN
+                         WRITE ( 23 )  simulated_time, do2d_yz_time_count(av), &
+                                       av
+                      ENDIF
+#endif
+                      IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) .OR.&
+                           ( section(is,s) ==  -1  .AND.  nxl-1 == -1 ) )      &
+                      THEN
+                         WRITE (23)  nys-1, nyn+1, nzb, nzt+1
+                         WRITE (23)  local_2d
+                      ELSE
+                         WRITE (23)  -1, -1, -1, -1
+                      ENDIF
+
+                   ELSE
+!
+!--                   PE0 receives partial arrays from all processors of the 
+!--                   respective cross section and outputs them. Here a
+!--                   barrier has to be set, because otherwise 
+!--                   "-MPI- FATAL: Remote protocol queue full" may occur.
+                      CALL MPI_BARRIER( comm2d, ierr )
+
+                      ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
+                      IF ( myid == 0 )  THEN
+!
+!--                      Local array can be relocated directly.
+                         IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr )  &
+                           .OR. ( section(is,s) ==  -1  .AND.  nxl-1 == -1 ) ) &
+                         THEN
+                            total_2d(nys-1:nyn+1,nzb:nzt+1) = local_2d
+                         ENDIF
+!
+!--                      Receive data from all other PEs.
+                         DO  n = 1, numprocs-1
+!
+!--                         Receive index limits first, then array.
+!--                         Index limits are received in arbitrary order from
+!--                         the PEs.
+                            CALL MPI_RECV( ind(1), 4, MPI_INTEGER,            &
+                                           MPI_ANY_SOURCE, 0, comm2d, status, &
+                                           ierr )
+!
+!--                         Not all PEs have data for YZ-cross-section.
+                            IF ( ind(1) /= -9999 )  THEN
+                               sender = status(MPI_SOURCE)
+                               DEALLOCATE( local_2d )
+                               ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
+                               CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
+                                              MPI_REAL, sender, 1, comm2d,  &
+                                              status, ierr )
+                               total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
+                            ENDIF
                          ENDDO
-#endif
-                      ENDIF
-
-                   ELSE
-
-                      IF ( data_output_2d_on_each_pe )  THEN
-!
-!--                      Output of partial arrays on each PE. If the cross section does not reside
-!--                      on the PE, output special index values.
-#if defined( __netcdf )
-                         IF ( myid == 0 )  THEN
-                            WRITE ( 22 )  time_since_reference_point, do2d_xz_time_count(av), av
-                         ENDIF
-#endif
-                         DO  i = 0, io_blocks-1
-                            IF ( i == io_group )  THEN
-                               IF ( ( section(is,s_ind) >= nys .AND. section(is,s_ind) <= nyn )    &
-                                    .OR.  ( section(is,s_ind) == -1 .AND. nys-1 == -1 ) )  THEN
-                                  WRITE (22)  nxl, nxr, nzb_do, nzt_do, nzb, nzt+1
-                                  WRITE (22)  local_2d
-                               ELSE
-                                  WRITE (22)  -1, -1, -1, -1, -1, -1
-                               ENDIF
-                            ENDIF
-#if defined( __parallel )
-                            CALL MPI_BARRIER( comm2d, ierr )
-#endif
-                         ENDDO
+!
+!--                      Output of the total cross-section.
+                         IF ( iso2d_output )  THEN
+                            WRITE (23)  total_2d(0:ny+1,nzb:nzt+1)
+                         ENDIF
+!
+!--                      Relocate the local array for the next loop increment
+                         DEALLOCATE( local_2d )
+                         ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) )
+
+#if defined( __netcdf )
+                         IF ( netcdf_output )  THEN
+                            nc_stat = NF90_PUT_VAR( id_set_yz(av),             &
+                                                    id_var_do2d(av,if),        &
+                                                    total_2d(0:ny+1,nzb:nzt+1),&
+                               start = (/ is, 1, 1, do2d_yz_time_count(av) /), &
+                                                count = (/ 1, ny+2, nz+2, 1 /) )
+                            IF ( nc_stat /= NF90_NOERR ) &
+                                                  CALL handle_netcdf_error( 60 )
+                         ENDIF
+#endif
 
                       ELSE
 !
-!--                      PE0 receives partial arrays from all processors of the respective cross
-!--                      section and outputs them. Here a barrier has to be set, because otherwise
-!--                      "-MPI- FATAL: Remote protocol queue full" may occur.
-                         CALL MPI_BARRIER( comm2d, ierr )
-
-                         ngp = ( nxr-nxl + 1 ) * ( nzt_do-nzb_do + 1 )
-                         IF ( myid == 0 )  THEN
-!
-!--                         Local array can be relocated directly.
-                            IF ( ( section(is,s_ind) >= nys .AND. section(is,s_ind) <= nyn )  .OR. &
-                                 ( section(is,s_ind) == -1 .AND. nys-1 == -1 ) )  THEN
-                               total_2d(nxl:nxr,nzb_do:nzt_do) = local_2d
-                            ENDIF
-!
-!--                         Receive data from all other PEs.
-                            DO  n = 1, numprocs-1
-!
-!--                            Receive index limits first, then array.
-!--                            Index limits are received in arbitrary order from the PEs.
-                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER, MPI_ANY_SOURCE, 0, comm2d,   &
-                                              status, ierr )
-!
-!--                            Not all PEs have data for XZ-cross-section.
-                               IF ( ind(1) /= -9999 )  THEN
-                                  sender = status(MPI_SOURCE)
-                                  DEALLOCATE( local_2d )
-                                  ALLOCATE( local_2d(ind(1):ind(2), ind(3):ind(4)) )
-                                  CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, MPI_REAL, sender, 1,&
-                                                 comm2d, status, ierr )
-                                  total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
-                               ENDIF
-                            ENDDO
-!
-!--                         Relocate the local array for the next loop increment
-                            DEALLOCATE( local_2d )
-                            ALLOCATE( local_2d(nxl:nxr,nzb_do:nzt_do) )
-
-#if defined( __netcdf )
-                            nc_stat = NF90_PUT_VAR( id_set_xz(av),                                 &
-                                                    id_var_do2d(av,ivar),                          &
-                                                    total_2d(0:nx,nzb_do:nzt_do),                  &
-                                                    start = (/ 1, is, 1, do2d_xz_time_count(av) /),&
-                                                    count = (/ nx+1, 1, nzt_do-nzb_do+1, 1 /) )
-                            CALL netcdf_handle_error( 'data_output_2d', 58 )
-#endif
-
+!--                      If the cross section resides on the PE, send the
+!--                      local index limits, otherwise send -9999 to PE0.
+                         IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr )  &
+                           .OR. ( section(is,s) ==  -1  .AND.  nxl-1 == -1 ) ) &
+                         THEN
+                            ind(1) = nys-1; ind(2) = nyn+1
+                            ind(3) = nzb;   ind(4) = nzt+1
                          ELSE
-!
-!--                         If the cross section resides on the PE, send the local index limits,
-!--                         otherwise send -9999 to PE0.
-                            IF ( ( section(is,s_ind) >= nys .AND. section(is,s_ind) <= nyn )  .OR. &
-                                 ( section(is,s_ind) == -1 .AND. nys-1 == -1 ) )  THEN
-                               ind(1) = nxl; ind(2) = nxr
-                               ind(3) = nzb_do;   ind(4) = nzt_do
-                            ELSE
-                               ind(1) = -9999; ind(2) = -9999
-                               ind(3) = -9999; ind(4) = -9999
-                            ENDIF
-                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, ierr )
-!
-!--                         If applicable, send data to PE0.
-                            IF ( ind(1) /= -9999 )  THEN
-                               CALL MPI_SEND( local_2d(nxl,nzb_do), ngp, MPI_REAL, 0, 1, comm2d,   &
-                                              ierr )
-                            ENDIF
-                         ENDIF
-!
-!--                      A barrier has to be set, because otherwise some PEs may proceed too fast so
-!--                      that PE0 may receive wrong data on tag 0
-                         CALL MPI_BARRIER( comm2d, ierr )
-                      ENDIF
-
+                            ind(1) = -9999; ind(2) = -9999
+                            ind(3) = -9999; ind(4) = -9999
+                         ENDIF
+                         CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
+                                        ierr )
+!
+!--                      If applicable, send data to PE0.
+                         IF ( ind(1) /= -9999 )  THEN
+                            CALL MPI_SEND( local_2d(nys-1,nzb), ngp, MPI_REAL, &
+                                           0, 1, comm2d, ierr )
+                         ENDIF
+                      ENDIF
+!
+!--                   A barrier has to be set, because otherwise some PEs may
+!--                   proceed too fast so that PE0 may receive wrong data on
+!--                   tag 0
+                      CALL MPI_BARRIER( comm2d, ierr )
                    ENDIF
 #else
-#if defined( __netcdf )
-                   nc_stat = NF90_PUT_VAR( id_set_xz(av),                                          &
-                                           id_var_do2d(av,ivar),                                   &
-                                           local_2d(nxl:nxr,nzb_do:nzt_do),                        &
-                                           start = (/ 1, is, 1, do2d_xz_time_count(av) /),         &
-                                           count = (/ nx+1, 1, nzt_do-nzb_do+1, 1 /) )
-                   CALL netcdf_handle_error( 'data_output_2d', 451 )
-#endif
-#endif
-
-                CASE ( 'yz' )
-!
-!--                Update the netCDF yz cross section time axis.
-!--                In case of parallel output, this is only done by PE0 to increase the performance.
-                   IF ( time_since_reference_point /= do2d_yz_last_time(av) )  THEN
-                      do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
-                      do2d_yz_last_time(av)  = time_since_reference_point
-                      IF ( myid == 0 )  THEN
-                         IF ( .NOT. data_output_2d_on_each_pe  .OR.  netcdf_data_format > 4 )  THEN
-#if defined( __netcdf )
-                            nc_stat = NF90_PUT_VAR( id_set_yz(av),                                 &
-                                                    id_var_time_yz(av),                            &
-                                                    (/ time_since_reference_point /),              &
-                                                    start = (/ do2d_yz_time_count(av) /),          &
-                                                    count = (/ 1 /) )
-                            CALL netcdf_handle_error( 'data_output_2d', 59 )
-#endif
-                         ENDIF
-                      ENDIF
-                   ENDIF
-
-!
-!--                If required, carry out averaging along x
-                   IF ( section(is,s_ind) == -1 )  THEN
-
-                      ALLOCATE( local_2d_l(nys:nyn,nzb_do:nzt_do) )
-                      local_2d_l = 0.0_wp
-                      ngp = ( nyn-nys+1 ) * ( nzt_do-nzb_do+1 )
-!
-!--                   First local averaging on the PE
-                      DO  k = nzb_do, nzt_do
-                         DO  j = nys, nyn
-                            DO  i = nxl, nxr
-                               local_2d_l(j,k) = local_2d_l(j,k) + local_pf(i,j,k)
-                            ENDDO
-                         ENDDO
-                      ENDDO
-#if defined( __parallel )
-!
-!--                   Now do the averaging over all PEs along x
-                      IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-                      CALL MPI_ALLREDUCE( local_2d_l(nys,nzb_do), local_2d(nys,nzb_do), ngp,       &
-                                          MPI_REAL, MPI_SUM, comm1dx, ierr )
-#else
-                      local_2d = local_2d_l
-#endif
-                      local_2d = local_2d / ( nx + 1.0_wp )
-
-                      DEALLOCATE( local_2d_l )
-
-                   ELSE
-!
-!--                   Just store the respective section on the local array (but only if it is
-!--                   available on this PE!)
-                      IF ( section(is,s_ind) >= nxl  .AND.  section(is,s_ind) <= nxr )  THEN
-                         local_2d = local_pf(section(is,s_ind),:,nzb_do:nzt_do)
-                      ENDIF
-
-                   ENDIF
-
-#if defined( __parallel )
-                   IF ( netcdf_data_format > 4 )  THEN
-!
-!--                   Output in netCDF4/HDF5 format.
-!--                   Output only on those PEs where the respective cross sections reside. Cross
-!--                   sections averaged along x are output on the respective first PE along x
-!--                   (myidx=0).
-                      IF ( ( section(is,s_ind) >= nxl .AND. section(is,s_ind) <= nxr )  .OR.       &
-                           ( section(is,s_ind) == -1 .AND. myidx == 0 ) )  THEN
-#if defined( __netcdf )
-!
-!--                      For parallel output, all cross sections are first stored here on a local
-!--                      array and will be written to the output file afterwards to increase the
-!--                      performance.
-                         DO  j = nys, nyn
-                            DO  k = nzb_do, nzt_do
-                               local_2d_sections_l(is,j,k) = local_2d(j,k)
-                            ENDDO
-                         ENDDO
-#endif
-                      ENDIF
-
-                   ELSE
-
-                      IF ( data_output_2d_on_each_pe )  THEN
-!
-!--                      Output of partial arrays on each PE. If the cross section does not reside
-!--                      on the PE, output special index values.
-#if defined( __netcdf )
-                         IF ( myid == 0 )  THEN
-                            WRITE ( 23 )  time_since_reference_point, do2d_yz_time_count(av), av
-                         ENDIF
-#endif
-                         DO  i = 0, io_blocks-1
-                            IF ( i == io_group )  THEN
-                               IF ( ( section(is,s_ind) >= nxl .AND. section(is,s_ind) <= nxr )    &
-                                    .OR.  ( section(is,s_ind) == -1 .AND. nxl-1 == -1 ) )  THEN
-                                  WRITE (23)  nys, nyn, nzb_do, nzt_do, nzb, nzt+1
-                                  WRITE (23)  local_2d
-                               ELSE
-                                  WRITE (23)  -1, -1, -1, -1, -1, -1
-                               ENDIF
-                            ENDIF
-#if defined( __parallel )
-                            CALL MPI_BARRIER( comm2d, ierr )
-#endif
-                         ENDDO
-
+                   IF ( iso2d_output )  THEN
+                      WRITE (23)  local_2d(nys:nyn+1,nzb:nzt+1)
+                   ENDIF
+#if defined( __netcdf )
+                   IF ( netcdf_output )  THEN
+                      nc_stat = NF90_PUT_VAR( id_set_yz(av),                   &
+                                              id_var_do2d(av,if),              &
+                                              local_2d(nys:nyn+1,nzb:nzt+1),   &
+                               start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
+                                              count = (/ 1, ny+2, nz+2, 1 /) )
+                      IF ( nc_stat /= NF90_NOERR )  &
+                                                  CALL handle_netcdf_error( 61 )
+                   ENDIF
+#endif
+#endif
+                   do2d_yz_n = do2d_yz_n + 1
+!
+!--                Write LOCAL-parameter set for ISO2D.
+                   IF ( myid == 0  .AND.  iso2d_output )  THEN
+                      IF ( section(is,s) /= -1 )  THEN
+                         WRITE ( section_chr, '(''x = '',F8.2,'' m  (GP '',I3, &
+                                               &'')'')'                        &
+                               )  section(is,s)*dx, section(is,s)
                       ELSE
-!
-!--                      PE0 receives partial arrays from all processors of the respective cross
-!--                      section and outputs them. Here a barrier has to be set, because otherwise
-!--                      "-MPI- FATAL: Remote protocol queue full" may occur.
-                         CALL MPI_BARRIER( comm2d, ierr )
-
-                         ngp = ( nyn-nys+1 ) * ( nzt_do-nzb_do+1 )
-                         IF ( myid == 0 )  THEN
-!
-!--                         Local array can be relocated directly.
-                            IF ( ( section(is,s_ind) >= nxl .AND. section(is,s_ind) <= nxr )  .OR. &
-                                 ( section(is,s_ind) == -1 .AND. nxl-1 == -1 ) )  THEN
-                               total_2d(nys:nyn,nzb_do:nzt_do) = local_2d
-                            ENDIF
-!
-!--                         Receive data from all other PEs.
-                            DO  n = 1, numprocs-1
-!
-!--                            Receive index limits first, then array.
-!--                            Index limits are received in arbitrary order from the PEs.
-                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER, MPI_ANY_SOURCE, 0, comm2d,   &
-                                              status, ierr )
-!
-!--                            Not all PEs have data for YZ-cross-section.
-                               IF ( ind(1) /= -9999 )  THEN
-                                  sender = status(MPI_SOURCE)
-                                  DEALLOCATE( local_2d )
-                                  ALLOCATE( local_2d(ind(1):ind(2), ind(3):ind(4)) )
-                                  CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, MPI_REAL, sender, 1,&
-                                                 comm2d, status, ierr )
-                                  total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
-                               ENDIF
-                            ENDDO
-!
-!--                         Relocate the local array for the next loop increment
-                            DEALLOCATE( local_2d )
-                            ALLOCATE( local_2d(nys:nyn,nzb_do:nzt_do) )
-
-#if defined( __netcdf )
-                            nc_stat = NF90_PUT_VAR( id_set_yz(av),                                 &
-                                                    id_var_do2d(av,ivar),                          &
-                                                    total_2d(0:ny,nzb_do:nzt_do),                  &
-                                                    start = (/ is, 1, 1, do2d_yz_time_count(av) /),&
-                                                    count = (/ 1, ny+1, nzt_do-nzb_do+1, 1 /) )
-                            CALL netcdf_handle_error( 'data_output_2d', 61 )
-#endif
-
-                         ELSE
-!
-!--                         If the cross section resides on the PE, send the
-!--                         local index limits, otherwise send -9999 to PE0.
-                            IF ( ( section(is,s_ind) >= nxl .AND. section(is,s_ind) <= nxr )  .OR. &
-                                 ( section(is,s_ind) == -1 .AND. nxl-1 == -1 ) )  THEN
-                               ind(1) = nys; ind(2) = nyn
-                               ind(3) = nzb_do;   ind(4) = nzt_do
-                            ELSE
-                               ind(1) = -9999; ind(2) = -9999
-                               ind(3) = -9999; ind(4) = -9999
-                            ENDIF
-                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, ierr )
-!
-!--                         If applicable, send data to PE0.
-                            IF ( ind(1) /= -9999 )  THEN
-                               CALL MPI_SEND( local_2d(nys,nzb_do), ngp, MPI_REAL, 0, 1, comm2d,   &
-                                              ierr )
-                            ENDIF
-                         ENDIF
-!
-!--                      A barrier has to be set, because otherwise some PEs may proceed too fast so
-!--                      that PE0 may receive wrong data on tag 0
-                         CALL MPI_BARRIER( comm2d, ierr )
-                      ENDIF
-
-                   ENDIF
-#else
-#if defined( __netcdf )
-                   nc_stat = NF90_PUT_VAR( id_set_yz(av),                                          &
-                                           id_var_do2d(av,ivar),                                   &
-                                           local_2d(nys:nyn,nzb_do:nzt_do),                        &
-                                           start = (/ is, 1, 1, do2d_xz_time_count(av) /),         &
-                                           count = (/ 1, ny+1, nzt_do-nzb_do+1, 1 /) )
-                   CALL netcdf_handle_error( 'data_output_2d', 452 )
-#endif
-#endif
+                         section_chr = 'averaged along x'
+                      ENDIF
+                      IF ( av == 0 )  THEN
+                         rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
+                                 TRIM( simulated_time_chr ) // '  ' // &
+                                 TRIM( section_chr )
+                      ELSE
+                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
+                                 TRIM( simulated_time_chr ) // '  ' //       &
+                                 TRIM( section_chr )
+                      ENDIF
+                      WRITE (29,LOCAL)
+                   ENDIF
 
              END SELECT
@@ -1831,164 +1175,9 @@
           ENDDO loop1
 
-!
-!--       For parallel output, all data were collected before on a local array and are written now
-!--       to the netcdf file. This must be done to increase the performance of the parallel output.
-#if defined( __netcdf )
-          IF ( netcdf_data_format > 4 )  THEN
-
-                SELECT CASE ( mode )
-
-                   CASE ( 'xy' )
-                      IF ( two_d )  THEN
-                         nis = 1
-                         two_d = .FALSE.
-                      ELSE
-                         nis = ns
-                      ENDIF
-!
-!--                   Do not output redundant ghost point data except for the boundaries of the
-!--                   total domain.
-!                      IF ( nxr == nx  .AND.  nyn /= ny )  THEN
-!                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
-!                                                 id_var_do2d(av,ivar),           &
-!                                                 local_2d_sections(nxl:nxr+1,  &
-!                                                    nys:nyn,1:nis),            &
-!                                                 start = (/ nxl+1, nys+1, 1,   &
-!                                                    do2d_xy_time_count(av) /), &
-!                                                 count = (/ nxr-nxl+2,         &
-!                                                            nyn-nys+1, nis, 1  &
-!                                                          /) )
-!                      ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
-!                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
-!                                                 id_var_do2d(av,ivar),           &
-!                                                 local_2d_sections(nxl:nxr,    &
-!                                                    nys:nyn+1,1:nis),          &
-!                                                 start = (/ nxl+1, nys+1, 1,   &
-!                                                    do2d_xy_time_count(av) /), &
-!                                                 count = (/ nxr-nxl+1,         &
-!                                                            nyn-nys+2, nis, 1  &
-!                                                          /) )
-!                      ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
-!                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
-!                                                 id_var_do2d(av,ivar),           &
-!                                                 local_2d_sections(nxl:nxr+1,  &
-!                                                    nys:nyn+1,1:nis),          &
-!                                                 start = (/ nxl+1, nys+1, 1,   &
-!                                                    do2d_xy_time_count(av) /), &
-!                                                 count = (/ nxr-nxl+2,         &
-!                                                            nyn-nys+2, nis, 1  &
-!                                                          /) )
-!                      ELSE
-                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                                    &
-                                                 id_var_do2d(av,ivar),                             &
-                                                 local_2d_sections(nxl:nxr, nys:nyn,1:nis),        &
-                                                 start = (/ nxl+1, nys+1, 1,                       &
-                                                            do2d_xy_time_count(av) /),             &
-                                                 count = (/ nxr-nxl+1, nyn-nys+1, nis, 1 /) )
-!                      ENDIF
-
-                      CALL netcdf_handle_error( 'data_output_2d', 55 )
-
-                   CASE ( 'xz' )
-!
-!--                   First, all PEs get the information of all cross-sections.
-!--                   Then the data are written to the output file by all PEs while NF90_COLLECTIVE
-!--                   is set in subroutine define_netcdf_header. Although redundant information are
-!--                   written to the output file in that case, the performance is significantly
-!--                   better compared to the case where only the first row of PEs in x-direction
-!--                   (myidx = 0) is given the output while NF90_INDEPENDENT is set.
-                      IF ( npey /= 1 )  THEN
-
-#if defined( __parallel )
-!
-!--                      Distribute data over all PEs along y
-                         ngp = ( nxr-nxl+1 ) * ( nzt_do-nzb_do+1 ) * ns
-                         IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-                         CALL MPI_ALLREDUCE( local_2d_sections_l(nxl,1,nzb_do),                    &
-                                             local_2d_sections(nxl,1,nzb_do),                      &
-                                             ngp, MPI_REAL, MPI_SUM, comm1dy, ierr )
-#else
-                         local_2d_sections = local_2d_sections_l
-#endif
-                      ENDIF
-!
-!--                   Do not output redundant ghost point data except for the boundaries of the
-!--                   total domain.
-!                      IF ( nxr == nx )  THEN
-!                         nc_stat = NF90_PUT_VAR( id_set_xz(av),                &
-!                                             id_var_do2d(av,ivar),               &
-!                                             local_2d_sections(nxl:nxr+1,1:ns, &
-!                                                nzb_do:nzt_do),                &
-!                                             start = (/ nxl+1, 1, 1,           &
-!                                                do2d_xz_time_count(av) /),     &
-!                                             count = (/ nxr-nxl+2, ns, nzt_do-nzb_do+1,  &
-!                                                        1 /) )
-!                      ELSE
-                         nc_stat = NF90_PUT_VAR( id_set_xz(av),                                    &
-                                                 id_var_do2d(av,ivar),                             &
-                                                 local_2d_sections(nxl:nxr,1:ns, nzb_do:nzt_do),   &
-                                                 start = (/ nxl+1, 1, 1, do2d_xz_time_count(av) /),&
-                                                 count = (/ nxr-nxl+1, ns, nzt_do-nzb_do+1, 1 /) )
-!                      ENDIF
-
-                      CALL netcdf_handle_error( 'data_output_2d', 57 )
-
-                   CASE ( 'yz' )
-!
-!--                   First, all PEs get the information of all cross-sections.
-!--                   Then the data are written to the output file by all PEs while NF90_COLLECTIVE
-!--                   is set in subroutine define_netcdf_header. Although redundant information are
-!--                   written to the output file in that case, the performance is significantly
-!--                   better compared to the case where only the first row of PEs in y-direction
-!--                   (myidy = 0) is given the output while NF90_INDEPENDENT is set.
-                      IF ( npex /= 1 )  THEN
-
-#if defined( __parallel )
-!
-!--                      Distribute data over all PEs along x
-                         ngp = ( nyn-nys+1 ) * ( nzt-nzb + 2 ) * ns
-                         IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
-                         CALL MPI_ALLREDUCE( local_2d_sections_l(1,nys,nzb_do),                    &
-                                             local_2d_sections(1,nys,nzb_do),                      &
-                                             ngp, MPI_REAL, MPI_SUM, comm1dx, ierr )
-#else
-                         local_2d_sections = local_2d_sections_l
-#endif
-                      ENDIF
-!
-!--                   Do not output redundant ghost point data except for the boundaries of the
-!--                   total domain.
-!                      IF ( nyn == ny )  THEN
-!                         nc_stat = NF90_PUT_VAR( id_set_yz(av),                &
-!                                             id_var_do2d(av,ivar),               &
-!                                             local_2d_sections(1:ns,           &
-!                                                nys:nyn+1,nzb_do:nzt_do),      &
-!                                             start = (/ 1, nys+1, 1,           &
-!                                                do2d_yz_time_count(av) /),     &
-!                                             count = (/ ns, nyn-nys+2,         &
-!                                                        nzt_do-nzb_do+1, 1 /) )
-!                      ELSE
-                         nc_stat = NF90_PUT_VAR( id_set_yz(av),                                    &
-                                                 id_var_do2d(av,ivar),                             &
-                                                 local_2d_sections(1:ns,nys:nyn, nzb_do:nzt_do),   &
-                                                 start = (/ 1, nys+1, 1, do2d_yz_time_count(av) /),&
-                                                 count = (/ ns, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
-!                      ENDIF
-
-                      CALL netcdf_handle_error( 'data_output_2d', 60 )
-
-                   CASE DEFAULT
-                      message_string = 'unknown cross-section: ' // TRIM( mode )
-                      CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
-
-                END SELECT
-
-          ENDIF
-#endif
        ENDIF
 
-       ivar = ivar + 1
-       l = MAX( 2, LEN_TRIM( do2d(av,ivar) ) )
-       do2d_mode = do2d(av,ivar)(l-1:l)
+       if = if + 1
+       l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
+       do2d_mode = do2d(av,if)(l-1:l)
 
     ENDDO
@@ -1997,10 +1186,7 @@
 !-- Deallocate temporary arrays.
     IF ( ALLOCATED( level_z ) )  DEALLOCATE( level_z )
-    IF ( netcdf_data_format > 4 )  THEN
-       DEALLOCATE( local_pf, local_2d, local_2d_sections )
-       IF( mode == 'xz'  .OR.  mode == 'yz' )  DEALLOCATE( local_2d_sections_l )
-    ENDIF
+    DEALLOCATE( local_pf, local_2d )
 #if defined( __parallel )
-    IF ( .NOT. data_output_2d_on_each_pe  .AND.  myid == 0 )  THEN
+    IF ( .NOT.  data_output_2d_on_each_pe  .AND.  myid == 0 )  THEN
        DEALLOCATE( total_2d )
     ENDIF
@@ -2009,23 +1195,14 @@
 !
 !-- Close plot output file.
-    file_id = 20 + s_ind
+    file_id = 20 + s
 
     IF ( data_output_2d_on_each_pe )  THEN
-       DO  i = 0, io_blocks-1
-          IF ( i == io_group )  THEN
-             CALL close_file( file_id )
-          ENDIF
-#if defined( __parallel )
-          CALL MPI_BARRIER( comm2d, ierr )
-#endif
-       ENDDO
+       CALL close_file( file_id )
     ELSE
        IF ( myid == 0 )  CALL close_file( file_id )
     ENDIF
 
-    CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
-
-    IF ( debug_output_timestep )  CALL debug_message( 'data_output_2d', 'end' )
-
+
+    CALL cpu_log (log_point(3),'data_output_2d','stop','nobarrier')
 
  END SUBROUTINE data_output_2d
Index: palm/trunk/SOURCE/data_output_3d.f90
===================================================================
--- palm/trunk/SOURCE/data_output_3d.f90	(revision 4901)
+++ palm/trunk/SOURCE/data_output_3d.f90	(revision 1)
@@ -1,82 +1,59 @@
-!> @file data_output_3d.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
+ SUBROUTINE data_output_3d( av )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Keep 32-bit output for netcdf_data_output < 5
-!
-! 4768 2020-11-02 19:11:23Z suehring
-! Enable 3D data output also with 64-bit precision
+! $Log: data_output_3d.f90,v $
+! Revision 1.3  2006/06/02 15:18:59  raasch
+! +argument "found", -argument grid in call of routine user_data_output_3d
+!
+! Revision 1.2  2006/02/23 10:23:07  raasch
+! Former subroutine plot_3d renamed data_output_3d, pl.. renamed do..,
+! .._anz renamed .._n,
+! output extended to (almost) all quantities, output of user-defined quantities
+!
+! Revision 1.1  2006/02/23 10:21:34  raasch
+! Initial revision
+!
+! Revision 1.13  2005/06/26 20:08:36  raasch
+! +ql_c, ql_v, ql_vp
+!
+! Revision 1.12  2005/05/18 15:47:34  raasch
+! Extensions for NetCDF output
+!
+! Revision 1.11  2003/03/16 09:42:31  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.10  2002/06/11 13:13:27  raasch
+! TRIM function added (needed on IBM-systems)
+!
+! Revision 1.9  2002/04/16  08:11:50  08:11:50  raasch (Siegfried Raasch)
+! Output of scalar field s allowed
 ! 
-! 4559 2020-06-11 08:51:48Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4162 2019-08-16 05:54:29Z raasch
-! bugfix for r4155
-!
-! 4155 2019-08-14 06:25:18Z raasch
-! bugfix for 3d-output in serial mode (ghost points must not be written)
-!
-! 4127 2019-07-30 14:47:10Z suehring
-! Adjustment for top boundary index for plant-canopy model outputs (merge from branch resler)
-!
-! 4048 2019-06-21 21:00:21Z knoop
-! Moved tcm_data_output_3d to module_interface
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! modularize diagnostic output
-!
-! 3994 2019-05-22 18:08:09Z suehring
-! output of turbulence intensity added
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3814 2019-03-26 08:40:31Z pavelkrc
-! unused variables removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Bugfix: use time_since_reference_point instead of simulated_time (relevant when using wall/soil
-!         spinup)
+! Revision 1.8  2001/03/30 07:44:45  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.7  2001/03/09 21:46:23  letzel
+! All comments translated into English.
+!
+! Revision 1.6  2001/01/22 07:40:10  raasch
+! Module test_variables removed
+!
+! Revision 1.5  2000/04/13 14:02:39  schroeter
+! Plotausgabe fuer Gesamtwasser- und Fluessigwassergehalt sowie potentielle
+! Fluessigwassertemperatur
+!
+! Revision 1.4  99/03/02  09:24:51  09:24:51  raasch (Siegfried Raasch)
+! Datenkompression implementiert
+! 
+! Revision 1.3  1998/07/06 12:26:35  raasch
+! + USE test_variables
+!
+! Revision 1.2  1998/03/09 16:24:33  raasch
+! simulated_time_mod verlaengert
 !
 ! Revision 1.1  1997/09/03 06:29:36  raasch
@@ -86,100 +63,32 @@
 ! Description:
 ! ------------
-!> Output of the 3D-arrays in netCDF and/or AVS format.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE data_output_3d( av )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  d_exner, e, p, pt, q, ql, ql_c, ql_v, s, tend, u, v, vpt, w
-
+! Output of the 3D-arrays in NetCDF and/or AVS format.
+!------------------------------------------------------------------------------!
+
+    USE array_kind
+    USE arrays_3d
     USE averaging
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  lv_d_cp
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    USE control_parameters,                                                                        &
-        ONLY:  debug_output_timestep, do3d, do3d_no, do3d_time_count, land_surface, message_string,&
-               ntdim_3d, nz_do3d, plant_canopy, psolver, time_since_reference_point, urban_surface,&
-               varnamelength
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  io_blocks, io_group
-#endif
-
-    USE cpulog,                                                                                    &
-        ONLY: cpu_log, log_point
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, wall_flags_total_0
-
-#if ! defined( __parallel )
-    USE indices,                                                                                   &
-        ONLY:  nx, ny
-#endif
-
-    USE kinds
-
-    USE land_surface_model_mod,                                                                    &
-        ONLY: lsm_data_output_3d, nzb_soil, nzt_soil
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_data_output_3d
-
-#if defined( __netcdf )
-    USE NETCDF
-#endif
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  fill_value, id_set_3d, id_var_do3d, id_var_time_3d, nc_stat, netcdf_data_format,    &
-               netcdf_handle_error
-
-    USE particle_attributes,                                                                       &
-        ONLY:  grid_particles, number_of_particles, particles, particle_advection_start, prt_count
-
+    USE cloud_parameters
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE netcdf_control
+    USE particle_attributes
     USE pegrid
 
-    USE plant_canopy_model_mod,                                                                    &
-        ONLY:  pch_index
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  nz_urban_b, nz_urban_t
-
-    USE urban_surface_mod,                                                                         &
-        ONLY:  usm_data_output_3d
-
-
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  av        !< flag for (non-)average output
-    INTEGER(iwp) ::  flag_nr   !< number of masking flag
-    INTEGER(iwp) ::  i         !< loop index
-    INTEGER(iwp) ::  ivar      !< variable index
-    INTEGER(iwp) ::  j         !< loop index
-    INTEGER(iwp) ::  k         !< loop index
-    INTEGER(iwp) ::  n         !< loop index
-    INTEGER(iwp) ::  nzb_do    !< vertical lower limit for data output
-    INTEGER(iwp) ::  nzt_do    !< vertical upper limit for data output
-
-    LOGICAL      ::  found     !< true if output variable was found
-    LOGICAL      ::  resorted  !< true if variable is resorted
-
-    REAL(wp)     ::  mean_r    !< mean particle radius
-    REAL(wp)     ::  s_r2      !< sum( particle-radius**2 )
-    REAL(wp)     ::  s_r3      !< sum( particle-radius**3 )
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf  !< output array
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< pointer to array which shall be
-                                                            !< output
-
-    CHARACTER (LEN=varnamelength) ::  trimvar  !< TRIM of output-variable string
+    CHARACTER (LEN=9) ::  simulated_time_mod
+
+    INTEGER           ::  av, i, if, j, k, n, pos, prec, psi
+
+    LOGICAL           ::  found, resorted
+
+    REAL              ::  mean_r, s_r3, s_r4
+
+    REAL(spk), DIMENSION(:,:,:), ALLOCATABLE  ::  local_pf
+
+    REAL, DIMENSION(:,:,:), POINTER ::  to_be_resorted
 
 !
@@ -187,50 +96,34 @@
     IF ( do3d_no(av) == 0 )  RETURN
 
-    IF ( debug_output_timestep )  CALL debug_message( 'data_output_3d', 'start' )
-
     CALL cpu_log (log_point(14),'data_output_3d','start')
 
 !
 !-- Open output file.
-!-- For classic or 64bit netCDF output on more than one PE, each PE opens its own file and writes
-!-- the data of its subdomain in binary format. After the run, these files are combined to one
-!-- NetCDF file by combine_plot_fields.
-!-- For netCDF4/HDF5 output, data is written in parallel into one file.
-    IF ( netcdf_data_format < 5 )  THEN
-#if defined( __parallel )
-       CALL check_open( 30 )
+!-- Also creates coordinate and fld-file for AVS.
+!-- In case of a run on more than one PE, each PE opens its own file and
+!-- writes the data of its subdomain in binary format (regardless of the format
+!-- the user has requested). After the run, these files are combined to one
+!-- file by combine_plot_fields in the format requested by the user (netcdf
+!-- and/or avs). 
+    IF ( avs_output  .OR.  ( numprocs > 1 ) )  CALL check_open( 30 )
+
+#if defined( __netcdf )
+    IF ( myid == 0  .AND.  netcdf_output )  CALL check_open( 106+av*10 )
 #endif
-       IF ( myid == 0 )  CALL check_open( 106+av*10 )
-    ELSE
-       CALL check_open( 106+av*10 )
-    ENDIF
-
-!
-!-- For parallel netcdf output the time axis must be limited. Return, if this limit is exceeded.
-!-- This could be the case, if the simulated time exceeds the given end time by the length of the
-!-- given output interval.
-    IF ( netcdf_data_format > 4 )  THEN
-       IF ( do3d_time_count(av) + 1 > ntdim_3d(av) )  THEN
-          WRITE ( message_string, * ) 'Output of 3d data is not given at t=',                      &
-                                      time_since_reference_point, 's because the maximum ',        &
-                                      'number of output time levels is ',                          &
-                                      'exceeded.'
-          CALL message( 'data_output_3d', 'PA0387', 0, 1, 0, 6, 0 )
-          CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
-          RETURN
-       ENDIF
-    ENDIF
-
-!
-!-- Update the netCDF time axis.
-!-- In case of parallel output, this is only done by PE0 to increase the performance.
+
+!
+!-- Allocate a temporary array with the desired output dimensions.
+    ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do3d) )
+
+!
+!-- Update the NetCDF time axis
 #if defined( __netcdf )
     do3d_time_count(av) = do3d_time_count(av) + 1
-    IF ( myid == 0 )  THEN
-       nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av),                                  &
-                               (/ time_since_reference_point /),                                   &
-                               start = (/ do3d_time_count(av) /),                                  &
+    IF ( myid == 0  .AND.  netcdf_output )  THEN
+       nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), &
+                               (/ simulated_time /),              &
+                               start = (/ do3d_time_count(av) /), &
                                count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_3d', 376 )
+       IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 1009 )
     ENDIF
 #endif
@@ -238,39 +131,22 @@
 !
 !-- Loop over all variables to be written.
-    ivar = 1
-
-    DO  WHILE ( do3d(av,ivar)(1:1) /= ' ' )
-
-!
-!--    Initiate found flag and resorting flag
-       found = .FALSE.
+    if = 1
+
+    DO  WHILE ( do3d(av,if)(1:1) /= ' ' )
+!
+!--    Set the precision for data compression.
+       IF ( do3d_compress )  THEN
+          DO  i = 1, 100
+             IF ( plot_3d_precision(i)%variable == do3d(av,if) )  THEN
+                prec = plot_3d_precision(i)%precision
+                EXIT
+             ENDIF
+          ENDDO
+       ENDIF
+
+!
+!--    Store the array chosen on the temporary array.
        resorted = .FALSE.
-       trimvar = TRIM( do3d(av,ivar) )
-
-!
-!--    Temporary solution to account for data output within the new urban surface model
-!--    (urban_surface_mod.f90), see also SELECT CASE ( trimvar ).
-!--    Store the array chosen on the temporary array.
-       nzb_do   = nzb
-!
-!--    Set top index for 3D output. Note in case of plant-canopy model these index is determined by
-!--    pch_index.
-       IF ( plant_canopy  .AND.  trimvar(1:4) == 'pcm_' )  THEN
-          nzt_do   = pch_index
-       ELSE
-          nzt_do   = nz_do3d
-       ENDIF
-
-!
-!--    Allocate a temporary array with the desired output dimensions.
-       ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
-!
-!--    Before each output, set array local_pf to fill value
-       local_pf = REAL( fill_value, KIND=wp )
-!
-!--    Set masking flag for topography for not resorted arrays
-       flag_nr = 0
-
-       SELECT CASE ( trimvar )
+       SELECT CASE ( TRIM( do3d(av,if) ) )
 
           CASE ( 'e' )
@@ -278,32 +154,11 @@
                 to_be_resorted => e
              ELSE
-                IF ( .NOT. ALLOCATED( e_av ) )  THEN
-                   ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   e_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => e_av
              ENDIF
 
-          CASE ( 'thetal' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => pt
-             ELSE
-                IF ( .NOT. ALLOCATED( lpt_av ) )  THEN
-                   ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   lpt_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                to_be_resorted => lpt_av
-             ENDIF
-
           CASE ( 'p' )
              IF ( av == 0 )  THEN
-                IF ( psolver /= 'sor' )  CALL exchange_horiz( p, nbgp )
                 to_be_resorted => p
              ELSE
-                IF ( .NOT. ALLOCATED( p_av ) )  THEN
-                   ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   p_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                IF ( psolver /= 'sor' )  CALL exchange_horiz( p_av, nbgp )
                 to_be_resorted => p_av
              ENDIF
@@ -311,12 +166,9 @@
           CASE ( 'pc' )  ! particle concentration (requires ghostpoint exchange)
              IF ( av == 0 )  THEN
-                IF ( time_since_reference_point >= particle_advection_start )  THEN
-                   tend = prt_count
-                ELSE
-                   tend = 0.0_wp
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
+                tend = prt_count
+                CALL exchange_horiz( tend, 0, 0 )
+                DO  i = nxl-1, nxr+1
+                   DO  j = nys-1, nyn+1
+                      DO  k = nzb, nz_do3d
                          local_pf(i,j,k) = tend(k,j,i)
                       ENDDO
@@ -325,43 +177,33 @@
                 resorted = .TRUE.
              ELSE
-                IF ( .NOT. ALLOCATED( pc_av ) )  THEN
-                   ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   pc_av = REAL( fill_value, KIND = wp )
-                ENDIF
+                CALL exchange_horiz( pc_av, 0, 0 )
                 to_be_resorted => pc_av
              ENDIF
 
-          CASE ( 'pr' )  ! mean particle radius (effective radius)
-             IF ( av == 0 )  THEN
-                IF ( time_since_reference_point >= particle_advection_start )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb_do, nzt_do
-                            number_of_particles = prt_count(k,j,i)
-                            IF ( number_of_particles <= 0 )  CYCLE
-                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                            s_r2 = 0.0_wp
-                            s_r3 = 0.0_wp
-                            DO  n = 1, number_of_particles
-                               IF ( particles(n)%particle_mask )  THEN
-                                  s_r2 = s_r2 + particles(n)%radius**2 * particles(n)%weight_factor
-                                  s_r3 = s_r3 + particles(n)%radius**3 * particles(n)%weight_factor
-                               ENDIF
-                            ENDDO
-                            IF ( s_r2 > 0.0_wp )  THEN
-                               mean_r = s_r3 / s_r2
-                            ELSE
-                               mean_r = 0.0_wp
-                            ENDIF
-                            tend(k,j,i) = mean_r
+          CASE ( 'pr' )  ! mean particle radius
+             IF ( av == 0 )  THEN
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      DO  k = nzb, nzt+1
+                         psi = prt_start_index(k,j,i)
+                         s_r3 = 0.0
+                         s_r4 = 0.0
+                         DO  n = psi, psi+prt_count(k,j,i)-1
+                            s_r3 = s_r3 + particles(n)%radius**3
+                            s_r4 = s_r4 + particles(n)%radius**4
                          ENDDO
+                         IF ( s_r3 /= 0.0 )  THEN
+                            mean_r = s_r4 / s_r3
+                         ELSE
+                            mean_r = 0.0
+                         ENDIF
+                         tend(k,j,i) = mean_r
                       ENDDO
                    ENDDO
-                ELSE
-                   tend = 0.0_wp
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
+                ENDDO
+                CALL exchange_horiz( tend, 0, 0 )
+                DO  i = nxl-1, nxr+1
+                   DO  j = nys-1, nyn+1
+                      DO  k = nzb, nzt+1
                          local_pf(i,j,k) = tend(k,j,i)
                       ENDDO
@@ -370,20 +212,19 @@
                 resorted = .TRUE.
              ELSE
-                IF ( .NOT. ALLOCATED( pr_av ) )  THEN
-                   ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   pr_av = REAL( fill_value, KIND = wp )
-                ENDIF
+                CALL exchange_horiz( pr_av, 0, 0 )
                 to_be_resorted => pr_av
              ENDIF
 
-          CASE ( 'theta' )
-             IF ( av == 0 )  THEN
-                IF ( .NOT. bulk_cloud_model )  THEN
+          CASE ( 'pt' )
+             IF ( av == 0 )  THEN
+                IF ( .NOT. cloud_physics ) THEN
                    to_be_resorted => pt
                 ELSE
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb_do, nzt_do
-                            local_pf(i,j,k) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+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
@@ -392,8 +233,4 @@
                 ENDIF
              ELSE
-                IF ( .NOT. ALLOCATED( pt_av ) )  THEN
-                   ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   pt_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => pt_av
              ENDIF
@@ -403,19 +240,11 @@
                 to_be_resorted => q
              ELSE
-                IF ( .NOT. ALLOCATED( q_av ) )  THEN
-                   ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   q_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => q_av
              ENDIF
-
+             
           CASE ( 'ql' )
              IF ( av == 0 )  THEN
                 to_be_resorted => ql
              ELSE
-                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
-                   ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   ql_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => ql_av
              ENDIF
@@ -425,8 +254,4 @@
                 to_be_resorted => ql_c
              ELSE
-                IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
-                   ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   ql_c_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => ql_c_av
              ENDIF
@@ -436,8 +261,4 @@
                 to_be_resorted => ql_v
              ELSE
-                IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
-                   ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   ql_v_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => ql_v_av
              ENDIF
@@ -445,36 +266,6 @@
           CASE ( 'ql_vp' )
              IF ( av == 0 )  THEN
-                IF ( time_since_reference_point >= particle_advection_start )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb_do, nzt_do
-                            number_of_particles = prt_count(k,j,i)
-                            IF (number_of_particles <= 0)  CYCLE
-                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                            DO  n = 1, number_of_particles
-                               IF ( particles(n)%particle_mask )  THEN
-                                  tend(k,j,i) =  tend(k,j,i) +                                     &
-                                                 particles(n)%weight_factor / prt_count(k,j,i)
-                               ENDIF
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                   tend = 0.0_wp
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = tend(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-                resorted = .TRUE.
-             ELSE
-                IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
-                   ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   ql_vp_av = REAL( fill_value, KIND = wp )
-                ENDIF
+                to_be_resorted => ql_vp
+             ELSE
                 to_be_resorted => ql_vp_av
              ENDIF
@@ -482,7 +273,7 @@
           CASE ( 'qv' )
              IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
+                DO  i = nxl-1, nxr+1
+                   DO  j = nys-1, nyn+1
+                      DO  k = nzb, nz_do3d
                          local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
                       ENDDO
@@ -491,8 +282,4 @@
                 resorted = .TRUE.
              ELSE
-                IF ( .NOT. ALLOCATED( qv_av ) )  THEN
-                   ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   qv_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => qv_av
              ENDIF
@@ -500,57 +287,34 @@
           CASE ( 's' )
              IF ( av == 0 )  THEN
-                to_be_resorted => s
-             ELSE
-                IF ( .NOT. ALLOCATED( s_av ) )  THEN
-                   ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   s_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                to_be_resorted => s_av
-             ENDIF
-
+                to_be_resorted => q
+             ELSE
+                to_be_resorted => q_av
+             ENDIF
+             
           CASE ( 'u' )
-             flag_nr = 1
              IF ( av == 0 )  THEN
                 to_be_resorted => u
              ELSE
-                IF ( .NOT. ALLOCATED( u_av ) )  THEN
-                   ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   u_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => u_av
              ENDIF
 
           CASE ( 'v' )
-             flag_nr = 2
              IF ( av == 0 )  THEN
                 to_be_resorted => v
              ELSE
-                IF ( .NOT. ALLOCATED( v_av ) )  THEN
-                   ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   v_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => v_av
              ENDIF
 
-          CASE ( 'thetav' )
+          CASE ( 'vpt' )
              IF ( av == 0 )  THEN
                 to_be_resorted => vpt
              ELSE
-                IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
-                   ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   vpt_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => vpt_av
              ENDIF
 
           CASE ( 'w' )
-             flag_nr = 3
              IF ( av == 0 )  THEN
                 to_be_resorted => w
              ELSE
-                IF ( .NOT. ALLOCATED( w_av ) )  THEN
-                   ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   w_av = REAL( fill_value, KIND = wp )
-                ENDIF
                 to_be_resorted => w_av
              ENDIF
@@ -558,68 +322,12 @@
           CASE DEFAULT
 !
-!--          Quantities of other modules
-             IF ( .NOT. found )  THEN
-                CALL module_interface_data_output_3d( av, trimvar, found, local_pf, fill_value,    &
-                                                      resorted, nzb_do, nzt_do                     &
-                                                    )
-             ENDIF
-
-!
-!--          Temporary workaround: ToDo: refactor local_pf allocation
-             IF ( .NOT. found  .AND.  urban_surface  .AND.  trimvar(1:4) == 'usm_' )  THEN
-!
-!--             For urban model quantities, it is required to re-allocate local_pf
-                nzb_do = nz_urban_b
-                nzt_do = nz_urban_t
-
-                DEALLOCATE ( local_pf )
-                ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
-                local_pf = fill_value
-
-                CALL usm_data_output_3d( av, trimvar, found, local_pf, nzb_do, nzt_do )
-                resorted = .TRUE.
-
-!
-!--             If no soil model variable was found, re-allocate local_pf
-                IF ( .NOT. found )  THEN
-                   nzb_do = nzb
-                   nzt_do = nz_do3d
-
-                   DEALLOCATE ( local_pf )
-                   ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
-                ENDIF
-
-             ENDIF
-
-!
-!--          Temporary workaround: ToDo: refactor local_pf allocation
-             IF ( .NOT. found  .AND.  land_surface )  THEN
-!
-!--             For soil model quantities, it is required to re-allocate local_pf
-                nzb_do = nzb_soil
-                nzt_do = nzt_soil
-
-                DEALLOCATE ( local_pf )
-                ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
-                local_pf = fill_value
-
-                CALL lsm_data_output_3d( av, trimvar, found, local_pf )
-                resorted = .TRUE.
-
-!
-!--             If no soil model variable was found, re-allocate local_pf
-                IF ( .NOT. found )  THEN
-                   nzb_do = nzb
-                   nzt_do = nz_do3d
-
-                   DEALLOCATE ( local_pf )
-                   ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
-                ENDIF
-
-             ENDIF
-
-             IF ( .NOT. found )  THEN
-                message_string =  'no output available for: ' // TRIM( do3d(av,ivar) )
-                CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
+!--          User defined quantity
+             CALL user_data_output_3d( av, do3d(av,if), found, local_pf, &
+                                       nz_do3d )
+             resorted = .TRUE.
+
+             IF ( myid == 0  .AND.  .NOT. found )  THEN
+                PRINT*, '+++ data_output_3d: no output available for: ', &
+                             do3d(av,if)
              ENDIF
 
@@ -629,10 +337,8 @@
 !--    Resort the array to be output, if not done above
        IF ( .NOT. resorted )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb_do, nzt_do
-                   local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),                                 &
-                                            REAL( fill_value, KIND = wp ),                         &
-                                            BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                DO  k = nzb, nz_do3d
+                   local_pf(i,j,k) = to_be_resorted(k,j,i)
                 ENDDO
              ENDDO
@@ -641,78 +347,79 @@
 
 !
-!--    Output of the 3D-array
+!--    Output of the volume data information for the AVS-FLD-file.
+       do3d_avs_n = do3d_avs_n + 1
+       IF ( myid == 0  .AND.  avs_output )  THEN
+!
+!--       AVS-labels must not contain any colons. Hence they must be removed
+!--       from the time character string.
+          simulated_time_mod = simulated_time_chr
+          DO  WHILE ( SCAN( simulated_time_mod, ':' ) /= 0 )
+             pos = SCAN( simulated_time_mod, ':' )
+             simulated_time_mod(pos:pos) = '/'
+          ENDDO
+
+          IF ( av == 0 )  THEN
+             WRITE ( 33, 3300 )  do3d_avs_n, TRIM( avs_data_file ), &
+                                 skip_do_avs, TRIM( do3d(av,if) ), &
+                                 TRIM( simulated_time_mod )
+          ELSE
+             WRITE ( 33, 3300 )  do3d_avs_n, TRIM( avs_data_file ), &
+                                 skip_do_avs, TRIM( do3d(av,if) ) // &
+                                 ' averaged', TRIM( simulated_time_mod )
+          ENDIF
+!
+!--       Determine the Skip-value for the next array. Record end and start 
+!--       require 4 byte each.
+          skip_do_avs = skip_do_avs + ( ((nx+2)*(ny+2)*(nz_do3d+1)) * 4 + 8 )
+       ENDIF
+
+!
+!--    Output of the 3D-array. (compressed/uncompressed)
+       IF ( do3d_compress )  THEN
+!
+!--       Compression, output of compression information on FLD-file and output
+!--       of compressed data.
+          CALL write_compressed( local_pf, 30, 33, myid, nxl, nxr, nyn, nys, &
+                                 nzb, nz_do3d, prec )
+       ELSE
+!
+!--       Uncompressed output.
 #if defined( __parallel )
-       IF ( netcdf_data_format < 5 )  THEN
-!
-!--       Non-parallel netCDF output. Data is output in parallel in FORTRAN binary format here, and
-!--       later collected into one file by combine_plot_fields
-          IF ( myid == 0 )  THEN
-             WRITE ( 30 )  time_since_reference_point, do3d_time_count(av), av
+          IF ( netcdf_output  .AND.  myid == 0 )  THEN
+             WRITE ( 30 )  simulated_time, do3d_time_count(av), av
           ENDIF
-          DO  i = 0, io_blocks-1
-             IF ( i == io_group )  THEN
-                WRITE ( 30 )  nxl, nxr, nys, nyn, nzb_do, nzt_do
-                WRITE ( 30 )  REAL( local_pf(:,:,nzb_do:nzt_do), KIND = sp )
-             ENDIF
-
-             CALL MPI_BARRIER( comm2d, ierr )
-
-          ENDDO
-
-       ELSE
+          WRITE ( 30 )  nxl-1, nxr+1, nys-1, nyn+1, nzb, nz_do3d
+          WRITE ( 30 )  local_pf
+#else
+          IF ( avs_output )  THEN
+             WRITE ( 30 )  local_pf(nxl:nxr+1,nys:nyn+1,:)
+          ENDIF
 #if defined( __netcdf )
-!
-!--       Parallel output in netCDF4/HDF5 format.
-!          IF ( nxr == nx  .AND.  nyn /= ny )  THEN
-!             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar),  &
-!                               local_pf(nxl:nxr+1,nys:nyn,nzb_do:nzt_do),    &
-!                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
-!                count = (/ nxr-nxl+2, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
-!          ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
-!             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar),  &
-!                               local_pf(nxl:nxr,nys:nyn+1,nzb_do:nzt_do),    &
-!                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
-!                count = (/ nxr-nxl+1, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
-!          ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
-!             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar),  &
-!                             local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do  ),  &
-!                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
-!                count = (/ nxr-nxl+2, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
-!          ELSE
-!
-!--       Call for parallel runs
-          nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar),                             &
-                                   local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do),                        &
-                                   start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),      &
-                                   count = (/ nxr-nxl+1, nyn-nys+1, nzt_do-nzb_do+1, 1 /)          &
-                                 )
-!          ENDIF
-          CALL netcdf_handle_error( 'data_output_3d', 386 )
+          IF ( netcdf_output )  THEN
+             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),       &
+                                  local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d),  &
+                                  start = (/ 1, 1, 1, do3d_time_count(av) /), &
+                                  count = (/ nx+2, ny+2, nz_do3d-nzb+1, 1 /) )
+             IF ( nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 1010 )
+          ENDIF
+#endif
 #endif
        ENDIF
-#else
-#if defined( __netcdf )
-!
-!--    Call for non-parallel runs
-       nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar),                                &
-                               local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do),                            &
-                               start = (/ 1, 1, 1, do3d_time_count(av) /),                         &
-                               count = (/ nx+1, ny+1, nzt_do-nzb_do+1, 1 /) )
-       CALL netcdf_handle_error( 'data_output_3d', 446 )
-#endif
-#endif
-
-       ivar = ivar + 1
-
-!
-!--    Deallocate temporary array
-       DEALLOCATE ( local_pf )
+
+       if = if + 1
 
     ENDDO
 
-    CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
-
-    IF ( debug_output_timestep )  CALL debug_message( 'data_output_3d', 'end' )
-
+!
+!-- Deallocate temporary array.
+    DEALLOCATE( local_pf )
+
+
+    CALL cpu_log (log_point(14),'data_output_3d','stop','nobarrier')
+
+!
+!-- Formats.
+3300 FORMAT ('variable ',I4,'  file=',A,'  filetype=unformatted  skip=',I12/ &
+             'label = ',A,A)
 
  END SUBROUTINE data_output_3d
Index: palm/trunk/SOURCE/data_output_binary_module.f90
===================================================================
--- palm/trunk/SOURCE/data_output_binary_module.f90	(revision 4901)
+++ 	(revision )
@@ -1,869 +1,0 @@
-!> @file data_output_binary_module.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2019-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4597 2020-07-09 19:21:53Z gronemeier
-! change: update argument list of routine binary_init_dimension due to changes in interface
-!
-! 4579 2020-06-25 20:05:07Z gronemeier
-! corrected formatting to follow PALM coding standard
-!
-! 4577 2020-06-25 09:53:58Z raasch
-! further re-formatting to follow the PALM coding standard
-!
-! 4559 2020-06-11 08:51:48Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! Enable character-array output
-!
-! 4232 2019-09-20 09:34:22Z knoop
-! Bugfix: INCLUDE "mpif.h" must be placed after IMPLICIT NONE statement
-!
-! 4147 2019-08-07 09:42:31Z gronemeier
-! corrected indentation according to coding standard
-!
-! 4141 2019-08-05 12:24:51Z gronemeier
-! Initial revision
-!
-!
-! Authors:
-! --------
-!> @author: Tobias Gronemeier
-!
-! Description:
-! ------------
-!> Binary output module to write output data into binary files.
-!>
-!> @todo Get iostat value of write statements.
-!--------------------------------------------------------------------------------------------------!
- MODULE data_output_binary_module
-
-    USE kinds
-
-#if defined( __parallel )
-    USE MPI
-#endif
-
-    IMPLICIT NONE
-
-
-    CHARACTER(LEN=*), PARAMETER ::  config_file_name = 'BINARY_TO_NETCDF_CONFIG'  !< name of config file
-    CHARACTER(LEN=*), PARAMETER ::  file_prefix = 'BIN_'                          !< file prefix for binary files
-    CHARACTER(LEN=*), PARAMETER ::  mode_binary = 'binary'                        !< string to select operation mode of module
-
-    INTEGER, PARAMETER ::  charlen = 100  !< maximum length of character variables
-
-    CHARACTER(LEN=charlen)      ::  file_suffix = ''             !< file suffix added to each file name
-    CHARACTER(LEN=800)          ::  internal_error_message = ''  !< string containing the last error message
-    CHARACTER(LEN=800)          ::  temp_string                  !< dummy string
-
-    INTEGER ::  binary_file_lowest_unit = 1000  !< lowest unit number of all binary files created by this module
-    INTEGER ::  config_file_unit                !< unit number of config file
-    INTEGER ::  debug_output_unit               !< Fortran Unit Number of the debug-output file
-    INTEGER ::  global_id_in_file = -1          !< value of global ID within a file
-    INTEGER ::  master_rank                     !< master rank for tasks to be executed by single PE only
-    INTEGER ::  next_available_unit             !< next unit number available for new file
-    INTEGER ::  output_group_comm               !< MPI communicator addressing all MPI ranks which participate in output
-
-    INTEGER, DIMENSION(:), ALLOCATABLE ::  files_highest_variable_id  !< highest assigned ID of variable or dimension in a file
-
-    LOGICAL ::  binary_open_file_first_call = .TRUE.  !< true if binary_open_file routine was not called yet
-    LOGICAL ::  config_file_open = .FALSE.            !< true if config file is opened and not closed
-    LOGICAL ::  print_debug_output = .FALSE.          !< if true, debug output is printed
-
-    SAVE
-
-    PRIVATE
-
-    INTERFACE binary_init_module
-       MODULE PROCEDURE binary_init_module
-    END INTERFACE binary_init_module
-
-    INTERFACE binary_open_file
-       MODULE PROCEDURE binary_open_file
-    END INTERFACE binary_open_file
-
-    INTERFACE binary_init_dimension
-       MODULE PROCEDURE binary_init_dimension
-    END INTERFACE binary_init_dimension
-
-    INTERFACE binary_init_variable
-       MODULE PROCEDURE binary_init_variable
-    END INTERFACE binary_init_variable
-
-    INTERFACE binary_write_attribute
-       MODULE PROCEDURE binary_write_attribute
-    END INTERFACE binary_write_attribute
-
-    INTERFACE binary_stop_file_header_definition
-       MODULE PROCEDURE binary_stop_file_header_definition
-    END INTERFACE binary_stop_file_header_definition
-
-    INTERFACE binary_write_variable
-       MODULE PROCEDURE binary_write_variable
-    END INTERFACE binary_write_variable
-
-    INTERFACE binary_finalize
-       MODULE PROCEDURE binary_finalize
-    END INTERFACE binary_finalize
-
-    INTERFACE binary_get_error_message
-       MODULE PROCEDURE binary_get_error_message
-    END INTERFACE binary_get_error_message
-
-    PUBLIC                                                                                         &
-       binary_finalize,                                                                            &
-       binary_get_error_message,                                                                   &
-       binary_init_dimension,                                                                      &
-       binary_init_module,                                                                         &
-       binary_init_variable,                                                                       &
-       binary_open_file,                                                                           &
-       binary_stop_file_header_definition,                                                         &
-       binary_write_attribute,                                                                     &
-       binary_write_variable
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize data-output module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE binary_init_module( file_suffix_of_output_group, mpi_comm_of_output_group,             &
-                                master_output_rank, program_debug_output_unit, debug_output,       &
-                                dom_global_id )
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_suffix_of_output_group  !> file-name suffix added to each file;
-                                                                  !> must be unique for each output group
-
-    INTEGER, INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
-    INTEGER, INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
-    INTEGER, INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
-    INTEGER, INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
-
-    LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed
-
-
-    file_suffix        = file_suffix_of_output_group
-    output_group_comm  = mpi_comm_of_output_group
-    master_rank        = master_output_rank
-
-    debug_output_unit  = program_debug_output_unit
-    print_debug_output = debug_output
-
-    global_id_in_file  = dom_global_id
-
- END SUBROUTINE binary_init_module
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Open binary file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE binary_open_file( mode, file_name, file_id, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_open_file'  !< name of this routine
-
-    CHARACTER(LEN=charlen)             ::  bin_filename = ''  !< actual name of binary file
-    CHARACTER(LEN=charlen), INTENT(IN) ::  file_name          !< name of file
-    CHARACTER(LEN=*),       INTENT(IN) ::  mode               !< operation mode
-    CHARACTER(LEN=7)                   ::  my_rank_char       !< string containing value of my_rank with leading zeros
-
-    INTEGER, INTENT(OUT) ::  file_id       !< file ID
-    INTEGER              ::  my_rank       !< MPI rank of local processor
-    INTEGER              ::  nranks        !< number of MPI ranks participating in output
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-
-    INTEGER, DIMENSION(:), ALLOCATABLE ::  files_highest_variable_id_tmp  !< temporary list of given variable IDs in file
-
-    LOGICAL ::  file_exists  !< true if file to be opened already exists
-
-
-    return_value = 0
-
-#if defined( __parallel )
-    CALL MPI_COMM_SIZE( output_group_comm, nranks, return_value )
-    IF ( return_value == 0 )  CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
-    IF ( return_value == 0 )  THEN
-       WRITE( my_rank_char, '("_",I6.6)' )  my_rank
-    ELSE
-       CALL internal_message( 'error', routine_name // ': MPI error' )
-    ENDIF
-#else
-    nranks = 1
-    my_rank = master_rank
-    WRITE( my_rank_char, '("_",I6.6)' )  my_rank
-#endif
-!
-!-- Check mode (not required, added for compatibility reasons)
-    IF ( TRIM( mode ) == mode_binary )  CONTINUE
-!
-!-- Open binary config file for combining script
-    IF ( return_value == 0  .AND.  binary_open_file_first_call )  THEN
-
-       binary_open_file_first_call = .FALSE.
-       config_file_unit = binary_file_lowest_unit
-
-       IF ( my_rank == master_rank )  THEN
-!
-!--       Remove any pre-existing file
-          INQUIRE( FILE=TRIM( config_file_name ) // TRIM( file_suffix ), EXIST=file_exists )
-
-          IF ( file_exists )  THEN
-             CALL internal_message( 'debug', routine_name //                                       &
-                                    ': Remove existing file ' //                                   &
-                                    TRIM( config_file_name ) // TRIM( file_suffix ) )
-             !> @note Fortran2008 feature 'EXECUTE_COMMAND_LINE' not yet supported by
-             !>       PGI 18.10 compiler. Hence, non-standard 'SYSTEM' call must be used
-             ! CALL EXECUTE_COMMAND_LINE( &
-             !         COMMAND='rm ' // TRIM( config_file_name ) // TRIM( file_suffix ), &
-             !         WAIT=.TRUE., EXITSTAT=return_value )
-             CALL SYSTEM( 'rm ' // TRIM( config_file_name ) // TRIM( file_suffix ) )
-          ENDIF
-
-          OPEN( config_file_unit, FILE=TRIM( config_file_name ) // TRIM( file_suffix ),            &
-                FORM='UNFORMATTED', STATUS='NEW', IOSTAT=return_value )
-
-          IF ( return_value == 0 )  THEN
-
-             config_file_open = .TRUE.
-!
-!--          Write some general information to config file
-             WRITE( config_file_unit )  nranks
-             WRITE( config_file_unit )  master_rank
-             WRITE( config_file_unit )  LEN( file_prefix )
-             WRITE( config_file_unit )  file_prefix
-             WRITE( config_file_unit )  charlen
-             WRITE( config_file_unit )  global_id_in_file
-
-          ELSE
-
-             return_value = 1
-             CALL internal_message( 'error', routine_name // ': could not create config' )
-
-          ENDIF
-
-       ENDIF
-
-       next_available_unit = binary_file_lowest_unit + 1
-
-    ENDIF
-!
-!-- Initialize output file: open, write header, initialize variable/dimension IDs
-    IF ( return_value == 0 )  THEN
-
-       bin_filename = file_prefix // TRIM( file_name ) // TRIM( file_suffix ) // my_rank_char
-!
-!--    Remove any pre-existing file
-       INQUIRE( FILE=TRIM( bin_filename ), EXIST=file_exists )
-
-       IF ( file_exists )  THEN
-          CALL internal_message( 'debug', routine_name //                                          &
-                                 ': remove existing file ' // TRIM( bin_filename ) )
-          !> @note Fortran2008 feature 'EXECUTE_COMMAND_LINE' not yet supported by
-          !>       PGI 18.10 compiler. Hence, non-standard 'SYSTEM' call must be used
-          ! CALL EXECUTE_COMMAND_LINE( COMMAND='rm ' // TRIM( bin_filename ), &
-          !                            WAIT=.TRUE., EXITSTAT=return_value )
-          CALL SYSTEM( 'rm ' // TRIM( bin_filename ) )
-       ENDIF
-!
-!--    Open binary file
-       CALL internal_message( 'debug', routine_name // ': open file ' // TRIM( bin_filename ) )
-       OPEN ( next_available_unit, FILE=TRIM( bin_filename ), FORM='UNFORMATTED', STATUS='NEW',    &
-              IOSTAT=return_value )
-
-       IF ( return_value == 0 )  THEN
-!
-!--       Add file_name to config file
-          IF ( my_rank == master_rank )  THEN
-             WRITE( config_file_unit )  file_name
-          ENDIF
-!
-!--       Save file ID and increase next file unit number
-          file_id = next_available_unit
-          next_available_unit = next_available_unit + 1
-!
-!--       Write some meta data to file
-          WRITE ( file_id )  charlen
-          WRITE ( file_id )  file_id
-          WRITE ( file_id )  file_name
-!
-!--       Extend file-variable/dimension-ID list by 1 and set it to 0 for new file.
-          IF ( ALLOCATED( files_highest_variable_id ) )  THEN
-             ALLOCATE( files_highest_variable_id_tmp(SIZE( files_highest_variable_id )) )
-             files_highest_variable_id_tmp = files_highest_variable_id
-             DEALLOCATE( files_highest_variable_id )
-             ALLOCATE( files_highest_variable_id(binary_file_lowest_unit+1:file_id) )
-             files_highest_variable_id(:file_id-1) = files_highest_variable_id_tmp
-             DEALLOCATE( files_highest_variable_id_tmp )
-          ELSE
-             ALLOCATE( files_highest_variable_id(binary_file_lowest_unit+1:file_id) )
-          ENDIF
-          files_highest_variable_id(file_id) = 0
-
-       ELSE
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': could not open file "' // TRIM( file_name ) // '"')
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE binary_open_file
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write attribute to file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE binary_write_attribute( file_id, variable_id, attribute_name, value_char, value_int8,  &
-                                    value_int16, value_int32, value_real32, value_real64,          &
-                                    return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_attribute'  !< name of this routine
-
-    CHARACTER(LEN=charlen), INTENT(IN)           ::  attribute_name  !< name of attribute
-    CHARACTER(LEN=charlen)                       ::  attribute_type  !< data type of attribute
-    CHARACTER(LEN=charlen)                       ::  output_string   !< output string
-    CHARACTER(LEN=charlen), INTENT(IN), OPTIONAL ::  value_char      !< value of attribute
-
-    INTEGER, INTENT(IN)  ::  file_id       !< file ID
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-    INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
-
-    INTEGER(KIND=1), INTENT(IN), OPTIONAL ::  value_int8   !< value of attribute
-    INTEGER(KIND=2), INTENT(IN), OPTIONAL ::  value_int16  !< value of attribute
-    INTEGER(KIND=4), INTENT(IN), OPTIONAL ::  value_int32  !< value of attribute
-
-    REAL(KIND=4), INTENT(IN), OPTIONAL ::  value_real32  !< value of attribute
-    REAL(KIND=8), INTENT(IN), OPTIONAL ::  value_real64  !< value of attribute
-
-
-    return_value = 0
-
-    CALL internal_message( 'debug', TRIM( routine_name ) //                                        &
-                           ': write attribute ' // TRIM( attribute_name ) )
-!
-!-- Write attribute to file
-    output_string = 'attribute'
-    WRITE( file_id )  output_string
-
-    WRITE( file_id )  variable_id
-    WRITE( file_id )  attribute_name
-
-    IF ( PRESENT( value_char ) )  THEN
-       attribute_type = 'char'
-       WRITE( file_id )  attribute_type
-       WRITE( file_id )  value_char
-    ELSEIF ( PRESENT( value_int8 ) )  THEN
-       attribute_type = 'int8'
-       WRITE( file_id )  attribute_type
-       WRITE( file_id )  value_int8
-    ELSEIF ( PRESENT( value_int16 ) )  THEN
-       attribute_type = 'int16'
-       WRITE( file_id )  attribute_type
-       WRITE( file_id )  value_int16
-    ELSEIF ( PRESENT( value_int32 ) )  THEN
-       attribute_type = 'int32'
-       WRITE( file_id )  attribute_type
-       WRITE( file_id )  value_int32
-    ELSEIF ( PRESENT( value_real32 ) )  THEN
-       attribute_type = 'real32'
-       WRITE( file_id )  attribute_type
-       WRITE( file_id )  value_real32
-    ELSEIF ( PRESENT( value_real64 ) )  THEN
-       attribute_type = 'real64'
-       WRITE( file_id )  attribute_type
-       WRITE( file_id )  value_real64
-    ELSE
-       return_value = 1
-       CALL internal_message( 'error', TRIM( routine_name ) //                                     &
-                              ': no value given for attribute "' // TRIM( attribute_name ) // '"' )
-    ENDIF
-
- END SUBROUTINE binary_write_attribute
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize dimension. Write information in file header and save dimension values to be later
-!> written to file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE binary_init_dimension( mode, file_id, dimension_id, variable_id, dimension_name,       &
-                                   dimension_type, dimension_length, write_only_by_master_rank,    &
-                                   return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_dimension'  !< name of this routine
-
-    CHARACTER(LEN=charlen), INTENT(IN) ::  dimension_name  !< name of dimension
-    CHARACTER(LEN=charlen), INTENT(IN) ::  dimension_type  !< data type of dimension
-    CHARACTER(LEN=*),       INTENT(IN) ::  mode            !< operation mode
-    CHARACTER(LEN=charlen)             ::  output_string   !< output string
-
-    INTEGER, INTENT(OUT) ::  dimension_id      !< dimension ID
-    INTEGER, INTENT(IN)  ::  dimension_length  !< length of dimension
-    INTEGER, INTENT(IN)  ::  file_id           !< file ID
-    INTEGER, INTENT(OUT) ::  return_value      !< return value
-    INTEGER, INTENT(OUT) ::  variable_id       !< variable ID
-
-    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
-
-
-    return_value = 0
-
-    CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dimension_name ) )
-!
-!-- Required for compatibility reasons
-    IF ( TRIM( mode ) == mode_binary )  CONTINUE
-!
-!-- Assign dimension ID
-    dimension_id = files_highest_variable_id( file_id ) + 1
-    files_highest_variable_id( file_id ) = dimension_id
-!
-!-- Define dimension in file
-    output_string = 'dimension'
-    WRITE( file_id )  output_string
-    WRITE( file_id )  dimension_name
-    WRITE( file_id )  dimension_id
-    WRITE( file_id )  dimension_type
-    WRITE( file_id )  dimension_length
-!
-!-- Define variable associated with dimension
-    CALL binary_init_variable( mode, file_id, variable_id, dimension_name, dimension_type,         &
-                               (/ dimension_id /),                                                 &
-                               write_only_by_master_rank=write_only_by_master_rank,                &
-                               return_value=return_value )
-
-    IF ( return_value /= 0 )  THEN
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': init dimension "' // TRIM( dimension_name ) // '"' )
-    ENDIF
-
- END SUBROUTINE binary_init_dimension
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize variable. Write information of variable into file header.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE binary_init_variable( mode, file_id, variable_id, variable_name, variable_type,        &
-                                  dimension_ids, write_only_by_master_rank, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_variable'  !< name of this routine
-
-    CHARACTER(LEN=*),       INTENT(IN) ::  mode            !< operation mode
-    CHARACTER(LEN=charlen)             ::  output_string   !< output string
-    CHARACTER(LEN=charlen), INTENT(IN) ::  variable_name   !< name of variable
-    CHARACTER(LEN=charlen), INTENT(IN) ::  variable_type   !< data type of variable
-
-    INTEGER, INTENT(IN)  ::  file_id       !< file ID
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-    INTEGER, INTENT(OUT) ::  variable_id   !< variable ID
-
-    INTEGER, DIMENSION(:), INTENT(IN) ::  dimension_ids  !< list of dimension IDs used by variable
-
-    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
-
-
-    return_value = 0
-
-    CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( variable_name ) )
-!
-!-- Required for compatibility reasons
-    IF ( TRIM( mode ) == mode_binary )  CONTINUE
-    IF ( write_only_by_master_rank )  CONTINUE
-!
-!-- Assign variable ID
-    variable_id = files_highest_variable_id( file_id ) + 1
-    files_highest_variable_id( file_id ) = variable_id
-!
-!-- Write variable information in file
-    output_string = 'variable'
-    WRITE( file_id )  output_string
-    WRITE( file_id )  variable_name
-    WRITE( file_id )  variable_id
-    WRITE( file_id )  variable_type
-    WRITE( file_id )  SIZE( dimension_ids )
-    WRITE( file_id )  dimension_ids
-
- END SUBROUTINE binary_init_variable
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Leave file definition state.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE binary_stop_file_header_definition( file_id, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_stop_file_header_definition'  !< name of this routine
-
-    CHARACTER(LEN=charlen) ::  output_string  !< output string
-
-    INTEGER, INTENT(IN)  ::  file_id       !< file ID
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-
-
-    return_value = 0
-
-    WRITE( temp_string, * ) file_id
-    CALL internal_message( 'debug', routine_name //                                                &
-                           ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
-
-    output_string = '*** end file header ***'
-    WRITE( file_id )  output_string
-
- END SUBROUTINE binary_stop_file_header_definition
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write variable to file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE binary_write_variable(                                                                 &
-               file_id, variable_id, bounds_start, value_counts, bounds_origin,                    &
-               write_only_by_master_rank,                                                          &
-               values_char_0d,   values_char_1d,   values_char_2d,   values_char_3d,               &
-               values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,               &
-               values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,              &
-               values_int32_0d,  values_int32_1d,  values_int32_2d,  values_int32_3d,              &
-               values_intwp_0d,  values_intwp_1d,  values_intwp_2d,  values_intwp_3d,              &
-               values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d,             &
-               values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d,             &
-               values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d,             &
-               return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_variable'  !< name of this routine
-
-    CHARACTER(LEN=charlen) ::  output_string  !< output string
-
-    CHARACTER(LEN=1), POINTER,             INTENT(IN), OPTIONAL                   ::  values_char_0d  !< output variable
-    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_char_1d  !< output variable
-    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_char_2d  !< output variable
-    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_char_3d  !< output variable
-
-    INTEGER, INTENT(IN)  ::  file_id       !< file ID
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-    INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
-
-    INTEGER, DIMENSION(:), INTENT(IN) ::  bounds_origin  !< starting index of each dimension
-    INTEGER, DIMENSION(:), INTENT(IN) ::  bounds_start   !< starting index of variable
-    INTEGER, DIMENSION(:), INTENT(IN) ::  value_counts   !< count of values along each dimension to be written
-
-    INTEGER(KIND=1), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int8_0d   !< output variable
-    INTEGER(KIND=2), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int16_0d  !< output variable
-    INTEGER(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int32_0d  !< output variable
-    INTEGER(iwp),    POINTER,             INTENT(IN), OPTIONAL                   ::  values_intwp_0d  !< output variable
-    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int8_1d   !< output variable
-    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int16_1d  !< output variable
-    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int32_1d  !< output variable
-    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_intwp_1d  !< output variable
-    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int8_2d   !< output variable
-    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int16_2d  !< output variable
-    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int32_2d  !< output variable
-    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_intwp_2d  !< output variable
-    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int8_3d   !< output variable
-    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int16_3d  !< output variable
-    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int32_3d  !< output variable
-    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_intwp_3d  !< output variable
-
-    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
-
-    REAL(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real32_0d  !< output variable
-    REAL(KIND=8), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real64_0d  !< output variable
-    REAL(wp),     POINTER,             INTENT(IN), OPTIONAL                   ::  values_realwp_0d  !< output variable
-    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real32_1d  !< output variable
-    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real64_1d  !< output variable
-    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_realwp_1d  !< output variable
-    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real32_2d  !< output variable
-    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real64_2d  !< output variable
-    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_realwp_2d  !< output variable
-    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real32_3d  !< output variable
-    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real64_3d  !< output variable
-    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_realwp_3d  !< output variable
-
-
-    return_value = 0
-
-    WRITE( temp_string, '(": write variable ",I6," into file ",I6)' ) variable_id, file_id
-    CALL internal_message( 'debug', routine_name // TRIM( temp_string ) )
-!
-!-- Required for compatibility reasons
-    IF ( write_only_by_master_rank )  CONTINUE
-
-    IF ( .NOT. ANY( value_counts == 0 ) )  THEN
-       WRITE( file_id )  variable_id
-       WRITE( file_id )  bounds_start
-       WRITE( file_id )  value_counts
-       WRITE( file_id )  bounds_origin
-!
-!--    Character output
-       IF ( PRESENT( values_char_0d ) )  THEN
-          output_string = 'char'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_char_0d
-       ELSEIF ( PRESENT( values_char_1d ) )  THEN
-          output_string = 'char'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_char_1d
-       ELSEIF ( PRESENT( values_char_2d ) )  THEN
-          output_string = 'char'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_char_2d
-       ELSEIF ( PRESENT( values_char_3d ) )  THEN
-          output_string = 'char'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_char_3d
-!
-!--    8bit integer output
-       ELSEIF ( PRESENT( values_int8_0d ) )  THEN
-          output_string = 'int8'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int8_0d
-       ELSEIF ( PRESENT( values_int8_1d ) )  THEN
-          output_string = 'int8'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int8_1d
-       ELSEIF ( PRESENT( values_int8_2d ) )  THEN
-          output_string = 'int8'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int8_2d
-       ELSEIF ( PRESENT( values_int8_3d ) )  THEN
-          output_string = 'int8'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int8_3d
-!
-!--    16bit integer output
-       ELSEIF ( PRESENT( values_int16_0d ) )  THEN
-          output_string = 'int16'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int16_0d
-       ELSEIF ( PRESENT( values_int16_1d ) )  THEN
-          output_string = 'int16'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int16_1d
-       ELSEIF ( PRESENT( values_int16_2d ) )  THEN
-          output_string = 'int16'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int16_2d
-       ELSEIF ( PRESENT( values_int16_3d ) )  THEN
-          output_string = 'int16'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int16_3d
-!
-!--    32bit integer output
-       ELSEIF ( PRESENT( values_int32_0d ) )  THEN
-          output_string = 'int32'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int32_0d
-       ELSEIF ( PRESENT( values_int32_1d ) )  THEN
-          output_string = 'int32'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int32_1d
-       ELSEIF ( PRESENT( values_int32_2d ) )  THEN
-          output_string = 'int32'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int32_2d
-       ELSEIF ( PRESENT( values_int32_3d ) )  THEN
-          output_string = 'int32'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_int32_3d
-!
-!--    Working-precision integer output
-       ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
-          output_string = 'intwp'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_intwp_0d
-       ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
-          output_string = 'intwp'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_intwp_1d
-       ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
-          output_string = 'intwp'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_intwp_2d
-       ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
-          output_string = 'intwp'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_intwp_3d
-!
-!--    32bit real output
-       ELSEIF ( PRESENT( values_real32_0d ) )  THEN
-          output_string = 'real32'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_real32_0d
-       ELSEIF ( PRESENT( values_real32_1d ) )  THEN
-          output_string = 'real32'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_real32_1d
-       ELSEIF ( PRESENT( values_real32_2d ) )  THEN
-          output_string = 'real32'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_real32_2d
-       ELSEIF ( PRESENT( values_real32_3d ) )  THEN
-          output_string = 'real32'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_real32_3d
-!
-!--    64bit real output
-       ELSEIF ( PRESENT( values_real64_0d ) )  THEN
-          output_string = 'real64'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_real64_0d
-       ELSEIF ( PRESENT( values_real64_1d ) )  THEN
-          output_string = 'real64'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_real64_1d
-       ELSEIF ( PRESENT( values_real64_2d ) )  THEN
-          output_string = 'real64'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_real64_2d
-       ELSEIF ( PRESENT( values_real64_3d ) )  THEN
-          output_string = 'real64'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_real64_3d
-!
-!--    Working-precision real output
-       ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
-          output_string = 'realwp'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_realwp_0d
-       ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
-          output_string = 'realwp'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_realwp_1d
-       ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
-          output_string = 'realwp'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_realwp_2d
-       ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
-          output_string = 'realwp'
-          WRITE( file_id )  output_string
-          WRITE( file_id )  values_realwp_3d
-       ELSE
-          return_value = 1
-          CALL internal_message( 'error', routine_name // ': no values given' )
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE binary_write_variable
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Close opened files.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE binary_finalize( file_id, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_finalize'  !< name of this routine
-
-    CHARACTER(LEN=charlen) ::  output_string  !< output string
-
-    INTEGER, INTENT(IN)  ::  file_id       !< file ID
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-
-
-    IF ( config_file_open )  THEN
-
-       output_string = '*** end config file ***'
-       WRITE( config_file_unit )  output_string
-
-       CLOSE( config_file_unit, IOSTAT=return_value )
-
-       IF ( return_value /= 0 )  THEN
-          CALL internal_message( 'error', routine_name // ': cannot close configuration file' )
-       ELSE
-          config_file_open = .FALSE.
-       ENDIF
-
-    ELSE
-
-       return_value = 0
-
-    ENDIF
-
-    IF ( return_value == 0 )  THEN
-
-       WRITE( temp_string, * ) file_id
-       CALL internal_message( 'debug', routine_name //                                             &
-                              ': close file (file_id=' // TRIM( temp_string ) // ')' )
-
-       CLOSE( file_id, IOSTAT=return_value )
-       IF ( return_value /= 0 )  THEN
-          WRITE( temp_string, * ) file_id
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': cannot close file (file_id=' // TRIM( temp_string ) // ')' )
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE binary_finalize
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Message routine writing debug information into the debug file or creating the error message
-!> string.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE internal_message( level, string )
-
-    CHARACTER(LEN=*), INTENT(IN) ::  level   !< message importance level
-    CHARACTER(LEN=*), INTENT(IN) ::  string  !< message string
-
-
-    IF ( TRIM( level ) == 'error' )  THEN
-
-       WRITE( internal_error_message, '(A,A)' ) ': ', string
-
-    ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
-
-       WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
-       FLUSH( debug_output_unit )
-
-    ENDIF
-
- END SUBROUTINE internal_message
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Return the last created error message.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION binary_get_error_message() RESULT( error_message )
-
-    CHARACTER(LEN=800) ::  error_message  !< return error message to main program
-
-
-    error_message = TRIM( internal_error_message )
-
-    internal_error_message = ''
-
- END FUNCTION binary_get_error_message
-
- END MODULE data_output_binary_module
Index: palm/trunk/SOURCE/data_output_dvrp.f90
===================================================================
--- palm/trunk/SOURCE/data_output_dvrp.f90	(revision 1)
+++ palm/trunk/SOURCE/data_output_dvrp.f90	(revision 1)
@@ -0,0 +1,509 @@
+ MODULE dvrp_color
+
+    USE dvrp_variables
+
+    IMPLICIT NONE
+
+ CONTAINS
+
+    SUBROUTINE color_dvrp( value, color )
+
+       REAL, INTENT(IN)  ::  value
+       REAL, INTENT(OUT) ::  color(4)
+
+       REAL              ::  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 + 180.0 * scale, 360.0 )
+
+       color = (/ scale, 0.5, 1.0, 0.0 /)
+
+    END SUBROUTINE color_dvrp
+
+ END MODULE dvrp_color
+
+
+ RECURSIVE SUBROUTINE data_output_dvrp
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+! TEST: write statements
+!
+! Former revisions:
+! -----------------
+! $Log: data_output_dvrp.f90,v $
+! Revision 1.13  2006/02/23 10:25:12  raasch
+! Former routine plot_dvrp renamed data_output_dvrp,
+! Only a fraction of the particles may have a tail,
+! pl.. replaced by do.., %size renamed %dvrp_psize
+!
+! Revision 1.12  2005/03/31 07:00:46  raasch
+! Testversion with print statements checked in
+!
+! Revision 1.11  2003/08/01 08:44:50  raasch
+! Routine defined as recursive, because it is called from DVRP_STEERING_UPDATE
+! in case that the user has suspended the run by steering control.
+! Routine color_dvrp placed at the beginning of this file. This routine is used
+! for slicer colortable settings.
+!
+! Revision 1.10  2003/03/16 09:42:34  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.9  2003/03/04 11:35:07  raasch
+! Update for new version of dvrp software (e.g. using module dvrp is now
+! mandatory)
+!
+! Revision 1.8  2001/11/09 13:41:21  raasch
+! Colour can change along the particle tails
+!
+! Revision 1.7  2001/08/21 09:55:20  raasch
+! Superelevation for particles implemented, plotting of particle tails added,
+! colourtable definitions moved to subroutine user_dvrp_coltab
+!
+! Revision 1.6  2001/07/12 12:44:12  raasch
+! Test: color definitions for particles changed
+!
+! Revision 1.5  2001/03/30 07:45:00  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.4  2001/01/29 12:32:51  raasch
+! Passive scalar considered
+!
+! Revision 1.3  2001/01/22 07:41:12  raasch
+! Module test_variables removed
+!
+! Revision 1.2  2000/12/28 13:37:19  raasch
+! Total revision due to new features of dvrp-software,
+! plot of slicers included,
+! code is used only optionally (cpp-directives are added)
+!
+! Revision 1.1  2000/04/27 06:27:17  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Plot of isosurface, particles and slicers with dvrp-software
+!------------------------------------------------------------------------------!
+#if defined( __dvrp_graphics )
+
+    USE arrays_3d
+    USE cloud_parameters
+    USE cpulog
+    USE DVRP
+    USE dvrp_color
+    USE dvrp_variables
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE particle_attributes
+    USE pegrid
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=2) ::  section_chr
+    CHARACTER (LEN=6) ::  output_variable
+    INTEGER ::  i, j, k, l, m, n, nn, section_mode, tv, vn
+    INTEGER, DIMENSION(:), ALLOCATABLE ::  p_c, p_t
+    REAL    ::  center(3), distance, slicer_position, surface_value
+    REAL, DIMENSION(:),     ALLOCATABLE ::  psize, p_x, p_y, p_z
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
+
+
+    WRITE ( 9, * ) '*** myid=', myid, ' Anfang data_output_dvrp'
+    CALL FLUSH_( 9 )
+    CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
+
+!
+!-- Loop over all output modes choosed
+    m           = 1
+    tv          = 0  ! threshold counter
+    islice_dvrp = 0  ! slice plane counter
+    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.
+    WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: vor steering_update'
+    CALL FLUSH_( 9 )
+          CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
+    WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: nach steering_update'
+    CALL FLUSH_( 9 )
+          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,I1)' )  vn
+          output_variable = do3d(0,vn)
+          tv = tv + 1
+       ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
+          READ ( mode_dvrp(m), '(6X,I1)' )  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:9) == 'particles' )  THEN
+
+#if defined( __particles )
+    WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang particles'
+    CALL FLUSH_( 9 )
+!
+!--       DVRP-Calls for plotting particles:
+          CALL cpu_log( log_point_s(28), 'dvrp_particles', 'start' )
+
+!
+!--       Definition of characteristics of particle material
+          CALL DVRP_MATERIAL_RGB( m-1, 1, 0.1, 0.7, 0.1, 0.0 )
+
+!
+!--       Move particle coordinates to one-dimensional arrays
+          IF ( .NOT. use_particle_tails )  THEN
+!
+!--          All particles are output
+             ALLOCATE( psize(number_of_particles), p_t(number_of_particles), &
+                       p_c(number_of_particles), p_x(number_of_particles),   &
+                       p_y(number_of_particles), p_z(number_of_particles) )
+             psize = 0.0;  p_t = 0;  p_c = 0.0;  p_x = 0.0;  p_y = 0.0
+             p_z   = 0.0;
+             psize = particles(1:number_of_particles)%dvrp_psize
+             p_x   = particles(1:number_of_particles)%x * superelevation_x
+             p_y   = particles(1:number_of_particles)%y * superelevation_y
+             p_z   = particles(1:number_of_particles)%z * superelevation
+             p_c   = particles(1:number_of_particles)%color
+          ELSE
+!
+!--          Particles have a tail
+             WRITE (9,*) '--- before ALLOCATE  simtime=',simulated_time,' #of_tails=', number_of_tails, &
+                           ' max#of_tp=', maximum_number_of_tailpoints
+             CALL FLUSH_( 9 )
+             ALLOCATE( psize(number_of_tails), p_t(number_of_tails),      &
+                       p_c(number_of_tails*maximum_number_of_tailpoints), &
+                       p_x(number_of_tails*maximum_number_of_tailpoints), &
+                       p_y(number_of_tails*maximum_number_of_tailpoints), &
+                       p_z(number_of_tails*maximum_number_of_tailpoints) )
+             WRITE (9,*) '--- after ALLOCATE'
+             CALL FLUSH_( 9 )
+             psize = 0.0;  p_t = 0;  p_c = 0.0;  p_x = 0.0;  p_y = 0.0
+             p_z   = 0.0;
+             i = 0
+             k = 0
+             DO  n = 1, number_of_particles
+                nn = particles(n)%tail_id
+                IF ( nn /= 0 )  THEN
+                   k = k + 1
+                   IF ( simulated_time > 1338.0 )  THEN
+                      WRITE (9,*) '--- particle ',n,' tail_id=',nn,' #of_tp=',particles(n)%tailpoints
+                      CALL FLUSH_( 9 )
+                   ENDIF
+                   DO  j = 1, particles(n)%tailpoints
+                      i = i + 1
+                      p_x(i) = particle_tail_coordinates(j,1,nn) * &
+                                                                superelevation_x
+                      p_y(i) = particle_tail_coordinates(j,2,nn) * &
+                                                                superelevation_y
+                      p_z(i) = particle_tail_coordinates(j,3,nn) * &
+                                                                superelevation
+                      p_c(i) = particle_tail_coordinates(j,4,nn)
+                      IF ( simulated_time > 1338.0 )  THEN
+                         WRITE (9,*) '--- tp= ',i,' x=',p_x(i),' y=',p_y(i), &
+                                                 ' z=',p_z(i),' c=',p_c(i)
+                         CALL FLUSH_( 9 )
+                      ENDIF
+                   ENDDO
+                   psize(k) = particles(n)%dvrp_psize
+                   p_t(k)   = particles(n)%tailpoints - 1
+                   IF ( simulated_time > 1338.0 )  THEN
+                      WRITE (9,*) '--- t= ',k,' psize=',psize(k),' p_t=',p_t(k)
+                      CALL FLUSH_( 9 )
+                   ENDIF
+                ENDIF                
+             ENDDO
+             WRITE (9,*) '--- after locally storing the particle attributes'
+             CALL FLUSH_( 9 )
+          ENDIF
+
+!
+!--       Compute and plot particles in dvr-format
+          IF ( uniform_particles  .AND.  .NOT. use_particle_tails )  THEN
+!
+!--          All particles have the same color. Use simple routine to set
+!--          the particle attributes (produces less output data)
+             CALL DVRP_PARTICLES( m-1, p_x, p_y, p_z, psize )
+          ELSE
+!
+!--          Set color definitions
+             CALL user_dvrp_coltab( 'particles', 'none' )
+
+             CALL DVRP_COLORTABLE_HLS( m-1, 0, interval_values_dvrp,     &
+                                       interval_h_dvrp, interval_l_dvrp, &
+                                       interval_s_dvrp, interval_a_dvrp )
+
+             IF ( .NOT. use_particle_tails )  THEN
+                CALL DVRP_PARTICLES( m-1, number_of_particles, p_x, p_y, p_z, &
+                                     3, psize, p_c, p_t )
+             ELSE
+                WRITE (9,*) '--- before DVRP_PARTICLES'
+                CALL FLUSH_( 9 )
+                CALL DVRP_PARTICLES( m-1, number_of_tails, p_x, p_y, p_z, 15, &
+                                     psize, p_c, p_t )
+                WRITE (9,*) '--- after DVRP_PARTICLES'
+                CALL FLUSH_( 9 )
+             ENDIF
+          ENDIF
+
+          CALL DVRP_VISUALIZE( m-1, 3, dvrp_filecount )
+    WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende particles'
+    CALL FLUSH_( 9 )
+
+          DEALLOCATE( psize, p_c, p_t, p_x, p_y, p_z )
+
+          CALL cpu_log( log_point_s(28), 'dvrp_particles', 'stop' )
+#endif
+
+
+       ELSEIF ( ( 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:nxr+1,nys:nyn+1,nzb:nz_do3d) )
+
+!
+!--       Move original array to intermediate array
+          SELECT CASE ( output_variable )
+
+             CASE ( 'u', 'u_xy', 'u_xz', 'u_yz' )
+                DO  i = nxl, nxr+1
+                   DO  j = nys, nyn+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
+                ENDIF
+
+
+             CASE ( 'v', 'v_xy', 'v_xz', 'v_yz' )
+                DO  i = nxl, nxr+1
+                   DO  j = nys, nyn+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
+                ENDIF
+
+             CASE ( 'w', 'w_xy', 'w_xz', 'w_yz' )
+                DO  i = nxl, nxr+1
+                   DO  j = nys, nyn+1
+                      DO  k = nzb, nz_do3d
+                         local_pf(i,j,k) = w(k,j,i)
+                      ENDDO
+                   ENDDO
+                ENDDO
+
+             CASE ( 'p', 'p_xy', 'p_xz', 'p_yz' )
+                DO  i = nxl, nxr+1
+                   DO  j = nys, nyn+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, nxr+1
+                      DO  j = nys, nyn+1
+                         DO  k = nzb, nz_do3d
+                            local_pf(i,j,k) = pt(k,j,i)
+                         ENDDO
+                      ENDDO
+                   ENDDO
+                ELSE
+                   DO  i = nxl, nxr+1
+                      DO  j = nys, nyn+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 ( moisture  .OR.  passive_scalar )  THEN
+                   DO  i = nxl, nxr+1
+                      DO  j = nys, nyn+1
+                         DO  k = nzb, nz_do3d
+                            local_pf(i,j,k) = q(k,j,i)
+                         ENDDO
+                      ENDDO
+                   ENDDO            
+                ELSE
+                   IF ( myid == 0 )  THEN
+                      PRINT*, '+++ data_output_dvrp: if moisture/passive_scalar = ', & 
+                              'FALSE output of ', output_variable,            &
+                              'is not provided' 
+                   ENDIF
+                ENDIF
+             
+             CASE ( 'ql', 'ql_xy', 'ql_xz', 'ql_yz' )
+                IF ( cloud_physics  .OR.  cloud_droplets )  THEN
+                   DO  i = nxl, nxr+1
+                      DO  j = nys, nyn+1
+                         DO  k = nzb, nz_do3d
+                            local_pf(i,j,k) = ql(k,j,i)
+                         ENDDO
+                      ENDDO
+                   ENDDO
+                ELSE
+                   IF ( myid == 0 ) THEN
+                      PRINT*, '+++ data_output_dvrp: if cloud_physics = FALSE ', & 
+                              'output of ', output_variable, 'is not provided' 
+                   ENDIF
+                ENDIF
+
+             CASE ( 'u*_xy' )
+                DO  i = nxl, nxr+1
+                   DO  j = nys, nyn+1
+                      local_pf(i,j,nzb+1) = us(j,i)
+                   ENDDO
+                ENDDO
+                slicer_position = zu(nzb+1)
+
+             CASE ( 't*_xy' )
+                DO  i = nxl, nxr+1
+                   DO  j = nys, nyn+1
+                      local_pf(i,j,nzb+1) = ts(j,i)
+                   ENDDO
+                ENDDO
+                slicer_position = zu(nzb+1)
+
+
+             CASE DEFAULT
+                IF ( myid == 0 )  THEN
+                   PRINT*,'+++ data_output_dvrp: no output possible for: ', &
+                          output_variable
+                ENDIF
+
+          END SELECT
+
+
+          IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
+
+    WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang isosurface'
+    CALL FLUSH_( 9 )
+!
+!--          DVRP-Calls for plotting isosurfaces:
+             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'start' )
+
+!
+!--          Definition of characteristics of isosurface material
+!--          Preliminary settings for w!
+             IF ( output_variable == 'w' )  THEN
+                CALL DVRP_MATERIAL_RGB( m-1, 1, 0.3, 0.8, 0.3, 0.0 )
+             ELSE
+                CALL DVRP_MATERIAL_RGB( m-1, 1, 0.9, 0.9, 0.9, 0.0 )
+             ENDIF
+
+!
+!--          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 )
+             CALL DVRP_THRESHOLD( m-1, threshold(tv) )
+             CALL DVRP_VISUALIZE( m-1, 1, dvrp_filecount )
+    WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende isosurface'
+    CALL FLUSH_( 9 )
+
+             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
+
+          ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
+
+    WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang slicer'
+    CALL FLUSH_( 9 )
+!
+!--          DVRP-Calls for plotting slicers:
+             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'start' )
+
+!
+!--          Material and color definitions
+             CALL DVRP_MATERIAL_RGB( m-1, 1, 0.0, 0.0, 0.0, 0.0 )
+
+             islice_dvrp = islice_dvrp + 1
+!             CALL DVRP_COLORFUNCTION( m-1, DVRP_CM_HLS, 25,                    &
+!                                      slicer_range_limits_dvrp(:,islice_dvrp), &
+!                                      color_dvrp )
+
+             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 )
+             CALL DVRP_SLICER( m-1, section_mode, slicer_position )
+             CALL DVRP_VISUALIZE( m-1, 2, dvrp_filecount )
+
+             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
+
+    WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende slicer'
+    CALL FLUSH_( 9 )
+          ENDIF
+
+          DEALLOCATE( local_pf )
+
+       ENDIF
+
+       m = m + 1
+
+    ENDDO
+
+    dvrp_filecount = dvrp_filecount + 1
+
+    CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
+    WRITE ( 9, * ) '*** myid=', myid, ' Ende data_output_dvrp'
+    CALL FLUSH_( 9 )
+
+#endif
+ END SUBROUTINE data_output_dvrp
Index: palm/trunk/SOURCE/data_output_flight.f90
===================================================================
--- palm/trunk/SOURCE/data_output_flight.f90	(revision 4901)
+++ 	(revision )
@@ -1,131 +1,0 @@
-!> @file data_output_flight.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! unused variables removed
-!
-! 1957 2016-07-07 10:43:48Z suehring
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Writing data from flight measurements on file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE data_output_flight
-
-#if defined( __netcdf )
-    USE control_parameters,                                                                        &
-        ONLY:  num_leg, num_var_fl, time_since_reference_point, virtual_flight
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point
-
-    USE flight_mod,                                                                                &
-        ONLY:  sensor, x_pos, y_pos, z_pos
-
-    USE kinds
-
-    USE NETCDF
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  dofl_time_count, id_set_fl, id_var_dofl, id_var_time_fl, id_var_x_fl, id_var_y_fl,  &
-               id_var_z_fl, nc_stat, netcdf_handle_error
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !< loop variable for output quantities
-    INTEGER(iwp) ::  l !< loop variable for flight legs
-    INTEGER(iwp) ::  k !< internal count for variable labels and units
-
-    CALL cpu_log( log_point(64), 'data_output_flight', 'start' )
-
-!
-!-- Check if virtual flights are carried out
-    IF ( .NOT. virtual_flight )  RETURN
-
-!
-!-- Output is only performed on PE0
-    IF ( myid == 0 )  THEN
-
-!
-!--    Open file for flight output in NetCDF format
-       CALL check_open( 199 )
-
-!
-!--    Increment the counter for number of output times
-       dofl_time_count = dofl_time_count + 1
-
-!
-!--    Update the flight-output time and spatial coordinates
-       nc_stat = NF90_PUT_VAR( id_set_fl, id_var_time_fl,                                          &
-                               (/ time_since_reference_point /),                                   &
-                               start = (/ dofl_time_count /),                                      &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_flight', 554 )
-
-       DO  l = 1, num_leg
-          nc_stat = NF90_PUT_VAR( id_set_fl, id_var_x_fl(l),                                       &
-                                  (/ x_pos(l) /),                                                  &
-                                  start = (/ dofl_time_count /),                                   &
-                                  count = (/ 1 /) )
-          nc_stat = NF90_PUT_VAR( id_set_fl, id_var_y_fl(l),                                       &
-                                  (/ y_pos(l) /),                                                  &
-                                  start = (/ dofl_time_count /),                                   &
-                                  count = (/ 1 /) )
-          nc_stat = NF90_PUT_VAR( id_set_fl, id_var_z_fl(l),                                       &
-                                  (/ z_pos(l) /),                                                  &
-                                  start = (/ dofl_time_count /),                                   &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'data_output_flight', 555 )
-       ENDDO
-!
-!--    Output measured quantities
-       k = 1
-       DO  l = 1, num_leg
-          DO i = 1, num_var_fl
-             nc_stat = NF90_PUT_VAR( id_set_fl, id_var_dofl(k),                                    &
-                                     (/ sensor(i,l) /),                                            &
-                                     start = (/ dofl_time_count /),                                &
-                                     count = (/ 1 /) )
-
-             CALL netcdf_handle_error( 'data_output_flight', 556 )
-
-             k = k + 1
-          ENDDO
-       ENDDO
-    ENDIF
-
-    CALL cpu_log( log_point(64), 'data_output_flight', 'stop' )
-
-#endif
- END SUBROUTINE data_output_flight
Index: palm/trunk/SOURCE/data_output_mask.f90
===================================================================
--- palm/trunk/SOURCE/data_output_mask.f90	(revision 4901)
+++ 	(revision )
@@ -1,845 +1,0 @@
-!> @file data_output_mask.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! small re-formatting to follow the coding standard
-! 
-! 4895 2021-03-03 15:39:08Z suehring
-! Remove offset in terrain-following masked output
-! 
-! 4828 2021-01-05 11:21:41Z Giersch
-! file re-formatted to follow the PALM coding standard
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4377 2020-01-15 11:10:51Z gronemeier
-! bugfix: set fill value for output according to wall_flags_total_0 for non-terrain following output
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4331 2019-12-10 18:25:02Z suehring
-! Formatting adjustment
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4246 2019-09-30 09:27:52Z pavelkrc
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Remove variable grid
-!
-! 4167 2019-08-16 11:01:48Z suehring
-! Changed behaviour of masked output over surface to follow terrain and ignore buildings
-! (J.Resler, T.Gronemeier)
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to avoid runtime error
-! (Loop variable has been modified) in time_integration
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! Modularize diagnostic output
-!
-! 3994 2019-05-22 18:08:09Z suehring
-! output of turbulence intensity added
-!
-! 3665 2019-01-10 08:28:24Z raasch
-! unused variables removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Fix output time levels (use time_since_reference_point)
-!
-! 410 2009-12-04 17:05:40Z letzel
-! Initial version
-!
-! Description:
-! ------------
-!> Masked data output in netCDF format for current mask (current value of mid).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE data_output_mask( av, mid )
-
-
-
-#if defined( __netcdf )
-    USE arrays_3d,                                                                                 &
-        ONLY:  d_exner, e, nc, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa, tend, u, v, &
-               vpt, w
-
-    USE averaging,                                                                                 &
-        ONLY:  e_av, lpt_av, nc_av, nr_av, p_av, pc_av, pr_av, pt_av, q_av, qc_av, ql_av, ql_c_av, &
-               ql_v_av, ql_vp_av, qv_av, qr_av, rho_ocean_av, s_av, sa_av, u_av, v_av, vpt_av, w_av
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  lv_d_cp
-
-    USE chemistry_model_mod,                                                                       &
-        ONLY:  chem_data_output_mask
-
-    USE control_parameters,                                                                        &
-        ONLY:  air_chemistry, domask, domask_no, domask_time_count, mask_i, mask_j, mask_k,        &
-               mask_size_l, mask_surface, max_masks, message_string, nz_do3d, salsa,               &
-               time_since_reference_point
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  mask_size, mask_start_l
-#endif
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point
-
-    USE diagnostic_output_quantities_mod,                                                          &
-        ONLY:  doq_output_mask
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt, wall_flags_total_0
-
-    USE kinds
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    USE NETCDF
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  fill_value, id_set_mask, id_var_domask, id_var_time_mask, nc_stat,                  &
-               netcdf_data_format, netcdf_handle_error
-
-    USE particle_attributes,                                                                       &
-        ONLY:  grid_particles, number_of_particles, particles, particle_advection_start, prt_count
-
-    USE pegrid
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  radiation, radiation_data_output_mask
-
-    USE salsa_mod,                                                                                 &
-        ONLY:  salsa_data_output_mask
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  av                      !< flag for (non-)average output
-    INTEGER(iwp) ::  flag_nr                 !< number of masking flag
-    INTEGER(iwp) ::  i                       !< loop index
-    INTEGER(iwp) ::  im                      !< loop index for masked variables
-    INTEGER(iwp) ::  ivar                    !< variable index
-    INTEGER(iwp) ::  j                       !< loop index
-    INTEGER(iwp) ::  jm                      !< loop index for masked variables
-    INTEGER(iwp) ::  k                       !< loop index
-    INTEGER(iwp) ::  kk                      !< vertical index
-    INTEGER(iwp) ::  ktt                     !< k index of lowest non-terrain surface
-    INTEGER(iwp) ::  mid                     !< masked output running index
-    INTEGER(iwp) ::  n                       !< loop index
-    INTEGER(iwp) ::  netcdf_data_format_save !< value of netcdf_data_format
-#if defined( __parallel )
-    INTEGER(iwp) ::  ind(6)                  !< index limits (lower/upper bounds) of array 'local_2d'
-    INTEGER(iwp) ::  ngp                     !< number of grid points of an output slice
-    INTEGER(iwp) ::  sender                  !< PE id of sending PE
-#endif
-
-    LOGICAL ::  found      !< true if output variable was found
-    LOGICAL ::  resorted   !< true if variable is resorted
-
-    REAL(wp) ::  mean_r    !< mean particle radius
-    REAL(wp) ::  s_r2      !< sum( particle-radius**2 )
-    REAL(wp) ::  s_r3      !< sum( particle-radius**3 )
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf    !< output array
-#if defined( __parallel )
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  total_pf    !< collected output array
-#endif
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to array which shall be output
-
-
-!
-!-- Return, if nothing to output
-    IF ( domask_no(mid,av) == 0 )  RETURN
-
-    CALL cpu_log (log_point(49),'data_output_mask','start')
-
-!
-!-- Parallel netcdf output is not tested so far for masked data, hence netcdf_data_format is
-!-- switched back to non-paralell output.
-    netcdf_data_format_save = netcdf_data_format
-    IF ( netcdf_data_format == 5 ) netcdf_data_format = 3
-    IF ( netcdf_data_format == 6 ) netcdf_data_format = 4
-
-!
-!-- Open output file.
-    IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
-       CALL check_open( 200+mid+av*max_masks )
-    ENDIF
-
-!
-!-- Allocate total and local output arrays.
-#if defined( __parallel )
-    IF ( myid == 0 )  THEN
-       ALLOCATE( total_pf( mask_size(mid,1),mask_size(mid,2),mask_size(mid,3) ) )
-    ENDIF
-#endif
-    ALLOCATE( local_pf( mask_size_l(mid,1),mask_size_l(mid,2), mask_size_l(mid,3) ) )
-
-!
-!-- Update the netCDF time axis.
-    domask_time_count(mid,av) = domask_time_count(mid,av) + 1
-    IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
-       nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_time_mask(mid,av),                      &
-                               (/ time_since_reference_point /),                                   &
-                               start = (/ domask_time_count(mid,av) /),                            &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_mask', 460 )
-    ENDIF
-
-!
-!-- Loop over all variables to be written.
-    ivar = 1
-
-    DO  WHILE ( domask(mid,av,ivar)(1:1) /= ' ' )
-!
-!--    Reallocate local_pf on PE 0 since its shape changes during MPI exchange
-       IF ( netcdf_data_format < 5  .AND.  myid == 0  .AND.  ivar > 1 )  THEN
-          DEALLOCATE( local_pf )
-          ALLOCATE( local_pf( mask_size_l(mid,1),mask_size_l(mid,2), mask_size_l(mid,3) ) )
-       ENDIF
-!
-!--    Set masking flag for topography for not resorted arrays
-       flag_nr = 0
-!
-!--    Store the variable chosen.
-       resorted = .FALSE.
-       SELECT CASE ( TRIM( domask(mid,av,ivar) ) )
-
-          CASE ( 'e' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => e
-             ELSE
-                to_be_resorted => e_av
-             ENDIF
-
-          CASE ( 'thetal' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => pt
-             ELSE
-                to_be_resorted => lpt_av
-             ENDIF
-
-          CASE ( 'nc' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => nc
-             ELSE
-                to_be_resorted => nc_av
-             ENDIF
-
-          CASE ( 'nr' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => nr
-             ELSE
-                to_be_resorted => nr_av
-             ENDIF
-
-          CASE ( 'p' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => p
-             ELSE
-                to_be_resorted => p_av
-             ENDIF
-
-          CASE ( 'pc' )  ! particle concentration (requires ghostpoint exchange)
-             IF ( av == 0 )  THEN
-                tend = prt_count
-                CALL exchange_horiz( tend, nbgp )
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) =  tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-!
-!--                Terrain-following masked output
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ),     &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) =  tend(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                CALL exchange_horiz( pc_av, nbgp )
-                to_be_resorted => pc_av
-             ENDIF
-
-          CASE ( 'pr' )  ! mean particle radius (effective radius)
-             IF ( av == 0 )  THEN
-                IF ( time_since_reference_point >= particle_advection_start )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb, nz_do3d
-                            number_of_particles = prt_count(k,j,i)
-                            IF ( number_of_particles <= 0 )  CYCLE
-                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                            s_r2 = 0.0_wp
-                            s_r3 = 0.0_wp
-                            DO  n = 1, number_of_particles
-                               IF ( particles(n)%particle_mask )  THEN
-                                  s_r2 = s_r2 + grid_particles(k,j,i)%particles(n)%radius**2 *     &
-                                         grid_particles(k,j,i)%particles(n)%weight_factor
-                                  s_r3 = s_r3 + grid_particles(k,j,i)%particles(n)%radius**3 *     &
-                                         grid_particles(k,j,i)%particles(n)%weight_factor
-                               ENDIF
-                            ENDDO
-                            IF ( s_r2 > 0.0_wp )  THEN
-                               mean_r = s_r3 / s_r2
-                            ELSE
-                               mean_r = 0.0_wp
-                            ENDIF
-                            tend(k,j,i) = mean_r
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                   CALL exchange_horiz( tend, nbgp )
-                ELSE
-                   tend = 0.0_wp
-                ENDIF
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) =  tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-!
-!--                Terrain-following masked output
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) =  tend(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                CALL exchange_horiz( pr_av, nbgp )
-                to_be_resorted => pr_av
-             ENDIF
-
-          CASE ( 'theta' )
-             IF ( av == 0 )  THEN
-                IF ( .NOT. bulk_cloud_model ) THEN
-                   to_be_resorted => pt
-                ELSE
-                   IF ( .NOT. mask_surface(mid) )  THEN
-                      DO  i = 1, mask_size_l(mid,1)
-                         DO  j = 1, mask_size_l(mid,2)
-                            DO  k = 1, mask_size_l(mid,3)
-                               local_pf(i,j,k) = pt( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) &
-                                                 + lv_d_cp * d_exner( mask_k(mid,k) ) *            &
-                                                   ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i) )
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ELSE
-!
-!--                   Terrain-following masked output
-                      DO  i = 1, mask_size_l(mid,1)
-                         DO  j = 1, mask_size_l(mid,2)
-!
-!--                         Get k index of the lowest non-terrain grid point
-                            im = mask_i(mid,i)
-                            jm = mask_j(mid,j)
-                            ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),   &
-                                          DIM = 1 ) - 1
-                            DO  k = 1, mask_size_l(mid,3)
-                               kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                            Set value if not in building, else set fill value
-                               IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                                  local_pf(i,j,k) = fill_value
-                               ELSE
-                                  local_pf(i,j,k) = pt(kk,jm,im) +                                 &
-                                                    lv_d_cp * d_exner(kk) * ql(kk,jm,im)
-                               ENDIF
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ENDIF
-                   resorted = .TRUE.
-                ENDIF
-             ELSE
-                to_be_resorted => pt_av
-             ENDIF
-
-          CASE ( 'q' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => q
-             ELSE
-                to_be_resorted => q_av
-             ENDIF
-
-          CASE ( 'qc' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => qc
-             ELSE
-                to_be_resorted => qc_av
-             ENDIF
-
-          CASE ( 'ql' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => ql
-             ELSE
-                to_be_resorted => ql_av
-             ENDIF
-
-          CASE ( 'ql_c' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => ql_c
-             ELSE
-                to_be_resorted => ql_c_av
-             ENDIF
-
-          CASE ( 'ql_v' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => ql_v
-             ELSE
-                to_be_resorted => ql_v_av
-             ENDIF
-
-          CASE ( 'ql_vp' )
-             IF ( av == 0 )  THEN
-                IF ( time_since_reference_point >= particle_advection_start )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb, nz_do3d
-                            number_of_particles = prt_count(k,j,i)
-                            IF ( number_of_particles <= 0 )  CYCLE
-                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                            DO  n = 1, number_of_particles
-                               IF ( particles(n)%particle_mask )  THEN
-                                  tend(k,j,i) = tend(k,j,i) + &
-                                          particles(n)%weight_factor / prt_count(k,j,i)
-                               ENDIF
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                   CALL exchange_horiz( tend, nbgp )
-                ELSE
-                   tend = 0.0_wp
-                ENDIF
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) =  tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-!
-!--                Terrain-following masked output
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) = tend(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                CALL exchange_horiz( ql_vp_av, nbgp )
-                to_be_resorted => ql_vp_av
-             ENDIF
-
-          CASE ( 'qv' )
-             IF ( av == 0 )  THEN
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) = q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) -       &
-                                              ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-!
-!--                Terrain-following masked output
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) = q(kk,jm,im) - ql(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                to_be_resorted => qv_av
-             ENDIF
-
-          CASE ( 'qr' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => qr
-             ELSE
-                to_be_resorted => qr_av
-             ENDIF
-
-          CASE ( 'rho_sea_water' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => rho_ocean
-             ELSE
-                to_be_resorted => rho_ocean_av
-             ENDIF
-
-          CASE ( 's' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => s
-             ELSE
-                to_be_resorted => s_av
-             ENDIF
-
-          CASE ( 'sa' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => sa
-             ELSE
-                to_be_resorted => sa_av
-             ENDIF
-
-          CASE ( 'u' )
-             flag_nr = 1
-             IF ( av == 0 )  THEN
-                to_be_resorted => u
-             ELSE
-                to_be_resorted => u_av
-             ENDIF
-
-          CASE ( 'v' )
-             flag_nr = 2
-             IF ( av == 0 )  THEN
-                to_be_resorted => v
-             ELSE
-                to_be_resorted => v_av
-             ENDIF
-
-          CASE ( 'thetav' )
-             IF ( av == 0 )  THEN
-                to_be_resorted => vpt
-             ELSE
-                to_be_resorted => vpt_av
-             ENDIF
-
-          CASE ( 'w' )
-             flag_nr = 3
-             IF ( av == 0 )  THEN
-                to_be_resorted => w
-             ELSE
-                to_be_resorted => w_av
-             ENDIF
-
-          CASE DEFAULT
-!
-!--          Set flag to steer output of radiation, land-surface, or user-defined quantities
-             found = .FALSE.
-!
-!--          Radiation quantity
-             IF ( .NOT. found  .AND. radiation )  THEN
-                CALL radiation_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid )
-             ENDIF
-
-             IF ( .NOT. found  .AND. air_chemistry )  THEN
-                CALL chem_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid )
-             ENDIF
-!
-!--          Check for diagnostic quantities
-             IF ( .NOT. found )  THEN
-                CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf, mid )
-             ENDIF
-!
-!--          SALSA quantities
-             IF ( .NOT. found  .AND.  salsa )  THEN
-                CALL salsa_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid )
-             ENDIF
-!
-!--          User defined quantity
-             IF ( .NOT. found )  THEN
-                CALL user_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid )
-             ENDIF
-
-             resorted = .TRUE.
-
-             IF ( .NOT. found )  THEN
-                WRITE ( message_string, * ) 'no masked output available for: ',                    &
-                                            TRIM( domask(mid,av,ivar) )
-                CALL message( 'data_output_mask', 'PA0327', 0, 0, 0, 6, 0 )
-             ENDIF
-
-       END SELECT
-
-!
-!--    Resort the array to be output, if not done above
-       IF ( .NOT. resorted )  THEN
-          IF ( .NOT. mask_surface(mid) )  THEN
-!
-!--          Default masked output
-             DO  i = 1, mask_size_l(mid,1)
-                DO  j = 1, mask_size_l(mid,2)
-                   DO  k = 1, mask_size_l(mid,3)
-                      local_pf(i,j,k) = MERGE( to_be_resorted( mask_k(mid,k),                      &
-                                                               mask_j(mid,j),                      &
-                                                               mask_i(mid,i)),                     &
-                                               REAL( fill_value, KIND = wp ),                      &
-                                               BTEST( wall_flags_total_0( mask_k(mid,k),           &
-                                                                          mask_j(mid,j),           &
-                                                                          mask_i(mid,i) ),         &
-                                                      flag_nr )                                    &
-                                             )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-          ELSE
-!
-!--          Terrain-following masked output
-             DO  i = 1, mask_size_l(mid,1)
-                DO  j = 1, mask_size_l(mid,2)
-!
-!--                Get k index of the lowest non-terrain grid point
-                   im = mask_i(mid,i)
-                   jm = mask_j(mid,j)
-                   ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ),     &
-                                 DIM = 1 ) - 1
-                   DO  k = 1, mask_size_l(mid,3)
-                      kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                   Set value if not in building, else set fill value
-                      IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                         local_pf(i,j,k) = fill_value
-                      ELSE
-                         local_pf(i,j,k) = to_be_resorted(kk,jm,im)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-
-          ENDIF
-       ENDIF
-
-!
-!--    I/O block. I/O methods are implemented
-!--    (1) for parallel execution
-!--     a. with netCDF 4 parallel I/O-enabled library
-!--     b. with netCDF 3 library
-!--    (2) for serial execution.
-!--    The choice of method depends on the correct setting of preprocessor
-!--    directives __parallel and __netcdf4_parallel as well as on the parameter
-!--    netcdf_data_format.
-#if defined( __parallel )
-#if defined( __netcdf4_parallel )
-       IF ( netcdf_data_format > 4 )  THEN
-!
-!--       (1) a. Parallel I/O using netCDF 4 (not yet tested)
-          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                             &
-                                  id_var_domask(mid,av,ivar), local_pf,                            &
-                                  start = (/ mask_start_l(mid,1), mask_start_l(mid,2),             &
-                                             mask_start_l(mid,3), domask_time_count(mid,av) /),    &
-                                  count = (/ mask_size_l(mid,1), mask_size_l(mid,2),               &
-                                             mask_size_l(mid,3), 1 /) )
-          CALL netcdf_handle_error( 'data_output_mask', 461 )
-       ELSE
-#endif
-!
-!--       (1) b. Conventional I/O only through PE0
-!--       PE0 receives partial arrays from all processors of the respective mask and outputs them.
-!--       Here a barrier has to be set, because otherwise "-MPI- FATAL: Remote protocol queue full"
-!--       may occur.
-          CALL MPI_BARRIER( comm2d, ierr )
-
-          ngp = mask_size_l(mid,1) * mask_size_l(mid,2) * mask_size_l(mid,3)
-          IF ( myid == 0 )  THEN
-!
-!--          Local array can be relocated directly.
-             total_pf( mask_start_l(mid,1):mask_start_l(mid,1)+mask_size_l(mid,1)-1,               &
-                       mask_start_l(mid,2):mask_start_l(mid,2)+mask_size_l(mid,2)-1,               &
-                       mask_start_l(mid,3):mask_start_l(mid,3)+mask_size_l(mid,3)-1 )              &
-                  = local_pf
-!
-!--          Receive data from all other PEs.
-             DO  n = 1, numprocs-1
-!
-!--             Receive index limits first, then array.
-!--             Index limits are received in arbitrary order from the PEs.
-                CALL MPI_RECV( ind(1), 6, MPI_INTEGER, MPI_ANY_SOURCE, 0, comm2d, status, ierr )
-!
-!--             Not all PEs have data for the mask
-                IF ( ind(1) /= -9999 )  THEN
-                   ngp = ( ind(2)-ind(1)+1 ) * (ind(4)-ind(3)+1 ) * ( ind(6)-ind(5)+1 )
-                   sender = status(MPI_SOURCE)
-                   DEALLOCATE( local_pf )
-                   ALLOCATE( local_pf( ind(1):ind(2),ind(3):ind(4),ind(5):ind(6) ) )
-                   CALL MPI_RECV( local_pf(ind(1),ind(3),ind(5)), ngp, MPI_REAL, sender, 1, comm2d,&
-                                  status, ierr )
-                   total_pf( ind(1):ind(2),ind(3):ind(4),ind(5):ind(6) ) = local_pf
-                ENDIF
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                          &
-                                     id_var_domask(mid,av,ivar), total_pf,                         &
-                                     start = (/ 1, 1, 1, domask_time_count(mid,av) /),             &
-                                     count = (/ mask_size(mid,1), mask_size(mid,2),                &
-                                                mask_size(mid,3), 1 /) )
-             CALL netcdf_handle_error( 'data_output_mask', 462 )
-
-          ELSE
-!
-!--          If at least part of the mask resides on the PE, send the index limits for the target
-!--          array, otherwise send -9999 to PE0.
-             IF ( mask_size_l(mid,1) > 0  .AND.  mask_size_l(mid,2) > 0  .AND.                     &
-                  mask_size_l(mid,3) > 0  )  THEN
-                ind(1) = mask_start_l(mid,1)
-                ind(2) = mask_start_l(mid,1) + mask_size_l(mid,1) - 1
-                ind(3) = mask_start_l(mid,2)
-                ind(4) = mask_start_l(mid,2) + mask_size_l(mid,2) - 1
-                ind(5) = mask_start_l(mid,3)
-                ind(6) = mask_start_l(mid,3) + mask_size_l(mid,3) - 1
-             ELSE
-                ind(1) = -9999; ind(2) = -9999
-                ind(3) = -9999; ind(4) = -9999
-                ind(5) = -9999; ind(6) = -9999
-             ENDIF
-             CALL MPI_SEND( ind(1), 6, MPI_INTEGER, 0, 0, comm2d, ierr )
-!
-!--          If applicable, send data to PE0.
-             IF ( ind(1) /= -9999 )  THEN
-                CALL MPI_SEND( local_pf(1,1,1), ngp, MPI_REAL, 0, 1, comm2d, ierr )
-             ENDIF
-          ENDIF
-!
-!--       A barrier has to be set, because otherwise some PEs may proceed too fast so that PE0 may
-!--       receive wrong data on tag 0.
-          CALL MPI_BARRIER( comm2d, ierr )
-#if defined( __netcdf4_parallel )
-       ENDIF
-#endif
-#else
-!
-!--    (2) For serial execution of PALM, the single processor (PE0) holds all data and writes them
-!--        directly to file.
-       nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                                &
-                               id_var_domask(mid,av,ivar), local_pf,                               &
-                               start = (/ 1, 1, 1, domask_time_count(mid,av) /),                   &
-                               count = (/ mask_size_l(mid,1), mask_size_l(mid,2),                  &
-                                          mask_size_l(mid,3), 1 /) )
-       CALL netcdf_handle_error( 'data_output_mask', 463 )
-#endif
-
-       ivar = ivar + 1
-
-    ENDDO
-
-!
-!-- Deallocate temporary arrays.
-    DEALLOCATE( local_pf )
-#if defined( __parallel )
-    IF ( myid == 0 )  THEN
-       DEALLOCATE( total_pf )
-    ENDIF
-#endif
-
-!
-!-- Switch back to original format given by user (see beginning of this routine)
-    netcdf_data_format = netcdf_data_format_save
-
-    CALL cpu_log( log_point(49), 'data_output_mask', 'stop' )
-#endif
-
-
- END SUBROUTINE data_output_mask
Index: palm/trunk/SOURCE/data_output_module.f90
===================================================================
--- palm/trunk/SOURCE/data_output_module.f90	(revision 4901)
+++ 	(revision )
@@ -1,4246 +1,0 @@
-!> @file data_output_module.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2019-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! bugfix: - write unlimited dimension in netcdf4-parallel mode
-! new   : - added optional argument to dom_def_dim to allow that dimension variables can be written
-!           by every PE
-!
-! 4579 2020-06-25 20:05:07Z gronemeier
-! corrected formatting to follow PALM coding standard
-!
-! 4577 2020-06-25 09:53:58Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4500 2020-04-17 10:12:45Z suehring
-! Avoid uninitialized variables
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! Enable character-array output
-!
-! 4147 2019-08-07 09:42:31Z gronemeier
-! corrected indentation according to coding standard
-!
-! 4141 2019-08-05 12:24:51Z gronemeier
-! Initial revision
-!
-!
-! Authors:
-! --------
-!> @author Tobias Gronemeier
-!> @author Helge Knoop
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Data-output module to handle output of variables into output files.
-!>
-!> The module first creates an interal database containing all meta data of all output quantities.
-!> After defining all meta data, the output files are initialized and prepared for writing. When
-!> writing is finished, files can be finalized and closed.
-!> The order of calls are as follows:
-!>   1. Initialize the module via
-!>      'dom_init'
-!>   2. Define output files via (multiple calls of)
-!>      'dom_def_file', 'dom_def_att', 'dom_def_dim', 'dom_def_var'
-!>   3. Leave definition stage via
-!>      'dom_def_end'
-!>   4. Write output data into file via
-!>      'dom_write_var'
-!>   5. Finalize the output via
-!>      'dom_finalize_output'
-!> If any routine exits with a non-zero return value, the error message of the last encountered
-!> error can be fetched via 'dom_get_error_message'.
-!> For debugging purposes, the content of the database can be written to the debug output via
-!> 'dom_database_debug_output'.
-!>
-!> @todo Convert variable if type of given values do not fit specified type.
-!--------------------------------------------------------------------------------------------------!
- MODULE data_output_module
-
-    USE kinds
-
-    USE data_output_netcdf4_module,                                                                &
-       ONLY: netcdf4_finalize,                                                                     &
-             netcdf4_get_error_message,                                                            &
-             netcdf4_init_dimension,                                                               &
-             netcdf4_init_module,                                                                  &
-             netcdf4_init_variable,                                                                &
-             netcdf4_open_file,                                                                    &
-             netcdf4_stop_file_header_definition,                                                  &
-             netcdf4_write_attribute,                                                              &
-             netcdf4_write_variable
-
-    USE data_output_binary_module,                                                                 &
-       ONLY: binary_finalize,                                                                      &
-             binary_get_error_message,                                                             &
-             binary_init_dimension,                                                                &
-             binary_init_module,                                                                   &
-             binary_init_variable,                                                                 &
-             binary_open_file,                                                                     &
-             binary_stop_file_header_definition,                                                   &
-             binary_write_attribute,                                                               &
-             binary_write_variable
-
-    IMPLICIT NONE
-
-    INTEGER, PARAMETER ::  charlen = 100  !< maximum length of character variables
-    INTEGER, PARAMETER ::  no_id = -1     !< default ID if no ID was assigned
-
-    TYPE attribute_type
-       CHARACTER(LEN=charlen) ::  data_type = ''  !< data type
-       CHARACTER(LEN=charlen) ::  name            !< attribute name
-       CHARACTER(LEN=charlen) ::  value_char      !< attribute value if character
-       INTEGER(KIND=1)        ::  value_int8      !< attribute value if 8bit integer
-       INTEGER(KIND=2)        ::  value_int16     !< attribute value if 16bit integer
-       INTEGER(KIND=4)        ::  value_int32     !< attribute value if 32bit integer
-       REAL(KIND=4)           ::  value_real32    !< attribute value if 32bit real
-       REAL(KIND=8)           ::  value_real64    !< attribute value if 64bit real
-    END TYPE attribute_type
-
-    TYPE variable_type
-       CHARACTER(LEN=charlen) ::  data_type = ''                              !< data type
-       CHARACTER(LEN=charlen) ::  name                                        !< variable name
-       INTEGER                ::  id = no_id                                  !< id within file
-       LOGICAL                ::  write_only_by_master_rank = .FALSE.         !< true if only master rank shall write variable
-       CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE ::  dimension_names  !< list of dimension names used by variable
-       INTEGER,                DIMENSION(:), ALLOCATABLE ::  dimension_ids    !< list of dimension ids used by variable
-       TYPE(attribute_type),   DIMENSION(:), ALLOCATABLE ::  attributes       !< list of attributes
-    END TYPE variable_type
-
-    TYPE dimension_type
-       CHARACTER(LEN=charlen) ::  data_type = ''                            !< data type
-       CHARACTER(LEN=charlen) ::  name                                      !< dimension name
-       INTEGER                ::  id = no_id                                !< dimension id within file
-       INTEGER                ::  length                                    !< length of dimension
-       INTEGER                ::  length_mask                               !< length of masked dimension
-       INTEGER                ::  variable_id = no_id                       !< associated variable id within file
-       LOGICAL                ::  is_masked = .FALSE.                       !< true if masked
-       LOGICAL                ::  write_only_by_master_rank = .FALSE.       !< true if only master rank shall write variable
-       INTEGER,         DIMENSION(2)              ::  bounds                !< lower and upper bound of dimension
-       INTEGER,         DIMENSION(:), ALLOCATABLE ::  masked_indices        !< list of masked indices of dimension
-       INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE ::  masked_values_int8    !< masked dimension values if 16bit integer
-       INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE ::  masked_values_int16   !< masked dimension values if 16bit integer
-       INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE ::  masked_values_int32   !< masked dimension values if 32bit integer
-       INTEGER(iwp),    DIMENSION(:), ALLOCATABLE ::  masked_values_intwp   !< masked dimension values if working-precision int
-       INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE ::  values_int8           !< dimension values if 16bit integer
-       INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE ::  values_int16          !< dimension values if 16bit integer
-       INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE ::  values_int32          !< dimension values if 32bit integer
-       INTEGER(iwp),    DIMENSION(:), ALLOCATABLE ::  values_intwp          !< dimension values if working-precision integer
-       LOGICAL,         DIMENSION(:), ALLOCATABLE ::  mask                  !< mask
-       REAL(KIND=4),    DIMENSION(:), ALLOCATABLE ::  masked_values_real32  !< masked dimension values if 32bit real
-       REAL(KIND=8),    DIMENSION(:), ALLOCATABLE ::  masked_values_real64  !< masked dimension values if 64bit real
-       REAL(wp),        DIMENSION(:), ALLOCATABLE ::  masked_values_realwp  !< masked dimension values if working-precision real
-       REAL(KIND=4),    DIMENSION(:), ALLOCATABLE ::  values_real32         !< dimension values if 32bit real
-       REAL(KIND=8),    DIMENSION(:), ALLOCATABLE ::  values_real64         !< dimension values if 64bit real
-       REAL(wp),        DIMENSION(:), ALLOCATABLE ::  values_realwp         !< dimension values if working-precision real
-       TYPE(attribute_type), DIMENSION(:), ALLOCATABLE ::  attributes       !< list of attributes
-    END TYPE dimension_type
-
-    TYPE file_type
-       CHARACTER(LEN=charlen)                          ::  format = ''        !< file format
-       CHARACTER(LEN=charlen)                          ::  name = ''          !< file name
-       INTEGER                                         ::  id = no_id         !< id of file
-       LOGICAL                                         ::  is_init = .FALSE.  !< true if initialized
-       TYPE(attribute_type), DIMENSION(:), ALLOCATABLE ::  attributes         !< list of attributes
-       TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimensions         !< list of dimensions
-       TYPE(variable_type),  DIMENSION(:), ALLOCATABLE ::  variables          !< list of variables
-    END TYPE file_type
-
-
-    CHARACTER(LEN=800)     ::  internal_error_message = ''  !< string containing the last error message
-    CHARACTER(LEN=charlen) ::  output_file_suffix = ''      !< file suffix added to each file name
-    CHARACTER(LEN=800)     ::  temp_string                  !< dummy string
-
-    INTEGER ::  debug_output_unit  !< Fortran Unit Number of the debug-output file
-    INTEGER ::  nfiles = 0         !< number of files
-    INTEGER ::  master_rank = 0    !< master rank for tasks to be executed by single PE only
-    INTEGER ::  output_group_comm  !< MPI communicator addressing all MPI ranks which participate in output
-
-    LOGICAL ::  print_debug_output = .FALSE.  !< if true, debug output is printed
-
-    TYPE(file_type), DIMENSION(:), ALLOCATABLE ::  files  !< file list
-
-    SAVE
-
-    PRIVATE
-
-    !> Initialize the data-output module
-    INTERFACE dom_init
-       MODULE PROCEDURE dom_init
-    END INTERFACE dom_init
-
-    !> Add files to database
-    INTERFACE dom_def_file
-       MODULE PROCEDURE dom_def_file
-    END INTERFACE dom_def_file
-
-    !> Add dimensions to database
-    INTERFACE dom_def_dim
-       MODULE PROCEDURE dom_def_dim
-    END INTERFACE dom_def_dim
-
-    !> Add variables to database
-    INTERFACE dom_def_var
-       MODULE PROCEDURE dom_def_var
-    END INTERFACE dom_def_var
-
-    !> Add attributes to database
-    INTERFACE dom_def_att
-       MODULE PROCEDURE dom_def_att_char
-       MODULE PROCEDURE dom_def_att_int8
-       MODULE PROCEDURE dom_def_att_int16
-       MODULE PROCEDURE dom_def_att_int32
-       MODULE PROCEDURE dom_def_att_real32
-       MODULE PROCEDURE dom_def_att_real64
-    END INTERFACE dom_def_att
-
-    !> Prepare for output: evaluate database and create files
-    INTERFACE dom_def_end
-       MODULE PROCEDURE dom_def_end
-    END INTERFACE dom_def_end
-
-    !> Write variables to file
-    INTERFACE dom_write_var
-       MODULE PROCEDURE dom_write_var
-    END INTERFACE dom_write_var
-
-    !> Last actions required for output befor termination
-    INTERFACE dom_finalize_output
-       MODULE PROCEDURE dom_finalize_output
-    END INTERFACE dom_finalize_output
-
-    !> Return error message
-    INTERFACE dom_get_error_message
-       MODULE PROCEDURE dom_get_error_message
-    END INTERFACE dom_get_error_message
-
-    !> Write database to debug output
-    INTERFACE dom_database_debug_output
-       MODULE PROCEDURE dom_database_debug_output
-    END INTERFACE dom_database_debug_output
-
-    PUBLIC                                                                                         &
-       dom_database_debug_output,                                                                  &
-       dom_def_att,                                                                                &
-       dom_def_dim,                                                                                &
-       dom_def_end,                                                                                &
-       dom_def_file,                                                                               &
-       dom_def_var,                                                                                &
-       dom_finalize_output,                                                                        &
-       dom_get_error_message,                                                                      &
-       dom_init,                                                                                   &
-       dom_write_var
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize data-output module.
-!> Provide some general information of the main program.
-!> The optional argument 'file_suffix_of_output_group' defines a file suffix which is added to all
-!> output files. If multiple output groups (groups of MPI ranks, defined by
-!> 'mpi_comm_of_output_group') exist, a unique file suffix must be given for each group. This
-!> prevents that multiple groups try to open and write to the same output file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dom_init( file_suffix_of_output_group, mpi_comm_of_output_group, master_output_rank,   &
-                      program_debug_output_unit, debug_output )
-
-    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  file_suffix_of_output_group  !< file-name suffix added to each file;
-                                                                            !> must be unique for each output group
-
-    INTEGER, INTENT(IN), OPTIONAL ::  master_output_rank         !< MPI rank executing tasks which must
-                                                                 !> be executed by a single PE only
-    INTEGER, INTENT(IN)           ::  mpi_comm_of_output_group   !< MPI communicator specifying the MPI group
-                                                                 !> which participate in the output
-    INTEGER, INTENT(IN)           ::  program_debug_output_unit  !< file unit number for debug output
-
-    LOGICAL, INTENT(IN)           ::  debug_output               !< if true, debug output is printed
-
-
-    IF ( PRESENT( file_suffix_of_output_group ) )  output_file_suffix = file_suffix_of_output_group
-    IF ( PRESENT( master_output_rank ) )  master_rank = master_output_rank
-
-    output_group_comm = mpi_comm_of_output_group
-
-    debug_output_unit = program_debug_output_unit
-    print_debug_output = debug_output
-
-    CALL binary_init_module( output_file_suffix, output_group_comm, master_rank,                   &
-                             debug_output_unit, debug_output, no_id )
-
-    CALL netcdf4_init_module( output_file_suffix, output_group_comm, master_rank,                  &
-                             debug_output_unit, debug_output, no_id )
-
- END SUBROUTINE dom_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define output file.
-!> Example call:
-!>   status = dom_def_file( 'my_output_file_name', 'binary' )
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_def_file( file_name, file_format ) RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_file'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< name of file to be created
-    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< format of file to be created
-
-    INTEGER ::  f             !< loop index
-    INTEGER ::  return_value  !< return value
-
-    TYPE(file_type), DIMENSION(:), ALLOCATABLE ::  files_tmp  !< temporary file list
-
-
-    return_value = 0
-
-    CALL internal_message( 'debug', routine_name // ': define file "' // TRIM( file_name ) // '"' )
-!
-!-- Allocate file list or extend it by 1
-    IF ( .NOT. ALLOCATED( files ) ) THEN
-
-       nfiles = 1
-       ALLOCATE( files(nfiles) )
-
-    ELSE
-
-       nfiles = SIZE( files )
-!
-!--    Check if file already exists
-       DO  f = 1, nfiles
-          IF ( files(f)%name == TRIM( file_name ) )  THEN
-             return_value = 1
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': file "' // TRIM( file_name ) // '" already exists' )
-             EXIT
-          ENDIF
-       ENDDO
-!
-!--    Extend file list
-       IF ( return_value == 0 )  THEN
-          ALLOCATE( files_tmp(nfiles) )
-          files_tmp = files
-          DEALLOCATE( files )
-          nfiles = nfiles + 1
-          ALLOCATE( files(nfiles) )
-          files(:nfiles-1) = files_tmp
-          DEALLOCATE( files_tmp )
-       ENDIF
-
-    ENDIF
-!
-!-- Add new file to database
-    IF ( return_value == 0 )  THEN
-       files(nfiles)%name = TRIM( file_name )
-       files(nfiles)%format = TRIM( file_format )
-    ENDIF
-
- END FUNCTION dom_def_file
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define dimension.
-!> Dimensions can either be limited (a lower and upper bound is given) or unlimited (only a lower
-!> bound is given). Also, instead of providing all values of the dimension, a single value can be
-!> given which is then used to fill the entire dimension.
-!> An optional mask can be given to mask limited dimensions.
-!> Per default, a dimension is written to file only by the output master rank. However, this
-!> behaviour can be changed via the optional parameter 'write_only_by_master_rank'.
-!> Example call:
-!>   - fixed dimension with 100 entries (values known):
-!>       status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
-!>                             output_type='real32', bounds=(/1,100/), &
-!>                             values_real32=my_dim(1:100), mask=my_dim_mask(1:100) )
-!>   - fixed dimension with 50 entries (values not yet known):
-!>       status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
-!>                             output_type='int32', bounds=(/0,49/), &
-!>                             values_int32=(/fill_value/) )
-!>   - masked dimension with 75 entries:
-!>       status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
-!>                             output_type='real64', bounds=(/101,175/), &
-!>                             values_real64=my_dim(1:75), mask=my_dim_mask(1:75) )
-!>   - unlimited dimension:
-!>       status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
-!>                             output_type='real32', bounds=(/1/), &
-!>                             values_real32=(/fill_value/) )
-!>   - dimension values must be written by all MPI ranks later
-!>     (e.g. the master output rank does not know all dimension values):
-!>       status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
-!>                             output_type='real32', bounds=(/1,100/), &
-!>                             values_real32=(/fill_value/), write_only_by_master_rank = .FALSE. )
-!>
-!> @note The optional argument 'write_only_by_master_rank' is set true by default to reduce the
-!>       number of file accesses. If dimension values must, however, be written by all MPI ranks
-!>       (e.g. each rank only knows parts of the values), 'write_only_by_master_rank' must be set
-!>       false to allow each rank to write values to the file for this dimension.
-!>       Values must be written after definition stage via calling dom_write_var.
-!> @todo Convert given values into selected output_type.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_def_dim( file_name, dimension_name, output_type, bounds,                             &
-                       values_int8, values_int16, values_int32, values_intwp,                      &
-                       values_real32, values_real64, values_realwp,                                &
-                       mask, write_only_by_master_rank )                                           &
-             RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_dim'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name       !< name of file
-    CHARACTER(LEN=*), INTENT(IN) ::  dimension_name  !< name of dimension
-    CHARACTER(LEN=*), INTENT(IN) ::  output_type     !< data type of dimension variable in output file
-
-    INTEGER ::  d             !< loop index
-    INTEGER ::  f             !< loop index
-    INTEGER ::  i             !< loop index
-    INTEGER ::  j             !< loop index
-    INTEGER ::  ndims         !< number of dimensions in file
-    INTEGER ::  return_value  !< return value
-
-    INTEGER,         DIMENSION(:), INTENT(IN)           ::  bounds        !< lower and upper bound of dimension variable
-    INTEGER(KIND=1), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int8   !< values of dimension
-    INTEGER(KIND=2), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int16  !< values of dimension
-    INTEGER(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int32  !< values of dimension
-    INTEGER(iwp),    DIMENSION(:), INTENT(IN), OPTIONAL ::  values_intwp  !< values of dimension
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  write_only_by_master_rank  !< true if only master rank shall write this variable
-
-    LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL ::  mask  !< mask of dimesion
-
-    REAL(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_real32  !< values of dimension
-    REAL(KIND=8), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_real64  !< values of dimension
-    REAL(wp),     DIMENSION(:), INTENT(IN), OPTIONAL ::  values_realwp  !< values of dimension
-
-    TYPE(dimension_type)                            ::  dimension       !< new dimension
-    TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimensions_tmp  !< temporary dimension list
-
-
-    return_value = 0
-    ndims = 0
-
-    CALL internal_message( 'debug', routine_name //                                                &
-                           ': define dimension ' //                                                &
-                           '(dimension "' // TRIM( dimension_name ) //                             &
-                           '", file "' // TRIM( file_name ) // '")' )
-
-    dimension%name      = TRIM( dimension_name )
-    dimension%data_type = TRIM( output_type )
-
-    IF ( PRESENT( write_only_by_master_rank ) )  THEN
-       dimension%write_only_by_master_rank = write_only_by_master_rank
-    ELSE
-       dimension%write_only_by_master_rank = .TRUE.
-    ENDIF
-!
-!-- Check dimension bounds and allocate dimension according to bounds
-    IF ( SIZE( bounds ) == 1 )  THEN
-!
-!--    Dimension has only lower bound, which means it changes its size during simulation.
-!--    Set length to -1 as indicator.
-       dimension%bounds(:) = bounds(1)
-       dimension%length    = -1
-
-       IF ( PRESENT( mask ) )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': unlimited dimensions cannot be masked ' //                     &
-                                 '(dimension "' // TRIM( dimension_name ) //                       &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-
-    ELSEIF ( SIZE( bounds ) == 2 )  THEN
-
-       dimension%bounds = bounds
-       dimension%length = bounds(2) - bounds(1) + 1
-!
-!--    Save dimension values
-       IF ( PRESENT( values_int8 ) )  THEN
-          ALLOCATE( dimension%values_int8(dimension%bounds(1):dimension%bounds(2)) )
-          IF ( SIZE( values_int8 ) == dimension%length )  THEN
-             dimension%values_int8 = values_int8
-          ELSEIF ( SIZE( values_int8 ) == 1 )  THEN
-             dimension%values_int8(:) = values_int8(1)
-          ELSE
-             return_value = 2
-          ENDIF
-       ELSEIF( PRESENT( values_int16 ) )  THEN
-          ALLOCATE( dimension%values_int16(dimension%bounds(1):dimension%bounds(2)) )
-          IF ( SIZE( values_int16 ) == dimension%length )  THEN
-             dimension%values_int16 = values_int16
-          ELSEIF ( SIZE( values_int16 ) == 1 )  THEN
-             dimension%values_int16(:) = values_int16(1)
-          ELSE
-             return_value = 2
-          ENDIF
-       ELSEIF( PRESENT( values_int32 ) )  THEN
-          ALLOCATE( dimension%values_int32(dimension%bounds(1):dimension%bounds(2)) )
-          IF ( SIZE( values_int32 ) == dimension%length )  THEN
-             dimension%values_int32 = values_int32
-          ELSEIF ( SIZE( values_int32 ) == 1 )  THEN
-             dimension%values_int32(:) = values_int32(1)
-          ELSE
-             return_value = 2
-          ENDIF
-       ELSEIF( PRESENT( values_intwp ) )  THEN
-          ALLOCATE( dimension%values_intwp(dimension%bounds(1):dimension%bounds(2)) )
-          IF ( SIZE( values_intwp ) == dimension%length )  THEN
-             dimension%values_intwp = values_intwp
-          ELSEIF ( SIZE( values_intwp ) == 1 )  THEN
-             dimension%values_intwp(:) = values_intwp(1)
-          ELSE
-             return_value = 2
-          ENDIF
-       ELSEIF( PRESENT( values_real32 ) )  THEN
-          ALLOCATE( dimension%values_real32(dimension%bounds(1):dimension%bounds(2)) )
-          IF ( SIZE( values_real32 ) == dimension%length )  THEN
-             dimension%values_real32 = values_real32
-          ELSEIF ( SIZE( values_real32 ) == 1 )  THEN
-             dimension%values_real32(:) = values_real32(1)
-          ELSE
-             return_value = 2
-          ENDIF
-       ELSEIF( PRESENT( values_real64 ) )  THEN
-          ALLOCATE( dimension%values_real64(dimension%bounds(1):dimension%bounds(2)) )
-          IF ( SIZE( values_real64 ) == dimension%length )  THEN
-             dimension%values_real64 = values_real64
-          ELSEIF ( SIZE( values_real64 ) == 1 )  THEN
-             dimension%values_real64(:) = values_real64(1)
-          ELSE
-             return_value = 2
-          ENDIF
-       ELSEIF( PRESENT( values_realwp ) )  THEN
-          ALLOCATE( dimension%values_realwp(dimension%bounds(1):dimension%bounds(2)) )
-          IF ( SIZE( values_realwp ) == dimension%length )  THEN
-             dimension%values_realwp = values_realwp
-          ELSEIF ( SIZE( values_realwp ) == 1 )  THEN
-             dimension%values_realwp(:) = values_realwp(1)
-          ELSE
-             return_value = 2
-          ENDIF
-       ELSE
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': no values given ' //                                           &
-                                 '(dimension "' // TRIM( dimension_name ) //                       &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-
-       IF ( return_value == 2 )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': number of values and given bounds do not match ' //            &
-                                 '(dimension "' // TRIM( dimension_name ) //                       &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-!
-!--    Initialize mask
-       IF ( PRESENT( mask )  .AND.  return_value == 0 )  THEN
-
-          IF ( dimension%length == SIZE( mask ) )  THEN
-
-             IF ( ALL( mask ) )  THEN
-
-                CALL internal_message( 'debug', routine_name //                                    &
-                                       ': mask contains only TRUE values. Ignoring mask ' //       &
-                                       '(dimension "' // TRIM( dimension_name ) //                 &
-                                       '", file "' // TRIM( file_name ) // '")!' )
-
-             ELSE
-
-                dimension%is_masked = .TRUE.
-                dimension%length_mask = COUNT( mask )
-
-                ALLOCATE( dimension%mask(dimension%bounds(1):dimension%bounds(2)) )
-                ALLOCATE( dimension%masked_indices(0:dimension%length_mask-1) )
-
-                dimension%mask = mask
-!
-!--             Save masked positions and masked values
-                IF ( ALLOCATED( dimension%values_int8 ) )  THEN
-
-                   ALLOCATE( dimension%masked_values_int8(0:dimension%length_mask-1) )
-                   j = 0
-                   DO  i = dimension%bounds(1), dimension%bounds(2)
-                      IF ( dimension%mask(i) )  THEN
-                         dimension%masked_values_int8(j) = dimension%values_int8(i)
-                         dimension%masked_indices(j) = i
-                         j = j + 1
-                      ENDIF
-                   ENDDO
-
-                ELSEIF ( ALLOCATED( dimension%values_int16 ) )  THEN
-
-                   ALLOCATE( dimension%masked_values_int16(0:dimension%length_mask-1) )
-                   j = 0
-                   DO  i = dimension%bounds(1), dimension%bounds(2)
-                      IF ( dimension%mask(i) )  THEN
-                         dimension%masked_values_int16(j) = dimension%values_int16(i)
-                         dimension%masked_indices(j) = i
-                         j = j + 1
-                      ENDIF
-                   ENDDO
-
-                ELSEIF ( ALLOCATED( dimension%values_int32 ) )  THEN
-
-                   ALLOCATE( dimension%masked_values_int32(0:dimension%length_mask-1) )
-                   j = 0
-                   DO  i = dimension%bounds(1), dimension%bounds(2)
-                      IF ( dimension%mask(i) )  THEN
-                         dimension%masked_values_int32(j) = dimension%values_int32(i)
-                         dimension%masked_indices(j) = i
-                         j = j + 1
-                      ENDIF
-                   ENDDO
-
-                ELSEIF ( ALLOCATED( dimension%values_intwp ) )  THEN
-
-                   ALLOCATE( dimension%masked_values_intwp(0:dimension%length_mask-1) )
-                   j = 0
-                   DO  i = dimension%bounds(1), dimension%bounds(2)
-                      IF ( dimension%mask(i) )  THEN
-                         dimension%masked_values_intwp(j) = dimension%values_intwp(i)
-                         dimension%masked_indices(j) = i
-                         j = j + 1
-                      ENDIF
-                   ENDDO
-
-                ELSEIF ( ALLOCATED( dimension%values_real32 ) )  THEN
-
-                   ALLOCATE( dimension%masked_values_real32(0:dimension%length_mask-1) )
-                   j = 0
-                   DO  i = dimension%bounds(1), dimension%bounds(2)
-                      IF ( dimension%mask(i) )  THEN
-                         dimension%masked_values_real32(j) = dimension%values_real32(i)
-                         dimension%masked_indices(j) = i
-                         j = j + 1
-                      ENDIF
-                   ENDDO
-
-                ELSEIF ( ALLOCATED(dimension%values_real64) )  THEN
-
-                   ALLOCATE( dimension%masked_values_real64(0:dimension%length_mask-1) )
-                   j = 0
-                   DO  i = dimension%bounds(1), dimension%bounds(2)
-                      IF ( dimension%mask(i) )  THEN
-                         dimension%masked_values_real64(j) = dimension%values_real64(i)
-                         dimension%masked_indices(j) = i
-                         j = j + 1
-                      ENDIF
-                   ENDDO
-
-                ELSEIF ( ALLOCATED(dimension%values_realwp) )  THEN
-
-                   ALLOCATE( dimension%masked_values_realwp(0:dimension%length_mask-1) )
-                   j = 0
-                   DO  i = dimension%bounds(1), dimension%bounds(2)
-                      IF ( dimension%mask(i) )  THEN
-                         dimension%masked_values_realwp(j) = dimension%values_realwp(i)
-                         dimension%masked_indices(j) = i
-                         j = j + 1
-                      ENDIF
-                   ENDDO
-
-                ENDIF
-
-             ENDIF  ! if not all mask = true
-
-          ELSE
-             return_value = 1
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': size of mask and given bounds do not match ' //             &
-                                    '(dimension "' // TRIM( dimension_name ) //                    &
-                                    '", file "' // TRIM( file_name ) // '")!' )
-          ENDIF
-
-       ENDIF
-
-    ELSE
-
-       return_value = 1
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': at least one but no more than two bounds must be given ' //       &
-                              '(dimension "' // TRIM( dimension_name ) //                          &
-                              '", file "' // TRIM( file_name ) // '")!' )
-
-    ENDIF
-!
-!-- Add dimension to database
-    IF ( return_value == 0 )  THEN
-
-       DO  f = 1, nfiles
-
-          IF ( TRIM( file_name ) == files(f)%name )  THEN
-
-             IF ( files(f)%is_init )  THEN
-
-                return_value = 1
-                CALL internal_message( 'error', routine_name //                                    &
-                                       ': file already initialized. ' //                           &
-                                       'No further dimension definition allowed ' //               &
-                                       '(dimension "' // TRIM( dimension_name ) //                 &
-                                       '", file "' // TRIM( file_name ) // '")!' )
-                EXIT
-
-             ELSEIF ( .NOT. ALLOCATED( files(f)%dimensions ) )  THEN
-
-                ndims = 1
-                ALLOCATE( files(f)%dimensions(ndims) )
-
-             ELSE
-!
-!--             Check if any variable of the same name as the new dimension is already defined
-                IF ( ALLOCATED( files(f)%variables ) )  THEN
-                   DO  i = 1, SIZE( files(f)%variables )
-                      IF ( files(f)%variables(i)%name == dimension%name )  THEN
-                         return_value = 1
-                         CALL internal_message( 'error', routine_name //                           &
-                                 ': file already has a variable of this name defined. ' //         &
-                                 'Defining a dimension of the same name is not allowed ' //        &
-                                 '(dimension "' // TRIM( dimension_name ) //                       &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-                         EXIT
-                      ENDIF
-                   ENDDO
-                ENDIF
-
-                IF ( return_value == 0 )  THEN
-!
-!--                Check if dimension already exists in file
-                   ndims = SIZE( files(f)%dimensions )
-
-                   DO  d = 1, ndims
-                      IF ( files(f)%dimensions(d)%name == dimension%name )  THEN
-                         return_value = 1
-                         CALL internal_message( 'error', routine_name //                           &
-                                                ': dimension already exists in file ' //           &
-                                                '(dimension "' // TRIM( dimension_name ) //        &
-                                                '", file "' // TRIM( file_name ) // '")!' )
-                         EXIT
-                      ENDIF
-                   ENDDO
-!
-!--                Extend dimension list
-                   IF ( return_value == 0 )  THEN
-                      ALLOCATE( dimensions_tmp(ndims) )
-                      dimensions_tmp = files(f)%dimensions
-                      DEALLOCATE( files(f)%dimensions )
-                      ndims = ndims + 1
-                      ALLOCATE( files(f)%dimensions(ndims) )
-                      files(f)%dimensions(:ndims-1) = dimensions_tmp
-                      DEALLOCATE( dimensions_tmp )
-                   ENDIF
-                ENDIF
-
-             ENDIF
-!
-!--          Add new dimension to database
-             IF ( return_value == 0 )  files(f)%dimensions(ndims) = dimension
-
-             EXIT
-
-          ENDIF
-       ENDDO
-
-       IF ( f > nfiles )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': file not found (dimension "' // TRIM( dimension_name ) //      &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-
-    ENDIF
-
- END FUNCTION dom_def_dim
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Add variable to database.
-!> Example call:
-!>   dom_def_var( file_name =  'my_output_file_name', &
-!>                variable_name = 'u', &
-!>                dimension_names = (/'x   ', 'y   ', 'z   ', 'time'/), &
-!>                output_type = 'real32' )
-!> @note The order of dimensions must match in reversed order to the dimensions of the
-!>       corresponding variable array. The last given dimension can also be non-existent within the
-!>       variable array if at any given call of 'dom_write_var' for this variable, the last
-!>       dimension has only a single index.
-!>       Hence, the array 'u' must be allocated with dimension 'x' as its last dimension, preceded
-!>       by 'y', then 'z', and 'time' being the first dimension. If at any given write statement,
-!>       only a single index of dimension 'time' is to be written, the dimension can be non-present
-!>       in the variable array leaving dimension 'z' as the first dimension.
-!>       So, the variable array needs to be allocated like either:
-!>          ALLOCATE( u(<time>,<z>,<y>,<x>) )
-!>       or
-!>          ALLOCATE( u(<z>,<y>,<x>) )
-!> @note The optional argument 'write_only_by_master_rank' can be used to reduce the number of file
-!>       accesses. If a variable is identical on each MPI rank, setting 'write_only_by_master_rank'
-!>       allows the underlying output modules to skip the write command if possible for MPI ranks
-!>       other than the master output rank.
-!>       As restrictions may apply for different output modules, it might be possible that this
-!>       option is ignored internally. Hence, all MPI ranks must still participate in the
-!>       dom_write_var calls in any case.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_def_var( file_name, variable_name, dimension_names, output_type,                     &
-                       write_only_by_master_rank )                                                 &
-             RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_var'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name      !< name of file
-    CHARACTER(LEN=*), INTENT(IN) ::  output_type    !< data type of variable
-    CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< name of variable
-
-    CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) ::  dimension_names  !< list of dimension names
-
-    INTEGER ::  d             !< loop index
-    INTEGER ::  f             !< loop index
-    INTEGER ::  i             !< loop index
-    INTEGER ::  nvars         !< number of variables in file
-    INTEGER ::  return_value  !< return value
-
-    LOGICAL                       ::  found                      !< true if requested dimension is defined in file
-    LOGICAL, INTENT(IN), OPTIONAL ::  write_only_by_master_rank  !< true if only master rank shall write this variable
-
-    TYPE(variable_type)                            ::  variable       !< new variable
-    TYPE(variable_type), DIMENSION(:), ALLOCATABLE ::  variables_tmp  !< temporary variable list
-
-
-    return_value = 0
-    found = .FALSE.
-
-    CALL internal_message( 'debug', routine_name //                                                &
-                           ': define variable (variable "' // TRIM( variable_name ) //             &
-                           '", file "' // TRIM( file_name ) // '")' )
-
-    variable%name = TRIM( variable_name )
-
-    ALLOCATE( variable%dimension_names(SIZE( dimension_names )) )
-    ALLOCATE( variable%dimension_ids(SIZE( dimension_names )) )
-
-    variable%dimension_names = dimension_names
-    variable%dimension_ids = -1
-    variable%data_type = TRIM( output_type )
-
-    IF ( PRESENT( write_only_by_master_rank ) )  THEN
-       variable%write_only_by_master_rank = write_only_by_master_rank
-    ELSE
-       variable%write_only_by_master_rank = .FALSE.
-    ENDIF
-!
-!-- Add variable to database
-    DO  f = 1, nfiles
-
-       IF ( TRIM( file_name ) == files(f)%name )  THEN
-
-          IF ( files(f)%is_init )  THEN
-
-             return_value = 1
-             CALL internal_message( 'error', routine_name //                                       &
-                     ': file already initialized. No further variable definition allowed ' //      &
-                     '(variable "' // TRIM( variable_name ) //                                     &
-                     '", file "' // TRIM( file_name ) // '")!' )
-             EXIT
-
-          ELSEIF ( ALLOCATED( files(f)%dimensions ) )  THEN
-!
-!--          Check if any dimension of the same name as the new variable is already defined
-             DO  d = 1, SIZE( files(f)%dimensions )
-                IF ( files(f)%dimensions(d)%name == variable%name )  THEN
-                   return_value = 1
-                   CALL internal_message( 'error', routine_name //                                 &
-                           ': file already has a dimension of this name defined. ' //              &
-                           'Defining a variable of the same name is not allowed ' //               &
-                           '(variable "' // TRIM( variable_name ) //                               &
-                           '", file "' // TRIM( file_name ) // '")!' )
-                   EXIT
-                ENDIF
-             ENDDO
-!
-!--          Check if dimensions assigned to variable are defined within file
-             IF ( return_value == 0 )  THEN
-                DO  i = 1, SIZE( variable%dimension_names )
-                   found = .FALSE.
-                   DO  d = 1, SIZE( files(f)%dimensions )
-                      IF ( files(f)%dimensions(d)%name == variable%dimension_names(i) )  THEN
-                         found = .TRUE.
-                         EXIT
-                      ENDIF
-                   ENDDO
-                   IF ( .NOT. found )  THEN
-                      return_value = 1
-                      CALL internal_message( 'error', routine_name //                              &
-                              ': required dimension "'//  TRIM( variable%dimension_names(i) ) //   &
-                              '" for variable is not defined ' //                                  &
-                              '(variable "' // TRIM( variable_name ) //                            &
-                              '", file "' // TRIM( file_name ) // '")!' )
-                      EXIT
-                   ENDIF
-                ENDDO
-             ENDIF
-
-          ELSE
-
-             return_value = 1
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': no dimensions defined in file. Cannot define variable '//   &
-                                    '(variable "' // TRIM( variable_name ) //                      &
-                                    '", file "' // TRIM( file_name ) // '")!' )
-
-          ENDIF
-
-          IF ( return_value == 0 )  THEN
-!
-!--          Check if variable already exists
-             IF ( .NOT. ALLOCATED( files(f)%variables ) )  THEN
-
-                nvars = 1
-                ALLOCATE( files(f)%variables(nvars) )
-
-             ELSE
-
-                nvars = SIZE( files(f)%variables )
-                DO  i = 1, nvars
-                   IF ( files(f)%variables(i)%name == variable%name )  THEN
-                      return_value = 1
-                      CALL internal_message( 'error', routine_name //                              &
-                                             ': variable already exists '//                        &
-                                             '(variable "' // TRIM( variable_name ) //             &
-                                             '", file "' // TRIM( file_name ) // '")!' )
-                      EXIT
-                   ENDIF
-                ENDDO
-
-                IF ( return_value == 0 )  THEN
-!
-!--                Extend variable list
-                   ALLOCATE( variables_tmp(nvars) )
-                   variables_tmp = files(f)%variables
-                   DEALLOCATE( files(f)%variables )
-                   nvars = nvars + 1
-                   ALLOCATE( files(f)%variables(nvars) )
-                   files(f)%variables(:nvars-1) = variables_tmp
-                   DEALLOCATE( variables_tmp )
-                ENDIF
-
-             ENDIF
-!
-!--          Add new variable to database
-             IF ( return_value == 0 )  files(f)%variables(nvars) = variable
-
-          ENDIF
-
-          EXIT
-
-       ENDIF
-
-    ENDDO
-
-    IF ( f > nfiles )  THEN
-       return_value = 1
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': file not found (variable "' // TRIM( variable_name ) //           &
-                              '", file "' // TRIM( file_name ) // '")!' )
-    ENDIF
-
- END FUNCTION dom_def_var
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create attribute with value of type character.
-!> If the optional argument 'variable_name' is given, the attribute is added to the respective
-!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
-!> the file itself.
-!> If an attribute of similar name already exists, it is updated (overwritten) with the new value.
-!> If the optional argument 'append' is set TRUE, the value of an already existing attribute of
-!> similar name is appended by the new value instead of overwritten.
-!> Example call:
-!>   - define a global file attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   attribute_name='my_attribute', &
-!>                   value='This is the attribute value' )
-!>   - define a variable attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   variable_name='my_variable', &
-!>                   attribute_name='my_attribute', &
-!>                   value='This is the attribute value' )
-!>   - append an attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   attribute_name='my_attribute', &
-!>                   value=' and this part was appended', append=.TRUE. )
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_def_att_char( file_name, variable_name, attribute_name, value, append )              &
-             RESULT( return_value )
-
-    ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_char'  !< name of routine
-
-    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
-    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
-    CHARACTER(LEN=*),      INTENT(IN)           ::  value                   !< attribute value
-    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
-    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
-
-    INTEGER ::  return_value  !< return value
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
-    LOGICAL                       ::  append_internal  !< same as 'append'
-
-    TYPE(attribute_type) ::  attribute  !< new attribute
-
-
-    return_value = 0
-
-    IF ( PRESENT( append ) )  THEN
-       append_internal = append
-    ELSE
-       append_internal = .FALSE.
-    ENDIF
-
-    attribute%name       = TRIM( attribute_name )
-    attribute%data_type  = 'char'
-    attribute%value_char = TRIM( value )
-
-    IF ( PRESENT( variable_name ) )  THEN
-       variable_name_internal = TRIM( variable_name )
-    ELSE
-       variable_name_internal = ''
-    ENDIF
-
-    return_value = save_attribute_in_database( file_name=TRIM( file_name ),                        &
-                                               variable_name=TRIM( variable_name_internal ),       &
-                                               attribute=attribute, append=append_internal )
-
- END FUNCTION dom_def_att_char
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create attribute with value of type int8.
-!> If the optional argument 'variable_name' is given, the attribute is added to the respective
-!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
-!> the file itself.
-!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
-!> Example call:
-!>   - define a global file attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   attribute_name='my_attribute', &
-!>                   value=0_1 )
-!>   - define a variable attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   variable_name='my_variable', &
-!>                   attribute_name='my_attribute', &
-!>                   value=1_1 )
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_def_att_int8( file_name, variable_name, attribute_name, value, append )              &
-             RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int8'  !< name of routine
-
-    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
-    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
-    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
-    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
-
-    INTEGER(KIND=1), INTENT(IN) ::  value  !< attribute value
-
-    INTEGER ::  return_value  !< return value
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
-    LOGICAL                       ::  append_internal  !< same as 'append'
-
-    TYPE(attribute_type) ::  attribute  !< new attribute
-
-
-    return_value = 0
-
-    IF ( PRESENT( variable_name ) )  THEN
-       variable_name_internal = TRIM( variable_name )
-    ELSE
-       variable_name_internal = ''
-    ENDIF
-
-    IF ( PRESENT( append ) )  THEN
-       IF ( append )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': numeric attribute cannot be appended ' //                      &
-                                 '(attribute "' // TRIM( attribute_name ) //                       &
-                                 '", variable "' // TRIM( variable_name_internal ) //              &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-    ENDIF
-
-    IF ( return_value == 0 )  THEN
-       append_internal = .FALSE.
-
-       attribute%name       = TRIM( attribute_name )
-       attribute%data_type  = 'int8'
-       attribute%value_int8 = value
-
-       return_value = save_attribute_in_database( file_name=TRIM( file_name ),                     &
-                                                  variable_name=TRIM( variable_name_internal ),    &
-                                                  attribute=attribute, append=append_internal )
-    ENDIF
-
- END FUNCTION dom_def_att_int8
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create attribute with value of type int16.
-!> If the optional argument 'variable_name' is given, the attribute is added to the respective
-!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
-!> the file itself.
-!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
-!> Example call:
-!>   - define a global file attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   attribute_name='my_attribute', &
-!>                   value=0_2 )
-!>   - define a variable attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   variable_name='my_variable', &
-!>                   attribute_name='my_attribute', &
-!>                   value=1_2 )
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_def_att_int16( file_name, variable_name, attribute_name, value, append )             &
-             RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int16'  !< name of routine
-
-    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
-    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
-    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
-    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
-
-    INTEGER(KIND=2), INTENT(IN) ::  value  !< attribute value
-
-    INTEGER ::  return_value  !< return value
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
-    LOGICAL                       ::  append_internal  !< same as 'append'
-
-    TYPE(attribute_type) ::  attribute  !< new attribute
-
-
-    return_value = 0
-
-    IF ( PRESENT( variable_name ) )  THEN
-       variable_name_internal = TRIM( variable_name )
-    ELSE
-       variable_name_internal = ''
-    ENDIF
-
-    IF ( PRESENT( append ) )  THEN
-       IF ( append )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': numeric attribute cannot be appended ' //                      &
-                                 '(attribute "' // TRIM( attribute_name ) //                       &
-                                 '", variable "' // TRIM( variable_name_internal ) //              &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-    ENDIF
-
-    IF ( return_value == 0 )  THEN
-       append_internal = .FALSE.
-
-       attribute%name        = TRIM( attribute_name )
-       attribute%data_type   = 'int16'
-       attribute%value_int16 = value
-
-       return_value = save_attribute_in_database( file_name=TRIM( file_name ),                     &
-                                                  variable_name=TRIM( variable_name_internal ),    &
-                                                  attribute=attribute, append=append_internal )
-    ENDIF
-
- END FUNCTION dom_def_att_int16
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create attribute with value of type int32.
-!> If the optional argument 'variable_name' is given, the attribute is added to the respective
-!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
-!> the file itself.
-!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
-!> Example call:
-!>   - define a global file attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   attribute_name='my_attribute', &
-!>                   value=0_4 )
-!>   - define a variable attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   variable_name='my_variable', &
-!>                   attribute_name='my_attribute', &
-!>                   value=1_4 )
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_def_att_int32( file_name, variable_name, attribute_name, value, append )             &
-             RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int32'  !< name of routine
-
-    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
-    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
-    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
-    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
-
-    INTEGER(KIND=4), INTENT(IN) ::  value  !< attribute value
-
-    INTEGER ::  return_value  !< return value
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
-    LOGICAL                       ::  append_internal  !< same as 'append'
-
-    TYPE(attribute_type) ::  attribute  !< new attribute
-
-
-    return_value = 0
-
-    IF ( PRESENT( variable_name ) )  THEN
-       variable_name_internal = TRIM( variable_name )
-    ELSE
-       variable_name_internal = ''
-    ENDIF
-
-    IF ( PRESENT( append ) )  THEN
-       IF ( append )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': numeric attribute cannot be appended ' //                      &
-                                 '(attribute "' // TRIM( attribute_name ) //                       &
-                                 '", variable "' // TRIM( variable_name_internal ) //              &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-    ENDIF
-
-    IF ( return_value == 0 )  THEN
-       append_internal = .FALSE.
-
-       attribute%name        = TRIM( attribute_name )
-       attribute%data_type   = 'int32'
-       attribute%value_int32 = value
-
-       return_value = save_attribute_in_database( file_name=TRIM( file_name ),                     &
-                                                  variable_name=TRIM( variable_name_internal ),    &
-                                                  attribute=attribute, append=append_internal )
-    ENDIF
-
- END FUNCTION dom_def_att_int32
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create attribute with value of type real32.
-!> If the optional argument 'variable_name' is given, the attribute is added to the respective
-!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
-!> the file itself.
-!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
-!> Example call:
-!>   - define a global file attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   attribute_name='my_attribute', &
-!>                   value=1.0_4 )
-!>   - define a variable attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   variable_name='my_variable', &
-!>                   attribute_name='my_attribute', &
-!>                   value=1.0_4 )
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_def_att_real32( file_name, variable_name, attribute_name, value, append )            &
-             RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_real32'  !< name of routine
-
-    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
-    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
-    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
-    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
-
-    INTEGER ::  return_value  !< return value
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
-    LOGICAL                       ::  append_internal  !< same as 'append'
-
-    REAL(KIND=4), INTENT(IN) ::  value  !< attribute value
-
-    TYPE(attribute_type) ::  attribute  !< new attribute
-
-
-    return_value = 0
-
-    IF ( PRESENT( variable_name ) )  THEN
-       variable_name_internal = TRIM( variable_name )
-    ELSE
-       variable_name_internal = ''
-    ENDIF
-
-    IF ( PRESENT( append ) )  THEN
-       IF ( append )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': numeric attribute cannot be appended ' //                      &
-                                 '(attribute "' // TRIM( attribute_name ) //                       &
-                                 '", variable "' // TRIM( variable_name_internal ) //              &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-    ENDIF
-
-    IF ( return_value == 0 )  THEN
-       append_internal = .FALSE.
-
-       attribute%name         = TRIM( attribute_name )
-       attribute%data_type    = 'real32'
-       attribute%value_real32 = value
-
-       return_value = save_attribute_in_database( file_name=TRIM( file_name ),                     &
-                                                  variable_name=TRIM( variable_name_internal ),    &
-                                                  attribute=attribute, append=append_internal )
-    ENDIF
-
- END FUNCTION dom_def_att_real32
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create attribute with value of type real64.
-!> If the optional argument 'variable_name' is given, the attribute is added to the respective
-!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
-!> the file itself.
-!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
-!> Example call:
-!>   - define a global file attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   attribute_name='my_attribute', &
-!>                   value=0.0_8 )
-!>   - define a variable attribute:
-!>      dom_def_att( file_name='my_output_file_name', &
-!>                   variable_name='my_variable', &
-!>                   attribute_name='my_attribute', &
-!>                   value=1.0_8 )
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_def_att_real64( file_name, variable_name, attribute_name, value, append )            &
-             RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_real64'  !< name of routine
-
-    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
-    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
-    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
-    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
-
-    INTEGER ::  return_value  !< return value
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
-    LOGICAL                       ::  append_internal  !< same as 'append'
-
-    REAL(KIND=8), INTENT(IN) ::  value  !< attribute value
-
-    TYPE(attribute_type) ::  attribute  !< new attribute
-
-
-    return_value = 0
-
-    IF ( PRESENT( variable_name ) )  THEN
-       variable_name_internal = TRIM( variable_name )
-    ELSE
-       variable_name_internal = ''
-    ENDIF
-
-    IF ( PRESENT( append ) )  THEN
-       IF ( append )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': numeric attribute cannot be appended ' //                      &
-                                 '(attribute "' // TRIM( attribute_name ) //                       &
-                                 '", variable "' // TRIM( variable_name_internal ) //              &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-    ENDIF
-
-    IF ( return_value == 0 )  THEN
-       append_internal = .FALSE.
-
-       attribute%name         = TRIM( attribute_name )
-       attribute%data_type    = 'real64'
-       attribute%value_real64 = value
-
-       return_value = save_attribute_in_database( file_name=TRIM( file_name ),                     &
-                                                  variable_name=TRIM( variable_name_internal ),    &
-                                                  attribute=attribute, append=append_internal )
-    ENDIF
-
- END FUNCTION dom_def_att_real64
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> End output definition.
-!> The database is cleared from unused files and dimensions. Then, the output files are initialized
-!> and prepared for writing output values to them. The saved values of the dimensions are written
-!> to the files.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_def_end() RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_end'  !< name of routine
-
-    INTEGER ::  d             !< loop index
-    INTEGER ::  f             !< loop index
-    INTEGER ::  return_value  !< return value
-
-    INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int8           !< target array for dimension values
-    INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int16          !< target array for dimension values
-    INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int32          !< target array for dimension values
-    INTEGER(iwp),    DIMENSION(:), ALLOCATABLE, TARGET ::  values_intwp          !< target array for dimension values
-
-    INTEGER(KIND=1), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int8_pointer   !< pointer to target array
-    INTEGER(KIND=2), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int16_pointer  !< pointer to target array
-    INTEGER(KIND=4), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int32_pointer  !< pointer to target array
-    INTEGER(iwp),    DIMENSION(:), POINTER, CONTIGUOUS ::  values_intwp_pointer  !< pointer to target array
-
-    REAL(KIND=4), DIMENSION(:), ALLOCATABLE, TARGET ::  values_real32            !< target array for dimension values
-    REAL(KIND=8), DIMENSION(:), ALLOCATABLE, TARGET ::  values_real64            !< target array for dimension values
-    REAL(wp),     DIMENSION(:), ALLOCATABLE, TARGET ::  values_realwp            !< target array for dimension values
-
-    REAL(KIND=4), DIMENSION(:), POINTER, CONTIGUOUS ::  values_real32_pointer    !< pointer to target array
-    REAL(KIND=8), DIMENSION(:), POINTER, CONTIGUOUS ::  values_real64_pointer    !< pointer to target array
-    REAL(wp),     DIMENSION(:), POINTER, CONTIGUOUS ::  values_realwp_pointer    !< pointer to target array
-
-
-    return_value = 0
-    CALL internal_message( 'debug', routine_name // ': start' )
-!
-!-- Clear database from empty files and unused dimensions
-    IF ( nfiles > 0 )  return_value = cleanup_database()
-
-    IF ( return_value == 0 )  THEN
-       DO  f = 1, nfiles
-!
-!--       Skip initialization if file is already initialized
-          IF ( files(f)%is_init )  CYCLE
-
-          CALL internal_message( 'debug', routine_name // ': initialize file "' //                 &
-                                 TRIM( files(f)%name ) // '"' )
-!
-!--       Open file
-          CALL open_output_file( files(f)%format, files(f)%name, files(f)%id,                      &
-                                 return_value=return_value )
-!
-!--       Initialize file header:
-!--       define dimensions and variables and write attributes
-          IF ( return_value == 0 )  CALL init_file_header( files(f), return_value=return_value )
-!
-!--       End file definition
-          IF ( return_value == 0 )                                                                 &
-             CALL stop_file_header_definition( files(f)%format, files(f)%id, files(f)%name,        &
-                                               return_value )
-
-          IF ( return_value == 0 )  THEN
-!
-!--          Flag file as initialized
-             files(f)%is_init = .TRUE.
-!
-!--          Write dimension values into file
-             DO  d = 1, SIZE( files(f)%dimensions )
-                IF ( ALLOCATED( files(f)%dimensions(d)%values_int8 ) )  THEN
-                   ALLOCATE( values_int8(files(f)%dimensions(d)%bounds(1):                         &
-                                         files(f)%dimensions(d)%bounds(2)) )
-                   values_int8 = files(f)%dimensions(d)%values_int8
-                   values_int8_pointer => values_int8
-                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name,       &
-                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),          &
-                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),          &
-                                     values_int8_1d=values_int8_pointer )
-                   DEALLOCATE( values_int8 )
-                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_int16 ) )  THEN
-                   ALLOCATE( values_int16(files(f)%dimensions(d)%bounds(1):                        &
-                                          files(f)%dimensions(d)%bounds(2)) )
-                   values_int16 = files(f)%dimensions(d)%values_int16
-                   values_int16_pointer => values_int16
-                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name,       &
-                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),          &
-                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),          &
-                                     values_int16_1d=values_int16_pointer )
-                   DEALLOCATE( values_int16 )
-                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_int32 ) )  THEN
-                   ALLOCATE( values_int32(files(f)%dimensions(d)%bounds(1):                        &
-                                          files(f)%dimensions(d)%bounds(2)) )
-                   values_int32 = files(f)%dimensions(d)%values_int32
-                   values_int32_pointer => values_int32
-                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name,       &
-                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),          &
-                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),          &
-                                     values_int32_1d=values_int32_pointer )
-                   DEALLOCATE( values_int32 )
-                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_intwp ) )  THEN
-                   ALLOCATE( values_intwp(files(f)%dimensions(d)%bounds(1):                        &
-                                          files(f)%dimensions(d)%bounds(2)) )
-                   values_intwp = files(f)%dimensions(d)%values_intwp
-                   values_intwp_pointer => values_intwp
-                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name,       &
-                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),          &
-                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),          &
-                                     values_intwp_1d=values_intwp_pointer )
-                   DEALLOCATE( values_intwp )
-                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_real32 ) )  THEN
-                   ALLOCATE( values_real32(files(f)%dimensions(d)%bounds(1):                       &
-                                           files(f)%dimensions(d)%bounds(2)) )
-                   values_real32 = files(f)%dimensions(d)%values_real32
-                   values_real32_pointer => values_real32
-                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name,       &
-                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),          &
-                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),          &
-                                     values_real32_1d=values_real32_pointer )
-                   DEALLOCATE( values_real32 )
-                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_real64 ) )  THEN
-                   ALLOCATE( values_real64(files(f)%dimensions(d)%bounds(1):                       &
-                                           files(f)%dimensions(d)%bounds(2)) )
-                   values_real64 = files(f)%dimensions(d)%values_real64
-                   values_real64_pointer => values_real64
-                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name,       &
-                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),          &
-                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),          &
-                                     values_real64_1d=values_real64_pointer )
-                   DEALLOCATE( values_real64 )
-                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_realwp ) )  THEN
-                   ALLOCATE( values_realwp(files(f)%dimensions(d)%bounds(1):                       &
-                                           files(f)%dimensions(d)%bounds(2)) )
-                   values_realwp = files(f)%dimensions(d)%values_realwp
-                   values_realwp_pointer => values_realwp
-                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name,       &
-                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),          &
-                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),          &
-                                     values_realwp_1d=values_realwp_pointer )
-                   DEALLOCATE( values_realwp )
-                ENDIF
-                IF ( return_value /= 0 )  EXIT
-             ENDDO
-
-          ENDIF
-
-          IF ( return_value /= 0 )  EXIT
-
-       ENDDO
-    ENDIF
-
-    CALL internal_message( 'debug', routine_name // ': finished' )
-
- END FUNCTION dom_def_end
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write variable to file.
-!> Example call:
-!>   dom_write_var( file_name = 'my_output_file_name', &
-!>                  name = 'u', &
-!>                  bounds_start = (/nxl, nys, nzb, time_step/), &
-!>                  bounds_end = (/nxr, nyn, nzt, time_step/), &
-!>                  values_real64_3d = u )
-!> @note The order of dimension bounds must match to the order of dimensions given in call
-!>       'dom_def_var'. I.e., the corresponding variable definition should be like:
-!>          dom_def_var( file_name =  'my_output_file_name', &
-!>                       name = 'u', &
-!>                       dimension_names = (/'x   ', 'y   ', 'z   ', 'time'/), &
-!>                       output_type = <desired-output-type> )
-!> @note The values given do not need to be of the same data type as was defined in the
-!>       corresponding 'dom_def_var' call. If the output format 'netcdf' was chosen, the values are
-!>       automatically converted to the data type given during the definition. If 'binary' was
-!>       chosen, the values are written to file as given in the 'dom_write_var' call.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_write_var( file_name, variable_name, bounds_start, bounds_end,                       &
-                         values_char_0d,   values_char_1d,   values_char_2d,   values_char_3d,     &
-                         values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,     &
-                         values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,    &
-                         values_int32_0d,  values_int32_1d,  values_int32_2d,  values_int32_3d,    &
-                         values_intwp_0d,  values_intwp_1d,  values_intwp_2d,  values_intwp_3d,    &
-                         values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d,   &
-                         values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d,   &
-                         values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d )  &
-             RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_write_var'  !< name of routine
-
-    CHARACTER(LEN=charlen)            ::  file_format    !< file format chosen for file
-    CHARACTER(LEN=*),      INTENT(IN) ::  file_name      !< name of file
-    CHARACTER(LEN=*),      INTENT(IN) ::  variable_name  !< name of variable
-
-    CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL                   ::  values_char_0d           !< output variable
-    CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_char_1d           !< output variable
-    CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_char_2d           !< output variable
-    CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_char_3d           !< output variable
-
-    CHARACTER(LEN=1), TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_char_1d_resorted  !< resorted output variable
-    CHARACTER(LEN=1), TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_char_2d_resorted  !< resorted output variable
-    CHARACTER(LEN=1), TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_char_3d_resorted  !< resorted output variable
-
-    CHARACTER(LEN=1), POINTER                                         ::  values_char_0d_pointer   !< pointer to resortet array
-    CHARACTER(LEN=1), POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_char_1d_pointer   !< pointer to resortet array
-    CHARACTER(LEN=1), POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_char_2d_pointer   !< pointer to resortet array
-    CHARACTER(LEN=1), POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_char_3d_pointer   !< pointer to resortet array
-
-    INTEGER ::  file_id              !< file ID
-    INTEGER ::  i                    !< loop index
-    INTEGER ::  j                    !< loop index
-    INTEGER ::  k                    !< loop index
-    INTEGER ::  output_return_value  !< return value of a called output routine
-    INTEGER ::  return_value         !< return value
-    INTEGER ::  variable_id          !< variable ID
-
-    INTEGER, DIMENSION(:),   INTENT(IN)  ::  bounds_end             !< end index per dimension of variable
-    INTEGER, DIMENSION(:),   INTENT(IN)  ::  bounds_start           !< start index per dimension of variable
-    INTEGER, DIMENSION(:),   ALLOCATABLE ::  bounds_origin          !< first index of each dimension
-    INTEGER, DIMENSION(:),   ALLOCATABLE ::  bounds_start_internal  !< start index per dim. for output after masking
-    INTEGER, DIMENSION(:),   ALLOCATABLE ::  value_counts           !< count of indices to be written per dimension
-    INTEGER, DIMENSION(:,:), ALLOCATABLE ::  masked_indices         !< list containing all output indices along a dimension
-
-    LOGICAL ::  do_output                  !< true if any data lies within given range of masked dimension
-    LOGICAL ::  write_only_by_master_rank  !< true if only master rank shall write variable
-
-    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL                   ::  values_int8_0d             !< output variable
-    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL                   ::  values_int16_0d            !< output variable
-    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL                   ::  values_int32_0d            !< output variable
-    INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL                   ::  values_intwp_0d            !< output variable
-    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int8_1d             !< output variable
-    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int16_1d            !< output variable
-    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int32_1d            !< output variable
-    INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_intwp_1d            !< output variable
-    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int8_2d             !< output variable
-    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int16_2d            !< output variable
-    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int32_2d            !< output variable
-    INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_intwp_2d            !< output variable
-    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int8_3d             !< output variable
-    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int16_3d            !< output variable
-    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int32_3d            !< output variable
-    INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_intwp_3d            !< output variable
-
-    INTEGER(KIND=1), POINTER                                         ::  values_int8_0d_pointer     !< pointer to resortet array
-    INTEGER(KIND=2), POINTER                                         ::  values_int16_0d_pointer    !< pointer to resortet array
-    INTEGER(KIND=4), POINTER                                         ::  values_int32_0d_pointer    !< pointer to resortet array
-    INTEGER(iwp),    POINTER                                         ::  values_intwp_0d_pointer    !< pointer to resortet array
-    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_int8_1d_pointer     !< pointer to resortet array
-    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_int16_1d_pointer    !< pointer to resortet array
-    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_int32_1d_pointer    !< pointer to resortet array
-    INTEGER(iwp),    POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_intwp_1d_pointer    !< pointer to resortet array
-    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_int8_2d_pointer     !< pointer to resortet array
-    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_int16_2d_pointer    !< pointer to resortet array
-    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_int32_2d_pointer    !< pointer to resortet array
-    INTEGER(iwp),    POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_intwp_2d_pointer    !< pointer to resortet array
-    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_int8_3d_pointer     !< pointer to resortet array
-    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_int16_3d_pointer    !< pointer to resortet array
-    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_int32_3d_pointer    !< pointer to resortet array
-    INTEGER(iwp),    POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_intwp_3d_pointer    !< pointer to resortet array
-
-    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_int8_1d_resorted    !< resorted output variable
-    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_int16_1d_resorted   !< resorted output variable
-    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_int32_1d_resorted   !< resorted output variable
-    INTEGER(iwp),    TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_intwp_1d_resorted   !< resorted output variable
-    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_int8_2d_resorted    !< resorted output variable
-    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_int16_2d_resorted   !< resorted output variable
-    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_int32_2d_resorted   !< resorted output variable
-    INTEGER(iwp),    TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_intwp_2d_resorted   !< resorted output variable
-    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_int8_3d_resorted    !< resorted output variable
-    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_int16_3d_resorted   !< resorted output variable
-    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_int32_3d_resorted   !< resorted output variable
-    INTEGER(iwp),    TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_intwp_3d_resorted   !< resorted output variable
-
-    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL                      ::  values_real32_0d           !< output variable
-    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL                      ::  values_real64_0d           !< output variable
-    REAL(wp),     POINTER, INTENT(IN), OPTIONAL                      ::  values_realwp_0d           !< output variable
-    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)        ::  values_real32_1d           !< output variable
-    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)        ::  values_real64_1d           !< output variable
-    REAL(wp),     POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)        ::  values_realwp_1d           !< output variable
-    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)      ::  values_real32_2d           !< output variable
-    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)      ::  values_real64_2d           !< output variable
-    REAL(wp),     POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)      ::  values_realwp_2d           !< output variable
-    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:)    ::  values_real32_3d           !< output variable
-    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:)    ::  values_real64_3d           !< output variable
-    REAL(wp),     POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:)    ::  values_realwp_3d           !< output variable
-
-    REAL(KIND=4), POINTER                                            ::  values_real32_0d_pointer   !< pointer to resortet array
-    REAL(KIND=8), POINTER                                            ::  values_real64_0d_pointer   !< pointer to resortet array
-    REAL(wp),     POINTER                                            ::  values_realwp_0d_pointer   !< pointer to resortet array
-    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:)                  ::  values_real32_1d_pointer   !< pointer to resortet array
-    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:)                  ::  values_real64_1d_pointer   !< pointer to resortet array
-    REAL(wp),     POINTER, CONTIGUOUS, DIMENSION(:)                  ::  values_realwp_1d_pointer   !< pointer to resortet array
-    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:)                ::  values_real32_2d_pointer   !< pointer to resortet array
-    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:)                ::  values_real64_2d_pointer   !< pointer to resortet array
-    REAL(wp),     POINTER, CONTIGUOUS, DIMENSION(:,:)                ::  values_realwp_2d_pointer   !< pointer to resortet array
-    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:)              ::  values_real32_3d_pointer   !< pointer to resortet array
-    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:,:)              ::  values_real64_3d_pointer   !< pointer to resortet array
-    REAL(wp),     POINTER, CONTIGUOUS, DIMENSION(:,:,:)              ::  values_realwp_3d_pointer   !< pointer to resortet array
-
-    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:)                  ::  values_real32_1d_resorted  !< resorted output variable
-    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:)                  ::  values_real64_1d_resorted  !< resorted output variable
-    REAL(wp),     TARGET, ALLOCATABLE, DIMENSION(:)                  ::  values_realwp_1d_resorted  !< resorted output variable
-    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:)                ::  values_real32_2d_resorted  !< resorted output variable
-    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:)                ::  values_real64_2d_resorted  !< resorted output variable
-    REAL(wp),     TARGET, ALLOCATABLE, DIMENSION(:,:)                ::  values_realwp_2d_resorted  !< resorted output variable
-    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:)              ::  values_real32_3d_resorted  !< resorted output variable
-    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:,:)              ::  values_real64_3d_resorted  !< resorted output variable
-    REAL(wp),     TARGET, ALLOCATABLE, DIMENSION(:,:,:)              ::  values_realwp_3d_resorted  !< resorted output variable
-
-    TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimension_list  !< list of used dimensions of variable
-
-
-    return_value = 0
-    output_return_value = 0
-
-    CALL internal_message( 'debug', routine_name // ': write ' // TRIM( variable_name ) //         &
-                           ' into file ' // TRIM( file_name ) )
-!
-!-- Search for variable within file
-    CALL find_var_in_file( file_name, variable_name, file_format, file_id, variable_id,            &
-                           write_only_by_master_rank, dimension_list, return_value=return_value  )
-
-    IF ( return_value == 0 )  THEN
-!
-!--    Check if the correct amount of variable bounds were given
-       IF ( SIZE( bounds_start ) /= SIZE( dimension_list )  .OR.                                   &
-            SIZE( bounds_end )   /= SIZE( dimension_list ) )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': number bounds do not match with ' //                           &
-                                 'number of dimensions of variable ' //                            &
-                                 '(variable "' // TRIM( variable_name ) //                         &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-
-    ENDIF
-
-    IF ( return_value == 0 )  THEN
-!
-!--    Save starting index (lower bounds) of each dimension
-       ALLOCATE( bounds_origin(SIZE( dimension_list )) )
-       ALLOCATE( bounds_start_internal(SIZE( dimension_list )) )
-       ALLOCATE( value_counts(SIZE( dimension_list )) )
-
-       WRITE( temp_string, * ) bounds_start
-       CALL internal_message( 'debug', routine_name //                                             &
-                              ': file "' // TRIM( file_name ) //                                   &
-                              '", variable "' // TRIM( variable_name ) //                          &
-                              '", bounds_start =' // TRIM( temp_string ) )
-       WRITE( temp_string, * ) bounds_end
-       CALL internal_message( 'debug', routine_name //                                             &
-                              ': file "' // TRIM( file_name ) //                                   &
-                              '", variable "' // TRIM( variable_name ) //                          &
-                              '", bounds_end =' // TRIM( temp_string ) )
-!
-!--    Get bounds for masking
-       CALL get_masked_indices_and_masked_dimension_bounds( dimension_list, bounds_start,          &
-               bounds_end, bounds_start_internal, value_counts, bounds_origin, masked_indices )
-
-       do_output = .NOT. ANY( value_counts == 0 )
-
-       WRITE( temp_string, * ) bounds_start_internal
-       CALL internal_message( 'debug', routine_name //                                             &
-                              ': file "' // TRIM( file_name ) //                                   &
-                              '", variable "' // TRIM( variable_name ) //                          &
-                              '", bounds_start_internal =' // TRIM( temp_string ) )
-       WRITE( temp_string, * ) value_counts
-       CALL internal_message( 'debug', routine_name //                                             &
-                              ': file "' // TRIM( file_name ) //                                   &
-                              '", variable "' // TRIM( variable_name ) //                          &
-                              '", value_counts =' // TRIM( temp_string ) )
-!
-!--    Mask and resort variable
-!--    Character output
-       IF ( PRESENT( values_char_0d ) )  THEN
-          values_char_0d_pointer => values_char_0d
-       ELSEIF ( PRESENT( values_char_1d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_char_1d_resorted(0:value_counts(1)-1) )
-             !$OMP PARALLEL PRIVATE (i)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                values_char_1d_resorted(i) = values_char_1d(masked_indices(1,i))
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_char_1d_resorted(1) )
-             values_char_1d_resorted = ' '
-          ENDIF
-          values_char_1d_pointer => values_char_1d_resorted
-       ELSEIF ( PRESENT( values_char_2d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_char_2d_resorted(0:value_counts(1)-1,                                &
-                                               0:value_counts(2)-1) )
-             !$OMP PARALLEL PRIVATE (i,j)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   values_char_2d_resorted(i,j) = values_char_2d(masked_indices(2,j),              &
-                                                                 masked_indices(1,i))
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_char_2d_resorted(1,1) )
-             values_char_2d_resorted = ' '
-          ENDIF
-          values_char_2d_pointer => values_char_2d_resorted
-       ELSEIF ( PRESENT( values_char_3d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_char_3d_resorted(0:value_counts(1)-1,                                &
-                                               0:value_counts(2)-1,                                &
-                                               0:value_counts(3)-1) )
-             !$OMP PARALLEL PRIVATE (i,j,k)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   DO  k = 0, value_counts(3) - 1
-                      values_char_3d_resorted(i,j,k) = values_char_3d(masked_indices(3,k),         &
-                                                                      masked_indices(2,j),         &
-                                                                      masked_indices(1,i))
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_char_3d_resorted(1,1,1) )
-             values_char_3d_resorted = ' '
-          ENDIF
-          values_char_3d_pointer => values_char_3d_resorted
-!
-!--    8bit integer output
-       ELSEIF ( PRESENT( values_int8_0d ) )  THEN
-          values_int8_0d_pointer => values_int8_0d
-       ELSEIF ( PRESENT( values_int8_1d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_int8_1d_resorted(0:value_counts(1)-1) )
-             !$OMP PARALLEL PRIVATE (i)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                values_int8_1d_resorted(i) = values_int8_1d(masked_indices(1,i))
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_int8_1d_resorted(1) )
-             values_int8_1d_resorted = 0_1
-          ENDIF
-          values_int8_1d_pointer => values_int8_1d_resorted
-       ELSEIF ( PRESENT( values_int8_2d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_int8_2d_resorted(0:value_counts(1)-1,                                &
-                                               0:value_counts(2)-1) )
-             !$OMP PARALLEL PRIVATE (i,j)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   values_int8_2d_resorted(i,j) = values_int8_2d(masked_indices(2,j),              &
-                                                                 masked_indices(1,i))
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_int8_2d_resorted(1,1) )
-             values_int8_2d_resorted = 0_1
-          ENDIF
-          values_int8_2d_pointer => values_int8_2d_resorted
-       ELSEIF ( PRESENT( values_int8_3d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_int8_3d_resorted(0:value_counts(1)-1,                                &
-                                               0:value_counts(2)-1,                                &
-                                               0:value_counts(3)-1) )
-             !$OMP PARALLEL PRIVATE (i,j,k)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   DO  k = 0, value_counts(3) - 1
-                      values_int8_3d_resorted(i,j,k) = values_int8_3d(masked_indices(3,k),         &
-                                                                      masked_indices(2,j),         &
-                                                                      masked_indices(1,i))
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_int8_3d_resorted(1,1,1) )
-             values_int8_3d_resorted = 0_1
-          ENDIF
-          values_int8_3d_pointer => values_int8_3d_resorted
-!
-!--    16bit integer output
-       ELSEIF ( PRESENT( values_int16_0d ) )  THEN
-          values_int16_0d_pointer => values_int16_0d
-       ELSEIF ( PRESENT( values_int16_1d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_int16_1d_resorted(0:value_counts(1)-1) )
-             !$OMP PARALLEL PRIVATE (i)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                values_int16_1d_resorted(i) = values_int16_1d(masked_indices(1,i))
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_int16_1d_resorted(1) )
-             values_int16_1d_resorted = 0_1
-          ENDIF
-          values_int16_1d_pointer => values_int16_1d_resorted
-       ELSEIF ( PRESENT( values_int16_2d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_int16_2d_resorted(0:value_counts(1)-1,                               &
-                                                0:value_counts(2)-1) )
-             !$OMP PARALLEL PRIVATE (i,j)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   values_int16_2d_resorted(i,j) = values_int16_2d(masked_indices(2,j),            &
-                                                                   masked_indices(1,i))
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_int16_2d_resorted(1,1) )
-             values_int16_2d_resorted = 0_1
-          ENDIF
-          values_int16_2d_pointer => values_int16_2d_resorted
-       ELSEIF ( PRESENT( values_int16_3d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_int16_3d_resorted(0:value_counts(1)-1,                               &
-                                                0:value_counts(2)-1,                               &
-                                                0:value_counts(3)-1) )
-             !$OMP PARALLEL PRIVATE (i,j,k)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   DO  k = 0, value_counts(3) - 1
-                      values_int16_3d_resorted(i,j,k) = values_int16_3d(masked_indices(3,k),       &
-                                                                        masked_indices(2,j),       &
-                                                                        masked_indices(1,i))
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_int16_3d_resorted(1,1,1) )
-             values_int16_3d_resorted = 0_1
-          ENDIF
-          values_int16_3d_pointer => values_int16_3d_resorted
-!
-!--    32bit integer output
-       ELSEIF ( PRESENT( values_int32_0d ) )  THEN
-          values_int32_0d_pointer => values_int32_0d
-       ELSEIF ( PRESENT( values_int32_1d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_int32_1d_resorted(0:value_counts(1)-1) )
-             !$OMP PARALLEL PRIVATE (i)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                values_int32_1d_resorted(i) = values_int32_1d(masked_indices(1,i))
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_int32_1d_resorted(1) )
-             values_int32_1d_resorted = 0_1
-          ENDIF
-          values_int32_1d_pointer => values_int32_1d_resorted
-       ELSEIF ( PRESENT( values_int32_2d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_int32_2d_resorted(0:value_counts(1)-1,                               &
-                                                0:value_counts(2)-1) )
-             !$OMP PARALLEL PRIVATE (i,j)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   values_int32_2d_resorted(i,j) = values_int32_2d(masked_indices(2,j),            &
-                                                                   masked_indices(1,i))
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_int32_2d_resorted(1,1) )
-             values_int32_2d_resorted = 0_1
-          ENDIF
-          values_int32_2d_pointer => values_int32_2d_resorted
-       ELSEIF ( PRESENT( values_int32_3d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_int32_3d_resorted(0:value_counts(1)-1,                               &
-                                                0:value_counts(2)-1,                               &
-                                                0:value_counts(3)-1) )
-             !$OMP PARALLEL PRIVATE (i,j,k)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   DO  k = 0, value_counts(3) - 1
-                      values_int32_3d_resorted(i,j,k) = values_int32_3d(masked_indices(3,k),       &
-                                                                        masked_indices(2,j),       &
-                                                                        masked_indices(1,i))
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_int32_3d_resorted(1,1,1) )
-             values_int32_3d_resorted = 0_1
-          ENDIF
-          values_int32_3d_pointer => values_int32_3d_resorted
-!
-!--    Working-precision integer output
-       ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
-          values_intwp_0d_pointer => values_intwp_0d
-       ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_intwp_1d_resorted(0:value_counts(1)-1) )
-             !$OMP PARALLEL PRIVATE (i)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                values_intwp_1d_resorted(i) = values_intwp_1d(masked_indices(1,i))
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_intwp_1d_resorted(1) )
-             values_intwp_1d_resorted = 0_1
-          ENDIF
-          values_intwp_1d_pointer => values_intwp_1d_resorted
-       ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_intwp_2d_resorted(0:value_counts(1)-1,                               &
-                                                0:value_counts(2)-1) )
-             !$OMP PARALLEL PRIVATE (i,j)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   values_intwp_2d_resorted(i,j) = values_intwp_2d(masked_indices(2,j),            &
-                                                                   masked_indices(1,i))
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_intwp_2d_resorted(1,1) )
-             values_intwp_2d_resorted = 0_1
-          ENDIF
-          values_intwp_2d_pointer => values_intwp_2d_resorted
-       ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_intwp_3d_resorted(0:value_counts(1)-1,                               &
-                                                0:value_counts(2)-1,                               &
-                                                0:value_counts(3)-1) )
-             !$OMP PARALLEL PRIVATE (i,j,k)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   DO  k = 0, value_counts(3) - 1
-                      values_intwp_3d_resorted(i,j,k) = values_intwp_3d(masked_indices(3,k),       &
-                                                                        masked_indices(2,j),       &
-                                                                        masked_indices(1,i))
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_intwp_3d_resorted(1,1,1) )
-             values_intwp_3d_resorted = 0_1
-          ENDIF
-          values_intwp_3d_pointer => values_intwp_3d_resorted
-!
-!--    32bit real output
-       ELSEIF ( PRESENT( values_real32_0d ) )  THEN
-          values_real32_0d_pointer => values_real32_0d
-       ELSEIF ( PRESENT( values_real32_1d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_real32_1d_resorted(0:value_counts(1)-1) )
-             !$OMP PARALLEL PRIVATE (i)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                values_real32_1d_resorted(i) = values_real32_1d(masked_indices(1,i))
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_real32_1d_resorted(1) )
-             values_real32_1d_resorted = 0_1
-          ENDIF
-          values_real32_1d_pointer => values_real32_1d_resorted
-       ELSEIF ( PRESENT( values_real32_2d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_real32_2d_resorted(0:value_counts(1)-1,                              &
-                                                 0:value_counts(2)-1) )
-             !$OMP PARALLEL PRIVATE (i,j)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   values_real32_2d_resorted(i,j) = values_real32_2d(masked_indices(2,j),          &
-                                                                     masked_indices(1,i))
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_real32_2d_resorted(1,1) )
-             values_real32_2d_resorted = 0_1
-          ENDIF
-          values_real32_2d_pointer => values_real32_2d_resorted
-       ELSEIF ( PRESENT( values_real32_3d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_real32_3d_resorted(0:value_counts(1)-1,                              &
-                                                 0:value_counts(2)-1,                              &
-                                                 0:value_counts(3)-1) )
-             !$OMP PARALLEL PRIVATE (i,j,k)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   DO  k = 0, value_counts(3) - 1
-                      values_real32_3d_resorted(i,j,k) = values_real32_3d(masked_indices(3,k),     &
-                                                                          masked_indices(2,j),     &
-                                                                          masked_indices(1,i))
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_real32_3d_resorted(1,1,1) )
-             values_real32_3d_resorted = 0_1
-          ENDIF
-          values_real32_3d_pointer => values_real32_3d_resorted
-!
-!--    64bit real output
-       ELSEIF ( PRESENT( values_real64_0d ) )  THEN
-          values_real64_0d_pointer => values_real64_0d
-       ELSEIF ( PRESENT( values_real64_1d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_real64_1d_resorted(0:value_counts(1)-1) )
-             !$OMP PARALLEL PRIVATE (i)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                values_real64_1d_resorted(i) = values_real64_1d(masked_indices(1,i))
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_real64_1d_resorted(1) )
-             values_real64_1d_resorted = 0_1
-          ENDIF
-          values_real64_1d_pointer => values_real64_1d_resorted
-       ELSEIF ( PRESENT( values_real64_2d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_real64_2d_resorted(0:value_counts(1)-1,                              &
-                                                 0:value_counts(2)-1) )
-             !$OMP PARALLEL PRIVATE (i,j)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   values_real64_2d_resorted(i,j) = values_real64_2d(masked_indices(2,j),          &
-                                                                     masked_indices(1,i))
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_real64_2d_resorted(1,1) )
-             values_real64_2d_resorted = 0_1
-          ENDIF
-          values_real64_2d_pointer => values_real64_2d_resorted
-       ELSEIF ( PRESENT( values_real64_3d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_real64_3d_resorted(0:value_counts(1)-1,                              &
-                                                 0:value_counts(2)-1,                              &
-                                                 0:value_counts(3)-1) )
-             !$OMP PARALLEL PRIVATE (i,j,k)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   DO  k = 0, value_counts(3) - 1
-                      values_real64_3d_resorted(i,j,k) = values_real64_3d(masked_indices(3,k),     &
-                                                                          masked_indices(2,j),     &
-                                                                          masked_indices(1,i))
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_real64_3d_resorted(1,1,1) )
-             values_real64_3d_resorted = 0_1
-          ENDIF
-          values_real64_3d_pointer => values_real64_3d_resorted
-!
-!--    Working-precision real output
-       ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
-          values_realwp_0d_pointer => values_realwp_0d
-       ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_realwp_1d_resorted(0:value_counts(1)-1) )
-             !$OMP PARALLEL PRIVATE (i)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                values_realwp_1d_resorted(i) = values_realwp_1d(masked_indices(1,i))
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_realwp_1d_resorted(1) )
-             values_realwp_1d_resorted = 0_1
-          ENDIF
-          values_realwp_1d_pointer => values_realwp_1d_resorted
-       ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_realwp_2d_resorted(0:value_counts(1)-1,                              &
-                                                 0:value_counts(2)-1) )
-             !$OMP PARALLEL PRIVATE (i,j)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   values_realwp_2d_resorted(i,j) = values_realwp_2d(masked_indices(2,j),          &
-                                                                     masked_indices(1,i))
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_realwp_2d_resorted(1,1) )
-             values_realwp_2d_resorted = 0_1
-          ENDIF
-          values_realwp_2d_pointer => values_realwp_2d_resorted
-       ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
-          IF ( do_output ) THEN
-             ALLOCATE( values_realwp_3d_resorted(0:value_counts(1)-1,                              &
-                                                 0:value_counts(2)-1,                              &
-                                                 0:value_counts(3)-1) )
-             !$OMP PARALLEL PRIVATE (i,j,k)
-             !$OMP DO
-             DO  i = 0, value_counts(1) - 1
-                DO  j = 0, value_counts(2) - 1
-                   DO  k = 0, value_counts(3) - 1
-                      values_realwp_3d_resorted(i,j,k) = values_realwp_3d(masked_indices(3,k),     &
-                                                                          masked_indices(2,j),     &
-                                                                          masked_indices(1,i))
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-          ELSE
-             ALLOCATE( values_realwp_3d_resorted(1,1,1) )
-             values_realwp_3d_resorted = 0_1
-          ENDIF
-          values_realwp_3d_pointer => values_realwp_3d_resorted
-
-       ELSE
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': no output values given ' //                                    &
-                                 '(variable "' // TRIM( variable_name ) //                         &
-                                 '", file "' // TRIM( file_name ) // '")!'  )
-       ENDIF
-
-       DEALLOCATE( masked_indices )
-
-    ENDIF  ! Check for error
-
-    IF ( return_value == 0 )  THEN
-!
-!--    Write variable into file
-       SELECT CASE ( TRIM( file_format ) )
-
-          CASE ( 'binary' )
-!
-!--          Character output
-             IF ( PRESENT( values_char_0d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_char_0d=values_char_0d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_char_1d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_char_1d=values_char_1d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_char_2d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_char_2d=values_char_2d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_char_3d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_char_3d=values_char_3d_pointer,          &
-                        return_value=output_return_value )
-!
-!--          8bit integer output
-             ELSEIF ( PRESENT( values_int8_0d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int8_0d=values_int8_0d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int8_1d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int8_1d=values_int8_1d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int8_2d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int8_2d=values_int8_2d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int8_3d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int8_3d=values_int8_3d_pointer,          &
-                        return_value=output_return_value )
-!
-!--          16bit integer output
-             ELSEIF ( PRESENT( values_int16_0d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int16_0d=values_int16_0d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int16_1d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int16_1d=values_int16_1d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int16_2d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int16_2d=values_int16_2d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int16_3d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int16_3d=values_int16_3d_pointer,        &
-                        return_value=output_return_value )
-!
-!--          32bit integer output
-             ELSEIF ( PRESENT( values_int32_0d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int32_0d=values_int32_0d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int32_1d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int32_1d=values_int32_1d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int32_2d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int32_2d=values_int32_2d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int32_3d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int32_3d=values_int32_3d_pointer,        &
-                        return_value=output_return_value )
-!
-!--          Working-precision integer output
-             ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_intwp_0d=values_intwp_0d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_intwp_1d=values_intwp_1d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_intwp_2d=values_intwp_2d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_intwp_3d=values_intwp_3d_pointer,        &
-                        return_value=output_return_value )
-!
-!--          32bit real output
-             ELSEIF ( PRESENT( values_real32_0d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real32_0d=values_real32_0d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real32_1d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real32_1d=values_real32_1d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real32_2d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real32_2d=values_real32_2d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real32_3d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real32_3d=values_real32_3d_pointer,      &
-                        return_value=output_return_value )
-!
-!--          64bit real output
-             ELSEIF ( PRESENT( values_real64_0d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real64_0d=values_real64_0d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real64_1d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real64_1d=values_real64_1d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real64_2d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real64_2d=values_real64_2d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real64_3d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real64_3d=values_real64_3d_pointer,      &
-                        return_value=output_return_value )
-!
-!--          Working-precision real output
-             ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_realwp_0d=values_realwp_0d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_realwp_1d=values_realwp_1d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_realwp_2d=values_realwp_2d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
-                CALL binary_write_variable( file_id, variable_id,                                  &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_realwp_3d=values_realwp_3d_pointer,      &
-                        return_value=output_return_value )
-             ELSE
-                return_value = 1
-                CALL internal_message( 'error', routine_name //                                    &
-                                       ': output_type not supported by file format "' //           &
-                                       TRIM( file_format ) // '" ' //                              &
-                                       '(variable "' // TRIM( variable_name ) //                   &
-                                       '", file "' // TRIM( file_name ) // '")!' )
-             ENDIF
-
-          CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
-!
-!--          Character integer output
-             IF ( PRESENT( values_char_0d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_char_0d=values_char_0d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_char_1d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_char_1d=values_char_1d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_char_2d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_char_2d=values_char_2d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_char_3d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_char_3d=values_char_3d_pointer,          &
-                        return_value=output_return_value )
-!
-!--          8bit integer output
-             ELSEIF ( PRESENT( values_int8_0d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int8_0d=values_int8_0d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int8_1d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int8_1d=values_int8_1d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int8_2d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int8_2d=values_int8_2d_pointer,          &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int8_3d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int8_3d=values_int8_3d_pointer,          &
-                        return_value=output_return_value )
-!
-!--          16bit integer output
-             ELSEIF ( PRESENT( values_int16_0d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int16_0d=values_int16_0d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int16_1d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int16_1d=values_int16_1d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int16_2d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int16_2d=values_int16_2d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int16_3d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int16_3d=values_int16_3d_pointer,        &
-                        return_value=output_return_value )
-!
-!--          32bit integer output
-             ELSEIF ( PRESENT( values_int32_0d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int32_0d=values_int32_0d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int32_1d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int32_1d=values_int32_1d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int32_2d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int32_2d=values_int32_2d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_int32_3d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_int32_3d=values_int32_3d_pointer,        &
-                        return_value=output_return_value )
-!
-!--          Working-precision integer output
-             ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_intwp_0d=values_intwp_0d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_intwp_1d=values_intwp_1d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_intwp_2d=values_intwp_2d_pointer,        &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_intwp_3d=values_intwp_3d_pointer,        &
-                        return_value=output_return_value )
-!
-!--          32bit real output
-             ELSEIF ( PRESENT( values_real32_0d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real32_0d=values_real32_0d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real32_1d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real32_1d=values_real32_1d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real32_2d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real32_2d=values_real32_2d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real32_3d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real32_3d=values_real32_3d_pointer,      &
-                        return_value=output_return_value )
-!
-!--          64bit real output
-             ELSEIF ( PRESENT( values_real64_0d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real64_0d=values_real64_0d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real64_1d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real64_1d=values_real64_1d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real64_2d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real64_2d=values_real64_2d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_real64_3d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_real64_3d=values_real64_3d_pointer,      &
-                        return_value=output_return_value )
-!
-!--          Working-precision real output
-             ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_realwp_0d=values_realwp_0d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_realwp_1d=values_realwp_1d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_realwp_2d=values_realwp_2d_pointer,      &
-                        return_value=output_return_value )
-             ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
-                CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id,        &
-                        bounds_start_internal, value_counts, bounds_origin,                        &
-                        write_only_by_master_rank, values_realwp_3d=values_realwp_3d_pointer,      &
-                        return_value=output_return_value )
-             ELSE
-                return_value = 1
-                CALL internal_message( 'error', routine_name //                                    &
-                                       ': output_type not supported by file format "' //           &
-                                       TRIM( file_format ) // '" ' //                              &
-                                       '(variable "' // TRIM( variable_name ) //                   &
-                                       '", file "' // TRIM( file_name ) // '")!' )
-             ENDIF
-
-          CASE DEFAULT
-             return_value = 1
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': file format "' // TRIM( file_format ) //                    &
-                                    '" not supported ' //                                          &
-                                    '(variable "' // TRIM( variable_name ) //                      &
-                                    '", file "' // TRIM( file_name ) // '")!' )
-
-       END SELECT
-
-       IF ( return_value == 0  .AND.  output_return_value /= 0 )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': error while writing variable ' //                              &
-                                 '(variable "' // TRIM( variable_name ) //                         &
-                                 '", file "' // TRIM( file_name ) // '")!' )
-       ENDIF
-
-    ENDIF
-
- END FUNCTION dom_write_var
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Finalize output.
-!> All necessary steps are carried out to close all output files. If a file could not be closed,
-!> this is noted in the error message.
-!>
-!> @bug if multiple files failed to be closed, only the last failure is given in the error message.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_finalize_output() RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_finalize_output'  !< name of routine
-
-    INTEGER ::  f                      !< loop index
-    INTEGER ::  output_return_value    !< return value from called routines
-    INTEGER ::  return_value           !< return value
-    INTEGER ::  return_value_internal  !< error code after closing a single file
-
-
-    return_value = 0
-
-    DO  f = 1, nfiles
-
-       IF ( files(f)%is_init )  THEN
-
-          output_return_value = 0
-          return_value_internal = 0
-
-          SELECT CASE ( TRIM( files(f)%format ) )
-
-             CASE ( 'binary' )
-                CALL binary_finalize( files(f)%id, output_return_value )
-
-             CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
-                CALL netcdf4_finalize( TRIM( files(f)%format(9:) ), files(f)%id,                   &
-                                       output_return_value )
-
-             CASE DEFAULT
-                return_value_internal = 1
-
-          END SELECT
-
-          IF ( output_return_value /= 0 )  THEN
-             return_value = output_return_value
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': error while finalizing file "' //                           &
-                                    TRIM( files(f)%name ) // '"' )
-          ELSEIF ( return_value_internal /= 0 )  THEN
-             return_value = return_value_internal
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': unsupported file format "' //                               &
-                                    TRIM( files(f)%format ) // '" for file "' //                   &
-                                    TRIM( files(f)%name ) // '"' )
-          ENDIF
-
-       ENDIF
-
-    ENDDO
-
- END FUNCTION dom_finalize_output
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Return the last created error message.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION dom_get_error_message() RESULT( error_message )
-
-    CHARACTER(LEN=800) ::  error_message  !< return error message to main program
-
-
-    error_message = TRIM( internal_error_message )
-
-    error_message = TRIM( error_message ) // TRIM( binary_get_error_message() )
-
-    error_message = TRIM( error_message ) // TRIM( netcdf4_get_error_message() )
-
-    internal_error_message = ''
-
- END FUNCTION dom_get_error_message
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Add attribute to database.
-!>
-!> @todo Try to combine similar code parts and shorten routine.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION save_attribute_in_database( file_name, variable_name, attribute, append )                &
-             RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'save_attribute_in_database'  !< name of routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name      !< name of file
-    CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< name of variable
-
-    INTEGER ::  a             !< loop index
-    INTEGER ::  d             !< loop index
-    INTEGER ::  f             !< loop index
-    INTEGER ::  natts         !< number of attributes
-    INTEGER ::  return_value  !< return value
-
-    LOGICAL             ::  found   !< true if variable or dimension of name 'variable_name' found
-    LOGICAL, INTENT(IN) ::  append  !< if true, append value to existing value
-
-    TYPE(attribute_type), INTENT(IN) ::  attribute  !< new attribute
-
-    TYPE(attribute_type), DIMENSION(:), ALLOCATABLE ::  atts_tmp  !< temporary attribute list
-
-
-    return_value = 0
-    found = .FALSE.
-
-    CALL internal_message( 'debug', routine_name //                                                &
-                           ': define attribute "' // TRIM( attribute%name ) //                     &
-                           '" of variable "' // TRIM( variable_name ) //                           &
-                           '" in file "' // TRIM( file_name ) // '"' )
-
-    DO  f = 1, nfiles
-
-       IF ( TRIM( file_name ) == files(f)%name )  THEN
-
-          IF ( files(f)%is_init )  THEN
-             return_value = 1
-             CALL internal_message( 'error', routine_name // ': file "' // TRIM( file_name ) //    &
-                     '" is already initialized. No further attribute definition allowed!' )
-             EXIT
-          ENDIF
-!
-!--       Add attribute to file
-          IF ( TRIM( variable_name ) == '' )  THEN
-!
-!--          Initialize first file attribute
-             IF ( .NOT. ALLOCATED( files(f)%attributes ) )  THEN
-                natts = 1
-                ALLOCATE( files(f)%attributes(natts) )
-             ELSE
-                natts = SIZE( files(f)%attributes )
-!
-!--             Check if attribute already exists
-                DO  a = 1, natts
-                   IF ( files(f)%attributes(a)%name == attribute%name )  THEN
-                      IF ( append )  THEN
-!
-!--                      Append existing string attribute
-                         files(f)%attributes(a)%value_char =                                       &
-                            TRIM( files(f)%attributes(a)%value_char ) //                           &
-                            TRIM( attribute%value_char )
-                      ELSE
-                         files(f)%attributes(a) = attribute
-                      ENDIF
-                      found = .TRUE.
-                      EXIT
-                   ENDIF
-                ENDDO
-!
-!--             Extend attribute list by 1
-                IF ( .NOT. found )  THEN
-                   ALLOCATE( atts_tmp(natts) )
-                   atts_tmp = files(f)%attributes
-                   DEALLOCATE( files(f)%attributes )
-                   natts = natts + 1
-                   ALLOCATE( files(f)%attributes(natts) )
-                   files(f)%attributes(:natts-1) = atts_tmp
-                   DEALLOCATE( atts_tmp )
-                ENDIF
-             ENDIF
-!
-!--          Save new attribute to the end of the attribute list
-             IF ( .NOT. found )  THEN
-                files(f)%attributes(natts) = attribute
-                found = .TRUE.
-             ENDIF
-
-             EXIT
-
-          ELSE
-!
-!--          Add attribute to dimension
-             IF ( ALLOCATED( files(f)%dimensions ) )  THEN
-
-                DO  d = 1, SIZE( files(f)%dimensions )
-
-                   IF ( files(f)%dimensions(d)%name == TRIM( variable_name ) )  THEN
-
-                      IF ( .NOT. ALLOCATED( files(f)%dimensions(d)%attributes ) )  THEN
-!
-!--                      Initialize first attribute
-                         natts = 1
-                         ALLOCATE( files(f)%dimensions(d)%attributes(natts) )
-                      ELSE
-                         natts = SIZE( files(f)%dimensions(d)%attributes )
-!
-!--                      Check if attribute already exists
-                         DO  a = 1, natts
-                            IF ( files(f)%dimensions(d)%attributes(a)%name == attribute%name )     &
-                            THEN
-                               IF ( append )  THEN
-!
-!--                               Append existing character attribute
-                                  files(f)%dimensions(d)%attributes(a)%value_char =                &
-                                     TRIM( files(f)%dimensions(d)%attributes(a)%value_char ) //    &
-                                     TRIM( attribute%value_char )
-                               ELSE
-!
-!--                               Update existing attribute
-                                  files(f)%dimensions(d)%attributes(a) = attribute
-                               ENDIF
-                               found = .TRUE.
-                               EXIT
-                            ENDIF
-                         ENDDO
-!
-!--                      Extend attribute list
-                         IF ( .NOT. found )  THEN
-                            ALLOCATE( atts_tmp(natts) )
-                            atts_tmp = files(f)%dimensions(d)%attributes
-                            DEALLOCATE( files(f)%dimensions(d)%attributes )
-                            natts = natts + 1
-                            ALLOCATE( files(f)%dimensions(d)%attributes(natts) )
-                            files(f)%dimensions(d)%attributes(:natts-1) = atts_tmp
-                            DEALLOCATE( atts_tmp )
-                         ENDIF
-                      ENDIF
-!
-!--                   Add new attribute to database
-                      IF ( .NOT. found )  THEN
-                         files(f)%dimensions(d)%attributes(natts) = attribute
-                         found = .TRUE.
-                      ENDIF
-
-                      EXIT
-
-                   ENDIF  ! dimension found
-
-                ENDDO  ! loop over dimensions
-
-             ENDIF  ! dimensions exist in file
-!
-!--          Add attribute to variable
-             IF ( .NOT. found  .AND.  ALLOCATED( files(f)%variables) )  THEN
-
-                DO  d = 1, SIZE( files(f)%variables )
-
-                   IF ( files(f)%variables(d)%name == TRIM( variable_name ) )  THEN
-
-                      IF ( .NOT. ALLOCATED( files(f)%variables(d)%attributes ) )  THEN
-!
-!--                      Initialize first attribute
-                         natts = 1
-                         ALLOCATE( files(f)%variables(d)%attributes(natts) )
-                      ELSE
-                         natts = SIZE( files(f)%variables(d)%attributes )
-!
-!--                      Check if attribute already exists
-                         DO  a = 1, natts
-                            IF ( files(f)%variables(d)%attributes(a)%name == attribute%name )  THEN
-                               IF ( append )  THEN
-!
-!--                               Append existing character attribute
-                                  files(f)%variables(d)%attributes(a)%value_char =                 &
-                                     TRIM( files(f)%variables(d)%attributes(a)%value_char ) //     &
-                                     TRIM( attribute%value_char )
-                               ELSE
-!
-!--                               Update existing attribute
-                                  files(f)%variables(d)%attributes(a) = attribute
-                               ENDIF
-                               found = .TRUE.
-                               EXIT
-                            ENDIF
-                         ENDDO
-!
-!--                      Extend attribute list
-                         IF ( .NOT. found )  THEN
-                            ALLOCATE( atts_tmp(natts) )
-                            atts_tmp = files(f)%variables(d)%attributes
-                            DEALLOCATE( files(f)%variables(d)%attributes )
-                            natts = natts + 1
-                            ALLOCATE( files(f)%variables(d)%attributes(natts) )
-                            files(f)%variables(d)%attributes(:natts-1) = atts_tmp
-                            DEALLOCATE( atts_tmp )
-                         ENDIF
-
-                      ENDIF
-!
-!--                   Add new attribute to database
-                      IF ( .NOT. found )  THEN
-                         files(f)%variables(d)%attributes(natts) = attribute
-                         found = .TRUE.
-                      ENDIF
-
-                      EXIT
-
-                   ENDIF  ! variable found
-
-                ENDDO  ! loop over variables
-
-             ENDIF  ! variables exist in file
-
-             IF ( .NOT. found )  THEN
-                return_value = 1
-                CALL internal_message( 'error',                                                    &
-                        routine_name //                                                            &
-                        ': requested dimension/variable "' // TRIM( variable_name ) //             &
-                        '" for attribute "' // TRIM( attribute%name ) //                           &
-                        '" does not exist in file "' // TRIM( file_name ) // '"' )
-             ENDIF
-
-             EXIT
-
-          ENDIF  ! variable_name not empty
-
-       ENDIF  ! check file_name
-
-    ENDDO  ! loop over files
-
-    IF ( .NOT. found  .AND.  return_value == 0 )  THEN
-       return_value = 1
-       CALL internal_message( 'error',                                                             &
-                              routine_name //                                                      &
-                              ': requested file "' // TRIM( file_name ) //                         &
-                              '" for attribute "' // TRIM( attribute%name ) //                     &
-                              '" does not exist' )
-    ENDIF
-
- END FUNCTION save_attribute_in_database
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check database and delete any unused dimensions and empty files (i.e. files
-!> without variables).
-!--------------------------------------------------------------------------------------------------!
- FUNCTION cleanup_database() RESULT( return_value )
-
-    ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'cleanup_database'  !< name of routine
-
-    INTEGER ::  d             !< loop index
-    INTEGER ::  f             !< loop index
-    INTEGER ::  i             !< loop index
-    INTEGER ::  ndims         !< number of dimensions in a file
-    INTEGER ::  ndims_used    !< number of used dimensions in a file
-    INTEGER ::  nfiles_used   !< number of used files
-    INTEGER ::  nvars         !< number of variables in a file
-    INTEGER ::  return_value  !< return value
-
-    LOGICAL, DIMENSION(1:nfiles)             ::  file_is_used       !< true if file contains variables
-    LOGICAL, DIMENSION(:),       ALLOCATABLE ::  dimension_is_used  !< true if dimension is used by any variable
-
-    TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  used_dimensions  !< list of used dimensions
-
-    TYPE(file_type), DIMENSION(:), ALLOCATABLE ::  used_files  !< list of used files
-
-
-    return_value = 0
-!
-!-- Flag files which contain output variables as used
-    file_is_used(:) = .FALSE.
-    DO  f = 1, nfiles
-       IF ( ALLOCATED( files(f)%variables ) )  THEN
-          file_is_used(f) = .TRUE.
-       ENDIF
-    ENDDO
-!
-!-- Copy flagged files into temporary list
-    nfiles_used = COUNT( file_is_used )
-    ALLOCATE( used_files(nfiles_used) )
-    i = 0
-    DO  f = 1, nfiles
-       IF ( file_is_used(f) )  THEN
-          i = i + 1
-          used_files(i) = files(f)
-       ENDIF
-    ENDDO
-!
-!-- Replace file list with list of used files
-    DEALLOCATE( files )
-    nfiles = nfiles_used
-    ALLOCATE( files(nfiles) )
-    files = used_files
-    DEALLOCATE( used_files )
-!
-!-- Check every file for unused dimensions
-    DO  f = 1, nfiles
-!
-!--    If a file is already initialized, it was already checked previously
-       IF ( files(f)%is_init )  CYCLE
-!
-!--    Get number of defined dimensions
-       ndims = SIZE( files(f)%dimensions )
-       ALLOCATE( dimension_is_used(ndims) )
-!
-!--    Go through all variables and flag all used dimensions
-       nvars = SIZE( files(f)%variables )
-       DO  d = 1, ndims
-          DO  i = 1, nvars
-             dimension_is_used(d) =                                                                &
-                ANY( files(f)%dimensions(d)%name == files(f)%variables(i)%dimension_names )
-             IF ( dimension_is_used(d) )  EXIT
-          ENDDO
-       ENDDO
-!
-!--    Copy used dimensions to temporary list
-       ndims_used = COUNT( dimension_is_used )
-       ALLOCATE( used_dimensions(ndims_used) )
-       i = 0
-       DO  d = 1, ndims
-          IF ( dimension_is_used(d) )  THEN
-             i = i + 1
-             used_dimensions(i) = files(f)%dimensions(d)
-          ENDIF
-       ENDDO
-!
-!--    Replace dimension list with list of used dimensions
-       DEALLOCATE( files(f)%dimensions )
-       ndims = ndims_used
-       ALLOCATE( files(f)%dimensions(ndims) )
-       files(f)%dimensions = used_dimensions
-       DEALLOCATE( used_dimensions )
-       DEALLOCATE( dimension_is_used )
-
-    ENDDO
-
- END FUNCTION cleanup_database
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Open requested output file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE open_output_file( file_format, file_name, file_id, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'open_output_file'  !< name of routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< name of file to be checked
-
-    INTEGER, INTENT(OUT) ::  file_id              !< file ID
-    INTEGER              ::  output_return_value  !< return value of a called output routine
-    INTEGER, INTENT(OUT) ::  return_value         !< return value
-
-
-    return_value = 0
-    output_return_value = 0
-
-    SELECT CASE ( TRIM( file_format ) )
-
-       CASE ( 'binary' )
-          CALL binary_open_file( 'binary', file_name, file_id, output_return_value )
-
-       CASE ( 'netcdf4-serial' )
-          CALL netcdf4_open_file( 'serial', file_name, file_id, output_return_value )
-
-       CASE ( 'netcdf4-parallel' )
-          CALL netcdf4_open_file( 'parallel', file_name, file_id, output_return_value )
-
-       CASE DEFAULT
-          return_value = 1
-
-    END SELECT
-
-    IF ( output_return_value /= 0 )  THEN
-       return_value = output_return_value
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': error while opening file "' // TRIM( file_name ) // '"' )
-    ELSEIF ( return_value /= 0 )  THEN
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': file "' // TRIM( file_name ) //                                   &
-                              '": file format "' // TRIM( file_format ) //                         &
-                              '" not supported' )
-    ENDIF
-
- END SUBROUTINE open_output_file
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize attributes, dimensions and variables in a file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_file_header( file, return_value )
-
-    ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_header'  !< name of routine
-
-    INTEGER              ::  a             !< loop index
-    INTEGER              ::  d             !< loop index
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-
-    TYPE(file_type), INTENT(INOUT) ::  file  !< initialize header of this file
-
-
-    return_value  = 0
-!
-!-- Write file attributes
-    IF ( ALLOCATED( file%attributes ) )  THEN
-       DO  a = 1, SIZE( file%attributes )
-          return_value = write_attribute( file%format, file%id, file%name,                         &
-                                          variable_id=no_id, variable_name='',                     &
-                                          attribute=file%attributes(a) )
-          IF ( return_value /= 0 )  EXIT
-       ENDDO
-    ENDIF
-
-    IF ( return_value == 0 )  THEN
-!
-!--    Initialize file dimensions
-       DO  d = 1, SIZE( file%dimensions )
-
-          IF ( .NOT. file%dimensions(d)%is_masked )  THEN
-!
-!--          Initialize non-masked dimension
-             CALL init_file_dimension( file%format, file%id, file%name,                            &
-                                       file%dimensions(d)%id, file%dimensions(d)%name,             &
-                                       file%dimensions(d)%data_type, file%dimensions(d)%length,    &
-                                       file%dimensions(d)%variable_id,                             &
-                                       file%dimensions(d)%write_only_by_master_rank, return_value )
-
-          ELSE
-!
-!--          Initialize masked dimension
-             CALL init_file_dimension( file%format, file%id, file%name,                            &
-                     file%dimensions(d)%id, file%dimensions(d)%name,                               &
-                     file%dimensions(d)%data_type, file%dimensions(d)%length_mask,                 &
-                     file%dimensions(d)%variable_id,                                               &
-                     file%dimensions(d)%write_only_by_master_rank, return_value )
-
-          ENDIF
-
-          IF ( return_value == 0  .AND.  ALLOCATED( file%dimensions(d)%attributes ) )  THEN
-!
-!--          Write dimension attributes
-             DO  a = 1, SIZE( file%dimensions(d)%attributes )
-                return_value = write_attribute( file%format, file%id, file%name,                   &
-                                                variable_id=file%dimensions(d)%variable_id,        &
-                                                variable_name=file%dimensions(d)%name,             &
-                                                attribute=file%dimensions(d)%attributes(a) )
-                IF ( return_value /= 0 )  EXIT
-             ENDDO
-          ENDIF
-
-          IF ( return_value /= 0 )  EXIT
-
-       ENDDO
-!
-!--    Save dimension IDs for variables wihtin database
-       IF ( return_value == 0 )                                                                    &
-          CALL collect_dimesion_ids_for_variables( file%name, file%variables, file%dimensions,     &
-                                                   return_value )
-!
-!--    Initialize file variables
-       IF ( return_value == 0 )  THEN
-          DO  d = 1, SIZE( file%variables )
-
-             CALL init_file_variable( file%format, file%id, file%name,                             &
-                     file%variables(d)%id, file%variables(d)%name, file%variables(d)%data_type,    &
-                     file%variables(d)%dimension_ids,                                              &
-                     file%variables(d)%write_only_by_master_rank, return_value )
-
-             IF ( return_value == 0  .AND.  ALLOCATED( file%variables(d)%attributes ) )  THEN
-!
-!--             Write variable attributes
-                DO  a = 1, SIZE( file%variables(d)%attributes )
-                   return_value = write_attribute( file%format, file%id, file%name,                &
-                                                   variable_id=file%variables(d)%id,               &
-                                                   variable_name=file%variables(d)%name,           &
-                                                   attribute=file%variables(d)%attributes(a) )
-                   IF ( return_value /= 0 )  EXIT
-                ENDDO
-             ENDIF
-
-             IF ( return_value /= 0 )  EXIT
-
-          ENDDO
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE init_file_header
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize dimension in file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_file_dimension( file_format, file_id, file_name,                                  &
-                                 dimension_id, dimension_name, dimension_type, dimension_length,   &
-                                 variable_id, write_only_by_master_rank, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_dimension'  !< file format chosen for file
-
-    CHARACTER(LEN=*), INTENT(IN) ::  dimension_name  !< name of dimension
-    CHARACTER(LEN=*), INTENT(IN) ::  dimension_type  !< data type of dimension
-    CHARACTER(LEN=*), INTENT(IN) ::  file_format     !< file format chosen for file
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name       !< name of file
-
-    INTEGER, INTENT(OUT) ::  dimension_id         !< dimension ID
-    INTEGER, INTENT(IN)  ::  dimension_length     !< length of dimension
-    INTEGER, INTENT(IN)  ::  file_id              !< file ID
-    INTEGER              ::  output_return_value  !< return value of a called output routine
-    INTEGER, INTENT(OUT) ::  return_value         !< return value
-    INTEGER, INTENT(OUT) ::  variable_id          !< associated variable ID
-
-    LOGICAL, INTENT(IN)  ::  write_only_by_master_rank  !< true if only master rank shall write variable
-
-
-    return_value = 0
-    output_return_value = 0
-
-    temp_string = '(file "' // TRIM( file_name ) //                                                &
-                  '", dimension "' // TRIM( dimension_name ) // '")'
-
-    SELECT CASE ( TRIM( file_format ) )
-
-       CASE ( 'binary' )
-          CALL binary_init_dimension( 'binary', file_id, dimension_id, variable_id,                &
-                  dimension_name, dimension_type, dimension_length, write_only_by_master_rank,     &
-                  return_value=output_return_value )
-
-       CASE ( 'netcdf4-serial' )
-          CALL netcdf4_init_dimension( 'serial', file_id, dimension_id, variable_id,               &
-                  dimension_name, dimension_type, dimension_length, write_only_by_master_rank,     &
-                  return_value=output_return_value )
-
-       CASE ( 'netcdf4-parallel' )
-          CALL netcdf4_init_dimension( 'parallel', file_id, dimension_id, variable_id,             &
-                  dimension_name, dimension_type, dimension_length, write_only_by_master_rank,     &
-                  return_value=output_return_value )
-
-       CASE DEFAULT
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': file format "' // TRIM( file_format ) //                       &
-                                 '" not supported ' // TRIM( temp_string ) )
-
-    END SELECT
-
-    IF ( output_return_value /= 0 )  THEN
-       return_value = output_return_value
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': error while defining dimension ' // TRIM( temp_string ) )
-    ENDIF
-
- END SUBROUTINE init_file_dimension
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize variable.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_file_variable( file_format, file_id, file_name,                                   &
-                                variable_id, variable_name, variable_type, dimension_ids,          &
-                                write_only_by_master_rank, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_variable'  !< file format chosen for file
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_format    !< file format chosen for file
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name      !< file name
-    CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< name of variable
-    CHARACTER(LEN=*), INTENT(IN) ::  variable_type  !< data type of variable
-
-    INTEGER, INTENT(IN)  ::  file_id              !< file ID
-    INTEGER              ::  output_return_value  !< return value of a called output routine
-    INTEGER, INTENT(OUT) ::  return_value         !< return value
-    INTEGER, INTENT(OUT) ::  variable_id          !< variable ID
-
-    INTEGER, DIMENSION(:), INTENT(IN) ::  dimension_ids  !< list of dimension IDs used by variable
-
-    LOGICAL, INTENT(IN)  ::  write_only_by_master_rank  !< true if only master rank shall write variable
-
-
-    return_value = 0
-    output_return_value = 0
-
-    temp_string = '(file "' // TRIM( file_name ) //                                                &
-                  '", variable "' // TRIM( variable_name ) // '")'
-
-    SELECT CASE ( TRIM( file_format ) )
-
-       CASE ( 'binary' )
-          CALL binary_init_variable( 'binary', file_id, variable_id, variable_name,                &
-                  variable_type, dimension_ids, write_only_by_master_rank,                         &
-                  return_value=output_return_value )
-
-       CASE ( 'netcdf4-serial' )
-          CALL netcdf4_init_variable( 'serial', file_id, variable_id, variable_name,               &
-                  variable_type, dimension_ids, write_only_by_master_rank,                         &
-                  return_value=output_return_value )
-
-       CASE ( 'netcdf4-parallel' )
-          CALL netcdf4_init_variable( 'parallel', file_id, variable_id, variable_name,             &
-                  variable_type, dimension_ids, write_only_by_master_rank,                         &
-                  return_value=output_return_value )
-
-       CASE DEFAULT
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': file format "' // TRIM( file_format ) //                       &
-                                 '" not supported ' // TRIM( temp_string ) )
-
-    END SELECT
-
-    IF ( output_return_value /= 0 )  THEN
-       return_value = output_return_value
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': error while defining variable ' // TRIM( temp_string ) )
-    ENDIF
-
- END SUBROUTINE init_file_variable
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write attribute to file.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION write_attribute( file_format, file_id, file_name,                                        &
-                           variable_id, variable_name, attribute )                                 &
-             RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'write_attribute'  !< file format chosen for file
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_format    !< file format chosen for file
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name      !< file name
-    CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< variable name
-
-    INTEGER, INTENT(IN) ::  file_id              !< file ID
-    INTEGER             ::  return_value         !< return value
-    INTEGER             ::  output_return_value  !< return value of a called output routine
-    INTEGER, INTENT(IN) ::  variable_id          !< variable ID
-
-    TYPE(attribute_type), INTENT(IN) ::  attribute  !< attribute to be written
-
-
-    return_value = 0
-    output_return_value = 0
-!
-!-- Prepare for possible error message
-    temp_string = '(file "' // TRIM( file_name ) //                                                &
-                  '", variable "' // TRIM( variable_name ) //                                      &
-                  '", attribute "' // TRIM( attribute%name ) // '")'
-!
-!-- Write attribute to file
-    SELECT CASE ( TRIM( file_format ) )
-
-       CASE ( 'binary' )
-
-          SELECT CASE ( TRIM( attribute%data_type ) )
-
-             CASE( 'char' )
-                CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,             &
-                        attribute_name=attribute%name, value_char=attribute%value_char,            &
-                        return_value=output_return_value )
-
-             CASE( 'int8' )
-                CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,             &
-                        attribute_name=attribute%name, value_int8=attribute%value_int8,            &
-                        return_value=output_return_value )
-
-             CASE( 'int16' )
-                CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,             &
-                        attribute_name=attribute%name, value_int16=attribute%value_int16,          &
-                        return_value=output_return_value )
-
-             CASE( 'int32' )
-                CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,             &
-                        attribute_name=attribute%name, value_int32=attribute%value_int32,          &
-                        return_value=output_return_value )
-
-             CASE( 'real32' )
-                CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,             &
-                        attribute_name=attribute%name, value_real32=attribute%value_real32,        &
-                        return_value=output_return_value )
-
-             CASE( 'real64' )
-                CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,             &
-                        attribute_name=attribute%name, value_real64=attribute%value_real64,        &
-                        return_value=output_return_value )
-
-             CASE DEFAULT
-                return_value = 1
-                CALL internal_message( 'error', routine_name //                                    &
-                                       ': file format "' // TRIM( file_format ) //                 &
-                                       '" does not support attribute data type "'//                &
-                                       TRIM( attribute%data_type ) //                              &
-                                       '" ' // TRIM( temp_string ) )
-
-          END SELECT
-
-       CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
-
-          SELECT CASE ( TRIM( attribute%data_type ) )
-
-             CASE( 'char' )
-                CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id,               &
-                        variable_id=variable_id, attribute_name=attribute%name,                    &
-                        value_char=attribute%value_char, return_value=output_return_value )
-
-             CASE( 'int8' )
-                CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id,               &
-                        variable_id=variable_id, attribute_name=attribute%name,                    &
-                        value_int8=attribute%value_int8, return_value=output_return_value )
-
-             CASE( 'int16' )
-                CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id,               &
-                        variable_id=variable_id, attribute_name=attribute%name,                    &
-                        value_int16=attribute%value_int16, return_value=output_return_value )
-
-             CASE( 'int32' )
-                CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id,               &
-                        variable_id=variable_id, attribute_name=attribute%name,                    &
-                        value_int32=attribute%value_int32, return_value=output_return_value )
-
-             CASE( 'real32' )
-                CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id,               &
-                        variable_id=variable_id, attribute_name=attribute%name,                    &
-                        value_real32=attribute%value_real32, return_value=output_return_value )
-
-             CASE( 'real64' )
-                CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id,               &
-                        variable_id=variable_id, attribute_name=attribute%name,                    &
-                        value_real64=attribute%value_real64, return_value=output_return_value )
-
-             CASE DEFAULT
-                return_value = 1
-                CALL internal_message( 'error', routine_name //                                    &
-                                       ': file format "' // TRIM( file_format ) //                 &
-                                       '" does not support attribute data type "'//                &
-                                       TRIM( attribute%data_type ) //                              &
-                                       '" ' // TRIM( temp_string ) )
-
-          END SELECT
-
-       CASE DEFAULT
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': unsupported file format "' // TRIM( file_format ) //           &
-                                 '" ' // TRIM( temp_string ) )
-
-    END SELECT
-
-    IF ( output_return_value /= 0 )  THEN
-       return_value = output_return_value
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': error while writing attribute ' // TRIM( temp_string ) )
-    ENDIF
-
- END FUNCTION write_attribute
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Get dimension IDs and save them to variables.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE collect_dimesion_ids_for_variables( file_name, variables, dimensions, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'collect_dimesion_ids_for_variables'  !< file format chosen for file
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name  !< name of file
-
-    INTEGER              ::  d             !< loop index
-    INTEGER              ::  i             !< loop index
-    INTEGER              ::  j             !< loop index
-    INTEGER              ::  ndims         !< number of dimensions
-    INTEGER              ::  nvars         !< number of variables
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-
-    LOGICAL ::  found  !< true if dimension required by variable was found in dimension list
-
-    TYPE(dimension_type), DIMENSION(:), INTENT(IN) ::  dimensions  !< list of dimensions in file
-
-    TYPE(variable_type), DIMENSION(:), INTENT(INOUT) ::  variables  !< list of variables in file
-
-
-    return_value = 0
-    found = .FALSE.
-    ndims = SIZE( dimensions )
-    nvars = SIZE( variables )
-
-    DO  i = 1, nvars
-       DO  j = 1, SIZE( variables(i)%dimension_names )
-          found = .FALSE.
-          DO  d = 1, ndims
-             IF ( variables(i)%dimension_names(j) == dimensions(d)%name )  THEN
-                variables(i)%dimension_ids(j) = dimensions(d)%id
-                found = .TRUE.
-                EXIT
-             ENDIF
-          ENDDO
-          IF ( .NOT. found )  THEN
-             return_value = 1
-             CALL internal_message( 'error', routine_name //                                       &
-                     ': required dimension "' // TRIM( variables(i)%dimension_names(j) ) //        &
-                     '" is undefined (variable "' // TRIM( variables(i)%name ) //                  &
-                     '", file "' // TRIM( file_name ) // '")!' )
-             EXIT
-          ENDIF
-       ENDDO
-       IF ( .NOT. found )  EXIT
-    ENDDO
-
- END SUBROUTINE collect_dimesion_ids_for_variables
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Leave file definition/initialization.
-!>
-!> @todo Do we need an MPI barrier at the end?
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stop_file_header_definition( file_format, file_id, file_name, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'stop_file_header_definition'  !< name of routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< file name
-
-    INTEGER, INTENT(IN)  ::  file_id              !< file id
-    INTEGER              ::  output_return_value  !< return value of a called output routine
-    INTEGER, INTENT(OUT) ::  return_value         !< return value
-
-
-    return_value = 0
-    output_return_value = 0
-
-    temp_string = '(file "' // TRIM( file_name ) // '")'
-
-    SELECT CASE ( TRIM( file_format ) )
-
-       CASE ( 'binary' )
-          CALL binary_stop_file_header_definition( file_id, output_return_value )
-
-       CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
-          CALL netcdf4_stop_file_header_definition( file_format(9:), file_id, output_return_value )
-
-       CASE DEFAULT
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': file format "' // TRIM( file_format ) //                       &
-                                 '" not supported ' // TRIM( temp_string ) )
-
-    END SELECT
-
-    IF ( output_return_value /= 0 )  THEN
-       return_value = output_return_value
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': error while leaving file-definition state ' //                    &
-                              TRIM( temp_string ) )
-    ENDIF
-
-    ! CALL MPI_Barrier( MPI_COMM_WORLD, return_value )
-
- END SUBROUTINE stop_file_header_definition
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Find a requested variable 'variable_name' and its used dimensions in requested file 'file_name'.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE find_var_in_file( file_name, variable_name, file_format, file_id, variable_id,         &
-                              write_only_by_master_rank, dimensions, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'find_var_in_file'  !< name of routine
-
-    CHARACTER(LEN=charlen), INTENT(OUT) ::  file_format    !< file format chosen for file
-    CHARACTER(LEN=*),       INTENT(IN)  ::  file_name      !< name of file
-    CHARACTER(LEN=*),       INTENT(IN)  ::  variable_name  !< name of variable
-
-    INTEGER              ::  d             !< loop index
-    INTEGER              ::  dd            !< loop index
-    INTEGER              ::  f             !< loop index
-    INTEGER, INTENT(OUT) ::  file_id       !< file ID
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-    INTEGER, INTENT(OUT) ::  variable_id   !< variable ID
-
-    INTEGER, DIMENSION(:), ALLOCATABLE ::  dimension_ids  !< list of dimension IDs used by variable
-
-    LOGICAL              ::  found                      !< true if requested variable found in requested file
-    LOGICAL, INTENT(OUT) ::  write_only_by_master_rank  !< true if only master rank shall write variable
-
-    TYPE(dimension_type), DIMENSION(:), ALLOCATABLE, INTENT(OUT) ::  dimensions  !< list of dimensions used by variable
-
-
-    return_value = 0
-    found = .FALSE.
-
-    DO  f = 1, nfiles
-       IF ( TRIM( file_name ) == TRIM( files(f)%name ) )  THEN
-
-          IF ( .NOT. files(f)%is_init )  THEN
-             return_value = 1
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': file not initialized. ' //                                  &
-                                    'Writing variable to file is impossible ' //                   &
-                                    '(variable "' // TRIM( variable_name ) //                      &
-                                    '", file "' // TRIM( file_name ) // '")!' )
-             EXIT
-          ENDIF
-
-          file_id     = files(f)%id
-          file_format = files(f)%format
-!
-!--       Search for variable in file
-          DO  d = 1, SIZE( files(f)%variables )
-             IF ( TRIM( variable_name ) == TRIM( files(f)%variables(d)%name ) )  THEN
-
-                variable_id = files(f)%variables(d)%id
-                write_only_by_master_rank = files(f)%variables(d)%write_only_by_master_rank
-
-                ALLOCATE( dimension_ids(SIZE( files(f)%variables(d)%dimension_ids )) )
-                ALLOCATE( dimensions(SIZE( files(f)%variables(d)%dimension_ids )) )
-
-                dimension_ids = files(f)%variables(d)%dimension_ids
-
-                found = .TRUE.
-                EXIT
-
-             ENDIF
-          ENDDO
-
-          IF ( found )  THEN
-!
-!--          Get list of dimensions used by variable
-             DO  d = 1, SIZE( files(f)%dimensions )
-                DO  dd = 1, SIZE( dimension_ids )
-                   IF ( dimension_ids(dd) == files(f)%dimensions(d)%id )  THEN
-                      dimensions(dd) = files(f)%dimensions(d)
-                      EXIT
-                   ENDIF
-                ENDDO
-             ENDDO
-
-          ELSE
-!
-!--          If variable was not found, search for a dimension instead
-             DO  d = 1, SIZE( files(f)%dimensions )
-                IF ( TRIM( variable_name ) == TRIM( files(f)%dimensions(d)%name ) )  THEN
-
-                   variable_id = files(f)%dimensions(d)%variable_id
-                   write_only_by_master_rank = files(f)%dimensions(d)%write_only_by_master_rank
-
-                   ALLOCATE( dimensions(1) )
-
-                   dimensions(1) = files(f)%dimensions(d)
-
-                   found = .TRUE.
-                   EXIT
-
-                ENDIF
-             ENDDO
-
-          ENDIF
-!
-!--       If variable was not found in requested file, return an error
-          IF ( .NOT. found )  THEN
-             return_value = 1
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': variable not found in file ' //                             &
-                                    '(variable "' // TRIM( variable_name ) //                      &
-                                    '", file "' // TRIM( file_name ) // '")!' )
-          ENDIF
-
-          EXIT
-
-       ENDIF  ! file found
-    ENDDO  ! loop over files
-
-    IF ( .NOT. found  .AND.  return_value == 0 )  THEN
-       return_value = 1
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': file not found ' //                                               &
-                              '(variable "' // TRIM( variable_name ) //                            &
-                              '", file "' // TRIM( file_name ) // '")!' )
-    ENDIF
-
- END SUBROUTINE find_var_in_file
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Search for masked indices of dimensions within the given bounds ('bounds_start' and
-!> 'bounds_end'). Return the masked indices ('masked_indices') of the dimensions, the first index
-!> of the masked dimensions containing these indices ('bounds_masked_start'), the count of masked
-!> indices within given bounds ('value_counts') and the origin index of each dimension
-!> ('bounds_origin'). If, for any dimension, no masked index lies within the given bounds, counts,
-!> starts and origins are set to zero for all dimensions.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_masked_indices_and_masked_dimension_bounds(                                        &
-               dimensions, bounds_start, bounds_end, bounds_masked_start, value_counts,            &
-               bounds_origin, masked_indices )
-
-    ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'get_masked_indices_and_masked_dimension_bounds'  !< name of routine
-
-    INTEGER ::  d  !< loop index
-    INTEGER ::  i  !< loop index
-
-    INTEGER, DIMENSION(:), INTENT(IN)  ::  bounds_end           !< upper bonuds to be searched in
-    INTEGER, DIMENSION(:), INTENT(OUT) ::  bounds_masked_start  !< lower bounds of masked dimensions within given bounds
-    INTEGER, DIMENSION(:), INTENT(OUT) ::  bounds_origin        !< first index of each dimension, 0 if dimension is masked
-    INTEGER, DIMENSION(:), INTENT(IN)  ::  bounds_start         !< lower bounds to be searched in
-    INTEGER, DIMENSION(:), INTENT(OUT) ::  value_counts         !< count of indices per dimension to be output
-
-    INTEGER, DIMENSION(:,:), ALLOCATABLE, INTENT(OUT) ::  masked_indices  !< masked indices within given bounds
-
-    TYPE(dimension_type), DIMENSION(:), INTENT(IN) ::  dimensions  !< dimensions to be searched for masked indices
-
-
-    ALLOCATE( masked_indices(SIZE( dimensions ),0:MAXVAL( bounds_end - bounds_start + 1 )) )
-    masked_indices = -HUGE( 0 )
-!
-!-- Check for masking and update lower and upper bounds if masked
-    DO  d = 1, SIZE( dimensions )
-
-       IF ( dimensions(d)%is_masked )  THEN
-
-          bounds_origin(d) = 0
-
-          bounds_masked_start(d) = -HUGE( 0 )
-!
-!--       Find number of masked values within given variable bounds
-          value_counts(d) = 0
-          DO  i = LBOUND( dimensions(d)%masked_indices, DIM=1 ),                                   &
-                  UBOUND( dimensions(d)%masked_indices, DIM=1 )
-!
-!--          Is masked index within given bounds?
-             IF ( dimensions(d)%masked_indices(i) >= bounds_start(d)  .AND.                        &
-                  dimensions(d)%masked_indices(i) <= bounds_end(d)           )  THEN
-!
-!--             Save masked index
-                masked_indices(d,value_counts(d)) = dimensions(d)%masked_indices(i)
-                value_counts(d) = value_counts(d) + 1
-!
-!--             Save bounds of mask within given bounds
-                IF ( bounds_masked_start(d) == -HUGE( 0 ) )  bounds_masked_start(d) = i
-
-             ENDIF
-
-          ENDDO
-!
-!--       Set masked bounds to zero if no masked index lies within bounds
-          IF ( value_counts(d) == 0 )  THEN
-             bounds_origin(:) = 0
-             bounds_masked_start(:) = 0
-             value_counts(:) = 0
-             EXIT
-          ENDIF
-
-       ELSE
-!
-!--       If dimension is not masked, save all indices within bounds for output
-          bounds_origin(d) = dimensions(d)%bounds(1)
-          bounds_masked_start(d) = bounds_start(d)
-          value_counts(d) = bounds_end(d) - bounds_start(d) + 1
-
-          DO  i = 0, value_counts(d) - 1
-             masked_indices(d,i) = bounds_start(d) + i
-          ENDDO
-
-       ENDIF
-
-    ENDDO
-
- END SUBROUTINE get_masked_indices_and_masked_dimension_bounds
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Message routine writing debug information into the debug file or creating the error message
-!> string.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE internal_message( level, string )
-
-    CHARACTER(LEN=*), INTENT(IN) ::  level   !< message importance level
-    CHARACTER(LEN=*), INTENT(IN) ::  string  !< message string
-
-
-    IF ( TRIM( level ) == 'error' )  THEN
-
-       WRITE( internal_error_message, '(A,A)' ) 'DOM ERROR: ', string
-
-    ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
-
-       WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
-       FLUSH( debug_output_unit )
-
-    ENDIF
-
- END SUBROUTINE internal_message
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Print contents of the created database to debug_output_unit. This routine can be called at any
-!> stage after the call to 'dom_init'. Multiple calls are possible.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dom_database_debug_output
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_database_debug_output'  !< name of this routine
-    CHARACTER(LEN=*), PARAMETER ::  separation_string = '---'                   !< string separating blocks in output
-
-    INTEGER, PARAMETER ::  indent_depth = 3        !< space per indentation
-    INTEGER, PARAMETER ::  max_keyname_length = 8  !< length of longest key name
-
-    CHARACTER(LEN=50) ::  write_format1  !< format for write statements
-
-    INTEGER ::  f             !< loop index
-    INTEGER ::  indent_level  !< indentation level
-    INTEGER ::  natts         !< number of attributes
-    INTEGER ::  ndims         !< number of dimensions
-    INTEGER ::  nvars         !< number of variables
-
-
-    CALL internal_message( 'debug', routine_name // ': write database to debug output' )
-
-    WRITE( debug_output_unit, '(A)' ) 'DOM database:'
-    WRITE( debug_output_unit, '(A)' ) REPEAT( separation_string // ' ', 4 )
-
-    IF ( .NOT. ALLOCATED( files )  .OR.  nfiles == 0 )  THEN
-
-       WRITE( debug_output_unit, '(A)' ) 'database is empty'
-
-    ELSE
-
-       indent_level = 1
-       WRITE( write_format1, '(A,I3,A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A,T',      &
-                                             indent_level * indent_depth + 1 + max_keyname_length, &
-                                             ',(": ")'
-
-       DO  f = 1, nfiles
-
-          natts = 0
-          ndims = 0
-          nvars = 0
-          IF ( ALLOCATED( files(f)%attributes ) ) natts = SIZE( files(f)%attributes )
-          IF ( ALLOCATED( files(f)%dimensions ) ) ndims = SIZE( files(f)%dimensions )
-          IF ( ALLOCATED( files(f)%variables  ) ) nvars = SIZE( files(f)%variables  )
-
-          WRITE( debug_output_unit, '(A)' ) 'file:'
-          WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) 'name', TRIM( files(f)%name )
-          WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) 'format', TRIM(files(f)%format)
-          WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) 'id', files(f)%id
-          WRITE( debug_output_unit, TRIM( write_format1 ) // ',L1)' ) 'is init', files(f)%is_init
-          WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) '#atts', natts
-          WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) '#dims', ndims
-          WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) '#vars', nvars
-
-          IF ( natts /= 0 )  CALL print_attributes( indent_level, files(f)%attributes )
-          IF ( ndims /= 0 )  CALL print_dimensions( indent_level, files(f)%dimensions )
-          IF ( nvars /= 0 )  CALL print_variables( indent_level, files(f)%variables )
-
-          WRITE( debug_output_unit, '(/A/)' ) REPEAT( separation_string // ' ', 4 )
-
-       ENDDO
-
-    ENDIF
-
-    CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Print list of attributes.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE print_attributes( indent_level, attributes )
-
-       INTEGER, PARAMETER ::  max_keyname_length = 6  !< length of longest key name
-
-       CHARACTER(LEN=50) ::  write_format1  !< format for write statements
-       CHARACTER(LEN=50) ::  write_format2  !< format for write statements
-
-       INTEGER             ::  i             !< loop index
-       INTEGER, INTENT(IN) ::  indent_level  !< indentation level
-       INTEGER             ::  nelement      !< number of elements to print
-
-       TYPE(attribute_type), DIMENSION(:), INTENT(IN) ::  attributes  !< list of attributes
-
-
-       WRITE( write_format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
-       WRITE( write_format2, '(A,I3,A,I3,A)' )                                                     &
-          '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T',                                   &
-          ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
-
-       WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' )                                  &
-          REPEAT( separation_string // ' ', 4 )
-       WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) 'attributes:'
-
-       nelement = SIZE( attributes )
-       DO  i = 1, nelement
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' )                               &
-             'name', TRIM( attributes(i)%name )
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' )                               &
-             'type', TRIM( attributes(i)%data_type )
-
-          IF ( TRIM( attributes(i)%data_type ) == 'char' )  THEN
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' )                            &
-                'value', TRIM( attributes(i)%value_char )
-          ELSEIF ( TRIM( attributes(i)%data_type ) == 'int8' )  THEN
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',I4)' )                           &
-                'value', attributes(i)%value_int8
-          ELSEIF ( TRIM( attributes(i)%data_type ) == 'int16' )  THEN
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)' )                           &
-                'value', attributes(i)%value_int16
-          ELSEIF ( TRIM( attributes(i)%data_type ) == 'int32' )  THEN
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)' )                          &
-                'value', attributes(i)%value_int32
-          ELSEIF ( TRIM( attributes(i)%data_type ) == 'real32' )  THEN
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',E14.7)' )                        &
-                'value', attributes(i)%value_real32
-          ELSEIF (  TRIM(attributes(i)%data_type) == 'real64' )  THEN
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)' )                       &
-                'value', attributes(i)%value_real64
-          ENDIF
-          IF ( i < nelement )                                                                      &
-             WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) separation_string
-       ENDDO
-
-    END SUBROUTINE print_attributes
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Print list of dimensions.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE print_dimensions( indent_level, dimensions )
-
-       INTEGER, PARAMETER ::  max_keyname_length = 26  !< length of longest key name
-
-       CHARACTER(LEN=50) ::  write_format1  !< format for write statements
-       CHARACTER(LEN=50) ::  write_format2  !< format for write statements
-
-       INTEGER             ::  i             !< loop index
-       INTEGER, INTENT(IN) ::  indent_level  !< indentation level
-       INTEGER             ::  j             !< loop index
-       INTEGER             ::  nelement      !< number of elements to print
-
-       LOGICAL ::  is_masked  !< true if dimension is masked
-
-       TYPE(dimension_type), DIMENSION(:), INTENT(IN) ::  dimensions  !< list of dimensions
-
-
-       WRITE( write_format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
-       WRITE( write_format2, '(A,I3,A,I3,A)' )                                                     &
-          '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T',                                   &
-          ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
-
-       WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' )                                  &
-          REPEAT( separation_string // ' ', 4 )
-       WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) 'dimensions:'
-
-       nelement = SIZE( dimensions )
-       DO  i = 1, nelement
-          is_masked = dimensions(i)%is_masked
-!
-!--       Print general information
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' )                               &
-             'name', TRIM( dimensions(i)%name )
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' )                               &
-             'type', TRIM( dimensions(i)%data_type )
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' )                              &
-             'id', dimensions(i)%id
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)' )                              &
-             'write only by master rank', dimensions(i)%write_only_by_master_rank
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' )                              &
-             'length', dimensions(i)%length
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7,A,I7)' )                         &
-             'bounds', dimensions(i)%bounds(1), ',', dimensions(i)%bounds(2)
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)' )                              &
-             'is masked', dimensions(i)%is_masked
-!
-!--       Print information about mask
-          IF ( is_masked )  THEN
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' )                           &
-                'masked length', dimensions(i)%length_mask
-
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)', ADVANCE='no' )             &
-                'mask', dimensions(i)%mask(dimensions(i)%bounds(1))
-             DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
-                WRITE( debug_output_unit, '(A,L1)', ADVANCE='no' ) ',', dimensions(i)%mask(j)
-             ENDDO
-             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)', ADVANCE='no' )             &
-                'masked indices', dimensions(i)%masked_indices(0)
-             DO  j = 1, dimensions(i)%length_mask-1
-                WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' )                                 &
-                   ',', dimensions(i)%masked_indices(j)
-             ENDDO
-             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-          ENDIF
-!
-!--       Print saved values
-          IF ( ALLOCATED( dimensions(i)%values_int8 ) )  THEN
-
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',I4)', ADVANCE='no' )             &
-                'values', dimensions(i)%values_int8(dimensions(i)%bounds(1))
-             DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
-                WRITE( debug_output_unit, '(A,I4)', ADVANCE='no' )                                 &
-                   ',', dimensions(i)%values_int8(j)
-             ENDDO
-             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             IF ( is_masked )  THEN
-                WRITE( debug_output_unit, TRIM( write_format2 ) // ',I4)', ADVANCE='no' )          &
-                   'masked values', dimensions(i)%masked_values_int8(0)
-                DO  j = 1, dimensions(i)%length_mask-1
-                   WRITE( debug_output_unit, '(A,I4)', ADVANCE='no' )                              &
-                      ',', dimensions(i)%masked_values_int8(j)
-                ENDDO
-                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             ENDIF
-
-          ELSEIF ( ALLOCATED( dimensions(i)%values_int16 ) )  THEN
-
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)', ADVANCE='no' )             &
-                'values', dimensions(i)%values_int16(dimensions(i)%bounds(1))
-             DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
-                WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' )                                 &
-                   ',', dimensions(i)%values_int16(j)
-             ENDDO
-             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             IF ( is_masked )  THEN
-                WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)', ADVANCE='no' )          &
-                   'masked values', dimensions(i)%masked_values_int16(0)
-                DO  j = 1, dimensions(i)%length_mask-1
-                   WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' )                              &
-                      ',', dimensions(i)%masked_values_int16(j)
-                ENDDO
-                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             ENDIF
-
-          ELSEIF ( ALLOCATED( dimensions(i)%values_int32 ) )  THEN
-
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' )            &
-                'values', dimensions(i)%values_int32(dimensions(i)%bounds(1))
-             DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
-                WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' )                                &
-                   ',', dimensions(i)%values_int32(j)
-             ENDDO
-             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             IF ( is_masked )  THEN
-                WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' )         &
-                   'masked values', dimensions(i)%masked_values_int32(0)
-                DO  j = 1, dimensions(i)%length_mask-1
-                   WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' )                             &
-                      ',', dimensions(i)%masked_values_int32(j)
-                ENDDO
-                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             ENDIF
-
-          ELSEIF ( ALLOCATED( dimensions(i)%values_intwp ) )  THEN
-
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' )            &
-                'values', dimensions(i)%values_intwp(dimensions(i)%bounds(1))
-             DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
-                WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' )                                &
-                   ',', dimensions(i)%values_intwp(j)
-             ENDDO
-             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             IF ( is_masked )  THEN
-                WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' )         &
-                   'masked values', dimensions(i)%masked_values_intwp(0)
-                DO  j = 1, dimensions(i)%length_mask-1
-                   WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' )                             &
-                      ',', dimensions(i)%masked_values_intwp(j)
-                ENDDO
-                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             ENDIF
-
-          ELSEIF ( ALLOCATED( dimensions(i)%values_real32 ) )  THEN
-
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',E14.7)', ADVANCE='no' )          &
-                'values', dimensions(i)%values_real32(dimensions(i)%bounds(1))
-             DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
-                WRITE( debug_output_unit, '(A,E14.7)', ADVANCE='no' )                              &
-                   ',', dimensions(i)%values_real32(j)
-             ENDDO
-             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             IF ( is_masked )  THEN
-                WRITE( debug_output_unit, TRIM( write_format2 ) // ',E14.7)', ADVANCE='no' )       &
-                   'masked values', dimensions(i)%masked_values_real32(0)
-                DO  j = 1, dimensions(i)%length_mask-1
-                   WRITE( debug_output_unit, '(A,E14.7)', ADVANCE='no' )                           &
-                      ',', dimensions(i)%masked_values_real32(j)
-                ENDDO
-                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             ENDIF
-
-          ELSEIF ( ALLOCATED( dimensions(i)%values_real64 ) )  THEN
-
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' )         &
-                'values', dimensions(i)%values_real64(dimensions(i)%bounds(1))
-             DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
-                WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' )                             &
-                   ',', dimensions(i)%values_real64(j)
-             ENDDO
-             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             IF ( is_masked )  THEN
-                WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' )      &
-                   'masked values', dimensions(i)%masked_values_real64(0)
-                DO  j = 1, dimensions(i)%length_mask-1
-                   WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' )                          &
-                      ',', dimensions(i)%masked_values_real64(j)
-                ENDDO
-                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             ENDIF
-
-          ELSEIF ( ALLOCATED( dimensions(i)%values_realwp ) )  THEN
-
-             WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' )         &
-                'values', dimensions(i)%values_realwp(dimensions(i)%bounds(1))
-             DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
-                WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' )                             &
-                   ',', dimensions(i)%values_realwp(j)
-             ENDDO
-             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             IF ( is_masked )  THEN
-                WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' )      &
-                   'masked values', dimensions(i)%masked_values_realwp(0)
-                DO  j = 1, dimensions(i)%length_mask-1
-                   WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' )                          &
-                      ',', dimensions(i)%masked_values_realwp(j)
-                ENDDO
-                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-             ENDIF
-
-          ENDIF
-
-          IF ( ALLOCATED( dimensions(i)%attributes ) )                                             &
-             CALL print_attributes( indent_level+1, dimensions(i)%attributes )
-
-          IF ( i < nelement )                                                                      &
-             WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) separation_string
-       ENDDO
-
-    END SUBROUTINE print_dimensions
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Print list of variables.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE print_variables( indent_level, variables )
-
-       INTEGER, PARAMETER ::  max_keyname_length = 26  !< length of longest key name
-
-       CHARACTER(LEN=50) ::  write_format1  !< format for write statements
-       CHARACTER(LEN=50) ::  write_format2  !< format for write statements
-
-       INTEGER             ::  i             !< loop index
-       INTEGER, INTENT(IN) ::  indent_level  !< indentation level
-       INTEGER             ::  j             !< loop index
-       INTEGER             ::  nelement      !< number of elements to print
-
-       TYPE(variable_type), DIMENSION(:), INTENT(IN) ::  variables  !< list of variables
-
-
-       WRITE( write_format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
-       WRITE( write_format2, '(A,I3,A,I3,A)' )                                                     &
-          '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T',                                   &
-          ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
-
-       WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' )                                  &
-          REPEAT( separation_string // ' ', 4 )
-       WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) 'variables:'
-
-       nelement = SIZE( variables )
-       DO  i = 1, nelement
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' )                               &
-             'name', TRIM( variables(i)%name )
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' )                               &
-             'type', TRIM( variables(i)%data_type )
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' )                              &
-             'id', variables(i)%id
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)' )                              &
-             'write only by master rank', variables(i)%write_only_by_master_rank
-
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)', ADVANCE='no' )                 &
-             'dimension names', TRIM( variables(i)%dimension_names(1) )
-          DO  j = 2, SIZE( variables(i)%dimension_names )
-             WRITE( debug_output_unit, '(A,A)', ADVANCE='no' )                                     &
-                ',', TRIM( variables(i)%dimension_names(j) )
-          ENDDO
-          WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-
-          WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)', ADVANCE='no' )                &
-             'dimension ids', variables(i)%dimension_ids(1)
-          DO  j = 2, SIZE( variables(i)%dimension_names )
-             WRITE( debug_output_unit, '(A,I7)', ADVANCE='no' )                                    &
-                ',', variables(i)%dimension_ids(j)
-          ENDDO
-          WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
-
-          IF ( ALLOCATED( variables(i)%attributes ) )                                              &
-             CALL print_attributes( indent_level+1, variables(i)%attributes )
-          IF ( i < nelement )                                                                      &
-             WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) separation_string
-       ENDDO
-
-    END SUBROUTINE print_variables
-
- END SUBROUTINE dom_database_debug_output
-
- END MODULE data_output_module
Index: palm/trunk/SOURCE/data_output_netcdf4_module.f90
===================================================================
--- palm/trunk/SOURCE/data_output_netcdf4_module.f90	(revision 4901)
+++ 	(revision )
@@ -1,1063 +1,0 @@
-!> @file data_output_netcdf4_module.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2019-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4599 2020-07-10 12:42:02Z gronemeier
-! bugfix: set no-fill mode per variable
-!
-! 4597 2020-07-09 19:21:53Z gronemeier
-! bugfix: - allow writing of unlimited dimensions in parallel mode
-!         - prevent unused-variable warning if preprocessor directives are not given
-! change: - set parallel access mode to independent per default
-! new   : - dimension variables can be written by every PE
-!
-! 4579 2020-06-25 20:05:07Z gronemeier
-! corrected formatting to follow PALM coding standard
-!
-! 4577 2020-06-25 09:53:58Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! bugfix: cpp-directive moved to avoid compile error due to unused dummy argument
-!
-! 4408 2020-02-14 10:04:39Z gronemeier
-! Enable character-array output
-!
-! 4232 2019-09-20 09:34:22Z knoop
-! Bugfix: INCLUDE "mpif.h" must be placed after IMPLICIT NONE statement
-!
-! 4147 2019-08-07 09:42:31Z gronemeier
-! corrected indentation according to coding standard
-!
-! 4141 2019-08-05 12:24:51Z gronemeier
-! Initial revision
-!
-!
-! Authors:
-! --------
-!> @author: Tobias Gronemeier
-!
-! Description:
-! ------------
-!> NetCDF output module to write data to NetCDF files.
-!> This is either done in parallel mode via parallel NetCDF4 I/O or in serial mode only by PE0.
-!>
-!> @bug 'mode' is not always checked. If a routine is called with an unknown mode (e.g. a typo),
-!>      this does not throw any error.
-!--------------------------------------------------------------------------------------------------!
- MODULE data_output_netcdf4_module
-
-    USE kinds
-
-#if defined( __parallel )
-    USE MPI
-#endif
-
-#if defined( __netcdf4 )
-    USE NETCDF
-#endif
-
-    IMPLICIT NONE
-
-
-    CHARACTER(LEN=*), PARAMETER ::  mode_parallel = 'parallel'  !< string selecting netcdf4 parallel mode
-    CHARACTER(LEN=*), PARAMETER ::  mode_serial   = 'serial'    !< string selecting netcdf4 serial mode
-
-    CHARACTER(LEN=100) ::  file_suffix = ''             !< file suffix added to each file name
-    CHARACTER(LEN=800) ::  internal_error_message = ''  !< string containing the last error message
-    CHARACTER(LEN=800) ::  temp_string                  !< dummy string
-
-    INTEGER ::  debug_output_unit       !< Fortran Unit Number of the debug-output file
-    INTEGER ::  global_id_in_file = -1  !< value of global ID within a file
-    INTEGER ::  master_rank             !< master rank for tasks to be executed by single PE only
-    INTEGER ::  my_rank                 !< MPI rank of processor
-    INTEGER ::  output_group_comm       !< MPI communicator addressing all MPI ranks which participate in output
-
-    LOGICAL ::  print_debug_output = .FALSE.  !< if true, debug output is printed
-
-    SAVE
-
-    PRIVATE
-
-    INTERFACE netcdf4_init_module
-       MODULE PROCEDURE netcdf4_init_module
-    END INTERFACE netcdf4_init_module
-
-    INTERFACE netcdf4_open_file
-       MODULE PROCEDURE netcdf4_open_file
-    END INTERFACE netcdf4_open_file
-
-    INTERFACE netcdf4_init_dimension
-       MODULE PROCEDURE netcdf4_init_dimension
-    END INTERFACE netcdf4_init_dimension
-
-    INTERFACE netcdf4_init_variable
-       MODULE PROCEDURE netcdf4_init_variable
-    END INTERFACE netcdf4_init_variable
-
-    INTERFACE netcdf4_write_attribute
-       MODULE PROCEDURE netcdf4_write_attribute
-    END INTERFACE netcdf4_write_attribute
-
-    INTERFACE netcdf4_stop_file_header_definition
-       MODULE PROCEDURE netcdf4_stop_file_header_definition
-    END INTERFACE netcdf4_stop_file_header_definition
-
-    INTERFACE netcdf4_write_variable
-       MODULE PROCEDURE netcdf4_write_variable
-    END INTERFACE netcdf4_write_variable
-
-    INTERFACE netcdf4_finalize
-       MODULE PROCEDURE netcdf4_finalize
-    END INTERFACE netcdf4_finalize
-
-    INTERFACE netcdf4_get_error_message
-       MODULE PROCEDURE netcdf4_get_error_message
-    END INTERFACE netcdf4_get_error_message
-
-    PUBLIC                                                                                         &
-       netcdf4_finalize,                                                                           &
-       netcdf4_get_error_message,                                                                  &
-       netcdf4_init_dimension,                                                                     &
-       netcdf4_init_module,                                                                        &
-       netcdf4_init_variable,                                                                      &
-       netcdf4_open_file,                                                                          &
-       netcdf4_stop_file_header_definition,                                                        &
-       netcdf4_write_attribute,                                                                    &
-       netcdf4_write_variable
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize data-output module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf4_init_module( file_suffix_of_output_group, mpi_comm_of_output_group,            &
-                                 master_output_rank,                                               &
-                                 program_debug_output_unit, debug_output, dom_global_id )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_module'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_suffix_of_output_group  !> file-name suffix added to each file;
-                                                                  !> must be unique for each output group
-
-    INTEGER, INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
-    INTEGER, INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
-    INTEGER, INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
-    INTEGER, INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
-    INTEGER             ::  return_value               !< return value
-
-    LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed
-
-
-    file_suffix = file_suffix_of_output_group
-    output_group_comm = mpi_comm_of_output_group
-    master_rank = master_output_rank
-
-#if defined( __parallel )
-    CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
-    IF ( return_value /= 0 )  THEN
-       CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
-    ENDIF
-#else
-    my_rank = master_rank
-    return_value = 0
-!
-!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
-    IF ( .FALSE. )  CALL internal_message( 'debug', routine_name // ': dummy message' )
-#endif
-
-    debug_output_unit = program_debug_output_unit
-    print_debug_output = debug_output
-
-    global_id_in_file = dom_global_id
-
- END SUBROUTINE netcdf4_init_module
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Open netcdf file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf4_open_file( mode, file_name, file_id, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_open_file'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name  !< name of file
-    CHARACTER(LEN=*), INTENT(IN) ::  mode       !< operation mode (either parallel or serial)
-
-    INTEGER, INTENT(OUT) ::  file_id       !< file ID
-    INTEGER              ::  nc_stat       !< netcdf return value
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-
-
-    return_value = 0
-    file_id = -1
-!
-!-- Open new file
-    CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( file_name ) // '"' )
-
-    IF ( TRIM( mode ) == mode_serial )  THEN
-
-#if defined( __netcdf4 )
-
-       IF ( return_value == 0 )  THEN
-          IF ( my_rank == master_rank )  THEN
-             nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ),                      &
-                                    IOR( NF90_NOCLOBBER, NF90_NETCDF4 ),                           &
-                                    file_id )
-          ELSE
-             nc_stat = 0
-          ENDIF
-       ENDIF
-#else
-       nc_stat = 0
-       return_value = 1
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': pre-processor directive "__netcdf4" not given. ' //               &
-                              'Using NetCDF4 output not possible' )
-#endif
-
-    ELSEIF ( TRIM( mode ) == mode_parallel )  THEN
-
-#if defined( __parallel ) && defined( __netcdf4 ) && defined( __netcdf4_parallel )
-       nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ),                            &
-                              IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ),              &
-                              file_id, COMM = output_group_comm, INFO = MPI_INFO_NULL )
-#else
-       nc_stat = 0
-       return_value = 1
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': pre-processor directives "__parallel" and/or ' //                 &
-                              '"__netcdf4" and/or "__netcdf4_parallel" not given. ' //             &
-                              'Using parallel NetCDF4 output not possible' )
-#endif
-
-    ELSE
-       nc_stat = 0
-       return_value = 1
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': selected mode "' // TRIM( mode ) // '" must be either "' //       &
-                              mode_serial // '" or "' // mode_parallel // '"' )
-    ENDIF
-
-#if defined( __netcdf4 )
-    IF ( nc_stat /= NF90_NOERR  .AND.  return_value == 0 )  THEN
-       return_value = 1
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': NetCDF error while opening file "' //                             &
-                              TRIM( file_name ) // '": ' // NF90_STRERROR( nc_stat ) )
-    ENDIF
-#endif
-
- END SUBROUTINE netcdf4_open_file
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write attribute to netcdf file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf4_write_attribute( mode, file_id, variable_id, attribute_name,                   &
-                                     value_char, value_int8, value_int16, value_int32,             &
-                                     value_real32, value_real64, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_write_attribute'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN)           ::  attribute_name  !< name of attribute
-    CHARACTER(LEN=*), INTENT(IN)           ::  mode            !< operation mode (either parallel or serial)
-    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  value_char      !< value of attribute
-
-    INTEGER, INTENT(IN)  ::  file_id       !< file ID
-    INTEGER              ::  nc_stat       !< netcdf return value
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-    INTEGER              ::  target_id     !< ID of target which gets attribute (either global or variable_id)
-    INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
-
-    INTEGER(KIND=1), INTENT(IN), OPTIONAL ::  value_int8   !< value of attribute
-    INTEGER(KIND=2), INTENT(IN), OPTIONAL ::  value_int16  !< value of attribute
-    INTEGER(KIND=4), INTENT(IN), OPTIONAL ::  value_int32  !< value of attribute
-
-    REAL(KIND=4), INTENT(IN), OPTIONAL ::  value_real32  !< value of attribute
-    REAL(KIND=8), INTENT(IN), OPTIONAL ::  value_real64  !< value of attribute
-
-
-#if defined( __netcdf4 )
-    return_value = 0
-
-    IF ( .NOT. ( TRIM( mode ) == mode_serial  .AND.  my_rank /= master_rank ) )  THEN
-
-       IF ( variable_id == global_id_in_file )  THEN
-          target_id = NF90_GLOBAL
-       ELSE
-          target_id = variable_id
-       ENDIF
-
-       CALL internal_message( 'debug', routine_name //                                             &
-                              ': write attribute "' // TRIM( attribute_name ) // '"' )
-
-       IF ( PRESENT( value_char ) )  THEN
-          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), TRIM( value_char ) )
-       ELSEIF ( PRESENT( value_int8 ) )  THEN
-          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int8 )
-       ELSEIF ( PRESENT( value_int16 ) )  THEN
-          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int16 )
-       ELSEIF ( PRESENT( value_int32 ) )  THEN
-          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int32 )
-       ELSEIF ( PRESENT( value_real32 ) )  THEN
-          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real32 )
-       ELSEIF ( PRESENT( value_real64 ) )  THEN
-          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real64 )
-       ELSE
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': no value given for attribute "' // TRIM( attribute_name ) //   &
-                                 '"' )
-       ENDIF
-
-       IF ( return_value == 0 )  THEN
-          IF ( nc_stat /= NF90_NOERR )  THEN
-             return_value = 1
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': NetCDF error while writing attribute "' //                  &
-                                    TRIM( attribute_name ) // '": ' // NF90_STRERROR( nc_stat ) )
-          ENDIF
-       ENDIF
-
-    ENDIF
-#else
-    return_value = 1
-!
-!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
-    IF ( .FALSE. )  THEN
-       nc_stat = LEN( routine_name )
-       target_id = 0
-    ENDIF
-#endif
-
- END SUBROUTINE netcdf4_write_attribute
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize dimension.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id,                      &
-                                    dimension_name, dimension_type, dimension_length,              &
-                                    write_only_by_master_rank, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_dimension'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  dimension_name  !< name of dimension
-    CHARACTER(LEN=*), INTENT(IN) ::  dimension_type  !< data type of dimension
-    CHARACTER(LEN=*), INTENT(IN) ::  mode            !< operation mode (either parallel or serial)
-
-    INTEGER, INTENT(OUT) ::  dimension_id         !< dimension ID
-    INTEGER, INTENT(IN)  ::  dimension_length     !< length of dimension
-    INTEGER, INTENT(IN)  ::  file_id              !< file ID
-    INTEGER              ::  nc_dimension_length  !< length of dimension
-    INTEGER              ::  nc_stat              !< netcdf return value
-    INTEGER, INTENT(OUT) ::  return_value         !< return value
-    INTEGER, INTENT(OUT) ::  variable_id          !< variable ID
-
-    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
-
-
-#if defined( __netcdf4 )
-    return_value = 0
-    variable_id = -1
-    dimension_id = -1
-
-    IF ( .NOT. ( TRIM( mode ) == mode_serial  .AND.  my_rank /= master_rank ) )  THEN
-
-       CALL internal_message( 'debug', routine_name //                                             &
-                              ': init dimension "' // TRIM( dimension_name ) // '"' )
-!
-!--    Check if dimension is unlimited
-       IF ( dimension_length < 0 )  THEN
-          nc_dimension_length = NF90_UNLIMITED
-       ELSE
-          nc_dimension_length = dimension_length
-       ENDIF
-!
-!--    Define dimension in file
-       nc_stat = NF90_DEF_DIM( file_id, dimension_name, nc_dimension_length, dimension_id )
-
-       IF ( nc_stat == NF90_NOERR )  THEN
-!
-!--       Define variable holding dimension values in file
-          CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type,  &
-                                      (/ dimension_id /),                                          &
-                                      write_only_by_master_rank=write_only_by_master_rank,         &
-                                      return_value=return_value )
-
-       ELSE
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': NetCDF error while initializing dimension "' //                &
-                                 TRIM( dimension_name ) // '": ' // NF90_STRERROR( nc_stat ) )
-       ENDIF
-
-    ENDIF
-#else
-    return_value = 1
-    variable_id = -1
-    dimension_id = -1
-!
-!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
-    IF ( .FALSE. )  THEN
-       nc_stat = LEN( routine_name )
-       nc_dimension_length = 0
-    ENDIF
-#endif
-
- END SUBROUTINE netcdf4_init_dimension
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize variable.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf4_init_variable( mode, file_id, variable_id, variable_name, variable_type,       &
-                                   dimension_ids, write_only_by_master_rank, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_variable'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  mode           !< operation mode (either parallel or serial)
-    CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< name of variable
-    CHARACTER(LEN=*), INTENT(IN) ::  variable_type  !< data type of variable
-
-    INTEGER, INTENT(IN)  ::  file_id                 !< file ID
-    INTEGER              ::  nc_stat                 !< netcdf return value
-    INTEGER              ::  nc_variable_type        !< netcdf data type
-    INTEGER, INTENT(OUT) ::  return_value            !< return value
-    INTEGER, INTENT(OUT) ::  variable_id             !< variable ID
-#if defined( __netcdf4_parallel )
-    INTEGER              ::  parallel_access_mode    !< either NF90_INDEPENDENT or NF90_COLLECTIVE
-    INTEGER              ::  unlimited_dimension_id  !< ID of unlimited dimension in file
-#endif
-    INTEGER, DIMENSION(:), INTENT(IN) ::  dimension_ids  !< list of dimension IDs used by variable
-
-    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
-
-
-#if defined( __netcdf4 )
-    return_value = 0
-    variable_id = -1
-
-    IF ( ( TRIM( mode ) == mode_serial  .AND.  my_rank == master_rank )                            &
-         .OR.  TRIM( mode ) == mode_parallel )  THEN
-
-       WRITE( temp_string, * ) write_only_by_master_rank
-       CALL internal_message( 'debug', routine_name //                                             &
-                              ': init variable "' // TRIM( variable_name ) //                      &
-                              '" ( write_only_by_master_rank = ' // TRIM( temp_string ) // ')' )
-
-       nc_variable_type = get_netcdf_data_type( variable_type )
-
-       IF ( nc_variable_type /= -1 )  THEN
-!
-!--       Define variable in file
-          nc_stat = NF90_DEF_VAR( file_id, variable_name, nc_variable_type,                        &
-                                  dimension_ids, variable_id )
-!
-!--       Set no-fill mode
-          IF ( nc_stat == NF90_NOERR )  &
-             nc_stat = NF90_DEF_VAR_FILL( file_id, variable_id, NF90_NOFILL, NF90_FILL_BYTE )
-
-#if defined( __netcdf4_parallel )
-!
-!--       Define how variable can be accessed by PEs in parallel netcdf file
-          IF ( nc_stat == NF90_NOERR  .AND.  TRIM( mode ) == mode_parallel )  THEN
-!
-!--          If the variable uses an unlimited dimension, its access mode must be 'collective',
-!--          otherwise it can be set to independent.
-!--          Hence, get ID of unlimited dimension in file (if any) and check if it is used by
-!--          the variable.
-             nc_stat = NF90_INQUIRE( file_id, UNLIMITEDDIMID=unlimited_dimension_id )
-
-             IF ( nc_stat == NF90_NOERR )  THEN
-                IF ( ANY( dimension_ids == unlimited_dimension_id ) )  THEN
-                   parallel_access_mode = NF90_COLLECTIVE
-                ELSE
-                   parallel_access_mode = NF90_INDEPENDENT
-                ENDIF
-
-                nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, parallel_access_mode )
-             ENDIF
-          ENDIF
-#endif
-
-          IF ( nc_stat /= NF90_NOERR )  THEN
-             return_value = 1
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': NetCDF error while initializing variable "' //              &
-                                    TRIM( variable_name ) // '": ' // NF90_STRERROR( nc_stat ) )
-          ENDIF
-
-       ELSE
-          return_value = 1
-       ENDIF
-
-    ELSEIF ( TRIM( mode ) /= mode_serial  .AND.  TRIM( mode ) /= mode_parallel )  THEN
-       return_value = 1
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': selected mode "' // TRIM( mode ) // '" must be either "' //       &
-                              mode_serial // '" or "' // mode_parallel // '"' )
-    ENDIF
-
-#else
-    return_value = 1
-    variable_id = -1
-!
-!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
-    IF ( .FALSE. )  THEN
-       nc_stat = LEN( routine_name )
-       nc_variable_type = get_netcdf_data_type( '' )
-    ENDIF
-#endif
-
- END SUBROUTINE netcdf4_init_variable
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Leave file definition state.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf4_stop_file_header_definition( mode, file_id, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_stop_file_header_definition'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  mode  !< operation mode (either parallel or serial)
-
-    INTEGER, INTENT(IN)  ::  file_id        !< file ID
-    INTEGER              ::  nc_stat        !< netcdf return value
-    INTEGER              ::  old_fill_mode  !< previous netcdf fill mode
-    INTEGER, INTENT(OUT) ::  return_value   !< return value
-
-
-#if defined( __netcdf4 )
-    return_value = 0
-
-    IF ( .NOT. ( TRIM( mode ) == mode_serial  .AND.  my_rank /= master_rank ) )  THEN
-
-       WRITE( temp_string, * ) file_id
-       CALL internal_message( 'debug', routine_name //                                             &
-                              ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
-!
-!--    Set general no fill, otherwise the performance drops significantly
-       nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_fill_mode )
-
-       IF ( nc_stat == NF90_NOERR )  THEN
-          nc_stat = NF90_ENDDEF( file_id )
-       ENDIF
-
-       IF ( nc_stat /= NF90_NOERR )  THEN
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
-       ENDIF
-
-    ENDIF
-#else
-    return_value = 1
-!
-!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
-    IF ( .FALSE. )  THEN
-       nc_stat = LEN( routine_name )
-       old_fill_mode = 0
-    ENDIF
-#endif
-
- END SUBROUTINE netcdf4_stop_file_header_definition
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write variable of different kind into netcdf file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf4_write_variable(                                                                &
-               mode, file_id, variable_id, bounds_start, value_counts, bounds_origin,              &
-               write_only_by_master_rank,                                                          &
-               values_char_0d,   values_char_1d,   values_char_2d,   values_char_3d,               &
-               values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,               &
-               values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,              &
-               values_int32_0d,  values_int32_1d,  values_int32_2d,  values_int32_3d,              &
-               values_intwp_0d,  values_intwp_1d,  values_intwp_2d,  values_intwp_3d,              &
-               values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d,             &
-               values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d,             &
-               values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d,             &
-               return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_write_variable'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  mode  !< operation mode (either parallel or serial)
-
-    CHARACTER(LEN=1), POINTER,             INTENT(IN), OPTIONAL                   ::  values_char_0d  !< output variable
-    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_char_1d  !< output variable
-    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_char_2d  !< output variable
-    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_char_3d  !< output variable
-
-    INTEGER              ::  d                       !< loop index
-    INTEGER, INTENT(IN)  ::  file_id                 !< file ID
-    INTEGER              ::  nc_stat                 !< netcdf return value
-    INTEGER              ::  ndims                   !< number of dimensions of variable in file
-    INTEGER, INTENT(OUT) ::  return_value            !< return value
-    INTEGER              ::  unlimited_dimension_id  !< ID of unlimited dimension in file
-    INTEGER, INTENT(IN)  ::  variable_id             !< variable ID
-
-    INTEGER, DIMENSION(:),              INTENT(IN)  ::  bounds_origin      !< starting index of each dimension
-    INTEGER, DIMENSION(:),              INTENT(IN)  ::  bounds_start       !< starting index of variable
-    INTEGER, DIMENSION(:), ALLOCATABLE              ::  dimension_ids      !< IDs of dimensions of variable in file
-    INTEGER, DIMENSION(:), ALLOCATABLE              ::  dimension_lengths  !< length of dimensions of variable in file
-    INTEGER, DIMENSION(:),              INTENT(IN)  ::  value_counts       !< count of values along each dimension to be written
-
-    INTEGER(KIND=1), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int8_0d   !< output variable
-    INTEGER(KIND=2), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int16_0d  !< output variable
-    INTEGER(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int32_0d  !< output variable
-    INTEGER(iwp),    POINTER,             INTENT(IN), OPTIONAL                   ::  values_intwp_0d  !< output variable
-    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int8_1d   !< output variable
-    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int16_1d  !< output variable
-    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int32_1d  !< output variable
-    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_intwp_1d  !< output variable
-    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int8_2d   !< output variable
-    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int16_2d  !< output variable
-    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int32_2d  !< output variable
-    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_intwp_2d  !< output variable
-    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int8_3d   !< output variable
-    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int16_3d  !< output variable
-    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int32_3d  !< output variable
-    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_intwp_3d  !< output variable
-
-    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
-    LOGICAL             ::  write_data                 !< true if variable shall be written to file
-
-    REAL(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real32_0d  !< output variable
-    REAL(KIND=8), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real64_0d  !< output variable
-    REAL(wp),     POINTER,             INTENT(IN), OPTIONAL                   ::  values_realwp_0d  !< output variable
-    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real32_1d  !< output variable
-    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real64_1d  !< output variable
-    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_realwp_1d  !< output variable
-    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real32_2d  !< output variable
-    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real64_2d  !< output variable
-    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_realwp_2d  !< output variable
-    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real32_3d  !< output variable
-    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real64_3d  !< output variable
-    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_realwp_3d  !< output variable
-
-
-#if defined( __netcdf4 )
-    return_value = 0
-    write_data = .FALSE.
-!
-!-- Check whether this PE write any data to file
-    IF ( TRIM( mode ) == mode_serial )  THEN
-
-       IF ( my_rank == master_rank )  write_data = .TRUE.
-
-    ELSEIF ( TRIM( mode ) == mode_parallel )  THEN
-!
-!--    Check for collective access mode.
-!--    This cannot be checked directly but indirect via the presence of any unlimited dimensions
-!--    If any dimension is unlimited, variable access must be collective and all PEs must
-!--    participate in writing
-       ndims = SIZE( bounds_start )
-       ALLOCATE( dimension_ids(ndims) )
-
-       nc_stat = NF90_INQUIRE_VARIABLE( file_id, variable_id, DIMIDS=dimension_ids )
-       nc_stat = NF90_INQUIRE( file_id, UNLIMITEDDIMID=unlimited_dimension_id )
-
-       IF ( ANY( dimension_ids == unlimited_dimension_id ) )  THEN
-          write_data = .TRUE.
-!
-!--    If access is independent, check if only master rank shall write
-       ELSEIF ( write_only_by_master_rank )  THEN
-          IF ( my_rank == master_rank )  write_data = .TRUE.
-!
-!--    If all PEs can write, check if there are any data to be written
-       ELSEIF ( ALL( value_counts > 0, DIM=1 ) )  THEN
-          write_data = .TRUE.
-       ENDIF
-
-    ELSE
-       return_value = 1
-       CALL internal_message( 'error', routine_name //                                             &
-                              ': selected mode "' // TRIM( mode ) // '" must be either "' //       &
-                              mode_serial // '" or "' // mode_parallel // '"' )
-    ENDIF
-
-    IF ( write_data )  THEN
-
-       WRITE( temp_string, * ) variable_id
-       CALL internal_message( 'debug', routine_name // ': write variable ' // TRIM( temp_string ) )
-
-       ndims = SIZE( bounds_start )
-!
-!--    Character output
-       IF ( PRESENT( values_char_0d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_char_0d /),                      &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_char_1d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_1d,                            &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_char_2d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_2d,                            &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_char_3d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_3d,                            &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-!
-!--    8bit integer output
-       ELSEIF ( PRESENT( values_int8_0d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int8_0d /),                      &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_int8_1d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_1d,                            &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_int8_2d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_2d,                            &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_int8_3d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_3d,                            &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-!
-!--    16bit integer output
-       ELSEIF ( PRESENT( values_int16_0d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int16_0d /),                     &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_int16_1d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_1d,                           &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_int16_2d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_2d,                           &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_int16_3d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_3d,                           &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-!
-!--    32bit integer output
-       ELSEIF ( PRESENT( values_int32_0d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int32_0d /),                     &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_int32_1d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_1d,                           &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_int32_2d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_2d,                           &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_int32_3d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_3d,                           &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-!
-!--    Working-precision integer output
-       ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_intwp_0d /),                     &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_1d,                           &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_2d,                           &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_3d,                           &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-!
-!--    32bit real output
-       ELSEIF ( PRESENT( values_real32_0d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real32_0d /),                    &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_real32_1d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_1d,                          &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_real32_2d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_2d,                          &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_real32_3d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_3d,                          &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-!
-!--    64bit real output
-       ELSEIF ( PRESENT( values_real64_0d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real64_0d /),                    &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_real64_1d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_1d,                          &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_real64_2d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_2d,                          &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_real64_3d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_3d,                          &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-!
-!--    Working-precision real output
-       ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_realwp_0d /),                    &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_1d,                          &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_2d,                          &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
-          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_3d,                          &
-                                  start = bounds_start - bounds_origin + 1,                        &
-                                  count = value_counts )
-       ELSE
-          return_value = 1
-          nc_stat = NF90_NOERR
-          WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) variable_id, file_id
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': no output values given ' // TRIM( temp_string ) )
-       ENDIF
-!
-!--    Check for errors
-       IF ( nc_stat /= NF90_NOERR )  THEN
-          return_value = 1
-
-          IF ( nc_stat == NF90_EEDGE .OR. nc_stat == NF90_EINVALCOORDS )  THEN
-!
-!--          If given bounds exceed dimension bounds, get information of bounds in file
-             WRITE( temp_string, * )  NF90_STRERROR( nc_stat )
-
-             IF ( .NOT. ALLOCATED( dimension_ids ) )  ALLOCATE( dimension_ids(ndims) )
-             ALLOCATE( dimension_lengths(ndims) )
-
-             nc_stat = NF90_INQUIRE_VARIABLE( file_id, variable_id, dimids=dimension_ids )
-
-             d = 1
-             DO WHILE ( d <= ndims .AND. nc_stat == NF90_NOERR )
-                nc_stat = NF90_INQUIRE_DIMENSION( file_id, dimension_ids(d),                       &
-                                                  LEN=dimension_lengths(d) )
-                d = d + 1
-             ENDDO
-
-             IF ( nc_stat == NF90_NOERR )  THEN
-                WRITE( temp_string, * )  TRIM( temp_string ) // '; given variable bounds: ' //     &
-                   'start=', bounds_start, ', count=', value_counts, ', origin=', bounds_origin
-                CALL internal_message( 'error', routine_name //                                    &
-                                       ': error while writing: ' // TRIM( temp_string ) )
-             ELSE
-!
-!--             Error occured during NF90_INQUIRE_VARIABLE or NF90_INQUIRE_DIMENSION
-                CALL internal_message( 'error', routine_name //                                    &
-                                       ': error while accessing file: ' //                         &
-                                        NF90_STRERROR( nc_stat ) )
-             ENDIF
-
-          ELSE
-!
-!--          Other NetCDF error
-             CALL internal_message( 'error', routine_name //                                       &
-                                    ': error while writing: ' // NF90_STRERROR( nc_stat ) )
-          ENDIF
-       ENDIF
-
-    ENDIF
-#else
-    return_value = 1
-!
-!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
-    IF ( .FALSE. )  THEN
-       nc_stat = LEN( routine_name )
-       IF ( write_data )  unlimited_dimension_id = 0
-       IF ( ALLOCATED( dimension_ids ) )  d = 0
-       IF ( ALLOCATED( dimension_lengths ) )  ndims = 0
-    ENDIF
-#endif
-
- END SUBROUTINE netcdf4_write_variable
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Close netcdf file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf4_finalize( mode, file_id, return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_finalize'  !< name of routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  mode  !< operation mode (either parallel or serial)
-
-    INTEGER, INTENT(IN)  ::  file_id       !< file ID
-    INTEGER              ::  nc_stat       !< netcdf return value
-    INTEGER, INTENT(OUT) ::  return_value  !< return value
-
-
-#if defined( __netcdf4 )
-    return_value = 0
-
-    IF ( .NOT. ( TRIM( mode ) == mode_serial  .AND.  my_rank /= master_rank ) )  THEN
-
-       WRITE( temp_string, * ) file_id
-       CALL internal_message( 'debug', routine_name //                                             &
-                              ': close file (file_id=' // TRIM( temp_string ) // ')' )
-
-       nc_stat = NF90_CLOSE( file_id )
-       IF ( nc_stat == NF90_NOERR )  THEN
-          return_value = 0
-       ELSE
-          return_value = 1
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
-       ENDIF
-
-    ENDIF
-#else
-    return_value = 1
-!
-!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
-    IF ( .FALSE. )  THEN
-       nc_stat = 0
-       temp_string = routine_name
-    ENDIF
-#endif
-
- END SUBROUTINE netcdf4_finalize
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Convert data_type string into netcdf data type value.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION get_netcdf_data_type( data_type ) RESULT( return_value )
-
-    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'get_netcdf_data_type'  !< name of this routine
-
-    CHARACTER(LEN=*), INTENT(IN) ::  data_type  !< requested data type
-
-    INTEGER ::  return_value  !< netcdf data type
-
-
-    SELECT CASE ( TRIM( data_type ) )
-
-#if defined( __netcdf4 )
-       CASE ( 'char' )
-          return_value = NF90_CHAR
-
-       CASE ( 'int8' )
-          return_value = NF90_BYTE
-
-       CASE ( 'int16' )
-          return_value = NF90_SHORT
-
-       CASE ( 'int32' )
-          return_value = NF90_INT
-
-       CASE ( 'real32' )
-          return_value = NF90_FLOAT
-
-       CASE ( 'real64' )
-          return_value = NF90_DOUBLE
-#endif
-
-       CASE DEFAULT
-          CALL internal_message( 'error', routine_name //                                          &
-                                 ': data type unknown (' // TRIM( data_type ) // ')' )
-          return_value = -1
-
-    END SELECT
-
- END FUNCTION get_netcdf_data_type
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Message routine writing debug information into the debug file or creating the error message
-!> string.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE internal_message( level, string )
-
-    CHARACTER(LEN=*), INTENT(IN) ::  level   !< message importance level
-    CHARACTER(LEN=*), INTENT(IN) ::  string  !< message string
-
-
-    IF ( TRIM( level ) == 'error' )  THEN
-
-       WRITE( internal_error_message, '(A,A)' ) ': ', string
-
-    ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
-
-       WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
-       FLUSH( debug_output_unit )
-
-    ENDIF
-
- END SUBROUTINE internal_message
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Return the last created error message.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION netcdf4_get_error_message() RESULT( error_message )
-
-    CHARACTER(LEN=800) ::  error_message  !< return error message to main program
-
-
-    error_message = TRIM( internal_error_message )
-
-    internal_error_message = ''
-
- END FUNCTION netcdf4_get_error_message
-
-
- END MODULE data_output_netcdf4_module
Index: palm/trunk/SOURCE/data_output_particle_mod.f90
===================================================================
--- palm/trunk/SOURCE/data_output_particle_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2318 +1,0 @@
-!> @file data_output_particle_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4779 2020-11-09 17:45:22Z suehring
-! Avoid overlong lines and unused variables
-!
-! 4778 2020-11-09 13:40:05Z raasch
-! Initial implementation (K. Ketelsen)
-!
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Output of particle time series
-!--------------------------------------------------------------------------------------------------!
- MODULE data_output_particle_mod
-
-#if defined( __parallel )
-    USE MPI
-#endif
-
-#if defined( __netcdf4 )
-    USE NETCDF
-#endif
-
-    USE, INTRINSIC ::  ISO_C_BINDING
-
-    USE kinds,                                                                                     &
-       ONLY:  dp, idp, isp, iwp, sp, wp
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nnx, nny, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt
-
-    USE control_parameters,                                                                        &
-        ONLY:  dt_dopts, end_time, simulated_time
-
-    USE pegrid,                                                                                    &
-        ONLY:  comm1dx, comm1dy, comm2d, myid, myidx, myidy, npex, npey, numprocs, pdims
-
-    USE particle_attributes,                                                                       &
-        ONLY:  data_output_pts, grid_particles, grid_particle_def, number_of_output_particles,     &
-               particles, particle_type, prt_count, pts_id_file, pts_increment, pts_percentage,    &
-               oversize, unlimited_dimension
-
-    USE shared_memory_io_mod,                                                                      &
-        ONLY:  sm_class
-
-    USE data_output_netcdf4_module,                                                                &
-        ONLY:  netcdf4_finalize, netcdf4_get_error_message, netcdf4_init_dimension,                &
-               netcdf4_init_module, netcdf4_init_variable, netcdf4_open_file,                      &
-               netcdf4_stop_file_header_definition, netcdf4_write_attribute, netcdf4_write_variable
-
-     USE cpulog,                                                                                   &
-         ONLY:  cpu_log, log_point_s
-
-    IMPLICIT NONE
-
-    PRIVATE
-    SAVE
-
-
-    LOGICAL, PUBLIC      :: dop_active = .FALSE.
-
-!
-!-- Variables for restart
-    INTEGER(iwp), PUBLIC ::  dop_prt_axis_dimension
-    INTEGER(iwp), PUBLIC ::  dop_last_active_particle
-
-!
-!-- kk Private module variables can be declared inside the submodule
-    INTEGER, PARAMETER ::  max_nr_variables    = 128
-    INTEGER, PARAMETER ::  nr_fixed_variables  = 16
-
-    CHARACTER(LEN=32) ::  file_name            !< Name of NetCDF file
-
-    INTEGER(iwp) :: end_local_numbering
-    INTEGER(iwp) :: io_end_index
-    INTEGER(iwp) :: io_start_index         !< Start index of the output area on IO thread
-    INTEGER(iwp) :: nr_particles_pe        !< Number of particles assigned for output on this thread
-    INTEGER(iwp) :: nr_particles_rest      !< Numbere of rest Particle (ireg. distribution)
-    INTEGER(iwp) :: nr_particles_out       !< Total number od particles assigned for output
-    INTEGER(iwp) :: nr_time_values         !< Number of values on time axis
-    INTEGER(iwp) :: pe_end_index
-    INTEGER(iwp) :: pe_start_index         !< Start index of the output area on this thread
-    INTEGER(iwp) :: start_local_numbering  !< Start increment 1 numbering on this thread
-
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) ::  io_indices       !< Indices on IO processes
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) ::  mo_indices       !< Indices for model communicator
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) ::  remote_nr_particles
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) ::  rma_particles    !< Start address and number of remote particles
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) ::  sh_indices       !< Indices in shared memory group
-
-    LOGICAL ::  irregular_distribubtion  !< irregular distribution of output particlesexit
-
-    REAL(sp), ALLOCATABLE, DIMENSION(:) ::  time_axis_values  !< time axis Values
-
-    TYPE var_def
-       INTEGER(iwp)      ::  var_id
-       CHARACTER(LEN=32) ::  name
-       CHARACTER(LEN=32) ::  units
-       LOGICAL           ::  is_integer = .FALSE.
-    END TYPE var_def
-
-    TYPE(sm_class) ::  part_io  !< manage communicator for particle IO
-
-    TYPE(var_def), DIMENSION(nr_fixed_variables) ::  fix_variables
-    TYPE(var_def), DIMENSION(max_nr_variables)   ::  variables
-
-!
-!-- NetCDF
-    INTEGER(iwp) ::  file_id = -1      !< id of Netcdf file
-    INTEGER(iwp) ::  nr_fix_variables  !< Number of fixed variables scheduled for output
-    INTEGER(iwp) ::  nr_variables      !< Number of variables  scheduled for output
-
-    TYPE dimension_id
-       INTEGER(iwp)         :: prt
-       INTEGER(iwp)         :: time
-    END TYPE dimension_id
-
-    TYPE variable_id
-       INTEGER(iwp)         :: prt
-       INTEGER(iwp)         :: time
-    END TYPE variable_id
-
-    TYPE(dimension_id) ::  did
-    TYPE(variable_id)  ::  var_id
-
-!
-!-- Shared memory buffer
-    INTEGER(iwp) ::  win_prt_i = -1  !< integer MPI shared Memory window
-    INTEGER(iwp) ::  win_prt_r = -1  !< real  MPI shared Memory window
-    INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:) ::  out_buf_i  !< integer output buffer
-    REAL(sp), POINTER, CONTIGUOUS, DIMENSION(:)     ::  out_buf_r  !< real output buffer
-
-!
-!-- Particle list in file
-    INTEGER(idp), ALLOCATABLE, DIMENSION(:) ::  part_id_list_file
-
-    LOGICAL ::  part_list_in_file
-
-!
-!-- RMA window
-#if defined( __parallel )
-    INTEGER(iwp)    ::  win_rma_buf_i
-    INTEGER(iwp)    ::  win_rma_buf_r
-#endif
-
-    INTEGER(iwp)                            :: initial_number_of_active_particles
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:) :: remote_indices     !< particle nubmer of the remodte partices,
-                                                                  !< used as indices in the output array
-    INTEGER(iwp), POINTER, DIMENSION(:)     :: transfer_buffer_i  !< rma window to provide data, which can be
-                                                                  !< fetch via MPI_Get
-    REAL(sp), POINTER, DIMENSION(:)         :: transfer_buffer_r  !< Same for REAL
-
-!
-!-- Public subroutine Interface
-    INTERFACE dop_init
-       MODULE PROCEDURE dop_init
-    END INTERFACE dop_init
-
-    INTERFACE dop_output_tseries
-       MODULE PROCEDURE dop_output_tseries
-    END INTERFACE dop_output_tseries
-
-    INTERFACE dop_finalize
-       MODULE PROCEDURE dop_finalize
-    END INTERFACE  dop_finalize
-
-#if defined( __parallel )
-    INTERFACE dop_alloc_rma_mem
-       MODULE PROCEDURE dop_alloc_rma_mem_i1
-       MODULE PROCEDURE dop_alloc_rma_mem_r1
-    END INTERFACE dop_alloc_rma_mem
-#endif
-
-    PUBLIC dop_init, dop_output_tseries, dop_finalize
-#if defined( __parallel )
-    PUBLIC dop_alloc_rma_mem       ! Must be PUBLIC on NEC, although it is only used in submodule
-#endif
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_init( read_restart )
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: i                           !<
-#if defined( __parallel )
-    INTEGER(iwp) :: ierr                        !< MPI error code
-#endif
-    INTEGER(iwp) :: nr_local_last_pe            !< Number of output particles on myid == numprocs-2
-    INTEGER(idp) :: nr_particles_8              !< Total number of particles in 64 bit
-    INTEGER(iwp) :: nr_particles_local          !< total number of particles scheduled for output on this thread
-
-    INTEGER(idp), DIMENSION(0:numprocs-1)     :: nr_particles_all_8
-    INTEGER(iwp), DIMENSION(0:numprocs-1)     :: nr_particles_all_s
-    INTEGER(iwp), DIMENSION(0:numprocs-1)     :: nr_particles_all_r
-
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:)  :: io_indices_s
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:)  :: mo_indices_s
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:)  :: sh_indices_s
-
-    LOGICAL, INTENT(IN)    :: read_restart
-
-    REAL(dp)     :: xnr_part                    !< Must be 64 Bit REAL
-
-
-    part_list_in_file = (pts_id_file /= ' ')
-
-    IF ( .NOT. part_list_in_file )  THEN
-       IF ( .NOT. read_restart)  THEN
-
-          CALL set_indef_particle_nr
-
-          CALL count_output_particles( nr_particles_local )
-
-          nr_particles_all_s = 0
-          nr_particles_all_s(myid) = nr_particles_local
-
-#if defined( __parallel )
-          CALL MPI_ALLREDUCE( nr_particles_all_s, nr_particles_all_r, SIZE( nr_particles_all_s ),  &
-                              MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-          nr_particles_all_r = nr_particles_all_s
-#endif
-
-          initial_number_of_active_particles = SUM( nr_particles_all_r )
-
-          start_local_numbering = 1
-          end_local_numbering   = nr_particles_all_r(0)
-
-          IF ( myid > 0 )  THEN
-             DO  i = 1, numprocs-1
-                start_local_numbering = start_local_numbering+nr_particles_all_r(i-1)
-                end_local_numbering   = start_local_numbering+nr_particles_all_r(i)-1
-                IF ( myid == i )  EXIT
-             ENDDO
-          ENDIF
-
-          nr_particles_all_8 = nr_particles_all_r       ! Use 64 INTEGER, maybe more than 2 GB particles
-          nr_particles_8 = SUM( nr_particles_all_8 )
-          IF ( nr_particles_8 > 2000000000_idp )  THEN   ! This module works only with 32 Bit INTEGER
-             WRITE( 9, * ) 'Number of particles too large ', nr_particles_8 ; FLUSH( 9 )
-#if defined( __parallel )
-             CALL MPI_ABORT( MPI_COMM_WORLD, 1, ierr )
-#endif
-          ENDIF
-          nr_particles_out = nr_particles_8       ! Total number of particles scheduled for output
-
-!
-!--       Reserve space for additional particle
-          IF ( number_of_output_particles > 0 )  THEN
-             nr_particles_out = MAX( number_of_output_particles, nr_particles_out )
-          ELSEIF ( oversize > 100.0_wp )  THEN
-             xnr_part = nr_particles_out * oversize / 100.0_wp
-             nr_particles_out = xnr_part
-          ENDIF
-       ELSE
-          nr_particles_out = dop_prt_axis_dimension            ! Get Number from restart file
-          initial_number_of_active_particles = dop_last_active_particle
-       ENDIF
-
-    ELSE
-       CALL set_indef_particle_nr
-       CALL dop_read_output_particle_list( nr_particles_out )
-    ENDIF
-    dop_prt_axis_dimension = nr_particles_out
-
-!
-!-- The number of particles must be at least the number of MPI processes
-    nr_particles_out = MAX( nr_particles_out, numprocs )
-
-
-    nr_particles_pe = ( nr_particles_out + numprocs - 1 ) / numprocs   ! Number of paricles scheduled for ouput on this thread
-
-    pe_start_index = myid * nr_particles_pe + 1                              !Output numberimng on this thread
-    pe_end_index   = MIN( ( myid + 1 ) * nr_particles_pe, nr_particles_out )
-
-    irregular_distribubtion = .FALSE.
-#if defined( __parallel )
-!
-!-- In case of few particles, it can happen that not only the last thread gets fewer output
-!-- particles. In this case, the local number of particles on thread numprocs-1 will be < 1.
-!-- If this happens, irregular distribution of output particles will be used.
-    IF ( myid == numprocs-1 )  THEN
-       nr_local_last_pe = pe_end_index-pe_start_index + 1
-    ELSE
-       nr_local_last_pe = 0
-    ENDIF
-    CALL MPI_BCAST( nr_local_last_pe, 1, MPI_INTEGER, numprocs-1, comm2d, ierr )
-#else
-    nr_local_last_pe = nr_particles_pe
-#endif
-    IF ( nr_local_last_pe < 1 )  THEN
-       irregular_distribubtion = .TRUE.
-       CALL dop_setup_ireg_distribution
-    ENDIF
-
-
-    IF ( .NOT. read_restart  .AND.  .NOT. part_list_in_file )  THEN
-       CALL set_particle_number
-    ENDIF
-
-    IF ( part_list_in_file )  THEN
-       CALL dop_find_particle_in_outlist
-    ENDIF
-
-    CALL part_io%sm_init_data_output_particles( )
-
-    ALLOCATE( sh_indices_s(2,0:part_io%sh_npes-1) )
-    ALLOCATE( sh_indices(2,0:part_io%sh_npes-1) )
-
-
-#if defined( __parallel )
-    sh_indices_s = 0
-    sh_indices_s(1,part_io%sh_rank) = pe_start_index
-    sh_indices_s(2,part_io%sh_rank) = pe_end_index
-
-    CALL MPI_ALLREDUCE( sh_indices_s, sh_indices, 2*part_io%sh_npes, MPI_INTEGER, MPI_SUM,         &
-                        part_io%comm_shared, ierr )
-
-    io_start_index = sh_indices(1,0)                         ! output numbering on actual IO thread
-    io_end_index   = sh_indices(2,part_io%sh_npes-1)
-#else
-    io_start_index = pe_start_index                          ! output numbering
-    io_end_index   = pe_end_index
-#endif
-
-
-#if defined( __parallel )
-    CALL MPI_BCAST( part_io%io_npes, 1, MPI_INTEGER, 0,  part_io%comm_shared, ierr )
-#endif
-    ALLOCATE( io_indices(2,0:part_io%io_npes-1) )
-    IF ( part_io%iam_io_pe )  THEN
-       ALLOCATE( io_indices_s(2,0:part_io%io_npes-1) )
-
-       io_indices_s = 0
-       io_indices_s(1,part_io%io_rank) = io_start_index
-       io_indices_s(2,part_io%io_rank) = io_end_index
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( io_indices_s, io_indices, 2 * part_io%io_npes, MPI_INTEGER, MPI_SUM,    &
-                           part_io%comm_io, ierr )
-#else
-       io_indices = io_indices_s
-#endif
-
-    ENDIF
-
-#if defined( __parallel )
-    CALL MPI_BCAST( io_indices, SIZE( io_indices ), MPI_INTEGER, 0,  part_io%comm_shared, ierr )
-#endif
-
-    ALLOCATE( remote_nr_particles(2,0:numprocs-1) )
-    ALLOCATE( rma_particles(2,0:numprocs-1) )
-
-    ALLOCATE( mo_indices(2,0:numprocs-1) )
-    ALLOCATE( mo_indices_s(2,0:numprocs-1) )
-
-    mo_indices_s = 0
-    mo_indices_s(1,myid) = pe_start_index
-    mo_indices_s(2,myid) = pe_end_index
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( mo_indices_s, mo_indices, 2 * numprocs, MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-    mo_indices = mo_indices_s
-#endif
-
-!-- Allocate output buffer
-#if defined( __parallel )
-    CALL part_io%sm_allocate_shared( out_buf_r, io_start_index, io_end_index, win_prt_r )
-    CALL part_io%sm_allocate_shared( out_buf_i, io_start_index, io_end_index, win_prt_i )
-#else
-    ALLOCATE( out_buf_r(io_start_index:io_end_index) )
-    ALLOCATE( out_buf_i(io_start_index:io_end_index) )
-#endif
-
-!
-!-- NetCDF
-    CALL dop_netcdf_setup( )
-
-#if defined( __parallel )
-    CALL MPI_BCAST( nr_fix_variables, 1, MPI_INTEGER, 0, part_io%comm_shared, ierr )
-    CALL MPI_BCAST( nr_variables, 1, MPI_INTEGER, 0, part_io%comm_shared, ierr )
-#endif
-
-    CALL dop_count_remote_particles
-
-    CALL dop_write_fixed_variables
-
-    CALL deallocate_and_free
-
-    CALL dop_output_tseries
-
-    RETURN
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE dop_setup_ireg_distribution
-
-       IMPLICIT NONE
-
-       nr_particles_pe   = ( nr_particles_out ) / numprocs   ! Number of paricles scheduled for ouput on this thread
-
-       nr_particles_rest = nr_particles_out - numprocs * nr_particles_pe
-
-       nr_particles_pe = nr_particles_pe + 1
-       IF ( myid < nr_particles_rest )  THEN
-          pe_start_index = myid * nr_particles_pe + 1                              ! Output numberimng on this thread
-          pe_end_index   = MIN( ( myid + 1 ) * nr_particles_pe, nr_particles_out)
-       ELSE
-          pe_start_index = nr_particles_rest * ( nr_particles_pe )                                 &
-                           + ( myid - nr_particles_rest ) * ( nr_particles_pe - 1 ) + 1  !Output numberimng on this thread
-          pe_end_index   = MIN( pe_start_index + nr_particles_pe - 2, nr_particles_out )
-       ENDIF
-
-
-    END SUBROUTINE dop_setup_ireg_distribution
-
- END SUBROUTINE dop_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Particle output on selected time steps
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_output_tseries
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)             :: i                           !<
-    INTEGER(iwp)             :: return_value                !< Return value data_output_netcdf4 .. routines
-#if defined( __parallel )
-    INTEGER(iwp)             :: ierr                        !< MPI error code
-#endif
-    INTEGER(iwp), SAVE        :: icount=0                    !< count output steps
-
-    INTEGER(iwp), DIMENSION(2)      :: bounds_origin, bounds_start, value_counts
-
-    REAl(wp), POINTER, CONTIGUOUS, DIMENSION(:)  :: my_time
-
-    icount = icount + 1
-
-    CALL dop_delete_particle_number
-
-    IF ( part_list_in_file )  THEN
-
-       CALL dop_find_particle_in_outlist
-    ELSE
-       CALL dop_newly_generated_particles
-    ENDIF
-
-    CALL dop_count_remote_particles
-
-    bounds_origin    = 1
-
-    bounds_start(1)  = io_start_index
-    bounds_start(2)  = icount
-
-    value_counts(1)  = io_end_index-io_start_index + 1
-    value_counts(2)  = 1
-
-    DO  i = 1, nr_variables
-#if defined( __netcdf4 )
-       IF ( variables(i)%is_integer )  THEN
-          out_buf_i = NF90_FILL_INT
-       ELSE
-          out_buf_r = NF90_FILL_REAL
-       ENDIF
-#endif
-
-       CALL cpu_log( log_point_s(99), 'dop_fill_out_buf', 'start' )
-       CALL dop_fill_out_buf (variables(i))
-       CALL cpu_log( log_point_s(99), 'dop_fill_out_buf', 'stop' )
-
-       CALL cpu_log( log_point_s(88), 'dop_get_remote_particle', 'start' )
-#if defined( __parallel )
-       CALL  dop_get_remote_particle( variables(i)%is_integer )
-#endif
-       CALL cpu_log( log_point_s(88), 'dop_get_remote_particle', 'stop' )
-
-       CALL cpu_log( log_point_s(89), 'particle NetCDF output', 'start' )
-       CALL part_io%sm_node_barrier( )
-       IF ( part_io%iam_io_pe )  THEN
-          IF ( variables(i)%is_integer)  THEN
-             CALL netcdf4_write_variable( 'parallel', file_id, variables(i)%var_id, bounds_start,  &
-                                          value_counts, bounds_origin, .FALSE.,                    &
-                                          values_int32_1d=out_buf_i, return_value=return_value )
-          ELSE
-             CALL netcdf4_write_variable( 'parallel', file_id, variables(i)%var_id, bounds_start,  &
-                                           value_counts, bounds_origin, .FALSE.,                   &
-                                           values_real32_1d=out_buf_r, return_value=return_value)
-          ENDIF
-       ENDIF
-       CALL part_io%sm_node_barrier( )
-       CALL cpu_log( log_point_s(89), 'particle NetCDF output', 'stop' )
-
-#if defined( __parallel )
-       CALL MPI_BARRIER( comm2d, ierr )               !kk This Barrier is necessary, not sure why
-#endif
-    ENDDO
-
-    CALL deallocate_and_free
-
-!
-!-- Write Time value
-    IF ( myid == 0 )  THEN
-       ALLOCATE( my_time(1) )
-       bounds_start(1)  = icount
-       value_counts(1)  = 1
-       my_time(1)       = simulated_time
-       IF ( unlimited_dimension )  THEN               ! For workaround described in dop finalize
-          time_axis_values(icount) = my_time(1)
-       ELSE
-          CALL netcdf4_write_variable( 'parallel', file_id, var_id%time, bounds_start(1:1),        &
-                                       value_counts(1:1), bounds_origin(1:1), .TRUE.,              &
-                                       values_realwp_1d=my_time, return_value=return_value )
-       ENDIF
-       DEALLOCATE( my_time )
-    ENDIF
-
-    RETURN
- END SUBROUTINE dop_output_tseries
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_finalize
-
-    IMPLICIT NONE
-
-#if defined( __netcdf4 )
-    INTEGER(iwp) :: ierr                        !< MPI error code
-#endif
-    INTEGER(iwp) :: return_value                !< Return value data_output_netcdf4 .. routines
-#if defined( __netcdf4 )
-    INTEGER(iwp) :: var_len
-#endif
-
-    IF ( win_prt_i /= -1 )  THEN
-       CALL part_io%sm_free_shared( win_prt_i )
-    ENDIF
-    IF ( win_prt_r /= -1 )  THEN
-       CALL part_io%sm_free_shared( win_prt_r )
-    ENDIF
-
-    IF ( file_id /= -1  .AND.  part_io%iam_io_pe )  THEN
-       CALL netcdf4_finalize( 'parallel', file_id, return_value )
-       file_id = -1
-
-#if defined( __netcdf4 )
-!
-!--    For yet unknown reasons it is not possible to write in parallel mode the time values to
-!--    NetCDF variable time.
-!--    This workaround closes the parallel file and writes the time values in sequential mode on
-!--    PE0.
-!--    kk  This is a real quick and dirty workaround and the problem should be solved in the final
-!--        version !!!
-       IF ( myid == 0  .AND.  unlimited_dimension )  THEN
-          ierr = NF90_OPEN( TRIM( file_name ), NF90_WRITE, file_id )
-          ierr = NF90_INQUIRE_DIMENSION( file_id, did%time, LEN = var_len)
-
-          ierr = NF90_PUT_VAR( file_id, var_id%time, time_axis_values(1:var_len) )
-
-          ierr = NF90_CLOSE( file_id )
-       ENDIF
-#endif
-    ENDIF
-
-    RETURN
- END SUBROUTINE dop_finalize
-
-!
-!--Private subroutines
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
-!
-!-- kk    Not sure if necessary, but set ALL particle number to -1
- SUBROUTINE set_indef_particle_nr
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: i                           !<
-    INTEGER(iwp) :: j                           !<
-    INTEGER(iwp) :: k                           !<
-    INTEGER(iwp) :: n                           !<
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             DO  n = 1, SIZE( grid_particles(k,j,i)%particles )
-                grid_particles(k,j,i)%particles(n)%particle_nr = -1
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-    RETURN
- END SUBROUTINE set_indef_particle_nr
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Count particles scheduled for output.
-!> Here pts_increment and pts_percentage are used to select output particles.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE count_output_particles (pcount)
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)               :: i             !<
-    INTEGER(iwp)               :: j             !<
-    INTEGER(iwp)               :: k             !<
-    INTEGER(iwp)               :: n             !<
-    INTEGER(iwp)               :: n_all         !< count all particles for MOD function
-    INTEGER(iwp), INTENT(OUT)  :: pcount        !<
-
-    REAL(dp)     :: finc
-    REAL(dp)     :: fcount
-
-
-    pcount = 0
-    IF ( pts_increment == 1 )  THEN
-       pcount = SUM( prt_count )
-    ELSE
-       n_all = 0
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                DO  n = 1, prt_count(k,j,i)
-                   IF ( MOD( n_all, pts_increment ) == 0 )  THEN
-                      pcount = pcount + 1
-                   ENDIF
-                   n_all = n_all + 1
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
-    IF ( pts_percentage < 100.0_wp )  THEN
-
-       finc   = pts_percentage / 100
-
-       pcount = 0
-       fcount = 0.0_wp
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                DO  n = 1, prt_count(k,j,i)
-                   fcount = fcount + finc
-                   IF ( pcount < INT( fcount ) )  THEN
-                      pcount = pcount + 1
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-    RETURN
- END SUBROUTINE count_output_particles
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_read_output_particle_list( nr_particles_out )
-
-    IMPLICIT NONE
-
-    INTEGER(idp)               :: dummy  !<
-    INTEGER(iwp)               :: i      !<
-    INTEGER(iwp)               :: istat  !<
-    INTEGER(iwp)               :: iu     !<
-    INTEGER(iwp), INTENT(OUT)  :: nr_particles_out
-
-
-    iu    = 345
-    istat = 0
-    nr_particles_out = 0
-
-    OPEN( UNIT=iu, FILE=TRIM( pts_id_file ) )      !kk should be changed to check_open
-
-!
-!-- First stridem cout output particle
-    DO  WHILE( istat == 0 )
-       READ( iu, *, iostat=istat )  dummy
-       nr_particles_out = nr_particles_out + 1
-    ENDDO
-
-    nr_particles_out = nr_particles_out - 1             ! subtract 1 for end of file read
-
-    ALLOCATE( part_id_list_file(nr_particles_out) )
-
-    REWIND( iu )
-!
-!-- Second stride, read particle ids for scheduled output particle.
-    DO  i = 1, nr_particles_out
-       READ( iu, * ) part_id_list_file(i)
-    ENDDO
-
-    CLOSE( iu )
-
- END SUBROUTINE dop_read_output_particle_list
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set output particle number for selected active particles
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE set_particle_number
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: i                           !<
-    INTEGER(iwp) :: j                           !<
-    INTEGER(iwp) :: k                           !<
-    INTEGER(iwp) :: n                           !<
-    INTEGER(iwp) :: n_all                       !< count all particles for MOD function
-    INTEGER(iwp) :: particle_nr                 !< output particle number
-    INTEGER(iwp) :: pcount                      !< local particle count in case of pts_percentage
-
-    REAL(dp)     :: fcount                      !< partical progress in %/100
-    REAL(dp)     :: finc                        !< increment of particle
-
-
-    pcount = 0
-    fcount = 0.0
-
-    particle_nr = start_local_numbering
-    n_all       = 0
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             IF ( pts_increment > 1 )  THEN
-                DO  n = 1, prt_count(k,j,i)
-                   IF ( MOD( n_all, pts_increment ) == 0 )  THEN
-                      grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr
-                      particle_nr = particle_nr + 1
-                   ELSE
-                      grid_particles(k,j,i)%particles(n)%particle_nr = -2
-                   ENDIF
-                   n_all = n_all + 1
-                ENDDO
-             ELSEIF ( pts_percentage < 100.0_wp )  THEN
-                finc   = pts_percentage / 100
-
-                DO  n = 1, prt_count(k,j,i)
-!
-!--                Eeach particle moves fraction on particle axis (i.e part percent == 80; move 0.8)
-!--                if increases next whole number, the particle is taken for output.
-                   fcount = fcount + finc
-                   IF ( pcount < INT( fcount ) )  THEN
-                      pcount = pcount + 1
-                      grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr
-                      particle_nr = particle_nr + 1
-                   ELSE
-                      grid_particles(k,j,i)%particles(n)%particle_nr = -2
-                   ENDIF
-                ENDDO
-             ELSE
-                DO  n = 1, prt_count(k,j,i)
-                   grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr
-                   particle_nr = particle_nr + 1
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-
-    RETURN
- END SUBROUTINE set_particle_number
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_find_particle_in_outlist
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: i                           !<
-#if defined( __parallel )
-    INTEGER(iwp) :: ierr                        !< MPI error code
-#endif
-    INTEGER(iwp) :: j                           !<
-    INTEGER(iwp) :: k                           !<
-    INTEGER(iwp) :: l                           !<
-    INTEGER(iwp) :: n                           !<
-    INTEGER(iwp) :: nr_part                     !<
-!      INTEGER, save :: icount=0
-
-
-    nr_part = 0
-
-!
-!-- If there is a long particle output list, for performance reason it may become necessary to
-!-- optimize the following loop.
-!
-!-- Decode the particle id in i,j,k,n.
-!-- Split serach, i.e search first in i, then in j ...
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             DO  n = 1, prt_count(k,j,i)
-                DO  l = 1, SIZE( part_id_list_file )
-                   IF ( grid_particles(k,j,i)%particles(n)%id == part_id_list_file(l) )  THEN
-                      grid_particles(k,j,i)%particles(n)%particle_nr =  l
-                      nr_part = nr_part + 1
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( nr_part, initial_number_of_active_particles, 1, MPI_INTEGER, MPI_SUM,      &
-                        comm2d, ierr )
-#else
-    initial_number_of_active_particles = nr_part
-#endif
-
- END SUBROUTINE dop_find_particle_in_outlist
-
-!
-!-- Netcdf Setup
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Open NetCDF File DATA_1D_PTS_NETCDF
-!> Define Dimensions and variables
-!> Write constant variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_netcdf_setup
-
-    IMPLICIT NONE
-
-    INTEGER, PARAMETER       :: global_id_in_file = -1
-
-    INTEGER(iwp)             :: i
-    INTEGER(iwp)             :: fix_ind
-    INTEGER(iwp)             :: return_value
-    INTEGER(iwp)             :: var_ind
-
-    INTEGER, DIMENSION(2)    :: dimension_ids
-
-    LOGICAL                  :: const_flag
-
-
-    nr_time_values = end_time / dt_dopts + 1               !kk has to be adapted to formular of 3d output
-
-    IF ( part_io%iam_io_pe )  THEN
-       CALL netcdf4_init_module( "", part_io%comm_io, 0, 9, .TRUE., -1 )
-
-       file_name = 'DATA_1D_PTS_NETCDF'
-#if defined( __parallel )
-       CALL netcdf4_open_file( 'parallel', TRIM( file_name ), file_id, return_value )
-#else
-       CALL netcdf4_open_file( 'serial', TRIM( file_name ), file_id, return_value )
-#endif
-
-!
-!--    Global attributes
-       CALL netcdf4_write_attribute( 'parallel', file_id, global_id_in_file, 'comment',            &
-                                     'Particle ouput created by PALM module data_output_particle', &
-                                     return_value=return_value )
-
-       CALL netcdf4_write_attribute( 'parallel', file_id, global_id_in_file,                       &
-                                     'initial_nr_particles',                                       &
-                                     value_int32=initial_number_of_active_particles,               &
-                                     return_value=return_value )
-!
-!--    Define dimensions
-       CALL netcdf4_init_dimension( 'parallel', file_id, did%prt, var_id%prt, 'prt','int32' ,      &
-                                    nr_particles_out, .TRUE., return_value )
-
-       IF ( unlimited_dimension )  THEN
-          CALL netcdf4_init_dimension( 'parallel', file_id, did%time, var_id%time, 'time','real32',&
-                                       -1, .TRUE., return_value )
-          ALLOCATE( time_axis_values(nr_time_values) )
-       ELSE
-          CALL netcdf4_init_dimension( 'parallel', file_id, did%time, var_id%time, 'time','real32',&
-                                       nr_time_values, .TRUE., return_value )
-       ENDIF
-    ENDIF
-!
-!-- Variables without time axis
-!-- These variables will always be written only once at the beginning of the file
-    dimension_ids(1) = did%prt
-
-    fix_ind = 1
-    fix_variables(fix_ind)%name  = 'origin_x'
-    fix_variables(fix_ind)%units = 'meter'
-
-    IF ( part_io%iam_io_pe )  THEN
-       CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id,             &
-                                   fix_variables(fix_ind)%name, 'real32', dimension_ids(1:1),      &
-                                   .FALSE., return_value )
-
-       CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, 'units',  &
-                                     value_char=TRIM( fix_variables(fix_ind)%units ),              &
-                                     return_value=return_value )
-    ENDIF
-
-    fix_ind = fix_ind + 1
-    fix_variables(fix_ind)%name  = 'origin_y'
-    fix_variables(fix_ind)%units = 'meter'
-
-    IF ( part_io%iam_io_pe )  THEN
-       CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id,             &
-                                   fix_variables(fix_ind)%name, 'real32', dimension_ids(1:1),      &
-                                   .FALSE., return_value )
-
-       CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, 'units',  &
-                                     value_char=TRIM( fix_variables(fix_ind)%units ),              &
-                                     return_value=return_value )
-
-    ENDIF
-
-    fix_ind = fix_ind + 1
-    fix_variables(fix_ind)%name  = 'origin_z'
-    fix_variables(fix_ind)%units = 'meter'
-
-    IF ( part_io%iam_io_pe )  THEN
-       CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id,             &
-                                   fix_variables(fix_ind)%name, 'real32', dimension_ids(1:1),      &
-                                   .FALSE., return_value )
-
-       CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, 'units',  &
-                                     value_char=TRIM( fix_variables(fix_ind)%units ),              &
-                                     return_value=return_value )
-    ENDIF
-
-!
-!-- These variables are written if name end with _const'
-    DO  i = 1, SIZE( data_output_pts )
-       const_flag = ( INDEX( TRIM( data_output_pts(i) ), '_const' ) > 0 )
-       IF ( LEN( TRIM( data_output_pts(i) ) ) > 0  .AND.  const_flag)  THEN
-          fix_ind = fix_ind + 1
-          fix_variables(fix_ind)%name  = TRIM( data_output_pts(i) )
-
-          SELECT CASE ( TRIM( fix_variables(fix_ind)%name ) )
-             CASE ( 'radius_const' )
-                fix_variables(fix_ind)%units = 'meter'
-                fix_variables(fix_ind)%is_integer = .FALSE.
-             CASE ( 'aux1_const' )
-                fix_variables(fix_ind)%units = 'depend_on_setup'
-                fix_variables(fix_ind)%is_integer = .FALSE.
-             CASE ( 'aux2_const' )
-                fix_variables(fix_ind)%units = 'depend_on_setup'
-                fix_variables(fix_ind)%is_integer = .FALSE.
-             CASE ( 'rvar1_const' )
-                fix_variables(fix_ind)%units = 'depend_on_setup'
-                fix_variables(fix_ind)%is_integer = .FALSE.
-             CASE ( 'rvar2_const' )
-                fix_variables(fix_ind)%units = 'depend_on_setup'
-                fix_variables(fix_ind)%is_integer = .FALSE.
-             CASE ( 'rvar3_const' )
-                fix_variables(fix_ind)%units = 'depend_on_setup'
-                fix_variables(fix_ind)%is_integer = .FALSE.
-          END SELECT
-
-          IF ( part_io%iam_io_pe )  THEN
-             IF ( fix_variables(fix_ind)%is_integer )  THEN
-                CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id,    &
-                                            fix_variables(fix_ind)%name, 'int32',                  &
-                                            dimension_ids(1:1), .FALSE., return_value )
-             ELSE
-                CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id,    &
-                                             fix_variables(fix_ind)%name, 'real32',                &
-                                             dimension_ids(1:1), .FALSE., return_value )
-             ENDIF
-
-             CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id,     &
-                                           'units',                                                &
-                                           value_char=TRIM( fix_variables(fix_ind)%units ),        &
-                                           return_value=return_value )
-          ENDIF
-
-       ENDIF
-    ENDDO
-
-    nr_fix_variables = fix_ind
-!
-!-- Variables time axis
-!-- These variables will always be written in the time loop
-    dimension_ids(1) = did%prt
-    dimension_ids(2) = did%time
-
-    var_ind = 0
-
-    DO  i = 1, SIZE( data_output_pts )
-       const_flag = ( INDEX( TRIM( data_output_pts(i) ), '_const' ) > 0 )
-       IF ( LEN( TRIM( data_output_pts(i) ) ) > 0  .AND.  .NOT. const_flag )  THEN
-          var_ind = var_ind + 1
-          variables(var_ind)%name  = TRIM( data_output_pts(i) )
-
-          SELECT CASE ( TRIM( variables(var_ind)%name) )
-             CASE ( 'id' )
-                variables(var_ind)%name  = TRIM( data_output_pts(i) ) // '_low'
-                variables(var_ind)%units = 'Number'
-                variables(var_ind)%is_integer = .TRUE.
-                IF ( part_io%iam_io_pe )  THEN
-                   CALL netcdf4_init_variable( 'parallel', file_id, variables(var_ind)%var_id,     &
-                                               variables(var_ind)%name, 'int32',                   &
-                                               dimension_ids(1:2), .FALSE., return_value )
-                   CALL netcdf4_write_attribute( 'parallel', file_id, variables(var_ind)%var_id,   &
-                                                 'units',                                          &
-                                                 value_char=TRIM( variables(var_ind)%units ),      &
-                                                 return_value=return_value )
-                ENDIF
-
-                var_ind = var_ind + 1
-                variables(var_ind)%name  = TRIM( data_output_pts(i) ) // '_high'
-                variables(var_ind)%units = 'Number'
-                variables(var_ind)%is_integer = .TRUE.
-             CASE ( 'particle_nr' )
-                variables(var_ind)%units = 'Number'
-                variables(var_ind)%is_integer = .TRUE.
-             CASE ( 'class' )
-                variables(var_ind)%units = 'Number'
-                variables(var_ind)%is_integer = .TRUE.
-             CASE ( 'group' )
-                variables(var_ind)%units = 'Number'
-                variables(var_ind)%is_integer = .TRUE.
-             CASE ( 'x' )
-                variables(var_ind)%units = 'meter'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'y' )
-                variables(var_ind)%units = 'meter'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'z' )
-                variables(var_ind)%units = 'meter'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'speed_x' )
-                variables(var_ind)%units = 'm/s'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'speed_y' )
-                variables(var_ind)%units = 'm/s'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'speed_z' )
-                variables(var_ind)%units = 'm/s'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'radius' )
-                variables(var_ind)%units = 'meter'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'age' )
-                variables(var_ind)%units = 'sec'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'age_m' )
-                variables(var_ind)%units = 'sec'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'dt_sum' )
-                variables(var_ind)%units = 'sec'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'e_m' )
-                variables(var_ind)%units = 'Ws'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE( 'weight_factor' )
-                variables(var_ind)%units = 'factor'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'aux1' )
-                variables(var_ind)%units = 'depend_on_setup'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'aux2' )
-                variables(var_ind)%units = 'depend_on_setup'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'rvar1' )
-                variables(var_ind)%units = 'depend_on_setup'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'rvar2' )
-                variables(var_ind)%units = 'depend_on_setup'
-                variables(var_ind)%is_integer = .FALSE.
-             CASE ( 'rvar3' )
-                variables(var_ind)%units = 'depend_on_setup'
-                variables(var_ind)%is_integer = .FALSE.
-          END SELECT
-
-          IF ( part_io%iam_io_pe )  THEN
-             IF ( variables(var_ind)%is_integer )  THEN
-                CALL netcdf4_init_variable( 'parallel', file_id, variables(var_ind)%var_id,        &
-                                            variables(var_ind)%name, 'int32', dimension_ids(1:2),  &
-                                            .FALSE., return_value )
-             ELSE
-                CALL netcdf4_init_variable( 'parallel', file_id, variables(var_ind)%var_id,        &
-                                            variables(var_ind)%name, 'real32', dimension_ids(1:2), &
-                                            .FALSE., return_value )
-             ENDIF
-
-             CALL netcdf4_write_attribute( 'parallel', file_id, variables(var_ind)%var_id, 'units',&
-                                           value_char=TRIM( variables(var_ind)%units ),            &
-                                           return_value=return_value )
-          ENDIF
-
-       ENDIF
-    ENDDO
-
-    nr_variables = var_ind
-
-    IF ( part_io%iam_io_pe )  THEN
-       CALL netcdf4_stop_file_header_definition( 'parallel', file_id, return_value )
-    ENDIF
-
-    CALL dop_write_axis
-
-    RETURN
-
-  CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
-     SUBROUTINE dop_write_axis
-
-        IMPLICIT NONE
-
-        INTEGER(iwp)         :: i
-        INTEGER(iwp)         :: return_value                !< Return value data_output_netcdf4 .. routines
-
-        INTEGER,DIMENSION(1) ::  bounds_origin, bounds_start, value_counts
-
-        INTEGER, POINTER, CONTIGUOUS, DIMENSION(:)   :: prt_val
-
-
-        bounds_origin = 1
-        bounds_start(1) = 1
-
-        IF ( myid == 0 )  THEN
-
-           ALLOCATE( prt_val(nr_particles_out) )
-           DO  i = 1, nr_particles_out
-              prt_val(i) = i
-           ENDDO
-           value_counts(1) = nr_particles_out
-
-           CALL netcdf4_write_variable( 'parallel', file_id, var_id%prt, bounds_start,             &
-                                        value_counts, bounds_origin, .TRUE.,                       &
-                                        values_int32_1d=prt_val, return_value=return_value)
-
-           DEALLOCATE( prt_val )
-        ENDIF
-
-        RETURN
-     END SUBROUTINE dop_write_axis
-
- END SUBROUTINE dop_netcdf_setup
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write constant variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_write_fixed_variables
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)             :: i                              !
-    INTEGER(iwp)             :: return_value                   !
-
-    INTEGER(iwp),DIMENSION(1)   :: bounds_origin, bounds_start, value_counts
-
-
-    bounds_origin(1) = 1
-    bounds_start(1)  = io_start_index
-    value_counts(1)  = io_end_index - io_start_index + 1
-
-
-    DO  i = 1, nr_fix_variables
-
-#if defined( __netcdf4 )
-       IF ( fix_variables(i)%is_integer )  THEN
-          out_buf_i = NF90_FILL_INT
-       ELSE
-          out_buf_r = NF90_FILL_REAL
-       ENDIF
-#endif
-
-       CALL dop_fill_out_buf( fix_variables(i) )
-
-       CALL dop_get_remote_particle( fix_variables(i)%is_integer )
-
-       CALL part_io%sm_node_barrier( )
-       IF ( part_io%iam_io_pe )  THEN
-          IF ( fix_variables(i)%is_integer )  THEN
-             CALL netcdf4_write_variable( 'parallel', file_id, fix_variables(i)%var_id,            &
-                                          bounds_start, value_counts, bounds_origin, .FALSE.,      &
-                                          values_int32_1d=out_buf_i, return_value=return_value)
-          ELSE
-             CALL  netcdf4_write_variable( 'parallel', file_id, fix_variables(i)%var_id,           &
-                                           bounds_start, value_counts, bounds_origin, .FALSE.,     &
-                                           values_real32_1d=out_buf_r, return_value=return_value)
-          ENDIF
-       ENDIF
-       CALL part_io%sm_node_barrier( )
-    ENDDO
-
-    RETURN
- END SUBROUTINE dop_write_fixed_variables
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_delete_particle_number
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: i                           !<
-    INTEGER(iwp) :: j                           !<
-    INTEGER(iwp) :: k                           !<
-    INTEGER(iwp) :: n                           !<
-
-!
-!-- Delete inactive particles, i.e. all particles with particle_mask == .FALSE..
-!-- Get an output particle nr of -1.
-!-- kk   Not sure if it is required here or already done in lagrangian_particle_model_mod before
-!--      this call.
-    remote_nr_particles = 0
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             DO  n = 1, prt_count(k,j,i)
-                IF ( .NOT. grid_particles(k,j,i)%particles(n)%particle_mask )  THEN
-                   grid_particles(k,j,i)%particles(n)%particle_nr = -1
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-    RETURN
- END SUBROUTINE dop_delete_particle_number
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_newly_generated_particles
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: i                           !<
-#if defined( __parallel )
-    INTEGER(iwp) :: ierr                        !< MPI error code
-#endif
-    INTEGER(iwp) :: j                           !<
-    INTEGER(iwp) :: k                           !<
-    INTEGER(iwp) :: n                           !<
-    INTEGER(iwp) :: n_all                       !< count all particles for MOD function
-    INTEGER(iwp) :: nr_new_particle             !<
-    INTEGER(iwp) :: particle_nr                 !<
-    INTEGER(iwp) :: start_new_numbering
-
-    INTEGER(iwp),DIMENSION(0:numprocs-1)     :: nr_particles_new_r
-    INTEGER(iwp),DIMENSION(0:numprocs-1)     :: nr_particles_new_s
-
-    REAL(dp)     :: fcount
-    REAL(dp)     :: finc
-
-
-!
-!-- Count Number of Newly Generated particles.
-!-- Condition for a newparticle: particle_mask = .TRUE. and particle nr of -1.
-!
-!-- For performance reasons, this subroutine may be combined later with dop_delete_particle_number.
-    nr_new_particle     = 0
-
-    IF ( pts_increment > 1 )  THEN
-       n_all = 0
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                DO  n = 1, prt_count(k,j,i)
-                   IF ( grid_particles(k,j,i)%particles(n)%particle_mask )  THEN
-                      IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 )  THEN
-                         IF ( MOD( n_all, pts_increment ) == 0 )  THEN
-                            nr_new_particle = nr_new_particle + 1
-                         ENDIF
-                         n_all = n_all + 1
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-    ELSEIF ( pts_percentage < 100.0_wp )  THEN
-       finc   = pts_percentage / 100
-       fcount = 0.0
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                DO  n = 1, prt_count(k,j,i)
-                   IF ( grid_particles(k,j,i)%particles(n)%particle_mask )  THEN
-                      IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 )  THEN
-                         fcount = fcount + finc
-                         IF ( nr_new_particle < INT( fcount ) )  THEN
-                            nr_new_particle = nr_new_particle + 1
-                         ENDIF
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ELSE
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                DO  n = 1, prt_count(k,j,i)
-                   IF ( grid_particles(k,j,i)%particles(n)%particle_mask )  THEN
-                      IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 )  THEN
-                         nr_new_particle = nr_new_particle + 1
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Determine start number of new particles on eac thread.
-    nr_particles_new_s = 0
-    nr_particles_new_s(myid) = nr_new_particle
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( nr_particles_new_s, nr_particles_new_r, SIZE( nr_particles_new_s ),        &
-                        MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-    nr_particles_new_r = nr_particles_new_s
-#endif
-!
-!-- Abortion if selected particles from new particle set would exceed particle axis of output
-!-- changed by JS.
-    IF ( ( SUM( nr_particles_new_r ) + initial_number_of_active_particles ) > nr_particles_out )   &
-    THEN
-       RETURN
-    ENDIF
-
-    start_new_numbering = initial_number_of_active_particles + 1
-
-    IF ( myid > 0)  THEN
-       DO  i = 1, numprocs-1
-          start_new_numbering = start_new_numbering + nr_particles_new_r(i-1)
-          IF ( myid == i )  EXIT
-       ENDDO
-    ENDIF
-
-    initial_number_of_active_particles = initial_number_of_active_particles +                      &
-                                         SUM( nr_particles_new_r )
-
-    dop_last_active_particle = initial_number_of_active_particles
-!
-!-- Set number of new particles
-    particle_nr         = start_new_numbering
-    nr_new_particle     = 0
-
-    IF ( pts_increment > 1 )  THEN
-       n_all = 0
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                DO  n = 1, prt_count(k,j,i)
-                   IF ( grid_particles(k,j,i)%particles(n)%particle_mask)  THEN
-                      IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 )  THEN
-                         IF ( MOD( n_all, pts_increment ) == 0 )  THEN
-                            grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr
-                            particle_nr = particle_nr + 1
-                         ELSE
-                            grid_particles(k,j,i)%particles(n)%particle_nr = -2
-                         ENDIF
-                         n_all = n_all + 1
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-    ELSEIF ( pts_percentage < 100.0_wp )  THEN
-       finc   = pts_percentage / 100
-       fcount = 0.0_wp
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                DO  n = 1, prt_count(k,j,i)
-                   IF ( grid_particles(k,j,i)%particles(n)%particle_mask )  THEN
-                      IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 )  THEN
-                         fcount = fcount + finc
-                         IF ( nr_new_particle < INT( fcount ) )  THEN
-                            grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr
-                            particle_nr = particle_nr + 1
-                            nr_new_particle = nr_new_particle + 1
-                         ELSE
-                            grid_particles(k,j,i)%particles(n)%particle_nr = -2
-                         ENDIF
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-    ELSE
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                DO  n = 1, prt_count(k,j,i)
-                   IF ( grid_particles(k,j,i)%particles(n)%particle_mask )  THEN
-                      IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 )  THEN
-                          grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr
-                          particle_nr = particle_nr + 1
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-
-
-    ENDIF
-
-
-
-    RETURN
- END SUBROUTINE dop_newly_generated_particles
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_count_remote_particles
-
-    IMPLICIT NONE
-
-#if defined( __parallel )
-    INTEGER(iwp) :: i                           !<
-    INTEGER(iwp) :: ierr                        !< MPI error code
-    INTEGER(iwp) :: j                           !<
-    INTEGER(iwp) :: k                           !<
-    INTEGER(iwp) :: n                           !<
-    INTEGER(iwp) :: iop                         !<
-    INTEGER(iwp) :: particle_nr
-    INTEGER(iwp) :: pe_nr
-    INTEGER(iwp) :: win_size
-
-    INTEGER(iwp), DIMENSION(0:numprocs-1) :: part_ind
-
-!
-!-- Count remote particles
-    remote_nr_particles = 0
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             DO  n = 1, prt_count(k,j,i)
-                particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                IF ( particle_nr > 0 )  THEN
-                   DO  iop = 0, numprocs-1                  !kk this loop has to be optimized
-!
-!--                   Although the counting is local PE based, the following if is io processor
-!--                   based because particles in MPI shared memory do not have to be transfered.
-                      IF ( particle_nr < io_start_index  .OR.  particle_nr > io_end_index )  THEN
-                         IF ( particle_nr >= mo_indices(1,iop)  .AND.                              &
-                              particle_nr <= mo_indices(2,iop) )  THEN
-                            remote_nr_particles(2,iop) = remote_nr_particles(2,iop) + 1
-                         ENDIF
-                      ENDIF
-                   ENDDO
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-    remote_nr_particles(1,0) = 0
-    DO  i = 1, numprocs-1
-       remote_nr_particles(1,i) = remote_nr_particles(1,i-1) + remote_nr_particles(2,i-1)
-    ENDDO
-
-    win_size = SUM( remote_nr_particles(2,:) )
-    CALL dop_alloc_rma_mem( transfer_buffer_i, win_size, win_rma_buf_i )
-    CALL dop_alloc_rma_mem( transfer_buffer_r, win_size, win_rma_buf_r )
-
-    CALL MPI_ALLTOALL( remote_nr_particles, 2, MPI_INTEGER, rma_particles, 2, MPI_INTEGER, comm2d, &
-                       ierr)
-
-!
-!-- The particles indices are the same for all output variables during one time step therefore, the
-!-- indices are transfered only once here.
-    part_ind = remote_nr_particles(1,:)
-    transfer_buffer_i = -9999
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-
-             DO  n = 1, prt_count(k,j,i)
-                particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                IF ( particle_nr < io_start_index  .OR.  particle_nr > io_end_index )  THEN
-                   IF ( particle_nr > 0 )  THEN
-                      pe_nr = find_pe_from_particle_nr( particle_nr )
-                      transfer_buffer_i(part_ind(pe_nr)) = particle_nr
-                      part_ind(pe_nr) = part_ind(pe_nr) + 1
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL MPI_BARRIER( MPI_COMM_WORLD, ierr )
-
-    CALL dop_get_remote_indices
-
-#endif
-    RETURN
- END SUBROUTINE dop_count_remote_particles
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Fill ouput buffer.
-!> Local variables values are copied into output buffer. Local here means local to shared memory
-!> group.
-!> Remote variable values are copied into transfer buffer this is done by all threads.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_fill_out_buf (var)
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=32) :: local_name
-
-    INTEGER(iwp) :: i                           !<
-    INTEGER(iwp) :: j                           !<
-    INTEGER(iwp) :: k                           !<
-    INTEGER(iwp) :: local_len                   !<
-    INTEGER(iwp) :: n                           !<
-    INTEGER(iwp) :: particle_nr                 !<
-    INTEGER(iwp) :: pe_nr                       !<
-    INTEGER(idp) :: pval                        !<
-
-    INTEGER(iwp), DIMENSION(0:numprocs-1) :: part_ind
-
-    TYPE(var_def), INTENT(IN)    :: var
-
-
-    part_ind = remote_nr_particles(1,:)
-    transfer_buffer_i = -9998
-!
-!-- Filling output buffer is the same for variable name and variable name_const, therefore set
-!-- local_name without _const
-    local_len = INDEX( TRIM( var%name ), '_const' )
-    IF ( local_len == 0 )  THEN
-       local_name = var%name
-    ELSE
-       local_name = var%name(1:local_len-1)
-    ENDIF
-!
-!-- In this subroutine the particles are seperated:
-!
-!-- All particles which are located in the share memory area of the respective IO thread are copied
-!-- into the output buffer. The other output particle are copied into the transfer buffer.
-    SELECT CASE ( TRIM( local_name ) )
-       CASE ( 'origin_x' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n =1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%origin_x
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%origin_x
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'origin_y' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%origin_y
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr (particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%origin_y
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'origin_z' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%origin_z
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr (particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%origin_z
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'id_low' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      pval = IBITS( grid_particles(k,j,i)%particles(n)%id,0,32 )
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_i(particle_nr) = INT(pval,4)
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_i(part_ind(pe_nr)) = INT( pval, 4 )
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'id_high' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      pval = IBITS( grid_particles(k,j,i)%particles(n)%id,32,32 )
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_i(particle_nr) = INT(pval,4)
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_i(part_ind(pe_nr)) = INT( pval, 4 )
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'particle_nr' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_i(particle_nr) = grid_particles(k,j,i)%particles(n)%particle_nr
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_i(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%particle_nr
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'class' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_i(particle_nr) = grid_particles(k,j,i)%particles(n)%class
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_i(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%class
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'group' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_i(particle_nr) = grid_particles(k,j,i)%particles(n)%group
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_i(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%group
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'x' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%x
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%x
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'y' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%y
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%y
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'z' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%z
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%z
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'speed_x' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%speed_x
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%speed_x
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'speed_y' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%speed_y
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%speed_y
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'speed_z' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%speed_z
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr (particle_nr)
-                         transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%speed_z
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'radius' )
-          DO i=nxl,nxr
-             DO j=nys,nyn
-                DO k=nzb+1,nzt
-                   DO n=1,prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%radius
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%radius
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'age' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%age
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%age
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'age_m' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%age_m
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%age_m
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'dt_sum' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%dt_sum
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%dt_sum
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE( 'e_m' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%e_m
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%e_m
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'weight_factor' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%weight_factor
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%weight_factor
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'aux1' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%aux1
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%aux1
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'aux2' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%aux2
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%aux2
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'rvar1' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%rvar1
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%rvar1
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'rvar2' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%rvar2
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr (particle_nr)
-                         transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)               &
-                                                               %particles(n)%rvar2
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       CASE ( 'rvar3' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   DO  n = 1, prt_count(k,j,i)
-                      particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr
-                      IF ( particle_nr >= io_start_index  .AND.  particle_nr <= io_end_index )  THEN
-                         out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%rvar3
-                      ELSEIF ( particle_nr > 0 )  THEN
-                         pe_nr = find_pe_from_particle_nr(particle_nr)
-                         transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)                &
-                                                              %particles(n)%rvar3
-                         part_ind(pe_nr) = part_ind(pe_nr) + 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-    END SELECT
-
-    RETURN
- END SUBROUTINE dop_fill_out_buf
-
-#if defined( __parallel )
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Get indices (displacement) of remot particles
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_get_remote_indices
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: bufsize                     !< size of remote indices array
-    INTEGER(iwp) :: i                           !<
-    INTEGER(iwp) :: ierr                        !< MPI error code
-    INTEGER(iwp) :: ind_local                   !< index in remore indices array
-    INTEGER(KIND=MPI_ADDRESS_KIND)   :: disp    !< displacement in RMA window
-
-
-    bufsize = SUM( rma_particles(2,:) )
-    ALLOCATE( remote_indices(0:bufsize) )
-    remote_indices = -1
-
-    ind_local = 0
-    CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr )
-    DO  i = 0, numprocs-1
-       IF ( rma_particles(2,i) > 0 )  THEN
-          disp = rma_particles(1,i)
-          IF ( rma_particles(2,i) > 0 )  THEN
-             CALL MPI_GET( remote_indices(ind_local), rma_particles(2,i), MPI_INTEGER, i, disp,    &
-                           rma_particles(2,i), MPI_INTEGER, win_rma_buf_i, ierr )
-             ind_local = ind_local + rma_particles(2,i)
-          ENDIF
-       ENDIF
-    ENDDO
-    CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr )
-
-    RETURN
- END SUBROUTINE dop_get_remote_indices
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_get_remote_particle (is_integer)
-
-    IMPLICIT NONE
-
-    LOGICAL, INTENT(IN)   :: is_integer
-
-
-#if defined( __parallel )
-    INTEGER(iwp) :: bufsize                     !< size of remote data array
-    INTEGER(iwp) :: i                           !<
-    INTEGER(iwp) :: ierr                        !< MPI error code
-    INTEGER(iwp) :: ind_local                   !< index in remore indices array
-    INTEGER(iwp) :: j                           !<
-    INTEGER(iwp) :: particle_nr                 !< particle number
-    INTEGER(KIND=MPI_ADDRESS_KIND)           :: disp        !< displacement in RMA window
-
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:)  :: rma_buf_i   !< buffer to receive remote data (INTEGER)
-
-    REAL(sp), ALLOCATABLE, DIMENSION(:)      :: rma_buf_r   !< buffer to receive remote data (REAL)
-
-
-    bufsize   = SUM( rma_particles(2,:) )
-    ind_local = 0
-    ALLOCATE( rma_buf_r(0:bufsize-1) )
-    ALLOCATE( rma_buf_i(0:bufsize-1) )
-
-    IF ( is_integer )  THEN
-       CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr )
-    ELSE
-       CALL MPI_WIN_FENCE( 0, win_rma_buf_r, ierr )
-    ENDIF
-    DO  i = 0, numprocs-1
-       IF ( rma_particles(2,i) > 0 )  THEN
-          IF ( is_integer )  THEN
-             disp = rma_particles(1,i)
-             CALL MPI_GET( rma_buf_i(ind_local), rma_particles(2,i), MPI_INTEGER, i, disp,         &
-                           rma_particles(2,i), MPI_INTEGER,  win_rma_buf_i, ierr )
-             ind_local = ind_local + rma_particles(2,i)
-          ELSE
-             disp = rma_particles(1,i)
-             CALL MPI_GET( rma_buf_r(ind_local), rma_particles(2,i), MPI_real, i, disp,            &
-                           rma_particles(2,i), MPI_real,  win_rma_buf_r, ierr )
-             ind_local = ind_local + rma_particles(2,i)
-          ENDIF
-       ENDIF
-    ENDDO
-    IF ( is_integer )  THEN
-       CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr )
-    ELSE
-       CALL MPI_WIN_FENCE( 0, win_rma_buf_r, ierr )
-    ENDIF
-
-    ind_local = 0
-
-    DO  i = 0, numprocs-1
-       IF ( rma_particles(2,i) > 0 )  THEN
-          IF ( is_integer )  THEN
-!
-!--          Copy data from remote PEs into output array
-             DO  j = 0, rma_particles(2,i)-1
-                particle_nr = remote_indices(ind_local)
-                out_buf_i(particle_nr) = rma_buf_i(ind_local)
-                ind_local = ind_local + 1
-             ENDDO
-          ELSE
-!
-!--          Copy data from remote PEs into output array
-             DO   j = 0, rma_particles(2,i)-1
-                particle_nr = remote_indices(ind_local)
-                out_buf_r(particle_nr) = rma_buf_r(ind_local)
-                ind_local = ind_local + 1
-             ENDDO
-          ENDIF
-       ENDIF
-    ENDDO
-
-    IF ( ALLOCATED( rma_buf_r) )  DEALLOCATE( rma_buf_r )
-    IF ( ALLOCATED( rma_buf_i) )  DEALLOCATE( rma_buf_i )
-#else
-   IF ( is_integer )  THEN
-   ENDIF
-#endif
-
-    RETURN
- END SUBROUTINE dop_get_remote_particle
-
-#if defined( __parallel )
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate memory and cread window for one-sided communication (INTEGER 1-D array)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_alloc_rma_mem_i1( array, idim1, win )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN)                             ::  idim1    !<
-    INTEGER                                              ::  ierr     !< MPI error code
-    INTEGER(iwp), INTENT(OUT)                            ::  win      !<
-    INTEGER(KIND=MPI_ADDRESS_KIND)                       ::  winsize  !< size of RMA window
-
-    INTEGER(isp), DIMENSION(:), POINTER, INTENT(INOUT)   ::  array  !<
-
-
-    winsize = MAX( idim1, 2 )
-
-    ALLOCATE( array(0:winsize-1) )
-
-    winsize = winsize * isp
-
-    CALL MPI_WIN_CREATE( array, winsize, isp, MPI_INFO_NULL, comm2d, win, ierr )
-
-    array = -1
-
-    CALL MPI_WIN_FENCE( 0, win, ierr )
-
- END SUBROUTINE dop_alloc_rma_mem_i1
-#endif
-
-#if defined( __parallel )
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate memory and cread window for one-sided communication (REAL 1-D array)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dop_alloc_rma_mem_r1( array, idim1, win )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN)       ::  idim1    !<
-    INTEGER                        ::  ierr     !< MPI error code
-    INTEGER(iwp), INTENT(OUT)      ::  win      !<
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !< size of RMA window
-
-    REAL(sp), DIMENSION(:), POINTER, INTENT(INOUT)     ::  array   !<
-
-
-    winsize = MAX( idim1, 2 )
-
-    ALLOCATE( array(0:winsize-1) )
-
-    winsize = winsize * sp
-
-    CALL MPI_WIN_CREATE( array, winsize, sp, MPI_INFO_NULL, comm2d, win, ierr )
-
-    array = -1.0_wp
-
-    CALL MPI_WIN_FENCE( 0, win, ierr )
-
- END SUBROUTINE dop_alloc_rma_mem_r1
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE deallocate_and_free
-
-    IMPLICIT NONE
-
-#if defined( __parallel )
-    INTEGER                        ::  ierr     !< MPI error code
-#endif
-
-#if defined( __parallel )
-    CALL MPI_WIN_FREE( win_rma_buf_i, ierr )
-    CALL MPI_WIN_FREE( win_rma_buf_r, ierr )
-#endif
-    IF ( ALLOCATED( remote_indices ) )  DEALLOCATE( remote_indices )
-
-    DEALLOCATE( transfer_buffer_i )
-    DEALLOCATE( transfer_buffer_r )
-
-    RETURN
-
- END SUBROUTINE deallocate_and_free
-
-
- FUNCTION find_pe_from_particle_nr( particle_nr )  RESULT( pe_nr )
-    IMPLICIT NONE
-
-    INTEGER(iwp)                   :: base              !<
-    INTEGER(iwp), INTENT(IN)       :: particle_nr
-    INTEGER(iwp)                   :: pe_nr             !<
-    INTEGER(iwp)                   :: pnr               !<
-
-    IF ( irregular_distribubtion )  THEN
-       IF ( particle_nr <= nr_particles_rest * nr_particles_pe )  THEN
-          pe_nr = ( particle_nr - 1 ) / nr_particles_pe
-       ELSE
-          base  = nr_particles_rest * nr_particles_pe
-          pnr   = particle_nr - base
-          pe_nr = ( pnr - 1 ) / ( nr_particles_pe - 1 )
-          pe_nr = pe_nr + nr_particles_rest
-       ENDIF
-    ELSE
-       pe_nr = ( particle_nr - 1 ) / nr_particles_pe
-    ENDIF
-
-
-!-- kk   This error test is to detect programming errors. For performance reasons it can be removed
-!-- kk   in the final, stable version.
-
- END FUNCTION find_pe_from_particle_nr
-
- END MODULE data_output_particle_mod
Index: palm/trunk/SOURCE/data_output_profiles.f90
===================================================================
--- palm/trunk/SOURCE/data_output_profiles.f90	(revision 4901)
+++ palm/trunk/SOURCE/data_output_profiles.f90	(revision 1)
@@ -1,34 +1,68 @@
-!> @file data_output_profiles.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE data_output_profiles
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! add variable description
+! $Log: data_output_profiles.f90,v $
+! Revision 1.18  2006/08/16 14:27:04  raasch
+! PRINT* statements for testing removed
+!
+! Revision 1.17  2006/08/08 12:45:47  raasch
+! Immediate return in case of average_count_pr = 0.
+!
+! Revision 1.16  2006/02/23 10:26:53  raasch
+! Former routine plot_1d renamed data_output_profiles
+! pl.. renamed do.., .._anz renamed .._no
+! error number argument for handle_netcdf_error
+!
+! Revision 1.15  2005/05/18 15:44:44  raasch
+! Extensions for NetCDF output
+!
+! Revision 1.14  2001/03/30 07:44:12  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.13  2001/03/02 14:21:17  letzel
+! All comments translated into English.
+!
+! Revision 1.12  2001/01/22 07:36:55  raasch
+! Module test_variables removed
+!
+! Revision 1.11  1998/07/06 12:25:36  raasch
+! + USE test_variables
+!
+! Revision 1.10  1998/04/15 11:22:02  raasch
+! zeitlich gemittelte Profile werden jetzt auch mit zeitlich gemittelten
+! Groessen normiert
+!
+! Revision 1.9  1998/04/06 14:33:53  raasch
+! Implementierung weiterer Normierungsmethoden
+!
+! Revision 1.8  1998/03/30 11:37:30  raasch
+! Erweiterungen fuer Gebietsstatistiken korrigiert
+!
+! Revision 1.7  1998/03/25 13:55:45  raasch
+! Erweiterungen fuer Gebietsstatistiken
+!
+! Revision 1.6  1998/03/09 16:24:04  raasch
+! Ueberpruefung der Normierungsfaktoren auf 0.0 und evtl.
+! Abschaltung der Normalisierung
+!
+! Revision 1.5  1998/03/03 07:58:11  raasch
+! Aufruf von flow_statistics erfolgt jetzt gegebenenfalls hier
+! Ausgabe von zeitlich gemittelten Profilen, Abspeichern von Normierungsgroessen
+!
+! Revision 1.4  1998/02/19 07:10:04  raasch
+! x-Wertebereichsermittelung nur bezueglich des auszugebenden Hoehenbereiches,
+! x-Wertebereichsermittelung auch fuer Anfangsprofile
+!
+! Revision 1.3  1998/02/04 16:09:11  raasch
+! x-Wertebereiche fuer die einzelnen Koordinatenkreuze ermitteln
+!
+! Revision 1.2  1997/09/16 06:38:20  raasch
+! style- und color-Indexberechnung korrigiert
 !
 ! Revision 1.1  1997/09/12 06:28:48  raasch
@@ -38,41 +72,22 @@
 ! Description:
 ! ------------
-!> Plot output of 1D-profiles for PROFIL
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE data_output_profiles
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  average_count_pr, averaging_interval_pr, coupling_start_time,                       &
-               dopr_n, dopr_time_count, normalizing_region, time_since_reference_point
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point
-
-    USE indices,                                                                                   &
-        ONLY:  nzb, nzt
-
-    USE kinds
-
-#if defined( __netcdf )
-    USE NETCDF
-#endif
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  id_set_pr, id_var_dopr, id_var_norm_dopr, id_var_time_pr, nc_stat,                  &
-               netcdf_handle_error, output_for_t0
-
+! Plot output of 1D-profiles for PROFIL
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE netcdf_control
     USE pegrid
-
     USE profil_parameter
-
-    USE statistics,                                                                                &
-        ONLY:  flow_statistics_called, hom, hom_sum, pr_palm, statistic_regions
+    USE statistics
 
     IMPLICIT NONE
 
 
-    INTEGER(iwp) ::  i  !< loop index
-    INTEGER(iwp) ::  sr !< statistic region index
+    INTEGER ::  i, id, ilc, ils, j, k, sr
+    REAL    ::  uxma, uxmi
+
 
 !
@@ -86,17 +101,18 @@
 !
 !-- If required, compute temporal average
-    IF ( averaging_interval_pr == 0.0_wp )  THEN
+    IF ( averaging_interval_pr == 0.0 )  THEN
        hom_sum(:,:,:) = hom(:,1,:,:)
     ELSE
        IF ( average_count_pr > 0 )  THEN
-          hom_sum = hom_sum / REAL( average_count_pr, KIND=wp )
+          hom_sum = hom_sum / REAL( average_count_pr )
        ELSE
 !
-!--       This case may happen if dt_dopr is changed in the runtime_parameters-list of a restart run
+!--       This case may happen if dt_dopr is changed in the d3par-list of
+!--       a restart run
           RETURN
        ENDIF
     ENDIF
 
-
+    
     IF ( myid == 0 )  THEN
 
@@ -106,5 +122,15 @@
 !
 !--    Open file for profile output in NetCDF format
-       CALL check_open( 104 )
+       IF ( netcdf_output )  THEN
+          CALL check_open( 104 )
+       ENDIF
+
+!
+!--    Open PROFIL-output files for each (sub-)region
+       IF ( profil_output )  THEN
+          DO  sr = 0, statistic_regions
+             CALL check_open( 40 + sr )
+          ENDDO
+       ENDIF
 
 !
@@ -113,152 +139,306 @@
 
 !
+!--    Re-set to zero the counter for the number of profiles already written
+!--    at the current output time into the respective crosses
+       cross_pnc_local = 0
+
+!
 !--    Output of initial profiles
        IF ( dopr_time_count == 1 )  THEN
 
-          IF ( .NOT. output_for_t0 ) THEN
-
+          IF ( netcdf_output )  THEN
 #if defined( __netcdf )
 !
-!--          Store initial time to time axis, but only if an output is required for at least one of
-!--          the profiles. The initial time is either 0, or, in case of a prerun for coupled
-!--          atmosphere-ocean runs, has a negative value
-             DO  i = 1, dopr_n
-                IF ( dopr_initial_index(i) /= 0 )  THEN
-                   nc_stat = NF90_PUT_VAR( id_set_pr, id_var_time_pr,                              &
-                                           (/ -coupling_start_time /),                             &
-                                           start = (/ 1 /), count = (/ 1 /) )
-                   CALL netcdf_handle_error( 'data_output_profiles', 329 )
-                   output_for_t0 = .TRUE.
-                   EXIT
-                ENDIF
-             ENDDO
+!--          Store initial time (t=0) to time axis          
+             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_time_pr, (/ 0.0 /), &
+                                     start = (/ 1 /), count = (/ 1 /) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 329 )
 
 !
 !--          Store normalization factors
-             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(1), & ! wpt0
-                                     (/ hom_sum(nzb,18,normalizing_region) /),                     &
-                                     start = (/ 1 /), count = (/ 1 /) )
-             CALL netcdf_handle_error( 'data_output_profiles', 330 )
-
-             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(2), & ! ws2
-                                     (/ hom_sum(nzb+8,pr_palm,normalizing_region)**2 /),           &
-                                     start = (/ 1 /), count = (/ 1 /) )
-             CALL netcdf_handle_error( 'data_output_profiles', 331 )
-             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(3), & ! tsw2
-                                     (/ hom_sum(nzb+3,pr_palm,normalizing_region)**2 /),           &
-                                      start = (/ 1 /), count = (/ 1 /) )
-             CALL netcdf_handle_error( 'data_output_profiles', 332 )
-             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(4), & ! ws3
-                                     (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 /),           &
-                                     start = (/ 1 /), count = (/ 1 /) )
-             CALL netcdf_handle_error( 'data_output_profiles', 333 )
-
-             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(5), & ! ws2tsw
-                                     (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 *             &
-                                        hom_sum(nzb+3,pr_palm,normalizing_region)    /),           &
-                                     start = (/ 1 /), count = (/ 1 /) )
-             CALL netcdf_handle_error( 'data_output_profiles', 334 )
-
-             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(6), & ! wstsw2
-                                     (/ hom_sum(nzb+8,pr_palm,normalizing_region) *                &
-                                        hom_sum(nzb+3,pr_palm,normalizing_region)**2 /),           &
-                                     start = (/ 1 /), count = (/ 1 /) )
-             CALL netcdf_handle_error( 'data_output_profiles', 335 )
-
-             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(7), & ! z_i
-                                     (/ hom_sum(nzb+6,pr_palm,normalizing_region) /),              &
-                                     start = (/ 1 /), count = (/ 1 /) )
-             CALL netcdf_handle_error( 'data_output_profiles', 336 )
-
+             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(1), &  ! wpt0
+                                  (/ hom_sum(nzb,18,normalizing_region) /), &
+                                     start = (/ 1 /), count = (/ 1 /) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 330 )
+
+             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(2), &  ! ws2
+                        (/ hom_sum(nzb+8,var_hom,normalizing_region)**2 /), &
+                                     start = (/ 1 /), count = (/ 1 /) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 331 )
+
+             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(3), &  ! tsw2
+                        (/ hom_sum(nzb+3,var_hom,normalizing_region)**2 /), &
+                                     start = (/ 1 /), count = (/ 1 /) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 332 )
+
+             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(4), &  ! ws3
+                        (/ hom_sum(nzb+8,var_hom,normalizing_region)**3 /), &
+                                     start = (/ 1 /), count = (/ 1 /) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 333 )
+
+             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(5), &  ! ws2tsw
+                        (/ hom_sum(nzb+8,var_hom,normalizing_region)**3 *   &
+                           hom_sum(nzb+3,var_hom,normalizing_region)    /), &
+                                     start = (/ 1 /), count = (/ 1 /) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 334 )
+
+             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(6), &  ! wstsw2
+                        (/ hom_sum(nzb+8,var_hom,normalizing_region) *      &
+                           hom_sum(nzb+3,var_hom,normalizing_region)**2 /), &
+                                     start = (/ 1 /), count = (/ 1 /) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 335 )
+
+             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(7), &  ! z_i
+                           (/ hom_sum(nzb+6,var_hom,normalizing_region) /), &
+                                     start = (/ 1 /), count = (/ 1 /) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 336 )
 #endif
-!
-!--          Loop over all 1D variables
-             DO  i = 1, dopr_n
-
-                IF ( dopr_initial_index(i) /= 0 )  THEN
-
-!
-!--                Output for the individual (sub-)regions
-                   DO  sr = 0, statistic_regions
-
+          ENDIF
+!
+!--       Loop over all 1D variables
+          DO  i = 1, dopr_n
+
+             IF ( dopr_initial_index(i) /= 0 )  THEN
+
+!
+!--             Output for the individual (sub-)regions
+                DO  sr = 0, statistic_regions
+
+                   IF ( profil_output )  THEN
+                      id = 40 + sr
+!
+!--                   Write Label-Header
+                      WRITE ( id, 100 )  TRIM( data_output_pr(i) ), '(t=0)'
+!
+!--                   Write total profile
+                      DO  k = nzb, nzt+1
+                         WRITE ( id, 101 )  hom(k,2,dopr_initial_index(i),sr), &
+                                            hom(k,1,dopr_initial_index(i),sr)
+                      ENDDO
+!
+!--                   Write separation label
+                      WRITE ( id, 102 )
+                   ENDIF
+
+                   IF ( netcdf_output )  THEN
 #if defined( __netcdf )
 !
 !--                   Write data to netcdf file
-                      nc_stat = NF90_PUT_VAR( id_set_pr, id_var_dopr(i,sr),                        &
-                                              hom(nzb:nzt+1,1,dopr_initial_index(i),sr),           &
-                                              start = (/ 1, 1 /),                                  &
+                      nc_stat = NF90_PUT_VAR( id_set_pr, id_var_dopr(i,sr),    &
+                                    hom(nzb:nzt+1,1,dopr_initial_index(i),sr), &
+                                              start = (/ 1, 1 /),              &
                                               count = (/ nzt-nzb+2, 1 /) )
-                      CALL netcdf_handle_error( 'data_output_profiles', 337 )
+                      IF ( nc_stat /= NF90_NOERR )  &
+                                                CALL handle_netcdf_error( 337 )
 #endif
-
-                   ENDDO
-
-                ENDIF   ! Initial profile available
-
-             ENDDO   ! Loop over dopr_n for initial profiles
-
-             IF ( output_for_t0 )  THEN
-                dopr_time_count = dopr_time_count + 1
-             ENDIF
-
-          END IF
+                   ENDIF
+
+                ENDDO
+
+                IF ( profil_output )  THEN
+!
+!--                Determine indices for later NAMELIST-output (s. below)
+                   profile_number = profile_number + 1
+                   j = dopr_crossindex(i)
+                   IF ( j /= 0 )  THEN
+                      cross_profile_number_count(j) = &
+                                               cross_profile_number_count(j) + 1
+                      k = cross_profile_number_count(j)
+                      cross_profile_numbers(k,j) = profile_number
+!
+!--                   Initial profiles are always drawn as solid lines in 
+!--                   anti-background colour.
+                      cross_linecolors(k,j) = 1
+                      cross_linestyles(k,j) = 0
+!
+!--                   If required, extend x-value range of the respective
+!--                   cross, provided it has not been specified in &
+!--                   check_parameters. Determination over all (sub-)regions.
+                      IF ( cross_uxmin(j) == 0.0  .AND. &
+                           cross_uxmax(j) == 0.0 )  THEN
+
+                         DO  sr = 0, statistic_regions
+
+                            uxmi = &
+                            MINVAL( hom(:nz_do1d,1,dopr_initial_index(i),sr) )
+
+                            uxma = &
+                            MAXVAL( hom(:nz_do1d,1,dopr_initial_index(i),sr) )
+!
+!--                         When the value range of the first line in the
+!--                         corresponding cross is determined, its value range
+!--                         is simply adopted.
+                            IF ( cross_uxmin_computed(j) > &
+                                 cross_uxmax_computed(j) )  THEN
+                               cross_uxmin_computed(j) = uxmi
+                               cross_uxmax_computed(j) = uxma
+                            ELSE
+                               cross_uxmin_computed(j) = &
+                                            MIN( cross_uxmin_computed(j), uxmi )
+                               cross_uxmax_computed(j) = &
+                                            MAX( cross_uxmax_computed(j), uxma )
+                            ENDIF
+
+                         ENDDO
+
+                      ENDIF
+!
+!--                   If required, determine and note normalizing factors
+                      SELECT CASE ( cross_normalized_x(j) )
+
+                         CASE ( 'ts2' )
+                            cross_normx_factor(k,j) = &
+                             ( hom_sum(nzb+3,var_hom,normalizing_region) )**2
+                         CASE ( 'wpt0' )
+                            cross_normx_factor(k,j) = &
+                             hom_sum(nzb,18,normalizing_region)
+                         CASE ( 'wsts2' )
+                            cross_normx_factor(k,j) = &
+                             hom_sum(nzb+8,var_hom,normalizing_region)  &
+                           * ( hom_sum(nzb+3,var_hom,normalizing_region) )**2
+                         CASE ( 'ws2' )
+                            cross_normx_factor(k,j) = &
+                             ( hom_sum(nzb+8,var_hom,normalizing_region) )**2
+                         CASE ( 'ws2ts' )
+                            cross_normx_factor(k,j) = &
+                           ( hom_sum(nzb+8,var_hom,normalizing_region) )**2 &
+                           * hom_sum(nzb+3,var_hom,normalizing_region)
+                         CASE ( 'ws3' )
+                            cross_normx_factor(k,j) = &
+                             ( hom_sum(nzb+8,var_hom,normalizing_region) )**3
+
+                      END SELECT
+
+                      SELECT CASE ( cross_normalized_y(j) )
+
+                         CASE ( 'z_i' )
+                            cross_normy_factor(k,j) = &
+                                    hom_sum(nzb+6,var_hom,normalizing_region)
+
+                      END SELECT
+
+!
+!--                   Check the normalizing factors for zeros and deactivate
+!--                   the normalization, if required.
+                      IF ( cross_normx_factor(k,j) == 0.0  .OR. &
+                           cross_normy_factor(k,j) == 0.0 )  THEN
+                         PRINT*,'+++ WARNING data_output_profiles: normalizi', &
+                                'ng cross ',j, ' is not possible since one o', &
+                                'f the'
+                         PRINT*,'                     normalizing factors is ',&
+                                'zero!'
+                         PRINT*,'    cross_normx_factor(',k,',',j,') = ', &
+                                cross_normx_factor(k,j)
+                         PRINT*,'    cross_normy_factor(',k,',',j,') = ', &
+                                cross_normy_factor(k,j)
+                         cross_normx_factor(k,j) = 1.0
+                         cross_normy_factor(k,j) = 1.0
+                         cross_normalized_x(j) = ' '
+                         cross_normalized_y(j) = ' '
+                      ENDIF
+
+!
+!--                   If required, extend normalized x-value range of the
+!--                   respective cross, provided it has not been specified in
+!--                   check_parameters. Determination over all (sub-)regions.
+                      IF ( cross_uxmin_normalized(j) == 0.0  .AND. &
+                           cross_uxmax_normalized(j) == 0.0 )  THEN
+
+                         DO  sr = 0, statistic_regions
+
+                            uxmi = MINVAL( hom(:nz_do1d,1,             &
+                                           dopr_initial_index(i),sr) ) / &
+                                   cross_normx_factor(k,j)
+                            uxma = MAXVAL( hom(:nz_do1d,1,             &
+                                           dopr_initial_index(i),sr) ) / &
+                                   cross_normx_factor(k,j)
+!
+!--                         When the value range of the first line in the
+!--                         corresponding cross is determined, its value range
+!--                         is simply adopted.
+                            IF ( cross_uxmin_normalized_computed(j) > &
+                                 cross_uxmax_normalized_computed(j) )  THEN
+                               cross_uxmin_normalized_computed(j) = uxmi
+                               cross_uxmax_normalized_computed(j) = uxma
+                            ELSE
+                               cross_uxmin_normalized_computed(j) = &
+                                 MIN( cross_uxmin_normalized_computed(j), uxmi )
+                               cross_uxmax_normalized_computed(j) = &
+                                 MAX( cross_uxmax_normalized_computed(j), uxma )
+                            ENDIF
+
+                         ENDDO
+
+                      ENDIF
+
+                   ENDIF   ! Index determination
+
+                ENDIF   ! profil output
+
+             ENDIF   ! Initial profile available
+
+          ENDDO   ! Loop over dopr_n for initial profiles
+
+          IF ( netcdf_output )  dopr_time_count = dopr_time_count + 1
+
        ENDIF   ! Initial profiles
 
+       IF ( netcdf_output )  THEN
 #if defined( __netcdf )
-
-!
-!--    Store time to time axis
-       nc_stat = NF90_PUT_VAR( id_set_pr, id_var_time_pr,                                          &
-                               (/ time_since_reference_point /),                                   &
-                               start = (/ dopr_time_count /),                                      &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_profiles', 338 )
-
-!
-!--    Store normalization factors
-       nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(1), &  ! wpt0
-                               (/ hom_sum(nzb,18,normalizing_region) /),                           &
-                               start = (/ dopr_time_count /),                                      &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_profiles', 339 )
-
-       nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(2), &  ! ws2
-                               (/ hom_sum(nzb+8,pr_palm,normalizing_region)**2 /),                 &
-                               start = (/ dopr_time_count /),                                      &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_profiles', 340 )
-
-       nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(3), &  ! tsw2
-                               (/ hom_sum(nzb+3,pr_palm,normalizing_region)**2 /),                 &
-                               start = (/ dopr_time_count /),                                      &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_profiles', 341 )
-
-       nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(4), &  ! ws3
-                               (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 /),                 &
-                               start = (/ dopr_time_count /),                                      &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_profiles', 342 )
-
-       nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(5), &  ! ws2tsw
-                               (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 *                   &
-                                  hom_sum(nzb+3,pr_palm,normalizing_region) /),                    &
-                               start = (/ dopr_time_count /),               &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_profiles', 343 )
-
-       nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(6), &  ! wstsw2
-                               (/ hom_sum(nzb+8,pr_palm,normalizing_region) *                      &
-                                  hom_sum(nzb+3,pr_palm,normalizing_region)**2 /),                 &
-                               start = (/ dopr_time_count /),                                      &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_profiles', 344 )
-
-       nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(7), &  ! z_i
-                               (/ hom_sum(nzb+6,pr_palm,normalizing_region) /),                    &
-                               start = (/ dopr_time_count /),                                      &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_profiles', 345 )
+!
+!--       Store time to time axis          
+          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_time_pr,     &
+                                  (/ simulated_time /),          &
+                                  start = (/ dopr_time_count /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 338 )
+
+!
+!--       Store normalization factors
+          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(1), &  ! wpt0
+                                  (/ hom_sum(nzb,18,normalizing_region) /), &
+                                  start = (/ dopr_time_count /),               &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 339 )
+
+          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(2), &  ! ws2
+                        (/ hom_sum(nzb+8,var_hom,normalizing_region)**2 /), &
+                                  start = (/ dopr_time_count /),               &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 340 )
+
+          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(3), &  ! tsw2
+                        (/ hom_sum(nzb+3,var_hom,normalizing_region)**2 /), &
+                                  start = (/ dopr_time_count /),               &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 341 )
+
+          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(4), &  ! ws3
+                        (/ hom_sum(nzb+8,var_hom,normalizing_region)**3 /), &
+                                  start = (/ dopr_time_count /),               &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 342 )
+
+          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(5), &  ! ws2tsw
+                        (/ hom_sum(nzb+8,var_hom,normalizing_region)**3 *   &
+                           hom_sum(nzb+3,var_hom,normalizing_region)    /), &
+                                  start = (/ dopr_time_count /),               &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 343 )
+
+          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(6), &  ! wstsw2
+                        (/ hom_sum(nzb+8,var_hom,normalizing_region) *      &
+                           hom_sum(nzb+3,var_hom,normalizing_region)**2 /), &
+                                  start = (/ dopr_time_count /),               &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 344 )
+
+          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(7), &  ! z_i
+                           (/ hom_sum(nzb+6,var_hom,normalizing_region) /), &
+                                  start = (/ dopr_time_count /),               &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 345 )
 #endif
+       ENDIF
 
 !
@@ -270,17 +450,171 @@
           DO  sr = 0, statistic_regions
 
+             IF ( profil_output )  THEN
+                id = 40 + sr
+!
+!--             Write Label-Header
+                WRITE ( id, 100 )  TRIM( dopr_label(i) ), simulated_time_chr
+!
+!--             Output of total profile
+                DO  k = nzb, nzt+1
+                   WRITE ( id, 101 )  hom(k,2,dopr_index(i),sr), &
+                                      hom_sum(k,dopr_index(i),sr)
+                ENDDO
+!
+!--             Write separation label
+                WRITE ( id, 102 )
+             ENDIF
+
+             IF ( netcdf_output )  THEN
 #if defined( __netcdf )
 !
-!--          Write data to netcdf file
-             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_dopr(i,sr),                                 &
-                                     hom_sum(nzb:nzt+1,dopr_index(i),sr),                          &
-                                     start = (/ 1, dopr_time_count /),                             &
-                                     count = (/ nzt-nzb+2, 1 /) )
-             CALL netcdf_handle_error( 'data_output_profiles', 346 )
+!--             Write data to netcdf file
+                nc_stat = NF90_PUT_VAR( id_set_pr, id_var_dopr(i,sr),          &
+                                        hom_sum(nzb:nzt+1,dopr_index(i),sr),&
+                                        start = (/ 1, dopr_time_count /),      &
+                                        count = (/ nzt-nzb+2, 1 /) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 346 )
 #endif
+             ENDIF
 
           ENDDO
 
-       ENDDO
+          IF ( profil_output )  THEN
+!
+!--          Determine profile number on file and note the data for later
+!--          NAMELIST output, if the respective profile is to be drawn by
+!--          PROFIL (if it shall not be drawn, the variable dopr_crossindex has
+!--          the value 0, otherwise the number of the coordinate cross)
+             profile_number = profile_number + 1
+             j = dopr_crossindex(i)
+
+             IF ( j /= 0 )  THEN
+                cross_profile_number_count(j) = cross_profile_number_count(j) +1
+                k = cross_profile_number_count(j)
+                cross_pnc_local(j)            = cross_pnc_local(j)            +1
+                cross_profile_numbers(k,j) = profile_number
+                ilc = MOD( dopr_time_count, 10 )
+                IF ( ilc == 0 )  ilc = 10
+                cross_linecolors(k,j) = linecolors(ilc)
+                ils = MOD( cross_pnc_local(j), 11 )
+                IF ( ils == 0 )  ils = 11
+                cross_linestyles(k,j) = linestyles(ils)
+!
+!--             If required, extend x-value range of the respective coordinate 
+!--             cross, provided it has not been specified in check_parameters.
+!--             Determination over all (sub-)regions.
+                IF ( cross_uxmin(j) == 0.0  .AND.  cross_uxmax(j) == 0.0 )  THEN
+
+                   DO  sr = 0, statistic_regions
+
+                      uxmi = MINVAL( hom_sum(:nz_do1d,dopr_index(i),sr) )
+                      uxma = MAXVAL( hom_sum(:nz_do1d,dopr_index(i),sr) )
+!
+!--                   When the value range of the first line in the
+!--                   corresponding cross is determined, its value range is
+!--                   simply adopted.
+                      IF ( cross_uxmin_computed(j) > cross_uxmax_computed(j) ) &
+                      THEN
+                         cross_uxmin_computed(j) = uxmi
+                         cross_uxmax_computed(j) = uxma
+                      ELSE
+                         cross_uxmin_computed(j) = &
+                                           MIN( cross_uxmin_computed(j), uxmi )
+                         cross_uxmax_computed(j) = &
+                                           MAX( cross_uxmax_computed(j), uxma )
+                      ENDIF
+
+                   ENDDO
+
+                ENDIF
+!
+!--             If required, store the normalizing factors
+                SELECT CASE ( cross_normalized_x(j) )
+
+                   CASE ( 'tsw2' )
+                      cross_normx_factor(k,j) = &
+                            ( hom_sum(nzb+11,var_hom,normalizing_region) )**2
+                   CASE ( 'wpt0' )
+                      cross_normx_factor(k,j) = &
+                              hom_sum(nzb,18,normalizing_region)
+                   CASE ( 'wstsw2' )
+                      cross_normx_factor(k,j) = &
+                              hom_sum(nzb+8,var_hom,normalizing_region)  &
+                          * ( hom_sum(nzb+11,var_hom,normalizing_region) )**2
+                   CASE ( 'ws2' )
+                      cross_normx_factor(k,j) = &
+                            ( hom_sum(nzb+8,var_hom,normalizing_region) )**2
+                   CASE ( 'ws2tsw' )
+                      cross_normx_factor(k,j) = &
+                            ( hom_sum(nzb+8,var_hom,normalizing_region) )**2&
+                            * hom_sum(nzb+11,var_hom,normalizing_region)
+                   CASE ( 'ws3' )
+                      cross_normx_factor(k,j) = &
+                            ( hom_sum(nzb+8,var_hom,normalizing_region) )**3
+
+                END SELECT
+                SELECT CASE ( cross_normalized_y(j) )
+
+                   CASE ( 'z_i' )
+                      cross_normy_factor(k,j) = &
+                                   hom_sum(nzb+6,var_hom,normalizing_region)
+
+                END SELECT
+
+!
+!--             Check the normalizing factors for zeros and deactivate the 
+!--             normalization, if required.
+                IF ( cross_normx_factor(k,j) == 0.0  .OR. &
+                     cross_normy_factor(k,j) == 0.0 )  THEN
+                   PRINT*,'+++ WARNING data_output_profiles: normalizing ',j, &
+                          ' cross is not possible since one of the'
+                   PRINT*,'                     normalizing factors is zero!'
+                   PRINT*,'    cross_normx_factor(',k,',',j,') = ', &
+                           cross_normx_factor(k,j)
+                   PRINT*,'    cross_normy_factor(',k,',',j,') = ', &
+                           cross_normy_factor(k,j)
+                   cross_normx_factor(k,j) = 1.0
+                   cross_normy_factor(k,j) = 1.0
+                   cross_normalized_x(j) = ' '
+                   cross_normalized_y(j) = ' '
+                ENDIF
+
+!
+!--             If required, extend normalized x-value range of the respective  
+!--             cross, provided it has not been specified in check_parameters.
+!--             Determination over all (sub-)regions.
+                IF ( cross_uxmin_normalized(j) == 0.0  .AND. &
+                     cross_uxmax_normalized(j) == 0.0 )  THEN
+
+                   DO  sr = 0, statistic_regions
+
+                      uxmi = MINVAL( hom(:nz_do1d,1,dopr_index(i),sr) ) / &
+                             cross_normx_factor(k,j)
+                      uxma = MAXVAL( hom(:nz_do1d,1,dopr_index(i),sr) ) / &
+                             cross_normx_factor(k,j)
+!
+!--                   When the value range of the first line in the
+!--                   corresponding cross is determined, its value range is
+!--                   simply adopted.
+                      IF ( cross_uxmin_normalized_computed(j) > &
+                           cross_uxmax_normalized_computed(j) )  THEN
+                         cross_uxmin_normalized_computed(j) = uxmi
+                         cross_uxmax_normalized_computed(j) = uxma
+                      ELSE
+                         cross_uxmin_normalized_computed(j) = &
+                                MIN( cross_uxmin_normalized_computed(j), uxmi )
+                         cross_uxmax_normalized_computed(j) = &
+                                MAX( cross_uxmax_normalized_computed(j), uxma )
+                      ENDIF
+
+                   ENDDO
+
+                ENDIF
+
+             ENDIF   ! Index determination
+
+          ENDIF   ! profil output
+
+       ENDDO   ! Loop over dopr_n
 
     ENDIF  ! Output on PE0
@@ -288,9 +622,15 @@
 !
 !-- If averaging has been done above, the summation counter must be re-set.
-    IF ( averaging_interval_pr /= 0.0_wp )  THEN
+    IF ( averaging_interval_pr /= 0.0 )  THEN
        average_count_pr = 0
     ENDIF
 
-    CALL cpu_log( log_point(15), 'data_output_profiles','stop' )
+    CALL cpu_log( log_point(15), 'data_output_profiles','stop', 'nobarrier' )
+
+!
+!-- Formats
+100 FORMAT ('#1 ',A,1X,A)
+101 FORMAT (E15.7,1X,E15.7)
+102 FORMAT ('NEXT')
 
  END SUBROUTINE data_output_profiles
Index: palm/trunk/SOURCE/data_output_ptseries.f90
===================================================================
--- palm/trunk/SOURCE/data_output_ptseries.f90	(revision 1)
+++ palm/trunk/SOURCE/data_output_ptseries.f90	(revision 1)
@@ -0,0 +1,275 @@
+ SUBROUTINE data_output_ptseries
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: data_output_ptseries.f90,v $
+! Revision 1.2  2006/08/22 13:51:13  raasch
+! Seperate output for particle groups
+!
+! Revision 1.1  2006/08/04 14:24:18  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Output of particle data timeseries in NetCDF format.
+!------------------------------------------------------------------------------!
+#if defined( __particles )
+
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE netcdf_control
+    USE particle_attributes
+    USE pegrid
+
+    IMPLICIT NONE
+
+
+    INTEGER ::  i, inum, j, n
+
+    REAL, DIMENSION(0:number_of_particle_groups,30) ::  pts_value, pts_value_l
+
+
+
+    CALL cpu_log( log_point(36), 'data_output_ptseries', 'start' )
+
+    IF ( myid == 0  .AND.  netcdf_output )  THEN
+!
+!--    Open file for time series output in NetCDF format
+       dopts_time_count = dopts_time_count + 1
+       CALL check_open( 109 )
+#if defined( __netcdf )
+!
+!--    Update the particle time series time axis
+       nc_stat = NF90_PUT_VAR( id_set_pts, id_var_time_pts,    &
+                               (/ simulated_time /),           &
+                               start = (/ dopts_time_count /), count = (/ 1 /) )
+       IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 391 )
+#endif
+
+    ENDIF
+
+    pts_value_l = 0.0
+
+!
+!-- Calculate or collect the particle time series quantities for all particles
+!-- and seperately for each particle group (if there is more than one group)
+    DO  n = 1, number_of_particles
+
+       pts_value_l(0,1)  = number_of_particles            ! total # of particles
+       pts_value_l(0,2)  = pts_value_l(0,2) + &
+                           ( particles(n)%x - particles(n)%origin_x )  ! mean x
+       pts_value_l(0,3)  = pts_value_l(0,3) + &
+                           ( particles(n)%y - particles(n)%origin_y )  ! mean y
+       pts_value_l(0,4)  = pts_value_l(0,4) + &
+                           ( particles(n)%z - particles(n)%origin_z )  ! mean z
+       pts_value_l(0,5)  = pts_value_l(0,5) + particles(n)%z ! mean z (absolute)
+       pts_value_l(0,6)  = pts_value_l(0,6) + particles(n)%speed_x     ! mean u
+       pts_value_l(0,7)  = pts_value_l(0,7) + particles(n)%speed_y     ! mean v
+       pts_value_l(0,8)  = pts_value_l(0,8) + particles(n)%speed_z     ! mean w
+       pts_value_l(0,9)  = pts_value_l(0,9) + &
+                                            particles(n)%speed_x_sgs ! mean sgsu
+       pts_value_l(0,10) = pts_value_l(0,10) + &
+                                            particles(n)%speed_y_sgs ! mean sgsv
+       pts_value_l(0,11) = pts_value_l(0,11) + &
+                                            particles(n)%speed_z_sgs ! mean sgsw
+       IF ( particles(n)%speed_z > 0.0 )  THEN
+          pts_value_l(0,12) = pts_value_l(0,12) + 1.0  ! # of upward moving prts
+          pts_value_l(0,13) = pts_value_l(0,13) + &
+                                            particles(n)%speed_z ! mean w upw.
+       ELSE
+          pts_value_l(0,14) = pts_value_l(0,14) + &
+                                            particles(n)%speed_z ! mean w down
+       ENDIF
+       pts_value_l(0,15) = number_of_particles
+       pts_value_l(0,16) = number_of_particles
+
+!
+!--    Repeat the same for the respective particle group
+       IF ( number_of_particle_groups > 1 )  THEN
+          j = particles(n)%group
+
+          pts_value_l(j,1)  = pts_value_l(j,1)  + 1
+          pts_value_l(j,2)  = pts_value_l(j,2)  + &
+                              ( particles(n)%x - particles(n)%origin_x )
+          pts_value_l(j,3)  = pts_value_l(j,3)  + &
+                              ( particles(n)%y - particles(n)%origin_y )
+          pts_value_l(j,4)  = pts_value_l(j,4)  + &
+                              ( particles(n)%z - particles(n)%origin_z )
+          pts_value_l(j,5)  = pts_value_l(j,5)  + particles(n)%z
+          pts_value_l(j,6)  = pts_value_l(j,6)  + particles(n)%speed_x
+          pts_value_l(j,7)  = pts_value_l(j,7)  + particles(n)%speed_y
+          pts_value_l(j,8)  = pts_value_l(j,8)  + particles(n)%speed_z
+          pts_value_l(j,9)  = pts_value_l(j,9)  + particles(n)%speed_x_sgs
+          pts_value_l(j,10) = pts_value_l(j,10) + particles(n)%speed_y_sgs
+          pts_value_l(j,11) = pts_value_l(j,11) + particles(n)%speed_z_sgs
+          IF ( particles(n)%speed_z > 0.0 )  THEN
+             pts_value_l(j,12) = pts_value_l(j,12) + 1.0
+             pts_value_l(j,13) = pts_value_l(j,13) + particles(n)%speed_z
+          ELSE
+             pts_value_l(j,14) = pts_value_l(j,14) + particles(n)%speed_z
+          ENDIF
+          pts_value_l(j,15) = pts_value_l(j,15) + 1.0
+          pts_value_l(j,16) = pts_value_l(j,16) + 1.0
+
+       ENDIF
+
+    ENDDO
+
+#if defined( __parallel )
+!
+!-- Sum values of the subdomains
+    inum = number_of_particle_groups + 1
+
+    CALL MPI_ALLREDUCE( pts_value_l(0,1), pts_value(0,1), 14*inum, MPI_REAL, &
+                        MPI_SUM, comm2d, ierr )
+    CALL MPI_ALLREDUCE( pts_value_l(0,15), pts_value(0,15), inum, MPI_REAL, &
+                        MPI_MAX, comm2d, ierr )
+    CALL MPI_ALLREDUCE( pts_value_l(0,16), pts_value(0,16), inum, MPI_REAL, &
+                        MPI_MIN, comm2d, ierr )
+#else
+    pts_value(:,1:16) = pts_value_l(:,1:16)
+#endif
+
+!
+!-- Normalize the above calculated quantities with the total number of
+!-- particles
+    IF ( number_of_particle_groups > 1 )  THEN
+       inum = number_of_particle_groups
+    ELSE
+       inum = 0
+    ENDIF
+
+    DO  j = 0, inum
+
+       IF ( pts_value(j,1) > 0.0 )  THEN
+
+          pts_value(j,2:14) = pts_value(j,2:14) / pts_value(j,1)
+          IF ( pts_value(j,12) > 0.0  .AND.  pts_value(j,12) < 1.0 )  THEN
+             pts_value(j,13) = pts_value(j,13) / pts_value(j,12)
+             pts_value(j,14) = pts_value(j,14) / ( 1.0 - pts_value(j,12) )
+          ELSEIF ( pts_value(j,12) == 0.0 )  THEN
+             pts_value(j,13) = -1.0
+          ELSE
+             pts_value(j,14) = -1.0
+          ENDIF
+
+       ENDIF
+
+    ENDDO
+
+!
+!-- Calculate higher order moments of particle time series quantities,
+!-- seperately for each particle group (if there is more than one group)
+    DO  n = 1, number_of_particles
+
+       pts_value_l(0,17) = pts_value_l(0,17) + ( particles(n)%x - &
+                           particles(n)%origin_x - pts_value(0,2) )**2 ! x*2
+       pts_value_l(0,18) = pts_value_l(0,18) + ( particles(n)%y - &
+                           particles(n)%origin_y - pts_value(0,3) )**2 ! y*2
+       pts_value_l(0,19) = pts_value_l(0,19) + ( particles(n)%z - &
+                           particles(n)%origin_z - pts_value(0,4) )**2 ! z*2
+       pts_value_l(0,20) = pts_value_l(0,20) + ( particles(n)%speed_x - &
+                                               pts_value(0,6) )**2     ! u*2
+       pts_value_l(0,21) = pts_value_l(0,21) + ( particles(n)%speed_y - &
+                                               pts_value(0,7) )**2     ! v*2
+       pts_value_l(0,22) = pts_value_l(0,22) + ( particles(n)%speed_z - &
+                                               pts_value(0,8) )**2     ! w*2
+       pts_value_l(0,23) = pts_value_l(0,23) + ( particles(n)%speed_x_sgs - &
+                                               pts_value(0,9) )**2     ! u"2
+       pts_value_l(0,24) = pts_value_l(0,24) + ( particles(n)%speed_y_sgs - &
+                                               pts_value(0,10) )**2    ! v"2
+       pts_value_l(0,25) = pts_value_l(0,25) + ( particles(n)%speed_z_sgs - &
+                                               pts_value(0,11) )**2    ! w"2
+!
+!--    Repeat the same for the respective particle group
+       IF ( number_of_particle_groups > 1 )  THEN
+          j = particles(n)%group
+
+          pts_value_l(j,17) = pts_value_l(j,17) + ( particles(n)%x - &
+                              particles(n)%origin_x - pts_value(j,2) )**2
+          pts_value_l(j,18) = pts_value_l(j,18) + ( particles(n)%y - &
+                              particles(n)%origin_y - pts_value(j,3) )**2
+          pts_value_l(j,19) = pts_value_l(j,19) + ( particles(n)%z - &
+                              particles(n)%origin_z - pts_value(j,4) )**2
+          pts_value_l(j,20) = pts_value_l(j,20) + ( particles(n)%speed_x - &
+                                                  pts_value(j,6) )**2
+          pts_value_l(j,21) = pts_value_l(j,21) + ( particles(n)%speed_y - &
+                                                  pts_value(j,7) )**2
+          pts_value_l(j,22) = pts_value_l(j,22) + ( particles(n)%speed_z - &
+                                                  pts_value(j,8) )**2
+          pts_value_l(j,23) = pts_value_l(j,23) + ( particles(n)%speed_x_sgs - &
+                                                  pts_value(j,9) )**2
+          pts_value_l(j,24) = pts_value_l(j,24) + ( particles(n)%speed_y_sgs - &
+                                                  pts_value(j,10) )**2
+          pts_value_l(j,25) = pts_value_l(j,25) + ( particles(n)%speed_z_sgs - &
+                                                  pts_value(j,11) )**2
+       ENDIF
+
+    ENDDO
+
+    pts_value_l(0,26) = ( number_of_particles - pts_value(0,1) / numprocs )**2
+                                                 ! variance of particle numbers
+    IF ( number_of_particle_groups > 1 )  THEN
+       DO  j = 1, number_of_particle_groups
+          pts_value_l(j,26) = ( pts_value_l(j,1) - &
+                                pts_value(j,1) / numprocs )**2
+       ENDDO
+    ENDIF
+
+#if defined( __parallel )
+!
+!-- Sum values of the subdomains
+    inum = number_of_particle_groups + 1
+
+    CALL MPI_ALLREDUCE( pts_value_l(0,17), pts_value(0,17), inum*10, MPI_REAL, &
+                        MPI_SUM, comm2d, ierr )
+#else
+    pts_value(:,17:26) = pts_value_l(:,17:26)
+#endif
+
+!
+!-- Normalize the above calculated quantities with the total number of
+!-- particles
+    IF ( number_of_particle_groups > 1 )  THEN
+       inum = number_of_particle_groups
+    ELSE
+       inum = 0
+    ENDIF
+
+    DO  j = 0, inum
+
+       IF ( pts_value(j,1) > 0.0 )  THEN
+          pts_value(j,17:25) = pts_value(j,17:25) / pts_value(j,1)
+       ENDIF
+       pts_value(j,26) = pts_value(j,26) / numprocs
+
+    ENDDO
+
+#if defined( __netcdf )
+!
+!-- Output particle time series quantities in NetCDF format
+    IF ( myid == 0  .AND.  netcdf_output )  THEN
+       DO  j = 0, inum
+          DO  i = 1, dopts_num
+             nc_stat = NF90_PUT_VAR( id_set_pts, id_var_dopts(i,j),  &
+                                     (/ pts_value(j,i) /),           &
+                                     start = (/ dopts_time_count /), &
+                                     count = (/ 1 /) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 392 )
+          ENDDO
+       ENDDO
+    ENDIF
+#endif
+
+    CALL cpu_log( log_point(36), 'data_output_ptseries','stop', 'nobarrier' )
+
+#endif
+ END SUBROUTINE data_output_ptseries
Index: palm/trunk/SOURCE/data_output_spectra.f90
===================================================================
--- palm/trunk/SOURCE/data_output_spectra.f90	(revision 4901)
+++ palm/trunk/SOURCE/data_output_spectra.f90	(revision 1)
@@ -1,35 +1,32 @@
-!> @file data_output_spectra.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
+ SUBROUTINE data_output_spectra
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! variables documented
-!
+! $Log: data_output_spectra.f90,v $
+! Revision 1.7  2006/04/11 14:56:38  raasch
+! pl_spectra renamed data_output_sp
+!
+! Revision 1.6  2006/02/23 10:29:38  raasch
+! Former routine plot_spectra renamed data_output_spectra
+! error number argument for handle_netcdf_error
+!
+! Revision 1.5  2005/05/18 15:48:29  raasch
+! Extensions for NetCDF output
+!
+! Revision 1.4  2003/03/16 09:42:42  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.3  2002/06/11 13:14:02  raasch
+! TRIM function added (needed on IBM-systems), additional translations into
+! English and further formatting
+!
+! Revision 1.2  2001/03/30  07:45:18  07:45:18  raasch (Siegfried Raasch)
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+! 
 ! Revision 1.1  2001/01/05 15:14:20  raasch
 ! Initial revision
@@ -38,40 +35,25 @@
 ! Description:
 ! ------------
-!> Writing spectra data on file, using a special format which allows
-!> plotting of these data with PROFIL-graphic-software
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE data_output_spectra
-
-#if defined( __netcdf )
-    USE control_parameters,                                                                        &
-        ONLY:  message_string, time_since_reference_point
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point
-
-    USE kinds
-
-    USE NETCDF
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  id_set_sp, id_var_time_sp, nc_stat, netcdf_handle_error
-
+! Writing spectra data on file, using a special format which allows
+! plotting of these data with PROFIL-graphic-software
+!------------------------------------------------------------------------------!
+#if defined( __spectra )
+
+    USE arrays_3d
+    USE control_parameters
+    USE cpulog
+    USE interfaces
+    USE netcdf_control
     USE pegrid
-
-    USE spectra_mod,                                                                               &
-        ONLY:  average_count_sp, averaging_interval_sp, comp_spectra_level, data_output_sp,        &
-               dosp_time_count, spectra_direction, spectrum_x, spectrum_y
+    USE spectrum
+    USE statistics
 
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  m       !< running index over spectra output
-    INTEGER(iwp) ::  pr      !< index used to assign default quantities to data output
+    INTEGER :: m, pr, cranz_x, cranz_y
+    LOGICAL :: frame_x, frame_y
 
     CALL cpu_log( log_point(31), 'data_output_spectra', 'start' )
-
-!
-!-- Check if user gave any levels for spectra to be calculated
-    IF ( comp_spectra_level(1) == 999999 )  RETURN
 
 !
@@ -81,5 +63,5 @@
 !
 !--    Open file for spectra output in NetCDF format
-       CALL check_open( 107 )
+       IF ( netcdf_output )  CALL check_open( 107 )
 
 !
@@ -87,20 +69,41 @@
        dosp_time_count = dosp_time_count + 1
 
+#if defined( __netcdf )
 !
 !--    Update the spectra time axis
-       nc_stat = NF90_PUT_VAR( id_set_sp, id_var_time_sp,                                          &
-                               (/ time_since_reference_point /),                                   &
+       nc_stat = NF90_PUT_VAR( id_set_sp, id_var_time_sp, (/ simulated_time /),&
                                start = (/ dosp_time_count /), count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_spectra', 47 )
+       IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 47 )
+#endif
+
+       IF ( profil_output )  THEN
+!
+!--       Compute RAHMEN-Parameter CRANZ for x- and y-spectra separately
+          cranz_x = 0; cranz_y = 0; frame_x = .FALSE.; frame_y = .FALSE.
+
+          m = 1
+          DO WHILE ( data_output_sp(m) /= ' ' .AND. m <= 10 )
+
+             IF ( INDEX( spectra_direction(m), 'x' ) /= 0 )  THEN
+                cranz_x = cranz_x + 1
+             ENDIF
+             IF ( INDEX( spectra_direction(m), 'y' ) /= 0 )  THEN
+                cranz_y = cranz_y + 1
+             ENDIF
+
+             m = m + 1
+
+          ENDDO
+
+       ENDIF
 
 !
 !--    If necessary, calculate time average and reset average counter
        IF ( average_count_sp == 0 )  THEN
-          message_string = 'no spectra data available'
-          CALL message( 'data_output_spectra', 'PA0186', 0, 0, 0, 6, 0 )
+          PRINT*, '+++ data_output_spectra: no spectra data available'
        ENDIF
        IF ( average_count_sp /= 1 )  THEN
-          spectrum_x = spectrum_x / REAL( average_count_sp, KIND=wp )
-          spectrum_y = spectrum_y / REAL( average_count_sp, KIND=wp )
+          spectrum_x = spectrum_x / REAL( average_count_sp )
+          spectrum_y = spectrum_y / REAL( average_count_sp )
           average_count_sp = 0
        ENDIF
@@ -122,5 +125,5 @@
                 pr = 3
 
-             CASE ( 'theta' )
+             CASE ( 'pt' )
                 pr = 4
 
@@ -128,14 +131,7 @@
                 pr = 5
 
-             CASE ( 's' )
-                pr = 6
-
              CASE DEFAULT
-!
-!--             The DEFAULT case is reached either if the parameter data_output_sp(m) contains a
-!--             wrong character string or if the user has coded a special case in the user
-!--             interface. There, the subroutine user_spectra checks which of these two conditions
-!--             applies.
-                CALL user_spectra( 'data_output', m, pr )
+                PRINT*, '+++ data_output_spectra: Spectra of ', &
+                             TRIM( data_output_sp(m) ), ' are not defined'
 
           END SELECT
@@ -143,12 +139,31 @@
 !
 !--       Output of spectra in NetCDF format
-!--       Output of x-spectra
-          IF ( INDEX( spectra_direction(m), 'x' ) /= 0 ) THEN
-             CALL output_spectra_netcdf( m, 'x' )
-          ENDIF
-!
-!--       Output of y-spectra
-          IF ( INDEX( spectra_direction(m), 'y' ) /= 0 ) THEN
-             CALL output_spectra_netcdf( m, 'y' )
+          IF ( netcdf_output )  THEN
+!
+!--          Output of x-spectra
+             IF ( INDEX( spectra_direction(m), 'x' ) /= 0 ) THEN
+                CALL output_spectra_netcdf( m, 'x' )
+             ENDIF
+!
+!--          Output of y-spectra
+             IF ( INDEX( spectra_direction(m), 'y' ) /= 0 ) THEN
+                CALL output_spectra_netcdf( m, 'y' )
+             ENDIF
+          ENDIF
+
+!
+!--       Output of spectra in profil format
+          IF ( profil_output )  THEN
+!
+!--          Output of x-spectra
+             IF ( INDEX( spectra_direction(m), 'x' ) /= 0 ) THEN
+                CALL data_output_spectra_x( m, cranz_x, pr, frame_x )
+             ENDIF
+
+!
+!--          Output of y-spectra
+             IF ( INDEX( spectra_direction(m), 'y' ) /= 0 ) THEN
+                CALL data_output_spectra_y( m, cranz_y, pr, frame_y )
+             ENDIF
           ENDIF
 
@@ -161,5 +176,5 @@
 !
 !--    Reset spectra values
-       spectrum_x = 0.0_wp; spectrum_y = 0.0_wp
+       spectrum_x = 0.0; spectrum_y = 0.0
 
     ENDIF
@@ -175,45 +190,27 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
  SUBROUTINE output_spectra_netcdf( nsp, direction )
 #if defined( __netcdf )
 
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  pi
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nx, ny
-
-    USE kinds
-
-    USE NETCDF
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  id_set_sp, id_var_dospx, id_var_dospy, nc_stat, netcdf_handle_error
-
-    USE spectra_mod,                                                                               &
-        ONLY:  dosp_time_count, n_sp_x, n_sp_y, spectrum_x, spectrum_y
-
+    USE constants
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE netcdf_control
+    USE spectrum
+    USE statistics
 
     IMPLICIT NONE
 
-    CHARACTER (LEN=1), INTENT(IN) ::  direction     !< directio of spectra evaluation
-
-    INTEGER(iwp), INTENT(IN)      ::  nsp           !< number of spectrum
-
-    INTEGER(iwp)                  ::  i             !< running index in frequency space
-    INTEGER(iwp)                  ::  k             !< running index over number of spectrum
-
-    REAL(wp)                      ::  frequency     !< wavenumber
-
-    REAL(wp), DIMENSION(nx/2)     ::  netcdf_data_x !< normalized wavenumber along x written into NetCDF file
-    REAL(wp), DIMENSION(ny/2)     ::  netcdf_data_y !< normalized wavenumber along y written into NetCDF file
+    CHARACTER (LEN=1), INTENT(IN) ::  direction
+
+    INTEGER, INTENT(IN) ::  nsp
+
+    INTEGER ::  i, k
+
+    REAL ::  frequency
+
+    REAL, DIMENSION(nx/2) ::  netcdf_data_x
+    REAL, DIMENSION(ny/2) ::  netcdf_data_y
 
 
@@ -223,12 +220,12 @@
 
           DO  i = 1, nx/2
-             frequency = 2.0_wp * pi * i / ( dx * ( nx + 1 ) )
+             frequency = 2.0 * pi * i / ( dx * ( nx + 1 ) )
              netcdf_data_x(i) = frequency * spectrum_x(i,k,nsp)
           ENDDO
 
-          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospx(nsp), netcdf_data_x,                     &
-                                  start = (/ 1, k, dosp_time_count /),                             &
+          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospx(nsp), netcdf_data_x, &
+                                  start = (/ 1, k, dosp_time_count /), &
                                   count = (/ nx/2, 1, 1 /) )
-          CALL netcdf_handle_error( 'data_output_spectra', 348 )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 348 )
 
        ENDDO
@@ -241,12 +238,12 @@
 
           DO  i = 1, ny/2
-             frequency = 2.0_wp * pi * i / ( dy * ( ny + 1 ) )
+             frequency = 2.0 * pi * i / ( dy * ( ny + 1 ) )
              netcdf_data_y(i) = frequency * spectrum_y(i,k,nsp)
           ENDDO
 
-          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospy(nsp), netcdf_data_y,                     &
-                                  start = (/ 1, k, dosp_time_count /),                             &
+          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospy(nsp), netcdf_data_y, &
+                                  start = (/ 1, k, dosp_time_count /), &
                                   count = (/ ny/2, 1, 1 /) )
-          CALL netcdf_handle_error( 'data_output_spectra', 349 )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 349 )
 
        ENDDO
@@ -256,2 +253,322 @@
 #endif
  END SUBROUTINE output_spectra_netcdf
+
+
+#if defined( __spectra )
+ SUBROUTINE data_output_spectra_x( m, cranz, pr, frame_written )
+
+    USE arrays_3d
+    USE constants
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE pegrid
+    USE singleton
+    USE spectrum
+    USE statistics
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=30) ::  atext
+    INTEGER            ::  i, j, k, m, pr
+    LOGICAL            ::  frame_written
+    REAL               ::  frequency = 0.0
+
+!
+!-- Variables needed for PROFIL-namelist
+    INTEGER                  :: cranz, labforx = 3, labfory = 3, legpos = 3, &
+                                timodex = 1
+    INTEGER, DIMENSION(1:10) :: cucol = 1, klist = 999999, lstyle = 0
+    LOGICAL                  :: datleg = .TRUE., grid = .TRUE., &
+                                lclose = .TRUE., rand = .TRUE., &
+                                swap = .TRUE., twoxa = .TRUE.,  &
+                                xlog = .TRUE., ylog = .TRUE.
+    CHARACTER (LEN=80)       :: rtext, utext, xtext = 'k in m>->1', ytext
+    REAL                     :: gwid = 0.1, rlegfak = 0.7, uxmin, uxmax, &
+                                uymin, uymax
+    REAL, DIMENSION(1:10)    :: lwid = 0.6
+    REAL, DIMENSION(10)      :: uyma, uymi
+
+    NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
+    NAMELIST /CROSS/   rand, cucol, grid, gwid, klist, labforx, labfory,      &
+                       legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
+                       uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog,  &
+                       ytext
+
+
+    rtext = '\0.5 ' // run_description_header
+
+!
+!-- Open parameter- and data-file
+    CALL check_open( 81 )
+    CALL check_open( 82 )
+
+!
+!-- Write file header,
+!-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
+!-- pr serves as an index for output of strings (axis-labels) of the
+!-- different quantities u, v, w, pt and q)
+    DO  k = 1, n_sp_x
+       IF ( k < 10 )  THEN
+          IF ( pr == 3 )  THEN
+             WRITE ( 82, 100 )  '#', k, header_char( pr ),        &
+                                INT( zw(comp_spectra_level(k)) ), &
+                                simulated_time_chr
+          ELSE
+             WRITE ( 82, 100 )  '#', k, header_char( pr ),        &
+                                INT( zu(comp_spectra_level(k)) ), &
+                                simulated_time_chr
+          ENDIF
+       ELSE
+          IF ( pr == 3 )  THEN
+             WRITE ( 82, 101 )  '#', k, header_char( pr ),        &
+                                INT( zw(comp_spectra_level(k)) ), &
+                                simulated_time_chr
+          ELSE
+             WRITE ( 82, 101 )  '#', k, header_char( pr ),        &
+                                INT( zu(comp_spectra_level(k)) ), &
+                                simulated_time_chr
+          ENDIF
+       ENDIF
+    ENDDO
+
+    IF ( .NOT. frame_written )  THEN
+       WRITE ( 81, RAHMEN )
+       frame_written = .TRUE.
+    ENDIF
+
+!
+!-- Write all data and calculate uymi and uyma. They serve to calculate
+!-- the CROSS-parameters uymin and uymax
+    uymi = 999.999; uyma = -999.999
+    DO  i = 1, nx/2
+       frequency = 2.0 * pi * i / ( dx * ( nx + 1 ) )
+       WRITE ( 82, 102 )  frequency, ( frequency * spectrum_x(i,k,m), k = 1, &
+                          n_sp_x )
+       DO  k = 1, n_sp_x
+          uymi(k) = MIN( uymi(k), frequency * spectrum_x(i,k,m) )
+          uyma(k) = MAX( uyma(k), frequency * spectrum_x(i,k,m) )
+       ENDDO
+    ENDDO
+
+!
+!-- Determine CROSS-parameters
+    cucol(1:n_sp_x)  = (/ ( k, k = 1, n_sp_x ) /)
+    lstyle(1:n_sp_x) = (/ ( lstyles(k), k = 1, n_sp_x ) /)
+
+!
+!-- Calculate klist-values from the available comp_spectra_level values
+    i = 1; k = 1
+    DO WHILE ( i <= 10  .AND.  plot_spectra_level(i) /= 999999 )
+       DO WHILE ( k <= n_sp_x  .AND. &
+                  plot_spectra_level(i) >= comp_spectra_level(k) )
+          IF ( plot_spectra_level(i) == comp_spectra_level(k) )  THEN
+             klist(i) = k + klist_x
+          ELSE
+             uymi(k) =  999.999
+             uyma(k) = -999.999
+          ENDIF
+          k = k + 1
+       ENDDO
+       i = i + 1
+    ENDDO
+    uymi(k:n_sp_x) =  999.999
+    uyma(k:n_sp_x) = -999.999
+    utext = 'x'//utext_char( pr )
+    IF ( averaging_interval_sp /= 0.0 ) THEN
+       WRITE ( atext, 104 )  averaging_interval_sp
+       utext = TRIM(utext) // ',  ' // TRIM( atext )
+    ENDIF
+    uxmin = 0.8 * 2.0 * pi        / ( dx * ( nx + 1 ) )
+    uxmax = 1.2 * 2.0 * pi * nx/2 / ( dx * ( nx + 1 ) )
+    uymin = 0.8 * MIN (  999.999, MINVAL ( uymi ) )
+    uymax = 1.2 * MAX ( -999.999, MAXVAL ( uyma ) )
+    ytext = ytext_char( pr )
+
+!
+!-- Output of CROSS-parameters
+    WRITE ( 81, CROSS )
+
+!
+!-- Increase counter by the number of profiles written in the actual block
+    klist_x = klist_x + n_sp_x
+
+!
+!-- Write end-mark
+    WRITE ( 82, 103 )
+
+!
+!-- Close parameter- and data-file
+    CALL close_file( 81 )
+    CALL close_file( 82 )
+
+!
+!-- Formats
+100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
+101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
+102 FORMAT (E15.7,10(1X,E15.7))
+103 FORMAT ('NEXT')
+104 FORMAT ('time averaged over',F7.1,' s')
+
+ END SUBROUTINE data_output_spectra_x
+
+
+ SUBROUTINE data_output_spectra_y( m, cranz, pr, frame_written )
+
+    USE arrays_3d
+    USE constants
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE pegrid
+    USE singleton
+    USE spectrum
+    USE statistics
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=30) ::  atext
+    INTEGER            :: i, j, k, m, pr
+    LOGICAL            :: frame_written
+    REAL               :: frequency = 0.0
+
+!
+!-- Variables needed for PROFIL-namelist
+    INTEGER                  :: cranz, labforx = 3, labfory = 3, legpos = 3, &
+                                timodex = 1
+    INTEGER, DIMENSION(1:10) :: cucol = 1, klist = 999999, lstyle = 0
+    LOGICAL                  :: datleg = .TRUE., grid = .TRUE., &
+                                lclose = .TRUE., rand = .TRUE., &
+                                swap = .TRUE., twoxa = .TRUE.,  &
+                                xlog = .TRUE., ylog = .TRUE.
+    CHARACTER (LEN=80)       :: rtext, utext, xtext = 'k in m>->1', ytext
+    REAL                     :: gwid = 0.1, rlegfak = 0.7, uxmin, uxmax, &
+                                uymin, uymax
+    REAL, DIMENSION(1:10)    :: lwid = 0.6
+    REAL, DIMENSION(10)      :: uyma, uymi
+
+    NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
+    NAMELIST /CROSS/   rand, cucol, grid, gwid, klist, labforx, labfory,      &
+                       legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
+                       uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog,  &
+                       ytext
+
+
+    rtext = '\0.5 ' // run_description_header
+
+!
+!-- Open parameter- and data-file
+    CALL check_open( 83 )
+    CALL check_open( 84 )
+
+!
+!-- Write file header,
+!-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
+!-- pr serves as an index for output of strings (axis-labels) of the
+!-- different quantities u, v, w, pt and q)
+    DO  k = 1, n_sp_y
+       IF ( k < 10 )  THEN
+          IF ( pr == 3 ) THEN
+             WRITE ( 84, 100 )  '#', k, header_char( pr ),        &
+                                INT( zw(comp_spectra_level(k)) ), &
+                                simulated_time_chr
+          ELSE
+             WRITE ( 84, 100 )  '#', k, header_char( pr ),        &
+                                INT( zu(comp_spectra_level(k)) ), &
+                                simulated_time_chr
+          ENDIF
+       ELSE
+          IF ( pr == 3 )  THEN
+             WRITE ( 84, 101 )  '#', k, header_char( pr ),        &
+                                INT( zw(comp_spectra_level(k)) ), &
+                                simulated_time_chr
+          ELSE
+             WRITE ( 84, 101 )  '#', k, header_char( pr ),        &
+                                INT( zu(comp_spectra_level(k)) ), &
+                                simulated_time_chr
+          ENDIF
+       ENDIF
+    ENDDO
+
+    IF ( .NOT. frame_written )  THEN
+       WRITE ( 83, RAHMEN )
+       frame_written = .TRUE.
+    ENDIF
+
+!
+!-- Write all data and calculate uymi and uyma. They serve to calculate
+!-- the CROSS-parameters uymin and uymax
+    uymi = 999.999; uyma = -999.999
+    DO  j = 1, ny/2
+       frequency = 2.0 * pi * j / ( dy * ( ny + 1 ) )
+       WRITE ( 84, 102 ) frequency, ( frequency * spectrum_y(j,k,m), &
+                                      k = 1, n_sp_y ) 
+       DO k = 1, n_sp_y
+          uymi(k) = MIN( uymi(k), frequency * spectrum_y(j,k,m) )
+          uyma(k) = MAX( uyma(k), frequency * spectrum_y(j,k,m) )
+       ENDDO
+    ENDDO
+
+!
+!-- Determine CROSS-parameters
+    cucol(1:n_sp_y)  = (/ ( k, k = 1, n_sp_y ) /)
+    lstyle(1:n_sp_y) = (/ ( lstyles(k), k = 1, n_sp_y ) /)
+
+!
+!-- Calculate klist-values from the available comp_spectra_level values
+    j = 1; k = 1
+    DO WHILE ( j <= 10  .AND.  plot_spectra_level(j) /= 999999 )
+       DO WHILE ( k <= n_sp_y  .AND. &
+                  plot_spectra_level(j) >= comp_spectra_level(k) )
+          IF ( plot_spectra_level(j) == comp_spectra_level(k) )  THEN
+             klist(j) = k + klist_y
+          ELSE
+             uymi(k) =  999.999
+             uyma(k) = -999.999
+          ENDIF
+          k = k + 1
+       ENDDO
+       j = j + 1
+    ENDDO
+    uymi(k:n_sp_y) =  999.999
+    uyma(k:n_sp_y) = -999.999
+    utext = 'y'//utext_char( pr )
+    IF ( averaging_interval_sp /= 0.0 )  THEN
+       WRITE ( atext, 104 )  averaging_interval_sp
+       utext = TRIM(utext) // ',  ' // TRIM( atext )
+    ENDIF
+    uxmin = 0.8 * 2.0 * pi        / ( dy * ( ny + 1 ) )
+    uxmax = 1.2 * 2.0 * pi * ny/2 / ( dy * ( ny + 1 ) )
+    uymin = 0.8 * MIN (  999.999, MINVAL ( uymi ) )
+    uymax = 1.2 * MAX ( -999.999, MAXVAL ( uyma ) )
+    ytext = ytext_char( pr )
+
+!
+!-- Output CROSS-parameters
+    WRITE ( 83, CROSS )
+
+!
+!-- Increase counter by the number of profiles written in the actual block
+    klist_y = klist_y + n_sp_y
+
+!
+!-- Write end-mark
+    WRITE ( 84, 103 )  
+
+!
+!-- Close parameter- and data-file
+    CALL close_file( 83 )
+    CALL close_file( 84 )
+
+!
+!-- Formats
+100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
+101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
+102 FORMAT (E15.7,10(1X,E15.7))
+103 FORMAT ('NEXT')
+104 FORMAT ('time averaged over',F7.1,' s')
+
+ END SUBROUTINE data_output_spectra_y
+#endif
Index: palm/trunk/SOURCE/data_output_tseries.f90
===================================================================
--- palm/trunk/SOURCE/data_output_tseries.f90	(revision 4901)
+++ palm/trunk/SOURCE/data_output_tseries.f90	(revision 1)
@@ -1,34 +1,52 @@
-!> @file data_output_tseries.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE data_output_tseries
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! unused format removed
+! $Log: data_output_tseries.f90,v $
+! Revision 1.13  2006/03/14 12:42:51  raasch
+! Error removed: NetCDF output only if switched on
+!
+! Revision 1.12  2006/02/23 10:30:54  raasch
+! Former routine plot_ts renamed data_output_tseries
+! error number argument for handle_netcdf_error
+! plts_anz renamed dots_n
+!
+! Revision 1.11  2005/05/18 15:50:54  raasch
+! Extensions for NetCDF output
+!
+! Revision 1.10  2003/04/16 13:10:40  raasch
+! Output of Monin Obukhov length included
+!
+! Revision 1.9  2001/03/30 07:45:34  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.8  2001/01/22 20:36:59  letzel
+! All comments translated into English.
+!
+! Revision 1.7  2001/01/22 07:42:50  raasch
+! Module test_variables removed
+!
+! Revision 1.6  1999/02/05 09:14:35  raasch
+! Erweiterung fuer Ausgabe von Upstream-Anteilen, Erweiterung von ts_value
+! auf 30 Elemente
+!
+! Revision 1.5  1998/07/06 12:26:59  raasch
+! + USE test_variables
+!
+! Revision 1.4  1998/04/15 11:22:22  raasch
+! Erweiterung der Zeitreihenausgabe auf oberflaechennahe Temperaturen und
+! Waermestroeme
+!
+! Revision 1.3  1998/03/30 11:48:03  raasch
+! Divergenzen stehen jetzt in hom
+!
+! Revision 1.2  1998/03/25 13:56:01  raasch
+! Erweiterungen fuer Gebietsstatistiken,
+! dt in dt_3d umbenannt
 !
 ! Revision 1.1  1998/03/03 08:00:13  raasch
@@ -38,36 +56,22 @@
 ! Description:
 ! ------------
-!> Time series output for PROFIL. Always all time series are stored. A selection can be applied via
-!> the PROFIL-parameters in close_file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE data_output_tseries
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  dots_time_count, time_since_reference_point
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point
-
-    USE kinds
-
-#if defined( __netcdf )
-    USE NETCDF
-#endif
-    USE netcdf_interface,                                                                          &
-        ONLY:  dots_num, id_set_ts, id_var_dots, id_var_time_ts, nc_stat, netcdf_handle_error
-
+! Time series output for PROFIL. Always all time series are stored. A selection
+! can be applied via the PROFIL-parameters in close_file.
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE netcdf_control
     USE pegrid
-
     USE profil_parameter
-
-    USE statistics,                                                                                &
-        ONLY:  flow_statistics_called, statistic_regions, ts_value
+    USE statistics
 
     IMPLICIT NONE
 
 
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  sr !<
+    INTEGER ::  file_id, i, j, sr
+    REAL    ::  ts_value(30)
 
 
@@ -84,20 +88,17 @@
 !
 !--    Open file for time series output in NetCDF format
-       CALL check_open( 105 )
-
-!--    Increment the counter for number of output times
-!--    CAUTION: The following line has to be after the call of the subroutine check_open, since
-!--             check_open resets the counter dots_time_count to 0, if a new file is opened
-       dots_time_count = dots_time_count + 1
-
+       IF ( netcdf_output )  THEN
+          dots_time_count = dots_time_count + 1
+          CALL check_open( 105 )
 #if defined( __netcdf )
 !
-!--    Update the time series time axis
-       nc_stat = NF90_PUT_VAR( id_set_ts, id_var_time_ts,                                          &
-                               (/ time_since_reference_point /),                                   &
-                               start = (/ dots_time_count /),                                      &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_tseries', 350 )
+!--       Update the time series time axis
+          nc_stat = NF90_PUT_VAR( id_set_ts, id_var_time_ts,     &
+                                  (/ simulated_time /),          &
+                                  start = (/ dots_time_count /), &
+                                  count = (/ 1 /) )
+          IF (nc_stat /= NF90_NOERR)  CALL handle_netcdf_error( 350 )
 #endif
+       ENDIF
 
 !
@@ -105,21 +106,104 @@
 !--    applicable)
        DO  sr = 0, statistic_regions
+!
+!--       Open file for time series output.
+          IF ( profil_output )  THEN
+             file_id = 50 + sr
+             CALL check_open( file_id )
+          ENDIF
+
+!
+!--       Collect and printout all time series quantities in a single line.
+          ts_value(1) = hom(nzb+4,1,var_hom,sr)     ! E
+          ts_value(2) = hom(nzb+5,1,var_hom,sr)     ! E*
+          ts_value(3) = dt_3d
+          ts_value(4) = hom(nzb,1,var_hom,sr)       ! u*
+          ts_value(5) = hom(nzb+3,1,var_hom,sr)     ! th*
+          ts_value(6) = u_max
+          ts_value(7) = v_max
+          ts_value(8) = w_max
+          ts_value(9) = hom(nzb+10,1,var_sum,sr)    ! new divergence
+          ts_value(10) = hom(nzb+9,1,var_hom,sr)    ! old Divergence
+          ts_value(11) = hom(nzb+6,1,var_hom,sr)    ! z_i(1)
+          ts_value(12) = hom(nzb+7,1,var_hom,sr)    ! z_i(2)
+          ts_value(13) = hom(nzb+8,1,var_hom,sr)    ! w*
+          ts_value(14) = hom(nzb,1,16,sr)           ! w'pt'   at k=0
+          ts_value(15) = hom(nzb+1,1,16,sr)         ! w'pt'   at k=1
+          ts_value(16) = hom(nzb+1,1,18,sr)         ! wpt     at k=1
+          ts_value(17) = hom(nzb,1,4,sr)            ! pt(0)
+          ts_value(18) = hom(nzb+1,1,4,sr)          ! pt(zp)
+          ts_value(19) = hom(nzb+9,1,var_hom-1,sr)  ! splptx
+          ts_value(20) = hom(nzb+10,1,var_hom-1,sr) ! splpty
+          ts_value(21) = hom(nzb+11,1,var_hom-1,sr) ! splptz
+          IF ( ts_value(5) /= 0.0 )  THEN
+             ts_value(22) = ts_value(4)**2 / &
+                            ( kappa * g * ts_value(5) / ts_value(18) )  ! L
+          ELSE
+             ts_value(22) = 10000.0
+          ENDIF
 
 #if defined( __netcdf )
-          DO  i = 1, dots_num
-             nc_stat = NF90_PUT_VAR( id_set_ts, id_var_dots(i,sr),                                 &
-                                     (/ ts_value(i,sr) /),                                         &
-                                     start = (/ dots_time_count /),                                &
-                                     count = (/ 1 /) )
-             CALL netcdf_handle_error( 'data_output_tseries', 351 )
-          ENDDO
+          IF ( netcdf_output )  THEN
+             DO  i = 1, dots_num
+                nc_stat = NF90_PUT_VAR( id_set_ts, id_var_dots(i,sr),  &
+                                        (/ ts_value(i) /),             &
+                                        start = (/ dots_time_count /), &
+                                        count = (/ 1 /) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 351 )
+             ENDDO
+          ENDIF
 #endif
 
-       ENDDO
+          IF ( profil_output )  THEN
+             WRITE ( file_id, 500 )  simulated_time, ts_value(1:22)
+!
+!--          y-value range of the crosses to be drawn by PROFIL
+!--          If required, enlarge them, provided they have not yet been
+!--          specified in
+!--          check_parameters
+             DO  i = 1, dots_n
+
+                j = dots_crossindex(i)
+
+                IF ( cross_ts_uymin(j) == 999.999 )  THEN
+!
+!--                When the value range of the first line in the corresponding
+!--                cross is determined, its value range is simply adopted.
+                   IF ( cross_ts_uymin_computed(j) == 999.999 ) &
+                   THEN
+                      cross_ts_uymin_computed(j) = ts_value(dots_index(i))
+                   ELSE
+                      cross_ts_uymin_computed(j) = &
+                         MIN(cross_ts_uymin_computed(j),ts_value(dots_index(i)))
+                   ENDIF
+                ENDIF
+
+                IF ( cross_ts_uymax(j) == 999.999 )  THEN
+!
+!--                When the value range of the first line in the corresponding
+!--                cross is determined, its value range is simply adopted.
+                   IF ( cross_ts_uymax_computed(j) == 999.999 ) &
+                   THEN
+                      cross_ts_uymax_computed(j) = ts_value(dots_index(i))
+                   ELSE
+                      cross_ts_uymax_computed(j) = &
+                         MAX(cross_ts_uymax_computed(j),ts_value(dots_index(i)))
+                   ENDIF
+                ENDIF
+
+             ENDDO
+
+          ENDIF
+
+       ENDDO   ! Loop of subregions.
 
     ENDIF
 
 
-    CALL cpu_log( log_point(21), 'data_output_tseries', 'stop' )
+    CALL cpu_log( log_point(21), 'data_output_tseries','stop', 'nobarrier' )
+
+!
+!-- formats
+500 FORMAT (23(E15.7,1X))
 
  END SUBROUTINE data_output_tseries
Index: palm/trunk/SOURCE/diagnostic_output_quantities_mod.f90
===================================================================
--- palm/trunk/SOURCE/diagnostic_output_quantities_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2735 +1,0 @@
-!> @file diagnostic_output_quantities_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Remove offset in terrain-following masked output
-!
-! 4866 2021-02-05 17:50:14Z suehring
-! Implemented vertical passive scalar flux
-! Implemented air temperature as diagnostic output quantity (previous commit)
-!
-! 4861 2021-02-01 10:51:45Z raasch
-! Enable 3D data output also with 64-bit precision
-!
-! 4757 2020-10-26 10:23:38Z schwenkel
-! Implement relative humidity as diagnostic output quantity
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4583 2020-06-29 12:36:47Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4560 2020-06-11 12:19:47Z suehring
-! - Bugfix in calculation of vertical momentum and scalar fluxes
-! - remove averaged output variables from PUBLIC list
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4518 2020-05-04 15:44:28Z suehring
-! * Define arrays over ghost points in order to allow for standard mpi-io treatment. By this
-!   modularization of restart-data input is possible with the module interface.
-! * Bugfix: add missing restart input of wtheta_av, wq_av, wu_av, and wv_av.
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! use statement for exchange horiz added,
-! bugfix for call of exchange horiz 2d
-!
-! 4431 2020-02-27 23:23:01Z gronemeier
-! added wspeed and wdir output; bugfix: set fill_value in case of masked output
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! added output of wu, wv, wtheta and wq to enable covariance calculation according to temporal EC
-! method
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4331 2019-12-10 18:25:02Z suehring
-! - Modularize 2-m potential temperature output
-! - New output for 10-m wind speed
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4167 2019-08-16 11:01:48Z suehring
-! Changed behaviour of masked output over surface to follow terrain and ignore buildings
-! (J.Resler, T.Gronemeier)
-!
-! 4157 2019-08-14 09:19:12Z suehring
-! Initialization restructured, in order to work also when data output during spin-up is enabled.
-!
-! 4132 2019-08-02 12:34:17Z suehring
-! Bugfix in masked data output
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to avoid runtime error
-! (Loop variable has been modified) in time_integration
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! - Add output of uu, vv, ww to enable variance calculation according temporal EC method
-! - Allocate arrays only when they are required
-! - Formatting adjustment
-! - Rename subroutines
-! - Further modularization
-!
-! 3998 2019-05-23 13:38:11Z suehring
-! Bugfix in gathering all output strings
-!
-! 3995 2019-05-22 18:59:54Z suehring
-! Avoid compiler warnings about unused variable and fix string operation which is not allowed with
-! PGI compiler
-!
-! 3994 2019-05-22 18:08:09Z suehring
-! Initial revision
-!
-! Authors:
-! --------
-! @author Farah Kanani-Suehring
-!
-!
-! Description:
-! ------------
-!> ...
-!--------------------------------------------------------------------------------------------------!
- MODULE diagnostic_output_quantities_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu,                                                                               &
-               exner,                                                                              &
-               hyp,                                                                                &
-               pt,                                                                                 &
-               q,                                                                                  &
-               s,                                                                                  &
-               u,                                                                                  &
-               v,                                                                                  &
-               w,                                                                                  &
-               zu,                                                                                 &
-               zw
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  degc_to_k,                                                                          &
-               kappa,                                                                              &
-               pi,                                                                                 &
-               magnus,                                                                             &
-               rd_d_rv
-
-    USE control_parameters,                                                                        &
-        ONLY:  current_timestep_number,                                                            &
-               data_output,                                                                        &
-               data_output_pr,                                                                     &
-               humidity,                                                                           &
-               message_string,                                                                     &
-               passive_scalar,                                                                     &
-               restart_data_format_output,                                                         &
-               varnamelength
-!
-!     USE cpulog,                                                                                   &
-!         ONLY:  cpu_log, log_point
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_2d
-
-   USE grid_variables,                                                                             &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               wall_flags_total_0
-
-    USE kinds
-
-    USE profil_parameter,                                                                          &
-        ONLY:  dopr_index
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_check_array,                                                              &
-               rrd_mpi_io,                                                                         &
-               wrd_mpi_io
-
-    USE statistics,                                                                                &
-        ONLY:  hom,                                                                                &
-               pr_palm,                                                                            &
-               rmask,                                                                              &
-               statistic_regions,                                                                  &
-               sums_l
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_def_h,                                                                         &
-               surf_lsm_h,                                                                         &
-               surf_type,                                                                          &
-               surf_usm_h
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=varnamelength), DIMENSION(500) ::  do_all = ' '
-
-    INTEGER(iwp) ::  timestep_number_at_prev_calc = 0  !< ...at previous diagnostic output calculation
-
-    LOGICAL ::  initialized_diagnostic_output_quantities = .FALSE. !< flag indicating whether output is initialized
-    LOGICAL ::  prepared_diagnostic_output_quantities = .FALSE.    !< flag indicating whether output is p
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pt_2m     !< 2-m air potential temperature
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pt_2m_av  !< averaged 2-m air potential temperature
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  uv_10m    !< horizontal wind speed at 10m
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  uv_10m_av !< averaged horizontal wind speed at 10m
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  rh     !< relative humidity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  rh_av  !< avg. relative humidity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ta     !< air temperature
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ta_av  !< avg. air temperature
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ti     !< rotation(u,v,w) aka turbulence intensity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ti_av  !< avg. rotation(u,v,w) aka turbulence intensity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  u_center     !< u at center of grid box
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  u_center_av  !< mean of u_center
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uu           !< uu
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uu_av        !< mean of uu
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wspeed       !< horizontal wind speed
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wspeed_av    !< mean of horizotal wind speed
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  v_center     !< v at center of grid box
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  v_center_av  !< mean of v_center
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vv           !< vv
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vv_av        !< mean of vv
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wdir         !< wind direction
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wdir_av      !< mean wind direction
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ww           !< ww
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ww_av        !< mean of ww
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wu           !< wu
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wu_av        !< mean of wu
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wv           !< wv
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wv_av        !< mean of wv
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wtheta       !< wtheta
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wtheta_av    !< mean of wtheta
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wq           !< wq
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wq_av        !< mean of wq
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ws           !< ws
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ws_av        !< mean of ws
-
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public variables
-    PUBLIC do_all,                                                                                 &
-           initialized_diagnostic_output_quantities,                                               &
-           prepared_diagnostic_output_quantities,                                                  &
-           timestep_number_at_prev_calc
-!
-!-- Public routines
-    PUBLIC doq_3d_data_averaging,                                                                  &
-           doq_calculate,                                                                          &
-           doq_check_data_output,                                                                  &
-           doq_check_data_output_pr,                                                               &
-           doq_define_netcdf_grid,                                                                 &
-           doq_init,                                                                               &
-           doq_output_2d,                                                                          &
-           doq_output_3d,                                                                          &
-           doq_output_mask,                                                                        &
-           doq_statistics,                                                                         &
-           doq_rrd_local,                                                                          &
-           doq_wrd_local
-
-
-    INTERFACE doq_3d_data_averaging
-       MODULE PROCEDURE doq_3d_data_averaging
-    END INTERFACE doq_3d_data_averaging
-
-    INTERFACE doq_calculate
-       MODULE PROCEDURE doq_calculate
-    END INTERFACE doq_calculate
-
-    INTERFACE doq_check_data_output
-       MODULE PROCEDURE doq_check_data_output
-    END INTERFACE doq_check_data_output
-
-    INTERFACE doq_check_data_output_pr
-       MODULE PROCEDURE doq_check_data_output_pr
-    END INTERFACE doq_check_data_output_pr
-
-    INTERFACE doq_define_netcdf_grid
-       MODULE PROCEDURE doq_define_netcdf_grid
-    END INTERFACE doq_define_netcdf_grid
-
-    INTERFACE doq_output_2d
-       MODULE PROCEDURE doq_output_2d
-    END INTERFACE doq_output_2d
-
-    INTERFACE doq_output_3d
-       MODULE PROCEDURE doq_output_3d
-    END INTERFACE doq_output_3d
-
-    INTERFACE doq_output_mask
-       MODULE PROCEDURE doq_output_mask
-    END INTERFACE doq_output_mask
-
-    INTERFACE doq_init
-       MODULE PROCEDURE doq_init
-    END INTERFACE doq_init
-
-    INTERFACE doq_statistics
-       MODULE PROCEDURE doq_statistics
-    END INTERFACE doq_statistics
-
-    INTERFACE doq_prepare
-       MODULE PROCEDURE doq_prepare
-    END INTERFACE doq_prepare
-
-   INTERFACE doq_rrd_local
-       MODULE PROCEDURE doq_rrd_local_ftn
-       MODULE PROCEDURE doq_rrd_local_mpi
-    END INTERFACE doq_rrd_local
-
-    INTERFACE doq_wrd_local
-       MODULE PROCEDURE doq_wrd_local
-    END INTERFACE doq_wrd_local
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sum up and time-average diagnostic output quantities as well as allocate the array necessary for
-!> storing the average.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_3d_data_averaging( mode, variable )
-
-    USE control_parameters,                                                                        &
-        ONLY:  average_count_3d
-
-    CHARACTER (LEN=*) ::  mode     !<
-    CHARACTER (LEN=*) ::  variable !<
-
-    INTEGER(iwp) ::  i !<
-    INTEGER(iwp) ::  j !<
-    INTEGER(iwp) ::  k !<
-
-
-    IF ( mode == 'allocate' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'rh' )
-             IF ( .NOT. ALLOCATED( rh_av ) )  THEN
-                ALLOCATE( rh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             rh_av = 0.0_wp
-
-          CASE ( 'ta' )
-             IF ( .NOT. ALLOCATED( ta_av ) )  THEN
-                ALLOCATE( ta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             ta_av = 0.0_wp
-
-          CASE ( 'ti' )
-             IF ( .NOT. ALLOCATED( ti_av ) )  THEN
-                ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             ti_av = 0.0_wp
-
-          CASE ( 'uu' )
-             IF ( .NOT. ALLOCATED( uu_av ) )  THEN
-                ALLOCATE( uu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             uu_av = 0.0_wp
-
-          CASE ( 'vv' )
-             IF ( .NOT. ALLOCATED( vv_av ) )  THEN
-                ALLOCATE( vv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             vv_av = 0.0_wp
-
-          CASE ( 'ww' )
-             IF ( .NOT. ALLOCATED( ww_av ) )  THEN
-                ALLOCATE( ww_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             ww_av = 0.0_wp
-
-           CASE ( 'wu' )
-             IF ( .NOT. ALLOCATED( wu_av ) )  THEN
-                ALLOCATE( wu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             wu_av = 0.0_wp
-
-           CASE ( 'wv' )
-             IF ( .NOT. ALLOCATED( wv_av ) )  THEN
-                ALLOCATE( wv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             wv_av = 0.0_wp
-
-           CASE ( 'wtheta' )
-             IF ( .NOT. ALLOCATED( wtheta_av ) )  THEN
-                ALLOCATE( wtheta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             wtheta_av = 0.0_wp
-
-           CASE ( 'wq' )
-             IF ( .NOT. ALLOCATED( wq_av ) )  THEN
-                ALLOCATE( wq_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             wq_av = 0.0_wp
-
-          CASE ( 'ws' )
-             IF ( .NOT. ALLOCATED( ws_av ) )  THEN
-                ALLOCATE( ws_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             ws_av = 0.0_wp
-
-          CASE ( 'theta_2m*' )
-             IF ( .NOT. ALLOCATED( pt_2m_av ) )  THEN
-                ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             pt_2m_av = 0.0_wp
-
-          CASE ( 'wspeed_10m*' )
-             IF ( .NOT. ALLOCATED( uv_10m_av ) )  THEN
-                ALLOCATE( uv_10m_av(nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             uv_10m_av = 0.0_wp
-
-          CASE ( 'wspeed' )
-             IF ( .NOT. ALLOCATED( wspeed_av ) )  THEN
-                ALLOCATE( wspeed_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             wspeed_av = 0.0_wp
-
-          CASE ( 'wdir' )
-             IF ( .NOT. ALLOCATED( u_center_av ) )  THEN
-                ALLOCATE( u_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             IF ( .NOT. ALLOCATED( v_center_av ) )  THEN
-                ALLOCATE( v_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             u_center_av = 0.0_wp
-             v_center_av = 0.0_wp
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'sum' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'rh' )
-             IF ( ALLOCATED( rh_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         rh_av(k,j,i) = rh_av(k,j,i) + rh(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ta' )
-             IF ( ALLOCATED( ta_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         ta_av(k,j,i) = ta_av(k,j,i) + ta(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ti' )
-             IF ( ALLOCATED( ti_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         ti_av(k,j,i) = ti_av(k,j,i) + ti(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'uu' )
-             IF ( ALLOCATED( uu_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         uu_av(k,j,i) = uu_av(k,j,i) + uu(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'vv' )
-             IF ( ALLOCATED( vv_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         vv_av(k,j,i) = vv_av(k,j,i) + vv(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ww' )
-             IF ( ALLOCATED( ww_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         ww_av(k,j,i) = ww_av(k,j,i) + ww(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wu' )
-             IF ( ALLOCATED( wu_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         wu_av(k,j,i) = wu_av(k,j,i) + wu(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wv' )
-             IF ( ALLOCATED( wv_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         wv_av(k,j,i) = wv_av(k,j,i) + wv(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wtheta' )
-             IF ( ALLOCATED( wtheta_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         wtheta_av(k,j,i) = wtheta_av(k,j,i) + wtheta(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wq' )
-             IF ( ALLOCATED( wq_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         wq_av(k,j,i) = wq_av(k,j,i) + wq(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ws' )
-             IF ( ALLOCATED( ws_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         ws_av(k,j,i) = ws_av(k,j,i) + ws(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'theta_2m*' )
-             IF ( ALLOCATED( pt_2m_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      pt_2m_av(j,i) = pt_2m_av(j,i) + pt_2m(j,i)
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wspeed_10m*' )
-             IF ( ALLOCATED( uv_10m_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      uv_10m_av(j,i) = uv_10m_av(j,i) + uv_10m(j,i)
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wspeed' )
-            IF ( ALLOCATED( wspeed_av ) )  THEN
-               DO  i = nxl, nxr
-                  DO  j = nys, nyn
-                     DO  k = nzb, nzt+1
-                         wspeed_av(k,j,i) = wspeed_av(k,j,i) + wspeed(k,j,i)
-                     ENDDO
-                  ENDDO
-               ENDDO
-            ENDIF
-
-          CASE ( 'wdir' )
-             IF ( ALLOCATED( u_center_av )  .AND.  ALLOCATED( v_center_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                        u_center_av(k,j,i) = u_center_av(k,j,i) + u_center(k,j,i)
-                        v_center_av(k,j,i) = v_center_av(k,j,i) + v_center(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'average' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'rh' )
-             IF ( ALLOCATED( rh_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         rh_av(k,j,i) = rh_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ta' )
-             IF ( ALLOCATED( ta_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         ta_av(k,j,i) = ta_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ti' )
-             IF ( ALLOCATED( ti_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         ti_av(k,j,i) = ti_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'uu' )
-             IF ( ALLOCATED( uu_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         uu_av(k,j,i) = uu_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'vv' )
-             IF ( ALLOCATED( vv_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         vv_av(k,j,i) = vv_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ww' )
-             IF ( ALLOCATED( ww_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         ww_av(k,j,i) = ww_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wu' )
-             IF ( ALLOCATED( wu_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         wu_av(k,j,i) = wu_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wv' )
-             IF ( ALLOCATED( wv_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         wv_av(k,j,i) = wv_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wtheta' )
-             IF ( ALLOCATED( wtheta_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         wtheta_av(k,j,i) = wtheta_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wq' )
-             IF ( ALLOCATED( wq_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         wq_av(k,j,i) = wq_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ws' )
-             IF ( ALLOCATED( ws_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         ws_av(k,j,i) = ws_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-         CASE ( 'theta_2m*' )
-            IF ( ALLOCATED( pt_2m_av ) )  THEN
-               DO  i = nxlg, nxrg
-                  DO  j = nysg, nyng
-                     pt_2m_av(j,i) = pt_2m_av(j,i) / REAL( average_count_3d, KIND=wp )
-                  ENDDO
-               ENDDO
-               CALL exchange_horiz_2d( pt_2m_av )
-            ENDIF
-
-         CASE ( 'wspeed_10m*' )
-            IF ( ALLOCATED( uv_10m_av ) )  THEN
-               DO  i = nxlg, nxrg
-                  DO  j = nysg, nyng
-                     uv_10m_av(j,i) = uv_10m_av(j,i) / REAL( average_count_3d, KIND=wp )
-                  ENDDO
-               ENDDO
-               CALL exchange_horiz_2d( uv_10m_av )
-            ENDIF
-
-         CASE ( 'wspeed' )
-             IF ( ALLOCATED( wspeed_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         wspeed_av(k,j,i) = wspeed_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'wdir' )
-             IF ( ALLOCATED( u_center_av )  .AND.  ALLOCATED( v_center_av ) )  THEN
-
-                IF ( .NOT. ALLOCATED( wdir_av ) )  THEN
-                   ALLOCATE( wdir_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                wdir_av = 0.0_wp
-
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         u_center_av(k,j,i) = u_center_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                         v_center_av(k,j,i) = v_center_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                         wdir_av(k,j,i) = ATAN2( u_center_av(k,j,i), v_center_av(k,j,i) )          &
-                                          / pi * 180.0_wp + 180.0_wp
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-       END SELECT
-
-    ENDIF
-
-
- END SUBROUTINE doq_3d_data_averaging
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output for diagnostic output
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_check_data_output( var, unit, i, ilen, k )
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  unit  !<
-    CHARACTER (LEN=*) ::  var   !<
-
-    INTEGER(iwp), OPTIONAL, INTENT(IN) ::  i     !< Current element of data_output
-    INTEGER(iwp), OPTIONAL, INTENT(IN) ::  ilen  !< Length of current entry in data_output
-    INTEGER(iwp), OPTIONAL, INTENT(IN) ::  k     !< Output is xy mode? 0 = no, 1 = yes
-
-
-    SELECT CASE ( TRIM( var ) )
-
-       CASE ( 'rh' )
-          unit = '%'
-
-       CASE ( 'ta' )
-          unit = 'degree_C'
-
-       CASE ( 'ti' )
-          unit = '1/s'
-
-       CASE ( 'uu' )
-          unit = 'm2/s2'
-
-       CASE ( 'vv' )
-          unit = 'm2/s2'
-
-       CASE ( 'ww' )
-          unit = 'm2/s2'
-
-       CASE ( 'wu' )
-          unit = 'm2/s2'
-
-       CASE ( 'wv' )
-          unit = 'm2/s2'
-
-       CASE ( 'wtheta' )
-          unit = 'Km/s'
-
-       CASE ( 'wq' )
-          unit = 'm/s'
-
-       CASE ( 'ws' )
-          IF ( .NOT.  passive_scalar )  THEN
-             message_string = 'data_output = ' // TRIM( var ) //                                   &
-                              ' is not implemented for passive_scalar = .FALSE.'
-             CALL message( 'diagnostic_output', 'PA0093', 1, 2, 0, 6, 0 )
-          ENDIF
-          unit = 'm/s'
-
-       CASE ( 'wspeed' )
-          unit = 'm/s'
-
-       CASE ( 'wdir' )
-          unit = 'degree'
-!
-!--    Treat horizotal cross-section output quanatities
-       CASE ( 'theta_2m*', 'wspeed_10m*' )
-!
-!--       Check if output quantity is _xy only.
-          IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
-             message_string = 'illegal value for data_output: "' //                                &
-                              TRIM( var ) // '" & only 2d-horizontal ' //                          &
-                              'cross sections are allowed for this value'
-             CALL message( 'diagnostic_output', 'PA0111', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( TRIM( var ) == 'theta_2m*'   )  unit = 'K'
-          IF ( TRIM( var ) == 'wspeed_10m*' )  unit = 'm/s'
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE doq_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the unit of user defined profile output quantities. For those variables not recognized by the
-!> user, the parameter unit is set to "illegal", which tells the calling routine that the
-!> output variable is not defined and leads to a program abort.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-    CHARACTER (LEN=*) ::  unit      !<
-    CHARACTER (LEN=*) ::  variable  !<
-    CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
-
-    INTEGER(iwp) ::  pr_index       !<
-    INTEGER(iwp) ::  var_count      !<
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'rh' )
-          IF ( .NOT.  humidity )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) //       &
-                              ' requires humidity'
-             CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
-          ENDIF
-          pr_index = 130
-          dopr_index(var_count) = pr_index
-          dopr_unit     = '%'
-          unit = dopr_unit
-          hom(:,2,pr_index,:)  = SPREAD( zu, 2, statistic_regions+1 )
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE doq_check_data_output_pr
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining appropriate grid for netcdf variables.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*), INTENT(IN)  ::  variable    !<
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_x      !<
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y      !<
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z      !<
-
-    LOGICAL, INTENT(OUT)           ::  found       !<
-
-
-    found  = .TRUE.
-
-    SELECT CASE ( TRIM( variable ) )
-!
-!--    s grid
-       CASE ( 'rh', 'rh_xy', 'rh_xz', 'rh_yz',                                                     &
-              'ta', 'ta_xy', 'ta_xz', 'ta_yz',                                                     &
-              'ti', 'ti_xy', 'ti_xz', 'ti_yz',                                                     &
-              'wspeed', 'wspeed_xy', 'wspeed_xz', 'wspeed_yz',                                     &
-              'wdir', 'wdir_xy', 'wdir_xz', 'wdir_yz' )
-
-          grid_x = 'x'
-          grid_y = 'y'
-          grid_z = 'zu'
-!
-!--    s grid surface variables
-       CASE ( 'theta_2m*_xy', 'wspeed_10m*' )
-
-          grid_x = 'x'
-          grid_y = 'y'
-          grid_z = 'zu'
-!
-!--    u grid
-       CASE ( 'uu', 'uu_xy', 'uu_xz', 'uu_yz' )
-
-          grid_x = 'xu'
-          grid_y = 'y'
-          grid_z = 'zu'
-!
-!--    v grid
-       CASE ( 'vv', 'vv_xy', 'vv_xz', 'vv_yz'  )
-
-          grid_x = 'x'
-          grid_y = 'yv'
-          grid_z = 'zu'
-!
-!--    w grid
-       CASE ( 'ww', 'ww_xy', 'ww_xz', 'ww_yz',                                                     &
-              'wu', 'wu_xy', 'wu_xz', 'wu_yz',                                                     &
-              'wv', 'wv_xy', 'wv_xz', 'wv_yz',                                                     &
-              'wtheta', 'wtheta_xy', 'wtheta_xz', 'wtheta_yz',                                     &
-              'wq', 'wq_xy', 'wq_xz', 'wq_yz',                                                     &
-              'ws', 'ws_xy', 'ws_xz', 'ws_yz' )
-
-          grid_x = 'x'
-          grid_y = 'y'
-          grid_z = 'zw'
-
-       CASE DEFAULT
-          found  = .FALSE.
-          grid_x = 'none'
-          grid_y = 'none'
-          grid_z = 'none'
-
-    END SELECT
-
-
- END SUBROUTINE doq_define_netcdf_grid
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 2D output variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do,       &
-                           fill_value )
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  grid     !<
-    CHARACTER (LEN=*) ::  mode     !<
-    CHARACTER (LEN=*) ::  variable !<
-
-    INTEGER(iwp) ::  av       !< value indicating averaged or non-averaged output
-    INTEGER(iwp) ::  flag_nr  !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
-    INTEGER(iwp) ::  i        !< grid index x-direction
-    INTEGER(iwp) ::  j        !< grid index y-direction
-    INTEGER(iwp) ::  k        !< grid index z-direction
-    INTEGER(iwp) ::  nzb_do   !<
-    INTEGER(iwp) ::  nzt_do   !<
-
-    LOGICAL ::  found             !< true if variable is in list
-    LOGICAL ::  resorted          !< true if array is resorted
-    LOGICAL ::  two_d             !< flag parameter that indicates 2D variables (horizontal cross sections)
-
-    REAL(wp) ::  fill_value       !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
-    REAL(wp), DIMENSION(:,:,:), POINTER ::                 to_be_resorted  !< points to array which needs to be resorted for output
-
-
-    flag_nr  = 0
-    found    = .TRUE.
-    resorted = .FALSE.
-    two_d    = .FALSE.
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'rh_xy', 'rh_xz', 'rh_yz' )
-           IF ( av == 0 )  THEN
-              to_be_resorted => rh
-           ELSE
-              IF ( .NOT. ALLOCATED( rh_av ) )  THEN
-                 ALLOCATE( rh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                 rh_av = REAL( fill_value, KIND = wp )
-              ENDIF
-              to_be_resorted => rh_av
-           ENDIF
-           flag_nr = 0
-
-           IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE ( 'ta_xy', 'ta_xz', 'ta_yz' )
-           IF ( av == 0 )  THEN
-              to_be_resorted => ta
-           ELSE
-              IF ( .NOT. ALLOCATED( ta_av ) )  THEN
-                 ALLOCATE( ta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                 ta_av = REAL( fill_value, KIND = wp )
-              ENDIF
-              to_be_resorted => ta_av
-           ENDIF
-           flag_nr = 0
-
-           IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE ( 'ti_xy', 'ti_xz', 'ti_yz' )
-           IF ( av == 0 )  THEN
-              to_be_resorted => ti
-           ELSE
-              IF ( .NOT. ALLOCATED( ti_av ) )  THEN
-                 ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                 ti_av = REAL( fill_value, KIND = wp )
-              ENDIF
-              to_be_resorted => ti_av
-           ENDIF
-           flag_nr = 0
-
-           IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE ( 'uu_xy', 'uu_xz', 'uu_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => uu
-          ELSE
-             IF ( .NOT. ALLOCATED( uu_av ) )  THEN
-                ALLOCATE( uu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                uu_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => uu_av
-          ENDIF
-          flag_nr = 1
-
-          IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE ( 'vv_xy', 'vv_xz', 'vv_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => vv
-          ELSE
-             IF ( .NOT. ALLOCATED( vv_av ) )  THEN
-                ALLOCATE( vv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                vv_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => vv_av
-          ENDIF
-          flag_nr = 2
-
-          IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE ( 'ww_xy', 'ww_xz', 'ww_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ww
-          ELSE
-             IF ( .NOT. ALLOCATED( ww_av ) )  THEN
-                ALLOCATE( ww_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ww_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ww_av
-          ENDIF
-          flag_nr = 3
-
-          IF ( mode == 'xy' )  grid = 'zw'
-
-       CASE ( 'wu_xy', 'wu_xz', 'wu_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wu
-          ELSE
-             IF ( .NOT. ALLOCATED( wu_av ) )  THEN
-                ALLOCATE( wu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wu_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wu_av
-          ENDIF
-          flag_nr = 0
-
-          IF ( mode == 'xy' )  grid = 'zw'
-
-       CASE ( 'wv_xy', 'wv_xz', 'wv_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wv
-          ELSE
-             IF ( .NOT. ALLOCATED( wv_av ) )  THEN
-                ALLOCATE( wv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wv_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wv_av
-          ENDIF
-          flag_nr = 0
-
-          IF ( mode == 'xy' )  grid = 'zw'
-
-       CASE ( 'wtheta_xy', 'wtheta_xz', 'wtheta_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wtheta
-          ELSE
-             IF ( .NOT. ALLOCATED( wtheta_av ) )  THEN
-                ALLOCATE( wtheta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wtheta_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wtheta_av
-          ENDIF
-          flag_nr = 0
-
-          IF ( mode == 'xy' )  grid = 'zw'
-
-       CASE ( 'wq_xy', 'wq_xz', 'wq_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wq
-          ELSE
-             IF ( .NOT. ALLOCATED( wq_av ) )  THEN
-                ALLOCATE( wq_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wq_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wq_av
-          ENDIF
-          flag_nr = 0
-
-          IF ( mode == 'xy' )  grid = 'zw'
-
-       CASE ( 'ws_xy', 'ws_xz', 'ws_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ws
-          ELSE
-             IF ( .NOT. ALLOCATED( ws_av ) )  THEN
-                ALLOCATE( ws_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ws_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ws_av
-          ENDIF
-          flag_nr = 0
-
-          IF ( mode == 'xy' )  grid = 'zw'
-
-       CASE ( 'theta_2m*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = pt_2m(j,i)
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( pt_2m_av ) )  THEN
-                ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
-                pt_2m_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = pt_2m_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-          resorted = .TRUE.
-          two_d    = .TRUE.
-          grid     = 'zu1'
-
-       CASE ( 'wspeed_10m*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = uv_10m(j,i)
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( uv_10m_av ) )  THEN
-                ALLOCATE( uv_10m_av(nysg:nyng,nxlg:nxrg) )
-                uv_10m_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = uv_10m_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-          resorted = .TRUE.
-          two_d    = .TRUE.
-          grid     = 'zu1'
-
-       CASE ( 'wspeed_xy', 'wspeed_xz', 'wspeed_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wspeed
-          ELSE
-             IF ( .NOT. ALLOCATED( wspeed_av ) )  THEN
-                ALLOCATE( wspeed_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wspeed_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wspeed_av
-          ENDIF
-          flag_nr = 0
-
-          IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE ( 'wdir_xy', 'wdir_xz', 'wdir_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wdir
-          ELSE
-             IF ( .NOT. ALLOCATED( wdir_av ) )  THEN
-                ALLOCATE( wdir_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wdir_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wdir_av
-          ENDIF
-          flag_nr = 0
-
-          IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE DEFAULT
-          found = .FALSE.
-          grid  = 'none'
-
-    END SELECT
-
-    IF ( found  .AND.  .NOT. resorted )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_do, nzt_do
-                local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),                                    &
-                                         REAL( fill_value, KIND = wp ),                            &
-                                         BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE doq_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 3D output variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  variable !<
-
-    INTEGER(iwp) ::  av       !< index indicating averaged or instantaneous output
-    INTEGER(iwp) ::  flag_nr  !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
-    INTEGER(iwp) ::  i        !< index variable along x-direction
-    INTEGER(iwp) ::  j        !< index variable along y-direction
-    INTEGER(iwp) ::  k        !< index variable along z-direction
-    INTEGER(iwp) ::  nzb_do   !< lower limit of the data output (usually 0)
-    INTEGER(iwp) ::  nzt_do   !< vertical upper limit of the data output (usually nz_do3d)
-
-    LOGICAL ::  found             !< true if variable is in list
-    LOGICAL ::  resorted          !< true if array is resorted
-
-    REAL(wp) ::  fill_value       !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf        !<
-    REAL(wp), DIMENSION(:,:,:), POINTER ::                 to_be_resorted  !< points to array which needs to be resorted for output
-
-
-    flag_nr  = 0
-    found    = .TRUE.
-    resorted = .FALSE.
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'rh' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rh
-          ELSE
-             IF ( .NOT. ALLOCATED( rh ) )  THEN
-                ALLOCATE( rh(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                rh = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => rh
-          ENDIF
-          flag_nr = 0
-
-       CASE ( 'ta' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ta
-          ELSE
-             IF ( .NOT. ALLOCATED( ta ) )  THEN
-                ALLOCATE( ta(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ta = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ta
-          ENDIF
-          flag_nr = 0
-
-       CASE ( 'ti' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ti
-          ELSE
-             IF ( .NOT. ALLOCATED( ti_av ) )  THEN
-                ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ti_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ti_av
-          ENDIF
-          flag_nr = 0
-
-       CASE ( 'uu' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => uu
-          ELSE
-             IF ( .NOT. ALLOCATED( uu_av ) )  THEN
-                ALLOCATE( uu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                uu_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => uu_av
-          ENDIF
-          flag_nr = 1
-
-       CASE ( 'vv' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => vv
-          ELSE
-             IF ( .NOT. ALLOCATED( vv_av ) )  THEN
-                ALLOCATE( vv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                vv_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => vv_av
-          ENDIF
-          flag_nr = 2
-
-       CASE ( 'ww' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ww
-          ELSE
-             IF ( .NOT. ALLOCATED( ww_av ) )  THEN
-                ALLOCATE( ww_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ww_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ww_av
-          ENDIF
-          flag_nr = 3
-
-       CASE ( 'wu' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wu
-          ELSE
-             IF ( .NOT. ALLOCATED( wu_av ) )  THEN
-                ALLOCATE( wu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wu_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wu_av
-          ENDIF
-          flag_nr = 0
-
-       CASE ( 'wv' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wv
-          ELSE
-             IF ( .NOT. ALLOCATED( wv_av ) )  THEN
-                ALLOCATE( wv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wv_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wv_av
-          ENDIF
-          flag_nr = 0
-
-       CASE ( 'wtheta' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wtheta
-          ELSE
-             IF ( .NOT. ALLOCATED( wtheta_av ) )  THEN
-                ALLOCATE( wtheta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wtheta_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wtheta_av
-          ENDIF
-          flag_nr = 0
-
-       CASE ( 'wq' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wq
-          ELSE
-             IF ( .NOT. ALLOCATED( wq_av ) )  THEN
-                ALLOCATE( wq_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wq_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wq_av
-          ENDIF
-          flag_nr = 0
-
-       CASE ( 'ws' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ws
-          ELSE
-             IF ( .NOT. ALLOCATED( ws_av ) )  THEN
-                ALLOCATE( ws_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ws_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => ws_av
-          ENDIF
-          flag_nr = 0
-
-       CASE ( 'wspeed' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wspeed
-          ELSE
-             IF ( .NOT. ALLOCATED( wspeed_av ) )  THEN
-                ALLOCATE( wspeed_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wspeed_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wspeed_av
-          ENDIF
-          flag_nr = 0
-
-       CASE ( 'wdir' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wdir
-          ELSE
-             IF ( .NOT. ALLOCATED( wdir_av ) )  THEN
-                ALLOCATE( wdir_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wdir_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => wdir_av
-          ENDIF
-          flag_nr = 0
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
-    IF ( found  .AND.  .NOT. resorted )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_do, nzt_do
-                local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),                                    &
-                                         REAL( fill_value, KIND = wp ),                            &
-                                         BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE doq_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with indices
-!> (i,j,k) for masked data output.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_output_mask( av, variable, found, local_pf, mid )
-
-    USE control_parameters
-
-    USE indices
-
-    IMPLICIT NONE
-
-    REAL(wp), PARAMETER   ::  fill_value = -9999.0_wp       !< value for the _FillValue attribute
-
-    CHARACTER (LEN=*) ::  variable   !<
-    CHARACTER (LEN=5) ::  grid       !< flag to distinquish between staggered grids
-
-    INTEGER(iwp) ::  av              !< index indicating averaged or instantaneous output
-    INTEGER(iwp) ::  flag_nr         !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
-    INTEGER(iwp) ::  i               !< index variable along x-direction
-    INTEGER(iwp) ::  j               !< index variable along y-direction
-    INTEGER(iwp) ::  k               !< index variable along z-direction
-    INTEGER(iwp) ::  im              !< loop index for masked variables
-    INTEGER(iwp) ::  jm              !< loop index for masked variables
-    INTEGER(iwp) ::  kk              !< masked output index variable along z-direction
-    INTEGER(iwp) ::  mid             !< masked output running index
-    INTEGER(iwp) ::  ktt             !< k index of highest horizontal surface
-
-    LOGICAL      ::  found           !< true if variable is in list
-    LOGICAL      ::  resorted        !< true if array is resorted
-
-    REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  local_pf   !<
-
-    REAL(wp), DIMENSION(:,:,:), POINTER  ::  to_be_resorted  !< points to array which needs to be resorted for output
-
-
-    flag_nr  = 0
-    found    = .TRUE.
-    resorted = .FALSE.
-    grid     = 's'
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'rh' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rh
-          ELSE
-             to_be_resorted => rh_av
-          ENDIF
-          grid = 's'
-          flag_nr = 0
-
-       CASE ( 'ta' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ta
-          ELSE
-             to_be_resorted => ta_av
-          ENDIF
-          grid = 's'
-          flag_nr = 0
-
-       CASE ( 'ti' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ti
-          ELSE
-             to_be_resorted => ti_av
-          ENDIF
-          grid = 's'
-          flag_nr = 0
-
-       CASE ( 'uu' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => uu
-          ELSE
-             to_be_resorted => uu_av
-          ENDIF
-          grid = 'u'
-          flag_nr = 1
-
-       CASE ( 'vv' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => vv
-          ELSE
-             to_be_resorted => vv_av
-          ENDIF
-          grid = 'v'
-          flag_nr = 2
-
-       CASE ( 'ww' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ww
-          ELSE
-             to_be_resorted => ww_av
-          ENDIF
-          grid = 'w'
-          flag_nr = 3
-
-       CASE ( 'wu' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wu
-          ELSE
-             to_be_resorted => wu_av
-          ENDIF
-          grid = 's'
-          flag_nr = 0
-
-       CASE ( 'wv' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wv
-          ELSE
-             to_be_resorted => wv_av
-          ENDIF
-          grid = 's'
-          flag_nr = 0
-
-       CASE ( 'wtheta' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wtheta
-          ELSE
-             to_be_resorted => wtheta_av
-          ENDIF
-          grid = 's'
-          flag_nr = 0
-
-       CASE ( 'wq' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wq
-          ELSE
-             to_be_resorted => wq_av
-          ENDIF
-          grid = 's'
-          flag_nr = 0
-
-       CASE ( 'ws' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => ws
-          ELSE
-             to_be_resorted => ws_av
-          ENDIF
-          grid = 's'
-          flag_nr = 0
-
-       CASE ( 'wspeed' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wspeed
-          ELSE
-             to_be_resorted => wspeed_av
-          ENDIF
-          grid = 's'
-          flag_nr = 0
-
-       CASE ( 'wdir' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => wdir
-          ELSE
-             to_be_resorted => wdir_av
-          ENDIF
-          grid = 's'
-          flag_nr = 0
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
-    IF ( found  .AND.  .NOT. resorted )  THEN
-       IF ( .NOT. mask_surface(mid) )  THEN
-!
-!--       Default masked output
-          DO  i = 1, mask_size_l(mid,1)
-             DO  j = 1, mask_size_l(mid,2)
-                DO  k = 1, mask_size_l(mid,3)
-                   local_pf(i,j,k) = MERGE( to_be_resorted(mask_k(mid,k),                          &
-                                                           mask_j(mid,j),                          &
-                                                           mask_i(mid,i)),                         &
-                                            REAL( fill_value, KIND = wp ),                         &
-                                            BTEST( wall_flags_total_0(mask_k(mid,k),               &
-                                                                      mask_j(mid,j),               &
-                                                                      mask_i(mid,i)),              &
-                                                   flag_nr ) )
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ELSE
-!
-!--       Terrain-following masked output
-          DO  i = 1, mask_size_l(mid,1)
-             DO  j = 1, mask_size_l(mid,2)
-!
-!--             Get k index of the lowest non-terrain grid point, else set fill value
-                im = mask_i(mid,i)
-                jm = mask_j(mid,j)
-                ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ), DIM=1 ) - 1
-                DO  k = 1, mask_size_l(mid,3)
-                   kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                Set value if not in building
-                   IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                      local_pf(i,j,k) = fill_value
-                   ELSE
-                      local_pf(i,j,k) = to_be_resorted(kk,jm,im)
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ENDIF
-    ENDIF
-
- END SUBROUTINE doq_output_mask
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate required arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_init
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ivar   !< loop index over all 2d/3d/mask output quantities
-
-
-!
-!-- Next line is to avoid compiler warnings about unused variables
-    IF ( timestep_number_at_prev_calc == 0 )  CONTINUE
-!
-!-- Preparatory steps and initialization of output arrays
-    IF ( .NOT.  prepared_diagnostic_output_quantities )  CALL doq_prepare
-
-    initialized_diagnostic_output_quantities = .FALSE.
-
-    ivar = 1
-
-    DO  WHILE ( ivar <= SIZE( do_all ) )
-
-       SELECT CASE ( TRIM( do_all(ivar) ) )
-!
-!--       Allocate array for 'relative humidity'
-          CASE ( 'rh' )
-             IF ( .NOT. ALLOCATED( rh ) )  THEN
-                ALLOCATE( rh(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                rh = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for 'air temperature'
-          CASE ( 'ta' )
-             IF ( .NOT. ALLOCATED( ta ) )  THEN
-                ALLOCATE( ta(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ta = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for 'turbulence intensity'
-          CASE ( 'ti' )
-             IF ( .NOT. ALLOCATED( ti ) )  THEN
-                ALLOCATE( ti(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ti = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for uu
-          CASE ( 'uu' )
-             IF ( .NOT. ALLOCATED( uu ) )  THEN
-                ALLOCATE( uu(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                uu = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for vv
-          CASE ( 'vv' )
-             IF ( .NOT. ALLOCATED( vv ) )  THEN
-                ALLOCATE( vv(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                vv = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for ww
-          CASE ( 'ww' )
-             IF ( .NOT. ALLOCATED( ww ) )  THEN
-                ALLOCATE( ww(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ww = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for wu
-          CASE ( 'wu' )
-             IF ( .NOT. ALLOCATED( wu ) )  THEN
-                ALLOCATE( wu(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wu = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for wv
-          CASE ( 'wv' )
-             IF ( .NOT. ALLOCATED( wv ) )  THEN
-                ALLOCATE( wv(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wv = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for wtheta
-          CASE ( 'wtheta' )
-             IF ( .NOT. ALLOCATED( wtheta ) )  THEN
-                ALLOCATE( wtheta(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wtheta = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for wq
-          CASE ( 'wq' )
-             IF ( .NOT. ALLOCATED( wq ) )  THEN
-                ALLOCATE( wq(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wq = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for ws
-          CASE ( 'ws' )
-             IF ( .NOT. ALLOCATED( ws ) )  THEN
-                ALLOCATE( ws(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ws = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for 2-m potential temperature
-          CASE ( 'theta_2m*' )
-             IF ( .NOT. ALLOCATED( pt_2m ) )  THEN
-                ALLOCATE( pt_2m(nysg:nyng,nxlg:nxrg) )
-                pt_2m = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for 10-m wind speed
-          CASE ( 'wspeed_10m*' )
-             IF ( .NOT. ALLOCATED( uv_10m ) )  THEN
-                ALLOCATE( uv_10m(nysg:nyng,nxlg:nxrg) )
-                uv_10m = 0.0_wp
-             ENDIF
-!
-!--       Allocate array for wspeed
-          CASE ( 'wspeed' )
-             IF ( .NOT. ALLOCATED( wspeed ) )  THEN
-                ALLOCATE( wspeed(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wspeed = 0.0_wp
-             ENDIF
-
-!
-!--       Allocate array for wdir
-          CASE ( 'wdir' )
-             IF ( .NOT. ALLOCATED( u_center ) )  THEN
-                ALLOCATE( u_center(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                u_center = 0.0_wp
-             ENDIF
-             IF ( .NOT. ALLOCATED( v_center ) )  THEN
-                ALLOCATE( v_center(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                v_center = 0.0_wp
-             ENDIF
-             IF ( .NOT. ALLOCATED( wdir ) )  THEN
-                ALLOCATE( wdir(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                wdir = 0.0_wp
-             ENDIF
-
-       END SELECT
-
-       ivar = ivar + 1
-    ENDDO
-
-    initialized_diagnostic_output_quantities = .TRUE.
-
- END SUBROUTINE doq_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of module-specific statistics, i.e. horizontally averaged profiles and time series.
-!> This is called for every statistic region sr, but at least for the region "total domain" (sr=0).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_statistics( mode, sr, tn )
-
-
-    CHARACTER (LEN=*) ::  mode   !<
-
-!     INTEGER(iwp) ::  i    !<
-!     INTEGER(iwp) ::  j    !<
-!     INTEGER(iwp) ::  k    !<
-    INTEGER(iwp) ::  sr   !<
-    INTEGER(iwp) ::  tn   !<
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( sr == 0  .OR.  tn == 0 )  CONTINUE
-
-    IF ( mode == 'profiles' )  THEN
-
-    ELSEIF ( mode == 'time_series' )  THEN
-
-    ENDIF
-
- END SUBROUTINE doq_statistics
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate diagnostic quantities
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_calculate
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i          !< grid index x-dimension
-    INTEGER(iwp) ::  j          !< grid index y-dimension
-    INTEGER(iwp) ::  k          !< grid index z-dimension
-    INTEGER(iwp) ::  ivar       !< loop index over all 2d/3d/mask output quantities
-
-    REAL(wp) ::  temp           !< temperature
-    REAL(wp) ::  e_s            !< saturation vapor pressure
-    REAL(wp) ::  q_s            !< saturation mixing ratio
-
-    TYPE(surf_type), POINTER ::  surf     !< surf-type array, used to generalize subroutines
-
-
-!     CALL cpu_log( log_point(41), 'calculate_quantities', 'start' )
-
-!
-!-- Save timestep number to check in time_integration if doq_calculate has been called already,
-!-- since the CALL occurs at two locations, but the calculations need to be done only once per
-!-- timestep.
-    timestep_number_at_prev_calc = current_timestep_number
-
-    ivar = 1
-
-    DO  WHILE ( ivar <= SIZE( do_all ) )
-
-       SELECT CASE ( TRIM( do_all(ivar) ) )
-!
-!--       rh (relative humidity)
-          CASE ( 'rh' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      IF ( humidity )  THEN
-                         temp = exner(k) * pt(k,j,i)
-                         e_s = magnus( temp )
-                         q_s = rd_d_rv * e_s / ( hyp(k) - e_s )
-                         rh(k,j,i) = q(k,j,i) / q_s * 100.0_wp                                     &
-                                     * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       ta (air temperature)
-          CASE ( 'ta' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      ta(k,j,i) = exner(k) * pt(k,j,i) - degc_to_k
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       Calculate 'turbulence intensity' from rot[(u,v,w)] at scalar grid point
-          CASE ( 'ti' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      ti(k,j,i) = 0.25_wp * SQRT(                                                  &
-                                       (   (   w(k,j+1,i) + w(k-1,j+1,i)                           &
-                                             - w(k,j-1,i) - w(k-1,j-1,i) ) * ddy                   &
-                                         - (   v(k+1,j,i) + v(k+1,j+1,i)                           &
-                                             - v(k-1,j,i) - v(k-1,j+1,i) ) * ddzu(k) )**2          &
-                                     + (   (   u(k+1,j,i) + u(k+1,j,i+1)                           &
-                                             - u(k-1,j,i) - u(k-1,j,i+1) ) * ddzu(k)               &
-                                         - (   w(k,j,i+1) + w(k-1,j,i+1)                           &
-                                             - w(k,j,i-1) - w(k-1,j,i-1) ) * ddx     )**2          &
-                                     + (   (   v(k,j,i+1) + v(k,j+1,i+1)                           &
-                                             - v(k,j,i-1) - v(k,j+1,i-1) ) * ddx                   &
-                                         - (   u(k,j+1,i) + u(k,j+1,i+1)                           &
-                                             - u(k,j-1,i) - u(k,j-1,i+1) ) * ddy     )**2  )       &
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       uu
-          CASE ( 'uu' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      uu(k,j,i) = u(k,j,i) * u(k,j,i)                                              &
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       vv
-          CASE ( 'vv' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      vv(k,j,i) = v(k,j,i) * v(k,j,i)                                              &
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       ww
-          CASE ( 'ww' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt-1
-                      ww(k,j,i) = w(k,j,i) * w(k,j,i)                                              &
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       wu
-          CASE ( 'wu' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt-1
-                      wu(k,j,i) = w(k,j,i)                                                         &
-                                  * 0.25_wp * ( u(k,j,i) + u(k,j,i+1) + u(k+1,j,i) + u(k+1,j,i+1) )&
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       wv
-          CASE ( 'wv' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt-1
-                      wv(k,j,i) = w(k,j,i)                                                         &
-                                  * 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k+1,j,i) + v(k+1,j+1,i) )&
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       wtheta
-          CASE ( 'wtheta' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt-1
-                      wtheta(k,j,i) = w(k,j,i)                                                     &
-                                     *  0.5_wp  * ( pt(k,j,i) + pt(k+1,j,i) )                      &
-                                     * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ))
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       wq
-          CASE ( 'wq' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt-1
-                      wq(k,j,i) = w(k,j,i) * 0.5_wp * ( q(k,j,i) + q(k+1,j,i) )                    &
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       ws
-          CASE ( 'ws' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt-1
-                      ws(k,j,i) = w(k,j,i) * 0.5_wp * ( s(k,j,i) + s(k+1,j,i) )                    &
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       2-m potential temperature
-          CASE ( 'theta_2m*' )
-!
-!--          2-m potential temperature is caluclated from surface arrays. In case the 2m level is
-!--          below the first grid point, MOST is applied, else, linear interpolation between two
-!--          vertical grid levels is applied. To access all surfaces, iterate over all horizontally-
-!--          upward facing surface types.
-             surf => surf_def_h(0)
-             CALL calc_pt_2m
-             surf => surf_lsm_h(0)
-             CALL calc_pt_2m
-             surf => surf_usm_h(0)
-             CALL calc_pt_2m
-!
-!--       10-m wind speed
-          CASE ( 'wspeed_10m*' )
-!
-!--          10-m wind speed is caluclated from surface arrays. In case the 10m level is below the
-!--          first grid point, MOST is applied, else, linear interpolation between two vertical grid
-!--          levels is applied. To access all surfaces, iterate over all horizontally-upward facing
-!--          surface types.
-             surf => surf_def_h(0)
-             CALL calc_wind_10m
-             surf => surf_lsm_h(0)
-             CALL calc_wind_10m
-             surf => surf_usm_h(0)
-             CALL calc_wind_10m
-!
-!--       Horizontal wind speed
-          CASE ( 'wspeed' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb, nzt+1
-                      wspeed(k,j,i) = SQRT( ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) )**2              &
-                                          + ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) )**2 )            &
-                                     * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ))
-                   ENDDO
-                ENDDO
-             ENDDO
-
-!
-!--       Horizontal wind direction
-          CASE ( 'wdir' )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb, nzt+1
-                      u_center(k,j,i) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
-                      v_center(k,j,i) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
-
-                      wdir(k,j,i) = ATAN2( u_center(k,j,i), v_center(k,j,i) )                      &
-                                    / pi * 180.0_wp + 180.0_wp
-                   ENDDO
-                ENDDO
-             ENDDO
-
-       END SELECT
-
-       ivar = ivar + 1
-    ENDDO
-
-!     CALL cpu_log( log_point(41), 'calculate_quantities', 'stop' )
-
-!
-!-- The following block contains subroutines to calculate diagnostic surface quantities.
-    CONTAINS
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of 2-m potential temperature.
-!--------------------------------------------------------------------------------------------------!
-       SUBROUTINE calc_pt_2m
-
-          USE surface_layer_fluxes_mod,                                                            &
-              ONLY:  psi_h
-
-          IMPLICIT NONE
-
-          INTEGER(iwp) ::  kk     !< running index along the z-dimension
-          INTEGER(iwp) ::  m      !< running index for surface elements
-
-          DO  m = 1, surf%ns
-
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-!
-!--          If 2-m level is below the first grid level, MOST is used for calculation of
-!--          2-m temperature.
-             IF ( surf%z_mo(m) > 2.0_wp )  THEN
-                pt_2m(j,i) = surf%pt_surface(m) + surf%ts(m) / kappa                               &
-                                * ( LOG( 2.0_wp / surf%z0h(m) )                                    &
-                                    - psi_h( 2.0_wp      / surf%ol(m) )                            &
-                                    + psi_h( surf%z0h(m) / surf%ol(m) ) )
-!
-!--          If 2-m level is above the first grid level, 2-m temperature is linearly interpolated
-!--          between the two nearest vertical grid levels. Note, since 2-m temperature is only
-!--          computed for horizontal upward-facing surfaces, only a vertical interpolation is
-!--          necessary.
-             ELSE
-!
-!--             zw(k-1) defines the height of the surface.
-                kk = k
-                DO WHILE ( zu(kk) - zw(k-1) < 2.0_wp  .AND.  kk <= nzt )
-                   kk = kk + 1
-                ENDDO
-!
-!--             kk defines the index of the first grid level >= 2m.
-                pt_2m(j,i) = pt(kk-1,j,i) +                                                        &
-                              ( zw(k-1) + 2.0_wp - zu(kk-1)     ) *                                &
-                              ( pt(kk,j,i)       - pt(kk-1,j,i) ) /                                &
-                              ( zu(kk)           - zu(kk-1)     )
-             ENDIF
-
-          ENDDO
-
-       END SUBROUTINE calc_pt_2m
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of 10-m wind speed.
-!--------------------------------------------------------------------------------------------------!
-       SUBROUTINE calc_wind_10m
-
-          USE surface_layer_fluxes_mod,                                                            &
-              ONLY:  psi_m
-
-          IMPLICIT NONE
-
-          INTEGER(iwp) ::  kk     !< running index along the z-dimension
-          INTEGER(iwp) ::  m      !< running index for surface elements
-
-          REAL(wp) ::  uv_l !< wind speed at lower grid point
-          REAL(wp) ::  uv_u !< wind speed at upper grid point
-
-
-          DO  m = 1, surf%ns
-
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-!
-!--          If 10-m level is below the first grid level, MOST is used for calculation of 10-m
-!--          temperature.
-             IF ( surf%z_mo(m) > 10.0_wp )  THEN
-                uv_10m(j,i) = surf%us(m) / kappa                                                   &
-                              * ( LOG( 10.0_wp /  surf%z0(m) )                                     &
-                                  - psi_m( 10.0_wp    / surf%ol(m) )                               &
-                                  + psi_m( surf%z0(m) / surf%ol(m) ) )
-!
-!--          If 10-m level is above the first grid level, 10-m wind speed is linearly interpolated
-!--          between the two nearest vertical grid levels. Note, since 10-m temperature is only
-!--          computed for horizontal upward-facing surfaces, only a vertical interpolation is
-!--          necessary.
-             ELSE
-!
-!--             zw(k-1) defines the height of the surface.
-                kk = k
-                DO WHILE ( zu(kk) - zw(k-1) < 10.0_wp  .AND.  kk <= nzt )
-                   kk = kk + 1
-                ENDDO
-!
-!--             kk defines the index of the first grid level >= 10m.
-                uv_l = SQRT( ( 0.5_wp * ( u(kk-1,j,i) + u(kk-1,j,i+1) ) )**2                       &
-                           + ( 0.5_wp * ( v(kk-1,j,i) + v(kk-1,j+1,i) ) )**2 )
-
-                uv_u = SQRT( ( 0.5_wp * ( u(kk,j,i)   + u(kk,j,i+1)   ) )**2                       &
-                           + ( 0.5_wp * ( v(kk,j,i)   + v(kk,j+1,i)   ) )**2 )
-
-                uv_10m(j,i) = uv_l + ( zw(k-1) + 10.0_wp - zu(kk-1) ) *                            &
-                                     ( uv_u              - uv_l     ) /                            &
-                                     ( zu(kk)            - zu(kk-1) )
-
-             ENDIF
-
-          ENDDO
-
-       END SUBROUTINE calc_wind_10m
-
- END SUBROUTINE doq_calculate
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Preparation of the diagnostic output, counting of the module-specific output quantities and
-!> gathering of the output names.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_prepare
-
-    USE control_parameters,                                                                        &
-        ONLY:  do2d, do3d, domask, masks
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=varnamelength), DIMENSION(0:1,500) ::  do2d_var = ' '  !< label array for 2d output quantities
-
-    INTEGER(iwp) ::  av         !< index defining type of output, av=0 instantaneous, av=1 averaged
-    INTEGER(iwp) ::  ivar       !< loop index
-    INTEGER(iwp) ::  ivar_all   !< loop index
-    INTEGER(iwp) ::  l          !< index for cutting string
-    INTEGER(iwp) ::  mid          !< masked output running index
-
-
-    prepared_diagnostic_output_quantities = .FALSE.
-
-    ivar     = 1
-    ivar_all = 1
-
-    DO  av = 0, 1
-!
-!--    Remove _xy, _xz, or _yz from string
-       l = MAX( 3, LEN_TRIM( do2d(av,ivar) ) )
-       do2d_var(av,ivar)(1:l-3) = do2d(av,ivar)(1:l-3)
-!
-!--    Gather 2d output quantity names.
-!--    Check for double occurrence of output quantity, e.g. by _xy, _yz, _xz.
-       DO  WHILE ( do2d_var(av,ivar)(1:1) /= ' ' )
-          IF ( .NOT.  ANY( do_all == do2d_var(av,ivar) ) )  THEN
-             do_all(ivar_all) = do2d_var(av,ivar)
-          ENDIF
-          ivar = ivar + 1
-          ivar_all = ivar_all + 1
-          l = MAX( 3, LEN_TRIM( do2d(av,ivar) ) )
-          do2d_var(av,ivar)(1:l-3) = do2d(av,ivar)(1:l-3)
-       ENDDO
-
-       ivar = 1
-!
-!--    Gather 3d output quantity names
-       DO  WHILE ( do3d(av,ivar)(1:1) /= ' ' )
-          do_all(ivar_all) = do3d(av,ivar)
-          ivar = ivar + 1
-          ivar_all = ivar_all + 1
-       ENDDO
-
-       ivar = 1
-!
-!--    Gather masked output quantity names. Also check for double output e.g. by different masks.
-       DO  mid = 1, masks
-          DO  WHILE ( domask(mid,av,ivar)(1:1) /= ' ' )
-             IF ( .NOT.  ANY( do_all == domask(mid,av,ivar) ) )  THEN
-                do_all(ivar_all) = domask(mid,av,ivar)
-             ENDIF
-
-             ivar = ivar + 1
-             ivar_all = ivar_all + 1
-          ENDDO
-          ivar = 1
-       ENDDO
-
-    ENDDO
-
-    prepared_diagnostic_output_quantities = .TRUE.
-
- END SUBROUTINE doq_prepare
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine reads local (subdomain) restart data
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,    &
-                               nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d, found )
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-    USE pegrid
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k               !<
-    INTEGER(iwp) ::  nxlc            !<
-    INTEGER(iwp) ::  nxlf            !<
-    INTEGER(iwp) ::  nxl_on_file     !<
-    INTEGER(iwp) ::  nxrc            !<
-    INTEGER(iwp) ::  nxrf            !<
-    INTEGER(iwp) ::  nxr_on_file     !<
-    INTEGER(iwp) ::  nync            !<
-    INTEGER(iwp) ::  nynf            !<
-    INTEGER(iwp) ::  nyn_on_file     !<
-    INTEGER(iwp) ::  nysc            !<
-    INTEGER(iwp) ::  nysf            !<
-    INTEGER(iwp) ::  nys_on_file     !<
-
-    LOGICAL, INTENT(OUT)  :: found
-
-    REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d   !<
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
-
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'pt_2m_av' )
-          IF ( .NOT. ALLOCATED( pt_2m_av ) )  THEN
-             ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_2d
-          pt_2m_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                                     &
-                      tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rh_av' )
-          IF ( .NOT. ALLOCATED( rh_av ) )  THEN
-             ALLOCATE( rh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          rh_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'ta_av' )
-          IF ( .NOT. ALLOCATED( ta_av ) )  THEN
-             ALLOCATE( ta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          ta_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'ti_av' )
-          IF ( .NOT. ALLOCATED( ti_av ) )  THEN
-             ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          ti_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'u_center_av' )
-          IF ( .NOT. ALLOCATED( u_center_av ) )  THEN
-             ALLOCATE( u_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          u_center_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'uu_av' )
-          IF ( .NOT. ALLOCATED( uu_av ) )  THEN
-             ALLOCATE( uu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          uu_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'uv_10m_av' )
-          IF ( .NOT. ALLOCATED( uv_10m_av ) )  THEN
-             ALLOCATE( uv_10m_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_2d
-          uv_10m_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                                    &
-                       tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'v_center_av' )
-          IF ( .NOT. ALLOCATED( v_center_av ) )  THEN
-             ALLOCATE( v_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          v_center_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'vv_av' )
-          IF ( .NOT. ALLOCATED( vv_av ) )  THEN
-             ALLOCATE( vv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          vv_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'wtheta_av' )
-          IF ( .NOT. ALLOCATED( wtheta_av ) )  THEN
-             ALLOCATE( wtheta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          wtheta_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                   &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'wq_av' )
-          IF ( .NOT. ALLOCATED( wq_av ) )  THEN
-             ALLOCATE( wq_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          wq_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'ws_av' )
-          IF ( .NOT. ALLOCATED( ws_av ) )  THEN
-             ALLOCATE( ws_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          ws_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'wspeed_av' )
-          IF ( .NOT. ALLOCATED( wspeed_av ) )  THEN
-             ALLOCATE( wspeed_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          wspeed_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                   &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'wu_av' )
-          IF ( .NOT. ALLOCATED( wu_av ) )  THEN
-             ALLOCATE( wu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          wu_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'wv_av' )
-          IF ( .NOT. ALLOCATED( wv_av ) )  THEN
-             ALLOCATE( wv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          wv_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'ww_av' )
-          IF ( .NOT. ALLOCATED( ww_av ) )  THEN
-             ALLOCATE( ww_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          ww_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE doq_rrd_local_ftn
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_rrd_local_mpi
-
-    LOGICAL ::  array_found  !< control flad indicating whether the array is found in the file or not
-
-
-    CALL rd_mpi_io_check_array( 'pt_2m_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( pt_2m_av ) )  ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'pt_2m_av', pt_2m_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'ta_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( ta_av ) )  ALLOCATE( ta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'ta_av', ta_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'ti_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( ti_av ) )  ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'ti_av', ti_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rh_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rh_av ) )  ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rh_av', rh_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'u_center_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( u_center_av ) )  ALLOCATE( u_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'u_center_av', u_center_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'uu_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( uu_av ) )  ALLOCATE( uu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'uu_av', uu_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'uv_10m_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( uv_10m_av ) )  ALLOCATE( uv_10m_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'uv_10m_av', uv_10m_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'v_center_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( v_center_av ) )  ALLOCATE( v_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'v_center_av', v_center_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'vv_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( vv_av ) )  ALLOCATE( vv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'vv_av', vv_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'ww_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( ww_av ) )  ALLOCATE( ww_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'ww_av', ww_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'wu_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( wu_av ) )  ALLOCATE( wu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'wu_av', wu_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'wv_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( wv_av ) )  ALLOCATE( wv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'wv_av', wv_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'wtheta_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( wtheta_av ) )  ALLOCATE( wtheta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'wtheta_av', wtheta_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'wq_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( wq_av ) )  ALLOCATE( wq_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'wq_av', wq_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'ws_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( ws_av ) )  ALLOCATE( ws_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'ws_av', ws_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'wspeed_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( wspeed_av ) )  ALLOCATE( wspeed_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'wspeed_av', wspeed_av )
-    ENDIF
-
- END SUBROUTINE doq_rrd_local_mpi
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine writes local (subdomain) restart data
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE doq_wrd_local
-
-    IMPLICIT NONE
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       IF ( ALLOCATED( pt_2m_av ) )  THEN
-          CALL wrd_write_string( 'pt_2m_av' )
-          WRITE ( 14 )  pt_2m_av
-       ENDIF
-
-       IF ( ALLOCATED( rh_av ) )  THEN
-          CALL wrd_write_string( 'rh_av' )
-          WRITE ( 14 )  rh_av
-       ENDIF
-
-       IF ( ALLOCATED( ta_av ) )  THEN
-          CALL wrd_write_string( 'ta_av' )
-          WRITE ( 14 )  ta_av
-       ENDIF
-
-       IF ( ALLOCATED( ti_av ) )  THEN
-          CALL wrd_write_string( 'ti_av' )
-          WRITE ( 14 )  ti_av
-       ENDIF
-
-       IF ( ALLOCATED( u_center_av ) )  THEN
-          CALL wrd_write_string( 'u_center_av' )
-          WRITE ( 14 )  u_center_av
-       ENDIF
-
-       IF ( ALLOCATED( uu_av ) )  THEN
-          CALL wrd_write_string( 'uu_av' )
-          WRITE ( 14 )  uu_av
-       ENDIF
-
-       IF ( ALLOCATED( uv_10m_av ) )  THEN
-          CALL wrd_write_string( 'uv_10m_av' )
-          WRITE ( 14 )  uv_10m_av
-       ENDIF
-
-       IF ( ALLOCATED( v_center_av ) )  THEN
-          CALL wrd_write_string( 'v_center_av' )
-          WRITE ( 14 )  v_center_av
-       ENDIF
-
-       IF ( ALLOCATED( vv_av ) )  THEN
-          CALL wrd_write_string( 'vv_av' )
-          WRITE ( 14 )  vv_av
-       ENDIF
-
-       IF ( ALLOCATED( ww_av ) )  THEN
-          CALL wrd_write_string( 'ww_av' )
-          WRITE ( 14 )  ww_av
-       ENDIF
-
-       IF ( ALLOCATED( wu_av ) )  THEN
-          CALL wrd_write_string( 'wu_av' )
-          WRITE ( 14 )  wu_av
-       ENDIF
-
-       IF ( ALLOCATED( wv_av ) )  THEN
-          CALL wrd_write_string( 'wv_av' )
-          WRITE ( 14 )  wv_av
-       ENDIF
-
-       IF ( ALLOCATED( wtheta_av ) )  THEN
-          CALL wrd_write_string( 'wtheta_av' )
-          WRITE ( 14 )  wtheta_av
-       ENDIF
-
-       IF ( ALLOCATED( wq_av ) )  THEN
-          CALL wrd_write_string( 'wq_av' )
-          WRITE ( 14 )  wq_av
-       ENDIF
-
-       IF ( ALLOCATED( ws_av ) )  THEN
-          CALL wrd_write_string( 'ws_av' )
-          WRITE ( 14 )  ws_av
-       ENDIF
-
-       IF ( ALLOCATED( wspeed_av ) )  THEN
-          CALL wrd_write_string( 'wspeed_av' )
-          WRITE ( 14 )  wspeed_av
-       ENDIF
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       IF ( ALLOCATED( pt_2m_av ) )     CALL wrd_mpi_io( 'pt_2m_av', pt_2m_av )
-       IF ( ALLOCATED( rh_av ) )        CALL wrd_mpi_io( 'rh_av', rh_av )
-       IF ( ALLOCATED( ta_av ) )        CALL wrd_mpi_io( 'ta_av', ta_av )
-       IF ( ALLOCATED( ti_av ) )        CALL wrd_mpi_io( 'ti_av', ti_av )
-       IF ( ALLOCATED( u_center_av ) )  CALL wrd_mpi_io( 'u_center_av', u_center_av )
-       IF ( ALLOCATED( uu_av ) )        CALL wrd_mpi_io( 'uu_av', uu_av )
-       IF ( ALLOCATED( uv_10m_av ) )    CALL wrd_mpi_io( 'uv_10m_av', uv_10m_av )
-       IF ( ALLOCATED( vv_av ) )        CALL wrd_mpi_io( 'vv_av', vv_av )
-       IF ( ALLOCATED( v_center_av ) )  CALL wrd_mpi_io( 'v_center_av', v_center_av )
-       IF ( ALLOCATED( wtheta_av ) )    CALL wrd_mpi_io( 'wtheta_av', wtheta_av )
-       IF ( ALLOCATED( wq_av ) )        CALL wrd_mpi_io( 'wq_av', wq_av )
-       IF ( ALLOCATED( ws_av ) )        CALL wrd_mpi_io( 'ws_av', ws_av )
-       IF ( ALLOCATED( wspeed_av ) )    CALL wrd_mpi_io( 'wspeed_av', wspeed_av )
-       IF ( ALLOCATED( wu_av ) )        CALL wrd_mpi_io( 'wu_av', wu_av )
-       IF ( ALLOCATED( wv_av ) )        CALL wrd_mpi_io( 'wv_av', wv_av )
-       IF ( ALLOCATED( ww_av ) )        CALL wrd_mpi_io( 'ww_av', ww_av )
-
-    ENDIF
-
- END SUBROUTINE doq_wrd_local
-
-
- END MODULE diagnostic_output_quantities_mod
Index: palm/trunk/SOURCE/diffusion_e.f90
===================================================================
--- palm/trunk/SOURCE/diffusion_e.f90	(revision 1)
+++ palm/trunk/SOURCE/diffusion_e.f90	(revision 1)
@@ -0,0 +1,311 @@
+ MODULE diffusion_e_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: diffusion_e.f90,v $
+! Revision 1.18  2006/08/04 14:29:43  raasch
+! dissipation is stored in extra array diss if needed later on for calculating
+! the sgs particle velocities
+!
+! Revision 1.17  2006/02/23 10:31:46  raasch
+! nzb_2d replaced by nzb_s_inner
+!
+! Revision 1.16  2004/01/30 10:18:18  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.15  2003/03/14 13:39:33  raasch
+! Loop optimization for diffusion_e, l and ll are now automatic arrays
+!
+! Revision 1.14  2003/03/12 16:25:03  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.13  2002/12/19 14:25:28  raasch
+! Correction of mixing length term (l(k)/ll(k)). The condition kh=3*km in
+! the unstable case is now also exactly met in the wall adjustment region.
+! Factor 0.7 in wall adjustment part replaced by variable
+! wall_adjustment_factor, which is set to ... in modules.f90.
+!
+! Revision 1.12  2002/06/11 12:51:59  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+! 1D-array l is allocated only once in the first call.
+!
+! Revision 1.11  2001/08/21 08:24:34  raasch
+! Wall adjustment of mixing length to 0.7 z can be switched off
+!
+! Revision 1.10  2001/03/30 07:06:30  raasch
+! Near surface mixing length is limited to 0.7*zu,
+! e**1.5 replaced by e*SQRT(e) (more than 10% total increase in performance
+! of this routine),
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.9  2001/01/22 06:05:28  raasch
+! Module test_variables removed
+!
+! Revision 1.8  2001/01/02 17:27:00  raasch
+! -dpt_dz_d, dpt_dz_u
+!
+! Revision 1.7  2000/07/03 12:56:34  raasch
+! array l changed from dummy argument to local allocatable array,
+! dummy arguments, whose corresponding actual arguments are pointers,
+! are now also defined as pointers
+! all comments translated into English
+!
+! Revision 1.6  2000/04/18 08:10:12  schroeter
+! Revision 1.4 wieder rueckgaengig gemacht, das Stabilitaets-
+! kriterium basiert nun wieder auf zentralen Differenzen
+!
+! Revision 1.5  2000/04/13 14:33:08  schroeter
+! je nach Initialisierungsmodus (trocken/feucht) fliesst in die
+! Berechnung des Mischungsweges pt oder vpt ein, wird durch
+! entsprechende Variablenuebergabe geregelt
+!
+! Revision 1.4  99/02/17  09:15:52  09:15:52  raasch (Siegfried Raasch)
+! Dissipation jetzt gemaess dem originalen Deardorff-Ansatz
+! Kriterium fuer reduzierten Mischungsweg im stabil geschichteten Fall enger
+! gefasst (Schichtung muss sowohl oberhalb als auch unterhalb des betrachteten
+! Gitterpunkts stabil sein)
+! 
+! Revision 1.3  1998/07/06 12:10:56  raasch
+! + USE test_variables
+!
+! Revision 1.2  1998/03/11 11:48:59  raasch
+! Anpassung des Mischungsweges an den Prandtlschen Mischungsweg moeglich
+!
+! Revision 1.1  1997/09/19 07:40:24  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Diffusion- and dissipation terms for the TKE
+!------------------------------------------------------------------------------!
+
+    PRIVATE
+    PUBLIC diffusion_e
+    
+
+    INTERFACE diffusion_e
+       MODULE PROCEDURE diffusion_e
+       MODULE PROCEDURE diffusion_e_ij
+    END INTERFACE diffusion_e
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, theta, &
+                            rif, tend, zu )
+
+       USE control_parameters
+       USE grid_variables
+       USE indices
+       USE particle_attributes
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+       REAL            ::  dpt_dz, l_stable, phi_m
+       REAL            ::  ddzu(1:nzt+1), dd2zu(1:nzt), ddzw(1:nzt), &
+                           l_grid(1:nzt), zu(0:nzt+1)
+       REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: diss, tend
+       REAL, DIMENSION(:,:), POINTER   ::  rif
+       REAL, DIMENSION(:,:,:), POINTER ::  e, km, theta
+       REAL, DIMENSION(nzb+1:nzt-1,nys:nyn) ::  dissipation, l, ll
+ 
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+!
+!--          First, calculate phi-function for eventually adjusting the &
+!--          mixing length to the prandtl mixing length
+             IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
+                IF ( rif(j,i) >= 0.0 )  THEN
+                   phi_m = 1.0 + 5.0 * rif(j,i)
+                ELSE
+                   phi_m = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
+                ENDIF
+             ENDIF
+
+             DO  k = nzb_s_inner(j,i)+1, nzt-1
+!
+!--             Calculate the mixing length (for dissipation)
+                dpt_dz = ( theta(k+1,j,i) - theta(k-1,j,i) ) * dd2zu(k)
+                IF ( dpt_dz > 0.0 ) THEN
+                   l_stable = 0.76 * SQRT( e(k,j,i) ) / &
+                                     SQRT( g / theta(k,j,i) * dpt_dz ) + 1E-5
+                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), l_grid(k), &
+                                  l_stable )
+                   ll(k,j) = MIN( wall_adjustment_factor * zu(k), l_grid(k) )
+                ELSE
+                   l(k,j)  = MIN( l_grid(k), l_stable )
+                   ll(k,j) = l_grid(k)
+                ENDIF
+                IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
+                   l(k,j)  = MIN( l(k,j),  kappa * zu(k) / phi_m )
+                   ll(k,j) = MIN( ll(k,j), kappa * zu(k) / phi_m )
+                ENDIF
+
+             ENDDO
+          ENDDO
+!
+!--       Calculate the tendency terms
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt-1
+
+                 dissipation(k,j) = ( 0.19 + 0.74 * 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 )  THEN
+             DO  j = nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt-1
+                   diss(k,j,i) = dissipation(k,j)
+                ENDDO
+             ENDDO
+          ENDIF
+
+       ENDDO
+
+!
+!--    Boundary condition for dissipation
+       IF ( use_sgs_for_particles )  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
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_e_ij( i, j, ddzu, dd2zu, ddzw, diss, e, km, l_grid, &
+                               theta, rif, tend, zu )
+
+       USE control_parameters
+       USE grid_variables
+       USE indices
+       USE particle_attributes
+
+       IMPLICIT NONE
+
+       INTEGER         ::  i, j, k
+       REAL            ::  dpt_dz, l_stable, phi_m
+       REAL            ::  ddzu(1:nzt+1), dd2zu(1:nzt), ddzw(1:nzt), &
+                           l_grid(1:nzt), zu(0:nzt+1)
+       REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ::  diss, tend
+       REAL, DIMENSION(:,:), POINTER   ::  rif
+       REAL, DIMENSION(:,:,:), POINTER ::  e, km, theta
+       REAL, DIMENSION(nzb+1:nzt-1)    ::  dissipation, l, ll
+
+
+!
+!--    First, calculate phi-function for eventually adjusting the mixing length
+!--    to the prandtl mixing length
+       IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
+          IF ( rif(j,i) >= 0.0 )  THEN
+             phi_m = 1.0 + 5.0 * rif(j,i)
+          ELSE
+             phi_m = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
+          ENDIF
+       ENDIF
+
+!
+!--    Calculate the mixing length (for dissipation)
+       DO  k = nzb_s_inner(j,i)+1, nzt-1
+          dpt_dz = ( theta(k+1,j,i) - theta(k-1,j,i) ) * dd2zu(k)
+          IF ( dpt_dz > 0.0 ) THEN
+             l_stable = 0.76 * SQRT( e(k,j,i) ) / &
+                               SQRT( g / theta(k,j,i) * dpt_dz ) + 1E-5
+          ELSE
+             l_stable = l_grid(k)
+          ENDIF
+!
+!--       Adjustment of the mixing length
+          IF ( wall_adjustment )  THEN
+             l(k)  = MIN( wall_adjustment_factor * zu(k), l_grid(k), l_stable )
+             ll(k) = MIN( wall_adjustment_factor * zu(k), l_grid(k) )
+          ELSE
+             l(k)  = MIN( l_grid(k), l_stable )
+             ll(k) = l_grid(k)
+          ENDIF
+          IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
+             l(k)  = MIN( l(k),  kappa * zu(k) / phi_m )
+             ll(k) = MIN( ll(k), kappa * zu(k) / phi_m )
+          ENDIF
+
+!
+!--       Calculate the tendency term
+          dissipation(k) = ( 0.19 + 0.74 * 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 )  THEN
+          DO  k = nzb_s_inner(j,i)+1, nzt-1
+             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 4901)
+++ palm/trunk/SOURCE/diffusion_s.f90	(revision 1)
@@ -1,50 +1,39 @@
-!> @file diffusion_s.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
+ MODULE diffusion_s_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Implementation of downward facing USM and LSM surfaces
-! 
-! 4583 2020-06-29 12:36:47Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_total_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3927 2019-04-23 13:24:29Z raasch
-! pointer attribute removed from scalar 3d-array for performance reasons
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! unused variables removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! nopointer option removed
+! $Log: diffusion_s.f90,v $
+! Revision 1.8  2006/02/23 10:34:17  raasch
+! nzb_2d replaced by nzb_s_outer in horizontal diffusion and by nzb_s_inner
+! or nzb_diff_s_inner, respectively, in vertical diffusion, prescribed surface
+! fluxes at vertically oriented topography
+!
+! Revision 1.7  2004/01/30 10:20:56  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.6  2003/03/12 16:25:32  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.5  2002/06/11 12:52:41  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.4  2001/03/30 07:11:44  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.3  2001/01/25 06:58:14  raasch
+! Variable "prandtl_layer replaced by "use_surface_fluxes"
+!
+! Revision 1.2  2000/07/03 12:57:13  raasch
+! dummy arguments, whose corresponding actual arguments are pointers,
+! are now also defined as pointers,
+! all comments translated into English
 !
 ! Revision 1.1  2000/04/13 14:54:02  schroeter
@@ -54,8 +43,6 @@
 ! Description:
 ! ------------
-!> Diffusion term of scalar quantities (temperature and water content)
-!--------------------------------------------------------------------------------------------------!
- MODULE diffusion_s_mod
-
+! Diffusion term of scalar quantities (temperature and water content)
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -70,325 +57,91 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_s( s, s_flux_def_h_up,    s_flux_def_h_down,                              &
-                               s_flux_t,                                                           &
-                               s_flux_lsm_h_up,    s_flux_lsm_h_down,                              &
-                               s_flux_usm_h_up,    s_flux_usm_h_down,                              &
-                               s_flux_def_v_north, s_flux_def_v_south,                             &
-                               s_flux_def_v_east,  s_flux_def_v_west,                              &
-                               s_flux_lsm_v_north, s_flux_lsm_v_south,                             &
-                               s_flux_lsm_v_east,  s_flux_lsm_v_west,                              &
-                               s_flux_usm_v_north, s_flux_usm_v_south,                             &
-                               s_flux_usm_v_east,  s_flux_usm_v_west )
-
-       USE arrays_3d,                                                                              &
-           ONLY:  ddzu, ddzw, kh, tend, drho_air, rho_air_zw
-
-       USE control_parameters,                                                                     &
-           ONLY: use_surface_fluxes, use_top_fluxes
-
-       USE grid_variables,                                                                         &
-           ONLY:  ddx, ddx2, ddy, ddy2
-
-       USE indices,                                                                                &
-           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, wall_flags_total_0
-
-       USE kinds
-
-       USE surface_mod,                                                                            &
-           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_s( ddzu, ddzw, kh, s, s_flux, tend )
+
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i             !< running index x direction
-       INTEGER(iwp) ::  j             !< running index y direction
-       INTEGER(iwp) ::  k             !< running index z direction
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
-
-       REAL(wp) ::  flag              !< flag to mask topography grid points
-       REAL(wp) ::  mask_bottom       !< flag to mask vertical upward-facing surface
-       REAL(wp) ::  mask_east         !< flag to mask vertical surface east of the grid point
-       REAL(wp) ::  mask_north        !< flag to mask vertical surface north of the grid point
-       REAL(wp) ::  mask_south        !< flag to mask vertical surface south of the grid point
-       REAL(wp) ::  mask_top          !< flag to mask vertical downward-facing surface
-       REAL(wp) ::  mask_west         !< flag to mask vertical surface west of the grid point
-
-       REAL(wp), DIMENSION(1:surf_def_h(0)%ns) ::  s_flux_def_h_up    !< flux at horizontal upward-facing default-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_h(1)%ns) ::  s_flux_def_h_down  !< flux at horizontal donwward-facing default-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_v(2)%ns) ::  s_flux_def_v_east  !< flux at east-facing vertical default-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_v(0)%ns) ::  s_flux_def_v_north !< flux at north-facing vertical default-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_v(1)%ns) ::  s_flux_def_v_south !< flux at south-facing vertical default-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_v(3)%ns) ::  s_flux_def_v_west  !< flux at west-facing vertical default-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_h(0)%ns) ::  s_flux_lsm_h_up    !< flux at horizontal upward-facing natural-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_h(1)%ns) ::  s_flux_lsm_h_down  !< flux at horizontal downward-facing natural-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_v(2)%ns) ::  s_flux_lsm_v_east  !< flux at east-facing vertical natural-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_v(0)%ns) ::  s_flux_lsm_v_north !< flux at north-facing vertical natural-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_v(1)%ns) ::  s_flux_lsm_v_south !< flux at south-facing vertical natural-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_v(3)%ns) ::  s_flux_lsm_v_west  !< flux at west-facing vertical natural-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_h(0)%ns) ::  s_flux_usm_h_up    !< flux at horizontal upward-facing urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_h(1)%ns) ::  s_flux_usm_h_down  !< flux at horizontal downward-facing urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_v(2)%ns) ::  s_flux_usm_v_east  !< flux at east-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_v(0)%ns) ::  s_flux_usm_v_north !< flux at north-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_v(1)%ns) ::  s_flux_usm_v_south !< flux at south-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_v(3)%ns) ::  s_flux_usm_v_west  !< flux at west-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_h(2)%ns) ::  s_flux_t           !< flux at model top
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !< treated scalar
-
-
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, m) &
-       !$ACC PRIVATE(surf_e, surf_s, flag, mask_top, mask_bottom) &
-       !$ACC PRIVATE(mask_north, mask_south, mask_west, mask_east) &
-       !$ACC PRESENT(wall_flags_total_0, kh) &
-       !$ACC PRESENT(s) &
-       !$ACC PRESENT(ddzu, ddzw, drho_air, rho_air_zw) &
-       !$ACC PRESENT(surf_def_h(0:2), surf_def_v(0:3)) &
-       !$ACC PRESENT(surf_lsm_h(0:1), surf_lsm_v(0:3)) &
-       !$ACC PRESENT(surf_usm_h(0:1), surf_usm_v(0:3)) &
-       !$ACC PRESENT(s_flux_def_h_up, s_flux_def_h_down) &
-       !$ACC PRESENT(s_flux_t) &
-       !$ACC PRESENT(s_flux_def_v_north, s_flux_def_v_south) &
-       !$ACC PRESENT(s_flux_def_v_east, s_flux_def_v_west) &
-       !$ACC PRESENT(s_flux_lsm_h_up, s_flux_lsm_h_down) &
-       !$ACC PRESENT(s_flux_lsm_v_north, s_flux_lsm_v_south) &
-       !$ACC PRESENT(s_flux_lsm_v_east, s_flux_lsm_v_west) &
-       !$ACC PRESENT(s_flux_usm_h_up, s_flux_usm_h_down) &
-       !$ACC PRESENT(s_flux_usm_v_north, s_flux_usm_v_south) &
-       !$ACC PRESENT(s_flux_usm_v_east, s_flux_usm_v_west) &
-       !$ACC PRESENT(tend)
+       INTEGER ::  i, j, k
+       REAL    ::  vertical_gridspace
+       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt)
+       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+       REAL, DIMENSION(:,:),   POINTER ::  s_flux
+       REAL, DIMENSION(:,:,:), POINTER ::  kh, s
+
        DO  i = nxl, nxr
           DO  j = nys,nyn
 !
 !--          Compute horizontal diffusion
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography and wall-bounded grid points
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--             Predetermine flag to mask wall-bounded grid points, equivalent to former s_outer
-!--             array
-                mask_west  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i-1), 0 ) )
-                mask_east  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i+1), 0 ) )
-                mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j-1,i), 0 ) )
-                mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j+1,i), 0 ) )
-
-                tend(k,j,i) = tend(k,j,i)                                                          &
-                                                  + 0.5_wp * (                                     &
-                                mask_east  * ( kh(k,j,i) + kh(k,j,i+1) )                           &
-                                           * ( s(k,j,i+1) - s(k,j,i)   )                           &
-                              - mask_west  * ( kh(k,j,i) + kh(k,j,i-1) )                           &
-                                           * ( s(k,j,i)   - s(k,j,i-1) )                           &
-                                                             ) * ddx2 * flag                       &
-                                                  + 0.5_wp * (                                     &
-                                mask_north * ( kh(k,j,i) + kh(k,j+1,i) )                           &
-                                           * ( s(k,j+1,i) - s(k,j,i)   )                           &
-                              - mask_south * ( kh(k,j,i) + kh(k,j-1,i) )                           &
-                                           * ( s(k,j,i)   - s(k,j-1,i) )                           &
-                                                             ) * ddy2 * flag
+             DO  k = nzb_s_outer(j,i)+1, nzt-1
+
+                tend(k,j,i) = tend(k,j,i)                                     &
+                                          + 0.5 * (                           &
+                        ( 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 * (                           &
+                        ( 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. First, determine start and
-!--          end index for respective (j,i)-index. Please note, in the flat case following loop will
-!--          not be entered, as surf_s=1 and surf_e=0. Furtermore, note, no vertical natural
-!--          surfaces so far.
-!--          First, for default-type surfaces.
-!--          North-facing vertical default-type surfaces
-             surf_s = surf_def_v(0)%start_index(j,i)
-             surf_e = surf_def_v(0)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_def_v(0)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_def_v_north(m) * ddy
-             ENDDO
-!
-!--          South-facing vertical default-type surfaces
-             surf_s = surf_def_v(1)%start_index(j,i)
-             surf_e = surf_def_v(1)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_def_v(1)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_def_v_south(m) * ddy
-             ENDDO
-!
-!--          East-facing vertical default-type surfaces
-             surf_s = surf_def_v(2)%start_index(j,i)
-             surf_e = surf_def_v(2)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_def_v(2)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_def_v_east(m) * ddx
-             ENDDO
-!
-!--          West-facing vertical default-type surfaces
-             surf_s = surf_def_v(3)%start_index(j,i)
-             surf_e = surf_def_v(3)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_def_v(3)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_def_v_west(m) * ddx
-             ENDDO
-!
-!--          Now, for natural-type surfaces.
-!--          North-facing
-             surf_s = surf_lsm_v(0)%start_index(j,i)
-             surf_e = surf_lsm_v(0)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_lsm_v(0)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_north(m) * ddy
-             ENDDO
-!
-!--          South-facing
-             surf_s = surf_lsm_v(1)%start_index(j,i)
-             surf_e = surf_lsm_v(1)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_lsm_v(1)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_south(m) * ddy
-             ENDDO
-!
-!--          East-facing
-             surf_s = surf_lsm_v(2)%start_index(j,i)
-             surf_e = surf_lsm_v(2)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_lsm_v(2)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_east(m) * ddx
-             ENDDO
-!
-!--          West-facing
-             surf_s = surf_lsm_v(3)%start_index(j,i)
-             surf_e = surf_lsm_v(3)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_lsm_v(3)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_west(m) * ddx
-             ENDDO
-!
-!--          Now, for urban-type surfaces.
-!--          North-facing
-             surf_s = surf_usm_v(0)%start_index(j,i)
-             surf_e = surf_usm_v(0)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_usm_v(0)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_north(m) * ddy
-             ENDDO
-!
-!--          South-facing
-             surf_s = surf_usm_v(1)%start_index(j,i)
-             surf_e = surf_usm_v(1)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_usm_v(1)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_south(m) * ddy
-             ENDDO
-!
-!--          East-facing
-             surf_s = surf_usm_v(2)%start_index(j,i)
-             surf_e = surf_usm_v(2)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_usm_v(2)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_east(m) * ddx
-             ENDDO
-!
-!--          West-facing
-             surf_s = surf_usm_v(3)%start_index(j,i)
-             surf_e = surf_usm_v(3)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k           = surf_usm_v(3)%k(m)
-                tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_west(m) * ddx
-             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.
-!--          Model top is also mask if top flux is given.
-             DO  k = nzb+1, nzt
-!
-!--             Determine flags to mask topography below and above. Flag 0 is used to mask
-!--             topography in general, and flag 8 implies information about use_surface_fluxes.
-!--             Flag 9 is used to control flux at model top.
-                mask_bottom = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 8 ) )
-                mask_top    = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 8 ) ) *   &
-                              MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 9 ) )
-                flag        = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                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)                      &
-                                                            * rho_air_zw(k)                        &
-                                                            * mask_top                             &
-                                    - ( kh(k,j,i) + kh(k-1,j,i) ) *                                &
-                                          ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)                        &
-                                                            * rho_air_zw(k-1)                      &
-                                                            * mask_bottom                          &
-                                                  ) * ddzw(k) * drho_air(k)                        &
-                                                              * flag
-             ENDDO
-
-!
-!--          Vertical diffusion at horizontal walls.
-             IF ( use_surface_fluxes )  THEN
-!
-!--             Default-type surfaces, upward-facing
-                surf_s = surf_def_h(0)%start_index(j,i)
-                surf_e = surf_def_h(0)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_def_h(0)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + s_flux_def_h_up(m) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Default-type surfaces, downward-facing
-                surf_s = surf_def_h(1)%start_index(j,i)
-                surf_e = surf_def_h(1)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_def_h(1)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + s_flux_def_h_down(m) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Natural-type surfaces, upward-facing
-                surf_s = surf_lsm_h(0)%start_index(j,i)
-                surf_e = surf_lsm_h(0)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_lsm_h(0)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + s_flux_lsm_h_up(m) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Natural-type surfaces, downward-facing
-                surf_s = surf_lsm_h(1)%start_index(j,i)
-                surf_e = surf_lsm_h(1)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_lsm_h(1)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + s_flux_lsm_h_down(m) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Urban-type surfaces, upward-facing
-                surf_s = surf_usm_h(0)%start_index(j,i)
-                surf_e = surf_usm_h(0)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_usm_h(0)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + s_flux_usm_h_up(m) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Urban-type surfaces, downward-facing
-                surf_s = surf_usm_h(1)%start_index(j,i)
-                surf_e = surf_usm_h(1)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_usm_h(1)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + s_flux_usm_h_down(m) * ddzw(k) * drho_air(k)
-                ENDDO
-
-             ENDIF
-!
-!--          Vertical diffusion at the last computational gridpoint along z-direction
-             IF ( use_top_fluxes )  THEN
-                surf_s = surf_def_h(2)%start_index(j,i)
-                surf_e = surf_def_h(2)%end_index(j,i)
-                DO  m = surf_s, surf_e
-
-                   k   = surf_def_h(2)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(m) ) * ddzw(k) * drho_air(k)
+!--          Apply prescribed horizontal wall heatflux where necessary
+             IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
+             THEN
+                DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
+
+                   tend(k,j,i) = tend(k,j,i)                                  &
+                                          + 0.5 * ( fwxp(j,i) *               &
+                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
+                        - ( 1.0 - fwxp(j,i) ) * wall_heatflux(1)              &
+                                                   -fwxm(j,i) *               &
+                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
+                        + ( 1.0 - fwxm(j,i) ) * wall_heatflux(3)              &
+                                                  ) * ddx2                    &
+                                          + 0.5 * ( fwyp(j,i) *               &
+                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
+                        - ( 1.0 - fwyp(j,i) ) * wall_heatflux(2)              &
+                                                   -fwym(j,i) *               &
+                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
+                        + ( 1.0 - fwym(j,i) ) * wall_heatflux(4)              &
+                                                  ) * ddy2
                 ENDDO
              ENDIF
 
+!
+!--          Compute vertical diffusion. In case that surface fluxes have been
+!--          presribed or computed, index k starts at nzb+2.
+             DO  k = nzb_diff_s_inner(j,i), nzt-1
+
+                tend(k,j,i) = tend(k,j,i)                                     &
+                                       + 0.5 * (                              &
+            ( 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 in &
+!--          z-direction
+             IF ( use_surface_fluxes )  THEN
+
+                k = nzb_s_inner(j,i)+1
+
+                tend(k,j,i) = tend(k,j,i)                                     &
+                                       + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )    &
+                                               * ( s(k+1,j,i)-s(k,j,i) )      &
+                                               * ddzu(k+1)                    &
+                                           + s_flux(j,i)                      &
+                                         ) * ddzw(k)
+
+             ENDIF
+
           ENDDO
        ENDDO
@@ -396,303 +149,87 @@
     END SUBROUTINE diffusion_s
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_s_ij( i, j, s,                                                            &
-                               s_flux_def_h_up,    s_flux_def_h_down,                              &
-                               s_flux_t,                                                           &
-                               s_flux_lsm_h_up,    s_flux_lsm_h_down,                              &
-                               s_flux_usm_h_up,    s_flux_usm_h_down,                              &
-                               s_flux_def_v_north, s_flux_def_v_south,                             &
-                               s_flux_def_v_east,  s_flux_def_v_west,                              &
-                               s_flux_lsm_v_north, s_flux_lsm_v_south,                             &
-                               s_flux_lsm_v_east,  s_flux_lsm_v_west,                              &
-                               s_flux_usm_v_north, s_flux_usm_v_south,                             &
-                               s_flux_usm_v_east,  s_flux_usm_v_west )
-
-       USE arrays_3d,                                                                              &
-           ONLY:  ddzu, ddzw, kh, tend, drho_air, rho_air_zw
-
-       USE control_parameters,                                                                     &
-           ONLY: use_surface_fluxes, use_top_fluxes
-
-       USE grid_variables,                                                                         &
-           ONLY:  ddx, ddx2, ddy, ddy2
-
-       USE indices,                                                                                &
-           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_total_0
-
-       USE kinds
-
-       USE surface_mod,                                                                            &
-           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_s_ij( i, j, ddzu, ddzw, kh, s, s_flux, tend )
+
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i             !< running index x direction
-       INTEGER(iwp) ::  j             !< running index y direction
-       INTEGER(iwp) ::  k             !< running index z direction
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
-
-       REAL(wp) ::  flag              !< flag to mask topography grid points
-       REAL(wp) ::  mask_bottom       !< flag to mask vertical upward-facing surface
-       REAL(wp) ::  mask_east         !< flag to mask vertical surface east of the grid point
-       REAL(wp) ::  mask_north        !< flag to mask vertical surface north of the grid point
-       REAL(wp) ::  mask_south        !< flag to mask vertical surface south of the grid point
-       REAL(wp) ::  mask_top          !< flag to mask vertical downward-facing surface
-       REAL(wp) ::  mask_west         !< flag to mask vertical surface west of the grid point
-
-       REAL(wp), DIMENSION(1:surf_def_h(1)%ns) ::  s_flux_def_h_down  !< flux at horizontal donwward-facing default-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_h(0)%ns) ::  s_flux_def_h_up    !< flux at horizontal upward-facing default-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_v(2)%ns) ::  s_flux_def_v_east  !< flux at east-facing vertical default-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_v(0)%ns) ::  s_flux_def_v_north !< flux at north-facing vertical default-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_v(1)%ns) ::  s_flux_def_v_south !< flux at south-facing vertical default-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_v(3)%ns) ::  s_flux_def_v_west  !< flux at west-facing vertical default-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_h(0)%ns) ::  s_flux_lsm_h_up    !< flux at horizontal upward-facing natural-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_h(1)%ns) ::  s_flux_lsm_h_down    !< flux at horizontal downward-facing natural-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_v(2)%ns) ::  s_flux_lsm_v_east  !< flux at east-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_v(0)%ns) ::  s_flux_lsm_v_north !< flux at north-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_v(1)%ns) ::  s_flux_lsm_v_south !< flux at south-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_lsm_v(3)%ns) ::  s_flux_lsm_v_west  !< flux at west-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_h(0)%ns) ::  s_flux_usm_h_up    !< flux at horizontal upward-facing urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_h(1)%ns) ::  s_flux_usm_h_down  !< flux at horizontal downward-facing urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_v(2)%ns) ::  s_flux_usm_v_east  !< flux at east-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_v(0)%ns) ::  s_flux_usm_v_north !< flux at north-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_v(1)%ns) ::  s_flux_usm_v_south !< flux at south-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_usm_v(3)%ns) ::  s_flux_usm_v_west  !< flux at west-facing vertical urban-type surfaces
-       REAL(wp), DIMENSION(1:surf_def_h(2)%ns) ::  s_flux_t           !< flux at model top
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !< treated scalar
-
+       INTEGER ::  i, j, k
+       REAL    ::  vertical_gridspace
+       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt)
+       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+       REAL, DIMENSION(:,:),   POINTER ::  s_flux
+       REAL, DIMENSION(:,:,:), POINTER ::  kh, s
 
 !
 !--    Compute horizontal diffusion
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography and wall-bounded grid points
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--       Predetermine flag to mask wall-bounded grid points, equivalent to former s_outer array
-          mask_west  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i-1), 0 ) )
-          mask_east  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i+1), 0 ) )
-          mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j-1,i), 0 ) )
-          mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j+1,i), 0 ) )
-!
-!--       Finally, determine flag to mask both topography itself as well as wall-bounded grid
-!--       points, which will be treated further below
-
-          tend(k,j,i) = tend(k,j,i)                                                                &
-                                          + 0.5_wp * (                                             &
-                            mask_east  * ( kh(k,j,i) + kh(k,j,i+1) )                               &
-                                       * ( s(k,j,i+1) - s(k,j,i)   )                               &
-                          - mask_west  * ( kh(k,j,i) + kh(k,j,i-1) )                               &
-                                       * ( s(k,j,i)   - s(k,j,i-1) )                               &
-                                                     ) * ddx2 * flag                               &
-                                          + 0.5_wp * (                                             &
-                            mask_north * ( kh(k,j,i) + kh(k,j+1,i) )                               &
-                                       * ( s(k,j+1,i) - s(k,j,i)   )                               &
-                          - mask_south * ( kh(k,j,i) + kh(k,j-1,i) )                               &
-                                       * ( s(k,j,i)  - s(k,j-1,i)  )                               &
-                                                     ) * ddy2 * flag
+       DO  k = nzb_s_outer(j,i)+1, nzt-1
+
+          tend(k,j,i) = tend(k,j,i)                                           &
+                                          + 0.5 * (                           &
+                        ( 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 * (                           &
+                        ( 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. First, determine start and end
-!--    index for respective (j,i)-index. Please note, in the flat case following loops will not be
-!--    entered, as surf_s=1 and surf_e=0. Furtermore, note, no vertical natural surfaces so far.
-!--    First, for default-type surfaces.
-!--    North-facing vertical default-type surfaces
-       surf_s = surf_def_v(0)%start_index(j,i)
-       surf_e = surf_def_v(0)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_def_v(0)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_def_v_north(m) * ddy
-       ENDDO
-!
-!--    South-facing vertical default-type surfaces
-       surf_s = surf_def_v(1)%start_index(j,i)
-       surf_e = surf_def_v(1)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_def_v(1)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_def_v_south(m) * ddy
-       ENDDO
-!
-!--    East-facing vertical default-type surfaces
-       surf_s = surf_def_v(2)%start_index(j,i)
-       surf_e = surf_def_v(2)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_def_v(2)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_def_v_east(m) * ddx
-       ENDDO
-!
-!--    West-facing vertical default-type surfaces
-       surf_s = surf_def_v(3)%start_index(j,i)
-       surf_e = surf_def_v(3)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_def_v(3)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_def_v_west(m) * ddx
-       ENDDO
-!
-!--    Now, for natural-type surfaces
-!--    North-facing
-       surf_s = surf_lsm_v(0)%start_index(j,i)
-       surf_e = surf_lsm_v(0)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_lsm_v(0)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_north(m) * ddy
-       ENDDO
-!
-!--    South-facing
-       surf_s = surf_lsm_v(1)%start_index(j,i)
-       surf_e = surf_lsm_v(1)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_lsm_v(1)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_south(m) * ddy
-       ENDDO
-!
-!--    East-facing
-       surf_s = surf_lsm_v(2)%start_index(j,i)
-       surf_e = surf_lsm_v(2)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_lsm_v(2)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_east(m) * ddx
-       ENDDO
-!
-!--    West-facing
-       surf_s = surf_lsm_v(3)%start_index(j,i)
-       surf_e = surf_lsm_v(3)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_lsm_v(3)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_west(m) * ddx
-       ENDDO
-!
-!--    Now, for urban-type surfaces
-!--    North-facing
-       surf_s = surf_usm_v(0)%start_index(j,i)
-       surf_e = surf_usm_v(0)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_usm_v(0)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_north(m) * ddy
-       ENDDO
-!
-!--    South-facing
-       surf_s = surf_usm_v(1)%start_index(j,i)
-       surf_e = surf_usm_v(1)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_usm_v(1)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_south(m) * ddy
-       ENDDO
-!
-!--    East-facing
-       surf_s = surf_usm_v(2)%start_index(j,i)
-       surf_e = surf_usm_v(2)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_usm_v(2)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_east(m) * ddx
-       ENDDO
-!
-!--    West-facing
-       surf_s = surf_usm_v(3)%start_index(j,i)
-       surf_e = surf_usm_v(3)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k           = surf_usm_v(3)%k(m)
-          tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_west(m) * ddx
-       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. Model top is also
-!--    mask if top flux is given.
-       DO  k = nzb+1, nzt
-!
-!--       Determine flags to mask topography below and above. Flag 0 is used to mask topography in
-!--       general, and flag 8 implies information about use_surface_fluxes. Flag 9 is used to
-!--       control flux at model top.
-          mask_bottom = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 8 ) )
-          mask_top    = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 8 ) )  *        &
-                        MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 9 ) )
-          flag        = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-          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)                      &
-                                                            * rho_air_zw(k)                        &
-                                                            * mask_top                             &
-                                    - ( kh(k,j,i) + kh(k-1,j,i) ) *                                &
-                                          ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)                        &
-                                                            * rho_air_zw(k-1)                      &
-                                                            * mask_bottom                          &
-                                                  ) * ddzw(k) * drho_air(k)                        &
-                                                              * flag
-       ENDDO
-
-!
-!--    Vertical diffusion at horizontal walls.
-!--    TO DO: Adjust for downward facing walls and mask already in main loop
-       IF ( use_surface_fluxes )  THEN
-!
-!--       Default-type surfaces, upward-facing
-          surf_s = surf_def_h(0)%start_index(j,i)
-          surf_e = surf_def_h(0)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_def_h(0)%k(m)
-             tend(k,j,i) = tend(k,j,i) + s_flux_def_h_up(m) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Default-type surfaces, downward-facing
-          surf_s = surf_def_h(1)%start_index(j,i)
-          surf_e = surf_def_h(1)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_def_h(1)%k(m)
-             tend(k,j,i) = tend(k,j,i) + s_flux_def_h_down(m) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Natural-type surfaces, upward-facing
-          surf_s = surf_lsm_h(0)%start_index(j,i)
-          surf_e = surf_lsm_h(0)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_lsm_h(0)%k(m)
-             tend(k,j,i) = tend(k,j,i) + s_flux_lsm_h_up(m) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Natural-type surfaces, downward-facing
-          surf_s = surf_lsm_h(1)%start_index(j,i)
-          surf_e = surf_lsm_h(1)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_lsm_h(1)%k(m)
-             tend(k,j,i) = tend(k,j,i) + s_flux_lsm_h_down(m) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Urban-type surfaces, upward-facing
-          surf_s = surf_usm_h(0)%start_index(j,i)
-          surf_e = surf_usm_h(0)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_usm_h(0)%k(m)
-             tend(k,j,i) = tend(k,j,i) + s_flux_usm_h_up(m) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Urban-type surfaces, upward-facing
-          surf_s = surf_usm_h(1)%start_index(j,i)
-          surf_e = surf_usm_h(1)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_usm_h(1)%k(m)
-             tend(k,j,i) = tend(k,j,i) + s_flux_usm_h_down(m) * ddzw(k) * drho_air(k)
+!--    Apply prescribed horizontal wall heatflux where necessary
+       IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
+       THEN
+          DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
+
+             tend(k,j,i) = tend(k,j,i)                                        &
+                                          + 0.5 * ( fwxp(j,i) *               &
+                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
+                        - ( 1.0 - fwxp(j,i) ) * wall_heatflux(1)              &
+                                                   -fwxm(j,i) *               &
+                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
+                        + ( 1.0 - fwxm(j,i) ) * wall_heatflux(3)              &
+                                                  ) * ddx2                    &
+                                          + 0.5 * ( fwyp(j,i) *               &
+                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
+                        - ( 1.0 - fwyp(j,i) ) * wall_heatflux(2)              &
+                                                   -fwym(j,i) *               &
+                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
+                        + ( 1.0 - fwym(j,i) ) * wall_heatflux(4)              &
+                                                  ) * ddy2
           ENDDO
        ENDIF
-!
-!--    Vertical diffusion at the last computational gridpoint along z-direction
-       IF ( use_top_fluxes )  THEN
-          surf_s = surf_def_h(2)%start_index(j,i)
-          surf_e = surf_def_h(2)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_def_h(2)%k(m)
-             tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(m) ) * ddzw(k) * drho_air(k)
-          ENDDO
+
+!
+!--    Compute vertical diffusion. In case that surface fluxes have been
+!--    presribed or computed, index k starts at nzb+2.
+       DO  k = nzb_diff_s_inner(j,i), nzt-1
+
+          tend(k,j,i) = tend(k,j,i)                                           &
+                                       + 0.5 * (                              &
+            ( 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 in z-direction
+       IF ( use_surface_fluxes )  THEN
+
+          k = nzb_s_inner(j,i)+1
+
+          tend(k,j,i) = tend(k,j,i)                                           &
+                                       + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )    &
+                                               * ( s(k+1,j,i)-s(k,j,i) )      &
+                                               * ddzu(k+1)                    &
+                                           + s_flux(j,i)                      &
+                                         ) * ddzw(k)
+
        ENDIF
 
Index: palm/trunk/SOURCE/diffusion_u.f90
===================================================================
--- palm/trunk/SOURCE/diffusion_u.f90	(revision 4901)
+++ palm/trunk/SOURCE/diffusion_u.f90	(revision 1)
@@ -1,47 +1,67 @@
-!> @file diffusion_u.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE diffusion_u_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
-!
+! 
+! 
 ! Former revisions:
 ! -----------------
-! $Id$
-! Update ACC directives for downward facing USM and LSM surfaces
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
+! $Log: diffusion_u.f90,v $
+! Revision 1.15  2006/02/23 10:35:35  raasch
+! nzb_2d replaced by nzb_u_outer in horizontal diffusion and by nzb_u_inner
+! or nzb_diff_u, respectively, in vertical diffusion,
+! wall functions added for north and south walls, +z0 in argument list,
+! terms containing w(k-1,..) are removed from the Prandtl-layer equation
+! because they cause errors at the edges of topography
+! WARNING: loops containing the MAX function are still not properly vectorized!
+!
+! Revision 1.14  2005/03/26 20:08:21  raasch
+! Extension of horizontal loop upper bounds for non-cyclic boundary conditions,
+! additional damping layer at the outflow in case of non-cyclic lateral
+! boundaries, additional argument km_damp_y
+!
+! Revision 1.13  2004/01/30 10:21:32  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.12  2003/03/12 16:26:14  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.11  2002/06/11 12:53:12  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.10  2001/08/21 08:25:55  raasch
+! Special treatment at k=1 generally if momentum flux is prescribed (not only in
+! case of a Prandtl layer)
+!
+! Revision 1.9  2001/03/30 07:12:02  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.8  2001/01/22 06:14:00  raasch
+! Module test_variables removed
+!
+! Revision 1.7  2000/07/03 12:57:46  raasch
+! dummy arguments, whose corresponding actual arguments are pointers,
+! are now also defined as pointers,
+! all comments translated into English
+!
+! Revision 1.6  2000/03/14 13:55:33  schroeter
+! vertical impulse fluxes are computed over dz at the
+! top of the Prandtl-layer
+!
+! Revision 1.5  98/07/06  12:11:42  12:11:42  raasch (Siegfried Raasch)
+! + USE test_variables
 ! 
-! 4583 2020-06-29 12:36:47Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! OpenACC port for SPEC
+! Revision 1.4  1998/01/23 09:56:44  raasch
+! Einbau der Prandtl-Schicht
+!
+! Revision 1.3  1997/09/12 07:22:50  raasch
+! Leerzeilen mussten entfernt werden
+!
+! Revision 1.2  1997/09/12 06:43:27  raasch
+! HP-Compiler erfordert & am Beginn von Fortsetzungszeilen
 !
 ! Revision 1.1  1997/09/12 06:23:51  raasch
@@ -51,10 +71,6 @@
 ! 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
-
+! Diffusion term of the u-component
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -69,246 +85,146 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_u
-
-       USE arrays_3d,                                                                              &
-           ONLY:  ddzu, ddzw, drho_air, km, rho_air_zw, tend, u, v, w
-
-       USE control_parameters,                                                                     &
-           ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
-
-       USE grid_variables,                                                                         &
-           ONLY:  ddx, ddx2, ddy
-
-       USE indices,                                                                                &
-           ONLY:  nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_total_0
-
-       USE kinds
-
-       USE surface_mod,                                                                            &
-           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_u( ddzu, ddzw, km, km_damp_y, tend, u, usws, v, w, z0 )
+
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i             !< running index x direction
-       INTEGER(iwp) ::  j             !< running index y direction
-       INTEGER(iwp) ::  k             !< running index z direction
-       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< end index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< start index of surface elements at (j,i)-gridpoint
-
-       REAL(wp)     ::  flag          !< flag to mask topography grid points
-       REAL(wp)     ::  kmym          !< diffusion coefficient on southward side of the u-gridbox - interpolated onto xu-yv grid
-       REAL(wp)     ::  kmyp          !< diffusion coefficient on northward side of the u-gridbox - interpolated onto xu-yv grid
-       REAL(wp)     ::  kmzm          !< diffusion coefficient on bottom of the gridbox - interpolated onto xu-zw grid
-       REAL(wp)     ::  kmzp          !< diffusion coefficient on top of the gridbox - interpolated onto xu-zw grid
-       REAL(wp)     ::  mask_bottom   !< flag to mask vertical upward-facing surface
-       REAL(wp)     ::  mask_north    !< flag to mask vertical surface north of the grid point
-       REAL(wp)     ::  mask_south    !< flag to mask vertical surface south of the grid point
-       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface
-
-
-
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, l, m) &
-       !$ACC PRIVATE(surf_e, surf_s, flag, kmym, kmyp, kmzm, kmzp) &
-       !$ACC PRIVATE(mask_bottom, mask_north, mask_south, mask_top) &
-       !$ACC PRESENT(wall_flags_total_0, km) &
-       !$ACC PRESENT(u, v, w) &
-       !$ACC PRESENT(ddzu, ddzw, drho_air, rho_air_zw) &
-       !$ACC PRESENT(surf_def_h(0:2), surf_def_v(0:1)) &
-       !$ACC PRESENT(surf_lsm_h(0:1), surf_lsm_v(0:1)) &
-       !$ACC PRESENT(surf_usm_h(0:1), surf_usm_v(0:1)) &
-       !$ACC PRESENT(tend)
-       DO  i = nxlu, nxr
-          DO  j = nys, nyn
+       INTEGER ::  i, j, k
+       REAL    ::  kmym_x, kmym_y, kmyp_x, kmyp_y, kmzm, kmzp, usvs
+       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt), km_damp_y(nys-1:nyn+1)
+       REAL    ::  z0(nys-1:nyn+1,nxl-1:nxr+1)
+       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+       REAL, DIMENSION(:,:),   POINTER ::  usws
+       REAL, DIMENSION(:,:,:), POINTER ::  km, u, v, w
+
+       DO  i = nxl, nxr+uxrp
+          DO  j = nys,nyn
 !
 !--          Compute horizontal diffusion
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography and wall-bounded grid points.
-!--             It is sufficient to masked only north- and south-facing surfaces, which need special
-!--             treatment for the u-component.
-                flag       = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i),   1 ) )
-                mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j-1,i), 1 ) )
-                mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j+1,i), 1 ) )
+             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 * flag                                           &
-                              +          ( mask_north * (                                          &
-                                  kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy                       &
-                                + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx                       &
-                                                        )                                          &
-                                         - mask_south * (                                          &
-                                  kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy                           &
-                                + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx                           &
-                                                        )                                          &
-                                         ) * ddy  * flag
+                kmyp_x = 0.25 * &
+                         ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+                kmym_x = 0.25 * &
+                         ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+                kmyp_y = kmyp_x
+                kmym_y = kmym_x
+!
+!--             Increase diffusion at the outflow boundary in case of
+!--             non-cyclic lateral boundaries. Damping is only needed for
+!--             velocity components parallel to the outflow boundary in
+!--             the direction normal to the outflow boundary.
+                IF ( bc_ns /= 'cyclic' )  THEN
+                   kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+                   kmym_y = MAX( kmym_y, km_damp_y(j) )
+                ENDIF
+
+                tend(k,j,i) = tend(k,j,i)                                    &
+                      & + 2.0 * (                                            &
+                      &           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_y * ( u(k,j+1,i) - u(k,j,i)     ) * ddy     &
+                      &   + kmyp_x * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx     &
+                      &   - kmym_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy         &
+                      &   - kmym_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx         &
+                      &   ) * ddy
              ENDDO
-!
-!--          Add horizontal momentum flux u'v' at north- (l=0) and south-facing (l=1) surfaces.
-!--          Note, in the the flat case, loops won't be entered as start_index > end_index.
-!--          Furtermore, note, no vertical natural surfaces so far.
-!--          Default-type surfaces
-             DO  l = 0, 1
-                surf_s = surf_def_v(l)%start_index(j,i)
-                surf_e = surf_def_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_def_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_uv(m) * ddy
-                ENDDO
-             ENDDO
-!
-!--          Natural-type surfaces
-             DO  l = 0, 1
-                surf_s = surf_lsm_v(l)%start_index(j,i)
-                surf_e = surf_lsm_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_lsm_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_uv(m) * ddy
-                ENDDO
-             ENDDO
-!
-!--          Urban-type surfaces
-             DO  l = 0, 1
-                surf_s = surf_usm_v(l)%start_index(j,i)
-                surf_e = surf_usm_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_usm_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_uv(m) * ddy
-                ENDDO
-             ENDDO
-
-!
-!--          Compute vertical diffusion. In case of simulating a surface layer, respective grid
-!--          diffusive fluxes are masked (flag 8) within this loop, and added further below, else,
-!--          simple gradient approach is applied. Model top is also mask if top-momentum flux is
-!--          given.
-             DO  k = nzb+1, nzt
-!
-!--             Determine flags to mask topography below and above. Flag 1 is used to mask
-!--             topography in general, and flag 8 implies information about use_surface_fluxes.
-!--             Flag 9 is used to control momentum flux at model top.
-                mask_bottom = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 8 ) )
-                mask_top    = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 8 ) ) *   &
-                              MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 9 ) )
-                flag        = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,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) )
-                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                       &
-                                         ) * rho_air_zw(k)   * mask_top                            &
-                                - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)                 &
-                                         + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx                     &
-                                         ) * rho_air_zw(k-1) * mask_bottom                         &
-                                ) * ddzw(k) * drho_air(k) * flag
-             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
-!
-!--             Default-type surfaces, upward-facing
-                surf_s = surf_def_h(0)%start_index(j,i)
-                surf_e = surf_def_h(0)%end_index(j,i)
-                DO  m = surf_s, surf_e
-
-                   k   = surf_def_h(0)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - ( - surf_def_h(0)%usws(m) ) ) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Default-type surfaces, dowward-facing
-                surf_s = surf_def_h(1)%start_index(j,i)
-                surf_e = surf_def_h(1)%end_index(j,i)
-                DO  m = surf_s, surf_e
-
-                   k   = surf_def_h(1)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - surf_def_h(1)%usws(m) ) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Natural-type surfaces, upward-facing
-                surf_s = surf_lsm_h(0)%start_index(j,i)
-                surf_e = surf_lsm_h(0)%end_index(j,i)
-                DO  m = surf_s, surf_e
-
-                   k   = surf_lsm_h(0)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - ( - surf_lsm_h(0)%usws(m) ) ) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Natural-type surfaces, downward-facing
-                surf_s = surf_lsm_h(1)%start_index(j,i)
-                surf_e = surf_lsm_h(1)%end_index(j,i)
-                DO  m = surf_s, surf_e
-
-                   k   = surf_lsm_h(1)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - surf_lsm_h(1)%usws(m) ) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Urban-type surfaces, upward-facing
-                surf_s = surf_usm_h(0)%start_index(j,i)
-                surf_e = surf_usm_h(0)%end_index(j,i)
-                DO  m = surf_s, surf_e
-
-                   k   = surf_usm_h(0)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - ( - surf_usm_h(0)%usws(m) ) ) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Urban-type surfaces, downward-facing
-                surf_s = surf_usm_h(1)%start_index(j,i)
-                surf_e = surf_usm_h(1)%end_index(j,i)
-                DO  m = surf_s, surf_e
-
-                   k   = surf_usm_h(1)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - surf_usm_h(1)%usws(m) ) * ddzw(k) * drho_air(k)
-                ENDDO
-
-             ENDIF
-!
-!--          Add momentum flux at model top
-             IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
-                surf_s = surf_def_h(2)%start_index(j,i)
-                surf_e = surf_def_h(2)%end_index(j,i)
-                DO  m = surf_s, surf_e
-
-                   k   = surf_def_h(2)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - surf_def_h(2)%usws(m) ) * ddzw(k) * drho_air(k)
+
+!
+!--          Wall functions at the north and south walls, respectively
+             IF ( wall_u(j,i) /= 0.0 )  THEN
+                DO  k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
+                   usvs   = kappa * u(k,j,i) / LOG( 0.5 * dy / z0(j,i) )
+                   usvs   = -usvs * ABS( usvs )
+                   kmyp_x = 0.25 * &
+                            ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+                   kmym_x = 0.25 * &
+                            ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+                   kmyp_y = kmyp_x
+                   kmym_y = kmym_x
+!
+!--                Increase diffusion at the outflow boundary in case of
+!--                non-cyclic lateral boundaries. Damping is only needed for
+!--                velocity components parallel to the outflow boundary in
+!--                the direction normal to the outflow boundary.
+                   IF ( bc_ns /= 'cyclic' )  THEN
+                      kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+                      kmym_y = MAX( kmym_y, km_damp_y(j) )
+                   ENDIF
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                 + 2.0 * (                                     &
+                                       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_y * ( u(k,j+1,i) - u(k,j,i)     ) * ddy &
+                                + kmyp_x * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx &
+                                                  )                            &
+                                     - fym(j,i) * (                            &
+                                  kmym_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy     &
+                                + kmym_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx     &
+                                                  )                            &
+                                     + wall_u(j,i) * usvs                      &
+                                   ) * 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
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzp = 0.25 * &
+                       ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+                kmzm = 0.25 * &
+                       ( 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) modell 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 * &
+                      ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+                kmzm = 0.25 * &
+                      ( 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
+
           ENDDO
        ENDDO
@@ -317,220 +233,137 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_u_ij( i, j )
-
-       USE arrays_3d,                                                                              &
-           ONLY:  ddzu, ddzw, drho_air, km, tend, u, v, w, rho_air_zw
-
-       USE control_parameters,                                                                     &
-           ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
-
-       USE grid_variables,                                                                         &
-           ONLY:  ddx, ddx2, ddy
-
-       USE indices,                                                                                &
-           ONLY:  nzb, nzt, wall_flags_total_0
-
-       USE kinds
-
-       USE surface_mod,                                                                            &
-           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_u_ij( i, j, ddzu, ddzw, km, km_damp_y, tend, u, usws, &
+                               v, w, z0 )
+
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i             !< running index x direction
-       INTEGER(iwp) ::  j             !< running index y direction
-       INTEGER(iwp) ::  k             !< running index z direction
-       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
-
-       REAL(wp)     ::  flag          !< flag to mask topography grid points
-       REAL(wp)     ::  kmym          !< diffusion coefficient on southward side of the u-gridbox - interpolated onto xu-yv grid
-       REAL(wp)     ::  kmyp          !<diffusion coefficient on northward side of the u-gridbox - interpolated onto xu-yv grid
-       REAL(wp)     ::  kmzm          !< diffusion coefficient on bottom of the gridbox - interpolated onto xu-zw grid
-       REAL(wp)     ::  kmzp          !< diffusion coefficient on top of the gridbox - interpolated onto xu-zw grid
-       REAL(wp)     ::  mask_bottom   !< flag to mask vertical upward-facing surface
-       REAL(wp)     ::  mask_north    !< flag to mask vertical surface north of the grid point
-       REAL(wp)     ::  mask_south    !< flag to mask vertical surface south of the grid point
-       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface
+       INTEGER ::  i, j, k
+       REAL    ::  kmym_x, kmym_y, kmyp_x, kmyp_y, kmzm, kmzp, usvs
+       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt), km_damp_y(nys-1:nyn+1)
+       REAL    ::  z0(nys-1:nyn+1,nxl-1:nxr+1)
+       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+       REAL, DIMENSION(:,:),   POINTER ::  usws
+       REAL, DIMENSION(:,:,:), POINTER ::  km, u, v, w
+
 !
 !--    Compute horizontal diffusion
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography and wall-bounded grid points.
-!--       It is sufficient to masked only north- and south-facing surfaces, which need special
-!--       treatment for the u-component.
-          flag       = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i),   1 ) )
-          mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j-1,i), 1 ) )
-          mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j+1,i), 1 ) )
+       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 * flag                                         &
-                                         + (                                                       &
-                          mask_north * kmyp * ( ( u(k,j+1,i) - u(k,j,i)     ) * ddy                &
-                                              + ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx                &
-                                              )                                                    &
-                        - mask_south * kmym * ( ( u(k,j,i)   - u(k,j-1,i)   ) * ddy                &
-                                              + ( v(k,j,i)   - v(k,j,i-1)   ) * ddx                &
-                                              )                                                    &
-                                           ) * ddy  * flag
+          kmyp_x = 0.25 * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+          kmym_x = 0.25 * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+          kmyp_y = kmyp_x
+          kmym_y = kmym_x
+
+!
+!--       Increase diffusion at the outflow boundary in case of non-cyclic
+!--       lateral boundaries. Damping is only needed for velocity components
+!--       parallel to the outflow boundary in the direction normal to the
+!--       outflow boundary.
+          IF ( bc_ns /= 'cyclic' )  THEN
+             kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+             kmym_y = MAX( kmym_y, km_damp_y(j) )
+          ENDIF
+
+          tend(k,j,i) = tend(k,j,i)                                          &
+                      & + 2.0 * (                                            &
+                      &           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_y * ( u(k,j+1,i) - u(k,j,i)     ) * ddy     &
+                      &   + kmyp_x * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx     &
+                      &   - kmym_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy         &
+                      &   - kmym_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx         &
+                      &   ) * ddy
        ENDDO
 
 !
-!--    Add horizontal momentum flux u'v' at north- (l=0) and south-facing (l=1) surfaces. Note, in
-!--    the the flat case, loops won't be entered as start_index > end_index. Furtermore, note, no
-!--    vertical natural surfaces so far.
-!--    Default-type surfaces
-       DO  l = 0, 1
-          surf_s = surf_def_v(l)%start_index(j,i)
-          surf_e = surf_def_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_def_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_uv(m) * ddy
-          ENDDO
-       ENDDO
-!
-!--    Natural-type surfaces
-       DO  l = 0, 1
-          surf_s = surf_lsm_v(l)%start_index(j,i)
-          surf_e = surf_lsm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_lsm_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_uv(m) * ddy
-          ENDDO
-       ENDDO
-!
-!--    Urban-type surfaces
-       DO  l = 0, 1
-          surf_s = surf_usm_v(l)%start_index(j,i)
-          surf_e = surf_usm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_usm_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_uv(m) * ddy
-          ENDDO
-       ENDDO
-!
-!--    Compute vertical diffusion. In case of simulating a surface layer, respective grid diffusive
-!--    fluxes are masked (flag 8) within this loop, and added further below, else, simple gradient
-!--    approach is applied. Model top is also mask if top-momentum flux is given.
-       DO  k = nzb+1, nzt
-!
-!--       Determine flags to mask topography below and above. Flag 1 is used to mask topography in
-!--       general, and flag 8 implies information about use_surface_fluxes. Flag 9 is used to
-!--       control momentum flux at model top.
-          mask_bottom = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 8 ) )
-          mask_top    = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 8 ) ) *         &
-                        MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 9 ) )
-          flag        = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,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) )
-          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                             &
-                                   ) * rho_air_zw(k)   * mask_top                                  &
-                          - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)                       &
-                                   + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx                           &
-                                   ) * rho_air_zw(k-1) * mask_bottom                               &
-                          ) * ddzw(k) * drho_air(k) * flag
-       ENDDO
-
-!
-!--    Vertical diffusion at the first surface grid points, 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.
-       IF ( use_surface_fluxes )  THEN
-!
-!--       Default-type surfaces, upward-facing
-          surf_s = surf_def_h(0)%start_index(j,i)
-          surf_e = surf_def_h(0)%end_index(j,i)
-          DO  m = surf_s, surf_e
-
-             k   = surf_def_h(0)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - ( - surf_def_h(0)%usws(m) ) ) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Default-type surfaces, dowward-facing (except for model-top fluxes)
-          surf_s = surf_def_h(1)%start_index(j,i)
-          surf_e = surf_def_h(1)%end_index(j,i)
-          DO  m = surf_s, surf_e
-
-             k   = surf_def_h(1)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - surf_def_h(1)%usws(m) ) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Natural-type surfaces, upward-facing
-          surf_s = surf_lsm_h(0)%start_index(j,i)
-          surf_e = surf_lsm_h(0)%end_index(j,i)
-          DO  m = surf_s, surf_e
-
-             k   = surf_lsm_h(0)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - ( - surf_lsm_h(0)%usws(m) ) ) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Natural-type surfaces, downward-facing
-          surf_s = surf_lsm_h(1)%start_index(j,i)
-          surf_e = surf_lsm_h(1)%end_index(j,i)
-          DO  m = surf_s, surf_e
-
-             k   = surf_lsm_h(1)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - surf_lsm_h(1)%usws(m) ) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Urban-type surfaces, upward-facing
-          surf_s = surf_usm_h(0)%start_index(j,i)
-          surf_e = surf_usm_h(0)%end_index(j,i)
-          DO  m = surf_s, surf_e
-
-             k   = surf_usm_h(0)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - ( - surf_usm_h(0)%usws(m) ) ) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Urban-type surfaces, downward-facing
-          surf_s = surf_usm_h(1)%start_index(j,i)
-          surf_e = surf_usm_h(1)%end_index(j,i)
-          DO  m = surf_s, surf_e
-
-             k   = surf_usm_h(1)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - surf_usm_h(1)%usws(m) ) * ddzw(k) * drho_air(k)
-          ENDDO
-
-       ENDIF
-!
-!--    Add momentum flux at model top
-       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
-          surf_s = surf_def_h(2)%start_index(j,i)
-          surf_e = surf_def_h(2)%end_index(j,i)
-          DO  m = surf_s, surf_e
-
-             k   = surf_def_h(2)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - surf_def_h(2)%usws(m) ) * ddzw(k) * drho_air(k)
+!--    Wall functions at the north and south walls, respectively
+       IF ( wall_u(j,i) .NE. 0.0 )  THEN
+          DO  k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
+             usvs   = kappa * u(k,j,i) / LOG( 0.5 * dy / z0(j,i) )
+             usvs   = -usvs * ABS( usvs )
+             kmyp_x = 0.25 * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+             kmym_x = 0.25 * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+             kmyp_y = kmyp_x
+             kmym_y = kmym_x
+!
+!--          Increase diffusion at the outflow boundary in case of
+!--          non-cyclic lateral boundaries. Damping is only needed for
+!--          velocity components parallel to the outflow boundary in
+!--          the direction normal to the outflow boundary.
+             IF ( bc_ns /= 'cyclic' )  THEN
+                kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+                kmym_y = MAX( kmym_y, km_damp_y(j) )
+             ENDIF
+
+             tend(k,j,i) = tend(k,j,i)                                         &
+                                 + 2.0 * (                                     &
+                                       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_y * ( u(k,j+1,i) - u(k,j,i)     ) * ddy &
+                                + kmyp_x * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx &
+                                                  )                            &
+                                     - fym(j,i) * (                            &
+                                  kmym_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy     &
+                                + kmym_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx     &
+                                                  )                            &
+                                     + wall_u(j,i) * usvs                      &
+                                   ) * 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
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmzp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+          kmzm = 0.25 * ( 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) modell 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 * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+          kmzm = 0.25 * ( 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
 
     END SUBROUTINE diffusion_u_ij
Index: palm/trunk/SOURCE/diffusion_v.f90
===================================================================
--- palm/trunk/SOURCE/diffusion_v.f90	(revision 4901)
+++ palm/trunk/SOURCE/diffusion_v.f90	(revision 1)
@@ -1,47 +1,67 @@
-!> @file diffusion_v.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE diffusion_v_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Update ACC directives for downward facing USM and LSM surfaces
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
+! $Log: diffusion_v.f90,v $
+! Revision 1.15  2006/02/23 10:36:00  raasch
+! nzb_2d replaced by nzb_v_outer in horizontal diffusion and by nzb_v_inner
+! or nzb_diff_v, respectively, in vertical diffusion,
+! wall functions added for north and south walls, +z0 in argument list,
+! terms containing w(k-1,..) are removed from the Prandtl-layer equation
+! because they cause errors at the edges of topography
+! WARNING: loops containing the MAX function are still not properly vectorized!
+!
+! Revision 1.14  2005/03/26 20:09:56  raasch
+! Extension of horizontal loop upper bounds for non-cyclic boundary conditions,
+! additional damping layer at the outflow in case of non-cyclic lateral
+! boundaries, additional argument km_damp_x
+!
+! Revision 1.13  2004/01/30 10:21:56  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.12  2003/03/12 16:26:31  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.11  2002/06/11 12:53:46  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.10  2001/08/21 08:29:31  raasch
+! Special treatment at k=1 generally if momentum flux is prescribed (not only in
+! case of a Prandtl layer)
+!
+! Revision 1.9  2001/03/30 07:12:19  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.8  2001/01/22 06:18:41  raasch
+! Module test_variables removed
+!
+! Revision 1.7  2000/07/03 12:58:14  raasch
+! dummy arguments, whose corresponding actual arguments are pointers,
+! are now also defined as pointers,
+! all comments translated into English
+!
+! Revision 1.6  2000/03/14 13:58:18  schroeter
+! vertical impulse fluxes are computed over dz at the
+! top of the Prandtl-layer
+!
+! Revision 1.5  98/07/06  12:12:05  12:12:05  raasch (Siegfried Raasch)
+! + USE test_variables
 ! 
-! 4583 2020-06-29 12:36:47Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! OpenACC port for SPEC
+! Revision 1.4  1998/01/23 09:57:18  raasch
+! Einbau der Prandtl-Schicht
+!
+! Revision 1.3  1997/09/12 07:24:20  raasch
+! Leerzeilen mussten entfernt werden
+!
+! Revision 1.2  1997/09/12 06:43:46  raasch
+! HP-Compiler erfordert & am Beginn von Fortsetzungszeilen
 !
 ! Revision 1.1  1997/09/12 06:24:01  raasch
@@ -51,8 +71,6 @@
 ! Description:
 ! ------------
-!> Diffusion term of the v-component
-!--------------------------------------------------------------------------------------------------!
- MODULE diffusion_v_mod
-
+! Diffusion term of the v-component
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -67,239 +85,144 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_v
-
-       USE arrays_3d,                                                                              &
-           ONLY:  ddzu, ddzw, drho_air, km, rho_air_zw, tend, u, v, w 
-
-       USE control_parameters,                                                                     &
-           ONLY:  constant_top_momentumflux, use_surface_fluxes,  use_top_fluxes
-
-       USE grid_variables,                                                                         &
-           ONLY:  ddx, ddy, ddy2
-
-       USE indices,                                                                                &
-           ONLY:  nxl, nxr, nyn, nysv, nzb, nzt, wall_flags_total_0
-
-       USE kinds
-
-       USE surface_mod,                                                                            &
-           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_v( ddzu, ddzw, km, km_damp_x, tend, u, v, vsws, w, z0 )
+
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i             !< running index x direction
-       INTEGER(iwp) ::  j             !< running index y direction
-       INTEGER(iwp) ::  k             !< running index z direction
-       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
-
-       REAL(wp)     ::  flag          !< flag to mask topography grid points
-       REAL(wp)     ::  kmxm          !< diffusion coefficient on leftward side of the v-gridbox - interpolated onto xu-yv grid
-       REAL(wp)     ::  kmxp          !< diffusion coefficient on rightward side of the v-gridbox - interpolated onto xu-yv grid
-       REAL(wp)     ::  kmzm          !< diffusion coefficient on bottom of the gridbox - interpolated onto yv-zw grid
-       REAL(wp)     ::  kmzp          !< diffusion coefficient on top of the gridbox - interpolated onto yv-zw grid
-       REAL(wp)     ::  mask_bottom   !< flag to mask vertical upward-facing surface
-       REAL(wp)     ::  mask_east     !< flag to mask vertical surface south of the grid point
-       REAL(wp)     ::  mask_west     !< flag to mask vertical surface north of the grid point
-       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface
-
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, l, m) &
-       !$ACC PRIVATE(surf_e, surf_s, flag, kmxm, kmxp, kmzm, kmzp) &
-       !$ACC PRIVATE(mask_bottom, mask_east, mask_west, mask_top) &
-       !$ACC PRESENT(wall_flags_total_0, km) &
-       !$ACC PRESENT(u, v, w) &
-       !$ACC PRESENT(ddzu, ddzw, drho_air, rho_air_zw) &
-       !$ACC PRESENT(surf_def_h(0:2), surf_def_v(2:3)) &
-       !$ACC PRESENT(surf_lsm_h(0:1), surf_lsm_v(2:3)) &
-       !$ACC PRESENT(surf_usm_h(0:1), surf_usm_v(2:3)) &
-       !$ACC PRESENT(tend)
+       INTEGER ::  i, j, k
+       REAL    ::  kmxm_x, kmxm_y, kmxp_x, kmxp_y, kmzm, kmzp, vsus
+       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt), km_damp_x(nxl-1:nxr+1)
+       REAL    ::  z0(nys-1:nyn+1,nxl-1:nxr+1)
+       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+       REAL, DIMENSION(:,:),   POINTER ::  vsws
+       REAL, DIMENSION(:,:,:), POINTER ::  km, u, v, w
+
        DO  i = nxl, nxr
-          DO  j = nysv, nyn
+          DO  j = nys, nyn+vynp
 !
 !--          Compute horizontal diffusion
-             DO  k = nzb+1, nzt
-
-!
-!--             Predetermine flag to mask topography and wall-bounded grid points.
-!--             It is sufficient to masked only east- and west-facing surfaces, which need special
-!--             treatment for the v-component.
-                flag      = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i),   2 ) )
-                mask_east = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i+1), 2 ) )
-                mask_west = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i-1), 2 ) )
+             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) +          (                                             &
-                                mask_east * kmxp * (                                               &
-                                       ( v(k,j,i+1) - v(k,j,i)     ) * ddx                         &
-                                     + ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy                         &
-                                                   )                                               &
-                              - mask_west * kmxm * (                                               &
-                                       ( v(k,j,i) - v(k,j,i-1) ) * ddx                             &
-                                     + ( u(k,j,i) - u(k,j-1,i) ) * ddy                             &
-                                                   )                                               &
-                                                     ) * ddx  * flag                               &
-                                          + 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 * flag
-
+                kmxp_x = 0.25 * &
+                         ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+                kmxm_x = 0.25 * &
+                         ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+                kmxp_y = kmxp_x
+                kmxm_y = kmxm_x
+!
+!--             Increase diffusion at the outflow boundary in case of
+!--             non-cyclic lateral boundaries. Damping is only needed for
+!--             velocity components parallel to the outflow boundary in
+!--             the direction normal to the outflow boundary.
+                IF ( bc_lr /= 'cyclic' )  THEN
+                   kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+                   kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+                ENDIF
+
+                tend(k,j,i) = tend(k,j,i)                                    &
+                      & + ( kmxp_x * ( v(k,j,i+1) - v(k,j,i)     ) * ddx     &
+                      &   + kmxp_y * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy     &
+                      &   - kmxm_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx         &
+                      &   - kmxm_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy         &
+                      &   ) * ddx                                            &
+                      & + 2.0 * (                                            &
+                      &           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
 
 !
-!--          Add horizontal momentum flux v'u' at east- (l=2) and west-facing (l=3) surfaces. Note,
-!--          in the the flat case, loops won't be entered as start_index > end_index. Furtermore,
-!--          note, no vertical natural surfaces so far.
-!--          Default-type surfaces
-             DO  l = 2, 3
-                surf_s = surf_def_v(l)%start_index(j,i)
-                surf_e = surf_def_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_def_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_uv(m) * ddx
-                ENDDO
-             ENDDO
-!
-!--          Natural-type surfaces
-             DO  l = 2, 3
-                surf_s = surf_lsm_v(l)%start_index(j,i)
-                surf_e = surf_lsm_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_lsm_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_uv(m) * ddx
-                ENDDO
-             ENDDO
-!
-!--          Urban-type surfaces
-             DO  l = 2, 3
-                surf_s = surf_usm_v(l)%start_index(j,i)
-                surf_e = surf_usm_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_usm_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_uv(m) * ddx
-                ENDDO
-             ENDDO
-!
-!--          Compute vertical diffusion. In case of simulating a surface layer, respective grid
-!--          diffusive fluxes are masked (flag 10) within this loop, and added further below, else,
-!--          simple gradient approach is applied. Model top is also mask if top-momentum flux is
-!--          given.
-             DO  k = nzb+1, nzt
-!
-!--             Determine flags to mask topography below and above. Flag 2 is used to mask
-!--             topography in general, while flag 8 implies also information about
-!--             use_surface_fluxes. Flag 9 is used to control momentum flux at model top.
-                mask_bottom = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 8 ) )
-                mask_top    = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 8 ) ) *   &
-                              MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 9 ) )
-                flag        = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-!
-!--             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                       &
-                              &            ) * rho_air_zw(k)   * mask_top                          &
-                              &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)               &
-                              &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy                   &
-                              &            ) * rho_air_zw(k-1) * mask_bottom                       &
-                              &   ) * ddzw(k) * drho_air(k) * flag
-             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.
-             IF ( use_surface_fluxes )  THEN
-!
-!--             Default-type surfaces, upward-facing
-                surf_s = surf_def_h(0)%start_index(j,i)
-                surf_e = surf_def_h(0)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_def_h(0)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - ( - surf_def_h(0)%vsws(m) ) ) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Default-type surfaces, dowward-facing
-                surf_s = surf_def_h(1)%start_index(j,i)
-                surf_e = surf_def_h(1)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_def_h(1)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - surf_def_h(1)%vsws(m) ) * ddzw(k) * drho_air(k)
-                ENDDO
-!
-!--             Natural-type surfaces, upward-facing
-                surf_s = surf_lsm_h(0)%start_index(j,i)
-                surf_e = surf_lsm_h(0)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_lsm_h(0)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - ( - surf_lsm_h(0)%vsws(m) ) ) * ddzw(k) * drho_air(k)
-
-                ENDDO
-!
-!--             Natural-type surfaces, downward-facing
-                surf_s = surf_lsm_h(1)%start_index(j,i)
-                surf_e = surf_lsm_h(1)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_lsm_h(1)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 +  ( - surf_lsm_h(1)%vsws(m) ) * ddzw(k) * drho_air(k)
-
-                ENDDO
-!
-!--             Urban-type surfaces, upward-facing
-                surf_s = surf_usm_h(0)%start_index(j,i)
-                surf_e = surf_usm_h(0)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_usm_h(0)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - ( - surf_usm_h(0)%vsws(m) ) ) * ddzw(k) * drho_air(k)
-
-                ENDDO
-!
-!--             Urban-type surfaces, downward-facing
-                surf_s = surf_usm_h(1)%start_index(j,i)
-                surf_e = surf_usm_h(1)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k   = surf_usm_h(1)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - surf_usm_h(1)%vsws(m) ) * ddzw(k) * drho_air(k)
-
+!--          Wall functions at the left and right walls, respectively
+             IF ( wall_v(j,i) /= 0.0 )  THEN
+                DO  k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
+                   vsus   = kappa * v(k,j,i) / LOG( 0.5 * dx / z0(j,i))
+                   vsus   = -vsus * ABS( vsus )
+                   kmxp_x = 0.25 * &
+                            ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+                   kmxm_x = 0.25 * &
+                            ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+                   kmxp_y = kmxp_x
+                   kmxm_y = kmxm_x
+!
+!--                Increase diffusion at the outflow boundary in case of
+!--                non-cyclic lateral boundaries. Damping is only needed for
+!--                velocity components parallel to the outflow boundary in
+!--                the direction normal to the outflow boundary.
+                   IF ( bc_lr /= 'cyclic' )  THEN
+                      kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+                      kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+                   ENDIF
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                 + 2.0 * (                                     &
+                                       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_x * ( v(k,j,i+1) - v(k,j,i)     ) * ddx &
+                                + kmxp_y * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy &
+                                                  )                            &
+                                     - fxm(j,i) * (                            &
+                                  kmxm_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx     &
+                                + kmxm_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy     &
+                                                  )                            &
+                                     + wall_v(j,i) * vsus                      &
+                                   ) * ddx
                 ENDDO
              ENDIF
-!
-!--          Add momentum flux at model top
-             IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
-                surf_s = surf_def_h(2)%start_index(j,i)
-                surf_e = surf_def_h(2)%end_index(j,i)
-                DO  m = surf_s, surf_e
-
-                   k   = surf_def_h(2)%k(m)
-
-                   tend(k,j,i) = tend(k,j,i)                                                       &
-                                 + ( - surf_def_h(2)%vsws(m) ) * ddzw(k) * drho_air(k)
-                ENDDO
+
+!
+!--          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
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzp = 0.25 * &
+                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+                kmzm = 0.25 * &
+                       ( 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) modell 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 * &
+                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+                kmzm = 0.25 * &
+                       ( 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
 
@@ -310,218 +233,137 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_v_ij( i, j )
-
-       USE arrays_3d,                                                                              &
-           ONLY:  ddzu, ddzw, drho_air, km, tend, u, v, w, rho_air_zw
-
-       USE control_parameters,                                                                     &
-           ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
-
-       USE grid_variables,                                                                         &
-           ONLY:  ddx, ddy, ddy2
-
-       USE indices,                                                                                &
-           ONLY:  nzb, nzt, wall_flags_total_0
-
-       USE kinds
-
-       USE surface_mod,                                                                            &
-           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_v_ij( i, j, ddzu, ddzw, km, km_damp_x, tend, u, v, &
+                               vsws, w, z0 )
+
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
        IMPLICIT NONE
 
-
-       INTEGER(iwp) ::  i             !< running index x direction
-       INTEGER(iwp) ::  j             !< running index y direction
-       INTEGER(iwp) ::  k             !< running index z direction
-       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
-
-       REAL(wp)     ::  flag          !< flag to mask topography grid points
-       REAL(wp)     ::  kmxm          !< diffusion coefficient on leftward side of the v-gridbox - interpolated onto xu-yv grid
-       REAL(wp)     ::  kmxp          !< diffusion coefficient on rightward side of the v-gridbox - interpolated onto xu-yv grid
-       REAL(wp)     ::  kmzm          !< diffusion coefficient on bottom of the gridbox - interpolated onto xu-zw grid
-       REAL(wp)     ::  kmzp          !< diffusion coefficient on top of the gridbox - interpolated onto xu-zw grid
-       REAL(wp)     ::  mask_bottom   !< flag to mask vertical upward-facing surface
-       REAL(wp)     ::  mask_east     !< flag to mask vertical surface south of the grid point
-       REAL(wp)     ::  mask_west     !< flag to mask vertical surface north of the grid point
-       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface
+       INTEGER ::  i, j, k
+       REAL    ::  kmxm_x, kmxm_y, kmxp_x, kmxp_y, kmzm, kmzp, vsus
+       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt), km_damp_x(nxl-1:nxr+1)
+       REAL    ::  z0(nys-1:nyn+1,nxl-1:nxr+1)
+       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+       REAL, DIMENSION(:,:),   POINTER ::  vsws
+       REAL, DIMENSION(:,:,:), POINTER ::  km, u, v, w
 
 !
 !--    Compute horizontal diffusion
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography and wall-bounded grid points.
-!--       It is sufficient to masked only east- and west-facing surfaces, which need special
-!--       treatment for the v-component.
-          flag      = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i),   2 ) )
-          mask_east = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i+1), 2 ) )
-          mask_west = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i-1), 2 ) )
+       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) +          (                                                   &
-                          mask_east * kmxp * (                                                     &
-                                 ( v(k,j,i+1) - v(k,j,i)     ) * ddx                               &
-                               + ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy                               &
-                                             )                                                     &
-                        - mask_west * kmxm * (                                                     &
-                                 ( v(k,j,i) - v(k,j,i-1) ) * ddx                                   &
-                               + ( u(k,j,i) - u(k,j-1,i) ) * ddy                                   &
-                                             )                                                     &
-                                               ) * ddx  * flag                                     &
-                                    + 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 * flag
+          kmxp_x = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+          kmxm_x = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+          kmxp_y = kmxp_x
+          kmxm_y = kmxm_x
+!
+!--       Increase diffusion at the outflow boundary in case of non-cyclic
+!--       lateral boundaries. Damping is only needed for velocity components
+!--       parallel to the outflow boundary in the direction normal to the
+!--       outflow boundary.
+          IF ( bc_lr /= 'cyclic' )  THEN
+             kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+             kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+          ENDIF
+
+          tend(k,j,i) = tend(k,j,i)                                          &
+                      & + ( kmxp_x * ( v(k,j,i+1) - v(k,j,i)     ) * ddx     &
+                      &   + kmxp_y * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy     &
+                      &   - kmxm_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx         &
+                      &   - kmxm_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy         &
+                      &   ) * ddx                                            &
+                      & + 2.0 * (                                            &
+                      &           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
 
 !
-!--    Add horizontal momentum flux v'u' at east- (l=2) and west-facing (l=3) surfaces. Note, in the
-!--    the flat case, loops won't be entered as start_index > end_index. Furtermore, note, no
-!--    vertical natural surfaces so far.
-!--    Default-type surfaces
-       DO  l = 2, 3
-          surf_s = surf_def_v(l)%start_index(j,i)
-          surf_e = surf_def_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_def_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_uv(m) * ddx
-          ENDDO
-       ENDDO
-!
-!--    Natural-type surfaces
-       DO  l = 2, 3
-          surf_s = surf_lsm_v(l)%start_index(j,i)
-          surf_e = surf_lsm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_lsm_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_uv(m) * ddx
-          ENDDO
-       ENDDO
-!
-!--    Urban-type surfaces
-       DO  l = 2, 3
-          surf_s = surf_usm_v(l)%start_index(j,i)
-          surf_e = surf_usm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_usm_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_uv(m) * ddx
-          ENDDO
-       ENDDO
-!
-!--    Compute vertical diffusion. In case of simulating a surface layer, respective grid diffusive
-!--    fluxes are masked (flag 8) within this loop, and added further below, else, simple gradient
-!--    approach is applied. Model top is also mask if top-momentum flux is given.
-       DO  k = nzb+1, nzt
-!
-!--       Determine flags to mask topography below and above. Flag 2 is used to mask topography in
-!--       general, while flag 10 implies also information about use_surface_fluxes. Flag 9 is used
-!--       to control momentum flux at model top.
-          mask_bottom = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 8 ) )
-          mask_top    = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 8 ) ) *         &
-                        MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k+1,j,i), 9 ) )
-          flag        = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-!
-!--       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                             &
-                        &            ) * rho_air_zw(k)   * mask_top                                &
-                        &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)                     &
-                        &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy                         &
-                        &            ) * rho_air_zw(k-1) * mask_bottom                             &
-                        &   ) * ddzw(k) * drho_air(k) * flag
-       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.
-       IF ( use_surface_fluxes )  THEN
-!
-!--       Default-type surfaces, upward-facing
-          surf_s = surf_def_h(0)%start_index(j,i)
-          surf_e = surf_def_h(0)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_def_h(0)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - ( - surf_def_h(0)%vsws(m) ) ) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Default-type surfaces, dowward-facing
-          surf_s = surf_def_h(1)%start_index(j,i)
-          surf_e = surf_def_h(1)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_def_h(1)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - surf_def_h(1)%vsws(m) ) * ddzw(k) * drho_air(k)
-          ENDDO
-!
-!--       Natural-type surfaces, upward-facing
-          surf_s = surf_lsm_h(0)%start_index(j,i)
-          surf_e = surf_lsm_h(0)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_lsm_h(0)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - ( - surf_lsm_h(0)%vsws(m) ) ) * ddzw(k) * drho_air(k)
-
-          ENDDO
-!
-!--       Natural-type surfaces, downward-facing
-          surf_s = surf_lsm_h(1)%start_index(j,i)
-          surf_e = surf_lsm_h(1)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_lsm_h(1)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - surf_lsm_h(1)%vsws(m) ) * ddzw(k) * drho_air(k)
-
-          ENDDO
-!
-!--       Urban-type surfaces, upward-facing
-          surf_s = surf_usm_h(0)%start_index(j,i)
-          surf_e = surf_usm_h(0)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_usm_h(0)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - ( - surf_usm_h(0)%vsws(m) ) ) * ddzw(k) * drho_air(k)
-
-          ENDDO
-!
-!--       Urban-type surfaces, downward-facing
-          surf_s = surf_usm_h(1)%start_index(j,i)
-          surf_e = surf_usm_h(1)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k   = surf_usm_h(1)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - surf_usm_h(1)%vsws(m) ) * ddzw(k) * drho_air(k)
-
+!--    Wall functions at the left and right walls, respectively
+       IF ( wall_v(j,i) /= 0.0 )  THEN
+          DO  k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
+             vsus   = kappa * v(k,j,i) / LOG( 0.5 * dx / z0(j,i))
+             vsus   = -vsus * ABS( vsus )
+             kmxp_x = 0.25 * &
+                      ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+             kmxm_x = 0.25 * &
+                      ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+             kmxp_y = kmxp_x
+             kmxm_y = kmxm_x
+!
+!--          Increase diffusion at the outflow boundary in case of
+!--          non-cyclic lateral boundaries. Damping is only needed for
+!--          velocity components parallel to the outflow boundary in
+!--          the direction normal to the outflow boundary.
+             IF ( bc_lr /= 'cyclic' )  THEN
+                kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+                kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+             ENDIF
+
+             tend(k,j,i) = tend(k,j,i)                                         &
+                                 + 2.0 * (                                     &
+                                       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_x * ( v(k,j,i+1) - v(k,j,i)     ) * ddx &
+                                + kmxp_y * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy &
+                                                  )                            &
+                                     - fxm(j,i) * (                            &
+                                  kmxm_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx     &
+                                + kmxm_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy     &
+                                                  )                            &
+                                     + wall_v(j,i) * vsus                      &
+                                   ) * ddx
           ENDDO
        ENDIF
-!
-!--    Add momentum flux at model top
-       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
-          surf_s = surf_def_h(2)%start_index(j,i)
-          surf_e = surf_def_h(2)%end_index(j,i)
-          DO  m = surf_s, surf_e
-
-             k   = surf_def_h(2)%k(m)
-
-             tend(k,j,i) = tend(k,j,i) + ( - surf_def_h(2)%vsws(m) ) * ddzw(k) * drho_air(k)
-          ENDDO
+
+!
+!--    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
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmzp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+          kmzm = 0.25 * ( 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) modell 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 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+          kmzm = 0.25 * ( 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
 
Index: palm/trunk/SOURCE/diffusion_w.f90
===================================================================
--- palm/trunk/SOURCE/diffusion_w.f90	(revision 4901)
+++ palm/trunk/SOURCE/diffusion_w.f90	(revision 1)
@@ -1,41 +1,52 @@
-!> @file diffusion_w.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE diffusion_w_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! OpenACC port for SPEC
+! $Log: diffusion_w.f90,v $
+! Revision 1.12  2006/02/23 10:38:03  raasch
+! nzb_2d replaced by nzb_w_outer, wall functions added for all vertical walls,
+! +z0 in argument list
+! WARNING: loops containing the MAX function are still not properly vectorized!
+!
+! Revision 1.11  2005/03/26 20:11:05  raasch
+! Additional damping layer at the outflow in case of non-cyclic lateral
+! boundaries, additional arguments km_damp_x, km_damp_y
+!
+! Revision 1.10  2004/01/30 10:22:32  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.9  2003/03/12 16:26:49  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.8  2002/06/11 12:54:16  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.7  2001/03/30 07:12:35  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.6  2001/01/22 06:20:12  raasch
+! Module test_variables removed
+!
+! Revision 1.5  2000/07/03 12:58:40  raasch
+! dummy arguments, whose corresponding actual arguments are pointers,
+! are now also defined as pointers,
+! all comments translated into English
+!
+! Revision 1.4  1998/07/06 12:12:24  raasch
+! + USE test_variables
+!
+! Revision 1.3  1997/09/12 07:24:58  raasch
+! Leerzeilen mussten entfernt werden
+!
+! Revision 1.2  1997/09/12 06:44:00  raasch
+! HP-Compiler erfordert & am Beginn von Fortsetzungszeilen
 !
 ! Revision 1.1  1997/09/12 06:24:11  raasch
@@ -45,8 +56,6 @@
 ! Description:
 ! ------------
-!> Diffusion term of the w-component
-!--------------------------------------------------------------------------------------------------!
- MODULE diffusion_w_mod
-
+! Diffusion term of the w-component
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -61,169 +70,145 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_w
-
-       USE arrays_3d,                                                                              &
-           ONLY :  ddzu, ddzw, drho_air_zw, km, rho_air, tend, u, v, w
-
-       USE grid_variables,                                                                         &
-           ONLY :  ddx, ddy
-
-       USE indices,                                                                                &
-           ONLY :  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_total_0
-
-       USE kinds
-
-       USE surface_mod,                                                                            &
-           ONLY :  surf_def_v, surf_lsm_v, surf_usm_v
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_w( ddzu, ddzw, km, km_damp_x, km_damp_y, tend, u, v, &
+                            w, z0 )
+
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i             !< running index x direction
-       INTEGER(iwp) ::  j             !< running index y direction
-       INTEGER(iwp) ::  k             !< running index z direction
-       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
-
-       REAL(wp) ::  flag              !< flag to mask topography grid points
-       REAL(wp) ::  kmxm              !< diffusion coefficient on leftward side of the w-gridbox - interpolated onto xu-y grid
-       REAL(wp) ::  kmxp              !<diffusion coefficient on rightward side of the w-gridbox - interpolated onto xu-y grid
-       REAL(wp) ::  kmym              !< diffusion coefficient on southward side of the w-gridbox - interpolated onto x-yv grid
-       REAL(wp) ::  kmyp              !< diffusion coefficient on northward side of the w-gridbox - interpolated onto x-yv grid
-       REAL(wp) ::  mask_east         !< flag to mask vertical wall east of the grid point
-       REAL(wp) ::  mask_north        !< flag to mask vertical wall north of the grid point
-       REAL(wp) ::  mask_south        !< flag to mask vertical wall south of the grid point
-       REAL(wp) ::  mask_west         !< flag to mask vertical wall west of the grid point
-
-
-
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, l, m) &
-       !$ACC PRIVATE(surf_e, surf_s, flag, kmxm, kmxp, kmym, kmyp) &
-       !$ACC PRIVATE(mask_west, mask_east, mask_south, mask_north) &
-       !$ACC PRESENT(wall_flags_total_0, km) &
-       !$ACC PRESENT(u, v, w) &
-       !$ACC PRESENT(ddzu, ddzw, rho_air, drho_air_zw) &
-       !$ACC PRESENT(surf_def_v(0:3)) &
-       !$ACC PRESENT(surf_lsm_v(0:3)) &
-       !$ACC PRESENT(surf_usm_v(0:3)) &
-       !$ACC PRESENT(tend)
+       INTEGER ::  i, j, k
+       REAL    ::  kmxm_x, kmxm_z, kmxp_x, kmxp_z, kmym_y, kmym_z, kmyp_y, &
+                   kmyp_z, wsus, wsvs
+       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt), km_damp_x(nxl-1:nxr+1), &
+                   km_damp_y(nys-1:nyn+1)
+       REAL    ::  z0(nys-1:nyn+1,nxl-1:nxr+1)
+       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+       REAL, DIMENSION(:,:,:), POINTER ::  km, u, v, w
+
+
        DO  i = nxl, nxr
           DO  j = nys, nyn
-             DO  k = nzb+1, nzt-1
-!
-!--             Predetermine flag to mask topography and wall-bounded grid points.
-                flag       = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i),   3 ) )
-                mask_east  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i+1), 3 ) )
-                mask_west  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i-1), 3 ) )
-                mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j-1,i), 3 ) )
-                mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j+1,i), 3 ) )
+             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)                                                          &
-                              + ( mask_east *  kmxp * (                                            &
-                                          ( w(k,j,i+1)   - w(k,j,i)   ) * ddx                      &
-                                        + ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)                &
-                                                      )                                            &
-                                - mask_west * kmxm *  (                                            &
-                                          ( w(k,j,i)     - w(k,j,i-1) ) * ddx                      &
-                                        + ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)                &
-                                                      )                                            &
-                                ) * ddx                                 * flag                     &
-                              + ( mask_north * kmyp * (                                            &
-                                          ( w(k,j+1,i)   - w(k,j,i)   ) * ddy                      &
-                                        + ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)                &
-                                                      )                                            &
-                                - mask_south * kmym * (                                            &
-                                          ( w(k,j,i)     - w(k,j-1,i) ) * ddy                      &
-                                        + ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)                &
-                                                      )                                            &
-                                ) * ddy                                 * flag                     &
-                              + 2.0_wp * (                                                         &
-                                km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) )   * ddzw(k+1)              &
-                                            * rho_air(k+1)                                         &
-                              - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)                &
-                                            * rho_air(k)                                           &
-                                         ) * ddzu(k+1) * drho_air_zw(k) * flag
+                kmxp_x = 0.25 * &
+                         ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+                kmxm_x = 0.25 * &
+                         ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+                kmxp_z = kmxp_x
+                kmxm_z = kmxm_x
+                kmyp_y = 0.25 * &
+                         ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+                kmym_y = 0.25 * &
+                         ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+                kmyp_z = kmyp_y
+                kmym_z = kmym_y
+!
+!--             Increase diffusion at the outflow boundary in case of
+!--             non-cyclic lateral boundaries. Damping is only needed for
+!--             velocity components parallel to the outflow boundary in
+!--             the direction normal to the outflow boundary.
+                IF ( bc_lr /= 'cyclic' )  THEN
+                   kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+                   kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+                ENDIF
+                IF ( bc_ns /= 'cyclic' )  THEN
+                   kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+                   kmym_y = MAX( kmym_y, km_damp_y(j) )
+                ENDIF
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & + ( kmxp_x * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx       &
+                      &   + kmxp_z * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
+                      &   - kmxm_x * ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
+                      &   - kmxm_z * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
+                      &   ) * ddx                                              &
+                      & + ( kmyp_y * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy       &
+                      &   + kmyp_z * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
+                      &   - kmym_y * ( w(k,j,i)   - w(k,j-1,i) ) * ddy         &
+                      &   - kmym_z * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)   &
+                      &   ) * ddy                                              &
+                      & + 2.0 * (                                              &
+                      &   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
 
 !
-!--          Add horizontal momentum flux v'w' at north- (l=0) and south-facing (l=1) surfaces.
-!--          Note, in the the flat case, loops won't be entered as start_index > end_index.
-!--          Furtermore, note, no vertical natural surfaces so far.
-!--          Default-type surfaces
-             DO  l = 0, 1
-                surf_s = surf_def_v(l)%start_index(j,i)
-                surf_e = surf_def_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_def_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_w(m) * ddy
+!--          Wall functions at all vertical walls, where necessary
+             IF ( wall_w_x(j,i) /= 0.0  .OR.  wall_w_y(j,i) /= 0.0 )  THEN
+                DO  k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
+                   IF ( wall_w_x(j,i) /= 0.0 )  THEN
+                      wsus = kappa * w(k,j,i) / LOG( 0.5 * dx / z0(j,i))
+                      wsus = -wsus * ABS( wsus )
+                   ELSE
+                      wsus = 0.0
+                   ENDIF
+                   IF ( wall_w_y(j,i) /= 0.0 )  THEN
+                      wsvs = kappa * w(k,j,i) / LOG( 0.5 * dy / z0(j,i))
+                      wsvs = -wsvs * ABS( wsvs )
+                   ELSE
+                      wsvs = 0.0
+                   ENDIF
+!
+!--                Interpolate eddy diffusivities on staggered gridpoints
+                   kmxp_x = 0.25 * &
+                            ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+                   kmxm_x = 0.25 * &
+                            ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+                   kmxp_z = kmxp_x
+                   kmxm_z = kmxm_x
+                   kmyp_y = 0.25 * &
+                            ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+                   kmym_y = 0.25 * &
+                            ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+                   kmyp_z = kmyp_y
+                   kmym_z = kmym_y
+!
+!--                Increase diffusion at the outflow boundary in case of
+!--                non-cyclic lateral boundaries. Damping is only needed for
+!--                velocity components parallel to the outflow boundary in
+!--                the direction normal to the outflow boundary.
+                   IF ( bc_lr /= 'cyclic' )  THEN
+                      kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+                      kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+                   ENDIF
+                   IF ( bc_ns /= 'cyclic' )  THEN
+                      kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+                      kmym_y = MAX( kmym_y, km_damp_y(j) )
+                   ENDIF
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                 + (   fwxp(j,i) * (                           &
+                            kmxp_x * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx       &
+                          + kmxp_z * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
+                                                   )                           &
+                                     - fwxm(j,i) * (                           &
+                            kmxm_x * ( w(k,j,i)     - w(k,j,i-1) ) * ddx       &
+                          + kmxm_z * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1) &
+                                                   )                           &
+                                     + wall_w_x(j,i) * wsus                    &
+                                   ) * ddx                                     &
+                                 + (   fwyp(j,i) * (                           &
+                            kmyp_y * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy       &
+                          + kmyp_z * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
+                                                   )                           &
+                                     - fwym(j,i) * (                           &
+                            kmym_y * ( w(k,j,i)     - w(k,j-1,i) ) * ddy       &
+                          + kmym_z * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1) &
+                                                   )                           &
+                                     + wall_w_y(j,i) * wsvs                    &
+                                   ) * ddy                                     &
+                                 + 2.0 * (                                     &
+                           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
-             ENDDO
-!
-!--          Natural-type surfaces
-             DO  l = 0, 1
-                surf_s = surf_lsm_v(l)%start_index(j,i)
-                surf_e = surf_lsm_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_lsm_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_w(m) * ddy
-                ENDDO
-             ENDDO
-!
-!--          Urban-type surfaces
-             DO  l = 0, 1
-                surf_s = surf_usm_v(l)%start_index(j,i)
-                surf_e = surf_usm_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_usm_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_w(m) * ddy
-                ENDDO
-             ENDDO
-!
-!--          Add horizontal momentum flux u'w' at east- (l=2) and west-facing (l=3) surface.
-!--          Default-type surfaces
-             DO  l = 2, 3
-                surf_s = surf_def_v(l)%start_index(j,i)
-                surf_e = surf_def_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_def_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_w(m) * ddx
-                ENDDO
-             ENDDO
-!
-!--          Natural-type surfaces
-             DO  l = 2, 3
-                surf_s = surf_lsm_v(l)%start_index(j,i)
-                surf_e = surf_lsm_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_lsm_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_w(m) * ddx
-                ENDDO
-             ENDDO
-!
-!--          Urban-type surfaces
-             DO  l = 2, 3
-                surf_s = surf_usm_v(l)%start_index(j,i)
-                surf_e = surf_usm_v(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k           = surf_usm_v(l)%k(m)
-                   tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_w(m) * ddx
-                ENDDO
-             ENDDO
+             ENDIF
 
           ENDDO
@@ -233,153 +218,135 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_w_ij( i, j )
-
-       USE arrays_3d,                                                                              &
-           ONLY :  ddzu, ddzw, drho_air_zw, km, rho_air, tend, u, v, w
-
-       USE grid_variables,                                                                         &
-           ONLY :  ddx, ddy
-
-       USE indices,                                                                                &
-           ONLY :  nzb, nzt, wall_flags_total_0
-
-       USE kinds
-
-       USE surface_mod,                                                                            &
-           ONLY :  surf_def_v, surf_lsm_v, surf_usm_v
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_w_ij( i, j, ddzu, ddzw, km, km_damp_x, km_damp_y, &
+                               tend, u, v, w, z0 )
+
+       USE control_parameters
+       USE grid_variables
+       USE indices
 
        IMPLICIT NONE
 
-
-       INTEGER(iwp) ::  i             !< running index x direction
-       INTEGER(iwp) ::  j             !< running index y direction
-       INTEGER(iwp) ::  k             !< running index z direction
-       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
-       INTEGER(iwp) ::  m             !< running index surface elements
-       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
-       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
-
-       REAL(wp) ::  flag              !< flag to mask topography grid points
-       REAL(wp) ::  kmxm              !< diffusion coefficient on leftward side of the w-gridbox - interpolated onto xu-y grid
-       REAL(wp) ::  kmxp              !< diffusion coefficient on rightward side of the w-gridbox - interpolated onto xu-y grid
-       REAL(wp) ::  kmym              !< diffusion coefficient on southward side of the w-gridbox - interpolated onto x-yv grid
-       REAL(wp) ::  kmyp              !< diffusion coefficient on northward side of the w-gridbox - interpolated onto x-yv grid
-       REAL(wp) ::  mask_east         !< flag to mask vertical wall east of the grid point
-       REAL(wp) ::  mask_north        !< flag to mask vertical wall north of the grid point
-       REAL(wp) ::  mask_south        !< flag to mask vertical wall south of the grid point
-       REAL(wp) ::  mask_west         !< flag to mask vertical wall west of the grid point
-
-
-       DO  k = nzb+1, nzt-1
-!
-!--       Predetermine flag to mask topography and wall-bounded grid points.
-          flag       = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i),   3 ) )
-          mask_east  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i+1), 3 ) )
-          mask_west  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i-1), 3 ) )
-          mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j-1,i), 3 ) )
-          mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j+1,i), 3 ) )
+       INTEGER ::  i, j, k
+       REAL    ::  kmxm_x, kmxm_z, kmxp_x, kmxp_z, kmym_y, kmym_z, kmyp_y, &
+                   kmyp_z, wsus, wsvs
+       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt), km_damp_x(nxl-1:nxr+1), &
+                   km_damp_y(nys-1:nyn+1)
+       REAL    ::  z0(nys-1:nyn+1,nxl-1:nxr+1)
+       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+       REAL, DIMENSION(:,:,:), POINTER ::  km, u, v, w
+
+
+       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)                                                                &
-                        + ( mask_east *  kmxp * (                                                  &
-                                    ( w(k,j,i+1)   - w(k,j,i)   ) * ddx                            &
-                                  + ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)                      &
-                                                )                                                  &
-                          - mask_west * kmxm *  (                                                  &
-                                    ( w(k,j,i)     - w(k,j,i-1) ) * ddx                            &
-                                  + ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)                      &
-                                                )                                                  &
-                          ) * ddx                                 * flag                           &
-                        + ( mask_north * kmyp * (                                                  &
-                                    ( w(k,j+1,i)   - w(k,j,i)   ) * ddy                            &
-                                  + ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)                      &
-                                                )                                                  &
-                          - mask_south * kmym * (                                                  &
-                                    ( w(k,j,i)     - w(k,j-1,i) ) * ddy                            &
-                                  + ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)                      &
-                                                )                                                  &
-                          ) * ddy                                 * flag                           &
-                        + 2.0_wp * (                                                               &
-                          km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)                      &
-                                      * rho_air(k+1)                                               &
-                        - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)                      &
-                                      * rho_air(k)                                                 &
-                                   ) * ddzu(k+1) * drho_air_zw(k) * flag
+          kmxp_x = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+          kmxm_x = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+          kmxp_z = kmxp_x
+          kmxm_z = kmxm_x
+          kmyp_y = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+          kmym_y = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+          kmyp_z = kmyp_y
+          kmym_z = kmym_y
+!
+!--       Increase diffusion at the outflow boundary in case of non-cyclic
+!--       lateral boundaries. Damping is only needed for velocity components
+!--       parallel to the outflow boundary in the direction normal to the
+!--       outflow boundary.
+          IF ( bc_lr /= 'cyclic' )  THEN
+             kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+             kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+          ENDIF
+          IF ( bc_ns /= 'cyclic' )  THEN
+             kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+             kmym_y = MAX( kmym_y, km_damp_y(j) )
+          ENDIF
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                      & + ( kmxp_x * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx       &
+                      &   + kmxp_z * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
+                      &   - kmxm_x * ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
+                      &   - kmxm_z * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
+                      &   ) * ddx                                              &
+                      & + ( kmyp_y * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy       &
+                      &   + kmyp_z * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
+                      &   - kmym_y * ( w(k,j,i)   - w(k,j-1,i) ) * ddy         &
+                      &   - kmym_z * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)   &
+                      &   ) * ddy                                              &
+                      & + 2.0 * (                                              &
+                      &   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
-!
-!--    Add horizontal momentum flux v'w' at north- (l=0) and south-facing (l=1) surfaces. Note, in
-!--    the the flat case, loops won't be entered as start_index > end_index. Furtermore, note, no
-!--    vertical natural surfaces so far.
-!--    Default-type surfaces
-       DO  l = 0, 1
-          surf_s = surf_def_v(l)%start_index(j,i)
-          surf_e = surf_def_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_def_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_w(m) * ddy
+
+!
+!--    Wall functions at all vertical walls, where necessary
+       IF ( wall_w_x(j,i) /= 0.0  .OR.  wall_w_y(j,i) /= 0.0 )  THEN
+          DO  k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
+             IF ( wall_w_x(j,i) /= 0.0 )  THEN
+                wsus = kappa * w(k,j,i) / LOG( 0.5 * dx / z0(j,i))
+                wsus = -wsus * ABS( wsus )
+             ELSE
+                wsus = 0.0
+             ENDIF
+             IF ( wall_w_y(j,i) /= 0.0 )  THEN
+                wsvs = kappa * w(k,j,i) / LOG( 0.5 * dy / z0(j,i))
+                wsvs = -wsvs * ABS( wsvs )
+             ELSE
+                wsvs = 0.0
+             ENDIF
+!
+!--          Interpolate eddy diffusivities on staggered gridpoints
+             kmxp_x = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+             kmxm_x = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+             kmxp_z = kmxp_x
+             kmxm_z = kmxm_x
+             kmyp_y = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+             kmym_y = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+             kmyp_z = kmyp_y
+             kmym_z = kmym_y
+!
+!--          Increase diffusion at the outflow boundary in case of
+!--          non-cyclic lateral boundaries. Damping is only needed for
+!--          velocity components parallel to the outflow boundary in
+!--          the direction normal to the outflow boundary.
+             IF ( bc_lr /= 'cyclic' )  THEN
+                kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+                kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+             ENDIF
+             IF ( bc_ns /= 'cyclic' )  THEN
+                kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+                kmym_y = MAX( kmym_y, km_damp_y(j) )
+             ENDIF
+
+             tend(k,j,i) = tend(k,j,i)                                         &
+                                 + (   fwxp(j,i) * (                           &
+                            kmxp_x * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx       &
+                          + kmxp_z * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
+                                                   )                           &
+                                     - fwxm(j,i) * (                           &
+                            kmxm_x * ( w(k,j,i)     - w(k,j,i-1) ) * ddx       &
+                          + kmxm_z * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1) &
+                                                   )                           &
+                                     + wall_w_x(j,i) * wsus                    &
+                                   ) * ddx                                     &
+                                 + (   fwyp(j,i) * (                           &
+                            kmyp_y * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy       &
+                          + kmyp_z * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
+                                                   )                           &
+                                     - fwym(j,i) * (                           &
+                            kmym_y * ( w(k,j,i)     - w(k,j-1,i) ) * ddy       &
+                          + kmym_z * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1) &
+                                                   )                           &
+                                     + wall_w_y(j,i) * wsvs                    &
+                                   ) * ddy                                     &
+                                 + 2.0 * (                                     &
+                           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
-       ENDDO
-!
-!--    Natural-type surfaces
-       DO  l = 0, 1
-          surf_s = surf_lsm_v(l)%start_index(j,i)
-          surf_e = surf_lsm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_lsm_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_w(m) * ddy
-          ENDDO
-       ENDDO
-!
-!--    Urban-type surfaces
-       DO  l = 0, 1
-          surf_s = surf_usm_v(l)%start_index(j,i)
-          surf_e = surf_usm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_usm_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_w(m) * ddy
-          ENDDO
-       ENDDO
-!
-!--    Add horizontal momentum flux u'w' at east- (l=2) and west-facing (l=3) surfaces.
-!--    Default-type surfaces
-       DO  l = 2, 3
-          surf_s = surf_def_v(l)%start_index(j,i)
-          surf_e = surf_def_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_def_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_w(m) * ddx
-          ENDDO
-       ENDDO
-!
-!--    Natural-type surfaces
-       DO  l = 2, 3
-          surf_s = surf_lsm_v(l)%start_index(j,i)
-          surf_e = surf_lsm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_lsm_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_w(m) * ddx
-          ENDDO
-       ENDDO
-!
-!--    Urban-type surfaces
-       DO  l = 2, 3
-          surf_s = surf_usm_v(l)%start_index(j,i)
-          surf_e = surf_usm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_usm_v(l)%k(m)
-             tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_w(m) * ddx
-          ENDDO
-       ENDDO
-
+       ENDIF
 
     END SUBROUTINE diffusion_w_ij
Index: palm/trunk/SOURCE/diffusivities.f90
===================================================================
--- palm/trunk/SOURCE/diffusivities.f90	(revision 1)
+++ palm/trunk/SOURCE/diffusivities.f90	(revision 1)
@@ -0,0 +1,244 @@
+ SUBROUTINE diffusivities( theta )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Log: diffusivities.f90,v $
+! Revision 1.24  2006/04/26 12:16:26  raasch
+! OpenMP optimization (+sums_l_l_t), sqrt_e must be private
+!
+! Revision 1.23  2006/02/23 12:13:29  raasch
+! nzb_2d replaced by nzb_s_inner/outer, option of a minimum tke
+! quasi boundary conditions is now set for sums_l_l instead of sums_l
+!
+! Revision 1.22  2005/03/26 20:16:26  raasch
+! Eddy diffusivities are also calculated for the ghost points in order to spare
+! the communication otherwise needed for the exchange of these points.
+! Neumann boundary conditions set at the outflow boundaries in case of
+! non-cyclic lateral boundaries
+!
+! Revision 1.21  2004/01/30 10:23:12  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.20  2003/03/14 13:40:09  raasch
+! Loop optimization (SQRT(e) solved in a seperate loop, joining of loops)
+!
+! Revision 1.19  2003/03/12 16:28:56  raasch
+! phi_m is initialized in declaration statement in order to avoid run time
+! errors due to compiler problems on ibm and nec
+!
+! Revision 1.18  2002/12/19 14:32:23  raasch
+! Correction of mixing length term (l(k)/ll(k)). The condition kh=3*km in
+! the unstable case is now also exactly met in the wall adjustment region.
+! Factor 0.7 in wall adjustment part replaced by variable
+! wall_adjustment_factor, which is set to 1.8 in modules.f90.
+! Missing OMP DO statement added.
+!
+! Revision 1.17  2002/06/11 12:56:49  raasch
+! OpenMP directives added,
+! array l changed from allocatable to automatic, because it must be on the stack
+! in case of using OpenMP
+!
+! Revision 1.16  2001/08/21  08:30:34  08:30:34  raasch (Siegfried Raasch)
+! Wall adjustment of mixing length to 0.7 z can be switched off
+! Lower boundary condition for km and kh changed to Neumann
+! 
+! Revision 1.15  2001/03/30 07:22:09  raasch
+! Near surface mixing length is limited to 0.7*zu,
+! if adjust_mixing_length=T, l is modified at all gridpoints (previously at
+! k=1 only),
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.14  2001/01/22 06:31:36  raasch
+! Module test_variables removed
+!
+! Revision 1.13  2001/01/02 17:27:41  raasch
+! -dpt_dz_d, dpt_dz_u
+!
+! Revision 1.12  2000/12/20 10:35:47  letzel
+! All comments translated into English.
+!
+! Revision 1.11  2000/04/18 08:10:42  schroeter
+! Revision 1.4 wieder rueckgaengig gemacht, das Stabilitaets-
+! kriterium basiert nun wieder auf zentralen Differenzen
+!
+! Revision 1.9  2000/04/13 13:42:14  schroeter
+! je nach Initialisierungsmodus (trocken/feucht) fliesst in
+! Mischungswegberechnung pt oder vpt ein, wird durch entsprechende
+! Variablenuebergabe geregelt
+!
+! Revision 1.8  99/02/17  09:17:39  09:17:39  raasch (Siegfried Raasch)
+! Kriterium fuer reduzierten Mischungsweg im stabil geschichteten Fall enger
+! gefasst (Schichtung muss sowohl oberhalb als auch unterhalb des betrachteten
+! Gitterpunkts stabil sein)
+! 
+! Revision 1.7  1998/09/22 17:18:41  raasch
+! Testweise cm = 0.4 bei k=1, aber vorerst auskommentiert
+!
+! Revision 1.6  1998/08/05 06:52:44  raasch
+! Mischungsweganpassung an Prandtl nur bei k=1
+!
+! Revision 1.2  1998/03/11 11:49:26  raasch
+! Anpassung des Mischungsweges an den Prandtlschen Mischungsweg moeglich
+!
+! Revision 1.1  1997/09/19 07:41:10  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Computation of the turbulent diffusion coefficients for momentum and heat 
+! according to Prandtl-Kolmogorov
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE pegrid
+    USE statistics
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k, omp_get_thread_num, sr, tn
+
+    REAL    ::  dpt_dz, l_stable, phi_m = 1.0
+
+    REAL    ::  theta(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+
+    REAL, DIMENSION(1:nzt) ::  l, ll, sqrt_e
+
+
+!
+!-- Default thread number in case of one thread
+    tn = 0
+
+!
+!-- Initialization for calculation of the mixing length profile
+    sums_l_l = 0.0
+
+!
+!-- Compute the turbulent diffusion coefficient for momentum
+    !$OMP PARALLEL PRIVATE (dpt_dz,i,j,k,l,ll,l_stable,phi_m,sqrt_e,sr,tn)
+!$  tn = omp_get_thread_num()
+
+    !$OMP DO
+    DO  i = nxl-1, nxr+1
+       DO  j = nys-1, nyn+1
+
+!
+!--       Compute the Phi-function for a possible adaption of the mixing length
+!--       to the Prandtl mixing length
+          IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
+             IF ( rif(j,i) >= 0.0 )  THEN
+                phi_m = 1.0 + 5.0 * rif(j,i)
+             ELSE
+                phi_m = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
+             ENDIF
+          ENDIF
+          
+!
+!--       Introduce an optional minimum tke
+          IF ( e_min > 0.0 )  THEN
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                e(k,j,i) = MAX( e(k,j,i), e_min )
+             ENDDO
+          ENDIF
+
+!
+!--       Calculate square root of e in a seperate loop, because it is used
+!--       twice in the next loop (better vectorization)
+          DO  k = nzb_s_inner(j,i)+1, nzt
+             sqrt_e(k) = SQRT( e(k,j,i) )
+          ENDDO
+
+!
+!--       Determine the mixing length
+          DO  k = nzb_s_inner(j,i)+1, nzt
+             dpt_dz = ( theta(k+1,j,i) - theta(k-1,j,i) ) * dd2zu(k)
+             IF ( dpt_dz > 0.0 ) THEN
+                l_stable = 0.76 * sqrt_e(k) / &
+                                  SQRT( g / theta(k,j,i) * dpt_dz ) + 1E-5
+             ELSE
+                l_stable = l_grid(k)
+             ENDIF
+!
+!--          Adjustment of the mixing length
+             IF ( wall_adjustment )  THEN
+                l(k)  = MIN( l_wall(k,j,i), l_grid(k), l_stable )
+                ll(k) = MIN( l_wall(k,j,i), l_grid(k) )
+             ELSE
+                l(k)  = MIN( l_grid(k), l_stable )
+                ll(k) = l_grid(k)
+             ENDIF
+             IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
+                l(k)  = MIN( l(k),  kappa * zu(k) / phi_m )
+                ll(k) = MIN( ll(k), kappa * zu(k) / phi_m )
+             ENDIF
+
+!
+!--          Compute diffusion coefficients for momentum and heat
+             km(k,j,i) = 0.1 * l(k) * sqrt_e(k)
+             kh(k,j,i) = ( 1.0 + 2.0 * l(k) / ll(k) ) * km(k,j,i)
+
+          ENDDO
+
+!
+!--       Summation for averaged profile (cf. flow_statistics)
+          DO  sr = 0, statistic_regions
+             IF ( rmask(j,i,sr) /= 0.0 )  THEN
+                DO  k = nzb_s_outer(j,i)+1, nzt
+                   sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + l(k)
+                ENDDO
+             ENDIF
+          ENDDO
+
+       ENDDO
+    ENDDO
+
+    sums_l_l(nzt+1,:,tn) = sums_l_l(nzt,:,tn)   ! quasi boundary-condition for
+                                                ! data output
+
+    !$OMP END PARALLEL
+
+!
+!-- Set vertical boundary values (Neumann conditions both at bottom and top).
+!-- Horizontal boundary conditions at vertical walls are not set because
+!-- so far vertical walls require usage of a Prandtl-layer where the boundary
+!-- values of the diffusivities are not needed
+    !$OMP PARALLEL DO
+    DO  i = nxl-1, nxr+1
+       DO  j = nys-1, nyn+1
+          km(nzb_s_inner(j,i),j,i) = km(nzb_s_inner(j,i)+1,j,i)
+          km(nzt+1,j,i)            = km(nzt,j,i)
+          kh(nzb_s_inner(j,i),j,i) = kh(nzb_s_inner(j,i)+1,j,i)
+          kh(nzt+1,j,i)            = kh(nzt,j,i)
+       ENDDO
+    ENDDO
+
+!
+!-- Set Neumann boundary conditions at the outflow boundaries in case of
+!-- non-cyclic lateral boundaries
+    IF ( outflow_l )  THEN
+       km(:,:,nxl-1) = km(:,:,nxl)
+       kh(:,:,nxl-1) = kh(:,:,nxl)
+    ENDIF
+    IF ( outflow_r )  THEN
+       km(:,:,nxr+1) = km(:,:,nxr)
+       kh(:,:,nxr+1) = kh(:,:,nxr)
+    ENDIF
+    IF ( outflow_s )  THEN
+       km(:,nys-1,:) = km(:,nys,:)
+       kh(:,nys-1,:) = kh(:,nys,:)
+    ENDIF
+    IF ( outflow_n )  THEN
+       km(:,nyn+1,:) = km(:,nyn,:)
+       kh(:,nyn+1,:) = kh(:,nyn,:)
+    ENDIF
+
+
+ END SUBROUTINE diffusivities
Index: palm/trunk/SOURCE/disturb_field.f90
===================================================================
--- palm/trunk/SOURCE/disturb_field.f90	(revision 4901)
+++ palm/trunk/SOURCE/disturb_field.f90	(revision 1)
@@ -1,47 +1,44 @@
-!> @file disturb_field.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
+ SUBROUTINE disturb_field( nzb_uv_inner, dist1, field, xrp, ynp )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
 !
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-! 
-! 
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: disturb_field.f90,v $
+! Revision 1.11  2006/08/04 14:31:59  raasch
+! izuf renamed iran
 !
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
+! Revision 1.10  2006/02/23 12:14:06  raasch
+! Additional argument nzb_uv_inner (no perturbations below the topography)
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
+! Revision 1.9  2005/03/26 20:18:30  raasch
+! Arguments for non-cyclic boundary conditions added to argument list and to
+! argument list of routine exchange_horiz.
+! Perturbations can be imposed for different ranges (steered by dist_range).
 !
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
+! Revision 1.8  2003/10/29 08:48:51  raasch
+! Module random_function_mod is used
 !
-! 4237 2019-09-25 11:33:42Z knoop
-! Added missing OpenMP directives
+! Revision 1.7  2003/03/14 13:41:48  raasch
+! Different random number generators available
 !
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
+! Revision 1.6  2001/03/30 07:22:26  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
 !
-! 3849 2019-04-01 16:35:16Z knoop
-! Corrected "Former revisions" section
+! Revision 1.5  2001/01/25 06:59:38  raasch
+! Module interfaces added (missing this interface caused errors on machines
+! other than Cray)
+!
+! Revision 1.4  2001/01/22 06:32:49  raasch
+! Module test_variables removed
+!
+! Revision 1.3  2000/07/03 12:59:03  raasch
+! All comments translated into English
+!
+! Revision 1.2  1998/07/06 12:13:01  raasch
+! + USE test_variables
 !
 ! Revision 1.1  1998/02/04 15:40:45  raasch
@@ -51,67 +48,37 @@
 ! Description:
 ! ------------
-!> Imposing a random perturbation on a 3D-array.
-!> On parallel computers, the random number generator is as well called for all gridpoints of the
-!> total domain to ensure, regardless of the number of PEs used, that the elements of the array have
-!> the same values in the same order in every case. The perturbation range is steered by dist_range.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE disturb_field( var_char, dist1, field )
+! Imposing a random perturbation on a 3D-array.
+! On parallel computers, the random number generator is as well called for all
+! gridpoints of the total domain to ensure, regardless of the number of PEs
+! used, that the elements of the array have the same values in the same
+! order in every case. The perturbation range is steered by dist_range.
+!------------------------------------------------------------------------------!
 
-
-    USE control_parameters,                                                                        &
-        ONLY:  dist_nxl, dist_nxr, dist_nyn, dist_nys, dist_range, disturbance_amplitude,          &
-               disturbance_created, disturbance_level_ind_b, disturbance_level_ind_t, iran,        &
-               random_generator, topography
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max, nzt,                &
-               wall_flags_total_0
-
-    USE kinds
-
-    USE random_function_mod,                                                                       &
-        ONLY: random_function
-
-    USE random_generator_parallel,                                                                 &
-        ONLY:  random_number_parallel, random_seed_parallel, random_dummy, seq_random_array
+    USE control_parameters
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE random_function_mod
 
     IMPLICIT NONE
 
-    CHARACTER (LEN = *) ::  var_char !< flag to distinguish betwenn u- and v-component
+    INTEGER ::  i, j, k, xrp, ynp
+    INTEGER ::  nzb_uv_inner(nys-1:nyn+1,nxl-1:nxr+1)
 
-    INTEGER(iwp) ::  flag_nr !< number of respective flag for u- or v-grid
-    INTEGER(iwp) ::  i       !< index variable
-    INTEGER(iwp) ::  j       !< index variable
-    INTEGER(iwp) ::  k       !< index variable
-
-    REAL(wp) ::  randomnumber  !<
-
-    REAL(wp) ::  dist1(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !<
-    REAL(wp) ::  field(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !<
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  dist2  !<
+    REAL    ::  randomnumber,                             &
+                dist1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+                field(nzb:nzt+1,nys-1:nyn+ynp+1,nxl-1:nxr+xrp+1)
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  dist2
 
 
     CALL cpu_log( log_point(20), 'disturb_field', 'start' )
-!
-!-- Set flag number, 20 for u-grid, 21 for v-grid, required to mask topography
-    flag_nr = MERGE( 20, 21, TRIM(var_char) == 'u' )
-!
-!-- Create an additional temporary array and initialize the arrays needed to store the disturbance
-    ALLOCATE( dist2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!$ACC DATA CREATE(dist2(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
 
 !
-!-- dist1 is initialized on the host (see below) and then updated on the device.
-    dist1 = 0.0_wp
-    !$ACC KERNELS PRESENT(dist2)
-    dist2 = 0.0_wp
-    !$ACC END KERNELS
+!-- Create an additional temporary array and initialize the arrays needed
+!-- to store the disturbance
+    ALLOCATE( dist2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    dist1 = 0.0
+    dist2 = 0.0
 
 !
@@ -121,23 +88,12 @@
           DO  j = dist_nys(dist_range), dist_nyn(dist_range)
              DO  k = disturbance_level_ind_b, disturbance_level_ind_t
-                randomnumber = 3.0_wp * disturbance_amplitude * ( random_function( iran ) - 0.5_wp )
-                IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND. nyn >= j )  THEN
+                randomnumber = 3.0 * disturbance_amplitude * &
+                               ( random_function( iran ) - 0.5 )
+                IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.  &
+                     nyn >= j ) &
+                THEN
                    dist1(k,j,i) = randomnumber
                 ENDIF
              ENDDO
-          ENDDO
-       ENDDO
-    ELSEIF ( random_generator == 'random-parallel' )  THEN
-       DO  i = dist_nxl(dist_range), dist_nxr(dist_range)
-          DO  j = dist_nys(dist_range), dist_nyn(dist_range)
-             CALL random_seed_parallel( put=seq_random_array(:, j, i) )
-             DO  k = disturbance_level_ind_b, disturbance_level_ind_t
-                CALL random_number_parallel( random_dummy )
-                randomnumber = 3.0_wp * disturbance_amplitude * ( random_dummy - 0.5_wp )
-                IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.  nyn >= j )  THEN
-                   dist1(k,j,i) = randomnumber
-                ENDIF
-             ENDDO
-             CALL random_seed_parallel( get=seq_random_array(:, j, i) )
           ENDDO
        ENDDO
@@ -146,7 +102,14 @@
           DO  j = dist_nys(dist_range), dist_nyn(dist_range)
              DO  k = disturbance_level_ind_b, disturbance_level_ind_t
+#if defined( __nec )
+                randomnumber = 3.0 * disturbance_amplitude * &
+                               ( RANDOM( 0 ) - 0.5 )
+#else
                 CALL RANDOM_NUMBER( randomnumber )
-                randomnumber = 3.0_wp * disturbance_amplitude * ( randomnumber - 0.5_wp )
-                IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.  nyn >= j )  THEN
+                randomnumber = 3.0 * disturbance_amplitude * &
+                                ( randomnumber - 0.5 )
+#endif
+                IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j ) &
+                THEN
                    dist1(k,j,i) = randomnumber
                 ENDIF
@@ -158,63 +121,46 @@
 
 !
-!-- Update dist1 on the device, this is expected by exchange_horiz!
-    !$ACC UPDATE DEVICE(dist1(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
+!-- Exchange of ghost points for the random perturbation
+    CALL exchange_horiz( dist1, 0, 0 )
 
 !
-!-- Exchange of ghost points for the random perturbation
-
-    CALL exchange_horiz( dist1, nbgp )
-!
 !-- Applying the Shuman filter in order to smooth the perturbations.
-!-- Neighboured grid points in all three directions are used for the filter operation.
-!-- Loop has been splitted to make runs reproducible on HLRN systems using compiler option -O3
-     !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k) PRESENT(dist1, dist2)
-     !$OMP PARALLEL DO PRIVATE(i, j, k)
-     DO  i = nxl, nxr
-        DO  j = nys, nyn
+!-- Neighboured grid points in all three directions are used for the
+!-- filter operation.
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
           DO  k = disturbance_level_ind_b-1, disturbance_level_ind_t+1
-             dist2(k,j,i) = ( dist1(k,j,i-1) + dist1(k,j,i+1)                                      &
-                            + dist1(k,j+1,i) + dist1(k+1,j,i)                                      &
-                            ) / 12.0_wp
+             dist2(k,j,i) = ( dist1(k,j,i-1) + dist1(k,j,i+1) + dist1(k,j-1,i) &
+                            + dist1(k,j+1,i) + dist1(k+1,j,i) + dist1(k-1,j,i) &
+                            + 6.0 * dist1(k,j,i)                               &
+                            ) / 12.0
           ENDDO
-          DO  k = disturbance_level_ind_b-1, disturbance_level_ind_t+1
-              dist2(k,j,i) = dist2(k,j,i) + ( dist1(k,j-1,i) + dist1(k-1,j,i)                      &
-                            + 6.0_wp * dist1(k,j,i)                                                &
-                                            ) / 12.0_wp
-          ENDDO
-        ENDDO
-     ENDDO
+       ENDDO
+    ENDDO
 
 !
 !-- Exchange of ghost points for the filtered perturbation.
 !-- Afterwards, filter operation and exchange of ghost points are repeated.
-    CALL exchange_horiz( dist2, nbgp )
-
-    !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k) PRESENT(dist1, dist2)
-    !$OMP PARALLEL DO PRIVATE(i, j, k)
+    CALL exchange_horiz( dist2, 0, 0 )
     DO  i = nxl, nxr
        DO  j = nys, nyn
           DO  k = disturbance_level_ind_b-2, disturbance_level_ind_t+2
-             dist1(k,j,i) = ( dist2(k,j,i-1) + dist2(k,j,i+1) + dist2(k,j-1,i)                     &
-                            + dist2(k,j+1,i) + dist2(k+1,j,i) + dist2(k-1,j,i)                     &
-                            + 6.0_wp * dist2(k,j,i)                                                &
-                            ) / 12.0_wp
+             dist1(k,j,i) = ( dist2(k,j,i-1) + dist2(k,j,i+1) + dist2(k,j-1,i) &
+                            + dist2(k,j+1,i) + dist2(k+1,j,i) + dist2(k-1,j,i) &
+                            + 6.0 * dist2(k,j,i)                               &
+                            ) / 12.0
           ENDDO
        ENDDO
     ENDDO
-
-    CALL exchange_horiz( dist1, nbgp )
+    CALL exchange_horiz( dist1, 0, 0 )
 
 !
-!-- Remove perturbations below topography (including one gridpoint above it in order to allow for
-!-- larger timesteps at the beginning of the simulation (diffusion criterion))
+!-- Remove perturbations below topography (including one gridpoint above it
+!-- in order to allow for larger timesteps at the beginning of the simulation
+!-- (diffusion criterion))
     IF ( TRIM( topography ) /= 'flat' )  THEN
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-             DO  k = nzb, nzb_max
-                dist1(k,j,i) = MERGE( dist1(k,j,i), 0.0_wp,                                        &
-                                  BTEST( wall_flags_total_0(k,j,i), flag_nr )                      &
-                                    )
-             ENDDO
+       DO  i = nxl-1, nxr+1
+          DO  j = nys-1, nyn+1
+             dist1(nzb:nzb_uv_inner(j,i)+1,j,i) = 0.0
           ENDDO
        ENDDO
@@ -223,8 +169,6 @@
 !
 !-- Random perturbation is added to the array to be disturbed.
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) PRESENT(field, dist1)
-    !$OMP PARALLEL DO PRIVATE(i, j, k)
-    DO  i = nxlg, nxrg
-       DO  j = nysg, nyng
+    DO  i = nxl-1, nxr+1
+       DO  j = nys-1, nyn+1
           DO  k = disturbance_level_ind_b-2, disturbance_level_ind_t+2
              field(k,j,i) = field(k,j,i) + dist1(k,j,i)
@@ -232,6 +176,4 @@
        ENDDO
     ENDDO
-
-!$ACC END DATA
 
 !
Index: palm/trunk/SOURCE/disturb_heatflux.f90
===================================================================
--- palm/trunk/SOURCE/disturb_heatflux.f90	(revision 4901)
+++ palm/trunk/SOURCE/disturb_heatflux.f90	(revision 1)
@@ -1,38 +1,30 @@
-!> @file disturb_heatflux.f90
+ SUBROUTINE disturb_heatflux
+
 !------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
+! Actual revisions:
+! -----------------
+! 
 !
-! 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-2021 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-! 
-! 
 ! Former revisions:
 ! -----------------
-! $Id$
-! Corrected "Former revisions" section
-! 
-! 3761 2019-02-25 15:31:42Z raasch
-! unsed variables removed
-! 
-! 3719 2019-02-06 13:10:18Z kanani
-! Moved log_points out of subroutine into time_integration for better overview.
-! 
-! 3655 2019-01-07 16:51:22Z knoop
-! unused variable removed
+! $Log: disturb_heatflux.f90,v $
+! Revision 1.7  2006/08/04 14:35:07  raasch
+! Additional parameter in function random_gauss which limits the range of the
+! created random numbers, izuf renamed iran
+!
+! Revision 1.6  2006/02/23 12:14:38  raasch
+! Over topography surface_heatflux is replaced by wall_heatflux(0)
+!
+! Revision 1.5  2001/03/30 07:22:44  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.4  2001/01/22 06:34:34  raasch
+! Module test_variables removed
+!
+! Revision 1.3  2000/12/20 11:57:38  letzel
+! All comments translated into English.
+!
+! Revision 1.2  1998/07/06 12:13:19  raasch
+! + USE test_variables
 !
 ! Revision 1.1  1998/03/25 20:03:47  raasch
@@ -42,89 +34,49 @@
 ! Description:
 ! ------------
-!> Generate random, normally distributed heatflux values and store them as the
-!> near-surface heatflux.
+! Generate random, normally distributed heatflux values and store them as the
+! near-surface heatflux.
+! On parallel computers, too, this random generator is called at all grid points
+! of the total array in order to guarantee the same random distribution of the
+! total array regardless of the number of processors used during the model run.
 !------------------------------------------------------------------------------!
- SUBROUTINE disturb_heatflux( surf )
- 
 
-    USE arrays_3d,                                                             &
-        ONLY:  heatflux_input_conversion
-        
-    USE control_parameters,                                                    &
-        ONLY:  iran, surface_heatflux, random_generator, wall_heatflux
-        
-    USE kinds
-    
-    USE indices,                                                               &
-        ONLY:  nzb
-
-    USE random_generator_parallel,                                             &
-        ONLY:  random_number_parallel, random_seed_parallel, random_dummy,     &
-               seq_random_array
-
-    USE surface_mod,                                                           &
-        ONLY:  surf_type
+    USE arrays_3d
+    USE control_parameters
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i  !< grid index, x direction
-    INTEGER(iwp) ::  j  !< grid index, y direction
-    INTEGER(iwp) ::  k  !< grid index, z direction
-    INTEGER(iwp) ::  m  !< loop variables over surface elements
-    
-    REAL(wp) ::  random_gauss  !<
-    REAL(wp) ::  randomnumber  !<
-
-    TYPE(surf_type) ::  surf   !< surface-type variable
+    INTEGER ::  i, j
+    REAL    ::  random_gauss, randomnumber
 
 
+    CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
+
 !
-!-- Generate random disturbances and store them. Note, if 
-!-- random_generator /= 'random-parallel' it is not guaranteed to obtain  
-!-- the same random distribution if the number of processors is changed. 
-    IF ( random_generator /= 'random-parallel' )  THEN
-
-       DO  m = 1, surf%ns
-
-          k = surf%k(m)
-
-          randomnumber = random_gauss( iran, 5.0_wp )      
+!-- Generate random disturbances and store them
+    DO  i = 0, nx
+       DO  j = 0, ny
+          randomnumber = random_gauss( iran, 5.0 )
+          IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.  nyn >= j ) &
+          THEN
+             IF ( nzb_s_inner(j,i) == 0 )  THEN
+                shf(j,i) = randomnumber * surface_heatflux
 !
-!--       k-1 is topography top index. If this is 0, set surface heatflux. Over
-!--       topography surface_heatflux is replaced by wall_heatflux(0).
-          IF ( k-1 == 0 )  THEN
-             surf%shf(m) = randomnumber * surface_heatflux                     &
-                              * heatflux_input_conversion(nzb)
-          ELSE
-             surf%shf(m) = randomnumber * wall_heatflux(0)                     &
-                              * heatflux_input_conversion(k-1)
+!--             Over topography surface_heatflux is replaced by wall_heatflux(0)
+                shf(j,i) = randomnumber * wall_heatflux(0)
+             ELSE
+             ENDIF
           ENDIF
        ENDDO
-    ELSE
+    ENDDO
 
-       DO  m = 1, surf%ns
+!
+!-- Exchange lateral boundary conditions for the heatflux array
+    CALL exchange_horiz_2d( shf )
 
-          i = surf%i(m)
-          j = surf%j(m)
-          k = surf%k(m)
-
-          CALL random_seed_parallel( put=seq_random_array(:, j, i) )
-          CALL random_number_parallel( random_dummy )    
-!
-!--       k-1 is topography top index. If this is 0, set surface heatflux. Over
-!--       topography surface_heatflux is replaced by wall_heatflux(0).
-          IF ( k-1 == 0 )  THEN
-             surf%shf(m) = ( random_dummy - 0.5_wp ) * surface_heatflux        &
-                              * heatflux_input_conversion(nzb)
-          ELSE
-             surf%shf(m) = ( random_dummy - 0.5_wp ) * wall_heatflux(0)        &
-                              * heatflux_input_conversion(k-1)
-          ENDIF
-
-          CALL random_seed_parallel( get=seq_random_array(:, j, i) )
-
-       ENDDO
-
-    ENDIF
+    CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
 
 
Index: palm/trunk/SOURCE/dynamics_mod.f90
===================================================================
--- palm/trunk/SOURCE/dynamics_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,1525 +1,0 @@
-!> @file dynamics_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! bugfix: deactivated header output
-!
-! 4845 2021-01-18 11:15:37Z raasch
-! radiation boundary condition always uses maximum phase velocity, respective code for calculating
-! the phase velocity is removed
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Enable 3D data output also with 64-bit precision
-!
-! 4760 2020-10-26 13:26:47Z schwenkel
-! Implement relative humidity as diagnostic output quantity
-!
-! 4731 2020-10-07 13:25:11Z schwenkel
-! Move exchange_horiz from time_integration to modules
-!
-! 4627 2020-07-26 10:14:44Z raasch
-! bugfix for r4626
-!
-! 4626 2020-07-26 09:49:48Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO for reading local arrays
-!
-! 4505 2020-04-20 15:37:15Z schwenkel
-! Add flag for saturation check
-!
-! 4495 2020-04-13 20:11:20Z resler
-! restart data handling with MPI-IO added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Bugfix for last commit.
-!
-! 4359 2019-12-30 13:36:50Z suehring
-! Refine post-initialization check for realistically inital values of mixing ratio. Give an error
-! message for faulty initial values, but only a warning in a restart run.
-!
-! 4347 2019-12-18 13:18:33Z suehring
-! Implement post-initialization check for realistically inital values of mixing ratio
-!
-! 4281 2019-10-29 15:15:39Z schwenkel
-! Moved boundary conditions in dynamics module
-!
-! 4097 2019-07-15 11:59:11Z suehring
-! Avoid overlong lines - limit is 132 characters per line
-!
-! 4047 2019-06-21 18:58:09Z knoop
-! Initial introduction of the dynamics module with only dynamics_swap_timelevel implemented
-!
-!
-! Description:
-! ------------
-!> This module contains the dynamics of PALM.
-!--------------------------------------------------------------------------------------------------!
- MODULE dynamics_mod
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  diss,                                                                               &
-               diss_p,                                                                             &
-               dzu,                                                                                &
-               e,                                                                                  &
-               e_p,                                                                                &
-               exner,                                                                              &
-               hyp,                                                                                &
-               pt, pt_1, pt_2, pt_init, pt_p,                                                      &
-               q, q_1, q_2, q_p,                                                                   &
-               s, s_1, s_2, s_p,                                                                   &
-               u, u_1, u_2, u_init, u_p,                                                           &
-               v, v_1, v_2, v_p, v_init,                                                           &
-               w, w_1, w_2, w_p,                                                                   &
-               zu
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  magnus,                                                                             &
-               rd_d_rv
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               bc_pt_t_val,                                                                        &
-               bc_q_t_val,                                                                         &
-               bc_s_t_val,                                                                         &
-               check_realistic_q,                                                                  &
-               child_domain,                                                                       &
-               coupling_mode,                                                                      &
-               constant_diffusion,                                                                 &
-               dt_3d,                                                                              &
-               humidity,                                                                           &
-               ibc_pt_b,                                                                           &
-               ibc_pt_t,                                                                           &
-               ibc_q_b,                                                                            &
-               ibc_q_t,                                                                            &
-               ibc_s_b,                                                                            &
-               ibc_s_t,                                                                            &
-               ibc_uv_b,                                                                           &
-               ibc_uv_t,                                                                           &
-               initializing_actions,                                                               &
-               intermediate_timestep_count,                                                        &
-               length,                                                                             &
-               message_string,                                                                     &
-               nesting_offline,                                                                    &
-               neutral,                                                                            &
-               nudging,                                                                            &
-               passive_scalar,                                                                     &
-               restart_string,                                                                     &
-               rans_mode,                                                                          &
-               rans_tke_e,                                                                         &
-               tsc
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx,                                                                                &
-               ddy,                                                                                &
-               dx,                                                                                 &
-               dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               ny,                                                                                 &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nzb,                                                                                &
-               nzt
-
-    USE kinds
-
-    USE pegrid
-
-    USE pmc_interface,                                                                             &
-        ONLY : nesting_mode
-
-!    USE restart_data_mpi_io_mod,                                                                   &
-!        ONLY:
-
-    USE surface_mod,                                                                               &
-        ONLY :  bc_h
-
-
-    IMPLICIT NONE
-
-    LOGICAL ::  dynamics_module_enabled = .FALSE.   !<
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public functions
-    PUBLIC                                                                                         &
-       dynamics_parin,                                                                             &
-       dynamics_check_parameters,                                                                  &
-       dynamics_check_data_output_ts,                                                              &
-       dynamics_check_data_output_pr,                                                              &
-       dynamics_check_data_output,                                                                 &
-       dynamics_init_masks,                                                                        &
-       dynamics_define_netcdf_grid,                                                                &
-       dynamics_init_arrays,                                                                       &
-       dynamics_init,                                                                              &
-       dynamics_init_checks,                                                                       &
-       dynamics_header,                                                                            &
-       dynamics_actions,                                                                           &
-       dynamics_non_advective_processes,                                                           &
-       dynamics_exchange_horiz,                                                                    &
-       dynamics_prognostic_equations,                                                              &
-       dynamics_boundary_conditions,                                                               &
-       dynamics_swap_timelevel,                                                                    &
-       dynamics_3d_data_averaging,                                                                 &
-       dynamics_data_output_2d,                                                                    &
-       dynamics_data_output_3d,                                                                    &
-       dynamics_statistics,                                                                        &
-       dynamics_rrd_global,                                                                        &
-       dynamics_rrd_local,                                                                         &
-       dynamics_wrd_global,                                                                        &
-       dynamics_wrd_local,                                                                         &
-       dynamics_last_actions
-
-!
-!-- Public parameters, constants and initial values
-    PUBLIC                                                                                         &
-       dynamics_module_enabled
-
-    INTERFACE dynamics_parin
-       MODULE PROCEDURE dynamics_parin
-    END INTERFACE dynamics_parin
-
-    INTERFACE dynamics_check_parameters
-       MODULE PROCEDURE dynamics_check_parameters
-    END INTERFACE dynamics_check_parameters
-
-    INTERFACE dynamics_check_data_output_ts
-       MODULE PROCEDURE dynamics_check_data_output_ts
-    END INTERFACE dynamics_check_data_output_ts
-
-    INTERFACE dynamics_check_data_output_pr
-       MODULE PROCEDURE dynamics_check_data_output_pr
-    END INTERFACE dynamics_check_data_output_pr
-
-    INTERFACE dynamics_check_data_output
-       MODULE PROCEDURE dynamics_check_data_output
-    END INTERFACE dynamics_check_data_output
-
-    INTERFACE dynamics_init_masks
-       MODULE PROCEDURE dynamics_init_masks
-    END INTERFACE dynamics_init_masks
-
-    INTERFACE dynamics_define_netcdf_grid
-       MODULE PROCEDURE dynamics_define_netcdf_grid
-    END INTERFACE dynamics_define_netcdf_grid
-
-    INTERFACE dynamics_init_arrays
-       MODULE PROCEDURE dynamics_init_arrays
-    END INTERFACE dynamics_init_arrays
-
-    INTERFACE dynamics_init
-       MODULE PROCEDURE dynamics_init
-    END INTERFACE dynamics_init
-
-    INTERFACE dynamics_init_checks
-       MODULE PROCEDURE dynamics_init_checks
-    END INTERFACE dynamics_init_checks
-
-    INTERFACE dynamics_header
-       MODULE PROCEDURE dynamics_header
-    END INTERFACE dynamics_header
-
-    INTERFACE dynamics_actions
-       MODULE PROCEDURE dynamics_actions
-       MODULE PROCEDURE dynamics_actions_ij
-    END INTERFACE dynamics_actions
-
-    INTERFACE dynamics_non_advective_processes
-       MODULE PROCEDURE dynamics_non_advective_processes
-       MODULE PROCEDURE dynamics_non_advective_processes_ij
-    END INTERFACE dynamics_non_advective_processes
-
-    INTERFACE dynamics_exchange_horiz
-       MODULE PROCEDURE dynamics_exchange_horiz
-    END INTERFACE dynamics_exchange_horiz
-
-    INTERFACE dynamics_prognostic_equations
-       MODULE PROCEDURE dynamics_prognostic_equations
-       MODULE PROCEDURE dynamics_prognostic_equations_ij
-    END INTERFACE dynamics_prognostic_equations
-
-    INTERFACE dynamics_boundary_conditions
-       MODULE PROCEDURE dynamics_boundary_conditions
-    END INTERFACE dynamics_boundary_conditions
-
-    INTERFACE dynamics_swap_timelevel
-       MODULE PROCEDURE dynamics_swap_timelevel
-    END INTERFACE dynamics_swap_timelevel
-
-    INTERFACE dynamics_3d_data_averaging
-       MODULE PROCEDURE dynamics_3d_data_averaging
-    END INTERFACE dynamics_3d_data_averaging
-
-    INTERFACE dynamics_data_output_2d
-       MODULE PROCEDURE dynamics_data_output_2d
-    END INTERFACE dynamics_data_output_2d
-
-    INTERFACE dynamics_data_output_3d
-       MODULE PROCEDURE dynamics_data_output_3d
-    END INTERFACE dynamics_data_output_3d
-
-    INTERFACE dynamics_statistics
-       MODULE PROCEDURE dynamics_statistics
-    END INTERFACE dynamics_statistics
-
-    INTERFACE dynamics_rrd_global
-       MODULE PROCEDURE dynamics_rrd_global_ftn
-       MODULE PROCEDURE dynamics_rrd_global_mpi
-    END INTERFACE dynamics_rrd_global
-
-    INTERFACE dynamics_rrd_local
-       MODULE PROCEDURE dynamics_rrd_local_ftn
-       MODULE PROCEDURE dynamics_rrd_local_mpi
-    END INTERFACE dynamics_rrd_local
-
-    INTERFACE dynamics_wrd_global
-       MODULE PROCEDURE dynamics_wrd_global
-    END INTERFACE dynamics_wrd_global
-
-    INTERFACE dynamics_wrd_local
-       MODULE PROCEDURE dynamics_wrd_local
-    END INTERFACE dynamics_wrd_local
-
-    INTERFACE dynamics_last_actions
-       MODULE PROCEDURE dynamics_last_actions
-    END INTERFACE dynamics_last_actions
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific namelist
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_parin
-
-    CHARACTER(LEN=100)  ::  line  !< dummy string that contains the current line of the parameter
-                                  !< file
-    INTEGER(iwp)  ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /dynamics_parameters/  switch_off_module
-
-
-!
-!-- For the time beeing (unless the dynamics module is further developed), set default module
-!-- switch to true.
-    dynamics_module_enabled = .TRUE.
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, dynamics_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    dynamics_parameters namelist was found and read correctly.
-       IF ( .NOT. switch_off_module )  dynamics_module_enabled = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    dynamics_parameters namelist was found, but contained errors. Print an error message
-!--    including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'dynamics_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE dynamics_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check control parameters and deduce further quantities.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_check_parameters
-
-
- END SUBROUTINE dynamics_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set module-specific timeseries units and labels
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
-
-    INTEGER(iwp),      INTENT(IN)     ::  dots_max
-
-    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT)  :: dots_label
-    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT)  :: dots_unit
-
-    INTEGER(iwp),      INTENT(INOUT)  ::  dots_num
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( dots_num == 0  .OR.  dots_label(1)(1:1) == ' '  .OR.  dots_unit(1)(1:1) == ' ' )  CONTINUE
-
-
- END SUBROUTINE dynamics_check_data_output_ts
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the unit of module-specific profile output quantities. For those variables not recognized,
-!> the parameter unit is set to "illegal", which tells the calling routine that the output variable
-!> is not defined and leads to a program abort.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-
-    CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
-    CHARACTER (LEN=*) ::  unit     !<
-    CHARACTER (LEN=*) ::  variable !<
-
-    INTEGER(iwp) ::  var_count     !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( unit(1:1) == ' '  .OR.  dopr_unit(1:1) == ' '  .OR.  var_count == 0 )  CONTINUE
-
-    SELECT CASE ( TRIM( variable ) )
-
-!       CASE ( 'var_name' )
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE dynamics_check_data_output_pr
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the unit of module-specific output quantities. For those variables not recognized,
-!> the parameter unit is set to "illegal", which tells the calling routine that the output variable
-!< is not defined and leads to a program abort.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_check_data_output( variable, unit )
-
-
-    CHARACTER (LEN=*) ::  unit     !<
-    CHARACTER (LEN=*) ::  variable !<
-
-    SELECT CASE ( TRIM( variable ) )
-
-!       CASE ( 'u2' )
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE dynamics_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Initialize module-specific masked output
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_init_masks( variable, unit )
-
-
-    CHARACTER (LEN=*) ::  unit     !<
-    CHARACTER (LEN=*) ::  variable !<
-
-
-    SELECT CASE ( TRIM( variable ) )
-
-!       CASE ( 'u2' )
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE dynamics_init_masks
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize module-specific arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_init_arrays
-
-
- END SUBROUTINE dynamics_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Execution of module-specific initializing actions
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_init
-
-
- END SUBROUTINE dynamics_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Perform module-specific post-initialization checks
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_init_checks
-
-    INTEGER(iwp) ::  i !< loop index in x-direction
-    INTEGER(iwp) ::  j !< loop index in y-direction
-    INTEGER(iwp) ::  k !< loop index in z-direction
-
-    LOGICAL      ::  realistic_q = .TRUE. !< flag indicating realistic mixing ratios
-
-    REAL(wp)     ::  e_s !< saturation water vapor pressure
-    REAL(wp)     ::  q_s !< saturation mixing ratio
-    REAL(wp)     ::  t_l !< actual temperature
-    REAL(wp)     ::  rh_check = 9999999.9_wp !< relative humidity
-    REAL(wp)     ::  rh_min = 9999999.9_wp !< max relative humidity
-    REAL(wp)     ::  height = 9999999.9_wp !< height of supersaturated regions
-    REAL(wp)     ::  min_height = 9999999.9_wp !< height of supersaturated regions
-
-!
-!-- Check for realistic initial mixing ratio. This must be in a realistic phyiscial range and must
-!-- not exceed the saturation mixing ratio by more than 2 percent. Please note, the check is
-!-- performed for each grid point (not just for a vertical profile), in order to cover also
-!-- three-dimensional initialization. Note, this check gives an error only for the initial run not
-!-- for a restart run. In case there are no cloud physics considered, the mixing ratio can exceed
-!-- the saturation moisture. This case a warning is given.
-    IF ( humidity  .AND.  .NOT. neutral  .AND.  check_realistic_q )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Calculate actual temperature, water vapor saturation pressure, and based on this
-!--             the saturation mixing ratio.
-                t_l = exner(k) * pt(k,j,i)
-                e_s = magnus( t_l )
-                q_s = rd_d_rv * e_s / ( hyp(k) - e_s )
-
-                IF ( q(k,j,i) > 1.02_wp * q_s )  THEN
-                   realistic_q = .FALSE.
-                   rh_check = q(k,j,i) / q_s * 100.0_wp
-                   height = zu(k)
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    Since the check is performed locally, merge the logical flag from all mpi ranks,
-!--    in order to do not print the error message multiple times.
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( MPI_IN_PLACE, realistic_q, 1, MPI_LOGICAL, MPI_LAND, comm2d, ierr)
-       CALL MPI_ALLREDUCE( rh_check, rh_min, 1, MPI_REAL, MPI_MIN, comm2d, ierr )
-       CALL MPI_ALLREDUCE( height, min_height, 1, MPI_REAL, MPI_MIN, comm2d, ierr )
-#endif
-
-       IF ( .NOT. realistic_q  .AND.                                                               &
-            TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-            WRITE( message_string, * ) 'The initial mixing ratio exceeds the saturation mixing' // &
-               'ratio, with rh =', rh_min, '% in a height of', min_height, 'm for the first time'
-          CALL message( 'dynamic_init_checks', 'PA0697', 2, 2, 0, 6, 0 )
-       ELSEIF ( .NOT. realistic_q  .AND.                                                           &
-                TRIM( initializing_actions ) == 'read_restart_data' )  THEN
-          WRITE( message_string, * ) 'The initial mixing ratio exceeds the saturation mixing' //   &
-              'ratio, with rh =', rh_min, '% in a height of', min_height, 'm for the first time'
-          CALL message( 'dynamic_init_checks', 'PA0697', 0, 1, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
- END SUBROUTINE dynamics_init_checks
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the grids on which module-specific output quantities are defined. Allowed values for
-!> grid_x are "x" and "xu", for grid_y "y" and "yv", and for grid_z "zu" and "zw".
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
-
-
-    CHARACTER (LEN=*) ::  grid_x     !<
-    CHARACTER (LEN=*) ::  grid_y     !<
-    CHARACTER (LEN=*) ::  grid_z     !<
-    CHARACTER (LEN=*) ::  variable   !<
-
-    LOGICAL ::  found   !<
-
-
-    SELECT CASE ( TRIM( variable ) )
-
-!       CASE ( 'u2' )
-
-       CASE DEFAULT
-          found  = .FALSE.
-          grid_x = 'none'
-          grid_y = 'none'
-          grid_z = 'none'
-
-    END SELECT
-
-
- END SUBROUTINE dynamics_define_netcdf_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Print a header with module-specific information.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_header( io )
-
-
-    INTEGER(iwp) ::  io   !< output-file id
-
-!
-!-- Write dynamics module header
-!-- NOTE: Deactivated because no relevant information to write so far
-    IF ( .FALSE. )  WRITE ( io, 100 )
-
-!
-!-- Format-descriptors
-100 FORMAT (//' Dynamics module information:'/                                              &
-              ' -----------------------------------'//)
-
- END SUBROUTINE dynamics_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Execute module-specific actions for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_actions( location )
-
-
-    CHARACTER (LEN=*) ::  location !<
-
-!    INTEGER(iwp) ::  i !<
-!    INTEGER(iwp) ::  j !<
-!    INTEGER(iwp) ::  k !<
-
-!
-!-- 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' )
-
-
-       CASE ( 'before_prognostic_equations' )
-
-
-       CASE ( 'after_integration' )
-
-
-       CASE ( 'after_timestep' )
-
-
-       CASE ( 'u-tendency' )
-
-
-       CASE ( 'v-tendency' )
-
-
-       CASE ( 'w-tendency' )
-
-
-       CASE ( 'pt-tendency' )
-
-
-       CASE ( 'sa-tendency' )
-
-
-       CASE ( 'e-tendency' )
-
-
-       CASE ( 'q-tendency' )
-
-
-       CASE ( 's-tendency' )
-
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE dynamics_actions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Execute module-specific actions for grid point i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_actions_ij( i, j, location )
-
-
-    CHARACTER (LEN=*) ::  location
-
-    INTEGER(iwp) ::  i
-    INTEGER(iwp) ::  j
-
-!
-!-- Here the user-defined actions follow
-    SELECT CASE ( location )
-
-       CASE ( 'u-tendency' )
-
-!
-!--       Next line is to avoid compiler warning about unused variables. Please remove.
-          IF ( i +  j < 0 )  CONTINUE
-
-       CASE ( 'v-tendency' )
-
-
-       CASE ( 'w-tendency' )
-
-
-       CASE ( 'pt-tendency' )
-
-
-       CASE ( 'sa-tendency' )
-
-
-       CASE ( 'e-tendency' )
-
-
-       CASE ( 'q-tendency' )
-
-
-       CASE ( 's-tendency' )
-
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE dynamics_actions_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute module-specific non-advective processes for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_non_advective_processes
-
-
-
- END SUBROUTINE dynamics_non_advective_processes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute module-specific non-advective processes for grid points i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_non_advective_processes_ij( i, j )
-
-
-    INTEGER(iwp) ::  i                 !<
-    INTEGER(iwp) ::  j                 !<
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( i + j < 0 )  CONTINUE
-
-
- END SUBROUTINE dynamics_non_advective_processes_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Perform module-specific horizontal boundary exchange
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_exchange_horiz( location )
-
-       CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-       SELECT CASE ( location )
-
-          CASE ( 'before_prognostic_equation' )
-
-          CASE ( 'after_prognostic_equation' )
-
-             CALL exchange_horiz( u_p, nbgp )
-             CALL exchange_horiz( v_p, nbgp )
-             CALL exchange_horiz( w_p, nbgp )
-             CALL exchange_horiz( pt_p, nbgp )
-             IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e_p, nbgp )
-             IF ( rans_tke_e  )               CALL exchange_horiz( diss_p, nbgp )
-             IF ( humidity )                  CALL exchange_horiz( q_p, nbgp )
-             IF ( passive_scalar )            CALL exchange_horiz( s_p, nbgp )
-
-          CASE ( 'after_anterpolation' )
-
-             CALL exchange_horiz( u, nbgp )
-             CALL exchange_horiz( v, nbgp )
-             CALL exchange_horiz( w, nbgp )
-             IF ( .NOT. neutral )             CALL exchange_horiz( pt, nbgp )
-             IF ( humidity )                  CALL exchange_horiz( q, nbgp )
-             IF ( passive_scalar )            CALL exchange_horiz( s, nbgp )
-             IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e, nbgp )
-             IF ( .NOT. constant_diffusion  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-                CALL exchange_horiz( diss, nbgp )
-             ENDIF
-
-       END SELECT
-
- END SUBROUTINE dynamics_exchange_horiz
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute module-specific prognostic equations for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_prognostic_equations
-
-
-
- END SUBROUTINE dynamics_prognostic_equations
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute module-specific prognostic equations for grid point i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_prognostic_equations_ij( i, j, i_omp_start, tn )
-
-
-    INTEGER(iwp), INTENT(IN) ::  i            !< grid index in x-direction
-    INTEGER(iwp), INTENT(IN) ::  i_omp_start  !< first loop index of i-loop in prognostic_equations
-    INTEGER(iwp), INTENT(IN) ::  j            !< grid index in y-direction
-    INTEGER(iwp), INTENT(IN) ::  tn           !< task number of openmp task
-
-!
-!-- Next line is just to avoid compiler warnings about unused variables. You may remove it.
-    IF ( i + j + i_omp_start + tn < 0 )  CONTINUE
-
- END SUBROUTINE dynamics_prognostic_equations_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute boundary conditions of dynamics model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_boundary_conditions
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< grid index x direction
-    INTEGER(iwp) ::  j  !< grid index y direction
-    INTEGER(iwp) ::  k  !< grid index z direction
-    INTEGER(iwp) ::  l  !< running index boundary type, for up- and downward-facing walls
-    INTEGER(iwp) ::  m  !< running index surface elements
-
-!
-!-- Bottom boundary
-    IF ( ibc_uv_b == 1 )  THEN
-       u_p(nzb,:,:) = u_p(nzb+1,:,:)
-       v_p(nzb,:,:) = v_p(nzb+1,:,:)
-    ENDIF
-!
-!-- Set zero vertical velocity at topography top (l=0), or bottom (l=1) in case
-!-- of downward-facing surfaces.
-    DO  l = 0, 1
-       !$OMP PARALLEL DO PRIVATE( i, j, k )
-       !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
-       !$ACC PRESENT(bc_h, w_p)
-       DO  m = 1, bc_h(l)%ns
-          i = bc_h(l)%i(m)
-          j = bc_h(l)%j(m)
-          k = bc_h(l)%k(m)
-          w_p(k+bc_h(l)%koff,j,i) = 0.0_wp
-       ENDDO
-    ENDDO
-
-!
-!-- Top boundary. A nested domain ( ibc_uv_t = 3 ) does not require settings.
-    IF ( ibc_uv_t == 0 )  THEN
-        !$ACC KERNELS PRESENT(u_p, v_p, u_init, v_init)
-        u_p(nzt+1,:,:) = u_init(nzt+1)
-        v_p(nzt+1,:,:) = v_init(nzt+1)
-        !$ACC END KERNELS
-    ELSEIF ( ibc_uv_t == 1 )  THEN
-        u_p(nzt+1,:,:) = u_p(nzt,:,:)
-        v_p(nzt+1,:,:) = v_p(nzt,:,:)
-    ENDIF
-
-!
-!-- Vertical nesting: Vertical velocity not zero at the top of the fine grid
-    IF ( .NOT.  child_domain  .AND.  .NOT.  nesting_offline  .AND.                                 &
-         TRIM(coupling_mode) /= 'vnested_fine' )  THEN
-       !$ACC KERNELS PRESENT(w_p)
-       w_p(nzt:nzt+1,:,:) = 0.0_wp  !< nzt is not a prognostic level (but cf. pres)
-       !$ACC END KERNELS
-    ENDIF
-
-!
-!-- Temperature at bottom and top boundary.
-!-- In case of coupled runs (ibc_pt_b = 2) the temperature is given by the sea surface temperature
-!-- of the coupled ocean model.
-!-- Dirichlet
-    IF ( .NOT. neutral )  THEN
-       IF ( ibc_pt_b == 0 )  THEN
-          DO  l = 0, 1
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, bc_h(l)%ns
-                i = bc_h(l)%i(m)
-                j = bc_h(l)%j(m)
-                k = bc_h(l)%k(m)
-                pt_p(k+bc_h(l)%koff,j,i) = pt(k+bc_h(l)%koff,j,i)
-             ENDDO
-          ENDDO
-!
-!--    Neumann, zero-gradient
-       ELSEIF ( ibc_pt_b == 1 )  THEN
-          DO  l = 0, 1
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
-             !$ACC PRESENT(bc_h, pt_p)
-             DO  m = 1, bc_h(l)%ns
-                i = bc_h(l)%i(m)
-                j = bc_h(l)%j(m)
-                k = bc_h(l)%k(m)
-                pt_p(k+bc_h(l)%koff,j,i) = pt_p(k,j,i)
-             ENDDO
-          ENDDO
-       ENDIF
-
-!
-!--    Temperature at top boundary
-       IF ( ibc_pt_t == 0 )  THEN
-           pt_p(nzt+1,:,:) = pt(nzt+1,:,:)
-!
-!--        In case of nudging adjust top boundary to pt which is
-!--        read in from NUDGING-DATA
-           IF ( nudging )  THEN
-              pt_p(nzt+1,:,:) = pt_init(nzt+1)
-           ENDIF
-       ELSEIF ( ibc_pt_t == 1 )  THEN
-           pt_p(nzt+1,:,:) = pt_p(nzt,:,:)
-       ELSEIF ( ibc_pt_t == 2 )  THEN
-           !$ACC KERNELS PRESENT(pt_p, dzu)
-           pt_p(nzt+1,:,:) = pt_p(nzt,:,:) + bc_pt_t_val * dzu(nzt+1)
-           !$ACC END KERNELS
-       ENDIF
-    ENDIF
-!
-!-- Boundary conditions for total water content, bottom and top boundary (see also temperature)
-    IF ( humidity )  THEN
-!
-!--    Surface conditions for constant_humidity_flux
-!--    Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
-!--    belongs to the atmospheric grid point, therefore, set q_p at k-1
-       IF ( ibc_q_b == 0 ) THEN
-
-          DO  l = 0, 1
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, bc_h(l)%ns
-                i = bc_h(l)%i(m)
-                j = bc_h(l)%j(m)
-                k = bc_h(l)%k(m)
-                q_p(k+bc_h(l)%koff,j,i) = q(k+bc_h(l)%koff,j,i)
-             ENDDO
-          ENDDO
-
-       ELSE
-
-          DO  l = 0, 1
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, bc_h(l)%ns
-                i = bc_h(l)%i(m)
-                j = bc_h(l)%j(m)
-                k = bc_h(l)%k(m)
-                q_p(k+bc_h(l)%koff,j,i) = q_p(k,j,i)
-             ENDDO
-          ENDDO
-       ENDIF
-!
-!--    Top boundary
-       IF ( ibc_q_t == 0 ) THEN
-          q_p(nzt+1,:,:) = q(nzt+1,:,:)
-       ELSEIF ( ibc_q_t == 1 ) THEN
-          q_p(nzt+1,:,:) = q_p(nzt,:,:) + bc_q_t_val * dzu(nzt+1)
-       ENDIF
-    ENDIF
-!
-!-- Boundary conditions for scalar, bottom and top boundary (see also temperature)
-    IF ( passive_scalar )  THEN
-!
-!--    Surface conditions for constant_humidity_flux
-!--    Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
-!--    belongs to the atmospheric grid point, therefore, set s_p at k-1
-       IF ( ibc_s_b == 0 ) THEN
-
-          DO  l = 0, 1
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, bc_h(l)%ns
-                i = bc_h(l)%i(m)
-                j = bc_h(l)%j(m)
-                k = bc_h(l)%k(m)
-                s_p(k+bc_h(l)%koff,j,i) = s(k+bc_h(l)%koff,j,i)
-             ENDDO
-          ENDDO
-
-       ELSE
-
-          DO  l = 0, 1
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, bc_h(l)%ns
-                i = bc_h(l)%i(m)
-                j = bc_h(l)%j(m)
-                k = bc_h(l)%k(m)
-                s_p(k+bc_h(l)%koff,j,i) = s_p(k,j,i)
-             ENDDO
-          ENDDO
-       ENDIF
-!
-!--    Top boundary condition
-       IF ( ibc_s_t == 0 )  THEN
-          s_p(nzt+1,:,:) = s(nzt+1,:,:)
-       ELSEIF ( ibc_s_t == 1 )  THEN
-          s_p(nzt+1,:,:) = s_p(nzt,:,:)
-       ELSEIF ( ibc_s_t == 2 )  THEN
-          s_p(nzt+1,:,:) = s_p(nzt,:,:) + bc_s_t_val * dzu(nzt+1)
-       ENDIF
-
-    ENDIF
-!
-!-- In case of inflow or nest boundary at the south boundary the boundary for v is at nys and in
-!-- case of inflow or nest boundary at the left boundary the boundary for u is at nxl. Since in
-!-- prognostic_equations (cache optimized version) these levels are handled as a prognostic level,
-!-- boundary values have to be restored here.
-    IF ( bc_dirichlet_s )  THEN
-       v_p(:,nys,:) = v_p(:,nys-1,:)
-    ELSEIF ( bc_dirichlet_l ) THEN
-       u_p(:,:,nxl) = u_p(:,:,nxl-1)
-    ENDIF
-
-!
-!-- The same restoration for u at i=nxl and v at j=nys as above must be made in case of nest
-!-- boundaries. This must not be done in case of vertical nesting mode as in that case the lateral
-!-- boundaries are actually cyclic.
-!-- Lateral oundary conditions for TKE and dissipation are set in tcm_boundary_conds.
-    IF ( nesting_mode /= 'vertical'  .OR.  nesting_offline )  THEN
-       IF ( bc_dirichlet_s )  THEN
-          v_p(:,nys,:) = v_p(:,nys-1,:)
-       ENDIF
-       IF ( bc_dirichlet_l )  THEN
-          u_p(:,:,nxl) = u_p(:,:,nxl-1)
-       ENDIF
-    ENDIF
-
-!
-!-- Lateral boundary conditions for scalar quantities at the outflow.
-!-- Lateral oundary conditions for TKE and dissipation are set in tcm_boundary_conds.
-    IF ( bc_radiation_s )  THEN
-       pt_p(:,nys-1,:)     = pt_p(:,nys,:)
-       IF ( humidity )  THEN
-          q_p(:,nys-1,:) = q_p(:,nys,:)
-       ENDIF
-       IF ( passive_scalar )  s_p(:,nys-1,:) = s_p(:,nys,:)
-    ELSEIF ( bc_radiation_n )  THEN
-       pt_p(:,nyn+1,:)     = pt_p(:,nyn,:)
-       IF ( humidity )  THEN
-          q_p(:,nyn+1,:) = q_p(:,nyn,:)
-       ENDIF
-       IF ( passive_scalar )  s_p(:,nyn+1,:) = s_p(:,nyn,:)
-    ELSEIF ( bc_radiation_l )  THEN
-       pt_p(:,:,nxl-1)     = pt_p(:,:,nxl)
-       IF ( humidity )  THEN
-          q_p(:,:,nxl-1) = q_p(:,:,nxl)
-       ENDIF
-       IF ( passive_scalar )  s_p(:,:,nxl-1) = s_p(:,:,nxl)
-    ELSEIF ( bc_radiation_r )  THEN
-       pt_p(:,:,nxr+1)     = pt_p(:,:,nxr)
-       IF ( humidity )  THEN
-          q_p(:,:,nxr+1) = q_p(:,:,nxr)
-       ENDIF
-       IF ( passive_scalar )  s_p(:,:,nxr+1) = s_p(:,:,nxr)
-    ENDIF
-
-!
-!-- Radiation boundary conditions for the velocities at the respective outflow.
-!-- The phase velocity is set to the maximum phase velocity that ensures numerical
-!-- stability (CFL-condition), i.e. a Courant number of one is assumed.
-    IF ( bc_radiation_s )  THEN
-       u_p(:,-1,:) = u(:,0,:)
-       v_p(:,0,:)  = v(:,1,:)
-       w_p(:,-1,:) = w(:,0,:)
-    ENDIF
-
-    IF ( bc_radiation_n )  THEN
-       u_p(:,ny+1,:) = u(:,ny,:)
-       v_p(:,ny+1,:) = v(:,ny,:)
-       w_p(:,ny+1,:) = w(:,ny,:)
-    ENDIF
-
-    IF ( bc_radiation_l )  THEN
-       u_p(:,:,0)  = u(:,:,1)
-       v_p(:,:,-1) = v(:,:,0)
-       w_p(:,:,-1) = w(:,:,0)
-    ENDIF
-
-    IF ( bc_radiation_r )  THEN
-       u_p(:,:,nx+1) = u(:,:,nx)
-       v_p(:,:,nx+1) = v(:,:,nx)
-       w_p(:,:,nx+1) = w(:,:,nx)
-    ENDIF
-
- END SUBROUTINE dynamics_boundary_conditions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Swap timelevels of module-specific array pointers
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_swap_timelevel ( mod_count )
-
-
-    INTEGER, INTENT(IN) :: mod_count
-
-
-    SELECT CASE ( mod_count )
-
-       CASE ( 0 )
-
-          u  => u_1;   u_p  => u_2
-          v  => v_1;   v_p  => v_2
-          w  => w_1;   w_p  => w_2
-          IF ( .NOT. neutral )  THEN
-             pt => pt_1;  pt_p => pt_2
-          ENDIF
-          IF ( humidity )  THEN
-             q => q_1;    q_p => q_2
-          ENDIF
-          IF ( passive_scalar )  THEN
-             s => s_1;    s_p => s_2
-          ENDIF
-
-       CASE ( 1 )
-
-          u  => u_2;   u_p  => u_1
-          v  => v_2;   v_p  => v_1
-          w  => w_2;   w_p  => w_1
-          IF ( .NOT. neutral )  THEN
-             pt => pt_2;  pt_p => pt_1
-          ENDIF
-          IF ( humidity )  THEN
-             q => q_2;    q_p => q_1
-          ENDIF
-          IF ( passive_scalar )  THEN
-             s => s_2;    s_p => s_1
-          ENDIF
-
-    END SELECT
-
- END SUBROUTINE dynamics_swap_timelevel
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sum up and time-average module-specific output quantities as well as allocate the array necessary
-!> for storing the average.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_3d_data_averaging( mode, variable )
-
-
-    CHARACTER (LEN=*) ::  mode    !<
-    CHARACTER (LEN=*) :: variable !<
-
-
-    IF ( mode == 'allocate' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-!          CASE ( 'u2' )
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'sum' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-!          CASE ( 'u2' )
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'average' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-!          CASE ( 'u2' )
-
-       END SELECT
-
-    ENDIF
-
- END SUBROUTINE dynamics_3d_data_averaging
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resorts the module-specific output quantity with indices (k,j,i) to a temporary array with
-!> indices (i,j,k) and sets the grid on which it is defined.
-!> Allowed values for grid are "zu" and "zw".
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do,     &
-                                     nzt_do, fill_value )
-
-
-    CHARACTER (LEN=*)             ::  grid       !<
-    CHARACTER (LEN=*), INTENT(IN) ::  mode       !< either 'xy', 'xz' or 'yz'
-    CHARACTER (LEN=*)             ::  variable   !<
-
-    INTEGER(iwp) ::  av     !< flag to control data output of instantaneous or time-averaged data
-!    INTEGER(iwp) ::  i      !< grid index along x-direction
-!    INTEGER(iwp) ::  j      !< grid index along y-direction
-!    INTEGER(iwp) ::  k      !< grid index along z-direction
-!    INTEGER(iwp) ::  m      !< running index surface elements
-    INTEGER(iwp) ::  nzb_do !< lower limit of the domain (usually nzb)
-    INTEGER(iwp) ::  nzt_do !< upper limit of the domain (usually nzt+1)
-
-    LOGICAL      ::  found !<
-    LOGICAL      ::  two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
-
-    REAL(wp), INTENT(IN) ::  fill_value
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
-
-!
-!-- Next line is just to avoid compiler warnings about unused variables. You may remove it.
-    IF ( two_d .AND. av + LEN( mode ) + local_pf(nxl,nys,nzb_do) + fill_value < 0.0 )  CONTINUE
-
-    found = .TRUE.
-
-    SELECT CASE ( TRIM( variable ) )
-
-!       CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
-
-       CASE DEFAULT
-          found = .FALSE.
-          grid  = 'none'
-
-    END SELECT
-
-
- END SUBROUTINE dynamics_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resorts the module-specific output quantity with indices (k,j,i) to a temporary array with
-!> indices (i,j,k).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-
-
-    CHARACTER (LEN=*) ::  variable !<
-
-    INTEGER(iwp) ::  av    !<
-!    INTEGER(iwp) ::  i     !<
-!    INTEGER(iwp) ::  j     !<
-!    INTEGER(iwp) ::  k     !<
-    INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
-    INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
-
-    LOGICAL      ::  found !<
-
-    REAL(wp), INTENT(IN) ::  fill_value    !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( av + local_pf(nxl,nys,nzb_do) + fill_value < 0.0 )  CONTINUE
-
-
-    found = .TRUE.
-
-    SELECT CASE ( TRIM( variable ) )
-
-!       CASE ( 'u2' )
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE dynamics_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of module-specific statistics, i.e. horizontally averaged profiles and time series.
-!> This is called for every statistic region sr, but at least for the region "total domain" (sr=0).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_statistics( mode, sr, tn )
-
-
-    CHARACTER (LEN=*) ::  mode   !<
-!    INTEGER(iwp) ::  i    !<
-!    INTEGER(iwp) ::  j    !<
-!    INTEGER(iwp) ::  k    !<
-    INTEGER(iwp) ::  sr   !<
-    INTEGER(iwp) ::  tn   !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( sr == 0  .OR.  tn == 0 )  CONTINUE
-
-    IF ( mode == 'profiles' )  THEN
-
-    ELSEIF ( mode == 'time_series' )  THEN
-
-    ENDIF
-
- END SUBROUTINE dynamics_statistics
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_rrd_global_ftn( found )
-
-    LOGICAL, INTENT(OUT)  ::  found
-
-
-    found = .TRUE.
-
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'global_paramter' )
-!          READ ( 13 )  global_parameter
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE dynamics_rrd_global_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_rrd_global_mpi
-
-!    CALL rrd_mpi_io( 'global_parameter', global_parameter )
-    CONTINUE
-
- END SUBROUTINE dynamics_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!> Subdomain index limits on file are given by nxl_on_file, etc.
-!> Indices nxlc, etc. indicate the range of gridpoints to be mapped from the subdomain on file (f)
-!> to the subdomain of the current PE (c). They have been calculated in routine rrd_local.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf,     &
-                                    nync, nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d,    &
-                                    found )
-
-
-    INTEGER(iwp) ::  k               !<
-    INTEGER(iwp) ::  nxlc            !<
-    INTEGER(iwp) ::  nxlf            !<
-    INTEGER(iwp) ::  nxl_on_file     !<
-    INTEGER(iwp) ::  nxrc            !<
-    INTEGER(iwp) ::  nxrf            !<
-    INTEGER(iwp) ::  nxr_on_file     !<
-    INTEGER(iwp) ::  nync            !<
-    INTEGER(iwp) ::  nynf            !<
-    INTEGER(iwp) ::  nyn_on_file     !<
-    INTEGER(iwp) ::  nysc            !<
-    INTEGER(iwp) ::  nysf            !<
-    INTEGER(iwp) ::  nys_on_file     !<
-
-    LOGICAL, INTENT(OUT)  ::  found
-
-    REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d   !<
-    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf +                               &
-         tmp_2d(nys_on_file,nxl_on_file) +                                                         &
-         tmp_3d(nzb,nys_on_file,nxl_on_file) < 0.0 )  CONTINUE
-!
-!-- Here the reading of user-defined restart data follows:
-!-- Sample for user-defined output
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-!       CASE ( 'u2_av' )
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE dynamics_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_rrd_local_mpi
-
-    IMPLICIT NONE
-
-!    LOGICAL ::  array_found  !<
-
-
-!    CALL rd_mpi_io_check_array( 'u2_av' , found = array_found )
-!    IF ( array_found )  THEN
-!       IF ( .NOT. ALLOCATED( u2_av ) )  ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!       CALL rrd_mpi_io( 'u2_av', u2_av )
-!    ENDIF
-
-    CONTINUE
-
- END SUBROUTINE dynamics_rrd_local_mpi
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Writes global module-specific restart data into binary file(s) for restart runs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_wrd_global
-
-
- END SUBROUTINE dynamics_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Writes processor specific and module-specific restart data into binary file(s) for restart runs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_wrd_local
-
-
- END SUBROUTINE dynamics_wrd_local
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Execute module-specific actions at the very end of the program.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dynamics_last_actions
-
-
- END SUBROUTINE dynamics_last_actions
-
- END MODULE dynamics_mod
Index: palm/trunk/SOURCE/exchange_horiz.f90
===================================================================
--- palm/trunk/SOURCE/exchange_horiz.f90	(revision 1)
+++ palm/trunk/SOURCE/exchange_horiz.f90	(revision 1)
@@ -0,0 +1,180 @@
+ SUBROUTINE exchange_horiz( ar, xrp, ynp )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: exchange_horiz.f90,v $
+! Revision 1.16  2006/02/23 12:19:08  raasch
+! anz_yz renamed ngp_yz
+!
+! Revision 1.15  2005/03/26 20:20:39  raasch
+! Extensions for non-cyclic boundary conditions along x or y
+!
+! Revision 1.14  2003/10/29 08:51:10  raasch
+! Exchange of boundaries within the PE memory in case that multigrid method
+! has switched to PE0 only
+!
+! Revision 1.13  2003/03/16 09:30:38  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.12  2002/12/20 10:40:08  raasch
+! Integer variables will be defined in the parallel case only
+!
+! Revision 1.11  2002/12/19 14:46:43  raasch
+! Cyclic boundary conditions along y used instead of sendrecv in case of
+! pdims(2)=1. SENDRECV replaced by nonblocking routines ISEND and IRECV.
+! Array "feld" is renamed to "ar".
+!
+! Revision 1.9  2002/04/16  08:16:50  08:16:50  raasch (Siegfried Raasch)
+! Cyclic boundary conditions along x used instead of sendrecv in case of
+! pdims(1)=1
+! 
+! Revision 1.8  2001/07/20 13:04:59  raasch
+! anz_yz and type_xz changed to arrays to allow for the boundary value exchange
+! for the different grid levels used in the multigrid method,
+! +module control_parameters
+!
+! Revision 1.7  2001/03/30 07:23:00  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.6  2001/01/22 06:36:07  raasch
+! Module test_variables removed
+!
+! Revision 1.5  2000/12/20 12:06:44  letzel
+! All comments translated into English.
+!
+! Revision 1.4  1998/07/06 12:13:36  raasch
+! + USE test_variables
+!
+! Revision 1.3  1998/01/23 09:57:45  raasch
+! Umbenennung von anz_yz_p in anz_yz sowie von type_xz_p in type_xz
+!
+! Revision 1.2  1997/08/11 06:14:55  raasch
+! Felder werden jetzt ueber Formalparameter uebergeben.
+!
+! Revision 1.1  1997/07/24 11:13:29  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Exchange of lateral boundary values (parallel computers) and cyclic
+! lateral boundary conditions, respectively.
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER ::  xrp, ynp
+
+#if defined( __parallel )
+    INTEGER                               ::  typexz
+    INTEGER, DIMENSION(4)                 ::  req
+    INTEGER, DIMENSION(MPI_STATUS_SIZE,4) ::  wait_stat
+#endif
+
+    REAL ::  ar(nzb:nzt+1,nys-1:nyn+ynp+1,nxl-1:nxr+xrp+1)
+
+
+    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Exchange of lateral boundary values for parallel computers
+    IF ( pdims(1) == 1  .OR.  mg_switch_to_pe0 )  THEN
+!
+!--    One-dimensional decomposition along y, boundary values can be exchanged
+!--    within the PE memory
+       IF ( bc_lr == 'cyclic' )  THEN
+          ar(:,nys:nyn,nxl-1) = ar(:,nys:nyn,nxr)
+          ar(:,nys:nyn,nxr+1) = ar(:,nys:nyn,nxl)
+       ENDIF
+
+    ELSE
+       req = 0
+!
+!--    Send left boundary, receive right one
+       CALL MPI_ISEND(                                                     &
+               ar(nzb,nys-1,nxl), ngp_yz(grid_level), MPI_REAL, pleft,  0, &
+                          comm2d, req(1), ierr )
+       CALL MPI_IRECV(                                                       &
+               ar(nzb,nys-1,nxr+1), ngp_yz(grid_level), MPI_REAL, pright, 0, &
+                          comm2d, req(2), ierr )
+!
+!--    Send right boundary, receive left one
+       CALL MPI_ISEND(                                                     &
+               ar(nzb,nys-1,nxr), ngp_yz(grid_level), MPI_REAL, pright, 1, &
+                          comm2d, req(3), ierr )
+       CALL MPI_IRECV(                                                       &
+               ar(nzb,nys-1,nxl-1), ngp_yz(grid_level), MPI_REAL, pleft,  1, &
+                          comm2d, req(4), ierr )
+       call MPI_Waitall (4,req,wait_stat,ierr)
+    ENDIF
+
+
+    IF ( pdims(2) == 1  .OR.  mg_switch_to_pe0 )  THEN
+!
+!--    One-dimensional decomposition along x, boundary values can be exchanged
+!--    within the PE memory
+       IF ( bc_ns == 'cyclic' )  THEN
+          ar(:,nys-1,:) = ar(:,nyn,:)
+          ar(:,nyn+1,:) = ar(:,nys,:)
+       ENDIF
+
+    ELSE
+!
+!--    Set the MPI data type, which depends on the size of the array
+!--    (the v array has an additional gridpoint along y in case of non-cyclic
+!--    boundary conditions)
+       IF ( ynp == 0 )  THEN
+          typexz = type_xz(grid_level)
+       ELSE
+          typexz = type_xz_p
+       ENDIF
+
+       req = 0
+!
+!--    Send front boundary, receive rear one
+       CALL MPI_ISEND( ar(nzb,nys,nxl-1),   1, typexz, psouth, 0, comm2d, &
+                       req(1), ierr )
+       CALL MPI_IRECV( ar(nzb,nyn+1,nxl-1), 1, typexz, pnorth, 0, comm2d, &
+                       req(2), ierr )
+!
+!--    Send rear boundary, receive front one
+       CALL MPI_ISEND( ar(nzb,nyn,nxl-1),   1, typexz, pnorth, 1, comm2d, &
+                       req(3), ierr )
+       CALL MPI_IRECV( ar(nzb,nys-1,nxl-1), 1, typexz, psouth, 1, comm2d, &
+                       req(4), ierr )
+       call MPI_Waitall (4,req,wait_stat,ierr)
+    ENDIF
+
+
+#else
+
+!
+!-- Lateral boundary conditions in the non-parallel case
+    IF ( bc_lr == 'cyclic' )  THEN
+       ar(:,nys:nyn,nxl-1) = ar(:,nys:nyn,nxr)
+       ar(:,nys:nyn,nxr+1) = ar(:,nys:nyn,nxl)
+    ENDIF
+
+    IF ( bc_ns == 'cyclic' )  THEN
+       ar(:,nys-1,:) = ar(:,nyn,:)
+       ar(:,nyn+1,:) = ar(:,nys,:)
+    ENDIF
+
+#endif
+
+    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
+
+ END SUBROUTINE exchange_horiz
Index: palm/trunk/SOURCE/exchange_horiz_2d.f90
===================================================================
--- palm/trunk/SOURCE/exchange_horiz_2d.f90	(revision 1)
+++ palm/trunk/SOURCE/exchange_horiz_2d.f90	(revision 1)
@@ -0,0 +1,213 @@
+ SUBROUTINE exchange_horiz_2d( ar )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: exchange_horiz_2d.f90,v $
+! Revision 1.9  2006/05/12 19:15:52  letzel
+! MPI_REAL replaced by MPI_INTEGER in exchange_horiz_2d_int
+!
+! Revision 1.8  2006/02/23 12:18:32  raasch
+! Additional subroutine exchange_horiz_2d_int for 2D integer arrays,
+! extensions for non-cyclic boundary conditions along x or y for non-parallel
+! case, anz_y renamed ngp_y
+!
+! Revision 1.7  2003/03/16 09:30:43  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.6  2002/06/11 12:59:35  raasch
+! Cyclic boundary conditions are used instead of sendrecv in case of
+! pdims(..)=1. Array "feld" is renamed to "ar".
+!
+! Revision 1.5  2001/03/30  07:23:16  07:23:16  raasch (Siegfried Raasch)
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+! 
+! Revision 1.4  2001/01/22 06:43:50  raasch
+! Module test_variables removed
+!
+! Revision 1.3  2000/12/20 12:09:27  letzel
+! All comments translated into English.
+!
+! Revision 1.2  1998/07/06 12:13:53  raasch
+! + USE test_variables
+!
+! Revision 1.1  1998/01/23 09:58:21  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
+! boundary conditions, respectively, for 2D-arrays.
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+
+    IMPLICIT NONE
+
+    REAL ::  ar(nys-1:nyn+1,nxl-1:nxr+1)
+
+
+    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Exchange of lateral boundary values for parallel computers
+    IF ( pdims(1) == 1 )  THEN
+
+!
+!--    One-dimensional decomposition along y, boundary values can be exchanged
+!--    within the PE memory
+       ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
+       ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
+
+    ELSE
+!
+!--    Send left boundary, receive right one
+       CALL MPI_SENDRECV( ar(nys,nxl),   ngp_y, MPI_REAL, pleft,  0, &
+                          ar(nys,nxr+1), ngp_y, MPI_REAL, pright, 0, &
+                          comm2d, status, ierr )
+!
+!--    Send right boundary, receive left one
+       CALL MPI_SENDRECV( ar(nys,nxr),   ngp_y, MPI_REAL, pright,  1, &
+                          ar(nys,nxl-1), ngp_y, MPI_REAL, pleft,   1, &
+                          comm2d, status, ierr )
+    ENDIF
+
+    IF ( pdims(2) == 1 )  THEN
+!
+!--    One-dimensional decomposition along x, boundary values can be exchanged
+!--    within the PE memory
+       ar(nys-1,:) = ar(nyn,:)
+       ar(nyn+1,:) = ar(nys,:)
+
+    ELSE
+!
+!--    Send front boundary, receive rear one
+       CALL MPI_SENDRECV( ar(nys,nxl-1),   1, type_x, psouth, 0, &
+                          ar(nyn+1,nxl-1), 1, type_x, pnorth, 0, &
+                          comm2d, status, ierr )
+!
+!--    Send rear boundary, receive front one
+       CALL MPI_SENDRECV( ar(nyn,nxl-1),   1, type_x, pnorth, 1, &
+                          ar(nys-1,nxl-1), 1, type_x, psouth, 1, &
+                          comm2d, status, ierr )
+    ENDIF
+
+#else
+
+!
+!-- Lateral boundary conditions in the non-parallel case
+    IF ( bc_lr == 'cyclic' )  THEN
+       ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
+       ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
+    ENDIF
+
+    IF ( bc_ns == 'cyclic' )  THEN
+       ar(nys-1,:) = ar(nyn,:)
+       ar(nyn+1,:) = ar(nys,:)
+    ENDIF
+
+#endif
+
+    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
+
+ END SUBROUTINE exchange_horiz_2d
+
+
+
+ SUBROUTINE exchange_horiz_2d_int( ar )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
+! boundary conditions, respectively, for 2D integer arrays.
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER ::  ar(nys-1:nyn+1,nxl-1:nxr+1)
+
+
+    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Exchange of lateral boundary values for parallel computers
+    IF ( pdims(1) == 1 )  THEN
+
+!
+!--    One-dimensional decomposition along y, boundary values can be exchanged
+!--    within the PE memory
+       ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
+       ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
+
+    ELSE
+!
+!--    Send left boundary, receive right one
+       CALL MPI_SENDRECV( ar(nys,nxl),   ngp_y, MPI_INTEGER, pleft,  0, &
+                          ar(nys,nxr+1), ngp_y, MPI_INTEGER, pright, 0, &
+                          comm2d, status, ierr )
+!
+!--    Send right boundary, receive left one
+       CALL MPI_SENDRECV( ar(nys,nxr),   ngp_y, MPI_INTEGER, pright,  1, &
+                          ar(nys,nxl-1), ngp_y, MPI_INTEGER, pleft,   1, &
+                          comm2d, status, ierr )
+    ENDIF
+
+    IF ( pdims(2) == 1 )  THEN
+!
+!--    One-dimensional decomposition along x, boundary values can be exchanged
+!--    within the PE memory
+       ar(nys-1,:) = ar(nyn,:)
+       ar(nyn+1,:) = ar(nys,:)
+
+    ELSE
+!
+!--    Send front boundary, receive rear one
+       CALL MPI_SENDRECV( ar(nys,nxl-1),   1, type_x_int, psouth, 0, &
+                          ar(nyn+1,nxl-1), 1, type_x_int, pnorth, 0, &
+                          comm2d, status, ierr )
+!
+!--    Send rear boundary, receive front one
+       CALL MPI_SENDRECV( ar(nyn,nxl-1),   1, type_x_int, pnorth, 1, &
+                          ar(nys-1,nxl-1), 1, type_x_int, psouth, 1, &
+                          comm2d, status, ierr )
+    ENDIF
+
+#else
+
+!
+!-- Lateral boundary conditions in the non-parallel case
+    IF ( bc_lr == 'cyclic' )  THEN
+       ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
+       ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
+    ENDIF
+
+    IF ( bc_ns == 'cyclic' )  THEN
+       ar(nys-1,:) = ar(nyn,:)
+       ar(nyn+1,:) = ar(nys,:)
+    ENDIF
+
+#endif
+
+    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
+
+ END SUBROUTINE exchange_horiz_2d_int
Index: palm/trunk/SOURCE/exchange_horiz_mod.f90
===================================================================
--- palm/trunk/SOURCE/exchange_horiz_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,858 +1,0 @@
-!> @file exchange_horiz.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4474 2020-03-26 09:32:18Z raasch
-! bugfix for correct usage of alternative communicators in case of 1d-decompositions and in
-! non-parallel mode
-!
-! 4461 2020-03-12 16:51:59Z raasch
-! optional communicator added to exchange_horiz
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! routine has been modularized, file exchange_horiz_2d has been merged
-!
-! 4429 2020-02-27 15:24:30Z raasch
-! bugfix: cpp-directives added for serial mode
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! OpenACC directives re-formatted
-!
-! 3657 2019-01-07 20:14:18Z knoop
-! OpenACC port for SPEC
-!
-! Revision 1.1  1997/07/24 11:13:29  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Exchange of ghost point layers for subdomains (in parallel mode) and setting of cyclic lateral
-!> boundary conditions for the total domain .
-!--------------------------------------------------------------------------------------------------!
- MODULE exchange_horiz_mod
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    PRIVATE
-    PUBLIC exchange_horiz, exchange_horiz_int, exchange_horiz_2d, exchange_horiz_2d_byte,          &
-           exchange_horiz_2d_int
-
-    INTERFACE exchange_horiz
-       MODULE PROCEDURE exchange_horiz
-    END INTERFACE exchange_horiz
-
-    INTERFACE exchange_horiz_int
-       MODULE PROCEDURE exchange_horiz_int
-    END INTERFACE exchange_horiz_int
-
-    INTERFACE exchange_horiz_2d
-       MODULE PROCEDURE exchange_horiz_2d
-    END INTERFACE exchange_horiz_2d
-
-    INTERFACE exchange_horiz_2d_byte
-       MODULE PROCEDURE exchange_horiz_2d_byte
-    END INTERFACE exchange_horiz_2d_byte
-
-    INTERFACE exchange_horiz_2d_int
-       MODULE PROCEDURE exchange_horiz_2d_int
-    END INTERFACE exchange_horiz_2d_int
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exchange of ghost point layers for subdomains (in parallel mode) and setting of cyclic lateral
-!> boundary conditions for the total domain.
-!> This routine is for REAL 3d-arrays.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE exchange_horiz( ar, nbgp_local, alternative_communicator)
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc, bc_ns_cyc
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  grid_level, mg_switch_to_pe0, synchronous_exchange
-#endif
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
-
-
-#if defined( _OPENACC )
-    INTEGER(iwp) ::  i           !<
-#endif
-
-    INTEGER(iwp), OPTIONAL ::  alternative_communicator  !< alternative MPI communicator to be used
-
-    INTEGER(iwp) ::  communicator  !< communicator that is used as argument in MPI calls
-    INTEGER(iwp) ::  left_pe       !< id of left pe that is used as argument in MPI calls
-    INTEGER(iwp) ::  nbgp_local    !< number of ghost point layers
-    INTEGER(iwp) ::  north_pe      !< id of north pe that is used as argument in MPI calls
-    INTEGER(iwp) ::  right_pe      !< id of right pe that is used as argument in MPI calls
-    INTEGER(iwp) ::  south_pe      !< id of south pe that is used as argument in MPI calls
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local,                                   &
-                        nxl-nbgp_local:nxr+nbgp_local) ::  ar !< 3d-array for which exchange is done
-
-
-    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
-
-#if defined( _OPENACC )
-    !$ACC UPDATE IF_PRESENT ASYNC(1) &
-    !$ACC HOST(ar(:,:,nxr-nbgp_local+1:nxr)) &
-    !$ACC HOST(ar(:,:,nxl:nxl+nbgp_local-1))
-
-!
-!-- Wait for first UPDATE to complete before starting the others.
-    !$ACC WAIT(1) ASYNC(2)
-    ! ar(:,:,nxl-nbgp_local:nxl-1) is overwritten by first part below
-    ! ar(:,:,nxl:nxl+nbgp_local-1) has been transferred above
-    DO i = nxl+nbgp_local, nxr-nbgp_local
-       !$ACC UPDATE IF_PRESENT ASYNC(2) &
-       !$ACC HOST(ar(:,nyn-nbgp_local+1:nyn,i)) &
-       !$ACC HOST(ar(:,nys:nys+nbgp_local-1,i))
-    ENDDO
-    ! ar(:,:,nxr-nbgp_local+1:nxr) has been transferred above
-    ! ar(:,:,nxr+1:nxr+nbgp_local) is overwritten by first part below
-
-!
-!-- Wait for first UPDATE to complete before starting MPI.
-    !$ACC WAIT(1)
-#endif
-
-!
-!-- Set the communicator to be used
-    IF ( PRESENT( alternative_communicator ) )  THEN
-!
-!--    Alternative communicator is to be used
-       communicator = communicator_configurations(alternative_communicator)%mpi_communicator
-       left_pe  = communicator_configurations(alternative_communicator)%pleft
-       right_pe = communicator_configurations(alternative_communicator)%pright
-       south_pe = communicator_configurations(alternative_communicator)%psouth
-       north_pe = communicator_configurations(alternative_communicator)%pnorth
-
-    ELSE
-!
-!--    Main communicator is to be used
-       communicator = comm2d
-       left_pe  = pleft
-       right_pe = pright
-       south_pe = psouth
-       north_pe = pnorth
-
-    ENDIF
-
-#if defined( __parallel )
-
-!
-!-- Exchange in x-direction of lateral boundaries
-    IF ( pdims(1) == 1  .OR.  mg_switch_to_pe0 )  THEN
-!
-!--    One-dimensional decomposition along y, boundary values can be exchanged within the PE memory.
-       IF ( PRESENT( alternative_communicator ) )  THEN
-          IF ( alternative_communicator <= 2 )  THEN
-             ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
-             ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
-          ENDIF
-       ELSE
-          IF ( bc_lr_cyc )  THEN
-             ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
-             ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
-          ENDIF
-       ENDIF
-
-    ELSE
-
-       IF ( synchronous_exchange )  THEN
-!
-!--       Send left boundary, receive right one (synchronous)
-          CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxl),   1, type_yz(grid_level), left_pe,  0,    &
-                             ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), right_pe, 0,    &
-                             communicator, status, ierr )
-!
-!--       Send right boundary, receive left one (synchronous)
-          CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1,                           &
-                             type_yz(grid_level), right_pe, 1,                                     &
-                             ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1,                             &
-                             type_yz(grid_level), left_pe,  1,                                     &
-                             communicator, status, ierr )
-
-       ELSE
-
-!
-!--       Asynchroneous exchange
-          IF ( send_receive == 'lr'  .OR.  send_receive == 'al' )  THEN
-
-             req(1:4)  = 0
-             req_count = 0
-!
-!--          Send left boundary, receive right one (asynchronous)
-             CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxl),   1, type_yz(grid_level), left_pe,        &
-                             req_count, communicator, req(req_count+1), ierr )
-             CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), right_pe,       &
-                             req_count, communicator, req(req_count+2), ierr )
-!
-!--          Send right boundary, receive left one (asynchronous)
-             CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, type_yz(grid_level),      &
-                             right_pe, req_count+1, communicator, req(req_count+3), ierr )
-             CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1, type_yz(grid_level),      &
-                             left_pe,  req_count+1, communicator, req(req_count+4), ierr )
-
-             CALL MPI_WAITALL( 4, req, wait_stat, ierr )
-
-          ENDIF
-
-       ENDIF
-
-    ENDIF
-
-    !$ACC UPDATE IF_PRESENT ASYNC(1) &
-    !$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
-    !$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
-
-!
-!-- Wait for UPDATES above to complete before starting MPI.
-    !$ACC WAIT(2)
-
-    IF ( pdims(2) == 1  .OR.  mg_switch_to_pe0 )  THEN
-!
-!--    One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
-       IF ( PRESENT( alternative_communicator ) )  THEN
-          IF ( alternative_communicator == 1  .OR.  alternative_communicator == 3 )  THEN
-             ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
-             ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
-          ENDIF
-       ELSE
-          IF ( bc_ns_cyc )  THEN
-             ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
-             ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
-          ENDIF
-       ENDIF
-
-    ELSE
-
-       IF ( synchronous_exchange )  THEN
-!
-!--       Send front boundary, receive rear one (synchronous)
-          CALL MPI_SENDRECV( ar(nzb,nys,nxl-nbgp_local),   1, type_xz(grid_level), south_pe, 0,    &
-                             ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), north_pe, 0,    &
-                             communicator, status, ierr )
-!
-!--       Send rear boundary, receive front one (synchronous)
-          CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1,                           &
-                             type_xz(grid_level), north_pe, 1,                                     &
-                             ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,                           &
-                             type_xz(grid_level), south_pe, 1,                                     &
-                             communicator, status, ierr )
-
-       ELSE
-
-!
-!--       Asynchroneous exchange
-          IF ( send_receive == 'ns'  .OR.  send_receive == 'al' )  THEN
-
-             req(1:4)  = 0
-             req_count = 0
-
-!
-!--          Send front boundary, receive rear one (asynchronous)
-             CALL MPI_ISEND( ar(nzb,nys,nxl-nbgp_local),   1, type_xz(grid_level), south_pe,       &
-                             req_count, communicator, req(req_count+1), ierr )
-             CALL MPI_IRECV( ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), north_pe,       &
-                             req_count, communicator, req(req_count+2), ierr )
-!
-!--          Send rear boundary, receive front one (asynchronous)
-             CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, type_xz(grid_level),      &
-                             north_pe, req_count+1, communicator, req(req_count+3), ierr )
-             CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1, type_xz(grid_level),      &
-                             south_pe, req_count+1, communicator, req(req_count+4), ierr )
-
-             CALL MPI_WAITALL( 4, req, wait_stat, ierr )
-
-          ENDIF
-
-       ENDIF
-
-    ENDIF
-
-#else
-
-!
-!-- Lateral boundary conditions in the non-parallel case.
-!-- Case dependent, because in GPU mode still not all arrays are on device. This workaround has to
-!-- be removed later. Also, since PGI compiler 12.5 has problems with array syntax, explicit loops
-!-- are used.
-    IF ( PRESENT( alternative_communicator ) )  THEN
-       IF ( alternative_communicator <= 2 )  THEN
-          ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
-          ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
-       ENDIF
-    ELSE
-       IF ( bc_lr_cyc )  THEN
-          ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
-          ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
-       ENDIF
-    ENDIF
-
-    !$ACC UPDATE IF_PRESENT ASYNC(1) &
-    !$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
-    !$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
-
-!
-!-- Wait for UPDATES above to complete before starting MPI.
-    !$ACC WAIT(2)
-
-    IF ( PRESENT( alternative_communicator ) )  THEN
-       IF ( alternative_communicator == 1  .OR.  alternative_communicator == 3 )  THEN
-          ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
-          ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
-       ENDIF
-    ELSE
-       IF ( bc_ns_cyc )  THEN
-          ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
-          ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
-       ENDIF
-    ENDIF
-
-#endif
-
-#if defined( _OPENACC )
-    DO i = nxl-nbgp_local, nxr+nbgp_local
-       !$ACC UPDATE IF_PRESENT ASYNC(2) &
-       !$ACC DEVICE(ar(:,nys-nbgp_local:nys-1,i)) &
-       !$ACC DEVICE(ar(:,nyn+1:nyn+nbgp_local,i))
-    ENDDO
-
-!
-!-- Wait for all UPDATEs to finish.
-    !$ACC WAIT
-#endif
-
-    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
-
- END SUBROUTINE exchange_horiz
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc, bc_ns_cyc
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  grid_level
-#endif
-
-    USE indices,                                                                                   &
-        ONLY:  nzb
-
-    INTEGER(iwp) ::  nbgp_local  !< number of ghost points
-    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
-    INTEGER(iwp) ::  nxr_l       !< local index bound at current grid level, right side
-    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
-    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
-    INTEGER(iwp) ::  nzt_l       !< local index bound at current grid level, top
-
-    INTEGER(iwp), DIMENSION(nzb:nzt_l+1,nys_l-nbgp_local:nyn_l+nbgp_local,                         &
-                            nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
-
-
-#if defined( __parallel )
-    IF ( pdims(1) == 1 )  THEN
-!
-!--    One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
-       IF ( bc_lr_cyc )  THEN
-          ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
-          ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
-       ENDIF
-    ELSE
-!
-!--    Send left boundary, receive right one (synchronous)
-       CALL MPI_SENDRECV( ar(nzb,nys_l-nbgp_local,nxl_l),   1, type_yz_int(grid_level), pleft,  0, &
-                          ar(nzb,nys_l-nbgp_local,nxr_l+1), 1, type_yz_int(grid_level), pright, 0, &
-                          comm2d, status, ierr )
-!
-!--    Send right boundary, receive left one (synchronous)
-       CALL MPI_SENDRECV( ar(nzb,nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, type_yz_int(grid_level), &
-                          pright, 1,                                                               &
-                          ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local),   1, type_yz_int(grid_level), &
-                          pleft,  1,                                                               &
-                          comm2d, status, ierr )
-    ENDIF
-
-
-    IF ( pdims(2) == 1 )  THEN
-!
-!--    One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
-       IF ( bc_ns_cyc )  THEN
-          ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
-          ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
-       ENDIF
-
-    ELSE
-
-!
-!--    Send front boundary, receive rear one (synchronous)
-       CALL MPI_SENDRECV( ar(nzb,nys_l,nxl_l-nbgp_local),   1, type_xz_int(grid_level), psouth, 0, &
-                          ar(nzb,nyn_l+1,nxl_l-nbgp_local), 1, type_xz_int(grid_level), pnorth, 0, &
-                          comm2d, status, ierr )
-!
-!--    Send rear boundary, receive front one (synchronous)
-       CALL MPI_SENDRECV( ar(nzb,nyn_l-nbgp_local+1,nxl_l-nbgp_local), 1,                          &
-                          type_xz_int(grid_level), pnorth, 1,                                      &
-                          ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local),   1,                          &
-                          type_xz_int(grid_level), psouth, 1,                                      &
-                          comm2d, status, ierr )
-
-    ENDIF
-
-#else
-
-    IF ( bc_lr_cyc )  THEN
-       ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
-       ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
-    ENDIF
-
-    IF ( bc_ns_cyc )  THEN
-       ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
-       ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
-    ENDIF
-
-#endif
-
- END SUBROUTINE exchange_horiz_int
-
-! Description:
-! ------------
-!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic boundary conditions,
-!> respectively, for 2D-arrays.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE exchange_horiz_2d( ar )
-
-    USE control_parameters,                                                                        &
-        ONLY :  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,                    &
-                bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
-
-    USE cpulog,                                                                                    &
-        ONLY :  cpu_log, log_point_s
-
-    USE indices,                                                                                   &
-        ONLY :  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg
-
-#if ! defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc, bc_ns_cyc
-#endif
-
-
-    INTEGER(iwp) :: i  !<
-
-    REAL(wp) ::  ar(nysg:nyng,nxlg:nxrg)  !<
-
-
-    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
-
-#if defined( __parallel )
-
-!
-!-- Exchange of lateral boundary values for parallel computers
-    IF ( pdims(1) == 1 )  THEN
-
-!
-!--    One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
-       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
-       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
-
-    ELSE
-!
-!--    Send left boundary, receive right one
-
-       CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft,  0,                                      &
-                          ar(nysg,nxr+1), 1, type_y, pright, 0,                                    &
-                          comm2d, status, ierr )
-!
-!--    Send right boundary, receive left one
-       CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright,  1,                              &
-                          ar(nysg,nxlg), 1, type_y, pleft,   1,                                    &
-                          comm2d, status, ierr )
-
-
-    ENDIF
-
-    IF ( pdims(2) == 1 )  THEN
-!
-!--    One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
-       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
-       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
-
-    ELSE
-!
-!--    Send front boundary, receive rear one
-
-       CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0,                                      &
-                          ar(nyn+1,nxlg), 1, type_x, pnorth, 0,                                    &
-                          comm2d, status, ierr )
-!
-!--    Send rear boundary, receive front one
-       CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1,                               &
-                          ar(nysg,nxlg), 1, type_x, psouth, 1,                                     &
-                          comm2d, status, ierr )
-
-    ENDIF
-
-#else
-
-!
-!-- Lateral boundary conditions in the non-parallel case
-    IF ( bc_lr_cyc )  THEN
-       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
-       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
-    ENDIF
-
-    IF ( bc_ns_cyc )  THEN
-       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
-       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
-    ENDIF
-
-#endif
-
-!
-!-- Neumann-conditions at inflow/outflow/nested boundaries
-    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-       DO  i = nbgp, 1, -1
-          ar(:,nxl-i) = ar(:,nxl)
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-       DO  i = 1, nbgp
-          ar(:,nxr+i) = ar(:,nxr)
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-       DO  i = nbgp, 1, -1
-          ar(nys-i,:) = ar(nys,:)
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-       DO  i = 1, nbgp
-          ar(nyn+i,:) = ar(nyn,:)
-       ENDDO
-    ENDIF
-
-    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
-
- END SUBROUTINE exchange_horiz_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic boundary conditions,
-!> respectively, for 2D 8-bit integer arrays.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE exchange_horiz_2d_byte( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,                     &
-               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point_s
-
-#if ! defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc, bc_ns_cyc
-#endif
-
-    INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
-    INTEGER(iwp) ::  i           !< dummy index to zero-gradient conditions at in/outflow boundaries
-    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
-    INTEGER(iwp) ::  nxr_l       !< local index bound at current grid level, right side
-    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
-    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
-
-    INTEGER(KIND=1), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,                                  &
-                               nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
-
-    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
-
-#if defined( __parallel )
-
-!
-!-- Exchange of lateral boundary values for parallel computers
-    IF ( pdims(1) == 1 )  THEN
-
-!
-!--    One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
-       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
-       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
-
-    ELSE
-!
-!--    Send left boundary, receive right one
-       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                                         &
-                          type_y_byte, pleft,  0,                                                  &
-                          ar(nys_l-nbgp_local,nxr_l+1), 1,                                         &
-                          type_y_byte, pright, 0,                                                  &
-                          comm2d, status, ierr )
-!
-!--    Send right boundary, receive left one
-       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,                              &
-                          type_y_byte, pright, 1,                                                  &
-                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,                              &
-                          type_y_byte, pleft,  1,                                                  &
-                          comm2d, status, ierr )
-
-    ENDIF
-
-    IF ( pdims(2) == 1 )  THEN
-!
-!--    One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
-       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
-       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
-
-
-    ELSE
-!
-!--    Send front boundary, receive rear one
-       CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                                         &
-                          type_x_byte, psouth, 0,                                                  &
-                          ar(nyn_l+1,nxl_l-nbgp_local), 1,                                         &
-                          type_x_byte, pnorth, 0,                                                  &
-                          comm2d, status, ierr )
-
-!
-!--    Send rear boundary, receive front one
-       CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,                              &
-                          type_x_byte, pnorth, 1,                                                  &
-                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,                              &
-                          type_x_byte, psouth, 1,                                                  &
-                          comm2d, status, ierr )
-
-    ENDIF
-
-#else
-
-!
-!-- Lateral boundary conditions in the non-parallel case
-    IF ( bc_lr_cyc )  THEN
-       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
-       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
-    ENDIF
-
-    IF ( bc_ns_cyc )  THEN
-       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
-       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
-    ENDIF
-
-#endif
-!
-!-- Neumann-conditions at inflow/outflow/nested boundaries
-    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-       DO  i = nbgp_local, 1, -1
-         ar(:,nxl_l-i) = ar(:,nxl_l)
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_r  .OR.  bc_radiation_r  )  THEN
-       DO  i = 1, nbgp_local
-          ar(:,nxr_l+i) = ar(:,nxr_l)
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_s  .OR.  bc_radiation_s  )  THEN
-       DO  i = nbgp_local, 1, -1
-         ar(nys_l-i,:) = ar(nys_l,:)
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_n  .OR.  bc_radiation_n  )  THEN
-       DO  i = 1, nbgp_local
-         ar(nyn_l+i,:) = ar(nyn_l,:)
-       ENDDO
-    ENDIF
-
-    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
-
- END SUBROUTINE exchange_horiz_2d_byte
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic boundary conditions,
-!> respectively, for 2D 32-bit integer arrays.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,                     &
-               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  grid_level
-#endif
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point_s
-
-#if ! defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc, bc_ns_cyc
-#endif
-
-    INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
-    INTEGER(iwp) ::  i           !< dummy index to zero-gradient conditions at in/outflow boundaries
-    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
-    INTEGER(iwp) ::  nxr_l       !< local index bound at current grid level, right side
-    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
-    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
-
-    INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,                                     &
-                            nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
-
-    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
-
-#if defined( __parallel )
-
-!
-!-- Exchange of lateral boundary values for parallel computers
-    IF ( pdims(1) == 1 )  THEN
-
-!
-!--    One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
-       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
-       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
-
-    ELSE
-!
-!--    Send left boundary, receive right one
-       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                                         &
-                          type_y_int(grid_level), pleft,  0,                                       &
-                          ar(nys_l-nbgp_local,nxr_l+1), 1,                                         &
-                          type_y_int(grid_level), pright, 0,                                       &
-                          comm2d, status, ierr )
-!
-!--    Send right boundary, receive left one
-       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,                              &
-                          type_y_int(grid_level), pright, 1,                                       &
-                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,                              &
-                          type_y_int(grid_level), pleft,  1,                                       &
-                          comm2d, status, ierr )
-
-    ENDIF
-
-    IF ( pdims(2) == 1 )  THEN
-!
-!--    One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
-       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
-       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
-
-
-    ELSE
-!
-!--    Send front boundary, receive rear one
-       CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                                         &
-                          type_x_int(grid_level), psouth, 0,                                       &
-                          ar(nyn_l+1,nxl_l-nbgp_local), 1,                                         &
-                          type_x_int(grid_level), pnorth, 0,                                       &
-                          comm2d, status, ierr )
-
-!
-!--    Send rear boundary, receive front one
-       CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,                              &
-                          type_x_int(grid_level), pnorth, 1,                                       &
-                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,                              &
-                          type_x_int(grid_level), psouth, 1,                                       &
-                          comm2d, status, ierr )
-
-    ENDIF
-
-#else
-
-!
-!-- Lateral boundary conditions in the non-parallel case
-    IF ( bc_lr_cyc )  THEN
-       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
-       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
-    ENDIF
-
-    IF ( bc_ns_cyc )  THEN
-       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
-       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
-    ENDIF
-
-#endif
-!
-!-- Neumann-conditions at inflow/outflow/nested boundaries
-    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-       DO  i = nbgp_local, 1, -1
-         ar(:,nxl_l-i) = ar(:,nxl_l)
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_r  .OR.  bc_radiation_r  )  THEN
-       DO  i = 1, nbgp_local
-          ar(:,nxr_l+i) = ar(:,nxr_l)
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_s  .OR.  bc_radiation_s  )  THEN
-       DO  i = nbgp_local, 1, -1
-         ar(nys_l-i,:) = ar(nys_l,:)
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_n  .OR.  bc_radiation_n  )  THEN
-       DO  i = 1, nbgp_local
-         ar(nyn_l+i,:) = ar(nyn_l,:)
-       ENDDO
-    ENDIF
-
-    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
-
- END SUBROUTINE exchange_horiz_2d_int
-
-
- END MODULE exchange_horiz_mod
Index: palm/trunk/SOURCE/fft_xy.f90
===================================================================
--- palm/trunk/SOURCE/fft_xy.f90	(revision 1)
+++ palm/trunk/SOURCE/fft_xy.f90	(revision 1)
@@ -0,0 +1,842 @@
+ MODULE fft_xy
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: fft_xy.f90,v $
+! Revision 1.4  2006/03/28 12:27:09  raasch
+! Stop when system-specific fft is selected on NEC. For unknown reasons this
+! causes a program abort during first allocation in init_grid.
+!
+! Revision 1.3  2006/02/23 12:22:41  raasch
+! System specfic routines are not allowed to be used on ibmy
+!
+! Revision 1.2  2004/04/30 11:44:27  raasch
+! Module renamed from fft_for_1d_decomp to fft_xy, 1d-routines renamed to
+! fft_x and fft_y,
+! function FFT replaced by subroutine FFTN due to problems with 64-bit
+! mode on ibm,
+! shape of array cwork is explicitly stored in ishape/jshape and handled
+! to routine FFTN instead of shape-function (due to compiler error on
+! decalpha),
+! non vectorized FFT for nec included
+!
+! Revision 1.1  2004/04/30 11:37:14  raasch
+! Initial revision
+!
+! Revision 1.6  2003/08/01 08:15:09  raasch
+! No abort in fft_1dd_init on t3e-systems if system specific routines are used
+!
+! Revision 1.5  2003/04/16 12:51:47  raasch
+! Temperton-fft implemented in routines fft_x_1dd and fft_y_1dd
+!
+! Revision 1.4  2003/03/16 09:37:26  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.3  2003/03/12 16:29:39  raasch
+! Routines fft_x_1dd_m and fft_y_1dd_m added (suitable for multiple 1d-fft on
+! vector processors)
+!
+! Revision 1.2  2002/12/19 14:49:18  raasch
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.1  2002/06/11 13:00:49  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Fast Fourier transformation along x and y for 1d domain decomposition along x.
+! Original version: Klaus Ketelsen (May 2002)
+!------------------------------------------------------------------------------!
+
+    USE array_kind
+    USE control_parameters
+    USE indices
+    USE singleton
+    USE temperton_fft
+
+    IMPLICIT NONE
+
+    PRIVATE
+    PUBLIC fft_x, fft_y, fft_init, fft_x_m, fft_y_m
+
+    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::  ifax_x, ifax_y
+
+    LOGICAL, SAVE                            ::  init_fft = .FALSE.
+
+    REAL, SAVE ::  sqr_nx, sqr_ny
+    REAL, DIMENSION(:), ALLOCATABLE, SAVE    ::  trigs_x, trigs_y
+
+#if defined( __ibm )
+    INTEGER, PARAMETER ::  nau1 = 20000, nau2 = 22000
+!
+!-- The following working arrays contain tables and have to be "save" and
+!-- shared in OpenMP sense
+    REAL, DIMENSION(nau1), SAVE ::  aux1, auy1, aux3, auy3
+#elif defined( __nec )
+    INTEGER, SAVE ::  nz1
+    REAL, DIMENSION(:), ALLOCATABLE, SAVE ::  trig_xb, trig_xf, trig_yb, &
+                                              trig_yf
+#endif
+
+!
+!-- Public interfaces
+    INTERFACE fft_init
+       MODULE PROCEDURE fft_init
+    END INTERFACE fft_init
+
+    INTERFACE fft_x
+       MODULE PROCEDURE fft_x
+    END INTERFACE fft_x
+
+    INTERFACE fft_y
+       MODULE PROCEDURE fft_y
+    END INTERFACE fft_y
+
+    INTERFACE fft_x_m
+       MODULE PROCEDURE fft_x_m
+    END INTERFACE fft_x_m
+
+    INTERFACE fft_y_m
+       MODULE PROCEDURE fft_y_m
+    END INTERFACE fft_y_m
+
+ CONTAINS
+
+
+    SUBROUTINE fft_init
+
+       IMPLICIT NONE
+
+!
+!--    The following temporary working arrays have to be on stack or private
+!--    in OpenMP sense
+#if defined( __ibm )
+       REAL, DIMENSION(0:nx+2) :: workx
+       REAL, DIMENSION(0:ny+2) :: worky
+       REAL, DIMENSION(nau2)   :: aux2, auy2, aux4, auy4
+#elif defined( __nec )
+       REAL, DIMENSION(0:nx+3,nz+1)   ::  work_x
+       REAL, DIMENSION(0:ny+3,nz+1)   ::  work_y
+       REAL, DIMENSION(6*(nx+3),nz+1) ::  workx
+       REAL, DIMENSION(6*(ny+3),nz+1) ::  worky
+#endif 
+
+!
+!--    Return, if already called
+       IF ( init_fft )  THEN
+          RETURN
+       ELSE
+          init_fft = .TRUE.
+       ENDIF
+
+       IF ( fft_method == 'system-specific' )  THEN
+
+          sqr_nx = SQRT( 1.0 / ( nx + 1.0 ) )
+          sqr_ny = SQRT( 1.0 / ( ny + 1.0 ) )
+#if defined( __ibm )  &&  ! defined( __ibmy_special )
+!
+!--       Initialize tables for fft along x
+          CALL DRCFT( 1, workx, 1, workx, 1, nx+1, 1,  1, sqr_nx, aux1, nau1, &
+                      aux2, nau2 )
+          CALL DCRFT( 1, workx, 1, workx, 1, nx+1, 1, -1, sqr_nx, aux3, nau1, &
+                      aux4, nau2 )
+!
+!--       Initialize tables for fft along y
+          CALL DRCFT( 1, worky, 1, worky, 1, ny+1, 1,  1, sqr_ny, auy1, nau1, &
+                      auy2, nau2 )
+          CALL DCRFT( 1, worky, 1, worky, 1, ny+1, 1, -1, sqr_ny, auy3, nau1, &
+                      auy4, nau2 )
+#elif defined( __nec )
+          PRINT*, '+++ fft_init: fft method "', fft_method, &
+                  '" currently does not work on NEC'
+          CALL local_stop
+
+          ALLOCATE( trig_xb(2*(nx+1)), trig_xf(2*(nx+1)), &
+                    trig_yb(2*(ny+1)), trig_yf(2*(ny+1)) )
+
+          work_x = 0.0
+          work_y = 0.0
+          nz1  = nz + MOD( nz+1, 2 )  ! odd nz slows down fft significantly
+                                      ! when using the NEC ffts
+
+!
+!--       Initialize tables for fft along x (non-vector and vector case (M))
+          CALL DZFFT( 0, nx+1, sqr_nx, work_x, work_x, trig_xf, workx, 0 )
+          CALL ZDFFT( 0, nx+1, sqr_nx, work_x, work_x, trig_xb, workx, 0 )
+          CALL DZFFTM( 0, nx+1, nz1, sqr_nx, work_x, nx+4, work_x, nx+4, &
+                       trig_xf, workx, 0 )
+          CALL ZDFFTM( 0, nx+1, nz1, sqr_nx, work_x, nx+4, work_x, nx+4, &
+                       trig_xb, workx, 0 )
+!
+!--       Initialize tables for fft along y (non-vector and vector case (M))
+          CALL DZFFT( 0, ny+1, sqr_ny, work_y, work_y, trig_yf, worky, 0 )
+          CALL ZDFFT( 0, ny+1, sqr_ny, work_y, work_y, trig_yb, worky, 0 )
+          CALL DZFFTM( 0, ny+1, nz1, sqr_ny, work_y, ny+4, work_y, ny+4, &
+                       trig_yf, worky, 0 )
+          CALL ZDFFTM( 0, ny+1, nz1, sqr_ny, work_y, ny+4, work_y, ny+4, &
+                       trig_yb, worky, 0 )
+#else
+          PRINT*, '+++ fft_init: no system-specific fft-call available'
+          CALL local_stop
+#endif
+       ELSEIF ( fft_method == 'temperton-algorithm' )  THEN
+!
+!--       Temperton-algorithm
+!--       Initialize tables for fft along x and y
+          ALLOCATE( ifax_x(nx+1), ifax_y(ny+1), trigs_x(nx+1), trigs_y(ny+1) )
+
+          CALL set99( trigs_x, ifax_x, nx+1 )
+          CALL set99( trigs_y, ifax_y, ny+1 )
+
+       ELSEIF ( fft_method == 'singleton-algorithm' )  THEN
+
+          CONTINUE
+
+       ELSE
+
+          PRINT*, '+++ fft_init: fft method "', fft_method, &
+                  '" not available'
+          CALL local_stop
+
+       ENDIF
+
+    END SUBROUTINE fft_init
+
+
+    SUBROUTINE fft_x( ar, direction )
+
+!----------------------------------------------------------------------!
+!                                 fft_x                                !
+!                                                                      !
+!               Fourier-transformation along x-direction               !
+!                                                                      !
+!      fft_x uses internal algorithms (Singleton or Temperton) or      !
+!           system-specific routines, if they are available            !
+!----------------------------------------------------------------------!
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  direction
+       INTEGER ::  i, ishape(1)
+
+!kk    REAL, DIMENSION(:)        ::  ar !kk Does NOT work (Bug??)
+       REAL, DIMENSION(0:nx)     ::  ar
+       REAL, DIMENSION(0:nx+2)   ::  work
+       REAL, DIMENSION(nx+2)     ::  work1
+       COMPLEX, DIMENSION(:), ALLOCATABLE ::  cwork
+#if defined( __ibm )
+       REAL, DIMENSION(nau2)     ::  aux2, aux4
+#elif defined( __nec )
+       REAL, DIMENSION(6*(nx+1)) ::  work2
+#endif
+
+       IF ( fft_method == 'singleton-algorithm' )  THEN
+
+!
+!--       Performing the fft with singleton's software works on every system,
+!--       since it is part of the model
+          ALLOCATE( cwork(0:nx) )
+      
+          IF ( direction == 'forward')   then
+
+             DO  i = 0, nx
+                cwork(i) = CMPLX( ar(i) )
+             ENDDO
+             ishape = SHAPE( cwork )
+             CALL FFTN( cwork, ishape )
+
+             DO  i = 0, (nx+1)/2
+                ar(i) = REAL( cwork(i) )
+             ENDDO
+             DO  i = 1, (nx+1)/2 - 1
+                ar(nx+1-i) = -AIMAG( cwork(i) )
+             ENDDO
+
+          ELSE
+
+             cwork(0) = CMPLX( ar(0), 0.0 )
+             DO  i = 1, (nx+1)/2 - 1
+                cwork(i)      = CMPLX( ar(i), -ar(nx+1-i) )
+                cwork(nx+1-i) = CMPLX( ar(i),  ar(nx+1-i) )
+             ENDDO
+             cwork((nx+1)/2) = CMPLX( ar((nx+1)/2), 0.0 )
+
+             ishape = SHAPE( cwork )
+             CALL FFTN( cwork, ishape, inv = .TRUE. )
+
+             DO  i = 0, nx
+                ar(i) = REAL( cwork(i) )
+             ENDDO
+
+          ENDIF
+
+          DEALLOCATE( cwork )
+
+       ELSEIF ( fft_method == 'temperton-algorithm' )  THEN
+
+!
+!--       Performing the fft with Temperton's software works on every system,
+!--       since it is part of the model
+          IF ( direction == 'forward' )  THEN
+
+             work(0:nx) = ar
+             CALL fft991cy( work, work1, trigs_x, ifax_x, 1, nx+1, nx+1, 1, -1 )
+
+             DO  i = 0, (nx+1)/2
+                ar(i) = work(2*i)
+             ENDDO
+             DO  i = 1, (nx+1)/2 - 1
+                ar(nx+1-i) = work(2*i+1)
+             ENDDO
+
+          ELSE
+
+             DO  i = 0, (nx+1)/2
+                work(2*i) = ar(i)
+             ENDDO
+             DO  i = 1, (nx+1)/2 - 1
+                work(2*i+1) = ar(nx+1-i)
+             ENDDO
+             work(1)    = 0.0
+             work(nx+2) = 0.0
+
+             CALL fft991cy( work, work1, trigs_x, ifax_x, 1, nx+1, nx+1, 1, 1 )
+             ar = work(0:nx)
+
+          ENDIF
+
+       ELSEIF ( fft_method == 'system-specific' )  THEN
+
+#if defined( __ibm )  &&  ! defined( __ibmy_special )
+          IF ( direction == 'forward' )  THEN
+
+             CALL DRCFT( 0, ar, 1, work, 1, nx+1, 1, 1, sqr_nx, aux1, nau1, &
+                         aux2, nau2 )
+
+             DO  i = 0, (nx+1)/2
+                ar(i) = work(2*i)
+             ENDDO
+             DO  i = 1, (nx+1)/2 - 1
+                ar(nx+1-i) = work(2*i+1)
+             ENDDO
+
+          ELSE
+
+             DO  i = 0, (nx+1)/2
+                work(2*i) = ar(i)
+             ENDDO
+             DO  i = 1, (nx+1)/2 - 1
+                work(2*i+1) = ar(nx+1-i)
+             ENDDO
+             work(1) = 0.0
+             work(nx+2) = 0.0
+
+             CALL DCRFT( 0, work, 1, work, 1, nx+1, 1, -1, sqr_nx, aux3, nau1, &
+                         aux4, nau2 )
+
+             DO  i = 0, nx
+                ar(i) = work(i)
+             ENDDO
+
+          ENDIF
+#elif defined( __nec )
+          IF ( direction == 'forward' )  THEN
+
+             work(0:nx) = ar(0:nx)
+
+             CALL DZFFT( 1, nx+1, sqr_nx, work, work, trig_xf, work2, 0 )
+
+             DO  i = 0, (nx+1)/2
+                ar(i) = work(2*i)
+             ENDDO
+             DO  i = 1, (nx+1)/2 - 1
+                ar(nx+1-i) = work(2*i+1)
+             ENDDO
+
+          ELSE
+
+             DO  i = 0, (nx+1)/2
+                work(2*i) = ar(i)
+             ENDDO
+             DO  i = 1, (nx+1)/2 - 1
+                work(2*i+1) = ar(nx+1-i)
+             ENDDO
+             work(1) = 0.0
+             work(nx+2) = 0.0
+
+             CALL ZDFFT( -1, nx+1, sqr_nx, work, work, trig_xb, work2, 0 )
+
+             ar(0:nx) = work(0:nx)
+
+          ENDIF
+#else
+          PRINT*, '+++ fft_x: no system-specific fft-call available'
+          CALL local_stop
+#endif
+       ELSE
+
+          PRINT*, '+++ fft_x: fft method "', fft_method, '" not available'
+          CALL local_stop
+
+       ENDIF
+
+    END SUBROUTINE fft_x
+
+    SUBROUTINE fft_y( ar, direction )
+
+!----------------------------------------------------------------------!
+!                                 fft_y                                !
+!                                                                      !
+!               Fourier-transformation along y-direction               !
+!                                                                      !
+!      fft_y uses internal algorithms (Singleton or Temperton) or      !
+!           system-specific routines, if they are available            !
+!----------------------------------------------------------------------!
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  direction
+       INTEGER ::  j, jshape(1)
+
+!kk    REAL, DIMENSION(:)        ::  ar !kk Does NOT work (Bug??)
+       REAL, DIMENSION(0:ny)     ::  ar
+       REAL, DIMENSION(0:ny+2)   ::  work
+       REAL, DIMENSION(ny+2)     ::  work1
+       COMPLEX, DIMENSION(:), ALLOCATABLE ::  cwork
+#if defined( __ibm )
+       REAL, DIMENSION(nau2)     ::  auy2, auy4
+#elif defined( __nec )
+       REAL, DIMENSION(6*(ny+1)) ::  work2
+#endif
+
+       IF ( fft_method == 'singleton-algorithm' )  THEN
+
+!
+!--       Performing the fft with singleton's software works on every system,
+!--       since it is part of the model
+          ALLOCATE( cwork(0:ny) )
+
+          IF ( direction == 'forward')  THEN
+
+             DO  j = 0, ny
+                cwork(j) = CMPLX( ar(j) )
+             ENDDO
+
+             jshape = SHAPE( cwork )
+             CALL FFTN( cwork, jshape )
+
+             DO  j = 0, (ny+1)/2
+                ar(j) = REAL( cwork(j) )
+             ENDDO
+             DO  j = 1, (ny+1)/2 - 1
+                ar(ny+1-j) = -AIMAG( cwork(j) )
+             ENDDO
+
+          ELSE
+
+             cwork(0) = CMPLX( ar(0), 0.0 )
+             DO  j = 1, (ny+1)/2 - 1
+                cwork(j)      = CMPLX( ar(j), -ar(ny+1-j) )
+                cwork(ny+1-j) = CMPLX( ar(j),  ar(ny+1-j) )
+             ENDDO
+             cwork((ny+1)/2) = CMPLX( ar((ny+1)/2), 0.0 )
+
+             jshape = SHAPE( cwork )
+             CALL FFTN( cwork, jshape, inv = .TRUE. )
+
+             DO  j = 0, ny
+                ar(j) = REAL( cwork(j) )
+             ENDDO
+
+          ENDIF
+
+          DEALLOCATE( cwork )
+
+       ELSEIF ( fft_method == 'temperton-algorithm' )  THEN
+
+!
+!--       Performing the fft with Temperton's software works on every system,
+!--       since it is part of the model
+          IF ( direction == 'forward' )  THEN
+
+             work(0:ny) = ar
+             CALL fft991cy( work, work1, trigs_y, ifax_y, 1, ny+1, ny+1, 1, -1 )
+
+             DO  j = 0, (ny+1)/2
+                ar(j) = work(2*j)
+             ENDDO
+             DO  j = 1, (ny+1)/2 - 1
+                ar(ny+1-j) = work(2*j+1)
+             ENDDO
+
+          ELSE
+
+             DO  j = 0, (ny+1)/2
+                work(2*j) = ar(j)
+             ENDDO
+             DO  j = 1, (ny+1)/2 - 1
+                work(2*j+1) = ar(ny+1-j)
+             ENDDO
+             work(1)    = 0.0
+             work(ny+2) = 0.0
+
+             CALL fft991cy( work, work1, trigs_y, ifax_y, 1, ny+1, ny+1, 1, 1 )
+             ar = work(0:ny)
+
+          ENDIF
+
+       ELSEIF ( fft_method == 'system-specific' )  THEN
+
+#if defined( __ibm )  &&  ! defined( __ibmy_special )
+          IF ( direction == 'forward')  THEN
+
+             CALL DRCFT( 0, ar, 1, work, 1, ny+1, 1, 1, sqr_ny, auy1, nau1, &
+                         auy2, nau2 )
+
+             DO  j = 0, (ny+1)/2
+                ar(j) = work(2*j)
+             ENDDO
+             DO  j = 1, (ny+1)/2 - 1
+                ar(ny+1-j) = work(2*j+1)
+             ENDDO
+
+          ELSE
+
+             DO  j = 0, (ny+1)/2
+                work(2*j) = ar(j)
+             ENDDO
+             DO  j = 1, (ny+1)/2 - 1
+                work(2*j+1) = ar(ny+1-j)
+             ENDDO
+             work(1)    = 0.0
+             work(ny+2) = 0.0
+
+             CALL DCRFT( 0, work, 1, work, 1, ny+1, 1, -1, sqr_ny, auy3, nau1, &
+                         auy4, nau2 )
+
+             DO  j = 0, ny
+                ar(j) = work(j)
+             ENDDO
+
+          ENDIF
+#elif defined( __nec )
+          IF ( direction == 'forward' )  THEN
+
+             work(0:ny) = ar(0:ny)
+
+             CALL DZFFT( 1, ny+1, sqr_ny, work, work, trig_yf, work2, 0 )
+
+             DO  j = 0, (ny+1)/2
+                ar(j) = work(2*j)
+             ENDDO
+             DO  j = 1, (ny+1)/2 - 1
+                ar(ny+1-j) = work(2*j+1)
+             ENDDO
+
+          ELSE
+
+             DO  j = 0, (ny+1)/2
+                work(2*j) = ar(j)
+             ENDDO
+             DO  j = 1, (ny+1)/2 - 1
+                work(2*j+1) = ar(ny+1-j)
+             ENDDO
+             work(1) = 0.0
+             work(ny+2) = 0.0
+
+             CALL ZDFFT( -1, ny+1, sqr_ny, work, work, trig_yb, work2, 0 )
+
+             ar(0:ny) = work(0:ny)
+
+          ENDIF
+#else
+          PRINT*, '+++ fft_y: no system-specific fft-call available'
+          CALL local_stop
+#endif
+
+       ELSE
+
+          PRINT*, '+++ fft_y: fft method "', fft_method, '" not available'
+          CALL local_stop
+
+       ENDIF
+
+    END SUBROUTINE fft_y
+
+    SUBROUTINE fft_x_m( ar, direction )
+
+!----------------------------------------------------------------------!
+!                               fft_x_m                                !
+!                                                                      !
+!               Fourier-transformation along x-direction               !
+!                 Version for 1d domain decomposition                  !
+!             using multiple 1D FFT from Math Keisan on NEC            !
+!                       or Temperton-algorithm                         !
+!       (no singleton-algorithm on NEC because it does not vectorize)  !
+!                                                                      !
+!----------------------------------------------------------------------!
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*)              ::  direction
+       INTEGER                        ::  i, k, siza, sizw
+
+       REAL, DIMENSION(0:nx,nz)       ::  ar
+       REAL, DIMENSION(0:nx+3,nz+1)   ::  ai
+       REAL, DIMENSION(6*(nx+4),nz+1) ::  work1
+#if defined( __nec )
+       COMPLEX, DIMENSION((nx+4)/2+1,nz+1) ::  work
+#endif
+
+       IF ( fft_method == 'temperton-algorithm' )  THEN
+
+          siza = SIZE( ai, 1 )
+
+          IF ( direction == 'forward')  THEN
+
+             ai(0:nx,1:nz) = ar(0:nx,1:nz)
+             ai(nx+1:,:)   = 0.0
+
+             CALL fft991cy( ai, work1, trigs_x, ifax_x, 1, siza, nx+1, nz, -1 )
+
+             DO  k = 1, nz
+                DO  i = 0, (nx+1)/2
+                   ar(i,k) = ai(2*i,k)
+                ENDDO
+                DO  i = 1, (nx+1)/2 - 1
+                   ar(nx+1-i,k) = ai(2*i+1,k)
+                ENDDO
+             ENDDO
+
+          ELSE
+
+             DO  k = 1, nz
+                DO  i = 0, (nx+1)/2
+                   ai(2*i,k) = ar(i,k)
+                ENDDO
+                DO  i = 1, (nx+1)/2 - 1
+                   ai(2*i+1,k) = ar(nx+1-i,k)
+                ENDDO
+                ai(1,k) = 0.0
+                ai(nx+2,k) = 0.0
+             ENDDO
+
+             CALL fft991cy( ai, work1, trigs_x, ifax_x, 1, siza, nx+1, nz, 1 )
+
+             ar(0:nx,1:nz) = ai(0:nx,1:nz)
+
+          ENDIF
+
+       ELSEIF ( fft_method == 'system-specific' )  THEN
+
+#if defined( __nec )
+          siza = SIZE( ai, 1 )
+          sizw = SIZE( work, 1 )
+
+          IF ( direction == 'forward')  THEN
+
+!
+!--          Tables are initialized once more. This call should not be
+!--          necessary, but otherwise program aborts in asymmetric case
+             CALL DZFFTM( 0, nx+1, nz1, sqr_nx, work, nx+4, work, nx+4, &
+                          trig_xf, work1, 0 )
+
+             ai(0:nx,1:nz) = ar(0:nx,1:nz)
+             IF ( nz1 > nz )  THEN
+                ai(:,nz1) = 0.0
+             ENDIF
+
+             CALL DZFFTM( 1, nx+1, nz1, sqr_nx, ai, siza, work, sizw, &
+                          trig_xf, work1, 0 )
+
+             DO  k = 1, nz
+                DO  i = 0, (nx+1)/2
+                   ar(i,k) = REAL( work(i+1,k) )
+                ENDDO
+                DO  i = 1, (nx+1)/2 - 1
+                   ar(nx+1-i,k) = AIMAG( work(i+1,k) )
+                ENDDO
+             ENDDO
+
+          ELSE
+
+!
+!--          Tables are initialized once more. This call should not be
+!--          necessary, but otherwise program aborts in asymmetric case
+             CALL ZDFFTM( 0, nx+1, nz1, sqr_nx, work, nx+4, work, nx+4, &
+                          trig_xb, work1, 0 )
+
+             IF ( nz1 > nz )  THEN
+                work(:,nz1) = 0.0
+             ENDIF
+             DO  k = 1, nz
+                work(1,k) = CMPLX( ar(0,k), 0.0 )
+                DO  i = 1, (nx+1)/2 - 1
+                   work(i+1,k) = CMPLX( ar(i,k), ar(nx+1-i,k) )
+                ENDDO
+                work(((nx+1)/2)+1,k) = CMPLX( ar((nx+1)/2,k), 0.0 )
+             ENDDO
+
+             CALL ZDFFTM( -1, nx+1, nz1, sqr_nx, work, sizw, ai, siza, &
+                          trig_xb, work1, 0 )
+
+             ar(0:nx,1:nz) = ai(0:nx,1:nz)
+
+          ENDIF
+
+#else
+          PRINT*, '+++ fft_x_m: no system-specific fft-call available'
+          STOP
+#endif
+
+       ELSE
+
+          PRINT*, '+++ fft_x_m: fft method "', fft_method, '" not available'
+          CALL local_stop
+
+       ENDIF
+
+    END SUBROUTINE fft_x_m
+
+    SUBROUTINE fft_y_m( ar, ny1, direction )
+
+!----------------------------------------------------------------------!
+!                               fft_y_m                                !
+!                                                                      !
+!               Fourier-transformation along y-direction               !
+!                 Version for 1d domain decomposition                  !
+!             using multiple 1D FFT from Math Keisan on NEC            !
+!                       or Temperton-algorithm                         !
+!       (no singleton-algorithm on NEC because it does not vectorize)  !
+!                                                                      !
+!----------------------------------------------------------------------!
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*)              ::  direction
+       INTEGER                        ::  j, k, ny1, siza, sizw
+
+       REAL, DIMENSION(0:ny1,nz)      ::  ar
+       REAL, DIMENSION(0:ny+3,nz+1)   ::  ai
+       REAL, DIMENSION(6*(ny+4),nz+1) ::  work1
+#if defined( __nec )
+       COMPLEX, DIMENSION((ny+4)/2+1,nz+1) ::  work
+#endif
+
+       IF ( fft_method == 'temperton-algorithm' )  THEN
+
+          siza = SIZE( ai, 1 )
+
+          IF ( direction == 'forward')  THEN
+
+             ai(0:ny,1:nz) = ar(0:ny,1:nz)
+             ai(ny+1:,:)   = 0.0
+
+             CALL fft991cy( ai, work1, trigs_y, ifax_y, 1, siza, ny+1, nz, -1 )
+
+             DO  k = 1, nz
+                DO  j = 0, (ny+1)/2
+                   ar(j,k) = ai(2*j,k)
+                ENDDO
+                DO  j = 1, (ny+1)/2 - 1
+                   ar(ny+1-j,k) = ai(2*j+1,k)
+                ENDDO
+             ENDDO
+
+          ELSE
+
+             DO  k = 1, nz
+                DO  j = 0, (ny+1)/2
+                   ai(2*j,k) = ar(j,k)
+                ENDDO
+                DO  j = 1, (ny+1)/2 - 1
+                   ai(2*j+1,k) = ar(ny+1-j,k)
+                ENDDO
+                ai(1,k) = 0.0
+                ai(ny+2,k) = 0.0
+             ENDDO
+
+             CALL fft991cy( ai, work1, trigs_y, ifax_y, 1, siza, ny+1, nz, 1 )
+
+             ar(0:ny,1:nz) = ai(0:ny,1:nz)
+
+          ENDIF
+
+       ELSEIF ( fft_method == 'system-specific' )  THEN
+
+#if defined( __nec )
+          siza = SIZE( ai, 1 )
+          sizw = SIZE( work, 1 )
+
+          IF ( direction == 'forward')  THEN
+
+!
+!--          Tables are initialized once more. This call should not be
+!--          necessary, but otherwise program aborts in asymmetric case
+             CALL DZFFTM( 0, ny+1, nz1, sqr_ny, work, ny+4, work, ny+4, &
+                          trig_yf, work1, 0 )
+
+             ai(0:ny,1:nz) = ar(0:ny,1:nz)
+             IF ( nz1 > nz )  THEN
+                ai(:,nz1) = 0.0
+             ENDIF
+
+             CALL DZFFTM( 1, ny+1, nz1, sqr_ny, ai, siza, work, sizw, &
+                          trig_yf, work1, 0 )
+
+             DO  k = 1, nz
+                DO  j = 0, (ny+1)/2
+                   ar(j,k) = REAL( work(j+1,k) )
+                ENDDO
+                DO  j = 1, (ny+1)/2 - 1
+                   ar(ny+1-j,k) = AIMAG( work(j+1,k) )
+                ENDDO
+             ENDDO
+
+          ELSE
+
+!
+!--          Tables are initialized once more. This call should not be
+!--          necessary, but otherwise program aborts in asymmetric case
+             CALL ZDFFTM( 0, ny+1, nz1, sqr_ny, work, ny+4, work, ny+4, &
+                          trig_yb, work1, 0 )
+
+             IF ( nz1 > nz )  THEN
+                work(:,nz1) = 0.0
+             ENDIF
+             DO  k = 1, nz
+                work(1,k) = CMPLX( ar(0,k), 0.0 )
+                DO  j = 1, (ny+1)/2 - 1
+                   work(j+1,k) = CMPLX( ar(j,k), ar(ny+1-j,k) )
+                ENDDO
+                work(((ny+1)/2)+1,k) = CMPLX( ar((ny+1)/2,k), 0.0 )
+             ENDDO
+
+             CALL ZDFFTM( -1, ny+1, nz1, sqr_ny, work, sizw, ai, siza, &
+                          trig_yb, work1, 0 )
+
+             ar(0:ny,1:nz) = ai(0:ny,1:nz)
+
+          ENDIF
+
+#else
+          PRINT*, '+++ fft_y_m: no system-specific fft-call available'
+          STOP
+#endif
+
+       ELSE
+
+          PRINT*, '+++ fft_y_m: fft method "', fft_method, '" not available'
+          CALL local_stop
+
+       ENDIF
+
+    END SUBROUTINE fft_y_m
+
+ END MODULE fft_xy
Index: palm/trunk/SOURCE/fft_xy_mod.f90
===================================================================
--- palm/trunk/SOURCE/fft_xy_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,1785 +1,0 @@
-!> @file fft_xy_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! preprocessor branch for ibm removed
-!
-! 4646 2020-08-24 16:02:40Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4370 2020-01-10 14:00:44Z raasch
-! bugfix for Temperton-fft usage on GPU
-!
-! 4366 2020-01-09 08:12:43Z raasch
-! Vectorized Temperton-fft added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Code added to avoid compiler warnings
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! OpenACC port for SPEC
-!
-! Revision 1.1  2002/06/11 13:00:49  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Fast Fourier transformation along x and y for 1d domain decomposition along x.
-!> Original version: Klaus Ketelsen (May 2002)
-!> @todo openmp support for vectorized Temperton fft
-!------------------------------------------------------------------------------!
- MODULE fft_xy
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  fft_method, loop_optimization, message_string
-
-    USE cuda_fft_interfaces
-
-    USE indices,                                                                                   &
-        ONLY:  nx, ny, nz
-
-#if defined( __cuda_fft )
-    USE ISO_C_BINDING
-#elif defined( __fftw )
-    USE, INTRINSIC ::  ISO_C_BINDING
-#endif
-
-    USE kinds
-
-    USE singleton,                                                                                 &
-        ONLY: fftn
-
-    USE temperton_fft
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_y, nxr_y, nyn_x, nys_x, nzb_x, nzb_y, nzt_x, nzt_y
-
-    IMPLICIT NONE
-
-    PRIVATE
-    PUBLIC fft_init, f_vec_x, fft_x, fft_x_1d, fft_x_m, fft_y, fft_y_1d, fft_y_m, temperton_fft_vec
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE, SAVE ::  ifax_x  !<
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE, SAVE ::  ifax_y  !<
-
-    LOGICAL, SAVE ::  init_fft = .FALSE.           !<
-    LOGICAL, SAVE ::  temperton_fft_vec = .FALSE.  !<
-
-    REAL(wp), SAVE ::  dnx      !<
-    REAL(wp), SAVE ::  dny      !<
-    REAL(wp), SAVE ::  sqr_dnx  !<
-    REAL(wp), SAVE ::  sqr_dny  !<
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trigs_x  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trigs_y  !<
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  f_vec_x
-
-#if defined( __nec_fft )
-    INTEGER(iwp), SAVE ::  nz1  !<
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trig_xb  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trig_xf  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trig_yb  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trig_yf  !<
-
-#elif defined( __cuda_fft )
-    INTEGER(C_INT), SAVE ::  plan_xf  !<
-    INTEGER(C_INT), SAVE ::  plan_xi  !<
-    INTEGER(C_INT), SAVE ::  plan_yf  !<
-    INTEGER(C_INT), SAVE ::  plan_yi  !<
-
-#endif
-
-#if defined( __fftw )
-    INCLUDE  'fftw3.f03'
-    COMPLEX(KIND=C_DOUBLE_COMPLEX), DIMENSION(:), ALLOCATABLE, SAVE ::  x_out  !<
-    COMPLEX(KIND=C_DOUBLE_COMPLEX), DIMENSION(:), ALLOCATABLE, SAVE ::  y_out  !<
-
-    INTEGER(KIND=C_INT) ::  nx_c  !<
-    INTEGER(KIND=C_INT) ::  ny_c  !<
-
-    REAL(KIND=C_DOUBLE), DIMENSION(:), ALLOCATABLE, SAVE ::  x_in   !<
-    REAL(KIND=C_DOUBLE), DIMENSION(:), ALLOCATABLE, SAVE ::  y_in   !<
-    !$OMP THREADPRIVATE( x_out, y_out, x_in, y_in )
-
-
-    TYPE(C_PTR), SAVE ::  plan_xf, plan_xi, plan_yf, plan_yi
-#endif
-
-!
-!-- Public interfaces
-    INTERFACE fft_init
-       MODULE PROCEDURE fft_init
-    END INTERFACE fft_init
-
-    INTERFACE fft_x
-       MODULE PROCEDURE fft_x
-    END INTERFACE fft_x
-
-    INTERFACE fft_x_1d
-       MODULE PROCEDURE fft_x_1d
-    END INTERFACE fft_x_1d
-
-    INTERFACE fft_y
-       MODULE PROCEDURE fft_y
-    END INTERFACE fft_y
-
-    INTERFACE fft_y_1d
-       MODULE PROCEDURE fft_y_1d
-    END INTERFACE fft_y_1d
-
-    INTERFACE fft_x_m
-       MODULE PROCEDURE fft_x_m
-    END INTERFACE fft_x_m
-
-    INTERFACE fft_y_m
-       MODULE PROCEDURE fft_y_m
-    END INTERFACE fft_y_m
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE fft_init
-
-       USE pegrid,                                                                                 &
-           ONLY:  pdims
-
-       IMPLICIT NONE
-
-!
-!--    The following temporary working arrays have to be on stack or private
-!--    in OpenMP sense
-#if defined( __nec_fft )
-       REAL(wp), DIMENSION(0:nx+3,nz+1)   ::  work_x  !<
-       REAL(wp), DIMENSION(0:ny+3,nz+1)   ::  work_y  !<
-       REAL(wp), DIMENSION(6*(nx+3),nz+1) ::  workx   !<
-       REAL(wp), DIMENSION(6*(ny+3),nz+1) ::  worky   !<
-#endif
-
-!
-!--    Return, if already called
-       IF ( init_fft )  THEN
-          RETURN
-       ELSE
-          init_fft = .TRUE.
-       ENDIF
-
-#if defined( _OPENACC ) && defined( __cuda_fft )
-       fft_method = 'system-specific'
-#endif
-
-!
-!--    Switch to tell the Poisson-solver that the vectorized version of Temperton-fft is to be used.
-       IF ( fft_method == 'temperton-algorithm'  .AND.  loop_optimization == 'vector'  .AND.       &
-            pdims(1) /= 1  .AND.  pdims(2) /= 1 )  THEN
-          temperton_fft_vec = .TRUE.
-       ENDIF
-
-       IF ( fft_method == 'system-specific' )  THEN
-
-          dnx = 1.0_wp / ( nx + 1.0_wp )
-          dny = 1.0_wp / ( ny + 1.0_wp )
-          sqr_dnx = SQRT( dnx )
-          sqr_dny = SQRT( dny )
-
-#if defined( __nec_fft )
-          message_string = 'fft method "' // TRIM( fft_method) // '" currently does not work on NEC'
-          CALL message( 'fft_init', 'PA0187', 1, 2, 0, 6, 0 )
-
-          ALLOCATE( trig_xb(2*(nx+1)), trig_xf(2*(nx+1)), trig_yb(2*(ny+1)), trig_yf(2*(ny+1)) )
-
-          work_x = 0.0_wp
-          work_y = 0.0_wp
-          nz1  = nz + MOD( nz+1, 2 )  ! odd nz slows down fft significantly
-                                      ! when using the NEC ffts
-
-!
-!--       Initialize tables for fft along x (non-vector and vector case (M))
-          CALL DZFFT( 0, nx+1, sqr_dnx, work_x, work_x, trig_xf, workx, 0 )
-          CALL ZDFFT( 0, nx+1, sqr_dnx, work_x, work_x, trig_xb, workx, 0 )
-          CALL DZFFTM( 0, nx+1, nz1, sqr_dnx, work_x, nx+4, work_x, nx+4, trig_xf, workx, 0 )
-          CALL ZDFFTM( 0, nx+1, nz1, sqr_dnx, work_x, nx+4, work_x, nx+4, trig_xb, workx, 0 )
-!
-!--       Initialize tables for fft along y (non-vector and vector case (M))
-          CALL DZFFT( 0, ny+1, sqr_dny, work_y, work_y, trig_yf, worky, 0 )
-          CALL ZDFFT( 0, ny+1, sqr_dny, work_y, work_y, trig_yb, worky, 0 )
-          CALL DZFFTM( 0, ny+1, nz1, sqr_dny, work_y, ny+4, work_y, ny+4, trig_yf, worky, 0 )
-          CALL ZDFFTM( 0, ny+1, nz1, sqr_dny, work_y, ny+4, work_y, ny+4, trig_yb, worky, 0 )
-#elif defined( __cuda_fft )
-          CALL CUFFTPLAN1D( plan_xf, nx+1, CUFFT_D2Z, (nyn_x-nys_x+1) * (nzt_x-nzb_x+1) )
-          CALL CUFFTPLAN1D( plan_xi, nx+1, CUFFT_Z2D, (nyn_x-nys_x+1) * (nzt_x-nzb_x+1) )
-          CALL CUFFTPLAN1D( plan_yf, ny+1, CUFFT_D2Z, (nxr_y-nxl_y+1) * (nzt_y-nzb_y+1) )
-          CALL CUFFTPLAN1D( plan_yi, ny+1, CUFFT_Z2D, (nxr_y-nxl_y+1) * (nzt_y-nzb_y+1) )
-#else
-          message_string = 'no system-specific fft-call available'
-          CALL message( 'fft_init', 'PA0188', 1, 2, 0, 6, 0 )
-#endif
-       ELSEIF ( fft_method == 'temperton-algorithm' )  THEN
-!
-!--       Temperton-algorithm
-!--       Initialize tables for fft along x and y
-          ALLOCATE( ifax_x(nx+1), ifax_y(ny+1), trigs_x(nx+1), trigs_y(ny+1) )
-
-          CALL set99( trigs_x, ifax_x, nx+1 )
-          CALL set99( trigs_y, ifax_y, ny+1 )
-
-          IF ( temperton_fft_vec )  THEN
-             ALLOCATE( f_vec_x((nyn_x-nys_x+1)*(nzt_x-nzb_x+1),0:nx+2) )
-          ENDIF
-
-
-
-       ELSEIF ( fft_method == 'fftw' )  THEN
-!
-!--       FFTW
-#if defined( __fftw )
-          nx_c = nx+1
-          ny_c = ny+1
-          !$OMP PARALLEL
-          ALLOCATE( x_in(0:nx+2), y_in(0:ny+2), x_out(0:(nx+1)/2), y_out(0:(ny+1)/2) )
-          !$OMP END PARALLEL
-          plan_xf = FFTW_PLAN_DFT_R2C_1D( nx_c, x_in, x_out, FFTW_ESTIMATE )
-          plan_xi = FFTW_PLAN_DFT_C2R_1D( nx_c, x_out, x_in, FFTW_ESTIMATE )
-          plan_yf = FFTW_PLAN_DFT_R2C_1D( ny_c, y_in, y_out, FFTW_ESTIMATE )
-          plan_yi = FFTW_PLAN_DFT_C2R_1D( ny_c, y_out, y_in, FFTW_ESTIMATE )
-#else
-          message_string = 'preprocessor switch for fftw is missing'
-          CALL message( 'fft_init', 'PA0080', 1, 2, 0, 6, 0 )
-#endif
-
-       ELSEIF ( fft_method == 'singleton-algorithm' )  THEN
-
-          CONTINUE
-
-       ELSE
-
-          message_string = 'fft method "' // TRIM( fft_method) // '" not available'
-          CALL message( 'fft_init', 'PA0189', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    END SUBROUTINE fft_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Fourier-transformation along x-direction.
-!> Version for 2D-decomposition.
-!> It uses internal algorithms (Singleton or Temperton) or system-specific routines, if they are
-!> available.
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE fft_x( ar, direction, ar_2d, ar_inv )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  direction  !<
-
-       COMPLEX(wp), DIMENSION(:), ALLOCATABLE ::  cwork  !<
-
-       INTEGER(iwp) ::  i          !<
-       INTEGER(iwp) ::  ishape(1)  !<
-       INTEGER(iwp) ::  j          !<
-       INTEGER(iwp) ::  k          !<
-       INTEGER(iwp) ::  mm         !<
-
-       LOGICAL ::  forward_fft !<
-
-       REAL(wp), DIMENSION(0:nx+2) ::  work   !<
-       REAL(wp), DIMENSION(nx+2)   ::  work1  !<
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE           ::  work_vec  !<
-       REAL(wp), DIMENSION(0:nx,nys_x:nyn_x), OPTIONAL ::  ar_2d     !<
-
-       REAL(wp), DIMENSION(0:nx,nys_x:nyn_x,nzb_x:nzt_x)           ::  ar       !<
-       REAL(wp), DIMENSION(nys_x:nyn_x,nzb_x:nzt_x,0:nx), OPTIONAL ::  ar_inv   !<
-
-#if defined( __nec_fft )
-       REAL(wp), DIMENSION(6*(nx+1)) ::  work2  !<
-#elif defined( __cuda_fft )
-       COMPLEX(dp), DIMENSION(0:(nx+1)/2,nys_x:nyn_x,nzb_x:nzt_x) ::  ar_tmp  !<
-       !$ACC DECLARE CREATE(ar_tmp)
-#endif
-
-!
-!--    To avoid compiler warning: Unused dummy argument âar_2dâ
-       IF ( PRESENT( ar_2d ) )  CONTINUE
-
-       IF ( direction == 'forward' )  THEN
-          forward_fft = .TRUE.
-       ELSE
-          forward_fft = .FALSE.
-       ENDIF
-
-       IF ( fft_method == 'singleton-algorithm' )  THEN
-
-!
-!--       Performing the fft with singleton's software works on every system, since it is part of
-!--       the model.
-          ALLOCATE( cwork(0:nx) )
-
-          IF ( forward_fft )  THEN
-
-             !$OMP PARALLEL PRIVATE ( cwork, i, ishape, j, k )
-             !$OMP DO
-             DO  k = nzb_x, nzt_x
-                DO  j = nys_x, nyn_x
-
-                   DO  i = 0, nx
-                      cwork(i) = CMPLX( ar(i,j,k), KIND=wp )
-                   ENDDO
-
-                   ishape = SHAPE( cwork )
-                   CALL FFTN( cwork, ishape )
-
-                   DO  i = 0, (nx+1)/2
-                      ar(i,j,k) = REAL( cwork(i), KIND=wp )
-                   ENDDO
-                   DO  i = 1, (nx+1)/2 - 1
-                      ar(nx+1-i,j,k) = -AIMAG( cwork(i) )
-                   ENDDO
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-          ELSE
-
-             !$OMP PARALLEL PRIVATE ( cwork, i, ishape, j, k )
-             !$OMP DO
-             DO  k = nzb_x, nzt_x
-                DO  j = nys_x, nyn_x
-
-                   cwork(0) = CMPLX( ar(0,j,k), 0.0_wp, KIND=wp )
-                   DO  i = 1, (nx+1)/2 - 1
-                      cwork(i)      = CMPLX( ar(i,j,k), -ar(nx+1-i,j,k), KIND=wp )
-                      cwork(nx+1-i) = CMPLX( ar(i,j,k),  ar(nx+1-i,j,k), KIND=wp )
-                   ENDDO
-                   cwork((nx+1)/2) = CMPLX( ar((nx+1)/2,j,k), 0.0_wp, KIND=wp )
-
-                   ishape = SHAPE( cwork )
-                   CALL FFTN( cwork, ishape, inv = .TRUE. )
-
-                   DO  i = 0, nx
-                      ar(i,j,k) = REAL( cwork(i), KIND=wp )
-                   ENDDO
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-          ENDIF
-
-          DEALLOCATE( cwork )
-
-       ELSEIF ( fft_method == 'temperton-algorithm' )  THEN
-
-!
-!--       Performing the fft with Temperton's software works on every system, since it is part of
-!--       the model.
-          IF ( forward_fft )  THEN
-
-             IF ( .NOT. temperton_fft_vec )  THEN
-
-                !$OMP PARALLEL PRIVATE ( work, work1, i, j, k )
-                !$OMP DO
-                DO  k = nzb_x, nzt_x
-                   DO  j = nys_x, nyn_x
-
-                      work(0:nx) = ar(0:nx,j,k)
-                      CALL fft991cy( work, work1, trigs_x, ifax_x, 1, nx+1, nx+1, 1, -1 )
-
-                      DO  i = 0, (nx+1)/2
-                         ar(i,j,k) = work(2*i)
-                      ENDDO
-                      DO  i = 1, (nx+1)/2 - 1
-                         ar(nx+1-i,j,k) = work(2*i+1)
-                      ENDDO
-
-                   ENDDO
-                ENDDO
-                !$OMP END PARALLEL
-
-             ELSE
-
-!
-!--             Vector version of the Temperton-algorithm. Computes multiple 1-D FFT's.
-                ALLOCATE( work_vec( (nyn_x-nys_x+1)*(nzt_x-nzb_x+1),nx+2) )
-!
-!--             f_vec_x is already set in transpose_zx
-                CALL fft991cy_vec( f_vec_x, work_vec, trigs_x, ifax_x, nx+1, -1 )
-                DEALLOCATE( work_vec )
-
-                IF ( PRESENT( ar_inv ) )  THEN
-
-                   DO  k = nzb_x, nzt_x
-                      DO  j = nys_x, nyn_x
-                         mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1)
-                         DO  i = 0, (nx+1)/2
-                            ar_inv(j,k,i) = f_vec_x(mm,2*i)
-                         ENDDO
-                         DO  i = 1, (nx+1)/2-1
-                            ar_inv(j,k,nx+1-i) = f_vec_x(mm,2*i+1)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ELSE
-
-                   DO  k = nzb_x, nzt_x
-                      DO  j = nys_x, nyn_x
-                         mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1)
-                         DO  i = 0, (nx+1)/2
-                            ar(i,j,k) = f_vec_x(mm,2*i)
-                         ENDDO
-                         DO  i = 1, (nx+1)/2-1
-                            ar(nx+1-i,j,k) = f_vec_x(mm,2*i+1)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ENDIF
-
-             ENDIF
-
-          ELSE
-
-!
-!--          Backward fft
-             IF ( .NOT. temperton_fft_vec )  THEN
-
-                !$OMP PARALLEL PRIVATE ( work, work1, i, j, k )
-                !$OMP DO
-                DO  k = nzb_x, nzt_x
-                   DO  j = nys_x, nyn_x
-
-                      DO  i = 0, (nx+1)/2
-                         work(2*i) = ar(i,j,k)
-                      ENDDO
-                      DO  i = 1, (nx+1)/2 - 1
-                         work(2*i+1) = ar(nx+1-i,j,k)
-                      ENDDO
-                      work(1)    = 0.0_wp
-                      work(nx+2) = 0.0_wp
-
-                      CALL fft991cy( work, work1, trigs_x, ifax_x, 1, nx+1, nx+1, 1, 1 )
-                      ar(0:nx,j,k) = work(0:nx)
-
-                   ENDDO
-                ENDDO
-                !$OMP END PARALLEL
-
-             ELSE
-
-                IF ( PRESENT( ar_inv ) )  THEN
-
-                   DO  k = nzb_x, nzt_x
-                      DO  j = nys_x, nyn_x
-                         mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1)
-                         DO  i = 0, (nx+1)/2
-                            f_vec_x(mm,2*i) = ar_inv(j,k,i)
-                         ENDDO
-                         DO  i = 1, (nx+1)/2-1
-                            f_vec_x(mm,2*i+1) = ar_inv(j,k,nx+1-i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ELSE
-
-                   DO  k = nzb_x, nzt_x
-                      DO  j = nys_x, nyn_x
-                         mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1)
-                         DO  i = 0, (nx+1)/2
-                            f_vec_x(mm,2*i) = ar(i,j,k)
-                         ENDDO
-                         DO  i = 1, (nx+1)/2-1
-                            f_vec_x(mm,2*i+1) = ar(nx+1-i,j,k)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ENDIF
-                f_vec_x(:,1)    = 0.0_wp
-                f_vec_x(:,nx+2) = 0.0_wp
-
-                ALLOCATE( work_vec((nyn_x-nys_x+1)*(nzt_x-nzb_x+1),nx+2) )
-                CALL fft991cy_vec( f_vec_x, work_vec, trigs_x, ifax_x, nx+1, 1 )
-                DEALLOCATE( work_vec )
-
-             ENDIF
-
-          ENDIF
-
-       ELSEIF ( fft_method == 'fftw' )  THEN
-
-#if defined( __fftw )
-          IF ( forward_fft )  THEN
-
-             !$OMP PARALLEL PRIVATE ( work, i, j, k )
-             !$OMP DO
-             DO  k = nzb_x, nzt_x
-                DO  j = nys_x, nyn_x
-
-                   x_in(0:nx) = ar(0:nx,j,k)
-                   CALL FFTW_EXECUTE_DFT_R2C( plan_xf, x_in, x_out )
-
-                   IF ( PRESENT( ar_2d ) )  THEN
-
-                      DO  i = 0, (nx+1)/2
-                         ar_2d(i,j) = REAL( x_out(i), KIND=wp ) / ( nx+1 )
-                      ENDDO
-                      DO  i = 1, (nx+1)/2 - 1
-                         ar_2d(nx+1-i,j) = AIMAG( x_out(i) ) / ( nx+1 )
-                      ENDDO
-
-                   ELSE
-
-                      DO  i = 0, (nx+1)/2
-                         ar(i,j,k) = REAL( x_out(i), KIND=wp ) / ( nx+1 )
-                      ENDDO
-                      DO  i = 1, (nx+1)/2 - 1
-                         ar(nx+1-i,j,k) = AIMAG( x_out(i) ) / ( nx+1 )
-                      ENDDO
-
-                   ENDIF
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-          ELSE
-             !$OMP PARALLEL PRIVATE ( work, i, j, k )
-             !$OMP DO
-             DO  k = nzb_x, nzt_x
-                DO  j = nys_x, nyn_x
-
-                   IF ( PRESENT( ar_2d ) )  THEN
-
-                      x_out(0) = CMPLX( ar_2d(0,j), 0.0_wp, KIND=wp )
-                      DO  i = 1, (nx+1)/2 - 1
-                         x_out(i) = CMPLX( ar_2d(i,j), ar_2d(nx+1-i,j), KIND=wp )
-                      ENDDO
-                      x_out((nx+1)/2) = CMPLX( ar_2d((nx+1)/2,j), 0.0_wp, KIND=wp )
-
-                   ELSE
-
-                      x_out(0) = CMPLX( ar(0,j,k), 0.0_wp, KIND=wp )
-                      DO  i = 1, (nx+1)/2 - 1
-                         x_out(i) = CMPLX( ar(i,j,k), ar(nx+1-i,j,k), KIND=wp )
-                      ENDDO
-                      x_out((nx+1)/2) = CMPLX( ar((nx+1)/2,j,k), 0.0_wp, KIND=wp )
-
-                   ENDIF
-
-                   CALL FFTW_EXECUTE_DFT_C2R( plan_xi, x_out, x_in)
-                   ar(0:nx,j,k) = x_in(0:nx)
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-          ENDIF
-#endif
-
-       ELSEIF ( fft_method == 'system-specific' )  THEN
-
-#if defined( __nec_fft )
-
-          IF ( forward_fft )  THEN
-
-             !$OMP PARALLEL PRIVATE ( work, i, j, k )
-             !$OMP DO
-             DO  k = nzb_x, nzt_x
-                DO  j = nys_x, nyn_x
-
-                   work(0:nx) = ar(0:nx,j,k)
-
-                   CALL DZFFT( 1, nx+1, sqr_dnx, work, work, trig_xf, work2, 0 )
-
-                   DO  i = 0, (nx+1)/2
-                      ar(i,j,k) = work(2*i)
-                   ENDDO
-                   DO  i = 1, (nx+1)/2 - 1
-                      ar(nx+1-i,j,k) = work(2*i+1)
-                   ENDDO
-
-                ENDDO
-             ENDDO
-             !$END OMP PARALLEL
-
-          ELSE
-
-             !$OMP PARALLEL PRIVATE ( work, i, j, k )
-             !$OMP DO
-             DO  k = nzb_x, nzt_x
-                DO  j = nys_x, nyn_x
-
-                   DO  i = 0, (nx+1)/2
-                      work(2*i) = ar(i,j,k)
-                   ENDDO
-                   DO  i = 1, (nx+1)/2 - 1
-                      work(2*i+1) = ar(nx+1-i,j,k)
-                   ENDDO
-                   work(1) = 0.0_wp
-                   work(nx+2) = 0.0_wp
-
-                   CALL ZDFFT( -1, nx+1, sqr_dnx, work, work, trig_xb, work2, 0 )
-
-                   ar(0:nx,j,k) = work(0:nx)
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-          ENDIF
-
-#elif defined( __cuda_fft )
-
-          IF ( forward_fft )  THEN
-
-             !$ACC HOST_DATA USE_DEVICE(ar, ar_tmp)
-             CALL CUFFTEXECD2Z( plan_xf, ar, ar_tmp )
-             !$ACC END HOST_DATA
-
-             !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i,j,k) &
-             !$ACC PRESENT(ar, ar_tmp)
-             DO  k = nzb_x, nzt_x
-                DO  j = nys_x, nyn_x
-
-                   DO  i = 0, (nx+1)/2
-                      ar(i,j,k)      = REAL( ar_tmp(i,j,k), KIND=wp )  * dnx
-                   ENDDO
-
-                   DO  i = 1, (nx+1)/2 - 1
-                      ar(nx+1-i,j,k) = AIMAG( ar_tmp(i,j,k) ) * dnx
-                   ENDDO
-
-                ENDDO
-             ENDDO
-
-          ELSE
-
-             !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i,j,k) &
-             !$ACC PRESENT(ar, ar_tmp)
-             DO  k = nzb_x, nzt_x
-                DO  j = nys_x, nyn_x
-
-                   ar_tmp(0,j,k) = CMPLX( ar(0,j,k), 0.0_wp, KIND=wp )
-
-                   DO  i = 1, (nx+1)/2 - 1
-                      ar_tmp(i,j,k) = CMPLX( ar(i,j,k), ar(nx+1-i,j,k), KIND=wp )
-                   ENDDO
-                   ar_tmp((nx+1)/2,j,k) = CMPLX( ar((nx+1)/2,j,k), 0.0_wp, KIND=wp )
-
-                ENDDO
-             ENDDO
-
-             !$ACC HOST_DATA USE_DEVICE(ar, ar_tmp)
-             CALL CUFFTEXECZ2D( plan_xi, ar_tmp, ar )
-             !$ACC END HOST_DATA
-
-          ENDIF
-
-#endif
-
-       ENDIF
-
-    END SUBROUTINE fft_x
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Fourier-transformation along x-direction.
-!> Version for 1D-decomposition.
-!> It uses internal algorithms (Singleton or Temperton) or system-specific routines, if they are
-!> available.
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE fft_x_1d( ar, direction )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  direction  !<
-
-       INTEGER(iwp) ::  i               !<
-       INTEGER(iwp) ::  ishape(1)       !<
-
-       LOGICAL ::  forward_fft          !<
-
-       REAL(wp), DIMENSION(0:nx)   ::  ar     !<
-       REAL(wp), DIMENSION(0:nx+2) ::  work   !<
-       REAL(wp), DIMENSION(nx+2)   ::  work1  !<
-
-       COMPLEX(wp), DIMENSION(:), ALLOCATABLE ::  cwork  !<
-
-#if defined( __nec_fft )
-       REAL(wp), DIMENSION(6*(nx+1)) ::  work2  !<
-#endif
-
-       IF ( direction == 'forward' )  THEN
-          forward_fft = .TRUE.
-       ELSE
-          forward_fft = .FALSE.
-       ENDIF
-
-       IF ( fft_method == 'singleton-algorithm' )  THEN
-
-!
-!--       Performing the fft with singleton's software works on every system, since it is part of
-!--       the model.
-          ALLOCATE( cwork(0:nx) )
-
-          IF ( forward_fft )  THEN
-
-             DO  i = 0, nx
-                cwork(i) = CMPLX( ar(i), KIND=wp )
-             ENDDO
-             ishape = SHAPE( cwork )
-             CALL FFTN( cwork, ishape )
-             DO  i = 0, (nx+1)/2
-                ar(i) = REAL( cwork(i), KIND=wp )
-             ENDDO
-             DO  i = 1, (nx+1)/2 - 1
-                ar(nx+1-i) = -AIMAG( cwork(i) )
-             ENDDO
-
-          ELSE
-
-             cwork(0) = CMPLX( ar(0), 0.0_wp, KIND=wp )
-             DO  i = 1, (nx+1)/2 - 1
-                cwork(i)      = CMPLX( ar(i), -ar(nx+1-i), KIND=wp )
-                cwork(nx+1-i) = CMPLX( ar(i),  ar(nx+1-i), KIND=wp )
-             ENDDO
-             cwork((nx+1)/2) = CMPLX( ar((nx+1)/2), 0.0_wp, KIND=wp )
-
-             ishape = SHAPE( cwork )
-             CALL FFTN( cwork, ishape, inv = .TRUE. )
-
-             DO  i = 0, nx
-                ar(i) = REAL( cwork(i), KIND=wp )
-             ENDDO
-
-          ENDIF
-
-          DEALLOCATE( cwork )
-
-       ELSEIF ( fft_method == 'temperton-algorithm' )  THEN
-
-!
-!--       Performing the fft with Temperton's software works on every system, since it is part of
-!--       the model.
-          IF ( forward_fft )  THEN
-
-             work(0:nx) = ar
-             CALL fft991cy( work, work1, trigs_x, ifax_x, 1, nx+1, nx+1, 1, -1 )
-
-             DO  i = 0, (nx+1)/2
-                ar(i) = work(2*i)
-             ENDDO
-             DO  i = 1, (nx+1)/2 - 1
-                ar(nx+1-i) = work(2*i+1)
-             ENDDO
-
-          ELSE
-
-             DO  i = 0, (nx+1)/2
-                work(2*i) = ar(i)
-             ENDDO
-             DO  i = 1, (nx+1)/2 - 1
-                work(2*i+1) = ar(nx+1-i)
-             ENDDO
-             work(1)    = 0.0_wp
-             work(nx+2) = 0.0_wp
-
-             CALL fft991cy( work, work1, trigs_x, ifax_x, 1, nx+1, nx+1, 1, 1 )
-             ar = work(0:nx)
-
-          ENDIF
-
-       ELSEIF ( fft_method == 'fftw' )  THEN
-
-#if defined( __fftw )
-          IF ( forward_fft )  THEN
-
-             x_in(0:nx) = ar(0:nx)
-             CALL FFTW_EXECUTE_DFT_R2C( plan_xf, x_in, x_out )
-
-             DO  i = 0, (nx+1)/2
-                ar(i) = REAL( x_out(i), KIND=wp ) / ( nx+1 )
-             ENDDO
-             DO  i = 1, (nx+1)/2 - 1
-                ar(nx+1-i) = AIMAG( x_out(i) ) / ( nx+1 )
-             ENDDO
-
-         ELSE
-
-             x_out(0) = CMPLX( ar(0), 0.0_wp, KIND=wp )
-             DO  i = 1, (nx+1)/2 - 1
-                x_out(i) = CMPLX( ar(i), ar(nx+1-i), KIND=wp )
-             ENDDO
-             x_out((nx+1)/2) = CMPLX( ar((nx+1)/2), 0.0_wp, KIND=wp )
-
-             CALL FFTW_EXECUTE_DFT_C2R( plan_xi, x_out, x_in)
-             ar(0:nx) = x_in(0:nx)
-
-         ENDIF
-#endif
-
-       ELSEIF ( fft_method == 'system-specific' )  THEN
-
-#if defined( __nec_fft )
-          IF ( forward_fft )  THEN
-
-             work(0:nx) = ar(0:nx)
-
-             CALL DZFFT( 1, nx+1, sqr_dnx, work, work, trig_xf, work2, 0 )
-
-             DO  i = 0, (nx+1)/2
-                ar(i) = work(2*i)
-             ENDDO
-             DO  i = 1, (nx+1)/2 - 1
-                ar(nx+1-i) = work(2*i+1)
-             ENDDO
-
-          ELSE
-
-             DO  i = 0, (nx+1)/2
-                work(2*i) = ar(i)
-             ENDDO
-             DO  i = 1, (nx+1)/2 - 1
-                work(2*i+1) = ar(nx+1-i)
-             ENDDO
-             work(1) = 0.0_wp
-             work(nx+2) = 0.0_wp
-
-             CALL ZDFFT( -1, nx+1, sqr_dnx, work, work, trig_xb, work2, 0 )
-
-             ar(0:nx) = work(0:nx)
-
-          ENDIF
-#endif
-
-       ENDIF
-
-    END SUBROUTINE fft_x_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Fourier-transformation along y-direction.
-!> Version for 2D-decomposition.
-!> It uses internal algorithms (Singleton or Temperton) or system-specific routines, if they are
-!> available.
-!>
-!> direction:  'forward' or 'backward'
-!> ar, ar_tr:  3D data arrays
-!>             forward:   ar: before  ar_tr: after transformation
-!>             backward:  ar_tr: before  ar: after transfosition
-!>
-!> In case of non-overlapping transposition/transformation:
-!> nxl_y_bound = nxl_y_l = nxl_y
-!> nxr_y_bound = nxr_y_l = nxr_y
-!>
-!> In case of overlapping transposition/transformation
-!> - nxl_y_bound  and  nxr_y_bound have the original values of nxl_y, nxr_y.  ar_tr is dimensioned
-!>   using these values.
-!> - nxl_y_l = nxr_y_r.  ar is dimensioned with these values, so that transformation is carried out
-!>   for a 2D-plane only.
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE fft_y( ar, direction, ar_tr, nxl_y_bound, nxr_y_bound, nxl_y_l, nxr_y_l, ar_inv )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  direction  !<
-
-       INTEGER(iwp) ::  i            !<
-       INTEGER(iwp) ::  j            !<
-       INTEGER(iwp) ::  jshape(1)    !<
-       INTEGER(iwp) ::  k            !<
-       INTEGER(iwp) ::  mm           !<
-       INTEGER(iwp) ::  nxl_y_bound  !<
-       INTEGER(iwp) ::  nxl_y_l      !<
-       INTEGER(iwp) ::  nxr_y_bound  !<
-       INTEGER(iwp) ::  nxr_y_l      !<
-
-       LOGICAL ::  forward_fft  !<
-
-       REAL(wp), DIMENSION(0:ny+2) ::  work   !<
-       REAL(wp), DIMENSION(ny+2)   ::  work1  !<
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  f_vec_y
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  work_vec
-
-       REAL(wp), DIMENSION(0:ny,nxl_y_l:nxr_y_l,nzb_y:nzt_y)                   ::  ar      !<
-       REAL(wp), DIMENSION(nxl_y:nxr_y,nzb_y:nzt_y,0:ny), OPTIONAL             ::  ar_inv  !<
-       REAL(wp), DIMENSION(0:ny,nxl_y_bound:nxr_y_bound,nzb_y:nzt_y), OPTIONAL ::  ar_tr   !<
-
-       COMPLEX(wp), DIMENSION(:), ALLOCATABLE ::  cwork  !<
-
-#if defined( __nec_fft )
-       REAL(wp), DIMENSION(6*(ny+1)) ::  work2  !<
-#elif defined( __cuda_fft )
-       COMPLEX(dp), DIMENSION(0:(ny+1)/2,nxl_y:nxr_y,nzb_y:nzt_y) ::  ar_tmp  !<
-       !$ACC DECLARE CREATE(ar_tmp)
-#endif
-
-
-       IF ( direction == 'forward' )  THEN
-          forward_fft = .TRUE.
-       ELSE
-          forward_fft = .FALSE.
-       ENDIF
-
-       IF ( fft_method == 'singleton-algorithm' )  THEN
-
-!
-!--       Performing the fft with singleton's software works on every system, since it is part of
-!--       the model.
-          ALLOCATE( cwork(0:ny) )
-
-          IF ( forward_fft )  THEN
-
-             !$OMP PARALLEL PRIVATE ( cwork, i, jshape, j, k )
-             !$OMP DO
-             DO  k = nzb_y, nzt_y
-                DO  i = nxl_y_l, nxr_y_l
-
-                   DO  j = 0, ny
-                      cwork(j) = CMPLX( ar(j,i,k), KIND=wp )
-                   ENDDO
-
-                   jshape = SHAPE( cwork )
-                   CALL FFTN( cwork, jshape )
-
-                   DO  j = 0, (ny+1)/2
-                      ar_tr(j,i,k) = REAL( cwork(j), KIND=wp )
-                   ENDDO
-                   DO  j = 1, (ny+1)/2 - 1
-                      ar_tr(ny+1-j,i,k) = -AIMAG( cwork(j) )
-                   ENDDO
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-          ELSE
-
-             !$OMP PARALLEL PRIVATE ( cwork, i, jshape, j, k )
-             !$OMP DO
-             DO  k = nzb_y, nzt_y
-                DO  i = nxl_y_l, nxr_y_l
-
-                   cwork(0) = CMPLX( ar_tr(0,i,k), 0.0_wp, KIND=wp )
-                   DO  j = 1, (ny+1)/2 - 1
-                      cwork(j)      = CMPLX( ar_tr(j,i,k), -ar_tr(ny+1-j,i,k), KIND=wp )
-                      cwork(ny+1-j) = CMPLX( ar_tr(j,i,k),  ar_tr(ny+1-j,i,k), KIND=wp )
-                   ENDDO
-                   cwork((ny+1)/2) = CMPLX( ar_tr((ny+1)/2,i,k), 0.0_wp, KIND=wp )
-
-                   jshape = SHAPE( cwork )
-                   CALL FFTN( cwork, jshape, inv = .TRUE. )
-
-                   DO  j = 0, ny
-                      ar(j,i,k) = REAL( cwork(j), KIND=wp )
-                   ENDDO
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-          ENDIF
-
-          DEALLOCATE( cwork )
-
-       ELSEIF ( fft_method == 'temperton-algorithm' )  THEN
-
-!
-!--       Performing the fft with Temperton's software works on every system, since it is part of
-!--       the model.
-          IF ( forward_fft )  THEN
-
-             IF ( .NOT. temperton_fft_vec )  THEN
-
-                !$OMP PARALLEL PRIVATE ( work, work1, i, j, k )
-                !$OMP DO
-                DO  k = nzb_y, nzt_y
-                   DO  i = nxl_y_l, nxr_y_l
-
-                      work(0:ny) = ar(0:ny,i,k)
-                      CALL fft991cy( work, work1, trigs_y, ifax_y, 1, ny+1, ny+1, 1, -1 )
-
-                      DO  j = 0, (ny+1)/2
-                         ar_tr(j,i,k) = work(2*j)
-                      ENDDO
-                      DO  j = 1, (ny+1)/2 - 1
-                         ar_tr(ny+1-j,i,k) = work(2*j+1)
-                      ENDDO
-
-                   ENDDO
-                ENDDO
-                !$OMP END PARALLEL
-
-             ELSE
-!
-!--             Vector version of Temperton-fft. Computes multiple 1-D FFT's.
-                ALLOCATE( f_vec_y((nxr_y_l-nxl_y_l+1)*(nzt_y-nzb_y+1),0:ny+2) )
-
-                mm = 1
-                DO  k = nzb_y, nzt_y
-                   DO  i = nxl_y_l, nxr_y_l
-                      f_vec_y(mm,0:nx) = ar(0:nx,i,k)
-                      mm = mm+1
-                   ENDDO
-                ENDDO
-
-                ALLOCATE( work_vec( (nxr_y_l-nxl_y_l+1)*(nzt_y-nzb_y+1),ny+2) )
-                CALL fft991cy_vec( f_vec_y, work_vec, trigs_y, ifax_y, ny+1, -1 )
-                DEALLOCATE( work_vec )
-
-                IF( PRESENT( ar_inv ) )  THEN
-
-                   DO  k = nzb_y, nzt_y
-                      DO  i = nxl_y_l, nxr_y_l
-                         mm = i-nxl_y_l+1+(k-nzb_y)*(nxr_y_l-nxl_y_l+1)
-                         DO  j = 0, (ny+1)/2
-                            ar_inv(i,k,j) = f_vec_y(mm,2*j)
-                         ENDDO
-                         DO  j = 1, (ny+1)/2 - 1
-                            ar_inv(i,k,ny+1-j) = f_vec_y(mm,2*j+1)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ELSE
-
-                   DO  k = nzb_y, nzt_y
-                      DO  i = nxl_y_l, nxr_y_l
-                         mm = i-nxl_y_l+1+(k-nzb_y)*(nxr_y_l-nxl_y_l+1)
-                         DO  j = 0, (ny+1)/2
-                            ar(j,i,k) = f_vec_y(mm,2*j)
-                         ENDDO
-                         DO  j = 1, (ny+1)/2 - 1
-                            ar(ny+1-j,i,k) = f_vec_y(mm,2*j+1)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ENDIF
-
-                DEALLOCATE( f_vec_y )
-
-             ENDIF
-
-          ELSE
-
-             IF ( .NOT. temperton_fft_vec )  THEN
-
-                !$OMP PARALLEL PRIVATE ( work, work1, i, j, k )
-                !$OMP DO
-                DO  k = nzb_y, nzt_y
-                   DO  i = nxl_y_l, nxr_y_l
-
-                      DO  j = 0, (ny+1)/2
-                         work(2*j) = ar_tr(j,i,k)
-                      ENDDO
-                      DO  j = 1, (ny+1)/2 - 1
-                         work(2*j+1) = ar_tr(ny+1-j,i,k)
-                      ENDDO
-                      work(1)    = 0.0_wp
-                      work(ny+2) = 0.0_wp
-
-                      CALL fft991cy( work, work1, trigs_y, ifax_y, 1, ny+1, ny+1, 1, 1 )
-                      ar(0:ny,i,k) = work(0:ny)
-
-                   ENDDO
-                ENDDO
-                !$OMP END PARALLEL
-
-             ELSE
-
-                ALLOCATE( f_vec_y((nxr_y_l-nxl_y_l+1)*(nzt_y-nzb_y+1),0:ny+2) )
-
-                IF ( PRESENT( ar_inv ) )  THEN
-
-                   DO  k = nzb_y, nzt_y
-                      DO  i = nxl_y_l, nxr_y_l
-                         mm = i-nxl_y_l+1+(k-nzb_y)*(nxr_y_l-nxl_y_l+1)
-                         DO  j = 0, (ny+1)/2
-                            f_vec_y(mm,2*j) = ar_inv(i,k,j)
-                         ENDDO
-                         DO  j = 1, (ny+1)/2 - 1
-                            f_vec_y(mm,2*j+1) = ar_inv(i,k,ny+1-j)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ELSE
-
-                   DO  k = nzb_y, nzt_y
-                      DO  i = nxl_y_l, nxr_y_l
-                         mm = i-nxl_y_l+1+(k-nzb_y)*(nxr_y_l-nxl_y_l+1)
-                         DO  j = 0, (ny+1)/2
-                            f_vec_y(mm,2*j) = ar(j,i,k)
-                         ENDDO
-                         DO  j = 1, (ny+1)/2 - 1
-                            f_vec_y(mm,2*j+1) = ar(ny+1-j,i,k)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ENDIF
-
-                f_vec_y(:,1)    = 0.0_wp
-                f_vec_y(:,ny+2) = 0.0_wp
-
-                ALLOCATE( work_vec((nxr_y_l-nxl_y_l+1)*(nzt_y-nzb_y+1),ny+2) )
-                CALL fft991cy_vec( f_vec_y, work_vec, trigs_y, ifax_y, ny+1, 1 )
-                DEALLOCATE( work_vec )
-
-                mm = 1
-                DO  k = nzb_y, nzt_y
-                   DO  i = nxl_y_l, nxr_y_l
-                      ar(0:ny,i,k) = f_vec_y(mm,0:ny)
-                      mm = mm+1
-                   ENDDO
-                ENDDO
-
-                DEALLOCATE( f_vec_y )
-
-             ENDIF
-
-          ENDIF
-
-       ELSEIF ( fft_method == 'fftw' )  THEN
-
-#if defined( __fftw )
-          IF ( forward_fft )  THEN
-
-             !$OMP PARALLEL PRIVATE ( work, i, j, k )
-             !$OMP DO
-             DO  k = nzb_y, nzt_y
-                DO  i = nxl_y_l, nxr_y_l
-
-                   y_in(0:ny) = ar(0:ny,i,k)
-                   CALL FFTW_EXECUTE_DFT_R2C( plan_yf, y_in, y_out )
-
-                   DO  j = 0, (ny+1)/2
-                      ar_tr(j,i,k) = REAL( y_out(j), KIND=wp ) / (ny+1)
-                   ENDDO
-                   DO  j = 1, (ny+1)/2 - 1
-                      ar_tr(ny+1-j,i,k) = AIMAG( y_out(j) ) / (ny+1)
-                   ENDDO
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-          ELSE
-
-             !$OMP PARALLEL PRIVATE ( work, i, j, k )
-             !$OMP DO
-             DO  k = nzb_y, nzt_y
-                DO  i = nxl_y_l, nxr_y_l
-
-                   y_out(0) = CMPLX( ar_tr(0,i,k), 0.0_wp, KIND=wp )
-                   DO  j = 1, (ny+1)/2 - 1
-                      y_out(j) = CMPLX( ar_tr(j,i,k), ar_tr(ny+1-j,i,k), KIND=wp )
-                   ENDDO
-                   y_out((ny+1)/2) = CMPLX( ar_tr((ny+1)/2,i,k), 0.0_wp, KIND=wp )
-
-                   CALL FFTW_EXECUTE_DFT_C2R( plan_yi, y_out, y_in )
-                   ar(0:ny,i,k) = y_in(0:ny)
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-          ENDIF
-#endif
-
-       ELSEIF ( fft_method == 'system-specific' )  THEN
-
-#if defined( __nec_fft )
-          IF ( forward_fft )  THEN
-
-             !$OMP PARALLEL PRIVATE ( work, i, j, k )
-             !$OMP DO
-             DO  k = nzb_y, nzt_y
-                DO  i = nxl_y_l, nxr_y_l
-
-                   work(0:ny) = ar(0:ny,i,k)
-
-                   CALL DZFFT( 1, ny+1, sqr_dny, work, work, trig_yf, work2, 0 )
-
-                   DO  j = 0, (ny+1)/2
-                      ar_tr(j,i,k) = work(2*j)
-                   ENDDO
-                   DO  j = 1, (ny+1)/2 - 1
-                      ar_tr(ny+1-j,i,k) = work(2*j+1)
-                   ENDDO
-
-                ENDDO
-             ENDDO
-             !$END OMP PARALLEL
-
-          ELSE
-
-             !$OMP PARALLEL PRIVATE ( work, i, j, k )
-             !$OMP DO
-             DO  k = nzb_y, nzt_y
-                DO  i = nxl_y_l, nxr_y_l
-
-                   DO  j = 0, (ny+1)/2
-                      work(2*j) = ar_tr(j,i,k)
-                   ENDDO
-                   DO  j = 1, (ny+1)/2 - 1
-                      work(2*j+1) = ar_tr(ny+1-j,i,k)
-                   ENDDO
-                   work(1) = 0.0_wp
-                   work(ny+2) = 0.0_wp
-
-                   CALL ZDFFT( -1, ny+1, sqr_dny, work, work, trig_yb, work2, 0 )
-
-                   ar(0:ny,i,k) = work(0:ny)
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-          ENDIF
-#elif defined( __cuda_fft )
-
-          IF ( forward_fft )  THEN
-
-             !$ACC HOST_DATA USE_DEVICE(ar, ar_tmp)
-             CALL CUFFTEXECD2Z( plan_yf, ar, ar_tmp )
-             !$ACC END HOST_DATA
-
-             !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i,j,k) &
-             !$ACC PRESENT(ar, ar_tmp)
-             DO  k = nzb_y, nzt_y
-                DO  i = nxl_y, nxr_y
-
-                   DO  j = 0, (ny+1)/2
-                      ar(j,i,k)      = REAL( ar_tmp(j,i,k), KIND=wp ) * dny
-                   ENDDO
-
-                   DO  j = 1, (ny+1)/2 - 1
-                      ar(ny+1-j,i,k) = AIMAG( ar_tmp(j,i,k) ) * dny
-                   ENDDO
-
-                ENDDO
-             ENDDO
-
-          ELSE
-
-             !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i,j,k) &
-             !$ACC PRESENT(ar, ar_tmp)
-             DO  k = nzb_y, nzt_y
-                DO  i = nxl_y, nxr_y
-
-                   ar_tmp(0,i,k) = CMPLX( ar(0,i,k), 0.0_wp, KIND=wp )
-
-                   DO  j = 1, (ny+1)/2 - 1
-                      ar_tmp(j,i,k) = CMPLX( ar(j,i,k), ar(ny+1-j,i,k), KIND=wp )
-                   ENDDO
-                   ar_tmp((ny+1)/2,i,k) = CMPLX( ar((ny+1)/2,i,k), 0.0_wp, KIND=wp )
-
-                ENDDO
-             ENDDO
-
-             !$ACC HOST_DATA USE_DEVICE(ar, ar_tmp)
-             CALL CUFFTEXECZ2D( plan_yi, ar_tmp, ar )
-             !$ACC END HOST_DATA
-
-          ENDIF
-
-#endif
-
-       ENDIF
-
-    END SUBROUTINE fft_y
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Fourier-transformation along y-direction.
-!> Version for 1D-decomposition.
-!> It uses internal algorithms (Singleton or Temperton) or system-specific routines, if they are
-!> available.
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE fft_y_1d( ar, direction )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  direction
-
-       INTEGER(iwp) ::  j          !<
-       INTEGER(iwp) ::  jshape(1)  !<
-
-       LOGICAL ::  forward_fft  !<
-
-       REAL(wp), DIMENSION(0:ny)    ::  ar     !<
-       REAL(wp), DIMENSION(0:ny+2)  ::  work   !<
-       REAL(wp), DIMENSION(ny+2)    ::  work1  !<
-
-       COMPLEX(wp), DIMENSION(:), ALLOCATABLE ::  cwork  !<
-
-#if defined( __nec_fft )
-       REAL(wp), DIMENSION(6*(ny+1)) ::  work2  !<
-#endif
-
-       IF ( direction == 'forward' )  THEN
-          forward_fft = .TRUE.
-       ELSE
-          forward_fft = .FALSE.
-       ENDIF
-
-       IF ( fft_method == 'singleton-algorithm' )  THEN
-
-!
-!--       Performing the fft with singleton's software works on every system, since it is part of
-!--       the model.
-          ALLOCATE( cwork(0:ny) )
-
-          IF ( forward_fft )  THEN
-
-             DO  j = 0, ny
-                cwork(j) = CMPLX( ar(j), KIND=wp )
-             ENDDO
-
-             jshape = SHAPE( cwork )
-             CALL FFTN( cwork, jshape )
-
-             DO  j = 0, (ny+1)/2
-                ar(j) = REAL( cwork(j), KIND=wp )
-             ENDDO
-             DO  j = 1, (ny+1)/2 - 1
-                ar(ny+1-j) = -AIMAG( cwork(j) )
-             ENDDO
-
-          ELSE
-
-             cwork(0) = CMPLX( ar(0), 0.0_wp, KIND=wp )
-             DO  j = 1, (ny+1)/2 - 1
-                cwork(j)      = CMPLX( ar(j), -ar(ny+1-j), KIND=wp )
-                cwork(ny+1-j) = CMPLX( ar(j),  ar(ny+1-j), KIND=wp )
-             ENDDO
-             cwork((ny+1)/2) = CMPLX( ar((ny+1)/2), 0.0_wp, KIND=wp )
-
-             jshape = SHAPE( cwork )
-             CALL FFTN( cwork, jshape, inv = .TRUE. )
-
-             DO  j = 0, ny
-                ar(j) = REAL( cwork(j), KIND=wp )
-             ENDDO
-
-          ENDIF
-
-          DEALLOCATE( cwork )
-
-       ELSEIF ( fft_method == 'temperton-algorithm' )  THEN
-
-!
-!--       Performing the fft with Temperton's software works on every system, since it is part of
-!--       the model.
-          IF ( forward_fft )  THEN
-
-             work(0:ny) = ar
-             CALL fft991cy( work, work1, trigs_y, ifax_y, 1, ny+1, ny+1, 1, -1 )
-
-             DO  j = 0, (ny+1)/2
-                ar(j) = work(2*j)
-             ENDDO
-             DO  j = 1, (ny+1)/2 - 1
-                ar(ny+1-j) = work(2*j+1)
-             ENDDO
-
-          ELSE
-
-             DO  j = 0, (ny+1)/2
-                work(2*j) = ar(j)
-             ENDDO
-             DO  j = 1, (ny+1)/2 - 1
-                work(2*j+1) = ar(ny+1-j)
-             ENDDO
-             work(1)    = 0.0_wp
-             work(ny+2) = 0.0_wp
-
-             CALL fft991cy( work, work1, trigs_y, ifax_y, 1, ny+1, ny+1, 1, 1 )
-             ar = work(0:ny)
-
-          ENDIF
-
-       ELSEIF ( fft_method == 'fftw' )  THEN
-
-#if defined( __fftw )
-          IF ( forward_fft )  THEN
-
-             y_in(0:ny) = ar(0:ny)
-             CALL FFTW_EXECUTE_DFT_R2C( plan_yf, y_in, y_out )
-
-             DO  j = 0, (ny+1)/2
-                ar(j) = REAL( y_out(j), KIND=wp ) / (ny+1)
-             ENDDO
-             DO  j = 1, (ny+1)/2 - 1
-                ar(ny+1-j) = AIMAG( y_out(j) ) / (ny+1)
-             ENDDO
-
-          ELSE
-
-             y_out(0) = CMPLX( ar(0), 0.0_wp, KIND=wp )
-             DO  j = 1, (ny+1)/2 - 1
-                y_out(j) = CMPLX( ar(j), ar(ny+1-j), KIND=wp )
-             ENDDO
-             y_out((ny+1)/2) = CMPLX( ar((ny+1)/2), 0.0_wp, KIND=wp )
-
-             CALL FFTW_EXECUTE_DFT_C2R( plan_yi, y_out, y_in )
-             ar(0:ny) = y_in(0:ny)
-
-          ENDIF
-#endif
-
-       ELSEIF ( fft_method == 'system-specific' )  THEN
-
-#if defined( __nec_fft )
-          IF ( forward_fft )  THEN
-
-             work(0:ny) = ar(0:ny)
-
-             CALL DZFFT( 1, ny+1, sqr_dny, work, work, trig_yf, work2, 0 )
-
-             DO  j = 0, (ny+1)/2
-                ar(j) = work(2*j)
-             ENDDO
-             DO  j = 1, (ny+1)/2 - 1
-                ar(ny+1-j) = work(2*j+1)
-             ENDDO
-
-          ELSE
-
-             DO  j = 0, (ny+1)/2
-                work(2*j) = ar(j)
-             ENDDO
-             DO  j = 1, (ny+1)/2 - 1
-                work(2*j+1) = ar(ny+1-j)
-             ENDDO
-             work(1) = 0.0_wp
-             work(ny+2) = 0.0_wp
-
-             CALL ZDFFT( -1, ny+1, sqr_dny, work, work, trig_yb, work2, 0 )
-
-             ar(0:ny) = work(0:ny)
-
-          ENDIF
-#endif
-
-       ENDIF
-
-    END SUBROUTINE fft_y_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Fourier-transformation along x-direction.
-!> Version for 1d domain decomposition,
-!> using multiple 1D FFT from Math Keisan on NEC or Temperton-algorithm
-!> (no singleton-algorithm on NEC because it does not vectorize).
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE fft_x_m( ar, direction )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  direction  !<
-
-       INTEGER(iwp) ::  i     !<
-       INTEGER(iwp) ::  k     !<
-       INTEGER(iwp) ::  siza  !<
-#if defined( __nec_fft )
-       INTEGER(iwp) ::  sizw
-#endif
-
-       REAL(wp), DIMENSION(0:nx,nz)       ::  ar     !<
-       REAL(wp), DIMENSION(0:nx+3,nz+1)   ::  ai     !<
-       REAL(wp), DIMENSION(6*(nx+4),nz+1) ::  work1  !<
-
-#if defined( __nec_fft )
-       COMPLEX(wp), DIMENSION(:,:), ALLOCATABLE ::  work
-#endif
-
-       IF ( fft_method == 'temperton-algorithm' )  THEN
-
-          siza = SIZE( ai, 1 )
-
-          IF ( direction == 'forward')  THEN
-
-             ai(0:nx,1:nz) = ar(0:nx,1:nz)
-             ai(nx+1:,:)   = 0.0_wp
-
-             CALL fft991cy( ai, work1, trigs_x, ifax_x, 1, siza, nx+1, nz, -1 )
-
-             DO  k = 1, nz
-                DO  i = 0, (nx+1)/2
-                   ar(i,k) = ai(2*i,k)
-                ENDDO
-                DO  i = 1, (nx+1)/2 - 1
-                   ar(nx+1-i,k) = ai(2*i+1,k)
-                ENDDO
-             ENDDO
-
-          ELSE
-
-             DO  k = 1, nz
-                DO  i = 0, (nx+1)/2
-                   ai(2*i,k) = ar(i,k)
-                ENDDO
-                DO  i = 1, (nx+1)/2 - 1
-                   ai(2*i+1,k) = ar(nx+1-i,k)
-                ENDDO
-                ai(1,k) = 0.0_wp
-                ai(nx+2,k) = 0.0_wp
-             ENDDO
-
-             CALL fft991cy( ai, work1, trigs_x, ifax_x, 1, siza, nx+1, nz, 1 )
-
-             ar(0:nx,1:nz) = ai(0:nx,1:nz)
-
-          ENDIF
-
-       ELSEIF ( fft_method == 'system-specific' )  THEN
-
-#if defined( __nec_fft )
-          ALLOCATE( work((nx+4)/2+1,nz+1) )
-          siza = SIZE( ai, 1 )
-          sizw = SIZE( work, 1 )
-
-          IF ( direction == 'forward')  THEN
-
-!
-!--          Tables are initialized once more. This call should not be necessary, but otherwise
-!--          program aborts in asymmetric case.
-             CALL DZFFTM( 0, nx+1, nz1, sqr_dnx, work, nx+4, work, nx+4, trig_xf, work1, 0 )
-
-             ai(0:nx,1:nz) = ar(0:nx,1:nz)
-             IF ( nz1 > nz )  THEN
-                ai(:,nz1) = 0.0_wp
-             ENDIF
-
-             CALL DZFFTM( 1, nx+1, nz1, sqr_dnx, ai, siza, work, sizw, trig_xf, work1, 0 )
-
-             DO  k = 1, nz
-                DO  i = 0, (nx+1)/2
-                   ar(i,k) = REAL( work(i+1,k), KIND=wp )
-                ENDDO
-                DO  i = 1, (nx+1)/2 - 1
-                   ar(nx+1-i,k) = AIMAG( work(i+1,k) )
-                ENDDO
-             ENDDO
-
-          ELSE
-
-!
-!--          Tables are initialized once more. This call should not be
-!--          necessary, but otherwise program aborts in asymmetric case
-             CALL ZDFFTM( 0, nx+1, nz1, sqr_dnx, work, nx+4, work, nx+4, trig_xb, work1, 0 )
-
-             IF ( nz1 > nz )  THEN
-                work(:,nz1) = 0.0_wp
-             ENDIF
-             DO  k = 1, nz
-                work(1,k) = CMPLX( ar(0,k), 0.0_wp, KIND=wp )
-                DO  i = 1, (nx+1)/2 - 1
-                   work(i+1,k) = CMPLX( ar(i,k), ar(nx+1-i,k), KIND=wp )
-                ENDDO
-                work(((nx+1)/2)+1,k) = CMPLX( ar((nx+1)/2,k), 0.0_wp, KIND=wp )
-             ENDDO
-
-             CALL ZDFFTM( -1, nx+1, nz1, sqr_dnx, work, sizw, ai, siza, trig_xb, work1, 0 )
-
-             ar(0:nx,1:nz) = ai(0:nx,1:nz)
-
-          ENDIF
-
-          DEALLOCATE( work )
-#endif
-
-       ENDIF
-
-    END SUBROUTINE fft_x_m
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Fourier-transformation along y-direction.
-!> Version for 1d domain decomposition,
-!> using multiple 1D FFT from Math Keisan on NEC or Temperton-algorithm
-!> (no singleton-algorithm on NEC because it does not vectorize).
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE fft_y_m( ar, ny1, direction )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  direction  !<
-
-       INTEGER(iwp) ::  j     !<
-       INTEGER(iwp) ::  k     !<
-       INTEGER(iwp) ::  ny1   !<
-       INTEGER(iwp) ::  siza  !<
-#if defined( __nec_fft )
-       INTEGER(iwp) ::  sizw
-#endif
-
-       REAL(wp), DIMENSION(0:ny1,nz)      ::  ar     !<
-       REAL(wp), DIMENSION(0:ny+3,nz+1)   ::  ai     !<
-       REAL(wp), DIMENSION(6*(ny+4),nz+1) ::  work1  !<
-
-#if defined( __nec_fft )
-       COMPLEX(wp), DIMENSION(:,:), ALLOCATABLE ::  work
-#endif
-
-
-       IF ( fft_method == 'temperton-algorithm' )  THEN
-
-          siza = SIZE( ai, 1 )
-
-          IF ( direction == 'forward')  THEN
-
-             ai(0:ny,1:nz) = ar(0:ny,1:nz)
-             ai(ny+1:,:)   = 0.0_wp
-
-             CALL fft991cy( ai, work1, trigs_y, ifax_y, 1, siza, ny+1, nz, -1 )
-
-             DO  k = 1, nz
-                DO  j = 0, (ny+1)/2
-                   ar(j,k) = ai(2*j,k)
-                ENDDO
-                DO  j = 1, (ny+1)/2 - 1
-                   ar(ny+1-j,k) = ai(2*j+1,k)
-                ENDDO
-             ENDDO
-
-          ELSE
-
-             DO  k = 1, nz
-                DO  j = 0, (ny+1)/2
-                   ai(2*j,k) = ar(j,k)
-                ENDDO
-                DO  j = 1, (ny+1)/2 - 1
-                   ai(2*j+1,k) = ar(ny+1-j,k)
-                ENDDO
-                ai(1,k) = 0.0_wp
-                ai(ny+2,k) = 0.0_wp
-             ENDDO
-
-             CALL fft991cy( ai, work1, trigs_y, ifax_y, 1, siza, ny+1, nz, 1 )
-
-             ar(0:ny,1:nz) = ai(0:ny,1:nz)
-
-          ENDIF
-
-       ELSEIF ( fft_method == 'system-specific' )  THEN
-
-#if defined( __nec_fft )
-          ALLOCATE( work((ny+4)/2+1,nz+1) )
-          siza = SIZE( ai, 1 )
-          sizw = SIZE( work, 1 )
-
-          IF ( direction == 'forward')  THEN
-
-!
-!--          Tables are initialized once more. This call should not be necessary, but otherwise
-!--          program aborts in asymmetric case.
-             CALL DZFFTM( 0, ny+1, nz1, sqr_dny, work, ny+4, work, ny+4, trig_yf, work1, 0 )
-
-             ai(0:ny,1:nz) = ar(0:ny,1:nz)
-             IF ( nz1 > nz )  THEN
-                ai(:,nz1) = 0.0_wp
-             ENDIF
-
-             CALL DZFFTM( 1, ny+1, nz1, sqr_dny, ai, siza, work, sizw, trig_yf, work1, 0 )
-
-             DO  k = 1, nz
-                DO  j = 0, (ny+1)/2
-                   ar(j,k) = REAL( work(j+1,k), KIND=wp )
-                ENDDO
-                DO  j = 1, (ny+1)/2 - 1
-                   ar(ny+1-j,k) = AIMAG( work(j+1,k) )
-                ENDDO
-             ENDDO
-
-          ELSE
-
-!
-!--          Tables are initialized once more. This call should not be necessary, but otherwise
-!--          program aborts in asymmetric case.
-             CALL ZDFFTM( 0, ny+1, nz1, sqr_dny, work, ny+4, work, ny+4, trig_yb, work1, 0 )
-
-             IF ( nz1 > nz )  THEN
-                work(:,nz1) = 0.0_wp
-             ENDIF
-             DO  k = 1, nz
-                work(1,k) = CMPLX( ar(0,k), 0.0_wp, KIND=wp )
-                DO  j = 1, (ny+1)/2 - 1
-                   work(j+1,k) = CMPLX( ar(j,k), ar(ny+1-j,k), KIND=wp )
-                ENDDO
-                work(((ny+1)/2)+1,k) = CMPLX( ar((ny+1)/2,k), 0.0_wp, KIND=wp )
-             ENDDO
-
-             CALL ZDFFTM( -1, ny+1, nz1, sqr_dny, work, sizw, ai, siza, trig_yb, work1, 0 )
-
-             ar(0:ny,1:nz) = ai(0:ny,1:nz)
-
-          ENDIF
-
-          DEALLOCATE( work )
-#endif
-
-       ENDIF
-
-    END SUBROUTINE fft_y_m
-
-
- END MODULE fft_xy
Index: palm/trunk/SOURCE/flow_statistics.f90
===================================================================
--- palm/trunk/SOURCE/flow_statistics.f90	(revision 4901)
+++ palm/trunk/SOURCE/flow_statistics.f90	(revision 1)
@@ -1,95 +1,100 @@
-!> @file flow_statistics.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
+ SUBROUTINE flow_statistics
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Output ghf and r_a as sum of all horizontally upward-facing surfaces in LSM+USM simulations
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Implement relative humidity as diagnostic output quantity
-!
-! 4742 2020-10-14 15:11:02Z schwenkel
-! Implement snow and graupel (bulk microphysics)
-!
-! 4703 2020-09-28 09:21:45Z suehring
-! Revise averaging of land-surface quantities
-!
-! 4672 2020-09-09 21:27:32Z pavelkrc
-! OpenACC bugfix
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4646 2020-08-24 16:02:40Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4581 2020-06-29 08:49:58Z suehring
-! Formatting adjustment
-!
-! 4551 2020-06-02 10:22:25Z suehring
-! Bugfix in summation for statistical regions
-!
-! 4521 2020-05-06 11:39:49Z schwenkel
-! Rename variable
-!
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-!
-! 4472 2020-03-24 12:21:00Z Giersch
-! Calculations of the Kolmogorov lengt scale eta implemented
-!
-! 4464 2020-03-17 11:08:46Z Giersch
-! Reset last change (r4463)
-!
-! 4463 2020-03-17 09:27:36Z Giersch
-! Calculate horizontally averaged profiles of all velocity components at the same place
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4442 2020-03-04 19:21:13Z suehring
-! Change order of dimension in surface array %frac to allow for better vectorization.
-!
-! 4441 2020-03-04 19:20:35Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4131 2019-08-02 11:06:18Z monakurppa
-! Allow profile output for salsa variables.
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! Correct conversion to kinematic scalar fluxes in case of pw-scheme and statistic regions
-!
-! 3828 2019-03-27 19:36:23Z raasch
-! unused variables removed
-!
-! 3676 2019-01-16 15:07:05Z knoop
-! Bugfix, terminate OMP Parallel block
+! $Log: flow_statistics.f90,v $
+! Revision 1.41  2006/08/04 14:37:50  raasch
+! Error removed in non-parallel part (sums_l)
+!
+! Revision 1.40  2006/04/26 14:06:01  raasch
+! Call of omp_get_thread_num written as comment line. Since lcmuk does not
+! understand this comment, a cpp-directive is required.
+!
+! Revision 1.39  2006/04/26 12:19:16  raasch
+! OpenMP optimization, thread number added as third dimension of sums_l,
+! nzb_s_inner(j,i) replaced by nzb in determination of z_i
+!
+! Revision 1.38  2006/02/23 12:23:15  raasch
+! nzb and nzb_diff replaced by nzb_s_outer and nzb_diff_s_outer resrectively,
+! nanz_sums, nanz_2dh, nanz_3d renamed ngp_sums, ngp_2dh and ngp_3d,
+! respectively,
+! ngp_2dh and ngp_3d partially replaced by ngp_2dh_outer and ngp_3d_inner,
+! respectively
+!
+! Revision 1.37  2005/12/06 16:40:21  raasch
+! Calculation of ql (54) profile in case of using cloud droplets
+!
+! Revision 1.36  2005/04/23 09:10:27  raasch
+! +local array sums_ll instead of temporarily using sums_l
+!
+! Revision 1.35  2004/04/30 11:46:56  raasch
+! leap_frog changed to time_integration
+!
+! Revision 1.34  2003/05/09 14:25:12  raasch
+! Parameters in MPI_ALLREDUCE call changed
+!
+! Revision 1.33  2003/03/31 15:42:53  raasch
+! Calculation of horizontal temperature fluxes modified and cleaned up
+!
+! Revision 1.32  2003/03/16 09:39:07  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.31  2003/03/12 16:30:07  raasch
+! Calculation of perturbation and total energy of the total domain
+! re-arranged in order to allow vectorization of the respective loop
+!
+! Revision 1.30  2003/03/04 11:26:35  raasch
+! Error in calculation of the vertical flux of resolved scale energy
+! (profile 57) removed
+!
+! Revision 1.29  2002/12/19 14:50:02  raasch
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.28  2002/04/16 08:04:19  raasch
+! Error in passive scalar profile (hom(..41..)) removed
+!
+! Revision 1.27  2002/04/11 16:31:03  schroeter
+! No changes.
+!
+! Revision 1.26  2001/09/04  12:00:12  12:00:12  raasch (Siegfried Raasch)
+! Calculation of the vertical flux of resolved scale energy and pressure
+! fluctuations
+! 
+! Revision 1.25  2001/08/21 08:32:24  raasch
+! Special calculation of surface fluxes whenever they are prescribed (not only
+! in case of a Prandtl layer), call of user_interface
+!
+! Revision 1.24  2001/03/30 07:23:34  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.23  2001/02/07 06:48:25  raasch
+! Error in non-parallel passive scalar code removed
+!
+! Revision 1.22  2001/01/29 12:25:02  raasch
+! Passive scalar is considered
+!
+! Revision 1.21  2001/01/22 06:49:27  raasch
+! Module test_variables removed
+!
+! Revision 1.20  2000/04/13 13:54:15  schroeter
+! + computation of new profiles for calculations with
+!   cloud_physics
+!
+! Revision 1.19  2000/01/26  09:32:58  09:32:58  letzel (Marcus Letzel)
+! All comments translated into English
+! 
+! Revision 1.16  1998/04/21 15:54:54  raasch
+! Berechnung von w* beruecksichtigt jetzt den Fall z_i=0,
+! Faktor 0.5 bei Energietransport hinzugefuegt
+!
+! Revision 1.6  1998/02/10 15:06:02  raasch
+! Berechnung des Gesamtwaermestroms, in aufgeloesten Waermestroemen wird das
+! horizontale Temperaturmittel nicht mehr abgezogen, Berechnung der
+! Gesamtimpulsfluesse
 !
 ! Revision 1.1  1997/08/11 06:15:17  raasch
@@ -99,154 +104,43 @@
 ! Description:
 ! ------------
-!> Compute average profiles and further average flow quantities for the different user-defined
-!> (sub-)regions. The region indexed 0 is the total model domain.
-!>
-!> @note For simplicity, nzb_s_inner and nzb_diff_s_inner are used as a lower vertical index for
-!>       k-loops for all variables, although strictly speaking the k-loops would have to be split
-!>       up according to the staggered grid. However, this implies no error since staggered velocity
-!>       components are zero at the walls and inside buildings.
-!> @todo Revise output steering of land-surface and urban-surface output quantities
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE flow_statistics
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, ddzw, d_exner, e, exner, heatflux_output_conversion, hyp, km, kh,             &
-               momentumflux_output_conversion,                                                     &
-               nc, ni, ng, nr, ns, p, prho, prr, pt, q, qc, qi, qg, ql, qr, qs,                    &
-               rho_air, rho_air_zw, rho_ocean, s, sa, u, ug, v, vg, vpt, w, w_subs,                &
-               waterflux_output_conversion, zw
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  g, lv_d_cp, magnus, rd_d_rv
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY: bulk_cloud_model, graupel, snow, microphysics_morrison, microphysics_seifert,        &
-              microphysics_ice_phase
-
-    USE chem_modules,                                                                              &
-        ONLY:  max_pr_cs
-
-    USE control_parameters,                                                                        &
-        ONLY:   air_chemistry, average_count_pr, cloud_droplets, do_sum, dt_3d, humidity,          &
-                initializing_actions, kolmogorov_length_scale, land_surface, large_scale_forcing,  &
-                large_scale_subsidence, max_pr_salsa, max_pr_user, message_string, neutral,        &
-                ocean_mode, passive_scalar, salsa, simulated_time, simulated_time_at_begin,        &
-                urban_surface,                                                                     &
-                use_subsidence_tendencies, use_surface_fluxes, use_top_fluxes, ws_scheme_mom,      &
-                ws_scheme_sca
-
-    USE cpulog,                                                                                    &
-        ONLY:   cpu_log, log_point
-
-    USE grid_variables,                                                                            &
-        ONLY:   ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:   ngp_2dh, ngp_2dh_s_inner, ngp_3d, ngp_3d_inner, nxl, nxr, nyn, nys, nzb, nzt,      &
-                topo_min_level, wall_flags_total_0
-
-#if defined( __parallel )
-    USE indices,                                                                                   &
-        ONLY:  ngp_sums, ngp_sums_ls
-#endif
-
-    USE kinds
-
-    USE land_surface_model_mod,                                                                    &
-        ONLY:   m_soil_h, nzb_soil, nzt_soil, t_soil_h
-
-    USE lsf_nudging_mod,                                                                           &
-        ONLY:   td_lsa_lpt, td_lsa_q, td_sub_lpt, td_sub_q, time_vert
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_statistics
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  dots_rad, dots_soil, dots_max
-
+! Compute average profiles and further average flow quantities for the different
+! user-defined (sub-)regions. The region indexed 0 is the total model domain.
+!
+! NOTE: For simplicity, nzb_s_outer and nzb_diff_s_outer are being used as a
+! ----  lower vertical index for k-loops for all variables so that regardless
+! of the variable and its respective staggered grid always the same number of
+! grid points is used for 2D averages. The disadvantage: depending on the
+! variable, up to one grid layer adjacent to the (vertical walls of the)
+! topography is missed out by this simplification.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE cloud_parameters
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
     USE pegrid
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  radiation, radiation_scheme,                                                        &
-               rad_lw_in, rad_lw_out, rad_lw_cs_hr, rad_lw_hr,                                     &
-               rad_sw_in, rad_sw_out, rad_sw_cs_hr, rad_sw_hr
-
     USE statistics
-
-    USE surface_mod,                                                                               &
-        ONLY :  surf_def_h, surf_lsm_h, surf_usm_h
-
+    USE control_parameters
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i                   !<
-    INTEGER(iwp) ::  j                   !<
-    INTEGER(iwp) ::  k                   !<
-    INTEGER(iwp) ::  ki                  !<
-    INTEGER(iwp) ::  k_surface_level     !<
-    INTEGER(iwp) ::  m                   !< loop variable over all horizontal wall elements
-    INTEGER(iwp) ::  l                   !< loop variable over surface facing -- up- or downward-facing
-    INTEGER(iwp) ::  nt                  !<
-!$  INTEGER(iwp) ::  omp_get_thread_num  !<
-    INTEGER(iwp) ::  sr                  !<
-    INTEGER(iwp) ::  tn                  !<
-
-    LOGICAL ::  first  !<
-
-    REAL(wp) ::  dissipation      !< dissipation rate
-    REAL(wp) ::  dptdz_threshold  !<
-    REAL(wp) ::  du_dx            !< Derivative of u fluctuations with respect to x
-    REAL(wp) ::  du_dy            !< Derivative of u fluctuations with respect to y
-    REAL(wp) ::  du_dz            !< Derivative of u fluctuations with respect to z
-    REAL(wp) ::  dv_dx            !< Derivative of v fluctuations with respect to x
-    REAL(wp) ::  dv_dy            !< Derivative of v fluctuations with respect to y
-    REAL(wp) ::  dv_dz            !< Derivative of v fluctuations with respect to z
-    REAL(wp) ::  dw_dx            !< Derivative of w fluctuations with respect to x
-    REAL(wp) ::  dw_dy            !< Derivative of w fluctuations with respect to y
-    REAL(wp) ::  dw_dz            !< Derivative of w fluctuations with respect to z
-    REAL(wp) ::  eta              !< Kolmogorov length scale
-    REAL(wp) ::  fac              !<
-    REAL(wp) ::  flag             !<
-    REAL(wp) ::  height           !<
-    REAL(wp) ::  pts              !<
-    REAL(wp) ::  s11              !< fluctuating rate-of-strain tensor component 11
-    REAL(wp) ::  s21              !< fluctuating rate-of-strain tensor component 21
-    REAL(wp) ::  s31              !< fluctuating rate-of-strain tensor component 31
-    REAL(wp) ::  s12              !< fluctuating rate-of-strain tensor component 12
-    REAL(wp) ::  s22              !< fluctuating rate-of-strain tensor component 22
-    REAL(wp) ::  s32              !< fluctuating rate-of-strain tensor component 32
-    REAL(wp) ::  s13              !< fluctuating rate-of-strain tensor component 13
-    REAL(wp) ::  s23              !< fluctuating rate-of-strain tensor component 23
-    REAL(wp) ::  s33              !< fluctuating rate-of-strain tensor component 33
-    REAL(wp) ::  sums_l_etot      !<
-    REAL(wp) ::  ust              !<
-    REAL(wp) ::  ust2             !<
-    REAL(wp) ::  u2               !<
-    REAL(wp) ::  vst              !<
-    REAL(wp) ::  vst2             !<
-    REAL(wp) ::  v2               !<
-    REAL(wp) ::  w2               !<
-
-    REAL(wp) ::  temp           !< temperature
-    REAL(wp) ::  e_s            !< saturation vapor pressure
-    REAL(wp) ::  q_s            !< saturation mixing ratio
-    REAL(wp) ::  rh_tmp         !< local value of relative humidity
-
-    REAL(wp) ::  dptdz(nzb+1:nzt+1)    !<
-    REAL(wp) ::  sums_ll(nzb:nzt+1,2)  !<
+    INTEGER ::  i, j, k, omp_get_thread_num, sr, tn
+    LOGICAL ::  first
+    REAL    ::  height, pts, sums_l_eper, sums_l_etot, ust, ust2, u2, vst, &
+                vst2, v2, w2, z_i(2)
+    REAL    ::  sums_ll(nzb:nzt+1,2)
 
 
     CALL cpu_log( log_point(10), 'flow_statistics', 'start' )
 
-
-!
-!-- To be on the safe side, check whether flow_statistics has already been called once after the
-!-- current time step.
+!
+!-- To be on the safe side, check whether flow_statistics has already been
+!-- called once after the current time step
     IF ( flow_statistics_called )  THEN
-
-       message_string = 'flow_statistics is called two times within one ' // 'timestep'
-       CALL message( 'flow_statistics', 'PA0190', 1, 2, 0, 6, 0 )
-
+       IF ( myid == 0 )  PRINT*, '+++ WARNING: flow_statistics is called two', &
+                                 ' times within one timestep'
+       CALL local_stop
     ENDIF
 
@@ -257,135 +151,69 @@
 !
 !--    Initialize (local) summation array
-       sums_l = 0.0_wp
-#ifdef _OPENACC
-       !$ACC KERNELS PRESENT(sums_l)
-       sums_l = 0.0_wp
-       !$ACC END KERNELS
+       sums_l = 0.0
+
+!
+!--    Store sums that have been computed in other subroutines in summation
+!--    array
+       sums_l(:,11,:) = sums_l_l(:,sr,:)      ! mixing length from diffusivities
+!--    WARNING: next line still has to be adjusted for OpenMP 
+       sums_l(:,21,0) = sums_wsts_bc_l(:,sr)  ! heat flux from advec_s_bc
+       sums_l(nzb+9,var_sum,0)  = sums_divold_l(sr)  ! old divergence from pres
+       sums_l(nzb+10,var_sum,0) = sums_divnew_l(sr)  ! new divergence from pres
+!--    WARNING: next four lines still may have to be adjusted for OpenMP 
+       sums_l(nzb:nzb+2,var_sum-1,0)    = sums_up_fraction_l(1,1:3,sr)! upstream
+       sums_l(nzb+3:nzb+5,var_sum-1,0)  = sums_up_fraction_l(2,1:3,sr)! parts
+       sums_l(nzb+6:nzb+8,var_sum-1,0)  = sums_up_fraction_l(3,1:3,sr)! from
+       sums_l(nzb+9:nzb+11,var_sum-1,0) = sums_up_fraction_l(4,1:3,sr)! spline
+
+!
+!--    Horizontally averaged profiles of horizontal velocities and temperature.
+!--    They must have been computed before, because they are already required
+!--    for other horizontal averages.
+       tn = 0
+       !$OMP PARALLEL PRIVATE( i, j, k, tn )
+#if defined( __lcmuk )
+       tn = omp_get_thread_num()
+#else
+!$     tn = omp_get_thread_num()
 #endif
 
-!
-!--    Store sums that have been computed in other subroutines in summation array
-       sums_l(:,11,:) = sums_l_l(:,sr,:)      ! mixing length from diffusivities
-!--    WARNING: next line still has to be adjusted for OpenMP
-       sums_l(:,21,0) = sums_wsts_bc_l(:,sr) *                                                     &
-                        heatflux_output_conversion  ! heat flux from advec_s_bc
-       sums_l(nzb+9,pr_palm,0)  = sums_divold_l(sr)  ! old divergence from pres
-       sums_l(nzb+10,pr_palm,0) = sums_divnew_l(sr)  ! new divergence from pres
-
-!
-!--    When calcuating horizontally-averaged total (resolved- plus subgrid-scale) vertical fluxes
-!--    and velocity variances by using commonly-applied Reynolds-based methods
-!--    ( e.g. <w'pt'> = (w-<w>)*(pt-<pt>) ) in combination with the 5th order advection scheme,
-!--    pronounced artificial kinks could be observed in the vertical profiles near the surface.
-!--    Please note: these kinks were not related to the model truth, i.e. these kinks are just
-!--    related to an evaluation problem.
-!--    In order avoid these kinks, vertical fluxes and horizontal as well vertical velocity
-!--    variances are calculated directly within the advection routines, according to the numerical
-!--    discretization, to evaluate the statistical quantities as they will appear within the
-!--    prognostic equations.
-!--    Copy the turbulent quantities, evaluated in the advection routines to the local array
-!--    sums_l() for further computations.
-       IF ( ws_scheme_mom .AND. sr == 0 )  THEN
-
-!
-!--       According to the Neumann bc for the horizontal velocity components, the corresponding
-!--       fluxes has to satisfiy the same bc.
-          IF ( ocean_mode )  THEN
-             sums_us2_ws_l(nzt+1,:) = sums_us2_ws_l(nzt,:)
-             sums_vs2_ws_l(nzt+1,:) = sums_vs2_ws_l(nzt,:)
-          ENDIF
-
-          DO  i = 0, threads_per_task-1
-!
-!--          Swap the turbulent quantities evaluated in advec_ws.
-             sums_l(:,13,i) = sums_wsus_ws_l(:,i) * momentumflux_output_conversion ! w*u*
-             sums_l(:,15,i) = sums_wsvs_ws_l(:,i) * momentumflux_output_conversion ! w*v*
-             sums_l(:,30,i) = sums_us2_ws_l(:,i)                                   ! u*2
-             sums_l(:,31,i) = sums_vs2_ws_l(:,i)                                   ! v*2
-             sums_l(:,32,i) = sums_ws2_ws_l(:,i)                                   ! w*2
-             sums_l(:,34,i) = sums_l(:,34,i) + 0.5_wp *                                            &
-                              ( sums_us2_ws_l(:,i) + sums_vs2_ws_l(:,i) + sums_ws2_ws_l(:,i) )  ! e*
-          ENDDO
-
-       ENDIF
-
-       IF ( ws_scheme_sca .AND. sr == 0 )  THEN
-
-          DO  i = 0, threads_per_task-1
-             sums_l(:,17,i)                        = sums_wspts_ws_l(:,i)                          &
-                                                     * heatflux_output_conversion   ! w*pt*
-             IF ( ocean_mode     ) sums_l(:,66,i)  = sums_wssas_ws_l(:,i)           ! w*sa*
-             IF ( humidity       ) sums_l(:,49,i)  = sums_wsqs_ws_l(:,i)                           &
-                                                     * waterflux_output_conversion  ! w*q*
-             IF ( passive_scalar ) sums_l(:,114,i) = sums_wsss_ws_l(:,i)            ! w*s*
-          ENDDO
-
-       ENDIF
-!
-!--    Horizontally averaged profiles of horizontal velocities and temperature.
-!--    They must have been computed before, because they are already required for other horizontal
-!--    averages.
-       tn = 0
-       !$OMP PARALLEL PRIVATE( i, j, k, tn, flag )
-       !$ tn = omp_get_thread_num()
        !$OMP DO
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
-       !$ACC PRESENT(wall_flags_total_0, u, v, pt, rmask, sums_l)
        DO  i = nxl, nxr
           DO  j =  nys, nyn
-             DO  k = nzb, nzt+1
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                !$ACC ATOMIC
-                sums_l(k,1,tn)  = sums_l(k,1,tn)  + u(k,j,i)  * rmask(j,i,sr) * flag
-                !$ACC ATOMIC
-                sums_l(k,2,tn)  = sums_l(k,2,tn)  + v(k,j,i)  * rmask(j,i,sr) * flag
-                !$ACC ATOMIC
-                sums_l(k,4,tn)  = sums_l(k,4,tn)  + pt(k,j,i) * rmask(j,i,sr) * flag
+             DO  k = nzb_s_outer(j,i), nzt+1
+                sums_l(k,1,tn)  = sums_l(k,1,tn)  + u(k,j,i)  * rmask(j,i,sr)
+                sums_l(k,2,tn)  = sums_l(k,2,tn)  + v(k,j,i)  * rmask(j,i,sr)
+                sums_l(k,4,tn)  = sums_l(k,4,tn)  + pt(k,j,i) * rmask(j,i,sr)
              ENDDO
           ENDDO
        ENDDO
-       !$ACC UPDATE HOST(sums_l(:,1,tn), sums_l(:,2,tn), sums_l(:,4,tn))
-
-!
-!--    Horizontally averaged profile of salinity
-       IF ( ocean_mode )  THEN
+
+!
+!--    Horizontally averaged profiles of virtual potential temperature,
+!--    total water content, specific humidity and liquid water potential
+!--    temperature
+       IF ( moisture )  THEN
           !$OMP DO
           DO  i = nxl, nxr
              DO  j =  nys, nyn
-                DO  k = nzb, nzt+1
-                   sums_l(k,23,tn)  = sums_l(k,23,tn) + sa(k,j,i)                                  &
-                                      * rmask(j,i,sr)                                              &
-                                      * MERGE( 1.0_wp, 0.0_wp,                                     &
-                                               BTEST( wall_flags_total_0(k,j,i), 22 ) )
+                DO  k = nzb_s_outer(j,i), nzt+1
+                   sums_l(k,44,tn)  = sums_l(k,44,tn) + &
+                                      vpt(k,j,i) * rmask(j,i,sr)
+                   sums_l(k,41,tn)  = sums_l(k,41,tn) + &
+                                      q(k,j,i) * rmask(j,i,sr)
                 ENDDO
              ENDDO
           ENDDO
-       ENDIF
-
-!
-!--    Horizontally averaged profiles of virtual potential temperature, total water content, water
-!--    vapor mixing ratio and liquid water potential temperature
-       IF ( humidity )  THEN
-          !$OMP DO
-          DO  i = nxl, nxr
-             DO  j =  nys, nyn
-                DO  k = nzb, nzt+1
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                   sums_l(k,44,tn)  = sums_l(k,44,tn) + vpt(k,j,i) * rmask(j,i,sr) * flag
-                   sums_l(k,41,tn)  = sums_l(k,41,tn) + q(k,j,i) * rmask(j,i,sr)   * flag
-                ENDDO
-             ENDDO
-          ENDDO
-          IF ( bulk_cloud_model )  THEN
+          IF ( cloud_physics )  THEN
              !$OMP DO
              DO  i = nxl, nxr
                 DO  j =  nys, nyn
-                   DO  k = nzb, nzt+1
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                      sums_l(k,42,tn) = sums_l(k,42,tn) +                      &
-                                        ( q(k,j,i) - ql(k,j,i) ) * rmask(j,i,sr) * flag
-                      sums_l(k,43,tn) = sums_l(k,43,tn) + (                                        &
-                                           pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)            &
-                                                          ) * rmask(j,i,sr) * flag
+                   DO  k = nzb_s_outer(j,i), nzt+1
+                      sums_l(k,42,tn) = sums_l(k,42,tn) + &
+                                      ( q(k,j,i) - ql(k,j,i) ) * rmask(j,i,sr)
+                      sums_l(k,43,tn) = sums_l(k,43,tn) + ( &
+                                      pt(k,j,i) + l_d_cp*pt_d_t(k) * ql(k,j,i) &
+                                                          ) * rmask(j,i,sr)
                    ENDDO
                 ENDDO
@@ -400,9 +228,6 @@
           DO  i = nxl, nxr
              DO  j =  nys, nyn
-                DO  k = nzb, nzt+1
-                   sums_l(k,115,tn)  = sums_l(k,115,tn) + s(k,j,i)                                 &
-                                       * rmask(j,i,sr)                                             &
-                                       * MERGE( 1.0_wp, 0.0_wp,                                    &
-                                                BTEST( wall_flags_total_0(k,j,i), 22 ) )
+                DO  k = nzb_s_outer(j,i), nzt+1
+                   sums_l(k,41,tn)  = sums_l(k,41,tn) + q(k,j,i) * rmask(j,i,sr)
                 ENDDO
              ENDDO
@@ -410,4 +235,5 @@
        ENDIF
        !$OMP END PARALLEL
+
 !
 !--    Summation of thread sums
@@ -417,11 +243,8 @@
              sums_l(:,2,0) = sums_l(:,2,0) + sums_l(:,2,i)
              sums_l(:,4,0) = sums_l(:,4,0) + sums_l(:,4,i)
-             IF ( ocean_mode )  THEN
-                sums_l(:,23,0) = sums_l(:,23,0) + sums_l(:,23,i)
-             ENDIF
-             IF ( humidity )  THEN
+             IF ( moisture )  THEN
                 sums_l(:,41,0) = sums_l(:,41,0) + sums_l(:,41,i)
                 sums_l(:,44,0) = sums_l(:,44,0) + sums_l(:,44,i)
-                IF ( bulk_cloud_model )  THEN
+                IF ( cloud_physics )  THEN
                    sums_l(:,42,0) = sums_l(:,42,0) + sums_l(:,42,i)
                    sums_l(:,43,0) = sums_l(:,43,0) + sums_l(:,43,i)
@@ -429,5 +252,5 @@
              ENDIF
              IF ( passive_scalar )  THEN
-                sums_l(:,115,0) = sums_l(:,115,0) + sums_l(:,115,i)
+                sums_l(:,41,0) = sums_l(:,41,0) + sums_l(:,41,i)
              ENDIF
           ENDDO
@@ -437,39 +260,26 @@
 !
 !--    Compute total sum from local sums
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,     &
-                           ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( sums_l(nzb,2,0), sums(nzb,2), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,     &
-                           ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( sums_l(nzb,4,0), sums(nzb,4), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,     &
-                           ierr )
-       IF ( ocean_mode )  THEN
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_ALLREDUCE( sums_l(nzb,23,0), sums(nzb,23), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,&
-                              ierr )
-       ENDIF
-       IF ( humidity ) THEN
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_ALLREDUCE( sums_l(nzb,44,0), sums(nzb,44), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,&
-                              ierr )
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,&
-                              ierr )
-          IF ( bulk_cloud_model ) THEN
-             IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-             CALL MPI_ALLREDUCE( sums_l(nzb,42,0), sums(nzb,42), nzt+2-nzb, MPI_REAL, MPI_SUM,     &
-                                 comm2d, ierr )
-             IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-             CALL MPI_ALLREDUCE( sums_l(nzb,43,0), sums(nzb,43), nzt+2-nzb, MPI_REAL, MPI_SUM,     &
-                                 comm2d, ierr )
+       CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), nzt+2-nzb, MPI_REAL, &
+                           MPI_SUM, comm2d, ierr )
+       CALL MPI_ALLREDUCE( sums_l(nzb,2,0), sums(nzb,2), nzt+2-nzb, MPI_REAL, &
+                           MPI_SUM, comm2d, ierr )
+       CALL MPI_ALLREDUCE( sums_l(nzb,4,0), sums(nzb,4), nzt+2-nzb, MPI_REAL, &
+                           MPI_SUM, comm2d, ierr )
+       IF ( moisture ) THEN
+          CALL MPI_ALLREDUCE( sums_l(nzb,44,0), sums(nzb,44), nzt+2-nzb, &
+                              MPI_REAL, MPI_SUM, comm2d, ierr )
+          CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb, &
+                              MPI_REAL, MPI_SUM, comm2d, ierr )
+          IF ( cloud_physics ) THEN
+             CALL MPI_ALLREDUCE( sums_l(nzb,42,0), sums(nzb,42), nzt+2-nzb, &
+                                 MPI_REAL, MPI_SUM, comm2d, ierr )
+             CALL MPI_ALLREDUCE( sums_l(nzb,43,0), sums(nzb,43), nzt+2-nzb, &
+                                 MPI_REAL, MPI_SUM, comm2d, ierr )
           ENDIF
        ENDIF
 
        IF ( passive_scalar )  THEN
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_ALLREDUCE( sums_l(nzb,115,0), sums(nzb,115), nzt+2-nzb, MPI_REAL, MPI_SUM,      &
-                              comm2d, ierr )
+          CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb, &
+                              MPI_REAL, MPI_SUM, comm2d, ierr )
        ENDIF
 #else
@@ -477,45 +287,35 @@
        sums(:,2) = sums_l(:,2,0)
        sums(:,4) = sums_l(:,4,0)
-       IF ( ocean_mode )  sums(:,23) = sums_l(:,23,0)
-       IF ( humidity ) THEN
+       IF ( moisture ) THEN
           sums(:,44) = sums_l(:,44,0)
           sums(:,41) = sums_l(:,41,0)
-          IF ( bulk_cloud_model ) THEN
+          IF ( cloud_physics ) THEN
              sums(:,42) = sums_l(:,42,0)
              sums(:,43) = sums_l(:,43,0)
           ENDIF
        ENDIF
-       IF ( passive_scalar )  sums(:,115) = sums_l(:,115,0)
+       IF ( passive_scalar )  sums(:,41) = sums_l(:,41,0)
 #endif
 
 !
-!--    Final values are obtained by division by the total number of grid points used for summation.
-!--    After that store profiles.
-       sums(:,1) = sums(:,1) / ngp_2dh(sr)
-       sums(:,2) = sums(:,2) / ngp_2dh(sr)
-       sums(:,4) = sums(:,4) / ngp_2dh_s_inner(:,sr)
+!--    Final values are obtained by division by the total number of grid points 
+!--    used for summation. After that store profiles.
+       sums(:,1) = sums(:,1) / ngp_2dh_outer(:,sr)
+       sums(:,2) = sums(:,2) / ngp_2dh_outer(:,sr)
+       sums(:,4) = sums(:,4) / ngp_2dh_outer(:,sr)
        hom(:,1,1,sr) = sums(:,1)             ! u
        hom(:,1,2,sr) = sums(:,2)             ! v
        hom(:,1,4,sr) = sums(:,4)             ! pt
-       !$ACC UPDATE DEVICE(hom(:,1,1,sr), hom(:,1,2,sr), hom(:,1,4,sr))
-
-
-!
-!--    Salinity
-       IF ( ocean_mode )  THEN
-          sums(:,23) = sums(:,23) / ngp_2dh_s_inner(:,sr)
-          hom(:,1,23,sr) = sums(:,23)             ! sa
-       ENDIF
 
 !
 !--    Humidity and cloud parameters
-       IF ( humidity ) THEN
-          sums(:,44) = sums(:,44) / ngp_2dh_s_inner(:,sr)
-          sums(:,41) = sums(:,41) / ngp_2dh_s_inner(:,sr)
+       IF ( moisture ) THEN
+          sums(:,44) = sums(:,44) / ngp_2dh_outer(:,sr)
+          sums(:,41) = sums(:,41) / ngp_2dh_outer(:,sr)
           hom(:,1,44,sr) = sums(:,44)             ! vpt
           hom(:,1,41,sr) = sums(:,41)             ! qv (q)
-          IF ( bulk_cloud_model ) THEN
-             sums(:,42) = sums(:,42) / ngp_2dh_s_inner(:,sr)
-             sums(:,43) = sums(:,43) / ngp_2dh_s_inner(:,sr)
+          IF ( cloud_physics ) THEN
+             sums(:,42) = sums(:,42) / ngp_2dh_outer(:,sr)
+             sums(:,43) = sums(:,43) / ngp_2dh_outer(:,sr)
              hom(:,1,42,sr) = sums(:,42)             ! qv
              hom(:,1,43,sr) = sums(:,43)             ! pt
@@ -525,407 +325,135 @@
 !
 !--    Passive scalar
-       IF ( passive_scalar )  hom(:,1,115,sr) = sums(:,115) / ngp_2dh_s_inner(:,sr)  ! s
-
-!
-!--    Horizontally averaged profiles of the remaining prognostic variables, variances, the total
-!--    and the perturbation energy (single values in last column of sums_l) and some diagnostic
-!--    quantities.
-!--    NOTE: for simplicity, nzb_s_inner is used below, although strictly speaking the following
-!--    ----  k-loop would have to be split up and rearranged according to the staggered grid.
-!--          However, this implies no error since staggered velocity components are zero at the
-!--          walls and inside buildings.
+       IF ( passive_scalar )  hom(:,1,41,sr) = sums(:,41) / ngp_2dh_outer(:,sr)
+
+!
+!--    Horizontally averaged profiles of the remaining prognostic variables,
+!--    variances, the total and the perturbation energy (single values in last
+!--    column of sums_l) and some diagnostic quantities.
+!--    NOTE: for simplicity, nzb_s_outer is used below, although strictly 
+!--    ----  speaking the following k-loop would have to be split up and 
+!--          rearranged according to the staggered grid.
        tn = 0
-       !$OMP PARALLEL PRIVATE( i, j, k, pts, sums_ll,                          &
-       !$OMP                   sums_l_etot, tn, ust, ust2, u2, vst, vst2, v2,  &
-       !$OMP                   w2, flag, m, ki, l )
-       !$ tn = omp_get_thread_num()
+#if defined( __lcmuk )
+       !$OMP PARALLEL PRIVATE( i, j, k, pts, sums_ll, sums_l_eper, sums_l_etot, &
+       !$OMP                    tn, ust, ust2, u2, vst, vst2, v2, w2 )
+       tn = omp_get_thread_num()
+#else
+       !$OMP PARALLEL PRIVATE( i, j, k, pts, sums_ll, sums_l_eper, sums_l_etot, tn, ust, ust2, u2, vst, vst2, v2, w2 )
+!$     tn = omp_get_thread_num()
+#endif
        !$OMP DO
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, m) &
-       !$ACC PRIVATE(sums_l_etot, flag, du_dx, du_dy, du_dz) &
-       !$ACC PRIVATE(dv_dx, dv_dy, dv_dz, dw_dx, dw_dy, dw_dz) &
-       !$ACC PRIVATE(s11, s21, s31, s12, s22, s32, s13, s23, s33) &
-       !$ACC PRIVATE(dissipation, eta) &
-       !$ACC PRESENT(wall_flags_total_0, rmask, momentumflux_output_conversion) &
-       !$ACC PRESENT(hom(:,1,1:2,sr), hom(:,1,4,sr)) &
-       !$ACC PRESENT(e, u, v, w, km, kh, p, pt) &
-       !$ACC PRESENT(ddx, ddy, ddzu, ddzw) &
-       !$ACC PRESENT(surf_def_h(0), surf_lsm_h(0), surf_usm_h(0)) &
-       !$ACC PRESENT(sums_l)
        DO  i = nxl, nxr
           DO  j =  nys, nyn
-             sums_l_etot = 0.0_wp
-             DO  k = nzb, nzt+1
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 22 ) )
-!
-!--             Prognostic and diagnostic variables
-                !$ACC ATOMIC
-                sums_l(k,3,tn)  = sums_l(k,3,tn)  + w(k,j,i)  * rmask(j,i,sr) * flag
-                !$ACC ATOMIC
-                sums_l(k,8,tn)  = sums_l(k,8,tn)  + e(k,j,i)  * rmask(j,i,sr) * flag
-                !$ACC ATOMIC
-                sums_l(k,9,tn)  = sums_l(k,9,tn)  + km(k,j,i) * rmask(j,i,sr) * flag
-                !$ACC ATOMIC
-                sums_l(k,10,tn) = sums_l(k,10,tn) + kh(k,j,i) * rmask(j,i,sr) * flag
-                !$ACC ATOMIC
-                sums_l(k,40,tn) = sums_l(k,40,tn) + ( p(k,j,i)                                     &
-                                         / momentumflux_output_conversion(k) ) * flag
-
-                !$ACC ATOMIC
-                sums_l(k,33,tn) = sums_l(k,33,tn) + &
-                                  ( pt(k,j,i)-hom(k,1,4,sr) )**2 * rmask(j,i,sr) * flag
-#ifndef _OPENACC
-                IF ( humidity )  THEN
-                   sums_l(k,70,tn) = sums_l(k,70,tn) +                                             &
-                                     ( q(k,j,i)-hom(k,1,41,sr) )**2 * rmask(j,i,sr) * flag
-                ENDIF
-                IF ( passive_scalar )  THEN
-                   sums_l(k,116,tn) = sums_l(k,116,tn) +                                           &
-                                      ( s(k,j,i)-hom(k,1,115,sr) )**2 * rmask(j,i,sr) * flag
-                ENDIF
-#endif
-!
-!--             Higher moments
-!--             (Computation of the skewness of w further below)
-                !$ACC ATOMIC
-                sums_l(k,38,tn) = sums_l(k,38,tn) + w(k,j,i)**3 * rmask(j,i,sr) * flag
-
-                sums_l_etot  = sums_l_etot + 0.5_wp * ( u(k,j,i)**2 + v(k,j,i)**2 + w(k,j,i)**2 )  &
-                                             * rmask(j,i,sr) * flag
-
-!
-!--             Computation of the Kolmogorov length scale. Calculation is based on gradients of the
-!--             deviations from the horizontal mean.
-!--             Kolmogorov scale at the boundaries (k=0/z=0m and k=nzt+1) is set to zero.
-                IF ( kolmogorov_length_scale .AND. k /= nzb .AND. k /= nzt+1) THEN
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 22 ) )
-
-!
-!--                Calculate components of the fluctuating rate-of-strain tensor
-!--                (0.5*(del u'_i/del x_j + del u'_j/del x_i)) defined in the center of each grid
-!--                box.
-                   du_dx = ( ( u(k,j,i+1) - hom(k,1,1,sr) ) -                                      &
-                             ( u(k,j,i) - hom(k,1,1,sr) ) ) * ddx
-                   du_dy = 0.25_wp * ddy *                                                         &
-                           ( ( u(k,j+1,i) - hom(k,1,1,sr) ) -                                      &
-                             ( u(k,j-1,i) - hom(k,1,1,sr) ) +                                      &
-                             ( u(k,j+1,i+1) - hom(k,1,1,sr) ) -                                    &
-                             ( u(k,j-1,i+1) - hom(k,1,1,sr) ) )
-                   du_dz = 0.25_wp * ( ( ( u(k+1,j,i) - hom(k+1,1,1,sr) ) -                        &
-                                         ( u(k,j,i) - hom(k,1,1,sr) ) ) *                          &
-                                       ddzu(k+1) +                                                 &
-                                       ( ( u(k,j,i) - hom(k,1,1,sr) ) -                            &
-                                         ( u(k-1,j,i) - hom(k-1,1,1,sr) ) ) *                      &
-                                       ddzu(k) +                                                   &
-                                       ( ( u(k+1,j,i+1) - hom(k+1,1,1,sr) ) -                      &
-                                         ( u(k,j,i+1) - hom(k,1,1,sr) ) ) *                        &
-                                       ddzu(k+1) +                                                 &
-                                       ( ( u(k,j,i+1) - hom(k,1,1,sr) ) -                          &
-                                         ( u(k-1,j,i+1) - hom(k-1,1,1,sr) ) ) *                    &
-                                       ddzu(k) )
-
-                   dv_dx = 0.25_wp * ddx *                                                         &
-                           ( ( v(k,j,i+1) - hom(k,1,2,sr) ) -                                      &
-                             ( v(k,j,i-1) - hom(k,1,2,sr) ) +                                      &
-                             ( v(k,j+1,i+1) - hom(k,1,2,sr) ) -                                    &
-                             ( v(k,j+1,i-1) - hom(k,1,2,sr) ) )
-                   dv_dy = ( ( v(k,j+1,i) - hom(k,1,2,sr) ) - ( v(k,j,i) - hom(k,1,2,sr) ) ) * ddy
-                   dv_dz = 0.25_wp * ( ( ( v(k+1,j,i) - hom(k+1,1,2,sr) ) -                        &
-                                         ( v(k,j,i) - hom(k,1,2,sr) ) ) *                          &
-                                       ddzu(k+1) +                                                 &
-                                       ( ( v(k,j,i) - hom(k,1,2,sr) ) -                            &
-                                         ( v(k-1,j,i) - hom(k-1,1,2,sr) ) ) *                      &
-                                       ddzu(k) +                                                   &
-                                       ( ( v(k+1,j+1,i) - hom(k+1,1,2,sr) ) -                      &
-                                         ( v(k,j+1,i) - hom(k,1,2,sr) ) ) *                        &
-                                       ddzu(k+1) +                                                 &
-                                       ( ( v(k,j+1,i) - hom(k,1,2,sr) ) -                          &
-                                         ( v(k-1,j+1,i) - hom(k-1,1,2,sr) ) ) *                    &
-                                       ddzu(k) )
-
-                   dw_dx = 0.25_wp * ddx * ( w(k,j,i+1) - w(k,j,i-1) + w(k-1,j,i+1) - w(k-1,j,i-1) )
-                   dw_dy = 0.25_wp * ddy * ( w(k,j+1,i) - w(k,j-1,i) + w(k-1,j+1,i) - w(k-1,j-1,i) )
-                   dw_dz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
-
-                   s11 = 0.5_wp * ( du_dx + du_dx )
-                   s21 = 0.5_wp * ( dv_dx + du_dy )
-                   s31 = 0.5_wp * ( dw_dx + du_dz )
-
-                   s12 = s21
-                   s22 = 0.5 * ( dv_dy + dv_dy )
-                   s32 = 0.5 * ( dw_dy + dv_dz )
-
-                   s13 = s31
-                   s23 = s32
-                   s33 = 0.5_wp * ( dw_dz + dw_dz )
-
-!--                Calculate 3D instantaneous energy dissipation rate following Pope (2000):
-!--                Turbulent flows, p.259. It is defined in the center of each grid volume.
-                   dissipation = 2.0_wp * km(k,j,i) *                                              &
-                                ( s11*s11 + s21*s21 + s31*s31 +                                    &
-                                  s12*s12 + s22*s22 + s32*s32 +                                    &
-                                  s13*s13 + s23*s23 + s33*s33 )
-                   eta         = ( km(k,j,i)**3.0_wp / ( dissipation+1.0E-12 ) )**(1.0_wp/4.0_wp)
-
-                   !$ACC ATOMIC
-                   sums_l(k,121,tn) = sums_l(k,121,tn) + eta * rmask(j,i,sr) * flag
-
-
-                ENDIF !Kolmogorov length scale
-
-             ENDDO !k-loop
-!
-!--          Total and perturbation energy for the total domain (being collected in the last column
-!--          of sums_l). Summation of these quantities is seperated from the previous loop in order
-!--          to allow vectorization of that loop.
-             !$ACC ATOMIC
-             sums_l(nzb+4,pr_palm,tn) = sums_l(nzb+4,pr_palm,tn) + sums_l_etot
-!
-!--          2D-arrays (being collected in the last column of sums_l)
-             IF ( surf_def_h(0)%end_index(j,i) >= surf_def_h(0)%start_index(j,i) )  THEN
-                m = surf_def_h(0)%start_index(j,i)
-                !$ACC ATOMIC
-                sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +                                &
-                                           surf_def_h(0)%us(m)   * rmask(j,i,sr)
-                !$ACC ATOMIC
-                sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +                              &
-                                           surf_def_h(0)%usws(m) * rmask(j,i,sr)
-                !$ACC ATOMIC
-                sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +                              &
-                                           surf_def_h(0)%vsws(m) * rmask(j,i,sr)
-                !$ACC ATOMIC
-                sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +                              &
-                                           surf_def_h(0)%ts(m)   * rmask(j,i,sr)
-#ifndef _OPENACC
-                IF ( humidity )  THEN
-                   sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +                         &
-                                               surf_def_h(0)%qs(m)   * rmask(j,i,sr)
-                ENDIF
-                IF ( passive_scalar )  THEN
-                   sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) +                         &
-                                               surf_def_h(0)%ss(m)   * rmask(j,i,sr)
-                ENDIF
-#endif
-!
-!--             Summation of surface temperature.
-                !$ACC ATOMIC
-                sums_l(nzb+14,pr_palm,tn) = sums_l(nzb+14,pr_palm,tn)   +                          &
-                                            surf_def_h(0)%pt_surface(m) * rmask(j,i,sr)
-             ENDIF
-             IF ( surf_lsm_h(0)%end_index(j,i) >= surf_lsm_h(0)%start_index(j,i) )  THEN
-                m = surf_lsm_h(0)%start_index(j,i)
-                !$ACC ATOMIC
-                sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +                                &
-                                           surf_lsm_h(0)%us(m)   * rmask(j,i,sr)
-                !$ACC ATOMIC
-                sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +                              &
-                                           surf_lsm_h(0)%usws(m) * rmask(j,i,sr)
-                !$ACC ATOMIC
-                sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +                              &
-                                           surf_lsm_h(0)%vsws(m) * rmask(j,i,sr)
-                !$ACC ATOMIC
-                sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +                              &
-                                           surf_lsm_h(0)%ts(m)   * rmask(j,i,sr)
-#ifndef _OPENACC
-                IF ( humidity )  THEN
-                   sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +                         &
-                                               surf_lsm_h(0)%qs(m)   * rmask(j,i,sr)
-                ENDIF
-                IF ( passive_scalar )  THEN
-                   sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) +                         &
-                                               surf_lsm_h(0)%ss(m)   * rmask(j,i,sr)
-                ENDIF
-#endif
-!
-!--             Summation of surface temperature.
-                !$ACC ATOMIC
-                sums_l(nzb+14,pr_palm,tn) = sums_l(nzb+14,pr_palm,tn) +                            &
-                                            surf_lsm_h(0)%pt_surface(m) * rmask(j,i,sr)
-             ENDIF
-             IF ( surf_usm_h(0)%end_index(j,i) >= surf_usm_h(0)%start_index(j,i) )  THEN
-                m = surf_usm_h(0)%start_index(j,i)
-                !$ACC ATOMIC
-                sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +                                &
-                                           surf_usm_h(0)%us(m)   * rmask(j,i,sr)
-                !$ACC ATOMIC
-                sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +                              &
-                                           surf_usm_h(0)%usws(m) * rmask(j,i,sr)
-                !$ACC ATOMIC
-                sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +                              &
-                                           surf_usm_h(0)%vsws(m) * rmask(j,i,sr)
-                !$ACC ATOMIC
-                sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +                              &
-                                           surf_usm_h(0)%ts(m)   * rmask(j,i,sr)
-#ifndef _OPENACC
-                IF ( humidity )  THEN
-                   sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +                         &
-                                               surf_usm_h(0)%qs(m)   * rmask(j,i,sr)
-                ENDIF
-                IF ( passive_scalar )  THEN
-                   sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) +                         &
-                                               surf_usm_h(0)%ss(m) * rmask(j,i,sr)
-                ENDIF
-#endif
-!
-!--             Summation of surface temperature.
-                !$ACC ATOMIC
-                sums_l(nzb+14,pr_palm,tn) = sums_l(nzb+14,pr_palm,tn) +                            &
-                                            surf_usm_h(0)%pt_surface(m)  * rmask(j,i,sr)
-             ENDIF
-          ENDDO !j-loop
-       ENDDO !i-loop
-       !$ACC UPDATE &
-       !$ACC HOST(sums_l(:,3,tn), sums_l(:,8,tn), sums_l(:,9,tn)) &
-       !$ACC HOST(sums_l(:,10,tn), sums_l(:,40,tn), sums_l(:,33,tn)) &
-       !$ACC HOST(sums_l(:,38,tn), sums_l(:,121,tn)) &
-       !$ACC HOST(sums_l(nzb:nzb+4,pr_palm,tn), sums_l(nzb+14:nzb+14,pr_palm,tn))
-
-!
-!--    Computation of statistics when ws-scheme is not used. Else these
-!--    quantities are evaluated in the advection routines.
-       IF ( .NOT. ws_scheme_mom .OR. sr /= 0 .OR. simulated_time == 0.0_wp )  THEN
-          !$OMP DO
-          DO  i = nxl, nxr
-             DO  j =  nys, nyn
-                DO  k = nzb, nzt+1
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 22 ) )
-
-                   u2   = u(k,j,i)**2
-                   v2   = v(k,j,i)**2
-                   w2   = w(k,j,i)**2
-                   ust2 = ( u(k,j,i) - hom(k,1,1,sr) )**2
-                   vst2 = ( v(k,j,i) - hom(k,1,2,sr) )**2
-
-                   sums_l(k,30,tn) = sums_l(k,30,tn) + ust2 * rmask(j,i,sr) * flag
-                   sums_l(k,31,tn) = sums_l(k,31,tn) + vst2 * rmask(j,i,sr) * flag
-                   sums_l(k,32,tn) = sums_l(k,32,tn) + w2   * rmask(j,i,sr) * flag
-!
-!--                Perturbation energy
-                   sums_l(k,34,tn) = sums_l(k,34,tn) +                                             &
-                                     0.5_wp * ( ust2 + vst2 + w2 ) * rmask(j,i,sr) * flag
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-!
-!--    Computaion of domain-averaged perturbation energy. Please note, to prevent that perturbation
-!--    energy is larger (even if only slightly) than the total kinetic energy, calculation is based
-!--    on deviations from the horizontal mean, instead of spatial descretization of the advection
-!--    term.
-       !$OMP DO
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag, w2, ust2, vst2) &
-       !$ACC PRESENT(wall_flags_total_0, u, v, w, rmask, hom(:,1,1:2,sr)) &
-       !$ACC PRESENT(sums_l)
-       DO  i = nxl, nxr
-          DO  j =  nys, nyn
-             DO  k = nzb, nzt+1
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 22 ) )
-
+             sums_l_etot = 0.0
+             sums_l_eper = 0.0
+             DO  k = nzb_s_outer(j,i), nzt+1
+                u2   = u(k,j,i)**2
+                v2   = v(k,j,i)**2
                 w2   = w(k,j,i)**2
                 ust2 = ( u(k,j,i) - hom(k,1,1,sr) )**2
                 vst2 = ( v(k,j,i) - hom(k,1,2,sr) )**2
-                w2   = w(k,j,i)**2
-
-                !$ACC ATOMIC
-                sums_l(nzb+5,pr_palm,tn) = sums_l(nzb+5,pr_palm,tn)                                &
-                                           + 0.5_wp * ( ust2 + vst2 + w2 ) * rmask(j,i,sr) * flag
-
-             ENDDO
+!
+!--             Prognostic and diagnostic variables
+                sums_l(k,3,tn)  = sums_l(k,3,tn)  + w(k,j,i)  * rmask(j,i,sr)
+                sums_l(k,8,tn)  = sums_l(k,8,tn)  + e(k,j,i)  * rmask(j,i,sr)
+                sums_l(k,9,tn)  = sums_l(k,9,tn)  + km(k,j,i) * rmask(j,i,sr)
+                sums_l(k,10,tn) = sums_l(k,10,tn) + kh(k,j,i) * rmask(j,i,sr)
+                sums_l(k,40,tn) = sums_l(k,40,tn) + p(k,j,i)
+
+!
+!--             Variances
+                sums_l(k,30,tn) = sums_l(k,30,tn) + ust2 * rmask(j,i,sr)
+                sums_l(k,31,tn) = sums_l(k,31,tn) + vst2 * rmask(j,i,sr)
+                sums_l(k,32,tn) = sums_l(k,32,tn) + w2   * rmask(j,i,sr)
+                sums_l(k,33,tn) = sums_l(k,33,tn) + &
+                                  ( pt(k,j,i)-hom(k,1,4,sr) )**2 * rmask(j,i,sr)
+!
+!--             Higher moments
+!--             (Computation of the skewness of w further below)
+                sums_l(k,38,tn) = sums_l(k,38,tn) + w(k,j,i) * w2 * &
+                                                    rmask(j,i,sr)
+!
+!--             Perturbation energy
+                sums_l(k,34,tn) = sums_l(k,34,tn) + 0.5 * ( ust2 + vst2 + w2 ) &
+                                                    * rmask(j,i,sr)
+                sums_l_etot  = sums_l_etot + &
+                                        0.5 * ( u2 + v2 + w2 ) * rmask(j,i,sr)
+                sums_l_eper  = sums_l_eper + &
+                                        0.5 * ( ust2+vst2+w2 ) * rmask(j,i,sr)
+             ENDDO
+!
+!--          Total and perturbation energy for the total domain (being
+!--          collected in the last column of sums_l). Summation of these
+!--          quantities is seperated from the previous loop in order to
+!--          allow vectorization of that loop.
+             sums_l(nzb+4,var_sum,tn) = sums_l(nzb+4,var_sum,tn) + sums_l_etot
+             sums_l(nzb+5,var_sum,tn) = sums_l(nzb+5,var_sum,tn) + sums_l_eper
+!
+!--          2D-arrays (being collected in the last column of sums_l)
+             sums_l(nzb,var_sum,tn)   = sums_l(nzb,var_sum,tn) +   &
+                                        us(j,i)   * rmask(j,i,sr)
+             sums_l(nzb+1,var_sum,tn) = sums_l(nzb+1,var_sum,tn) + &
+                                        usws(j,i) * rmask(j,i,sr)
+             sums_l(nzb+2,var_sum,tn) = sums_l(nzb+2,var_sum,tn) + &
+                                        vsws(j,i) * rmask(j,i,sr)
+             sums_l(nzb+3,var_sum,tn) = sums_l(nzb+3,var_sum,tn) + &
+                                        ts(j,i)   * rmask(j,i,sr)
           ENDDO
        ENDDO
-       !$ACC UPDATE HOST(sums_l(nzb+5:nzb+5,pr_palm,tn))
 
 !
 !--    Horizontally averaged profiles of the vertical fluxes
        !$OMP DO
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, l, m) &
-       !$ACC PRIVATE(ki, flag, ust, vst, pts) &
-       !$ACC PRESENT(kh, km, u, v, w, pt) &
-       !$ACC PRESENT(wall_flags_total_0, rmask, ddzu, rho_air_zw, hom(:,1,1:4,sr)) &
-       !$ACC PRESENT(heatflux_output_conversion, momentumflux_output_conversion) &
-       !$ACC PRESENT(surf_def_h(0:2), surf_lsm_h(0:1), surf_usm_h(0:1)) &
-       !$ACC PRESENT(sums_l)
        DO  i = nxl, nxr
           DO  j = nys, nyn
 !
-!--          Subgridscale fluxes (without Prandtl layer from k=nzb, oterwise from k=nzb+1)
-!--          NOTE: for simplicity, nzb_diff_s_inner is used below, although strictly speaking the
-!--          ----  following k-loop would have to be split up according to the staggered grid.
-!--                However, this implies no error since staggered velocity components are zero at
-!--                the walls and inside buildings.
-!--          Flag 23 is used to mask surface fluxes as well as model-top fluxes, which are added
-!--          further below.
-             DO  k = nzb, nzt
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 23 ) ) *           &
-                       MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 9  ) )
+!--          Subgridscale fluxes (without Prandtl layer from k=nzb, 
+!--          oterwise from k=nzb+1)
+!--          NOTE: for simplicity, nzb_diff_s_outer is used below, although
+!--          ----  strictly speaking the following k-loop would have to be
+!--                split up according to the staggered grid.
+             DO  k = nzb_diff_s_outer(j,i)-1, nzt
 !
 !--             Momentum flux w"u"
-                !$ACC ATOMIC
-                sums_l(k,12,tn) = sums_l(k,12,tn) - 0.25_wp * (                                    &
-                                  km(k,j,i) + km(k+1,j,i) + km(k,j,i-1) + km(k+1,j,i-1)            &
-                                                              ) * (                                &
-                                      ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)                      &
-                                    + ( w(k,j,i)   - w(k,j,i-1) ) * ddx                            &
-                                                                  ) * rmask(j,i,sr)                &
-                                            * rho_air_zw(k)                                        &
-                                            * momentumflux_output_conversion(k)                    &
-                                            * flag
+                sums_l(k,12,tn) = sums_l(k,12,tn) - 0.25 * (                   &
+                               km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) &
+                                                           ) * (               &
+                                   ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
+                                 + ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
+                                                               ) * rmask(j,i,sr)
 !
 !--             Momentum flux w"v"
-                !$ACC ATOMIC
-                sums_l(k,14,tn) = sums_l(k,14,tn) - 0.25_wp * (                                    &
-                                  km(k,j,i) + km(k+1,j,i) + km(k,j-1,i) + km(k+1,j-1,i)            &
-                                                              ) * (                                &
-                                      ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)                      &
-                                    + ( w(k,j,i)   - w(k,j-1,i) ) * ddy                            &
-                                                                  ) * rmask(j,i,sr)                &
-                                            * rho_air_zw(k)                                        &
-                                            * momentumflux_output_conversion(k)                    &
-                                            * flag
+                sums_l(k,14,tn) = sums_l(k,14,tn) - 0.25 * (                   &
+                               km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) &
+                                                           ) * (               &
+                                   ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
+                                 + ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
+                                                               ) * rmask(j,i,sr)
 !
 !--             Heat flux w"pt"
-                !$ACC ATOMIC
-                sums_l(k,16,tn) = sums_l(k,16,tn)                                                  &
-                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )                    &
-                                               * ( pt(k+1,j,i) - pt(k,j,i) )                       &
-                                               * rho_air_zw(k)                                     &
-                                               * heatflux_output_conversion(k)                     &
-                                               * ddzu(k+1) * rmask(j,i,sr)                         &
-                                               * flag
-
-!
-!--             Salinity flux w"sa"
-#ifndef _OPENACC
-                IF ( ocean_mode )  THEN
-                   sums_l(k,65,tn) = sums_l(k,65,tn)                                               &
-                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )                    &
-                                               * ( sa(k+1,j,i) - sa(k,j,i) )                       &
-                                               * ddzu(k+1) * rmask(j,i,sr)                         &
-                                               * flag
-                ENDIF
+                sums_l(k,16,tn) = sums_l(k,16,tn)                              &
+                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
+                                               * ( pt(k+1,j,i) - pt(k,j,i) )   &
+                                               * ddzu(k+1) * rmask(j,i,sr)
+
 
 !
 !--             Buoyancy flux, water flux (humidity flux) w"q"
-                IF ( humidity ) THEN
-                   sums_l(k,45,tn) = sums_l(k,45,tn)                                               &
-                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )                    &
-                                               * ( vpt(k+1,j,i) - vpt(k,j,i) )                     &
-                                               * rho_air_zw(k)                                     &
-                                               * heatflux_output_conversion(k)                     &
-                                               * ddzu(k+1) * rmask(j,i,sr) * flag
-                   sums_l(k,48,tn) = sums_l(k,48,tn)                                               &
-                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )                    &
-                                               * ( q(k+1,j,i) - q(k,j,i) )                         &
-                                               * rho_air_zw(k)                                     &
-                                               * waterflux_output_conversion(k)                    &
-                                               * ddzu(k+1) * rmask(j,i,sr) * flag
-
-                   IF ( bulk_cloud_model ) THEN
-                      sums_l(k,51,tn) = sums_l(k,51,tn)                                            &
-                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )                    &
-                                               * ( ( q(k+1,j,i) - ql(k+1,j,i) )                    &
-                                                - ( q(k,j,i) - ql(k,j,i) ) )                       &
-                                               * rho_air_zw(k)                                     &
-                                               * waterflux_output_conversion(k)                    &
-                                               * ddzu(k+1) * rmask(j,i,sr) * flag
+                IF ( moisture ) THEN
+                   sums_l(k,45,tn) = sums_l(k,45,tn)                           &
+                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
+                                               * ( vpt(k+1,j,i) - vpt(k,j,i) ) &
+                                               * ddzu(k+1) * rmask(j,i,sr)
+                   sums_l(k,48,tn) = sums_l(k,48,tn)                           &
+                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
+                                               * ( q(k+1,j,i) - q(k,j,i) )     &
+                                               * ddzu(k+1) * rmask(j,i,sr)
+                   IF ( cloud_physics ) THEN
+                      sums_l(k,51,tn) = sums_l(k,51,tn)                        &
+                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
+                                               * ( ( q(k+1,j,i) - ql(k+1,j,i) )&
+                                                - ( q(k,j,i) - ql(k,j,i) ) )   &
+                                               * ddzu(k+1) * rmask(j,i,sr) 
                    ENDIF
                 ENDIF
@@ -934,11 +462,9 @@
 !--             Passive scalar flux
                 IF ( passive_scalar )  THEN
-                   sums_l(k,117,tn) = sums_l(k,117,tn)                                             &
-                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )                    &
-                                                  * ( s(k+1,j,i) - s(k,j,i) )                      &
-                                                  * ddzu(k+1) * rmask(j,i,sr)                      &
-                                                              * flag
+                   sums_l(k,48,tn) = sums_l(k,48,tn)                           &
+                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
+                                               * ( q(k+1,j,i) - q(k,j,i) )     &
+                                               * ddzu(k+1) * rmask(j,i,sr)
                 ENDIF
-#endif
 
              ENDDO
@@ -947,820 +473,222 @@
 !--          Subgridscale fluxes in the Prandtl layer
              IF ( use_surface_fluxes )  THEN
-                DO  l = 0, 1
-                   ! The original code using MERGE doesn't work with the PGI
-                   ! compiler when running on the GPU.
-                   ! This is submitted as a compiler Bug in PGI ticket TPR#26718
-                   ! ki = MERGE( -1, 0, l == 0 )
-                   ki = -1 + l
-                   IF ( surf_def_h(l)%ns >= 1 )  THEN
-                      DO  m = surf_def_h(l)%start_index(j,i),                                      &
-                              surf_def_h(l)%end_index(j,i)
-                         k = surf_def_h(l)%k(m)
-
-                         !$ACC ATOMIC
-                         sums_l(k+ki,12,tn) = sums_l(k+ki,12,tn) +                                 &
-                                              momentumflux_output_conversion(k+ki) *               &
-                                              surf_def_h(l)%usws(m) * rmask(j,i,sr)     ! w"u"
-                         !$ACC ATOMIC
-                         sums_l(k+ki,14,tn) = sums_l(k+ki,14,tn) +                                 &
-                                              momentumflux_output_conversion(k+ki) *               &
-                                              surf_def_h(l)%vsws(m) * rmask(j,i,sr)     ! w"v"
-                         !$ACC ATOMIC
-                         sums_l(k+ki,16,tn) = sums_l(k+ki,16,tn) +                                 &
-                                              heatflux_output_conversion(k+ki) *                   &
-                                              surf_def_h(l)%shf(m)  * rmask(j,i,sr)     ! w"pt"
-#if 0
-                         sums_l(k+ki,58,tn) = sums_l(k+ki,58,tn) +                                 &
-                                              0.0_wp * rmask(j,i,sr)                    ! u"pt"
-                         sums_l(k+ki,61,tn) = sums_l(k+ki,61,tn) +                                 &
-                                              0.0_wp * rmask(j,i,sr)                    ! v"pt"
-#endif
-#ifndef _OPENACC
-                         IF ( ocean_mode )  THEN
-                            sums_l(k+ki,65,tn) = sums_l(k+ki,65,tn) +                              &
-                                                 surf_def_h(l)%sasws(m) * rmask(j,i,sr)  ! w"sa"
-                         ENDIF
-                         IF ( humidity )  THEN
-                            sums_l(k+ki,48,tn) = sums_l(k+ki,48,tn) +                              &
-                                                 waterflux_output_conversion(k+ki) *               &
-                                                 surf_def_h(l)%qsws(m) * rmask(j,i,sr)  ! w"q" (w"qv")
-                            sums_l(k+ki,45,tn) = sums_l(k+ki,45,tn) +  (                           &
-                                                 ( 1.0_wp + 0.61_wp * q(k+ki,j,i) ) *              &
-                                                 surf_def_h(l)%shf(m) + 0.61_wp * pt(k+ki,j,i) *   &
-                                                 surf_def_h(l)%qsws(m) )                           &
-                                                 * heatflux_output_conversion(k+ki)
-                            IF ( cloud_droplets )  THEN
-                               sums_l(k+ki,45,tn) = sums_l(k+ki,45,tn) +      (                    &
-                                                    ( 1.0_wp + 0.61_wp * q(k+ki,j,i) -             &
-                                                      ql(k+ki,j,i) ) * surf_def_h(l)%shf(m) +      &
-                                                      0.61_wp * pt(k+ki,j,i)                       &
-                                                      * surf_def_h(l)%qsws(m) )                    &
-                                                    * heatflux_output_conversion(k+ki)
-                            ENDIF
-                            IF ( bulk_cloud_model )  THEN
-!
-!--                            Formula does not work if ql(k+ki) /= 0.0
-                               sums_l(k+ki,51,tn) = sums_l(k+ki,51,tn) +                           &
-                                                    waterflux_output_conversion(k+ki) *            &
-                                                    surf_def_h(l)%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
-                            ENDIF
-                         ENDIF
-                         IF ( passive_scalar )  THEN
-                            sums_l(k+ki,117,tn) = sums_l(k+ki,117,tn) +                            &
-                                                  surf_def_h(l)%ssws(m) * rmask(j,i,sr) ! w"s"
-                         ENDIF
-#endif
-
-                      ENDDO
-
-                   ENDIF
-                   IF ( surf_lsm_h(l)%end_index(j,i) >= surf_lsm_h(l)%start_index(j,i) )  THEN
-                      m = surf_lsm_h(l)%start_index(j,i)
-                      !$ACC ATOMIC
-                      sums_l(nzb,12,tn) = sums_l(nzb,12,tn) +                                         &
-                                          momentumflux_output_conversion(nzb) *                       &
-                                          surf_lsm_h(l)%usws(m) * rmask(j,i,sr)     ! w"u"
-                      !$ACC ATOMIC
-                      sums_l(nzb,14,tn) = sums_l(nzb,14,tn) +                                         &
-                                          momentumflux_output_conversion(nzb) *                       &
-                                          surf_lsm_h(l)%vsws(m) * rmask(j,i,sr)     ! w"v"
-                      !$ACC ATOMIC
-                      sums_l(nzb,16,tn) = sums_l(nzb,16,tn) +                                         &
-                                          heatflux_output_conversion(nzb) *                           &
-                                          surf_lsm_h(l)%shf(m)  * rmask(j,i,sr)     ! w"pt"
-#if 0
-                      sums_l(nzb,58,tn) = sums_l(nzb,58,tn) +                                         &
-                                          0.0_wp * rmask(j,i,sr)        ! u"pt"
-                      sums_l(nzb,61,tn) = sums_l(nzb,61,tn) +                                         &
-                                          0.0_wp * rmask(j,i,sr)        ! v"pt"
-#endif
-#ifndef _OPENACC
-                      IF ( ocean_mode )  THEN
-                         sums_l(nzb,65,tn) = sums_l(nzb,65,tn) +                                      &
-                                             surf_lsm_h(l)%sasws(m) * rmask(j,i,sr)  ! w"sa"
-                      ENDIF
-                      IF ( humidity )  THEN
-                         sums_l(nzb,48,tn) = sums_l(nzb,48,tn) +                                      &
-                                             waterflux_output_conversion(nzb) *                       &
-                                             surf_lsm_h(l)%qsws(m) * rmask(j,i,sr)  ! w"q" (w"qv")
-                         sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                                    &
-                                             ( 1.0_wp + 0.61_wp * q(nzb,j,i) ) * surf_lsm_h(l)%shf(m) +  &
-                                               0.61_wp * pt(nzb,j,i) * surf_lsm_h(l)%qsws(m) )           &
-                                             * heatflux_output_conversion(nzb)
-                         IF ( cloud_droplets )  THEN
-                            sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                                 &
-                                                ( 1.0_wp + 0.61_wp * q(nzb,j,i) -                     &
-                                                  ql(nzb,j,i) ) * surf_lsm_h(l)%shf(m) +                 &
-                                                  0.61_wp * pt(nzb,j,i) * surf_lsm_h(l)%qsws(m) )        &
-                                                * heatflux_output_conversion(nzb)
-                         ENDIF
-                         IF ( bulk_cloud_model )  THEN
-!
-!--                         Formula does not work if ql(nzb) /= 0.0
-                            sums_l(nzb,51,tn) = sums_l(nzb,51,tn) +                                   &
-                                                waterflux_output_conversion(nzb) *                    &
-                                                surf_lsm_h(l)%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
-                         ENDIF
-                      ENDIF
-                      IF ( passive_scalar )  THEN
-                         sums_l(nzb,117,tn) = sums_l(nzb,117,tn) +                                    &
-                                              surf_lsm_h(l)%ssws(m) * rmask(j,i,sr) ! w"s"
-                      ENDIF
-#endif
-
-                   ENDIF
-                   IF ( surf_usm_h(l)%end_index(j,i) >= surf_usm_h(l)%start_index(j,i) )  THEN
-                      m = surf_usm_h(l)%start_index(j,i)
-                      !$ACC ATOMIC
-                      sums_l(nzb,12,tn) = sums_l(nzb,12,tn) +                                         &
-                                          momentumflux_output_conversion(nzb) *                       &
-                                          surf_usm_h(l)%usws(m) * rmask(j,i,sr)                ! w"u"
-                      !$ACC ATOMIC
-                      sums_l(nzb,14,tn) = sums_l(nzb,14,tn) +                                         &
-                                          momentumflux_output_conversion(nzb) *                       &
-                                          surf_usm_h(l)%vsws(m) * rmask(j,i,sr)                ! w"v"
-                      !$ACC ATOMIC
-                      sums_l(nzb,16,tn) = sums_l(nzb,16,tn) +                                         &
-                                          heatflux_output_conversion(nzb) *                           &
-                                          surf_usm_h(l)%shf(m)  * rmask(j,i,sr)                ! w"pt"
-#if 0
-                      sums_l(nzb,58,tn) = sums_l(nzb,58,tn) + 0.0_wp * rmask(j,i,sr)        ! u"pt"
-                      sums_l(nzb,61,tn) = sums_l(nzb,61,tn) + 0.0_wp * rmask(j,i,sr)        ! v"pt"
-#endif
-#ifndef _OPENACC
-                      IF ( ocean_mode )  THEN
-                         sums_l(nzb,65,tn) = sums_l(nzb,65,tn) +                                      &
-                                             surf_usm_h(l)%sasws(m) * rmask(j,i,sr)            ! w"sa"
-                      ENDIF
-                      IF ( humidity )  THEN
-                         sums_l(nzb,48,tn) = sums_l(nzb,48,tn) +                                      &
-                                             waterflux_output_conversion(nzb) *                       &
-                                             surf_usm_h(l)%qsws(m) * rmask(j,i,sr)             ! w"q" (w"qv")
-                         sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                                    &
-                                             ( 1.0_wp + 0.61_wp * q(nzb,j,i) ) *                      &
-                                             surf_usm_h(l)%shf(m) + 0.61_wp * pt(nzb,j,i) *              &
-                                             surf_usm_h(l)%qsws(m)  )                                    &
-                                             * heatflux_output_conversion(nzb)
-                         IF ( cloud_droplets )  THEN
-                            sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                                 &
-                                                ( 1.0_wp + 0.61_wp * q(nzb,j,i) -                     &
-                                                 ql(nzb,j,i) ) * surf_usm_h(l)%shf(m) +                  &
-                                                 0.61_wp * pt(nzb,j,i) * surf_usm_h(l)%qsws(m) )         &
-                                                * heatflux_output_conversion(nzb)
-                         ENDIF
-                         IF ( bulk_cloud_model )  THEN
-!
-!--                         Formula does not work if ql(nzb) /= 0.0
-                            sums_l(nzb,51,tn) = sums_l(nzb,51,tn) +                                   &
-                                                waterflux_output_conversion(nzb) *                    &
-                                                surf_usm_h(l)%qsws(m) * rmask(j,i,sr)          ! w"q" (w"qv")
-                         ENDIF
-                      ENDIF
-                      IF ( passive_scalar )  THEN
-                         sums_l(nzb,117,tn) = sums_l(nzb,117,tn) +                                    &
-                                              surf_usm_h(l)%ssws(m) * rmask(j,i,sr)            ! w"s"
-                      ENDIF
-#endif
-
-                   ENDIF
-                ENDDO
-             ENDIF
-
-#ifndef _OPENACC
-             IF ( .NOT. neutral )  THEN
-                IF ( surf_def_h(0)%end_index(j,i) >= surf_def_h(0)%start_index(j,i) )  THEN
-                   m = surf_def_h(0)%start_index(j,i)
-                   sums_l(nzb,112,tn) = sums_l(nzb,112,tn) + surf_def_h(0)%ol(m) * rmask(j,i,sr) ! L
-                ENDIF
-                IF ( surf_lsm_h(0)%end_index(j,i) >= surf_lsm_h(0)%start_index(j,i) )  THEN
-                   m = surf_lsm_h(0)%start_index(j,i)
-                   sums_l(nzb,112,tn) = sums_l(nzb,112,tn) + surf_lsm_h(0)%ol(m)    * rmask(j,i,sr) ! L
-                ENDIF
-                IF ( surf_usm_h(0)%end_index(j,i) >= surf_usm_h(0)%start_index(j,i) )  THEN
-                   m = surf_usm_h(0)%start_index(j,i)
-                   sums_l(nzb,112,tn) = sums_l(nzb,112,tn) + surf_usm_h(0)%ol(m)    * rmask(j,i,sr) ! L
-                ENDIF
-             ENDIF
-
-             IF ( radiation )  THEN
-                IF ( surf_def_h(0)%end_index(j,i) >= surf_def_h(0)%start_index(j,i) )  THEN
-                   m = surf_def_h(0)%start_index(j,i)
-                   sums_l(nzb,99,tn)  = sums_l(nzb,99,tn)   +                                      &
-                                        surf_def_h(0)%rad_net(m)    * rmask(j,i,sr)
-                   sums_l(nzb,100,tn) = sums_l(nzb,100,tn)  +                                      &
-                                        surf_def_h(0)%rad_lw_in(m)  * rmask(j,i,sr)
-                   sums_l(nzb,101,tn) = sums_l(nzb,101,tn)  +                                      &
-                                        surf_def_h(0)%rad_lw_out(m) * rmask(j,i,sr)
-                   sums_l(nzb,102,tn) = sums_l(nzb,102,tn)  +                                      &
-                                        surf_def_h(0)%rad_sw_in(m)  * rmask(j,i,sr)
-                   sums_l(nzb,103,tn) = sums_l(nzb,103,tn)  +                                      &
-                                        surf_def_h(0)%rad_sw_out(m) * rmask(j,i,sr)
-                ENDIF
-                IF ( surf_lsm_h(0)%end_index(j,i) >= surf_lsm_h(0)%start_index(j,i) )  THEN
-                   m = surf_lsm_h(0)%start_index(j,i)
-                   sums_l(nzb,99,tn)  = sums_l(nzb,99,tn)   +                                      &
-                                        surf_lsm_h(0)%rad_net(m)    * rmask(j,i,sr)
-                   sums_l(nzb,100,tn) = sums_l(nzb,100,tn)  +                                      &
-                                        surf_lsm_h(0)%rad_lw_in(m)  * rmask(j,i,sr)
-                   sums_l(nzb,101,tn) = sums_l(nzb,101,tn)  +                                      &
-                                        surf_lsm_h(0)%rad_lw_out(m) * rmask(j,i,sr)
-                   sums_l(nzb,102,tn) = sums_l(nzb,102,tn)  +                                      &
-                                        surf_lsm_h(0)%rad_sw_in(m)  * rmask(j,i,sr)
-                   sums_l(nzb,103,tn) = sums_l(nzb,103,tn)  +                                      &
-                                        surf_lsm_h(0)%rad_sw_out(m) * rmask(j,i,sr)
-                ENDIF
-                IF ( surf_usm_h(0)%end_index(j,i) >= surf_usm_h(0)%start_index(j,i) )  THEN
-                   m = surf_usm_h(0)%start_index(j,i)
-                   sums_l(nzb,99,tn)  = sums_l(nzb,99,tn)   +                                      &
-                                        surf_usm_h(0)%rad_net(m)    * rmask(j,i,sr)
-                   sums_l(nzb,100,tn) = sums_l(nzb,100,tn)  +                                      &
-                                        surf_usm_h(0)%rad_lw_in(m)  * rmask(j,i,sr)
-                   sums_l(nzb,101,tn) = sums_l(nzb,101,tn)  +                                      &
-                                        surf_usm_h(0)%rad_lw_out(m) * rmask(j,i,sr)
-                   sums_l(nzb,102,tn) = sums_l(nzb,102,tn)  +                                      &
-                                        surf_usm_h(0)%rad_sw_in(m)  * rmask(j,i,sr)
-                   sums_l(nzb,103,tn) = sums_l(nzb,103,tn)  +                                      &
-                                        surf_usm_h(0)%rad_sw_out(m) * rmask(j,i,sr)
-                ENDIF
-
-#if defined ( __rrtmg )
-                IF ( radiation_scheme == 'rrtmg' )  THEN
-
-                   IF ( surf_def_h(0)%end_index(j,i) >= surf_def_h(0)%start_index(j,i) )  THEN
-                      m = surf_def_h(0)%start_index(j,i)
-                      sums_l(nzb,108,tn)  = sums_l(nzb,108,tn)  +                                  &
-                                            surf_def_h(0)%rrtm_aldif(m,0) * rmask(j,i,sr)
-                      sums_l(nzb,109,tn) = sums_l(nzb,109,tn)  +                                   &
-                                           surf_def_h(0)%rrtm_aldir(m,0) * rmask(j,i,sr)
-                      sums_l(nzb,110,tn) = sums_l(nzb,110,tn)  +                                   &
-                                           surf_def_h(0)%rrtm_asdif(m,0) * rmask(j,i,sr)
-                      sums_l(nzb,111,tn) = sums_l(nzb,111,tn)  +                                   &
-                                           surf_def_h(0)%rrtm_asdir(m,0) * rmask(j,i,sr)
-                   ENDIF
-                   IF ( surf_lsm_h(0)%end_index(j,i) >= surf_lsm_h(0)%start_index(j,i) )  THEN
-                      m = surf_lsm_h(0)%start_index(j,i)
-                      sums_l(nzb,108,tn)  = sums_l(nzb,108,tn)  +                                  &
-                                            SUM( surf_lsm_h(0)%frac(m,:) *                            &
-                                                 surf_lsm_h(0)%rrtm_aldif(m,:) ) * rmask(j,i,sr)
-                      sums_l(nzb,109,tn) = sums_l(nzb,109,tn)  +                                   &
-                                           SUM( surf_lsm_h(0)%frac(m,:) *                             &
-                                                surf_lsm_h(0)%rrtm_aldir(m,:) ) * rmask(j,i,sr)
-                      sums_l(nzb,110,tn) = sums_l(nzb,110,tn)  +                                   &
-                                           SUM( surf_lsm_h(0)%frac(m,:) *                             &
-                                                surf_lsm_h(0)%rrtm_asdif(m,:) ) * rmask(j,i,sr)
-                      sums_l(nzb,111,tn) = sums_l(nzb,111,tn)  +                                   &
-                                           SUM( surf_lsm_h(0)%frac(m,:) *                             &
-                                                surf_lsm_h(0)%rrtm_asdir(m,:) ) * rmask(j,i,sr)
-                   ENDIF
-                   IF ( surf_usm_h(0)%end_index(j,i) >= surf_usm_h(0)%start_index(j,i) )  THEN
-                      m = surf_usm_h(0)%start_index(j,i)
-                      sums_l(nzb,108,tn)  = sums_l(nzb,108,tn)  +                                  &
-                                            SUM( surf_usm_h(0)%frac(m,:) *                            &
-                                                 surf_usm_h(0)%rrtm_aldif(m,:) ) * rmask(j,i,sr)
-                      sums_l(nzb,109,tn) = sums_l(nzb,109,tn)  +                                   &
-                                           SUM( surf_usm_h(0)%frac(m,:) *                             &
-                                                surf_usm_h(0)%rrtm_aldir(m,:) ) * rmask(j,i,sr)
-                      sums_l(nzb,110,tn) = sums_l(nzb,110,tn)  +                                   &
-                                           SUM( surf_usm_h(0)%frac(m,:) *                             &
-                                                surf_usm_h(0)%rrtm_asdif(m,:) ) * rmask(j,i,sr)
-                      sums_l(nzb,111,tn) = sums_l(nzb,111,tn)  +                                   &
-                                           SUM( surf_usm_h(0)%frac(m,:) *                             &
-                                                surf_usm_h(0)%rrtm_asdir(m,:) ) * rmask(j,i,sr)
-                   ENDIF
-
-                ENDIF
-#endif
-             ENDIF
-#endif
-!
-!--          Subgridscale fluxes at the top surface
-             IF ( use_top_fluxes )  THEN
-                m = surf_def_h(2)%start_index(j,i)
-                !$ACC ATOMIC
-                sums_l(nzt,12,tn) = sums_l(nzt,12,tn) +                                            &
-                                    momentumflux_output_conversion(nzt) *                          &
-                                    surf_def_h(2)%usws(m) * rmask(j,i,sr)    ! w"u"
-                !$ACC ATOMIC
-                sums_l(nzt+1,12,tn) = sums_l(nzt+1,12,tn) +                                        &
-                                      momentumflux_output_conversion(nzt+1) *                      &
-                                      surf_def_h(2)%usws(m) * rmask(j,i,sr)  ! w"u"
-                !$ACC ATOMIC
-                sums_l(nzt,14,tn) = sums_l(nzt,14,tn) +                                            &
-                                    momentumflux_output_conversion(nzt) *                          &
-                                    surf_def_h(2)%vsws(m) * rmask(j,i,sr)    ! w"v"
-                !$ACC ATOMIC
-                sums_l(nzt+1,14,tn) = sums_l(nzt+1,14,tn) +                                        &
-                                      momentumflux_output_conversion(nzt+1) *                      &
-                                      surf_def_h(2)%vsws(m) * rmask(j,i,sr)  ! w"v"
-                !$ACC ATOMIC
-                sums_l(nzt,16,tn) = sums_l(nzt,16,tn) +                                            &
-                                    heatflux_output_conversion(nzt) *                              &
-                                    surf_def_h(2)%shf(m)  * rmask(j,i,sr)    ! w"pt"
-                !$ACC ATOMIC
-                sums_l(nzt+1,16,tn) = sums_l(nzt+1,16,tn) +                                        &
-                                      heatflux_output_conversion(nzt+1) *                          &
-                                      surf_def_h(2)%shf(m)  * rmask(j,i,sr)  ! w"pt"
-#if 0
-                sums_l(nzt:nzt+1,58,tn) = sums_l(nzt:nzt+1,58,tn) +                                &
-                                          0.0_wp * rmask(j,i,sr)             ! u"pt"
-                sums_l(nzt:nzt+1,61,tn) = sums_l(nzt:nzt+1,61,tn) +                                &
-                                          0.0_wp * rmask(j,i,sr)             ! v"pt"
-#endif
-#ifndef _OPENACC
-                IF ( ocean_mode )  THEN
-                   sums_l(nzt,65,tn) = sums_l(nzt,65,tn) + &
-                                       surf_def_h(2)%sasws(m) * rmask(j,i,sr)  ! w"sa"
-                ENDIF
-                IF ( humidity )  THEN
-                   sums_l(nzt,48,tn) = sums_l(nzt,48,tn) +                                         &
-                                       waterflux_output_conversion(nzt) *                          &
-                                       surf_def_h(2)%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
-                   sums_l(nzt,45,tn) = sums_l(nzt,45,tn) +   (                                     &
-                                       ( 1.0_wp + 0.61_wp * q(nzt,j,i) ) *                         &
-                                       surf_def_h(2)%shf(m) +                                      &
-                                       0.61_wp * pt(nzt,j,i) *                                     &
-                                       surf_def_h(2)%qsws(m) )                                     &
-                                       * heatflux_output_conversion(nzt)
-                   IF ( cloud_droplets )  THEN
-                      sums_l(nzt,45,tn) = sums_l(nzt,45,tn) +    (                                 &
-                                          ( 1.0_wp + 0.61_wp * q(nzt,j,i) -                        &
-                                            ql(nzt,j,i) ) *                                        &
-                                            surf_def_h(2)%shf(m) +                                 &
-                                           0.61_wp * pt(nzt,j,i) *                                 &
-                                           surf_def_h(2)%qsws(m) )                                 &
-                                           * heatflux_output_conversion(nzt)
-                   ENDIF
-                   IF ( bulk_cloud_model )  THEN
+                sums_l(nzb,12,tn) = sums_l(nzb,12,tn) + &
+                                    usws(j,i) * rmask(j,i,sr)     ! w"u"
+                sums_l(nzb,14,tn) = sums_l(nzb,14,tn) + &
+                                    vsws(j,i) * rmask(j,i,sr)     ! w"v"
+                sums_l(nzb,16,tn) = sums_l(nzb,16,tn) + &
+                                    shf(j,i)  * rmask(j,i,sr)     ! w"pt"
+                sums_l(nzb,58,tn) = sums_l(nzb,58,tn) + &
+                                    0.0 * rmask(j,i,sr)           ! u"pt"
+                sums_l(nzb,61,tn) = sums_l(nzb,61,tn) + &
+                                    0.0 * rmask(j,i,sr)           ! v"pt"
+                IF ( moisture )  THEN
+                   sums_l(nzb,48,tn) = sums_l(nzb,48,tn) + &
+                                       qsws(j,i) * rmask(j,i,sr)  ! w"q" (w"qv")
+                   IF ( cloud_physics )  THEN
+                      sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (           &
+                                          ( 1.0 + 0.61 * q(nzb,j,i) ) *   &
+                                          shf(j,i) + 0.61 * pt(nzb,j,i) * &
+                                                     qsws(j,i)            &
+                                                              )
 !
 !--                   Formula does not work if ql(nzb) /= 0.0
-                      sums_l(nzt,51,tn) = sums_l(nzt,51,tn) +              &  ! w"q" (w"qv")
-                                          waterflux_output_conversion(nzt) *                       &
-                                          surf_def_h(2)%qsws(m) * rmask(j,i,sr)
+                      sums_l(nzb,51,tn) = sums_l(nzb,51,tn) + &   ! w"q" (w"qv")
+                                          qsws(j,i) * rmask(j,i,sr)
                    ENDIF
                 ENDIF
                 IF ( passive_scalar )  THEN
-                   sums_l(nzt,117,tn) = sums_l(nzt,117,tn) +                                       &
-                                        surf_def_h(2)%ssws(m) * rmask(j,i,sr) ! w"s"
+                   sums_l(nzb,48,tn) = sums_l(nzb,48,tn) + &
+                                       qsws(j,i) * rmask(j,i,sr)  ! w"q" (w"qv")
                 ENDIF
-#endif
              ENDIF
 
 !
 !--          Resolved fluxes (can be computed for all horizontal points)
-!--          NOTE: for simplicity, nzb_s_inner is used below, although strictly speaking the
-!--          ----  following k-loop would have to be split up and rearranged according to the
-!--                staggered grid.
-             DO  k = nzb, nzt
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                ust = 0.5_wp * ( u(k,j,i)   - hom(k,1,1,sr) +                                      &
-                                 u(k+1,j,i) - hom(k+1,1,1,sr) )
-                vst = 0.5_wp * ( v(k,j,i)   - hom(k,1,2,sr) +                                      &
-                                 v(k+1,j,i) - hom(k+1,1,2,sr) )
-                pts = 0.5_wp * ( pt(k,j,i)   - hom(k,1,4,sr) +                                     &
-                                 pt(k+1,j,i) - hom(k+1,1,4,sr) )
+!--          NOTE: for simplicity, nzb_s_outer is used below, although strictly 
+!--          ----  speaking the following k-loop would have to be split up and 
+!--                rearranged according to the staggered grid.
+             DO  k = nzb_s_outer(j,i), nzt
+                ust = 0.5 * ( u(k,j,i)   - hom(k,1,1,sr) + &
+                              u(k+1,j,i) - hom(k+1,1,1,sr) )
+                vst = 0.5 * ( v(k,j,i)   - hom(k,1,2,sr) + &
+                              v(k+1,j,i) - hom(k+1,1,2,sr) )
+                pts = 0.5 * ( pt(k,j,i)   - hom(k,1,4,sr) + &
+                              pt(k+1,j,i) - hom(k+1,1,4,sr) )
+!
+!--             Momentum flux w*u*
+                sums_l(k,13,tn) = sums_l(k,13,tn) + 0.5 *                     &
+                                                    ( w(k,j,i-1) + w(k,j,i) ) &
+                                                    * ust * rmask(j,i,sr)
+!
+!--             Momentum flux w*v*
+                sums_l(k,15,tn) = sums_l(k,15,tn) + 0.5 *                     &
+                                                    ( w(k,j-1,i) + w(k,j,i) ) &
+                                                    * vst * rmask(j,i,sr)
+!
+!--             Heat flux w*pt*
+!--             The following formula (comment line, not executed) does not
+!--             work if applied to subregions
+!                sums_l(k,17,tn) = sums_l(k,17,tn) + 0.5 *                     &
+!                                                    ( pt(k,j,i)+pt(k+1,j,i) ) &
+!                                                    * w(k,j,i) * rmask(j,i,sr)
+                sums_l(k,17,tn) = sums_l(k,17,tn) + pts * w(k,j,i) * &
+                                                    rmask(j,i,sr)
 !
 !--             Higher moments
-                !$ACC ATOMIC
-                sums_l(k,35,tn) = sums_l(k,35,tn) + pts * w(k,j,i)**2 * rmask(j,i,sr) * flag
-                !$ACC ATOMIC
-                sums_l(k,36,tn) = sums_l(k,36,tn) + pts**2 * w(k,j,i) * rmask(j,i,sr) * flag
-
-!
-!--             Salinity flux and density (density does not belong to here, but so far there is no
-!--             other suitable place to calculate)
-#ifndef _OPENACC
-                IF ( ocean_mode )  THEN
-                   IF( .NOT. ws_scheme_sca .OR. sr /= 0 )  THEN
-                      pts = 0.5_wp * ( sa(k,j,i)   - hom(k,1,23,sr) +                              &
-                                       sa(k+1,j,i) - hom(k+1,1,23,sr) )
-                      sums_l(k,66,tn) = sums_l(k,66,tn) + pts * w(k,j,i) *                         &
-                                        rmask(j,i,sr) * flag
+                sums_l(k,35,tn) = sums_l(k,35,tn) + pts * w(k,j,i)**2 * &
+                                                    rmask(j,i,sr)
+                sums_l(k,36,tn) = sums_l(k,36,tn) + pts**2 * w(k,j,i) * &
+                                                    rmask(j,i,sr)
+
+!
+!--             Buoyancy flux, water flux, humidity flux and liquid water
+!--             content
+                IF ( moisture )  THEN
+                   pts = 0.5 * ( vpt(k,j,i)   - hom(k,1,44,sr) + &
+                                 vpt(k+1,j,i) - hom(k+1,1,44,sr) )
+                   sums_l(k,46,tn) = sums_l(k,46,tn) + pts * w(k,j,i) * &
+                                                       rmask(j,i,sr)
+                   pts = 0.5 * ( q(k,j,i)   - hom(k,1,41,sr) + &
+                                 q(k+1,j,i) - hom(k+1,1,41,sr) )
+                   sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) * &
+                                                       rmask(j,i,sr)
+                   IF ( cloud_physics  .OR.  cloud_droplets )  THEN
+                      pts = 0.5 *                                            &
+                             ( ( q(k,j,i)   - ql(k,j,i)   ) - hom(k,1,42,sr) &
+                             + ( q(k+1,j,i) - ql(k+1,j,i) ) - hom(k+1,1,42,sr) )
+                      sums_l(k,52,tn) = sums_l(k,52,tn) + pts * w(k,j,i) * &
+                                                          rmask(j,i,sr)
+                      sums_l(k,54,tn) = sums_l(k,54,tn) + ql(k,j,i) * &
+                                                          rmask(j,i,sr)
                    ENDIF
-                   sums_l(k,64,tn) = sums_l(k,64,tn) + rho_ocean(k,j,i) * rmask(j,i,sr) * flag
-                   sums_l(k,71,tn) = sums_l(k,71,tn) + prho(k,j,i)      * rmask(j,i,sr) * flag
                 ENDIF
 
 !
-!--             Buoyancy flux, water flux, humidity flux, liquid water content, rain drop
-!--             concentration and rain water content
-                IF ( humidity )  THEN
-                   IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
-                      pts = 0.5_wp * ( vpt(k,j,i)   - hom(k,1,44,sr) +                             &
-                                       vpt(k+1,j,i) - hom(k+1,1,44,sr) )
-                      sums_l(k,46,tn) = sums_l(k,46,tn) + pts * w(k,j,i) *                         &
-                                                          rho_air_zw(k) *                          &
-                                                          heatflux_output_conversion(k) *          &
-                                                          rmask(j,i,sr) * flag
-                      sums_l(k,54,tn) = sums_l(k,54,tn) + ql(k,j,i) * rmask(j,i,sr) * flag
-
-                      IF ( .NOT. cloud_droplets )  THEN
-                         pts = 0.5_wp *                                                            &
-                               ( ( q(k,j,i) - ql(k,j,i) ) -                                        &
-                               hom(k,1,42,sr) +                                                    &
-                               ( q(k+1,j,i) - ql(k+1,j,i) ) -                                      &
-                               hom(k+1,1,42,sr) )
-                         sums_l(k,52,tn) = sums_l(k,52,tn) + pts * w(k,j,i) *                      &
-                                             rho_air_zw(k) *                                       &
-                                             waterflux_output_conversion(k) *                      &
-                                             rmask(j,i,sr) * flag
-                         sums_l(k,75,tn) = sums_l(k,75,tn) + qc(k,j,i)  * rmask(j,i,sr) * flag
-                         sums_l(k,76,tn) = sums_l(k,76,tn) + prr(k,j,i) * rmask(j,i,sr) * flag
-                         IF ( microphysics_morrison )  THEN
-                            sums_l(k,123,tn) = sums_l(k,123,tn) + nc(k,j,i) * rmask(j,i,sr) * flag
-                         ENDIF
-                         IF ( microphysics_ice_phase )  THEN
-                            sums_l(k,124,tn) = sums_l(k,124,tn) + ni(k,j,i) * rmask(j,i,sr) * flag
-                            sums_l(k,125,tn) = sums_l(k,125,tn) + qi(k,j,i) * rmask(j,i,sr) * flag
-                            IF ( graupel  .AND.  snow )  THEN
-                               sums_l(k,126,tn) = sums_l(k,126,tn) + ng(k,j,i) * rmask(j,i,sr) * flag
-                               sums_l(k,127,tn) = sums_l(k,127,tn) + qg(k,j,i) * rmask(j,i,sr) * flag
-                               sums_l(k,128,tn) = sums_l(k,128,tn) + ns(k,j,i) * rmask(j,i,sr) * flag
-                               sums_l(k,129,tn) = sums_l(k,129,tn) + qs(k,j,i) * rmask(j,i,sr) * flag
-                            ENDIF
-                         ENDIF
-
-                         IF ( microphysics_seifert )  THEN
-                            sums_l(k,73,tn) = sums_l(k,73,tn) + nr(k,j,i) * rmask(j,i,sr) * flag
-                            sums_l(k,74,tn) = sums_l(k,74,tn) + qr(k,j,i) * rmask(j,i,sr) * flag
-                         ENDIF
-                      ENDIF
-
-                   ELSE
-                      IF( .NOT. ws_scheme_sca  .OR.  sr /= 0 )  THEN
-                         pts = 0.5_wp * ( vpt(k,j,i)   - hom(k,1,44,sr) +                          &
-                                          vpt(k+1,j,i) - hom(k+1,1,44,sr) )
-                         sums_l(k,46,tn) = sums_l(k,46,tn) + pts * w(k,j,i) *                      &
-                                                             rho_air_zw(k)  *                      &
-                                                             heatflux_output_conversion(k) *       &
-                                                             rmask(j,i,sr)  * flag
-                      ELSE IF ( ws_scheme_sca  .AND.  sr == 0 )  THEN
-                         sums_l(k,46,tn) = ( ( 1.0_wp + 0.61_wp *                                  &
-                                               hom(k,1,41,sr) ) *                                  &
-                                             sums_l(k,17,tn) +                                     &
-                                             0.61_wp * hom(k,1,4,sr) *                             &
-                                             sums_l(k,49,tn)                                       &
-                                           ) * heatflux_output_conversion(k) * flag
-                      END IF
-                   END IF
-                   temp = exner(k) * pt(k,j,i)
-                   e_s = magnus( temp )
-                   q_s = rd_d_rv * e_s / ( hyp(k) - e_s )
-                   rh_tmp = q(k,j,i) / q_s * 100.0_wp
-                   sums_l(k,130,tn) = sums_l(k,130,tn) + rh_tmp * rmask(j,i,sr) * flag
+!--             Passive scalar flux
+                IF ( passive_scalar )  THEN
+                   pts = 0.5 * ( q(k,j,i)   - hom(k,1,41,sr) + &
+                                 q(k+1,j,i) - hom(k+1,1,41,sr) )
+                   sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) * &
+                                                       rmask(j,i,sr)
                 ENDIF
-!
-!--             Passive scalar flux
-                IF ( passive_scalar  .AND.  ( .NOT. ws_scheme_sca .OR. sr /= 0 ) )  THEN
-                   pts = 0.5_wp * ( s(k,j,i)   - hom(k,1,115,sr) +                                 &
-                                    s(k+1,j,i) - hom(k+1,1,115,sr) )
-                   sums_l(k,114,tn) = sums_l(k,114,tn) + pts * w(k,j,i) * rmask(j,i,sr) * flag
-                ENDIF
-#endif
 
 !
 !--             Energy flux w*e*
-!--             has to be adjusted
-                !$ACC ATOMIC
-                sums_l(k,37,tn) = sums_l(k,37,tn) + w(k,j,i) * 0.5_wp *                            &
-                                                    ( ust**2 + vst**2 + w(k,j,i)**2 )              &
-                                                    * rho_air_zw(k)                                &
-                                                    * momentumflux_output_conversion(k)            &
-                                                    * rmask(j,i,sr) * flag
+                sums_l(k,37,tn) = sums_l(k,37,tn) + w(k,j,i) * 0.5 *           &
+                                              ( ust**2 + vst**2 + w(k,j,i)**2 )&
+                                              * rmask(j,i,sr)
+          
              ENDDO
           ENDDO
        ENDDO
-       !$OMP END PARALLEL
-
-       !$ACC UPDATE &
-       !$ACC HOST(sums_l(:,12,tn), sums_l(:,14,tn), sums_l(:,16,tn)) &
-       !$ACC HOST(sums_l(:,35,tn), sums_l(:,36,tn), sums_l(:,37,tn))
-!
-!--    Treat land-surface quantities according to new wall model structure.
-       IF ( land_surface )  THEN
-          tn = 0
-          !$OMP PARALLEL PRIVATE( i, j, m, tn )
-          !$ tn = omp_get_thread_num()
-          !$OMP DO
-          DO  m = 1, surf_lsm_h(0)%ns
-             i = surf_lsm_h(0)%i(m)
-             j = surf_lsm_h(0)%j(m)
-
-             sums_l(nzb,93,tn)  = sums_l(nzb,93,tn) + surf_lsm_h(0)%ghf(m)       * rmask(j,i,sr)
-             sums_l(nzb,94,tn)  = sums_l(nzb,94,tn) + surf_lsm_h(0)%qsws_liq(m)  * rmask(j,i,sr)
-             sums_l(nzb,95,tn)  = sums_l(nzb,95,tn) + surf_lsm_h(0)%qsws_soil(m) * rmask(j,i,sr)
-             sums_l(nzb,96,tn)  = sums_l(nzb,96,tn) + surf_lsm_h(0)%qsws_veg(m)  * rmask(j,i,sr)
-             sums_l(nzb,97,tn)  = sums_l(nzb,97,tn) + surf_lsm_h(0)%r_a(m)       * rmask(j,i,sr)
-             sums_l(nzb,98,tn)  = sums_l(nzb,98,tn) + surf_lsm_h(0)%r_s(m)       * rmask(j,i,sr)
-          ENDDO
-          !$OMP END PARALLEL
-
-          tn = 0
-          !$OMP PARALLEL PRIVATE( i, j, k, m, tn )
-          !$ tn = omp_get_thread_num()
-          !$OMP DO
-          DO  m = 1, surf_lsm_h(0)%ns
-
-             i = surf_lsm_h(0)%i(m)
-             j = surf_lsm_h(0)%j(m)
-             DO  k = nzb_soil, nzt_soil
-                sums_l(k,89,tn)  = sums_l(k,89,tn)  + t_soil_h(0)%var_2d(k,m) * rmask(j,i,sr)
-                sums_l(k,91,tn)  = sums_l(k,91,tn)  + m_soil_h(0)%var_2d(k,m) * rmask(j,i,sr)
-             ENDDO
-          ENDDO
-          !$OMP END PARALLEL
-       ENDIF
-!
-!--    Treat urban-surface quantities according to new wall model structure. Here, ghf and r_a are
-!--    added on top of LSM sums.
-       IF ( land_surface  .AND.  urban_surface )  THEN
-          tn = 0
-          !$OMP PARALLEL PRIVATE( i, j, m, tn )
-          !$ tn = omp_get_thread_num()
-          !$OMP DO
-          DO  m = 1, surf_usm_h(0)%ns
-             i = surf_usm_h(0)%i(m)
-             j = surf_usm_h(0)%j(m)
-
-             sums_l(nzb,93,tn)  = sums_l(nzb,93,tn) + surf_usm_h(0)%wghf_eb(m) * rmask(j,i,sr)
-             sums_l(nzb,97,tn)  = sums_l(nzb,97,tn) + surf_usm_h(0)%r_a(m)     * rmask(j,i,sr)
-          ENDDO
-          !$OMP END PARALLEL
-       ENDIF
-!
-!--    For speed optimization fluxes which have been computed in part directly inside the WS
-!--    advection routines are treated seperatly.
-!--    Momentum fluxes first:
-
-       tn = 0
-       !$OMP PARALLEL PRIVATE( i, j, k, tn, flag )
-       !$ tn = omp_get_thread_num()
-       IF ( .NOT. ws_scheme_mom .OR. sr /= 0  )  THEN
+
+!
+!--    Divergence of vertical flux of resolved scale energy and pressure
+!--    fluctuations. First calculate the products, then the divergence.
+!--    Calculation is time consuming. Do it only, if profiles shall be plotted.
+       IF ( hom(nzb+1,2,55,0) /= 0.0 )  THEN
+
+          sums_ll = 0.0  ! local array
+
           !$OMP DO
           DO  i = nxl, nxr
              DO  j = nys, nyn
-                DO  k = nzb, nzt
-!
-!--                Flag 23 is used to mask surface fluxes as well as model-top fluxes, which are
-!--                added further below.
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 23 ) ) *        &
-                          MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 9  ) )
-
-                   ust = 0.5_wp * ( u(k,j,i)   - hom(k,1,1,sr) +                                   &
-                                    u(k+1,j,i) - hom(k+1,1,1,sr) )
-                   vst = 0.5_wp * ( v(k,j,i)   - hom(k,1,2,sr) +                                   &
-                                    v(k+1,j,i) - hom(k+1,1,2,sr) )
-!
-!--                Momentum flux w*u*
-                   sums_l(k,13,tn) = sums_l(k,13,tn) + 0.5_wp *                                    &
-                                                     ( w(k,j,i-1) + w(k,j,i) )                     &
-                                                     * rho_air_zw(k)                               &
-                                                     * momentumflux_output_conversion(k)           &
-                                                     * ust * rmask(j,i,sr)                         &
-                                                           * flag
-!
-!--                Momentum flux w*v*
-                   sums_l(k,15,tn) = sums_l(k,15,tn) + 0.5_wp * ( w(k,j-1,i) + w(k,j,i) )          &
-                                                     * rho_air_zw(k)                               &
-                                                     * momentumflux_output_conversion(k)           &
-                                                     * vst * rmask(j,i,sr)                         &
-                                                           * flag
+                DO  k = nzb_s_outer(j,i)+1, nzt
+
+                   sums_ll(k,1) = sums_ll(k,1) + 0.5 * w(k,j,i) * (        &
+                  ( 0.25 * ( u(k,j,i)+u(k+1,j,i)+u(k,j,i+1)+u(k+1,j,i+1)   &
+                           - 2.0 * ( hom(k,1,1,sr) + hom(k+1,1,1,sr) )     &
+                           ) )**2                                          &
+                + ( 0.25 * ( v(k,j,i)+v(k+1,j,i)+v(k,j+1,i)+v(k+1,j+1,i)   &
+                           - 2.0 * ( hom(k,1,2,sr) + hom(k+1,1,2,sr) )     &
+                           ) )**2                                          &
+                   + w(k,j,i)**2                                  )
+
+                   sums_ll(k,2) = sums_ll(k,2) + 0.5 * w(k,j,i) &
+                                               * ( p(k,j,i) + p(k+1,j,i) )
+
                 ENDDO
              ENDDO
           ENDDO
-
-       ENDIF
-       IF ( .NOT. ws_scheme_sca .OR. sr /= 0 )  THEN
+          sums_ll(0,1)     = 0.0    ! because w is zero at the bottom
+          sums_ll(nzt+1,1) = 0.0
+          sums_ll(0,2)     = 0.0
+          sums_ll(nzt+1,2) = 0.0
+
+          DO  k = nzb_s_outer(j,i)+1, nzt
+             sums_l(k,55,tn) = ( sums_ll(k,1) - sums_ll(k-1,1) ) * ddzw(k)
+             sums_l(k,56,tn) = ( sums_ll(k,2) - sums_ll(k-1,2) ) * ddzw(k)
+          ENDDO
+          sums_l(nzb,55,tn) = sums_l(nzb+1,55,tn)
+          sums_l(nzb,56,tn) = sums_l(nzb+1,56,tn)
+
+       ENDIF
+
+!
+!--    Divergence of vertical flux of SGS TKE
+       IF ( hom(nzb+1,2,57,0) /= 0.0 )  THEN
+
           !$OMP DO
           DO  i = nxl, nxr
              DO  j = nys, nyn
-                DO  k = nzb, nzt
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 23 ) ) *        &
-                          MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 9  ) )
-!
-!--                Vertical heat flux
-                   sums_l(k,17,tn) = sums_l(k,17,tn) + 0.5_wp *                                    &
-                                     ( pt(k,j,i)   - hom(k,1,4,sr) +                               &
-                                       pt(k+1,j,i) - hom(k+1,1,4,sr) )                             &
-                                     * rho_air_zw(k)                                               &
-                                     * heatflux_output_conversion(k)                               &
-                                     * w(k,j,i) * rmask(j,i,sr) * flag
-                   IF ( humidity )  THEN
-                      pts = 0.5_wp * ( q(k,j,i)   - hom(k,1,41,sr) +                               &
-                                       q(k+1,j,i) - hom(k+1,1,41,sr) )
-                      sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) *                         &
-                                                          rho_air_zw(k)  *                         &
-                                                          waterflux_output_conversion(k) *         &
-                                                          rmask(j,i,sr)  * flag
-                   ENDIF
-                   IF ( passive_scalar )  THEN
-                      pts = 0.5_wp * ( s(k,j,i)   - hom(k,1,115,sr) +                              &
-                                       s(k+1,j,i) - hom(k+1,1,115,sr) )
-                      sums_l(k,114,tn) = sums_l(k,114,tn) + pts * w(k,j,i) *  rmask(j,i,sr) * flag
-                   ENDIF
+                DO  k = nzb_s_outer(j,i)+1, nzt
+
+                   sums_l(k,57,tn) = sums_l(k,57,tn) + (                       &
+                   (km(k,j,i)+km(k+1,j,i)) * (e(k+1,j,i)-e(k,j,i)) * ddzu(k+1) &
+                 - (km(k-1,j,i)+km(k,j,i)) * (e(k,j,i)-e(k-1,j,i)) * ddzu(k)   &
+                                                 ) * ddzw(k)
+
                 ENDDO
              ENDDO
           ENDDO
-
-       ENDIF
-
-!
-!--    Density at top follows Neumann condition
-       IF ( ocean_mode )  THEN
-          sums_l(nzt+1,64,tn) = sums_l(nzt,64,tn)
-          sums_l(nzt+1,71,tn) = sums_l(nzt,71,tn)
-       ENDIF
-
-!
-!--    Divergence of vertical flux of resolved scale energy and pressure fluctuations as well as
-!--    flux of pressure fluctuation itself (68).
-!--    First calculate the products, then the divergence.
-!--    Calculation is time consuming. Do it only, if profiles shall be plotted.
-       IF ( hom(nzb+1,2,55,0) /= 0.0_wp  .OR.  hom(nzb+1,2,68,0) /= 0.0_wp )  THEN
-          sums_ll = 0.0_wp  ! local array
+          sums_l(nzb,57,tn) = sums_l(nzb+1,57,tn)
+
+       ENDIF
+
+!
+!--    Horizontal heat fluxes (subgrid, resolved, total). 
+!--    Do it only, if profiles shall be plotted. 
+       IF ( hom(nzb+1,2,58,0) /= 0.0 ) THEN
 
           !$OMP DO
           DO  i = nxl, nxr
              DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                   sums_ll(k,1) = sums_ll(k,1) + 0.5_wp * w(k,j,i) * (                             &
-                                    ( 0.25_wp * ( u(k,j,i)+u(k+1,j,i)+u(k,j,i+1)+u(k+1,j,i+1) )    &
-                                              - 0.5_wp * ( hom(k,1,1,sr) + hom(k+1,1,1,sr) ) )**2  &
-                                  + ( 0.25_wp * ( v(k,j,i)+v(k+1,j,i)+v(k,j+1,i)+v(k+1,j+1,i) )    &
-                                              - 0.5_wp * ( hom(k,1,2,sr) + hom(k+1,1,2,sr) ) )**2  &
-                                  + w(k,j,i)**2                      ) * flag * rmask(j,i,sr)
-
-                   sums_ll(k,2) = sums_ll(k,2) + 0.5_wp * w(k,j,i)                                 &
-                                       * ( ( p(k,j,i) + p(k+1,j,i) )                               &
-                                         / momentumflux_output_conversion(k) )                     &
-                                       * flag * rmask(j,i,sr)
-
+                DO  k = nzb_s_outer(j,i)+1, nzt
+!
+!--                Subgrid horizontal heat fluxes u"pt", v"pt"
+                   sums_l(k,58,tn) = sums_l(k,58,tn) - 0.5 *                   &
+                                                   ( kh(k,j,i) + kh(k,j,i-1) ) &
+                                                 * ( pt(k,j,i-1) - pt(k,j,i) ) &
+                                                 * ddx * rmask(j,i,sr)
+                   sums_l(k,61,tn) = sums_l(k,61,tn) - 0.5 *                   &
+                                                   ( kh(k,j,i) + kh(k,j-1,i) ) &
+                                                 * ( pt(k,j-1,i) - pt(k,j,i) ) &
+                                                 * ddy * rmask(j,i,sr)
+!
+!--                Resolved horizontal heat fluxes u*pt*, v*pt*
+                   sums_l(k,59,tn) = sums_l(k,59,tn) +                         &
+                                                  ( u(k,j,i) - hom(k,1,1,sr) ) &
+                                       * 0.5 * ( pt(k,j,i-1) - hom(k,1,4,sr) + &
+                                                 pt(k,j,i)   - hom(k,1,4,sr) )
+                   pts = 0.5 * ( pt(k,j-1,i) - hom(k,1,4,sr) + &
+                                 pt(k,j,i)   - hom(k,1,4,sr) )
+                   sums_l(k,62,tn) = sums_l(k,62,tn) +                         &
+                                                  ( v(k,j,i) - hom(k,1,2,sr) ) &
+                                       * 0.5 * ( pt(k,j-1,i) - hom(k,1,4,sr) + &
+                                                 pt(k,j,i)   - hom(k,1,4,sr) )
                 ENDDO
              ENDDO
           ENDDO
-          sums_ll(0,1)     = 0.0_wp    ! because w is zero at the bottom
-          sums_ll(nzt+1,1) = 0.0_wp
-          sums_ll(0,2)     = 0.0_wp
-          sums_ll(nzt+1,2) = 0.0_wp
-
-          DO  k = nzb+1, nzt
-             sums_l(k,55,tn) = ( sums_ll(k,1) - sums_ll(k-1,1) ) * ddzw(k)
-             sums_l(k,56,tn) = ( sums_ll(k,2) - sums_ll(k-1,2) ) * ddzw(k)
-             sums_l(k,68,tn) = sums_ll(k,2)
-          ENDDO
-          sums_l(nzb,55,tn) = sums_l(nzb+1,55,tn)
-          sums_l(nzb,56,tn) = sums_l(nzb+1,56,tn)
-          sums_l(nzb,68,tn) = 0.0_wp    ! because w* = 0 at nzb
-
-       ENDIF
-
-!
-!--    Divergence of vertical flux of SGS TKE and the flux itself (69)
-       IF ( hom(nzb+1,2,57,0) /= 0.0_wp  .OR.  hom(nzb+1,2,69,0) /= 0.0_wp )  THEN
-          !$OMP DO
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                   sums_l(k,57,tn) = sums_l(k,57,tn) - 0.5_wp * (                                  &
-                                       (km(k,j,i)+km(k+1,j,i)) * (e(k+1,j,i)-e(k,j,i)) * ddzu(k+1) &
-                                     - (km(k-1,j,i)+km(k,j,i)) * (e(k,j,i)-e(k-1,j,i)) * ddzu(k)   &
-                                                                ) * ddzw(k)                        &
-                                                                  * flag * rmask(j,i,sr)
-
-                   sums_l(k,69,tn) = sums_l(k,69,tn) - 0.5_wp * (                                  &
-                                        ( km(k,j,i) + km(k+1,j,i) ) *                              &
-                                        ( e(k+1,j,i) - e(k,j,i) ) * ddzu(k+1)                      &
-                                                                ) * flag * rmask(j,i,sr)
-
-                ENDDO
-             ENDDO
-          ENDDO
-          sums_l(nzb,57,tn) = sums_l(nzb+1,57,tn)
-          sums_l(nzb,69,tn) = sums_l(nzb+1,69,tn)
-
-       ENDIF
-
-!
-!--    Horizontal heat fluxes (subgrid, resolved, total).
-!--    Do it only, if profiles shall be plotted.
-       IF ( hom(nzb+1,2,58,0) /= 0.0_wp ) THEN
-
-          !$OMP DO
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--                Subgrid horizontal heat fluxes u"pt", v"pt"
-                   sums_l(k,58,tn) = sums_l(k,58,tn) - 0.5_wp *                                    &
-                                                        ( kh(k,j,i) + kh(k,j,i-1) )                &
-                                                      * ( pt(k,j,i-1) - pt(k,j,i) )                &
-                                                      * rho_air_zw(k)                              &
-                                                      * heatflux_output_conversion(k)              &
-                                                      * ddx * rmask(j,i,sr) * flag
-                   sums_l(k,61,tn) = sums_l(k,61,tn) - 0.5_wp *                                    &
-                                                        ( kh(k,j,i) + kh(k,j-1,i) )                &
-                                                      * ( pt(k,j-1,i) - pt(k,j,i) )                &
-                                                      * rho_air_zw(k)                              &
-                                                      * heatflux_output_conversion(k)              &
-                                                      * ddy * rmask(j,i,sr) * flag
-!
-!--                Resolved horizontal heat fluxes u*pt*, v*pt*
-                   sums_l(k,59,tn) = sums_l(k,59,tn) +              ( u(k,j,i) - hom(k,1,1,sr) )   &
-                                                      * 0.5_wp * ( pt(k,j,i-1) - hom(k,1,4,sr) +   &
-                                                                   pt(k,j,i)   - hom(k,1,4,sr) )   &
-                                                                 * heatflux_output_conversion(k)   &
-                                                                 * flag
-                   pts = 0.5_wp * ( pt(k,j-1,i) - hom(k,1,4,sr) +                                  &
-                                    pt(k,j,i)   - hom(k,1,4,sr) )
-                   sums_l(k,62,tn) = sums_l(k,62,tn) +              ( v(k,j,i) - hom(k,1,2,sr) )   &
-                                                      * 0.5_wp * ( pt(k,j-1,i) - hom(k,1,4,sr) +   &
-                                                                   pt(k,j,i)   - hom(k,1,4,sr) )   &
-                                                                 * heatflux_output_conversion(k)   &
-                                                                 * flag
-                ENDDO
-             ENDDO
-          ENDDO
 !
 !--       Fluxes at the surface must be zero (e.g. due to the Prandtl-layer)
-          sums_l(nzb,58,tn) = 0.0_wp
-          sums_l(nzb,59,tn) = 0.0_wp
-          sums_l(nzb,60,tn) = 0.0_wp
-          sums_l(nzb,61,tn) = 0.0_wp
-          sums_l(nzb,62,tn) = 0.0_wp
-          sums_l(nzb,63,tn) = 0.0_wp
-
-       ENDIF
-       !$OMP END PARALLEL
-
-!
-!--    Collect current large scale advection and subsidence tendencies for
-!--    data output
-       IF ( large_scale_forcing  .AND.  ( simulated_time > 0.0_wp ) )  THEN
-!
-!--       Interpolation in time of LSF_DATA
-          nt = 1
-          DO WHILE ( simulated_time - dt_3d > time_vert(nt) )
-             nt = nt + 1
-          ENDDO
-          IF ( simulated_time - dt_3d /= time_vert(nt) )  THEN
-            nt = nt - 1
-          ENDIF
-
-          fac = ( simulated_time - dt_3d - time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
-
-
-          DO  k = nzb, nzt
-             sums_ls_l(k,0) = td_lsa_lpt(k,nt) + fac * ( td_lsa_lpt(k,nt+1) - td_lsa_lpt(k,nt) )
-             sums_ls_l(k,1) = td_lsa_q(k,nt)   + fac * ( td_lsa_q(k,nt+1)   - td_lsa_q(k,nt) )
-          ENDDO
-
-          sums_ls_l(nzt+1,0) = sums_ls_l(nzt,0)
-          sums_ls_l(nzt+1,1) = sums_ls_l(nzt,1)
-
-          IF ( large_scale_subsidence  .AND.  use_subsidence_tendencies )  THEN
-
-             DO  k = nzb, nzt
-                sums_ls_l(k,2) = td_sub_lpt(k,nt) + fac * ( td_sub_lpt(k,nt+1) - td_sub_lpt(k,nt) )
-                sums_ls_l(k,3) = td_sub_q(k,nt)   + fac * ( td_sub_q(k,nt+1)   - td_sub_q(k,nt) )
-             ENDDO
-
-             sums_ls_l(nzt+1,2) = sums_ls_l(nzt,2)
-             sums_ls_l(nzt+1,3) = sums_ls_l(nzt,3)
-
-          ENDIF
-
-       ENDIF
-
-       tn = 0
-       !$OMP PARALLEL PRIVATE( i, j, k, tn )
-       !$ tn = omp_get_thread_num()
-       IF ( radiation  .AND.  radiation_scheme == 'rrtmg' )  THEN
-          !$OMP DO
-          DO  i = nxl, nxr
-             DO  j =  nys, nyn
-                DO  k = nzb+1, nzt+1
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                   sums_l(k,100,tn)  = sums_l(k,100,tn) + rad_lw_in(k,j,i)    * rmask(j,i,sr) * flag
-                   sums_l(k,101,tn)  = sums_l(k,101,tn) + rad_lw_out(k,j,i)   * rmask(j,i,sr) * flag
-                   sums_l(k,102,tn)  = sums_l(k,102,tn) + rad_sw_in(k,j,i)    * rmask(j,i,sr) * flag
-                   sums_l(k,103,tn)  = sums_l(k,103,tn) + rad_sw_out(k,j,i)   * rmask(j,i,sr) * flag
-                   sums_l(k,104,tn)  = sums_l(k,104,tn) + rad_lw_cs_hr(k,j,i) * rmask(j,i,sr) * flag
-                   sums_l(k,105,tn)  = sums_l(k,105,tn) + rad_lw_hr(k,j,i)    * rmask(j,i,sr) * flag
-                   sums_l(k,106,tn)  = sums_l(k,106,tn) + rad_sw_cs_hr(k,j,i) * rmask(j,i,sr) * flag
-                   sums_l(k,107,tn)  = sums_l(k,107,tn) + rad_sw_hr(k,j,i)    * rmask(j,i,sr) * flag
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-
-!
-!--    Calculate the profiles for all other modules
-       CALL module_interface_statistics( 'profiles', sr, tn, dots_max )
+          sums(nzb,58) = 0.0
+          sums(nzb,59) = 0.0
+          sums(nzb,60) = 0.0
+          sums(nzb,61) = 0.0
+          sums(nzb,62) = 0.0
+          sums(nzb,63) = 0.0
+
+       ENDIF
        !$OMP END PARALLEL
 
@@ -1771,158 +699,39 @@
              sums_l(:,3,0)          = sums_l(:,3,0) + sums_l(:,3,i)
              sums_l(:,4:40,0)       = sums_l(:,4:40,0) + sums_l(:,4:40,i)
-             sums_l(:,45:pr_palm,0) = sums_l(:,45:pr_palm,0) + &
-                                      sums_l(:,45:pr_palm,i)
-             IF ( max_pr_user > 0 )  THEN
-                sums_l(:,pr_palm+1:pr_palm+max_pr_user,0) =                                        &
-                                                       sums_l(:,pr_palm+1:pr_palm+max_pr_user,0) + &
-                                                       sums_l(:,pr_palm+1:pr_palm+max_pr_user,i)
-             ENDIF
-
-             IF ( air_chemistry )  THEN
-                IF ( max_pr_cs > 0 )  THEN
-                     sums_l(:,pr_palm+max_pr_user+1:pr_palm + max_pr_user+ max_pr_cs,0) =          &
-                               sums_l(:,pr_palm+max_pr_user+1:pr_palm+max_pr_user+max_pr_cs,0) + &
-                               sums_l(:,pr_palm+max_pr_user+1:pr_palm+max_pr_user+max_pr_cs,i)
-
-                ENDIF
-             ENDIF
-             IF ( salsa )  THEN
-                IF ( max_pr_cs > 0 )  THEN
-                   sums_l(:,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0) =    &
-                      sums_l(:,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0) + &
-                      sums_l(:,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,i)
-
-                ENDIF
-             ENDIF
+             sums_l(:,45:var_sum,0) = sums_l(:,45:var_sum,0) + &
+                                      sums_l(:,45:var_sum,i)
           ENDDO
        ENDIF
 
 #if defined( __parallel )
-
 !
 !--    Compute total sum from local sums
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), ngp_sums, MPI_REAL, MPI_SUM, comm2d, ierr )
-       IF ( large_scale_forcing )  THEN
-          CALL MPI_ALLREDUCE( sums_ls_l(nzb,2), sums(nzb,83), ngp_sums_ls, MPI_REAL, MPI_SUM,      &
-                              comm2d, ierr )
-       ENDIF
-
-       IF ( air_chemistry  .AND.  max_pr_cs > 0 )  THEN
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          DO  i = 1, max_pr_cs
-             CALL MPI_ALLREDUCE( sums_l(nzb,pr_palm+max_pr_user+i,0),                              &
-                                 sums(nzb,pr_palm+max_pr_user+i),                                  &
-                                 nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d, ierr )
-          ENDDO
-       ENDIF
-
-       IF ( salsa  .AND.  max_pr_salsa > 0 )  THEN
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          DO  i = 1, max_pr_salsa
-             CALL MPI_ALLREDUCE( sums_l(nzb,pr_palm+max_pr_user+max_pr_cs+i,0),                    &
-                                 sums(nzb,pr_palm+max_pr_user+max_pr_user+i),                      &
-                                 nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d, ierr )
-          ENDDO
-       ENDIF
-
+       CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), ngp_sums, MPI_REAL, &
+                           MPI_SUM, comm2d, ierr )
 #else
        sums = sums_l(:,:,0)
-       IF ( large_scale_forcing )  THEN
-          sums(:,81:88) = sums_ls_l
-       ENDIF
 #endif
 
 !
-!--    Final values are obtained by division by the total number of grid points used for summation.
-!--    After that store profiles.
-!--    Check, if statistical regions do contain at least one grid point at the respective k-level,
-!--    otherwise division by zero will lead to undefined values, which may cause e.g. problems with
-!--    NetCDF output.
+!--    Final values are obtained by division by the total number of grid points 
+!--    used for summation. After that store profiles.
 !--    Profiles:
        DO  k = nzb, nzt+1
-          sums(k,3)             = sums(k,3)     / ngp_2dh(sr)
-          sums(k,12:22)         = sums(k,12:22) / ngp_2dh(sr)
-          sums(k,30:32)         = sums(k,30:32) / ngp_2dh(sr)
-          sums(k,35:39)         = sums(k,35:39) / ngp_2dh(sr)
-          sums(k,45:53)         = sums(k,45:53) / ngp_2dh(sr)
-          sums(k,55:63)         = sums(k,55:63) / ngp_2dh(sr)
-          sums(k,81:88)         = sums(k,81:88) / ngp_2dh(sr)
-!
-!--       Average land-surface quantities over LSM surfaces only
-          IF ( land_surface  .AND.  surf_lsm_h(0)%ns_tot > 0 )  THEN
-             sums(k,89:92) = sums(k,89:92) / surf_lsm_h(0)%ns_tot
-             sums(k,94:96) = sums(k,94:96) / surf_lsm_h(0)%ns_tot
-             sums(k,98)    = sums(k,98)    / surf_lsm_h(0)%ns_tot
-          ENDIF
-!
-!--       Average land/urban-surface quantities over LSM+USM surfaces. Note, at the moment this
-!--       only works when the land-surface model runs alone or in combination with the urban-
-!--       surface model. This is because the number of output quantities is defined by the LSM.
-!--       This needs to be revised in the future.
-          IF ( land_surface  .AND.  surf_lsm_h(0)%ns_tot + surf_usm_h(0)%ns_tot > 0 )  THEN
-           !  print*, surf_lsm_h(0)%ns_tot + surf_usm_h(0)%ns_tot, surf_lsm_h(0)%ns_tot, surf_usm_h(0)%ns_tot
-             sums(k,93) = sums(k,93) / ( surf_lsm_h(0)%ns_tot + surf_usm_h(0)%ns_tot )
-             sums(k,97) = sums(k,97) / ( surf_lsm_h(0)%ns_tot + surf_usm_h(0)%ns_tot )
-          ENDIF
-
-          sums(k,99:112)        = sums(k,99:112)        / ngp_2dh(sr)
-          sums(k,114)           = sums(k,114)           / ngp_2dh(sr)
-          sums(k,117)           = sums(k,117)           / ngp_2dh(sr)
-          IF ( ngp_2dh_s_inner(k,sr) /= 0 )  THEN
-             sums(k,8:11)          = sums(k,8:11)          / ngp_2dh_s_inner(k,sr)
-             sums(k,23:29)         = sums(k,23:29)         / ngp_2dh_s_inner(k,sr)
-             sums(k,33:34)         = sums(k,33:34)         / ngp_2dh_s_inner(k,sr)
-             sums(k,40)            = sums(k,40)            / ngp_2dh_s_inner(k,sr)
-             sums(k,54)            = sums(k,54)            / ngp_2dh_s_inner(k,sr)
-             sums(k,64)            = sums(k,64)            / ngp_2dh_s_inner(k,sr)
-             sums(k,70:80)         = sums(k,70:80)         / ngp_2dh_s_inner(k,sr)
-             sums(k,116)           = sums(k,116)           / ngp_2dh_s_inner(k,sr)
-             sums(k,118:pr_palm-2) = sums(k,118:pr_palm-2) / ngp_2dh_s_inner(k,sr)
-             sums(k,123:130)       = sums(k,123:130) * ngp_2dh_s_inner(k,sr)  / ngp_2dh(sr)
-          ENDIF
+          sums(k,:var_sum-2)      = sums(k,:var_sum-2) / ngp_2dh_outer(k,sr)
        ENDDO
-
+!--    Upstream-parts
+       sums(nzb:nzb+11,var_sum-1) = sums(nzb:nzb+11,var_sum-1) / ngp_3d(sr)
 !--    u* and so on
-!--    As sums(nzb:nzb+3,pr_palm) are full 2D arrays (us, usws, vsws, ts) whose size is always
-!--    ( nx + 1 ) * ( ny + 1 ), defined at the first grid layer above the topography, they are
-!--    divided by ngp_2dh(sr)
-       sums(nzb:nzb+3,pr_palm)    = sums(nzb:nzb+3,pr_palm)  /  ngp_2dh(sr)
-       sums(nzb+12,pr_palm)       = sums(nzb+12,pr_palm)     /  ngp_2dh(sr)    ! qs
-       sums(nzb+13,pr_palm)       = sums(nzb+13,pr_palm)     /  ngp_2dh(sr)    ! ss
-       sums(nzb+14,pr_palm)       = sums(nzb+14,pr_palm)     /  ngp_2dh(sr)    ! surface temperature
-
+!--    As sums(nzb:nzb+3,var_sum) are full 2D arrays (us, usws, vsws, ts) whose
+!--    size is always ( nx + 1 ) * ( ny + 1 ), defined at the first grid layer
+!--    above the topography, they are being divided by ngp_2dh(sr)
+       sums(nzb:nzb+3,var_sum)    = sums(nzb:nzb+3,var_sum)    / &
+                                    ngp_2dh(sr)
 !--    eges, e*
-       sums(nzb+4:nzb+5,pr_palm)  = sums(nzb+4:nzb+5,pr_palm)  /  ngp_3d(sr)
+       sums(nzb+4:nzb+5,var_sum)  = sums(nzb+4:nzb+5,var_sum)  / &
+                                    ngp_3d_inner(sr)
 !--    Old and new divergence
-       sums(nzb+9:nzb+10,pr_palm) = sums(nzb+9:nzb+10,pr_palm) /  ngp_3d_inner(sr)
-
-!--    User-defined profiles
-       IF ( max_pr_user > 0 )  THEN
-          DO  k = nzb, nzt+1
-             sums(k,pr_palm+1:pr_palm+max_pr_user) =  sums(k,pr_palm+1:pr_palm+max_pr_user) /      &
-                                                      ngp_2dh_s_inner(k,sr)
-          ENDDO
-       ENDIF
-
-       IF ( air_chemistry )  THEN
-          IF ( max_pr_cs > 0 )  THEN
-             DO k = nzb, nzt+1
-                sums(k, pr_palm+1:pr_palm+max_pr_user+max_pr_cs) =                                 &
-                                                sums(k, pr_palm+1:pr_palm+max_pr_user+max_pr_cs) / &
-                                                ngp_2dh_s_inner(k,sr)
-             ENDDO
-          ENDIF
-       ENDIF
-
-       IF ( salsa )  THEN
-          IF ( max_pr_salsa > 0 )  THEN
-             DO k = nzb, nzt+1
-                sums(k,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa) = &
-                  sums(k,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa) &
-                  / ngp_2dh_s_inner(k,sr)
-             ENDDO
-          ENDIF
-       ENDIF
+       sums(nzb+9:nzb+10,var_sum) = sums(nzb+9:nzb+10,var_sum) / &
+                                    ngp_3d_inner(sr)
 
 !
@@ -1945,6 +754,5 @@
        hom(:,1,21,sr) = sums(:,21)     ! w*pt*BC
        hom(:,1,22,sr) = sums(:,16) + sums(:,21)    ! wptBC
-                                       ! profile 24 is initial profile (sa)
-                                       ! profiles 25-29 left empty for initial
+                                       ! profiles 23-29 left empty for initial 
                                        ! profiles
        hom(:,1,30,sr) = sums(:,30)     ! u*2
@@ -1957,8 +765,8 @@
        hom(:,1,37,sr) = sums(:,37)     ! w*e*
        hom(:,1,38,sr) = sums(:,38)     ! w*3
-       hom(:,1,39,sr) = sums(:,38) / ( ABS( sums(:,32) ) + 1E-20_wp )**1.5_wp   ! Sw
+       hom(:,1,39,sr) = sums(:,38) / ( sums(:,32) + 1E-20 )**1.5    ! Sw
        hom(:,1,40,sr) = sums(:,40)     ! p
-       hom(:,1,45,sr) = sums(:,45)     ! w"vpt"
-       hom(:,1,46,sr) = sums(:,46)     ! w*vpt*
+       hom(:,1,45,sr) = sums(:,45)     ! w"q"
+       hom(:,1,46,sr) = sums(:,46)     ! w*vpt*       
        hom(:,1,47,sr) = sums(:,45) + sums(:,46)    ! wvpt
        hom(:,1,48,sr) = sums(:,48)     ! w"q" (w"qv")
@@ -1966,10 +774,10 @@
        hom(:,1,50,sr) = sums(:,48) + sums(:,49)    ! wq (wqv)
        hom(:,1,51,sr) = sums(:,51)     ! w"qv"
-       hom(:,1,52,sr) = sums(:,52)     ! w*qv*
+       hom(:,1,52,sr) = sums(:,52)     ! w*qv*       
        hom(:,1,53,sr) = sums(:,52) + sums(:,51)    ! wq (wqv)
        hom(:,1,54,sr) = sums(:,54)     ! ql
        hom(:,1,55,sr) = sums(:,55)     ! w*u*u*/dz
        hom(:,1,56,sr) = sums(:,56)     ! w*p*/dz
-       hom(:,1,57,sr) = sums(:,57)     ! ( w"e + w"p"/rho_ocean )/dz
+       hom(:,1,57,sr) = sums(:,57)     ! w"e/dz
        hom(:,1,58,sr) = sums(:,58)     ! u"pt"
        hom(:,1,59,sr) = sums(:,59)     ! u*pt*
@@ -1978,210 +786,32 @@
        hom(:,1,62,sr) = sums(:,62)     ! v*pt*
        hom(:,1,63,sr) = sums(:,61) + sums(:,62)    ! vpt_t
-       hom(:,1,64,sr) = sums(:,64)     ! rho_ocean
-       hom(:,1,65,sr) = sums(:,65)     ! w"sa"
-       hom(:,1,66,sr) = sums(:,66)     ! w*sa*
-       hom(:,1,67,sr) = sums(:,65) + sums(:,66)    ! wsa
-       hom(:,1,68,sr) = sums(:,68)     ! w*p*
-       hom(:,1,69,sr) = sums(:,69)     ! w"e + w"p"/rho_ocean
-       hom(:,1,70,sr) = sums(:,70)     ! q*2
-       hom(:,1,71,sr) = sums(:,71)     ! prho
-       hom(:,1,72,sr) = hyp * 1E-2_wp  ! hyp in hPa
-       hom(:,1,123,sr) = sums(:,123)   ! nc
-       hom(:,1,124,sr) = sums(:,124)   ! ni
-       hom(:,1,125,sr) = sums(:,125)   ! qi
-       hom(:,1,126,sr) = sums(:,126)   ! ng
-       hom(:,1,127,sr) = sums(:,127)   ! qg
-       hom(:,1,128,sr) = sums(:,128)   ! ns
-       hom(:,1,129,sr) = sums(:,129)   ! qs
-       hom(:,1,130,sr) = sums(:,130)   ! rh
-       hom(:,1,73,sr) = sums(:,73)     ! nr
-       hom(:,1,74,sr) = sums(:,74)     ! qr
-       hom(:,1,75,sr) = sums(:,75)     ! qc
-       hom(:,1,76,sr) = sums(:,76)     ! prr (precipitation rate)
-                                       ! 77 is initial density profile
-       hom(:,1,78,sr) = ug             ! ug
-       hom(:,1,79,sr) = vg             ! vg
-       hom(:,1,80,sr) = w_subs         ! w_subs
-
-       IF ( large_scale_forcing )  THEN
-          hom(:,1,81,sr) = sums_ls_l(:,0)          ! td_lsa_lpt
-          hom(:,1,82,sr) = sums_ls_l(:,1)          ! td_lsa_q
-          IF ( use_subsidence_tendencies )  THEN
-             hom(:,1,83,sr) = sums_ls_l(:,2)       ! td_sub_lpt
-             hom(:,1,84,sr) = sums_ls_l(:,3)       ! td_sub_q
-          ELSE
-             hom(:,1,83,sr) = sums(:,83)           ! td_sub_lpt
-             hom(:,1,84,sr) = sums(:,84)           ! td_sub_q
+
+       hom(:,1,var_hom-1,sr) = sums(:,var_sum-1)
+                                       ! upstream-parts u_x, u_y, u_z, v_x,
+                                       ! v_y, usw. (in last but one profile)
+       hom(:,1,var_hom,sr) = sums(:,var_sum)  
+                                       ! u*, w'u', w'v', t* (in last profile)
+
+!
+!--    Determine the boundary layer height using two different schemes.
+!--    First scheme: Starting from the Earth's surface, look for the first 
+!--    relative minimum of the total heat flux. The corresponding height is
+!--    accepted as the boundary layer height, if it is less than 1.5 times the
+!--    height where the heat flux becomes negative for the first time.
+!--    NOTE: This criterion is still capable of improving!
+       z_i(1) = 0.0
+       first = .TRUE.
+       DO  k = nzb, nzt-1
+          IF ( first .AND. hom(k,1,18,sr) < 0.0 )  THEN
+             first = .FALSE.
+             height = zw(k)
           ENDIF
-          hom(:,1,85,sr) = sums(:,85)              ! td_nud_lpt
-          hom(:,1,86,sr) = sums(:,86)              ! td_nud_q
-          hom(:,1,87,sr) = sums(:,87)              ! td_nud_u
-          hom(:,1,88,sr) = sums(:,88)              ! td_nud_v
-       ENDIF
-
-       IF ( land_surface )  THEN
-          hom(:,1,89,sr) = sums(:,89)              ! t_soil
-                                                   ! 90 is initial t_soil profile
-          hom(:,1,91,sr) = sums(:,91)              ! m_soil
-                                                   ! 92 is initial m_soil profile
-          hom(:,1,93,sr)  = sums(:,93)             ! ghf
-          hom(:,1,94,sr)  = sums(:,94)             ! qsws_liq
-          hom(:,1,95,sr)  = sums(:,95)             ! qsws_soil
-          hom(:,1,96,sr)  = sums(:,96)             ! qsws_veg
-          hom(:,1,97,sr)  = sums(:,97)             ! r_a
-          hom(:,1,98,sr)  = sums(:,98)             ! r_s
-
-       ENDIF
-
-       IF ( radiation )  THEN
-          hom(:,1,99,sr) = sums(:,99)            ! rad_net
-          hom(:,1,100,sr) = sums(:,100)            ! rad_lw_in
-          hom(:,1,101,sr) = sums(:,101)            ! rad_lw_out
-          hom(:,1,102,sr) = sums(:,102)            ! rad_sw_in
-          hom(:,1,103,sr) = sums(:,103)            ! rad_sw_out
-
-          IF ( radiation_scheme == 'rrtmg' )  THEN
-             hom(:,1,104,sr) = sums(:,104)            ! rad_lw_cs_hr
-             hom(:,1,105,sr) = sums(:,105)            ! rad_lw_hr
-             hom(:,1,106,sr) = sums(:,106)            ! rad_sw_cs_hr
-             hom(:,1,107,sr) = sums(:,107)            ! rad_sw_hr
-
-             hom(:,1,108,sr) = sums(:,108)            ! rrtm_aldif
-             hom(:,1,109,sr) = sums(:,109)            ! rrtm_aldir
-             hom(:,1,110,sr) = sums(:,110)            ! rrtm_asdif
-             hom(:,1,111,sr) = sums(:,111)            ! rrtm_asdir
-          ENDIF
-       ENDIF
-
-       hom(:,1,112,sr) = sums(:,112)            !: L
-
-       IF ( passive_scalar )  THEN
-          hom(:,1,117,sr) = sums(:,117)     ! w"s"
-          hom(:,1,114,sr) = sums(:,114)     ! w*s*
-          hom(:,1,118,sr) = sums(:,117) + sums(:,114)    ! ws
-          hom(:,1,116,sr) = sums(:,116)     ! s*2
-       ENDIF
-
-       hom(:,1,119,sr) = rho_air       ! rho_air in Kg/m^3
-       hom(:,1,120,sr) = rho_air_zw    ! rho_air_zw in Kg/m^3
-
-       IF ( kolmogorov_length_scale )  THEN
-          hom(:,1,121,sr) = sums(:,121) * 1E3_wp  ! eta in mm
-       ENDIF
-
-
-       hom(:,1,pr_palm,sr) =   sums(:,pr_palm)
-                                       ! u*, w'u', w'v', t* (in last profile)
-
-       IF ( max_pr_user > 0 )  THEN    ! user-defined profiles
-          hom(:,1,pr_palm+1:pr_palm+max_pr_user,sr) = &
-                               sums(:,pr_palm+1:pr_palm+max_pr_user)
-       ENDIF
-
-       IF ( air_chemistry )  THEN
-          IF ( max_pr_cs > 0 )  THEN    ! chem_spcs profiles
-             hom(:, 1, pr_palm+max_pr_user+1:pr_palm + max_pr_user+max_pr_cs, sr) = &
-                               sums(:, pr_palm+max_pr_user+1:pr_palm+max_pr_user+max_pr_cs)
-          ENDIF
-       ENDIF
-
-       IF ( salsa )  THEN
-          IF ( max_pr_salsa > 0 )  THEN    ! salsa profiles
-             hom(:,1,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa, sr) = &
-                  sums(:,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa)
-          ENDIF
-       ENDIF
-!
-!--    Determine the boundary layer height using two different schemes.
-!--    First scheme: Starting from the Earth's (Ocean's) surface, look for the first relative
-!--    minimum (maximum) of the total heat flux.
-!--    The corresponding height is assumed as the boundary layer height, if it is less than 1.5
-!--    times the height where the heat flux becomes negative (positive) for the first time.
-!--    Attention: the resolved vertical sensible heat flux (hom(:,1,17,sr) = w*pt*) is not known at
-!--    the beginning because the calculation happens in advec_s_ws which is called after
-!--    flow_statistics. Therefore z_i is directly taken from restart data at the beginning of
-!--    restart runs.
-       IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .OR.                              &
-            simulated_time_at_begin /= simulated_time ) THEN
-
-          z_i(1) = 0.0_wp
-          first = .TRUE.
-
-          IF ( ocean_mode )  THEN
-             DO  k = nzt, nzb+1, -1
-                IF ( first  .AND.  hom(k,1,18,sr) < -1.0E-8_wp )  THEN
-                   first = .FALSE.
-                   height = zw(k)
-                ENDIF
-                IF ( hom(k,1,18,sr) < -1.0E-8_wp  .AND.  hom(k-1,1,18,sr) > hom(k,1,18,sr) )  THEN
-                   IF ( zw(k) < 1.5_wp * height )  THEN
-                      z_i(1) = zw(k)
-                   ELSE
-                      z_i(1) = height
-                   ENDIF
-                   EXIT
-                ENDIF
-             ENDDO
-          ELSE
-             DO  k = nzb, nzt-1
-                IF ( first  .AND.  hom(k,1,18,sr) < -1.0E-8_wp )  THEN
-                   first = .FALSE.
-                   height = zw(k)
-                ENDIF
-                IF ( hom(k,1,18,sr) < -1.0E-8_wp  .AND.  hom(k+1,1,18,sr) > hom(k,1,18,sr) )  THEN
-                   IF ( zw(k) < 1.5_wp * height )  THEN
-                      z_i(1) = zw(k)
-                   ELSE
-                      z_i(1) = height
-                   ENDIF
-                   EXIT
-                ENDIF
-             ENDDO
-          ENDIF
-
-!
-!--       Second scheme: Gradient scheme from Sullivan et al. (1998), modified by Uhlenbrock(2006).
-!--       The boundary layer height is the height with the maximal local temperature gradient:
-!--       starting from the second (the last but one) vertical gridpoint, the local gradient must be
-!--       at least 0.2K/100m and greater than the next four gradients.
-!--       WARNING: The threshold value of 0.2K/100m must be adjusted for the
-!--       ocean case!
-          z_i(2) = 0.0_wp
-          DO  k = nzb+1, nzt+1
-             dptdz(k) = ( hom(k,1,4,sr) - hom(k-1,1,4,sr) ) * ddzu(k)
-          ENDDO
-          dptdz_threshold = 0.2_wp / 100.0_wp
-
-          IF ( ocean_mode )  THEN
-             DO  k = nzt+1, nzb+5, -1
-                IF ( dptdz(k) > dptdz_threshold  .AND.                                             &
-                     dptdz(k) > dptdz(k-1)  .AND.  dptdz(k) > dptdz(k-2)  .AND.                    &
-                     dptdz(k) > dptdz(k-3)  .AND.  dptdz(k) > dptdz(k-4) )  THEN
-                   z_i(2) = zw(k-1)
-                   EXIT
-                ENDIF
-             ENDDO
-          ELSE
-             DO  k = nzb+1, nzt-3
-                IF ( dptdz(k) > dptdz_threshold  .AND.                                             &
-                     dptdz(k) > dptdz(k+1)  .AND.  dptdz(k) > dptdz(k+2)  .AND.                    &
-                     dptdz(k) > dptdz(k+3)  .AND.  dptdz(k) > dptdz(k+4) )  THEN
-                   z_i(2) = zw(k-1)
-                   EXIT
-                ENDIF
-             ENDDO
-          ENDIF
-
-       ENDIF
-
-       hom(nzb+6,1,pr_palm,sr) = z_i(1)
-       hom(nzb+7,1,pr_palm,sr) = z_i(2)
-
-!
-!--    Determine vertical index which is nearest to the mean surface level height of the respective
-!--    statistic region
-       DO  k = nzb, nzt
-          IF ( zw(k) >= mean_surface_level_height(sr) )  THEN
-             k_surface_level = k
+          IF ( hom(k,1,18,sr) < 0.0  .AND. &
+               hom(k+1,1,18,sr) > hom(k,1,18,sr) )  THEN
+             IF ( zw(k) < 1.5 * height )  THEN
+                z_i(1) = zw(k)
+             ELSE
+                z_i(1) = height
+             ENDIF
              EXIT
           ENDIF
@@ -2189,98 +819,43 @@
 
 !
-!--    Computation of both the characteristic vertical velocity and the characteristic convective
-!--    boundary layer temperature.
-!--    The inversion height entering into the equation is defined with respect to the mean surface
-!--    level height of the respective statistic region.
-!--    The horizontal average at surface level index + 1 is input for the average temperature.
-       IF ( hom(k_surface_level,1,18,sr) > 1.0E-8_wp  .AND.  z_i(1) /= 0.0_wp )  THEN
-          hom(nzb+8,1,pr_palm,sr) =                                                                &
-                                   ( g / hom(k_surface_level+1,1,4,sr) *                           &
-                                   ( hom(k_surface_level,1,18,sr) /                                &
-                                   ( heatflux_output_conversion(nzb) * rho_air(nzb) ) )            &
-                                   * ABS( z_i(1) - mean_surface_level_height(sr) ) )**0.333333333_wp
+!--    Second scheme: Starting from the top model boundary, look for the first 
+!--    characteristic kink in the temperature profile, where the originally 
+!--    stable stratification notably weakens.
+       z_i(2) = 0.0
+       DO  k = nzt-1, nzb+1, -1
+          IF ( ( hom(k+1,1,4,sr) - hom(k,1,4,sr) ) > &
+               2.0 * ( hom(k,1,4,sr) - hom(k-1,1,4,sr) ) )  THEN
+             z_i(2) = zu(k)
+             EXIT
+          ENDIF
+       ENDDO
+
+       hom(nzb+6,1,var_hom,sr) = z_i(1)
+       hom(nzb+7,1,var_hom,sr) = z_i(2)
+
+!
+!--    Computation of both the characteristic vertical velocity and
+!--    the characteristic convective boundary layer temperature.
+!--    The horizontal average at nzb+1 is input for the average temperature.
+       IF ( hom(nzb,1,18,sr) > 0.0  .AND.  z_i(1) /= 0.0 )  THEN
+          hom(nzb+8,1,var_hom,sr)  = ( g / hom(nzb+1,1,4,sr) * &
+                                       hom(nzb,1,18,sr) * z_i(1) )**0.333333333
+!--       so far this only works if Prandtl layer is used
+          hom(nzb+11,1,var_hom,sr) = hom(nzb,1,16,sr) / hom(nzb+8,1,var_hom,sr)
        ELSE
-          hom(nzb+8,1,pr_palm,sr)  = 0.0_wp
-       ENDIF
-
-!
-!--    Collect the time series quantities. Please note, timeseries quantities which are collected
-!--    from horizontally averaged profiles, e.g. wpt or pt(zp), are treated specially. In case of
-!--    elevated model surfaces, index nzb+1 might be within topography and data will be zero.
-!--    Therefore, take value for the first atmosphere index, which is topo_min_level+1.
-       ts_value(1,sr) = hom(nzb+4,1,pr_palm,sr)        ! E
-       ts_value(2,sr) = hom(nzb+5,1,pr_palm,sr)        ! E*
-       ts_value(3,sr) = dt_3d
-       ts_value(4,sr) = hom(nzb,1,pr_palm,sr)          ! u*
-       ts_value(5,sr) = hom(nzb+3,1,pr_palm,sr)        ! th*
-       ts_value(6,sr) = u_max
-       ts_value(7,sr) = v_max
-       ts_value(8,sr) = w_max
-       ts_value(9,sr) = hom(nzb+10,1,pr_palm,sr)       ! new divergence
-       ts_value(10,sr) = hom(nzb+9,1,pr_palm,sr)       ! old Divergence
-       ts_value(11,sr) = hom(nzb+6,1,pr_palm,sr)       ! z_i(1)
-       ts_value(12,sr) = hom(nzb+7,1,pr_palm,sr)       ! z_i(2)
-       ts_value(13,sr) = hom(nzb+8,1,pr_palm,sr)       ! w*
-       ts_value(14,sr) = hom(nzb,1,16,sr)              ! w'pt'   at k=0
-       ts_value(15,sr) = hom(topo_min_level+1,1,16,sr) ! w'pt'   at k=1
-       ts_value(16,sr) = hom(topo_min_level+1,1,18,sr) ! wpt     at k=1
-       ts_value(17,sr) = hom(nzb+14,1,pr_palm,sr)      ! pt(0)
-       ts_value(18,sr) = hom(topo_min_level+1,1,4,sr)  ! pt(zp)
-       ts_value(19,sr) = hom(nzb+1,1,pr_palm,sr)       ! u'w'    at k=0
-       ts_value(20,sr) = hom(nzb+2,1,pr_palm,sr)       ! v'w'    at k=0
-       ts_value(21,sr) = hom(nzb,1,48,sr)              ! w"q"    at k=0
-
-       IF ( .NOT. neutral )  THEN
-          ts_value(22,sr) = hom(nzb,1,112,sr)          ! L
-       ELSE
-          ts_value(22,sr) = 1.0E10_wp
-       ENDIF
-
-       ts_value(23,sr) = hom(nzb+12,1,pr_palm,sr)   ! q*
-
-       IF ( passive_scalar )  THEN
-          ts_value(24,sr) = hom(nzb+13,1,117,sr)       ! w"s" ( to do ! )
-          ts_value(25,sr) = hom(nzb+13,1,pr_palm,sr)   ! s*
-       ENDIF
-
-!
-!--    Collect land surface model timeseries
-       IF ( land_surface )  THEN
-          ts_value(dots_soil  ,sr) = hom(nzb,1,93,sr)           ! ghf
-          ts_value(dots_soil+1,sr) = hom(nzb,1,94,sr)           ! qsws_liq
-          ts_value(dots_soil+2,sr) = hom(nzb,1,95,sr)           ! qsws_soil
-          ts_value(dots_soil+3,sr) = hom(nzb,1,96,sr)           ! qsws_veg
-          ts_value(dots_soil+4,sr) = hom(nzb,1,97,sr)           ! r_a
-          ts_value(dots_soil+5,sr) = hom(nzb,1,98,sr)           ! r_s
-       ENDIF
-!
-!--    Collect radiation model timeseries
-       IF ( radiation )  THEN
-          ts_value(dots_rad,sr)   = hom(nzb,1,99,sr)           ! rad_net
-          ts_value(dots_rad+1,sr) = hom(nzb,1,100,sr)          ! rad_lw_in
-          ts_value(dots_rad+2,sr) = hom(nzb,1,101,sr)          ! rad_lw_out
-          ts_value(dots_rad+3,sr) = hom(nzb,1,102,sr)          ! rad_sw_in
-          ts_value(dots_rad+4,sr) = hom(nzb,1,103,sr)          ! rad_sw_out
-
-          IF ( radiation_scheme == 'rrtmg' )  THEN
-             ts_value(dots_rad+5,sr) = hom(nzb,1,108,sr)          ! rrtm_aldif
-             ts_value(dots_rad+6,sr) = hom(nzb,1,109,sr)          ! rrtm_aldir
-             ts_value(dots_rad+7,sr) = hom(nzb,1,110,sr)          ! rrtm_asdif
-             ts_value(dots_rad+8,sr) = hom(nzb,1,111,sr)          ! rrtm_asdir
-          ENDIF
-
-       ENDIF
-
-!
-!--    Calculate additional statistics provided by other modules
-       CALL module_interface_statistics( 'time_series', sr, 0, dots_max )
+          hom(nzb+8,1,var_hom,sr)  = 0.0
+          hom(nzb+11,1,var_hom,sr) = 0.0
+       ENDIF
 
     ENDDO    ! loop of the subregions
 
 !
-!-- If required, sum up horizontal averages for subsequent time averaging.
-!-- Do not sum, if flow statistics is called before the first initial time step.
-    IF ( do_sum  .AND.  simulated_time /= 0.0_wp )  THEN
-       IF ( average_count_pr == 0 )  hom_sum = 0.0_wp
+!-- Calculate additional statistics provided by the user interface
+    CALL user_statistics
+
+!
+!-- If required, sum up horizontal averages for subsequent time averaging
+    IF ( do_sum )  THEN
+       IF ( average_count_pr == 0 )  hom_sum = 0.0
        hom_sum = hom_sum + hom(:,1,:,:)
        average_count_pr = average_count_pr + 1
@@ -2297,2 +872,5 @@
 
  END SUBROUTINE flow_statistics
+
+
+
Index: palm/trunk/SOURCE/global_min_max.f90
===================================================================
--- palm/trunk/SOURCE/global_min_max.f90	(revision 4901)
+++ palm/trunk/SOURCE/global_min_max.f90	(revision 1)
@@ -1,46 +1,45 @@
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
+ SUBROUTINE global_min_max( i1, i2, j1, j2, k1, k2, ar, mode, value, &
+                            value_ijk, value1, value1_ijk )
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! bugfix for correct identification of indices of extreme values in case of non-cyclic
-! boundary conditions
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! preprocessor branch for ibm removed
-!
-! 4646 2020-08-24 16:02:40Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4429 2020-02-27 15:24:30Z raasch
-! bugfix: cpp-directives added for serial mode
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! OpenACC support added
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
+! $Log: global_min_max.f90,v $
+! Revision 1.11  2003/04/16 12:56:58  raasch
+! Index values of the extrema are limited to the range 0..nx, 0..ny
+!
+! Revision 1.10  2003/03/16 09:39:21  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.9  2003/03/14 13:42:50  raasch
+! IF clause extracted from loop which determines the absolut array maximum,
+! because otherwise it prevents vectorization of that loop
+!
+! Revision 1.8  2002/12/19 14:51:03  raasch
+! Speed optimization by removing MINVAL/MAXVAL calls and by handling
+! the "abs" case in a different way than the min/max cases,
+! translation of remaining variables
+!
+! Revision 1.7  2002/06/11 13:08:16  raasch
+! Last change limited to IBM since it does not work on 64-bit machines
+!
+! Revision 1.6  2002/05/02  18:50:36  18:50:36  raasch (Siegfried Raasch)
+! Type of fmax, fmax_l, fmin and fmin_l changed to REAL (KIND=4).
+! 
+! Revision 1.5  2001/01/22 06:51:02  raasch
+! Module test_variables removed
+!
+! Revision 1.4  2000/12/20 12:19:57  letzel
+! All comments translated into English.
+!
+! Revision 1.3  1998/07/06 12:14:37  raasch
+! + USE test_variables
+!
+! Revision 1.2  1997/08/11 06:16:54  raasch
+! Indices des ermittelten Minumums/Maximums werden an PEs gesendet
 !
 ! Revision 1.1  1997/07/24 11:14:03  raasch
@@ -50,61 +49,28 @@
 ! Description:
 ! ------------
-!> Determine the array minimum/maximum and the corresponding indices.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE global_min_max( i1, i2, j1, j2, k1, k2, ar, mode, offset, value, value_ijk, value1,    &
-                            value1_ijk )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr, bc_ns
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, ny, nx
-
-    USE kinds
-
+! Determine the array minimum/maximum and the corresponding indices.
+!-------------------------------------------------------------------------------!
+
+    USE indices
     USE pegrid
 
     IMPLICIT NONE
 
-    CHARACTER (LEN=*) ::  mode  !<
-
-    INTEGER(iwp) ::  i              !<
-    INTEGER(iwp) ::  i1             !<
-    INTEGER(iwp) ::  i2             !<
-#if defined( __parallel )
-    INTEGER(iwp) ::  id_fmax        !<
-    INTEGER(iwp) ::  id_fmin        !<
-#endif
-    INTEGER(iwp) ::  j              !<
-    INTEGER(iwp) ::  j1             !<
-    INTEGER(iwp) ::  j2             !<
-    INTEGER(iwp) ::  k              !<
-    INTEGER(iwp) ::  k1             !<
-    INTEGER(iwp) ::  k2             !<
-    INTEGER(iwp) ::  value_ijk(3)   !<
-
-    INTEGER(iwp), DIMENSION(3) ::  fmax_ijk    !<
-    INTEGER(iwp), DIMENSION(3) ::  fmax_ijk_l  !<
-    INTEGER(iwp), DIMENSION(3) ::  fmin_ijk    !<
-    INTEGER(iwp), DIMENSION(3) ::  fmin_ijk_l  !<
-
-    INTEGER(iwp), DIMENSION(3), OPTIONAL ::  value1_ijk  !<
-
-    REAL(wp) ::  offset            !<
-    REAL(wp) ::  value             !<
-    REAL(wp), OPTIONAL ::  value1  !<
-
-    REAL(wp), DIMENSION(2) ::  fmax    !<
-    REAL(wp), DIMENSION(2) ::  fmax_l  !<
-    REAL(wp), DIMENSION(2) ::  fmin    !<
-    REAL(wp), DIMENSION(2) ::  fmin_l  !<
-
-    REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) ::  ar  !<
-
-#if defined( _OPENACC )
-    INTEGER(iwp) ::  count_eq   !< counter for locations of maximum
-    REAL(wp)     ::  red        !< scalar for reduction with OpenACC
-#endif
+    CHARACTER (LEN=*) ::  mode
+
+    INTEGER           ::  i, i1, i2, id_fmax, id_fmin, j, j1, j2, k, k1, k2, &
+                          fmax_ijk(3), fmax_ijk_l(3), fmin_ijk(3), &
+                          fmin_ijk_l(3), value_ijk(3)
+    INTEGER, OPTIONAL ::  value1_ijk(3)
+    REAL              ::  value, &
+                          ar(i1:i2,j1:j2,k1:k2)
+#if defined( __ibm )
+    REAL (KIND=4)     ::  fmax(2), fmax_l(2), fmin(2), fmin_l(2)  ! on 32bit-
+                          ! machines MPI_2REAL must not be replaced by
+                          ! MPI_2DOUBLE_PRECISION
+#else
+    REAL              ::  fmax(2), fmax_l(2), fmin(2), fmin_l(2)
+#endif
+    REAL, OPTIONAL    ::  value1
 
 
@@ -116,12 +82,11 @@
 !--    Determine the local minimum
        fmin_ijk_l = MINLOC( ar )
-       fmin_ijk_l(1) = i1 + fmin_ijk_l(1) - 1 ! MINLOC assumes lowerbound = 1
-       fmin_ijk_l(2) = j1 + fmin_ijk_l(2) - nbgp
-       fmin_ijk_l(3) = k1 + fmin_ijk_l(3) - nbgp
+       fmin_ijk_l(1) = i1 + fmin_ijk_l(1) - 1    ! MINLOC assumes lowerbound = 1
+       fmin_ijk_l(2) = j1 + fmin_ijk_l(2) - 1
+       fmin_ijk_l(3) = k1 + fmin_ijk_l(3) - 1
        fmin_l(1)  = ar(fmin_ijk_l(1),fmin_ijk_l(2),fmin_ijk_l(3))
 
 #if defined( __parallel )
        fmin_l(2)  = myid
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
        CALL MPI_ALLREDUCE( fmin_l, fmin, 1, MPI_2REAL, MPI_MINLOC, comm2d, ierr )
 
@@ -131,5 +96,6 @@
        IF ( id_fmin /= 0 )  THEN
           IF ( myid == 0 )  THEN
-             CALL MPI_RECV( fmin_ijk, 3, MPI_INTEGER, id_fmin, 0, comm2d, status, ierr )
+             CALL MPI_RECV( fmin_ijk, 3, MPI_INTEGER, id_fmin, 0, comm2d, &
+                            status, ierr )
           ELSEIF ( myid == id_fmin )  THEN
              CALL MPI_SEND( fmin_ijk_l, 3, MPI_INTEGER, 0, 0, comm2d, ierr )
@@ -155,12 +121,11 @@
 !--    Determine the local maximum
        fmax_ijk_l = MAXLOC( ar )
-       fmax_ijk_l(1) = i1 + fmax_ijk_l(1) - 1 ! MAXLOC assumes lowerbound = 1
-       fmax_ijk_l(2) = j1 + fmax_ijk_l(2) - nbgp
-       fmax_ijk_l(3) = k1 + fmax_ijk_l(3) - nbgp
+       fmax_ijk_l(1) = i1 + fmax_ijk_l(1) - 1    ! MAXLOC assumes lowerbound = 1
+       fmax_ijk_l(2) = j1 + fmax_ijk_l(2) - 1
+       fmax_ijk_l(3) = k1 + fmax_ijk_l(3) - 1
        fmax_l(1) = ar(fmax_ijk_l(1),fmax_ijk_l(2),fmax_ijk_l(3))
 
 #if defined( __parallel )
        fmax_l(2)  = myid
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
        CALL MPI_ALLREDUCE( fmax_l, fmax, 1, MPI_2REAL, MPI_MAXLOC, comm2d, ierr )
 
@@ -170,5 +135,6 @@
        IF ( id_fmax /= 0 )  THEN
           IF ( myid == 0 )  THEN
-             CALL MPI_RECV( fmax_ijk, 3, MPI_INTEGER, id_fmax, 0, comm2d, status, ierr )
+             CALL MPI_RECV( fmax_ijk, 3, MPI_INTEGER, id_fmax, 0, comm2d, &
+                            status, ierr )
           ELSEIF ( myid == id_fmax )  THEN
              CALL MPI_SEND( fmax_ijk_l, 3, MPI_INTEGER, 0, 0, comm2d, ierr )
@@ -178,5 +144,5 @@
        ENDIF
 !
-!--    Send the indices of the just determined array maximum to other PEs
+!--    send the indices of the just determined array maximum to other PEs
        CALL MPI_BCAST( fmax_ijk, 3, MPI_INTEGER, 0, comm2d, ierr )
 #else
@@ -191,53 +157,7 @@
     IF ( mode == 'abs' )  THEN
 
-#if defined( _OPENACC )
-       red = 0.0_wp
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-       !$ACC PRESENT(ar) COPY(red) REDUCTION(MAX: red)
-       DO  k = k1, k2
-          DO  j = j1, j2
-             DO  i = i1, i2
-                IF ( ABS( ar(i,j,k) ) > red )  THEN
-                   red = ABS( ar(i,j,k) )
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-       fmax_l(1) = red
-
-!
-!--    Determine the maximum's position and count how often it is found.
-       count_eq = 0
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-       !$ACC PRESENT(ar) COPY(fmax_ijk_l(1:3), count_eq) &
-       !$ACC REDUCTION(+:count_eq)
-       DO  k = k1, k2
-          DO  j = j1, j2
-             DO  i = i1, i2
-                IF ( ABS( ar(i,j,k) ) == red )  THEN
-                   fmax_ijk_l(1) = i
-                   fmax_ijk_l(2) = j
-                   fmax_ijk_l(3) = k
-                   count_eq = count_eq + 1
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-       IF ( count_eq == 1 ) THEN
-!
-!--       We found a single maximum element and correctly got its position. Transfer its value to
-!--       handle the negative case correctly.
-          !$ACC UPDATE HOST(ar(fmax_ijk_l(1):fmax_ijk_l(1),fmax_ijk_l(2),fmax_ijk_l(3)))
-       ELSE
-!
-!--       We found no maximum element (?) or multiple, so the position is not correct.
-!--       Copy the full array to the host and determine the maximum sequentially...
-          !$ACC UPDATE HOST(ar(i1:i2,j1:j2,k1:k2))
-#endif
-
 !
 !--    Determine the local absolut maximum
-       fmax_l(1)     = 0.0_wp
+       fmax_l(1)     = 0.0
        fmax_ijk_l(1) =  i1
        fmax_ijk_l(2) =  j1
@@ -256,14 +176,9 @@
        ENDDO
 
-#if defined( _OPENACC )
-!
-!--    Close ELSE case from above
-       ENDIF
-#endif
-
 !
 !--    Set a flag in case that the determined value is negative.
-!--    A constant offset has to be subtracted in order to handle the special case i=0 correctly.
-       IF ( ar(fmax_ijk_l(1),fmax_ijk_l(2),fmax_ijk_l(3)) < 0.0_wp )  THEN
+!--    A constant offset has to be subtracted in order to handle the special
+!--    case i=0 correctly
+       IF ( ar(fmax_ijk_l(1),fmax_ijk_l(2),fmax_ijk_l(3)) < 0.0 )  THEN
           fmax_ijk_l(1) = -fmax_ijk_l(1) - 10
        ENDIF
@@ -271,6 +186,6 @@
 #if defined( __parallel )
        fmax_l(2)  = myid
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( fmax_l, fmax, 1, MPI_2REAL, MPI_MAXLOC, comm2d, ierr )
+       CALL MPI_ALLREDUCE( fmax_l, fmax, 1, MPI_2REAL, MPI_MAXLOC, comm2d, &
+                           ierr )
 
 !
@@ -279,66 +194,6 @@
        IF ( id_fmax /= 0 )  THEN
           IF ( myid == 0 )  THEN
-             CALL MPI_RECV( fmax_ijk, 3, MPI_INTEGER, id_fmax, 0, comm2d, status, ierr )
-          ELSEIF ( myid == id_fmax )  THEN
-             CALL MPI_SEND( fmax_ijk_l, 3, MPI_INTEGER, 0, 0, comm2d, ierr )
-          ENDIF
-       ELSE
-          fmax_ijk = fmax_ijk_l
-       ENDIF
-!
-!--    Send the indices of the just determined absolut maximum to other PEs
-       CALL MPI_BCAST( fmax_ijk, 3, MPI_INTEGER, 0, comm2d, ierr )
-#else
-       fmax(1)  = fmax_l(1)
-       fmax_ijk = fmax_ijk_l
-#endif
-
-    ENDIF
-
-!
-!-- Determine absolute maximum of ( array - offset )
-    IF ( mode == 'absoff' )  THEN
-
-!
-!--    Determine the local absolut maximum
-       fmax_l(1)     = 0.0_wp
-       fmax_ijk_l(1) =  i1
-       fmax_ijk_l(2) =  j1
-       fmax_ijk_l(3) =  k1
-       DO  k = k1, k2
-          DO  j = j1, j2
-!
-!--          Attention: the lowest gridpoint is excluded here, because there is no advection at
-!--          ---------- nzb=0 and mode 'absoff' is only used for calculating u,v extrema for
-!--                     CFL-criteria.
-             DO  i = i1+1, i2
-                IF ( ABS( ar(i,j,k) - offset ) > fmax_l(1) )  THEN
-                   fmax_l(1) = ABS( ar(i,j,k) - offset )
-                   fmax_ijk_l(1) = i
-                   fmax_ijk_l(2) = j
-                   fmax_ijk_l(3) = k
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-!
-!--    Set a flag in case that the determined value is negative.
-!--    A constant offset has to be subtracted in order to handle the special case i=0 correctly.
-       IF ( ar(fmax_ijk_l(1),fmax_ijk_l(2),fmax_ijk_l(3)) < 0.0_wp )  THEN
-          fmax_ijk_l(1) = -fmax_ijk_l(1) - 10
-       ENDIF
-
-#if defined( __parallel )
-       fmax_l(2)  = myid
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( fmax_l, fmax, 1, MPI_2REAL, MPI_MAXLOC, comm2d, ierr )
-
-!
-!--    Determine the global absolut maximum. Result stored on PE0.
-       id_fmax = fmax(2)
-       IF ( id_fmax /= 0 )  THEN
-          IF ( myid == 0 )  THEN
-             CALL MPI_RECV( fmax_ijk, 3, MPI_INTEGER, id_fmax, 0, comm2d, status, ierr )
+             CALL MPI_RECV( fmax_ijk, 3, MPI_INTEGER, id_fmax, 0, comm2d, &
+                            status, ierr )
           ELSEIF ( myid == id_fmax )  THEN
              CALL MPI_SEND( fmax_ijk_l, 3, MPI_INTEGER, 0, 0, comm2d, ierr )
@@ -378,16 +233,11 @@
           value1_ijk = fmax_ijk
 
-       CASE( 'abs', 'absoff' )
+       CASE( 'abs' )
 
           value     = fmax(1)
           value_ijk = fmax_ijk
-          IF ( fmax_ijk(1) <= -10 )  THEN
-!
-!--          Index needs to be corrected because it has been modified above to indicate negative
-!--          values
+          IF ( fmax_ijk(1) < 0 )  THEN
+             value        = -value
              value_ijk(1) = -value_ijk(1) - 10
-!
-!--          For this reason also change the sign of the quantity
-             value        = -value
           ENDIF
 
@@ -395,14 +245,10 @@
 
 !
-!-- Limit index values to the range 0..nx, 0..ny. Non-cyclic setups may have extrema at the
-!-- outer borders, which should be correctly identified.
-    IF ( bc_lr == 'cyclic' )  THEN
-       IF ( value_ijk(3) < 0  ) value_ijk(3) = nx +1 + value_ijk(3)
-       IF ( value_ijk(3) > nx ) value_ijk(3) = value_ijk(3) - (nx+1)
-    ENDIF
-    IF ( bc_ns == 'cyclic' )  THEN
-       IF ( value_ijk(2) < 0  ) value_ijk(2) = ny +1 + value_ijk(2)
-       IF ( value_ijk(2) > ny ) value_ijk(2) = value_ijk(2) - (ny+1)
-    ENDIF
+!-- Limit index values to the range 0..nx, 0..ny
+    IF ( value_ijk(3) ==   -1 )  value_ijk(3) = nx
+    IF ( value_ijk(3) == nx+1 )  value_ijk(3) =  0
+    IF ( value_ijk(2) ==   -1 )  value_ijk(2) = ny
+    IF ( value_ijk(2) == ny+1 )  value_ijk(2) =  0
+
 
  END SUBROUTINE global_min_max
Index: palm/trunk/SOURCE/gust_mod.f90
===================================================================
--- palm/trunk/SOURCE/gust_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,795 +1,0 @@
-!> @file gust_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Enable 3D data output also with 64-bit precision
-!
-! 4646 2020-08-24 16:02:40Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO for reading local arrays
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! CASE statement for dummy variable u2_av in gust_rrd_local changed to avoid unintended
-! interdependencies with user-defined variables
-!
-! 3837 2019-03-28 16:55:58Z knoop
-! unused variable for file index removed from rrd-subroutines parameter list
-!
-! 3725 2019-02-07 10:11:02Z raasch
-! dummy statement modified to avoid compiler warnings about unused variables
-!
-! 3685 2019-01-21 01:02:11Z knoop
-! Some interface calls moved to module_interface + cleanup
-!
-! 3665 2019-01-10 08:28:24Z raasch
-! dummy statements added to avoid compiler warnings about unused variables
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Bugfix: domain bounds of local_pf corrected
-!
-!
-! Interfaces concerning data output updated
-!
-!
-! renamed gust_par to gust_parameters
-!
-!
-! Initial interface definition
-!
-!
-! Description:
-! ------------
-!> Gust model.
-!>
-!> @todo This is just a dummy module. The actual module ist not released yet.
-!--------------------------------------------------------------------------------------------------!
- MODULE gust_mod
-
-    USE control_parameters,                                                                        &
-        ONLY:  restart_data_format_output
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt
-
-    USE kinds
-
-!    USE restart_data_mpi_io_mod,                                                                   &
-!        ONLY:
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  idum  !< dummy variable used to avoid compiler warnings about unused variables
-
-    LOGICAL ::  dummy_logical = .FALSE.        !< switch to avoid compiler warnings about unused variables
-    LOGICAL ::  gust_module_enabled = .FALSE.  !< switch, if the entire module is used at all
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public functions
-    PUBLIC                                                                                         &
-       gust_parin,                                                                                 &
-       gust_check_parameters,                                                                      &
-       gust_check_data_output_pr,                                                                  &
-       gust_check_data_output,                                                                     &
-       gust_init_arrays,                                                                           &
-       gust_init,                                                                                  &
-       gust_define_netcdf_grid,                                                                    &
-       gust_header,                                                                                &
-       gust_actions,                                                                               &
-       gust_prognostic_equations,                                                                  &
-       gust_swap_timelevel,                                                                        &
-       gust_3d_data_averaging,                                                                     &
-       gust_data_output_2d,                                                                        &
-       gust_data_output_3d,                                                                        &
-       gust_statistics,                                                                            &
-       gust_rrd_global,                                                                            &
-       gust_wrd_global,                                                                            &
-       gust_rrd_local,                                                                             &
-       gust_wrd_local
-!
-!-- Public parameters, constants and initial values
-    PUBLIC                                                                                         &
-       gust_module_enabled
-
-
-    INTERFACE gust_parin
-       MODULE PROCEDURE gust_parin
-    END INTERFACE gust_parin
-
-    INTERFACE gust_check_parameters
-       MODULE PROCEDURE gust_check_parameters
-    END INTERFACE gust_check_parameters
-
-    INTERFACE gust_check_data_output_pr
-       MODULE PROCEDURE gust_check_data_output_pr
-    END INTERFACE gust_check_data_output_pr
-
-    INTERFACE gust_check_data_output
-       MODULE PROCEDURE gust_check_data_output
-    END INTERFACE gust_check_data_output
-
-    INTERFACE gust_init_arrays
-       MODULE PROCEDURE gust_init_arrays
-    END INTERFACE gust_init_arrays
-
-    INTERFACE gust_init
-       MODULE PROCEDURE gust_init
-    END INTERFACE gust_init
-
-    INTERFACE gust_define_netcdf_grid
-       MODULE PROCEDURE gust_define_netcdf_grid
-    END INTERFACE gust_define_netcdf_grid
-
-    INTERFACE gust_header
-       MODULE PROCEDURE gust_header
-    END INTERFACE gust_header
-
-    INTERFACE gust_actions
-       MODULE PROCEDURE gust_actions
-       MODULE PROCEDURE gust_actions_ij
-    END INTERFACE gust_actions
-
-    INTERFACE gust_prognostic_equations
-       MODULE PROCEDURE gust_prognostic_equations
-       MODULE PROCEDURE gust_prognostic_equations_ij
-    END INTERFACE gust_prognostic_equations
-
-    INTERFACE gust_swap_timelevel
-       MODULE PROCEDURE gust_swap_timelevel
-    END INTERFACE gust_swap_timelevel
-
-    INTERFACE gust_3d_data_averaging
-       MODULE PROCEDURE gust_3d_data_averaging
-    END INTERFACE gust_3d_data_averaging
-
-    INTERFACE gust_data_output_2d
-       MODULE PROCEDURE gust_data_output_2d
-    END INTERFACE gust_data_output_2d
-
-    INTERFACE gust_data_output_3d
-       MODULE PROCEDURE gust_data_output_3d
-    END INTERFACE gust_data_output_3d
-
-    INTERFACE gust_statistics
-       MODULE PROCEDURE gust_statistics
-    END INTERFACE gust_statistics
-
-    INTERFACE gust_rrd_global
-       MODULE PROCEDURE gust_rrd_global_ftn
-       MODULE PROCEDURE gust_rrd_global_mpi
-    END INTERFACE gust_rrd_global
-
-    INTERFACE gust_wrd_global
-       MODULE PROCEDURE gust_wrd_global
-    END INTERFACE gust_wrd_global
-
-    INTERFACE gust_rrd_local
-       MODULE PROCEDURE gust_rrd_local_ftn
-       MODULE PROCEDURE gust_rrd_local_mpi
-    END INTERFACE gust_rrd_local
-
-    INTERFACE gust_wrd_local
-       MODULE PROCEDURE gust_wrd_local
-    END INTERFACE gust_wrd_local
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &gust_parameters for gust module
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE gust_parin
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100)  ::  line  !< dummy string that contains the current line of the parameter
-                                  !< file
-
-    INTEGER(iwp)  ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /gust_parameters/  switch_off_module
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, gust_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    gust_parameters namelist was found and read correctly. Set flag that indicates that the gust
-!--    module is switched on.
-       IF ( .NOT. switch_off_module )  gust_module_enabled = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    gust_parameters namelist was found, but contained errors. Print an error message including
-!--    the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'gust_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE gust_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for gust module
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_check_parameters
-
-
-       IMPLICIT NONE
-
-
-    END SUBROUTINE gust_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output of profiles for gust module
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
-       CHARACTER (LEN=*) ::  unit      !<
-       CHARACTER (LEN=*) ::  variable  !<
-
-       INTEGER(iwp) ::  var_count      !<
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( dummy_logical )  idum = LEN( unit ) + LEN( variable ) + LEN( dopr_unit ) + var_count
-
-    END SUBROUTINE gust_check_data_output_pr
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output for gust module
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_check_data_output( var, unit )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  unit  !<
-       CHARACTER (LEN=*) ::  var   !<
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( dummy_logical )  idum = LEN( var ) + LEN( unit )
-
-    END SUBROUTINE gust_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate gust module arrays and define pointers
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_init_arrays
-
-
-       IMPLICIT NONE
-
-
-    END SUBROUTINE gust_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the gust module
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_init
-
-
-       IMPLICIT NONE
-
-
-    END SUBROUTINE gust_init
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining appropriate grid for netcdf variables.
-!> It is called out from subroutine netcdf.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*), INTENT(IN) ::  grid_x      !<
-       CHARACTER (LEN=*), INTENT(IN) ::  grid_y      !<
-       CHARACTER (LEN=*), INTENT(IN) ::  grid_z      !<
-       CHARACTER (LEN=*), INTENT(IN) ::  var         !<
-
-       LOGICAL, INTENT(IN)           ::  found       !<
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( found )  idum = LEN( var ) + LEN( grid_x ) + LEN( grid_y ) + LEN( grid_z )
-
-    END SUBROUTINE gust_define_netcdf_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for gust module
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_header ( io )
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp), INTENT(IN) ::  io  !< Unit of the output file
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( dummy_logical )  idum = io
-
-    END SUBROUTINE gust_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_actions( location )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  location !<
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( dummy_logical )  idum = LEN( location )
-
-    END SUBROUTINE gust_actions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_actions_ij( i, j, location )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  location
-
-       INTEGER(iwp) ::  i
-       INTEGER(iwp) ::  j
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( dummy_logical )  idum = i + j + LEN( location )
-
-    END SUBROUTINE gust_actions_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_prognostic_equations()
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( dummy_logical )  idum = 1
-
-    END SUBROUTINE gust_prognostic_equations
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_prognostic_equations_ij( i, j, i_omp_start, tn )
-
-
-       INTEGER(iwp), INTENT(IN) ::  i            !< grid index in x-direction
-       INTEGER(iwp), INTENT(IN) ::  i_omp_start  !< first loop index of i-loop in prognostic_equations
-       INTEGER(iwp), INTENT(IN) ::  j            !< grid index in y-direction
-       INTEGER(iwp), INTENT(IN) ::  tn           !< task number of openmp task
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( dummy_logical )  idum = i + j + i_omp_start + tn
-
-    END SUBROUTINE gust_prognostic_equations_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Swapping of timelevels
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_swap_timelevel ( mod_count )
-
-
-       IMPLICIT NONE
-
-       INTEGER, INTENT(IN) ::  mod_count
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( dummy_logical )  idum = mod_count
-
-    END SUBROUTINE gust_swap_timelevel
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine for averaging 3D data
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_3d_data_averaging( mode, variable )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  mode    !<
-       CHARACTER (LEN=*) ::  variable !<
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( dummy_logical )  idum = LEN( mode ) + LEN( variable )
-
-    END SUBROUTINE gust_3d_data_averaging
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 2D output variables
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do,      &
-                                    nzt_do, fill_value )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*), INTENT(INOUT) ::  grid       !< name of vertical grid
-       CHARACTER (LEN=*), INTENT(IN)    ::  mode       !< either 'xy', 'xz' or 'yz'
-       CHARACTER (LEN=*), INTENT(IN)    ::  variable   !< name of variable
-
-       INTEGER(iwp), INTENT(IN) ::  av        !< flag for (non-)average output
-       INTEGER(iwp), INTENT(IN) ::  nzb_do    !< vertical output index (bottom)
-       INTEGER(iwp), INTENT(IN) ::  nzt_do    !< vertical output index (top)
-
-       LOGICAL, INTENT(INOUT) ::  found   !< flag if output variable is found
-       LOGICAL, INTENT(INOUT) ::  two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
-
-       REAL(wp), INTENT(IN) ::  fill_value !< value for the _FillValue attribute
-
-       REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(INOUT) ::  local_pf !< local
-                                                                                      !< array to which output data is resorted to
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( found .AND. two_d )  THEN
-          idum = av + LEN( variable ) + LEN( grid // mode ) + local_pf(nxl,nys,nzb_do) + fill_value
-       ENDIF
-
-    END SUBROUTINE gust_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 3D output variables
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*), INTENT(IN) ::  variable   !< name of variable
-
-       INTEGER(iwp), INTENT(IN) ::  av        !< flag for (non-)average output
-       INTEGER(iwp), INTENT(IN) ::  nzb_do    !< lower limit of the data output (usually 0)
-       INTEGER(iwp), INTENT(IN) ::  nzt_do    !< vertical upper limit of the data output (usually nz_do3d)
-
-       LOGICAL, INTENT(INOUT) ::  found     !< flag if output variable is found
-
-       REAL(wp), INTENT(IN) ::  fill_value !< value for the _FillValue attribute
-
-       REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(INOUT) ::  local_pf   !< local
-                                                                                        !< array to which output data is resorted to
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( found )  idum = av + LEN( variable ) + fill_value + local_pf(nxl,nys,nzb_do)
-
-    END SUBROUTINE gust_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine computes profile and timeseries data for the gust module.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_statistics( mode, sr, tn, dots_max )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  mode  !<
-
-       INTEGER(iwp) ::  dots_max   !<
-       INTEGER(iwp) ::  sr         !<
-       INTEGER(iwp) ::  tn         !<
-
-!
-!--    Next line is just to avoid compiler warnings about unused variables. You may remove it.
-       IF ( dummy_logical )  idum = dots_max + sr + tn + LEN( mode )
-
-    END SUBROUTINE gust_statistics
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_rrd_global_ftn( found )
-
-
-       USE control_parameters,                                                                     &
-           ONLY: length, restart_string
-
-
-       IMPLICIT NONE
-
-       LOGICAL, INTENT(OUT)  ::  found
-
-
-       found = .TRUE.
-
-
-       SELECT CASE ( restart_string(1:length) )
-
-          CASE ( 'global_paramter' )
-!             READ ( 13 )  global_parameter
-
-          CASE DEFAULT
-
-             found = .FALSE.
-
-       END SELECT
-
-
-    END SUBROUTINE gust_rrd_global_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_rrd_global_mpi
-
-
-!       CALL rrd_mpi_io( 'global_parameter', global_parameter )
-!             READ ( 13 )  global_parameter
-
-    END SUBROUTINE gust_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,&
-                                   nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d, found )
-
-
-       USE control_parameters
-
-       USE indices
-
-       USE kinds
-
-       USE pegrid
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  k               !<
-       INTEGER(iwp) ::  nxlc            !<
-       INTEGER(iwp) ::  nxlf            !<
-       INTEGER(iwp) ::  nxl_on_file     !<
-       INTEGER(iwp) ::  nxrc            !<
-       INTEGER(iwp) ::  nxrf            !<
-       INTEGER(iwp) ::  nxr_on_file     !<
-       INTEGER(iwp) ::  nync            !<
-       INTEGER(iwp) ::  nynf            !<
-       INTEGER(iwp) ::  nyn_on_file     !<
-       INTEGER(iwp) ::  nysc            !<
-       INTEGER(iwp) ::  nysf            !<
-       INTEGER(iwp) ::  nys_on_file     !<
-
-       LOGICAL, INTENT(OUT)  ::  found
-
-       REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d   !<
-       REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
-
-
-!
-!--    Next lins are just to avoid compiler warnings about unused variables in case of empty user interface routine.
-!--    You may remove them.
-       IF ( dummy_logical )  THEN
-          idum = k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf +                       &
-                 tmp_2d(nys_on_file,nxl_on_file) + tmp_3d(nzb,nys_on_file,nxl_on_file)
-       ENDIF
-
-!
-!--    Here the reading of user-defined restart data follows:
-!--    Sample for user-defined output
-       found = .TRUE.
-
-       SELECT CASE ( restart_string(1:length) )
-
-          CASE ( '.......' )
-!             IF ( .NOT. ALLOCATED( u2_av ) ) THEN
-!                  ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!             ENDIF
-!             IF ( k == 1 )  READ ( 13 )  tmp_3d
-!                u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =         &
-!                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-!
-          CASE DEFAULT
-
-             found = .FALSE.
-
-          END SELECT
-
-
-    END SUBROUTINE gust_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_rrd_local_mpi
-
-
-!       CALL rrd_mpi_io( 'local_array', local_array )
-
-    END SUBROUTINE gust_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data for the gust module.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_wrd_global
-
-
-       IMPLICIT NONE
-
-
-       IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-!          CALL wrd_write_string( 'global_parameter' )
-!          WRITE ( 14 )  global_parameter
-
-!          IF ( ALLOCATED( inflow_damping_factor ) )  THEN
-!             CALL wrd_write_string( 'inflow_damping_factor' )
-!             WRITE ( 14 )  inflow_damping_factor
-!          ENDIF
-
-       ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-!          CALL wrd_mpi_io( 'global_parameter', global_parameter )
-!          IF ( ALLOCATED( inflow_damping_factor ) )  THEN
-!             CALL wrd_mpi_io_global_array( 'inflow_damping_factor', inflow_damping_factor )
-!          ENDIF
-
-       ENDIF
-
-    END SUBROUTINE gust_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data for the gust module.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE gust_wrd_local
-
-
-       IMPLICIT NONE
-
-
-       IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-!          IF ( ALLOCATED( u2_av ) )  THEN
-!             CALL wrd_write_string( 'u2_av' )
-!             WRITE ( 14 )  u2_av
-!          ENDIF
-
-       ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-!          IF ( ALLOCATED( u2_av ) )  CALL wrd_mpi_io( 'u2_av', u2_av )
-
-       ENDIF
-
-    END SUBROUTINE gust_wrd_local
-
-
-
- END MODULE gust_mod
Index: palm/trunk/SOURCE/header.f90
===================================================================
--- palm/trunk/SOURCE/header.f90	(revision 4901)
+++ palm/trunk/SOURCE/header.f90	(revision 1)
@@ -1,86 +1,137 @@
-! !> @file header.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE header
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! output of use_cmax removed
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! file re-formatted to follow the PALM coding standard
-!
-! 4586 2020-07-01 16:16:43Z gronemeier
-! Renamed rif to Ri (gradient Richardson number, 1D model)
-! and zeta (= z_mo / ol, stability parameter, 3D model)
-!
-! 4573 2020-06-24 13:08:47Z oliver.maas
-! added statement for pt_surface_heating_rate
-!
-! 4536 2020-05-17 17:24:13Z raasch
-! output of restart data format added
-!
-! 4473 2020-03-25 21:04:07Z gronemeier
-! revised message if wall_adjustment is used
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Bugfix, character length too short, caused crash on NEC.
-!
-! 4309 2019-11-26 18:49:59Z suehring
-! replaced recycling_yshift by y_shift
-!
-! 4301 2019-11-22 12:09:09Z oliver.maas
-!
-! 4297 2019-11-21 10:37:50Z oliver.maas
-! Adjusted format for simulated time and related quantities
-!
-! 4297 2019-11-21 10:37:50Z oliver.maas
-! adjusted message to the changed parameter recycling_yshift
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod
-!
-! 4223 2019-09-10 09:20:47Z gronemeier
-! Write information about rotation angle
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to avoid runtime error
-! (Loop variable has been modified) in time_integration
-!
-! 4023 2019-06-12 13:20:01Z maronga
-! Renamed "coupling start time" to "spinup time"
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! unused variable removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Implementation of the PALM module interface
+! $Log: header.f90,v $
+! Revision 1.63  2006/08/22 13:53:13  raasch
+! Output of dz_max
+!
+! Revision 1.62  2006/08/04 14:38:41  raasch
+! Generation of the run description header as well as run date and run time
+! moved to routine check_parameters,
+! output for additional particle quantities
+!
+! Revision 1.61  2006/04/26 12:19:51  raasch
+! Output of threads per task
+!
+! Revision 1.60  2006/04/11 14:57:01  raasch
+! pl_spectra renamed data_output_sp
+!
+! Revision 1.59  2006/03/14 12:44:10  raasch
+! Output of the initial geostrophic wind profile corrected
+!
+! Revision 1.58  2006/02/23 12:24:22  raasch
+! Output of psl, psr, pdx, etc. for each particle group, output of e_min,
+! information about volume flow conservation and usage of NetCDF 64 bit offset
+! format, pl.. renamed do.., skip_time control parameters for do..,
+! ebene renamed section, .._anz renamed .._no, dt_average renamed
+! dt_averaging_input_pr
+! output of 2d/3d data averaging informations, buffer is forced to be written
+! on file at the end of the routine
+!
+! Revision 1.57  2005/10/20 14:06:44  raasch
+! Error in output of yz-slice information removed
+!
+! Revision 1.56  2005/07/01 07:48:14  steinfeld
+! Information on the initial profiles of ug and vg added;
+! dependency of ug and vg on height considered in the output of
+! the boundary conditions for u and v
+!
+! Revision 1.55  2005/06/26 19:53:15  raasch
+! gas_constant renamed r_d, latent_heat renamed l_v, radius is used instead
+! of diameter, output formats 335+337 changed
+!
+! Revision 1.54  2005/05/19 08:32:27  raasch
+! Error in output of particle inertia information removed
+!
+! Revision 1.53  2005/05/18 15:31:59  raasch
+! Informations about data output format (netcdf, iso2d, etc.) are given
+!
+! Revision 1.52  2005/04/23 09:16:10  raasch
+! fcl_factor renamed cfl_factor
+!
+! Revision 1.51  2005/03/26 20:23:14  raasch
+! Output of horizontal boundary conditions, output of additional call of
+! pressure solver in case of Runge-Kutta schemes,
+! calculate the number of particle groups (formerly unknown = 0 )
+!
+! Revision 1.50  2004/04/30 11:48:02  raasch
+! Forcing a 1d-decomposition is output on linux-cluster and decalpha,
+! output of subdomain sizes, impulse_advec renamed momentum_advec
+!
+! Revision 1.49  2004/01/28 15:09:15  raasch
+! Output of timestep schemes modified
+!
+! Revision 1.48  2003/10/29 08:52:04  raasch
+! Additional output for multigrid method (lowest levels gathered on PE0),
+! particle output modified for particle groups
+!
+! Revision 1.47  2003/04/16 12:58:18  raasch
+! Output for mixing length limitations revised
+!
+! Revision 1.46  2003/03/16 09:39:31  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.45  2003/03/14 13:43:21  raasch
+! Informations about random generator
+!
+! Revision 1.44  2003/03/12 16:31:45  raasch
+! Small change for NEC system
+!
+! Revision 1.43  2002/12/19 14:53:47  raasch
+! Informations about user defined restart times added
+!
+! Revision 1.42  2002/09/12 13:03:24  raasch
+! Informations about particle inertia added
+!
+! Revision 1.41  2002/06/11 13:09:11  raasch
+! Information about hybrid solver, usage of 1d-decomposition and fast version
+! of prognostic_equations included,
+! no output of mixing length adjustments in case of constant diffusion
+!
+! Revision 1.40  2002/04/16  08:06:13  08:06:13  raasch (Siegfried Raasch)
+! Informations about particle boundary conditions and output of particle
+! data added, direct output of informations about scalar transport (instead
+! of using humidity)
+! 
+! Revision 1.39  2001/08/21 08:50:54  raasch
+! Informations about mixing length adjustment, particle tails and dvrp PE usage
+! included
+!
+! Revision 1.38  2001/07/20 13:05:39  raasch
+! Information about multigrid method included
+!
+! Revision 1.37  2001/07/12 12:08:14  raasch
+! Additional informations about dvrp-output (host and filenames) and
+! particles (maximum age, random start positions), + module particle_attributes
+!
+! Revision 1.36  2001/03/30 07:23:53  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.35  2001/01/29 12:25:55  raasch
+! Informations about using passive scalar
+!
+! Revision 1.34  2001/01/25 07:00:48  raasch
+! Information about using surface fluxes and fft-method added
+!
+! Revision 1.33  2001/01/05 15:11:41  raasch
+! Spectra informations added. Old revision remarks deleted.
+!
+! Revision 1.32  2001/01/03 13:08:47  letzel
+! File output translated into English.
+!
+! Revision 1.31  2000/12/28 13:04:54  raasch
+! Slicer information added to dvrp-output.
+! Informations about optionally used packages are put in cpp-define-brackets.
+!
+! Revision 1.30  2000/04/27 07:08:14  raasch
+! notice if processor topology is predefined by user,
+! general notice about dvrp-output (including isosurface and particles),
+! all comments translated into English
 !
 ! Revision 1.1  1997/08/11 06:17:20  raasch
@@ -90,154 +141,45 @@
 ! Description:
 ! ------------
-!> Writing a header with all important information about the current run.
-!> This subroutine is called three times, two times at the beginning (writing information on
-!> files RUN_CONTROL and HEADER) and one time at the end of the run, then writing
-!> additional information about CPU-usage on file
-!> header.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE header
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  pt_init, q_init, s_init, sa_init, ug, vg, w_subs, zu, zw
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  g, kappa
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
+! Writing a header with all important informations about the actual run.
+! This subroutine is called three times, two times at the beginning 
+! (writing information on files RUN_CONTROL and HEADER) and one time at the
+! end of the run, then writing additional information about CPU-usage on file
+! header.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
     USE control_parameters
-
-    USE cpulog,                                                                                    &
-        ONLY:  log_point_s
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  mg_loc_ind, nnx, nny, nnz, nx, ny, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzt, nzt_mg,     &
-               topo_top_ind
-
-    USE kinds
-
-    USE model_1d_mod,                                                                              &
-        ONLY:  damp_level_ind_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_header
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  netcdf_data_format, netcdf_data_format_string, netcdf_deflate
-
-    USE ocean_mod,                                                                                 &
-        ONLY:  ibc_sa_t, prho_reference, sa_surface, sa_vertical_gradient,                         &
-               sa_vertical_gradient_level, sa_vertical_gradient_level_ind
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  get_date_time
-
+    USE cloud_parameters
+    USE cpulog
+    USE dvrp_variables
+    USE grid_variables
+    USE indices
+    USE model_1d
+    USE particle_attributes
     USE pegrid
-
-#if defined( __parallel )
-    USE pmc_handle_communicator,                                                                   &
-        ONLY:  pmc_get_model_info
-
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run, nesting_datatransfer_mode, nesting_mode
-#endif
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_def_h
-
-    USE turbulence_closure_mod,                                                                    &
-        ONLY:  rans_const_c, rans_const_sigma
+    USE spectrum
 
     IMPLICIT NONE
 
-
-    CHARACTER (LEN=2)  ::  do2d_mode           !< mode of 2D data output (xy, xz, yz)
-
-    CHARACTER (LEN=5)  ::  section_chr         !< string indicating grid information where to output 2D slices
-
-    CHARACTER (LEN=10) ::  host_chr            !< string for hostname
-
-    CHARACTER (LEN=16) ::  begin_chr           !< string indication start time for the data output
-    CHARACTER (LEN=16) ::  coor_chr            !< dummy string
-
-    CHARACTER (LEN=23) ::  date_time_str       !< string for date and time information
-
-    CHARACTER (LEN=26) ::  ver_rev             !< string for run identification
-
-#if defined( __parallel )
-    CHARACTER (LEN=32) ::  cpl_name            !< name of child domain (nesting mode only)
-#endif
-
-    CHARACTER (LEN=40) ::  output_format       !< netcdf format
-
-    CHARACTER (LEN=70) ::  char1               !< dummy varialbe used for various strings
-    CHARACTER (LEN=70) ::  char2               !< string containing informating about the advected distance in case of Galilei
-                                               !< transformation
-    CHARACTER (LEN=70) ::  dopr_chr            !< string indicating profile output variables
-    CHARACTER (LEN=70) ::  do2d_xy             !< string indicating 2D-xy output variables
-    CHARACTER (LEN=70) ::  do2d_xz             !< string indicating 2D-xz output variables
-    CHARACTER (LEN=70) ::  do2d_yz             !< string indicating 2D-yz output variables
-    CHARACTER (LEN=70) ::  do3d_chr            !< string indicating 3D output variables
-    CHARACTER (LEN=70) ::  domask_chr          !< string indicating masked output variables
-    CHARACTER (LEN=70) ::  run_classification  !< string classifying type of run, e.g. nested, coupled, etc.
-
-    CHARACTER (LEN=85) ::  r_upper             !< string indicating model top boundary condition for various quantities
-    CHARACTER (LEN=85) ::  r_lower             !< string indicating bottom boundary condition for various quantities
-
-    CHARACTER (LEN=86) ::  coordinates         !< string indicating height coordinates for profile-prescribed variables
-    CHARACTER (LEN=86) ::  gradients           !< string indicating gradients of profile-prescribed variables between the
-                                               !< prescribed height coordinates
-    CHARACTER (LEN=86) ::  slices              !< string indicating grid coordinates of profile-prescribed subsidence velocity
-    CHARACTER (LEN=86) ::  temperatures        !< string indicating profile-prescribed subsidence velocities
-    CHARACTER (LEN=86) ::  ugcomponent         !< string indicating profile-prescribed geostrophic u-component
-    CHARACTER (LEN=86) ::  vgcomponent         !< string indicating profile-prescribed geostrophic v-component
-
-    CHARACTER (LEN=1), DIMENSION(1:3) ::  dir = (/ 'x', 'y', 'z' /)  !< string indicating masking steps along certain direction
-
-    INTEGER(iwp) ::  av             !< index indicating average output quantities
-    INTEGER(iwp) ::  bh             !< building height in generic single-building setup
-    INTEGER(iwp) ::  blx            !< building width in grid points along x in generic single-building setup
-    INTEGER(iwp) ::  bly            !< building width in grid points along y in generic single-building setup
-    INTEGER(iwp) ::  bxl            !< index for left building wall in generic single-building setup
-    INTEGER(iwp) ::  bxr            !< index for right building wall in generic single-building setup
-    INTEGER(iwp) ::  byn            !< index for north building wall in generic single-building setup
-    INTEGER(iwp) ::  bys            !< index for south building wall in generic single-building setup
-    INTEGER(iwp) ::  ch             !< canyon depth in generic street-canyon setup
-    INTEGER(iwp) ::  count          !< number of masked output locations
-    INTEGER(iwp) ::  cwx            !< canyon width along x in generic street-canyon setup
-    INTEGER(iwp) ::  cwy            !< canyon width along y in generic street-canyon setup
-    INTEGER(iwp) ::  cxl            !< index for left canyon wall in generic street-canyon setup
-    INTEGER(iwp) ::  cxr            !< index for right canyon wall in generic street-canyon setup
-    INTEGER(iwp) ::  cyn            !< index for north canyon wall in generic street-canyon setup
-    INTEGER(iwp) ::  cys            !< index for south canyon wall in generic street-canyon setup
-    INTEGER(iwp) ::  dim            !< running index for masking output locations
-    INTEGER(iwp) ::  i              !< running index for various loops
-    INTEGER(iwp) ::  io             !< file unit of HEADER file
-    INTEGER(iwp) ::  l              !< substring length
-    INTEGER(iwp) ::  ll             !< substring length
-    INTEGER(iwp) ::  mid            !< masked output running index
-#if defined( __parallel )
-    INTEGER(iwp) ::  cpl_parent_id  !< parent ID for the respective child model
-    INTEGER(iwp) ::  my_cpl_id      !< run id in a nested model setup
-    INTEGER(iwp) ::  n              !< running index over number of couplers in a nested model setup
-    INTEGER(iwp) ::  ncpl           !< number of coupler in a nested model setup
-    INTEGER(iwp) ::  npe_total      !< number of total PEs in a coupler (parent + child)
-#endif
-
-
-    REAL(wp) ::  cpuseconds_per_simulated_second  !< CPU time (in s) per simulated second
-#if defined( __parallel )
-    REAL(wp) ::  lower_left_coord_x               !< x-coordinate of nest domain
-    REAL(wp) ::  lower_left_coord_y               !< y-coordinate of nest domain
-#endif
-
-!
-!-- Open the output file. At the end of the simulation, output is directed to unit 19.
-    IF ( ( runnr == 0 .OR. force_print_header )  .AND.                                             &
+    CHARACTER (LEN=1)  ::  prec
+    CHARACTER (LEN=2)  ::  do2d_mode
+    CHARACTER (LEN=5)  ::  section_chr
+    CHARACTER (LEN=9)  ::  time_to_string
+    CHARACTER (LEN=10) ::  coor_chr, host_chr
+    CHARACTER (LEN=16) ::  begin_chr
+    CHARACTER (LEN=40) ::  output_format
+    CHARACTER (LEN=70) ::  char1, char2, coordinates, gradients, dopr_chr, &
+                           do2d_xy, do2d_xz, do2d_yz, do3d_chr, &
+                           run_classification, slices, temperatures, &
+                           ugcomponent, vgcomponent
+    CHARACTER (LEN=85) ::  roben, runten
+
+    INTEGER ::  av, bh, blx, bly, bxl, bxr, byn, bys, i, ihost, io, j, l, ll
+    REAL    ::  cpuseconds_per_simulated_second
+
+!
+!-- Open the output file. At the end of the simulation, output is directed
+!-- to unit 19.
+    IF ( ( runnr == 0 .OR. force_print_header )  .AND. &
          .NOT. simulated_time_at_begin /= simulated_time )  THEN
        io = 15   !  header output on file RUN_CONTROL
@@ -248,5 +190,6 @@
 
 !
-!-- At the end of the run, output file (HEADER) will be rewritten with new information
+!-- At the end of the run, output file (HEADER) will be rewritten with
+!-- new informations
     IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
 
@@ -254,30 +197,13 @@
 !-- Determine kind of model run
     IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
-       run_classification = 'restart run'
-    ELSEIF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
-       run_classification = 'run with cyclic fill of 3D - prerun data'
-    ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
-       run_classification = 'run without 1D - prerun'
-    ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
-       run_classification = 'run with 1D - prerun'
-    ELSEIF ( INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
-       run_classification = 'run initialized with COSMO data'
-    ELSEIF ( INDEX( initializing_actions, 'by_user' ) /=0 )  THEN
-       run_classification = 'run initialized by user'
-    ELSEIF ( INDEX( initializing_actions, 'initialize_vortex' ) /=0 )  THEN
-       run_classification = 'run additionally initialized by a Rankine-vortex'
-    ELSEIF ( INDEX( initializing_actions, 'initialize_ptanom' ) /=0 )  THEN
-       run_classification = 'run additionally initialized by temperature anomaly'
+       run_classification = '3D - restart run'
     ELSE
-       message_string = ' unknown action(s): ' // TRIM( initializing_actions )
-       CALL message( 'header', 'PA0191', 0, 0, 0, 6, 0 )
-    ENDIF
-#if defined( __parallel )
-    IF ( nested_run )  run_classification = 'nested ' // run_classification(1:63)
-#endif
-    IF ( ocean_mode )  THEN
-       run_classification = 'ocean - ' // run_classification(1:61)
-    ELSE
-       run_classification = 'atmosphere - ' // run_classification(1:57)
+       IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
+          run_classification = '3D - run without 1D - prerun'
+       ELSEIF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 ) THEN
+          run_classification = '3D - run with 1D - prerun'
+       ELSE
+          PRINT*,'+++ header:  unknown action(s): ',initializing_actions
+       ENDIF
     ENDIF
 
@@ -285,73 +211,34 @@
 !-- Run-identification, date, time, host
     host_chr = host(1:10)
-    ver_rev = TRIM( version ) // '  ' // TRIM( revision )
-    WRITE ( io, 100 )  ver_rev, TRIM( run_classification )
-    IF ( TRIM( coupling_mode ) /= 'uncoupled' )  THEN
-       WRITE ( io, 101 )  coupling_mode
-    ENDIF
+    WRITE ( io, 100 )  version, TRIM( run_classification ), run_date, &
+                       run_identifier, run_time, runnr, ADJUSTR( host_chr )
 #if defined( __parallel )
-    IF ( coupling_start_time /= 0.0_wp  .AND. .NOT. spinup )  THEN
-       IF ( coupling_start_time > simulated_time_at_begin )  THEN
-          WRITE ( io, 109 )
-       ELSE
-          WRITE ( io, 114 )
-       ENDIF
-    ENDIF
-#endif
-    IF ( ensemble_member_nr /= 0 )  THEN
-       WRITE ( io, 512 )  run_date, run_identifier, run_time, runnr, ADJUSTR( host_chr ),          &
-                          ensemble_member_nr
-    ELSE
-       WRITE ( io, 102 )  run_date, run_identifier, run_time, runnr, ADJUSTR( host_chr )
-    ENDIF
-#if defined( __parallel )
-    IF ( npex == -1  .AND.  npey == -1 )  THEN
+    IF ( npex == -1  .AND.  pdims(2) /= 1 )  THEN
        char1 = 'calculated'
+    ELSEIF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.  &
+               host(1:2) == 'lc' )  .AND.                          &
+             npex == -1  .AND.  pdims(2) == 1 )  THEN
+       char1 = 'forced'
     ELSE
        char1 = 'predefined'
     ENDIF
     IF ( threads_per_task == 1 )  THEN
-       WRITE ( io, 103 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
+       WRITE ( io, 101 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
     ELSE
-       WRITE ( io, 104 )  numprocs*threads_per_task, numprocs, threads_per_task, pdims(1),         &
-                          pdims(2), TRIM( char1 )
-    ENDIF
-
-    IF ( pdims(2) == 1 )  THEN
-       WRITE ( io, 107 )  'x'
+       WRITE ( io, 102 )  numprocs*threads_per_task, numprocs, &
+                          threads_per_task, pdims(1), pdims(2), TRIM( char1 )
+    ENDIF
+    IF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.    &
+           host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  .AND. &
+         npex == -1  .AND.  pdims(2) == 1 )                      &
+    THEN
+       WRITE ( io, 104 )
+    ELSEIF ( pdims(2) == 1 )  THEN
+       WRITE ( io, 105 )  'x'
     ELSEIF ( pdims(1) == 1 )  THEN
-       WRITE ( io, 107 )  'y'
-    ENDIF
-    IF ( numprocs /= maximum_parallel_io_streams )  THEN
-       WRITE ( io, 108 )  maximum_parallel_io_streams
-    ENDIF
+       WRITE ( io, 105 )  'y'
+    ENDIF
+    IF ( use_seperate_pe_for_dvrp_output )  WRITE ( io, 103 )
 #endif
-
-#if defined( __parallel )
-!
-!-- Nesting informations
-    IF ( nested_run )  THEN
-
-       WRITE ( io, 600 )  TRIM( nesting_mode ), TRIM( nesting_datatransfer_mode )
-       CALL pmc_get_model_info( ncpl = ncpl, cpl_id = my_cpl_id )
-
-       DO  n = 1, ncpl
-          CALL pmc_get_model_info( request_for_cpl_id = n, cpl_name = cpl_name,                    &
-                                   cpl_parent_id = cpl_parent_id,                                  &
-                                   lower_left_x = lower_left_coord_x,                              &
-                                   lower_left_y = lower_left_coord_y,                              &
-                                   npe_total = npe_total )
-          IF ( n == my_cpl_id )  THEN
-             char1 = '*'
-          ELSE
-             char1 = ' '
-          ENDIF
-          WRITE ( io, 601 )  TRIM( char1 ), n, cpl_parent_id, npe_total, lower_left_coord_x,       &
-                             lower_left_coord_y, TRIM( cpl_name )
-       ENDDO
-
-    ENDIF
-#endif
-
     WRITE ( io, 99 )
 
@@ -359,17 +246,11 @@
 !-- Numerical schemes
     WRITE ( io, 110 )
-    IF ( rans_mode )  THEN
-       WRITE ( io, 124 )  TRIM( turbulence_closure ), 'RANS'
-    ELSE
-       WRITE ( io, 124 )  TRIM( turbulence_closure ), 'LES'
-    ENDIF
-    WRITE ( io, 121 )  TRIM( approximation )
     IF ( psolver(1:7) == 'poisfft' )  THEN
        WRITE ( io, 111 )  TRIM( fft_method )
-       IF ( transpose_compute_overlap )  WRITE( io, 115 )
+       IF ( psolver == 'poisfft_hybrid' )  WRITE ( io, 138 )
     ELSEIF ( psolver == 'sor' )  THEN
        WRITE ( io, 112 )  nsor_ini, nsor, omega_sor
-    ELSEIF ( psolver(1:9) == 'multigrid' )  THEN
-       WRITE ( io, 135 )  TRIM(psolver), cycle_mg, maximum_grid_level, ngsrb
+    ELSEIF ( psolver == 'multigrid' )  THEN
+       WRITE ( io, 135 )  cycle_mg, maximum_grid_level, ngsrb
        IF ( mg_cycles == -1 )  THEN
           WRITE ( io, 140 )  residual_limit
@@ -378,16 +259,17 @@
        ENDIF
        IF ( mg_switch_to_pe0_level == 0 )  THEN
-          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, nzt_mg(1)
-       ELSEIF (  mg_switch_to_pe0_level /= -1 )  THEN
-          WRITE ( io, 137 )  mg_switch_to_pe0_level,                                               &
-                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1,                                    &
-                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1,                                    &
-                             nzt_mg(mg_switch_to_pe0_level),                                       &
-                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1,                         &
+          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
                              nzt_mg(1)
-       ENDIF
-       IF ( psolver == 'multigrid_noopt'  .AND.  masking_method )  WRITE ( io, 144 )
-    ENDIF
-    IF ( call_psolver_at_all_substeps  .AND.  timestep_scheme(1:5) == 'runge' )  THEN
+       ELSE
+          WRITE ( io, 137 )  mg_switch_to_pe0_level,            &
+                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
+                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
+                             nzt_mg(mg_switch_to_pe0_level),    &
+                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
+                             nzt_mg(1)
+       ENDIF
+    ENDIF
+    IF ( call_psolver_at_all_substeps  .AND. timestep_scheme(1:5) == 'runge' ) &
+    THEN
        WRITE ( io, 142 )
     ENDIF
@@ -395,20 +277,40 @@
     IF ( momentum_advec == 'pw-scheme' )  THEN
        WRITE ( io, 113 )
-    ELSEIF (momentum_advec == 'ws-scheme' )  THEN
-       WRITE ( io, 503 )
+    ELSE
+       WRITE ( io, 114 )
+       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
+       IF ( overshoot_limit_u /= 0.0  .OR.  overshoot_limit_v /= 0.0  .OR. &
+            overshoot_limit_w /= 0.0 )  THEN
+          WRITE ( io, 127 )  overshoot_limit_u, overshoot_limit_v, &
+                             overshoot_limit_w
+       ENDIF
+       IF ( ups_limit_u /= 0.0  .OR.  ups_limit_v /= 0.0  .OR. &
+            ups_limit_w /= 0.0 )                               &
+       THEN
+          WRITE ( io, 125 )  ups_limit_u, ups_limit_v, ups_limit_w
+       ENDIF
+       IF ( long_filter_factor /= 0.0 )  WRITE ( io, 115 )  long_filter_factor
     ENDIF
     IF ( scalar_advec == 'pw-scheme' )  THEN
        WRITE ( io, 116 )
-    ELSEIF ( scalar_advec == 'ws-scheme' )  THEN
-       WRITE ( io, 504 )
+    ELSEIF ( scalar_advec == 'ups-scheme' )  THEN
+       WRITE ( io, 117 )
+       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
+       IF ( overshoot_limit_e /= 0.0  .OR.  overshoot_limit_pt /= 0.0 )  THEN
+          WRITE ( io, 128 )  overshoot_limit_e, overshoot_limit_pt
+       ENDIF
+       IF ( ups_limit_e /= 0.0  .OR.  ups_limit_pt /= 0.0 )  THEN
+          WRITE ( io, 126 )  ups_limit_e, ups_limit_pt
+       ENDIF
     ELSE
        WRITE ( io, 118 )
     ENDIF
-
-    WRITE ( io, 139 )  TRIM( loop_optimization )
-
+    IF ( momentum_advec /= 'ups-scheme' .AND. scalar_advec /= 'ups-scheme' &
+         .AND. scalar_advec /= 'bc-scheme'  .AND.  host(1:3) /= 'nec' )  THEN
+       WRITE ( io, 139 )
+    ENDIF
     IF ( galilei_transformation )  THEN
        IF ( use_ug_for_galilei_tr )  THEN
-          char1 = '0.6 * geostrophic wind'
+          char1 = 'geostrophic wind'
        ELSE
           char1 = 'mean wind in model domain'
@@ -419,41 +321,33 @@
           char2 = 'at the end of the run'
        ENDIF
-       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ), advected_distance_x/1000.0_wp,             &
-                          advected_distance_y/1000.0_wp
-    ENDIF
-    WRITE ( io, 122 )  timestep_scheme
-    IF ( use_upstream_for_tke )  WRITE ( io, 143 )
-    IF ( rayleigh_damping_factor /= 0.0_wp )  THEN
-       IF ( .NOT. ocean_mode )  THEN
-          WRITE ( io, 123 )  'above', rayleigh_damping_height, rayleigh_damping_factor
-       ELSE
-          WRITE ( io, 123 )  'below', rayleigh_damping_height, rayleigh_damping_factor
-       ENDIF
-    ENDIF
-    IF ( neutral )  WRITE ( io, 131 )  pt_surface
-    IF ( humidity )  THEN
-       IF ( .NOT. bulk_cloud_model )  THEN
+       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ), &
+                          advected_distance_x/1000.0, advected_distance_y/1000.0
+    ENDIF
+    IF ( timestep_scheme == 'leapfrog' )  THEN
+       WRITE ( io, 120 )
+    ELSEIF ( timestep_scheme == 'leapfrog+euler' )  THEN
+       WRITE ( io, 121 )
+    ELSE
+       WRITE ( io, 122 )  timestep_scheme
+    ENDIF
+    IF ( rayleigh_damping_factor /= 0.0 )  THEN
+       WRITE ( io, 123 )  rayleigh_damping_height, rayleigh_damping_factor
+    ENDIF
+    IF ( moisture )  THEN
+       IF ( .NOT. cloud_physics )  THEN
           WRITE ( io, 129 )
        ELSE
           WRITE ( io, 130 )
+          WRITE ( io, 131 )
+          IF ( radiation )      WRITE ( io, 132 )
+          IF ( precipitation )  WRITE ( io, 133 )
        ENDIF
     ENDIF
     IF ( passive_scalar )  WRITE ( io, 134 )
-    IF ( conserve_volume_flow )  THEN
-       WRITE ( io, 150 )  conserve_volume_flow_mode
-       IF ( TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
-          WRITE ( io, 151 )  u_bulk, v_bulk
-       ENDIF
-    ELSEIF ( dp_external )  THEN
-       IF ( dp_smooth )  THEN
-          WRITE ( io, 152 )  dpdxy, dp_level_b, ', vertically smoothed.'
-       ELSE
-          WRITE ( io, 152 )  dpdxy, dp_level_b, '.'
-       ENDIF
-    ENDIF
+    IF ( conserve_volume_flow )  WRITE ( io, 150 )
     WRITE ( io, 99 )
 
 !
-!-- Runtime and timestep information
+!-- Runtime and timestep informations
     WRITE ( io, 200 )
     IF ( .NOT. dt_fixed )  THEN
@@ -464,6 +358,7 @@
     WRITE ( io, 203 )  simulated_time_at_begin, end_time
 
-    IF ( time_restart /= 9999999.9_wp  .AND.  simulated_time_at_begin == simulated_time )  THEN
-       IF ( dt_restart == 9999999.9_wp )  THEN
+    IF ( time_restart /= 9999999.9  .AND. &
+         simulated_time_at_begin == simulated_time )  THEN
+       IF ( dt_restart == 9999999.9 )  THEN
           WRITE ( io, 204 )  ' Restart at:       ',time_restart
        ELSE
@@ -474,206 +369,38 @@
     IF ( simulated_time_at_begin /= simulated_time )  THEN
        i = MAX ( log_point_s(10)%counts, 1 )
-       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0_wp )  THEN
-          cpuseconds_per_simulated_second = 0.0_wp
+       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0 )  THEN
+          cpuseconds_per_simulated_second = 0.0
        ELSE
-          cpuseconds_per_simulated_second = log_point_s(10)%sum /                                  &
-                                            ( simulated_time - simulated_time_at_begin )
-       ENDIF
-       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum,                                     &
-                          log_point_s(10)%sum / REAL( i, KIND=wp ), cpuseconds_per_simulated_second
-       IF ( time_restart /= 9999999.9_wp  .AND.  time_restart < end_time )  THEN
-          IF ( dt_restart == 9999999.9_wp )  THEN
-             WRITE ( io, 204 )  ' Next restart at:     ',time_restart
-          ELSE
-             WRITE ( io, 205 )  ' Next restart at:     ',time_restart, dt_restart
-          ENDIF
-       ENDIF
-    ENDIF
-
-
-!
-!-- Start time for coupled runs, if independent precursor runs for atmosphere and ocean are used or
-!-- have been used. In this case, coupling_start_time defines the time when the coupling is
-!-- switched on.
-    IF ( coupling_start_time /= 0.0_wp )  THEN
-       WRITE ( io, 207 )  coupling_start_time
+          cpuseconds_per_simulated_second = log_point_s(10)%sum / &
+                                            ( simulated_time -    &
+                                              simulated_time_at_begin )
+       ENDIF
+       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum, &
+                          log_point_s(10)%sum / REAL( i ),     &
+                          cpuseconds_per_simulated_second
+       IF ( time_restart /= 9999999.9  .AND.  time_restart < end_time )  THEN
+          IF ( dt_restart == 9999999.9 )  THEN
+             WRITE ( io, 204 )  ' Next restart at:  ',time_restart
+          ELSE
+             WRITE ( io, 205 )  ' Next restart at:  ',time_restart, dt_restart
+          ENDIF
+       ENDIF
     ENDIF
 
 !
 !-- Computational grid
-    IF ( .NOT. ocean_mode )  THEN
-       WRITE ( io, 250 )  dx, dy
-
-       DO i = 1, number_stretch_level_start+1
-          WRITE ( io, 253 )  i, dz(i)
-       ENDDO
-
-       WRITE( io, 251 ) (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
-
-       IF ( ANY( dz_stretch_level_start_index < nzt+1 ) )  THEN
-          WRITE( io, '(A)', advance='no') ' Vertical stretching starts at height:'
-          DO i = 1, number_stretch_level_start
-             WRITE ( io, '(F10.1,A3)', advance='no' )  dz_stretch_level_start(i), ' m,'
-          ENDDO
-          WRITE( io, '(/,A)', advance='no') ' Vertical stretching starts at index: '
-          DO i = 1, number_stretch_level_start
-             WRITE ( io, '(I12,A1)', advance='no' )  dz_stretch_level_start_index(i), ','
-          ENDDO
-          WRITE( io, '(/,A)', advance='no') ' Vertical stretching ends at height:  '
-          DO i = 1, number_stretch_level_start
-             WRITE ( io, '(F10.1,A3)', advance='no' )  dz_stretch_level_end(i), ' m,'
-          ENDDO
-          WRITE( io, '(/,A)', advance='no') ' Vertical stretching ends at index:   '
-          DO i = 1, number_stretch_level_start
-             WRITE ( io, '(I12,A1)', advance='no' )  dz_stretch_level_end_index(i), ','
-          ENDDO
-          WRITE( io, '(/,A)', advance='no') ' Factor used for stretching:          '
-          DO i = 1, number_stretch_level_start
-             WRITE ( io, '(F12.3,A1)', advance='no' )  dz_stretch_factor_array(i), ','
-          ENDDO
-       ENDIF
-
+    WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
+    IF ( dz_stretch_level_index < nzt+1 )  THEN
+       WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
+                          dz_stretch_factor, dz_max
+    ENDIF
+    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
+                       MIN( nnz+2, nzt+2 )
+    IF ( nxa == nx  .AND.  nya == ny  .AND.  nza == nz )  THEN
+       WRITE ( io, 255 )
     ELSE
-       WRITE ( io, 250 )  dx, dy
-       DO i = 1, number_stretch_level_start+1
-          WRITE ( io, 253 )  i, dz(i)
-       ENDDO
-
-       WRITE ( io, 251 ) (nx+1)*dx, (ny+1)*dy, zu(0)
-
-       IF ( ANY( dz_stretch_level_start_index > 0 ) )  THEN
-          WRITE( io, '(A)', advance='no') ' Vertical stretching starts at height:'
-          DO i = 1, number_stretch_level_start
-             WRITE ( io, '(F10.1,A3)', advance='no' )  dz_stretch_level_start(i), ' m,'
-          ENDDO
-          WRITE( io, '(/,A)', advance='no') ' Vertical stretching starts at index: '
-          DO i = 1, number_stretch_level_start
-             WRITE ( io, '(I12,A1)', advance='no' )  dz_stretch_level_start_index(i), ','
-          ENDDO
-          WRITE( io, '(/,A)', advance='no') ' Vertical stretching ends at height:  '
-          DO i = 1, number_stretch_level_start
-             WRITE ( io, '(F10.1,A3)', advance='no' )  dz_stretch_level_end(i), ' m,'
-          ENDDO
-          WRITE( io, '(/,A)', advance='no') ' Vertical stretching ends at index:   '
-          DO i = 1, number_stretch_level_start
-             WRITE ( io, '(I12,A1)', advance='no' )  dz_stretch_level_end_index(i), ','
-          ENDDO
-          WRITE( io, '(/,A)', advance='no') ' Factor used for stretching:          '
-          DO i = 1, number_stretch_level_start
-             WRITE ( io, '(F12.3,A1)', advance='no' )  dz_stretch_factor_array(i), ','
-          ENDDO
-       ENDIF
-    ENDIF
-    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), MIN( nnz+2, nzt+2 )
+       WRITE ( io, 256 )  nnx-(nxa-nx), nny-(nya-ny), nzt+2
+    ENDIF
     IF ( sloping_surface )  WRITE ( io, 260 )  alpha_surface
-
-!
-!-- Profile for the large scale vertial velocity.
-!-- Building output strings, starting with surface value
-    IF ( large_scale_subsidence )  THEN
-       temperatures = '   0.0'
-       gradients = '------'
-       slices = '     0'
-       coordinates = '   0.0'
-       i = 1
-       DO  WHILE ( subs_vertical_gradient_level_i(i) /= -9999 )
-
-          WRITE (coor_chr,'(E10.2,7X)')  &
-                                w_subs(subs_vertical_gradient_level_i(i))
-          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
-
-          WRITE (coor_chr,'(E10.2,7X)')  subs_vertical_gradient(i)
-          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
-
-          WRITE (coor_chr,'(I10,7X)')  subs_vertical_gradient_level_i(i)
-          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
-
-          WRITE (coor_chr,'(F10.2,7X)')  subs_vertical_gradient_level(i)
-          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
-
-          IF ( i == 10 )  THEN
-             EXIT
-          ELSE
-             i = i + 1
-          ENDIF
-
-       ENDDO
-
-
-       IF ( .NOT. large_scale_forcing )  THEN
-          WRITE ( io, 426 )  TRIM( coordinates ), TRIM( temperatures ), TRIM( gradients ),         &
-                             TRIM( slices )
-       ENDIF
-
-
-    ENDIF
-
-!-- Profile of the geostrophic wind (component ug).
-!-- Building output strings
-    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
-    gradients = '------'
-    slices = '     0'
-    coordinates = '   0.0'
-    i = 1
-    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
-
-       WRITE (coor_chr,'(F6.2,1X)')  ug(ug_vertical_gradient_level_ind(i))
-       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
-
-       WRITE (coor_chr,'(F6.2,1X)')  ug_vertical_gradient(i)
-       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
-
-       WRITE (coor_chr,'(I6,1X)')  ug_vertical_gradient_level_ind(i)
-       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
-
-       WRITE (coor_chr,'(F6.1,1X)')  ug_vertical_gradient_level(i)
-       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
-
-       IF ( i == 10 )  THEN
-          EXIT
-       ELSE
-          i = i + 1
-       ENDIF
-
-    ENDDO
-
-    IF ( .NOT. large_scale_forcing )  THEN
-       WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), TRIM( gradients ),             &
-                          TRIM( slices )
-    ENDIF
-
-!-- Profile of the geostrophic wind (component vg).
-!-- Building output strings
-    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
-    gradients = '------'
-    slices = '     0'
-    coordinates = '   0.0'
-    i = 1
-    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
-
-       WRITE (coor_chr,'(F6.2,1X)')  vg(vg_vertical_gradient_level_ind(i))
-       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
-
-       WRITE (coor_chr,'(F6.2,1X)')  vg_vertical_gradient(i)
-       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
-
-       WRITE (coor_chr,'(I6,1X)')  vg_vertical_gradient_level_ind(i)
-       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
-
-       WRITE (coor_chr,'(F6.1,1X)')  vg_vertical_gradient_level(i)
-       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
-
-       IF ( i == 10 )  THEN
-          EXIT
-       ELSE
-          i = i + 1
-       ENDIF
-
-    ENDDO
-
-    IF ( .NOT. large_scale_forcing )  THEN
-       WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), TRIM( gradients ),             &
-                          TRIM( slices )
-    ENDIF
 
 !
@@ -688,202 +415,101 @@
           blx = INT( building_length_x / dx )
           bly = INT( building_length_y / dy )
-          bh  = MINLOC( ABS( zw - building_height ), 1 ) - 1
-          IF ( ABS( zw(bh  ) - building_height ) == &
-               ABS( zw(bh+1) - building_height )    )  bh = bh + 1
-
-          IF ( building_wall_left == 9999999.9_wp )  THEN
+          bh  = INT( building_height / dz )
+
+          IF ( building_wall_left == 9999999.9 )  THEN
              building_wall_left = ( nx + 1 - blx ) / 2 * dx
           ENDIF
-          bxl = INT ( building_wall_left / dx + 0.5_wp )
+          bxl = INT ( building_wall_left / dx + 0.5 )
           bxr = bxl + blx
 
-          IF ( building_wall_south == 9999999.9_wp )  THEN
+          IF ( building_wall_south == 9999999.9 )  THEN
              building_wall_south = ( ny + 1 - bly ) / 2 * dy
           ENDIF
-          bys = INT ( building_wall_south / dy + 0.5_wp )
+          bys = INT ( building_wall_south / dy + 0.5 )
           byn = bys + bly
 
-          WRITE ( io, 271 )  building_length_x, building_length_y, building_height, bxl, bxr, bys, &
-                             byn
-
-       CASE ( 'single_street_canyon' )
-          ch  = MINLOC( ABS( zw - canyon_height ), 1 ) - 1
-          IF ( ABS( zw(ch  ) - canyon_height ) == &
-               ABS( zw(ch+1) - canyon_height )    )  ch = ch + 1
-          IF ( canyon_width_x /= 9999999.9_wp )  THEN
-!
-!--          Street canyon in y direction
-             cwx = NINT( canyon_width_x / dx )
-             IF ( canyon_wall_left == 9999999.9_wp )  THEN
-                canyon_wall_left = ( nx + 1 - cwx ) / 2 * dx
-             ENDIF
-             cxl = NINT( canyon_wall_left / dx )
-             cxr = cxl + cwx
-             WRITE ( io, 272 )  'y', canyon_height, ch, 'u', cxl, cxr
-
-          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
-!
-!--          Street canyon in x direction
-             cwy = NINT( canyon_width_y / dy )
-             IF ( canyon_wall_south == 9999999.9_wp )  THEN
-                canyon_wall_south = ( ny + 1 - cwy ) / 2 * dy
-             ENDIF
-             cys = NINT( canyon_wall_south / dy )
-             cyn = cys + cwy
-             WRITE ( io, 272 )  'x', canyon_height, ch, 'v', cys, cyn
-          ENDIF
-
-       CASE ( 'tunnel' )
-          IF ( tunnel_width_x /= 9999999.9_wp )  THEN
-!
-!--          Tunnel axis in y direction
-             IF ( tunnel_length == 9999999.9_wp  .OR.  tunnel_length >= ( nx + 1 ) * dx )  THEN
-                WRITE ( io, 273 )  'y', tunnel_height, tunnel_wall_depth, tunnel_width_x
-             ELSE
-                WRITE ( io, 274 )  'y', tunnel_height, tunnel_wall_depth, tunnel_width_x,          &
-                                        tunnel_length
-             ENDIF
-
-          ELSEIF ( tunnel_width_y /= 9999999.9_wp )  THEN
-!
-!--          Tunnel axis in x direction
-             IF ( tunnel_length == 9999999.9_wp  .OR.  tunnel_length >= ( ny + 1 ) * dy )  THEN
-                WRITE ( io, 273 )  'x', tunnel_height, tunnel_wall_depth, tunnel_width_y
-             ELSE
-                WRITE ( io, 274 )  'x', tunnel_height, tunnel_wall_depth, tunnel_width_y,          &
-                                        tunnel_length
-             ENDIF
-          ENDIF
+          WRITE ( io, 271 )  building_length_x, building_length_y, &
+                             building_height, bxl, bxr, bys, byn
 
     END SELECT
 
-    IF ( TRIM( topography ) /= 'flat' )  THEN
-       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
-          IF ( TRIM( topography ) == 'single_building' .OR.                                        &
-               TRIM( topography ) == 'single_street_canyon' )  THEN
-             WRITE ( io, 278 )
-          ELSEIF ( TRIM( topography ) == 'read_from_file' )  THEN
-             WRITE ( io, 279 )
-          ENDIF
-       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_edge' )  THEN
-          WRITE ( io, 278 )
-       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_center' )  THEN
-          WRITE ( io, 279 )
-       ENDIF
-    ENDIF
-
-!-- Complex terrain
-    IF ( complex_terrain )  THEN
-       WRITE( io, 280 )
-       IF ( turbulent_inflow )  THEN
-          WRITE( io, 281 )  zu(topo_top_ind(0,0,0))
-       ENDIF
-       IF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
-          WRITE( io, 282 )
-       ENDIF
-    ENDIF
 !
 !-- Boundary conditions
     IF ( ibc_p_b == 0 )  THEN
-       r_lower = 'p(0)     = 0      |'
+       runten = 'p(0)     = 0      |'
     ELSEIF ( ibc_p_b == 1 )  THEN
-       r_lower = 'p(0)     = p(1)   |'
+       runten = 'p(0)     = p(1)   |'
+    ELSE
+       runten = 'p(0)     = p(1) +R|'
     ENDIF
     IF ( ibc_p_t == 0 )  THEN
-       r_upper  = 'p(nzt+1) = 0      |'
+       roben  = 'p(nzt+1) = 0      |'
     ELSE
-       r_upper  = 'p(nzt+1) = p(nzt) |'
+       roben  = 'p(nzt+1) = p(nzt) |'
     ENDIF
 
     IF ( ibc_uv_b == 0 )  THEN
-       r_lower = TRIM( r_lower ) // ' uv(0)     = -uv(1)                |'
+       runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
     ELSE
-       r_lower = TRIM( r_lower ) // ' uv(0)     = uv(1)                 |'
-    ENDIF
-    IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
-       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = 0                     |'
-    ELSEIF ( ibc_uv_t == 0 )  THEN
-       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
+       runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
+    ENDIF
+    IF ( ibc_uv_t == 0 )  THEN
+       roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
     ELSE
-       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = uv(nzt)               |'
+       roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
     ENDIF
 
     IF ( ibc_pt_b == 0 )  THEN
-       IF ( land_surface )  THEN
-          r_lower = TRIM( r_lower ) // ' pt(0)     = from soil model'
-       ELSE
-          r_lower = TRIM( r_lower ) // ' pt(0)     = pt_surface'
-       ENDIF
-    ELSEIF ( ibc_pt_b == 1 )  THEN
-       r_lower = TRIM( r_lower ) // ' pt(0)     = pt(1)'
-    ELSEIF ( ibc_pt_b == 2 )  THEN
-       r_lower = TRIM( r_lower ) // ' pt(0)     = from coupled model'
+       runten = TRIM( runten ) // ' pt(0)   = pt_surface'
+    ELSE
+       runten = TRIM( runten ) // ' pt(0)   = pt(1)'
     ENDIF
     IF ( ibc_pt_t == 0 )  THEN
-       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt_top'
-    ELSEIF( ibc_pt_t == 1 )  THEN
-       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt(nzt)'
-    ELSEIF( ibc_pt_t == 2 )  THEN
-       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
-
-    ENDIF
-
-    WRITE ( io, 300 )  r_lower, r_upper
+       roben  = TRIM( roben  ) // ' pt(nzt) = pt_top'
+    ELSE
+       roben  = TRIM( roben  ) // ' pt(nzt) = pt(nzt-1) + dpt/dz'
+    ENDIF
+
+    WRITE ( io, 300 )  runten, roben
 
     IF ( .NOT. constant_diffusion )  THEN
        IF ( ibc_e_b == 1 )  THEN
-          r_lower = 'e(0)     = e(1)'
+          runten = 'e(0)     = e(1)'
        ELSE
-          r_lower = 'e(0)     = e(1) = (u*/0.1)**2'
-       ENDIF
-       r_upper = 'e(nzt+1) = e(nzt) = e(nzt-1)'
-
-       WRITE ( io, 301 )  'e', r_lower, r_upper
-
-    ENDIF
-
-    IF ( ocean_mode )  THEN
-       r_lower = 'sa(0)    = sa(1)'
-       IF ( ibc_sa_t == 0 )  THEN
-          r_upper =  'sa(nzt+1) = sa_surface'
+          runten = 'e(0)     = e(1) = (u*/0.1)**2'
+       ENDIF
+       roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
+
+       WRITE ( io, 301 )  runten, roben       
+
+    ENDIF
+
+    IF ( moisture  .OR.  passive_scalar )  THEN
+       IF ( moisture )  THEN
+          IF ( ibc_q_b == 0 )  THEN
+             runten = 'q(0)     = q_surface'
+          ELSE
+             runten = 'q(0)     = q(1)'
+          ENDIF
+          IF ( ibc_q_t == 0 )  THEN
+             roben =  'q(nzt)   = q_top'
+          ELSE
+             roben =  'q(nzt)   = q(nzt-1) + dq/dz'
+          ENDIF
        ELSE
-          r_upper =  'sa(nzt+1) = sa(nzt)'
-       ENDIF
-       WRITE ( io, 301 ) 'sa', r_lower, r_upper
-    ENDIF
-
-    IF ( humidity )  THEN
-       IF ( ibc_q_b == 0 )  THEN
-          IF ( land_surface )  THEN
-             r_lower = 'q(0)     = from soil model'
-          ELSE
-             r_lower = 'q(0)     = q_surface'
-          ENDIF
-
-       ELSE
-          r_lower = 'q(0)      = q(1)'
-       ENDIF
-       IF ( ibc_q_t == 0 )  THEN
-          r_upper =  'q(nzt+1) = q_top'
-       ELSE
-          r_upper =  'q(nzt+1) = q(nzt) + dq/dz'
-       ENDIF
-       WRITE ( io, 301 ) 'q', r_lower, r_upper
-    ENDIF
-
-    IF ( passive_scalar )  THEN
-       IF ( ibc_s_b == 0 )  THEN
-          r_lower = 's(0)      = s_surface'
-       ELSE
-          r_lower = 's(0)      = s(1)'
-       ENDIF
-       IF ( ibc_s_t == 0 )  THEN
-          r_upper =  's(nzt+1) = s_top'
-       ELSEIF ( ibc_s_t == 1 )  THEN
-          r_upper =  's(nzt+1) = s(nzt)'
-       ELSEIF ( ibc_s_t == 2 )  THEN
-          r_upper =  's(nzt+1) = s(nzt) + ds/dz'
-       ENDIF
-       WRITE ( io, 301 ) 's', r_lower, r_upper
+          IF ( ibc_q_b == 0 )  THEN
+             runten = 's(0)     = s_surface'
+          ELSE
+             runten = 's(0)     = s(1)'
+          ENDIF
+          IF ( ibc_q_t == 0 )  THEN
+             roben =  's(nzt)   = s_top'
+          ELSE
+             roben =  's(nzt)   = s(nzt-1) + ds/dz'
+          ENDIF
+       ENDIF
+
+       WRITE ( io, 302 ) runten, roben
+
     ENDIF
 
@@ -891,227 +517,40 @@
        WRITE ( io, 303 )
        IF ( constant_heatflux )  THEN
-          IF ( large_scale_forcing .AND. lsf_surf )  THEN
-             IF ( surf_def_h(0)%ns >= 1 )  WRITE ( io, 306 )  surf_def_h(0)%shf(1)
-          ELSE
-             WRITE ( io, 306 )  surface_heatflux
-          ENDIF
+          WRITE ( io, 306 )  surface_heatflux
           IF ( random_heatflux )  WRITE ( io, 307 )
        ENDIF
-       IF ( humidity  .AND.  constant_waterflux )  THEN
-          IF ( large_scale_forcing .AND. lsf_surf )  THEN
-             WRITE ( io, 311 ) surf_def_h(0)%qsws(1)
-          ELSE
-             WRITE ( io, 311 ) surface_waterflux
-          ENDIF
-       ENDIF
-       IF ( passive_scalar  .AND.  constant_scalarflux )  THEN
-          WRITE ( io, 313 ) surface_scalarflux
-       ENDIF
-    ENDIF
-
-    IF ( use_top_fluxes )  THEN
-       WRITE ( io, 304 )
-       IF ( coupling_mode == 'uncoupled' )  THEN
-          WRITE ( io, 320 )  top_momentumflux_u, top_momentumflux_v
-          IF ( constant_top_heatflux )  THEN
-             WRITE ( io, 306 )  top_heatflux
-          ENDIF
-       ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
-          WRITE ( io, 316 )
-       ENDIF
-       IF ( ocean_mode  .AND.  constant_top_salinityflux )  WRITE ( io, 309 )  top_salinityflux
-       IF ( humidity       )  WRITE ( io, 315 )
-       IF ( passive_scalar  .AND.  constant_top_scalarflux )  WRITE ( io, 302 ) top_scalarflux
-    ENDIF
-
-    IF ( constant_flux_layer )  THEN
-       WRITE ( io, 305 )  (zu(1)-zu(0)), roughness_length, z0h_factor*roughness_length, kappa,     &
-                          zeta_min, zeta_max
+       IF ( moisture  .AND.  constant_waterflux )  THEN
+          WRITE ( io, 311 ) surface_waterflux
+       ENDIF
+       IF ( passive_scalar  .AND.  constant_waterflux )  THEN
+          WRITE ( io, 313 ) surface_waterflux
+       ENDIF
+    ENDIF
+
+    IF ( prandtl_layer )  THEN
+       WRITE ( io, 305 )  zu(1), roughness_length, kappa, rif_min, rif_max
        IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
-       IF ( humidity  .AND.  .NOT. constant_waterflux )  THEN
+       IF ( moisture  .AND.  .NOT. constant_waterflux )  THEN
           WRITE ( io, 312 )
        ENDIF
-       IF ( passive_scalar  .AND.  .NOT. constant_scalarflux )  THEN
+       IF ( passive_scalar  .AND.  .NOT. constant_waterflux )  THEN
           WRITE ( io, 314 )
        ENDIF
     ELSE
-       IF ( INDEX( initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
-          WRITE ( io, 310 )  zeta_min, zeta_max
+       IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
+          WRITE ( io, 310 )  rif_min, rif_max
        ENDIF
     ENDIF
 
     WRITE ( io, 317 )  bc_lr, bc_ns
-    IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
-       WRITE ( io, 318 )  pt_damping_width, pt_damping_factor
-       IF ( turbulent_inflow )  THEN
-          IF ( y_shift == 0 )  THEN
-             WRITE ( io, 319 )  recycling_width, recycling_plane,                                  &
-                                inflow_damping_height, inflow_damping_width
-          ELSE
-             WRITE ( io, 322 )  y_shift, recycling_width, recycling_plane,                         &
-                                inflow_damping_height, inflow_damping_width
-          END IF
-       ENDIF
-       IF ( turbulent_outflow )  THEN
-          WRITE ( io, 323 )  outflow_source_plane, INT( outflow_source_plane / dx )
-       ENDIF
-    ENDIF
-
-!
-!-- Initial Profiles
-    WRITE ( io, 321 )
-!
-!-- Initial wind profiles
-    IF ( u_profile(1) /= 9999999.9_wp )  WRITE ( io, 427 )
-
-!
-!-- Initial temperature profile
-!-- Building output strings, starting with surface temperature
-    WRITE ( temperatures, '(F6.2)' )  pt_surface
-    gradients = '------'
-    slices = '     0'
-    coordinates = '   0.0'
-    i = 1
-    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
-
-       WRITE ( coor_chr, '(F7.2)' )  pt_init(pt_vertical_gradient_level_ind(i))
-       temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
-
-       WRITE ( coor_chr, '(F7.2)' )  pt_vertical_gradient(i)
-       gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
-
-       WRITE ( coor_chr, '(I7)' )  pt_vertical_gradient_level_ind(i)
-       slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
-
-       WRITE ( coor_chr, '(F7.1)' )  pt_vertical_gradient_level(i)
-       coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
-
-       IF ( i == 10 )  THEN
-          EXIT
-       ELSE
-          i = i + 1
-       ENDIF
-
-    ENDDO
-
-    IF ( .NOT. nudging )  THEN
-       WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), TRIM( gradients ),            &
-                          TRIM( slices )
-    ELSE
-       WRITE ( io, 428 )
-    ENDIF
-
-!
-!-- Initial humidity profile
-!-- Building output strings, starting with surface humidity
-    IF ( humidity )  THEN
-       WRITE ( temperatures, '(E8.1)' )  q_surface
-       gradients = '--------'
-       slices = '       0'
-       coordinates = '     0.0'
-       i = 1
-       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
-
-          WRITE ( coor_chr, '(E8.1,4X)' )  q_init(q_vertical_gradient_level_ind(i))
-          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
-
-          WRITE ( coor_chr, '(E8.1,4X)' )  q_vertical_gradient(i)
-          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
-
-          WRITE ( coor_chr, '(I8,4X)' )  q_vertical_gradient_level_ind(i)
-          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
-
-          WRITE ( coor_chr, '(F8.1,4X)' )  q_vertical_gradient_level(i)
-          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
-
-          IF ( i == 10 )  THEN
-             EXIT
-          ELSE
-             i = i + 1
-          ENDIF
-
-       ENDDO
-
-       IF ( .NOT. nudging )  THEN
-          WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), TRIM( gradients ),         &
-                             TRIM( slices )
-       ENDIF
-    ENDIF
-!
-!-- Initial scalar profile
-!-- Building output strings, starting with surface humidity
-    IF ( passive_scalar )  THEN
-       WRITE ( temperatures, '(E8.1)' )  s_surface
-       gradients = '--------'
-       slices = '       0'
-       coordinates = '     0.0'
-       i = 1
-       DO  WHILE ( s_vertical_gradient_level_ind(i) /= -9999 )
-
-          WRITE ( coor_chr, '(E8.1,4X)' )  s_init(s_vertical_gradient_level_ind(i))
-          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
-
-          WRITE ( coor_chr, '(E8.1,4X)' )  s_vertical_gradient(i)
-          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
-
-          WRITE ( coor_chr, '(I8,4X)' )  s_vertical_gradient_level_ind(i)
-          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
-
-          WRITE ( coor_chr, '(F8.1,4X)' )  s_vertical_gradient_level(i)
-          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
-
-          IF ( i == 10 )  THEN
-             EXIT
-          ELSE
-             i = i + 1
-          ENDIF
-
-       ENDDO
-
-       WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), TRIM( gradients ),            &
-                          TRIM( slices )
-    ENDIF
-
-!
-!-- Initial salinity profile
-!-- Building output strings, starting with surface salinity
-    IF ( ocean_mode )  THEN
-       WRITE ( temperatures, '(F6.2)' )  sa_surface
-       gradients = '------'
-       slices = '     0'
-       coordinates = '   0.0'
-       i = 1
-       DO  WHILE ( sa_vertical_gradient_level_ind(i) /= -9999 )
-
-          WRITE ( coor_chr, '(F7.2)' )  sa_init(sa_vertical_gradient_level_ind(i))
-          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
-
-          WRITE ( coor_chr, '(F7.2)' )  sa_vertical_gradient(i)
-          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
-
-          WRITE ( coor_chr, '(I7)' )  sa_vertical_gradient_level_ind(i)
-          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
-
-          WRITE ( coor_chr, '(F7.1)' )  sa_vertical_gradient_level(i)
-          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
-
-          IF ( i == 10 )  THEN
-             EXIT
-          ELSE
-             i = i + 1
-          ENDIF
-
-       ENDDO
-
-       WRITE ( io, 425 )  TRIM( coordinates ), TRIM( temperatures ), TRIM( gradients ),            &
-                          TRIM( slices )
-    ENDIF
-
+    IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
+       WRITE ( io, 318 )  outflow_damping_width, km_damp_max
+    ENDIF
 
 !
 !-- Listing of 1D-profiles
-    WRITE ( io, 325 )  dt_dopr_listing
-    IF ( averaging_interval_pr /= 0.0_wp )  THEN
-       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
+    WRITE ( io, 320 )  dt_dopr_listing
+    IF ( averaging_interval_pr /= 0.0 )  THEN
+       WRITE ( io, 321 )  averaging_interval_pr, dt_averaging_input_pr
     ENDIF
 
@@ -1119,6 +558,6 @@
 !-- DATA output
     WRITE ( io, 330 )
-    IF ( averaging_interval_pr /= 0.0_wp )  THEN
-       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
+    IF ( averaging_interval_pr /= 0.0 )  THEN
+       WRITE ( io, 321 )  averaging_interval_pr, dt_averaging_input_pr
     ENDIF
 
@@ -1130,10 +569,19 @@
 
        output_format = ''
-       output_format = netcdf_data_format_string
-       IF ( netcdf_deflate == 0 )  THEN
-          WRITE ( io, 344 )  output_format
-       ELSE
-          WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
-       ENDIF
+       IF ( netcdf_output )  THEN
+          IF ( netcdf_64bit )  THEN
+             output_format = 'netcdf (64 bit offset)'
+          ELSE
+             output_format = 'netcdf'
+          ENDIF
+       ENDIF
+       IF ( profil_output )  THEN
+          IF ( netcdf_output )  THEN
+             output_format = TRIM( output_format ) // ' and profil'
+          ELSE
+             output_format = 'profil'
+          ENDIF
+       ENDIF
+       WRITE ( io, 345 )  output_format
 
        DO  i = 1, dopr_n
@@ -1149,5 +597,5 @@
        ENDIF
        WRITE ( io, 333 )  dt_dopr, averaging_interval_pr, dt_averaging_input_pr
-       IF ( skip_time_dopr /= 0.0_wp )  WRITE ( io, 339 )  skip_time_dopr
+       IF ( skip_time_dopr /= 0.0 )  WRITE ( io, 339 )  skip_time_dopr
     ENDIF
 
@@ -1181,7 +629,8 @@
        ENDDO
 
-       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.                                &
-              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.                                &
-              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) ) )  THEN
+       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.    &
+              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.    &
+              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) )  .AND. &
+            ( netcdf_output  .OR.  iso2d_output ) )  THEN
 
           IF (  av == 0 )  THEN
@@ -1198,10 +647,19 @@
 
           output_format = ''
-          output_format = netcdf_data_format_string
-          IF ( netcdf_deflate == 0 )  THEN
-             WRITE ( io, 344 )  output_format
-          ELSE
-             WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
-          ENDIF
+          IF ( netcdf_output )  THEN
+             IF ( netcdf_64bit )  THEN
+                output_format = 'netcdf (64 bit offset)'
+             ELSE
+                output_format = 'netcdf'
+             ENDIF
+          ENDIF
+          IF ( iso2d_output )  THEN
+             IF ( netcdf_output )  THEN
+                output_format = TRIM( output_format ) // ' and iso2d'
+             ELSE
+                output_format = 'iso2d'
+             ENDIF
+          ENDIF
+          WRITE ( io, 345 )  output_format
 
           IF ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  THEN
@@ -1210,5 +668,6 @@
              coordinates = '/'
 !
-!--          Building strings with index and coordinate information of the slices
+!--          Building strings with index and coordinate informations of the
+!--          slices
              DO  WHILE ( section(i,1) /= -9999 )
 
@@ -1217,9 +676,5 @@
                 slices = TRIM( slices ) // TRIM( section_chr ) // '/'
 
-                IF ( section(i,1) == -1 )  THEN
-                   WRITE ( coor_chr, '(F10.1)' )  -1.0_wp
-                ELSE
-                   WRITE ( coor_chr, '(F10.1)' )  zu(section(i,1))
-                ENDIF
+                WRITE (coor_chr,'(F10.1)')  zu(section(i,1))
                 coor_chr = ADJUSTL( coor_chr )
                 coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
@@ -1228,22 +683,20 @@
              ENDDO
              IF ( av == 0 )  THEN
-                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, TRIM( begin_chr ), 'k',              &
-                                   TRIM( slices ), TRIM( coordinates )
-                IF ( skip_time_do2d_xy /= 0.0_wp )  THEN
+                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, &
+                                   TRIM( begin_chr ), 'k', TRIM( slices ), &
+                                   TRIM( coordinates )
+                IF ( skip_time_do2d_xy /= 0.0 )  THEN
                    WRITE ( io, 339 )  skip_time_do2d_xy
                 ENDIF
              ELSE
-                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, TRIM( begin_chr ),            &
-                                   averaging_interval, dt_averaging_input, 'k', TRIM( slices ),    &
+                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, &
+                                   TRIM( begin_chr ), averaging_interval, &
+                                   dt_averaging_input, 'k', TRIM( slices ), &
                                    TRIM( coordinates )
-                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
+                IF ( skip_time_data_output_av /= 0.0 )  THEN
                    WRITE ( io, 339 )  skip_time_data_output_av
                 ENDIF
              ENDIF
-             IF ( netcdf_data_format > 4 )  THEN
-                WRITE ( io, 352 )  ntdim_2d_xy(av)
-             ELSE
-                WRITE ( io, 353 )
-             ENDIF
+
           ENDIF
 
@@ -1253,5 +706,6 @@
              coordinates = '/'
 !
-!--          Building strings with index and coordinate information of the slices
+!--          Building strings with index and coordinate informations of the
+!--          slices
              DO  WHILE ( section(i,2) /= -9999 )
 
@@ -1267,21 +721,18 @@
              ENDDO
              IF ( av == 0 )  THEN
-                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, TRIM( begin_chr ), 'j',              &
-                                   TRIM( slices ), TRIM( coordinates )
-                IF ( skip_time_do2d_xz /= 0.0_wp )  THEN
+                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, &
+                                   TRIM( begin_chr ), 'j', TRIM( slices ), &
+                                   TRIM( coordinates )
+                IF ( skip_time_do2d_xz /= 0.0 )  THEN
                    WRITE ( io, 339 )  skip_time_do2d_xz
                 ENDIF
              ELSE
-                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, TRIM( begin_chr ),            &
-                                   averaging_interval, dt_averaging_input, 'j', TRIM( slices ),    &
+                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, &
+                                   TRIM( begin_chr ), averaging_interval, &
+                                   dt_averaging_input, 'j', TRIM( slices ), &
                                    TRIM( coordinates )
-                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
+                IF ( skip_time_data_output_av /= 0.0 )  THEN
                    WRITE ( io, 339 )  skip_time_data_output_av
                 ENDIF
-             ENDIF
-             IF ( netcdf_data_format > 4 )  THEN
-                WRITE ( io, 352 )  ntdim_2d_xz(av)
-             ELSE
-                WRITE ( io, 353 )
              ENDIF
           ENDIF
@@ -1292,5 +743,6 @@
              coordinates = '/'
 !
-!--          Building strings with index and coordinate information of the slices
+!--          Building strings with index and coordinate informations of the
+!--          slices
              DO  WHILE ( section(i,3) /= -9999 )
 
@@ -1306,22 +758,19 @@
              ENDDO
              IF ( av == 0 )  THEN
-                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, TRIM( begin_chr ), 'i',              &
-                                   TRIM( slices ), TRIM( coordinates )
-                IF ( skip_time_do2d_yz /= 0.0_wp )  THEN
+                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, &
+                                   TRIM( begin_chr ), 'i', TRIM( slices ), &
+                                   TRIM( coordinates )
+                IF ( skip_time_do2d_yz /= 0.0 )  THEN
                    WRITE ( io, 339 )  skip_time_do2d_yz
                 ENDIF
              ELSE
-                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, TRIM( begin_chr ),            &
-                                   averaging_interval, dt_averaging_input, 'i', TRIM( slices ),    &
+                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, &
+                                   TRIM( begin_chr ), averaging_interval, &
+                                   dt_averaging_input, 'i', TRIM( slices ), &
                                    TRIM( coordinates )
-                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
+                IF ( skip_time_data_output_av /= 0.0 )  THEN
                    WRITE ( io, 339 )  skip_time_data_output_av
                 ENDIF
              ENDIF
-             IF ( netcdf_data_format > 4 )  THEN
-                WRITE ( io, 352 )  ntdim_2d_yz(av)
-             ELSE
-                WRITE ( io, 353 )
-             ENDIF
           ENDIF
 
@@ -1350,10 +799,20 @@
           ENDIF
 
-          output_format = netcdf_data_format_string
-          IF ( netcdf_deflate == 0 )  THEN
-             WRITE ( io, 344 )  output_format
-          ELSE
-             WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
-          ENDIF
+          output_format = ''
+          IF ( netcdf_output )  THEN
+             IF ( netcdf_64bit )  THEN
+                output_format = 'netcdf (64 bit offset)'
+             ELSE
+                output_format = 'netcdf'
+             ENDIF
+          ENDIF
+          IF ( avs_output )  THEN
+             IF ( netcdf_output )  THEN
+                output_format = TRIM( output_format ) // ' and avs'
+             ELSE
+                output_format = 'avs'
+             ENDIF
+          ENDIF
+          WRITE ( io, 345 )  output_format
 
           IF ( do3d_at_begin )  THEN
@@ -1363,22 +822,45 @@
           ENDIF
           IF ( av == 0 )  THEN
-             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), zu(nz_do3d), nz_do3d
-          ELSE
-             WRITE ( io, 343 )  do3d_chr, dt_data_output_av, TRIM( begin_chr ), averaging_interval,&
+             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), &
+                                zu(nz_do3d), nz_do3d
+          ELSE
+             WRITE ( io, 343 )  do3d_chr, dt_data_output_av,           &
+                                TRIM( begin_chr ), averaging_interval, &
                                 dt_averaging_input, zu(nz_do3d), nz_do3d
           ENDIF
 
-          IF ( netcdf_data_format > 4 )  THEN
-             WRITE ( io, 352 )  ntdim_3d(av)
-          ELSE
-             WRITE ( io, 353 )
+          IF ( do3d_compress )  THEN
+             do3d_chr = ''
+             i = 1
+             DO WHILE ( do3d(av,i) /= ' ' )
+
+                SELECT CASE ( do3d(av,i) )
+                   CASE ( 'u' )
+                      j = 1
+                   CASE ( 'v' )
+                      j = 2
+                   CASE ( 'w' )
+                      j = 3
+                   CASE ( 'p' )
+                      j = 4
+                   CASE ( 'pt' )
+                      j = 5
+                END SELECT
+                WRITE ( prec, '(I1)' )  plot_3d_precision(j)%precision
+                do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // &
+                           ':' // prec // ','
+                i = i + 1
+
+             ENDDO
+             WRITE ( io, 338 )  do3d_chr
+
           ENDIF
 
           IF ( av == 0 )  THEN
-             IF ( skip_time_do3d /= 0.0_wp )  THEN
+             IF ( skip_time_do3d /= 0.0 )  THEN
                 WRITE ( io, 339 )  skip_time_do3d
              ENDIF
           ELSE
-             IF ( skip_time_data_output_av /= 0.0_wp )  THEN
+             IF ( skip_time_data_output_av /= 0.0 )  THEN
                 WRITE ( io, 339 )  skip_time_data_output_av
              ENDIF
@@ -1390,99 +872,84 @@
 
 !
-!-- Masked arrays
-    IF ( masks > 0 )  WRITE ( io, 345 )  mask_scale_x, mask_scale_y, mask_scale_z
-    DO  mid = 1, masks
-       DO  av = 0, 1
-
-          i = 1
-          domask_chr = ''
-          DO  WHILE ( domask(mid,av,i) /= ' ' )
-             domask_chr = TRIM( domask_chr ) // ' ' // TRIM( domask(mid,av,i) ) // ','
-             i = i + 1
-          ENDDO
-
-          IF ( domask_chr /= '' )  THEN
-             IF ( av == 0 )  THEN
-                WRITE ( io, 346 )  '', mid
-             ELSE
-                WRITE ( io, 346 )  ' (time-averaged)', mid
+!-- Timeseries
+    IF ( dt_dots /= 9999999.9 )  THEN
+       WRITE ( io, 340 )
+
+       output_format = ''
+       IF ( netcdf_output )  THEN
+          IF ( netcdf_64bit )  THEN
+             output_format = 'netcdf (64 bit offset)'
+          ELSE
+             output_format = 'netcdf'
+          ENDIF
+       ENDIF
+       IF ( profil_output )  THEN
+          IF ( netcdf_output )  THEN
+             output_format = TRIM( output_format ) // ' and profil'
+          ELSE
+             output_format = 'profil'
+          ENDIF
+       ENDIF
+       WRITE ( io, 345 )  output_format
+       WRITE ( io, 341 )  dt_dots
+    ENDIF
+
+#if defined( __dvrp_graphics )
+!
+!-- Dvrp-output
+    IF ( dt_dvrp /= 9999999.9 )  THEN
+       WRITE ( io, 360 )  dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
+                          TRIM( dvrp_username ), TRIM( dvrp_directory )
+       i = 1
+       l = 0
+       DO WHILE ( mode_dvrp(i) /= ' ' )
+          IF ( mode_dvrp(i)(1:10) == 'isosurface' )  THEN
+             READ ( mode_dvrp(i), '(10X,I1)' )  j
+             l = l + 1
+             IF ( do3d(0,j) /= ' ' )  THEN
+                WRITE ( io, 361 )  TRIM( do3d(0,j) ), threshold(l)
              ENDIF
-
-             output_format = netcdf_data_format_string
-!
-!--          Parallel output not implemented for mask data, hence output_format must be adjusted.
-             IF ( netcdf_data_format == 5 ) output_format = 'netCDF4/HDF5'
-             IF ( netcdf_data_format == 6 ) output_format = 'netCDF4/HDF5 classic'
-             IF ( netcdf_deflate == 0 )  THEN
-                WRITE ( io, 344 )  output_format
-             ELSE
-                WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
-             ENDIF
-
-             IF ( av == 0 )  THEN
-                WRITE ( io, 347 )  domask_chr, dt_domask(mid)
-             ELSE
-                WRITE ( io, 348 )  domask_chr, dt_data_output_av, averaging_interval,              &
-                                   dt_averaging_input
-             ENDIF
-
-             IF ( av == 0 )  THEN
-                IF ( skip_time_domask(mid) /= 0.0_wp )  THEN
-                   WRITE ( io, 339 )  skip_time_domask(mid)
-                ENDIF
-             ELSE
-                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
-                   WRITE ( io, 339 )  skip_time_data_output_av
-                ENDIF
-             ENDIF
-!
-!--          Output locations
-             DO  dim = 1, 3
-                IF ( mask(mid,dim,1) >= 0.0_wp )  THEN
-                   count = 0
-                   DO  WHILE ( mask(mid,dim,count+1) >= 0.0_wp )
-                      count = count + 1
-                   ENDDO
-                   WRITE ( io, 349 )  dir(dim), dir(dim), mid, dir(dim), mask(mid,dim,:count)
-                ELSEIF ( mask_loop(mid,dim,1) <  0.0_wp .AND.                                      &
-                         mask_loop(mid,dim,2) <  0.0_wp .AND.                                      &
-                         mask_loop(mid,dim,3) == 0.0_wp )  THEN
-                   WRITE ( io, 350 )  dir(dim), dir(dim)
-                ELSEIF ( mask_loop(mid,dim,3) == 0.0_wp )  THEN
-                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), mask_loop(mid,dim,1:2)
-                ELSE
-                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), mask_loop(mid,dim,1:3)
-                ENDIF
-             ENDDO
-          ENDIF
-
+          ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' )  THEN
+             READ ( mode_dvrp(i), '(6X,I1)' )  j
+             IF ( do2d(0,j) /= ' ' )  WRITE ( io, 362 )  TRIM( do2d(0,j) )
+          ELSEIF ( mode_dvrp(i)(1:9) == 'particles' )  THEN
+             WRITE ( io, 363 )
+          ENDIF
+          i = i + 1
        ENDDO
-    ENDDO
-
-!
-!-- Timeseries
-    IF ( dt_dots /= 9999999.9_wp )  THEN
-       WRITE ( io, 340 )
-
-       output_format = netcdf_data_format_string
-       IF ( netcdf_deflate == 0 )  THEN
-          WRITE ( io, 344 )  output_format
-       ELSE
-          WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
-       ENDIF
-       WRITE ( io, 341 )  dt_dots
-    ENDIF
-
-!
-!-- Restart data formats
-    IF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.  write_binary )  THEN
-       WRITE ( io, 355 )
-       IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
-          WRITE ( io, 356 )  TRIM( restart_data_format_input )
-       ENDIF
-       IF ( write_binary )  THEN
-          WRITE ( io, 357 )  TRIM( restart_data_format_output )
-       ENDIF
-    ENDIF
+    ENDIF
+#endif
+
+#if defined( __spectra )
+!
+!-- Spectra output
+    IF ( dt_dosp /= 9999999.9 ) THEN
+       WRITE ( io, 370 )
+
+       output_format = ''
+       IF ( netcdf_output )  THEN
+          IF ( netcdf_64bit )  THEN
+             output_format = 'netcdf (64 bit offset)'
+          ELSE
+             output_format = 'netcdf'
+          ENDIF
+       ENDIF
+       IF ( profil_output )  THEN
+          IF ( netcdf_output )  THEN
+             output_format = TRIM( output_format ) // ' and profil'
+          ELSE
+             output_format = 'profil'
+          ENDIF
+       ENDIF
+       WRITE ( io, 345 )  output_format
+       WRITE ( io, 371 )  dt_dosp
+       IF ( skip_time_dosp /= 0.0 )  WRITE ( io, 339 )  skip_time_dosp
+       WRITE ( io, 372 )  ( data_output_sp(i), i = 1,10 ),     &
+                          ( spectra_direction(i), i = 1,10 ),  &
+                          ( comp_spectra_level(i), i = 1,10 ), &
+                          ( plot_spectra_level(i), i = 1,10 ), &
+                          averaging_interval_sp, dt_averaging_input_pr
+    ENDIF
+#endif
 
     WRITE ( io, 99 )
@@ -1494,10 +961,5 @@
 !
 !-- Geostrophic parameters
-    WRITE ( io, 410 )  latitude, longitude, rotation_angle, omega, f, fs
-
-!
-!-- Day and time during model start
-    CALL get_date_time( 0.0_wp, date_time_str=date_time_str )
-    WRITE ( io, 456 )  TRIM( date_time_str )
+    WRITE ( io, 410 )  omega, phi, f, fs
 
 !
@@ -1505,19 +967,128 @@
     WRITE ( io, 411 )  g
 
-    WRITE ( io, 412 )  TRIM( reference_state )
-    IF ( use_single_reference_value )  THEN
-       IF ( ocean_mode )  THEN
-          WRITE ( io, 413 )  prho_reference
+!
+!-- Cloud physics parameters
+    IF ( cloud_physics ) THEN
+       WRITE ( io, 412 )
+       WRITE ( io, 413 ) surface_pressure, r_d, rho_surface, cp, l_v
+    ENDIF
+
+!-- Profile of the geostrophic wind (component ug)
+!-- Building output strings
+    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
+    gradients = '------'
+    slices = '     0'
+    coordinates = '   0.0'
+    i = 1
+    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
+      
+       WRITE (coor_chr,'(F6.2,4X)')  ug(ug_vertical_gradient_level_ind(i))
+       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
+
+       WRITE (coor_chr,'(F6.2,4X)')  ug_vertical_gradient(i)
+       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
+
+       WRITE (coor_chr,'(I6,4X)')  ug_vertical_gradient_level_ind(i)
+       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
+
+       WRITE (coor_chr,'(F6.1,4X)')  ug_vertical_gradient_level(i)
+       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
+
+       i = i + 1
+    ENDDO
+
+    WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), &
+                       TRIM( gradients ), TRIM( slices )
+
+!-- Profile of the geostrophic wind (component vg)
+!-- Building output strings
+    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
+    gradients = '------'
+    slices = '     0'
+    coordinates = '   0.0'
+    i = 1
+    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
+
+       WRITE (coor_chr,'(F6.2,4X)')  vg(vg_vertical_gradient_level_ind(i))
+       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
+
+       WRITE (coor_chr,'(F6.2,4X)')  vg_vertical_gradient(i)
+       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
+
+       WRITE (coor_chr,'(I6,4X)')  vg_vertical_gradient_level_ind(i)
+       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
+
+       WRITE (coor_chr,'(F6.1,4X)')  vg_vertical_gradient_level(i)
+       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
+
+       i = i + 1 
+    ENDDO
+
+    WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), &
+                       TRIM( gradients ), TRIM( slices )
+
+!
+!-- Initial temperature profile
+!-- Building output strings, starting with surface temperature
+    WRITE ( temperatures, '(F6.2)' )  pt_surface
+    gradients = '------'
+    slices = '     0'
+    coordinates = '   0.0'
+    i = 1
+    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
+
+       WRITE (coor_chr,'(F6.2,4X)')  pt_init(pt_vertical_gradient_level_ind(i))
+       temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
+
+       WRITE (coor_chr,'(F6.2,4X)')  pt_vertical_gradient(i)
+       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
+
+       WRITE (coor_chr,'(I6,4X)')  pt_vertical_gradient_level_ind(i)
+       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
+
+       WRITE (coor_chr,'(F6.1,4X)')  pt_vertical_gradient_level(i)
+       coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
+
+       i = i + 1
+    ENDDO
+
+    WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), &
+                       TRIM( gradients ), TRIM( slices )
+
+!
+!-- Initial humidity profile
+!-- Building output strings, starting with surface humidity
+    IF ( moisture  .OR.  passive_scalar )  THEN
+       WRITE ( temperatures, '(E8.1)' )  q_surface
+       gradients = '--------'
+       slices = '       0'
+       coordinates = '     0.0'
+       i = 1
+       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
+          
+          WRITE (coor_chr,'(E8.1,4X)')  q_init(q_vertical_gradient_level_ind(i))
+          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
+
+          WRITE (coor_chr,'(E8.1,4X)')  q_vertical_gradient(i)
+          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
+          
+          WRITE (coor_chr,'(I8,4X)')  q_vertical_gradient_level_ind(i)
+          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
+          
+          WRITE (coor_chr,'(F8.1,4X)')  q_vertical_gradient_level(i)
+          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
+
+          i = i + 1
+       ENDDO
+
+       IF ( moisture )  THEN
+          WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), &
+                             TRIM( gradients ), TRIM( slices )
        ELSE
-          WRITE ( io, 414 )  pt_reference
-       ENDIF
-    ENDIF
-
-!
-!-- Cloud physics parameters / quantities / numerical methods
-    WRITE ( io, 430 )
-    IF ( humidity  .AND.  .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets)  THEN
-       WRITE ( io, 431 )
-    ENDIF
+          WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), &
+                             TRIM( gradients ), TRIM( slices )
+       ENDIF
+    ENDIF
+
 !
 !-- LES / turbulence parameters
@@ -1528,22 +1099,21 @@
 !--
     IF ( constant_diffusion )  THEN
-       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, prandtl_number
+       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, &
+                          prandtl_number
     ENDIF
     IF ( .NOT. constant_diffusion)  THEN
-       IF ( e_init > 0.0_wp )  WRITE ( io, 455 )  e_init
-       IF ( e_min  > 0.0_wp )  WRITE ( io, 454 )  e_min
-       IF ( wall_adjustment )  WRITE ( io, 453 )
-    ENDIF
-    IF ( rans_mode )  THEN
-       WRITE ( io, 457 )  rans_const_c, rans_const_sigma
-    ENDIF
+       IF ( e_min > 0.0 )  WRITE ( io, 454 )  e_min
+       IF ( wall_adjustment )  WRITE ( io, 453 )  wall_adjustment_factor
+       IF ( adjust_mixing_length  .AND.  prandtl_layer )  WRITE ( io, 452 )
+    ENDIF
+
 !
 !-- Special actions during the run
     WRITE ( io, 470 )
     IF ( create_disturbances )  THEN
-       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                                       &
-                          zu(disturbance_level_ind_b), disturbance_level_ind_b,                    &
+       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                   &
+                          zu(disturbance_level_ind_b), disturbance_level_ind_b,&
                           zu(disturbance_level_ind_t), disturbance_level_ind_t
-       IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
+       IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
           WRITE ( io, 472 )  inflow_disturbance_begin, inflow_disturbance_end
        ELSE
@@ -1552,21 +1122,74 @@
        WRITE ( io, 474 )  TRIM( random_generator )
     ENDIF
-    IF ( pt_surface_initial_change /= 0.0_wp )  THEN
+    IF ( pt_surface_initial_change /= 0.0 )  THEN
        WRITE ( io, 475 )  pt_surface_initial_change
     ENDIF
-    IF ( pt_surface_heating_rate /= 0.0_wp )  THEN
-       WRITE ( io, 476 )  pt_surface_heating_rate
-    ENDIF
-    IF ( humidity  .AND.  q_surface_initial_change /= 0.0_wp )  THEN
-       WRITE ( io, 477 )  q_surface_initial_change
-    ENDIF
-    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0_wp )  THEN
-       WRITE ( io, 478 )  q_surface_initial_change
-    ENDIF
+    IF ( moisture  .AND.  q_surface_initial_change /= 0.0 )  THEN
+       WRITE ( io, 476 )  q_surface_initial_change       
+    ENDIF
+    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0 )  THEN
+       WRITE ( io, 477 )  q_surface_initial_change       
+    ENDIF
+
+#if defined( __particles )
+!
+!-- Particle attributes
+    WRITE ( io, 480 )  particle_advection_start, dt_prel, bc_par_lr, &
+                       bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
+                       end_time_prel
+    IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
+    IF ( random_start_position )  WRITE ( io, 481 )
+    IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
+    WRITE ( io, 495 )  total_number_of_particles
+    IF ( .NOT. vertical_particle_advection )  WRITE ( io, 482 )
+    IF ( maximum_number_of_tailpoints /= 0 )  THEN
+       WRITE ( io, 483 )  maximum_number_of_tailpoints
+       IF ( minimum_tailpoint_distance /= 0 )  THEN
+          WRITE ( io, 484 )  total_number_of_tails, minimum_tailpoint_distance,&
+                             maximum_tailpoint_age
+       ENDIF
+    ENDIF
+    IF ( dt_write_particle_data /= 9999999.9 )  THEN
+       WRITE ( io, 485 )  dt_write_particle_data
+       output_format = ''
+       IF ( netcdf_output )  THEN
+          IF ( netcdf_64bit )  THEN
+             output_format = 'netcdf (64 bit offset) and binary'
+          ELSE
+             output_format = 'netcdf and binary'
+          ENDIF
+       ELSE
+          output_format = 'binary'
+       ENDIF
+       WRITE ( io, 345 )  output_format
+    ENDIF
+    IF ( dt_dopts /= 9999999.9 )  WRITE ( io, 494 )  dt_dopts
+    IF ( write_particle_statistics )  WRITE ( io, 486 )
+
+    WRITE ( io, 487 )  number_of_particle_groups
+
+    DO  i = 1, number_of_particle_groups
+       IF ( i == 1  .AND.  density_ratio(i) == 9999999.9 )  THEN
+          WRITE ( io, 490 )  i, 0.0
+          WRITE ( io, 492 )
+       ELSE
+          WRITE ( io, 490 )  i, radius(i)
+          IF ( density_ratio(i) /= 0.0 )  THEN
+             WRITE ( io, 491 )  density_ratio(i)
+          ELSE
+             WRITE ( io, 492 )
+          ENDIF
+       ENDIF
+       WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
+                          pdx(i), pdy(i), pdz(i)
+    ENDDO
+
+#endif
 
 !
 !-- Parameters of 1D-model
     IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
-       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, mixing_length_1d, dissipation_1d
+       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, &
+                          mixing_length_1d, dissipation_1d
        IF ( damp_level_ind_1d /= nzt+1 )  THEN
           WRITE ( io, 502 )  zu(damp_level_ind_1d), damp_level_ind_1d
@@ -1575,13 +1198,16 @@
 
 !
-!-- Header information from other modules
-    CALL module_interface_header( io )
-
+!-- User-defined informations
+    CALL user_header( io )
 
     WRITE ( io, 99 )
 
+#if defined( __ibm )
 !
 !-- Write buffer contents to disc immediately
-    FLUSH( io )
+    CALL FLUSH_( io )
+#elif defined( __lcmuk )  ||  defined( __nec )
+    CALL FLUSH( io )
+#endif
 
 !
@@ -1589,329 +1215,326 @@
 
  99 FORMAT (1X,78('-'))
-100 FORMAT (/1X,'******************************',4X,44('-')/                                       &
-            1X,'* ',A,' *',4X,A/                                                                   &
-            1X,'******************************',4X,44('-'))
-101 FORMAT (35X,'coupled run: ',A/                                                                 &
-            35X,42('-'))
-102 FORMAT (/' Date:               ',A10,4X,'Run:       ',A34/                                     &
-            ' Time:                 ',A8,4X,'Run-No.:   ',I2.2/                                    &
-            ' Run on host:        ',A10)
+100 FORMAT (/10X,'****************',11X,28('-')/                &
+            10X,'*  ',A12,'*',11X,A/                            &
+            10X,'****************',11X,28('-')//                &
+            ' Date:            ',A8,11X,'Run:       ',A20/      &
+            ' Time:            ',A8,11X,'Run-No.:   ',I2.2/     &
+            ' Run on host:   ',A10)
 #if defined( __parallel )
-103 FORMAT (' Number of PEs:',10X,I6,4X,'Processor grid (x,y): (',I4,',',I4,')',1X,A)
-104 FORMAT (' Number of PEs:',10X,I6,4X,'Tasks:',I4,'   threads per task:',I4/                     &
-              35X,'Processor grid (x,y): (',I4,',',I4,')',1X,A)
-107 FORMAT (35X,'A 1d-decomposition along ',A,' is used')
-108 FORMAT (35X,'Max. # of parallel I/O streams is ',I5)
-109 FORMAT (35X,'Precursor run for coupled atmos-ocean run'/                                       &
-            35X,42('-'))
-114 FORMAT (35X,'Coupled atmosphere-ocean run following'/                                          &
-            35X,'independent precursor runs'/                                                      &
-            35X,42('-'))
+101 FORMAT (' Number of PEs:',7X,I4,11X,'Processor grid (x,y): (',I3,',',I3, &
+              ')',1X,A)
+102 FORMAT (' Number of PEs:',7X,I4,11X,'Tasks:',I4,'   threads per task:',I4/ &
+              37X,'Processor grid (x,y): (',I3,',',I3,')',1X,A)
+103 FORMAT (37X,'One additional PE is used to handle'/37X,'the dvrp output!')
+104 FORMAT (37X,'A 1d-decomposition along x is forced'/ &
+            37X,'because the job is running on an SMP-cluster')
+105 FORMAT (37X,'A 1d-decomposition along ',A,' is used')
 #endif
-110 FORMAT (/' Numerical Schemes:'/                                                                &
+110 FORMAT (/' Numerical Schemes:'/ &
              ' -----------------'/)
-124 FORMAT (' --> Use the ',A,' turbulence closure (',A,' mode).')
-121 FORMAT (' --> Use the ',A,' approximation for the model equations.')
 111 FORMAT (' --> Solve perturbation pressure via FFT using ',A,' routines')
-112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/                           &
-            '     Iterations (initial/other): ',I3,'/',I3,'  omega =',F6.3)
-113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)',' or Upstream')
-115 FORMAT ('     FFT and transpositions are overlapping')
-116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)',' or Upstream')
+112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/ &
+            '     Iterations (initial/other): ',I3,'/',I3,'  omega = ',F5.3)
+113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)', &
+                  ' or Upstream')
+114 FORMAT (' --> Momentum advection via Upstream-Spline-Scheme')
+115 FORMAT ('     Tendencies are smoothed via Long-Filter with factor ',F5.3) 
+116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)', &
+                  ' or Upstream')
+117 FORMAT (' --> Scalar advection via Upstream-Spline-Scheme')
 118 FORMAT (' --> Scalar advection via Bott-Chlond-Scheme')
-119 FORMAT (' --> Galilei-Transform applied to horizontal advection:'/                             &
-            '     translation velocity = ',A/                                                      &
+119 FORMAT (' --> Galilei-Transform applied to horizontal advection', &
+            '     Translation velocity = ',A/ &
             '     distance advected ',A,':  ',F8.3,' km(x)  ',F8.3,' km(y)')
+120 FORMAT (' --> Time differencing scheme: leapfrog only (no euler in case', &
+                  ' of timestep changes)')
+121 FORMAT (' --> Time differencing scheme: leapfrog + euler in case of', &
+                  ' timestep changes')
 122 FORMAT (' --> Time differencing scheme: ',A)
-123 FORMAT (' --> Rayleigh-Damping active, starts ',A,' z = ',F8.2,' m'/                           &
-            '     maximum damping coefficient:',F6.3, ' 1/s')
+123 FORMAT (' --> Rayleigh-Damping active, starts above z = ',F8.2,' m'/ &
+            '     maximum damping coefficient: ',F5.3, ' 1/s')
+124 FORMAT ('     Spline-overshoots are being suppressed')
+125 FORMAT ('     Upstream-Scheme is used if Upstream-differences fall short', &
+                  ' of'/                                                       &
+            '     delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
+126 FORMAT ('     Upstream-Scheme is used if Upstream-differences fall short', &
+                  ' of'/                                                       &
+            '     delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
+127 FORMAT ('     The following absolute overshoot differences are tolerated:'/&
+            '     delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
+128 FORMAT ('     The following absolute overshoot differences are tolerated:'/&
+            '     delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
 129 FORMAT (' --> Additional prognostic equation for the specific humidity')
 130 FORMAT (' --> Additional prognostic equation for the total water content')
-131 FORMAT (' --> No pt-equation solved. Neutral stratification with pt = ',F6.2,' K assumed')
+131 FORMAT (' --> Parameterization of condensation processes via (0%-or100%)')
+132 FORMAT (' --> Parameterization of long-wave radiation processes via'/ &
+            '     effective emissivity scheme')
+133 FORMAT (' --> Precipitation parameterization via Kessler-Scheme')
 134 FORMAT (' --> Additional prognostic equation for a passive scalar')
-135 FORMAT (' --> Solve perturbation pressure via ',A,' method (',A,'-cycle)'/                     &
-            '     number of grid levels:                   ',I2/                                   &
+135 FORMAT (' --> Solve perturbation pressure via multigrid method (', &
+                  A,'-cycle)'/ &
+            '     number of grid levels:                   ',I2/ &
             '     Gauss-Seidel red/black iterations:       ',I2)
-136 FORMAT ('     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', I3,')')
-137 FORMAT ('     level data gathered on PE0 at level:     ',I2/                                   &
-            '     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', I3,')'/              &
-            '     gridpoints of coarsest domain (x,y,z):    (',I3,',',I3,',', I3,')')
-139 FORMAT (' --> Loop optimization method: ',A)
+136 FORMAT ('     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
+                  I3,')')
+137 FORMAT ('     level data gathered on PE0 at level:     ',I2/ &
+            '     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
+                  I3,')'/ &
+            '     gridpoints of coarsest domain (x,y,z):    (',I3,',',I3,',', &
+                  I3,')')
+138 FORMAT ('     Using hybrid version for 1d-domain-decomposition')
+139 FORMAT (' --> Prognostic equations are solved in one single loop (fast', &
+                  ' method)')
 140 FORMAT ('     maximum residual allowed:                ',E10.3)
 141 FORMAT ('     fixed number of multigrid cycles:        ',I4)
-142 FORMAT ('     perturbation pressure is calculated at every Runge-Kutta ','step')
-143 FORMAT ('     Euler/upstream scheme is used for the SGS turbulent ','kinetic energy')
-144 FORMAT ('     masking method is used')
-150 FORMAT (' --> Volume flow at the right and north boundary will be ','conserved'/               &
-            '     using the ',A,' mode')
-151 FORMAT ('     with u_bulk = ',F7.3,' m/s and v_bulk = ',F7.3,' m/s')
-152 FORMAT (' --> External pressure gradient directly prescribed by the user:',                    &
-           /'     ',2(1X,E12.5),'Pa/m in x/y direction',                                           &
-           /'     starting from dp_level_b =',F8.3,'m',A/)
-200 FORMAT (//' Run time and time step information:'/                                              &
-            ' ----------------------------------'/)
-201 FORMAT (' Timestep:             variable     maximum value: ',F6.3,' s',                       &
-            '    CFL-factor:',F5.2)
-202 FORMAT (' Timestep:          dt = ',F6.3,' s'/)
-203 FORMAT (' Start time:        ',F11.3,' s'/                                                     &
-             ' End time:          ',F11.3,' s')
-204 FORMAT (A,F11.3,' s')
-205 FORMAT (A,F11.3,' s',5X,'restart every',17X,F11.3,' s')
-206 FORMAT (/' Time reached:      ',F11.3,' s'/                                                    &
-             ' CPU-time used:       ',F9.3,' s     per timestep:                 ',F9.3,' s'/      &
-             '                                      per second of simulated time: ',F9.3,' s')
-207 FORMAT (' Spinup time:       ',F11.3,' s')
-250 FORMAT (//' Computational grid and domain size:'/                                              &
-              ' ----------------------------------'//                                              &
-              ' Grid length:      dx =    ',F8.3,' m    dy =    ',F8.3,' m')
-251 FORMAT (/' Domain size:       x = ',F10.3,' m     y = ',F10.3,' m  z(u) = ',F10.3,' m'/)
-253 FORMAT ('                dz(',I1,') =    ', F8.3, ' m')
-254 FORMAT (//' Number of gridpoints (x,y,z):  (0:',I4,', 0:',I4,', 0:',I4,')'/                    &
+142 FORMAT ('     perturbation pressure is calculated at every Runge-Kutta ', &
+                  'step')
+150 FORMAT (' --> Volume flow at the right and north boundary will be ', &
+                  'conserved')
+200 FORMAT (//' Run time and time step information:'/ &
+             ' ----------------------------------'/)
+201 FORMAT ( ' Timestep:          variable     maximum value: ',F6.3,' s', &
+             '    CFL-factor: ',F4.2)
+202 FORMAT ( ' Timestep:       dt = ',F6.3,' s'/)
+203 FORMAT ( ' Start time:       ',F9.3,' s'/ &
+             ' End time:         ',F9.3,' s')
+204 FORMAT ( A,F9.3,' s')
+205 FORMAT ( A,F9.3,' s',5X,'restart every',17X,F9.3,' s')
+206 FORMAT (/' Time reached:     ',F9.3,' s'/ &
+             ' CPU-time used:    ',F9.3,' s     per timestep:               ', &
+               '  ',F9.3,' s'/                                                 &
+             '                                   per second of simulated tim', &
+               'e: ',F9.3,' s')
+250 FORMAT (//' Computational grid and domain size:'/ &
+              ' ----------------------------------'// &
+              ' Grid length:      dx =    ',F7.3,' m    dy =    ',F7.3, &
+              ' m    dz =    ',F7.3,' m'/ &
+              ' Domain size:       x = ',F10.3,' m     y = ',F10.3, &
+              ' m  z(u) = ',F10.3,' m'/)
+252 FORMAT (' dz constant up to ',F10.3,' m (k=',I4,'), then stretched by', &
+              ' factor: ',F5.3/ &
+            ' maximum dz not to be exceeded is dz_max = ',F10.3,' m'/)
+254 FORMAT (' Number of gridpoints (x,y,z):  (0:',I4,', 0:',I4,', 0:',I4,')'/ &
             ' Subdomain size (x,y,z):        (  ',I4,',   ',I4,',   ',I4,')'/)
-260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,' degrees')
-270 FORMAT (//' Topography information:'/                                                          &
-              ' ----------------------'//                                                          &
+255 FORMAT (' Subdomains have equal size')
+256 FORMAT (' Subdomains at the upper edges of the virtual processor grid ', &
+              'have smaller sizes'/                                          &
+            ' Size of smallest subdomain:    (  ',I4,',   ',I4,',   ',I4,')')
+260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,&
+             ' degrees')
+270 FORMAT (//' Topography informations:'/ &
+              ' -----------------------'// &
               1X,'Topography: ',A)
-271 FORMAT (' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/                            &
-            ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4,' / ',I4)
-272 FORMAT (' Single quasi-2D street canyon of infinite length in ',A,' direction' /               &
-            ' Canyon height: ', F6.2, 'm, ch = ', I4, '.'      /                                   &
-            ' Canyon position (',A,'-walls): cxl = ', I4,', cxr = ', I4, '.')
-273 FORMAT (' Tunnel of infinite length in ',A,                                                    &
-            ' direction' /                                                                         &
-            ' Tunnel height: ', F6.2, /                                                            &
-            ' Tunnel-wall depth: ', F6.2      /                                                    &
-            ' Tunnel width: ', F6.2 )
-274 FORMAT (' Tunnel in ', A, ' direction.' /                                                      &
-            ' Tunnel height: ', F6.2, /                                                            &
-            ' Tunnel-wall depth: ', F6.2      /                                                    &
-            ' Tunnel width: ', F6.2, /                                                             &
-            ' Tunnel length: ', F6.2 )
-278 FORMAT (' Topography grid definition convention:'/                                             &
-            ' cell edge (staggered grid points'/                                                   &
-            ' (u in x-direction, v in y-direction))' /)
-279 FORMAT (' Topography grid definition convention:'/                                             &
-            ' cell center (scalar grid points)' /)
-280 FORMAT (' Complex terrain simulation is activated.')
-281 FORMAT ('    --> Mean inflow profiles are adjusted.' /                                         &
-            '    --> Elevation of inflow boundary: ', F7.1, ' m' )
-282 FORMAT ('    --> Initial data from 3D-precursor run is shifted' /                              &
-            '        vertically depending on local surface height.')
-300 FORMAT (//' Boundary conditions:'/                                                             &
-             ' -------------------'//                                                              &
-             '                     p                    uv             ',                          &
-             '                     pt'//                                                           &
-             ' B. bound.: ',A/                                                                     &
+271 FORMAT (  ' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/ &
+              ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4, &
+                ' / ',I4)
+300 FORMAT (//' Boundary conditions:'/ &
+             ' -------------------'// &
+             '                     p                    uv             ', &
+             '                   pt'// &
+             ' B. bound.: ',A/ &
              ' T. bound.: ',A)
-301 FORMAT (/'                     ',A//                                                           &
-             ' B. bound.: ',A/                                                                     &
+301 FORMAT (/'                     e'// &
+             ' B. bound.: ',A/ &
              ' T. bound.: ',A)
-303 FORMAT (/' Bottom surface fluxes are used in diffusion terms at k=1')
-304 FORMAT (/' Top surface fluxes are used in diffusion terms at k=nzt')
-305 FORMAT (//'    Constant flux layer between bottom surface and first ',                         &
-              'computational u,v-level:'//                                                         &
-             '       z_mo = ',F6.2,' m   z0 =',F7.4,' m   z0h =',F8.5,' m   kappa =',F5.2/         &
-             '       zeta value range:   ',F8.2,' <= zeta <=',F6.2)
-306 FORMAT ('       Predefined constant heatflux:   ',F9.6,' K m/s')
+302 FORMAT (/'                     q'// &
+             ' B. bound.: ',A/ &
+             ' T. bound.: ',A)
+303 FORMAT (/' Surface fluxes are used in diffusion terms at k=1')
+305 FORMAT (//'    Prandtl-Layer between surface and first computational ', &
+               'u,v-level:'// &
+             '       zp = ',F6.2,' m   z0 = ',F6.4,' m   kappa = ',F4.2/ &
+             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
+306 FORMAT ('       Predefined constant heatflux:   ',F6.3,' K m/s')
 307 FORMAT ('       Heatflux has a random normal distribution')
 308 FORMAT ('       Predefined surface temperature')
-309 FORMAT ('       Predefined constant salinityflux:   ',F9.6,' psu m/s')
-310 FORMAT (//'    1D-Model:'//                                                                    &
-             '       Ri value range:   ',F6.2,' <= Ri <=',F6.2)
-311 FORMAT ('       Predefined constant humidity flux: ',E10.3,' kg/kg m/s')
+310 FORMAT (//'    1D-Model:'// &
+             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
+311 FORMAT ('       Predefined constant humidity flux: ',E10.3,' m/s')
 312 FORMAT ('       Predefined surface humidity')
 313 FORMAT ('       Predefined constant scalar flux: ',E10.3,' kg/(m**2 s)')
 314 FORMAT ('       Predefined scalar value at the surface')
-302 FORMAT ('       Predefined constant scalarflux:   ',F9.6,' kg/(m**2 s)')
-315 FORMAT ('       Humidity flux at top surface is 0.0')
-316 FORMAT ('       Sensible heatflux and momentum flux from coupled ', 'atmosphere model')
-317 FORMAT (//' Lateral boundaries:'/                                                              &
-            '       left/right:  ',A/                                                              &
+317 FORMAT (//' Lateral boundaries:'/ &
+            '       left/right:  ',A/    &
             '       north/south: ',A)
-318 FORMAT (/'       pt damping layer width = ',F8.2,' m, pt ','damping factor =',F7.4)
-319 FORMAT ('       turbulence recycling at inflow switched on'/                                   &
-            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/                      &
-            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m')
-320 FORMAT ('       Predefined constant momentumflux:  u: ',F9.6,' m**2/s**2'/                     &
-            '                                          v: ',F9.6,' m**2/s**2')
-321 FORMAT (//' Initial profiles:'/                                                                &
-              ' ----------------')
-322 FORMAT ('       turbulence recycling at inflow switched on'/                                   &
-            '       y-shift of the recycled inflow turbulence is',I3,' PE'/                        &
-            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/                      &
-            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m'/)
-323 FORMAT ('       turbulent outflow conditon switched on'/                                       &
-            '       position of outflow source plane: ',F7.1,' m   ','grid index: ', I4)
-325 FORMAT (//' List output:'/                                                                     &
-             ' -----------'//                                                                      &
-            '    1D-Profiles:'/                                                                    &
-            '       Output every             ',F10.2,' s')
-326 FORMAT ('       Time averaged over       ',F8.2,' s'/                                          &
+318 FORMAT (/'       outflow damping layer width: ',I3,' gridpoints with km_', &
+                    'max =',F5.1,' m**2/s')
+320 FORMAT (//' List output:'/ &
+             ' -----------'//  &
+            '    1D-Profiles:'/    &
+            '       Output every             ',F8.2,' s')
+321 FORMAT ('       Time averaged over       ',F8.2,' s'/ &
             '       Averaging input every    ',F8.2,' s')
-330 FORMAT (//' Data output:'/                                                                     &
+330 FORMAT (//' Data output:'/ &
              ' -----------'/)
 331 FORMAT (/'    1D-Profiles:')
 332 FORMAT (/'       ',A)
-333 FORMAT ('       Output every             ',F8.2,' s',/                                         &
-            '       Time averaged over       ',F8.2,' s'/                                          &
+333 FORMAT ('       Output every             ',F8.2,' s',/ &
+            '       Time averaged over       ',F8.2,' s'/ &
             '       Averaging input every    ',F8.2,' s')
 334 FORMAT (/'    2D-Arrays',A,':')
-335 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/                                            &
-            '       Output every             ',F8.2,' s  ',A/                                      &
-            '       Cross sections at ',A1,' = ',A/                                                &
+335 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
+            '       Output every             ',F8.2,' s  ',A/ &
+            '       Cross sections at ',A1,' = ',A/ &
             '       scalar-coordinates:   ',A,' m'/)
 336 FORMAT (/'    3D-Arrays',A,':')
 337 FORMAT (/'       Arrays: ',A/ &
-            '       Output every             ',F8.2,' s  ',A/                                      &
+            '       Output every             ',F8.2,' s  ',A/ &
             '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
+338 FORMAT ('       Compressed data output'/ &
+            '       Decimal precision: ',A/)
 339 FORMAT ('       No output during initial ',F8.2,' s')
 340 FORMAT (/'    Time series:')
 341 FORMAT ('       Output every             ',F8.2,' s'/)
-342 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/                                            &
-            '       Output every             ',F8.2,' s  ',A/                                      &
-            '       Time averaged over       ',F8.2,' s'/                                          &
-            '       Averaging input every    ',F8.2,' s'/                                          &
-            '       Cross sections at ',A1,' = ',A/                                                &
+342 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
+            '       Output every             ',F8.2,' s  ',A/ &
+            '       Time averaged over       ',F8.2,' s'/ &
+            '       Averaging input every    ',F8.2,' s'/ &
+            '       Cross sections at ',A1,' = ',A/ &
             '       scalar-coordinates:   ',A,' m'/)
-343 FORMAT (/'       Arrays: ',A/                                                                  &
-            '       Output every             ',F8.2,' s  ',A/                                      &
-            '       Time averaged over       ',F8.2,' s'/                                          &
-            '       Averaging input every    ',F8.2,' s'/                                          &
+343 FORMAT (/'       Arrays: ',A/ &
+            '       Output every             ',F8.2,' s  ',A/ &
+            '       Time averaged over       ',F8.2,' s'/ &
+            '       Averaging input every    ',F8.2,' s'/ &
             '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
-344 FORMAT ('       Output format: ',A/)
-345 FORMAT (/'    Scaling lengths for output locations of all subsequent mask IDs:',/              &
-            '       mask_scale_x (in x-direction): ',F9.3, ' m',/                                  &
-            '       mask_scale_y (in y-direction): ',F9.3, ' m',/                                  &
-            '       mask_scale_z (in z-direction): ',F9.3, ' m' )
-346 FORMAT (/'    Masked data output',A,' for mask ID ',I2, ':')
-347 FORMAT ('       Variables: ',A/                                                                &
-            '       Output every             ',F8.2,' s')
-348 FORMAT ('       Variables: ',A/ &
-            '       Output every             ',F8.2,' s'/                                          &
-            '       Time averaged over       ',F8.2,' s'/                                          &
-            '       Averaging input every    ',F8.2,' s')
-349 FORMAT (/'       Output locations in ',A,'-direction in multiples of ',                        &
-            'mask_scale_',A,' predefined by array mask_',I2.2,'_',A,':'/                           &
-            13('       ',8(F8.2,',')/) )
-350 FORMAT (/'       Output locations in ',A,'-direction: ',                                       &
-            'all gridpoints along ',A,'-direction (default).' )
-351 FORMAT (/'       Output locations in ',A,'-direction in multiples of ',                        &
-            'mask_scale_',A,' constructed from array mask_',I2.2,'_',A,'_loop:'/                   &
-            '          loop begin:',F8.2,', end:',F8.2,', stride:',F8.2 )
-352 FORMAT (/'       Number of output time levels allowed: ',I3 /)
-353 FORMAT (/'       Number of output time levels allowed: unlimited'/)
-354 FORMAT ('       Output format: ',A, '   compressed with level: ',I1/)
-355 FORMAT (/'    Restart data format(s):')
-356 FORMAT ('    Input format:  ',A)
-357 FORMAT ('    Output format: ',A)
-400 FORMAT (//' Physical quantities:'/                                                             &
+345 FORMAT ('       Output format: ',A/)
+#if defined( __dvrp_graphics )
+360 FORMAT ('    Plot-Sequence with dvrp-software:'/ &
+            '       Output every      ',F7.1,' s'/ &
+            '       Output mode:      ',A/ &
+            '       Host / User:      ',A,' / ',A/ &
+            '       Directory:        ',A// &
+            '       The sequence contains:')
+361 FORMAT ('       Isosurface of ',A,'  Threshold value: ', E12.3)
+362 FORMAT ('       Sectional plane ',A)
+363 FORMAT ('       Particles')
+#endif
+#if defined( __spectra )
+370 FORMAT ('    Spectra:')
+371 FORMAT ('       Output every ',F7.1,' s'/)
+372 FORMAT ('       Arrays:     ', 10(A5,',')/                         &
+            '       Directions: ', 10(A5,',')/                         &
+            '       height levels  k = ', 9(I3,','),I3,'.'/            &
+            '       height levels selected for standard plot:'/        &
+            '                      k = ', 9(I3,','),I3,'.'/            &
+            '       Time averaged over ', F7.1, ' s,' /                &
+            '       Profiles for the time averaging are taken every ', &
+                    F6.1,' s')
+#endif
+400 FORMAT (//' Physical quantities:'/ &
               ' -------------------'/)
-410 FORMAT ('    Geograph. latitude  :   latitude  = ',F5.1,' degr'/                               &
-            '    Geograph. longitude :   longitude = ',F5.1,' degr'/                               &
-            '    Rotation angle      :   rotation_angle = ',F5.1,' degr'/                          &
-            '    Angular velocity    :   omega  =',E10.3,' rad/s'/                                 &
-            '    Coriolis parameter  :   f      = ',F9.6,' 1/s'/                                   &
-            '                            f*     = ',F9.6,' 1/s')
-411 FORMAT (/'    Gravity             :   g      = ',F4.1,' m/s**2')
-412 FORMAT (/'    Reference state used in buoyancy terms: ',A)
-413 FORMAT ('       Reference density in buoyancy terms: ',F8.3,' kg/m**3')
-414 FORMAT ('       Reference temperature in buoyancy terms: ',F8.4,' K')
-420 FORMAT (/'    Characteristic levels of the initial temperature profile:'//                     &
-            '       Height:        ',A,'  m'/                                                      &
-            '       Temperature:   ',A,'  K'/                                                      &
-            '       Gradient:      ',A,'  K/100m'/                                                 &
+410 FORMAT ('    Angular velocity    :   omega = ',E9.3,' rad/s'/  &
+            '    Geograph. latitude  :   phi   = ',F4.1,' degr'/   &
+            '    Coriolis parameter  :   f     = ',F9.6,' 1/s'/    &
+            '                            f*    = ',F9.6,' 1/s')
+411 FORMAT (/'    Gravity             :   g     = ',F4.1,' m/s**2')
+412 FORMAT (/'    Cloud physics parameters:'/ &
+             '    ------------------------'/)
+413 FORMAT ('        Surface pressure   :   p_0   = ',F7.2,' hPa'/      &
+            '        Gas constant       :   R     = ',F5.1,' J/(kg K)'/ &
+            '        Density of air     :   rho_0 = ',F5.3,' kg/m**3'/  &
+            '        Specific heat cap. :   c_p   = ',F6.1,' J/(kg K)'/ &
+            '        Vapourization heat :   L_v   = ',E8.2,' J/kg')
+420 FORMAT (/'    Characteristic levels of the initial temperature profile:'// &
+            '       Height:        ',A,'  m'/ &
+            '       Temperature:   ',A,'  K'/ &
+            '       Gradient:      ',A,'  K/100m'/ &
             '       Gridpoint:     ',A)
-421 FORMAT (/'    Characteristic levels of the initial humidity profile:'//                        &
-            '       Height:      ',A,'  m'/                                                        &
-            '       Humidity:    ',A,'  kg/kg'/                                                    &
-            '       Gradient:    ',A,'  (kg/kg)/100m'/                                             &
+421 FORMAT (/'    Characteristic levels of the initial humidity profile:'// &
+            '       Height:      ',A,'  m'/ &
+            '       Humidity:    ',A,'  kg/kg'/ &
+            '       Gradient:    ',A,'  (kg/kg)/100m'/ &
             '       Gridpoint:   ',A)
-422 FORMAT (/'    Characteristic levels of the initial scalar profile:'//                          &
-            '       Height:                  ',A,'  m'/                                            &
-            '       Scalar concentration:    ',A,'  kg/m**3'/                                      &
-            '       Gradient:                ',A,'  (kg/m**3)/100m'/                               &
+422 FORMAT (/'    Characteristic levels of the initial scalar profile:'// &
+            '       Height:                  ',A,'  m'/ &
+            '       Scalar concentration:    ',A,'  kg/m**3'/ &
+            '       Gradient:                ',A,'  (kg/m**3)/100m'/ &
             '       Gridpoint:               ',A)
-423 FORMAT (/'    Characteristic levels of the geo. wind component ug:'//                          &
-            '       Height:      ',A,'  m'/                                                        &
-            '       ug:          ',A,'  m/s'/                                                      &
-            '       Gradient:    ',A,'  1/100s'/                                                   &
+423 FORMAT (/'    Characteristic levels of the geo. wind component ug:'// &
+            '       Height:      ',A,'  m'/ &
+            '       ug:          ',A,'  m/s'/ &
+            '       Gradient:    ',A,'  1/100s'/ &
             '       Gridpoint:   ',A)
-424 FORMAT (/'    Characteristic levels of the geo. wind component vg:'//                          &
-            '       Height:      ',A,'  m'/                                                        &
-            '       vg:          ',A,'  m/s'/                                                      &
-            '       Gradient:    ',A,'  1/100s'/                                                   &
+424 FORMAT (/'    Characteristic levels of the geo. wind component vg:'// &
+            '       Height:      ',A,'  m'/ &
+            '       vg:          ',A,'  m/S'/ &
+            '       Gradient:    ',A,'  1/100s'/ &
             '       Gridpoint:   ',A)
-425 FORMAT (/'    Characteristic levels of the initial salinity profile:'//                        &
-            '       Height:     ',A,'  m'/                                                         &
-            '       Salinity:   ',A,'  psu'/                                                       &
-            '       Gradient:   ',A,'  psu/100m'/                                                  &
-            '       Gridpoint:  ',A)
-426 FORMAT (/'    Characteristic levels of the subsidence/ascent profile:'//                       &
-            '       Height:      ',A,'  m'/                                                        &
-            '       w_subs:      ',A,'  m/s'/                                                      &
-            '       Gradient:    ',A,'  (m/s)/100m'/                                               &
-            '       Gridpoint:   ',A)
-427 FORMAT (/'    Initial wind profiles (u,v) are interpolated from given'//                       &
-                  ' profiles')
-428 FORMAT (/'    Initial profiles (u, v, pt, q) are taken from file '/                            &
-             '    NUDGING_DATA')
-430 FORMAT (//' Cloud physics quantities / methods:'/                                              &
-              ' ----------------------------------'/)
-431 FORMAT ('    Humidity is considered, bu no condensation')
-450 FORMAT (//' LES / Turbulence quantities:'/                                                     &
+450 FORMAT (//' LES / Turbulence quantities:'/ &
               ' ---------------------------'/)
-451 FORMAT ('    Diffusion coefficients are constant:'/                                            &
-            '    Km = ',F6.2,' m**2/s   Kh = ',F6.2,' m**2/s   Pr = ',F5.2)
-453 FORMAT ('    Mixing length is limited close to surfaces')
-454 FORMAT ('    TKE is not allowed to fall below ',E9.2,' (m/s)**2')
-455 FORMAT ('    initial TKE is prescribed as ',E9.2,' (m/s)**2')
-456 FORMAT (/'    Date and time at model start : ',A)
-457 FORMAT ('    RANS-mode constants: c_0 = ',F9.5/                                                &
-            '                         c_1 = ',F9.5/                                                &
-            '                         c_2 = ',F9.5/                                                &
-            '                         c_3 = ',F9.5/                                                &
-            '                         c_4 = ',F9.5/                                                &
-            '                         sigma_e    = ',F9.5/                                         &
-            '                         sigma_diss = ',F9.5)
-470 FORMAT (//' Actions during the simulation:'/                                                   &
+451 FORMAT ('   Diffusion coefficients are constant:'/ &
+            '   Km = ',F6.2,' m**2/s   Kh = ',F6.2,' m**2/s   Pr = ',F5.2)
+452 FORMAT ('   Mixing length is limited to the Prandtl mixing lenth.')
+453 FORMAT ('   Mixing length is limited to ',F4.2,' * z')
+454 FORMAT ('   TKE is not allowed to fall below ',E9.2,' (m/s)**2')
+470 FORMAT (//' Actions during the simulation:'/ &
               ' -----------------------------'/)
-471 FORMAT ('    Disturbance impulse (u,v) every :   ',F6.2,' s'/                                  &
-            '    Disturbance amplitude           :    ',F5.2, ' m/s'/                              &
-            '    Lower disturbance level         : ',F8.2,' m (GP ',I4,')'/                        &
-            '    Upper disturbance level         : ',F8.2,' m (GP ',I4,')')
-472 FORMAT ('    Disturbances continued during the run from i/j =',I4,' to i/j =',I4)
-473 FORMAT ('    Disturbances cease as soon as the disturbance energy exceeds',F6.3, ' m**2/s**2')
+471 FORMAT ('    Disturbance impulse (u,v) every :  ',F6.2,' s'/             &
+            '    Disturbance amplitude           :    ',F4.2, ' m/s'/        &
+            '    Lower disturbance level         : ',F7.2,' m (GP ',I4,')'/  &
+            '    Upper disturbance level         : ',F7.2,' m (GP ',I4,')')
+472 FORMAT ('    Disturbances continued during the run from i/j =',I4, &
+                 ' to i/j =',I4)
+473 FORMAT ('    Disturbances cease as soon as the disturbance energy exceeds',&
+                 1X,F5.3, ' m**2/s**2')
 474 FORMAT ('    Random number generator used    : ',A/)
-475 FORMAT ('    The surface temperature is increased (or decreased, ','respectively, if'/         &
-            '    the value is negative) by ',F5.2,' K at the beginning of the',' 3D-simulation'/)
-476 FORMAT ('    The surface temperature increases (or decreases, ','respectively, if'/            &
-            '    the value is negative) by ',F8.4,' K/h during the',' 3D-simulation'/)
-477 FORMAT ('    The surface humidity is increased (or decreased, ','respectively, if the'/        &
-            '    value is negative) by ',E8.1,' kg/kg at the beginning of',' the 3D-simulation'/)
-478 FORMAT ('    The scalar value is increased at the surface (or decreased, ',                    &
-                 'respectively, if the'/                                                           &
-            '    value is negative) by ',E8.1,' kg/m**3 at the beginning of',' the 3D-simulation'/)
-500 FORMAT (//' 1D-Model parameters:'/                                                             &
-              ' -------------------'//                                                             &
-            '    Simulation time:                   ',F8.1,' s'/                                   &
-            '    Run-controll output every:         ',F8.1,' s'/                                   &
-            '    Vertical profile output every:     ',F8.1,' s'/                                   &
-            '    Mixing length calculation:         ',A/                                           &
+475 FORMAT ('    The surface temperature is increased (or decreased, ', &
+                 'respectively, if'/ &
+            '    the value is negative) by ',F5.2,' K at the beginning of the',&
+                 ' 3D-simulation'/)
+476 FORMAT ('    The surface humidity is increased (or decreased, ',&
+                 'respectively, if the'/ &
+            '    value is negative) by ',E8.1,' kg/kg at the beginning of', &
+                 ' the 3D-simulation'/)
+477 FORMAT ('    The scalar value is increased at the surface (or decreased, ',&
+                 'respectively, if the'/ &
+            '    value is negative) by ',E8.1,' kg/m**3 at the beginning of', &
+                 ' the 3D-simulation'/)
+#if defined( __particles )
+480 FORMAT ('    Particles:'/ &
+            '    ---------'// &
+            '       Particle advection is active (switched on at t = ', F7.1, &
+                    ' s)'/ &
+            '       Start of new particle generations every  ',F6.1,' s'/ &
+            '       Boundary conditions: left/right: ', A, ' north/south: ', A/&
+            '                            bottom:     ', A, ' top:         ', A/&
+            '       Maximum particle age:                 ',F9.1,' s'/ &
+            '       Advection stopped at t = ',F9.1,' s'/)
+481 FORMAT ('       Particles have random start positions'/)
+482 FORMAT ('       Particles are advected only horizontally'/)
+483 FORMAT ('       Particles have tails with a maximum of ',I3,' points')
+484 FORMAT ('            Number of tails of the total domain: ',I10/ &
+            '            Minimum distance between tailpoints: ',F8.2,' m'/ &
+            '            Maximum age of the end of the tail:  ',F8.2,' s')
+485 FORMAT ('       Particle data are written on file every ', F9.1, ' s')
+486 FORMAT ('       Particle statistics are written on file'/)
+487 FORMAT ('       Number of particle groups: ',I2/)
+488 FORMAT ('       SGS velocity components are used for particle advection'/ &
+            '          minimum timestep for advection: ', F7.5/)
+489 FORMAT ('       Number of particles simultaneously released at each ', &
+                    'point: ', I5/)
+490 FORMAT ('       Particle group ',I2,':'/ &
+            '          Particle radius: ',E10.3, 'm')
+491 FORMAT ('          Particle inertia is activated'/ &
+            '             density_ratio (rho_fluid/rho_particle) = ',F5.3/)
+492 FORMAT ('          Particles are advected only passively (no inertia)'/)
+493 FORMAT ('          Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/&
+            '                                         y:',F8.1,' - ',F8.1,' m'/&
+            '                                         z:',F8.1,' - ',F8.1,' m'/&
+            '          Particle distances:  dx = ',F8.1,' m  dy = ',F8.1, &
+                       ' m  dz = ',F8.1,' m'/)
+494 FORMAT ('       Output of particle time series in NetCDF format every ', &
+                    F8.2,' s'/)
+495 FORMAT ('       Number of particles in total domain: ',I10/)
+#endif
+500 FORMAT (//' 1D-Model parameters:'/                           &
+              ' -------------------'//                           &
+            '    Simulation time:                   ',F8.1,' s'/ &
+            '    Run-controll output every:         ',F8.1,' s'/ &
+            '    Vertical profile output every:     ',F8.1,' s'/ &
+            '    Mixing length calculation:         ',A/         &
             '    Dissipation calculation:           ',A/)
 502 FORMAT ('    Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
-503 FORMAT (' --> Momentum advection via Wicker-Skamarock-Scheme 5th order')
-504 FORMAT (' --> Scalar advection via Wicker-Skamarock-Scheme 5th order')
-512 FORMAT (/' Date:               ',A10,6X,'Run:       ',A34/                                     &
-            ' Time:                 ',A8,6X,'Run-No.:   ',I2.2/                                    &
-            ' Run on host:        ',A10,6X,'En-No.:    ',I2.2)
-#if defined( __parallel )
-600 FORMAT (/' Nesting informations:'/                                                             &
-            ' --------------------'/                                                               &
-            ' Nesting mode:                     ',A/                                               &
-            ' Nesting-datatransfer mode:        ',A//                                              &
-            ' Nest id  parent  number   lower left coordinates   name'/                            &
-            ' (*=me)     id    of PEs      x (m)     y (m)')
-601 FORMAT (2X,A1,1X,I2.2,6X,I2.2,5X,I5,5X,F8.2,2X,F8.2,5X,A)
-#endif
+
 
  END SUBROUTINE header
Index: palm/trunk/SOURCE/impact_of_latent_heat.f90
===================================================================
--- palm/trunk/SOURCE/impact_of_latent_heat.f90	(revision 1)
+++ palm/trunk/SOURCE/impact_of_latent_heat.f90	(revision 1)
@@ -0,0 +1,112 @@
+ MODULE impact_of_latent_heat_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: impact_of_latent_heat.f90,v $
+! Revision 1.5  2004/01/30 10:25:59  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.4  2003/03/12 16:32:14  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.3  2002/06/11 13:10:06  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.2  2001/01/22 06:52:34  raasch
+! Module test_variables removed
+!
+! Revision 1.1  2000/04/13 14:48:40  schroeter
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Calculate the impact of latent heat due to precipitation
+! (simplified Kessler scheme)
+!------------------------------------------------------------------------------!
+
+    PRIVATE
+    PUBLIC impact_of_latent_heat
+
+    INTERFACE impact_of_latent_heat
+       MODULE PROCEDURE impact_of_latent_heat
+       MODULE PROCEDURE impact_of_latent_heat_ij
+    END INTERFACE impact_of_latent_heat
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE impact_of_latent_heat
+
+       USE arrays_3d
+       USE cloud_parameters
+       USE constants
+       USE indices
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+       REAL    :: precipitation_rate
+
+ 
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_2d(j,i)+1, nzt-1    
+
+                IF ( ql(k,j,i) > ql_crit )  THEN
+                   precipitation_rate = prec_time_const * &
+                                        ( ql(k,j,i) - ql_crit )
+                ELSE
+                   precipitation_rate = 0.0
+                ENDIF
+                tend(k,j,i) = tend(k,j,i) + precipitation_rate * l_d_cp * &
+                                            pt_d_t(k)
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE impact_of_latent_heat
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE impact_of_latent_heat_ij( i, j )
+
+       USE arrays_3d
+       USE cloud_parameters
+       USE constants
+       USE indices
+   
+       IMPLICIT NONE
+
+       INTEGER :: i, j, k
+       REAL    :: precipitation_rate
+
+
+       DO  k = nzb_2d(j,i)+1, nzt-1    
+
+          IF ( ql(k,j,i) > ql_crit )  THEN
+             precipitation_rate = prec_time_const * ( ql(k,j,i) - ql_crit )
+          ELSE
+             precipitation_rate = 0.0
+          ENDIF
+          tend(k,j,i) = tend(k,j,i) + precipitation_rate * l_d_cp * pt_d_t(k)
+
+       ENDDO
+
+    END SUBROUTINE impact_of_latent_heat_ij
+
+ END MODULE impact_of_latent_heat_mod
Index: palm/trunk/SOURCE/indoor_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/indoor_model_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2223 +1,0 @@
-!> @file indoor_model_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2018-2021 Leibniz Universitaet Hannover
-! Copyright 2018-2021 Hochschule Offenburg
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Enable restart mechanism for previous indoor temperature
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Change parameters for summer_pars and winter_pars (responsible: S. Rissmann)
-!
-! 4780 2020-11-10 11:17:10Z suehring
-! Enable 3D data output also with 64-bit precision
-!
-! 4750 2020-10-16 14:27:48Z suehring
-! - Namelist parameter added to switch-off/on the indoor model during wall/soil spinup
-! - Bugfix in window-wall treatment during spinup - in the urban-surface model the window fraction
-!   is set to zero during spinup, so it is done here also
-! - Bugfix in wall treatment - inner wall temperature was too low due to wrong weighting of
-!   wall/green/window fractions
-!
-! 4730 2020-10-07 10:48:51Z suehring
-! Bugfix - avoid divisions by zero
-! 
-! 4709 2020-09-28 19:20:00Z maronga
-! Bugfix: avoid division by zero in case of zero window fraction (now also for vertical walls).
-! Reactivated waste heat.
-!
-! 4704 2020-09-28 10:13:03Z maronga
-! Bugfix: avoid division by zero in case of zero window fraction
-!
-! 4702 2020-09-27 18:39:00Z maronga
-! Removed unused variable indoor_wall_window_temperature
-!
-! 4701 2020-09-27 11:02:15Z maronga
-! Heat transfer for wall and windows back to USM separated into q_wall and q_win (instead q_wall_win).
-! Heat flow direction revised (heat flow positive from outside to inside).
-! New variable indoor_wall_temperature (for q_wall).
-! Removed unused quantity q_trans.
-!
-! 4698 2020-09-25 08:37:55Z maronga
-! Fixed faulty characters
-!
-! 4687 2020-09-21 19:40:16Z maronga
-! Bugfix: values of theta_m_t_prev were not stored for individual surfaces and thus re-used by all
-! surfaces and buildings, which led to excessive indoor temperatures
-!
-! 4681 2020-09-16 10:23:06Z pavelkrc
-! Bugfix for implementation of downward surfaces
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4646 2020-08-24 16:02:40Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! Change order of dimension in surface array %frac to allow for better vectorization.
-!
-! 4441 2020-03-04 19:20:35Z suehring
-! Major bugfix in calculation of energy demand - floor-area-per-facade was wrongly calculated
-! leading to unrealistically high energy demands and thus to unreallistically high waste-heat
-! fluxes.
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4310 2019-11-26 19:01:28Z suehring
-! Remove dt_indoor from namelist input. The indoor model is an hourly-based model, calling it
-! more/less often lead to inaccurate results.
-!
-! 4299 2019-11-22 10:13:38Z suehring
-! Output of indoor temperature revised (to avoid non-defined values within buildings)
-!
-! 4267 2019-10-16 18:58:49Z suehring
-! Bugfix in initialization, some indices to access building_pars where wrong.
-! Introduction of seasonal parameters.
-!
-! 4246 2019-09-30 09:27:52Z pavelkrc
-!
-!
-! 4242 2019-09-27 12:59:10Z suehring
-! Bugfix in array index
-!
-! 4238 2019-09-25 16:06:01Z suehring
-! - Bugfix in determination of minimum facade height and in location message
-! - Bugfix, avoid division by zero
-! - Some optimization
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod
-!
-! 4217 2019-09-04 09:47:05Z scharf
-! Corrected "Former revisions" section
-!
-! 4209 2019-09-02 12:00:03Z suehring
-! - Bugfix in initialization of indoor temperature
-! - Prescibe default indoor temperature in case it is not given in the namelist input
-!
-! 4182 2019-08-21 14:37:54Z scharf
-! Corrected "Former revisions" section
-!
-! 4148 2019-08-08 11:26:00Z suehring
-! Bugfix in case of non grid-resolved buildings. Further, vertical grid spacing is now considered at
-! the correct level.
-! - change calculation of a_m and c_m
-! - change calculation of u-values (use h_es in building array)
-! - rename h_tr_... to  h_t_...
-!          h_tr_em  to  h_t_wm
-!          h_tr_op  to  h_t_wall
-!          h_tr_w   to  h_t_es
-! - rename h_ve     to  h_v
-! - rename h_is     to  h_ms
-! - inserted net_floor_area
-! - inserted params_waste_heat_h, params_waste_heat_c from building database
-!   in building array
-! - change calculation of q_waste_heat
-! - bugfix in averaging mean indoor temperature
-!
-! 3759 2019-02-21 15:53:45Z suehring
-! - Calculation of total building volume
-! - Several bugfixes
-! - Calculation of building height revised
-!
-! 3745 2019-02-15 18:57:56Z suehring
-! - remove building_type from module
-! - initialize parameters for each building individually instead of a bulk initializaion with
-!   identical building type for all
-! - output revised
-! - add missing _wp
-! - some restructuring of variables in building data structure
-!
-! 3744 2019-02-15 18:38:58Z suehring
-! Some interface calls moved to module_interface + cleanup
-!
-! 3469 2018-10-30 20:05:07Z kanani
-! Initial revision (tlang, suehring, kanani, srissman)!
-!
-! Authors:
-! --------
-! @author Tobias Lang
-! @author Jens Pfafferott
-! @author Farah Kanani-Suehring
-! @author Matthias Suehring
-! @author Sascha Rissmann
-! @author Bjoern Maronga
-!
-!
-! Description:
-! ------------
-!> Module for Indoor Climate Model (ICM)
-!> The module is based on the DIN EN ISO 13790 with simplified hour-based procedure.
-!> This model is a equivalent circuit diagram of a three-point RC-model (5R1C).
-!> This module differs between indoor-air temperature an average temperature of indoor surfaces which make it prossible to determine
-!> thermal comfort
-!> the heat transfer between indoor and outdoor is simplified
-
-!> @todo Many statement comments that are given as doxygen comments need to be changed to normal comments
-!> @todo Replace window_area_per_facade by %frac(1,m) for window
-!> @todo emissivity change for window blinds if solar_protection_on=1
-
-!> @note Do we allow use of integer flags, or only logical flags? (concerns e.g. cooling_on, heating_on)
-!> @note How to write indoor temperature output to pt array?
-!>
-!> @bug  Calculation of iwghf_eb and iwghf_eb_window is faulty
-!--------------------------------------------------------------------------------------------------!
- MODULE indoor_model_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzw,                                                                               &
-               dzw,                                                                                &
-               pt
-
-    USE control_parameters,                                                                        &
-        ONLY:  initializing_actions
-
-    USE kinds
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  building_id_f, building_type_f
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  get_date_time, northward_equinox, seconds_per_hour, southward_equinox
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_usm_h, surf_usm_v
-
-
-    IMPLICIT NONE
-
-!
-!-- Define data structure for buidlings.
-    TYPE build
-
-       INTEGER(iwp) ::  id                                !< building ID
-       INTEGER(iwp) ::  kb_max                            !< highest vertical index of a building
-       INTEGER(iwp) ::  kb_min                            !< lowest vertical index of a building
-       INTEGER(iwp) ::  num_facades_per_building_h = 0    !< total number of horizontal facades elements
-       INTEGER(iwp) ::  num_facades_per_building_h_l = 0  !< number of horizontal facade elements on local subdomain
-       INTEGER(iwp) ::  num_facades_per_building_v = 0    !< total number of vertical facades elements
-       INTEGER(iwp) ::  num_facades_per_building_v_l = 0  !< number of vertical facade elements on local subdomain
-       INTEGER(iwp) ::  ventilation_int_loads             !< [-] allocation of activity in the building
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  l_h            !< index array linking surface-element orientation index
-                                                                  !< for horizontal surfaces with building
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  l_v            !< index array linking surface-element orientation index
-                                                                  !< for vertical surfaces with building
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  m_h            !< index array linking surface-element index for
-                                                                  !< horizontal surfaces with building
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  m_v            !< index array linking surface-element index for
-                                                                  !< vertical surfaces with building
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  num_facade_h   !< number of horizontal facade elements per buidling
-                                                                  !< and height level
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  num_facade_v   !< number of vertical facades elements per buidling
-                                                                  !< and height level
-
-
-       LOGICAL ::  on_pe = .FALSE.   !< flag indicating whether a building with certain ID is on local subdomain
-
-       REAL(wp) ::  air_change_high       !< [1/h] air changes per time_utc_hour
-       REAL(wp) ::  air_change_low        !< [1/h] air changes per time_utc_hour
-       REAL(wp) ::  area_facade           !< [m2] area of total facade
-       REAL(wp) ::  building_height       !< building height
-       REAL(wp) ::  eta_ve                !< [-] heat recovery efficiency
-       REAL(wp) ::  factor_a              !< [-] Dynamic parameters specific effective surface according to Table 12; 2.5
-                                          !< (very light, light and medium), 3.0 (heavy), 3.5 (very heavy)
-       REAL(wp) ::  factor_c              !< [J/(m2 K)] Dynamic parameters inner heatstorage according to Table 12; 80000
-                                          !< (very light), 110000 (light), 165000 (medium), 260000 (heavy), 370000 (very heavy)
-       REAL(wp) ::  f_c_win               !< [-] shading factor
-       REAL(wp) ::  fapf                  !< [m2/m2] floor area per facade
-       REAL(wp) ::  g_value_win           !< [-] SHGC factor
-       REAL(wp) ::  h_es                  !< [W/(m2 K)] surface-related heat transfer coefficient between extern and surface
-       REAL(wp) ::  height_cei_con        !< [m] ceiling construction heigth
-       REAL(wp) ::  height_storey         !< [m] storey heigth
-       REAL(wp) ::  params_waste_heat_c   !< [-] anthropogenic heat outputs for cooling e.g. 1.33 for KKM with COP = 3
-       REAL(wp) ::  params_waste_heat_h   !< [-] anthropogenic heat outputs for heating e.g. 1 - 0.9 = 0.1 for combustion with
-                                          !< eta = 0.9 or -2 for WP with COP = 3
-       REAL(wp) ::  phi_c_max             !< [W] Max. Cooling capacity (negative)
-       REAL(wp) ::  phi_h_max             !< [W] Max. Heating capacity (positive)
-       REAL(wp) ::  q_c_max               !< [W/m2] Max. Cooling heat flux per netto floor area (negative)
-       REAL(wp) ::  q_h_max               !< [W/m2] Max. Heating heat flux per netto floor area (positive)
-       REAL(wp) ::  qint_high             !< [W/m2] internal heat gains, option Database qint_0-23
-       REAL(wp) ::  qint_low              !< [W/m2] internal heat gains, option Database qint_0-23
-       REAL(wp) ::  lambda_at             !< [-] ratio internal surface/floor area chap. 7.2.2.2.
-       REAL(wp) ::  lambda_layer3         !< [W/(m*K)] Thermal conductivity of the inner layer
-       REAL(wp) ::  net_floor_area        !< [m2] netto ground area
-       REAL(wp) ::  s_layer3              !< [m] half thickness of the inner layer (layer_3)
-       REAL(wp) ::  theta_int_c_set       !< [degree_C] Max. Setpoint temperature (summer)
-       REAL(wp) ::  theta_int_h_set       !< [degree_C] Max. Setpoint temperature (winter)
-       REAL(wp) ::  u_value_win           !< [W/(m2*K)] transmittance
-       REAL(wp) ::  vol_tot               !< [m3] total building volume
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_in       !< mean building indoor temperature, height dependent
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_in_l     !< mean building indoor temperature on local subdomain, height dependent
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  theta_m_t_prev_h !< [degree_C] value of theta_m_t from previous time step (horizontal)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  theta_m_t_prev_v !< [degree_C] value of theta_m_t from previous time step (vertical)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  volume     !< total building volume, height dependent
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  vol_frac   !< fraction of local on total building volume, height dependent
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  vpf        !< building volume volume per facade element, height dependent
-
-    END TYPE build
-
-    TYPE(build), DIMENSION(:), ALLOCATABLE ::  buildings   !< building array
-
-    INTEGER(iwp) ::  cooling_on              !< Indoor cooling flag (0=off, 1=on)
-    INTEGER(iwp) ::  heating_on              !< Indoor heating flag (0=off, 1=on)
-    INTEGER(iwp) ::  num_build               !< total number of buildings in domain
-    INTEGER(iwp) ::  solar_protection_off    !< Solar protection off
-    INTEGER(iwp) ::  solar_protection_on     !< Solar protection on
-
-    LOGICAL ::  indoor_during_spinup = .FALSE.      !< namelist parameter used to switch-off/on the indoor model during spinup
-!
-!-- Declare all global variables within the module
-
-    REAL(wp), PARAMETER ::  dt_indoor = 3600.0_wp                  !< [s] time interval for indoor-model application, fixed to
-                                                                   !< 3600.0 due to model requirements
-    REAL(wp), PARAMETER ::  h_is                     = 3.45_wp     !< [W/(m2 K)] surface-related heat transfer coefficient between
-                                                                   !< surface and air (chap. 7.2.2.2)
-    REAL(wp), PARAMETER ::  h_ms                     = 9.1_wp      !< [W/(m2 K)] surface-related heat transfer coefficient between
-                                                                   !< component and surface (chap. 12.2.2)
-    REAL(wp), PARAMETER ::  params_f_f               = 0.3_wp      !< [-] frame ratio chap. 8.3.2.1.1 for buildings with mostly
-                                                                   !< cooling 2.0_wp
-    REAL(wp), PARAMETER ::  params_f_w               = 0.9_wp      !< [-] correction factor (fuer nicht senkrechten Stahlungseinfall
-                                                                   !< DIN 4108-2 chap.8, (hier konstant, keine WinkelabhÃ€ngigkeit)
-    REAL(wp), PARAMETER ::  params_f_win             = 0.5_wp      !< [-] proportion of window area, Database A_win aus
-                                                                   !< Datenbank 27 window_area_per_facade_percent
-    REAL(wp), PARAMETER ::  params_solar_protection  = 300.0_wp    !< [W/m2] chap. G.5.3.1 sun protection closed, if the radiation
-                                                                   !< on facade exceeds this value
-
-    REAL(wp) ::  a_m                                 !< [m2] the effective mass-related area
-    REAL(wp) ::  air_change                          !< [1/h] Airflow
-    REAL(wp) ::  c_m                                 !< [J/K] internal heat storage capacity
-    REAL(wp) ::  facade_element_area                 !< [m2_facade] building surface facade
-    REAL(wp) ::  floor_area_per_facade               !< [m2/m2] floor area per facade area
-    REAL(wp) ::  h_t_1                               !< [W/K] Heat transfer coefficient auxiliary variable 1
-    REAL(wp) ::  h_t_2                               !< [W/K] Heat transfer coefficient auxiliary variable 2
-    REAL(wp) ::  h_t_3                               !< [W/K] Heat transfer coefficient auxiliary variable 3
-    REAL(wp) ::  h_t_es                              !< [W/K] heat transfer coefficient of doors, windows, curtain walls and
-                                                     !< glazed walls (assumption: thermal mass=0)
-    REAL(wp) ::  h_t_is                              !< [W/K] thermal coupling conductance (Thermischer Kopplungsleitwert)
-    REAL(wp) ::  h_t_ms                              !< [W/K] Heat transfer conductance term (got with h_t_wm the thermal mass)
-    REAL(wp) ::  h_t_wall                            !< [W/K] heat transfer coefficient of opaque components (assumption: got all
-                                                     !< thermal mass) contains of h_t_wm and h_t_ms
-    REAL(wp) ::  h_t_wm                              !< [W/K] Heat transfer coefficient of the emmision (got with h_t_ms the
-                                                     !< thermal mass)
-    REAL(wp) ::  h_v                                 !< [W/K] heat transfer of ventilation
-    REAL(wp) ::  indoor_volume_per_facade            !< [m3] indoor air volume per facade element
-    REAL(wp) ::  initial_indoor_temperature = 293.15 !< [K] initial indoor temperature (namelist parameter)
-    REAL(wp) ::  net_sw_in                           !< [W/m2] net short-wave radiation
-    REAL(wp) ::  phi_hc_nd                           !< [W] heating demand and/or cooling demand
-    REAL(wp) ::  phi_hc_nd_10                        !< [W] heating demand and/or cooling demand for heating or cooling
-    REAL(wp) ::  phi_hc_nd_ac                        !< [W] actual heating demand and/or cooling demand
-    REAL(wp) ::  phi_hc_nd_un                        !< [W] unlimited heating demand and/or cooling demand which is necessary to
-                                                     !< reach the demanded required temperature (heating is positive,
-                                                     !< cooling is negative)
-    REAL(wp) ::  phi_ia                              !< [W] internal air load = internal loads * 0.5, Eq. (C.1)
-    REAL(wp) ::  phi_m                               !< [W] mass specific thermal load (internal and external)
-    REAL(wp) ::  phi_mtot                            !< [W] total mass specific thermal load (internal and external)
-    REAL(wp) ::  phi_sol                             !< [W] solar loads
-    REAL(wp) ::  phi_st                              !< [W] mass specific thermal load implied non thermal mass
-    REAL(wp) ::  q_wall                              !< [W/m2]heat flux from indoor into wall
-    REAL(wp) ::  q_win                               !< [W/m2]heat flux from indoor into window
-    REAL(wp) ::  q_waste_heat                        !< [W/m2]waste heat, sum of waste heat over the roof to Palm
-
-    REAL(wp) ::  q_c_m                               !< [W] Energy of thermal storage mass specific thermal load for internal
-                                                     !< and external heatsources (for energy bilanz)
-    REAL(wp) ::  q_c_st                              !< [W] Energy of thermal storage mass specific thermal load implied non
-                                                     !< thermal mass (for energy bilanz)
-    REAL(wp) ::  q_int                               !< [W] Energy of internal air load (for energy bilanz)
-    REAL(wp) ::  q_sol                               !< [W] Energy of solar (for energy bilanz)
-    REAL(wp) ::  q_vent                              !< [W] Energy of ventilation (for energy bilanz)
-
-    REAL(wp) ::  schedule_d                          !< [-] activation for internal loads (low or high + low)
-    REAL(wp) ::  skip_time_do_indoor = 0.0_wp        !< [s] Indoor model is not called before this time
-    REAL(wp) ::  theta_air                           !< [degree_C] air temperature of the RC-node
-    REAL(wp) ::  theta_air_0                         !< [degree_C] air temperature of the RC-node in equilibrium
-    REAL(wp) ::  theta_air_10                        !< [degree_C] air temperature of the RC-node from a heating capacity
-                                                     !< of 10 W/m2
-    REAL(wp) ::  theta_air_ac                        !< [degree_C] actual room temperature after heating/cooling
-    REAL(wp) ::  theta_air_set                       !< [degree_C] Setpoint_temperature for the room
-    REAL(wp) ::  theta_m                             !< [degree_C} inner temperature of the RC-node
-    REAL(wp) ::  theta_m_t                           !< [degree_C] (Fictive) component temperature during timestep
-    REAL(wp) ::  theta_op                            !< [degree_C] operative temperature
-    REAL(wp) ::  theta_s                             !< [degree_C] surface temperature of the RC-node
-    REAL(wp) ::  time_indoor = 0.0_wp                !< [s] time since last call of indoor model
-    REAL(wp) ::  total_area                          !< [m2] area of all surfaces pointing to zone
-    REAL(wp) ::  window_area_per_facade              !< [m2] window area per facade element
-
-!
-!-- Definition of seasonal parameters, summer and winter, for different building types
-    REAL(wp), DIMENSION(0:1,1:7) ::  summer_pars = RESHAPE( (/                & ! building_type 1
-                                          0.5_wp,                             & ! basical airflow without occupancy of the room
-                                          1.5_wp,                             & ! additional airflow depend of occupancy of the room
-                                          0.5_wp,                             & ! building_type 2: basical airflow without occupancy
-                                                                                ! of the room
-                                          1.5_wp,                             & ! additional airflow depend of occupancy of the room
-                                          0.5_wp,                             & ! building_type 3: basical airflow without occupancy
-                                                                                ! of the room
-                                          1.5_wp,                             & ! additional airflow depend of occupancy of the room
-                                          1.0_wp,                             & ! building_type 4: basical airflow without occupancy
-                                                                                ! of the room
-                                          1.0_wp,                             & ! additional airflow depend of occupancy of the room
-                                          1.0_wp,                             & ! building_type 5: basical airflow without occupancy
-                                                                                ! of the room
-                                          1.0_wp,                             & ! additional airflow depend of occupancy of the room
-                                          1.0_wp,                             & ! building_type 6: basical airflow without occupancy
-                                                                                ! of the room
-                                          1.0_wp,                             & ! additional airflow depend of occupancy of the room
-                                          1.0_wp,                             & ! building_type 7: basical airflow without occupancy
-                                                                                ! of the room
-                                          1.0_wp                              & ! additional airflow depend of occupancy of the room
-                                                           /), (/ 2, 7 /) )
-
-    REAL(wp), DIMENSION(0:1,1:7) ::  winter_pars = RESHAPE( (/                & ! building_type 1
-                                          0.5_wp,                             & ! basical airflow without occupancy of the room
-                                          0.0_wp,                             & ! additional airflow depend of occupancy of the room
-                                          0.5_wp,                             & ! building_type 2: basical airflow without occupancy
-                                                                                ! of the room
-                                          0.0_wp,                             & ! additional airflow depend of occupancy of the room
-                                          0.5_wp,                             & ! building_type 3: basical airflow without occupancy
-                                                                                ! of the room
-                                          0.0_wp,                             & ! additional airflow depend of occupancy of the room
-                                          0.2_wp,                             & ! building_type 4: basical airflow without occupancy
-                                                                                ! of the room
-                                          0.8_wp,                             & ! additional airflow depend of occupancy of the room
-                                          0.2_wp,                             & ! building_type 5: basical airflow without occupancy
-                                                                                ! of the room
-                                          0.8_wp,                             & ! additional airflow depend of occupancy of the room
-                                          0.2_wp,                             & ! building_type 6: basical airflow without occupancy
-                                                                                ! of the room
-                                          0.8_wp,                             & ! additional airflow depend of occupancy of the room
-                                          0.2_wp,                             & ! building_type 7: basical airflow without occupancy
-                                                                                ! of the room
-                                          0.8_wp                              & ! additional airflow depend of occupancy of the room
-                                                           /), (/ 2, 7 /) )
-
-    SAVE
-
-
-    PRIVATE
-
-!
-!-- Add INTERFACES that must be available to other modules
-    PUBLIC im_init, im_main_heatcool, im_parin, im_define_netcdf_grid, im_check_data_output,       &
-           im_data_output_3d, im_check_parameters
-
-
-!
-!-- Add VARIABLES that must be available to other modules
-    PUBLIC dt_indoor,                                                                              &
-           indoor_during_spinup,                                                                   &
-           skip_time_do_indoor,                                                                    &
-           time_indoor
-
-!
-!-- PALM interfaces:
-!-- Data output checks for 2D/3D data to be done in check_parameters
-     INTERFACE im_check_data_output
-        MODULE PROCEDURE im_check_data_output
-     END INTERFACE im_check_data_output
-!
-!-- Input parameter checks to be done in check_parameters
-     INTERFACE im_check_parameters
-        MODULE PROCEDURE im_check_parameters
-     END INTERFACE im_check_parameters
-!
-!-- Data output of 3D data
-     INTERFACE im_data_output_3d
-        MODULE PROCEDURE im_data_output_3d
-     END INTERFACE im_data_output_3d
-
-!
-!-- Definition of data output quantities
-     INTERFACE im_define_netcdf_grid
-        MODULE PROCEDURE im_define_netcdf_grid
-     END INTERFACE im_define_netcdf_grid
-!
-! !
-! !-- Output of information to the header file
-!     INTERFACE im_header
-!        MODULE PROCEDURE im_header
-!     END INTERFACE im_header
-!
-!-- Calculations for indoor temperatures
-    INTERFACE im_calc_temperatures
-       MODULE PROCEDURE im_calc_temperatures
-    END INTERFACE im_calc_temperatures
-!
-!-- Initialization actions
-    INTERFACE im_init
-       MODULE PROCEDURE im_init
-    END INTERFACE im_init
-!
-!-- Main part of indoor model
-    INTERFACE im_main_heatcool
-       MODULE PROCEDURE im_main_heatcool
-    END INTERFACE im_main_heatcool
-!
-!-- Reading of NAMELIST parameters
-    INTERFACE im_parin
-       MODULE PROCEDURE im_parin
-    END INTERFACE im_parin
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!< Calculation of the air temperatures and mean radiation temperature.
-!< This is basis for the operative temperature.
-!< Based on a Crank-Nicholson scheme with a timestep of a hour.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE im_calc_temperatures ( i, j, k, indoor_wall_temperature,  &
-                                   near_facade_temperature, phi_hc_nd_dummy, theta_m_t_prev )
-
-    INTEGER(iwp) ::  i
-    INTEGER(iwp) ::  j
-    INTEGER(iwp) ::  k
-
-    REAL(wp) ::  indoor_wall_temperature   !< temperature of innermost wall layer evtl in im_calc_temperatures einfÃŒgen
-    REAL(wp) ::  near_facade_temperature
-    REAL(wp) ::  phi_hc_nd_dummy
-    REAL(wp), INTENT(IN) :: theta_m_t_prev
-!
-!-- Calculation of total mass specific thermal load (internal and external)
-    phi_mtot = ( phi_m + h_t_wm * indoor_wall_temperature                                   &
-                       + h_t_3  * ( phi_st + h_t_es * pt(k,j,i)                                    &
-                                            + h_t_1 *                                              &
-                                    ( ( ( phi_ia + phi_hc_nd_dummy ) / h_v )                       &
-                                                 + near_facade_temperature )                       &
-                                  ) / h_t_2                                                        &
-               )                                                                !< [degree_C] Eq. (C.5)
-!
-!-- Calculation of component temperature at current timestep
-    theta_m_t = ( ( theta_m_t_prev                                                                 &
-                    * ( ( c_m / 3600.0_wp ) - 0.5_wp * ( h_t_3 + h_t_wm ) )                        &
-                     + phi_mtot                                                                    &
-                  )                                                                                &
-                  /   ( ( c_m / 3600.0_wp ) + 0.5_wp * ( h_t_3 + h_t_wm ) )                        &
-                )                                                               !< [degree_C] Eq. (C.4)
-!
-!-- Calculation of mean inner temperature for the RC-node in current timestep
-    theta_m = ( theta_m_t + theta_m_t_prev ) * 0.5_wp                           !< [degree_C] Eq. (C.9)
-
-!
-!-- Calculation of mean surface temperature of the RC-node in current timestep
-    theta_s = ( (   h_t_ms * theta_m + phi_st + h_t_es * pt(k,j,i)                                 &
-                  + h_t_1  * ( near_facade_temperature                                             &
-                           + ( phi_ia + phi_hc_nd_dummy ) / h_v )                                  &
-                )                                                                                  &
-                / ( h_t_ms + h_t_es + h_t_1 )                                                      &
-              )                                                                 !< [degree_C] Eq. (C.10)
-
-!
-!-- Calculation of the air temperature of the RC-node
-
-
-    theta_air = ( h_t_is * theta_s + h_v * near_facade_temperature + phi_ia + phi_hc_nd_dummy ) /  &
-                ( h_t_is + h_v )                                                !< [degree_C] Eq. (C.11)
-
-
- END SUBROUTINE im_calc_temperatures
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the indoor model.
-!> Static information are calculated here, e.g. building parameters and geometrical information,
-!> anything that doesn't change in time.
-!
-!-- Input values
-!-- Input datas from Palm, M4
-!     i_global             -->  net_sw_in                         !< global radiation [W/m2]
-!     theta_e              -->  pt(k,j,i)                         !< undisturbed outside temperature, 1. PALM volume, for windows
-!     theta_sup = theta_f  -->  surf_usm_h%pt_10cm(m)
-!                               surf_usm_v(l)%pt_10cm(m)          !< Air temperature, facade near (10cm) air temperature from
-                                                                  !< 1. Palm volume
-!     theta_node           -->  t_wall_h(nzt_wall,m)
-!                               t_wall_v(l)%t(nzt_wall,m)         !< Temperature of innermost wall layer, for opaque wall
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE im_init
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string, time_since_reference_point
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_total_0
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE pegrid
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_usm_h, surf_usm_v
-
-    USE urban_surface_mod,                                                                         &
-        ONLY:  building_pars, building_type
-
-    INTEGER(iwp) ::  bt          !< local building type
-    INTEGER(iwp) ::  day_of_year !< day of the year
-    INTEGER(iwp) ::  fa          !< running index for facade elements of each building
-    INTEGER(iwp) ::  i           !< running index along x-direction
-    INTEGER(iwp) ::  j           !< running index along y-direction
-    INTEGER(iwp) ::  k           !< running index along z-direction
-    INTEGER(iwp) ::  l           !< running index for surface-element orientation
-    INTEGER(iwp) ::  m           !< running index surface elements
-    INTEGER(iwp) ::  n           !< building index
-    INTEGER(iwp) ::  nb          !< building index
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids           !< building IDs on entire model domain
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_final     !< building IDs on entire model domain,
-                                                                    !< multiple occurences are sorted out
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_final_tmp !< temporary array used for resizing
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_l         !< building IDs on local subdomain
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_l_tmp     !< temporary array used to resize array of building IDs
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  displace_dum        !< displacements of start addresses, used for MPI_ALLGATHERV
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k_max_l             !< highest vertical index of a building on subdomain
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k_min_l             !< lowest vertical index of a building on subdomain
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  n_fa                !< counting array
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  num_facades_h       !< dummy array used for summing-up total number of
-                                                                    !< horizontal facade elements
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  num_facades_v       !< dummy array used for summing-up total number of
-                                                                    !< vertical facade elements
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  receive_dum_h       !< dummy array used for MPI_ALLREDUCE
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  receive_dum_v       !< dummy array used for MPI_ALLREDUCE
-
-    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  num_buildings         !< number of buildings with different ID on entire model domain
-    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  num_buildings_l       !< number of buildings with different ID on local subdomain
-
-    REAL(wp) ::  u_tmp                                     !< dummy for temporary calculation of u-value without h_is
-    REAL(wp) ::  du_tmp                                    !< 1/u_tmp
-    REAL(wp) ::  du_win_tmp                                !< 1/building(nb)%u_value_win
-    REAL(wp) ::  facade_area_v                             !< dummy to compute the total facade area from vertical walls
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  volume         !< total building volume at each discrete height level
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  volume_l       !< total building volume at each discrete height level,
-                                                           !< on local subdomain
-
-    CALL location_message( 'initializing indoor model', 'start' )
-!
-!-- Initializing of indoor model is only possible if buildings can be distinguished by their IDs.
-    IF ( .NOT. building_id_f%from_file )  THEN
-       message_string = 'Indoor model requires information about building_id'
-       CALL message( 'im_init', 'PA0999', 1, 2, 0, 6, 0  )
-    ENDIF
-!
-!-- Determine number of different building IDs on local subdomain.
-    num_buildings_l = 0
-    num_buildings   = 0
-    ALLOCATE( build_ids_l(1) )
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
-             IF ( num_buildings_l(myid) > 0 )  THEN
-                IF ( ANY( building_id_f%var(j,i) == build_ids_l ) )  THEN
-                   CYCLE
-                ELSE
-                   num_buildings_l(myid) = num_buildings_l(myid) + 1
-!
-!--                Resize array with different local building ids
-                   ALLOCATE( build_ids_l_tmp(1:SIZE(build_ids_l)) )
-                   build_ids_l_tmp = build_ids_l
-                   DEALLOCATE( build_ids_l )
-                   ALLOCATE( build_ids_l(1:num_buildings_l(myid)) )
-                   build_ids_l(1:num_buildings_l(myid)-1) =                                        &
-                                                          build_ids_l_tmp(1:num_buildings_l(myid)-1)
-                   build_ids_l(num_buildings_l(myid)) = building_id_f%var(j,i)
-                   DEALLOCATE( build_ids_l_tmp )
-                ENDIF
-!
-!--          First occuring building id on PE
-             ELSE
-                num_buildings_l(myid) = num_buildings_l(myid) + 1
-                build_ids_l(1) = building_id_f%var(j,i)
-             ENDIF
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!-- Determine number of building IDs for the entire domain. (Note, building IDs can appear multiple
-!-- times as buildings might be distributed over several PEs.)
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( num_buildings_l, num_buildings, numprocs, MPI_INTEGER, MPI_SUM, comm2d,    &
-                        ierr )
-#else
-    num_buildings = num_buildings_l
-#endif
-    ALLOCATE( build_ids(1:SUM(num_buildings)) )
-!
-!-- Gather building IDs. Therefore, first, determine displacements used required for MPI_GATHERV
-!-- call.
-    ALLOCATE( displace_dum(0:numprocs-1) )
-    displace_dum(0) = 0
-    DO i = 1, numprocs-1
-       displace_dum(i) = displace_dum(i-1) + num_buildings(i-1)
-    ENDDO
-
-#if defined( __parallel )
-    CALL MPI_ALLGATHERV( build_ids_l(1:num_buildings_l(myid)),                                     &
-                         num_buildings(myid),                                                      &
-                         MPI_INTEGER,                                                              &
-                         build_ids,                                                                &
-                         num_buildings,                                                            &
-                         displace_dum,                                                             &
-                         MPI_INTEGER,                                                              &
-                         comm2d, ierr )
-
-    DEALLOCATE( displace_dum )
-
-#else
-    build_ids = build_ids_l
-#endif
-!
-!-- Note: in parallel mode, building IDs can occur mutliple times, as each PE has send its own ids.
-!-- Therefore, sort out building IDs which appear multiple times.
-    num_build = 0
-    DO  n = 1, SIZE(build_ids)
-
-       IF ( ALLOCATED(build_ids_final) )  THEN
-          IF ( ANY( build_ids(n) == build_ids_final ) )  THEN
-             CYCLE
-          ELSE
-             num_build = num_build + 1
-!
-!--          Resize
-             ALLOCATE( build_ids_final_tmp(1:num_build) )
-             build_ids_final_tmp(1:num_build-1) = build_ids_final(1:num_build-1)
-             DEALLOCATE( build_ids_final )
-             ALLOCATE( build_ids_final(1:num_build) )
-             build_ids_final(1:num_build-1) = build_ids_final_tmp(1:num_build-1)
-             build_ids_final(num_build) = build_ids(n)
-             DEALLOCATE( build_ids_final_tmp )
-          ENDIF
-       ELSE
-          num_build = num_build + 1
-          ALLOCATE( build_ids_final(1:num_build) )
-          build_ids_final(num_build) = build_ids(n)
-       ENDIF
-    ENDDO
-
-!
-!-- Allocate building-data structure array. Note, this is a global array and all building IDs on
-!-- domain are known by each PE. Further attributes, e.g. height-dependent arrays, however, are only
-!-- allocated on PEs where  the respective building is present (in order to reduce memory demands).
-    ALLOCATE( buildings(1:num_build) )
-
-!
-!-- Store building IDs and check if building with certain ID is present on subdomain.
-    DO  nb = 1, num_build
-       buildings(nb)%id = build_ids_final(nb)
-
-       IF ( ANY( building_id_f%var(nys:nyn,nxl:nxr) == buildings(nb)%id ) )                        &
-          buildings(nb)%on_pe = .TRUE.
-    ENDDO
-!
-!-- Determine the maximum vertical dimension occupied by each building.
-    ALLOCATE( k_min_l(1:num_build) )
-    ALLOCATE( k_max_l(1:num_build) )
-    k_min_l = nzt + 1
-    k_max_l = 0
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
-             nb = MINLOC( ABS( buildings(:)%id - building_id_f%var(j,i) ), DIM=1 )
-             DO  k = nzb, nzt+1
-!
-!--             Check if grid point belongs to a building.
-                IF ( BTEST( wall_flags_total_0(k,j,i), 6 ) )  THEN
-                   k_min_l(nb) = MIN( k_min_l(nb), k )
-                   k_max_l(nb) = MAX( k_max_l(nb), k )
-                ENDIF
-
-             ENDDO
-          ENDIF
-       ENDDO
-    ENDDO
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( k_min_l(:), buildings(:)%kb_min, num_build, MPI_INTEGER, MPI_MIN, comm2d,  &
-                        ierr )
-    CALL MPI_ALLREDUCE( k_max_l(:), buildings(:)%kb_max, num_build, MPI_INTEGER, MPI_MAX, comm2d,  &
-                        ierr )
-#else
-    buildings(:)%kb_min = k_min_l(:)
-    buildings(:)%kb_max = k_max_l(:)
-#endif
-
-    DEALLOCATE( k_min_l )
-    DEALLOCATE( k_max_l )
-!
-!-- Calculate building height.
-    DO  nb = 1, num_build
-       buildings(nb)%building_height = 0.0_wp
-       DO  k = buildings(nb)%kb_min, buildings(nb)%kb_max
-          buildings(nb)%building_height = buildings(nb)%building_height + dzw(k+1)
-       ENDDO
-    ENDDO
-!
-!-- Calculate building volume
-    DO  nb = 1, num_build
-!
-!--    Allocate temporary array for summing-up building volume
-       ALLOCATE( volume(buildings(nb)%kb_min:buildings(nb)%kb_max)   )
-       ALLOCATE( volume_l(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-       volume   = 0.0_wp
-       volume_l = 0.0_wp
-!
-!--    Calculate building volume per height level on each PE where these building is present.
-       IF ( buildings(nb)%on_pe )  THEN
-
-          ALLOCATE( buildings(nb)%volume(buildings(nb)%kb_min:buildings(nb)%kb_max)   )
-          ALLOCATE( buildings(nb)%vol_frac(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-          buildings(nb)%volume   = 0.0_wp
-          buildings(nb)%vol_frac = 0.0_wp
-
-          IF ( ANY( building_id_f%var(nys:nyn,nxl:nxr) == buildings(nb)%id ) )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = buildings(nb)%kb_min, buildings(nb)%kb_max
-                      IF ( building_id_f%var(j,i) /= building_id_f%fill )                          &
-                         volume_l(k) = volume_l(k) + dx * dy * dzw(k+1)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Sum-up building volume from all subdomains
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( volume_l, volume, SIZE(volume), MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-       volume = volume_l
-#endif
-!
-!--    Save total building volume as well as local fraction on volume on building data structure.
-       IF ( ALLOCATED( buildings(nb)%volume ) )  buildings(nb)%volume = volume
-!
-!--    Determine fraction of local on total building volume
-       IF ( buildings(nb)%on_pe )  buildings(nb)%vol_frac = volume_l / volume
-!
-!--    Calculate total building volume
-       IF ( ALLOCATED( buildings(nb)%volume ) )  buildings(nb)%vol_tot = SUM( buildings(nb)%volume )
-
-       DEALLOCATE( volume   )
-       DEALLOCATE( volume_l )
-
-    ENDDO
-!
-!-- Allocate arrays for indoor temperature.
-    DO  nb = 1, num_build
-       IF ( buildings(nb)%on_pe )  THEN
-          ALLOCATE( buildings(nb)%t_in(buildings(nb)%kb_min:buildings(nb)%kb_max)   )
-          ALLOCATE( buildings(nb)%t_in_l(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-          buildings(nb)%t_in   = 0.0_wp
-          buildings(nb)%t_in_l = 0.0_wp
-       ENDIF
-    ENDDO
-!
-!-- Allocate arrays for number of facades per height level. Distinguish between horizontal and
-!-- vertical facades.
-    DO  nb = 1, num_build
-       IF ( buildings(nb)%on_pe )  THEN
-          ALLOCATE( buildings(nb)%num_facade_h(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-          ALLOCATE( buildings(nb)%num_facade_v(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-
-          buildings(nb)%num_facade_h = 0
-          buildings(nb)%num_facade_v = 0
-       ENDIF
-    ENDDO
-!
-!-- Determine number of facade elements per building on local subdomain.
-!-- Distinguish between horizontal and vertical facade elements.
-!
-!-- Horizontal facades
-    buildings(:)%num_facades_per_building_h_l = 0
-    DO  l = 0, 1
-       DO  m = 1, surf_usm_h(l)%ns
-!
-!--       For the current facade element determine corresponding building index.
-!--       First, obtain j,j,k indices of the building. Please note the offset between facade/surface
-!--       element and building location (for horizontal surface elements the horizontal offsets are
-!--       zero).
-          i = surf_usm_h(l)%i(m) + surf_usm_h(l)%ioff
-          j = surf_usm_h(l)%j(m) + surf_usm_h(l)%joff
-          k = surf_usm_h(l)%k(m) + surf_usm_h(l)%koff
-!
-!--       Determine building index and check whether building is on PE.
-          nb = MINLOC( ABS( buildings(:)%id - building_id_f%var(j,i) ), DIM=1 )
-
-          IF ( buildings(nb)%on_pe )  THEN
-!
-!--          Count number of facade elements at each height level.
-             buildings(nb)%num_facade_h(k) = buildings(nb)%num_facade_h(k) + 1
-!
-!--          Moreover, sum up number of local facade elements per building.
-             buildings(nb)%num_facades_per_building_h_l =                                             &
-                                                      buildings(nb)%num_facades_per_building_h_l + 1
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!-- Vertical facades
-    buildings(:)%num_facades_per_building_v_l = 0
-    DO  l = 0, 3
-       DO  m = 1, surf_usm_v(l)%ns
-!
-!--       For the current facade element determine corresponding building index.
-!--       First, obtain j,j,k indices of the building. Please note the offset between facade/surface
-!--       element and building location (for vertical surface elements the vertical offsets are
-!--       zero).
-          i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
-          j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
-          k = surf_usm_v(l)%k(m) + surf_usm_v(l)%koff
-
-          nb = MINLOC( ABS( buildings(:)%id - building_id_f%var(j,i) ), DIM=1 )
-          IF ( buildings(nb)%on_pe )  THEN
-             buildings(nb)%num_facade_v(k) = buildings(nb)%num_facade_v(k) + 1
-             buildings(nb)%num_facades_per_building_v_l =                                          &
-                                                      buildings(nb)%num_facades_per_building_v_l + 1
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!-- Determine total number of facade elements per building and assign number to building data type.
-    DO  nb = 1, num_build
-!
-!--    Allocate dummy array used for summing-up facade elements.
-!--    Please note, dummy arguments are necessary as building-date type arrays are not necessarily
-!--    allocated on all PEs.
-       ALLOCATE( num_facades_h(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-       ALLOCATE( num_facades_v(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-       ALLOCATE( receive_dum_h(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-       ALLOCATE( receive_dum_v(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-       num_facades_h = 0
-       num_facades_v = 0
-       receive_dum_h = 0
-       receive_dum_v = 0
-
-       IF ( buildings(nb)%on_pe )  THEN
-          num_facades_h = buildings(nb)%num_facade_h
-          num_facades_v = buildings(nb)%num_facade_v
-       ENDIF
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( num_facades_h,                                                          &
-                           receive_dum_h,                                                          &
-                           buildings(nb)%kb_max - buildings(nb)%kb_min + 1,                        &
-                           MPI_INTEGER,                                                            &
-                           MPI_SUM,                                                                &
-                           comm2d,                                                                 &
-                           ierr )
-
-       CALL MPI_ALLREDUCE( num_facades_v,                                                          &
-                           receive_dum_v,                                                          &
-                           buildings(nb)%kb_max - buildings(nb)%kb_min + 1,                        &
-                           MPI_INTEGER,                                                            &
-                           MPI_SUM,                                                                &
-                           comm2d,                                                                 &
-                           ierr )
-       IF ( ALLOCATED( buildings(nb)%num_facade_h ) )  buildings(nb)%num_facade_h = receive_dum_h
-       IF ( ALLOCATED( buildings(nb)%num_facade_v ) )  buildings(nb)%num_facade_v = receive_dum_v
-#else
-       buildings(nb)%num_facade_h = num_facades_h
-       buildings(nb)%num_facade_v = num_facades_v
-#endif
-
-!
-!--    Deallocate dummy arrays
-       DEALLOCATE( num_facades_h )
-       DEALLOCATE( num_facades_v )
-       DEALLOCATE( receive_dum_h )
-       DEALLOCATE( receive_dum_v )
-!
-!--    Allocate index arrays which link facade elements with surface-data type.
-!--    Please note, no height levels are considered here (information is stored in surface-data type
-!--    itself).
-       IF ( buildings(nb)%on_pe )  THEN
-!
-!--       Determine number of facade elements per building.
-          buildings(nb)%num_facades_per_building_h = SUM( buildings(nb)%num_facade_h )
-          buildings(nb)%num_facades_per_building_v = SUM( buildings(nb)%num_facade_v )
-!
-!--       Allocate arrays which link the building with the horizontal and vertical urban-type
-!--       surfaces. Please note, linking arrays are allocated over all facade elements, which is
-!--       required in case a building is located at the subdomain boundaries, where the building and
-!--       the corresponding surface elements are located on different subdomains.
-          ALLOCATE( buildings(nb)%l_h(1:buildings(nb)%num_facades_per_building_h_l) )
-          ALLOCATE( buildings(nb)%m_h(1:buildings(nb)%num_facades_per_building_h_l) )
-
-          ALLOCATE( buildings(nb)%l_v(1:buildings(nb)%num_facades_per_building_v_l) )
-          ALLOCATE( buildings(nb)%m_v(1:buildings(nb)%num_facades_per_building_v_l) )
-
-          ALLOCATE( buildings(nb)%theta_m_t_prev_h(1:buildings(nb)%num_facades_per_building_h_l) )
-          ALLOCATE( buildings(nb)%theta_m_t_prev_v(1:buildings(nb)%num_facades_per_building_v_l) )
-       ENDIF
-
-       IF ( buildings(nb)%on_pe )  THEN
-          ALLOCATE( buildings(nb)%vpf(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-          buildings(nb)%vpf = 0.0_wp
-
-          facade_area_v = 0.0_wp
-          DO  k = buildings(nb)%kb_min, buildings(nb)%kb_max
-             facade_area_v = facade_area_v + buildings(nb)%num_facade_v(k) * dzw(k+1) * dx
-          ENDDO
-!
-!--       Determine volume per total facade area (vpf). For the horizontal facade area
-!--       num_facades_per_building_h can be taken, multiplied with dx*dy.
-!--       However, due to grid stretching, vertical facade elements must be summed-up vertically.
-!--       Please note, if dx /= dy, an error is made!
-          buildings(nb)%vpf = buildings(nb)%vol_tot /                                              &
-                              ( buildings(nb)%num_facades_per_building_h * dx * dy + facade_area_v )
-!
-!--       Determine floor-area-per-facade.
-          buildings(nb)%fapf = buildings(nb)%num_facades_per_building_h     * dx * dy              &
-                               / ( buildings(nb)%num_facades_per_building_h * dx * dy              &
-                                   + facade_area_v )
-       ENDIF
-    ENDDO
-!
-!-- Link facade elements with surface data type.
-!-- Allocate array for counting.
-    ALLOCATE( n_fa(1:num_build) )
-    n_fa = 1
-
-    DO  l = 0, 1
-       DO  m = 1, surf_usm_h(l)%ns
-          i = surf_usm_h(l)%i(m) + surf_usm_h(l)%ioff
-          j = surf_usm_h(l)%j(m) + surf_usm_h(l)%joff
-
-          nb = MINLOC( ABS( buildings(:)%id - building_id_f%var(j,i) ), DIM=1 )
-
-          IF ( buildings(nb)%on_pe )  THEN
-             buildings(nb)%l_h(n_fa(nb)) = l
-             buildings(nb)%m_h(n_fa(nb)) = m
-             n_fa(nb) = n_fa(nb) + 1
-          ENDIF
-       ENDDO
-    ENDDO
-
-    n_fa = 1
-    DO  l = 0, 3
-       DO  m = 1, surf_usm_v(l)%ns
-          i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
-          j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
-
-          nb = MINLOC( ABS( buildings(:)%id - building_id_f%var(j,i) ), DIM=1 )
-
-          IF ( buildings(nb)%on_pe )  THEN
-             buildings(nb)%l_v(n_fa(nb)) = l
-             buildings(nb)%m_v(n_fa(nb)) = m
-             n_fa(nb) = n_fa(nb) + 1
-          ENDIF
-       ENDDO
-    ENDDO
-    DEALLOCATE( n_fa )
-!
-!-- Initialize building parameters, first by mean building type. Note, in this case all buildings
-!-- have the same type.
-!-- In a second step initialize with building tpyes from static input file, where building types can
-!-- be individual for each building.
-    buildings(:)%lambda_layer3       = building_pars(31,building_type)
-    buildings(:)%s_layer3            = building_pars(44,building_type)
-    buildings(:)%f_c_win             = building_pars(119,building_type)
-    buildings(:)%g_value_win         = building_pars(120,building_type)
-    buildings(:)%u_value_win         = building_pars(121,building_type)
-    buildings(:)%eta_ve              = building_pars(124,building_type)
-    buildings(:)%factor_a            = building_pars(125,building_type)
-    buildings(:)%factor_c            = building_pars(126,building_type)
-    buildings(:)%lambda_at           = building_pars(127,building_type)
-    buildings(:)%theta_int_h_set     = building_pars(13,building_type)
-    buildings(:)%theta_int_c_set     = building_pars(12,building_type)
-    buildings(:)%q_h_max             = building_pars(128,building_type)
-    buildings(:)%q_c_max             = building_pars(129,building_type)
-    buildings(:)%qint_high           = building_pars(130,building_type)
-    buildings(:)%qint_low            = building_pars(131,building_type)
-    buildings(:)%height_storey       = building_pars(132,building_type)
-    buildings(:)%height_cei_con      = building_pars(133,building_type)
-    buildings(:)%params_waste_heat_h = building_pars(134,building_type)
-    buildings(:)%params_waste_heat_c = building_pars(135,building_type)
-!
-!-- Initialize seasonal dependent parameters, depending on day of the year.
-!-- First, calculated day of the year.
-    CALL get_date_time( time_since_reference_point, day_of_year = day_of_year )
-!
-!-- Summer is defined in between northward- and southward equinox.
-    IF ( day_of_year >= northward_equinox  .AND.  day_of_year <= southward_equinox )  THEN
-       buildings(:)%air_change_low      = summer_pars(0,building_type)
-       buildings(:)%air_change_high     = summer_pars(1,building_type)
-    ELSE
-       buildings(:)%air_change_low      = winter_pars(0,building_type)
-       buildings(:)%air_change_high     = winter_pars(1,building_type)
-    ENDIF
-!
-!-- Initialize ventilation load. Please note, building types > 7 are actually not allowed (check
-!-- already in urban_surface_mod and netcdf_data_input_mod.
-!-- However, the building data base may be later extended.
-    IF ( building_type ==  1  .OR.  building_type ==  2  .OR.                                      &
-         building_type ==  3  .OR.  building_type == 10  .OR.                                      &
-         building_type == 11  .OR.  building_type == 12 )  THEN
-       buildings(:)%ventilation_int_loads = 1
-!
-!-- Office, building with large windows
-    ELSEIF ( building_type ==  4  .OR.  building_type ==  5  .OR.                                  &
-             building_type ==  6  .OR.  building_type ==  7  .OR.                                  &
-             building_type ==  8  .OR.  building_type ==  9)  THEN
-       buildings(:)%ventilation_int_loads = 2
-!
-!-- Industry, hospitals
-    ELSEIF ( building_type == 13  .OR.  building_type == 14  .OR.                                  &
-             building_type == 15  .OR.  building_type == 16  .OR.                                  &
-             building_type == 17  .OR.  building_type == 18 )  THEN
-       buildings(:)%ventilation_int_loads = 3
-    ENDIF
-!
-!-- Initialization of building parameters - level 2
-    IF ( building_type_f%from_file )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-              IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
-                 nb = MINLOC( ABS( buildings(:)%id - building_id_f%var(j,i) ), DIM=1 )
-                 bt = building_type_f%var(j,i)
-
-                 buildings(nb)%lambda_layer3       = building_pars(31,bt)
-                 buildings(nb)%s_layer3            = building_pars(44,bt)
-                 buildings(nb)%f_c_win             = building_pars(119,bt)
-                 buildings(nb)%g_value_win         = building_pars(120,bt)
-                 buildings(nb)%u_value_win         = building_pars(121,bt)
-                 buildings(nb)%eta_ve              = building_pars(124,bt)
-                 buildings(nb)%factor_a            = building_pars(125,bt)
-                 buildings(nb)%factor_c            = building_pars(126,bt)
-                 buildings(nb)%lambda_at           = building_pars(127,bt)
-                 buildings(nb)%theta_int_h_set     = building_pars(13,bt)
-                 buildings(nb)%theta_int_c_set     = building_pars(12,bt)
-                 buildings(nb)%q_h_max             = building_pars(128,bt)
-                 buildings(nb)%q_c_max             = building_pars(129,bt)
-                 buildings(nb)%qint_high           = building_pars(130,bt)
-                 buildings(nb)%qint_low            = building_pars(131,bt)
-                 buildings(nb)%height_storey       = building_pars(132,bt)
-                 buildings(nb)%height_cei_con      = building_pars(133,bt)
-                 buildings(nb)%params_waste_heat_h = building_pars(134,bt)
-                 buildings(nb)%params_waste_heat_c = building_pars(135,bt)
-
-              IF ( day_of_year >= northward_equinox  .AND.  day_of_year <= southward_equinox )  THEN
-                 buildings(nb)%air_change_low      = summer_pars(0,bt)
-                 buildings(nb)%air_change_high     = summer_pars(1,bt)
-              ELSE
-                 buildings(nb)%air_change_low      = winter_pars(0,bt)
-                 buildings(nb)%air_change_high     = winter_pars(1,bt)
-              ENDIF
-
-!
-!--              Initialize ventilaation load. Please note, building types > 7
-!--              are actually not allowed (check already in urban_surface_mod
-!--              and netcdf_data_input_mod. However, the building data base may
-!--              be later extended.
-                 IF ( bt ==  1  .OR.  bt ==  2  .OR.                                               &
-                      bt ==  3  .OR.  bt == 10  .OR.                                               &
-                      bt == 11  .OR.  bt == 12 )  THEN
-                    buildings(nb)%ventilation_int_loads = 1
-!
-!--              Office, building with large windows
-                 ELSEIF ( bt ==  4  .OR.  bt ==  5  .OR.                                           &
-                          bt ==  6  .OR.  bt ==  7  .OR.                                           &
-                          bt ==  8  .OR.  bt ==  9)  THEN
-                    buildings(nb)%ventilation_int_loads = 2
-!
-!--              Industry, hospitals
-                 ELSEIF ( bt == 13  .OR.  bt == 14  .OR.                                           &
-                          bt == 15  .OR.  bt == 16  .OR.                                           &
-                          bt == 17  .OR.  bt == 18 )  THEN
-                    buildings(nb)%ventilation_int_loads = 3
-                 ENDIF
-              ENDIF
-           ENDDO
-        ENDDO
-    ENDIF
-!
-!-- Calculation of surface-related heat transfer coeffiecient out of standard u-values from building
-!-- database.
-!-- Only amount of extern and surface is used.
-!-- Otherwise amount between air and surface taken account twice.
-    DO nb = 1, num_build
-       IF ( buildings(nb)%on_pe ) THEN
-          du_win_tmp = 1.0_wp / buildings(nb)%u_value_win
-          u_tmp = buildings(nb)%u_value_win * ( du_win_tmp / ( du_win_tmp -                        &
-                  0.125_wp + ( 1.0_wp / h_is ) ) )
-
-          du_tmp = 1.0_wp / u_tmp
-
-          buildings(nb)%h_es = 1.0_wp / ( du_tmp - ( 1.0_wp / h_is ) )
-
-       ENDIF
-    ENDDO
-!
-!-- Initialize indoor temperature. Actually only for output at initial state.
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-       DO  nb = 1, num_build
-          IF ( buildings(nb)%on_pe )  THEN
-             buildings(nb)%t_in(:) = initial_indoor_temperature
-
-!
-!--          (after first loop, use theta_m_t as theta_m_t_prev)
-             buildings(nb)%theta_m_t_prev_h(:) = initial_indoor_temperature
-             buildings(nb)%theta_m_t_prev_v(:) = initial_indoor_temperature
-
-          ENDIF
-       ENDDO
-!
-!-- Initialize indoor temperature at previous timestep.
-    ELSE
-       DO  nb = 1, num_build
-          IF ( buildings(nb)%on_pe )  THEN
-!
-!--          Mean indoor temperature can be initialized with initial value. This is just
-!--          used for output.
-             buildings(nb)%t_in(:) = initial_indoor_temperature
-!
-!--          Initialize theta_m_t_prev arrays. The respective data during the restart mechanism
-!--          is stored on the surface-data array.
-             DO  fa = 1, buildings(nb)%num_facades_per_building_h_l
-!
-!--             Determine indices where corresponding surface-type information is stored.
-                l = buildings(nb)%l_h(fa)
-                m = buildings(nb)%m_h(fa)
-                buildings(nb)%theta_m_t_prev_h(fa) = surf_usm_h(l)%t_prev(m)
-             ENDDO
-             DO  fa = 1, buildings(nb)%num_facades_per_building_v_l
-!
-!--             Determine indices where corresponding surface-type information is stored.
-                l = buildings(nb)%l_v(fa)
-                m = buildings(nb)%m_v(fa)
-                buildings(nb)%theta_m_t_prev_v(fa) = surf_usm_v(l)%t_prev(m)
-             ENDDO
-          ENDIF
-       ENDDO
-    ENDIF
-
-    CALL location_message( 'initializing indoor model', 'finished' )
-
- END SUBROUTINE im_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Main part of the indoor model.
-!> Calculation of .... (kanani: Please describe)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE im_main_heatcool
-
-!     USE basic_constants_and_equations_mod,                                     &
-!         ONLY:  c_p
-
-    USE control_parameters,                                                                        &
-        ONLY:  time_since_reference_point
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE pegrid
-
-    USE surface_mod,                                                                               &
-        ONLY:  ind_pav_green,                                                                      &
-               ind_veg_wall,                                                                       &
-               ind_wat_win,                                                                        &
-               surf_usm_h,                                                                         &
-               surf_usm_v
-
-    USE urban_surface_mod,                                                                         &
-        ONLY:  building_type,                                                                      &
-               nzt_wall,                                                                           &
-               t_green_h,                                                                          &
-               t_green_v,                                                                          &
-               t_wall_h,                                                                           &
-               t_wall_v,                                                                           &
-               t_window_h,                                                                         &
-               t_window_v
-
-
-    INTEGER(iwp) ::  fa   !< running index for facade elements of each building
-    INTEGER(iwp) ::  i    !< index of facade-adjacent atmosphere grid point in x-direction
-    INTEGER(iwp) ::  j    !< index of facade-adjacent atmosphere grid point in y-direction
-    INTEGER(iwp) ::  k    !< index of facade-adjacent atmosphere grid point in z-direction
-    INTEGER(iwp) ::  kk   !< vertical index of indoor grid point adjacent to facade
-    INTEGER(iwp) ::  l    !< running index for surface-element orientation
-    INTEGER(iwp) ::  m    !< running index surface elements
-    INTEGER(iwp) ::  nb   !< running index for buildings
-
-    LOGICAL  ::  during_spinup                    !< flag indicating that the simulation is still in wall/soil spinup
-
-    REAL(wp) ::  frac_green                       !< dummy for green fraction
-    REAL(wp) ::  frac_wall                        !< dummy for wall fraction
-    REAL(wp) ::  frac_win                         !< dummy for window fraction
-!     REAL(wp) ::  indoor_wall_window_temperature   !< weighted temperature of innermost wall/window layer
-    REAL(wp) ::  indoor_wall_temperature          !< temperature of innermost wall layer evtl in im_calc_temperatures einfÃŒgen
-    REAL(wp) ::  near_facade_temperature          !< outside air temperature 10cm away from facade
-    REAL(wp) ::  second_of_day                    !< second of the current day
-    REAL(wp) ::  time_utc_hour                    !< time of day (hour UTC)
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_in_l_send   !< dummy send buffer used for summing-up indoor temperature per kk-level
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_in_recv     !< dummy recv buffer used for summing-up indoor temperature per kk-level
-!
-!-- Determine time of day in hours.
-    CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
-    time_utc_hour = second_of_day / seconds_per_hour
-!
-!-- Check if the simulation is still in wall/soil spinup mode
-    during_spinup = MERGE( .TRUE., .FALSE., time_since_reference_point < 0.0_wp )
-!
-!-- Following calculations must be done for each facade element.
-    DO  nb = 1, num_build
-!
-!--    First, check whether building is present on local subdomain.
-       IF ( buildings(nb)%on_pe )  THEN
-!
-!--       Determine daily schedule. 08:00-18:00 = 1, other hours = 0.
-!--       Residental Building, panel WBS 70
-          IF ( buildings(nb)%ventilation_int_loads == 1 )  THEN
-             IF ( time_utc_hour >= 8.0_wp  .AND.  time_utc_hour <= 18.0_wp )  THEN
-                schedule_d = 0
-             ELSE
-                schedule_d = 1
-             ENDIF
-          ENDIF
-!
-!--       Office, building with large windows
-          IF ( buildings(nb)%ventilation_int_loads == 2 )  THEN
-             IF ( time_utc_hour >= 8.0_wp  .AND.  time_utc_hour <= 18.0_wp )  THEN
-                schedule_d = 1
-             ELSE
-                schedule_d = 0
-             ENDIF
-          ENDIF
-!
-!--       Industry, hospitals
-          IF ( buildings(nb)%ventilation_int_loads == 3 )  THEN
-             IF ( time_utc_hour >= 6.0_wp  .AND.  time_utc_hour <= 22.0_wp )  THEN
-                schedule_d = 1
-             ELSE
-                schedule_d = 0
-             ENDIF
-          ENDIF
-!
-!--       Initialize/reset indoor temperature - note, this is only for output
-          buildings(nb)%t_in_l = 0.0_wp
-!
-!--       Horizontal surfaces
-          DO  fa = 1, buildings(nb)%num_facades_per_building_h_l
-!
-!--          Determine indices where corresponding surface-type information is stored.
-             l = buildings(nb)%l_h(fa)
-             m = buildings(nb)%m_h(fa)
-!
-!--          During spinup set window fraction to zero and add these to wall fraction.
-             frac_win   = MERGE( surf_usm_h(l)%frac(m,ind_wat_win), 0.0_wp, .NOT. during_spinup )
-             frac_wall  = MERGE( surf_usm_h(l)%frac(m,ind_veg_wall),                               &
-                                 surf_usm_h(l)%frac(m,ind_veg_wall) +                              &
-                                 surf_usm_h(l)%frac(m,ind_wat_win),                                &
-                                 .NOT. during_spinup )
-             frac_green = surf_usm_h(l)%frac(m,ind_pav_green)
-!
-!--          Determine building height level index.
-             kk = surf_usm_h(l)%k(m) + surf_usm_h(l)%koff
-!
-!--          Building geometries --> not time-dependent
-             facade_element_area          = dx * dy                               !< [m2] surface area per facade element
-             floor_area_per_facade        = buildings(nb)%fapf                    !< [m2/m2] floor area per facade area
-             indoor_volume_per_facade     = buildings(nb)%vpf(kk)                 !< [m3/m2] indoor air volume per facade area
-             buildings(nb)%area_facade    = facade_element_area *                                  &
-                                            ( buildings(nb)%num_facades_per_building_h +           &
-                                              buildings(nb)%num_facades_per_building_v ) !< [m2] area of total facade
-             window_area_per_facade       = frac_win  * facade_element_area              !< [m2] window area per facade element
-
-             buildings(nb)%net_floor_area = buildings(nb)%vol_tot / ( buildings(nb)%height_storey )
-             total_area                   = buildings(nb)%net_floor_area                            !< [m2] area of all surfaces
-                                                                                                    !< pointing to zone  Eq. (9) according to section 7.2.2.2
-             a_m                          = buildings(nb)%factor_a * total_area *                  &
-                                            ( facade_element_area / buildings(nb)%area_facade ) *  &
-                                            buildings(nb)%lambda_at                                 !< [m2] standard values
-                                                                                                    !< according to Table 12 section 12.3.1.2  (calculate over Eq. (65) according to section 12.3.1.2)
-             c_m                          = buildings(nb)%factor_c * total_area *                  &
-                                            ( facade_element_area / buildings(nb)%area_facade )     !< [J/K] standard values
-                                                                                                    !< according to table 12 section 12.3.1.2 (calculate over Eq. (66) according to section 12.3.1.2)
-!
-!--          Calculation of heat transfer coefficient for transmission --> not time-dependent
-             h_t_es   = window_area_per_facade * buildings(nb)%h_es                                   !< [W/K] only for windows
-
-             h_t_is  = buildings(nb)%area_facade * h_is                                               !< [W/K] with h_is = 3.45 W /
-                                                                                                      !< (m2 K) between surface and air, Eq. (9)
-             h_t_ms  = a_m * h_ms                                                                     !< [W/K] with h_ms = 9.10 W /
-                                                                                                      !< (m2 K) between component and surface, Eq. (64)
-             h_t_wall  = 1.0_wp / ( 1.0_wp / ( ( facade_element_area - window_area_per_facade )    &  !< [W/K]
-                                    * buildings(nb)%lambda_layer3 / buildings(nb)%s_layer3 * 0.5_wp &
-                                             ) + 1.0_wp / h_t_ms )                                    !< [W/K] opaque components
-             h_t_wm  = 1.0_wp / ( 1.0_wp / h_t_wall - 1.0_wp / h_t_ms )                               !< [W/K] emmision Eq. (63),
-                                                                                                      !< Section 12.2.2
-!
-!--          Internal air loads dependent on the occupacy of the room.
-!--          Basical internal heat gains (qint_low) with additional internal heat gains by occupancy (qint_high) (0,5*phi_int).
-             phi_ia = 0.5_wp * ( ( buildings(nb)%qint_high * schedule_d + buildings(nb)%qint_low ) &
-                              * floor_area_per_facade )
-             q_int = phi_ia / total_area
-!
-!--          Airflow dependent on the occupacy of the room.
-!--          Basical airflow (air_change_low) with additional airflow gains by occupancy (air_change_high)
-             air_change = ( buildings(nb)%air_change_high * schedule_d + buildings(nb)%air_change_low )  !< [1/h]?
-!
-!--          Heat transfer of ventilation.
-!--          Not less than 0.01 W/K to avoid division by 0 in further calculations with heat
-!--          capacity of air 0.33 Wh/m2K.
-             h_v   = MAX( 0.01_wp , ( air_change * indoor_volume_per_facade *                      &
-                                      0.33_wp * (1.0_wp - buildings(nb)%eta_ve ) ) )    !< [W/K] from ISO 13789 Eq.(10)
-
-!--          Heat transfer coefficient auxiliary variables
-             h_t_1 = 1.0_wp / ( ( 1.0_wp / h_v )   + ( 1.0_wp / h_t_is ) )  !< [W/K] Eq. (C.6)
-             h_t_2 = h_t_1 + h_t_es                                         !< [W/K] Eq. (C.7)
-             h_t_3 = 1.0_wp / ( ( 1.0_wp / h_t_2 ) + ( 1.0_wp / h_t_ms ) )  !< [W/K] Eq. (C.8)
-!
-!--          Net short-wave radiation through window area (was i_global)
-             net_sw_in = surf_usm_h(l)%rad_sw_in(m) - surf_usm_h(l)%rad_sw_out(m)
-!
-!--          Quantities needed for im_calc_temperatures
-             i = surf_usm_h(l)%i(m)
-             j = surf_usm_h(l)%j(m)
-             k = surf_usm_h(l)%k(m)
-             near_facade_temperature = surf_usm_h(l)%pt_10cm(m)
-!              indoor_wall_window_temperature = frac_wall  * t_wall_h(l)%val(nzt_wall,m)             &
-!                                             + frac_win   * t_window_h(l)%val(nzt_wall,m)           &
-!                                             + frac_green * t_green_h(l)%val(nzt_wall,m)
-             indoor_wall_temperature = frac_wall  * t_wall_h(l)%val(nzt_wall,m)                    &
-                                     + frac_win   * t_window_h(l)%val(nzt_wall,m)                  &
-                                     + frac_green * t_green_h(l)%val(nzt_wall,m)
-!
-!--          Solar thermal gains. If net_sw_in larger than sun-protection threshold parameter
-!--          (params_solar_protection), sun protection will be activated.
-             IF ( net_sw_in <= params_solar_protection )  THEN
-                solar_protection_off = 1
-                solar_protection_on  = 0
-             ELSE
-                solar_protection_off = 0
-                solar_protection_on  = 1
-             ENDIF
-!
-!--          Calculation of total heat gains from net_sw_in through windows [W] in respect on
-!--          automatic sun protection.
-!--          DIN 4108 - 2 chap.8
-             phi_sol = (   window_area_per_facade * net_sw_in * solar_protection_off               &
-                         + window_area_per_facade * net_sw_in * buildings(nb)%f_c_win *            &
-                           solar_protection_on )                                                   &
-                       * buildings(nb)%g_value_win * ( 1.0_wp - params_f_f ) * params_f_w
-             q_sol = phi_sol
-!
-!--          Calculation of the mass specific thermal load for internal and external heatsources of
-!--          the inner node.
-             phi_m   = (a_m / total_area) * ( phi_ia + phi_sol )                                    !< [W] Eq. (C.2) with
-                                                                                                    !< phi_ia=0,5*phi_int
-             q_c_m = phi_m
-!
-!--          Calculation mass specific thermal load implied non thermal mass
-             phi_st  =   ( 1.0_wp - ( a_m / total_area ) - ( h_t_es / ( 9.1_wp * total_area ) ) )  &
-                       * ( phi_ia + phi_sol )                                                       !< [W] Eq. (C.3) with
-                                                                                                    !< phi_ia=0,5*phi_int
-             q_c_st = phi_st
-!
-!--          Calculations for deriving indoor temperature and heat flux into the wall
-!--          Step 1: indoor temperature without heating and cooling
-!--          section C.4.1 Picture C.2 zone 3)
-             phi_hc_nd = 0.0_wp
-
-             CALL  im_calc_temperatures ( i, j, k, indoor_wall_temperature, &
-                                          near_facade_temperature, phi_hc_nd, buildings(nb)%theta_m_t_prev_h(fa) )
-!
-!--          If air temperature between border temperatures of heating and cooling, assign output
-!--          variable, then ready.
-             IF ( buildings(nb)%theta_int_h_set <= theta_air  .AND.                                &
-                  theta_air <= buildings(nb)%theta_int_c_set )  THEN
-                phi_hc_nd_ac = 0.0_wp
-                phi_hc_nd    = phi_hc_nd_ac
-                theta_air_ac = theta_air
-!
-!--          Step 2: Else, apply 10 W/m2 heating/cooling power and calculate indoor temperature
-!--          again.
-             ELSE
-!
-!--             Temperature not correct, calculation method according to section C4.2
-                theta_air_0 = theta_air                                                  !< temperature without heating/cooling
-!
-!--             Heating or cooling?
-                IF ( theta_air_0 > buildings(nb)%theta_int_c_set )  THEN
-                   theta_air_set = buildings(nb)%theta_int_c_set
-                ELSE
-                   theta_air_set = buildings(nb)%theta_int_h_set
-                ENDIF
-!
-!--             Calculate the temperature with phi_hc_nd_10
-                phi_hc_nd_10 = 10.0_wp * floor_area_per_facade
-                phi_hc_nd    = phi_hc_nd_10
-
-                CALL  im_calc_temperatures ( i, j, k, indoor_wall_temperature, &
-                                             near_facade_temperature, phi_hc_nd, buildings(nb)%theta_m_t_prev_h(fa) )
-                theta_air_10 = theta_air                                                !< temperature with 10 W/m2 of heating
-!
-!--             Avoid division by zero at first timestep where the denominator can become zero.
-                IF ( ABS( theta_air_10  - theta_air_0 ) < 1E-10_wp )  THEN
-                   phi_hc_nd_un = phi_hc_nd_10
-                ELSE
-                   phi_hc_nd_un = phi_hc_nd_10 * ( theta_air_set - theta_air_0 )                   &
-                                               / ( theta_air_10  - theta_air_0 )             !< Eq. (C.13)
-                ENDIF
-!
-!--             Step 3: with temperature ratio to determine the heating or cooling capacity.
-!--             If necessary, limit the power to maximum power.
-!--             section C.4.1 Picture C.2 zone 2) and 4)
-                buildings(nb)%phi_c_max = buildings(nb)%q_c_max * floor_area_per_facade
-                buildings(nb)%phi_h_max = buildings(nb)%q_h_max * floor_area_per_facade
-                IF ( buildings(nb)%phi_c_max < phi_hc_nd_un  .AND.                                 &
-                     phi_hc_nd_un < buildings(nb)%phi_h_max )  THEN
-                   phi_hc_nd_ac = phi_hc_nd_un
-                   phi_hc_nd = phi_hc_nd_un
-                ELSE
-!
-!--             Step 4: inner temperature with maximum heating (phi_hc_nd_un positive) or cooling
-!--                     (phi_hc_nd_un negative)
-!--             section C.4.1 Picture C.2 zone 1) and 5)
-                   IF ( phi_hc_nd_un > 0.0_wp )  THEN
-                      phi_hc_nd_ac = buildings(nb)%phi_h_max                            !< Limit heating
-                   ELSE
-                      phi_hc_nd_ac = buildings(nb)%phi_c_max                            !< Limit cooling
-                   ENDIF
-                ENDIF
-                phi_hc_nd = phi_hc_nd_ac
-!
-!--             Calculate the temperature with phi_hc_nd_ac (new)
-                CALL  im_calc_temperatures ( i, j, k, indoor_wall_temperature, &
-                                             near_facade_temperature, phi_hc_nd, buildings(nb)%theta_m_t_prev_h(fa) )
-                theta_air_ac = theta_air
-             ENDIF
-!
-!--          Update theta_m_t_prev
-             buildings(nb)%theta_m_t_prev_h(fa) = theta_m_t
-
-
-             q_vent = h_v * ( theta_air - near_facade_temperature )
-!
-!--          Calculate the operating temperature with weighted mean temperature of air and mean
-!--          solar temperature.
-!--          Will be used for thermal comfort calculations.
-             theta_op     = 0.3_wp * theta_air_ac + 0.7_wp * theta_s          !< [degree_C] operative Temperature Eq. (C.12)
-
-!              surf_usm_h(l)%t_indoor(m) = theta_op                               !< not integrated now
-!
-!--          Heat flux into the wall. Value needed in urban_surface_mod to
-!--          calculate heat transfer through wall layers towards the facade
-!--          (use c_p * rho_surface to convert [W/m2] into [K m/s])
-             IF ( (facade_element_area - window_area_per_facade) > 0.0_wp )  THEN
-                q_wall = h_t_wm * ( indoor_wall_temperature - theta_m )                 &
-                                    / ( facade_element_area - window_area_per_facade )
-             ELSE
-                q_wall = 0.0_wp
-             ENDIF
-
-             IF ( window_area_per_facade > 0.0_wp )  THEN
-                q_win = h_t_es * ( pt(k,j,i) - theta_s ) / ( window_area_per_facade )
-             ELSE
-                q_win = 0.0_wp
-             ENDIF
-!
-!--          Transfer q_wall & q_win back to USM (innermost wall/window layer)
-             surf_usm_h(l)%iwghf_eb(m)        = - q_wall
-             surf_usm_h(l)%iwghf_eb_window(m) = - q_win
-!
-!--          Sum up operational indoor temperature per kk-level. Further below, this temperature is
-!--          reduced by MPI to one temperature per kk-level and building (processor overlapping).
-             buildings(nb)%t_in_l(kk) = buildings(nb)%t_in_l(kk) + theta_op
-!
-!--          Calculation of waste heat.
-!--          Anthropogenic heat output.
-             IF ( phi_hc_nd_ac > 0.0_wp )  THEN
-                heating_on = 1
-                cooling_on = 0
-             ELSE
-                heating_on = 0
-                cooling_on = -1
-             ENDIF
-
-             q_waste_heat = ( phi_hc_nd * (                                                        &
-                              buildings(nb)%params_waste_heat_h * heating_on +                     &
-                              buildings(nb)%params_waste_heat_c * cooling_on )                     &
-                            ) / facade_element_area  !< [W/m2] , observe the directional convention in PALM!
-!
-!--          Store waste heat and previous previous indoor temperature on surface-data type.
-!--          These will be used in the urban-surface model.
-             surf_usm_h(l)%t_prev(m) = buildings(nb)%theta_m_t_prev_h(fa)
-             surf_usm_h(l)%waste_heat(m) = q_waste_heat
-          ENDDO !< Horizontal surfaces loop
-!
-!--       Vertical surfaces
-          DO  fa = 1, buildings(nb)%num_facades_per_building_v_l
-!
-!--          Determine indices where corresponding surface-type information is stored.
-             l = buildings(nb)%l_v(fa)
-             m = buildings(nb)%m_v(fa)
-
-!
-!--          During spinup set window fraction to zero and add these to wall fraction.
-             frac_win   = MERGE( surf_usm_v(l)%frac(m,ind_wat_win), 0.0_wp, .NOT. during_spinup )
-             frac_wall  = MERGE( surf_usm_v(l)%frac(m,ind_veg_wall),                               &
-                                 surf_usm_v(l)%frac(m,ind_veg_wall) +                              &
-                                 surf_usm_v(l)%frac(m,ind_wat_win),                                &
-                                 .NOT. during_spinup )
-             frac_green = surf_usm_v(l)%frac(m,ind_pav_green)
-!
-!--          Determine building height level index.
-             kk = surf_usm_v(l)%k(m) + surf_usm_v(l)%koff
-!
-!--          (SOME OF THE FOLLOWING (not time-dependent) COULD PROBABLY GO INTO A FUNCTION
-!--          EXCEPT facade_element_area, EVERYTHING IS CALCULATED EQUALLY)
-!--          Building geometries  --> not time-dependent
-             IF ( l == 0  .OR. l == 1 ) facade_element_area = dx * dzw(kk+1)    !< [m2] surface area per facade element
-             IF ( l == 2  .OR. l == 3 ) facade_element_area = dy * dzw(kk+1)    !< [m2] surface area per facade element
-
-             floor_area_per_facade        = buildings(nb)%fapf                  !< [m2/m2] floor area per facade area
-             indoor_volume_per_facade     = buildings(nb)%vpf(kk)               !< [m3/m2] indoor air volume per facade area
-             buildings(nb)%area_facade    = facade_element_area *                                  &
-                                            ( buildings(nb)%num_facades_per_building_h +           &
-                                              buildings(nb)%num_facades_per_building_v )  !< [m2] area of total facade
-             window_area_per_facade       = frac_win * facade_element_area                !< [m2] window area per facade element
-
-             buildings(nb)%net_floor_area = buildings(nb)%vol_tot / ( buildings(nb)%height_storey )
-             total_area                   = buildings(nb)%net_floor_area                              !< [m2] area of all surfaces
-                                                                                                      !< pointing to zone  Eq. (9) according to section 7.2.2.2
-             a_m                          = buildings(nb)%factor_a * total_area *                  &
-                                            ( facade_element_area / buildings(nb)%area_facade ) *  &
-                                              buildings(nb)%lambda_at                                 !< [m2] standard values
-                                                                                                      !< according to Table 12 section 12.3.1.2  (calculate over Eq. (65) according to section 12.3.1.2)
-             c_m                          = buildings(nb)%factor_c * total_area *                   &
-                                            ( facade_element_area / buildings(nb)%area_facade )       !< [J/K] standard values
-                                                                                                      !< according to table 12 section 12.3.1.2 (calculate over Eq. (66) according to section 12.3.1.2)
-!
-!--          Calculation of heat transfer coefficient for transmission --> not time-dependent
-             h_t_es   = window_area_per_facade * buildings(nb)%h_es                                   !< [W/K] only for windows
-
-             h_t_is  = buildings(nb)%area_facade  * h_is                                              !< [W/K] with h_is = 3.45 W /
-                                                                                                      !< (m2 K) between surface and air, Eq. (9)
-             h_t_ms  = a_m * h_ms                                                                     !< [W/K] with h_ms = 9.10 W /
-                                                                                                      !< (m2 K) between component and surface, Eq. (64)
-             h_t_wall  = 1.0_wp / ( 1.0_wp / ( ( facade_element_area - window_area_per_facade )    &  !< [W/K]
-                                    * buildings(nb)%lambda_layer3 / buildings(nb)%s_layer3 * 0.5_wp &
-                                             ) + 1.0_wp / h_t_ms )                                    !< [W/K] opaque components
-             h_t_wm  = 1.0_wp / ( 1.0_wp / h_t_wall - 1.0_wp / h_t_ms )                               !< [W/K] emmision Eq. (63), Section 12.2.2
-!
-!--          Internal air loads dependent on the occupacy of the room.
-!--          Basical internal heat gains (qint_low) with additional internal heat gains by occupancy
-!--          (qint_high) (0,5*phi_int)
-             phi_ia = 0.5_wp * ( ( buildings(nb)%qint_high * schedule_d + buildings(nb)%qint_low ) &
-                             * floor_area_per_facade )
-             q_int = phi_ia
-
-!
-!--          Airflow dependent on the occupacy of the room.
-!--          Basical airflow (air_change_low) with additional airflow gains by occupancy
-!--          (air_change_high)
-             air_change = ( buildings(nb)%air_change_high * schedule_d +                           &
-                            buildings(nb)%air_change_low )
-!
-!--          Heat transfer of ventilation.
-!--          Not less than 0.01 W/K to avoid division by 0 in further calculations with heat
-!--          capacity of air 0.33 Wh/m2K
-             h_v   = MAX( 0.01_wp , ( air_change * indoor_volume_per_facade *                      &
-                                    0.33_wp * (1.0_wp - buildings(nb)%eta_ve ) ) )                    !< [W/K] from ISO 13789
-                                                                                                      !< Eq.(10)
-
-!--          Heat transfer coefficient auxiliary variables
-             h_t_1 = 1.0_wp / ( ( 1.0_wp / h_v )   + ( 1.0_wp / h_t_is ) )                            !< [W/K] Eq. (C.6)
-             h_t_2 = h_t_1 + h_t_es                                                                   !< [W/K] Eq. (C.7)
-             h_t_3 = 1.0_wp / ( ( 1.0_wp / h_t_2 ) + ( 1.0_wp / h_t_ms ) )                            !< [W/K] Eq. (C.8)
-!
-!--          Net short-wave radiation through window area (was i_global)
-             net_sw_in = surf_usm_v(l)%rad_sw_in(m) - surf_usm_v(l)%rad_sw_out(m)
-!
-!--          Quantities needed for im_calc_temperatures
-             i = surf_usm_v(l)%i(m)
-             j = surf_usm_v(l)%j(m)
-             k = surf_usm_v(l)%k(m)
-             near_facade_temperature = surf_usm_v(l)%pt_10cm(m)
-
-!              indoor_wall_window_temperature = frac_wall  * t_wall_v(l)%val(nzt_wall,m)             &
-!                                             + frac_win   * t_window_v(l)%val(nzt_wall,m)           &
-!                                             + frac_green * t_green_v(l)%val(nzt_wall,m)
-
-             indoor_wall_temperature = frac_wall  * t_wall_v(l)%val(nzt_wall,m)                    &
-                                     + frac_win   * t_window_v(l)%val(nzt_wall,m)                  &
-                                     + frac_green * t_green_v(l)%val(nzt_wall,m)
-
-!
-!--          Solar thermal gains. If net_sw_in larger than sun-protection
-!--          threshold parameter (params_solar_protection), sun protection will
-!--          be activated
-             IF ( net_sw_in <= params_solar_protection )  THEN
-                solar_protection_off = 1
-                solar_protection_on  = 0
-             ELSE
-                solar_protection_off = 0
-                solar_protection_on  = 1
-             ENDIF
-!
-!--          Calculation of total heat gains from net_sw_in through windows [W] in respect on
-!--          automatic sun protection.
-!--          DIN 4108 - 2 chap.8
-             phi_sol = (   window_area_per_facade * net_sw_in * solar_protection_off               &
-                         + window_area_per_facade * net_sw_in * buildings(nb)%f_c_win *            &
-                           solar_protection_on )                                                   &
-                       * buildings(nb)%g_value_win * ( 1.0_wp - params_f_f ) * params_f_w
-             q_sol = phi_sol
-!
-!--          Calculation of the mass specific thermal load for internal and external heatsources.
-             phi_m   = (a_m / total_area) * ( phi_ia + phi_sol )          !< [W] Eq. (C.2) with phi_ia=0,5*phi_int
-             q_c_m = phi_m
-!
-!--          Calculation mass specific thermal load implied non thermal mass.
-             phi_st  =   ( 1.0_wp - ( a_m / total_area ) - ( h_t_es / ( 9.1_wp * total_area ) ) )  &
-                       * ( phi_ia + phi_sol )                                                       !< [W] Eq. (C.3) with
-                                                                                                    !< phi_ia=0,5*phi_int
-             q_c_st = phi_st
-!
-!--          Calculations for deriving indoor temperature and heat flux into the wall.
-!--          Step 1: indoor temperature without heating and cooling.
-!--          section C.4.1 Picture C.2 zone 3)
-             phi_hc_nd = 0.0_wp
-             CALL im_calc_temperatures ( i, j, k, indoor_wall_temperature, &
-                                         near_facade_temperature, phi_hc_nd, buildings(nb)%theta_m_t_prev_v(fa) )
-!
-!--          If air temperature between border temperatures of heating and cooling, assign output
-!--          variable, then ready.
-             IF ( buildings(nb)%theta_int_h_set <= theta_air  .AND.                                &
-                  theta_air <= buildings(nb)%theta_int_c_set )  THEN
-                phi_hc_nd_ac = 0.0_wp
-                phi_hc_nd    = phi_hc_nd_ac
-                theta_air_ac = theta_air
-!
-!--          Step 2: Else, apply 10 W/m2 heating/cooling power and calculate indoor temperature
-!--          again.
-             ELSE
-!
-!--             Temperature not correct, calculation method according to section C4.2
-                theta_air_0 = theta_air !< Note temperature without heating/cooling
-!
-!--             Heating or cooling?
-                IF ( theta_air_0 > buildings(nb)%theta_int_c_set )  THEN
-                   theta_air_set = buildings(nb)%theta_int_c_set
-                ELSE
-                   theta_air_set = buildings(nb)%theta_int_h_set
-                ENDIF
-
-!--             Calculate the temperature with phi_hc_nd_10
-                phi_hc_nd_10 = 10.0_wp * floor_area_per_facade
-                phi_hc_nd    = phi_hc_nd_10
-
-                CALL  im_calc_temperatures ( i, j, k, indoor_wall_temperature, &
-                                             near_facade_temperature, phi_hc_nd, buildings(nb)%theta_m_t_prev_v(fa) )
-
-                theta_air_10 = theta_air !< Note the temperature with 10 W/m2 of heating
-!
-!--             Avoid division by zero at first timestep where the denominator can become zero.
-                IF ( ABS( theta_air_10  - theta_air_0 ) < 1E-10_wp )  THEN
-                   phi_hc_nd_un = phi_hc_nd_10
-                ELSE
-                   phi_hc_nd_un = phi_hc_nd_10 * ( theta_air_set - theta_air_0 )                   &
-                                               / ( theta_air_10  - theta_air_0 )             !< Eq. (C.13)
-                ENDIF
-!
-!--             Step 3: with temperature ratio to determine the heating or cooling capacity
-!--             If necessary, limit the power to maximum power.
-!--             section C.4.1 Picture C.2 zone 2) and 4)
-                buildings(nb)%phi_c_max = buildings(nb)%q_c_max * floor_area_per_facade
-                buildings(nb)%phi_h_max = buildings(nb)%q_h_max * floor_area_per_facade
-                IF ( buildings(nb)%phi_c_max < phi_hc_nd_un  .AND.                                 &
-                     phi_hc_nd_un < buildings(nb)%phi_h_max )  THEN
-                   phi_hc_nd_ac = phi_hc_nd_un
-                   phi_hc_nd = phi_hc_nd_un
-                ELSE
-!
-!--             Step 4: inner temperature with maximum heating (phi_hc_nd_un positive) or cooling
-!--                     (phi_hc_nd_un negative)
-!--             section C.4.1 Picture C.2 zone 1) and 5)
-                   IF ( phi_hc_nd_un > 0.0_wp )  THEN
-                      phi_hc_nd_ac = buildings(nb)%phi_h_max                                         !< Limit heating
-                   ELSE
-                      phi_hc_nd_ac = buildings(nb)%phi_c_max                                         !< Limit cooling
-                   ENDIF
-                ENDIF
-                phi_hc_nd = phi_hc_nd_ac
-!
-!--             Calculate the temperature with phi_hc_nd_ac (new)
-                CALL  im_calc_temperatures ( i, j, k, indoor_wall_temperature, &
-                                             near_facade_temperature, phi_hc_nd, buildings(nb)%theta_m_t_prev_v(fa) )
-                theta_air_ac = theta_air
-             ENDIF
-!
-!--          Update theta_m_t_prev
-             buildings(nb)%theta_m_t_prev_v(fa) = theta_m_t
-
-
-             q_vent = h_v * ( theta_air - near_facade_temperature )
-!
-!--          Calculate the operating temperature with weighted mean of temperature of air and mean.
-!--          Will be used for thermal comfort calculations.
-             theta_op     = 0.3_wp * theta_air_ac + 0.7_wp * theta_s
-
-!              surf_usm_v(l)%t_indoor(m) = theta_op                  !< not integrated yet
-!
-!--          Heat flux into the wall. Value needed in urban_surface_mod to
-!--          calculate heat transfer through wall layers towards the facade
-             IF ( (facade_element_area - window_area_per_facade) > 0.0_wp )  THEN
-                q_wall = h_t_wm * ( indoor_wall_temperature - theta_m )                 &
-                                    / ( facade_element_area - window_area_per_facade )
-             ELSE
-                q_wall = 0.0_wp
-             ENDIF
-
-             IF ( window_area_per_facade > 0.0_wp )  THEN
-                q_win = h_t_es * ( pt(k,j,i) - theta_s ) / ( window_area_per_facade )
-             ELSE
-                q_win = 0.0_wp
-             ENDIF
-
-!
-!--          Transfer q_wall & q_win back to USM (innermost wall/window layer)
-             surf_usm_v(l)%iwghf_eb(m)        = - q_wall
-             surf_usm_v(l)%iwghf_eb_window(m) = - q_win
-
-!              print*, "wwfjg", surf_usm_v(l)%iwghf_eb(m), surf_usm_v(l)%iwghf_eb_window(m)
-!
-!--          Sum up operational indoor temperature per kk-level. Further below, this temperature is
-!--          reduced by MPI to one temperature per kk-level and building (processor overlapping).
-             buildings(nb)%t_in_l(kk) = buildings(nb)%t_in_l(kk) + theta_op
-!
-!--          Calculation of waste heat.
-!--          Anthropogenic heat output.
-             IF ( phi_hc_nd_ac > 0.0_wp )  THEN
-                heating_on = 1
-                cooling_on = 0
-             ELSE
-                heating_on = 0
-                cooling_on = -1
-             ENDIF
-
-             q_waste_heat = ( phi_hc_nd * ( buildings(nb)%params_waste_heat_h * heating_on +       &
-                                            buildings(nb)%params_waste_heat_c * cooling_on )       &
-                            ) / facade_element_area  !< [W/m2] , observe the directional convention in PALM!
-!
-!--          Store waste heat and previous previous indoor temperature on surface-data type.
-!--          These will be used in the urban-surface model.
-             surf_usm_v(l)%t_prev(m)     = buildings(nb)%theta_m_t_prev_v(fa)
-             surf_usm_v(l)%waste_heat(m) = q_waste_heat
-          ENDDO !< Vertical surfaces loop
-       ENDIF !< buildings(nb)%on_pe
-    ENDDO !< buildings loop
-
-!
-!-- Determine the mean building temperature.
-    DO  nb = 1, num_build
-!
-!--    Allocate dummy array used for summing-up facade elements.
-!--    Please note, dummy arguments are necessary as building-date type arrays are not necessarily
-!--    allocated on all PEs.
-       ALLOCATE( t_in_l_send(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-       ALLOCATE( t_in_recv(buildings(nb)%kb_min:buildings(nb)%kb_max) )
-       t_in_l_send = 0.0_wp
-       t_in_recv   = 0.0_wp
-
-       IF ( buildings(nb)%on_pe )  THEN
-          t_in_l_send = buildings(nb)%t_in_l
-       ENDIF
-
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( t_in_l_send,                                                            &
-                           t_in_recv,                                                              &
-                           buildings(nb)%kb_max - buildings(nb)%kb_min + 1,                        &
-                           MPI_REAL,                                                               &
-                           MPI_SUM,                                                                &
-                           comm2d,                                                                 &
-                           ierr )
-
-       IF ( ALLOCATED( buildings(nb)%t_in ) )  buildings(nb)%t_in = t_in_recv
-#else
-       IF ( ALLOCATED( buildings(nb)%t_in ) )  buildings(nb)%t_in = buildings(nb)%t_in_l
-#endif
-
-       IF ( ALLOCATED( buildings(nb)%t_in ) )  THEN
-!
-!--       Average indoor temperature. Note, in case a building is completely surrounded by higher
-!--       buildings, it may have no facade elements at some height levels, which will lead to a
-!--       division by zero.
-          DO  k = buildings(nb)%kb_min, buildings(nb)%kb_max
-             IF ( buildings(nb)%num_facade_h(k) + buildings(nb)%num_facade_v(k) > 0 )  THEN
-                buildings(nb)%t_in(k) = buildings(nb)%t_in(k) /                                    &
-                                        REAL( buildings(nb)%num_facade_h(k) +                      &
-                                              buildings(nb)%num_facade_v(k), KIND = wp )
-             ENDIF
-          ENDDO
-!
-!--       If indoor temperature is not defined because of missing facade elements, the values from
-!--       the above-lying level will be taken.
-!--       At least at the top of the buildings facades are defined, so that at least there an indoor
-!--       temperature is defined. This information will propagate downwards the building.
-          DO  k = buildings(nb)%kb_max-1, buildings(nb)%kb_min, -1
-             IF ( buildings(nb)%num_facade_h(k) + buildings(nb)%num_facade_v(k) <= 0 )  THEN
-                buildings(nb)%t_in(k) = buildings(nb)%t_in(k+1)
-             ENDIF
-          ENDDO
-       ENDIF
-
-
-!
-!--    Deallocate dummy arrays
-       DEALLOCATE( t_in_l_send )
-       DEALLOCATE( t_in_recv )
-
-    ENDDO
-
- END SUBROUTINE im_main_heatcool
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-!-------------
-!> Check data output for plant canopy model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE im_check_data_output( var, unit )
-
-    CHARACTER (LEN=*) ::  unit   !<
-    CHARACTER (LEN=*) ::  var    !<
-
-    SELECT CASE ( TRIM( var ) )
-
-
-        CASE ( 'im_hf_roof')
-           unit = 'W m-2'
-
-        CASE ( 'im_hf_wall_win' )
-           unit = 'W m-2'
-
-        CASE ( 'im_hf_wall_win_waste' )
-           unit = 'W m-2'
-
-        CASE ( 'im_hf_roof_waste' )
-           unit = 'W m-2'
-
-        CASE ( 'im_t_indoor_mean' )
-           unit = 'K'
-
-        CASE ( 'im_t_indoor_roof' )
-           unit = 'K'
-
-        CASE ( 'im_t_indoor_wall_win' )
-           unit = 'K'
-
-        CASE ( 'im_t_indoor_wall' )
-           unit = 'K'
-
-        CASE DEFAULT
-           unit = 'illegal'
-
-    END SELECT
-
- END SUBROUTINE
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-!-------------
-!> Check parameters routine for plant canopy model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE im_check_parameters
-
-!   USE control_parameters,
-!       ONLY: message_string
-
- END SUBROUTINE im_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-!-------------
-!> Subroutine defining appropriate grid for netcdf variables.
-!> It is called from subroutine netcdf.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE im_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_x
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z
-    CHARACTER (LEN=*), INTENT(IN)  ::  var
-
-    LOGICAL, INTENT(OUT)           ::  found
-
-
-    found   = .TRUE.
-!
-!-- Check for the grid
-    SELECT CASE ( TRIM( var ) )
-
-       CASE ( 'im_hf_roof', 'im_hf_roof_waste' )
-          grid_x = 'x'
-          grid_y = 'y'
-          grid_z = 'zw'
-!
-!--    Heat fluxes at vertical walls are actually defined on stagged grid, i.e. xu, yv.
-       CASE ( 'im_hf_wall_win', 'im_hf_wall_win_waste' )
-          grid_x = 'x'
-          grid_y = 'y'
-          grid_z = 'zu'
-
-       CASE ( 'im_t_indoor_mean', 'im_t_indoor_roof', 'im_t_indoor_wall_win', 'indoor_wall' )
-          grid_x = 'x'
-          grid_y = 'y'
-          grid_z = 'zw'
-
-       CASE DEFAULT
-          found  = .FALSE.
-          grid_x = 'none'
-          grid_y = 'none'
-          grid_z = 'none'
-    END SELECT
-
- END SUBROUTINE im_define_netcdf_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defining 3D output variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE im_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-
-    USE indices
-
-    USE kinds
-
-    CHARACTER (LEN=*) ::  variable !<
-
-    INTEGER(iwp) ::  av    !<
-    INTEGER(iwp) ::  i     !<
-    INTEGER(iwp) ::  j     !<
-    INTEGER(iwp) ::  k     !<
-    INTEGER(iwp) ::  l     !<
-    INTEGER(iwp) ::  m     !<
-    INTEGER(iwp) ::  nb    !< index of the building in the building data structure
-    INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
-    INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
-
-    LOGICAL      ::  found !<
-
-    REAL(wp), INTENT(IN) ::  fill_value !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
-
-    local_pf = fill_value
-
-    found = .TRUE.
-
-    SELECT CASE ( TRIM( variable ) )
-!
-!--     Output of indoor temperature. All grid points within the building are filled with values,
-!--     while atmospheric grid points are set to _FillValues.
-        CASE ( 'im_t_indoor_mean' )
-           IF ( av == 0 ) THEN
-              DO  i = nxl, nxr
-                 DO  j = nys, nyn
-                    IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
-!
-!--                    Determine index of the building within the building data structure.
-                       nb = MINLOC( ABS( buildings(:)%id - building_id_f%var(j,i) ), DIM=1 )
-                       IF ( buildings(nb)%on_pe )  THEN
-!
-!--                       Write mean building temperature onto output array. Please note, in
-!--                       contrast to many other loops in the output, the vertical bounds are
-!--                       determined by the lowest and hightest vertical index occupied by the
-!--                       building.
-                          DO  k = buildings(nb)%kb_min, buildings(nb)%kb_max
-                             local_pf(i,j,k) = buildings(nb)%t_in(k)
-                          ENDDO
-                       ENDIF
-                    ENDIF
-                 ENDDO
-              ENDDO
-           ENDIF
-
-        CASE ( 'im_hf_roof' )
-           IF ( av == 0 )  THEN
-              DO  m = 1, surf_usm_h(0)%ns
-                 i = surf_usm_h(0)%i(m) !+ surf_usm_h%ioff
-                 j = surf_usm_h(0)%j(m) !+ surf_usm_h%joff
-                 k = surf_usm_h(0)%k(m) !+ surf_usm_h%koff
-                 local_pf(i,j,k) = surf_usm_h(0)%iwghf_eb(m)
-              ENDDO
-           ENDIF
-
-        CASE ( 'im_hf_roof_waste' )
-           IF ( av == 0 )  THEN
-              DO m = 1, surf_usm_h(0)%ns
-                 i = surf_usm_h(0)%i(m) !+ surf_usm_h%ioff
-                 j = surf_usm_h(0)%j(m) !+ surf_usm_h%joff
-                 k = surf_usm_h(0)%k(m) !+ surf_usm_h%koff
-                 local_pf(i,j,k) = surf_usm_h(0)%waste_heat(m)
-              ENDDO
-           ENDIF
-
-       CASE ( 'im_hf_wall_win' )
-           IF ( av == 0 )  THEN
-              DO l = 0, 3
-                 DO m = 1, surf_usm_v(l)%ns
-                    i = surf_usm_v(l)%i(m) !+ surf_usm_v(l)%ioff
-                    j = surf_usm_v(l)%j(m) !+ surf_usm_v(l)%joff
-                    k = surf_usm_v(l)%k(m) !+ surf_usm_v(l)%koff
-                    local_pf(i,j,k) = surf_usm_v(l)%iwghf_eb(m)
-                 ENDDO
-              ENDDO
-           ENDIF
-
-        CASE ( 'im_hf_wall_win_waste' )
-           IF ( av == 0 )  THEN
-              DO l = 0, 3
-                 DO m = 1, surf_usm_v(l)%ns
-                    i = surf_usm_v(l)%i(m) !+ surf_usm_v(l)%ioff
-                    j = surf_usm_v(l)%j(m) !+ surf_usm_v(l)%joff
-                    k = surf_usm_v(l)%k(m) !+ surf_usm_v(l)%koff
-                    local_pf(i,j,k) =  surf_usm_v(l)%waste_heat(m)
-                 ENDDO
-              ENDDO
-           ENDIF
-
-!
-!< NOTE im_t_indoor_roof and im_t_indoor_wall_win not work yet
-
-!         CASE ( 'im_t_indoor_roof' )
-!            IF ( av == 0 )  THEN
-!               DO  m = 1, surf_usm_h%ns
-!                   i = surf_usm_h%i(m) !+ surf_usm_h%ioff
-!                   j = surf_usm_h%j(m) !+ surf_usm_h%joff
-!                   k = surf_usm_h%k(m) !+ surf_usm_h%koff
-!                   local_pf(i,j,k) = surf_usm_h%t_indoor(m)
-!               ENDDO
-!            ENDIF
-!
-!         CASE ( 'im_t_indoor_wall_win' )
-!            IF ( av == 0 )  THEN
-!               DO l = 0, 3
-!                  DO m = 1, surf_usm_v(l)%ns
-!                     i = surf_usm_v(l)%i(m) !+ surf_usm_v(l)%ioff
-!                     j = surf_usm_v(l)%j(m) !+ surf_usm_v(l)%joff
-!                     k = surf_usm_v(l)%k(m) !+ surf_usm_v(l)%koff
-!                     local_pf(i,j,k) = surf_usm_v(l)%t_indoor(m)
-!                  ENDDO
-!               ENDDO
-!            ENDIF
-
-        CASE DEFAULT
-           found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE im_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &indoor_parameters for indoor model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE im_parin
-
-    USE control_parameters,                                                                        &
-        ONLY:  indoor_model
-
-
-    CHARACTER(LEN=100) ::  line  !< string containing current line of file PARIN
-
-    INTEGER(iwp)  ::  io_status  !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /indoor_parameters/  indoor_during_spinup,                                            &
-                                  initial_indoor_temperature,                                      &
-                                  switch_off_module
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, indoor_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    indoor_parameters namelist was found and read correctly. Set flag that indicates that the
-!--    indoor model is switched on.
-       IF ( .NOT. switch_off_module )  indoor_model = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    indoor_parameters namelist was found, but contained errors. Print an error message including
-!--    the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'indoor_parameters', line )
-
-    ENDIF
-
-!
-!--    Activate spinup (maybe later
-!        IF ( spinup_time > 0.0_wp )  THEN
-!           coupling_start_time = spinup_time
-!           end_time = end_time + spinup_time
-!           IF ( spinup_pt_mean == 9999999.9_wp )  THEN
-!              spinup_pt_mean = pt_surface
-!           ENDIF
-!           spinup = .TRUE.
-!        ENDIF
-
- END SUBROUTINE im_parin
-
-
-END MODULE indoor_model_mod
Index: palm/trunk/SOURCE/inflow_turbulence.f90
===================================================================
--- palm/trunk/SOURCE/inflow_turbulence.f90	(revision 4901)
+++ 	(revision )
@@ -1,324 +1,0 @@
-!> @file inflow_turbulence.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4429 2020-02-27 15:24:30Z raasch
-! bugfix: cpp-directives added for serial mode
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! use y_shift instead of old parameter recycling_yshift
-!
-! 4297 2019-11-21 10:37:50Z oliver.maas
-! changed recycling_yshift so that the y-shift can be a multiple of PE instead of y-shift of a half
-! domain width
-!
-! 4183 2019-08-23 07:33:16Z oliver.maas
-! simplified steering of recycling of absolute values by initialization parameter
-! recycling_method_for_thermodynamic_quantities
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4172 2019-08-20 11:55:33Z oliver.maas
-! added optional recycling of absolute values for pt and q
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
-! Initial version (2008/03/07)
-!
-! Description:
-! ------------
-!> Imposing turbulence at the respective inflow using the turbulence recycling method of
-!> Kataoka and Mizuno (2002).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE inflow_turbulence
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  e, inflow_damping_factor, mean_inflow_profiles, pt, q, s, u, v, w
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  humidity, passive_scalar, recycling_method_for_thermodynamic_quantities,            &
-               recycling_plane, y_shift
-
-#else
-    USE control_parameters,                                                                        &
-        ONLY:  humidity, passive_scalar, recycling_method_for_thermodynamic_quantities,            &
-               recycling_plane
-
-#endif
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nxl, ny, nyn, nys, nyng, nysg, nzb, nzt
-
-    USE kinds
-
-    USE pegrid
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i        !< loop index
-    INTEGER(iwp) ::  j        !< loop index
-    INTEGER(iwp) ::  k        !< loop index
-    INTEGER(iwp) ::  l        !< loop index
-    INTEGER(iwp) ::  ngp_ifd  !< number of grid points stored in avpr
-    INTEGER(iwp) ::  ngp_pr   !< number of grid points stored in inflow_dist
-#if defined( __parallel )
-    INTEGER(iwp) ::  next     !< ID of receiving PE for y-shift
-    INTEGER(iwp) ::  prev     !< ID of sending PE for y-shift
-#endif
-
-    REAL(wp), DIMENSION(nzb:nzt+1,7,nbgp) ::  avpr               !< stores averaged profiles at recycling plane
-    REAL(wp), DIMENSION(nzb:nzt+1,7,nbgp) ::  avpr_l             !< auxiliary variable to calculate avpr
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,7,nbgp) ::  inflow_dist        !< turbulence signal of vars, added at inflow boundary
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,7,nbgp) ::  local_inflow_dist  !< auxiliary variable for inflow_dist, used for y-shift
-#endif
-
-    CALL cpu_log( log_point(40), 'inflow_turbulence', 'start' )
-
-!
-!-- Carry out spanwise averaging in the recycling plane
-    avpr_l = 0.0_wp
-    ngp_pr = ( nzt - nzb + 2 ) * 7 * nbgp
-    ngp_ifd = ngp_pr * ( nyn - nys + 1 + 2 * nbgp )
-
-!
-!-- First, local averaging within the recycling domain
-    i = recycling_plane
-
-#if defined( __parallel )
-    IF ( myidx == id_recycling )  THEN
-
-       DO  l = 1, nbgp
-          DO  j = nys, nyn
-             DO  k = nzb, nzt + 1
-
-                avpr_l(k,1,l) = avpr_l(k,1,l) + u(k,j,i)
-                avpr_l(k,2,l) = avpr_l(k,2,l) + v(k,j,i)
-                avpr_l(k,3,l) = avpr_l(k,3,l) + w(k,j,i)
-                avpr_l(k,4,l) = avpr_l(k,4,l) + pt(k,j,i)
-                avpr_l(k,5,l) = avpr_l(k,5,l) + e(k,j,i)
-                IF ( humidity )  avpr_l(k,6,l) = avpr_l(k,6,l) + q(k,j,i)
-                IF ( passive_scalar )  avpr_l(k,7,l) = avpr_l(k,7,l) + s(k,j,i)
-
-             ENDDO
-          ENDDO
-          i = i + 1
-       ENDDO
-
-    ENDIF
-!
-!-- Now, averaging over all PEs
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( avpr_l(nzb,1,1), avpr(nzb,1,1), ngp_pr, MPI_REAL, MPI_SUM, comm2d, ierr )
-
-#else
-    DO  l = 1, nbgp
-       DO  j = nys, nyn
-          DO  k = nzb, nzt + 1
-
-             avpr_l(k,1,l) = avpr_l(k,1,l) + u(k,j,i)
-             avpr_l(k,2,l) = avpr_l(k,2,l) + v(k,j,i)
-             avpr_l(k,3,l) = avpr_l(k,3,l) + w(k,j,i)
-             avpr_l(k,4,l) = avpr_l(k,4,l) + pt(k,j,i)
-             avpr_l(k,5,l) = avpr_l(k,5,l) + e(k,j,i)
-             IF ( humidity )  avpr_l(k,6,l) = avpr_l(k,6,l) + q(k,j,i)
-             IF ( passive_scalar )  avpr_l(k,7,l) = avpr_l(k,7,l) + s(k,j,i)
-
-          ENDDO
-       ENDDO
-       i = i + 1
-    ENDDO
-
-    avpr = avpr_l
-#endif
-
-    avpr = avpr / ( ny + 1 )
-!
-!-- Calculate the disturbances at the recycling plane for recycling of absolute quantities, the
-!-- disturbance is defined as the absolute value (and not as the deviation from the mean profile).
-    i = recycling_plane
-
-#if defined( __parallel )
-    IF ( myidx == id_recycling )  THEN
-       DO  l = 1, nbgp
-          DO  j = nysg, nyng
-             DO  k = nzb, nzt + 1
-                inflow_dist(k,j,1,l) = u(k,j,i+1) - avpr(k,1,l)
-                inflow_dist(k,j,2,l) = v(k,j,i)   - avpr(k,2,l)
-                inflow_dist(k,j,3,l) = w(k,j,i)   - avpr(k,3,l)
-                IF ( TRIM( recycling_method_for_thermodynamic_quantities )                         &
-                     == 'turbulent_fluctuation' )  THEN
-                   inflow_dist(k,j,4,l) = pt(k,j,i) - avpr(k,4,l)
-                ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities )                     &
-                         == 'absolute_value' )  THEN
-                   inflow_dist(k,j,4,l) = pt(k,j,i)
-                ENDIF
-                inflow_dist(k,j,5,l) = e(k,j,i)   - avpr(k,5,l)
-                IF ( humidity ) THEN
-                   IF ( TRIM( recycling_method_for_thermodynamic_quantities )                      &
-                        == 'turbulent_fluctuation' )  THEN
-                      inflow_dist(k,j,6,l) = q(k,j,i) - avpr(k,6,l)
-                   ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities )                  &
-                            == 'absolute_value' )  THEN
-                      inflow_dist(k,j,6,l) = q(k,j,i)
-                   ENDIF
-                ENDIF
-                IF ( passive_scalar )                                                              &
-                   inflow_dist(k,j,7,l) = s(k,j,i) - avpr(k,7,l)
-            ENDDO
-          ENDDO
-          i = i + 1
-       ENDDO
-
-    ENDIF
-#else
-    DO  l = 1, nbgp
-       DO  j = nysg, nyng
-          DO  k = nzb, nzt+1
-             inflow_dist(k,j,1,l) = u(k,j,i+1) - avpr(k,1,l)
-             inflow_dist(k,j,2,l) = v(k,j,i)   - avpr(k,2,l)
-             inflow_dist(k,j,3,l) = w(k,j,i)   - avpr(k,3,l)
-             IF ( TRIM( recycling_method_for_thermodynamic_quantities )                            &
-                   == 'turbulent_fluctuation' )  THEN
-                inflow_dist(k,j,4,l) = pt(k,j,i) - avpr(k,4,l)
-             ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities )                        &
-                      == 'absolute_value' )  THEN
-                inflow_dist(k,j,4,l) = pt(k,j,i)
-             ENDIF
-             inflow_dist(k,j,5,l) = e(k,j,i)   - avpr(k,5,l)
-             IF ( humidity )  THEN
-                IF ( TRIM( recycling_method_for_thermodynamic_quantities )                         &
-                     == 'turbulent_fluctuation' )  THEN
-                   inflow_dist(k,j,6,l) = q(k,j,i) - avpr(k,6,l)
-                ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities )                     &
-                         == 'absolute_value' )  THEN
-                   inflow_dist(k,j,6,l) = q(k,j,i)
-                ENDIF
-             ENDIF
-             IF ( passive_scalar )                                                                 &
-                inflow_dist(k,j,7,l) = s(k,j,i) - avpr(k,7,l)
-
-          ENDDO
-       ENDDO
-       i = i + 1
-    ENDDO
-#endif
-
-!
-!-- For parallel runs, send the disturbances to the respective inflow PE
-#if defined( __parallel )
-    IF ( myidx == id_recycling  .AND.  myidx /= id_inflow )  THEN
-
-       CALL MPI_SEND( inflow_dist(nzb,nysg,1,1), ngp_ifd, MPI_REAL, id_inflow, 1, comm1dx, ierr )
-
-    ELSEIF ( myidx /= id_recycling  .AND.  myidx == id_inflow )  THEN
-
-       inflow_dist = 0.0_wp
-       CALL MPI_RECV( inflow_dist(nzb,nysg,1,1), ngp_ifd, MPI_REAL, id_recycling, 1, comm1dx,      &
-                      status, ierr )
-
-    ENDIF
-
-!
-!-- y-shift for inflow_dist
-!-- Shift inflow_dist in positive y direction by a number of
-!-- PEs equal to y_shift
-    IF ( ( y_shift /= 0 )  .AND.  myidx == id_inflow )  THEN
-
-!
-!--    Calculate the ID of the PE which sends data to this PE (prev) and of the PE which receives
-!--    data from this PE (next).
-       prev = MODULO(myidy - y_shift , pdims(2))
-       next = MODULO(myidy + y_shift , pdims(2))
-
-       local_inflow_dist = 0.0_wp
-
-       CALL MPI_SENDRECV( inflow_dist(nzb,nysg,1,1), ngp_ifd, MPI_REAL, next, 1,                   &
-                          local_inflow_dist(nzb,nysg,1,1), ngp_ifd, MPI_REAL, prev, 1, comm1dy,    &
-                          status, ierr )
-
-       inflow_dist = local_inflow_dist
-
-    ENDIF
-
-#endif
-
-!
-!-- Add the disturbance at the inflow
-    IF ( nxl == 0 )  THEN
-
-       DO  j = nysg, nyng
-          DO  k = nzb, nzt + 1
-
-             u(k,j,-nbgp+1:0) = mean_inflow_profiles(k,1) +                                        &
-                                inflow_dist(k,j,1,1:nbgp) * inflow_damping_factor(k)
-             v(k,j,-nbgp:-1)  = mean_inflow_profiles(k,2) +                                        &
-                                inflow_dist(k,j,2,1:nbgp) * inflow_damping_factor(k)
-             w(k,j,-nbgp:-1)  = inflow_dist(k,j,3,1:nbgp) * inflow_damping_factor(k)
-             IF ( TRIM( recycling_method_for_thermodynamic_quantities )                            &
-                   == 'turbulent_fluctuation' )  THEN
-                pt(k,j,-nbgp:-1) = mean_inflow_profiles(k,4) +                                     &
-                                   inflow_dist(k,j,4,1:nbgp) * inflow_damping_factor(k)
-             ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities )                        &
-                      == 'absolute_value' )  THEN
-                pt(k,j,-nbgp:-1) = inflow_dist(k,j,4,1:nbgp)
-             ENDIF
-             e(k,j,-nbgp:-1)  = mean_inflow_profiles(k,5) +                                        &
-                                inflow_dist(k,j,5,1:nbgp) * inflow_damping_factor(k)
-             e(k,j,-nbgp:-1)  = MAX( e(k,j,-nbgp:-1), 0.0_wp )
-             IF ( humidity )  THEN
-                IF ( TRIM( recycling_method_for_thermodynamic_quantities )                         &
-                      == 'turbulent_fluctuation' )  THEN
-                   q(k,j,-nbgp:-1)  = mean_inflow_profiles(k,6) +                                  &
-                                      inflow_dist(k,j,6,1:nbgp) * inflow_damping_factor(k)
-                ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities )                     &
-                         == 'absolute_value' )  THEN
-                   q(k,j,-nbgp:-1)  = inflow_dist(k,j,6,1:nbgp)
-                ENDIF
-             ENDIF
-             IF ( passive_scalar )                                                                 &
-                s(k,j,-nbgp:-1)  = mean_inflow_profiles(k,7) +                                     &
-                                   inflow_dist(k,j,7,1:nbgp) * inflow_damping_factor(k)
-
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-
-    CALL  cpu_log( log_point(40), 'inflow_turbulence', 'stop' )
-
-
- END SUBROUTINE inflow_turbulence
Index: palm/trunk/SOURCE/init_1d_model.f90
===================================================================
--- palm/trunk/SOURCE/init_1d_model.f90	(revision 1)
+++ palm/trunk/SOURCE/init_1d_model.f90	(revision 1)
@@ -0,0 +1,1019 @@
+ SUBROUTINE init_1d_model
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: init_1d_model.f90,v $
+! Revision 1.21  2006/06/02 15:19:57  raasch
+! cpp-directives extended for lctit
+!
+! Revision 1.20  2006/04/20 13:16:24  letzel
+! Errors removed in the computation of the diabatic mixing length
+!
+! Revision 1.19  2006/03/14 12:48:52  raasch
+! Error in initializing l_black removed,
+! maximum possible timestep for runge schemes reduced, output for units 15 and
+! 17 is flushed
+!
+! Revision 1.18  2006/02/23 12:27:38  raasch
+! Switches for calculating the mixing length and the dissipation,
+! remaining e1d_m**1.5 replaced by e1d_m*SQRT(e1d_m),
+! nt_anz_1d renamed current_timestep_number_1d
+!
+! Revision 1.17  2005/06/29 09:58:25  steinfeld
+! A potential dependency of ug and vg on height is considered in the
+! tendency terms of u and v; calculation of lambda is commented out
+!
+! Revision 1.16  2005/04/23 09:22:04  raasch
+! Initial horizontal velocities at the lowest grid levels are set to a very
+! small value in order to avoid too small time steps caused by the diffusion
+! criterion
+!
+! Revision 1.15  2005/03/26 20:27:33  raasch
+! Output format of timestep changed, e1d_m**1.5 replaced by e1d_m*SQRT(e1d_m)
+! because of wrong results on NEC-SX6
+!
+! Revision 1.14  2004/04/30 11:55:02  raasch
+! Runge-Kutta scheme implemented, routine leap_frog_1d renamed to
+! time_integration_1d
+!
+! Revision 1.13  2001/03/30 07:24:10  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.12  2001/01/29 12:26:57  raasch
+! Passive scalar is considered
+!
+! Revision 1.11  2001/01/22 06:54:13  raasch
+! Module test_variables removed
+!
+! Revision 1.10  2001/01/02 17:28:35  raasch
+! Adjustment of computations of energy dissipation, mixing length and
+! eddy diffusivities to methods used in the 3D-model:
+! cm changed from 0.4 to 0.1, grid dependend mixing length instead of
+! Blackadar mixing length is used, Deardorff modification of mxixing length
+! when stratification is stable
+!
+! Revision 1.9  2000/12/21 14:16:15  letzel
+! All comments translated into English.
+!
+! Revision 1.8  2000/04/13 13:23:47  schroeter
+! + 1D-Modell an Rechnungen mit Feuchte angepasst
+!
+! Revision 1.7  2000/03/14  12:56:02  12:56:02  schroeter (Michael Schroeter)
+! Asselin-filter is called before swapping timelevels
+! 
+! Revision 1.1  1998/03/09 16:22:10  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! 1D-model to initialize the 3D-arrays.
+! The temperature profile is set as steady and a corresponding steady solution 
+! of the wind profile is being computed.
+! All subroutines required can be found within this file.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE indices
+    USE model_1d
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=9) ::  time_to_string
+    INTEGER ::  k
+    REAL    ::  lambda
+
+!
+!-- Allocate required 1D-arrays
+    ALLOCATE( e1d(nzb:nzt+1),    e1d_m(nzb:nzt+1),   e1d_p(nzb:nzt+1), &
+              kh1d(nzb:nzt+1),   kh1d_m(nzb:nzt+1),  km1d(nzb:nzt+1),  &
+              km1d_m(nzb:nzt+1), l_black(nzb:nzt+1), l1d(nzb:nzt+1),   &
+              l1d_m(nzb:nzt+1),  rif1d(nzb:nzt+1),   te_e(nzb:nzt+1),  &
+              te_em(nzb:nzt+1),  te_u(nzb:nzt+1),    te_um(nzb:nzt+1), &
+              te_v(nzb:nzt+1),   te_vm(nzb:nzt+1),   u1d(nzb:nzt+1),   &
+              u1d_m(nzb:nzt+1),  u1d_p(nzb:nzt+1),   v1d(nzb:nzt+1),   &
+              v1d_m(nzb:nzt+1),  v1d_p(nzb:nzt+1) )
+
+!
+!-- Initialize arrays
+    IF ( constant_diffusion )  THEN
+       km1d   = km_constant
+       km1d_m = km_constant
+       kh1d   = km_constant / prandtl_number
+       kh1d_m = km_constant / prandtl_number
+    ELSE
+       e1d = 0.0; e1d_m = 0.0; e1d_p = 0.0
+       kh1d = 0.0; kh1d_m = 0.0; km1d = 0.0; km1d_m = 0.0
+       rif1d = 0.0
+!
+!--    Compute the mixing length
+       l_black(nzb) = 0.0
+
+       IF ( TRIM( mixing_length_1d ) == 'blackadar' )  THEN
+!
+!--       Blackadar mixing length
+          IF ( f /= 0.0 )  THEN
+             lambda = 2.7E-4 * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) / f + 1E-10
+          ELSE
+             lambda = 30.0
+          ENDIF
+
+          DO  k = nzb+1, nzt+1
+             l_black(k) = kappa * zu(k) / ( 1.0 + kappa * zu(k) / lambda )
+          ENDDO
+
+       ELSEIF ( TRIM( mixing_length_1d ) == 'as_in_3d_model' )  THEN
+!
+!--       Use the same mixing length as in 3D model
+          l_black(1:nzt) = l_grid
+          l_black(nzt+1) = l_black(nzt)
+
+       ENDIF
+
+!
+!--    Adjust mixing length to the prandtl mixing length (within the prandtl
+!--    layer)
+       IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
+          k = nzb+1
+          l_black(k) = MIN( l_black(k), kappa * zu(k) )
+       ENDIF
+    ENDIF
+    l1d   = l_black
+    l1d_m = l_black
+    u1d   = u_init
+    u1d_m = u_init
+    u1d_p = u_init
+    v1d   = v_init
+    v1d_m = v_init
+    v1d_p = v_init
+
+!
+!-- Set initial horizontal velocities at the lowest grid levels to a very small
+!-- value in order to avoid too small time steps caused by the diffusion limit
+!-- in the initial phase of a run (at k=1, dz/2 occurs in the limiting formula!)
+    u1d(0:1)   = 0.1
+    u1d_m(0:1) = 0.1
+    u1d_p(0:1) = 0.1
+    v1d(0:1)   = 0.1
+    v1d_m(0:1) = 0.1
+    v1d_p(0:1) = 0.1
+
+!
+!-- For u*, theta* and the momentum fluxes plausible values are set
+    IF ( prandtl_layer )  THEN
+       us1d = 0.1   ! without initial friction the flow would not change
+    ELSE
+       e1d(nzb+1)  = 1.0
+       km1d(nzb+1) = 1.0
+       us1d = 0.0
+    ENDIF
+    ts1d = 0.0
+    usws1d = 0.0; usws1d_m = 0.0
+    vsws1d = 0.0; vsws1d_m = 0.0
+    z01d = roughness_length
+    IF ( moisture .OR. passive_scalar )  qs1d = 0.0
+
+!
+!-- Set start time in hh:mm:ss - format
+    simulated_time_chr = time_to_string( simulated_time_1d )
+
+!
+!-- Integrate the 1D-model equations using the leap-frog scheme
+    CALL time_integration_1d
+
+
+ END SUBROUTINE init_1d_model
+
+
+
+ SUBROUTINE time_integration_1d
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Leap-frog time differencing scheme for the 1D-model.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE indices
+    USE model_1d
+    USE pegrid
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=9) ::  time_to_string
+    INTEGER ::  k
+    REAL    ::  a, b, dissipation, dpt_dz, flux, kmzm, kmzp, l_stable, pt_0, &
+                uv_total
+
+!
+!-- Determine the time step at the start of a 1D-simulation and
+!-- determine and printout quantities used for run control
+    CALL timestep_1d
+    CALL run_control_1d
+
+!
+!-- Start of time loop
+    DO  WHILE ( simulated_time_1d < end_time_1d  .AND.  .NOT. stop_dt_1d )
+
+!
+!--    Depending on the timestep scheme, carry out one or more intermediate
+!--    timesteps
+
+       intermediate_timestep_count = 0
+       DO  WHILE ( intermediate_timestep_count < &
+                   intermediate_timestep_count_max )
+
+          intermediate_timestep_count = intermediate_timestep_count + 1
+
+          CALL timestep_scheme_steering
+
+!
+!--       Compute all tendency terms. If a Prandtl-layer is simulated, k starts 
+!--       at nzb+2.
+          DO  k = nzb_diff, nzt
+
+             kmzm = 0.5 * ( km1d_m(k-1) + km1d_m(k) )
+             kmzp = 0.5 * ( km1d_m(k) + km1d_m(k+1) )
+!
+!--          u-component
+             te_u(k) =  f * ( v1d(k) - vg(k) ) + ( &
+                              kmzp * ( u1d_m(k+1) - u1d_m(k) ) * ddzu(k+1) &
+                            - kmzm * ( u1d_m(k) - u1d_m(k-1) ) * ddzu(k)   &
+                                              ) * ddzw(k)
+!
+!--          v-component
+             te_v(k) = -f * ( u1d(k) - ug(k) ) + ( &
+                              kmzp * ( v1d_m(k+1) - v1d_m(k) ) * ddzu(k+1) &
+                            - kmzm * ( v1d_m(k) - v1d_m(k-1) ) * ddzu(k)   &
+                                              ) * ddzw(k)
+          ENDDO
+          IF ( .NOT. constant_diffusion )  THEN
+             DO  k = nzb_diff, nzt
+!
+!--             TKE
+                kmzm = 0.5 * ( km1d_m(k-1) + km1d_m(k) )
+                kmzp = 0.5 * ( km1d_m(k) + km1d_m(k+1) )
+                IF ( .NOT. moisture )  THEN
+                   pt_0 = pt_init(k)
+                   flux =  ( pt_init(k+1)-pt_init(k-1) ) * dd2zu(k)
+                ELSE
+                   pt_0 = pt_init(k) * ( 1.0 + 0.61 * q_init(k) )
+                   flux = ( ( pt_init(k+1) - pt_init(k-1) ) +                 &
+                            0.61 * pt_init(k) * ( q_init(k+1) - q_init(k-1) ) &
+                          ) * dd2zu(k)
+                ENDIF
+
+                IF ( dissipation_1d == 'detering' )  THEN
+!
+!--                According to Detering, c_e=0.064
+                   dissipation = 0.064 * e1d_m(k) * SQRT( e1d_m(k) ) / l1d_m(k)
+                ELSEIF ( dissipation_1d == 'as_in_3d_model' )  THEN
+                   dissipation = ( 0.19 + 0.74 * l1d_m(k) / l_grid(k) ) &
+                                 * e1d_m(k) * SQRT( e1d_m(k) ) / l1d_m(k)
+                ENDIF
+
+                te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2&
+                                    + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2&
+                                    )                                          &
+                                    - g / pt_0 * kh1d(k) * flux                &
+                                    +            (                             &
+                                 kmzp * ( e1d_m(k+1) - e1d_m(k) ) * ddzu(k+1)  &
+                               - kmzm * ( e1d_m(k) - e1d_m(k-1) ) * ddzu(k)    &
+                                                 ) * ddzw(k)                   &
+                               - dissipation
+             ENDDO
+          ENDIF
+
+!
+!--       Tendency terms at the top of the Prandtl-layer.
+!--       Finite differences of the momentum fluxes are computed using half the 
+!--       normal grid length (2.0*ddzw(k)) for the sake of enhanced accuracy 
+          IF ( prandtl_layer )  THEN
+
+             k = nzb+1
+             kmzm = 0.5 * ( km1d_m(k-1) + km1d_m(k) )
+             kmzp = 0.5 * ( km1d_m(k) + km1d_m(k+1) )
+             IF ( .NOT. moisture )  THEN
+                pt_0 = pt_init(k)
+                flux =  ( pt_init(k+1)-pt_init(k-1) ) * dd2zu(k)
+             ELSE
+                pt_0 = pt_init(k) * ( 1.0 + 0.61 * q_init(k) )
+                flux = ( ( pt_init(k+1) - pt_init(k-1) ) +                 &
+                         0.61 * pt_init(k) * ( q_init(k+1) - q_init(k-1) ) &
+                       ) * dd2zu(k)
+             ENDIF
+
+             IF ( dissipation_1d == 'detering' )  THEN
+!
+!--             According to Detering, c_e=0.064
+                dissipation = 0.064 * e1d_m(k) * SQRT( e1d_m(k) ) / l1d_m(k)
+             ELSEIF ( dissipation_1d == 'as_in_3d_model' )  THEN
+                dissipation = ( 0.19 + 0.74 * l1d_m(k) / l_grid(k) ) &
+                              * e1d_m(k) * SQRT( e1d_m(k) ) / l1d_m(k)
+             ENDIF
+
+!
+!--          u-component
+             te_u(k) = f * ( v1d(k) - vg(k) ) + ( &
+                       kmzp * ( u1d_m(k+1) - u1d_m(k) ) * ddzu(k+1) + usws1d_m &
+                                               ) * 2.0 * ddzw(k)
+!
+!--          v-component
+             te_v(k) = -f * ( u1d(k) - ug(k) ) + ( &
+                       kmzp * ( v1d_m(k+1) - v1d_m(k) ) * ddzu(k+1) + vsws1d_m &
+                                           ) * 2.0 * ddzw(k)
+!
+!--          TKE
+             te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2   &
+                                 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2   &
+                                 )                                             &
+                                 - g / pt_0 * kh1d(k) * flux                   &
+                                 +           (                                 &
+                              kmzp * ( e1d_m(k+1) - e1d_m(k) ) * ddzu(k+1)     &
+                            - kmzm * ( e1d_m(k) - e1d_m(k-1) ) * ddzu(k)       &
+                                              ) * ddzw(k)                      &
+                            - dissipation
+          ENDIF
+
+!
+!--       Prognostic equations for all 1D variables
+          DO  k = nzb+1, nzt
+
+             u1d_p(k) = ( 1. - tsc(1) ) * u1d_m(k) + &
+                        tsc(1) * u1d(k) + dt_1d * ( tsc(2) * te_u(k) + &
+                                                    tsc(3) * te_um(k) ) 
+             v1d_p(k) = ( 1. - tsc(1) ) * v1d_m(k) + &
+                        tsc(1) * v1d(k) + dt_1d * ( tsc(2) * te_v(k) + &
+                                                    tsc(3) * te_vm(k) ) 
+
+          ENDDO
+          IF ( .NOT. constant_diffusion )  THEN
+             DO  k = nzb+1, nzt
+
+                e1d_p(k) = ( 1. - tsc(1) ) * e1d_m(k) + &
+                           tsc(1) * e1d(k) + dt_1d * ( tsc(2) * te_e(k) + &
+                                                       tsc(3) * te_em(k) ) 
+
+             ENDDO
+!
+!--          Eliminate negative TKE values, which can result from the
+!--          integration due to numerical inaccuracies. In such cases the TKE
+!--          value is reduced to 10 percent of its old value.
+             WHERE ( e1d_p < 0.0 )  e1d_p = 0.1 * e1d
+          ENDIF
+
+!
+!--       Calculate tendencies for the next Runge-Kutta step
+          IF ( timestep_scheme(1:5) == 'runge' ) THEN
+             IF ( intermediate_timestep_count == 1 )  THEN
+
+                DO  k = nzb+1, nzt
+                   te_um(k) = te_u(k)
+                   te_vm(k) = te_v(k)
+                ENDDO
+
+                IF ( .NOT. constant_diffusion )  THEN
+                   DO k = nzb+1, nzt
+                      te_em(k) = te_e(k)
+                   ENDDO
+                ENDIF
+
+             ELSEIF ( intermediate_timestep_count < &
+                         intermediate_timestep_count_max )  THEN
+
+                DO  k = nzb+1, nzt
+                   te_um(k) = -9.5625 * te_u(k) + 5.3125 * te_um(k)
+                   te_vm(k) = -9.5625 * te_v(k) + 5.3125 * te_vm(k)
+                ENDDO
+
+                IF ( .NOT. constant_diffusion )  THEN
+                   DO k = nzb+1, nzt
+                      te_em(k) = -9.5625 * te_e(k) + 5.3125 * te_em(k)
+                   ENDDO
+                ENDIF
+
+             ENDIF
+          ENDIF
+
+
+!
+!--       Boundary conditions for the prognostic variables.
+!--       At the top boundary (nzt+1) u,v and e keep their initial values 
+!--       (ug(nzt+1), vg(nzt+1), 0), at the bottom boundary the mirror 
+!--       boundary condition applies to u and v.
+!--       The boundary condition for e is set further below ( (u*/cm)**2 ).
+          u1d_p(nzb) = -u1d_p(nzb+1)
+          v1d_p(nzb) = -v1d_p(nzb+1)
+
+!
+!--       If necessary, apply the time filter
+          IF ( asselin_filter_factor /= 0.0  .AND. &
+               timestep_scheme(1:5) /= 'runge' )  THEN
+
+             u1d = u1d + asselin_filter_factor * ( u1d_p - 2.0 * u1d + u1d_m )
+             v1d = v1d + asselin_filter_factor * ( v1d_p - 2.0 * v1d + v1d_m )
+
+             IF ( .NOT. constant_diffusion )  THEN
+                e1d = e1d + asselin_filter_factor * &
+                            ( e1d_p - 2.0 * e1d + e1d_m )
+             ENDIF
+
+          ENDIF
+
+!
+!--       Swap the time levels in preparation for the next time step.
+          IF ( timestep_scheme(1:4) == 'leap' )  THEN
+             u1d_m  = u1d
+             v1d_m  = v1d
+             IF ( .NOT. constant_diffusion )  THEN
+                e1d_m  = e1d
+                kh1d_m = kh1d  ! The old diffusion quantities are required for
+                km1d_m = km1d  ! explicit diffusion in the leap-frog scheme.
+                l1d_m  = l1d
+                IF ( prandtl_layer )  THEN
+                   usws1d_m = usws1d
+                   vsws1d_m = vsws1d
+                ENDIF
+             ENDIF
+          ENDIF
+          u1d  = u1d_p
+          v1d  = v1d_p
+          IF ( .NOT. constant_diffusion )  THEN
+             e1d  = e1d_p
+          ENDIF
+
+!
+!--       Compute diffusion quantities
+          IF ( .NOT. constant_diffusion )  THEN
+
+!
+!--          First compute the vertical fluxes in the Prandtl-layer
+             IF ( prandtl_layer )  THEN
+!
+!--             Compute theta* using Rif numbers of the previous time step
+                IF ( rif1d(1) >= 0.0 )  THEN
+!
+!--                Stable stratification
+                   ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) /      &
+                          ( LOG( zu(nzb+1) / z01d ) + 5.0 * rif1d(nzb+1) * &
+                                          ( zu(nzb+1) - z01d ) / zu(nzb+1) &
+                          )
+                ELSE
+!
+!--                Unstable stratification
+                   a = SQRT( 1.0 - 16.0 * rif1d(nzb+1) )
+                   b = SQRT( 1.0 - 16.0 * rif1d(nzb+1) / zu(nzb+1) * z01d )
+!
+!--                In the borderline case the formula for stable stratification 
+!--                must be applied, because otherwise a zero division would
+!--                occur in the argument of the logarithm.
+                   IF ( a == 0.0  .OR.  b == 0.0 )  THEN
+                      ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) /      &
+                             ( LOG( zu(nzb+1) / z01d ) + 5.0 * rif1d(nzb+1) * &
+                                             ( zu(nzb+1) - z01d ) / zu(nzb+1) &
+                             )
+                   ELSE
+                      ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / &
+                             LOG( (a-1.0) / (a+1.0) * (b+1.0) / (b-1.0) )
+                   ENDIF
+                ENDIF
+
+             ENDIF    ! prandtl_layer
+
+!
+!--          Compute the Richardson-flux numbers,
+!--          first at the top of the Prandtl-layer using u* of the previous
+!--          time step (+1E-30, if u* = 0), then in the remaining area. There
+!--          the rif-numbers of the previous time step are used.
+
+             IF ( prandtl_layer )  THEN
+                IF ( .NOT. moisture )  THEN
+                   pt_0 = pt_init(nzb+1)
+                   flux = ts1d
+                ELSE
+                   pt_0 = pt_init(nzb+1) * ( 1.0 + 0.61 * q_init(nzb+1) )
+                   flux = ts1d + 0.61 * pt_init(k) * qs1d
+                ENDIF
+                rif1d(nzb+1) = zu(nzb+1) * kappa * g * flux / &
+                               ( pt_0 * ( us1d**2 + 1E-30 ) )
+             ENDIF
+
+             DO  k = nzb_diff, nzt
+                IF ( .NOT. moisture )  THEN
+                   pt_0 = pt_init(k)
+                   flux = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k)
+                ELSE
+                   pt_0 = pt_init(k) * ( 1.0 + 0.61 * q_init(k) )
+                   flux = ( ( pt_init(k+1) - pt_init(k-1) )                    &
+                            + 0.61 * pt_init(k) * ( q_init(k+1) - q_init(k-1) )&
+                          ) * dd2zu(k)
+                ENDIF
+                IF ( rif1d(k) >= 0.0 )  THEN
+                   rif1d(k) = g / pt_0 * flux /                              &
+                              (  ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2   &
+                               + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2   &
+                               + 1E-30                                       &
+                              )
+                ELSE
+                   rif1d(k) = g / pt_0 * flux /                              &
+                              (  ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2   &
+                               + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2   &
+                               + 1E-30                                       &
+                              ) * ( 1.0 - 16.0 * rif1d(k) )**0.25
+                ENDIF
+             ENDDO
+!
+!--          Richardson-numbers must remain restricted to a realistic value
+!--          range. It is exceeded excessively for very small velocities
+!--          (u,v --> 0).
+             WHERE ( rif1d < rif_min )  rif1d = rif_min
+             WHERE ( rif1d > rif_max )  rif1d = rif_max
+
+!
+!--          Compute u* from the absolute velocity value
+             IF ( prandtl_layer )  THEN
+                uv_total = SQRT( u1d(nzb+1)**2 + v1d(nzb+1)**2 )
+
+                IF ( rif1d(nzb+1) >= 0.0 )  THEN
+!
+!--                Stable stratification
+                   us1d = kappa * uv_total / (                                 &
+                             LOG( zu(nzb+1) / z01d ) + 5.0 * rif1d(nzb+1) *    &
+                                              ( zu(nzb+1) - z01d ) / zu(nzb+1) &
+                                             )
+                ELSE
+!
+!--                Unstable stratification
+                   a = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif1d(nzb+1) ) )
+                   b = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif1d(nzb+1) / zu(nzb+1) &
+                                                    * z01d ) )
+!
+!--                In the borderline case the formula for stable stratification 
+!--                must be applied, because otherwise a zero division would
+!--                occur in the argument of the logarithm.
+                   IF ( a == 1.0  .OR.  b == 1.0 )  THEN
+                      us1d = kappa * uv_total / (                            &
+                             LOG( zu(nzb+1) / z01d ) +                       &
+                             5.0 * rif1d(nzb+1) * ( zu(nzb+1) - z01d ) /     &
+                                                  zu(nzb+1) )
+                   ELSE
+                      us1d = kappa * uv_total / (                              &
+                                 LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) +&
+                                 2.0 * ( ATAN( b ) - ATAN( a ) )               &
+                                                )
+                   ENDIF
+                ENDIF
+
+!
+!--             Compute the momentum fluxes for the diffusion terms
+                usws1d  = - u1d(nzb+1) / uv_total * us1d**2
+                vsws1d  = - v1d(nzb+1) / uv_total * us1d**2
+
+!
+!--             Boundary condition for the turbulent kinetic energy at the top
+!--             of the Prandtl-layer. c_m = 0.4 according to Detering.
+!--             Additional Neumann condition de/dz = 0 at nzb is set to ensure
+!--             compatibility with the 3D model.
+                IF ( ibc_e_b == 2 )  THEN
+                   e1d(nzb+1) = ( us1d / 0.1 )**2
+!                  e1d(nzb+1) = ( us1d / 0.4 )**2  !not used so far, see also
+                                                   !prandtl_fluxes
+                ENDIF
+                e1d(nzb) = e1d(nzb+1)
+
+                IF ( moisture .OR. passive_scalar ) THEN
+!
+!--                Compute q* 
+                   IF ( rif1d(1) >= 0.0 )  THEN
+!
+!--                Stable stratification
+                   qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) /        &
+                          ( LOG( zu(nzb+1) / z01d ) + 5.0 * rif1d(nzb+1) * &
+                                          ( zu(nzb+1) - z01d ) / zu(nzb+1) &
+                          )
+                ELSE
+!
+!--                Unstable stratification
+                   a = SQRT( 1.0 - 16.0 * rif1d(nzb+1) )
+                   b = SQRT( 1.0 - 16.0 * rif1d(nzb+1) / zu(nzb+1) * z01d )
+!
+!--                In the borderline case the formula for stable stratification 
+!--                must be applied, because otherwise a zero division would
+!--                occur in the argument of the logarithm.
+                   IF ( a == 1.0  .OR.  b == 1.0 )  THEN
+                      qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) /        &
+                             ( LOG( zu(nzb+1) / z01d ) + 5.0 * rif1d(nzb+1) * &
+                                             ( zu(nzb+1) - z01d ) / zu(nzb+1) &
+                             )
+                   ELSE
+                      qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / &
+                             LOG( (a-1.0) / (a+1.0) * (b+1.0) / (b-1.0) )
+                   ENDIF
+                ENDIF                
+                ELSE
+                   qs1d = 0.0
+                ENDIF             
+
+             ENDIF   !  prandtl_layer
+
+!
+!--          Compute the diabatic mixing length
+             IF ( mixing_length_1d == 'blackadar' )  THEN
+                DO  k = nzb+1, nzt
+                   IF ( rif1d(k) >= 0.0 )  THEN
+                      l1d(k) = l_black(k) / ( 1.0 + 5.0 * rif1d(k) )
+                   ELSE
+                      l1d(k) = l_black(k) * ( 1.0 - 16.0 * rif1d(k) )**0.25
+                   ENDIF
+                   l1d(k) = l_black(k)
+                ENDDO
+
+             ELSEIF ( mixing_length_1d == 'as_in_3d_model' )  THEN
+                DO  k = nzb+1, nzt
+                   dpt_dz = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k)
+                   IF ( dpt_dz > 0.0 )  THEN
+                      l_stable = 0.76 * SQRT( e1d(k) ) / &
+                                     SQRT( g / pt_init(k) * dpt_dz ) + 1E-5
+                   ELSE
+                      l_stable = l_grid(k)
+                   ENDIF
+                   l1d(k) = MIN( l_grid(k), l_stable )
+                ENDDO
+             ENDIF
+
+!
+!--          Adjust mixing length to the prandtl mixing length
+             IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
+                k = nzb+1
+                IF ( rif1d(k) >= 0.0 )  THEN
+                   l1d(k) = MIN( l1d(k), kappa * zu(k) / ( 1.0 + 5.0 * &
+                                                           rif1d(k) ) )
+                ELSE
+                   l1d(k) = MIN( l1d(k), kappa * zu(k) *          &
+                                  SQRT( SQRT( 1.0 - 16.0 * rif1d(k) ) ) )
+                ENDIF
+             ENDIF
+
+!
+!--          Compute the diffusion coefficients for momentum via the
+!--          corresponding Prandtl-layer relationship and according to
+!--          Prandtl-Kolmogorov, respectively. The unstable stratification is
+!--          computed via the adiabatic mixing length, for the unstability has
+!--          already been taken account of via the TKE (cf. also Diss.).
+             IF ( prandtl_layer )  THEN
+                IF ( rif1d(nzb+1) >= 0.0 )  THEN
+                   km1d(nzb+1) = us1d * kappa * zu(nzb+1) / &
+                                 ( 1.0 + 5.0 * rif1d(nzb+1) )
+                ELSE
+                   km1d(nzb+1) = us1d * kappa * zu(nzb+1) * &
+                                 ( 1.0 - 16.0 * rif1d(nzb+1) )**0.25
+                ENDIF
+             ENDIF
+             DO  k = nzb_diff, nzt
+!                km1d(k) = 0.4 * SQRT( e1d(k) ) !changed: adjustment to 3D-model
+                km1d(k) = 0.1 * SQRT( e1d(k) )
+                IF ( rif1d(k) >= 0.0 )  THEN
+                   km1d(k) = km1d(k) * l1d(k)
+                ELSE
+                   km1d(k) = km1d(k) * l_black(k)
+                ENDIF
+             ENDDO
+
+!
+!--          Add damping layer
+             DO  k = damp_level_ind_1d+1, nzt+1
+                km1d(k) = 1.1 * km1d(k-1)
+                km1d(k) = MIN( km1d(k), 10.0 )
+             ENDDO
+
+!
+!--          Compute the diffusion coefficient for heat via the relationship
+!--          kh = phim / phih * km
+             DO  k = nzb+1, nzt
+                IF ( rif1d(k) >= 0.0 )  THEN
+                   kh1d(k) = km1d(k)
+                ELSE
+                   kh1d(k) = km1d(k) * ( 1.0 - 16.0 * rif1d(k) )**0.25
+                ENDIF
+             ENDDO
+
+          ENDIF   ! .NOT. constant_diffusion
+
+!
+!--       The Runge-Kutta scheme needs the recent diffusion quantities
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             u1d_m  = u1d
+             v1d_m  = v1d
+             IF ( .NOT. constant_diffusion )  THEN
+                e1d_m  = e1d
+                kh1d_m = kh1d
+                km1d_m = km1d
+                l1d_m  = l1d
+                IF ( prandtl_layer )  THEN
+                   usws1d_m = usws1d
+                   vsws1d_m = vsws1d
+                ENDIF
+             ENDIF
+          ENDIF
+
+
+       ENDDO   ! intermediate step loop
+
+!
+!--    Increment simulated time and output times
+       current_timestep_number_1d = current_timestep_number_1d + 1
+       simulated_time_1d          = simulated_time_1d + dt_1d
+       simulated_time_chr         = time_to_string( simulated_time_1d )
+       time_pr_1d                 = time_pr_1d          + dt_1d
+       time_run_control_1d        = time_run_control_1d + dt_1d
+
+!
+!--    Determine and print out quantities for run control
+       IF ( time_run_control_1d >= dt_run_control_1d )  THEN
+          CALL run_control_1d
+          time_run_control_1d = time_run_control_1d - dt_run_control_1d
+       ENDIF
+
+!
+!--    Profile output on file
+       IF ( time_pr_1d >= dt_pr_1d )  THEN
+          CALL print_1d_model
+          time_pr_1d = time_pr_1d - dt_pr_1d
+       ENDIF
+
+!
+!--    Determine size of next time step
+       CALL timestep_1d
+
+    ENDDO   ! time loop
+
+
+ END SUBROUTINE time_integration_1d
+
+
+ SUBROUTINE run_control_1d
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Compute and print out quantities for run control of the 1D model.
+!------------------------------------------------------------------------------!
+
+    USE constants
+    USE indices
+    USE model_1d
+    USE pegrid
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    INTEGER ::  k
+    REAL    ::  alpha, energy, umax, uv_total, vmax
+
+!
+!-- Output
+    IF ( myid == 0 )  THEN
+!
+!--    If necessary, write header
+       IF ( .NOT. run_control_header_1d )  THEN
+          WRITE ( 15, 100 )
+          run_control_header_1d = .TRUE.
+       ENDIF
+
+!
+!--    Compute control quantities
+!--    grid level nzp is excluded due to mirror boundary condition
+       umax = 0.0; vmax = 0.0; energy = 0.0
+       DO  k = nzb+1, nzt+1
+          umax = MAX( ABS( umax ), ABS( u1d(k) ) )
+          vmax = MAX( ABS( vmax ), ABS( v1d(k) ) )
+          energy = energy + 0.5 * ( u1d(k)**2 + v1d(k)**2 )
+       ENDDO
+       energy = energy / REAL( nzt - nzb + 1 )
+
+       uv_total = SQRT( u1d(nzb+1)**2 + v1d(nzb+1)**2 )
+       IF ( ABS( v1d(nzb+1) ) .LT. 1.0E-5 )  THEN
+          alpha = ACOS( SIGN( 1.0 , u1d(nzb+1) ) )
+       ELSE
+          alpha = ACOS( u1d(nzb+1) / uv_total )
+          IF ( v1d(nzb+1) <= 0.0 )  alpha = 2.0 * pi - alpha
+       ENDIF
+       alpha = alpha / ( 2.0 * pi ) * 360.0
+
+       WRITE ( 15, 101 )  current_timestep_number_1d, simulated_time_chr, &
+                          dt_1d, umax, vmax, us1d, alpha, energy
+#if defined( __ibm )
+!
+!--    Write buffer contents to disc immediately
+       CALL FLUSH_( 15 )
+#elif defined( __lcmuk )  ||  defined( __lctit )  ||  defined( __nec )
+       CALL FLUSH( 15 )
+#endif
+
+    ENDIF
+
+!
+!-- formats
+100 FORMAT (///'1D-Zeitschrittkontrollausgaben:'/ &
+              &'------------------------------'// &
+           &'ITER.  HH:MM:SS    DT      UMAX   VMAX    U*   ALPHA   ENERG.'/ &
+           &'-------------------------------------------------------------')
+101 FORMAT (I5,2X,A9,1X,F6.2,2X,F6.2,1X,F6.2,2X,F5.3,2X,F5.1,2X,F7.2)
+
+
+ END SUBROUTINE run_control_1d
+
+
+
+ SUBROUTINE timestep_1d
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Compute the time step w.r.t. the diffusion criterion
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE indices
+    USE model_1d
+    USE pegrid
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    INTEGER ::  k
+    REAL    ::  div, dt_diff, fac, percent_change, value
+
+
+!
+!-- Compute the currently feasible time step according to the diffusion
+!-- criterion. At nzb+1 the half grid length is used.
+    IF ( timestep_scheme(1:4) == 'leap' )  THEN
+       fac = 0.25
+    ELSE
+       fac = 0.35
+    ENDIF
+    dt_diff = dt_max_1d
+    DO  k = nzb+2, nzt
+       value   = fac * dzu(k) * dzu(k) / ( km1d(k) + 1E-20 )
+       dt_diff = MIN( value, dt_diff )
+    ENDDO
+    value   = fac * zu(nzb+1) * zu(nzb+1) / ( km1d(nzb+1) + 1E-20 )
+    dt_1d = MIN( value, dt_diff )
+
+!
+!-- Set flag when the time step becomes too small
+    IF ( dt_1d < ( 0.00001 * dt_max_1d ) )  THEN
+       stop_dt_1d = .TRUE.
+       IF ( myid == 0 )  THEN
+          PRINT*,'+++ timestep_1d: timestep has exceeded the lower limit'
+          PRINT*,'                 dt_1d = ',dt_1d,' s   simulation stopped!'
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+    IF ( timestep_scheme(1:4) == 'leap' )  THEN
+
+!
+!--    The current time step will only be changed if the new time step exceeds
+!--    its previous value by 5 % or falls 2 % below. After a time step
+!--    reduction at least 30 iterations must be done with this value before a
+!--    new reduction will be allowed again.
+!--    The control parameters for application of Euler- or leap-frog schemes are
+!--    set accordingly.
+       percent_change = dt_1d / old_dt_1d - 1.0
+       IF ( percent_change > 0.05  .OR.  percent_change < -0.02 )  THEN
+
+!
+!--       Each time step increase is by at most 2 %
+          IF ( percent_change > 0.0  .AND.  simulated_time_1d /= 0.0 )  THEN
+             dt_1d = 1.02 * old_dt_1d
+          ENDIF
+
+!
+!--       A more or less simple new time step value is obtained taking only the
+!--       first two significant digits
+          div = 1000.0
+          DO  WHILE ( dt_1d < div )
+             div = div / 10.0
+          ENDDO
+          dt_1d = NINT( dt_1d * 100.0 / div ) * div / 100.0
+
+!
+!--       Now the time step can be changed.
+          IF ( percent_change < 0.0 )  THEN
+!
+!--          Time step reduction
+             old_dt_1d = dt_1d
+             last_dt_change_1d = current_timestep_number_1d
+          ELSE
+!
+!--          Time step will only be increased if at least 30 iterations have
+!--          been done since the previous time step change, and of course at
+!--          simulation start, respectively.
+             IF ( current_timestep_number_1d >= last_dt_change_1d + 30  .OR. &
+                     simulated_time_1d == 0.0 )  THEN
+                old_dt_1d = dt_1d
+                last_dt_change_1d = current_timestep_number_1d
+             ELSE
+                dt_1d = old_dt_1d
+             ENDIF
+          ENDIF
+       ELSE
+!
+!--       No time step change since the difference is too small
+          dt_1d = old_dt_1d
+       ENDIF
+
+    ELSE    ! Runge-Kutta
+
+!--    A more or less simple new time step value is obtained taking only the
+!--    first two significant digits
+       div = 1000.0
+       DO  WHILE ( dt_1d < div )
+          div = div / 10.0
+       ENDDO
+       dt_1d = NINT( dt_1d * 100.0 / div ) * div / 100.0
+
+       old_dt_1d = dt_1d
+       last_dt_change_1d = current_timestep_number_1d
+
+    ENDIF
+
+ END SUBROUTINE timestep_1d
+
+
+
+ SUBROUTINE print_1d_model
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! List output of profiles from the 1D-model
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE indices
+    USE model_1d
+    USE pegrid
+    USE control_parameters
+
+    IMPLICIT NONE
+
+
+    INTEGER ::  k
+
+
+    IF ( myid == 0 )  THEN
+!
+!--    Open list output file for profiles from the 1D-model
+       CALL check_open( 17 )
+
+!
+!--    Write Header
+       WRITE ( 17, 100 )  TRIM( run_description_header ), &
+                          TRIM( simulated_time_chr )
+       WRITE ( 17, 101 )
+
+!
+!--    Write the values
+       WRITE ( 17, 102 )
+       WRITE ( 17, 101 )
+       DO  k = nzt+1, nzb, -1
+          WRITE ( 17, 103)  k, zu(k), u1d(k), v1d(k), pt_init(k), e1d(k), &
+                            rif1d(k), km1d(k), kh1d(k), l1d(k), zu(k), k
+       ENDDO
+       WRITE ( 17, 101 )
+       WRITE ( 17, 102 )
+       WRITE ( 17, 101 )
+
+#if defined( __ibm )
+!
+!--    Write buffer contents to disc immediately
+       CALL FLUSH_( 17 )
+#elif defined( __lcmuk )  ||  defined( __lctit )  ||  defined( __nec )
+       CALL FLUSH( 17 )
+#endif
+
+    ENDIF
+
+!
+!-- Formats
+100 FORMAT (//1X,A/1X,10('-')/' 1d-model profiles'/ &
+            ' Time: ',A)
+101 FORMAT (1X,79('-'))
+102 FORMAT ('   k     zu      u      v     pt      e    rif    Km    Kh     ', &
+            'l      zu      k')
+103 FORMAT (1X,I4,1X,F7.1,1X,F6.2,1X,F6.2,1X,F6.2,1X,F6.2,1X,F5.2,1X,F5.2, &
+            1X,F5.2,1X,F6.2,1X,F7.1,2X,I4)
+
+
+ END SUBROUTINE print_1d_model
Index: palm/trunk/SOURCE/init_3d_model.f90
===================================================================
--- palm/trunk/SOURCE/init_3d_model.f90	(revision 4901)
+++ palm/trunk/SOURCE/init_3d_model.f90	(revision 1)
@@ -1,143 +1,138 @@
-!> @file init_3d_model.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
+#if defined( __ibmy_special )
+@PROCESS NOOPTimize
+#endif
+ SUBROUTINE init_3d_model
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Rename resize_array into add_ghost_layers and remove number of passed indices
-!
-! 4877 2021-02-17 16:17:35Z suehring
-! Bugfix in initialization of vertical surfaces with roughness and surface heat fluxes
-!
-! 4848 2021-01-21 15:51:51Z gronemeier
-! replaced use_syn_turb_gen by syn_turb_gen
-!
-! 4845 2021-01-18 11:15:37Z raasch
-! removed allocation and initialization of arrays required for radiation boundary conditions
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Add possibility to initialize surface flux of passive scalar via static driver
-!
-! 4783 2020-11-13 13:58:45Z raasch
-! bugfix for reading restart data with MPI-I/O (does not work with blockwise I/O)
-!
-! 4680 2020-09-16 10:20:34Z gronemeier
-! Add option to fix date or time of the simulation
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4648 2020-08-25 07:52:08Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4548 2020-05-28 19:36:45Z suehring
-! Bugfix, move call for lsf_forcing_surf after lsf_init is called
-!
-! 4514 2020-04-30 16:29:59Z suehring
-! Add possibility to initialize surface sensible and latent heat fluxes via a static driver.
-!
-! 4493 2020-04-10 09:49:43Z pavelkrc
-! Overwrite u_init, v_init, pt_init, q_init and s_init with hom for all cyclic_fill-cases, not only
-! for turbulent_inflow = .TRUE.
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4286 2019-10-30 16:01:14Z resler
-! implement new palm_date_time_mod
-!
-! 4223 2019-09-10 09:20:47Z gronemeier
-! Deallocate temporary string array since it may be re-used to read different input data in other
-! modules
-!
-! 4186 2019-08-23 16:06:14Z suehring
-! Design change, use variables defined in netcdf_data_input_mod to read netcd variables rather than
-! define local ones.
-!
-! 4185 2019-08-23 13:49:38Z oliver.maas
-! For initializing_actions = ' cyclic_fill':
-! Overwrite u_init, v_init, pt_init, q_init and s_init with the (temporally) and horizontally
-! averaged vertical profiles from the end of the prerun, because these profiles shall be used as the
-! basic state for the rayleigh damping and the pt_damping.
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4151 2019-08-09 08:24:30Z suehring
-! Add netcdf directive around input calls (fix for last commit)
-!
-! 4150 2019-08-08 20:00:47Z suehring
-! Input of additional surface variables independent on land- or urban-surface model
-!
-! 4131 2019-08-02 11:06:18Z monakurppa
-! Allocate sums and sums_l to allow profile output for salsa variables.
-!
-! 4130 2019-08-01 13:04:13Z suehring
-! Effectively reduce 3D initialization to 1D initial profiles. This is because 3D initialization
-! produces structures in the w-component that are correlated with the processor grid for some
-! unknown reason
-!
-! 4090 2019-07-11 15:06:47Z Giersch
-! Unused variables removed
-!
-! 4088 2019-07-11 13:57:56Z Giersch
-! Pressure and density profile calculations revised using basic functions
-!
-! 4048 2019-06-21 21:00:21Z knoop
-! Further modularization of particle code components
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! Convert most location messages to debug messages to reduce output in job logfile to a minimum
-!
-! unused variable removed
-!
-! 3937 2019-04-29 15:09:07Z suehring
-! Move initialization of synthetic turbulence generator behind initialization of offline nesting.
-! Remove call for stg_adjust, as this is now already done in stg_init.
-!
-! 3900 2019-04-16 15:17:43Z suehring
-! Fix problem with LOD = 2 initialization
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3849 2019-04-01 16:35:16Z knoop
-! Move initialization of rmask before initializing user_init_arrays
-!
-! 3711 2019-01-31 13:44:26Z knoop
-! Introduced module_interface_init_checks for post-init checks in modules
-!
-! 3700 2019-01-26 17:03:42Z knoop
-! Some interface calls moved to module_interface + cleanup
-!
-! 3648 2019-01-02 16:35:46Z suehring
-! Rename subroutines for surface-data output
+! $Log: init_3d_model.f90,v $
+! Revision 1.49  2006/08/22 15:59:07  raasch
+! No optimization of this file on the ibmy (Yonsei Univ.)
+!
+! Revision 1.48  2006/08/22 13:58:30  raasch
+! Initialisation of all tendency arrays (t.._m) needed for the Runge-Kutta
+! schemes
+!
+! Revision 1.47  2006/08/04 14:39:20  raasch
+! Allocation of diss, needed for calculating the sgs particle velocities
+!
+! Revision 1.46  2006/05/15 08:14:56  letzel
+! Initialize volume_flow_initial_l and volume_flow_area_l with 0.0
+!
+! Revision 1.45  2006/04/26 13:32:44  raasch
+! Provisional correction for Piacsek & Williams advection scheme: keep u and
+! v zero one layer below the topography (in case of set_1d-model_profiles).
+!
+! Revision 1.44  2006/04/26 12:22:09  raasch
+! sums_l and sums_l_l changed to three dimensions
+!
+! Revision 1.43  2006/02/23 12:29:11  raasch
+! Allocation and default setting of k index arrays nzb_2d and nzb_diff_2d
+! moved to routine init_grid, nanz_sums, nanz_2dh and nanz_3d renamed ngp_sums,
+! ngp_2dh and ngp_3d, respectively,
+! allocation and setting of ngp_2dh and ngp_3d moved from parin and init_pegrid
+! to here,
+! read_fields_from_prior_run renamed read_restart_data,
+! new grid point counters ngp_2dh_outer and ngp_3d_inner are calculated,
+! additional argument nzb_.._inner added to call of disturb_field
+! optional calculation of the initial volume flow through the right and north
+! boundary
+!
+! Revision 1.42  2005/06/26 19:55:01  raasch
+! ql is now a pointer, init_cloud_physics is called anyway
+!
+! Revision 1.41  2005/03/26 20:29:41  raasch
+! Arguments for non-cyclic boundary conditions added in call of routine
+! disturb_field, diffusivities km_damp_x and km_damp_y used within the outflow
+! damping layer are allocated and initialized, uvmean_outflow is allocated
+!
+! Revision 1.40  2004/04/30 11:59:05  raasch
+! Reading of restart data is moved to new routine read_3d_binary,
+! diffusion quantity arrays are allocated for previous timelevels only
+! in case of leapfrog scheme, enlarged transposition array d
+!
+! Revision 1.39  2004/01/30 10:27:20  raasch
+! Allocation and default setting of index arrays nzb_2d and nzb_diff_2d
+!
+! Revision 1.38  2004/01/28 15:09:56  raasch
+! Time levels for Runge-Kutta scheme initialized, setting of bt before
+! calling pres removed
+!
+! Revision 1.37  2003/10/29 08:54:05  raasch
+! Random numbers are initialized or random seed is read from file of
+! previous run, module random_function_mod is used, new binary version 2.2
+!
+! Revision 1.36  2003/08/01 08:25:08  raasch
+! Array sums is initialized (must be defined in the first call of pres),
+! call of init_cloud_physics moved before init_particles
+!
+! Revision 1.35  2003/04/09 11:50:50  raasch
+! In case of initialisation with constant profiles, the horizontal
+! velocities at k=0,1 are explicitly set to zero
+!
+! Revision 1.34  2003/03/16 09:39:39  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.33  2002/12/19 15:32:42  raasch
+! Subroutine local_tremain_ini (initializing the remaining cpu-time)
+! moved to main program (palm), reading of array hom is moved to routine
+! read_var_list, STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.32  2002/05/02 18:51:11  raasch
+! Time level t+dt re-introduced and initialized
+!
+! Revision 1.31  2001/11/05  09:31:38  09:31:38  weinbrec (Sonja Weinbrecht)
+! Initialization of spectrum_x and spectrum_y for continuation runs
+! 
+! Revision 1.30  2001/03/30 07:25:25  raasch
+! Arguments removed from pres, arrays work and work1 removed,
+! initialization of timelevel t+dt removed,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.29  2001/01/29 12:27:49  raasch
+! Passive scalar is considered
+!
+! Revision 1.28  2001/01/25 07:02:19  raasch
+! Initialization of surface fluxes changed due to new variable
+! use_surface_fluxes
+!
+! Revision 1.27  2001/01/05 15:12:23  raasch
+! Allocate spectrum_x and spectrum_y, new binary version 2.1
+!
+! Revision 1.26  2001/01/02 17:29:43  raasch
+! Unit 13 closed after reading binary input (after call of user_init, where
+! read from unit 13 may occur)
+!
+! Revision 1.25  2000/12/28 13:05:53  raasch
+! Init_particles is called unconditionally
+!
+! Revision 1.24  2000/04/27 07:05:19  raasch
+! Call of subroutine init_slope added to compute the initial temperature field
+! and other constants used in case of a sloping surface,
+! call of subroutine init_dvrp added to initialize dvrp-software,
+! old revision remarks deleted
+!
+! Revision 1.23  2000/04/13 13:22:09  schroeter
+! Allokieren und Initialisierung der Feuchtefelder und Wolkenphysikparameter
+!
+! Revision 1.22  2000/01/26  10:30:49  10:30:49  letzel (Marcus Letzel)
+! All comments translated into English
+! 
+! Revision 1.21  2000/01/10 09:54:10  raasch
+! Trennung der zeitabhaengigen Variablen in pointer und targets,
+! Anfangszuordnung der pointer
+!
+! Revision 1.17  1999/03/03 07:22:35  raasch
+! Beim binaeren Einlesen werden alle Variablen mit exakter Laenge von Datei
+! gelesen, da sich bei schneller I/O Records nicht einfach ueberspringen lassen
+!
+! Revision 1.14  1998/12/15 07:33:50  raasch
+! Zusaetzliche Ermittelung der tatsaechlichen Einlesezeiten auf T3E
+! mit messpunkt_e(14) unter Verwendung von TIMEF (s. cpu_zeitmessung)
 !
 ! Revision 1.1  1998/03/09 16:22:22  raasch
@@ -147,637 +142,215 @@
 ! Description:
 ! ------------
-!> Allocation of arrays and initialization of the 3D model via
-!> a) pre-run the 1D model
-!> or
-!> b) pre-set constant linear profiles
-!> or
-!> c) read values of a previous run
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_3d_model
-
-
-    USE advec_ws
+! Allocation of arrays and initialization of the 3D model via
+! a) pre-run the 1D model
+! or
+! b) pre-set constant linear profiles
+! or
+! c) read values of a previous run
+!------------------------------------------------------------------------------!
 
     USE arrays_3d
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  barometric_formula, c_p, exner_function, exner_function_invers, g,                  &
-               ideal_gas_law_rho, ideal_gas_law_rho_pt, l_v, pi
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    USE chem_modules,                                                                              &
-        ONLY:  max_pr_cs ! ToDo: this dependency needs to be removed cause it is ugly #new_dom
-
+    USE averaging
+    USE constants
     USE control_parameters
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_2d
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy, ddx2_mg, ddy2_mg
-
+    USE cpulog
     USE indices
-
-    USE kinds
-
-    USE lsf_nudging_mod,                                                                           &
-        ONLY:  ls_forcing_surf
-
-    USE model_1d_mod,                                                                              &
-        ONLY:  init_1d_model, l1d, u1d, v1d
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_init_arrays,                                                       &
-               module_interface_init,                                                              &
-               module_interface_init_checks
-
-    USE multi_agent_system_mod,                                                                    &
-        ONLY:  agents_active, mas_init
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  dots_max
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  add_ghost_layers,                                                                   &
-               char_fill,                                                                          &
-               check_existence,                                                                    &
-               close_input_file,                                                                   &
-               get_attribute,                                                                      &
-               get_variable,                                                                       &
-               init_3d,                                                                            &
-               input_pids_static,                                                                  &
-               inquire_num_variables,                                                              &
-               inquire_variable_names,                                                             &
-               input_file_static,                                                                  &
-               netcdf_data_input_init_3d,                                                          &
-               num_var_pids,                                                                       &
-               open_read_file,                                                                     &
-               pids_id,                                                                            &
-               real_2d,                                                                            &
-               vars_pids
-
-    USE nesting_offl_mod,                                                                          &
-        ONLY:  nesting_offl_init
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  init_date_time
-
+    USE interfaces
+    USE model_1d
+    USE particle_attributes
     USE pegrid
-
-#if defined( __parallel )
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run
-#endif
-
+    USE profil_parameter
     USE random_function_mod
-
-    USE random_generator_parallel,                                                                 &
-        ONLY:  init_parallel_random_generator
-
-    USE read_restart_data_mod,                                                                     &
-        ONLY:  rrd_local, rrd_read_parts_of_global
-
-    USE statistics,                                                                                &
-        ONLY:  hom, hom_sum, mean_surface_level_height, pr_palm, rmask, statistic_regions, sums,   &
-               sums_divnew_l, sums_divold_l, sums_l, sums_l_l, sums_wsts_bc_l, ts_value,           &
-               weight_pres, weight_substep
-
-    USE synthetic_turbulence_generator_mod,                                                        &
-        ONLY:  stg_init
-
-    USE surface_layer_fluxes_mod,                                                                  &
-        ONLY:  init_surface_layer_fluxes
-
-    USE surface_mod,                                                                               &
-        ONLY :  init_single_surface_properties,                                                    &
-                init_surface_arrays,                                                               &
-                init_surfaces,                                                                     &
-                surf_def_h,                                                                        &
-                surf_def_v,                                                                        &
-                surf_lsm_h,                                                                        &
-                surf_usm_h
-
-#if defined( _OPENACC )
-    USE surface_mod,                                                                               &
-        ONLY :  bc_h
-#endif
-
-    USE surface_data_output_mod,                                                                   &
-        ONLY:  surface_data_output_init
-
-    USE transpose_indices
-
+    USE statistics
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i                    !< grid index in x direction
-    INTEGER(iwp) ::  ind_array(1)         !< dummy used to determine start index for external pressure forcing
-    INTEGER(iwp) ::  j                    !< grid index in y direction
-    INTEGER(iwp) ::  k                    !< grid index in z direction
-    INTEGER(iwp) ::  k_surf               !< surface level index
-    INTEGER(iwp) ::  l                    !< running index over surface orientation
-    INTEGER(iwp) ::  m                    !< index of surface element in surface data type
-    INTEGER(iwp) ::  nz_u_shift           !< topography-top index on u-grid, used to vertically shift initial profiles
-    INTEGER(iwp) ::  nz_v_shift           !< topography-top index on v-grid, used to vertically shift initial profiles
-    INTEGER(iwp) ::  nz_w_shift           !< topography-top index on w-grid, used to vertically shift initial profiles
-    INTEGER(iwp) ::  nz_s_shift           !< topography-top index on scalar-grid, used to vertically shift initial profiles
-    INTEGER(iwp) ::  nz_u_shift_l         !< topography-top index on u-grid, used to vertically shift initial profiles
-    INTEGER(iwp) ::  nz_v_shift_l         !< topography-top index on v-grid, used to vertically shift initial profiles
-    INTEGER(iwp) ::  nz_w_shift_l         !< topography-top index on w-grid, used to vertically shift initial profiles
-    INTEGER(iwp) ::  nz_s_shift_l         !< topography-top index on scalar-grid, used to vertically shift initial profiles
-    INTEGER(iwp) ::  nzt_l                !< index of top PE boundary for multigrid level
-    INTEGER(iwp) ::  sr                   !< index of statistic region
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE   ::  ngp_2dh_l  !< toal number of horizontal grid points in statistical region on
-                                                             !< subdomain
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  ngp_2dh_outer_l    !< number of horizontal non-wall bounded grid points on
-                                                                     !< subdomain
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  ngp_2dh_s_inner_l  !< number of horizontal non-topography grid points on
-                                                                     !< subdomain
-
-    REAL(wp) ::  dx_l !< grid spacing along x on different multigrid level
-    REAL(wp) ::  dy_l !< grid spacing along y on different multigrid level
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  init_l                       !< dummy array used for averaging 3D data to obtain
-                                                                         !< inital profiles
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mean_surface_level_height_l  !< mean surface level height on subdomain
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ngp_3d_inner_l               !< total number of non-topography grid points on subdomain
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ngp_3d_inner_tmp             !< total number of non-topography grid points
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  p_hydrostatic                !< hydrostatic pressure
-
-    REAL(wp), DIMENSION(1:3) ::  volume_flow_area_l     !< area of lateral and top model domain surface on local subdomain
-    REAL(wp), DIMENSION(1:3) ::  volume_flow_initial_l  !< initial volume flow into model domain
-
-    TYPE(real_2d) ::  tmp_2d !< temporary variable to input additional surface-data from static file
-
-    CALL location_message( 'model initialization', 'start' )
-!
-!-- Set reference date-time
-    CALL init_date_time( date_time_str=origin_date_time,                                           &
-                         use_fixed_date=use_fixed_date,                                            &
-                         use_fixed_time=use_fixed_time )
-
-    IF ( debug_output )  CALL debug_message( 'allocating arrays', 'start' )
+    INTEGER ::  i, j, k, sr
+
+    INTEGER, DIMENSION(:), ALLOCATABLE ::  ngp_2dh_l, ngp_3d_inner_l
+
+    INTEGER, DIMENSION(:,:), ALLOCATABLE ::  ngp_2dh_outer_l
+
+    REAL, DIMENSION(1:2) ::  volume_flow_area_l, volume_flow_initial_l
+
+
 !
 !-- Allocate arrays
-    ALLOCATE( mean_surface_level_height(0:statistic_regions),                                      &
-              mean_surface_level_height_l(0:statistic_regions),                                    &
-              ngp_2dh(0:statistic_regions), ngp_2dh_l(0:statistic_regions),                        &
-              ngp_3d(0:statistic_regions),                                                         &
-              ngp_3d_inner(0:statistic_regions),                                                   &
-              ngp_3d_inner_l(0:statistic_regions),                                                 &
-              ngp_3d_inner_tmp(0:statistic_regions),                                               &
-              sums_divnew_l(0:statistic_regions),                                                  &
+    ALLOCATE( ngp_2dh(0:statistic_regions), ngp_2dh_l(0:statistic_regions), &
+              ngp_3d(0:statistic_regions),                                  &
+              ngp_3d_inner(0:statistic_regions),                            &
+              ngp_3d_inner_l(0:statistic_regions),                          &
+              sums_divnew_l(0:statistic_regions),                           &
               sums_divold_l(0:statistic_regions) )
-    ALLOCATE( dp_smooth_factor(nzb:nzt), rdf(nzb+1:nzt), rdf_sc(nzb+1:nzt) )
-    ALLOCATE( ngp_2dh_outer(nzb:nzt+1,0:statistic_regions),                                        &
-              ngp_2dh_outer_l(nzb:nzt+1,0:statistic_regions),                                      &
-              ngp_2dh_s_inner(nzb:nzt+1,0:statistic_regions),                                      &
-              ngp_2dh_s_inner_l(nzb:nzt+1,0:statistic_regions),                                    &
-              rmask(nysg:nyng,nxlg:nxrg,0:statistic_regions),                                      &
-              sums(nzb:nzt+1,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa),                          &
-              sums_l(nzb:nzt+1,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:threads_per_task-1),   &
-              sums_l_l(nzb:nzt+1,0:statistic_regions,0:threads_per_task-1),                        &
+    ALLOCATE( rdf(nzb+1:nzt), uvmean_outflow(nzb:nzt+1),                    &
+              uvmean_outflow_l(nzb:nzt+1) )
+    ALLOCATE( hom_sum(nzb:nzt+1,var_hom,0:statistic_regions),               &
+              ngp_2dh_outer(nzb:nzt+1,0:statistic_regions),                 &
+              ngp_2dh_outer_l(nzb:nzt+1,0:statistic_regions),               &
+              rmask(nys-1:nyn+1,nxl-1:nxr+1,0:statistic_regions),           &
+              sums(nzb:nzt+1,var_sum),                                      &
+              sums_l(nzb:nzt+1,var_sum,0:threads_per_task-1),               &
+              sums_l_l(nzb:nzt+1,0:statistic_regions,0:threads_per_task-1), &
+              sums_up_fraction_l(10,3,0:statistic_regions),                 &
               sums_wsts_bc_l(nzb:nzt+1,0:statistic_regions) )
-    ALLOCATE( ts_value(dots_max,0:statistic_regions) )
-    ALLOCATE( ptdf_x(nxlg:nxrg), ptdf_y(nysg:nyng) )
-
-    ALLOCATE( d(nzb+1:nzt,nys:nyn,nxl:nxr),                                                        &
-              p(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                    &
-              tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-    ALLOCATE( pt_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                 &
-              pt_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                 &
-              u_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                  &
-              u_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                  &
-              u_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                  &
-              v_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                  &
-              v_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                  &
-              v_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                  &
-              w_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                  &
-              w_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                  &
-              w_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    IF (  .NOT.  neutral )  THEN
-       ALLOCATE( pt_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+    ALLOCATE( km_damp_x(nxl-1:nxr+1), km_damp_y(nys-1:nyn+1) )
+
+    ALLOCATE( rif_1(nys-1:nyn+1,nxl-1:nxr+1), shf_1(nys-1:nyn+1,nxl-1:nxr+1),  &
+              ts(nys-1:nyn+1,nxl-1:nxr+1), us(nys-1:nyn+1,nxl-1:nxr+1),        &
+              usws_1(nys-1:nyn+1,nxl-1:nxr+1), vsws_1(nys-1:nyn+1,nxl-1:nxr+1),&
+              z0(nys-1:nyn+1,nxl-1:nxr+1) )
+
+    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--    Leapfrog scheme needs two timelevels of diffusion quantities
+       ALLOCATE( rif_2(nys-1:nyn+1,nxl-1:nxr+1),  &
+                 shf_2(nys-1:nyn+1,nxl-1:nxr+1),  &
+                 usws_2(nys-1:nyn+1,nxl-1:nxr+1), &
+                 vsws_2(nys-1:nyn+1,nxl-1:nxr+1) )
     ENDIF
-!
-!-- Pre-set masks for regional statistics. Default is the total model domain.
-!-- Ghost points are excluded because counting values at the ghost boundaries would bias the
-!-- statistics.
-    rmask = 1.0_wp
-    rmask(:,nxlg:nxl-1,:) = 0.0_wp;  rmask(:,nxr+1:nxrg,:) = 0.0_wp
-    rmask(nysg:nys-1,:,:) = 0.0_wp;  rmask(nyn+1:nyng,:,:) = 0.0_wp
-!
-!-- Following array is required for perturbation pressure within the iterative pressure solvers. For
-!-- the multistep schemes (Runge-Kutta), array p holds the weighted average of the substeps and
-!-- cannot be used in the Poisson solver.
-    IF ( psolver == 'sor' )  THEN
-       ALLOCATE( p_loc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ELSEIF ( psolver(1:9) == 'multigrid' )  THEN
-!
-!--    For performance reasons, multigrid is using one ghost layer only
-       ALLOCATE( p_loc(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+    ALLOCATE( d(nzb+1:nzta,nys:nyna,nxl:nxra),             &
+              e_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),      &
+              e_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),      &
+              e_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),      &
+              kh_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),     &
+              km_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),     &
+              p(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),        &
+              pt_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),     &
+              pt_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),     &
+              pt_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),     &
+              tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),     &
+              u_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1+uxrp), &
+              u_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1+uxrp), &
+              u_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1+uxrp), &
+              v_1(nzb:nzt+1,nys-1:nyn+1+vynp,nxl-1:nxr+1), &
+              v_2(nzb:nzt+1,nys-1:nyn+1+vynp,nxl-1:nxr+1), &
+              v_3(nzb:nzt+1,nys-1:nyn+1+vynp,nxl-1:nxr+1), &
+              w_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),      &
+              w_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),      &
+              w_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+       ALLOCATE( kh_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+                 km_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     ENDIF
 
-!
-!-- Array for storing constant coeffficients of the tridiagonal solver
-    IF ( psolver == 'poisfft' )  THEN
-       ALLOCATE( tri(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1,2) )
-       ALLOCATE( tric(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) )
+    IF ( moisture  .OR.  passive_scalar ) THEN
+!
+!--    2D-moisture/scalar arrays
+       ALLOCATE ( qs(nys-1:nyn+1,nxl-1:nxr+1),     &
+                  qsws_1(nys-1:nyn+1,nxl-1:nxr+1) )
+
+       IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+          ALLOCATE( qsws_2(nys-1:nyn+1,nxl-1:nxr+1) )
+       ENDIF
+!
+!--    3D-moisture/scalar arrays
+       ALLOCATE( q_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+                 q_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+                 q_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+!
+!--    3D-arrays needed for moisture only
+       IF ( moisture )  THEN
+          ALLOCATE( vpt_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+             ALLOCATE( vpt_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+          ENDIF
+
+          IF ( cloud_physics ) THEN
+!
+!--          Liquid water content
+             ALLOCATE ( ql_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+          ENDIF
+
+          IF ( cloud_droplets )  THEN
+!
+!--          Liquid water content, change in liquid water content,
+!--          real volume of particles (with weighting), volume of particles
+             ALLOCATE ( ql_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+                        ql_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+                        ql_v(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+                        ql_vp(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+          ENDIF
+
+       ENDIF
+
     ENDIF
 
-    IF ( humidity )  THEN
-!
-!--    3D-humidity
-       ALLOCATE( q_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                               &
-                 q_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                               &
-                 q_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                               &
-                 vpt_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+!
+!-- 3D-array for storing the dissipation, needed for calculating the sgs
+!-- particle velocities
+    IF ( use_sgs_for_particles )  THEN
+       ALLOCATE ( diss(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     ENDIF
 
-    IF ( passive_scalar )  THEN
-
-!
-!--    3D scalar arrays
-       ALLOCATE( s_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                               &
-                 s_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                               &
-                 s_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
+    IF ( dt_dosp /= 9999999.9 )  THEN
+       ALLOCATE( spectrum_x( 1:nx/2, 1:10, 1:10 ), &
+                 spectrum_y( 1:ny/2, 1:10, 1:10 ) )
     ENDIF
 
 !
-!-- Allocate and set 1d-profiles for Stokes drift velocity. It may be set to non-zero values later
-!-- in ocean_init.
-    ALLOCATE( u_stokes_zu(nzb:nzt+1), u_stokes_zw(nzb:nzt+1),                                      &
-              v_stokes_zu(nzb:nzt+1), v_stokes_zw(nzb:nzt+1) )
-    u_stokes_zu(:) = 0.0_wp
-    u_stokes_zw(:) = 0.0_wp
-    v_stokes_zu(:) = 0.0_wp
-    v_stokes_zw(:) = 0.0_wp
-
-!
-!-- Allocation of anelastic and Boussinesq approximation specific arrays
-    ALLOCATE( p_hydrostatic(nzb:nzt+1) )
-    ALLOCATE( rho_air(nzb:nzt+1) )
-    ALLOCATE( rho_air_zw(nzb:nzt+1) )
-    ALLOCATE( drho_air(nzb:nzt+1) )
-    ALLOCATE( drho_air_zw(nzb:nzt+1) )
-!
-!-- Density profile calculation for anelastic and Boussinesq approximation.
-!-- In case of a Boussinesq approximation, a constant density is calculated mainly for output
-!-- purposes. This density does not need to be considered in the model's system of equations.
-    IF ( TRIM( approximation ) == 'anelastic' )  THEN
-       DO  k = nzb, nzt+1
-          p_hydrostatic(k) = barometric_formula(zu(k), pt_surface *                                &
-                                                exner_function(surface_pressure * 100.0_wp),       &
-                                                surface_pressure * 100.0_wp)
-
-          rho_air(k) = ideal_gas_law_rho_pt(p_hydrostatic(k), pt_init(k))
-       ENDDO
-
-       DO  k = nzb, nzt
-          rho_air_zw(k) = 0.5_wp * ( rho_air(k) + rho_air(k+1) )
-       ENDDO
-
-       rho_air_zw(nzt+1)  = rho_air_zw(nzt) + 2.0_wp * ( rho_air(nzt+1) - rho_air_zw(nzt)  )
+!-- Initial assignment of the pointers
+    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+
+       rif_m  => rif_1;   rif  => rif_2
+       shf_m  => shf_1;   shf  => shf_2
+       usws_m => usws_1;  usws => usws_2
+       vsws_m => vsws_1;  vsws => vsws_2
+       e_m  => e_1;   e  => e_2;   e_p  => e_3;   te_m  => e_3
+       kh_m => kh_1;  kh => kh_2
+       km_m => km_1;  km => km_2
+       pt_m => pt_1;  pt => pt_2;  pt_p => pt_3;  tpt_m => pt_3
+       u_m  => u_1;   u  => u_2;   u_p  => u_3;   tu_m  => u_3
+       v_m  => v_1;   v  => v_2;   v_p  => v_3;   tv_m  => v_3
+       w_m  => w_1;   w  => w_2;   w_p  => w_3;   tw_m  => w_3
+
+       IF ( moisture  .OR.  passive_scalar )  THEN
+          qsws_m => qsws_1;  qsws => qsws_2
+          q_m    => q_1;     q    => q_2;     q_p => q_3;     tq_m => q_3
+          IF ( moisture )        vpt_m  => vpt_1;   vpt  => vpt_2
+          IF ( cloud_physics )   ql   => ql_1
+          IF ( cloud_droplets )  THEN
+             ql   => ql_1
+             ql_c => ql_2
+          ENDIF
+       ENDIF
 
     ELSE
-       DO  k = nzb, nzt+1
-          p_hydrostatic(k) = barometric_formula(zu(nzb), pt_surface *                              &
-                                                exner_function(surface_pressure * 100.0_wp),       &
-                                                surface_pressure * 100.0_wp)
-
-          rho_air(k) = ideal_gas_law_rho_pt(p_hydrostatic(k), pt_init(nzb))
-       ENDDO
-
-       DO  k = nzb, nzt
-          rho_air_zw(k) = 0.5_wp * ( rho_air(k) + rho_air(k+1) )
-       ENDDO
-
-       rho_air_zw(nzt+1)  = rho_air_zw(nzt) + 2.0_wp * ( rho_air(nzt+1) - rho_air_zw(nzt)  )
+
+       rif  => rif_1
+       shf  => shf_1
+       usws => usws_1
+       vsws => vsws_1
+       e    => e_1;   e_p  => e_2;   te_m  => e_3;   e_m  => e_3
+       kh   => kh_1
+       km   => km_1
+       pt   => pt_1;  pt_p => pt_2;  tpt_m => pt_3;  pt_m => pt_3
+       u    => u_1;   u_p  => u_2;   tu_m  => u_3;   u_m  => u_3
+       v    => v_1;   v_p  => v_2;   tv_m  => v_3;   v_m  => v_3
+       w    => w_1;   w_p  => w_2;   tw_m  => w_3;   w_m  => w_3
+
+       IF ( moisture  .OR.  passive_scalar )  THEN
+          qsws   => qsws_1
+          q      => q_1;     q_p  => q_2;     tq_m => q_3;    q_m => q_3
+          IF ( moisture )        vpt  => vpt_1
+          IF ( cloud_physics )   ql   => ql_1
+          IF ( cloud_droplets )  THEN
+             ql   => ql_1
+             ql_c => ql_2
+          ENDIF
+       ENDIF
 
     ENDIF
-!
-!-- Compute the inverse density array in order to avoid expencive divisions
-    drho_air    = 1.0_wp / rho_air
-    drho_air_zw = 1.0_wp / rho_air_zw
-
-!
-!-- Allocation of flux conversion arrays
-    ALLOCATE( heatflux_input_conversion(nzb:nzt+1) )
-    ALLOCATE( waterflux_input_conversion(nzb:nzt+1) )
-    ALLOCATE( momentumflux_input_conversion(nzb:nzt+1) )
-    ALLOCATE( heatflux_output_conversion(nzb:nzt+1) )
-    ALLOCATE( waterflux_output_conversion(nzb:nzt+1) )
-    ALLOCATE( momentumflux_output_conversion(nzb:nzt+1) )
-
-!
-!-- Calculate flux conversion factors according to approximation and in-/output mode
-    DO  k = nzb, nzt+1
-
-        IF ( TRIM( flux_input_mode ) == 'kinematic' )  THEN
-            heatflux_input_conversion(k)      = rho_air_zw(k)
-            waterflux_input_conversion(k)     = rho_air_zw(k)
-            momentumflux_input_conversion(k)  = rho_air_zw(k)
-        ELSEIF ( TRIM( flux_input_mode ) == 'dynamic' ) THEN
-            heatflux_input_conversion(k)      = 1.0_wp / c_p
-            waterflux_input_conversion(k)     = 1.0_wp / l_v
-            momentumflux_input_conversion(k)  = 1.0_wp
-        ENDIF
-
-        IF ( TRIM( flux_output_mode ) == 'kinematic' )  THEN
-            heatflux_output_conversion(k)     = drho_air_zw(k)
-            waterflux_output_conversion(k)    = drho_air_zw(k)
-            momentumflux_output_conversion(k) = drho_air_zw(k)
-        ELSEIF ( TRIM( flux_output_mode ) == 'dynamic' ) THEN
-            heatflux_output_conversion(k)     = c_p
-            waterflux_output_conversion(k)    = l_v
-            momentumflux_output_conversion(k) = 1.0_wp
-        ENDIF
-
-        IF ( .NOT. humidity ) THEN
-            waterflux_input_conversion(k)  = 1.0_wp
-            waterflux_output_conversion(k) = 1.0_wp
-        ENDIF
-
-    ENDDO
-
-!
-!-- In case of multigrid method, compute grid lengths and grid factors for the grid levels with
-!-- respective density on each grid.
-    IF ( psolver(1:9) == 'multigrid' )  THEN
-
-       ALLOCATE( ddx2_mg(maximum_grid_level) )
-       ALLOCATE( ddy2_mg(maximum_grid_level) )
-       ALLOCATE( dzu_mg(nzb+1:nzt+1,maximum_grid_level) )
-       ALLOCATE( dzw_mg(nzb+1:nzt+1,maximum_grid_level) )
-       ALLOCATE( f1_mg(nzb+1:nzt,maximum_grid_level) )
-       ALLOCATE( f2_mg(nzb+1:nzt,maximum_grid_level) )
-       ALLOCATE( f3_mg(nzb+1:nzt,maximum_grid_level) )
-       ALLOCATE( rho_air_mg(nzb:nzt+1,maximum_grid_level) )
-       ALLOCATE( rho_air_zw_mg(nzb:nzt+1,maximum_grid_level) )
-
-       dzu_mg(:,maximum_grid_level) = dzu
-       rho_air_mg(:,maximum_grid_level) = rho_air
-!
-!--    Next line to ensure an equally spaced grid.
-       dzu_mg(1,maximum_grid_level) = dzu(2)
-       rho_air_mg(nzb,maximum_grid_level) = rho_air(nzb) + (rho_air(nzb) - rho_air(nzb+1))
-
-       dzw_mg(:,maximum_grid_level) = dzw
-       rho_air_zw_mg(:,maximum_grid_level) = rho_air_zw
-       nzt_l = nzt
-       DO  l = maximum_grid_level-1, 1, -1
-           dzu_mg(nzb+1,l) = 2.0_wp * dzu_mg(nzb+1,l+1)
-           dzw_mg(nzb+1,l) = 2.0_wp * dzw_mg(nzb+1,l+1)
-           rho_air_mg(nzb,l)    = rho_air_mg(nzb,l+1)    + ( rho_air_mg(nzb,l+1)    -              &
-                                                             rho_air_mg(nzb+1,l+1)    )
-           rho_air_zw_mg(nzb,l) = rho_air_zw_mg(nzb,l+1) + ( rho_air_zw_mg(nzb,l+1) -              &
-                                                             rho_air_zw_mg(nzb+1,l+1) )
-           rho_air_mg(nzb+1,l)    = rho_air_mg(nzb+1,l+1)
-           rho_air_zw_mg(nzb+1,l) = rho_air_zw_mg(nzb+1,l+1)
-           nzt_l = nzt_l / 2
-           DO  k = 2, nzt_l+1
-              dzu_mg(k,l) = dzu_mg(2*k-2,l+1) + dzu_mg(2*k-1,l+1)
-              dzw_mg(k,l) = dzw_mg(2*k-2,l+1) + dzw_mg(2*k-1,l+1)
-              rho_air_mg(k,l)    = rho_air_mg(2*k-1,l+1)
-              rho_air_zw_mg(k,l) = rho_air_zw_mg(2*k-1,l+1)
-           ENDDO
-       ENDDO
-
-       nzt_l = nzt
-       dx_l  = dx
-       dy_l  = dy
-       DO  l = maximum_grid_level, 1, -1
-          ddx2_mg(l) = 1.0_wp / dx_l**2
-          ddy2_mg(l) = 1.0_wp / dy_l**2
-          DO  k = nzb+1, nzt_l
-             f2_mg(k,l) = rho_air_zw_mg(k,l) / ( dzu_mg(k+1,l) * dzw_mg(k,l) )
-             f3_mg(k,l) = rho_air_zw_mg(k-1,l) / ( dzu_mg(k,l)   * dzw_mg(k,l) )
-             f1_mg(k,l) = 2.0_wp * ( ddx2_mg(l) + ddy2_mg(l) )                                     &
-                          * rho_air_mg(k,l) + f2_mg(k,l) + f3_mg(k,l)
-          ENDDO
-          nzt_l = nzt_l / 2
-          dx_l  = dx_l * 2.0_wp
-          dy_l  = dy_l * 2.0_wp
-       ENDDO
-
-    ENDIF
-
-!
-!-- 1D-array for large scale subsidence velocity
-    IF ( .NOT. ALLOCATED( w_subs ) )  THEN
-       ALLOCATE ( w_subs(nzb:nzt+1) )
-       w_subs = 0.0_wp
-    ENDIF
-
-!
-!-- Initial assignment of the pointers
-    IF ( .NOT. neutral )  THEN
-       pt => pt_1;  pt_p => pt_2;  tpt_m => pt_3
-    ELSE
-       pt => pt_1;  pt_p => pt_1;  tpt_m => pt_3
-    ENDIF
-    u  => u_1;   u_p  => u_2;   tu_m  => u_3
-    v  => v_1;   v_p  => v_2;   tv_m  => v_3
-    w  => w_1;   w_p  => w_2;   tw_m  => w_3
-
-    IF ( humidity )  THEN
-       q => q_1;  q_p => q_2;  tq_m => q_3
-       vpt  => vpt_1
-    ENDIF
-
-    IF ( passive_scalar )  THEN
-       s => s_1;  s_p => s_2;  ts_m => s_3
-    ENDIF
-
-!
-!-- Initialize surface arrays
-    CALL init_surface_arrays
-!
-!-- Allocate arrays for other modules
-    CALL module_interface_init_arrays
-
-
-!
-!-- Allocate arrays containing the RK coefficient for calculation of perturbation pressure and
-!-- turbulent fluxes. At this point values are set for pressure calculation during initialization
-!-- (where no timestep is done). Further below the values needed within the timestep scheme will be
-!-- set.
-    ALLOCATE( weight_substep(1:intermediate_timestep_count_max),                                   &
-              weight_pres(1:intermediate_timestep_count_max) )
-    weight_substep = 1.0_wp
-    weight_pres    = 1.0_wp
-    intermediate_timestep_count = 0  ! needed when simulated_time = 0.0
-
-    IF ( debug_output )  CALL debug_message( 'allocating arrays', 'end' )
-
-!
-!-- Initialize time series
-    ts_value = 0.0_wp
-
-!
-!-- Initialize local summation arrays for routine flow_statistics.
-!-- This is necessary because they may not yet have been initialized when they are called from
-!-- flow_statistics (or - depending on the chosen model run - are never initialized)
-    sums_divnew_l  = 0.0_wp
-    sums_divold_l  = 0.0_wp
-    sums_l_l       = 0.0_wp
-    sums_wsts_bc_l = 0.0_wp
 
 !
 !-- Initialize model variables
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.                                &
-         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
-!
-!--    Initialization with provided input data derived from larger-scale model
-       IF ( INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
-          IF ( debug_output )  CALL debug_message( 'initializing with INIFOR', 'start' )
-!
-!--       Read initial 1D profiles or 3D data from NetCDF file, depending on the provided
-!--       level-of-detail.
-!--       At the moment, only u, v, w, pt and q are provided.
-          CALL netcdf_data_input_init_3d
-!
-!--       Please note, Inifor provides data from nzb+1 to nzt.
-!--       Bottom and top boundary conditions for Inifor profiles are already set (just after
-!--       reading), so that this is not necessary here.
-!--       Depending on the provided level-of-detail, initial Inifor data is either stored on data
-!--       type (lod=1), or directly on 3D arrays (lod=2).
-!--       In order to obtain also initial profiles in case of lod=2 (which is required for e.g.
-!--       damping), average over 3D data.
-          IF( init_3d%lod_u == 1 )  THEN
-             u_init = init_3d%u_init
-          ELSEIF( init_3d%lod_u == 2 )  THEN
-             ALLOCATE( init_l(nzb:nzt+1) )
-             DO  k = nzb, nzt+1
-                init_l(k) = SUM( u(k,nys:nyn,nxl:nxr) )
-             ENDDO
-             init_l = init_l / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )
-
-#if defined( __parallel )
-             CALL MPI_ALLREDUCE( init_l, u_init, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-             u_init = init_l
-#endif
-             DEALLOCATE( init_l )
-
-          ENDIF
-
-          IF( init_3d%lod_v == 1 )  THEN
-             v_init = init_3d%v_init
-          ELSEIF( init_3d%lod_v == 2 )  THEN
-             ALLOCATE( init_l(nzb:nzt+1) )
-             DO  k = nzb, nzt+1
-                init_l(k) = SUM( v(k,nys:nyn,nxl:nxr) )
-             ENDDO
-             init_l = init_l / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )
-
-#if defined( __parallel )
-             CALL MPI_ALLREDUCE( init_l, v_init, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-             v_init = init_l
-#endif
-             DEALLOCATE( init_l )
-          ENDIF
-          IF( .NOT. neutral )  THEN
-             IF( init_3d%lod_pt == 1 )  THEN
-                pt_init = init_3d%pt_init
-             ELSEIF( init_3d%lod_pt == 2 )  THEN
-                ALLOCATE( init_l(nzb:nzt+1) )
-                DO  k = nzb, nzt+1
-                   init_l(k) = SUM( pt(k,nys:nyn,nxl:nxr) )
-                ENDDO
-                init_l = init_l / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )
-
-#if defined( __parallel )
-                CALL MPI_ALLREDUCE( init_l, pt_init, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-                pt_init = init_l
-#endif
-                DEALLOCATE( init_l )
-             ENDIF
-          ENDIF
-
-
-          IF( humidity )  THEN
-             IF( init_3d%lod_q == 1 )  THEN
-                q_init = init_3d%q_init
-             ELSEIF( init_3d%lod_q == 2 )  THEN
-                ALLOCATE( init_l(nzb:nzt+1) )
-                DO  k = nzb, nzt+1
-                   init_l(k) = SUM( q(k,nys:nyn,nxl:nxr) )
-                ENDDO
-                init_l = init_l / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )
-
-#if defined( __parallel )
-                CALL MPI_ALLREDUCE( init_l, q_init, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-                q_init = init_l
-#endif
-                DEALLOCATE( init_l )
-             ENDIF
-          ENDIF
-
-!
-!--       Write initial profiles onto 3D arrays.
-!--       Work-around, 3D initialization of u,v,w creates artificial structures which correlate with
-!--       the processor grid. The reason for this is still unknown. To work-around this, 3D
-!--       initialization will be effectively reduce to a 1D initialization where no such artificial
-!--       structures appear.
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                IF( init_3d%lod_u == 1  .OR.  init_3d%lod_u == 2 )  u(:,j,i) = u_init(:)
-                IF( init_3d%lod_v == 1  .OR.  init_3d%lod_u == 2 )  v(:,j,i) = v_init(:)
-                IF( .NOT. neutral  .AND.  ( init_3d%lod_pt == 1  .OR.  init_3d%lod_pt == 2 ) )     &
-                   pt(:,j,i) = pt_init(:)
-                IF( humidity  .AND.  ( init_3d%lod_q == 1  .OR.  init_3d%lod_q == 2 ) )            &
-                   q(:,j,i) = q_init(:)
-             ENDDO
-          ENDDO
-!
-!--       Set geostrophic wind components.
-          IF ( init_3d%from_file_ug )  THEN
-             ug(:) = init_3d%ug_init(:)
-          ENDIF
-          IF ( init_3d%from_file_vg )  THEN
-             vg(:) = init_3d%vg_init(:)
-          ENDIF
-!
-!--       Set bottom and top boundary condition for geostrophic wind
-          ug(nzt+1) = ug(nzt)
-          vg(nzt+1) = vg(nzt)
-          ug(nzb)   = ug(nzb+1)
-          vg(nzb)   = vg(nzb+1)
-!
-!--       Set inital w to 0
-          w = 0.0_wp
-
-          IF ( passive_scalar )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   s(:,j,i) = s_init
-                ENDDO
-             ENDDO
-          ENDIF
-
-!
-!--       Set velocity components at non-atmospheric / oceanic grid points to zero.
-          u = MERGE( u, 0.0_wp, BTEST( wall_flags_total_0, 1 ) )
-          v = MERGE( v, 0.0_wp, BTEST( wall_flags_total_0, 2 ) )
-          w = MERGE( w, 0.0_wp, BTEST( wall_flags_total_0, 3 ) )
-!
-!--       Initialize surface variables, e.g. friction velocity, momentum fluxes, etc.
-          CALL  init_surfaces
-
-          IF ( debug_output )  CALL  debug_message( 'initializing with INIFOR', 'end' )
-!
-!--    Initialization via computed 1D-model profiles
-       ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
-
-          IF ( debug_output )  CALL  debug_message( 'initializing with 1D model profiles', 'start' )
+    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
+!
+!--    First model run of a possible job queue.
+!--    Initial profiles of the variables must be computes.
+       IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
 !
 !--       Use solutions of the 1D model as initial profiles,
@@ -786,15 +359,26 @@
 !
 !--       Transfer initial profiles to the arrays of the 3D model
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                e(:,j,i)  = e1d
+                kh(:,j,i) = kh1d
+                km(:,j,i) = km1d
                 pt(:,j,i) = pt_init
+             ENDDO
+          ENDDO
+          DO  i = nxl-1, nxr+uxrp+1
+             DO  j = nys-1, nyn+1
                 u(:,j,i)  = u1d
+             ENDDO
+          ENDDO
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+vynp+1
                 v(:,j,i)  = v1d
              ENDDO
           ENDDO
 
-          IF ( humidity )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
+          IF ( moisture  .OR.  passive_scalar )  THEN
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
                    q(:,j,i) = q_init
                 ENDDO
@@ -802,81 +386,120 @@
           ENDIF
 
-          IF ( passive_scalar )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   s(:,j,i) = s_init
-                ENDDO
-             ENDDO
-          ENDIF
-!
-!--          Store initial profiles for output purposes etc.
           IF ( .NOT. constant_diffusion )  THEN
-             hom(:,1,25,:) = SPREAD( l1d, 2, statistic_regions+1 )
-          ENDIF
-!
-!--       Set velocities back to zero
-          u = MERGE( u, 0.0_wp, BTEST( wall_flags_total_0, 1 ) )
-          v = MERGE( v, 0.0_wp, BTEST( wall_flags_total_0, 2 ) )
-!
-!--       WARNING: The extra boundary conditions set after running the 1D model impose an error on
-!--       -------- the divergence one layer below the topography; need to correct later
-!--       ATTENTION: Provisional correction for Piacsek & Williams advection scheme: keep u and v
-!--       ---------- zero one layer below the topography.
-          IF ( ibc_uv_b == 1 )  THEN
-!
-!--          Neumann condition
              DO  i = nxl-1, nxr+1
                 DO  j = nys-1, nyn+1
-                   u(nzb,j,i) = u(nzb+1,j,i)
-                   v(nzb,j,i) = v(nzb+1,j,i)
+                   e(:,j,i)  = e1d
                 ENDDO
              ENDDO
-
-          ENDIF
-!
-!--       Initialize surface variables, e.g. friction velocity, momentum fluxes, etc.
-          CALL init_surfaces
-
-          IF ( debug_output )  CALL  debug_message( 'initializing with 1D model profiles', 'end' )
-
-       ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )  THEN
-
-          IF ( debug_output )  CALL  debug_message( 'initializing with constant profiles', 'start' )
-
-!
-!--       Use constructed initial profiles (velocity constant with height, temperature profile with
-!--       constant gradient)
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                pt(:,j,i) = pt_init
-                u(:,j,i)  = u_init
-                v(:,j,i)  = v_init
-             ENDDO
-          ENDDO
-!
-!--       Mask topography
-          u = MERGE( u, 0.0_wp, BTEST( wall_flags_total_0, 1 ) )
-          v = MERGE( v, 0.0_wp, BTEST( wall_flags_total_0, 2 ) )
-!
-!--       Set initial horizontal velocities at the lowest computational grid levels to zero in order
-!--       to avoid too small time steps caused by the diffusion limit in the initial phase of a run
-!--       (at k=1, dz/2 occurs in the limiting formula!).
-!--       Please note, in case land- or urban-surface model is used and a spinup is applied, masking
-!--       the lowest computational level is not possible as MOST as well as energy-balance
-!--       parametrizations will not work with zero wind velocity.
-          IF ( ibc_uv_b /= 1  .AND.  .NOT. spinup )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO  k = nzb, nzt
-                      u(k,j,i) = MERGE( u(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 20 ) )
-                      v(k,j,i) = MERGE( v(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 21 ) )
+!
+!--          Store initial profiles for output purposes etc.
+             hom(:,1,25,:) = SPREAD( l1d, 2, statistic_regions+1 )
+
+             IF ( prandtl_layer )  THEN
+                rif  = rif1d(nzb+1)
+                ts   = 0.0  ! could actually be computed more accurately in the
+                            ! 1D model. Update when opportunity arises.
+                us   = us1d
+                usws = usws1d
+                vsws = vsws1d
+             ELSE
+                ts   = 0.0  ! must be set, because used in
+                rif  = 0.0  ! flowste
+                us   = 0.0
+                usws = 0.0
+                vsws = 0.0
+             ENDIF
+
+          ELSE
+             e    = 0.0  ! must be set, because used in
+             rif  = 0.0  ! flowste
+             ts   = 0.0
+             us   = 0.0
+             usws = 0.0
+             vsws = 0.0
+          ENDIF
+
+!
+!--       In every case qs = 0.0 (see also pt)
+!--       This could actually be computed more accurately in the 1D model.
+!--       Update when opportunity arises!
+          IF ( moisture  .OR.  passive_scalar )  qs = 0.0
+
+!
+!--       inside buildings set velocities back to zero
+          IF ( topography /= 'flat' )  THEN
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   u(nzb:nzb_u_inner(j,i),j,i) = 0.0
+                   v(nzb:nzb_v_inner(j,i),j,i) = 0.0
+                ENDDO
+             ENDDO
+!
+!--          WARNING: The extra boundary conditions set after running the
+!--          -------  1D model impose an error on the divergence one layer
+!--                   below the topography; need to correct later 
+!--          ATTENTION: Provisional correction for Piacsek & Williams
+!--          ---------  advection scheme: keep u and v zero one layer below
+!--                     the topography.
+             IF ( ibc_uv_b == 0 )  THEN
+!
+!--             Satisfying the Dirichlet condition with an extra layer below
+!--             the surface where the u and v component change their sign.
+                DO  i = nxl-1, nxr+1
+                   DO  j = nys-1, nyn+1
+                      IF ( nzb_u_inner(j,i) == 0 ) u(0,j,i) = -u(1,j,i)
+                      IF ( nzb_v_inner(j,i) == 0 ) v(0,j,i) = -v(1,j,i)
                    ENDDO
                 ENDDO
-             ENDDO
-          ENDIF
-
-          IF ( humidity )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
+
+             ELSE
+!
+!--             Neumann condition
+                DO  i = nxl-1, nxr+1
+                   DO  j = nys-1, nyn+1
+                      IF ( nzb_u_inner(j,i) == 0 ) u(0,j,i) = u(1,j,i)
+                      IF ( nzb_v_inner(j,i) == 0 ) v(0,j,i) = v(1,j,i)
+                   ENDDO
+                ENDDO
+
+             ENDIF
+
+          ENDIF
+
+       ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 ) &
+       THEN
+!
+!--       Use constructed initial profiles (velocity constant with height,
+!--       temperature profile with constant gradient)
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                pt(:,j,i) = pt_init
+             ENDDO
+          ENDDO
+          DO  i = nxl-1, nxr+uxrp+1
+             DO  j = nys-1, nyn+1
+                u(:,j,i)  = u_init
+             ENDDO
+          ENDDO
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+vynp+1
+                v(:,j,i)  = v_init
+             ENDDO
+          ENDDO
+!
+!--       Set initial horizontal velocities at the lowest grid levels to zero
+!--       in order to avoid too small time steps caused by the diffusion
+!--       limit in the initial phase of a run (at k=1, dz/2 occurs in the
+!--       limiting formula!)
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                u(nzb:nzb_u_inner(j,i)+1,j,i) = 0.0
+                v(nzb:nzb_v_inner(j,i)+1,j,i) = 0.0
+             ENDDO
+          ENDDO
+
+          IF ( moisture  .OR.  passive_scalar )  THEN
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
                    q(:,j,i) = q_init
                 ENDDO
@@ -884,79 +507,57 @@
           ENDIF
 
-          IF ( passive_scalar )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   s(:,j,i) = s_init
-                ENDDO
-             ENDDO
-          ENDIF
-
-!
-!--       Compute initial temperature field and other constants used in case of a sloping surface.
+          
+          IF ( constant_diffusion )  THEN
+             km   = km_constant
+             kh   = km / prandtl_number
+          ELSE
+             kh   = 0.01   ! there must exist an initial diffusion, because 
+             km   = 0.01   ! otherwise no TKE would be produced by the
+                           ! production terms, as long as not yet
+                           ! e = (u*/cm)**2 at k=nzb+1
+          ENDIF
+          e    = 0.0
+          rif  = 0.0
+          ts   = 0.0
+          us   = 0.0
+          usws = 0.0
+          vsws = 0.0
+          IF ( moisture  .OR.  passive_scalar ) qs = 0.0
+
+!
+!--       Compute initial temperature field and other constants used in case
+!--       of a sloping surface
           IF ( sloping_surface )  CALL init_slope
-!
-!--       Initialize surface variables, e.g. friction velocity, momentum fluxes, etc.
-          CALL init_surfaces
-
-          IF ( debug_output )  CALL debug_message( 'initializing with constant profiles', 'end' )
-
-       ELSEIF ( INDEX(initializing_actions, 'by_user') /= 0 )  THEN
-
-          IF ( debug_output )  CALL debug_message( 'initializing by user', 'start' )
-!
-!--       Pre-initialize surface variables, i.e. setting start- and end-indices at each
-!--       (j,i)-location. Please note, this does not supersede user-defined initialization of
-!--       surface quantities.
-          CALL init_surfaces
-!
-!--       Initialization will completely be done by the user
-          CALL user_init_3d_model
-
-          IF ( debug_output )  CALL debug_message( 'initializing by user', 'end' )
-
-       ENDIF
-
-       IF ( debug_output )  THEN
-          CALL debug_message( 'initializing statistics, boundary conditions, etc.', 'start' )
-       ENDIF
-
-!
-!--    Bottom boundary
-       IF ( ibc_uv_b == 0  .OR.  ibc_uv_b == 2  )  THEN
-          u(nzb,:,:) = 0.0_wp
-          v(nzb,:,:) = 0.0_wp
-       ENDIF
-
-!
-!--    Apply channel flow boundary condition
-       IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
-          u(nzt+1,:,:) = 0.0_wp
-          v(nzt+1,:,:) = 0.0_wp
+
        ENDIF
 
 !
 !--    Calculate virtual potential temperature
-       IF ( humidity )  vpt = pt * ( 1.0_wp + 0.61_wp * q )
-
-!
-!--    Store initial profiles for output purposes etc.. Please note, in case of initialization of u,
-!--    v, w, pt, and q via output data derived from larger scale models, data will not be
-!--    horizontally homogeneous. Actually, a mean profile should be calculated before.
+       IF ( moisture ) vpt = pt * ( 1.0 + 0.61 * q )
+
+!
+!--    Store initial profiles for output purposes etc.
        hom(:,1,5,:) = SPREAD( u(:,nys,nxl), 2, statistic_regions+1 )
        hom(:,1,6,:) = SPREAD( v(:,nys,nxl), 2, statistic_regions+1 )
-       IF ( ibc_uv_b == 0 .OR. ibc_uv_b == 2)  THEN
-          hom(nzb,1,5,:) = 0.0_wp
-          hom(nzb,1,6,:) = 0.0_wp
+       IF ( ibc_uv_b == 0 )  THEN
+          hom(nzb,1,5,:) = -hom(nzb+1,1,5,:)  ! due to satisfying the Dirichlet 
+          hom(nzb,1,6,:) = -hom(nzb+1,1,6,:)  ! condition with an extra layer 
+              ! below the surface where the u and v component change their sign
        ENDIF
        hom(:,1,7,:)  = SPREAD( pt(:,nys,nxl), 2, statistic_regions+1 )
-
-       IF ( humidity )  THEN
-!
-!--       Store initial profile of total water content, virtual potential temperature
+       hom(:,1,23,:) = SPREAD( km(:,nys,nxl), 2, statistic_regions+1 )
+       hom(:,1,24,:) = SPREAD( kh(:,nys,nxl), 2, statistic_regions+1 )
+
+
+       IF ( moisture )  THEN
+!
+!--       Store initial profile of total water content, virtual potential
+!--       temperature 
           hom(:,1,26,:) = SPREAD(   q(:,nys,nxl), 2, statistic_regions+1 )
           hom(:,1,29,:) = SPREAD( vpt(:,nys,nxl), 2, statistic_regions+1 )
-!
-!--       Store initial profile of mixing ratio and potential temperature
-          IF ( bulk_cloud_model  .OR.  cloud_droplets ) THEN
+          IF ( cloud_physics  .OR.  cloud_droplets ) THEN
+!
+!--          Store initial profile of specific humidity and potential
+!--          temperature
              hom(:,1,27,:) = SPREAD(  q(:,nys,nxl), 2, statistic_regions+1 )
              hom(:,1,28,:) = SPREAD( pt(:,nys,nxl), 2, statistic_regions+1 )
@@ -964,45 +565,131 @@
        ENDIF
 
-!
-!--    Store initial scalar profile
        IF ( passive_scalar )  THEN
-          hom(:,1,121,:) = SPREAD(  s(:,nys,nxl), 2, statistic_regions+1 )
-       ENDIF
-
-!
-!--    Initialize the random number generators (from numerical recipes)
-       CALL random_function_ini
-
-       IF ( random_generator == 'random-parallel' )  THEN
-          CALL init_parallel_random_generator( nx, nys, nyn, nxl, nxr )
-       ENDIF
-!
-!--    Set the reference state to be used in the buoyancy terms (for ocean runs the reference state
-!--    will be set (overwritten) in init_ocean).
-       IF ( use_single_reference_value )  THEN
-          IF ( .NOT. humidity )  THEN
-             ref_state(:) = pt_reference
-          ELSE
-             ref_state(:) = vpt_reference
-          ENDIF
-       ELSE
-          IF ( .NOT. humidity )  THEN
-             ref_state(:) = pt_init(:)
-          ELSE
-             ref_state(:) = vpt(:,nys,nxl)
-          ENDIF
-       ENDIF
-
-!
-!--    For the moment, vertical velocity is zero
-       w = 0.0_wp
+!
+!--       Store initial scalar profile
+          hom(:,1,26,:) = SPREAD(  q(:,nys,nxl), 2, statistic_regions+1 )
+       ENDIF
+
+!
+!--    Initialize surface fluxes
+       IF ( use_surface_fluxes )  THEN
+
+          IF ( constant_heatflux )  THEN
+!
+!--          Heat flux is prescribed
+             IF ( random_heatflux )  THEN
+                CALL disturb_heatflux
+             ELSE
+                shf = surface_heatflux
+!
+!--             Over topography surface_heatflux is replaced by wall_heatflux(0)
+                IF ( TRIM( topography ) /= 'flat' )  THEN
+                   DO  i = nxl-1, nxr+1
+                      DO  j = nys-1, nyn+1
+                         IF ( nzb_s_inner(j,i) /= 0 )  THEN
+                            shf(j,i) = wall_heatflux(0)
+                         ENDIF
+                      ENDDO
+                   ENDDO
+                ENDIF
+             ENDIF
+             IF ( ASSOCIATED( shf_m ) )  shf_m = shf
+          ENDIF
+
+!
+!--       Determine the near-surface water flux
+          IF ( moisture  .OR.  passive_scalar )  THEN
+             IF ( constant_waterflux )  THEN
+                qsws   = surface_waterflux
+                IF ( ASSOCIATED( qsws_m ) )  qsws_m = qsws
+             ENDIF
+          ENDIF
+
+       ENDIF
+
+!
+!--    Initialize Prandtl layer quantities
+       IF ( prandtl_layer )  THEN
+
+          z0 = roughness_length
+
+          IF ( .NOT. constant_heatflux )  THEN 
+!
+!--          Surface temperature is prescribed. Here the heat flux cannot be
+!--          simply estimated, because therefore rif, u* and theta* would have
+!--          to be computed by iteration. This is why the heat flux is assumed
+!--          to be zero before the first time step. It approaches its correct
+!--          value in the course of the first few time steps.
+             shf   = 0.0
+             IF ( ASSOCIATED( shf_m ) )  shf_m = 0.0
+          ENDIF
+
+          IF ( moisture  .OR.  passive_scalar )  THEN
+             IF ( .NOT. constant_waterflux )  THEN
+                qsws   = 0.0
+                IF ( ASSOCIATED( qsws_m ) )   qsws_m = 0.0
+             ENDIF
+          ENDIF
+
+       ENDIF
+
+!
+!--    Calculate the initial volume flow at the right and north boundary
+       IF ( conserve_volume_flow )  THEN
+
+          volume_flow_initial_l = 0.0
+          volume_flow_area_l    = 0.0
+  
+          IF ( nxr == nx )  THEN
+             DO  j = nys, nyn
+                DO  k = nzb_2d(j,nx) + 1, nzt
+                   volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
+                                              u(k,j,nx) * dzu(k)
+                   volume_flow_area_l(1)    = volume_flow_area_l(1) + dzu(k)
+                ENDDO
+             ENDDO
+          ENDIF
+
+          IF ( nyn == ny )  THEN
+             DO  i = nxl, nxr
+                DO  k = nzb_2d(ny,i) + 1, nzt  
+                   volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
+                                              v(k,ny,i) * dzu(k)
+                   volume_flow_area_l(2)    = volume_flow_area_l(2) + dzu(k)
+                ENDDO
+             ENDDO
+          ENDIF
+
+#if defined( __parallel )
+          CALL MPI_ALLREDUCE( volume_flow_initial_l(1), volume_flow_initial(1),&
+                              2, MPI_REAL, MPI_SUM, comm2d, ierr )
+          CALL MPI_ALLREDUCE( volume_flow_area_l(1), volume_flow_area(1),      &
+                              2, MPI_REAL, MPI_SUM, comm2d, ierr )
+#else
+          volume_flow_initial = volume_flow_initial_l
+          volume_flow_area    = volume_flow_area_l
+#endif  
+       ENDIF
+
+!
+!--    For the moment, perturbation pressure and vertical velocity are zero
+       p = 0.0; w = 0.0
 
 !
 !--    Initialize array sums (must be defined in first call of pres)
-       sums = 0.0_wp
-
-!
-!--    In case of iterative solvers, p must get an initial value
-       IF ( psolver(1:9) == 'multigrid'  .OR.  psolver == 'sor' )  p = 0.0_wp
+       sums = 0.0
+
+!
+!--    Treating cloud physics, liquid water content is zero at beginning of
+!--    the simulation
+       IF ( cloud_physics )  ql = 0.0
+
+!
+!--    Initialize spectra
+       IF ( dt_dosp /= 9999999.9 )  THEN
+          spectrum_x = 0.0
+          spectrum_y = 0.0
+       ENDIF
+
 !
 !--    Impose vortex with vertical axis on the initial velocity profile
@@ -1012,7 +699,6 @@
 
 !
-!--    Impose temperature anomaly (advection test only) or warm air bubble close to surface.
-       IF ( INDEX( initializing_actions, 'initialize_ptanom' ) /= 0  .OR.                          &
-            INDEX( initializing_actions, 'initialize_bubble' ) /= 0  )  THEN
+!--    Impose temperature anomaly (advection test only)
+       IF ( INDEX( initializing_actions, 'initialize_ptanom' ) /= 0 )  THEN
           CALL init_pt_anomaly
        ENDIF
@@ -1020,5 +706,5 @@
 !
 !--    If required, change the surface temperature at the start of the 3D run
-       IF ( pt_surface_initial_change /= 0.0_wp )  THEN
+       IF ( pt_surface_initial_change /= 0.0 )  THEN
           pt(nzb,:,:) = pt(nzb,:,:) + pt_surface_initial_change
        ENDIF
@@ -1027,692 +713,237 @@
 !--    If required, change the surface humidity/scalar at the start of the 3D
 !--    run
-       IF ( humidity  .AND.  q_surface_initial_change /= 0.0_wp )                                  &
+       IF ( ( moisture .OR. passive_scalar ) .AND. &
+            q_surface_initial_change /= 0.0 )  THEN
           q(nzb,:,:) = q(nzb,:,:) + q_surface_initial_change
-
-       IF ( passive_scalar  .AND.  s_surface_initial_change /= 0.0_wp )                            &
-          s(nzb,:,:) = s(nzb,:,:) + s_surface_initial_change
-
+       ENDIF
+
+!
+!--    Initialize the random number generator (from numerical recipes)
+       CALL random_function_ini
+
+!
+!--    Impose random perturbation on the horizontal velocity field and then
+!--    remove the divergences from the velocity field
+       IF ( create_disturbances )  THEN
+          CALL disturb_field( nzb_u_inner, tend, u, uxrp,    0 )
+          CALL disturb_field( nzb_v_inner, tend, v,    0, vynp )
+          n_sor = nsor_ini
+          CALL pres
+          n_sor = nsor
+       ENDIF
+
+!
+!--    Once again set the perturbation pressure explicitly to zero in order to
+!--    assure that it does not generate any divergences in the first time step.
+!--    At t=0 the velocity field is free of divergence (as constructed above).
+!--    Divergences being created during a time step are not yet known and thus
+!--    cannot be corrected during the time step yet.
+       p = 0.0
 
 !
 !--    Initialize old and new time levels.
-       tpt_m = 0.0_wp; tu_m = 0.0_wp; tv_m = 0.0_wp; tw_m = 0.0_wp
-       pt_p = pt; u_p = u; v_p = v; w_p = w
-
-       IF ( humidity  )  THEN
-          tq_m = 0.0_wp
+       IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+          e_m = e; pt_m = pt; u_m = u; v_m = v; w_m = w; kh_m = kh; km_m = km
+       ELSE
+          te_m = 0.0; tpt_m = 0.0; tu_m = 0.0; tv_m = 0.0; tw_m = 0.0
+       ENDIF
+       e_p = e; pt_p = pt; u_p = u; v_p = v; w_p = w
+
+       IF ( moisture  .OR.  passive_scalar )  THEN
+          IF ( ASSOCIATED( q_m ) )  q_m = q
+          IF ( timestep_scheme(1:5) == 'runge' )  tq_m = 0.0
           q_p = q
-       ENDIF
-
-       IF ( passive_scalar )  THEN
-          ts_m = 0.0_wp
-          s_p  = s
-       ENDIF
-
-       IF ( debug_output )  THEN
-          CALL debug_message( 'initializing statistics, boundary conditions, etc.', 'end' )
-       ENDIF
-
-    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.         &
-             TRIM( initializing_actions ) == 'cyclic_fill' )                   &
+          IF ( moisture  .AND.  ASSOCIATED( vpt_m ) )  vpt_m = vpt
+       ENDIF
+
+    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data' ) &
     THEN
-
-       IF ( debug_output )  THEN
-          CALL debug_message( 'initializing in case of restart / cyclic_fill', 'start' )
-       ENDIF
-!
-!--    Initialize surface elements and its attributes, e.g. heat- and momentumfluxes, roughness,
-!--    scaling parameters. As number of surface elements might be different between runs, e.g. in
-!--    case of cyclic fill, and not all surface elements are read, surface elements need to be
-!--    initialized before.
-!--    Please note, in case of cyclic fill, surfaces should be initialized after restart data is
-!--    read, else, individual settings of surface parameters will be overwritten from data of
-!--    precursor run, hence, init_surfaces is called a second time after reading the restart data.
-       CALL init_surfaces
-!
-!--    When reading data for cyclic fill of 3D prerun data files, read some of the global variables
-!--    from the restart file which are required for initializing the inflow
-       IF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
-
-!
-!--       Blockwise I/O does not work together with MPI-I/O
-          IF ( restart_data_format_input(1:3) == 'mpi' )  THEN
-             CALL rrd_read_parts_of_global
-          ELSE
-             DO  i = 0, io_blocks-1
-                IF ( i == io_group )  THEN
-                   CALL rrd_read_parts_of_global
-                ENDIF
-#if defined( __parallel )
-                CALL MPI_BARRIER( comm2d, ierr )
-#endif
-             ENDDO
-          ENDIF
-
-       ENDIF
-
-!
-!--    Read processor specific binary data from restart file.
-!--    Blockwise I/O does not work together with MPI-I/O
-       IF ( restart_data_format_input(1:3) == 'mpi' )  THEN
-          CALL rrd_local
-       ELSE
-          DO  i = 0, io_blocks-1
-             IF ( i == io_group )  THEN
-                CALL rrd_local
+!
+!--    Read binary data from restart file
+       CALL read_3d_binary
+
+!
+!--    Calculate initial temperature field and other constants used in case
+!--    of a sloping surface
+       IF ( sloping_surface )  CALL init_slope
+
+!
+!--    Initialize new time levels (only done in order to set boundary values
+!--    including ghost points)
+       e_p = e; pt_p = pt; u_p = u; v_p = v; w_p = w
+       IF ( moisture  .OR.  passive_scalar )  q_p = q
+
+    ELSE
+!
+!--    Actually this part of the programm should not be reached
+       IF ( myid == 0 )  PRINT*,'+++ init_3d_model: unknown initializing ', &
+                                                    'problem'
+       CALL local_stop
+    ENDIF
+
+!
+!-- If required, initialize dvrp-software
+!    WRITE ( 9, * ) '*** myid=', myid, ' vor init_dvrp'
+!    CALL FLUSH_( 9 )
+    IF ( dt_dvrp /= 9999999.9 )  CALL init_dvrp
+!    WRITE ( 9, * ) '*** myid=', myid, ' nach init_dvrp'
+!    CALL FLUSH_( 9 )
+
+!
+!-- If required, initialize quantities for handling cloud physics
+!-- This routine must be called before init_particles, because
+!-- otherwise, array pt_d_t, needed in data_output_dvrp (called by
+!-- init_particles) is not defined.
+    CALL init_cloud_physics
+
+!
+!-- If required, initialize particles
+!    WRITE ( 9, * ) '*** myid=', myid, ' vor init_particles'
+!    CALL FLUSH_( 9 )
+    CALL init_particles
+!    WRITE ( 9, * ) '*** myid=', myid, ' nach init_particles'
+!    CALL FLUSH_( 9 )
+
+!
+!-- Initialize quantities for special advections schemes
+    CALL init_advec
+
+!
+!-- Initialize Rayleigh damping factors
+    rdf = 0.0
+    IF ( rayleigh_damping_factor /= 0.0 )  THEN
+       DO  k = nzb+1, nzt
+          IF ( zu(k) >= rayleigh_damping_height )  THEN
+             rdf(k) = rayleigh_damping_factor * &
+                      ( SIN( pi * 0.5 * ( zu(k) - rayleigh_damping_height )    &
+                                      / ( zu(nzt) - rayleigh_damping_height ) )&
+                      )**2
+          ENDIF
+       ENDDO
+    ENDIF
+
+!
+!-- Initialize diffusivities used within the outflow damping layer in case of
+!-- non-cyclic lateral boundaries. A linear increase is assumed over the first
+!-- half of the width of the damping layer
+    IF ( bc_lr /= 'cyclic' )  THEN
+
+       DO  i = nxl-1, nxr+1
+
+          IF ( outflow_r )  THEN
+
+             IF ( i >= nx - outflow_damping_width )  THEN
+                km_damp_x(i) = km_damp_max * MIN( 1.0,                    &
+                               ( i - ( nx - outflow_damping_width ) ) / &
+                               REAL( outflow_damping_width/2 )            &
+                                                )
+             ELSE
+                km_damp_x(i) = 0.0
              ENDIF
-#if defined( __parallel )
-             CALL MPI_BARRIER( comm2d, ierr )
-#endif
-          ENDDO
-       ENDIF
-
-
-       IF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
-
-!
-!--       In case of cyclic fill, call init_surfaces a second time, so that surface properties such
-!--       as heat fluxes are initialized as prescribed.
-          CALL init_surfaces
-
-!
-!--       Overwrite u_init, v_init, pt_init, q_init and s_init with the horizontally mean (hom)
-!--       vertical profiles from the end of the prerun, because these profiles shall be used as the
-!--       reference state for the rayleigh damping and the pt_damping. This is especially important
-!--       for the use of large_scale_subsidence, because the reference temperature in the free
-!--       atmosphere changes in time.
-          u_init(:) = hom_sum(:,1,0)
-          v_init(:) = hom_sum(:,2,0)
-          pt_init(:) = hom_sum(:,4,0)
-          IF ( humidity )  q_init(:) = hom_sum(:,41,0)
-          IF ( passive_scalar )  s_init(:) = hom_sum(:,115,0)
-       ENDIF
-!
-!--    In case of complex terrain and cyclic fill method as initialization, shift initial data in
-!--    the vertical direction for each point in the x-y-plane depending on local surface height.
-       IF ( complex_terrain  .AND.  TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                nz_u_shift = topo_top_ind(j,i,1)
-                nz_v_shift = topo_top_ind(j,i,2)
-                nz_w_shift = topo_top_ind(j,i,3)
-                nz_s_shift = topo_top_ind(j,i,0)
-
-                u(nz_u_shift:nzt+1,j,i)  = u(0:nzt+1-nz_u_shift,j,i)
-
-                v(nz_v_shift:nzt+1,j,i)  = v(0:nzt+1-nz_v_shift,j,i)
-
-                w(nz_w_shift:nzt+1,j,i)  = w(0:nzt+1-nz_w_shift,j,i)
-
-                p(nz_s_shift:nzt+1,j,i)  =  p(0:nzt+1-nz_s_shift,j,i)
-                pt(nz_s_shift:nzt+1,j,i) = pt(0:nzt+1-nz_s_shift,j,i)
-             ENDDO
-          ENDDO
-       ENDIF
-!
-!--    Initialization of the turbulence recycling method
-       IF ( TRIM( initializing_actions ) == 'cyclic_fill'  .AND.  turbulent_inflow )  THEN
-!
-!--       First store the profiles to be used at the inflow.
-!--       These profiles are the (temporally) and horizontally averaged vertical profiles from the
-!--       prerun. Alternatively, prescribed profiles for u,v-components can be used.
-          ALLOCATE( mean_inflow_profiles(nzb:nzt+1,1:num_mean_inflow_profiles) )
-
-          IF ( use_prescribed_profile_data )  THEN
-             mean_inflow_profiles(:,1) = u_init            ! u
-             mean_inflow_profiles(:,2) = v_init            ! v
-          ELSE
-             mean_inflow_profiles(:,1) = hom_sum(:,1,0)    ! u
-             mean_inflow_profiles(:,2) = hom_sum(:,2,0)    ! v
-          ENDIF
-          mean_inflow_profiles(:,4) = hom_sum(:,4,0)       ! pt
-          IF ( humidity )  mean_inflow_profiles(:,6) = hom_sum(:,41,0)          ! q
-          IF ( passive_scalar )  mean_inflow_profiles(:,7) = hom_sum(:,115,0)   ! s
-
-!
-!--       In case of complex terrain, determine vertical displacement at inflow boundary and adjust
-!--       mean inflow profiles
-          IF ( complex_terrain )  THEN
-             IF ( nxlg <= 0  .AND.  nxrg >= 0  .AND.  nysg <= 0  .AND.  nyng >= 0 )  THEN
-                nz_u_shift_l = topo_top_ind(j,i,1)
-                nz_v_shift_l = topo_top_ind(j,i,2)
-                nz_w_shift_l = topo_top_ind(j,i,3)
-                nz_s_shift_l = topo_top_ind(j,i,0)
+
+          ELSEIF ( outflow_l )  THEN
+
+             IF ( i <= outflow_damping_width )  THEN
+                km_damp_x(i) = km_damp_max * MIN( 1.0,                    &
+                               ( outflow_damping_width - i ) / &
+                               REAL( outflow_damping_width/2 )            &
+                                                )
              ELSE
-                nz_u_shift_l = 0
-                nz_v_shift_l = 0
-                nz_w_shift_l = 0
-                nz_s_shift_l = 0
+                km_damp_x(i) = 0.0
              ENDIF
 
-#if defined( __parallel )
-             CALL MPI_ALLREDUCE( nz_u_shift_l, nz_u_shift, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
-             CALL MPI_ALLREDUCE( nz_v_shift_l, nz_v_shift, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
-             CALL MPI_ALLREDUCE( nz_w_shift_l, nz_w_shift, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
-             CALL MPI_ALLREDUCE( nz_s_shift_l, nz_s_shift, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
-#else
-             nz_u_shift = nz_u_shift_l
-             nz_v_shift = nz_v_shift_l
-             nz_w_shift = nz_w_shift_l
-             nz_s_shift = nz_s_shift_l
-#endif
-
-             mean_inflow_profiles(:,1) = 0.0_wp
-             mean_inflow_profiles(nz_u_shift:nzt+1,1) = hom_sum(0:nzt+1-nz_u_shift,1,0)  ! u
-
-             mean_inflow_profiles(:,2) = 0.0_wp
-             mean_inflow_profiles(nz_v_shift:nzt+1,2) = hom_sum(0:nzt+1-nz_v_shift,2,0)  ! v
-
-             mean_inflow_profiles(nz_s_shift:nzt+1,4) = hom_sum(0:nzt+1-nz_s_shift,4,0)  ! pt
-
-          ENDIF
-
-!
-!--       If necessary, adjust the horizontal flow field to the prescribed profiles
-          IF ( use_prescribed_profile_data )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO  k = nzb, nzt+1
-                      u(k,j,i) = u(k,j,i) - hom_sum(k,1,0) + u_init(k)
-                      v(k,j,i) = v(k,j,i) - hom_sum(k,2,0) + v_init(k)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-
-!
-!--       Use these mean profiles at the inflow (provided that Dirichlet conditions are used)
-          IF ( bc_dirichlet_l )  THEN
-             DO  j = nysg, nyng
-                DO  k = nzb, nzt+1
-                   u(k,j,nxlg:-1)  = mean_inflow_profiles(k,1)
-                   v(k,j,nxlg:-1)  = mean_inflow_profiles(k,2)
-                   w(k,j,nxlg:-1)  = 0.0_wp
-                   pt(k,j,nxlg:-1) = mean_inflow_profiles(k,4)
-                   IF ( humidity )  q(k,j,nxlg:-1)  = mean_inflow_profiles(k,6)
-                   IF ( passive_scalar )  s(k,j,nxlg:-1)  = mean_inflow_profiles(k,7)
-                ENDDO
-             ENDDO
-          ENDIF
-
-!
-!--       Calculate the damping factors to be used at the inflow. For a turbulent inflow the
-!--       turbulent fluctuations have to be limited vertically because otherwise the turbulent
-!--       inflow layer will grow in time.
-          IF ( inflow_damping_height == 9999999.9_wp )  THEN
-!
-!--          Default: use the inversion height calculated by the prerun; if this is zero,
-!--          inflow_damping_height must be explicitly specified.
-             IF ( hom_sum(nzb+6,pr_palm,0) /= 0.0_wp )  THEN
-                inflow_damping_height = hom_sum(nzb+6,pr_palm,0)
+          ENDIF
+
+       ENDDO
+    ENDIF
+
+    IF ( bc_ns /= 'cyclic' )  THEN
+
+       DO  j = nys-1, nyn+1
+
+          IF ( outflow_n )  THEN
+
+             IF ( j >= ny - outflow_damping_width )  THEN
+                km_damp_y(j) = km_damp_max * MIN( 1.0,                    &
+                               ( j - ( ny - outflow_damping_width ) ) / &
+                               REAL( outflow_damping_width/2 )            &
+                                                )
              ELSE
-                WRITE( message_string, * ) 'inflow_damping_height must be ',                       &
-                                           'explicitly specified because&the inversion height ',   &
-                                           'calculated by the prerun is zero.'
-                CALL message( 'init_3d_model', 'PA0318', 1, 2, 0, 6, 0 )
+                km_damp_y(j) = 0.0
              ENDIF
 
-          ENDIF
-
-          IF ( inflow_damping_width == 9999999.9_wp )  THEN
-!
-!--          Default for the transition range: one tenth of the undamped layer
-             inflow_damping_width = 0.1_wp * inflow_damping_height
-
-          ENDIF
-
-          ALLOCATE( inflow_damping_factor(nzb:nzt+1) )
-
-          DO  k = nzb, nzt+1
-
-             IF ( zu(k) <= inflow_damping_height )  THEN
-                inflow_damping_factor(k) = 1.0_wp
-             ELSEIF ( zu(k) <= ( inflow_damping_height + inflow_damping_width ) )  THEN
-                inflow_damping_factor(k) = 1.0_wp -                                                &
-                                           ( zu(k) - inflow_damping_height ) / inflow_damping_width
+          ELSEIF ( outflow_s )  THEN
+
+             IF ( j <= outflow_damping_width )  THEN
+                km_damp_y(j) = km_damp_max * MIN( 1.0,                    &
+                               ( outflow_damping_width - j ) / &
+                               REAL( outflow_damping_width/2 )            &
+                                                )
              ELSE
-                inflow_damping_factor(k) = 0.0_wp
+                km_damp_y(j) = 0.0
              ENDIF
 
-          ENDDO
-
-       ENDIF
-
-!
-!--    Inside buildings set velocities back to zero
-       IF ( TRIM( initializing_actions ) == 'cyclic_fill'  .AND.  topography /= 'flat' )  THEN
-!
-!--       Inside buildings set velocities back to zero.
-!--       Other scalars (pt, q, s, p, sa, ...) are ignored at present,
-!--       maybe revise later.
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                DO  k = nzb, nzt
-                   u(k,j,i) = MERGE( u(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-                   v(k,j,i) = MERGE( v(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-                   w(k,j,i) = MERGE( w(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ENDIF
-
-!
-!--    Calculate initial temperature field and other constants used in case of a sloping surface
-       IF ( sloping_surface )  CALL init_slope
-
-!
-!--    Initialize new time levels (only done in order to set boundary values including ghost points)
-       pt_p = pt; u_p = u; v_p = v; w_p = w
-       IF ( humidity )  THEN
-          q_p = q
-       ENDIF
-       IF ( passive_scalar )  s_p  = s
-!
-!--    Allthough tendency arrays are set in prognostic_equations, they have have to be predefined
-!--    here because they are used (but multiplied with 0) there before they are set.
-       tpt_m = 0.0_wp; tu_m = 0.0_wp; tv_m = 0.0_wp; tw_m = 0.0_wp
-       IF ( humidity )  THEN
-          tq_m = 0.0_wp
-       ENDIF
-       IF ( passive_scalar )  ts_m  = 0.0_wp
-
-       IF ( debug_output )  THEN
-          CALL debug_message( 'initializing in case of restart / cyclic_fill', 'end' )
-       ENDIF
-
-    ELSE
-!
-!--    Actually this part of the programm should not be reached
-       message_string = 'unknown initializing problem'
-       CALL message( 'init_3d_model', 'PA0193', 1, 2, 0, 6, 0 )
+          ENDIF
+
+       ENDDO
     ENDIF
 
 !
-!-- Calculate the initial volume flow at the right and north boundary
-    IF ( conserve_volume_flow )  THEN
-
-       IF ( use_prescribed_profile_data )  THEN
-
-          volume_flow_initial_l = 0.0_wp
-          volume_flow_area_l    = 0.0_wp
-
-          IF ( nxr == nx )  THEN
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   volume_flow_initial_l(1) = volume_flow_initial_l(1) +                           &
-                                              u_init(k) * dzw(k)                                   &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,j,nxr), 1 )     &
-                                                     )
-
-                   volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)                       &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,j,nxr), 1 )     &
-                                                     )
-                ENDDO
-             ENDDO
-          ENDIF
-
-          IF ( nyn == ny )  THEN
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   volume_flow_initial_l(2) = volume_flow_initial_l(2) +                           &
-                                              v_init(k) * dzw(k)                                   &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,nyn,i), 2 )     &
-                                                     )
-                   volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)                       &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,nyn,i), 2 )     &
-                                                     )
-                ENDDO
-             ENDDO
-          ENDIF
-
-#if defined( __parallel )
-          CALL MPI_ALLREDUCE( volume_flow_initial_l(1), volume_flow_initial(1), 2, MPI_REAL,       &
-                              MPI_SUM, comm2d, ierr )
-          CALL MPI_ALLREDUCE( volume_flow_area_l(1), volume_flow_area(1), 2, MPI_REAL, MPI_SUM,    &
-                              comm2d, ierr )
-
-#else
-          volume_flow_initial = volume_flow_initial_l
-          volume_flow_area    = volume_flow_area_l
-#endif
-
-       ELSEIF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
-
-          volume_flow_initial_l = 0.0_wp
-          volume_flow_area_l    = 0.0_wp
-
-          IF ( nxr == nx )  THEN
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   volume_flow_initial_l(1) = volume_flow_initial_l(1) +                           &
-                                              hom_sum(k,1,0) * dzw(k)                              &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,j,nx), 1 )      &
-                                                     )
-                   volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)                       &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,j,nx), 1 )      &
-                                                     )
-                ENDDO
-             ENDDO
-          ENDIF
-
-          IF ( nyn == ny )  THEN
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   volume_flow_initial_l(2) = volume_flow_initial_l(2) +                           &
-                                              hom_sum(k,2,0) * dzw(k)                              &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,ny,i), 2 )      &
-                                                     )
-                   volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)                       &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,ny,i), 2 )      &
-                                                     )
-                ENDDO
-             ENDDO
-          ENDIF
-
-#if defined( __parallel )
-          CALL MPI_ALLREDUCE( volume_flow_initial_l(1), volume_flow_initial(1), 2, MPI_REAL,       &
-                              MPI_SUM, comm2d, ierr )
-          CALL MPI_ALLREDUCE( volume_flow_area_l(1), volume_flow_area(1), 2, MPI_REAL, MPI_SUM,    &
-                              comm2d, ierr )
-
-#else
-          volume_flow_initial = volume_flow_initial_l
-          volume_flow_area    = volume_flow_area_l
-#endif
-
-       ELSEIF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-
-          volume_flow_initial_l = 0.0_wp
-          volume_flow_area_l    = 0.0_wp
-
-          IF ( nxr == nx )  THEN
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   volume_flow_initial_l(1) = volume_flow_initial_l(1) +                           &
-                                              u(k,j,nx) * dzw(k)                                   &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,j,nx), 1 )      &
-                                                     )
-                   volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)                       &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                   BTEST( wall_flags_total_0(k,j,nx), 1 )          &
-                                                     )
-                ENDDO
-             ENDDO
-          ENDIF
-
-          IF ( nyn == ny )  THEN
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   volume_flow_initial_l(2) = volume_flow_initial_l(2) +                           &
-                                              v(k,ny,i) * dzw(k)                                   &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,ny,i), 2 )      &
-                                                     )
-                   volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)                       &
-                                              * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                       BTEST( wall_flags_total_0(k,ny,i), 2 )      &
-                                                     )
-                ENDDO
-             ENDDO
-          ENDIF
-
-#if defined( __parallel )
-          CALL MPI_ALLREDUCE( volume_flow_initial_l(1), volume_flow_initial(1), 2, MPI_REAL,       &
-                              MPI_SUM, comm2d, ierr )
-          CALL MPI_ALLREDUCE( volume_flow_area_l(1), volume_flow_area(1), 2, MPI_REAL, MPI_SUM,    &
-                              comm2d, ierr )
-
-#else
-          volume_flow_initial = volume_flow_initial_l
-          volume_flow_area    = volume_flow_area_l
-#endif
-
-       ENDIF
-
-!
-!--    In case of 'bulk_velocity' mode, volume_flow_initial is calculated from u|v_bulk instead
-       IF ( TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
-          volume_flow_initial(1) = u_bulk * volume_flow_area(1)
-          volume_flow_initial(2) = v_bulk * volume_flow_area(2)
-       ENDIF
-
-    ENDIF
-!
-!-- In the following, surface properties can be further initialized with input from static driver
-!-- file.
-!-- At the moment this affects only default surfaces. For example, roughness length or sensible /
-!-- latent heat fluxes can be initialized heterogeneously for default surfaces. Therefore, a generic
-!-- routine from netcdf_data_input_mod is called to read a 2D array.
-    IF ( input_pids_static )  THEN
-!
-!--    Allocate memory for possible static input
-       ALLOCATE( tmp_2d%var(nys:nyn,nxl:nxr) )
-       tmp_2d%var = 0.0_wp
-!
-!--    Open the static input file
-#if defined( __netcdf )
-       CALL open_read_file( TRIM( input_file_static ) //                                           &
-                            TRIM( coupling_char ), pids_id )
-
-       CALL inquire_num_variables( pids_id, num_var_pids )
-!
-!--    Allocate memory to store variable names and read them
-       ALLOCATE( vars_pids(1:num_var_pids) )
-       CALL inquire_variable_names( pids_id, vars_pids )
-!
-!--    Input roughness length.
-       IF ( check_existence( vars_pids, 'z0' ) )  THEN
-!
-!--       Read _FillValue attribute
-          CALL get_attribute( pids_id, char_fill, tmp_2d%fill, .FALSE., 'z0' )
-!
-!--       Read variable
-          CALL get_variable( pids_id, 'z0', tmp_2d%var, nxl, nxr, nys, nyn )
-          CALL add_ghost_layers( tmp_2d%var )
-          CALL exchange_horiz_2d( tmp_2d%var )
-!
-!--       Initialize roughness length. Note, z0 will be only initialized at default-type surfaces.
-!--       At natural or urban z0 is implicitly initialized by the respective parameter lists.
-!--       Initialize horizontal surface elements.
-          CALL init_single_surface_properties( surf_def_h(0)%z0, tmp_2d%var, surf_def_h(0)%ns,     &
-                                               tmp_2d%fill, surf_def_h(0)%i, surf_def_h(0)%j )
-!
-!--       Initialize roughness also at vertical surface elements.
-!--       Note, the actual 2D input arrays are only defined on the subdomain. Therefore, pass the
-!--       index arrays with their respective offset values.
-          DO  l = 0, 3
-             CALL init_single_surface_properties( surf_def_v(l)%z0, tmp_2d%var, surf_def_v(l)%ns,  &
-                                                  tmp_2d%fill, surf_def_v(l)%i+surf_def_v(l)%ioff, &
-                                                  surf_def_v(l)%j+surf_def_v(l)%joff )
-          ENDDO
-
-       ENDIF
-!
-!--    Input surface sensible heat flux.
-       IF ( check_existence( vars_pids, 'shf' ) )  THEN
-!
-!--       Read _FillValue attribute
-          CALL get_attribute( pids_id, char_fill, tmp_2d%fill, .FALSE., 'shf' )
-!
-!--       Read variable
-          CALL get_variable( pids_id, 'shf', tmp_2d%var, nxl, nxr, nys, nyn )
-          CALL add_ghost_layers( tmp_2d%var )
-          CALL exchange_horiz_2d( tmp_2d%var )
-!
-!--       Initialize heat flux. Note, shf will be only initialized at default-type surfaces. At
-!--       natural or urban shf is implicitly initialized by the respective parameter lists.
-!--       Initialize horizontal surface elements.
-          CALL init_single_surface_properties( surf_def_h(0)%shf, tmp_2d%var, surf_def_h(0)%ns,    &
-                                               tmp_2d%fill, surf_def_h(0)%i, surf_def_h(0)%j )
-!
-!--       Initialize heat flux also at vertical surface elements.
-!--       Note, the actual 2D input arrays are only defined on the subdomain. Therefore, pass the
-!--       index arrays with their respective offset values.
-          DO  l = 0, 3
-             CALL init_single_surface_properties( surf_def_v(l)%shf, tmp_2d%var, surf_def_v(l)%ns, &
-                                                  tmp_2d%fill, surf_def_v(l)%i+surf_def_v(l)%ioff, &
-                                                  surf_def_v(l)%j+surf_def_v(l)%joff )
-          ENDDO
-
-       ENDIF
-!
-!--    Input surface latent heat flux.
-       IF ( humidity )  THEN
-          IF ( check_existence( vars_pids, 'qsws' ) )  THEN
-!
-!--          Read _FillValue attribute
-             CALL get_attribute( pids_id, char_fill, tmp_2d%fill, .FALSE., 'qsws' )
-!
-!--          Read variable
-             CALL get_variable( pids_id, 'qsws', tmp_2d%var, nxl, nxr, nys, nyn )
-             CALL add_ghost_layers( tmp_2d%var )
-             CALL exchange_horiz_2d( tmp_2d%var )
-!
-!--          Initialize latent heat flux. Note, qsws will be only initialized at default-type surfaces.
-!--          At natural or urban qsws is implicitly initialized by the respective parameter lists.
-!--          Initialize horizontal surface elements.
-             CALL init_single_surface_properties( surf_def_h(0)%qsws, tmp_2d%var, surf_def_h(0)%ns,&
-                                                  tmp_2d%fill, surf_def_h(0)%i, surf_def_h(0)%j )
-!
-!--          Initialize latent heat flux also at vertical surface elements.
-!--          Note, the actual 2D input arrays are only defined on the subdomain. Therefore, pass the
-!--          index arrays with their respective offset values.
-             DO  l = 0, 3
-                CALL init_single_surface_properties( surf_def_v(l)%qsws, tmp_2d%var,               &
-                                                     surf_def_v(l)%ns, tmp_2d%fill,                &
-                                                     surf_def_v(l)%i+surf_def_v(l)%ioff,           &
-                                                     surf_def_v(l)%j+surf_def_v(l)%joff )
-             ENDDO
-
-          ENDIF
-       ENDIF
-!
-!--    Input passive scalar flux.
-       IF ( passive_scalar )  THEN
-          IF ( check_existence( vars_pids, 'ssws' ) )  THEN
-!
-!--          Read _FillValue attribute
-             CALL get_attribute( pids_id, char_fill, tmp_2d%fill, .FALSE., 'ssws' )
-!
-!--          Read variable
-             CALL get_variable( pids_id, 'ssws', tmp_2d%var, nxl, nxr, nys, nyn )
-             CALL add_ghost_layers( tmp_2d%var )
-             CALL exchange_horiz_2d( tmp_2d%var )
-!
-!--          Initialize passive scalar flux. Initialize horizontal surface elements.
-             CALL init_single_surface_properties( surf_def_h(0)%ssws, tmp_2d%var, surf_def_h(0)%ns,&
-                                                  tmp_2d%fill, surf_def_h(0)%i, surf_def_h(0)%j )
-
-             DO  l = 0, 3
-                CALL init_single_surface_properties( surf_def_v(l)%ssws, tmp_2d%var,               &
-                                                     surf_def_v(l)%ns, tmp_2d%fill,                &
-                                                     surf_def_v(l)%i+surf_def_v(l)%ioff,           &
-                                                     surf_def_v(l)%j+surf_def_v(l)%joff )
-             ENDDO
-
-          ENDIF
-       ENDIF
-!
-!--    Additional variables, can be initialized the
-!--    same way.
-
-!
-!--    Finally, close the input file and deallocate temporary arrays
-       DEALLOCATE( vars_pids )
-
-       CALL close_input_file( pids_id )
-#endif
-       DEALLOCATE( tmp_2d%var )
-    ENDIF
-!
-!-- Finally, if random_heatflux is set, disturb shf at horizontal surfaces. Actually, this should be
-!-- done in surface_mod, where all other initializations of surface quantities are done. However,
-!-- this would create a ring dependency, hence, it is done here. Maybe delete disturb_heatflux and
-!-- tranfer the respective code directly into the initialization in surface_mod.
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.                                &
-         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
-
-       IF ( use_surface_fluxes  .AND.  constant_heatflux  .AND.  random_heatflux )  THEN
-          IF ( surf_def_h(0)%ns >= 1 )  CALL disturb_heatflux( surf_def_h(0) )
-          IF ( surf_lsm_h(0)%ns >= 1 )  CALL disturb_heatflux( surf_lsm_h(0) )
-          IF ( surf_usm_h(0)%ns >= 1 )  CALL disturb_heatflux( surf_usm_h(0) )
-       ENDIF
-    ENDIF
-
-!
-!-- Compute total sum of grid points and the mean surface level height for each statistic region.
-!-- These are mainly used for horizontal averaging of turbulence statistics.
-!-- ngp_2dh: number of grid points of a horizontal cross section through the respective statistic
-!--          region
-!-- ngp_3d:  number of grid points of the respective statistic region
-    ngp_2dh_outer_l   = 0
-    ngp_2dh_outer     = 0
-    ngp_2dh_s_inner_l = 0
-    ngp_2dh_s_inner   = 0
-    ngp_2dh_l         = 0
-    ngp_2dh           = 0
-    ngp_3d_inner_l    = 0.0_wp
-    ngp_3d_inner      = 0
-    ngp_3d            = 0
-    ngp_sums          = ( nz + 2 ) * ( pr_palm + max_pr_user )
-
-    mean_surface_level_height   = 0.0_wp
-    mean_surface_level_height_l = 0.0_wp
-!
-!-- To do: New concept for these non-topography grid points!
+!-- Initialize local summation arrays for UP flow_statistics. This is necessary
+!-- because they may not yet have been initialized when they are called from 
+!-- flow_statistics (or - depending on the chosen model run - are never 
+!-- initialized)
+    sums_divnew_l      = 0.0
+    sums_divold_l      = 0.0
+    sums_l_l           = 0.0
+    sums_up_fraction_l = 0.0
+    sums_wsts_bc_l     = 0.0
+
+!
+!-- Pre-set masks for regional statistics. Default is the total model domain.
+    rmask = 1.0
+
+!
+!-- User-defined initializing actions
+    CALL user_init
+
+!
+!-- Input binary data file is not needed anymore. This line must be placed
+!-- after call of user_init!
+    CALL close_file( 13 )
+
+!
+!-- Compute total sum of active mask grid points
+!-- ngp_2dh: number of grid points of a horizontal cross section through the
+!--          total domain
+!-- ngp_3d:  number of grid points of the total domain
+!-- Note: The lower vertical index nzb_s_outer imposes a small error on the 2D 
+!-- ----  averages of staggered variables such as u and v due to the topography
+!--       arrangement on the staggered grid. Maybe revise later.
+    ngp_2dh_outer_l = 0
+    ngp_2dh_outer   = 0
+    ngp_2dh_l       = 0
+    ngp_2dh         = 0
+    ngp_3d_inner_l  = 0
+    ngp_3d_inner    = 0
+    ngp_3d          = 0
+    ngp_sums        = ( nz + 2 ) * var_sum
+
     DO  sr = 0, statistic_regions
        DO  i = nxl, nxr
           DO  j = nys, nyn
-             IF ( rmask(j,i,sr) == 1.0_wp )  THEN
+             IF ( rmask(j,i,sr) == 1.0 )  THEN
 !
 !--             All xy-grid points
                 ngp_2dh_l(sr) = ngp_2dh_l(sr) + 1
 !
-!--             Determine mean surface-level height. In case of downward-facing walls are present,
-!--             more than one surface level exist.
-!--             In this case, use the lowest surface-level height.
-                IF ( surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) )  THEN
-                   m = surf_def_h(0)%start_index(j,i)
-                   k = surf_def_h(0)%k(m)
-                   mean_surface_level_height_l(sr) = mean_surface_level_height_l(sr) + zw(k-1)
-                ENDIF
-                IF ( surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i) )  THEN
-                   m = surf_lsm_h(0)%start_index(j,i)
-                   k = surf_lsm_h(0)%k(m)
-                   mean_surface_level_height_l(sr) = mean_surface_level_height_l(sr) + zw(k-1)
-                ENDIF
-                IF ( surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i) )  THEN
-                   m = surf_usm_h(0)%start_index(j,i)
-                   k = surf_usm_h(0)%k(m)
-                   mean_surface_level_height_l(sr) = mean_surface_level_height_l(sr) + zw(k-1)
-                ENDIF
-
-                k_surf = k - 1
-
-                DO  k = nzb, nzt+1
-!
-!--                xy-grid points above topography
-                   ngp_2dh_outer_l(k,sr) = ngp_2dh_outer_l(k,sr)     +                             &
-                                           MERGE( 1, 0, BTEST( wall_flags_total_0(k,j,i), 24 ) )
-
-                   ngp_2dh_s_inner_l(k,sr) = ngp_2dh_s_inner_l(k,sr) +                             &
-                                             MERGE( 1, 0, BTEST( wall_flags_total_0(k,j,i), 22 ) )
-
+!--             xy-grid points above topography
+                DO  k = nzb_s_outer(j,i), nz + 1
+                   ngp_2dh_outer_l(k,sr) = ngp_2dh_outer_l(k,sr) + 1
                 ENDDO
 !
 !--             All grid points of the total domain above topography
-                ngp_3d_inner_l(sr) = ngp_3d_inner_l(sr) + ( nz - k_surf + 2 )
-
-
-
+                ngp_3d_inner_l(sr) = ngp_3d_inner_l(sr) + &
+                                     ( nz - nzb_s_inner(j,i) + 2 )
              ENDIF
           ENDDO
@@ -1722,291 +953,27 @@
     sr = statistic_regions + 1
 #if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( ngp_2dh_l(0), ngp_2dh(0), sr, MPI_INTEGER, MPI_SUM, comm2d, ierr )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( ngp_2dh_outer_l(0,0), ngp_2dh_outer(0,0), (nz+2)*sr, MPI_INTEGER, MPI_SUM, &
+    CALL MPI_ALLREDUCE( ngp_2dh_l(0), ngp_2dh(0), sr, MPI_INTEGER, MPI_SUM,  &
                         comm2d, ierr )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( ngp_2dh_s_inner_l(0,0), ngp_2dh_s_inner(0,0), (nz+2)*sr, MPI_INTEGER,      &
+    CALL MPI_ALLREDUCE( ngp_2dh_outer_l(0,0), ngp_2dh_outer(0,0), (nz+2)*sr, &
+                        MPI_INTEGER, MPI_SUM, comm2d, ierr )
+    CALL MPI_ALLREDUCE( ngp_3d_inner_l(0), ngp_3d_inner(0), sr, MPI_INTEGER, &
                         MPI_SUM, comm2d, ierr )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( ngp_3d_inner_l(0), ngp_3d_inner_tmp(0), sr, MPI_REAL, MPI_SUM, comm2d,     &
-                        ierr )
-    ngp_3d_inner = INT( ngp_3d_inner_tmp, KIND = SELECTED_INT_KIND( 18 ) )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( mean_surface_level_height_l(0), mean_surface_level_height(0), sr, MPI_REAL,&
-                        MPI_SUM, comm2d, ierr )
-    mean_surface_level_height = mean_surface_level_height / REAL( ngp_2dh )
 #else
-    ngp_2dh         = ngp_2dh_l
-    ngp_2dh_outer   = ngp_2dh_outer_l
-    ngp_2dh_s_inner = ngp_2dh_s_inner_l
-    ngp_3d_inner    = INT( ngp_3d_inner_l, KIND = SELECTED_INT_KIND( 18 ) )
-    mean_surface_level_height = mean_surface_level_height_l / REAL( ngp_2dh_l )
+    ngp_2dh       = ngp_2dh_l
+    ngp_2dh_outer = ngp_2dh_outer_l
+    ngp_3d_inner  = ngp_3d_inner_l
 #endif
 
-    ngp_3d = INT ( ngp_2dh, KIND = SELECTED_INT_KIND( 18 ) ) *                                     &
-             INT ( (nz + 2 ), KIND = SELECTED_INT_KIND( 18 ) )
-
-!
-!-- Set a lower limit of 1 in order to avoid zero divisions in flow_statistics, buoyancy, etc. A
-!-- zero value will occur for cases where all grid points of the respective subdomain lie below the
-!-- surface topography
-    ngp_2dh_outer   = MAX( 1, ngp_2dh_outer(:,:)   )
-    ngp_3d_inner    = MAX( INT(1, KIND = SELECTED_INT_KIND( 18 )), ngp_3d_inner(:) )
-    ngp_2dh_s_inner = MAX( 1, ngp_2dh_s_inner(:,:) )
-
-    DEALLOCATE( mean_surface_level_height_l, ngp_2dh_l, ngp_2dh_outer_l, ngp_3d_inner_l,           &
-                ngp_3d_inner_tmp )
-
-!
-!-- Initializae 3D offline nesting in COSMO model and read data from
-!-- external NetCDF file.
-    IF ( nesting_offline )  CALL nesting_offl_init
-!
-!-- Initialize quantities for special advections schemes
-    CALL init_advec
-
-!
-!-- Impose random perturbation on the horizontal velocity field and then
-!-- remove the divergences from the velocity field at the initial stage
-    IF ( create_disturbances  .AND.  disturbance_energy_limit /= 0.0_wp  .AND.                     &
-         TRIM( initializing_actions ) /= 'read_restart_data'  .AND.                                &
-         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
-
-       IF ( debug_output )  THEN
-          CALL debug_message( 'creating disturbances + applying pressure solver', 'start' )
-       ENDIF
-!
-!--    Needed for both disturb_field and pres
-!$ACC DATA &
-!$ACC CREATE(tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(u(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(v(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
-
-       CALL disturb_field( 'u', tend, u )
-       CALL disturb_field( 'v', tend, v )
-
-!$ACC DATA &
-!$ACC CREATE(d(nzb+1:nzt,nys:nyn,nxl:nxr)) &
-!$ACC COPY(w(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPYIN(rho_air(nzb:nzt+1), rho_air_zw(nzb:nzt+1)) &
-!$ACC COPYIN(ddzu(1:nzt+1), ddzw(1:nzt+1)) &
-!$ACC COPYIN(wall_flags_total_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPYIN(bc_h(0:1)) &
-!$ACC COPYIN(bc_h(0)%i(1:bc_h(0)%ns)) &
-!$ACC COPYIN(bc_h(0)%j(1:bc_h(0)%ns)) &
-!$ACC COPYIN(bc_h(0)%k(1:bc_h(0)%ns)) &
-!$ACC COPYIN(bc_h(1)%i(1:bc_h(1)%ns)) &
-!$ACC COPYIN(bc_h(1)%j(1:bc_h(1)%ns)) &
-!$ACC COPYIN(bc_h(1)%k(1:bc_h(1)%ns))
-
-       n_sor = nsor_ini
-       CALL pres
-       n_sor = nsor
-
-!$ACC END DATA
-!$ACC END DATA
-
-       IF ( debug_output )  THEN
-          CALL debug_message( 'creating disturbances + applying pressure solver', 'end' )
-       ENDIF
-
-    ENDIF
-
-    IF ( .NOT. ocean_mode )  THEN
-
-       ALLOCATE( hyp(nzb:nzt+1) )
-       ALLOCATE( d_exner(nzb:nzt+1) )
-       ALLOCATE( exner(nzb:nzt+1) )
-       ALLOCATE( hyrho(nzb:nzt+1) )
-!
-!--    Check temperature in case of too large domain height
-       DO  k = nzb, nzt+1
-          IF ( ( pt_surface * exner_function( surface_pressure * 100.0_wp ) - g/c_p * zu(k) )      &
-                 < 0.0_wp )  THEN
-             WRITE( message_string, * )  'absolute temperature < 0.0 at zu(', k, ') = ', zu(k)
-             CALL message( 'init_3d_model', 'PA0142', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDDO
-
-!
-!--    Calculate vertical profile of the hydrostatic pressure (hyp)
-       hyp    = barometric_formula( zu, pt_surface * exner_function( surface_pressure * 100.0_wp ),&
-                                    surface_pressure * 100.0_wp )
-       d_exner = exner_function_invers( hyp )
-       exner = 1.0_wp / exner_function_invers( hyp )
-       hyrho  = ideal_gas_law_rho_pt( hyp, pt_init )
-!
-!--    Compute reference density
-       rho_surface = ideal_gas_law_rho( surface_pressure * 100.0_wp,                               &
-                                        pt_surface * exner_function( surface_pressure * 100.0_wp ) )
-
-    ENDIF
-
-!
-!-- If required, initialize particles
-    IF ( agents_active )  CALL mas_init
-!
-!-- Initialization of synthetic turbulence generator
-    IF ( syn_turb_gen )  CALL stg_init
-!
-!-- Initializing actions for all other modules
-    CALL module_interface_init
-!
-!-- Initialize surface layer (done after LSM as roughness length are required for initialization
-    IF ( constant_flux_layer )  CALL init_surface_layer_fluxes
-!
-!-- Initialize surface data output
-    IF ( surface_output )  CALL surface_data_output_init
-!
-!-- Initialize the ws-scheme.
-    IF ( ws_scheme_sca  .OR.  ws_scheme_mom )  CALL ws_init
-!
-!-- Perform post-initializing checks for all other modules
-    CALL module_interface_init_checks
-
-!
-!-- Initialize surface forcing corresponding to large-scale forcing. Therein,
-!-- initialize heat-fluxes, etc. via datatype. Revise it later!
-    IF ( large_scale_forcing  .AND.  lsf_surf )  THEN
-       IF ( use_surface_fluxes  .AND.  constant_heatflux )  THEN
-          CALL ls_forcing_surf( simulated_time )
-       ENDIF
-    ENDIF
-!
-!-- Setting weighting factors for calculation of perturbation pressure and turbulent quantities from
-!-- the RK substeps.
-    IF ( TRIM( timestep_scheme ) == 'runge-kutta-3' )  THEN      ! for RK3-method
-
-       weight_substep(1) = 1._wp/6._wp
-       weight_substep(2) = 3._wp/10._wp
-       weight_substep(3) = 8._wp/15._wp
-
-       weight_pres(1)    = 1._wp/3._wp
-       weight_pres(2)    = 5._wp/12._wp
-       weight_pres(3)    = 1._wp/4._wp
-
-    ELSEIF ( TRIM( timestep_scheme ) == 'runge-kutta-2' )  THEN  ! for RK2-method
-
-       weight_substep(1) = 1._wp/2._wp
-       weight_substep(2) = 1._wp/2._wp
-
-       weight_pres(1)    = 1._wp/2._wp
-       weight_pres(2)    = 1._wp/2._wp
-
-    ELSE                                     ! for Euler-method
-
-       weight_substep(1) = 1.0_wp
-       weight_pres(1)    = 1.0_wp
-
-    ENDIF
-
-!
-!-- Initialize Rayleigh damping factors
-    rdf    = 0.0_wp
-    rdf_sc = 0.0_wp
-    IF ( rayleigh_damping_factor /= 0.0_wp )  THEN
-
-       IF (  .NOT.  ocean_mode )  THEN
-          DO  k = nzb+1, nzt
-             IF ( zu(k) >= rayleigh_damping_height )  THEN
-                rdf(k) = rayleigh_damping_factor *                                                 &
-                         ( SIN( pi * 0.5_wp * ( zu(k) - rayleigh_damping_height )                  &
-                                / ( zu(nzt) - rayleigh_damping_height ) )                          &
-                         )**2
-             ENDIF
-          ENDDO
-       ELSE
-!
-!--       In ocean mode, rayleigh damping is applied in the lower part of the model domain
-          DO  k = nzt, nzb+1, -1
-             IF ( zu(k) <= rayleigh_damping_height )  THEN
-                rdf(k) = rayleigh_damping_factor *                                                 &
-                         ( SIN( pi * 0.5_wp * ( rayleigh_damping_height - zu(k) )                  &
-                                / ( rayleigh_damping_height - zu(nzb+1) ) )                        &
-                         )**2
-             ENDIF
-          ENDDO
-       ENDIF
-
-    ENDIF
-    IF ( scalar_rayleigh_damping )  rdf_sc = rdf
-
-!
-!-- Initialize the starting level and the vertical smoothing factor used for the external pressure
-!-- gradient
-    dp_smooth_factor = 1.0_wp
-    IF ( dp_external )  THEN
-!
-!--    Set the starting level dp_level_ind_b only if it has not been set before (e.g. in init_grid).
-       IF ( dp_level_ind_b == 0 )  THEN
-          ind_array = MINLOC( ABS( dp_level_b - zu ) )
-          dp_level_ind_b = ind_array(1) - 1 + nzb
-                                        ! MINLOC uses lower array bound 1
-       ENDIF
-       IF ( dp_smooth )  THEN
-          dp_smooth_factor(:dp_level_ind_b) = 0.0_wp
-          DO  k = dp_level_ind_b+1, nzt
-             dp_smooth_factor(k) = 0.5_wp * ( 1.0_wp + SIN( pi *                                   &
-                                             ( REAL( k - dp_level_ind_b, KIND=wp ) /               &
-                                               REAL( nzt - dp_level_ind_b, KIND=wp ) - 0.5_wp ) ) )
-          ENDDO
-       ENDIF
-    ENDIF
-
-!
-!-- Initialize damping zone for the potential temperature in case of non-cyclic lateral boundaries.
-!-- The damping zone has the maximum value at the inflow boundary and decreases to zero at
-!-- pt_damping_width.
-    ptdf_x = 0.0_wp
-    ptdf_y = 0.0_wp
-    IF ( bc_lr_dirrad )  THEN
-       DO  i = nxl, nxr
-          IF ( ( i * dx ) < pt_damping_width )  THEN
-             ptdf_x(i) = pt_damping_factor * ( SIN( pi * 0.5_wp *                                  &
-                                                    REAL( pt_damping_width - i * dx, KIND=wp ) /   &
-                                                    REAL( pt_damping_width, KIND=wp ) ) )**2
-                                  ENDIF
-       ENDDO
-    ELSEIF ( bc_lr_raddir )  THEN
-       DO  i = nxl, nxr
-          IF ( ( i * dx ) > ( nx * dx - pt_damping_width ) )  THEN
-             ptdf_x(i) = pt_damping_factor * SIN( pi * 0.5_wp *                                    &
-                                                  ( ( i - nx ) * dx + pt_damping_width ) /         &
-                                                  REAL( pt_damping_width, KIND=wp ) )**2
-          ENDIF
-       ENDDO
-    ELSEIF ( bc_ns_dirrad )  THEN
-       DO  j = nys, nyn
-          IF ( ( j * dy ) > ( ny * dy - pt_damping_width ) )  THEN
-             ptdf_y(j) = pt_damping_factor * SIN( pi * 0.5_wp *                                    &
-                                                  ( ( j - ny ) * dy + pt_damping_width ) /         &
-                                                  REAL( pt_damping_width, KIND=wp ) )**2
-          ENDIF
-       ENDDO
-    ELSEIF ( bc_ns_raddir )  THEN
-       DO  j = nys, nyn
-          IF ( ( j * dy ) < pt_damping_width )  THEN
-             ptdf_y(j) = pt_damping_factor * SIN( pi * 0.5_wp *                                    &
-                                                  ( pt_damping_width - j * dy ) /                  &
-                                                  REAL( pt_damping_width, KIND=wp ) )**2
-          ENDIF
-       ENDDO
-    ENDIF
-
-!
-!-- Input binary data file is not needed anymore. This line must be placed after call of user_init!
-    CALL close_file( 13 )
-!
-!-- In case of nesting, put an barrier to assure that all parent and child domains finished
-!-- initialization.
-#if defined( __parallel )
-    IF ( nested_run )  CALL MPI_BARRIER( MPI_COMM_WORLD, ierr )
-#endif
-
-
-    CALL location_message( 'model initialization', 'finished' )
+    ngp_3d = ngp_2dh * ( nz + 2 )
+
+!
+!-- Set a lower limit of 1 in order to avoid zero divisions in flow_statistics,
+!-- buoyancy, etc. A zero value will occur for cases where all grid points of
+!-- the respective subdomain lie below the surface topography
+    ngp_2dh_outer = MAX( 1, ngp_2dh_outer(:,:) ) 
+    ngp_3d_inner  = MAX( 1, ngp_3d_inner(:)    )
+
+    DEALLOCATE( ngp_2dh_l, ngp_2dh_outer_l, ngp_3d_inner_l )
+
 
  END SUBROUTINE init_3d_model
Index: palm/trunk/SOURCE/init_advec.f90
===================================================================
--- palm/trunk/SOURCE/init_advec.f90	(revision 4901)
+++ palm/trunk/SOURCE/init_advec.f90	(revision 1)
@@ -1,34 +1,27 @@
-!> @file init_advec.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE init_advec
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
+! $Log: init_advec.f90,v $
+! Revision 1.6  2004/04/30 11:59:31  raasch
+! impulse_advec renamed momentum_advec
+!
+! Revision 1.5  2001/03/30 07:25:53  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.4  2001/01/22 06:57:43  raasch
+! Module test_variables removed
+!
+! Revision 1.3  2000/12/21 16:12:52  letzel
+! All comments translated into English.
+!
+! Revision 1.2  1999/02/17 09:18:45  raasch
+! Fehlerkorrektur, Verfahren muessen unabhaengig voneinander initialisierbar
+! sein
 !
 ! Revision 1.1  1999/02/05 09:07:38  raasch
@@ -38,33 +31,18 @@
 ! Description:
 ! ------------
-!> Initialize constant coefficients and parameters for certain advection schemes.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_advec
-
-
-    USE advection,                                                                                 &
-        ONLY:  aex, bex, dex, eex
-
-    USE kinds
-
-    USE control_parameters,                                                                        &
-        ONLY:  scalar_advec
+! Initialize constant coefficients and parameters for certain advection schemes.
+!------------------------------------------------------------------------------!
+
+    USE advection
+    USE arrays_3d
+    USE indices
+    USE control_parameters
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i          !<
-    INTEGER(iwp) ::  intervals  !<
-    INTEGER(iwp) ::  j          !<
-
-    REAL(wp) :: delt   !<
-    REAL(wp) :: dn     !<
-    REAL(wp) :: dnneu  !<
-    REAL(wp) :: ex1    !<
-    REAL(wp) :: ex2    !<
-    REAL(wp) :: ex3    !<
-    REAL(wp) :: ex4    !<
-    REAL(wp) :: ex5    !<
-    REAL(wp) :: ex6    !<
-    REAL(wp) :: sterm  !<
+    INTEGER :: i, intervals, j, k
+    REAL    :: delt, dn, dnneu, ex1, ex2, ex3, ex4, ex5, ex6, spl_alpha, &
+               spl_beta, sterm
+    REAL, DIMENSION(:), ALLOCATABLE ::  spl_u, temp
 
 
@@ -76,20 +54,20 @@
        ALLOCATE( aex(intervals), bex(intervals), dex(intervals), eex(intervals) )
 
-       delt  = 1.0_wp / REAL( intervals, KIND=wp )
-       sterm = delt * 0.5_wp
+       delt  = 1.0 / REAL( intervals )
+       sterm = delt * 0.5
 
        DO  i = 1, intervals
 
-          IF ( sterm > 0.5_wp )  THEN
-             dn = -5.0_wp
+          IF ( sterm > 0.5 )  THEN
+             dn = -5.0
           ELSE
-             dn = 5.0_wp
+             dn = 5.0
           ENDIF
 
           DO  j = 1, 15
-             ex1 = dn * EXP( -dn ) - EXP( 0.5_wp * dn ) + EXP( -0.5_wp * dn )
+             ex1 = dn * EXP( -dn ) - EXP( 0.5 * dn ) + EXP( -0.5 * dn )
              ex2 = EXP( dn ) - EXP( -dn )
-             ex3 = EXP( -dn ) * ( 1.0_wp - dn ) - 0.5_wp * EXP(  0.5_wp * dn )                     &
-                                                - 0.5_wp * EXP( -0.5_wp * dn )
+             ex3 = EXP( -dn ) * ( 1.0 - dn ) - 0.5 * EXP(  0.5 * dn ) &
+                                             - 0.5 * EXP( -0.5 * dn )
              ex4 = EXP( dn ) + EXP( -dn )
              ex5 = dn * sterm + ex1 / ex2
@@ -99,12 +77,12 @@
           ENDDO
 
-          IF ( sterm < 0.5_wp )  dn = MAX(  2.95E-2_wp, dn )
-          IF ( sterm > 0.5_wp )  dn = MIN( -2.95E-2_wp, dn )
+          IF ( sterm < 0.5 )  dn = MAX(  2.95E-2, dn )
+          IF ( sterm > 0.5 )  dn = MIN( -2.95E-2, dn )
           ex1 = EXP( -dn )
           ex2 = EXP( dn ) - ex1
           aex(i) = -ex1 / ex2
-          bex(i) = 1.0_wp / ex2
+          bex(i) = 1.0 / ex2
           dex(i) = dn
-          eex(i) = EXP( dex(i) * 0.5_wp )
+          eex(i) = EXP( dex(i) * 0.5 )
           sterm = sterm + delt
 
@@ -113,3 +91,157 @@
     ENDIF
 
+    IF ( momentum_advec == 'ups-scheme' .OR. scalar_advec  == 'ups-scheme' )  &
+    THEN
+
+!
+!--    Provide the constant parameters for the Upstream-Spline advection scheme.
+!--    In x- und y-direction the Sherman-Morrison formula is applied
+!--    (cf. Press et al, 1986 (Numerical Recipes)).
+!
+!--    Allocate nonlocal arrays
+       ALLOCATE( spl_z_x(0:nx), spl_z_y(0:ny), spl_tri_x(5,0:nx), &
+                 spl_tri_y(5,0:ny), spl_tri_zu(5,nzb:nzt+1),      &
+                 spl_tri_zw(5,nzb:nzt+1) )
+
+!
+!--    Provide diagonal elements of the tridiagonal matrices for all 
+!--    directions
+       spl_tri_x(1,:)  = 2.0
+       spl_tri_y(1,:)  = 2.0
+       spl_tri_zu(1,:) = 2.0
+       spl_tri_zw(1,:) = 2.0
+
+!
+!--    Elements of the cyclic tridiagonal matrix
+!--    (same for all horizontal directions)
+       spl_alpha = 0.5
+       spl_beta  = 0.5
+
+!
+!--    Sub- and superdiagonal elements, x-direction
+       spl_tri_x(2,0:nx) = 0.5
+       spl_tri_x(3,0:nx) = 0.5
+
+!
+!--    mMdify the diagonal elements (Sherman-Morrison)
+       spl_gamma_x    = -spl_tri_x(1,0)
+       spl_tri_x(1,0)  = spl_tri_x(1,0) - spl_gamma_x
+       spl_tri_x(1,nx) = spl_tri_x(1,nx) - spl_alpha * spl_beta / spl_gamma_x
+
+!
+!--    Split the tridiagonal matrix for Thomas algorithm
+       spl_tri_x(4,0) = spl_tri_x(1,0)
+       DO  i = 1, nx
+          spl_tri_x(5,i) = spl_tri_x(2,i) / spl_tri_x(4,i-1)
+          spl_tri_x(4,i) = spl_tri_x(1,i) - spl_tri_x(5,i) * spl_tri_x(3,i-1)
+       ENDDO
+
+!
+!--    Allocate arrays required locally
+       ALLOCATE( temp(0:nx), spl_u(0:nx) )
+
+!
+!--    Provide "corrective vector", x-direction
+       spl_u(0)      = spl_gamma_x
+       spl_u(1:nx-1) = 0.0
+       spl_u(nx)     = spl_alpha
+
+!
+!--    Solve the system of equations for the corrective vector
+!--    (Sherman-Morrison)
+       temp(0) = spl_u(0)
+       DO  i = 1, nx
+          temp(i) = spl_u(i) - spl_tri_x(5,i) * temp(i-1)
+       ENDDO
+       spl_z_x(nx) = temp(nx) / spl_tri_x(4,nx)
+       DO  i = nx-1, 0, -1
+          spl_z_x(i) = ( temp(i) - spl_tri_x(3,i) * spl_z_x(i+1) ) / &
+                       spl_tri_x(4,i)
+       ENDDO
+
+!
+!--    Deallocate local arrays, for they are allocated in a different way for
+!--    operations in y-direction
+       DEALLOCATE( temp, spl_u )    
+    
+!
+!--    Provide sub- and superdiagonal elements, y-direction
+       spl_tri_y(2,0:ny) = 0.5
+       spl_tri_y(3,0:ny) = 0.5
+
+!
+!--    Modify the diagonal elements (Sherman-Morrison)
+       spl_gamma_y    = -spl_tri_y(1,0) 
+       spl_tri_y(1,0)  = spl_tri_y(1,0) - spl_gamma_y
+       spl_tri_y(1,ny) = spl_tri_y(1,ny) - spl_alpha * spl_beta / spl_gamma_y
+
+!
+!--    Split the tridiagonal matrix for Thomas algorithm
+       spl_tri_y(4,0) = spl_tri_y(1,0)
+       DO  j = 1, ny
+          spl_tri_y(5,j) = spl_tri_y(2,j) / spl_tri_y(4,j-1)
+          spl_tri_y(4,j) = spl_tri_y(1,j) - spl_tri_y(5,j) * spl_tri_y(3,j-1)
+       ENDDO
+
+!
+!--    Allocate arrays required locally
+       ALLOCATE( temp(0:ny), spl_u(0:ny) )
+
+!
+!--    Provide "corrective vector", y-direction
+       spl_u(0)      = spl_gamma_y
+       spl_u(1:ny-1) = 0.0
+       spl_u(ny)     = spl_alpha
+    
+!
+!--    Solve the system of equations for the corrective vector
+!--    (Sherman-Morrison)
+       temp = 0.0
+       spl_z_y = 0.0
+       temp(0) = spl_u(0)
+       DO  j = 1, ny
+          temp(j) = spl_u(j) - spl_tri_y(5,j) * temp(j-1)
+       ENDDO
+       spl_z_y(ny) = temp(ny) / spl_tri_y(4,ny)
+       DO  j = ny-1, 0, -1
+          spl_z_y(j) = ( temp(j) - spl_tri_y(3,j) * spl_z_y(j+1) ) / &
+                       spl_tri_y(4,j)
+       ENDDO
+
+!
+!--    deallocate local arrays, for they are no longer required
+       DEALLOCATE( temp, spl_u )
+
+!
+!--    provide sub- and superdiagonal elements, z-direction
+       spl_tri_zu(2,nzb)   = 0.0
+       spl_tri_zu(2,nzt+1) = 1.0
+       spl_tri_zw(2,nzb)   = 0.0
+       spl_tri_zw(2,nzt+1) = 1.0
+
+       spl_tri_zu(3,nzb)   = 1.0
+       spl_tri_zu(3,nzt+1) = 0.0
+       spl_tri_zw(3,nzb)   = 1.0
+       spl_tri_zw(3,nzt+1) = 0.0
+
+       DO  k = nzb+1, nzt
+          spl_tri_zu(2,k) = dzu(k) / ( dzu(k) + dzu(k+1) )
+          spl_tri_zw(2,k) = dzw(k) / ( dzw(k) + dzw(k+1) )
+          spl_tri_zu(3,k) = 1.0 - spl_tri_zu(2,k)
+          spl_tri_zw(3,k) = 1.0 - spl_tri_zw(2,k)
+       ENDDO
+    
+       spl_tri_zu(4,nzb) = spl_tri_zu(1,nzb)
+       spl_tri_zw(4,nzb) = spl_tri_zw(1,nzb)
+       DO  k = nzb+1, nzt+1
+          spl_tri_zu(5,k) = spl_tri_zu(2,k) / spl_tri_zu(4,k-1)
+          spl_tri_zw(5,k) = spl_tri_zw(2,k) / spl_tri_zw(4,k-1)
+          spl_tri_zu(4,k) = spl_tri_zu(1,k) - spl_tri_zu(5,k) * &
+                            spl_tri_zu(3,k-1)
+          spl_tri_zw(4,k) = spl_tri_zw(1,k) - spl_tri_zw(5,k) * &
+                            spl_tri_zw(3,k-1)
+       ENDDO
+
+    ENDIF
+
  END SUBROUTINE init_advec
Index: palm/trunk/SOURCE/init_cloud_physics.f90
===================================================================
--- palm/trunk/SOURCE/init_cloud_physics.f90	(revision 1)
+++ palm/trunk/SOURCE/init_cloud_physics.f90	(revision 1)
@@ -0,0 +1,79 @@
+ SUBROUTINE init_cloud_physics
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! ------------------
+! $Log: init_cloud_physics.f90,v $
+! Revision 1.5  2005/06/26 19:55:58  raasch
+! Initialization of cloud droplet constants, gas_constant renamed r_d,
+! latent_heat renamed l_v
+!
+! Revision 1.4  2001/03/30 07:26:30  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.),
+! surface_pressure keeps unit hPa and is not converted to Pa
+!
+! Revision 1.3  2001/01/25 07:03:10  raasch
+! Module test_variables removed
+!
+! Revision 1.2  2001/01/22 09:16:57  schroeter
+! To calculate verticle pressure profile use actual surface-temperature in
+! place of potential temperature as reference value.
+!
+! Revision 1.1  2000/04/13 14:37:22  schroeter
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Initialization of parameters for handling cloud-physics
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE cloud_parameters
+    USE control_parameters
+    USE grid_variables
+    USE indices
+
+    IMPLICIT NONE
+
+    INTEGER ::  k
+    REAL    ::  t_surface
+
+    ALLOCATE( hydro_press(nzb:nzt+1), pt_d_t(nzb:nzt+1), t_d_pt(nzb:nzt+1) )
+
+!
+!-- Compute frequently used parameters
+    l_d_cp = l_v / cp
+    l_d_r  = l_v / r_d
+    l_d_rv = l_v / r_v
+
+!
+!-- Constant b in equation for droplet growth by condensation / evaporation.
+!-- Factor 1E-3 is needed because formula is in cgs units
+    mass_of_solute = 1.0E-17            ! in kg
+    molecular_weight_of_solute = 58.5   ! NaCl
+    b_cond = 4.3 * 2.0 * mass_of_solute / molecular_weight_of_solute * 1.0E-6
+
+!
+!-- Calculate:
+!-- pt / t : ratio of potential and actual temperature (pt_d_t)
+!-- t / pt : ratio of actual and potential temperature (t_d_pt)
+!-- p_0(z) : vertical profile of the hydrostatic pressure (hydro_press)
+    t_surface = pt_surface * ( surface_pressure / 1000.0 )**0.286
+    DO  k = nzb, nzt+1
+       hydro_press(k) = surface_pressure * 100.0 * &
+                        ( (t_surface - g/cp * zu(k)) / t_surface )**(1.0/0.286)
+       pt_d_t(k)      = ( 100000.0 / hydro_press(k) )**0.286
+       t_d_pt(k)      = 1.0 / pt_d_t(k)       
+    ENDDO
+
+!
+!-- Compute reference density
+    rho_surface = surface_pressure * 100.0 / ( r_d * t_surface )
+
+
+ END SUBROUTINE init_cloud_physics
Index: palm/trunk/SOURCE/init_coupling.f90
===================================================================
--- palm/trunk/SOURCE/init_coupling.f90	(revision 4901)
+++ 	(revision )
@@ -1,143 +1,0 @@
-!> @file init_coupling.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! ------------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4564 2020-06-12 14:03:36Z raasch
-! Vertical nesting method of Huq et al. (2019) removed
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! references to mrun replaced by palmrun, and updated
-!
-! 222 2009-01-12 16:04:16Z letzel
-! Initial revision
-!
-! Description:
-! ------------
-!> Initializing coupling via MPI-1 or MPI-2 if the coupled version of PALM is called.
-!--------------------------------------------------------------------------------------------------!
-  SUBROUTINE init_coupling
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  coupling_char, coupling_mode
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-!
-!-- Local variables
-#if defined( __parallel )
-    INTEGER(iwp) ::  i            !<
-    INTEGER(iwp) ::  inter_color  !<
-#endif
-
-    INTEGER(iwp), DIMENSION(:) ::  bc_data(0:3) = 0  !<
-
-!
-!-- Get information about the coupling mode from the environment variable which has been set by the
-!-- mpiexec command.
-!-- This method is currently not used because the mpiexec command is not available on some machines.
-!    CALL GET_ENVIRONMENT_VARIABLE( 'coupling_mode', coupling_mode, i )
-!    IF ( i == 0 )  coupling_mode = 'uncoupled'
-!    IF ( coupling_mode == 'ocean_to_atmosphere' )  coupling_char = '_O'
-
-!
-!-- Get information about the coupling mode from standard input (PE0 only) and distribute it to the
-!-- other PEs. Distribute PEs to 2 new communicators.
-!-- ATTENTION: numprocs will be reset according to the new communicators
-#if defined ( __parallel )
-
-    IF ( myid == 0 )  THEN
-       READ (*,*,ERR=10,END=10)  coupling_mode, bc_data(1), bc_data(2)
-10     CONTINUE
-       IF ( TRIM( coupling_mode ) == 'coupled_run' )  THEN
-          i = 1
-       ELSE
-          i = 0
-       ENDIF
-       bc_data(0) = i
-
-!
-!--    Check if '_O' has to be used as file extension in an uncoupled ocean run. This is required,
-!--    if this run shall be continued as a coupled run.
-       IF ( TRIM( coupling_mode ) == 'precursor_ocean' )  bc_data(3) = 1
-
-    ENDIF
-
-    CALL MPI_BCAST( bc_data(0), 4, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr )
-    i = bc_data(0)
-
-    IF ( i == 0 )  THEN
-       coupling_mode = 'uncoupled'
-!
-!--    In case of a precursor ocean run, an additional flag file is created.
-!--    This is necessary for data_output_2d_on_each_pe = .T.
-       IF ( bc_data(3) == 1 )  THEN
-          OPEN( 90, FILE='PRECURSOR_OCEAN', FORM='FORMATTED' )
-          WRITE ( 90, '(''TRUE'')' )
-          CLOSE ( 90 )
-       ENDIF
-    ELSE
-       comm_inter = MPI_COMM_WORLD
-
-       IF ( myid < bc_data(1) ) THEN
-          inter_color     = 0
-          numprocs        = bc_data(1)
-          coupling_mode   = 'atmosphere_to_ocean'
-       ELSE
-          inter_color     = 1
-          numprocs        = bc_data(2)
-          coupling_mode   = 'ocean_to_atmosphere'
-       ENDIF
-
-       CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, inter_color, 0, comm_palm, ierr )
-       comm2d = comm_palm
-
-!
-!--    Write a flag file for the ocean model and the other atmosphere processes.
-       OPEN( 90, FILE='COUPLING_PORT_OPENED', FORM='FORMATTED' )
-       WRITE ( 90, '(''TRUE'')' )
-       CLOSE ( 90 )
-    ENDIF
-#endif
-
-!
-!-- In case of a precursor ocean run (followed by a coupled run), or a coupled atmosphere-ocean run,
-!-- set the file extension for the ocean files.
-    IF ( TRIM( coupling_mode ) == 'ocean_to_atmosphere' .OR. bc_data(3) == 1 )  THEN
-       coupling_char = '_O'
-    ENDIF
-
- END SUBROUTINE init_coupling
Index: palm/trunk/SOURCE/init_dvrp.f90
===================================================================
--- palm/trunk/SOURCE/init_dvrp.f90	(revision 1)
+++ palm/trunk/SOURCE/init_dvrp.f90	(revision 1)
@@ -0,0 +1,614 @@
+  SUBROUTINE init_dvrp
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! ----------------- 
+! 
+! Test output of isosurface on camera file
+! TEST: print* statements
+! ToDo: checking of mode_dvrp for legal values is not correct
+!
+! Former revisions:
+! -----------------
+! $Log: init_dvrp.f90,v $
+! Revision 1.12  2006/02/23 12:30:22  raasch
+! ebene renamed section, pl.. replaced by do..,
+!
+! Revision 1.11  2005/03/31 07:01:20  raasch
+! Test version with print statements checked in
+!
+! Revision 1.10  2003/08/01 08:36:28  raasch
+! Module dvrp added to routine close_dvrp, set the maximum time the program
+! can be suspended on user request, every steering variable is defined for
+! every stream
+!
+! Revision 1.9  2003/03/16 09:39:44  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.8  2003/03/04 11:28:53  raasch
+! Update for new version of dvrp software (e.g. using module dvrp is now
+! mandatory). Initialization of dvrp steering variables included.
+!
+! Revision 1.7  2002/12/19 15:37:57  raasch
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.6  2001/08/21 09:45:54  raasch
+! Superelevation implemented, additional PE can be used for handling the
+! dvrp output (see init_dvrp_logging and close_dvrp)
+!
+! Revision 1.5  2001/07/12 12:10:16  raasch
+! Adjustment of camera position, output of boundingbox moved from the scene
+! files to camera.dvr, destination for dvrp_output is now controlled via
+! parameters given in the parameter file.
+!
+! Revision 1.4  2001/03/30 07:31:03  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.3  2001/01/25 07:04:23  raasch
+! Subroutines init_dvrp_logging and close_dvrp attached.
+!
+! Revision 1.2  2000/12/28 13:11:43  raasch
+! Complete revision due to new features of dvrp-software
+!
+! Revision 1.1  2000/04/27 06:24:39  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Initializing actions needed when using dvrp-software
+!------------------------------------------------------------------------------!
+#if defined( __dvrp_graphics )
+
+    USE arrays_3d
+    USE DVRP
+    USE dvrp_variables
+    USE grid_variables
+    USE indices
+    USE pegrid
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=2)  ::  section_chr
+    CHARACTER (LEN=80) ::  dvrp_file_local
+    INTEGER ::  i, j, k, l, m, pn, tv, vn
+    LOGICAL ::  allocated
+    REAL    ::  center(3), distance
+
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
+
+    TYPE(CSTRING), SAVE ::  dvrp_directory_c, dvrp_file_c, &
+                            dvrp_file_local_c,dvrp_host_c, &
+                            dvrp_password_c, dvrp_username_c, name_c
+
+!
+!-- Set the maximum time the program can be suspended on user request (by
+!-- dvrp steering). This variable is defined in module DVRP.
+    DVRP_MAX_SUSPEND_TIME = 7200
+
+!
+!-- Allocate array holding the names and limits of the steering variables
+!-- (must have the same number of elements as array mode_dvrp!)
+    ALLOCATE( steering_dvrp(10) )
+
+!
+!-- Check, if output parameters are given and/or allowed
+!-- and set default-values, where necessary
+    IF ( dvrp_username == ' ' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ init_dvrp: dvrp_username is undefined'
+          CALL local_stop
+       ENDIF
+    ENDIF
+
+    IF ( dvrp_output /= 'ftp'  .AND.  dvrp_output /= 'rtsp'  .AND. &
+         dvrp_output /= 'local' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ init_dvrp: dvrp_output="', dvrp_output, '" not allowed'
+          CALL local_stop
+       ENDIF
+    ENDIF
+
+    IF ( dvrp_directory == 'default' )  THEN
+       dvrp_directory = TRIM( dvrp_username ) // '/' // TRIM( run_identifier )
+    ENDIF
+
+    IF ( dvrp_file /= 'default'  .AND.  dvrp_file /= '/dev/null' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ init_dvrp: dvrp_file="', dvrp_file, '" not allowed'
+          CALL local_stop
+       ENDIF
+    ENDIF
+
+!
+!-- Strings are assigned to strings of special type which have a CHAR( 0 )
+!-- (C end-of-character symbol) at their end. This is needed when strings are
+!-- passed to C routines.
+    dvrp_directory_c = dvrp_directory
+    dvrp_file_c      = dvrp_file
+    dvrp_host_c      = dvrp_host
+    dvrp_password_c  = dvrp_password
+    dvrp_username_c  = dvrp_username
+
+!
+!-- Loop over all output modes choosed
+    m = 1
+    allocated = .FALSE.
+    DO WHILE ( mode_dvrp(m) /= ' ' )
+    
+!
+!--    Check, if mode is allowed
+       IF ( mode_dvrp(m)(1:10) /= 'isosurface'  .AND. &
+            mode_dvrp(m)(1:6)  /= 'slicer'      .AND. &
+            mode_dvrp(m)(1:9)  /= 'particles' )  THEN
+
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ init_dvrp: mode_dvrp="', mode_dvrp, '" not allowed'
+          ENDIF
+          CALL local_stop
+
+       ENDIF
+    
+!
+!--    Camera position must be computed and written on file when no dvrp-output
+!--    has been generated so far (in former runs)
+!       IF ( dvrp_filecount == 0 )  THEN
+!
+!--       Compute center of domain and distance of camera from center
+          center(1) = ( nx + 1.0 ) * dx * 0.5 * superelevation_x
+          center(2) = ( ny + 1.0 ) * dy * 0.5 * superelevation_y
+          center(3) = ( zu(nz_do3d) - zu(nzb) ) * 0.5 * superelevation
+          distance  = 1.5 * MAX( ( nx + 1.0 ) * dx * superelevation_x, &
+                                 ( ny + 1.0 ) * dy * superelevation_y, &
+	                         ( zu(nz_do3d) - zu(nzb) ) * superelevation )
+
+!
+!--       Write camera position on file
+          CALL DVRP_INIT( m-1, 0 )
+
+!
+!--       Create filename for camera
+          IF ( dvrp_output == 'rtsp' )  THEN
+
+    WRITE ( 9, * ) '***  vor dvrp_output_rtsp'
+    CALL FLUSH_( 9 )
+             dvrp_file   = TRIM( mode_dvrp(m) ) // '/camera.dvr'
+             dvrp_file_c = dvrp_file
+             CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
+                                    dvrp_password_c, dvrp_directory_c, &
+                                    dvrp_file_c )
+    WRITE ( 9, * ) '***  nach dvrp_output_rtsp'
+    CALL FLUSH_( 9 )
+
+          ELSEIF ( dvrp_output == 'ftp' )  THEN
+
+             dvrp_file   = TRIM( mode_dvrp(m) ) // '.camera.dvr'
+             dvrp_file_c = dvrp_file
+!             CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
+!                                   dvrp_password_c, dvrp_directory_c,    &
+!                                   dvrp_file_c )
+
+          ELSE
+
+             IF ( dvrp_file(1:9) /= '/dev/null' )  THEN
+                dvrp_file_local   = TRIM( mode_dvrp(m) ) // '.camera.dvr'
+                dvrp_file_local_c = dvrp_file_local
+             ELSE
+                dvrp_file_local_c = dvrp_file_c
+             ENDIF
+!             CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
+
+          ENDIF
+
+          CALL DVRP_CAMERA( m-1, center, distance )
+    WRITE ( 9, * ) '***  #1'
+    CALL FLUSH_( 9 )
+
+!
+!--       Define bounding box material and create a bounding box
+          CALL DVRP_MATERIAL_RGB( m-1, 1, 0.5, 0.5, 0.5, 0.0 )
+          CALL DVRP_BOUNDINGBOX( m-1, 1, 0.01, 0.0, 0.0, 0.0,    &
+                                 (nx+1) * dx * superelevation_x, &
+                                 (ny+1) * dy * superelevation_y, &
+                                 zu(nz_do3d) * superelevation )
+
+          CALL DVRP_VISUALIZE( m-1, 0, 0 )
+          CALL DVRP_EXIT( m-1 )
+    WRITE ( 9, * ) '***  #2'
+    CALL FLUSH_( 9 )
+
+
+!
+!--       Write topography isosurface on file
+          CALL DVRP_INIT( m-1, 0 )
+
+!
+!--       Create filename for buildings
+          IF ( dvrp_output == 'rtsp' )  THEN
+
+             dvrp_file   = TRIM( mode_dvrp(m) ) // '/buildings.dvr'
+             dvrp_file_c = dvrp_file
+             CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
+                                    dvrp_password_c, dvrp_directory_c, &
+                                    dvrp_file_c )
+    WRITE ( 9, * ) '***  #3'
+    CALL FLUSH_( 9 )
+
+          ENDIF
+
+!
+!--       Determine local gridpoint coordinates
+          IF ( .NOT. allocated )  THEN
+             ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), &
+                       zcoor_dvrp(nzb:nz_do3d) )
+             allocated = .TRUE.
+
+             DO  i = nxl, nxr+1
+                xcoor_dvrp(i) = i * dx * superelevation_x
+             ENDDO
+             DO  j = nys, nyn+1
+                ycoor_dvrp(j) = j * dy * superelevation_y
+             ENDDO
+             zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
+             nx_dvrp    = nxr+1 - nxl + 1
+             ny_dvrp    = nyn+1 - nys + 1
+             nz_dvrp    = nz_do3d - nzb + 1
+          ENDIF
+
+!
+!--       Define the grid used by dvrp
+          CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, &
+                          ycoor_dvrp, zcoor_dvrp )
+          CALL DVRP_MATERIAL_RGB( m-1, 1, 0.8, 0.7, 0.6, 0.0 )
+    WRITE ( 9, * ) '***  #4'
+    CALL FLUSH_( 9 )
+
+!
+!--       Compute and plot isosurface in dvr-format
+          ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
+          local_pf = 0.0
+          DO  i = nxl, nxr+1
+             DO  j = nys, nyn+1
+                IF ( nzb_s_inner(j,i) > 0 )  THEN
+                      local_pf(i,j,nzb:nzb_s_inner(j,i)) = 1.0
+                   ENDIF
+             ENDDO
+          ENDDO
+    WRITE ( 9, * ) '***  #4.1'
+    CALL FLUSH_( 9 )
+          CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
+                          cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
+    WRITE ( 9, * ) '***  #4.2'
+    CALL FLUSH_( 9 )
+          CALL DVRP_THRESHOLD( m-1, 1.0 )
+    WRITE ( 9, * ) '***  #4.3'
+    CALL FLUSH_( 9 )
+          CALL DVRP_VISUALIZE( m-1, 1, 0 )
+    WRITE ( 9, * ) '***  #4.4'
+    CALL FLUSH_( 9 )
+
+          DEALLOCATE( local_pf )
+
+          CALL DVRP_EXIT( m-1 )
+    WRITE ( 9, * ) '***  #5'
+    CALL FLUSH_( 9 )
+
+!
+!--       Write the surface isosurface on file
+          CALL DVRP_INIT( m-1, 0 )
+
+!
+!--       Create filename for surface
+          IF ( dvrp_output == 'rtsp' )  THEN
+
+             dvrp_file   = TRIM( mode_dvrp(m) ) // '/surface.dvr'
+             dvrp_file_c = dvrp_file
+             CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
+                                    dvrp_password_c, dvrp_directory_c, &
+                                    dvrp_file_c )
+    WRITE ( 9, * ) '***  #6'
+    CALL FLUSH_( 9 )
+
+          ENDIF
+
+!
+!--       Determine local gridpoint coordinates
+          IF ( .NOT. allocated )  THEN
+             ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), &
+                       zcoor_dvrp(nzb:nz_do3d) )
+             allocated = .TRUE.
+
+             DO  i = nxl, nxr+1
+                xcoor_dvrp(i) = i * dx * superelevation_x
+             ENDDO
+             DO  j = nys, nyn+1
+                ycoor_dvrp(j) = j * dy * superelevation_y
+             ENDDO
+             zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
+             nx_dvrp    = nxr+1 - nxl + 1
+             ny_dvrp    = nyn+1 - nys + 1
+             nz_dvrp    = nz_do3d - nzb + 1
+          ENDIF
+
+!
+!--       Define the grid used by dvrp
+          CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, &
+                          ycoor_dvrp, zcoor_dvrp )
+          CALL DVRP_MATERIAL_RGB( m-1, 1, 0.0, 0.6, 0.0, 0.0 )
+    WRITE ( 9, * ) '***  #7'
+    CALL FLUSH_( 9 )
+
+!
+!--       Compute and plot isosurface in dvr-format
+          ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
+          local_pf = 0.0
+          local_pf(:,:,0) = 1.0
+
+          CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
+                          cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
+          CALL DVRP_THRESHOLD( m-1, 1.0 )
+          CALL DVRP_VISUALIZE( m-1, 1, 0 )
+
+          DEALLOCATE( local_pf )
+
+          CALL DVRP_EXIT( m-1 )
+    WRITE ( 9, * ) '***  #8'
+    CALL FLUSH_( 9 )
+
+    
+!       ENDIF
+
+
+!
+!--    Initialize dvrp for all dvrp-calls during the run
+       CALL DVRP_INIT( m-1, 0 )
+
+!
+!--    Preliminary definition of filename for dvrp-output
+       IF ( dvrp_output == 'rtsp' )  THEN
+
+!
+!--       First initialize parameters for possible interactive steering.
+!--       Every parameter has to be passed to the respective stream.
+          pn = 1
+!
+!--       Initialize threshold counter needed for initialization of the
+!--       isosurface steering variables
+          tv = 0
+
+          DO WHILE ( mode_dvrp(pn) /= ' ' )
+
+             IF ( mode_dvrp(pn)(1:10) == 'isosurface' )  THEN
+
+                READ ( mode_dvrp(pn), '(10X,I1)' )  vn
+                steering_dvrp(pn)%name = do3d(0,vn)
+                tv = tv + 1
+
+                IF ( do3d(0,vn)(1:1) == 'w' )  THEN
+                   steering_dvrp(pn)%min  = -4.0
+                   steering_dvrp(pn)%max  =  5.0
+                ELSE
+                   steering_dvrp(pn)%min  = 288.0
+                   steering_dvrp(pn)%max  = 292.0
+                ENDIF
+
+                name_c = TRIM( do3d(0,vn) )
+    WRITE ( 9, * ) '***  #9'
+    CALL FLUSH_( 9 )
+                CALL DVRP_STEERING_INIT( m-1, name_c, steering_dvrp(pn)%min, &
+                                         steering_dvrp(pn)%max, threshold(tv) )
+    WRITE ( 9, * ) '***  #10'
+    CALL FLUSH_( 9 )
+
+             ELSEIF ( mode_dvrp(pn)(1:6) == 'slicer' )  THEN
+
+                READ ( mode_dvrp(pn), '(6X,I1)' )  vn
+                steering_dvrp(pn)%name = do2d(0,vn)
+                name_c = TRIM( 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' )
+                      steering_dvrp(pn)%imin   = 0
+                      steering_dvrp(pn)%imax   = nz_do3d
+                      slicer_position_dvrp(pn) = section(1,1)
+                      CALL DVRP_STEERING_INIT( m-1, name_c,            &
+                                               steering_dvrp(pn)%imin, &
+                                               steering_dvrp(pn)%imax, &
+                                               slicer_position_dvrp(pn) )
+                   CASE ( 'xz' )
+                      steering_dvrp(pn)%imin   = 0
+                      steering_dvrp(pn)%imax   = ny
+                      slicer_position_dvrp(pn) = section(1,2)
+                      CALL DVRP_STEERING_INIT( m-1, name_c,            &
+                                               steering_dvrp(pn)%imin, &
+                                               steering_dvrp(pn)%imax, &
+                                               slicer_position_dvrp(pn) )
+                   CASE ( 'yz' )
+                      steering_dvrp(pn)%imin = 0
+                      steering_dvrp(pn)%imax = nx
+                      slicer_position_dvrp(pn) = section(1,3)
+                      CALL DVRP_STEERING_INIT( m-1, name_c,            &
+                                               steering_dvrp(pn)%imin, &
+                                               steering_dvrp(pn)%imax, &
+                                               slicer_position_dvrp(pn) )
+                END SELECT
+
+             ENDIF
+
+             pn = pn + 1
+
+          ENDDO
+
+    WRITE ( 9, * ) '***  #11'
+    CALL FLUSH_( 9 )
+
+          dvrp_file = TRIM( mode_dvrp(m) ) // '/*****.dvr'
+          dvrp_file_c = dvrp_file
+          CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
+                                 dvrp_password_c, dvrp_directory_c, &
+                                 dvrp_file_c )
+    WRITE ( 9, * ) '***  #12'
+    CALL FLUSH_( 9 )
+
+       ELSEIF ( dvrp_output == 'ftp' )  THEN
+
+          dvrp_file   = TRIM( mode_dvrp(m) ) // '.%05d.dvr'
+          dvrp_file_c = dvrp_file
+!          CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
+!                                dvrp_password_c, dvrp_directory_c, dvrp_file_c )
+
+       ELSE
+
+          IF ( dvrp_file(1:9) /= '/dev/null' )  THEN
+             dvrp_file_local   = TRIM( mode_dvrp(m) ) // '.camera.dvr'
+             dvrp_file_local_c = dvrp_file_local
+          ELSE
+             dvrp_file_local_c = dvrp_file_c
+          ENDIF
+!          CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
+
+       ENDIF
+
+!       dvrp_file = TRIM( mode_dvrp(m) ) // '.%05d.dvr' // CHAR( 0 )
+!       dvrp_file = TRIM( mode_dvrp(m) ) // '/*****.dvr' // CHAR( 0 )
+!       dvrp_file = '/dev/null' // CHAR( 0 )
+!       CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host, dvrp_username, dvrp_password, &
+!                             dvrp_directory, dvrp_file )
+!       CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host, dvrp_username, dvrp_password, &
+!                              dvrp_directory, dvrp_file )
+!       CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file )
+
+!
+!--    Determine local gridpoint coordinates
+       IF ( .NOT. allocated )  THEN
+          ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), &
+                    zcoor_dvrp(nzb:nz_do3d) )
+          allocated = .TRUE.
+
+          DO  i = nxl, nxr+1
+             xcoor_dvrp(i) = i * dx * superelevation_x
+          ENDDO
+          DO  j = nys, nyn+1
+             ycoor_dvrp(j) = j * dy * superelevation_y
+          ENDDO
+          zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
+          nx_dvrp    = nxr+1 - nxl + 1
+          ny_dvrp    = nyn+1 - nys + 1
+          nz_dvrp    = nz_do3d - nzb + 1
+       ENDIF
+
+!
+!--    Define the grid used by dvrp
+    WRITE ( 9, * ) '***  #13'
+    CALL FLUSH_( 9 )
+
+       CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, ycoor_dvrp, &
+                       zcoor_dvrp )
+    WRITE ( 9, * ) '***  #14'
+    CALL FLUSH_( 9 )
+
+
+       m = m + 1
+
+    ENDDO
+
+#endif
+ END SUBROUTINE init_dvrp
+
+ 
+ SUBROUTINE init_dvrp_logging
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Initializes logging events for time measurement with dvrp software
+! and splits one PE from the global communicator in case that dvrp output
+! shall be done by one single PE.
+!------------------------------------------------------------------------------!
+#if defined( __dvrp_graphics )
+
+    USE dvrp_variables
+    USE pegrid
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=4) ::  chr
+    INTEGER           ::  idummy
+
+!
+!-- Initialize logging of calls by DVRP graphic software
+    WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_INIT'
+    CALL FLUSH_( 9 )
+    CALL DVRP_LOG_INIT( 'DVRP_LOG' // CHAR( 0 ), 0 )
+    WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_INIT'
+    CALL FLUSH_( 9 )
+
+!
+!-- User-defined logging events: #1 (total time needed by PALM)
+    WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_SYMBOL'
+    CALL FLUSH_( 9 )
+    CALL DVRP_LOG_SYMBOL( 1, 'PALM_total' // CHAR( 0 ) )
+    WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_SYMBOL'
+    CALL FLUSH_( 9 )
+    CALL DVRP_LOG_SYMBOL( 2, 'PALM_timestep' // CHAR( 0 ) )
+    WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_EVENT'
+    CALL FLUSH_( 9 )
+    CALL DVRP_LOG_EVENT( 1, 1 )
+    WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_EVENT'
+    CALL FLUSH_( 9 )
+
+#if defined( __parallel )
+!
+!-- Find out, if dvrp output shall be done by a dedicated PE
+    CALL local_getenv( 'use_seperate_pe_for_dvrp_output', 31, chr, idummy )
+    IF ( chr == 'true' )  THEN
+       use_seperate_pe_for_dvrp_output = .TRUE.
+    WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_SPLIT'
+    CALL FLUSH_( 9 )
+       CALL DVRP_SPLIT( MPI_COMM_WORLD, comm_palm )
+    WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_SPLIT'
+    CALL FLUSH_( 9 )
+       CALL MPI_COMM_SIZE( comm_palm, numprocs, ierr )
+    ENDIF
+#endif
+
+#endif
+ END SUBROUTINE init_dvrp_logging
+
+
+ SUBROUTINE close_dvrp
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Exit of dvrp software and finish dvrp logging
+!------------------------------------------------------------------------------!
+#if defined( __dvrp_graphics )
+
+    USE control_parameters
+    USE dvrp
+    USE dvrp_variables
+
+    INTEGER ::  m
+
+!
+!-- If required, close dvrp-software and logging of dvrp-calls
+    IF ( dt_dvrp /= 9999999.9 )  THEN
+       m = 1
+       DO WHILE ( mode_dvrp(m) /= ' ' )
+          CALL DVRP_EXIT( m-1 )
+          m = m + 1
+       ENDDO
+       CALL DVRP_LOG_EVENT( -1, 1 )   ! Logging of total cpu-time used by PALM
+       IF ( use_seperate_pe_for_dvrp_output )  THEN
+          CALL DVRP_SPLIT_EXIT( 1 )      ! Argument 0: reduced output
+       ELSE
+          CALL DVRP_LOG_EXIT( 1 )        ! Argument 0: reduced output
+       ENDIF
+    ENDIF
+
+#endif
+ END SUBROUTINE close_dvrp
Index: palm/trunk/SOURCE/init_grid.f90
===================================================================
--- palm/trunk/SOURCE/init_grid.f90	(revision 4901)
+++ palm/trunk/SOURCE/init_grid.f90	(revision 1)
@@ -1,146 +1,66 @@
-!> @file init_grid.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE init_grid
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Height of level k=0 for the u,v-grid is always set 0.0,
-! small changes to follow coding standard
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Bugfix in building mapping when static driver is available but no actual building is present
-! within the model domain
-!
-! 4691 2020-09-22 14:38:38Z suehring
-! Reference model topography to the lowest grid point also in ASCII input case
-!
-! 4653 2020-08-27 08:54:43Z pavelkrc
-! file re-formatted to follow the PALM coding standard
-!
-! 4630 2020-07-30 14:54:34Z suehring
-! In case of ASCII topography input flag grid points as terrain and building.
-!
-! 4601 2020-07-14 12:06:09Z suehring
-! Minor formatting adjustments
-!
-! 4564 2020-06-12 14:03:36Z raasch
-! Vertical nesting method of Huq et al. (2019) removed
-!
-! 4543 2020-05-20 14:12:22Z gronemeier
-! Remove non-required check for canyon height
-!
-! 4507 2020-04-22 18:21:45Z gronemeier
-! update origin_z with shifting height of orography (oro_min)
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added,
-! bugfix for call of exchange horiz 2d
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4414 2020-02-19 20:16:04Z suehring
-! - Remove deprecated topography arrays nzb_s_inner, nzb_u_inner, etc.
-! - Move initialization of boundary conditions and multigrid into an extra module interface.
-!
-! 4386 2020-01-27 15:07:30Z Giersch
-! Allocation statements, comments, naming of variables revised and _wp added to real type values
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Revise error messages for generic tunnel setup.
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4340 2019-12-16 08:17:03Z Giersch
-! Topography closed channel flow with symmetric boundaries implemented
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4328 2019-12-09 18:53:04Z suehring
-! Minor change in nzb_max computation. Commentation added.
-!
-! 4314 2019-11-29 10:29:20Z suehring
-! Set additional topography flag 4 to mark topography grid points emerged from the filtering process.
-!
-! 4294 2019-11-13 18:34:16Z suehring
-! Bugfix, always set bit 5 and 6 of wall_flags, indicating terrain- and building surfaces in all
-! cases, in order to enable terrain-following output also when no land- or urban-surface model is
-! applied.
-!
-! 4265 2019-10-15 16:16:24Z suehring
-! Bugfix for last commit, exchange oro_max variable only when it is allocated (not necessarily the
-! case when topography is input from ASCII file).
-!
-! 4245 2019-09-30 08:40:37Z pavelkrc
-! Store oro_max (building z-offset) in 2D for building surfaces
-!
-! 4189 2019-08-26 16:19:38Z suehring
-! - Add check for proper setting of namelist parameter topography
-! - Set flag to indicate land surfaces in case no topography is provided
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Pre-calculate topography top index and store it on an array (replaces former functions
-! get_topography_top_index)
-!
-! 4159 2019-08-15 13:31:35Z suehring
-! Revision of topography processing. This was not consistent between 2D and 3D buildings.
-!
-! 4144 2019-08-06 09:11:47Z raasch
-! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
-!
-! 4115 2019-07-24 12:50:49Z suehring
-! Bugfix in setting near-surface flag 24, inidicating wall-bounded grid points
-!
-! 4110 2019-07-22 17:05:21Z suehring
-! - Separate initialization of advection flags for momentum and scalars.
-! - Change subroutine interface for ws_init_flags_scalar to pass boundary flags
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! Fix bad commit
-!
-! 3926 2019-04-23 12:56:42Z suehring
-! Minor bugfix in building mapping when all building IDs in the model domain are missing
-!
-! 3857 2019-04-03 13:00:16Z knoop
-! In projection of non-building 3D objects onto numerical grid remove dependency on building_type
-!
-! 3763 2019-02-25 17:33:49Z suehring
-! Replace work-around for ghost point exchange of 1-byte arrays with specific routine as already
-! done in other routines
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! unused variables removed
-!
-! 3661 2019-01-08 18:22:50Z suehring
-! Remove setting of nzb_max to nzt at non-cyclic boundary PEs, instead, order degradation of
-! advection scheme is handeled directly in advec_ws
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Comment added
+! $Log: init_grid.f90,v $
+! Revision 1.17  2006/08/22 14:00:05  raasch
+! +dz_max to limit vertical stretching,
+! bugfix in index array initialization for line- or point-like topography
+! structures
+!
+! Revision 1.16  2006/03/03 14:28:31  letzel
+! call of user_init_grid now requires the actual parameter nzb_local
+!
+! Revision 1.15  2006/02/24 16:05:59  raasch
+! Error removed: l_wall modification (multiplication with wall adjustment
+! factor and ghost point exchange) must be taken out of the if-clause (see end
+! of this routine)
+!
+! Revision 1.14  2006/02/23 12:30:59  raasch
+! Definition of index and wall arrays describing topography
+!
+! Revision 1.13  2002/12/19 15:38:38  raasch
+! Calculation of dl_grid removed, STOP statement replaced by call of subroutine
+! local_stop
+!
+! Revision 1.12  2001/07/20 13:06:33  raasch
+! +dzu_mg, dzw_mg, f1_mg, f2_mg, f3_mg
+!
+! Revision 1.11  2001/03/30 07:31:20  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.10  2001/01/22 19:35:19  letzel
+! All comments translated into English.
+!
+! Revision 1.9  2001/01/22 07:06:16  raasch
+! Module test_variables removed
+!
+! Revision 1.8  1999/02/05 09:08:32  raasch
+! Erweiterung von dzw um einen Gitterpunkt nach oben fuer Upstream-Spline-
+! Verfahren
+!
+! Revision 1.7  1998/07/06 12:16:43  raasch
+! + USE test_variables
+!
+! Revision 1.6  1998/03/18 20:13:16  raasch
+! dz wird unveraendert gelassen (hatte bisher den Wert der groessten,
+! gestreckten) Gitterweite
+!
+! Revision 1.5  1997/09/19 07:43:27  raasch
+! +dd2zu, dl_grid, l_grid
+!
+! Revision 1.4  1997/09/12 06:26:02  raasch
+! Kehrwerte der Gitterweitenquadrate werden berechnet
+!
+! Revision 1.3  1997/09/09 08:29:12  raasch
+! Kehrwerte der Gitterweiten werden berechnet
+!
+! Revision 1.2  1997/08/26 06:31:11  raasch
+! Berechnung der Vertikalniveaus und der Gitterweiten
 !
 ! Revision 1.1  1997/08/11 06:17:45  raasch
@@ -149,439 +69,72 @@
 !
 ! Description:
-! -------------------------------------------------------------------------------------------------!
-!> Creating grid depending constants
-!> @todo: Rearrange topo flag list
-!> @todo: reference 3D buildings on top of orography is not tested and may need further improvement
-!>        for steep slopes
-!> @todo: Use more advanced setting of building type at filled holes
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_grid
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dd2zu, ddzu, ddzu_pres, ddzw, dzu, dzw, x, xu, y, yv, zu, zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  constant_flux_layer, dz, dz_max, dz_stretch_factor,                                 &
-               dz_stretch_factor_array, dz_stretch_level, dz_stretch_level_end,                    &
-               dz_stretch_level_end_index, dz_stretch_level_start_index,                           &
-               dz_stretch_level_start, message_string,                                             &
-               number_stretch_level_end,                                                           &
-               number_stretch_level_start,                                                         &
-               ocean_mode,                                                                         &
-               psolver,                                                                            &
-               symmetry_flag,                                                                      &
-               topography,                                                                         &
-               use_surface_fluxes
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddx2, ddy, ddy2, dx, dx2, dy, dy2, zu_s_inner, zw_w_inner
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               ny,                                                                                 &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nz,                                                                                 &
-               nzb,                                                                                &
-               nzb_diff,                                                                           &
-               nzb_max,                                                                            &
-               nzt,                                                                                &
-               topo_top_ind,                                                                       &
-               topo_min_level
-
-    USE kinds
-
+! ------------
+! Creating grid depending constants
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE grid_variables
+    USE indices
     USE pegrid
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i             !< index variable along x
-    INTEGER(iwp) ::  j             !< index variable along y
-    INTEGER(iwp) ::  k             !< index variable along z
-    INTEGER(iwp) ::  k_top         !< topography top index on local PE
-    INTEGER(iwp) ::  n             !< loop variable for stretching
-    INTEGER(iwp) ::  number_dz     !< number of user-specified dz values
-    INTEGER(iwp) ::  nzb_local_max !< vertical grid index of maximum topography height
-    INTEGER(iwp) ::  nzb_local_min !< vertical grid index of minimum topography height
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  topo !< input array for 3D topography and dummy array for setting "outer"-flags
-
-    REAL(wp) ::  dz_level_end  !< distance between calculated height level for u/v-grid and user-specified end level for stretching
-    REAL(wp) ::  dz_stretched  !< stretched vertical grid spacing
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  min_dz_stretch_level_end !< Array that contains all minimum heights where the stretching
-                                                                     !< can end
-
-
-!
-!-- Calculation of horizontal array bounds including ghost layers
-    nxlg = nxl - nbgp
-    nxrg = nxr + nbgp
-    nysg = nys - nbgp
-    nyng = nyn + nbgp
+    INTEGER ::  bh, blx, bly, bxl, bxr, byn, bys, i, i_center, j, j_center, k, &
+                l, nzb_si, nzt_l, vi
+
+    INTEGER, DIMENSION(:), ALLOCATABLE   ::  vertical_influence
+
+    INTEGER, DIMENSION(:,:), ALLOCATABLE ::  corner_nl, corner_nr, corner_sl,  &
+                                             corner_sr, wall_l, wall_n, wall_r,&
+                                             wall_s, nzb_local, nzb_tmp
+
+    REAL    ::  dx_l, dy_l, dz_stretched
+
+    REAL, DIMENSION(0:ny,0:nx)          ::  topo_height
+
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  distance
 
 !
 !-- Allocate grid arrays
-    ALLOCATE( x(0:nx) )
-    ALLOCATE( xu(0:nx) )
-
-    DO i = 0, nx
-       xu(i) = i * dx
-       x(i)  = i * dx + 0.5_wp * dx
-    ENDDO
-
-    ALLOCATE( y(0:ny) )
-    ALLOCATE( yv(0:ny) )
-
-    DO j = 0, ny
-       yv(j) = j * dy
-       y(j)  = j * dy + 0.5_wp * dy
-    ENDDO
-
-    ALLOCATE( ddzu(1:nzt+1) )
-    ALLOCATE( ddzw(1:nzt+1) )
-    ALLOCATE( dd2zu(1:nzt) )
-    ALLOCATE( dzu(1:nzt+1) )
-    ALLOCATE( dzw(1:nzt+1) )
-    ALLOCATE( zu(nzb:nzt+1) )
-    ALLOCATE( zw(nzb:nzt+1) )
-
-!
-!-- For constructing an appropriate grid, the vertical grid spacing dz has to be specified with a
-!-- non-negative value in the parameter file.
-    IF ( dz(1) == -1.0_wp )  THEN
-       message_string = 'missing dz'
-       CALL message( 'init_grid', 'PA0200', 1, 2, 0, 6, 0 )
-    ELSEIF ( dz(1) <= 0.0_wp )  THEN
-       WRITE( message_string, * ) 'dz=',dz(1),' <= 0.0'
-       CALL message( 'init_grid', 'PA0201', 1, 2, 0, 6, 0 )
+    ALLOCATE( ddzu(1:nzt+1), ddzw(1:nzt+1), dd2zu(1:nzt), dzu(1:nzt+1), &
+              dzw(1:nzt+1), l_grid(1:nzt), zu(0:nzt+1), zw(0:nzt+1) )
+
+!
+!-- Compute height of u-levels from constant grid length and dz stretch factors
+    IF ( dz == -1.0 )  THEN
+       IF ( myid == 0 )  PRINT*,'+++ init_grid:  missing dz'
+       CALL local_stop
+    ELSEIF ( dz <= 0.0 )  THEN
+       IF ( myid == 0 )  PRINT*,'+++ init_grid:  dz=',dz,' <= 0.0'
+       CALL local_stop
     ENDIF
-
-!
-!-- Initialize dz_stretch_level_start with the value of dz_stretch_level if it was set by the user.
-    IF ( dz_stretch_level /= -9999999.9_wp ) THEN
-       dz_stretch_level_start(1) = dz_stretch_level
-    ENDIF
-
-!
-!-- Determine number of dz values and stretching levels specified by the user to allow right
-!-- controlling of the stretching mechanism and to perform error checks. The additional requirement
-!-- that dz /= dz_max for counting number of user-specified dz values is necessary. Otherwise
-!-- restarts would abort if the old stretching mechanism with dz_stretch_level is used (Attention:
-!-- The user is not allowed to specify a dz value equal to the default of dz_max = 999.0).
-    number_dz = COUNT( dz /= -1.0_wp  .AND.  dz /= dz_max)
-    number_stretch_level_start = COUNT( dz_stretch_level_start /= -9999999.9_wp )
-    number_stretch_level_end = COUNT( dz_stretch_level_end /= 9999999.9_wp )
-
-!
-!-- The number of specified end levels +1 has to be the same as the number
-!-- of specified dz values
-    IF ( number_dz /= number_stretch_level_end + 1 ) THEN
-       WRITE( message_string, * )  'The number of values for dz = ', number_dz,                    &
-                                   'has to be the same as& ', 'the number of values for ',         &
-                                   'dz_stretch_level_end + 1 = ', number_stretch_level_end+1
-       CALL message( 'init_grid', 'PA0156', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- The number of specified start levels has to be the same or one less than the number of specified
-!-- dz values
-    IF ( number_dz /= number_stretch_level_start + 1  .AND.                                        &
-         number_dz /= number_stretch_level_start )  THEN
-       WRITE( message_string, * )  'The number of values for dz = ', number_dz,                    &
-                                   'has to be the same as or one ',                                &
-                                   'more than& the number of values for ',                         &
-                                   'dz_stretch_level_start = ', number_stretch_level_start
-       CALL message( 'init_grid', 'PA0211', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!-- The number of specified start levels has to be the same or one more than the number of specified
-!-- end levels
-    IF ( number_stretch_level_start /= number_stretch_level_end + 1  .AND.                         &
-         number_stretch_level_start /= number_stretch_level_end ) THEN
-       WRITE( message_string, * )  'The number of values for ',                                    &
-                                   'dz_stretch_level_start = ', dz_stretch_level_start,            &
-                                   'has to be the ', 'same or one more than& the number of ',      &
-                                   'values for dz_stretch_level_end = ', number_stretch_level_end
-       CALL message( 'init_grid', 'PA0216', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Initialize dz for the free atmosphere with the value of dz_max
-    IF ( dz(number_stretch_level_start+1) == -1.0_wp  .AND.  number_stretch_level_start /= 0 ) THEN
-       dz(number_stretch_level_start+1) = dz_max
-    ENDIF
-
-!
-!-- Initialize the stretching factor if (infinitely) stretching in the free atmosphere is desired
-!-- (dz_stretch_level_end was not specified for the free atmosphere)
-    IF ( number_stretch_level_start == number_stretch_level_end + 1 )  THEN
-       dz_stretch_factor_array(number_stretch_level_start) = dz_stretch_factor
-    ENDIF
-
-!
-!-- Allocation of arrays for stretching
-    ALLOCATE( min_dz_stretch_level_end(number_stretch_level_start) )
-
-!
-!-- Define the vertical grid levels. Start with atmosphere branch
-    IF ( .NOT. ocean_mode )  THEN
-
-!
-!--    The stretching region has to be large enough to allow for a smooth transition between two
-!--    different grid spacings. The number 4 is an empirical value.
-       DO n = 1, number_stretch_level_start
-          min_dz_stretch_level_end(n) = dz_stretch_level_start(n) + 4 * MAX( dz(n),dz(n+1) )
-       ENDDO
-
-       IF ( ANY( min_dz_stretch_level_end(1:number_stretch_level_start) >                          &
-                 dz_stretch_level_end(1:number_stretch_level_start) ) )  THEN
-          message_string= 'Each dz_stretch_level_end has to be larger ' //                         &
-                          'than its corresponding value for &' //                                  &
-                          'dz_stretch_level_start + 4*MAX(dz(n),dz(n+1)) '//                       &
-                          'to allow for smooth grid stretching'
-          CALL message( 'init_grid', 'PA0224', 1, 2, 0, 6, 0 )
+!
+!-- Since the w-level lies on the surface, the first u-level (staggered!) lies
+!-- below the surface (used for "mirror" boundary condition).
+!-- The first u-level above the surface corresponds to the top of the 
+!-- Prandtl-layer.
+    zu(0) = - dz * 0.5
+    zu(1) =   dz * 0.5
+
+    dz_stretch_level_index = nzt+1
+    dz_stretched = dz
+    DO  k = 2, nzt+1
+       IF ( dz_stretch_level <= zu(k-1)  .AND.  dz_stretched < dz_max )  THEN
+          dz_stretched = dz_stretched * dz_stretch_factor
+          dz_stretched = MIN( dz_stretched, dz_max )
+          IF ( dz_stretch_level_index == nzt+1 )  dz_stretch_level_index = k-1
        ENDIF
-
-!
-!--    Stretching must not be applied within the surface layer (first two grid points). For the
-!--    default case dz_stretch_level_start is negative. Therefore the absolut value is checked here.
-       IF ( ANY( ABS( dz_stretch_level_start ) <= dz(1) * 1.5_wp ) ) THEN
-          WRITE( message_string, * )  'Each dz_stretch_level_start has to be ',                    &
-                                      'larger than ', dz(1) * 1.5
-          CALL message( 'init_grid', 'PA0226', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    The stretching has to start and end on a grid level. Therefore user-specified values are
-!--    mapped to the next lowest level. The calculation of the first level is realized differently
-!--    just because of historical reasons (the advanced/new stretching mechanism was realized in a
-!--    way that results don't change if the old parameters dz_stretch_level, dz_stretch_factor and
-!--    dz_max are used).
-       IF ( number_stretch_level_start /= 0 )  THEN
-          dz_stretch_level_start(1) = INT( (dz_stretch_level_start(1) - dz(1)/2.0) / dz(1) )       &
-                                      * dz(1) + dz(1)/2.0
-       ENDIF
-
-       IF ( number_stretch_level_start > 1 ) THEN
-          DO n = 2, number_stretch_level_start
-             dz_stretch_level_start(n) = INT( dz_stretch_level_start(n) / dz(n) ) * dz(n)
-          ENDDO
-       ENDIF
-
-       IF ( number_stretch_level_end /= 0 ) THEN
-          DO n = 1, number_stretch_level_end
-             dz_stretch_level_end(n) = INT( dz_stretch_level_end(n) / dz(n+1) ) * dz(n+1)
-          ENDDO
-       ENDIF
-
-!
-!--    Determine stretching factor if necessary
-       IF ( number_stretch_level_end >= 1 ) THEN
-          CALL calculate_stretching_factor( number_stretch_level_end )
-       ENDIF
-
-!
-!--    Grid for atmosphere with surface at z=0. This corresponds to k=0 on the w-grid AND
-!--    the u-grid.
-!--    First compute the u- and v-levels.
-!--    The second u-level (k=1) corresponds to the top of the surface layer.
-       zu(0) = 0.0_wp
-       zu(1) = dz(1) * 0.5_wp
-
-!
-!--    Determine u and v height levels considering the possibility of grid stretching in several
-!--    heights.
-       n = 1
-       dz_stretch_level_start_index = nzt+1
-       dz_stretch_level_end_index = nzt+1
-       dz_stretched = dz(1)
-
-!--    The default value of dz_stretch_level_start is negative, thus the first condition is true
-!--    even if no stretching shall be applied. Hence, the second condition is also necessary.
-       DO  k = 2, nzt+1-symmetry_flag
-          IF ( dz_stretch_level_start(n) <= zu(k-1)  .AND.                                         &
-               dz_stretch_level_start(n) /= -9999999.9_wp )  THEN
-             dz_stretched = dz_stretched * dz_stretch_factor_array(n)
-
-             IF ( dz(n) > dz(n+1) )  THEN
-                dz_stretched = MAX( dz_stretched, dz(n+1) ) !Restrict dz_stretched to the user-specified (higher) dz
-             ELSE
-                dz_stretched = MIN( dz_stretched, dz(n+1) ) !Restrict dz_stretched to the user-specified (lower) dz
-             ENDIF
-
-             IF ( dz_stretch_level_start_index(n) == nzt+1 )  dz_stretch_level_start_index(n) = k-1
-
-          ENDIF
-
-          zu(k) = zu(k-1) + dz_stretched
-
-!
-!--       Make sure that the stretching ends exactly at dz_stretch_level_end
-          dz_level_end = ABS( zu(k) - dz_stretch_level_end(n) )
-
-          IF ( dz_level_end  <  dz(n+1) / 3.0 )  THEN
-             zu(k) = dz_stretch_level_end(n)
-             dz_stretched = dz(n+1)
-             dz_stretch_level_end_index(n) = k
-             n = n + 1
-          ENDIF
-       ENDDO
-
-!
-!--    If a closed channel flow is simulated, make sure that grid structure is the same for both
-!--    bottom and top boundary. (Hint: Using a different dz at the bottom and at the top makes no
-!--    sense due to symmetric boundaries where dz should be equal. Therefore, different dz at the
-!--    bottom and top causes an abort (see check_parameters).)
-       IF ( topography == 'closed_channel' )  THEN
-          zu(nzt+1) = zu(nzt) + dz(1) * 0.5_wp
-       ENDIF
-
-!
-!--    Compute the w-levels. They are always staggered half-way between the corresponding u-levels.
-!--    In case of dirichlet bc for u and v at the ground the first u- and w-level (k=0) are defined
-!--    at same height (z=0).
-!--    Per default, the top w-level is extrapolated linearly. In case of a closed channel flow,
-!--    zu(nzt+1) and zw(nzt) must be set explicitely.
-!--    (Hint: Using a different dz at the bottom and at the top makes no sense due to symmetric
-!--    boundaries where dz should be equal. Therefore, different dz at the bottom and top causes an
-!--    abort (see check_parameters).)
-       zw(0) = 0.0_wp
-       DO  k = 1, nzt-symmetry_flag
-          zw(k) = ( zu(k) + zu(k+1) ) * 0.5_wp
-       ENDDO
-       IF ( topography == 'closed_channel' )  THEN
-          zw(nzt)   = zw(nzt-1) + dz(1)
-          zw(nzt+1) = zw(nzt) + dz(1)
-       ELSE
-          zw(nzt+1) = zw(nzt) + 2.0_wp * ( zu(nzt+1) - zw(nzt) )
-       ENDIF
-
-    ELSE !ocean branch
-
-!
-!--    The stretching region has to be large enough to allow for a smooth transition between two
-!--    different grid spacings. The number 4 is an empirical value
-       DO n = 1, number_stretch_level_start
-          min_dz_stretch_level_end(n) = dz_stretch_level_start(n) - 4 * MAX( dz(n),dz(n+1) )
-       ENDDO
-
-       IF ( ANY( min_dz_stretch_level_end (1:number_stretch_level_start) <                         &
-                 dz_stretch_level_end(1:number_stretch_level_start) ) )  THEN
-             message_string= 'Each dz_stretch_level_end has to be less ' //                        &
-                             'than its corresponding value for &' //                               &
-                             'dz_stretch_level_start - 4*MAX(dz(n),dz(n+1)) '//                    &
-                             'to allow for smooth grid stretching'
-             CALL message( 'init_grid', 'PA0224', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    Stretching must not be applied close to the surface (last two grid points). For the default
-!--    case dz_stretch_level_start is negative.
-       IF ( ANY( dz_stretch_level_start >= - dz(1) * 1.5_wp ) )  THEN
-          WRITE( message_string, * )  'Each dz_stretch_level_start has to be ',                    &
-                                      'less than ', -dz(1) * 1.5
-             CALL message( 'init_grid', 'PA0226', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    The stretching has to start and end on a grid level. Therefore user-specified values are
-!--    mapped to the next highest level. The calculation of the first level is realized differently
-!--    just because of historical reasons (the advanced/new stretching mechanism was realized in a
-!--    way that results don't change if the old parameters dz_stretch_level, dz_stretch_factor and
-!--    dz_max are used)
-       IF ( number_stretch_level_start /= 0 )  THEN
-          dz_stretch_level_start(1) = INT( (dz_stretch_level_start(1) + dz(1)/2.0) / dz(1) )       &
-                                      * dz(1) - dz(1)/2.0
-       ENDIF
-
-       IF ( number_stretch_level_start > 1 )  THEN
-          DO n = 2, number_stretch_level_start
-             dz_stretch_level_start(n) = INT( dz_stretch_level_start(n) / dz(n) ) * dz(n)
-          ENDDO
-       ENDIF
-
-       IF ( number_stretch_level_end /= 0 )  THEN
-          DO n = 1, number_stretch_level_end
-             dz_stretch_level_end(n) = INT( dz_stretch_level_end(n) / dz(n+1) ) * dz(n+1)
-          ENDDO
-       ENDIF
-
-!
-!--    Determine stretching factor if necessary
-       IF ( number_stretch_level_end >= 1 ) THEN
-          CALL calculate_stretching_factor( number_stretch_level_end )
-       ENDIF
-
-!
-!--    Grid for ocean with free water surface is at k=nzt (w-grid).
-!--    In case of neumann bc at the ground the first first u-level (k=0) lies below the first
-!--    w-level (k=0). In case of dirichlet bc the first u- and w-level are defined at same height,
-!--    but staggered from the second level.
-!--    The second u-level (k=1) corresponds to the top of the surface layer.
-!--    z values are negative starting from z=0 (surface)
-       zu(nzt+1) =   dz(1) * 0.5_wp
-       zu(nzt)   = - dz(1) * 0.5_wp
-
-!
-!--    Determine u and v height levels considering the possibility of grid stretching in several
-!--    heights.
-       n = 1
-       dz_stretch_level_start_index = 0
-       dz_stretch_level_end_index = 0
-       dz_stretched = dz(1)
-
-       DO  k = nzt-1, 0, -1
-
-          IF ( dz_stretch_level_start(n) >= zu(k+1) )  THEN
-             dz_stretched = dz_stretched * dz_stretch_factor_array(n)
-
-             IF ( dz(n) > dz(n+1) )  THEN
-                dz_stretched = MAX( dz_stretched, dz(n+1) ) !Restrict dz_stretched to the user-specified (higher) dz
-             ELSE
-                dz_stretched = MIN( dz_stretched, dz(n+1) ) !Restrict dz_stretched to the user-specified (lower) dz
-             ENDIF
-
-             IF ( dz_stretch_level_start_index(n) == 0 )  dz_stretch_level_start_index(n) = k+1
-
-          ENDIF
-
-          zu(k) = zu(k+1) - dz_stretched
-
-!
-!--       Make sure that the stretching ends exactly at dz_stretch_level_end
-          dz_level_end = ABS( zu(k) - dz_stretch_level_end(n) )
-
-          IF ( dz_level_end  < dz(n+1)/3.0 )  THEN
-             zu(k) = dz_stretch_level_end(n)
-             dz_stretched = dz(n+1)
-             dz_stretch_level_end_index(n) = k
-             n = n + 1
-          ENDIF
-       ENDDO
-
-!
-!--    Compute the w-levels. They are always staggered half-way between the corresponding u-levels,
-!--    except for u and v at the ground. In this case the first u- and
-!--    w-level are defined at same height. The top w-level (nzt+1) is not used but set for
-!--    consistency, since w and all scalar variables are defined up to nzt+1.
-       zw(nzt+1) = dz(1)
-       zw(nzt)   = 0.0_wp
-       DO  k = 0, nzt
-          zw(k) = ( zu(k) + zu(k+1) ) * 0.5_wp
-       ENDDO
-
-!
-!--    Like for the atmosphere, the first u-grid and w-grid-level are defined at same height.
-       zu(0) = zw(0)
-
-    ENDIF !End of defining the vertical grid levels
+       zu(k) = zu(k-1) + dz_stretched
+    ENDDO
+
+!
+!-- Compute the u-levels. They are always staggered half-way between the 
+!-- corresponding w-levels. The top w-level is extrapolated linearly.
+    zw(0) = 0.0
+    DO  k = 1, nzt
+       zw(k) = ( zu(k) + zu(k+1) ) * 0.5
+    ENDDO
+    zw(nzt+1) = zw(nzt) + 2.0 * ( zu(nzt+1) - zw(nzt) )
 
 !
@@ -589,100 +142,115 @@
     DO  k = 1, nzt+1
        dzu(k)  = zu(k) - zu(k-1)
-       ddzu(k) = 1.0_wp / dzu(k)
+       ddzu(k) = 1.0 / dzu(k)
        dzw(k)  = zw(k) - zw(k-1)
-       ddzw(k) = 1.0_wp / dzw(k)
+       ddzw(k) = 1.0 / dzw(k)
     ENDDO
 
     DO  k = 1, nzt
-       dd2zu(k) = 1.0_wp / ( dzu(k) + dzu(k+1) )
-    ENDDO
-
-!
-!-- The FFT- SOR-pressure solvers assume grid spacings of a staggered grid everywhere. For the
-!-- actual grid, the grid spacing at the lowest level is only dz/2, but should be dz. Therefore, an
-!-- additional array containing with appropriate grid information is created for these solvers.
-    IF ( psolver(1:9) /= 'multigrid' )  THEN
-       ALLOCATE( ddzu_pres(1:nzt+1) )
-       ddzu_pres = ddzu
-       ddzu_pres(1) = ddzu_pres(2)  ! change for lowest level
+       dd2zu(k) = 1.0 / ( dzu(k) + dzu(k+1) )
+    ENDDO
+
+!
+!-- In case of multigrid method, compute grid lengths and grid factors for the
+!-- grid levels
+    IF ( psolver == 'multigrid' )  THEN
+
+       ALLOCATE( ddx2_mg(maximum_grid_level), ddy2_mg(maximum_grid_level), &
+                 dzu_mg(nzb+1:nzt+1,maximum_grid_level),                   &
+                 dzw_mg(nzb+1:nzt+1,maximum_grid_level),                   &
+                 f1_mg(nzb+1:nzt,maximum_grid_level),                      &
+                 f2_mg(nzb+1:nzt,maximum_grid_level),                      &
+                 f3_mg(nzb+1:nzt,maximum_grid_level) )
+
+       dzu_mg(:,maximum_grid_level) = dzu
+       dzw_mg(:,maximum_grid_level) = dzw
+       nzt_l = nzt
+       DO  l = maximum_grid_level-1, 1, -1
+           dzu_mg(nzb+1,l) = 2.0 * dzu_mg(nzb+1,l+1)
+           dzw_mg(nzb+1,l) = 2.0 * dzw_mg(nzb+1,l+1)
+           nzt_l = nzt_l / 2
+           DO  k = 2, nzt_l+1
+              dzu_mg(k,l) = dzu_mg(2*k-2,l+1) + dzu_mg(2*k-1,l+1)
+              dzw_mg(k,l) = dzw_mg(2*k-2,l+1) + dzw_mg(2*k-1,l+1)
+           ENDDO
+       ENDDO
+
+       nzt_l = nzt
+       dx_l  = dx
+       dy_l  = dy
+       DO  l = maximum_grid_level, 1, -1
+          ddx2_mg(l) = 1.0 / dx_l**2
+          ddy2_mg(l) = 1.0 / dy_l**2
+          DO  k = nzb+1, nzt_l
+             f2_mg(k,l) = 1.0 / ( dzu_mg(k+1,l) * dzw_mg(k,l) )
+             f3_mg(k,l) = 1.0 / ( dzu_mg(k,l)   * dzw_mg(k,l) )
+             f1_mg(k,l) = 2.0 * ( ddx2_mg(l) + ddy2_mg(l) ) + &
+                          f2_mg(k,l) + f3_mg(k,l)
+          ENDDO
+          nzt_l = nzt_l / 2
+          dx_l  = dx_l * 2.0
+          dy_l  = dy_l * 2.0
+       ENDDO
+
     ENDIF
 
 !
 !-- Compute the reciprocal values of the horizontal grid lengths.
-    ddx = 1.0_wp / dx
-    ddy = 1.0_wp / dy
+    ddx = 1.0 / dx
+    ddy = 1.0 / dy
     dx2 = dx * dx
     dy2 = dy * dy
-    ddx2 = 1.0_wp / dx2
-    ddy2 = 1.0_wp / dy2
-
-!
-!-- Allocate 3D array to set topography
-    ALLOCATE( topo(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    topo = 0
-!
-!-- Initialize topography by generic topography or read topography from file.
-    CALL init_topo( topo )
-!
-!-- Set flags to mask topography on the grid.
-    CALL set_topo_flags( topo )
-
-!
-!-- Determine the maximum level of topography. It is used for steering the degradation of order of
-!-- the applied advection scheme, as well in the lpm.
-    k_top = 0
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt + 1
-             k_top = MAX( k_top, MERGE( k, 0, .NOT. BTEST( topo(k,j,i), 0 ) ) )
-          ENDDO
-       ENDDO
-    ENDDO
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( k_top, nzb_max, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
-#else
-    nzb_max = k_top
-#endif
-!
-!-- Increment nzb_max by 1 in order to allow for proper diverengence correction.
-!-- Further, in case topography extents up to the model top, limit to nzt.
-    nzb_max = MIN( nzb_max+1, nzt )
-!
-!-- Determine minimum index of topography. Usually, this will be nzb. In case there is elevated
-!-- topography, however, the lowest topography will be higher.
-!-- This index is e.g. used to calculate mean first-grid point atmosphere temperature, surface
-!-- pressure and density, etc. .
-    topo_min_level   = 0
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ), topo_min_level, 1, MPI_INTEGER, &
-                        MPI_MIN, comm2d, ierr )
-#else
-    topo_min_level = MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) )
-#endif
-
-!
-!-- Check topography for consistency with model domain. Therefore, use maximum and minium
-!-- topography-top indices. Note, minimum topography top index is already calculated.
-    IF ( TRIM( topography ) /= 'flat' )  THEN
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ), nzb_local_max, 1,            &
-                           MPI_INTEGER, MPI_MAX, comm2d, ierr )
-#else
-       nzb_local_max = MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) )
-#endif
-       nzb_local_min = topo_min_level
-!
-!--    Consistency checks
-       IF ( nzb_local_min < 0  .OR.  nzb_local_max  > nz + 1 )  THEN
-          WRITE( message_string, * ) 'nzb_local values are outside the model domain',              &
-                                     '&MINVAL( nzb_local ) = ', nzb_local_min,                     &
-                                     '&MAXVAL( nzb_local ) = ', nzb_local_max
-          CALL message( 'init_grid', 'PA0210', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-!
-!-- Define vertical gridpoint from (or to) which on the usual finite difference form (which does not
-!-- use surface fluxes) is applied.
-    IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
+    ddx2 = 1.0 / dx2
+    ddy2 = 1.0 / dy2
+
+!
+!-- Compute the grid-dependent mixing length.
+    DO  k = 1, nzt
+       l_grid(k)  = ( dx * dy * dzw(k) )**0.33333333333333
+    ENDDO
+
+!
+!-- Allocate outer and inner index arrays for topography and set
+!-- defaults
+    ALLOCATE( corner_nl(nys:nyn,nxl:nxr), corner_nr(nys:nyn,nxl:nxr), &
+              corner_sl(nys:nyn,nxl:nxr), corner_sr(nys:nyn,nxl:nxr), &
+              nzb_local(-1:ny+1,-1:nx+1), nzb_tmp(-1:ny+1,-1:nx+1),   &
+              wall_l(nys:nyn,nxl:nxr), wall_n(nys:nyn,nxl:nxr),       &
+              wall_r(nys:nyn,nxl:nxr), wall_s(nys:nyn,nxl:nxr) )
+    ALLOCATE( fwxm(nys-1:nyn+1,nxl-1:nxr+1), fwxp(nys-1:nyn+1,nxl-1:nxr+1), &
+              fwym(nys-1:nyn+1,nxl-1:nxr+1), fwyp(nys-1:nyn+1,nxl-1:nxr+1), &
+              fxm(nys-1:nyn+1,nxl-1:nxr+1), fxp(nys-1:nyn+1,nxl-1:nxr+1),   &
+              fym(nys-1:nyn+1,nxl-1:nxr+1), fyp(nys-1:nyn+1,nxl-1:nxr+1),   &
+              nzb_s_inner(nys-1:nyn+1,nxl-1:nxr+1),                         &
+              nzb_s_outer(nys-1:nyn+1,nxl-1:nxr+1),                         &
+              nzb_u_inner(nys-1:nyn+1,nxl-1:nxr+1),                         &
+              nzb_u_outer(nys-1:nyn+1,nxl-1:nxr+1),                         &
+              nzb_v_inner(nys-1:nyn+1,nxl-1:nxr+1),                         &
+              nzb_v_outer(nys-1:nyn+1,nxl-1:nxr+1),                         &
+              nzb_w_inner(nys-1:nyn+1,nxl-1:nxr+1),                         &
+              nzb_w_outer(nys-1:nyn+1,nxl-1:nxr+1),                         &
+              nzb_diff_s_inner(nys-1:nyn+1,nxl-1:nxr+1),                    &
+              nzb_diff_s_outer(nys-1:nyn+1,nxl-1:nxr+1),                    &
+              nzb_diff_u(nys-1:nyn+1,nxl-1:nxr+1),                          &
+              nzb_diff_v(nys-1:nyn+1,nxl-1:nxr+1),                          &
+              nzb_2d(nys-1:nyn+1,nxl-1:nxr+1),                              &
+              wall_e_x(nys-1:nyn+1,nxl-1:nxr+1),                            &
+              wall_e_y(nys-1:nyn+1,nxl-1:nxr+1),                            &
+              wall_u(nys-1:nyn+1,nxl-1:nxr+1),                              &
+              wall_v(nys-1:nyn+1,nxl-1:nxr+1),                              &
+              wall_w_x(nys-1:nyn+1,nxl-1:nxr+1),                            &
+              wall_w_y(nys-1:nyn+1,nxl-1:nxr+1) )
+
+    ALLOCATE( l_wall(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+    nzb_s_inner = nzb;  nzb_s_outer = nzb
+    nzb_u_inner = nzb;  nzb_u_outer = nzb
+    nzb_v_inner = nzb;  nzb_v_outer = nzb
+    nzb_w_inner = nzb;  nzb_w_outer = nzb
+
+!
+!-- Define vertical gridpoint from which on the usual finite difference
+!-- form (which does not use surface fluxes) is applied 
+    IF ( prandtl_layer  .OR.  use_surface_fluxes )  THEN
        nzb_diff = nzb + 2
     ELSE
@@ -690,1783 +258,597 @@
     ENDIF
 
+    nzb_diff_s_inner = nzb_diff;  nzb_diff_s_outer = nzb_diff
+    nzb_diff_u = nzb_diff;  nzb_diff_v = nzb_diff
+
+    wall_e_x = 0.0;  wall_e_y = 0.0;  wall_u = 0.0;  wall_v = 0.0
+    wall_w_x = 0.0;  wall_w_y = 0.0
+    fwxp = 1.0;  fwxm = 1.0;  fwyp = 1.0;  fwym = 1.0
+    fxp  = 1.0;  fxm  = 1.0;  fyp  = 1.0;  fym  = 1.0
+
+!
+!-- Initialize near-wall mixing length l_wall only in the vertical direction
+!-- for the moment,
+!-- multiplication with wall_adjustment_factor near the end of this routine
+    l_wall(nzb,:,:)   = l_grid(1)
+    DO  k = nzb+1, nzt
+       l_wall(k,:,:)  = l_grid(k)
+    ENDDO
+    l_wall(nzt+1,:,:) = l_grid(nzt)
+
+    ALLOCATE ( vertical_influence(nzb:nzt) )
+    DO  k = 1, nzt
+       vertical_influence(k) = MIN ( INT( l_grid(k) / &
+                     ( wall_adjustment_factor * dzw(k) ) + 0.5 ), nzt - k )
+    ENDDO
+
+    DO  k = 1, MAXVAL( nzb_s_inner )
+       IF ( l_grid(k) > 1.5 * dx * wall_adjustment_factor .OR.  &
+            l_grid(k) > 1.5 * dy * wall_adjustment_factor )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ WARNING: grid anisotropy exceeds '// &
+                           'threshold given by only local'
+             PRINT*, '             horizontal reduction of near_wall '// &
+                           'mixing length l_wall'
+             PRINT*, '             starting from height level k = ', k, '.'
+          ENDIF
+          EXIT
+       ENDIF
+    ENDDO
+    vertical_influence(0) = vertical_influence(1)
+
+    DO  i = nxl-1, nxr+1
+       DO  j = nys-1, nyn+1
+          DO  k = nzb_s_inner(j,i) + 1, &
+                  nzb_s_inner(j,i) + vertical_influence(nzb_s_inner(j,i))
+             l_wall(k,j,i) = zu(k) - zw(nzb_s_inner(j,i))
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Set outer and inner index arrays for non-flat topography.
+!-- Here consistency checks concerning domain size and periodicity are
+!-- necessary.
+!-- Within this SELECT CASE structure only nzb_local is initialized
+!-- individually depending on the chosen topography type, all other index 
+!-- arrays are initialized further below.
+    SELECT CASE ( TRIM( topography ) )
+
+       CASE ( 'flat' )
+!
+!--       No actions necessary
+
+       CASE ( 'single_building' )
+!
+!--       Single rectangular building, by default centered in the middle of the
+!--       total domain
+          blx = NINT( building_length_x / dx )
+          bly = NINT( building_length_y / dy )
+          bh  = NINT( building_height / dz )
+
+          IF ( building_wall_left == 9999999.9 )  THEN
+             building_wall_left = ( nx + 1 - blx ) / 2 * dx
+          ENDIF
+          bxl = NINT( building_wall_left / dx )
+          bxr = bxl + blx
+
+          IF ( building_wall_south == 9999999.9 )  THEN
+             building_wall_south = ( ny + 1 - bly ) / 2 * dy
+          ENDIF
+          bys = NINT( building_wall_south / dy )
+          byn = bys + bly
+
+!
+!--       Building size has to meet some requirements
+          IF ( ( bxl < 1 ) .OR. ( bxr > nx-1 ) .OR. ( bxr < bxl+3 ) .OR.  &
+               ( bys < 1 ) .OR. ( byn > ny-1 ) .OR. ( byn < bys+3 ) )  THEN
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ init_grid: inconsistent building parameters:'
+                PRINT*, '               bxl=', bxl, 'bxr=', bxr, 'bys=', bys, &
+                                      'byn=', byn, 'nx=', nx, 'ny=', ny
+             ENDIF
+             CALL local_stop
+          ENDIF
+
+!
+!--       Set the individual index arrays for all velocity components and
+!--       scalars, taking into account the staggered grid. The horizontal
+!--       wind component normal to a wall defines the position of the wall, and
+!--       in the respective direction the building is as long as specified in
+!--       building_length_?, but in the other horizontal direction (for w and s
+!--       in both horizontal directions) the building appears shortened by one
+!--       grid length due to the staggered grid.
+          nzb_local = 0
+          nzb_local(bys:byn-1,bxl:bxr-1) = bh
+
+       CASE ( 'read_from_file' )
+!
+!--       Arbitrary irregular topography data in PALM format (exactly matching
+!--       the grid size and total domain size)
+          OPEN( 90, FILE='TOPOGRAPHY_DATA', STATUS='OLD', FORM='FORMATTED',  &
+               ERR=10 )
+          DO  j = ny, 0, -1
+             READ( 90, *, ERR=11, END=11 )  ( topo_height(j,i), i = 0, nx )
+          ENDDO
+!
+!--       Calculate the index height of the topography
+          DO  i = 0, nx
+             DO  j = 0, ny
+                nzb_local(j,i) = NINT( topo_height(j,i) / dz )
+             ENDDO
+          ENDDO
+          nzb_local(-1,0:nx)   = nzb_local(ny,0:nx)
+          nzb_local(ny+1,0:nx) = nzb_local(0,0:nx)
+          nzb_local(:,-1)      = nzb_local(:,nx)
+          nzb_local(:,nx+1)    = nzb_local(:,0)
+      
+          GOTO 12
+
+ 10       IF ( myid == 0 )  THEN
+             PRINT*, '+++ init_grid: file TOPOGRAPHY_DATA does not exist'
+          ENDIF
+          CALL local_stop
+
+ 11       IF ( myid == 0 )  THEN
+             PRINT*, '+++ init_grid: errors in file TOPOGRAPHY_DATA'
+          ENDIF
+          CALL local_stop
+
+ 12       CLOSE( 90 )
+
+       CASE DEFAULT
+!
+!--       The DEFAULT case is reached either if the parameter topography
+!--       contains a wrong character string or if the user has coded a special
+!--       case in the user interface. There, the subroutine user_init_grid 
+!--       checks which of these two conditions applies.
+          CALL user_init_grid( nzb_local )
+
+    END SELECT
+
+!
+!-- Consistency checks and index array initialization are only required for
+!-- non-flat topography
     IF ( TRIM( topography ) /= 'flat' )  THEN
-!
-!--    Allocate and set the arrays containing the topography height (for output reasons only).
-       IF ( nxr == nx  .AND.  nyn /= ny )  THEN
-          ALLOCATE( zu_s_inner(nxl:nxr+1,nys:nyn), zw_w_inner(nxl:nxr+1,nys:nyn) )
-       ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
-          ALLOCATE( zu_s_inner(nxl:nxr,nys:nyn+1), zw_w_inner(nxl:nxr,nys:nyn+1) )
-       ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
-          ALLOCATE( zu_s_inner(nxl:nxr+1,nys:nyn+1), zw_w_inner(nxl:nxr+1,nys:nyn+1) )
-       ELSE
-          ALLOCATE( zu_s_inner(nxl:nxr,nys:nyn), zw_w_inner(nxl:nxr,nys:nyn) )
+
+!
+!--    Consistency checks
+       IF ( MINVAL( nzb_local ) < 0  .OR.  MAXVAL( nzb_local ) > nz + 1 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ init_grid: nzb_local values are outside the', &
+                          'model domain'
+             PRINT*, '               MINVAL( nzb_local ) = ', MINVAL(nzb_local)
+             PRINT*, '               MAXVAL( nzb_local ) = ', MAXVAL(nzb_local)
+          ENDIF
+          CALL local_stop
        ENDIF
 
-       zu_s_inner   = 0.0_wp
-       zw_w_inner   = 0.0_wp
-!
-!--    Determine local topography height on scalar and w-grid. Note, setting lateral boundary values
-!--    is not necessary, realized via wall_flags_static_0 array. Further, please note that loop
-!--    bounds are different from nxl to nxr and nys to nyn on south and right model boundary, hence,
-!--    use intrinsic lbound and ubound functions to infer array bounds.
-       DO  i = LBOUND(zu_s_inner, 1), UBOUND(zu_s_inner, 1)
-          DO  j = LBOUND(zu_s_inner, 2), UBOUND(zu_s_inner, 2)
-!
-!--          Topography height on scalar grid. Therefore, determine index of upward-facing surface
-!--          element on scalar grid.
-             zu_s_inner(i,j) = zu(topo_top_ind(j,i,0))
-!
-!--          Topography height on w grid. Therefore, determine index of upward-facing surface
-!--          element on w grid.
-             zw_w_inner(i,j) = zw(topo_top_ind(j,i,3))
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE init_grid
-
-
-! Description:
-! -------------------------------------------------------------------------------------------------!
-!> Calculation of the stretching factor through an iterative method. Ideas were taken from the paper
-!> "Regional stretched grid generation and its application to the NCAR RegCM (1999)". Normally, no
-!> analytic solution exists because the system of equations has two variables (r,l) but four
-!> requirements  (l=integer, r=[0,88;1,2], Eq(6), Eq(5) starting from index j=1) which results into
-!> an overdetermined system.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calculate_stretching_factor( number_end )
-
-    USE control_parameters,                                                                        &
-        ONLY:  dz, dz_stretch_factor_array, dz_stretch_level_end, dz_stretch_level_start,          &
-               message_string
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    REAL(wp), PARAMETER ::  stretch_factor_interval = 1.0E-06_wp  !< interval for sampling possible stretching factors
-    REAL(wp), PARAMETER ::  stretch_factor_lower_limit = 0.88_wp  !< lowest possible stretching factor
-    REAL(wp), PARAMETER ::  stretch_factor_upper_limit = 1.12_wp  !< highest possible stretching factor
-
-    INTEGER(iwp) ::  iterations  !< number of iterations until stretch_factor_lower/upper_limit is reached
-    INTEGER(iwp) ::  l_rounded   !< after l_rounded grid levels dz(n) is strechted to dz(n+1) with stretch_factor_2
-    INTEGER(iwp) ::  n           !< loop variable for stretching
-
-    INTEGER(iwp), INTENT(IN) ::  number_end !< number of user-specified end levels for stretching
-
-    REAL(wp) ::  delta_l               !< absolute difference between l and l_rounded
-    REAL(wp) ::  delta_stretch_factor  !< absolute difference between stretch_factor_1 and stretch_factor_2
-    REAL(wp) ::  delta_total_new       !< sum of delta_l and delta_stretch_factor for the next iteration (should be as small as
-                                       !< possible)
-    REAL(wp) ::  delta_total_old       !< sum of delta_l and delta_stretch_factor for the last iteration
-    REAL(wp) ::  distance              !< distance between dz_stretch_level_start and dz_stretch_level_end (stretching region)
-    REAL(wp) ::  l                     !< value that fulfil Eq. (5) in the paper mentioned above together with stretch_factor_1
-                                       !< exactly
-    REAL(wp) ::  numerator             !< numerator of the quotient
-    REAL(wp) ::  stretch_factor_1      !< stretching factor that fulfil Eq. (5) togehter with l exactly
-    REAL(wp) ::  stretch_factor_2      !< stretching factor that fulfil Eq. (6) togehter with l_rounded exactly
-
-    REAL(wp) ::  dz_stretch_factor_array_2(9) = 1.08_wp  !< Array that contains all stretch_factor_2 that belongs to
-                                                         !< stretch_factor_1
-
-
-    l = 0
-    DO  n = 1, number_end
-
-       iterations = 1
-       stretch_factor_1 = 1.0_wp
-       stretch_factor_2 = 1.0_wp
-       delta_total_old = 1.0_wp
-
-!
-!--    First branch for stretching from rough to fine
-       IF ( dz(n) > dz(n+1) )  THEN
-          DO WHILE ( stretch_factor_1 >= stretch_factor_lower_limit )
-
-             stretch_factor_1 = 1.0_wp - iterations * stretch_factor_interval
-             distance = ABS( dz_stretch_level_end(n) - dz_stretch_level_start(n) )
-             numerator = distance * stretch_factor_1 / dz(n) + stretch_factor_1 - distance / dz(n)
-
-             IF ( numerator > 0.0_wp )  THEN
-                l = LOG( numerator ) / LOG( stretch_factor_1 ) - 1.0_wp
-                l_rounded = NINT( l )
-                delta_l = ABS( l_rounded - l ) / l
-             ENDIF
-
-             stretch_factor_2 = EXP( LOG( dz(n+1)/dz(n) ) / (l_rounded) )
-
-             delta_stretch_factor = ABS( stretch_factor_1 - stretch_factor_2 ) / stretch_factor_2
-
-             delta_total_new = delta_l + delta_stretch_factor
-
-!
-!--          stretch_factor_1 is taken to guarantee that the stretching procedure ends as close as
-!--          possible to dz_stretch_level_end.
-!--          stretch_factor_2 would guarantee that the stretched dz(n) is equal to dz(n+1) after
-!--          l_rounded grid levels.
-             IF (delta_total_new < delta_total_old)  THEN
-                dz_stretch_factor_array(n) = stretch_factor_1
-                dz_stretch_factor_array_2(n) = stretch_factor_2
-                delta_total_old = delta_total_new
-             ENDIF
-
-             iterations = iterations + 1
-
-          ENDDO
-
-!
-!--    Second branch for stretching from fine to rough
-       ELSEIF ( dz(n) < dz(n+1) )  THEN
-
-          DO WHILE ( stretch_factor_1 <= stretch_factor_upper_limit )
-
-             stretch_factor_1 = 1.0_wp + iterations * stretch_factor_interval
-             distance = ABS( dz_stretch_level_end(n) - dz_stretch_level_start(n) )
-             numerator = distance * stretch_factor_1 / dz(n) + stretch_factor_1 - distance / dz(n)
-
-             l = LOG( numerator ) / LOG( stretch_factor_1 ) - 1.0_wp
-             l_rounded = NINT( l )
-             delta_l = ABS( l_rounded - l ) / l
-
-             stretch_factor_2 = EXP( LOG( dz(n+1)/dz(n) ) / (l_rounded) )
-
-             delta_stretch_factor = ABS( stretch_factor_1 - stretch_factor_2 ) / stretch_factor_2
-
-             delta_total_new = delta_l + delta_stretch_factor
-
-!
-!--          stretch_factor_1 is taken to guarantee that the stretching procedure ends as close as
-!--          possible to dz_stretch_level_end.
-!--          stretch_factor_2 would guarantee that the stretched dz(n) is equal to dz(n+1) after
-!--          l_rounded grid levels.
-             IF (delta_total_new < delta_total_old)  THEN
-                dz_stretch_factor_array(n) = stretch_factor_1
-                dz_stretch_factor_array_2(n) = stretch_factor_2
-                delta_total_old = delta_total_new
-             ENDIF
-
-             iterations = iterations + 1
-          ENDDO
-
-       ELSE
-
-          message_string= 'Two adjacent values of dz must be different'
-          CALL message( 'init_grid', 'PA0228', 1, 2, 0, 6, 0 )
-
+       IF ( bc_lr == 'cyclic' )  THEN
+          IF ( ANY( nzb_local(:,-1) /= nzb_local(:,nx)   )  .OR. &
+               ANY( nzb_local(:,0)  /= nzb_local(:,nx+1) ) )  THEN
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ init_grid: nzb_local does not fulfill cyclic', &
+                        '               boundary condition in x-direction'
+             ENDIF
+             CALL local_stop
+          ENDIF
        ENDIF
-
-!
-!--    Check if also the second stretching factor fits into the allowed interval. If not, print a
-!--    warning for the user.
-       IF ( dz_stretch_factor_array_2(n) < stretch_factor_lower_limit  .OR.                        &
-            dz_stretch_factor_array_2(n) > stretch_factor_upper_limit )  THEN
-          WRITE( message_string, * ) 'stretch_factor_2 = ', dz_stretch_factor_array_2(n),          &
-                                     ' which is', ' responsible for exactly reaching& dz =',       &
-                                      dz(n+1), 'after a specific amount of',                       &
-                                     ' grid levels& exceeds the upper',                            &
-                                     ' limit =', stretch_factor_upper_limit,                       &
-                                     ' &or lower limit = ', stretch_factor_lower_limit
-          CALL message( 'init_grid', 'PA0499', 0, 1, 0, 6, 0 )
-
+       IF ( bc_ns == 'cyclic' )  THEN
+          IF ( ANY( nzb_local(-1,:) /= nzb_local(ny,:)   )  .OR. &
+               ANY( nzb_local(0,:)  /= nzb_local(ny+1,:) ) )  THEN
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ init_grid: nzb_local does not fulfill cyclic', &
+                        '               boundary condition in y-direction'
+             ENDIF
+             CALL local_stop
+          ENDIF
        ENDIF
 
-    ENDDO
-
- END SUBROUTINE calculate_stretching_factor
-
-
-! Description:
-! -------------------------------------------------------------------------------------------------!
-!> Set temporary topography flags and reference buildings on top of underlying orography.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE process_topography( topo_3d )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zu, zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc, bc_ns_cyc, ocean_mode
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_2d, exchange_horiz_int
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nzt
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  buildings_f, building_id_f, building_type_f,                                        &
-               init_model,                                                                         &
-               input_pids_static,                                                                  &
-               terrain_height_f
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  dim_builds       !< total number of buildings within the model domain
-    INTEGER(iwp) ::  i                !< running index along x-direction
-    INTEGER(iwp) ::  j                !< running index along y-direction
-    INTEGER(iwp) ::  k                !< running index along z-direction with respect to numeric grid
-    INTEGER(iwp) ::  k2               !< running index along z-direction with respect to netcdf grid
-    INTEGER(iwp) ::  nr               !< index variable indication maximum terrain height for respective building ID
-    INTEGER(iwp) ::  num_build        !< counter for number of buildings
-    INTEGER(iwp) ::  topo_top_index   !< orography top index, used to map 3D buildings onto terrain
-
-#if defined( __parallel )
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  displace_dum        !< displacements of start addresses, used for MPI_ALLGATHERV
-#endif
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids           !< building IDs on entire model domain
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_final     !< building IDs on entire model domain, multiple occurences are
-                                                                    !< sorted out
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_final_tmp !< temporary array used for resizing
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_l         !< building IDs on local subdomain
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_l_tmp     !< temporary array used to resize array of building IDs
-
-    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  num_buildings     !< number of buildings with different ID on entire model domain
-    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  num_buildings_l   !< number of buildings with different ID on local subdomain
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo_3d !< input array for 3D topography and dummy array for setting
-                                                                       !< "outer"-flags
-
-    REAL(wp)                            ::  ocean_offset        !< offset to consider inverse vertical coordinate at topography
-                                                                !< definition
-    REAL(wp)                            ::  oro_min = 0.0_wp    !< minimum terrain height in entire model domain, used to reference
-                                                                !< terrain to zero
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  oro_max             !< maximum terrain height occupied by an building with certain id
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  oro_max_l           !< maximum terrain height occupied by an building with certain id,
-                                                                !< on local subdomain
-
-!
-!-- Reference lowest terrain height to zero. This ensures that first, non-required gird levels
-!-- (those which lie entirely below the minimum orography) are avoided, and second, that also
-!-- negative orography can be used within the input file.
-!-- Please note, in case of a nested run, the global minimum from all parent and childs needs to be
-!-- removed to avoid steep edges at the child-domain boundaries.
-    IF ( input_pids_static )  THEN
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( MINVAL( terrain_height_f%var ), oro_min, 1, MPI_REAL, MPI_MIN,          &
-                           MPI_COMM_WORLD, ierr )
-#else
-       oro_min = MINVAL( terrain_height_f%var )
-#endif
-       terrain_height_f%var = terrain_height_f%var - oro_min
-!
-!--    Update reference height used within output files
-       init_model%origin_z = init_model%origin_z + oro_min
-!
-!-- ASCII topography branch. In this case, in contrast to the static driver input, topography is
-!-- assumed to be building; thus the minimum building height is substracted from the building array.
-    ELSE
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( MINVAL( buildings_f%var_2d ), oro_min, 1, MPI_REAL, MPI_MIN,            &
-                           MPI_COMM_WORLD, ierr )
-#else
-       oro_min = MINVAL( buildings_f%var_2d )
-#endif
-       buildings_f%var_2d = buildings_f%var_2d - oro_min
-!
-!--    Update reference height used within output files
-       init_model%origin_z = init_model%origin_z + oro_min
-    ENDIF
-
-!
-!-- In the following, buildings and orography are further preprocessed before they are mapped on the
-!-- LES grid.
-!-- Buildings are mapped on top of the orography by maintaining the roof shape of the building. This
-!-- can be achieved by referencing building on top of the maximum terrain height within the area
-!-- occupied by the respective building. As buildings and terrain height are defined PE-wise,
-!-- parallelization of this referencing is required (a building can be distributed between different
-!-- PEs).
-!-- In a first step, determine the number of buildings with different building id on each PE. In a
-!-- next step, all building ids are gathered into one array which is present to all PEs. For each
-!-- building ID, the maximum terrain height occupied by the respective building is computed and
-!-- distributed to each PE.
-!-- Finally, for each building id and its respective reference orography, builidings are mapped on
-!-- top.
-!--
-!-- First, pre-set topography flags, bit 1 indicates orography, bit 2 buildings classify the
-!-- respective surfaces.
-    topo_3d          = IBSET( topo_3d, 0 )
-    topo_3d(nzb,:,:) = IBCLR( topo_3d(nzb,:,:), 0 )
-!
-!-- In order to map topography on PALM grid also in case of ocean simulations, pre-calculate an
-!-- offset value.
-    ocean_offset = MERGE( zw(0), 0.0_wp, ocean_mode )
-!
-!-- Reference buildings on top of orography. This is not necessary if topography is read from ASCII
-!-- file as no distinction between buildings and terrain height can be made. Moreover, this is also
-!-- not necessary if urban-surface and land-surface model are used at the same time.
-    IF ( input_pids_static )  THEN
-
-       IF ( buildings_f%from_file )  THEN
-          num_buildings_l = 0
-          num_buildings   = 0
-!
-!--       Allocate at least one element for building ids and give it an inital negative value that
-!--       will be overwritten later. This, however, is necessary in case there all IDs in the model
-!--       domain are fill values.
-          ALLOCATE( build_ids_l(1) )
-          build_ids_l = -1
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
-                   IF ( num_buildings_l(myid) > 0 )  THEN
-                      IF ( ANY( building_id_f%var(j,i) ==  build_ids_l ) )  THEN
-                         CYCLE
-                      ELSE
-                         num_buildings_l(myid) = num_buildings_l(myid) + 1
-!
-!--                   Resize array with different local building ids
-                      ALLOCATE( build_ids_l_tmp(1:SIZE(build_ids_l)) )
-                      build_ids_l_tmp = build_ids_l
-                      DEALLOCATE( build_ids_l )
-                      ALLOCATE( build_ids_l(1:num_buildings_l(myid)) )
-                      build_ids_l(1:num_buildings_l(myid)-1) =                                     &
-                                                          build_ids_l_tmp(1:num_buildings_l(myid)-1)
-                      build_ids_l(num_buildings_l(myid)) = building_id_f%var(j,i)
-                      DEALLOCATE( build_ids_l_tmp )
-                   ENDIF
-!
-!--                First occuring building id on PE
-                   ELSE
-                      num_buildings_l(myid) = num_buildings_l(myid) + 1
-                      build_ids_l(1) = building_id_f%var(j,i)
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-!
-!--       Determine number of different building ids for the entire domain
-#if defined( __parallel )
-          CALL MPI_ALLREDUCE( num_buildings_l, num_buildings, numprocs, MPI_INTEGER, MPI_SUM,      &
-                              comm2d, ierr )
-#else
-          num_buildings = num_buildings_l
-#endif
-!
-!--       Gather all buildings ids on each PEs.
-!--       First, allocate array encompassing all building ids in model domain.
-          ALLOCATE( build_ids(1:SUM(num_buildings)) )
-#if defined( __parallel )
-!
-!--       Allocate array for displacements.
-!--       As each PE may has a different number of buildings, so that the block sizes send by each
-!--       PE may not be equal. Hence,  information about the respective displacement is required,
-!--       indicating the respective adress where each MPI-task writes into the receive buffer array.
-          ALLOCATE( displace_dum(0:numprocs-1) )
-          displace_dum(0) = 0
-          DO i = 1, numprocs-1
-             displace_dum(i) = displace_dum(i-1) + num_buildings(i-1)
-          ENDDO
-
-          CALL MPI_ALLGATHERV( build_ids_l(1:num_buildings_l(myid)), num_buildings(myid),          &
-                               MPI_INTEGER, build_ids, num_buildings, displace_dum, MPI_INTEGER,   &
-                               comm2d, ierr )
-
-          DEALLOCATE( displace_dum )
-
-#else
-          build_ids = build_ids_l
-#endif
-
-!
-!--       Note, in parallel mode building ids can occure mutliple times, as each PE has send its own
-!--       ids. Therefore, sort out building ids which appear more than one time.
-          num_build = 0
-          DO  nr = 1, SIZE(build_ids)
-
-             IF ( ALLOCATED(build_ids_final) )  THEN
-                IF ( ANY( build_ids(nr) == build_ids_final ) )  THEN
-                   CYCLE
-                ELSE
-                   num_build = num_build + 1
-!
-!--                Resize
-                   ALLOCATE( build_ids_final_tmp(1:num_build) )
-                   build_ids_final_tmp(1:num_build-1) = build_ids_final(1:num_build-1)
-                   DEALLOCATE( build_ids_final )
-                   ALLOCATE( build_ids_final(1:num_build) )
-                   build_ids_final(1:num_build-1) = build_ids_final_tmp(1:num_build-1)
-                   build_ids_final(num_build) = build_ids(nr)
-                   DEALLOCATE( build_ids_final_tmp )
-                ENDIF
-             ELSE
-                num_build = num_build + 1
-                ALLOCATE( build_ids_final(1:num_build) )
-                build_ids_final(num_build) = build_ids(nr)
-             ENDIF
-          ENDDO
-
-!
-!--       Determine maximumum terrain height occupied by the respective building and temporalily
-!--       store on oro_max. Before, check whether any buildings are defined within the domain.
-          IF ( ALLOCATED( build_ids_final ) )  THEN
-             dim_builds = SIZE(build_ids_final)
-          ELSE
-             dim_builds = 0
-          ENDIF
-
-          ALLOCATE( oro_max_l(1:dim_builds) )
-          ALLOCATE( oro_max(1:dim_builds)   )
-          oro_max_l = 0.0_wp
-
-          DO  nr = 1, dim_builds
-             oro_max_l(nr) = MAXVAL( MERGE( terrain_height_f%var(nys:nyn,nxl:nxr),                 &
-                                              0.0_wp,                                              &
-                                              building_id_f%var(nys:nyn,nxl:nxr) ==                &
-                                              build_ids_final(nr) ) )
-          ENDDO
-
-#if defined( __parallel )
-          IF ( dim_builds >= 1 )  THEN
-             CALL MPI_ALLREDUCE( oro_max_l, oro_max, SIZE( oro_max ), MPI_REAL, MPI_MAX, comm2d,   &
-                                 ierr )
-          ENDIF
-#else
-          oro_max = oro_max_l
-#endif
-!
-!--       Finally, determine discrete grid height of maximum orography occupied by a building. Use
-!--       all-or-nothing approach, i.e. if terrain exceeds the scalar level the grid box is fully
-!--       terrain and the maximum terrain is set to the zw level.
-!--       terrain or
-          oro_max_l = 0.0
-          DO  nr = 1, dim_builds
-             DO  k = nzb, nzt
-                IF ( zu(k) - ocean_offset <= oro_max(nr) )  oro_max_l(nr) = zw(k) - ocean_offset
-             ENDDO
-             oro_max(nr) = oro_max_l(nr)
-          ENDDO
-       ENDIF
-!
-!--    Allocate array for storing terrain height under buildings
-       IF ( buildings_f%from_file )  THEN
-          ALLOCATE( buildings_f%oro_max(nysg:nyng,nxlg:nxrg) )
-          buildings_f%oro_max = buildings_f%fill1
-       END IF
-!
-!--    Map orography as well as buildings onto grid.
+!
+!--    Initialize index arrays nzb_s_inner and nzb_w_inner
+       nzb_s_inner = nzb_local(nys-1:nyn+1,nxl-1:nxr+1)
+       nzb_w_inner = nzb_local(nys-1:nyn+1,nxl-1:nxr+1)
+
+!
+!--    Initialize remaining index arrays:
+!--    first pre-initialize them with nzb_s_inner...
+       nzb_u_inner = nzb_s_inner
+       nzb_u_outer = nzb_s_inner
+       nzb_v_inner = nzb_s_inner
+       nzb_v_outer = nzb_s_inner
+       nzb_w_outer = nzb_s_inner
+       nzb_s_outer = nzb_s_inner
+
+!
+!--    ...then extend pre-initialized arrays in their according directions
+!--    based on nzb_local using nzb_tmp as a temporary global index array
+
+!
+!--    nzb_s_outer: 
+!--    extend nzb_local east-/westwards first, then north-/southwards
+       nzb_tmp = nzb_local
+       DO  j = -1, ny + 1
+          DO  i = 0, nx
+             nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i), &
+                                 nzb_local(j,i+1) )
+          ENDDO
+       ENDDO
        DO  i = nxl, nxr
           DO  j = nys, nyn
-             topo_top_index = 0
-!
-!--          Obtain index in global building_id array
-             IF ( buildings_f%from_file )  THEN
-                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
-!
-!--                Determine index where maximum terrain height occupied by the respective building
-!--                height is stored.
-                   nr = MINLOC( ABS( build_ids_final - building_id_f%var(j,i) ), DIM=1 )
-!
-!--                Save grid-indexed oro_max
-                   buildings_f%oro_max(j,i) = oro_max(nr)
-                ENDIF
-             ENDIF
-             DO  k = nzb, nzt
-!
-!--             In a first step, if grid point is below or equal the given terrain height, grid
-!--             point is flagged to be of type natural.
-!--             Please note, in case there is also a building which is lower than the vertical grid
-!--             spacing, initialization of surface attributes will not be correct as given surface
-!--             information will not be in accordance to the classified grid points.
-!--             Hence, in this case, also a building flag.
-                IF ( zu(k) - ocean_offset <= terrain_height_f%var(j,i) )  THEN
-                   topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
-                   topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 1 )
-                   topo_top_index = k ! topo_top_index + 1
-                ENDIF
-!
-!--             Set building grid points. Here, only consider 2D buildings.
-!--             3D buildings require separate treatment.
-                IF ( buildings_f%from_file  .AND.  buildings_f%lod == 1 )  THEN
-!
-!--                Fill-up the terrain to the level of maximum orography within the building-covered
-!--                area.
-                   IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
-!
-!--                   Note, oro_max is always on zw level
-                      IF ( zu(k) - ocean_offset < oro_max(nr) )  THEN
-                         topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
-                         topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 1 )
-                      ELSEIF ( zu(k) - ocean_offset <= oro_max(nr) + buildings_f%var_2d(j,i) )  THEN
-                         topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
-                         topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
-                      ENDIF
-                   ENDIF
-                ENDIF
-             ENDDO
-!
-!--          Special treatment for non grid-resolved buildings. This case, the uppermost terrain
-!--          grid point is flagged as building as well, even though no building exists at all.
-!--          However, the surface element will be identified as urban-surface and the input data
-!--          provided by the drivers is consistent to the surface classification. Else, all non
-!--          grid-resolved buildings would vanish and identified as terrain grid points, which,
-!--          however, won't be consistent with the input data.
-             IF ( buildings_f%from_file  .AND.  buildings_f%lod == 1 )  THEN
-                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
-                   DO  k = nzb, nzt
-                      IF( zw(k) - ocean_offset == oro_max(nr) )  THEN
-                         IF ( buildings_f%var_2d(j,i) <= zu(k+1) - zw(k) )  THEN
-                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
-                         ENDIF
-                      ENDIF
+             nzb_s_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i), &
+                                     nzb_tmp(j+1,i) )
+          ENDDO
+!
+!--       non-cyclic boundary conditions (overwritten by call of
+!--       exchange_horiz_2d_int below in case of cyclic boundary conditions)
+          IF ( nys == 0 )  THEN
+             j = -1
+             nzb_s_outer(j,i) = MAX( nzb_tmp(j+1,i), nzb_tmp(j,i) )
+          ENDIF
+          IF ( nys == ny )  THEN
+             j = ny + 1
+             nzb_s_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i) )
+          ENDIF
+       ENDDO
+!
+!--    nzb_w_outer: 
+!--    identical to nzb_s_outer
+       nzb_w_outer = nzb_s_outer
+
+!
+!--    nzb_u_inner: 
+!--    extend nzb_local rightwards only
+       nzb_tmp = nzb_local
+       DO  j = -1, ny + 1
+          DO  i = 0, nx + 1
+             nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i) )
+          ENDDO
+       ENDDO
+       nzb_u_inner = nzb_tmp(nys-1:nyn+1,nxl-1:nxr+1)
+
+!
+!--    nzb_u_outer: 
+!--    extend current nzb_tmp (nzb_u_inner) north-/southwards
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             nzb_u_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i), &
+                                     nzb_tmp(j+1,i) )
+          ENDDO
+!
+!--       non-cyclic boundary conditions (overwritten by call of
+!--       exchange_horiz_2d_int below in case of cyclic boundary conditions)
+          IF ( nys == 0 )  THEN
+             j = -1
+             nzb_u_outer(j,i) = MAX( nzb_tmp(j+1,i), nzb_tmp(j,i) )
+          ENDIF
+          IF ( nys == ny )  THEN
+             j = ny + 1
+             nzb_u_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i) )
+          ENDIF
+       ENDDO
+
+!
+!--    nzb_v_inner:
+!--    extend nzb_local northwards only
+       nzb_tmp = nzb_local
+       DO  i = -1, nx + 1
+          DO  j = 0, ny + 1
+             nzb_tmp(j,i) = MAX( nzb_local(j-1,i), nzb_local(j,i) )
+          ENDDO
+       ENDDO
+       nzb_v_inner = nzb_tmp(nys-1:nyn+1,nxl-1:nxr+1)
+
+!
+!--    nzb_v_outer: 
+!--    extend current nzb_tmp (nzb_v_inner) right-/leftwards
+       DO  j = nys, nyn
+          DO  i = nxl, nxr
+             nzb_v_outer(j,i) = MAX( nzb_tmp(j,i-1), nzb_tmp(j,i), &
+                                     nzb_tmp(j,i+1) )
+          ENDDO
+!
+!--       non-cyclic boundary conditions (overwritten by call of
+!--       exchange_horiz_2d_int below in case of cyclic boundary conditions)
+          IF ( nxl == 0 )  THEN
+             i = -1
+             nzb_v_outer(j,i) = MAX( nzb_tmp(j,i+1), nzb_tmp(j,i) )
+          ENDIF
+          IF ( nxr == nx )  THEN
+             i = nx + 1
+             nzb_v_outer(j,i) = MAX( nzb_tmp(j,i-1), nzb_tmp(j,i) )
+          ENDIF
+       ENDDO
+
+!
+!--    Exchange of lateral boundary values (parallel computers) and cyclic
+!--    boundary conditions, if applicable.
+!--    Since nzb_s_inner and nzb_w_inner are derived directly from nzb_local
+!--    they do not require exchange and are not included here.
+       CALL exchange_horiz_2d_int( nzb_u_inner )
+       CALL exchange_horiz_2d_int( nzb_u_outer )
+       CALL exchange_horiz_2d_int( nzb_v_inner )
+       CALL exchange_horiz_2d_int( nzb_v_outer )
+       CALL exchange_horiz_2d_int( nzb_w_outer )
+       CALL exchange_horiz_2d_int( nzb_s_outer )
+
+    ENDIF
+
+!
+!-- Preliminary: to be removed after completion of the topography code!
+!-- Set the former default k index arrays nzb_2d
+    nzb_2d      = nzb
+
+!
+!-- Set the individual index arrays which define the k index from which on
+!-- the usual finite difference form (which does not use surface fluxes) is
+!-- applied 
+    IF ( prandtl_layer  .OR.  use_surface_fluxes )  THEN
+       nzb_diff_u         = nzb_u_inner + 2
+       nzb_diff_v         = nzb_v_inner + 2
+       nzb_diff_s_inner   = nzb_s_inner + 2
+       nzb_diff_s_outer   = nzb_s_outer + 2
+    ELSE
+       nzb_diff_u         = nzb_u_inner + 1
+       nzb_diff_v         = nzb_v_inner + 1
+       nzb_diff_s_inner   = nzb_s_inner + 1
+       nzb_diff_s_outer   = nzb_s_outer + 1
+    ENDIF
+
+!
+!-- Calculation of wall switches and factors required by diffusion_u/v.f90 and 
+!-- for limitation of near-wall mixing length l_wall further below
+    corner_nl = 0
+    corner_nr = 0
+    corner_sl = 0
+    corner_sr = 0
+    wall_l    = 0
+    wall_n    = 0
+    wall_r    = 0
+    wall_s    = 0
+
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+!
+!--       u-component
+          IF ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) )  THEN
+             wall_u(j,i) = 1.0   ! north wall (location of adjacent fluid)
+             fym(j,i)    = 0.0
+             fyp(j,i)    = 1.0
+          ELSEIF ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) )  THEN
+             wall_u(j,i) = 1.0   ! south wall (location of adjacent fluid)
+             fym(j,i)    = 1.0
+             fyp(j,i)    = 0.0
+          ENDIF
+!
+!--       v-component
+          IF ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  THEN
+             wall_v(j,i) = 1.0   ! rigth wall (location of adjacent fluid)
+             fxm(j,i)    = 0.0
+             fxp(j,i)    = 1.0
+          ELSEIF ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  THEN
+             wall_v(j,i) = 1.0   ! left wall (location of adjacent fluid)
+             fxm(j,i)    = 1.0
+             fxp(j,i)    = 0.0
+          ENDIF
+!
+!--       w-component, also used for scalars, separate arrays for shear 
+!--       production of tke
+          IF ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  THEN
+             wall_e_y(j,i) =  1.0   ! north wall (location of adjacent fluid)
+             wall_w_y(j,i) =  1.0
+             fwym(j,i)     =  0.0
+             fwyp(j,i)     =  1.0
+          ELSEIF ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) )  THEN
+             wall_e_y(j,i) = -1.0   ! south wall (location of adjacent fluid)
+             wall_w_y(j,i) =  1.0
+             fwym(j,i)     =  1.0
+             fwyp(j,i)     =  0.0
+          ENDIF
+          IF ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  THEN
+             wall_e_x(j,i) =  1.0   ! right wall (location of adjacent fluid)
+             wall_w_x(j,i) =  1.0
+             fwxm(j,i)     =  0.0
+             fwxp(j,i)     =  1.0
+          ELSEIF ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) )  THEN
+             wall_e_x(j,i) = -1.0   ! left wall (location of adjacent fluid)
+             wall_w_x(j,i) =  1.0
+             fwxm(j,i)     =  1.0
+             fwxp(j,i)     =  0.0
+          ENDIF
+!
+!--       Wall and corner locations inside buildings for limitation of
+!--       near-wall mixing length l_wall
+          IF ( nzb_s_inner(j,i) > nzb_s_inner(j+1,i) )  THEN
+
+             wall_n(j,i) = nzb_s_inner(j+1,i) + 1            ! North wall
+
+             IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) )  THEN
+                corner_nl(j,i) = MAX( nzb_s_inner(j+1,i),  & ! Northleft corner
+                                      nzb_s_inner(j,i-1) ) + 1
+             ENDIF
+
+             IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) )  THEN
+                corner_nr(j,i) = MAX( nzb_s_inner(j+1,i),  & ! Northright corner
+                                      nzb_s_inner(j,i+1) ) + 1
+             ENDIF
+
+          ENDIF
+
+          IF ( nzb_s_inner(j,i) > nzb_s_inner(j-1,i) )  THEN
+
+             wall_s(j,i) = nzb_s_inner(j-1,i) + 1            ! South wall
+             IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) )  THEN
+                corner_sl(j,i) = MAX( nzb_s_inner(j-1,i),  & ! Southleft corner
+                                      nzb_s_inner(j,i-1) ) + 1
+             ENDIF
+
+             IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) )  THEN
+                corner_sr(j,i) = MAX( nzb_s_inner(j-1,i),  & ! Southright corner
+                                      nzb_s_inner(j,i+1) ) + 1
+             ENDIF
+
+          ENDIF
+
+          IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) )  THEN
+             wall_l(j,i) = nzb_s_inner(j,i-1) + 1            ! Left wall
+          ENDIF
+
+          IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) )  THEN
+             wall_r(j,i) = nzb_s_inner(j,i+1) + 1            ! Right wall
+          ENDIF
+
+       ENDDO
+    ENDDO
+
+!
+!-- In case of topography: limit near-wall mixing length l_wall further:
+!-- Go through all points of the subdomain one by one and look for the closest
+!-- surface
+    IF ( TRIM(topography) /= 'flat' )  THEN
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+
+             nzb_si = nzb_s_inner(j,i)
+             vi     = vertical_influence(nzb_si)
+
+             IF ( wall_n(j,i) > 0 )  THEN
+!
+!--             North wall (y distance)
+                DO  k = wall_n(j,i), nzb_si
+                   l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i), 0.5 * dy )
+                ENDDO
+!
+!--             Above North wall (yz distance)
+                DO  k = nzb_si + 1, nzb_si + vi
+                   l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i),     &
+                                          SQRT( 0.25 * dy**2 + &
+                                          ( zu(k) - zw(nzb_si) )**2 ) )
+                ENDDO
+!
+!--             Northleft corner (xy distance)
+                IF ( corner_nl(j,i) > 0 )  THEN
+                   DO  k = corner_nl(j,i), nzb_si
+                      l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1), &
+                                               0.5 * SQRT( dx**2 + dy**2 ) )
+                   ENDDO
+!
+!--                Above Northleft corner (xyz distance)
+                   DO  k = nzb_si + 1, nzb_si + vi
+                      l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1),             &
+                                               SQRT( 0.25 * (dx**2 + dy**2) + &
+                                               ( zu(k) - zw(nzb_si) )**2 ) )
                    ENDDO
                 ENDIF
-             ENDIF
-!
-!--          Map 3D buildings onto terrain height.
-!--          In case of any slopes, map building on top of maximum terrain height covered by the
-!--          building. In other words, extend building down to the respective local terrain-surface
-!--          height.
-             IF ( buildings_f%from_file  .AND.  buildings_f%lod == 2 )  THEN
-                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
-!
-!--                Extend building down to the terrain surface, i.e. fill-up surface irregularities
-!--                below a building. Note, oro_max is already a discrete height according to the
-!--                all-or-nothing approach, i.e. grid box is either topography or atmosphere,
-!--                terrain top is defined at upper bound of the grid box.
-!--                Hence, check for zw in this case.
-!--                Note, do this only for buildings which are surface mounted, i.e. building types
-!--                1-6. Below bridges, which are represented exclusively by building type 7, terrain
-!--                shape should be maintained.
-                   IF ( building_type_f%from_file )  THEN
-                      IF ( building_type_f%var(j,i) /= 7 )  THEN
-                         DO k = topo_top_index + 1, nzt + 1
-                            IF ( zu(k) - ocean_offset <= oro_max(nr) )  THEN
-                               topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
-                               topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 1 )
-                            ENDIF
-                         ENDDO
-!
-!--                      After surface irregularities are smoothen, determine lower start index
-!--                      where building starts.
-                         DO  k = nzb, nzt
-                            IF ( zu(k) - ocean_offset <= oro_max(nr) )  topo_top_index = k
-                         ENDDO
-                      ENDIF
-                   ENDIF
-!
-!--                Finally, map building on top.
-                   k2 = 0
-                   DO k = topo_top_index, nzt + 1
-                      IF ( k2 <= buildings_f%nz-1 )  THEN
-                         IF ( buildings_f%var_3d(k2,j,i) == 1 )  THEN
-                            topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
-                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
-                         ENDIF
-                      ENDIF
-                      k2 = k2 + 1
+!
+!--             Northright corner (xy distance)
+                IF ( corner_nr(j,i) > 0 )  THEN
+                   DO  k = corner_nr(j,i), nzb_si
+                       l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1), &
+                                                0.5 * SQRT( dx**2 + dy**2 ) )
+                   ENDDO
+!
+!--                Above northright corner (xyz distance)
+                   DO  k = nzb_si + 1, nzb_si + vi
+                      l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1), &
+                                               SQRT( 0.25 * (dx**2 + dy**2) + &
+                                               ( zu(k) - zw(nzb_si) )**2 ) )
                    ENDDO
                 ENDIF
              ENDIF
-          ENDDO
-       ENDDO
-!
-!--    Horizontal exchange the oro_max array, which is required to for initialization of
-!--    building-surface properties.
-       IF ( ALLOCATED( buildings_f%oro_max ) )  THEN
-          CALL exchange_horiz_2d( buildings_f%oro_max(:,:) )
-       ENDIF
-!
-!--    Deallocate temporary arrays required for processing and reading data
-       IF ( ALLOCATED( oro_max         ) )  DEALLOCATE( oro_max         )
-       IF ( ALLOCATED( oro_max_l       ) )  DEALLOCATE( oro_max_l       )
-       IF ( ALLOCATED( build_ids_final ) )  DEALLOCATE( build_ids_final )
-!
-!-- Topography input via ASCII format.
-    ELSE
-
-       ocean_offset = MERGE( zw(0), 0.0_wp, ocean_mode )
-!
-!--    Initialize topography bit 0 (indicates obstacle) everywhere to zero and clear all grid points
-!--    at nzb, where alway a surface is defined.
-!--    Further, set also bit 1 (indicates terrain) at nzb, which is further used for masked data
-!--    output and further processing. Note, in the ASCII case no distinction is made between
-!--    buildings and terrain,  so that setting of bit 1 and 2 at the same time has no effect.
-       topo_3d          = IBSET( topo_3d, 0 )
-       topo_3d(nzb,:,:) = IBCLR( topo_3d(nzb,:,:), 0 )
-       topo_3d(nzb,:,:) = IBSET( topo_3d(nzb,:,:), 1 )
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb, nzt
-!
-!--             Flag topography for all grid points which are below the local topography height.
-!--             Note, each topography is flagged as building (bit 2) as well as terrain (bit 1) in
-!--             order to employ urban-surface as well as land-surface model.
-                IF ( zu(k) - ocean_offset <= buildings_f%var_2d(j,i) )  THEN
-                   topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
-                   topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 1 )
-                   topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-    CALL exchange_horiz_int( topo_3d, nys, nyn, nxl, nxr, nzt, nbgp )
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( nys == 0  )  topo_3d(:,-1,:)   = topo_3d(:,0,:)
-       IF ( nyn == ny )  topo_3d(:,ny+1,:) = topo_3d(:,ny,:)
-    ENDIF
-
-    IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( nxl == 0  )  topo_3d(:,:,-1)   = topo_3d(:,:,0)
-       IF ( nxr == nx )  topo_3d(:,:,nx+1) = topo_3d(:,:,nx)
-    ENDIF
-
- END SUBROUTINE process_topography
-
-
-! Description:
-! -------------------------------------------------------------------------------------------------!
-!> Filter topography, i.e. fill holes resolved by only one grid point.
-!> Such holes are suspected to lead to velocity blow-ups as continuity equation on discrete grid
-!> cannot be fulfilled in such case.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE filter_topography( topo_3d )
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc, bc_ns_cyc, message_string
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_int, exchange_horiz_2d_byte, exchange_horiz_2d_int
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nzt
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  building_id_f, building_type_f
-
-    USE  pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i          !< running index along x-direction
-    INTEGER(iwp) ::  j          !< running index along y-direction
-    INTEGER(iwp) ::  k          !< running index along z-direction
-    INTEGER(iwp) ::  num_hole   !< number of holes (in topography) resolved by only one grid point
-    INTEGER(iwp) ::  num_hole_l !< number of holes (in topography) resolved by only one grid point on local PE
-    INTEGER(iwp) ::  num_wall   !< number of surrounding vertical walls for a single grid point
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE            ::  topo_tmp  !< temporary 3D-topography used to fill holes
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo_3d   !< 3D-topography array merging buildings and
-                                                                         !< orography
-
-    LOGICAL      ::  filled = .FALSE. !< flag indicating if holes were filled
-
-!
-!-- Before checking for holes, set lateral boundary conditions for
-!-- topography. After hole-filling, boundary conditions must be set again.
-!-- Several iterations are performed, in order to fill holes which might
-!-- emerge by the filling-algorithm itself.
-    ALLOCATE( topo_tmp(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    topo_tmp = 0
-
-    num_hole = 99999
-    DO WHILE ( num_hole > 0 )
-
-       num_hole = 0
-       CALL exchange_horiz_int( topo_3d, nys, nyn, nxl, nxr, nzt, nbgp )
-!
-!--    Exchange also building ID and type. Note, building_type is an one-byte variable.
-       IF ( building_id_f%from_file )                                                              &
-          CALL exchange_horiz_2d_int( building_id_f%var, nys, nyn, nxl, nxr, nbgp )
-       IF ( building_type_f%from_file )                                                            &
-          CALL exchange_horiz_2d_byte( building_type_f%var, nys, nyn, nxl, nxr, nbgp )
-
-       topo_tmp = topo_3d
-!
-!--    In case of non-cyclic lateral boundaries, assume lateral boundary to be a solid wall. Thus,
-!--    intermediate spaces of one grid point between boundary and some topographic structure will be
-!--    filled.
-       IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( nys == 0  )  topo_tmp(:,-1,:)   = IBCLR( topo_tmp(:,0,:),  0 )
-          IF ( nyn == ny )  topo_tmp(:,ny+1,:) = IBCLR( topo_tmp(:,ny,:), 0 )
-       ENDIF
-
-       IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( nxl == 0  )  topo_tmp(:,:,-1)   = IBCLR( topo_tmp(:,:,0),  0 )
-          IF ( nxr == nx )  topo_tmp(:,:,nx+1) = IBCLR( topo_tmp(:,:,nx), 0 )
-       ENDIF
-
-       num_hole_l = 0
-       DO i = nxl, nxr
-          DO j = nys, nyn
-             DO  k = nzb+1, nzt
-                IF ( BTEST( topo_tmp(k,j,i), 0 ) )  THEN
-                   num_wall = 0
-                   IF ( .NOT. BTEST( topo_tmp(k,j-1,i), 0 ) )  num_wall = num_wall + 1
-                   IF ( .NOT. BTEST( topo_tmp(k,j+1,i), 0 ) )  num_wall = num_wall + 1
-                   IF ( .NOT. BTEST( topo_tmp(k,j,i-1), 0 ) )  num_wall = num_wall + 1
-                   IF ( .NOT. BTEST( topo_tmp(k,j,i+1), 0 ) )  num_wall = num_wall + 1
-                   IF ( .NOT. BTEST( topo_tmp(k-1,j,i), 0 ) )  num_wall = num_wall + 1
-                   IF ( .NOT. BTEST( topo_tmp(k+1,j,i), 0 ) )  num_wall = num_wall + 1
-
-                   IF ( num_wall >= 4 )  THEN
-                      num_hole_l     = num_hole_l + 1
-!
-!--                   Clear flag 0 and set special flag ( bit 4) to indicate that new topography
-!--                   point is a result of filtering process.
-                      topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
-                      topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 4 )
-!
-!--                   If filled grid point is occupied by a building, classify it as building grid
-!--                   point.
-                      IF ( building_type_f%from_file )  THEN
-                         IF ( building_type_f%var(j,i)   /=  building_type_f%fill  .OR.            &
-                              building_type_f%var(j+1,i) /=  building_type_f%fill  .OR.            &
-                              building_type_f%var(j-1,i) /=  building_type_f%fill  .OR.            &
-                              building_type_f%var(j,i+1) /=  building_type_f%fill  .OR.            &
-                              building_type_f%var(j,i-1) /=  building_type_f%fill )  THEN
-!
-!--                         Set flag indicating building surfaces
-                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
-!
-!--                         Set building_type and ID at this position if not already set. This is
-!--                         required for proper initialization of urban-surface energy balance
-!--                         solver.
-                            IF ( building_type_f%var(j,i) == building_type_f%fill )  THEN
-
-                               IF ( building_type_f%var(j+1,i) /= building_type_f%fill )  THEN
-                                  building_type_f%var(j,i) = building_type_f%var(j+1,i)
-                                  building_id_f%var(j,i)   = building_id_f%var(j+1,i)
-                               ELSEIF ( building_type_f%var(j-1,i) /= building_type_f%fill )  THEN
-                                  building_type_f%var(j,i) = building_type_f%var(j-1,i)
-                                  building_id_f%var(j,i)   = building_id_f%var(j-1,i)
-                               ELSEIF ( building_type_f%var(j,i+1) /= building_type_f%fill )  THEN
-                                  building_type_f%var(j,i) = building_type_f%var(j,i+1)
-                                  building_id_f%var(j,i)   = building_id_f%var(j,i+1)
-                               ELSEIF ( building_type_f%var(j,i-1) /= building_type_f%fill )  THEN
-                                  building_type_f%var(j,i) = building_type_f%var(j,i-1)
-                                  building_id_f%var(j,i)   = building_id_f%var(j,i-1)
-                               ENDIF
-                            ENDIF
-                         ENDIF
-                      ENDIF
-!
-!--                   If filled grid point is already classified as building everything is fine,
-!--                   else classify this grid point as natural type grid point. This case, values
-!--                   for the surface type are already set.
-                      IF ( .NOT. BTEST( topo_3d(k,j,i), 2 ) )  THEN
-                         topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 1 )
-                      ENDIF
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    Count the total number of holes, required for informative message.
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( num_hole_l, num_hole, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-       num_hole = num_hole_l
-#endif
-       IF ( num_hole > 0  .AND.  .NOT. filled )  filled = .TRUE.
-
-    ENDDO
-!
-!-- Create an informative message if any holes were filled.
-    IF ( filled )  THEN
-       WRITE( message_string, * ) 'Topography was filtered, i.e. holes ' //                        &
-                                  'resolved by only one grid point '     //                        &
-                                  'were filled during initialization.'
-       CALL message( 'init_grid', 'PA0430', 0, 0, 0, 6, 0 )
-    ENDIF
-
-    DEALLOCATE( topo_tmp )
-!
-!-- Finally, exchange topo_3d array again and if necessary set Neumann boundary condition in case of
-!-- non-cyclic lateral boundaries.
-    CALL exchange_horiz_int( topo_3d, nys, nyn, nxl, nxr, nzt, nbgp )
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( nys == 0  )  topo_3d(:,-1,:)   = topo_3d(:,0,:)
-       IF ( nyn == ny )  topo_3d(:,ny+1,:) = topo_3d(:,ny,:)
-    ENDIF
-
-    IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( nxl == 0  )  topo_3d(:,:,-1)   = topo_3d(:,:,0)
-       IF ( nxr == nx )  topo_3d(:,:,nx+1) = topo_3d(:,:,nx)
-    ENDIF
-!
-!-- Exchange building ID and type. Note, building_type is an one-byte variable.
-    IF ( building_id_f%from_file )                                                                 &
-       CALL exchange_horiz_2d_int( building_id_f%var, nys, nyn, nxl, nxr, nbgp )
-    IF ( building_type_f%from_file )                                                               &
-       CALL exchange_horiz_2d_byte( building_type_f%var, nys, nyn, nxl, nxr, nbgp )
-
- END SUBROUTINE filter_topography
-
-
-! Description:
-! -------------------------------------------------------------------------------------------------!
-!> Reads topography information from file or sets generic topography. Moreover, all
-!> topography-relevant topography arrays are initialized, and grid flags are set.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_topo( topo )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc, bc_ns_cyc, building_height, building_length_x, building_length_y,        &
-               building_wall_left, building_wall_south, canyon_height, canyon_wall_left,           &
-               canyon_wall_south, canyon_width_x, canyon_width_y, dp_level_ind_b, dz,              &
-               message_string, topography, topography_grid_convention, tunnel_height,              &
-               tunnel_length, tunnel_width_x, tunnel_width_y, tunnel_wall_depth
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_int
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt
-
-    USE kinds
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  buildings_f, terrain_height_f
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  bh                !< temporary vertical index of building height
-    INTEGER(iwp) ::  ch                !< temporary vertical index for canyon height
-    INTEGER(iwp) ::  hv_in             !< heavyside function to model inner tunnel surface
-    INTEGER(iwp) ::  i                 !< index variable along x
-    INTEGER(iwp) ::  index_left_bwall  !< index for left building wall
-    INTEGER(iwp) ::  index_north_bwall !< index for north building wall
-    INTEGER(iwp) ::  index_right_bwall !< index for right building wall
-    INTEGER(iwp) ::  index_south_bwall !< index for south building wall
-    INTEGER(iwp) ::  index_left_cwall  !< index for left canyon wall
-    INTEGER(iwp) ::  index_north_cwall !< index for north canyon wall
-    INTEGER(iwp) ::  index_right_cwall !< index for right canyon wall
-    INTEGER(iwp) ::  index_south_cwall !< index for south canyon wall
-    INTEGER(iwp) ::  j                 !< index variable along y
-    INTEGER(iwp) ::  k                 !< index variable along z
-    INTEGER(iwp) ::  ngp_bx            !< grid point number of building size along x
-    INTEGER(iwp) ::  ngp_by            !< grid point number of building size along y
-    INTEGER(iwp) ::  ngp_cx            !< grid point number of canyon size along x
-    INTEGER(iwp) ::  ngp_cy            !< grid point number of canyon size along y
-    INTEGER(iwp) ::  hv_out            !< heavyside function to model outer tunnel surface
-    INTEGER(iwp) ::  td                !< tunnel wall depth
-    INTEGER(iwp) ::  th                !< height of outer tunnel wall
-    INTEGER(iwp) ::  txe_in            !< end position of inner tunnel wall in x
-    INTEGER(iwp) ::  txe_out           !< end position of outer tunnel wall in x
-    INTEGER(iwp) ::  txs_in            !< start position of inner tunnel wall in x
-    INTEGER(iwp) ::  txs_out           !< start position of outer tunnel wall in x
-    INTEGER(iwp) ::  tye_in            !< end position of inner tunnel wall in y
-    INTEGER(iwp) ::  tye_out           !< end position of outer tunnel wall in y
-    INTEGER(iwp) ::  tys_in            !< start position of inner tunnel wall in y
-    INTEGER(iwp) ::  tys_out           !< start position of outer tunnel wall in y
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_local         !< index for topography top at cell-center
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo !< input array for 3D topography and dummy array for setting
-                                                                    !< "outer"-flags
-!
-!-- Check for correct setting of the namelist parameter topography. If topography information is
-!-- read from file but topography = 'flat', initialization does not work properly.
-    IF ( ( buildings_f%from_file  .OR.  terrain_height_f%from_file )  .AND.                        &
-           TRIM( topography ) /= 'read_from_file' )  THEN
-       message_string =  'If topography information is provided (via ' //                          &
-                         'Netcdf or ASCII input) topography = '        //                          &
-                         '"read_from_file" is required.'
-       CALL message( 'init_grid', 'PA0437', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Set outer and inner index arrays for non-flat topography.
-!-- Here consistency checks concerning domain size and periodicity are necessary.
-!-- Within this SELECT CASE structure only nzb_local is initialized individually depending on the
-!-- chosen topography type, all other index arrays are initialized further below.
-    SELECT CASE ( TRIM( topography ) )
-
-       CASE ( 'flat' )
-!
-!--       Initialilize 3D topography array, used later for initializing flags
-          topo(nzb+1:nzt+1,:,:) = IBSET( topo(nzb+1:nzt+1,:,:), 0 )
-
-       CASE ( 'closed_channel' )
-!
-!--       Initialilize 3D topography array, used later for initializing flags
-          topo(nzb+1:nzt,:,:) = IBSET( topo(nzb+1:nzt,:,:), 0 )
-
-       CASE ( 'single_building' )
-!
-!--       Single rectangular building, by default centered in the middle of the
-!--       total domain
-          ngp_bx = NINT( building_length_x / dx )
-          ngp_by = NINT( building_length_y / dy )
-          bh  = MINLOC( ABS( zw - building_height ), 1 ) - 1
-          IF ( ABS( zw(bh) - building_height ) ==  ABS( zw(bh+1) - building_height ) )  bh = bh + 1
-          IF ( building_wall_left == 9999999.9_wp )  THEN
-             building_wall_left = ( nx + 1 - ngp_bx ) / 2 * dx
-          ENDIF
-          index_left_bwall = NINT( building_wall_left / dx )
-          index_right_bwall = index_left_bwall + ngp_bx
-
-          IF ( building_wall_south == 9999999.9_wp )  THEN
-              building_wall_south = ( ny + 1 - ngp_by ) / 2 * dy
-          ENDIF
-          index_south_bwall = NINT( building_wall_south / dy )
-          index_north_bwall = index_south_bwall + ngp_by
-
-!
-!--       Building size has to meet some requirements
-          IF ( ( index_left_bwall  < 1 )  .OR.  ( index_right_bwall > nx-1 )  .OR.                 &
-               ( index_right_bwall < index_left_bwall+3 )  .OR.                                    &
-               ( index_south_bwall < 1 )  .OR.  ( index_north_bwall > ny-1 )  .OR.                 &
-               ( index_north_bwall < index_south_bwall+3 ) )  THEN
-             WRITE( message_string, * ) 'inconsistent building parameters:',                       &
-                                      '&index_left_bwall=', index_left_bwall,                      &
-                                      'index_right_bwall=', index_right_bwall,                     &
-                                      'index_south_bwall=', index_south_bwall,                     &
-                                      'index_north_bwall=', index_north_bwall,                     &
-                                      'nx=', nx, 'ny=', ny
-             CALL message( 'init_grid', 'PA0203', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          ALLOCATE( nzb_local(nysg:nyng,nxlg:nxrg) )
-          nzb_local = 0
-!
-!--       Define the building.
-          IF ( index_left_bwall <= nxr  .AND.  index_right_bwall >= nxl  .AND.                     &
-               index_south_bwall <= nyn  .AND.  index_north_bwall >= nys )                         &
-             nzb_local(MAX(nys,index_south_bwall):MIN(nyn,index_north_bwall),                      &
-                       MAX(nxl,index_left_bwall):MIN(nxr,index_right_bwall)) = bh
-!
-!--       Set bit array on basis of nzb_local
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                topo(nzb_local(j,i)+1:nzt+1,j,i) = IBSET( topo(nzb_local(j,i)+1:nzt+1,j,i), 0 )
-             ENDDO
-          ENDDO
-
-          DEALLOCATE( nzb_local )
-
-          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
-!
-!--       Set boundary conditions also for flags. Can be interpreted as Neumannb oundary conditions
-!--       for topography.
-          IF ( .NOT. bc_ns_cyc )  THEN
-             IF ( nys == 0  )  THEN
-                DO  i = 1, nbgp
-                   topo(:,nys-i,:)   = topo(:,nys,:)
+
+             IF ( wall_s(j,i) > 0 )  THEN
+!
+!--             South wall (y distance)
+                DO  k = wall_s(j,i), nzb_si
+                   l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i), 0.5 * dy )
                 ENDDO
-             ENDIF
-             IF ( nyn == ny )  THEN
-                DO  i = 1, nbgp
-                   topo(:,nyn+i,:) = topo(:,nyn,:)
+!
+!--             Above south wall (yz distance)
+                DO  k = nzb_si + 1, &
+                        nzb_si + vi
+                   l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i),     &
+                                          SQRT( 0.25 * dy**2 + &
+                                          ( zu(k) - zw(nzb_si) )**2 ) )
                 ENDDO
-             ENDIF
-          ENDIF
-          IF ( .NOT. bc_lr_cyc )  THEN
-             IF ( nxl == 0  )  THEN
-                DO  i = 1, nbgp
-                   topo(:,:,nxl-i)   = topo(:,:,nxl)
-                ENDDO
-             ENDIF
-             IF ( nxr == nx )  THEN
-                DO  i = 1, nbgp
-                   topo(:,:,nxr+i) = topo(:,:,nxr)
-                ENDDO
-             ENDIF
-          ENDIF
-
-       CASE ( 'single_street_canyon' )
-!
-!--       Single quasi-2D street canyon of infinite length in x or y direction.
-!--       The canyon is centered in the other direction by default.
-          IF ( canyon_width_x /= 9999999.9_wp )  THEN
-!
-!--          Street canyon in y direction
-             ngp_cx = NINT( canyon_width_x / dx )
-             IF ( canyon_wall_left == 9999999.9_wp )  THEN
-                canyon_wall_left = ( nx + 1 - ngp_cx ) / 2 * dx
-             ENDIF
-             index_left_cwall= NINT( canyon_wall_left / dx )
-             index_right_cwall= index_left_cwall+ ngp_cx
-          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
-!
-!--          Street canyon in x direction
-             ngp_cy = NINT( canyon_width_y / dy )
-             IF ( canyon_wall_south == 9999999.9_wp )  THEN
-                canyon_wall_south = ( ny + 1 - ngp_cy ) / 2 * dy
-             ENDIF
-             index_south_cwall = NINT( canyon_wall_south / dy )
-             index_north_cwall = index_south_cwall + ngp_cy
-
-          ELSE
-
-             message_string = 'no street canyon width given'
-             CALL message( 'init_grid', 'PA0204', 1, 2, 0, 6, 0 )
-
-          ENDIF
-
-          ch  = MINLOC( ABS( zw - canyon_height ), 1 ) - 1
-          IF ( ABS( zw(ch) - canyon_height ) == ABS( zw(ch+1) - canyon_height ) )  ch = ch + 1
-          dp_level_ind_b = ch
-!
-!--       Street canyon size has to meet some requirements
-          IF ( canyon_width_x /= 9999999.9_wp )  THEN
-             IF ( ( index_left_cwall< 1 )  .OR.  ( index_right_cwall> nx-1 )  .OR.                 &
-                  ( ngp_cx < 3 ) )  THEN
-                WRITE( message_string, * ) 'inconsistent canyon parameters:',                      &
-                                           '&index_left_cwall=', index_left_cwall,                 &
-                                           ' index_right_cwall=', index_right_cwall,               &
-                                           ' ngp_cx=', ngp_cx, ' ch=', ch, ' nx=', nx, ' ny=', ny
-                CALL message( 'init_grid', 'PA0205', 1, 2, 0, 6, 0 )
-             ENDIF
-          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
-             IF ( ( index_south_cwall < 1 )  .OR.                                                  &
-                  ( index_north_cwall > ny-1 )  .OR.  ( ngp_cy < 3 ) )  THEN
-                WRITE( message_string, * ) 'inconsistent canyon parameters:',                      &
-                                           '&index_south_cwall=', index_south_cwall,               &
-                                           ' index_north_cwall=', index_north_cwall,               &
-                                           ' ngp_cy=', ngp_cy, ' ch=', ch, ' nx=', nx, ' ny=', ny
-                CALL message( 'init_grid', 'PA0206', 1, 2, 0, 6, 0 )
-             ENDIF
-          ENDIF
-          IF ( canyon_width_x /= 9999999.9_wp  .AND.  canyon_width_y /= 9999999.9_wp )  THEN
-             message_string = 'inconsistent canyon parameters:' //                                 &
-                              '&street canyon can only be oriented' //                             &
-                              ' either in x- or in y-direction'
-             CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          ALLOCATE( nzb_local(nysg:nyng,nxlg:nxrg) )
-          nzb_local = ch
-          IF ( canyon_width_x /= 9999999.9_wp )  THEN
-             IF ( index_left_cwall<= nxr  .AND.  index_right_cwall>= nxl )                         &
-                nzb_local(:,MAX(nxl,index_left_cwall+1):MIN(nxr,index_right_cwall-1)) = 0
-          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
-             IF ( index_south_cwall <= nyn  .AND.  index_north_cwall >= nys )                      &
-                nzb_local(MAX(nys,index_south_cwall+1):MIN(nyn,index_north_cwall-1),:) = 0
-          ENDIF
-!
-!--       Set bit array on basis of nzb_local
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                topo(nzb_local(j,i)+1:nzt+1,j,i) = IBSET( topo(nzb_local(j,i)+1:nzt+1,j,i), 0 )
-             ENDDO
-          ENDDO
-          DEALLOCATE( nzb_local )
-
-          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
-!
-!--       Set boundary conditions also for flags. Can be interpreted as Neumann boundary conditions
-!--       for topography.
-          IF ( .NOT. bc_ns_cyc )  THEN
-             IF ( nys == 0  )  THEN
-                DO  i = 1, nbgp
-                   topo(:,nys-i,:) = topo(:,nys,:)
-                ENDDO
-             ENDIF
-             IF ( nyn == ny )  THEN
-                DO  i = 1, nbgp
-                   topo(:,nyn+i,:) = topo(:,nyn,:)
-                ENDDO
-             ENDIF
-          ENDIF
-          IF ( .NOT. bc_lr_cyc )  THEN
-             IF ( nxl == 0  )  THEN
-                DO  i = 1, nbgp
-                   topo(:,:,nxl-i) = topo(:,:,nxl)
-                ENDDO
-             ENDIF
-             IF ( nxr == nx )  THEN
-                DO  i = 1, nbgp
-                   topo(:,:,nxr+i) = topo(:,:,nxr)
-                ENDDO
-             ENDIF
-          ENDIF
-
-       CASE ( 'tunnel' )
-!
-!--       Tunnel height
-          IF ( tunnel_height == 9999999.9_wp )  THEN
-             th = zw( INT( 0.2 * nz) )
-          ELSE
-             th = tunnel_height
-          ENDIF
-!
-!--       Tunnel-wall depth
-          IF ( tunnel_wall_depth == 9999999.9_wp )  THEN
-             td = MAX ( dx, dy, dz(1) )
-          ELSE
-             td = tunnel_wall_depth
-          ENDIF
-!
-!--       Check for tunnel width
-          IF ( tunnel_width_x == 9999999.9_wp  .AND.  tunnel_width_y == 9999999.9_wp  )  THEN
-             message_string = 'No tunnel width is given. '
-             CALL message( 'init_grid', 'PA0280', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( tunnel_width_x /= 9999999.9_wp  .AND.  tunnel_width_y /= 9999999.9_wp  )  THEN
-             message_string = 'Inconsistent tunnel parameters:' //                                 &
-                              'tunnel can only be oriented' //                                     &
-                              'either in x- or in y-direction.'
-             CALL message( 'init_grid', 'PA0281', 1, 2, 0, 6, 0 )
-          ENDIF
-!
-!--       Check for too small tunnel width in x- and y-direction
-          IF ( tunnel_width_x /= 9999999.9_wp  .AND.                                               &
-               tunnel_width_x - 2.0_wp * td <= 2.0_wp * dx )  THEN
-             message_string = 'tunnel_width_x too small'
-             CALL message( 'init_grid', 'PA0175', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( tunnel_width_y /= 9999999.9_wp  .AND.                                               &
-               tunnel_width_y - 2.0_wp * td <= 2.0_wp * dy )  THEN
-             message_string = 'tunnel_width_y too small'
-             CALL message( 'init_grid', 'PA0455', 1, 2, 0, 6, 0 )
-          ENDIF
-!
-!--       Check for too large tunnel width.
-!--       Tunnel axis along y.
-          IF ( tunnel_width_x /= 9999999.9_wp )  THEN
-             IF ( tunnel_width_x > ( nx + 1 ) * dx )  THEN
-                message_string = 'tunnel_width_x too large'
-                CALL message( 'init_grid', 'PA0282', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             txs_out = INT( ( nx + 1 ) * 0.5_wp * dx - tunnel_width_x * 0.5_wp )
-             txe_out = INT( ( nx + 1 ) * 0.5_wp * dx + tunnel_width_x * 0.5_wp )
-             txs_in  = INT( ( nx + 1 ) * 0.5_wp * dx - ( tunnel_width_x * 0.5_wp - td ) )
-             txe_in  = INT( ( nx + 1 ) * 0.5_wp * dx + ( tunnel_width_x * 0.5_wp - td ) )
-
-             tys_out = INT( ( ny + 1 ) * 0.5_wp * dy - tunnel_length * 0.5_wp )
-             tye_out = INT( ( ny + 1 ) * 0.5_wp * dy + tunnel_length * 0.5_wp )
-             tys_in  = tys_out
-             tye_in  = tye_out
-          ENDIF
-!
-!--       Tunnel axis along x.
-          IF ( tunnel_width_y /= 9999999.9_wp )  THEN
-             IF ( tunnel_width_y > ( ny + 1 ) * dy )  THEN
-                message_string = 'tunnel_width_y too large'
-                CALL message( 'init_grid', 'PA0456', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             txs_out = INT( ( nx + 1 ) * 0.5_wp * dx - tunnel_length * 0.5_wp )
-             txe_out = INT( ( nx + 1 ) * 0.5_wp * dx + tunnel_length * 0.5_wp )
-             txs_in  = txs_out
-             txe_in  = txe_out
-
-             tys_out = INT( ( ny + 1 ) * 0.5_wp * dy - tunnel_width_y * 0.5_wp )
-             tye_out = INT( ( ny + 1 ) * 0.5_wp * dy + tunnel_width_y * 0.5_wp )
-             tys_in  = INT( ( ny + 1 ) * 0.5_wp * dy - ( tunnel_width_y * 0.5_wp - td ) )
-             tye_in  = INT( ( ny + 1 ) * 0.5_wp * dy + ( tunnel_width_y * 0.5_wp - td ) )
-          ENDIF
-
-          topo = 0
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-!
-!--             Use heaviside function to model outer tunnel surface
-                hv_out = th * 0.5_wp * ( ( SIGN( 1.0_wp, i * dx - txs_out ) + 1.0_wp )             &
-                                       - ( SIGN( 1.0_wp, i * dx - txe_out ) + 1.0_wp ) )
-
-                hv_out = hv_out * 0.5_wp * ( ( SIGN( 1.0_wp, j * dy - tys_out ) + 1.0_wp )         &
-                                           - ( SIGN( 1.0_wp, j * dy - tye_out ) + 1.0_wp ) )
-!
-!--             Use heaviside function to model inner tunnel surface
-                hv_in  = ( th - td ) * 0.5_wp * ( ( SIGN( 1.0_wp, i * dx - txs_in ) + 1.0_wp )     &
-                                                - ( SIGN( 1.0_wp, i * dx - txe_in ) + 1.0_wp ) )
-
-                hv_in = hv_in * 0.5_wp * ( ( SIGN( 1.0_wp, j * dy - tys_in ) + 1.0_wp )            &
-                                         - ( SIGN( 1.0_wp, j * dy - tye_in ) + 1.0_wp ) )
-!
-!--             Set flags at x-y-positions without any tunnel surface
-                IF ( hv_out - hv_in == 0.0_wp )  THEN
-                   topo(nzb+1:nzt+1,j,i) = IBSET( topo(nzb+1:nzt+1,j,i), 0 )
-!
-!--             Set flags at x-y-positions with tunnel surfaces
-                ELSE
-                   DO  k = nzb + 1, nzt + 1
-!
-!--                   Inner tunnel
-                      IF ( hv_out - hv_in == th )  THEN
-                         IF ( zw(k) <= hv_out )  THEN
-                            topo(k,j,i) = IBCLR( topo(k,j,i), 0 )
-                         ELSE
-                            topo(k,j,i) = IBSET( topo(k,j,i), 0 )
-                         ENDIF
-                      ENDIF
-!
-!--                   Lateral tunnel walls
-                      IF ( hv_out - hv_in == td )  THEN
-                         IF ( zw(k) <= hv_in )  THEN
-                            topo(k,j,i) = IBSET( topo(k,j,i), 0 )
-                         ELSEIF ( zw(k) > hv_in  .AND.  zw(k) <= hv_out )  THEN
-                            topo(k,j,i) = IBCLR( topo(k,j,i), 0 )
-                         ELSEIF ( zw(k) > hv_out )  THEN
-                            topo(k,j,i) = IBSET( topo(k,j,i), 0 )
-                         ENDIF
-                      ENDIF
+!
+!--             Southleft corner (xy distance)
+                IF ( corner_sl(j,i) > 0 )  THEN
+                   DO  k = corner_sl(j,i), nzb_si
+                      l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1), &
+                                               0.5 * SQRT( dx**2 + dy**2 ) )
+                   ENDDO
+!
+!--                Above southleft corner (xyz distance)
+                   DO  k = nzb_si + 1, nzb_si + vi
+                      l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1),             &
+                                               SQRT( 0.25 * (dx**2 + dy**2) + &
+                                               ( zu(k) - zw(nzb_si) )**2 ) )
                    ENDDO
                 ENDIF
-             ENDDO
-          ENDDO
-
-          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
-!
-!--       Set boundary conditions also for flags. Can be interpreted as Neumann boundary conditions
-!--       for topography.
-          IF ( .NOT. bc_ns_cyc )  THEN
-             IF ( nys == 0  )  THEN
-                DO  i = 1, nbgp
-                   topo(:,nys-i,:) = topo(:,nys,:)
+!
+!--             Southright corner (xy distance)
+                IF ( corner_sr(j,i) > 0 )  THEN
+                   DO  k = corner_sr(j,i), nzb_si
+                      l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1), &
+                                               0.5 * SQRT( dx**2 + dy**2 ) )
+                   ENDDO
+!
+!--                Above southright corner (xyz distance)
+                   DO  k = nzb_si + 1, nzb_si + vi
+                      l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1),             &
+                                               SQRT( 0.25 * (dx**2 + dy**2) + &
+                                               ( zu(k) - zw(nzb_si) )**2 ) )
+                   ENDDO
+                ENDIF
+
+             ENDIF
+
+             IF ( wall_l(j,i) > 0 )  THEN
+!
+!--             Left wall (x distance)
+                DO  k = wall_l(j,i), nzb_si
+                   l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1), 0.5 * dx )
                 ENDDO
-             ENDIF
-             IF ( nyn == ny )  THEN
-                DO  i = 1, nbgp
-                   topo(:,nyn+i,:) = topo(:,nyn,:)
+!
+!--             Above left wall (xz distance)
+                DO  k = nzb_si + 1, nzb_si + vi
+                   l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1),     &
+                                          SQRT( 0.25 * dx**2 + &
+                                          ( zu(k) - zw(nzb_si) )**2 ) )
                 ENDDO
              ENDIF
-          ENDIF
-          IF ( .NOT. bc_lr_cyc )  THEN
-             IF ( nxl == 0  )  THEN
-                DO  i = 1, nbgp
-                   topo(:,:,nxl-i) = topo(:,:,nxl)
+
+             IF ( wall_r(j,i) > 0 )  THEN
+!
+!--             Right wall (x distance)
+                DO  k = wall_r(j,i), nzb_si
+                   l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1), 0.5 * dx )
                 ENDDO
-             ENDIF
-             IF ( nxr == nx )  THEN
-                DO  i = 1, nbgp
-                   topo(:,:,nxr+i) = topo(:,:,nxr)
+!
+!--             Above right wall (xz distance)
+                DO  k = nzb_si + 1, nzb_si + vi
+                   l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1),     &
+                                          SQRT( 0.25 * dx**2 + &
+                                          ( zu(k) - zw(nzb_si) )**2 ) )
                 ENDDO
-             ENDIF
-          ENDIF
-
-       CASE ( 'read_from_file' )
-!
-!--       Note, topography information have been already read.
-!--       If required, further process topography, i.e. reference buildings on top of orography and
-!--       set temporary 3D topography array, which is used later to set grid flags. Calling of this
-!--       rouinte is also required in case of ASCII input, even though no distinction between
-!--       terrain- and building height is made in this case.
-          CALL process_topography( topo )
-!
-!--       Filter holes resolved by only one grid-point
-          CALL filter_topography( topo )
-!
-!--       Exchange ghost-points, as well as add cyclic or Neumann boundary conditions.
-          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
-!
-!--       Set lateral boundary conditions for topography on all ghost layers
-          IF ( .NOT. bc_ns_cyc )  THEN
-             IF ( nys == 0  )  THEN
-                DO  i = 1, nbgp
-                   topo(:,nys-i,:) = topo(:,nys,:)
-                ENDDO
-             ENDIF
-             IF ( nyn == ny )  THEN
-                DO  i = 1, nbgp
-                   topo(:,nyn+i,:) = topo(:,nyn,:)
-                ENDDO
-             ENDIF
-          ENDIF
-
-          IF ( .NOT. bc_lr_cyc )  THEN
-             IF ( nxl == 0  )  THEN
-                DO  i = 1, nbgp
-                   topo(:,:,nxl-i) = topo(:,:,nxl)
-                ENDDO
-             ENDIF
-             IF ( nxr == nx )  THEN
-                DO  i = 1, nbgp
-                   topo(:,:,nxr+i) = topo(:,:,nxr)
-                ENDDO
-             ENDIF
-          ENDIF
-
-
-       CASE DEFAULT
-!
-!--       The DEFAULT case is reached either if the parameter topography contains a wrong character
-!--       string or if the user has defined a special case in the user interface. There, the
-!--       subroutine user_init_grid checks which of these two conditions applies.
-          CALL user_init_grid( topo )
-          CALL filter_topography( topo )
-
-    END SELECT
-!
-!-- Consistency checks and index array initialization are only required for non-flat topography.
-    IF ( TRIM( topography ) /= 'flat' )  THEN
-!
-!--    In case of non-flat topography, check whether the convention how to define the topography
-!--    grid has been set correctly, or whether the default is applicable. If this is not possible,
-!--    abort.
-       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
-          IF ( TRIM( topography ) /= 'closed_channel'        .AND.                                 &
-               TRIM( topography ) /= 'single_building'       .AND.                                 &
-               TRIM( topography ) /= 'single_street_canyon'  .AND.                                 &
-               TRIM( topography ) /= 'tunnel'                .AND.                                 &
-               TRIM( topography ) /= 'read_from_file')  THEN
-!--          The default value is not applicable here, because it is only valid for the four
-!--          standard cases 'single_building', 'single_street_canyon', 'tunnel' and 'read_from_file'
-!--          defined in init_grid.
-             WRITE( message_string, * ) 'The value for "topography_grid_convention" ',             &
-                                        'is not set. Its default value is & only valid for ',      &
-                                        '"topography" = ''single_building'', ''tunnel'' ',         &
-                                        '''single_street_canyon'', ''closed_channel'' & or ',      &
-                                        '''read_from_file''.',                                     &
-                                        '& Choose ''cell_edge'' or ''cell_center''.'
-             CALL message( 'init_grid', 'PA0239', 1, 2, 0, 6, 0 )
-          ELSE
-!--          The default value is applicable here.
-!--          Set convention according to topography.
-             IF ( TRIM( topography ) == 'single_building'  .OR.                                    &
-                  TRIM( topography ) == 'single_street_canyon' )  THEN
-                topography_grid_convention = 'cell_edge'
-             ELSEIF ( TRIM( topography ) == 'read_from_file'  .OR.                                 &
-                      TRIM( topography ) == 'tunnel')  THEN
-                topography_grid_convention = 'cell_center'
-             ENDIF
-          ENDIF
-       ELSEIF ( TRIM( topography_grid_convention ) /= 'cell_edge'  .AND.                           &
-                TRIM( topography_grid_convention ) /= 'cell_center' )  THEN
-          WRITE( message_string, * )  'The value for "topography_grid_convention" is ',            &
-                                      'not recognized.& Choose ''cell_edge'' or ''cell_center''.'
-          CALL message( 'init_grid', 'PA0240', 1, 2, 0, 6, 0 )
-       ENDIF
-
-
-       IF ( topography_grid_convention == 'cell_edge' )  THEN
-!
-!--       The array nzb_local as defined using the 'cell_edge' convention
-!--       describes the actual total size of topography which is defined at the
-!--       cell edges where u=0 on the topography walls in x-direction and v=0
-!--       on the topography walls in y-direction. However, PALM uses individual
-!--       arrays nzb_u|v|w|s_inner|outer that are based on nzb_s_inner.
-!--       Therefore, the extent of topography in nzb_local is now reduced by
-!--       1dx at the E topography walls and by 1dy at the N topography walls
-!--       to form the basis for nzb_s_inner.
-!--       Note, the reverse memory access (i-j instead of j-i) is absolutely
-!--       required at this point.
-          DO  j = nys+1, nyn+1
-             DO  i = nxl-1, nxr
-                DO  k = nzb, nzt+1
-                   IF ( BTEST( topo(k,j,i), 0 )  .OR.  BTEST( topo(k,j,i+1), 0 ) )                 &
-                       topo(k,j,i) = IBSET( topo(k,j,i), 0 )
-                ENDDO
-             ENDDO
-          ENDDO
-          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
-
-          DO  i = nxl, nxr+1
-             DO  j = nys-1, nyn
-                DO  k = nzb, nzt+1
-                   IF ( BTEST( topo(k,j,i), 0 )  .OR.  BTEST( topo(k,j+1,i), 0 ) )                 &
-                      topo(k,j,i) = IBSET( topo(k,j,i), 0 )
-                ENDDO
-             ENDDO
-          ENDDO
-          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
-
-       ENDIF
+
+             ENDIF
+
+          ENDDO
+       ENDDO
+
     ENDIF
 
- END SUBROUTINE init_topo
-
-
- SUBROUTINE set_topo_flags(topo)
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc, bc_ns_cyc, constant_flux_layer, scalar_advec, topography,                &
-               use_surface_fluxes, use_top_fluxes
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_int
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nzt, topo_top_ind,   &
-               wall_flags_static_0, wall_flags_total_0
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i             !< index variable along x
-    INTEGER(iwp) ::  ibit          !< integer bit position of topgraphy masking array
-    INTEGER(iwp) ::  j             !< index variable along y
-    INTEGER(iwp) ::  k             !< index variable along z
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo !< input array for 3D topography and dummy array for setting
-                                                                    !< "outer"-flags
-
-    ALLOCATE( wall_flags_static_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    wall_flags_static_0 = 0
-!
-!-- Set-up topography flags. First, set flags only for s, u, v and w-grid.
-!-- Further special flags will be set in following loops.
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt+1
-!
-!--          scalar grid
-             IF ( BTEST( topo(k,j,i), 0 ) )                                                        &
-                wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 0 )
-!
-!--          u grid
-             IF ( BTEST( topo(k,j,i), 0 )  .AND.  BTEST( topo(k,j,i-1), 0 ) )                      &
-                wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 1 )
-!
-!--          v grid
-             IF ( BTEST( topo(k,j,i), 0 )  .AND.  BTEST( topo(k,j-1,i), 0 ) )                      &
-                 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 2 )
-
-          ENDDO
-
-          DO  k = nzb, nzt
-!
-!--          w grid
-             IF ( BTEST( topo(k,j,i), 0 )  .AND.  BTEST( topo(k+1,j,i), 0 ) )                      &
-                wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 3 )
-          ENDDO
-
-          IF ( topography /= 'closed_channel' )  THEN
-             wall_flags_static_0(nzt+1,j,i) = IBSET( wall_flags_static_0(nzt+1,j,i), 3 )
-          ENDIF
-
-       ENDDO
-    ENDDO
-
-    CALL exchange_horiz_int( wall_flags_static_0, nys, nyn, nxl, nxr, nzt, nbgp )
-
-!
-!-- Set outer array for scalars to mask near-surface grid points. Note, on basis of flag 24 futher
-!-- flags will be derived which are used to control production of subgrid TKE production near walls.
-    ALLOCATE( wall_flags_total_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    wall_flags_total_0 = 0
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt+1
-             wall_flags_total_0(k,j,i) = IOR( wall_flags_total_0(k,j,i), wall_flags_static_0(k,j,i) )
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL exchange_horiz_int( wall_flags_total_0, nys, nyn, nxl, nxr, nzt, nbgp )
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt+1
-             IF ( BTEST( wall_flags_total_0(k,j-1,i), 0 )    .AND.                                 &
-                  BTEST( wall_flags_total_0(k,j+1,i), 0 )    .AND.                                 &
-                  BTEST( wall_flags_total_0(k,j,i-1), 0 )    .AND.                                 &
-                  BTEST( wall_flags_total_0(k,j,i+1), 0 )    .AND.                                 &
-                  BTEST( wall_flags_total_0(k,j-1,i-1), 0 )  .AND.                                 &
-                  BTEST( wall_flags_total_0(k,j+1,i-1), 0 )  .AND.                                 &
-                  BTEST( wall_flags_total_0(k,j-1,i+1), 0 )  .AND.                                 &
-                  BTEST( wall_flags_total_0(k,j+1,i+1), 0 ) )                                      &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 24 )
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Set further special flags
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt+1
-!
-!--          scalar grid, former nzb_diff_s_inner.
-!--          Note, use this flag also to mask topography in diffusion_u and diffusion_v along the
-!--          vertical direction. In case of use_surface_fluxes, fluxes are calculated via MOST,
-!--          else, simple gradient approach is applied. Please note, in case of u- and v-diffuison,
-!--          a small error is made at edges (on the east side for u, at the north side for v), since
-!--          topography on scalar grid point is used instead of topography on u/v-grid. As number of
-!--          topography grid points on uv-grid is different than s-grid, different number of surface
-!--          elements would be required. In order to avoid this, treat edges (u(k,j,i+1)) simply by
-!--          a gradient approach, i.e. these points are not masked within diffusion_u. Tests had
-!--          shown that the effect on the flow is negligible.
-             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
-                IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )                                       &
-                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 8 )
-             ELSE
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 8 )
-             ENDIF
-
-          ENDDO
-!
-!--       Special flag to control vertical diffusion at model top - former nzt_diff
-          wall_flags_total_0(:,j,i) = IBSET( wall_flags_total_0(:,j,i), 9 )
-          IF ( use_top_fluxes )                                                &
-             wall_flags_total_0(nzt+1,j,i) = IBCLR( wall_flags_total_0(nzt+1,j,i), 9 )
-
-
-          DO  k = nzb+1, nzt
-!
-!--          Special flag on u grid, former nzb_u_inner + 1, required for disturb_field and
-!--          initialization. Do not disturb directly at topography, as well as initialize u with
-!--          zero one grid point outside of topography.
-             IF ( BTEST( wall_flags_total_0(k-1,j,i), 1 )  .AND.                                   &
-                  BTEST( wall_flags_total_0(k,j,i),   1 )  .AND.                                   &
-                  BTEST( wall_flags_total_0(k+1,j,i), 1 ) )                                        &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 20 )
-!
-!--          Special flag on v grid, former nzb_v_inner + 1, required for disturb_field and
-!--          initialization. Do not disturb directly at topography, as well as initialize v with
-!--          zero one grid point outside of topography.
-             IF ( BTEST( wall_flags_total_0(k-1,j,i), 2 )  .AND.                                   &
-                  BTEST( wall_flags_total_0(k,j,i),   2 )  .AND.                                   &
-                  BTEST( wall_flags_total_0(k+1,j,i), 2 ) )                                        &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 21 )
-!
-!--          Special flag on scalar grid, former nzb_s_inner+1. Used for lpm_sgs_tke
-             IF ( BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                                   &
-                  BTEST( wall_flags_total_0(k-1,j,i), 0 )  .AND.                                   &
-                  BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                                        &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 25 )
-!
-!--          Special flag on scalar grid, nzb_diff_s_outer - 1, required in in production_e
-             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
-                IF ( BTEST( wall_flags_total_0(k,j,i),   24 )  .AND.                               &
-                     BTEST( wall_flags_total_0(k-1,j,i), 24 )  .AND.                               &
-                     BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                                     &
-                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 29 )
-             ELSE
-                IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )                                       &
-                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 29 )
-             ENDIF
-!
-!--          Special flag on scalar grid, nzb_diff_s_outer - 1, required in
-!--          in production_e
-             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
-                IF ( BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                                &
-                     BTEST( wall_flags_total_0(k-1,j,i), 0 )  .AND.                                &
-                     BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                                     &
-                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 30 )
-             ELSE
-                IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )                                       &
-                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 30 )
-             ENDIF
-          ENDDO
-!
-!--       Flags indicating downward facing walls
-          DO  k = nzb+1, nzt+1
-!
-!--          Scalar grid
-             IF (       BTEST( wall_flags_total_0(k-1,j,i), 0 )  .AND.                             &
-                  .NOT. BTEST( wall_flags_total_0(k,j,i), 0   ) )                                  &
-                 wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 13 )
-!
-!--          Downward facing wall on u grid
-             IF (       BTEST( wall_flags_total_0(k-1,j,i), 1 )  .AND.                             &
-                  .NOT. BTEST( wall_flags_total_0(k,j,i), 1   ) )                                  &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 15 )
-!
-!--          Downward facing wall on v grid
-             IF (       BTEST( wall_flags_total_0(k-1,j,i), 2 )  .AND.                             &
-                  .NOT. BTEST( wall_flags_total_0(k,j,i), 2   ) )                                  &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 17 )
-!
-!--          Downward facing wall on w grid
-             IF (       BTEST( wall_flags_total_0(k-1,j,i), 3 )  .AND.                             &
-                  .NOT. BTEST( wall_flags_total_0(k,j,i), 3 ) )                                    &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 19 )
-          ENDDO
-!
-!--       Flags indicating upward facing walls
-          DO  k = nzb, nzt
-!
-!--          Upward facing wall on scalar grid
-             IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                             &
-                        BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                                  &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 12 )
-!
-!--          Upward facing wall on u grid
-             IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   1 )  .AND.                             &
-                        BTEST( wall_flags_total_0(k+1,j,i), 1 ) )                                  &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 14 )
-
-!
-!--          Upward facing wall on v grid
-             IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   2 )  .AND.                             &
-                        BTEST( wall_flags_total_0(k+1,j,i), 2 ) )                                  &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 16 )
-
-!
-!--          Upward facing wall on w grid
-             IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   3 )  .AND.                             &
-                        BTEST( wall_flags_total_0(k+1,j,i), 3 ) )                                  &
-                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 18 )
-!
-!--          Special flag on scalar grid, former nzb_s_inner
-             IF ( BTEST( wall_flags_total_0(k,j,i), 0 )  .OR.                                      &
-                  BTEST( wall_flags_total_0(k,j,i), 12 ) .OR.                                      &
-                  BTEST( wall_flags_total_0(k,j,i), 13 ) )                                         &
-                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 22 )
-!
-!--          Special flag on scalar grid, nzb_diff_s_inner - 1, required for
-!--          flow_statistics
-             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
-                IF ( BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                                &
-                     BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                                     &
-                  wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 23 )
-             ELSE
-                IF ( BTEST( wall_flags_total_0(k,j,i), 22 ) )                                      &
-                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 23 )
-             ENDIF
-
-
-          ENDDO
-          wall_flags_total_0(nzt+1,j,i) = IBSET( wall_flags_total_0(nzt+1,j,i), 22 )
-          wall_flags_total_0(nzt+1,j,i) = IBSET( wall_flags_total_0(nzt+1,j,i), 23 )
-!
-!--       Set flags indicating that topography is close by in horizontal direction, i.e. flags that
-!--       infold the topography. These will be used to set advection flags for passive scalars,
-!--       where due to large gradients near buildings stationary numerical oscillations can produce
-!--       unrealistically high concentrations. This is only necessary if WS-scheme is applied for
-!--       scalar advection. Note, these flags will be only used for passive scalars such as chemical
-!--       species or aerosols.
-          IF ( scalar_advec == 'ws-scheme' )  THEN
-             DO  k = nzb, nzt
-                IF ( BTEST( wall_flags_total_0(k,j,i), 0 )  .AND. (                                &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i-1), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i-2), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i-3), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i+1), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i+2), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i+3), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-1,i-3:i+3), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-2,i-3:i+3), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3,i-3:i+3), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j+1,i-3:i+3), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j+2,i-3:i+3), 0 ) )  .OR.              &
-                     ANY( .NOT. BTEST( wall_flags_total_0(k,j+3,i-3:i+3), 0 ) )                    &
-                                                                  )                                &
-                   )                                                                               &
-                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 31 )
-             ENDDO
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!-- Finally, set identification flags indicating natural terrain or buildings.
-!-- Natural terrain grid points. Information on the type of the surface is stored in bit 1 of
-!-- 3D Integer array topo. However, this bit is only set when topography is read from file. In order
-!-- to run the land-surface model also without topography information, set bit 1 explicitely in this
-!-- case.
-!--
-!-- Natural terrain grid points
-!-- If no topography is initialized, the land-surface is at k = nzb.
-    IF ( TRIM( topography ) /= 'read_from_file' )  THEN
-       wall_flags_static_0(nzb,:,:) = IBSET( wall_flags_static_0(nzb,:,:), 5 )
-    ELSE
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-!
-!--             Natural terrain grid point
-                IF ( BTEST( topo(k,j,i), 1 ) )                                                     &
-                   wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 5 )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Building grid points.
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt+1
-             IF ( BTEST( topo(k,j,i), 2 ) )                                                        &
-                wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 6 )
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Set flag 4, indicating new topography grid points due to filtering.
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt+1
-             IF ( BTEST( topo(k,j,i), 4 ) )                                                        &
-                wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 4 )
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL exchange_horiz_int( wall_flags_static_0, nys, nyn, nxl, nxr, nzt, nbgp )
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt+1
-             wall_flags_total_0(k,j,i) = IOR( wall_flags_total_0(k,j,i), wall_flags_static_0(k,j,i) )
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Exchange ghost points for wall flags
-    CALL exchange_horiz_int( wall_flags_total_0, nys, nyn, nxl, nxr, nzt, nbgp )
-!
-!-- Set boundary conditions also for flags. Can be interpreted as Neumann boundary conditions for
-!-- topography.
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( nys == 0  )  THEN
-          DO  i = 1, nbgp
-             wall_flags_total_0(:,nys-i,:)   = wall_flags_total_0(:,nys,:)
-          ENDDO
-       ENDIF
-       IF ( nyn == ny )  THEN
-          DO  i = 1, nbgp
-             wall_flags_total_0(:,nyn+i,:) = wall_flags_total_0(:,nyn,:)
-          ENDDO
-       ENDIF
-    ENDIF
-    IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( nxl == 0  )  THEN
-          DO  i = 1, nbgp
-             wall_flags_total_0(:,:,nxl-i)   = wall_flags_total_0(:,:,nxl)
-          ENDDO
-       ENDIF
-       IF ( nxr == nx )  THEN
-          DO  i = 1, nbgp
-             wall_flags_total_0(:,:,nxr+i) = wall_flags_total_0(:,:,nxr)
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Pre-calculate topography top indices (former get_topography_top_index
-!-- function)
-    ALLOCATE( topo_top_ind(nysg:nyng,nxlg:nxrg,0:5) )
-!
-!-- Uppermost topography index on scalar grid
-    ibit = 12
-    topo_top_ind(:,:,0) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,:,:), ibit ) ), DIM=1 ) &
-                          - 1
-!
-!-- Uppermost topography index on u grid
-    ibit = 14
-    topo_top_ind(:,:,1) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,:,:), ibit ) ), DIM=1 ) &
-                          - 1
-!
-!-- Uppermost topography index on v grid
-    ibit = 16
-    topo_top_ind(:,:,2) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,:,:), ibit ) ), DIM=1 ) &
-                          - 1
-!
-!-- Uppermost topography index on w grid
-    ibit = 18
-    topo_top_ind(:,:,3) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,:,:), ibit ) ), DIM=1 ) &
-                          - 1
-!
-!-- Uppermost topography index on scalar outer grid
-    ibit = 24
-    topo_top_ind(:,:,4) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,:,:), ibit ) ), DIM=1 ) &
-                          - 1
-!
-!-- Uppermost topography index including full-3D geometry
-    ibit = 12
-    DO  k = nzb, nzt+1
-       WHERE( BTEST( wall_flags_total_0(k,:,:), ibit ) )  topo_top_ind(:,:,5) = k
-    ENDDO
-
- END SUBROUTINE set_topo_flags
+!
+!-- Multiplication with wall_adjustment_factor
+    l_wall = wall_adjustment_factor * l_wall
+
+!
+!-- Need to set lateral boundary conditions for l_wall
+    CALL exchange_horiz( l_wall, 0, 0 )
+
+    DEALLOCATE( corner_nl, corner_nr, corner_sl, corner_sr, nzb_local, &
+                nzb_tmp, vertical_influence, wall_l, wall_n, wall_r, wall_s )
+
+
+ END SUBROUTINE init_grid
Index: palm/trunk/SOURCE/init_masks.f90
===================================================================
--- palm/trunk/SOURCE/init_masks.f90	(revision 4901)
+++ 	(revision )
@@ -1,816 +1,0 @@
-!> @file init_masks.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! small re-formatting to follow the coding standard
-!
-! 4895 2021-03-03 15:39:08Z suehring
-! Allow only mask_k_over_surface >= 1 for terrain-following mask output
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Implement snow and graupel (bulk microphysics)
-!
-! 4648 2020-08-25 07:52:08Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4521 2020-05-06 11:39:49Z schwenkel
-! Rename variable
-!
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to avoid runtime error
-! (Loop variable has been modified) in time_integration
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! unused variables removed
-!
-! 3687 2019-01-22 10:42:06Z knoop
-! unused variables removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Move the control parameter "salsa" from salsa_mod to control_parameters (M. Kurppa)
-!
-! 410 2009-12-04 17:05:40Z letzel
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Initialize masked data output
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_masks
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zu, zw
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY: bulk_cloud_model, microphysics_ice_phase, microphysics_morrison,                     &
-              microphysics_seifert, snow, graupel
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  constant_diffusion, cloud_droplets, data_output_masks, data_output_masks_user, doav,&
-               doav_n, domask, domask_no, dz, dz_stretch_level_start, humidity, mask, masks,       &
-               mask_scale, mask_i, mask_i_global, mask_j, mask_j_global, mask_k, mask_k_global,    &
-               mask_k_over_surface, mask_loop, mask_size, mask_size_l, mask_start_l, mask_surface, &
-               mask_x, mask_x_loop, mask_xyz_dimension, mask_y, mask_y_loop, mask_z, mask_z_loop,  &
-               max_masks,  message_string, passive_scalar, ocean_mode, varnamelength
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nx, nxl, nxr, ny, nyn, nys, nz, nzb, nzt
-
-    USE kinds
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_init_masks
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  domask_unit, netcdf_data_format
-
-    USE particle_attributes,                                                                       &
-        ONLY:  particle_advection
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=varnamelength) ::  var  !< contains variable name
-    CHARACTER (LEN=7)             ::  unit !< contains unit of variable
-
-    CHARACTER (LEN=varnamelength), DIMENSION(max_masks,100) ::  do_mask      !< list of output variables
-    CHARACTER (LEN=varnamelength), DIMENSION(max_masks,100) ::  do_mask_user !< list of user-specified output variables
-
-    INTEGER(iwp) ::  count        !< counting masking indices along a dimension
-    INTEGER(iwp) ::  i            !< loop index
-    INTEGER(iwp) ::  ilen         !< length of string saved in 'do_mask'
-    INTEGER(iwp) ::  ind_array(1) !< array index
-    INTEGER(iwp) ::  j            !< loop index
-    INTEGER(iwp) ::  k            !< loop index
-    INTEGER(iwp) ::  m            !< mask index
-    INTEGER(iwp) ::  mid            !< masked output running index
-#if defined( __parallel )
-    INTEGER(iwp) ::  ind(6)       !< index limits (lower/upper bounds) of output array
-    INTEGER(iwp) ::  n            !< loop index
-    INTEGER(iwp) ::  sender       !< PE id of sending PE
-#endif
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  tmp_array !< temporary 1D array
-
-    LOGICAL ::  found !< true if variable is found
-
-!
-!-- Initial values are explicitly set here due to a bug in the Cray compiler in case of assignments
-!-- of initial values in declaration statements for arrays with more than 9999 elements
-!-- (appears with -eD only)
-    domask = ' '
-
-!
-!-- Allocation and initialization
-    ALLOCATE( tmp_array( MAX(nx,ny,nz)+2 ) )
-
-    ALLOCATE( mask_i(max_masks,nxr-nxl+2),                                                         &
-              mask_j(max_masks,nyn-nys+2),                                                         &
-              mask_k(max_masks,nzt-nzb+2) )
-!
-!-- internal mask arrays ("mask,dimension,selection")
-    ALLOCATE( mask(max_masks,3,mask_xyz_dimension), mask_loop(max_masks,3,3) )
-
-!
-!-- Parallel mask output not yet supported. In check_parameters data format is restricted and is
-!-- switched back to non-parallel output. Therefore the following error can not occur at the moment.
-    IF ( netcdf_data_format > 4 )  THEN
-       message_string = 'netCDF file formats '//                                                   &
-                        '5 and 6 (with parallel I/O support)'//                                    &
-                        ' are currently not supported.'
-       CALL message( 'init_masks', 'PA0328', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Store data output parameters for masked data output in few shared arrays
-    DO  mid = 1, masks
-
-       do_mask(mid,:)      = data_output_masks(mid,:)
-       do_mask_user(mid,:) = data_output_masks_user(mid,:)
-
-       mask(mid,1,:) = mask_x(mid,:)
-       mask(mid,2,:) = mask_y(mid,:)
-       mask(mid,3,:) = mask_z(mid,:)
-!
-!--    Flag a mask as terrain following
-       IF ( mask_k_over_surface(mid,1) /= -1_iwp )  THEN
-          mask_surface(mid) = .TRUE.
-       ENDIF
-
-       IF ( mask_x_loop(mid,1) == -1.0_wp  .AND.  mask_x_loop(mid,2) == -1.0_wp  .AND.             &
-            mask_x_loop(mid,3) == -1.0_wp )  THEN
-          mask_loop(mid,1,1:2) = -1.0_wp
-          mask_loop(mid,1,3)   =  0.0_wp
-       ELSE
-          mask_loop(mid,1,:) = mask_x_loop(mid,:)
-       ENDIF
-       IF ( mask_y_loop(mid,1) == -1.0_wp  .AND.  mask_y_loop(mid,2) == -1.0_wp  .AND.             &
-            mask_y_loop(mid,3) == -1.0_wp )  THEN
-          mask_loop(mid,2,1:2) = -1.0_wp
-          mask_loop(mid,2,3)   =  0.0_wp
-       ELSE
-          mask_loop(mid,2,:) = mask_y_loop(mid,:)
-       ENDIF
-       IF ( mask_z_loop(mid,1) == -1.0_wp  .AND.  mask_z_loop(mid,2) == -1.0_wp  .AND.             &
-            mask_z_loop(mid,3) == -1.0_wp )  THEN
-          mask_loop(mid,3,1:2) = -1.0_wp
-          mask_loop(mid,3,3)   =  0.0_wp
-       ELSE
-          mask_loop(mid,3,:) = mask_z_loop(mid,:)
-       ENDIF
-
-    ENDDO
-
-    mask_i = -1; mask_j = -1; mask_k = -1
-
-!
-!-- Global arrays are required by define_netcdf_header.
-    IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
-       ALLOCATE( mask_i_global(max_masks,nx+2),                                                    &
-                 mask_j_global(max_masks,ny+2),                                                    &
-                 mask_k_global(max_masks,nz+2) )
-       mask_i_global = -1; mask_j_global = -1; mask_k_global = -1
-    ENDIF
-
-!
-!-- Determine variable names for each mask
-    DO  mid = 1, masks
-!
-!--    Append user-defined data output variables to the standard data output
-       IF ( do_mask_user(mid,1) /= ' ' )  THEN
-          i = 1
-          DO  WHILE ( do_mask(mid,i) /= ' '  .AND.  i <= 100 )
-             i = i + 1
-          ENDDO
-          j = 1
-          DO  WHILE ( do_mask_user(mid,j) /= ' '  .AND.  j <= 100 )
-             IF ( i > 100 )  THEN
-                WRITE ( message_string, * ) 'number of output quantitities ',                      &
-                                            'given by data_output_mask and data_output_mask_user ',&
-                                            'exceeds the limit of 100'
-                CALL message( 'init_masks', 'PA0329', 1, 2, 0, 6, 0 )
-             ENDIF
-             do_mask(mid,i) = do_mask_user(mid,j)
-             i = i + 1
-             j = j + 1
-          ENDDO
-       ENDIF
-
-!
-!--    Check and set steering parameters for mask data output and averaging
-       i   = 1
-       DO WHILE ( do_mask(mid,i) /= ' '  .AND.  i <= 100 )
-!
-!--       Check for data averaging
-          ilen = LEN_TRIM( do_mask(mid,i) )
-          j = 0                                              ! no data averaging
-          IF ( ilen > 3 )  THEN
-             IF ( do_mask(mid,i)(ilen-2:ilen) == '_av' )  THEN
-                j = 1                                           ! data averaging
-                do_mask(mid,i) = do_mask(mid,i)(1:ilen-3)
-             ENDIF
-          ENDIF
-          var = TRIM( do_mask(mid,i) )
-!
-!--       Check for allowed value and set units
-          SELECT CASE ( TRIM( var ) )
-
-             CASE ( 'e' )
-                IF ( constant_diffusion )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires constant_diffusion = .FALSE.'
-                   CALL message( 'init_masks', 'PA0103', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'm2/s2'
-
-             CASE ( 'thetal' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'init_masks', 'PA0108', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'K'
-
-             CASE ( 'nc' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'init_masks', 'PA0108', 1, 2, 0, 6, 0 )
-                ELSEIF ( .NOT. microphysics_morrison )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' // 'requires  = morrison'
-                   CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = '1/m3'
-
-             CASE ( 'ni' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'init_masks', 'PA0108', 1, 2, 0, 6, 0 )
-                 ELSEIF ( .NOT. microphysics_ice_phase )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' //                        &
-                                    'requires  microphysics_ice_phase = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = '1/m3'
-
-             CASE ( 'ng' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                        '" requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'init_masks', 'PA0108', 1, 2, 0, 6, 0 )
-                 ELSEIF ( .NOT. microphysics_ice_phase  .OR.  .NOT.  graupel )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' //                        &
-                         'requires  microphysics_ice_phase = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = '1/m3'
-
-
-             CASE ( 'nr' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'init_masks', 'PA0108', 1, 2, 0, 6, 0 )
-                ELSEIF ( .NOT. microphysics_seifert )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '"' //                         &
-                                    'requires cloud_scheme = seifert_beheng'
-                   CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = '1/m3'
-
-             CASE ( 'ns' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                        '" requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'init_masks', 'PA0108', 1, 2, 0, 6, 0 )
-                 ELSEIF ( .NOT. microphysics_seifert  .OR.  .NOT.  snow)  THEN
-                   message_string = 'output of "' // TRIM( var ) // '"' //                         &
-                         'requires cloud_scheme = seifert_beheng'
-                   CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = '1/m3'
-
-
-             CASE ( 'pc', 'pr' )
-                IF ( .NOT. particle_advection )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires a "particles_par"-NAMELIST in the ',    &
-                                               'parameter file (PARIN)'
-                   CALL message( 'init_masks', 'PA0104', 1, 2, 0, 6, 0 )
-                ENDIF
-                IF ( TRIM( var ) == 'pc' )  unit = 'number'
-                IF ( TRIM( var ) == 'pr' )  unit = 'm'
-
-             CASE ( 'q', 'thetav' )
-                IF ( .NOT. humidity )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires humidity = .TRUE.'
-                   CALL message( 'init_masks', 'PA0105', 1, 2, 0, 6, 0 )
-                ENDIF
-                IF ( TRIM( var ) == 'q'   )  unit = 'kg/kg'
-                IF ( TRIM( var ) == 'thetav' )  unit = 'K'
-
-             CASE ( 'qc' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '"' //                         &
-                                    'requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0108', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'kg/kg'
-
-             CASE ( 'ql' )
-                IF ( .NOT. ( bulk_cloud_model  .OR.  cloud_droplets ) )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires bulk_cloud_model = .TRUE. or ',         &
-                                               'cloud_droplets = .TRUE.'
-                   CALL message( 'init_masks', 'PA0106', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'kg/kg'
-
-             CASE ( 'ql_c', 'ql_v', 'ql_vp' )
-                IF ( .NOT. cloud_droplets )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires cloud_droplets = .TRUE.'
-                   CALL message( 'init_masks', 'PA0107', 1, 2, 0, 6, 0 )
-                ENDIF
-                IF ( TRIM( var ) == 'ql_c'  )  unit = 'kg/kg'
-                IF ( TRIM( var ) == 'ql_v'  )  unit = 'm3'
-                IF ( TRIM( var ) == 'ql_vp' )  unit = 'none'
-
-             CASE ( 'qv' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                        '                      " requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'init_masks', 'PA0108', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'kg/kg'
-
-             CASE ( 'qg' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' //                        &
-                            'requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0108', 1, 2, 0, 6, 0 )
-                ELSEIF ( .NOT. microphysics_ice_phase  .OR.  .NOT.  graupel )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' //                        &
-                            'requires microphysics_ice_phase = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'kg/kg'
-
-             CASE ( 'qi' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' //                        &
-                                    'requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0108', 1, 2, 0, 6, 0 )
-                ELSEIF ( .NOT. microphysics_ice_phase ) THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' //                        &
-                                    'requires microphysics_ice_phase = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'kg/kg'
-
-             CASE ( 'qr' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' //                        &
-                                    'requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0108', 1, 2, 0, 6, 0 )
-                ELSEIF ( .NOT. microphysics_seifert ) THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' //                        &
-                                    'requires cloud_scheme = seifert_beheng'
-                   CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'kg/kg'
-
-             CASE ( 'qs' )
-                IF ( .NOT. bulk_cloud_model )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' //                        &
-                            'requires bulk_cloud_model = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0108', 1, 2, 0, 6, 0 )
-                ELSEIF ( .NOT. microphysics_seifert  .OR.  snow )  THEN
-                   message_string = 'output of "' // TRIM( var ) // '" ' //                        &
-                            'requires cloud_scheme = seifert_beheng'
-                   CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'kg/kg'
-
-
-             CASE ( 'rho_sea_water' )
-                IF ( .NOT. ocean_mode )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires ocean mode'
-                   CALL message( 'init_masks', 'PA0109', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'kg/m3'
-
-             CASE ( 's' )
-                IF ( .NOT. passive_scalar )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ),                         &
-                                               '" requires passive_scalar = .TRUE.'
-                   CALL message( 'init_masks', 'PA0110', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'conc'
-
-             CASE ( 'sa' )
-                IF ( .NOT. ocean_mode )  THEN
-                   WRITE ( message_string, * ) 'output of "', TRIM( var ), '" requires ocean mode'
-                   CALL message( 'init_masks', 'PA0109', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'psu'
-
-             CASE ( 'us*', 't*', 'lwp*', 'pra*', 'prr*', 'z0*', 'z0h*' )
-                WRITE ( message_string, * ) 'illegal value for data_', 'output: "', TRIM( var ),   &
-                                            '" is only allowed', 'for horizontal cross section'
-                CALL message( 'init_masks', 'PA0111', 1, 2, 0, 6, 0 )
-
-             CASE ( 'p', 'theta', 'u', 'v', 'w' )
-                IF ( TRIM( var ) == 'p'  )  unit = 'Pa'
-                IF ( TRIM( var ) == 'theta' )  unit = 'K'
-                IF ( TRIM( var ) == 'u'  )  unit = 'm/s'
-                IF ( TRIM( var ) == 'v'  )  unit = 'm/s'
-                IF ( TRIM( var ) == 'w'  )  unit = 'm/s'
-                CONTINUE
-
-             CASE DEFAULT
-!
-!--             Allocate arrays for other modules
-                CALL module_interface_init_masks( var, unit )
-
-                IF ( unit == 'illegal' )  THEN
-                   IF ( do_mask_user(mid,1) /= ' ' )  THEN
-                      WRITE ( message_string, * ) 'illegal value for data_',                       &
-                                                  'output_masks or data_output_masks_user: "',     &
-                                                  TRIM( do_mask(mid,i) ), '"'
-                      CALL message( 'init_masks', 'PA0018', 1, 2, 0, 6, 0 )
-                   ELSE
-                      WRITE ( message_string, * ) 'illegal value for data_',                       &
-                                                  ' output_masks : "', TRIM( do_mask(mid,i) ), '"'
-                      CALL message( 'init_masks', 'PA0330', 1, 2, 0, 6, 0 )
-                   ENDIF
-                ENDIF
-
-          END SELECT
-!
-!--       Set the internal steering parameters appropriately
-          domask_no(mid,j)                    = domask_no(mid,j) + 1
-          domask(mid,j,domask_no(mid,j))      = do_mask(mid,i)
-          domask_unit(mid,j,domask_no(mid,j)) = unit
-
-          IF ( j == 1 )  THEN
-!
-!--          Check, if variable is already subject to averaging
-             found = .FALSE.
-             DO  k = 1, doav_n
-                IF ( TRIM( doav(k) ) == TRIM( var ) )  found = .TRUE.
-             ENDDO
-
-             IF ( .NOT. found )  THEN
-                doav_n = doav_n + 1
-                doav(doav_n) = var
-             ENDIF
-          ENDIF
-
-          i = i + 1
-
-       ENDDO   ! do_mask(mid,i)
-    ENDDO   ! mid
-
-
-!
-!-- Determine mask locations for each mask
-    DO  mid = 1, masks
-!
-!--    Set local masks for each subdomain along all three dimensions
-       CALL set_mask_locations( 1, dx, 'dx', nx, 'nx', nxl, nxr )
-       CALL set_mask_locations( 2, dy, 'dy', ny, 'ny', nys, nyn )
-       IF ( .NOT. mask_surface(mid) )  THEN
-          CALL set_mask_locations( 3, dz(1), 'dz', nz, 'nz', nzb, nzt )
-       ELSE
-!
-!--       Set vertical mask locations and size in case of terrain-following output
-          count = 0
-          DO  WHILE ( mask_k_over_surface(mid, count+1) >= 0 )
-             m = mask_k_over_surface(mid, count+1)
-             IF ( m < 1 )  THEN
-                WRITE ( message_string, '(I3,A,I3,A)' )  m, ' in mask ', mid, ' must be > 0.'
-                CALL message( 'init_masks', 'PA0743', 1, 2, 0, 6, 0 )
-             ENDIF
-             IF ( m > nz+1 )  THEN
-                WRITE ( message_string, '(I3,A,I3,A,I1,3A,I3)' )  m, ' in mask ', mid,             &
-                                                                  ' along dimension ', 3,          &
-                                                                  ' exceeds (nz+1) = ', nz+1
-                CALL message( 'init_masks', 'PA0331', 1, 2, 0, 6, 0 )
-             ENDIF
-             count = count + 1
-             mask_k(mid,count) = mask_k_over_surface(mid, count)
-             IF ( count == mask_xyz_dimension )  EXIT
-          ENDDO
-          mask_start_l(mid,3) = 1
-          mask_size(mid,3)    = count
-          mask_size_l(mid,3)  = count
-       ENDIF
-!
-!--    Set global masks along all three dimensions (required by define_netcdf_header).
-#if defined( __parallel )
-!
-!--    PE0 receives partial arrays from all processors of the respective mask and outputs them. Here
-!--    a barrier has to be set, because otherwise "-MPI- FATAL: Remote protocol queue full" may
-!--    occur.
-
-       CALL MPI_BARRIER( comm2d, ierr )
-
-       IF ( myid == 0 )  THEN
-!
-!--       Local arrays can be relocated directly.
-          mask_i_global(mid,mask_start_l(mid,1): &
-                       mask_start_l(mid,1)+mask_size_l(mid,1)-1) = &
-                       mask_i(mid,:mask_size_l(mid,1))
-          mask_j_global(mid,mask_start_l(mid,2): &
-                       mask_start_l(mid,2)+mask_size_l(mid,2)-1) = &
-                       mask_j(mid,:mask_size_l(mid,2))
-          mask_k_global(mid,mask_start_l(mid,3): &
-                       mask_start_l(mid,3)+mask_size_l(mid,3)-1) = &
-                       mask_k(mid,:mask_size_l(mid,3))
-!
-!--       Receive data from all other PEs.
-          DO  n = 1, numprocs-1
-!
-!--          Receive index limits first, then arrays.
-!--          Index limits are received in arbitrary order from the PEs.
-             CALL MPI_RECV( ind(1), 6, MPI_INTEGER, MPI_ANY_SOURCE, 0, comm2d, status, ierr )
-!
-!--          Not all PEs have data for the mask.
-             IF ( ind(1) /= -9999 )  THEN
-                sender = status(MPI_SOURCE)
-                CALL MPI_RECV( tmp_array(ind(1)), ind(2)-ind(1)+1, MPI_INTEGER, sender, 1, comm2d, &
-                               status, ierr )
-                mask_i_global(mid,ind(1):ind(2)) = tmp_array(ind(1):ind(2))
-                CALL MPI_RECV( tmp_array(ind(3)), ind(4)-ind(3)+1, MPI_INTEGER, sender, 2, comm2d, &
-                               status, ierr )
-                mask_j_global(mid,ind(3):ind(4)) = tmp_array(ind(3):ind(4))
-                CALL MPI_RECV( tmp_array(ind(5)), ind(6)-ind(5)+1, MPI_INTEGER, sender, 3, comm2d, &
-                               status, ierr )
-                mask_k_global(mid,ind(5):ind(6)) = tmp_array(ind(5):ind(6))
-             ENDIF
-          ENDDO
-
-       ELSE
-!
-!--       If at least part of the mask resides on the PE, send the index limits for the target
-!--       array, otherwise send -9999 to PE0.
-          IF ( mask_size_l(mid,1) > 0  .AND.  mask_size_l(mid,2) > 0  .AND.                        &
-               mask_size_l(mid,3) > 0  )  THEN
-             ind(1) = mask_start_l(mid,1)
-             ind(2) = mask_start_l(mid,1) + mask_size_l(mid,1) - 1
-             ind(3) = mask_start_l(mid,2)
-             ind(4) = mask_start_l(mid,2) + mask_size_l(mid,2) - 1
-             ind(5) = mask_start_l(mid,3)
-             ind(6) = mask_start_l(mid,3) + mask_size_l(mid,3) - 1
-          ELSE
-             ind(1) = -9999; ind(2) = -9999
-             ind(3) = -9999; ind(4) = -9999
-             ind(5) = -9999; ind(6) = -9999
-          ENDIF
-          CALL MPI_SEND( ind(1), 6, MPI_INTEGER, 0, 0, comm2d, ierr )
-!
-!--       If applicable, send data to PE0.
-          IF ( ind(1) /= -9999 )  THEN
-             tmp_array(:mask_size_l(mid,1)) = mask_i(mid,:mask_size_l(mid,1))
-             CALL MPI_SEND( tmp_array(1), mask_size_l(mid,1), MPI_INTEGER, 0, 1, comm2d, ierr )
-             tmp_array(:mask_size_l(mid,2)) = mask_j(mid,:mask_size_l(mid,2))
-             CALL MPI_SEND( tmp_array(1), mask_size_l(mid,2), MPI_INTEGER, 0, 2, comm2d, ierr )
-             tmp_array(:mask_size_l(mid,3)) = mask_k(mid,:mask_size_l(mid,3))
-             CALL MPI_SEND( tmp_array(1), mask_size_l(mid,3), MPI_INTEGER, 0, 3, comm2d, ierr )
-          ENDIF
-       ENDIF
-!
-!--    A barrier has to be set, because otherwise some PEs may proceed too fast so that PE0 may
-!--    receive wrong data on tag 0.
-       CALL MPI_BARRIER( comm2d, ierr )
-
-       IF ( netcdf_data_format > 4 )  THEN
-
-          CALL MPI_BCAST( mask_i_global(mid,:), nx+2, MPI_INTEGER, 0, comm2d, ierr )
-          CALL MPI_BCAST( mask_j_global(mid,:), ny+2, MPI_INTEGER, 0, comm2d, ierr )
-          CALL MPI_BCAST( mask_k_global(mid,:), nz+2, MPI_INTEGER, 0, comm2d, ierr )
-
-       ENDIF
-
-#else
-!
-!--    Local arrays can be relocated directly.
-       mask_i_global(mid,:) = mask_i(mid,:)
-       mask_j_global(mid,:) = mask_j(mid,:)
-       mask_k_global(mid,:) = mask_k(mid,:)
-#endif
-    ENDDO   ! mid
-
-    DEALLOCATE( tmp_array )
-!
-!-- Internal mask arrays cannot be deallocated on PE 0 because they are required for header output
-!-- on PE 0.
-    IF ( myid /= 0 )  DEALLOCATE( mask, mask_loop )
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set local mask for each subdomain along 'dim' direction.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE set_mask_locations( dim, dxyz, dxyz_string, nxyz, nxyz_string, lb, ub )
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=2) ::  dxyz_string !<
-       CHARACTER (LEN=2) ::  nxyz_string !<
-
-       INTEGER(iwp)  ::  count       !<
-       INTEGER(iwp)  ::  count_l     !<
-       INTEGER(iwp)  ::  dim         !<
-       INTEGER(iwp)  ::  m           !<
-       INTEGER(iwp)  ::  loop_begin  !<
-       INTEGER(iwp)  ::  loop_end    !<
-       INTEGER(iwp)  ::  loop_stride !<
-       INTEGER(iwp)  ::  lb          !<
-       INTEGER(iwp)  ::  nxyz        !<
-       INTEGER(iwp)  ::  ub          !<
-
-       REAL(wp)      ::  dxyz  !<
-       REAL(wp)      ::  ddxyz !<
-       REAL(wp)      ::  tmp1  !<
-       REAL(wp)      ::  tmp2  !<
-
-       count = 0;  count_l = 0
-       ddxyz = 1.0_wp / dxyz
-       tmp1  = 0.0_wp
-       tmp2  = 0.0_wp
-
-       IF ( mask(mid,dim,1) >= 0.0_wp )  THEN
-!
-!--       Use predefined mask_* array
-          DO  WHILE ( mask(mid,dim,count+1) >= 0.0_wp )
-             count = count + 1
-             IF ( dim == 1  .OR.  dim == 2 )  THEN
-                m = NINT( mask(mid,dim,count) * mask_scale(dim) * ddxyz - 0.5_wp )
-                IF ( m < 0 )  m = 0  ! avoid negative values
-             ELSEIF ( dim == 3 )  THEN
-                ind_array =  &
-                     MINLOC( ABS( mask(mid,dim,count) * mask_scale(dim) - zu ) )
-                m = ind_array(1) - 1 + nzb  ! MINLOC uses lower array bound 1
-             ENDIF
-             IF ( m > (nxyz+1) )  THEN
-                WRITE ( message_string, '(I3,A,I3,A,I1,3A,I3)' )  m, ' in mask ', mid,             &
-                                                                  ' along dimension ' ,dim,        &
-                                                                  ' exceeds (' ,nxyz_string,       &
-                                                                  '+1) = ', nxyz+1
-                CALL message( 'init_masks', 'PA0331', 1, 2, 0, 6, 0 )
-             ENDIF
-             IF ( ( m >= lb  .AND.  m <= ub )  .OR.  ( m == (nxyz+1)  .AND.  ub == nxyz )  )  THEN
-                IF ( count_l == 0 )  mask_start_l(mid,dim) = count
-                count_l = count_l + 1
-                IF ( dim == 1 )  THEN
-                   mask_i(mid,count_l) = m
-                ELSEIF ( dim == 2 )  THEN
-                   mask_j(mid,count_l) = m
-                ELSEIF ( dim == 3 )  THEN
-                   mask_k(mid,count_l) = m
-                ENDIF
-             ENDIF
-             IF ( count == mask_xyz_dimension )  EXIT
-          ENDDO
-          mask_size(mid,dim)   = count
-          mask_size_l(mid,dim) = count_l
-
-       ELSE
-!
-!--       Use predefined mask_loop_* array, or use the default (all grid points along this
-!--       direction)
-          IF ( mask_loop(mid,dim,1) < 0.0_wp )  THEN
-             tmp1 = mask_loop(mid,dim,1)
-             mask_loop(mid,dim,1) = zw(nzb)  !   lowest level  (default)
-          ENDIF
-          IF ( dim == 1 .OR. dim == 2 )  THEN
-             IF ( mask_loop(mid,dim,2) < 0.0_wp )  THEN
-                tmp2 = mask_loop(mid,dim,2)
-                mask_loop(mid,dim,2) = nxyz*dxyz / mask_scale(dim)   ! (default)
-             ENDIF
-             IF ( MAXVAL( mask_loop(mid,dim,1:2) )  &
-                  > (nxyz+1) * dxyz / mask_scale(dim) )  THEN
-                WRITE ( message_string, '(2(A,I3,A,I1,A,F9.3),5A,I1,A,F9.3)' )                     &
-                     'mask_loop(', mid, ',', dim, ',1)=', mask_loop(mid,dim,1),                    &
-                     ' and/or mask_loop(', mid, ',', dim, ',2)=', mask_loop(mid,dim,2),            &
-                     ' exceed (', nxyz_string,'+1)*',dxyz_string,'/mask_scale(',dim,')=',          &
-                     (nxyz+1)*dxyz/mask_scale(dim)
-                CALL message( 'init_masks', 'PA0332', 1, 2, 0, 6, 0 )
-             ENDIF
-             loop_begin  = NINT( mask_loop(mid,dim,1) * mask_scale(dim) * ddxyz - 0.5_wp )
-             loop_end    = NINT( mask_loop(mid,dim,2) * mask_scale(dim) * ddxyz - 0.5_wp )
-             loop_stride = NINT( mask_loop(mid,dim,3) * mask_scale(dim) * ddxyz )
-             IF ( loop_begin == -1 )  loop_begin = 0  ! avoid negative values
-          ELSEIF ( dim == 3 )  THEN
-             IF ( mask_loop(mid,dim,2) < 0.0_wp )  THEN
-                tmp2 = mask_loop(mid,dim,2)
-                mask_loop(mid,dim,2) = zu(nz+1) / mask_scale(dim)   ! (default)
-             ENDIF
-             IF ( MAXVAL( mask_loop(mid,dim,1:2) ) > zu(nz+1) / mask_scale(dim) )  THEN
-                WRITE ( message_string, '(2(A,I3,A,I1,A,F9.3),A,I1,A,F9.3)' )                      &
-                      'mask_loop(', mid, ',', dim, ',1)=', mask_loop(mid,dim,1),                   &
-                      ' and/or mask_loop(', mid, ',', dim, ',2)=', mask_loop(mid,dim,2),           &
-                      ' exceed zu(nz+1)/mask_scale(', dim, ')=',zu(nz+1)/mask_scale(dim)
-                CALL message( 'init_masks', 'PA0333', 1, 2, 0, 6, 0 )
-             ENDIF
-             ind_array  = MINLOC( ABS( mask_loop(mid,dim,1) * mask_scale(dim) - zu ) )
-             loop_begin = ind_array(1) - 1 + nzb ! MINLOC uses lower array bound 1
-             ind_array  = MINLOC( ABS( mask_loop(mid,dim,2) * mask_scale(dim) - zu ) )
-             loop_end   = ind_array(1) - 1 + nzb ! MINLOC uses lower array bound 1
-!
-!--          The following line assumes a constant vertical grid spacing within the vertical mask
-!--          range; it fails for vertical grid stretching.
-!--          Maybe revise later. Issue warning but continue execution. ABS(...) within the IF
-!--          statement is necessary because the default value of dz_stretch_level_start is
-!--          -9999999.9_wp.
-             loop_stride = NINT( mask_loop(mid,dim,3) * mask_scale(dim) * ddxyz )
-
-             IF ( mask_loop(mid,dim,2) * mask_scale(dim) > ABS( dz_stretch_level_start(1) ) )  THEN
-                WRITE ( message_string, '(A,I3,A,I1,A,F9.3,A,F8.2,3A)' )                           &
-                      'mask_loop(', mid, ',', dim, ',2)=', mask_loop(mid,dim,2),                   &
-                      ' exceeds dz_stretch_level=', dz_stretch_level_start(1),                     &
-                      '.&Vertical mask locations will not ',                                       &
-                      'match the desired heights within the stretching ', 'region.'
-                CALL message( 'init_masks', 'PA0334', 0, 1, 0, 6, 0 )
-             ENDIF
-
-          ENDIF
-!
-!--       If necessary, reset mask_loop(mid,dim,1) and mask_loop(mid,dim,2).
-          IF ( tmp1 < 0.0_wp )  mask_loop(mid,dim,1) = tmp1
-          IF ( tmp2 < 0.0_wp )  mask_loop(mid,dim,2) = tmp2
-!
-!--       The default stride +/-1 (every grid point) applies if mask_loop(mid,dim,3) is not
-!--       specified (its default is zero).
-          IF ( loop_stride == 0 )  THEN
-             IF ( loop_end >= loop_begin )  THEN
-                loop_stride =  1
-             ELSE
-                loop_stride = -1
-             ENDIF
-          ENDIF
-          DO  m = loop_begin, loop_end, loop_stride
-             count = count + 1
-             IF ( ( m >= lb  .AND.  m <= ub ) .OR.  ( m == (nxyz+1) .AND. ub == nxyz )  )  THEN
-                IF ( count_l == 0 )  mask_start_l(mid,dim) = count
-                count_l = count_l + 1
-                IF ( dim == 1 )  THEN
-                   mask_i(mid,count_l) = m
-                ELSEIF ( dim == 2 )  THEN
-                   mask_j(mid,count_l) = m
-                ELSEIF ( dim == 3 )  THEN
-                   mask_k(mid,count_l) = m
-                ENDIF
-             ENDIF
-          ENDDO
-          mask_size(mid,dim)   = count
-          mask_size_l(mid,dim) = count_l
-
-       ENDIF
-
-    END SUBROUTINE set_mask_locations
-
- END SUBROUTINE init_masks
Index: palm/trunk/SOURCE/init_particles.f90
===================================================================
--- palm/trunk/SOURCE/init_particles.f90	(revision 1)
+++ palm/trunk/SOURCE/init_particles.f90	(revision 1)
@@ -0,0 +1,648 @@
+ SUBROUTINE init_particles
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: init_particles.f90,v $
+! Revision 1.24  2007/02/11 13:00:17  raasch
+! Bugfix: allocation of tail_mask and new_tail_id in case of restart-runs
+! Bugfix: __ was missing in a cpp-directive
+!
+! Revision 1.23  2006/08/22 14:11:08  raasch
+! Default settings of particle start positions changed
+!
+! Revision 1.22  2006/08/04 14:44:58  raasch
+! New particles attributes initialized (e_m, dt_sum, speed_x/y/z_sgs),
+! total length of mpi_particle_type adjusted, more than one particle can be
+! released per point, izuf renamed iran, set a special seed value iran_part
+! to be used for the particle advection code, determination of particle group
+! number removed from header to here
+!
+! Revision 1.21  2006/03/14 12:55:24  raasch
+! Determination of the number of particle groups removed
+!
+! Revision 1.20  2006/02/23 12:34:00  raasch
+! Allocation of prt_start_index and prt_count + calling subroutine
+! sort_particles,
+! particle source parameters psl, psr, pss, psn, psb, pst, pdx, pdy, pdz are now
+! 1D arrays (1:max_number_of_particle_groups) and allow up to specify
+! max_number_of_particle_groups different sources by setting
+! number_of_particle_groups >= 1 even if density_ratio is not specified,
+! only a fraction of the particles may have tails, therefore input from unit 90
+! has changed,
+! 0.5 replaced by 0.4999999999 in setting the random fluctuations,
+! Defaults of psl, psr, pss, psn adjusted.
+! If the number of particle groups is set by the user, density_ratio is reset to
+! default.
+! In case of user-specified pdx, pdy, pdz = 0.0 reset them to defaults,
+! improve particle release at PE boundaries, nt_anz renamed
+! current_timestep_number
+!
+! Revision 1.19  2005/06/26 19:56:47  raasch
+! particle_groups%radius is used instead of diameter, particle%radius is
+! initialized, new initial informations about radius and weighting factor
+! stored on array particles, total length of mpi_particle_type adjusted
+!
+! Revision 1.18  2004/04/30 12:03:28  raasch
+! MPI data type for particles modified due to modification of FORTRAN particle
+! type
+!
+! Revision 1.17  2003/10/29 08:55:35  raasch
+! Module random_function_mod is used, version check of the binary file,
+! modifications for new particle group feature
+!
+! Revision 1.16  2003/03/16 09:39:51  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.15  2003/03/04 11:30:48  raasch
+! Displacement for integers in mpi_particle_type reduced from 16 to 8 on
+! ibm, since integers seem to be only 4 byte long. Accordingly, total length
+! reduced from 104 to 96.
+!
+! Revision 1.14  2002/12/19 15:39:48  raasch
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.13  2002/09/12 13:04:13  raasch
+! Read density_ratio from restart file
+!
+! Revision 1.12  2002/04/16 08:08:34  raasch
+! New initial informations about speed components and start positions stored on
+! array particles. Check boundary conditions and read them from restart file.
+!
+! Revision 1.11  2001/11/12 16:06:06  raasch
+! Array particle_tail_coordinates extended to contain colour informations,
+! reading particle data from restart file can be prohibited
+!
+! Revision 1.9  2001/08/21 09:49:05  raasch
+! Particle tail is initialized
+!
+! Revision 1.8  2001/07/12 12:10:58  raasch
+! Particle sources (starting positions) are now controlled by parameters
+!
+! Revision 1.7  2001/03/30 07:31:37  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.6  2001/01/25 07:05:36  raasch
+! Writing of particle informations is optional now
+!
+! Revision 1.5  2001/01/22 07:16:17  raasch
+! Module test_particles removed
+!
+! Revision 1.4  2001/01/02 17:30:16  raasch
+! Opening of unit 80 moved to check_open. Unit 90 instead of 81 is used
+! for binary input.
+!
+! Revision 1.3  2000/12/28 13:15:58  raasch
+! Complete revision due to new features of dvrp-software,
+! all comments translated into English,
+! code is used only optionally (cpp-directives are added)
+!
+! Revision 1.2  2000/04/27 06:38:48  raasch
+! compute position of camera with new indepent routine vtk_camera and
+! store result on a separate file
+!
+! 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, ..). Advection of these particles is carried out by advec_particles,
+! plotting is done in data_output_dvrp.
+!------------------------------------------------------------------------------!
+#if defined( __particles )
+
+    USE arrays_3d
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE particle_attributes
+    USE pegrid
+    USE random_function_mod
+
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=10) ::  particle_binary_version, version_on_file
+
+    INTEGER ::  i, j, n, nn
+#if defined( __parallel )
+    INTEGER, DIMENSION(3) ::  blocklengths, displacements, types
+#endif
+    LOGICAL ::  uniform_particles_l
+    REAL    ::  factor, pos_x, pos_y, pos_z, value
+
+
+#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 (=> total
+!-- length 100, nevertheless, 120 bytes are needed on T3E since integer seems
+!-- to be 8 bytes long there)
+    blocklengths(1)  = 18; blocklengths(2)  = 4; blocklengths(3)  =  1
+#if defined( __t3eb )
+    displacements(1) = 0; displacements(2) = 144; displacements(3) = 176
+#else
+    displacements(1) = 0; displacements(2) = 144; displacements(3) = 160
+#endif
+    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
+
+!
+!-- Check the number of particle groups.
+    IF ( number_of_particle_groups > max_number_of_particle_groups )  THEN
+       PRINT*, '+++ WARNING: init_particles: ', &
+                    'max_number_of_particle_groups =', &
+               max_number_of_particle_groups
+       PRINT*, '+++          number_of_particle_groups reset to ', &
+               max_number_of_particle_groups
+       number_of_particle_groups = max_number_of_particle_groups
+    ENDIF
+
+!
+!-- Set default start positions, if necessary
+    IF ( psl(1) == 9999999.9 )  psl(1) = -0.5 * dx
+    IF ( psr(1) == 9999999.9 )  psr(1) = ( nx + 0.5 ) * dx
+    IF ( pss(1) == 9999999.9 )  pss(1) = -0.5 * dy
+    IF ( psn(1) == 9999999.9 )  psn(1) = ( ny + 0.5 ) * dy
+    IF ( psb(1) == 9999999.9 )  psb(1) = zu(nz/2)
+    IF ( pst(1) == 9999999.9 )  pst(1) = psb(1)
+
+    IF ( pdx(1) == 9999999.9  .OR.  pdx(1) == 0.0 )  pdx(1) = dx
+    IF ( pdy(1) == 9999999.9  .OR.  pdy(1) == 0.0 )  pdy(1) = dy
+    IF ( pdz(1) == 9999999.9  .OR.  pdz(1) == 0.0 )  pdz(1) = zu(2) - zu(1)
+
+    DO  j = 2, number_of_particle_groups
+       IF ( psl(j) == 9999999.9 )  psl(j) = psl(j-1)
+       IF ( psr(j) == 9999999.9 )  psr(j) = psr(j-1)
+       IF ( pss(j) == 9999999.9 )  pss(j) = pss(j-1)
+       IF ( psn(j) == 9999999.9 )  psn(j) = psn(j-1)
+       IF ( psb(j) == 9999999.9 )  psb(j) = psb(j-1)
+       IF ( pst(j) == 9999999.9 )  pst(j) = pst(j-1)
+       IF ( pdx(j) == 9999999.9  .OR.  pdx(j) == 0.0 )  pdx(j) = pdx(j-1)
+       IF ( pdy(j) == 9999999.9  .OR.  pdy(j) == 0.0 )  pdy(j) = pdy(j-1)
+       IF ( pdz(j) == 9999999.9  .OR.  pdz(j) == 0.0 )  pdz(j) = pdz(j-1)
+    ENDDO
+
+!
+!-- For the first model run of a possible job chain initialize the
+!-- particles, otherwise read the particle data from file.
+    IF ( TRIM( initializing_actions ) == 'read_restart_data'  &
+         .AND.  read_particles_from_restartfile )  THEN
+
+!
+!--    Read particle data from previous model run.
+!--    First open the input unit.
+       IF ( myid_char == '' )  THEN
+          OPEN ( 90, FILE='PARTICLE_RESTART_DATA_IN'//myid_char, &
+                     FORM='UNFORMATTED' )
+       ELSE
+          OPEN ( 90, FILE='PARTICLE_RESTART_DATA_IN/'//myid_char, &
+                     FORM='UNFORMATTED' )
+       ENDIF
+
+!
+!--    First compare the version numbers
+       READ ( 90 )  version_on_file
+       particle_binary_version = '3.0'
+       IF ( TRIM( version_on_file ) /= TRIM( particle_binary_version ) )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ init_particles: version mismatch concerning data ', &
+                     'from prior run'
+             PRINT*, '        version on file    = "', TRIM( version_on_file ),&
+                     '"'
+             PRINT*, '        version in program = "', &
+                     TRIM( particle_binary_version ), '"'
+          ENDIF
+          CALL local_stop
+       ENDIF
+
+!
+!--    Read some particle parameters and the size of the particle arrays,
+!--    allocate them and read their contents.
+       READ ( 90 )  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t,                  &
+                    maximum_number_of_particles, maximum_number_of_tailpoints, &
+                    maximum_number_of_tails, number_of_initial_particles,      &
+                    number_of_particles, number_of_particle_groups,            &
+                    number_of_tails, particle_groups, time_prel,               &
+                    time_write_particle_data, uniform_particles
+
+       IF ( number_of_initial_particles /= 0 )  THEN
+          ALLOCATE( initial_particles(1:number_of_initial_particles) )
+          READ ( 90 )  initial_particles
+       ENDIF
+
+       ALLOCATE( prt_count(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),       &
+                 prt_start_index(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+                 particle_mask(maximum_number_of_particles),         &
+                 particles(maximum_number_of_particles) )
+
+       READ ( 90 )  prt_count, prt_start_index
+       READ ( 90 )  particles
+
+       IF ( use_particle_tails )  THEN
+          ALLOCATE( particle_tail_coordinates(maximum_number_of_tailpoints,5, &
+                    maximum_number_of_tails),                                 &
+                    new_tail_id(maximum_number_of_tails),                     &
+                    tail_mask(maximum_number_of_tails) )
+          READ ( 90 )  particle_tail_coordinates
+       ENDIF
+
+       CLOSE ( 90 )
+
+    ELSE
+
+!
+!--    Allocate particle arrays and set attributes of the initial set of
+!--    particles, which can be also periodically released at later times.
+!--    Also allocate array for particle tail coordinates, if needed.
+       ALLOCATE( prt_count(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),       &
+                 prt_start_index(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+                 particle_mask(maximum_number_of_particles),         &
+                 particles(maximum_number_of_particles) )
+
+!
+!--    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.
+       particles = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+                                  0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+                                  0, 0, 0, 0 )
+       particle_groups = particle_groups_type( 0.0, 0.0, 0.0, 0.0 )
+
+!
+!--    Set the default particle size used for dvrp plots
+       IF ( dvrp_psize == 9999999.9 )  dvrp_psize = 0.2 * dx
+
+!
+!--    Set values for the density ratio and radius for all particle
+!--    groups, if necessary
+       IF ( density_ratio(1) == 9999999.9 )  density_ratio(1) = 0.0
+       IF ( radius(1)        == 9999999.9 )  radius(1) = 0.0
+       DO  i = 2, number_of_particle_groups
+          IF ( density_ratio(i) == 9999999.9 )  THEN
+             density_ratio(i) = density_ratio(i-1)
+          ENDIF
+          IF ( radius(i) == 9999999.9 )  radius(i) = radius(i-1)
+       ENDDO
+
+       DO  i = 1, number_of_particle_groups
+          IF ( density_ratio(i) /= 0.0  .AND.  radius(i) == 0 )  THEN
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ init_particles: particle group #', i, 'has a', &
+                        'density ratio /= 0 but radius = 0'
+             ENDIF
+             CALL local_stop
+          ENDIF
+          particle_groups(i)%density_ratio = density_ratio(i)
+          particle_groups(i)%radius        = radius(i)
+       ENDDO
+
+!
+!--    Calculate particle positions and store particle attributes, if
+!--    particle is situated on this PE
+       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 ) * dy  .AND.  &
+                     pos_y <  ( nyn + 0.5 ) * dy )  THEN
+
+                   pos_x = psl(i)
+
+                   DO WHILE ( pos_x <= psr(i) )
+
+                      IF ( pos_x >= ( nxl - 0.5 ) * dx  .AND.  &
+                           pos_x <  ( nxr + 0.5 ) * dx )  THEN
+
+                         DO  j = 1, particles_per_point
+
+                            n = n + 1
+                            IF ( n > maximum_number_of_particles )  THEN
+                               PRINT*,'+++ init_particles: number of initial', &
+                                      ' particles (', n, ') exceeds'
+                               PRINT*,'    maximum_number_of_particles (',     &
+                                      maximum_number_of_particles, ') on PE ', &
+                                      myid
+#if defined( __parallel )
+                               CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+                               CALL local_stop
+#endif
+                            ENDIF
+                            particles(n)%x             = pos_x
+                            particles(n)%y             = pos_y
+                            particles(n)%z             = pos_z
+                            particles(n)%age           = 0.0
+                            particles(n)%dt_sum        = 0.0
+                            particles(n)%dvrp_psize    = dvrp_psize
+                            particles(n)%e_m           = 0.0
+                            particles(n)%speed_x       = 0.0
+                            particles(n)%speed_x_sgs   = 0.0
+                            particles(n)%speed_y       = 0.0
+                            particles(n)%speed_y_sgs   = 0.0
+                            particles(n)%speed_z       = 0.0
+                            particles(n)%speed_z_sgs   = 0.0
+                            particles(n)%origin_x      = pos_x
+                            particles(n)%origin_y      = pos_y
+                            particles(n)%origin_z      = pos_z
+                            particles(n)%radius      = particle_groups(i)%radius
+                            particles(n)%weight_factor =initial_weighting_factor
+                            particles(n)%color         = 1
+                            particles(n)%group         = i
+                            particles(n)%tailpoints    = 0
+                            IF ( use_particle_tails  .AND. &
+                                 MOD( n, skip_particles_for_tail ) == 0 )  THEN
+                               number_of_tails         = number_of_tails + 1
+!
+!--                            This is a temporary provisional setting (see
+!--                            further below!)
+                               particles(n)%tail_id    = number_of_tails
+                            ELSE
+                               particles(n)%tail_id    = 0
+                            ENDIF
+
+                         ENDDO
+
+                      ENDIF
+
+                      pos_x = pos_x + pdx(i)
+
+                   ENDDO
+
+                ENDIF
+
+                pos_y = pos_y + pdy(i)
+
+             ENDDO
+
+             pos_z = pos_z + pdz(i)
+
+          ENDDO
+
+       ENDDO
+
+       number_of_initial_particles = n
+       number_of_particles         = n
+
+!
+!--    Calculate the number of particles and tails of the total domain
+#if defined( __parallel )
+       CALL MPI_ALLREDUCE( number_of_particles, total_number_of_particles, 1, &
+                           MPI_REAL, MPI_SUM, comm2d, ierr )
+       CALL MPI_ALLREDUCE( number_of_tails, total_number_of_tails, 1, &
+                           MPI_REAL, MPI_SUM, comm2d, ierr )
+#else
+       total_number_of_particles = number_of_particles
+       total_number_of_tails     = number_of_tails
+#endif
+
+!
+!--    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
+
+!
+!--    User modification of initial particles
+       CALL user_init_particles
+
+!
+!--    Store the initial set of particles for release at later times
+       IF ( number_of_initial_particles /= 0 )  THEN
+          ALLOCATE( initial_particles(1:number_of_initial_particles) )
+          initial_particles(1:number_of_initial_particles) = &
+                                        particles(1:number_of_initial_particles)
+       ENDIF
+
+!
+!--    Add random fluctuation to particle positions
+       IF ( random_start_position )  THEN
+
+          iran = iran + myid    ! Random positions should be different on
+                                ! different PEs
+
+          DO  n = 1, number_of_initial_particles
+             IF ( psl(particles(n)%group) /= psr(particles(n)%group) )  THEN
+                particles(n)%x = particles(n)%x + &
+                                 ( random_function( iran ) - 0.5 ) * &
+                                 pdx(particles(n)%group)
+                IF ( particles(n)%x  <=  ( nxl - 0.5 ) * dx )  THEN
+                   particles(n)%x = ( nxl - 0.4999999999 ) * dx
+                ELSEIF ( particles(n)%x  >=  ( nxr + 0.5 ) * dx )  THEN
+                   particles(n)%x = ( nxr + 0.4999999999 ) * dx
+                ENDIF
+             ENDIF
+             IF ( pss(particles(n)%group) /= psn(particles(n)%group) )  THEN
+                particles(n)%y = particles(n)%y + &
+                                 ( random_function( iran ) - 0.5 ) * &
+                                 pdy(particles(n)%group)
+                IF ( particles(n)%y  <=  ( nys - 0.5 ) * dy )  THEN
+                   particles(n)%y = ( nys - 0.4999999999 ) * dy
+                ELSEIF ( particles(n)%y  >=  ( nyn + 0.5 ) * dy )  THEN
+                   particles(n)%y = ( nyn + 0.4999999999 ) * dy
+                ENDIF
+             ENDIF
+             IF ( psb(particles(n)%group) /= pst(particles(n)%group) )  THEN
+                particles(n)%z = particles(n)%z + &
+                                 ( random_function( iran ) - 0.5 ) * &
+                                 pdz(particles(n)%group)
+             ENDIF
+          ENDDO
+       ENDIF
+
+!
+!--    Sort particles in the sequence the gridboxes are stored in the memory
+       CALL sort_particles
+
+!
+!--    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_initial_particles,             &
+                              maximum_number_of_particles
+          CALL close_file( 80 )
+       ENDIF
+
+!
+!--    Check if particles are really uniform in color and radius (dvrp_size)
+!--    (uniform_particles is preset TRUE)
+       IF ( uniform_particles )  THEN
+          IF ( number_of_initial_particles == 0 )  THEN
+             uniform_particles_l = .TRUE.
+          ELSE
+             n = number_of_initial_particles
+             IF ( MINVAL( particles(1:n)%dvrp_psize  ) ==     &
+                  MAXVAL( particles(1:n)%dvrp_psize  )  .AND. &
+                  MINVAL( particles(1:n)%color ) ==     &
+                  MAXVAL( particles(1:n)%color ) )  THEN
+                uniform_particles_l = .TRUE.
+             ELSE
+                uniform_particles_l = .FALSE.
+             ENDIF
+          ENDIF
+
+#if defined( __parallel )
+          CALL MPI_ALLREDUCE( uniform_particles_l, uniform_particles, 1, &
+                              MPI_LOGICAL, MPI_LAND, comm2d, ierr )
+#else
+          uniform_particles = uniform_particles_l
+#endif
+
+       ENDIF
+
+!
+!--    Set the beginning of the particle tails and their age
+       IF ( use_particle_tails )  THEN
+!
+!--       Choose the maximum number of tails significantly larger than the
+!--       one initially required
+          factor = 10.0
+          value  = number_of_tails
+          DO WHILE ( value / 10.0 >= 1.0 )
+             factor = factor * 10.0
+             value  = value / 10.0
+          ENDDO
+          maximum_number_of_tails = factor * INT( value )
+
+          ALLOCATE( particle_tail_coordinates(maximum_number_of_tailpoints,5, &
+                    maximum_number_of_tails),                                 &
+                    new_tail_id(maximum_number_of_tails),                     &
+                    tail_mask(maximum_number_of_tails) )
+
+          particle_tail_coordinates  = 0.0
+          minimum_tailpoint_distance = minimum_tailpoint_distance**2
+          number_of_initial_tails    = number_of_tails
+
+          nn = 0
+          DO  n = 1, number_of_particles
+!
+!--          Only for those particles marked above with a provisional tail_id
+!--          tails will be created. Particles now get their final tail_id.
+             IF ( particles(n)%tail_id /= 0 )  THEN
+
+                nn = nn + 1
+                particles(n)%tail_id = nn
+
+                particle_tail_coordinates(1,1,nn) = particles(n)%x
+                particle_tail_coordinates(1,2,nn) = particles(n)%y
+                particle_tail_coordinates(1,3,nn) = particles(n)%z
+                particle_tail_coordinates(1,4,nn) = particles(n)%color
+                particles(n)%tailpoints = 1
+                IF ( minimum_tailpoint_distance /= 0.0 )  THEN
+                   particle_tail_coordinates(2,1,nn) = particles(n)%x
+                   particle_tail_coordinates(2,2,nn) = particles(n)%y
+                   particle_tail_coordinates(2,3,nn) = particles(n)%z
+                   particle_tail_coordinates(2,4,nn) = particles(n)%color
+                   particle_tail_coordinates(1:2,5,nn) = 0.0
+                   particles(n)%tailpoints = 2
+                ENDIF
+
+             ENDIF
+          ENDDO
+       ENDIF
+
+!
+!--    Plot initial positions of particles (only if particle advection is
+!--    switched on from the beginning of the simulation (t=0))
+       IF ( particle_advection_start == 0.0 )  CALL data_output_dvrp
+
+    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
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ init_particles: unknown boundary condition ',   &
+                         'bc_par_b = "', TRIM( bc_par_b ), '"'
+          ENDIF
+          CALL local_stop
+          
+    END SELECT
+    SELECT CASE ( bc_par_t )
+    
+       CASE ( 'absorb' )
+          ibc_par_t = 1
+
+       CASE ( 'reflect' )
+          ibc_par_t = 2
+          
+       CASE DEFAULT
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ init_particles: unknown boundary condition ',   &
+                         'bc_par_t = "', TRIM( bc_par_t ), '"'
+          ENDIF
+          CALL local_stop
+          
+    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
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ init_particles: unknown boundary condition ',   &
+                         'bc_par_lr = "', TRIM( bc_par_lr ), '"'
+          ENDIF
+          CALL local_stop
+          
+    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
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ init_particles: unknown boundary condition ',   &
+                         'bc_par_ns = "', TRIM( bc_par_ns ), '"'
+          ENDIF
+          CALL local_stop
+          
+    END SELECT
+!
+!-- Formats
+8000 FORMAT (I6,1X,F7.2,4X,I6,71X,I6)
+
+#endif
+ END SUBROUTINE init_particles
Index: palm/trunk/SOURCE/init_pegrid.f90
===================================================================
--- palm/trunk/SOURCE/init_pegrid.f90	(revision 4901)
+++ palm/trunk/SOURCE/init_pegrid.f90	(revision 1)
@@ -1,77 +1,110 @@
-!> @file init_pegrid.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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/>.
-!
-! Current revisions:
-! ------------------
-!
+ SUBROUTINE init_pegrid
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! replaced use_syn_turb_gen by syn_turb_gen
-!
-! 4648 2020-08-25 07:52:08Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4564 2020-06-12 14:03:36Z raasch
-! Vertical nesting method of Huq et al. (2019) removed
-!
-! 4461 2020-03-12 16:51:59Z raasch
-! communicator configurations for four virtual pe grids defined
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! changed message PA0467
-!
-! 4264 2019-10-15 16:00:23Z scharf
-! corrected error message string
-!
-! 4241 2019-09-27 06:32:47Z raasch
-! Check added to ensure that subdomain grid has at least the size as given by the number of ghost
-! points
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4045 2019-06-21 10:58:47Z raasch
-! bugfix: kind attribute added to nint function to allow for large integers which may appear in case
-!         of default recycling width and small grid spacings
-!
-! 3999 2019-05-23 16:09:37Z suehring
-! Spend 3 ghost points also in case of pw-scheme when nesting is applied
-!
-! 3897 2019-04-15 11:51:14Z suehring
-! Minor revision of multigrid check; give warning instead of an abort.
-!
-! 3890 2019-04-12 15:59:20Z suehring
-! Check if grid coarsening is possible on subdomain, in order to avoid that multigrid approach
-! effectively reduces to a Gauss-Seidel scheme.
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3884 2019-04-10 13:31:55Z Giersch
-! id_recycling is only calculated in case of tubulent inflow
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! unused variable removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! variables documented
+! $Log: init_pegrid.f90,v $
+! Revision 1.28  2006/04/26 13:23:32  raasch
+! lcmuk does not understand the !$ comment so a cpp-directive is required
+!
+! Revision 1.27  2006/04/26 12:50:32  raasch
+! Get the number of OpenMP threads
+!
+! Revision 1.26  2006/02/23 12:34:57  raasch
+! Calculation of nanz_sums, nanz_2dh and nanz_3d moved to init_3d_model,
+! anz_y.. renamed ngp_y.., + MPI type type_x_int
+!
+! Revision 1.25  2005/10/20 15:37:36  raasch
+! error removed: the last PE in a row is not allowed to have more grid points
+! than the other PES (only less)
+!
+! Revision 1.24  2005/03/26 20:35:06  raasch
+! Extensions for non-cyclic boundary conditions
+! MIN function must be used instead of MAX for deciding if a switch to PE0 is
+! useful (multigrid-method), maximuma_grid_level_l is defined in case that a
+! pre-defined value for mg_switch_to_pe0_level is given (caused errors on NEC)
+!
+! Revision 1.23  2004/04/30 12:27:13  raasch
+! Setting 1d-decomposition as default on decalpha, indices for direct
+! transpositions z --> y and y --> x added, +module poisfft_mod,
+! data types for mpi_alltoallv removed (not neeeded any more),
+! poisfft_hybrid is no longer enforced in case of a 1d-decomposition along x,
+! an enlarged grid which will fit all transposition demands is calculated,
+! impulse_advec renamed momentum_advec
+!
+! Revision 1.22  2003/10/29 08:56:20  raasch
+! Number of possible grid levels for the mulitgrid-method are calculated
+! based on the total domain grid
+!
+! Revision 1.21  2003/08/01 08:40:03  raasch
+! Error removed: for a 1D-decomposition along x, the number PEs must also
+! be an integral divisor of the number of gridpoints along y
+!
+! Revision 1.20  2003/05/09 14:27:26  raasch
+! Setting 1d-decomposition as default on linux clusters
+!
+! Revision 1.19  2003/04/16 13:00:11  raasch
+! Call of fft_1dd_init, +module fft_for_1d_decomp
+!
+! Revision 1.18  2003/03/16 09:39:57  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.17  2003/03/12 16:32:47  raasch
+! A 1d-decomposition along x is the default on NEC hosts
+!
+! Revision 1.16  2002/12/19 15:40:39  raasch
+! In case of 1d-decomposition along x only a part of the integral divisor
+! conditions is checked, on IBM hosts a 1d-decomposition along x is the
+! default, a switch from Poisson-FFT-solver to the hybrid-solver is made
+! in case of 1d-decomposition along x, the hybrid-solver does not force a
+! 1d-decomposition any more, STOP replaced by call of local_stop
+!
+! Revision 1.15  2002/06/11 13:10:58  raasch
+! Usage of the Poisson-hybrid-solver forces a 1d-decomposition,
+! initialization of hybrid-solver
+!
+! Revision 1.14  2001/08/21  09:49:45  09:49:45  raasch (Siegfried Raasch)
+! MPI_COMM_WORLD replaced by comm_palm
+! 
+! Revision 1.13  2001/07/20 13:07:26  raasch
+! In case of using multigrid method, grid levels and additional MPI derived data
+! types are calculated. anz_yz and type_xz are now arrays.
+!
+! Revision 1.12  2001/03/30 07:32:01  raasch
+! Calculations of nw and nw1 removed,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.11  2001/01/22 08:33:48  raasch
+! Module test_variables removed
+!
+! Revision 1.9  2000/12/28 13:16:37  raasch
+! definition of mpi_particle_type moved to subroutine init_particles
+!
+! Revision 1.8  2000/04/27 06:54:03  raasch
+! Processor topology can now be prescribed by the user using npex and npey,
+! all comments translated into English
+!
+! Revision 1.7  1999/11/25 16:23:36  raasch
+! MPI-Datentyp fuer Partikeltransfer vereinbart
+!
+! Revision 1.6  1998/07/16 06:50:23  raasch
+! cpp-Direktiven fuer t3ej2 und t3ej5 erweitert
+!
+! Revision 1.5  1998/07/06 12:17:06  raasch
+! + USE test_variables
+!
+! Revision 1.4  1998/03/18 20:13:42  raasch
+! myid_char auf 5 Zeichen erweitert
+!
+! Revision 1.3  1998/01/23 10:02:08  raasch
+! Gitterpunktzahlen und Datentyp fuer 2D-Randaustausch
+! anz_yz_p, type_xz_p in anz_yz und type_xz umbenannt
+!
+! Revision 1.2  1997/08/11 06:18:28  raasch
+! Gitterpunktanzahl von globalen Feldern werden berechnet
 !
 ! Revision 1.1  1997/07/24 11:15:09  raasch
@@ -81,122 +114,43 @@
 ! Description:
 ! ------------
-!> Determination of the virtual processor topology (if not prescribed by the user) and computation
-!> of the grid point number and array bounds of the local domains.
-!> @todo: remove MPI-data types for 2D exchange on coarse multigrid level (not used any more)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_pegrid
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, bc_lr, bc_ns,       &
-               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, grid_level,         &
-               grid_level_count, maximum_grid_level, message_string, mg_switch_to_pe0_level, psolver
-
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  coupling_mode, coupling_topology, gathered_size, momentum_advec,                    &
-               outflow_source_plane, recycling_width, scalar_advec, subdomain_size,                &
-               syn_turb_gen, turbulent_inflow, turbulent_outflow, y_shift
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx
-#endif
-
-    USE indices,                                                                                   &
-        ONLY:  nnx, nny, nnz, nx, nxl, nxl_mg, nxlu, nxr, nxr_mg, ny, nyn, nyn_mg, nys, nys_mg,    &
-               nysv, nz, nzb, nzt, nzt_mg, wall_flags_1, wall_flags_2, wall_flags_3, wall_flags_4, &
-               wall_flags_5, wall_flags_6, wall_flags_7, wall_flags_8, wall_flags_9, wall_flags_10
-
-#if defined( __parallel )
-    USE indices,                                                                                   &
-        ONLY:  mg_loc_ind, nbgp, nx_a, nx_o, ny_a, ny_o
-#endif
-
-    USE kinds
-
+! Determination of the virtual processor topology (if not prescribed by the
+! user)and computation of the grid point number and array bounds of the local
+! domains.
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE fft_xy
+    USE indices
     USE pegrid
-
-#if defined( __parallel )
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run
-
-    USE spectra_mod,                                                                               &
-        ONLY:  calculate_spectra
-
-    USE synthetic_turbulence_generator_mod,                                                        &
-        ONLY:  id_stg_left, id_stg_north, id_stg_right, id_stg_south
-#endif
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_y, nxl_z, nxr_y, nxr_z, nyn_x, nyn_z, nys_x, nys_z, nzb_x, nzb_y, nzt_x, nzt_y
-
-#if defined( __parallel )
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_yd, nxr_yd, nzb_yd, nzt_yd
-#endif
+    USE poisfft_mod
+    USE poisfft_hybrid_mod
+    USE statistics
+    USE transpose_indices
+
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i                        !< running index over number of processors or number of multigrid level
-#if defined( __parallel )
-    INTEGER(iwp) ::  id_inflow_l              !< ID indicating processors located at the left inflow boundary
-    INTEGER(iwp) ::  id_outflow_l             !< local value of id_outflow
-    INTEGER(iwp) ::  id_outflow_source_l      !< local value of id_outflow_source
-    INTEGER(iwp) ::  id_recycling_l           !< ID indicating processors located at the recycling plane
-    INTEGER(iwp) ::  id_stg_left_l            !< left lateral boundary local core id in case of turbulence generator
-    INTEGER(iwp) ::  id_stg_north_l           !< north lateral boundary local core id in case of turbulence generator
-    INTEGER(iwp) ::  id_stg_right_l           !< right lateral boundary local core id in case of turbulence generator
-    INTEGER(iwp) ::  id_stg_south_l           !< south lateral boundary local core id in case of turbulence generator
-    INTEGER(iwp) ::  ind(5)                   !< array containing the subdomain bounds
-#endif
-    INTEGER(iwp) ::  j                        !< running index, used for various loops
-    INTEGER(iwp) ::  k                        !< number of vertical grid points in different multigrid level
-    INTEGER(iwp) ::  maximum_grid_level_l     !< maximum number of grid level without switching to PE 0
-    INTEGER(iwp) ::  mg_levels_x              !< maximum number of grid level allowed along x-direction
-    INTEGER(iwp) ::  mg_levels_y              !< maximum number of grid level allowed along y-direction
-    INTEGER(iwp) ::  mg_levels_z              !< maximum number of grid level allowed along z-direction
-    INTEGER(iwp) ::  mg_switch_to_pe0_level_l !< maximum number of grid level with switching to PE 0
-#if defined( __parallel )
-    INTEGER(iwp) ::  nnx_y                    !< quotient of number of grid points along x-direction and number of PEs used along y-direction
-    INTEGER(iwp) ::  nny_x                    !< quotient of number of grid points along y-direction and number of PEs used along x-direction
-    INTEGER(iwp) ::  nny_z                    !< quotient of number of grid points along y-direction and number of PEs used along x-direction
-    INTEGER(iwp) ::  nnz_x                    !< quotient of number of grid points along z-direction and number of PEs used along x-direction
-    INTEGER(iwp) ::  nnz_y                    !< quotient of number of grid points along z-direction and number of PEs used along x-direction
-    INTEGER(iwp) ::  numproc_sqr              !< square root of the number of processors
-#endif
-    INTEGER(iwp) ::  nxl_l                    !< lower index bound along x-direction on subdomain and different multigrid level
-    INTEGER(iwp) ::  nxr_l                    !< upper index bound along x-direction on subdomain and different multigrid level
-    INTEGER(iwp) ::  nyn_l                    !< lower index bound along y-direction on subdomain and different multigrid level
-    INTEGER(iwp) ::  nys_l                    !< upper index bound along y-direction on subdomain and different multigrid level
-#if defined( __parallel )
-    INTEGER(iwp) ::  nzb_l                    !< lower index bound along z-direction on subdomain and different multigrid level
-#endif
-    INTEGER(iwp) ::  nzt_l                    !< upper index bound along z-direction on subdomain and different multigrid level
-!$  INTEGER(iwp) ::  omp_get_num_threads      !< number of OpenMP threads
-
-#if defined( __parallel )
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ind_all !< dummy array containing index bounds on subdomain, used for gathering
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nxlf    !< lower index bound allong x-direction for every PE
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nxrf    !< upper index bound allong x-direction for every PE
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nynf    !< lower index bound allong y-direction for every PE
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nysf    !< lower index bound allong y-direction for every PE
-
-    INTEGER(iwp), DIMENSION(2) ::  pdims_remote         !< number of PEs used for coupled model (only in atmospher-ocean coupling)
-    INTEGER(iwp)               ::  lcoord(2)            !< PE coordinates of left neighbor along x and y
-    INTEGER(iwp)               ::  rcoord(2)            !< PE coordinates of right neighbor along x and y
-#endif
+    INTEGER ::  gathered_size, i, ind(5), j, k, maximum_grid_level_l,     &
+                mg_switch_to_pe0_level_l, mg_levels_x, mg_levels_y,       &
+                mg_levels_z, nnx_y, nnx_z, nny_x, nny_z, nnz_x, nnz_y,    &
+                numproc_sqr, nx_total, nxl_l, nxr_l, nyn_l, nys_l, nzb_l, &
+                nzt_l, omp_get_num_threads, subdomain_size
+
+    INTEGER, DIMENSION(:), ALLOCATABLE ::  ind_all, nxlf, nxrf, nynf, nysf
+
+    LOGICAL ::  found
 
 !
 !-- Get the number of OpenMP threads
     !$OMP PARALLEL
+#if defined( __lcmuk )
+    threads_per_task = omp_get_num_threads()
+#else
 !$  threads_per_task = omp_get_num_threads()
+#endif
     !$OMP END PARALLEL
 
 
 #if defined( __parallel )
-
-    CALL location_message( 'creating virtual PE grids + MPI derived data types', 'start' )
-
 !
 !-- Determine the processor topology or check it, if prescribed by the user
@@ -205,21 +159,36 @@
 !
 !--    Automatic determination of the topology
-       numproc_sqr = SQRT( REAL( numprocs, KIND=wp ) )
-       pdims(1)    = MAX( numproc_sqr , 1 )
-       DO  WHILE ( MOD( numprocs , pdims(1) ) /= 0 )
-          pdims(1) = pdims(1) - 1
-       ENDDO
-       pdims(2) = numprocs / pdims(1)
+!--    The default on SMP- and cluster-hosts is a 1d-decomposition along x
+#if defined( __lcmuk )
+       host = 'lcmuk'
+#endif
+       IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR. &
+            host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  THEN
+
+          pdims(1) = numprocs
+          pdims(2) = 1
+
+       ELSE
+
+          numproc_sqr = SQRT( REAL( numprocs ) )
+          pdims(1)    = MAX( numproc_sqr , 1 )
+          DO  WHILE ( MOD( numprocs , pdims(1) ) /= 0 )
+             pdims(1) = pdims(1) - 1
+          ENDDO
+          pdims(2) = numprocs / pdims(1)
+
+       ENDIF
 
     ELSEIF ( npex /= -1  .AND.  npey /= -1 )  THEN
 
 !
-!--    Prescribed by user. Number of processors on the prescribed topology must be equal to the
-!--    number of PEs available to the job
+!--    Prescribed by user. Number of processors on the prescribed topology
+!--    must be equal to the number of PEs available to the job
        IF ( ( npex * npey ) /= numprocs )  THEN
-          WRITE( message_string, * ) 'number of PEs of the prescribed ', 'topology (', npex*npey,  &
-                                     ') does not match & the number of ',                          &
-                                     'PEs available to the job (', numprocs, ')'
-          CALL message( 'init_pegrid', 'PA0221', 1, 2, 0, 6, 0 )
+          PRINT*, '+++ init_pegrid:'
+          PRINT*, '    number of PEs of the prescribed topology (', npex*npey, &
+                      ') does not match the number of PEs available to the ',  &
+                      'job (', numprocs, ')'
+          CALL local_stop
        ENDIF
        pdims(1) = npex
@@ -230,36 +199,20 @@
 !--    If the processor topology is prescribed by the user, the number of
 !--    PEs must be given in both directions
-       message_string = 'if the processor topology is prescribed by th' //                         &
-                        'e user & both values of "npex" and "npey" must be given' //               &
-                        ' in the &NAMELIST-parameter file'
-       CALL message( 'init_pegrid', 'PA0222', 1, 2, 0, 6, 0 )
-
-    ENDIF
-
-!
-!-- Create four default MPI communicators for the 2d virtual PE grid. One of them will be used as
-!-- the main communicator for this run, while others might be used for specific quantities like
-!-- aerosol, chemical species, or passive scalars), if their horizontal boundary conditions shall
-!-- be different from those of the other quantities (e.g. non-cyclic conditions for aerosols, and
-!-- cyclic conditions for all others).
-    DO  i = 1, 4
-
-       IF ( i == 1 )  cyclic = (/  .TRUE., .TRUE.  /)   ! cyclic along x and y
-       IF ( i == 2 )  cyclic = (/  .TRUE., .FALSE. /)   ! cyclic along x
-       IF ( i == 3 )  cyclic = (/ .FALSE., .TRUE.  /)   ! cyllic along y
-       IF ( i == 4 )  cyclic = (/ .FALSE., .FALSE. /)   ! non-cyclic
-
-       CALL MPI_CART_CREATE( comm_palm, ndim, pdims, cyclic, reorder,                              &
-                             communicator_configurations(i)%mpi_communicator, ierr )
-
-       CALL MPI_CART_SHIFT( communicator_configurations(i)%mpi_communicator, 0, 1,                 &
-                            communicator_configurations(i)%pleft,                                  &
-                            communicator_configurations(i)%pright, ierr )
-
-       CALL MPI_CART_SHIFT( communicator_configurations(i)%mpi_communicator, 1, 1,                 &
-                            communicator_configurations(i)%psouth,                                 &
-                            communicator_configurations(i)%pnorth, ierr )
-
-    ENDDO
+       PRINT*, '+++ init_pegrid:'
+       PRINT*, '    if the processor topology is prescribed by the user, ',   &
+                    'both values of "npex" and "npey" must be given in the ', &
+                    'NAMELIST-parameter file'
+       CALL local_stop
+
+    ENDIF
+
+!
+!-- The hybrid solver can only be used in case of a 1d-decomposition along x
+    IF ( pdims(2) /= 1  .AND.  psolver == 'poisfft_hybrid' )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '*** init_pegrid: psolver = "poisfft_hybrid" can only be'
+          PRINT*, '                 used in case of a 1d-decomposition along x'
+       ENDIF
+    ENDIF
 
 !
@@ -268,79 +221,14 @@
     IF ( bc_ns /= 'cyclic' )  cyclic(2) = .FALSE.
 
-
-!
-!-- Set the main communicator (virtual pe grid) for this run
-    IF ( bc_lr == 'cyclic'  .AND.  bc_ns == 'cyclic' )  i = 1
-    IF ( bc_lr == 'cyclic'  .AND.  bc_ns /= 'cyclic' )  i = 2
-    IF ( bc_lr /= 'cyclic'  .AND.  bc_ns == 'cyclic' )  i = 3
-    IF ( bc_lr /= 'cyclic'  .AND.  bc_ns /= 'cyclic' )  i = 4
-
-    comm2d = communicator_configurations(i)%mpi_communicator
-    pleft  = communicator_configurations(i)%pleft
-    pright = communicator_configurations(i)%pright
-    psouth = communicator_configurations(i)%psouth
-    pnorth = communicator_configurations(i)%pnorth
-
-!
-!-- Set rank and coordinates of the main communicator
+!
+!-- Create the virtual processor grid
+    CALL MPI_CART_CREATE( comm_palm, ndim, pdims, cyclic, reorder, &
+                          comm2d, ierr )
     CALL MPI_COMM_RANK( comm2d, myid, ierr )
-    WRITE (myid_char,'(''_'',I6.6)')  myid
+    WRITE (myid_char,'(''_'',I4.4)')  myid
 
     CALL MPI_CART_COORDS( comm2d, myid, ndim, pcoord, ierr )
-
-!
-!-- In case of cyclic boundary conditions, a y-shift at the boundaries in x-direction can be
-!-- introduced via parameter y_shift. The shift is done by modifying the processor grid in such a
-!-- way that processors located at the x-boundary communicate across it to processors with
-!-- y-coordinate shifted by y_shift relative to their own. This feature can not be used in
-!-- combination with an fft pressure solver. It has been implemented to counter the effect of streak
-!-- structures in case of cyclic boundary conditions. For a description of these see Munters
-!-- (2016; dx.doi.org/10.1063/1.4941912)
-!--
-!-- Get coordinates of left and right neighbor on PE grid
-    IF ( y_shift /= 0 ) THEN
-       IF ( bc_lr == 'cyclic' ) THEN
-          IF ( TRIM( psolver ) /= 'multigrid' .AND.  TRIM( psolver ) /= 'multigrid_noopt')  THEN
-             message_string = 'y_shift /= 0 requires a multigrid pressure solver '
-             CALL message( 'check_parameters', 'PA0468', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          CALL MPI_CART_COORDS( comm2d, pright, ndim, rcoord, ierr )
-          CALL MPI_CART_COORDS( comm2d, pleft, ndim, lcoord, ierr )
-
-!
-!--       If the x(y)-coordinate of the right (left) neighbor is smaller (greater) than that of the
-!--       calling process, then the calling process is located on the right (left) boundary of the
-!--       processor grid. In that case, the y-coordinate of that neighbor is increased (decreased)
-!--       by y_shift.
-!--       The rank of the process with that coordinate is then inquired and the neighbor rank for
-!--       MPI_SENDRECV, pright (pleft) is set to it.
-!--       In this way, the calling process receives a new right (left) neighbor for all future
-!--       MPI_SENDRECV calls. That neighbor has a y-coordinate of y+(-)y_shift, where y is the
-!--       original right (left) neighbor's y-coordinate. The modulo-operation ensures that if the
-!--       neighbor's y-coordinate exceeds the grid-boundary, it will be relocated to the opposite
-!--       part of the grid cyclicly.
-          IF ( rcoord(1) < pcoord(1) )  THEN
-             rcoord(2) = MODULO( rcoord(2) + y_shift, pdims(2) )
-             CALL MPI_CART_RANK( comm2d, rcoord, pright, ierr )
-          ENDIF
-
-          IF ( lcoord(1) > pcoord(1) )  THEN
-             lcoord(2) = MODULO( lcoord(2) - y_shift, pdims(2) )
-             CALL MPI_CART_RANK( comm2d, lcoord, pleft, ierr )
-          ENDIF
-
-       ELSE
-!
-!--       y-shift for non-cyclic boundary conditions is only implemented
-!--       for the turbulence recycling method in inflow_turbulence.f90
-          IF ( .NOT. turbulent_inflow )  THEN
-             message_string = 'y_shift /= 0 is only allowed for cyclic ' //                        &
-                              'boundary conditions in both directions '  //                        &
-                              'or with turbulent_inflow == .TRUE.'
-             CALL message( 'check_parameters', 'PA0467', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
+    CALL MPI_CART_SHIFT( comm2d, 0, 1, pleft, pright, ierr )
+    CALL MPI_CART_SHIFT( comm2d, 1, 1, psouth, pnorth, ierr )
 
 !
@@ -358,16 +246,81 @@
     CALL MPI_COMM_RANK( comm1dy, myidy, ierr )
 
-!
-!-- Calculate array bounds along x-direction for every PE.
-    ALLOCATE( nxlf(0:pdims(1)-1), nxrf(0:pdims(1)-1), nynf(0:pdims(2)-1), nysf(0:pdims(2)-1) )
-
-    IF ( MOD( nx+1 , pdims(1) ) /= 0 )  THEN
-       WRITE( message_string, * ) 'x-direction: gridpoint number (' ,nx+1, ') ',                   &
-                                  'is not an& integral multiple of the number',                    &
-                                  ' of processors (', pdims(1), ')'
-       CALL message( 'init_pegrid', 'PA0225', 1, 2, 0, 6, 0 )
+
+!
+!-- Find a grid (used for array d) which will match the transposition demands
+    IF ( grid_matching == 'strict' )  THEN
+
+       nxa = nx;  nya = ny;  nza = nz
+
     ELSE
-       nnx  = ( nx + 1 ) / pdims(1)
-    ENDIF
+
+       found = .FALSE.
+   xn: DO  nxa = nx, 2*nx
+!
+!--       Meet conditions for nx
+          IF ( MOD( nxa+1, pdims(1) ) /= 0 .OR. &
+               MOD( nxa+1, pdims(2) ) /= 0 )  CYCLE xn
+
+      yn: DO  nya = ny, 2*ny
+!
+!--          Meet conditions for ny
+             IF ( MOD( nya+1, pdims(2) ) /= 0 .OR. &
+                  MOD( nya+1, pdims(1) ) /= 0 )  CYCLE yn
+
+
+         zn: DO  nza = nz, 2*nz
+!
+!--             Meet conditions for nz
+                IF ( ( MOD( nza, pdims(1) ) /= 0  .AND.  pdims(1) /= 1  .AND. &
+                       pdims(2) /= 1 )  .OR.                                  &
+                     ( MOD( nza, pdims(2) ) /= 0  .AND.  dt_dosp /= 9999999.9 &
+                     ) )  THEN
+                   CYCLE zn
+                ELSE
+                   found = .TRUE.
+                   EXIT xn
+                ENDIF
+
+             ENDDO zn
+
+          ENDDO yn
+
+       ENDDO xn
+
+       IF ( .NOT. found )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ init_pegrid: no matching grid for transpositions found'
+          ENDIF
+          CALL local_stop
+       ENDIF
+
+    ENDIF
+
+!
+!-- Calculate array bounds in x-direction for every PE.
+!-- The last PE along x may get less grid points than the others
+    ALLOCATE( nxlf(0:pdims(1)-1), nxrf(0:pdims(1)-1), nynf(0:pdims(2)-1), &
+              nysf(0:pdims(2)-1), nnx_pe(0:pdims(1)-1), nny_pe(0:pdims(2)-1) )
+
+    IF ( MOD( nxa+1 , pdims(1) ) /= 0 )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*,'+++ x-direction:  gridpoint number (',nx+1,') is not an'
+          PRINT*,'                  integral divisor of the number of proces', &
+                                   &'sors (', pdims(1),')'
+       ENDIF
+       CALL local_stop
+    ELSE
+       nnx  = ( nxa + 1 ) / pdims(1)
+       IF ( nnx*pdims(1) - ( nx + 1) > nnx )  THEN
+          IF ( myid == 0 )  THEN
+	     PRINT*,'+++ x-direction: nx does not match the requirements ', &
+	                 'given by the number of PEs'
+             PRINT*,'                 used'
+             PRINT*,'    please use nx = ', nx - ( pdims(1) - ( nnx*pdims(1) &
+	                 - ( nx + 1 ) ) ), ' instead of nx =', nx
+          ENDIF
+	  CALL local_stop
+       ENDIF
+    ENDIF    
 
 !
@@ -376,16 +329,29 @@
        nxlf(i)   = i * nnx
        nxrf(i)   = ( i + 1 ) * nnx - 1
+       nnx_pe(i) = MIN( nx, nxrf(i) ) - nxlf(i) + 1
     ENDDO
 
 !
 !-- Calculate array bounds in y-direction for every PE.
-    IF ( MOD( ny+1 , pdims(2) ) /= 0 )  THEN
-       WRITE( message_string, * ) 'y-direction: gridpoint number (', ny+1, ') ',                   &
-                                  'is not an& integral multiple of the number',                    &
-                                  ' of processors (', pdims(2), ')'
-       CALL message( 'init_pegrid', 'PA0227', 1, 2, 0, 6, 0 )
+    IF ( MOD( nya+1 , pdims(2) ) /= 0 )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*,'+++ y-direction:  gridpoint number (',ny+1,') is not an'
+          PRINT*,'                  integral divisor of the number of proces', &
+                                   &'sors (', pdims(2),')'
+       ENDIF
+       CALL local_stop
     ELSE
-       nny  = ( ny + 1 ) / pdims(2)
-    ENDIF
+       nny  = ( nya + 1 ) / pdims(2)
+       IF ( nny*pdims(2) - ( ny + 1) > nny )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ x-direction: nx does not match the requirements ', &
+                         'given by the number of PEs'
+             PRINT*,'                 used'
+             PRINT*,'    please use nx = ', nx - ( pdims(1) - ( nnx*pdims(1) &
+                         - ( nx + 1 ) ) ), ' instead of nx =', nx
+          ENDIF
+          CALL local_stop
+       ENDIF
+    ENDIF    
 
 !
@@ -394,153 +360,173 @@
        nysf(j)   = j * nny
        nynf(j)   = ( j + 1 ) * nny - 1
+       nny_pe(j) = MIN( ny, nynf(j) ) - nysf(j) + 1
     ENDDO
 
 !
 !-- Local array bounds of the respective PEs
-    nxl = nxlf(pcoord(1))
-    nxr = nxrf(pcoord(1))
-    nys = nysf(pcoord(2))
-    nyn = nynf(pcoord(2))
-    nzb = 0
-    nzt = nz
-    nnz = nz
-
-!
-!-- Set switches to define if the PE is situated at the border of the virtual processor grid
-    IF ( nxl == 0 )   left_border_pe  = .TRUE.
-    IF ( nxr == nx )  right_border_pe = .TRUE.
-    IF ( nys == 0 )   south_border_pe = .TRUE.
-    IF ( nyn == ny )  north_border_pe = .TRUE.
-
-!
-!-- Calculate array bounds and gridpoint numbers for the transposed arrays (needed in the pressure
-!-- solver)
-!-- For the transposed arrays, cyclic boundaries as well as top and bottom boundaries are omitted,
-!-- because they are obstructive to the transposition
+    nxl  = nxlf(pcoord(1))
+    nxra = nxrf(pcoord(1))
+    nxr  = MIN( nx, nxra )
+    nys  = nysf(pcoord(2))
+    nyna = nynf(pcoord(2))
+    nyn  = MIN( ny, nyna )
+    nzb  = 0
+    nzta = nza
+    nzt  = MIN( nz, nzta )
+    nnz  = nza
+
+!
+!-- Calculate array bounds and gridpoint numbers for the transposed arrays
+!-- (needed in the pressure solver)
+!-- For the transposed arrays, cyclic boundaries as well as top and bottom
+!-- boundaries are omitted, because they are obstructive to the transposition
 
 !
 !-- 1. transposition  z --> x
-!-- This transposition is not neccessary in case of a 1d-decomposition along x
-    IF ( psolver == 'poisfft'  .OR.  calculate_spectra )  THEN
-
-       IF ( pdims(2) /= 1 )  THEN
-          IF ( MOD( nz , pdims(1) ) /= 0 )  THEN
-             WRITE( message_string, * ) 'transposition z --> x:& ',                                &
-                                        'nz=', nz, ' is not an integral multiple ',                &
-                                        'of pdims(1)=', pdims(1)
-             CALL message( 'init_pegrid', 'PA0230', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-       nys_x = nys
-       nyn_x = nyn
-       nny_x = nny
-       nnz_x = nz / pdims(1)
-       nzb_x = 1 + myidx * nnz_x
-       nzt_x = ( myidx + 1 ) * nnz_x
+!-- This transposition is not neccessary in case of a 1d-decomposition along x,
+!-- except that the uptream-spline method is switched on
+    IF ( pdims(2) /= 1  .OR.  momentum_advec == 'ups-scheme'  .OR. &
+         scalar_advec == 'ups-scheme' )  THEN
+
+       IF ( pdims(2) == 1  .AND. ( momentum_advec == 'ups-scheme'  .OR. &
+            scalar_advec == 'ups-scheme' ) )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ WARNING: init_pegrid: 1d-decomposition along x ', &
+                                &'chosen but nz restrictions may occur'
+             PRINT*,'             since ups-scheme is activated'
+          ENDIF
+       ENDIF
+       nys_x  = nys
+       nyn_xa = nyna
+       nyn_x  = nyn
+       nny_x  = nny
+       IF ( MOD( nza , pdims(1) ) /= 0 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ transposition z --> x:'
+             PRINT*,'    nz=',nz,' is not an integral divisior of pdims(1)=', &
+                    &pdims(1)
+          ENDIF
+          CALL local_stop
+       ENDIF
+       nnz_x  = nza / pdims(1)
+       nzb_x  = 1 + myidx * nnz_x
+       nzt_xa = ( myidx + 1 ) * nnz_x
+       nzt_x  = MIN( nzt, nzt_xa )
+
        sendrecvcount_zx = nnx * nny * nnz_x
 
     ENDIF
 
-
-    IF ( psolver == 'poisfft' )  THEN
-!
-!--    2. transposition  x --> y
-       IF ( MOD( nx+1 , pdims(2) ) /= 0 )  THEN
-          WRITE( message_string, * ) 'transposition x --> y:& ',                                   &
-                                     'nx+1=', nx+1, ' is not an integral ',                        &
-                                     'multiple of pdims(2)=', pdims(2)
-          CALL message( 'init_pegrid', 'PA0231', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       nnz_y = nnz_x
-       nzb_y = nzb_x
-       nzt_y = nzt_x
-       nnx_y = (nx+1) / pdims(2)
-       nxl_y = myidy * nnx_y
-       nxr_y = ( myidy + 1 ) * nnx_y - 1
-       sendrecvcount_xy = nnx_y * nny_x * nnz_y
-!
-!--    3. transposition  y --> z
-!--    (ELSE:  x --> y  in case of 1D-decomposition along x)
-       nxl_z = nxl_y
-       nxr_z = nxr_y
-       nny_z = (ny+1) / pdims(1)
-       nys_z = myidx * nny_z
-       nyn_z = ( myidx + 1 ) * nny_z - 1
+!
+!-- 2. transposition  x --> y
+    nnz_y  = nnz_x
+    nzb_y  = nzb_x
+    nzt_ya = nzt_xa
+    nzt_y  = nzt_x
+    IF ( MOD( nxa+1 , pdims(2) ) /= 0 )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*,'+++ transposition x --> y:'
+          PRINT*,'    nx+1=',nx+1,' is not an integral divisor of ',&
+                 &'pdims(2)=',pdims(2)
+       ENDIF
+       CALL local_stop
+    ENDIF
+    nnx_y = (nxa+1) / pdims(2)
+    nxl_y = myidy * nnx_y
+    nxr_ya = ( myidy + 1 ) * nnx_y - 1
+    nxr_y  = MIN( nx, nxr_ya )
+
+    sendrecvcount_xy = nnx_y * nny_x * nnz_y
+
+!
+!-- 3. transposition  y --> z  (ELSE:  x --> y  in case of 1D-decomposition
+!-- along x)
+    IF ( pdims(2) /= 1  .OR.  momentum_advec == 'ups-scheme'  .OR. &
+         scalar_advec == 'ups-scheme' )  THEN
+!
+!--    y --> z
+!--    This transposition is not neccessary in case of a 1d-decomposition
+!--    along x, except that the uptream-spline method is switched on
+       nnx_z  = nnx_y
+       nxl_z  = nxl_y
+       nxr_za = nxr_ya
+       nxr_z  = nxr_y
+       IF ( MOD( nya+1 , pdims(1) ) /= 0 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ Transposition y --> z:'
+             PRINT*,'    ny+1=',ny+1,' is not an integral divisor of ',&
+                    &'pdims(1)=',pdims(1)
+          ENDIF
+          CALL local_stop
+       ENDIF
+       nny_z  = (nya+1) / pdims(1)
+       nys_z  = myidx * nny_z
+       nyn_za = ( myidx + 1 ) * nny_z - 1
+       nyn_z  = MIN( ny, nyn_za )
+
        sendrecvcount_yz = nnx_y * nny_z * nnz_y
 
-       IF ( pdims(2) /= 1 )  THEN
-!
-!--       y --> z
-!--       This transposition is not neccessary in case of a 1d-decomposition
-!--       along x, except that the uptream-spline method is switched on
-          IF ( MOD( ny+1 , pdims(1) ) /= 0 )  THEN
-             WRITE( message_string, * ) 'transposition y --> z:& ',                                &
-                                        'ny+1=', ny+1, ' is not an integral ',                     &
-                                        'multiple of pdims(1)=', pdims(1)
-             CALL message( 'init_pegrid', 'PA0232', 1, 2, 0, 6, 0 )
-          ENDIF
-
+    ELSE
+!
+!--    x --> y. This condition must be fulfilled for a 1D-decomposition along x
+       IF ( MOD( nya+1 , pdims(1) ) /= 0 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ Transposition x --> y:'
+             PRINT*,'    ny+1=',ny+1,' is not an integral divisor of ',&
+                    &'pdims(1)=',pdims(1)
+          ENDIF
+          CALL local_stop
+       ENDIF
+
+    ENDIF
+
+!
+!-- Indices for direct transpositions z --> y (used for calculating spectra)
+    IF ( dt_dosp /= 9999999.9 )  THEN
+       IF ( MOD( nza, pdims(2) ) /= 0 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ Direct transposition z --> y (needed for spectra):'
+             PRINT*,'    nz=',nz,' is not an integral divisor of ',&
+                    &'pdims(2)=',pdims(2)
+          ENDIF
+          CALL local_stop
        ELSE
-!
-!--       x --> y
-!--       This condition must be fulfilled for a 1D-decomposition along x
-          IF ( MOD( ny+1 , pdims(1) ) /= 0 )  THEN
-             WRITE( message_string, * ) 'transposition x --> y:& ',                                &
-                                        'ny+1=', ny+1, ' is not an integral ',                     &
-                                        'multiple of pdims(1)=', pdims(1)
-             CALL message( 'init_pegrid', 'PA0233', 1, 2, 0, 6, 0 )
-          ENDIF
-
-       ENDIF
-
-    ENDIF
-
-!
-!-- Indices for direct transpositions z --> y (used for calculating spectra)
-    IF ( calculate_spectra )  THEN
-       IF ( MOD( nz, pdims(2) ) /= 0 )  THEN
-          WRITE( message_string, * ) 'direct transposition z --> y (needed ',                      &
-                                     'for spectra):& nz=', nz, ' is not an ',                      &
-                                     'integral multiple of pdims(2)=', pdims(2)
-          CALL message( 'init_pegrid', 'PA0234', 1, 2, 0, 6, 0 )
-       ELSE
-          nxl_yd = nxl
-          nxr_yd = nxr
-          nzb_yd = 1 + myidy * ( nz / pdims(2) )
-          nzt_yd = ( myidy + 1 ) * ( nz / pdims(2) )
-          sendrecvcount_zyd = nnx * nny * ( nz / pdims(2) )
-       ENDIF
-    ENDIF
-
-    IF ( psolver == 'poisfft'  .OR.  calculate_spectra )  THEN
-!
-!--    Indices for direct transpositions y --> x
-!--    (they are only possible in case of a 1d-decomposition along x)
-       IF ( pdims(2) == 1 )  THEN
-          nny_x = nny / pdims(1)
-          nys_x = myid * nny_x
-          nyn_x = ( myid + 1 ) * nny_x - 1
-          nzb_x = 1
-          nzt_x = nz
-          sendrecvcount_xy = nnx * nny_x * nz
-       ENDIF
-
-    ENDIF
-
-    IF ( psolver == 'poisfft' )  THEN
-!
-!--    Indices for direct transpositions x --> y
-!--    (they are only possible in case of a 1d-decomposition along y)
-       IF ( pdims(1) == 1 )  THEN
-          nnx_y = nnx / pdims(2)
-          nxl_y = myid * nnx_y
-          nxr_y = ( myid + 1 ) * nnx_y - 1
-          nzb_y = 1
-          nzt_y = nz
-          sendrecvcount_xy = nnx_y * nny * nz
-       ENDIF
-
+          nxl_yd  = nxl
+          nxr_yda = nxra
+          nxr_yd  = nxr
+          nzb_yd  = 1 + myidy * ( nza / pdims(2) )
+          nzt_yda = ( myidy + 1 ) * ( nza / pdims(2) )
+          nzt_yd  = MIN( nzt, nzt_yda )
+
+          sendrecvcount_zyd = nnx * nny * ( nza / pdims(2) )
+       ENDIF
+    ENDIF
+
+!
+!-- Indices for direct transpositions y --> x (they are only possible in case
+!-- of a 1d-decomposition along x)
+    IF ( pdims(2) == 1 )  THEN
+       nny_x  = nny / pdims(1)
+       nys_x  = myid * nny_x
+       nyn_xa = ( myid + 1 ) * nny_x - 1
+       nyn_x  = MIN( ny, nyn_xa )
+       nzb_x  = 1
+       nzt_xa = nza
+       nzt_x  = nz
+       sendrecvcount_xy = nnx * nny_x * nza
+    ENDIF
+
+!
+!-- Indices for direct transpositions x --> y (they are only possible in case
+!-- of a 1d-decomposition along y)
+    IF ( pdims(1) == 1 )  THEN
+       nnx_y  = nnx / pdims(2)
+       nxl_y  = myid * nnx_y
+       nxr_ya = ( myid + 1 ) * nnx_y - 1
+       nxr_y  = MIN( nx, nxr_ya )
+       nzb_y  = 1
+       nzt_ya = nza
+       nzt_y  = nz
+       sendrecvcount_xy = nnx_y * nny * nza
     ENDIF
 
@@ -548,35 +534,4 @@
 !-- Arrays for storing the array bounds are needed any more
     DEALLOCATE( nxlf , nxrf , nynf , nysf )
-
-
-!
-!-- Collect index bounds from other PEs (to be written to restart file later)
-    ALLOCATE( hor_index_bounds(4,0:numprocs-1) )
-
-    IF ( myid == 0 )  THEN
-
-       hor_index_bounds(1,0) = nxl
-       hor_index_bounds(2,0) = nxr
-       hor_index_bounds(3,0) = nys
-       hor_index_bounds(4,0) = nyn
-
-!
-!--    Receive data from all other PEs
-       DO  i = 1, numprocs-1
-          CALL MPI_RECV( ibuf, 4, MPI_INTEGER, i, MPI_ANY_TAG, comm2d, status, ierr )
-          hor_index_bounds(:,i) = ibuf(1:4)
-       ENDDO
-
-    ELSE
-!
-!--    Send index bounds to PE0
-       ibuf(1) = nxl
-       ibuf(2) = nxr
-       ibuf(3) = nys
-       ibuf(4) = nyn
-       CALL MPI_SEND( ibuf, 4, MPI_INTEGER, 0, myid, comm2d, ierr )
-
-    ENDIF
-
 
 #if defined( __print )
@@ -586,14 +541,18 @@
        PRINT*, '*** processor topology ***'
        PRINT*, ' '
-       PRINT*, 'myid   pcoord    left right  south north  idx idy   nxl: nxr','   nys: nyn'
-       PRINT*, '------------------------------------------------------------','-----------'
-       WRITE (*,1000)  0, pcoord(1), pcoord(2), pleft, pright, psouth, pnorth, myidx, myidy, nxl,  &
-                       nxr, nys, nyn
-1000   FORMAT (I4,2X,'(',I3,',',I3,')',3X,I4,2X,I4,3X,I4,2X,I4,2X,I3,1X,I3,2(2X,I4,':',I4))
-
-!
-!--    Receive data from the other PEs
+       PRINT*, 'myid   pcoord    left right  south north  idx idy   nxl: nxr',&
+               &'   nys: nyn'
+       PRINT*, '------------------------------------------------------------',&
+               &'-----------'
+       WRITE (*,1000)  0, pcoord(1), pcoord(2), pleft, pright, psouth, pnorth, &
+                       myidx, myidy, nxl, nxr, nys, nyn
+1000   FORMAT (I4,2X,'(',I3,',',I3,')',3X,I4,2X,I4,3X,I4,2X,I4,2X,I3,1X,I3, &
+               2(2X,I4,':',I4))
+
+!
+!--    Recieve data from the other PEs
        DO  i = 1,numprocs-1
-          CALL MPI_RECV( ibuf, 12, MPI_INTEGER, i, MPI_ANY_TAG, comm2d, status, ierr )
+          CALL MPI_RECV( ibuf, 12, MPI_INTEGER, i, MPI_ANY_TAG, comm2d, status, &
+                         ierr )
           WRITE (*,1000)  i, ( ibuf(j) , j = 1,12 )
        ENDDO
@@ -606,171 +565,61 @@
        ibuf(8) = myidy; ibuf(9) = nxl; ibuf(10) = nxr; ibuf(11) = nys
        ibuf(12) = nyn
-       CALL MPI_SEND( ibuf, 12, MPI_INTEGER, 0, myid, comm2d, ierr )
+       CALL MPI_SEND( ibuf, 12, MPI_INTEGER, 0, myid, comm2d, ierr )       
     ENDIF
 #endif
 
-!
-!-- Determine the number of ghost point layers
-    IF ( scalar_advec   == 'ws-scheme'  .OR.                                                       &
-         momentum_advec == 'ws-scheme'  .OR.  nested_run )  THEN
-       nbgp = 3
-    ELSE
-       nbgp = 1
-    ENDIF
-
-!
-!-- Check that the number of computational grid points is not smaller than the number of ghost
-!-- points.
-    IF ( nnx < nbgp )  THEN
-       WRITE( message_string, * ) 'number of subdomain grid points along x (', nnx, ') is smaller',&
-                                  'than the number of ghost points (', nbgp, ')'
-       CALL message( 'init_pegrid', 'PA0682', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( nny < nbgp )  THEN
-       WRITE( message_string, * ) 'number of subdomain grid points along y (', nny, ') is smaller',&
-                                  'than the number of ghost points (', nbgp, ')'
-       CALL message( 'init_pegrid', 'PA0683', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Create a new MPI derived datatype for the exchange of surface (xy) data, which is needed for
-!-- coupled atmosphere-ocean runs.
-!-- First, calculate number of grid points of an xy-plane.
-    ngp_xy  = ( nxr - nxl + 1 + 2 * nbgp ) * ( nyn - nys + 1 + 2 * nbgp )
-    CALL MPI_TYPE_VECTOR( ngp_xy, 1, nzt-nzb+2, MPI_REAL, type_xy, ierr )
-    CALL MPI_TYPE_COMMIT( type_xy, ierr )
-
-    IF ( TRIM( coupling_mode ) /= 'uncoupled' )  THEN
-
-!
-!--    Pass the number of grid points of the atmosphere model to
-!--    the ocean model and vice versa
-       IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
-
-          nx_a = nx
-          ny_a = ny
-
-          IF ( myid == 0 )  THEN
-
-             CALL MPI_SEND( nx_a, 1, MPI_INTEGER, numprocs, 1, comm_inter, ierr )
-             CALL MPI_SEND( ny_a, 1, MPI_INTEGER, numprocs, 2, comm_inter,  ierr )
-             CALL MPI_SEND( pdims, 2, MPI_INTEGER, numprocs, 3, comm_inter, ierr )
-             CALL MPI_RECV( nx_o, 1, MPI_INTEGER, numprocs, 4, comm_inter, status, ierr )
-             CALL MPI_RECV( ny_o, 1, MPI_INTEGER, numprocs, 5, comm_inter, status, ierr )
-             CALL MPI_RECV( pdims_remote, 2, MPI_INTEGER, numprocs, 6, comm_inter, status, ierr )
-          ENDIF
-
-          CALL MPI_BCAST( nx_o, 1, MPI_INTEGER, 0, comm2d, ierr )
-          CALL MPI_BCAST( ny_o, 1, MPI_INTEGER, 0, comm2d, ierr )
-          CALL MPI_BCAST( pdims_remote, 2, MPI_INTEGER, 0, comm2d, ierr )
-
-       ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
-
-          nx_o = nx
-          ny_o = ny
-
-          IF ( myid == 0 )  THEN
-
-             CALL MPI_RECV( nx_a, 1, MPI_INTEGER, 0, 1, comm_inter, status, ierr )
-             CALL MPI_RECV( ny_a, 1, MPI_INTEGER, 0, 2, comm_inter, status, ierr )
-             CALL MPI_RECV( pdims_remote, 2, MPI_INTEGER, 0, 3, comm_inter, status, ierr )
-             CALL MPI_SEND( nx_o, 1, MPI_INTEGER, 0, 4, comm_inter, ierr )
-             CALL MPI_SEND( ny_o, 1, MPI_INTEGER, 0, 5, comm_inter, ierr )
-             CALL MPI_SEND( pdims, 2, MPI_INTEGER, 0, 6, comm_inter, ierr )
-          ENDIF
-
-          CALL MPI_BCAST( nx_a, 1, MPI_INTEGER, 0, comm2d, ierr)
-          CALL MPI_BCAST( ny_a, 1, MPI_INTEGER, 0, comm2d, ierr)
-          CALL MPI_BCAST( pdims_remote, 2, MPI_INTEGER, 0, comm2d, ierr)
-
-       ENDIF
-
-       ngp_a = ( nx_a+1 + 2 * nbgp ) * ( ny_a+1 + 2 * nbgp )
-       ngp_o = ( nx_o+1 + 2 * nbgp ) * ( ny_o+1 + 2 * nbgp )
-
-!
-!--    Determine if the horizontal grid and the number of PEs in ocean and atmosphere is same or not.
-       IF ( nx_o == nx_a  .AND.  ny_o == ny_a  .AND.                                               &
-            pdims(1) == pdims_remote(1)  .AND.  pdims(2) == pdims_remote(2) )  THEN
-          coupling_topology = 0
-       ELSE
-          coupling_topology = 1
-       ENDIF
-
-!
-!--    Determine the target PEs for the exchange between ocean and atmosphere (comm2d)
-       IF ( coupling_topology == 0 )  THEN
-!
-!--       In case of identical topologies, every atmosphere PE has exactly one ocean PE counterpart
-!--       and vice versa
-          IF ( TRIM( coupling_mode ) == 'atmosphere_to_ocean' )  THEN
-             target_id = myid + numprocs
-          ELSE
-             target_id = myid
-          ENDIF
-
-       ELSE
-!
-!--       In case of nonequivalent topology in ocean and atmosphere only for PE0 in ocean and PE0 in
-!--       atmosphere a target_id is needed, since data echxchange between ocean and atmosphere will
-!--       be done only between these PEs.
-          IF ( myid == 0 )  THEN
-
-             IF ( TRIM( coupling_mode ) == 'atmosphere_to_ocean' )  THEN
-                target_id = numprocs
-             ELSE
-                target_id = 0
-             ENDIF
-
-          ENDIF
-
-       ENDIF
-
-    ENDIF
-
 #else
 
 !
-!-- Array bounds when running on a single PE (respectively a non-parallel machine)
-    nxl = 0
-    nxr = nx
-    nnx = nxr - nxl + 1
-    nys = 0
-    nyn = ny
-    nny = nyn - nys + 1
-    nzb = 0
-    nzt = nz
-    nnz = nz
-
-    ALLOCATE( hor_index_bounds(4,0:0) )
-    hor_index_bounds(1,0) = nxl
-    hor_index_bounds(2,0) = nxr
-    hor_index_bounds(3,0) = nys
-    hor_index_bounds(4,0) = nyn
-
-!
-!-- Array bounds for the pressure solver (in the parallel code, these bounds are the ones for the
-!-- transposed arrays)
-    nys_x = nys
-    nyn_x = nyn
-    nzb_x = nzb + 1
-    nzt_x = nzt
-
-    nxl_y = nxl
-    nxr_y = nxr
-    nzb_y = nzb + 1
-    nzt_y = nzt
-
-    nxl_z = nxl
-    nxr_z = nxr
-    nys_z = nys
-    nyn_z = nyn
+!-- Array bounds when running on a single PE (respectively a non-parallel
+!-- machine)
+    nxl  = 0
+    nxr  = nx
+    nxra = nx
+    nnx  = nxr - nxl + 1
+    nys  = 0
+    nyn  = ny
+    nyna = ny
+    nny  = nyn - nys + 1
+    nzb  = 0
+    nzt  = nz
+    nzta = nz
+    nnz  = nz
+
+!
+!-- For non-cyclic boundaries extend array u (v) by one gridpoint
+    IF ( bc_lr /= 'cyclic' )  uxrp = 1
+    IF ( bc_ns /= 'cyclic' )  vynp = 1
+
+!
+!-- Array bounds for the pressure solver (in the parallel code, these bounds
+!-- are the ones for the transposed arrays)
+    nys_x  = nys
+    nyn_x  = nyn
+    nyn_xa = nyn
+    nzb_x  = nzb + 1
+    nzt_x  = nzt
+    nzt_xa = nzt
+
+    nxl_y  = nxl
+    nxr_y  = nxr
+    nxr_ya = nxr
+    nzb_y  = nzb + 1
+    nzt_y  = nzt
+    nzt_ya = nzt
+
+    nxl_z  = nxl
+    nxr_z  = nxr
+    nxr_za = nxr
+    nys_z  = nys
+    nyn_z  = nyn
+    nyn_za = nyn
 
 #endif
 
 !
-!-- Calculate number of grid levels necessary for the multigrid poisson solver as well as the
-!-- gridpoint indices on each level
-    IF ( psolver(1:9) == 'multigrid' )  THEN
+!-- Calculate number of grid levels necessary for the multigrid poisson solver
+!-- as well as the gridpoint indices on each level
+    IF ( psolver == 'multigrid' )  THEN
 
 !
@@ -792,43 +641,17 @@
        ENDDO
 
-       k = nz    ! do not use nnz because it might be > nz due to transposition
-                 ! requirements
+       k = nnz
        DO WHILE ( MOD( k, 2 ) == 0  .AND.  k /= 2 )
           k = k / 2
           mg_levels_z = mg_levels_z + 1
        ENDDO
-!
-!--    The optimized MG-solver does not allow odd values for nz at the coarsest grid level
-       IF ( TRIM( psolver ) /= 'multigrid_noopt' )  THEN
-          IF ( MOD( k, 2 ) /= 0 )  mg_levels_z = mg_levels_z - 1
-!
-!--       An odd value of nz does not work. The finest level must have an even value.
-          IF (  mg_levels_z == 0 )  THEN
-             message_string = 'optimized multigrid method requires nz to be even'
-             CALL message( 'init_pegrid', 'PA0495', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
 
        maximum_grid_level = MIN( mg_levels_x, mg_levels_y, mg_levels_z )
-!
-!--    Check if subdomain sizes prevents any coarsening.
-!--    This case, the maximum number of grid levels is 1, i.e. effectively a Gauss-Seidel scheme is
-!--    applied rather than a multigrid approach.
-!--    Give a warning in this case.
-       IF ( maximum_grid_level == 1  .AND.  mg_switch_to_pe0_level == -1 )  THEN
-          message_string = 'No grid coarsening possible, multigrid ' //                            &
-                           'approach effectively reduces to a Gauss-Seidel ' //                    &
-                           'scheme.'
-
-          CALL message( 'poismg', 'PA0648', 0, 1, 0, 6, 0 )
-       ENDIF
-
-!
-!--    Find out, if the total domain allows more levels. These additional levels are identically
-!--    processed on all PEs.
-       IF ( numprocs > 1  .AND.  mg_switch_to_pe0_level /= -1 )  THEN
-
+
+!
+!--    Find out, if the total domain allows more levels. These additional
+!--    levels are processed on PE0 only.
+       IF ( numprocs > 1 )  THEN
           IF ( mg_levels_z > MIN( mg_levels_x, mg_levels_y ) )  THEN
-
              mg_switch_to_pe0_level_l = maximum_grid_level
 
@@ -851,19 +674,19 @@
 
              IF ( maximum_grid_level_l > mg_switch_to_pe0_level_l )  THEN
-                mg_switch_to_pe0_level_l = maximum_grid_level_l - mg_switch_to_pe0_level_l + 1
+                mg_switch_to_pe0_level_l = maximum_grid_level_l - &
+                                           mg_switch_to_pe0_level_l + 1
              ELSE
                 mg_switch_to_pe0_level_l = 0
              ENDIF
-
           ELSE
-
              mg_switch_to_pe0_level_l = 0
              maximum_grid_level_l = maximum_grid_level
-
-          ENDIF
-
-!
-!--       Use switch level calculated above only if it is not pre-defined by user
+          ENDIF
+
+!
+!--       Use switch level calculated above only if it is not pre-defined
+!--       by user
           IF ( mg_switch_to_pe0_level == 0 )  THEN
+
              IF ( mg_switch_to_pe0_level_l /= 0 )  THEN
                 mg_switch_to_pe0_level = mg_switch_to_pe0_level_l
@@ -874,33 +697,28 @@
 !
 !--          Check pre-defined value and reset to default, if neccessary
-             IF ( mg_switch_to_pe0_level < mg_switch_to_pe0_level_l  .OR.                          &
+             IF ( mg_switch_to_pe0_level < mg_switch_to_pe0_level_l  .OR.  &
                   mg_switch_to_pe0_level >= maximum_grid_level_l )  THEN
-                message_string = 'mg_switch_to_pe0_level ' //                                      &
-                                 'out of range and reset to 0'
-                CALL message( 'init_pegrid', 'PA0235', 0, 1, 0, 6, 0 )
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ WARNING init_pegrid: mg_switch_to_pe0_level ', &
+                               'out of range and reset to default (=0)'
+                ENDIF
                 mg_switch_to_pe0_level = 0
              ELSE
 !
-!--             Use the largest number of possible levels anyway and recalculate the switch level to
-!--             this largest number of possible values
+!--             Use the largest number of possible levels anyway and recalculate
+!--             the switch level to this largest number of possible values
                 maximum_grid_level = maximum_grid_level_l
 
              ENDIF
-
-          ENDIF
-
-       ENDIF
-
-       ALLOCATE( grid_level_count(maximum_grid_level),                                             &
-                 nxl_mg(0:maximum_grid_level), nxr_mg(0:maximum_grid_level),                       &
-                 nyn_mg(0:maximum_grid_level), nys_mg(0:maximum_grid_level),                       &
-                 nzt_mg(0:maximum_grid_level) )
+          ENDIF
+
+       ENDIF
+
+       ALLOCATE( grid_level_count(maximum_grid_level),                   &
+                 nxl_mg(maximum_grid_level), nxr_mg(maximum_grid_level), &
+                 nyn_mg(maximum_grid_level), nys_mg(maximum_grid_level), &
+                 nzt_mg(maximum_grid_level) )
 
        grid_level_count = 0
-!
-!--    Index zero required as dummy due to definition of arrays f2 and p2 in recursive subroutine
-!--    next_mg_level
-       nxl_mg(0) = 0; nxr_mg(0) = 0; nyn_mg(0) = 0; nys_mg(0) = 0; nzt_mg(0) = 0
-
        nxl_l = nxl; nxr_l = nxr; nys_l = nys; nyn_l = nyn; nzt_l = nzt
 
@@ -910,5 +728,7 @@
 #if defined( __parallel )
 !
-!--          Save the grid size of the subdomain at the switch level, because it is needed in poismg.
+!--          Save the grid size of the subdomain at the switch level, because
+!--          it is needed in poismg.
+!--          Array bounds of the local subdomain grids are gathered on PE0
              ind(1) = nxl_l; ind(2) = nxr_l
              ind(3) = nys_l; ind(4) = nyn_l
@@ -924,5 +744,5 @@
              DEALLOCATE( ind_all )
 !
-!--          Calculate the grid size of the total domain
+!--          Calculate the grid size of the total domain gathered on PE0
              nxr_l = ( nxr_l-nxl_l+1 ) * pdims(1) - 1
              nxl_l = 0
@@ -930,16 +750,23 @@
              nys_l = 0
 !
-!--          The size of this gathered array must not be larger than the array tend, which is used
-!--          in the multigrid scheme as a temporary array. Therefore the subdomain size of an PE is
-!--          calculated and the size of the gathered grid. These values are used in routines pres
-!--          and poismg.
-             subdomain_size = ( nxr - nxl + 2 * nbgp + 1 ) *                                       &
-                              ( nyn - nys + 2 * nbgp + 1 ) * ( nzt - nzb + 2 )
-             gathered_size  = ( nxr_l - nxl_l + 3 ) * ( nyn_l - nys_l + 3 ) * ( nzt_l - nzb + 2 )
-
+!--          The size of this gathered array must not be larger than the
+!--          array tend, which is used in the multigrid scheme as a temporary
+!--          array
+             subdomain_size = ( nxr - nxl + 3 )     * ( nyn - nys + 3 )     * &
+                              ( nzt - nzb + 2 )
+             gathered_size  = ( nxr_l - nxl_l + 3 ) * ( nyn_l - nys_l + 3 ) * &
+                              ( nzt_l - nzb + 2 )
+
+             IF ( gathered_size > subdomain_size )  THEN
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ init_pegrid: not enough memory for storing ', &
+                               'gathered multigrid data on PE0'
+                ENDIF
+                CALL local_stop
+             ENDIF
 #else
-             message_string = 'multigrid gather/scatter impossible ' //                            &
+             PRINT*, '+++ init_pegrid: multigrid gather/scatter impossible ', &
                           'in non parallel mode'
-             CALL message( 'init_pegrid', 'PA0237', 1, 2, 0, 6, 0 )
+             CALL local_stop
 #endif
           ENDIF
@@ -951,399 +778,130 @@
           nzt_mg(i) = nzt_l
 
-          nxl_l = nxl_l / 2
+          nxl_l = nxl_l / 2 
           nxr_l = nxr_l / 2
-          nys_l = nys_l / 2
-          nyn_l = nyn_l / 2
-          nzt_l = nzt_l / 2
-
+          nys_l = nys_l / 2 
+          nyn_l = nyn_l / 2 
+          nzt_l = nzt_l / 2 
        ENDDO
 
-!
-!--    Temporary problem: Currently calculation of maxerror in routine poismg crashes if grid data
-!--    are collected on PE0 already on the finest grid level.
-!--    To be solved later.
-       IF ( maximum_grid_level == mg_switch_to_pe0_level )  THEN
-          message_string = 'grid coarsening on subdomain level cannot be performed'
-          CALL message( 'poismg', 'PA0236', 1, 2, 0, 6, 0 )
-       ENDIF
-
     ELSE
 
-       maximum_grid_level = 0
-
-    ENDIF
-
-!
-!-- Default level 0 tells exchange_horiz that all ghost planes have to be exchanged. grid_level is
-!-- adjusted in poismg, where only one ghost plane is required.
-    grid_level = 0
+       maximum_grid_level = 1
+
+    ENDIF
+
+    grid_level = maximum_grid_level
 
 #if defined( __parallel )
 !
 !-- Gridpoint number for the exchange of ghost points (y-line for 2D-arrays)
-    ngp_y  = nyn - nys + 1 + 2 * nbgp
-
-!
-!-- Define new MPI derived datatypes for the exchange of ghost points in x- and y-direction for
-!-- 2D-arrays (line)
-    CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp, ngp_y, MPI_REAL, type_x, ierr )
+    ngp_y  = nyn - nys + 1
+
+!
+!-- Define a new MPI derived datatype for the exchange of ghost points in
+!-- y-direction for 2D-arrays (line)
+    CALL MPI_TYPE_VECTOR( nxr-nxl+3, 1, ngp_y+2, MPI_REAL, type_x, ierr )
     CALL MPI_TYPE_COMMIT( type_x, ierr )
-
-    CALL MPI_TYPE_VECTOR( nbgp, ngp_y, ngp_y, MPI_REAL, type_y, ierr )
-    CALL MPI_TYPE_COMMIT( type_y, ierr )
-!
-!-- Define new MPI derived datatypes for the exchange of ghost points in x- and y-direction for
-!-- 2D-INTEGER arrays (line) - on normal grid.
-!-- Define types for 32-bit and 8-bit Integer. The 8-bit Integer are only required on normal grid,
-!-- while 32-bit Integer may be also required on coarser grid level in case of multigrid solver.
-!
-!-- 8-bit Integer
-    CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp, ngp_y, MPI_BYTE, type_x_byte, ierr )
-    CALL MPI_TYPE_COMMIT( type_x_byte, ierr )
-
-    CALL MPI_TYPE_VECTOR( nbgp, ngp_y, ngp_y, MPI_BYTE, type_y_byte, ierr )
-    CALL MPI_TYPE_COMMIT( type_y_byte, ierr )
-!
-!-- 32-bit Integer
-    ALLOCATE( type_x_int(0:maximum_grid_level), type_y_int(0:maximum_grid_level) )
-
-    CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp, ngp_y, MPI_INTEGER, type_x_int(0), ierr )
-    CALL MPI_TYPE_COMMIT( type_x_int(0), ierr )
-
-    CALL MPI_TYPE_VECTOR( nbgp, ngp_y, ngp_y, MPI_INTEGER, type_y_int(0), ierr )
-    CALL MPI_TYPE_COMMIT( type_y_int(0), ierr )
-!
-!-- Calculate gridpoint numbers for the exchange of ghost points along x (yz-plane for 3D-arrays)
-!-- and define MPI derived data type(s) for the exchange of ghost points in y-direction (xz-plane).
-!-- Do these calculations for the model grid and (if necessary) also for the coarser grid levels
-!-- used in the multigrid method
-    ALLOCATE ( ngp_xz(0:maximum_grid_level),                                                       &
-               ngp_xz_int(0:maximum_grid_level),                                                   &
-               ngp_yz(0:maximum_grid_level),                                                       &
-               ngp_yz_int(0:maximum_grid_level),                                                   &
-               type_xz(0:maximum_grid_level),                                                      &
-               type_xz_int(0:maximum_grid_level),                                                  &
-               type_yz(0:maximum_grid_level),                                                      &
-               type_yz_int(0:maximum_grid_level) )
+    CALL MPI_TYPE_VECTOR( nxr-nxl+3, 1, ngp_y+2, MPI_INTEGER, type_x_int, ierr )
+    CALL MPI_TYPE_COMMIT( type_x_int, ierr )
+
+!
+!-- Calculate gridpoint numbers for the exchange of ghost points along x
+!-- (yz-plane for 3D-arrays) and define MPI derived data type(s) for the
+!-- exchange of ghost points in y-direction (xz-plane).
+!-- Do these calculations for the model grid and (if necessary) also
+!-- for the coarser grid levels used in the multigrid method
+    ALLOCATE ( ngp_yz(maximum_grid_level), type_xz(maximum_grid_level) )
 
     nxl_l = nxl; nxr_l = nxr; nys_l = nys; nyn_l = nyn; nzb_l = nzb; nzt_l = nzt
-
-!
-!-- Discern between the model grid, which needs nbgp ghost points and grid levels for the multigrid
-!-- scheme. In the latter case only one ghost point is necessary.
-!-- First definition of MPI-datatypes for exchange of ghost layers on normal grid. The following
-!-- loop is needed for data exchange in poismg.f90.
-!
-!-- Determine number of grid points of yz-layer for exchange
-    ngp_yz(0) = (nzt - nzb + 2) * (nyn - nys + 1 + 2 * nbgp)
-
-!
-!-- Define an MPI-datatype for the exchange of left/right boundaries.
-!-- Although data are contiguous in physical memory (which does not necessarily require an
-!-- MPI-derived datatype), the data exchange between left and right PE's using the MPI-derived type
-!-- is 10% faster than without.
-    CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp*(nzt-nzb+2), ngp_yz(0), MPI_REAL, type_xz(0),     &
-                          ierr )
-    CALL MPI_TYPE_COMMIT( type_xz(0), ierr )
-
-    CALL MPI_TYPE_VECTOR( nbgp, ngp_yz(0), ngp_yz(0), MPI_REAL, type_yz(0), ierr )
-    CALL MPI_TYPE_COMMIT( type_yz(0), ierr )
-
-!
-!-- Define data types for exchange of 3D Integer arrays.
-    ngp_yz_int(0) = (nzt - nzb + 2) * (nyn - nys + 1 + 2 * nbgp)
-
-    CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp*(nzt-nzb+2), ngp_yz_int(0), MPI_INTEGER,          &
-                          type_xz_int(0), ierr )
-    CALL MPI_TYPE_COMMIT( type_xz_int(0), ierr )
-
-    CALL MPI_TYPE_VECTOR( nbgp, ngp_yz_int(0), ngp_yz_int(0), MPI_INTEGER, type_yz_int(0), ierr )
-    CALL MPI_TYPE_COMMIT( type_yz_int(0), ierr )
-
-!
-!-- Definition of MPI-datatypes for multigrid method (coarser level grids)
-    IF ( psolver(1:9) == 'multigrid' )  THEN
-!
-!--    Definition of MPI-datatyoe as above, but only 1 ghost level is used
-       DO  i = maximum_grid_level, 1 , -1
-!
-!--       For 3D-exchange on different multigrid level, one ghost point for REAL arrays, two ghost
-!--       points for INTEGER arrays
-          ngp_xz(i) = (nzt_l - nzb_l + 2) * (nxr_l - nxl_l + 3)
-          ngp_yz(i) = (nzt_l - nzb_l + 2) * (nyn_l - nys_l + 3)
-
-          ngp_xz_int(i) = (nzt_l - nzb_l + 2) * (nxr_l - nxl_l + 3)
-          ngp_yz_int(i) = (nzt_l - nzb_l + 2) * (nyn_l - nys_l + 3)
-!
-!--       MPI data type for REAL arrays, for xz-layers
-          CALL MPI_TYPE_VECTOR( nxr_l-nxl_l+3, nzt_l-nzb_l+2, ngp_yz(i), MPI_REAL, type_xz(i),     &
-                                ierr )
-          CALL MPI_TYPE_COMMIT( type_xz(i), ierr )
-
-!
-!--       MPI data type for INTEGER arrays, for xz-layers
-          CALL MPI_TYPE_VECTOR( nxr_l-nxl_l+3, nzt_l-nzb_l+2, ngp_yz_int(i), MPI_INTEGER,          &
-                                type_xz_int(i), ierr )
-          CALL MPI_TYPE_COMMIT( type_xz_int(i), ierr )
-
-!
-!--       MPI data type for REAL arrays, for yz-layers
-          CALL MPI_TYPE_VECTOR( 1, ngp_yz(i), ngp_yz(i), MPI_REAL, type_yz(i), ierr )
-          CALL MPI_TYPE_COMMIT( type_yz(i), ierr )
-!
-!--       MPI data type for INTEGER arrays, for yz-layers
-          CALL MPI_TYPE_VECTOR( 1, ngp_yz_int(i), ngp_yz_int(i), MPI_INTEGER, type_yz_int(i), ierr )
-          CALL MPI_TYPE_COMMIT( type_yz_int(i), ierr )
-
-
-!--       For 2D-exchange of INTEGER arrays on coarser grid level, where 2 ghost points need to be
-!--       exchanged. Only required for 32-bit Integer arrays.
-          CALL MPI_TYPE_VECTOR( nxr_l-nxl_l+5, 2, nyn_l-nys_l+5, MPI_INTEGER, type_x_int(i), ierr )
-          CALL MPI_TYPE_COMMIT( type_x_int(i), ierr )
-
-
-          CALL MPI_TYPE_VECTOR( 2, nyn_l-nys_l+5, nyn_l-nys_l+5, MPI_INTEGER, type_y_int(i), ierr )
-          CALL MPI_TYPE_COMMIT( type_y_int(i), ierr )
-
-          nxl_l = nxl_l / 2
-          nxr_l = nxr_l / 2
-          nys_l = nys_l / 2
-          nyn_l = nyn_l / 2
-          nzt_l = nzt_l / 2
-
-       ENDDO
-
-    ENDIF
-
+         
+    DO i = maximum_grid_level, 1 , -1
+       ngp_yz(i) = (nzt_l - nzb_l + 2) * (nyn_l - nys_l + 3)
+
+       CALL MPI_TYPE_VECTOR( nxr_l-nxl_l+3, nzt_l-nzb_l+2, ngp_yz(i), &
+                             MPI_REAL, type_xz(i), ierr )
+       CALL MPI_TYPE_COMMIT( type_xz(i), ierr )
+
+       nxl_l = nxl_l / 2 
+       nxr_l = nxr_l / 2
+       nys_l = nys_l / 2 
+       nyn_l = nyn_l / 2 
+       nzt_l = nzt_l / 2 
+    ENDDO
 #endif
 
 #if defined( __parallel )
 !
-!-- Setting of flags for inflow/outflow/nesting conditions.
+!-- Setting of flags for inflow/outflow conditions in case of non-cyclic
+!-- horizontal boundary conditions. Set variables for extending array u (v)
+!-- by one gridpoint on the left/rightmost (northest/southest) processor
     IF ( pleft == MPI_PROC_NULL )  THEN
-       IF ( bc_lr == 'dirichlet/radiation'  .OR.  bc_lr == 'nested'  .OR.                          &
-            bc_lr == 'nesting_offline' )  THEN
-          bc_dirichlet_l  = .TRUE.
-       ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
-          bc_radiation_l = .TRUE.
+       IF ( bc_lr == 'dirichlet/neumann' )  THEN
+          inflow_l  = .TRUE.
+       ELSEIF ( bc_lr == 'neumann/dirichlet' )  THEN
+          outflow_l = .TRUE.
        ENDIF
     ENDIF
 
     IF ( pright == MPI_PROC_NULL )  THEN
-       IF ( bc_lr == 'dirichlet/radiation' )  THEN
-          bc_radiation_r = .TRUE.
-       ELSEIF ( bc_lr == 'radiation/dirichlet'  .OR.  bc_lr == 'nested'  .OR.                      &
-                bc_lr == 'nesting_offline' )  THEN
-          bc_dirichlet_r  = .TRUE.
-       ENDIF
+       IF ( bc_lr == 'dirichlet/neumann' )  THEN
+          outflow_r = .TRUE.
+       ELSEIF ( bc_lr == 'neumann/dirichlet' )  THEN
+          inflow_r  = .TRUE.
+       ENDIF
+       uxrp      = 1
     ENDIF
 
     IF ( psouth == MPI_PROC_NULL )  THEN
-       IF ( bc_ns == 'dirichlet/radiation' )  THEN
-          bc_radiation_s = .TRUE.
-       ELSEIF ( bc_ns == 'radiation/dirichlet'  .OR.  bc_ns == 'nested'  .OR.                      &
-                bc_ns == 'nesting_offline' )  THEN
-          bc_dirichlet_s  = .TRUE.
+       IF ( bc_ns == 'dirichlet/neumann' )  THEN
+          outflow_s = .TRUE.
+       ELSEIF ( bc_ns == 'neumann/dirichlet' )  THEN
+          inflow_s  = .TRUE.
        ENDIF
     ENDIF
 
     IF ( pnorth == MPI_PROC_NULL )  THEN
-       IF ( bc_ns == 'dirichlet/radiation'  .OR.  bc_ns == 'nested'  .OR.                          &
-            bc_ns == 'nesting_offline' )  THEN
-          bc_dirichlet_n  = .TRUE.
-       ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
-          bc_radiation_n = .TRUE.
-       ENDIF
-    ENDIF
-!
-!-- In case of synthetic turbulence geneartor determine ids.
-!-- Please note, if no forcing or nesting is applied, the generator is applied only at the left
-!-- lateral boundary.
-    IF ( syn_turb_gen )  THEN
-       IF ( bc_dirichlet_l )  THEN
-          id_stg_left_l = myidx
-       ELSE
-          id_stg_left_l = 0
-       ENDIF
-       IF ( bc_dirichlet_r )  THEN
-          id_stg_right_l = myidx
-       ELSE
-          id_stg_right_l = 0
-       ENDIF
-       IF ( bc_dirichlet_s )  THEN
-          id_stg_south_l = myidy
-       ELSE
-          id_stg_south_l = 0
-       ENDIF
-       IF ( bc_dirichlet_n )  THEN
-          id_stg_north_l = myidy
-       ELSE
-          id_stg_north_l = 0
-       ENDIF
-
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( id_stg_left_l, id_stg_left,   1, MPI_INTEGER, MPI_SUM, comm1dx, ierr )
-
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( id_stg_right_l, id_stg_right, 1, MPI_INTEGER, MPI_SUM, comm1dx, ierr )
-
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( id_stg_south_l, id_stg_south, 1, MPI_INTEGER, MPI_SUM, comm1dy, ierr )
-
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( id_stg_north_l, id_stg_north, 1, MPI_INTEGER, MPI_SUM, comm1dy, ierr )
-
-    ENDIF
-
-!
-!-- Broadcast the id of the inflow PE
-    IF ( bc_dirichlet_l )  THEN
-       id_inflow_l = myidx
+       IF ( bc_ns == 'dirichlet/neumann' )  THEN
+          inflow_n  = .TRUE.
+       ELSEIF ( bc_ns == 'neumann/dirichlet' )  THEN
+          outflow_n = .TRUE.
+       ENDIF
+       vynp      = 1
+    ENDIF
+
+!
+!-- Additional MPI derived data type for the exchange of ghost points along x
+!-- needed in case of non-cyclic boundary conditions along y on the northmost
+!-- processors (for the exchange of the enlarged v array)
+    IF ( bc_ns /= 'cyclic'  .AND.  pnorth == MPI_PROC_NULL )  THEN
+       ngp_yz_p = ( nzt - nzb + 2 ) * ( nyn + vynp - nys + 3 )
+       CALL MPI_TYPE_VECTOR( nxr-nxl+3, nzt-nzb+2, ngp_yz_p, &
+                             MPI_REAL, type_xz_p, ierr )
+       CALL MPI_TYPE_COMMIT( type_xz_p, ierr )
+    ENDIF
+#else
+    IF ( bc_lr == 'dirichlet/neumann' )  THEN
+       inflow_l  = .TRUE.
+       outflow_r = .TRUE.
+       uxrp      = 1
+    ELSEIF ( bc_lr == 'neumann/dirichlet' )  THEN
+       outflow_l = .TRUE.
+       inflow_r  = .TRUE.
+    ENDIF
+
+    IF ( bc_ns == 'dirichlet/neumann' )  THEN
+       inflow_n  = .TRUE.
+       outflow_s = .TRUE.
+    ELSEIF ( bc_ns == 'neumann/dirichlet' )  THEN
+       outflow_n = .TRUE.
+       inflow_s  = .TRUE.
+       vynp      = 1
+    ENDIF
+#endif
+
+    IF ( psolver == 'poisfft_hybrid' )  THEN
+       CALL poisfft_hybrid_ini
     ELSE
-       id_inflow_l = 0
-    ENDIF
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( id_inflow_l, id_inflow, 1, MPI_INTEGER, MPI_SUM, comm1dx, ierr )
-
-!
-!-- Broadcast the id of the recycling plane
-!-- WARNING: needs to be adjusted in case of inflows other than from left side!
-    IF ( turbulent_inflow ) THEN
-
-       IF ( NINT( recycling_width / dx, KIND=idp ) >= nxl  .AND.                                   &
-            NINT( recycling_width / dx, KIND=idp ) <= nxr )  THEN
-          id_recycling_l = myidx
-       ELSE
-          id_recycling_l = 0
-       ENDIF
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( id_recycling_l, id_recycling, 1, MPI_INTEGER, MPI_SUM, comm1dx, ierr )
-
-    ENDIF
-
-!
-!-- Broadcast the id of the outflow PE and outflow-source plane
-    IF ( turbulent_outflow )  THEN
-
-       IF ( bc_radiation_r )  THEN
-          id_outflow_l = myidx
-       ELSE
-          id_outflow_l = 0
-       ENDIF
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( id_outflow_l, id_outflow, 1, MPI_INTEGER, MPI_SUM, &
-                           comm1dx, ierr )
-
-       IF ( NINT( outflow_source_plane / dx ) >= nxl  .AND.                                        &
-            NINT( outflow_source_plane / dx ) <= nxr )  THEN
-          id_outflow_source_l = myidx
-       ELSE
-          id_outflow_source_l = 0
-       ENDIF
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( id_outflow_source_l, id_outflow_source, 1, MPI_INTEGER, MPI_SUM,        &
-                           comm1dx, ierr )
-
-    ENDIF
-
-    CALL location_message( 'creating virtual PE grids + MPI derived data types', 'finished' )
-
-#else
-    IF ( bc_lr == 'dirichlet/radiation' )  THEN
-       bc_dirichlet_l = .TRUE.
-       bc_radiation_r = .TRUE.
-    ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
-       bc_radiation_l = .TRUE.
-       bc_dirichlet_r = .TRUE.
-    ENDIF
-
-    IF ( bc_ns == 'dirichlet/radiation' )  THEN
-       bc_dirichlet_n = .TRUE.
-       bc_radiation_s = .TRUE.
-    ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
-       bc_radiation_n = .TRUE.
-       bc_dirichlet_s = .TRUE.
-    ENDIF
-#endif
-
-!
-!-- At the inflow or outflow, u or v, respectively, have to be calculated for one more grid point.
-    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-       nxlu = nxl + 1
-    ELSE
-       nxlu = nxl
-    ENDIF
-    IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-       nysv = nys + 1
-    ELSE
-       nysv = nys
-    ENDIF
-
-!
-!-- Allocate wall flag arrays used in the multigrid solver
-    IF ( psolver(1:9) == 'multigrid' )  THEN
-
-       DO  i = maximum_grid_level, 1, -1
-
-           SELECT CASE ( i )
-
-              CASE ( 1 )
-                 ALLOCATE( wall_flags_1(nzb:nzt_mg(i)+1,                                           &
-                                        nys_mg(i)-1:nyn_mg(i)+1,                                   &
-                                        nxl_mg(i)-1:nxr_mg(i)+1) )
-
-              CASE ( 2 )
-                 ALLOCATE( wall_flags_2(nzb:nzt_mg(i)+1,                                           &
-                                        nys_mg(i)-1:nyn_mg(i)+1,                                   &
-                                        nxl_mg(i)-1:nxr_mg(i)+1) )
-
-              CASE ( 3 )
-                 ALLOCATE( wall_flags_3(nzb:nzt_mg(i)+1,                                           &
-                                        nys_mg(i)-1:nyn_mg(i)+1,                                   &
-                                        nxl_mg(i)-1:nxr_mg(i)+1) )
-
-              CASE ( 4 )
-                 ALLOCATE( wall_flags_4(nzb:nzt_mg(i)+1,                                           &
-                                        nys_mg(i)-1:nyn_mg(i)+1,                                   &
-                                        nxl_mg(i)-1:nxr_mg(i)+1) )
-
-              CASE ( 5 )
-                 ALLOCATE( wall_flags_5(nzb:nzt_mg(i)+1,                                           &
-                                        nys_mg(i)-1:nyn_mg(i)+1,                                   &
-                                        nxl_mg(i)-1:nxr_mg(i)+1) )
-
-              CASE ( 6 )
-                 ALLOCATE( wall_flags_6(nzb:nzt_mg(i)+1,                                           &
-                                        nys_mg(i)-1:nyn_mg(i)+1,                                   &
-                                        nxl_mg(i)-1:nxr_mg(i)+1) )
-
-              CASE ( 7 )
-                 ALLOCATE( wall_flags_7(nzb:nzt_mg(i)+1,                                           &
-                                        nys_mg(i)-1:nyn_mg(i)+1,                                   &
-                                        nxl_mg(i)-1:nxr_mg(i)+1) )
-
-              CASE ( 8 )
-                 ALLOCATE( wall_flags_8(nzb:nzt_mg(i)+1,                                           &
-                                        nys_mg(i)-1:nyn_mg(i)+1,                                   &
-                                        nxl_mg(i)-1:nxr_mg(i)+1) )
-
-              CASE ( 9 )
-                 ALLOCATE( wall_flags_9(nzb:nzt_mg(i)+1,                                           &
-                                        nys_mg(i)-1:nyn_mg(i)+1,                                   &
-                                        nxl_mg(i)-1:nxr_mg(i)+1) )
-
-              CASE ( 10 )
-                 ALLOCATE( wall_flags_10(nzb:nzt_mg(i)+1,                                          &
-                                        nys_mg(i)-1:nyn_mg(i)+1,                                   &
-                                        nxl_mg(i)-1:nxr_mg(i)+1) )
-
-              CASE DEFAULT
-                 message_string = 'more than 10 multigrid levels'
-                 CALL message( 'init_pegrid', 'PA0238', 1, 2, 0, 6, 0 )
-
-          END SELECT
-
-       ENDDO
-
+       CALL poisfft_init
     ENDIF
 
Index: palm/trunk/SOURCE/init_pt_anomaly.f90
===================================================================
--- palm/trunk/SOURCE/init_pt_anomaly.f90	(revision 4901)
+++ palm/trunk/SOURCE/init_pt_anomaly.f90	(revision 1)
@@ -1,44 +1,30 @@
-!> @file init_pt_anomaly.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE init_pt_anomaly
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: init_pt_anomaly.f90,v $
+! Revision 1.7  2005/03/26 20:36:55  raasch
+! Arguments for non-cyclic boundary conditions added to argument list of
+! routine exchange_horiz
 !
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
+! Revision 1.6  2001/03/30 07:32:28  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
+! Revision 1.5  2001/01/22 19:40:09  letzel
+! All comments translated into English.
 !
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
+! Revision 1.4  2001/01/22 07:19:14  raasch
+! Module test_variables removed
 !
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
+! Revision 1.3  1998/07/06 12:17:25  raasch
+! + USE test_variables
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! Added topography flags
+! Revision 1.2  1997/09/12 06:26:16  raasch
+! Stoerungsradius jetzt proportional zur Gitterweite
 !
 ! Revision 1.1  1997/08/29 08:58:56  raasch
@@ -48,110 +34,50 @@
 ! Description:
 ! ------------
-!> Impose a temperature perturbation for an advection test.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_pt_anomaly
+! Impose a temperature perturbation for an advection test.
+!------------------------------------------------------------------------------!
 
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  pt, zu
-
+    USE arrays_3d
+    USE constants
+    USE grid_variables
+    USE indices
     USE control_parameters
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxr, ny, nyn, nys, nzb, nzt, wall_flags_total_0
-
-    USE kinds
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i  !< grid index along x
-    INTEGER(iwp) ::  ic !< center index along x
-    INTEGER(iwp) ::  j  !< grid index along y
-    INTEGER(iwp) ::  jc !< center index along y
-    INTEGER(iwp) ::  k  !< grid index along z
-    INTEGER(iwp) ::  kc !< center index along z
-
-    REAL(wp)     ::  amount                               !< amount of temperature perturbation
-    REAL(wp)     ::  bubble_center_y                      !< center of bubble in y
-    REAL(wp)     ::  bubble_center_z = 170.0              !< center of bubble in z
-    REAL(wp)     ::  bubble_sigma_y = 300.0               !< width of bubble in y
-    REAL(wp)     ::  bubble_sigma_z = 150.0               !< width of bubble in z
-    REAL(wp)     ::  flag                                 !< flag to mask topography grid points
-    REAL(wp)     ::  initial_temperature_difference = 0.4 !< temperature perturbation for bubble in K
-    REAL(wp)     ::  radius                               !< radius of pt anomaly
-    REAL(wp)     ::  rc                                   !< radius of pt anomaly
-    REAL(wp)     ::  x                                    !< x dimension of pt anomaly
-    REAL(wp)     ::  y                                    !< y dimension of pt anomaly
-    REAL(wp)     ::  z                                    !< z dimension of pt anomaly
-
+    INTEGER ::  i, ic, j, jc, k, kc
+    REAL    ::  betrag, radius, rc, x, y, z
 
 !
 !-- Defaults: radius rc, strength z,
-!--           position of center: ic, jc, kc
-    rc =  10.0_wp * dx
+!--           position of centre: ic, jc, kc
+    rc =  10.0 * dx
     ic =  ( nx+1 ) / 2
     jc =  ic
-    kc =  nzt / 2
+    kc = nzt / 2
 
-    IF ( INDEX( initializing_actions, 'initialize_ptanom' ) /= 0 )  THEN
 !
-!--    Compute the perturbation.
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
+!-- Compute the perturbation.
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt-1
+             x = ( i - ic ) * dx
+             y = ( j - jc ) * dy
+             z = ABS( zu(k) - zu(kc) )
+             radius = SQRT( x**2 + y**2 + z**2 )
+             IF ( radius <= rc )  THEN
+                betrag = 5.0 * EXP( -( radius / 2.0 )**2 )
+             ELSE
+                betrag = 0.0
+             ENDIF
 
-                x = ( i - ic ) * dx
-                y = ( j - jc ) * dy
-                z = ABS( zu(k) - zu(kc) )
-                radius = SQRT( x**2 + y**2 + z**2 )
-                IF ( radius <= rc )  THEN
-                   amount = 5.0_wp * EXP( -( radius * 0.001_wp / 2.0_wp )**2 )
-                ELSE
-                   amount = 0.0_wp
-                ENDIF
+             pt(k,j,i) = pt(k,j,i) + betrag
 
-                pt(k,j,i) = pt(k,j,i) + amount * flag
-
-             ENDDO
           ENDDO
        ENDDO
-
-!
-!-- Initialize warm air bubble close to surface and homogenous elegonated along x-Axis
-    ELSEIF ( INDEX( initializing_actions, 'initialize_bubble' ) /= 0 )  THEN
-!
-!--    Calculate y-center of model domain
-       bubble_center_y = ( ny + 1.0 ) * dy / 2.0
-
-!
-!--    Compute perturbation for potential temperaure
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                pt(k,j,i) = pt(k,j,i) +                                                            &
-                               EXP( -0.5 * ( (j* dy - bubble_center_y) / bubble_sigma_y )**2) *    &
-                               EXP( -0.5 * ( (zu(k) - bubble_center_z) / bubble_sigma_z)**2)  *    &
-                               initial_temperature_difference * flag
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
+    ENDDO
 
 !
 !-- Exchange of boundary values for temperature
-    CALL exchange_horiz( pt, nbgp )
+    CALL exchange_horiz( pt, 0, 0 )
 
 
Index: palm/trunk/SOURCE/init_rankine.f90
===================================================================
--- palm/trunk/SOURCE/init_rankine.f90	(revision 4901)
+++ palm/trunk/SOURCE/init_rankine.f90	(revision 1)
@@ -1,37 +1,43 @@
-!> @file init_rankine.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE init_rankine
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: init_rankine.f90,v $
+! Revision 1.11  2005/03/26 20:38:49  raasch
+! Arguments for non-cyclic boundary conditions added to argument list of
+! routine exchange_horiz
 !
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
+! Revision 1.10  2004/01/28 15:11:27  raasch
+! Setting of bt before calling pres removed
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.9  2001/03/30 07:32:49  raasch
+! Arguments removed from pres,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! Modularization of all bulk cloud physics code components
+! Revision 1.8  2001/01/22 19:44:52  letzel
+! All comments translated into English.
+!
+! Revision 1.7  2001/01/22 07:20:30  raasch
+! Module test_variables removed
+!
+! Revision 1.6  1998/07/06 12:17:44  raasch
+! + USE test_variables
+!
+! Revision 1.5  1998/04/15 11:20:38  raasch
+! pt, usws und vsws werden an pres uebergeben
+!
+! Revision 1.4  1997/09/12 06:26:30  raasch
+! Wirbelradius jetzt proportional zur Gitterweite
+!
+! Revision 1.3  1997/09/09 08:29:24  raasch
+! Kehrwerte der Gitterweiten implementiert
+!
+! Revision 1.2  1997/08/26 06:31:33  raasch
+! +tend in pres-Aufruf
 !
 ! Revision 1.1  1997/08/11 06:18:43  raasch
@@ -41,53 +47,23 @@
 ! Description:
 ! ------------
-!> Initialize a (nondivergent) Rankine eddy with a vertical axis in order to test the advection
-!> terms and the pressure solver.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_rankine
+! Initialize a (nondivergent) Rankine eddy with a vertical axis in order to test 
+! the advection terms and the pressure solver.
+!------------------------------------------------------------------------------!
 
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  pt, pt_init, u, u_init, v, v_init
-
-    USE control_parameters,                                                                        &
-        ONLY:  initializing_actions, n_sor, nsor, nsor_ini
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  pi
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
-
-    USE kinds
+    USE arrays_3d
+    USE constants
+    USE grid_variables
+    USE indices
+    USE control_parameters
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i   !<
-    INTEGER(iwp) ::  ic  !<
-    INTEGER(iwp) ::  j   !<
-    INTEGER(iwp) ::  jc  !<
-    INTEGER(iwp) ::  k   !<
-    INTEGER(iwp) ::  kc1 !<
-    INTEGER(iwp) ::  kc2 !<
-
-    REAL(wp)     ::  alpha  !<
-    REAL(wp)     ::  betrag !<
-    REAL(wp)     ::  radius !<
-    REAL(wp)     ::  rc     !<
-    REAL(wp)     ::  uw     !<
-    REAL(wp)     ::  vw     !<
-    REAL(wp)     ::  x      !<
-    REAL(wp)     ::  y      !<
+    INTEGER ::  i, ic, j, jc, k, kc1, kc2
+    REAL    ::  alpha, betrag, radius, rc, uw, vw, x, y
 
 !
 !-- Default: eddy radius rc, eddy strength z,
 !--          position of eddy centre: ic, jc, kc1, kc2
-    rc  =  4.0_wp * dx
+    rc  =  4.0 * dx
     ic  =  ( nx+1 ) / 2
     jc  =  ic
@@ -96,42 +72,30 @@
 
 !
-!-- Reset initial profiles to constant profiles
-    IF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )  THEN
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-             pt(:,j,i) = pt_init
-             u(:,j,i)  = u_init
-             v(:,j,i)  = v_init
-          ENDDO
-       ENDDO
-    ENDIF
-
-!
 !-- Compute the u-component.
     DO  i = nxl, nxr
        DO  j = nys, nyn
-          x = ( i - ic - 0.5_wp ) * dx
-          y = ( j - jc          ) * dy
+          x = ( i - ic - 0.5 ) * dx
+          y = ( j - jc ) * dy
           radius = SQRT( x**2 + y**2 )
-          IF ( radius <= 2.0_wp * rc )  THEN
-             betrag = radius / ( 2.0_wp * rc ) * 0.08_wp
-          ELSEIF ( radius > 2.0_wp * rc  .AND.  radius < 8.0_wp * rc )  THEN
-             betrag = 0.08_wp * EXP( -( radius - 2.0_wp * rc ) / 2.0_wp )
+          IF ( radius <= 2.0 * rc )  THEN
+             betrag = radius / ( 2.0 * rc ) * 0.08
+          ELSEIF ( radius > 2.0 * rc  .AND.  radius < 8.0 * rc )  THEN
+             betrag = 0.08 * EXP( -( radius - 2.0 * rc ) / 2.0 )
           ELSE
-             betrag = 0.0_wp
+             betrag = 0.0
           ENDIF
 
-          IF ( x == 0.0_wp )  THEN
-             IF ( y > 0.0_wp )  THEN
-                alpha = pi / 2.0_wp
-             ELSEIF ( y < 0.0_wp )  THEN
-                alpha = 3.0_wp * pi / 2.0_wp
+          IF ( x == 0.0 )  THEN
+             IF ( y > 0.0 )  THEN
+                alpha = pi / 2.0
+             ELSEIF ( y < 0.0 )  THEN
+                alpha = 3.0 * pi / 2.0
              ENDIF
           ELSE
-             IF ( x < 0.0_wp )  THEN
+             IF ( x < 0.0 )  THEN
                 alpha = ATAN( y / x ) + pi
              ELSE
-                IF ( y < 0.0_wp )  THEN
-                   alpha = ATAN( y / x ) + 2.0_wp * pi
+                IF ( y < 0.0 )  THEN
+                   alpha = ATAN( y / x ) + 2.0 * pi
                 ELSE
                    alpha = ATAN( y / x )
@@ -152,27 +116,27 @@
     DO  i = nxl, nxr
        DO  j = nys, nyn
-          x = ( i - ic          ) * dx
-          y = ( j - jc - 0.5_wp ) * dy
+          x = ( i - ic ) * dx
+          y = ( j - jc - 0.5) * dy
           radius = SQRT( x**2 + y**2 )
-          IF ( radius <= 2.0_wp * rc )  THEN
-             betrag = radius / ( 2.0_wp * rc ) * 0.08_wp
-          ELSEIF ( radius > 2.0_wp * rc  .AND.  radius < 8.0_wp * rc )  THEN
-             betrag = 0.08_wp * EXP( -( radius - 2.0_wp * rc ) / 2.0_wp )
+          IF ( radius <= 2.0 * rc )  THEN
+             betrag = radius / ( 2.0 * rc ) * 0.08
+          ELSEIF ( radius > 2.0 * rc  .AND.  radius < 8.0 * rc )  THEN
+             betrag = 0.08 * EXP( -( radius - 2.0 * rc ) / 2.0 )
           ELSE
-             betrag = 0.0_wp
+             betrag = 0.0
           ENDIF
 
-          IF ( x == 0.0_wp )  THEN
-             IF ( y > 0.0_wp )  THEN
-                alpha = pi / 2.0_wp
-             ELSEIF ( y < 0.0_wp )  THEN
-                alpha = 3.0_wp * pi / 2.0_wp
+          IF ( x == 0.0 )  THEN
+             IF ( y > 0.0 )  THEN
+                alpha = pi / 2.0
+             ELSEIF ( y < 0.0 )  THEN
+                alpha = 3.0 * pi / 2.0
              ENDIF
           ELSE
-             IF ( x < 0.0_wp )  THEN
+             IF ( x < 0.0 )  THEN
                 alpha = ATAN( y / x ) + pi
              ELSE
-                IF ( y < 0.0_wp )  THEN
-                   alpha = ATAN( y / x ) + 2.0_wp * pi
+                IF ( y < 0.0 )  THEN
+                   alpha = ATAN( y / x ) + 2.0 * pi
                 ELSE
                    alpha = ATAN( y / x )
@@ -191,6 +155,6 @@
 !
 !-- Exchange of boundary values for the velocities.
-    CALL exchange_horiz( u, nbgp)
-    CALL exchange_horiz( v, nbgp )
+    CALL exchange_horiz( u, uxrp,    0 )
+    CALL exchange_horiz( v,    0, vynp )
 !
 !-- Make velocity field nondivergent.
Index: palm/trunk/SOURCE/init_slope.f90
===================================================================
--- palm/trunk/SOURCE/init_slope.f90	(revision 4901)
+++ palm/trunk/SOURCE/init_slope.f90	(revision 1)
@@ -1,34 +1,23 @@
-!> @file init_slope.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE init_slope
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: init_slope.f90,v $
+! Revision 1.5  2006/02/23 12:35:34  raasch
+! nanz_2dh renamed ngp_2dh
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.4  2003/03/16 09:40:02  raasch
+! Two underscores (_) are placed in front of all define-strings
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! Modularization of all bulk cloud physics code components
+! Revision 1.3  2001/03/30 07:33:59  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.2  2001/01/22 07:21:35  raasch
+! Module test_variables removed
 !
 ! Revision 1.1  2000/04/27 07:06:24  raasch
@@ -38,56 +27,36 @@
 ! Description:
 ! ------------
-!> Initialization of the temperature field and other variables used in case of a sloping surface.
-!> @note when a sloping surface is used, only one constant temperature
-!>       gradient is allowed!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_slope
+! Initialization of the temperature field and other variables used in case
+! of a sloping surface.
+! Remember: when a sloping surface is used, only one constant temperature
+!           gradient is allowed!
+!-------------------------------------------------------------------------------!
 
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  pt, pt_init, pt_slope_ref, zu
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  pi
-
-    USE control_parameters,                                                                        &
-        ONLY:  alpha_surface, initializing_actions, pt_slope_offset, pt_surface,                   &
-               pt_vertical_gradient, sin_alpha_surface
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx
-
-    USE indices,                                                                                   &
-        ONLY:  ngp_2dh, nx, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
-
-    USE kinds
-
+    USE arrays_3d
+    USE constants
+    USE grid_variables
+    USE indices
     USE pegrid
-
+    USE control_parameters
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i        !<
-    INTEGER(iwp) ::  j        !<
-    INTEGER(iwp) ::  k        !<
-
-    REAL(wp)     ::  alpha    !<
-    REAL(wp)     ::  height   !<
-    REAL(wp)     ::  pt_value !<
-    REAL(wp)     ::  radius   !<
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt_init_local !<
+    INTEGER ::  i, j, k
+    REAL    ::  alpha, height, pt_value, radius
+    REAL, DIMENSION(:), ALLOCATABLE ::  pt_init_local
 
 !
 !-- Calculate reference temperature field needed for computing buoyancy
-    ALLOCATE( pt_slope_ref(nzb:nzt+1,nxlg:nxrg) )
+    ALLOCATE( pt_slope_ref(nzb:nzt+1,nxl-1:nxr+1) )
 
-    DO  i = nxlg, nxrg
+    DO  i = nxl-1, nxr+1
        DO  k = nzb, nzt+1
 
 !
-!--       Compute height of grid-point relative to lower left corner of the total domain.
-!--       First compute the distance between the actual grid point and the lower left corner as well
-!--       as the angle between the line connecting these points and the bottom of the model.
+!--       Compute height of grid-point relative to lower left corner of
+!--       the total domain.
+!--       First compute the distance between the actual grid point and the
+!--       lower left corner as well as the angle between the line connecting
+!--       these points and the bottom of the model.
           IF ( k /= nzb )  THEN
              radius = SQRT( ( i * dx )**2 + zu(k)**2 )
@@ -95,23 +64,25 @@
           ELSE
              radius = SQRT( ( i * dx )**2 )
-             height = 0.0_wp
+             height = 0.0
           ENDIF
-          IF ( radius /= 0.0_wp )  THEN
+          IF ( radius /= 0.0 )  THEN
              alpha = ASIN( height / radius )
           ELSE
-             alpha = 0.0_wp
+             alpha = 0.0
           ENDIF
 !
 !--       Compute temperatures in the rotated coordinate system
-          alpha    = alpha + alpha_surface / 180.0_wp * pi
-          pt_value = pt_surface + radius * SIN( alpha ) * pt_vertical_gradient(1) / 100.0_wp
+          alpha    = alpha + alpha_surface / 180.0 * pi
+          pt_value = pt_surface + radius * SIN( alpha ) * &
+                                  pt_vertical_gradient(1) / 100.0
           pt_slope_ref(k,i) = pt_value
-       ENDDO
+       ENDDO                
     ENDDO
 
 !
-!-- Temperature difference between left and right boundary of the total domain, used for the cyclic
-!-- boundary in x-direction
-    pt_slope_offset = (nx+1) * dx * sin_alpha_surface * pt_vertical_gradient(1) / 100.0_wp
+!-- Temperature difference between left and right boundary of the total domain,
+!-- used for the cyclic boundary in x-direction
+    pt_slope_offset = (nx+1) * dx * sin_alpha_surface * &
+                      pt_vertical_gradient(1) / 100.0
 
 
@@ -121,13 +92,13 @@
 !
 !--    Set initial temperature equal to the reference temperature field
-       DO  j = nysg, nyng
+       DO  j = nys-1, nyn+1
           pt(:,j,:) = pt_slope_ref
        ENDDO
 
 !
-!--    Recompute the mean initial temperature profile (mean along x-direction of the rotated
-!--    coordinate system)
+!--    Recompute the mean initial temperature profile (mean along x-direction of
+!--    the rotated coordinate system)
        ALLOCATE( pt_init_local(nzb:nzt+1) )
-       pt_init_local = 0.0_wp
+       pt_init_local = 0.0
        DO  i = nxl, nxr
           DO  j =  nys, nyn
@@ -136,17 +107,17 @@
              ENDDO
           ENDDO
-       ENDDO
+      ENDDO
 
 #if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( pt_init_local, pt_init, nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d, ierr )
+      CALL MPI_ALLREDUCE( pt_init_local, pt_init, nzt+2-nzb, MPI_REAL, &
+                           MPI_SUM, comm2d, ierr )
 #else
-       pt_init = pt_init_local
+      pt_init = pt_init_local
 #endif
 
-       pt_init = pt_init / ngp_2dh(0)
-       DEALLOCATE( pt_init_local )
+      pt_init = pt_init / ngp_2dh(0)
+      DEALLOCATE( pt_init_local )
 
-    ENDIF
+   ENDIF
 
  END SUBROUTINE init_slope
Index: palm/trunk/SOURCE/init_vertical_profiles.f90
===================================================================
--- palm/trunk/SOURCE/init_vertical_profiles.f90	(revision 4901)
+++ 	(revision )
@@ -1,147 +1,0 @@
-!> @file ocean_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2017-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! split from check_parameters as separate file to avoid circular dependency with ocean_mod
-!
-!
-!
-!
-! Authors:
-! --------
-! @author Siegfried Raasch
-!
-! Description:
-! ------------
-!> Inititalizes the vertical profiles of scalar quantities.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_vertical_profiles( vertical_gradient_level_ind,                                   &
-                                    vertical_gradient_level,                                       &
-                                    vertical_gradient, initial_profile,                            &
-                                    surface_value, bc_top_gradient )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzu, zu
-
-    USE control_parameters,                                                                        &
-        ONLY:  ocean_mode
-
-    USE indices,                                                                                   &
-        ONLY:  nz, nzt
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< loop counter
-    INTEGER(iwp) ::  k  !< loop counter
-
-    INTEGER(iwp), DIMENSION(1:10) ::  vertical_gradient_level_ind  !< vertical grid indices for gradient levels
-
-    REAL(wp)     ::  bc_top_gradient  !< model top gradient
-    REAL(wp)     ::  gradient         !< vertica gradient of the respective quantity
-    REAL(wp)     ::  surface_value    !< surface value of the respecitve quantity
-
-    REAL(wp), DIMENSION(0:nz+1) ::  initial_profile          !< initialisation profile
-    REAL(wp), DIMENSION(1:10)   ::  vertical_gradient        !< given vertical gradient
-    REAL(wp), DIMENSION(1:10)   ::  vertical_gradient_level  !< given vertical gradient level
-
-    i = 1
-    gradient = 0.0_wp
-
-    IF ( .NOT. ocean_mode )  THEN
-
-       vertical_gradient_level_ind(1) = 0
-       DO  k = 1, nzt+1
-          IF ( i < 11 )  THEN
-             IF ( vertical_gradient_level(i) < zu(k)  .AND.                                        &
-                  vertical_gradient_level(i) >= 0.0_wp )  THEN
-                gradient = vertical_gradient(i) / 100.0_wp
-                vertical_gradient_level_ind(i) = k - 1
-                i = i + 1
-             ENDIF
-          ENDIF
-          IF ( gradient /= 0.0_wp )  THEN
-             IF ( k /= 1 )  THEN
-                initial_profile(k) = initial_profile(k-1) + dzu(k) * gradient
-             ELSE
-                initial_profile(k) = initial_profile(k-1) + dzu(k) * gradient
-             ENDIF
-          ELSE
-             initial_profile(k) = initial_profile(k-1)
-          ENDIF
-!
-!--       Avoid negative values of scalars
-          IF ( initial_profile(k) < 0.0_wp )  THEN
-             initial_profile(k) = 0.0_wp
-          ENDIF
-       ENDDO
-
-    ELSE
-
-!
-!--    In ocean mode, profiles are constructed starting from the ocean surface, which is at the top
-!--    of the model domain
-       vertical_gradient_level_ind(1) = nzt+1
-       DO  k = nzt, 0, -1
-          IF ( i < 11 )  THEN
-             IF ( vertical_gradient_level(i) > zu(k)  .AND.                                        &
-                  vertical_gradient_level(i) <= 0.0_wp )  THEN
-                gradient = vertical_gradient(i) / 100.0_wp
-                vertical_gradient_level_ind(i) = k + 1
-                i = i + 1
-             ENDIF
-          ENDIF
-          IF ( gradient /= 0.0_wp )  THEN
-             IF ( k /= nzt )  THEN
-                initial_profile(k) = initial_profile(k+1) - dzu(k+1) * gradient
-             ELSE
-                initial_profile(k)   = surface_value - 0.5_wp * dzu(k+1) * gradient
-                initial_profile(k+1) = surface_value + 0.5_wp * dzu(k+1) * gradient
-             ENDIF
-          ELSE
-             initial_profile(k) = initial_profile(k+1)
-          ENDIF
-!
-!--       Avoid negative values of scalars
-          IF ( initial_profile(k) < 0.0_wp )  THEN
-             initial_profile(k) = 0.0_wp
-          ENDIF
-       ENDDO
-
-    ENDIF
-
-!
-!-- In case of no given gradients, choose zero gradient conditions
-    IF ( vertical_gradient_level(1) == -999999.9_wp )  THEN
-       vertical_gradient_level(1) = 0.0_wp
-    ENDIF
-!
-!-- Store gradient at the top boundary for possible Neumann boundary condition
-    bc_top_gradient  = ( initial_profile(nzt+1) - initial_profile(nzt) ) / dzu(nzt+1)
-
- END SUBROUTINE init_vertical_profiles
Index: palm/trunk/SOURCE/interaction_droplets_ptq.f90
===================================================================
--- palm/trunk/SOURCE/interaction_droplets_ptq.f90	(revision 1)
+++ palm/trunk/SOURCE/interaction_droplets_ptq.f90	(revision 1)
@@ -0,0 +1,85 @@
+ MODULE interaction_droplets_ptq_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: interaction_droplets_ptq.f90,v $
+! 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.
+!------------------------------------------------------------------------------!
+
+    PRIVATE
+    PUBLIC interaction_droplets_ptq
+
+    INTERFACE interaction_droplets_ptq
+       MODULE PROCEDURE interaction_droplets_ptq
+       MODULE PROCEDURE interaction_droplets_ptq_ij
+    END INTERFACE interaction_droplets_ptq
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE interaction_droplets_ptq
+
+       USE arrays_3d
+       USE cloud_parameters
+       USE control_parameters
+       USE indices
+
+       USE pegrid
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+
+ 
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_2d(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)
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE interaction_droplets_ptq
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE interaction_droplets_ptq_ij( i, j )
+
+       USE arrays_3d
+       USE cloud_parameters
+       USE control_parameters
+       USE indices
+
+       USE pegrid
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+
+
+       DO  k = nzb_2d(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)
+       ENDDO
+
+    END SUBROUTINE interaction_droplets_ptq_ij
+
+ END MODULE interaction_droplets_ptq_mod
Index: palm/trunk/SOURCE/lagrangian_particle_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/lagrangian_particle_model_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,8439 +1,0 @@
-!> @file lagrangian_particle_model_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Previous commit fixed
-!
-! 4883 2021-02-23 16:32:41Z hellstea
-! User switch for particle coupling added
-!
-! 4865 2021-02-03 11:51:40Z schwenkel
-! Remove unnecessary interface decalrations and public statments for private routines
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more,
-! deprecated namelist removed
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! output of particle time series added
-!
-! 4731 2020-10-07 13:25:11Z schwenkel
-! Move exchange_horiz from time_integration to modules
-!
-! 4673 2020-09-10 07:56:36Z schwenkel
-! bugfix in case of mpi-restarts
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4648 2020-08-25 07:52:08Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4628 2020-07-29 07:23:03Z raasch
-! extensions required for MPI-I/O of particle data to restart files
-!
-! 4616 2020-07-21 10:09:46Z schwenkel
-! Bugfix in case of strechting: k-calculation limited lower bound of 1
-!
-! 4589 2020-07-06 12:34:09Z suehring
-! remove unused variables
-!
-! 4588 2020-07-06 11:06:02Z suehring
-! Simplify particle-speed interpolation in logarithmic layer
-!
-! 4585 2020-06-30 15:05:20Z suehring
-! Limit logarithmically interpolated particle speed to the velocity component at the first
-! prognostic grid point (since no stability corrected interpolation is employed the particle speed
-! could be overestimated in unstable conditions).
-!
-! 4546 2020-05-24 12:16:41Z raasch
-! Variables iran and iran_part completely removed, added I/O of parallel random numbers to restart
-! file
-!
-! 4545 2020-05-22 13:17:57Z schwenkel
-! Using parallel random generator, thus preventing dependency of PE number
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4520 2020-05-06 08:57:19Z schwenkel
-! Add error number
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! restart data handling with MPI-IO added
-!
-! 4471 2020-03-24 12:08:06Z schwenkel
-! Bugfix in lpm_droplet_interactions_ptq
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4430 2020-02-27 18:02:20Z suehring
-! - Bugfix in logarithmic interpolation of near-ground particle speed (density was not considered).
-! - Revise CFL-check when SGS particle speeds are considered.
-! - In nested case with SGS particle speeds in the child domain, do not give warning that particles
-!   are on domain boundaries. At the end of the particle time integration these will be transferred
-!   to the parent domain anyhow.
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4336 2019-12-13 10:12:05Z raasch
-! bugfix: wrong header output of particle group features (density ratio) in case of restarts
-!         corrected
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4282 2019-10-29 16:18:46Z schwenkel
-! Bugfix of particle timeseries in case of more than one particle group
-!
-! 4277 2019-10-28 16:53:23Z schwenkel
-! Bugfix: Added first_call_lpm in use statement
-!
-! 4276 2019-10-28 16:03:29Z schwenkel
-! Modularize lpm: Move conditions in time intergration to module
-!
-! 4275 2019-10-28 15:34:55Z schwenkel
-! Change call of simple predictor corrector method, i.e. two divergence free velocitiy fields are
-! now used.
-!
-! 4232 2019-09-20 09:34:22Z knoop
-! Removed INCLUDE "mpif.h", as it is not needed because of USE pegrid
-!
-! 4195 2019-08-28 13:44:27Z schwenkel
-! Bugfix for simple_corrector interpolation method in case of ocean runs and output particle
-! advection interpolation method into header
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4145 2019-08-06 09:55:22Z schwenkel
-! Some reformatting
-!
-! 4144 2019-08-06 09:11:47Z raasch
-! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
-!
-! 4143 2019-08-05 15:14:53Z schwenkel
-! Rename variable and change select case to if statement
-!
-! 4122 2019-07-26 13:11:56Z schwenkel
-! Implement reset method as bottom boundary condition
-!
-! 4121 2019-07-26 10:01:22Z schwenkel
-! Implementation of an simple method for interpolating the velocities to particle position
-!
-! 4114 2019-07-23 14:09:27Z schwenkel
-! Bugfix: Added working precision for if statement
-!
-! 4054 2019-06-27 07:42:18Z raasch
-! bugfix for calculating the minimum particle time step
-!
-! 4044 2019-06-19 12:28:27Z schwenkel
-! Bugfix in case of grid strecting: corrected calculation of k-Index
-!
-! 4043 2019-06-18 16:59:00Z schwenkel
-! Remove min_nr_particle, Add lpm_droplet_interactions_ptq into module
-!
-! 4028 2019-06-13 12:21:37Z schwenkel
-! Further modularization of particle code components
-!
-! 4020 2019-06-06 14:57:48Z schwenkel
-! Removing submodules
-!
-! 4018 2019-06-06 13:41:50Z eckhard
-! Bugfix for former revision
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! Modularization of all lagrangian particle model code components
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! bugfix to guarantee correct particle releases in case that the release interval is smaller than
-! the model timestep
-!
-! Revision 1.1  1999/11/25 16:16:06  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> The embedded LPM allows for studying transport and dispersion processes within turbulent flows.
-!> This model is including passive particles that do not show any feedback on the turbulent flow.
-!> Further also particles with inertia and cloud droplets can be simulated explicitly.
-!>
-!> @todo test lcm
-!>       implement simple interpolation method for subgrid scale velocites
-!> @note <Enter notes on the module>
-!> @bug  <Enter bug on the module>
-!--------------------------------------------------------------------------------------------------!
- MODULE lagrangian_particle_model_mod
-
-    USE, INTRINSIC ::  ISO_C_BINDING
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  d_exner, de_dx, de_dy, de_dz, diss, dzw, e, exner, hyp, km, pt, q, ql, ql_1, ql_2,  &
-               ql_c, ql_v, ql_vp, u, v, w, zu, zw
-
-    USE averaging,                                                                                 &
-        ONLY:  pc_av, pr_av, ql_c_av, ql_v_av, ql_vp_av
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  g, kappa, l_v, lv_d_cp, magnus, molecular_weight_of_solute,                         &
-               molecular_weight_of_water, pi, r_v, rd_d_rv, rho_l, rho_s, vanthoff
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,                     &
-               child_domain, cloud_droplets, constant_flux_layer, current_timestep_number,         &
-               debug_output, dopts_time_count, dt_3d, dt_3d_reached, dt_3d_reached_l, dt_dopts, dz,&
-               dz_stretch_level, dz_stretch_level_start, first_call_lpm, humidity,                 &
-               initializing_actions, intermediate_timestep_count, intermediate_timestep_count_max, &
-               message_string, molecular_viscosity, ocean_mode, particle_maximum_age,              &
-               restart_data_format_input, restart_data_format_output, rho_surface, simulated_time, &
-               time_since_reference_point, topography, u_gtrans, v_gtrans
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point, log_point_s
-
-    USE data_output_particle_mod,                                                                  &
-        ONLY:  dop_active,                                                                         &
-               dop_finalize,                                                                       &
-               dop_init,                                                                           &
-               dop_output_tseries,                                                                 &
-               dop_prt_axis_dimension,                                                             &
-               dop_last_active_particle
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, ngp_2dh_outer, nx, nxl, nxlg, nxrg, nxr, ny, nyn, nys, nyng, nysg, nz, nzb,   &
-               nzb_max, nzt, topo_top_ind, wall_flags_total_0
-
-    USE kinds
-
-    USE pegrid
-
-    USE particle_attributes
-
-#if defined( __parallel )
-    USE pmc_particle_interface,                                                                    &
-        ONLY: pmcp_c_get_particle_from_parent, pmcp_c_send_particle_to_parent, pmcp_g_init,        &
-              pmcp_g_print_number_of_particles, pmcp_p_delete_particles_in_fine_grid_area,         &
-              pmcp_p_empty_particle_win, pmcp_p_fill_particle_win
-
-    USE pmc_interface,                                                                             &
-        ONLY: nested_run, particle_coupling
-#else
-    USE pmc_interface,                                                                             &
-        ONLY: nested_run
-#endif
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, dx, ddy, dy
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  dopts_num, id_set_pts, id_var_dopts, id_var_time_pts, nc_stat, netcdf_data_format,  &
-               netcdf_deflate, netcdf_handle_error
-
-    USE random_generator_parallel,                                                                 &
-        ONLY:  init_parallel_random_generator,                                                     &
-               id_random_array,                                                                    &
-               random_dummy,                                                                       &
-               random_number_parallel,                                                             &
-               random_number_parallel_gauss,                                                       &
-               random_seed_parallel
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_check_array,                                                              &
-               rd_mpi_io_check_open,                                                               &
-               rd_mpi_io_close,                                                                    &
-               rd_mpi_io_open,                                                                     &
-               rd_mpi_io_particle_filetypes,                                                       &
-               rrd_mpi_io,                                                                         &
-               rrd_mpi_io_global_array,                                                            &
-               rrd_mpi_io_particles,                                                               &
-               wrd_mpi_io,                                                                         &
-               wrd_mpi_io_global_array,                                                            &
-               wrd_mpi_io_particles
-
-    USE statistics,                                                                                &
-        ONLY:  hom
-
-    USE surface_mod,                                                                               &
-        ONLY:  bc_h,                                                                               &
-               surf_def_h,                                                                         &
-               surf_lsm_h,                                                                         &
-               surf_usm_h
-
-#if defined( __parallel )
-    USE MPI
-#endif
-
-#if defined( __netcdf )
-    USE NETCDF
-#endif
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), PARAMETER         ::  nr_2_direction_move = 10000 !<
-    INTEGER(iwp), PARAMETER         ::  phase_init    = 1           !<
-    INTEGER(iwp), PARAMETER, PUBLIC ::  phase_release = 2           !<
-
-    REAL(wp), PARAMETER ::  c_0 = 3.0_wp         !< parameter for lagrangian timescale
-
-    CHARACTER(LEN=15) ::  aero_species = 'nacl'                   !< aerosol species
-    CHARACTER(LEN=15) ::  aero_type    = 'maritime'               !< aerosol type
-    CHARACTER(LEN=15) ::  bc_par_b     = 'reflect'                !< bottom boundary condition
-    CHARACTER(LEN=15) ::  bc_par_lr    = 'cyclic'                 !< left/right boundary condition
-    CHARACTER(LEN=15) ::  bc_par_ns    = 'cyclic'                 !< north/south boundary condition
-    CHARACTER(LEN=15) ::  bc_par_t     = 'absorb'                 !< top boundary condition
-    CHARACTER(LEN=15) ::  collision_kernel   = 'none'             !< collision kernel
-
-    CHARACTER(LEN=5)  ::  splitting_function = 'gamma'            !< function for calculation critical weighting factor
-    CHARACTER(LEN=5)  ::  splitting_mode     = 'const'            !< splitting mode
-
-    CHARACTER(LEN=25) ::  particle_advection_interpolation = 'trilinear' !< interpolation method for calculatin the particle
-
-    INTEGER(iwp) ::  deleted_particles = 0                        !< number of deleted particles per time step
-    INTEGER(iwp) ::  i_splitting_mode                             !< dummy for splitting mode
-    INTEGER(iwp) ::  isf                                          !< dummy for splitting function
-    INTEGER(iwp) ::  max_number_particles_per_gridbox = 100       !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  number_particles_per_gridbox = -1            !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  number_of_sublayers = 20                     !< number of sublayers for particle velocities betwenn surface
-                                                                  !< and first grid level
-    INTEGER(iwp) ::  offset_ocean_nzt = 0                         !< in case of oceans runs, the vertical index calculations need
-                                                                  !< an offset
-    INTEGER(iwp) ::  offset_ocean_nzt_m1 = 0                      !< in case of oceans runs, the vertical index calculations need
-                                                                  !< an offset
-    INTEGER(iwp) ::  particles_per_point = 1                      !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  radius_classes = 20                          !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  splitting_factor = 2                         !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  splitting_factor_max = 5                     !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  step_dealloc = 100                           !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  total_number_of_particles                    !< total number of particles in the whole model domain
-    INTEGER(iwp) ::  trlp_count_recv_sum                          !< parameter for particle exchange of PEs
-    INTEGER(iwp) ::  trlp_count_sum                               !< parameter for particle exchange of PEs
-    INTEGER(iwp) ::  trrp_count_recv_sum                          !< parameter for particle exchange of PEs
-    INTEGER(iwp) ::  trrp_count_sum                               !< parameter for particle exchange of PEs
-    INTEGER(iwp) ::  trsp_count_recv_sum                          !< parameter for particle exchange of PEs
-    INTEGER(iwp) ::  trsp_count_sum                               !< parameter for particle exchange of PEs
-    INTEGER(iwp) ::  trnp_count_recv_sum                          !< parameter for particle exchange of PEs
-    INTEGER(iwp) ::  trnp_count_sum                               !< parameter for particle exchange of PEs
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  id_counter !< number of particles initialized in each grid box
-    INTEGER(isp), DIMENSION(:,:,:), ALLOCATABLE ::  seq_random_array_particles   !< sequence of random array for particle
-
-    LOGICAL ::  curvature_solution_effects = .FALSE.      !< namelist parameter (see documentation)
-    LOGICAL ::  deallocate_memory = .TRUE.                !< namelist parameter (see documentation)
-    LOGICAL ::  hall_kernel = .FALSE.                     !< flag for collision kernel
-    LOGICAL ::  interpolation_simple_corrector = .FALSE.  !< flag for simple particle advection interpolation with corrector step
-    LOGICAL ::  interpolation_simple_predictor = .FALSE.  !< flag for simple particle advection interpolation with predictor step
-    LOGICAL ::  interpolation_trilinear = .FALSE.         !< flag for trilinear particle advection interpolation
-    LOGICAL ::  lagrangian_particle_model = .FALSE.       !< namelist parameter (see documentation)
-    LOGICAL ::  merging = .FALSE.                         !< namelist parameter (see documentation)
-    LOGICAL ::  random_start_position = .FALSE.           !< namelist parameter (see documentation)
-    LOGICAL ::  read_particles_from_restartfile = .TRUE.  !< namelist parameter (see documentation)
-    LOGICAL ::  seed_follows_topography = .FALSE.         !< namelist parameter (see documentation)
-    LOGICAL ::  splitting = .FALSE.                       !< namelist parameter (see documentation)
-    LOGICAL ::  use_kernel_tables = .FALSE.               !< parameter, which turns on the use of precalculated collision kernels
-    LOGICAL ::  write_particle_statistics = .FALSE.       !< namelist parameter (see documentation)
-
-    LOGICAL, DIMENSION(max_number_of_particle_groups) ::   vertical_particle_advection = .TRUE.  !< Switch for vertical particle
-                                                                                                 !< transport
-
-    REAL(wp) ::  aero_weight = 1.0_wp                      !< namelist parameter (see documentation)
-    REAL(wp) ::  dt_min_part = 0.0002_wp                   !< minimum particle time step when SGS velocities are used (s)
-    REAL(wp) ::  dt_prel = 9999999.9_wp                    !< namelist parameter (see documentation)
-    REAL(wp) ::  dt_write_particle_data = 9999999.9_wp     !< namelist parameter (see documentation)
-    REAL(wp) ::  epsilon_collision                         !<
-    REAL(wp) ::  end_time_prel = 9999999.9_wp              !< namelist parameter (see documentation)
-    REAL(wp) ::  initial_weighting_factor = 1.0_wp         !< namelist parameter (see documentation)
-    REAL(wp) ::  last_particle_release_time = 0.0_wp       !< last time of particle release
-    REAL(wp) ::  log_sigma(3) = 1.0_wp                     !< namelist parameter (see documentation)
-    REAL(wp) ::  na(3) = 0.0_wp                            !< namelist parameter (see documentation)
-    REAL(wp) ::  number_concentration = -1.0_wp            !< namelist parameter (see documentation)
-    REAL(wp) ::  radius_merge = 1.0E-7_wp                  !< namelist parameter (see documentation)
-    REAL(wp) ::  radius_split = 40.0E-6_wp                 !< namelist parameter (see documentation)
-    REAL(wp) ::  rclass_lbound                             !<
-    REAL(wp) ::  rclass_ubound                             !<
-    REAL(wp) ::  rm(3) = 1.0E-6_wp                         !< namelist parameter (see documentation)
-    REAL(wp) ::  sgs_wf_part                               !< parameter for sgs
-    REAL(wp) ::  time_write_particle_data = 0.0_wp         !< write particle data at current time on file
-    REAL(wp) ::  urms                                      !<
-    REAL(wp) ::  weight_factor_merge = -1.0_wp             !< namelist parameter (see documentation)
-    REAL(wp) ::  weight_factor_split = -1.0_wp             !< namelist parameter (see documentation)
-    REAL(wp) ::  z0_av_global                              !< horizontal mean value of z0
-
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  density_ratio = 9999999.9_wp  !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  pdx = 9999999.9_wp            !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  pdy = 9999999.9_wp            !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  pdz = 9999999.9_wp            !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  psb = 9999999.9_wp            !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  psl = 9999999.9_wp            !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  psn = 9999999.9_wp            !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  psr = 9999999.9_wp            !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  pss = 9999999.9_wp            !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  pst = 9999999.9_wp            !< namelist parameter (see documentation).
-    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  radius = 9999999.9_wp         !< namelist parameter (see documentation)
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE     ::  log_z_z0   !< Precalculate LOG(z/z0)
-
-#if defined( __parallel )
-    INTEGER(iwp)            ::  nr_move_north               !<
-    INTEGER(iwp)            ::  nr_move_south               !<
-
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  move_also_north
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  move_also_south
-#endif
-
-    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 !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_t   !< u value of old timelevel t
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_t   !< v value of old timelevel t
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_t   !< w value of old timelevel t
-
-    SAVE
-
-    PRIVATE
-
-    PUBLIC lagrangian_particle_model
-
-    PUBLIC lpm_actions,                                                                            &
-           lpm_check_parameters,                                                                   &
-           lpm_data_output_ptseries,                                                               &
-           lpm_exchange_horiz_bounds,                                                              &
-           lpm_header,                                                                             &
-           lpm_init,                                                                               &
-           lpm_init_arrays,                                                                        &
-           lpm_last_actions,                                                                       &
-           lpm_parin,                                                                              &
-           lpm_rrd_global,                                                                         &
-           lpm_rrd_local,                                                                          &
-           lpm_wrd_global,                                                                         &
-           lpm_wrd_local
-
-    INTERFACE lpm_check_parameters
-       MODULE PROCEDURE lpm_check_parameters
-    END INTERFACE lpm_check_parameters
-
-    INTERFACE lpm_parin
-       MODULE PROCEDURE lpm_parin
-    END INTERFACE lpm_parin
-
-    INTERFACE lpm_header
-       MODULE PROCEDURE lpm_header
-    END INTERFACE lpm_header
-
-    INTERFACE lpm_init_arrays
-       MODULE PROCEDURE lpm_init_arrays
-    END INTERFACE lpm_init_arrays
-
-    INTERFACE lpm_init
-       MODULE PROCEDURE lpm_init
-    END INTERFACE lpm_init
-
-    INTERFACE lpm_actions
-       MODULE PROCEDURE lpm_actions
-    END INTERFACE lpm_actions
-
-    INTERFACE lpm_data_output_ptseries
-       MODULE PROCEDURE lpm_data_output_ptseries
-    END INTERFACE
-
-    INTERFACE lpm_rrd_local_particles
-       MODULE PROCEDURE lpm_rrd_local_particles
-    END INTERFACE lpm_rrd_local_particles
-
-    INTERFACE lpm_rrd_global
-       MODULE PROCEDURE lpm_rrd_global_ftn
-       MODULE PROCEDURE lpm_rrd_global_mpi
-    END INTERFACE lpm_rrd_global
-
-    INTERFACE lpm_rrd_local
-       MODULE PROCEDURE lpm_rrd_local_ftn
-       MODULE PROCEDURE lpm_rrd_local_mpi
-    END INTERFACE lpm_rrd_local
-
-    INTERFACE lpm_wrd_local
-       MODULE PROCEDURE lpm_wrd_local
-    END INTERFACE lpm_wrd_local
-
-    INTERFACE lpm_wrd_global
-       MODULE PROCEDURE lpm_wrd_global
-    END INTERFACE lpm_wrd_global
-
-    INTERFACE lpm_exchange_horiz_bounds
-       MODULE PROCEDURE lpm_exchange_horiz_bounds
-    END INTERFACE lpm_exchange_horiz_bounds
-
-    INTERFACE lpm_last_actions
-       MODULE PROCEDURE lpm_last_actions
-    END INTERFACE lpm_last_actions
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &particle_parameters for the Lagrangian particle model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_parin
-
-    CHARACTER(LEN=100) ::  line  !< string containing current line of file PARIN
-
-    INTEGER(iwp) ::  io_status  !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /particle_parameters/                                                                 &
-       aero_species,                                                                               &
-       aero_type,                                                                                  &
-       aero_weight,                                                                                &
-       alloc_factor,                                                                               &
-       bc_par_b,                                                                                   &
-       bc_par_lr,                                                                                  &
-       bc_par_ns,                                                                                  &
-       bc_par_t,                                                                                   &
-       collision_kernel,                                                                           &
-       curvature_solution_effects,                                                                 &
-       data_output_pts,                                                                            &
-       deallocate_memory,                                                                          &
-       density_ratio,                                                                              &
-       dissipation_classes,                                                                        &
-       dt_dopts,                                                                                   &
-       dt_min_part,                                                                                &
-       dt_prel,                                                                                    &
-       dt_write_particle_data,                                                                     &
-       end_time_prel,                                                                              &
-       initial_weighting_factor,                                                                   &
-       log_sigma,                                                                                  &
-       max_number_particles_per_gridbox,                                                           &
-       merging,                                                                                    &
-       na,                                                                                         &
-       number_concentration,                                                                       &
-       number_of_output_particles,                                                                 &
-       number_of_particle_groups,                                                                  &
-       number_particles_per_gridbox,                                                               &
-       oversize,                                                                                   &
-       particles_per_point,                                                                        &
-       particle_advection_start,                                                                   &
-       particle_advection_interpolation,                                                           &
-       particle_maximum_age,                                                                       &
-       pts_id_file,                                                                                &
-       pts_increment,                                                                              &
-       pts_percentage,                                                                             &
-       pdx,                                                                                        &
-       pdy,                                                                                        &
-       pdz,                                                                                        &
-       psb,                                                                                        &
-       psl,                                                                                        &
-       psn,                                                                                        &
-       psr,                                                                                        &
-       pss,                                                                                        &
-       pst,                                                                                        &
-       radius,                                                                                     &
-       radius_classes,                                                                             &
-       radius_merge,                                                                               &
-       radius_split,                                                                               &
-       random_start_position,                                                                      &
-       read_particles_from_restartfile,                                                            &
-       rm,                                                                                         &
-       seed_follows_topography,                                                                    &
-       splitting,                                                                                  &
-       splitting_factor,                                                                           &
-       splitting_factor_max,                                                                       &
-       splitting_function,                                                                         &
-       splitting_mode,                                                                             &
-       step_dealloc,                                                                               &
-       switch_off_module,                                                                          &
-       unlimited_dimension,                                                                        &
-       use_sgs_for_particles,                                                                      &
-       vertical_particle_advection,                                                                &
-       weight_factor_merge,                                                                        &
-       weight_factor_split,                                                                        &
-       write_particle_statistics
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, particle_parameters, IOSTAT=io_status )
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    particle_parameters namelist was found and read correctly. Set flag that indicates that
-!--    particles are switched on.
-       IF ( .NOT. switch_off_module )  particle_advection = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    particle_parameters namelist was found, but contained errors. Print an error message
-!--    including the line that caused the error.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'particle_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE lpm_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Writes used particle attributes in header file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_header ( io )
-
-    CHARACTER (LEN=40) ::  output_format       !< netcdf format
-
-    INTEGER(iwp) ::  i               !<
-    INTEGER(iwp), INTENT(IN) ::  io  !< Unit of the output file
-
-
-     IF ( humidity  .AND.  cloud_droplets )  THEN
-       WRITE ( io, 433 )
-       IF ( curvature_solution_effects )  WRITE ( io, 434 )
-       IF ( collision_kernel /= 'none' )  THEN
-          WRITE ( io, 435 )  TRIM( collision_kernel )
-          IF ( collision_kernel(6:9) == 'fast' )  THEN
-             WRITE ( io, 436 )  radius_classes, dissipation_classes
-          ENDIF
-       ELSE
-          WRITE ( io, 437 )
-       ENDIF
-    ENDIF
-
-    IF ( particle_advection )  THEN
-!
-!--    Particle attributes
-       WRITE ( io, 480 )  particle_advection_start, TRIM(particle_advection_interpolation),        &
-                          dt_prel, bc_par_lr, bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
-                          end_time_prel
-       IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
-       IF ( random_start_position )  WRITE ( io, 481 )
-       IF ( seed_follows_topography )  WRITE ( io, 496 )
-       IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
-       WRITE ( io, 495 )  total_number_of_particles
-       IF ( dt_write_particle_data /= 9999999.9_wp )  THEN
-          WRITE ( io, 485 )  dt_write_particle_data
-          IF ( netcdf_data_format > 1 )  THEN
-             output_format = 'netcdf (64 bit offset) and binary'
-          ELSE
-             output_format = 'netcdf and binary'
-          ENDIF
-          IF ( netcdf_deflate == 0 )  THEN
-             WRITE ( io, 344 )  output_format
-          ELSE
-             WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
-          ENDIF
-       ENDIF
-       IF ( dt_dopts /= 9999999.9_wp )  WRITE ( io, 494 )  dt_dopts
-       IF ( write_particle_statistics )  WRITE ( io, 486 )
-
-       WRITE ( io, 487 )  number_of_particle_groups
-
-       DO  i = 1, number_of_particle_groups
-          WRITE ( io, 490 )  i, radius(i)
-          IF ( density_ratio(i) /= 0.0_wp )  THEN
-             WRITE ( io, 491 )  density_ratio(i)
-          ELSE
-             WRITE ( io, 492 )
-          ENDIF
-          WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), pdx(i), pdy(i), pdz(i)
-          IF ( .NOT. vertical_particle_advection(i) )  WRITE ( io, 482 )
-       ENDDO
-
-    ENDIF
-
-344 FORMAT ('       Output format: ',A/)
-354 FORMAT ('       Output format: ',A, '   compressed with level: ',I1/)
-
-433 FORMAT ('    Cloud droplets treated explicitly using the Lagrangian part','icle model')
-434 FORMAT ('    Curvature and solution effecs are considered for growth of',                      &
-                 ' droplets < 1.0E-6 m')
-435 FORMAT ('    Droplet collision is handled by ',A,'-kernel')
-436 FORMAT ('       Fast kernel with fixed radius- and dissipation classes ','are used'/           &
-            '          number of radius classes:       ',I3,'    interval ','[1.0E-6,2.0E-4] m'/   &
-            '          number of dissipation classes:   ',I2,'    interval ','[0,1000] cm**2/s**3')
-437 FORMAT ('    Droplet collision is switched off')
-
-480 FORMAT ('    Particles:'/                                                                      &
-            '    ---------'//                                                                      &
-            '       Particle advection is active (switched on at t = ', F7.1,' s)'/                &
-            '       Interpolation of particle velocities is done by using ', A,' method'/          &
-            '       Start of new particle generations every  ',F6.1,' s'/                          &
-            '       Boundary conditions: left/right: ', A, ' north/south: ', A/                    &
-            '                            bottom:     ', A, ' top:         ', A/                    &
-            '       Maximum particle age:                 ',F9.1,' s'/                             &
-            '       Advection stopped at t = ',F9.1,' s'/)
-481 FORMAT ('       Particles have random start positions'/)
-482 FORMAT ('          Particles are advected only horizontally'/)
-485 FORMAT ('       Particle data are written on file every ', F9.1, ' s')
-486 FORMAT ('       Particle statistics are written on file'/)
-487 FORMAT ('       Number of particle groups: ',I2/)
-488 FORMAT ('       SGS velocity components are used for particle advection'/                      &
-            '          minimum timestep for advection:', F8.5/)
-489 FORMAT ('       Number of particles simultaneously released at each ','point: ', I5/)
-490 FORMAT ('       Particle group ',I2,':'/                                                       &
-            '          Particle radius: ',E10.3, 'm')
-491 FORMAT ('          Particle inertia is activated'/                                             &
-            '             density_ratio (rho_fluid/rho_particle) =',F6.3/)
-492 FORMAT ('          Particles are advected only passively (no inertia)'/)
-493 FORMAT ('          Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/                    &
-            '                                         y:',F8.1,' - ',F8.1,' m'/                    &
-            '                                         z:',F8.1,' - ',F8.1,' m'/                    &
-            '          Particle distances:  dx = ',F8.1,' m  dy = ',F8.1,' m  dz = ',F8.1,' m'/)
-494 FORMAT ('       Output of particle time series in NetCDF format every ',F8.2,' s'/)
-495 FORMAT ('       Number of particles in total domain: ',I10/)
-496 FORMAT ('       Initial vertical particle positions are interpreted ',                         &
-                    'as relative to the given topography')
-
- END SUBROUTINE lpm_header
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Writes used particle attributes in header file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_check_parameters
-
-    LOGICAL ::  id_file_exists = .FALSE.
-
-!
-!-- Collision kernels:
-    SELECT CASE ( TRIM( collision_kernel ) )
-
-       CASE ( 'hall', 'hall_fast' )
-          hall_kernel = .TRUE.
-
-       CASE ( 'wang', 'wang_fast' )
-          wang_kernel = .TRUE.
-
-       CASE ( 'none' )
-
-
-       CASE DEFAULT
-          message_string = 'unknown collision kernel: collision_kernel = "' //                     &
-                           TRIM( collision_kernel ) // '"'
-          CALL message( 'lpm_check_parameters', 'PA0350', 1, 2, 0, 6, 0 )
-
-    END SELECT
-
-    IF ( collision_kernel(6:9) == 'fast' )  use_kernel_tables = .TRUE.
-
-!
-!-- Subgrid scale velocites with the simple interpolation method for resolved velocites is not
-!-- implemented for passive particles. However, for cloud it can be combined as the sgs-velocites
-!-- for active particles are calculated differently, i.e. no subboxes are needed.
-    IF ( .NOT. TRIM( particle_advection_interpolation ) == 'trilinear'  .AND.                      &
-         use_sgs_for_particles  .AND.  .NOT. cloud_droplets )  THEN
-          message_string = 'subrgrid scale velocities in combination with ' //                     &
-                           'simple interpolation method is not '            //                     &
-                           'implemented'
-          CALL message( 'lpm_check_parameters', 'PA0659', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( nested_run  .AND.  cloud_droplets )  THEN
-       message_string = 'nested runs in combination with cloud droplets ' //                       &
-                        'is not implemented'
-       CALL message( 'lpm_check_parameters', 'PA0687', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( pts_increment > 1  .AND.  pts_percentage < 100.0_wp )  THEN
-       message_string = 'pts_increment and pts_percentage cannot be set both '
-       CALL message( 'lpm_check_parameters', 'PA0...', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( pts_increment < 1 )  THEN
-       message_string = 'pts_increment must be > 1'
-       CALL message( 'lpm_check_parameters', 'PA0...', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( pts_percentage > 100.0_wp )  THEN
-       message_string = 'pts_percentage must be < 100'
-       CALL message( 'lpm_check_parameters', 'PA0...', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    INQUIRE( FILE = pts_id_file, EXIST = id_file_exists )
-#if defined( __netcdf4_parallel )
-!
-!-- Check if individual particles timeseries is set
-    IF ( pts_increment  > 1  .AND.  dt_dopts /= 9999999.9_wp  .OR.                                 &
-         pts_percentage < 100.0_wp  .AND.  dt_dopts /= 9999999.9_wp  .OR.                          &
-         id_file_exists  .AND.  dt_dopts /= 9999999.9_wp  )                                        &
-    THEN
-       dop_active = .TRUE.
-    ENDIF
-#endif
-
- END SUBROUTINE lpm_check_parameters
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize arrays for lpm
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_init_arrays
-
-    IF ( cloud_droplets )  THEN
-!
-!--    Liquid water content, change in liquid water content
-       ALLOCATE ( ql_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                             &
-                  ql_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!--    Real volume of particles (with weighting), volume of particles
-       ALLOCATE ( ql_v(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                             &
-                  ql_vp(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ENDIF
-
-
-    ALLOCATE( u_t(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                  &
-              v_t(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                  &
-              w_t(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!
-!-- Initialize values with current time step
-    u_t = u
-    v_t = v
-    w_t = w
-!
-!--    Initial assignment of the pointers
-    IF ( cloud_droplets )  THEN
-       ql   => ql_1
-       ql_c => ql_2
-    ENDIF
-
- END SUBROUTINE lpm_init_arrays
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize Lagrangian particle model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_init
-
-    INTEGER(iwp) ::  i                           !<
-    INTEGER(iwp) ::  j                           !<
-    INTEGER(iwp) ::  k                           !<
-
-    LOGICAL  ::  read_restart                    !<
-
-    REAL(wp) ::  div                             !<
-    REAL(wp) ::  height_int                      !<
-    REAL(wp) ::  height_p                        !<
-    REAL(wp) ::  z_p                             !<
-    REAL(wp) ::  z0_av_local                     !<
-
-!
-!-- In case of oceans runs, the vertical index calculations need an offset, because otherwise the k
-!-- indices will become negative
-    IF ( ocean_mode )  THEN
-       offset_ocean_nzt    = nzt
-       offset_ocean_nzt_m1 = nzt - 1
-    ENDIF
-
-!
-!-- Define block offsets for dividing a gridcell in 8 sub cells.
-!-- See documentation for List of subgrid boxes.
-!-- See pack_and_sort in lpm_pack_arrays.f90 for assignment of the subgrid boxes.
-    block_offset(0) = block_offset_def ( 0, 0, 0)
-    block_offset(1) = block_offset_def ( 0, 0,-1)
-    block_offset(2) = block_offset_def ( 0,-1, 0)
-    block_offset(3) = block_offset_def ( 0,-1,-1)
-    block_offset(4) = block_offset_def (-1, 0, 0)
-    block_offset(5) = block_offset_def (-1, 0,-1)
-    block_offset(6) = block_offset_def (-1,-1, 0)
-    block_offset(7) = block_offset_def (-1,-1,-1)
-!
-!-- 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
-!
-!-- Check if downward-facing walls exist. This case, reflection boundary conditions (as well as
-!-- subgrid-scale velocities) may do not work properly (not realized so far).
-    IF ( surf_def_h(1)%ns >= 1 )  THEN
-       WRITE( message_string, * ) 'Overhanging topography do not work '//                          &
-                                  'with particles'
-       CALL message( 'lpm_init', 'PA0212', 0, 1, 0, 6, 0 )
-
-    ENDIF
-
-!
-!-- Set default start positions, if necessary
-    IF ( psl(1) == 9999999.9_wp )  psl(1) = 0.0_wp
-    IF ( psr(1) == 9999999.9_wp )  psr(1) = ( nx +1 ) * dx
-    IF ( pss(1) == 9999999.9_wp )  pss(1) = 0.0_wp
-    IF ( psn(1) == 9999999.9_wp )  psn(1) = ( ny +1 ) * 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)
-
-!
-!-- If number_particles_per_gridbox is set, the parametres pdx, pdy and pdz are calculated
-!-- diagnostically. Therfore an isotropic distribution is prescribed.
-    IF ( number_particles_per_gridbox /= -1 .AND.   &
-         number_particles_per_gridbox >= 1 )    THEN
-       pdx(1) = (( dx * dy * ( zu(2) - zu(1) ) ) /  &
-             REAL(number_particles_per_gridbox))**0.3333333_wp
-!
-!--    Ensure a smooth value (two significant digits) of distance between particles (pdx, pdy, pdz).
-       div = 1000.0_wp
-       DO  WHILE ( pdx(1) < div )
-          div = div / 10.0_wp
-       ENDDO
-       pdx(1) = NINT( pdx(1) * 100.0_wp / div ) * div / 100.0_wp
-       pdy(1) = pdx(1)
-       pdz(1) = pdx(1)
-
-    ENDIF
-
-    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.
-!-- Initialize prefactor required for stoachastic Weil equation.
-    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) )
-
-       de_dx = 0.0_wp
-       de_dy = 0.0_wp
-       de_dz = 0.0_wp
-
-       sgs_wf_part = 1.0_wp / 3.0_wp
-    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( surf_def_h(0)%z0 ) + SUM( surf_lsm_h(0)%z0 ) + SUM( surf_usm_h(0)%z0 )
-       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    = z0_av_global
-       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 which particle interpolation method should be used
-    IF ( TRIM( particle_advection_interpolation )  ==  'trilinear' )  THEN
-       interpolation_simple_corrector = .FALSE.
-       interpolation_simple_predictor = .FALSE.
-       interpolation_trilinear        = .TRUE.
-    ELSEIF ( TRIM( particle_advection_interpolation )  ==  'simple_corrector' )  THEN
-       interpolation_simple_corrector = .TRUE.
-       interpolation_simple_predictor = .FALSE.
-       interpolation_trilinear        = .FALSE.
-    ELSEIF ( TRIM( particle_advection_interpolation )  ==  'simple_predictor' )  THEN
-       interpolation_simple_corrector = .FALSE.
-       interpolation_simple_predictor = .TRUE.
-       interpolation_trilinear        = .FALSE.
-    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 ( 'reset' )
-          ibc_par_b = 3
-
-       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 ( 'nested' )
-          ibc_par_t = 3
-
-       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 ( 'nested' )
-          ibc_par_lr = 3
-
-       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 ( 'nested' )
-          ibc_par_ns = 3
-
-       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
-    SELECT CASE ( splitting_mode )
-
-       CASE ( 'const' )
-          i_splitting_mode = 1
-
-       CASE ( 'cl_av' )
-          i_splitting_mode = 2
-
-       CASE ( 'gb_av' )
-          i_splitting_mode = 3
-
-       CASE DEFAULT
-          WRITE( message_string, * )  'unknown splitting_mode = "', TRIM( splitting_mode ), '"'
-          CALL message( 'lpm_init', 'PA0146', 1, 2, 0, 6, 0 )
-
-    END SELECT
-    SELECT CASE ( splitting_function )
-
-       CASE ( 'gamma' )
-          isf = 1
-
-       CASE ( 'log' )
-          isf = 2
-
-       CASE ( 'exp' )
-          isf = 3
-
-       CASE DEFAULT
-          WRITE( message_string, * )  'unknown splitting function = "',                            &
-                                       TRIM( splitting_function ), '"'
-          CALL message( 'lpm_init', 'PA0147', 1, 2, 0, 6, 0 )
-
-    END SELECT
-!
-!-- Initialize collision kernels
-    IF ( collision_kernel /= 'none' )  CALL lpm_init_kernels
-
-!
-!-- For the first model run of a possible job chain initialize the particles, otherwise read the
-!-- particle data from restart file.
-    read_restart = .FALSE.
-    IF ( TRIM( initializing_actions ) == 'read_restart_data'                                       &
-         .AND.  read_particles_from_restartfile )  THEN
-       CALL lpm_rrd_local_particles
-
-       read_restart = .TRUE.
-    ELSE
-!
-!--    Allocate particle arrays and set attributes of the initial set of particles, which can be
-!--    also periodically released at later times.
-       ALLOCATE( grid_particles(nzb+1:nzt,nys:nyn,nxl:nxr),                                        &
-                 id_counter(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                 prt_count(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-       number_of_particles = 0
-       prt_count           = 0
-!
-!--    Initialize counter for particle IDs
-       id_counter = 1
-!
-!--    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_wp,                      &
-                                      0, 0, 0_idp, .FALSE., -1, -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
-
-!
-!--    Initialize parallel random number sequence seed for particles.
-!--    This is done separately here, as thus particle random numbers do not affect the random
-!--    numbers used for the flow field (e.g. for generating flow disturbances).
-       ALLOCATE ( seq_random_array_particles(5,nys:nyn,nxl:nxr) )
-       seq_random_array_particles = 0
-
-!--    Initializing with random_seed_parallel for every vertical gridpoint column.
-       random_dummy = 0
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             CALL random_seed_parallel (random_sequence=id_random_array(j, i))
-             CALL random_number_parallel (random_dummy)
-             CALL random_seed_parallel (get=seq_random_array_particles(:, j, i))
-          ENDDO
-       ENDDO
-!
-!--    Create the particle set, and set the initial particles
-       CALL lpm_create_particle( phase_init )
-       last_particle_release_time = particle_advection_start
-!
-!--    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
-          CALL close_file( 80 )
-       ENDIF
-
-    ENDIF
-
-#if defined( __parallel )
-    IF ( nested_run )  CALL pmcp_g_init
-#endif
-
-!
-!-- Output of particle time series
-    IF ( dop_active )  THEN
-       CALL dop_init( read_restart )
-    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:
-! ------------
-!> Create Lagrangian particles
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_create_particle (phase)
-
-    INTEGER(iwp)               ::  alloc_size  !< relative increase of allocated memory for particles
-    INTEGER(iwp)               ::  i           !< loop variable ( particle groups )
-    INTEGER(iwp)               ::  ip          !< index variable along x
-    INTEGER(iwp)               ::  j           !< loop variable ( particles per point )
-    INTEGER(iwp)               ::  jp          !< index variable along y
-    INTEGER(iwp)               ::  k           !< index variable along z
-    INTEGER(iwp)               ::  k_surf      !< index of surface grid point
-    INTEGER(iwp)               ::  kp          !< index variable along z
-    INTEGER(iwp)               ::  loop_stride !< loop variable for initialization
-    INTEGER(iwp)               ::  n           !< loop variable ( number of particles )
-    INTEGER(iwp)               ::  new_size    !< new size of allocated memory for particles
-
-    INTEGER(iwp), INTENT(IN)   ::  phase       !< mode of inititialization
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  local_count !< start address of new particle
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  local_start !< start address of new particle
-
-    LOGICAL                    ::  first_stride !< flag for initialization
-
-    REAL(wp)                   ::  pos_x      !< increment for particle position in x
-    REAL(wp)                   ::  pos_y      !< increment for particle position in y
-    REAL(wp)                   ::  pos_z      !< increment for particle position in z
-    REAL(wp)                   ::  rand_contr !< dummy argument for random position
-
-    TYPE(particle_type), TARGET ::  tmp_particle !< temporary particle used for initialization
-
-
-!
-!-- 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
-
-!
-!--    Calculate initial_weighting_factor diagnostically
-       IF ( number_concentration /= -1.0_wp  .AND.  number_concentration > 0.0_wp )  THEN
-          initial_weighting_factor =  number_concentration * pdx(1) * pdy(1) * pdz(1)
-       END IF
-
-       n = 0
-       DO  i = 1, number_of_particle_groups
-          pos_z = psb(i)
-          DO WHILE ( pos_z <= pst(i) )
-             IF ( pos_z >= zw(0) .AND.  pos_z < zw(nzt) )  THEN
-                pos_y = pss(i)
-                DO WHILE ( pos_y <= psn(i) )
-                   IF ( pos_y >= nys * dy  .AND.  pos_y <  ( nyn + 1 ) * dy  )  THEN
-                      pos_x = psl(i)
-               xloop: DO WHILE ( pos_x <= psr(i) )
-                         IF ( pos_x >= nxl * dx  .AND.  pos_x <  ( nxr + 1) * 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%e_m           = 0.0_wp
-                               tmp_particle%rvar1         = 0.0_wp
-                               tmp_particle%rvar2         = 0.0_wp
-                               tmp_particle%rvar3         = 0.0_wp
-                               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
-                               IF ( curvature_solution_effects )  THEN
-                                  tmp_particle%aux1      = 0.0_wp    ! dry aerosol radius
-                                  tmp_particle%aux2      = dt_3d     ! last Rosenbrock timestep
-                               ELSE
-                                  tmp_particle%aux1      = 0.0_wp    ! free to use
-                                  tmp_particle%aux2      = 0.0_wp    ! free to use
-                               ENDIF
-                               tmp_particle%radius        = particle_groups(i)%radius
-                               tmp_particle%weight_factor = initial_weighting_factor
-                               tmp_particle%class         = 1
-                               tmp_particle%group         = i
-                               tmp_particle%id            = 0_idp
-                               tmp_particle%particle_mask = .TRUE.
-                               tmp_particle%block_nr      = -1
-!
-!--                            Determine the grid indices of the particle position
-                               ip = INT( tmp_particle%x * ddx )
-                               jp = INT( tmp_particle%y * ddy )
-!
-!--                            In case of stretching the actual k index is found iteratively
-                               IF ( dz_stretch_level /= -9999999.9_wp  .OR.                        &
-                                    dz_stretch_level_start(1) /= -9999999.9_wp )  THEN
-                                  kp = MAX( MINLOC( ABS( tmp_particle%z - zu ), DIM = 1 ) - 1, 1 )
-                               ELSE
-                                  kp = INT( tmp_particle%z / dz(1) + 1 + offset_ocean_nzt )
-                               ENDIF
-!
-!--                            Determine surface level. Therefore, check for upward-facing wall on
-!--                            w-grid.
-                               k_surf = topo_top_ind(jp,ip,3)
-                               IF ( seed_follows_topography )  THEN
-!
-!--                               Particle height is given relative to topography
-                                  kp = kp + k_surf
-                                  tmp_particle%z = tmp_particle%z + zw(k_surf)
-!
-!--                               Skip particle release if particle position is above model top, or
-!--                               within topography in case of overhanging structures.
-                                  IF ( kp > nzt  .OR.                                              &
-                                       .NOT. BTEST( wall_flags_total_0(kp,jp,ip), 0 ) )  THEN
-                                     pos_x = pos_x + pdx(i)
-                                     CYCLE xloop
-                                  ENDIF
-!
-!--                            Skip particle release if particle position is below surface, or
-!--                            within topography in case of overhanging structures.
-                               ELSEIF ( .NOT. seed_follows_topography .AND.                        &
-                                         tmp_particle%z <= zw(k_surf)  .OR.                        &
-                                        .NOT. BTEST( wall_flags_total_0(kp,jp,ip), 0 ) )  THEN
-                                  pos_x = pos_x + pdx(i)
-                                  CYCLE xloop
-                               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
-             ENDIF
-
-             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 ) ), 1 )
-                      ELSE
-                         alloc_size = 1
-                      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 ) ), 1 )
-                         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
-!
-!-- Calculate particle IDs (for new particles only)
-    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
-
-                particles(n)%id = 10000_idp**3 * id_counter(kp,jp,ip) + 10000_idp**2 * kp +        &
-                                  10000_idp * jp + ip
-!
-!--             Count the number of particles that have been released before
-                id_counter(kp,jp,ip) = id_counter(kp,jp,ip) + 1
-
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Initialize aerosol background spectrum
-    IF ( curvature_solution_effects )  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
-!
-!--          Put the random seeds at grid point jp, ip
-             CALL random_seed_parallel( put=seq_random_array_particles(:,jp,ip) )
-             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)
-!
-!--             Move only new particles. Moreover, limit random fluctuation in order to prevent that
-!--             particles move more than one grid box, which would lead to problems concerning
-!--             particle exchange between processors in case pdx/pdy are larger than dx/dy,
-!--             respectively.
-                DO  n = local_start(kp,jp,ip), number_of_particles
-                   IF ( psl(particles(n)%group) /= psr(particles(n)%group) )  THEN
-                      CALL random_number_parallel( random_dummy )
-                      rand_contr = ( random_dummy - 0.5_wp ) * pdx(particles(n)%group)
-                      particles(n)%x = particles(n)%x +                                            &
-                                       MERGE( rand_contr, SIGN( dx, rand_contr ),                  &
-                                              ABS( rand_contr ) < dx                               &
-                                            )
-                   ENDIF
-                   IF ( pss(particles(n)%group) /= psn(particles(n)%group) )  THEN
-                      CALL random_number_parallel( random_dummy )
-                      rand_contr = ( random_dummy - 0.5_wp ) * pdy(particles(n)%group)
-                      particles(n)%y = particles(n)%y +                                            &
-                                       MERGE( rand_contr, SIGN( dy, rand_contr ),                  &
-                                              ABS( rand_contr ) < dy                               &
-                                            )
-                   ENDIF
-                   IF ( psb(particles(n)%group) /= pst(particles(n)%group) )  THEN
-                      CALL random_number_parallel( random_dummy )
-                      rand_contr = ( random_dummy - 0.5_wp ) * pdz(particles(n)%group)
-                      particles(n)%z = particles(n)%z +                                            &
-                                       MERGE( rand_contr, SIGN( dzw(kp), rand_contr ),             &
-                                              ABS( rand_contr ) < dzw(kp)                          &
-                                            )
-                   ENDIF
-                ENDDO
-!
-!--             Identify particles located outside the model domain and reflect or absorb them if
-!--             necessary.
-                CALL lpm_boundary_conds( 'bottom/top', i, j, k )
-!
-!--             Furthermore, remove particles located in topography. Note, as
-!--             the particle speed is still zero at this point, wall
-!--             reflection boundary conditions will not work in this case.
-                particles =>  grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-                DO  n = local_start(kp,jp,ip), number_of_particles
-                   i = particles(n)%x * ddx
-                   j = particles(n)%y * ddy
-                   k = particles(n)%z / dz(1) + 1 + offset_ocean_nzt
-                   DO WHILE( zw(k) < particles(n)%z )
-                      k = k + 1
-                   ENDDO
-                   DO WHILE( zw(k-1) > particles(n)%z )
-                      k = k - 1
-                   ENDDO
-!
-!--                Check if particle is within topography
-                   IF ( .NOT. BTEST( wall_flags_total_0(k,j,i), 0 ) )  THEN
-                      particles(n)%particle_mask = .FALSE.
-                      deleted_particles = deleted_particles + 1
-                   ENDIF
-
-                ENDDO
-             ENDDO
-!
-!--          Get the new random seeds from last call at grid point jp, ip
-             CALL random_seed_parallel( get=seq_random_array_particles(:,jp,ip) )
-          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_sort_and_delete
-!
-!-- Determine the current number of particles
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          DO  kp = nzb+1, nzt
-             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
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine initializes the particles as aerosols with physio-chemical properties.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_init_aerosols(local_start)
-
-    INTEGER(iwp) ::  ip             !<
-    INTEGER(iwp) ::  jp             !<
-    INTEGER(iwp) ::  kp             !<
-    INTEGER(iwp) ::  n              !<
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  local_start !<
-
-    REAL(wp) ::  afactor            !< curvature effects
-    REAL(wp) ::  bfactor            !< solute effects
-    REAL(wp) ::  dlogr              !< logarithmic width of radius bin
-    REAL(wp) ::  e_a                !< vapor pressure
-    REAL(wp) ::  e_s                !< saturation vapor pressure
-    REAL(wp) ::  rmax = 10.0e-6_wp  !< maximum aerosol radius
-    REAL(wp) ::  rmin = 0.005e-6_wp !< minimum aerosol radius
-    REAL(wp) ::  r_l                !< left radius of bin
-    REAL(wp) ::  r_mid              !< mean radius of bin
-    REAL(wp) ::  r_r                !< right radius of bin
-    REAL(wp) ::  sigma              !< surface tension
-    REAL(wp) ::  t_int              !< temperature
-
-
-!
-!-- Set constants for different aerosol species
-    IF ( TRIM( aero_species ) == 'nacl' )  THEN
-       molecular_weight_of_solute = 0.05844_wp
-       rho_s                      = 2165.0_wp
-       vanthoff                   = 2.0_wp
-    ELSEIF ( TRIM( aero_species ) == 'c3h4o4' )  THEN
-       molecular_weight_of_solute = 0.10406_wp
-       rho_s                      = 1600.0_wp
-       vanthoff                   = 1.37_wp
-    ELSEIF ( TRIM( aero_species ) == 'nh4o3' )  THEN
-       molecular_weight_of_solute = 0.08004_wp
-       rho_s                      = 1720.0_wp
-       vanthoff                   = 2.31_wp
-    ELSE
-       WRITE( message_string, * ) 'unknown aerosol species ',                                      &
-                                  'aero_species = "', TRIM( aero_species ), '"'
-       CALL message( 'lpm_init', 'PA0470', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- The following typical aerosol spectra are taken from Jaenicke (1993):
-!-- Tropospheric aerosols. Published in Aerosol-Cloud-Climate Interactions.
-    IF ( TRIM( aero_type ) == 'polar' )  THEN
-       na        = (/ 2.17e1, 1.86e-1, 3.04e-4 /) * 1.0E6_wp
-       rm        = (/ 0.0689, 0.375, 4.29 /) * 1.0E-6_wp
-       log_sigma = (/ 0.245, 0.300, 0.291 /)
-    ELSEIF ( TRIM( aero_type ) == 'background' )  THEN
-       na        = (/ 1.29e2, 5.97e1, 6.35e1 /) * 1.0E6_wp
-       rm        = (/ 0.0036, 0.127, 0.259 /) * 1.0E-6_wp
-       log_sigma = (/ 0.645, 0.253, 0.425 /)
-    ELSEIF ( TRIM( aero_type ) == 'maritime' )  THEN
-       na        = (/ 1.33e2, 6.66e1, 3.06e0 /) * 1.0E6_wp
-       rm        = (/ 0.0039, 0.133, 0.29 /) * 1.0E-6_wp
-       log_sigma = (/ 0.657, 0.210, 0.396 /)
-    ELSEIF ( TRIM( aero_type ) == 'continental' )  THEN
-       na        = (/ 3.20e3, 2.90e3, 3.00e-1 /) * 1.0E6_wp
-       rm        = (/ 0.01, 0.058, 0.9 /) * 1.0E-6_wp
-       log_sigma = (/ 0.161, 0.217, 0.380 /)
-    ELSEIF ( TRIM( aero_type ) == 'desert' )  THEN
-       na        = (/ 7.26e2, 1.14e3, 1.78e-1 /) * 1.0E6_wp
-       rm        = (/ 0.001, 0.0188, 10.8 /) * 1.0E-6_wp
-       log_sigma = (/ 0.247, 0.770, 0.438 /)
-    ELSEIF ( TRIM( aero_type ) == 'rural' )  THEN
-       na        = (/ 6.65e3, 1.47e2, 1.99e3 /) * 1.0E6_wp
-       rm        = (/ 0.00739, 0.0269, 0.0419 /) * 1.0E-6_wp
-       log_sigma = (/ 0.225, 0.557, 0.266 /)
-    ELSEIF ( TRIM( aero_type ) == 'urban' )  THEN
-       na        = (/ 9.93e4, 1.11e3, 3.64e4 /) * 1.0E6_wp
-       rm        = (/ 0.00651, 0.00714, 0.0248 /) * 1.0E-6_wp
-       log_sigma = (/ 0.245, 0.666, 0.337 /)
-    ELSEIF ( TRIM( aero_type ) == 'user' )  THEN
-       CONTINUE
-    ELSE
-       WRITE( message_string, * ) 'unknown aerosol type ',                                         &
-                                  'aero_type = "', TRIM( aero_type ), '"'
-       CALL message( 'lpm_init', 'PA0459', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-!
-!--       Put the random seeds at grid point jp, ip
-          CALL random_seed_parallel( put=seq_random_array_particles(:,jp,ip) )
-          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)
-
-             dlogr   = ( LOG10( rmax ) - LOG10( rmin ) ) /                                         &
-                       ( number_of_particles - local_start(kp,jp,ip) + 1 )
-!
-!--          Initialize the aerosols with a predefined spectral distribution of the dry radius
-!--          (logarithmically increasing bins) and a varying weighting factor.
-             DO  n = local_start(kp,jp,ip), number_of_particles  !only new particles
-
-                r_l   = 10.0**( LOG10( rmin ) + (n-1) * dlogr )
-                r_r   = 10.0**( LOG10( rmin ) + n * dlogr )
-                r_mid = SQRT( r_l * r_r )
-
-                particles(n)%aux1          = r_mid
-                particles(n)%weight_factor =                                                       &
-                   ( na(1) / ( SQRT( 2.0_wp * pi ) * log_sigma(1) ) *                              &
-                     EXP( - LOG10( r_mid / rm(1) )**2 / ( 2.0_wp * log_sigma(1)**2 ) ) +           &
-                     na(2) / ( SQRT( 2.0_wp * pi ) * log_sigma(2) ) *                              &
-                     EXP( - LOG10( r_mid / rm(2) )**2 / ( 2.0_wp * log_sigma(2)**2 ) ) +           &
-                     na(3) / ( SQRT( 2.0_wp * pi ) * log_sigma(3) ) *                              &
-                     EXP( - LOG10( r_mid / rm(3) )**2 / ( 2.0_wp * log_sigma(3)**2 ) )             &
-                   ) * ( LOG10( r_r ) - LOG10( r_l ) ) * ( dx * dy * dzw(kp) )
-
-!
-!--             Multiply weight_factor with the namelist parameter aero_weight to increase or
-!--             decrease the number of simulated aerosols
-                particles(n)%weight_factor = particles(n)%weight_factor * aero_weight
-!
-!--             Create random numver with parallel number generator
-                CALL random_number_parallel( random_dummy )
-                IF ( particles(n)%weight_factor - FLOOR( particles(n)%weight_factor, KIND=wp )     &
-                     > random_dummy )  THEN
-                   particles(n)%weight_factor = FLOOR( particles(n)%weight_factor, KIND=wp )       &
-                                                + 1.0_wp
-                ELSE
-                   particles(n)%weight_factor = FLOOR( particles(n)%weight_factor, KIND=wp )
-                ENDIF
-!
-!--             Unnecessary particles will be deleted
-                IF ( particles(n)%weight_factor <= 0.0_wp )  particles(n)%particle_mask = .FALSE.
-
-             ENDDO
-!
-!--          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) * exner(kp)
-
-             e_s = magnus( t_int )
-             e_a = q(kp,jp,ip) * hyp(kp) / ( q(kp,jp,ip) + rd_d_rv )
-
-             sigma   = 0.0761_wp - 0.000155_wp * ( t_int - 273.15_wp )
-             afactor = 2.0_wp * sigma / ( rho_l * r_v * t_int )
-
-             bfactor = vanthoff * molecular_weight_of_water *                                      &
-                       rho_s / ( molecular_weight_of_solute * rho_l )
-!
-!--          The formula is only valid for subsaturated environments. For supersaturations higher
-!--          than -5 %, the supersaturation is set to -5%.
-             IF ( e_a / e_s >= 0.95_wp )  e_a = 0.95_wp * e_s
-
-             DO  n = local_start(kp,jp,ip), number_of_particles  !only new particles
-!
-!--             For details on this equation, see Eq. (14) of Khvorostyanov and
-!--             Curry (2007, JGR)
-                particles(n)%radius = bfactor**0.3333333_wp *                                      &
-                                      particles(n)%aux1 / ( 1.0_wp - e_a / e_s )**0.3333333_wp /   &
-                                      ( 1.0_wp + ( afactor / ( 3.0_wp * bfactor**0.3333333_wp *    &
-                                        particles(n)%aux1 ) ) /                                    &
-                                       ( 1.0_wp - e_a / e_s )**0.6666666_wp                        &
-                                      )
-
-             ENDDO
-
-          ENDDO
-!
-!--       Get the new random seeds from last call at grid point j
-          CALL random_seed_parallel( get=seq_random_array_particles(:,jp,ip) )
-       ENDDO
-    ENDDO
-
- END SUBROUTINE lpm_init_aerosols
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates quantities required for considering the SGS velocity fluctuations in the particle
-!> transport by a stochastic approach. The respective quantities are: SGS-TKE gradients and
-!> horizontally averaged profiles of the SGS TKE and the resolved-scale velocity variances.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_init_sgs_tke
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE statistics,                                                                                &
-        ONLY:  flow_statistics_called, hom, sums, sums_l
-
-    INTEGER(iwp) ::  i      !< index variable along x
-    INTEGER(iwp) ::  j      !< index variable along y
-    INTEGER(iwp) ::  k      !< index variable along z
-    INTEGER(iwp) ::  m      !< running index for the surface elements
-
-    REAL(wp) ::  flag1      !< flag to mask topography
-
-!
-!-- TKE gradient along x and y
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt+1
-
-             IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 )  .AND.                             &
-                        BTEST( wall_flags_total_0(k,j,i), 0   )  .AND.                             &
-                        BTEST( wall_flags_total_0(k,j,i+1), 0 ) )                                  &
-             THEN
-                de_dx(k,j,i) = 2.0_wp * sgs_wf_part * ( e(k,j,i+1) - e(k,j,i) ) * ddx
-             ELSEIF ( BTEST( wall_flags_total_0(k,j,i-1), 0 )  .AND.                               &
-                      BTEST( wall_flags_total_0(k,j,i), 0   )  .AND.                               &
-                .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) )                                    &
-             THEN
-                de_dx(k,j,i) = 2.0_wp * sgs_wf_part * ( e(k,j,i) - e(k,j,i-1) ) * ddx
-             ELSEIF ( .NOT. BTEST( wall_flags_total_0(k,j,i), 22   )  .AND.                        &
-                      .NOT. BTEST( wall_flags_total_0(k,j,i+1), 22 ) )                             &
-             THEN
-                de_dx(k,j,i) = 0.0_wp
-             ELSEIF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 22 )  .AND.                        &
-                      .NOT. BTEST( wall_flags_total_0(k,j,i), 22   ) )                             &
-             THEN
-                de_dx(k,j,i) = 0.0_wp
-             ELSE
-                de_dx(k,j,i) = sgs_wf_part * ( e(k,j,i+1) - e(k,j,i-1) ) * ddx
-             ENDIF
-
-             IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 )  .AND.                             &
-                        BTEST( wall_flags_total_0(k,j,i), 0   )  .AND.                             &
-                        BTEST( wall_flags_total_0(k,j+1,i), 0 ) )                                  &
-             THEN
-                de_dy(k,j,i) = 2.0_wp * sgs_wf_part * ( e(k,j+1,i) - e(k,j,i) ) * ddy
-             ELSEIF ( BTEST( wall_flags_total_0(k,j-1,i), 0 )  .AND.                               &
-                      BTEST( wall_flags_total_0(k,j,i), 0   )  .AND.                               &
-                .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) )                                    &
-             THEN
-                de_dy(k,j,i) = 2.0_wp * sgs_wf_part * ( e(k,j,i) - e(k,j-1,i) ) * ddy
-             ELSEIF ( .NOT. BTEST( wall_flags_total_0(k,j,i), 22   )  .AND.                        &
-                      .NOT. BTEST( wall_flags_total_0(k,j+1,i), 22 ) )                             &
-             THEN
-                de_dy(k,j,i) = 0.0_wp
-             ELSEIF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 22 )  .AND.                        &
-                      .NOT. BTEST( wall_flags_total_0(k,j,i), 22   ) )                             &
-             THEN
-                de_dy(k,j,i) = 0.0_wp
-             ELSE
-                de_dy(k,j,i) = sgs_wf_part * ( e(k,j+1,i) - e(k,j-1,i) ) * ddy
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- TKE gradient along z at topograhy and  including bottom and top boundary conditions
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt-1
-!
-!--          Flag to mask topography
-             flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0  ) )
-
-             de_dz(k,j,i) = 2.0_wp * sgs_wf_part *                                                 &
-                           ( e(k+1,j,i) - e(k-1,j,i) ) / ( zu(k+1) - zu(k-1) ) * flag1
-          ENDDO
-!
-!--       upward-facing surfaces
-          DO  m = bc_h(0)%start_index(j,i), bc_h(0)%end_index(j,i)
-             k            = bc_h(0)%k(m)
-             de_dz(k,j,i) = 2.0_wp * sgs_wf_part * ( e(k+1,j,i) - e(k,j,i) ) / ( zu(k+1) - zu(k) )
-          ENDDO
-!
-!--       downward-facing surfaces
-          DO  m = bc_h(1)%start_index(j,i), bc_h(1)%end_index(j,i)
-             k            = bc_h(1)%k(m)
-             de_dz(k,j,i) = 2.0_wp * sgs_wf_part * ( e(k,j,i) - e(k-1,j,i) ) / ( zu(k) - zu(k-1) )
-          ENDDO
-
-          de_dz(nzb,j,i)   = 0.0_wp
-          de_dz(nzt,j,i)   = 0.0_wp
-          de_dz(nzt+1,j,i) = 0.0_wp
-       ENDDO
-    ENDDO
-!
-!-- Ghost point exchange
-    CALL exchange_horiz( de_dx, nbgp )
-    CALL exchange_horiz( de_dy, nbgp )
-    CALL exchange_horiz( de_dz, nbgp )
-    CALL exchange_horiz( diss, nbgp  )
-!
-!-- Set boundary conditions at non-periodic boundaries. Note, at non-period boundaries zero-gradient
-!-- boundary conditions are set for the subgrid TKE.
-!-- Thus, TKE gradients normal to the respective lateral boundaries are zero,
-!-- while tangetial TKE gradients then must be the same as within the prognostic domain.
-    IF ( bc_dirichlet_l )  THEN
-       de_dx(:,:,-1) = 0.0_wp
-       de_dy(:,:,-1) = de_dy(:,:,0)
-       de_dz(:,:,-1) = de_dz(:,:,0)
-    ENDIF
-    IF ( bc_dirichlet_r )  THEN
-       de_dx(:,:,nxr+1) = 0.0_wp
-       de_dy(:,:,nxr+1) = de_dy(:,:,nxr)
-       de_dz(:,:,nxr+1) = de_dz(:,:,nxr)
-    ENDIF
-    IF ( bc_dirichlet_n )  THEN
-       de_dx(:,nyn+1,:) = de_dx(:,nyn,:)
-       de_dy(:,nyn+1,:) = 0.0_wp
-       de_dz(:,nyn+1,:) = de_dz(:,nyn,:)
-    ENDIF
-    IF ( bc_dirichlet_s )  THEN
-       de_dx(:,nys-1,:) = de_dx(:,nys,:)
-       de_dy(:,nys-1,:) = 0.0_wp
-       de_dz(:,nys-1,:) = de_dz(:,nys,:)
-    ENDIF
-!
-!-- Calculate the horizontally averaged profiles of SGS TKE and resolved velocity variances (they
-!-- may have been already calculated in routine flow_statistics).
-    IF ( .NOT. flow_statistics_called )  THEN
-
-!
-!--    First calculate horizontally averaged profiles of the horizontal velocities.
-       sums_l(:,1,0) = 0.0_wp
-       sums_l(:,2,0) = 0.0_wp
-
-       DO  i = nxl, nxr
-          DO  j =  nys, nyn
-             DO  k = nzb, nzt+1
-!
-!--             Flag indicating vicinity of wall
-                flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 24 ) )
-
-                sums_l(k,1,0)  = sums_l(k,1,0)  + u(k,j,i) * flag1
-                sums_l(k,2,0)  = sums_l(k,2,0)  + v(k,j,i) * flag1
-             ENDDO
-          ENDDO
-       ENDDO
-
-#if defined( __parallel )
-!
-!--    Compute total sum from local sums
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,     &
-                           ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( sums_l(nzb,2,0), sums(nzb,2), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,     &
-                           ierr )
-#else
-       sums(:,1) = sums_l(:,1,0)
-       sums(:,2) = sums_l(:,2,0)
-#endif
-
-!
-!--    Final values are obtained by division by the total number of grid points used for the
-!--    summation.
-       hom(:,1,1,0) = sums(:,1) / ngp_2dh_outer(:,0)   ! u
-       hom(:,1,2,0) = sums(:,2) / ngp_2dh_outer(:,0)   ! v
-
-!
-!--    Now calculate the profiles of SGS TKE and the resolved-scale velocity variances
-       sums_l(:,8,0)  = 0.0_wp
-       sums_l(:,30,0) = 0.0_wp
-       sums_l(:,31,0) = 0.0_wp
-       sums_l(:,32,0) = 0.0_wp
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-!
-!--             Flag indicating vicinity of wall
-                flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 24 ) )
-
-                sums_l(k,8,0)  = sums_l(k,8,0)  + e(k,j,i)                       * flag1
-                sums_l(k,30,0) = sums_l(k,30,0) + ( u(k,j,i) - hom(k,1,1,0) )**2 * flag1
-                sums_l(k,31,0) = sums_l(k,31,0) + ( v(k,j,i) - hom(k,1,2,0) )**2 * flag1
-                sums_l(k,32,0) = sums_l(k,32,0) + w(k,j,i)**2                    * flag1
-             ENDDO
-          ENDDO
-       ENDDO
-
-#if defined( __parallel )
-!
-!--    Compute total sum from local sums
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( sums_l(nzb,8,0), sums(nzb,8), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,     &
-                           ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( sums_l(nzb,30,0), sums(nzb,30), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,   &
-                           ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( sums_l(nzb,31,0), sums(nzb,31), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,   &
-                           ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( sums_l(nzb,32,0), sums(nzb,32), nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d,   &
-                           ierr )
-
-#else
-       sums(:,8)  = sums_l(:,8,0)
-       sums(:,30) = sums_l(:,30,0)
-       sums(:,31) = sums_l(:,31,0)
-       sums(:,32) = sums_l(:,32,0)
-#endif
-
-!
-!--    Final values are obtained by division by the total number of grid points used for the
-!--    summation.
-       hom(:,1,8,0)  = sums(:,8)  / ngp_2dh_outer(:,0)   ! e
-       hom(:,1,30,0) = sums(:,30) / ngp_2dh_outer(:,0)   ! u*2
-       hom(:,1,31,0) = sums(:,31) / ngp_2dh_outer(:,0)   ! v*2
-       hom(:,1,32,0) = sums(:,32) / ngp_2dh_outer(:,0)   ! w*2
-
-    ENDIF
-
- END SUBROUTINE lpm_init_sgs_tke
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sobroutine control lpm actions, i.e. all actions during one time step.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_actions( location )
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-    INTEGER(iwp)       ::  i                  !<
-    INTEGER(iwp)       ::  ie                 !<
-    INTEGER(iwp)       ::  is                 !<
-    INTEGER(iwp)       ::  j                  !<
-    INTEGER(iwp)       ::  je                 !<
-    INTEGER(iwp)       ::  js                 !<
-    INTEGER(iwp), SAVE ::  lpm_count = 0      !<
-    INTEGER(iwp)       ::  k                  !<
-    INTEGER(iwp)       ::  ke                 !<
-    INTEGER(iwp)       ::  ks                 !<
-    INTEGER(iwp)       ::  m                  !<
-    INTEGER(iwp), SAVE ::  steps = 0          !<
-
-    LOGICAL            ::  first_loop_stride  !<
-
-
-    SELECT CASE ( location )
-
-       CASE ( 'after_pressure_solver' )
-!
-!--       The particle model is executed if particle advection start is reached and only at the end
-!--       of the intermediate time step loop.
-          IF ( time_since_reference_point >= particle_advection_start                              &
-               .AND.  intermediate_timestep_count == intermediate_timestep_count_max )             &
-          THEN
-             CALL cpu_log( log_point(25), 'lpm', 'start' )
-!
-!--          Write particle data at current time on file.
-!--          This has to be done here, before particles are further processed, because they may be
-!--          deleted within this timestep (in case that dt_write_particle_data = dt_prel =
-!--          particle_maximum_age).
-             time_write_particle_data = time_write_particle_data + dt_3d
-             IF ( time_write_particle_data >= dt_write_particle_data )  THEN
-
-                CALL lpm_data_output_particles
-!
-!--          The MOD function allows for changes in the output interval with restart runs.
-                time_write_particle_data = MOD( time_write_particle_data,                          &
-                                           MAX( dt_write_particle_data, dt_3d ) )
-             ENDIF
-
-!
-!--          Initialize arrays for marking those particles to be deleted after the (sub-) timestep.
-             deleted_particles = 0
-
-!
-!--          Initialize variables used for accumulating the number of particles exchanged between
-!--          the subdomains during all sub-timesteps (if sgs velocities are included). These data
-!--          are output further below on the particle statistics file.
-             trlp_count_sum      = 0
-             trlp_count_recv_sum = 0
-             trrp_count_sum      = 0
-             trrp_count_recv_sum = 0
-             trsp_count_sum      = 0
-             trsp_count_recv_sum = 0
-             trnp_count_sum      = 0
-             trnp_count_recv_sum = 0
-!
-!--          Calculate exponential term used in case of particle inertia for each
-!--          of the particle groups
-             DO  m = 1, number_of_particle_groups
-                IF ( particle_groups(m)%density_ratio /= 0.0_wp )  THEN
-                   particle_groups(m)%exp_arg  = 4.5_wp * particle_groups(m)%density_ratio *       &
-                                                 molecular_viscosity /                             &
-                                                 ( particle_groups(m)%radius )**2
-
-                   particle_groups(m)%exp_term = EXP( -particle_groups(m)%exp_arg * dt_3d )
-                ENDIF
-             ENDDO
-!
-!--          If necessary, release new set of particles
-             IF ( ( simulated_time - last_particle_release_time ) >= dt_prel  .AND.                &
-                    end_time_prel > simulated_time )  THEN
-                DO WHILE ( ( simulated_time - last_particle_release_time ) >= dt_prel )
-                   CALL lpm_create_particle( phase_release )
-                   last_particle_release_time = last_particle_release_time + dt_prel
-                ENDDO
-             ENDIF
-!
-!--          Reset summation arrays
-             IF ( cloud_droplets )  THEN
-                ql_c  = 0.0_wp
-                ql_v  = 0.0_wp
-                ql_vp = 0.0_wp
-             ENDIF
-
-             first_loop_stride = .TRUE.
-             grid_particles(:,:,:)%time_loop_done = .TRUE.
-!
-!--          Timestep loop for particle advection.
-!--          This loop has to be repeated until the advection time of every particle (within the
-!--          total domain!) has reached the LES timestep (dt_3d).
-!--          In case of including the SGS velocities, the particle timestep may be smaller than the
-!--          LES timestep (because of the Lagrangian timescale restriction) and particles may
-!--          require to undergo several particle timesteps, before the LES timestep is reached.
-!--          Because the number of these particle timesteps to be carried out is unknown at first,
-!--          these steps are carried out in the following infinite loop with exit condition.
-             DO
-                CALL cpu_log( log_point_s(44), 'lpm_advec', 'start' )
-                CALL cpu_log( log_point_s(44), 'lpm_advec', 'pause' )
-
-!
-!--             If particle advection includes SGS velocity components, calculate the required SGS
-!--             quantities (i.e. gradients of the TKE, as well as horizontally averaged profiles of
-!--             the SGS TKE and the resolved-scale velocity variances)
-                IF ( use_sgs_for_particles  .AND.  .NOT. cloud_droplets )  THEN
-                   CALL lpm_init_sgs_tke
-                ENDIF
-!
-!--             In case SGS-particle speed is considered, particles may carry out several particle
-!--             timesteps. In order to prevent unnecessary treatment of particles that already
-!--             reached the final time level, particles are sorted into contiguous blocks of
-!--             finished and not-finished particles, in addition to their already sorting
-!--             according to their sub-boxes.
-                IF ( .NOT. first_loop_stride  .AND.  use_sgs_for_particles )                       &
-                   CALL lpm_sort_timeloop_done
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-!
-!--                   Put the random seeds at grid point j, i
-                      CALL random_seed_parallel( put=seq_random_array_particles(:,j,i) )
-
-                      DO  k = nzb+1, nzt
-
-                         number_of_particles = prt_count(k,j,i)
-!
-!--                      If grid cell gets empty, flag must be true
-                         IF ( number_of_particles <= 0 )  THEN
-                            grid_particles(k,j,i)%time_loop_done = .TRUE.
-                            CYCLE
-                         ENDIF
-
-                         IF ( .NOT. first_loop_stride  .AND.  &
-                              grid_particles(k,j,i)%time_loop_done )  CYCLE
-
-                         particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-
-                         particles(1:number_of_particles)%particle_mask = .TRUE.
-!
-!--                      Initialize the variable storing the total time that a particle has advanced
-!--                      within the timestep procedure.
-                         IF ( first_loop_stride )  THEN
-                            particles(1:number_of_particles)%dt_sum = 0.0_wp
-                         ENDIF
-!
-!--                      Particle (droplet) growth by condensation/evaporation and collision
-                         IF ( cloud_droplets  .AND.  first_loop_stride)  THEN
-!
-!--                         Droplet growth by condensation / evaporation
-                            CALL lpm_droplet_condensation(i,j,k)
-!
-!--                         Particle growth by collision
-                            IF ( collision_kernel /= 'none' )  THEN
-                               CALL lpm_droplet_collision(i,j,k)
-                            ENDIF
-
-                         ENDIF
-!
-!--                      Initialize the switch used for the loop exit condition checked at the end
-!--                      of this loop. If at least one particle has failed to reach the LES
-!--                      timestep, this switch will be set false in lpm_advec.
-                         dt_3d_reached_l = .TRUE.
-
-!
-!--                      Particle advection
-                         CALL lpm_advec( i, j, k )
-!
-!--                      Particle reflection from walls. Only applied if the particles are in the
-!--                      vertical range of the topography. (Here, some optimization is still
-!--                      possible.)
-                         IF ( topography /= 'flat'  .AND.  k < nzb_max + 2 )  THEN
-                            CALL  lpm_boundary_conds( 'walls', i, j, k )
-                         ENDIF
-!
-!--                      User-defined actions after the calculation of the new particle position
-                         CALL user_lpm_advec( i, j, k )
-!
-!--                      Apply boundary conditions to those particles that have crossed the top or
-!--                      bottom boundary and delete those particles, which are older than allowed
-                         CALL lpm_boundary_conds( 'bottom/top', i, j, k )
-!
-!---                     If not all particles of the actual grid cell have reached the LES timestep,
-!--                      this cell has to do another loop iteration. Due to the fact that particles
-!--                      can move into neighboring grid cells, these neighbor cells also have to
-!--                      perform another loop iteration.
-!--                      Please note, this realization does not work properly if particles move into
-!--                      another subdomain.
-                         IF ( .NOT. dt_3d_reached_l )  THEN
-                            ks = MAX(nzb+1,k-1)
-                            ke = MIN(nzt,k+1)
-                            js = MAX(nys,j-1)
-                            je = MIN(nyn,j+1)
-                            is = MAX(nxl,i-1)
-                            ie = MIN(nxr,i+1)
-                            grid_particles(ks:ke,js:je,is:ie)%time_loop_done = .FALSE.
-                         ELSE
-                            grid_particles(k,j,i)%time_loop_done = .TRUE.
-                         ENDIF
-
-                      ENDDO
-!
-!--                   Get the new random seeds from last call at grid point jp, ip
-                      CALL random_seed_parallel( get=seq_random_array_particles(:,j,i) )
-
-                   ENDDO
-                ENDDO
-                steps = steps + 1
-                dt_3d_reached_l = ALL(grid_particles(:,:,:)%time_loop_done)
-!
-!--             Find out, if all particles on every PE have completed the LES timestep and set the
-!--             switch corespondingly
-#if defined( __parallel )
-                IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-                CALL MPI_ALLREDUCE( dt_3d_reached_l, dt_3d_reached, 1, MPI_LOGICAL, MPI_LAND,      &
-                                    comm2d, ierr )
-#else
-                dt_3d_reached = dt_3d_reached_l
-#endif
-                CALL cpu_log( log_point_s(44), 'lpm_advec', 'stop' )
-
-!
-!--             Apply splitting and merging algorithm
-                IF ( cloud_droplets )  THEN
-                   IF ( splitting )  THEN
-                      CALL lpm_splitting
-                   ENDIF
-                   IF ( merging )  THEN
-                      CALL lpm_merging
-                   ENDIF
-                ENDIF
-!
-!--             Move Particles local to PE to a different grid cell
-                CALL lpm_move_particle
-!
-!--             Horizontal boundary conditions including exchange between subdmains
-                CALL lpm_exchange_horiz
-
-!
-!--             IF .FALSE., lpm_sort_and_delete is done inside pcmp
-                IF ( .NOT. dt_3d_reached  .OR.  .NOT. nested_run )   THEN
-!
-!--                Pack particles (eliminate those marked for deletion), determine new number of
-!--                particles
-                   CALL lpm_sort_and_delete
-
-!--                Initialize variables for the next (sub-) timestep, i.e., for marking those
-!--                particles to be deleted after the timestep
-                   deleted_particles = 0
-                ENDIF
-
-                IF ( dt_3d_reached )  EXIT
-
-                first_loop_stride = .FALSE.
-             ENDDO   ! timestep loop
-
-#if defined( __parallel )
-!
-!--          In case of nested runs do the transfer of particles after every full model time step
-!--          if requested ( particle_coupling = .TRUE. )
-             IF ( nested_run )   THEN   
-                IF ( particle_coupling )  THEN
-                   CALL particles_from_parent_to_child
-                   CALL particles_from_child_to_parent
-                   CALL pmcp_p_delete_particles_in_fine_grid_area
-                ENDIF
-                CALL lpm_sort_and_delete
-
-                deleted_particles = 0
-             ENDIF
-#endif
-
-!
-!--          Calculate the new liquid water content for each grid box
-             IF ( cloud_droplets )  CALL lpm_calc_liquid_water_content
-
-!
-!--          At the end all arrays are exchanged
-             IF ( cloud_droplets )  THEN
-                CALL exchange_horiz( ql, nbgp )
-                CALL exchange_horiz( ql_c, nbgp )
-                CALL exchange_horiz( ql_v, nbgp )
-                CALL exchange_horiz( ql_vp, nbgp )
-             ENDIF
-
-!
-!--          Deallocate unused memory
-             IF ( deallocate_memory  .AND.  lpm_count == step_dealloc )  THEN
-                CALL dealloc_particles_array
-                lpm_count = 0
-             ELSEIF ( deallocate_memory )  THEN
-                lpm_count = lpm_count + 1
-             ENDIF
-
-!
-!--          Write particle statistics (in particular the number of particles exchanged between the
-!--          subdomains) on file
-             IF ( write_particle_statistics )  CALL lpm_write_exchange_statistics
-!
-!--          Execute Interactions of condnesation and evaporation to humidity and temperature field
-             IF ( cloud_droplets )  THEN
-                CALL lpm_interaction_droplets_ptq
-                CALL exchange_horiz( pt, nbgp )
-                CALL exchange_horiz( q, nbgp )
-             ENDIF
-
-             CALL cpu_log( log_point(25), 'lpm', 'stop' )
-
-! !
-! !--       Output of particle time series
-!           IF ( particle_advection )  THEN
-!              IF ( time_dopts >= dt_dopts  .OR.                                                        &
-!                   ( time_since_reference_point >= particle_advection_start  .AND.                     &
-!                    first_call_lpm ) )  THEN
-!                 CALL lpm_data_output_ptseries
-!                 time_dopts = MOD( time_dopts, MAX( dt_dopts, dt_3d ) )
-!              ENDIF
-!           ENDIF
-
-!
-!--           Set this switch to .false. @todo: maybe find better solution.
-              first_call_lpm = .FALSE.
-           ENDIF! ENDIF statement of lpm_actions('after_pressure_solver')
-
-       CASE ( 'after_integration' )
-!
-!--       Call at the end of timestep routine to save particle velocities fields for the next
-!--       timestep
-          CALL lpm_swap_timelevel_for_particle_advection
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE lpm_actions
-
-
-#if defined( __parallel )
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE particles_from_parent_to_child
-
-    CALL pmcp_c_get_particle_from_parent                         ! Child actions
-    CALL pmcp_p_fill_particle_win                                ! Parent actions
-
-    RETURN
-
- END SUBROUTINE particles_from_parent_to_child
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE particles_from_child_to_parent
-
-    CALL pmcp_c_send_particle_to_parent                         ! Child actions
-    CALL pmcp_p_empty_particle_win                              ! Parent actions
-
-    RETURN
-
- END SUBROUTINE particles_from_child_to_parent
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine write exchange statistics of the lpm in a ascii file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_write_exchange_statistics
-
-    INTEGER(iwp) ::  ip         !<
-    INTEGER(iwp) ::  jp         !<
-    INTEGER(iwp) ::  kp         !<
-    INTEGER(iwp) ::  tot_number_of_particles !<
-
-!
-!-- Determine the current number of particles
-    number_of_particles         = 0
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          DO  kp = nzb+1, nzt
-             number_of_particles = number_of_particles + prt_count(kp,jp,ip)
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL check_open( 80 )
-#if defined( __parallel )
-    WRITE ( 80, 8000 )  current_timestep_number+1, simulated_time+dt_3d, number_of_particles,      &
-                        pleft, trlp_count_sum, trlp_count_recv_sum, pright, trrp_count_sum,        &
-                        trrp_count_recv_sum, psouth, trsp_count_sum, trsp_count_recv_sum, pnorth,  &
-                        trnp_count_sum, trnp_count_recv_sum
-#else
-    WRITE ( 80, 8000 )  current_timestep_number+1, simulated_time+dt_3d, number_of_particles
-#endif
-    CALL close_file( 80 )
-
-    IF ( number_of_particles > 0 )  THEN
-        WRITE(9,*) 'number_of_particles ', number_of_particles, current_timestep_number + 1,       &
-                   simulated_time + dt_3d
-    ENDIF
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( number_of_particles, tot_number_of_particles, 1, MPI_INTEGER, MPI_SUM,     &
-                        comm2d, ierr )
-#else
-    tot_number_of_particles = number_of_particles
-#endif
-
-#if defined( __parallel )
-    IF ( nested_run )  THEN
-       CALL pmcp_g_print_number_of_particles( simulated_time + dt_3d, tot_number_of_particles)
-    ENDIF
-#endif
-
-!
-!-- Formats
-8000 FORMAT (I6,1X,F7.2,4X,I10,5X,4(I3,1X,I4,'/',I4,2X),6X,I10)
-
-
- END SUBROUTINE lpm_write_exchange_statistics
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write particle data in FORTRAN binary and/or netCDF format
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_data_output_particles
-
-    INTEGER(iwp) ::  ip !<
-    INTEGER(iwp) ::  jp !<
-    INTEGER(iwp) ::  kp !<
-
-    CALL cpu_log( log_point_s(40), 'lpm_data_output', 'start' )
-
-!
-!-- Attention: change version number for unit 85 (in routine check_open) whenever the output format
-!--            for this unit is changed!
-    CALL check_open( 85 )
-
-    WRITE ( 85 )  simulated_time
-    WRITE ( 85 )  prt_count
-
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          DO  kp = nzb+1, nzt
-             number_of_particles = prt_count(kp,jp,ip)
-             particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-             IF ( number_of_particles <= 0 )  CYCLE
-             WRITE ( 85 )  particles
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL close_file( 85 )
-
-
-#if defined( __netcdf )
-! !
-! !-- Output in netCDF format
-!     CALL check_open( 108 )
-!
-! !
-! !-- Update the NetCDF time axis
-!     prt_time_count = prt_time_count + 1
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_time_prt, &
-!                             (/ simulated_time /),        &
-!                             start = (/ prt_time_count /), count = (/ 1 /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 1 )
-!
-! !
-! !-- Output the real number of particles used
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_rnop_prt, &
-!                             (/ number_of_particles /),   &
-!                             start = (/ prt_time_count /), count = (/ 1 /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 2 )
-!
-! !
-! !-- Output all particle attributes
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(1), particles%age,      &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 3 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(2), particles%user,     &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 4 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(3), particles%origin_x, &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 5 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(4), particles%origin_y, &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 6 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(5), particles%origin_z, &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 7 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(6), particles%radius,   &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 8 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(7), particles%speed_x,  &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 9 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(8), particles%speed_y,  &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 10 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(9), particles%speed_z,  &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 11 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt,id_var_prt(10),                     &
-!                             particles%weight_factor,                       &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 12 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(11), particles%x,       &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 13 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(12), particles%y,       &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 14 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(13), particles%z,       &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 15 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(14), particles%class,   &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 16 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(15), particles%group,   &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 17 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(16),                    &
-!                             particles%id2,                                 &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 18 )
-!
-!     nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(17), particles%id1,     &
-!                             start = (/ 1, prt_time_count /),               &
-!                             count = (/ maximum_number_of_particles /) )
-!     CALL netcdf_handle_error( 'lpm_data_output_particles', 19 )
-!
-#endif
-
-    CALL cpu_log( log_point_s(40), 'lpm_data_output', 'stop' )
-
- END SUBROUTINE lpm_data_output_particles
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine calculates and provide particle timeseries output.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_data_output_ptseries
-
-    INTEGER(iwp) ::  i    !<
-    INTEGER(iwp) ::  inum !<
-    INTEGER(iwp) ::  j    !<
-    INTEGER(iwp) ::  jg   !<
-    INTEGER(iwp) ::  k    !<
-    INTEGER(iwp) ::  n    !<
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pts_value   !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pts_value_l !<
-
-
-    CALL cpu_log( log_point(36), 'data_output_ptseries', 'start' )
-
-    IF ( dop_active )  THEN
-       CALL dop_output_tseries
-    ENDIF
-
-    IF ( myid == 0 )  THEN
-!
-!--    Open file for time series output in NetCDF format
-       dopts_time_count = dopts_time_count + 1
-       CALL check_open( 109 )
-#if defined( __netcdf )
-!
-!--    Update the particle time series time axis
-       nc_stat = NF90_PUT_VAR( id_set_pts, id_var_time_pts, (/ time_since_reference_point /),      &
-                               start = (/ dopts_time_count /), count = (/ 1 /) )
-       CALL netcdf_handle_error( 'data_output_ptseries', 391 )
-#endif
-
-    ENDIF
-
-    ALLOCATE( pts_value(0:number_of_particle_groups,dopts_num),                                    &
-              pts_value_l(0:number_of_particle_groups,dopts_num) )
-
-    pts_value_l = 0.0_wp
-    pts_value_l(:,16) = 9999999.9_wp    ! for calculation of minimum radius
-
-!
-!-- Calculate or collect the particle time series quantities for all particles and seperately for
-!-- each particle group (if there is more than one group)
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt
-             number_of_particles = prt_count(k,j,i)
-             IF (number_of_particles <= 0)  CYCLE
-             particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-             DO  n = 1, number_of_particles
-
-                IF ( particles(n)%particle_mask )  THEN  ! Restrict analysis to active particles
-
-                   pts_value_l(0,1)  = pts_value_l(0,1) + 1.0_wp                   ! total # of particles
-                   pts_value_l(0,2)  = pts_value_l(0,2) +                                          &
-                                       ( particles(n)%x - particles(n)%origin_x )  ! mean x
-                   pts_value_l(0,3)  = pts_value_l(0,3) +                                          &
-                                       ( particles(n)%y - particles(n)%origin_y )  ! mean y
-                   pts_value_l(0,4)  = pts_value_l(0,4) +                                          &
-                                       ( particles(n)%z - particles(n)%origin_z )  ! mean z
-                   pts_value_l(0,5)  = pts_value_l(0,5) + particles(n)%z           ! mean z (absolute)
-                   pts_value_l(0,6)  = pts_value_l(0,6) + particles(n)%speed_x     ! mean u
-                   pts_value_l(0,7)  = pts_value_l(0,7) + particles(n)%speed_y     ! mean v
-                   pts_value_l(0,8)  = pts_value_l(0,8) + particles(n)%speed_z     ! mean w
-                   pts_value_l(0,9)  = pts_value_l(0,9)  + particles(n)%rvar1      ! mean sgsu
-                   pts_value_l(0,10) = pts_value_l(0,10) + particles(n)%rvar2      ! mean sgsv
-                   pts_value_l(0,11) = pts_value_l(0,11) + particles(n)%rvar3      ! mean sgsw
-                   IF ( particles(n)%speed_z > 0.0_wp )  THEN
-                      pts_value_l(0,12) = pts_value_l(0,12) + 1.0_wp                ! # of upward moving prts
-                      pts_value_l(0,13) = pts_value_l(0,13) +  particles(n)%speed_z ! mean w upw.
-                   ELSE
-                      pts_value_l(0,14) = pts_value_l(0,14) + particles(n)%speed_z  ! mean w down
-                   ENDIF
-                   pts_value_l(0,15) = pts_value_l(0,15) + particles(n)%radius       ! mean rad
-                   pts_value_l(0,16) = MIN( pts_value_l(0,16), particles(n)%radius ) ! minrad
-                   pts_value_l(0,17) = MAX( pts_value_l(0,17), particles(n)%radius ) ! maxrad
-                   pts_value_l(0,18) = pts_value_l(0,18) + 1.0_wp
-                   pts_value_l(0,19) = pts_value_l(0,18) + 1.0_wp
-!
-!--                Repeat the same for the respective particle group
-                   IF ( number_of_particle_groups > 1 )  THEN
-                      jg = particles(n)%group
-
-                      pts_value_l(jg,1)  = pts_value_l(jg,1) + 1.0_wp
-                      pts_value_l(jg,2)  = pts_value_l(jg,2) +                                     &
-                                           ( particles(n)%x  - particles(n)%origin_x )
-                      pts_value_l(jg,3)  = pts_value_l(jg,3) +                                     &
-                                           ( particles(n)%y  - particles(n)%origin_y )
-                      pts_value_l(jg,4)  = pts_value_l(jg,4) +                                     &
-                                           ( particles(n)%z  - particles(n)%origin_z )
-                      pts_value_l(jg,5)  = pts_value_l(jg,5) + particles(n)%z
-                      pts_value_l(jg,6)  = pts_value_l(jg,6) + particles(n)%speed_x
-                      pts_value_l(jg,7)  = pts_value_l(jg,7) + particles(n)%speed_y
-                      pts_value_l(jg,8)  = pts_value_l(jg,8) + particles(n)%speed_z
-                      pts_value_l(jg,9)  = pts_value_l(jg,9)  + particles(n)%rvar1
-                      pts_value_l(jg,10) = pts_value_l(jg,10) + particles(n)%rvar2
-                      pts_value_l(jg,11) = pts_value_l(jg,11) + particles(n)%rvar3
-                      IF ( particles(n)%speed_z > 0.0_wp )  THEN
-                         pts_value_l(jg,12) = pts_value_l(jg,12) + 1.0_wp
-                         pts_value_l(jg,13) = pts_value_l(jg,13) + particles(n)%speed_z
-                      ELSE
-                         pts_value_l(jg,14) = pts_value_l(jg,14) + particles(n)%speed_z
-                      ENDIF
-                      pts_value_l(jg,15) = pts_value_l(jg,15) + particles(n)%radius
-                      pts_value_l(jg,16) = MIN( pts_value_l(jg,16), particles(n)%radius )
-                      pts_value_l(jg,17) = MAX( pts_value_l(jg,17), particles(n)%radius )
-                      pts_value_l(jg,18) = pts_value_l(jg,18) + 1.0_wp
-                      pts_value_l(jg,19) = pts_value_l(jg,19) + 1.0_wp
-                   ENDIF
-
-                ENDIF
-
-             ENDDO
-
-          ENDDO
-       ENDDO
-    ENDDO
-
-
-#if defined( __parallel )
-!
-!-- Sum values of the subdomains
-    inum = number_of_particle_groups + 1
-
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( pts_value_l(0,1), pts_value(0,1), 15*inum, MPI_REAL, MPI_SUM, comm2d, ierr )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( pts_value_l(0,16), pts_value(0,16), inum, MPI_REAL, MPI_MIN, comm2d, ierr )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( pts_value_l(0,17), pts_value(0,17), inum, MPI_REAL, MPI_MAX, comm2d, ierr )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( pts_value_l(0,18), pts_value(0,18), inum, MPI_REAL, MPI_MAX, comm2d, ierr )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( pts_value_l(0,19), pts_value(0,19), inum, MPI_REAL, MPI_MIN, comm2d, ierr )
-#else
-    pts_value(:,1:19) = pts_value_l(:,1:19)
-#endif
-
-!
-!-- Normalize the above calculated quantities (except min/max values) with the total number of
-!-- particles
-    IF ( number_of_particle_groups > 1 )  THEN
-       inum = number_of_particle_groups
-    ELSE
-       inum = 0
-    ENDIF
-
-    DO  j = 0, inum
-
-       IF ( pts_value(j,1) > 0.0_wp )  THEN
-
-          pts_value(j,2:15) = pts_value(j,2:15) / pts_value(j,1)
-          IF ( pts_value(j,12) > 0.0_wp  .AND.  pts_value(j,12) < 1.0_wp )  THEN
-             pts_value(j,13) = pts_value(j,13) / pts_value(j,12)
-             pts_value(j,14) = pts_value(j,14) / ( 1.0_wp - pts_value(j,12) )
-          ELSEIF ( pts_value(j,12) == 0.0_wp )  THEN
-             pts_value(j,13) = -1.0_wp
-          ELSE
-             pts_value(j,14) = -1.0_wp
-          ENDIF
-
-       ENDIF
-
-    ENDDO
-
-!
-!-- Calculate higher order moments of particle time series quantities, seperately for each particle
-!-- group (if there is more than one group)
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb, nzt
-             number_of_particles = prt_count(k,j,i)
-             IF (number_of_particles <= 0)  CYCLE
-             particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-             DO  n = 1, number_of_particles
-
-                pts_value_l(0,20) = pts_value_l(0,20) + ( particles(n)%x -                         &
-                                       particles(n)%origin_x - pts_value(0,2) )**2 ! x*2
-                pts_value_l(0,21) = pts_value_l(0,21) + ( particles(n)%y -                         &
-                                       particles(n)%origin_y - pts_value(0,3) )**2 ! y*2
-                pts_value_l(0,22) = pts_value_l(0,22) + ( particles(n)%z -                         &
-                                       particles(n)%origin_z - pts_value(0,4) )**2 ! z*2
-                pts_value_l(0,23) = pts_value_l(0,23) + ( particles(n)%speed_x -                   &
-                                                          pts_value(0,6) )**2      ! u*2
-                pts_value_l(0,24) = pts_value_l(0,24) + ( particles(n)%speed_y -                   &
-                                                          pts_value(0,7) )**2      ! v*2
-                pts_value_l(0,25) = pts_value_l(0,25) + ( particles(n)%speed_z -                   &
-                                                          pts_value(0,8) )**2      ! w*2
-                pts_value_l(0,26) = pts_value_l(0,26) + ( particles(n)%rvar1 -                     &
-                                                          pts_value(0,9) )**2      ! u"2
-                pts_value_l(0,27) = pts_value_l(0,27) + ( particles(n)%rvar2 -                     &
-                                                          pts_value(0,10) )**2     ! v"2
-                pts_value_l(0,28) = pts_value_l(0,28) + ( particles(n)%rvar3 -                     &
-                                                          pts_value(0,11) )**2  ! w"2
-!
-!--             Repeat the same for the respective particle group
-                IF ( number_of_particle_groups > 1 )  THEN
-                   jg = particles(n)%group
-
-                   pts_value_l(jg,20) = pts_value_l(jg,20) + ( particles(n)%x -                    &
-                                           particles(n)%origin_x - pts_value(jg,2) )**2
-                   pts_value_l(jg,21) = pts_value_l(jg,21) + ( particles(n)%y -                    &
-                                           particles(n)%origin_y - pts_value(jg,3) )**2
-                   pts_value_l(jg,22) = pts_value_l(jg,22) + ( particles(n)%z -                    &
-                                           particles(n)%origin_z - pts_value(jg,4) )**2
-                   pts_value_l(jg,23) = pts_value_l(jg,23) + ( particles(n)%speed_x -              &
-                                                               pts_value(jg,6) )**2
-                   pts_value_l(jg,24) = pts_value_l(jg,24) + ( particles(n)%speed_y -              &
-                                                               pts_value(jg,7) )**2
-                   pts_value_l(jg,25) = pts_value_l(jg,25) + ( particles(n)%speed_z -              &
-                                                               pts_value(jg,8) )**2
-                   pts_value_l(jg,26) = pts_value_l(jg,26) + ( particles(n)%rvar1 -                &
-                                                               pts_value(jg,9) )**2
-                   pts_value_l(jg,27) = pts_value_l(jg,27) + ( particles(n)%rvar2 -                &
-                                                               pts_value(jg,10) )**2
-                   pts_value_l(jg,28) = pts_value_l(jg,28) + ( particles(n)%rvar3 -                &
-                                                               pts_value(jg,11) )**2
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-    pts_value_l(0,29) = ( number_of_particles - pts_value(0,1) / numprocs )**2
-                                                 ! variance of particle numbers
-    IF ( number_of_particle_groups > 1 )  THEN
-       DO  j = 1, number_of_particle_groups
-          pts_value_l(j,29) = ( pts_value_l(j,1) - pts_value(j,1) / numprocs )**2
-       ENDDO
-    ENDIF
-
-#if defined( __parallel )
-!
-!-- Sum values of the subdomains
-    inum = number_of_particle_groups + 1
-
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( pts_value_l(0,20), pts_value(0,20), inum*10, MPI_REAL, MPI_SUM, comm2d,    &
-                        ierr )
-#else
-    pts_value(:,20:29) = pts_value_l(:,20:29)
-#endif
-
-!
-!-- Normalize the above calculated quantities with the total number of particles
-    IF ( number_of_particle_groups > 1 )  THEN
-       inum = number_of_particle_groups
-    ELSE
-       inum = 0
-    ENDIF
-
-    DO  j = 0, inum
-
-       IF ( pts_value(j,1) > 0.0_wp )  THEN
-          pts_value(j,20:28) = pts_value(j,20:28) / pts_value(j,1)
-       ENDIF
-       pts_value(j,29) = pts_value(j,29) / numprocs
-
-    ENDDO
-
-#if defined( __netcdf )
-!
-!-- Output particle time series quantities in NetCDF format
-    IF ( myid == 0 )  THEN
-       DO  j = 0, inum
-          DO  i = 1, dopts_num
-             nc_stat = NF90_PUT_VAR( id_set_pts, id_var_dopts(i,j),                                &
-                                     (/ pts_value(j,i) /),                                         &
-                                     start = (/ dopts_time_count /),                               &
-                                     count = (/ 1 /) )
-             CALL netcdf_handle_error( 'data_output_ptseries', 392 )
-          ENDDO
-       ENDDO
-    ENDIF
-#endif
-
-    DEALLOCATE( pts_value, pts_value_l )
-
-    CALL cpu_log( log_point(36), 'data_output_ptseries', 'stop' )
-
-END SUBROUTINE lpm_data_output_ptseries
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine reads the respective restart data for the lpm.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_rrd_local_particles
-
-    CHARACTER(LEN=10) ::  particle_binary_version    !<
-    CHARACTER(LEN=10) ::  version_on_file            !<
-
-    CHARACTER(LEN=20) ::  save_restart_data_format_input  !<
-
-    INTEGER(iwp) ::  alloc_size !<
-    INTEGER(iwp) ::  ip         !<
-    INTEGER(iwp) ::  jp         !<
-    INTEGER(iwp) ::  kp         !<
-
-    INTEGER(idp), ALLOCATABLE, DIMENSION(:,:,:) ::  prt_global_index !<
-
-    LOGICAL ::  save_debug_output  !<
-
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  tmp_particles !<
-
-    IF ( TRIM( restart_data_format_input ) == 'fortran_binary' )  THEN
-
-!
-!--    Read particle data from previous model run.
-!--    First open the input unit.
-       IF ( myid_char == '' )  THEN
-          OPEN ( 90, FILE='PARTICLE_RESTART_DATA_IN'//myid_char, FORM='UNFORMATTED' )
-       ELSE
-          OPEN ( 90, FILE='PARTICLE_RESTART_DATA_IN/'//myid_char, FORM='UNFORMATTED' )
-       ENDIF
-
-!
-!--    First compare the version numbers
-       READ ( 90 )  version_on_file
-       particle_binary_version = '4.0'
-       IF ( TRIM( version_on_file ) /= TRIM( particle_binary_version ) )  THEN
-          message_string = 'version mismatch concerning data from prior ' //                       &
-                           'run &version on file = "' //                                           &
-                                         TRIM( version_on_file ) //                                &
-                           '&version in program = "' //                                            &
-                                         TRIM( particle_binary_version ) // '"'
-          CALL message( 'lpm_read_restart_file', 'PA0214', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    If less particles are stored on the restart file than prescribed by 1, the remainder is
-!--    initialized by zero_particle to avoid errors.
-       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_wp,                      &
-                                      0, 0, 0_idp, .FALSE., -1, -1 )
-!
-!--    Read some particle parameters and the size of the particle arrays, allocate them and read
-!--    their contents.
-       READ ( 90 )  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, last_particle_release_time,          &
-                    number_of_particle_groups, particle_groups, time_write_particle_data
-
-       ALLOCATE( prt_count(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                         &
-                 grid_particles(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-       READ ( 90 )  prt_count
-
-       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 )  THEN
-                   alloc_size = MAX( INT( number_of_particles *                                    &
-                                          ( 1.0_wp + alloc_factor / 100.0_wp ) ),                  &
-                                     1 )
-                ELSE
-                   alloc_size = 1
-                ENDIF
-
-                ALLOCATE( grid_particles(kp,jp,ip)%particles(1:alloc_size) )
-
-                IF ( number_of_particles > 0 )  THEN
-                   ALLOCATE( tmp_particles(1:number_of_particles) )
-                   READ ( 90 )  tmp_particles
-                   grid_particles(kp,jp,ip)%particles(1:number_of_particles) = tmp_particles
-                   DEALLOCATE( tmp_particles )
-                   IF ( number_of_particles < alloc_size )  THEN
-                      grid_particles(kp,jp,ip)%particles(number_of_particles+1:alloc_size)         &
-                         = zero_particle
-                   ENDIF
-                ELSE
-                   grid_particles(kp,jp,ip)%particles(1:alloc_size) = zero_particle
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-       CLOSE ( 90 )
-
-    ELSEIF ( restart_data_format_input(1:3) == 'mpi' )  THEN
-
-       WRITE ( 9, * )  'Here is MPI-IO praticle input ', rd_mpi_io_check_open()
-       FLUSH(9)
-
-       ALLOCATE( grid_particles(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                    &
-                 id_counter(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                        &
-                 prt_count(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                         &
-                 prt_global_index(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-!
-!--    Open restart file for read, if not already open, and do not allow usage of shared-memory I/O
-       IF ( .NOT. rd_mpi_io_check_open() )  THEN
-          save_restart_data_format_input = restart_data_format_input
-          restart_data_format_input = 'mpi'
-          CALL rd_mpi_io_open( 'READ', 'BININ' )
-          restart_data_format_input = save_restart_data_format_input
-       ENDIF
-
-       CALL  rd_mpi_io_particle_filetypes
-
-       prt_count = 0
-       CALL rrd_mpi_io( 'id_counter', id_counter )
-       CALL rrd_mpi_io( 'prt_count', prt_count )
-       CALL rrd_mpi_io( 'prt_global_index', prt_global_index )
-
-!
-!--    Allocate particles arrays
-       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 )  THEN
-                   alloc_size = MAX( INT( number_of_particles *                                    &
-                                          ( 1.0_wp + alloc_factor / 100.0_wp ) ),                  &
-                                     1 )
-                ELSE
-                   alloc_size = 1
-                ENDIF
-
-                ALLOCATE( grid_particles(kp,jp,ip)%particles(1:alloc_size) )
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-!
-!--    Now read particle data from restart file
-       CALL rrd_mpi_io_particles( 'particles', prt_global_index )
-
-       IF ( .NOT. rd_mpi_io_check_open() )  THEN
-!
-!--       Do not print header a second time to the debug file
-          save_debug_output = debug_output
-          debug_output      = .FALSE.
-          CALL rd_mpi_io_close()
-          debug_output = save_debug_output
-       ENDIF
-
-       DEALLOCATE( prt_global_index )
-
-    ENDIF
-!
-!-- Must be called to sort particles into blocks, which is needed for a fast interpolation of the
-!-- LES fields on the particle position.
-    CALL lpm_sort_and_delete
-
- END SUBROUTINE lpm_rrd_local_particles
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,    &
-                               nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
-
-
-   USE control_parameters,                                                                         &
-       ONLY: length, restart_string
-
-    INTEGER(iwp) ::  k               !<
-    INTEGER(iwp) ::  nxlc            !<
-    INTEGER(iwp) ::  nxlf            !<
-    INTEGER(iwp) ::  nxl_on_file     !<
-    INTEGER(iwp) ::  nxrc            !<
-    INTEGER(iwp) ::  nxrf            !<
-    INTEGER(iwp) ::  nxr_on_file     !<
-    INTEGER(iwp) ::  nync            !<
-    INTEGER(iwp) ::  nynf            !<
-    INTEGER(iwp) ::  nyn_on_file     !<
-    INTEGER(iwp) ::  nysc            !<
-    INTEGER(iwp) ::  nysf            !<
-    INTEGER(iwp) ::  nys_on_file     !<
-
-    INTEGER(isp), DIMENSION(:,:,:), ALLOCATABLE ::  tmp_2d_seq_random_particles  !< temporary array for storing random generator
-                                                                                 !< data for the lpm
-
-    LOGICAL, INTENT(OUT)  ::  found
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::  tmp_3d          !<
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::  tmp_3d_int  !<
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-        CASE ( 'id_counter' )
-           IF ( .NOT. ALLOCATED( id_counter ) )  THEN
-              ALLOCATE( id_counter(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-           ENDIF
-           IF ( k == 1 )  READ ( 13 )  tmp_3d_int
-           id_counter(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
-              tmp_3d_int(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-        CASE ( 'pc_av' )
-           IF ( .NOT. ALLOCATED( pc_av ) )  THEN
-              ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-           ENDIF
-           IF ( k == 1 )  READ ( 13 )  tmp_3d
-           pc_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                      &
-              tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-        CASE ( 'pr_av' )
-           IF ( .NOT. ALLOCATED( pr_av ) )  THEN
-              ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-           ENDIF
-           IF ( k == 1 )  READ ( 13 )  tmp_3d
-           pr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                      &
-              tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-         CASE ( 'ql_c_av' )
-            IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
-               ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-            ENDIF
-            IF ( k == 1 )  READ ( 13 )  tmp_3d
-            ql_c_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                   &
-               tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-         CASE ( 'ql_v_av' )
-            IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
-               ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-            ENDIF
-            IF ( k == 1 )  READ ( 13 )  tmp_3d
-            ql_v_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                   &
-               tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-         CASE ( 'ql_vp_av' )
-            IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
-               ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-            ENDIF
-            IF ( k == 1 )  READ ( 13 )  tmp_3d
-            ql_vp_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
-               tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-         CASE ( 'seq_random_array_particles' )
-            ALLOCATE( tmp_2d_seq_random_particles(5,nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) )
-            IF ( .NOT. ALLOCATED( seq_random_array_particles ) )  THEN
-               ALLOCATE( seq_random_array_particles(5,nys:nyn,nxl:nxr) )
-            ENDIF
-            IF ( k == 1 )  READ ( 13 )  tmp_2d_seq_random_particles
-            seq_random_array_particles(:,nysc:nync,nxlc:nxrc) =                                    &
-                                                 tmp_2d_seq_random_particles(:,nysf:nynf,nxlf:nxrf)
-            DEALLOCATE( tmp_2d_seq_random_particles )
-
-          CASE DEFAULT
-
-             found = .FALSE.
-
-       END SELECT
-
- END SUBROUTINE lpm_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_rrd_local_mpi
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=32) ::  tmp_name  !< temporary variable
-
-    INTEGER(iwp) ::  i  !< loop index
-
-    LOGICAL ::  array_found  !<
-
-    CALL rd_mpi_io_check_array( 'pc_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( pc_av ) )  ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'pc_av', pc_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'pr_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( pr_av ) )  ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'pr_av', pr_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'ql_c_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( ql_c_av ) )  ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'ql_c_av', ql_c_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'ql_v_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( ql_v_av ) )  ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'ql_v_av', ql_v_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'ql_vp_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( ql_vp_av ) )  ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'ql_vp_av', ql_vp_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'seq_random_array_particles01' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( seq_random_array_particles ) )  THEN
-          ALLOCATE( seq_random_array_particles(5,nys:nyn,nxl:nxr) )
-       ENDIF
-       DO  i = 1, SIZE( seq_random_array_particles, 1 )
-          WRITE( tmp_name, '(A,I2.2)' )  'seq_random_array_particles', i
-          CALL rrd_mpi_io( TRIM(tmp_name), seq_random_array_particles(i,:,:) )
-       ENDDO
-    ENDIF
-
- END SUBROUTINE lpm_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data for the lpm.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_wrd_local
-
-    CHARACTER (LEN=10) ::  particle_binary_version   !<
-    CHARACTER (LEN=32) ::  tmp_name                  !< temporary variable
-
-    INTEGER(iwp) ::  i                               !< loop index
-    INTEGER(iwp) ::  ip                              !<
-    INTEGER(iwp) ::  j                               !< loop index
-    INTEGER(iwp) ::  jp                              !<
-    INTEGER(iwp) ::  k                               !< loop index
-    INTEGER(iwp) ::  kp                              !<
-
-#if defined( __parallel )
-    INTEGER      :: ierr                             !<
-#endif
-    INTEGER(iwp) ::  start_index                     !<
-    INTEGER(iwp) ::  start_index_on_pe               !<
-
-    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  nr_particles_global
-    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  nr_particles_local
-
-    INTEGER(idp), ALLOCATABLE, DIMENSION(:,:,:) ::  prt_global_index
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-!
-!--    First open the output unit.
-       IF ( myid_char == '' )  THEN
-          OPEN ( 90, FILE='PARTICLE_RESTART_DATA_OUT'//myid_char, FORM='UNFORMATTED')
-       ELSE
-          IF ( myid == 0 )  CALL local_system( 'mkdir PARTICLE_RESTART_DATA_OUT' )
-#if defined( __parallel )
-!
-!--       Set a barrier in order to allow that thereafter all other processors in the directory
-!--       created by PE0 can open their file
-          CALL MPI_BARRIER( comm2d, ierr )
-#endif
-          OPEN ( 90, FILE='PARTICLE_RESTART_DATA_OUT/'//myid_char, FORM='UNFORMATTED' )
-       ENDIF
-
-!
-!--    Write the version number of the binary format.
-!--    Attention: After changes to the following output commands the version number of the variable
-!--    ---------  particle_binary_version must be changed! Also, the version number and the list of
-!--               arrays to be read in lpm_read_restart_file must be adjusted accordingly.
-       particle_binary_version = '4.0'
-       WRITE ( 90 )  particle_binary_version
-
-!
-!--    Write some particle parameters, the size of the particle arrays
-       WRITE ( 90 )  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, last_particle_release_time,         &
-                     number_of_particle_groups, particle_groups, time_write_particle_data
-
-       WRITE ( 90 )  prt_count
-
-       DO  ip = nxl, nxr
-          DO  jp = nys, nyn
-             DO  kp = nzb+1, nzt
-                number_of_particles = prt_count(kp,jp,ip)
-                particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-                IF ( number_of_particles <= 0 )  CYCLE
-                WRITE ( 90 )  particles
-             ENDDO
-          ENDDO
-       ENDDO
-
-       CLOSE ( 90 )
-
-#if defined( __parallel )
-       CALL MPI_BARRIER( comm2d, ierr )
-#endif
-
-       IF ( ALLOCATED( id_counter ) )  THEN
-          CALL wrd_write_string( 'id_counter' )
-          WRITE ( 14 )  id_counter
-       ENDIF
-
-       IF ( ALLOCATED( seq_random_array_particles ) )  THEN
-          CALL wrd_write_string( 'seq_random_array_particles' )
-          WRITE ( 14 )  seq_random_array_particles
-       ENDIF
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       IF ( ALLOCATED( seq_random_array_particles ) )  THEN
-          DO  i = 1, SIZE( seq_random_array_particles, 1 )
-             WRITE( tmp_name, '(A,I2.2)' )  'seq_random_array_particles', i
-             CALL wrd_mpi_io( TRIM( tmp_name ), seq_random_array_particles(i,:,:) )
-          ENDDO
-       ENDIF
-
-       ALLOCATE( prt_global_index(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-#if defined( __parallel )
-!--    TODO: needs to be replaced by standard PALM message
-       IF ( TRIM( restart_data_format_output ) == 'mpi_shared_memory' )   THEN
-          WRITE( 9, * )  'mpi_shared_memory is NOT implemented yet for particle IO'
-          FLUSH( 9 )
-          CALL MPI_ABORT( MPI_COMM_WORLD, 1, ierr )
-       ENDIF
-#endif
-
-       CALL rd_mpi_io_particle_filetypes
-
-       nr_particles_local = 0
-       nr_particles_local(myid) = SUM( prt_count )
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( nr_particles_local, nr_particles_global, numprocs, MPI_INTEGER, MPI_SUM,&
-                           comm2d, ierr )
-#else
-       nr_particles_global = nr_particles_local
-#endif
-
-       start_index_on_pe = 0
-       IF ( myid > 0 )  THEN
-          DO  i = 1, myid
-             start_index_on_pe = start_index_on_pe + nr_particles_global(i-1)
-          ENDDO
-       ENDIF
-
-       CALL wrd_mpi_io( 'id_counter', id_counter )
-       CALL wrd_mpi_io( 'prt_count',  prt_count )
-
-       start_index = start_index_on_pe
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-                prt_global_index(k,j,i) = start_index
-                start_index             = start_index + prt_count(k,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
-
-       CALL wrd_mpi_io( 'prt_global_index', prt_global_index )
-       CALL wrd_mpi_io_particles( 'particles', prt_global_index )
-
-       DEALLOCATE( prt_global_index )
-
-    ENDIF
-
- END SUBROUTINE lpm_wrd_local
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data for the lpm.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_wrd_global
-
-#if defined( __parallel )
-    INTEGER :: ierr  !<
-#endif
-
-    REAL(wp), DIMENSION(4,max_number_of_particle_groups) ::  particle_groups_array  !<
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL wrd_write_string( 'curvature_solution_effects' )
-       WRITE ( 14 )  curvature_solution_effects
-
-       CALL wrd_write_string( 'dop_last_active_particle' )
-       WRITE ( 14 )  dop_last_active_particle
-
-       CALL wrd_write_string( 'dop_prt_axis_dimension' )
-       WRITE ( 14 )  dop_prt_axis_dimension
-
-       CALL wrd_write_string( 'interpolation_simple_corrector' )
-       WRITE ( 14 )  interpolation_simple_corrector
-
-       CALL wrd_write_string( 'interpolation_simple_predictor' )
-       WRITE ( 14 )  interpolation_simple_predictor
-
-       CALL wrd_write_string( 'interpolation_trilinear' )
-       WRITE ( 14 )  interpolation_trilinear
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       CALL wrd_mpi_io( 'curvature_solution_effects', curvature_solution_effects )
-       CALL wrd_mpi_io( 'interpolation_simple_corrector', interpolation_simple_corrector )
-       CALL wrd_mpi_io( 'interpolation_simple_predictor', interpolation_simple_predictor )
-       CALL wrd_mpi_io( 'interpolation_trilinear', interpolation_trilinear )
-!
-!--    Write some global particle parameters
-!--    In case of Fortran binary format, these variables are written to unit 90
-       CALL wrd_mpi_io( 'bc_par_b', bc_par_b )
-       CALL wrd_mpi_io( 'bc_par_lr', bc_par_lr )
-       CALL wrd_mpi_io( 'bc_par_ns', bc_par_ns )
-       CALL wrd_mpi_io( 'bc_par_t', bc_par_t )
-       CALL wrd_mpi_io( 'dop_last_active_particle', dop_last_active_particle )
-       CALL wrd_mpi_io( 'dop_prt_axis_dimension', dop_prt_axis_dimension )
-       CALL wrd_mpi_io( 'last_particle_release_time', last_particle_release_time )
-       CALL wrd_mpi_io( 'number_of_particle_groups', number_of_particle_groups )
-       CALL wrd_mpi_io( 'time_write_particle_data', time_write_particle_data )
-
-!
-!--    Write particle_group informations via 2D array to avoid another overlay in
-!--    restart_data_mpi_io_mod.
-!--    TODO: convert the following to a standard PALM message
-       IF( STORAGE_SIZE( particle_groups(1) ) / (wp*8) /= 4 )  THEN
-          WRITE( 9, * )  'size of structure particle_groups_type has changed '
-          FLUSH( 9 )
-#if defined( __parallel )
-          CALL MPI_ABORT( MPI_COMM_WORLD, 1, ierr )
-#else
-          STOP 'error'
-#endif
-       ENDIF
-
-       particle_groups_array(1,:) = particle_groups(:)%density_ratio
-       particle_groups_array(2,:) = particle_groups(:)%radius
-       particle_groups_array(3,:) = particle_groups(:)%exp_arg
-       particle_groups_array(4,:) = particle_groups(:)%exp_term
-
-       CALL wrd_mpi_io_global_array( 'particle_groups', particle_groups_array )
-
-    ENDIF
-
- END SUBROUTINE lpm_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_rrd_global_ftn( found )
-
-    USE control_parameters,                                                                        &
-        ONLY: length, restart_string
-
-    LOGICAL, INTENT(OUT)  ::  found
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'curvature_solution_effects' )
-          READ ( 13 )  curvature_solution_effects
-
-       CASE ( 'dop_last_active_particle' )
-          READ ( 13 )  dop_last_active_particle
-
-       CASE ( 'dop_prt_axis_dimension' )
-          READ ( 13 )  dop_prt_axis_dimension
-
-       CASE ( 'interpolation_simple_corrector' )
-          READ ( 13 )  interpolation_simple_corrector
-
-       CASE ( 'interpolation_simple_predictor' )
-          READ ( 13 )  interpolation_simple_predictor
-
-       CASE ( 'interpolation_trilinear' )
-          READ ( 13 )  interpolation_trilinear
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE lpm_rrd_global_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_rrd_global_mpi
-
-#if defined( __parallel )
-    INTEGER    :: ierr    !<
-#endif
-
-    REAL(wp), DIMENSION(4,max_number_of_particle_groups) ::  particle_groups_array  !<
-
-
-    CALL rrd_mpi_io( 'curvature_solution_effects', curvature_solution_effects )
-    CALL rrd_mpi_io( 'interpolation_simple_corrector', interpolation_simple_corrector )
-    CALL rrd_mpi_io( 'interpolation_simple_predictor', interpolation_simple_predictor )
-    CALL rrd_mpi_io( 'interpolation_trilinear', interpolation_trilinear )
-!
-!-- Read some particle parameters.
-!-- In case of Fortran binary format, these variables are read from unit 90.
-    CALL rrd_mpi_io( 'bc_par_b', bc_par_b )
-    CALL rrd_mpi_io( 'bc_par_lr', bc_par_lr )
-    CALL rrd_mpi_io( 'bc_par_ns', bc_par_ns )
-    CALL rrd_mpi_io( 'bc_par_t', bc_par_t )
-    CALL rrd_mpi_io( 'dop_prt_axis_dimension', dop_prt_axis_dimension )
-    CALL rrd_mpi_io( 'dop_last_active_particle', dop_last_active_particle )
-    CALL rrd_mpi_io( 'last_particle_release_time', last_particle_release_time )
-    CALL rrd_mpi_io( 'number_of_particle_groups', number_of_particle_groups )
-    CALL rrd_mpi_io( 'time_write_particle_data', time_write_particle_data )
-
-!
-!-- Read particle group information via 2d-array to avoid another overlay in
-!-- restart_data_mpi_io_mod.
-!-- TODO: convert the following to a standard PALM message
-    IF ( STORAGE_SIZE( particle_groups(1) ) / (wp*8) /= 4 )  THEN
-       WRITE( 9, * )  'size of structure particle_groups_type has changed '
-       FLUSH( 9 )
-#if defined( __parallel )
-       CALL MPI_ABORT( MPI_COMM_WORLD, 1, ierr )
-#else
-       STOP 'error'
-#endif
-    ENDIF
-
-    CALL rrd_mpi_io_global_array( 'particle_groups', particle_groups_array )
-
-    particle_groups(:)%density_ratio = particle_groups_array(1,:)
-    particle_groups(:)%radius        = particle_groups_array(2,:)
-    particle_groups(:)%exp_arg       = particle_groups_array(3,:)
-    particle_groups(:)%exp_term      = particle_groups_array(4,:)
-
- END SUBROUTINE lpm_rrd_global_mpi
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Last actions before PALM finishes.
-!------------------------------------------------------------------------------!
- SUBROUTINE lpm_last_actions
-
-!
-!-- Close NETCDF file for individual particle timeseries
-    IF ( dop_active )  THEN
-       CALL dop_finalize
-    ENDIF
-
- END SUBROUTINE lpm_last_actions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This is a submodule of the lagrangian particle model. It contains all dynamic processes of the
-!> lpm. This includes the advection (resolved and sub-grid scale) as well as the boundary conditions
-!> of particles. As a next step this submodule should be excluded as an own file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_advec (ip,jp,kp)
-
-    REAL(wp), PARAMETER ::  a_rog = 9.65_wp      !< parameter for fall velocity
-    REAL(wp), PARAMETER ::  b_rog = 10.43_wp     !< parameter for fall velocity
-    REAL(wp), PARAMETER ::  c_rog = 0.6_wp       !< parameter for fall velocity
-    REAL(wp), PARAMETER ::  k_cap_rog = 4.0_wp   !< parameter for fall velocity
-    REAL(wp), PARAMETER ::  k_low_rog = 12.0_wp  !< parameter for fall velocity
-    REAL(wp), PARAMETER ::  d0_rog = 0.745_wp    !< separation diameter
-
-    INTEGER(iwp) ::  i                           !< index variable along x
-    INTEGER(iwp) ::  i_next                      !< index variable along x
-    INTEGER(iwp) ::  ip                          !< index variable along x
-    INTEGER(iwp) ::  iteration_steps = 1         !< amount of iterations steps for corrector step
-    INTEGER(iwp) ::  j                           !< index variable along y
-    INTEGER(iwp) ::  j_next                      !< index variable along y
-    INTEGER(iwp) ::  jp                          !< index variable along y
-    INTEGER(iwp) ::  k                           !< index variable along z
-    INTEGER(iwp) ::  k_wall                      !< vertical index of topography top
-    INTEGER(iwp) ::  kp                          !< index variable along z
-    INTEGER(iwp) ::  k_next                      !< index variable along z
-    INTEGER(iwp) ::  kw                          !< index variable along z
-    INTEGER(iwp) ::  kkw                         !< index variable along z
-    INTEGER(iwp) ::  n                           !< loop variable over all particles in a grid box
-    INTEGER(iwp) ::  nn                          !< loop variable over iterations steps
-    INTEGER(iwp) ::  nb                          !< block number particles are sorted in
-    INTEGER(iwp) ::  particle_end                !< end index for partilce loop
-    INTEGER(iwp) ::  particle_start              !< start index for particle loop
-    INTEGER(iwp) ::  subbox_end                  !< end index for loop over subboxes in particle advection
-    INTEGER(iwp) ::  subbox_start                !< start index for loop over subboxes in particle advection
-
-    INTEGER(iwp), DIMENSION(0:7) ::  end_index   !< start particle index for current block
-    INTEGER(iwp), DIMENSION(0:7) ::  start_index !< start particle index for current block
-
-    LOGICAL ::  subbox_at_wall !< flag to see if the current subgridbox is adjacent to a wall
-
-    REAL(wp) ::  aa                 !< dummy argument for horizontal particle interpolation
-    REAL(wp) ::  alpha              !< interpolation facor for x-direction
-    REAL(wp) ::  bb                 !< dummy argument for horizontal particle interpolation
-    REAL(wp) ::  beta               !< interpolation facor for y-direction
-    REAL(wp) ::  cc                 !< dummy argument for horizontal particle interpolation
-    REAL(wp) ::  d_z_p_z0           !< inverse of interpolation length for logarithmic interpolation
-    REAL(wp) ::  dd                 !< dummy argument for horizontal particle interpolation
-    REAL(wp) ::  de_dx_int_l        !< x/y-interpolated TKE gradient (x) at particle position at lower vertical level
-    REAL(wp) ::  de_dx_int_u        !< x/y-interpolated TKE gradient (x) at particle position at upper vertical level
-    REAL(wp) ::  de_dy_int_l        !< x/y-interpolated TKE gradient (y) at particle position at lower vertical level
-    REAL(wp) ::  de_dy_int_u        !< x/y-interpolated TKE gradient (y) at particle position at upper vertical level
-    REAL(wp) ::  de_dt              !< temporal derivative of TKE experienced by the particle
-    REAL(wp) ::  de_dt_min          !< lower level for temporal TKE derivative
-    REAL(wp) ::  de_dz_int_l        !< x/y-interpolated TKE gradient (z) at particle position at lower vertical level
-    REAL(wp) ::  de_dz_int_u        !< x/y-interpolated TKE gradient (z) at particle position at upper vertical level
-    REAL(wp) ::  diameter           !< diamter of droplet
-    REAL(wp) ::  diss_int_l         !< x/y-interpolated dissipation at particle position at lower vertical level
-    REAL(wp) ::  diss_int_u         !< x/y-interpolated dissipation at particle position at upper vertical level
-    REAL(wp) ::  dt_particle_m      !< previous particle time step
-    REAL(wp) ::  dz_temp            !< dummy for the vertical grid spacing
-    REAL(wp) ::  e_int_l            !< x/y-interpolated TKE at particle position at lower vertical level
-    REAL(wp) ::  e_int_u            !< x/y-interpolated TKE at particle position at upper vertical level
-    REAL(wp) ::  e_mean_int         !< horizontal mean TKE at particle height
-    REAL(wp) ::  exp_arg            !< argument in the exponent - particle radius
-    REAL(wp) ::  exp_term           !< exponent term
-    REAL(wp) ::  gamma              !< interpolation facor for z-direction
-    REAL(wp) ::  gg                 !< dummy argument for horizontal particle interpolation
-    REAL(wp) ::  height_p           !< dummy argument for logarithmic interpolation
-    REAL(wp) ::  log_z_z0_int       !< logarithmus used for surface_layer interpolation
-    REAL(wp) ::  rl                 !< Lagrangian autocorrelation coefficient
-    REAL(wp) ::  rg1                !< Gaussian distributed random number
-    REAL(wp) ::  rg2                !< Gaussian distributed random number
-    REAL(wp) ::  rg3                !< Gaussian distributed random number
-    REAL(wp) ::  sigma              !< velocity standard deviation
-    REAL(wp) ::  u_int_l            !< x/y-interpolated u-component at particle position at lower vertical level
-    REAL(wp) ::  u_int_u            !< x/y-interpolated u-component at particle position at upper vertical level
-    REAL(wp) ::  unext              !< calculated particle u-velocity of corrector step
-    REAL(wp) ::  us_int             !< friction velocity at particle grid box
-    REAL(wp) ::  v_int_l            !< x/y-interpolated v-component at particle position at lower vertical level
-    REAL(wp) ::  v_int_u            !< x/y-interpolated v-component at particle position at upper vertical level
-    REAL(wp) ::  vnext              !< calculated particle v-velocity of corrector step
-    REAL(wp) ::  vv_int             !< dummy to compute interpolated mean SGS TKE, used to scale SGS advection
-    REAL(wp) ::  w_int_l            !< x/y-interpolated w-component at particle position at lower vertical level
-    REAL(wp) ::  w_int_u            !< x/y-interpolated w-component at particle position at upper vertical level
-    REAL(wp) ::  wnext              !< calculated particle w-velocity of corrector step
-    REAL(wp) ::  w_s                !< terminal velocity of droplets
-    REAL(wp) ::  x                  !< dummy argument for horizontal particle interpolation
-    REAL(wp) ::  xp                 !< calculated particle position in x of predictor step
-    REAL(wp) ::  y                  !< dummy argument for horizontal particle interpolation
-    REAL(wp) ::  yp                 !< calculated particle position in y of predictor step
-    REAL(wp) ::  z_p                !< surface layer height (0.5 dz)
-    REAL(wp) ::  zp                 !< calculated particle position in z of predictor step
-
-    REAL(wp), DIMENSION(number_of_particles) ::  de_dx_int      !< horizontal TKE gradient along x at particle position
-    REAL(wp), DIMENSION(number_of_particles) ::  de_dy_int      !< horizontal TKE gradient along y at particle position
-    REAL(wp), DIMENSION(number_of_particles) ::  de_dz_int      !< horizontal TKE gradient along z at particle position
-    REAL(wp), DIMENSION(number_of_particles) ::  dens_ratio     !< ratio between the density of the fluid and the density of the
-                                                                !< particles
-    REAL(wp), DIMENSION(number_of_particles) ::  diss_int       !< dissipation at particle position
-    REAL(wp), DIMENSION(number_of_particles) ::  dt_gap         !< remaining time until particle time integration reaches LES time
-    REAL(wp), DIMENSION(number_of_particles) ::  dt_particle    !< particle time step
-    REAL(wp), DIMENSION(number_of_particles) ::  e_int          !< TKE at particle position
-    REAL(wp), DIMENSION(number_of_particles) ::  fs_int         !< weighting factor for subgrid-scale particle speed
-    REAL(wp), DIMENSION(number_of_particles) ::  lagr_timescale !< Lagrangian timescale
-    REAL(wp), DIMENSION(number_of_particles) ::  rvar1_temp     !< SGS particle velocity - u-component
-    REAL(wp), DIMENSION(number_of_particles) ::  rvar2_temp     !< SGS particle velocity - v-component
-    REAL(wp), DIMENSION(number_of_particles) ::  rvar3_temp     !< SGS particle velocity - w-component
-    REAL(wp), DIMENSION(number_of_particles) ::  term_1_2       !< flag to communicate whether a particle is near topography or not
-    REAL(wp), DIMENSION(number_of_particles) ::  u_int          !< u-component of particle speed
-    REAL(wp), DIMENSION(number_of_particles) ::  v_int          !< v-component of particle speed
-    REAL(wp), DIMENSION(number_of_particles) ::  w_int          !< w-component of particle speed
-    REAL(wp), DIMENSION(number_of_particles) ::  xv             !< x-position
-    REAL(wp), DIMENSION(number_of_particles) ::  yv             !< y-position
-    REAL(wp), DIMENSION(number_of_particles) ::  zv             !< z-position
-
-    REAL(wp), DIMENSION(number_of_particles, 3) ::  rg          !< vector of Gaussian distributed random numbers
-
-    CALL cpu_log( log_point_s(44), 'lpm_advec', 'continue' )
-!
-!-- Determine height of Prandtl layer and distance between Prandtl-layer height and horizontal mean
-!-- roughness height, which are required for vertical logarithmic interpolation of horizontal
-!-- particle speeds (for particles below first vertical grid level).
-    z_p      = zu(nzb+1) - zw(nzb)
-    d_z_p_z0 = 1.0_wp / ( z_p - z0_av_global )
-
-    xv = particles(1:number_of_particles)%x
-    yv = particles(1:number_of_particles)%y
-    zv = particles(1:number_of_particles)%z
-    dt_particle = dt_3d
-
-!
-!-- This case uses a simple interpolation method for the particle velocites, and applying a
-!-- predictor-corrector method. @note the current time divergence free time step is denoted with
-!-- u_t etc.; the velocities of the time level of t+1 wit u,v, and w, as the model is called after
-!-- swap timelevel
-!-- @attention: for the corrector step the velocities of t(n+1) are required.
-!-- Therefore the particle code is executed at the end of the time intermediate timestep routine.
-!-- This interpolation method is described in more detail in Grabowski et al., 2018 (GMD).
-    IF ( interpolation_simple_corrector )  THEN
-!
-!--    Predictor step
-       kkw = kp - 1
-       DO  n = 1, number_of_particles
-
-          alpha = MAX( MIN( ( particles(n)%x - ip * dx ) * ddx, 1.0_wp ), 0.0_wp )
-          u_int(n) = u_t(kp,jp,ip) * ( 1.0_wp - alpha ) + u_t(kp,jp,ip+1) * alpha
-
-          beta  = MAX( MIN( ( particles(n)%y - jp * dy ) * ddy, 1.0_wp ), 0.0_wp )
-          v_int(n) = v_t(kp,jp,ip) * ( 1.0_wp - beta ) + v_t(kp,jp+1,ip) * beta
-
-          gamma = MAX( MIN( ( particles(n)%z - zw(kkw) ) / ( zw(kkw+1) - zw(kkw) ), 1.0_wp ),      &
-                       0.0_wp )
-          w_int(n) = w_t(kkw,jp,ip) * ( 1.0_wp - gamma ) + w_t(kkw+1,jp,ip) * gamma
-
-       ENDDO
-!
-!--    Corrector step
-       DO  n = 1, number_of_particles
-
-          IF ( .NOT. particles(n)%particle_mask )  CYCLE
-
-          DO  nn = 1, iteration_steps
-
-!
-!--          Guess new position
-             xp = particles(n)%x + u_int(n) * dt_particle(n)
-             yp = particles(n)%y + v_int(n) * dt_particle(n)
-             zp = particles(n)%z + w_int(n) * dt_particle(n)
-!
-!--          x direction
-             i_next = FLOOR( xp * ddx , KIND=iwp)
-             alpha  = MAX( MIN( ( xp - i_next * dx ) * ddx, 1.0_wp ), 0.0_wp )
-!
-!--          y direction
-             j_next = FLOOR( yp * ddy )
-             beta   = MAX( MIN( ( yp - j_next * dy ) * ddy, 1.0_wp ), 0.0_wp )
-!
-!--          z_direction
-             k_next = MAX( MIN( FLOOR( zp / (zw(kkw+1)-zw(kkw)) + offset_ocean_nzt ), nzt ), 0)
-             gamma = MAX( MIN( ( zp - zw(k_next) ) /                                               &
-                               ( zw(k_next+1) - zw(k_next) ), 1.0_wp ), 0.0_wp )
-!
-!--          Calculate part of the corrector step
-             unext = u(k_next+1, j_next, i_next) * ( 1.0_wp - alpha ) +                            &
-                     u(k_next+1, j_next,   i_next+1) * alpha
-
-             vnext = v(k_next+1, j_next, i_next) * ( 1.0_wp - beta  ) +                            &
-                     v(k_next+1, j_next+1, i_next  ) * beta
-
-             wnext = w(k_next,   j_next, i_next) * ( 1.0_wp - gamma ) +                            &
-                     w(k_next+1, j_next, i_next  ) * gamma
-
-!
-!--          Calculate interpolated particle velocity with predictor corrector step. u_int, v_int
-!--          and w_int describes the part of the predictor step. unext, vnext and wnext is the part
-!--          of the corrector step. The resulting new position is set below. The implementation is
-!--          based on Grabowski et al., 2018 (GMD).
-             u_int(n) = 0.5_wp * ( u_int(n) + unext )
-             v_int(n) = 0.5_wp * ( v_int(n) + vnext )
-             w_int(n) = 0.5_wp * ( w_int(n) + wnext )
-
-          ENDDO
-       ENDDO
-!
-!-- This case uses a simple interpolation method for the particle velocites, and applying a
-!-- predictor.
-    ELSEIF ( interpolation_simple_predictor )  THEN
-!
-!--    The particle position for the w velociy is based on the value of kp and kp-1
-       kkw = kp - 1
-       DO  n = 1, number_of_particles
-          IF ( .NOT. particles(n)%particle_mask )  CYCLE
-
-          alpha    = MAX( MIN( ( particles(n)%x - ip * dx ) * ddx, 1.0_wp ), 0.0_wp )
-          u_int(n) = u(kp,jp,ip) * ( 1.0_wp - alpha ) + u(kp,jp,ip+1) * alpha
-
-          beta     = MAX( MIN( ( particles(n)%y - jp * dy ) * ddy, 1.0_wp ), 0.0_wp )
-          v_int(n) = v(kp,jp,ip) * ( 1.0_wp - beta ) + v(kp,jp+1,ip) * beta
-
-          gamma    = MAX( MIN( ( particles(n)%z - zw(kkw) ) / ( zw(kkw+1) - zw(kkw) ), 1.0_wp ),   &
-                          0.0_wp )
-          w_int(n) = w(kkw,jp,ip) * ( 1.0_wp - gamma ) + w(kkw+1,jp,ip) * gamma
-       ENDDO
-!
-!-- The trilinear interpolation.
-    ELSEIF ( interpolation_trilinear )  THEN
-
-       start_index = grid_particles(kp,jp,ip)%start_index
-       end_index   = grid_particles(kp,jp,ip)%end_index
-
-       DO  nb = 0, 7
-!
-!--       Interpolate u velocity-component
-          i = ip
-          j = jp + block_offset(nb)%j_off
-          k = kp + block_offset(nb)%k_off
-
-          DO  n = start_index(nb), end_index(nb)
-!
-!--          Interpolation of the u velocity component onto particle position.
-!--          Particles are interpolation bi-linearly in the horizontal and a linearly in the
-!--          vertical. An exception is made for particles below the first vertical grid level in
-!--          case of a prandtl layer. In this case the horizontal particle velocity components are
-!--          determined using Monin-Obukhov relations (if branch).
-!--          First, check if particle is located below first vertical grid level above topography
-!--          (Prandtl-layer height).
-!--          Determine vertical index of topography top
-             k_wall = topo_top_ind(jp,ip,0)
-
-             IF ( constant_flux_layer  .AND.  zv(n) - zw(k_wall) < z_p )  THEN
-!
-!--             Resolved-scale horizontal particle velocity is zero below z0.
-                IF ( zv(n) - zw(k_wall) < z0_av_global )  THEN
-                   u_int(n) = 0.0_wp
-                ELSE
-!
-!--                Determine the sublayer. Further used as index.
-                   height_p = ( zv(n) - zw(k_wall) - z0_av_global )                                &
-                                        * REAL( number_of_sublayers, KIND=wp )                     &
-                                        * d_z_p_z0
-!
-!--                Calculate LOG(z/z0) for exact particle height. Therefore,
-!--                interpolate linearly between precalculated logarithm.
-                   log_z_z0_int = log_z_z0( INT( height_p ) ) + ( height_p - INT( height_p ) ) *   &
-                                  ( log_z_z0( INT( height_p ) + 1 ) - log_z_z0( INT( height_p ) ) )
-!
-!--                Compute u*-portion for u-component based on mean roughness.
-!--                Note, neutral solution is applied for all situations, e.g. also for unstable and
-!--                stable situations. Even though this is not exact this saves a lot of CPU time
-!--                since several calls of intrinsic FORTRAN procedures (LOG, ATAN) are avoided. This
-!--                is justified as sensitivity studies revealed no significant effect of using the
-!--                neutral solution also for un/stable situations. Based on the u* recalculate the
-!--                velocity at height z_particle. Since the analytical solution only yields absolute
-!--                values, include the sign using the intrinsic SIGN function.
-                   us_int   = kappa * 0.5_wp * ABS( u(k_wall+1,jp,ip) + u(k_wall+1,jp,ip+1) ) /    &
-                              log_z_z0(number_of_sublayers)
-                   u_int(n) = SIGN( 1.0_wp, u(k_wall+1,jp,ip) + u(k_wall+1,jp,ip+1) ) *            &
-                              log_z_z0_int * us_int / kappa - u_gtrans
-
-                ENDIF
-!
-!--          Particle above the first grid level. Bi-linear interpolation in the horizontal and
-!--          linear interpolation in the vertical direction.
-             ELSE
-                x  = xv(n) - i * dx
-                y  = yv(n) + ( 0.5_wp - j ) * dy
-                aa = x**2          + y**2
-                bb = ( dx - x )**2 + y**2
-                cc = x**2          + ( dy - y )**2
-                dd = ( dx - x )**2 + ( dy - y )**2
-                gg = aa + bb + cc + dd
-
-                u_int_l = ( ( gg - aa ) * u(k,j,i)   + ( gg - bb ) * u(k,j,i+1)                    &
-                            + ( gg - cc ) * u(k,j+1,i) + ( gg - dd ) * u(k,j+1,i+1) )              &
-                          / ( 3.0_wp * gg ) - u_gtrans
-
-                IF ( k == nzt )  THEN
-                   u_int(n) = u_int_l
-                ELSE
-                   u_int_u = ( ( gg-aa ) * u(k+1,j,i) + ( gg-bb ) * u(k+1,j,i+1)                   &
-                               + ( gg-cc ) * u(k+1,j+1,i) + ( gg-dd ) * u(k+1,j+1,i+1) )           &
-                             / ( 3.0_wp * gg ) - u_gtrans
-                   u_int(n) = u_int_l + ( zv(n) - zu(k) ) / dzw(k+1) * ( u_int_u - u_int_l )
-                ENDIF
-             ENDIF
-          ENDDO
-!
-!--       Same procedure for interpolation of the v velocity-component
-          i = ip + block_offset(nb)%i_off
-          j = jp
-          k = kp + block_offset(nb)%k_off
-
-          DO  n = start_index(nb), end_index(nb)
-!
-!--          Determine vertical index of topography top
-             k_wall = topo_top_ind(jp,ip,0)
-
-             IF ( constant_flux_layer  .AND.  zv(n) - zw(k_wall) < z_p )  THEN
-                IF ( zv(n) - zw(k_wall) < z0_av_global )  THEN
-!
-!--                Resolved-scale horizontal particle velocity is zero below z0.
-                   v_int(n) = 0.0_wp
-                ELSE
-!
-!--                Determine the sublayer. Further used as index.
-                   height_p = ( zv(n) - zw(k_wall) - z0_av_global )                                &
-                                        * REAL( number_of_sublayers, KIND=wp )                     &
-                                        * d_z_p_z0
-!
-!--                Calculate LOG(z/z0) for exact particle height. Therefore, interpolate linearly
-!--                between precalculated logarithm.
-                   log_z_z0_int = log_z_z0(INT(height_p))                                          &
-                                    + ( height_p - INT(height_p) )                                 &
-                                    * ( log_z_z0(INT(height_p)+1) - log_z_z0(INT(height_p))        &
-                                      )
-!
-!--                Compute u*-portion for v-component based on mean roughness.
-!--                Note, neutral solution is applied for all situations, e.g. also for unstable and
-!--                stable situations. Even though this is not exact this saves a lot of CPU time
-!--                since several calls of intrinsic FORTRAN procedures (LOG, ATAN) are avoided, This
-!--                is justified as sensitivity studies revealed no significant effect of using the
-!--                neutral solution also for un/stable situations. Based on the u* recalculate the
-!--                velocity at height z_particle. Since the analytical solution only yields absolute
-!--                values, include the sign using the intrinsic SIGN function.
-                   us_int   = kappa * 0.5_wp * ABS( v(k_wall+1,jp,ip) + v(k_wall+1,jp+1,ip) ) /    &
-                              log_z_z0(number_of_sublayers)
-                   v_int(n) = SIGN( 1.0_wp, v(k_wall+1,jp,ip) + v(k_wall+1,jp+1,ip) ) *            &
-                              log_z_z0_int * us_int / kappa - v_gtrans
-
-                ENDIF
-             ELSE
-                x  = xv(n) + ( 0.5_wp - i ) * dx
-                y  = yv(n) - j * dy
-                aa = x**2          + y**2
-                bb = ( dx - x )**2 + y**2
-                cc = x**2          + ( dy - y )**2
-                dd = ( dx - x )**2 + ( dy - y )**2
-                gg = aa + bb + cc + dd
-
-                v_int_l = ( ( gg - aa ) * v(k,j,i)   + ( gg - bb ) * v(k,j,i+1)                    &
-                          + ( gg - cc ) * v(k,j+1,i) + ( gg - dd ) * v(k,j+1,i+1)                  &
-                          ) / ( 3.0_wp * gg ) - v_gtrans
-
-                IF ( k == nzt )  THEN
-                   v_int(n) = v_int_l
-                ELSE
-                   v_int_u = ( ( gg-aa ) * v(k+1,j,i)   + ( gg-bb ) * v(k+1,j,i+1)                 &
-                             + ( gg-cc ) * v(k+1,j+1,i) + ( gg-dd ) * v(k+1,j+1,i+1)               &
-                             ) / ( 3.0_wp * gg ) - v_gtrans
-                   v_int(n) = v_int_l + ( zv(n) - zu(k) ) / dzw(k+1) * ( v_int_u - v_int_l )
-                ENDIF
-             ENDIF
-          ENDDO
-!
-!--       Same procedure for interpolation of the w velocity-component
-          i = ip + block_offset(nb)%i_off
-          j = jp + block_offset(nb)%j_off
-          k = kp - 1
-
-          DO  n = start_index(nb), end_index(nb)
-             IF ( vertical_particle_advection(particles(n)%group) )  THEN
-                x  = xv(n) + ( 0.5_wp - i ) * dx
-                y  = yv(n) + ( 0.5_wp - j ) * dy
-                aa = x**2          + y**2
-                bb = ( dx - x )**2 + y**2
-                cc = x**2          + ( dy - y )**2
-                dd = ( dx - x )**2 + ( dy - y )**2
-                gg = aa + bb + cc + dd
-
-                w_int_l = ( ( gg - aa ) * w(k,j,i)   + ( gg - bb ) * w(k,j,i+1)                    &
-                          + ( gg - cc ) * w(k,j+1,i) + ( gg - dd ) * w(k,j+1,i+1)                  &
-                          ) / ( 3.0_wp * gg )
-
-                IF ( k == nzt )  THEN
-                   w_int(n) = w_int_l
-                ELSE
-                   w_int_u = ( ( gg-aa ) * w(k+1,j,i)   +                                          &
-                               ( gg-bb ) * w(k+1,j,i+1) +                                          &
-                               ( gg-cc ) * w(k+1,j+1,i) +                                          &
-                               ( gg-dd ) * w(k+1,j+1,i+1)                                          &
-                             ) / ( 3.0_wp * gg )
-                   w_int(n) = w_int_l + ( zv(n) - zw(k) ) / dzw(k+1) * ( w_int_u - w_int_l )
-                ENDIF
-             ELSE
-                w_int(n) = 0.0_wp
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDIF
-
-!-- Interpolate and calculate quantities needed for calculating the SGS velocities
-    IF ( use_sgs_for_particles  .AND.  .NOT. cloud_droplets )  THEN
-
-       DO  nb = 0,7
-
-          subbox_at_wall = .FALSE.
-!
-!--       In case of topography check if subbox is adjacent to a wall
-          IF ( .NOT. topography == 'flat' )  THEN
-             i = ip + MERGE( -1_iwp , 1_iwp, BTEST( nb, 2 ) )
-             j = jp + MERGE( -1_iwp , 1_iwp, BTEST( nb, 1 ) )
-             k = kp + MERGE( -1_iwp , 1_iwp, BTEST( nb, 0 ) )
-             IF ( .NOT. BTEST(wall_flags_total_0(k,  jp, ip), 0) .OR.                              &
-                  .NOT. BTEST(wall_flags_total_0(kp, j,  ip), 0) .OR.                              &
-                  .NOT. BTEST(wall_flags_total_0(kp, jp, i ), 0) )                                 &
-             THEN
-                subbox_at_wall = .TRUE.
-             ENDIF
-          ENDIF
-          IF ( subbox_at_wall )  THEN
-             e_int(start_index(nb):end_index(nb))     = e(kp,jp,ip)
-             diss_int(start_index(nb):end_index(nb))  = diss(kp,jp,ip)
-             de_dx_int(start_index(nb):end_index(nb)) = de_dx(kp,jp,ip)
-             de_dy_int(start_index(nb):end_index(nb)) = de_dy(kp,jp,ip)
-             de_dz_int(start_index(nb):end_index(nb)) = de_dz(kp,jp,ip)
-!
-!--          Set flag for stochastic equation.
-             term_1_2(start_index(nb):end_index(nb)) = 0.0_wp
-          ELSE
-             i = ip + block_offset(nb)%i_off
-             j = jp + block_offset(nb)%j_off
-             k = kp + block_offset(nb)%k_off
-
-             DO  n = start_index(nb), end_index(nb)
-!
-!--             Interpolate TKE
-                x  = xv(n) + ( 0.5_wp - i ) * dx
-                y  = yv(n) + ( 0.5_wp - j ) * dy
-                aa = x**2          + y**2
-                bb = ( dx - x )**2 + y**2
-                cc = x**2          + ( dy - y )**2
-                dd = ( dx - x )**2 + ( dy - y )**2
-                gg = aa + bb + cc + dd
-
-                e_int_l = ( ( gg-aa ) * e(k,j,i)   + ( gg-bb ) * e(k,j,i+1)                        &
-                          + ( gg-cc ) * e(k,j+1,i) + ( gg-dd ) * e(k,j+1,i+1)                      &
-                          ) / ( 3.0_wp * gg )
-
-                IF ( k+1 == nzt+1 )  THEN
-                   e_int(n) = e_int_l
-                ELSE
-                   e_int_u = ( ( gg - aa ) * e(k+1,j,i)   + &
-                               ( gg - bb ) * e(k+1,j,i+1) + &
-                               ( gg - cc ) * e(k+1,j+1,i) + &
-                               ( gg - dd ) * e(k+1,j+1,i+1) &
-                            ) / ( 3.0_wp * gg )
-                   e_int(n) = e_int_l + ( zv(n) - zu(k) ) / dzw(k+1) * ( e_int_u - e_int_l )
-                ENDIF
-!
-!--             Needed to avoid NaN particle velocities (this might not be required any more)
-                IF ( e_int(n) <= 0.0_wp )  THEN
-                   e_int(n) = 1.0E-20_wp
-                ENDIF
-!
-!--             Interpolate the TKE gradient along x (adopt incides i,j,k and all position variables
-!--             from above (TKE))
-                de_dx_int_l = ( ( gg - aa ) * de_dx(k,j,i)   +                                     &
-                                ( gg - bb ) * de_dx(k,j,i+1) +                                     &
-                                ( gg - cc ) * de_dx(k,j+1,i) +                                     &
-                                ( gg - dd ) * de_dx(k,j+1,i+1)                                     &
-                               ) / ( 3.0_wp * gg )
-
-                IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
-                   de_dx_int(n) = de_dx_int_l
-                ELSE
-                   de_dx_int_u = ( ( gg - aa ) * de_dx(k+1,j,i)   +                                &
-                                   ( gg - bb ) * de_dx(k+1,j,i+1) +                                &
-                                   ( gg - cc ) * de_dx(k+1,j+1,i) +                                &
-                                   ( gg - dd ) * de_dx(k+1,j+1,i+1)                                &
-                                  ) / ( 3.0_wp * gg )
-                   de_dx_int(n) = de_dx_int_l + ( zv(n) - zu(k) ) / dzw(k+1) *                     &
-                                              ( de_dx_int_u - de_dx_int_l )
-                ENDIF
-!
-!--             Interpolate the TKE gradient along y
-                de_dy_int_l = ( ( gg - aa ) * de_dy(k,j,i)   +                                     &
-                                ( gg - bb ) * de_dy(k,j,i+1) +                                     &
-                                ( gg - cc ) * de_dy(k,j+1,i) +                                     &
-                                ( gg - dd ) * de_dy(k,j+1,i+1)                                     &
-                               ) / ( 3.0_wp * gg )
-                IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
-                   de_dy_int(n) = de_dy_int_l
-                ELSE
-                   de_dy_int_u = ( ( gg - aa ) * de_dy(k+1,j,i)   +                                &
-                                   ( gg - bb ) * de_dy(k+1,j,i+1) +                                &
-                                   ( gg - cc ) * de_dy(k+1,j+1,i) +                                &
-                                   ( gg - dd ) * de_dy(k+1,j+1,i+1)                                &
-                                  ) / ( 3.0_wp * gg )
-                      de_dy_int(n) = de_dy_int_l + ( zv(n) - zu(k) ) / dzw(k+1) *                  &
-                                                 ( de_dy_int_u - de_dy_int_l )
-                ENDIF
-
-!
-!--             Interpolate the TKE gradient along z
-                IF ( zv(n) < 0.5_wp * dz(1) )  THEN
-                   de_dz_int(n) = 0.0_wp
-                ELSE
-                   de_dz_int_l = ( ( gg - aa ) * de_dz(k,j,i)   +                                  &
-                                   ( gg - bb ) * de_dz(k,j,i+1) +                                  &
-                                   ( gg - cc ) * de_dz(k,j+1,i) +                                  &
-                                   ( gg - dd ) * de_dz(k,j+1,i+1)                                  &
-                                  ) / ( 3.0_wp * gg )
-
-                   IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
-                      de_dz_int(n) = de_dz_int_l
-                   ELSE
-                      de_dz_int_u = ( ( gg - aa ) * de_dz(k+1,j,i)   +                             &
-                                      ( gg - bb ) * de_dz(k+1,j,i+1) +                             &
-                                      ( gg - cc ) * de_dz(k+1,j+1,i) +                             &
-                                      ( gg - dd ) * de_dz(k+1,j+1,i+1)                             &
-                                     ) / ( 3.0_wp * gg )
-                      de_dz_int(n) = de_dz_int_l + ( zv(n) - zu(k) ) / dzw(k+1) *                  &
-                                                 ( de_dz_int_u - de_dz_int_l )
-                   ENDIF
-                ENDIF
-
-!
-!--             Interpolate the dissipation of TKE
-                diss_int_l = ( ( gg - aa ) * diss(k,j,i)   +                                       &
-                               ( gg - bb ) * diss(k,j,i+1) +                                       &
-                               ( gg - cc ) * diss(k,j+1,i) +                                       &
-                               ( gg - dd ) * diss(k,j+1,i+1)                                       &
-                               ) / ( 3.0_wp * gg )
-
-                IF ( k == nzt )  THEN
-                   diss_int(n) = diss_int_l
-                ELSE
-                   diss_int_u = ( ( gg - aa ) * diss(k+1,j,i)   +                                  &
-                                  ( gg - bb ) * diss(k+1,j,i+1) +                                  &
-                                  ( gg - cc ) * diss(k+1,j+1,i) +                                  &
-                                  ( gg - dd ) * diss(k+1,j+1,i+1)                                  &
-                                 ) / ( 3.0_wp * gg )
-                   diss_int(n) = diss_int_l + ( zv(n) - zu(k) ) / dzw(k+1) *                       &
-                                            ( diss_int_u - diss_int_l )
-                ENDIF
-
-!
-!--             Set flag for stochastic equation.
-                term_1_2(n) = 1.0_wp
-             ENDDO
-          ENDIF
-       ENDDO
-
-       DO  nb = 0,7
-          i = ip + block_offset(nb)%i_off
-          j = jp + block_offset(nb)%j_off
-          k = kp + block_offset(nb)%k_off
-
-          DO  n = start_index(nb), end_index(nb)
-!
-!--          Vertical interpolation of the horizontally averaged SGS TKE and resolved-scale velocity
-!--          variances and use the interpolated values to calculate the coefficient fs, which is a
-!--          measure of the ratio of the subgrid-scale turbulent kinetic energy to the total amount
-!--          of turbulent kinetic energy.
-             IF ( k == 0 )  THEN
-                e_mean_int = hom(0,1,8,0)
-             ELSE
-                e_mean_int = hom(k,1,8,0) + ( hom(k+1,1,8,0) - hom(k,1,8,0) ) /                    &
-                                            ( zu(k+1) - zu(k) ) *                                  &
-                                            ( zv(n) - zu(k) )
-             ENDIF
-
-             kw = kp - 1
-
-             IF ( k == 0 )  THEN
-                aa  = hom(k+1,1,30,0)  * ( zv(n) / &
-                                         ( 0.5_wp * ( zu(k+1) - zu(k) ) ) )
-                bb  = hom(k+1,1,31,0)  * ( zv(n) / &
-                                         ( 0.5_wp * ( zu(k+1) - zu(k) ) ) )
-                cc  = hom(kw+1,1,32,0) * ( zv(n) / &
-                                         ( 1.0_wp * ( zw(kw+1) - zw(kw) ) ) )
-             ELSE
-                aa  = hom(k,1,30,0) + ( hom(k+1,1,30,0) - hom(k,1,30,0) ) *                        &
-                           ( ( zv(n) - zu(k) ) / ( zu(k+1) - zu(k) ) )
-                bb  = hom(k,1,31,0) + ( hom(k+1,1,31,0) - hom(k,1,31,0) ) *                        &
-                           ( ( zv(n) - zu(k) ) / ( zu(k+1) - zu(k) ) )
-                cc  = hom(kw,1,32,0) + ( hom(kw+1,1,32,0)-hom(kw,1,32,0) ) *                       &
-                           ( ( zv(n) - zw(kw) ) / ( zw(kw+1)-zw(kw) ) )
-             ENDIF
-
-             vv_int = ( 1.0_wp / 3.0_wp ) * ( aa + bb + cc )
-!
-!--          Needed to avoid NaN particle velocities. The value of 1.0 is just an educated guess for
-!--          the given case.
-             IF ( vv_int + ( 2.0_wp / 3.0_wp ) * e_mean_int == 0.0_wp )  THEN
-                fs_int(n) = 1.0_wp
-             ELSE
-                fs_int(n) = ( 2.0_wp / 3.0_wp ) * e_mean_int /                                     &
-                            ( vv_int + ( 2.0_wp / 3.0_wp ) * e_mean_int )
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       DO  nb = 0, 7
-          DO  n = start_index(nb), end_index(nb)
-             CALL random_number_parallel_gauss( random_dummy )
-             rg(n,1) = random_dummy
-             CALL random_number_parallel_gauss( random_dummy )
-             rg(n,2) = random_dummy
-             CALL random_number_parallel_gauss( random_dummy )
-             rg(n,3) = random_dummy
-          ENDDO
-       ENDDO
-
-       DO  nb = 0, 7
-          DO  n = start_index(nb), end_index(nb)
-
-!
-!--          Calculate the Lagrangian timescale according to Weil et al. (2004).
-             lagr_timescale(n) = ( 4.0_wp * e_int(n) + 1E-20_wp ) /                                &
-                                 ( 3.0_wp * fs_int(n) * c_0 * diss_int(n) + 1E-20_wp )
-
-!
-!--          Calculate the next particle timestep. dt_gap is the time needed to complete the current
-!--          LES timestep.
-             dt_gap(n) = dt_3d - particles(n)%dt_sum
-             dt_particle(n) = MIN( dt_3d, 0.025_wp * lagr_timescale(n), dt_gap(n) )
-             particles(n)%aux1 = lagr_timescale(n)
-             particles(n)%aux2 = dt_gap(n)
-!
-!--          The particle timestep should not be too small in order to prevent the number of
-!--          particle timesteps of getting too large
-             IF ( dt_particle(n) < dt_min_part )  THEN
-                IF ( dt_min_part < dt_gap(n) )  THEN
-                   dt_particle(n) = dt_min_part
-                ELSE
-                   dt_particle(n) = dt_gap(n)
-                ENDIF
-             ENDIF
-
-             rvar1_temp(n) = particles(n)%rvar1
-             rvar2_temp(n) = particles(n)%rvar2
-             rvar3_temp(n) = particles(n)%rvar3
-!
-!--          Calculate the SGS velocity components
-             IF ( particles(n)%age == 0.0_wp )  THEN
-!
-!--             For new particles the SGS components are derived from the SGS TKE. Limit the
-!--             Gaussian random number to the interval [-5.0*sigma, 5.0*sigma] in order to prevent
-!--             the SGS velocities from becoming unrealistically large.
-                rvar1_temp(n) = SQRT( 2.0_wp * sgs_wf_part * e_int(n) + 1E-20_wp ) * rg(n,1)
-                rvar2_temp(n) = SQRT( 2.0_wp * sgs_wf_part * e_int(n) + 1E-20_wp ) * rg(n,2)
-                rvar3_temp(n) = SQRT( 2.0_wp * sgs_wf_part * e_int(n) + 1E-20_wp ) * rg(n,3)
-             ELSE
-!
-!--             Restriction of the size of the new timestep: compared to the
-!--             previous timestep the increase must not exceed 200%. First,
-!--             check if age > age_m, in order to prevent that particles get zero
-!--             timestep.
-                dt_particle_m = MERGE( dt_particle(n),                                             &
-                                       particles(n)%age - particles(n)%age_m,                      &
-                                       particles(n)%age - particles(n)%age_m < 1E-8_wp )
-                IF ( dt_particle(n) > 2.0_wp * dt_particle_m )  THEN
-                   dt_particle(n) = 2.0_wp * dt_particle_m
-                ENDIF
-
-!--             For old particles the SGS components are correlated with the values from the
-!--             previous timestep. Random numbers have also to be limited (see above).
-!--             As negative values for the subgrid TKE are not allowed, the change of the subgrid
-!--             TKE with time cannot be smaller than -e_int(n)/dt_particle. This value is used as a
-!--             lower boundary value for the change of TKE
-                de_dt_min = - e_int(n) / dt_particle(n)
-
-                de_dt = ( e_int(n) - particles(n)%e_m ) / dt_particle_m
-
-                IF ( de_dt < de_dt_min )  THEN
-                   de_dt = de_dt_min
-                ENDIF
-
-                CALL weil_stochastic_eq( rvar1_temp(n), fs_int(n), e_int(n), de_dx_int(n), de_dt,  &
-                                         diss_int(n), dt_particle(n), rg(n,1), term_1_2(n) )
-
-                CALL weil_stochastic_eq( rvar2_temp(n), fs_int(n), e_int(n), de_dy_int(n), de_dt,  &
-                                         diss_int(n), dt_particle(n), rg(n,2), term_1_2(n) )
-
-                CALL weil_stochastic_eq( rvar3_temp(n), fs_int(n), e_int(n), de_dz_int(n), de_dt,  &
-                                         diss_int(n), dt_particle(n), rg(n,3), term_1_2(n) )
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-!
-!--    Check if the added SGS velocities result in a violation of the CFL-criterion. If yes, limt
-!--    the SGS particle speed to match the CFL criterion. Note, a re-calculation of the SGS particle
-!--    speed with smaller timestep does not necessarily fulfill the CFL criterion as the new SGS
-!--    speed can be even larger (due to the random term with scales with the square-root of
-!--    dt_particle, for small dt the random contribution increases).
-!--    Thus, we would need to re-calculate the SGS speeds as long as they would fulfill the
-!--    requirements, which could become computationally expensive,
-!--    Hence, we just limit them.
-       dz_temp = zw(kp)-zw(kp-1)
-
-       DO  nb = 0, 7
-          DO  n = start_index(nb), end_index(nb)
-             IF ( ABS( u_int(n) + rvar1_temp(n) ) > ( dx      / dt_particle(n) )  .OR.             &
-                  ABS( v_int(n) + rvar2_temp(n) ) > ( dy      / dt_particle(n) )  .OR.             &
-                  ABS( w_int(n) + rvar3_temp(n) ) > ( dz_temp / dt_particle(n) ) )  THEN
-!
-!--             If total speed exceeds the allowed speed according to CFL
-!--             criterion, limit the SGS speed to
-!--             dx_i / dt_particle - u_resolved_i, considering a safty factor.
-                rvar1_temp(n) = MERGE( rvar1_temp(n),                                              &
-                                       0.9_wp *                                                    &
-                                       SIGN( dx / dt_particle(n)                                   &
-                                             - ABS( u_int(n) ), rvar1_temp(n) ),                   &
-                                       ABS( u_int(n) + rvar1_temp(n) ) <                           &
-                                       ( dx / dt_particle(n) ) )
-                rvar2_temp(n) = MERGE( rvar2_temp(n),                                              &
-                                       0.9_wp *                                                    &
-                                       SIGN( dy / dt_particle(n)                                   &
-                                             - ABS( v_int(n) ), rvar2_temp(n) ),                   &
-                                       ABS( v_int(n) + rvar2_temp(n) ) <                           &
-                                       ( dy / dt_particle(n) ) )
-                rvar3_temp(n) = MERGE( rvar3_temp(n),                                              &
-                                       0.9_wp *                                                    &
-                                       SIGN( zw(kp)-zw(kp-1) / dt_particle(n)                      &
-                                             - ABS( w_int(n) ), rvar3_temp(n) ),                   &
-                                       ABS( w_int(n) + rvar3_temp(n) ) <                           &
-                                       ( zw(kp)-zw(kp-1) / dt_particle(n) ) )
-             ENDIF
-!
-!--          Update particle velocites
-             particles(n)%rvar1 = rvar1_temp(n)
-             particles(n)%rvar2 = rvar2_temp(n)
-             particles(n)%rvar3 = rvar3_temp(n)
-             u_int(n) = u_int(n) + particles(n)%rvar1
-             v_int(n) = v_int(n) + particles(n)%rvar2
-             w_int(n) = w_int(n) + particles(n)%rvar3
-!
-!--          Store the SGS TKE of the current timelevel which is needed for for calculating the SGS
-!--          particle velocities at the next timestep
-             particles(n)%e_m = e_int(n)
-          ENDDO
-       ENDDO
-
-    ELSE
-!
-!--    If no SGS velocities are used, only the particle timestep has to be set
-       dt_particle = dt_3d
-
-    ENDIF
-
-    dens_ratio = particle_groups(particles(1:number_of_particles)%group)%density_ratio
-    IF ( ANY( dens_ratio == 0.0_wp ) )  THEN
-!
-!--    Decide whether the particle loop runs over the subboxes or only over 1, number_of_particles.
-!--    This depends on the selected interpolation method.
-!--    If particle interpolation method is not trilinear, then the sorting within subboxes is not
-!--    required. However, therefore the index start_index(nb) and end_index(nb) are not defined and
-!--    the loops are still over number_of_particles. @todo find a more generic way to write this
-!--    loop or delete trilinear interpolation
-       IF ( interpolation_trilinear )  THEN
-          subbox_start = 0
-          subbox_end   = 7
-       ELSE
-          subbox_start = 1
-          subbox_end   = 1
-       ENDIF
-!
-!--    loop over subboxes. In case of simple interpolation scheme no subboxes are introduced, as
-!--    they are not required. Accordingly, this loop goes from 1 to 1.
-       DO  nb = subbox_start, subbox_end
-          IF ( interpolation_trilinear )  THEN
-             particle_start = start_index(nb)
-             particle_end   = end_index(nb)
-          ELSE
-             particle_start = 1
-             particle_end   = number_of_particles
-          ENDIF
-!
-!--         Loop from particle start to particle end
-            DO  n = particle_start, particle_end
-
-!
-!--          Particle advection
-             IF ( dens_ratio(n) == 0.0_wp )  THEN
-!
-!--             Pure passive transport (without particle inertia)
-                particles(n)%x = xv(n) + u_int(n) * dt_particle(n)
-                particles(n)%y = yv(n) + v_int(n) * dt_particle(n)
-                particles(n)%z = zv(n) + w_int(n) * dt_particle(n)
-
-                particles(n)%speed_x = u_int(n)
-                particles(n)%speed_y = v_int(n)
-                particles(n)%speed_z = w_int(n)
-
-             ELSE
-!
-!--             Transport of particles with inertia
-                particles(n)%x = particles(n)%x + particles(n)%speed_x * dt_particle(n)
-                particles(n)%y = particles(n)%y + particles(n)%speed_y * dt_particle(n)
-                particles(n)%z = particles(n)%z + particles(n)%speed_z * dt_particle(n)
-
-!
-!--             Update of the particle velocity
-                IF ( cloud_droplets )  THEN
-!
-!--                Terminal velocity is computed for vertical direction (Rogers et
-!--                al., 1993, J. Appl. Meteorol.)
-                   diameter = particles(n)%radius * 2000.0_wp !diameter in mm
-                   IF ( diameter <= d0_rog )  THEN
-                      w_s = k_cap_rog * diameter * ( 1.0_wp - EXP( -k_low_rog * diameter ) )
-                   ELSE
-                      w_s = a_rog - b_rog * EXP( -c_rog * diameter )
-                   ENDIF
-
-!
-!--                If selected, add random velocities following Soelch and Kaercher
-!--                (2010, Q. J. R. Meteorol. Soc.)
-                   IF ( use_sgs_for_particles )  THEN
-                      lagr_timescale(n) = km(kp,jp,ip) / MAX( e(kp,jp,ip), 1.0E-20_wp )
-                      rl    = EXP( -1.0_wp * dt_3d / MAX( lagr_timescale(n), 1.0E-20_wp ) )
-                      sigma = SQRT( e(kp,jp,ip) )
-!
-!--                   Calculate random component of particle sgs velocity using parallel
-!--                   random generator
-                      CALL random_number_parallel_gauss( random_dummy )
-                      rg1 = random_dummy
-                      CALL random_number_parallel_gauss( random_dummy )
-                      rg2 = random_dummy
-                      CALL random_number_parallel_gauss( random_dummy )
-                      rg3 = random_dummy
-
-                      particles(n)%rvar1 = rl * particles(n)%rvar1 +                               &
-                                           SQRT( 1.0_wp - rl**2 ) * sigma * rg1
-                      particles(n)%rvar2 = rl * particles(n)%rvar2 +                               &
-                                           SQRT( 1.0_wp - rl**2 ) * sigma * rg2
-                      particles(n)%rvar3 = rl * particles(n)%rvar3 +                               &
-                                           SQRT( 1.0_wp - rl**2 ) * sigma * rg3
-
-                      particles(n)%speed_x = u_int(n) + particles(n)%rvar1
-                      particles(n)%speed_y = v_int(n) + particles(n)%rvar2
-                      particles(n)%speed_z = w_int(n) + particles(n)%rvar3 - w_s
-                   ELSE
-                      particles(n)%speed_x = u_int(n)
-                      particles(n)%speed_y = v_int(n)
-                      particles(n)%speed_z = w_int(n) - w_s
-                   ENDIF
-
-                ELSE
-
-                   IF ( use_sgs_for_particles )  THEN
-                      exp_arg  = particle_groups(particles(n)%group)%exp_arg
-                      exp_term = EXP( -exp_arg * dt_particle(n) )
-                   ELSE
-                      exp_arg  = particle_groups(particles(n)%group)%exp_arg
-                      exp_term = particle_groups(particles(n)%group)%exp_term
-                   ENDIF
-                   particles(n)%speed_x = particles(n)%speed_x * exp_term +                        &
-                                          u_int(n) * ( 1.0_wp - exp_term )
-                   particles(n)%speed_y = particles(n)%speed_y * exp_term +                        &
-                                          v_int(n) * ( 1.0_wp - exp_term )
-                   particles(n)%speed_z = particles(n)%speed_z * exp_term +                        &
-                                          ( w_int(n) - ( 1.0_wp - dens_ratio(n) ) *                &
-                                          g / exp_arg ) * ( 1.0_wp - exp_term )
-                ENDIF
-
-             ENDIF
-          ENDDO
-       ENDDO
-
-    ELSE
-!
-!--    Decide whether the particle loop runs over the subboxes or only over 1, number_of_particles.
-!--    This depends on the selected interpolation method.
-       IF ( interpolation_trilinear )  THEN
-          subbox_start = 0
-          subbox_end   = 7
-       ELSE
-          subbox_start = 1
-          subbox_end   = 1
-       ENDIF
-!--    loop over subboxes. In case of simple interpolation scheme no subboxes are introduced, as
-!--    they are not required. Accordingly, this loop goes from 1 to 1.
-       DO  nb = subbox_start, subbox_end
-          IF ( interpolation_trilinear )  THEN
-             particle_start = start_index(nb)
-             particle_end   = end_index(nb)
-          ELSE
-             particle_start = 1
-             particle_end   = number_of_particles
-          ENDIF
-!
-!--         Loop from particle start to particle end
-            DO  n = particle_start, particle_end
-
-!
-!--          Transport of particles with inertia
-             particles(n)%x = xv(n) + particles(n)%speed_x * dt_particle(n)
-             particles(n)%y = yv(n) + particles(n)%speed_y * dt_particle(n)
-             particles(n)%z = zv(n) + particles(n)%speed_z * dt_particle(n)
-!
-!--          Update of the particle velocity
-             IF ( cloud_droplets )  THEN
-!
-!--             Terminal velocity is computed for vertical direction (Rogers et al., 1993,
-!--             J. Appl. Meteorol.)
-                diameter = particles(n)%radius * 2000.0_wp !diameter in mm
-                IF ( diameter <= d0_rog )  THEN
-                   w_s = k_cap_rog * diameter * ( 1.0_wp - EXP( -k_low_rog * diameter ) )
-                ELSE
-                   w_s = a_rog - b_rog * EXP( -c_rog * diameter )
-                ENDIF
-
-!
-!--             If selected, add random velocities following Soelch and Kaercher
-!--             (2010, Q. J. R. Meteorol. Soc.)
-                IF ( use_sgs_for_particles )  THEN
-                    lagr_timescale(n) = km(kp,jp,ip) / MAX( e(kp,jp,ip), 1.0E-20_wp )
-                    rl    = EXP( -1.0_wp * dt_3d / MAX( lagr_timescale(n), 1.0E-20_wp ) )
-                    sigma = SQRT( e(kp,jp,ip) )
-
-!
-!--                 Calculate random component of particle sgs velocity using parallel random
-!--                 generator
-                    CALL random_number_parallel_gauss( random_dummy )
-                    rg1 = random_dummy
-                    CALL random_number_parallel_gauss( random_dummy )
-                    rg2 = random_dummy
-                    CALL random_number_parallel_gauss( random_dummy )
-                    rg3 = random_dummy
-
-                    particles(n)%rvar1 = rl * particles(n)%rvar1 +                                 &
-                                         SQRT( 1.0_wp - rl**2 ) * sigma * rg1
-                    particles(n)%rvar2 = rl * particles(n)%rvar2 +                                 &
-                                         SQRT( 1.0_wp - rl**2 ) * sigma * rg2
-                    particles(n)%rvar3 = rl * particles(n)%rvar3 +                                 &
-                                         SQRT( 1.0_wp - rl**2 ) * sigma * rg3
-
-                    particles(n)%speed_x = u_int(n) + particles(n)%rvar1
-                    particles(n)%speed_y = v_int(n) + particles(n)%rvar2
-                    particles(n)%speed_z = w_int(n) + particles(n)%rvar3 - w_s
-                ELSE
-                    particles(n)%speed_x = u_int(n)
-                    particles(n)%speed_y = v_int(n)
-                    particles(n)%speed_z = w_int(n) - w_s
-                ENDIF
-
-             ELSE
-
-                IF ( use_sgs_for_particles )  THEN
-                   exp_arg  = particle_groups(particles(n)%group)%exp_arg
-                   exp_term = EXP( -exp_arg * dt_particle(n) )
-                ELSE
-                   exp_arg  = particle_groups(particles(n)%group)%exp_arg
-                   exp_term = particle_groups(particles(n)%group)%exp_term
-                ENDIF
-                particles(n)%speed_x = particles(n)%speed_x * exp_term +                           &
-                                       u_int(n) * ( 1.0_wp - exp_term )
-                particles(n)%speed_y = particles(n)%speed_y * exp_term +                           &
-                                       v_int(n) * ( 1.0_wp - exp_term )
-                particles(n)%speed_z = particles(n)%speed_z * exp_term +                           &
-                                       ( w_int(n) - ( 1.0_wp - dens_ratio(n) ) * g /               &
-                                       exp_arg ) * ( 1.0_wp - exp_term )
-             ENDIF
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-!
-!-- Store the old age of the particle ( needed to prevent that a particle crosses several PEs during
-!-- one timestep, and for the evaluation of the subgrid particle velocity fluctuations )
-    particles(1:number_of_particles)%age_m = particles(1:number_of_particles)%age
-
-!
-!--    loop over subboxes. In case of simple interpolation scheme no subboxes are introduced, as
-!--    they are not required. Accordingly, this loop goes from 1 to 1.
-!
-!-- Decide whether the particle loop runs over the subboxes or only over 1, number_of_particles.
-!-- This depends on the selected interpolation method.
-    IF ( interpolation_trilinear )  THEN
-       subbox_start = 0
-       subbox_end   = 7
-    ELSE
-       subbox_start = 1
-       subbox_end   = 1
-    ENDIF
-    DO  nb = subbox_start, subbox_end
-       IF ( interpolation_trilinear )  THEN
-          particle_start = start_index(nb)
-          particle_end   = end_index(nb)
-       ELSE
-          particle_start = 1
-          particle_end   = number_of_particles
-       ENDIF
-!
-!--    Loop from particle start to particle end and increment the particle age and the total time
-!--    that the particle has advanced within the particle timestep procedure.
-       DO  n = particle_start, particle_end
-          particles(n)%age    = particles(n)%age    + dt_particle(n)
-          particles(n)%dt_sum = particles(n)%dt_sum + dt_particle(n)
-       ENDDO
-!
-!--    Particles that leave the child domain during the SGS-timestep loop
-!--    must not continue timestepping until they are transferred to the
-!--    parent. Hence, set their dt_sum to dt.
-       IF ( child_domain  .AND.  use_sgs_for_particles )  THEN
-          DO  n = particle_start, particle_end
-             IF ( particles(n)%x < 0.0_wp         .OR.                                             &
-                  particles(n)%y < 0.0_wp         .OR.                                             &
-                  particles(n)%x > ( nx+1 ) * dx  .OR.                                             &
-                  particles(n)%y < ( ny+1 ) * dy )  THEN
-                particles(n)%dt_sum = dt_3d
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!--    Check whether there is still a particle that has not yet completed the total LES timestep
-       DO  n = particle_start, particle_end
-          IF ( ( dt_3d - particles(n)%dt_sum ) > 1E-8_wp )  dt_3d_reached_l = .FALSE.
-       ENDDO
-    ENDDO
-
-    CALL cpu_log( log_point_s(44), 'lpm_advec', 'pause' )
-
-
- END SUBROUTINE lpm_advec
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of subgrid-scale particle speed using the stochastic model
-!> of Weil et al. (2004, JAS, 61, 2877-2887).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE weil_stochastic_eq( v_sgs, fs_n, e_n, dedxi_n, dedt_n, diss_n, dt_n, rg_n, fac )
-
-    REAL(wp) ::  a1      !< dummy argument
-    REAL(wp) ::  dedt_n  !< time derivative of TKE at particle position
-    REAL(wp) ::  dedxi_n !< horizontal derivative of TKE at particle position
-    REAL(wp) ::  diss_n  !< dissipation at particle position
-    REAL(wp) ::  dt_n    !< particle timestep
-    REAL(wp) ::  e_n     !< TKE at particle position
-    REAL(wp) ::  fac     !< flag to identify adjacent topography
-    REAL(wp) ::  fs_n    !< weighting factor to prevent that subgrid-scale particle speed becomes too large
-    REAL(wp) ::  rg_n    !< random number
-    REAL(wp) ::  term1   !< memory term
-    REAL(wp) ::  term2   !< drift correction term
-    REAL(wp) ::  term3   !< random term
-    REAL(wp) ::  v_sgs   !< subgrid-scale velocity component
-
-!-- At first, limit TKE to a small non-zero number, in order to prevent the occurrence of extremely
-!-- large SGS-velocities in case TKE is zero, (could occur at the simulation begin).
-    e_n = MAX( e_n, 1E-20_wp )
-!
-!-- Please note, terms 1 and 2 (drift and memory term, respectively) are multiplied by a flag to
-!-- switch of both terms near topography.
-!-- This is necessary, as both terms may cause a subgrid-scale velocity build up if particles are
-!-- trapped in regions with very small TKE, e.g. in narrow street canyons resolved by only a few
-!-- grid points. Hence, term 1 and term 2 are disabled if one of the adjacent grid points belongs to
-!-- topography.
-!-- Moreover, in this case, the  previous subgrid-scale component is also set to zero.
-
-    a1 = fs_n * c_0 * diss_n
-!
-!-- Memory term
-    term1 = - a1 * v_sgs * dt_n / ( 4.0_wp * sgs_wf_part * e_n + 1E-20_wp ) * fac
-!
-!-- Drift correction term
-    term2 = ( ( dedt_n * v_sgs / e_n ) + dedxi_n ) * 0.5_wp * dt_n * fac
-!
-!-- Random term
-    term3 = SQRT( MAX( a1, 1E-20_wp ) ) * ( rg_n - 1.0_wp ) * SQRT( dt_n )
-!
-!-- In case one of the adjacent grid-boxes belongs to topograhy, the previous subgrid-scale velocity
-!-- component is set to zero, in order to prevent a velocity build-up.
-!-- This case, set also previous subgrid-scale component to zero.
-    v_sgs = v_sgs * fac + term1 + term2 + term3
-
- END SUBROUTINE weil_stochastic_eq
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> swap timelevel in case of particle advection interpolation 'simple-corrector'
-!> This routine is called at the end of one timestep, the velocities are then used for the next
-!> timestep
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_swap_timelevel_for_particle_advection
-
-!
-!-- Save the divergence free velocites of t+1 to use them at the end of the next time step
-    u_t = u
-    v_t = v
-    w_t = w
-
- END SUBROUTINE lpm_swap_timelevel_for_particle_advection
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Boundary conditions for the Lagrangian particles.
-!> The routine consists of two different parts. One handles the bottom (flat) and top boundary. In
-!> this part, also particles which exceeded their lifetime are deleted.
-!> The other part handles the reflection of particles from vertical walls.
-!> This part was developed by Jin Zhang during 2006-2007.
-!>
-!> To do: Code structure for finding the t_index values and for checking the reflection conditions
-!> ------ is basically the same for all four cases, so it should be possible to further
-!>        simplify/shorten it.
-!>
-!> THE WALLS PART OF THIS ROUTINE HAS NOT BEEN TESTED FOR OCEAN RUNS SO FAR!!!!
-!> (see offset_ocean_*)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_boundary_conds( location_bc , i, j, k )
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location_bc !< general mode: boundary conditions at bottom/top of the model domain
-                                   !< or at vertical surfaces (buildings, terrain steps)
-    INTEGER(iwp), INTENT(IN) ::  i !< grid index of particle box along x
-    INTEGER(iwp), INTENT(IN) ::  j !< grid index of particle box along y
-    INTEGER(iwp), INTENT(IN) ::  k !< grid index of particle box along z
-
-    INTEGER(iwp) ::  inc            !< dummy for sorting algorithmus
-    INTEGER(iwp) ::  ir             !< dummy for sorting algorithmus
-    INTEGER(iwp) ::  i1             !< grid index (x) of old particle position
-    INTEGER(iwp) ::  i2             !< grid index (x) of current particle position
-    INTEGER(iwp) ::  i3             !< grid index (x) of intermediate particle position
-    INTEGER(iwp) ::  index_reset    !< index reset height
-    INTEGER(iwp) ::  jr             !< dummy for sorting algorithmus
-    INTEGER(iwp) ::  j1             !< grid index (y) of old particle position
-    INTEGER(iwp) ::  j2             !< grid index (y) of current particle position
-    INTEGER(iwp) ::  j3             !< grid index (y) of intermediate particle position
-    INTEGER(iwp) ::  k1             !< grid index (z) of old particle position
-    INTEGER(iwp) ::  k2             !< grid index (z) of current particle position
-    INTEGER(iwp) ::  k3             !< grid index (z) of intermediate particle position
-    INTEGER(iwp) ::  n              !< particle number
-    INTEGER(iwp) ::  particles_top  !< maximum reset height
-    INTEGER(iwp) ::  t_index        !< running index for intermediate particle timesteps in reflection algorithmus
-    INTEGER(iwp) ::  t_index_number !< number of intermediate particle timesteps in reflection algorithmus
-    INTEGER(iwp) ::  tmp_x          !< dummy for sorting algorithm
-    INTEGER(iwp) ::  tmp_y          !< dummy for sorting algorithm
-    INTEGER(iwp) ::  tmp_z          !< dummy for sorting algorithm
-
-    INTEGER(iwp), DIMENSION(0:10) ::  x_ind(0:10) = 0 !< index array (x) of intermediate particle positions
-    INTEGER(iwp), DIMENSION(0:10) ::  y_ind(0:10) = 0 !< index array (y) of intermediate particle positions
-    INTEGER(iwp), DIMENSION(0:10) ::  z_ind(0:10) = 0 !< index array (z) of intermediate particle positions
-
-    LOGICAL  ::  cross_wall_x    !< flag to check if particle reflection along x is necessary
-    LOGICAL  ::  cross_wall_y    !< flag to check if particle reflection along y is necessary
-    LOGICAL  ::  cross_wall_z    !< flag to check if particle reflection along z is necessary
-    LOGICAL  ::  reflect_x       !< flag to check if particle is already reflected along x
-    LOGICAL  ::  reflect_y       !< flag to check if particle is already reflected along y
-    LOGICAL  ::  reflect_z       !< flag to check if particle is already reflected along z
-    LOGICAL  ::  tmp_reach_x     !< dummy for sorting algorithmus
-    LOGICAL  ::  tmp_reach_y     !< dummy for sorting algorithmus
-    LOGICAL  ::  tmp_reach_z     !< dummy for sorting algorithmus
-    LOGICAL  ::  x_wall_reached  !< flag to check if particle has already reached wall
-    LOGICAL  ::  y_wall_reached  !< flag to check if particle has already reached wall
-    LOGICAL  ::  z_wall_reached  !< flag to check if particle has already reached wall
-
-    LOGICAL, DIMENSION(0:10) ::  reach_x  !< flag to check if particle is at a yz-wall
-    LOGICAL, DIMENSION(0:10) ::  reach_y  !< flag to check if particle is at a xz-wall
-    LOGICAL, DIMENSION(0:10) ::  reach_z  !< flag to check if particle is at a xy-wall
-
-    REAL(wp) ::  dt_particle    !< particle timestep
-    REAL(wp) ::  eps = 1E-10_wp !< security number to check if particle has reached a wall
-    REAL(wp) ::  pos_x          !< intermediate particle position (x)
-    REAL(wp) ::  pos_x_old      !< particle position (x) at previous particle timestep
-    REAL(wp) ::  pos_y          !< intermediate particle position (y)
-    REAL(wp) ::  pos_y_old      !< particle position (y) at previous particle timestep
-    REAL(wp) ::  pos_z          !< intermediate particle position (z)
-    REAL(wp) ::  pos_z_old      !< particle position (z) at previous particle timestep
-    REAL(wp) ::  prt_x          !< current particle position (x)
-    REAL(wp) ::  prt_y          !< current particle position (y)
-    REAL(wp) ::  prt_z          !< current particle position (z)
-    REAL(wp) ::  reset_top      !< location of wall in z
-    REAL(wp) ::  t_old          !< previous reflection time
-    REAL(wp) ::  tmp_t          !< dummy for sorting algorithmus
-    REAL(wp) ::  xwall          !< location of wall in x
-    REAL(wp) ::  ywall          !< location of wall in y
-    REAL(wp) ::  zwall          !< location of wall in z
-
-    REAL(wp), DIMENSION(0:10) ::  t  !< reflection time
-
-    SELECT CASE ( location_bc )
-
-       CASE ( 'bottom/top' )
-
-!
-!--    Apply boundary conditions to those particles that have crossed the top or bottom boundary and
-!--    delete those particles, which are older than allowed
-       DO  n = 1, number_of_particles
-
-!
-!--       Stop if particles have moved further than the length of one PE subdomain (newly released
-!--       particles have age = age_m!)
-          IF ( particles(n)%age /= particles(n)%age_m )  THEN
-             IF ( ABS(particles(n)%speed_x) >                                                      &
-                  ((nxr-nxl+2)*dx)/(particles(n)%age-particles(n)%age_m)  .OR.                     &
-                  ABS(particles(n)%speed_y) >                                                      &
-                  ((nyn-nys+2)*dy)/(particles(n)%age-particles(n)%age_m) )  THEN
-
-                  WRITE( message_string, * )  'particle too fast.  n = ',  n
-                  CALL message( 'lpm_boundary_conds', 'PA0148', 2, 2, -1, 6, 1 )
-             ENDIF
-          ENDIF
-
-          IF ( particles(n)%age > particle_maximum_age  .AND.  particles(n)%particle_mask )  THEN
-             particles(n)%particle_mask  = .FALSE.
-             deleted_particles = deleted_particles + 1
-          ENDIF
-
-          IF ( particles(n)%z >= zw(nz)  .AND.  particles(n)%particle_mask )  THEN
-             IF ( ibc_par_t == 1 )  THEN
-!
-!--             Particle absorption
-                particles(n)%particle_mask  = .FALSE.
-                deleted_particles = deleted_particles + 1
-             ELSEIF ( ibc_par_t == 2 )  THEN
-!
-!--             Particle reflection
-                particles(n)%z       = 2.0_wp * zw(nz) - particles(n)%z
-                particles(n)%speed_z = -particles(n)%speed_z
-                IF ( use_sgs_for_particles  .AND. &
-                     particles(n)%rvar3 > 0.0_wp )  THEN
-                   particles(n)%rvar3 = -particles(n)%rvar3
-                ENDIF
-             ENDIF
-          ENDIF
-
-          IF ( particles(n)%z < zw(0)  .AND.  particles(n)%particle_mask )  THEN
-             IF ( ibc_par_b == 1 )  THEN
-!
-!--             Particle absorption
-                particles(n)%particle_mask  = .FALSE.
-                deleted_particles = deleted_particles + 1
-             ELSEIF ( ibc_par_b == 2 )  THEN
-!
-!--             Particle reflection
-                particles(n)%z       = 2.0_wp * zw(0) - particles(n)%z
-                particles(n)%speed_z = -particles(n)%speed_z
-                IF ( use_sgs_for_particles  .AND. &
-                     particles(n)%rvar3 < 0.0_wp )  THEN
-                   particles(n)%rvar3 = -particles(n)%rvar3
-                ENDIF
-             ELSEIF ( ibc_par_b == 3 )  THEN
-!
-!--             Find reset height. @note this works only in non-strechted cases
-                particles_top = INT( pst(1) / dz(1) )
-                index_reset = MINLOC( prt_count(nzb+1:particles_top,j,i), DIM = 1 )
-                reset_top = zu(index_reset)
-                CALL random_number_parallel( random_dummy )
-                particles(n)%z       = reset_top *  ( 1.0  + ( random_dummy / 10.0_wp) )
-                particles(n)%speed_z = 0.0_wp
-                IF ( curvature_solution_effects )  THEN
-                   particles(n)%radius = particles(n)%aux1
-                ELSE
-                   particles(n)%radius = 1.0E-8
-                ENDIF
-             ENDIF
-          ENDIF
-       ENDDO
-
-      CASE ( 'walls' )
-
-       CALL cpu_log( log_point_s(48), 'lpm_wall_reflect', 'start' )
-
-       DO  n = 1, number_of_particles
-!
-!--       Recalculate particle timestep
-          dt_particle = particles(n)%age - particles(n)%age_m
-!
-!--       Obtain x/y indices for current particle position
-          i2 = particles(n)%x * ddx
-          j2 = particles(n)%y * ddy
-          IF ( zw(k)   < particles(n)%z ) k2 = k + 1
-          IF ( zw(k)   > particles(n)%z  .AND.  zw(k-1) < particles(n)%z ) k2 = k
-          IF ( zw(k-1) > particles(n)%z ) k2 = k - 1
-!
-!--       Save current particle positions
-          prt_x = particles(n)%x
-          prt_y = particles(n)%y
-          prt_z = particles(n)%z
-!
-!--       Recalculate old particle positions
-          pos_x_old = particles(n)%x - particles(n)%speed_x * dt_particle
-          pos_y_old = particles(n)%y - particles(n)%speed_y * dt_particle
-          pos_z_old = particles(n)%z - particles(n)%speed_z * dt_particle
-!
-!--       Obtain x/y indices for old particle positions
-          i1 = i
-          j1 = j
-          k1 = k
-!
-!--       Determine horizontal as well as vertical walls at which particle can be potentially
-!--       reflected.
-!--       Start with walls aligned in yz layer.
-!--       Wall to the right
-          IF ( prt_x > pos_x_old )  THEN
-             xwall = ( i1 + 1 ) * dx
-!
-!--       Wall to the left
-          ELSE
-             xwall = i1 * dx
-          ENDIF
-!
-!--       Walls aligned in xz layer
-!--       Wall to the north
-          IF ( prt_y > pos_y_old )  THEN
-             ywall = ( j1 + 1 ) * dy
-!--       Wall to the south
-          ELSE
-             ywall = j1 * dy
-          ENDIF
-
-          IF ( prt_z > pos_z_old )  THEN
-             zwall = zw(k)
-          ELSE
-             zwall = zw(k-1)
-          ENDIF
-!
-!--       Initialize flags to check if particle reflection is necessary
-          cross_wall_x = .FALSE.
-          cross_wall_y = .FALSE.
-          cross_wall_z = .FALSE.
-!
-!--       Initialize flags to check if a wall is reached
-          reach_x      = .FALSE.
-          reach_y      = .FALSE.
-          reach_z      = .FALSE.
-!
-!--       Initialize flags to check if a particle was already reflected
-          reflect_x    = .FALSE.
-          reflect_y    = .FALSE.
-          reflect_z    = .FALSE.
-!
-!--       Initialize flags to check if a wall is already crossed.
-!--       ( Required to obtain correct indices. )
-          x_wall_reached = .FALSE.
-          y_wall_reached = .FALSE.
-          z_wall_reached = .FALSE.
-!
-!--       Initialize time array
-          t     = 0.0_wp
-!
-!--       Check if particle can reach any wall. This case, calculate the fractional time needed to
-!--       reach this wall. Store this fractional timestep in array t. Moreover, store indices for
-!--       these grid boxes where the respective wall belongs to.
-!--       Start with x-direction.
-          t_index    = 1
-          t(t_index) = ( xwall - pos_x_old )                                                       &
-                       / MERGE( MAX( prt_x - pos_x_old,  1E-30_wp ),                               &
-                                MIN( prt_x - pos_x_old, -1E-30_wp ),                               &
-                                prt_x > pos_x_old )
-          x_ind(t_index)   = i2
-          y_ind(t_index)   = j1
-          z_ind(t_index)   = k1
-          reach_x(t_index) = .TRUE.
-          reach_y(t_index) = .FALSE.
-          reach_z(t_index) = .FALSE.
-!
-!--       Store these values only if particle really reaches any wall. t must be in an interval
-!--       between [0:1].
-          IF ( t(t_index) <= 1.0_wp  .AND.  t(t_index) >= 0.0_wp )  THEN
-             t_index      = t_index + 1
-             cross_wall_x = .TRUE.
-          ENDIF
-!
-!--       y-direction
-          t(t_index) = ( ywall - pos_y_old )                                                       &
-                       / MERGE( MAX( prt_y - pos_y_old,  1E-30_wp ),                               &
-                                MIN( prt_y - pos_y_old, -1E-30_wp ),                               &
-                                prt_y > pos_y_old )
-          x_ind(t_index)   = i1
-          y_ind(t_index)   = j2
-          z_ind(t_index)   = k1
-          reach_x(t_index) = .FALSE.
-          reach_y(t_index) = .TRUE.
-          reach_z(t_index) = .FALSE.
-          IF ( t(t_index) <= 1.0_wp  .AND.  t(t_index) >= 0.0_wp )  THEN
-             t_index      = t_index + 1
-             cross_wall_y = .TRUE.
-          ENDIF
-!
-!--       z-direction
-          t(t_index) = (zwall - pos_z_old )                                                        &
-                       / MERGE( MAX( prt_z - pos_z_old,  1E-30_wp ),                               &
-                                MIN( prt_z - pos_z_old, -1E-30_wp ),                               &
-                                prt_z > pos_z_old )
-
-          x_ind(t_index)   = i1
-          y_ind(t_index)   = j1
-          z_ind(t_index)   = k2
-          reach_x(t_index) = .FALSE.
-          reach_y(t_index) = .FALSE.
-          reach_z(t_index) = .TRUE.
-          IF( t(t_index) <= 1.0_wp  .AND.  t(t_index) >= 0.0_wp)  THEN
-             t_index      = t_index + 1
-             cross_wall_z = .TRUE.
-          ENDIF
-
-          t_index_number = t_index - 1
-!
-!--       Carry out reflection only if particle reaches any wall
-          IF ( cross_wall_x  .OR.  cross_wall_y  .OR.  cross_wall_z )  THEN
-!
-!--          Sort fractional timesteps in ascending order. Also sort the corresponding indices and
-!--          flag according to the time interval a particle reaches the respective wall.
-             inc = 1
-             jr  = 1
-             DO WHILE ( inc <= t_index_number )
-                inc = 3 * inc + 1
-             ENDDO
-
-             DO WHILE ( inc > 1 )
-                inc = inc / 3
-                DO  ir = inc+1, t_index_number
-                   tmp_t       = t(ir)
-                   tmp_x       = x_ind(ir)
-                   tmp_y       = y_ind(ir)
-                   tmp_z       = z_ind(ir)
-                   tmp_reach_x = reach_x(ir)
-                   tmp_reach_y = reach_y(ir)
-                   tmp_reach_z = reach_z(ir)
-                   jr    = ir
-                   DO WHILE ( t(jr-inc) > tmp_t )
-                      t(jr)       = t(jr-inc)
-                      x_ind(jr)   = x_ind(jr-inc)
-                      y_ind(jr)   = y_ind(jr-inc)
-                      z_ind(jr)   = z_ind(jr-inc)
-                      reach_x(jr) = reach_x(jr-inc)
-                      reach_y(jr) = reach_y(jr-inc)
-                      reach_z(jr) = reach_z(jr-inc)
-                      jr    = jr - inc
-                      IF ( jr <= inc )  EXIT
-                   ENDDO
-                   t(jr)       = tmp_t
-                   x_ind(jr)   = tmp_x
-                   y_ind(jr)   = tmp_y
-                   z_ind(jr)   = tmp_z
-                   reach_x(jr) = tmp_reach_x
-                   reach_y(jr) = tmp_reach_y
-                   reach_z(jr) = tmp_reach_z
-                ENDDO
-             ENDDO
-!
-!--          Initialize temporary particle positions
-             pos_x = pos_x_old
-             pos_y = pos_y_old
-             pos_z = pos_z_old
-!
-!--          Loop over all times a particle possibly moves into a new grid box
-             t_old = 0.0_wp
-             DO t_index = 1, t_index_number
-!
-!--             Calculate intermediate particle position according to the timesteps a particle
-!--             reaches any wall.
-                pos_x = pos_x + ( t(t_index) - t_old ) * dt_particle * particles(n)%speed_x
-                pos_y = pos_y + ( t(t_index) - t_old ) * dt_particle * particles(n)%speed_y
-                pos_z = pos_z + ( t(t_index) - t_old ) * dt_particle * particles(n)%speed_z
-!
-!--             Obtain x/y grid indices for intermediate particle position from sorted index array
-                i3 = x_ind(t_index)
-                j3 = y_ind(t_index)
-                k3 = z_ind(t_index)
-!
-!--             Check which wall is already reached
-                IF ( .NOT. x_wall_reached )  x_wall_reached = reach_x(t_index)
-                IF ( .NOT. y_wall_reached )  y_wall_reached = reach_y(t_index)
-                IF ( .NOT. z_wall_reached )  z_wall_reached = reach_z(t_index)
-!
-!--             Check if a particle needs to be reflected at any yz-wall. If necessary, carry out
-!--             reflection. Please note, a security constant is required, as the particle position
-!--             does not necessarily exactly match the wall location due to rounding  errors.
-                IF ( reach_x(t_index)                            .AND.                             &
-                     ABS( pos_x - xwall ) < eps                  .AND.                             &
-                     .NOT. BTEST(wall_flags_total_0(k3,j3,i3),0) .AND.                             &
-                     .NOT. reflect_x )  THEN
-!
-!
-!--                Reflection in x-direction.
-!--                Ensure correct reflection by MIN/MAX functions, depending on direction of
-!--                particle transport.
-!--                Due to rounding errors pos_x does not exactly match the wall location, leading to
-!--                erroneous reflection.
-                   pos_x = MERGE( MIN( 2.0_wp * xwall - pos_x, xwall ),                            &
-                                  MAX( 2.0_wp * xwall - pos_x, xwall ),                            &
-                                  particles(n)%x > xwall )
-!
-!--                Change sign of particle speed
-                   particles(n)%speed_x = - particles(n)%speed_x
-!
-!--                Also change sign of subgrid-scale particle speed
-                   particles(n)%rvar1 = - particles(n)%rvar1
-!
-!--                Set flag that reflection along x is already done
-                   reflect_x          = .TRUE.
-!
-!--                As the particle does not cross any further yz-wall during this timestep, set
-!--                further x-indices to the current one.
-                   x_ind(t_index:t_index_number) = i1
-!
-!--             If particle already reached the wall but was not reflected, set further x-indices to
-!--             the new one.
-                ELSEIF ( x_wall_reached  .AND.  .NOT. reflect_x )  THEN
-                    x_ind(t_index:t_index_number) = i2
-                ENDIF  !particle reflection in x direction done
-
-!
-!--             Check if a particle needs to be reflected at any xz-wall. If necessary, carry out
-!--             reflection. Please note, a security constant is required, as the particle position
-!--             does not necessarily exactly match the wall location due to rounding errors.
-                IF ( reach_y(t_index)                            .AND.                             &
-                     ABS( pos_y - ywall ) < eps                  .AND.                             &
-                     .NOT. BTEST(wall_flags_total_0(k3,j3,i3),0) .AND.                             &
-                     .NOT. reflect_y )  THEN
-!
-!
-!--                Reflection in y-direction.
-!--                Ensure correct reflection by MIN/MAX functions, depending on direction of
-!--                particle transport.
-!--                Due to rounding errors pos_y does not exactly match the wall location, leading to
-!--                erroneous reflection.
-                   pos_y = MERGE( MIN( 2.0_wp * ywall - pos_y, ywall ),                            &
-                                  MAX( 2.0_wp * ywall - pos_y, ywall ),                            &
-                                  particles(n)%y > ywall )
-!
-!--                Change sign of particle speed
-                   particles(n)%speed_y = - particles(n)%speed_y
-!
-!--                Also change sign of subgrid-scale particle speed
-                   particles(n)%rvar2 = - particles(n)%rvar2
-!
-!--                Set flag that reflection along y is already done
-                   reflect_y          = .TRUE.
-!
-!--                As the particle does not cross any further xz-wall during this timestep, set
-!--                further y-indices to the current one.
-                   y_ind(t_index:t_index_number) = j1
-!
-!--             If particle already reached the wall but was not reflected, set further y-indices to
-!--             the new one.
-                ELSEIF ( y_wall_reached  .AND.  .NOT. reflect_y )  THEN
-                    y_ind(t_index:t_index_number) = j2
-                ENDIF  !particle reflection in y direction done
-
-!
-!--             Check if a particle needs to be reflected at any xy-wall. If necessary, carry out
-!--             reflection. Please note, a security constant is required, as the particle position
-!--             does not necessarily exactly match the wall location due to rounding errors.
-                IF ( reach_z(t_index)                            .AND.                             &
-                     ABS( pos_z - zwall ) < eps                  .AND.                             &
-                     .NOT. BTEST(wall_flags_total_0(k3,j3,i3),0) .AND.                             &
-                     .NOT. reflect_z )  THEN
-!
-!
-!--                Reflection in z-direction.
-!--                Ensure correct reflection by MIN/MAX functions, depending on direction of
-!--                particle transport.
-!--                Due to rounding errors pos_z does not exactly match the wall location, leading to
-!--                erroneous reflection.
-                   pos_z = MERGE( MIN( 2.0_wp * zwall - pos_z, zwall ),                            &
-                                  MAX( 2.0_wp * zwall - pos_z, zwall ),                            &
-                                  particles(n)%z > zwall )
-!
-!--                Change sign of particle speed
-                   particles(n)%speed_z = - particles(n)%speed_z
-!
-!--                Also change sign of subgrid-scale particle speed
-                   particles(n)%rvar3 = - particles(n)%rvar3
-!
-!--                Set flag that reflection along z is already done
-                   reflect_z          = .TRUE.
-!
-!--                As the particle does not cross any further xy-wall during this timestep, set
-!--                further z-indices to the current one.
-                   z_ind(t_index:t_index_number) = k1
-!
-!--             If particle already reached the wall but was not reflected, set further z-indices to
-!--             the new one.
-                ELSEIF ( z_wall_reached  .AND.  .NOT. reflect_z )  THEN
-                    z_ind(t_index:t_index_number) = k2
-                ENDIF  !particle reflection in z direction done
-
-!
-!--             Swap time
-                t_old = t(t_index)
-
-             ENDDO
-!
-!--          If a particle was reflected, calculate final position from last intermediate position.
-             IF ( reflect_x  .OR.  reflect_y  .OR.  reflect_z )  THEN
-
-                particles(n)%x = pos_x + ( 1.0_wp - t_old ) * dt_particle * particles(n)%speed_x
-                particles(n)%y = pos_y + ( 1.0_wp - t_old ) * dt_particle * particles(n)%speed_y
-                particles(n)%z = pos_z + ( 1.0_wp - t_old ) * dt_particle * particles(n)%speed_z
-
-             ENDIF
-
-          ENDIF
-
-       ENDDO
-
-       CALL cpu_log( log_point_s(48), 'lpm_wall_reflect', 'stop' )
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE lpm_boundary_conds
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates change in droplet radius by condensation/evaporation, using either an analytic formula
-!> or by numerically integrating the radius growth equation including curvature and solution effects
-!> using Rosenbrocks method (see Numerical recipes in FORTRAN, 2nd edition, p. 731).
-!> The analytical formula and growth equation follow those given in
-!> Rogers and Yau (A short course in cloud physics, 3rd edition, p. 102/103).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_droplet_condensation (i,j,k)
-
-!
-!-- Parameters for Rosenbrock method (see Verwer et al., 1999)
-    REAL(wp), PARAMETER ::  prec = 1.0E-3_wp     !< precision of Rosenbrock solution
-    REAL(wp), PARAMETER ::  q_increase = 1.5_wp  !< increase factor in timestep
-    REAL(wp), PARAMETER ::  q_decrease = 0.9_wp  !< decrease factor in timestep
-    REAL(wp), PARAMETER ::  gamma = 0.292893218814_wp !< = 1.0 - 1.0 / SQRT(2.0)
-!
-!-- Parameters for terminal velocity
-    REAL(wp), PARAMETER ::  a_rog = 9.65_wp      !< parameter for fall velocity
-    REAL(wp), PARAMETER ::  b_rog = 10.43_wp     !< parameter for fall velocity
-    REAL(wp), PARAMETER ::  c_rog = 0.6_wp       !< parameter for fall velocity
-    REAL(wp), PARAMETER ::  k_cap_rog = 4.0_wp   !< parameter for fall velocity
-    REAL(wp), PARAMETER ::  k_low_rog = 12.0_wp  !< parameter for fall velocity
-    REAL(wp), PARAMETER ::  d0_rog = 0.745_wp    !< separation diameter
-
-    INTEGER(iwp), INTENT(IN) ::  i              !<
-    INTEGER(iwp), INTENT(IN) ::  j              !<
-    INTEGER(iwp), INTENT(IN) ::  k              !<
-    INTEGER(iwp)             ::  n              !<
-
-    REAL(wp) ::  afactor                       !< curvature effects
-    REAL(wp) ::  arg                           !<
-    REAL(wp) ::  bfactor                       !< solute effects
-    REAL(wp) ::  ddenom                        !<
-    REAL(wp) ::  delta_r                       !<
-    REAL(wp) ::  diameter                      !< diameter of cloud droplets
-    REAL(wp) ::  diff_coeff                    !< diffusivity for water vapor
-    REAL(wp) ::  drdt                          !<
-    REAL(wp) ::  dt_ros                        !<
-    REAL(wp) ::  dt_ros_sum                    !<
-    REAL(wp) ::  d2rdtdr                       !<
-    REAL(wp) ::  e_a                           !< current vapor pressure
-    REAL(wp) ::  e_s                           !< current saturation vapor pressure
-    REAL(wp) ::  error                         !< local truncation error in Rosenbrock
-    REAL(wp) ::  k1                            !<
-    REAL(wp) ::  k2                            !<
-    REAL(wp) ::  r_err                         !< First order estimate of Rosenbrock radius
-    REAL(wp) ::  r_ros                         !< Rosenbrock radius
-    REAL(wp) ::  r_ros_ini                     !< initial Rosenbrock radius
-    REAL(wp) ::  r0                            !< gas-kinetic lengthscale
-    REAL(wp) ::  re_p                          !< particle Reynolds number
-    REAL(wp) ::  sigma                         !< surface tension of water
-    REAL(wp) ::  thermal_conductivity          !< thermal conductivity for water
-    REAL(wp) ::  t_int                         !< temperature
-    REAL(wp) ::  w_s                           !< terminal velocity of droplets
-
-    REAL(wp), DIMENSION(number_of_particles) ::  new_r                  !<
-    REAL(wp), DIMENSION(number_of_particles) ::  ventilation_effect     !<
-
-    CALL cpu_log( log_point_s(42), 'lpm_droplet_condens', 'start' )
-
-!
-!-- Absolute temperature
-    t_int = pt(k,j,i) * exner(k)
-!
-!-- Saturation vapor pressure (Eq. 10 in Bolton, 1980)
-    e_s = magnus( t_int )
-!
-!-- Current vapor pressure
-    e_a = q(k,j,i) * hyp(k) / ( q(k,j,i) + rd_d_rv )
-!
-!-- Thermal conductivity for water (from Rogers and Yau, Table 7.1)
-    thermal_conductivity = 7.94048E-05_wp * t_int + 0.00227011_wp
-!
-!-- Moldecular diffusivity of water vapor in air (Hall und Pruppacher, 1976)
-    diff_coeff           = 0.211E-4_wp * ( t_int / 273.15_wp )**1.94_wp * ( 101325.0_wp / hyp(k) )
-!
-!-- Lengthscale for gas-kinetic effects (from Mordy, 1959, p. 23):
-    r0 = diff_coeff / 0.036_wp * SQRT( 2.0_wp * pi / ( r_v * t_int ) )
-!
-!-- Calculate effects of heat conductivity and diffusion of water vapor on the
-!-- diffusional growth process (usually known as 1.0 / (F_k + F_d) )
-    ddenom  = 1.0_wp / ( rho_l * r_v * t_int / ( e_s * diff_coeff ) +                              &
-                         ( l_v / ( r_v * t_int ) - 1.0_wp ) * rho_l *                              &
-                         l_v / ( thermal_conductivity * t_int )                                    &
-                       )
-    new_r = 0.0_wp
-!
-!-- Determine ventilation effect on evaporation of large drops
-    DO  n = 1, number_of_particles
-
-       IF ( particles(n)%radius >= 4.0E-5_wp  .AND.  e_a / e_s < 1.0_wp )  THEN
-!
-!--       Terminal velocity is computed for vertical direction (Rogers et al.,
-!--       1993, J. Appl. Meteorol.)
-          diameter = particles(n)%radius * 2000.0_wp  !diameter in mm
-          IF ( diameter <= d0_rog )  THEN
-             w_s = k_cap_rog * diameter * ( 1.0_wp - EXP( -k_low_rog * diameter ) )
-          ELSE
-             w_s = a_rog - b_rog * EXP( -c_rog * diameter )
-          ENDIF
-!
-!--       Calculate droplet's Reynolds number
-          re_p = 2.0_wp * particles(n)%radius * w_s / molecular_viscosity
-!
-!--       Ventilation coefficient (Rogers and Yau, 1989):
-          IF ( re_p > 2.5_wp )  THEN
-             ventilation_effect(n) = 0.78_wp + 0.28_wp * SQRT( re_p )
-          ELSE
-             ventilation_effect(n) = 1.0_wp + 0.09_wp * re_p
-          ENDIF
-       ELSE
-!
-!--       For small droplets or in supersaturated environments, the ventilation effect does not play
-!--       a role.
-          ventilation_effect(n) = 1.0_wp
-       ENDIF
-    ENDDO
-
-    IF( .NOT. curvature_solution_effects )  THEN
-!
-!--    Use analytic model for diffusional growth including gas-kinetic effects (Mordy, 1959) but
-!--    without the impact of aerosols.
-       DO  n = 1, number_of_particles
-          arg      = ( particles(n)%radius + r0 )**2 + 2.0_wp * dt_3d * ddenom *                   &
-                                                       ventilation_effect(n)   *                   &
-                                                       ( e_a / e_s - 1.0_wp )
-          arg      = MAX( arg, ( 0.01E-6 + r0 )**2 )
-          new_r(n) = SQRT( arg ) - r0
-       ENDDO
-
-    ELSE
-!
-!--    Integrate the diffusional growth including gas-kinetic (Mordy, 1959),
-!--    as well as curvature and solute effects (e.g., KÃ¶hler, 1936).
-!
-!--    Curvature effect (afactor) with surface tension (sigma) by Straka (2009)
-       sigma = 0.0761_wp - 0.000155_wp * ( t_int - 273.15_wp )
-!
-!--    Solute effect (afactor)
-       afactor = 2.0_wp * sigma / ( rho_l * r_v * t_int )
-
-       DO  n = 1, number_of_particles
-!
-!--       Solute effect (bfactor)
-          bfactor = vanthoff * rho_s * particles(n)%aux1**3 *                                      &
-                    molecular_weight_of_water / ( rho_l * molecular_weight_of_solute )
-
-          dt_ros     = particles(n)%aux2  ! use previously stored Rosenbrock timestep
-          dt_ros_sum = 0.0_wp
-
-          r_ros     = particles(n)%radius  ! initialize Rosenbrock particle radius
-          r_ros_ini = r_ros
-!
-!--       Integrate growth equation using a 2nd-order Rosenbrock method
-!--       (see Verwer et al., 1999, Eq. (3.2)). The Rosenbrock method adjusts its with internal
-!--       timestep to minimize the local truncation error.
-          DO WHILE ( dt_ros_sum < dt_3d )
-
-             dt_ros = MIN( dt_ros, dt_3d - dt_ros_sum )
-
-             DO
-
-                drdt = ddenom * ventilation_effect(n) * ( e_a / e_s - 1.0_wp -                     &
-                                                          afactor / r_ros +                        &
-                                                          bfactor / r_ros**3                       &
-                                                        ) / ( r_ros + r0 )
-
-                d2rdtdr = -ddenom * ventilation_effect(n) *  (                                     &
-                                            ( e_a / e_s - 1.0_wp ) * r_ros**4 -                    &
-                                            afactor * r0 * r_ros**2 -                              &
-                                            2.0_wp * afactor * r_ros**3 +                          &
-                                            3.0_wp * bfactor * r0 +                                &
-                                            4.0_wp * bfactor * r_ros                               &
-                                                             )                                     &
-                          / ( r_ros**4 * ( r_ros + r0 )**2 )
-
-                k1    = drdt / ( 1.0_wp - gamma * dt_ros * d2rdtdr )
-
-                r_ros = MAX(r_ros_ini + k1 * dt_ros, particles(n)%aux1)
-                r_err = r_ros
-
-                drdt  = ddenom * ventilation_effect(n) * ( e_a / e_s - 1.0_wp -                    &
-                                                           afactor / r_ros +                       &
-                                                           bfactor / r_ros**3                      &
-                                                         ) / ( r_ros + r0 )
-
-                k2 = ( drdt - dt_ros * 2.0 * gamma * d2rdtdr * k1 ) /                              &
-                     ( 1.0_wp - dt_ros * gamma * d2rdtdr )
-
-                r_ros = MAX(r_ros_ini + dt_ros * ( 1.5_wp * k1 + 0.5_wp * k2), particles(n)%aux1)
-!
-!--             Check error of the solution, and reduce dt_ros if necessary.
-                error = ABS(r_err - r_ros) / r_ros
-                IF ( error > prec )  THEN
-                   dt_ros = SQRT( q_decrease * prec / error ) * dt_ros
-                   r_ros  = r_ros_ini
-                ELSE
-                   dt_ros_sum = dt_ros_sum + dt_ros
-                   dt_ros     = q_increase * dt_ros
-                   r_ros_ini  = r_ros
-                   EXIT
-                ENDIF
-
-             END DO
-
-          END DO  !Rosenbrock loop
-!
-!--       Store new particle radius
-          new_r(n) = r_ros
-!
-!--       Store internal time step value for next PALM step
-          particles(n)%aux2 = dt_ros
-
-       ENDDO !Particle loop
-
-    ENDIF
-
-    DO  n = 1, number_of_particles
-!
-!--    Sum up the change in liquid water for the respective grid box for the computation of the
-!--    release/depletion of water vapor and heat.
-       ql_c(k,j,i) = ql_c(k,j,i) + particles(n)%weight_factor *                                    &
-                                   rho_l * 1.33333333_wp * pi *                                    &
-                                   ( new_r(n)**3 - particles(n)%radius**3 ) /                      &
-                                   ( rho_surface * dx * dy * dzw(k) )
-!
-!--    Check if the increase in liqid water is not too big. If this is the case, the model timestep
-!--    might be too long.
-       IF ( ql_c(k,j,i) > 100.0_wp )  THEN
-          WRITE( message_string, * ) 'k=',k,' j=',j,' i=',i,                                       &
-                                     ' ql_c=',ql_c(k,j,i), '&part(',n,')%wf=',                     &
-                                     particles(n)%weight_factor,' delta_r=',delta_r
-          CALL message( 'lpm_droplet_condensation', 'PA0143', 2, 2, -1, 6, 1 )
-       ENDIF
-!
-!--    Check if the change in the droplet radius is not too big. If this is the case, the model
-!--    timestep might be too long.
-       delta_r = new_r(n) - particles(n)%radius
-       IF ( delta_r < 0.0_wp  .AND.  new_r(n) < 0.0_wp )  THEN
-          WRITE( message_string, * ) '#1 k=',k,' j=',j,' i=',i,                                    &
-                                     ' e_s=',e_s, ' e_a=',e_a,' t_int=',t_int,                     &
-                                     '&delta_r=',delta_r,                                          &
-                                     ' particle_radius=',particles(n)%radius
-          CALL message( 'lpm_droplet_condensation', 'PA0144', 2, 2, -1, 6, 1 )
-       ENDIF
-!
-!--    Sum up the total volume of liquid water (needed below for re-calculating the weighting
-!--    factors)
-       ql_v(k,j,i) = ql_v(k,j,i) + particles(n)%weight_factor * new_r(n)**3
-!
-!--    Determine radius class of the particle needed for collision
-       IF ( use_kernel_tables )  THEN
-          particles(n)%class = ( LOG( new_r(n) ) - rclass_lbound ) /                               &
-                               ( rclass_ubound - rclass_lbound ) * radius_classes
-          particles(n)%class = MIN( particles(n)%class, radius_classes )
-          particles(n)%class = MAX( particles(n)%class, 1 )
-       ENDIF
-!
-!--    Store new radius to particle features
-       particles(n)%radius = new_r(n)
-
-    ENDDO
-
-    CALL cpu_log( log_point_s(42), 'lpm_droplet_condens', 'stop' )
-
-
- END SUBROUTINE lpm_droplet_condensation
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Release of latent heat and change of mixing ratio due to condensation / evaporation of droplets.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_interaction_droplets_ptq
-
-    INTEGER(iwp) ::  i    !< running index x direction
-    INTEGER(iwp) ::  j    !< running index y direction
-    INTEGER(iwp) ::  k    !< running index z direction
-
-    REAL(wp) ::  flag     !< flag to mask topography grid points
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-!
-!--          Predetermine flag to mask topography
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-             q(k,j,i)  = q(k,j,i)  - ql_c(k,j,i) * flag
-             pt(k,j,i) = pt(k,j,i) + lv_d_cp * ql_c(k,j,i) * d_exner(k) * flag
-          ENDDO
-       ENDDO
-    ENDDO
-
- END SUBROUTINE lpm_interaction_droplets_ptq
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Release of latent heat and change of mixing ratio due to condensation / evaporation of droplets.
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-!  SUBROUTINE lpm_interaction_droplets_ptq_ij( i, j )
-!
-!     INTEGER(iwp) ::  i    !< running index x direction
-!     INTEGER(iwp) ::  j    !< running index y direction
-!     INTEGER(iwp) ::  k    !< running index z direction
-!
-!     REAL(wp) ::  flag     !< flag to mask topography grid points
-!
-!
-!     DO  k = nzb+1, nzt
-! !
-! !--    Predetermine flag to mask topography
-!        flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!        q(k,j,i)  = q(k,j,i)  - ql_c(k,j,i) * flag
-!        pt(k,j,i) = pt(k,j,i) + lv_d_cp * ql_c(k,j,i) * d_exner(k) * flag
-!     ENDDO
-!
-!  END SUBROUTINE lpm_interaction_droplets_ptq_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the liquid water content for each grid box.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_calc_liquid_water_content
-
-
-    INTEGER(iwp) ::  i   !<
-    INTEGER(iwp) ::  j   !<
-    INTEGER(iwp) ::  k   !<
-    INTEGER(iwp) ::  n   !<
-
-    CALL cpu_log( log_point_s(45), 'lpm_calc_ql', 'start' )
-
-!
-!-- Set water content initially to zero
-    ql = 0.0_wp;  ql_v = 0.0_wp;  ql_vp = 0.0_wp
-
-!
-!-- Calculate for each grid box
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             number_of_particles = prt_count(k,j,i)
-             IF ( number_of_particles <= 0 )  CYCLE
-             particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-!
-!--          Calculate the total volume in the boxes (ql_v, weighting factor has to beincluded)
-             DO  n = 1, prt_count(k,j,i)
-                ql_v(k,j,i)  = ql_v(k,j,i)  + particles(n)%weight_factor * particles(n)%radius**3
-             ENDDO
-!
-!--          Calculate the liquid water content
-             IF ( ql_v(k,j,i) /= 0.0_wp )  THEN
-                ql(k,j,i) = ql(k,j,i) + rho_l * 1.33333333_wp * pi *                               &
-                                        ql_v(k,j,i) / ( rho_surface * dx * dy * dzw(k) )
-                IF ( ql(k,j,i) < 0.0_wp )  THEN
-                   WRITE( message_string, * )  'LWC out of range: ' , ql(k,j,i),i,j,k
-                   CALL message( 'lpm_calc_liquid_water_content', 'PA0719', 2, 2, -1, 6, 1 )
-                ENDIF
-             ELSE
-                ql(k,j,i) = 0.0_wp
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL cpu_log( log_point_s(45), 'lpm_calc_ql', 'stop' )
-
- END SUBROUTINE lpm_calc_liquid_water_content
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates change in droplet radius by collision. Droplet collision is calculated for each grid
-!> box seperately. Collision is parameterized by using collision kernels. Two different kernels are
-!> available:
-!> Hall kernel: Kernel from Hall (1980, J. Atmos. Sci., 2486-2507), which considers collision due to
-!>              pure gravitational effects.
-!> Wang kernel: Beside gravitational effects (treated with the Hall-kernel) also the effects of
-!>              turbulence on the collision are considered using parameterizations of Ayala et al.
-!>              (2008, New J. Phys., 10, 075015) and Wang and Grabowski (2009, Atmos. Sci. Lett.,
-!>              10, 1-8). This kernel includes three possible effects of turbulence:
-!>              the modification of the relative velocity between the droplets,
-!>              the effect of preferential concentration,
-!>              and the enhancement of collision efficiencies.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_droplet_collision (i,j,k)
-
-    INTEGER(iwp), INTENT(IN) ::  i        !<
-    INTEGER(iwp), INTENT(IN) ::  j        !<
-    INTEGER(iwp), INTENT(IN) ::  k        !<
-
-    INTEGER(iwp) ::  eclass   !<
-    INTEGER(iwp) ::  n        !<
-    INTEGER(iwp) ::  m        !<
-    INTEGER(iwp) ::  rclass_l !<
-    INTEGER(iwp) ::  rclass_s !<
-
-    REAL(wp) ::  collection_probability  !< probability for collection
-    REAL(wp) ::  ddV                     !< inverse grid box volume
-    REAL(wp) ::  epsilon_collision       !< dissipation rate
-    REAL(wp) ::  factor_volume_to_mass   !< 4.0 / 3.0 * pi * rho_l
-    REAL(wp) ::  xm                      !< droplet mass of super-droplet m
-    REAL(wp) ::  xn                      !< droplet mass of super-droplet n
-    REAL(wp) ::  xsm                     !< aerosol mass of super-droplet m
-    REAL(wp) ::  xsn                     !< aerosol mass of super-droplet n
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  aero_mass !< total aerosol mass of super droplet
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mass      !< total mass of super droplet
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  weight    !< weighting factor
-
-    CALL cpu_log( log_point_s(43), 'lpm_droplet_coll', 'start' )
-
-    number_of_particles   = prt_count(k,j,i)
-    factor_volume_to_mass = 4.0_wp / 3.0_wp * pi * rho_l
-    ddV                   = 1.0_wp / ( dx * dy * dzw(k) )
-!
-!-- Collision requires at least one super droplet inside the box
-    IF ( number_of_particles > 0 )  THEN
-
-       IF ( use_kernel_tables )  THEN
-!
-!--       Fast method with pre-calculated collection kernels for discrete radius- and
-!--       dissipation-classes.
-          IF ( wang_kernel )  THEN
-             eclass = INT( diss(k,j,i) * 1.0E4_wp / 600.0_wp * dissipation_classes ) + 1
-             epsilon_collision = diss(k,j,i)
-          ELSE
-             epsilon_collision = 0.0_wp
-          ENDIF
-
-          IF ( hall_kernel  .OR.  epsilon_collision * 1.0E4_wp < 0.001_wp )  THEN
-             eclass = 0   ! Hall kernel is used
-          ELSE
-             eclass = MIN( dissipation_classes, eclass )
-          ENDIF
-
-       ELSE
-!
-!--       Collection kernels are re-calculated for every new grid box. First, allocate memory for
-!--       kernel table.
-!--       Third dimension is 1, because table is re-calculated for every new dissipation value.
-          ALLOCATE( ckernel(1:number_of_particles,1:number_of_particles,1:1) )
-!
-!--       Now calculate collection kernel for this box. Note that the kernel is based on the
-!--       previous time step
-          CALL recalculate_kernel( i, j, k )
-
-       ENDIF
-!
-!--    Temporary fields for total mass of super-droplet, aerosol mass, and weighting factor are
-!--    allocated.
-       ALLOCATE(mass(1:number_of_particles), weight(1:number_of_particles))
-       IF ( curvature_solution_effects )  ALLOCATE(aero_mass(1:number_of_particles))
-
-       mass(1:number_of_particles)   = particles(1:number_of_particles)%weight_factor *            &
-                                       particles(1:number_of_particles)%radius**3     *            &
-                                       factor_volume_to_mass
-
-       weight(1:number_of_particles) = particles(1:number_of_particles)%weight_factor
-
-       IF ( curvature_solution_effects )  THEN
-          aero_mass(1:number_of_particles) = particles(1:number_of_particles)%weight_factor *      &
-                                             particles(1:number_of_particles)%aux1**3       *      &
-                                             4.0_wp / 3.0_wp * pi * rho_s
-       ENDIF
-!
-!--    Calculate collision/coalescence
-       DO  n = 1, number_of_particles
-
-          DO  m = n, number_of_particles
-!
-!--          For collisions, the weighting factor of at least one super-droplet needs to be larger
-!--          or equal to one.
-             IF ( MIN( weight(n), weight(m) ) < 1.0_wp )  CYCLE
-!
-!--          Get mass of individual droplets (aerosols)
-             xn = mass(n) / weight(n)
-             xm = mass(m) / weight(m)
-             IF ( curvature_solution_effects )  THEN
-                xsn = aero_mass(n) / weight(n)
-                xsm = aero_mass(m) / weight(m)
-             ENDIF
-!
-!--          Probability that the necessary collisions take place
-             IF ( use_kernel_tables )  THEN
-                rclass_l = particles(n)%class
-                rclass_s = particles(m)%class
-
-                collection_probability  = MAX( weight(n), weight(m) ) *                            &
-                                          ckernel(rclass_l,rclass_s,eclass) * ddV * dt_3d
-             ELSE
-                collection_probability  = MAX( weight(n), weight(m) ) *                            &
-                                          ckernel(n,m,1) * ddV * dt_3d
-             ENDIF
-!
-!--          Calculate the number of collections and consider multiple collections.
-!--          (Accordingly, p_crit will be 0.0, 1.0, 2.0, ...)
-             CALL random_number_parallel( random_dummy )
-             IF ( collection_probability - FLOOR(collection_probability) > random_dummy )  THEN
-                collection_probability = FLOOR(collection_probability) + 1.0_wp
-             ELSE
-                collection_probability = FLOOR(collection_probability)
-             ENDIF
-
-             IF ( collection_probability > 0.0_wp )  THEN
-!
-!--             Super-droplet n collects droplets of super-droplet m
-                IF ( weight(n) < weight(m) )  THEN
-
-                   mass(n)   = mass(n)   + weight(n) * xm * collection_probability
-                   weight(m) = weight(m) - weight(n)      * collection_probability
-                   mass(m)   = mass(m)   - weight(n) * xm * collection_probability
-                   IF ( curvature_solution_effects )  THEN
-                      aero_mass(n) = aero_mass(n) + weight(n) * xsm * collection_probability
-                      aero_mass(m) = aero_mass(m) - weight(n) * xsm * collection_probability
-                   ENDIF
-
-                ELSEIF ( weight(m) < weight(n) )  THEN
-
-                   mass(m)   = mass(m)   + weight(m) * xn * collection_probability
-                   weight(n) = weight(n) - weight(m)      * collection_probability
-                   mass(n)   = mass(n)   - weight(m) * xn * collection_probability
-                   IF ( curvature_solution_effects )  THEN
-                      aero_mass(m) = aero_mass(m) + weight(m) * xsn * collection_probability
-                      aero_mass(n) = aero_mass(n) - weight(m) * xsn * collection_probability
-                   ENDIF
-
-                ELSE
-!
-!--                Collisions of particles of the same weighting factor.
-!--                Particle n collects 1/2 weight(n) droplets of particle m,
-!--                particle m collects 1/2 weight(m) droplets of particle n.
-!--                The total mass mass changes accordingly.
-!--                If n = m, the first half of the droplets coalesces with the second half of the
-!--                droplets; mass is unchanged because xm = xn for n = m.
-!--
-!--                Note: For m = n this equation is an approximation only valid for weight >> 1
-!--                (which is usually the case). The approximation is weight(n)-1 = weight(n).
-                   mass(n)   = mass(n)   + 0.5_wp * weight(n) * ( xm - xn )
-                   mass(m)   = mass(m)   + 0.5_wp * weight(m) * ( xn - xm )
-                   IF ( curvature_solution_effects )  THEN
-                      aero_mass(n) = aero_mass(n) + 0.5_wp * weight(n) * ( xsm - xsn )
-                      aero_mass(m) = aero_mass(m) + 0.5_wp * weight(m) * ( xsn - xsm )
-                   ENDIF
-                   weight(n) = weight(n) - 0.5_wp * weight(m)
-                   weight(m) = weight(n)
-
-                ENDIF
-
-             ENDIF
-
-          ENDDO
-
-          ql_vp(k,j,i) = ql_vp(k,j,i) + mass(n) / factor_volume_to_mass
-
-       ENDDO
-
-       IF ( ANY(weight < 0.0_wp) )  THEN
-             WRITE( message_string, * ) 'negative weighting factor'
-             CALL message( 'lpm_droplet_collision', 'PA0028', 2, 2, -1, 6, 1 )
-       ENDIF
-
-       particles(1:number_of_particles)%radius = ( mass(1:number_of_particles) /                   &
-                                                    ( weight(1:number_of_particles)                &
-                                                      * factor_volume_to_mass                      &
-                                                    )                                              &
-                                                 )**0.33333333333333_wp
-
-       IF ( curvature_solution_effects )  THEN
-          particles(1:number_of_particles)%aux1 = ( aero_mass(1:number_of_particles) /             &
-                                                     ( weight(1:number_of_particles)               &
-                                                       * 4.0_wp / 3.0_wp * pi * rho_s              &
-                                                     )                                             &
-                                                  )**0.33333333333333_wp
-       ENDIF
-
-       particles(1:number_of_particles)%weight_factor = weight(1:number_of_particles)
-
-       DEALLOCATE( weight, mass )
-       IF ( curvature_solution_effects )  DEALLOCATE( aero_mass )
-       IF ( .NOT. use_kernel_tables )  DEALLOCATE( ckernel )
-
-!
-!--    Check if LWC is conserved during collision process
-       IF ( ql_v(k,j,i) /= 0.0_wp )  THEN
-          IF ( ql_vp(k,j,i) / ql_v(k,j,i) >= 1.0001_wp  .OR.                                       &
-               ql_vp(k,j,i) / ql_v(k,j,i) <= 0.9999_wp )  THEN
-             WRITE( message_string, * ) ' LWC is not conserved during',' collision! ',             &
-                                        ' LWC after condensation: ', ql_v(k,j,i),                  &
-                                        ' LWC after collision: ', ql_vp(k,j,i)
-             CALL message( 'lpm_droplet_collision', 'PA0040', 2, 2, -1, 6, 1 )
-          ENDIF
-       ENDIF
-
-    ENDIF
-
-    CALL cpu_log( log_point_s(43), 'lpm_droplet_coll', 'stop' )
-
- END SUBROUTINE lpm_droplet_collision
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the collision efficiency matrix with fixed radius and dissipation classes,
-!> calculated at simulation start only.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_init_kernels
-
-    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_collision = epsclass(k)
-          urms    = 2.02_wp * ( epsilon_collision / 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 lpm_init_kernels
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of collision kernels during each timestep and for each grid box
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE recalculate_kernel( i1, j1, k1 )
-
-
-    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_collision = diss(k1,j1,i1)   ! dissipation rate in m**2/s**3
-    ELSE
-       epsilon_collision = 0.0_wp
-    ENDIF
-    urms    = 2.02_wp * ( epsilon_collision / 0.04_wp )**( 0.33333333333_wp )
-
-    IF ( wang_kernel  .AND.  epsilon_collision > 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
-
-    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_collision )
-    lambda_re = urms**2 * SQRT( 15.0_wp / epsilon_collision / molecular_viscosity )
-    tl        = urms**2 / epsilon_collision
-    lf        = 0.5_wp * urms**3 / epsilon_collision
-    tauk      = SQRT( molecular_viscosity / epsilon_collision )
-    eta       = ( molecular_viscosity**3 / epsilon_collision )**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
-
-
-    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
-
-    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
-
-    INTEGER(iwp) ::  j                            !<
-
-    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), PARAMETER ::  k_cap_rog = 4.0_wp    !< parameter
-    REAL(wp), PARAMETER ::  k_low_rog = 12.0_wp   !< parameter
-
-    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
-
-    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 = MAX( ira(i), 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
-
-    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 = MAX( ira(i), 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_collision <= 0.01_wp )  THEN
-             ecf(j,i) =   ( epsilon_collision - 0.01_wp ) / ( 0.0_wp  - 0.01_wp ) * y1             &
-                        + ( epsilon_collision - 0.0_wp  ) / ( 0.01_wp - 0.0_wp  ) * y2
-          ELSEIF ( epsilon_collision <= 0.06_wp )  THEN
-             ecf(j,i) =   ( epsilon_collision - 0.04_wp ) / ( 0.01_wp - 0.04_wp ) * y2             &
-                        + ( epsilon_collision - 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
-
-
- !-------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! This routine is a part of the Lagrangian particle model. Super droplets which fulfill certain
-! criterion's (e.g. a big weighting factor and a large radius) can be split into several super
-! droplets with a reduced number of represented particles of every super droplet. This mechanism
-! ensures an improved representation of the right tail of the drop size distribution with a feasible
-! amount of computational costs. The limits of particle creation should be chosen carefully! The
-! idea of this algorithm is based on Unterstrasser and Soelch, 2014.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_splitting
-
-    INTEGER(iwp), PARAMETER ::  n_max = 100 !< number of radii bin for splitting functions
-
-    INTEGER(iwp) ::  i                !<
-    INTEGER(iwp) ::  j                !<
-    INTEGER(iwp) ::  jpp              !<
-    INTEGER(iwp) ::  k                !<
-    INTEGER(iwp) ::  n                !<
-    INTEGER(iwp) ::  new_particles_gb !< counter of created particles within one grid box
-    INTEGER(iwp) ::  new_size         !< new particle array size
-    INTEGER(iwp) ::  np               !<
-    INTEGER(iwp) ::  old_size         !< old particle array size
-
-    LOGICAL ::  first_loop_stride_sp = .TRUE. !< flag to calculate constants only once
-
-    REAL(wp) ::  diameter                 !< diameter of droplet
-    REAL(wp) ::  dlog                     !< factor for DSD calculation
-    REAL(wp) ::  factor_volume_to_mass    !< pre calculate factor volume to mass
-    REAL(wp) ::  lambda                   !< slope parameter of gamma-distribution
-    REAL(wp) ::  lwc                      !< liquid water content of grid box
-    REAL(wp) ::  lwc_total                !< average liquid water content of cloud
-    REAL(wp) ::  m1                       !< first moment of DSD
-    REAL(wp) ::  m1_total                 !< average over all PEs of first moment of DSD
-    REAL(wp) ::  m2                       !< second moment of DSD
-    REAL(wp) ::  m2_total                 !< average average over all PEs second moment of DSD
-    REAL(wp) ::  m3                       !< third moment of DSD
-    REAL(wp) ::  m3_total                 !< average average over all PEs third moment of DSD
-    REAL(wp) ::  mu                       !< spectral shape parameter of gamma distribution
-    REAL(wp) ::  nrclgb                   !< number of cloudy grid boxes (ql >= 1.0E-5 kg/kg)
-    REAL(wp) ::  nrclgb_total             !< average over all PEs of number of cloudy grid boxes
-    REAL(wp) ::  nr                       !< number concentration of cloud droplets
-    REAL(wp) ::  nr_total                 !< average over all PEs of number of cloudy grid boxes
-    REAL(wp) ::  nr0                      !< intercept parameter of gamma distribution
-    REAL(wp) ::  pirho_l                  !< pi * rho_l / 6.0
-    REAL(wp) ::  ql_crit = 1.0E-5_wp      !< threshold lwc for cloudy grid cells (Siebesma et al 2003, JAS, 60)
-    REAL(wp) ::  rm                       !< volume averaged mean radius
-    REAL(wp) ::  rm_total                 !< average over all PEs of volume averaged mean radius
-    REAL(wp) ::  r_min = 1.0E-6_wp        !< minimum radius of approximated spectra
-    REAL(wp) ::  r_max = 1.0E-3_wp        !< maximum radius of approximated spectra
-    REAL(wp) ::  sigma_log = 1.5_wp       !< standard deviation of the LOG-distribution
-    REAL(wp) ::  zeta                     !< Parameter for DSD calculation of Seifert
-
-    REAL(wp), DIMENSION(0:n_max-1) ::  an_spl     !< size dependent critical weight factor
-    REAL(wp), DIMENSION(0:n_max-1) ::  r_bin_mid  !< mass weighted mean radius of a bin
-    REAL(wp), DIMENSION(0:n_max)   ::  r_bin      !< boundaries of a radius bin
-
-    TYPE(particle_type) ::  tmp_particle   !< temporary particle TYPE
-
-    CALL cpu_log( log_point_s(80), 'lpm_splitting', 'start' )
-
-    IF ( first_loop_stride_sp )  THEN
-       IF ( i_splitting_mode == 2  .OR.  i_splitting_mode == 3 )  THEN
-          dlog   = ( LOG10(r_max) - LOG10(r_min) ) / ( n_max - 1 )
-          DO  i = 0, n_max-1
-             r_bin(i) = 10.0_wp**( LOG10(r_min) + i * dlog - 0.5_wp * dlog )
-             r_bin_mid(i) = 10.0_wp**( LOG10(r_min) + i * dlog )
-          ENDDO
-          r_bin(n_max) = 10.0_wp**( LOG10(r_min) + n_max * dlog - 0.5_wp * dlog )
-       ENDIF
-       factor_volume_to_mass =  4.0_wp / 3.0_wp * pi * rho_l
-       pirho_l  = pi * rho_l / 6.0_wp
-       IF ( weight_factor_split == -1.0_wp )  THEN
-          weight_factor_split = 0.1_wp * initial_weighting_factor
-       ENDIF
-    ENDIF
-
-
-    IF ( i_splitting_mode == 1 )  THEN
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-
-                new_particles_gb = 0
-                number_of_particles = prt_count(k,j,i)
-                IF ( number_of_particles <= 0  .OR.  ql(k,j,i) < ql_crit )  CYCLE
-                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-!
-!--             Start splitting operations. Each particle is checked if it fulfilled the splitting
-!--             criterion's. In splitting mode 'const' a critical radius  (radius_split) a critical
-!--             weighting factor (weight_factor_split) and a splitting factor (splitting_factor)
-!--             must be prescribed (see particle_parameters). Super droplets which have a larger
-!--             radius and larger weighting factor are split into 'splitting_factor' super droplets.
-!--             Therefore, the weighting factor of the super droplet and all created clones is
-!--             reduced by the factor of 'splitting_factor'.
-                DO  n = 1, number_of_particles
-                   IF ( particles(n)%particle_mask           .AND.                                 &
-                        particles(n)%radius >= radius_split  .AND.                                 &
-                        particles(n)%weight_factor >= weight_factor_split )                        &
-                   THEN
-!
-!--                   Calculate the new number of particles.
-                      new_size = prt_count(k,j,i) + splitting_factor - 1
-!
-!--                   Cycle if maximum number of particles per grid box is greater than the allowed
-!--                   maximum number.
-                      IF ( new_size >= max_number_particles_per_gridbox )  CYCLE
-!
-!--                   Reallocate particle array if necessary.
-                      IF ( new_size > SIZE( particles ) )  THEN
-                         CALL realloc_particles_array( i, j, k, new_size )
-                      ENDIF
-                      old_size = prt_count(k,j,i)
-!
-!--                   Calculate new weighting factor.
-                      particles(n)%weight_factor = particles(n)%weight_factor / splitting_factor
-                      tmp_particle = particles(n)
-!
-!--                   Create splitting_factor-1 new particles.
-                      DO  jpp = 1, splitting_factor-1
-                         grid_particles(k,j,i)%particles(jpp+old_size) = tmp_particle
-                      ENDDO
-                      new_particles_gb = new_particles_gb + splitting_factor - 1
-!
-!--                   Save the new number of super droplets for every grid box.
-                      prt_count(k,j,i) = prt_count(k,j,i) + splitting_factor - 1
-                   ENDIF
-                ENDDO
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ELSEIF ( i_splitting_mode == 2 )  THEN
-!
-!--    Initialize summing variables.
-       lwc          = 0.0_wp
-       lwc_total    = 0.0_wp
-       m1           = 0.0_wp
-       m1_total     = 0.0_wp
-       m2           = 0.0_wp
-       m2_total     = 0.0_wp
-       m3           = 0.0_wp
-       m3_total     = 0.0_wp
-       nr           = 0.0_wp
-       nrclgb       = 0.0_wp
-       nrclgb_total = 0.0_wp
-       nr_total     = 0.0_wp
-       rm           = 0.0_wp
-       rm_total     = 0.0_wp
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                number_of_particles = prt_count(k,j,i)
-                IF ( number_of_particles <= 0  .OR.  ql(k,j,i) < ql_crit )  CYCLE
-                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                nrclgb = nrclgb + 1.0_wp
-!
-!--             Calculate moments of DSD.
-                DO  n = 1, number_of_particles
-                   IF ( particles(n)%particle_mask  .AND.  particles(n)%radius >= r_min )          &
-                   THEN
-                      nr  = nr  + particles(n)%weight_factor
-                      rm  = rm  + factor_volume_to_mass  *                                         &
-                                 particles(n)%radius**3  *                                         &
-                                 particles(n)%weight_factor
-                      IF ( isf == 1 )  THEN
-                         diameter   = particles(n)%radius * 2.0_wp
-                         lwc = lwc + factor_volume_to_mass *                                       &
-                                     particles(n)%radius**3 *                                      &
-                                     particles(n)%weight_factor
-                         m1  = m1  + particles(n)%weight_factor * diameter
-                         m2  = m2  + particles(n)%weight_factor * diameter**2
-                         m3  = m3  + particles(n)%weight_factor * diameter**3
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( nr, nr_total, 1 , MPI_REAL, MPI_SUM, comm2d, ierr )
-       CALL MPI_ALLREDUCE( rm, rm_total, 1 , MPI_REAL, MPI_SUM, comm2d, ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( nrclgb, nrclgb_total, 1 , MPI_REAL, MPI_SUM, comm2d, ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( lwc, lwc_total, 1 , MPI_REAL, MPI_SUM, comm2d, ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( m1, m1_total, 1 , MPI_REAL, MPI_SUM, comm2d, ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( m2, m2_total, 1 , MPI_REAL, MPI_SUM, comm2d, ierr )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( m3, m3_total, 1 , MPI_REAL, MPI_SUM, comm2d, ierr )
-#endif
-
-!
-!--    Calculate number concentration and mean volume averaged radius.
-       nr_total = MERGE( nr_total / nrclgb_total, 0.0_wp, nrclgb_total > 0.0_wp )
-       rm_total = MERGE( ( rm_total / ( nr_total * factor_volume_to_mass ) )**0.3333333_wp, 0.0_wp,&
-                          nrclgb_total > 0.0_wp                                                    &
-                       )
-!
-!--    Check which function should be used to approximate the DSD.
-       IF ( isf == 1 )  THEN
-          lwc_total = MERGE( lwc_total / nrclgb_total, 0.0_wp, nrclgb_total > 0.0_wp )
-          m1_total  = MERGE( m1_total  / nrclgb_total, 0.0_wp, nrclgb_total > 0.0_wp )
-          m2_total  = MERGE( m2_total  / nrclgb_total, 0.0_wp, nrclgb_total > 0.0_wp )
-          m3_total  = MERGE( m3_total  / nrclgb_total, 0.0_wp, nrclgb_total > 0.0_wp )
-          zeta = m1_total * m3_total / m2_total**2
-          mu   = MAX( ( ( 1.0_wp - zeta ) * 2.0_wp + 1.0_wp ) / ( zeta - 1.0_wp ), 0.0_wp )
-
-          lambda = ( pirho_l * nr_total / lwc_total *                                              &
-                     ( mu + 3.0_wp ) * ( mu + 2.0_wp ) * ( mu + 1.0_wp )                           &
-                   )**0.3333333_wp
-          nr0 = nr_total / gamma( mu + 1.0_wp ) * lambda**( mu + 1.0_wp )
-
-          DO  n = 0, n_max-1
-             diameter  = r_bin_mid(n) * 2.0_wp
-             an_spl(n) = nr0 * diameter**mu * EXP( -lambda * diameter ) *                          &
-                         ( r_bin(n+1) - r_bin(n) ) * 2.0_wp
-          ENDDO
-       ELSEIF ( isf == 2 )  THEN
-          DO  n = 0, n_max-1
-             an_spl(n) = nr_total / ( SQRT( 2.0_wp * pi ) * LOG(sigma_log) * r_bin_mid(n) ) *      &
-                         EXP( -( LOG( r_bin_mid(n) / rm_total )**2 ) /                             &
-                               ( 2.0_wp * LOG(sigma_log)**2 )                                      &
-                            ) *                                                                    &
-                         ( r_bin(n+1) - r_bin(n) )
-          ENDDO
-       ELSEIF( isf == 3 )  THEN
-          DO  n = 0, n_max-1
-             an_spl(n) = 3.0_wp * nr_total * r_bin_mid(n)**2 / rm_total**3  *                      &
-                         EXP( -( r_bin_mid(n)**3 / rm_total**3 ) )          *                      &
-                         ( r_bin(n+1) - r_bin(n) )
-          ENDDO
-       ENDIF
-!
-!--    Criterion to avoid super droplets with a weighting factor < 1.0.
-       an_spl = MAX(an_spl, 1.0_wp)
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                number_of_particles = prt_count(k,j,i)
-                IF ( number_of_particles <= 0  .OR.  ql(k,j,i) < ql_crit )  CYCLE
-                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                new_particles_gb = 0
-!
-!--             Start splitting operations. Each particle is checked if it fulfilled the splitting
-!--             criterion's. In splitting mode 'cl_av' a critical radius (radius_split) and a
-!--             splitting function must be prescribed (see particles_par). The critical weighting
-!--             factor is calculated while approximating a 'gamma', 'log' or 'exp'- drop size
-!--             distribution. In this mode the DSD is calculated as an average over all cloudy grid
-!--             boxes. Super droplets which have a larger radius and larger weighting factor are
-!--             split into 'splitting_factor' super droplets. In this case the splitting factor is
-!--             calculated of weighting factor of the super droplet and the approximated number
-!--             concentration for droplet of such a size. Due to the splitting, the weighting factor
-!--             of the super droplet and all created clones is reduced by the factor of
-!--             'splitting_facor'.
-                DO  n = 1, number_of_particles
-                   DO  np = 0, n_max-1
-                      IF ( r_bin(np) >= radius_split          .AND.                                &
-                           particles(n)%particle_mask         .AND.                                &
-                           particles(n)%radius >= r_bin(np)   .AND.                                &
-                           particles(n)%radius < r_bin(np+1)  .AND.                                &
-                           particles(n)%weight_factor >= an_spl(np)  )                             &
-                      THEN
-!
-!--                      Calculate splitting factor
-                         splitting_factor = MIN( INT( particles(n)%weight_factor /                 &
-                                                       an_spl(np)                                  &
-                                                    ), splitting_factor_max                        &
-                                               )
-                         IF ( splitting_factor < 2 )  CYCLE
-!
-!--                      Calculate the new number of particles.
-                         new_size = prt_count(k,j,i) + splitting_factor - 1
-!
-!--                      Cycle if maximum number of particles per grid box is greater than the
-!--                      allowed maximum number.
-                         IF ( new_size >= max_number_particles_per_gridbox )  CYCLE
-!
-!--                      Reallocate particle array if necessary.
-                         IF ( new_size > SIZE( particles ) )  THEN
-                            CALL realloc_particles_array( i, j, k, new_size )
-                         ENDIF
-                         old_size  = prt_count(k,j,i)
-                         new_particles_gb = new_particles_gb + splitting_factor - 1
-!
-!--                      Calculate new weighting factor.
-                         particles(n)%weight_factor = particles(n)%weight_factor / splitting_factor
-                         tmp_particle = particles(n)
-!
-!--                      Create splitting_factor-1 new particles.
-                         DO  jpp = 1, splitting_factor-1
-                            grid_particles(k,j,i)%particles(jpp+old_size) = tmp_particle
-                         ENDDO
-!
-!--                      Save the new number of super droplets.
-                         prt_count(k,j,i) = prt_count(k,j,i) + splitting_factor - 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ELSEIF ( i_splitting_mode == 3 )  THEN
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-
-!
-!--             Initialize summing variables.
-                lwc = 0.0_wp
-                m1  = 0.0_wp
-                m2  = 0.0_wp
-                m3  = 0.0_wp
-                nr  = 0.0_wp
-                rm  = 0.0_wp
-
-                new_particles_gb = 0
-                number_of_particles = prt_count(k,j,i)
-                IF ( number_of_particles <= 0  .OR.  ql(k,j,i) < ql_crit )  CYCLE
-                particles => grid_particles(k,j,i)%particles
-!
-!--             Calculate moments of DSD.
-                DO  n = 1, number_of_particles
-                   IF ( particles(n)%particle_mask  .AND.  particles(n)%radius >= r_min )          &
-                   THEN
-                      nr  = nr + particles(n)%weight_factor
-                      rm  = rm + factor_volume_to_mass  *                                          &
-                                 particles(n)%radius**3  *                                         &
-                                 particles(n)%weight_factor
-                      IF ( isf == 1 )  THEN
-                         diameter   = particles(n)%radius * 2.0_wp
-                         lwc = lwc + factor_volume_to_mass *                                       &
-                                     particles(n)%radius**3 *                                      &
-                                     particles(n)%weight_factor
-                         m1  = m1 + particles(n)%weight_factor * diameter
-                         m2  = m2 + particles(n)%weight_factor * diameter**2
-                         m3  = m3 + particles(n)%weight_factor * diameter**3
-                      ENDIF
-                   ENDIF
-                ENDDO
-
-                IF ( nr <= 0.0_wp  .OR.  rm <= 0.0_wp )  CYCLE
-!
-!--             Calculate mean volume averaged radius.
-                rm = ( rm / ( nr * factor_volume_to_mass ) )**0.3333333_wp
-!
-!--             Check which function should be used to approximate the DSD.
-                IF ( isf == 1 )  THEN
-!
-!--                Gamma size distribution to calculate
-!--                critical weight_factor (e.g. Marshall + Palmer, 1948).
-                   zeta = m1 * m3 / m2**2
-                   mu   = MAX( ( ( 1.0_wp - zeta ) * 2.0_wp + 1.0_wp ) / ( zeta - 1.0_wp ), 0.0_wp )
-                   lambda = ( pirho_l * nr / lwc *                                                 &
-                              ( mu + 3.0_wp ) * ( mu + 2.0_wp ) * ( mu + 1.0_wp )                  &
-                            )**0.3333333_wp
-                   nr0 =  ( nr / (gamma( mu + 1.0_wp ) ) ) *                                       &
-                          lambda**( mu + 1.0_wp )
-
-                   DO  n = 0, n_max-1
-                      diameter         = r_bin_mid(n) * 2.0_wp
-                      an_spl(n) = nr0 * diameter**mu *                                             &
-                                  EXP( -lambda * diameter ) *                                      &
-                                  ( r_bin(n+1) - r_bin(n) ) * 2.0_wp
-                   ENDDO
-                ELSEIF ( isf == 2 )  THEN
-!
-!--                Lognormal size distribution to calculate critical
-!--                weight_factor (e.g. Levin, 1971, Bradley + Stow, 1974).
-                   DO  n = 0, n_max-1
-                      an_spl(n) = nr / ( SQRT( 2.0_wp * pi ) *                                     &
-                                              LOG(sigma_log) * r_bin_mid(n)                        &
-                                       ) *                                                         &
-                                  EXP( -( LOG( r_bin_mid(n) / rm )**2 ) /                          &
-                                        ( 2.0_wp * LOG(sigma_log)**2 )                             &
-                                     ) *                                                           &
-                                  ( r_bin(n+1) - r_bin(n) )
-                   ENDDO
-                ELSEIF ( isf == 3 )  THEN
-!
-!--                Exponential size distribution to calculate critical weight_factor
-!--                (e.g. Berry + Reinhardt, 1974).
-                   DO  n = 0, n_max-1
-                      an_spl(n) = 3.0_wp * nr * r_bin_mid(n)**2 / rm**3 *                          &
-                                  EXP( - ( r_bin_mid(n)**3 / rm**3 ) ) *                           &
-                                  ( r_bin(n+1) - r_bin(n) )
-                   ENDDO
-                ENDIF
-
-!
-!--             Criterion to avoid super droplets with a weighting factor < 1.0.
-                an_spl = MAX(an_spl, 1.0_wp)
-!
-!--             Start splitting operations. Each particle is checked if it fulfilled the splitting
-!--             criterions. In splitting mode 'gb_av' a critical radius (radius_split) and a
-!--             splitting function must be prescribed (see particles_par). The critical weighting
-!--             factor is calculated while appoximating a 'gamma', 'log' or 'exp'-drop size
-!--             distribution. In this mode a DSD is calculated for every cloudy grid box. Super
-!--             droplets which have a larger radius and larger weighting factor are split into
-!--             'splitting_factor' super droplets. In this case the splitting factor is calculated
-!--             by the weighting factor of the super droplet  and the approximated number
-!--             concentration for droplets of such size. Due to the splitting, the weighting factor
-!--             of the super droplet and all created clones are reduced by the factor  of
-!--             'splitting_facor'.
-                DO  n = 1, number_of_particles
-                   DO  np = 0, n_max-1
-                      IF ( r_bin(np) >= radius_split           .AND.                               &
-                           particles(n)%particle_mask          .AND.                               &
-                           particles(n)%radius >= r_bin(np)    .AND.                               &
-                           particles(n)%radius < r_bin(np+1)   .AND.                               &
-                           particles(n)%weight_factor >= an_spl(np) )                              &
-                      THEN
-!
-!--                      Calculate splitting factor.
-                         splitting_factor = MIN( INT( particles(n)%weight_factor / an_spl(np) ),   &
-                                                 splitting_factor_max                              &
-                                               )
-                         IF ( splitting_factor < 2 )  CYCLE
-
-!
-!--                      Calculate the new number of particles.
-                         new_size = prt_count(k,j,i) + splitting_factor - 1
-!
-!--                      Cycle if maximum number of particles per grid box
-!--                      is greater than the allowed maximum number.
-                         IF ( new_size >= max_number_particles_per_gridbox )  CYCLE
-!
-!--                      Reallocate particle array if necessary.
-                         IF ( new_size > SIZE( particles ) )  THEN
-                            CALL realloc_particles_array( i, j, k, new_size )
-                         ENDIF
-!
-!--                      Calculate new weighting factor.
-                         particles(n)%weight_factor = particles(n)%weight_factor / splitting_factor
-                         tmp_particle               = particles(n)
-                         old_size                   = prt_count(k,j,i)
-!
-!--                      Create splitting_factor-1 new particles.
-                         DO  jpp = 1, splitting_factor-1
-                            grid_particles(k,j,i)%particles( jpp + old_size ) = tmp_particle
-                         ENDDO
-!
-!--                      Save the new number of droplets for every grid box.
-                         prt_count(k,j,i)    = prt_count(k,j,i) + splitting_factor - 1
-                         new_particles_gb    = new_particles_gb + splitting_factor - 1
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
-    CALL cpu_log( log_point_s(80), 'lpm_splitting', 'stop' )
-
- END SUBROUTINE lpm_splitting
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! This routine is a part of the Lagrangian particle model. Two Super droplets which fulfill certain
-! criterions (e.g. a big weighting factor and a small radius) can be merged into one super droplet
-! with a increased number of represented particles of the super droplet. This mechanism ensures an
-! improved feasible amount of computational costs. The limits of particle creation should be chosen
-! carefully! The idea of this algorithm is based on Unterstrasser and Soelch, 2014.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_merging
-
-    INTEGER(iwp) ::  i         !<
-    INTEGER(iwp) ::  j         !<
-    INTEGER(iwp) ::  k         !<
-    INTEGER(iwp) ::  n         !<
-    INTEGER(iwp) ::  merge_drp = 0     !< number of merged droplets
-
-
-    REAL(wp) ::  ql_crit = 1.0E-5_wp  !< threshold lwc for cloudy grid cells
-                                      !< (e.g. Siebesma et al 2003, JAS, 60)
-
-    CALL cpu_log( log_point_s(81), 'lpm_merging', 'start' )
-
-    merge_drp  = 0
-
-    IF ( weight_factor_merge == -1.0_wp )  THEN
-       weight_factor_merge = 0.5_wp * initial_weighting_factor
-    ENDIF
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-
-             number_of_particles = prt_count(k,j,i)
-             IF ( number_of_particles <= 0  .OR.  ql(k,j,i) >= ql_crit )  CYCLE
-             particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-!
-!--          Start merging operations: This routine deletes super droplets with a small radius
-!--          (radius <= radius_merge) and a low weighting factor (weight_factor  <=
-!--          weight_factor_merge). The number of represented particles will be added to the next
-!--          particle of the particle array. Tests showed that this simplified method can be used
-!--          because it will only take place outside of cloudy grid boxes where ql <= 1.0E-5 kg/kg.
-!--          Therefore, especially former cloned and subsequent evaporated super droplets will be
-!--          merged.
-             DO  n = 1, number_of_particles-1
-                IF ( particles(n)%particle_mask                    .AND.                           &
-                     particles(n+1)%particle_mask                  .AND.                           &
-                     particles(n)%radius        <= radius_merge    .AND.                           &
-                     particles(n)%weight_factor <= weight_factor_merge )                           &
-                THEN
-                   particles(n+1)%weight_factor  = particles(n+1)%weight_factor +                  &
-                                                   ( particles(n)%radius**3     /                  &
-                                                     particles(n+1)%radius**3   *                  &
-                                                     particles(n)%weight_factor                    &
-                                                   )
-                   particles(n)%particle_mask = .FALSE.
-                   deleted_particles          = deleted_particles + 1
-                   merge_drp                  = merge_drp + 1
-
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-
-    CALL cpu_log( log_point_s(81), 'lpm_merging', 'stop' )
-
- END SUBROUTINE lpm_merging
-
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! 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
-
-    INTEGER(iwp) ::  ip                !< index variable along x
-    INTEGER(iwp) ::  jp                !< index variable along y
-    INTEGER(iwp) ::  kp                !< index variable along z
-    INTEGER(iwp) ::  n                 !< particle index variable
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  i                 !< grid index (x) of particle positition
-    INTEGER(iwp) ::  j                 !< grid index (y) of particle positition
-    INTEGER(iwp) ::  par_size          !< Particle size in bytes
-    INTEGER(iwp) ::  trlp_count        !< number of particles send to left PE
-    INTEGER(iwp) ::  trlp_count_recv   !< number of particles receive from right PE
-    INTEGER(iwp) ::  trnp_count        !< number of particles send to north PE
-    INTEGER(iwp) ::  trnp_count_recv   !< number of particles receive from south PE
-    INTEGER(iwp) ::  trrp_count        !< number of particles send to right PE
-    INTEGER(iwp) ::  trrp_count_recv   !< number of particles receive from left PE
-    INTEGER(iwp) ::  trsp_count        !< number of particles send to south PE
-    INTEGER(iwp) ::  trsp_count_recv   !< number of particles receive from north PE
-
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvlp  !< particles received from right PE
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvnp  !< particles received from south PE
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvrp  !< particles received from left PE
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvsp  !< particles received from north PE
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trlp  !< particles send to left PE
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trnp  !< particles send to north PE
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trrp  !< particles send to right PE
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trsp  !< particles send to south PE
-#endif
-
-    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
-    trrp_count  = 0
-
-    trlp_count_recv   = 0
-    trrp_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 * ddx
-!
-!--                   Above calculation does not work for indices less than zero
-                      IF ( particles(n)%x < 0.0_wp)  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 ( trrp_count  == 0 )  trrp_count  = 1
-
-       ALLOCATE( trlp(trlp_count), trrp(trrp_count) )
-
-       trlp = zero_particle
-       trrp = zero_particle
-
-       trlp_count  = 0
-       trrp_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 * ddx
-!
-!--                Above calculation does not work for indices less than zero
-                   IF ( particles(n)%x < 0.0_wp )  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 + 1)* 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
-
-!
-!-- STORAGE_SIZE returns the storage size of argument A in bits. However , it
-!-- is needed in bytes. The function C_SIZEOF which produces this value directly
-!-- causes problems with gfortran. For this reason the use of C_SIZEOF is avoided
-    par_size = STORAGE_SIZE( trlp(1) ) / 8
-
-
-!
-!-- Allocate arrays required for north-south exchange, as these are used directly after particles
-!-- are exchange along x-direction.
-    ALLOCATE( move_also_north(1:nr_2_direction_move) )
-    ALLOCATE( move_also_south(1:nr_2_direction_move) )
-
-    nr_move_north = 0
-    nr_move_south = 0
-!
-!-- 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, MAX(1,trlp_count)*par_size,      MPI_BYTE, pleft, 1,               &
-                          rvrp, MAX(1,trrp_count_recv)*par_size, MPI_BYTE, pright, 1,              &
-                          comm2d, status, ierr )
-
-       IF ( trrp_count_recv > 0 )  CALL lpm_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)))
-!
-!--    This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit variables in structure
-!--    particle_type (due to the calculation of par_size)
-       CALL MPI_SENDRECV( trrp, MAX(1,trrp_count)*par_size,      MPI_BYTE, pright, 1,              &
-                          rvlp, MAX(1,trlp_count_recv)*par_size, MPI_BYTE,  pleft, 1,              &
-                          comm2d, status, ierr )
-
-       IF ( trlp_count_recv > 0 )  CALL lpm_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 y, no transfer is necessary, because the particle
-!-- remains on the PE.
-    trsp_count  = nr_move_south
-    trnp_count  = nr_move_north
-
-    trsp_count_recv   = 0
-    trnp_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 * ddy
-!
-!--                   Above calculation does not work for indices less than zero
-                      IF ( particles(n)%y < 0.0_wp)  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 ( trnp_count  == 0 )  trnp_count  = 1
-
-       ALLOCATE( trsp(trsp_count), trnp(trnp_count) )
-
-       trsp = zero_particle
-       trnp = zero_particle
-
-       trsp_count  = nr_move_south
-       trnp_count  = nr_move_north
-
-       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 * ddy
-!
-!--                Above calculation does not work for indices less than zero
-                   IF ( particles(n)%y < 0.0_wp )  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+1)* 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 y
-                         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)))
-!
-!--    This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit variables in structure
-!--    particle_type (due to the calculation of par_size)
-       CALL MPI_SENDRECV( trsp, trsp_count*par_size,      MPI_BYTE, psouth, 1,                     &
-                          rvnp, trnp_count_recv*par_size, MPI_BYTE, pnorth, 1,                     &
-                          comm2d, status, ierr )
-
-       IF ( trnp_count_recv  > 0 )  CALL lpm_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)))
-!
-!--    This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit variables in structure
-!--    particle_type (due to the calculation of par_size)
-       CALL MPI_SENDRECV( trnp, trnp_count*par_size,      MPI_BYTE, pnorth, 1,                     &
-                          rvsp, trsp_count_recv*par_size, MPI_BYTE, psouth, 1,                     &
-                          comm2d, status, ierr )
-
-       IF ( trsp_count_recv > 0 )  CALL lpm_add_particles_to_gridcell(rvsp(1:trsp_count_recv))
-
-
-       DEALLOCATE(rvsp)
-
-       number_of_particles = number_of_particles + trsp_count_recv
-
-       DEALLOCATE( trsp, trnp )
-
-    ENDIF
-
-    DEALLOCATE( move_also_north )
-    DEALLOCATE( move_also_south )
-
-#else
-
-    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
-!
-!--             Apply boundary conditions
-
-                IF ( particles(n)%x < 0.0_wp )  THEN
-
-                   IF ( ibc_par_lr == 0 )  THEN
-!
-!--                   Cyclic boundary. Relevant coordinate has to be changed.
-                      particles(n)%x = ( nx + 1 ) * dx + particles(n)%x
-                      particles(n)%origin_x = ( nx + 1 ) * dx + particles(n)%origin_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 + 1) * 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
-                      particles(n)%origin_x = particles(n)%origin_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
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn, nyn-nys
-          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)%y < 0.0_wp)  THEN
-
-                   IF ( ibc_par_ns == 0 )  THEN
-!
-!--                   Cyclic boundary. Relevant coordinate has to be changed.
-                      particles(n)%y = ( ny + 1 ) * dy + particles(n)%y
-                      particles(n)%origin_y = ( ny + 1 ) * dy + particles(n)%origin_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 + 1) * 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
-                      particles(n)%origin_y = particles(n)%origin_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
-          ENDDO
-       ENDDO
-    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:
-! ------------
-!> Exchange ghostpoints
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE lpm_exchange_horiz_bounds( location )
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-       CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-       SELECT CASE ( location )
-
-          CASE ( 'before_prognostic_equation' )
-
-          CASE ( 'after_prognostic_equation' )
-
-             IF ( wang_kernel  .OR.  use_sgs_for_particles )  THEN
-                CALL exchange_horiz( diss, nbgp )
-             ENDIF
-
-       END SELECT
-
-    END SUBROUTINE lpm_exchange_horiz_bounds
-
-
-#if defined( __parallel )
-!--------------------------------------------------------------------------------------------------!
-! 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 lpm_add_particles_to_gridcell (particle_array)
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)        ::  ip        !< grid index (x) of particle
-    INTEGER(iwp)        ::  jp        !< grid index (x) of particle
-    INTEGER(iwp)        ::  kp        !< grid index (x) of particle
-    INTEGER(iwp)        ::  n         !< index variable of particle
-    INTEGER(iwp)        ::  pindex    !< dummy argument for new number of particles per grid box
-
-    LOGICAL             ::  pack_done !<
-
-    TYPE(particle_type), DIMENSION(:), INTENT(IN)  ::  particle_array !< new particles in a grid box
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  temp_ns        !< temporary particle array for reallocation
-
-
-    pack_done     = .FALSE.
-
-    DO  n = 1, SIZE( particle_array )
-
-       IF ( .NOT. particle_array(n)%particle_mask )  CYCLE
-
-       ip = particle_array(n)%x * ddx
-       jp = particle_array(n)%y * ddy
-!
-!--    In case of stretching the actual k index must be found
-       IF ( dz_stretch_level /= -9999999.9_wp  .OR.  dz_stretch_level_start(1) /= -9999999.9_wp )  &
-       THEN
-          kp = MAX( MINLOC( ABS( particle_array(n)%z - zu ), DIM = 1 ) - 1, 1 )
-       ELSE
-          kp = INT( particle_array(n)%z / dz(1) + 1 + offset_ocean_nzt )
-       ENDIF
-
-       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
-                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
-!
-!--          Before particle information is swapped to exchange-array, check if enough memory is
-!--          allocated. If required, reallocate exchange array.
-             IF ( nr_move_south > SIZE( move_also_south ) )  THEN
-!
-!--             At first, allocate further temporary array to swap particle information.
-                ALLOCATE( temp_ns(SIZE( move_also_south )+nr_2_direction_move) )
-                temp_ns(1:nr_move_south-1) = move_also_south(1:nr_move_south-1)
-                DEALLOCATE( move_also_south )
-                ALLOCATE( move_also_south(SIZE( temp_ns )) )
-                move_also_south(1:nr_move_south-1) = temp_ns(1:nr_move_south-1)
-                DEALLOCATE( temp_ns )
-
-             ENDIF
-
-             move_also_south(nr_move_south) = particle_array(n)
-
-             IF ( jp == -1 )  THEN
-!
-!--             Apply boundary condition along y
-                IF ( ibc_par_ns == 0 )  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
-                ELSEIF ( ibc_par_ns == 1 )  THEN
-!
-!--                Particle absorption
-                   move_also_south(nr_move_south)%particle_mask = .FALSE.
-                   deleted_particles = deleted_particles + 1
-
-                ELSEIF ( ibc_par_ns == 2 )  THEN
-!
-!--                Particle reflection
-                   move_also_south(nr_move_south)%y       = -move_also_south(nr_move_south)%y
-                   move_also_south(nr_move_south)%speed_y = -move_also_south(nr_move_south)%speed_y
-
-                ENDIF
-
-             ENDIF
-
-          ELSEIF ( jp >= nyn+1 )  THEN
-
-             nr_move_north = nr_move_north+1
-!
-!--          Before particle information is swapped to exchange-array, check if enough memory is
-!--          allocated. If required, reallocate exchange array.
-             IF ( nr_move_north > SIZE( move_also_north ) )  THEN
-!
-!--             At first, allocate further temporary array to swap particle information.
-                ALLOCATE( temp_ns(SIZE( move_also_north )+nr_2_direction_move) )
-                temp_ns(1:nr_move_north-1) = move_also_south(1:nr_move_north-1)
-                DEALLOCATE( move_also_north )
-                ALLOCATE( move_also_north(SIZE( temp_ns )) )
-                move_also_north(1:nr_move_north-1) = temp_ns(1:nr_move_north-1)
-                DEALLOCATE( temp_ns )
-
-             ENDIF
-
-             move_also_north(nr_move_north) = particle_array(n)
-             IF ( jp == ny+1 )  THEN
-!
-!--             Apply boundary condition along y
-                IF ( ibc_par_ns == 0 )  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
-                ELSEIF ( ibc_par_ns == 1 )  THEN
-!
-!--                Particle absorption
-                   move_also_north(nr_move_north)%particle_mask = .FALSE.
-                   deleted_particles = deleted_particles + 1
-
-                ELSEIF ( ibc_par_ns == 2 )  THEN
-!
-!--                Particle reflection
-                   move_also_north(nr_move_north)%y       = -move_also_north(nr_move_north)%y
-                   move_also_north(nr_move_north)%speed_y = -move_also_north(nr_move_north)%speed_y
-
-                ENDIF
-
-             ENDIF
-
-          ELSE
-
-             IF ( .NOT. child_domain )  THEN
-                WRITE(0,'(a,8i7)') 'particle out of range ',myid,ip,jp,kp,nxl,nxr,nys,nyn
-
-             ENDIF
-
-          ENDIF
-
-       ENDIF
-
-    ENDDO
-
- END SUBROUTINE lpm_add_particles_to_gridcell
-#endif
-
-
-!--------------------------------------------------------------------------------------------------!
-! 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
-
-    INTEGER(iwp)        ::  i           !< grid index (x) of particle position
-    INTEGER(iwp)        ::  ip          !< index variable along x
-    INTEGER(iwp)        ::  j           !< grid index (y) of particle position
-    INTEGER(iwp)        ::  jp          !< index variable along y
-    INTEGER(iwp)        ::  k           !< grid index (z) of particle position
-    INTEGER(iwp)        ::  kp          !< index variable along z
-    INTEGER(iwp)        ::  n           !< index variable for particle array
-    INTEGER(iwp)        ::  np_before_move !< number of particles per grid box before moving
-    INTEGER(iwp)        ::  pindex      !< dummy argument for number of new particle per grid box
-
-    TYPE(particle_type), DIMENSION(:), POINTER  ::  particles_before_move !< particles before moving
-
-    CALL cpu_log( log_point_s(41), 'lpm_move_particle', 'start' )
-    CALL lpm_check_cfl
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          DO  kp = nzb+1, nzt
-
-             np_before_move = prt_count(kp,jp,ip)
-             IF ( np_before_move <= 0 )  CYCLE
-             particles_before_move => grid_particles(kp,jp,ip)%particles(1:np_before_move)
-
-             DO  n = 1, np_before_move
-                i = particles_before_move(n)%x * ddx
-                j = particles_before_move(n)%y * ddy
-                k = kp
-!
-!--             Find correct vertical particle grid box (necessary in case of grid stretching).
-!--             Due to the CFL limitations only the neighbouring grid boxes are considered.
-                IF( zw(k)   < particles_before_move(n)%z ) k = k + 1
-                IF( zw(k-1) > particles_before_move(n)%z ) k = k - 1
-
-!--             For lpm_exchange_horiz to work properly particles need to be moved to the outermost
-!--             gridboxes of the respective processor. If the particle index is inside the processor
-!--             the following lines will not change the index.
-                i = MIN ( i , nxr )
-                i = MAX ( i , nxl )
-                j = MIN ( j , nyn )
-                j = MAX ( j , nys )
-
-                k = MIN ( k , nzt )
-                k = MAX ( k , nzb+1 )
-
-!
-!--             Check, if particle has moved to another grid cell.
-                IF ( i /= ip  .OR.  j /= jp  .OR.  k /= kp )  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
-                      CALL realloc_particles_array( i, j, k )
-                   ENDIF
-
-                   grid_particles(k,j,i)%particles(pindex) = particles_before_move(n)
-                   prt_count(k,j,i) = pindex
-
-                   particles_before_move(n)%particle_mask = .FALSE.
-                ENDIF
-             ENDDO
-
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL cpu_log( log_point_s(41), 'lpm_move_particle', 'stop' )
-
-    RETURN
-
- END SUBROUTINE lpm_move_particle
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check CFL-criterion for each particle. If one particle violated the criterion the particle will
-!> be deleted and a warning message is given.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lpm_check_cfl
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)  ::  i !< running index, x-direction
-    INTEGER(iwp)  ::  j !< running index, y-direction
-    INTEGER(iwp)  ::  k !< running index, z-direction
-    INTEGER(iwp)  ::  n !< running index, number of particles
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             number_of_particles = prt_count(k,j,i)
-             IF ( number_of_particles <= 0 )  CYCLE
-             particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-             DO  n = 1, number_of_particles
-!
-!--             Note, check for CFL does not work at first particle timestep when both, age and
-!--             age_m are zero.
-                IF ( particles(n)%age - particles(n)%age_m > 0.0_wp )  THEN
-                   IF( ABS( particles(n)%speed_x ) >                                               &
-                       ( dx / ( particles(n)%age - particles(n)%age_m) )  .OR.                     &
-                       ABS( particles(n)%speed_y ) >                                               &
-                       ( dy / ( particles(n)%age - particles(n)%age_m) )  .OR.                     &
-                       ABS( particles(n)%speed_z ) >                                               &
-                       ( ( zw(k)-zw(k-1) ) / ( particles(n)%age - particles(n)%age_m) ) )          &
-                   THEN
-                      WRITE( message_string, * )                                                   &
-                         'Particle violated CFL-criterion: &particle with id ', particles(n)%id,   &
-                         ' will be deleted!'
-                      CALL message( 'lpm_check_cfl', 'PA0475', 0, 1, -1, 6, 0 )
-
-                      particles(n)%particle_mask= .FALSE.
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
- END SUBROUTINE lpm_check_cfl
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> If the allocated memory for the particle array does not suffice to add arriving particles from
-!> neighbour grid cells, this subrouting reallocates the particle array to assure enough memory is
-!> available.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE realloc_particles_array ( i, j, k, size_in )
-
-    INTEGER(iwp), INTENT(IN)                       ::  i              !<
-    INTEGER(iwp), INTENT(IN)                       ::  j              !<
-    INTEGER(iwp), INTENT(IN)                       ::  k              !<
-    INTEGER(iwp), INTENT(IN), OPTIONAL             ::  size_in        !<
-
-    INTEGER(iwp)                                   ::  new_size        !<
-    INTEGER(iwp)                                   ::  old_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, 1, old_size + 1 )
-
-    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:new_size)
-
-    RETURN
-
- END SUBROUTINE realloc_particles_array
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Not needed but allocated space for particles is dealloced.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE dealloc_particles_array
-
-
-    INTEGER(iwp) ::  i               !<
-    INTEGER(iwp) ::  j               !<
-    INTEGER(iwp) ::  k               !<
-    INTEGER(iwp) ::  old_size        !<
-    INTEGER(iwp) ::  new_size        !<
-
-    LOGICAL ::  dealloc
-
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  tmp_particles_d !<
-    TYPE(particle_type), DIMENSION(500)            ::  tmp_particles_s !<
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-!
-!--          Determine number of active particles
-             number_of_particles = prt_count(k,j,i)
-!
-!--          Determine allocated memory size
-             old_size = SIZE( grid_particles(k,j,i)%particles )
-!
-!--          Check for large unused memory
-             dealloc = ( ( number_of_particles < 1 .AND. old_size > 1 )  .OR.                      &
-                         ( number_of_particles > 1 .AND.                                           &
-                           old_size - number_of_particles * ( 1.0_wp + 0.01_wp * alloc_factor )    &
-                           > 0.0_wp )                                                              &
-                       )
-
-             IF ( dealloc )  THEN
-                IF ( number_of_particles < 1 )  THEN
-                   new_size = 1
-                ELSE
-                   new_size = INT( number_of_particles * ( 1.0_wp + 0.01_wp * alloc_factor ) )
-                ENDIF
-
-                IF ( number_of_particles <= 500 )  THEN
-
-                   tmp_particles_s(1:number_of_particles) = grid_particles(k,j,i)%particles(1:number_of_particles)
-
-                   DEALLOCATE(grid_particles(k,j,i)%particles)
-                   ALLOCATE(grid_particles(k,j,i)%particles(new_size))
-
-                   grid_particles(k,j,i)%particles(1:number_of_particles)          = tmp_particles_s(1:number_of_particles)
-                   grid_particles(k,j,i)%particles(number_of_particles+1:new_size) = zero_particle
-
-                ELSE
-
-                   ALLOCATE(tmp_particles_d(number_of_particles))
-                   tmp_particles_d(1:number_of_particles) = grid_particles(k,j,i)%particles(1:number_of_particles)
-
-                   DEALLOCATE(grid_particles(k,j,i)%particles)
-                   ALLOCATE(grid_particles(k,j,i)%particles(new_size))
-
-                   grid_particles(k,j,i)%particles(1:number_of_particles)          = tmp_particles_d(1:number_of_particles)
-                   grid_particles(k,j,i)%particles(number_of_particles+1:new_size) = zero_particle
-
-                   DEALLOCATE(tmp_particles_d)
-
-                ENDIF
-
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-
- END SUBROUTINE dealloc_particles_array
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! -----------
-!> Routine for the whole processor.
-!> Sort all particles into the 8 respective subgrid boxes (in case of trilinear interpolation
-!> method) and free space of particles which has been marked for deletion.
-!--------------------------------------------------------------------------------------------------!
-   SUBROUTINE lpm_sort_and_delete
-
-       INTEGER(iwp) ::  i  !<
-       INTEGER(iwp) ::  ip !<
-       INTEGER(iwp) ::  is !<
-       INTEGER(iwp) ::  j  !<
-       INTEGER(iwp) ::  jp !<
-       INTEGER(iwp) ::  kp !<
-       INTEGER(iwp) ::  m  !<
-       INTEGER(iwp) ::  n  !<
-       INTEGER(iwp) ::  nn !<
-       INTEGER(iwp) ::  sort_index  !<
-
-       INTEGER(iwp), DIMENSION(0:7) ::  sort_count  !<
-
-       TYPE(particle_type), DIMENSION(:,:), ALLOCATABLE ::  sort_particles    !<
-
-       CALL cpu_log( log_point_s(51), 'lpm_sort_and_delete', 'start' )
-       IF ( interpolation_trilinear )  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)
-                   nn = 0
-                   sort_count = 0
-                   ALLOCATE( sort_particles(number_of_particles, 0:7) )
-
-                   DO  n = 1, number_of_particles
-                      sort_index = 0
-
-                      IF ( particles(n)%particle_mask )  THEN
-                         nn = nn + 1
-!
-!--                      Sorting particles with a binary scheme.
-!--                      sort_index=111_2=7_10 -> particle at the left,south,bottom subgridbox
-!--                      sort_index=000_2=0_10 -> particle at the right,north,top subgridbox
-!--                      For this the center of the gridbox is calculated.
-                         i = (particles(n)%x + 0.5_wp * dx) * ddx
-                         j = (particles(n)%y + 0.5_wp * dy) * ddy
-
-                         IF ( i == ip )  sort_index = sort_index + 4
-                         IF ( j == jp )  sort_index = sort_index + 2
-                         IF ( zu(kp) > particles(n)%z ) sort_index = sort_index + 1
-
-                         sort_count(sort_index) = sort_count(sort_index) + 1
-                         m = sort_count(sort_index)
-                         sort_particles(m,sort_index) = particles(n)
-                         sort_particles(m,sort_index)%block_nr = sort_index
-                      ENDIF
-                   ENDDO
-!
-!--                Delete and resort particles by overwritting and set the number_of_particles to
-!--                the actual value.
-                   nn = 0
-                   DO  is = 0,7
-                      grid_particles(kp,jp,ip)%start_index(is) = nn + 1
-                      DO  n = 1,sort_count(is)
-                         nn = nn + 1
-                         particles(nn) = sort_particles(n,is)
-                      ENDDO
-                      grid_particles(kp,jp,ip)%end_index(is) = nn
-                   ENDDO
-
-                   number_of_particles = nn
-                   prt_count(kp,jp,ip) = number_of_particles
-                   DEALLOCATE(sort_particles)
-                ENDDO
-             ENDDO
-          ENDDO
-
-!--    In case of the simple interpolation method the particles must not be sorted in subboxes.
-!--    Particles marked for deletion however, must be deleted and number of particles must be
-!--    recalculated as it is also done for the trilinear particle advection interpolation method.
-       ELSE
-
-          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)
-!
-!--                Repack particles array, i.e. delete particles and recalculate number of particles
-                   CALL lpm_pack
-                   prt_count(kp,jp,ip) = number_of_particles
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-       CALL cpu_log( log_point_s(51), 'lpm_sort_and_delete', 'stop' )
-
-    END SUBROUTINE lpm_sort_and_delete
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Move all particles not marked for deletion to lowest indices (packing)
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE lpm_pack
-
-       INTEGER(iwp) ::  n       !<
-       INTEGER(iwp) ::  nn      !<
-!
-!--    Find out elements marked for deletion and move data from highest index values to these free
-!--    indices
-       nn = number_of_particles
-
-       DO WHILE ( .NOT. particles(nn)%particle_mask )
-          nn = nn-1
-          IF ( nn == 0 )  EXIT
-       ENDDO
-
-       IF ( nn > 0 )  THEN
-          DO  n = 1, number_of_particles
-             IF ( .NOT. particles(n)%particle_mask )  THEN
-                particles(n) = particles(nn)
-                nn = nn - 1
-                DO WHILE ( .NOT. particles(nn)%particle_mask )
-                   nn = nn-1
-                   IF ( n == nn )  EXIT
-                ENDDO
-             ENDIF
-             IF ( n == nn )  EXIT
-          ENDDO
-       ENDIF
-
-!
-!--    The number of deleted particles has been determined in routines lpm_boundary_conds,
-!--    lpm_droplet_collision, and lpm_exchange_horiz
-       number_of_particles = nn
-
-    END SUBROUTINE lpm_pack
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sort particles in each sub-grid box into two groups: particles that already completed the LES
-!> timestep, and particles that need further timestepping to complete the LES timestep.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE lpm_sort_timeloop_done
-
-       INTEGER(iwp) ::  end_index     !< particle end index for each sub-box
-       INTEGER(iwp) ::  i             !< index of particle grid box in x-direction
-       INTEGER(iwp) ::  j             !< index of particle grid box in y-direction
-       INTEGER(iwp) ::  k             !< index of particle grid box in z-direction
-       INTEGER(iwp) ::  n             !< running index for number of particles
-       INTEGER(iwp) ::  nb            !< index of subgrid boux
-       INTEGER(iwp) ::  nf            !< indices for particles in each sub-box that already finalized their substeps
-       INTEGER(iwp) ::  nnf           !< indices for particles in each sub-box that need further treatment
-       INTEGER(iwp) ::  num_finalized !< number of particles in each sub-box that already finalized their substeps
-       INTEGER(iwp) ::  start_index   !< particle start index for each sub-box
-
-       TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  sort_particles  !< temporary particle array
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-
-                number_of_particles = prt_count(k,j,i)
-                IF ( number_of_particles <= 0 )  CYCLE
-                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-
-                DO  nb = 0, 7
-!
-!--                Obtain start and end index for each subgrid box
-                   start_index = grid_particles(k,j,i)%start_index(nb)
-                   end_index   = grid_particles(k,j,i)%end_index(nb)
-!
-!--                Allocate temporary array used for sorting.
-                   ALLOCATE( sort_particles(start_index:end_index) )
-!
-!--                Determine number of particles already completed the LES timestep, and write them
-!--                into a temporary array.
-                   nf = start_index
-                   num_finalized = 0
-                   DO  n = start_index, end_index
-                      IF ( dt_3d - particles(n)%dt_sum < 1E-8_wp )  THEN
-                         sort_particles(nf) = particles(n)
-                         nf                 = nf + 1
-                         num_finalized      = num_finalized + 1
-                      ENDIF
-                   ENDDO
-!
-!--                Determine number of particles that not completed the LES timestep, and write them
-!--                into a temporary array.
-                   nnf = nf
-                   DO  n = start_index, end_index
-                      IF ( dt_3d - particles(n)%dt_sum > 1E-8_wp )  THEN
-                         sort_particles(nnf) = particles(n)
-                         nnf                 = nnf + 1
-                      ENDIF
-                   ENDDO
-!
-!--                Write back sorted particles
-                   particles(start_index:end_index) = sort_particles(start_index:end_index)
-!
-!--                Determine updated start_index, used to masked already
-!--                completed particles.
-                   grid_particles(k,j,i)%start_index(nb) = grid_particles(k,j,i)%start_index(nb)   &
-                                                           + num_finalized
-!
-!--                Deallocate dummy array
-                   DEALLOCATE ( sort_particles )
-!
-!--                Finally, if number of non-completed particles is non zero
-!--                in any of the sub-boxes, set control flag appropriately.
-                   IF ( nnf > nf )  grid_particles(k,j,i)%time_loop_done = .FALSE.
-
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE lpm_sort_timeloop_done
-
-END MODULE lagrangian_particle_model_mod
Index: palm/trunk/SOURCE/land_surface_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/land_surface_model_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,7442 +1,0 @@
-!> @file land_surface_model_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! revised output of surface data via MPI-IO for better performance
-!
-! 4876 2021-02-17 12:27:36Z raasch
-! bugfix for instantaneous c_liq output
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more,
-! deprecated namelist removed
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Enable 3D data output also with 64-bit precision
-!
-! 4723 2020-10-06 15:16:11Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4717 2020-09-30 22:27:40Z pavelkrc
-! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP directives (J. Resler)
-!
-! 4716 2020-09-30 22:06:37Z pavelkrc
-! Revert change at water surfaces (previous)
-!
-! 4713 2020-09-29 12:02:05Z pavelkrc
-! - Optimize calculation in case of calc_soil_moisture=false
-! - Improve OMP parallelization
-! - Do not calculate surface prognostic temperature for water surfaces (avoid numerical
-!   instabilities)
-! Author: J. Resler
-!
-! 4694 2020-09-23 15:09:19Z pavelkrc
-! Fix reading of surface data from MPI restart file
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces for RTM 4.1
-! Author: J. Resler (Institute of Computer Science, Prague)
-!
-! 4669 2020-09-09 13:43:47Z pavelkrc
-! Fix calculation of force_radiation_call
-!
-! 4666 2020-09-04 19:22:56Z maronga
-! Bugfix: wrong value for g_d for vegetation_type = 7 (0.13 -> 0.03)
-!
-! 4630 2020-07-30 14:54:34Z suehring
-! - Bugfix in level 3 initialization of root-area-density
-! - Bugfix in resistance calculation - avoid potential divisions by zero
-! - Avoid double classifiation of vertical walls (at surfaces that are also covered by buildings)
-! - Minor formatting adjustment to increase readability
-!
-! 4602 2020-07-14 14:49:45Z suehring
-! - Bugfix in level 3 initialization of pavements - wrongly assumed existence of
-!   pavement_subsurface_pars
-! - Add missing initialization of albedo type with values given from static input file
-!
-! 4581 2020-06-29 08:49:58Z suehring
-! Minor formatting of error message
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4534 2020-05-14 18:35:22Z raasch
-! bugfix for switching on restart data output with MPI-IO
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO for reading local arrays
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4450 2020-03-09 19:12:57Z suehring
-! Missing from_file check
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directive moved
-!
-! 4442 2020-03-04 19:21:13Z suehring
-! Change order of dimension in surface arrays %frac, %emissivity and %albedo to allow for better
-! vectorization in the radiation interactions.
-!
-! 4441 2020-03-04 19:20:35Z suehring
-! bugfix: missing cpp-directives for serial mode added, misplaced cpp-directives moved
-!
-! 4381 2020-01-20 13:51:46Z suehring
-! - Bugfix in nested soil initialization in case no dynamic input file is present
-! - In order to do not mess-up the job-protocoll, give error messages 503, 507 and 508 only once
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Fix wrong location string in message call
-!
-! 4356 2019-12-20 17:09:33Z suehring
-! Correct single message calls, local checks must be given by the respective mpi rank.
-!
-! 4339 2019-12-13 18:18:30Z suehring
-! Bugfix, character length too short, caused crash on NEC.
-!
-! 4338 2019-12-13 13:23:23Z suehring
-! To avoid divisions by zero, add security factor in calculation of roughness length over water
-! surfaces.
-!
-! 4321 2019-12-04 10:26:38Z pavelkrc
-! Initialization of relative surface fractions revised
-!
-! 4312 2019-11-27 14:06:25Z suehring
-! Bugfix: partitioning of LE from liquid water reservoir fixed. Bare soils are now allowed to store
-!         liquid water at the surface.
-!
-! 4261 2019-10-09 17:58:00Z scharf
-! bugfix for rev. 4258: deallocate temporary arrays
-!
-! 4258 2019-10-07 13:29:08Z suehring
-! - Revise limitation for soil moisture in case it exceeds its saturation value (J. Resler)
-! - Revise initialization of soil moisture and temperature in a nested run in case dynamic input
-!   information is available. This case, the soil within the child domains can be initialized
-!   separately. (J. Resler, M. Suehring)
-! - As part of this revision, migrate the netcdf input of soil temperature / moisture to this
-!   module, as well as the routine to inter/extrapolate soil profiles between different grids.
-!
-! 4251 2019-10-02 12:07:38Z maronga
-! Bugfix: albedo_types for vegetation_type look-up table corrected.
-!
-! 4201 2019-08-29 15:47:27Z suehring
-! - Limit soil moisture to its saturation moisture and give a respective warning rather than an
-!   error.
-! - Perform checks for soil temperature only when there is no dynamic input file for the parent or
-!   possible child domains.
-!
-! 4194 2019-08-28 08:09:44Z suehring
-! Apply more strict limitation of z0 over water surfaces in case it exceeds the surface-layer
-! height, in order to avoid instabilities.
-!
-! 4188 2019-08-26 14:15:47Z suehring
-! Minor adjustment in error numbers, typos corrected
-!
-! 4187 2019-08-26 12:43:15Z suehring
-! Adjust message call in case of local checks
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4118 2019-07-25 16:11:45Z suehring
-! Initialization of soil temperature and moisture via dynamic input file only for vegetation and
-! pavement surfaces.
-!
-! 4110 2019-07-22 17:05:21Z suehring
-! Relax checks for non-consistent initialization in case static or dynamic input is provided. For
-! example, soil_temperature or deep_soil_temperature is not mandatory any more if dynamic input is
-! available. Also, improper settings of x_type in namelist are only checked if no static file is
-! available.
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! Further revision of last commit in order to avoid any side effects when albedo type is not set in
-! namelist and default albedo type changes.
-!
-! 4024 2019-06-12 14:06:46Z suehring
-! Bugfix in albedo initialization, caused crashes in rrtmg calls
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3964 2019-05-09 09:48:32Z suehring
-! In a nested child domain, distinguish between soil moisture and temperature initialization from
-! parent via dynamic input file. Further, initialize soil moisture/temperature from dynamic input
-! file only when initialization via 'inifor' is desired.
-!
-! 3943 2019-05-02 09:50:41Z maronga
-! Removed extra blank character
-!
-! 3941 2019-04-30 09:48:33Z suehring
-! Check that at least one surface type is set at surface element.
-!
-! 3933 2019-04-25 12:33:20Z kanani
-! Remove unused subroutine and allocation of pt_2m, this is done in surface_mod now (surfaces%pt_2m)
-!
-!
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3881 2019-04-10 09:31:22Z suehring
-! Bugfix in level 3 initialization of pavement albedo type and pavement emissivity
-!
-! 3868 2019-04-08 11:52:36Z suehring
-! More strict limitation of roughness length when it is in the order of the vertical grid spacing
-!
-! 3856 2019-04-03 11:06:59Z suehring
-! Bugfix in lsm_init in case no surface-fractions are provided
-!
-! 3847 2019-04-01 14:51:44Z suehring
-! Adjust message-call for checks that are especially carried out locally.
-!
-! 3832 2019-03-28 13:16:58Z raasch
-! instrumented with openmp directives
-!
-! 3786 2019-03-06 16:58:03Z raasch
-! further unused variables removed
-!
-! 3767 2019-02-27 08:18:02Z raasch
-! unused variable for file index removed from rrd-subroutines parameter list
-!
-! 3715 2019-02-04 17:34:55Z suehring
-! Revise check for saturation moisture
-!
-! 3710 2019-01-30 18:11:19Z suehring
-! Check if soil-, water-, pavement- and vegetation types are set within a valid range.
-!
-! 3692 2019-01-23 14:45:49Z suehring
-! Revise check for soil moisture higher than its saturation value
-!
-! 3685 2019-01-21 01:02:11Z knoop
-! Some interface calls moved to module_interface + cleanup
-!
-! 3677 2019-01-17 09:07:06Z moh.hefny
-! Removed most_method
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! nopointer option removed
-!
-! 1496 2014-12-02 17:25:50Z maronga
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Land surface model, consisting of a solver for the energy balance at the surface and a multi
-!> layer soil scheme. The scheme is similar to the TESSEL scheme implemented in the ECMWF IFS model,
-!> with modifications according to H-TESSEL. The implementation is based on the formulation
-!> implemented in the DALES and UCLA-LES models.
-!>
-!> @todo Extensive verification energy-balance solver for vertical surfaces,
-!>       e.g. parametrization of r_a
-!> @todo Revise single land-surface processes for vertical surfaces, e.g. treatment of humidity,
-!>       etc.
-!> @todo Consider partial absorption of the net shortwave radiation by the skin layer.
-!> @todo Improve surface water parameterization
-!> @todo Invert indices (running from -3 to 0. Currently: nzb_soil=0, nzt_soil=3)).
-!> @todo Implement surface runoff model (required when performing long-term LES with considerable
-!>       precipitation.
-!> @todo Revise calculation of f2 when wilting point is non-constant in the soil
-!> @todo Allow for zero soil moisture (currently, it is set to wilting point)
-!> @note No time step criterion is required as long as the soil layers do not become too thin.
-!> @todo Attention, pavement_subpars_1/2 are hardcoded to 8 levels, in case more levels are used
-!>       this may cause an potential bug
-!> @todo Routine calc_q_surface required?
-!> @todo Allow for precipitation water to enter pavements that are semi-pervious
-!--------------------------------------------------------------------------------------------------!
- MODULE land_surface_model_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  d_exner, exner, hyp, hyrho, pt, prr, q, q_p, ql, vpt, u, v, w
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  c_p, g, lv_d_cp, l_v, kappa, magnus, rho_l, r_d, r_v, rd_d_rv
-
-    USE calc_mean_profile_mod,                                                                     &
-        ONLY:  calc_mean_profile
-
-    USE control_parameters,                                                                        &
-        ONLY:  cloud_droplets, coupling_char, coupling_start_time, debug_output,                   &
-               debug_output_timestep, debug_string, dt_3d, end_time, humidity,                     &
-               intermediate_timestep_count, initializing_actions, intermediate_timestep_count_max, &
-               land_surface, max_masks, pt_surface, restart_data_format_output, rho_surface,       &
-               spinup, spinup_pt_mean, spinup_time, surface_pressure, timestep_scheme,             &
-               time_since_reference_point, tsc
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY: bulk_cloud_model, precipitation
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY :  albedo_type_f,                                                                     &
-                building_type_f,                                                                   &
-                char_fill,                                                                         &
-                char_lod,                                                                          &
-                check_existence,                                                                   &
-                close_input_file,                                                                  &
-                get_attribute,                                                                     &
-                get_dimension_length,                                                              &
-                get_variable,                                                                      &
-                init_3d,                                                                           &
-                input_file_dynamic,                                                                &
-                input_pids_dynamic,                                                                &
-                input_pids_static,                                                                 &
-                inquire_num_variables,                                                             &
-                inquire_variable_names,                                                            &
-                num_var_pids,                                                                      &
-                open_read_file,                                                                    &
-                pids_id,                                                                           &
-                pavement_pars_f,                                                                   &
-                pavement_subsurface_pars_f,                                                        &
-                pavement_type_f,                                                                   &
-                root_area_density_lsm_f,                                                           &
-                soil_pars_f,                                                                       &
-                soil_type_f,                                                                       &
-                surface_fraction_f,                                                                &
-                vars_pids,                                                                         &
-                vegetation_pars_f,                                                                 &
-                vegetation_type_f,                                                                 &
-                water_pars_f,                                                                      &
-                water_type_f
-
-    USE kinds
-
-    USE pegrid
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  albedo, albedo_type, emissivity, force_radiation_call, radiation, radiation_scheme, &
-               unscheduled_radiation_calls
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_check_array, rd_mpi_io_surface_filetypes, rrd_mpi_io, rrd_mpi_io_surface, &
-               wrd_mpi_io, wrd_mpi_io_surface
-
-    USE statistics,                                                                                &
-        ONLY:  hom, statistic_regions
-
-    USE surface_mod,                                                                               &
-        ONLY :  ind_pav_green, ind_veg_wall, ind_wat_win, surf_lsm_h, surf_lsm_v, surf_type,       &
-                surface_restore_elements
-
-    IMPLICIT NONE
-
-    TYPE surf_type_lsm
-       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  var_1d !< 1D prognostic variable
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_2d !< 2D prognostic variable
-    END TYPE surf_type_lsm
-
-!
-!-- LSM model constants
-
-    REAL(wp), PARAMETER  ::                                                                        &
-              b_ch               = 6.04_wp,    & ! Clapp & Hornberger exponent
-              lambda_h_dry       = 0.19_wp,    & ! heat conductivity for dry soil (W/m/K)
-              lambda_h_sm        = 3.44_wp,    & ! heat conductivity of the soil matrix (W/m/K)
-              lambda_h_water     = 0.57_wp,    & ! heat conductivity of water (W/m/K)
-              m_max_depth        = 0.0002_wp,  & ! Maximum capacity of the water reservoir on a flat surface (leaf/bare soil) (m)
-              psi_sat            = -0.388_wp,  & ! soil matrix potential at saturation
-              rho_c_soil         = 2.19E6_wp,  & ! volumetric heat capacity of soil (J/m3/K)
-              rho_c_water        = 4.20E6_wp     ! volumetric heat capacity of water (J/m3/K)
-
-
-    REAL(wp), DIMENSION(0:7), PARAMETER  :: dz_soil_default =                  & ! default soil layer configuration
-                                            (/ 0.01_wp, 0.02_wp, 0.04_wp,      &
-                                               0.06_wp, 0.14_wp, 0.26_wp,      &
-                                               0.54_wp, 1.86_wp /)
-
-    REAL(wp), DIMENSION(0:3), PARAMETER  :: dz_soil_ref =                      & ! reference four layer soil configuration used for estimating the root fractions
-                                            (/ 0.07_wp, 0.21_wp, 0.72_wp,      &
-                                               1.89_wp /)
-
-    REAL(wp), DIMENSION(0:3), PARAMETER  :: zs_ref =                           & ! reference four layer soil configuration used for estimating the root fractions
-                                            (/ 0.07_wp, 0.28_wp, 1.0_wp,       &
-                                               2.89_wp /)
-
-
-!
-!-- LSM variables
-    CHARACTER(10) :: surface_type = 'netcdf'      !< general classification. Allowed are:
-                                                  !< 'vegetation', 'pavement', ('building'), 'water', and 'netcdf'
-
-
-
-    INTEGER(iwp) :: nzb_soil = 0,             & !< bottom of the soil model (Earth's surface)
-                    nzt_soil = 7,             & !< top of the soil model
-                    nzt_pavement = 0,         & !< top of the pavement within the soil
-                    nzs = 8,                  & !< number of soil layers
-                    pavement_depth_level = 0, & !< default NAMELIST nzt_pavement
-                    pavement_type = 1,        & !< default NAMELIST pavement_type
-                    soil_type = 3,            & !< default NAMELIST soil_type
-                    vegetation_type = 2,      & !< default NAMELIST vegetation_type
-                    water_type = 1              !< default NAMELISt water_type
-
-
-
-    LOGICAL :: aero_resist_kray = .TRUE.,        & !< flag to control parametrization of aerodynamic resistance at vertical surface elements
-               conserve_water_content = .TRUE.,  & !< open or closed bottom surface for the soil model
-               constant_roughness = .FALSE.,     & !< use fixed/dynamic roughness lengths for water surfaces
-               force_radiation_call_l = .FALSE.    !< flag to force calling of radiation routine
-
-!   value 9999999.9_wp -> generic available or user-defined value must be set
-!   otherwise -> no generic variable and user setting is optional
-    REAL(wp) :: alpha_vangenuchten = 9999999.9_wp,            & !< NAMELIST alpha_vg
-                canopy_resistance_coefficient = 9999999.9_wp, & !< NAMELIST g_d
-                c_surface = 9999999.9_wp,                     & !< Surface (skin) heat capacity (J/m2/K)
-                deep_soil_temperature =  9999999.9_wp,        & !< Deep soil temperature (bottom boundary condition)
-                drho_l_lv,                                    & !< (rho_l * l_v)**-1
-                field_capacity = 9999999.9_wp,                & !< NAMELIST m_fc
-                f_shortwave_incoming = 9999999.9_wp,          & !< NAMELIST f_sw_in
-                hydraulic_conductivity = 9999999.9_wp,        & !< NAMELIST gamma_w_sat
-                ke = 0.0_wp,                                  & !< Kersten number
-                lambda_h_sat = 0.0_wp,                        & !< heat conductivity for saturated soil (W/m/K)
-                lambda_surface_stable = 9999999.9_wp,         & !< NAMELIST lambda_surface_s (W/m2/K)
-                lambda_surface_unstable = 9999999.9_wp,       & !< NAMELIST lambda_surface_u (W/m2/K)
-                leaf_area_index = 9999999.9_wp,               & !< NAMELIST lai
-                l_vangenuchten = 9999999.9_wp,                & !< NAMELIST l_vg
-                min_canopy_resistance = 9999999.9_wp,         & !< NAMELIST r_canopy_min
-                min_soil_resistance = 50.0_wp,                & !< NAMELIST r_soil_min
-                m_total = 0.0_wp,                             & !< weighted total water content of the soil (m3/m3)
-                n_vangenuchten = 9999999.9_wp,                & !< NAMELIST n_vg
-                pavement_heat_capacity = 9999999.9_wp,        & !< volumetric heat capacity of pavement (e.g. roads) (J/m3/K)
-                pavement_heat_conduct  = 9999999.9_wp,        & !< heat conductivity for pavements (e.g. roads) (W/m/K)
-                q_s = 0.0_wp,                                 & !< saturation water vapor mixing ratio
-                residual_moisture = 9999999.9_wp,             & !< NAMELIST m_res
-                rho_cp,                                       & !< rho_surface * cp
-                rho_lv,                                       & !< rho_ocean * l_v
-                saturation_moisture = 9999999.9_wp,           & !< NAMELIST m_sat
-                skip_time_do_lsm = 0.0_wp,                    & !< LSM is not called before this time
-                vegetation_coverage = 9999999.9_wp,           & !< NAMELIST c_veg
-                water_temperature = 9999999.9_wp,             & !< water temperature
-                wilting_point = 9999999.9_wp,                 & !< NAMELIST m_wilt
-                z0_vegetation  = 9999999.9_wp,                & !< NAMELIST z0 (lsm_par)
-                z0h_vegetation = 9999999.9_wp,                & !< NAMELIST z0h (lsm_par)
-                z0q_vegetation = 9999999.9_wp,                & !< NAMELIST z0q (lsm_par)
-                z0_pavement    = 9999999.9_wp,                & !< NAMELIST z0 (lsm_par)
-                z0h_pavement   = 9999999.9_wp,                & !< NAMELIST z0h (lsm_par)
-                z0q_pavement   = 9999999.9_wp,                & !< NAMELIST z0q (lsm_par)
-                z0_water       = 9999999.9_wp,                & !< NAMELIST z0 (lsm_par)
-                z0h_water      = 9999999.9_wp,                & !< NAMELIST z0h (lsm_par)
-                z0q_water      = 9999999.9_wp                   !< NAMELIST z0q (lsm_par)
-
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE  ::  ddz_soil,        & !< 1/dz_soil
-                                             ddz_soil_center, & !< 1/dz_soil_center
-                                             dz_soil_center,  & !< soil grid spacing (center-center)
-                                             root_extr,       & !< root extraction
-                                             zs                 !< depth of the temperature/moisute levels
-
-
-
-    REAL(wp), DIMENSION(0:20)  ::  dz_soil  = 9999999.9_wp,          & !< (NAMELIST) soil layer depths (spacing)
-                                   root_fraction = 9999999.9_wp,     & !< (NAMELIST) distribution of root surface area to the individual soil layers
-                                   soil_moisture = 0.0_wp,           & !< NAMELIST soil moisture content (m3/m3)
-                                   soil_temperature = 9999999.9_wp,  & !< NAMELIST soil temperature (K) +1
-                                   zs_layer = 9999999.9_wp             !< soil layer depths (edge)
-
-    TYPE(surf_type_lsm), DIMENSION(:), POINTER ::                                                  &
-                                     m_soil_h,        & !< Soil moisture (m3/m3), horizontal surface elements
-                                     m_soil_h_p,      & !< Prog. soil moisture (m3/m3), horizontal surface elements
-                                     t_soil_h,        & !< Soil temperature (K), horizontal surface elements
-                                     t_soil_h_p         !< Prog. soil temperature (K), horizontal surface elements
-
-    TYPE(surf_type_lsm), DIMENSION(0:1), TARGET ::                                                 &
-                                     m_soil_h_1,      & !<
-                                     m_soil_h_2,      & !<
-                                     t_soil_h_1,      & !<
-                                     t_soil_h_2         !<
-
-    TYPE(surf_type_lsm), DIMENSION(:), POINTER ::                                                  &
-                                     m_soil_v,        & !< Soil moisture (m3/m3), vertical surface elements
-                                     m_soil_v_p,      & !< Prog. soil moisture (m3/m3), vertical surface elements
-                                     t_soil_v,        & !< Soil temperature (K), vertical surface elements
-                                     t_soil_v_p         !< Prog. soil temperature (K), vertical surface elements
-
-    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::                                                 &
-                                     m_soil_v_1,      & !<
-                                     m_soil_v_2,      & !<
-                                     t_soil_v_1,      & !<
-                                     t_soil_v_2         !<
-
-    TYPE(surf_type_lsm), DIMENSION(:), POINTER ::                                                  &
-                                      m_liq_h,        & !< liquid water reservoir (m), horizontal surface elements
-                                      m_liq_h_p,      & !< progn. liquid water reservoir (m), horizontal surface elements
-                                      t_surface_h,    & !< surface temperature (K), horizontal surface elements
-                                      t_surface_h_p     !< progn. surface temperature (K), horizontal surface elements
-
-    TYPE(surf_type_lsm), DIMENSION(0:1), TARGET ::                                                 &
-                                      m_liq_h_1,      & !<
-                                      m_liq_h_2,      & !<
-                                      t_surface_h_1,  & !<
-                                      t_surface_h_2     !<
-
-    TYPE(surf_type_lsm), DIMENSION(:), POINTER  ::                                                 &
-                                      m_liq_v,        & !< liquid water reservoir (m), vertical surface elements
-                                      m_liq_v_p,      & !< progn. liquid water reservoir (m), vertical surface elements
-                                      t_surface_v,    & !< surface temperature (K), vertical surface elements
-                                      t_surface_v_p     !< progn. surface temperature (K), vertical surface elements
-
-    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET   ::                                               &
-                                      m_liq_v_1,      & !<
-                                      m_liq_v_2,      & !<
-                                      t_surface_v_1,  & !<
-                                      t_surface_v_2     !<
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: m_liq_av
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  m_soil_av, &   !< Average of m_soil
-                                                        t_soil_av      !< Average of t_soil
-
-    TYPE(surf_type_lsm), DIMENSION(0:1), TARGET ::  tm_liq_h_m      !< liquid water reservoir tendency (m), horizontal surface elements
-    TYPE(surf_type_lsm), DIMENSION(0:1), TARGET ::  tm_soil_h_m     !< m_soil storage array, horizontal surface elements
-    TYPE(surf_type_lsm), DIMENSION(0:1), TARGET ::  tt_soil_h_m     !< t_soil storage array, horizontal surface elements
-    TYPE(surf_type_lsm), DIMENSION(0:1), TARGET ::  tt_surface_h_m  !< surface temperature tendency (K), horizontal surface elements
-
-    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::  tm_liq_v_m      !< liquid water reservoir tendency (m), vertical surface elements
-    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::  tm_soil_v_m     !< m_soil storage array, vertical surface elements
-    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::  tt_soil_v_m     !< t_soil storage array, vertical surface elements
-    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::  tt_surface_v_m  !< surface temperature tendency (K), vertical surface elements
-
-!
-!-- Energy balance variables
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::                                                       &
-              c_liq_av,         & !< average of c_liq
-              c_soil_av,        & !< average of c_soil
-              c_veg_av,         & !< average of c_veg
-              lai_av,           & !< average of lai
-              qsws_liq_av,      & !< average of qsws_liq
-              qsws_soil_av,     & !< average of qsws_soil
-              qsws_veg_av,      & !< average of qsws_veg
-              r_s_av              !< average of r_s
-
-!
-!-- Predefined Land surface classes (vegetation_type)
-    CHARACTER(26), DIMENSION(0:18), PARAMETER ::  vegetation_type_name = (/                        &
-                                                     'user defined              ',           & !  0
-                                                     'bare soil                 ',           & !  1
-                                                     'crops, mixed farming      ',           & !  2
-                                                     'short grass               ',           & !  3
-                                                     'evergreen needleleaf trees',           & !  4
-                                                     'deciduous needleleaf trees',           & !  5
-                                                     'evergreen broadleaf trees ',           & !  6
-                                                     'deciduous broadleaf trees ',           & !  7
-                                                     'tall grass                ',           & !  8
-                                                     'desert                    ',           & !  9
-                                                     'tundra                    ',           & ! 10
-                                                     'irrigated crops           ',           & ! 11
-                                                     'semidesert                ',           & ! 12
-                                                     'ice caps and glaciers     ',           & ! 13
-                                                     'bogs and marshes          ',           & ! 14
-                                                     'evergreen shrubs          ',           & ! 15
-                                                     'deciduous shrubs          ',           & ! 16
-                                                     'mixed forest/woodland     ',           & ! 17
-                                                     'interrupted forest        '            & ! 18
-                                                                         /)
-
-!
-!-- Soil model classes (soil_type)
-    CHARACTER(12), DIMENSION(0:6), PARAMETER ::  soil_type_name = (/                               &
-                                                     'user defined',                  & ! 0
-                                                     'coarse      ',                  & ! 1
-                                                     'medium      ',                  & ! 2
-                                                     'medium-fine ',                  & ! 3
-                                                     'fine        ',                  & ! 4
-                                                     'very fine   ',                  & ! 5
-                                                     'organic     '                   & ! 6
-                                                                  /)
-
-!
-!-- Pavement classes
-    CHARACTER(29), DIMENSION(0:15), PARAMETER ::  pavement_type_name = (/                          &
-                                                     'user defined                 ', & ! 0
-                                                     'asphalt/concrete mix         ', & ! 1
-                                                     'asphalt (asphalt concrete)   ', & ! 2
-                                                     'concrete (Portland concrete) ', & ! 3
-                                                     'sett                         ', & ! 4
-                                                     'paving stones                ', & ! 5
-                                                     'cobblestone                  ', & ! 6
-                                                     'metal                        ', & ! 7
-                                                     'wood                         ', & ! 8
-                                                     'gravel                       ', & ! 9
-                                                     'fine gravel                  ', & ! 10
-                                                     'pebblestone                  ', & ! 11
-                                                     'woodchips                    ', & ! 12
-                                                     'tartan (sports)              ', & ! 13
-                                                     'artifical turf (sports)      ', & ! 14
-                                                     'clay (sports)                '  & ! 15
-                                                                        /)
-
-!
-!-- Water classes
-    CHARACTER(12), DIMENSION(0:5), PARAMETER ::  water_type_name = (/                              &
-                                                     'user defined',                  & ! 0
-                                                     'lake        ',                  & ! 1
-                                                     'river       ',                  & ! 2
-                                                     'ocean       ',                  & ! 3
-                                                     'pond        ',                  & ! 4
-                                                     'fountain    '                   & ! 5
-                                                                    /)
-
-!
-!-- Land surface parameters according to the respective classes (vegetation_type)
-    INTEGER(iwp) ::  ind_v_rc_min = 0    !< index for r_canopy_min in vegetation_pars
-    INTEGER(iwp) ::  ind_v_rc_lai = 1    !< index for LAI in vegetation_pars
-    INTEGER(iwp) ::  ind_v_c_veg   = 2   !< index for c_veg in vegetation_pars
-    INTEGER(iwp) ::  ind_v_gd  = 3       !< index for g_d in vegetation_pars
-    INTEGER(iwp) ::  ind_v_z0 = 4        !< index for z0 in vegetation_pars
-    INTEGER(iwp) ::  ind_v_z0qh = 5      !< index for z0h / z0q in vegetation_pars
-    INTEGER(iwp) ::  ind_v_lambda_s = 6  !< index for lambda_s_s in vegetation_pars
-    INTEGER(iwp) ::  ind_v_lambda_u = 7  !< index for lambda_s_u in vegetation_pars
-    INTEGER(iwp) ::  ind_v_f_sw_in = 8   !< index for f_sw_in in vegetation_pars
-    INTEGER(iwp) ::  ind_v_c_surf = 9    !< index for c_surface in vegetation_pars
-    INTEGER(iwp) ::  ind_v_at = 10       !< index for albedo_type in vegetation_pars
-    INTEGER(iwp) ::  ind_v_emis = 11     !< index for emissivity in vegetation_pars
-
-    INTEGER(iwp) ::  ind_w_temp     = 0    !< index for temperature in water_pars
-    INTEGER(iwp) ::  ind_w_z0       = 1    !< index for z0 in water_pars
-    INTEGER(iwp) ::  ind_w_z0h      = 2    !< index for z0h in water_pars
-    INTEGER(iwp) ::  ind_w_lambda_s = 3    !< index for lambda_s_s in water_pars
-    INTEGER(iwp) ::  ind_w_lambda_u = 4    !< index for lambda_s_u in water_pars
-    INTEGER(iwp) ::  ind_w_at       = 5    !< index for albedo type in water_pars
-    INTEGER(iwp) ::  ind_w_emis     = 6    !< index for emissivity in water_pars
-
-    INTEGER(iwp) ::  ind_p_z0       = 0    !< index for z0 in pavement_pars
-    INTEGER(iwp) ::  ind_p_z0h      = 1    !< index for z0h in pavement_pars
-    INTEGER(iwp) ::  ind_p_at       = 2    !< index for albedo type in pavement_pars
-    INTEGER(iwp) ::  ind_p_emis     = 3    !< index for emissivity in pavement_pars
-    INTEGER(iwp) ::  ind_p_lambda_h = 0    !< index for lambda_h in pavement_subsurface_pars
-    INTEGER(iwp) ::  ind_p_rho_c    = 1    !< index for rho_c in pavement_pars
-!
-!-- Land surface parameters
-!-- r_canopy_min,     lai,   c_veg,     g_d         z0,         z0h, lambda_s_s, lambda_s_u, f_sw_in,  c_surface, albedo_type, emissivity
-    REAL(wp), DIMENSION(0:11,1:18), PARAMETER :: vegetation_pars = RESHAPE( (/                     &
-          0.0_wp, 0.00_wp, 0.00_wp, 0.00_wp,  0.005_wp,   0.5E-4_wp,     0.0_wp,    0.0_wp, 0.00_wp, 0.00_wp, 17.0_wp, 0.94_wp, & !  1
-        180.0_wp, 3.00_wp, 1.00_wp, 0.00_wp,   0.10_wp,    0.001_wp,    10.0_wp,   10.0_wp, 0.05_wp, 0.00_wp,  2.0_wp, 0.95_wp, & !  2
-        110.0_wp, 2.00_wp, 1.00_wp, 0.00_wp,   0.03_wp,   0.3E-4_wp,    10.0_wp,   10.0_wp, 0.05_wp, 0.00_wp,  5.0_wp, 0.95_wp, & !  3
-        500.0_wp, 5.00_wp, 1.00_wp, 0.03_wp,   2.00_wp,     2.00_wp,    20.0_wp,   15.0_wp, 0.03_wp, 0.00_wp,  6.0_wp, 0.97_wp, & !  4
-        500.0_wp, 5.00_wp, 1.00_wp, 0.03_wp,   2.00_wp,     2.00_wp,    20.0_wp,   15.0_wp, 0.03_wp, 0.00_wp,  8.0_wp, 0.97_wp, & !  5
-        175.0_wp, 5.00_wp, 1.00_wp, 0.03_wp,   2.00_wp,     2.00_wp,    20.0_wp,   15.0_wp, 0.03_wp, 0.00_wp,  9.0_wp, 0.97_wp, & !  6
-        240.0_wp, 6.00_wp, 0.99_wp, 0.03_wp,   2.00_wp,     2.00_wp,    20.0_wp,   15.0_wp, 0.03_wp, 0.00_wp,  7.0_wp, 0.97_wp, & !  7
-        100.0_wp, 2.00_wp, 0.70_wp, 0.00_wp,   0.47_wp,  0.47E-2_wp,    10.0_wp,   10.0_wp, 0.05_wp, 0.00_wp, 10.0_wp, 0.97_wp, & !  8
-        250.0_wp, 0.05_wp, 0.00_wp, 0.00_wp,  0.013_wp, 0.013E-2_wp,    15.0_wp,   15.0_wp, 0.00_wp, 0.00_wp, 11.0_wp, 0.94_wp, & !  9
-         80.0_wp, 1.00_wp, 0.50_wp, 0.00_wp,  0.034_wp, 0.034E-2_wp,    10.0_wp,   10.0_wp, 0.05_wp, 0.00_wp, 13.0_wp, 0.97_wp, & ! 10
-        180.0_wp, 3.00_wp, 1.00_wp, 0.00_wp,    0.5_wp,  0.50E-2_wp,    10.0_wp,   10.0_wp, 0.05_wp, 0.00_wp,  2.0_wp, 0.97_wp, & ! 11
-        150.0_wp, 0.50_wp, 0.10_wp, 0.00_wp,   0.17_wp,  0.17E-2_wp,    10.0_wp,   10.0_wp, 0.05_wp, 0.00_wp, 11.0_wp, 0.97_wp, & ! 12
-          0.0_wp, 0.00_wp, 0.00_wp, 0.00_wp, 1.3E-3_wp,   1.3E-4_wp,    58.0_wp,   58.0_wp, 0.00_wp, 0.00_wp, 14.0_wp, 0.97_wp, & ! 13
-        240.0_wp, 4.00_wp, 0.60_wp, 0.00_wp,   0.83_wp,  0.83E-2_wp,    10.0_wp,   10.0_wp, 0.05_wp, 0.00_wp,  3.0_wp, 0.97_wp, & ! 14
-        225.0_wp, 3.00_wp, 0.50_wp, 0.00_wp,   0.10_wp,  0.10E-2_wp,    10.0_wp,   10.0_wp, 0.05_wp, 0.00_wp,  4.0_wp, 0.97_wp, & ! 15
-        225.0_wp, 1.50_wp, 0.50_wp, 0.00_wp,   0.25_wp,  0.25E-2_wp,    10.0_wp,   10.0_wp, 0.05_wp, 0.00_wp,  5.0_wp, 0.97_wp, & ! 16
-        250.0_wp, 5.00_wp, 1.00_wp, 0.03_wp,   2.00_wp,     2.00_wp,    20.0_wp,   15.0_wp, 0.03_wp, 0.00_wp, 10.0_wp, 0.97_wp, & ! 17
-        175.0_wp, 2.50_wp, 1.00_wp, 0.03_wp,   1.10_wp,     1.10_wp,    20.0_wp,   15.0_wp, 0.03_wp, 0.00_wp,  7.0_wp, 0.97_wp  & ! 18
-                                                                             /), (/ 12, 18 /) )
-
-
-!
-!-- Root distribution for default soil layer configuration (sum = 1)
-!--                                level 1 - level 4 according to zs_ref
-    REAL(wp), DIMENSION(0:3,1:18), PARAMETER :: root_distribution = RESHAPE( (/                    &
-                                                1.00_wp, 0.00_wp, 0.00_wp, 0.00_wp,          & !  1
-                                                0.24_wp, 0.41_wp, 0.31_wp, 0.04_wp,          & !  2
-                                                0.35_wp, 0.38_wp, 0.23_wp, 0.04_wp,          & !  3
-                                                0.26_wp, 0.39_wp, 0.29_wp, 0.06_wp,          & !  4
-                                                0.26_wp, 0.38_wp, 0.29_wp, 0.07_wp,          & !  5
-                                                0.24_wp, 0.38_wp, 0.31_wp, 0.07_wp,          & !  6
-                                                0.25_wp, 0.34_wp, 0.27_wp, 0.14_wp,          & !  7
-                                                0.27_wp, 0.27_wp, 0.27_wp, 0.09_wp,          & !  8
-                                                1.00_wp, 0.00_wp, 0.00_wp, 0.00_wp,          & !  9
-                                                0.47_wp, 0.45_wp, 0.08_wp, 0.00_wp,          & ! 10
-                                                0.24_wp, 0.41_wp, 0.31_wp, 0.04_wp,          & ! 11
-                                                0.17_wp, 0.31_wp, 0.33_wp, 0.19_wp,          & ! 12
-                                                0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp,          & ! 13
-                                                0.25_wp, 0.34_wp, 0.27_wp, 0.11_wp,          & ! 14
-                                                0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp,          & ! 15
-                                                0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp,          & ! 16
-                                                0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp,          & ! 17
-                                                0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp           & ! 18
-                                                                               /), (/ 4, 18 /) )
-
-!
-!-- Soil parameters according to the following porosity classes (soil_type)
-
-!
-!-- Soil parameters  alpha_vg,      l_vg,    n_vg, gamma_w_sat,    m_sat,     m_fc,   m_wilt,    m_res
-    REAL(wp), DIMENSION(0:7,1:6), PARAMETER :: soil_pars = RESHAPE( (/                             &
-             3.83_wp,  1.250_wp, 1.38_wp,  6.94E-6_wp, 0.403_wp, 0.244_wp, 0.059_wp, 0.025_wp,& ! 1
-             3.14_wp, -2.342_wp, 1.28_wp,  1.16E-6_wp, 0.439_wp, 0.347_wp, 0.151_wp, 0.010_wp,& ! 2
-             0.83_wp, -0.588_wp, 1.25_wp,  0.26E-6_wp, 0.430_wp, 0.383_wp, 0.133_wp, 0.010_wp,& ! 3
-             3.67_wp, -1.977_wp, 1.10_wp,  2.87E-6_wp, 0.520_wp, 0.448_wp, 0.279_wp, 0.010_wp,& ! 4
-             2.65_wp,  2.500_wp, 1.10_wp,  1.74E-6_wp, 0.614_wp, 0.541_wp, 0.335_wp, 0.010_wp,& ! 5
-             1.30_wp,  0.400_wp, 1.20_wp,  0.93E-6_wp, 0.766_wp, 0.663_wp, 0.267_wp, 0.010_wp & ! 6
-                                                                     /), (/ 8, 6 /) )
-
-
-!
-!-- TO BE FILLED
-!-- Pavement parameters      z0,       z0h, albedo_type, emissivity
-    REAL(wp), DIMENSION(0:3,1:15), PARAMETER :: pavement_pars = RESHAPE( (/                        &
-                                              5.0E-2_wp, 5.0E-4_wp,     18.0_wp,    0.97_wp,  & !  1
-                                              5.0E-2_wp, 5.0E-4_wp,     19.0_wp,    0.94_wp,  & !  2
-                                              1.0E-2_wp, 1.0E-4_wp,     20.0_wp,    0.98_wp,  & !  3
-                                              1.0E-2_wp, 1.0E-4_wp,     21.0_wp,    0.93_wp,  & !  4
-                                              1.0E-2_wp, 1.0E-4_wp,     22.0_wp,    0.97_wp,  & !  5
-                                              1.0E-2_wp, 1.0E-4_wp,     23.0_wp,    0.97_wp,  & !  6
-                                              1.0E-2_wp, 1.0E-4_wp,     24.0_wp,    0.97_wp,  & !  7
-                                              1.0E-2_wp, 1.0E-4_wp,     25.0_wp,    0.94_wp,  & !  8
-                                              1.0E-2_wp, 1.0E-4_wp,     26.0_wp,    0.98_wp,  & !  9
-                                              1.0E-2_wp, 1.0E-4_wp,     27.0_wp,    0.93_wp,  & ! 10
-                                              1.0E-2_wp, 1.0E-4_wp,     28.0_wp,    0.97_wp,  & ! 11
-                                              1.0E-2_wp, 1.0E-4_wp,     29.0_wp,    0.97_wp,  & ! 12
-                                              1.0E-2_wp, 1.0E-4_wp,     30.0_wp,    0.97_wp,  & ! 13
-                                              1.0E-2_wp, 1.0E-4_wp,     31.0_wp,    0.94_wp,  & ! 14
-                                              1.0E-2_wp, 1.0E-4_wp,     32.0_wp,    0.98_wp   & ! 15
-                                                                          /), (/ 4, 15 /) )
-!
-!-- Pavement subsurface parameters part 1: thermal conductivity (W/m/K)
-!--   0.0-0.01, 0.01-0.03, 0.03-0.07, 0.07-0.15, 0.15-0.30, 0.30-0.50,    0.50-1.25,    1.25-3.00
-    REAL(wp), DIMENSION(0:7,1:15), PARAMETER :: pavement_subsurface_pars_1 = RESHAPE( (/           &
-       0.75_wp,   0.75_wp,   0.75_wp,   0.75_wp,   0.75_wp,   0.75_wp, 9999999.9_wp, 9999999.9_wp, & !  1
-       0.75_wp,   0.75_wp,   0.75_wp,   0.75_wp,   0.75_wp,   0.75_wp, 9999999.9_wp, 9999999.9_wp, & !  2
-       0.89_wp,   0.89_wp,   0.89_wp,   0.89_wp,   0.89_wp,   0.89_wp, 9999999.9_wp, 9999999.9_wp, & !  3
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp, & !  4
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp, & !  5
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp, & !  6
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp, & !  7
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp, & !  8
-       0.70_wp,   0.70_wp,   0.70_wp,   0.70_wp,   0.70_wp,   0.70_wp, 9999999.9_wp, 9999999.9_wp, & !  9
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 10
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 11
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 12
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 13
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 14
-       1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp,   1.00_wp, 9999999.9_wp, 9999999.9_wp  & ! 15
-       /), (/ 8, 15 /) )
-
-!
-!-- Pavement subsurface parameters part 2: volumetric heat capacity (J/m3/K)
-!--     0.0-0.01, 0.01-0.03, 0.03-0.07, 0.07-0.15, 0.15-0.30, 0.30-0.50,    0.50-1.25,    1.25-3.00
-    REAL(wp), DIMENSION(0:7,1:15), PARAMETER :: pavement_subsurface_pars_2 = RESHAPE( (/           &
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & !  1
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & !  2
-       1.76E6_wp, 1.76E6_wp, 1.76E6_wp, 1.76E6_wp, 1.76E6_wp, 1.76E6_wp, 9999999.9_wp, 9999999.9_wp, & !  3
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & !  4
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & !  5
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & !  6
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & !  7
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & !  8
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & !  9
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 10
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 11
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 12
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 13
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 14
-       1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp  & ! 15
-       /), (/ 8, 15 /) )
-
-!
-!-- TO BE FILLED
-!-- Water parameters                    temperature,     z0,      z0h, albedo_type, emissivity,
-    REAL(wp), DIMENSION(0:6,1:5), PARAMETER :: water_pars = RESHAPE( (/                            &
-                         283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp, & ! 1
-                         283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp, & ! 2
-                         283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp, & ! 3
-                         283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp, & ! 4
-                         283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp  & ! 5
-                                                                      /), (/ 7, 5 /) )
-
-    SAVE
-
-
-    PRIVATE
-
-
-!
-!-- Public functions
-    PUBLIC lsm_boundary_condition, lsm_check_data_output, lsm_check_data_output_pr,                &
-           lsm_check_parameters, lsm_define_netcdf_grid, lsm_3d_data_averaging, lsm_data_output_2d,&
-           lsm_data_output_3d, lsm_energy_balance, lsm_header, lsm_init, lsm_init_arrays,          &
-           lsm_parin, lsm_soil_model, lsm_swap_timelevel, lsm_rrd_local, lsm_wrd_local
-! !vegetat
-!-- Public parameters, constants and initial values
-    PUBLIC aero_resist_kray, skip_time_do_lsm
-
-!
-!-- Public grid variables
-    PUBLIC nzb_soil, nzs, nzt_soil, zs
-
-!
-!-- Public prognostic variables
-    PUBLIC m_soil_h, t_soil_h
-
-    INTERFACE lsm_boundary_condition
-       MODULE PROCEDURE lsm_boundary_condition
-    END INTERFACE lsm_boundary_condition
-
-    INTERFACE lsm_check_data_output
-       MODULE PROCEDURE lsm_check_data_output
-    END INTERFACE lsm_check_data_output
-
-    INTERFACE lsm_check_data_output_pr
-       MODULE PROCEDURE lsm_check_data_output_pr
-    END INTERFACE lsm_check_data_output_pr
-
-    INTERFACE lsm_check_parameters
-       MODULE PROCEDURE lsm_check_parameters
-    END INTERFACE lsm_check_parameters
-
-    INTERFACE lsm_3d_data_averaging
-       MODULE PROCEDURE lsm_3d_data_averaging
-    END INTERFACE lsm_3d_data_averaging
-
-    INTERFACE lsm_data_output_2d
-       MODULE PROCEDURE lsm_data_output_2d
-    END INTERFACE lsm_data_output_2d
-
-    INTERFACE lsm_data_output_3d
-       MODULE PROCEDURE lsm_data_output_3d
-    END INTERFACE lsm_data_output_3d
-
-    INTERFACE lsm_define_netcdf_grid
-       MODULE PROCEDURE lsm_define_netcdf_grid
-    END INTERFACE lsm_define_netcdf_grid
-
-    INTERFACE lsm_energy_balance
-       MODULE PROCEDURE lsm_energy_balance
-    END INTERFACE lsm_energy_balance
-
-    INTERFACE lsm_header
-       MODULE PROCEDURE lsm_header
-    END INTERFACE lsm_header
-
-    INTERFACE lsm_init
-       MODULE PROCEDURE lsm_init
-    END INTERFACE lsm_init
-
-    INTERFACE lsm_init_arrays
-       MODULE PROCEDURE lsm_init_arrays
-    END INTERFACE lsm_init_arrays
-
-    INTERFACE lsm_parin
-       MODULE PROCEDURE lsm_parin
-    END INTERFACE lsm_parin
-
-    INTERFACE lsm_soil_model
-       MODULE PROCEDURE lsm_soil_model
-    END INTERFACE lsm_soil_model
-
-    INTERFACE lsm_swap_timelevel
-       MODULE PROCEDURE lsm_swap_timelevel
-    END INTERFACE lsm_swap_timelevel
-
-    INTERFACE lsm_rrd_local
-       MODULE PROCEDURE lsm_rrd_local_ftn
-       MODULE PROCEDURE lsm_rrd_local_mpi
-    END INTERFACE lsm_rrd_local
-
-    INTERFACE lsm_wrd_local
-       MODULE PROCEDURE lsm_wrd_local
-    END INTERFACE lsm_wrd_local
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set internal Neumann boundary condition at outer soil grid points for temperature and humidity.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_boundary_condition
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: i      !< grid index x-direction
-    INTEGER(iwp) :: ioff   !< offset index x-direction indicating location of soil grid point
-    INTEGER(iwp) :: j      !< grid index y-direction
-    INTEGER(iwp) :: joff   !< offset index x-direction indicating location of soil grid point
-    INTEGER(iwp) :: k      !< grid index z-direction
-    INTEGER(iwp) :: koff   !< offset index x-direction indicating location of soil grid point
-    INTEGER(iwp) :: l      !< running index surface-orientation
-    INTEGER(iwp) :: m      !< running index surface elements
-
-    DO l = 0, 1
-       koff = surf_lsm_h(l)%koff
-       DO  m = 1, surf_lsm_h(l)%ns
-          i = surf_lsm_h(l)%i(m)
-          j = surf_lsm_h(l)%j(m)
-          k = surf_lsm_h(l)%k(m)
-          pt(k+koff,j,i) = pt(k,j,i)
-       ENDDO
-    ENDDO
-
-    DO  l = 0, 3
-       ioff = surf_lsm_v(l)%ioff
-       joff = surf_lsm_v(l)%joff
-       DO  m = 1, surf_lsm_v(l)%ns
-          i = surf_lsm_v(l)%i(m)
-          j = surf_lsm_v(l)%j(m)
-          k = surf_lsm_v(l)%k(m)
-          pt(k,j+joff,i+ioff) = pt(k,j,i)
-       ENDDO
-    ENDDO
-!
-!-- In case of humidity, set boundary conditions also for q and vpt.
-    IF ( humidity )  THEN
-       DO  l = 0, 1
-          koff = surf_lsm_h(l)%koff
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-             k = surf_lsm_h(l)%k(m)
-             q(k+koff,j,i)   = q(k,j,i)
-             vpt(k+koff,j,i) = vpt(k,j,i)
-          ENDDO
-       ENDDO
-       DO  l = 0, 3
-          ioff = surf_lsm_v(l)%ioff
-          joff = surf_lsm_v(l)%joff
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m)
-             j = surf_lsm_v(l)%j(m)
-             k = surf_lsm_v(l)%k(m)
-             q(k,j+joff,i+ioff)   = q(k,j,i)
-             vpt(k,j+joff,i+ioff) = vpt(k,j,i)
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE lsm_boundary_condition
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output for land surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_check_data_output( var, unit, i, ilen, k )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  data_output, message_string
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  unit  !<
-    CHARACTER (LEN=*) ::  var   !<
-
-    INTEGER(iwp) :: i
-    INTEGER(iwp) :: ilen
-    INTEGER(iwp) :: k
-
-    SELECT CASE ( TRIM( var ) )
-
-       CASE ( 'm_soil' )
-          IF (  .NOT.  land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-          unit = 'm3/m3'
-
-       CASE ( 't_soil' )
-          IF (  .NOT.  land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-          unit = 'K'
-
-       CASE ( 'lai*', 'c_liq*', 'c_soil*', 'c_veg*', 'm_liq*', 'qsws_liq*', 'qsws_soil*',          &
-              'qsws_veg*', 'r_s*' )
-          IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
-             message_string = 'illegal value for data_output: "' //                                &
-                              TRIM( var ) // '" & only 2d-horizontal ' //                          &
-                              'cross sections are allowed for this value'
-             CALL message( 'lsm_check_data_output', 'PA0111', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( TRIM( var ) == 'lai*'  .AND.  .NOT. land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( TRIM( var ) == 'c_liq*'  .AND.  .NOT. land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( TRIM( var ) == 'c_soil*'  .AND.  .NOT. land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( TRIM( var ) == 'c_veg*'  .AND.  .NOT. land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( TRIM( var ) == 'm_liq*'  .AND.  .NOT. land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( TRIM( var ) == 'qsws_liq*'  .AND.  .NOT. land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( TRIM( var ) == 'qsws_soil*'  .AND.  .NOT. land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( TRIM( var ) == 'qsws_veg*'  .AND.  .NOT. land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( TRIM( var ) == 'r_s*'  .AND.  .NOT. land_surface )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res land_surface = .TRUE.'
-             CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( TRIM( var ) == 'lai*'   )      unit = 'none'
-          IF ( TRIM( var ) == 'c_liq*' )      unit = 'none'
-          IF ( TRIM( var ) == 'c_soil*')      unit = 'none'
-          IF ( TRIM( var ) == 'c_veg*' )      unit = 'none'
-          IF ( TRIM( var ) == 'm_liq*'     )  unit = 'm'
-          IF ( TRIM( var ) == 'qsws_liq*'  )  unit = 'W/m2'
-          IF ( TRIM( var ) == 'qsws_soil*' )  unit = 'W/m2'
-          IF ( TRIM( var ) == 'qsws_veg*'  )  unit = 'W/m2'
-          IF ( TRIM( var ) == 'r_s*')         unit = 's/m'
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE lsm_check_data_output
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output of profiles for land surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-    USE control_parameters,                                                                        &
-        ONLY:  data_output_pr, message_string
-
-    USE indices
-
-    USE profil_parameter
-
-    USE statistics
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
-    CHARACTER (LEN=*) ::  unit      !<
-    CHARACTER (LEN=*) ::  variable  !<
-
-    INTEGER(iwp) ::  var_count     !<
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 't_soil', '#t_soil' )
-          IF (  .NOT.  land_surface )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is ' //&
-                              'not implemented for land_surface = .FALSE.'
-             CALL message( 'lsm_check_data_output_pr', 'PA0402', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 89
-             dopr_unit     = 'K'
-             hom(0:nzs-1,2,89,:)  = SPREAD( - zs(nzb_soil:nzt_soil), 2, statistic_regions+1 )
-             IF ( data_output_pr(var_count)(1:1) == '#' )  THEN
-                dopr_initial_index(var_count) = 90
-                hom(0:nzs-1,2,90,:)   = SPREAD( - zs(nzb_soil:nzt_soil), 2, statistic_regions+1 )
-                data_output_pr(var_count)     = data_output_pr(var_count)(2:)
-             ENDIF
-             unit = dopr_unit
-          ENDIF
-
-       CASE ( 'm_soil', '#m_soil' )
-          IF (  .NOT.  land_surface )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is' // &
-                              ' not implemented for land_surface = .FALSE.'
-             CALL message( 'lsm_check_data_output_pr', 'PA0402', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 91
-             dopr_unit     = 'm3/m3'
-             hom(0:nzs-1,2,91,:)  = SPREAD( - zs(nzb_soil:nzt_soil), 2, statistic_regions+1 )
-             IF ( data_output_pr(var_count)(1:1) == '#' )  THEN
-                dopr_initial_index(var_count) = 92
-                hom(0:nzs-1,2,92,:)   = SPREAD( - zs(nzb_soil:nzt_soil), 2, statistic_regions+1 )
-                data_output_pr(var_count)     = data_output_pr(var_count)(2:)
-             ENDIF
-             unit = dopr_unit
-          ENDIF
-
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE lsm_check_data_output_pr
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for land surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_check_parameters
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_pt_b, bc_q_b, constant_flux_layer, message_string
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i        !< running index, x-dimension
-    INTEGER(iwp) ::  j        !< running index, y-dimension
-    INTEGER(iwp) ::  k        !< running index, z-dimension
-
-    LOGICAL      ::  dynamic_soil_input_parent !< flag indicating the presence of a dynamic input file for the parent
-
-!
-!-- Check for a valid setting of surface_type. The default value is 'netcdf'.
-!-- In that case, the surface types are read from NetCDF file.
-    IF ( TRIM( surface_type ) /= 'vegetation'  .AND.  TRIM( surface_type ) /= 'pavement'  .AND.    &
-         TRIM( surface_type ) /= 'water'       .AND.  TRIM( surface_type ) /= 'netcdf' )  THEN
-       message_string = 'unknown surface type: surface_type = "' // TRIM( surface_type ) // '"'
-       CALL message( 'lsm_check_parameters', 'PA0019', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Dirichlet boundary conditions are required as the surface fluxes are calculated from the
-!-- temperature/humidity gradients in the land surface model.
-    IF ( bc_pt_b == 'neumann'  .OR.  bc_q_b == 'neumann' )  THEN
-       message_string = 'lsm requires setting of' // 'bc_pt_b = "dirichlet" and ' //               &
-                        'bc_q_b  = "dirichlet"'
-       CALL message( 'lsm_check_parameters', 'PA0399', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( .NOT. constant_flux_layer )  THEN
-       message_string = 'lsm requires ' // 'constant_flux_layer = .T.'
-       CALL message( 'lsm_check_parameters', 'PA0400', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( .NOT. radiation )  THEN
-       message_string = 'lsm requires ' // 'the radiation model to be switched on'
-       CALL message( 'lsm_check_parameters', 'PA0400', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check if soil types are set within a valid range.
-    IF ( TRIM( surface_type ) == 'vegetation'  .OR.  TRIM( surface_type ) == 'pavement' )  THEN
-       IF ( soil_type < LBOUND( soil_pars, 2 )  .AND.  soil_type > UBOUND( soil_pars, 2 ) )  THEN
-          WRITE( message_string, * ) 'soil_type = ', soil_type, ' is out ' // 'of the valid range'
-          CALL message( 'lsm_check_parameters', 'PA0452', 2, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-    IF ( TRIM( surface_type ) == 'netcdf' )  THEN
-       IF ( soil_type_f%from_file )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                IF ( soil_type_f%var_2d(j,i) /= soil_type_f%fill  .AND.                            &
-                     ( soil_type_f%var_2d(j,i) < LBOUND( soil_pars, 2 ) .OR.                       &
-                       soil_type_f%var_2d(j,i) > UBOUND( soil_pars, 2 ) ) )                        &
-                THEN
-                   WRITE( message_string, * ) 'soil_type = is out  of ' //                         &
-                                              'the valid range at (j,i) = ', j, i
-                   CALL message( 'lsm_check_parameters', 'PA0452', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Check if vegetation types are set within a valid range.
-    IF ( TRIM( surface_type ) == 'vegetation' )  THEN
-       IF ( vegetation_type < LBOUND( vegetation_pars, 2 )  .AND.                                  &
-            vegetation_type > UBOUND( vegetation_pars, 2 ) )  THEN
-          WRITE( message_string, * ) 'vegetation_type = ', vegetation_type,                        &
-                                     ' is out of the valid range'
-          CALL message( 'lsm_check_parameters', 'PA0526', 2, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-    IF ( TRIM( surface_type ) == 'netcdf' )  THEN
-       IF ( vegetation_type_f%from_file )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill  .AND.                   &
-                     ( vegetation_type_f%var(j,i) < LBOUND( vegetation_pars, 2 ) .OR.              &
-                       vegetation_type_f%var(j,i) > UBOUND( vegetation_pars, 2 ) ) )               &
-                THEN
-                   WRITE( message_string, * ) 'vegetation_type = is out of ' //                    &
-                                              'the valid range at (j,i) = ', j, i
-                   CALL message( 'lsm_check_parameters', 'PA0526', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Check if pavement types are set within a valid range.
-    IF ( TRIM( surface_type ) == 'pavement' )  THEN
-       IF ( pavement_type < LBOUND( pavement_pars, 2 )  .AND.                                      &
-            pavement_type > UBOUND( pavement_pars, 2 ) )  THEN
-          WRITE( message_string, * ) 'pavement_type = ', pavement_type, ' is out of the valid range'
-          CALL message( 'lsm_check_parameters', 'PA0527', 2, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-    IF ( TRIM( surface_type ) == 'netcdf' )  THEN
-       IF ( pavement_type_f%from_file )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill  .AND.                       &
-                     ( pavement_type_f%var(j,i) < LBOUND( pavement_pars, 2 ) .OR.                  &
-                       pavement_type_f%var(j,i) > UBOUND( pavement_pars, 2 ) ) )                   &
-                THEN
-                   WRITE( message_string, * ) 'pavement_type = is out of ' //                      &
-                                              'the valid range at (j,i) = ', j, i
-                   CALL message( 'lsm_check_parameters', 'PA0527', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Check if water types are set within a valid range.
-    IF ( TRIM( surface_type ) == 'water' )  THEN
-       IF ( water_type < LBOUND( water_pars, 2 )  .AND.  water_type > UBOUND( water_pars, 2 ) )    &
-       THEN
-          WRITE( message_string, * ) 'water_type = ', water_type, ' is out of the valid range'
-          CALL message( 'lsm_check_parameters', 'PA0528', 2, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-    IF ( TRIM( surface_type ) == 'netcdf' )  THEN
-       IF ( water_type_f%from_file )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                IF ( water_type_f%var(j,i) /= water_type_f%fill  .AND.                             &
-                     ( water_type_f%var(j,i) < LBOUND( water_pars, 2 ) .OR.                        &
-                       water_type_f%var(j,i) > UBOUND( water_pars, 2 ) ) )                         &
-                THEN
-                   WRITE( message_string, * ) 'water_type = is out  of ' //                        &
-                                              'the valid range at (j,i) = ', j, i
-                   CALL message( 'lsm_check_parameters', 'PA0528', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Check further settings for consistency.
-    IF ( TRIM( surface_type ) == 'vegetation' )  THEN
-
-       IF ( vegetation_type == 0 )  THEN
-          IF ( min_canopy_resistance == 9999999.9_wp )  THEN
-             message_string = 'vegetation_type = 0 (user defined)' //                              &
-                              'requires setting of min_canopy_resistance' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( leaf_area_index == 9999999.9_wp )  THEN
-             message_string = 'vegetation_type = 0 (user_defined)' //                              &
-                              'requires setting of leaf_area_index' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( vegetation_coverage == 9999999.9_wp )  THEN
-             message_string = 'vegetation_type = 0 (user_defined)' //                              &
-                              'requires setting of vegetation_coverage' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( canopy_resistance_coefficient == 9999999.9_wp)  THEN
-             message_string = 'vegetation_type = 0 (user_defined)' //                              &
-                              'requires setting of' // 'canopy_resistance_coefficient /= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( lambda_surface_stable == 9999999.9_wp )  THEN
-             message_string = 'vegetation_type = 0 (user_defined)' //                              &
-                              'requires setting of lambda_surface_stable' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( lambda_surface_unstable == 9999999.9_wp )  THEN
-             message_string = 'vegetation_type = 0 (user_defined)' //                              &
-                              'requires setting of lambda_surface_unstable' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( f_shortwave_incoming == 9999999.9_wp )  THEN
-             message_string = 'vegetation_type = 0 (user_defined)' //                              &
-                              'requires setting of f_shortwave_incoming' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( z0_vegetation == 9999999.9_wp )  THEN
-             message_string = 'vegetation_type = 0 (user_defined)' //                              &
-                              'requires setting of z0_vegetation' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( z0h_vegetation == 9999999.9_wp )  THEN
-             message_string = 'vegetation_type = 0 (user_defined)' //                              &
-                              'requires setting of z0h_vegetation' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-       IF ( vegetation_type == 1 )  THEN
-          IF ( vegetation_coverage /= 9999999.9_wp  .AND.  vegetation_coverage /= 0.0_wp )  THEN
-             message_string = 'vegetation_type = 1 (bare soil)' //                                 &
-                              ' requires vegetation_coverage = 0'
-             CALL message( 'lsm_check_parameters', 'PA0294', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-    ENDIF
-
-    IF ( TRIM( surface_type ) == 'water' )  THEN
-
-       IF ( water_type == 0 )  THEN
-
-          IF ( z0_water == 9999999.9_wp )  THEN
-             message_string = 'water_type = 0 (user_defined)' //                                   &
-                              'requires setting of z0_water' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0415', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( z0h_water == 9999999.9_wp )  THEN
-             message_string = 'water_type = 0 (user_defined)' //                                   &
-                              'requires setting of z0h_water' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0392', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( water_temperature == 9999999.9_wp )  THEN
-             message_string = 'water_type = 0 (user_defined)' //                                   &
-                              'requires setting of water_temperature' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0379', 1, 2, 0, 6, 0 )
-          ENDIF
-
-       ENDIF
-
-    ENDIF
-
-    IF ( TRIM( surface_type ) == 'pavement' )  THEN
-
-       IF ( ANY( dz_soil /= 9999999.9_wp )  .AND.  pavement_type /= 0 )  THEN
-          message_string = 'non-default setting of dz_soil ' //                                    &
-                           'does not allow to use pavement_type /= 0)'
-          CALL message( 'lsm_check_parameters', 'PA0341', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( pavement_type == 0 )  THEN
-
-          IF ( z0_pavement == 9999999.9_wp )  THEN
-             message_string = 'pavement_type = 0 (user_defined)' //                                &
-                              'requires setting of z0_pavement' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0352', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( z0h_pavement == 9999999.9_wp )  THEN
-             message_string = 'pavement_type = 0 (user_defined)' //                                &
-                              'requires setting of z0h_pavement' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0353', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( pavement_heat_conduct == 9999999.9_wp )  THEN
-             message_string = 'pavement_type = 0 (user_defined)' //                                &
-                              'requires setting of pavement_heat_conduct' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0342', 1, 2, 0, 6, 0 )
-          ENDIF
-
-           IF ( pavement_heat_capacity == 9999999.9_wp )  THEN
-             message_string = 'pavement_type = 0 (user_defined)' //                                &
-                              'requires setting of pavement_heat_capacity' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0139', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( pavement_depth_level == 0 )  THEN
-             message_string = 'pavement_type = 0 (user_defined)' //                                &
-                              'requires setting of pavement_depth_level' // '/= 0'
-             CALL message( 'lsm_check_parameters', 'PA0474', 1, 2, 0, 6, 0 )
-          ENDIF
-
-       ENDIF
-
-    ENDIF
-
-    IF ( TRIM( surface_type ) == 'netcdf' )  THEN
-       IF ( pavement_type_f%from_file )  THEN
-          IF ( ANY( pavement_type_f%var /= pavement_type_f%fill )  .AND.                           &
-               ANY( dz_soil /= 9999999.9_wp ) )  THEN
-             message_string = 'pavement-surfaces are not allowed in ' //                           &
-                              'combination with a non-default setting of dz_soil'
-             CALL message( 'lsm_check_parameters', 'PA0316', 2, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-
-!
-!-- Temporary message as long as NetCDF input is not available
-    IF ( TRIM( surface_type ) == 'netcdf'  .AND.  .NOT. input_pids_static )  THEN
-       message_string = 'surface_type = netcdf requires static input file.'
-       CALL message( 'lsm_check_parameters', 'PA0465', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( soil_type == 0  .AND.  .NOT. input_pids_static )  THEN
-
-       IF ( alpha_vangenuchten == 9999999.9_wp )  THEN
-          message_string = 'soil_type = 0 (user_defined)' //                                       &
-                           'requires setting of alpha_vangenuchten' // '/= 9999999.9'
-          CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( l_vangenuchten == 9999999.9_wp )  THEN
-          message_string = 'soil_type = 0 (user_defined)' //                                       &
-                           'requires setting of l_vangenuchten' // '/= 9999999.9'
-          CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( n_vangenuchten == 9999999.9_wp )  THEN
-          message_string = 'soil_type = 0 (user_defined)' //                                       &
-                           'requires setting of n_vangenuchten' // '/= 9999999.9'
-          CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( hydraulic_conductivity == 9999999.9_wp )  THEN
-          message_string = 'soil_type = 0 (user_defined)' //                                       &
-                           'requires setting of hydraulic_conductivity' // '/= 9999999.9'
-          CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( saturation_moisture == 9999999.9_wp )  THEN
-          message_string = 'soil_type = 0 (user_defined)' //                                       &
-                           'requires setting of saturation_moisture' // '/= 9999999.9'
-          CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( field_capacity == 9999999.9_wp )  THEN
-          message_string = 'soil_type = 0 (user_defined)' //                                       &
-                           'requires setting of field_capacity' // '/= 9999999.9'
-          CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( wilting_point == 9999999.9_wp )  THEN
-          message_string = 'soil_type = 0 (user_defined)' //                                       &
-                           'requires setting of wilting_point' // '/= 9999999.9'
-          CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( residual_moisture == 9999999.9_wp )  THEN
-          message_string = 'soil_type = 0 (user_defined)' //                                       &
-                           'requires setting of residual_moisture' // '/= 9999999.9'
-          CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDIF
-
-!
-!-- Determine number of soil layers to be used and check whether an appropriate root fraction is
-!-- prescribed.
-    nzb_soil = 0
-    nzt_soil = -1
-    IF ( ALL( dz_soil == 9999999.9_wp ) )  THEN
-       nzt_soil = 7
-       dz_soil(nzb_soil:nzt_soil) = dz_soil_default
-    ELSE
-       DO k = 0, 19
-          IF ( dz_soil(k) /= 9999999.9_wp )  THEN
-             nzt_soil = nzt_soil + 1
-          ENDIF
-       ENDDO
-    ENDIF
-    nzs = nzt_soil + 1
-
-!
-!-- Check whether valid soil temperatures are prescribed. Only check this if no dynamic soil is not
-!-- initialized with dynamic input.
-!-- In a nested case, check whether there is a dynamic input file for the child
-!-- (input_pids_dynamic = .T.) or one for the parent (inquire without coupling_char).
-    INQUIRE( FILE = TRIM( input_file_dynamic ), EXIST = dynamic_soil_input_parent )
-
-    IF ( .NOT. input_pids_dynamic  .AND.  .NOT. dynamic_soil_input_parent )  THEN
-       IF ( COUNT( soil_temperature /= 9999999.9_wp ) /= nzs )  THEN
-          WRITE( message_string, * ) 'number of soil layers (', nzs, ') does not',                 &
-                                     ' match to the number of layers specified',                   &
-                                     ' in soil_temperature (',                                     &
-                                     COUNT( soil_temperature /= 9999999.9_wp ), ')'
-             CALL message( 'lsm_check_parameters', 'PA0471', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( deep_soil_temperature == 9999999.9_wp )  THEN
-             message_string = 'deep_soil_temperature is not set but must be' // '/= 9999999.9'
-             CALL message( 'lsm_check_parameters', 'PA0472', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-!
-!-- Check whether the sum of all root fractions equals one
-    IF ( .NOT. vegetation_type_f%from_file )  THEN
-       IF ( vegetation_type == 0 )  THEN
-          IF ( SUM( root_fraction(nzb_soil:nzt_soil) ) /= 1.0_wp )  THEN
-             message_string = 'vegetation_type = 0 (user_defined)' //                              &
-                              'requires setting of root_fraction' //                               &
-                              '/= 9999999.9 and SUM(root_fraction) = 1'
-             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- Calculate grid spacings. Temperature and moisture are defined at the center of the soil layers,
-!-- whereas gradients/fluxes are defined at the edges (_layer)
-!
-!-- Allocate global 1D arrays
-    ALLOCATE ( ddz_soil_center(nzb_soil:nzt_soil) )
-    ALLOCATE ( ddz_soil(nzb_soil:nzt_soil+1) )
-    ALLOCATE ( dz_soil_center(nzb_soil:nzt_soil) )
-    ALLOCATE ( zs(nzb_soil:nzt_soil+1) )
-
-
-    zs(nzb_soil) = 0.5_wp * dz_soil(nzb_soil)
-    zs_layer(nzb_soil) = dz_soil(nzb_soil)
-
-    DO  k = nzb_soil+1, nzt_soil
-       zs_layer(k) = zs_layer(k-1) + dz_soil(k)
-       zs(k) = (zs_layer(k) +  zs_layer(k-1)) * 0.5_wp
-    ENDDO
-
-    dz_soil(nzt_soil+1) = zs_layer(nzt_soil) + dz_soil(nzt_soil)
-    zs(nzt_soil+1) = zs_layer(nzt_soil) + 0.5_wp * dz_soil(nzt_soil)
-
-    DO  k = nzb_soil, nzt_soil-1
-       dz_soil_center(k) = zs(k+1) - zs(k)
-       IF ( dz_soil_center(k) <= 0.0_wp )  THEN
-          message_string = 'invalid soil layer configuration found ' // '(dz_soil_center(k) <= 0.0)'
-          CALL message( 'lsm_check_parameters', 'PA0140', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDDO
-
-    dz_soil_center(nzt_soil) = zs_layer(k-1) + dz_soil(k) - zs(nzt_soil)
-
-    ddz_soil_center = 1.0_wp / dz_soil_center
-    ddz_soil(nzb_soil:nzt_soil) = 1.0_wp / dz_soil(nzb_soil:nzt_soil)
-
- END SUBROUTINE lsm_check_parameters
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calls energy balance solver and soil energy model the surfaces in all directions.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_energy_balance( during_spinup )
-
-    USE control_parameters,                                                                        &
-        ONLY:  calc_soil_moisture_during_spinup
-
-    INTEGER(iwp) ::  l              !< loop index for surface types
-    LOGICAL      ::  during_spinup  !< flag indicating soil/wall spinup phase
-    LOGICAL      ::  calc_sm
-
-    calc_sm = .NOT. during_spinup .OR. calc_soil_moisture_during_spinup
-!
-!-- Call for horizontal surfaces
-    DO l = 0, 1
-       CALL lsm_surface_energy_balance( .TRUE., l )
-       CALL lsm_soil_model( .TRUE., l, calc_sm )
-    ENDDO
-!
-!--   Call for vertical surfaces
-    DO l = 0, 3
-       CALL lsm_surface_energy_balance( .FALSE., l )
-       CALL lsm_soil_model( .FALSE., l, calc_sm )
-    ENDDO
-
- END SUBROUTINE lsm_energy_balance
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Solver for the energy balance at the surface.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_surface_energy_balance( horizontal, l )
-
-    USE pegrid
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  rad_lw_out
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i         !< running index
-    INTEGER(iwp) ::  i_off     !< offset to determine index of surface element, seen from atmospheric grid point, for x
-    INTEGER(iwp) ::  j         !< running index
-    INTEGER(iwp) ::  j_off     !< offset to determine index of surface element, seen from atmospheric grid point, for y
-    INTEGER(iwp) ::  k         !< running index
-    INTEGER(iwp) ::  k_off     !< offset to determine index of surface element, seen from atmospheric grid point, for z
-    INTEGER(iwp) ::  ks        !< running index
-    INTEGER(iwp) ::  l         !< surface-facing index
-    INTEGER(iwp) ::  m         !< running index concerning wall elements
-
-    LOGICAL      ::  horizontal !< Flag indicating horizontal or vertical surfaces
-    LOGICAL      ::  upward     !< Flag indicating upward horizontal surfaces
-
-    REAL(wp) :: c_surface_tmp,  & !< temporary variable for storing the volumetric heat capacity of the surface
-                coef_1,         & !< coef. for prognostic equation
-                coef_2,         & !< coef. for prognostic equation
-                dq_s_dt,        & !< derivate of q_s with respect to T
-                e,              & !< water vapour pressure
-                e_s,            & !< water vapour saturation pressure
-                e_s_dt,         & !< derivate of e_s with respect to T
-                f_qsws,         & !< factor for qsws
-                f_qsws_liq,     & !< factor for qsws_liq
-                f_qsws_soil,    & !< factor for qsws_soil
-                f_qsws_veg,     & !< factor for qsws_veg
-                f_shf,          & !< factor for shf
-                f1,             & !< resistance correction term 1
-                f2,             & !< resistance correction term 2
-                f3,             & !< resistance correction term 3
-                lambda_soil,    & !< Thermal conductivity of the uppermost soil layer (W/m2/K)
-                lambda_surface, & !< Current value of lambda_surface (W/m2/K)
-                m_liq_max,      & !< maxmimum value of the liq. water reservoir
-                m_min,          & !< minimum soil moisture
-                tend,           & !< tendency
-                ueff              !< limited near-surface wind speed - used for calculation of resistance
-
-    TYPE(surf_type_lsm), POINTER ::  surf_m_liq
-    TYPE(surf_type_lsm), POINTER ::  surf_m_liq_p
-    TYPE(surf_type_lsm), POINTER ::  surf_t_surface
-    TYPE(surf_type_lsm), POINTER ::  surf_t_surface_p
-    TYPE(surf_type_lsm), POINTER ::  surf_tm_liq_m
-    TYPE(surf_type_lsm), POINTER ::  surf_tt_surface_m
-
-    TYPE(surf_type_lsm), POINTER ::  surf_m_soil
-    TYPE(surf_type_lsm), POINTER ::  surf_t_soil
-
-    TYPE(surf_type), POINTER  ::  surf  !< surface-date type variable
-
-
-    IF ( debug_output_timestep )  THEN
-       WRITE( debug_string, * ) 'lsm_surface_energy_balance', horizontal, l
-       CALL debug_message( debug_string, 'start' )
-    ENDIF
-
-    upward = .FALSE.
-    IF ( horizontal )  THEN
-       surf              => surf_lsm_h(l)
-       surf_t_surface    => t_surface_h(l)
-       surf_t_surface_p  => t_surface_h_p(l)
-       surf_tt_surface_m => tt_surface_h_m(l)
-       surf_m_liq        => m_liq_h(l)
-       surf_m_liq_p      => m_liq_h_p(l)
-       surf_tm_liq_m     => tm_liq_h_m(l)
-       surf_m_soil       => m_soil_h(l)
-       surf_t_soil       => t_soil_h(l)
-       IF ( l == 0 ) upward = .TRUE.
-    ELSE
-       surf              => surf_lsm_v(l)
-       surf_t_surface    => t_surface_v(l)
-       surf_t_surface_p  => t_surface_v_p(l)
-       surf_tt_surface_m => tt_surface_v_m(l)
-       surf_m_liq        => m_liq_v(l)
-       surf_m_liq_p      => m_liq_v_p(l)
-       surf_tm_liq_m     => tm_liq_v_m(l)
-       surf_m_soil       => m_soil_v(l)
-       surf_t_soil       => t_soil_v(l)
-    ENDIF
-
-!
-!-- Index offset of surface element point with respect to adjoining atmospheric grid point
-    k_off = surf%koff
-    j_off = surf%joff
-    i_off = surf%ioff
-
-    !$OMP PARALLEL DO PRIVATE (m, i, j, k, lambda_h_sat, ke, lambda_soil, lambda_surface, ueff,    &
-    !$OMP&                     c_surface_tmp, f1,m_total, f2, e_s, e, f3, m_min, m_liq_max, q_s,   &
-    !$OMP&                     f_qsws_veg, f_qsws_soil, f_qsws_liq, f_shf, f_qsws, e_s_dt, dq_s_dt,&
-    !$OMP&                     coef_1, coef_2, tend) SCHEDULE (STATIC)
-    DO  m = 1, surf%ns
-
-       i = surf%i(m)
-       j = surf%j(m)
-       k = surf%k(m)
-
-!
-!--    Define heat conductivity between surface and soil depending on surface type. For vegetation,
-!--    a skin layer parameterization is used. The new parameterization uses a combination of two
-!--    conductivities: a constant conductivity for the skin layer, and a conductivity according to
-!--    the uppermost soil layer. For bare soil and pavements, no skin layer is applied. In these
-!--    cases, the temperature is assumed to be constant between the surface and the first soil
-!--    layer. The heat conductivity is then derived from the soil/pavement properties.
-!--    For water surfaces, the conductivity is already set to 1E10.
-!--    Moreover, the heat capacity is set. For bare soil the heat capacity is the capacity of the
-!--    uppermost soil layer, for pavement it is that of the material involved.
-
-!
-!--    For vegetation type surfaces, the thermal conductivity of the soil is needed.
-
-       IF ( surf%vegetation_surface(m) )  THEN
-
-          lambda_h_sat = lambda_h_sm**(1.0_wp - surf%m_sat(nzb_soil,m)) *                          &
-                         lambda_h_water ** surf_m_soil%var_2d(nzb_soil,m)
-
-          ke = 1.0_wp + LOG10( MAX( 0.1_wp, surf_m_soil%var_2d(nzb_soil,m) /                       &
-                                    surf%m_sat(nzb_soil,m) ) )
-
-          lambda_soil = ( ke * ( lambda_h_sat - lambda_h_dry ) + lambda_h_dry )                    &
-                        * ddz_soil(nzb_soil) * 2.0_wp
-
-!
-!--       When bare soil is set without a thermal conductivity (no skin layer), the heat capacity is
-!--       that of the soil layer, otherwise it is a combination of the conductivities from the skin
-!--       and the soil layer.
-          IF ( surf%lambda_surface_s(m) == 0.0_wp )  THEN
-            surf%c_surface(m) = ( rho_c_soil * ( 1.0_wp - surf%m_sat(nzb_soil,m) )                 &
-                                + rho_c_water * surf_m_soil%var_2d(nzb_soil,m) )                   &
-                                * dz_soil(nzb_soil) * 0.5_wp
-            lambda_surface = lambda_soil
-
-          ELSEIF ( surf_t_surface%var_1d(m) >= surf_t_soil%var_2d(nzb_soil,m) )                    &
-          THEN
-             lambda_surface = surf%lambda_surface_s(m) * lambda_soil                               &
-                              / ( surf%lambda_surface_s(m) + lambda_soil )
-          ELSE
-
-             lambda_surface = surf%lambda_surface_u(m) * lambda_soil                               &
-                              / ( surf%lambda_surface_u(m) + lambda_soil )
-          ENDIF
-       ELSE
-          lambda_surface = surf%lambda_surface_s(m)
-       ENDIF
-
-!
-!--    Set heat capacity of the skin/surface. It is ususally zero when a skin layer is used, and
-!--    non-zero otherwise.
-       c_surface_tmp = surf%c_surface(m)
-
-!
-!--    First step: calculate aerodyamic resistance. As pt, us, ts are not available for the
-!--    prognostic time step, data from the last time step is used here. Note that this formulation
-!--    is the equivalent to the ECMWF formulation using drag coefficients.
-!        IF ( bulk_cloud_model )  THEN
-!           pt1 = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
-!           qv1 = q(k,j,i) - ql(k,j,i)
-!        ELSEIF ( cloud_droplets )  THEN
-!           pt1 = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
-!           qv1 = q(k,j,i)
-!        ELSE
-!           pt1 = pt(k,j,i)
-!           IF ( humidity )  THEN
-!              qv1 = q(k,j,i)
-!           ELSE
-!              qv1 = 0.0_wp
-!           ENDIF
-!        ENDIF
-!
-!--     Calculation of r_a for vertical and horizontal downward surfaces
-!--
-!--     Heat transfer coefficient for forced convection along vertical walls follows formulation in
-!--     TUF3d model (Krayenhoff & Voogt, 2006).
-!--
-!--       H = httc (Tsfc - Tair)
-!--       httc = rw * (11.8 + 4.2 * Ueff) - 4.0
-!--
-!--             rw: wall patch roughness relative to 1.0 for concrete
-!--             Ueff: effective wind speed
-!--             - 4.0 is a reduction of Rowley et al (1930) formulation based on
-!--             Cole and Sturrock (1977)
-!--
-!--             Ucan: Canyon wind speed
-!--             wstar: convective velocity
-!--             Qs: surface heat flux
-!--             zH: height of the convective layer
-!--             wstar = (g/Tcan*Qs*zH)**(1./3.)
-
-!--    Effective velocity components must always be defined at scalar grid point. The wall normal
-!--    component is obtained by simple linear interpolation. (An alternative would be a logarithmic
-!--    interpolation.)
-!--    A roughness lenght of 0.001 is assumed for concrete (the inverse, 1000 is used in the
-!--    nominator for scaling).
-!--    To do: detailed investigation which approach gives more reliable results!
-!--    Please note, in case of very small friction velocity, e.g. in little holes, the resistance
-!--    can become negative. For this reason, limit r_a to positive values.
-       IF ( upward .OR.  .NOT. aero_resist_kray )  THEN
-          surf%r_a(m) = ABS( ( surf%pt1(m) - surf%pt_surface(m) ) /                               &
-                             ( surf%ts(m) * surf%us(m) + 1.0E-20_wp ) )
-       ELSE
-!
-!--       Limit wind velocity in order to avoid division by zero.
-!--       The nominator can become <= 0.0 for values z0 < 3*10E-4.
-          ueff = MAX( SQRT(  ( ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp )**2 +                           &
-                             ( ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp )**2 +                           &
-                             ( ( w(k,j,i) + w(k-1,j,i) ) * 0.5_wp )**2 ),                          &
-                      1.0_wp / 4.2_wp * ( 4.0_wp / ( surf%z0(m) * 1000.0_wp ) - 11.8_wp ), 0.1_wp )
-          surf%r_a(m) = rho_cp / ( surf%z0(m) * 1000.0_wp * ( 11.8_wp + 4.2_wp * ueff ) - 4.0_wp )
-       ENDIF
-!
-!--    Make sure that the resistance does not drop to zero for neutral stratification. Also, set a
-!--    maximum resistance to avoid the breakdown of MOST for locations with zero wind speed.
-       IF ( surf%r_a(m) <   1.0_wp )  surf%r_a(m) =   1.0_wp
-       IF ( surf%r_a(m) > 300.0_wp )  surf%r_a(m) = 300.0_wp
-!
-!--    Second step: calculate canopy resistance r_canopy f1-f3 here are defined as 1/f1-f3 as in
-!--    ECMWF documentation
-
-!--    f1: correction for incoming shortwave radiation (stomata close at night)
-       f1 = MIN( 1.0_wp, ( 0.004_wp * surf%rad_sw_in(m) + 0.05_wp ) /                              &
-                         ( 0.81_wp * ( 0.004_wp * surf%rad_sw_in(m) + 1.0_wp) ) )
-
-!
-!--    f2: correction for soil moisture availability to plants (the integrated soil moisture must
-!--        thus be considered here)
-!--    f2 = 0 for very dry soils
-       m_total = 0.0_wp
-       DO  ks = nzb_soil, nzt_soil
-           m_total = m_total + surf%root_fr(ks,m)                                                  &
-                     * MAX( surf_m_soil%var_2d(ks,m), surf%m_wilt(ks,m) )
-       ENDDO
-
-!
-!--    The calculation of f2 is based on only one wilting point value for all soil layers. The value
-!--    at k=nzb_soil is used here as a proxy but might need refinement in the future.
-       IF ( m_total > surf%m_wilt(nzb_soil,m)  .AND.  m_total < surf%m_fc(nzb_soil,m) )  THEN
-          f2 = ( m_total - surf%m_wilt(nzb_soil,m) ) /                                             &
-               ( surf%m_fc(nzb_soil,m) - surf%m_wilt(nzb_soil,m) )
-       ELSEIF ( m_total >= surf%m_fc(nzb_soil,m) )  THEN
-          f2 = 1.0_wp
-       ELSE
-          f2 = 1.0E-20_wp
-       ENDIF
-
-!
-!--    Calculate water vapour pressure at saturation and convert to hPa.
-!--    The magnus formula is limited to temperatures up to 333.15 K to avoid negative values of q_s.
-       e_s = 0.01_wp * magnus( MIN(surf_t_surface%var_1d(m), 333.15_wp) )
-
-!
-!--    f3: correction for vapour pressure deficit
-       IF ( surf%g_d(m) /= 0.0_wp )  THEN
-!
-!--       Calculate vapour pressure
-          e  = surf%qv1(m) * surface_pressure / ( surf%qv1(m) + rd_d_rv )
-          f3 = EXP ( - surf%g_d(m) * (e_s - e) )
-       ELSE
-          f3 = 1.0_wp
-       ENDIF
-!
-!--    Calculate canopy resistance. In case that c_veg is 0 (bare soils),
-!--    this calculation is obsolete, as r_canopy is not used below.
-!--    To do: check for very dry soil -> r_canopy goes to infinity.
-       surf%r_canopy(m) = surf%r_canopy_min(m) / ( surf%lai(m) * f1 * f2 * f3 + 1.0E-20_wp )
-!
-!--    Third step: calculate bare soil resistance r_soil.
-       m_min = surf%c_veg(m) * surf%m_wilt(nzb_soil,m) +                                           &
-               ( 1.0_wp - surf%c_veg(m) ) * surf%m_res(nzb_soil,m)
-
-
-       f2 = ( surf_m_soil%var_2d(nzb_soil,m) - m_min ) / ( surf%m_fc(nzb_soil,m) - m_min )
-       f2 = MAX( f2, 1.0E-20_wp )
-       f2 = MIN( f2, 1.0_wp     )
-
-       surf%r_soil(m) = surf%r_soil_min(m) / f2
-
-!
-!--    Calculate the maximum possible liquid water amount on plants and bare surface. For vegetated
-!--    surfaces, a maximum depth of 0.2 mm is assumed, while paved surfaces might hold up 1 mm of
-!--    water. The liquid water fraction for paved surfaces is calculated after Masson (2000)
-!--    (TEB model) and originates from Noilhan & Planton (1989), while the ECMWF formulation is used
-!--    for vegetated surfaces and bare soils.
-       IF ( surf%pavement_surface(m) )  THEN
-          m_liq_max = m_max_depth * 5.0_wp
-          surf%c_liq(m) = MIN( 1.0_wp, ( surf_m_liq%var_1d(m) / m_liq_max)**0.67 )
-       ELSE
-          m_liq_max = m_max_depth * ( surf%c_veg(m) * surf%lai(m)              &
-                      + ( 1.0_wp - surf%c_veg(m) ) )
-          surf%c_liq(m) = MIN( 1.0_wp, surf_m_liq%var_1d(m) / m_liq_max )
-       ENDIF
-!
-!--    Calculate saturation water vapor mixing ratio
-       q_s = rd_d_rv * e_s / ( surface_pressure - e_s )
-!
-!--    In case of dewfall, set evapotranspiration to zero.
-!--    All super-saturated water is then removed from the air.
-       IF ( humidity  .AND.  q_s <= surf%qv1(m) )  THEN
-          surf%r_canopy(m) = 0.0_wp
-          surf%r_soil(m)   = 0.0_wp
-       ENDIF
-
-!
-!--    Calculate coefficients for the total evapotranspiration.
-!--    In case of water surface, set vegetation and soil fluxes to zero.
-!--    For pavements, only evaporation of liquid water is possible.
-       IF ( surf%water_surface(m) )  THEN
-          f_qsws_veg  = 0.0_wp
-          f_qsws_soil = 0.0_wp
-          f_qsws_liq  = rho_lv / surf%r_a(m)
-       ELSEIF ( surf%pavement_surface(m) )  THEN
-          f_qsws_veg  = 0.0_wp
-          f_qsws_soil = 0.0_wp
-          f_qsws_liq  = rho_lv * surf%c_liq(m) / surf%r_a(m)
-       ELSE
-          f_qsws_veg  = rho_lv * surf%c_veg(m) *                                                   &
-                            ( 1.0_wp        - surf%c_liq(m)  ) /                                   &
-                            ( surf%r_a(m) + surf%r_canopy(m) )
-          f_qsws_soil = rho_lv * (1.0_wp    - surf%c_veg(m)  )                                     &
-                               * (1.0_wp    - surf%c_liq(m)  ) /                                   &
-                            ( surf%r_a(m) + surf%r_soil(m)   )
-          f_qsws_liq  = rho_lv * surf%c_liq(m) / surf%r_a(m)
-       ENDIF
-
-       f_shf  = rho_cp / surf%r_a(m)
-       f_qsws = f_qsws_veg + f_qsws_soil + f_qsws_liq
-!
-!--    Calculate derivative of q_s for Taylor series expansion
-       e_s_dt = e_s * ( 17.62_wp / ( surf_t_surface%var_1d(m) -  29.65_wp) -                       &
-                        17.62_wp * ( surf_t_surface%var_1d(m) - 273.15_wp)                         &
-                       / ( surf_t_surface%var_1d(m) - 29.65_wp)**2 )
-
-       dq_s_dt = rd_d_rv * e_s_dt / ( surface_pressure - e_s_dt )
-!
-!--    Calculate net radiation radiation without longwave outgoing flux because it has a dependency
-!--    on surface temperature and thus enters the prognostic equations directly.
-       surf%rad_net_l(m) = surf%rad_sw_in(m) - surf%rad_sw_out(m) + surf%rad_lw_in(m)
-!
-!--    Calculate new skin temperature
-       IF ( humidity )  THEN
-!
-!--       Numerator of the prognostic equation
-          coef_1 = surf%rad_net_l(m) + surf%rad_lw_out_change_0(m) * surf_t_surface%var_1d(m)      &
-                   - surf%rad_lw_out(m) + f_shf * surf%pt1(m)                                      &
-                   + f_qsws * ( surf%qv1(m) - q_s + dq_s_dt * surf_t_surface%var_1d(m) )           &
-                   + lambda_surface * surf_t_soil%var_2d(nzb_soil,m)
-
-!
-!--       Denominator of the prognostic equation
-          coef_2 = surf%rad_lw_out_change_0(m) + f_qsws * dq_s_dt + lambda_surface                 &
-                   + f_shf / exner(nzb)
-       ELSE
-!
-!--       Numerator of the prognostic equation
-          coef_1 = surf%rad_net_l(m) + surf%rad_lw_out_change_0(m) * surf_t_surface%var_1d(m)      &
-                   - surf%rad_lw_out(m) + f_shf * surf%pt1(m)                                      &
-                   + lambda_surface * surf_t_soil%var_2d(nzb_soil,m)
-!
-!--       Denominator of the prognostic equation
-          coef_2 = surf%rad_lw_out_change_0(m) + lambda_surface + f_shf / exner(nzb)
-
-       ENDIF
-
-       tend = 0.0_wp
-
-!
-!--    Implicit solution when the surface layer has no heat capacity, otherwise use RK3 scheme.
-       surf_t_surface_p%var_1d(m) = ( coef_1 * dt_3d * tsc(2) + c_surface_tmp *                    &
-                                      surf_t_surface%var_1d(m) ) / ( c_surface_tmp + coef_2        &
-                                                                     * dt_3d * tsc(2) )
-
-!
-!--    Add RK3 term
-       IF ( c_surface_tmp /= 0.0_wp )  THEN
-
-          surf_t_surface_p%var_1d(m) = surf_t_surface_p%var_1d(m) + dt_3d * tsc(3) *               &
-                                                                    surf_tt_surface_m%var_1d(m)
-
-!
-!--       Calculate true tendency
-          tend = ( surf_t_surface_p%var_1d(m) - surf_t_surface%var_1d(m) -                         &
-                   dt_3d * tsc(3) * surf_tt_surface_m%var_1d(m) ) / ( dt_3d  * tsc(2) )
-!
-!--       Calculate t_surface tendencies for the next Runge-Kutta step
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( intermediate_timestep_count == 1 )  THEN
-                surf_tt_surface_m%var_1d(m) = tend
-             ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                surf_tt_surface_m%var_1d(m) = -9.5625_wp * tend +                                  &
-                                               5.3125_wp * surf_tt_surface_m%var_1d(m)
-             ENDIF
-          ENDIF
-       ENDIF
-
-!
-!--    In case of fast changes in the skin temperature, it is possible to update the radiative
-!--    fluxes independently from the prescribed radiation call frequency. This effectively prevents
-!--    oscillations, especially when setting skip_time_do_radiation /= 0. The threshold value of 0.2
-!--    used here is just a first guess. This method should be revised in the future as tests have
-!--    shown that the threshold is often reached, when no oscillations would occur (causes immense
-!--    computing time for the radiation code).
-       IF ( ABS( surf_t_surface_p%var_1d(m) - surf_t_surface%var_1d(m) ) > 0.2_wp  .AND.           &
-            unscheduled_radiation_calls )  THEN
-          force_radiation_call_l = .TRUE.
-       ENDIF
-
-       surf%pt_surface(m) = surf_t_surface_p%var_1d(m) / exner(nzb)
-
-!
-!--    Calculate fluxes
-       surf%rad_net_l(m) = surf%rad_net_l(m)                                                       &
-                           + surf%rad_lw_out_change_0(m) * surf_t_surface%var_1d(m)                &
-                           - surf%rad_lw_out(m)                                                    &
-                           - surf%rad_lw_out_change_0(m) * surf_t_surface_p%var_1d(m)
-
-       surf%rad_net(m) = surf%rad_net_l(m)
-       surf%rad_lw_out(m) = surf%rad_lw_out(m) + surf%rad_lw_out_change_0(m) *                     &
-                            ( surf_t_surface_p%var_1d(m) - surf_t_surface%var_1d(m) )
-
-       surf%ghf(m) = lambda_surface * ( surf_t_surface_p%var_1d(m)                                 &
-                                        - surf_t_soil%var_2d(nzb_soil,m) )
-
-       surf%shf(m) = - f_shf * ( surf%pt1(m) - surf%pt_surface(m) ) / c_p
-!
-!--    Update the 3d field of rad_lw_out array to have consistent output
-       IF ( upward )  THEN
-          IF ( radiation_scheme == 'rrtmg' )  THEN
-             rad_lw_out(k+k_off,j+j_off,i+i_off) = surf%rad_lw_out(m)
-          ELSE
-             rad_lw_out(0,j+j_off,i+i_off) = surf%rad_lw_out(m)
-          ENDIF
-       ENDIF
-
-       IF ( humidity )  THEN
-          surf%qsws(m) = - f_qsws * ( surf%qv1(m) - q_s + dq_s_dt * surf_t_surface%var_1d(m)       &
-                                      - dq_s_dt * surf_t_surface_p%var_1d(m) )
-
-          surf%qsws_veg(m) = - f_qsws_veg  * ( surf%qv1(m) - q_s                                   &
-                             + dq_s_dt * surf_t_surface%var_1d(m) - dq_s_dt                        &
-                             * surf_t_surface_p%var_1d(m) )
-
-          surf%qsws_soil(m) = - f_qsws_soil * ( surf%qv1(m) - q_s                                  &
-                              + dq_s_dt * surf_t_surface%var_1d(m) - dq_s_dt                       &
-                              * surf_t_surface_p%var_1d(m) )
-
-          surf%qsws_liq(m) = - f_qsws_liq  * ( surf%qv1(m) - q_s                                   &
-                             + dq_s_dt * surf_t_surface%var_1d(m) - dq_s_dt                        &
-                             * surf_t_surface_p%var_1d(m) )
-       ENDIF
-
-!
-!--    Calculate the true surface resistance. ABS is used here to avoid negative values that can
-!--    occur for very small fluxes due to the artifical addition of 1.0E-20.
-       IF ( .NOT.  humidity )  THEN
-          surf%r_s(m) = 1.0E10_wp
-       ELSE
-          surf%r_s(m) = ABS( rho_lv / ( f_qsws + 1.0E-20_wp ) - surf%r_a(m) )
-       ENDIF
-!
-!--    Calculate change in liquid water reservoir due to dew fall or evaporation of liquid water.
-       IF ( humidity )  THEN
-!
-!--       If precipitation is activated, add rain water to qsws_liq and qsws_soil according to the
-!--       vegetation coverage.
-!--       precipitation_rate is given in mm.
-          IF ( precipitation )  THEN
-
-!
-!--          Add precipitation to liquid water reservoir, if possible.
-!--          Otherwise, add the water to soil. In case of pavements, the exceeding water amount is
-!--          explicitly removed (as fictive runoff by drainage systems).
-             IF ( surf%pavement_surface(m) )  THEN
-                IF ( surf_m_liq%var_1d(m) < m_liq_max )  THEN
-                   surf%qsws_liq(m) = surf%qsws_liq(m)                                             &
-                                      + prr(k+k_off,j+j_off,i+i_off)                               &
-                                      * hyrho(k+k_off)                                             &
-                                      * 0.001_wp * rho_l * l_v
-                ENDIF
-             ELSE
-                IF ( surf_m_liq%var_1d(m) < m_liq_max )  THEN
-                   surf%qsws_liq(m) = surf%qsws_liq(m)                                             &
-                                      + surf%c_veg(m) * prr(k+k_off,j+j_off,i+i_off)               &
-                                      * hyrho(k+k_off)                                             &
-                                      * 0.001_wp * rho_l * l_v
-                   surf%qsws_soil(m) = surf%qsws_soil(m)                                           &
-                                       + ( 1.0_wp - surf%c_veg(m) ) * prr(k+k_off,j+j_off,i+i_off) &
-                                       * hyrho(k+k_off)                                            &
-                                       * 0.001_wp * rho_l * l_v
-                ELSE
-
-!--                Add precipitation to bare soil according to the bare soil coverage.
-                   surf%qsws_soil(m) = surf%qsws_soil(m)                                           &
-                                       + surf%c_veg(m) * prr(k+k_off,j+j_off,i+i_off)              &
-                                       * hyrho(k+k_off)                                            &
-                                       * 0.001_wp * rho_l * l_v
-
-                ENDIF
-             ENDIF
-
-          ENDIF
-
-!
-!--       If the air is saturated, check the reservoir water level.
-          IF ( surf%qsws(m) < 0.0_wp )  THEN
-!
-!--          Check if reservoir is full (avoid values > m_liq_max).
-!--          In that case, qsws_liq goes to qsws_soil for pervious surfaces. In this case qsws_veg
-!--          is zero anyway (because c_liq = 1), so that tend is zero and no further check is
-!--          needed.
-             IF ( surf_m_liq%var_1d(m) == m_liq_max )  THEN
-                IF ( .NOT. surf%pavement_surface(m))  THEN
-                   surf%qsws_soil(m) = surf%qsws_soil(m) + surf%qsws_liq(m)
-                ENDIF
-                surf%qsws_liq(m)  = 0.0_wp
-             ENDIF
-
-!
-!--          In case qsws_veg becomes negative (unphysical behavior), let the water enter the liquid
-!--          water reservoir as dew on the plant.
-             IF ( surf%qsws_veg(m) < 0.0_wp )  THEN
-                surf%qsws_liq(m) = surf%qsws_liq(m) + surf%qsws_veg(m)
-                surf%qsws_veg(m) = 0.0_wp
-             ENDIF
-          ENDIF
-
-          surf%qsws(m) = surf%qsws(m) / l_v
-
-          tend = - surf%qsws_liq(m) * drho_l_lv
-          surf_m_liq_p%var_1d(m) = surf_m_liq%var_1d(m) + dt_3d *                                  &
-                                      ( tsc(2) * tend + tsc(3) * surf_tm_liq_m%var_1d(m) )
-!
-!--       Check if reservoir is overfull -> reduce to maximum (conservation of water is violated
-!--       here).
-          surf_m_liq_p%var_1d(m) = MIN( surf_m_liq_p%var_1d(m),m_liq_max )
-
-!
-!--       Check if reservoir is empty (avoid values < 0.0) (conservation of water is violated here).
-          surf_m_liq_p%var_1d(m) = MAX( surf_m_liq_p%var_1d(m), 0.0_wp )
-!
-!--       Calculate m_liq tendencies for the next Runge-Kutta step
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( intermediate_timestep_count == 1 )  THEN
-                surf_tm_liq_m%var_1d(m) = tend
-             ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                surf_tm_liq_m%var_1d(m) = -9.5625_wp * tend + 5.3125_wp * surf_tm_liq_m%var_1d(m)
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-    ENDDO
-
-!
-!-- Make a logical OR for all processes. Force radiation call if at least one processor reached the
-!-- threshold change in skin temperature.
-    IF ( unscheduled_radiation_calls  .AND.  intermediate_timestep_count                           &
-         == intermediate_timestep_count_max-1 )  THEN
-#if defined( __parallel )
-       IF ( .NOT. force_radiation_call )  THEN
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_ALLREDUCE( force_radiation_call_l, force_radiation_call, 1, MPI_LOGICAL,        &
-                              MPI_LOR, comm2d, ierr )
-       ENDIF
-#else
-       force_radiation_call = force_radiation_call .OR. force_radiation_call_l
-#endif
-       force_radiation_call_l = .FALSE.
-    ENDIF
-
-!
-!-- Calculate surface water vapor mixing ratio
-    IF ( humidity )  THEN
-       CALL calc_q_surface
-    ENDIF
-!
-!-- Calculate new roughness lengths (for water surfaces only)
-    IF ( upward .AND.  .NOT. constant_roughness )  CALL calc_z0_water_surface
-
-    IF ( debug_output_timestep )  THEN
-       WRITE( debug_string, * ) 'lsm_surface_energy_balance', horizontal, l
-       CALL debug_message( debug_string, 'end' )
-    ENDIF
-
-    CONTAINS
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of mixing ratio of the skin layer (surface). It is assumend that the skin is always
-!> saturated.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE calc_q_surface
-
-       IMPLICIT NONE
-
-       REAL(wp) ::  e_s           !< saturation water vapor pressure
-       REAL(wp) ::  q_s           !< saturation mixing ratio
-       REAL(wp) ::  resistance    !< aerodynamic and soil resistance term
-
-
-       !$OMP PARALLEL DO PRIVATE (m, i, j, k, e_s, q_s, resistance) SCHEDULE (STATIC)
-       DO  m = 1, surf%ns
-
-          i = surf%i(m)
-          j = surf%j(m)
-          k = surf%k(m)
-!
-!--       Calculate water vapour pressure at saturation and convert to hPa
-          e_s = 0.01_wp * magnus( MIN(surf_t_surface_p%var_1d(m), 333.15_wp) )
-
-!
-!--       Calculate mixing ratio at saturation
-          q_s = rd_d_rv * e_s / ( surface_pressure - e_s )
-
-          resistance = surf%r_a(m) / ( surf%r_a(m) + surf%r_s(m) + 1E-5_wp )
-
-!
-!--       Calculate mixing ratio at surface
-          IF ( bulk_cloud_model )  THEN
-             q(k+k_off,j+j_off,i+i_off) = resistance * q_s +                                       &
-                                          ( 1.0_wp - resistance ) * ( q(k,j,i) - ql(k,j,i) )
-          ELSE
-             q(k+k_off,j+j_off,i+i_off) = resistance * q_s +                                       &
-                                          ( 1.0_wp - resistance ) * q(k,j,i)
-          ENDIF
-
-          surf%q_surface(m) = q(k+k_off,j+j_off,i+i_off)
-!
-!--       Update virtual potential temperature
-          surf%vpt_surface(m) = surf%pt_surface(m) * ( 1.0_wp + 0.61_wp * surf%q_surface(m) )
-
-       ENDDO
-
-    END SUBROUTINE calc_q_surface
-
- END SUBROUTINE lsm_surface_energy_balance
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for land surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_header ( io )
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=20) ::  coor_chr            !< Temporary string
-    CHARACTER (LEN=86) ::  m_soil_chr          !< String for soil moisture
-    CHARACTER (LEN=86) ::  roots_chr           !< String for root profile
-    CHARACTER (LEN=86) ::  soil_depth_chr      !< String for soil depth
-    CHARACTER (LEN=86) ::  t_soil_chr          !< String for soil temperature profile
-    CHARACTER (LEN=86) ::  vertical_index_chr  !< String for the vertical index
-
-    INTEGER(iwp) ::  i                         !< Loop index over soil layers
-
-    INTEGER(iwp), INTENT(IN) ::  io            !< Unit of the output file
-
-
-    t_soil_chr = ''
-    m_soil_chr    = ''
-    soil_depth_chr  = ''
-    roots_chr        = ''
-    vertical_index_chr   = ''
-
-    i = 1
-    DO i = nzb_soil, nzt_soil
-
-       WRITE (coor_chr,'(F10.2,7X)') soil_temperature(i)
-       t_soil_chr = TRIM( t_soil_chr ) // ' ' // TRIM( coor_chr )
-
-       WRITE (coor_chr,'(F10.2,7X)') soil_moisture(i)
-       m_soil_chr = TRIM( m_soil_chr ) // ' ' // TRIM( coor_chr )
-
-       WRITE (coor_chr,'(F10.2,7X)')  - zs(i)
-       soil_depth_chr = TRIM( soil_depth_chr ) // ' '  // TRIM( coor_chr )
-
-       WRITE (coor_chr,'(F10.2,7X)')  root_fraction(i)
-       roots_chr = TRIM( roots_chr ) // ' ' // TRIM( coor_chr )
-
-       WRITE (coor_chr,'(I10,7X)')  i
-       vertical_index_chr = TRIM( vertical_index_chr ) // ' ' // TRIM( coor_chr )
-
-    ENDDO
-
-!
-!-- Write land surface model header
-    WRITE( io,  1 )
-    IF ( conserve_water_content )  THEN
-       WRITE( io, 2 )
-    ELSE
-       WRITE( io, 3 )
-    ENDIF
-
-    IF ( vegetation_type_f%from_file )  THEN
-       WRITE( io, 5 )
-    ELSE
-       WRITE( io, 4 ) TRIM( vegetation_type_name(vegetation_type) ),                               &
-                      TRIM (soil_type_name(soil_type) )
-    ENDIF
-    WRITE( io, 6 ) TRIM( soil_depth_chr ), TRIM( t_soil_chr ), TRIM( m_soil_chr ),                 &
-                      TRIM( roots_chr ), TRIM( vertical_index_chr )
-
-1   FORMAT (//' Land surface model information:'/' ------------------------------'/)
-2   FORMAT ('    --> Soil bottom is closed (water content is conserved',', default)')
-3   FORMAT ('    --> Soil bottom is open (water content is not conserved)')
-4   FORMAT ('    --> Land surface type  : ',A,/'    --> Soil porosity type : ',A)
-5   FORMAT ('    --> Land surface type  : read from file'/                                         &
-         '    --> Soil porosity type : read from file' )
-6   FORMAT (/'    Initial soil temperature and moisture profile:'//                                &
-         '       Height:        ',A,'  m'/                                                         &
-         '       Temperature:   ',A,'  K'/                                                         &
-         '       Moisture:      ',A,'  m**3/m**3'/                                                 &
-         '       Root fraction: ',A,'  '/                                                          &
-         '       Grid point:    ',A)
-
-
- END SUBROUTINE lsm_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the land surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_init
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string
-
-    USE indices,                                                                                   &
-        ONLY:  nx, ny, topo_min_level
-
-#if defined( __parallel )
-    USE pmc_handle_communicator,                                                                   &
-     ONLY:  pmc_is_rootmodel
-#endif
-
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                       !< running index
-    INTEGER(iwp) ::  j                       !< running index
-    INTEGER(iwp) ::  k                       !< running index
-    INTEGER(iwp) ::  kn                      !< running index
-    INTEGER(iwp) ::  ko                      !< running index
-    INTEGER(iwp) ::  kroot                   !< running index
-    INTEGER(iwp) ::  kzs                     !< running index
-    INTEGER(iwp) ::  l                       !< running index surface facing
-    INTEGER(iwp) ::  m                       !< running index
-    INTEGER(iwp) ::  st                      !< soil-type index
-    INTEGER(iwp) ::  n_soil_layers_total     !< temperature variable, stores the total number of soil layers + 4
-#if defined( __parallel )
-    INTEGER(iwp) ::  nzs_root                !< number of soil layers in root domain (used in case soil data needs to be
-                                             !< transferred from root model to child models)
-
-    LOGICAL      ::  init_msoil_from_driver_root !< flag indicating that msoil in root is initialized from dynamic file
-    LOGICAL      ::  init_tsoil_from_driver_root !< flag indicating that tsoil in root is initialized from dynamic file
-#endif
-    LOGICAL      ::  flag_exceed_z0              !< dummy flag to indicate whether roughness length is too high
-    LOGICAL      ::  flag_exceed_z0h             !< dummy flag to indicate whether roughness length for scalars is too high
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  m_soil_root    !< domain-averaged soil moisture profile in root domain
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_soil_root    !< domain-averaged soil temperature profile in root domain
-#endif
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bound          !< temporary arrays for storing index bounds
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bound_root_fr  !< temporary arrays for storing index bounds
-#if defined( __parallel )
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pr_soil_init   !< temporary array used for averaging soil profiles
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  z_soil_root    !< vertical dimension of soil grid in root domain
-#endif
-
-
-    IF ( debug_output )  CALL debug_message( 'lsm_init', 'start' )
-!
-!-- If no cloud physics is used, rho_surface has not been calculated before.
-    IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets )  THEN
-       CALL calc_mean_profile( pt, 4 )
-       rho_surface = hyp(nzb) / ( r_d * hom(topo_min_level+1,1,4,0) * exner(nzb) )
-    ENDIF
-
-!
-!-- Calculate frequently used parameters
-    rho_cp    = c_p * rho_surface
-    rho_lv    = rho_surface * l_v
-    drho_l_lv = 1.0_wp / (rho_l * l_v)
-
-!
-!-- Set initial values for prognostic quantities
-!-- Horizontal surfaces
-    DO  l = 0, 1
-       tt_surface_h_m(l)%var_1d = 0.0_wp
-       tt_soil_h_m(l)%var_2d    = 0.0_wp
-       tm_soil_h_m(l)%var_2d    = 0.0_wp
-       tm_liq_h_m(l)%var_1d     = 0.0_wp
-       surf_lsm_h(l)%c_liq      = 0.0_wp
-
-       surf_lsm_h(l)%ghf = 0.0_wp
-
-       surf_lsm_h(l)%qsws_liq  = 0.0_wp
-       surf_lsm_h(l)%qsws_soil = 0.0_wp
-       surf_lsm_h(l)%qsws_veg  = 0.0_wp
-
-       surf_lsm_h(l)%r_a        = 50.0_wp
-       surf_lsm_h(l)%r_s        = 50.0_wp
-       surf_lsm_h(l)%r_canopy   = 0.0_wp
-       surf_lsm_h(l)%r_soil     = 0.0_wp
-    ENDDO
-!
-!-- Do the same for vertical surfaces
-    DO  l = 0, 3
-       tt_surface_v_m(l)%var_1d = 0.0_wp
-       tt_soil_v_m(l)%var_2d    = 0.0_wp
-       tm_soil_v_m(l)%var_2d    = 0.0_wp
-       tm_liq_v_m(l)%var_1d     = 0.0_wp
-       surf_lsm_v(l)%c_liq      = 0.0_wp
-
-       surf_lsm_v(l)%ghf = 0.0_wp
-
-       surf_lsm_v(l)%qsws_liq  = 0.0_wp
-       surf_lsm_v(l)%qsws_soil = 0.0_wp
-       surf_lsm_v(l)%qsws_veg  = 0.0_wp
-
-       surf_lsm_v(l)%r_a      = 50.0_wp
-       surf_lsm_v(l)%r_s      = 50.0_wp
-       surf_lsm_v(l)%r_canopy = 0.0_wp
-       surf_lsm_v(l)%r_soil   = 0.0_wp
-    ENDDO
-
-!
-!-- Set initial values for prognostic soil quantities
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-       DO  l = 0, 1
-          t_soil_h(l)%var_2d = 0.0_wp
-          m_soil_h(l)%var_2d = 0.0_wp
-          m_liq_h(l)%var_1d  = 0.0_wp
-       ENDDO
-       DO  l = 0, 3
-          t_soil_v(l)%var_2d = 0.0_wp
-          m_soil_v(l)%var_2d = 0.0_wp
-          m_liq_v(l)%var_1d  = 0.0_wp
-       ENDDO
-    ENDIF
-!
-!-- Allocate 3D soil model arrays
-!-- First, for horizontal surfaces
-    DO  l = 0, 1
-       ALLOCATE ( surf_lsm_h(l)%alpha_vg(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)    )
-       ALLOCATE ( surf_lsm_h(l)%gamma_w_sat(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns) )
-       ALLOCATE ( surf_lsm_h(l)%lambda_h(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)    )
-       ALLOCATE ( surf_lsm_h(l)%lambda_h_def(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns))
-       ALLOCATE ( surf_lsm_h(l)%l_vg(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)        )
-       ALLOCATE ( surf_lsm_h(l)%m_fc(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)        )
-       ALLOCATE ( surf_lsm_h(l)%m_res(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)       )
-       ALLOCATE ( surf_lsm_h(l)%m_sat(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)       )
-       ALLOCATE ( surf_lsm_h(l)%m_wilt(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)      )
-       ALLOCATE ( surf_lsm_h(l)%n_vg(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)        )
-       ALLOCATE ( surf_lsm_h(l)%rho_c_total(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns) )
-       ALLOCATE ( surf_lsm_h(l)%rho_c_total_def(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns) )
-       ALLOCATE ( surf_lsm_h(l)%root_fr(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)     )
-
-       surf_lsm_h(l)%lambda_h     = 0.0_wp
-!
-!--    If required, allocate humidity-related variables for the soil model
-       IF ( humidity )  THEN
-          ALLOCATE ( surf_lsm_h(l)%lambda_w(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns) )
-          ALLOCATE ( surf_lsm_h(l)%gamma_w(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)  )
-
-          surf_lsm_h(l)%lambda_w = 0.0_wp
-       ENDIF
-    ENDDO
-!
-!-- For vertical surfaces
-    DO  l = 0, 3
-       ALLOCATE ( surf_lsm_v(l)%alpha_vg(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)    )
-       ALLOCATE ( surf_lsm_v(l)%gamma_w_sat(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
-       ALLOCATE ( surf_lsm_v(l)%lambda_h(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)    )
-       ALLOCATE ( surf_lsm_v(l)%lambda_h_def(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns))
-       ALLOCATE ( surf_lsm_v(l)%l_vg(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)        )
-       ALLOCATE ( surf_lsm_v(l)%m_fc(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)        )
-       ALLOCATE ( surf_lsm_v(l)%m_res(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)       )
-       ALLOCATE ( surf_lsm_v(l)%m_sat(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)       )
-       ALLOCATE ( surf_lsm_v(l)%m_wilt(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)      )
-       ALLOCATE ( surf_lsm_v(l)%n_vg(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)        )
-       ALLOCATE ( surf_lsm_v(l)%rho_c_total(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
-       ALLOCATE ( surf_lsm_v(l)%rho_c_total_def(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
-       ALLOCATE ( surf_lsm_v(l)%root_fr(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)     )
-
-       surf_lsm_v(l)%lambda_h     = 0.0_wp
-
-!
-!--    If required, allocate humidity-related variables for the soil model.
-       IF ( humidity )  THEN
-          ALLOCATE ( surf_lsm_v(l)%lambda_w(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
-          ALLOCATE ( surf_lsm_v(l)%gamma_w(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)  )
-
-          surf_lsm_v(l)%lambda_w = 0.0_wp
-       ENDIF
-    ENDDO
-!
-!-- Allocate albedo type and emissivity for vegetation, water and pavement fraction.
-!-- Set default values at each surface element.
-    DO  l = 0, 1
-       ALLOCATE ( surf_lsm_h(l)%albedo_type(1:surf_lsm_h(l)%ns,0:2) )
-       ALLOCATE ( surf_lsm_h(l)%emissivity(1:surf_lsm_h(l)%ns,0:2) )
-!
-!--       Initialize albedo type according to its default type, in order to set values independently
-!--       on default albedo_type in radiation model.
-       surf_lsm_h(l)%albedo_type(:,ind_veg_wall)  = INT( vegetation_pars(ind_v_at,vegetation_type) )
-       surf_lsm_h(l)%albedo_type(:,ind_wat_win)   = INT( water_pars(ind_w_at,water_type)           )
-       surf_lsm_h(l)%albedo_type(:,ind_pav_green) = INT( pavement_pars(ind_p_at,pavement_type)     )
-       surf_lsm_h(l)%emissivity  = emissivity
-    ENDDO
-
-    DO  l = 0, 3
-       ALLOCATE ( surf_lsm_v(l)%albedo_type(1:surf_lsm_v(l)%ns,0:2) )
-       ALLOCATE ( surf_lsm_v(l)%emissivity(1:surf_lsm_v(l)%ns,0:2)  )
-!
-!--    Initialize albedo type according to its default type, in order to set values independently on
-!--    default albedo_type in radiation model.
-       surf_lsm_v(l)%albedo_type(:,ind_veg_wall)  = INT( vegetation_pars(ind_v_at,vegetation_type) )
-       surf_lsm_v(l)%albedo_type(:,ind_wat_win)   = INT( water_pars(ind_w_at,water_type)           )
-       surf_lsm_v(l)%albedo_type(:,ind_pav_green) = INT( pavement_pars(ind_p_at,pavement_type)     )
-       surf_lsm_v(l)%emissivity  = emissivity
-    ENDDO
-!
-!-- Allocate arrays for relative surface fraction.
-!-- 0 - vegetation fraction, 2 - water fraction, 1 - pavement fraction
-    DO  l = 0, 1
-       ALLOCATE( surf_lsm_h(l)%frac(1:surf_lsm_h(l)%ns,0:2) )
-       surf_lsm_h(l)%frac = 0.0_wp
-    ENDDO
-    DO  l = 0, 3
-       ALLOCATE( surf_lsm_v(l)%frac(1:surf_lsm_v(l)%ns,0:2) )
-       surf_lsm_v(l)%frac = 0.0_wp
-    ENDDO
-!
-!-- For vertical walls only - allocate special flag indicating if any building is on top of any
-!-- natural surfaces. Used for initialization only.
-    DO  l = 0, 3
-       ALLOCATE( surf_lsm_v(l)%building_covered(1:surf_lsm_v(l)%ns) )
-    ENDDO
-!
-!-- Allocate arrays for the respective types and their names on the surface elements. This will be
-!-- required to treat deposition of chemical species.
-    DO  l = 0, 1
-       ALLOCATE( surf_lsm_h(l)%pavement_type(1:surf_lsm_h(l)%ns)   )
-       ALLOCATE( surf_lsm_h(l)%vegetation_type(1:surf_lsm_h(l)%ns) )
-       ALLOCATE( surf_lsm_h(l)%water_type(1:surf_lsm_h(l)%ns)      )
-
-       surf_lsm_h(l)%pavement_type   = 0
-       surf_lsm_h(l)%vegetation_type = 0
-       surf_lsm_h(l)%water_type      = 0
-
-       ALLOCATE( surf_lsm_h(l)%pavement_type_name(1:surf_lsm_h(l)%ns)   )
-       ALLOCATE( surf_lsm_h(l)%vegetation_type_name(1:surf_lsm_h(l)%ns) )
-       ALLOCATE( surf_lsm_h(l)%water_type_name(1:surf_lsm_h(l)%ns)      )
-
-       surf_lsm_h(l)%pavement_type_name   = 'none'
-       surf_lsm_h(l)%vegetation_type_name = 'none'
-       surf_lsm_h(l)%water_type_name      = 'none'
-    ENDDO
-
-    DO  l = 0, 3
-       ALLOCATE( surf_lsm_v(l)%pavement_type(1:surf_lsm_v(l)%ns)   )
-       ALLOCATE( surf_lsm_v(l)%vegetation_type(1:surf_lsm_v(l)%ns) )
-       ALLOCATE( surf_lsm_v(l)%water_type(1:surf_lsm_v(l)%ns)      )
-
-       surf_lsm_v(l)%pavement_type   = 0
-       surf_lsm_v(l)%vegetation_type = 0
-       surf_lsm_v(l)%water_type      = 0
-
-       ALLOCATE( surf_lsm_v(l)%pavement_type_name(1:surf_lsm_v(l)%ns)   )
-       ALLOCATE( surf_lsm_v(l)%vegetation_type_name(1:surf_lsm_v(l)%ns) )
-       ALLOCATE( surf_lsm_v(l)%water_type_name(1:surf_lsm_v(l)%ns)      )
-
-       surf_lsm_v(l)%pavement_type_name   = 'none'
-       surf_lsm_v(l)%vegetation_type_name = 'none'
-       surf_lsm_v(l)%water_type_name      = 'none'
-    ENDDO
-
-!
-!-- Set flag parameter for the prescribed surface type depending on user input. Set surface fraction
-!-- to 1 for the respective type.
-    SELECT CASE ( TRIM( surface_type ) )
-
-       CASE ( 'vegetation' )
-          DO  l = 0, 1
-             surf_lsm_h(l)%vegetation_surface = .TRUE.
-             surf_lsm_h(l)%frac(:,ind_veg_wall) = 1.0_wp
-          ENDDO
-          DO  l = 0, 3
-             surf_lsm_v(l)%vegetation_surface = .TRUE.
-             surf_lsm_v(l)%frac(:,ind_veg_wall) = 1.0_wp
-          ENDDO
-
-       CASE ( 'water' )
-!
-!--       Note, downward and vertical water surface does not really make sense.
-          DO  l = 0, 1
-            surf_lsm_h(l)%water_surface = .TRUE.
-            surf_lsm_h(l)%frac(:,ind_wat_win) = 1.0_wp
-          ENDDO
-          DO  l = 0, 3
-             surf_lsm_v(l)%water_surface   = .TRUE.
-             surf_lsm_v(l)%frac(:,ind_wat_win) = 1.0_wp
-          ENDDO
-
-       CASE ( 'pavement' )
-          DO  l = 0, 1
-             surf_lsm_h(l)%pavement_surface = .TRUE.
-             surf_lsm_h(l)%frac(:,ind_pav_green) = 1.0_wp
-          ENDDO
-          DO  l = 0, 3
-             surf_lsm_v(l)%pavement_surface   = .TRUE.
-             surf_lsm_v(l)%frac(:,ind_pav_green) = 1.0_wp
-          ENDDO
-
-       CASE ( 'netcdf' )
-          DO  l = 0, 1
-             DO  m = 1, surf_lsm_h(l)%ns
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-                IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill )                        &
-                   surf_lsm_h(l)%vegetation_surface(m) = .TRUE.
-                IF ( pavement_type_f%var(j,i)   /= pavement_type_f%fill )                          &
-                   surf_lsm_h(l)%pavement_surface(m) = .TRUE.
-                IF ( water_type_f%var(j,i)      /= water_type_f%fill )                             &
-                   surf_lsm_h(l)%water_surface(m) = .TRUE.
-!
-!--             Check if at least one type is set.
-                IF ( .NOT. surf_lsm_h(l)%vegetation_surface(m)  .AND.                              &
-                     .NOT. surf_lsm_h(l)%pavement_surface(m)    .AND.                              &
-                     .NOT. surf_lsm_h(l)%water_surface(m) )  THEN
-                   WRITE( message_string, * ) 'Horizontal surface element ' //                     &
-                                              ' at i, j = ',  i, j,                                &
-                                              ' is neither a vegetation, ' //                      &
-                                              'pavement, nor a water surface.'
-                   CALL message( 'land_surface_model_mod', 'PA0619', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDDO
-          ENDDO
-!
-!--       For vertical surfaces some special checks and treatment are required for correct
-!--       initialization.
-          DO  l = 0, 3
-             DO  m = 1, surf_lsm_v(l)%ns
-!
-!--             Only for vertical surfaces. Check if at the grid point where the wall is defined
-!--             (i+ioff, j+joff) is any building.
-!--             This case, no natural surfaces properties will be defined at this grid point,
-!--             leading to problems in the initialization.
-!--             To overcome this, define a special flag which indicates that a building is defined
-!--             at the wall grid point and take the surface properties from the adjoining
-!--             grid point, i.e. without offset values.
-!--             Further, there can occur a special case where elevation changes are larger than
-!--             building heights. This case, (j,i) and (j+joff,i+ioff) grid points may be both
-!--             covered by buildings, but vertical natural walls may be located between the
-!--             buildings. This case, it is not guaranteed that information about natural surface
-!--             types is given, neither at (j,i) nor at (j+joff,i+ioff), again leading to
-!--             non-initialized surface properties.
-                surf_lsm_v(l)%building_covered(m) = .FALSE.
-!
-!--             Wall grid point is building-covered. This case, set flag indicating that surface
-!--             properties are initialized from neighboring reference grid point, which is not
-!--             building_covered.
-                IF ( building_type_f%from_file )  THEN
-                   i = surf_lsm_v(l)%i(m)
-                   j = surf_lsm_v(l)%j(m)
-                   IF ( building_type_f%var(j+surf_lsm_v(l)%joff,i+surf_lsm_v(l)%ioff)             &
-                        /= building_type_f%fill )                                                  &
-                      surf_lsm_v(l)%building_covered(m) = .TRUE.
-!
-!--                Wall grid point as well as neighboring reference grid point are both
-!--                building-covered. This case, surface properties are not necessarily defined (not
-!--                covered by checks for static input file) at this surface. Hence, initialize
-!--                surface properties by simply setting vegetation_type_f to bare-soil bulk
-!--                parametrization.
-!--                soil_type_f as well as surface_fractions_f will be set also.
-                   IF ( building_type_f%var(j+surf_lsm_v(l)%joff,i+surf_lsm_v(l)%ioff)             &
-                        /= building_type_f%fill  .AND.                                             &
-                        building_type_f%var(j,i) /= building_type_f%fill )                         &
-                   THEN
-                      vegetation_type_f%var(j,i) = 1 ! bare soil
-                      soil_type_f%var_2d(j,i)    = 1
-
-                      water_type_f%var(j,i)      = water_type_f%fill
-                      pavement_type_f%var(j,i)   = pavement_type_f%fill
-!
-!--                   If surface_fraction is provided in static input, set fraction for vegetation
-!--                   to one at building-covered surfaces.
-                      IF ( surface_fraction_f%from_file )  THEN
-                         surface_fraction_f%frac(ind_veg_wall,j,i)  = 1.0_wp
-                         surface_fraction_f%frac(ind_pav_green,j,i) = 0.0_wp
-                         surface_fraction_f%frac(ind_wat_win,j,i)   = 0.0_wp
-                      ENDIF
-                   ENDIF
-
-                ENDIF
-!
-!--             Normally proceed with setting surface types.
-                i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-                j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-                IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill )                        &
-                   surf_lsm_v(l)%vegetation_surface(m) = .TRUE.
-                IF ( pavement_type_f%var(j,i)   /= pavement_type_f%fill )                          &
-                   surf_lsm_v(l)%pavement_surface(m) = .TRUE.
-                IF ( water_type_f%var(j,i)      /= water_type_f%fill )                             &
-                   surf_lsm_v(l)%water_surface(m) = .TRUE.
-!
-!--             Check if at least one type is set.
-                IF ( .NOT. surf_lsm_v(l)%vegetation_surface(m)  .AND.                              &
-                     .NOT. surf_lsm_v(l)%pavement_surface(m)    .AND.                              &
-                     .NOT. surf_lsm_v(l)%water_surface(m) )  THEN
-                   WRITE( message_string, * ) 'Vertical surface element ' //                       &
-                                              ' at i, j = ',  i, j,                                &
-                                              ' is neither a vegetation, ' //                      &
-                                              'pavement, nor a water surface.'
-                   CALL message( 'land_surface_model_mod', 'PA0619', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDDO
-          ENDDO
-
-    END SELECT
-!
-!-- In case of netcdf input file, further initialize surface fractions.
-!-- At the moment only 1 surface is given at a location, so that the fraction is either 0 or 1.
-!-- This will be revised later. If surface fraction is not given in static input file, relative
-!-- fractions will be derived from given surface type. In this case, only 1 type is given at a
-!-- certain location (already checked).
-    IF ( input_pids_static  .AND.  surface_fraction_f%from_file )  THEN
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-!
-!--          0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction
-             IF ( surface_fraction_f%frac(ind_veg_wall,j,i) /= surface_fraction_f%fill )  THEN
-                surf_lsm_h(l)%frac(m,ind_veg_wall)  = surface_fraction_f%frac(ind_veg_wall,j,i)
-             ENDIF
-             IF ( surface_fraction_f%frac(ind_pav_green,j,i) /= surface_fraction_f%fill )  THEN
-                surf_lsm_h(l)%frac(m,ind_pav_green) = surface_fraction_f%frac(ind_pav_green,j,i)
-             ENDIF
-             IF ( surface_fraction_f%frac(ind_wat_win,j,i) /= surface_fraction_f%fill )  THEN
-                surf_lsm_h(l)%frac(m,ind_wat_win)   = surface_fraction_f%frac(ind_wat_win,j,i)
-             ENDIF
-!
-!--          Check if sum of relative fractions is zero. This case, give an error message.
-             IF ( SUM ( surf_lsm_h(l)%frac(m,:) ) == 0.0_wp )  THEN
-                WRITE( message_string, * ) 'surface fractions at grid point (j,i) = (',            &
-                                           j, i, ') are all zero.'
-                CALL message( 'land_surface_model_mod', 'PA0688', 2, 2, myid, 6, 0 )
-             ENDIF
-!
-!--          In case the sum of all surfaces is not 1, which may happen due to rounding errors or
-!--          type conversions, normalize the fractions to one. Note, at the moment no tile approach
-!--          is implemented, so that relative fractions are either 1 or zero.
-             IF ( SUM ( surf_lsm_h(l)%frac(m,:) ) > 1.0_wp  .OR.                                   &
-                  SUM ( surf_lsm_h(l)%frac(m,:) ) < 1.0_wp  )  THEN
-                surf_lsm_h(l)%frac(m,:) = surf_lsm_h(l)%frac(m,:) / SUM ( surf_lsm_h(l)%frac(m,:) )
-
-             ENDIF
-          ENDDO
-       ENDDO
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-             j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-!
-!--          0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction
-             IF ( surface_fraction_f%frac(ind_veg_wall,j,i)  /= surface_fraction_f%fill )  THEN
-                surf_lsm_v(l)%frac(m,ind_veg_wall)  = surface_fraction_f%frac(ind_veg_wall,j,i)
-             ENDIF
-             IF ( surface_fraction_f%frac(ind_pav_green,j,i) /= surface_fraction_f%fill )  THEN
-                surf_lsm_v(l)%frac(m,ind_pav_green) = surface_fraction_f%frac(ind_pav_green,j,i)
-             ENDIF
-             IF ( surface_fraction_f%frac(ind_wat_win,j,i)   /= surface_fraction_f%fill )  THEN
-                surf_lsm_v(l)%frac(m,ind_wat_win)   =  surface_fraction_f%frac(ind_wat_win,j,i)
-             ENDIF
-!
-!--          Check if sum of relative fractions is zero. This case, give an error message.
-             IF ( SUM ( surf_lsm_v(l)%frac(m,:) ) == 0.0_wp )  THEN
-                WRITE( message_string, * ) 'surface fractions at grid point (j,i) = (',            &
-                                           j, i, ') are all zero.'
-                CALL message( 'land_surface_model_mod', 'PA0688', 2, 2, myid, 6, 0 )
-             ENDIF
-!
-!--          In case the sum of all surfaces is not 1, which may happen due to rounding errors or
-!--          type conversions, normalize the fractions to one. Note, at the moment no tile approach
-!--          is implemented, so that relative fractions are either 1 or zero.
-             IF ( SUM ( surf_lsm_v(l)%frac(m,:) ) > 1.0_wp  .OR.                                   &
-                  SUM ( surf_lsm_v(l)%frac(m,:) ) < 1.0_wp  )  THEN
-                surf_lsm_v(l)%frac(m,:) = surf_lsm_v(l)%frac(m,:) / SUM ( surf_lsm_v(l)%frac(m,:) )
-
-             ENDIF
-          ENDDO
-       ENDDO
-    ELSEIF ( input_pids_static  .AND.  .NOT. surface_fraction_f%from_file )  THEN
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-
-             IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill )                           &
-                surf_lsm_h(l)%frac(m,ind_veg_wall)  = 1.0_wp
-             IF ( pavement_type_f%var(j,i)   /= pavement_type_f%fill   )                           &
-                surf_lsm_h(l)%frac(m,ind_pav_green) = 1.0_wp
-             IF ( water_type_f%var(j,i)      /= water_type_f%fill      )                           &
-                surf_lsm_h(l)%frac(m,ind_wat_win)   = 1.0_wp
-          ENDDO
-       ENDDO
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-             j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-
-             IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill )                           &
-                surf_lsm_v(l)%frac(m,ind_veg_wall)  = 1.0_wp
-             IF ( pavement_type_f%var(j,i)   /= pavement_type_f%fill   )                           &
-                surf_lsm_v(l)%frac(m,ind_pav_green) = 1.0_wp
-             IF ( water_type_f%var(j,i)      /= water_type_f%fill      )                           &
-                surf_lsm_v(l)%frac(m,ind_wat_win)   = 1.0_wp
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Level 1, initialization of soil parameters.
-!-- It is possible to overwrite each parameter by setting the respecticy NAMELIST variable to a
-!-- value /= 9999999.9.
-    IF ( soil_type /= 0 )  THEN
-
-       IF ( alpha_vangenuchten == 9999999.9_wp )     alpha_vangenuchten = soil_pars(0,soil_type)
-       IF ( l_vangenuchten == 9999999.9_wp )         l_vangenuchten = soil_pars(1,soil_type)
-       IF ( n_vangenuchten == 9999999.9_wp )         n_vangenuchten = soil_pars(2,soil_type)
-       IF ( hydraulic_conductivity == 9999999.9_wp ) hydraulic_conductivity = soil_pars(3,soil_type)
-       IF ( saturation_moisture == 9999999.9_wp )    saturation_moisture = soil_pars(4,soil_type)
-       IF ( field_capacity == 9999999.9_wp )         field_capacity = soil_pars(5,soil_type)
-       IF ( wilting_point == 9999999.9_wp )          wilting_point = soil_pars(6,soil_type)
-       IF ( residual_moisture == 9999999.9_wp )      residual_moisture = soil_pars(7,soil_type)
-
-    ENDIF
-!
-!-- Map values to the respective 2D/3D arrays
-!-- Horizontal surfaces
-    DO  l = 0, 1
-       surf_lsm_h(l)%alpha_vg    = alpha_vangenuchten
-       surf_lsm_h(l)%l_vg        = l_vangenuchten
-       surf_lsm_h(l)%n_vg        = n_vangenuchten
-       surf_lsm_h(l)%gamma_w_sat = hydraulic_conductivity
-       surf_lsm_h(l)%m_sat       = saturation_moisture
-       surf_lsm_h(l)%m_fc        = field_capacity
-       surf_lsm_h(l)%m_wilt      = wilting_point
-       surf_lsm_h(l)%m_res       = residual_moisture
-       surf_lsm_h(l)%r_soil_min  = min_soil_resistance
-    ENDDO
-!
-!-- Vertical surfaces
-    DO  l = 0, 3
-       surf_lsm_v(l)%alpha_vg    = alpha_vangenuchten
-       surf_lsm_v(l)%l_vg        = l_vangenuchten
-       surf_lsm_v(l)%n_vg        = n_vangenuchten
-       surf_lsm_v(l)%gamma_w_sat = hydraulic_conductivity
-       surf_lsm_v(l)%m_sat       = saturation_moisture
-       surf_lsm_v(l)%m_fc        = field_capacity
-       surf_lsm_v(l)%m_wilt      = wilting_point
-       surf_lsm_v(l)%m_res       = residual_moisture
-       surf_lsm_v(l)%r_soil_min  = min_soil_resistance
-    ENDDO
-!
-!-- Level 2, initialization of soil parameters via soil_type read from file.
-!-- Soil parameters are initialized for each (y,x)-grid point individually using default paramter
-!-- settings according to the given soil type.
-    IF ( soil_type_f%from_file )  THEN
-!
-!--    Level of detail = 1, i.e. a homogeneous soil distribution along the vertical dimension is
-!--    assumed.
-       IF ( soil_type_f%lod == 1 )  THEN
-!
-!--       Horizontal surfaces
-          DO  l = 0, 1
-             DO  m = 1, surf_lsm_h(l)%ns
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-
-                st = soil_type_f%var_2d(j,i)
-                IF ( st /= soil_type_f%fill )  THEN
-                   surf_lsm_h(l)%alpha_vg(:,m)    = soil_pars(0,st)
-                   surf_lsm_h(l)%l_vg(:,m)        = soil_pars(1,st)
-                   surf_lsm_h(l)%n_vg(:,m)        = soil_pars(2,st)
-                   surf_lsm_h(l)%gamma_w_sat(:,m) = soil_pars(3,st)
-                   surf_lsm_h(l)%m_sat(:,m)       = soil_pars(4,st)
-                   surf_lsm_h(l)%m_fc(:,m)        = soil_pars(5,st)
-                   surf_lsm_h(l)%m_wilt(:,m)      = soil_pars(6,st)
-                   surf_lsm_h(l)%m_res(:,m)       = soil_pars(7,st)
-                ENDIF
-             ENDDO
-          ENDDO
-!
-!--       Vertical surfaces ( assumes the soil type given at respective (x,y)
-          DO  l = 0, 3
-             DO  m = 1, surf_lsm_v(l)%ns
-                i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-                j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-
-                st = soil_type_f%var_2d(j,i)
-                IF ( st /= soil_type_f%fill )  THEN
-                   surf_lsm_v(l)%alpha_vg(:,m)    = soil_pars(0,st)
-                   surf_lsm_v(l)%l_vg(:,m)        = soil_pars(1,st)
-                   surf_lsm_v(l)%n_vg(:,m)        = soil_pars(2,st)
-                   surf_lsm_v(l)%gamma_w_sat(:,m) = soil_pars(3,st)
-                   surf_lsm_v(l)%m_sat(:,m)       = soil_pars(4,st)
-                   surf_lsm_v(l)%m_fc(:,m)        = soil_pars(5,st)
-                   surf_lsm_v(l)%m_wilt(:,m)      = soil_pars(6,st)
-                   surf_lsm_v(l)%m_res(:,m)       = soil_pars(7,st)
-                ENDIF
-             ENDDO
-          ENDDO
-!
-!--    Level of detail = 2, i.e. soil type and thus the soil parameters can be heterogeneous along
-!--    the vertical dimension.
-       ELSE
-!
-!--       Horizontal surfaces
-          DO  l = 0, 1
-             DO  m = 1, surf_lsm_h(l)%ns
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-
-                DO  k = nzb_soil, nzt_soil
-                   st = soil_type_f%var_3d(k,j,i)
-                   IF ( st /= soil_type_f%fill )  THEN
-                      surf_lsm_h(l)%alpha_vg(k,m)    = soil_pars(0,st)
-                      surf_lsm_h(l)%l_vg(k,m)        = soil_pars(1,st)
-                      surf_lsm_h(l)%n_vg(k,m)        = soil_pars(2,st)
-                      surf_lsm_h(l)%gamma_w_sat(k,m) = soil_pars(3,st)
-                      surf_lsm_h(l)%m_sat(k,m)       = soil_pars(4,st)
-                      surf_lsm_h(l)%m_fc(k,m)        = soil_pars(5,st)
-                      surf_lsm_h(l)%m_wilt(k,m)      = soil_pars(6,st)
-                      surf_lsm_h(l)%m_res(k,m)       = soil_pars(7,st)
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-!
-!--       Vertical surfaces ( assumes the soil type given at respective (x,y)
-          DO  l = 0, 3
-             DO  m = 1, surf_lsm_v(l)%ns
-                i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-                j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-
-                DO  k = nzb_soil, nzt_soil
-                   st = soil_type_f%var_3d(k,j,i)
-                   IF ( st /= soil_type_f%fill )  THEN
-                      surf_lsm_v(l)%alpha_vg(k,m)    = soil_pars(0,st)
-                      surf_lsm_v(l)%l_vg(k,m)        = soil_pars(1,st)
-                      surf_lsm_v(l)%n_vg(k,m)        = soil_pars(2,st)
-                      surf_lsm_v(l)%gamma_w_sat(k,m) = soil_pars(3,st)
-                      surf_lsm_v(l)%m_sat(k,m)       = soil_pars(4,st)
-                      surf_lsm_v(l)%m_fc(k,m)        = soil_pars(5,st)
-                      surf_lsm_v(l)%m_wilt(k,m)      = soil_pars(6,st)
-                      surf_lsm_v(l)%m_res(k,m)       = soil_pars(7,st)
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Level 3, initialization of single soil parameters at single z,x,y position via soil_pars read
-!-- from file.
-    IF ( soil_pars_f%from_file )  THEN
-!
-!--    Level of detail = 1, i.e. a homogeneous vertical distribution of soil parameters is assumed.
-!--    Horizontal surfaces
-       IF ( soil_pars_f%lod == 1 )  THEN
-!
-!--       Horizontal surfaces
-          DO  l = 0, 1
-             DO  m = 1, surf_lsm_h(l)%ns
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-
-                IF ( soil_pars_f%pars_xy(0,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_h(l)%alpha_vg(:,m)    = soil_pars_f%pars_xy(0,j,i)
-                IF ( soil_pars_f%pars_xy(1,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_h(l)%l_vg(:,m)        = soil_pars_f%pars_xy(1,j,i)
-                IF ( soil_pars_f%pars_xy(2,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_h(l)%n_vg(:,m)        = soil_pars_f%pars_xy(2,j,i)
-                IF ( soil_pars_f%pars_xy(3,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_h(l)%gamma_w_sat(:,m) = soil_pars_f%pars_xy(3,j,i)
-                IF ( soil_pars_f%pars_xy(4,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_h(l)%m_sat(:,m)       = soil_pars_f%pars_xy(4,j,i)
-                IF ( soil_pars_f%pars_xy(5,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_h(l)%m_fc(:,m)        = soil_pars_f%pars_xy(5,j,i)
-                IF ( soil_pars_f%pars_xy(6,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_h(l)%m_wilt(:,m)      = soil_pars_f%pars_xy(6,j,i)
-                IF ( soil_pars_f%pars_xy(7,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_h(l)%m_res(:,m)       = soil_pars_f%pars_xy(7,j,i)
-             ENDDO
-          ENDDO
-!
-!--       Vertical surfaces
-          DO  l = 0, 3
-             DO  m = 1, surf_lsm_v(l)%ns
-                i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-                j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-
-                IF ( soil_pars_f%pars_xy(0,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_v(l)%alpha_vg(:,m)    = soil_pars_f%pars_xy(0,j,i)
-                IF ( soil_pars_f%pars_xy(1,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_v(l)%l_vg(:,m)        = soil_pars_f%pars_xy(1,j,i)
-                IF ( soil_pars_f%pars_xy(2,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_v(l)%n_vg(:,m)        = soil_pars_f%pars_xy(2,j,i)
-                IF ( soil_pars_f%pars_xy(3,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_v(l)%gamma_w_sat(:,m) = soil_pars_f%pars_xy(3,j,i)
-                IF ( soil_pars_f%pars_xy(4,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_v(l)%m_sat(:,m)       = soil_pars_f%pars_xy(4,j,i)
-                IF ( soil_pars_f%pars_xy(5,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_v(l)%m_fc(:,m)        = soil_pars_f%pars_xy(5,j,i)
-                IF ( soil_pars_f%pars_xy(6,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_v(l)%m_wilt(:,m)      = soil_pars_f%pars_xy(6,j,i)
-                IF ( soil_pars_f%pars_xy(7,j,i) /= soil_pars_f%fill )                              &
-                   surf_lsm_v(l)%m_res(:,m)       = soil_pars_f%pars_xy(7,j,i)
-
-             ENDDO
-          ENDDO
-!
-!--    Level of detail = 2, i.e. soil parameters can be set at each soil layer individually.
-       ELSE
-!
-!--       Horizontal surfaces
-          DO  l = 0, 1
-             DO  m = 1, surf_lsm_h(l)%ns
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-
-                DO  k = nzb_soil, nzt_soil
-                   IF ( soil_pars_f%pars_xyz(0,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_h(l)%alpha_vg(k,m)    = soil_pars_f%pars_xyz(0,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(1,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_h(l)%l_vg(k,m)        = soil_pars_f%pars_xyz(1,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(2,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_h(l)%n_vg(k,m)        = soil_pars_f%pars_xyz(2,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(3,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_h(l)%gamma_w_sat(k,m) = soil_pars_f%pars_xyz(3,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(4,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_h(l)%m_sat(k,m)       = soil_pars_f%pars_xyz(4,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(5,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_h(l)%m_fc(k,m)        = soil_pars_f%pars_xyz(5,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(6,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_h(l)%m_wilt(k,m)      = soil_pars_f%pars_xyz(6,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(7,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_h(l)%m_res(k,m)       = soil_pars_f%pars_xyz(7,k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-!
-!--       Vertical surfaces
-          DO  l = 0, 3
-             DO  m = 1, surf_lsm_v(l)%ns
-                i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-                j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-
-                DO  k = nzb_soil, nzt_soil
-                   IF ( soil_pars_f%pars_xyz(0,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_v(l)%alpha_vg(k,m)    = soil_pars_f%pars_xyz(0,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(1,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_v(l)%l_vg(k,m)        = soil_pars_f%pars_xyz(1,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(2,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_v(l)%n_vg(k,m)        = soil_pars_f%pars_xyz(2,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(3,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_v(l)%gamma_w_sat(k,m) = soil_pars_f%pars_xyz(3,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(4,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_v(l)%m_sat(k,m)       = soil_pars_f%pars_xyz(4,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(5,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_v(l)%m_fc(k,m)        = soil_pars_f%pars_xyz(5,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(6,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_v(l)%m_wilt(k,m)      = soil_pars_f%pars_xyz(6,k,j,i)
-                   IF ( soil_pars_f%pars_xyz(7,k,j,i) /= soil_pars_f%fill )                        &
-                      surf_lsm_v(l)%m_res(k,m)       = soil_pars_f%pars_xyz(7,k,j,i)
-                ENDDO
-
-             ENDDO
-          ENDDO
-
-       ENDIF
-    ENDIF
-
-!
-!-- Level 1, initialization of vegetation parameters. A horizontally homogeneous distribution is
-!-- assumed here.
-    IF ( vegetation_type /= 0 )  THEN
-
-       IF ( min_canopy_resistance == 9999999.9_wp )  THEN
-          min_canopy_resistance = vegetation_pars(ind_v_rc_min,vegetation_type)
-       ENDIF
-
-       IF ( leaf_area_index == 9999999.9_wp )  THEN
-          leaf_area_index = vegetation_pars(ind_v_rc_lai,vegetation_type)
-       ENDIF
-
-       IF ( vegetation_coverage == 9999999.9_wp )  THEN
-          vegetation_coverage = vegetation_pars(ind_v_c_veg,vegetation_type)
-       ENDIF
-
-       IF ( canopy_resistance_coefficient == 9999999.9_wp )  THEN
-           canopy_resistance_coefficient= vegetation_pars(ind_v_gd,vegetation_type)
-       ENDIF
-
-       IF ( z0_vegetation == 9999999.9_wp )  THEN
-          z0_vegetation  = vegetation_pars(ind_v_z0,vegetation_type)
-       ENDIF
-
-       IF ( z0h_vegetation == 9999999.9_wp )  THEN
-          z0h_vegetation = vegetation_pars(ind_v_z0qh,vegetation_type)
-       ENDIF
-
-       IF ( z0q_vegetation == 9999999.9_wp )  THEN
-          z0q_vegetation = vegetation_pars(ind_v_z0qh,vegetation_type)
-       ENDIF
-
-       IF ( lambda_surface_stable == 9999999.9_wp )  THEN
-          lambda_surface_stable = vegetation_pars(ind_v_lambda_s,vegetation_type)
-       ENDIF
-
-       IF ( lambda_surface_unstable == 9999999.9_wp )  THEN
-          lambda_surface_unstable = vegetation_pars(ind_v_lambda_u,vegetation_type)
-       ENDIF
-
-       IF ( f_shortwave_incoming == 9999999.9_wp )  THEN
-          f_shortwave_incoming = vegetation_pars(ind_v_f_sw_in,vegetation_type)
-       ENDIF
-
-       IF ( c_surface == 9999999.9_wp )  THEN
-          c_surface = vegetation_pars(ind_v_c_surf,vegetation_type)
-       ENDIF
-
-       IF ( albedo_type == 9999999  .AND.  albedo == 9999999.9_wp )  THEN
-          albedo_type = INT(vegetation_pars(ind_v_at,vegetation_type))
-       ENDIF
-
-       IF ( emissivity == 9999999.9_wp )  THEN
-          emissivity = vegetation_pars(ind_v_emis,vegetation_type)
-       ENDIF
-
-    ENDIF
-!
-!-- Map values onto horizontal elemements
-    DO  l = 0, 1
-       DO  m = 1, surf_lsm_h(l)%ns
-          IF ( surf_lsm_h(l)%vegetation_surface(m) )  THEN
-             surf_lsm_h(l)%r_canopy_min(m)     = min_canopy_resistance
-             surf_lsm_h(l)%lai(m)              = leaf_area_index
-             surf_lsm_h(l)%c_veg(m)            = vegetation_coverage
-             surf_lsm_h(l)%g_d(m)              = canopy_resistance_coefficient
-             surf_lsm_h(l)%z0(m)               = z0_vegetation
-             surf_lsm_h(l)%z0h(m)              = z0h_vegetation
-             surf_lsm_h(l)%z0q(m)              = z0q_vegetation
-             surf_lsm_h(l)%lambda_surface_s(m) = lambda_surface_stable
-             surf_lsm_h(l)%lambda_surface_u(m) = lambda_surface_unstable
-             surf_lsm_h(l)%f_sw_in(m)          = f_shortwave_incoming
-             surf_lsm_h(l)%c_surface(m)        = c_surface
-             surf_lsm_h(l)%albedo_type(m,ind_veg_wall) = albedo_type
-             surf_lsm_h(l)%emissivity(m,ind_veg_wall)  = emissivity
-
-             surf_lsm_h(l)%vegetation_type(m)      = vegetation_type
-             surf_lsm_h(l)%vegetation_type_name(m) = vegetation_type_name(vegetation_type)
-          ELSE
-             surf_lsm_h(l)%lai(m)   = 0.0_wp
-             surf_lsm_h(l)%c_veg(m) = 0.0_wp
-             surf_lsm_h(l)%g_d(m)   = 0.0_wp
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!-- Map values onto vertical elements, even though this does not make much sense.
-    DO  l = 0, 3
-       DO  m = 1, surf_lsm_v(l)%ns
-          IF ( surf_lsm_v(l)%vegetation_surface(m) )  THEN
-             surf_lsm_v(l)%r_canopy_min(m)     = min_canopy_resistance
-             surf_lsm_v(l)%lai(m)              = leaf_area_index
-             surf_lsm_v(l)%c_veg(m)            = vegetation_coverage
-             surf_lsm_v(l)%g_d(m)              = canopy_resistance_coefficient
-             surf_lsm_v(l)%z0(m)               = z0_vegetation
-             surf_lsm_v(l)%z0h(m)              = z0h_vegetation
-             surf_lsm_v(l)%z0q(m)              = z0q_vegetation
-             surf_lsm_v(l)%lambda_surface_s(m) = lambda_surface_stable
-             surf_lsm_v(l)%lambda_surface_u(m) = lambda_surface_unstable
-             surf_lsm_v(l)%f_sw_in(m)          = f_shortwave_incoming
-             surf_lsm_v(l)%c_surface(m)        = c_surface
-             surf_lsm_v(l)%albedo_type(m,ind_veg_wall) = albedo_type
-             surf_lsm_v(l)%emissivity(m,ind_veg_wall)  = emissivity
-
-             surf_lsm_v(l)%vegetation_type(m)      = vegetation_type
-             surf_lsm_v(l)%vegetation_type_name(m) = vegetation_type_name(vegetation_type)
-          ELSE
-             surf_lsm_v(l)%lai(m)   = 0.0_wp
-             surf_lsm_v(l)%c_veg(m) = 0.0_wp
-             surf_lsm_v(l)%g_d(m)   = 0.0_wp
-          ENDIF
-       ENDDO
-    ENDDO
-
-!
-!-- Level 2, initialization of vegation parameters via vegetation_type read from file. Vegetation
-!-- parameters are initialized for each (y,x)-grid point individually using default paramter
-!-- settings according to the given vegetation type.
-    IF ( vegetation_type_f%from_file )  THEN
-!
-!--       Horizontal surfaces
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-
-             st = vegetation_type_f%var(j,i)
-             IF ( st /= vegetation_type_f%fill  .AND.  st /= 0 )  THEN
-                surf_lsm_h(l)%r_canopy_min(m)     = vegetation_pars(ind_v_rc_min,st)
-                surf_lsm_h(l)%lai(m)              = vegetation_pars(ind_v_rc_lai,st)
-                surf_lsm_h(l)%c_veg(m)            = vegetation_pars(ind_v_c_veg,st)
-                surf_lsm_h(l)%g_d(m)              = vegetation_pars(ind_v_gd,st)
-                surf_lsm_h(l)%z0(m)               = vegetation_pars(ind_v_z0,st)
-                surf_lsm_h(l)%z0h(m)              = vegetation_pars(ind_v_z0qh,st)
-                surf_lsm_h(l)%z0q(m)              = vegetation_pars(ind_v_z0qh,st)
-                surf_lsm_h(l)%lambda_surface_s(m) = vegetation_pars(ind_v_lambda_s,st)
-                surf_lsm_h(l)%lambda_surface_u(m) = vegetation_pars(ind_v_lambda_u,st)
-                surf_lsm_h(l)%f_sw_in(m)          = vegetation_pars(ind_v_f_sw_in,st)
-                surf_lsm_h(l)%c_surface(m)        = vegetation_pars(ind_v_c_surf,st)
-                surf_lsm_h(l)%albedo_type(m,ind_veg_wall) = INT( vegetation_pars(ind_v_at,st) )
-                surf_lsm_h(l)%emissivity(m,ind_veg_wall)  = vegetation_pars(ind_v_emis,st)
-
-                surf_lsm_h(l)%vegetation_type(m)      = st
-                surf_lsm_h(l)%vegetation_type_name(m) = vegetation_type_name(st)
-             ENDIF
-          ENDDO
-       ENDDO
-!
-!--    Vertical surfaces
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-             j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-
-             st = vegetation_type_f%var(j,i)
-             IF ( st /= vegetation_type_f%fill  .AND.  st /= 0 )  THEN
-                surf_lsm_v(l)%r_canopy_min(m)     = vegetation_pars(ind_v_rc_min,st)
-                surf_lsm_v(l)%lai(m)              = vegetation_pars(ind_v_rc_lai,st)
-                surf_lsm_v(l)%c_veg(m)            = vegetation_pars(ind_v_c_veg,st)
-                surf_lsm_v(l)%g_d(m)              = vegetation_pars(ind_v_gd,st)
-                surf_lsm_v(l)%z0(m)               = vegetation_pars(ind_v_z0,st)
-                surf_lsm_v(l)%z0h(m)              = vegetation_pars(ind_v_z0qh,st)
-                surf_lsm_v(l)%z0q(m)              = vegetation_pars(ind_v_z0qh,st)
-                surf_lsm_v(l)%lambda_surface_s(m) = vegetation_pars(ind_v_lambda_s,st)
-                surf_lsm_v(l)%lambda_surface_u(m) = vegetation_pars(ind_v_lambda_u,st)
-                surf_lsm_v(l)%f_sw_in(m)          = vegetation_pars(ind_v_f_sw_in,st)
-                surf_lsm_v(l)%c_surface(m)        = vegetation_pars(ind_v_c_surf,st)
-                surf_lsm_v(l)%albedo_type(m,ind_veg_wall) = INT( vegetation_pars(ind_v_at,st) )
-                surf_lsm_v(l)%emissivity(m,ind_veg_wall)  = vegetation_pars(ind_v_emis,st)
-
-                surf_lsm_v(l)%vegetation_type(m)      = st
-                surf_lsm_v(l)%vegetation_type_name(m) = vegetation_type_name(st)
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Level 3, initialization of vegation parameters at single (x,y) position via vegetation_pars read
-!-- from file.
-    IF ( vegetation_pars_f%from_file )  THEN
-!
-!--    Horizontal surfaces
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-!
-!--          If surface element is not a vegetation surface and any value in vegetation_pars is
-!--          given, neglect this information and give an informative message that this value will
-!--          not be used.
-             IF ( .NOT. surf_lsm_h(l)%vegetation_surface(m)  .AND.                                 &
-                   ANY( vegetation_pars_f%pars_xy(:,j,i) /= vegetation_pars_f%fill ) )  THEN
-                WRITE( message_string, * ) 'surface element at grid point (j,i) = (',              &
-                                           j, i, ') is not a vegetation surface, ',                &
-                                           'so that information given in ',                        &
-                                          'vegetation_pars at this point is neglected.'
-                CALL message( 'land_surface_model_mod', 'PA0436', 0, 0, myid, 6, 0 )
-             ELSE
-
-                IF ( vegetation_pars_f%pars_xy(ind_v_rc_min,j,i) /= vegetation_pars_f%fill )       &
-                   surf_lsm_h(l)%r_canopy_min(m)  = vegetation_pars_f%pars_xy(ind_v_rc_min,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_rc_lai,j,i) /= vegetation_pars_f%fill )       &
-                   surf_lsm_h(l)%lai(m)           = vegetation_pars_f%pars_xy(ind_v_rc_lai,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_c_veg,j,i) /=  vegetation_pars_f%fill )       &
-                   surf_lsm_h(l)%c_veg(m)         = vegetation_pars_f%pars_xy(ind_v_c_veg,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_gd,j,i) /= vegetation_pars_f%fill )           &
-                   surf_lsm_h(l)%g_d(m)           = vegetation_pars_f%pars_xy(ind_v_gd,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_z0,j,i) /= vegetation_pars_f%fill )           &
-                   surf_lsm_h(l)%z0(m)            = vegetation_pars_f%pars_xy(ind_v_z0,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_z0qh,j,i) /= vegetation_pars_f%fill )  THEN
-                   surf_lsm_h(l)%z0h(m)           = vegetation_pars_f%pars_xy(ind_v_z0qh,j,i)
-                   surf_lsm_h(l)%z0q(m)           = vegetation_pars_f%pars_xy(ind_v_z0qh,j,i)
-                ENDIF
-                IF ( vegetation_pars_f%pars_xy(ind_v_lambda_s,j,i) /= vegetation_pars_f%fill )     &
-                   surf_lsm_h(l)%lambda_surface_s(m) = vegetation_pars_f%pars_xy(ind_v_lambda_s,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_lambda_u,j,i) /= vegetation_pars_f%fill )     &
-                   surf_lsm_h(l)%lambda_surface_u(m) = vegetation_pars_f%pars_xy(ind_v_lambda_u,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_f_sw_in,j,i) /= vegetation_pars_f%fill )      &
-                   surf_lsm_h(l)%f_sw_in(m)          = vegetation_pars_f%pars_xy(ind_v_f_sw_in,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_c_surf,j,i) /= vegetation_pars_f%fill )       &
-                   surf_lsm_h(l)%c_surface(m)        = vegetation_pars_f%pars_xy(ind_v_c_surf,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_at,j,i) /= vegetation_pars_f%fill )           &
-                   surf_lsm_h(l)%albedo_type(m,ind_veg_wall) =                                     &
-                                                      INT( vegetation_pars_f%pars_xy(ind_v_at,j,i) )
-                IF ( vegetation_pars_f%pars_xy(ind_v_emis,j,i) /= vegetation_pars_f%fill )         &
-                   surf_lsm_h(l)%emissivity(m,ind_veg_wall)  =                                     &
-                                                       vegetation_pars_f%pars_xy(ind_v_emis,j,i)
-             ENDIF
-          ENDDO
-       ENDDO
-!
-!--    Vertical surfaces
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-             j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-!
-!--          If surface element is not a vegetation surface and any value in vegetation_pars is
-!--          given, neglect this information and give an informative message that this value will
-!--          not be used.
-             IF ( .NOT. surf_lsm_v(l)%vegetation_surface(m)  .AND.                                 &
-                   ANY( vegetation_pars_f%pars_xy(:,j,i) /= vegetation_pars_f%fill ) )  THEN
-                WRITE( message_string, * ) 'surface element at grid point (j,i) = (',              &
-                                           j, i, ') is not a vegetation surface, ',                &
-                                           'so that information given in ',                        &
-                                           'vegetation_pars at this point is neglected.'
-                CALL message( 'land_surface_model_mod', 'PA0436', 0, 0, myid, 6, 0 )
-             ELSE
-
-                IF ( vegetation_pars_f%pars_xy(ind_v_rc_min,j,i) /= vegetation_pars_f%fill )       &
-                   surf_lsm_v(l)%r_canopy_min(m)  = vegetation_pars_f%pars_xy(ind_v_rc_min,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_rc_lai,j,i) /= vegetation_pars_f%fill )       &
-                   surf_lsm_v(l)%lai(m)           = vegetation_pars_f%pars_xy(ind_v_rc_lai,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_c_veg,j,i) /= vegetation_pars_f%fill )        &
-                   surf_lsm_v(l)%c_veg(m)         = vegetation_pars_f%pars_xy(ind_v_c_veg,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_gd,j,i) /= vegetation_pars_f%fill )           &
-                  surf_lsm_v(l)%g_d(m)            = vegetation_pars_f%pars_xy(ind_v_gd,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_z0,j,i) /= vegetation_pars_f%fill )           &
-                   surf_lsm_v(l)%z0(m)            = vegetation_pars_f%pars_xy(ind_v_z0,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_z0qh,j,i) /= vegetation_pars_f%fill )  THEN
-                   surf_lsm_v(l)%z0h(m)           = vegetation_pars_f%pars_xy(ind_v_z0qh,j,i)
-                   surf_lsm_v(l)%z0q(m)           = vegetation_pars_f%pars_xy(ind_v_z0qh,j,i)
-                ENDIF
-                IF ( vegetation_pars_f%pars_xy(ind_v_lambda_s,j,i) /= vegetation_pars_f%fill )     &
-                   surf_lsm_v(l)%lambda_surface_s(m)  =                                            &
-                                                    vegetation_pars_f%pars_xy(ind_v_lambda_s,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_lambda_u,j,i) /= vegetation_pars_f%fill )     &
-                   surf_lsm_v(l)%lambda_surface_u(m)  =                                            &
-                                                    vegetation_pars_f%pars_xy(ind_v_lambda_u,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_f_sw_in,j,i) /= vegetation_pars_f%fill )      &
-                   surf_lsm_v(l)%f_sw_in(m)           =                                            &
-                                                    vegetation_pars_f%pars_xy(ind_v_f_sw_in,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_c_surf,j,i) /= vegetation_pars_f%fill )       &
-                   surf_lsm_v(l)%c_surface(m)         =                                            &
-                                                    vegetation_pars_f%pars_xy(ind_v_c_surf,j,i)
-                IF ( vegetation_pars_f%pars_xy(ind_v_at,j,i) /= vegetation_pars_f%fill )           &
-                   surf_lsm_v(l)%albedo_type(m,ind_veg_wall) =                                     &
-                                                   INT( vegetation_pars_f%pars_xy(ind_v_at,j,i) )
-                IF ( vegetation_pars_f%pars_xy(ind_v_emis,j,i) /= vegetation_pars_f%fill )         &
-                   surf_lsm_v(l)%emissivity(m,ind_veg_wall)  =                                     &
-                                                    vegetation_pars_f%pars_xy(ind_v_emis,j,i)
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDIF
-
-!
-!-- Level 1, initialization of water parameters. A horizontally homogeneous distribution is assumed
-!-- here.
-    IF ( water_type /= 0 )  THEN
-
-       IF ( water_temperature == 9999999.9_wp )  THEN
-          water_temperature = water_pars(ind_w_temp,water_type)
-       ENDIF
-
-       IF ( z0_water == 9999999.9_wp )  THEN
-          z0_water = water_pars(ind_w_z0,water_type)
-       ENDIF
-
-       IF ( z0h_water == 9999999.9_wp )  THEN
-          z0h_water = water_pars(ind_w_z0h,water_type)
-       ENDIF
-
-       IF ( z0q_water == 9999999.9_wp )  THEN
-          z0q_water = water_pars(ind_w_z0h,water_type)
-       ENDIF
-
-       IF ( albedo_type == 9999999  .AND.  albedo == 9999999.9_wp )  THEN
-          albedo_type = INT(water_pars(ind_w_at,water_type))
-       ENDIF
-
-       IF ( emissivity == 9999999.9_wp )  THEN
-          emissivity = water_pars(ind_w_emis,water_type)
-       ENDIF
-
-    ENDIF
-!
-!--    Map values onto horizontal elemements
-    DO  l = 0, 1
-       DO  m = 1, surf_lsm_h(l)%ns
-          IF ( surf_lsm_h(l)%water_surface(m) )  THEN
-             IF ( TRIM( initializing_actions ) /= 'read_restart_data' )                            &
-                t_soil_h(l)%var_2d(:,m)        = water_temperature
-             surf_lsm_h(l)%z0(m)               = z0_water
-             surf_lsm_h(l)%z0h(m)              = z0h_water
-             surf_lsm_h(l)%z0q(m)              = z0q_water
-             surf_lsm_h(l)%lambda_surface_s(m) = 1.0E10_wp
-             surf_lsm_h(l)%lambda_surface_u(m) = 1.0E10_wp
-             surf_lsm_h(l)%c_surface(m)        = 0.0_wp
-             surf_lsm_h(l)%albedo_type(m,ind_wat_win) = albedo_type
-             surf_lsm_h(l)%emissivity(m,ind_wat_win)  = emissivity
-
-             surf_lsm_h(l)%water_type(m)      = water_type
-             surf_lsm_h(l)%water_type_name(m) = water_type_name(water_type)
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!-- Map values onto vertical elements, even though this does not make much sense.
-    DO  l = 0, 3
-       DO  m = 1, surf_lsm_v(l)%ns
-          IF ( surf_lsm_v(l)%water_surface(m) )  THEN
-             IF ( TRIM( initializing_actions ) /= 'read_restart_data' )                            &
-                t_soil_v(l)%var_2d(:,m)        = water_temperature
-             surf_lsm_v(l)%z0(m)               = z0_water
-             surf_lsm_v(l)%z0h(m)              = z0h_water
-             surf_lsm_v(l)%z0q(m)              = z0q_water
-             surf_lsm_v(l)%lambda_surface_s(m) = 1.0E10_wp
-             surf_lsm_v(l)%lambda_surface_u(m) = 1.0E10_wp
-             surf_lsm_v(l)%c_surface(m)        = 0.0_wp
-             surf_lsm_v(l)%albedo_type(m,ind_wat_win) = albedo_type
-             surf_lsm_v(l)%emissivity(m,ind_wat_win)  = emissivity
-
-             surf_lsm_v(l)%water_type(m)      = water_type
-             surf_lsm_v(l)%water_type_name(m) = water_type_name(water_type)
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!
-!-- Level 2, initialization of water parameters via water_type read from file. Water surfaces are
-!-- initialized for each (y,x)-grid point individually using default paramter settings according to
-!-- the given water type.
-!-- Note, parameter 3/4 of water_pars are albedo and emissivity, whereas paramter 3/4 of
-!-- water_pars_f are heat conductivities!
-    IF ( water_type_f%from_file )  THEN
-!
-!--    Horizontal surfaces
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-
-             st = water_type_f%var(j,i)
-             IF ( st /= water_type_f%fill  .AND.  st /= 0 )  THEN
-                IF ( TRIM( initializing_actions ) /= 'read_restart_data' )                         &
-                   t_soil_h(l)%var_2d(:,m) = water_pars(ind_w_temp,st)
-                surf_lsm_h(l)%z0(m)     = water_pars(ind_w_z0,st)
-                surf_lsm_h(l)%z0h(m)    = water_pars(ind_w_z0h,st)
-                surf_lsm_h(l)%z0q(m)    = water_pars(ind_w_z0h,st)
-                surf_lsm_h(l)%lambda_surface_s(m) = water_pars(ind_w_lambda_s,st)
-                surf_lsm_h(l)%lambda_surface_u(m) = water_pars(ind_w_lambda_u,st)
-                surf_lsm_h(l)%c_surface(m)        = 0.0_wp
-                surf_lsm_h(l)%albedo_type(m,ind_wat_win) = INT( water_pars(ind_w_at,st) )
-                surf_lsm_h(l)%emissivity(m,ind_wat_win)  = water_pars(ind_w_emis,st)
-
-                surf_lsm_h(l)%water_type(m)      = st
-                surf_lsm_h(l)%water_type_name(m) = water_type_name(st)
-             ENDIF
-          ENDDO
-       ENDDO
-!
-!--    Vertical surfaces
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-             j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-
-             st = water_type_f%var(j,i)
-             IF ( st /= water_type_f%fill  .AND.  st /= 0 )  THEN
-                IF ( TRIM( initializing_actions ) /= 'read_restart_data' )                         &
-                   t_soil_v(l)%var_2d(:,m) = water_pars(ind_w_temp,st)
-                surf_lsm_v(l)%z0(m)     = water_pars(ind_w_z0,st)
-                surf_lsm_v(l)%z0h(m)    = water_pars(ind_w_z0h,st)
-                surf_lsm_v(l)%z0q(m)    = water_pars(ind_w_z0h,st)
-                surf_lsm_v(l)%lambda_surface_s(m) = water_pars(ind_w_lambda_s,st)
-                surf_lsm_v(l)%lambda_surface_u(m) = water_pars(ind_w_lambda_u,st)
-                surf_lsm_v(l)%c_surface(m)     = 0.0_wp
-                surf_lsm_v(l)%albedo_type(m,ind_wat_win) = INT( water_pars(ind_w_at,st) )
-                surf_lsm_v(l)%emissivity(m,ind_wat_win)  = water_pars(ind_w_emis,st)
-
-                surf_lsm_v(l)%water_type(m)      = st
-                surf_lsm_v(l)%water_type_name(m) = water_type_name(st)
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDIF
-
-!
-!-- Level 3, initialization of water parameters at single (x,y) position via water_pars read from
-!-- file.
-    IF ( water_pars_f%from_file )  THEN
-!
-!--    Horizontal surfaces
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-!
-!--          If surface element is not a water surface and any value in water_pars is given, neglect
-!--          this information and give an informative message that this value will not be used.
-             IF ( .NOT. surf_lsm_h(l)%water_surface(m)  .AND.                                      &
-                   ANY( water_pars_f%pars_xy(:,j,i) /= water_pars_f%fill ) )  THEN
-                WRITE( message_string, * ) 'surface element at grid point (j,i) = (',              &
-                                           j, i, ') is not a water surface, ',                     &
-                                           'so that information given in ',                        &
-                                           'water_pars at this point is neglected.'
-                CALL message( 'land_surface_model_mod', 'PA0645', 0, 0, myid, 6, 0 )
-             ELSE
-                IF ( water_pars_f%pars_xy(ind_w_temp,j,i) /= water_pars_f%fill  .AND.              &
-                     TRIM( initializing_actions ) /= 'read_restart_data' )                         &
-                      t_soil_h(l)%var_2d(:,m) = water_pars_f%pars_xy(ind_w_temp,j,i)
-
-                IF ( water_pars_f%pars_xy(ind_w_z0,j,i) /= water_pars_f%fill )                     &
-                   surf_lsm_h(l)%z0(m)     = water_pars_f%pars_xy(ind_w_z0,j,i)
-
-                IF ( water_pars_f%pars_xy(ind_w_z0h,j,i) /= water_pars_f%fill )  THEN
-                   surf_lsm_h(l)%z0h(m)    = water_pars_f%pars_xy(ind_w_z0h,j,i)
-                   surf_lsm_h(l)%z0q(m)    = water_pars_f%pars_xy(ind_w_z0h,j,i)
-                ENDIF
-                IF ( water_pars_f%pars_xy(ind_w_lambda_s,j,i) /= water_pars_f%fill )               &
-                   surf_lsm_h(l)%lambda_surface_s(m) = water_pars_f%pars_xy(ind_w_lambda_s,j,i)
-
-                IF ( water_pars_f%pars_xy(ind_w_lambda_u,j,i) /= water_pars_f%fill )               &
-                   surf_lsm_h(l)%lambda_surface_u(m) = water_pars_f%pars_xy(ind_w_lambda_u,j,i)
-
-                IF ( water_pars_f%pars_xy(ind_w_at,j,i) /= water_pars_f%fill )                     &
-                   surf_lsm_h(l)%albedo_type(m,ind_wat_win) =                                      &
-                                                       INT( water_pars_f%pars_xy(ind_w_at,j,i) )
-
-                IF ( water_pars_f%pars_xy(ind_w_emis,j,i) /= water_pars_f%fill )                   &
-                   surf_lsm_h(l)%emissivity(m,ind_wat_win) = water_pars_f%pars_xy(ind_w_emis,j,i)
-             ENDIF
-          ENDDO
-       ENDDO
-!
-!--       Vertical surfaces
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-             j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-!
-!--          If surface element is not a water surface and any value in water_pars is given, neglect
-!--          this information and give an informative message that this value will not be used.
-             IF ( .NOT. surf_lsm_v(l)%water_surface(m)  .AND.                                      &
-                   ANY( water_pars_f%pars_xy(:,j,i) /= water_pars_f%fill ) )  THEN
-                WRITE( message_string, * ) 'surface element at grid point (j,i) = (',              &
-                                           j, i, ') is not a water surface, ',                     &
-                                           'so that information given in ',                        &
-                                           'water_pars at this point is neglected.'
-                CALL message( 'land_surface_model_mod', 'PA0645', 0, 0, myid, 6, 0 )
-             ELSE
-
-                IF ( water_pars_f%pars_xy(ind_w_temp,j,i) /= water_pars_f%fill  .AND.              &
-                     TRIM( initializing_actions ) /= 'read_restart_data' )                         &
-                   t_soil_v(l)%var_2d(:,m) = water_pars_f%pars_xy(ind_w_temp,j,i)
-
-                IF ( water_pars_f%pars_xy(ind_w_z0,j,i) /= water_pars_f%fill )                     &
-                   surf_lsm_v(l)%z0(m)   = water_pars_f%pars_xy(ind_w_z0,j,i)
-
-                IF ( water_pars_f%pars_xy(ind_w_z0h,j,i) /= water_pars_f%fill )  THEN
-                   surf_lsm_v(l)%z0h(m)  = water_pars_f%pars_xy(ind_w_z0h,j,i)
-                   surf_lsm_v(l)%z0q(m)  = water_pars_f%pars_xy(ind_w_z0h,j,i)
-                ENDIF
-
-                IF ( water_pars_f%pars_xy(ind_w_lambda_s,j,i) /= water_pars_f%fill )               &
-                   surf_lsm_v(l)%lambda_surface_s(m) = water_pars_f%pars_xy(ind_w_lambda_s,j,i)
-
-                IF ( water_pars_f%pars_xy(ind_w_lambda_u,j,i) /= water_pars_f%fill )               &
-                   surf_lsm_v(l)%lambda_surface_u(m) = water_pars_f%pars_xy(ind_w_lambda_u,j,i)
-
-                IF ( water_pars_f%pars_xy(ind_w_at,j,i) /= water_pars_f%fill )                     &
-                   surf_lsm_v(l)%albedo_type(m,ind_wat_win) =                                      &
-                                                          INT( water_pars_f%pars_xy(ind_w_at,j,i) )
-
-                IF ( water_pars_f%pars_xy(ind_w_emis,j,i) /= water_pars_f%fill )                   &
-                   surf_lsm_v(l)%emissivity(m,ind_wat_win)  =  water_pars_f%pars_xy(ind_w_emis,j,i)
-             ENDIF
-          ENDDO
-       ENDDO
-
-    ENDIF
-!
-!-- Initialize pavement-type surfaces, level 1
-    IF ( pavement_type /= 0 )  THEN
-
-!
-!--    When a pavement_type is used, overwrite a possible setting of the pavement depth as it is
-!--    already defined by the pavement type.
-       pavement_depth_level = 0
-
-       IF ( z0_pavement == 9999999.9_wp )  THEN
-          z0_pavement  = pavement_pars(ind_p_z0,pavement_type)
-       ENDIF
-
-       IF ( z0h_pavement == 9999999.9_wp )  THEN
-          z0h_pavement = pavement_pars(ind_p_z0h,pavement_type)
-       ENDIF
-
-       IF ( z0q_pavement == 9999999.9_wp )  THEN
-          z0q_pavement = pavement_pars(ind_p_z0h,pavement_type)
-       ENDIF
-
-       IF ( pavement_heat_conduct == 9999999.9_wp )  THEN
-          pavement_heat_conduct = pavement_subsurface_pars_1(0,pavement_type)
-       ENDIF
-
-       IF ( pavement_heat_capacity == 9999999.9_wp )  THEN
-          pavement_heat_capacity = pavement_subsurface_pars_2(0,pavement_type)
-       ENDIF
-
-       IF ( albedo_type == 9999999  .AND.  albedo == 9999999.9_wp )  THEN
-          albedo_type = INT(pavement_pars(ind_p_at,pavement_type))
-       ENDIF
-
-       IF ( emissivity == 9999999.9_wp )  THEN
-          emissivity = pavement_pars(ind_p_emis,pavement_type)
-       ENDIF
-
-!
-!--    If the depth level of the pavement is not set, determine it from lookup table.
-       IF ( pavement_depth_level == 0 )  THEN
-          DO  k = nzb_soil, nzt_soil
-             IF ( pavement_subsurface_pars_1(k,pavement_type) == 9999999.9_wp  .OR.                &
-                  pavement_subsurface_pars_2(k,pavement_type) == 9999999.9_wp )                    &
-             THEN
-                nzt_pavement = k-1
-                EXIT
-             ENDIF
-          ENDDO
-       ELSE
-          nzt_pavement = pavement_depth_level
-       ENDIF
-    ENDIF
-!
-!-- Level 1 initialization of pavement type surfaces. Horizontally homogeneous characteristics are
-!-- assumed.
-    DO  l = 0, 1
-       surf_lsm_h(l)%nzt_pavement = pavement_depth_level
-       DO  m = 1, surf_lsm_h(l)%ns
-          IF ( surf_lsm_h(l)%pavement_surface(m) )  THEN
-             surf_lsm_h(l)%nzt_pavement(m)        = nzt_pavement
-             surf_lsm_h(l)%z0(m)                  = z0_pavement
-             surf_lsm_h(l)%z0h(m)                 = z0h_pavement
-             surf_lsm_h(l)%z0q(m)                 = z0q_pavement
-             surf_lsm_h(l)%lambda_surface_s(m)    = pavement_heat_conduct * ddz_soil(nzb_soil)     &
-                                                    * 2.0_wp
-             surf_lsm_h(l)%lambda_surface_u(m)    = pavement_heat_conduct * ddz_soil(nzb_soil)     &
-                                                    * 2.0_wp
-             surf_lsm_h(l)%c_surface(m)           = pavement_heat_capacity * dz_soil(nzb_soil)     &
-                                                    * 0.25_wp
-
-             surf_lsm_h(l)%albedo_type(m,ind_pav_green) = albedo_type
-             surf_lsm_h(l)%emissivity(m,ind_pav_green)  = emissivity
-
-             surf_lsm_h(l)%pavement_type(m)      = pavement_type
-             surf_lsm_h(l)%pavement_type_name(m) = pavement_type_name(pavement_type)
-
-             IF ( pavement_type /= 0 )  THEN
-                DO  k = nzb_soil, surf_lsm_h(l)%nzt_pavement(m)
-                   surf_lsm_h(l)%lambda_h_def(k,m)    = pavement_subsurface_pars_1(k,pavement_type)
-                   surf_lsm_h(l)%rho_c_total_def(k,m) = pavement_subsurface_pars_2(k,pavement_type)
-                ENDDO
-             ELSE
-                surf_lsm_h(l)%lambda_h_def(:,m)     = pavement_heat_conduct
-                surf_lsm_h(l)%rho_c_total_def(:,m)  = pavement_heat_capacity
-             ENDIF
-          ENDIF
-       ENDDO
-    ENDDO
-
-    DO  l = 0, 3
-       surf_lsm_v(l)%nzt_pavement = pavement_depth_level
-       DO  m = 1, surf_lsm_v(l)%ns
-          IF ( surf_lsm_v(l)%pavement_surface(m) )  THEN
-             surf_lsm_v(l)%nzt_pavement(m)     = nzt_pavement
-             surf_lsm_v(l)%z0(m)               = z0_pavement
-             surf_lsm_v(l)%z0h(m)              = z0h_pavement
-             surf_lsm_v(l)%z0q(m)              = z0q_pavement
-             surf_lsm_v(l)%lambda_surface_s(m) = pavement_heat_conduct * ddz_soil(nzb_soil) * 2.0_wp
-             surf_lsm_v(l)%lambda_surface_u(m) = pavement_heat_conduct * ddz_soil(nzb_soil) * 2.0_wp
-             surf_lsm_v(l)%c_surface(m)        = pavement_heat_capacity * dz_soil(nzb_soil)        &
-                                                 * 0.25_wp
-
-             surf_lsm_v(l)%albedo_type(m,ind_pav_green) = albedo_type
-             surf_lsm_v(l)%emissivity(m,ind_pav_green)  = emissivity
-
-             surf_lsm_v(l)%pavement_type(m)      = pavement_type
-             surf_lsm_v(l)%pavement_type_name(m) = pavement_type_name(pavement_type)
-
-             IF ( pavement_type /= 0 )  THEN
-                DO  k = nzb_soil, surf_lsm_v(l)%nzt_pavement(m)
-                   surf_lsm_v(l)%lambda_h_def(k,m)    = pavement_subsurface_pars_1(k,pavement_type)
-                   surf_lsm_v(l)%rho_c_total_def(k,m) = pavement_subsurface_pars_2(k,pavement_type)
-                ENDDO
-             ELSE
-                surf_lsm_v(l)%lambda_h_def(:,m)    = pavement_heat_conduct
-                surf_lsm_v(l)%rho_c_total_def(:,m) = pavement_heat_capacity
-             ENDIF
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!-- Level 2 initialization of pavement type surfaces via pavement_type read from file. Pavement
-!-- surfaces are initialized for each (y,x)-grid point individually.
-    IF ( pavement_type_f%from_file )  THEN
-!
-!--    Horizontal surfaces
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-
-             st = pavement_type_f%var(j,i)
-             IF ( st /= pavement_type_f%fill  .AND.  st /= 0 )  THEN
-!
-!--             Determine deepmost index of pavement layer
-                DO  k = nzb_soil, nzt_soil
-                   IF ( pavement_subsurface_pars_1(k,st) == 9999999.9_wp  .OR.                     &
-                        pavement_subsurface_pars_2(k,st) == 9999999.9_wp )                         &
-                   THEN
-                      surf_lsm_h(l)%nzt_pavement(m) = k-1
-                      EXIT
-                   ENDIF
-                ENDDO
-
-                surf_lsm_h(l)%z0(m)               = pavement_pars(ind_p_z0,st)
-                surf_lsm_h(l)%z0h(m)              = pavement_pars(ind_p_z0h,st)
-                surf_lsm_h(l)%z0q(m)              = pavement_pars(ind_p_z0h,st)
-
-                surf_lsm_h(l)%lambda_surface_s(m) = pavement_subsurface_pars_1(0,st)               &
-                                                    * ddz_soil(nzb_soil) * 2.0_wp
-                surf_lsm_h(l)%lambda_surface_u(m) = pavement_subsurface_pars_1(0,st)               &
-                                                    * ddz_soil(nzb_soil) * 2.0_wp
-                surf_lsm_h(l)%c_surface(m)        = pavement_subsurface_pars_2(0,st)               &
-                                                    * dz_soil(nzb_soil)  * 0.25_wp
-                surf_lsm_h(l)%albedo_type(m,ind_pav_green) = INT( pavement_pars(ind_p_at,st) )
-                surf_lsm_h(l)%emissivity(m,ind_pav_green)  = pavement_pars(ind_p_emis,st)
-
-                surf_lsm_h(l)%pavement_type(m)      = st
-                surf_lsm_h(l)%pavement_type_name(m) = pavement_type_name(st)
-
-                DO  k = nzb_soil, surf_lsm_h(l)%nzt_pavement(m)
-                   surf_lsm_h(l)%lambda_h_def(k,m)    = pavement_subsurface_pars_1(k,pavement_type)
-                   surf_lsm_h(l)%rho_c_total_def(k,m) = pavement_subsurface_pars_2(k,pavement_type)
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDDO
-!
-!--    Vertical surfaces
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-             j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-
-             st = pavement_type_f%var(j,i)
-             IF ( st /= pavement_type_f%fill  .AND.  st /= 0 )  THEN
-!
-!--             Determine deepmost index of pavement layer
-                DO  k = nzb_soil, nzt_soil
-                   IF ( pavement_subsurface_pars_1(k,st) == 9999999.9_wp  .OR.                     &
-                        pavement_subsurface_pars_2(k,st) == 9999999.9_wp )                         &
-                   THEN
-                      surf_lsm_v(l)%nzt_pavement(m) = k-1
-                      EXIT
-                   ENDIF
-                ENDDO
-
-                surf_lsm_v(l)%z0(m)  = pavement_pars(ind_p_z0,st)
-                surf_lsm_v(l)%z0h(m) = pavement_pars(ind_p_z0h,st)
-                surf_lsm_v(l)%z0q(m) = pavement_pars(ind_p_z0h,st)
-
-                surf_lsm_v(l)%lambda_surface_s(m) = pavement_subsurface_pars_1(0,st)               &
-                                                    * ddz_soil(nzb_soil) * 2.0_wp
-                surf_lsm_v(l)%lambda_surface_u(m) = pavement_subsurface_pars_1(0,st)               &
-                                                    * ddz_soil(nzb_soil) * 2.0_wp
-                surf_lsm_v(l)%c_surface(m)        = pavement_subsurface_pars_2(0,st)               &
-                                                    * dz_soil(nzb_soil) * 0.25_wp
-
-                surf_lsm_v(l)%albedo_type(m,ind_pav_green) = INT( pavement_pars(ind_p_at,st) )
-                surf_lsm_v(l)%emissivity(m,ind_pav_green)  = pavement_pars(ind_p_emis,st)
-
-                surf_lsm_v(l)%pavement_type(m)      = st
-                surf_lsm_v(l)%pavement_type_name(m) = pavement_type_name(st)
-
-                DO  k = nzb_soil, surf_lsm_v(l)%nzt_pavement(m)
-                   surf_lsm_v(l)%lambda_h_def(k,m)    = pavement_subsurface_pars_1(k,pavement_type)
-                   surf_lsm_v(l)%rho_c_total_def(k,m) = pavement_subsurface_pars_2(k,pavement_type)
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Level 3, initialization of pavement parameters at single (x,y) position via pavement_pars read
-!-- from file.
-    IF ( pavement_pars_f%from_file )  THEN
-!
-!--    Horizontal surfaces
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-!
-!--          If surface element is not a pavement surface and any value in pavement_pars is given,
-!--          neglect this information and give an informative message that this value will not be
-!--          used.
-             IF ( .NOT. surf_lsm_h(l)%pavement_surface(m)  .AND.                                   &
-                   ANY( pavement_pars_f%pars_xy(:,j,i) /= pavement_pars_f%fill ) )  THEN
-                WRITE( message_string, * ) 'surface element at grid point (j,i) = (',              &
-                                           j, i, ') is not a pavement surface, ',                  &
-                                           'so that information given in ',                        &
-                                           'pavement_pars at this point is neglected.'
-                CALL message( 'land_surface_model_mod', 'PA0647', 0, 0, myid, 6, 0 )
-             ELSE
-                IF ( pavement_pars_f%pars_xy(ind_p_z0,j,i) /= pavement_pars_f%fill )               &
-                   surf_lsm_h(l)%z0(m)  = pavement_pars_f%pars_xy(ind_p_z0,j,i)
-                IF ( pavement_pars_f%pars_xy(ind_p_z0h,j,i) /= pavement_pars_f%fill )  THEN
-                   surf_lsm_h(l)%z0h(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i)
-                   surf_lsm_h(l)%z0q(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i)
-                ENDIF
-                IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= pavement_pars_f%fill )               &
-                   surf_lsm_h(l)%albedo_type(m,ind_pav_green) =                                    &
-                                                     INT( pavement_pars_f%pars_xy(ind_p_at,j,i) )
-                IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /= pavement_pars_f%fill )             &
-                   surf_lsm_h(l)%emissivity(m,ind_pav_green)  =                                    &
-                                                          pavement_pars_f%pars_xy(ind_p_emis,j,i)
-             ENDIF
-          ENDDO
-       ENDDO
-!
-!--       Vertical surfaces
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-             j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-!
-!--          If surface element is not a pavement surface and any value in pavement_pars is given,
-!--          neglect this information and give an informative message that this value will not be
-!--          used.
-             IF ( .NOT. surf_lsm_v(l)%pavement_surface(m)  .AND.                                   &
-                   ANY( pavement_pars_f%pars_xy(:,j,i) /= pavement_pars_f%fill ) )  THEN
-                WRITE( message_string, * ) 'surface element at grid point (j,i) = (',              &
-                                            j, i, ') is not a pavement surface, ',                 &
-                                            'so that information given in ',                       &
-                                            'pavement_pars at this point is neglected.'
-                CALL message( 'land_surface_model_mod', 'PA0647', 0, 0, myid, 6, 0 )
-             ELSE
-                IF ( pavement_pars_f%pars_xy(ind_p_z0,j,i) /= pavement_pars_f%fill )               &
-                   surf_lsm_v(l)%z0(m) = pavement_pars_f%pars_xy(ind_p_z0,j,i)
-                IF ( pavement_pars_f%pars_xy(ind_p_z0h,j,i) /= pavement_pars_f%fill )  THEN
-                   surf_lsm_v(l)%z0h(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i)
-                   surf_lsm_v(l)%z0q(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i)
-                ENDIF
-                IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= pavement_pars_f%fill )               &
-                   surf_lsm_v(l)%albedo_type(m,ind_pav_green) =                                    &
-                                                     INT( pavement_pars_f%pars_xy(ind_p_at,j,i) )
-
-                IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /= pavement_pars_f%fill )             &
-                   surf_lsm_v(l)%emissivity(m,ind_pav_green)  =                                    &
-                                                          pavement_pars_f%pars_xy(ind_p_emis,j,i)
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Moreover, for grid points which are flagged with pavement-type 0 or where
-!-- pavement_subsurface_pars_f is provided, soil heat conductivity and capacity are initialized with
-!-- parameters given in pavement_subsurface_pars read from file.
-    IF ( pavement_subsurface_pars_f%from_file )  THEN
-!
-!--    Set pavement depth to nzt_soil. Please note, this is just a workaround at the moment.
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             IF ( surf_lsm_h(l)%pavement_surface(m) )  THEN
-
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-
-                surf_lsm_h(l)%nzt_pavement(m) = nzt_soil
-
-                IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)                     &
-                     /= pavement_subsurface_pars_f%fill )  THEN
-                   surf_lsm_h(l)%lambda_surface_s(m)  =                                            &
-                                       pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)   &
-                                       * ddz_soil(nzb_soil) * 2.0_wp
-                   surf_lsm_h(l)%lambda_surface_u(m)  =                                            &
-                                       pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)   &
-                                       * ddz_soil(nzb_soil) * 2.0_wp
-                ENDIF
-                IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) /=                     &
-                     pavement_subsurface_pars_f%fill )  THEN
-                   surf_lsm_h(l)%c_surface(m)     =                                                &
-                                       pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i)      &
-                                       * dz_soil(nzb_soil) * 0.25_wp
-                ENDIF
-
-                DO  k = nzb_soil, nzt_soil
-                   IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i) /=               &
-                        pavement_subsurface_pars_f%fill )  THEN
-                      surf_lsm_h(l)%lambda_h_def(k,m) =                                            &
-                                       pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i)
-                   ENDIF
-                   IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i) /=                  &
-                        pavement_subsurface_pars_f%fill )  THEN
-                      surf_lsm_h(l)%rho_c_total_def(k,m) =                                         &
-                                       pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i)
-                   ENDIF
-                ENDDO
-
-             ENDIF
-          ENDDO
-       ENDDO
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             IF ( surf_lsm_v(l)%pavement_surface(m) )  THEN
-
-                i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-                j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-
-                surf_lsm_v(l)%nzt_pavement(m) = nzt_soil
-
-                IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)                     &
-                     /= pavement_subsurface_pars_f%fill )  THEN
-                   surf_lsm_v(l)%lambda_surface_s(m) =                                             &
-                                       pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)   &
-                                       * ddz_soil(nzb_soil) * 2.0_wp
-                   surf_lsm_v(l)%lambda_surface_u(m) =                                             &
-                                       pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)   &
-                                       * ddz_soil(nzb_soil) * 2.0_wp
-                ENDIF
-                IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i)                        &
-                     /= pavement_subsurface_pars_f%fill )  THEN
-                   surf_lsm_v(l)%c_surface(m)    =                                                 &
-                                       pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i)      &
-                                       * dz_soil(nzb_soil) * 0.25_wp
-                ENDIF
-
-                DO  k = nzb_soil, nzt_soil
-                   IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)                  &
-                        /= pavement_subsurface_pars_f%fill )  THEN
-                      surf_lsm_v(l)%lambda_h_def(k,m) =                                            &
-                                        pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i)
-                   ENDIF
-                   IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i)                     &
-                        /= pavement_subsurface_pars_f%fill )  THEN
-                      surf_lsm_v(l)%rho_c_total_def(k,m) =                                         &
-                                        pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i)
-                   ENDIF
-                ENDDO
-
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Initialize albedo type via given type from static input file. Please note, even though the
-!-- albedo type has been already given by the pars, albedo_type overwrites these values.
-    IF ( albedo_type_f%from_file )  THEN
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-             IF ( albedo_type_f%var(j,i) /= albedo_type_f%fill )                                   &
-                surf_lsm_h(l)%albedo_type(m,:) = albedo_type_f%var(j,i)
-          ENDDO
-       ENDDO
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-             j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                                &
-                                             surf_lsm_v(l)%building_covered(m) )
-             IF ( albedo_type_f%var(j,i) /= albedo_type_f%fill )                                   &
-                surf_lsm_v(l)%albedo_type(m,:) = albedo_type_f%var(j,i)
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Initial run actions
-    IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-!
-!--    First, initialize soil temperature and moisture.
-!--    According to the initialization for surface and soil parameters, initialize soil moisture and
-!--    temperature via a level approach. This is to assure that all surface elements are
-!--    initialized, even if data provided from input file contains fill values at some locations.
-!--    Level 1, initialization via profiles given in parameter file
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             IF ( surf_lsm_h(l)%vegetation_surface(m)  .OR.  surf_lsm_h(l)%pavement_surface(m) )   &
-             THEN
-                DO  k = nzb_soil, nzt_soil
-                   t_soil_h(l)%var_2d(k,m) = soil_temperature(k)
-                   m_soil_h(l)%var_2d(k,m) = soil_moisture(k)
-                ENDDO
-                t_soil_h(l)%var_2d(nzt_soil+1,m) = deep_soil_temperature
-             ENDIF
-          ENDDO
-       ENDDO
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             IF ( surf_lsm_v(l)%vegetation_surface(m)  .OR.  surf_lsm_v(l)%pavement_surface(m) )   &
-             THEN
-                DO  k = nzb_soil, nzt_soil
-                   t_soil_v(l)%var_2d(k,m) = soil_temperature(k)
-                   m_soil_v(l)%var_2d(k,m) = soil_moisture(k)
-                ENDDO
-                t_soil_v(l)%var_2d(nzt_soil+1,m) = deep_soil_temperature
-             ENDIF
-          ENDDO
-       ENDDO
-!
-!--    Level 2 initialization of the soil, read soil properties from dynamic input file.
-       IF ( input_pids_dynamic )  THEN
-!
-!--       CPU measurement
-          CALL cpu_log( log_point_s(85), 'NetCDF input init', 'start' )
-#if defined ( __netcdf )
-!
-!--       Open file in read-only mode
-          CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), pids_id )
-!
-!--       Inquire all variable names
-          CALL inquire_num_variables( pids_id, num_var_pids )
-!
-!--       Allocate memory to store variable names.
-          ALLOCATE( vars_pids(1:num_var_pids) )
-          CALL inquire_variable_names( pids_id, vars_pids )
-!
-!--       Read vertical dimension for soil depth.
-          IF ( check_existence( vars_pids, 'zsoil' ) )                                             &
-             CALL get_dimension_length( pids_id, init_3d%nzs, 'zsoil' )
-!
-!--       Read also the horizontal dimensions required for soil initialization.
-!--       Please note, in case of non-nested runs or in case of root domain, these data is already
-!--       available, but will be read again for the sake of clearness.
-          CALL get_dimension_length( pids_id, init_3d%nx, 'x'  )
-          CALL get_dimension_length( pids_id, init_3d%ny, 'y'  )
-!
-!--       Check for correct horizontal and vertical dimension. Please note, in case of non-nested
-!--       runs or in case of root domain, these checks are already performed.
-          IF ( init_3d%nx-1 /= nx  .OR.  init_3d%ny-1 /= ny )  THEN
-             message_string = 'Number of horizontal grid points in '//                             &
-                              'dynamic input file does not match ' //                              &
-                              'the number of numeric grid points.'
-             CALL message( 'lsm_init', 'PA0543', 1, 2, 0, 6, 0 )
-          ENDIF
-!
-!--       Read vertical dimensions. Later, these are required for eventual inter- and extrapolations
-!--       of the initialization data.
-          IF ( check_existence( vars_pids, 'zsoil' ) )  THEN
-             ALLOCATE( init_3d%z_soil(1:init_3d%nzs) )
-             CALL get_variable( pids_id, 'zsoil', init_3d%z_soil )
-          ENDIF
-!
-!--       Read initial data for soil moisture
-          IF ( check_existence( vars_pids, 'init_soil_m' ) )  THEN
-!
-!--          Read attributes for the fill value and level-of-detail
-             CALL get_attribute( pids_id, char_fill, init_3d%fill_msoil, .FALSE., 'init_soil_m' )
-             CALL get_attribute( pids_id, char_lod, init_3d%lod_msoil, .FALSE., 'init_soil_m' )
-!
-!--          level-of-detail 1 - read initialization profile
-             IF ( init_3d%lod_msoil == 1 )  THEN
-                ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) )
-
-                CALL get_variable( pids_id, 'init_soil_m', init_3d%msoil_1d(0:init_3d%nzs-1) )
-!
-!--          level-of-detail 2 - read 3D initialization data
-             ELSEIF ( init_3d%lod_msoil == 2 )  THEN
-                ALLOCATE ( init_3d%msoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr) )
-
-               CALL get_variable( pids_id, 'init_soil_m',                                          &
-                                  init_3d%msoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr),               &
-                                  nxl, nxr, nys, nyn, 0, init_3d%nzs-1 )
-
-             ENDIF
-             init_3d%from_file_msoil = .TRUE.
-          ENDIF
-!
-!--       Read soil temperature
-          IF ( check_existence( vars_pids, 'init_soil_t' ) )  THEN
-!
-!--          Read attributes for the fill value and level-of-detail
-             CALL get_attribute( pids_id, char_fill, init_3d%fill_tsoil, .FALSE., 'init_soil_t' )
-             CALL get_attribute( pids_id, char_lod, init_3d%lod_tsoil, .FALSE., 'init_soil_t' )
-!
-!--          level-of-detail 1 - read initialization profile
-             IF ( init_3d%lod_tsoil == 1 )  THEN
-                ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) )
-
-                CALL get_variable( pids_id, 'init_soil_t', init_3d%tsoil_1d(0:init_3d%nzs-1) )
-
-!
-!--          level-of-detail 2 - read 3D initialization data
-             ELSEIF ( init_3d%lod_tsoil == 2 )  THEN
-                ALLOCATE ( init_3d%tsoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr) )
-
-                CALL get_variable( pids_id, 'init_soil_t',                                         &
-                                   init_3d%tsoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr),              &
-                                   nxl, nxr, nys, nyn, 0, init_3d%nzs-1 )
-             ENDIF
-             init_3d%from_file_tsoil = .TRUE.
-          ENDIF
-!
-!--       Close the input file and deallocate temporary arrays
-          DEALLOCATE( vars_pids )
-
-          CALL close_input_file( pids_id )
-#endif
-!
-!--       End of CPU measurement
-          CALL cpu_log( log_point_s(85), 'NetCDF input init', 'stop' )
-       ENDIF
-!
-!--    In case no dynamic input is available for a child domain but the parent is initialized with
-!--    dynamic input file, the different soil states can lead to significant discrepancies in the
-!--    atmospheric surface forcing. For this reason, the child domain is initialized with
-!--    domain-averaged soil profiles from the root domain, even if no initialization with inifor is
-!--    set. Note, as long as a dynamic input file with soil information is available for the child
-!--    domain, the input file information will be used.
-       IF ( nested_run )  THEN
-#if defined( __parallel )
-!
-!--       Check if soil moisture and temperature in the root model are initialized from dynamic
-!--       input. This case, distribute these information to its child domain(s).
-          IF ( pmc_is_rootmodel() )  THEN
-             init_msoil_from_driver_root = init_3d%from_file_msoil
-             init_tsoil_from_driver_root = init_3d%from_file_tsoil
-          ENDIF
-
-          CALL MPI_BCAST( init_msoil_from_driver_root, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr )
-          CALL MPI_BCAST( init_tsoil_from_driver_root, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr )
-!
-!--       In case of a nested run, first average the soil profiles in the root domain.
-          IF ( init_msoil_from_driver_root  .OR.  init_tsoil_from_driver_root )  THEN
-
-             IF ( pmc_is_rootmodel() )  THEN
-!
-!--             Child domains will be only initialized with horizontally averaged soil profiles in
-!--             parent domain (for sake of simplicity).
-!--             If required, average soil data on root parent domain before the soil profiles are
-!--             distributed onto the child domains.
-!--             Start with soil moisture.
-                IF ( init_3d%from_file_msoil  .AND.  init_3d%lod_msoil == 2 )  THEN
-                   ALLOCATE( pr_soil_init(0:init_3d%nzs-1) )
-                   DO  k = 0, init_3d%nzs-1
-                      pr_soil_init(k) = SUM( init_3d%msoil_3d(k,nys:nyn,nxl:nxr)  )
-                   ENDDO
-!
-!--                Allocate 1D array for soil-moisture profile (will not be allocated in lod==2
-!--                case).
-                   ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) )
-                   init_3d%msoil_1d = 0.0_wp
-                   CALL MPI_ALLREDUCE( pr_soil_init(0), init_3d%msoil_1d(0), SIZE(pr_soil_init),   &
-                                       MPI_REAL, MPI_SUM, comm2d, ierr )
-
-                   init_3d%msoil_1d = init_3d%msoil_1d / REAL( ( nx + 1 ) * ( ny + 1), KIND=wp )
-                   DEALLOCATE( pr_soil_init )
-                ENDIF
-!
-!--             Proceed with soil temperature.
-                IF ( init_3d%from_file_tsoil  .AND.  init_3d%lod_tsoil == 2 )  THEN
-                   ALLOCATE( pr_soil_init(0:init_3d%nzs-1) )
-
-                   DO  k = 0, init_3d%nzs-1
-                      pr_soil_init(k) = SUM( init_3d%tsoil_3d(k,nys:nyn,nxl:nxr)  )
-                   ENDDO
-!
-!--                Allocate 1D array for soil-temperature profile (will not be allocated in lod==2
-!--                case).
-                   ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) )
-                   init_3d%tsoil_1d = 0.0_wp
-                   CALL MPI_ALLREDUCE( pr_soil_init(0), init_3d%tsoil_1d(0), SIZE(pr_soil_init),   &
-                                       MPI_REAL, MPI_SUM, comm2d, ierr )
-                   init_3d%tsoil_1d = init_3d%tsoil_1d / REAL( ( nx + 1 ) * ( ny + 1), KIND=wp )
-                   DEALLOCATE( pr_soil_init )
-
-                ENDIF
-             ENDIF
-!
-!--          Broadcast number of soil layers in root model to all childs.
-!--          Note, only process 0 in COMM_WORLD is sending.
-             IF ( pmc_is_rootmodel() )  nzs_root = init_3d%nzs
-
-             CALL MPI_BCAST( nzs_root, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr )
-!
-!--          Allocate dummy arrays for soil moisture and temperature profiles on all domains.
-             ALLOCATE( z_soil_root(1:nzs_root)   )
-             IF ( init_msoil_from_driver_root )  ALLOCATE( m_soil_root(0:nzs_root-1) )
-             IF ( init_tsoil_from_driver_root )  ALLOCATE( t_soil_root(0:nzs_root-1) )
-!
-!--          Distribute the mean soil profiles to all child domains.
-             IF ( pmc_is_rootmodel() )  THEN
-                z_soil_root = init_3d%z_soil
-                IF ( init_msoil_from_driver_root )  m_soil_root = init_3d%msoil_1d
-                IF ( init_tsoil_from_driver_root )  t_soil_root = init_3d%tsoil_1d
-             ENDIF
-
-             CALL MPI_BCAST( z_soil_root, SIZE( z_soil_root ), MPI_REAL, 0, MPI_COMM_WORLD, ierr )
-
-             IF ( init_msoil_from_driver_root )                                                    &
-                CALL MPI_BCAST( m_soil_root, SIZE( m_soil_root ), MPI_REAL, 0, MPI_COMM_WORLD,     &
-                                ierr )
-
-             IF ( init_msoil_from_driver_root )                                                    &
-                CALL MPI_BCAST( t_soil_root, SIZE( t_soil_root ), MPI_REAL, 0, MPI_COMM_WORLD,     &
-                                ierr )
-!
-!--          In the following, the child domains decide whether they take the information from the
-!--          root domain or not.
-             IF ( .NOT. pmc_is_rootmodel() )  THEN
-!
-!--             If soil moisture or temperature isn't in dynamic input file for the child, take the
-!--             information provided from the root model.
-!--             Start with z-dimension
-                IF ( .NOT. init_3d%from_file_msoil  .OR.  .NOT. init_3d%from_file_msoil )  THEN
-                   init_3d%nzs = nzs_root
-                   ALLOCATE( init_3d%z_soil(1:init_3d%nzs) )
-                   init_3d%z_soil(1:init_3d%nzs) = z_soil_root
-                ENDIF
-!
-!--             Take soil moisture. Note, control flags from_file... and LoD need to be set.
-                IF ( .NOT. init_3d%from_file_msoil )  THEN
-                   ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) )
-                   init_3d%lod_msoil = 1
-                   init_3d%from_file_msoil = .TRUE.
-
-                   init_3d%msoil_1d = m_soil_root
-                ENDIF
-!
-!--             Take soil temperature. Note, control flags from_file... and LoD need to be set.
-                IF ( .NOT. init_3d%from_file_tsoil )  THEN
-                   ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) )
-                   init_3d%lod_tsoil = 1
-                   init_3d%from_file_tsoil = .TRUE.
-
-                   init_3d%tsoil_1d = t_soil_root
-                ENDIF
-             ENDIF
-
-             DEALLOCATE( z_soil_root )
-             DEALLOCATE( m_soil_root )
-             DEALLOCATE( t_soil_root )
-          ENDIF
-#endif
-       ENDIF
-!
-!--    Proceed with Level 2 initialization.
-       IF ( init_3d%from_file_msoil )  THEN
-
-          IF ( init_3d%lod_msoil == 1 )  THEN
-             DO  l = 0, 1
-                DO  m = 1, surf_lsm_h(l)%ns
-                   IF ( surf_lsm_h(l)%vegetation_surface(m)  .OR.                                  &
-                        surf_lsm_h(l)%pavement_surface(m) )  THEN
-
-                      CALL interpolate_soil_profile( m_soil_h(l)%var_2d(nzb_soil:nzt_soil,m),      &
-                                                     init_3d%msoil_1d(:),                          &
-                                                     zs(nzb_soil:nzt_soil), init_3d%z_soil,        &
-                                                     nzb_soil, nzt_soil,                           &
-                                                     nzb_soil, init_3d%nzs-1 )
-                   ENDIF
-                ENDDO
-             ENDDO
-             DO  l = 0, 3
-                DO  m = 1, surf_lsm_v(l)%ns
-                   IF ( surf_lsm_v(l)%vegetation_surface(m)  .OR.                                  &
-                        surf_lsm_v(l)%pavement_surface(m) )  THEN
-                      CALL interpolate_soil_profile( m_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),      &
-                                                     init_3d%msoil_1d(:),                          &
-                                                     zs(nzb_soil:nzt_soil), init_3d%z_soil,        &
-                                                     nzb_soil, nzt_soil,                           &
-                                                     nzb_soil, init_3d%nzs-1 )
-                   ENDIF
-                ENDDO
-             ENDDO
-          ELSE
-             DO  l = 0, 1
-                DO  m = 1, surf_lsm_h(l)%ns
-                   IF ( surf_lsm_h(l)%vegetation_surface(m)  .OR.                                  &
-                        surf_lsm_h(l)%pavement_surface(m) )  THEN
-                      i = surf_lsm_h(l)%i(m)
-                      j = surf_lsm_h(l)%j(m)
-
-                      IF ( init_3d%msoil_3d(0,j,i) /= init_3d%fill_msoil )                         &
-                         CALL interpolate_soil_profile( m_soil_h(l)%var_2d(nzb_soil:nzt_soil,m),   &
-                                                        init_3d%msoil_3d(:,j,i),                   &
-                                                        zs(nzb_soil:nzt_soil), init_3d%z_soil,     &
-                                                        nzb_soil, nzt_soil,                        &
-                                                        nzb_soil, init_3d%nzs-1 )
-                   ENDIF
-                ENDDO
-             ENDDO
-             DO  l = 0, 3
-                DO  m = 1, surf_lsm_v(l)%ns
-                   IF ( surf_lsm_v(l)%vegetation_surface(m)  .OR.                                  &
-                        surf_lsm_v(l)%pavement_surface(m) )  THEN
-!
-!--                   Note, in contrast to the static input data the dynamic input do not need to be
-!--                   checked whether a grid point is building covered. This is because soil data in
-!--                   the dynamic input is provided for the whole domain.
-                      i = surf_lsm_v(l)%i(m)
-                      j = surf_lsm_v(l)%j(m)
-
-                      IF ( init_3d%msoil_3d(0,j,i) /= init_3d%fill_msoil )                         &
-                         CALL interpolate_soil_profile( m_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),   &
-                                                        init_3d%msoil_3d(:,j,i),                   &
-                                                        zs(nzb_soil:nzt_soil), init_3d%z_soil,     &
-                                                        nzb_soil, nzt_soil,                        &
-                                                        nzb_soil, init_3d%nzs-1 )
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Soil temperature
-       IF ( init_3d%from_file_tsoil )  THEN
-
-          IF ( init_3d%lod_tsoil == 1 )  THEN ! change to 1 if provided correctly by INIFOR
-             DO  l = 0, 1
-                DO  m = 1, surf_lsm_h(l)%ns
-                   IF ( surf_lsm_h(l)%vegetation_surface(m)  .OR.                                  &
-                        surf_lsm_h(l)%pavement_surface(m) )  THEN
-                      CALL interpolate_soil_profile( t_soil_h(l)%var_2d(nzb_soil:nzt_soil,m),      &
-                                                     init_3d%tsoil_1d(:),                          &
-                                                     zs(nzb_soil:nzt_soil), init_3d%z_soil,        &
-                                                     nzb_soil, nzt_soil,                           &
-                                                     nzb_soil, init_3d%nzs-1 )
-!
-!--                   Set boundary condition, i.e. deep soil temperature
-                      t_soil_h(l)%var_2d(nzt_soil+1,m) = t_soil_h(l)%var_2d(nzt_soil,m)
-                   ENDIF
-                ENDDO
-             ENDDO
-             DO  l = 0, 3
-                DO  m = 1, surf_lsm_v(l)%ns
-                   IF ( surf_lsm_v(l)%vegetation_surface(m)  .OR.                                  &
-                        surf_lsm_v(l)%pavement_surface(m) )  THEN
-                     CALL interpolate_soil_profile( t_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),       &
-                                                    init_3d%tsoil_1d(:),                           &
-                                                    zs(nzb_soil:nzt_soil), init_3d%z_soil,         &
-                                                    nzb_soil, nzt_soil,                            &
-                                                    nzb_soil, init_3d%nzs-1 )
-!
-!--                   Set boundary condition, i.e. deep soil temperature
-                      t_soil_v(l)%var_2d(nzt_soil+1,m) = t_soil_v(l)%var_2d(nzt_soil,m)
-                   ENDIF
-                ENDDO
-             ENDDO
-          ELSE
-             DO  l = 0, 1
-                DO  m = 1, surf_lsm_h(l)%ns
-                   IF ( surf_lsm_h(l)%vegetation_surface(m)  .OR.                                  &
-                        surf_lsm_h(l)%pavement_surface(m) )  THEN
-                      i = surf_lsm_h(l)%i(m)
-                      j = surf_lsm_h(l)%j(m)
-
-                      IF ( init_3d%tsoil_3d(0,j,i) /= init_3d%fill_tsoil )                         &
-                         CALL interpolate_soil_profile( t_soil_h(l)%var_2d(nzb_soil:nzt_soil,m),   &
-                                                        init_3d%tsoil_3d(:,j,i),                   &
-                                                        zs(nzb_soil:nzt_soil), init_3d%z_soil,     &
-                                                        nzb_soil, nzt_soil,                        &
-                                                        nzb_soil, init_3d%nzs-1 )
-!
-!--                   Set boundary condition, i.e. deep soil temperature
-                      t_soil_h(l)%var_2d(nzt_soil+1,m) = t_soil_h(l)%var_2d(nzt_soil,m)
-                   ENDIF
-                ENDDO
-             ENDDO
-             DO  l = 0, 3
-                DO  m = 1, surf_lsm_v(l)%ns
-                   IF ( surf_lsm_v(l)%vegetation_surface(m)  .OR.                                  &
-                        surf_lsm_v(l)%pavement_surface(m) )  THEN
-!
-!--                   Note, in contrast to the static input data the dynamic input do not need to be
-!--                   checked whether a grid point is building covered. This is because soil data in
-!--                   the dynamic input is provided for the whole domain.
-                      i = surf_lsm_v(l)%i(m)
-                      j = surf_lsm_v(l)%j(m)
-
-                      IF ( init_3d%tsoil_3d(0,j,i) /= init_3d%fill_tsoil )                         &
-                         CALL interpolate_soil_profile( t_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),   &
-                                                        init_3d%tsoil_3d(:,j,i),                   &
-                                                        zs(nzb_soil:nzt_soil), init_3d%z_soil,     &
-                                                        nzb_soil, nzt_soil,                        &
-                                                        nzb_soil, init_3d%nzs-1 )
-!
-!--                   Set boundary condition, i.e. deep soil temperature
-                      t_soil_v(l)%var_2d(nzt_soil+1,m) = t_soil_v(l)%var_2d(nzt_soil,m)
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    After soil moisture and temperature are finally initialized, check if soil moisture is higher
-!--    than its saturation value. If this would be the case, the soil model parametrization will
-!--    produce floating point errors. Hence, limit the soil moisture to its saturation value and
-!--    give a warning.
-       DO l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             IF ( surf_lsm_h(l)%vegetation_surface(m)  .OR.  surf_lsm_h(l)%pavement_surface(m) )   &
-             THEN
-                DO  k = nzb_soil, nzt_soil
-                   IF ( m_soil_h(l)%var_2d(k,m) > surf_lsm_h(l)%m_sat(k,m) )  THEN
-                      m_soil_h(l)%var_2d(k,m) = surf_lsm_h(l)%m_sat(k,m)
-                      WRITE( message_string, * ) 'soil moisture is higher '//                      &
-                         'than its saturation value at (k,j,i) ', k,                               &
-                         surf_lsm_h(l)%i(m), surf_lsm_h(l)%j(m), ' and is ' //                     &
-                         'thus limited to this value to maintain stability.'
-                      CALL message( 'lsm_init', 'PA0458', 0, 1, myid, 6, 0 )
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDDO
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             IF ( surf_lsm_v(l)%vegetation_surface(m)  .OR.  surf_lsm_v(l)%pavement_surface(m) )   &
-             THEN
-                DO  k = nzb_soil, nzt_soil
-                   IF ( m_soil_v(l)%var_2d(k,m) > surf_lsm_v(l)%m_sat(k,m) )  THEN
-                      m_soil_v(l)%var_2d(k,m) = surf_lsm_v(l)%m_sat(k,m)
-                      WRITE( message_string, * ) 'soil moisture is higher '//                      &
-                         'than its saturation value at (k,j,i) ', k,                               &
-                         surf_lsm_v(l)%i(m), surf_lsm_v(l)%j(m), ' and is ' //                     &
-                         'thus limited to this value to maintain stability.'
-                      CALL message( 'lsm_init', 'PA0458', 0, 1, myid, 6, 0 )
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDDO
-
-!
-!--    Further initialization
-       DO l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-             k = surf_lsm_h(l)%k(m)
-!
-!--          Initialize surface temperature with soil temperature in the uppermost layer.
-             t_surface_h(l)%var_1d(m)    = t_soil_h(l)%var_2d(nzb_soil,m)
-             surf_lsm_h(l)%pt_surface(m) = t_soil_h(l)%var_2d(nzb_soil,m) / exner(nzb)
-
-             IF ( bulk_cloud_model  .OR. cloud_droplets )  THEN
-                surf_lsm_h(l)%pt1(m) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
-             ELSE
-                surf_lsm_h(l)%pt1(m) = pt(k,j,i)
-             ENDIF
-!
-!--          Assure that r_a cannot be zero at model start
-             IF ( surf_lsm_h(l)%pt1(m) == surf_lsm_h(l)%pt_surface(m) )                            &
-                surf_lsm_h(l)%pt1(m) = surf_lsm_h(l)%pt1(m) + 1.0E-20_wp
-
-             surf_lsm_h(l)%us(m)   = 0.1_wp
-             surf_lsm_h(l)%ts(m)   = ( surf_lsm_h(l)%pt1(m) - surf_lsm_h(l)%pt_surface(m) )        &
-                                     / surf_lsm_h(l)%r_a(m)
-             surf_lsm_h(l)%shf(m)  = - surf_lsm_h(l)%us(m) * surf_lsm_h(l)%ts(m) * rho_surface
-          ENDDO
-       ENDDO
-!
-!--    Vertical surfaces
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m)
-             j = surf_lsm_v(l)%j(m)
-             k = surf_lsm_v(l)%k(m)
-!
-!--          Initialize surface temperature with soil temperature in the uppermost layer.
-             t_surface_v(l)%var_1d(m)    = t_soil_v(l)%var_2d(nzb_soil,m)
-             surf_lsm_v(l)%pt_surface(m) = t_soil_v(l)%var_2d(nzb_soil,m) / exner(nzb)
-
-             IF ( bulk_cloud_model .OR. cloud_droplets )  THEN
-                surf_lsm_v(l)%pt1(m) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
-             ELSE
-                surf_lsm_v(l)%pt1(m) = pt(k,j,i)
-             ENDIF
-
-!
-!--          Assure that r_a cannot be zero at model start.
-             IF ( surf_lsm_v(l)%pt1(m) == surf_lsm_v(l)%pt_surface(m) )                            &
-                  surf_lsm_v(l)%pt1(m) = surf_lsm_v(l)%pt1(m) + 1.0E-20_wp
-!
-!--          Set artifical values for ts and us so that r_a has its initial value for the first time
-!--          step. Only for interior core domain, not for ghost points.
-             surf_lsm_v(l)%us(m)  = 0.1_wp
-             surf_lsm_v(l)%ts(m)  = ( surf_lsm_v(l)%pt1(m) - surf_lsm_v(l)%pt_surface(m) ) /       &
-                                    surf_lsm_v(l)%r_a(m)
-             surf_lsm_v(l)%shf(m) = - surf_lsm_v(l)%us(m) * surf_lsm_v(l)%ts(m) * rho_surface
-
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Level 1 initialization of root distribution - provided by the user via via namelist.
-    DO l = 0, 1
-       DO  m = 1, surf_lsm_h(l)%ns
-          DO  k = nzb_soil, nzt_soil
-             surf_lsm_h(l)%root_fr(k,m) = root_fraction(k)
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DO  l = 0, 3
-       DO  m = 1, surf_lsm_v(l)%ns
-          DO  k = nzb_soil, nzt_soil
-             surf_lsm_v(l)%root_fr(k,m) = root_fraction(k)
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Level 2 initialization of root distribution.
-!-- When no root distribution is given by the user, use look-up table to prescribe the root fraction
-!-- in the individual soil layers.
-    IF ( ALL( root_fraction == 9999999.9_wp ) )  THEN
-!
-!--    First, calculate the index bounds for integration
-       n_soil_layers_total = nzt_soil - nzb_soil + 6
-       ALLOCATE ( bound(0:n_soil_layers_total) )
-       ALLOCATE ( bound_root_fr(0:n_soil_layers_total) )
-
-       kn = 0
-       ko = 0
-       bound(0) = 0.0_wp
-       DO k = 1, n_soil_layers_total-1
-          IF ( zs_layer(kn) <= zs_ref(ko) )  THEN
-             bound(k) = zs_layer(kn)
-             bound_root_fr(k) = ko
-             kn = kn + 1
-             IF ( kn > nzt_soil+1 )  THEN
-                kn = nzt_soil
-             ENDIF
-          ELSE
-             bound(k) = zs_ref(ko)
-             bound_root_fr(k) = ko
-             ko = ko + 1
-             IF ( ko > 3 )  THEN
-                ko = 3
-             ENDIF
-          ENDIF
-
-       ENDDO
-
-!
-!--    Integrate over all soil layers based on the four-layer root fraction.
-       kzs = 1
-       root_fraction = 0.0_wp
-       DO k = 0, n_soil_layers_total-2
-          kroot = bound_root_fr(k+1)
-          root_fraction(kzs-1) = root_fraction(kzs-1)                                              &
-                                 + root_distribution(kroot,vegetation_type)                        &
-                                 / dz_soil_ref(kroot) * ( bound(k+1) - bound(k) )
-
-          IF ( bound(k+1) == zs_layer(kzs-1) )  THEN
-             kzs = kzs+1
-          ENDIF
-       ENDDO
-
-
-!
-!--    Normalize so that the sum of all fractions equals one
-       root_fraction = root_fraction / SUM(root_fraction)
-
-       DEALLOCATE( bound )
-       DEALLOCATE( bound_root_fr )
-
-!
-!--    Map calculated root fractions
-       DO  l = 0, 1
-             DO  m = 1, surf_lsm_h(l)%ns
-                DO  k = nzb_soil, nzt_soil
-                   IF ( surf_lsm_h(l)%pavement_surface(m)  .AND.                                   &
-                        k <= surf_lsm_h(l)%nzt_pavement(m) )  THEN
-                      surf_lsm_h(l)%root_fr(k,m) = 0.0_wp
-                   ELSE
-                      surf_lsm_h(l)%root_fr(k,m) = root_fraction(k)
-                   ENDIF
-
-                ENDDO
-!
-!--          Normalize so that the sum = 1. Only relevant when the root distribution was set to zero
-!--          due to pavement at some layers.
-             IF ( SUM( surf_lsm_h(l)%root_fr(:,m) ) > 0.0_wp )  THEN
-                DO k = nzb_soil, nzt_soil
-                   surf_lsm_h(l)%root_fr(k,m) = surf_lsm_h(l)%root_fr(k,m)                         &
-                                                / SUM( surf_lsm_h(l)%root_fr(:,m) )
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDDO
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             DO  k = nzb_soil, nzt_soil
-                IF ( surf_lsm_v(l)%pavement_surface(m)  .AND.                                      &
-                     k <= surf_lsm_v(l)%nzt_pavement(m) )  THEN
-                   surf_lsm_v(l)%root_fr(k,m) = 0.0_wp
-                ELSE
-                   surf_lsm_v(l)%root_fr(k,m) = root_fraction(k)
-                ENDIF
-             ENDDO
-!
-!--          Normalize so that the sum = 1. Only relevant when the root distribution was set to zero
-!--          due to pavement at some layers.
-             IF ( SUM( surf_lsm_v(l)%root_fr(:,m) ) > 0.0_wp )  THEN
-                DO  k = nzb_soil, nzt_soil
-                   surf_lsm_v(l)%root_fr(k,m) = surf_lsm_v(l)%root_fr(k,m)                         &
-                                                / SUM( surf_lsm_v(l)%root_fr(:,m) )
-                ENDDO
-             ENDIF
-          ENDDO
-        ENDDO
-    ENDIF
-!
-!-- Level 3 initialization of root distribution.
-!-- Take value from file.
-    IF ( root_area_density_lsm_f%from_file )  THEN
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             IF ( surf_lsm_h(l)%vegetation_surface(m) )  THEN
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-                DO  k = nzb_soil, nzt_soil
-                   surf_lsm_h(l)%root_fr(k,m) = root_area_density_lsm_f%var(k,j,i)
-                ENDDO
-
-             ENDIF
-          ENDDO
-       ENDDO
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             IF ( surf_lsm_v(l)%vegetation_surface(m) )  THEN
-                i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-                j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff,                             &
-                                                surf_lsm_v(l)%building_covered(m) )
-
-                DO  k = nzb_soil, nzt_soil
-                   surf_lsm_v(l)%root_fr(k,m) = root_area_density_lsm_f%var(k,j,i)
-                ENDDO
-
-             ENDIF
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-!
-!-- Possibly do user-defined actions (e.g. define heterogeneous land surface)
-    CALL user_init_land_surface
-
-
-!
-!-- Calculate new roughness lengths (for water surfaces only, i.e. only horizontal surfaces)
-    IF ( .NOT. constant_roughness )  CALL calc_z0_water_surface
-
-    t_soil_h_p    = t_soil_h
-    m_soil_h_p    = m_soil_h
-    m_liq_h_p     = m_liq_h
-    t_surface_h_p = t_surface_h
-
-    t_soil_v_p    = t_soil_v
-    m_soil_v_p    = m_soil_v
-    m_liq_v_p     = m_liq_v
-    t_surface_v_p = t_surface_v
-
-
-
-!-- Store initial profiles of t_soil and m_soil (assuming they are
-!-- horizontally homogeneous on this PE)
-!-- DEACTIVATED FOR NOW - leads to error when number of locations with
-!-- soil model is zero on a PE.
-!        hom(nzb_soil:nzt_soil,1,90,:)  = SPREAD( t_soil_h%var_2d(nzb_soil:nzt_soil,1),  &
-!                                                 2, statistic_regions+1 )
-!        hom(nzb_soil:nzt_soil,1,92,:)  = SPREAD( m_soil_h%var_2d(nzb_soil:nzt_soil,1),  &
-!                                                 2, statistic_regions+1 )
-
-!
-!-- Finally, make some consistency checks.
-!-- Check for illegal combination of LAI and vegetation coverage.
-    DO  l = 0, 1
-       IF ( ANY( .NOT. surf_lsm_h(l)%pavement_surface  .AND.                                       &
-                       surf_lsm_h(l)%lai == 0.0_wp     .AND.  surf_lsm_h(l)%c_veg == 1.0_wp )      &
-          )  THEN
-          message_string = 'For non-pavement surfaces the combination ' //                         &
-                           ' lai = 0.0 and c_veg = 1.0 is not allowed.'
-          CALL message( 'lsm_init', 'PA0671', 2, 2, myid, 6, 0 )
-       ENDIF
-    ENDDO
-    DO  l = 0, 3
-       IF ( ANY( .NOT. surf_lsm_v(l)%pavement_surface  .AND.                                       &
-                       surf_lsm_v(l)%lai == 0.0_wp     .AND.  surf_lsm_v(l)%c_veg == 1.0_wp )      &
-          )  THEN
-          message_string = 'For non-pavement surfaces the combination ' //                         &
-                           ' lai = 0.0 and c_veg = 1.0 is not allowed.'
-          CALL message( 'lsm_init', 'PA0671', 2, 2, myid, 6, 0 )
-       ENDIF
-    ENDDO
-!
-!-- Check if roughness length for momentum, heat, or moisture exceed surface-layer height and
-!-- decrease local roughness length where necessary. This case, give an informative message.
-!-- Note, to avoid that the job-protocoll is messed-up, this message is only given once.
-!-- ???what about the vertical surfaces???
-    flag_exceed_z0  = .FALSE.
-    flag_exceed_z0h = .FALSE.
-    DO l = 0, 1
-       DO  m = 1, surf_lsm_h(l)%ns
-          IF ( surf_lsm_h(l)%z0(m) > 0.5_wp * surf_lsm_h(l)%z_mo(m) )  THEN
-             surf_lsm_h(l)%z0(m) = 0.5_wp * surf_lsm_h(l)%z_mo(m)
-             flag_exceed_z0   = .TRUE.
-          ENDIF
-          IF ( surf_lsm_h(l)%z0h(m) > 0.5_wp * surf_lsm_h(l)%z_mo(m) )  THEN
-             surf_lsm_h(l)%z0h(m) = 0.5_wp * surf_lsm_h(l)%z_mo(m)
-             surf_lsm_h(l)%z0q(m) = 0.5_wp * surf_lsm_h(l)%z_mo(m)
-             flag_exceed_z0h   = .TRUE.
-          ENDIF
-       ENDDO
-    ENDDO
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0, 1, MPI_LOGICAL, MPI_LOR, comm2d, ierr)
-#endif
-    IF ( flag_exceed_z0 )  THEN
-       WRITE( message_string, * ) 'z0 exceeds surface-layer height ' //                            &
-                                  'at horizontal natural surface(s) and '//                        &
-                                  'is decreased appropriately'
-       CALL message( 'land_surface_model_mod', 'PA0503', 0, 0, 0, 6, 0 )
-    ENDIF
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0h, 1, MPI_LOGICAL, MPI_LOR, comm2d, ierr)
-#endif
-    IF ( flag_exceed_z0h )  THEN
-       WRITE( message_string, * ) 'z0h exceeds surface-layer height ' //                           &
-                                  'at horizontal natural surface(s) and '//                        &
-                                  'is decreased appropriately.'
-       CALL message( 'land_surface_model_mod', 'PA0507', 0, 0, 0, 6, 0 )
-    ENDIF
-
-    flag_exceed_z0  = .FALSE.
-    flag_exceed_z0h = .FALSE.
-    DO  l = 0, 3
-       DO  m = 1, surf_lsm_v(l)%ns
-          IF ( surf_lsm_v(l)%z0(m) > 0.5_wp * surf_lsm_v(l)%z_mo(m) )  THEN
-             surf_lsm_v(l)%z0(m) = 0.5_wp * surf_lsm_v(l)%z_mo(m)
-             flag_exceed_z0      = .TRUE.
-          ENDIF
-          IF ( surf_lsm_v(l)%z0h(m) > 0.5_wp * surf_lsm_v(l)%z_mo(m) )  THEN
-             surf_lsm_v(l)%z0h(m) = 0.5_wp * surf_lsm_v(l)%z_mo(m)
-             surf_lsm_v(l)%z0q(m) = 0.5_wp * surf_lsm_v(l)%z_mo(m)
-             flag_exceed_z0h      = .TRUE.
-          ENDIF
-       ENDDO
-    ENDDO
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0, 1, MPI_LOGICAL, MPI_LOR, comm2d, ierr)
-#endif
-    IF ( flag_exceed_z0 )  THEN
-       WRITE( message_string, * ) 'z0 exceeds surface-layer height ' //                            &
-                                  'at vertical natural surface(s) and '//                          &
-                                  'is decreased appropriately'
-       CALL message( 'land_surface_model_mod', 'PA0503', 0, 0, 0, 6, 0 )
-    ENDIF
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0h, 1, MPI_LOGICAL, MPI_LOR, comm2d, ierr)
-#endif
-    IF ( flag_exceed_z0h )  THEN
-       WRITE( message_string, * ) 'z0h exceeds surface-layer height ' //                           &
-                                  'at vertical natural surface(s) and '//                          &
-                                  'is decreased appropriately.'
-       CALL message( 'land_surface_model_mod', 'PA0507', 0, 0, 0, 6, 0 )
-    ENDIF
-
-    IF ( debug_output )  CALL debug_message( 'lsm_init', 'end' )
-
- END SUBROUTINE lsm_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate land surface model arrays and define pointers
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_init_arrays
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  l !< index indicating facing of surface array
-
-
-    ALLOCATE( root_extr(nzb_soil:nzt_soil) )
-    root_extr = 0.0_wp
-
-!
-!-- Allocate surface and soil temperature / humidity. Please note, these arrays are allocated
-!-- according to surface-data structure, even if they do not belong to the data type due to the
-!-- pointer arithmetric (TARGET attribute is not allowed in a data-type).
-!
-!-- Horizontal surfaces
-    DO l = 0, 1
-       ALLOCATE( m_liq_h_1(l)%var_1d(1:surf_lsm_h(l)%ns)                      )
-       ALLOCATE( m_liq_h_2(l)%var_1d(1:surf_lsm_h(l)%ns)                      )
-       ALLOCATE( t_surface_h_1(l)%var_1d(1:surf_lsm_h(l)%ns)                  )
-       ALLOCATE( t_surface_h_2(l)%var_1d(1:surf_lsm_h(l)%ns)                  )
-       ALLOCATE( m_soil_h_1(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)   )
-       ALLOCATE( m_soil_h_2(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)   )
-       ALLOCATE( t_soil_h_1(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h(l)%ns) )
-       ALLOCATE( t_soil_h_2(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h(l)%ns) )
-    ENDDO
-!
-!-- Vertical surfaces
-    DO  l = 0, 3
-       ALLOCATE( m_liq_v_1(l)%var_1d(1:surf_lsm_v(l)%ns)                      )
-       ALLOCATE( m_liq_v_2(l)%var_1d(1:surf_lsm_v(l)%ns)                      )
-       ALLOCATE( t_surface_v_1(l)%var_1d(1:surf_lsm_v(l)%ns)                  )
-       ALLOCATE( t_surface_v_2(l)%var_1d(1:surf_lsm_v(l)%ns)                  )
-       ALLOCATE( m_soil_v_1(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)   )
-       ALLOCATE( m_soil_v_2(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)   )
-       ALLOCATE( t_soil_v_1(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(l)%ns) )
-       ALLOCATE( t_soil_v_2(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(l)%ns) )
-    ENDDO
-
-!
-!-- Allocate array for heat flux in W/m2, required for radiation?
-!-- Consider to remove this array
-    DO l = 0, 1
-       ALLOCATE( surf_lsm_h(l)%surfhf(1:surf_lsm_h(l)%ns) )
-    ENDDO
-    DO  l = 0, 3
-       ALLOCATE( surf_lsm_v(l)%surfhf(1:surf_lsm_v(l)%ns) )
-    ENDDO
-
-
-!
-!-- Allocate intermediate timestep arrays
-!-- Horizontal surfaces
-    DO l = 0, 1
-       ALLOCATE( tm_liq_h_m(l)%var_1d(1:surf_lsm_h(l)%ns)                     )
-       ALLOCATE( tt_surface_h_m(l)%var_1d(1:surf_lsm_h(l)%ns)                 )
-       ALLOCATE( tm_soil_h_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)  )
-       ALLOCATE( tt_soil_h_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h(l)%ns)  )
-    ENDDO
-!
-!-- Horizontal surfaces
-    DO  l = 0, 3
-       ALLOCATE( tm_liq_v_m(l)%var_1d(1:surf_lsm_v(l)%ns)                     )
-       ALLOCATE( tt_surface_v_m(l)%var_1d(1:surf_lsm_v(l)%ns)                 )
-       ALLOCATE( tm_soil_v_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)  )
-       ALLOCATE( tt_soil_v_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)  )
-    ENDDO
-
-!
-!-- Allocate 2D vegetation model arrays
-!-- Horizontal surfaces
-    DO l = 0, 1
-       ALLOCATE( surf_lsm_h(l)%building_surface(1:surf_lsm_h(l)%ns)    )
-       ALLOCATE( surf_lsm_h(l)%c_liq(1:surf_lsm_h(l)%ns)               )
-       ALLOCATE( surf_lsm_h(l)%c_surface(1:surf_lsm_h(l)%ns)           )
-       ALLOCATE( surf_lsm_h(l)%c_veg(1:surf_lsm_h(l)%ns)               )
-       ALLOCATE( surf_lsm_h(l)%f_sw_in(1:surf_lsm_h(l)%ns)             )
-       ALLOCATE( surf_lsm_h(l)%ghf(1:surf_lsm_h(l)%ns)                 )
-       ALLOCATE( surf_lsm_h(l)%g_d(1:surf_lsm_h(l)%ns)                 )
-       ALLOCATE( surf_lsm_h(l)%lai(1:surf_lsm_h(l)%ns)                 )
-       ALLOCATE( surf_lsm_h(l)%lambda_surface_u(1:surf_lsm_h(l)%ns)    )
-       ALLOCATE( surf_lsm_h(l)%lambda_surface_s(1:surf_lsm_h(l)%ns)    )
-       ALLOCATE( surf_lsm_h(l)%nzt_pavement(1:surf_lsm_h(l)%ns)        )
-       ALLOCATE( surf_lsm_h(l)%pavement_surface(1:surf_lsm_h(l)%ns)    )
-       ALLOCATE( surf_lsm_h(l)%qsws_soil(1:surf_lsm_h(l)%ns)           )
-       ALLOCATE( surf_lsm_h(l)%qsws_liq(1:surf_lsm_h(l)%ns)            )
-       ALLOCATE( surf_lsm_h(l)%qsws_veg(1:surf_lsm_h(l)%ns)            )
-       ALLOCATE( surf_lsm_h(l)%rad_net_l(1:surf_lsm_h(l)%ns)           )
-       ALLOCATE( surf_lsm_h(l)%r_a(1:surf_lsm_h(l)%ns)                 )
-       ALLOCATE( surf_lsm_h(l)%r_canopy(1:surf_lsm_h(l)%ns)            )
-       ALLOCATE( surf_lsm_h(l)%r_soil(1:surf_lsm_h(l)%ns)              )
-       ALLOCATE( surf_lsm_h(l)%r_soil_min(1:surf_lsm_h(l)%ns)          )
-       ALLOCATE( surf_lsm_h(l)%r_s(1:surf_lsm_h(l)%ns)                 )
-       ALLOCATE( surf_lsm_h(l)%r_canopy_min(1:surf_lsm_h(l)%ns)        )
-       ALLOCATE( surf_lsm_h(l)%vegetation_surface(1:surf_lsm_h(l)%ns)  )
-       ALLOCATE( surf_lsm_h(l)%water_surface(1:surf_lsm_h(l)%ns)       )
-
-       surf_lsm_h(l)%water_surface        = .FALSE.
-       surf_lsm_h(l)%pavement_surface     = .FALSE.
-       surf_lsm_h(l)%vegetation_surface   = .FALSE.
-
-!
-!--    Set default values
-       surf_lsm_h(l)%r_canopy_min = 0.0_wp
-    ENDDO
-!
-!-- Vertical surfaces
-    DO  l = 0, 3
-       ALLOCATE( surf_lsm_v(l)%building_surface(1:surf_lsm_v(l)%ns)    )
-       ALLOCATE( surf_lsm_v(l)%c_liq(1:surf_lsm_v(l)%ns)               )
-       ALLOCATE( surf_lsm_v(l)%c_surface(1:surf_lsm_v(l)%ns)           )
-       ALLOCATE( surf_lsm_v(l)%c_veg(1:surf_lsm_v(l)%ns)               )
-       ALLOCATE( surf_lsm_v(l)%f_sw_in(1:surf_lsm_v(l)%ns)             )
-       ALLOCATE( surf_lsm_v(l)%ghf(1:surf_lsm_v(l)%ns)                 )
-       ALLOCATE( surf_lsm_v(l)%g_d(1:surf_lsm_v(l)%ns)                 )
-       ALLOCATE( surf_lsm_v(l)%lai(1:surf_lsm_v(l)%ns)                 )
-       ALLOCATE( surf_lsm_v(l)%lambda_surface_u(1:surf_lsm_v(l)%ns)    )
-       ALLOCATE( surf_lsm_v(l)%lambda_surface_s(1:surf_lsm_v(l)%ns)    )
-       ALLOCATE( surf_lsm_v(l)%nzt_pavement(1:surf_lsm_v(l)%ns)        )
-       ALLOCATE( surf_lsm_v(l)%pavement_surface(1:surf_lsm_v(l)%ns)    )
-       ALLOCATE( surf_lsm_v(l)%qsws_soil(1:surf_lsm_v(l)%ns)           )
-       ALLOCATE( surf_lsm_v(l)%qsws_liq(1:surf_lsm_v(l)%ns)            )
-       ALLOCATE( surf_lsm_v(l)%qsws_veg(1:surf_lsm_v(l)%ns)            )
-       ALLOCATE( surf_lsm_v(l)%rad_net_l(1:surf_lsm_v(l)%ns)           )
-       ALLOCATE( surf_lsm_v(l)%r_a(1:surf_lsm_v(l)%ns)                 )
-       ALLOCATE( surf_lsm_v(l)%r_canopy(1:surf_lsm_v(l)%ns)            )
-       ALLOCATE( surf_lsm_v(l)%r_soil(1:surf_lsm_v(l)%ns)              )
-       ALLOCATE( surf_lsm_v(l)%r_soil_min(1:surf_lsm_v(l)%ns)          )
-       ALLOCATE( surf_lsm_v(l)%r_s(1:surf_lsm_v(l)%ns)                 )
-       ALLOCATE( surf_lsm_v(l)%r_canopy_min(1:surf_lsm_v(l)%ns)        )
-       ALLOCATE( surf_lsm_v(l)%vegetation_surface(1:surf_lsm_v(l)%ns)  )
-       ALLOCATE( surf_lsm_v(l)%water_surface(1:surf_lsm_v(l)%ns)       )
-
-       surf_lsm_v(l)%water_surface      = .FALSE.
-       surf_lsm_v(l)%pavement_surface   = .FALSE.
-       surf_lsm_v(l)%vegetation_surface = .FALSE.
-
-
-!
-!--    Set default values
-       surf_lsm_v(l)%r_canopy_min = 0.0_wp
-
-    ENDDO
-
-!
-!-- Initial assignment of the pointers
-!-- Horizontal surfaces
-    t_soil_h    => t_soil_h_1;    t_soil_h_p    => t_soil_h_2
-    t_surface_h => t_surface_h_1; t_surface_h_p => t_surface_h_2
-    m_soil_h    => m_soil_h_1;    m_soil_h_p    => m_soil_h_2
-    m_liq_h     => m_liq_h_1;     m_liq_h_p     => m_liq_h_2
-!
-!-- Vertical surfaces
-    t_soil_v    => t_soil_v_1;    t_soil_v_p    => t_soil_v_2
-    t_surface_v => t_surface_v_1; t_surface_v_p => t_surface_v_2
-    m_soil_v    => m_soil_v_1;    m_soil_v_p    => m_soil_v_2
-    m_liq_v     => m_liq_v_1;     m_liq_v_p     => m_liq_v_2
-
-
- END SUBROUTINE lsm_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &lsmpar for land surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_parin
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter
-                                 !< file
-
-    INTEGER(iwp)  ::  io_status  !< status after reading the nameslist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /land_surface_parameters/  aero_resist_kray,                                          &
-                                        alpha_vangenuchten,                                        &
-                                        c_surface,                                                 &
-                                        canopy_resistance_coefficient,                             &
-                                        constant_roughness,                                        &
-                                        conserve_water_content,                                    &
-                                        deep_soil_temperature,                                     &
-                                        dz_soil,                                                   &
-                                        f_shortwave_incoming,                                      &
-                                        field_capacity,                                            &
-                                        hydraulic_conductivity,                                    &
-                                        lambda_surface_stable,                                     &
-                                        lambda_surface_unstable,                                   &
-                                        leaf_area_index,                                           &
-                                        l_vangenuchten,                                            &
-                                        min_canopy_resistance,                                     &
-                                        min_soil_resistance,                                       &
-                                        n_vangenuchten,                                            &
-                                        pavement_depth_level,                                      &
-                                        pavement_heat_capacity,                                    &
-                                        pavement_heat_conduct,                                     &
-                                        pavement_type,                                             &
-                                        residual_moisture,                                         &
-                                        root_fraction,                                             &
-                                        saturation_moisture,                                       &
-                                        skip_time_do_lsm,                                          &
-                                        soil_moisture,                                             &
-                                        soil_temperature,                                          &
-                                        soil_type,                                                 &
-                                        surface_type,                                              &
-                                        switch_off_module,                                         &
-                                        vegetation_coverage,                                       &
-                                        vegetation_type,                                           &
-                                        water_temperature,                                         &
-                                        water_type,                                                &
-                                        wilting_point,                                             &
-                                        z0_pavement,                                               &
-                                        z0_vegetation,                                             &
-                                        z0_water,                                                  &
-                                        z0h_pavement,                                              &
-                                        z0h_vegetation,                                            &
-                                        z0h_water,                                                 &
-                                        z0q_pavement,                                              &
-                                        z0q_vegetation,                                            &
-                                        z0q_water
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, land_surface_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    land_surface_parameters namelist was found and read correctly. Set flag that indicates that
-!--    the land surface model is switched on.
-       IF ( .NOT. switch_off_module )  land_surface = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    land_surface_parameters namelist was found but contained errors. Print an error message
-!--    including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'land_surface_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE lsm_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Soil model as part of the land surface model. The model predicts soil temperature and water
-!> content.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_soil_model( horizontal, l, calc_soil_moisture )
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k       !< running index
-    INTEGER(iwp) ::  l       !< surface-data type index indication facing
-    INTEGER(iwp) ::  m       !< running index
-
-    LOGICAL, INTENT(IN) ::  calc_soil_moisture !< flag indicating whether soil moisture shall be calculated or not.
-
-    LOGICAL      ::  horizontal !< flag indication horizontal wall, required to set pointer accordingly
-
-    REAL(wp)     ::  h_vg !< Van Genuchten coef. h
-
-    REAL(wp), DIMENSION(nzb_soil:nzt_soil) :: gamma_temp,                          & !< temp. gamma
-                                              lambda_temp,                         & !< temp. lambda
-                                              tend                                   !< tendency
-
-    TYPE(surf_type_lsm), POINTER ::  surf_m_soil
-    TYPE(surf_type_lsm), POINTER ::  surf_m_soil_p
-    TYPE(surf_type_lsm), POINTER ::  surf_t_soil
-    TYPE(surf_type_lsm), POINTER ::  surf_t_soil_p
-    TYPE(surf_type_lsm), POINTER ::  surf_tm_soil_m
-    TYPE(surf_type_lsm), POINTER ::  surf_tt_soil_m
-
-    TYPE(surf_type), POINTER  ::  surf  !< surface-date type variable
-
-
-    IF ( debug_output_timestep )  THEN
-       WRITE( debug_string, * ) 'lsm_soil_model', horizontal, l, calc_soil_moisture
-       CALL debug_message( debug_string, 'start' )
-    ENDIF
-
-    IF ( horizontal )  THEN
-       surf           => surf_lsm_h(l)
-
-       surf_m_soil    => m_soil_h(l)
-       surf_m_soil_p  => m_soil_h_p(l)
-       surf_t_soil    => t_soil_h(l)
-       surf_t_soil_p  => t_soil_h_p(l)
-       surf_tm_soil_m => tm_soil_h_m(l)
-       surf_tt_soil_m => tt_soil_h_m(l)
-    ELSE
-       surf           => surf_lsm_v(l)
-
-       surf_m_soil    => m_soil_v(l)
-       surf_m_soil_p  => m_soil_v_p(l)
-       surf_t_soil    => t_soil_v(l)
-       surf_t_soil_p  => t_soil_v_p(l)
-       surf_tm_soil_m => tm_soil_v_m(l)
-       surf_tt_soil_m => tt_soil_v_m(l)
-    ENDIF
-
-    !$OMP PARALLEL DO PRIVATE (m, k, lambda_temp, lambda_h_sat, ke, tend, gamma_temp, h_vg,    &
-    !$OMP&                     m_total, root_extr) SCHEDULE (STATIC)
-    DO  m = 1, surf%ns
-
-       IF (  .NOT.  surf%water_surface(m) )  THEN
-          DO  k = nzb_soil, nzt_soil
-
-             IF ( surf%pavement_surface(m)  .AND.  k <= surf%nzt_pavement(m) )  THEN
-
-                surf%rho_c_total(k,m) = surf%rho_c_total_def(k,m)
-                lambda_temp(k)        = surf%lambda_h_def(k,m)
-
-             ELSE
-!
-!--             Calculate volumetric heat capacity of the soil, taking into account water content.
-                surf%rho_c_total(k,m) = ( rho_c_soil * ( 1.0_wp - surf%m_sat(k,m) )                &
-                                          + rho_c_water * surf_m_soil%var_2d(k,m) )
-
-!
-!--             Calculate soil heat conductivity at the center of the soil layers
-                lambda_h_sat = lambda_h_sm**(1.0_wp - surf%m_sat(k,m)) *                           &
-                               lambda_h_water ** surf_m_soil%var_2d(k,m)
-
-                ke = 1.0_wp + LOG10( MAX( 0.1_wp, surf_m_soil%var_2d(k,m) / surf%m_sat(k,m) ) )
-
-                lambda_temp(k) = ke * (lambda_h_sat - lambda_h_dry) + lambda_h_dry
-             ENDIF
-          ENDDO
-
-!
-!--       Calculate soil heat conductivity (lambda_h) at the _layer level using linear
-!--       interpolation. For pavement surface, the true pavement depth is considered.
-          DO  k = nzb_soil, nzt_soil-1
-             surf%lambda_h(k,m) = ( lambda_temp(k+1) + lambda_temp(k) ) * 0.5_wp
-          ENDDO
-          surf%lambda_h(nzt_soil,m) = lambda_temp(nzt_soil)
-
-!
-!--       Prognostic equation for soil temperature t_soil
-          tend(:) = 0.0_wp
-
-          tend(nzb_soil) = ( 1.0_wp / surf%rho_c_total(nzb_soil,m) ) *                             &
-                           ( surf%lambda_h(nzb_soil,m) *                                           &
-                             ( surf_t_soil%var_2d(nzb_soil+1,m) - surf_t_soil%var_2d(nzb_soil,m) ) &
-                             * ddz_soil_center(nzb_soil)                                           &
-                           + surf%ghf(m) ) * ddz_soil(nzb_soil)
-
-          DO  k = nzb_soil+1, nzt_soil
-             tend(k) = ( 1.0_wp / surf%rho_c_total(k,m) )                                          &
-                       * (   surf%lambda_h(k,m)                                                    &
-                           * ( surf_t_soil%var_2d(k+1,m) - surf_t_soil%var_2d(k,m) )               &
-                           * ddz_soil_center(k)                                                    &
-                           - surf%lambda_h(k-1,m)                                                  &
-                           * ( surf_t_soil%var_2d(k,m) - surf_t_soil%var_2d(k-1,m) )               &
-                           * ddz_soil_center(k-1)                                                  &
-                         ) * ddz_soil(k)
-
-          ENDDO
-
-          surf_t_soil_p%var_2d(nzb_soil:nzt_soil,m) = surf_t_soil%var_2d(nzb_soil:nzt_soil,m)      &
-                                                      + dt_3d * ( tsc(2) * tend(nzb_soil:nzt_soil) &
-                                                      + tsc(3)                                     &
-                                                      * surf_tt_soil_m%var_2d(nzb_soil:nzt_soil,m) )
-
-!
-!--       Calculate t_soil tendencies for the next Runge-Kutta step
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( intermediate_timestep_count == 1 )  THEN
-                DO  k = nzb_soil, nzt_soil
-                   surf_tt_soil_m%var_2d(k,m) = tend(k)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                DO  k = nzb_soil, nzt_soil
-                   surf_tt_soil_m%var_2d(k,m) = -9.5625_wp * tend(k) +                             &
-                                                 5.3125_wp * surf_tt_soil_m%var_2d(k,m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-
-          IF ( calc_soil_moisture )  THEN
-
-             DO  k = nzb_soil, nzt_soil
-!
-!--             In order to prevent water tranport through paved surfaces, conductivity and
-!--             diffusivity are set to zero.
-                IF ( surf%pavement_surface(m)  .AND.  k <= surf%nzt_pavement(m) )  THEN
-                   lambda_temp(k) = 0.0_wp
-                   gamma_temp(k)  = 0.0_wp
-
-                ELSE
-
-!
-!--                Calculate soil diffusivity at the center of the soil layers
-                   lambda_temp(k) = ( - b_ch * surf%gamma_w_sat(k,m) * psi_sat / surf%m_sat(k,m) ) &
-                                    * ( MAX( surf_m_soil%var_2d(k,m), surf%m_wilt(k,m) )           &
-                                        / surf%m_sat(k,m) )**( b_ch + 2.0_wp )
-
-!
-!--                Parametrization of Van Genuchten
-!--                Calculate the hydraulic conductivity after Van Genuchten (1980)
-                   h_vg = ( ( ( surf%m_res(k,m) - surf%m_sat(k,m) ) /                              &
-                              ( surf%m_res(k,m) -                                                  &
-                                MAX( surf_m_soil%var_2d(k,m), surf%m_wilt(k,m) )                   &
-                              )                                                                    &
-                            )**(                                                                   &
-                          surf%n_vg(k,m) / ( surf%n_vg(k,m) - 1.0_wp )                             &
-                               ) - 1.0_wp                                                          &
-                          )**( 1.0_wp / surf%n_vg(k,m) ) / surf%alpha_vg(k,m)
-
-                   gamma_temp(k) = surf%gamma_w_sat(k,m) *                                         &
-                                   (                                                               &
-                                     (                                                             &
-                                       ( 1.0_wp + ( surf%alpha_vg(k,m) * h_vg )**surf%n_vg(k,m)    &
-                                       )**( 1.0_wp - 1.0_wp / surf%n_vg(k,m) )                     &
-                                     - ( surf%alpha_vg(k,m) * h_vg )**( surf%n_vg(k,m) - 1.0_wp)   &
-                                     )**2                                                          &
-                                   )                                                               &
-                                   / ( ( 1.0_wp + ( surf%alpha_vg(k,m) * h_vg )**surf%n_vg(k,m)    &
-                                       )**( ( 1.0_wp  - 1.0_wp / surf%n_vg(k,m) ) *                &
-                                            ( surf%l_vg(k,m) + 2.0_wp) )                           &
-                                     )
-
-                ENDIF
-
-             ENDDO
-!
-!--          Prognostic equation for soil moisture content. Only performed, when humidity is enabled
-!--          in the atmosphere.
-             IF ( humidity )  THEN
-!
-!--             Calculate soil diffusivity (lambda_w) at the _layer level using linear
-!--             interpolation. To do: replace this with ECMWF-IFS Eq. 8.81.
-                DO  k = nzb_soil, nzt_soil-1
-
-                   surf%lambda_w(k,m) = ( lambda_temp(k+1) + lambda_temp(k) ) * 0.5_wp
-                   surf%gamma_w(k,m)  = ( gamma_temp(k+1)  +  gamma_temp(k) ) * 0.5_wp
-
-                ENDDO
-!
-!
-!--             In case of a closed bottom (= water content is conserved), set hydraulic
-!--             conductivity to zero so that no water will be lost in the bottom layer. As gamma_w
-!--             is always a positive value, it cannot be set to zero in case of purely dry soil
-!--             since this would cause accumulation of (non-existing) water in the lowest soil
-!--             layer.
-                IF ( conserve_water_content  .AND.  surf_m_soil%var_2d(nzt_soil,m) /= 0.0_wp )  THEN
-
-                   surf%gamma_w(nzt_soil,m) = 0.0_wp
-                ELSE
-                   surf%gamma_w(nzt_soil,m) = gamma_temp(nzt_soil)
-                ENDIF
-
-!--             The root extraction (= root_extr * qsws_veg / (rho_l * l_v)) ensures the mass
-!--             conservation for water. The transpiration of plants equals the cumulative
-!--             withdrawals by the roots in the soil. The scheme takes into account the
-!--             availability of water in the soil layers as well as the root fraction in the
-!--             respective layer. Layer with moisture below wilting point will not contribute, which
-!--             reflects the preference of plants to take water from moister layers.
-!
-!--             Calculate the root extraction (ECMWF 7.69, the sum of root_extr = 1). The energy
-!--             balance solver guarantees a positive transpiration, so that there is no need for an
-!--             additional check.
-                m_total = 0.0_wp
-                DO  k = nzb_soil, nzt_soil
-                   IF ( surf_m_soil%var_2d(k,m) > surf%m_wilt(k,m) )  THEN
-                      m_total = m_total + surf%root_fr(k,m) * surf_m_soil%var_2d(k,m)
-                   ENDIF
-                ENDDO
-                IF ( m_total > 0.0_wp )  THEN
-                   DO  k = nzb_soil, nzt_soil
-                      IF ( surf_m_soil%var_2d(k,m) > surf%m_wilt(k,m) )  THEN
-                         root_extr(k) = surf%root_fr(k,m) * surf_m_soil%var_2d(k,m) / m_total
-                      ELSE
-                         root_extr(k) = 0.0_wp
-                      ENDIF
-                   ENDDO
-                ENDIF
-!
-!--             Prognostic equation for soil water content m_soil_h.
-                tend(:) = 0.0_wp
-
-                tend(nzb_soil) = ( surf%lambda_w(nzb_soil,m)                                       &
-                                   * (   surf_m_soil%var_2d(nzb_soil+1,m)                          &
-                                       - surf_m_soil%var_2d(nzb_soil,m)                            &
-                                     ) * ddz_soil_center(nzb_soil)                                 &
-                                   - surf%gamma_w(nzb_soil,m)                                      &
-                                   - ( root_extr(nzb_soil) * surf%qsws_veg(m) + surf%qsws_soil(m) )&
-                                   * drho_l_lv                                                     &
-                                 ) * ddz_soil(nzb_soil)
-
-                DO  k = nzb_soil+1, nzt_soil-1
-                   tend(k) = ( surf%lambda_w(k,m) * ( surf_m_soil%var_2d(k+1,m)                    &
-                             - surf_m_soil%var_2d(k,m) ) * ddz_soil_center(k)                      &
-                             - surf%gamma_w(k,m)                                                   &
-                             - surf%lambda_w(k-1,m) * ( surf_m_soil%var_2d(k,m)                    &
-                             - surf_m_soil%var_2d(k-1,m)) * ddz_soil_center(k-1)                   &
-                             + surf%gamma_w(k-1,m) - (root_extr(k)                                 &
-                             * surf%qsws_veg(m) * drho_l_lv)                                       &
-                             ) * ddz_soil(k)
-                ENDDO
-                tend(nzt_soil) = ( - surf%gamma_w(nzt_soil,m)                                      &
-                                   - surf%lambda_w(nzt_soil-1,m)                                   &
-                                   * ( surf_m_soil%var_2d(nzt_soil,m)                              &
-                                   - surf_m_soil%var_2d(nzt_soil-1,m))                             &
-                                   * ddz_soil_center(nzt_soil-1)                                   &
-                                   + surf%gamma_w(nzt_soil-1,m) - (                                &
-                                   root_extr(nzt_soil)                                             &
-                                   * surf%qsws_veg(m) * drho_l_lv )                                &
-                                 ) * ddz_soil(nzt_soil)
-
-                surf_m_soil_p%var_2d(nzb_soil:nzt_soil,m) = surf_m_soil%var_2d(nzb_soil:nzt_soil,m)&
-                                                            + dt_3d * ( tsc(2) * tend(:)           &
-                                                            + tsc(3) * surf_tm_soil_m%var_2d(:,m) )
-
-!
-!--             Account for dry and wet soils to keep solution stable (mass conservation is violated
-!--             here)
-                DO  k = nzb_soil, nzt_soil
-                   surf_m_soil_p%var_2d(k,m) = MIN( surf_m_soil_p%var_2d(k,m), surf%m_sat(k,m) )
-                   surf_m_soil_p%var_2d(k,m) = MAX( surf_m_soil_p%var_2d(k,m), 0.0_wp )
-                ENDDO
-
-!
-!--             Calculate m_soil tendencies for the next Runge-Kutta step
-                IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                   IF ( intermediate_timestep_count == 1 )  THEN
-                      DO  k = nzb_soil, nzt_soil
-                         surf_tm_soil_m%var_2d(k,m) = tend(k)
-                      ENDDO
-                   ELSEIF ( intermediate_timestep_count <  intermediate_timestep_count_max )  THEN
-                      DO  k = nzb_soil, nzt_soil
-                         surf_tm_soil_m%var_2d(k,m) = -9.5625_wp * tend(k)                         &
-                                                      + 5.3125_wp * surf_tm_soil_m%var_2d(k,m)
-                      ENDDO
-
-                   ENDIF
-
-                ENDIF
-
-             ENDIF
-
-          ENDIF
-
-       ENDIF
-
-    ENDDO
-!
-!-- Debug location message
-    IF ( debug_output_timestep )  THEN
-       WRITE( debug_string, * ) 'lsm_soil_model', horizontal, l, calc_soil_moisture
-       CALL debug_message( debug_string, 'end' )
-    ENDIF
-
- END SUBROUTINE lsm_soil_model
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Swapping of timelevels
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_swap_timelevel ( mod_count )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) :: mod_count
-
-
-    SELECT CASE ( mod_count )
-
-       CASE ( 0 )
-!
-!--          Horizontal surfaces
-          t_surface_h  => t_surface_h_1; t_surface_h_p  => t_surface_h_2
-          t_soil_h     => t_soil_h_1;    t_soil_h_p     => t_soil_h_2
-          IF ( humidity )  THEN
-             m_soil_h  => m_soil_h_1;    m_soil_h_p     => m_soil_h_2
-             m_liq_h   => m_liq_h_1;     m_liq_h_p      => m_liq_h_2
-          ENDIF
-
-!
-!--          Vertical surfaces
-          t_surface_v  => t_surface_v_1; t_surface_v_p  => t_surface_v_2
-          t_soil_v     => t_soil_v_1;    t_soil_v_p     => t_soil_v_2
-          IF ( humidity )  THEN
-             m_soil_v  => m_soil_v_1;    m_soil_v_p     => m_soil_v_2
-             m_liq_v   => m_liq_v_1;     m_liq_v_p      => m_liq_v_2
-
-          ENDIF
-
-
-
-       CASE ( 1 )
-!
-!--          Horizontal surfaces
-          t_surface_h  => t_surface_h_2; t_surface_h_p  => t_surface_h_1
-          t_soil_h     => t_soil_h_2;    t_soil_h_p     => t_soil_h_1
-          IF ( humidity )  THEN
-             m_soil_h  => m_soil_h_2;    m_soil_h_p     => m_soil_h_1
-             m_liq_h   => m_liq_h_2;     m_liq_h_p      => m_liq_h_1
-
-          ENDIF
-!
-!--          Vertical surfaces
-          t_surface_v  => t_surface_v_2; t_surface_v_p  => t_surface_v_1
-          t_soil_v     => t_soil_v_2;    t_soil_v_p     => t_soil_v_1
-          IF ( humidity )  THEN
-             m_soil_v  => m_soil_v_2;    m_soil_v_p     => m_soil_v_1
-             m_liq_v   => m_liq_v_2;     m_liq_v_p      => m_liq_v_1
-          ENDIF
-
-    END SELECT
-
- END SUBROUTINE lsm_swap_timelevel
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine for averaging 3D data
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_3d_data_averaging( mode, variable )
-
-
-    USE control_parameters
-
-    USE indices
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  mode    !<
-    CHARACTER (LEN=*) ::  variable !<
-
-    INTEGER(iwp) ::  i       !<
-    INTEGER(iwp) ::  j       !<
-    INTEGER(iwp) ::  k       !<
-    INTEGER(iwp) ::  m       !< running index
-
-    IF ( mode == 'allocate' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-             CASE ( 'c_liq*' )
-                IF ( .NOT. ALLOCATED( c_liq_av ) )  THEN
-                   ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                c_liq_av = 0.0_wp
-
-             CASE ( 'c_soil*' )
-                IF ( .NOT. ALLOCATED( c_soil_av ) )  THEN
-                   ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                c_soil_av = 0.0_wp
-
-             CASE ( 'c_veg*' )
-                IF ( .NOT. ALLOCATED( c_veg_av ) )  THEN
-                   ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                c_veg_av = 0.0_wp
-
-             CASE ( 'lai*' )
-                IF ( .NOT. ALLOCATED( lai_av ) )  THEN
-                   ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                lai_av = 0.0_wp
-
-             CASE ( 'm_liq*' )
-                IF ( .NOT. ALLOCATED( m_liq_av ) )  THEN
-                   ALLOCATE( m_liq_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                m_liq_av = 0.0_wp
-
-             CASE ( 'm_soil' )
-                IF ( .NOT. ALLOCATED( m_soil_av ) )  THEN
-                   ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                m_soil_av = 0.0_wp
-
-             CASE ( 'qsws_liq*' )
-                IF ( .NOT. ALLOCATED( qsws_liq_av ) )  THEN
-                   ALLOCATE( qsws_liq_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qsws_liq_av = 0.0_wp
-
-             CASE ( 'qsws_soil*' )
-                IF ( .NOT. ALLOCATED( qsws_soil_av ) )  THEN
-                   ALLOCATE( qsws_soil_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qsws_soil_av = 0.0_wp
-
-             CASE ( 'qsws_veg*' )
-                IF ( .NOT. ALLOCATED( qsws_veg_av ) )  THEN
-                   ALLOCATE( qsws_veg_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qsws_veg_av = 0.0_wp
-
-             CASE ( 'r_s*' )
-                IF ( .NOT. ALLOCATED( r_s_av ) )  THEN
-                   ALLOCATE( r_s_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                r_s_av = 0.0_wp
-
-             CASE ( 't_soil' )
-                IF ( .NOT. ALLOCATED( t_soil_av ) )  THEN
-                   ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                t_soil_av = 0.0_wp
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'sum' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'c_liq*' )
-             IF ( ALLOCATED( c_liq_av ) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   c_liq_av(j,i) = c_liq_av(j,i) + surf_lsm_h(0)%c_liq(m)
-                ENDDO
-             ENDIF
-
-          CASE ( 'c_soil*' )
-             IF ( ALLOCATED( c_soil_av ) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   c_soil_av(j,i) = c_soil_av(j,i) + (1.0 - surf_lsm_h(0)%c_veg(m))
-                ENDDO
-             ENDIF
-
-          CASE ( 'c_veg*' )
-             IF ( ALLOCATED( c_veg_av ) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   c_veg_av(j,i) = c_veg_av(j,i) + surf_lsm_h(0)%c_veg(m)
-                ENDDO
-             ENDIF
-
-          CASE ( 'lai*' )
-             IF ( ALLOCATED( lai_av ) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   lai_av(j,i) = lai_av(j,i) + surf_lsm_h(0)%lai(m)
-                ENDDO
-             ENDIF
-
-          CASE ( 'm_liq*' )
-             IF ( ALLOCATED( m_liq_av ) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   m_liq_av(j,i) = m_liq_av(j,i) + m_liq_h(0)%var_1d(m)
-                ENDDO
-             ENDIF
-
-          CASE ( 'm_soil' )
-             IF ( ALLOCATED( m_soil_av ) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   DO  k = nzb_soil, nzt_soil
-                      m_soil_av(k,j,i) = m_soil_av(k,j,i) + m_soil_h(0)%var_2d(k,m)
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'qsws_liq*' )
-             IF ( ALLOCATED( qsws_liq_av ) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   qsws_liq_av(j,i) = qsws_liq_av(j,i) + surf_lsm_h(0)%qsws_liq(m)
-                ENDDO
-             ENDIF
-
-          CASE ( 'qsws_soil*' )
-             IF ( ALLOCATED( qsws_soil_av ) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   qsws_soil_av(j,i) = qsws_soil_av(j,i) + surf_lsm_h(0)%qsws_soil(m)
-                ENDDO
-             ENDIF
-
-          CASE ( 'qsws_veg*' )
-             IF ( ALLOCATED(qsws_veg_av ) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   qsws_veg_av(j,i) = qsws_veg_av(j,i) + surf_lsm_h(0)%qsws_veg(m)
-                ENDDO
-             ENDIF
-
-          CASE ( 'r_s*' )
-             IF ( ALLOCATED( r_s_av) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   r_s_av(j,i) = r_s_av(j,i) + surf_lsm_h(0)%r_s(m)
-                ENDDO
-             ENDIF
-
-          CASE ( 't_soil' )
-             IF ( ALLOCATED( t_soil_av ) )  THEN
-                DO  m = 1, surf_lsm_h(0)%ns
-                   i   = surf_lsm_h(0)%i(m)
-                   j   = surf_lsm_h(0)%j(m)
-                   DO  k = nzb_soil, nzt_soil
-                      t_soil_av(k,j,i) = t_soil_av(k,j,i) + t_soil_h(0)%var_2d(k,m)
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'average' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'c_liq*' )
-             IF ( ALLOCATED( c_liq_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      c_liq_av(j,i) = c_liq_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'c_soil*' )
-             IF ( ALLOCATED( c_soil_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      c_soil_av(j,i) = c_soil_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'c_veg*' )
-             IF ( ALLOCATED( c_veg_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      c_veg_av(j,i) = c_veg_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-         CASE ( 'lai*' )
-             IF ( ALLOCATED( lai_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      lai_av(j,i) = lai_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'm_liq*' )
-             IF ( ALLOCATED( m_liq_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      m_liq_av(j,i) = m_liq_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'm_soil' )
-             IF ( ALLOCATED( m_soil_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_soil, nzt_soil
-                         m_soil_av(k,j,i) = m_soil_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'qsws_liq*' )
-             IF ( ALLOCATED( qsws_liq_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      qsws_liq_av(j,i) = qsws_liq_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'qsws_soil*' )
-             IF ( ALLOCATED( qsws_soil_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      qsws_soil_av(j,i) = qsws_soil_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'qsws_veg*' )
-             IF ( ALLOCATED( qsws_veg_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      qsws_veg_av(j,i) = qsws_veg_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'r_s*' )
-             IF ( ALLOCATED( r_s_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      r_s_av(j,i) = r_s_av(j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 't_soil' )
-             IF ( ALLOCATED( t_soil_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_soil, nzt_soil
-                         t_soil_av(k,j,i) = t_soil_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-!
-!--
-
-       END SELECT
-
-    ENDIF
-
- END SUBROUTINE lsm_3d_data_averaging
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining appropriate grid for netcdf variables.
-!> It is called out from subroutine netcdf.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-     IMPLICIT NONE
-
-     CHARACTER (LEN=*), INTENT(IN)  ::  var         !<
-
-     CHARACTER (LEN=*), INTENT(OUT) ::  grid_x      !<
-     CHARACTER (LEN=*), INTENT(OUT) ::  grid_y      !<
-     CHARACTER (LEN=*), INTENT(OUT) ::  grid_z      !<
-
-     LOGICAL, INTENT(OUT)           ::  found       !<
-
-     found  = .TRUE.
-
-!
-!--  Check for the grid
-     SELECT CASE ( TRIM( var ) )
-
-        CASE ( 'm_soil', 't_soil', 'm_soil_xy', 't_soil_xy', 'm_soil_xz', 't_soil_xz', 'm_soil_yz',&
-               't_soil_yz' )
-           grid_x = 'x'
-           grid_y = 'y'
-           grid_z = 'zs'
-
-        CASE DEFAULT
-           found  = .FALSE.
-           grid_x = 'none'
-           grid_y = 'none'
-           grid_z = 'none'
-     END SELECT
-
- END SUBROUTINE lsm_define_netcdf_grid
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 3D output variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
-
-    USE indices
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  grid     !<
-    CHARACTER (LEN=*) ::  mode     !<
-    CHARACTER (LEN=*) ::  variable !<
-
-    INTEGER(iwp) ::  av      !<
-    INTEGER(iwp) ::  i       !< running index
-    INTEGER(iwp) ::  j       !< running index
-    INTEGER(iwp) ::  k       !< running index
-    INTEGER(iwp) ::  m       !< running index
-    INTEGER(iwp) ::  nzb_do  !<
-    INTEGER(iwp) ::  nzt_do  !<
-
-    LOGICAL      ::  found !<
-    LOGICAL      ::  two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
-
-    REAL(wp) ::  fill_value = -999.0_wp    !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
-
-
-    found = .TRUE.
-
-    SELECT CASE ( TRIM( variable ) )
-!
-!--    Before data is transfered to local_pf, transfer is it 2D dummy variable and exchange ghost
-!--    points therein.
-!--    However, at this point this is only required for instantaneous arrays, time-averaged
-!--    quantities are already exchanged.
-       CASE ( 'c_liq*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i                   = surf_lsm_h(0)%i(m)
-                j                   = surf_lsm_h(0)%j(m)
-                local_pf(i,j,nzb+1) = surf_lsm_h(0)%c_liq(m)
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( c_liq_av ) )  THEN
-               ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) )
-               c_liq_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = c_liq_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'c_soil*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i                   = surf_lsm_h(0)%i(m)
-                j                   = surf_lsm_h(0)%j(m)
-                local_pf(i,j,nzb+1) = 1.0_wp - surf_lsm_h(0)%c_veg(m)
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( c_soil_av ) )  THEN
-               ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) )
-               c_soil_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = c_soil_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'c_veg*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i                   = surf_lsm_h(0)%i(m)
-                j                   = surf_lsm_h(0)%j(m)
-                local_pf(i,j,nzb+1) = surf_lsm_h(0)%c_veg(m)
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( c_veg_av ) )  THEN
-               ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) )
-               c_veg_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = c_veg_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'lai*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i                   = surf_lsm_h(0)%i(m)
-                j                   = surf_lsm_h(0)%j(m)
-                local_pf(i,j,nzb+1) = surf_lsm_h(0)%lai(m)
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( lai_av ) )  THEN
-               ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) )
-               lai_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = lai_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'm_liq*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i                   = surf_lsm_h(0)%i(m)
-                j                   = surf_lsm_h(0)%j(m)
-                local_pf(i,j,nzb+1) = m_liq_h(0)%var_1d(m)
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( m_liq_av ) )  THEN
-               ALLOCATE( m_liq_av(nysg:nyng,nxlg:nxrg) )
-               m_liq_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = m_liq_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'm_soil_xy', 'm_soil_xz', 'm_soil_yz' )
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i   = surf_lsm_h(0)%i(m)
-                j   = surf_lsm_h(0)%j(m)
-                DO k = nzb_soil, nzt_soil
-                   local_pf(i,j,k) = m_soil_h(0)%var_2d(k,m)
-                ENDDO
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( m_soil_av ) )  THEN
-               ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
-               m_soil_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO k = nzb_soil, nzt_soil
-                      local_pf(i,j,k) = m_soil_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-
-          nzb_do = nzb_soil
-          nzt_do = nzt_soil
-
-          IF ( mode == 'xy' ) grid = 'zs'
-
-       CASE ( 'qsws_liq*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i                   = surf_lsm_h(0)%i(m)
-                j                   = surf_lsm_h(0)%j(m)
-                local_pf(i,j,nzb+1) = surf_lsm_h(0)%qsws_liq(m)
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( qsws_liq_av ) )  THEN
-               ALLOCATE( qsws_liq_av(nysg:nyng,nxlg:nxrg) )
-               qsws_liq_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) =  qsws_liq_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'qsws_soil*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i                   = surf_lsm_h(0)%i(m)
-                j                   = surf_lsm_h(0)%j(m)
-                local_pf(i,j,nzb+1) =  surf_lsm_h(0)%qsws_soil(m)
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( qsws_soil_av ) )  THEN
-               ALLOCATE( qsws_soil_av(nysg:nyng,nxlg:nxrg) )
-               qsws_soil_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) =  qsws_soil_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'qsws_veg*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i                   = surf_lsm_h(0)%i(m)
-                j                   = surf_lsm_h(0)%j(m)
-                local_pf(i,j,nzb+1) =  surf_lsm_h(0)%qsws_veg(m)
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( qsws_veg_av ) )  THEN
-               ALLOCATE( qsws_veg_av(nysg:nyng,nxlg:nxrg) )
-               qsws_veg_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) =  qsws_veg_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-
-       CASE ( 'r_s*_xy' )        ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i                   = surf_lsm_h(0)%i(m)
-                j                   = surf_lsm_h(0)%j(m)
-                local_pf(i,j,nzb+1) = surf_lsm_h(0)%r_s(m)
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( r_s_av ) )  THEN
-               ALLOCATE( r_s_av(nysg:nyng,nxlg:nxrg) )
-               r_s_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = r_s_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 't_soil_xy', 't_soil_xz', 't_soil_yz' )
-          IF ( av == 0 )  THEN
-             DO  m = 1, surf_lsm_h(0)%ns
-                i   = surf_lsm_h(0)%i(m)
-                j   = surf_lsm_h(0)%j(m)
-                DO k = nzb_soil, nzt_soil
-                   local_pf(i,j,k) = t_soil_h(0)%var_2d(k,m)
-                ENDDO
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( t_soil_av ) )  THEN
-               ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
-               t_soil_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO k = nzb_soil, nzt_soil
-                      local_pf(i,j,k) = t_soil_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-
-          nzb_do = nzb_soil
-          nzt_do = nzt_soil
-
-          IF ( mode == 'xy' )  grid = 'zs'
-
-
-       CASE DEFAULT
-          found = .FALSE.
-          grid  = 'none'
-
-    END SELECT
-
- END SUBROUTINE lsm_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 3D output variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_data_output_3d( av, variable, found, local_pf )
-
-
-    USE indices
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  variable !<
-
-    INTEGER(iwp) ::  av    !<
-    INTEGER(iwp) ::  i     !<
-    INTEGER(iwp) ::  j     !<
-    INTEGER(iwp) ::  k     !<
-    INTEGER(iwp) ::  m     !< running index
-
-    LOGICAL      ::  found !<
-
-    REAL(wp) ::  fill_value = -999.0_wp    !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_soil:nzt_soil) ::  local_pf !<
-
-
-    found = .TRUE.
-
-
-    SELECT CASE ( TRIM( variable ) )
-!
-!--   Requires 3D exchange
-
-      CASE ( 'm_soil' )
-
-         IF ( av == 0 )  THEN
-            DO  m = 1, surf_lsm_h(0)%ns
-                i   = surf_lsm_h(0)%i(m)
-                j   = surf_lsm_h(0)%j(m)
-                DO  k = nzb_soil, nzt_soil
-                   local_pf(i,j,k) = m_soil_h(0)%var_2d(k,m)
-                ENDDO
-            ENDDO
-         ELSE
-            IF ( .NOT. ALLOCATED( m_soil_av ) )  THEN
-               ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
-               m_soil_av = REAL( fill_value, KIND = wp )
-            ENDIF
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_soil, nzt_soil
-                     local_pf(i,j,k) = m_soil_av(k,j,i)
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-
-      CASE ( 't_soil' )
-
-         IF ( av == 0 )  THEN
-            DO  m = 1, surf_lsm_h(0)%ns
-               i   = surf_lsm_h(0)%i(m)
-               j   = surf_lsm_h(0)%j(m)
-               DO  k = nzb_soil, nzt_soil
-                  local_pf(i,j,k) = t_soil_h(0)%var_2d(k,m)
-               ENDDO
-            ENDDO
-         ELSE
-            IF ( .NOT. ALLOCATED( t_soil_av ) )  THEN
-               ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
-               t_soil_av = REAL( fill_value, KIND = wp )
-            ENDIF
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_soil, nzt_soil
-                     local_pf(i,j,k) = t_soil_av(k,j,i)
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE lsm_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Write restart data for land surface model. It is necessary to write start_index and end_index
-!> several times.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_wrd_local
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=1) ::  dum    !< dummy to create correct string for creating variable string
-
-    INTEGER(iwp)      ::  l      !< index variable for surface orientation
-
-    INTEGER(iwp),DIMENSION(nys:nyn,nxl:nxr) ::  global_end_index    !< end index for surface data (MPI-IO)
-    INTEGER(iwp),DIMENSION(nys:nyn,nxl:nxr) ::  global_start_index  !< start index for surface data (MPI-IO)
-
-    LOGICAL ::  surface_data_to_write  !< switch for MPI-I/O if PE has surface data to write
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL wrd_write_string( 'ns_h_on_file_lsm' )
-       WRITE ( 14 )  surf_lsm_h(0:1)%ns
-
-       CALL wrd_write_string( 'ns_v_on_file_lsm' )
-       WRITE ( 14 )  surf_lsm_v(0:3)%ns
-
-
-       IF ( ALLOCATED( c_liq_av ) )  THEN
-          CALL wrd_write_string( 'c_liq_av' )
-          WRITE ( 14 )  c_liq_av
-       ENDIF
-
-       IF ( ALLOCATED( c_soil_av ) )  THEN
-          CALL wrd_write_string( 'c_soil_av' )
-          WRITE ( 14 )  c_soil_av
-       ENDIF
-
-       IF ( ALLOCATED( c_veg_av ) )  THEN
-          CALL wrd_write_string( 'c_veg_av' )
-          WRITE ( 14 )  c_veg_av
-       ENDIF
-
-       IF ( ALLOCATED( lai_av ) )  THEN
-          CALL wrd_write_string( 'lai_av' )
-          WRITE ( 14 )  lai_av
-       ENDIF
-
-       IF ( ALLOCATED( m_liq_av ) )  THEN
-          CALL wrd_write_string( 'm_liq_av' )
-          WRITE ( 14 )  m_liq_av
-       ENDIF
-
-       IF ( ALLOCATED( m_soil_av ) )  THEN
-          CALL wrd_write_string( 'm_soil_av' )
-          WRITE ( 14 )  m_soil_av
-       ENDIF
-
-       IF ( ALLOCATED( qsws_liq_av ) )  THEN
-          CALL wrd_write_string( 'qsws_liq_av' )
-          WRITE ( 14 )  qsws_liq_av
-       ENDIF
-
-       IF ( ALLOCATED( qsws_soil_av ) )  THEN
-          CALL wrd_write_string( 'qsws_soil_av' )
-          WRITE ( 14 )  qsws_soil_av
-       ENDIF
-
-       IF ( ALLOCATED( qsws_veg_av ) )  THEN
-          CALL wrd_write_string( 'qsws_veg_av' )
-          WRITE ( 14 )  qsws_veg_av
-       ENDIF
-
-       IF ( ALLOCATED( t_soil_av ) )  THEN
-          CALL wrd_write_string( 't_soil_av' )
-          WRITE ( 14 )  t_soil_av
-       ENDIF
-
-       DO  l = 0, 1
-          CALL wrd_write_string( 'lsm_start_index_h' )
-          WRITE ( 14 )  surf_lsm_h(l)%start_index
-
-          CALL wrd_write_string( 'lsm_end_index_h' )
-          WRITE ( 14 )  surf_lsm_h(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-          CALL wrd_write_string( 't_soil_h(' // dum // ')' )
-          WRITE ( 14 )  t_soil_h(l)%var_2d
-       ENDDO
-
-       DO  l = 0, 3
-
-          CALL wrd_write_string( 'lsm_start_index_v' )
-          WRITE ( 14 )  surf_lsm_v(l)%start_index
-
-          CALL wrd_write_string( 'lsm_end_index_v' )
-          WRITE ( 14 )  surf_lsm_v(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-          CALL wrd_write_string( 't_soil_v(' // dum // ')' )
-          WRITE ( 14 )  t_soil_v(l)%var_2d
-
-       ENDDO
-
-       DO  l = 0, 1
-          CALL wrd_write_string( 'lsm_start_index_h' )
-          WRITE ( 14 )  surf_lsm_h(l)%start_index
-
-          CALL wrd_write_string( 'lsm_end_index_h' )
-          WRITE ( 14 )  surf_lsm_h(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-          CALL wrd_write_string( 'm_soil_h(' // dum // ')' )
-          WRITE ( 14 )  m_soil_h(l)%var_2d
-       ENDDO
-
-       DO  l = 0, 3
-
-          CALL wrd_write_string( 'lsm_start_index_v' )
-          WRITE ( 14 )  surf_lsm_v(l)%start_index
-
-          CALL wrd_write_string( 'lsm_end_index_v' )
-          WRITE ( 14 )  surf_lsm_v(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-          CALL wrd_write_string( 'm_soil_v(' // dum // ')' )
-          WRITE ( 14 )  m_soil_v(l)%var_2d
-
-       ENDDO
-
-       DO  l = 0, 1
-          CALL wrd_write_string( 'lsm_start_index_h' )
-          WRITE ( 14 )  surf_lsm_h(l)%start_index
-
-          CALL wrd_write_string( 'lsm_end_index_h' )
-          WRITE ( 14 )  surf_lsm_h(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-          CALL wrd_write_string( 'm_liq_h(' // dum // ')' )
-          WRITE ( 14 )  m_liq_h(l)%var_1d
-       ENDDO
-
-       DO  l = 0, 3
-
-          CALL wrd_write_string( 'lsm_start_index_v' )
-          WRITE ( 14 )  surf_lsm_v(l)%start_index
-
-          CALL wrd_write_string( 'lsm_end_index_v' )
-          WRITE ( 14 )  surf_lsm_v(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-          CALL wrd_write_string( 'm_liq_v(' // dum // ')' )
-          WRITE ( 14 )  m_liq_v(l)%var_1d
-
-       ENDDO
-
-       DO  l = 0, 1
-          CALL wrd_write_string( 'lsm_start_index_h' )
-          WRITE ( 14 )  surf_lsm_h(l)%start_index
-
-          CALL wrd_write_string( 'lsm_end_index_h' )
-          WRITE ( 14 )  surf_lsm_h(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-          CALL wrd_write_string( 't_surface_h(' // dum // ')' )
-          WRITE ( 14 )  t_surface_h(l)%var_1d
-       ENDDO
-
-       DO  l = 0, 3
-
-          CALL wrd_write_string( 'lsm_start_index_v' )
-          WRITE ( 14 )  surf_lsm_v(l)%start_index
-
-          CALL wrd_write_string( 'lsm_end_index_v' )
-          WRITE ( 14 )  surf_lsm_v(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-          CALL wrd_write_string( 't_surface_v(' // dum // ')' )
-          WRITE ( 14 )  t_surface_v(l)%var_1d
-
-       ENDDO
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       IF ( ALLOCATED( c_liq_av ) )  CALL wrd_mpi_io( 'c_liq_av',  c_liq_av )
-       IF ( ALLOCATED( c_soil_av ) )  CALL wrd_mpi_io( 'c_soil_av',  c_soil_av )
-       IF ( ALLOCATED( c_veg_av ) )  CALL wrd_mpi_io( 'c_veg_av',  c_veg_av )
-       IF ( ALLOCATED( lai_av ) )  CALL wrd_mpi_io( 'lai_av', lai_av )
-       IF ( ALLOCATED( m_liq_av ) )  CALL wrd_mpi_io( 'm_liq_av',  m_liq_av )
-       IF ( ALLOCATED( m_soil_av ) )  CALL wrd_mpi_io( 'm_soil_av', m_soil_av, nzb_soil, nzt_soil )
-       IF ( ALLOCATED( qsws_liq_av ) )  CALL wrd_mpi_io( 'qsws_liq_av', qsws_liq_av )
-       IF ( ALLOCATED( qsws_soil_av ) )  CALL wrd_mpi_io( 'qsws_soil_av', qsws_soil_av )
-       IF ( ALLOCATED( qsws_veg_av ) )  CALL wrd_mpi_io( 'qsws_veg_av', qsws_veg_av )
-       IF ( ALLOCATED( t_soil_av ) )  CALL wrd_mpi_io( 't_soil_av', t_soil_av, nzb_soil, nzt_soil )
-
-       DO  l = 0, 1
-
-          WRITE( dum, '(I1)' )  l
-
-          CALL rd_mpi_io_surface_filetypes( surf_lsm_h(l)%start_index, surf_lsm_h(l)%end_index,    &
-                                            surface_data_to_write, global_start_index,             &
-                                            global_end_index )
-
-          CALL wrd_mpi_io( 'lsm_global_start_index_h_' // dum, global_start_index )
-          CALL wrd_mpi_io( 'lsm_global_end_index_h_' // dum, global_end_index )
-
-          IF ( .NOT. surface_data_to_write )  CYCLE
-
-          CALL wrd_mpi_io_surface( 't_soil_h(' // dum // ')', t_soil_h(l)%var_2d )
-          CALL wrd_mpi_io_surface( 'm_soil_h(' // dum // ')', m_soil_h(l)%var_2d )
-          CALL wrd_mpi_io_surface( 'm_liq_h(' // dum // ')', m_liq_h(l)%var_1d )
-          CALL wrd_mpi_io_surface( 't_surface_h(' // dum // ')', t_surface_h(l)%var_1d )
-       ENDDO
-
-       DO  l = 0, 3
-
-          WRITE( dum, '(I1)' )  l
-
-          CALL rd_mpi_io_surface_filetypes ( surf_lsm_v(l)%start_index, surf_lsm_v(l)%end_index,   &
-                                            surface_data_to_write, global_start_index,             &
-                                            global_end_index )
-
-          CALL wrd_mpi_io( 'lsm_global_start_index_v_' // dum, global_start_index )
-          CALL wrd_mpi_io( 'lsm_global_end_index_v_' // dum, global_end_index )
-
-          IF ( .NOT. surface_data_to_write )  CYCLE
-
-          CALL wrd_mpi_io_surface( 't_soil_v(' // dum // ')', t_soil_v(l)%var_2d  )
-          CALL wrd_mpi_io_surface( 'm_soil_v(' // dum // ')', m_soil_v(l)%var_2d )
-          CALL wrd_mpi_io_surface( 'm_liq_v(' // dum // ')',  m_liq_v(l)%var_1d )
-          CALL wrd_mpi_io_surface( 't_surface_v(' // dum // ')',  t_surface_v(l)%var_1d )
-
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE lsm_wrd_local
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,    &
-                               nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, found )
-
-
-    USE control_parameters
-
-    USE indices
-
-    USE pegrid
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k                 !<
-    INTEGER(iwp) ::  l                 !< running index surface orientation
-    INTEGER(iwp) ::  nxlc              !<
-    INTEGER(iwp) ::  nxlf              !<
-    INTEGER(iwp) ::  nxl_on_file       !< index of left boundary on former local domain
-    INTEGER(iwp) ::  nxrc              !<
-    INTEGER(iwp) ::  nxrf              !<
-    INTEGER(iwp) ::  nxr_on_file       !< index of right boundary on former local domain
-    INTEGER(iwp) ::  nync              !<
-    INTEGER(iwp) ::  nynf              !<
-    INTEGER(iwp) ::  nyn_on_file       !< index of north boundary on former local domain
-    INTEGER(iwp) ::  nysc              !<
-    INTEGER(iwp) ::  nysf              !<
-    INTEGER(iwp) ::  nys_on_file       !< index of south boundary on former local domain
-
-    INTEGER(iwp) ::  ns_h_on_file_lsm(0:1) !< number of horizontal surface elements (natural type) on file
-    INTEGER(iwp) ::  ns_v_on_file_lsm(0:3) !< number of vertical surface elements (natural type) on file
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  start_index_on_file
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  end_index_on_file
-
-    LOGICAL, INTENT(OUT)  :: found
-
-    REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d   !<
-
-    REAL(wp), DIMENSION(nzb_soil:nzt_soil,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
-
-    TYPE(surf_type_lsm), DIMENSION(0:1), SAVE :: tmp_walltype_h_1d   !< temporary 1D array containing the respective surface
-                                                                     !< variable stored on file, horizontal surfaces
-    TYPE(surf_type_lsm), DIMENSION(0:1), SAVE :: tmp_walltype_h_2d   !< temporary 2D array containing the respective surface
-                                                                     !< variable stored on file, horizontal surfaces
-    TYPE(surf_type_lsm), DIMENSION(0:1), SAVE :: tmp_walltype_h_2d2  !< temporary 2D array containing the respective surface
-                                                                     !< variable stored on file, horizontal surfaces
-
-    TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_1d   !< temporary 1D array containing the respective surface
-                                                                     !< variable stored on file, vertical surfaces
-    TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_2d   !< temporary 2D array containing the respective surface
-                                                                     !< variable stored on file, vertical surfaces
-    TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_2d2  !< temporary 2D array containing the respective surface
-                                                                     !< variable stored on file, vertical surfaces
-
-
-    found = .TRUE.
-
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'ns_h_on_file_lsm' )
-          IF ( k == 1 )  THEN
-             READ ( 13 ) ns_h_on_file_lsm
-
-             DO l = 0, 1
-                IF ( ALLOCATED( tmp_walltype_h_1d(l)%var_1d ) )                                    &
-                   DEALLOCATE( tmp_walltype_h_1d(l)%var_1d )
-                IF ( ALLOCATED( tmp_walltype_h_2d(l)%var_2d ) )                                    &
-                   DEALLOCATE( tmp_walltype_h_2d(l)%var_2d )
-                IF ( ALLOCATED( tmp_walltype_h_2d2(l)%var_2d ) )                                   &
-                   DEALLOCATE( tmp_walltype_h_2d2(l)%var_2d )
-             ENDDO
-
-!
-!--          Allocate temporary arrays to store surface data
-             DO l = 0, 1
-                ALLOCATE( tmp_walltype_h_1d(l) %var_1d(1:ns_h_on_file_lsm(l)) )
-                ALLOCATE( tmp_walltype_h_2d(l) %var_2d(nzb_soil:nzt_soil+1, 1:ns_h_on_file_lsm(l)) )
-                ALLOCATE( tmp_walltype_h_2d2(l) %var_2d(nzb_soil:nzt_soil,1:ns_h_on_file_lsm(l))  )
-             ENDDO
-
-          ENDIF
-
-       CASE ( 'ns_v_on_file_lsm' )
-          IF ( k == 1 )  THEN
-             READ ( 13 ) ns_v_on_file_lsm
-
-             DO  l = 0, 3
-                IF ( ALLOCATED( tmp_walltype_v_1d(l)%var_1d ) )                                    &
-                   DEALLOCATE( tmp_walltype_v_1d(l)%var_1d )
-                IF ( ALLOCATED( tmp_walltype_v_2d(l)%var_2d ) )                                    &
-                   DEALLOCATE( tmp_walltype_v_2d(l)%var_2d )
-                IF ( ALLOCATED( tmp_walltype_v_2d2(l)%var_2d ) )                                   &
-                   DEALLOCATE( tmp_walltype_v_2d2(l)%var_2d )
-             ENDDO
-
-!
-!--          Allocate temporary arrays to store surface data
-             DO  l = 0, 3
-                ALLOCATE( tmp_walltype_v_1d(l) %var_1d(1:ns_v_on_file_lsm(l)) )
-                ALLOCATE( tmp_walltype_v_2d(l) %var_2d(nzb_soil:nzt_soil+1,1:ns_v_on_file_lsm(l)) )
-                ALLOCATE( tmp_walltype_v_2d2(l) %var_2d(nzb_soil:nzt_soil,1:ns_v_on_file_lsm(l))  )
-             ENDDO
-
-          ENDIF
-
-
-       CASE ( 'c_liq_av' )
-          IF ( .NOT. ALLOCATED( c_liq_av ) )  THEN
-             ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_2d
-          c_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                      &
-             tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'c_soil_av' )
-          IF ( .NOT. ALLOCATED( c_soil_av ) )  THEN
-             ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_2d
-          c_soil_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                     &
-             tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'c_veg_av' )
-          IF ( .NOT. ALLOCATED( c_veg_av ) )  THEN
-             ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_2d
-          c_veg_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                      &
-             tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'lai_av' )
-          IF ( .NOT. ALLOCATED( lai_av ) )  THEN
-             ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_2d
-          lai_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                        &
-             tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'm_liq_av' )
-          IF ( .NOT. ALLOCATED( m_liq_av ) )  THEN
-             ALLOCATE( m_liq_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_2d
-          m_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                      &
-             tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'm_soil_av' )
-          IF ( .NOT. ALLOCATED( m_soil_av ) )  THEN
-             ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d(:,:,:)
-          m_soil_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                   &
-             tmp_3d(nzb_soil:nzt_soil,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'qsws_liq_av' )
-          IF ( .NOT. ALLOCATED( qsws_liq_av ) )  THEN
-             ALLOCATE( qsws_liq_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_2d
-          qsws_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                                  &
-             tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-       CASE ( 'qsws_soil_av' )
-          IF ( .NOT. ALLOCATED( qsws_soil_av ) )  THEN
-             ALLOCATE( qsws_soil_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_2d
-          qsws_soil_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                                 &
-             tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'qsws_veg_av' )
-          IF ( .NOT. ALLOCATED( qsws_veg_av ) )  THEN
-             ALLOCATE( qsws_veg_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_2d
-          qsws_veg_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                                  &
-             tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 't_soil_av' )
-          IF ( .NOT. ALLOCATED( t_soil_av ) )  THEN
-             ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d(:,:,:)
-          t_soil_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                   &
-             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'lsm_start_index_h', 'lsm_start_index_v'  )
-            IF ( k == 1 )  THEN
-
-               IF ( ALLOCATED( start_index_on_file ) )  DEALLOCATE( start_index_on_file )
-
-               ALLOCATE ( start_index_on_file(nys_on_file:nyn_on_file, nxl_on_file:nxr_on_file) )
-
-               READ ( 13 )  start_index_on_file
-
-            ENDIF
-
-       CASE ( 'lsm_end_index_h', 'lsm_end_index_v' )
-            IF ( k == 1 )  THEN
-
-               IF ( ALLOCATED( end_index_on_file ) )  DEALLOCATE( end_index_on_file )
-
-               ALLOCATE ( end_index_on_file(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) )
-
-               READ ( 13 )  end_index_on_file
-
-            ENDIF
-
-       CASE ( 't_soil_h(0)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_soil_h(0)%var_2d ) )                                         &
-                ALLOCATE( t_soil_h(0)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h(0)%ns) )
-             READ ( 13 )  tmp_walltype_h_2d(0)%var_2d
-          ENDIF
-          CALL surface_restore_elements( t_soil_h(0)%var_2d,                                       &
-                                         tmp_walltype_h_2d(0)%var_2d,                              &
-                                         surf_lsm_h(0)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 't_soil_h(1)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_soil_h(1)%var_2d ) )                                         &
-                ALLOCATE( t_soil_h(1)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h(1)%ns) )
-             READ ( 13 )  tmp_walltype_h_2d(1)%var_2d
-          ENDIF
-          CALL surface_restore_elements( t_soil_h(1)%var_2d,                                       &
-                                         tmp_walltype_h_2d(1)%var_2d,                              &
-                                         surf_lsm_h(1)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 't_soil_v(0)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_soil_v(0)%var_2d ) )                                         &
-                ALLOCATE( t_soil_v(0)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(0)%ns) )
-             READ ( 13 )  tmp_walltype_v_2d(0)%var_2d
-          ENDIF
-          CALL surface_restore_elements( t_soil_v(0)%var_2d,                                       &
-                                         tmp_walltype_v_2d(0)%var_2d,                              &
-                                         surf_lsm_v(0)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 't_soil_v(1)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_soil_v(1)%var_2d ) )                                         &
-                ALLOCATE( t_soil_v(1)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(1)%ns) )
-             READ ( 13 )  tmp_walltype_v_2d(1)%var_2d
-          ENDIF
-          CALL surface_restore_elements( t_soil_v(1)%var_2d,                                       &
-                                         tmp_walltype_v_2d(1)%var_2d,                              &
-                                         surf_lsm_v(1)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 't_soil_v(2)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_soil_v(2)%var_2d ) )                                         &
-                ALLOCATE( t_soil_v(2)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(2)%ns) )
-             READ ( 13 )  tmp_walltype_v_2d(2)%var_2d
-          ENDIF
-          CALL surface_restore_elements( t_soil_v(2)%var_2d,                                       &
-                                         tmp_walltype_v_2d(2)%var_2d,                              &
-                                         surf_lsm_v(2)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 't_soil_v(3)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_soil_v(3)%var_2d ) )                                         &
-                ALLOCATE( t_soil_v(1)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(3)%ns) )
-             READ ( 13 )  tmp_walltype_v_2d(3)%var_2d
-          ENDIF
-          CALL surface_restore_elements( t_soil_v(3)%var_2d,                                       &
-                                         tmp_walltype_v_2d(3)%var_2d,                              &
-                                         surf_lsm_v(3)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 'm_soil_h(0)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_soil_h(0)%var_2d ) )                                         &
-                ALLOCATE( m_soil_h(0)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h(0)%ns) )
-             READ ( 13 )  tmp_walltype_h_2d2(0)%var_2d
-          ENDIF
-          CALL surface_restore_elements( m_soil_h(0)%var_2d,                                       &
-                                         tmp_walltype_h_2d2(0)%var_2d,                             &
-                                         surf_lsm_h(0)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 'm_soil_h(1)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_soil_h(1)%var_2d ) )                                         &
-                ALLOCATE( m_soil_h(1)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h(1)%ns) )
-             READ ( 13 )  tmp_walltype_h_2d2(1)%var_2d
-          ENDIF
-          CALL surface_restore_elements( m_soil_h(1)%var_2d,                                       &
-                                         tmp_walltype_h_2d2(1)%var_2d,                             &
-                                         surf_lsm_h(1)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 'm_soil_v(0)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_soil_v(0)%var_2d ) )                                         &
-                ALLOCATE( m_soil_v(0)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(0)%ns) )
-             READ ( 13 )  tmp_walltype_v_2d2(0)%var_2d
-          ENDIF
-          CALL surface_restore_elements( m_soil_v(0)%var_2d,                                       &
-                                         tmp_walltype_v_2d2(0)%var_2d,                             &
-                                         surf_lsm_v(0)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 'm_soil_v(1)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_soil_v(1)%var_2d ) )                                         &
-                ALLOCATE( m_soil_v(1)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(1)%ns) )
-             READ ( 13 )  tmp_walltype_v_2d2(1)%var_2d
-          ENDIF
-          CALL surface_restore_elements( m_soil_v(1)%var_2d,                                       &
-                                         tmp_walltype_v_2d2(1)%var_2d,                             &
-                                         surf_lsm_v(1)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-
-       CASE ( 'm_soil_v(2)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_soil_v(2)%var_2d ) )                                         &
-                ALLOCATE( m_soil_v(2)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(2)%ns) )
-             READ ( 13 )  tmp_walltype_v_2d2(2)%var_2d
-          ENDIF
-          CALL surface_restore_elements( m_soil_v(2)%var_2d,                                       &
-                                         tmp_walltype_v_2d2(2)%var_2d,                             &
-                                         surf_lsm_v(2)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-
-       CASE ( 'm_soil_v(3)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_soil_v(3)%var_2d ) )                                         &
-                ALLOCATE( m_soil_v(1)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(3)%ns) )
-             READ ( 13 )  tmp_walltype_v_2d2(3)%var_2d
-          ENDIF
-          CALL surface_restore_elements( m_soil_v(3)%var_2d,                                       &
-                                         tmp_walltype_v_2d2(3)%var_2d,                             &
-                                         surf_lsm_v(3)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-
-       CASE ( 'm_liq_h(0)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_liq_h(0)%var_1d ) )                                          &
-                ALLOCATE( m_liq_h(0)%var_1d(1:surf_lsm_h(0)%ns) )
-             READ ( 13 )  tmp_walltype_h_1d(0)%var_1d
-          ENDIF
-          CALL surface_restore_elements( m_liq_h(0)%var_1d,                                        &
-                                         tmp_walltype_h_1d(0)%var_1d,                              &
-                                         surf_lsm_h(0)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 'm_liq_h(1)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_liq_h(1)%var_1d ) )                                          &
-                ALLOCATE( m_liq_h(1)%var_1d(1:surf_lsm_h(1)%ns) )
-             READ ( 13 )  tmp_walltype_h_1d(1)%var_1d
-          ENDIF
-          CALL surface_restore_elements( m_liq_h(1)%var_1d,                                        &
-                                         tmp_walltype_h_1d(1)%var_1d,                              &
-                                         surf_lsm_h(1)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-
-       CASE ( 'm_liq_v(0)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_liq_v(0)%var_1d ) )                                          &
-                ALLOCATE( m_liq_v(0)%var_1d(1:surf_lsm_v(0)%ns) )
-             READ ( 13 )  tmp_walltype_v_1d(0)%var_1d
-          ENDIF
-          CALL surface_restore_elements( m_liq_v(0)%var_1d,                                        &
-                                         tmp_walltype_v_1d(0)%var_1d,                              &
-                                         surf_lsm_v(0)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-
-       CASE ( 'm_liq_v(1)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_liq_v(1)%var_1d ) )                                          &
-                ALLOCATE( m_liq_v(1)%var_1d(1:surf_lsm_v(1)%ns) )
-             READ ( 13 )  tmp_walltype_v_1d(1)%var_1d
-          ENDIF
-          CALL surface_restore_elements( m_liq_v(1)%var_1d,                                        &
-                                         tmp_walltype_v_1d(1)%var_1d,                              &
-                                         surf_lsm_v(1)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-
-       CASE ( 'm_liq_v(2)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_liq_v(2)%var_1d ) )                                          &
-                ALLOCATE( m_liq_v(2)%var_1d(1:surf_lsm_v(2)%ns) )
-             READ ( 13 )  tmp_walltype_v_1d(2)%var_1d
-          ENDIF
-          CALL surface_restore_elements( m_liq_v(2)%var_1d,                                        &
-                                         tmp_walltype_v_1d(2)%var_1d,                              &
-                                         surf_lsm_v(2)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 'm_liq_v(3)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_liq_v(3)%var_1d ) )                                          &
-                ALLOCATE( m_liq_v(3)%var_1d(1:surf_lsm_v(3)%ns) )
-             READ ( 13 )  tmp_walltype_v_1d(3)%var_1d
-          ENDIF
-          CALL surface_restore_elements( m_liq_v(3)%var_1d,                                        &
-                                         tmp_walltype_v_1d(3)%var_1d,                              &
-                                         surf_lsm_v(3)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-
-       CASE ( 't_surface_h(0)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surface_h(0)%var_1d ) )                                      &
-                ALLOCATE( t_surface_h(0)%var_1d(1:surf_lsm_h(0)%ns) )
-             READ ( 13 )  tmp_walltype_h_1d(0)%var_1d
-          ENDIF
-          CALL surface_restore_elements( t_surface_h(0)%var_1d,                                    &
-                                         tmp_walltype_h_1d(0)%var_1d,                              &
-                                         surf_lsm_h(0)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surface_h(1)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surface_h(1)%var_1d ) )                                      &
-                ALLOCATE( t_surface_h(1)%var_1d(1:surf_lsm_h(1)%ns) )
-             READ ( 13 )  tmp_walltype_h_1d(1)%var_1d
-          ENDIF
-          CALL surface_restore_elements( t_surface_h(1)%var_1d,                                    &
-                                         tmp_walltype_h_1d(1)%var_1d,                              &
-                                         surf_lsm_h(1)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surface_v(0)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surface_v(0)%var_1d ) )                                      &
-                ALLOCATE( t_surface_v(0)%var_1d(1:surf_lsm_v(0)%ns) )
-             READ ( 13 )  tmp_walltype_v_1d(0)%var_1d
-          ENDIF
-          CALL surface_restore_elements( t_surface_v(0)%var_1d,                                    &
-                                         tmp_walltype_v_1d(0)%var_1d,                              &
-                                         surf_lsm_v(0)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surface_v(1)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surface_v(1)%var_1d ) )                                      &
-                ALLOCATE( t_surface_v(1)%var_1d(1:surf_lsm_v(1)%ns) )
-             READ ( 13 )  tmp_walltype_v_1d(1)%var_1d
-          ENDIF
-          CALL surface_restore_elements( t_surface_v(1)%var_1d,                                    &
-                                         tmp_walltype_v_1d(1)%var_1d,                              &
-                                         surf_lsm_v(1)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surface_v(2)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surface_v(2)%var_1d ) )                                      &
-                ALLOCATE( t_surface_v(2)%var_1d(1:surf_lsm_v(2)%ns) )
-             READ ( 13 )  tmp_walltype_v_1d(2)%var_1d
-          ENDIF
-          CALL surface_restore_elements( t_surface_v(2)%var_1d,                                    &
-                                         tmp_walltype_v_1d(2)%var_1d,                              &
-                                         surf_lsm_v(2)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surface_v(3)' )
-
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surface_v(3)%var_1d ) )                                      &
-                ALLOCATE( t_surface_v(3)%var_1d(1:surf_lsm_v(3)%ns) )
-             READ ( 13 )  tmp_walltype_v_1d(3)%var_1d
-          ENDIF
-          CALL surface_restore_elements( t_surface_v(3)%var_1d,                                    &
-                                         tmp_walltype_v_1d(3)%var_1d,                              &
-                                         surf_lsm_v(3)%start_index,                                &
-                                         start_index_on_file,                                      &
-                                         end_index_on_file,                                        &
-                                         nxlc, nysc,                                               &
-                                         nxlf, nxrf, nysf, nynf,                                   &
-                                         nys_on_file, nyn_on_file,                                 &
-                                         nxl_on_file,nxr_on_file )
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE lsm_rrd_local_ftn
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE lsm_rrd_local_mpi
-
-    USE control_parameters
-
-    USE indices
-
-    USE pegrid
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1) ::  dum  !< dummy to create correct string for creating variable string
-
-    INTEGER(iwp) ::  l   !< running index surface orientation
-
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_end_index
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_start_index
-
-    LOGICAL ::  array_found
-    LOGICAL ::  data_to_read    !< switch to steer reading of data
-
-
-    CALL rd_mpi_io_check_array( 'c_liq_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( c_liq_av ) )  ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'c_liq_av',  c_liq_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'c_soil_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( c_soil_av ) )  ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'c_soil_av',  c_soil_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'c_veg_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( c_veg_av ) )  ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'c_veg_av',  c_veg_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'lai_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( lai_av ) )  ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'lai_av',  lai_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'm_liq_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( m_liq_av ) )  ALLOCATE( m_liq_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'm_liq_av',  m_liq_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'm_soil_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( m_soil_av ) )  ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'm_soil_av', m_soil_av, nzb_soil, nzt_soil )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'qsws_liq_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( qsws_liq_av ) )  ALLOCATE( qsws_liq_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'qsws_liq_av',  qsws_liq_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'qsws_soil_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( qsws_soil_av ) )  ALLOCATE( qsws_soil_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'qsws_soil_av',  qsws_soil_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'qsws_veg_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( qsws_veg_av ) )  ALLOCATE( qsws_veg_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'qsws_veg_av',  qsws_veg_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 't_soil_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( t_soil_av ) )  ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 't_soil_av', t_soil_av, nzb_soil, nzt_soil )
-    ENDIF
-
-    DO l = 0, 1
-
-       WRITE( dum, '(I1)')  l
-
-!
-!--    surf_lsm_h(l)%start_index and surf_lsm_h(l)%end_index are already set and should not be read
-!--    from restart file.
-       CALL rrd_mpi_io( 'lsm_global_start_index_h_' // dum, global_start_index )
-       CALL rrd_mpi_io( 'lsm_global_end_index_h_' // dum, global_end_index )
-
-       CALL rd_mpi_io_surface_filetypes ( surf_lsm_h(l)%start_index, surf_lsm_h(l)%end_index,      &
-                                          data_to_read, global_start_index, global_end_index )
-       IF ( .NOT. data_to_read )  CYCLE
-
-       CALL rrd_mpi_io_surface( 't_soil_h(' // dum // ')', t_soil_h(l)%var_2d )
-       CALL rrd_mpi_io_surface( 'm_soil_h(' // dum // ')',  m_soil_h(l)%var_2d )
-       CALL rrd_mpi_io_surface( 'm_liq_h(' // dum // ')', m_liq_h(l)%var_1d )
-       CALL rrd_mpi_io_surface( 't_surface_h(' // dum // ')', t_surface_h(l)%var_1d )
-
-    ENDDO
-
-    DO  l = 0, 3
-
-       WRITE( dum, '(I1)')  l
-
-!
-!--    surf_lsm_v(l)%start_index and surf_lsm_v(l)%end_index are already set and should not be read
-!--    from restart file.
-       CALL rrd_mpi_io( 'lsm_global_start_index_v_' // dum , global_start_index )
-       CALL rrd_mpi_io( 'lsm_global_end_index_v_' // dum , global_end_index )
-
-       CALL rd_mpi_io_surface_filetypes( surf_lsm_v(l)%start_index, surf_lsm_v(l)%end_index,       &
-                                         data_to_read, global_start_index, global_end_index )
-       IF ( .NOT. data_to_read )  CYCLE
-
-       CALL rrd_mpi_io_surface( 't_soil_v(' // dum // ')', t_soil_v(l)%var_2d )
-       CALL rrd_mpi_io_surface( 'm_soil_v(' // dum // ')', m_soil_v(l)%var_2d )
-       CALL rrd_mpi_io_surface( 'm_liq_v(' // dum // ')', m_liq_v(l)%var_1d )
-       CALL rrd_mpi_io_surface( 't_surface_v(' // dum // ')', t_surface_v(l)%var_1d )
-
-    ENDDO
-
- END SUBROUTINE lsm_rrd_local_mpi
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of roughness length for open water (lakes, ocean). The parameterization follows
-!> Charnock (1955). Two different implementations are available: as in ECMWF-IFS (Beljaars 1994) or
-!> as in FLake (Subin et al. 2012)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_z0_water_surface
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string, molecular_viscosity
-
-    INTEGER(iwp) ::  i       !< running index
-    INTEGER(iwp) ::  j       !< running index
-    INTEGER(iwp) ::  m       !< running index
-
-    LOGICAL      ::  flag_exceed_z0  = .FALSE. !< dummy flag to indicate whether roughness length is too high
-    LOGICAL      ::  flag_exceed_z0h = .FALSE. !< dummy flag to indicate whether roughness length for scalars is too high
-
-    REAL(wp), PARAMETER :: alpha_ch  = 0.018_wp !< Charnock constant (0.01-0.11). Use 0.01 for FLake and 0.018 for ECMWF
-!       REAL(wp), PARAMETER :: pr_number = 0.71_wp !< molecular Prandtl number in the Charnock parameterization (differs from
-!                                                  !< prandtl_number)
-!       REAL(wp), PARAMETER :: sc_number = 0.66_wp !< molecular Schmidt number in the Charnock parameterization
-!       REAL(wp) :: re_0 !< near-surface roughness Reynolds number
-
-
-    !$OMP PARALLEL DO PRIVATE (m, i, j) SCHEDULE (STATIC)                                      &
-    !$OMP&            REDUCTION(.OR.:flag_exceed_z0, flag_exceed_z0h)
-    DO  m = 1, surf_lsm_h(0)%ns
-!--    Only upward facin horizontal surfaces are considered for water surface processing
-
-       IF ( surf_lsm_h(0)%water_surface(m) )  THEN
-          i   = surf_lsm_h(0)%i(m)
-          j   = surf_lsm_h(0)%j(m)
-!
-!--       Disabled: FLake parameterization. Ideally, the Charnock coefficient should depend on
-!--       the water depth and the fetch length
-!          re_0 = z0(j,i) * us(j,i) / molecular_viscosity
-!
-!          z0(j,i) = MAX( 0.1_wp * molecular_viscosity / us(j,i),            &
-!                           alpha_ch * us(j,i) / g )
-!
-!          z0h(j,i) = z0(j,i) * EXP( - kappa / pr_number * ( 4.0_wp * SQRT( re_0 ) - 3.2_wp ) )
-!          z0q(j,i) = z0(j,i) * EXP( - kappa / pr_number * ( 4.0_wp * SQRT( re_0 ) - 4.2_wp ) )
-
-!
-!          Set minimum roughness length for u* > 0.2
-!          IF ( us(j,i) > 0.2_wp )  THEN
-!             z0h(j,i) = MAX( 1.0E-5_wp, z0h(j,i) )
-!             z0q(j,i) = MAX( 1.0E-5_wp, z0q(j,i) )
-!          ENDIF
-
-!
-!--       ECMWF IFS model parameterization after Beljaars (1994). At low wind speed, the sea surface
-!--       becomes aerodynamically smooth and the roughness scales with the viscosity. At high wind
-!--       speed, the Charnock relation is used. Add a security factor of 1E-8 to avoid divisions by
-!--       zero.
-          surf_lsm_h(0)%z0(m)  = ( 0.11_wp * molecular_viscosity /                                 &
-                                    ( surf_lsm_h(0)%us(m) + 1E-8_wp ) )                            &
-                                  + ( alpha_ch * surf_lsm_h(0)%us(m)**2 / g )
-
-          surf_lsm_h(0)%z0h(m) = 0.40_wp * molecular_viscosity / ( surf_lsm_h(0)%us(m) + 1E-8_wp )
-          surf_lsm_h(0)%z0q(m) = 0.62_wp * molecular_viscosity / ( surf_lsm_h(0)%us(m) + 1E-8_wp )
-
-
-          IF ( surf_lsm_h(0)%z0(m) > 0.1_wp * surf_lsm_h(0)%z_mo(m) )  THEN
-             surf_lsm_h(0)%z0(m) = 0.1_wp * surf_lsm_h(0)%z_mo(m)
-             flag_exceed_z0   = .TRUE.
-          ENDIF
-
-          IF ( surf_lsm_h(0)%z0h(m) >= 0.1_wp * surf_lsm_h(0)%z_mo(m) )  THEN
-             surf_lsm_h(0)%z0h(m) = 0.1_wp * surf_lsm_h(0)%z_mo(m)
-             flag_exceed_z0h   = .TRUE.
-          ENDIF
-
-          IF ( surf_lsm_h(0)%z0q(m) >= 0.1_wp * surf_lsm_h(0)%z_mo(m) )  THEN
-             surf_lsm_h(0)%z0q(m) = 0.1_wp * surf_lsm_h(0)%z_mo(m)
-             flag_exceed_z0h   = .TRUE.
-          ENDIF
-
-
-       ENDIF
-    ENDDO
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0, 1, MPI_LOGICAL, MPI_LOR, comm2d, ierr)
-#endif
-    IF ( flag_exceed_z0 )  THEN
-       WRITE( message_string, * ) 'z0 exceeds surface-layer height ' //                            &
-                                  'at horizontal sea surface(s) and ' //                           &
-                                  'is decreased appropriately'
-       CALL message( 'land_surface_model_mod', 'PA0508', 0, 0, 0, 6, 0 )
-    ENDIF
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0h, 1, MPI_LOGICAL, MPI_LOR, comm2d, ierr)
-#endif
-    IF ( flag_exceed_z0h )  THEN
-       WRITE( message_string, * ) 'z0h/q exceeds surface-layer height ' //                         &
-                                  'at horizontal sea surface(s) and ' //                           &
-                                  'is decreased appropriately'
-       CALL message( 'land_surface_model_mod', 'PA0508', 0, 0, 0, 6, 0 )
-    ENDIF
-
- END SUBROUTINE calc_z0_water_surface
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!>  Vertical interpolation and extrapolation of 1D soil profile input from dynamic input file onto
-!> the numeric vertical soil grid.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE interpolate_soil_profile( var, var_file, z_grid, z_file, nzb_var, nzt_var, nzb_file,   &
-                                      nzt_file )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k        !< running index z-direction file
-    INTEGER(iwp) ::  kk       !< running index z-direction stretched model grid
-    INTEGER(iwp) ::  ku       !< upper index bound along z-direction for varialbe from file
-    INTEGER(iwp) ::  nzb_var  !< lower bound of final array
-    INTEGER(iwp) ::  nzt_var  !< upper bound of final array
-    INTEGER(iwp) ::  nzb_file !< lower bound of file array
-    INTEGER(iwp) ::  nzt_file !< upper bound of file array
-
-    REAL(wp), DIMENSION(nzb_var:nzt_var)   ::  var      !< treated variable
-    REAL(wp), DIMENSION(nzb_file:nzt_file) ::  var_file !< temporary variable
-    REAL(wp), DIMENSION(nzb_file:nzt_file) ::  z_file   !< grid levels on file grid
-    REAL(wp), DIMENSION(nzb_var:nzt_var)   ::  z_grid   !< grid levels on numeric grid
-
-
-    ku = nzt_file
-
-    DO  k = nzb_var, nzt_var
-!
-!--    Determine index on Inifor grid which is closest to the actual height
-       kk = MINLOC( ABS( z_file - z_grid(k) ), DIM = 1 )
-!
-!--    If closest index on Inifor grid is smaller than top index, interpolate the data.
-       IF ( kk < nzt_file )  THEN
-          IF ( z_file(kk) - z_grid(k) <= 0.0_wp )  THEN
-             var(k) = var_file(kk) + ( var_file(kk+1) - var_file(kk) ) /                           &
-                                     ( z_file(kk+1)   - z_file(kk)   ) *                           &
-                                     ( z_grid(k)      - z_file(kk)   )
-
-          ELSEIF ( z_file(kk) - z_grid(k) > 0.0_wp )  THEN
-             var(k) = var_file(kk-1) + ( var_file(kk) - var_file(kk-1) ) /                         &
-                                       ( z_file(kk)   - z_file(kk-1)   ) *                         &
-                                       ( z_grid(k)    - z_file(kk-1)   )
-          ENDIF
-!
-!--    Extrapolate if actual height is above the highest Inifor level by the last value.
-       ELSE
-          var(k) = var_file(ku)
-       ENDIF
-
-    ENDDO
-
- END SUBROUTINE interpolate_soil_profile
-
-!
-!-- Integrated stability function for heat and moisture
- FUNCTION psi_h( zeta )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    REAL(wp)            ::  psi_h !< Integrated similarity function result
-    REAL(wp)            ::  x     !< dummy variable
-    REAL(wp)            ::  zeta  !< Stability parameter z/L
-
-    REAL(wp), PARAMETER ::  a = 1.0_wp            !< constant
-    REAL(wp), PARAMETER ::  b = 0.66666666666_wp  !< constant
-    REAL(wp), PARAMETER ::  c = 5.0_wp            !< constant
-    REAL(wp), PARAMETER ::  d = 0.35_wp           !< constant
-    REAL(wp), PARAMETER ::  c_d_d = c / d         !< constant
-    REAL(wp), PARAMETER ::  bc_d_d = b * c / d    !< constant
-
-
-    IF ( zeta < 0.0_wp )  THEN
-       x = SQRT( 1.0_wp  - 16.0_wp * zeta )
-       psi_h = 2.0_wp * LOG( (1.0_wp + x ) / 2.0_wp )
-    ELSE
-       psi_h = - b * ( zeta - c_d_d ) * EXP( -d * zeta )                                           &
-               - (1.0_wp + 0.66666666666_wp * a * zeta )**1.5_wp - bc_d_d + 1.0_wp
-!
-!--    Old version for stable conditions (only valid for z/L < 0.5)
-!--    psi_h = - 5.0_wp * zeta
-    ENDIF
-
- END FUNCTION psi_h
-
- END MODULE land_surface_model_mod
Index: palm/trunk/SOURCE/large_scale_forcing_nudging_mod.f90
===================================================================
--- palm/trunk/SOURCE/large_scale_forcing_nudging_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,1406 +1,0 @@
-!> @file large_scale_forcing_nudging_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3719 2019-02-06 13:10:18Z kanani
-! Removed USE cpulog (unused)
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! unused variables removed
-!
-! 2320 2017-07-21 12:47:43Z suehring
-! initial revision
-!
-! Description:
-! ------------
-!> Calculates large scale forcings (geostrophic wind and subsidence velocity) as well as surfaces
-!> fluxes dependent on time given in an external file (LSF_DATA).
-!> Moreover, module contains nudging routines, where u, v, pt and q are nudged  to given profiles on
-!> a relaxation timescale tnudge.
-!> Profiles are read in from NUDGING_DATA.
-!> Code is based on Neggers et al. (2012) and also in parts on DALES and UCLA-LES.
-!> @todo: Revise reading of ASCII-files
-!> @todo: Remove unused variables and control flags
-!> @todo: Revise large-scale facing of surface variables
-!> @todo: Revise control flags lsf_exception, lsf_surf, lsf_vert, etc.
-!--------------------------------------------------------------------------------------------------!
- MODULE lsf_nudging_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzw, diss, e, heatflux_input_conversion, pt, pt_init, q, q_init, s, tend, u, u_init,&
-               ug, v, v_init, vg, w, w_subs, waterflux_input_conversion, zu, zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr, bc_ns, bc_pt_b, bc_q_b, constant_diffusion, constant_heatflux,               &
-               constant_waterflux, data_output_pr, dt_3d, end_time, humidity, initializing_actions,&
-               intermediate_timestep_count, ibc_pt_b, ibc_q_b,                                     &
-               large_scale_forcing, large_scale_subsidence, lsf_surf, lsf_vert, lsf_exception,     &
-               message_string, neutral, nudging, passive_scalar, pt_surface, ocean_mode, q_surface,&
-               surface_heatflux, surface_pressure, surface_waterflux, topography,                  &
-               use_subsidence_tendencies
-
-    USE grid_variables
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, ngp_sums_ls, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nys, nysv, nysg, nyn, nyng,  &
-               nzb, nz, nzt, wall_flags_total_0
-
-    USE kinds
-
-    USE pegrid
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
-
-    USE statistics,                                                                                &
-        ONLY:  hom, statistic_regions, sums_ls_l, weight_substep
-
-    INTEGER(iwp) ::  nlsf = 1000                       !< maximum number of profiles in LSF_DATA (large scale forcing)
-    INTEGER(iwp) ::  ntnudge = 1000                    !< maximum number of profiles in NUDGING_DATA (nudging)
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  p_surf        !< time-dependent surface pressure (large scale forcing)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt_surf       !< time-dependent surface temperature (large scale forcing)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws_surf     !< time-dependent surface latent heat flux (large scale forcing)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  q_surf        !< time-dependent surface water vapor mixing ratio (large scale forcing)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  shf_surf      !< time-dependent surface sensible heat flux (large scale forcing)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  timenudge     !< times at which vertical profiles are defined in NUDGING_DATA (nudging)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  time_surf     !< times at which surface values/fluxes are defined in LSF_DATA (large
-                                                          !< scale forcing)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  time_vert     !< times at which vertical profiles are defined in LSF_DATA (large scale
-                                                          !< forcing)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  tmp_tnudge    !< current nudging time scale
-
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ptnudge     !< vertical profile of pot. temperature interpolated to vertical grid
-                                                          !< (nudging)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qnudge      !< vertical profile of water vapor mixing ratio interpolated to vertical
-                                                          !< grid (nudging)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tnudge      !< vertical profile of nudging time scale interpolated to vertical grid
-                                                          !< (nudging)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  td_lsa_lpt  !< temperature tendency due to large scale advection (large scale forcing)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  td_lsa_q    !< water vapor mixing ratio tendency due to large scale advection (large
-                                                          !< scale forcing)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  td_sub_lpt  !< temperature tendency due to subsidence/ascent (large scale forcing)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  td_sub_q    !< water vapor mixing ratio tendency due to subsidence/ascent (large scale
-                                                          !< forcing)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ug_vert     !< vertical profile of geostrophic wind component in x-direction
-                                                          !< interpolated to vertical grid (large scale forcing)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  unudge      !< vertical profile of wind component in x-direction interpolated to
-                                                          !< vertical grid (nudging)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vnudge      !< vertical profile of wind component in y-direction interpolated to
-                                                          !< vertical grid (nudging)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vg_vert     !< vertical profile of geostrophic wind component in y-direction
-                                                          !< interpolated to vertical grid (large scale forcing)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wnudge      !< vertical profile of subsidence/ascent velocity interpolated to vertical
-                                                          !< grid (nudging) ???
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wsubs_vert  !< vertical profile of wind component in z-direction interpolated to
-                                                          !< vertical grid (nudging) ???
-
-    SAVE
-    PRIVATE
-!
-!-- Public subroutines
-    PUBLIC calc_tnudge, ls_forcing_surf, ls_forcing_vert, ls_advec, lsf_init,                      &
-           lsf_nudging_check_parameters, nudge_init, lsf_nudging_check_data_output_pr,             &
-           lsf_nudging_header, nudge, nudge_ref
-
-!
-!-- Public variables
-    PUBLIC qsws_surf, shf_surf, td_lsa_lpt, td_lsa_q, td_sub_lpt, td_sub_q, time_vert
-
-
-    INTERFACE ls_advec
-       MODULE PROCEDURE ls_advec
-       MODULE PROCEDURE ls_advec_ij
-    END INTERFACE ls_advec
-
-    INTERFACE nudge
-       MODULE PROCEDURE nudge
-       MODULE PROCEDURE nudge_ij
-    END INTERFACE nudge
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE lsf_nudging_check_parameters
-
-       IMPLICIT NONE
-!
-!--    Check nudging and large scale forcing from external file
-       IF ( nudging  .AND.  (  .NOT.  large_scale_forcing ) )  THEN
-          message_string = 'Nudging requires large_scale_forcing = .T.. &'//                       &
-                           'Surface fluxes and geostrophic wind should be &'//                     &
-                           'prescribed in file LSF_DATA'
-          CALL message( 'check_parameters', 'PA0374', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( large_scale_forcing  .AND.  ( bc_lr /= 'cyclic' .OR. bc_ns /= 'cyclic' ) )  THEN
-          message_string = 'Non-cyclic lateral boundaries do not allow for &'//                    &
-                           'the usage of large scale forcing from external file.'
-          CALL message( 'check_parameters', 'PA0375', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( large_scale_forcing  .AND.  ( .NOT. humidity ) )  THEN
-          message_string = 'The usage of large scale forcing from external &'//                    &
-                           'file LSF_DATA requires humidity = .T..'
-          CALL message( 'check_parameters', 'PA0376', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( large_scale_forcing  .AND.  passive_scalar )  THEN
-          message_string = 'The usage of large scale forcing from external &'//                    &
-                           'file LSF_DATA is not implemented for passive scalars'
-          CALL message( 'check_parameters', 'PA0440', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( large_scale_forcing  .AND.  topography /= 'flat'  .AND. .NOT. lsf_exception )  THEN
-          message_string = 'The usage of large scale forcing from external &'//                    &
-                           'file LSF_DATA is not implemented for non-flat topography'
-          CALL message( 'check_parameters', 'PA0377', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( large_scale_forcing  .AND.  ocean_mode )  THEN
-          message_string = 'The usage of large scale forcing from external &'//                    &
-                           'file LSF_DATA is not implemented for ocean mode'
-          CALL message( 'check_parameters', 'PA0378', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    END SUBROUTINE lsf_nudging_check_parameters
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output of profiles for land surface model
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE lsf_nudging_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-       USE profil_parameter
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  unit      !<
-       CHARACTER (LEN=*) ::  variable  !<
-       CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
-
-       INTEGER(iwp) ::  var_count     !<
-
-       SELECT CASE ( TRIM( variable ) )
-
-
-          CASE ( 'td_lsa_thetal' )
-             IF ( .NOT. large_scale_forcing )  THEN
-                message_string = 'data_output_pr = ' //                                            &
-                                 TRIM( data_output_pr(var_count) ) //                              &
-                                 ' is not implemented for ' //                                     &
-                                 'large_scale_forcing = .FALSE.'
-                CALL message( 'lsf_nudging_check_data_output_pr', 'PA0393', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(var_count) = 81
-                dopr_unit             = 'K/s'
-                unit                  = 'K/s'
-                hom(:,2,81,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-
-          CASE ( 'td_lsa_q' )
-             IF ( .NOT. large_scale_forcing )  THEN
-                message_string = 'data_output_pr = ' //                                            &
-                                 TRIM( data_output_pr(var_count) ) //                              &
-                                 ' is not implemented for ' //                                     &
-                                 'large_scale_forcing = .FALSE.'
-                CALL message( 'lsf_nudging_check_data_output_pr', 'PA0393', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(var_count) = 82
-                dopr_unit             = 'kg/kgs'
-                unit                  = 'kg/kgs'
-                hom(:,2,82,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-          CASE ( 'td_sub_thetal' )
-             IF ( .NOT. large_scale_forcing )  THEN
-                message_string = 'data_output_pr = ' //                                            &
-                                 TRIM( data_output_pr(var_count) ) //                              &
-                                 ' is not implemented for ' //                                     &
-                                 'large_scale_forcing = .FALSE.'
-                CALL message( 'lsf_nudging_check_data_output_pr', 'PA0393', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(var_count) = 83
-                dopr_unit             = 'K/s'
-                unit                  = 'K/s'
-                hom(:,2,83,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-
-          CASE ( 'td_sub_q' )
-             IF ( .NOT. large_scale_forcing )  THEN
-                message_string = 'data_output_pr = ' //                                            &
-                                 TRIM( data_output_pr(var_count) ) //                              &
-                                 ' is not implemented for ' //                                     &
-                                 'large_scale_forcing = .FALSE.'
-                CALL message( 'lsf_nudging_check_data_output_pr', 'PA0393', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(var_count) = 84
-                dopr_unit             = 'kg/kgs'
-                unit                  = 'kg/kgs'
-                hom(:,2,84,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-
-          CASE ( 'td_nud_thetal' )
-             IF ( .NOT. nudging )  THEN
-                message_string = 'data_output_pr = ' //                                            &
-                                 TRIM( data_output_pr(var_count) ) //                              &
-                                 ' is not implemented for ' //                                     &
-                                 'nudging = .FALSE.'
-                CALL message( 'lsf_nudging_check_data_output_pr', 'PA0394', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(var_count) = 85
-                dopr_unit             = 'K/s'
-                unit                  = 'K/s'
-                hom(:,2,85,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-
-          CASE ( 'td_nud_q' )
-             IF ( .NOT. nudging )  THEN
-                message_string = 'data_output_pr = ' //                                            &
-                                 TRIM( data_output_pr(var_count) ) //                              &
-                                 ' is not implemented for ' //                                     &
-                                 'nudging = .FALSE.'
-                CALL message( 'lsf_nudging_check_data_output_pr', 'PA0394', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(var_count) = 86
-                dopr_unit             = 'kg/kgs'
-                unit                  = 'kg/kgs'
-                hom(:,2,86,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-
-          CASE ( 'td_nud_u' )
-             IF ( .NOT. nudging )  THEN
-                message_string = 'data_output_pr = ' //                                            &
-                                 TRIM( data_output_pr(var_count) ) //                              &
-                                 ' is not implemented for ' //                                     &
-                                 'nudging = .FALSE.'
-                CALL message( 'lsf_nudging_check_data_output_pr', 'PA0394', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(var_count) = 87
-                dopr_unit             = 'm/s2'
-                unit                  = 'm/s2'
-                hom(:,2,87,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-
-          CASE ( 'td_nud_v' )
-             IF ( .NOT. nudging )  THEN
-                message_string = 'data_output_pr = ' //                                            &
-                                 TRIM( data_output_pr(var_count) ) //                              &
-                                 ' is not implemented for ' //                                     &
-                                 'nudging = .FALSE.'
-                CALL message( 'lsf_nudging_check_data_output_pr', 'PA0394', 1, 2, 0, 6, 0 )
-             ELSE
-                dopr_index(var_count) = 88
-                dopr_unit             = 'm/s2'
-                unit                  = 'm/s2'
-                hom(:,2,88,:) = SPREAD( zu, 2, statistic_regions+1 )
-             ENDIF
-
-
-          CASE DEFAULT
-             unit = 'illegal'
-
-       END SELECT
-
-    END SUBROUTINE lsf_nudging_check_data_output_pr
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE lsf_nudging_header ( io )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp), INTENT(IN) ::  io !< Unit of the output file
-
-       WRITE ( io, 1 )
-       IF ( large_scale_forcing )  THEN
-          WRITE ( io, 3 )
-          WRITE ( io, 4 )
-
-          IF ( large_scale_subsidence )  THEN
-             IF ( .NOT. use_subsidence_tendencies )  THEN
-                WRITE ( io, 5 )
-             ELSE
-                WRITE ( io, 6 )
-             ENDIF
-          ENDIF
-
-          IF ( bc_pt_b == 'dirichlet' )  THEN
-             WRITE ( io, 12 )
-          ELSEIF ( bc_pt_b == 'neumann' )  THEN
-             WRITE ( io, 13 )
-          ENDIF
-
-          IF ( bc_q_b == 'dirichlet' )  THEN
-             WRITE ( io, 14 )
-          ELSEIF ( bc_q_b == 'neumann' )  THEN
-             WRITE ( io, 15 )
-          ENDIF
-
-          WRITE ( io, 7 )
-          IF ( nudging )  THEN
-             WRITE ( io, 10 )
-          ENDIF
-       ELSE
-          WRITE ( io, 2 )
-          WRITE ( io, 11 )
-       ENDIF
-       IF ( large_scale_subsidence )  THEN
-          WRITE ( io, 8 )
-          WRITE ( io, 9 )
-       ENDIF
-
-
-1 FORMAT (//' Large scale forcing and nudging:'/                                                   &
-              ' -------------------------------'/)
-2 FORMAT (' --> No large scale forcing from external is used (default) ')
-3 FORMAT (' --> Large scale forcing from external file LSF_DATA is used: ')
-4 FORMAT ('     - large scale advection tendencies ')
-5 FORMAT ('     - large scale subsidence velocity w_subs ')
-6 FORMAT ('     - large scale subsidence tendencies ')
-7 FORMAT ('     - and geostrophic wind components ug and vg')
-8 FORMAT (' --> Large-scale vertical motion is used in the ',                                      &
-                  'prognostic equation(s) for')
-9 FORMAT ('     the scalar(s) only')
-10 FORMAT (' --> Nudging is used')
-11 FORMAT (' --> No nudging is used (default) ')
-12 FORMAT ('     - prescribed surface values for temperature')
-13 FORMAT ('     - prescribed surface fluxes for temperature')
-14 FORMAT ('     - prescribed surface values for humidity')
-15 FORMAT ('     - prescribed surface fluxes for humidity')
-
-    END SUBROUTINE lsf_nudging_header
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE lsf_init
-
-       IMPLICIT NONE
-
-       CHARACTER(100) ::  chmess      !<
-       CHARACTER(1)   ::  hash        !<
-
-       INTEGER(iwp) ::  ierrn         !<
-       INTEGER(iwp) ::  finput = 90   !<
-       INTEGER(iwp) ::  k             !<
-       INTEGER(iwp) ::  nt            !<
-
-       REAL(wp) ::  fac               !<
-       REAL(wp) ::  high_td_lsa_lpt   !<
-       REAL(wp) ::  high_td_lsa_q     !<
-       REAL(wp) ::  high_td_sub_lpt   !<
-       REAL(wp) ::  high_td_sub_q     !<
-       REAL(wp) ::  highheight        !<
-       REAL(wp) ::  highug_vert       !<
-       REAL(wp) ::  highvg_vert       !<
-       REAL(wp) ::  highwsubs_vert    !<
-       REAL(wp) ::  low_td_lsa_lpt    !<
-       REAL(wp) ::  low_td_lsa_q      !<
-       REAL(wp) ::  low_td_sub_lpt    !<
-       REAL(wp) ::  low_td_sub_q      !<
-       REAL(wp) ::  lowheight         !<
-       REAL(wp) ::  lowug_vert        !<
-       REAL(wp) ::  lowvg_vert        !<
-       REAL(wp) ::  lowwsubs_vert     !<
-       REAL(wp) ::  r_dummy           !<
-
-       ALLOCATE( p_surf(0:nlsf), pt_surf(0:nlsf), q_surf(0:nlsf),                                  &
-                 qsws_surf(0:nlsf), shf_surf(0:nlsf),                                              &
-                 td_lsa_lpt(nzb:nzt+1,0:nlsf), td_lsa_q(nzb:nzt+1,0:nlsf),                         &
-                 td_sub_lpt(nzb:nzt+1,0:nlsf), td_sub_q(nzb:nzt+1,0:nlsf),                         &
-                 time_vert(0:nlsf), time_surf(0:nlsf),                                             &
-                 ug_vert(nzb:nzt+1,0:nlsf), vg_vert(nzb:nzt+1,0:nlsf),                             &
-                 wsubs_vert(nzb:nzt+1,0:nlsf) )
-
-       p_surf = 0.0_wp; pt_surf = 0.0_wp; q_surf = 0.0_wp; qsws_surf = 0.0_wp
-       shf_surf = 0.0_wp; time_vert = 0.0_wp; td_lsa_lpt = 0.0_wp
-       td_lsa_q = 0.0_wp; td_sub_lpt = 0.0_wp; td_sub_q = 0.0_wp
-       time_surf = 0.0_wp; ug_vert = 0.0_wp; vg_vert = 0.0_wp
-       wsubs_vert = 0.0_wp
-
-!
-!--    Array for storing large scale forcing and nudging tendencies at each timestep for data output
-       ALLOCATE( sums_ls_l(nzb:nzt+1,0:7) )
-       sums_ls_l = 0.0_wp
-
-       ngp_sums_ls = (nz+2)*6
-
-       OPEN ( finput, FILE='LSF_DATA', STATUS='OLD', FORM='FORMATTED', IOSTAT=ierrn )
-
-       IF ( ierrn /= 0 )  THEN
-          message_string = 'file LSF_DATA does not exist'
-          CALL message( 'ls_forcing', 'PA0368', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       ierrn = 0
-!
-!--    First three lines of LSF_DATA contain header
-       READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
-       READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
-       READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
-
-       IF ( ierrn /= 0 )  THEN
-          message_string = 'errors in file LSF_DATA'
-          CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    Surface values are read in
-       nt     = 0
-       ierrn = 0
-
-       DO WHILE ( time_surf(nt) < end_time )
-          nt = nt + 1
-          READ ( finput, *, IOSTAT = ierrn ) time_surf(nt), shf_surf(nt), qsws_surf(nt),           &
-                                             pt_surf(nt), q_surf(nt), p_surf(nt)
-
-          IF ( ierrn /= 0 )  THEN
-            WRITE ( message_string, * ) 'No time dependent surface ' //                            &
-                                        'variables in & LSF_DATA for end of run found'
-
-             CALL message( 'ls_forcing', 'PA0363', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDDO
-
-       IF ( time_surf(1) > end_time )  THEN
-          WRITE ( message_string, * ) 'Time dependent surface variables in ' //                    &
-                                      '&LSF_DATA set in after end of ' ,                           &
-                                      'simulation - lsf_surf is set to FALSE'
-          CALL message( 'ls_forcing', 'PA0371', 0, 0, 0, 6, 0 )
-          lsf_surf = .FALSE.
-       ENDIF
-
-!
-!--    Go to the end of the list with surface variables
-       DO WHILE ( ierrn == 0 )
-          READ ( finput, *, IOSTAT = ierrn ) r_dummy
-       ENDDO
-
-!
-!--    Profiles of ug, vg and w_subs are read in (large scale forcing)
-
-       nt = 0
-       DO WHILE ( time_vert(nt) < end_time )
-          nt = nt + 1
-          hash = "#"
-          ierrn = 1 ! not zero
-!
-!--       Search for the next line consisting of "# time", from there onwards the profiles will be
-!--       read.
-          DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) )
-             READ ( finput, *, IOSTAT=ierrn ) hash, time_vert(nt)
-             IF ( ierrn < 0 )  THEN
-                WRITE( message_string, * ) 'No time dependent vertical profiles',                  &
-                                           ' in & LSF_DATA for end of run found'
-                CALL message( 'ls_forcing', 'PA0372', 1, 2, 0, 6, 0 )
-             ENDIF
-          ENDDO
-
-          IF ( nt == 1 .AND. time_vert(nt) > end_time ) EXIT
-
-          READ ( finput, *, IOSTAT=ierrn ) lowheight, lowug_vert, lowvg_vert, lowwsubs_vert,       &
-                                           low_td_lsa_lpt, low_td_lsa_q, low_td_sub_lpt,           &
-                                           low_td_sub_q
-          IF ( ierrn /= 0 )  THEN
-             message_string = 'errors in file LSF_DATA'
-             CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, highvg_vert, highwsubs_vert,   &
-                                           high_td_lsa_lpt, high_td_lsa_q, high_td_sub_lpt,        &
-                                           high_td_sub_q
-
-          IF ( ierrn /= 0 )  THEN
-             message_string = 'errors in file LSF_DATA'
-             CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
-          ENDIF
-
-
-          DO  k = nzb, nzt+1
-             IF ( highheight < zu(k) )  THEN
-                lowheight      = highheight
-                lowug_vert     = highug_vert
-                lowvg_vert     = highvg_vert
-                lowwsubs_vert  = highwsubs_vert
-                low_td_lsa_lpt = high_td_lsa_lpt
-                low_td_lsa_q   = high_td_lsa_q
-                low_td_sub_lpt = high_td_sub_lpt
-                low_td_sub_q   = high_td_sub_q
-
-                ierrn = 0
-                READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, highvg_vert,             &
-                                                 highwsubs_vert, high_td_lsa_lpt, high_td_lsa_q,   &
-                                                 high_td_sub_lpt, high_td_sub_q
-
-                IF ( ierrn /= 0 )  THEN
-                   WRITE( message_string, * ) 'zu(',k,') = ', zu(k), 'm ',                         &
-                                              'is higher than the maximum height in LSF_DATA ',    &
-                                              'which is ', lowheight, 'm. Interpolation on PALM ', &
-                                              'grid is not possible.'
-                   CALL message( 'ls_forcing', 'PA0395', 1, 2, 0, 6, 0 )
-                ENDIF
-
-             ENDIF
-
-!
-!--          Interpolation of prescribed profiles in space
-             fac = (highheight-zu(k))/(highheight - lowheight)
-
-             ug_vert(k,nt)    = fac * lowug_vert    + ( 1.0_wp - fac ) * highug_vert
-             vg_vert(k,nt)    = fac * lowvg_vert    + ( 1.0_wp - fac ) * highvg_vert
-             wsubs_vert(k,nt) = fac * lowwsubs_vert + ( 1.0_wp - fac ) * highwsubs_vert
-
-             td_lsa_lpt(k,nt) = fac * low_td_lsa_lpt + ( 1.0_wp - fac ) * high_td_lsa_lpt
-             td_lsa_q(k,nt)   = fac * low_td_lsa_q   + ( 1.0_wp - fac ) * high_td_lsa_q
-             td_sub_lpt(k,nt) = fac * low_td_sub_lpt + ( 1.0_wp - fac ) * high_td_sub_lpt
-             td_sub_q(k,nt)   = fac * low_td_sub_q   + ( 1.0_wp - fac ) * high_td_sub_q
-
-          ENDDO
-
-       ENDDO
-
-!
-!--    Large scale vertical velocity has to be zero at the surface
-       wsubs_vert(nzb,:) = 0.0_wp
-
-       IF ( time_vert(1) > end_time )  THEN
-          WRITE ( message_string, * ) 'Time dependent large scale profile ',                       &
-                                      'forcing from&LSF_DATA sets in after end of ' ,              &
-                                      'simulation - lsf_vert is set to FALSE'
-          CALL message( 'ls_forcing', 'PA0373', 0, 0, 0, 6, 0 )
-          lsf_vert = .FALSE.
-       ENDIF
-
-       CLOSE( finput )
-
-    END SUBROUTINE lsf_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE ls_forcing_surf ( time )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  nt                     !<
-
-       REAL(wp)             :: dum_surf_flux  !<
-       REAL(wp)             :: fac            !<
-       REAL(wp), INTENT(in) :: time           !<
-
-!
-!--    Interpolation in time of LSF_DATA at the surface
-       nt = 1
-       DO WHILE ( time > time_surf(nt) )
-          nt = nt + 1
-       ENDDO
-       IF ( time /= time_surf(nt) )  THEN
-         nt = nt - 1
-       ENDIF
-
-       fac = ( time -time_surf(nt) ) / ( time_surf(nt+1) - time_surf(nt) )
-
-       IF ( ibc_pt_b == 0 )  THEN
-!
-!--       In case of Dirichlet boundary condition shf must not be set - it is calculated via MOST in
-!--       prandtl_fluxes
-          pt_surface = pt_surf(nt) + fac * ( pt_surf(nt+1) - pt_surf(nt) )
-
-       ELSEIF ( ibc_pt_b == 1 )  THEN
-!
-!--       In case of Neumann boundary condition pt_surface is needed for
-!--       calculation of reference density
-          dum_surf_flux = ( shf_surf(nt) + fac * ( shf_surf(nt+1) - shf_surf(nt) )                 &
-                          ) * heatflux_input_conversion(nzb)
-!
-!--       Save surface sensible heat flux on default, natural and urban surface type, if required.
-          IF ( surf_def_h(0)%ns >= 1 )  surf_def_h(0)%shf(:) = dum_surf_flux
-          IF ( surf_lsm_h(0)%ns >= 1 )  surf_lsm_h(0)%shf(:) = dum_surf_flux
-          IF ( surf_usm_h(0)%ns >= 1 )  surf_usm_h(0)%shf(:) = dum_surf_flux
-
-          pt_surface    = pt_surf(nt) + fac * ( pt_surf(nt+1) - pt_surf(nt) )
-
-       ENDIF
-
-       IF ( ibc_q_b == 0 )  THEN
-!
-!--       In case of Dirichlet boundary condition qsws must not be set - it is calculated via MOST
-!--       in prandtl_fluxes
-          q_surface = q_surf(nt) + fac * ( q_surf(nt+1) - q_surf(nt) )
-
-       ELSEIF ( ibc_q_b == 1 )  THEN
-          dum_surf_flux = ( qsws_surf(nt) + fac * ( qsws_surf(nt+1) - qsws_surf(nt) )              &
-                          ) * waterflux_input_conversion(nzb)
-!
-!--       Save surface sensible heat flux on default, natural and urban surface type, if required
-          IF ( surf_def_h(0)%ns >= 1 )  surf_def_h(0)%qsws(:) = dum_surf_flux
-          IF ( surf_lsm_h(0)%ns >= 1 )  surf_lsm_h(0)%qsws(:) = dum_surf_flux
-          IF ( surf_usm_h(0)%ns >= 1 )  surf_usm_h(0)%qsws(:) = dum_surf_flux
-
-       ENDIF
-!
-!--    Surface heat- and waterflux will be written later onto surface elements
-       IF ( .NOT. neutral  .AND.  constant_heatflux  .AND.                                         &
-            TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-          surface_heatflux = shf_surf(1)
-       ENDIF
-       IF ( humidity  .AND.  constant_waterflux  .AND.                                             &
-            TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-          surface_waterflux = qsws_surf(1)
-       ENDIF
-
-       surface_pressure = p_surf(nt) + fac * ( p_surf(nt+1) - p_surf(nt) )
-
-    END SUBROUTINE ls_forcing_surf
-
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE ls_forcing_vert ( time )
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  nt                     !<
-
-       REAL(wp)             ::  fac           !<
-       REAL(wp), INTENT(in) ::  time          !<
-
-!
-!--    Interpolation in time of LSF_DATA for ug, vg and w_subs
-       nt = 1
-       DO WHILE ( time > time_vert(nt) )
-          nt = nt + 1
-       ENDDO
-       IF ( time /= time_vert(nt) )  THEN
-         nt = nt - 1
-       ENDIF
-
-       fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
-
-       ug     = ug_vert(:,nt) + fac * ( ug_vert(:,nt+1) - ug_vert(:,nt) )
-       vg     = vg_vert(:,nt) + fac * ( vg_vert(:,nt+1) - vg_vert(:,nt) )
-
-       IF ( large_scale_subsidence )  THEN
-          w_subs = wsubs_vert(:,nt) + fac * ( wsubs_vert(:,nt+1) - wsubs_vert(:,nt) )
-       ENDIF
-
-    END SUBROUTINE ls_forcing_vert
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE ls_advec ( time, prog_var )
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  prog_var   !<
-
-       INTEGER(iwp) ::  i               !<
-       INTEGER(iwp) ::  j               !<
-       INTEGER(iwp) ::  k               !<
-       INTEGER(iwp) ::  nt               !<
-
-       REAL(wp) :: fac                  !<
-       REAL(wp), INTENT(in)  :: time    !<
-
-!
-!--    Interpolation in time of LSF_DATA
-       nt = 1
-       DO WHILE ( time > time_vert(nt) )
-          nt = nt + 1
-       ENDDO
-       IF ( time /= time_vert(nt) )  THEN
-         nt = nt - 1
-       ENDIF
-
-       fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
-
-!
-!--    Add horizontal large scale advection tendencies of pt and q
-       SELECT CASE ( prog_var )
-
-          CASE ( 'pt' )
-
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      tend(k,j,i) = tend(k,j,i) + td_lsa_lpt(k,nt) + fac *                         &
-                                       ( td_lsa_lpt(k,nt+1) - td_lsa_lpt(k,nt) ) *                 &
-                                       MERGE( 1.0_wp, 0.0_wp,                                     &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-          CASE ( 'q' )
-
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      tend(k,j,i) = tend(k,j,i) + td_lsa_q(k,nt) + fac *                           &
-                                       ( td_lsa_q(k,nt+1) - td_lsa_q(k,nt) ) *                     &
-                                       MERGE( 1.0_wp, 0.0_wp,                                     &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-       END SELECT
-
-!
-!--    Subsidence of pt and q with prescribed subsidence tendencies
-       IF ( large_scale_subsidence .AND. use_subsidence_tendencies )  THEN
-
-          SELECT CASE ( prog_var )
-
-             CASE ( 'pt' )
-
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb+1, nzt
-                         tend(k,j,i) = tend(k,j,i) + td_sub_lpt(k,nt) + fac *                      &
-                                       ( td_sub_lpt(k,nt+1) - td_sub_lpt(k,nt) ) *                 &
-                                       MERGE( 1.0_wp, 0.0_wp,                                      &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             CASE ( 'q' )
-
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb+1, nzt
-                         tend(k,j,i) = tend(k,j,i) + td_sub_q(k,nt) + fac *                        &
-                                          ( td_sub_q(k,nt+1) - td_sub_q(k,nt) ) *                  &
-                                          MERGE( 1.0_wp, 0.0_wp,                                   &
-                                                 BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-          END SELECT
-
-       ENDIF
-
-    END SUBROUTINE ls_advec
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE ls_advec_ij ( i, j, time, prog_var )
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  prog_var   !<
-
-       INTEGER(iwp) ::  i               !<
-       INTEGER(iwp) ::  j               !<
-       INTEGER(iwp) ::  k               !<
-       INTEGER(iwp) ::  nt              !<
-
-       REAL(wp) :: fac                  !<
-       REAL(wp), INTENT(in)  :: time    !<
-
-
-!
-!--    Interpolation in time of LSF_DATA
-       nt = 1
-       DO WHILE ( time > time_vert(nt) )
-          nt = nt + 1
-       ENDDO
-       IF ( time /= time_vert(nt) )  THEN
-         nt = nt - 1
-       ENDIF
-
-       fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
-
-!
-!--    Add horizontal large scale advection tendencies of pt and q
-       SELECT CASE ( prog_var )
-
-          CASE ( 'pt' )
-
-             DO  k = nzb+1, nzt
-                tend(k,j,i) = tend(k,j,i) + td_lsa_lpt(k,nt)                                       &
-                             + fac * ( td_lsa_lpt(k,nt+1) - td_lsa_lpt(k,nt) )*                    &
-                                        MERGE( 1.0_wp, 0.0_wp,                                     &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-             ENDDO
-
-          CASE ( 'q' )
-
-             DO  k = nzb+1, nzt
-                tend(k,j,i) = tend(k,j,i) + td_lsa_q(k,nt)                                         &
-                              + fac * ( td_lsa_q(k,nt+1) - td_lsa_q(k,nt) ) *                      &
-                                        MERGE( 1.0_wp, 0.0_wp,                                     &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-             ENDDO
-
-       END SELECT
-
-!
-!--    Subsidence of pt and q with prescribed profiles
-       IF ( large_scale_subsidence .AND. use_subsidence_tendencies )  THEN
-
-          SELECT CASE ( prog_var )
-
-             CASE ( 'pt' )
-
-                DO  k = nzb+1, nzt
-                   tend(k,j,i) = tend(k,j,i) + td_sub_lpt(k,nt)                                    &
-                                 + fac * ( td_sub_lpt(k,nt+1) - td_sub_lpt(k,nt) ) *               &
-                                   MERGE( 1.0_wp, 0.0_wp,                                          &
-                                          BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                ENDDO
-
-             CASE ( 'q' )
-
-                DO  k = nzb+1, nzt
-                   tend(k,j,i) = tend(k,j,i) + td_sub_q(k,nt)                                      &
-                                 + fac * ( td_sub_q(k,nt+1) - td_sub_q(k,nt) ) *                   &
-                                   MERGE( 1.0_wp, 0.0_wp,                                          &
-                                          BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                ENDDO
-
-          END SELECT
-
-       ENDIF
-
-    END SUBROUTINE ls_advec_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE nudge_init
-
-       IMPLICIT NONE
-
-       CHARACTER(1) ::  hash     !<
-
-       INTEGER(iwp) ::  finput = 90  !<
-       INTEGER(iwp) ::  ierrn        !<
-       INTEGER(iwp) ::  k            !<
-       INTEGER(iwp) ::  nt            !<
-
-       REAL(wp) ::  fac          !<
-
-       REAL(wp) ::  highheight   !<
-       REAL(wp) ::  highqnudge   !<
-       REAL(wp) ::  highptnudge  !<
-       REAL(wp) ::  hightnudge   !<
-       REAL(wp) ::  highunudge   !<
-       REAL(wp) ::  highvnudge   !<
-       REAL(wp) ::  highwnudge   !<
-
-       REAL(wp) ::  lowheight    !<
-       REAL(wp) ::  lowqnudge    !<
-       REAL(wp) ::  lowptnudge   !<
-       REAL(wp) ::  lowtnudge    !<
-       REAL(wp) ::  lowunudge    !<
-       REAL(wp) ::  lowvnudge    !<
-       REAL(wp) ::  lowwnudge    !<
-
-
-       ALLOCATE( ptnudge(nzb:nzt+1,1:ntnudge), qnudge(nzb:nzt+1,1:ntnudge),                        &
-                 tnudge(nzb:nzt+1,1:ntnudge), unudge(nzb:nzt+1,1:ntnudge),                         &
-                 vnudge(nzb:nzt+1,1:ntnudge), wnudge(nzb:nzt+1,1:ntnudge)  )
-
-       ALLOCATE( tmp_tnudge(nzb:nzt) )
-
-       ALLOCATE( timenudge(0:ntnudge) )
-
-       ptnudge = 0.0_wp; qnudge = 0.0_wp; tnudge = 0.0_wp; unudge = 0.0_wp
-       vnudge = 0.0_wp; wnudge = 0.0_wp; timenudge = 0.0_wp
-!
-!--    Initialize array tmp_nudge with a current nudging time scale of 6 hours
-       tmp_tnudge = 21600.0_wp
-
-       nt = 0
-       OPEN ( finput, FILE='NUDGING_DATA', STATUS='OLD', &
-              FORM='FORMATTED', IOSTAT=ierrn )
-
-       IF ( ierrn /= 0 )  THEN
-          message_string = 'file NUDGING_DATA does not exist'
-          CALL message( 'nudging', 'PA0365', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       ierrn = 0
-
- rloop:DO
-          nt = nt + 1
-          hash = "#"
-          ierrn = 1 ! not zero
-!
-!--       Search for the next line consisting of "# time", from there onwards the profiles will be
-!--       read.
-          DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) )
-
-            READ ( finput, *, IOSTAT=ierrn ) hash, timenudge(nt)
-            IF ( ierrn < 0 )  EXIT rloop
-
-          ENDDO
-
-          ierrn = 0
-          READ ( finput, *, IOSTAT=ierrn ) lowheight, lowtnudge, lowunudge, lowvnudge, lowwnudge , &
-                                           lowptnudge, lowqnudge
-
-          IF ( ierrn /= 0 )  THEN
-             message_string = 'errors in file NUDGING_DATA'
-             CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          ierrn = 0
-          READ ( finput, *, IOSTAT=ierrn ) highheight, hightnudge, highunudge, highvnudge,         &
-                                           highwnudge , highptnudge, highqnudge
-
-          IF ( ierrn /= 0 )  THEN
-             message_string = 'errors in file NUDGING_DATA'
-             CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          DO  k = nzb, nzt+1
-             DO WHILE ( highheight < zu(k) )
-                lowheight  = highheight
-                lowtnudge  = hightnudge
-                lowunudge  = highunudge
-                lowvnudge  = highvnudge
-                lowwnudge  = highwnudge
-                lowptnudge = highptnudge
-                lowqnudge  = highqnudge
-
-                ierrn = 0
-                READ ( finput, *, IOSTAT=ierrn )  highheight , hightnudge , highunudge ,           &
-                                                  highvnudge , highwnudge , highptnudge, highqnudge
-                IF (ierrn /= 0 )  THEN
-                   WRITE( message_string, * ) 'zu(',k,') = ', zu(k), 'm is ',                      &
-                                            'higher than the maximum height in NUDING_DATA which ',&
-                                            'is ', lowheight, 'm. Interpolation on PALM ',         &
-                                            'grid is not possible.'
-                   CALL message( 'nudging', 'PA0364', 1, 2, 0, 6, 0 )
-                ENDIF
-             ENDDO
-
-!
-!--          Interpolation of prescribed profiles in space
-
-             fac = ( highheight - zu(k) ) / ( highheight - lowheight )
-
-             tnudge(k,nt)  = fac * lowtnudge  + ( 1.0_wp - fac ) * hightnudge
-             unudge(k,nt)  = fac * lowunudge  + ( 1.0_wp - fac ) * highunudge
-             vnudge(k,nt)  = fac * lowvnudge  + ( 1.0_wp - fac ) * highvnudge
-             wnudge(k,nt)  = fac * lowwnudge  + ( 1.0_wp - fac ) * highwnudge
-             ptnudge(k,nt) = fac * lowptnudge + ( 1.0_wp - fac ) * highptnudge
-             qnudge(k,nt)  = fac * lowqnudge  + ( 1.0_wp - fac ) * highqnudge
-          ENDDO
-
-       ENDDO rloop
-
-       CLOSE ( finput )
-
-!
-!--    Overwrite initial profiles in case of nudging
-       IF ( nudging )  THEN
-          pt_init = ptnudge(:,1)
-          u_init  = unudge(:,1)
-          v_init  = vnudge(:,1)
-          IF ( humidity  )  THEN ! is passive_scalar correct???
-             q_init = qnudge(:,1)
-          ENDIF
-
-          WRITE( message_string, * ) 'Initial profiles of u, v, pt and q ',                        &
-                                     'from NUDGING_DATA are used.'
-          CALL message( 'large_scale_forcing_nudging', 'PA0370', 0, 0, 0, 6, 0 )
-       ENDIF
-
-
-    END SUBROUTINE nudge_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE calc_tnudge ( time )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  k   !<
-       INTEGER(iwp) ::  nt  !<
-
-       REAL(wp) ::  dtm         !<
-       REAL(wp) ::  dtp         !<
-       REAL(wp) ::  time        !<
-
-       nt = 1
-       DO WHILE ( time > timenudge(nt) )
-         nt = nt+1
-       ENDDO
-       IF ( time /= timenudge(1) ) THEN
-         nt = nt-1
-       ENDIF
-
-       dtm = ( time - timenudge(nt) ) / ( timenudge(nt+1) - timenudge(nt) )
-       dtp = ( timenudge(nt+1) - time ) / ( timenudge(nt+1) - timenudge(nt) )
-
-       DO  k = nzb, nzt
-          tmp_tnudge(k) = MAX( dt_3d, tnudge(k,nt) * dtp + tnudge(k,nt+1) * dtm )
-       ENDDO
-
-    END SUBROUTINE calc_tnudge
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE nudge ( time, prog_var )
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  prog_var  !<
-
-       INTEGER(iwp) ::  i  !<
-       INTEGER(iwp) ::  j  !<
-       INTEGER(iwp) ::  k  !<
-       INTEGER(iwp) ::  nt  !<
-
-       REAL(wp) ::  dtm         !<
-       REAL(wp) ::  dtp         !<
-       REAL(wp) ::  time        !<
-       REAL(wp) ::  tmp_tend    !<
-
-
-       nt = 1
-       DO WHILE ( time > timenudge(nt) )
-         nt = nt+1
-       ENDDO
-       IF ( time /= timenudge(1) ) THEN
-         nt = nt-1
-       ENDIF
-
-       dtm = ( time - timenudge(nt) ) / ( timenudge(nt+1) - timenudge(nt) )
-       dtp = ( timenudge(nt+1) - time ) / ( timenudge(nt+1) - timenudge(nt) )
-
-       SELECT CASE ( prog_var )
-
-          CASE ( 'u' )
-
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-
-                   DO  k = nzb+1, nzt
-
-                      tmp_tend = - ( hom(k,1,1,0) - ( unudge(k,nt) * dtp + unudge(k,nt+1) * dtm ) )&
-                                   / tmp_tnudge(k)
-
-                      tend(k,j,i) = tend(k,j,i)                                                    &
-                                    + tmp_tend * MERGE( 1.0_wp, 0.0_wp,                            &
-                                                        BTEST( wall_flags_total_0(k,j,i), 1 ) )
-
-                      sums_ls_l(k,6) = sums_ls_l(k,6)                                              &
-                                       + tmp_tend * weight_substep(intermediate_timestep_count)
-                   ENDDO
-
-                   sums_ls_l(nzt+1,6) = sums_ls_l(nzt,6)
-
-                ENDDO
-            ENDDO
-
-          CASE ( 'v' )
-
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-
-                   DO  k = nzb+1, nzt
-
-                      tmp_tend = - ( hom(k,1,2,0) - ( vnudge(k,nt) * dtp + vnudge(k,nt+1) * dtm ) )&
-                                   / tmp_tnudge(k)
-
-                      tend(k,j,i) = tend(k,j,i)                                                    &
-                                    + tmp_tend * MERGE( 1.0_wp, 0.0_wp,                            &
-                                                        BTEST( wall_flags_total_0(k,j,i), 2 ) )
-
-                      sums_ls_l(k,7) = sums_ls_l(k,7)                                              &
-                                       + tmp_tend * weight_substep(intermediate_timestep_count)
-                   ENDDO
-
-                   sums_ls_l(nzt+1,7) = sums_ls_l(nzt,7)
-
-                ENDDO
-            ENDDO
-
-          CASE ( 'pt' )
-
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-
-                   DO  k = nzb+1, nzt
-
-                      tmp_tend = - ( hom(k,1,4,0) - ( ptnudge(k,nt) * dtp +                        &
-                                     ptnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
-
-                      tend(k,j,i) = tend(k,j,i)                                                    &
-                                    + tmp_tend * MERGE( 1.0_wp, 0.0_wp,                            &
-                                                        BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                      sums_ls_l(k,4) = sums_ls_l(k,4)                                              &
-                                       + tmp_tend * weight_substep(intermediate_timestep_count)
-                   ENDDO
-
-                   sums_ls_l(nzt+1,4) = sums_ls_l(nzt,4)
-
-                ENDDO
-            ENDDO
-
-          CASE ( 'q' )
-
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-
-                   DO  k = nzb+1, nzt
-
-                      tmp_tend = - ( hom(k,1,41,0) - ( qnudge(k,nt) * dtp +                        &
-                                     qnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
-
-                      tend(k,j,i) = tend(k,j,i)                                                    &
-                                    + tmp_tend * MERGE( 1.0_wp, 0.0_wp,                            &
-                                                        BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                      sums_ls_l(k,5) = sums_ls_l(k,5)                                              &
-                                       + tmp_tend * weight_substep(intermediate_timestep_count)
-                   ENDDO
-
-                   sums_ls_l(nzt+1,5) = sums_ls_l(nzt,5)
-
-                ENDDO
-            ENDDO
-
-          CASE DEFAULT
-             message_string = 'unknown prognostic variable "' // prog_var // '"'
-             CALL message( 'nudge', 'PA0367', 1, 2, 0, 6, 0 )
-
-       END SELECT
-
-    END SUBROUTINE nudge
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-
-    SUBROUTINE nudge_ij( i, j, time, prog_var )
-
-       IMPLICIT NONE
-
-
-       CHARACTER (LEN=*) ::  prog_var  !<
-
-       INTEGER(iwp) ::  i  !<
-       INTEGER(iwp) ::  j  !<
-       INTEGER(iwp) ::  k  !<
-       INTEGER(iwp) ::  nt  !<
-
-       REAL(wp) ::  dtm         !<
-       REAL(wp) ::  dtp         !<
-       REAL(wp) ::  time        !<
-       REAL(wp) ::  tmp_tend    !<
-
-
-       nt = 1
-       DO WHILE ( time > timenudge(nt) )
-         nt = nt+1
-       ENDDO
-       IF ( time /= timenudge(1) )  THEN
-         nt = nt-1
-       ENDIF
-
-       dtm = ( time - timenudge(nt) ) / ( timenudge(nt+1) - timenudge(nt) )
-       dtp = ( timenudge(nt+1) - time ) / ( timenudge(nt+1) - timenudge(nt) )
-
-       SELECT CASE ( prog_var )
-
-          CASE ( 'u' )
-
-             DO  k = nzb+1, nzt
-
-                tmp_tend = - ( hom(k,1,1,0) - ( unudge(k,nt) * dtp + unudge(k,nt+1) * dtm ) )      &
-                             / tmp_tnudge(k)
-
-                tend(k,j,i) = tend(k,j,i)                                                          &
-                              + tmp_tend * MERGE( 1.0_wp, 0.0_wp,                                  &
-                                                  BTEST( wall_flags_total_0(k,j,i), 1 ) )
-
-                sums_ls_l(k,6) = sums_ls_l(k,6)                                                    &
-                                 + tmp_tend * weight_substep(intermediate_timestep_count)
-             ENDDO
-
-             sums_ls_l(nzt+1,6) = sums_ls_l(nzt,6)
-
-          CASE ( 'v' )
-
-             DO  k = nzb+1, nzt
-
-                tmp_tend = - ( hom(k,1,2,0) - ( vnudge(k,nt) * dtp + vnudge(k,nt+1) * dtm ) )      &
-                             / tmp_tnudge(k)
-
-                tend(k,j,i) = tend(k,j,i)                                                          &
-                              + tmp_tend * MERGE( 1.0_wp, 0.0_wp,                                  &
-                                                  BTEST( wall_flags_total_0(k,j,i), 2 ) )
-
-                sums_ls_l(k,7) = sums_ls_l(k,7)                                                    &
-                                 + tmp_tend * weight_substep(intermediate_timestep_count)
-             ENDDO
-
-             sums_ls_l(nzt+1,7) = sums_ls_l(nzt,7)
-
-          CASE ( 'pt' )
-
-             DO  k = nzb+1, nzt
-
-                tmp_tend = - ( hom(k,1,4,0) - ( ptnudge(k,nt) * dtp + ptnudge(k,nt+1) * dtm ) )    &
-                             / tmp_tnudge(k)
-
-                tend(k,j,i) = tend(k,j,i)                                                          &
-                              + tmp_tend * MERGE( 1.0_wp, 0.0_wp,                                  &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                sums_ls_l(k,4) = sums_ls_l(k,4)                                                    &
-                                 + tmp_tend * weight_substep(intermediate_timestep_count)
-             ENDDO
-
-             sums_ls_l(nzt+1,4) = sums_ls_l(nzt,4)
-
-
-          CASE ( 'q' )
-
-             DO  k = nzb+1, nzt
-
-                tmp_tend = - ( hom(k,1,41,0) - ( qnudge(k,nt) * dtp + qnudge(k,nt+1) * dtm ) )     &
-                             / tmp_tnudge(k)
-
-                tend(k,j,i) = tend(k,j,i)                                                          &
-                              + tmp_tend * MERGE( 1.0_wp, 0.0_wp,                                  &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                sums_ls_l(k,5) = sums_ls_l(k,5)                                                    &
-                                 + tmp_tend * weight_substep(intermediate_timestep_count)
-             ENDDO
-
-             sums_ls_l(nzt+1,5) = sums_ls_l(nzt,5)
-
-          CASE DEFAULT
-             message_string = 'unknown prognostic variable "' // prog_var // '"'
-             CALL message( 'nudge', 'PA0367', 1, 2, 0, 6, 0 )
-
-       END SELECT
-
-
-    END SUBROUTINE nudge_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE nudge_ref ( time )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  nt                    !<
-
-       REAL(wp)             ::  fac           !<
-       REAL(wp), INTENT(in) ::  time          !<
-
-!
-!--    Interpolation in time of NUDGING_DATA for pt_init and q_init. This is needed for correct
-!--    upper boundary conditions for pt and q and in case that large scale subsidence as well as
-!--    scalar Rayleigh-damping are used.
-       nt = 1
-       DO WHILE ( time > time_vert(nt) )
-          nt = nt + 1
-       ENDDO
-       IF ( time /= time_vert(nt) )  THEN
-        nt = nt - 1
-       ENDIF
-
-       fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
-
-       pt_init = ptnudge(:,nt) + fac * ( ptnudge(:,nt+1) - ptnudge(:,nt) )
-       q_init  = qnudge(:,nt) + fac * ( qnudge(:,nt+1) - qnudge(:,nt) )
-       u_init  = unudge(:,nt) + fac * ( unudge(:,nt+1) - unudge(:,nt) )
-       v_init  = vnudge(:,nt) + fac * ( vnudge(:,nt+1) - vnudge(:,nt) )
-
-    END SUBROUTINE nudge_ref
-
-
- END MODULE lsf_nudging_mod
Index: palm/trunk/SOURCE/local_getenv.f90
===================================================================
--- palm/trunk/SOURCE/local_getenv.f90	(revision 1)
+++ palm/trunk/SOURCE/local_getenv.f90	(revision 1)
@@ -0,0 +1,66 @@
+ SUBROUTINE local_getenv( var, ivar, value, ivalue )
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: local_getenv.f90,v $
+! Revision 1.5  2003/05/09 14:37:07  raasch
+! On the MUK cluster, only PE0 is able to read environment variables.
+! Therefore, they have to be communicated via broadcast to the other PEs.
+!
+! Revision 1.4  2003/03/16 09:40:22  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.3  2001/01/22 07:23:55  raasch
+! Comments translated into English
+!
+! Revision 1.2  1998/07/16 06:50:50  raasch
+! cpp-Direktiven fuer t3ej2 und t3ej5 erweitert
+!
+! Revision 1.1  1997/08/11 06:21:01  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Getting the values of environment-variabls (for different operating-systems)
+!-------------------------------------------------------------------------------!
+
+#if defined( __lcmuk )
+    USE pegrid
+#endif
+    CHARACTER (LEN=*) ::  var, value
+    INTEGER           ::  ivalue, ivar
+#if defined( __t3eb ) || defined( __t3eh ) || defined( __t3ej2 ) || defined( __t3ej5 )
+    INTEGER           ::  dummy
+#endif
+#if defined( __lcmuk )
+    INTEGER            ::  i, ia(20)
+#endif
+
+#if defined( __t3eb ) || defined( __t3eh ) || defined( __t3ej2 ) || defined( __t3ej5 )
+    CALL PXFGETENV( var(1:ivar), ivar, value, ivalue, dummy )
+    IF ( ivalue == 0 )  value = ''
+#else
+    CALL GETENV( var(1:ivar), value )
+    ivalue = LEN_TRIM( value )
+#endif
+
+#if defined( __lcmuk )  &&  defined( __parallel )
+    ia = IACHAR( ' ' )
+    IF ( myid == 0 )  THEN
+       DO  i = 1, ivalue
+          ia(i) = IACHAR( value(i:i) )
+       ENDDO
+    ENDIF
+    CALL MPI_BCAST( ia(1), 20, MPI_INTEGER, 0, comm2d, ierr )
+    DO  i = 1, 20
+       IF ( ACHAR( ia(i) ) /= ' ' )  value(i:i) = ACHAR( ia(i) )
+    ENDDO
+    ivalue = LEN_TRIM( value )
+#endif
+ END SUBROUTINE local_getenv    
Index: palm/trunk/SOURCE/local_stop.f90
===================================================================
--- palm/trunk/SOURCE/local_stop.f90	(revision 4901)
+++ palm/trunk/SOURCE/local_stop.f90	(revision 1)
@@ -1,40 +1,14 @@
-!> @file local_stop.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE local_stop
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4564 2020-06-12 14:03:36Z raasch
-! Vertical nesting method of Huq et al. (2019) removed
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: misplaced cpp-directive moved
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Added an empty output string to stop keywords to clean up job protocol
+! $Log: local_stop.f90,v $
+! Revision 1.2  2003/03/16 09:40:28  raasch
+! Two underscores (_) are placed in front of all define-strings
 !
 ! Revision 1.1  2002/12/19 15:46:23  raasch
@@ -44,115 +18,14 @@
 ! Description:
 ! ------------
-!> Stop program execution
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE local_stop
-
-#if defined( __parallel )
-
-    USE control_parameters,                                                                        &
-        ONLY:  abort_mode, coupling_mode, coupling_mode_remote, dt_restart, stop_dt,               &
-               terminate_coupled, terminate_coupled_remote, terminate_run, time_restart
+! Stop program execution
+!-------------------------------------------------------------------------------!
 
     USE pegrid
 
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run
-
-
-    IF ( coupling_mode == 'uncoupled' )  THEN
-
-       IF ( nested_run )  THEN
-!
-!--       Workaround: If any of the nested model crashes, it aborts the whole run with MPI_ABORT,
-!--                   regardless of the reason given by abort_mode
-          CALL MPI_ABORT( MPI_COMM_WORLD, 9999, ierr )
-       ELSE
-          IF ( abort_mode == 1 )  THEN
-             CALL MPI_FINALIZE( ierr )
-             STOP 1
-          ELSEIF ( abort_mode == 2 )  THEN
-             CALL MPI_ABORT( comm2d, 9999, ierr )
-          ELSEIF ( abort_mode == 3 )  THEN
-             CALL MPI_ABORT( MPI_COMM_WORLD, 9999, ierr )
-          ENDIF
-       ENDIF
-
-    ELSE
-
-       SELECT CASE ( terminate_coupled_remote )
-
-          CASE ( 0 )
-             IF ( myid == 0 )  THEN
-                PRINT*, '+++ local_stop:'
-                PRINT*, '    local model "', TRIM( coupling_mode ), '" stops now'
-             ENDIF
-!
-!--          Inform the remote model of the termination and its reason, provided the remote model
-!--          has not already been informed of another termination reason (terminate_coupled > 0)
-!--          before.
-             IF ( terminate_coupled == 0 )  THEN
-                terminate_coupled = 1
-                IF ( myid == 0 ) THEN
-                   CALL MPI_SENDRECV(                                                              &
-                        terminate_coupled,        1, MPI_INTEGER, target_id,  0,                   &
-                        terminate_coupled_remote, 1, MPI_INTEGER, target_id,  0,                   &
-                        comm_inter, status, ierr )
-                ENDIF
-                CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_REAL, 0, comm2d, ierr)
-             ENDIF
-             CALL MPI_FINALIZE( ierr )
-             STOP 1
-
-          CASE ( 1 )
-             IF ( myid == 0 )  THEN
-                PRINT*, '+++ local_stop:'
-                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), '" stopped'
-             ENDIF
-             CALL MPI_FINALIZE( ierr )
-             STOP 1
-
-          CASE ( 2 )
-             IF ( myid == 0 )  THEN
-                PRINT*, '+++ local_stop:'
-                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), '" terminated'
-                PRINT*, '    with stop_dt = .T.'
-             ENDIF
-             stop_dt = .TRUE.
-
-          CASE ( 3 )
-             IF ( myid == 0 )  THEN
-                PRINT*, '+++ local_stop:'
-                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), '" terminated'
-                PRINT*, '    with terminate_run = .T. (CPU-time limit)'
-             ENDIF
-             terminate_run = .TRUE.
-
-          CASE ( 4 )
-             IF ( myid == 0 )  THEN
-                PRINT*, '+++ local_stop:'
-                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), '" terminated'
-                PRINT*, '    with terminate_run = .T. (restart)'
-             ENDIF
-             terminate_run = .TRUE.
-             time_restart = time_restart + dt_restart
-
-          CASE ( 5 )
-             IF ( myid == 0 )  THEN
-                PRINT*, '+++ local_stop:'
-                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), '" terminated'
-                PRINT*, '    with terminate_run = .T. (single restart)'
-             ENDIF
-             terminate_run = .TRUE.
-             time_restart = 9999999.9_wp
-
-       END SELECT
-
-    ENDIF
-
-#else
-
-    STOP 1
-
+#if defined( __parallel )
+    CALL MPI_FINALIZE( ierr )
 #endif
 
- END SUBROUTINE local_stop
+    STOP
+
+ END SUBROUTINE local_stop    
Index: palm/trunk/SOURCE/local_system.f90
===================================================================
--- palm/trunk/SOURCE/local_system.f90	(revision 4901)
+++ palm/trunk/SOURCE/local_system.f90	(revision 1)
@@ -1,34 +1,20 @@
-!> @file local_system.f90
-!!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE local_system( command )
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: local_system.f90,v $
+! Revision 1.4  2003/03/16 09:40:33  raasch
+! Two underscores (_) are placed in front of all define-strings
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.3  2001/01/22 07:25:35  raasch
+! Comments translated into English
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
+! Revision 1.2  1998/07/16 06:51:19  raasch
+! cpp-Direktiven fuer t3ej2 und t3ej5 erweitert
 !
 ! Revision 1.1  1997/09/03 06:27:27  raasch
@@ -38,12 +24,14 @@
 ! Description:
 ! ------------
-!> System calls for different operating systems
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE local_system( command )
+! System calls for different operating systems
+!-------------------------------------------------------------------------------!
 
+    CHARACTER (LEN=*) ::  command
 
-    CHARACTER (LEN=*) ::  command !<
+#if defined( __t3eb ) || defined( __t3eh ) || defined( __t3ej2 ) || defined( __t3ej5 )
+    CALL ISHELL( command )
+#else
+    CALL SYSTEM( command )
+#endif
 
-    CALL SYSTEM( command )
-
- END SUBROUTINE local_system
+ END SUBROUTINE local_system    
Index: palm/trunk/SOURCE/local_tremain.f90
===================================================================
--- palm/trunk/SOURCE/local_tremain.f90	(revision 4901)
+++ palm/trunk/SOURCE/local_tremain.f90	(revision 1)
@@ -1,34 +1,48 @@
-!> @file local_tremain.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE local_tremain( remaining_time )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: local_tremain.f90,v $
+! Revision 1.14  2006/06/02 15:20:33  raasch
+! Extended to TIT Sun Fire X4600 System (lctit)
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.13  2003/05/09 14:39:55  raasch
+! Time measurement on IBM is now done using function irtc, which allows correct
+! measurements for jobs running over the 24:00 timeline
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
+! Revision 1.12  2003/03/16 09:41:49  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.11  2003/03/14 13:44:20  raasch
+! Print statement for testing removed
+!
+! Revision 1.10  2003/03/12 16:33:55  raasch
+! Extended to NEC-SX6 systems
+!
+! Revision 1.9  2002/12/19 15:49:17  raasch
+! Extended to IBM-Regatta systems
+!
+! Revision 1.8  2001/03/30 07:35:00  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.7  2001/01/22 08:34:53  raasch
+! Module test_variables removed
+!
+! Revision 1.5  1998/07/16 06:51:44  raasch
+! cpp-Direktiven fuer t3ej2 und t3ej5 erweitert
+!
+! Revision 1.4  1998/07/06 12:19:02  raasch
+! + USE test_variables
+!
+! Revision 1.3  1998/03/24 15:27:23  raasch
+! Zeitbestimmung auf t3eh aufgenommen
+!
+! Revision 1.2  1998/03/23 08:39:53  raasch
+! Bestimmung der verbleibenden Zeit auf vpp ergaenzt
 !
 ! Revision 1.1  1998/03/18 20:14:47  raasch
@@ -38,30 +52,61 @@
 ! Description:
 ! ------------
-!> For different operating systems get the remaining cpu-time of the job
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE local_tremain( remaining_time )
+! For different operating systems get the remaining cpu-time of the job
+!------------------------------------------------------------------------------!
 
-
-    USE control_parameters,                                                                        &
-        ONLY:  maximum_cpu_time_allowed
-
-    USE cpulog,                                                                                    &
-        ONLY:  initial_wallclock_time
-
-    USE kinds
-
+    USE control_parameters
+    USE cpulog
     USE pegrid
 
     IMPLICIT NONE
 
-    INTEGER(idp) ::  count                 !<
-    INTEGER(idp) ::  count_rate            !<
+    REAL ::  remaining_time
+!#if defined( __vpp )
+!    REAL ::  cpu_time_used, rdum
+!#endif
+#if defined( __ibm )
+    INTEGER(8) ::  IRTC
+    REAL       ::  actual_wallclock_time
+#elif defined( __lctit )
+    INTEGER    ::  count, count_rate
+    REAL       ::  actual_wallclock_time
+#endif
 
-    REAL(wp)     ::  current_wallclock_time !<
-    REAL(wp)     ::  remaining_time        !<
+#if defined( __t3eh ) || defined( __t3eb ) || defined( __t3ej2 ) || defined( __t3ej5 )
+
+    CALL MPP_TREMAIN( remaining_time )
+
+!#elif defined( __vpp )
+!
+!    CALL CLOCKV( rdum, cpu_time_used, 0, 2 )
+!    remaining_time = maximum_cpu_time_allowed - cpu_time_used
+
+#elif defined( __ibm )
+
+!    CALL SYSTEM_CLOCK( count, count_rate )
+!    actual_wallclock_time = REAL( count ) / REAL( count_rate )
+    actual_wallclock_time = IRTC( ) * 1E-9
+    remaining_time = maximum_cpu_time_allowed - &
+                     ( actual_wallclock_time - initial_wallclock_time )
+
+#elif defined( __lctit )
 
     CALL SYSTEM_CLOCK( count, count_rate )
-    current_wallclock_time = REAL( count, KIND=wp ) / REAL( count_rate, KIND=wp )
-    remaining_time = maximum_cpu_time_allowed - ( current_wallclock_time - initial_wallclock_time )
+    actual_wallclock_time = REAL( count ) / REAL( count_rate )
+    remaining_time = maximum_cpu_time_allowed - &
+                     ( actual_wallclock_time - initial_wallclock_time )
+
+#elif defined( __nec )
+    
+    CALL TREMAIN( remaining_time )
+    remaining_time = remaining_time / tasks_per_node
+
+#else
+
+!
+!-- No stop due to running out of cpu-time on other machines
+    remaining_time = 9999999.9
+
+#endif
 
  END SUBROUTINE local_tremain
Index: palm/trunk/SOURCE/local_tremain_ini.f90
===================================================================
--- palm/trunk/SOURCE/local_tremain_ini.f90	(revision 4901)
+++ palm/trunk/SOURCE/local_tremain_ini.f90	(revision 1)
@@ -1,34 +1,46 @@
-!> @file local_tremain_ini.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE local_tremain_ini
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
+! $Log: local_tremain_ini.f90,v $
+! Revision 1.13  2007/02/11 13:07:03  raasch
+! Allowed cpu limit is now read from file instead of reading the value from
+! environment variable (see routine parin)
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.12  2006/06/02 15:21:09  raasch
+! Extended to TIT Sun Fire X4600 System (lctit)
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
+! Revision 1.11  2003/05/09 14:40:20  raasch
+! Time measurement on IBM is now done using function irtc, which allows correct
+! measurements for jobs running over the 24:00 timeline
+!
+! Revision 1.10  2003/03/16 09:42:01  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.9  2002/12/19 15:50:31  raasch
+! Measurements extended for IBM
+!
+! Revision 1.8  2001/03/30 07:35:16  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.7  2001/01/22 08:35:38  raasch
+! Module test_variables removed
+!
+! Revision 1.5  1998/07/16 06:52:11  raasch
+! cpp-Direktiven fuer t3ej2 und t3ej5 erweitert
+!
+! Revision 1.4  1998/07/06 12:19:21  raasch
+! + USE test_variables
+!
+! Revision 1.3  1998/03/24 15:27:38  raasch
+! Initialisierung auf t3eh ergaenzt
+!
+! Revision 1.2  1998/03/23 08:40:23  raasch
+! Initialisierung auf vpp ergaenzt
 !
 ! Revision 1.1  1998/03/18 20:15:05  raasch
@@ -38,23 +50,39 @@
 ! Description:
 ! ------------
-!> Initialization of CPU-time measurements for different operating systems
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE local_tremain_ini
+! Initialization of CPU-time measurements for different operating systems
+!------------------------------------------------------------------------------!
 
-
-    USE cpulog,                                                                                    &
-        ONLY:  initial_wallclock_time
-
-    USE kinds
+    USE control_parameters
+    USE cpulog
 
     IMPLICIT NONE
 
-    INTEGER(idp)     ::  count      !<
-    INTEGER(idp)     ::  count_rate !<
+#if defined( __ibm )
+    CHARACTER (LEN=10) ::  value_chr
+    INTEGER            ::  idum
+    INTEGER(8)         ::  IRTC
+#elif defined( __lctit )
+    CHARACTER (LEN=10) ::  value_chr
+    INTEGER            ::  idum
+    INTEGER            ::  count, count_rate
+#endif
+
 
 !
 !-- Get initial wall clock time
+#if defined( __ibm )
+
+    initial_wallclock_time = IRTC( ) * 1E-9
+
+#elif defined( __lctit )
+
     CALL SYSTEM_CLOCK( count, count_rate )
-    initial_wallclock_time = REAL( count, KIND=wp ) / REAL( count_rate, KIND=wp )
+    initial_wallclock_time = REAL( count ) / REAL( count_rate )
+
+#else
+!
+!-- So far, nothing is done on these machines
+#endif
+
 
  END SUBROUTINE local_tremain_ini
Index: palm/trunk/SOURCE/message.f90
===================================================================
--- palm/trunk/SOURCE/message.f90	(revision 4901)
+++ 	(revision )
@@ -1,375 +1,0 @@
-!> @file message.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4580 2020-06-29 07:54:21Z raasch
-! bugfix for aborts in case of nested runs
-!
-! 4578 2020-06-25 15:43:32Z gronemeier
-! bugfix : do not save input values from last call of routines debug_message and location_message
-! changes: layout changes according to PALM coding standards
-!
-! 4536 2020-05-17 17:24:13Z raasch
-! location message format changed
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4097 2019-07-15 11:59:11Z suehring
-! Avoid overlong lines - limit is 132 characters per line
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Improved formatting of job logfile output,
-! changed output of DEBUG file
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Minor formating changes
-!
-! 213 2008-11-13 10:26:18Z raasch
-! Initial revision
-!
-! Description:
-! ------------
-!> Handling of the different kinds of messages.
-!> Meaning of formal parameters:
-!> requested_action: 0 - continue, 1 - abort by stop, 2 - abort by mpi_abort
-!>                   3 - abort by mpi_abort using MPI_COMM_WORLD
-!> message_level: 0 - informative, 1 - warning, 2 - error
-!> output_on_pe: -1 - all, else - output on specified PE
-!> file_id: 6 - stdout (*)
-!> flush_file: 0 - no action, 1 - flush the respective output buffer
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE message( routine_name, message_identifier, requested_action, message_level,            &
-                     output_on_pe, file_id, flush_file )
-
-    USE control_parameters,                                                                        &
-        ONLY:  abort_mode, message_string
-
-    USE kinds
-
-    USE pegrid
-
-    USE pmc_interface,                                                                             &
-        ONLY:  cpl_id, nested_run
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=6)   ::  message_identifier            !<
-    CHARACTER(LEN=20)  ::  nest_string                   !< nest id information
-    CHARACTER(LEN=*)   ::  routine_name                  !<
-    CHARACTER(LEN=200) ::  header_string                 !<
-    CHARACTER(LEN=200) ::  header_string_2               !< for message ID and routine name
-    CHARACTER(LEN=200) ::  information_string_1          !<
-    CHARACTER(LEN=200) ::  information_string_2          !<
-
-    INTEGER(iwp) ::  file_id                             !<
-    INTEGER(iwp) ::  flush_file                          !<
-    INTEGER(iwp) ::  i                                   !<
-    INTEGER(iwp) ::  message_level                       !<
-    INTEGER(iwp) ::  output_on_pe                        !<
-    INTEGER(iwp) ::  requested_action                    !<
-
-    LOGICAL ::  do_output                                !<
-    LOGICAL ::  pe_out_of_range                          !<
-
-
-    do_output       = .FALSE.
-    pe_out_of_range = .FALSE.
-
-!
-!-- In case of nested runs create the nest id informations
-    IF ( nested_run )  THEN
-       WRITE( nest_string, '(1X,A,I2.2)' )  'from nest-id ', cpl_id
-    ELSE
-       nest_string = ''
-    ENDIF
-!
-!-- Create the complete output string, starting with the message level
-    IF ( message_level == 0 )  THEN
-       header_string = '--- informative message' // TRIM(nest_string) // ' ---'
-    ELSEIF ( message_level == 1 )  THEN
-       header_string = '+++ warning message' // TRIM(nest_string) // ' ---'
-    ELSEIF ( message_level == 2 )  THEN
-       header_string = '+++ error message' // TRIM(nest_string) // ' ---'
-    ELSE
-       WRITE( header_string,'(A,I2)' )  '+++ unknown message level' //                             &
-                                        TRIM(nest_string) // ': ', message_level
-    ENDIF
-
-!
-!-- Add the message identifier and the generating routine
-    header_string_2 = 'ID: ' // message_identifier //                                              &
-                      '  generated by routine: ' // TRIM( routine_name )
-
-    information_string_1 = 'Further information can be found at'
-    IF ( message_identifier(1:2) == 'NC' )  THEN
-       information_string_2 = 'http://palm.muk.uni-hannover.de/trac/wiki/doc/app/errmsg#NC'
-    ELSE
-       information_string_2 = 'http://palm.muk.uni-hannover.de/trac/wiki/doc/app/errmsg#' //       &
-                              message_identifier
-    ENDIF
-
-
-!
-!-- Output the output string and the corresponding message string which had been already assigned in
-!-- the calling subroutine.
-!
-!-- First find out if output shall be done on this PE.
-    IF ( output_on_pe == -1 )  THEN
-       do_output = .TRUE.
-    ELSEIF ( myid == output_on_pe )  THEN
-       do_output = .TRUE.
-    ENDIF
-#if defined( __parallel )
-!
-!-- In case of illegal pe number output on pe0
-    IF ( output_on_pe > numprocs-1 )  THEN
-       pe_out_of_range = .TRUE.
-       IF ( myid == 0 )  do_output = .TRUE.
-    ENDIF
-#endif
-
-!
-!-- Now do the output
-    IF ( do_output )  THEN
-
-       IF ( file_id == 6 )  THEN
-!
-!--       Output on stdout
-          WRITE( *, '(16X,A)' )  TRIM( header_string )
-          WRITE( *, '(20X,A)' )  TRIM( header_string_2 )
-!
-!--       Cut message string into pieces and output one piece per line.
-!--       Remove leading blanks.
-          message_string = ADJUSTL( message_string )
-          i = INDEX( message_string, '&' )
-          DO WHILE ( i /= 0 )
-             WRITE( *, '(20X,A)' )  ADJUSTL( message_string(1:i-1) )
-             message_string = ADJUSTL( message_string(i+1:) )
-             i = INDEX( message_string, '&' )
-          ENDDO
-          WRITE( *, '(20X,A)' )  ''
-          WRITE( *, '(20X,A)' )  TRIM( message_string )
-          WRITE( *, '(20X,A)' )  ''
-          WRITE( *, '(20X,A)' )  TRIM( information_string_1 )
-          WRITE( *, '(20X,A)' )  TRIM( information_string_2 )
-          WRITE( *, '(20X,A)' )  ''
-
-       ELSE
-!
-!--       Output on requested file id (file must have been opened elsewhere!)
-          WRITE( file_id, '(A/)' )  TRIM( header_string )
-!
-!--       Cut message string into pieces and output one piece per line.
-!--       Remove leading blanks.
-          message_string = ADJUSTL( message_string )
-          i = INDEX( message_string, '&' )
-          DO WHILE ( i /= 0 )
-             WRITE( file_id, '(4X,A)' )  ADJUSTL( message_string(1:i-1) )
-             message_string = ADJUSTL( message_string(i+1:) )
-             i = INDEX( message_string, '&' )
-          ENDDO
-          WRITE( file_id, '(4X,A)' )  TRIM( message_string )
-          WRITE( file_id, '(4X,A)' )  ''
-          WRITE( file_id, '(4X,A)' )  TRIM( information_string_1 )
-          WRITE( file_id, '(4X,A)' )  TRIM( information_string_2 )
-          WRITE( file_id, '(4X,A)' )  ''
-!
-!--       Flush buffer, if requested
-          IF ( flush_file == 1 )  FLUSH( file_id )
-       ENDIF
-
-       IF ( pe_out_of_range )  THEN
-          WRITE ( *, '(A)' )  '+++ WARNING from routine message:'
-          WRITE ( *, '(A,I6,A)' )  '    PE ', output_on_pe, ' choosed for output is larger '
-          WRITE ( *, '(A,I6)' )  '    than the maximum number of used PEs', numprocs-1
-          WRITE ( *, '(A)' )  '    Output is done on PE0 instead'
-       ENDIF
-
-    ENDIF
-
-!
-!-- Abort execution, if requested
-    IF ( requested_action > 0 )  THEN
-       abort_mode = requested_action
-!
-!--    Since nested runs always use MPI_ABORT, let only the PE which output a message initiate the
-!--    abort. Others just wait.
-       IF ( nested_run  .AND.  requested_action == 1  .AND.  .NOT. do_output )  THEN
-#if defined( __parallel )
-          CALL MPI_BARRIER( comm2d, ierr )
-#endif
-       ELSE
-          CALL local_stop
-       ENDIF
-    ENDIF
-
- END SUBROUTINE message
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prints out the given location on stdout
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE location_message( location, message_type )
-
-    USE, INTRINSIC ::  ISO_FORTRAN_ENV,                                                            &
-        ONLY:  OUTPUT_UNIT
-
-    USE pegrid,                                                                                    &
-        ONLY:  myid
-
-    USE pmc_interface,                                                                             &
-        ONLY:  cpl_id
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)  ::  location             !< text to be output on stdout
-    CHARACTER(LEN=60) ::  location_trimmed     !< trimmed text to be output on stdout
-    CHARACTER(LEN=*)  ::  message_type         !< type of message; supported values: 'start', 'finished'
-    CHARACTER(LEN=10) ::  message_type_string  !< formatted message-type string for output
-    CHARACTER(LEN=8)  ::  system_time          !< formatted system clock time
-    CHARACTER(LEN=10) ::  time                 !< current time of system
-
-!
-!-- Output for nested runs only on the root domain
-    IF ( cpl_id /= 1 )  RETURN
-
-    IF ( myid == 0 )  THEN
-!
-!--    Get system time for debug info output (helpful to estimate the required computing time for
-!--    specific parts of code)
-       CALL date_and_time( TIME=time )
-       system_time = time(1:2) // ':' // time(3:4) // ':' // time(5:6)
-!
-!--    Write message-type string depending on message_type
-       message_type_string = REPEAT( '-', 10 )
-       IF ( TRIM( message_type ) == 'start' )                                                      &
-          message_type_string(2:) = TRIM( message_type ) // '----'
-       IF ( TRIM( message_type ) == 'finished' )                                                   &
-          message_type_string(2:) = TRIM( message_type ) // '-'
-!
-!--    Trim location text to a maximum of 60 chars
-!--    Note: if the length is set within the write format, the string is right-aligned; to trim and
-!--    left-align the output, we need to use this detour
-       WRITE( location_trimmed, '(A)' )  ADJUSTL( TRIM( location ) )
-!
-!--    Write and flush debug location or info message to file
-       WRITE( OUTPUT_UNIT, 200 )  system_time, message_type_string, TRIM( location_trimmed )
-       FLUSH( OUTPUT_UNIT )
-!
-!--    Message formats
-200    FORMAT ( 3X, A, 3x, A, 3X, A )
-
-    ENDIF
-
- END SUBROUTINE location_message
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prints out the given debug information to unit 9 (DEBUG files in temporary directory)
-!> for each PE on each domain.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE debug_message( debug_string, message_type )
-
-    USE control_parameters,                                                                        &
-        ONLY:  time_since_reference_point
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)  ::  debug_string         !< debug message to be output to debug_output_unit
-    CHARACTER(LEN=*)  ::  message_type         !< type of message; supported values: 'start', 'end', 'info'
-    CHARACTER(LEN=7)  ::  message_type_string  !< formatted message-type string for output
-    CHARACTER(LEN=8)  ::  system_time          !< formatted system clock time
-    CHARACTER(LEN=10) ::  time                 !< current time of system
-
-    INTEGER, PARAMETER ::  debug_output_unit = 9
-
-!
-!-- Get system time for debug info output (helpful to estimate the required computing time for
-!-- specific parts of code)
-    CALL date_and_time( TIME=time )
-    system_time = time(1:2) // ':' // time(3:4) // ':' // time(5:6)
-!
-!-- Write message-type string depending on message_type
-    message_type_string = REPEAT( '-', 7 )
-    IF ( TRIM( message_type ) == 'start' )  message_type_string(2:) = TRIM( message_type ) // '-'
-    IF ( TRIM( message_type ) == 'end' )    message_type_string(2:) = TRIM( message_type ) // '---'
-    IF ( TRIM( message_type ) == 'info' )   message_type_string(2:) = TRIM( message_type ) // '--'
-!
-!-- Write and flush debug location or info message to file
-    WRITE( debug_output_unit, 201 )    system_time, time_since_reference_point, &
-                                       message_type_string, TRIM( debug_string )
-    FLUSH( debug_output_unit )
-!
-!-- Message formats
-201 FORMAT ( 'System time: ', A, ' | simulated time (s): ', F12.3, ' | ', A, ' ', A )
-
- END SUBROUTINE debug_message
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Abort routine for failures durin reading of namelists
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE parin_fail_message( location, line )
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  location !< text to be output on stdout
-    CHARACTER(LEN=*) ::  line
-
-    CHARACTER(LEN=80) ::  line_dum
-
-    INTEGER(iwp) ::  line_counter
-
-    line_dum = ' '
-    line_counter = 0
-
-    REWIND( 11 )
-    DO WHILE ( INDEX( line_dum, TRIM(line) ) == 0 )
-       READ ( 11, '(A)', END=20 )  line_dum
-       line_counter = line_counter + 1
-    ENDDO
-
- 20 WRITE( message_string, '(A,I3,A)' ) 'Error(s) in NAMELIST '// TRIM(location) //                &
-                                        '&Reading fails on line ', line_counter, ' at&' // line
-    CALL message( 'parin', 'PA0271', 1, 2, 0, 6, 0 )
-
- END SUBROUTINE parin_fail_message
Index: palm/trunk/SOURCE/mod_kinds.f90
===================================================================
--- palm/trunk/SOURCE/mod_kinds.f90	(revision 4901)
+++ 	(revision )
@@ -1,75 +1,0 @@
-!> @file mod_kinds.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4000 2019-05-24 07:20:44Z raasch
-! preprocessor switch added for choosing the real precision
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
-! 1306 2014-03-13 14:30:59Z raasch
-! Initial revision
-!
-! Description:
-! ------------
-!> Standard kind definitions
-!> wp (working precision) and iwp (integer working precision) are the kinds used by default in all
-!> variable declarations.
-!> By default, PALM is using wp = dp (64bit), and iwp = isp (32bit).
-!> If you like to switch to other precision, then please set wp/iwp appropriately by assigning other
-!> kinds below.
-!--------------------------------------------------------------------------------------------------!
- MODULE kinds
-
-
-    IMPLICIT NONE
-
-!
-!-- Floating point kinds
-    INTEGER, PARAMETER ::  sp = 4           !< single precision (32 bit)
-    INTEGER, PARAMETER ::  dp = 8           !< double precision (64 bit)
-
-!
-!-- Integer kinds
-    INTEGER, PARAMETER ::  isp = SELECTED_INT_KIND(  9 )   !< single precision (32 bit)
-    INTEGER, PARAMETER ::  idp = SELECTED_INT_KIND( 14 )   !< double precision (64 bit)
-
-!
-!-- Set kinds to be used as defaults
-#if defined( __single_precision )
-    INTEGER, PARAMETER ::   wp =  sp          !< default real kind
-#else
-    INTEGER, PARAMETER ::   wp =  dp          !< default real kind
-#endif
-    INTEGER, PARAMETER ::  iwp = isp          !< default integer kind
-
-    SAVE
-
- END MODULE kinds
Index: palm/trunk/SOURCE/mod_particle_attributes.f90
===================================================================
--- palm/trunk/SOURCE/mod_particle_attributes.f90	(revision 4901)
+++ 	(revision )
@@ -1,154 +1,0 @@
-!> @file mod_particle_attributes.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! variables for particle output renamed, id counter removed from particle type
-!
-! 4677 2020-09-14 07:55:28Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4628 2020-07-29 07:23:03Z raasch
-! extensions required for MPI-I/O of particle data to restart files
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4043 2019-06-18 16:59:00Z schwenkel
-! Remove min_nr_particle
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! interoperable C datatypes introduced in particle type to avoid compiler warnings
-!
-! 3720 2019-02-06 13:19:55Z knoop
-! time_prel replaced by last_particle_release_time
-!
-! 1359 2014-04-11 17:15:14Z hoffmann
-! new module containing all particle related variables
-! -dt_sort_particles
-!
-! Description:
-! ------------
-!> Definition of variables used to compute particle transport
-!--------------------------------------------------------------------------------------------------!
- MODULE particle_attributes
-
-    USE, INTRINSIC ::  ISO_C_BINDING
-
-    USE control_parameters,                                                                        &
-        ONLY: varnamelength
-
-    USE kinds
-
-    INTEGER(iwp), PARAMETER ::  max_number_of_particle_groups = 10 !< maximum allowed number of particle groups
-
-    CHARACTER(LEN=64)                           ::  pts_id_file = ''  !< namelist parameter
-    CHARACTER(LEN=varnamelength), DIMENSION(50) ::  data_output_pts = ''    !< namelist parameter
-
-    INTEGER(iwp) ::  dissipation_classes = 10                     !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  ibc_par_b                                    !< particle bottom boundary condition dummy
-    INTEGER(iwp) ::  ibc_par_lr                                   !< particle left/right boundary condition dummy
-    INTEGER(iwp) ::  ibc_par_ns                                   !< particle north/south boundary condition dummy
-    INTEGER(iwp) ::  ibc_par_t                                    !< particle top boundary condition dummy
-    INTEGER(iwp) ::  number_of_output_particles = 0               !< number of output particles
-    INTEGER(iwp) ::  number_of_particles = 0                      !< number of particles for each grid box (3d array is saved on
-                                                                  !< prt_count)
-    INTEGER(iwp) ::  number_of_particle_groups = 1                !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  pts_increment = 1                            !< increment of particles in output file
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  prt_count  !< 3d array of number of particles of every grid box
-
-    LOGICAL ::  particle_advection = .FALSE.              !< parameter to steer the advection of particles
-    LOGICAL ::  unlimited_dimension = .TRUE.              !< umlimited dimension for particle output
-    LOGICAL ::  use_sgs_for_particles = .FALSE.           !< namelist parameter (see documentation)
-    LOGICAL ::  wang_kernel = .FALSE.                     !< flag for collision kernel
-
-    REAL(wp) ::  alloc_factor = 20.0_wp                   !< namelist parameter (see documentation)
-    REAL(wp) ::  oversize = 100.0_wp                      !< reserve spare particles in output file (in % relative to initial
-                                                          !< number)
-    REAL(wp) ::  particle_advection_start = 0.0_wp        !< namelist parameter (see documentation)
-    REAL(wp) ::  pts_percentage = 100.0_wp                !< percentage of particles in output file
-
-    TYPE, PUBLIC ::  particle_type
-        REAL(wp)     ::  aux1             !< auxiliary multi-purpose feature
-        REAL(wp)     ::  aux2             !< auxiliary multi-purpose feature
-        REAL(wp)     ::  radius           !< radius of particle
-        REAL(wp)     ::  age              !< age of particle
-        REAL(wp)     ::  age_m            !<
-        REAL(wp)     ::  dt_sum           !<
-        REAL(wp)     ::  e_m              !< interpolated sgs tke
-        REAL(wp)     ::  origin_x         !< origin x-position of particle (changed cyclic bc)
-        REAL(wp)     ::  origin_y         !< origin y-position of particle (changed cyclic bc)
-        REAL(wp)     ::  origin_z         !< origin z-position of particle (changed cyclic bc)
-        REAL(wp)     ::  rvar1            !<
-        REAL(wp)     ::  rvar2            !<
-        REAL(wp)     ::  rvar3            !<
-        REAL(wp)     ::  speed_x          !< speed of particle in x
-        REAL(wp)     ::  speed_y          !< speed of particle in y
-        REAL(wp)     ::  speed_z          !< speed of particle in z
-        REAL(wp)     ::  weight_factor    !< weighting factor
-        REAL(wp)     ::  x                !< x-position
-        REAL(wp)     ::  y                !< y-position
-        REAL(wp)     ::  z                !< z-position
-        INTEGER(iwp) ::  class            !< radius class needed for collision
-        INTEGER(iwp) ::  group            !< number of particle group
-        INTEGER(idp) ::  id               !< particle ID (64 bit integer)
-        LOGICAL      ::  particle_mask    !< if this parameter is set to false the particle will be deleted
-        INTEGER(iwp) ::  block_nr         !< number for sorting (removable?)
-        INTEGER(iwp) ::  particle_nr=-1   !< particle number for particle IO (increment one
-    END TYPE particle_type
-
-    TYPE(particle_type), DIMENSION(:), POINTER ::  particles      !< Particle array for this grid cell
-    TYPE(particle_type)                        ::  zero_particle  !< zero particle to avoid weird things
-
-    TYPE particle_groups_type
-        SEQUENCE
-        REAL(wp) ::  density_ratio  !< density ratio of the fluid and the particles
-        REAL(wp) ::  radius         !< radius of particle
-        REAL(wp) ::  exp_arg        !< exponential term of particle inertia
-        REAL(wp) ::  exp_term       !< exponential term of particle inertia
-    END TYPE particle_groups_type
-
-    TYPE(particle_groups_type), DIMENSION(max_number_of_particle_groups) ::  particle_groups
-
-    TYPE  grid_particle_def
-        INTEGER(iwp), DIMENSION(0:7)               ::  start_index     !< start particle index for current block
-        INTEGER(iwp), DIMENSION(0:7)               ::  end_index       !< end particle index for current block
-        LOGICAL                                    ::  time_loop_done  !< timestep loop for particle advection
-        TYPE(particle_type), POINTER, DIMENSION(:) ::  particles       !< Particle array for this grid cell
-    END TYPE grid_particle_def
-
-    TYPE(grid_particle_def), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  grid_particles
-
-    TYPE block_offset_def          !<
-        INTEGER(iwp) ::  i_off     !<
-        INTEGER(iwp) ::  j_off     !<
-        INTEGER(iwp) ::  k_off     !<
-    END TYPE block_offset_def
-
-    TYPE(block_offset_def), DIMENSION(0:7)         ::  block_offset
-
-    SAVE
-
-
- END MODULE particle_attributes
Index: palm/trunk/SOURCE/model_1d_mod.f90
===================================================================
--- palm/trunk/SOURCE/model_1d_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,1029 +1,0 @@
-!> @file model_1d_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4586 2020-07-01 16:16:43Z gronemeier
-! renamed Richardson flux number into gradient Richardson number
-!
-! 4449 2020-03-09 14:43:16Z suehring
-! Set intermediate_timestep_count back to zero after 1D-model integration.
-! This is required e.g. for initial calls of calc_mean_profile.
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Modularization of all bulk cloud physics code components
-!
-! Revision 1.1  1998/03/09 16:22:10  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> 1D-model to initialize the 3D-arrays.
-!> The temperature profile is set as steady and a corresponding steady solution
-!> of the wind profile is being computed.
-!> All subroutines required can be found within this file.
-!>
-!> @todo harmonize code with new surface_layer_fluxes module
-!> @bug 1D model crashes when using small grid spacings in the order of 1 m
-!> @fixme option "as_in_3d_model" seems to be an inappropriate option because
-!>        the 1D model uses different turbulence closure approaches at least if
-!>        the 3D model is set to LES-mode.
-!--------------------------------------------------------------------------------------------------!
- MODULE model_1d_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dd2zu, ddzu, ddzw, dzu, dzw, pt_init, q_init, ug, u_init, vg, v_init, zu
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  g, kappa, pi
-
-    USE control_parameters,                                                                        &
-        ONLY:  constant_diffusion, constant_flux_layer, dissipation_1d, f, humidity, ibc_e_b,      &
-               intermediate_timestep_count, intermediate_timestep_count_max, km_constant,          &
-               message_string, mixing_length_1d, prandtl_number, roughness_length,                 &
-               run_description_header, simulated_time_chr, timestep_scheme, tsc, z0h_factor
-
-    USE indices,                                                                                   &
-        ONLY:  nzb, nzb_diff, nzt
-
-    USE kinds
-
-    USE pegrid,                                                                                    &
-        ONLY:  myid
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  current_timestep_number_1d = 0  !< current timestep number (1d-model)
-    INTEGER(iwp) ::  damp_level_ind_1d               !< lower grid index of damping layer (1d-model)
-
-    LOGICAL ::  run_control_header_1d = .FALSE.  !< flag for output of run control header (1d-model)
-    LOGICAL ::  stop_dt_1d = .FALSE.             !< termination flag, used in case of too small timestep (1d-model)
-
-    REAL(wp) ::  alpha_buoyancy                !< model constant according to Koblitz (2013)
-    REAL(wp) ::  c_0 = 0.416179145_wp          !< = 0.03^0.25; model constant according to Koblitz (2013)
-    REAL(wp) ::  c_1 = 1.52_wp                 !< model constant according to Koblitz (2013)
-    REAL(wp) ::  c_2 = 1.83_wp                 !< model constant according to Koblitz (2013)
-    REAL(wp) ::  c_3                           !< model constant
-    REAL(wp) ::  c_mu                          !< model constant
-    REAL(wp) ::  damp_level_1d = -1.0_wp       !< namelist parameter
-    REAL(wp) ::  dt_1d = 60.0_wp               !< dynamic timestep (1d-model)
-    REAL(wp) ::  dt_max_1d = 300.0_wp          !< timestep limit (1d-model)
-    REAL(wp) ::  dt_pr_1d = 9999999.9_wp       !< namelist parameter
-    REAL(wp) ::  dt_run_control_1d = 60.0_wp   !< namelist parameter
-    REAL(wp) ::  end_time_1d = 864000.0_wp     !< namelist parameter
-    REAL(wp) ::  lambda                        !< maximum mixing length
-    REAL(wp) ::  qs1d                          !< characteristic humidity scale (1d-model)
-    REAL(wp) ::  simulated_time_1d = 0.0_wp    !< updated simulated time (1d-model)
-    REAL(wp) ::  sig_diss = 2.95_wp            !< model constant according to Koblitz (2013)
-    REAL(wp) ::  sig_e = 2.95_wp               !< model constant according to Koblitz (2013)
-    REAL(wp) ::  time_pr_1d = 0.0_wp           !< updated simulated time for profile output (1d-model)
-    REAL(wp) ::  time_run_control_1d = 0.0_wp  !< updated simulated time for run-control output (1d-model)
-    REAL(wp) ::  ts1d                          !< characteristic temperature scale (1d-model)
-    REAL(wp) ::  us1d                          !< friction velocity (1d-model)
-    REAL(wp) ::  usws1d                        !< u-component of the momentum flux (1d-model)
-    REAL(wp) ::  vsws1d                        !< v-component of the momentum flux (1d-model)
-    REAL(wp) ::  z01d                          !< roughness length for momentum (1d-model)
-    REAL(wp) ::  z0h1d                         !< roughness length for scalars (1d-model)
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  diss1d   !< tke dissipation rate (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  diss1d_p !< prognostic value of tke dissipation rate (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  e1d      !< tke (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  e1d_p    !< prognostic value of tke (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  kh1d     !< turbulent diffusion coefficient for heat (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  km1d     !< turbulent diffusion coefficient for momentum (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  l1d      !< mixing length for turbulent diffusion coefficients (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  l1d_init !< initial mixing length (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  l1d_diss !< mixing length for dissipation (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ri1d    !< gradient Richardson number (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_diss  !< tendency of diss (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_dissm !< weighted tendency of diss for previous sub-timestep (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_e     !< tendency of e (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_em    !< weighted tendency of e for previous sub-timestep (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_u     !< tendency of u (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_um    !< weighted tendency of u for previous sub-timestep (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_v     !< tendency of v (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_vm    !< weighted tendency of v for previous sub-timestep (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  u1d      !< u-velocity component (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  u1d_p    !< prognostic value of u-velocity component (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  v1d      !< v-velocity component (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  v1d_p    !< prognostic value of v-velocity component (1d-model)
-
-!
-!-- Initialize 1D model
-    INTERFACE init_1d_model
-       MODULE PROCEDURE init_1d_model
-    END INTERFACE init_1d_model
-
-!
-!-- Print profiles
-    INTERFACE print_1d_model
-       MODULE PROCEDURE print_1d_model
-    END INTERFACE print_1d_model
-
-!
-!-- Print run control information
-    INTERFACE run_control_1d
-       MODULE PROCEDURE run_control_1d
-    END INTERFACE run_control_1d
-
-!
-!-- Main procedure
-    INTERFACE time_integration_1d
-       MODULE PROCEDURE time_integration_1d
-    END INTERFACE time_integration_1d
-
-!
-!-- Calculate time step
-    INTERFACE timestep_1d
-       MODULE PROCEDURE timestep_1d
-    END INTERFACE timestep_1d
-
-    SAVE
-
-    PRIVATE
-!
-!-- Public interfaces
-    PUBLIC  init_1d_model
-
-!
-!-- Public variables
-    PUBLIC  damp_level_1d, damp_level_ind_1d, diss1d, dt_pr_1d, dt_run_control_1d, e1d,            &
-            end_time_1d, kh1d, km1d, l1d, ri1d, u1d, us1d, usws1d, v1d, vsws1d
-
-
-    CONTAINS
-
- SUBROUTINE init_1d_model
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=9) ::  time_to_string  !< function to transform time from real to character string
-
-    INTEGER(iwp) ::  k  !< loop index
-
-!
-!-- Allocate required 1D-arrays
-    ALLOCATE( diss1d(nzb:nzt+1), diss1d_p(nzb:nzt+1),                                              &
-              e1d(nzb:nzt+1), e1d_p(nzb:nzt+1), kh1d(nzb:nzt+1),                                   &
-              km1d(nzb:nzt+1), l1d(nzb:nzt+1), l1d_init(nzb:nzt+1),                                &
-              l1d_diss(nzb:nzt+1), ri1d(nzb:nzt+1), te_diss(nzb:nzt+1),                            &
-              te_dissm(nzb:nzt+1), te_e(nzb:nzt+1),                                                &
-              te_em(nzb:nzt+1), te_u(nzb:nzt+1), te_um(nzb:nzt+1),                                 &
-              te_v(nzb:nzt+1), te_vm(nzb:nzt+1), u1d(nzb:nzt+1),                                   &
-              u1d_p(nzb:nzt+1),  v1d(nzb:nzt+1), v1d_p(nzb:nzt+1) )
-
-!
-!-- Initialize arrays
-    IF ( constant_diffusion )  THEN
-       km1d = km_constant
-       kh1d = km_constant / prandtl_number
-    ELSE
-       diss1d = 0.0_wp; diss1d_p = 0.0_wp
-       e1d = 0.0_wp; e1d_p = 0.0_wp
-       kh1d = 0.0_wp; km1d = 0.0_wp
-       ri1d = 0.0_wp
-!
-!--    Compute the mixing length
-       l1d_init(nzb) = 0.0_wp
-
-       IF ( TRIM( mixing_length_1d ) == 'blackadar' )  THEN
-!
-!--       Blackadar mixing length
-          IF ( f /= 0.0_wp )  THEN
-             lambda = 2.7E-4_wp * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) / ABS( f ) + 1E-10_wp
-          ELSE
-             lambda = 30.0_wp
-          ENDIF
-
-          DO  k = nzb+1, nzt+1
-             l1d_init(k) = kappa * zu(k) / ( 1.0_wp + kappa * zu(k) / lambda )
-          ENDDO
-
-       ELSEIF ( TRIM( mixing_length_1d ) == 'as_in_3d_model' )  THEN
-!
-!--       Use the same mixing length as in 3D model (LES-mode)
-          !> @todo rename (delete?) this option
-          !>  As the mixing length is different between RANS and LES mode, it
-          !>  must be distinguished here between these modes. For RANS mode,
-          !>  the mixing length is calculated accoding to Blackadar, which is
-          !>  the other option at this point.
-          !>  Maybe delete this option entirely (not appropriate in LES case)
-          !>  2018-03-20, gronemeier
-          DO  k = nzb+1, nzt
-             l1d_init(k)  = ( dx * dy * dzw(k) )**0.33333333333333_wp
-          ENDDO
-          l1d_init(nzt+1) = l1d_init(nzt)
-
-       ENDIF
-    ENDIF
-    l1d      = l1d_init
-    l1d_diss = l1d_init
-    u1d      = u_init
-    u1d_p    = u_init
-    v1d      = v_init
-    v1d_p    = v_init
-
-!
-!-- Set initial horizontal velocities at the lowest grid levels to a very small value in order to
-!-- avoid too small time steps caused by the diffusion limit in the initial phase of a run (at k=1,
-!-- dz/2 occurs in the limiting formula!)
-    u1d(0:1)   = 0.1_wp
-    u1d_p(0:1) = 0.1_wp
-    v1d(0:1)   = 0.1_wp
-    v1d_p(0:1) = 0.1_wp
-
-!
-!-- For u*, theta* and the momentum fluxes plausible values are set
-    IF ( constant_flux_layer )  THEN
-       us1d = 0.1_wp   ! without initial friction the flow would not change
-    ELSE
-       diss1d(nzb+1) = 0.001_wp
-       e1d(nzb+1)  = 1.0_wp
-       km1d(nzb+1) = 1.0_wp
-       us1d = 0.0_wp
-    ENDIF
-    ts1d = 0.0_wp
-    usws1d = 0.0_wp
-    vsws1d = 0.0_wp
-    z01d  = roughness_length
-    z0h1d = z0h_factor * z01d
-    IF ( humidity )  qs1d = 0.0_wp
-
-!
-!-- Tendencies must be preset in order to avoid runtime errors
-    te_diss  = 0.0_wp
-    te_dissm = 0.0_wp
-    te_e  = 0.0_wp
-    te_em = 0.0_wp
-    te_um = 0.0_wp
-    te_vm = 0.0_wp
-
-!
-!-- Set model constant
-    IF ( dissipation_1d == 'as_in_3d_model' )  c_0 = 0.1_wp
-    c_mu = c_0**4
-
-!
-!-- Set start time in hh:mm:ss - format
-    simulated_time_chr = time_to_string( simulated_time_1d )
-
-!
-!-- Integrate the 1D-model equations using the Runge-Kutta scheme
-    CALL time_integration_1d
-
-
- END SUBROUTINE init_1d_model
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Runge-Kutta time differencing scheme for the 1D-model.
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE time_integration_1d
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=9) ::  time_to_string  !< function to transform time from real to character string
-
-    INTEGER(iwp) ::  k  !< loop index
-
-    REAL(wp) ::  a            !< auxiliary variable
-    REAL(wp) ::  b            !< auxiliary variable
-    REAL(wp) ::  dpt_dz       !< vertical temperature gradient
-    REAL(wp) ::  flux         !< vertical temperature gradient
-    REAL(wp) ::  kmzm         !< Km(z-dz/2)
-    REAL(wp) ::  kmzp         !< Km(z+dz/2)
-    REAL(wp) ::  l_stable     !< mixing length for stable case
-    REAL(wp) ::  pt_0         !< reference temperature
-    REAL(wp) ::  uv_total     !< horizontal wind speed
-
-!
-!-- Determine the time step at the start of a 1D-simulation and determine and printout quantities
-!-- used for run control
-    dt_1d = 0.01_wp
-    CALL run_control_1d
-
-!
-!-- Start of time loop
-    DO  WHILE ( simulated_time_1d < end_time_1d  .AND.  .NOT. stop_dt_1d )
-
-!
-!--    Depending on the timestep scheme, carry out one or more intermediate timesteps
-
-       intermediate_timestep_count = 0
-       DO  WHILE ( intermediate_timestep_count < intermediate_timestep_count_max )
-
-          intermediate_timestep_count = intermediate_timestep_count + 1
-
-          CALL timestep_scheme_steering
-
-!
-!--       Compute all tendency terms. If a constant-flux layer is simulated, k starts at nzb+2.
-          DO  k = nzb_diff, nzt
-
-             kmzm = 0.5_wp * ( km1d(k-1) + km1d(k) )
-             kmzp = 0.5_wp * ( km1d(k) + km1d(k+1) )
-!
-!--          u-component
-             te_u(k) =  f * ( v1d(k) - vg(k) ) + (                                                 &
-                              kmzp * ( u1d(k+1) - u1d(k) ) * ddzu(k+1)                             &
-                            - kmzm * ( u1d(k) - u1d(k-1) ) * ddzu(k)                               &
-                                                 ) * ddzw(k)
-!
-!--          v-component
-             te_v(k) = -f * ( u1d(k) - ug(k) ) + (                                                 &
-                              kmzp * ( v1d(k+1) - v1d(k) ) * ddzu(k+1)                             &
-                            - kmzm * ( v1d(k) - v1d(k-1) ) * ddzu(k)                               &
-                                                 ) * ddzw(k)
-          ENDDO
-          IF ( .NOT. constant_diffusion )  THEN
-             DO  k = nzb_diff, nzt
-!
-!--             TKE and dissipation rate
-                kmzm = 0.5_wp * ( km1d(k-1) + km1d(k) )
-                kmzp = 0.5_wp * ( km1d(k) + km1d(k+1) )
-                IF ( .NOT. humidity )  THEN
-                   pt_0 = pt_init(k)
-                   flux =  ( pt_init(k+1)-pt_init(k-1) ) * dd2zu(k)
-                ELSE
-                   pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) )
-                   flux = ( ( pt_init(k+1) - pt_init(k-1) ) +                                      &
-                            0.61_wp * ( pt_init(k+1) * q_init(k+1) -                               &
-                                        pt_init(k-1) * q_init(k-1)   )                             &
-                          ) * dd2zu(k)
-                ENDIF
-
-!
-!--             Calculate dissipation rate if no prognostic equation is used for dissipation rate.
-                IF ( dissipation_1d == 'detering' )  THEN
-                   diss1d(k) = c_0**3 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
-                ELSEIF ( dissipation_1d == 'as_in_3d_model' )  THEN
-                   diss1d(k) = ( 0.19_wp + 0.74_wp * l1d_diss(k) / l1d_init(k) )                   &
-                               * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
-                ENDIF
-!
-!--             TKE
-                te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2                    &
-                                    + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2                    &
-                                    )                                                              &
-                                    - g / pt_0 * kh1d(k) * flux                                    &
-                                    +            (                                                 &
-                                     kmzp * ( e1d(k+1) - e1d(k) ) * ddzu(k+1)                      &
-                                   - kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k)                        &
-                                                 ) * ddzw(k) / sig_e                               &
-                                   - diss1d(k)
-
-                IF ( dissipation_1d == 'prognostic' )  THEN
-!
-!--                dissipation rate
-                   IF ( ri1d(k) >= 0.0_wp )  THEN
-                      alpha_buoyancy = 1.0_wp - l1d(k) / lambda
-                   ELSE
-                      alpha_buoyancy = 1.0_wp - ( 1.0_wp + ( c_2 - 1.0_wp )                        &
-                                                         / ( c_2 - c_1    ) )                      &
-                                              * l1d(k) / lambda
-                   ENDIF
-                   c_3 = ( c_1 - c_2 ) * alpha_buoyancy + 1.0_wp
-                   te_diss(k) = ( km1d(k) *                                                        &
-                                  ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2                      &
-                                  + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2                      &
-                                  ) * ( c_1 + (c_2 - c_1) * l1d(k) / lambda )                      &
-                                  - g / pt_0 * kh1d(k) * flux * c_3                                &
-                                  - c_2 * diss1d(k)                                                &
-                                ) * diss1d(k) / ( e1d(k) + 1.0E-20_wp )                            &
-                                + (   kmzp * ( diss1d(k+1) - diss1d(k) )                           &
-                                           * ddzu(k+1)                                             &
-                                    - kmzm * ( diss1d(k) - diss1d(k-1) )                           &
-                                           * ddzu(k)                                               &
-                                  ) * ddzw(k) / sig_diss
-
-                ENDIF
-
-             ENDDO
-          ENDIF
-
-!
-!--       Tendency terms at the top of the constant-flux layer.
-!--       Finite differences of the momentum fluxes are computed using half the normal grid length
-!--       (2.0*ddzw(k)) for the sake of enhanced accuracy
-          IF ( constant_flux_layer )  THEN
-
-             k = nzb+1
-             kmzm = 0.5_wp * ( km1d(k-1) + km1d(k) )
-             kmzp = 0.5_wp * ( km1d(k) + km1d(k+1) )
-             IF ( .NOT. humidity )  THEN
-                pt_0 = pt_init(k)
-                flux =  ( pt_init(k+1)-pt_init(k-1) ) * dd2zu(k)
-             ELSE
-                pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) )
-                flux = ( ( pt_init(k+1) - pt_init(k-1) ) +                                         &
-                         0.61_wp * ( pt_init(k+1) * q_init(k+1) -                                  &
-                                     pt_init(k-1) * q_init(k-1)   )                                &
-                       ) * dd2zu(k)
-             ENDIF
-
-!
-!--          Calculate dissipation rate if no prognostic equation is used for dissipation rate.
-             IF ( dissipation_1d == 'detering' )  THEN
-                diss1d(k) = c_0**3 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
-             ELSEIF ( dissipation_1d == 'as_in_3d_model' )  THEN
-                diss1d(k) = ( 0.19_wp + 0.74_wp * l1d_diss(k) / l1d_init(k) )                      &
-                            * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
-             ENDIF
-
-!
-!--          u-component
-             te_u(k) = f * ( v1d(k) - vg(k) ) + (                                                  &
-                       kmzp * ( u1d(k+1) - u1d(k) ) * ddzu(k+1) + usws1d                           &
-                                                ) * 2.0_wp * ddzw(k)
-!
-!--          v-component
-             te_v(k) = -f * ( u1d(k) - ug(k) ) + (                                                 &
-                       kmzp * ( v1d(k+1) - v1d(k) ) * ddzu(k+1) + vsws1d                           &
-                                                 ) * 2.0_wp * ddzw(k)
-!
-!--          TKE
-             IF ( .NOT. dissipation_1d == 'prognostic' )  THEN
-                !> @query why integrate over 2dz
-                !>   Why is it allowed to integrate over two delta-z for e
-                !>   while for u and v it is not?
-                !>   2018-04-23, gronemeier
-                te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2                    &
-                                    + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2                    &
-                                    )                                                              &
-                                    - g / pt_0 * kh1d(k) * flux                                    &
-                                    +           (                                                  &
-                                     kmzp * ( e1d(k+1) - e1d(k) ) * ddzu(k+1)                      &
-                                   - kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k)                        &
-                                                 ) * ddzw(k) / sig_e                               &
-                                   - diss1d(k)
-             ENDIF
-
-          ENDIF
-
-!
-!--       Prognostic equations for all 1D variables
-          DO  k = nzb+1, nzt
-
-             u1d_p(k) = u1d(k) + dt_1d * ( tsc(2) * te_u(k) + tsc(3) * te_um(k) )
-             v1d_p(k) = v1d(k) + dt_1d * ( tsc(2) * te_v(k) + tsc(3) * te_vm(k) )
-
-          ENDDO
-          IF ( .NOT. constant_diffusion )  THEN
-
-             DO  k = nzb+1, nzt
-                e1d_p(k) = e1d(k) + dt_1d * ( tsc(2) * te_e(k) + tsc(3) * te_em(k) )
-             ENDDO
-
-!
-!--          Eliminate negative TKE values, which can result from the integration due to numerical
-!--          inaccuracies. In such cases the TKE value is reduced to 10 percent of its old value.
-             WHERE ( e1d_p < 0.0_wp )  e1d_p = 0.1_wp * e1d
-
-             IF ( dissipation_1d == 'prognostic' )  THEN
-                DO  k = nzb+1, nzt
-                   diss1d_p(k) = diss1d(k) + dt_1d * ( tsc(2) * te_diss(k) + tsc(3) * te_dissm(k) )
-                ENDDO
-                WHERE ( diss1d_p < 0.0_wp )  diss1d_p = 0.1_wp * diss1d
-             ENDIF
-          ENDIF
-
-!
-!--       Calculate tendencies for the next Runge-Kutta step
-          IF ( timestep_scheme(1:5) == 'runge' ) THEN
-             IF ( intermediate_timestep_count == 1 )  THEN
-
-                DO  k = nzb+1, nzt
-                   te_um(k) = te_u(k)
-                   te_vm(k) = te_v(k)
-                ENDDO
-
-                IF ( .NOT. constant_diffusion )  THEN
-                   DO k = nzb+1, nzt
-                      te_em(k) = te_e(k)
-                   ENDDO
-                   IF ( dissipation_1d == 'prognostic' )  THEN
-                      DO k = nzb+1, nzt
-                         te_dissm(k) = te_diss(k)
-                      ENDDO
-                   ENDIF
-                ENDIF
-
-             ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-
-                DO  k = nzb+1, nzt
-                   te_um(k) = -9.5625_wp * te_u(k) + 5.3125_wp * te_um(k)
-                   te_vm(k) = -9.5625_wp * te_v(k) + 5.3125_wp * te_vm(k)
-                ENDDO
-
-                IF ( .NOT. constant_diffusion )  THEN
-                   DO k = nzb+1, nzt
-                      te_em(k) = -9.5625_wp * te_e(k) + 5.3125_wp * te_em(k)
-                   ENDDO
-                   IF ( dissipation_1d == 'prognostic' )  THEN
-                      DO k = nzb+1, nzt
-                         te_dissm(k) = -9.5625_wp * te_diss(k) + 5.3125_wp * te_dissm(k)
-                      ENDDO
-                   ENDIF
-                ENDIF
-
-             ENDIF
-          ENDIF
-
-!
-!--       Boundary conditions for the prognostic variables.
-!--       At the top boundary (nzt+1) u, v, e, and diss keep their initial values (ug(nzt+1),
-!--       vg(nzt+1), 0, 0).
-!--       At the bottom boundary, Dirichlet condition is used for u and v (0) and Neumann condition
-!--       for e and diss (e(nzb)=e(nzb+1)).
-          u1d_p(nzb) = 0.0_wp
-          v1d_p(nzb) = 0.0_wp
-
-!
-!--       Swap the time levels in preparation for the next time step.
-          u1d  = u1d_p
-          v1d  = v1d_p
-          IF ( .NOT. constant_diffusion )  THEN
-             e1d  = e1d_p
-             IF ( dissipation_1d == 'prognostic' )  THEN
-                diss1d = diss1d_p
-             ENDIF
-          ENDIF
-
-!
-!--       Compute diffusion quantities
-          IF ( .NOT. constant_diffusion )  THEN
-
-!
-!--          First compute the vertical fluxes in the constant-flux layer
-             IF ( constant_flux_layer )  THEN
-!
-!--             Compute theta* using Ri numbers of the previous time step
-                IF ( ri1d(nzb+1) >= 0.0_wp )  THEN
-!
-!--                Stable stratification
-                   ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) /                              &
-                          ( LOG( zu(nzb+1) / z0h1d ) + 5.0_wp * ri1d(nzb+1) *                      &
-                                          ( zu(nzb+1) - z0h1d ) / zu(nzb+1)                        &
-                          )
-                ELSE
-!
-!--                Unstable stratification
-                   a = SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) )
-                   b = SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) / zu(nzb+1) * z0h1d )
-
-                   ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) /                              &
-                          LOG( (a-1.0_wp) / (a+1.0_wp) * (b+1.0_wp) / (b-1.0_wp) )
-                ENDIF
-
-             ENDIF    ! constant_flux_layer
-             !> @todo combine if clauses
-             !>   The previous and following if clauses can be combined into a
-             !>   single clause
-             !>   2018-04-23, gronemeier
-!
-!--          Compute the gradient Richardson numbers,
-!--          first at the top of the constant-flux layer using u* of the previous time step
-!--          (+1E-30, if u* = 0), then in the remaining area.
-!--          There, the Ri numbers of the previous time step are used.
-
-             IF ( constant_flux_layer )  THEN
-                IF ( .NOT. humidity )  THEN
-                   pt_0 = pt_init(nzb+1)
-                   flux = ts1d
-                ELSE
-                   pt_0 = pt_init(nzb+1) * ( 1.0_wp + 0.61_wp * q_init(nzb+1) )
-                   flux = ts1d + 0.61_wp * pt_init(k) * qs1d
-                ENDIF
-                ri1d(nzb+1) = zu(nzb+1) * kappa * g * flux / ( pt_0 * ( us1d**2 + 1E-30_wp ) )
-             ENDIF
-
-             DO  k = nzb_diff, nzt
-                IF ( .NOT. humidity )  THEN
-                   pt_0 = pt_init(k)
-                   flux = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k)
-                ELSE
-                   pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) )
-                   flux = ( ( pt_init(k+1) - pt_init(k-1) )                                        &
-                            + 0.61_wp                                                              &
-                            * (   pt_init(k+1) * q_init(k+1)                                       &
-                                - pt_init(k-1) * q_init(k-1) )                                     &
-                          ) * dd2zu(k)
-                ENDIF
-                IF ( ri1d(k) >= 0.0_wp )  THEN
-                   ri1d(k) = g / pt_0 * flux /                                                     &
-                              (  ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2                         &
-                               + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2                         &
-                               + 1E-30_wp                                                          &
-                              )
-                ELSE
-                   ri1d(k) = g / pt_0 * flux /                                                     &
-                              (  ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2                         &
-                               + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2                         &
-                               + 1E-30_wp                                                          &
-                              ) * ( 1.0_wp - 16.0_wp * ri1d(k) )**0.25_wp
-                ENDIF
-             ENDDO
-!
-!--          Richardson numbers must remain restricted to a realistic value range. It is exceeded
-!--           excessively for very small velocities (u,v --> 0).
-             WHERE ( ri1d < -5.0_wp )  ri1d = -5.0_wp
-             WHERE ( ri1d > 1.0_wp )  ri1d = 1.0_wp
-
-!
-!--          Compute u* from the absolute velocity value
-             IF ( constant_flux_layer )  THEN
-                uv_total = SQRT( u1d(nzb+1)**2 + v1d(nzb+1)**2 )
-
-                IF ( ri1d(nzb+1) >= 0.0_wp )  THEN
-!
-!--                Stable stratification
-                   us1d = kappa * uv_total / ( LOG( zu(nzb+1) / z01d )                             &
-                                               + 5.0_wp * ri1d(nzb+1) * ( zu(nzb+1) - z01d )       &
-                                                 / zu(nzb+1)                                       &
-                                             )
-                ELSE
-!
-!--                Unstable stratification
-                   a = 1.0_wp / SQRT( SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) ) )
-                   b = 1.0_wp / SQRT( SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) / zu(nzb+1) * z01d ) )
-                   us1d = kappa * uv_total / ( LOG( (1.0_wp+b) / (1.0_wp-b) * (1.0_wp-a) /         &
-                                                    (1.0_wp+a) ) +                                 &
-                                               2.0_wp * ( ATAN( b ) - ATAN( a ) )                  &
-                                             )
-                ENDIF
-
-!
-!--             Compute the momentum fluxes for the diffusion terms
-                usws1d  = - u1d(nzb+1) / uv_total * us1d**2
-                vsws1d  = - v1d(nzb+1) / uv_total * us1d**2
-
-!
-!--             Boundary condition for the turbulent kinetic energy and dissipation rate at the top
-!--             of the constant-flux layer.
-!--             Additional Neumann condition de/dz = 0 at nzb is set to ensure compatibility with
-!--             the 3D model.
-                IF ( ibc_e_b == 2 )  THEN
-                   e1d(nzb+1) = ( us1d / c_0 )**2
-                ENDIF
-                IF ( dissipation_1d == 'prognostic' )  THEN
-                   e1d(nzb+1) = ( us1d / c_0 )**2
-                   diss1d(nzb+1) = us1d**3 / ( kappa * zu(nzb+1) )
-                   diss1d(nzb) = diss1d(nzb+1)
-                ENDIF
-                e1d(nzb) = e1d(nzb+1)
-
-                IF ( humidity ) THEN
-!
-!--                Compute q*
-                   IF ( ri1d(nzb+1) >= 0.0_wp )  THEN
-!
-!--                   Stable stratification
-                      qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) /                             &
-                             ( LOG( zu(nzb+1) / z0h1d ) + 5.0_wp * ri1d(nzb+1) *                   &
-                                             ( zu(nzb+1) - z0h1d ) / zu(nzb+1)                     &
-                             )
-                   ELSE
-!
-!--                   Unstable stratification
-                      a = SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) )
-                      b = SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) / zu(nzb+1) * z0h1d )
-                      qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) /                             &
-                             LOG( (a-1.0_wp) / (a+1.0_wp) * (b+1.0_wp) / (b-1.0_wp) )
-                   ENDIF
-                ELSE
-                   qs1d = 0.0_wp
-                ENDIF
-
-             ENDIF   !  constant_flux_layer
-
-!
-!--          Compute the diabatic mixing length. The unstable stratification must not be considered
-!--          for l1d (km1d) as it is already considered in the dissipation of TKE via l1d_diss.
-!--          Otherwise, km1d would be too large.
-             IF ( dissipation_1d /= 'prognostic' )  THEN
-                IF ( mixing_length_1d == 'blackadar' )  THEN
-                   DO  k = nzb+1, nzt
-                      IF ( ri1d(k) >= 0.0_wp )  THEN
-                         l1d(k) = l1d_init(k) / ( 1.0_wp + 5.0_wp * ri1d(k) )
-                         l1d_diss(k) = l1d(k)
-                      ELSE
-                         l1d(k) = l1d_init(k)
-                         l1d_diss(k) = l1d_init(k) * SQRT( 1.0_wp - 16.0_wp * ri1d(k) )
-                      ENDIF
-                   ENDDO
-                ELSEIF ( mixing_length_1d == 'as_in_3d_model' )  THEN
-                   DO  k = nzb+1, nzt
-                      dpt_dz = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k)
-                      IF ( dpt_dz > 0.0_wp )  THEN
-                         l_stable = 0.76_wp * SQRT( e1d(k) )                                       &
-                                    / SQRT( g / pt_init(k) * dpt_dz ) + 1E-5_wp
-                      ELSE
-                         l_stable = l1d_init(k)
-                      ENDIF
-                      l1d(k) = MIN( l1d_init(k), l_stable )
-                      l1d_diss(k) = l1d(k)
-                   ENDDO
-                ENDIF
-             ELSE
-                DO  k = nzb+1, nzt
-                   l1d(k) = c_0**3 * e1d(k) * SQRT( e1d(k) ) / ( diss1d(k) + 1.0E-30_wp )
-                ENDDO
-             ENDIF
-
-!
-!--          Compute the diffusion coefficients for momentum via the corresponding Prandtl-layer
-!--          relationship and according to Prandtl-Kolmogorov, respectively
-             IF ( constant_flux_layer )  THEN
-                IF ( ri1d(nzb+1) >= 0.0_wp )  THEN
-                   km1d(nzb+1) = us1d * kappa * zu(nzb+1) /                                        &
-                                 ( 1.0_wp + 5.0_wp * ri1d(nzb+1) )
-                ELSE
-                   km1d(nzb+1) = us1d * kappa * zu(nzb+1) *                                        &
-                                 ( 1.0_wp - 16.0_wp * ri1d(nzb+1) )**0.25_wp
-                ENDIF
-             ENDIF
-
-             IF ( dissipation_1d == 'prognostic' )  THEN
-                DO  k = nzb_diff, nzt
-                   km1d(k) = c_mu * e1d(k)**2 / ( diss1d(k) + 1.0E-30_wp )
-                ENDDO
-             ELSE
-                DO  k = nzb_diff, nzt
-                   km1d(k) = c_0 * SQRT( e1d(k) ) * l1d(k)
-                ENDDO
-             ENDIF
-
-!
-!--          Add damping layer
-             DO  k = damp_level_ind_1d+1, nzt+1
-                km1d(k) = 1.1_wp * km1d(k-1)
-                km1d(k) = MIN( km1d(k), 10.0_wp )
-             ENDDO
-
-!
-!--          Compute the diffusion coefficient for heat via the relationship kh = phim / phih * km
-             DO  k = nzb+1, nzt
-                IF ( ri1d(k) >= 0.0_wp )  THEN
-                   kh1d(k) = km1d(k)
-                ELSE
-                   kh1d(k) = km1d(k) * ( 1.0_wp - 16.0_wp * ri1d(k) )**0.25_wp
-                ENDIF
-             ENDDO
-
-          ENDIF   ! .NOT. constant_diffusion
-
-       ENDDO   ! intermediate step loop
-
-!
-!--    Increment simulated time and output times
-       current_timestep_number_1d = current_timestep_number_1d + 1
-       simulated_time_1d          = simulated_time_1d + dt_1d
-       simulated_time_chr         = time_to_string( simulated_time_1d )
-       time_pr_1d                 = time_pr_1d          + dt_1d
-       time_run_control_1d        = time_run_control_1d + dt_1d
-
-!
-!--    Determine and print out quantities for run control
-       IF ( time_run_control_1d >= dt_run_control_1d )  THEN
-          CALL run_control_1d
-          time_run_control_1d = time_run_control_1d - dt_run_control_1d
-       ENDIF
-
-!
-!--    Profile output on file
-       IF ( time_pr_1d >= dt_pr_1d )  THEN
-          CALL print_1d_model
-          time_pr_1d = time_pr_1d - dt_pr_1d
-       ENDIF
-
-!
-!--    Determine size of next time step
-       CALL timestep_1d
-
-    ENDDO   ! time loop
-!
-!-- Set intermediate_timestep_count back to zero. This is required e.g. for initial calls of
-!-- calc_mean_profile.
-    intermediate_timestep_count = 0
-
- END SUBROUTINE time_integration_1d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute and print out quantities for run control of the 1D model.
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE run_control_1d
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k     !< loop index
-
-    REAL(wp) ::  alpha     !< angle of wind vector at top of constant-flux layer
-    REAL(wp) ::  energy    !< kinetic energy
-    REAL(wp) ::  umax      !< maximum of u
-    REAL(wp) ::  uv_total  !< horizontal wind speed
-    REAL(wp) ::  vmax      !< maximum of v
-
-!
-!-- Output
-    IF ( myid == 0 )  THEN
-!
-!--    If necessary, write header
-       IF ( .NOT. run_control_header_1d )  THEN
-          CALL check_open( 15 )
-          WRITE ( 15, 100 )
-          run_control_header_1d = .TRUE.
-       ENDIF
-
-!
-!--    Compute control quantities
-!--    grid level nzp is excluded due to mirror boundary condition
-       umax = 0.0_wp; vmax = 0.0_wp; energy = 0.0_wp
-       DO  k = nzb+1, nzt+1
-          umax = MAX( ABS( umax ), ABS( u1d(k) ) )
-          vmax = MAX( ABS( vmax ), ABS( v1d(k) ) )
-          energy = energy + 0.5_wp * ( u1d(k)**2 + v1d(k)**2 )
-       ENDDO
-       energy = energy / REAL( nzt - nzb + 1, KIND=wp )
-
-       uv_total = SQRT( u1d(nzb+1)**2 + v1d(nzb+1)**2 )
-       IF ( ABS( v1d(nzb+1) ) < 1.0E-5_wp )  THEN
-          alpha = ACOS( SIGN( 1.0_wp , u1d(nzb+1) ) )
-       ELSE
-          alpha = ACOS( u1d(nzb+1) / uv_total )
-          IF ( v1d(nzb+1) <= 0.0_wp )  alpha = 2.0_wp * pi - alpha
-       ENDIF
-       alpha = alpha / ( 2.0_wp * pi ) * 360.0_wp
-
-       WRITE ( 15, 101 )  current_timestep_number_1d, simulated_time_chr, dt_1d, umax, vmax, us1d, &
-                          alpha, energy
-!
-!--    Write buffer contents to disc immediately
-       FLUSH( 15 )
-
-    ENDIF
-
-!
-!-- formats
-100 FORMAT (///'1D run control output:'/                                                           &
-               '------------------------------'//                                                  &
-            'ITER.   HH:MM:SS    DT      UMAX   VMAX    U*   ALPHA   ENERG.'/                      &
-            '-------------------------------------------------------------')
-101 FORMAT (I7,1X,A9,1X,F6.2,2X,F6.2,1X,F6.2,1X,F6.3,2X,F5.1,2X,F7.2)
-
-
- END SUBROUTINE run_control_1d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the time step w.r.t. the diffusion criterion
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE timestep_1d
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k    !< loop index
-
-    REAL(wp) ::  dt_diff  !< time step accorind to diffusion criterion
-    REAL(wp) ::  dt_old   !< previous time step
-    REAL(wp) ::  fac      !< factor of criterion
-    REAL(wp) ::  value    !< auxiliary variable
-
-!
-!-- Save previous time step
-    dt_old = dt_1d
-
-!
-!-- Compute the currently feasible time step according to the diffusion criterion. At nzb+1 the half
-!-- grid length is used.
-    fac = 0.125
-    dt_diff = dt_max_1d
-    DO  k = nzb+2, nzt
-       value   = fac * dzu(k) * dzu(k) / ( km1d(k) + 1E-20_wp )
-       dt_diff = MIN( value, dt_diff )
-    ENDDO
-    value   = fac * zu(nzb+1) * zu(nzb+1) / ( km1d(nzb+1) + 1E-20_wp )
-    dt_1d = MIN( value, dt_diff )
-
-!
-!-- Limit the new time step to a maximum of 10 times the previous time step
-    dt_1d = MIN( dt_old * 10.0_wp, dt_1d )
-
-!
-!-- Set flag when the time step becomes too small
-    IF ( dt_1d < ( 1.0E-15_wp * dt_max_1d ) )  THEN
-       stop_dt_1d = .TRUE.
-
-       WRITE( message_string, * ) 'timestep has exceeded the lower limit&', 'dt_1d = ',dt_1d,      &
-                                  ' s   simulation stopped!'
-       CALL message( 'timestep_1d', 'PA0192', 1, 2, 0, 6, 0 )
-
-    ENDIF
-
- END SUBROUTINE timestep_1d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> List output of profiles from the 1D-model
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE print_1d_model
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k  !< loop parameter
-
-    LOGICAL, SAVE :: write_first = .TRUE. !< flag for writing header
-
-
-    IF ( myid == 0 )  THEN
-!
-!--    Open list output file for profiles from the 1D-model
-       CALL check_open( 17 )
-
-!
-!--    Write Header
-       IF ( write_first )  THEN
-          WRITE ( 17, 100 )  TRIM( run_description_header )
-          write_first = .FALSE.
-       ENDIF
-
-!
-!--    Write the values
-       WRITE ( 17, 104 )  TRIM( simulated_time_chr )
-       WRITE ( 17, 101 )
-       WRITE ( 17, 102 )
-       WRITE ( 17, 101 )
-       DO  k = nzt+1, nzb, -1
-          WRITE ( 17, 103)  k, zu(k), u1d(k), v1d(k), pt_init(k), e1d(k), ri1d(k), km1d(k),        &
-                            kh1d(k), l1d(k), diss1d(k)
-       ENDDO
-       WRITE ( 17, 101 )
-       WRITE ( 17, 102 )
-       WRITE ( 17, 101 )
-
-!
-!--    Write buffer contents to disc immediately
-       FLUSH( 17 )
-
-    ENDIF
-
-!
-!-- Formats
-100 FORMAT ('# ',A/'#',10('-')/'# 1d-model profiles')
-104 FORMAT (//'# Time: ',A)
-101 FORMAT ('#',111('-'))
-102 FORMAT ('#  k     zu      u          v          pt         e          ',   &
-            'Ri         Km         Kh         l          diss   ')
-103 FORMAT (1X,I4,1X,F7.1,9(1X,E10.3))
-
-
- END SUBROUTINE print_1d_model
-
-
- END MODULE
Index: palm/trunk/SOURCE/module_interface.f90
===================================================================
--- palm/trunk/SOURCE/module_interface.f90	(revision 4901)
+++ 	(revision )
@@ -1,2080 +1,0 @@
-!> @file module_interface.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! routine required for output of particle time series added
-!
-! 4768 2020-11-02 19:11:23Z suehring
-! Enable 3D data output also with 64-bit precision
-!
-! 4757 2020-10-26 10:23:38Z schwenkel
-! Implement doq calls
-!
-! 4753 2020-10-21 14:55:41Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4731 2020-10-07 13:25:11Z schwenkel
-! Move exchange_horiz from time_integration to modules
-!
-! 4708 2020-09-28 17:42:58Z suehring
-! pass fillvalue attribute to radiation output
-!
-! 4590 2020-07-06 14:34:59Z suehring
-! Enable mpi-io for biomet
-!
-! 4525 2020-05-10 17:05:07Z raasch
-! added restart I/O for global salsa data,
-! added restart with MPI-IO for salsa
-!
-! 4518 2020-05-04 15:44:28Z suehring
-! Call of doq_rrd_local enabled
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO for reading local arrays
-!
-! 4514 2020-04-30 16:29:59Z suehring
-! Added global restart routines for plant-canopy model
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4414 2020-02-19 20:16:04Z suehring
-! Add module interface for basic initialization of numerics.
-!
-! 4411 2020-02-18 14:28:02Z maronga
-! Added output routines for WTM
-!
-! 4407 2020-02-13 20:31:44Z knoop
-! Changed program_debug_output_unit to 9 in dom_init call
-!
-! 4400 2020-02-10 20:32:41Z suehring
-! - Use data-output module for virtual measurement output
-! - Remove deprecated routines for virtual measurement module
-!
-! 4361 2020-01-07 12:22:38Z suehring
-! Remove unused arrays in pmc_rrd_local
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Add pcm_rrd_local and pcm_wrd_local
-!
-! 4331 2019-12-10 18:25:02Z suehring
-! Change interface for doq_check_data_output, in order to perform further output checks.
-!
-! 4281 2019-10-29 15:15:39Z schwenkel
-! Added dynamics boundary conditions
-!
-! 4272 2019-10-23 15:18:57Z schwenkel
-! Further modularization of boundary conditions: moved boundary conditions to respective modules
-!
-! 4268 2019-10-17 11:29:38Z schwenkel
-! Introduction of module_interface_boundary_conditions
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4173 2019-08-20 12:04:06Z gronemeier
-! add vdi_internal_controls
-!
-! 4157 2019-08-14 09:19:12Z suehring
-! Call doq_init from module interface
-!
-! 4132 2019-08-02 12:34:17Z suehring
-! Bugfix in masked data output for diagnostic quantities
-!
-! 4131 2019-08-02 11:06:18Z monakurppa
-! Add output of 3D plant-canopy outputs (merge from branch resler)
-!
-! 4048 2019-06-21 21:00:21Z knoop
-! Moved turbulence_closure_mod calls into this module_interface
-!
-! 4047 2019-06-21 18:58:09Z knoop
-! Introduction of the dynamics module
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! Introduce diagnostic output
-!
-! 4028 2019-06-13 12:21:37Z schwenkel
-! Further modularization of particle code components
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! local_pf need INTENT(INOUT) attribute rather than INTENT(OUT). This is because INTENT(OUT) sets
-! the array to not-defined. Especially for outputs that are not defined everywhere, e.g.
-! land-surface outputs, this will be problematic as NaN will be output.
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce switchable DEBUG file output via debug_message routine
-!
-! 3956 2019-05-07 12:32:52Z monakurppa
-! - Added calls for salsa_non_advective_processes and salsa_exchange_horiz_bounds
-! - Moved the call for salsa_data_output_2d/3d before that of radiation_data_output_2d/3d.
-!   radiation_data_output_2d/3d tries to read a salsa output variable and encounters a segmentation
-!   fault for "Ntot" due to the shortoutput name
-!
-! 3931 2019-04-24 16:34:28Z schwenkel
-! Changed non_transport_physics to non_advective_processes
-!
-! 3930 2019-04-24 14:57:18Z forkel
-! Correct/complete module_interface introduction for chemistry model
-!
-! 3887 2019 -04-12 08:47:41Z schwenkel
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3880 2019 -04-08 21:43:02Z knoop
-! Add a call for salsa_prognostic_equations
-!
-! 3840 2019-03-29 10:35:52Z knoop
-! bugfix: intent of dummy arguments changed to inout
-!
-! 3770 2019-02-28 11:22:32Z moh.hefny
-! removed unused variables in module_interface_check_data_output_ts
-!
-! 3767 08:18:02Z raasch
-! unused variable file_index removed from subroutine parameter list
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! first argument removed from module_interface_rrd_*, statement added to avoid compiler warning
-! about unused variable, file reformatted with respect to coding standards
-!
-! 3762 2019-02-25 16:54:16Z suehring
-! only pass required arguments to surface_data_output_rrd_local
-!
-! 3747 2019-02-16 15:15:23Z gronemeier
-! Call user_init_arrays
-!
-! 3745 2019-02-15 18:57:56Z suehring
-! Add indoor model
-!
-! 3744 2019-02-15 18:38:58Z suehring
-! Removed bio_check_parameters as the method is empty.
-!
-! 3735 2019-02-12 09:52:40Z dom_dwd_user
-! Accepting variable j from check_parameters and passing it to bio_check_data_output
-! Add required restart data for surface output module
-!
-! 3731 2019-02-11 13:06:27Z suehring
-! Add check_parameters routine for virtual measurements
-!
-! 3711 2019-01-31 13:44:26Z knoop
-! Introduced module_interface_init_checks for post-init checks
-!
-! 3705 2019-01-29 19:56:39Z suehring
-! Add last_actions for virtual measurements
-!
-! 3704 2019-01-29 19:51:41Z suehring
-! Some interface calls moved to module_interface + cleanup
-!
-! 3684 2019-01-20 20:20:58Z knoop
-! Bugfix: made unit intend INOUT
-!
-! 3650 2019-01-04 13:01:33Z kanani
-! Add restart routines for biometeorology
-!
-! 3649 2019-01-02 16:52:21Z suehring
-! Initialize strings, in order to avoid compiler warnings for non-initialized characters with
-! intent(out) attribute
-!
-! 3648 2019-01-02 16:35:46Z suehring
-! 3641 2018-12-23 22:10:01Z knoop
-! Initial implementation of the PALM module interface
-!
-!
-! Description:
-! ------------
-!> This is the interface between the PALM model core and all its modules.
-!>
-!> @todo Re-format module to be consistent with coding standard
-!--------------------------------------------------------------------------------------------------!
- MODULE module_interface
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt
-
-    USE kinds
-
-    USE pegrid,                                                                                    &
-        ONLY:  comm2d
-
-!
-!-- load module-specific control parameters.
-!-- ToDo: move all of them to respective module or a dedicated central module
-    USE data_output_module,                                                                        &
-        ONLY:  dom_def_end,                                                                        &
-               dom_finalize_output,                                                                &
-               dom_init
-
-    USE dynamics_mod,                                                                              &
-        ONLY:  dynamics_3d_data_averaging,                                                         &
-               dynamics_actions,                                                                   &
-               dynamics_boundary_conditions,                                                       &
-               dynamics_check_data_output,                                                         &
-               dynamics_check_data_output_pr,                                                      &
-               dynamics_check_data_output_ts,                                                      &
-               dynamics_check_parameters,                                                          &
-               dynamics_data_output_2d,                                                            &
-               dynamics_data_output_3d,                                                            &
-               dynamics_define_netcdf_grid,                                                        &
-               dynamics_exchange_horiz,                                                            &
-               dynamics_header,                                                                    &
-               dynamics_init,                                                                      &
-               dynamics_init_arrays,                                                               &
-               dynamics_init_checks,                                                               &
-               dynamics_init_masks,                                                                &
-               dynamics_last_actions,                                                              &
-               dynamics_non_advective_processes,                                                   &
-               dynamics_parin,                                                                     &
-               dynamics_prognostic_equations,                                                      &
-               dynamics_rrd_global,                                                                &
-               dynamics_rrd_local,                                                                 &
-               dynamics_statistics,                                                                &
-               dynamics_swap_timelevel,                                                            &
-               dynamics_wrd_global,                                                                &
-               dynamics_wrd_local
-
-    USE turbulence_closure_mod,                                                                    &
-        ONLY:  tcm_3d_data_averaging,                                                              &
-               tcm_actions,                                                                        &
-               tcm_boundary_conds,                                                                 &
-               tcm_check_data_output,                                                              &
-               tcm_check_parameters,                                                               &
-               tcm_data_output_2d,                                                                 &
-               tcm_data_output_3d,                                                                 &
-               tcm_init,                                                                           &
-               tcm_init_arrays,                                                                    &
-               tcm_prognostic_equations,                                                           &
-               tcm_swap_timelevel
-
-    USE control_parameters,                                                                        &
-        ONLY:  air_chemistry,                                                                      &
-               biometeorology,                                                                     &
-               coupling_char,                                                                      &
-               debug_output,                                                                       &
-               debug_output_timestep,                                                              &
-               indoor_model,                                                                       &
-               land_surface,                                                                       &
-               large_scale_forcing,                                                                &
-               nesting_offline,                                                                    &
-               nudging,                                                                            &
-               ocean_mode,                                                                         &
-               plant_canopy,                                                                       &
-               salsa,                                                                              &
-               surface_output,                                                                     &
-               syn_turb_gen,                                                                       &
-               urban_surface,                                                                      &
-               vdi_checks,                                                                         &
-               virtual_flight,                                                                     &
-               virtual_measurement,                                                                &
-               wind_turbine
-
-!
-!-- Load interface routines of all PALM modules
-    USE biometeorology_mod,                                                                        &
-        ONLY:  bio_3d_data_averaging,                                                              &
-               bio_check_data_output,                                                              &
-               bio_data_output_2d,                                                                 &
-               bio_data_output_3d,                                                                 &
-               bio_init,                                                                           &
-               bio_init_checks,                                                                    &
-               bio_header,                                                                         &
-               bio_parin,                                                                          &
-               bio_rrd_global,                                                                     &
-               bio_rrd_local,                                                                      &
-               bio_wrd_global,                                                                     &
-               bio_wrd_local
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bcm_3d_data_averaging,                                                              &
-               bcm_actions,                                                                        &
-               bcm_boundary_conditions,                                                            &
-               bcm_check_data_output_pr,                                                           &
-               bcm_check_data_output,                                                              &
-               bcm_check_parameters,                                                               &
-               bcm_data_output_2d,                                                                 &
-               bcm_data_output_3d,                                                                 &
-               bcm_exchange_horiz,                                                                 &
-               bcm_header,                                                                         &
-               bcm_init_arrays,                                                                    &
-               bcm_init,                                                                           &
-               bcm_non_advective_processes,                                                        &
-               bcm_parin,                                                                          &
-               bcm_prognostic_equations,                                                           &
-               bcm_rrd_global,                                                                     &
-               bcm_rrd_local,                                                                      &
-               bcm_swap_timelevel,                                                                 &
-               bcm_wrd_global,                                                                     &
-               bcm_wrd_local,                                                                      &
-               bulk_cloud_model
-
-   USE chemistry_model_mod,                                                                        &
-       ONLY:  chem_3d_data_averaging,                                                              &
-              chem_actions,                                                                        &
-              chem_boundary_conditions,                                                            &
-              chem_check_data_output,                                                              &
-              chem_check_data_output_pr,                                                           &
-              chem_check_parameters,                                                               &
-              chem_data_output_2d,                                                                 &
-              chem_data_output_3d,                                                                 &
-              chem_exchange_horiz_bounds,                                                          &
-              chem_header,                                                                         &
-              chem_init,                                                                           &
-              chem_init_arrays,                                                                    &
-              chem_non_advective_processes,                                                        &
-              chem_parin,                                                                          &
-              chem_prognostic_equations,                                                           &
-              chem_rrd_local,                                                                      &
-              chem_statistics,                                                                     &
-              chem_swap_timelevel,                                                                 &
-              chem_wrd_local
-
-    USE diagnostic_output_quantities_mod,                                                          &
-        ONLY:  doq_3d_data_averaging,                                                              &
-               doq_check_data_output,                                                              &
-               doq_check_data_output_pr,                                                           &
-               doq_define_netcdf_grid,                                                             &
-               doq_init,                                                                           &
-               doq_output_2d,                                                                      &
-               doq_output_3d,                                                                      &
-               doq_statistics,                                                                     &
-               doq_rrd_local,                                                                      &
-               doq_wrd_local
-
-    USE flight_mod,                                                                                &
-        ONLY:  flight_header,                                                                      &
-               flight_init,                                                                        &
-               flight_parin,                                                                       &
-               flight_rrd_global,                                                                  &
-               flight_wrd_global
-
-    USE gust_mod,                                                                                  &
-        ONLY:  gust_3d_data_averaging,                                                             &
-               gust_actions,                                                                       &
-               gust_check_parameters,                                                              &
-               gust_check_data_output,                                                             &
-               gust_check_data_output_pr,                                                          &
-               gust_data_output_2d,                                                                &
-               gust_data_output_3d,                                                                &
-               gust_header,                                                                        &
-               gust_init,                                                                          &
-               gust_init_arrays,                                                                   &
-               gust_module_enabled,                                                                &
-               gust_parin,                                                                         &
-               gust_prognostic_equations,                                                          &
-               gust_rrd_global,                                                                    &
-               gust_rrd_local,                                                                     &
-               gust_statistics,                                                                    &
-               gust_swap_timelevel,                                                                &
-               gust_wrd_global,                                                                    &
-               gust_wrd_local
-
-    USE indoor_model_mod,                                                                          &
-        ONLY:  im_check_data_output,                                                               &
-               im_check_parameters,                                                                &
-               im_data_output_3d,                                                                  &
-               im_init,                                                                            &
-               im_parin
-
-    USE lagrangian_particle_model_mod,                                                             &
-        ONLY:  lpm_actions,                                                                        &
-               lpm_check_parameters,                                                               &
-               lpm_exchange_horiz_bounds,                                                          &
-               lpm_header,                                                                         &
-               lpm_init,                                                                           &
-               lpm_init_arrays,                                                                    &
-               lpm_last_actions,                                                                   &
-               lpm_parin,                                                                          &
-               lpm_rrd_global,                                                                     &
-               lpm_rrd_local,                                                                      &
-               lpm_wrd_local,                                                                      &
-               lpm_wrd_global
-
-    USE land_surface_model_mod,                                                                    &
-        ONLY:  lsm_3d_data_averaging,                                                              &
-               lsm_check_parameters,                                                               &
-               lsm_check_data_output,                                                              &
-               lsm_check_data_output_pr,                                                           &
-               lsm_data_output_2d,                                                                 &
-               lsm_header,                                                                         &
-               lsm_init,                                                                           &
-               lsm_init_arrays,                                                                    &
-               lsm_parin,                                                                          &
-               lsm_rrd_local,                                                                      &
-               lsm_swap_timelevel,                                                                 &
-               lsm_wrd_local
-
-    USE lsf_nudging_mod,                                                                           &
-        ONLY:  lsf_nudging_check_parameters,                                                       &
-               lsf_nudging_check_data_output_pr,                                                   &
-               lsf_nudging_header,                                                                 &
-               lsf_init,                                                                           &
-               nudge_init
-
-    USE multi_agent_system_mod,                                                                    &
-        ONLY:  mas_parin
-
-    USE nesting_offl_mod,                                                                          &
-        ONLY:  nesting_offl_check_parameters,                                                      &
-               nesting_offl_header,                                                                &
-               nesting_offl_parin
-
-    USE ocean_mod,                                                                                 &
-        ONLY:  ocean_3d_data_averaging,                                                            &
-               ocean_actions,                                                                      &
-               ocean_boundary_conditions,                                                          &
-               ocean_check_parameters,                                                             &
-               ocean_check_data_output,                                                            &
-               ocean_check_data_output_pr,                                                         &
-               ocean_data_output_2d,                                                               &
-               ocean_data_output_3d,                                                               &
-               ocean_exchange_horiz,                                                               &
-               ocean_init_arrays,                                                                  &
-               ocean_init,                                                                         &
-               ocean_header,                                                                       &
-               ocean_parin,                                                                        &
-               ocean_prognostic_equations,                                                         &
-               ocean_rrd_global,                                                                   &
-               ocean_rrd_local,                                                                    &
-               ocean_swap_timelevel,                                                               &
-               ocean_wrd_global,                                                                   &
-               ocean_wrd_local
-
-    USE particle_attributes,                                                                       &
-        ONLY:  particle_advection
-
-    USE poismg_noopt_mod,                                                                          &
-        ONLY:  poismg_noopt_init
-
-    USE plant_canopy_model_mod,                                                                    &
-         ONLY: pcm_3d_data_averaging,                                                              &
-               pcm_check_parameters,                                                               &
-               pcm_check_data_output,                                                              &
-               pcm_data_output_3d,                                                                 &
-               pcm_header,                                                                         &
-               pcm_init,                                                                           &
-               pcm_parin,                                                                          &
-               pcm_rrd_global,                                                                     &
-               pcm_rrd_local,                                                                      &
-               pcm_wrd_global,                                                                     &
-               pcm_wrd_local
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  radiation,                                                                          &
-               radiation_3d_data_averaging,                                                        &
-               radiation_check_parameters,                                                         &
-               radiation_check_data_output,                                                        &
-               radiation_check_data_output_pr,                                                     &
-               radiation_check_data_output_ts,                                                     &
-               radiation_data_output_2d,                                                           &
-               radiation_data_output_3d,                                                           &
-               radiation_header,                                                                   &
-               radiation_init,                                                                     &
-               radiation_parin,                                                                    &
-               radiation_rrd_local,                                                                &
-               radiation_wrd_local
-
-    USE salsa_mod,                                                                                 &
-        ONLY:  salsa_3d_data_averaging,                                                            &
-               salsa_actions,                                                                      &
-               salsa_boundary_conditions,                                                          &
-               salsa_check_data_output,                                                            &
-               salsa_check_data_output_pr,                                                         &
-               salsa_check_parameters,                                                             &
-               salsa_data_output_2d,                                                               &
-               salsa_data_output_3d,                                                               &
-               salsa_exchange_horiz_bounds,                                                        &
-               salsa_header,                                                                       &
-               salsa_init,                                                                         &
-               salsa_init_arrays,                                                                  &
-               salsa_non_advective_processes,                                                      &
-               salsa_parin,                                                                        &
-               salsa_prognostic_equations,                                                         &
-               salsa_rrd_global,                                                                   &
-               salsa_rrd_local,                                                                    &
-               salsa_statistics,                                                                   &
-               salsa_swap_timelevel,                                                               &
-               salsa_wrd_global,                                                                   &
-               salsa_wrd_local
-
-    USE spectra_mod,                                                                               &
-        ONLY:  calculate_spectra,                                                                  &
-               spectra_check_parameters,                                                           &
-               spectra_header,                                                                     &
-               spectra_parin
-
-    USE surface_data_output_mod,                                                                   &
-        ONLY:  surface_data_output_check_parameters,                                               &
-               surface_data_output_init_arrays,                                                    &
-               surface_data_output_parin,                                                          &
-               surface_data_output_rrd_global,                                                     &
-               surface_data_output_rrd_local,                                                      &
-               surface_data_output_wrd_global,                                                     &
-               surface_data_output_wrd_local
-
-    USE surface_mod,                                                                               &
-        ONLY:  init_bc
-
-    USE synthetic_turbulence_generator_mod,                                                        &
-        ONLY:  stg_check_parameters,                                                               &
-               stg_header,                                                                         &
-               stg_parin,                                                                          &
-               stg_rrd_global,                                                                     &
-               stg_wrd_global
-
-    USE urban_surface_mod,                                                                         &
-        ONLY:  usm_3d_data_averaging,                                                              &
-               usm_check_data_output,                                                              &
-               usm_check_parameters,                                                               &
-               usm_init,                                                                           &
-               usm_init_arrays,                                                                    &
-               usm_parin,                                                                          &
-               usm_swap_timelevel,                                                                 &
-               usm_rrd_local,                                                                      &
-               usm_wrd_local
-
-    USE vdi_internal_controls,                                                                     &
-        ONLY:  vdi_actions
-
-    USE virtual_measurement_mod,                                                                   &
-        ONLY:  vm_check_parameters,                                                                &
-               vm_init,                                                                            &
-               vm_init_output,                                                                     &
-               vm_parin
-
-    USE wind_turbine_model_mod,                                                                    &
-        ONLY:  wtm_actions,                                                                        &
-               wtm_check_parameters,                                                               &
-               wtm_init,                                                                           &
-               wtm_init_arrays,                                                                    &
-               wtm_init_output,                                                                    &
-               wtm_parin,                                                                          &
-               wtm_rrd_global,                                                                     &
-               wtm_wrd_global
-
-    USE user,                                                                                      &
-        ONLY:  user_3d_data_averaging,                                                             &
-               user_actions,                                                                       &
-               user_check_data_output,                                                             &
-               user_check_data_output_pr,                                                          &
-               user_check_data_output_ts,                                                          &
-               user_check_parameters,                                                              &
-               user_data_output_2d,                                                                &
-               user_data_output_3d,                                                                &
-               user_header,                                                                        &
-               user_init,                                                                          &
-               user_init_arrays,                                                                   &
-               user_last_actions,                                                                  &
-               user_module_enabled,                                                                &
-               user_parin,                                                                         &
-               user_statistics,                                                                    &
-               user_rrd_global,                                                                    &
-               user_rrd_local,                                                                     &
-               user_wrd_global,                                                                    &
-               user_wrd_local
-
-    IMPLICIT NONE
-
-    PRIVATE
-
-!
-!-- Public functions
-    PUBLIC                                                                                         &
-       module_interface_parin,                                                                     &
-       module_interface_check_parameters,                                                          &
-       module_interface_check_data_output_ts,                                                      &
-       module_interface_check_data_output_pr,                                                      &
-       module_interface_check_data_output,                                                         &
-       module_interface_init_masks,                                                                &
-       module_interface_define_netcdf_grid,                                                        &
-       module_interface_init_arrays,                                                               &
-       module_interface_init,                                                                      &
-       module_interface_init_checks,                                                               &
-       module_interface_init_numerics,                                                             &
-       module_interface_init_output,                                                               &
-       module_interface_header,                                                                    &
-       module_interface_actions,                                                                   &
-       module_interface_non_advective_processes,                                                   &
-       module_interface_exchange_horiz,                                                            &
-       module_interface_prognostic_equations,                                                      &
-       module_interface_boundary_conditions,                                                       &
-       module_interface_swap_timelevel,                                                            &
-       module_interface_3d_data_averaging,                                                         &
-       module_interface_data_output_2d,                                                            &
-       module_interface_data_output_3d,                                                            &
-       module_interface_statistics,                                                                &
-       module_interface_rrd_global,                                                                &
-       module_interface_wrd_global,                                                                &
-       module_interface_rrd_local,                                                                 &
-       module_interface_wrd_local,                                                                 &
-       module_interface_last_actions
-
-
-    INTERFACE module_interface_parin
-       MODULE PROCEDURE module_interface_parin
-    END INTERFACE module_interface_parin
-
-    INTERFACE module_interface_check_parameters
-       MODULE PROCEDURE module_interface_check_parameters
-    END INTERFACE module_interface_check_parameters
-
-    INTERFACE module_interface_check_data_output_ts
-       MODULE PROCEDURE module_interface_check_data_output_ts
-    END INTERFACE module_interface_check_data_output_ts
-
-    INTERFACE module_interface_check_data_output_pr
-       MODULE PROCEDURE module_interface_check_data_output_pr
-    END INTERFACE module_interface_check_data_output_pr
-
-    INTERFACE module_interface_check_data_output
-       MODULE PROCEDURE module_interface_check_data_output
-    END INTERFACE module_interface_check_data_output
-
-    INTERFACE module_interface_init_masks
-       MODULE PROCEDURE module_interface_init_masks
-    END INTERFACE module_interface_init_masks
-
-    INTERFACE module_interface_define_netcdf_grid
-       MODULE PROCEDURE module_interface_define_netcdf_grid
-    END INTERFACE module_interface_define_netcdf_grid
-
-    INTERFACE module_interface_init_arrays
-       MODULE PROCEDURE module_interface_init_arrays
-    END INTERFACE module_interface_init_arrays
-
-    INTERFACE module_interface_init
-       MODULE PROCEDURE module_interface_init
-    END INTERFACE module_interface_init
-
-    INTERFACE module_interface_init_checks
-       MODULE PROCEDURE module_interface_init_checks
-    END INTERFACE module_interface_init_checks
-
-    INTERFACE module_interface_init_numerics
-       MODULE PROCEDURE module_interface_init_numerics
-    END INTERFACE module_interface_init_numerics
-
-    INTERFACE module_interface_init_output
-       MODULE PROCEDURE module_interface_init_output
-    END INTERFACE module_interface_init_output
-
-    INTERFACE module_interface_header
-       MODULE PROCEDURE module_interface_header
-    END INTERFACE module_interface_header
-
-    INTERFACE module_interface_actions
-       MODULE PROCEDURE module_interface_actions
-       MODULE PROCEDURE module_interface_actions_ij
-    END INTERFACE module_interface_actions
-
-    INTERFACE module_interface_non_advective_processes
-       MODULE PROCEDURE module_interface_non_advective_processes
-       MODULE PROCEDURE module_interface_non_advective_processes_ij
-    END INTERFACE module_interface_non_advective_processes
-
-    INTERFACE module_interface_exchange_horiz
-       MODULE PROCEDURE module_interface_exchange_horiz
-    END INTERFACE module_interface_exchange_horiz
-
-    INTERFACE module_interface_prognostic_equations
-       MODULE PROCEDURE module_interface_prognostic_equations
-       MODULE PROCEDURE module_interface_prognostic_equations_ij
-    END INTERFACE module_interface_prognostic_equations
-
-    INTERFACE module_interface_swap_timelevel
-       MODULE PROCEDURE module_interface_swap_timelevel
-    END INTERFACE module_interface_swap_timelevel
-
-    INTERFACE module_interface_boundary_conditions
-       MODULE PROCEDURE module_interface_boundary_conditions
-    END INTERFACE module_interface_boundary_conditions
-
-    INTERFACE module_interface_3d_data_averaging
-       MODULE PROCEDURE module_interface_3d_data_averaging
-    END INTERFACE module_interface_3d_data_averaging
-
-    INTERFACE module_interface_data_output_2d
-       MODULE PROCEDURE module_interface_data_output_2d
-    END INTERFACE module_interface_data_output_2d
-
-    INTERFACE module_interface_data_output_3d
-       MODULE PROCEDURE module_interface_data_output_3d
-    END INTERFACE module_interface_data_output_3d
-
-    INTERFACE module_interface_statistics
-       MODULE PROCEDURE module_interface_statistics
-    END INTERFACE module_interface_statistics
-
-    INTERFACE module_interface_rrd_global
-       MODULE PROCEDURE module_interface_rrd_global_ftn
-       MODULE PROCEDURE module_interface_rrd_global_mpi
-    END INTERFACE module_interface_rrd_global
-
-    INTERFACE module_interface_wrd_global
-       MODULE PROCEDURE module_interface_wrd_global
-    END INTERFACE module_interface_wrd_global
-
-    INTERFACE module_interface_rrd_local
-       MODULE PROCEDURE module_interface_rrd_local_ftn
-       MODULE PROCEDURE module_interface_rrd_local_mpi
-    END INTERFACE module_interface_rrd_local
-
-    INTERFACE module_interface_wrd_local
-       MODULE PROCEDURE module_interface_wrd_local
-    END INTERFACE module_interface_wrd_local
-
-    INTERFACE module_interface_last_actions
-       MODULE PROCEDURE module_interface_last_actions
-    END INTERFACE module_interface_last_actions
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific parameter namelists
-!------------------------------------------------------------------------------                    !
- SUBROUTINE module_interface_parin
-
-
-    IF ( debug_output )  CALL debug_message( 'reading module-specific parameters', 'start' )
-
-    CALL dynamics_parin
-
-    CALL bio_parin
-    CALL bcm_parin
-    CALL chem_parin
-    CALL flight_parin ! ToDo: rename module to match filename
-    CALL gust_parin
-    CALL im_parin
-    CALL lpm_parin
-    CALL lsm_parin
-    ! ToDo: create parin routine for large_scale_forcing and nudging (should be seperate modules or new module switch)
-    CALL mas_parin
-    CALL nesting_offl_parin
-    CALL ocean_parin
-    CALL pcm_parin
-    CALL radiation_parin
-    CALL salsa_parin
-    CALL spectra_parin
-    CALL surface_data_output_parin
-    CALL stg_parin
-    CALL usm_parin
-    CALL vm_parin
-    CALL wtm_parin
-
-    CALL user_parin
-
-    IF ( debug_output )  CALL debug_message( 'reading module-specific parameters', 'end' )
-
-
- END SUBROUTINE module_interface_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Perform module-specific initialization checks
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_check_parameters
-
-
-    IF ( debug_output )  CALL debug_message( 'checking module-specific parameters', 'start' )
-
-    CALL dynamics_check_parameters
-    CALL tcm_check_parameters
-
-    IF ( bulk_cloud_model )     CALL bcm_check_parameters
-    IF ( air_chemistry )        CALL chem_check_parameters
-    IF ( gust_module_enabled )  CALL gust_check_parameters
-    IF ( indoor_model )         CALL im_check_parameters
-    IF ( particle_advection )   CALL lpm_check_parameters
-    IF ( land_surface )         CALL lsm_check_parameters
-    IF ( large_scale_forcing  .OR.  nudging )  CALL lsf_nudging_check_parameters ! ToDo: create single module switch
-    IF ( nesting_offline )      CALL nesting_offl_check_parameters
-    IF ( ocean_mode )           CALL ocean_check_parameters
-    IF ( plant_canopy )         CALL pcm_check_parameters
-    IF ( radiation )            CALL radiation_check_parameters
-    IF ( salsa )                CALL salsa_check_parameters
-    IF ( calculate_spectra )    CALL spectra_check_parameters
-    IF ( surface_output )       CALL surface_data_output_check_parameters
-    IF ( syn_turb_gen )         CALL stg_check_parameters
-    IF ( urban_surface )        CALL usm_check_parameters
-    IF ( virtual_measurement )  CALL vm_check_parameters
-    IF ( wind_turbine )         CALL wtm_check_parameters
-
-    IF ( user_module_enabled )  CALL user_check_parameters
-
-    IF ( debug_output )  CALL debug_message( 'checking module-specific parameters', 'end' )
-
-
- END SUBROUTINE module_interface_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check module-specific data output of timeseries
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
-
-    INTEGER(iwp),      INTENT(IN)       ::  dots_max !< variable output array index
-    INTEGER(iwp),      INTENT(INOUT)    ::  dots_num !< variable output array index
-
-    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_label
-    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_unit
-
-
-    IF ( debug_output )  CALL debug_message( 'checking module-specific data output ts', 'start' )
-
-    CALL dynamics_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
-
-    IF ( radiation )  THEN
-       CALL radiation_check_data_output_ts( dots_max, dots_num )
-    ENDIF
-
-    IF ( user_module_enabled )  THEN
-       CALL user_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
-    ENDIF
-
-    IF ( debug_output )  CALL debug_message( 'checking module-specific data output ts', 'end' )
-
-
- END SUBROUTINE module_interface_check_data_output_ts
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check module-specific data output of profiles
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-
-    CHARACTER (LEN=*), INTENT(IN)    ::  variable  !< variable name
-    CHARACTER (LEN=*), INTENT(INOUT) ::  unit      !< physical unit of variable
-    CHARACTER (LEN=*), INTENT(OUT)   ::  dopr_unit !< local value of dopr_unit
-
-    INTEGER(iwp),      INTENT(IN)    ::  var_count !< variable output array index
-
-
-    IF ( debug_output )  CALL debug_message( 'checking module-specific data output pr', 'start' )
-
-    CALL dynamics_check_data_output_pr( variable, var_count, unit, dopr_unit )
-    CALL doq_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-    IF ( unit == 'illegal'  .AND.  bulk_cloud_model )  THEN
-       CALL bcm_check_data_output_pr( variable, var_count, unit, dopr_unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  air_chemistry )  THEN
-       CALL chem_check_data_output_pr( variable, var_count, unit, dopr_unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  gust_module_enabled  )  THEN
-       CALL gust_check_data_output_pr( variable, var_count, unit, dopr_unit )
-    ENDIF
-
-    IF ( unit == 'illegal' )  THEN ! ToDo: add module switch if possible
-       CALL lsm_check_data_output_pr( variable, var_count, unit, dopr_unit )
-    ENDIF
-
-    IF ( unit == 'illegal' )  THEN ! ToDo: add module switch if possible
-       CALL lsf_nudging_check_data_output_pr( variable, var_count, unit, dopr_unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  ocean_mode )  THEN
-       CALL ocean_check_data_output_pr( variable, var_count, unit, dopr_unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  radiation )  THEN
-       CALL radiation_check_data_output_pr( variable, var_count, unit, dopr_unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  salsa )  THEN
-       CALL salsa_check_data_output_pr( variable, var_count, unit, dopr_unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  user_module_enabled )  THEN
-       unit = '' ! ToDo: Seems like a hack. Find a general soultion!
-       CALL user_check_data_output_pr( variable, var_count, unit, dopr_unit )
-    ENDIF
-
-    IF ( debug_output )  CALL debug_message( 'checking module-specific data output pr', 'end' )
-
-
- END SUBROUTINE module_interface_check_data_output_pr
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check module-specific 2D and 3D data output
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_check_data_output( variable, unit, i, j, ilen, k )
-
-
-    CHARACTER (LEN=*), INTENT(IN)    ::  variable !< variable name
-    CHARACTER (LEN=*), INTENT(INOUT) ::  unit     !< physical unit of variable
-
-    INTEGER(iwp),      INTENT(IN)    :: i         !< ToDo: remove dummy argument, instead pass string from data_output
-    INTEGER(iwp),      INTENT(IN)    :: j         !< average quantity? 0 = no, 1 = yes
-    INTEGER(iwp),      INTENT(IN)    :: ilen      !< ToDo: remove dummy argument, instead pass string from data_output
-    INTEGER(iwp),      INTENT(IN)    :: k         !< ToDo: remove dummy argument, instead pass string from data_output
-
-
-    IF ( debug_output )  CALL debug_message( 'checking module-specific data output 2d/3d', 'start' )
-
-    CALL dynamics_check_data_output( variable, unit )
-
-    CALL tcm_check_data_output( variable, unit )
-
-    IF ( unit == 'illegal'  .AND.  biometeorology )  THEN
-       CALL bio_check_data_output( variable, unit, i, j, ilen, k )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  bulk_cloud_model  )  THEN
-       CALL bcm_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  air_chemistry  .AND.  (variable(1:3) == 'kc_'  .OR.             &
-         variable(1:3) == 'em_') )  THEN  ! ToDo: remove aditional conditions
-       CALL chem_check_data_output( variable, unit, i, ilen, k )
-    ENDIF
-
-    IF ( unit == 'illegal' )  THEN
-       CALL doq_check_data_output( variable, unit, i, ilen, k )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  gust_module_enabled  )  THEN
-       CALL gust_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( unit == 'illegal' )  THEN  ! ToDo: add module switch if possible
-       CALL lsm_check_data_output( variable, unit, i, ilen, k )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  ocean_mode )  THEN
-       CALL ocean_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  plant_canopy  .AND.  variable(1:4) == 'pcm_' )  THEN  ! ToDo: remove aditional conditions
-       CALL pcm_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  radiation )  THEN
-       CALL radiation_check_data_output( variable, unit, i, ilen, k )
-    ENDIF
-
-    IF ( unit == 'illegal' .AND. salsa ) THEN
-       CALL salsa_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( unit == 'illegal' .AND. indoor_model ) THEN
-       CALL im_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  urban_surface  .AND.  variable(1:4) == 'usm_' )  THEN  ! ToDo: remove aditional conditions
-       CALL usm_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  user_module_enabled )  THEN
-       unit = ''
-       CALL user_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( debug_output )  CALL debug_message( 'checking module-specific data output 2d/3d', 'end' )
-
-
- END SUBROUTINE module_interface_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Interface for init_masks. ToDo: get rid of these redundant calls!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_init_masks( variable, unit )
-
-
-    CHARACTER (LEN=*), INTENT(IN)    ::  variable !< variable name
-    CHARACTER (LEN=*), INTENT(INOUT) ::  unit     !< physical unit of variable
-
-
-    IF ( debug_output )  CALL debug_message( 'initializing module-specific masks', 'start' )
-
-    CALL dynamics_init_masks( variable, unit )
-
-    IF ( unit == 'illegal'  .AND.  air_chemistry  .AND.  (variable(1:3) == 'kc_'  .OR.             &
-         variable(1:3) == 'em_') )  THEN  ! ToDo: remove aditional conditions
-       CALL chem_check_data_output( variable, unit, 0, 0, 0 )
-    ENDIF
-
-    IF ( unit == 'illegal' )  THEN
-       CALL doq_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  radiation )  THEN
-       CALL radiation_check_data_output( variable, unit, 0, 0, 0 )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  salsa )  THEN
-       CALL salsa_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( unit == 'illegal'  .AND.  user_module_enabled )  THEN
-       unit = ''
-       CALL user_check_data_output( variable, unit )
-    ENDIF
-
-    IF ( debug_output )  CALL debug_message( 'initializing module-specific masks', 'end' )
-
-
- END SUBROUTINE module_interface_init_masks
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Define appropriate grid for module-specific netcdf output variables.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-
-    CHARACTER (LEN=*), INTENT(IN)  ::  var    !< variable name
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_x !< netcdf dimension in x-direction
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y !< netcdf dimension in y-direction
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z !< netcdf dimension in z-direction
-
-    LOGICAL,           INTENT(OUT) ::  found  !< indicates if variable was found
-
-
-    IF ( debug_output )  CALL debug_message( 'defining module-specific netcdf grids', 'start' )
-!
-!-- As long as no action is done in this subroutine, initialize strings with intent(out) attribute,
-!-- in order to avoid compiler warnings.
-    found  = .FALSE.
-    grid_x = 'none'
-    grid_y = 'none'
-    grid_z = 'none'
-!
-!-- Use var to avoid compiler warning about unused variable
-    IF ( var == ' ' )  RETURN
-
-    IF ( debug_output )  CALL debug_message( 'defining module-specific netcdf grids', 'end' )
-
-
- END SUBROUTINE module_interface_define_netcdf_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate module-specific arrays and pointers
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_init_arrays
-
-
-    IF ( debug_output )  CALL debug_message( 'initializing module-specific arrays', 'start' )
-
-    CALL dynamics_init_arrays
-    CALL tcm_init_arrays
-
-    IF ( bulk_cloud_model    )  CALL bcm_init_arrays
-    IF ( air_chemistry       )  CALL chem_init_arrays
-    IF ( gust_module_enabled )  CALL gust_init_arrays
-    IF ( particle_advection  )  CALL lpm_init_arrays
-    IF ( land_surface        )  CALL lsm_init_arrays
-    IF ( ocean_mode          )  CALL ocean_init_arrays
-    IF ( salsa               )  CALL salsa_init_arrays
-    IF ( urban_surface       )  CALL usm_init_arrays
-    IF ( surface_output      )  CALL surface_data_output_init_arrays
-    IF ( wind_turbine        )  CALL wtm_init_arrays
-
-    IF ( user_module_enabled )  CALL user_init_arrays
-
-    IF ( debug_output )  CALL debug_message( 'initializing module-specific arrays', 'end' )
-
-
- END SUBROUTINE module_interface_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Perform module-specific initialization
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_init
-
-
-    IF ( debug_output )  CALL debug_message( 'module-specific initialization', 'start' )
-
-    CALL dynamics_init
-    CALL tcm_init
-
-    IF ( biometeorology      )  CALL bio_init
-    IF ( bulk_cloud_model    )  CALL bcm_init
-    IF ( air_chemistry       )  CALL chem_init
-    IF ( virtual_flight      )  CALL flight_init
-    IF ( gust_module_enabled )  CALL gust_init
-    IF ( indoor_model        )  CALL im_init
-    IF ( particle_advection  )  CALL lpm_init
-    IF ( large_scale_forcing )  CALL lsf_init
-    IF ( land_surface        )  CALL lsm_init
-    IF ( nudging             )  CALL nudge_init
-    IF ( ocean_mode          )  CALL ocean_init
-    IF ( plant_canopy        )  CALL pcm_init
-    IF ( salsa               )  CALL salsa_init
-    IF ( urban_surface       )  CALL usm_init
-    IF ( virtual_measurement )  CALL vm_init
-    IF ( wind_turbine        )  CALL wtm_init
-    IF ( radiation           )  CALL radiation_init
-
-    CALL doq_init
-
-    IF ( user_module_enabled )  CALL user_init
-
-    IF ( debug_output )  CALL debug_message( 'module-specific initialization', 'end' )
-
- END SUBROUTINE module_interface_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize boundary conditions and numerical schemes.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_init_numerics
-
-!
-!-- Initialize boundary conditions via surface type
-    CALL init_bc
-!
-!-- Calculate wall flag arrays for the multigrid method.
-!-- Please note, wall flags are only applied in the non-optimized version.
-    CALL poismg_noopt_init
-
- END SUBROUTINE module_interface_init_numerics
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize data output
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_init_output
-
-    INTEGER(iwp) ::  return_value  !< returned status value of called function
-
-!
-!-- Initialize data-output module
-    CALL dom_init( file_suffix_of_output_group=coupling_char,                                      &
-                   mpi_comm_of_output_group=comm2d,                                                &
-                   program_debug_output_unit=9,                                                    &
-                   debug_output=debug_output )
-!
-!-- Define module-specific output quantities
-    IF ( virtual_measurement )  CALL vm_init_output
-    IF ( wind_turbine )         CALL wtm_init_output
-!
-!-- Leave output-definition state
-    return_value = dom_def_end()
-
- END SUBROUTINE module_interface_init_output
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Perform module-specific post-initialization checks
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_init_checks
-
-
-    IF ( debug_output )  CALL debug_message( 'module-specific post-initialization checks', 'start' )
-
-    CALL dynamics_init_checks
-
-    IF ( biometeorology )  CALL bio_init_checks
-
-    IF ( debug_output )  CALL debug_message( 'module-specific post-initialization checks', 'end' )
-
-
- END SUBROUTINE module_interface_init_checks
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Gather module-specific header output
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_header( io )
-
-
-    INTEGER(iwp), INTENT(IN) ::  io  !< unit of the output file
-
-
-    IF ( debug_output )  CALL debug_message( 'module-specific header output', 'start' )
-
-    CALL dynamics_header( io )
-
-    IF ( biometeorology      )  CALL bio_header ( io )
-    IF ( bulk_cloud_model    )  CALL bcm_header( io )
-    IF ( air_chemistry       )  CALL chem_header ( io )
-    IF ( virtual_flight      )  CALL flight_header( io )
-    IF ( gust_module_enabled )  CALL gust_header( io )
-    IF ( particle_advection  )  CALL lpm_header( io )
-    IF ( land_surface        )  CALL lsm_header( io )
-    IF ( large_scale_forcing )  CALL lsf_nudging_header( io )
-    IF ( nesting_offline     )  CALL nesting_offl_header( io )
-    IF ( ocean_mode          )  CALL ocean_header( io )
-    IF ( plant_canopy        )  CALL pcm_header( io )
-    IF ( radiation           )  CALL radiation_header( io )
-    IF ( salsa               )  CALL salsa_header( io )
-    IF ( calculate_spectra   )  CALL spectra_header( io )
-    IF ( syn_turb_gen        )  CALL stg_header( io )
-
-    IF ( user_module_enabled )  CALL user_header( io )
-
-    IF ( debug_output )  CALL debug_message( 'module-specific header output', 'end' )
-
-
- END SUBROUTINE module_interface_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Perform module-specific actions while in time-integration (vector-optimized)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_actions( location )
-
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-    CALL dynamics_actions( location )
-    CALL tcm_actions( location )
-
-    IF ( bulk_cloud_model    )  CALL bcm_actions( location )
-    IF ( air_chemistry       )  CALL chem_actions( location )
-    IF ( gust_module_enabled )  CALL gust_actions( location )
-    IF ( particle_advection  )  CALL lpm_actions( location )
-    IF ( ocean_mode          )  CALL ocean_actions( location )
-    IF ( salsa               )  CALL salsa_actions( location )
-    IF ( wind_turbine        )  CALL wtm_actions( location )
-
-    IF ( user_module_enabled )  CALL user_actions( location )
-    IF ( vdi_checks          )  CALL vdi_actions( location )
-
-
- END SUBROUTINE module_interface_actions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Perform module-specific actions while in time-integration (cache-optimized)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_actions_ij( i, j, location )
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location  !< call location string
-
-    INTEGER(iwp),      INTENT(IN) ::  i         !< grid index in x-direction
-    INTEGER(iwp),      INTENT(IN) ::  j         !< grid index in y-direction
-
-    CALL dynamics_actions( i, j, location )
-    CALL tcm_actions( i, j, location )
-
-    IF ( bulk_cloud_model    )  CALL bcm_actions( i, j, location )
-    IF ( air_chemistry       )  CALL chem_actions( i, j, location )
-    IF ( gust_module_enabled )  CALL gust_actions( i, j, location )
-    IF ( ocean_mode          )  CALL ocean_actions( i, j, location )
-    IF ( salsa               )  CALL salsa_actions( i, j, location )
-    IF ( wind_turbine        )  CALL wtm_actions( i, j, location )
-
-    IF ( user_module_enabled )  CALL user_actions( i, j, location )
-
-
- END SUBROUTINE module_interface_actions_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute module-specific non_advective_processes (vector-optimized)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_non_advective_processes
-
-
-    CALL dynamics_non_advective_processes
-
-    IF ( bulk_cloud_model    )  CALL bcm_non_advective_processes
-    IF ( air_chemistry       )  CALL chem_non_advective_processes
-    IF ( salsa               )  CALL salsa_non_advective_processes
-
-
- END SUBROUTINE module_interface_non_advective_processes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute module-specific non_advective_processes (cache-optimized)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_non_advective_processes_ij( i, j )
-
-
-    INTEGER(iwp), INTENT(IN) ::  i            !< grid index in x-direction
-    INTEGER(iwp), INTENT(IN) ::  j            !< grid index in y-direction
-
-    CALL dynamics_non_advective_processes( i, j )
-
-    IF ( bulk_cloud_model    )  CALL bcm_non_advective_processes( i, j )
-    IF ( air_chemistry       )  CALL chem_non_advective_processes( i, j )
-    IF ( salsa               )  CALL salsa_non_advective_processes( i, j )
-
-
- END SUBROUTINE module_interface_non_advective_processes_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exchange horiz for module-specific quantities
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_exchange_horiz( location )
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific exchange_horiz', 'start' )
-
-    CALL dynamics_exchange_horiz( location )
-
-    IF ( bulk_cloud_model    )  CALL bcm_exchange_horiz( location )
-    IF ( air_chemistry       )  CALL chem_exchange_horiz_bounds( location )
-    IF ( ocean_mode          )  CALL ocean_exchange_horiz( location )
-    IF ( particle_advection  )  CALL lpm_exchange_horiz_bounds( location )
-    IF ( salsa               )  CALL salsa_exchange_horiz_bounds( location )
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific exchange_horiz', 'end' )
-
-
- END SUBROUTINE module_interface_exchange_horiz
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute module-specific prognostic_equations (vector-optimized)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_prognostic_equations
-
-
-    CALL dynamics_prognostic_equations
-    CALL tcm_prognostic_equations
-
-    IF ( bulk_cloud_model    )  CALL bcm_prognostic_equations
-    IF ( air_chemistry       )  CALL chem_prognostic_equations
-    IF ( gust_module_enabled )  CALL gust_prognostic_equations
-    IF ( ocean_mode          )  CALL ocean_prognostic_equations
-    IF ( salsa               )  CALL salsa_prognostic_equations
-
-
- END SUBROUTINE module_interface_prognostic_equations
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute module-specific prognostic_equations (cache-optimized)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_prognostic_equations_ij( i, j, i_omp_start, tn )
-
-
-    INTEGER(iwp), INTENT(IN) ::  i            !< grid index in x-direction
-    INTEGER(iwp), INTENT(IN) ::  j            !< grid index in y-direction
-    INTEGER(iwp), INTENT(IN) ::  i_omp_start  !< first loop index of i-loop in prognostic_equations
-    INTEGER(iwp), INTENT(IN) ::  tn           !< task number of openmp task
-
-    CALL dynamics_prognostic_equations( i, j, i_omp_start, tn )
-    CALL tcm_prognostic_equations( i, j, i_omp_start, tn )
-
-    IF ( bulk_cloud_model    )  CALL bcm_prognostic_equations( i, j, i_omp_start, tn )
-    IF ( air_chemistry       )  CALL chem_prognostic_equations( i, j, i_omp_start, tn )
-    IF ( gust_module_enabled )  CALL gust_prognostic_equations( i, j, i_omp_start, tn )
-    IF ( ocean_mode          )  CALL ocean_prognostic_equations( i, j, i_omp_start, tn )
-    IF ( salsa               )  CALL salsa_prognostic_equations( i, j, i_omp_start, tn )
-
-
- END SUBROUTINE module_interface_prognostic_equations_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute module-specific boundary conditions
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_boundary_conditions
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific boundary_conditions', 'start' )
-
-    CALL dynamics_boundary_conditions
-    CALL tcm_boundary_conds
-
-    IF ( bulk_cloud_model    )  CALL bcm_boundary_conditions
-    IF ( air_chemistry       )  CALL chem_boundary_conditions
-    IF ( ocean_mode          )  CALL ocean_boundary_conditions
-    IF ( salsa               )  CALL salsa_boundary_conditions
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific boundary_conditions', 'end' )
-
-
- END SUBROUTINE module_interface_boundary_conditions
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Swap the timelevel pointers for module-specific arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_swap_timelevel ( swap_mode )
-
-
-    INTEGER(iwp), INTENT(IN) :: swap_mode !< determines procedure of pointer swap
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific swap timelevel', 'start' )
-
-    CALL dynamics_swap_timelevel( swap_mode )
-    CALL tcm_swap_timelevel( swap_mode )
-
-    IF ( bulk_cloud_model    )  CALL bcm_swap_timelevel( swap_mode )
-    IF ( air_chemistry       )  CALL chem_swap_timelevel( swap_mode )
-    IF ( gust_module_enabled )  CALL gust_swap_timelevel( swap_mode )
-    IF ( land_surface        )  CALL lsm_swap_timelevel( swap_mode )
-    IF ( ocean_mode          )  CALL ocean_swap_timelevel( swap_mode )
-    IF ( salsa               )  CALL salsa_swap_timelevel( swap_mode )
-    IF ( urban_surface       )  CALL usm_swap_timelevel( swap_mode )
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific swap timelevel', 'end' )
-
-
- END SUBROUTINE module_interface_swap_timelevel
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Perform module-specific averaging of 3D data
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_3d_data_averaging( mode, variable )
-
-
-    CHARACTER (LEN=*), INTENT(IN) ::  mode     !< averaging interface mode
-    CHARACTER (LEN=*), INTENT(IN) ::  variable !< variable name
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data averaging', 'start' )
-
-    CALL dynamics_3d_data_averaging( mode, variable )
-    CALL tcm_3d_data_averaging( mode, variable )
-
-    IF ( biometeorology      )  CALL bio_3d_data_averaging( mode, variable )
-    IF ( bulk_cloud_model    )  CALL bcm_3d_data_averaging( mode, variable )
-    IF ( air_chemistry       )  CALL chem_3d_data_averaging( mode, variable )
-    CALL doq_3d_data_averaging( mode, variable )  ! ToDo: this seems to be not according to the design
-    IF ( gust_module_enabled )  CALL gust_3d_data_averaging( mode, variable )
-    IF ( land_surface        )  CALL lsm_3d_data_averaging( mode, variable )
-    IF ( ocean_mode          )  CALL ocean_3d_data_averaging( mode, variable )
-    IF ( plant_canopy        )  CALL pcm_3d_data_averaging( mode, variable )
-    IF ( radiation           )  CALL radiation_3d_data_averaging( mode, variable )
-    IF ( salsa               )  CALL salsa_3d_data_averaging( mode, variable )
-    IF ( urban_surface       )  CALL usm_3d_data_averaging( mode, variable )
-
-    IF ( user_module_enabled )  CALL user_3d_data_averaging( mode, variable )
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data averaging', 'end' )
-
-
- END SUBROUTINE module_interface_3d_data_averaging
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Define module-specific 2D output variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_data_output_2d( av, variable, found, grid, mode, local_pf, two_d,     &
-                                             nzb_do, nzt_do, fill_value )
-
-    CHARACTER (LEN=*), INTENT(IN)    ::  mode       !< either 'xy', 'xz' or 'yz'
-    CHARACTER (LEN=*), INTENT(IN)    ::  variable   !< variable name
-    CHARACTER (LEN=*), INTENT(INOUT) ::  grid       !< name of vertical grid
-
-    INTEGER(iwp),      INTENT(IN)    ::  av         !< flag for (non-)average output
-    INTEGER(iwp),      INTENT(IN)    ::  nzb_do     !< vertical output index (bottom) (usually 0)
-    INTEGER(iwp),      INTENT(IN)    ::  nzt_do     !< vertical output index (top) (usually nz_do3d)
-
-    LOGICAL,           INTENT(INOUT) ::  found      !< flag if output variable is found
-    LOGICAL,           INTENT(OUT)   ::  two_d      !< flag for 2D variables
-
-    REAL(wp),          INTENT(IN)    ::  fill_value !< to be removed
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(INOUT) ::  local_pf !< ToDo: can also be kind=sp
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 2d data output', 'start' )
-
-    CALL dynamics_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do,&
-                                  fill_value )
-
-    IF ( .NOT. found )  THEN
-       CALL tcm_data_output_2d( av, variable, found, grid, mode, local_pf, nzb_do, nzt_do )
-    ENDIF
-
-    IF ( .NOT. found  .AND.  biometeorology )  THEN
-       CALL bio_data_output_2d( av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do )
-    ENDIF
-
-    IF ( .NOT. found  .AND.  bulk_cloud_model )  THEN
-       CALL bcm_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
-    ENDIF
-
-    IF ( .NOT. found  .AND.  air_chemistry )  THEN
-       CALL chem_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do, &
-                                 fill_value )
-    ENDIF
-
-    IF ( .NOT. found )  THEN
-       CALL doq_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do,       &
-                           fill_value )
-    ENDIF
-
-    IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
-       CALL gust_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do, &
-                                 fill_value )
-    ENDIF
-
-    IF ( .NOT. found  .AND.  land_surface )  THEN
-       CALL lsm_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
-    ENDIF
-
-    IF ( .NOT. found  .AND.  ocean_mode )  THEN
-       CALL ocean_data_output_2d( av, variable, found, grid, mode, local_pf, nzb_do, nzt_do )
-    ENDIF
-
-    IF ( .NOT. found  .AND.  radiation )  THEN
-       CALL radiation_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do,    &
-                                      nzt_do, fill_value )
-    ENDIF
-
-    IF ( .NOT. found  .AND.  salsa )  THEN
-       CALL salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
-    ENDIF
-
-    IF ( .NOT. found  .AND.  user_module_enabled )  THEN
-       CALL user_data_output_2d( av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do )
-    ENDIF
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 2d data output', 'end' )
-
-
- END SUBROUTINE module_interface_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Define module-specific 3D output variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_data_output_3d( av, variable, found, local_pf, fill_value, resorted,  &
-                                             nzb_do, nzt_do )
-
-    CHARACTER (LEN=*), INTENT(IN)    ::  variable   !< variable name
-
-    INTEGER(iwp),      INTENT(IN)    ::  av         !< flag for (non-)average output
-    INTEGER(iwp),      INTENT(IN)    ::  nzb_do     !< vertical output index (bottom) (usually 0)
-    INTEGER(iwp),      INTENT(IN)    ::  nzt_do     !< vertical output index (top) (usually nz_do3d)
-
-    LOGICAL,           INTENT(INOUT) ::  found      !< flag if output variable is found
-    LOGICAL,           INTENT(OUT)   ::  resorted   !< flag if output has been resorted
-
-    REAL(wp),          INTENT(IN)    ::  fill_value !< ToDo: refactor
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(INOUT) ::  local_pf
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data output', 'start' )
-
-    CALL dynamics_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-    resorted = .FALSE.
-
-    IF ( .NOT. found )  THEN
-       CALL tcm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( .NOT. found  .AND.  biometeorology )  THEN
-       CALL bio_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-       resorted = .FALSE.
-    ENDIF
-
-    IF ( .NOT. found  .AND.  bulk_cloud_model )  THEN
-       CALL bcm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( .NOT. found  .AND.  air_chemistry )  THEN
-       CALL chem_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( .NOT. found )  THEN
-       CALL doq_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
-       CALL gust_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( .NOT. found  .AND.  indoor_model )  THEN
-       CALL im_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( .NOT. found  .AND.  ocean_mode )  THEN
-       CALL ocean_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( .NOT. found  .AND.  plant_canopy )  THEN
-       CALL pcm_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( .NOT. found  .AND.  radiation )  THEN
-       CALL radiation_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( .NOT. found  .AND.  salsa )  THEN
-       CALL salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( .NOT. found  .AND.  user_module_enabled )  THEN
-       CALL user_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-       resorted = .TRUE.
-    ENDIF
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data output', 'end' )
-
-
- END SUBROUTINE module_interface_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute module-specific profile and timeseries data
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_statistics( mode, sr, tn, dots_max )
-
-
-    CHARACTER (LEN=*), INTENT(IN) ::  mode     !< statistical analysis mode
-
-    INTEGER(iwp),      INTENT(IN) ::  dots_max !< maximum number of timeseries
-    INTEGER(iwp),      INTENT(IN) ::  sr       !<
-    INTEGER(iwp),      INTENT(IN) ::  tn       !<
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific statistics', 'start' )
-
-    CALL dynamics_statistics( mode, sr, tn )
-    CALL doq_statistics( mode, sr, tn )
-
-    IF ( gust_module_enabled )  CALL gust_statistics( mode, sr, tn, dots_max )
-    IF ( air_chemistry       )  CALL chem_statistics( mode, sr, tn )
-    IF ( salsa               )  CALL salsa_statistics( mode, sr, tn )
-
-    IF ( user_module_enabled )  CALL user_statistics( mode, sr, tn )
-
-    IF ( debug_output_timestep )  CALL debug_message( 'module-specific statistics', 'end' )
-
-
- END SUBROUTINE module_interface_statistics
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific restart data in Fortran binary format globaly shared by all MPI ranks
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_rrd_global_ftn( found )
-
-
-    LOGICAL, INTENT(INOUT) ::  found    !< flag if variable was found
-
-
-    IF ( debug_output )  CALL debug_message( 'module-specific read global restart data', 'start' )
-
-    CALL dynamics_rrd_global( found ) ! ToDo: change interface to pass variable
-
-    IF ( .NOT. found )  CALL bio_rrd_global( found ) ! ToDo: change interface to pass variable
-    IF ( .NOT. found )  CALL bcm_rrd_global( found ) ! ToDo: change interface to pass variable
-    IF ( .NOT. found )  CALL flight_rrd_global( found ) ! ToDo: change interface to pass variable
-    IF ( .NOT. found )  CALL gust_rrd_global( found ) ! ToDo: change interface to pass variable
-    IF ( .NOT. found )  CALL lpm_rrd_global( found ) ! ToDo: change interface to pass variable
-    IF ( .NOT. found )  CALL pcm_rrd_global( found )
-    IF ( .NOT. found )  CALL ocean_rrd_global( found ) ! ToDo: change interface to pass variable
-    IF ( .NOT. found )  CALL salsa_rrd_global( found )
-    IF ( .NOT. found )  CALL stg_rrd_global ( found ) ! ToDo: change interface to pass variable
-    IF ( .NOT. found )  CALL wtm_rrd_global( found ) ! ToDo: change interface to pass variable
-    IF ( .NOT. found )  CALL surface_data_output_rrd_global( found )
-
-    IF ( .NOT. found )  CALL user_rrd_global( found ) ! ToDo: change interface to pass variable
-
-    IF ( debug_output )  CALL debug_message( 'module-specific read global restart data', 'end' )
-
-
- END SUBROUTINE module_interface_rrd_global_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific restart data in MPI format globaly shared by all MPI ranks
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_rrd_global_mpi
-
-
-    IF ( debug_output )  CALL debug_message( 'module-specific read global restart data', 'start' )
-
-    CALL dynamics_rrd_global
-
-    IF ( biometeorology )       CALL bio_rrd_global
-    IF ( bulk_cloud_model )     CALL bcm_rrd_global
-    IF ( virtual_flight )       CALL flight_rrd_global
-    IF ( gust_module_enabled )  CALL gust_rrd_global
-    IF ( particle_advection )   CALL lpm_rrd_global
-    IF ( plant_canopy )         CALL pcm_rrd_global
-    IF ( ocean_mode )           CALL ocean_rrd_global
-    IF ( salsa )                CALL salsa_rrd_global
-    IF ( syn_turb_gen )         CALL stg_rrd_global
-    IF ( wind_turbine )         CALL wtm_rrd_global
-    IF ( surface_output )       CALL surface_data_output_rrd_global
-
-    IF ( user_module_enabled )  CALL user_rrd_global
-
-    IF ( debug_output )  CALL debug_message( 'module-specific read global restart data', 'end' )
-
-
- END SUBROUTINE module_interface_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write module-specific restart data globaly shared by all MPI ranks
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_wrd_global
-
-
-    IF ( debug_output )  CALL debug_message( 'module-specific write global restart data', 'start' )
-
-    CALL dynamics_wrd_global
-
-    IF ( biometeorology )       CALL bio_wrd_global
-    IF ( bulk_cloud_model )     CALL bcm_wrd_global
-    IF ( virtual_flight )       CALL flight_wrd_global
-    IF ( gust_module_enabled )  CALL gust_wrd_global
-    IF ( particle_advection )   CALL lpm_wrd_global
-    IF ( plant_canopy )         CALL pcm_wrd_global
-    IF ( ocean_mode )           CALL ocean_wrd_global
-    IF ( salsa )                CALL salsa_wrd_global
-    IF ( syn_turb_gen )         CALL stg_wrd_global
-    IF ( wind_turbine )         CALL wtm_wrd_global
-    IF ( surface_output )       CALL surface_data_output_wrd_global
-
-    IF ( user_module_enabled )  CALL user_wrd_global
-
-    IF ( debug_output )  CALL debug_message( 'module-specific write global restart data', 'end' )
-
-
- END SUBROUTINE module_interface_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_rrd_local_ftn( map_index,                                             &
-                                            nxlf, nxlc, nxl_on_file,                               &
-                                            nxrf, nxrc, nxr_on_file,                               &
-                                            nynf, nync, nyn_on_file,                               &
-                                            nysf, nysc, nys_on_file,                               &
-                                            tmp_2d, tmp_3d, found )
-
-
-    INTEGER(iwp), INTENT(IN)  ::  map_index    !<
-    INTEGER(iwp), INTENT(IN)  ::  nxlc         !<
-    INTEGER(iwp), INTENT(IN)  ::  nxlf         !<
-    INTEGER(iwp), INTENT(IN)  ::  nxl_on_file  !<
-    INTEGER(iwp), INTENT(IN)  ::  nxrc         !<
-    INTEGER(iwp), INTENT(IN)  ::  nxrf         !<
-    INTEGER(iwp), INTENT(IN)  ::  nxr_on_file  !<
-    INTEGER(iwp), INTENT(IN)  ::  nync         !<
-    INTEGER(iwp), INTENT(IN)  ::  nynf         !<
-    INTEGER(iwp), INTENT(IN)  ::  nyn_on_file  !<
-    INTEGER(iwp), INTENT(IN)  ::  nysc         !<
-    INTEGER(iwp), INTENT(IN)  ::  nysf         !<
-    INTEGER(iwp), INTENT(IN)  ::  nys_on_file  !<
-
-    LOGICAL,      INTENT(INOUT) ::  found        !< flag if variable was found
-
-    REAL(wp),                                                                                      &
-       DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp),             &
-       INTENT(OUT) :: tmp_2d   !<
-    REAL(wp),                                                                                      &
-       DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp),   &
-       INTENT(OUT) :: tmp_3d   !<
-
-
-    IF ( debug_output )  THEN
-       CALL debug_message( 'module-specific read local restart data (Fortran binary)', 'start' )
-    ENDIF
-
-    CALL dynamics_rrd_local( map_index,                                                            &
-                             nxlf, nxlc, nxl_on_file,                                              &
-                             nxrf, nxrc, nxr_on_file,                                              &
-                             nynf, nync, nyn_on_file,                                              &
-                             nysf, nysc, nys_on_file,                                              &
-                             tmp_2d, tmp_3d, found                                                 &
-                           ) ! ToDo: change interface to pass variable
-
-    IF ( .NOT. found )  CALL bio_rrd_local( found )
-
-    IF ( .NOT. found )  CALL bcm_rrd_local( map_index,                                             &
-                                            nxlf, nxlc, nxl_on_file,                               &
-                                            nxrf, nxrc, nxr_on_file,                               &
-                                            nynf, nync, nyn_on_file,                               &
-                                            nysf, nysc, nys_on_file,                               &
-                                            tmp_2d, tmp_3d, found                                  &
-                                          ) ! ToDo: change interface to pass variable
-
-    IF ( .NOT. found )  CALL chem_rrd_local( map_index,                                            &
-                                             nxlf, nxlc, nxl_on_file,                              &
-                                             nxrf, nxrc, nxr_on_file,                              &
-                                             nynf, nync, nyn_on_file,                              &
-                                             nysf, nysc, nys_on_file,                              &
-                                             tmp_3d, found                                         &
-                                           ) ! ToDo: change interface to pass variable
-
-    IF ( .NOT. found )  CALL doq_rrd_local( map_index,                                             &
-                                            nxlf, nxlc, nxl_on_file,                               &
-                                            nxrf, nxrc, nxr_on_file,                               &
-                                            nynf, nync, nyn_on_file,                               &
-                                            nysf, nysc, nys_on_file,                               &
-                                            tmp_2d, tmp_3d, found                                  &
-                                          ) ! ToDo: change interface to pass variable
-
-    IF ( .NOT. found )  CALL gust_rrd_local( map_index,                                            &
-                                             nxlf, nxlc, nxl_on_file,                              &
-                                             nxrf, nxrc, nxr_on_file,                              &
-                                             nynf, nync, nyn_on_file,                              &
-                                             nysf, nysc, nys_on_file,                              &
-                                             tmp_2d, tmp_3d, found                                 &
-                                           ) ! ToDo: change interface to pass variable
-
-    IF ( .NOT. found )  CALL lpm_rrd_local( map_index,                                             &
-                                            nxlf, nxlc, nxl_on_file,                               &
-                                            nxrf, nxrc, nxr_on_file,                               &
-                                            nynf, nync, nyn_on_file,                               &
-                                            nysf, nysc, nys_on_file,                               &
-                                            tmp_3d, found                                          &
-                                          ) ! ToDo: change interface to pass variable
-
-    IF ( .NOT. found )  CALL lsm_rrd_local( map_index,                                             &
-                                            nxlf, nxlc, nxl_on_file,                               &
-                                            nxrf, nxrc, nxr_on_file,                               &
-                                            nynf, nync, nyn_on_file,                               &
-                                            nysf, nysc, nys_on_file,                               &
-                                            tmp_2d, found                                          &
-                                          ) ! ToDo: change interface to pass variable
-
-     IF ( .NOT. found )  CALL pcm_rrd_local( map_index,                                            &
-                                             nxlf, nxlc, nxl_on_file,                              &
-                                             nxrf, nxrc, nxr_on_file,                              &
-                                             nynf, nync, nyn_on_file,                              &
-                                             nysf, nysc, nys_on_file,                              &
-                                             found                                                 &
-                                           )
-
-    IF ( .NOT. found )  CALL ocean_rrd_local( map_index,                                           &
-                                              nxlf, nxlc, nxl_on_file,                             &
-                                              nxrf, nxrc, nxr_on_file,                             &
-                                              nynf, nync, nyn_on_file,                             &
-                                              nysf, nysc, nys_on_file,                             &
-                                              tmp_3d, found                                        &
-                                            ) ! ToDo: change interface to pass variable
-
-    IF ( .NOT. found )  CALL radiation_rrd_local( map_index,                                       &
-                                                  nxlf, nxlc, nxl_on_file,                         &
-                                                  nxrf, nxrc, nxr_on_file,                         &
-                                                  nynf, nync, nyn_on_file,                         &
-                                                  nysf, nysc, nys_on_file,                         &
-                                                  tmp_2d, tmp_3d, found                            &
-                                                ) ! ToDo: change interface to pass variable
-
-    IF ( .NOT. found )  CALL salsa_rrd_local( map_index,                                           &
-                                              nxlf, nxlc, nxl_on_file,                             &
-                                              nxrf, nxrc, nxr_on_file,                             &
-                                              nynf, nync, nyn_on_file,                             &
-                                              nysf, nysc, nys_on_file,                             &
-                                              tmp_3d, found                                        &
-                                            ) ! ToDo: change interface to pass variable
-
-    IF ( .NOT. found )  CALL usm_rrd_local( map_index,                                             &
-                                            nxlf, nxlc, nxl_on_file,                               &
-                                            nxrf, nxr_on_file,                                     &
-                                            nynf, nyn_on_file,                                     &
-                                            nysf, nysc, nys_on_file,                               &
-                                            found                                                  &
-                                          ) ! ToDo: change interface to pass variable
-!
-!-- Surface data do not need overlap data, so do not pass these information.
-    IF ( .NOT. found )  CALL surface_data_output_rrd_local( found )
-
-    IF ( .NOT. found )  CALL user_rrd_local( map_index,                                            &
-                                             nxlf, nxlc, nxl_on_file,                              &
-                                             nxrf, nxrc, nxr_on_file,                              &
-                                             nynf, nync, nyn_on_file,                              &
-                                             nysf, nysc, nys_on_file,                              &
-                                             tmp_3d, found                                         &
-                                           ) ! ToDo: change interface to pass variable
-
-    IF ( debug_output )  THEN
-       CALL debug_message( 'module-specific read local restart data (Fortran binary)', 'end' )
-    ENDIF
-
- END SUBROUTINE module_interface_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_rrd_local_mpi
-
-    IF ( debug_output )  THEN
-       CALL debug_message( 'module-specific read local restart data (MPI-IO)', 'start' )
-    ENDIF
-
-    CALL dynamics_rrd_local
-
-    IF ( biometeorology )       CALL bio_rrd_local
-    IF ( bulk_cloud_model )     CALL bcm_rrd_local
-    IF ( air_chemistry )        CALL chem_rrd_local
-    CALL doq_rrd_local
-    IF ( gust_module_enabled )  CALL gust_rrd_local
-    IF ( particle_advection )   CALL lpm_rrd_local
-    IF ( land_surface )         CALL lsm_rrd_local
-    IF ( plant_canopy )         CALL pcm_rrd_local
-    IF ( ocean_mode )           CALL ocean_rrd_local
-    IF ( radiation )            CALL radiation_rrd_local
-    IF ( salsa )                CALL salsa_rrd_local
-    IF ( urban_surface )        CALL usm_rrd_local
-    IF ( surface_output )       CALL surface_data_output_rrd_local
-
-    IF ( user_module_enabled )  CALL user_rrd_local
-
-    IF ( debug_output )  THEN
-       CALL debug_message( 'module-specific read local restart data (Fortran binary)', 'end' )
-    ENDIF
-
- END SUBROUTINE module_interface_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write module-specific restart data specific to local MPI ranks
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_wrd_local
-
-
-    IF ( debug_output )  CALL debug_message( 'module-specific write local restart data', 'start' )
-
-    CALL dynamics_wrd_local
-
-    IF ( biometeorology )       CALL bio_wrd_local
-    IF ( bulk_cloud_model )     CALL bcm_wrd_local
-    IF ( air_chemistry )        CALL chem_wrd_local
-    CALL doq_wrd_local
-    IF ( gust_module_enabled )  CALL gust_wrd_local
-    IF ( particle_advection )   CALL lpm_wrd_local
-    IF ( land_surface )         CALL lsm_wrd_local
-    IF ( plant_canopy )         CALL pcm_wrd_local
-    IF ( ocean_mode )           CALL ocean_wrd_local
-    IF ( radiation )            CALL radiation_wrd_local
-    IF ( salsa )                CALL salsa_wrd_local
-    IF ( urban_surface )        CALL usm_wrd_local
-    IF ( surface_output )       CALL surface_data_output_wrd_local
-
-    IF ( user_module_enabled )  CALL user_wrd_local
-
-    IF ( debug_output )  CALL debug_message( 'module-specific write local restart data', 'end' )
-
-
- END SUBROUTINE module_interface_wrd_local
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Perform module-specific last actions before the program terminates
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE module_interface_last_actions
-
-    INTEGER ::  return_value  !< returned status value of a called function
-
-
-    IF ( debug_output )  CALL debug_message( 'module-specific last actions', 'start' )
-
-    return_value = dom_finalize_output()
-
-    CALL dynamics_last_actions
-    IF ( particle_advection )   CALL lpm_last_actions
-    IF ( user_module_enabled )  CALL user_last_actions
-
-    IF ( debug_output )  CALL debug_message( 'module-specific last actions', 'end' )
-
-
- END SUBROUTINE module_interface_last_actions
-
-
- END MODULE module_interface
Index: palm/trunk/SOURCE/modules.f90
===================================================================
--- palm/trunk/SOURCE/modules.f90	(revision 4901)
+++ palm/trunk/SOURCE/modules.f90	(revision 1)
@@ -1,194 +1,283 @@
-!> @file modules.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
+ MODULE advection
+
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! array size for profiles increased from 400 to 500
-!
-! 4853 2021-01-25 07:56:09Z raasch
-! array size for profiles increased from 300 to 400
-!
-! 4845 2021-01-18 11:15:37Z raasch
-! -use_cmax and arrays required for radiation boundary conditions
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! file re-formatted to follow the PALM coding standard
-!
-! 4742 2020-10-14 15:11:02Z schwenkel
-! Implement snow and graupel (bulk microphysics)
-!
-! 4721 2020-10-02 10:21:52Z suehring
-! Change default value spinup_pt_amplitude to 0.0 K
-!
-! 4680 2020-09-16 10:20:34Z gronemeier
-! Add option to fix date or time of the simulation
-!
-! 4658 2020-08-28 18:15:50Z suehring
-! Change default value of dt_spinup
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4581 2020-06-29 08:49:58Z suehring
-! +sums_wschs_ws_l
-!
-! 4574 2020-06-24 16:33:32Z pavelkrc
-!
-! 4572 2020-06-24 10:09:41Z gronemeier
-! Revise description of rotation_angle
-!
-! 4565 2020-06-15 08:30:38Z oliver.maas
-! added pt_surface_heating_rate
-!
-! 4536 2020-05-17 17:24:13Z raasch
-! +qsurf_av, ssurf_av
-!
-! 4505 2020-04-20 15:37:15Z schwenkel
-! Add flag for saturation check
-!
-! 4502 2020-04-17 16:14:16Z raasch
-! Implementation of ice microphysics
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! +restart_data_format, restart_data_format_input|output, include_total_domain_boundaries
-!
-! 4476 2020-03-27 12:56:41Z maronga
-! Renamed variables for subgrids-scale model steering
-!
-! 4473 2020-03-25 21:04:07Z gronemeier
-! moved wall_adjustment_factor to turbulence_closure_mod
-!
-! 4472 2020-03-24 12:21:00Z Giersch
-! Additional switch added to activate calculations in flow_statistics for the kolmogorov length
-! scale
-!
-! 4461 2020-03-12 16:51:59Z raasch
-! +virtual_pe_grid, communicator_configurations
-!
-! 4414 2020-02-19 20:16:04Z suehring
-! - nzb_diff_s_inner, nzb_diff_s_outer, nzb_inner,nzb_outer, nzb_s_inner, nzb_s_outer, nzb_u_inner,
-!   nzb_u_outer, nzb_v_inner, nzb_v_outer, nzb_w_inner, nzb_w_outer
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4340 2019-12-16 08:17:03Z Giersch
-! Flag for topography closed channel flow with symmetric boundaries introduced
-!
-! 4331 2019-12-10 18:25:02Z suehring
-! - do_output_at_2m, pt_2m_av
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4301 2019-11-22 12:09:09Z oliver.maas
-! removed recycling_yshift
-!
-! 4297 2019-11-21 10:37:50Z oliver.maas
-! changed variable type of recycling_yshift from LOGICAL to INTEGER
-!
-! 4293 2019-11-12 14:44:01Z Giersch
-! Add origin_date_time
-!
-! 4146 2019-08-07 07:47:36Z gronemeier
-! Added rotation_angle
-!
-! 4184 2019-08-23 08:07:40Z oliver.maas
-! changed allocated length of recycling_method_for_thermodynamic_quantities from 20 to 80 characters
-!
-! 4183 2019-08-23 07:33:16Z oliver.maas
-! removed recycle_absolute_quantities and raq
-! added recycling_method_for_thermodynamic_quantities
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4173 2019-08-20 12:04:06Z gronemeier
-! add vdi_internal_controls
-!
-! 4172 2019-08-20 11:55:33Z oliver.maas
-! added recycle_absolute_quantities and raq
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! +topo_top_ind
-!
-! 4131 2019-08-02 11:06:18Z monakurppa
-! Add max_pr_salsa to control_parameters. Used in creating profile output for salsa.
-!
-! 4110 2019-07-22 17:05:21Z suehring
-! -advc_flags_1, advc_flags_2
-! +advc_flags_m, advc_flags_s
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! remove old_dt
-!
-! 4079 2019-07-09 18:04:41Z suehring
-! + monotonic_limiter_z
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to avoid runtime error
-! (Loop variable has been modified) in time_integration
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! increase maximum number of virtual flights
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3871 2019-04-08 14:38:39Z knoop
-! Initialized parameter region
-!
-! 3746 2019-02-16 12:41:27Z gronemeier
-! Removed most_method
-!
-! 3648 2019-01-02 16:35:46Z suehring
-! -surface_data_output +surface_output
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of global variables
-!--------------------------------------------------------------------------------------------------!
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of variables for special advection schemes.
-!--------------------------------------------------------------------------------------------------!
- MODULE advection
-
-    USE kinds
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  aex  !< exponential coefficient for the Bott-Chlond advection scheme
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bex  !< exponential coefficient for the Bott-Chlond advection scheme
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  dex  !< exponential coefficient for the Bott-Chlond advection scheme
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  eex  !< exponential coefficient for the Bott-Chlond advection scheme
+! $Log: modules.f90,v $
+! Revision 1.95  2007/02/11 13:18:30  raasch
+! version 3.1b (last under RCS control)
+!
+! Revision 1.94  2006/08/22 14:12:18  raasch
+! +dz_max,
+! id_var_dopts extended for second dimension
+!
+! Revision 1.93  2006/08/04 14:50:58  raasch
+! +c_0, diss, dt_min_part, end_time_prel, particles_per_point, sgs_wfu/v/w_part,
+! use_sgs_for_particles, use_upstream_for_tke needed for the particle package,
+! +dt_sum, e_m, speed_x/y/z/_sgs in particle_type,
+! +dt_dopts, time_dopts, netcdf ids for output of particle time series,
+! do2d_unit and do3d_unit now defined as 2d-arrays, izuf renamed iran
+!
+! Revision 1.92  2006/06/02 15:21:45  raasch
+! +NetCDF ids for the shifted u- and v-grid, +data_output_xy/xz/yz
+!
+! Revision 1.91  2006/04/26 12:22:52  raasch
+! +threads_per_task,
+! sums_l, sums_l_l arrays changed to three dimensions
+!
+! Revision 1.90  2006/04/11 14:58:27  raasch
+! pl_spectra renamed data_output_sp, length of run_identifier increased to 80
+!
+! Revision 1.89  2006/03/14 12:55:52  raasch
+! Default for number_of_particle_groups changed to 1
+!
+! Revision 1.88  2006/03/03 14:26:53  letzel
+! control parameter topography now has length 40
+!
+! Revision 1.87  2006/03/03 08:50:25  raasch
+! Default value for surface_heatflux changed to 9999999.9
+!
+! Revision 1.86  2006/02/23 12:39:14  raasch
+! Version 3.0 with topography
+! index arrays nzb_2d replaced by several new variable dependend arrays
+! (e.g. nzb_u_inner), nzb_diff_2d removed, +new grid point
+! counters ngp_2dh_outer and ngp_3d_inner,
+! +skip time control parameters skip_time_..., +log_message,
+! particle parameters psl, psr, pss, psn, psb, pst, pdx, pdy, pdz
+! are now 1D arrays (1:max_number_of_particle_groups), default of
+! number_of_particle_groups changed to 999999, idum in particle_type renamed
+! tail_id,
+! +data_output, data_output_user, do2d, do3d, doav for new steering of data
+! output,
+! +type_x_int for ghost exchange of integer arrays,
+! +netcdf_64bit for supporting NetCDF 64-bit offset format,
+! +mixing_length_1d, dissipation_1d for steering the 1d-model,
+! +e_min (control parameter for minimum tke), +parameters for assuring a
+! constant volume flow, +prt_count, prt_start_index, particle_advection,
+! ebene renamed section, nt_anz renamed current_timestep_number, anz_y..
+! renamed ngp_y.., nanz_sums, nanz_2dh, nanz_3d renamed ngp_sums, ngp_2dh,
+! ngp_3d, respectively, pl1d_anz, pl2d_.._anz, plts_anz, pl3d_anz renamed
+! dopr_n, pl2d_.._no, dots_n, do3d_n, respectively,
+! ql_v and ql_vp now have the target attribute,
+! average_period_pr1d removed
+!
+! Revision 1.85  2005/12/06 16:40:56  raasch
+! Version 2.11c
+!
+! Revision 1.84  2005/10/20 15:38:23  raasch
+! +id_var_rnop_prt, some values of prt_var_names and prt_var_units changed
+!
+! Revision 1.83  2005/06/29 10:40:30  steinfeld
+! Scalars ug and vg changed into one-dimensional arrays;
+! +ug_surface, ug_vertical_gradient, ug_vertical_gradient_level,
+!  ug_vertical_gradient_level_ind,
+!  vg_surface, vg_vertical_gradient, vg_vertical_gradient_level,
+!  vg_vertical_gradient_level_ind
+!
+! Revision 1.82  2005/06/26 20:03:33  raasch
+! +ql_1, ql_2, ql_m, ql is now a pointer, +variables for cloud droplets (arrays
+! ql_v,ql_vp, pointer ql_c), gas_constant renamed r_d, latent_heat renamed l_v,
+! radius instead of diameter, radius + weighting factor included in
+! particle_type, pl2d and pl3d string length increased from 6 to 10,
+! default of call_psolver_at_all_substeps is TRUE
+!
+! Revision 1.81  2005/05/18 15:36:46  raasch
+! New module netcdf_control, +data_output_format, pl1d_callcount renamed
+! dopr_time_count,
+! default values of pl_spectra and spectra_direction changed
+!
+! Revision 1.80  2005/04/23 09:31:14  raasch
+! Implicit counters i renamed i9 due to declaration conflicts with i in other
+! subroutines (reported by Portland compiler),
+! crmax increased to 100, fcl_factor renamed cfl_factor
+!
+! Revision 1.79  2005/03/26 20:40:48  raasch
+! +variables for non-cyclic boundary conditions, call_psolver_at_all_substeps,
+! default value for residual limit increased from 1E-6 to 1E-4
+!
+! Revision 1.78  2004/04/30 12:30:01  raasch
+! idum added in particle_type for better alignment (decalpha),
+! DATA statements replaced by (/ .../) because of internal compiler errors
+! on decalpha, + indices for direct transpositions z --> y,
+! dt_max_1d increased to 300.0 (from 60.0), +grid_matching,
+! arrays cross_ts_numbers and cross_ts_number_count enlarged,
+! impulse_advec renamed momentum_advec
+!
+! Revision 1.77  2004/01/30 10:30:26  raasch
+! +index arrays nzb_2d, nzb_diff_2d
+!
+! Revision 1.76  2004/01/28 15:25:15  raasch
+! +array tsc for timestep steering, +tu_m, tv_m etc. pointer for additional
+! tendencies needed for Runge-Kutta scheme, +intermediate_timestep_count(_max)
+! type log changed to logpoint due to name conflict with intrinsic log
+!
+! Revision 1.75  2003/10/29 08:58:54  raasch
+! +mg_cycles, mg_switch_to_pe0, mg_switch_to_pe0_level in module
+! control_parameters,
+! +mg_loc_ind in module indices, variables related to particle groups added
+! to module particle_attributes
+!
+! Revision 1.74  2003/08/01 08:40:59  raasch
+! +isclice_dvrp, lock_steering_update, slicer_position_dvrp,
+! slicer_range_limits_dvrp in module dvrp_variables
+!
+! Revision 1.73  2003/05/09 14:41:11  raasch
+! New version number 2.7
+!
+! Revision 1.72  2003/04/25 18:54:39  raasch
+! Module mpi added in module pegrid in case of linux cluster
+!
+! Revision 1.71  2003/04/16 13:27:33  raasch
+! Arrays cross_ts_uy... enlarged
+!
+! Revision 1.70  2003/04/16 13:07:43  raasch
+! Array cross_ts_profiles enlarged
+!
+! Revision 1.69  2003/03/16 09:42:07  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.68  2003/03/14 13:44:52  raasch
+! +random_generator in control_parameters
+!
+! Revision 1.67  2003/03/12 16:34:19  raasch
+! +tasks_per_node in pegrid
+!
+! Revision 1.66  2003/03/04 11:32:50  raasch
+! +type steering, +steering_dvrp in dvrp_variables
+!
+! Revision 1.65  2002/12/19 15:52:37  raasch
+! +initial_wallclock_time in cpulog, +myid_char_14 in pegrid,
+! default value for termination_time_needed now set in check_parameters,
+! array dl_grid removed, +wall_adjustment_factor, dt_restart, restart_time,
+! time_restart
+!
+! Revision 1.64  2002/09/12 13:05:44  raasch
+! Default values of *_vertical_gradient_level changed from 100000.0 to -1.0,
+! +molecular_viscosity, density_ratio
+!
+! Revision 1.63  2002/06/11 13:12:29  raasch
+! Entrys buoyancy, diffusion_e, diffusion_s, diffusion_u, diffusion_v and
+! diffusion_w removed from module pointer_interfaces,
+! length of character variables host + psolver increased to 64 and 16
+!
+! Revision 1.62  2002/05/02 18:53:18  raasch
+! Module singleton moved to a separate file. Arrays e_3, pt_3, q_3, u_3, v_3,
+! w_3 re-introduced. Pointer e_p, pt_p, q_p, u_p, v_p, w_p re-introduced.
+!
+! Revision 1.61  2002/04/16 08:09:32  raasch
+! Information about speed components and start positions included in
+! particle_type, +dt_write_particle_data, particle_advection_start,
+! time_write_particle_data and parameters for particle boundary conditions,
+! +vertical_particle_advection,
+! + variables for scalar boundary conditions and initialization
+!
+! Revision 1.60  2001/11/12 16:05:01  raasch
+! +read_particles_from_restartfile
+!
+! Revision 1.58  2001/09/04 12:00:52  raasch
+! New version number 2.3b
+!
+! Revision 1.57  2001/08/21 09:52:08  raasch
+! +comm_palm, maximum_number_of_tailpoints, maximum_tailpoint_age,
+! minimum_tailpoint_distance, particle_tail_coordinates, superelevation_x,
+! superelevation_y, wall_adjustment
+!
+! Revision 1.56  2001/07/20 13:09:07  raasch
+! +grid_level, maximum_grid_level, cycle_mg, gamma_mg, ngsrb,
+! residual_limit in control_parameters, +dzu_mg, dzw_mg, f1_mg, f2_mg, f3_mg
+! in arrays_3d, +superelevation in dvrp_variables, +nxl_mg .. nzt_mg in
+! indices, +ddx2_mg, ddy2_mg in grid_variables
+!
+! Revision 1.55  2001/07/12 12:13:24  raasch
+! default of bc_e_b changed from (u*)**2+neumann to neumann,
+! +particle_maximum_age, psl-pst, pdx-pdz,
+! default values defined for dvrp_directory, dvrp_file, dvrp_host, dvrp_password
+! SAVE-statements added to all modules
+!
+! Revision 1.54  2001/03/30 07:35:57  raasch
+! Interface for advec_s_bc changed, interface for production_e eliminated,
+! arrays work, work1, e_3, pt_3, q_3, u_3, v_3, w_3 removed,
+! pointer e_p, pt_p, q_p, u_p, v_p, w_p removed,
+! -nw, nw1,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.53  2001/01/30 01:57:16  raasch
+! +passive_scalar
+!
+! Revision 1.51  2001/01/26 00:31:49  raasch
+! +fft_method, use_surface_fluxes in steuer, +module singleton,
+! +write_particle_informations in particle_attributes
+!
+! Revision 1.49  2001/01/05 15:13:16  raasch
+! new module spectrum for computing spectra, +average_count_sp,
+! averaging_interval_sp, dt_dosp, time_average_sp, time_dosp in module steuer,
+! +spectrum_x, spectrum_y in module statistik
+!
+! Revision 1.48  2001/01/02 17:31:36  raasch
+! openfile has the new type file_status, version updated to 2.1a
+!
+! Revision 1.47  2000/12/30 18:48:53  raasch
+! Default value of mode_dvrp changed
+!
+! Revision 1.46  2000/12/28 13:21:35  raasch
+! version updated to 2.1
+!
+! Revision 1.45  2000/12/28 13:19:35  raasch
+! +mode_dvrp, +interval_..._dvrp, REAL*4 changed to REAL in particle_attributes,
+! +dt_prel, time_prel, -particle_transport
+!
+! Revision 1.44  2000/07/03 13:02:32  raasch
+! version updated to 2.0b
+!
+! Revision 1.43  2000/07/03 12:59:53  raasch
+! +dvrp_directory, dvrp_host, dvrp_password, dvrp_username,
+! new module pointer_interfaces which includes interfaces for subroutines with
+! pointer arguments called in prognostic_equations
+!
+! Revision 1.42  2000/04/27 07:35:56  raasch
+! npex and npey must be defined in general (not only for parallel case)
+!
+! Revision 1.41  2000/04/27 07:07:14  raasch
+! +pt_slope_offset, pt_slope_ref, npex, npey, dt_dvrp, time_dvrp,
+! new module dvrp_variables
+! -dt_plisos, dt_plpart, isosurface_filecount, time_plisos, time_plpart
+! Version 2.0a, all comments translated into English, old revision remarks
+! deleted
+!
+! Revision 1.40  2000/04/13 13:17:25  schroeter
+! Felder fuer Wolkenphysik zu Modul arrays3d hinzugefuegt, neues Modul
+! (cloud_parameters) fuer Wolkenphysikparameter eingefuegt
+!
+! Revision 1.39  2000/01/10  10:05:11  10:05:11  raasch (Siegfried Raasch)
+! +use_ug_for_galilei_tr, Aufteilung der zeitabhaengigen Groessen in pointer
+! und targets, + timestep_count
+! 
+! Revision 1.38  1999/12/28 10:06:52  raasch
+! +Variablen fuer Plot von Isooberflaechen
+!
+! Revision 1.37  1999/11/25 16:26:38  raasch
+! Neues Modul particle_attributes,
+! +Variablen fuer Partikelverlagerung: particle_transport, dt_plpart,
+! Version 1.1e
+!
+! Revision 1.1  1997/07/24 11:21:26  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Definition of variables for special advection schemes
+!------------------------------------------------------------------------------!
+
+    REAL ::  spl_gamma_x, spl_gamma_y
+
+    REAL, DIMENSION(:), ALLOCATABLE   ::  aex, bex, dex, eex, spl_z_x, spl_z_y
+    REAL, DIMENSION(:,:), ALLOCATABLE ::  spl_tri_x, spl_tri_y, spl_tri_zu, &
+                                          spl_tri_zw
 
     SAVE
@@ -198,407 +287,65 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> The variable in this module is used by multi_agent_system_mod AND netcdf_interface_mod. It must
-!> be here to avoid circular dependency.
-!> This is a workaround.
-!--------------------------------------------------------------------------------------------------!
- MODULE mas_global_attributes
-
-    USE kinds
-
-    INTEGER(iwp) ::  dim_size_agtnum  !< size of agent number dimension for netCDF output
-
-    SAVE
-
- END MODULE mas_global_attributes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of all arrays defined on the computational grid.
-!--------------------------------------------------------------------------------------------------!
+
+ MODULE array_kind
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of type parameters (used for the definition of single or double
+! precision variables)
+!------------------------------------------------------------------------------!
+
+    INTEGER, PARAMETER ::  dpk = SELECTED_REAL_KIND( 12 ), &
+                           spk = SELECTED_REAL_KIND( 6 )
+
+    SAVE
+
+ END MODULE array_kind
+
+
+
+
  MODULE arrays_3d
 
-    USE kinds
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  d_exner                         !< ratio of potential and actual temperature
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ddzu                            !< 1/dzu
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ddzu_pres                       !< modified ddzu for pressure solver
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  dd2zu                           !< 1/(dzu(k)+dzu(k+1))
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  drho_air                        !< inverse air density profile on the uv grid
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  drho_air_zw                     !< inverse air density profile on the w grid
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzu                             !< vertical grid size (u-grid)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ddzw                            !< 1/dzw
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzw                             !< vertical grid size (w-grid)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  exner                           !< ratio of actual and potential temperature
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  heatflux_input_conversion       !< conversion factor array for heatflux input
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  heatflux_output_conversion      !< conversion factor array for heatflux output
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  hyp                             !< hydrostatic pressure
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  hyrho                           !< density of air calculated with hydrostatic pressure
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  inflow_damping_factor           !< used for turbulent inflow
-                                                                            !< (non-cyclic boundary conditions)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  momentumflux_input_conversion   !< conversion factor array for momentumflux input
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  momentumflux_output_conversion  !< conversion factor array for momentumflux output
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ptdf_x                          !< damping factor for potential temperature in
-                                                                            !< x-direction
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ptdf_y                          !< damping factor for potential temperature in
-                                                                            !< y-direction
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt_init                         !< initial profile of potential temperature
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  q_init                          !< initial profile of total water mixing ratio
-                                                                            !< (or total water content with active cloud physics)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  rdf                             !< rayleigh damping factor for velocity components
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  rdf_sc                          !< rayleigh damping factor for scalar quantities
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ref_state                       !< reference state of potential temperature
-                                                                            !< (and density in case of ocean simulation)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  rho_air                         !< air density profile on the uv grid
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  rho_air_zw                      !< air density profile on the w grid
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  s_init                          !< initial profile of passive scalar concentration
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  sa_init                         !< initial profile of salinity (ocean)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ug                              !< geostrophic wind component in x-direction
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  u_init                          !< initial profile of horizontal velocity component u
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  u_stokes_zu                     !< u-component of Stokes drift velocity at zu levels
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  u_stokes_zw                     !< u-component of Stokes drift velocity at zw levels
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  vg                              !< geostrophic wind component in y-direction
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  v_init                          !< initial profile of horizontal velocity component v
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  v_stokes_zu                     !< v-component of Stokes drift velocity at zu levels
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  v_stokes_zw                     !< v-component of Stokes drift velocity at zw levels
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  waterflux_input_conversion      !< conversion factor array for waterflux input
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  waterflux_output_conversion     !< conversion factor array for waterflux output
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  w_subs                          !< subsidence/ascent velocity
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  x                               !< horizontal grid coordinate of v-grid (in m)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  xu                              !< horizontal grid coordinate of u-grid (in m)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  y                               !< horizontal grid coordinate of u-grid (in m)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  yv                              !< horizontal grid coordinate of v-grid (in m)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu                              !< vertical grid coordinate of u-grid (in m)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw                              !< vertical grid coordinate of w-grid (in m)
-
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  c_u                   !< phase speed of u-velocity component
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  c_v                   !< phase speed of v-velocity component
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  c_w                   !< phase speed of w-velocity component
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_diss           !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - TKE dissipation
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_e              !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - subgrid-scale TKE
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_nc             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - clouddrop-number concentration
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_ng             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - graupel number concentration
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_ni             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - ice crystal-number concentration
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_nr             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - raindrop-number concentration
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_ns             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - snow-number concentration
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_pt             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - potential temperature
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_q              !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - total water mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_qc             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - cloudwater mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_qg             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - graupel mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_qi             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - ice crystal mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_qr             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - rainwater mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_qs             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - snow mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_s              !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - passive scalar
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_sa             !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - salinity
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_u              !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - u-component
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_v              !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - v-component
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s_w              !< artificial numerical dissipation flux at south face of grid
-                                                                    !< box - w-component
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dzu_mg                !< vertical grid size (u-grid) for multigrid pressure solver
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dzw_mg                !< vertical grid size (w-grid) for multigrid pressure solver
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_diss           !< 6th-order advective flux at south face of grid box -
-                                                                    !< TKE dissipation
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_e              !< 6th-order advective flux at south face of grid box -
-                                                                    !< subgrid-scale TKE
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_nc             !< 6th-order advective flux at south face of grid box -
-                                                                    !< clouddrop-number concentration
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_ng             !< 6th-order advective flux at south face of grid box -
-                                                                    !< graupel-number concentration
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_ni             !< 6th-order advective flux at south face of grid box -
-                                                                    !< icecrystal-number concentration
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_nr             !< 6th-order advective flux at south face of grid box -
-                                                                    !< raindrop-number concentration
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_ns             !< 6th-order advective flux at south face of grid box -
-                                                                    !< graupel-number concentration
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_pt             !< 6th-order advective flux at south face of grid box -
-                                                                    !< potential temperature
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_q              !< 6th-order advective flux at south face of grid box -
-                                                                    !< total water mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_qc             !< 6th-order advective flux at south face of grid box -
-                                                                    !< cloudwater mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_qg             !< 6th-order advective flux at south face of grid box -
-                                                                    !< graupel mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_qi             !< 6th-order advective flux at south face of grid box -
-                                                                    !< ice crystal mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_qr             !< 6th-order advective flux at south face of grid box -
-                                                                    !< rainwater mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_qs             !< 6th-order advective flux at south face of grid box -
-                                                                    !< snow mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_s              !< 6th-order advective flux at south face of grid box -
-                                                                    !< passive scalar
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_sa             !< 6th-order advective flux at south face of grid box -
-                                                                    !< salinity
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_u              !< 6th-order advective flux at south face of grid box -
-                                                                    !< u-component
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_v              !< 6th-order advective flux at south face of grid box -
-                                                                    !< v-component
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s_w              !< 6th-order advective flux at south face of grid box -
-                                                                    !< w-component
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  f1_mg                 !< grid factor used in right hand side of Gauss-Seidel equation
-                                                                    !< (multigrid)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  f2_mg                 !< grid factor used in right hand side of Gauss-Seidel equation
-                                                                    !< (multigrid)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  f3_mg                 !< grid factor used in right hand side of Gauss-Seidel equation
-                                                                    !< (multigrid)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  mean_inflow_profiles  !< used for turbulent inflow (non-cyclic boundary conditions)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  precipitation_amount  !< precipitation amount due to gravitational settling
-                                                                    !< (bulk microphysics)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pt_slope_ref          !< potential temperature in rotated coordinate system
-                                                                    !< (in case of sloped surface)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_air_mg            !< air density profiles on the uv grid for multigrid
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_air_zw_mg         !< air density profiles on the w grid for multigrid
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  total_2d_a            !< horizontal array to store the total domain data, used for
-                                                                    !< atmosphere-ocean coupling (atmosphere data)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  total_2d_o            !< horizontal array to store the total domain data, used for
-                                                                    !< atmosphere-ocean coupling (ocean data)
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  d           !< divergence
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  de_dx       !< gradient of sgs tke in x-direction (lpm)
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  de_dy       !< gradient of sgs tke in y-direction (lpm)
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  de_dz       !< gradient of sgs tke in z-direction (lpm)
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_diss !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< TKE dissipation
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_e    !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< subgrid-scale TKE
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_nc   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< clouddrop-number concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_ng   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< graupel-number concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_ni   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< ice crystal-number concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_nr   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< raindrop-number concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_ns   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< snow-number concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_pt   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< potential temperature
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_q    !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< total water mixing ratio
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_qc   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< cloudwater
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_qg   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< graupel
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_qi   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< ice crystal
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_qr   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< rainwater
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_qs   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< snow
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_s    !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< passive scalar
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_sa   !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< salinity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_u    !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< u-component
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_v    !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< v-component
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l_w    !< artificial numerical dissipation flux at left face of grid box -
-                                                            !< w-component
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_diss !< 6th-order advective flux at south face of grid box - TKE dissipation
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_e    !< 6th-order advective flux at south face of grid box - subgrid-scale
-                                                            !< TKE
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_nc   !< 6th-order advective flux at south face of grid box - clouddrop-number
-                                                            !< concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_ng   !< 6th-order advective flux at south face of grid box -
-                                                            !< graupel-number concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_ni   !< 6th-order advective flux at south face of grid box -
-                                                            !< ice crystal-number concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_nr   !< 6th-order advective flux at south face of grid box - raindrop-number
-                                                            !< concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_ns   !< 6th-order advective flux at south face of grid box - snow-number concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_pt   !< 6th-order advective flux at south face of grid box - potential
-                                                            !< temperature
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_q    !< 6th-order advective flux at south face of grid box - mixing ratio
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_qc   !< 6th-order advective flux at south face of grid box - cloudwater
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_qg   !< 6th-order advective flux at south face of grid box - graupel
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_qi   !< 6th-order advective flux at south face of grid box - ice crystal
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_qr   !< 6th-order advective flux at south face of grid box - rainwater
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_qs   !< 6th-order advective flux at south face of grid box - snow
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_s    !< 6th-order advective flux at south face of grid box - passive scalar
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_sa   !< 6th-order advective flux at south face of grid box - salinity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_u    !< 6th-order advective flux at south face of grid box - u-component
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_v    !< 6th-order advective flux at south face of grid box - v-component
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l_w    !< 6th-order advective flux at south face of grid box - w-component
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  kh  !< eddy diffusivity for heat
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  km  !< eddy diffusivity for momentum
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  prr         !< rain rate
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  p_loc       !< local array in multigrid/sor solver containing the pressure which is
-                                                            !< iteratively advanced in each iteration step
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  tend        !< tendency field (time integration)
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  tric        !< coefficients of the tridiagonal matrix for solution of the Poisson
-                                                            !< equation in Fourier space
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  diss_1  !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  diss_2  !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  diss_3  !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  e_1     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  e_2     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  e_3     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  p       !< pointer: perturbation pressure
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  prho_1  !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nc_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nc_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nc_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ng_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ng_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ng_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ni_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ni_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ni_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nr_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nr_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nr_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ns_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ns_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ns_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pt_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pt_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pt_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_1     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_2     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_3     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qc_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qc_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qc_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qf_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qg_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qg_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qg_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qi_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qi_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qi_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ql_v    !< pointer: volume of liquid water
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ql_vp   !< pointer: liquid water weighting factor
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ql_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ql_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qr_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qr_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qr_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qs_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qs_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qs_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  rho_1   !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_1     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_2     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_3     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sa_1    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sa_2    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sa_3    !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  u_1     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  u_2     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  u_3     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  v_1     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  v_2     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  v_3     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vpt_1   !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  w_1     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  w_2     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  w_3     !< pointer for swapping of timelevels for respective quantity
-
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  diss       !< pointer: TKE dissipation
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  diss_p     !< pointer: prognostic value of TKE dissipation
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  e          !< pointer: subgrid-scale turbulence kinetic energy (sgs tke)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  e_p        !< pointer: prognostic value of sgs tke
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  nc         !< pointer: cloud drop number density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  nc_p       !< pointer: prognostic value of cloud drop number density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  ng         !< pointer: graupel number density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  ng_p       !< pointer: prognostic value of graupel number density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  ni         !< pointer: ice crystal number density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  ni_p       !< pointer: prognostic value of ice crystal number density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  nr         !< pointer: rain drop number density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  nr_p       !< pointer: prognostic value of rain drop number density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  ns         !< pointer: snow number density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  ns_p       !< pointer: prognostic value of snow number density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  prho       !< pointer: potential density
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  pt         !< pointer: potential temperature
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  pt_p       !< pointer: prognostic value of potential temperature
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  q          !< pointer: mixing ratio
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  q_p        !< pointer: prognostic value of mixing ratio
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qc         !< pointer: cloud water content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qc_p       !< pointer: prognostic value cloud water content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qf         !< pointer: frozen water content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qg         !< pointer: graupel water content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qg_p       !< pointer: prognostic value graupel water content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qi         !< pointer: ice crystal content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qi_p       !< pointer: prognostic value ice crystal content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  ql         !< pointer: liquid water content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  ql_c       !< pointer: change in liquid water content due to
-                                                                   !< condensation/evaporation during last time step
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qr         !< pointer: rain water content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qr_p       !< pointer: prognostic value of rain water content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qs         !< pointer: rain water content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  qs_p       !< pointer: prognostic value of rain water content
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  rho_ocean  !< pointer: density of ocean
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  s          !< pointer: passive scalar
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  s_p        !< pointer: prognostic value of passive scalar
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  sa         !< pointer: ocean salinity
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  sa_p       !< pointer: prognostic value of ocean salinity
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tdiss_m    !< pointer: weighted tendency of diss for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  te_m       !< pointer: weighted tendency of e for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tnc_m      !< pointer: weighted tendency of nc for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tng_m      !< pointer: weighted tendency of ng for previous sub-timestep (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tni_m      !< pointer: weighted tendency of ni for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tnr_m      !< pointer: weighted tendency of nr for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tns_m      !< pointer: weighted tendency of ns for previous sub-timestep (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tpt_m      !< pointer: weighted tendency of pt for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tq_m       !< pointer: weighted tendency of q for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tqc_m      !< pointer: weighted tendency of qc for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tqg_m      !< pointer: weighted tendency of qg for previous sub-timestep (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tqi_m      !< pointer: weighted tendency of qi for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tqr_m      !< pointer: weighted tendency of qr for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tqs_m      !< pointer: weighted tendency of qs for previous sub-timestep (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  ts_m       !< pointer: weighted tendency of s for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tsa_m      !< pointer: weighted tendency of sa for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tu_m       !< pointer: weighted tendency of u for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tv_m       !< pointer: weighted tendency of v for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tw_m       !< pointer: weighted tendency of w for previous sub-timestep
-                                                                   !< (Runge-Kutta)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  u          !< pointer: horizontal velocity component u (x-direction)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  u_p        !< pointer: prognostic value of u
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  v          !< pointer: horizontal velocity component v (y-direction)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  v_p        !< pointer: prognostic value of v
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  vpt        !< pointer: virtual potential temperature
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  w          !< pointer: vertical velocity component w (z-direction)
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  w_p        !< pointer: prognostic value of w
-
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  tri    !< array to hold the tridiagonal matrix for solution of the Poisson
-                                                         !< equation in Fourier space (4th dimension for threads)
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of all arrays defined on the computational grid
+!------------------------------------------------------------------------------!
+
+    USE array_kind
+
+    REAL, DIMENSION(:), ALLOCATABLE ::                                         &
+          ddzu, dd2zu, dzu, ddzw, dzw, km_damp_x, km_damp_y, l_grid, pt_init,  &
+          q_init, rdf, ug, u_init, uvmean_outflow, uvmean_outflow_l, vg,       &
+          v_init, zu, zw
+
+    REAL, DIMENSION(:,:), ALLOCATABLE ::                                       &
+          dzu_mg, dzw_mg, f1_mg, f2_mg, f3_mg, pt_slope_ref, qs, ts, us, z0
+
+    REAL, DIMENSION(:,:), ALLOCATABLE, TARGET ::                               &
+          qsws_1, qsws_2, rif_1, rif_2, shf_1, shf_2, usws_1, usws_2,          &
+          vsws_1, vsws_2
+
+    REAL, DIMENSION(:,:), POINTER ::                                           &
+          qsws, qsws_m, rif, rif_m, shf, shf_m, usws, usws_m, vsws, vsws_m
+
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::                                     &
+          d, diss, l_wall, tend
+
+    REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                             &
+          ql_v, ql_vp
+
+    REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                             &
+          e_1, e_2, e_3, kh_1, kh_2, km_1, km_2, pt_1, pt_2, pt_3, q_1, q_2,   &
+          q_3, ql_1, ql_2, u_1, u_2, u_3, v_1, v_2, v_3, vpt_1, vpt_2, w_1,    &
+          w_2, w_3
+
+    REAL, DIMENSION(:,:,:), POINTER ::                                         &
+          e, e_m, e_p, kh, kh_m, km, km_m, p, pt, pt_m, pt_p, q, q_m, q_p, ql, &
+          ql_c, te_m, tpt_m, tq_m, tu_m, tv_m, tw_m, u, u_m, u_p, v, v_m, v_p, &
+          vpt, vpt_m, w, w_m, w_p
+                                                    
 
     SAVE
@@ -607,658 +354,258 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of variables needed for time-averaging of 2d/3d data.
-!--------------------------------------------------------------------------------------------------!
+
+
  MODULE averaging
 
-    USE kinds
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ghf_av                 !< avg. ground heat flux
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lwp_av                 !< avg. liquid water path
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ol_av                  !< avg. Obukhov length
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qsurf_av               !< avg. surface mixing ratio
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qsws_av                !< avg. surface moisture flux
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  r_a_av                 !< avg. resistance
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ssurf_av               !< avg. surface passive scalar
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ssws_av                !< avg. surface scalar flux
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  shf_av                 !< avg. surface heat flux
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tsurf_av               !< avg. surface temperature
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ts_av                  !< avg. characteristic temperature scale
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  us_av                  !< avg. friction velocity
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  z0_av                  !< avg. roughness length for momentum
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  z0h_av                 !< avg. roughness length for heat
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  z0q_av                 !< avg. roughness length for moisture
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  diss_av       !< avg. tke dissipation rate
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  e_av          !< avg. subgrid-scale tke
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  kh_av         !< avg. eddy diffusivity for heat
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  km_av         !< avg. eddy diffusivity for momentum
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  lpt_av        !< avg. liquid water potential temperature
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nc_av         !< avg. cloud drop number density
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ng_av         !< avg. graupel drop number density
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ni_av         !< avg. ice crystal number density
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nr_av         !< avg. rain drop number density
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ns_av         !< avg. snow drop number density
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  p_av          !< avg. perturbation pressure
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pc_av         !< avg. particle/droplet concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pr_av         !< avg. particle/droplet radius
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  prr_av        !< avg. precipitation rate
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pt_av         !< avg. potential temperature
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_av          !< avg. mixing ratio
-                                                                      !< (or total water content with active cloud physics)
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qc_av         !< avg. cloud water content
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qg_av         !< avg. graupel water content
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qi_av         !< avg. ice crystal content
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ql_av         !< avg. liquid water content
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ql_c_av       !< avg. change in liquid water content due to
-                                                                      !< condensation/evaporation during last time step
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ql_v_av       !< avg. volume of liquid water
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ql_vp_av      !< avg. liquid water weighting factor
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qr_av         !< avg. rain water content
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qs_av         !< avg. snow water content
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qv_av         !< avg. water vapor content (mixing ratio)
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  rho_ocean_av  !< avg. ocean density
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_av          !< avg. passive scalar
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sa_av         !< avg. salinity
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  u_av          !< avg. horizontal velocity component u
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  v_av          !< avg. horizontal velocity component v
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vpt_av        !< avg. virtual potential temperature
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  w_av          !< avg. vertical velocity component
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables needed for time-averaging of 2d/3d data
+!------------------------------------------------------------------------------!
+
+    REAL, DIMENSION(:,:), ALLOCATABLE ::  lwp_av, ts_av, us_av
+
+    REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: &
+          e_av, p_av, pc_av, pr_av, pt_av, q_av, ql_av, ql_c_av, ql_v_av, &
+          ql_vp_av, qv_av, s_av, u_av, v_av, vpt_av, w_av
 
  END MODULE averaging
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of parameters for program control
-!--------------------------------------------------------------------------------------------------!
+
+
+ MODULE cloud_parameters
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables and constants for cloud physics
+!------------------------------------------------------------------------------!
+
+    REAL  ::  b_cond, cp = 1005.0, diff_coeff_l = 0.23E-4,                     &
+              effective_coll_efficiency, l_d_cp, l_d_r, l_d_rv, l_v = 2.5E+06, &
+              mass_of_solute, molecular_weight_of_solute,                      &
+              prec_time_const = 0.001, ql_crit = 0.0005, rho_l = 1.0E3,        &
+              r_d = 287.0, r_v = 461.51, rho_surface,                          &
+              thermal_conductivity_l = 2.43E-2
+
+    REAL, DIMENSION(:), ALLOCATABLE :: hydro_press, pt_d_t, t_d_pt
+
+    SAVE
+
+ END MODULE cloud_parameters
+
+
+
+
+ MODULE constants
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of general constants
+!------------------------------------------------------------------------------!
+
+    REAL    ::  pi = 3.141592654
+
+    SAVE
+
+ END MODULE constants
+
+
+
+
  MODULE control_parameters
 
-    USE kinds
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of parameters for program control
+!------------------------------------------------------------------------------!
+
+    TYPE plot_precision
+       CHARACTER (LEN=6) ::  variable
+       INTEGER           ::  precision
+    END TYPE plot_precision
+
+    TYPE(plot_precision), DIMENSION(100) ::  plot_3d_precision =               &
+                        (/ plot_precision( 'u', 2 ), plot_precision( 'v', 2 ), &
+                           plot_precision( 'w', 2 ), plot_precision( 'p', 5 ), &
+                           plot_precision( 'pt', 2 ),                          &
+                           ( plot_precision( ' ', 1 ), i9 = 1,95 ) /)
 
     TYPE file_status
-       LOGICAL ::  opened         !< file is currently open
-       LOGICAL ::  opened_before  !< file is currently closed, but has been openend before
+       LOGICAL ::  opened, opened_before
     END TYPE file_status
 
-    INTEGER(iwp), PARAMETER ::  fl_max = 500              !< maximum number of virtual-flight measurements
-    INTEGER,      PARAMETER ::  mask_xyz_dimension = 100  !< limit of mask dimensions (100 points in each direction)
-    INTEGER,      PARAMETER ::  max_masks = 50            !< maximum number of masks
-    INTEGER(iwp), PARAMETER ::  var_fl_max = 20           !< maximum number of different sampling variables in virtual flight
-                                                          !< measurements
-    INTEGER(iwp), PARAMETER ::  varnamelength = 30        !< length of output variable names
-
-    TYPE(file_status), DIMENSION(200+2*max_masks) ::                &  !< indicates if file is open or if it has been opened before
-                             openfile = file_status(.FALSE.,.FALSE.)
-
-    CHARACTER (LEN=1)    ::  cycle_mg = 'w'                               !< namelist parameter (see documentation)
-    CHARACTER (LEN=1)    ::  timestep_reason = ' '                        !< 'A'dvection or 'D'iffusion criterion, written to
-                                                                          !< RUN_CONTROL file
-    CHARACTER (LEN=5)    ::  run_zone = ' '                               !< time zone of simulation run
-    CHARACTER (LEN=8)    ::  coupling_char = ''                           !< appended to filenames in coupled or nested runs
-                                                                          !< ('_O': ocean PE,
-                                                                          !< '_NV': vertically nested atmosphere PE, '_N##': PE of
-                                                                          !< nested domain ##
-    CHARACTER (LEN=8)    ::  run_time = ' '                               !< time of simulation run
-    CHARACTER (LEN=9)    ::  simulated_time_chr                           !< simulated time, printed to RUN_CONTROL file
-    CHARACTER (LEN=10)   ::  run_date = ' '                               !< date of simulation run
-    CHARACTER (LEN=11)   ::  topography_grid_convention = ' '             !< namelist parameter
-    CHARACTER (LEN=12)   ::  revision = ' '                               !< PALM revision number
-    CHARACTER (LEN=12)   ::  version = ' '                                !< PALM version number
-    CHARACTER (LEN=12)   ::  user_interface_current_revision = ' '        !< revision number of the currently used user-interface
-                                                                          !< (must match user_interface_required_revision)
-    CHARACTER (LEN=12)   ::  user_interface_required_revision = ' '       !< required user-interface revision number
-    CHARACTER (LEN=16)   ::  conserve_volume_flow_mode = 'default'        !< namelist parameter
-    CHARACTER (LEN=16)   ::  loop_optimization = 'cache'                  !< namelist parameter
-    CHARACTER (LEN=16)   ::  momentum_advec = 'ws-scheme'                 !< namelist parameter
-    CHARACTER (LEN=16)   ::  psolver = 'poisfft'                          !< namelist parameter
-    CHARACTER (LEN=16)   ::  scalar_advec = 'ws-scheme'                   !< namelist parameter
-    CHARACTER (LEN=20)   ::  approximation = 'boussinesq'                 !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_e_b = 'neumann'                           !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_lr = 'cyclic'                             !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_ns = 'cyclic'                             !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_p_b = 'neumann'                           !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_p_t = 'dirichlet'                         !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_pt_b = 'dirichlet'                        !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_pt_t = 'initial_gradient'                 !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_q_b = 'dirichlet'                         !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_q_t = 'neumann'                           !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_s_b = 'dirichlet'                         !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_s_t = 'initial_gradient'                  !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_uv_b = 'dirichlet'                        !< namelist parameter
-    CHARACTER (LEN=20)   ::  bc_uv_t = 'dirichlet'                        !< namelist parameter
-    CHARACTER (LEN=20)   ::  coupling_mode = 'uncoupled'                  !< coupling mode for atmosphere-ocean coupling
-    CHARACTER (LEN=20)   ::  coupling_mode_remote = 'uncoupled'           !< coupling mode of the remote process in case of coupled
-                                                                          !< atmosphere-ocean runs
-    CHARACTER (LEN=20)   ::  dissipation_1d = 'detering'                  !< namelist parameter
-    CHARACTER (LEN=20)   ::  fft_method = 'temperton-algorithm'           !< namelist parameter
-    CHARACTER (LEN=20)   ::  mixing_length_1d = 'blackadar'               !< namelist parameter
-    CHARACTER (LEN=20)   ::  random_generator = 'random-parallel'         !< namelist parameter
-    CHARACTER (LEN=20)   ::  reference_state = 'initial_profile'          !< namelist parameter
-    CHARACTER (LEN=20)   ::  restart_data_format = 'fortran_binary'       !< namelist parameter
-    CHARACTER (LEN=20)   ::  restart_data_format_input = 'undefined'      !< namelist parameter
-    CHARACTER (LEN=20)   ::  restart_data_format_output = 'undefined'     !< namelist parameter
-    CHARACTER (LEN=20)   ::  timestep_scheme = 'runge-kutta-3'            !< namelist parameter
-    CHARACTER (LEN=20)   ::  turbulence_closure = '1.5-order'             !< namelist parameter
-    CHARACTER (LEN=23)   ::  origin_date_time = '2019-06-21 12:00:00 +00' !< date and time to be simulated
-    CHARACTER (LEN=40)   ::  flux_input_mode = 'approximation-specific'   !< type of flux input: dynamic or kinematic
-    CHARACTER (LEN=40)   ::  flux_output_mode = 'approximation-specific'  !< type of flux output: dynamic or kinematic
-    CHARACTER (LEN=40)   ::  topography = 'flat'                          !< namelist parameter
-    CHARACTER (LEN=64)   ::  host = '????'                                !< configuration identifier as given by palmrun option -c,
-                                                                          !< ENVPAR namelist parameter provided by palmrun
-    CHARACTER (LEN=80)   ::  log_message                                  !< user-defined message for debugging (sse data_log.f90)
-    CHARACTER (LEN=80)   ::  recycling_method_for_thermodynamic_quantities = 'turbulent_fluctuation'        !< namelist parameter
-    CHARACTER (LEN=80)   ::  run_identifier                               !< run identifier as given by palmrun option -r, ENVPAR
-                                                                          !< namelist parameter provided by palmrun
-    CHARACTER (LEN=100)  ::  initializing_actions = ' '                   !< namelist parameter
-    CHARACTER (LEN=100)  ::  restart_string = ' '                         !< for storing strings in case of writing/reading restart
-                                                                          !< data
-    CHARACTER (LEN=210)  ::  run_description_header                       !< string containing diverse run informations as run
-                                                                          !< identifier, coupling mode, host, ensemble number, run
-                                                                          !< date and time
-    CHARACTER (LEN=1000) ::  debug_string = ' '                           !<.....
-    CHARACTER (LEN=1000) ::  message_string = ' '                         !< dynamic string for error message output
-
-    CHARACTER (LEN=varnamelength), DIMENSION(300) ::  data_output_pr_user = ' '  !< namelist parameter
-    CHARACTER (LEN=varnamelength), DIMENSION(500) ::  data_output_pr = ' '       !< namelist parameter
-    CHARACTER (LEN=varnamelength), DIMENSION(500) ::  data_output = ' '          !< namelist parameter
-    CHARACTER (LEN=varnamelength), DIMENSION(500) ::  data_output_user = ' '     !< namelist parameter
-    CHARACTER (LEN=varnamelength), DIMENSION(500) ::  doav = ' '                 !< label array for multi-dimensional,
-                                                                                 !< averaged output quantities
-
-    CHARACTER (LEN=varnamelength), DIMENSION(max_masks,100) ::  data_output_masks = ' '       !< namelist parameter
-    CHARACTER (LEN=varnamelength), DIMENSION(max_masks,100) ::  data_output_masks_user = ' '  !< namelist parameter
-    CHARACTER (LEN=varnamelength), DIMENSION(0:1,500)       ::  do2d = ' '                    !< label array for 2d output
-                                                                                              !< quantities
-    CHARACTER (LEN=varnamelength), DIMENSION(0:1,500)       ::  do3d = ' '                    !< label array for 3d output
-                                                                                              !< quantities
-
-    CHARACTER (LEN=varnamelength), DIMENSION(max_masks,0:1,100) ::  domask = ' ' !< label array for multi-dimensional,
-                                                                                 !< masked output quantities
-
-    INTEGER(iwp) ::  abort_mode = 1                    !< abort condition (nested runs)
-    INTEGER(iwp) ::  agt_time_count = 0                !< number of output intervals for agent data output
-    INTEGER(iwp) ::  average_count_pr = 0              !< number of samples in vertical-profile output
-    INTEGER(iwp) ::  average_count_3d = 0              !< number of samples in 3d output
-    INTEGER(iwp) ::  current_timestep_number = 0       !< current timestep number, printed to RUN_CONTROL file
-    INTEGER(iwp) ::  coupling_topology = 0             !< switch for atmosphere-ocean-coupling: 0: same number of grid points and
-                                                       !< PEs along x and y in atmosphere and ocean, otherwise 1
-    INTEGER(iwp) ::  dist_range = 0                    !< switch for steering the horizontal disturbance range, 1: inflow
-                                                       !< disturbances in case of non-cyclic horizontal BC, 0: otherwise
-    INTEGER(iwp) ::  disturbance_level_ind_b           !< lowest grid index where flow disturbance is applied
-    INTEGER(iwp) ::  disturbance_level_ind_t           !< highest grid index where flow disturbance is applied
-    INTEGER(iwp) ::  doav_n = 0                        !< number of 2d/3d output quantities subject to time averaging
-    INTEGER(iwp) ::  dopr_n = 0                        !< number of profile output quantities subject to time averaging
-    INTEGER(iwp) ::  dopr_time_count = 0               !< number of output intervals for profile output
-    INTEGER(iwp) ::  dopts_time_count = 0              !< number of output intervals for particle data timeseries
-    INTEGER(iwp) ::  dots_time_count = 0               !< number of output intervals for timeseries output
-    INTEGER(iwp) ::  dp_level_ind_b = 0                !< lowest grid index for external pressure gradient forcing
-    INTEGER(iwp) ::  ensemble_member_nr = 0            !< namelist parameter
-    INTEGER(iwp) ::  gamma_mg                          !< switch for steering the multigrid cycle: 1: v-cycle, 2: w-cycle
-    INTEGER(iwp) ::  gathered_size                     !< number of total domain grid points of the grid level which is gathered on
-                                                       !< PE0 (multigrid solver)
-    INTEGER(iwp) ::  grid_level                        !< current grid level handled in the multigrid solver
-    INTEGER(iwp) ::  ibc_e_b                           !< integer flag for bc_e_b
-    INTEGER(iwp) ::  ibc_p_b                           !< integer flag for bc_p_b
-    INTEGER(iwp) ::  ibc_p_t                           !< integer flag for bc_p_t
-    INTEGER(iwp) ::  ibc_pt_b                          !< integer flag for bc_pt_b
-    INTEGER(iwp) ::  ibc_pt_t                          !< integer flag for bc_pt_t
-    INTEGER(iwp) ::  ibc_q_b                           !< integer flag for bc_q_b
-    INTEGER(iwp) ::  ibc_q_t                           !< integer flag for bc_q_t
-    INTEGER(iwp) ::  ibc_s_b                           !< integer flag for bc_s_b
-    INTEGER(iwp) ::  ibc_s_t                           !< integer flag for bc_s_t
-    INTEGER(iwp) ::  ibc_uv_b                          !< integer flag for bc_uv_b
-    INTEGER(iwp) ::  ibc_uv_t                          !< integer flag for bc_uv_t
-    INTEGER(iwp) ::  inflow_disturbance_begin = -1     !< namelist parameter
-    INTEGER(iwp) ::  inflow_disturbance_end = -1       !< namelist parameter
-    INTEGER(iwp) ::  intermediate_timestep_count       !< number of current Runge-Kutta substep
-    INTEGER(iwp) ::  intermediate_timestep_count_max   !< maximum number of Runge-Kutta substeps
-    INTEGER(iwp) ::  io_group = 0                      !< I/O group to which the PE belongs (= #PE / io_blocks)
-    INTEGER(iwp) ::  io_blocks = 1                     !< number of blocks for which I/O is done in sequence (total number of PEs /
-                                                       !< maximum_parallel_io_streams)
-    INTEGER(iwp) ::  iran = -1234567                   !< integer random number used for flow disturbances
-    INTEGER(iwp) ::  length = 0                        !< integer that specifies the length of a string in case of writing/reading
-                                                       !< restart data
-    INTEGER(iwp) ::  masks = 0                         !< counter for number of masked output quantities
-    INTEGER(iwp) ::  maximum_grid_level                !< number of grid levels that the multigrid solver is using
-    INTEGER(iwp) ::  maximum_parallel_io_streams = -1  !< maximum number of parallel io streams that the underlying parallel file
-                                                       !< system allows, set with palmrun option -w, ENVPAR namelist parameter, provided by palmrun
-    INTEGER(iwp) ::  max_pr_salsa = 0                  !< number of salsa profiles (must not change within a job chain)
-    INTEGER(iwp) ::  max_pr_user = 0                   !< number of user-defined profiles (must not change within a job chain)
-    INTEGER(iwp) ::  max_pr_user_tmp = 0               !< number of user-defined profiles that is temporary stored to check it
-                                                       !< against max_pr_user in case of restarts
-    INTEGER(iwp) ::  mgcycles = 0                      !< number of multigrid cycles that the multigrid solver has actually carried
-                                                       !< out
-    INTEGER(iwp) ::  mg_cycles = 4                     !< namelist parameter
-    INTEGER(iwp) ::  mg_switch_to_pe0_level = -1       !< namelist parameter
-    INTEGER(iwp) ::  ngsrb = 2                         !< namelist parameter
-    INTEGER(iwp) ::  nr_timesteps_this_run = 0         !< number of timesteps (cpu time measurements)
-    INTEGER(iwp) ::  nsor = 20                         !< namelist parameter
-    INTEGER(iwp) ::  nsor_ini = 100                    !< namelist parameter
-    INTEGER(iwp) ::  n_sor                             !< number of iterations to be used in SOR-scheme
-    INTEGER(iwp) ::  normalizing_region = 0            !< namelist parameter
-    INTEGER(iwp) ::  num_mean_inflow_profiles = 7      !< number of mean inflow profiles in case of turbulent inflow
-    INTEGER(iwp) ::  num_leg=0                         !< number of different legs in virtual flight measurements
-    INTEGER(iwp) ::  num_var_fl                        !< number of sampling/output variables in virtual flight measurements
-    INTEGER(iwp) ::  num_var_fl_user=0                 !< number of user-defined sampling/output variables in virtual flight
-                                                       !< measurements
-    INTEGER(iwp) ::  number_stretch_level_start        !< number of user-specified start levels for stretching
-    INTEGER(iwp) ::  number_stretch_level_end          !< number of user-specified end levels for stretching
-    INTEGER(iwp) ::  nz_do3d = -9999                   !< namelist parameter
-    INTEGER(iwp) ::  prt_time_count = 0                !< number of output intervals for particle data output
-    INTEGER(iwp) ::  recycling_plane                   !< position of recycling plane along x (in grid points) in case of turbulence
-                                                       !< recycling
-    INTEGER(iwp) ::  runnr = 0                         !< number of run in job chain
-    INTEGER(iwp) ::  subdomain_size                    !< number of grid points in (3d) subdomain including ghost points
-    INTEGER(iwp) ::  symmetry_flag = 0                 !< flag for sterring the symmetric behavior of the bottom and top boundary
-    INTEGER(iwp) ::  terminate_coupled = 0             !< switch for steering termination in case of coupled runs
-    INTEGER(iwp) ::  terminate_coupled_remote = 0      !< switch for steering termination in case of coupled runs (condition of the
-                                                       !< remote model)
-    INTEGER(iwp) ::  timestep_count = 0                !< number of timesteps carried out since the beginning of the initial run
-    INTEGER(iwp) ::  y_shift = 0                       !< namelist parameter
-
-    INTEGER(iwp) ::  dist_nxl(0:1)                               !< left boundary of disturbance region
-    INTEGER(iwp) ::  dist_nxr(0:1)                               !< right boundary of disturbance region
-    INTEGER(iwp) ::  dist_nyn(0:1)                               !< north boundary of disturbance region
-    INTEGER(iwp) ::  dist_nys(0:1)                               !< south boundary of disturbance region
-    INTEGER(iwp) ::  do2d_no(0:1) = 0                            !< number of 2d output quantities
-    INTEGER(iwp) ::  do2d_xy_time_count(0:1) = 0                 !< number of output intervals for 2d data (xy)
-    INTEGER(iwp) ::  do2d_xz_time_count(0:1) = 0                 !< number of output intervals for 2d data (xz)
-    INTEGER(iwp) ::  do2d_yz_time_count(0:1) = 0                 !< number of output intervals for 2d data (yz)
-    INTEGER(iwp) ::  do3d_no(0:1) = 0                            !< number of 3d output quantities
-    INTEGER(iwp) ::  do3d_time_count(0:1) = 0                    !< number of output intervals for 3d data
-    INTEGER(iwp) ::  domask_no(max_masks,0:1) = 0                !< number of masked output quantities
-    INTEGER(iwp) ::  domask_time_count(max_masks,0:1)            !< number of output intervals for masked data
-    INTEGER(iwp) ::  dz_stretch_level_end_index(9)               !< vertical grid level index until which the vertical grid spacing
-                                                                 !< is stretched
-    INTEGER(iwp) ::  dz_stretch_level_start_index(9)             !< vertical grid level index above which the vertical grid spacing
-                                                                 !< is stretched
-    INTEGER(iwp) ::  mask_size(max_masks,3) = -1                 !< size of mask array per mask and dimension (for netcdf output)
-    INTEGER(iwp) ::  mask_size_l(max_masks,3) = -1               !< subdomain size of mask array per mask and dimension
-                                                                 !< (for netcdf output)
-    INTEGER(iwp) ::  mask_start_l(max_masks,3) = -1              !< subdomain start index of mask array (for netcdf output)
-    INTEGER(iwp) ::  pt_vertical_gradient_level_ind(10) = -9999  !< grid index values of pt_vertical_gradient_level(s)
-    INTEGER(iwp) ::  q_vertical_gradient_level_ind(10) = -9999   !< grid index values of q_vertical_gradient_level(s)
-    INTEGER(iwp) ::  s_vertical_gradient_level_ind(10) = -9999   !< grid index values of s_vertical_gradient_level(s)
-    INTEGER(iwp) ::  section(100,3)                              !< collective array for section_xy/xz/yz
-    INTEGER(iwp) ::  section_xy(100) = -9999                     !< namelist parameter
-    INTEGER(iwp) ::  section_xz(100) = -9999                     !< namelist parameter
-    INTEGER(iwp) ::  section_yz(100) = -9999                     !< namelist parameter
-    INTEGER(iwp) ::  ug_vertical_gradient_level_ind(10) = -9999  !< grid index values of ug_vertical_gradient_level(s)
-    INTEGER(iwp) ::  vg_vertical_gradient_level_ind(10) = -9999  !< grid index values of vg_vertical_gradient_level(s)
-    INTEGER(iwp) ::  subs_vertical_gradient_level_i(10) = -9999  !< grid index values of subs_vertical_gradient_level(s)
-    INTEGER(iwp), DIMENSION(0:1) ::  ntdim_2d_xy  !< number of output intervals for 2d data (xy)
-    INTEGER(iwp), DIMENSION(0:1) ::  ntdim_2d_xz  !< number of output intervals for 2d data (xz)
-    INTEGER(iwp), DIMENSION(0:1) ::  ntdim_2d_yz  !< number of output intervals for 2d data (yz)
-    INTEGER(iwp), DIMENSION(0:1) ::  ntdim_3d     !< number of output intervals for 3d data
-
-    INTEGER(iwp), DIMENSION(max_masks,mask_xyz_dimension) ::  mask_k_over_surface = -1  !< namelist parameter, k index of height
-                                                                                        !<over surface
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  grid_level_count  !< internal switch for steering the multigrid v- and w-cycles
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mask_i         !< subdomain grid index of masked output point on x-dimension
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mask_j         !< subdomain grid index of masked output point on y-dimension
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mask_k         !< subdomain grid index of masked output point on z-dimension
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mask_i_global  !< global grid index of masked output point on x-dimension
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mask_j_global  !< global grid index of masked output point on y-dimension
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mask_k_global  !< global grid index of masked output point on z-dimension
-
-
-    LOGICAL ::  agent_time_unlimited = .FALSE.                   !< namelist parameter
-    LOGICAL ::  air_chemistry = .FALSE.                          !< chemistry model switch
-    LOGICAL ::  bc_dirichlet_l = .FALSE.                         !< flag indicating dirichlet boundary condition on left model
-                                                                 !< boundary
-    LOGICAL ::  bc_dirichlet_n = .FALSE.                         !< flag indicating dirichlet boundary condition on north model
-                                                                 !< boundary
-    LOGICAL ::  bc_dirichlet_r = .FALSE.                         !< flag indicating dirichlet boundary condition on right model
-                                                                 !< boundary
-    LOGICAL ::  bc_dirichlet_s = .FALSE.                         !< flag indicating dirichlet boundary condition on south model
-                                                                 !< boundary
-    LOGICAL ::  bc_lr_cyc =.TRUE.                                !< left-right boundary condition cyclic?
-    LOGICAL ::  bc_lr_dirrad = .FALSE.                           !< left-right boundary condition dirichlet/radiation?
-    LOGICAL ::  bc_lr_raddir = .FALSE.                           !< left-right boundary condition radiation/dirichlet?
-    LOGICAL ::  bc_ns_cyc = .TRUE.                               !< north-south boundary condition cyclic?
-    LOGICAL ::  bc_ns_dirrad = .FALSE.                           !< north-south boundary condition dirichlet/radiation?
-    LOGICAL ::  bc_ns_raddir = .FALSE.                           !< north-south boundary condition radiation/dirichlet?
-    LOGICAL ::  bc_radiation_l = .FALSE.                         !< radiation boundary condition for outflow at left domain boundary
-    LOGICAL ::  bc_radiation_n = .FALSE.                         !< radiation boundary condition for outflow at north domain
-                                                                 !< boundary
-    LOGICAL ::  bc_radiation_r = .FALSE.                         !< radiation boundary condition for outflow at right domain
-                                                                 !< boundary
-    LOGICAL ::  bc_radiation_s = .FALSE.                         !< radiation boundary condition for outflow at south domain
-                                                                 !< boundary
-    LOGICAL ::  biometeorology = .FALSE.                         !< biometeorology module switch
-    LOGICAL ::  calc_soil_moisture_during_spinup = .FALSE.       !< namelist parameter
-    LOGICAL ::  call_psolver_at_all_substeps = .TRUE.            !< namelist parameter
-    LOGICAL ::  check_realistic_q = .TRUE.                       !< namelist parameter
-    LOGICAL ::  child_domain  = .FALSE.                          !< flag indicating that model is nested in a parent domain
-    LOGICAL ::  cloud_droplets = .FALSE.                         !< namelist parameter
-    LOGICAL ::  complex_terrain = .FALSE.                        !< namelist parameter
-    LOGICAL ::  conserve_volume_flow = .FALSE.                   !< namelist parameter
-    LOGICAL ::  constant_diffusion = .FALSE.                     !< diffusion coefficient constant?
-    LOGICAL ::  constant_flux_layer = .TRUE.                     !< namelist parameter
-    LOGICAL ::  constant_heatflux = .TRUE.                       !< heat flux at all surfaces constant?
-    LOGICAL ::  constant_top_heatflux = .TRUE.                   !< heat flux at domain top constant?
-    LOGICAL ::  constant_top_momentumflux = .FALSE.              !< momentum flux at domain topconstant?
-    LOGICAL ::  constant_top_salinityflux = .TRUE.               !< constant salinity flux at ocean surface
-    LOGICAL ::  constant_top_scalarflux = .TRUE.                 !< passive-scalar flux at domain top constant?
-    LOGICAL ::  constant_scalarflux = .TRUE.                     !< passive-scalar flux at surfaces constant?
-    LOGICAL ::  constant_waterflux = .TRUE.                      !< water flux at all surfaces constant?
-    LOGICAL ::  create_disturbances = .TRUE.                     !< namelist parameter
-    LOGICAL ::  data_output_during_spinup = .FALSE.              !< namelist parameter
-    LOGICAL ::  data_output_2d_on_each_pe = .TRUE.               !< namelist parameter
-    LOGICAL ::  debug_output = .FALSE.                           !< namelist parameter
-    LOGICAL ::  debug_output_timestep = .FALSE.                  !< namelist parameter
-    LOGICAL ::  disturbance_created = .FALSE.                    !< flow disturbance imposed?
-    LOGICAL ::  do2d_at_begin = .FALSE.                          !< namelist parameter
-    LOGICAL ::  do3d_at_begin = .FALSE.                          !< namelist parameter
-    LOGICAL ::  do_sum = .FALSE.                                 !< contribute to time average of profile data?
-    LOGICAL ::  dp_external = .FALSE.                            !< namelist parameter
-    LOGICAL ::  dp_smooth = .FALSE.                              !< namelist parameter
-    LOGICAL ::  dt_fixed = .FALSE.                               !< fixed timestep (namelist parameter dt set)?
-    LOGICAL ::  dt_3d_reached                                    !< internal timestep for particle advection
-    LOGICAL ::  dt_3d_reached_l                                  !< internal timestep for particle advection
-    LOGICAL ::  first_call_lpm = .TRUE.                          !< call lpm only once per timestep?
-    LOGICAL ::  first_call_mas = .TRUE.                          !< call mas only once per timestep
-    LOGICAL ::  force_print_header = .FALSE.                     !< namelist parameter
-    LOGICAL ::  galilei_transformation = .FALSE.                 !< namelist parameter
-    LOGICAL ::  humidity = .FALSE.                               !< namelist parameter
-    LOGICAL ::  humidity_remote = .FALSE.                        !< switch for receiving near-surface humidity flux
-                                                                 !< (atmosphere-ocean coupling)
-    LOGICAL ::  include_total_domain_boundaries = .FALSE.        !< store outer boundaries in restart file (MPI-IO)
-    LOGICAL ::  indoor_model = .FALSE.                           !< switch for indoor-climate and energy-demand model
-    LOGICAL ::  kolmogorov_length_scale = .FALSE.                !< switch to activate calculations in flow_statistics for the
-                                                                 !< kolmogorov length scale
-    LOGICAL ::  large_scale_forcing = .FALSE.                    !< namelist parameter
-    LOGICAL ::  large_scale_subsidence = .FALSE.                 !< namelist parameter
-    LOGICAL ::  land_surface = .FALSE.                           !< use land surface model?
-    LOGICAL ::  les_dai = .FALSE.                                !< use Dai et al. turbulence closure (modified 1.5-order closure)
-                                                                 !< for LES mode. Shall replace the default 1.5-order closure
-    LOGICAL ::  les_dynamic = .FALSE.                            !< use dynamic subgrid model as turbulence closure for LES mode
-    LOGICAL ::  les_default = .FALSE.                            !< use 1.5-order default turbulence closure for LES mode
-    LOGICAL ::  lsf_exception = .FALSE.                          !< use of lsf with buildings (temporary)?
-    LOGICAL ::  lsf_surf = .TRUE.                                !< use surface forcing (large scale forcing)?
-    LOGICAL ::  lsf_vert = .TRUE.                                !< use atmospheric forcing (large scale forcing)?
-    LOGICAL ::  masking_method = .FALSE.                         !< namelist parameter
-    LOGICAL ::  mg_switch_to_pe0 = .FALSE.                       !< internal multigrid switch for steering the ghost point exchange
-                                                                 !< in case that data has been collected on PE0
-    LOGICAL ::  monotonic_limiter_z = .FALSE.                    !< use monotonic flux limiter for vertical scalar advection
-    LOGICAL ::  nesting_offline = .FALSE.                        !< flag controlling offline nesting in COSMO model
-    LOGICAL ::  neutral = .FALSE.                                !< namelist parameter
-    LOGICAL ::  nudging = .FALSE.                                !< namelist parameter
-    LOGICAL ::  ocean_mode = .FALSE.                             !< namelist parameter
-    LOGICAL ::  passive_scalar = .FALSE.                         !< namelist parameter
-    LOGICAL ::  plant_canopy = .FALSE.                           !< switch for use of plant canopy model
-    LOGICAL ::  random_heatflux = .FALSE.                        !< namelist parameter
-    LOGICAL ::  rans_mode = .FALSE.                              !< switch between RANS and LES mode
-    LOGICAL ::  rans_tke_e = .FALSE.                             !< use TKE-e turbulence closure for RANS mode
-    LOGICAL ::  rans_tke_l = .FALSE.                             !< use TKE-l turbulence closure for RANS mode
-    LOGICAL ::  read_svf = .FALSE.                               !< ENVPAR namelist parameter to steer input of svf
-                                                                 !< (ENVPAR is provided by palmrun)
-    LOGICAL ::  run_control_header = .FALSE.                     !< onetime output of RUN_CONTROL header
-    LOGICAL ::  run_coupled = .TRUE.                             !< internal switch telling PALM to run in coupled mode
-                                                                 !< (i.e. to exchange surface data) in case of atmosphere-ocean coupling
-    LOGICAL ::  salsa = .FALSE.                                  !< switch for the sectional aerosol module salsa
-    LOGICAL ::  scalar_rayleigh_damping = .TRUE.                 !< namelist parameter
-    LOGICAL ::  sloping_surface = .FALSE.                        !< use sloped surface? (namelist parameter alpha_surface)
-    LOGICAL ::  spinup = .FALSE.                                 !< perform model spinup without atmosphere code?
-    LOGICAL ::  surface_output = .FALSE.                         !< output of surface data
-    LOGICAL ::  stop_dt = .FALSE.                                !< internal switch to stop the time stepping
-    LOGICAL ::  synchronous_exchange = .FALSE.                   !< namelist parameter
-    LOGICAL ::  syn_turb_gen = .FALSE.                           !< flag for synthetic turbulence generator module
-    LOGICAL ::  terminate_run = .FALSE.                          !< terminate run (cpu-time limit, restarts)?
-    LOGICAL ::  topo_no_distinct = .FALSE.                       !< flag controlling classification of topography surfaces
-    LOGICAL ::  transpose_compute_overlap = .FALSE.              !< namelist parameter
-    LOGICAL ::  turbulent_inflow = .FALSE.                       !< namelist parameter
-    LOGICAL ::  turbulent_outflow = .FALSE.                      !< namelist parameter
-    LOGICAL ::  urban_surface = .FALSE.                          !< use urban surface model?
-    LOGICAL ::  use_fixed_date = .FALSE.                         !< date of simulation does not change (namelist parameter)
-    LOGICAL ::  use_fixed_time = .FALSE.                         !< time of simulation does not change (namelist parameter)
-    LOGICAL ::  use_free_convection_scaling = .FALSE.            !< namelist parameter to switch on free convection velocity scale
-                                                                 !< in calculation of horizontal wind speed (surface_layer_fluxes)
-    LOGICAL ::  use_initial_profile_as_reference = .FALSE.       !< use of initial profiles as reference state?
-    LOGICAL ::  use_prescribed_profile_data = .FALSE.            !< use of prescribed wind profiles?
-                                                                 !< (namelist parameters u_profile, v_profile)
-    LOGICAL ::  use_single_reference_value = .FALSE.             !< use of single value as reference state?
-    LOGICAL ::  use_subsidence_tendencies = .FALSE.              !< namelist parameter
-    LOGICAL ::  use_surface_fluxes = .FALSE.                     !< namelist parameter
-    LOGICAL ::  use_top_fluxes = .FALSE.                         !< namelist parameter
-    LOGICAL ::  use_ug_for_galilei_tr = .TRUE.                   !< namelist parameter
-    LOGICAL ::  use_upstream_for_tke = .FALSE.                   !< namelist parameter
-    LOGICAL ::  vdi_checks = .FALSE.                             !< do internal controls after VDI 3783 Part 9
-    LOGICAL ::  virtual_flight = .FALSE.                         !< use virtual flight model
-    LOGICAL ::  virtual_measurement = .FALSE.                    !< control parameter to switch-on virtual measurements
-    LOGICAL ::  wall_adjustment = .TRUE.                         !< namelist parameter
-    LOGICAL ::  wind_turbine = .FALSE.                           !< flag for use of wind turbine model
-    LOGICAL ::  write_binary = .FALSE.                           !< ENVPAR namelist parameter to steer restart I/O
-                                                                 !< (ENVPAR is provided by palmrun)
-    LOGICAL ::  write_svf = .FALSE.                              !< ENVPAR namelist parameter to steer output of svf
-                                                                 !< (ENVPAR is provided by palmrun)
-    LOGICAL ::  ws_scheme_sca = .FALSE.                          !< use Wicker-Skamarock scheme (scalar advection)?
-    LOGICAL ::  ws_scheme_mom = .FALSE.                          !< use Wicker-Skamarock scheme (momentum advection)?
-
-    LOGICAL ::  data_output_xy(0:1) = .FALSE.                !< output of xy cross-section data?
-    LOGICAL ::  data_output_xz(0:1) = .FALSE.                !< output of xz cross-section data?
-    LOGICAL ::  data_output_yz(0:1) = .FALSE.                !< output of yz cross-section data?
-
-    LOGICAL, DIMENSION(max_masks) ::  mask_surface = .FALSE.   !< flag for surface-following masked output
-
-    REAL(wp) ::  advected_distance_x = 0.0_wp                  !< advected distance of model domain along x
-                                                               !< (galilei transformation)
-    REAL(wp) ::  advected_distance_y = 0.0_wp                  !< advected distance of model domain along y
-                                                               !< (galilei transformation)
-    REAL(wp) ::  alpha_surface = 0.0_wp                        !< namelist parameter
-    REAL(wp) ::  atmos_ocean_sign = 1.0_wp                     !< vertical-grid conversion factor
-                                                               !< (=1.0 in atmosphere, =-1.0 in ocean)
-    REAL(wp) ::  averaging_interval = 0.0_wp                   !< namelist parameter
-    REAL(wp) ::  averaging_interval_pr = 9999999.9_wp          !< namelist parameter
-    REAL(wp) ::  bc_pt_t_val                                   !< vertical gradient of pt near domain top
-    REAL(wp) ::  bc_q_t_val                                    !< vertical gradient of humidity near domain top
-    REAL(wp) ::  bc_s_t_val                                    !< vertical gradient of passive scalar near domain top
-    REAL(wp) ::  bottom_salinityflux = 0.0_wp                  !< namelist parameter
-    REAL(wp) ::  building_height = 50.0_wp                     !< namelist parameter
-    REAL(wp) ::  building_length_x = 50.0_wp                   !< namelist parameter
-    REAL(wp) ::  building_length_y = 50.0_wp                   !< namelist parameter
-    REAL(wp) ::  building_wall_left = 9999999.9_wp             !< namelist parameter
-    REAL(wp) ::  building_wall_south = 9999999.9_wp            !< namelist parameter
-    REAL(wp) ::  canyon_height = 50.0_wp                       !< namelist parameter
-    REAL(wp) ::  canyon_width_x = 9999999.9_wp                 !< namelist parameter
-    REAL(wp) ::  canyon_width_y = 9999999.9_wp                 !< namelist parameter
-    REAL(wp) ::  canyon_wall_left = 9999999.9_wp               !< namelist parameter
-    REAL(wp) ::  canyon_wall_south = 9999999.9_wp              !< namelist parameter
-    REAL(wp) ::  cfl_factor = -1.0_wp                          !< namelist parameter
-    REAL(wp) ::  cos_alpha_surface                             !< cosine of alpha_surface
-    REAL(wp) ::  coupling_start_time = 0.0_wp                  !< namelist parameter
-    REAL(wp) ::  days_since_reference_point = 0.0_wp           !< days after atmosphere-ocean coupling has been activated,
-                                                               !< or after spinup phase of LSM has been finished
-    REAL(wp) ::  disturbance_amplitude = 0.25_wp               !< namelist parameter
-    REAL(wp) ::  disturbance_energy_limit = 0.01_wp            !< namelist parameter
-    REAL(wp) ::  disturbance_level_b = -9999999.9_wp           !< namelist parameter
-    REAL(wp) ::  disturbance_level_t = -9999999.9_wp           !< namelist parameter
-    REAL(wp) ::  dp_level_b = 0.0_wp                           !< namelist parameter
-    REAL(wp) ::  dt = -1.0_wp                                  !< namelist parameter
-    REAL(wp) ::  dt_averaging_input = 0.0_wp                   !< namelist parameter
-    REAL(wp) ::  dt_averaging_input_pr = 9999999.9_wp          !< namelist parameter
-    REAL(wp) ::  dt_coupling = 9999999.9_wp                    !< namelist parameter
-    REAL(wp) ::  dt_data_output = 9999999.9_wp                 !< namelist parameter
-    REAL(wp) ::  dt_data_output_av = 9999999.9_wp              !< namelist parameter
-    REAL(wp) ::  dt_disturb = 9999999.9_wp                     !< namelist parameter
-    REAL(wp) ::  dt_dopr = 9999999.9_wp                        !< namelist parameter
-    REAL(wp) ::  dt_dopr_listing = 9999999.9_wp                !< namelist parameter
-    REAL(wp) ::  dt_dopts = 9999999.9_wp                       !< namelist parameter
-    REAL(wp) ::  dt_dots = 9999999.9_wp                        !< namelist parameter
-    REAL(wp) ::  dt_do2d_xy = 9999999.9_wp                     !< namelist parameter
-    REAL(wp) ::  dt_do2d_xz = 9999999.9_wp                     !< namelist parameter
-    REAL(wp) ::  dt_do2d_yz = 9999999.9_wp                     !< namelist parameter
-    REAL(wp) ::  dt_do3d = 9999999.9_wp                        !< namelist parameter
-    REAL(wp) ::  dt_max = 20.0_wp                              !< namelist parameter
-    REAL(wp) ::  dt_restart = 9999999.9_wp                     !< namelist parameter
-    REAL(wp) ::  dt_run_control = 60.0_wp                      !< namelist parameter
-    REAL(wp) ::  dt_spinup = 5.0_wp                            !< namelist parameter
-    REAL(wp) ::  dt_write_agent_data = 9999999.9_wp            !< namelist parameter
-    REAL(wp) ::  dt_3d = 0.01_wp                               !< time step
-    REAL(wp) ::  dz_max = 999.0_wp                             !< namelist parameter
-    REAL(wp) ::  dz_stretch_factor = 1.08_wp                   !< namelist parameter
-    REAL(wp) ::  dz_stretch_level = -9999999.9_wp              !< namelist parameter
-    REAL(wp) ::  e_init = 0.0_wp                               !< namelist parameter
-    REAL(wp) ::  e_min = 0.0_wp                                !< namelist parameter
-    REAL(wp) ::  end_time = 0.0_wp                             !< namelist parameter
-    REAL(wp) ::  f = 0.0_wp                                    !< Coriolis parameter
-    REAL(wp) ::  fs = 0.0_wp                                   !< Coriolis parameter
-    REAL(wp) ::  inflow_damping_height = 9999999.9_wp          !< namelist parameter
-    REAL(wp) ::  inflow_damping_width = 9999999.9_wp           !< namelist parameter
-    REAL(wp) ::  km_constant = -1.0_wp                         !< namelist parameter
-    REAL(wp) ::  latitude = 55.0_wp                            !< namelist parameter
-    REAL(wp) ::  longitude = 0.0_wp                            !< namelist parameter
-    REAL(wp) ::  mask_scale_x = 1.0_wp                         !< namelist parameter
-    REAL(wp) ::  mask_scale_y = 1.0_wp                         !< namelist parameter
-    REAL(wp) ::  mask_scale_z = 1.0_wp                         !< namelist parameter
-    REAL(wp) ::  maximum_cpu_time_allowed = 0.0_wp             !< given wall time for run
-    REAL(wp) ::  molecular_viscosity = 1.461E-5_wp             !< molecular viscosity (used in lsm and lpm)
-    REAL(wp) ::  multi_agent_system_end   = 9999999.9_wp       !< namelist parameter (see documentation)
-    REAL(wp) ::  multi_agent_system_start = 0.0_wp             !< namelist parameter (see documentation)
-    REAL(wp) ::  omega = 7.29212E-5_wp                         !< namelist parameter
-    REAL(wp) ::  omega_sor = 1.8_wp                            !< namelist parameter
-    REAL(wp) ::  outflow_source_plane = -9999999.9_wp          !< namelist parameter
-    REAL(wp) ::  particle_maximum_age = 9999999.9_wp           !< namelist parameter
-    REAL(wp) ::  prandtl_number = 1.0_wp                       !< namelist parameter
-    REAL(wp) ::  pt_damping_factor = 0.0_wp                    !< namelist parameter
-    REAL(wp) ::  pt_damping_width = 0.0_wp                     !< namelist parameter
-    REAL(wp) ::  pt_reference = 9999999.9_wp                   !< namelist parameter
-    REAL(wp) ::  pt_slope_offset = 0.0_wp                      !< temperature difference between left and right
-                                                               !< boundary of total domain
-    REAL(wp) ::  pt_surface = 300.0_wp                         !< namelist parameter
-    REAL(wp) ::  pt_surface_heating_rate = 0.0_wp              !< namelist parameter
-    REAL(wp) ::  pt_surface_initial_change = 0.0_wp            !< namelist parameter
-    REAL(wp) ::  q_surface = 0.0_wp                            !< namelist parameter
-    REAL(wp) ::  q_surface_initial_change = 0.0_wp             !< namelist parameter
-    REAL(wp) ::  rayleigh_damping_factor = -1.0_wp             !< namelist parameter
-    REAL(wp) ::  rayleigh_damping_height = -1.0_wp             !< namelist parameter
-    REAL(wp) ::  recycling_width = 9999999.9_wp                !< namelist parameter
-    REAL(wp) ::  residual_limit = 1.0E-4_wp                    !< namelist parameter
-    REAL(wp) ::  restart_file_size                             !< size of restart file in mbyte
-    REAL(wp) ::  restart_time = 9999999.9_wp                   !< namelist parameter
-    REAL(wp) ::  rho_reference                                 !< reference state of density
-    REAL(wp) ::  rho_surface                                   !< surface value of density
-    REAL(wp) ::  rotation_angle = 0.0_wp                       !< clockwise rotation of model North relative to real North [deg]
-    REAL(wp) ::  roughness_length = 0.1_wp                     !< namelist parameter
-    REAL(wp) ::  simulated_time = 0.0_wp                       !< elapsed simulated time
-    REAL(wp) ::  simulated_time_at_begin                       !< elapsed simulated time of previous run (job chain)
-    REAL(wp) ::  sin_alpha_surface                             !< sine of alpha_surface (sloped surface)
-    REAL(wp) ::  skip_time_data_output = 0.0_wp                !< namelist parameter
-    REAL(wp) ::  skip_time_data_output_av = 9999999.9_wp       !< namelist parameter
-    REAL(wp) ::  skip_time_dopr = 9999999.9_wp                 !< namelist parameter
-    REAL(wp) ::  skip_time_do2d_xy = 9999999.9_wp              !< namelist parameter
-    REAL(wp) ::  skip_time_do2d_xz = 9999999.9_wp              !< namelist parameter
-    REAL(wp) ::  skip_time_do2d_yz = 9999999.9_wp              !< namelist parameter
-    REAL(wp) ::  skip_time_do3d = 9999999.9_wp                 !< namelist parameter
-    REAL(wp) ::  spinup_pt_amplitude = 0.0_wp                  !< namelist parameter
-    REAL(wp) ::  spinup_pt_mean = 9999999.9_wp                 !< namelist parameter
-    REAL(wp) ::  spinup_time = 0.0_wp                          !< namelist parameter
-    REAL(wp) ::  surface_heatflux = 9999999.9_wp               !< namelist parameter
-    REAL(wp) ::  surface_pressure = 1013.25_wp                 !< namelist parameter
-    REAL(wp) ::  surface_scalarflux = 9999999.9_wp             !< namelist parameter
-    REAL(wp) ::  surface_waterflux = 9999999.9_wp              !< namelist parameter
-    REAL(wp) ::  s_surface = 0.0_wp                            !< namelist parameter
-    REAL(wp) ::  s_surface_initial_change = 0.0_wp             !< namelist parameter
-    REAL(wp) ::  termination_time_needed = 35.0_wp             !< namelist parameter
-    REAL(wp) ::  time_coupling = 0.0_wp                        !< time since last coupling (surface_coupler)
-    REAL(wp) ::  time_disturb = 0.0_wp                         !< time since last flow disturbance
-    REAL(wp) ::  time_dopr = 0.0_wp                            !< time since last profile output
-    REAL(wp) ::  time_dopr_av = 0.0_wp                         !< time since last averaged profile output
-    REAL(wp) ::  time_dopr_listing = 0.0_wp                    !< time since last profile output (ASCII) on file
-    REAL(wp) ::  time_dopts = 0.0_wp                           !< time since last particle timeseries output
-    REAL(wp) ::  time_dosp = 0.0_wp                            !< time since last spectra output
-    REAL(wp) ::  time_dosp_av = 0.0_wp                         !< time since last averaged spectra output
-    REAL(wp) ::  time_dots = 0.0_wp                            !< time since last timeseries output
-    REAL(wp) ::  time_do2d_xy = 0.0_wp                         !< time since last xy cross-section output
-    REAL(wp) ::  time_do2d_xz = 0.0_wp                         !< time since last xz cross-section output
-    REAL(wp) ::  time_do2d_yz = 0.0_wp                         !< time since last yz cross-section output
-    REAL(wp) ::  time_do3d = 0.0_wp                            !< time since last 3d output
-    REAL(wp) ::  time_do_av = 0.0_wp                           !< time since last averaged-data output
-    REAL(wp) ::  time_do_sla = 0.0_wp                          !< time since last
-    REAL(wp) ::  time_restart = 9999999.9_wp                   !< time at which run shall be terminated and restarted
-    REAL(wp) ::  time_run_control = 0.0_wp                     !< time since last RUN_CONTROL output
-    REAL(wp) ::  time_since_reference_point = 0.0_wp           !< time after atmosphere-ocean coupling has been activated, or time
-                                                               !< after spinup phase of LSM has been finished
-    REAL(wp) ::  top_heatflux = 9999999.9_wp                   !< namelist parameter
-    REAL(wp) ::  top_momentumflux_u = 9999999.9_wp             !< namelist parameter
-    REAL(wp) ::  top_momentumflux_v = 9999999.9_wp             !< namelist parameter
-    REAL(wp) ::  top_salinityflux = 9999999.9_wp               !< namelist parameter
-    REAL(wp) ::  top_scalarflux = 9999999.9_wp                 !< namelist parameter
-    REAL(wp) ::  tunnel_height = 9999999.9_wp                  !< namelist parameter
-    REAL(wp) ::  tunnel_length = 9999999.9_wp                  !< namelist parameter
-    REAL(wp) ::  tunnel_width_x = 9999999.9_wp                 !< namelist parameter
-    REAL(wp) ::  tunnel_width_y = 9999999.9_wp                 !< namelist parameter
-    REAL(wp) ::  tunnel_wall_depth = 9999999.9_wp              !< namelist parameter
-    REAL(wp) ::  ug_surface = 0.0_wp                           !< namelist parameter
-    REAL(wp) ::  u_bulk = 0.0_wp                               !< namelist parameter
-    REAL(wp) ::  u_gtrans = 0.0_wp                             !< transformed wind component (galilei transformation)
-    REAL(wp) ::  vg_surface = 0.0_wp                           !< namelist parameter
-    REAL(wp) ::  vpt_reference = 9999999.9_wp                  !< reference state of virtual potential temperature
-    REAL(wp) ::  v_bulk = 0.0_wp                               !< namelist parameter
-    REAL(wp) ::  v_gtrans = 0.0_wp                             !< transformed wind component (galilei transformation)
-    REAL(wp) ::  zeta_max = 20.0_wp                            !< namelist parameter
-    REAL(wp) ::  zeta_min = -20.0_wp                           !< namelist parameter
-    REAL(wp) ::  z0h_factor = 1.0_wp                           !< namelist parameter
-
-    REAL(wp) ::  do2d_xy_last_time(0:1) = -1.0_wp                  !< time of previous xy output
-    REAL(wp) ::  do2d_xz_last_time(0:1) = -1.0_wp                  !< time of previous xz output
-    REAL(wp) ::  do2d_yz_last_time(0:1) = -1.0_wp                  !< time of previous yz output
-    REAL(wp) ::  dpdxy(1:2) = 0.0_wp                               !< namelist parameter
-    REAL(wp) ::  dt_domask(max_masks) = 9999999.9_wp               !< namelist parameter
-    REAL(wp) ::  dz(10) = -1.0_wp                                  !< namelist parameter
-    REAL(wp) ::  dz_stretch_level_start(9) = -9999999.9_wp         !< namelist parameter
-    REAL(wp) ::  dz_stretch_level_end(9) = 9999999.9_wp            !< namelist parameter
-    REAL(wp) ::  dz_stretch_factor_array(9) = 1.08_wp              !< namelist parameter
-    REAL(wp) ::  mask_scale(3)                                     !< collective array for mask_scale_x/y/z
-    REAL(wp) ::  pt_vertical_gradient(10) = 0.0_wp                 !< namelist parameter
-    REAL(wp) ::  pt_vertical_gradient_level(10) = -999999.9_wp     !< namelist parameter
-    REAL(wp) ::  q_vertical_gradient(10) = 0.0_wp                  !< namelist parameter
-    REAL(wp) ::  q_vertical_gradient_level(10) = -999999.9_wp      !< namelist parameter
-    REAL(wp) ::  s_vertical_gradient(10) = 0.0_wp                  !< namelist parameter
-    REAL(wp) ::  s_vertical_gradient_level(10) = -999999.9_wp      !< namelist parameter
-    REAL(wp) ::  skip_time_domask(max_masks) = 9999999.9_wp        !< namelist parameter
-    REAL(wp) ::  threshold(20) = 0.0_wp                            !< namelist parameter
-    REAL(wp) ::  time_domask(max_masks) = 0.0_wp                   !< namelist parameter
-    REAL(wp) ::  tsc(10) = (/ 1.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, &    !< array used for controlling time-integration at different substeps
-                 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp /)
-    REAL(wp) ::  u_profile(200) = 9999999.9_wp                     !< namelist parameter
-    REAL(wp) ::  uv_heights(200) = 9999999.9_wp                    !< namelist parameter
-    REAL(wp) ::  v_profile(200) = 9999999.9_wp                     !< namelist parameter
-    REAL(wp) ::  ug_vertical_gradient(10) = 0.0_wp                 !< namelist parameter
-    REAL(wp) ::  ug_vertical_gradient_level(10) = -9999999.9_wp    !< namelist parameter
-    REAL(wp) ::  vg_vertical_gradient(10) = 0.0_wp                 !< namelist parameter
-    REAL(wp) ::  vg_vertical_gradient_level(10) = -9999999.9_wp    !< namelist parameter
-    REAL(wp) ::  volume_flow(1:3) = 0.0_wp                         !< volume flow through 1:yz-plane, 2: xz-plane, 3: xy-plane
-                                                                   !< (nest childs only)
-    REAL(wp) ::  volume_flow_area(1:3) = 0.0_wp                    !< area of the respective volume flow planes
-    REAL(wp) ::  volume_flow_initial(1:3) = 0.0_wp                 !< initial volume flow (t=0) through the respective volume flow
-                                                                   !< planes
-    REAL(wp) ::  wall_heatflux(0:5) = 0.0_wp                       !< namelist parameter
-    REAL(wp) ::  wall_humidityflux(0:5) = 0.0_wp                   !< namelist parameter
-    REAL(wp) ::  wall_salinityflux(0:5) = 0.0_wp                   !< namelist parameter
-    REAL(wp) ::  wall_scalarflux(0:5) = 0.0_wp                     !< namelist parameter
-    REAL(wp) ::  subs_vertical_gradient(10) = 0.0_wp               !< namelist parameter
-    REAL(wp) ::  subs_vertical_gradient_level(10) = -9999999.9_wp  !< namelist parameter
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  dp_smooth_factor  !< smoothing factor for external pressure gradient forcing
-
-    REAL(wp), DIMENSION(max_masks,mask_xyz_dimension) ::  mask_x = -1.0_wp  !< namelist parameter
-    REAL(wp), DIMENSION(max_masks,mask_xyz_dimension) ::  mask_y = -1.0_wp  !< namelist parameter
-    REAL(wp), DIMENSION(max_masks,mask_xyz_dimension) ::  mask_z = -1.0_wp  !< namelist parameter
-
-    REAL(wp), DIMENSION(max_masks,3) ::  mask_x_loop = -1.0_wp  !< namelist parameter
-    REAL(wp), DIMENSION(max_masks,3) ::  mask_y_loop = -1.0_wp  !< namelist parameter
-    REAL(wp), DIMENSION(max_masks,3) ::  mask_z_loop = -1.0_wp  !< namelist parameter
-
-!
-!--    Internal mask arrays ("mask,dimension,selection")
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  mask       !< collective array for mask_x/y/z
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  mask_loop  !< collective array for mask_x/y/z_loop
+    TYPE(file_status), DIMENSION(200) :: openfile = file_status(.FALSE.,.FALSE.)
+
+
+    CHARACTER (LEN=1)   ::  cycle_mg = 'w', timestep_reason = ' '
+    CHARACTER (LEN=5)   ::  write_binary = 'false'
+    CHARACTER (LEN=6)   ::  grid_matching = 'match'
+    CHARACTER (LEN=8)   ::  run_date, run_time
+    CHARACTER (LEN=9)   ::  simulated_time_chr
+    CHARACTER (LEN=12)  ::  version = 'PALM   3.1b'
+    CHARACTER (LEN=16)  ::  momentum_advec = 'pw-scheme', &
+                            psolver = 'poisfft', &
+                            scalar_advec = 'pw-scheme'
+    CHARACTER (LEN=20)  ::  bc_e_b = 'neumann', bc_lr = 'cyclic', &
+                            bc_ns = 'cyclic', &
+                            bc_p_b = 'neumann', bc_p_t = 'dirichlet', &
+                            bc_pt_b = 'dirichlet', bc_pt_t = 'neumann', &
+                            bc_q_b = 'dirichlet', bc_q_t = 'neumann', &
+                            bc_s_b = 'dirichlet', bc_s_t = 'neumann', &
+                            bc_uv_b = 'dirichlet', bc_uv_t = 'dirichlet', &
+                            dissipation_1d = 'as_in_3d_model', &
+                            fft_method = 'system-specific', &
+                            mixing_length_1d = 'as_in_3d_model', &
+                            random_generator = 'numerical-recipes', &
+                            timestep_scheme = 'runge-kutta-3'
+    CHARACTER (LEN=40)  ::  avs_data_file, topography = 'flat'
+    CHARACTER (LEN=64)  ::  host
+    CHARACTER (LEN=80)  ::  log_message, run_description_header, run_identifier
+    CHARACTER (LEN=100) ::  initializing_actions = ' '
+
+    CHARACTER (LEN=7),  DIMENSION(100) ::  do3d_comp_prec = ' '
+    CHARACTER (LEN=10), DIMENSION(10)  ::  data_output_format = ' '
+    CHARACTER (LEN=10), DIMENSION(100) ::  data_output = ' ',    &
+                                           data_output_pr = ' ', &
+                                           data_output_ts = ' ', &
+                                           data_output_user = ' ', doav = ' '
+    CHARACTER (LEN=20), DIMENSION(10)  ::  netcdf_precision = ' '
+
+    CHARACTER (LEN=10), DIMENSION(0:1,100) ::  do2d = ' ', do3d = ' '
+
+    INTEGER ::  average_count_pr = 0, average_count_sp = 0, &
+                average_count_3d = 0, current_timestep_number = 0, &
+                dist_range = 0, disturbance_level_ind_b, &
+                disturbance_level_ind_t, doav_n = 0, dopr_n = 0, &
+                dopr_time_count = 0, dopts_time_count = 0, &
+                dosp_time_count = 0, dots_n = 0, dots_time_count = 0, &
+                do2d_xy_n = 0, do2d_xz_n = 0, do2d_yz_n = 0, do3d_avs_n = 0, &
+                dvrp_filecount = 0, dz_stretch_level_index, gamma_mg, &
+                grid_level, ibc_e_b, ibc_p_b, ibc_p_t, ibc_pt_b, ibc_pt_t, &
+                ibc_q_b, ibc_q_t, ibc_uv_b, ibc_uv_t, &
+                inflow_disturbance_begin = -1, inflow_disturbance_end = -1, &
+                intermediate_timestep_count, intermediate_timestep_count_max, &
+                iran = -1234567, last_dt_change = 0, maximum_grid_level, &
+                mgcycles = 0, mg_cycles = -1, mg_switch_to_pe0_level = 0, &
+                ngsrb = 2, nsor = 20, nsor_ini = 100, n_sor, &
+                normalizing_region = 0, nz_do1d, nz_do3d = -9999, &
+                outflow_damping_width = -1, prt_time_count = 0, runnr = 0, &
+                skip_do_avs = 0, timestep_count = 0
+
+    INTEGER ::  dist_nxl(0:1), dist_nxr(0:1), dist_nyn(0:1), dist_nys(0:1), &
+                do2d_no(0:1) = 0, do2d_xy_time_count(0:1), &
+                do2d_xz_time_count(0:1), do2d_yz_time_count(0:1), &
+                do3d_no(0:1) = 0, do3d_time_count(0:1), &
+                pt_vertical_gradient_level_ind(10) = -9999, &
+                q_vertical_gradient_level_ind(10) = -9999, &
+                section(100,3), section_xy(100) = -9999, &
+                section_xz(100) = -9999, section_yz(100) = -9999, &
+                ug_vertical_gradient_level_ind(10) = -9999, &
+                vg_vertical_gradient_level_ind(10) = -9999
+
+    INTEGER, DIMENSION(:), ALLOCATABLE ::  grid_level_count
+
+    LOGICAL ::  adjust_mixing_length = .FALSE., avs_output = .FALSE., &
+                call_psolver_at_all_substeps = .TRUE., &
+                cloud_droplets = .FALSE., cloud_physics = .FALSE., &
+                conserve_volume_flow = .FALSE., constant_diffusion = .FALSE., &
+                constant_heatflux = .TRUE., constant_waterflux = .TRUE., &
+                create_disturbances = .TRUE., cut_spline_overshoot = .TRUE., &
+                data_output_2d_on_each_pe = .TRUE., do2d_at_begin = .FALSE., &
+                do3d_at_begin = .FALSE., do3d_compress = .FALSE., &
+                do_sum = .FALSE., dt_changed = .FALSE., dt_fixed = .FALSE., &
+                disturbance_created = .FALSE., &
+                first_call_advec_particles = .TRUE., &
+                force_print_header = .FALSE., galilei_transformation = .FALSE., &
+                inflow_l = .FALSE., inflow_n = .FALSE., inflow_r = .FALSE., &
+                inflow_s = .FALSE., iso2d_output = .FALSE., &
+                mg_switch_to_pe0 = .FALSE., moisture = .FALSE., &
+                netcdf_output = .FALSE., netcdf_64bit = .FALSE., &
+                outflow_l = .FALSE., outflow_n = .FALSE., outflow_r = .FALSE., &
+                outflow_s = .FALSE., passive_scalar = .FALSE., &
+                prandtl_layer = .TRUE., precipitation = .FALSE., &
+                profil_output = .FALSE., radiation = .FALSE., &
+                random_heatflux = .FALSE., run_control_header = .FALSE., &
+                sloping_surface = .FALSE., stop_dt = .FALSE., &
+                terminate_run = .FALSE., use_prior_plot1d_parameters = .FALSE., &
+                use_surface_fluxes = .FALSE., use_ug_for_galilei_tr = .TRUE., &
+                use_upstream_for_tke = .FALSE., wall_adjustment = .TRUE.
+
+    LOGICAL ::  data_output_xy(0:1) = .FALSE., data_output_xz(0:1) = .FALSE., &
+                data_output_yz(0:1) = .FALSE.
+
+    REAL ::  advected_distance_x = 0.0, advected_distance_y = 0.0, &
+             alpha_surface = 0.0, asselin_filter_factor = 0.1, &
+             averaging_interval = 0.0, averaging_interval_pr = 9999999.9, &
+             averaging_interval_sp = 9999999.9, bc_pt_t_val, bc_q_t_val, &
+             building_height = 50.0, building_length_x = 50.0, &
+             building_length_y = 50.0, building_wall_left = 9999999.9, &
+             building_wall_south = 9999999.9, cfl_factor = -1.0, &
+             cos_alpha_surface, disturbance_amplitude = 0.25, &
+             disturbance_energy_limit = 0.01, disturbance_level_b = -1.0, &
+             disturbance_level_t = -1.0, dt = -1.0, dt_averaging_input = 0.0, &
+             dt_averaging_input_pr = 9999999.9, dt_data_output = 9999999.9, &
+             dt_data_output_av = 9999999.9, dt_disturb = 9999999.9, &
+             dt_dopr = 9999999.9, dt_dopr_listing = 9999999.9, &
+             dt_dopts = 9999999.9, dt_dosp = 9999999.9, dt_dots = 9999999.9, &
+             dt_do2d_xy = 9999999.9, dt_do2d_xz = 9999999.9, &
+             dt_do2d_yz = 9999999.9, dt_do3d = 9999999.9, dt_dvrp = 9999999.9, &
+             dt_max = 20.0, dt_prel = 9999999.9, dt_restart = 9999999.9, &
+             dt_run_control = 60.0, dt_3d = -1.0, dz = -1.0, &
+             dz_max = 9999999.9, dz_stretch_factor = 1.08, &
+             dz_stretch_level = 100000.0, e_min = 0.0, end_time = 0.0, &
+             f = 0.0, fs = 0.0, g = 9.81, kappa = 0.4, km_constant = -1.0, &
+             km_damp_max = -1.0, long_filter_factor = 0.0, &
+             maximum_cpu_time_allowed = 0.0, molecular_viscosity = 1.461E-5, &
+             old_dt = 1.0E-10, omega = 7.29212E-5, omega_sor = 1.8, &
+             overshoot_limit_e = 0.0, overshoot_limit_pt = 0.0, &
+             overshoot_limit_u = 0.0, overshoot_limit_v = 0.0, &
+             overshoot_limit_w = 0.0, particle_maximum_age = 9999999.9, &
+             phi = 55.0, prandtl_number = 1.0, pt_slope_offset = 0.0, &
+             pt_surface = 300.0, pt_surface_initial_change = 0.0, &
+             q_surface = 0.0, q_surface_initial_change = 0.0, &
+             rayleigh_damping_factor = -1.0, rayleigh_damping_height = -1.0, &
+             residual_limit = 1.0E-4, restart_time = 9999999.9, rif_max = 1.0, &
+             rif_min = -5.0, roughness_length = 0.1, simulated_time = 0.0, &
+             simulated_time_at_begin, sin_alpha_surface, &
+             skip_time_data_output = 0.0, skip_time_data_output_av = 9999999.9,&
+             skip_time_dopr = 9999999.9, skip_time_dosp = 9999999.9, &
+             skip_time_do2d_xy = 9999999.9, skip_time_do2d_xz = 9999999.9, &
+             skip_time_do2d_yz = 9999999.9, skip_time_do3d = 9999999.9, &
+             surface_heatflux = 9999999.9, surface_pressure = 1013.25, &
+             surface_scalarflux = 0.0, surface_waterflux = 0.0, &
+             s_surface = 0.0, s_surface_initial_change = 0.0, &
+             termination_time_needed = -1.0, time_disturb = 0.0, &
+             time_dopr = 0.0, time_dopr_av = 0.0, time_dopr_listing = 0.0, &
+             time_dopts = 0.0, time_dosp = 0.0, time_dosp_av = 0.0, &
+             time_dots = 0.0, time_do2d_xy = 0.0, time_do2d_xz = 0.0, &
+             time_do2d_yz = 0.0, time_do3d = 0.0, time_do_av = 0.0, &
+             time_do_sla = 0.0, time_dvrp = 0.0, time_prel = 0.0, &
+             time_restart = 9999999.9, time_run_control = 0.0, &
+             ug_surface = 0.0, u_gtrans = 0.0, ups_limit_e = 0.0, &
+             ups_limit_pt = 0.0, ups_limit_u = 0.0, ups_limit_v = 0.0, &
+             ups_limit_w = 0.0, vg_surface = 0.0, v_gtrans = 0.0, &
+             wall_adjustment_factor = 1.8, z_max_do1d = -1.0, &
+             z_max_do1d_normalized = -1.0, z_max_do2d = -1.0
+
+    REAL ::  do2d_xy_last_time(0:1) = -1.0, do2d_xz_last_time(0:1) = -1.0, &
+             do2d_yz_last_time(0:1) = -1.0, pt_vertical_gradient(10) = 0.0, &
+             pt_vertical_gradient_level(10) = -1.0, &
+             q_vertical_gradient(10) = 0.0, &
+             q_vertical_gradient_level(10) = -1.0, &
+             s_vertical_gradient(10) = 0.0, &
+             s_vertical_gradient_level(10) = -1.0, threshold(20) = 0.0, &
+             tsc(10) = (/ 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 /), &
+             ug_vertical_gradient(10) = 0.0, &
+             ug_vertical_gradient_level(10) = -1.0, &
+             vg_vertical_gradient(10) = 0.0, &
+             vg_vertical_gradient_level(10) = -1.0, &
+             volume_flow(1:2) = 0.0, volume_flow_area(1:2) = 0.0, &
+             volume_flow_initial(1:2) = 0.0, wall_heatflux(0:4) = 0.0
+
 
     SAVE
@@ -1267,27 +614,123 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of grid spacings.
-!--------------------------------------------------------------------------------------------------!
+
+
+ MODULE cpulog
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables for cpu-time measurements
+!------------------------------------------------------------------------------!
+
+    REAL ::  initial_wallclock_time
+
+    TYPE logpoint
+       REAL               ::  isum, ivect, mean, mtime, mtimevec, sum, vector
+       INTEGER            ::  counts
+       CHARACTER (LEN=20) ::  place
+    END TYPE logpoint
+
+    TYPE(logpoint), DIMENSION(100) ::  log_point = logpoint( 0.0, 0.0, 0.0,   &
+                                       0.0, 0.0, 0.0, 0.0, 0, ' ' ),          &
+                                       log_point_s = logpoint( 0.0, 0.0, 0.0, &
+                                       0.0, 0.0, 0.0, 0.0, 0, ' ' )
+
+    SAVE
+
+ END MODULE cpulog
+
+
+
+
+ MODULE dvrp_variables
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables used with dvrp-software
+!------------------------------------------------------------------------------!
+
+    CHARACTER (LEN=10) ::  dvrp_output = 'rtsp'
+
+    CHARACTER (LEN=20), DIMENSION(10) ::  mode_dvrp = &
+                                     (/ ( '                    ', i9 = 1,10 ) /)
+
+    CHARACTER (LEN=80) ::  dvrp_directory = 'default',                    &
+                           dvrp_file      = 'default',                    &
+                           dvrp_host      = 'origin.rvs.uni-hannover.de', &
+                           dvrp_password  = '********',                   &
+                           dvrp_username  = ' '
+
+    INTEGER ::  dvrp_colourtable_entries = 4, islice_dvrp, nx_dvrp, ny_dvrp, &
+                nz_dvrp
+
+    INTEGER, DIMENSION(10) ::  slicer_position_dvrp
+
+    LOGICAL ::  cyclic_dvrp = .FALSE., lock_steering_update = .FALSE., &
+                use_seperate_pe_for_dvrp_output = .FALSE.
+
+    REAL    ::  superelevation = 1.0, superelevation_x = 1.0, &
+                superelevation_y = 1.0
+
+#if defined( __decalpha )
+    REAL, DIMENSION(2,10)  ::  slicer_range_limits_dvrp = (/ &
+                                -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
+                                -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
+                                -1.0, 1.0, -1.0, 1.0 /)
+
+    REAL, DIMENSION(2,100) ::  interval_values_dvrp, interval_h_dvrp =       &
+                               (/ 270.0, 225.0, 225.0, 180.0, 70.0, 25.0,    &
+                                  25.0, -25.0, ( 0.0, i9 = 1, 192 ) /),      &
+                               interval_l_dvrp = 0.5, interval_s_dvrp = 1.0, &
+                               interval_a_dvrp = 0.0
+#else
+    REAL, DIMENSION(2,10)  ::  slicer_range_limits_dvrp
+
+    REAL, DIMENSION(2,100) ::  interval_values_dvrp, interval_h_dvrp,        &
+                               interval_l_dvrp = 0.5, interval_s_dvrp = 1.0, &
+                               interval_a_dvrp = 0.0
+
+    DATA  slicer_range_limits_dvrp / -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
+                                     -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
+                                     -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
+                                     -1.0, 1.0 /
+
+    DATA  interval_h_dvrp / 270.0, 225.0, 225.0, 180.0, 70.0, 25.0, &
+                            25.0, -25.0, 192 * 0.0 /
+#endif
+
+    REAL, DIMENSION(:), ALLOCATABLE ::  xcoor_dvrp, ycoor_dvrp, zcoor_dvrp
+
+    TYPE steering
+       CHARACTER (LEN=20) ::  name
+       REAL               ::  min, max
+       INTEGER            ::  imin, imax
+    END TYPE steering
+
+    TYPE(steering), DIMENSION(:), ALLOCATABLE ::  steering_dvrp
+
+    SAVE
+
+ END MODULE dvrp_variables
+
+
+
+
  MODULE grid_variables
 
-    USE kinds
-
-    REAL(wp) ::  ddx          !< 1/dx
-    REAL(wp) ::  ddx2         !< 1/dx2
-    REAL(wp) ::  dx = 1.0_wp  !< horizontal grid size (along x-direction)
-    REAL(wp) ::  dx2          !< dx*dx
-    REAL(wp) ::  ddy          !< 1/dy
-    REAL(wp) ::  ddy2         !< 1/dy2
-    REAL(wp) ::  dy = 1.0_wp  !< horizontal grid size (along y-direction)
-    REAL(wp) ::  dy2          !< dy*dy
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ddx2_mg  !< 1/dx_l**2 (dx_l: grid spacing along x on different multigrid level)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ddy2_mg  !< 1/dy_l**2 (dy_l: grid spacing along y on different multigrid level)
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  zu_s_inner  !< height of topography top on scalar grid
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  zw_w_inner  !< height of topography top on w grid
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of grid spacings
+!------------------------------------------------------------------------------!
+
+    REAL ::  ddx, ddx2, dx = 1.0, dx2, ddy, ddy2, dy = 1.0, dy2
+
+    REAL, DIMENSION(:), ALLOCATABLE ::  ddx2_mg, ddy2_mg
+
+    REAL, DIMENSION(:,:), ALLOCATABLE ::  fwxm, fwxp, fwym, fwyp, fxm, fxp, &
+                                          fym, fyp, wall_e_x, wall_e_y, &
+                                          wall_u, wall_v, wall_w_x, wall_w_y
 
     SAVE
@@ -1296,87 +739,27 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of array bounds, number of gridpoints, and wall flag arrays.
-!--------------------------------------------------------------------------------------------------!
+
+
  MODULE indices
 
-    USE kinds
-
-    INTEGER(iwp) ::  nbgp = 3       !< number of boundary ghost points
-    INTEGER(iwp) ::  ngp_sums       !< number of vertical profile grid points time number of output profiles - used for allreduce
-                                    !< statements in MPI calls
-    INTEGER(iwp) ::  ngp_sums_ls    !< number of vertical profile grid points time number of large-scale forcing profiles - used for
-                                    !< allreduce statements in MPI calls
-    INTEGER(iwp) ::  nnx            !< number of subdomain grid points in x-direction
-    INTEGER(iwp) ::  nx = 0         !< nx+1 = total number of grid points in x-direction
-    INTEGER(iwp) ::  nx_a           !< in coupled atmosphere-ocean runs: total number of grid points along x (atmosphere)
-    INTEGER(iwp) ::  nx_o           !< in coupled atmosphere-ocean runs: total number of grid points along x (ocean)
-    INTEGER(iwp) ::  nxl            !< left-most grid index of subdomain (excluding ghost points)
-    INTEGER(iwp) ::  nxlg           !< left-most grid index of subdomain (including ghost points)
-    INTEGER(iwp) ::  nxlu           !< =nxl+1 (at left domain boundary with inflow from left), else =nxl
-                                    !< (used for u-velocity component)
-    INTEGER(iwp) ::  nxr            !< right-most grid index of subdomain (excluding ghost points)
-    INTEGER(iwp) ::  nxrg           !< right-most grid index of subdomain (including ghost points)
-    INTEGER(iwp) ::  nx_on_file     !< nx of previous run in job chain
-    INTEGER(iwp) ::  nny            !< number of subdomain grid points in y-direction
-    INTEGER(iwp) ::  ny = 0         !< ny+1 = total number of grid points in y-direction
-    INTEGER(iwp) ::  ny_a           !< in coupled atmosphere-ocean runs: total number of grid points along y (atmosphere)
-    INTEGER(iwp) ::  ny_o           !< in coupled atmosphere-ocean runs: total number of grid points along y (ocean)
-    INTEGER(iwp) ::  nyn            !< north-most grid index of subdomain (excluding ghost points)
-    INTEGER(iwp) ::  nyng           !< north-most grid index of subdomain (including ghost points)
-    INTEGER(iwp) ::  nys            !< south-most grid index of subdomain (excluding ghost points)
-    INTEGER(iwp) ::  nysg           !< south-most grid index of subdomain (including ghost points)
-    INTEGER(iwp) ::  nysv           !< =nys+1 (at south domain boundary with inflow from south), else =nys
-                                    !< (used for v-velocity component)
-    INTEGER(iwp) ::  ny_on_file     !< ny of previous run in job chain
-    INTEGER(iwp) ::  nnz            !< number of subdomain grid points in z-direction
-    INTEGER(iwp) ::  nz = 0         !< total number of grid points in z-direction
-    INTEGER(iwp) ::  nzb            !< bottom grid index of computational domain
-    INTEGER(iwp) ::  nzb_diff       !< will be removed
-    INTEGER(iwp) ::  nzb_max        !< vertical index of topography top
-    INTEGER(iwp) ::  nzt            !< nzt+1 = top grid index of computational domain
-    INTEGER(iwp) ::  topo_min_level !< minimum topography-top index (usually equal to nzb)
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ngp_2dh       !< number of grid points of a horizontal cross section through the
-                                                              !< total domain
-    INTEGER(idp), DIMENSION(:), ALLOCATABLE ::  ngp_3d        !< number of grid points of the total domain
-    INTEGER(idp), DIMENSION(:), ALLOCATABLE ::  ngp_3d_inner  !< ! need to have 64 bit for grids > 2E9
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nxl_mg        !< left-most grid index of subdomain on different multigrid level
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nxr_mg        !< right-most grid index of subdomain on different multigrid level
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nyn_mg        !< north-most grid index of subdomain on different multigrid level
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nys_mg        !< south-most grid index of subdomain on different multigrid level
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nzt_mg        !< top-most grid index of subdomain on different multigrid level
-
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mg_loc_ind        !< internal array to store index bounds of all PEs of that
-                                                                    !< multigrid level where data is collected to PE0
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  ngp_2dh_outer     !< number of horizontal grid points which are non-topography and
-                                                                    !< non-surface-bounded
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  ngp_2dh_s_inner   !< number of horizontal grid points which are non-topography
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_1   !< topograpyh masking flag on multigrid level 1
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_2   !< topograpyh masking flag on multigrid level 2
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_3   !< topograpyh masking flag on multigrid level 3
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_4   !< topograpyh masking flag on multigrid level 4
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_5   !< topograpyh masking flag on multigrid level 5
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_6   !< topograpyh masking flag on multigrid level 6
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_7   !< topograpyh masking flag on multigrid level 7
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_8   !< topograpyh masking flag on multigrid level 8
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_9   !< topograpyh masking flag on multigrid level 9
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_10  !< topograpyh masking flag on multigrid level 10
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  advc_flags_m            !< flags used to degrade order of advection scheme for
-                                                                            !< momentum
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  advc_flags_s            !< flags used to degrade order of advection scheme for
-                                                                            !< scalar quantities
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  topo_top_ind            !< precalculated topography top indices
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  wall_flags_static_0     !< flags to mask topography and surface-bounded grid
-                                                                            !< points
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  wall_flags_total_0      !< merged array, which contains the static and dynamic
-                                                                            !< flags
-
-    INTEGER(iwp), DIMENSION(:,:,:), POINTER ::  flags  !< pointer to wall_flags_1-10
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of array bounds and number of gridpoints
+!------------------------------------------------------------------------------!
+
+    INTEGER ::  ngp_sums, nnx, nx = 0, nxa, nxl, nxr, nxra, nny, ny = 0, nya,  &
+                nyn, nyna, nys, nnz, nz = 0, nza, nzb, nzb_diff, nzt, nzta,    &
+                uxrp = 0, vynp = 0
+
+    INTEGER, DIMENSION(:), ALLOCATABLE ::                                      &
+                ngp_2dh, ngp_3d, ngp_3d_inner,                                 &
+                nnx_pe, nny_pe, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzt_mg
+
+    INTEGER, DIMENSION(:,:), ALLOCATABLE ::                                    &
+                ngp_2dh_outer, mg_loc_ind, nzb_diff_s_inner, nzb_diff_s_outer, &
+                nzb_diff_u, nzb_diff_v, nzb_inner, nzb_outer, nzb_s_inner,     &
+                nzb_s_outer, nzb_u_inner, nzb_u_outer, nzb_v_inner,            &
+                nzb_v_outer, nzb_w_inner, nzb_w_outer, nzb_2d
 
     SAVE
@@ -1385,42 +768,41 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interfaces for special subroutines which use optional parameters.
-!--------------------------------------------------------------------------------------------------!
+
+
  MODULE interfaces
 
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Interfaces for special subroutines which use optional parameters
+!------------------------------------------------------------------------------!
+
     INTERFACE
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-       SUBROUTINE global_min_max ( i1, i2, j1, j2, k1, k2, array, mode, offset, result, result_ijk,&
-                                   result1, result1_ijk )
-
-          USE kinds
-
-          CHARACTER (LEN=*), INTENT(IN) ::  mode                      !< mode of global min/max function: can be 'min', 'max',
-                                                                      !< 'minmax', 'abs', or 'absoff'
-
-          INTEGER(iwp), INTENT(IN)      ::  i1                        !< internal index of min/max function
-          INTEGER(iwp), INTENT(IN)      ::  i2                        !< internal index of min/max function
-          INTEGER(iwp), INTENT(IN)      ::  j1                        !< internal index of min/max function
-          INTEGER(iwp), INTENT(IN)      ::  j2                        !< internal index of min/max function
-          INTEGER(iwp), INTENT(IN)      ::  k1                        !< internal index of min/max function
-          INTEGER(iwp), INTENT(IN)      ::  k2                        !< internal index of min/max function
-
-          INTEGER(iwp)                  ::  result_ijk(3)             !< grid index result of min/max function
-          INTEGER(iwp), OPTIONAL        ::  result1_ijk(3)            !< optional grid index result of min/max function
-
-          REAL(wp)                      ::  offset                    !< min/max function calculates absolute value with respect to
-                                                                      !< an offset
-          REAL(wp)                      ::  result                    !< result of min/max function
-          REAL(wp), OPTIONAL            ::  result1                   !< optional result of min/max function
-
-          REAL(wp), INTENT(IN)          ::  array(i1:i2,j1:j2,k1:k2)  !< input array of min/max function
+       SUBROUTINE cpu_log( log_event, place, modus, barrierwait )
+
+          USE cpulog
+
+          CHARACTER (LEN=*)           ::  modus, place
+          CHARACTER (LEN=*), OPTIONAL ::  barrierwait
+          TYPE(logpoint)              ::  log_event
+
+       END SUBROUTINE cpu_log
+
+    END INTERFACE
+
+
+
+    INTERFACE
+
+       SUBROUTINE global_min_max ( i1, i2, j1, j2, k1, k2, feld, mode, wert, &
+                                   wert_ijk, wert1, wert1_ijk )
+          CHARACTER (LEN=*), INTENT(IN) ::  mode
+          INTEGER, INTENT(IN)           ::  i1, i2, j1, j2, k1, k2
+          INTEGER                       ::  wert_ijk(3)
+          INTEGER, OPTIONAL             ::  wert1_ijk(3)
+          REAL                          ::  wert
+          REAL, OPTIONAL                ::  wert1
+          REAL, INTENT(IN)              ::  feld(i1:i2,j1:j2,k1:k2)
 
        END SUBROUTINE global_min_max
@@ -1433,25 +815,20 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interfaces for subroutines with pointer arguments called in prognostic_equations.
-!--------------------------------------------------------------------------------------------------!
+
  MODULE pointer_interfaces
 
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Interfaces for subroutines with pointer arguments called in
+! prognostic_equations
+!------------------------------------------------------------------------------!
+
     INTERFACE
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
        SUBROUTINE advec_s_bc( sk, sk_char )
 
-          USE kinds
-
-          CHARACTER (LEN=*), INTENT(IN) ::  sk_char  !< string for treated scalar in Bott-Chlond scheme
-
-          REAL(wp), DIMENSION(:,:,:), POINTER ::  sk  !< treated scalar array in Bott-Chlond scheme
+          CHARACTER (LEN=*), INTENT(IN)   ::  sk_char
+          REAL, DIMENSION(:,:,:), POINTER ::  sk
 
        END SUBROUTINE advec_s_bc
@@ -1459,4 +836,5 @@
     END INTERFACE
 
+
     SAVE
 
@@ -1464,119 +842,280 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of variables which define processor topology and the exchange of ghost point layers.
-!> This module must be placed in all routines containing MPI-calls.
-!--------------------------------------------------------------------------------------------------!
+
+
+ MODULE model_1d
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables for the 1D-model
+!------------------------------------------------------------------------------!
+
+    INTEGER ::  current_timestep_number_1d = 0, damp_level_ind_1d, &
+                last_dt_change_1d = 0 
+
+    LOGICAL ::  run_control_header_1d = .FALSE., stop_dt_1d = .FALSE. 
+
+    REAL ::     damp_level_1d = -1.0, dt_1d = 60.0, dt_max_1d = 300.0, &
+                dt_pr_1d = 9999999.9, dt_run_control_1d = 60.0, &
+                end_time_1d = 864000.0, old_dt_1d = 1.0E-10, &
+                qs1d, simulated_time_1d = 0.0, time_pr_1d = 0.0, &
+                time_run_control_1d = 0.0, ts1d, us1d, usws1d, usws1d_m, &
+                vsws1d, vsws1d_m, z01d
+
+
+    REAL, DIMENSION(:), ALLOCATABLE ::  e1d, e1d_m, e1d_p, kh1d, kh1d_m, km1d, &
+                                        km1d_m, l_black, l1d, l1d_m, rif1d,    &
+                                        te_e, te_em, te_u, te_um, te_v, te_vm, &
+                                        u1d, u1d_m, u1d_p, v1d, v1d_m, v1d_p
+
+    SAVE
+
+ END MODULE model_1d
+
+
+
+
+ MODULE netcdf_control
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of parameters and variables for netcdf control.
+!------------------------------------------------------------------------------!
+
+#if defined( __netcdf )
+    USE netcdf
+#endif
+
+    INTEGER, PARAMETER ::  dopr_norm_num = 7, dopts_num = 26, dots_num = 22, &
+                           replace_num = 6
+
+    CHARACTER, DIMENSION( replace_num ) :: &
+                           replace_char = (/ '''', '"', '*', '/', '(', ')' /), &
+                           replace_by   = (/ 'p' , 'p', 's', 'o', '_', '_' /)
+
+    CHARACTER (LEN=6), DIMENSION(dopr_norm_num) ::  dopr_norm_names =   &
+         (/ 'wpt0  ', 'ws2   ', 'tsw2  ', 'ws3   ', 'ws2tsw', 'wstsw2', &
+            'z_i   ' /)
+
+    CHARACTER (LEN=6), DIMENSION(dopr_norm_num) ::  dopr_norm_longnames = &
+         (/ 'wpt0  ', 'w*2   ', 't*w2  ', 'w*3   ', 'w*2t*w', 'w*t*w2',   &
+            'z_i   ' /)
+
+    CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_label = &
+          (/ 'tnpt   ', 'x_     ', 'y_     ', 'z_     ', 'z_abs  ', 'u      ', &
+             'v      ', 'w      ', 'u"     ', 'v"     ', 'w"     ', 'npt_up ', &
+             'w_up   ', 'w_down ', 'npt_max', 'npt_min', 'x*2    ', 'y*2    ', &
+             'z*2    ', 'u*2    ', 'v*2    ', 'w*2    ', 'u"2    ', 'v"2    ', &
+             'w"2    ', 'npt*2  ' /)
+
+    CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_unit = &
+          (/ 'number ', 'm      ', 'm      ', 'm      ', 'm      ', 'm/s    ', &
+             'm/s    ', 'm/s    ', 'm/s    ', 'm/s    ', 'm/s    ', 'number ', &
+             'm/s    ', 'm/s    ', 'number ', 'number ', 'm2     ', 'm2     ', &
+             'm2     ', 'm2/s2  ', 'm2/s2  ', 'm2/s2  ', 'm2/s2  ', 'm2/s2  ', &
+             'm2/s2  ', 'number2' /)
+
+    CHARACTER (LEN=7), DIMENSION(dots_num) :: dots_label = &
+          (/ 'E      ', 'E*     ', 'dt     ', 'u*     ', 'th*    ', 'umax   ', &
+             'vmax   ', 'wmax   ', 'div_new', 'div_old', 'z_i_wpt', 'z_i_pt ', &
+             'w*     ', 'w"pt"0 ', 'w"pt"  ', 'wpt    ', 'pt(0)  ', 'pt(zp) ', &
+             'splptx ', 'splpty ', 'splptz ', 'mo_L   ' /)
+
+    CHARACTER (LEN=7), DIMENSION(dots_num) :: dots_unit = &
+          (/ 'm2/s2  ', 'm2/s2  ', 's      ', 'm/s    ', 'K      ', 'm/s    ', &
+             'm/s    ', 'm/s    ', 's-1    ', 's-1    ', 'm      ', 'm      ', &
+             'm/s    ', 'K m/s  ', 'K m/s  ', 'k m/s  ', 'K      ', 'K      ', &
+             '%      ', '%      ', '%      ', 'm      ' /)
+
+    CHARACTER (LEN=7), DIMENSION(100) ::  dopr_unit = 'unknown'
+
+    CHARACTER (LEN=7), DIMENSION(0:1,100) ::  do2d_unit, do3d_unit
+
+    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_names = &
+          (/ 'pt_age          ', 'pt_dvrp_size    ', 'pt_origin_x     ', &
+             'pt_origin_y     ', 'pt_origin_z     ', 'pt_radius       ', &
+             'pt_speed_x      ', 'pt_speed_y      ', 'pt_speed_z      ', &
+             'pt_weight_factor', 'pt_x            ', 'pt_y            ', &
+             'pt_z            ', 'pt_color        ', 'pt_group        ', &
+             'pt_tailpoints   ', 'pt_tail_id      ', 'pt_density_ratio', &
+             'pt_exp_arg      ', 'pt_exp_term     ', 'not_used        ', &
+             'not_used        ', 'not_used        ', 'not_used        ', &
+             'not_used        ' /)
+
+    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_units = &
+          (/ 'seconds         ', 'meters          ', 'meters          ', &
+             'meters          ', 'meters          ', 'meters          ', &
+             'm/s             ', 'm/s             ', 'm/s             ', &
+             'factor          ', 'meters          ', 'meters          ', &
+             'meters          ', 'none            ', 'none            ', &
+             'none            ', 'none            ', 'ratio           ', &
+             'none            ', 'none            ', 'not_used        ', &
+             'not_used        ', 'not_used        ', 'not_used        ', &
+             'not_used        ' /)
+
+    INTEGER ::  id_dim_prtnum, id_dim_time_pr, id_dim_time_prt, &
+                id_dim_time_pts, id_dim_time_sp, id_dim_time_ts, id_dim_x_sp, &
+                id_dim_y_sp, id_dim_zu_sp, id_dim_zw_sp, id_set_pr, &
+                id_set_prt, id_set_pts, id_set_sp, id_set_ts, id_var_prtnum, &
+                id_var_rnop_prt, id_var_time_pr, id_var_time_prt, &
+                id_var_time_pts, id_var_time_sp, id_var_time_ts, id_var_x_sp, &
+                id_var_y_sp, id_var_zu_sp, id_var_zw_sp, nc_stat
+
+    INTEGER, DIMENSION(0:1) ::  id_dim_time_xy, id_dim_time_xz, &
+                id_dim_time_yz, id_dim_time_3d, id_dim_x_xy, id_dim_xu_xy, &
+                id_dim_x_xz, id_dim_xu_xz, id_dim_x_yz, id_dim_xu_yz, &
+                id_dim_x_3d, id_dim_xu_3d, id_dim_y_xy, id_dim_yv_xy, &
+                id_dim_y_xz, id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, &
+                id_dim_y_3d, id_dim_yv_3d, id_dim_zu_xy, id_dim_zu1_xy, &
+                id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy, &
+                id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d, id_set_xy, &
+                id_set_xz, id_set_yz, id_set_3d, id_var_ind_x_yz, &
+                id_var_ind_y_xz, id_var_ind_z_xy, id_var_time_xy, &
+                id_var_time_xz, id_var_time_yz, id_var_time_3d, id_var_x_xy, &
+                id_var_xu_xy, id_var_x_xz, id_var_xu_xz, id_var_x_yz, &
+                id_var_xu_yz, id_var_x_3d, id_var_xu_3d, id_var_y_xy, &
+                id_var_yv_xy, id_var_y_xz, id_var_yv_xz, id_var_y_yz, &
+                id_var_yv_yz, id_var_y_3d, id_var_yv_3d, id_var_zu_xy, &
+                id_var_zu1_xy, id_var_zu_xz, id_var_zu_yz, id_var_zu_3d, &
+                id_var_zw_xy, id_var_zw_xz, id_var_zw_yz, id_var_zw_3d
+
+    INTEGER, DIMENSION(10)  ::  id_var_dospx, id_var_dospy, nc_precision 
+    INTEGER, DIMENSION(20)  ::  id_var_prt
+    INTEGER, DIMENSION(dopr_norm_num) ::  id_var_norm_dopr
+
+    INTEGER, DIMENSION(dopts_num,0:10) ::  id_var_dopts
+    INTEGER, DIMENSION(0:1,100)        ::  id_var_do2d, id_var_do3d
+    INTEGER, DIMENSION(100,0:9)        ::  id_dim_z_pr, id_var_dopr, &
+                                           id_var_z_pr
+    INTEGER, DIMENSION(dots_num,0:9)   ::  id_var_dots
+
+
+    SAVE
+
+ END MODULE netcdf_control
+
+
+
+ MODULE particle_attributes
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables used to compute particle transport
+!------------------------------------------------------------------------------!
+
+    USE array_kind
+
+    CHARACTER (LEN=15)  ::  bc_par_lr = 'cyclic',  bc_par_ns = 'cyclic', &
+                            bc_par_b  = 'reflect', bc_par_t  = 'absorb'
+
+#if defined( __parallel )
+    INTEGER ::  mpi_particle_type
+#endif
+    INTEGER ::  ibc_par_lr, ibc_par_ns, ibc_par_b, ibc_par_t,                  &
+                iran_part = -1234567, maximum_number_of_particles = 1000,      &
+                maximum_number_of_tailpoints = 100,                            &
+                maximum_number_of_tails = 0,                                   &
+                number_of_initial_particles = 0, number_of_particles = 0,      &
+                number_of_particle_groups = 1, number_of_tails = 0,            &
+                number_of_initial_tails = 0, particles_per_point = 1,          &
+                particle_file_count = 0, skip_particles_for_tail = 100,        &
+                total_number_of_particles, total_number_of_tails = 0
+
+    INTEGER, PARAMETER ::  max_number_of_particle_groups = 10
+
+    INTEGER, DIMENSION(:), ALLOCATABLE     ::  new_tail_id
+    INTEGER, DIMENSION(:,:,:), ALLOCATABLE ::  prt_count, prt_start_index
+
+    LOGICAL ::  particle_advection = .FALSE., random_start_position = .FALSE., &
+                read_particles_from_restartfile = .TRUE.,                      &
+                uniform_particles = .TRUE., use_particle_tails = .FALSE.,      &
+                use_sgs_for_particles = .FALSE.,                               &
+                vertical_particle_advection = .TRUE.,                          &
+                write_particle_statistics = .FALSE.
+    LOGICAL, DIMENSION(:), ALLOCATABLE ::  particle_mask, tail_mask
+
+    REAL    ::  c_0 = 3.0, dt_min_part = 0.0002,                               &
+                dt_write_particle_data = 9999999.9, dvrp_psize = 9999999.9,    &
+                end_time_prel = 9999999.9, initial_weighting_factor = 1.0,     &
+                maximum_tailpoint_age = 100000.0,                              &
+                minimum_tailpoint_distance = 0.0,                              &
+                particle_advection_start = 0.0, sgs_wfu_part = 0.3333333,      &
+                sgs_wfv_part = 0.3333333, sgs_wfw_part = 0.3333333,            &
+                time_write_particle_data = 0.0
+
+    REAL, DIMENSION(max_number_of_particle_groups) ::  &
+                density_ratio = 9999999.9, pdx = 9999999.9, pdy = 9999999.9, &
+                pdz = 9999999.9, psb = 9999999.9, psl = 9999999.9,           &
+                psn = 9999999.9, psr = 9999999.9, pss = 9999999.9,           &
+                pst = 9999999.9, radius = 9999999.9
+
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  particle_tail_coordinates
+
+
+    TYPE particle_type
+       SEQUENCE
+       REAL    ::  age, dt_sum, dvrp_psize, e_m, origin_x, origin_y, origin_z, &
+                   radius, speed_x, speed_x_sgs, speed_y, speed_y_sgs,         &
+                   speed_z, speed_z_sgs, weight_factor, x, y, z
+       INTEGER ::  color, group, tailpoints, tail_id
+    END TYPE particle_type
+
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  initial_particles, &
+                                                       particles
+
+    TYPE particle_groups_type
+       SEQUENCE
+       REAL    ::  density_ratio, radius, exp_arg, exp_term
+    END TYPE particle_groups_type
+
+    TYPE(particle_groups_type), DIMENSION(max_number_of_particle_groups) ::&
+                   particle_groups
+
+    SAVE
+
+ END MODULE particle_attributes
+
+
+
+
+
  MODULE pegrid
 
-    USE kinds
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables which define processor topology and the exchange of
+! ghost point layers. This modules must be placed in all routines which contain
+! MPI-calls.
+!------------------------------------------------------------------------------!
 
 #if defined( __parallel )
+#if defined( __lcmuk )
     USE MPI
+!    INCLUDE "mpif.h"
+#else
+    INCLUDE "mpif.h"
 #endif
-
-    CHARACTER(LEN=2) ::  send_receive = 'al'     !<
-    CHARACTER(LEN=7) ::  myid_char = ''          !< character string containing processor id number
-
-    INTEGER(iwp) ::  comm1dx                     !< communicator for domain decomposition along x
-    INTEGER(iwp) ::  comm1dy                     !< communicator for domain decomposition along y
-    INTEGER(iwp) ::  comm2d                      !< standard 2d (xy) communicator used in PALM for the process group the PE belongs
-                                                 !< to
-    INTEGER(iwp) ::  comm_inter                  !< intercommunicator that connects atmosphere/ocean process groups
-    INTEGER(iwp) ::  comm_palm                   !< internal communicator used during the MPI setup at the beginning of a run
-    INTEGER(iwp) ::  id_inflow = 0               !< myidx of procs at inflow (turbulent inflow method)
-    INTEGER(iwp) ::  id_outflow = 0              !< myidx of procs at outflow (turbulent outflow method)
-    INTEGER(iwp) ::  id_outflow_source = 0       !< myidx of procs including ouflow source plane (turbulent outflow method)
-    INTEGER(iwp) ::  id_recycling = 0            !< myidx of procs containing the recycling plane (turbulence recycling method)
-    INTEGER(iwp) ::  ierr                        !< standard error parameter in MPI calls
-    INTEGER(iwp) ::  myid = 0                    !< id number of processor element
-    INTEGER(iwp) ::  myidx = 0                   !< id number of processor elements with same position along x-direction
-    INTEGER(iwp) ::  myidy = 0                   !< id number of processor elements with same position along y-direction
-    INTEGER(iwp) ::  ndim = 2                    !< dimension of the virtual PE grid
-    INTEGER(iwp) ::  ngp_a                       !< used in atmosphere/ocean coupling: total number of horizontal grid points
-                                                 !< (atmosphere)
-    INTEGER(iwp) ::  ngp_o                       !< used in atmosphere/ocean coupling: total number of horizontal grid points
-                                                 !< (ocean)
-    INTEGER(iwp) ::  ngp_xy                      !< used in atmosphere/ocean coupling: number of grid points of the subdomain
-    INTEGER(iwp) ::  ngp_y                       !< number of subdomain grid points along y including ghost points
-    INTEGER(iwp) ::  npex = -1                   !< number of processor elements in x-direction
-    INTEGER(iwp) ::  npey = -1                   !< number of processor elements in y-direction
-    INTEGER(iwp) ::  numprocs = 1                !< total number of appointed processor elements
-    INTEGER(iwp) ::  numprocs_previous_run = -1  !< total number of appointed processor elements in previous run (job chain)
-    INTEGER(iwp) ::  pleft                       !< MPI id of left neigbour pe
-    INTEGER(iwp) ::  pnorth                      !< MPI id of right neigbour pe
-    INTEGER(iwp) ::  pright                      !< MPI id of south neigbour pe
-    INTEGER(iwp) ::  psouth                      !< MPI id of north neigbour pe
-    INTEGER(iwp) ::  req_count = 0               !< MPI return variable - checks if Send-Receive operation is already finished
-    INTEGER(iwp) ::  sendrecvcount_xy            !< number of subdomain gridpoints to be exchanged in direct transpositions
-                                                 !< (y --> x, or x --> y) or second (2d) transposition x --> y
-    INTEGER(iwp) ::  sendrecvcount_yz            !< number of subdomain gridpoints to be exchanged in third (2d) transposition
-                                                 !< y --> z
-    INTEGER(iwp) ::  sendrecvcount_zx            !< number of subdomain gridpoints to be exchanged in first (2d) transposition
-                                                 !< z --> x
-    INTEGER(iwp) ::  sendrecvcount_zyd           !< number of subdomain gridpoints to be exchanged in direct transpositions z --> y (used for calculating spectra)
-    INTEGER(iwp) ::  target_id                   !< in atmosphere/ocean coupling: id of the ocean/atmosphere counterpart PE with
-                                                 !< whom the atmosphere/ocean PE exchanges data
-    INTEGER(iwp) ::  tasks_per_node = -9999      !< MPI tasks per compute node
-    INTEGER(iwp) ::  threads_per_task = 1        !< number of OPENMP threads per MPI task
-    INTEGER(iwp) ::  type_x                      !< derived MPI datatype for 2-D ghost-point exchange - north / south
-    INTEGER(iwp) ::  type_xy                     !< derived MPI datatype for 2-D ghost-point exchange - north / south
-    INTEGER(iwp) ::  type_y                      !< derived MPI datatype for 2-D exchange in atmosphere-ocean coupler
-
-    INTEGER(iwp) ::  pdims(2) = 1  !< number of processors along x-y dimension
-    INTEGER(iwp) ::  req(100)      !< MPI return variable indicating if send-receive operation is finished
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  hor_index_bounds               !< horizontal index bounds
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  hor_index_bounds_previous_run  !< horizontal index bounds of previous run
-
-    LOGICAL ::  collective_wait = .FALSE.          !< switch to set an explicit MPI barrier in front of all collective MPI calls
-
-    TYPE virtual_pe_grid
-       INTEGER(iwp) ::  mpi_communicator         !< MPI communicator id
-       INTEGER(iwp) ::  pleft                    !< MPI id of left neigbour pe
-       INTEGER(iwp) ::  pright                   !< MPI id of right neigbour pe
-       INTEGER(iwp) ::  psouth                   !< MPI id of south neigbour pe
-       INTEGER(iwp) ::  pnorth                   !< MPI id of north neigbour pe
-    END TYPE virtual_pe_grid
-
-    TYPE(virtual_pe_grid) ::  communicator_configurations(4)  !< stores the four possible 2d virtual grids:
-                                                              !< cyclic, cyclic along x, cyclic along y, non-cyclic
+#endif
+    CHARACTER(LEN=5)       ::  myid_char = '', myid_char_14 = ''
+    INTEGER                ::  myid=0, npex = -1, npey = -1, numprocs = 1, &
+                               tasks_per_node = -9999, threads_per_task = 1
 
 #if defined( __parallel )
-    INTEGER(iwp) ::  ibuf(12)                 !< internal buffer for calculating MPI settings
-    INTEGER(iwp) ::  pcoord(2)                !< PE coordinates along x and y
-    INTEGER(iwp) ::  status(MPI_STATUS_SIZE)  !< MPI status variable used in various MPI calls
-    INTEGER(iwp) ::  type_x_byte              !< derived MPI datatype for 2-D 8-bit integer ghost-point exchange - north / south
-    INTEGER(iwp) ::  type_y_byte              !< derived MPI datatype for 2-D integer ghost-point exchange - left / right
-
-    INTEGER(iwp), DIMENSION(MPI_STATUS_SIZE,100) ::  wait_stat  !< MPI status variable used in various MPI calls
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ngp_xz      !< number of ghost points in xz-plane on different multigrid level
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ngp_xz_int  !< number of ghost points in xz-plane on different multigrid level
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ngp_yz      !< number of ghost points in yz-plane on different multigrid level
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ngp_yz_int  !< number of ghost points in yz-plane on different multigrid level
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  type_x_int  !< derived MPI datatype for 2-D integer ghost-point exchange - north /
-                                                            !< south
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  type_xz     !< derived MPI datatype for 3-D integer ghost-point exchange - north /
-                                                            !< south
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  type_xz_int !< derived MPI datatype for 3-D integer ghost-point exchange - north /
-                                                            !< south
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  type_y_int  !< derived MPI datatype for 2-D integer ghost-point exchange - left /
-                                                            !< right
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  type_yz     !< derived MPI datatype for 3-D integer ghost-point exchange - left /
-                                                            !< right
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  type_yz_int !< derived MPI datatype for 3-D integer ghost-point exchange - left /
-                                                            !< right
-
-    LOGICAL ::  left_border_pe  = .FALSE.  !< = .TRUE. if PE is on left border of computational domain
-    LOGICAL ::  north_border_pe = .FALSE.  !< = .TRUE. if PE is on north border of computational domain
-    LOGICAL ::  reorder = .TRUE.           !< switch to allow MPI the reorder of ranking (e.g. row-major or column-major)
-    LOGICAL ::  right_border_pe = .FALSE.  !< = .TRUE. if PE is on right border of computational domain
-    LOGICAL ::  south_border_pe = .FALSE.  !< = .TRUE. if PE is on south border of computational domain
-
-    LOGICAL, DIMENSION(2) ::  cyclic = (/ .TRUE. , .TRUE. /)  !< boundary conditions of the virtual PE grid
-    LOGICAL, DIMENSION(2) ::  remain_dims                     !< internal array used to determine sub-topologies for transpositions
+    INTEGER ::  comm1dx, comm1dy, comm2d, comm_palm, ierr, myidx, myidy,       &
+                ndim = 2, ngp_y, ngp_yz_p, pleft, pnorth, pright, psouth,      &
+                sendrecvcount_xy, sendrecvcount_yz, sendrecvcount_zx,          &
+                sendrecvcount_zyd, sendrecvcount_yxd,                          &
+                type_x, type_x_int, type_xz_p, ibuf(12), pcoord(2), pdims(2),  &
+                status(MPI_STATUS_SIZE)
+
+    INTEGER, DIMENSION(:), ALLOCATABLE ::  ngp_yz, type_xz
+
+    LOGICAL ::  reorder = .TRUE.
+    LOGICAL, DIMENSION(2) ::  cyclic = (/ .TRUE. , .TRUE. /), &
+                              remain_dims
 #endif
 
@@ -1586,43 +1125,83 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of variables which control PROFIL-output.
-!--------------------------------------------------------------------------------------------------!
+
+
  MODULE profil_parameter
 
-    USE kinds
-
-    INTEGER(iwp), PARAMETER ::  crmax = 100  !< maximum number of coordinate systems for profile output
-
-    CHARACTER (LEN=27), DIMENSION(20) ::  cross_ts_profiles = &  !< time series to be plotted into one coordinate system, respectively
-                                          (/ ' E E*                      ',                        &
-                                             ' dt                        ',                        &
-                                             ' u* w*                     ',                        &
-                                             ' th*                       ',                        &
-                                             ' umax vmax wmax            ',                        &
-                                             ' div_old div_new           ',                        &
-                                             ' zi_wtheta zi_theta        ',                        &
-                                             ' w"theta"0 w"theta" wtheta ',                        &
-                                             ' theta(0) theta(zp)        ',                        &
-                                             ' splux spluy spluz         ',                        &
-                                             ' L                         ',                        &
-                                           ( '                           ', i9 = 1, 9 ) /)
-
-    CHARACTER (LEN=100), DIMENSION(crmax) ::  cross_profiles = &  !< quantities to be plotted into one coordinate system, respectively
-                                              (/ ' u v                                          ', &
-                                                 ' pt                                           ', &
-                                                 ' w"theta" w*theta* w*theta*BC wtheta wthetaBC ', &
-                                                 ' w"u" w*u* wu w"v" w*v* wv                    ', &
-                                                 ' km kh                                        ', &
-                                                 ' l                                            ', &
-                                 ( '                                              ', i9 = 1, 94 ) /)
-
-    INTEGER(iwp) ::  profile_columns = 2  !< number of coordinate systems on a profile plot per column
-    INTEGER(iwp) ::  profile_rows = 3     !< number of coordinate systems on a profile plot per row
-
-    INTEGER(iwp) ::  dopr_index(500) = 0                !< index number of respective profile quantity
-    INTEGER(iwp) ::  dopr_initial_index(500) = 0        !< index number of initial profiles to be output
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables which control PROFIL-output
+!------------------------------------------------------------------------------!
+
+    INTEGER, PARAMETER ::  crmax = 100
+
+    CHARACTER (LEN=10), DIMENSION(100) ::  dopr_label = ' '
+
+    CHARACTER (LEN=10), DIMENSION(crmax) ::  cross_normalized_x = ' ', &
+                                             cross_normalized_y = ' '
+
+    CHARACTER (LEN=20), DIMENSION(20) ::  cross_ts_profiles = &
+                           (/ ' E E*               ', ' dt                 ', &
+                              ' u* w*              ', ' th*                ', &
+                              ' umax vmax wmax     ', ' div_old div_new    ', &
+                              ' z_i_wpt z_i_pt     ', ' w"pt"0 w"pt" wpt   ', &
+                              ' pt(0) pt(zp)       ', ' splux spluy spluz  ', &
+                              ' L                  ',                         &
+                            ( '                    ', i9 = 1, 9 ) /)
+
+    CHARACTER (LEN=40), DIMENSION(crmax) ::  cross_xtext = &
+                           (/ 'windspeed in ms>->1         ', &
+                              'pot. temperature in K       ', &
+                              'heat flux in K ms>->1       ', &
+                              'momentum flux in m>2s>2     ', &
+                              'eddy diffusivity in m>2s>->1', &
+                              'mixing length in m          ', &
+                            ( '                            ', i9 = 1, 94 ) /)
+
+    CHARACTER (LEN=100), DIMENSION(crmax) ::  cross_profiles = &
+                           (/ ' u v                           ', &
+                              ' pt                            ', &
+                              ' w"pt" w*pt* w*pt*BC wpt wptBC ', &
+                              ' w"u" w*u* wu w"v" w*v* wv     ', &
+                              ' km kh                         ', &
+                              ' l                             ', &
+                         ( '                               ', i9 = 1, 94 ) /)
+
+    INTEGER ::  profile_columns = 3, profile_rows = 2, profile_number = 0
+
+    INTEGER ::  cross_linecolors(100,crmax) = 1, &
+                cross_linestyles(100,crmax) = 0, &
+                cross_profile_numbers(100,crmax) = 0, &
+                cross_pnc_local(crmax), cross_profile_number_count(crmax) = 0, &
+                cross_ts_numbers(crmax,crmax) = 0, &
+                cross_ts_number_count(crmax) = 0, dopr_crossindex(100) = 0, &
+                dopr_index(100) = 0, dopr_initial_index(100) = 0, &
+                dots_crossindex(100) = 0, dots_index(100) = 0, &
+                linecolors(10) = (/ 2, 3, 4,  5, 7, 8, 12, 15, 16, 23 /), &
+                linestyles(11) = (/ 0, 7, 3, 10, 4, 1,  9,  2,  5,  8, 6 /)
+                
+
+    REAL ::  cross_normx_factor(100,crmax) = 1.0, &
+             cross_normy_factor(100,crmax) = 1.0, &
+             cross_ts_uymax(20) = &
+                             (/ 999.999, 999.999, 999.999, 999.999, 999.999,   &
+                                999.999, 999.999, 999.999, 999.999, 999.999,   &
+                                999.999, 999.999, 999.999, 999.999, 999.999,   &
+                                999.999, 999.999, 999.999, 999.999, 999.999 /),&
+             cross_ts_uymax_computed(20) = 999.999, &
+             cross_ts_uymin(20) = &
+                             (/ 999.999, 999.999, 999.999,  -5.000, 999.999,   &
+                                999.999,   0.000, 999.999, 999.999, 999.999,   &
+                                999.999, 999.999, 999.999, 999.999, 999.999,   &
+                                999.999, 999.999, 999.999, 999.999, 999.999 /),&
+             cross_ts_uymin_computed(20) = 999.999, &
+             cross_uxmax(crmax) = 0.0, cross_uxmax_computed(crmax) = -1.0, &
+             cross_uxmax_normalized(crmax) = 0.0, &
+             cross_uxmax_normalized_computed(crmax) = -1.0, &
+             cross_uxmin(crmax) = 0.0, cross_uxmin_computed(crmax) =  1.0, &
+             cross_uxmin_normalized(crmax) = 0.0, &
+             cross_uxmin_normalized_computed(crmax) = 1.0, &
+             cross_uymax(crmax), cross_uymin(crmax)
 
     SAVE
@@ -1630,89 +1209,66 @@
  END MODULE profil_parameter
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of statistical quantities, e.g. global sums.
-!--------------------------------------------------------------------------------------------------!
+
+
+
+ MODULE spectrum
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of quantities used for computing spectra
+!------------------------------------------------------------------------------!
+
+    CHARACTER (LEN=6),  DIMENSION(1:5) ::  header_char = (/ 'PS(u) ', 'PS(v) ',&
+                                           'PS(w) ', 'PS(pt)', 'PS(q) ' /)
+    CHARACTER (LEN=2),  DIMENSION(10)  ::  spectra_direction = 'x'
+    CHARACTER (LEN=10), DIMENSION(10)  ::  data_output_sp  = ' '
+    CHARACTER (LEN=25), DIMENSION(1:5) ::  utext_char =                    &
+                                           (/ '-power spectrum of u     ', &
+                                              '-power spectrum of v     ', &
+                                              '-power spectrum of w     ', &
+                                              '-power spectrum of ^1185 ', &
+                                              '-power spectrum of q     ' /)
+    CHARACTER (LEN=39), DIMENSION(1:5) ::  ytext_char =                        &
+                                 (/ 'k ^2236 ^2566^2569<u(k) in m>2s>->2    ', &
+                                    'k ^2236 ^2566^2569<v(k) in m>2s>->2    ', &
+                                    'k ^2236 ^2566^2569<w(k) in m>2s>->2    ', &
+                                    'k ^2236 ^2566^2569<^1185(k) in m>2s>->2', &
+                                    'k ^2236 ^2566^2569<q(k) in m>2s>->2    ' /)
+
+    INTEGER ::  klist_x = 0, klist_y = 0, n_sp_x = 0, n_sp_y = 0
+
+    INTEGER ::  comp_spectra_level(10) = 999999,                   &
+                lstyles(10) = (/ 0, 7, 3, 10, 1, 4, 9, 2, 6, 8 /), &
+                plot_spectra_level(10) = 999999
+
+    REAL    ::  time_to_start_sp = 0.0
+
+    SAVE
+
+ END MODULE spectrum
+
+
+
+
  MODULE statistics
 
-    USE kinds
-
-    CHARACTER (LEN=40) ::  region(0:9) = 'total domain                            '  !< label for statistic region
-
-    INTEGER(iwp) ::  pr_palm = 200          !< maximum number of output profiles
-    INTEGER(iwp) ::  statistic_regions = 0  !< identifier for statistic regions
-
-    INTEGER(iwp) ::  u_max_ijk(3) = -1  !< index values (i,j,k) of location where u_max occurs
-    INTEGER(iwp) ::  v_max_ijk(3) = -1  !< index values (i,j,k) of location where v_max occurs
-    INTEGER(iwp) ::  w_max_ijk(3) = -1  !< index values (i,j,k) of location where w_max occurs
-
-    LOGICAL ::  flow_statistics_called = .FALSE.  !< flag that tells other routines if flow statistics was executed
-                                                  !< (after each timestep)
-
-    REAL(wp) ::  u_max = 0.0_wp  !< maximum of absolute u-veloctiy in entire domain
-    REAL(wp) ::  v_max = 0.0_wp  !< maximum of absolute v-veloctiy in entire domain
-    REAL(wp) ::  w_max = 0.0_wp  !< maximum of absolute w-veloctiy in entire domain
-
-    REAL(wp), DIMENSION(2) ::  z_i  !< inversion height
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mean_surface_level_height  !< mean surface level height for the different statistic
-                                                                       !< regions
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  sums_divnew_l              !< subdomain sum (_l) of divergence after pressure
-                                                                       !< solver call (new)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  sums_divold_l              !< subdomain sum (_l) of divergence before pressure
-                                                                       !< solver call (old)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  weight_pres                !< substep weighting factor for pressure solver
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  weight_substep             !< weighting factor for substeps in timestepping
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums             !< global sum array for the various output quantities
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_ls_l        !< subdomain sum of large scale forcing and nudging tendencies
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_salsa_ws_l  !< subdomain sum of vertical salsa flux w's'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_us2_ws_l    !< subdomain sum of horizontal momentum flux u'u'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_vs2_ws_l    !< subdomain sum of horizontal momentum flux v'v'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_ws2_ws_l    !< subdomain sum of vertical momentum flux w'w'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsncs_ws_l  !< subdomain sum of vertical clouddrop-number concentration flux
-                                                               !< w'nc' (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsngs_ws_l  !< subdomain sum of vertical graupel-number concentration flux w'nc' (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsnis_ws_l  !< subdomain sum of vertical ice crystal concentration flux w'ni'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsnrs_ws_l  !< subdomain sum of vertical raindrop-number concentration flux w'nr'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsnss_ws_l  !< subdomain sum of vertical snow-number concentration flux w'ns' (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wssas_ws_l  !< subdomain sum of vertical salinity flux w'sa'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsss_ws_l   !< subdomain sum of vertical passive scalar flux w's'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wspts_ws_l  !< subdomain sum of vertical sensible heat flux w'pt'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsqcs_ws_l  !< subdomain sum of vertical cloudwater flux w'qc'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsqgs_ws_l  !< subdomain sum of vertical graupel flux w'qg' (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsqis_ws_l  !< subdomain sum of vertical ice crystal flux w'qi'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsqrs_ws_l  !< subdomain sum of vertical rainwater flux w'qr'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsqss_ws_l  !< subdomain sum of vertical snow flux w'qs' (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsqs_ws_l   !< subdomain sum of vertical latent heat flux w'q'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsts_bc_l   !< subdomain sum of sensible heat flux in Bott-Chlond scheme
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsus_ws_l   !< subdomain sum of vertical momentum flux w'u'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_wsvs_ws_l   !< subdomain sum of vertical momentum flux w'v'
-                                                               !< (5th-order advection scheme only)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ts_value         !< timeseries output array for the various output quantities
-
-    REAL(wp), DIMENSION(:,:), POINTER     ::  sums_wschs_ws_l  !< subdomain sum of vertical chemistry flux w'ch'
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  hom_sum             !< sum array for horizontal mean
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  rmask               !< REAL flag array (0.0 or 1.0) for statistic regions
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  sums_l              !< subdomain sum (_l) gathered for various quantities
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  sums_l_l            !< subdomain sum (_l) of mixing length from diffusivities
-
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  hom  !< horizontal mean of various quantities (profiles/timeseries)
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of statistical quantities, e.g. global sums
+!------------------------------------------------------------------------------!
+
+    CHARACTER (LEN=40) ::  region(0:9)
+    INTEGER ::  statistic_regions = 0, var_hom = 80, var_sum = 80
+    INTEGER ::  u_max_ijk(3), v_max_ijk(3), w_max_ijk(3)
+    LOGICAL ::  flow_statistics_called = .FALSE.
+    REAL ::     u_max, v_max, w_max
+    REAL, DIMENSION(:), ALLOCATABLE       ::  sums_divnew_l, sums_divold_l
+    REAL, DIMENSION(:,:), ALLOCATABLE     ::  sums, sums_wsts_bc_l
+    REAL, DIMENSION(:,:,:), ALLOCATABLE   ::  hom_sum, rmask, spectrum_x, &
+                                              spectrum_y, sums_l, sums_l_l, &
+                                              sums_up_fraction_l
+    REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  hom
 
     SAVE
@@ -1722,29 +1278,17 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Definition of indices for transposed arrays.
-!--------------------------------------------------------------------------------------------------!
+
  MODULE transpose_indices
 
-    USE kinds
-
-    INTEGER(iwp) ::  nxl_y   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nxl_yd  !< internal index bound for transpositions
-    INTEGER(iwp) ::  nxl_z   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nxr_y   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nxr_yd  !< internal index bound for transpositions
-    INTEGER(iwp) ::  nxr_z   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nyn_x   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nyn_z   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nys_x   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nys_z   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nzb_x   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nzb_y   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nzb_yd  !< internal index bound for transpositions
-    INTEGER(iwp) ::  nzt_x   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nzt_y   !< internal index bound for transpositions
-    INTEGER(iwp) ::  nzt_yd  !< internal index bound for transpositions
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of indices for transposed arrays
+!------------------------------------------------------------------------------!
+
+    INTEGER ::  nxl_y, nxl_yd, nxl_z, nxr_y, nxr_ya, nxr_yd, nxr_yda, nxr_z, &
+                nxr_za, nyn_x, nyn_xa, nyn_z, nyn_za, nys_x, nys_z, nzb_x,   &
+                nzb_y, nzb_yd, nzt_x, nzt_xa, nzt_y, nzt_ya, nzt_yd, nzt_yda
+                
 
     SAVE
Index: palm/trunk/SOURCE/multi_agent_system_mod.f90
===================================================================
--- palm/trunk/SOURCE/multi_agent_system_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,4626 +1,0 @@
-!> @file multi_agent_system_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2016-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! file re-formatted to follow the PALM coding standard
-!
-! 4623 2020-07-24 08:42:02Z raasch
-! some switches calculated explicitly to avoid compiler warnings
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! bugfix: cpp-directives for serial mode added
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Removed wall_flags_static_0 from USE statements as it's not used within the module
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4307 2019-11-26 14:12:36Z maronga
-! Activated output of iPT
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction  of additional debug
-! messages
-!
-! 3876 2019-04-08 18:41:49Z knoop
-! replaced nspec by nvar: only variable species should bconsidered, fixed species are not relevant
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! save attribute added to local targets to avoid outlive pointer target warning
-!
-! 3665 2019-01-10 08:28:24Z raasch
-! unused variables removed
-!
-! 3159 2018-07-20 11:20:01Z sward
-! Initial revision
-!
-!
-!
-! Authors:
-! --------
-! @author sward
-!
-!
-! Description:
-! ------------
-!> Multi Agent System for the simulation of pedestrian movement in urban environments
-!--------------------------------------------------------------------------------------------------!
- MODULE multi_agent_system_mod
-
-    USE, INTRINSIC ::  ISO_C_BINDING
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  pi
-
-    USE control_parameters,                                                                        &
-        ONLY:  biometeorology,                                                                     &
-               debug_output_timestep,                                                              &
-               dt_3d,                                                                              &
-               dt_write_agent_data,                                                                &
-               message_string,                                                                     &
-               time_since_reference_point
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point, log_point_s
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy, dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, topo_top_ind
-
-    USE random_function_mod,                                                                       &
-        ONLY:  random_function
-
-    USE kinds
-
-    USE pegrid
-
-    INTEGER(iwp), PARAMETER ::  max_number_of_agent_groups = 100  !< maximum allowed number of agent groups
-    INTEGER(iwp), PARAMETER ::  nr_2_direction_move = 10000       !< parameter for agent exchange
-    INTEGER(iwp), PARAMETER ::  phase_init    = 1                 !< phase parameter
-    INTEGER(iwp), PARAMETER ::  phase_release = 2                 !< phase parameter
-
-    CHARACTER(LEN=15) ::  bc_mas_lr = 'absorb'  !< left/right boundary condition
-    CHARACTER(LEN=15) ::  bc_mas_ns = 'absorb'  !< north/south boundary condition
-
-    INTEGER(iwp) ::  agt_path_size = 15                !< size of agent path array
-    INTEGER(iwp) ::  deleted_agents = 0                !< number of deleted agents per time step
-    INTEGER(iwp) ::  dim_size_agtnum_manual = 9999999  !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  heap_count                        !< number of items in binary heap (for pathfinding)
-    INTEGER(iwp) ::  ibc_mas_lr                        !< agent left/right boundary condition dummy
-    INTEGER(iwp) ::  ibc_mas_ns                        !< agent north/south boundary condition dummy
-!    INTEGER(iwp) ::  ind_pm10 = -9                     !< chemical species index of PM10
-!    INTEGER(iwp) ::  ind_pm25 = -9                     !< chemical species index of PM2.5
-    INTEGER(iwp) ::  iran_agent = -1234567             !< number for random generator
-    INTEGER(iwp) ::  min_nr_agent = 2                  !< namelist parameter (see documentation)
-#if defined( __parallel )
-    INTEGER(iwp) ::  ghla_count_recv                   !< number of agents in left ghost layer
-    INTEGER(iwp) ::  ghna_count_recv                   !< number of agents in north ghost layer
-    INTEGER(iwp) ::  ghra_count_recv                   !< number of agents in right ghost layer
-    INTEGER(iwp) ::  ghsa_count_recv                   !< number of agents in south ghost layer
-    INTEGER(iwp) ::  nr_move_north                     !< number of agts to move north during exchange_horiz
-    INTEGER(iwp) ::  nr_move_south                     !< number of agts to move south during exchange_horiz
-#endif
-    INTEGER(iwp) ::  maximum_number_of_agents = 0      !< maximum number of agents during run
-    INTEGER(iwp) ::  number_of_agents = 0              !< number of agents for each grid box (3d array is saved on agt_count)
-    INTEGER(iwp) ::  number_of_agent_groups = 1        !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  sort_count_mas = 0                !< counter for sorting agents
-    INTEGER(iwp) ::  step_dealloc_mas = 100            !< namelist parameter (see documentation)
-    INTEGER(iwp) ::  total_number_of_agents            !< total number of agents in the whole model domain
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  agt_count         !< 3d array of number of agents of every grid box
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  s_measure_height  !< k-index(s-grid) for measurement
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  top_top_s         !< k-index of first s-gridpoint above topography
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  top_top_w         !< k-index of first v-gridpoint above topography
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  obstacle_flags    !< flags to identify corners and edges of topography that cannot
-                                                                    !< be crossed by agents
-
-    LOGICAL ::  deallocate_memory_mas = .TRUE.          !< namelist parameter (see documentation)
-    LOGICAL ::  dt_3d_reached_mas                       !< flag: agent timestep has reached model timestep
-    LOGICAL ::  dt_3d_reached_l_mas                     !< flag: agent timestep has reached model timestep
-    LOGICAL ::  agents_active = .FALSE.                 !< flag for agent system
-    LOGICAL ::  random_start_position_agents = .TRUE.   !< namelist parameter (see documentation)
-    LOGICAL ::  read_agents_from_restartfile = .FALSE.  !< namelist parameter (see documentation)
-    LOGICAL ::  agent_own_timestep = .FALSE.            !< namelist parameter (see documentation)
-
-    LOGICAL, DIMENSION(max_number_of_agent_groups) ::  a_rand_target = .FALSE. !< namelist parameter (see documentation)
-
-    REAL(wp) ::  agent_maximum_age = 9999999.9_wp          !< namelist parameter (see documentation)
-    REAL(wp) ::  agent_substep_time = 0.0_wp               !< time measurement during one LES timestep
-    REAL(wp) ::  alloc_factor_mas = 20.0_wp                !< namelist parameter (see documentation)
-    REAL(wp) ::  coll_t_0 = 3.                             !< namelist parameter (see documentation)
-    REAL(wp) ::  corner_gate_start = 0.5_wp                !< namelist parameter (see documentation)
-    REAL(wp) ::  corner_gate_width = 1.0_wp                !< namelist parameter (see documentation)
-    REAL(wp) ::  dim_size_factor_agtnum = 1.0_wp           !< namelist parameter (see documentation)
-    REAL(wp) ::  d_sigma_rep_agent                         !< inverse of sigma_rep_agent
-    REAL(wp) ::  d_sigma_rep_wall                          !< inverse of sigma_rep_wall
-    REAL(wp) ::  d_tau_accel_agent                         !< inverse of tau_accel_agent
-    REAL(wp) ::  desired_speed = 1.2_wp                    !< namelist parameter (see documentation)
-    REAL(wp) ::  des_sp_sig = .2_wp                        !< namelist parameter (see documentation)
-    REAL(wp) ::  dist_target_reached = 2.0_wp              !< distance at which target counts as reached
-    REAL(wp) ::  dist_to_int_target = .25_wp               !< namelist parameter (see documentation)
-    REAL(wp) ::  dt_agent = 0.02_wp                        !< namelist parameter (see documentation)
-    REAL(wp) ::  dt_arel = 9999999.9_wp                    !< namelist parameter (see documentation)
-    REAL(wp) ::  end_time_arel = 9999999.9_wp              !< namelist parameter (see documentation)
-    REAL(wp) ::  force_x                                   !< dummy value for force on current agent in x-direction
-    REAL(wp) ::  force_y                                   !< dummy value for force on current agent in y-direction
-    REAL(wp) ::  max_dist_from_path = 0.25_wp              !< distance from current path at which a new path is calculated
-    REAL(wp) ::  radius_agent = .25_wp                     !< namelist parameter (see documentation)
-    REAL(wp) ::  repuls_agent = 1.5_wp                     !< namelist parameter (see documentation)
-    REAL(wp) ::  repuls_wall = 7.0_wp                      !< namelist parameter (see documentation)
-    REAL(wp) ::  scan_radius_agent = 3.0_wp                !< namelist parameter (see documentation)
-    REAL(wp) ::  scan_radius_wall = 2.0_wp                 !< namelist parameter (see documentation)
-    REAL(wp) ::  sigma_rep_agent = 0.3_wp                  !< namelist parameter (see documentation)
-    REAL(wp) ::  sigma_rep_wall = 0.1_wp                   !< namelist parameter (see documentation)
-    REAL(wp) ::  tau_accel_agent = 0.5_wp                  !< namelist parameter (see documentation)
-    REAL(wp) ::  time_arel = 0.0_wp                        !< time for agent release
-    REAL(wp) ::  time_write_agent_data = 0.0_wp            !< write agent data at current time on file
-    REAL(wp) ::  v_max_agent = 1.3_wp                      !< namelist parameter (see documentation)
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  dummy_path_x  !<  dummy path (x-coordinate)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  dummy_path_y  !<  dummy path (y-coordinate)
-
-    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  adx = 9999999.9_wp  !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  ady = 9999999.9_wp  !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  asl = 9999999.9_wp  !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  asn = 9999999.9_wp  !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  asr = 9999999.9_wp  !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  ass = 9999999.9_wp  !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  at_x = 9999999.9_wp !< namelist parameter (see documentation)
-    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  at_y = 9999999.9_wp !< namelist parameter (see documentation)
-!
-!-- Type for the definition of an agent
-    TYPE agent_type
-        INTEGER(iwp) ::  block_nr             !< number for sorting
-        INTEGER(iwp) ::  group                !< number of agent group
-        INTEGER(idp) ::  id                   !< particle ID (64 bit integer)
-        INTEGER(iwp) ::  path_counter         !< current target along path (path_x/y)
-        LOGICAL      ::  agent_mask           !< if this parameter is set to false the agent will be deleted
-        REAL(wp)     ::  age                  !< age of agent
-        REAL(wp)     ::  age_m                !< age of agent
-        REAL(wp)     ::  dt_sum               !< sum of agents subtimesteps
-        REAL(wp)     ::  clo                  !< clothing index
-        REAL(wp)     ::  energy_storage       !< energy stored by agent
-        REAL(wp)     ::  clothing_temp        !< energy stored by agent
-        REAL(wp)     ::  actlev               !< metabolic + work energy of the person
-        REAL(wp)     ::  age_years            !< physical age of the person
-        REAL(wp)     ::  weight               !< total weight of the person (kg)
-        REAL(wp)     ::  height               !< height of the person (m)
-        REAL(wp)     ::  work                 !< workload of the agent (W)
-        INTEGER(iwp) ::  sex                  !< agents gender: 1 = male, 2 = female
-        REAL(wp)     ::  force_x              !< force term x-direction
-        REAL(wp)     ::  force_y              !< force term y-direction
-        REAL(wp)     ::  origin_x             !< origin x-position of agent
-        REAL(wp)     ::  origin_y             !< origin y-position of agent
-        REAL(wp)     ::  pm10                 !< PM10 concentration at agent position
-        REAL(wp)     ::  pm25                 !< PM25 concentration at agent position
-        REAL(wp)     ::  speed_abs            !< absolute value of agent speed
-        REAL(wp)     ::  speed_e_x            !< normalized speed of agent in x
-        REAL(wp)     ::  speed_e_y            !< normalized speed of agent in y
-        REAL(wp)     ::  speed_des            !< agent's desired speed
-        REAL(wp)     ::  speed_x              !< speed of agent in x
-        REAL(wp)     ::  speed_y              !< speed of agent in y
-        REAL(wp)     ::  ipt                  !< instationary thermal index iPT (degree_C)
-        REAL(wp)     ::  windspeed            !< absolute value of windspeed at agent position
-        REAL(wp)     ::  x                    !< x-position
-        REAL(wp)     ::  y                    !< y-position
-        REAL(wp)     ::  t                    !< temperature
-        REAL(wp)     ::  t_x                  !< x-position
-        REAL(wp)     ::  t_y                  !< y-position
-        REAL(wp), DIMENSION(0:15) ::  path_x  !< agent path to target (x)
-        REAL(wp), DIMENSION(0:15) ::  path_y  !< agent path to target (y)
-    END TYPE agent_type
-
-    TYPE(agent_type)                        ::  zero_agent           !< zero agent to avoid weird thing
-
-    TYPE(agent_type), DIMENSION(:), POINTER ::  agents               !< Agent array for this grid cell
-#if defined( __parallel )
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  agt_gh_l         !< ghost layer left of pe domain
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  agt_gh_n         !< ghost layer north of pe domain
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  agt_gh_r         !< ghost layer right of pe domain
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  agt_gh_s         !< ghost layer south of pe domain
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  move_also_north  !< for agent exchange between PEs
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  move_also_south  !< for agent exchange between PEs
-#endif
-!
-!-- Type for 2D grid on which agents are stored
-    TYPE  grid_agent_def
-        INTEGER(iwp), DIMENSION(0:3)            ::  start_index        !< start agent index for current block
-        INTEGER(iwp), DIMENSION(0:3)            ::  end_index          !< end agent index for current block
-        INTEGER(iwp)                            ::  id_counter         !< agent id counter (removeable?)
-        LOGICAL                                 ::  time_loop_done     !< timestep loop for agent advection
-        TYPE(agent_type), POINTER, DIMENSION(:) ::  agents             !< Particle array for this grid cell
-    END TYPE grid_agent_def
-
-    TYPE(grid_agent_def), DIMENSION(:,:), ALLOCATABLE, TARGET ::  grid_agents !< 2D grid on which agents are stored
-!
-!-- Item in a priority queue (binary heap)
-    TYPE heap_item
-       INTEGER(iwp) ::  mesh_id       !< id of the submitted mesh point
-       REAL(wp)     ::  priority      !< priority of the mesh point (= distance so far + heuristic to goal)
-    END TYPE heap_item
-
-    TYPE(heap_item), DIMENSION(:), ALLOCATABLE ::  queue  !< priority queue realized as binary heap
-!
-!-- Type for mesh point in visibility graph
-    TYPE  mesh_point
-        INTEGER(iwp)                            ::  polygon_id          !< Polygon the point belongs to
-        INTEGER(iwp)                            ::  vertex_id           !< Vertex in the polygon
-        INTEGER(iwp)                            ::  noc                 !< number of connections
-        INTEGER(iwp)                            ::  origin_id           !< ID of previous mesh point on path (A*)
-        INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  connected_vertices  !< Index of connected vertices
-        REAL(wp)                                ::  cost_so_far         !< Cost to reach this mesh point (A*)
-        REAL(wp)                                ::  x                   !< x-coordinate
-        REAL(wp)                                ::  y                   !< y-coordinate
-        REAL(wp)                                ::  x_s                 !< corner shifted outward from building by 1m (x)
-        REAL(wp)                                ::  y_s                 !< corner shifted outward from building by 1m (y)
-        REAL(wp), DIMENSION(:), ALLOCATABLE     ::  distance_to_vertex  !< Distance to each vertex
-    END TYPE mesh_point
-
-    TYPE(mesh_point), DIMENSION(:), ALLOCATABLE ::  mesh     !< navigation mesh
-    TYPE(mesh_point), DIMENSION(:), ALLOCATABLE ::  tmp_mesh !< temporary navigation mesh
-!
-!-- Vertex of a polygon
-    TYPE  vertex_type
-        LOGICAL               ::  delete  !< Flag to mark vertex for deletion
-        REAL(wp)              ::  x       !< x-coordinate
-        REAL(wp)              ::  y       !< y-coordinate
-    END TYPE vertex_type
-!
-!-- Polygon containing a number of vertices
-    TYPE  polygon_type
-        INTEGER(iwp)                                 ::  nov       !< Number of vertices in this polygon
-        TYPE(vertex_type), DIMENSION(:), ALLOCATABLE ::  vertices  !< Array of vertices
-    END TYPE polygon_type
-
-    TYPE(polygon_type), DIMENSION(:), ALLOCATABLE ::  polygons  !< Building data in polygon form
-
-    SAVE
-
-    PRIVATE
-!
-!-- Public functions
-    PUBLIC mas_init, mas_last_actions, mas_parin, multi_agent_system
-
-!
-!-- Public parameters, constants and initial values
-    PUBLIC agents_active
-
-    INTERFACE mas_parin
-       MODULE PROCEDURE mas_parin
-    END INTERFACE mas_parin
-
-    INTERFACE mas_init
-       MODULE PROCEDURE mas_init
-    END INTERFACE mas_init
-
-    INTERFACE mas_last_actions
-       MODULE PROCEDURE mas_last_actions
-    END INTERFACE mas_last_actions
-
-    INTERFACE multi_agent_system
-       MODULE PROCEDURE multi_agent_system
-    END INTERFACE multi_agent_system
-
-    CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Multi Agent System:
-!> executes a number of agents sub-timesteps until the model timestep is reached.
-!> The agent timestep is usually smaller than the model timestep.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE multi_agent_system
-
-    USE biometeorology_mod,                                                                        &
-        ONLY:  bio_calc_ipt,                                                                       &
-               bio_calculate_mrt_grid,                                                             &
-               bio_get_thermal_index_input_ij
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)       ::  i                  !< counter
-    INTEGER(iwp)       ::  ie                 !< counter
-    INTEGER(iwp)       ::  is                 !< counter
-    INTEGER(iwp)       ::  j                  !< counter
-    INTEGER(iwp)       ::  je                 !< counter
-    INTEGER(iwp)       ::  js                 !< counter
-    INTEGER(iwp), SAVE ::  mas_count = 0      !< counts the mas-calls
-    INTEGER(iwp)       ::  a                  !< agent iterator
-!
-!-- local meteorological conditions
-    REAL(wp) ::  pair  !< air pressure                    (hPa)
-    REAL(wp) ::  ta    !< air temperature                 (degree_C)
-    REAL(wp) ::  tmrt  !< mean radiant temperature        (degree_C)
-    REAL(wp) ::  v     !< wind speed    (local level)     (m/s)
-    REAL(wp) ::  vp    !< vapour pressure                 (hPa)
-
-
-    LOGICAL       ::  first_loop_stride   !< flag for first loop stride of agent sub-timesteps
-    LOGICAL, SAVE ::  first_call = .TRUE. !< first call of mas flag for output
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'multi_agent_system', 'start' )
-
-    CALL cpu_log( log_point(9), 'mas', 'start' )
-!
-!-- Initialize variables for the next (sub-) timestep, i.e., for marking those agents to be deleted
-!-- after the timestep
-    deleted_agents = 0
-    agent_substep_time = 0.0_wp
-!
-!-- If necessary, release new set of agents
-    IF ( time_arel >= dt_arel  .AND.  end_time_arel > time_since_reference_point )  THEN
-
-       CALL mas_create_agent( phase_release )
-!
-!--    The MOD function allows for changes in the output interval with restart runs.
-       time_arel = MOD( time_arel, MAX( dt_arel, dt_3d ) )
-
-    ENDIF
-
-    first_loop_stride = .TRUE.
-    grid_agents(:,:)%time_loop_done = .TRUE.
-!
-!-- Set timestep variable
-    IF ( .NOT. agent_own_timestep ) dt_agent = dt_3d
-!
-!-- Timestep loop for agent transport.
-!-- This loop has to be repeated until the transport time of every agent (within the total domain!)
-!-- has reached the LES timestep (dt_3d).
-!-- Timestep scheme is Euler-forward.
-    DO
-!
-!--    Write agent data at current time on file.
-       time_write_agent_data = time_write_agent_data + dt_agent
-       agent_substep_time    = agent_substep_time    + dt_agent
-       IF ( time_write_agent_data >= dt_write_agent_data )  THEN
-#if defined( __netcdf )
-          IF ( first_loop_stride ) CALL mas_get_prognostic_quantities
-          CALL mas_data_output_agents ( first_call )
-#else
-          WRITE( message_string, * ) 'NetCDF is needed for agent output. ',                        &
-                                     'Set __netcdf in compiler options'
-          CALL message( 'multi_agent_system', 'PA0071', 1, 2, 0, 6, 0 )
-#endif
-          IF(first_call) first_call = .FALSE.
-          time_write_agent_data = time_write_agent_data - dt_write_agent_data
-       ENDIF
-!
-!--    Flag is true by default, will be set to false if an agent has not yet reached the model
-!--    timestep.
-       grid_agents(:,:)%time_loop_done = .TRUE.
-
-!
-!--    First part of agent transport:
-!--    Evaluate social forces for all agents at current positions
-       CALL cpu_log( log_point_s(9), 'mas_social_forces', 'start' )
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-
-             number_of_agents = agt_count(j,i)
-!
-!--          If grid cell is empty, cycle
-             IF ( number_of_agents <= 0 ) CYCLE
-
-             agents => grid_agents(j,i)%agents(1:number_of_agents)
-!
-!--          Evaluation of social forces
-             CALL mas_timestep_forces_call(i,j)
-
-          ENDDO
-       ENDDO
-       CALL cpu_log( log_point_s(9), 'mas_social_forces', 'stop' )
-!
-!--    Second part of agent transport:
-!--    timestep
-       CALL cpu_log( log_point_s(16), 'mas_timestep', 'start' )
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-
-             number_of_agents = agt_count(j,i)
-!
-!--          If grid cell is empty, flag must be true
-             IF ( number_of_agents <= 0 )  THEN
-                grid_agents(j,i)%time_loop_done = .TRUE.
-                CYCLE
-             ENDIF
-
-             agents => grid_agents(j,i)%agents(1:number_of_agents)
-
-             agents(1:number_of_agents)%agent_mask = .TRUE.
-!
-!--          Initialize the variable storing the total time that an agent has advanced within the
-!--          timestep procedure.
-             IF ( first_loop_stride )  THEN
-                agents(1:number_of_agents)%dt_sum = 0.0_wp
-             ENDIF
-!
-!--          Initialize the switch used for the loop exit condition checked at the end of this loop.
-!--          If at least one agent has failed to reach the LES timestep, this switch will be set
-!--          false in mas_transport.
-             dt_3d_reached_l_mas = .TRUE.
-!
-!--          Timestep
-             CALL mas_timestep
-!
-!--          Delete agents that have been simulated longer than allowed.
-             CALL mas_boundary_conds( 'max_sim_time' )
-!
-!--          Delete agents that have reached target area.
-             CALL mas_boundary_conds( 'target_area' )
-!
-!--          If not all agents of the actual grid cell have reached the LES timestep, this cell has
-!--          to do another loop iteration. Due to the fact that agents can move into neighboring
-!--          grid cell, these neighbor cells also have to perform another loop iteration.
-             IF ( .NOT. dt_3d_reached_l_mas )  THEN
-                js = MAX(nys,j-1)
-                je = MIN(nyn,j+1)
-                is = MAX(nxl,i-1)
-                ie = MIN(nxr,i+1)
-                grid_agents(js:je,is:ie)%time_loop_done = .FALSE.
-             ENDIF
-
-          ENDDO
-       ENDDO
-       CALL cpu_log( log_point_s(16), 'mas_timestep', 'stop' )
-
-!
-!--    Find out, if all agents on each PE have completed the LES timestep and set the switch
-!--    corespondingly.
-       dt_3d_reached_l_mas = ALL(grid_agents(:,:)%time_loop_done)
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( dt_3d_reached_l_mas, dt_3d_reached_mas, 1, MPI_LOGICAL,  MPI_LAND,      &
-                           comm2d, ierr )
-#else
-       dt_3d_reached_mas = dt_3d_reached_l_mas
-#endif
-
-!
-!--    Increment time since last release
-       IF ( dt_3d_reached_mas )  time_arel = time_arel + dt_3d
-
-!
-!--    Move Agents local to PE to a different grid cell
-       CALL cpu_log( log_point_s(18), 'mas_move_exch_sort', 'start' )
-       CALL mas_eh_move_agent
-!
-!--    Horizontal boundary conditions including exchange between subdmains
-       CALL mas_eh_exchange_horiz
-!
-!--    Pack agents (eliminate those marked for deletion), determine new number of agents
-       CALL mas_ps_sort_in_subboxes
-       CALL cpu_log( log_point_s(18), 'mas_move_exch_sort', 'stop' )
-!
-!--    Initialize variables for the next (sub-) timestep, i.e., for marking those agents to be
-!--    deleted after the timestep
-       deleted_agents = 0
-
-       IF ( biometeorology )  THEN
-!
-!--       Fill out the MRT 2D grid from appropriate source (RTM, RRTMG,...)
-          CALL bio_calculate_mrt_grid ( .FALSE. )
-!
-!--       Call of human thermal comfort mod (and UV exposure)
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-
-                number_of_agents = agt_count(j,i)
-!
-!--             If grid cell gets empty, cycle
-                IF ( number_of_agents <= 0 )  CYCLE
-
-                agents => grid_agents(j,i)%agents(1:number_of_agents)
-!
-!--             Evaluation of social forces
-!                CALL bio_dynamic( i, j )
-!
-!--             Determine local meteorological conditions
-                CALL bio_get_thermal_index_input_ij ( .FALSE., i, j, ta, vp, v, pair, tmrt )
-
-                DO  a = 1, number_of_agents
-!
-!--                Calculate instationary thermal indices based on local tmrt
-
-                   CALL bio_calc_ipt ( ta, vp, v, pair, tmrt,                                      &
-                                       agents(a)%dt_sum,                                           &
-                                       agents(a)%energy_storage,                                   &
-                                       agents(a)%clothing_temp,                                    &
-                                       agents(a)%clo,                                              &
-                                       agents(a)%actlev,                                           &
-                                       agents(a)%age_years,                                        &
-                                       agents(a)%weight,                                           &
-                                       agents(a)%height,                                           &
-                                       agents(a)%work,                                             &
-                                       agents(a)%sex,                                              &
-                                       agents(a)%ipt )
-                END DO
-
-             ENDDO
-          ENDDO
-       ENDIF
-
-       IF ( dt_3d_reached_mas )  EXIT
-
-       first_loop_stride = .FALSE.
-    ENDDO   ! timestep loop
-
-!
-!-- Deallocate unused memory
-    IF ( deallocate_memory_mas  .AND.  mas_count == step_dealloc_mas )  THEN
-       CALL mas_eh_dealloc_agents_array
-       mas_count = 0
-    ELSEIF ( deallocate_memory_mas )  THEN
-       mas_count = mas_count + 1
-    ENDIF
-
-    CALL cpu_log( log_point(9), 'mas', 'stop' )
-
-    IF ( debug_output_timestep )  CALL debug_message( 'multi_agent_system', 'end' )
-
-
- END SUBROUTINE multi_agent_system
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of the direction vector from each agent to its current intermittent target.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_agent_direction
-
-    IMPLICIT NONE
-
-    LOGICAL ::  path_flag  !< true if new path must be calculated
-
-    INTEGER(iwp) ::  n   !< loop variable over all agents in a grid box
-    INTEGER(iwp) ::  pc  !< agent path counter
-
-    REAL(wp) ::  abs_dir         !< length of direction vector (for normalization)
-!    REAL(wp) ::  d_curr_target   !< rounding influence expressed as x speed component
-!    REAL(wp) ::  d_prev_target   !< rounding influence expressed as x speed component
-    REAL(wp) ::  dir_x           !< direction of agent (x)
-    REAL(wp) ::  dir_y           !< direction of agent (y)
-!    REAL(wp) ::  dist_round = 3. !< distance at which agents start rounding a corner
-    REAL(wp) ::  dtit            !< distance to intermittent target
-!    REAL(wp) ::  round_fac  = 0.2 !< factor for rounding influence
-!    REAL(wp) ::  speed_round_x   !< rounding influence expressed as x speed component
-!    REAL(wp) ::  speed_round_y   !< rounding influence expressed as x speed component
-
-!
-!-- Loop over all agents in the current grid box
-    DO  n = 1, number_of_agents
-       path_flag = .FALSE.
-       pc = agents(n)%path_counter
-!
-!--    If no path was calculated for agent yet, do it.
-       IF ( pc >= 999 )  THEN
-          CALL mas_nav_find_path(n)
-          pc = agents(n)%path_counter
-!
-!--    Check if new path must be calculated and if so, do it.
-       ELSE
-!
-!--       Case one: Agent has come close enough to intermittent target.
-!--                 -> chose new int target and calculate rest of path if no
-!--                    new intermittent targets are left
-          dtit = SQRT(   ( agents(n)%x - agents(n)%path_x(pc) )**2                                 &
-                       + ( agents(n)%y - agents(n)%path_y(pc) )**2 )
-          IF ( dtit < dist_to_int_target )  THEN
-             agents(n)%path_counter = agents(n)%path_counter + 1
-             pc = agents(n)%path_counter
-!
-!--          Path counter out of scope (each agent can store a maximum of 15 intermittent targets on
-!--          the way to its final target); new path must be calculated.
-             IF ( pc >= SIZE( agents(n)%path_x) )  THEN
-                path_flag = .TRUE.
-             ENDIF
-!
-!--          Case two: Agent too far from path
-!--                    -> set flag for new path to be calculated
-          ELSEIF ( dist_point_to_edge(agents(n)%path_x(pc-1),                                      &
-                                      agents(n)%path_y(pc-1),                                      &
-                                      agents(n)%path_x(pc),                                        &
-                                      agents(n)%path_y(pc),                                        &
-                                      agents(n)%x, agents(n)%y)                                    &
-                   > max_dist_from_path )                                                          &
-          THEN
-             path_flag = .TRUE.
-          ENDIF
-!
-!--       If one of the above two cases was true, calculate new path and reset 0th path point.
-!--       This point (the last target the agent had) is needed for the agent's rounding of corners
-!--       and the calculation of its deviation from its current path.
-          IF ( path_flag )  THEN
-             CALL mas_nav_find_path(n)
-             pc = agents(n)%path_counter
-          ENDIF
-       ENDIF
-!
-!--    Normalize direction vector
-       abs_dir             = 1.0d-12
-       dir_x               = agents(n)%path_x(pc) - agents(n)%x
-       dir_y               = agents(n)%path_y(pc) - agents(n)%y
-       abs_dir             = SQRT( dir_x**2 + dir_y**2 )+1.0d-12
-!--      needed later for corner rounding
-!        dir_x               = dir_x/abs_dir
-!        dir_y               = dir_y/abs_dir
-!        dir_x               = dir_x + speed_round_x
-!        dir_y               = dir_y + speed_round_y
-!        abs_dir             = SQRT(dir_x**2 + dir_y**2)+1.0d-12
-       agents(n)%speed_e_x = dir_x/abs_dir
-       agents(n)%speed_e_y = dir_y/abs_dir
-    ENDDO
-
-!
-!-- corner rounding; to be added
-!
-!--       Calculate direction change due to rounding of corners
-
-!           speed_round_x = 0.
-!           speed_round_y = 0.
-!
-!           d_curr_target = SQRT( (agents(n)%path_x(pc) - agents(n)%x)**2 +      &
-!                                 (agents(n)%path_y(pc) - agents(n)%y)**2 )
-!           d_prev_target = SQRT( (agents(n)%path_x(pc-1) - agents(n)%x)**2 +    &
-!                                 (agents(n)%path_y(pc-1) - agents(n)%y)**2 )
-! !
-! !--       Agent is close to next target and that target is not the final one
-!           IF ( d_curr_target < dist_round .AND. dist_round <                   &
-!                           SQRT( (agents(n)%path_x(pc) - agents(n)%t_x)**2 +    &
-!                                 (agents(n)%path_y(pc) - agents(n)%t_y)**2 ) )  &
-!           THEN
-!              speed_round_x = (agents(n)%path_x(pc+1) - agents(n)%path_x(pc)) / &
-!                              ABS( agents(n)%path_x(pc)                         &
-!                                 - agents(n)%path_x(pc+1)) * round_fac *        &
-!                              SIN( pi/dist_round*d_curr_target )
-!              speed_round_y = (agents(n)%path_y(pc+1) - agents(n)%path_y(pc)) / &
-!                              ABS( agents(n)%path_y(pc)                         &
-!                                 - agents(n)%path_y(pc+1)) * round_fac *        &
-!                              SIN( pi/dist_round*d_curr_target )
-!           ENDIF
-!
-!           IF ( d_prev_target < dist_round )  THEN
-!              IF ( agents(n)%path_x(pc) /= agents(n)%path_x(pc+1) )  THEN
-!                 speed_round_x = speed_round_x +                                   &
-!                                 (agents(n)%path_x(pc) - agents(n)%path_x(pc+1)) / &
-!                                 ABS( agents(n)%path_x(pc)                         &
-!                                    - agents(n)%path_x(pc+1)) * round_fac *        &
-!                                 SIN( pi/dist_round*d_prev_target )
-!              ENDIF
-!
-!              IF ( agents(n)%path_y(pc) /= agents(n)%path_y(pc+1) )  THEN
-!                 speed_round_y = speed_round_y +                                   &
-!                              (agents(n)%path_y(pc) - agents(n)%path_y(pc+1)) / &
-!                              ABS( agents(n)%path_y(pc)                         &
-!                                 - agents(n)%path_y(pc+1)) * round_fac *        &
-!                              SIN( pi/dist_round*d_prev_target )
-!              ENDIF
-
-!           ENDIF
-
-
- END SUBROUTINE mas_agent_direction
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Boundary conditions for maximum time, target reached and out of domain
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_boundary_conds( location )
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  location  !< Identifier
-
-    INTEGER(iwp) ::  grp  !< agent group
-    INTEGER(iwp) ::  n    !< agent number
-
-    REAL(wp) ::  dist_to_target !< distance to target
-
-    IF ( location == 'max_sim_time' )  THEN
-
-!
-!--    Delete agents that have been simulated longer than allowed
-       DO  n = 1, number_of_agents
-
-          IF ( agents(n)%age > agent_maximum_age  .AND.  agents(n)%agent_mask )  THEN
-             agents(n)%agent_mask  = .FALSE.
-             deleted_agents = deleted_agents + 1
-          ENDIF
-
-       ENDDO
-    ENDIF
-
-    IF ( location == 'target_area' )  THEN
-
-!
-!--    Delete agents that entered target region
-       DO  n = 1, number_of_agents
-          grp = agents(n)%group
-          dist_to_target = SQRT( ( agents(n)%x - at_x(grp) )**2 + ( agents(n)%y - at_y(grp) )**2 )
-          IF ( dist_to_target < dist_target_reached )  THEN
-             agents(n)%agent_mask  = .FALSE.
-             deleted_agents = deleted_agents + 1
-          ENDIF
-
-       ENDDO
-    ENDIF
-
- END SUBROUTINE mas_boundary_conds
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Release new agents at their respective sources
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_create_agent ( phase )
-
-    IMPLICIT  NONE
-
-    INTEGER(iwp) ::  alloc_size  !< relative increase of allocated memory for agents
-    INTEGER(iwp) ::  i           !< loop variable ( agent groups )
-    INTEGER(iwp) ::  ip          !< index variable along x
-    INTEGER(iwp) ::  jp          !< index variable along y
-    INTEGER(iwp) ::  loop_stride !< loop variable for initialization
-    INTEGER(iwp) ::  n           !< loop variable ( number of agents )
-    INTEGER(iwp) ::  new_size    !< new size of allocated memory for agents
-    INTEGER(iwp) ::  rn_side     !< index of agent path
-
-    INTEGER(iwp), INTENT(IN) ::  phase       !< mode of inititialization
-
-    INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  local_count !< start address of new agent
-    INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  local_start !< start address of new agent
-
-    LOGICAL ::  first_stride !< flag for initialization
-
-    REAL(wp) ::  pos_x       !< increment for agent position in x
-    REAL(wp) ::  pos_y       !< increment for agent position in y
-    REAL(wp) ::  rand_contr  !< dummy argument for random position
-    REAL(wp) ::  rn_side_dum !< index of agent path
-
-    TYPE(agent_type),TARGET ::  tmp_agent !< temporary agent used for initialization
-
-!
-!-- Calculate agent positions and store agent attributes, if agent 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 agents
-       ELSE
-          local_count = agt_count   ! Start address of new agents
-       ENDIF
-
-       DO  i = 1, number_of_agent_groups
-
-          pos_y = ass(i)
-
-          DO WHILE ( pos_y <= asn(i) )
-
-             IF ( pos_y >= nys * dy  .AND.  pos_y <  ( nyn + 1 ) * dy  )  THEN
-
-                pos_x = asl(i)
-
-         xloop: DO WHILE ( pos_x <= asr(i) )
-
-                   IF ( pos_x >= nxl * dx  .AND.  pos_x <  ( nxr + 1) * dx )  THEN
-
-                      tmp_agent%agent_mask = .TRUE.
-                      tmp_agent%group         = i
-                      tmp_agent%id            = 0_idp
-                      tmp_agent%block_nr      = -1
-                      tmp_agent%path_counter  = 999 !SIZE(tmp_agent%path_x)
-                      tmp_agent%age           = 0.0_wp
-                      tmp_agent%age_m         = 0.0_wp
-                      tmp_agent%dt_sum        = 0.0_wp
-                      tmp_agent%clo           = -999.0_wp
-                      tmp_agent%energy_storage= 0.0_wp
-                      tmp_agent%ipt           = 99999.0_wp
-                      tmp_agent%clothing_temp = -999._wp      !< energy stored by agent (W)
-                      tmp_agent%actlev        = 134.6862_wp   !< metabolic + work energy of the person
-                      tmp_agent%age_years     = 35._wp        !< physical age of the person
-                      tmp_agent%weight        = 75._wp        !< total weight of the person (kg)
-                      tmp_agent%height        = 1.75_wp       !< height of the person (m)
-                      tmp_agent%work          = 134.6862_wp   !< workload of the agent (W)
-                      tmp_agent%sex           = 1             !< agents gender: 1 = male, 2 = female
-                      tmp_agent%force_x       = 0.0_wp
-                      tmp_agent%force_y       = 0.0_wp
-                      tmp_agent%origin_x      = pos_x
-                      tmp_agent%origin_y      = pos_y
-                      tmp_agent%speed_abs     = 0.0_wp
-                      tmp_agent%speed_e_x     = 0.0_wp
-                      tmp_agent%speed_e_y     = 0.0_wp
-                      tmp_agent%speed_des     = random_normal(desired_speed,des_sp_sig)
-                      tmp_agent%speed_x       = 0.0_wp
-                      tmp_agent%speed_y       = 0.0_wp
-                      tmp_agent%x             = pos_x
-                      tmp_agent%y             = pos_y
-                      tmp_agent%path_x        = -1.0_wp
-                      tmp_agent%path_y        = -1.0_wp
-                      tmp_agent%t_x           = - pi
-                      tmp_agent%t_y           = - pi
-!
-!--                   Determine the grid indices of the agent position
-                      ip = tmp_agent%x * ddx
-                      jp = tmp_agent%y * ddy
-!
-!--                   Give each agent its target
-                      IF ( a_rand_target(i) )  THEN
-!
-!--                      Agent shall receive random target just outside simulated area
-                         rn_side_dum = random_function(iran_agent)
-                         rn_side     = FLOOR( 4.*rn_side_dum )
-                         IF ( rn_side < 2 )  THEN
-                            IF ( rn_side == 0 )  THEN
-                               tmp_agent%t_y = -2 * dy
-                            ELSE
-                               tmp_agent%t_y = ( ny + 3 ) * dy
-                            ENDIF
-                            tmp_agent%t_x = random_function(iran_agent) * ( nx + 1 ) * dx
-                         ELSE
-                            IF ( rn_side == 2 )  THEN
-                               tmp_agent%t_x = -2 * dx
-                            ELSE
-                               tmp_agent%t_x = ( nx + 3 ) * dx
-                            ENDIF
-                            tmp_agent%t_y = random_function(iran_agent) * ( ny + 1 ) * dy
-                         ENDIF
-!
-!--                   Agent gets target of her group
-                      ELSE
-                         tmp_agent%t_x = at_x(i)
-                         tmp_agent%t_y = at_y(i)
-                      ENDIF
-
-                      local_count(jp,ip) = local_count(jp,ip) + 1
-
-                      IF ( .NOT. first_stride )  THEN
-                         grid_agents(jp,ip)%agents(local_count(jp,ip)) = tmp_agent
-                      ENDIF
-
-                   ENDIF
-
-                   pos_x = pos_x + adx(i)
-
-                ENDDO xloop
-
-             ENDIF
-
-             pos_y = pos_y + ady(i)
-
-          ENDDO
-
-       ENDDO
-
-!
-!--    Allocate or reallocate agents array to new size
-       IF ( first_stride )  THEN
-          DO  ip = nxlg, nxrg
-             DO  jp = nysg, nyng
-                IF ( phase == phase_init )  THEN
-                   IF ( local_count(jp,ip) > 0 )  THEN
-                      alloc_size = MAX( INT( local_count(jp,ip) *                                  &
-                                             ( 1.0_wp + alloc_factor_mas / 100.0_wp ) ),           &
-                                        min_nr_agent )
-                   ELSE
-                      alloc_size = min_nr_agent
-                   ENDIF
-                   ALLOCATE( grid_agents(jp,ip)%agents(1:alloc_size) )
-                   DO  n = 1, alloc_size
-                      grid_agents(jp,ip)%agents(n) = zero_agent
-                   ENDDO
-                ELSEIF ( phase == phase_release )  THEN
-                   IF ( local_count(jp,ip) > 0 )  THEN
-                      new_size   = local_count(jp,ip) + agt_count(jp,ip)
-                      alloc_size = MAX( INT( new_size *                                            &
-                                             ( 1.0_wp + alloc_factor_mas / 100.0_wp ) ),           &
-                                        min_nr_agent )
-                      IF( alloc_size > SIZE( grid_agents(jp,ip)%agents) )  THEN
-                         CALL mas_eh_realloc_agents_array(ip,jp,alloc_size)
-                      ENDIF
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDIF
-
-    ENDDO
-
-    local_start = agt_count+1
-    agt_count   = local_count
-
-!
-!-- Calculate agent IDs
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          number_of_agents = agt_count(jp,ip)
-          IF ( number_of_agents <= 0 )  CYCLE
-          agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-
-          DO  n = local_start(jp,ip), number_of_agents  !only new agents
-
-             agents(n)%id = 10000_idp**2 * grid_agents(jp,ip)%id_counter + 10000_idp * jp + ip
-!
-!--          Count the number of agents that have been released before
-             grid_agents(jp,ip)%id_counter = grid_agents(jp,ip)%id_counter + 1
-
-          ENDDO
-
-       ENDDO
-    ENDDO
-
-!
-!-- Add random fluctuation to agent positions.
-    IF ( random_start_position_agents )  THEN
-       DO  ip = nxl, nxr
-          DO  jp = nys, nyn
-             number_of_agents = agt_count(jp,ip)
-             IF ( number_of_agents <= 0 )  CYCLE
-             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-!
-!--          Move only new agents. Moreover, limit random fluctuation in order to prevent that
-!--          agents move more than one grid box, which would lead to problems concerning agent
-!--          exchange  between processors in case adx/ady are larger than dx/dy, respectively.
-             DO  n = local_start(jp,ip), number_of_agents
-                IF ( asl(agents(n)%group) /= asr(agents(n)%group) )  THEN
-                   rand_contr = ( random_function( iran_agent ) - 0.5_wp ) * adx(agents(n)%group)
-                   agents(n)%x = agents(n)%x + MERGE( rand_contr, SIGN( dx, rand_contr ),          &
-                                                      ABS( rand_contr ) < dx                       &
-                                                    )
-                ENDIF
-                IF ( ass(agents(n)%group) /= asn(agents(n)%group) )  THEN
-                   rand_contr = ( random_function( iran_agent ) - 0.5_wp ) * ady(agents(n)%group)
-                   agents(n)%y = agents(n)%y +                                                     &
-                                 MERGE( rand_contr, SIGN( dy, rand_contr ), ABS( rand_contr ) < dy )
-                ENDIF
-             ENDDO
-!
-!--          Delete agents that have been simulated longer than allowed
-             CALL mas_boundary_conds( 'max_sim_time' )
-!
-!--          Delete agents that have reached target area
-             CALL mas_boundary_conds( 'target_area' )
-
-          ENDDO
-       ENDDO
-!
-!--    Exchange agents between grid cells and processors
-       CALL mas_eh_move_agent
-       CALL mas_eh_exchange_horiz
-
-    ENDIF
-!
-!-- In case of random_start_position_agents, delete agents identified by mas_eh_exchange_horiz and
-!-- mas_boundary_conds. Then sort agents into blocks, which is needed for a fast interpolation of
-!-- the LES fields on the agent position.
-    CALL mas_ps_sort_in_subboxes
-
-!
-!-- Determine the current number of agents
-    number_of_agents = 0
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          number_of_agents = number_of_agents + agt_count(jp,ip)
-       ENDDO
-    ENDDO
-!
-!-- Calculate the number of agents of the total domain
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( number_of_agents, total_number_of_agents, 1, MPI_INTEGER, MPI_SUM, comm2d, &
-                        ierr )
-#else
-    total_number_of_agents = number_of_agents
-#endif
-
-    RETURN
-
- END SUBROUTINE mas_create_agent
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Creates flags that indicate if a gridbox contains edges or corners. These flags are used for
-!> agents to check if obstacles are close to them.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_create_obstacle_flags
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zw
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  il
-    INTEGER(iwp) ::  jl
-
-    ALLOCATE( obstacle_flags(nysg:nyng,nxlg:nxrg) )
-
-    obstacle_flags = 0
-
-    DO  il = nxlg, nxrg
-       DO  jl = nysg, nyng
-!
-!--       Exclude cyclic topography boundary
-          IF ( il < 0 .OR. il > nx .OR. jl < 0 .OR. jl > ny ) CYCLE
-!
-!--       North edge
-          IF ( jl < nyng )  THEN
-             IF ( ( top_top_s(jl,il) - top_top_s(jl+1,il) ) > 1  .AND.                             &
-                  ( zw( top_top_w(jl,il) ) - zw( top_top_w(jl+1,il) ) ) > 0.51_wp )                &
-             THEN
-                obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 0 )
-             ENDIF
-          ENDIF
-!
-!--       North right corner
-          IF ( jl < nyng  .AND.  il < nxrg )  THEN
-             IF ( ( top_top_s(jl,il) - top_top_s(jl+1,il)   ) > 1  .AND.                           &
-                  ( top_top_s(jl,il) - top_top_s(jl+1,il+1) ) > 1  .AND.                           &
-                  ( top_top_s(jl,il) - top_top_s(jl,il+1)   ) > 1  .AND.                           &
-                  ( zw( top_top_w(jl,il) ) - zw( top_top_w(jl+1,il+1) ) ) > 0.51_wp )              &
-             THEN
-                obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 1 )
-             ENDIF
-          ENDIF
-!
-!--       Right edge
-          IF ( il < nxrg )  THEN
-             IF ( ( top_top_s(jl,il) - top_top_s(jl,il+1) ) > 1  .AND.                             &
-                  ( zw( top_top_w(jl,il) ) - zw( top_top_w(jl,il+1) ) ) > 0.51_wp )                &
-             THEN
-                obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 2 )
-             ENDIF
-          ENDIF
-!
-!--       South right corner
-          IF ( jl > nysg  .AND.  il < nxrg )  THEN
-             IF ( ( top_top_s(jl,il) - top_top_s(jl,il+1)   ) > 1  .AND.                           &
-                  ( top_top_s(jl,il) - top_top_s(jl-1,il+1) ) > 1  .AND.                           &
-                  ( top_top_s(jl,il) - top_top_s(jl-1,il)   ) > 1  .AND.                           &
-                  ( zw(top_top_w(jl,il) ) - zw( top_top_w(jl-1,il+1) ) ) > 0.51_wp )               &
-             THEN
-                obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 3 )
-             ENDIF
-          ENDIF
-!
-!--       South edge
-          IF ( jl > nysg )  THEN
-             IF ( ( top_top_s(jl,il) - top_top_s(jl-1,il) ) > 1  .AND.                             &
-                  ( zw( top_top_w(jl,il) ) - zw( top_top_w(jl-1,il) ) ) > 0.51_wp )                &
-             THEN
-                obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 4 )
-             ENDIF
-          ENDIF
-!
-!--       South left corner
-          IF ( jl > nysg  .AND.  il > nxlg )  THEN
-             IF ( ( top_top_s(jl,il) - top_top_s(jl-1,il)   ) > 1  .AND.                           &
-                  ( top_top_s(jl,il) - top_top_s(jl-1,il-1) ) > 1  .AND.                           &
-                  ( top_top_s(jl,il) - top_top_s(jl,il-1)   ) > 1  .AND.                           &
-                  ( zw( top_top_w(jl,il) ) - zw(top_top_w(jl-1,il-1) ) ) > 0.51_wp )               &
-             THEN
-                obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 5 )
-             ENDIF
-          ENDIF
-!
-!--       Left edge
-          IF ( il > nxlg )  THEN
-             IF ( ( top_top_s(jl,il) - top_top_s(jl,il-1) ) > 1  .AND.                             &
-                  ( zw(top_top_w(jl,il) ) - zw(top_top_w(jl,il-1) ) ) > 0.51_wp )                  &
-             THEN
-                obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 6 )
-             ENDIF
-          ENDIF
-!
-!--       North left corner
-          IF ( jl < nyng  .AND.  il > nxlg )  THEN
-             IF ( ( top_top_s(jl,il) - top_top_s(jl,il-1)   ) > 1  .AND.                           &
-                  ( top_top_s(jl,il) - top_top_s(jl+1,il-1) ) > 1  .AND.                           &
-                  ( top_top_s(jl,il) - top_top_s(jl+1,il)   ) > 1  .AND.                           &
-                  ( zw( top_top_w(jl,il) ) - zw( top_top_w(jl+1,il-1) ) ) > 0.51_wp )              &
-             THEN
-                obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 7 )
-             ENDIF
-          ENDIF
-
-       ENDDO
-    ENDDO
-
- END SUBROUTINE mas_create_obstacle_flags
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write agent data in netCDF format
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_data_output_agents( ftest )
-
-    USE control_parameters,                                                                        &
-        ONLY:  agt_time_count, biometeorology, end_time, message_string, multi_agent_system_end,   &
-               multi_agent_system_start
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  nc_stat, id_set_agt, id_var_time_agt, id_var_agt, netcdf_handle_error
-
-    USE pegrid
-
-#if defined( __netcdf )
-    USE NETCDF
-#endif
-    USE mas_global_attributes,                                                                     &
-        ONLY:  dim_size_agtnum
-
-    IMPLICIT NONE
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  agt_size !< Agent size in bytes
-    INTEGER(iwp) ::  n        !< counter (number of PEs)
-    INTEGER(iwp) ::  noa_rcv  !< received number of agents
-#endif
-    INTEGER(iwp) ::  dummy    !< dummy
-    INTEGER(iwp) ::  ii       !< counter (x)
-    INTEGER(iwp) ::  ip       !< counter (x)
-    INTEGER(iwp) ::  jp       !< counter (y)
-    INTEGER(iwp) ::  noa      !< number of agents
-    INTEGER(iwp) ::  out_noa  !< number of agents for output
-
-#if defined( __parallel )
-    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  noa_arr !< number of agents on each PE
-#endif
-!
-!-- SAVE attribute required to avoid compiler warning about pointer outlive the pointer target
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE, TARGET, SAVE ::  trf_agents !< all agents on current PE
-#if defined( __parallel )
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE, TARGET, SAVE ::  out_agents !< all agents in entire domain
-#endif
-
-    LOGICAL, INTENT (INOUT) :: ftest
-
-    LOGICAL, SAVE :: agt_dimension_exceeded = .FALSE.
-
-
-    CALL cpu_log( log_point_s(17), 'mas_data_output', 'start' )
-!
-!-- Get total number of agents and put all agents on one PE in one array
-    noa = 0
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          noa  = noa  + agt_count(jp,ip)
-       ENDDO
-    ENDDO
-    IF ( noa > 0 )  THEN
-       ALLOCATE( trf_agents(1:noa) )
-       dummy = 1
-       DO  ip = nxl, nxr
-          DO  jp = nys, nyn
-             IF ( agt_count(jp,ip) == 0 )  CYCLE
-             agents => grid_agents(jp,ip)%agents(1:agt_count(jp,ip))
-             trf_agents(dummy:(dummy-1+agt_count(jp,ip))) = agents
-             dummy = dummy + agt_count(jp,ip)
-          ENDDO
-       ENDDO
-    ENDIF
-#if defined( __parallel )
-!
-!-- Gather all agents on PE0 for output
-    IF ( myid == 0 )  THEN
-       noa_arr(0) = noa
-!
-!--    Receive data from all other PEs.
-       DO  n = 1, numprocs-1
-           CALL MPI_RECV( noa_arr(n), 1, MPI_INTEGER, n, 0, comm2d, status, ierr )
-       ENDDO
-    ELSE
-       CALL MPI_SEND( noa, 1, MPI_INTEGER, 0, 0, comm2d, ierr )
-    ENDIF
-    CALL MPI_BARRIER( comm2d, ierr )
-    agt_size = STORAGE_SIZE( zero_agent ) / 8
-    IF ( myid == 0 )  THEN
-!
-!--    Receive data from all other PEs.
-       out_noa = SUM( noa_arr )
-       IF ( out_noa > 0 )  THEN
-          ALLOCATE( out_agents(1:out_noa) )
-          IF ( noa > 0 )  THEN
-             out_agents(1:noa) = trf_agents
-          ENDIF
-          noa_rcv = noa
-          DO  n = 1, numprocs-1
-             IF ( noa_arr(n) > 0 )  THEN
-                CALL MPI_RECV( out_agents(noa_rcv+1), noa_arr(n) * agt_size, MPI_BYTE, n, 0,       &
-                               comm2d, status, ierr )
-                noa_rcv = noa_rcv + noa_arr(n)
-             ENDIF
-          ENDDO
-       ELSE
-          ALLOCATE( out_agents(1:2) )
-          out_agents = zero_agent
-          out_noa    = 2
-       ENDIF
-    ELSE
-       IF ( noa > 0 )  THEN
-          CALL MPI_SEND( trf_agents(1), noa*agt_size, MPI_BYTE, 0, 0, comm2d, ierr )
-       ENDIF
-    ENDIF
-!
-!-- A barrier has to be set, because otherwise some PEs may proceed too fast so that PE0 may receive
-!-- wrong data on tag 0.
-    CALL MPI_BARRIER( comm2d, ierr )
-#endif
-    IF ( myid == 0 )  THEN
-#if defined( __parallel )
-       agents => out_agents
-#else
-       agents => trf_agents
-#endif
-
-#if defined( __netcdf )
-!
-!--    Update maximum number of agents
-       maximum_number_of_agents = MAX(maximum_number_of_agents, out_noa)
-!
-!--       Output in netCDF format
-       IF ( ftest )  THEN
-!
-!--          First, define size of agent number dimension from amount of agents released, release
-!--          interval, time of agent simulation and max age of agents.
-          dim_size_agtnum = MIN( MIN( multi_agent_system_end, end_time )                           &
-                                    - multi_agent_system_start,                                    &
-                                 agent_maximum_age)
-
-          DO ii = 1, number_of_agent_groups
-             dim_size_agtnum = dim_size_agtnum                                                     &
-                                + ( FLOOR( ( asr(ii)-asl(ii) ) / adx(ii) ) + 1 )                   &
-                                * ( FLOOR( ( asn(ii)-ass(ii) ) / ady(ii) ) + 1 )                   &
-                                * ( FLOOR( dim_size_agtnum / dt_arel )     + 1 )                   &
-                                * dim_size_factor_agtnum
-             dim_size_agtnum = MIN( dim_size_agtnum, dim_size_agtnum_manual )
-          ENDDO
-          CALL check_open( 118 )
-       ENDIF
-
-!
-!--    Update the NetCDF time axis
-       agt_time_count = agt_time_count + 1
-
-       IF ( .NOT. agt_dimension_exceeded )  THEN
-!
-!--       If number of agents to be output exceeds dimension, set flag and print warning.
-          IF ( out_noa > dim_size_agtnum )  THEN
-
-             agt_dimension_exceeded = .TRUE.
-             WRITE( message_string, '(A,F11.1,2(A,I8))' )                                          &
-                                                  'Number of agents exceeds agent dimension.' //   &
-                                                  '&Starting at time_since_reference_point = ',    &
-                                                  time_since_reference_point,                      &
-                                                  ' s, &data may be missing.'//                    &
-                                                  '&Number of agents:     ', out_noa,              &
-                                                  '&Agent dimension size: ', dim_size_agtnum
-
-             CALL message( 'mas_data_output_agents', 'PA0420', 0, 1, 0, 6, 0 )
-
-          ENDIF
-       ENDIF
-
-!
-!--    Reduce number of output agents to dimension size, if necessary.
-       IF ( agt_dimension_exceeded )  THEN
-
-          out_noa = MIN( out_noa, dim_size_agtnum )
-
-       ENDIF
-
-       nc_stat = NF90_PUT_VAR( id_set_agt, id_var_time_agt,                                        &
-                               (/ time_since_reference_point + agent_substep_time /),              &
-                               start = (/ agt_time_count /),                                       &
-                               count = (/ 1 /) )
-       CALL netcdf_handle_error( 'mas_data_output_agents', 1 )
-
-!
-!--       Output agent attributes
-
-       nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(1), agents%id,                               &
-                               start = (/ 1, agt_time_count /),                                    &
-                               count = (/ out_noa /) )
-       CALL netcdf_handle_error( 'mas_data_output_agents', 2 )
-
-       nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(2), agents%x,                                &
-                               start = (/ 1, agt_time_count /),                                    &
-                               count = (/ out_noa /) )
-       CALL netcdf_handle_error( 'mas_data_output_agents', 3 )
-
-       nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(3), agents%y,                                &
-                               start = (/ 1, agt_time_count /),                                    &
-                               count = (/ out_noa /) )
-       CALL netcdf_handle_error( 'mas_data_output_agents', 4 )
-
-       nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(4), agents%windspeed,                        &
-                               start = (/ 1, agt_time_count /),                                    &
-                               count = (/ out_noa /) )
-       CALL netcdf_handle_error( 'mas_data_output_agents', 5 )
-
-       nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(5), agents%t,                                &
-                               start = (/ 1, agt_time_count /),                                    &
-                               count = (/ out_noa /) )
-       CALL netcdf_handle_error( 'mas_data_output_agents', 6 )
-
-       nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(6), agents%group,                            &
-                               start = (/ 1, agt_time_count /),                                    &
-                               count = (/ out_noa /) )
-       CALL netcdf_handle_error( 'mas_data_output_agents', 7 )
-
-
-       IF ( biometeorology )  THEN
-          nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(7), agents%ipt,                           &
-                                  start = (/ 1, agt_time_count /),                                 &
-                                  count = (/ out_noa /) )
-          CALL netcdf_handle_error( 'mas_data_output_agents', 8 )
-       ENDIF
-
-
-
-!           nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(8), agents%pm10,                         &
-!                                   start = (/ 1, agt_time_count /),                                &
-!                                   count = (/ out_noa /) )
-!           CALL netcdf_handle_error( 'mas_data_output_agents', 9 )
-!
-!           nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(9), agents%pm25,                         &
-!                                   start = (/ 1, agt_time_count /),                                &
-!                                   count = (/ out_noa /) )
-!           CALL netcdf_handle_error( 'mas_data_output_agents', 10 )
-!
-!
-!           nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(9), agents%uv,                           &
-!                                   start = (/ 1, agt_time_count /),                                &
-!                                   count = (/ out_noa /) )
-!           CALL netcdf_handle_error( 'mas_data_output_agents', 10 )
-
-       CALL cpu_log( log_point_s(17), 'mas_data_output', 'stop' )
-
-
-#endif
-
-#if defined( __parallel )
-       IF ( ALLOCATED( out_agents ) ) DEALLOCATE( out_agents )
-#endif
-    ELSE
-       CALL cpu_log( log_point_s(17), 'mas_data_output', 'stop' )
-    ENDIF
-
-    IF ( ALLOCATED( trf_agents ) ) DEALLOCATE( trf_agents )
-
- END SUBROUTINE mas_data_output_agents
-
-#if defined( __parallel )
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> If an agent moves from one processor to another, this subroutine moves the corresponding elements
-!> from the agent arrays of the old grid cells to the agent arrays of the new grid cells.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_eh_add_agents_to_gridcell (agent_array)
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  aindex  !< dummy argument for new number of agents per grid box
-    INTEGER(iwp) ::  ip      !< grid index (x) of agent
-    INTEGER(iwp) ::  jp      !< grid index (x) of agent
-    INTEGER(iwp) ::  n       !< index variable of agent
-
-    LOGICAL ::  pack_done  !< flag to indicate that packing is done
-
-    TYPE(agent_type), DIMENSION(:), INTENT(IN)  ::  agent_array  !< new agents in a grid box
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  temp_ns      !< temporary agent array for reallocation
-
-    pack_done     = .FALSE.
-
-    DO  n = 1, SIZE(agent_array)
-
-       IF ( .NOT. agent_array(n)%agent_mask )  CYCLE
-
-       ip = agent_array(n)%x * ddx
-       jp = agent_array(n)%y * ddy
-
-       IF ( ip >= nxl  .AND.  ip <= nxr  .AND.  jp >= nys  .AND.  jp <= nyn )  THEN ! agent stays on processor
-          number_of_agents = agt_count(jp,ip)
-          agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-
-          aindex = agt_count(jp,ip)+1
-          IF( aindex > SIZE( grid_agents(jp,ip)%agents ) )  THEN
-             IF ( pack_done )  THEN
-                CALL mas_eh_realloc_agents_array (ip,jp)
-             ELSE
-                CALL mas_ps_pack
-                agt_count(jp,ip) = number_of_agents
-                aindex = agt_count(jp,ip)+1
-                IF ( aindex > SIZE( grid_agents(jp,ip)%agents ) )  THEN
-                   CALL mas_eh_realloc_agents_array (ip,jp)
-                ENDIF
-                pack_done = .TRUE.
-             ENDIF
-          ENDIF
-          grid_agents(jp,ip)%agents(aindex) = agent_array(n)
-          agt_count(jp,ip) = aindex
-       ELSE
-          IF ( jp <= nys - 1 )  THEN
-             nr_move_south = nr_move_south+1
-!
-!--          Before agent information is swapped to exchange-array, check if enough memory is
-!--          allocated. If required, reallocate exchange array.
-             IF ( nr_move_south > SIZE( move_also_south ) )  THEN
-!
-!--             At first, allocate further temporary array to swap agent information.
-                ALLOCATE( temp_ns( SIZE( move_also_south ) + nr_2_direction_move ) )
-                temp_ns(1:nr_move_south-1) = move_also_south(1:nr_move_south-1)
-                DEALLOCATE( move_also_south )
-                ALLOCATE( move_also_south( SIZE(temp_ns) ) )
-                move_also_south(1:nr_move_south-1) = temp_ns(1:nr_move_south-1)
-                DEALLOCATE( temp_ns )
-
-             ENDIF
-
-             move_also_south(nr_move_south) = agent_array(n)
-
-             IF ( jp == -1 )  THEN
-!
-!--             Apply boundary condition along y
-                IF ( ibc_mas_ns == 0 )  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
-                ELSEIF ( ibc_mas_ns == 1 )  THEN
-!
-!--                Agent absorption
-                   move_also_south(nr_move_south)%agent_mask = .FALSE.
-                   deleted_agents = deleted_agents + 1
-
-                ENDIF
-             ENDIF
-          ELSEIF ( jp >= nyn+1 )  THEN
-             nr_move_north = nr_move_north+1
-!
-!--          Before agent information is swapped to exchange-array, check  if enough memory is
-!--          allocated. If required, reallocate exchange array.
-             IF ( nr_move_north > SIZE( move_also_north ) )  THEN
-!
-!--             At first, allocate further temporary array to swap agent information.
-                ALLOCATE( temp_ns( SIZE( move_also_north ) + nr_2_direction_move ) )
-                temp_ns(1:nr_move_north-1) = move_also_south(1:nr_move_north-1)
-                DEALLOCATE( move_also_north )
-                ALLOCATE( move_also_north(SIZE(temp_ns)) )
-                move_also_north(1:nr_move_north-1) = temp_ns(1:nr_move_north-1)
-                DEALLOCATE( temp_ns )
-
-             ENDIF
-
-             move_also_north(nr_move_north) = agent_array(n)
-             IF ( jp == ny+1 )  THEN
-!
-!--             Apply boundary condition along y
-                IF ( ibc_mas_ns == 0 )  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
-                ELSEIF ( ibc_mas_ns == 1 )  THEN
-!
-!--                Agent absorption
-                   move_also_north(nr_move_north)%agent_mask = .FALSE.
-                   deleted_agents = deleted_agents + 1
-
-                ENDIF
-             ENDIF
-          ENDIF
-       ENDIF
-    ENDDO
-
-    RETURN
-
- END SUBROUTINE mas_eh_add_agents_to_gridcell
-#endif
-
-
-#if defined( __parallel )
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> After ghost layer agents have been received from neighboring PEs, this subroutine sorts them into
-!> the corresponding grid cells
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_eh_add_ghost_agents_to_gridcell (agent_array)
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  aindex  !< dummy argument for new number of agents per grid box
-    INTEGER(iwp) ::  ip      !< grid index (x) of agent
-    INTEGER(iwp) ::  jp      !< grid index (x) of agent
-    INTEGER(iwp) ::  n       !< index variable of agent
-
-    LOGICAL ::  pack_done  !< flag to indicate that packing is done
-
-    TYPE(agent_type), DIMENSION(:), INTENT(IN)  ::  agent_array  !< new agents in a grid box
-
-    pack_done     = .FALSE.
-
-    DO  n = 1, SIZE(agent_array)
-
-       IF ( .NOT. agent_array(n)%agent_mask )  CYCLE
-
-       ip = agent_array(n)%x * ddx
-       jp = agent_array(n)%y * ddy
-
-       IF ( ip < nxl  .OR.  ip > nxr  .OR.  jp < nys  .OR.  jp > nyn )  THEN
-          number_of_agents = agt_count(jp,ip)
-          agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-
-          aindex = agt_count(jp,ip)+1
-          IF( aindex > SIZE( grid_agents(jp,ip)%agents ) )  THEN
-             IF ( pack_done )  THEN
-                CALL mas_eh_realloc_agents_array (ip,jp)
-             ELSE
-                CALL mas_ps_pack
-                agt_count(jp,ip) = number_of_agents
-                aindex = agt_count(jp,ip)+1
-                IF ( aindex > SIZE( grid_agents(jp,ip)%agents ) )  THEN
-                   CALL mas_eh_realloc_agents_array (ip,jp)
-                ENDIF
-                pack_done = .TRUE.
-             ENDIF
-          ENDIF
-          grid_agents(jp,ip)%agents(aindex) = agent_array(n)
-          agt_count(jp,ip) = aindex
-       ENDIF
-    ENDDO
- END SUBROUTINE mas_eh_add_ghost_agents_to_gridcell
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resizing of agent arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_eh_dealloc_agents_array
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i         !< grid index (x) of agent
-    INTEGER(iwp) ::  j         !< grid index (y) of agent
-    INTEGER(iwp) ::  new_size  !< new array size
-    INTEGER(iwp) ::  noa       !< number of agents
-    INTEGER(iwp) ::  old_size  !< old array size
-
-    LOGICAL ::  dealloc  !< flag that indicates if reallocation is necessary
-
-    TYPE(agent_type), DIMENSION(10) ::  tmp_agents_s  !< temporary static agent array
-
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  tmp_agents_d  !< temporary dynamic agent array
-
-    DO  i = nxlg, nxrg
-       DO  j = nysg, nyng
-!
-!--       Determine number of active agents
-          noa = agt_count(j,i)
-!
-!--       Determine allocated memory size
-          old_size = SIZE( grid_agents(j,i)%agents )
-!
-!--       Check for large unused memory
-          dealloc = ( ( noa < min_nr_agent .AND. old_size  > min_nr_agent )  .OR.                  &
-                      ( noa > min_nr_agent .AND.                                                   &
-                        old_size - noa * ( 1.0_wp + 0.01_wp * alloc_factor_mas ) > 0.0_wp )        &
-                    )
-!
-!--       If large unused memory was found, resize the corresponding array
-          IF ( dealloc )  THEN
-             IF ( noa < min_nr_agent )  THEN
-                new_size = min_nr_agent
-             ELSE
-                new_size = INT( noa * ( 1.0_wp + 0.01_wp * alloc_factor_mas ) )
-             ENDIF
-
-             IF ( noa <= 10 )  THEN
-
-                tmp_agents_s(1:noa) = grid_agents(j,i)%agents(1:noa)
-
-                DEALLOCATE(grid_agents(j,i)%agents)
-                ALLOCATE(grid_agents(j,i)%agents(1:new_size))
-
-                grid_agents(j,i)%agents(1:noa)          = tmp_agents_s(1:noa)
-                grid_agents(j,i)%agents(noa+1:new_size) = zero_agent
-
-             ELSE
-
-                ALLOCATE(tmp_agents_d(noa))
-                tmp_agents_d(1:noa) = grid_agents(j,i)%agents(1:noa)
-
-                DEALLOCATE(grid_agents(j,i)%agents)
-                ALLOCATE(grid_agents(j,i)%agents(new_size))
-
-                grid_agents(j,i)%agents(1:noa)          = tmp_agents_d(1:noa)
-                grid_agents(j,i)%agents(noa+1:new_size) = zero_agent
-
-                DEALLOCATE(tmp_agents_d)
-
-             ENDIF
-
-          ENDIF
-       ENDDO
-    ENDDO
-
- END SUBROUTINE mas_eh_dealloc_agents_array
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exchange between subdomains.
-!> As soon as one agent 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 agents to be transferred
-!> and allocate temporary arrays needed to store them.
-!> For a one-dimensional decomposition along y, no transfer is necessary, because the agent remains
-!> on the PE, but the agent coordinate has to be adjusted.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_eh_exchange_horiz
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ip               !< index variable along x
-    INTEGER(iwp) ::  jp               !< index variable along y
-    INTEGER(iwp) ::  n                !< agent index variable
-
-#if defined( __parallel )
-
-    INTEGER(iwp) ::  i                !< grid index (x) of agent positition
-    INTEGER(iwp) ::  j                !< grid index (y) of agent positition
-    INTEGER(iwp) ::  par_size         !< Agent size in bytes
-
-    INTEGER(iwp) ::  trla_count       !< number of agents send to left PE
-    INTEGER(iwp) ::  trla_count_recv  !< number of agents receive from right PE
-    INTEGER(iwp) ::  trna_count       !< number of agents send to north PE
-    INTEGER(iwp) ::  trna_count_recv  !< number of agents receive from south PE
-    INTEGER(iwp) ::  trra_count       !< number of agents send to right PE
-    INTEGER(iwp) ::  trra_count_recv  !< number of agents receive from left PE
-    INTEGER(iwp) ::  trsa_count       !< number of agents send to south PE
-    INTEGER(iwp) ::  trsa_count_recv  !< number of agents receive from north PE
-
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  rvla  !< agents received from right PE
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  rvna  !< agents received from south PE
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  rvra  !< agents received from left PE
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  rvsa  !< agents received from north PE
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  trla  !< agents send to left PE
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  trna  !< agents send to north PE
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  trra  !< agents send to right PE
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  trsa  !< agents send to south PE
-
-!
-!-- Exchange between subdomains.
-!-- As soon as one agent 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 agents to be transferred
-!-- and allocate temporary arrays needed to store them.
-!-- For a one-dimensional decomposition along y, no transfer is necessary, because the agent remains
-!-- on the PE, but the agent coordinate has to be adjusted.
-    trla_count  = 0
-    trra_count  = 0
-
-    trla_count_recv   = 0
-    trra_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
-
-             number_of_agents = agt_count(jp,ip)
-             IF ( number_of_agents <= 0 )  CYCLE
-             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-             DO  n = 1, number_of_agents
-                IF ( agents(n)%agent_mask )  THEN
-                   i = agents(n)%x * ddx
-!
-!--                Above calculation does not work for indices less than zero
-                   IF ( agents(n)%x < 0.0_wp )  i = -1
-
-                   IF ( i < nxl )  THEN
-                      trla_count = trla_count + 1
-                   ELSEIF ( i > nxr )  THEN
-                      trra_count = trra_count + 1
-                   ENDIF
-                ENDIF
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-       IF ( trla_count  == 0 )  trla_count  = 1
-       IF ( trra_count  == 0 )  trra_count  = 1
-
-       ALLOCATE( trla(trla_count), trra(trra_count) )
-
-       trla = zero_agent
-       trra = zero_agent
-
-       trla_count  = 0
-       trra_count  = 0
-
-    ENDIF
-!
-!-- Compute only first (nxl) and last (nxr) loop iterration
-    DO  ip = nxl, nxr, nxr-nxl
-       DO  jp = nys, nyn
-          number_of_agents = agt_count(jp,ip)
-          IF ( number_of_agents <= 0 ) CYCLE
-          agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-          DO  n = 1, number_of_agents
-!
-!--          Only those agents that have not been marked as 'deleted' may be moved.
-             IF ( agents(n)%agent_mask )  THEN
-
-                i = agents(n)%x * ddx
-!
-!--             Above calculation does not work for indices less than zero
-                IF ( agents(n)%x < 0.0_wp )  i = -1
-
-                IF ( i <  nxl )  THEN
-                   IF ( i < 0 )  THEN
-!
-!--                   Apply boundary condition along x
-                      IF ( ibc_mas_lr == 0 )  THEN
-!
-!--                      Cyclic condition
-                         IF ( pdims(1) == 1 )  THEN
-                            agents(n)%x        = ( nx + 1 ) * dx + agents(n)%x
-                            agents(n)%origin_x = ( nx + 1 ) * dx + agents(n)%origin_x
-                         ELSE
-                            trla_count         = trla_count + 1
-                            trla(trla_count)   = agents(n)
-                            trla(trla_count)%x = ( nx + 1 ) * dx + trla(trla_count)%x
-                            trla(trla_count)%origin_x = trla(trla_count)%origin_x + ( nx + 1 ) * dx
-                            agents(n)%agent_mask  = .FALSE.
-                            deleted_agents = deleted_agents + 1
-
-                            IF ( trla(trla_count)%x >= (nx + 1)* dx - 1.0E-12_wp )  THEN
-                               trla(trla_count)%x = trla(trla_count)%x - 1.0E-10_wp
-                               trla(trla_count)%origin_x = trla(trla_count)%origin_x - 1
-                            ENDIF
-
-                         ENDIF
-
-                      ELSEIF ( ibc_mas_lr == 1 )  THEN
-!
-!--                      Agent absorption
-                         agents(n)%agent_mask = .FALSE.
-                         deleted_agents = deleted_agents + 1
-
-                      ENDIF
-                   ELSE
-!
-!--                   Store agent data in the transfer array, which will be send to the neighbouring
-!--                   PE.
-                      trla_count = trla_count + 1
-                      trla(trla_count) = agents(n)
-                      agents(n)%agent_mask = .FALSE.
-                      deleted_agents = deleted_agents + 1
-
-                   ENDIF
-
-                ELSEIF ( i > nxr )  THEN
-                   IF ( i > nx )  THEN
-!
-!--                   Apply boundary condition along x
-                      IF ( ibc_mas_lr == 0 )  THEN
-!
-!--                      Cyclic condition
-                         IF ( pdims(1) == 1 )  THEN
-                            agents(n)%x = agents(n)%x - ( nx + 1 ) * dx
-                            agents(n)%origin_x = agents(n)%origin_x - ( nx + 1 ) * dx
-                         ELSE
-                            trra_count = trra_count + 1
-                            trra(trra_count) = agents(n)
-                            trra(trra_count)%x = trra(trra_count)%x - ( nx + 1 ) * dx
-                            trra(trra_count)%origin_x = trra(trra_count)%origin_x - ( nx + 1 ) * dx
-                            agents(n)%agent_mask = .FALSE.
-                            deleted_agents = deleted_agents + 1
-
-                         ENDIF
-
-                      ELSEIF ( ibc_mas_lr == 1 )  THEN
-!
-!--                      Agent absorption
-                         agents(n)%agent_mask = .FALSE.
-                         deleted_agents = deleted_agents + 1
-
-                      ENDIF
-                   ELSE
-!
-!--                   Store agent data in the transfer array, which will be send to the neighbouring
-!--                   PE.
-                      trra_count = trra_count + 1
-                      trra(trra_count) = agents(n)
-                      agents(n)%agent_mask = .FALSE.
-                      deleted_agents = deleted_agents + 1
-
-                   ENDIF
-
-                ENDIF
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Allocate arrays required for north-south exchange, as these are used directly after agents are
-!-- exchange along x-direction.
-    ALLOCATE( move_also_north(1:nr_2_direction_move) )
-    ALLOCATE( move_also_south(1:nr_2_direction_move) )
-
-    nr_move_north = 0
-    nr_move_south = 0
-!
-!-- Send left boundary, receive right boundary (but first exchange how many and check if agent
-!-- storage must be extended).
-    IF ( pdims(1) /= 1 )  THEN
-
-       CALL MPI_SENDRECV( trla_count,      1, MPI_INTEGER, pleft,  0,                              &
-                          trra_count_recv, 1, MPI_INTEGER, pright, 0,                              &
-                          comm2d, status, ierr )
-
-       ALLOCATE( rvra(MAX( 1,trra_count_recv )) )
-!
-!--    This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit variables in structure
-!--    agent_type (due to the calculation of par_size)
-       par_size = STORAGE_SIZE( trla(1) ) / 8
-       CALL MPI_SENDRECV( trla, MAX( 1, trla_count ) * par_size,     MPI_BYTE, pleft,  1,          &
-                          rvra, MAX( 1, trra_count_recv )* par_size, MPI_BYTE, pright, 1,          &
-                          comm2d, status, ierr )
-
-       IF ( trra_count_recv > 0 )  THEN
-          CALL mas_eh_add_agents_to_gridcell(rvra(1:trra_count_recv))
-       ENDIF
-
-       DEALLOCATE(rvra)
-
-!
-!--    Send right boundary, receive left boundary
-       CALL MPI_SENDRECV( trra_count,      1, MPI_INTEGER, pright, 0,                              &
-                          trla_count_recv, 1, MPI_INTEGER, pleft,  0,                              &
-                          comm2d, status, ierr )
-
-       ALLOCATE(rvla(MAX(1,trla_count_recv)))
-!
-!--    This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit variables in structure
-!--    agent_type (due to the calculation of par_size)
-       par_size = STORAGE_SIZE(trra(1))/8
-       CALL MPI_SENDRECV( trra, MAX( 1, trra_count ) * par_size,   MPI_BYTE, pright, 1,            &
-                          rvla, MAX(1,trla_count_recv) * par_size, MPI_BYTE,  pleft, 1,            &
-                          comm2d, status, ierr )
-
-       IF ( trla_count_recv > 0 )  THEN
-          CALL mas_eh_add_agents_to_gridcell(rvla(1:trla_count_recv))
-       ENDIF
-
-       DEALLOCATE( rvla )
-       DEALLOCATE( trla, trra )
-
-    ENDIF
-
-!
-!-- Check whether agents have crossed the boundaries in y direction. Note that this case can also
-!-- apply to agents that have just been received from the adjacent right or left PE.
-!-- Find out first the number of agents to be transferred and allocate temporary arrays needed to
-!-- store them.
-!-- For a one-dimensional decomposition along y, no transfer is necessary, because the agent remains
-!-- on the PE.
-    trsa_count  = nr_move_south
-    trna_count  = nr_move_north
-
-    trsa_count_recv   = 0
-    trna_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
-             number_of_agents = agt_count(jp,ip)
-             IF ( number_of_agents <= 0 )  CYCLE
-             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-             DO  n = 1, number_of_agents
-                IF ( agents(n)%agent_mask )  THEN
-                   j = agents(n)%y * ddy
-!
-!--                Above calculation does not work for indices less than zero
-                   IF ( agents(n)%y < 0.0_wp )  j = -1
-
-                   IF ( j < nys )  THEN
-                      trsa_count = trsa_count + 1
-                   ELSEIF ( j > nyn )  THEN
-                      trna_count = trna_count + 1
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-       IF ( trsa_count  == 0 )  trsa_count  = 1
-       IF ( trna_count  == 0 )  trna_count  = 1
-
-       ALLOCATE( trsa(trsa_count), trna(trna_count) )
-
-       trsa = zero_agent
-       trna = zero_agent
-
-       trsa_count  = nr_move_south
-       trna_count  = nr_move_north
-
-       trsa(1:nr_move_south) = move_also_south(1:nr_move_south)
-       trna(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
-          number_of_agents = agt_count(jp,ip)
-          IF ( number_of_agents <= 0 )  CYCLE
-          agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-          DO  n = 1, number_of_agents
-!
-!--          Only those agents that have not been marked as 'deleted' may be moved.
-             IF ( agents(n)%agent_mask )  THEN
-
-                j = agents(n)%y * ddy
-!
-!--             Above calculation does not work for indices less than zero
-                IF ( agents(n)%y < 0.0_wp * dy )  j = -1
-
-                IF ( j < nys )  THEN
-                   IF ( j < 0 )  THEN
-!
-!--                   Apply boundary condition along y
-                      IF ( ibc_mas_ns == 0 )  THEN
-!
-!--                      Cyclic condition
-                         IF ( pdims(2) == 1 )  THEN
-                            agents(n)%y = ( ny + 1 ) * dy + agents(n)%y
-                            agents(n)%origin_y = ( ny + 1 ) * dy + agents(n)%origin_y
-                         ELSE
-                            trsa_count         = trsa_count + 1
-                            trsa(trsa_count)   = agents(n)
-                            trsa(trsa_count)%y = ( ny + 1 ) * dy + trsa(trsa_count)%y
-                            trsa(trsa_count)%origin_y = trsa(trsa_count)%origin_y + ( ny + 1 ) * dy
-                            agents(n)%agent_mask = .FALSE.
-                            deleted_agents = deleted_agents + 1
-
-                            IF ( trsa(trsa_count)%y >= (ny+1)* dy - 1.0E-12_wp )  THEN
-                               trsa(trsa_count)%y = trsa(trsa_count)%y - 1.0E-10_wp
-                               trsa(trsa_count)%origin_y = trsa(trsa_count)%origin_y - 1
-                            ENDIF
-
-                         ENDIF
-
-                      ELSEIF ( ibc_mas_ns == 1 )  THEN
-!
-!--                      Agent absorption
-                         agents(n)%agent_mask = .FALSE.
-                         deleted_agents          = deleted_agents + 1
-
-                      ENDIF
-                   ELSE
-!
-!--                   Store agent data in the transfer array, which will be send to the neighbouring
-!--                   PE.
-                      trsa_count = trsa_count + 1
-                      trsa(trsa_count) = agents(n)
-                      agents(n)%agent_mask = .FALSE.
-                      deleted_agents = deleted_agents + 1
-
-                   ENDIF
-
-                ELSEIF ( j > nyn )  THEN
-                   IF ( j > ny )  THEN
-!
-!--                   Apply boundary condition along y
-                      IF ( ibc_mas_ns == 0 )  THEN
-!
-!--                      Cyclic condition
-                         IF ( pdims(2) == 1 )  THEN
-                            agents(n)%y        = agents(n)%y        - ( ny + 1 ) * dy
-                            agents(n)%origin_y = agents(n)%origin_y - ( ny + 1 ) * dy
-                         ELSE
-                            trna_count         = trna_count + 1
-                            trna(trna_count)   = agents(n)
-                            trna(trna_count)%y = trna(trna_count)%y - ( ny + 1 ) * dy
-                            trna(trna_count)%origin_y = trna(trna_count)%origin_y - ( ny + 1 ) * dy
-                            agents(n)%agent_mask = .FALSE.
-                            deleted_agents          = deleted_agents + 1
-                         ENDIF
-
-                      ELSEIF ( ibc_mas_ns == 1 )  THEN
-!
-!--                      Agent absorption
-                         agents(n)%agent_mask = .FALSE.
-                         deleted_agents = deleted_agents + 1
-
-                      ENDIF
-                   ELSE
-!
-!--                   Store agent data in the transfer array, which will be send to the neighbouring
-!--                   PE
-                      trna_count = trna_count + 1
-                      trna(trna_count) = agents(n)
-                      agents(n)%agent_mask = .FALSE.
-                      deleted_agents = deleted_agents + 1
-
-                   ENDIF
-
-                ENDIF
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Send front boundary, receive back boundary (but first exchange how many and check if agent
-!-- storage must be extended).
-    IF ( pdims(2) /= 1 )  THEN
-
-       CALL MPI_SENDRECV( trsa_count,      1, MPI_INTEGER, psouth, 0,                              &
-                          trna_count_recv, 1, MPI_INTEGER, pnorth, 0,                              &
-                          comm2d, status, ierr )
-
-       ALLOCATE( rvna( MAX( 1, trna_count_recv )) )
-!
-!--    This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit variables in structure
-!--    agent_type (due to the calculation of par_size)
-       par_size = STORAGE_SIZE(trsa(1))/8
-       CALL MPI_SENDRECV( trsa, trsa_count * par_size,      MPI_BYTE, psouth, 1,                   &
-                          rvna, trna_count_recv * par_size, MPI_BYTE, pnorth, 1,                   &
-                          comm2d, status, ierr )
-
-       IF ( trna_count_recv  > 0 )  THEN
-          CALL mas_eh_add_agents_to_gridcell(rvna(1:trna_count_recv))
-       ENDIF
-
-       DEALLOCATE( rvna )
-
-!
-!--    Send back boundary, receive front boundary
-       CALL MPI_SENDRECV( trna_count,      1, MPI_INTEGER, pnorth, 0,                              &
-                          trsa_count_recv, 1, MPI_INTEGER, psouth, 0,                              &
-                          comm2d, status, ierr )
-
-       ALLOCATE( rvsa( MAX( 1, trsa_count_recv )) )
-!
-!--    This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit variables in structure
-!--    agent_type (due to the calculation of par_size)
-       par_size = STORAGE_SIZE( trna(1) ) / 8
-       CALL MPI_SENDRECV( trna, trna_count * par_size,      MPI_BYTE, pnorth, 1,                   &
-                          rvsa, trsa_count_recv * par_size, MPI_BYTE, psouth, 1,                   &
-                          comm2d, status, ierr )
-
-       IF ( trsa_count_recv > 0 )  THEN
-          CALL mas_eh_add_agents_to_gridcell(rvsa(1:trsa_count_recv))
-       ENDIF
-
-       DEALLOCATE( rvsa )
-
-       number_of_agents = number_of_agents + trsa_count_recv
-
-       DEALLOCATE( trsa, trna )
-
-    ENDIF
-
-    DEALLOCATE( move_also_north )
-    DEALLOCATE( move_also_south )
-
-!
-!-- Accumulate the number of agents transferred between the subdomains)
-    CALL mas_eh_ghost_exchange
-
-#else
-
-    DO  ip = nxl, nxr, nxr-nxl
-       DO  jp = nys, nyn
-          number_of_agents = agt_count(jp,ip)
-          IF ( number_of_agents <= 0 )  CYCLE
-          agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-          DO  n = 1, number_of_agents
-!
-!--          Apply boundary conditions
-             IF ( agents(n)%x < 0.0_wp )  THEN
-
-                IF ( ibc_mas_lr == 0 )  THEN
-!
-!--                Cyclic boundary. Relevant coordinate has to be changed.
-                   agents(n)%x = ( nx + 1 ) * dx + agents(n)%x
-                   agents(n)%origin_x = ( nx + 1 ) * dx + agents(n)%origin_x
-                ELSEIF ( ibc_mas_lr == 1 )  THEN
-!
-!--                Agent absorption
-                   agents(n)%agent_mask = .FALSE.
-                   deleted_agents = deleted_agents + 1
-                ENDIF
-
-             ELSEIF ( agents(n)%x >= ( nx + 1 ) * dx )  THEN
-
-                IF ( ibc_mas_lr == 0 )  THEN
-!
-!--                Cyclic boundary. Relevant coordinate has to be changed.
-                   agents(n)%x = agents(n)%x - ( nx + 1 ) * dx
-
-                ELSEIF ( ibc_mas_lr == 1 )  THEN
-!
-!--                Agent absorption
-                   agents(n)%agent_mask = .FALSE.
-                   deleted_agents = deleted_agents + 1
-                ENDIF
-
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn, nyn-nys
-          number_of_agents = agt_count(jp,ip)
-          IF ( number_of_agents <= 0 )  CYCLE
-          agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-          DO  n = 1, number_of_agents
-
-             IF ( agents(n)%y < 0.0_wp )  THEN
-
-                IF ( ibc_mas_ns == 0 )  THEN
-!
-!--                Cyclic boundary. Relevant coordinate has to be changed.
-                   agents(n)%y = ( ny + 1 ) * dy + agents(n)%y
-                   agents(n)%origin_y = ( ny + 1 ) * dy + &
-                        agents(n)%origin_y
-
-                ELSEIF ( ibc_mas_ns == 1 )  THEN
-!
-!--                Agent absorption
-                   agents(n)%agent_mask = .FALSE.
-                   deleted_agents = deleted_agents + 1
-                ENDIF
-
-             ELSEIF ( agents(n)%y >= ( ny + 0.5_wp ) * dy )  THEN
-
-                IF ( ibc_mas_ns == 0 )  THEN
-!
-!--                Cyclic boundary. Relevant coordinate has to be changed.
-                   agents(n)%y = agents(n)%y - ( ny + 1 ) * dy
-
-                ELSEIF ( ibc_mas_ns == 1 )  THEN
-!
-!--                Agent absorption
-                   agents(n)%agent_mask = .FALSE.
-                   deleted_agents = deleted_agents + 1
-                ENDIF
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-#endif
-
- END SUBROUTINE mas_eh_exchange_horiz
-
-
-#if defined( __parallel )
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sends the agents from the three gridcells closest to the north/south/left/right border of a PE to
-!> the corresponding neighbors ghost layer (which is three grid boxes deep)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_eh_ghost_exchange
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  agt_size    !< Bit size of agent datatype
-    INTEGER(iwp) ::  ghla_count  !< ghost points left agent
-    INTEGER(iwp) ::  ghna_count  !< ghost points north agent
-    INTEGER(iwp) ::  ghra_count  !< ghost points right agent
-    INTEGER(iwp) ::  ghsa_count  !< ghost points south agent
-    INTEGER(iwp) ::  ip          !< index variable along x
-    INTEGER(iwp) ::  jp          !< index variable along y
-
-    LOGICAL ::  ghla_empty      !< ghost points left agent
-    LOGICAL ::  ghla_empty_rcv  !< ghost points left agent
-    LOGICAL ::  ghna_empty      !< ghost points north agent
-    LOGICAL ::  ghna_empty_rcv  !< ghost points north agent
-    LOGICAL ::  ghra_empty      !< ghost points right agent
-    LOGICAL ::  ghra_empty_rcv  !< ghost points right agent
-    LOGICAL ::  ghsa_empty      !< ghost points south agent
-    LOGICAL ::  ghsa_empty_rcv  !< ghost points south agent
-
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  ghla  !< agents received from right PE
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  ghna  !< agents received from south PE
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  ghra  !< agents received from left PE
-    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  ghsa  !< agents received from north PE
-
-    ghla_empty = .TRUE.
-    ghna_empty = .TRUE.
-    ghra_empty = .TRUE.
-    ghsa_empty = .TRUE.
-!
-!-- Reset ghost layer
-    DO  ip = nxlg, nxl-1
-       DO  jp = nysg, nyng
-          agt_count(jp,ip) = 0
-       ENDDO
-    ENDDO
-    DO  ip = nxr+1, nxrg
-       DO  jp = nysg, nyng
-          agt_count(jp,ip) = 0
-       ENDDO
-    ENDDO
-    DO  ip = nxl, nxr
-       DO  jp = nysg, nys-1
-          agt_count(jp,ip) = 0
-       ENDDO
-    ENDDO
-    DO  ip = nxl, nxr
-       DO  jp = nyn+1, nyng
-          agt_count(jp,ip) = 0
-       ENDDO
-    ENDDO
-!
-!-- Transfer of agents from left to right and vice versa
-    IF ( pdims(1) /= 1 )  THEN
-!
-!--    Reset left and right ghost layers
-       ghla_count  = 0
-       ghra_count  = 0
-!
-!--    First calculate the storage necessary for sending and receiving the data.
-       ghla_count = SUM(agt_count(nys:nyn,nxl:nxl+2))
-       ghra_count = SUM(agt_count(nys:nyn,nxr-2:nxr))
-!
-!--    No cyclic boundaries for agents
-       IF ( nxl == 0  .OR.  ghla_count == 0 )  THEN
-          ghla_count = 1
-       ELSE
-          ghla_empty = .FALSE.
-       ENDIF
-       IF ( nxr == nx  .OR.  ghra_count == 0 )  THEN
-          ghra_count = 1
-       ELSE
-          ghra_empty = .FALSE.
-       ENDIF
-       ALLOCATE( ghla(1:ghla_count), ghra(1:ghra_count) )
-       ghla = zero_agent
-       ghra = zero_agent
-!
-!--    Get all agents that will be sent left into one array
-       ghla_count = 0
-       IF ( nxl /= 0 )  THEN
-          DO  ip = nxl, nxl+2
-             DO jp = nys, nyn
-
-                number_of_agents = agt_count(jp,ip)
-                IF ( number_of_agents <= 0 )  CYCLE
-                ghla(ghla_count+1:ghla_count+number_of_agents)                                     &
-                                                     = grid_agents(jp,ip)%agents(1:number_of_agents)
-                ghla_count = ghla_count + number_of_agents
-
-             ENDDO
-          ENDDO
-       ENDIF
-       IF ( ghla_count == 0 )  ghla_count = 1
-!
-!--    Get all agents that will be sent right into one array
-       ghra_count = 0
-       IF ( nxr /= nx )  THEN
-          DO  ip = nxr-2, nxr
-             DO  jp = nys, nyn
-
-                number_of_agents = agt_count(jp,ip)
-                IF ( number_of_agents <= 0 )  CYCLE
-                ghra(ghra_count+1:ghra_count+number_of_agents)                                     &
-                                                   = grid_agents(jp,ip)%agents(1:number_of_agents)
-                ghra_count = ghra_count + number_of_agents
-
-             ENDDO
-          ENDDO
-       ENDIF
-       IF ( ghra_count == 0 ) ghra_count = 1
-!
-!--    Send/receive number of agents that will be transferred to/from left/right neighbor.
-       CALL MPI_SENDRECV( ghla_count,      1, MPI_INTEGER, pleft,  0,                              &
-                          ghra_count_recv, 1, MPI_INTEGER, pright, 0,                              &
-                          comm2d, status, ierr )
-       ALLOCATE ( agt_gh_r(1:ghra_count_recv) )
-!
-!--    Send/receive number of agents that will be transferred to/from right/left neighbor
-       CALL MPI_SENDRECV( ghra_count,      1, MPI_INTEGER, pright,  0,                             &
-                          ghla_count_recv, 1, MPI_INTEGER, pleft,   0,                             &
-                          comm2d, status, ierr )
-!
-!--    Send/receive flag that indicates if there are actually any agents in ghost layer
-       CALL MPI_SENDRECV( ghla_empty,     1, MPI_LOGICAL, pleft, 1,                                &
-                          ghra_empty_rcv, 1, MPI_LOGICAL, pright,1,                                &
-                          comm2d, status, ierr )
-       CALL MPI_SENDRECV( ghra_empty,     1, MPI_LOGICAL, pright,1,                                &
-                          ghla_empty_rcv, 1, MPI_LOGICAL, pleft, 1,                                &
-                          comm2d, status, ierr )
-
-
-       ALLOCATE ( agt_gh_l(1:ghla_count_recv) )
-!
-!--    Get bit size of one agent
-       agt_size = STORAGE_SIZE(zero_agent)/8
-!
-!--    Send/receive agents to/from left/right neighbor
-       CALL MPI_SENDRECV( ghla,     ghla_count      * agt_size, MPI_BYTE, pleft, 1,                &
-                          agt_gh_r, ghra_count_recv * agt_size, MPI_BYTE, pright,1,                &
-                          comm2d, status, ierr )
-!
-!--    Send/receive agents to/from left/right neighbor
-       CALL MPI_SENDRECV( ghra,     ghra_count      * agt_size, MPI_BYTE, pright,1,                &
-                          agt_gh_l, ghla_count_recv * agt_size, MPI_BYTE, pleft, 1,                &
-                          comm2d, status, ierr )
-!
-!--    If agents were received, add them to the respective ghost layer cells
-       IF ( .NOT. ghra_empty_rcv )  THEN
-          CALL mas_eh_add_ghost_agents_to_gridcell(agt_gh_r)
-       ENDIF
-
-       IF ( .NOT. ghla_empty_rcv )  THEN
-          CALL mas_eh_add_ghost_agents_to_gridcell(agt_gh_l)
-       ENDIF
-
-       DEALLOCATE( ghla, ghra, agt_gh_l, agt_gh_r )
-
-    ENDIF
-
-!
-!-- Transfer of agents from south to north and vice versa
-    IF ( pdims(2) /= 1 )  THEN
-!
-!--    Reset south and north ghost layers
-       ghsa_count  = 0
-       ghna_count  = 0
-!
-!--    First calculate the storage necessary for sending and receiving the data.
-       ghsa_count = SUM( agt_count(nys:nys+2,nxlg:nxrg) )
-       ghna_count = SUM( agt_count(nyn-2:nyn,nxlg:nxrg) )
-!
-!--    No cyclic boundaries for agents
-       IF ( nys == 0  .OR.  ghsa_count == 0 )  THEN
-          ghsa_count = 1
-       ELSE
-          ghsa_empty = .FALSE.
-       ENDIF
-       IF ( nyn == ny  .OR.  ghna_count == 0 )  THEN
-          ghna_count = 1
-       ELSE
-          ghna_empty = .FALSE.
-       ENDIF
-       ALLOCATE( ghsa(1:ghsa_count), ghna(1:ghna_count) )
-       ghsa = zero_agent
-       ghna = zero_agent
-!
-!--    Get all agents that will be sent south into one array
-       ghsa_count = 0
-       IF ( nys /= 0 )  THEN
-          DO  ip = nxlg, nxrg
-             DO  jp = nys, nys+2
-
-                number_of_agents = agt_count(jp,ip)
-                IF ( number_of_agents <= 0 )  CYCLE
-                ghsa(ghsa_count+1:ghsa_count+number_of_agents)                                     &
-                                                    = grid_agents(jp,ip)%agents(1:number_of_agents)
-                ghsa_count = ghsa_count + number_of_agents
-
-             ENDDO
-          ENDDO
-       ENDIF
-       IF ( ghsa_count == 0 )  ghsa_count = 1
-!
-!--    Get all agents that will be sent north into one array
-       ghna_count = 0
-       IF ( nyn /= ny )  THEN
-          DO  ip = nxlg, nxrg
-             DO  jp = nyn-2, nyn
-
-                number_of_agents = agt_count(jp,ip)
-                IF ( number_of_agents <= 0 )  CYCLE
-                ghna(ghna_count+1:ghna_count+number_of_agents)                                     &
-                                                     = grid_agents(jp,ip)%agents(1:number_of_agents)
-                ghna_count = ghna_count + number_of_agents
-
-             ENDDO
-          ENDDO
-       ENDIF
-       IF ( ghna_count == 0 ) ghna_count = 1
-!
-!--    Send/receive number of agents that will be transferred to/from south/north neighbor
-       CALL MPI_SENDRECV( ghsa_count,        1, MPI_INTEGER, psouth, 0,                            &
-                          ghna_count_recv,   1, MPI_INTEGER, pnorth, 0,                            &
-                          comm2d, status, ierr )
-       ALLOCATE ( agt_gh_n(1:ghna_count_recv) )
-!
-!--    Send/receive number of agents that will be transferred to/from north/south neighbor
-       CALL MPI_SENDRECV( ghna_count,        1, MPI_INTEGER, pnorth, 0,                            &
-                          ghsa_count_recv,   1, MPI_INTEGER, psouth, 0,                            &
-                          comm2d, status, ierr )
-!
-!--    Send/receive flag that indicates if there are actually any agents in ghost layer
-       CALL MPI_SENDRECV( ghsa_empty,     1, MPI_LOGICAL, psouth, 1,                               &
-                          ghna_empty_rcv, 1, MPI_LOGICAL, pnorth, 1,                               &
-                          comm2d, status, ierr )
-       CALL MPI_SENDRECV( ghna_empty,     1, MPI_LOGICAL, pnorth, 1,                               &
-                          ghsa_empty_rcv, 1, MPI_LOGICAL, psouth, 1,                               &
-                          comm2d, status, ierr )
-
-
-       ALLOCATE ( agt_gh_s(1:ghsa_count_recv) )
-!
-!--    Get bit size of one agent
-       agt_size = STORAGE_SIZE(zero_agent)/8
-!
-!--    Send/receive agents to/from south/north neighbor
-       CALL MPI_SENDRECV( ghsa,     ghsa_count      * agt_size, MPI_BYTE, psouth,1,                &
-                          agt_gh_n, ghna_count_recv * agt_size, MPI_BYTE, pnorth,1,                &
-                          comm2d, status, ierr )
-!
-!--       Send/receive agents to/from south/north neighbor
-       CALL MPI_SENDRECV( ghna,     ghna_count      * agt_size, MPI_BYTE, pnorth,1,                &
-                          agt_gh_s, ghsa_count_recv * agt_size, MPI_BYTE, psouth,1,                &
-                          comm2d, status, ierr )
-!
-!--    If agents were received, add them to the respective ghost layer cells
-       IF ( .NOT. ghna_empty_rcv )  THEN
-          CALL mas_eh_add_ghost_agents_to_gridcell(agt_gh_n)
-       ENDIF
-
-       IF ( .NOT. ghsa_empty_rcv )  THEN
-          CALL mas_eh_add_ghost_agents_to_gridcell(agt_gh_s)
-       ENDIF
-
-       DEALLOCATE( ghna, ghsa, agt_gh_n, agt_gh_s )
-
-    ENDIF
-
- END SUBROUTINE mas_eh_ghost_exchange
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> If an agent moves from one grid cell to another (on the current processor!), this subroutine
-!> moves the corresponding element from the agent array of the old grid cell to the agent array of
-!> the new grid cell.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_eh_move_agent
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  aindex         !< dummy argument for number of new agent per grid box
-    INTEGER(iwp) ::  i              !< grid index (x) of agent position
-    INTEGER(iwp) ::  ip             !< index variable along x
-    INTEGER(iwp) ::  j              !< grid index (y) of agent position
-    INTEGER(iwp) ::  jp             !< index variable along y
-    INTEGER(iwp) ::  n              !< index variable for agent array
-    INTEGER(iwp) ::  na_before_move !< number of agents per grid box before moving
-
-    TYPE(agent_type), DIMENSION(:), POINTER ::  agents_before_move !< agents before moving
-
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-
-             na_before_move = agt_count(jp,ip)
-             IF ( na_before_move <= 0 )  CYCLE
-             agents_before_move => grid_agents(jp,ip)%agents(1:na_before_move)
-
-             DO  n = 1, na_before_move
-                i = agents_before_move(n)%x * ddx
-                j = agents_before_move(n)%y * ddy
-
-!--             For mas_eh_exchange_horiz to work properly agents need to be moved to the outermost
-!--             gridboxes of the respective processor.
-!--             If the agent index is inside the processor the following lines will not change the
-!--             index.
-                i = MIN ( i , nxr )
-                i = MAX ( i , nxl )
-                j = MIN ( j , nyn )
-                j = MAX ( j , nys )
-
-!
-!--             Check if agent has moved to another grid cell.
-                IF ( i /= ip  .OR.  j /= jp )  THEN
-!
-!--                If the agent stays on the same processor, the agent will be added to the agent
-!--                array of the new processor.
-                   number_of_agents = agt_count(j,i)
-                   agents => grid_agents(j,i)%agents(1:number_of_agents)
-
-                   aindex = number_of_agents+1
-                   IF (  aindex > SIZE(grid_agents(j,i)%agents)  )  THEN
-                      CALL mas_eh_realloc_agents_array(i,j)
-                   ENDIF
-
-                   grid_agents(j,i)%agents(aindex) = agents_before_move(n)
-                   agt_count(j,i) = aindex
-
-                   agents_before_move(n)%agent_mask = .FALSE.
-                ENDIF
-             ENDDO
-
-       ENDDO
-    ENDDO
-
-    RETURN
-
- END SUBROUTINE mas_eh_move_agent
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> If the allocated memory for the agent array does not suffice to add arriving agents from
-!> neighbour grid cells, this subrouting reallocates the agent array to assure enough memory is
-!> available.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE mas_eh_realloc_agents_array (i,j,size_in)
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) :: new_size  !< new array size
-       INTEGER(iwp) :: old_size  !< old array size
-
-       INTEGER(iwp), INTENT(in) ::  i  !< grid index (y)
-       INTEGER(iwp), INTENT(in) ::  j  !< grid index (y)
-
-       INTEGER(iwp), INTENT(in), OPTIONAL ::  size_in  !< size of input array
-
-       TYPE(agent_type), DIMENSION(10) :: tmp_agents_s  !< temporary static agent array
-
-       TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: tmp_agents_d  !< temporary dynamic agent array
-
-       old_size = SIZE(grid_agents(j,i)%agents)
-
-       IF ( PRESENT( size_in ) )  THEN
-          new_size = size_in
-       ELSE
-          new_size = old_size * ( 1.0_wp + alloc_factor_mas / 100.0_wp )
-       ENDIF
-
-       new_size = MAX( new_size, min_nr_agent, old_size + 1 )
-
-       IF ( old_size <= 10 )  THEN
-
-          tmp_agents_s(1:old_size) = grid_agents(j,i)%agents(1:old_size)
-
-          DEALLOCATE( grid_agents(j,i)%agents )
-          ALLOCATE( grid_agents(j,i)%agents(new_size) )
-
-          grid_agents(j,i)%agents(1:old_size)         = tmp_agents_s(1:old_size)
-          grid_agents(j,i)%agents(old_size+1:new_size) = zero_agent
-
-       ELSE
-
-          ALLOCATE( tmp_agents_d(new_size) )
-          tmp_agents_d(1:old_size) = grid_agents(j,i)%agents
-
-          DEALLOCATE( grid_agents(j,i)%agents )
-          ALLOCATE( grid_agents(j,i)%agents(new_size) )
-
-          grid_agents(j,i)%agents(1:old_size)         = tmp_agents_d(1:old_size)
-          grid_agents(j,i)%agents(old_size+1:new_size) = zero_agent
-
-          DEALLOCATE( tmp_agents_d )
-
-       ENDIF
-       agents => grid_agents(j,i)%agents(1:number_of_agents)
-
-       RETURN
-    END SUBROUTINE mas_eh_realloc_agents_array
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Inquires prognostic model quantities at the position of each agent and stores them in that agent
-!> for later output
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_get_prognostic_quantities
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  exner, pt, u, v
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i_offset  !<  index offset for windspeed measurement
-    INTEGER(iwp) ::  il        !<  x-index
-    INTEGER(iwp) ::  is        !<  subgrid box counter
-    INTEGER(iwp) ::  j_offset  !<  index offset for windspeed measurement
-    INTEGER(iwp) ::  jl        !<  y-index
-    INTEGER(iwp) ::  kl        !<  z-index
-    INTEGER(iwp) ::  nl        !<  agent counter
-    INTEGER(iwp) ::  se        !<  subgrid box end index
-    INTEGER(iwp) ::  si        !<  subgrid box start index
-
-    REAL(wp) ::  u_a  !< windspeed at agent position (x)
-    REAL(wp) ::  v_a  !< windspeed at agent position (y)
-
-    DO  il = nxl, nxr
-       DO  jl = nys, nyn
-
-          number_of_agents = agt_count(jl,il)
-!
-!--       If grid cell is empty, cycle
-          IF ( number_of_agents <= 0 )  CYCLE
-          kl = s_measure_height(jl,il)
-
-          agents => grid_agents(jl,il)%agents(1:number_of_agents)
-!
-!--       Loop over the four subgrid boxes
-          DO  is = 0,3
-!
-!--          Set indices
-             si = grid_agents(jl,il)%start_index(is)
-             se = grid_agents(jl,il)%end_index(is)
-             DO  nl = si, se
-!
-!--             Calculate index offset in x-direction:
-!--             Left value if wall right of grid box
-!--             Right value if wall left of grid box
-!--             Else the one that is closer to the agent
-                IF ( BTEST( obstacle_flags( jl, il+1 ), 6 ) )  THEN
-                   i_offset = 0
-                ELSEIF ( BTEST( obstacle_flags( jl, il-1 ), 2 ) )  THEN
-                   i_offset = 1
-                ELSE
-                   i_offset = MERGE( 0, 1, BTEST(is,1) )
-                ENDIF
-                u_a = u( kl, jl, il + i_offset )
-!
-!--             Calculate index offset in y-direction:
-!--             South value if wall north of grid box
-!--             North value if wall south of grid box
-!--             Else the one that is closer to the agent
-                IF ( BTEST( obstacle_flags( jl+1, il ), 4 ) )  THEN
-                   j_offset = 0
-                ELSEIF ( BTEST( obstacle_flags( jl-1, il ), 0 ) )  THEN
-                   j_offset = 1
-                ELSE
-                   j_offset = MERGE( 0, 1, BTEST(is,0) )
-                ENDIF
-                v_a = v( kl, jl + j_offset, il )
-!
-!--             Calculate windspeed at agent postion
-                agents(nl)%windspeed = SQRT(u_a**2 + v_a**2)
-!
-!--             Calculate temperature at agent position
-                agents(nl)%t = pt(kl,jl,il) * exner(kl)
-
-             ENDDO
-
-          ENDDO
-
-       ENDDO
-    ENDDO
-
- END SUBROUTINE mas_get_prognostic_quantities
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Adds an item to the priority queue (binary heap) at the correct position
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_heap_insert_item( id, priority )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  cur_pos  !< current position
-    INTEGER(iwp) ::  id       !< mesh ID of item
-
-    REAL(wp) ::  priority  !< item priority
-
-    TYPE(heap_item) ::  item  !< heap item
-
-    item%mesh_id  = id
-    item%priority = priority
-!
-!--    Extend heap, if necessary
-    IF ( heap_count + 1 > SIZE( queue ) )  THEN
-       CALL mas_heap_extend
-    ENDIF
-!
-!-- Insert item at first unoccupied postion (highest index) of heap
-    cur_pos = heap_count
-    queue(cur_pos) = item
-!
-!-- Sort while inserted item is not at top of heap
-    DO WHILE ( cur_pos /= 0 )
-!
-!--    If priority < its parent's priority, swap them.
-!--    Else, sorting is done.
-       IF ( queue(cur_pos)%priority < queue(FLOOR( (cur_pos) / 2.0_wp ))%priority )  THEN
-          item = queue(cur_pos)
-          queue(cur_pos) = queue(FLOOR( ( cur_pos ) / 2.0_wp ))
-          queue(FLOOR( ( cur_pos ) / 2.0_wp )) = item
-          cur_pos = FLOOR( ( cur_pos ) / 2.0_wp )
-       ELSE
-          EXIT
-       ENDIF
-    ENDDO
-!
-!-- Item was added to heap, so the heap count increases
-    heap_count = heap_count + 1
-
- END SUBROUTINE mas_heap_insert_item
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Extends the size of the priority queue (binary heap)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_heap_extend
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  soh  !< size of heap
-
-    TYPE(heap_item), DIMENSION(:), ALLOCATABLE ::  dummy_heap  !< dummy heap
-
-    soh = SIZE( queue ) - 1
-    ALLOCATE( dummy_heap(0:soh) )
-    dummy_heap = queue
-    DEALLOCATE( queue )
-    ALLOCATE( queue(0:2*soh+1) )
-    queue(0:soh) = dummy_heap(0:soh)
-
- END SUBROUTINE mas_heap_extend
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Removes first (smallest) element from the priority queue, reorders the rest and returns the ID of
-!> the removed mesh point
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_heap_extract_item ( id )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  child    !< child of item in heap
-    INTEGER(iwp) ::  cur_pos  !< current position of item in heap
-    INTEGER(iwp) ::  id       !< ID of item extracted item
-
-    TYPE(heap_item) ::  dummy
-!
-!-- Get ID of mesh point with lowest priority (extracted item: top of heap)
-    id = queue(0)%mesh_id
-!
-!-- Put last item in heap at first position
-    queue(0) = queue(heap_count-1)
-    cur_pos = 0
-    DO
-!
-!--    If current item has no children, sorting is done
-       IF( 2*cur_pos+1 > heap_count - 1 )  THEN
-          EXIT
-!
-!--    If current item has only one child, check if item and its child are ordered correctly. Else,
-!--    swap them.
-       ELSEIF ( 2*cur_pos+2 > heap_count - 1 )  THEN
-          IF ( queue(cur_pos)%priority > queue(2*cur_pos+1)%priority )  THEN
-             dummy = queue(cur_pos)
-             queue(cur_pos) = queue(2*cur_pos+1)
-             queue(2*cur_pos+1) = dummy
-             cur_pos = 2*cur_pos+1
-          ELSE
-             EXIT
-          ENDIF
-       ELSE
-!
-!--       Determine the smaller child
-          IF ( queue(2*cur_pos+1)%priority >= queue(2*cur_pos+2)%priority )  THEN
-             child = 2
-          ELSE
-             child = 1
-          ENDIF
-!
-!--       Check if item and its smaller child are ordered falsely. If so, swap them. Else, sorting
-!--       is done.
-          IF ( queue(cur_pos)%priority > queue(2*cur_pos+child )%priority )  THEN
-             dummy = queue(cur_pos)
-             queue(cur_pos) = queue(2*cur_pos+child)
-             queue(2*cur_pos+child) = dummy
-             cur_pos = 2*cur_pos+child
-          ELSE
-             EXIT
-          ENDIF
-       ENDIF
-    ENDDO
-!
-!-- Top item was removed from heap, thus, heap_cout decreases by one
-    heap_count = heap_count-1
-
- END SUBROUTINE mas_heap_extract_item
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of Multi Agent System
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_init
-
-    USE control_parameters,                                                                        &
-        ONLY:  coupling_char, initializing_actions, io_blocks, io_group
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zu, zw
-
-    USE indices,                                                                                   &
-        ONLY:  nzt
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i             !< grid cell (x)
-    INTEGER(iwp) ::  ii            !< io-block counter
-    INTEGER(iwp) ::  il            !< io-block counter
-    INTEGER(iwp) ::  ioerr         !< IOSTAT flag for IO-commands ( 0 = no error )
-    INTEGER(iwp) ::  j             !< grid cell (y)
-    INTEGER(iwp) ::  jl            !< io-block counter
-    INTEGER(iwp) ::  kl            !< io-block counter
-    INTEGER(iwp) ::  kdum          !< io-block counter
-    INTEGER(iwp) ::  locdum        !< io-block counter
-    INTEGER(iwp) ::  size_of_mesh  !< temporary value for read
-    INTEGER(iwp) ::  size_of_pols  !< temporary value for read
-
-    LOGICAL ::  navigation_data_present  !< Flag: check for input file
-
-    REAL(wp) ::  zdum  !< dummy for measurement height
-    REAL(wp) ::  avg_agt_height = 1.8_wp
-
-
-!
-!-- Check the number of agent groups.
-    IF ( number_of_agent_groups > max_number_of_agent_groups )  THEN
-       WRITE( message_string, * ) 'max_number_of_agent_groups =', max_number_of_agent_groups ,     &
-                                  '&number_of_agent_groups reset to ', max_number_of_agent_groups
-       CALL message( 'mas_init', 'PA0072', 0, 1, 0, 6, 0 )
-       number_of_agent_groups = max_number_of_agent_groups
-    ENDIF
-
-!
-!-- Set some parameters
-    d_sigma_rep_agent = 1.0_wp/sigma_rep_agent
-    d_sigma_rep_wall  = 1.0_wp/sigma_rep_wall
-    d_tau_accel_agent = 1.0_wp/tau_accel_agent
-    IF ( dt_agent /= 999.0_wp )  THEN
-       agent_own_timestep = .TRUE.
-    ENDIF
-
-!
-!-- Get index of first grid box above topography
-    ALLOCATE( top_top_s(nysg:nyng,nxlg:nxrg),                                                      &
-              top_top_w(nysg:nyng,nxlg:nxrg),                                                      &
-              s_measure_height(nys:nyn,nxl:nxr) )
-!
-!-- Get first index above topography for scalar grid and last index in topography for z-component of
-!-- wind.
-    DO  il = nxlg, nxrg
-       DO  jl = nysg, nyng
-          top_top_s(jl,il) = topo_top_ind(jl,il,0) + 1
-          top_top_w(jl,il) = topo_top_ind(jl,il,3)
-       ENDDO
-    ENDDO
-!
-!-- Create 2D array containing the index at which measurements are done by agents. The height of
-!-- this measurement is given by avg_agt_height.
-    DO  il = nxl, nxr
-       DO  jl = nys, nyn
-
-          kdum = top_top_w(jl,il)
-          zdum = zw(kdum)
-          zdum = zdum + avg_agt_height
-          locdum = 0
-!
-!--       Locate minimum distance from u-grid to measurement height (zdum)
-          DO  kl = 1, nzt
-             IF ( ABS(zu(kl)-zdum) < ABS(zu(locdum)-zdum) ) locdum = kl
-          ENDDO
-          s_measure_height(jl,il) = locdum
-
-       ENDDO
-    ENDDO
-
-    CALL mas_create_obstacle_flags
-
-!
-!-- Set default start positions, if necessary
-    IF ( asl(1) == 9999999.9_wp )  asl(1) = 0.0_wp
-    IF ( asr(1) == 9999999.9_wp )  asr(1) = ( nx + 1 ) * dx
-    IF ( ass(1) == 9999999.9_wp )  ass(1) = 0.0_wp
-    IF ( asn(1) == 9999999.9_wp )  asn(1) = ( ny + 1 ) * dy
-    IF ( adx(1) == 9999999.9_wp  .OR.  adx(1) == 0.0_wp ) adx(1) = dx
-    IF ( ady(1) == 9999999.9_wp  .OR.  ady(1) == 0.0_wp ) ady(1) = dy
-
-    DO  j = 2, number_of_agent_groups
-       IF ( asl(j) == 9999999.9_wp )  asl(j) = asl(j-1)
-       IF ( asr(j) == 9999999.9_wp )  asr(j) = asr(j-1)
-       IF ( ass(j) == 9999999.9_wp )  ass(j) = ass(j-1)
-       IF ( asn(j) == 9999999.9_wp )  asn(j) = asn(j-1)
-       IF ( adx(j) == 9999999.9_wp  .OR.  adx(j) == 0.0_wp ) adx(j) = adx(j-1)
-       IF ( ady(j) == 9999999.9_wp  .OR.  ady(j) == 0.0_wp ) ady(j) = ady(j-1)
-    ENDDO
-
-!
-!-- Check boundary condition and set internal variables
-    SELECT CASE ( bc_mas_lr )
-
-       CASE ( 'cyclic' )
-          ibc_mas_lr = 0
-
-       CASE ( 'absorb' )
-          ibc_mas_lr = 1
-
-       CASE DEFAULT
-          WRITE( message_string, * ) 'unknown boundary condition ',                                &
-                                     'bc_mas_lr = "', TRIM( bc_mas_lr ), '"'
-          CALL message( 'mas_init', 'PA0073', 1, 2, 0, 6, 0 )
-
-    END SELECT
-    SELECT CASE ( bc_mas_ns )
-
-       CASE ( 'cyclic' )
-          ibc_mas_ns = 0
-
-       CASE ( 'absorb' )
-          ibc_mas_ns = 1
-
-       CASE DEFAULT
-          WRITE( message_string, * ) 'unknown boundary condition ',                                &
-                                     'bc_mas_ns = "', TRIM( bc_mas_ns ), '"'
-          CALL message( 'mas_init', 'PA0074', 1, 2, 0, 6, 0 )
-
-    END SELECT
-
-!
-!-- For the first model run of a possible job chain initialize the agents, otherwise read the agent
-!-- data from restart file.
-    IF ( TRIM( initializing_actions ) == 'read_restart_data'  .AND.  read_agents_from_restartfile )&
-    THEN
-
-!           CALL mas_read_restart_file
-
-    ELSE
-!
-!--    Read preprocessed data of navigation mesh and building polygons for agent pathfinding
-       DO  ii = 0, io_blocks-1
-          IF ( ii == io_group )  THEN
-!
-!--          Check for naviation input file and open it
-             INQUIRE( FILE='NAVIGATION_DATA' // TRIM( coupling_char ),                             &
-                      EXIST=navigation_data_present )
-             IF ( .NOT. navigation_data_present )  THEN
-                message_string = 'Input file NAVIGATION_DATA' //                                   &
-                                  TRIM( coupling_char ) // ' for MAS missing. ' //                 &
-                                  '&Please run agent_preprocessing before the job to create it.'
-                CALL message( 'mas_init', 'PA0525', 1, 2, 0, 6, 0 )
-             ENDIF
-             OPEN ( 119, FILE='NAVIGATION_DATA'//TRIM( coupling_char ), FORM='UNFORMATTED',        &
-                         IOSTAT=ioerr )
-!
-!--             Read mesh data
-             READ( 119 ) size_of_mesh
-             ALLOCATE( mesh(1:size_of_mesh) )
-             DO  i = 1, size_of_mesh
-                READ( 119 ) mesh(i)%polygon_id, mesh(i)%vertex_id,                                 &
-                            mesh(i)%noc, mesh(i)%origin_id,                                        &
-                            mesh(i)%cost_so_far, mesh(i)%x,                                        &
-                            mesh(i)%y, mesh(i)%x_s, mesh(i)%y_s
-                ALLOCATE( mesh(i)%connected_vertices(1:mesh(i)%noc),                               &
-                          mesh(i)%distance_to_vertex(1:mesh(i)%noc) )
-                DO  j = 1, mesh(i)%noc
-                   READ( 119 ) mesh(i)%connected_vertices(j),                                      &
-                               mesh(i)%distance_to_vertex(j)
-                ENDDO
-             ENDDO
-!
-!--             Read polygon data
-             READ( 119 ) size_of_pols
-             ALLOCATE( polygons(1:size_of_pols) )
-             DO  i = 1, size_of_pols
-                READ( 119 ) polygons(i)%nov
-                ALLOCATE( polygons(i)%vertices(0:polygons(i)%nov+1) )
-                DO  j = 0, polygons(i)%nov+1
-                   READ( 119 ) polygons(i)%vertices(j)%delete,                                     &
-                               polygons(i)%vertices(j)%x,                                          &
-                               polygons(i)%vertices(j)%y
-                ENDDO
-             ENDDO
-             CLOSE(119)
-
-          ENDIF
-#if defined( __parallel ) && ! defined ( __check )
-          CALL MPI_BARRIER( comm2d, ierr )
-#endif
-       ENDDO
-
-!
-!--    Allocate agent arrays and set attributes of the initial set of agents, which can be also
-!--    periodically released at later times.
-       ALLOCATE( agt_count  (nysg:nyng,nxlg:nxrg),                                                 &
-                 grid_agents(nysg:nyng,nxlg:nxrg) )
-!
-!--    Allocate dummy arrays for pathfinding
-       ALLOCATE( dummy_path_x(0:agt_path_size),                                                    &
-                 dummy_path_y(0:agt_path_size) )
-
-       number_of_agents = 0
-       sort_count_mas   = 0
-       agt_count        = 0
-
-!
-!--    Initialize counter for agent IDs
-       grid_agents%id_counter = 1
-
-!
-!--    Initialize all agents 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_agent%agent_mask = .FALSE.
-       zero_agent%block_nr      = -1
-       zero_agent%group         = 0
-       zero_agent%id            = 0_idp
-       zero_agent%path_counter  = agt_path_size
-       zero_agent%age           = 0.0_wp
-       zero_agent%age_m         = 0.0_wp
-       zero_agent%dt_sum        = 0.0_wp
-       zero_agent%clo           = 0.0_wp
-       zero_agent%energy_storage= 0.0_wp
-       zero_agent%force_x       = 0.0_wp
-       zero_agent%force_y       = 0.0_wp
-       zero_agent%origin_x      = 0.0_wp
-       zero_agent%origin_y      = 0.0_wp
-       zero_agent%speed_abs     = 0.0_wp
-       zero_agent%speed_e_x     = 0.0_wp
-       zero_agent%speed_e_y     = 0.0_wp
-       zero_agent%speed_des     = random_normal(desired_speed, des_sp_sig)
-       zero_agent%speed_x       = 0.0_wp
-       zero_agent%speed_y       = 0.0_wp
-       zero_agent%ipt           = 0.0_wp
-       zero_agent%x             = 0.0_wp
-       zero_agent%y             = 0.0_wp
-       zero_agent%path_x        = 0.0_wp
-       zero_agent%path_y        = 0.0_wp
-       zero_agent%t_x           = 0.0_wp
-       zero_agent%t_y           = 0.0_wp
-
-!
-!--    Set a seed value for the random number generator to be exclusively used for the agent code.
-!--    The generated random numbers should be different on the different PEs.
-       iran_agent = iran_agent + myid
-
-       CALL mas_create_agent( phase_init )
-
-    ENDIF
-
-!
-!-- To avoid programm abort, assign agents array to the local version of first grid cell.
-    number_of_agents = agt_count(nys,nxl)
-    agents => grid_agents(nys,nxl)%agents(1:number_of_agents)
-
- END SUBROUTINE mas_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Output of informative message about maximum agent number
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_last_actions
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string
-
-    IMPLICIT NONE
-
-    WRITE(message_string,'(A,I8,A)') 'The maximumn number of agents during this run was',          &
-                                     maximum_number_of_agents,                                     &
-                                     '&Consider adjusting the INPUT parameter'//                   &
-                                     '&dim_size_agtnum_manual accordingly for the next run.'
-
-    CALL message( 'mas_data_output_agents', 'PA0457', 0, 0, 0, 6, 0 )
-
- END SUBROUTINE mas_last_actions
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Finds the shortest path from a start position to a target position using the A*-algorithm
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_nav_a_star( start_x, start_y, target_x, target_y, nsteps )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  cur_node      !< current node of binary heap
-    INTEGER(iwp) ::  il            !< counter (x)
-    INTEGER(iwp) ::  neigh_node    !< neighbor node
-    INTEGER(iwp) ::  node_counter  !< binary heap node counter
-    INTEGER(iwp) ::  nsteps        !< number of steps
-    INTEGER(iwp) ::  path_ag       !< index of agent path
-    INTEGER(iwp) ::  som           !< size of mesh
-    INTEGER(iwp) ::  steps         !< steps along the path
-
-    LOGICAL ::  target_reached  !< flag
-
-    REAL(wp) ::  new_cost      !< updated cost to reach node
-    REAL(wp) ::  new_priority  !< priority of node to be added to queue
-    REAL(wp) ::  start_x       !< x-coordinate agent
-    REAL(wp) ::  start_y       !< y-coordinate agent
-    REAL(wp) ::  rn_gate       !< random number for corner gate
-    REAL(wp) ::  target_x      !< x-coordinate target
-    REAL(wp) ::  target_y      !< y-coordinate target
-!
-!-- Coordinate Type
-    TYPE coord
-       REAL(wp) ::  x    !< x-coordinate
-       REAL(wp) ::  x_s  !< x-coordinate (shifted)
-       REAL(wp) ::  y    !< y-coordinate
-       REAL(wp) ::  y_s  !< y-coordinate (shifted)
-    END TYPE coord
-
-    TYPE(coord), DIMENSION(:), ALLOCATABLE, TARGET ::  path      !< path array
-    TYPE(coord), DIMENSION(:), ALLOCATABLE, TARGET ::  tmp_path  !< temporary path for resizing
-
-    node_counter = 0
-!
-!-- Create temporary navigation mesh including agent and target positions
-    CALL mas_nav_create_tmp_mesh( start_x, start_y, target_x, target_y, som )
-    tmp_mesh(som)%cost_so_far = 0.0_wp
-!
-!-- Initialize priority queue
-    heap_count = 0_iwp
-    ALLOCATE( queue(0:100) )
-    target_reached = .FALSE.
-!
-!-- Add starting point (agent position) to frontier (the frontier consists of all the nodes that
-!-- are to be visited. The node with the smallest priority will be visited first. The priority
-!-- consists of the distance from the start node to this node plus a minimal guess (direct
-!-- distance) from this node to the goal). For the starting node, the priority is set to 0, as it's
-!-- the only node thus far.
-    CALL mas_heap_insert_item( som, 0.0_wp )
-    cur_node = som
-    DO WHILE ( heap_count > 0 )
-!
-!--    Step one: Pick lowest priority item from queue
-       node_counter = node_counter + 1
-       CALL mas_heap_extract_item(cur_node)
-!
-!--    Node 0 is the goal node
-       IF ( cur_node == 0 )  THEN
-          EXIT
-       ENDIF
-!
-!--    Loop over all of cur_node's neighbors
-       DO  il = 1, tmp_mesh(cur_node)%noc
-          neigh_node = tmp_mesh(cur_node)%connected_vertices(il)
-!
-!--       Check, if the way from the start node to this neigh_node via cur_node is shorter than the
-!--       previously found shortest path to it.
-!--       If so, replace said cost and add neigh_node to the frontier.
-!--       cost_so_far is initialized as 1.d12 so that all found distances should be smaller.
-          new_cost   = tmp_mesh(cur_node)%cost_so_far + tmp_mesh(cur_node)%distance_to_vertex(il)
-          IF ( new_cost < tmp_mesh(neigh_node)%cost_so_far )  THEN
-             tmp_mesh(neigh_node)%cost_so_far = new_cost
-             tmp_mesh(neigh_node)%origin_id   = cur_node
-!
-!--             Priority in the queue is cost_so_far + heuristic to goal
-             new_priority = new_cost                                                               &
-                            + heuristic(tmp_mesh(neigh_node)%x,                                    &
-                              tmp_mesh(neigh_node)%y, tmp_mesh(0)%x,                               &
-                              tmp_mesh(0)%y)
-             CALL mas_heap_insert_item(neigh_node,new_priority)
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!-- Add nodes to a path array. To do this, we must backtrack from the target node to its origin and
-!-- so on until a node is reached that has no origin (%origin_id == -1). This is the starting node.
-    DEALLOCATE( queue )
-    cur_node = 0
-    steps = 0
-    ALLOCATE( path(1:100) )
-    DO WHILE ( cur_node /= -1 )
-       steps = steps + 1
-!
-!--    Resize path array if necessary
-       IF ( steps > SIZE(path) )  THEN
-          ALLOCATE( tmp_path(1:steps-1) )
-          tmp_path(1:steps-1) = path(1:steps-1)
-          DEALLOCATE( path )
-          ALLOCATE( path(1:2*(steps-1)) )
-          path(1:steps-1) = tmp_path(1:steps-1)
-          DEALLOCATE( tmp_path )
-       ENDIF
-       path(steps)%x = tmp_mesh(cur_node)%x
-       path(steps)%y = tmp_mesh(cur_node)%y
-       path(steps)%x_s = tmp_mesh(cur_node)%x_s
-       path(steps)%y_s = tmp_mesh(cur_node)%y_s
-       cur_node = tmp_mesh(cur_node)%origin_id
-    ENDDO
-!
-!-- Add calculated intermittent targets to the path until either the target or the maximum number of
-!-- intermittent targets is reached.
-!-- Ignore starting point (reduce index by one), it is agent position.
-    dummy_path_x = -1
-    dummy_path_y = -1
-    path_ag = 1
-    steps = steps - 1
-    nsteps = 0
-    DO WHILE( steps > 0 .AND. path_ag <= agt_path_size )
-!
-!--    Each target point is randomly chosen along a line target along the bisector of the building
-!--    corner that starts at corner_gate_start and has a width of corner_gate_width. This is to
-!--    avoid clustering when opposing agent groups try to reach the same corner target.
-       rn_gate = random_function(iran_agent) * corner_gate_width + corner_gate_start
-       dummy_path_x(path_ag) = path(steps)%x + rn_gate * (path(steps)%x_s - path(steps)%x)
-       dummy_path_y(path_ag) = path(steps)%y + rn_gate * (path(steps)%y_s - path(steps)%y)
-       steps = steps - 1
-       path_ag = path_ag + 1
-       nsteps = nsteps + 1
-    ENDDO
-!
-!-- Set current intermittent target of this agent
-    DEALLOCATE( tmp_mesh, path )
-
- END SUBROUTINE mas_nav_a_star
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Adds a connection between two points of the navigation mesh (one-way: in_mp1 to in_mp2)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_nav_add_connection ( in_mp1, id2, in_mp2 )
-
-    IMPLICIT NONE
-
-    LOGICAL ::  connection_established  !< Flag to indicate if connection has already been established
-
-    INTEGER(iwp) ::  id2   !< ID of in_mp2
-    INTEGER(iwp) ::  il    !< local counter
-    INTEGER(iwp) ::  noc1  !< number of connections in in_mp1
-
-    INTEGER, DIMENSION(:), ALLOCATABLE ::  dum_cv  !< dummy array for connected_vertices
-
-    REAL(wp) ::  dist  !< Distance between the two points
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  dum_dtv
-
-    TYPE(mesh_point) ::  in_mp1  !< mesh point that gets a new connection
-    TYPE(mesh_point) ::  in_mp2  !< mesh point in_mp1 will be connected to
-
-    connection_established = .FALSE.
-!
-!-- Check if connection has already been established
-    noc1 = SIZE( in_mp1%connected_vertices )
-    DO  il = 1, in_mp1%noc
-       IF ( in_mp1%connected_vertices(il) == id2 )  THEN
-          connection_established = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( .NOT. connection_established )  THEN
-!
-!--    Resize arrays, if necessary
-       IF ( in_mp1%noc >= noc1 )  THEN
-          ALLOCATE( dum_cv(1:noc1),dum_dtv(1:noc1) )
-          dum_cv  = in_mp1%connected_vertices
-          dum_dtv = in_mp1%distance_to_vertex
-          DEALLOCATE( in_mp1%connected_vertices, in_mp1%distance_to_vertex )
-          ALLOCATE( in_mp1%connected_vertices(1:2*noc1),                                           &
-                    in_mp1%distance_to_vertex(1:2*noc1) )
-          in_mp1%connected_vertices         = -999
-          in_mp1%distance_to_vertex         = -999.
-          in_mp1%connected_vertices(1:noc1) = dum_cv
-          in_mp1%distance_to_vertex(1:noc1) = dum_dtv
-       ENDIF
-
-!
-!--    Add connection
-       in_mp1%noc = in_mp1%noc+1
-       dist = SQRT( (in_mp1%x - in_mp2%x)**2 + (in_mp1%y - in_mp2%y)**2 )
-       in_mp1%connected_vertices(in_mp1%noc) = id2
-       in_mp1%distance_to_vertex(in_mp1%noc) = dist
-    ENDIF
-
- END SUBROUTINE mas_nav_add_connection
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Adds a vertex (curren position of agent or target) to the existing tmp_mesh
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_nav_add_vertex_to_mesh ( in_mp, in_id )
-
-    IMPLICIT NONE
-
-
-    INTEGER(iwp) ::  in_id  !< vertex id of tested mesh point
-    INTEGER(iwp) ::  jl     !< mesh point counter
-    INTEGER(iwp) ::  pl     !< polygon counter
-    INTEGER(iwp) ::  vl     !< vertex counter
-    INTEGER(iwp) ::  pid_t  !< polygon id of tested mesh point
-    INTEGER(iwp) ::  vid_t  !< vertex id of tested mesh point
-
-    LOGICAL ::  intersection_found  !< flag
-    LOGICAL ::  is_left_n           !< local switch
-    LOGICAL ::  is_left_p           !< local switch
-    LOGICAL ::  is_right_n          !< local switch
-    LOGICAL ::  is_right_p          !< local switch
-
-    REAL(wp) ::  v1x  !< x-coordinate of test vertex 1 for intersection test
-    REAL(wp) ::  v1y  !< y-coordinate of test vertex 1 for intersection test
-    REAL(wp) ::  v2x  !< x-coordinate of test vertex 2 for intersection test
-    REAL(wp) ::  v2y  !< y-coordinate of test vertex 2 for intersection test
-    REAL(wp) ::  x    !< x-coordinate of current mesh point
-    REAL(wp) ::  x_t  !< x-coordinate of tested mesh point
-    REAL(wp) ::  y    !< y-coordinate of current mesh point
-    REAL(wp) ::  y_t  !< y-coordinate of tested mesh point
-
-    TYPE(mesh_point) ::  in_mp  !< Input mesh point
-!
-!--
-    x = in_mp%x
-    y = in_mp%y
-    DO  jl = 0, SIZE( tmp_mesh )-2
-       IF ( in_id == jl )  CYCLE
-!
-!--    Ignore mesh points with 0 connections
-       IF ( tmp_mesh(jl)%polygon_id /= -1 )  THEN
-          IF ( tmp_mesh(jl)%noc == 0 )  CYCLE
-       ENDIF
-       x_t = tmp_mesh(jl)%x
-       y_t = tmp_mesh(jl)%y
-       pid_t = tmp_mesh(jl)%polygon_id
-       vid_t = tmp_mesh(jl)%vertex_id
-!
-!--    If the connecting line between the target and a mesh point points into the mesh point's
-!--    polygon, no connection will be established between the two points. This is the case if the
-!--    previous (next, n) vertex of the polygon is right of the connecting line and the next
-!--    (previous, p) vertex of the polygon is left of the connecting line.
-       IF ( pid_t > 0  .AND.  pid_t <= SIZE( polygons ) )  THEN
-          is_left_p  = is_left(  x, y, x_t, y_t, polygons(pid_t)%vertices(vid_t-1)%x,              &
-                                 polygons(pid_t)%vertices(vid_t-1)%y )
-          is_left_n  = is_left(  x, y, x_t, y_t, polygons(pid_t)%vertices(vid_t+1)%x,              &
-                                 polygons(pid_t)%vertices(vid_t+1)%y )
-          is_right_p = is_right( x, y, x_t, y_t, polygons(pid_t)%vertices(vid_t-1)%x,              &
-                                 polygons(pid_t)%vertices(vid_t-1)%y )
-          is_right_n = is_right( x, y, x_t, y_t, polygons(pid_t)%vertices(vid_t+1)%x,              &
-                                 polygons(pid_t)%vertices(vid_t+1)%y )
-          IF ( ( is_left_p .AND. is_right_n )  .OR.  ( is_right_p .AND. is_left_n ) )  CYCLE
-       ENDIF
-!
-!--    For each edge of each polygon, check if it intersects with the potential connection. If at
-!--    least one intersection is found, no connection can be made.
-       intersection_found = .FALSE.
-       DO  pl = 1, SIZE( polygons )
-          DO  vl = 1, polygons(pl)%nov
-             v1x = polygons(pl)%vertices(vl)%x
-             v1y = polygons(pl)%vertices(vl)%y
-             v2x = polygons(pl)%vertices(vl+1)%x
-             v2y = polygons(pl)%vertices(vl+1)%y
-             intersection_found = intersect(x,y,x_t,y_t,v1x,v1y,v2x,v2y)
-             IF ( intersection_found )  THEN
-                EXIT
-             ENDIF
-          ENDDO
-          IF ( intersection_found )  EXIT
-       ENDDO
-       IF ( intersection_found )  CYCLE
-!
-!--    If neither of the above two tests was true, a connection will be established between the two
-!--    mesh points.
-       CALL mas_nav_add_connection(in_mp,jl, tmp_mesh(jl))
-       CALL mas_nav_add_connection(tmp_mesh(jl),in_id, in_mp)
-    ENDDO
-    CALL mas_nav_reduce_connections(in_mp)
-
- END SUBROUTINE mas_nav_add_vertex_to_mesh
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Creates a temporary copy of the navigation mesh to be used for pathfinding
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_nav_create_tmp_mesh( a_x, a_y, t_x, t_y, som )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  im   !< local mesh point counter
-    INTEGER(iwp) ::  noc  !< number of connetions
-    INTEGER(iwp) ::  som  !< size of mesh
-
-    REAL(wp) ::  a_x  !< x-coordinate agent
-    REAL(wp) ::  a_y  !< y-coordinate agent
-    REAL(wp) ::  t_x  !< x-coordinate target
-    REAL(wp) ::  t_y  !< y-coordinate target
-!
-!-- Give tmp_mesh the size of mesh
-    som = SIZE( mesh ) + 1
-    ALLOCATE( tmp_mesh(0:som) )
-!
-!-- Give the allocatable variables in tmp_mesh their respctive sizes
-    DO  im = 1, som-1
-       noc = mesh(im)%noc
-       ALLOCATE( tmp_mesh(im)%connected_vertices(1:noc) )
-       ALLOCATE( tmp_mesh(im)%distance_to_vertex(1:noc) )
-    ENDDO
-!
-!-- Copy mesh to tmp_mesh
-    tmp_mesh(1:som-1) = mesh(1:som-1)
-!
-!-- Add target point ...
-    CALL mas_nav_init_mesh_point(tmp_mesh(0),-1_iwp,-1_iwp,t_x, t_y)
-    CALL mas_nav_add_vertex_to_mesh(tmp_mesh(0),0_iwp)
-!
-!-- ... and start point to temp mesh
-    CALL mas_nav_init_mesh_point(tmp_mesh(som),-1_iwp,-1_iwp,a_x, a_y)
-    CALL mas_nav_add_vertex_to_mesh(tmp_mesh(som),som)
-
- END SUBROUTINE mas_nav_create_tmp_mesh
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Finds the shortest path from an agents' position to her target. As the actual pathfinding
-!> algorithm uses the obstacle corners and then shifts them outward after pathfinding, cases can
-!> occur in which the connection between these intermittent targets then intersect with obstacles.
-!> To remedy this the pathfinding algorithm is then run on every two subsequent intermittent targets
-!> iteratively and new intermittent targets may be added to the path this way.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_nav_find_path( nl )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  il            !< local counter
-    INTEGER(iwp) ::  jl            !< local counter
-    INTEGER(iwp) ::  kl            !< local counter
-    INTEGER(iwp) ::  nl            !< local agent counter
-    INTEGER(iwp) ::  nsteps_dummy  !< number of steps on path
-    INTEGER(iwp) ::  nsteps_total  !< number of steps on path
-
-    REAL(wp), DIMENSION(0:30) ::  ld_path_x  !< local dummy agent path to target (x)
-    REAL(wp), DIMENSION(0:30) ::  ld_path_y  !< local dummy agent path to target (y)
-!
-!-- Initialize agent path arrays
-    agents(nl)%path_x    = -1
-    agents(nl)%path_y    = -1
-    agents(nl)%path_x(0) = agents(nl)%x
-    agents(nl)%path_y(0) = agents(nl)%y
-!
-!-- Calculate initial path
-    CALL mas_nav_a_star( agents(nl)%x, agents(nl)%y, agents(nl)%t_x, agents(nl)%t_y, nsteps_total )
-!
-!-- Set the rest of the agent path that was just calculated
-    agents(nl)%path_x(1:nsteps_total) = dummy_path_x(1:nsteps_total)
-    agents(nl)%path_y(1:nsteps_total) = dummy_path_y(1:nsteps_total)
-!
-!-- Iterate through found path and check more intermittent targets need to be added. For this, run
-!-- pathfinding between every two consecutive intermittent targets.
-    DO  il = 0, MIN( agt_path_size-1, nsteps_total-1 )
-!
-!--    Pathfinding between two consecutive intermittent targets
-       CALL mas_nav_a_star( agents(nl)%path_x(il),   agents(nl)%path_y(il),                        &
-                            agents(nl)%path_x(il+1), agents(nl)%path_y(il+1),                      &
-                            nsteps_dummy )
-       nsteps_dummy = nsteps_dummy - 1
-!
-!--    If additional intermittent targets are found, add them to the path
-       IF ( nsteps_dummy > 0 )  THEN
-          ld_path_x = -1
-          ld_path_y = -1
-          ld_path_x(il+1:il+nsteps_dummy) = dummy_path_x(1:nsteps_dummy)
-          ld_path_y(il+1:il+nsteps_dummy) = dummy_path_y(1:nsteps_dummy)
-          kl = 1
-          DO  jl = il+1,nsteps_total
-            ld_path_x( il+nsteps_dummy+kl ) = agents(nl)%path_x(jl)
-            ld_path_y( il+nsteps_dummy+kl ) = agents(nl)%path_y(jl)
-            kl = kl + 1
-            IF ( kl > agt_path_size )  EXIT
-          ENDDO
-          nsteps_total = MIN( nsteps_total + nsteps_dummy, agt_path_size )
-          agents(nl)%path_x(il+1:nsteps_total) = ld_path_x(il+1:nsteps_total)
-          agents(nl)%path_y(il+1:nsteps_total) = ld_path_y(il+1:nsteps_total)
-       ENDIF
-
-    ENDDO
-!
-!-- Reset path counter to first intermittent target
-    agents(nl)%path_counter = 1
-
- END SUBROUTINE mas_nav_find_path
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reduces the size of connection array to the amount of actual connections after all connetions
-!> were added to a mesh point
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_nav_reduce_connections ( in_mp )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  noc  !< number of connections
-
-    INTEGER, DIMENSION(:), ALLOCATABLE ::  dum_cv    !< dummy connected_vertices
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  dum_dtv  !< dummy distance_to_vertex
-
-    TYPE(mesh_point) ::  in_mp
-
-    noc = in_mp%noc
-    ALLOCATE( dum_cv(1:noc),dum_dtv(1:noc) )
-    dum_cv  = in_mp%connected_vertices(1:noc)
-    dum_dtv = in_mp%distance_to_vertex(1:noc)
-    DEALLOCATE( in_mp%connected_vertices, in_mp%distance_to_vertex )
-    ALLOCATE( in_mp%connected_vertices(1:noc),                                                     &
-              in_mp%distance_to_vertex(1:noc) )
-    in_mp%connected_vertices(1:noc) = dum_cv(1:noc)
-    in_mp%distance_to_vertex(1:noc) = dum_dtv(1:noc)
-
- END SUBROUTINE mas_nav_reduce_connections
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initializes a point of the navigation mesh
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_nav_init_mesh_point ( in_mp, pid, vid, x, y )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  pid  !< polygon ID
-    INTEGER(iwp) ::  vid  !< vertex ID
-
-    REAL(wp) ::  x  !< x-coordinate
-    REAL(wp) ::  y  !< y-coordinate
-
-    TYPE(mesh_point) ::  in_mp  !< mesh point to be initialized
-
-    in_mp%origin_id          = -1
-    in_mp%polygon_id         = pid
-    in_mp%vertex_id          = vid
-    in_mp%cost_so_far        = 1.d12
-    in_mp%x                  = x
-    in_mp%y                  = y
-    in_mp%x_s                = x
-    in_mp%y_s                = y
-    ALLOCATE( in_mp%connected_vertices(1:100),                                                     &
-              in_mp%distance_to_vertex(1:100) )
-    in_mp%connected_vertices = -999
-    in_mp%distance_to_vertex = -999.
-    in_mp%noc                = 0
-
- END SUBROUTINE mas_nav_init_mesh_point
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reading of namlist from parin file
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_parin
-
-    USE control_parameters,                                                                        &
-        ONLY: agent_time_unlimited, multi_agent_system_end, multi_agent_system_start
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  line  !< dummy string for current line in namelist file
-
-    INTEGER(iwp)  ::  io_status  !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /agent_parameters/  a_rand_target,                                                    &
-                                 adx,                                                              &
-                                 ady,                                                              &
-                                 agent_maximum_age,                                                &
-                                 agent_time_unlimited,                                             &
-                                 alloc_factor_mas,                                                 &
-                                 asl,                                                              &
-                                 asn,                                                              &
-                                 asr,                                                              &
-                                 ass,                                                              &
-                                 at_x,                                                             &
-                                 at_y,                                                             &
-                                 bc_mas_lr,                                                        &
-                                 bc_mas_ns,                                                        &
-                                 coll_t_0,                                                         &
-                                 corner_gate_start,                                                &
-                                 corner_gate_width,                                                &
-                                 deallocate_memory_mas,                                            &
-                                 dim_size_agtnum_manual,                                           &
-                                 dim_size_factor_agtnum,                                           &
-                                 dist_to_int_target,                                               &
-                                 dt_agent,                                                         &
-                                 dt_arel,                                                          &
-                                 dt_write_agent_data,                                              &
-                                 end_time_arel,                                                    &
-                                 max_dist_from_path,                                               &
-                                 min_nr_agent,                                                     &
-                                 multi_agent_system_end,                                           &
-                                 multi_agent_system_start,                                         &
-                                 number_of_agent_groups,                                           &
-                                 radius_agent,                                                     &
-                                 random_start_position_agents,                                     &
-                                 read_agents_from_restartfile,                                     &
-                                 repuls_agent,                                                     &
-                                 repuls_wall,                                                      &
-                                 scan_radius_agent,                                                &
-                                 sigma_rep_agent,                                                  &
-                                 sigma_rep_wall,                                                   &
-                                 step_dealloc_mas,                                                 &
-                                 switch_off_module,                                                &
-                                 tau_accel_agent
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND ( 11 )
-    READ ( 11, agent_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    agent_parameters namelist was found and read correctly. Set flag that indicates that agents
-!--    are switched on.
-       IF ( .NOT. switch_off_module )  agents_active = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    agent_parameters namelist was found but contained errors. Print an error message including
-!--    the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'agent_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE mas_parin
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Routine for the whole processor
-!> Sort all agents into the 4 respective subgrid boxes
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_ps_sort_in_subboxes
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i           !< grid box (x)
-    INTEGER(iwp) ::  ip          !< counter (x)
-    INTEGER(iwp) ::  is          !< box counter
-    INTEGER(iwp) ::  j           !< grid box (y)
-    INTEGER(iwp) ::  jp          !< counter (y)
-    INTEGER(iwp) ::  m           !< sorting index
-    INTEGER(iwp) ::  n           !< agent index
-    INTEGER(iwp) ::  nn          !< agent counter
-    INTEGER(iwp) ::  sort_index  !< sorting index
-
-    INTEGER(iwp), DIMENSION(0:3) ::  sort_count  !< number of agents in one subbox
-
-    TYPE(agent_type), DIMENSION(:,:), ALLOCATABLE ::  sort_agents  !< sorted agent array
-
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          number_of_agents = agt_count(jp,ip)
-          IF ( number_of_agents <= 0 )  CYCLE
-          agents => grid_agents(jp,ip)%agents(1:number_of_agents)
-
-          nn = 0
-          sort_count = 0
-          ALLOCATE( sort_agents(number_of_agents, 0:3) )
-
-          DO  n = 1, number_of_agents
-             sort_index = 0
-
-             IF ( agents(n)%agent_mask )  THEN
-                nn = nn + 1
-!
-!--             Sorting agents with a binary scheme
-!--             sort_index=11_2=3_10 -> agent at the left,south subgridbox
-!--             sort_index=10_2=2_10 -> agent at the left,north subgridbox
-!--             sort_index=01_2=1_10 -> agent at the right,south subgridbox
-!--             sort_index=00_2=0_10 -> agent at the right,north subgridbox
-!--             For this the center of the gridbox is calculated
-                i = (agents(n)%x + 0.5_wp * dx) * ddx
-                j = (agents(n)%y + 0.5_wp * dy) * ddy
-
-                IF ( i == ip )  sort_index = sort_index + 2
-                IF ( j == jp )  sort_index = sort_index + 1
-
-                sort_count(sort_index) = sort_count(sort_index) + 1
-                m = sort_count(sort_index)
-                sort_agents(m,sort_index) = agents(n)
-                sort_agents(m,sort_index)%block_nr = sort_index
-             ENDIF
-          ENDDO
-
-          nn = 0
-          DO  is = 0,3
-             grid_agents(jp,ip)%start_index(is) = nn + 1
-             DO  n = 1,sort_count(is)
-                nn = nn + 1
-                agents(nn) = sort_agents(n,is)
-             ENDDO
-             grid_agents(jp,ip)%end_index(is) = nn
-          ENDDO
-
-          number_of_agents = nn
-          agt_count(jp,ip) = number_of_agents
-          DEALLOCATE( sort_agents )
-       ENDDO
-    ENDDO
-
- END SUBROUTINE mas_ps_sort_in_subboxes
-
-#if defined( __parallel )
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Move all agents not marked for deletion to lowest indices (packing)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_ps_pack
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  n   !< agent counter
-    INTEGER(iwp) ::  nn  !< number of agents
-!
-!-- Find out elements marked for deletion and move data from highest index values to these free
-!-- indices.
-    nn = number_of_agents
-
-    DO WHILE ( .NOT. agents(nn)%agent_mask )
-       nn = nn-1
-       IF ( nn == 0 )  EXIT
-    ENDDO
-
-    IF ( nn > 0 )  THEN
-       DO  n = 1, number_of_agents
-          IF ( .NOT. agents(n)%agent_mask )  THEN
-             agents(n) = agents(nn)
-             nn = nn - 1
-             DO WHILE ( .NOT. agents(nn)%agent_mask )
-                nn = nn-1
-                IF ( n == nn )  EXIT
-             ENDDO
-          ENDIF
-          IF ( n == nn )  EXIT
-       ENDDO
-    ENDIF
-
-!
-!-- The number of deleted agents has been determined in routines mas_boundary_conds,
-!-- mas_droplet_collision, and mas_eh_exchange_horiz.
-    number_of_agents = nn
-
- END SUBROUTINE mas_ps_pack
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sort agents in each sub-grid box into two groups: agents that already completed the LES
-!> timestep, and agents that need further timestepping to complete the LES timestep.
-!--------------------------------------------------------------------------------------------------!
-!    SUBROUTINE mas_ps_sort_timeloop_done
-!
-!       IMPLICIT NONE
-!
-!       INTEGER(iwp) :: end_index      !< agent end index for each sub-box
-!       INTEGER(iwp) :: i              !< index of agent grid box in x-direction
-!       INTEGER(iwp) :: j              !< index of agent grid box in y-direction
-!       INTEGER(iwp) :: n              !< running index for number of agents
-!       INTEGER(iwp) :: nb             !< index of subgrid boux
-!       INTEGER(iwp) :: nf             !< indices for agents in each sub-box that already finalized their substeps
-!       INTEGER(iwp) :: nnf            !< indices for agents in each sub-box that need further treatment
-!       INTEGER(iwp) :: num_finalized  !< number of agents in each sub-box that already finalized their substeps
-!       INTEGER(iwp) :: start_index    !< agent start index for each sub-box
-!
-!       TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: sort_agents  !< temporary agent array
-!
-!       DO  i = nxl, nxr
-!          DO  j = nys, nyn
-!
-!             number_of_agents = agt_count(j,i)
-!             IF ( number_of_agents <= 0 )  CYCLE
-!
-!             agents => grid_agents(j,i)%agents(1:number_of_agents)
-!
-!             DO  nb = 0, 3
-!
-!--             Obtain start and end index for each subgrid box
-!                start_index = grid_agents(j,i)%start_index(nb)
-!                end_index   = grid_agents(j,i)%end_index(nb)
-!
-!--             Allocate temporary array used for sorting
-!                ALLOCATE( sort_agents(start_index:end_index) )
-!
-!--             Determine number of agents already completed the LES
-!--             timestep, and write them into a temporary array
-!                nf = start_index
-!                num_finalized = 0
-!                DO  n = start_index, end_index
-!                   IF ( dt_3d - agents(n)%dt_sum < 1E-8_wp )  THEN
-!                      sort_agents(nf) = agents(n)
-!                      nf              = nf + 1
-!                      num_finalized   = num_finalized + 1
-!                   ENDIF
-!                ENDDO
-!
-!--             Determine number of agents that not completed the LES
-!--             timestep, and write them into a temporary array
-!                nnf = nf
-!                DO  n = start_index, end_index
-!                   IF ( dt_3d - agents(n)%dt_sum > 1E-8_wp )  THEN
-!                      sort_agents(nnf) = agents(n)
-!                      nnf              = nnf + 1
-!                   ENDIF
-!                ENDDO
-!
-!--             Write back sorted agents
-!                agents(start_index:end_index) =                          &
-!                                        sort_agents(start_index:end_index)
-!
-!--             Determine updated start_index, used to masked already
-!--             completed agents.
-!                grid_agents(j,i)%start_index(nb) =                     &
-!                                   grid_agents(j,i)%start_index(nb)    &
-!                                 + num_finalized
-!
-!--             Deallocate dummy array
-!                DEALLOCATE ( sort_agents )
-!
-!--             Finally, if number of non-completed agents is non zero
-!--             in any of the sub-boxes, set control flag appropriately.
-!                IF ( nnf > nf )                                             &
-!                   grid_agents(j,i)%time_loop_done = .FALSE.
-!
-!             ENDDO
-!          ENDDO
-!       ENDDO
-!
-!    END SUBROUTINE mas_ps_sort_timeloop_done
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calls social forces calculations
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_timestep_forces_call ( ip, jp )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ip  !< counter, x-direction
-    INTEGER(iwp) ::  jp  !< counter, y-direction
-    INTEGER(iwp) ::  n   !< loop variable over all agents in a grid box
-
-!
-!-- Get direction for all agents in current grid cell
-    CALL mas_agent_direction
-
-    DO  n = 1, number_of_agents
-
-       force_x = 0.0_wp
-       force_y = 0.0_wp
-
-       CALL mas_timestep_social_forces ( 'acceleration', n, ip, jp )
-
-       CALL mas_timestep_social_forces ( 'other_agents', n, ip, jp )
-
-       CALL mas_timestep_social_forces ( 'walls',        n, ip, jp )
-!
-!--    Update forces
-       agents(n)%force_x = force_x
-       agents(n)%force_y = force_y
-    ENDDO
-
- END SUBROUTINE mas_timestep_forces_call
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Euler timestep of agent transport
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_timestep
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  n  !< loop variable over all agents in a grid box
-
-    REAL(wp) ::  abs_v  !< absolute value of velocity
-    REAL(wp) ::  abs_f  !< absolute value of force
-
-    DO  n = 1, number_of_agents
-!
-!--    Limit absolute force to a maximum to prevent unrealistic acceleration
-       abs_f = SQRT( ( agents(n)%force_x )**2 + ( agents(n)%force_y )**2 )
-       IF ( abs_f > 20. )  THEN
-          agents(n)%force_x = agents(n)%force_x * 20. / abs_f
-          agents(n)%force_y = agents(n)%force_y * 20. / abs_f
-       ENDIF
-!
-!--    Update agent speed
-       agents(n)%speed_x = agents(n)%speed_x + agents(n)%force_x * dt_agent
-       agents(n)%speed_y = agents(n)%speed_y + agents(n)%force_y * dt_agent
-!
-!--    Reduction of agent speed to maximum agent speed
-       abs_v = SQRT( ( agents(n)%speed_x )**2 + ( agents(n)%speed_y )**2 )
-       IF ( abs_v > v_max_agent )  THEN
-          agents(n)%speed_x = agents(n)%speed_x * v_max_agent / abs_v
-          agents(n)%speed_y = agents(n)%speed_y * v_max_agent / abs_v
-       ENDIF
-!
-!--    Update agent position
-       agents(n)%x = agents(n)%x + agents(n)%speed_x * dt_agent
-       agents(n)%y = agents(n)%y + agents(n)%speed_y * dt_agent
-!
-!--    Update absolute value of agent speed
-       agents(n)%speed_abs = abs_v
-!
-!--    Increment the agent age and the total time that the agent has advanced within the agent
-!--    timestep procedure
-       agents(n)%age_m  = agents(n)%age
-       agents(n)%age    = agents(n)%age    + dt_agent
-       agents(n)%dt_sum = agents(n)%dt_sum + dt_agent
-!
-!--    Check whether there is still an agent that has not yet completed the total LES timestep
-       IF ( ( dt_3d - agents(n)%dt_sum ) > 1E-8_wp )  THEN
-          dt_3d_reached_l_mas = .FALSE.
-       ENDIF
-
-    ENDDO
-
- END SUBROUTINE mas_timestep
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates the Social Forces (Helbing and Molnar, 1995) that the agent experiences due to
-!> acceleration towards target and repulsion by obstacles
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_timestep_social_forces ( mode, nl, ip, jp )
-
-    IMPLICIT NONE
-
-    REAL(wp), PARAMETER ::  k_pl = 1.5  !< factor for collision avoidance
-
-    CHARACTER (LEN=*) ::  mode  !< identifier for the mode of calculation
-
-    INTEGER(iwp) ::  ij_dum      !< index of nearest wall
-    INTEGER(iwp) ::  il          !< index variable along x
-    INTEGER(iwp) ::  ip          !< index variable along x
-    INTEGER(iwp) ::  jl          !< index variable along y
-    INTEGER(iwp) ::  jp          !< index variable along y
-    INTEGER(iwp) ::  nl          !< loop variable over all agents in a grid box
-    INTEGER(iwp) ::  no          !< loop variable over all agents in a grid box
-    INTEGER(iwp) ::  noa         !< amount of agents in a grid box
-    INTEGER(iwp) ::  sc_x_end    !< index for scan for topography/other agents
-    INTEGER(iwp) ::  sc_x_start  !< index for scan for topography/other agents
-    INTEGER(iwp) ::  sc_y_end    !< index for scan for topography/other agents
-    INTEGER(iwp) ::  sc_y_start  !< index for scan for topography/other agents
-
-    LOGICAL ::  corner_found  !< flag that indicates a corner has been found near agent
-
-    REAL(wp) ::  a_pl             !< factor for collision avoidance
-    REAL(wp) ::  ax_semimaj       !< semiminor axis of repulsive ellipse
-    REAL(wp) ::  b_pl             !< factor for collision avoidance
-    REAL(wp) ::  c_pl             !< factor for collision avoidance
-    REAL(wp) ::  coll_t           !< time at which the next collision would happen
-    REAL(wp) ::  d_coll_t_0       !< inverse of collision cutoff time
-    REAL(wp) ::  d_pl             !< factor for collision avoidance
-    REAL(wp) ::  ddum_f           !< dummy devisor collision avoidance
-    REAL(wp) ::  dist             !< distance to obstacle
-    REAL(wp) ::  dist_sq          !< distance to obstacle squared
-    REAL(wp) ::  pos_rel_x        !< relative position of two agents (x)
-    REAL(wp) ::  pos_rel_y        !< relative position of two agents (y)
-    REAL(wp) ::  r_sq             !< y-position
-    REAL(wp) ::  sra              !< scan radius (agents)
-    REAL(wp) ::  srw              !< local variable for scan radius (walls)
-    REAL(wp) ::  v_rel_x          !< relative velocity (x); collision avoidance
-    REAL(wp) ::  v_rel_y          !< relative velocity (y); collision avoidance
-    REAL(wp) ::  x_a              !< x-position
-    REAL(wp) ::  x_wall           !< x-position of wall
-    REAL(wp) ::  y_a              !< y-position
-    REAL(wp) ::  y_wall           !< y-position of wall
-
-    TYPE(agent_type), DIMENSION(:), POINTER ::  l_agts  !< agents that repulse current agent
-
-!
-!-- Initialization
-    x_a = agents(nl)%x
-    y_a = agents(nl)%y
-
-    SELECT CASE ( TRIM( mode ) )
-!
-!--    Calculation of force due to agent trying to approach desired velocity
-       CASE ( 'acceleration' )
-
-          force_x = force_x + d_tau_accel_agent                                                    &
-                              * ( agents(nl)%speed_des*agents(nl)%speed_e_x - agents(nl)%speed_x )
-
-          force_y = force_y + d_tau_accel_agent                                                    &
-                              * ( agents(nl)%speed_des*agents(nl)%speed_e_y - agents(nl)%speed_y )
-
-!
-!--    Calculation of repulsive forces by other agents in a radius around the current one
-       CASE ( 'other_agents' )
-
-          sra = scan_radius_agent
-          d_coll_t_0 = 1./coll_t_0
-!
-!--       Find relevant gridboxes (those that could contain agents within scan radius)
-          sc_x_start = FLOOR( (x_a - sra) * ddx )
-          sc_x_end   = FLOOR( (x_a + sra) * ddx )
-          sc_y_start = FLOOR( (y_a - sra) * ddx )
-          sc_y_end   = FLOOR( (y_a + sra) * ddx )
-          IF ( sc_x_start < nxlg ) sc_x_start = nxlg
-          IF ( sc_x_end   > nxrg ) sc_x_end   = nxrg
-          IF ( sc_y_start < nysg ) sc_y_start = nysg
-          IF ( sc_y_end   > nyng ) sc_y_end   = nyng
-
-          sra = sra**2
-!
-!--       Loop over all previously found relevant gridboxes
-          DO  il = sc_x_start, sc_x_end
-             DO  jl = sc_y_start, sc_y_end
-                noa = agt_count(jl,il)
-                IF ( noa <= 0 )  CYCLE
-                l_agts => grid_agents(jl,il)%agents(1:noa)
-                DO  no = 1, noa
-!
-!--                Skip self
-                   IF ( jl == jp  .AND.  il == ip  .AND.  no == nl )  CYCLE
-                   pos_rel_x = l_agts(no)%x - x_a
-                   pos_rel_y = l_agts(no)%y - y_a
-                   dist_sq = pos_rel_x**2 + pos_rel_y**2
-                   IF ( dist_sq > sra )  CYCLE
-                   r_sq    = (2*radius_agent)**2
-                   v_rel_x   = agents(nl)%speed_x - l_agts(no)%speed_x
-                   v_rel_y   = agents(nl)%speed_y - l_agts(no)%speed_y
-!
-!--                Collision is already occuring, default to standard social forces.
-                   IF ( dist_sq <= r_sq )  THEN
-                      dist = SQRT( dist_sq ) + 1.0d-12
-                      ax_semimaj = 0.5_wp * SQRT( dist )
-
-                      force_x = force_x - 0.125_wp * repuls_agent                                  &
-                                     * d_sigma_rep_agent / ax_semimaj                              &
-                                     * EXP( - ax_semimaj * d_sigma_rep_agent )                     &
-                                     * ( pos_rel_x / dist )
-
-                      force_y = force_y - 0.125_wp * repuls_agent                                  &
-                                     * d_sigma_rep_agent / ax_semimaj                              &
-                                     * EXP( - ax_semimaj * d_sigma_rep_agent )                     &
-                                     * ( pos_rel_y / dist )
-!
-!--                Currently no collision, calculate collision avoidance force according to
-!--                Karamouzas et al (2014, PRL 113,238701)
-                   ELSE
-!
-!--                   Factors
-                      a_pl = v_rel_x**2 +  v_rel_y**2
-                      b_pl = pos_rel_x*v_rel_x + pos_rel_y*v_rel_y
-                      c_pl = dist_sq - r_sq
-                      d_pl = b_pl**2 - a_pl*c_pl
-!
-!--                   If the two agents are moving non-parallel, calculate collision avoidance
-!--                   social force
-                      IF ( d_pl > 0.0_wp  .AND.  ( a_pl < -0.00001 .OR. a_pl > 0.00001 ) )  THEN
-
-                         d_pl   = SQRT( d_pl )
-                         coll_t = ( b_pl - d_pl ) / a_pl
-                         IF ( coll_t > 0.0_wp )  THEN
-!
-!--                         Dummy factor
-                            ddum_f = 1. / ( a_pl * coll_t**2 ) * ( 2. / coll_t + 1.0 * d_coll_t_0 )
-!
-!--                         x-component of social force
-                            force_x = force_x - k_pl * EXP( -coll_t * d_coll_t_0 ) *               &
-                                      ( v_rel_x - ( b_pl * v_rel_x - a_pl * pos_rel_x ) / d_pl ) * &
-                                      ddum_f
-!
-!--                         y-component of social force
-                            force_y = force_y - k_pl * EXP( -coll_t * d_coll_t_0 ) *               &
-                                      ( v_rel_y - ( b_pl * v_rel_y - a_pl * pos_rel_y ) / d_pl ) * &
-                                      ddum_f
-
-                         ENDIF
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-
-       CASE ( 'walls' )
-
-          srw = scan_radius_wall
-          corner_found = .FALSE.
-!
-!--       Find relevant grid boxes (those that could contain topography within radius)
-          sc_x_start = (x_a - srw) * ddx
-          sc_x_end   = (x_a + srw) * ddx
-          sc_y_start = (y_a - srw) * ddx
-          sc_y_end   = (y_a + srw) * ddx
-          IF ( sc_x_start < nxlg ) sc_x_start = nxlg
-          IF ( sc_x_end   > nxrg ) sc_x_end   = nxrg
-          IF ( sc_y_start < nysg ) sc_y_start = nysg
-          IF ( sc_y_end   > nyng ) sc_y_end   = nyng
-!
-!--       Find "walls" ( i.e. topography steps (up or down) higher than one grid box ) that are
-!--       perpendicular to the agent within the defined search radius. Such obstacles cannot be
-!--       passed and a social force to that effect is applied.
-!--       Walls only apply a force perpendicular to the wall to the agent.
-!--       There is therefore a search for walls directly right, left, south and north of the agent.
-!--       All other walls are ignored.
-!--
-!--       Check for wall left of current agent
-          ij_dum = 0
-          IF ( sc_x_start < ip )  THEN
-             DO  il = ip - 1, sc_x_start, -1
-!
-!--             Going left from the agent, check for a right wall
-                IF ( BTEST( obstacle_flags(jp,il), 2 ) )  THEN
-!
-!--                Obstacle found in grid box il, wall at right side
-                   x_wall = (il+1)*dx
-!
-!--                Calculate force of found wall on agent
-                   CALL mas_timestep_wall_corner_force( x_a, x_wall, y_a, y_a )
-!
-!--                Calculate new x starting index for later scan for corners
-                   ij_dum = il + 1
-                   EXIT
-                ENDIF
-             ENDDO
-          ENDIF
-          IF ( ij_dum /= 0 ) sc_x_start = ij_dum
-
-!
-!--       Check for wall right of current agent
-          ij_dum = 0
-          IF ( sc_x_end > ip )  THEN
-             DO  il = ip + 1, sc_x_end
-!
-!--             Going right from the agent, check for a left wall
-                IF ( BTEST( obstacle_flags(jp,il), 6 ) )  THEN
-!
-!--                Obstacle found in grid box il, wall at left side
-                   x_wall = il*dx
-!
-!--                Calculate force of found wall on agent
-                   CALL mas_timestep_wall_corner_force( x_a, x_wall, y_a, y_a )
-!
-!--                Calculate new x end index for later scan for corners
-                   ij_dum = il - 1
-                   EXIT
-                ENDIF
-             ENDDO
-          ENDIF
-          IF ( ij_dum /= 0 ) sc_x_end = ij_dum
-
-!
-!--          Check for wall south of current agent
-          ij_dum = 0
-          IF ( sc_y_start < jp )  THEN
-             DO  jl = jp - 1, sc_y_start, -1
-!
-!--             Going south from the agent, check for a north wall
-                IF ( BTEST( obstacle_flags(jl,ip), 0 ) )  THEN
-!
-!--                Obstacle found in grid box jl, wall at left side
-                   y_wall = ( jl + 1 ) * dy
-
-                   CALL mas_timestep_wall_corner_force( x_a, x_a, y_a, y_wall )
-!
-!--                Calculate new y starting index for later scan for corners
-                   ij_dum = jl + 1
-                   EXIT
-                ENDIF
-             ENDDO
-          ENDIF
-          IF ( ij_dum /= 0 ) sc_y_start = ij_dum
-
-!
-!--       Check for wall north of current agent
-          ij_dum = 0
-          IF ( sc_y_end > jp )  THEN
-             DO  jl = jp + 1, sc_y_end
-!
-!--             Going north from the agent, check for a south wall
-                IF ( BTEST( obstacle_flags(jl,ip), 4 ) )  THEN
-!
-!--                   obstacle found in grid box jl, wall at left side
-                   y_wall = jl * dy
-
-                   CALL mas_timestep_wall_corner_force( x_a, x_a, y_a, y_wall )
-!
-!--                Calculate new y end index for later scan for corners
-                   ij_dum = jl - 1
-                ENDIF
-             ENDDO
-          ENDIF
-          IF ( ij_dum /= 0 ) sc_y_end = ij_dum
-
-!
-!--       Scan for corners surrounding current agent.
-!--       Only gridcells that are closer than the closest wall in each direction (n,s,r,l) are
-!--       considered in the search since those further away would have a significantly smaller
-!--       resulting force than the closer wall.
-          DO  il = sc_x_start, sc_x_end
-             DO  jl = sc_y_start, sc_y_end
-                IF ( il == ip  .OR.  jl == jp )  CYCLE
-!
-!--             Corners left of agent
-                IF ( il < ip )  THEN
-!
-!--                South left quadrant: look for north right corner
-                   IF ( jl < jp )  THEN
-                      IF ( BTEST( obstacle_flags(jl,il), 1 ) )  THEN
-!
-!--                      Calculate coordinates of the found corner
-                         x_wall = ( il + 1 ) * dx
-                         y_wall = ( jl + 1 ) * dy
-
-                         CALL mas_timestep_wall_corner_force( x_a, x_wall, y_a, y_wall )
-
-                      ENDIF
-!
-!--                North left quadrant: look for south right corner
-                   ELSEIF ( jl > jp )  THEN
-                      IF ( BTEST( obstacle_flags(jl,il), 3 ) )  THEN
-!
-!--                      Calculate coordinates of the corner of mentioned gridcell that is closest
-!--                      to the current agent.
-                         x_wall = ( il + 1 ) * dx
-                         y_wall = jl * dy
-
-                         CALL mas_timestep_wall_corner_force( x_a, x_wall, y_a, y_wall )
-
-                      ENDIF
-                   ENDIF
-                ELSEIF ( il > ip )  THEN
-!
-!--                South right quadrant: look for north left corner
-                   IF ( jl < jp )  THEN
-                      IF ( BTEST( obstacle_flags(jl,il), 7 ) )  THEN
-!
-!--                      Calculate coordinates of the corner of mentioned gridcell that is closest
-!--                      to the current agent.
-                         x_wall = il * dx
-                         y_wall = ( jl + 1 ) * dy
-
-                         CALL mas_timestep_wall_corner_force( x_a, x_wall, y_a, y_wall )
-
-                      ENDIF
-!
-!--                North right quadrant: look for south left corner
-                   ELSEIF ( jl > jp )  THEN
-                      IF ( BTEST( obstacle_flags(jl,il), 5 ) )  THEN
-!
-!--                      Calculate coordinates of the corner of mentioned gridcell that is closest
-!--                      to the current agent.
-                         x_wall = il * dx
-                         y_wall = jl * dy
-
-                         CALL mas_timestep_wall_corner_force( x_a, x_wall, y_a, y_wall )
-
-                      ENDIF
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-
-       CASE DEFAULT
-
-    END SELECT
-
- END SUBROUTINE mas_timestep_social_forces
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Given a distance to the current agent, calculates the force a found corner or wall exerts on that
-!> agent
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE mas_timestep_wall_corner_force( xa, xw, ya, yw )
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  dist_l     !< distance to obstacle
-    REAL(wp) ::  force_d_x  !< increment of social force, x-direction
-    REAL(wp) ::  force_d_y  !< increment of social force, x-direction
-    REAL(wp) ::  xa         !< x-position of agent
-    REAL(wp) ::  xw         !< x-position of wall
-    REAL(wp) ::  ya         !< x-position of agent
-    REAL(wp) ::  yw         !< y-position of wall
-
-    force_d_x = 0.0_wp
-    force_d_y = 0.0_wp
-!
-!-- Calculate coordinates of corner relative to agent postion and distance between corner and agent.
-    xw = xa - xw
-    yw = ya - yw
-    dist_l = SQRT( ( xw )**2 + ( yw )**2 )
-!
-!-- Calculate x and y component of repulsive force induced by previously found corner
-    IF ( dist_l > 0 )  THEN
-       force_d_x = repuls_wall * d_sigma_rep_wall                                                  &
-                   * EXP( -dist_l * d_sigma_rep_wall )                                             &
-                   * xw / (dist_l)
-       force_d_y = repuls_wall * d_sigma_rep_wall                                                  &
-                   * EXP( -dist_l * d_sigma_rep_wall )                                             &
-                   * yw / (dist_l)
-    ENDIF
-
-! !--    forces that are located outside of a sight radius of
-! !--    200 degrees (-> COS(100./180.*pi) = COS(.555*pi)) of
-! !--    current agent are considered to have an effect of 50%
-!        IF ( force_d_x * agents(nl)%speed_e_x +               &
-!             force_d_y * agents(nl)%speed_e_y <               &
-!             SQRT(force_d_x**2 + force_d_y**2) *              &
-!             COS( .55555555 * 3.1415 ) )                      &
-!        THEN
-!           force_d_x = force_d_x * .5_wp
-!           force_d_y = force_d_y * .5_wp
-!        ENDIF
-
-!
-!-- Add force increment to total force of current agent
-    force_x = force_x + force_d_x
-    force_y = force_y + force_d_y
-
- END SUBROUTINE mas_timestep_wall_corner_force
-
-
-!
-!-- Calculates distance of point P to edge (A,B). If A = B, calculates point-to-point distance from
-!-- A/B to P.
- FUNCTION dist_point_to_edge( a_x, a_y, b_x, b_y, p_x, p_y )
-
-    IMPLICIT NONE
-
-    REAL(wp)  :: a_x                 !< x-coordinate of point A of edge
-    REAL(wp)  :: a_y                 !< y-coordinate of point A of edge
-    REAL(wp)  :: ab_x                !< x-coordinate of vector from A to B
-    REAL(wp)  :: ab_y                !< y-coordinate of vector from A to B
-    REAL(wp)  :: ab_d                !< inverse length of vector from A to B
-    REAL(wp)  :: ab_u_x              !< x-coordinate of vector with direction of ab and length 1
-    REAL(wp)  :: ab_u_y              !< y-coordinate of vector with direction of ab and length 1
-    REAL(wp)  :: ap_x                !< x-coordinate of vector from A to P
-    REAL(wp)  :: ap_y                !< y-coordinate of vector from A to P
-    REAL(wp)  :: b_x                 !< x-coordinate of point B of edge
-    REAL(wp)  :: b_y                 !< y-coordinate of point B of edge
-    REAL(wp)  :: ba_x                !< x-coordinate of vector from B to A
-    REAL(wp)  :: ba_y                !< y-coordinate of vector from B to A
-    REAL(wp)  :: bp_x                !< x-coordinate of vector from B to P
-    REAL(wp)  :: bp_y                !< y-coordinate of vector from B to P
-    REAL(wp)  :: dist_x              !< x-coordinate of point P
-    REAL(wp)  :: dist_y              !< y-coordinate of point P
-    REAL(wp)  :: dist_point_to_edge  !< y-coordinate of point P
-    REAL(wp)  :: p_x                 !< x-coordinate of point P
-    REAL(wp)  :: p_y                 !< y-coordinate of point P
-
-    ab_x = - a_x + b_x
-    ab_y = - a_y + b_y
-    ba_x = - b_x + a_x
-    ba_y = - b_y + a_y
-    ap_x = - a_x + p_x
-    ap_y = - a_y + p_y
-    bp_x = - b_x + p_x
-    bp_y = - b_y + p_y
-
-    IF ( ab_x * ap_x + ab_y * ap_y <= 0. )  THEN
-       dist_point_to_edge = SQRT( ( a_x - p_x )**2 + ( a_y - p_y )**2 )
-    ELSEIF ( ba_x * bp_x + ba_y * bp_y <= 0. )  THEN
-       dist_point_to_edge = SQRT( ( b_x - p_x )**2 + ( b_y - p_y )**2)
-    ELSE
-       ab_d = 1.0_wp / SQRT( ( ab_x )**2 + ( ab_y )**2 )
-       ab_u_x = ab_x * ab_d
-       ab_u_y = ab_y * ab_d
-       dist_x = ap_x - ( ap_x * ab_u_x + ap_y * ab_u_y ) * ab_u_x
-       dist_y = ap_y - ( ap_x * ab_u_x + ap_y * ab_u_y ) * ab_u_y
-       dist_point_to_edge = SQRT( dist_x**2 + dist_y**2 )
-    ENDIF
-
- END FUNCTION dist_point_to_edge
-
-!
-!-- Returns the heuristic between points A and B (currently the straight distance)
- FUNCTION heuristic( ax, ay, bx, by )
-
-    IMPLICIT NONE
-
-    REAL(wp)  :: ax           !< x-coordinate of point A
-    REAL(wp)  :: ay           !< y-coordinate of point A
-    REAL(wp)  :: bx           !< x-coordinate of point B
-    REAL(wp)  :: by           !< y-coordinate of point B
-    REAL(wp)  :: heuristic    !< return value
-
-    heuristic = SQRT( ( ax - bx )**2 + ( ay - by )**2 )
-
- END FUNCTION heuristic
-
-!
-!-- Calculates if point P is left of the infinite line that contains A and B (direction: A to B).
-!-- Concept: 2D rotation of two vectors
- FUNCTION is_left( ax, ay, bx, by, px, py )
-
-    IMPLICIT NONE
-
-    LOGICAL  :: is_left !< return value; TRUE if P is left of AB
-
-    REAL(wp)  :: ax     !< x-coordinate of point A
-    REAL(wp)  :: ay     !< y-coordinate of point A
-    REAL(wp)  :: bx     !< x-coordinate of point B
-    REAL(wp)  :: by     !< y-coordinate of point B
-    REAL(wp)  :: px     !< x-coordinate of point P
-    REAL(wp)  :: py     !< y-coordinate of point P
-
-    is_left = (bx-ax)*(py-ay)-(px-ax)*(by-ay) > 0
-    IF ( ( ABS( ax - px ) < .001 .AND. ABS( ay - py ) < .001 )  .OR.                               &
-         ( ABS( bx - px ) < .001 .AND. ABS( by - py ) < .001) )                                    &
-    THEN
-       is_left = .FALSE.
-    ENDIF
-
- END FUNCTION is_left
-
-!
-!-- Calculates if point P is right of the infinite line that contains A and B (direction: A to B)
-!-- Concept: 2D rotation of two vectors
- FUNCTION is_right( ax, ay, bx, by, px, py )
-
-    IMPLICIT NONE
-
-    LOGICAL  :: is_right !< return value; TRUE if P is right of AB
-
-    REAL(wp), INTENT(IN)  :: ax     !< x-coordinate of point A
-    REAL(wp), INTENT(IN)  :: ay     !< y-coordinate of point A
-    REAL(wp), INTENT(IN)  :: bx     !< x-coordinate of point B
-    REAL(wp), INTENT(IN)  :: by     !< y-coordinate of point B
-    REAL(wp), INTENT(IN)  :: px     !< x-coordinate of point P
-    REAL(wp), INTENT(IN)  :: py     !< y-coordinate of point P
-
-    is_right = (bx-ax)*(py-ay)-(px-ax)*(by-ay) < 0
-    IF ( ( ABS( ax - px ) < 0.001_wp .AND. ABS( ay - py ) < 0.001_wp )  .OR.                       &
-         ( ABS( bx - px ) < 0.001_wp .AND. ABS( by - py ) < 0.001_wp ) )                           &
-    THEN
-       is_right = .FALSE.
-    ENDIF
-
- END FUNCTION is_right
-
-!
-!-- Returns true if the line segments AB and PQ share an intersection
- FUNCTION intersect( ax, ay, bx, by, px, py, qx, qy )
-
-    IMPLICIT NONE
-
-    LOGICAL  :: intersect !< return value; TRUE if intersection was found
-    LOGICAL  :: la        !< T if a is left of PQ
-    LOGICAL  :: lb        !< T if b is left of PQ
-    LOGICAL  :: lp        !< T if p is left of AB
-    LOGICAL  :: lq        !< T if q is left of AB
-    LOGICAL  :: poss      !< flag that indicates if an intersection is still possible
-    LOGICAL  :: ra        !< T if a is right of PQ
-    LOGICAL  :: rb        !< T if b is right of PQ
-    LOGICAL  :: rp        !< T if p is right of AB
-    LOGICAL  :: rq        !< T if q is right of AB
-
-    REAL(wp)  :: ax     !< x-coordinate of point A
-    REAL(wp)  :: ay     !< y-coordinate of point A
-    REAL(wp)  :: bx     !< x-coordinate of point B
-    REAL(wp)  :: by     !< y-coordinate of point B
-    REAL(wp)  :: px     !< x-coordinate of point P
-    REAL(wp)  :: py     !< y-coordinate of point P
-    REAL(wp)  :: qx     !< x-coordinate of point Q
-    REAL(wp)  :: qy     !< y-coordinate of point Q
-
-    intersect = .FALSE.
-    poss      = .FALSE.
-!
-!-- Intersection is possible only if P and Q are on opposing sides of AB
-    lp = is_left(ax,ay,bx,by,px,py)
-    rq = is_right(ax,ay,bx,by,qx,qy)
-    IF ( lp  .AND.  rq )  poss = .TRUE.
-    IF ( .NOT. poss )  THEN
-       lq = is_left(ax,ay,bx,by,qx,qy)
-       rp = is_right(ax,ay,bx,by,px,py)
-       IF ( lq  .AND.  rp )  poss = .TRUE.
-    ENDIF
-!
-!-- Intersection occurs only if above test (poss) was true AND A and B are on opposing sides of PQ.
-    IF ( poss )  THEN
-       la = is_left(px,py,qx,qy,ax,ay)
-       rb = is_right(px,py,qx,qy,bx,by)
-       IF ( la  .AND.  rb )  intersect = .TRUE.
-       IF ( .NOT. intersect )  THEN
-          lb = is_left(px,py,qx,qy,bx,by)
-          ra = is_right(px,py,qx,qy,ax,ay)
-          IF ( lb  .AND.  ra )  intersect = .TRUE.
-       ENDIF
-    ENDIF
-
- END FUNCTION intersect
-
-!
-!-- Gives a nuber randomly distributed around an average
- FUNCTION random_normal( avg, variation )
-
-    IMPLICIT NONE
-
-    REAL(wp)  :: avg            !< x-coordinate of vector from A to B
-    REAL(wp)  :: random_normal  !< y-coordinate of vector from A to B
-    REAL(wp)  :: variation      !< y-coordinate of vector from A to B
-
-    REAL(wp), DIMENSION(12)  :: random_arr  !< inverse length of vector from A to B
-
-    CALL RANDOM_NUMBER( random_arr )
-    random_normal = avg + variation * ( SUM( random_arr ) - 6.0_wp )
-
- END FUNCTION random_normal
-
-
- END MODULE multi_agent_system_mod
Index: palm/trunk/SOURCE/nesting_offl_mod.f90
===================================================================
--- palm/trunk/SOURCE/nesting_offl_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,3094 +1,0 @@
-!> @file nesting_offl_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4834 2021-01-07 10:28:00Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Bugfix in obtaining the correct timestamp in case of restart runs
-!
-! 4724 2020-10-06 17:20:39Z suehring $
-! - Enable LOD=1 input of boundary conditions
-! - Minor bugfix - add missing initialization of the top boundary
-!
-! 4582 2020-06-29 09:22:11Z suehring
-! Remove unused variable
-!
-! 4581 2020-06-29 08:49:58Z suehring
-! Omit explicit pressure forcing via geostrophic wind components in case of mesoscale nesting.
-!
-! 4561 2020-06-12 07:05:56Z suehring
-! Adapt mass-flux correction also for the anelastic approximation
-!
-! 4561 2020-06-12 07:05:56Z suehring
-! use statement for exchange horiz added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Bugfix, time coordinate is relative to origin_time rather than to 00:00:00 UTC.
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4286 2019-10-30 16:01:14Z resler
-! Fix wrong checks of time from dynamic driver in nesting_offl_mod
-!
-! 4273 2019-10-24 13:40:54Z monakurppa
-! Add a logical switch nesting_offline_chem
-!
-! 4270 2019-10-23 10:46:20Z monakurppa
-! Implement offline nesting for salsa variables.
-!
-! 4231 2019-09-12 11:22:00Z suehring
-! Bugfix in array deallocation
-!
-! 4230 2019-09-11 13:58:14Z suehring
-! Update mean chemistry profiles. These are also used for rayleigh damping.
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod
-!
-! - Data input moved into nesting_offl_mod
-! - check rephrased
-! - time variable is now relative to time_utc_init
-! - Define module specific data type for offline nesting in nesting_offl_mod
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4169 2019-08-19 13:54:35Z suehring
-! Additional check added.
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4125 2019-07-29 13:31:44Z suehring
-! In order to enable netcdf parallel access, allocate dummy arrays for the lateral boundary data on
-! cores that actually do not belong to these boundaries.
-!
-! 4079 2019-07-09 18:04:41Z suehring
-! - Set boundary condition for w at nzt+1 at the lateral boundaries, even though these won't enter
-!   the numerical solution. However, due to the mass conservation these values might some up to very
-!   large values which will occur in the run-control file
-! - Bugfix in offline nesting of chemical species
-! - Do not set Neumann conditions for TKE and passive scalar
-!
-! 4022 2019-06-12 11:52:39Z suehring
-! Detection of boundary-layer depth in stable boundary layer on basis of boundary data improved
-! Routine for boundary-layer depth calculation renamed and made public
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3964 2019-05-09 09:48:32Z suehring
-! Ensure that veloctiy term in calculation of bulk Richardson number does not become zero
-!
-! 3937 2019-04-29 15:09:07Z suehring
-! Set boundary conditon on upper-left and upper-south grid point for the u- and v-component,
-! respectively.
-!
-! 3891 2019-04-12 17:52:01Z suehring
-! Bugfix, do not overwrite lateral and top boundary data in case of restart runs.
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-!
-! Do local data exchange for chemistry variables only when boundary data is coming from dynamic file
-!
-! 3737 2019-02-12 16:57:06Z suehring
-! Introduce mesoscale nesting for chemical species
-!
-! 3705 2019-01-29 19:56:39Z suehring
-! Formatting adjustments
-!
-! 3704 2019-01-29 19:51:41Z suehring
-! Check implemented for offline nesting in child domain
-!
-! Initial Revision:
-! - separate offline nesting from large_scale_nudging_mod
-! - revise offline nesting, adjust for usage of synthetic turbulence generator
-! - adjust Rayleigh damping depending on the time-depending atmospheric conditions
-!
-!
-! Description:
-! ------------
-!> Offline nesting in larger-scale models. Boundary conditions for the simulation are read from
-!> NetCDF file and are prescribed onto the respective arrays.
-!> Further, a mass-flux correction is performed to maintain the mass balance.
-!--------------------------------------------------------------------------------------------------!
- MODULE nesting_offl_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  diss,                                                                               &
-               drho_air_zw,                                                                        &
-               dzw,                                                                                &
-               e,                                                                                  &
-               pt,                                                                                 &
-               pt_init,                                                                            &
-               q,                                                                                  &
-               q_init,                                                                             &
-               rdf,                                                                                &
-               rdf_sc,                                                                             &
-               rho_air,                                                                            &
-               rho_air_zw,                                                                         &
-               s,                                                                                  &
-               u,                                                                                  &
-               u_init,                                                                             &
-               ug,                                                                                 &
-               v,                                                                                  &
-               v_init,                                                                             &
-               vg,                                                                                 &
-               w,                                                                                  &
-               zu,                                                                                 &
-               zw
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  g,                                                                                  &
-               pi
-
-    USE chem_modules,                                                                              &
-        ONLY:  chem_species, nesting_offline_chem
-
-    USE control_parameters,                                                                        &
-        ONLY:  air_chemistry,                                                                      &
-               bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               coupling_char,                                                                      &
-               constant_diffusion,                                                                 &
-               child_domain,                                                                       &
-               debug_output_timestep,                                                              &
-               dt_3d,                                                                              &
-               dz,                                                                                 &
-               end_time,                                                                           &
-               humidity,                                                                           &
-               initializing_actions,                                                               &
-               message_string,                                                                     &
-               nesting_offline,                                                                    &
-               neutral,                                                                            &
-               passive_scalar,                                                                     &
-               rans_mode,                                                                          &
-               rans_tke_e,                                                                         &
-               rayleigh_damping_factor,                                                            &
-               rayleigh_damping_height,                                                            &
-               salsa,                                                                              &
-               spinup_time,                                                                        &
-               time_since_reference_point,                                                         &
-               volume_flow
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point,                                                                          &
-               log_point_s
-
-    USE grid_variables
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nys, nysv, nysg, nyn, nyng, nzb, nz, nzt, &
-               topo_top_ind, wall_flags_total_0
-
-    USE kinds
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  char_fill,                                                                          &
-               char_lod,                                                                           &
-               check_existence,                                                                    &
-               close_input_file,                                                                   &
-               get_attribute,                                                                      &
-               get_dimension_length,                                                               &
-               get_variable,                                                                       &
-               get_variable_pr,                                                                    &
-               input_pids_dynamic,                                                                 &
-               inquire_num_variables,                                                              &
-               inquire_variable_names,                                                             &
-               input_file_dynamic,                                                                 &
-               num_var_pids,                                                                       &
-               open_read_file,                                                                     &
-               pids_id
-
-    USE pegrid
-
-    USE salsa_mod,                                                                                 &
-        ONLY:  salsa_nesting_offl_bc,                                                              &
-               salsa_nesting_offl_init,                                                            &
-               salsa_nesting_offl_input
-
-    IMPLICIT NONE
-
-!
-!-- Define data type for nesting in larger-scale models like COSMO.
-!-- Data type comprises u, v, w, pt, and q at lateral and top boundaries.
-    TYPE nest_offl_type
-
-       CHARACTER(LEN=16) ::  char_l = 'ls_forcing_left_'   !< leading substring for variables at left boundary
-       CHARACTER(LEN=17) ::  char_n = 'ls_forcing_north_'  !< leading substring for variables at north boundary
-       CHARACTER(LEN=17) ::  char_r = 'ls_forcing_right_'  !< leading substring for variables at right boundary
-       CHARACTER(LEN=17) ::  char_s = 'ls_forcing_south_'  !< leading substring for variables at south boundary
-       CHARACTER(LEN=15) ::  char_t = 'ls_forcing_top_'    !< leading substring for variables at top boundary
-
-       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names         !< list of variable in dynamic input file
-       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_l  !< names of mesoscale nested chemistry variables at left
-                                                                           !< boundary
-       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_n  !< names of mesoscale nested chemistry variables at north
-                                                                           !< boundary
-       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_r  !< names of mesoscale nested chemistry variables at right
-                                                                           !< boundary
-       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_s  !< names of mesoscale nested chemistry variables at south
-                                                                           !< boundary
-       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_t  !< names of mesoscale nested chemistry variables at top
-                                                                           !< boundary
-
-       INTEGER(iwp) ::  lod_east_pt  = 2  !< level-of-detail of input data of potential temperature at the eastern boundary
-       INTEGER(iwp) ::  lod_east_qc  = 2  !< level-of-detail of input data of cloud-water mixture fraction at the eastern boundary
-       INTEGER(iwp) ::  lod_east_qv  = 2  !< level-of-detail of input data of specific humidity at the eastern boundary
-       INTEGER(iwp) ::  lod_east_u   = 2  !< level-of-detail of input data of the u-component at the eastern boundary
-       INTEGER(iwp) ::  lod_east_v   = 2  !< level-of-detail of input data of the v-component at the eastern boundary
-       INTEGER(iwp) ::  lod_east_w   = 2  !< level-of-detail of input data of the w-component at the eastern boundary
-       INTEGER(iwp) ::  lod_north_pt = 2  !< level-of-detail of input data of potential temperature at the northern boundary
-       INTEGER(iwp) ::  lod_north_qc = 2  !< level-of-detail of input data of cloud-water mixture fraction at the northern boundary
-       INTEGER(iwp) ::  lod_north_qv = 2  !< level-of-detail of input data of specific humidity at the northern boundary
-       INTEGER(iwp) ::  lod_north_u  = 2  !< level-of-detail of input data of the u-component at the northern boundary
-       INTEGER(iwp) ::  lod_north_v  = 2  !< level-of-detail of input data of the v-component at the northern boundary
-       INTEGER(iwp) ::  lod_north_w  = 2  !< level-of-detail of input data of the w-component at the northern boundary
-       INTEGER(iwp) ::  lod_south_pt = 2  !< level-of-detail of input data of potential temperature at the southern boundary
-       INTEGER(iwp) ::  lod_south_qc = 2  !< level-of-detail of input data of cloud-water mixture fraction at the southern boundary
-       INTEGER(iwp) ::  lod_south_qv = 2  !< level-of-detail of input data of specific humidity at the southern boundary
-       INTEGER(iwp) ::  lod_south_u  = 2  !< level-of-detail of input data of the u-component at the southern boundary
-       INTEGER(iwp) ::  lod_south_v  = 2  !< level-of-detail of input data of the v-component at the southern boundary
-       INTEGER(iwp) ::  lod_south_w  = 2  !< level-of-detail of input data of the w-component at the southern boundary
-       INTEGER(iwp) ::  lod_top_pt   = 2  !< level-of-detail of input data of potential temperature at the top boundary
-       INTEGER(iwp) ::  lod_top_qc   = 2  !< level-of-detail of input data of cloud-water mixture fraction at the top boundary
-       INTEGER(iwp) ::  lod_top_qv   = 2  !< level-of-detail of input data of specific humidity at the top boundary
-       INTEGER(iwp) ::  lod_top_u    = 2  !< level-of-detail of input data of the u-component at the top boundary
-       INTEGER(iwp) ::  lod_top_v    = 2  !< level-of-detail of input data of the v-component at the top boundary
-       INTEGER(iwp) ::  lod_top_w    = 2  !< level-of-detail of input data of the w-component at the top boundary
-       INTEGER(iwp) ::  lod_west_pt  = 2  !< level-of-detail of input data of potential temperature at the western boundary
-       INTEGER(iwp) ::  lod_west_qc  = 2  !< level-of-detail of input data of cloud-water mixture fraction at the western boundary
-       INTEGER(iwp) ::  lod_west_qv  = 2  !< level-of-detail of input data of specific humidity at the western boundary
-       INTEGER(iwp) ::  lod_west_u   = 2  !< level-of-detail of input data of the u-component at the western boundary
-       INTEGER(iwp) ::  lod_west_v   = 2  !< level-of-detail of input data of the v-component at the western boundary
-       INTEGER(iwp) ::  lod_west_w   = 2  !< level-of-detail of input data of the w-component at the western boundary
-       INTEGER(iwp) ::  nt                !< number of time levels in dynamic input file
-       INTEGER(iwp) ::  nzu               !< number of vertical levels on scalar grid in dynamic input file
-       INTEGER(iwp) ::  nzw               !< number of vertical levels on w grid in dynamic input file
-       INTEGER(iwp) ::  tind = 0          !< time index for reference time in mesoscale-offline nesting
-       INTEGER(iwp) ::  tind_p = 0        !< time index for following time in mesoscale-offline nesting
-
-       LOGICAL      ::  init = .FALSE.    !< flag indicating that offline nesting is already initialized
-
-       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_l  !< flags inidicating whether left boundary data for chemistry is in
-                                                                !< dynamic input file
-       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_n  !< flags inidicating whether north boundary data for chemistry is in
-                                                                !< dynamic input file
-       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_r  !< flags inidicating whether right boundary data for chemistry is in
-                                                                !< dynamic input file
-       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_s  !< flags inidicating whether south boundary data for chemistry is in
-                                                                !< dynamic input file
-       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_t  !< flags inidicating whether top boundary data for chemistry is in
-                                                                !< dynamic input file
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surface_pressure  !< time dependent surface pressure
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time              !< time levels in dynamic input file
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu_atmos          !< vertical levels at scalar grid in dynamic input file
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw_atmos          !< vertical levels at w grid in dynamic input file
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ug         !< domain-averaged geostrophic component
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vg         !< domain-averaged geostrophic component
-
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_l     !< potentital temperautre at left boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_n     !< potentital temperautre at north boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_r     !< potentital temperautre at right boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_s     !< potentital temperautre at south boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_top   !< potentital temperautre at top boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_l      !< mixing ratio at left boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_n      !< mixing ratio at north boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_r      !< mixing ratio at right boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_s      !< mixing ratio at south boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_top    !< mixing ratio at top boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_l      !< u-component at left boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_n      !< u-component at north boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_r      !< u-component at right boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_s      !< u-component at south boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_top    !< u-component at top boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_l      !< v-component at left boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_n      !< v-component at north boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_r      !< v-component at right boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_s      !< v-component at south boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_top    !< v-component at top boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_l      !< w-component at left boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_n      !< w-component at north boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_r      !< w-component at right boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_s      !< w-component at south boundary
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_top    !< w-component at top boundary
-
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_l   !< chemical species at left boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_n   !< chemical species at north boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_r   !< chemical species at right boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_s   !< chemical species at south boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_top !< chemical species at left boundary
-
-    END TYPE nest_offl_type
-
-    INTEGER(iwp) ::  i_bound     !< boundary grid point in x-direction for scalars, v, and w
-    INTEGER(iwp) ::  i_bound_u   !< boundary grid point in x-direction for u
-    INTEGER(iwp) ::  i_end       !< end index for array allocation along x-direction at norther/southern boundary
-    INTEGER(iwp) ::  i_start     !< start index for array allocation along x-direction at norther/southern boundary (scalars, v, w)
-    INTEGER(iwp) ::  i_start_u   !< start index for array allocation along x-direction at norther/southern boundary (u)
-    INTEGER(iwp) ::  j_bound     !< boundary grid point in y-direction for scalars, u, and w
-    INTEGER(iwp) ::  j_bound_v   !< boundary grid point in y-direction for v
-    INTEGER(iwp) ::  j_end       !< end index for array allocation along y-direction at eastern/western boundary
-    INTEGER(iwp) ::  j_start     !< start index for array allocation along y-direction at eastern/western boundary (scalars, u, w)
-    INTEGER(iwp) ::  j_start_v   !< start index for array allocation along y-direction at eastern/western boundary (v)
-    INTEGER(iwp) ::  lod         !< level-of-detail of lateral input data
-
-    REAL(wp) ::  fac_dt              !< interpolation factor
-    REAL(wp) ::  zi_ribulk = 0.0_wp  !< boundary-layer depth according to bulk Richardson criterion, i.e. the height where Ri_bulk
-                                     !< exceeds the critical bulk Richardson number of 0.2
-
-    TYPE(nest_offl_type) ::  nest_offl  !< data structure for data input at lateral and top boundaries (provided by Inifor)
-
-    SAVE
-    PRIVATE
-!
-!-- Public subroutines
-    PUBLIC nesting_offl_bc,                                                                        &
-           nesting_offl_calc_zi,                                                                   &
-           nesting_offl_check_parameters,                                                          &
-           nesting_offl_geostrophic_wind,                                                          &
-           nesting_offl_header,                                                                    &
-           nesting_offl_init,                                                                      &
-           nesting_offl_input,                                                                     &
-           nesting_offl_interpolation_factor,                                                      &
-           nesting_offl_mass_conservation,                                                         &
-           nesting_offl_parin
-!
-!-- Public variables
-    PUBLIC zi_ribulk
-
-    INTERFACE nesting_offl_bc
-       MODULE PROCEDURE nesting_offl_bc
-    END INTERFACE nesting_offl_bc
-
-    INTERFACE nesting_offl_calc_zi
-       MODULE PROCEDURE nesting_offl_calc_zi
-    END INTERFACE nesting_offl_calc_zi
-
-    INTERFACE nesting_offl_check_parameters
-       MODULE PROCEDURE nesting_offl_check_parameters
-    END INTERFACE nesting_offl_check_parameters
-
-    INTERFACE nesting_offl_geostrophic_wind
-       MODULE PROCEDURE nesting_offl_geostrophic_wind
-    END INTERFACE nesting_offl_geostrophic_wind
-
-    INTERFACE nesting_offl_header
-       MODULE PROCEDURE nesting_offl_header
-    END INTERFACE nesting_offl_header
-
-    INTERFACE nesting_offl_init
-       MODULE PROCEDURE nesting_offl_init
-    END INTERFACE nesting_offl_init
-
-    INTERFACE nesting_offl_input
-       MODULE PROCEDURE nesting_offl_input
-    END INTERFACE nesting_offl_input
-
-    INTERFACE nesting_offl_interpolation_factor
-       MODULE PROCEDURE nesting_offl_interpolation_factor
-    END INTERFACE nesting_offl_interpolation_factor
-
-    INTERFACE nesting_offl_mass_conservation
-       MODULE PROCEDURE nesting_offl_mass_conservation
-    END INTERFACE nesting_offl_mass_conservation
-
-    INTERFACE nesting_offl_parin
-       MODULE PROCEDURE nesting_offl_parin
-    END INTERFACE nesting_offl_parin
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads data at lateral and top boundaries derived from larger-scale model.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_input
-
-    INTEGER(iwp) ::  n   !< running index for chemistry variables
-
-!
-!-- Initialize INIFOR forcing in first call.
-    IF ( .NOT. nest_offl%init )  THEN
-#if defined ( __netcdf )
-!
-!--    Open file in read-only mode
-       CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), pids_id )
-!
-!--    At first, inquire all variable names.
-       CALL inquire_num_variables( pids_id, num_var_pids )
-!
-!--    Allocate memory to store variable names.
-       ALLOCATE( nest_offl%var_names(1:num_var_pids) )
-       CALL inquire_variable_names( pids_id, nest_offl%var_names )
-!
-!--    Read time dimension, allocate memory and finally read time array
-       CALL get_dimension_length( pids_id, nest_offl%nt, 'time' )
-
-       IF ( check_existence( nest_offl%var_names, 'time' ) )  THEN
-          ALLOCATE( nest_offl%time(0:nest_offl%nt-1) )
-          CALL get_variable( pids_id, 'time', nest_offl%time )
-       ENDIF
-!
-!--    Read vertical dimension of scalar und w grid
-       CALL get_dimension_length( pids_id, nest_offl%nzu, 'z' )
-       CALL get_dimension_length( pids_id, nest_offl%nzw, 'zw' )
-
-       IF ( check_existence( nest_offl%var_names, 'z' ) )  THEN
-          ALLOCATE( nest_offl%zu_atmos(1:nest_offl%nzu) )
-          CALL get_variable( pids_id, 'z', nest_offl%zu_atmos )
-       ENDIF
-       IF ( check_existence( nest_offl%var_names, 'zw' ) )  THEN
-          ALLOCATE( nest_offl%zw_atmos(1:nest_offl%nzw) )
-          CALL get_variable( pids_id, 'zw', nest_offl%zw_atmos )
-       ENDIF
-!
-!--    Read surface pressure
-       IF ( check_existence( nest_offl%var_names, 'surface_forcing_surface_pressure' ) )  THEN
-          ALLOCATE( nest_offl%surface_pressure(0:nest_offl%nt-1) )
-          CALL get_variable( pids_id, 'surface_forcing_surface_pressure',                          &
-                             nest_offl%surface_pressure )
-       ENDIF
-!
-!--    Close input file
-       CALL close_input_file( pids_id )
-#endif
-    ENDIF
-!
-!-- Check if dynamic driver data input is required.
-    IF ( nest_offl%time(nest_offl%tind_p) <= MAX( time_since_reference_point, 0.0_wp)  .OR.        &
-         .NOT.  nest_offl%init )  THEN
-       CONTINUE
-!
-!-- Return otherwise
-    ELSE
-       RETURN
-    ENDIF
-!
-!-- Start of CPU measurement
-    CALL cpu_log( log_point_s(86), 'NetCDF input forcing', 'start' )
-
-!
-!-- Obtain time index for current point in time. Note, the time coordinate in the input file is
-!-- always relative to the initial time in UTC, i.e. the time coordinate always starts at 0.0 even
-!-- if the initial UTC is e.g. 7200.0. Further, since time_since_reference_point is negativ here
-!-- when spinup is applied, use MAX function to obtain correct time index.
-    nest_offl%tind = MINLOC( ABS( nest_offl%time - MAX( time_since_reference_point, 0.0_wp ) ),    &
-                             DIM = 1 ) - 1
-!
-!--    Note, in case of restart runs, the time index for the boundary data may indicate a time in
-!--    the future. This needs to be checked and corrected.
-       IF ( TRIM( initializing_actions ) == 'read_restart_data'  .AND.                             &
-            nest_offl%time(nest_offl%tind) > time_since_reference_point )  THEN
-          nest_offl%tind = nest_offl%tind - 1
-       ENDIF
-    nest_offl%tind_p = nest_offl%tind + 1
-!
-!-- Open file in read-only mode
-#if defined ( __netcdf )
-    CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), pids_id )
-!
-!--    Read geostrophic wind components
-!        DO  t = nest_offl%tind, nest_offl%tind_p
-!           CALL get_variable_pr( pids_id, 'ls_forcing_ug', t+1,                 &
-!                                 nest_offl%ug(t-nest_offl%tind,nzb+1:nzt) )
-!           CALL get_variable_pr( pids_id, 'ls_forcing_vg', t+1,                 &
-!                                 nest_offl%vg(t-nest_offl%tind,nzb+1:nzt) )
-!        ENDDO
-!
-!-- Read data at lateral and top boundaries. Please note, at left and right domain boundary,
-!-- yz-layers are read for u, v, w, pt and q.
-!-- For the v-component, the data starts at nysv, while for the other quantities the data starts at
-!-- nys. This is equivalent at the north and south domain boundary for the u-component (nxlu).
-!-- Note, lateral data is also accessed by parallel IO, which is the reason why different arguments
-!-- are passed depending on the boundary control flags. Cores that do not belong to the respective
-!-- boundary only do a dummy read with count = 0, just in order to participate the collective
-!-- operation. This is because collective parallel access shows better performance than just a
-!-- conditional access.
-!-- Read data for LOD 2, i.e. time-dependent xz-, yz-, and xy-slices.
-    IF ( lod == 2 )  THEN
-       CALL get_variable( pids_id, 'ls_forcing_left_u',                                            &
-                          nest_offl%u_l,                                                           & ! array to be read
-                          MERGE( nys+1, 1, bc_dirichlet_l),                                        & ! start index y direction
-                          MERGE( nzb+1, 1, bc_dirichlet_l),                                        & ! start index z direction
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                             & ! start index time dimension
-                          MERGE( nyn-nys+1, 0, bc_dirichlet_l),                                    & ! number of elements along y
-                          MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                                & ! number of elements alogn z
-                          MERGE( 2, 0, bc_dirichlet_l),                                            & ! number of time steps (2 or 0)
-                          .TRUE. )                                                                   ! parallel IO when compiled accordingly
-
-       CALL get_variable( pids_id, 'ls_forcing_left_v',                                            &
-                          nest_offl%v_l,                                                           &
-                          MERGE( nysv, 1, bc_dirichlet_l),                                         &
-                          MERGE( nzb+1, 1, bc_dirichlet_l),                                        &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                             &
-                          MERGE( nyn-nysv+1, 0, bc_dirichlet_l),                                   &
-                          MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                                &
-                          MERGE( 2, 0, bc_dirichlet_l),                                            &
-                          .TRUE. )
-
-       CALL get_variable( pids_id, 'ls_forcing_left_w',                                            &
-                          nest_offl%w_l,                                                           &
-                          MERGE( nys+1, 1, bc_dirichlet_l),                                        &
-                          MERGE( nzb+1, 1, bc_dirichlet_l),                                        &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                             &
-                          MERGE( nyn-nys+1, 0, bc_dirichlet_l),                                    &
-                          MERGE( nest_offl%nzw, 0, bc_dirichlet_l),                                &
-                          MERGE( 2, 0, bc_dirichlet_l),                                            &
-                          .TRUE. )
-
-       IF ( .NOT. neutral )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_left_pt',                                        &
-                             nest_offl%pt_l,                                                       &
-                             MERGE( nys+1, 1, bc_dirichlet_l),                                     &
-                             MERGE( nzb+1, 1, bc_dirichlet_l),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                          &
-                             MERGE( nyn-nys+1, 0, bc_dirichlet_l),                                 &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                             &
-                             MERGE( 2, 0, bc_dirichlet_l),                                         &
-                             .TRUE. )
-       ENDIF
-
-       IF ( humidity )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_left_qv',                                        &
-                             nest_offl%q_l,                                                        &
-                             MERGE( nys+1, 1, bc_dirichlet_l),                                     &
-                             MERGE( nzb+1, 1, bc_dirichlet_l),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                          &
-                             MERGE( nyn-nys+1, 0, bc_dirichlet_l),                                 &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                             &
-                             MERGE( 2, 0, bc_dirichlet_l),                                         &
-                             .TRUE. )
-       ENDIF
-
-       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-          DO  n = 1, UBOUND( nest_offl%var_names_chem_l, 1 )
-             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_l(n) ) )  THEN
-                CALL get_variable( pids_id,                                                        &
-                                   TRIM( nest_offl%var_names_chem_l(n) ),                          &
-                                   nest_offl%chem_l(:,:,:,n),                                      &
-                                   MERGE( nys+1, 1, bc_dirichlet_l),                               &
-                                   MERGE( nzb+1, 1, bc_dirichlet_l),                               &
-                                   MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                    &
-                                   MERGE( nyn-nys+1, 0, bc_dirichlet_l),                           &
-                                   MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                       &
-                                   MERGE( 2, 0, bc_dirichlet_l),                                   &
-                                   .TRUE. )
-                nest_offl%chem_from_file_l(n) = .TRUE.
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!--    Read data for eastern boundary
-       CALL get_variable( pids_id, 'ls_forcing_right_u',                                           &
-                          nest_offl%u_r,                                                           &
-                          MERGE( nys+1, 1, bc_dirichlet_r),                                        &
-                          MERGE( nzb+1, 1, bc_dirichlet_r),                                        &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                             &
-                          MERGE( nyn-nys+1, 0, bc_dirichlet_r),                                    &
-                          MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                                &
-                          MERGE( 2, 0, bc_dirichlet_r),                                            &
-                          .TRUE. )
-
-       CALL get_variable( pids_id, 'ls_forcing_right_v',                                           &
-                          nest_offl%v_r,                                                           &
-                          MERGE( nysv, 1, bc_dirichlet_r),                                         &
-                          MERGE( nzb+1, 1, bc_dirichlet_r),                                        &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                             &
-                          MERGE( nyn-nysv+1, 0, bc_dirichlet_r),                                   &
-                          MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                                &
-                          MERGE( 2, 0, bc_dirichlet_r),                                            &
-                          .TRUE. )
-
-       CALL get_variable( pids_id, 'ls_forcing_right_w',                                           &
-                          nest_offl%w_r,                                                           &
-                          MERGE( nys+1, 1, bc_dirichlet_r),                                        &
-                          MERGE( nzb+1, 1, bc_dirichlet_r),                                        &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                             &
-                          MERGE( nyn-nys+1, 0, bc_dirichlet_r),                                    &
-                          MERGE( nest_offl%nzw, 0, bc_dirichlet_r),                                &
-                          MERGE( 2, 0, bc_dirichlet_r),                                            &
-                          .TRUE. )
-
-       IF ( .NOT. neutral )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_right_pt',                                       &
-                             nest_offl%pt_r,                                                       &
-                             MERGE( nys+1, 1, bc_dirichlet_r),                                     &
-                             MERGE( nzb+1, 1, bc_dirichlet_r),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                          &
-                             MERGE( nyn-nys+1, 0, bc_dirichlet_r),                                 &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                             &
-                             MERGE( 2, 0, bc_dirichlet_r),                                         &
-                             .TRUE. )
-       ENDIF
-
-       IF ( humidity )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_right_qv',                                       &
-                             nest_offl%q_r,                                                        &
-                             MERGE( nys+1, 1, bc_dirichlet_r),                                     &
-                             MERGE( nzb+1, 1, bc_dirichlet_r),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                          &
-                             MERGE( nyn-nys+1, 0, bc_dirichlet_r),                                 &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                             &
-                             MERGE( 2, 0, bc_dirichlet_r),                                         &
-                             .TRUE. )
-       ENDIF
-
-       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-          DO  n = 1, UBOUND( nest_offl%var_names_chem_r, 1 )
-             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_r(n) ) )  THEN
-                CALL get_variable( pids_id,                                                        &
-                                   TRIM( nest_offl%var_names_chem_r(n) ),                          &
-                                   nest_offl%chem_r(:,:,:,n),                                      &
-                                   MERGE( nys+1, 1, bc_dirichlet_r),                               &
-                                   MERGE( nzb+1, 1, bc_dirichlet_r),                               &
-                                   MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                    &
-                                   MERGE( nyn-nys+1, 0, bc_dirichlet_r),                           &
-                                   MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                       &
-                                   MERGE( 2, 0, bc_dirichlet_r),                                   &
-                                   .TRUE. )
-                nest_offl%chem_from_file_r(n) = .TRUE.
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!--    Read data for northern boundary
-       CALL get_variable( pids_id, 'ls_forcing_north_u',                                           &
-                          nest_offl%u_n,                                                           &
-                          MERGE( nxlu, 1, bc_dirichlet_n ),                                        &
-                          MERGE( nzb+1, 1, bc_dirichlet_n ),                                       &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                            &
-                          MERGE( nxr-nxlu+1, 0, bc_dirichlet_n ),                                  &
-                          MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),                               &
-                          MERGE( 2, 0, bc_dirichlet_n ),                                           &
-                          .TRUE. )
-
-       CALL get_variable( pids_id, 'ls_forcing_north_v',                                           &
-                          nest_offl%v_n,                                                           &
-                          MERGE( nxl+1, 1, bc_dirichlet_n ),                                       &
-                          MERGE( nzb+1, 1, bc_dirichlet_n ),                                       &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                            &
-                          MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),                                   &
-                          MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),                               &
-                          MERGE( 2, 0, bc_dirichlet_n ),                                           &
-                          .TRUE. )
-
-       CALL get_variable( pids_id, 'ls_forcing_north_w',                                           &
-                          nest_offl%w_n,                                                           &
-                          MERGE( nxl+1, 1, bc_dirichlet_n ),                                       &
-                          MERGE( nzb+1, 1, bc_dirichlet_n ),                                       &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                            &
-                          MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),                                   &
-                          MERGE( nest_offl%nzw, 0, bc_dirichlet_n ),                               &
-                          MERGE( 2, 0, bc_dirichlet_n ),                                           &
-                          .TRUE. )
-
-       IF ( .NOT. neutral )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_north_pt',                                       &
-                             nest_offl%pt_n,                                                       &
-                             MERGE( nxl+1, 1, bc_dirichlet_n ),                                    &
-                             MERGE( nzb+1, 1, bc_dirichlet_n ),                                    &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                         &
-                             MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),                                &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),                            &
-                             MERGE( 2, 0, bc_dirichlet_n ),                                        &
-                             .TRUE. )
-       ENDIF
-       IF ( humidity )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_north_qv',                                       &
-                             nest_offl%q_n,                                                        &
-                             MERGE( nxl+1, 1, bc_dirichlet_n ),                                    &
-                             MERGE( nzb+1, 1, bc_dirichlet_n ),                                    &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                         &
-                             MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),                                &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),                            &
-                             MERGE( 2, 0, bc_dirichlet_n ),                                        &
-                             .TRUE. )
-       ENDIF
-
-       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-          DO  n = 1, UBOUND( nest_offl%var_names_chem_n, 1 )
-             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_n(n) ) )  THEN
-                CALL get_variable( pids_id,                                                        &
-                                   TRIM( nest_offl%var_names_chem_n(n) ),                          &
-                                   nest_offl%chem_n(:,:,:,n),                                      &
-                                   MERGE( nxl+1, 1, bc_dirichlet_n ),                              &
-                                   MERGE( nzb+1, 1, bc_dirichlet_n ),                              &
-                                   MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                   &
-                                   MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),                          &
-                                   MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),                      &
-                                   MERGE( 2, 0, bc_dirichlet_n ),                                  &
-                                   .TRUE. )
-                nest_offl%chem_from_file_n(n) = .TRUE.
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!--    Read data for southern boundary
-       CALL get_variable( pids_id, 'ls_forcing_south_u',                                           &
-                          nest_offl%u_s,                                                           &
-                          MERGE( nxlu, 1, bc_dirichlet_s ),                                        &
-                          MERGE( nzb+1, 1, bc_dirichlet_s ),                                       &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                            &
-                          MERGE( nxr-nxlu+1, 0, bc_dirichlet_s ),                                  &
-                          MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),                               &
-                          MERGE( 2, 0, bc_dirichlet_s ),                                           &
-                          .TRUE. )
-
-       CALL get_variable( pids_id, 'ls_forcing_south_v',                                           &
-                          nest_offl%v_s,                                                           &
-                          MERGE( nxl+1, 1, bc_dirichlet_s ),                                       &
-                          MERGE( nzb+1, 1, bc_dirichlet_s ),                                       &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                            &
-                          MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),                                   &
-                          MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),                               &
-                          MERGE( 2, 0, bc_dirichlet_s ),                                           &
-                          .TRUE. )
-
-       CALL get_variable( pids_id, 'ls_forcing_south_w',                                           &
-                          nest_offl%w_s,                                                           &
-                          MERGE( nxl+1, 1, bc_dirichlet_s ),                                       &
-                          MERGE( nzb+1, 1, bc_dirichlet_s ),                                       &
-                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                            &
-                          MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),                                   &
-                          MERGE( nest_offl%nzw, 0, bc_dirichlet_s ),                               &
-                          MERGE( 2, 0, bc_dirichlet_s ),                                           &
-                          .TRUE. )
-
-       IF ( .NOT. neutral )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_south_pt',                                       &
-                             nest_offl%pt_s,                                                       &
-                             MERGE( nxl+1, 1, bc_dirichlet_s ),                                    &
-                             MERGE( nzb+1, 1, bc_dirichlet_s ),                                    &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                         &
-                             MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),                                &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),                            &
-                             MERGE( 2, 0, bc_dirichlet_s ),                                        &
-                             .TRUE. )
-       ENDIF
-       IF ( humidity )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_south_qv',                                       &
-                             nest_offl%q_s,                                                        &
-                             MERGE( nxl+1, 1, bc_dirichlet_s ),                                    &
-                             MERGE( nzb+1, 1, bc_dirichlet_s ),                                    &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                         &
-                             MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),                                &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),                            &
-                             MERGE( 2, 0, bc_dirichlet_s ),                                        &
-                             .TRUE. )
-       ENDIF
-
-       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-          DO  n = 1, UBOUND( nest_offl%var_names_chem_s, 1 )
-             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_s(n) ) )  THEN
-                CALL get_variable( pids_id,                                                        &
-                                   TRIM( nest_offl%var_names_chem_s(n) ),                          &
-                                   nest_offl%chem_s(:,:,:,n),                                      &
-                                   MERGE( nxl+1, 1, bc_dirichlet_s ),                              &
-                                   MERGE( nzb+1, 1, bc_dirichlet_s ),                              &
-                                   MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                   &
-                                   MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),                          &
-                                   MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),                      &
-                                   MERGE( 2, 0, bc_dirichlet_s ),                                  &
-                                   .TRUE. )
-                nest_offl%chem_from_file_s(n) = .TRUE.
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!--    Top boundary
-       CALL get_variable( pids_id, 'ls_forcing_top_u',                                             &
-                          nest_offl%u_top(0:1,nys:nyn,nxlu:nxr),                                   &
-                          nxlu, nys+1, nest_offl%tind+1,                                           &
-                          nxr-nxlu+1, nyn-nys+1, 2, .TRUE. )
-
-       CALL get_variable( pids_id, 'ls_forcing_top_v',                                             &
-                          nest_offl%v_top(0:1,nysv:nyn,nxl:nxr),                                   &
-                          nxl+1, nysv, nest_offl%tind+1,                                           &
-                          nxr-nxl+1, nyn-nysv+1, 2, .TRUE. )
-
-       CALL get_variable( pids_id, 'ls_forcing_top_w',                                             &
-                          nest_offl%w_top(0:1,nys:nyn,nxl:nxr),                                    &
-                          nxl+1, nys+1, nest_offl%tind+1,                                          &
-                          nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
-
-       IF ( .NOT. neutral )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_top_pt',                                         &
-                             nest_offl%pt_top(0:1,nys:nyn,nxl:nxr),                                &
-                             nxl+1, nys+1, nest_offl%tind+1,                                       &
-                             nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
-       ENDIF
-       IF ( humidity )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_top_qv',                                         &
-                             nest_offl%q_top(0:1,nys:nyn,nxl:nxr),                                 &
-                             nxl+1, nys+1, nest_offl%tind+1,                                       &
-                             nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
-       ENDIF
-
-       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-          DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
-             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
-                CALL get_variable( pids_id,                                                        &
-                                   TRIM( nest_offl%var_names_chem_t(n) ),                          &
-                                   nest_offl%chem_top(0:1,nys:nyn,nxl:nxr,n),                      &
-                                   nxl+1, nys+1, nest_offl%tind+1,                                 &
-                                   nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
-                nest_offl%chem_from_file_t(n) = .TRUE.
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!-- Read data for LOD 1, i.e. time-dependent profiles. In constrast to LOD 2 where the amount of IO
-!-- is larger, only the respective boundary processes read the data.
-    ELSE
-       IF ( bc_dirichlet_l )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_left_u',                                         &
-                             nest_offl%u_l(0:1,:,1:1),                                             & ! array to be read
-                             MERGE( nzb+1, 1, bc_dirichlet_l),                                     & ! start index z direction
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                          & ! start index time dimension
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                             & ! number of elements along z
-                             MERGE( 2, 0, bc_dirichlet_l) )                                          ! number of time steps (2 or 0)
-          CALL get_variable( pids_id, 'ls_forcing_left_v',                                         &
-                             nest_offl%v_l(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_l),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                          &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                             &
-                             MERGE( 2, 0, bc_dirichlet_l) )
-          CALL get_variable( pids_id, 'ls_forcing_left_w',                                         &
-                             nest_offl%w_l(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_l),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                          &
-                             MERGE( nest_offl%nzw, 0, bc_dirichlet_l),                             &
-                             MERGE( 2, 0, bc_dirichlet_l) )
-          IF ( .NOT. neutral )  THEN
-             CALL get_variable( pids_id, 'ls_forcing_left_pt',                                     &
-                                nest_offl%pt_l(0:1,:,1:1),                                         &
-                                MERGE( nzb+1, 1, bc_dirichlet_l),                                  &
-                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                       &
-                                MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                          &
-                                MERGE( 2, 0, bc_dirichlet_l) )
-          ENDIF
-          IF ( humidity )  THEN
-             CALL get_variable( pids_id, 'ls_forcing_left_qv',                                     &
-                                nest_offl%q_l(0:1,:,1:1),                                          &
-                                MERGE( nzb+1, 1, bc_dirichlet_l),                                  &
-                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                       &
-                                MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                          &
-                                MERGE( 2, 0, bc_dirichlet_l) )
-          ENDIF
-          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-             DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
-                IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
-                   CALL get_variable( pids_id, TRIM( nest_offl%var_names_chem_t(n) ),              &
-                                      nest_offl%chem_l(0:1,:,1:1,n),                               &
-                                      MERGE( nzb+1, 1, bc_dirichlet_l),                            &
-                                      MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                 &
-                                      MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                    &
-                                      MERGE( 2, 0, bc_dirichlet_l) )
-                   nest_offl%chem_from_file_l(n) = .TRUE.
-                ENDIF
-             ENDDO
-          ENDIF
-       ENDIF
-       IF ( bc_dirichlet_r )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_right_u',                                        &
-                             nest_offl%u_r(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_r),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                          &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                             &
-                             MERGE( 2, 0, bc_dirichlet_r) )
-          CALL get_variable( pids_id, 'ls_forcing_right_v',                                        &
-                             nest_offl%v_r(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_r),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                          &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                             &
-                             MERGE( 2, 0, bc_dirichlet_r) )
-          CALL get_variable( pids_id, 'ls_forcing_right_w',                                        &
-                             nest_offl%w_r(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_r),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                          &
-                             MERGE( nest_offl%nzw, 0, bc_dirichlet_r),                             &
-                             MERGE( 2, 0, bc_dirichlet_r) )
-          IF ( .NOT. neutral )  THEN
-             CALL get_variable( pids_id, 'ls_forcing_right_pt',                                    &
-                                nest_offl%pt_r(0:1,:,1:1),                                         &
-                                MERGE( nzb+1, 1, bc_dirichlet_r),                                  &
-                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                       &
-                                MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                          &
-                                MERGE( 2, 0, bc_dirichlet_r) )
-          ENDIF
-          IF ( humidity )  THEN
-             CALL get_variable( pids_id, 'ls_forcing_right_qv',                                    &
-                                nest_offl%q_r(0:1,:,1:1),                                          &
-                                MERGE( nzb+1, 1, bc_dirichlet_r),                                  &
-                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                       &
-                                MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                          &
-                                MERGE( 2, 0, bc_dirichlet_r) )
-          ENDIF
-          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-             DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
-                IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
-                   CALL get_variable( pids_id, TRIM( nest_offl%var_names_chem_t(n) ),              &
-                                      nest_offl%chem_r(0:1,:,1:1,n),                               &
-                                      MERGE( nzb+1, 1, bc_dirichlet_r),                            &
-                                      MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                 &
-                                      MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                    &
-                                      MERGE( 2, 0, bc_dirichlet_r) )
-                   nest_offl%chem_from_file_r(n) = .TRUE.
-                ENDIF
-             ENDDO
-          ENDIF
-       ENDIF
-       IF ( bc_dirichlet_n )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_north_u',                                        &
-                             nest_offl%u_n(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_n),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                          &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_n),                             &
-                             MERGE( 2, 0, bc_dirichlet_n) )
-          CALL get_variable( pids_id, 'ls_forcing_north_v',                                        &
-                             nest_offl%v_n(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_n),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                          &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_n),                             &
-                             MERGE( 2, 0, bc_dirichlet_n) )
-          CALL get_variable( pids_id, 'ls_forcing_north_w',                                        &
-                             nest_offl%w_n(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_n),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                          &
-                             MERGE( nest_offl%nzw, 0, bc_dirichlet_n),                             &
-                             MERGE( 2, 0, bc_dirichlet_n) )
-          IF ( .NOT. neutral )  THEN
-             CALL get_variable( pids_id, 'ls_forcing_north_pt',                                    &
-                                nest_offl%pt_n(0:1,:,1:1),                                         &
-                                MERGE( nzb+1, 1, bc_dirichlet_n),                                  &
-                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                       &
-                                MERGE( nest_offl%nzu, 0, bc_dirichlet_n),                          &
-                                MERGE( 2, 0, bc_dirichlet_n) )
-          ENDIF
-          IF ( humidity )  THEN
-             CALL get_variable( pids_id, 'ls_forcing_north_qv',                                    &
-                                nest_offl%q_n(0:1,:,1:1),                                          &
-                                MERGE( nzb+1, 1, bc_dirichlet_n),                                  &
-                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                       &
-                                MERGE( nest_offl%nzu, 0, bc_dirichlet_n),                          &
-                                MERGE( 2, 0, bc_dirichlet_n) )
-          ENDIF
-          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-             DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
-                IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
-                   CALL get_variable( pids_id, TRIM( nest_offl%var_names_chem_t(n) ),              &
-                                      nest_offl%chem_n(0:1,:,1:1,n),                               &
-                                      MERGE( nzb+1, 1, bc_dirichlet_n),                            &
-                                      MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                 &
-                                      MERGE( nest_offl%nzu, 0, bc_dirichlet_n),                    &
-                                      MERGE( 2, 0, bc_dirichlet_n) )
-                   nest_offl%chem_from_file_n(n) = .TRUE.
-                ENDIF
-             ENDDO
-          ENDIF
-       ENDIF
-       IF ( bc_dirichlet_s )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_south_u',                                        &
-                             nest_offl%u_s(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_s),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                          &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_s),                             &
-                             MERGE( 2, 0, bc_dirichlet_s) )
-          CALL get_variable( pids_id, 'ls_forcing_south_v',                                        &
-                             nest_offl%v_s(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_s),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                          &
-                             MERGE( nest_offl%nzu, 0, bc_dirichlet_s),                             &
-                             MERGE( 2, 0, bc_dirichlet_s) )
-          CALL get_variable( pids_id, 'ls_forcing_south_w',                                        &
-                             nest_offl%w_s(0:1,:,1:1),                                             &
-                             MERGE( nzb+1, 1, bc_dirichlet_s),                                     &
-                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                          &
-                             MERGE( nest_offl%nzw, 0, bc_dirichlet_s),                             &
-                             MERGE( 2, 0, bc_dirichlet_s) )
-          IF ( .NOT. neutral )  THEN
-             CALL get_variable( pids_id, 'ls_forcing_south_pt',                                    &
-                                nest_offl%pt_s(0:1,:,1:1),                                         &
-                                MERGE( nzb+1, 1, bc_dirichlet_s),                                  &
-                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                       &
-                                MERGE( nest_offl%nzu, 0, bc_dirichlet_s),                          &
-                                MERGE( 2, 0, bc_dirichlet_s) )
-          ENDIF
-          IF ( humidity )  THEN
-             CALL get_variable( pids_id, 'ls_forcing_south_qv',                                    &
-                                nest_offl%q_s(0:1,:,1:1),                                          &
-                                MERGE( nzb+1, 1, bc_dirichlet_s),                                  &
-                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                       &
-                                MERGE( nest_offl%nzu, 0, bc_dirichlet_s),                          &
-                                MERGE( 2, 0, bc_dirichlet_s) )
-          ENDIF
-          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-             DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
-                IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
-                   CALL get_variable( pids_id, TRIM( nest_offl%var_names_chem_t(n) ),              &
-                                      nest_offl%chem_s(0:1,:,1:1,n),                               &
-                                      MERGE( nzb+1, 1, bc_dirichlet_s),                            &
-                                      MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                 &
-                                      MERGE( nest_offl%nzu, 0, bc_dirichlet_s),                    &
-                                      MERGE( 2, 0, bc_dirichlet_s) )
-                   nest_offl%chem_from_file_s(n) = .TRUE.
-                ENDIF
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Read top boundary data, which is actually only a scalar value in the LOD 1 case.
-       CALL get_variable( pids_id, 'ls_forcing_top_u',                                             &
-                          nest_offl%u_top(0:1,1,1),                                                & ! array to be read
-                          nest_offl%tind+1,                                                        & ! start index in time
-                          2 )                                                                        ! number of elements to be read
-       CALL get_variable( pids_id, 'ls_forcing_top_v',                                             &
-                          nest_offl%v_top(0:1,1,1),                                                &
-                          nest_offl%tind+1,                                                        &
-                          2 )
-       CALL get_variable( pids_id, 'ls_forcing_top_w',                                             &
-                          nest_offl%w_top(0:1,1,1),                                                &
-                          nest_offl%tind+1,                                                        &
-                          2 )
-       IF ( .NOT. neutral )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_top_pt',                                         &
-                             nest_offl%pt_top(0:1,1,1),                                            &
-                             nest_offl%tind+1,                                                     &
-                             2 )
-       ENDIF
-       IF ( humidity )  THEN
-          CALL get_variable( pids_id, 'ls_forcing_top_qv',                                         &
-                             nest_offl%q_top(0:1,1,1),                                             &
-                             nest_offl%tind+1,                                                     &
-                             2 )
-       ENDIF
-       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-          DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
-             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
-                CALL get_variable( pids_id, TRIM( nest_offl%var_names_chem_t(n) ),                 &
-                                   nest_offl%chem_top(0:1,1,1,n),                                  &
-                                   nest_offl%tind+1,                                               &
-                                   2 )
-                nest_offl%chem_from_file_t(n) = .TRUE.
-             ENDIF
-          ENDDO
-       ENDIF
-    ENDIF
-
-
-!
-!-- Close input file
-    CALL close_input_file( pids_id )
-#endif
-!
-!-- Set control flag to indicate that boundary data has been initially input.
-    nest_offl%init = .TRUE.
-!
-!-- Call offline nesting for salsa
-    IF ( salsa )  CALL salsa_nesting_offl_input
-!
-!-- End of CPU measurement
-    CALL cpu_log( log_point_s(86), 'NetCDF input forcing', 'stop' )
-
- END SUBROUTINE nesting_offl_input
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> In this subroutine a constant mass within the model domain is guaranteed.
-!> Larger-scale models may be based on a compressible equation system, which is not consistent with
-!> PALMs incompressible equation system. In order to avoid a decrease or increase of mass during the
-!> simulation, non-divergent flow through the lateral and top boundaries is compensated by the
-!> vertical wind component at the top boundary.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_mass_conservation
-
-    INTEGER(iwp) ::  i  !< grid index in x-direction
-    INTEGER(iwp) ::  j  !< grid index in y-direction
-    INTEGER(iwp) ::  k  !< grid index in z-direction
-
-    REAL(wp) ::  d_area_t   !< inverse of the total area of the horizontal model domain
-    REAL(wp) ::  w_correct  !< vertical velocity increment required to compensate non-divergent flow through the boundaries
-
-    REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !< local volume flow
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_mass_conservation', 'start' )
-
-    CALL  cpu_log( log_point(58), 'offline nesting', 'start' )
-
-    volume_flow   = 0.0_wp
-    volume_flow_l = 0.0_wp
-
-    d_area_t = 1.0_wp / ( ( nx + 1 ) * dx * ( ny + 1 ) * dy )
-
-    IF ( bc_dirichlet_l )  THEN
-       i = nxl
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k) * dy * rho_air(k)             &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_r )  THEN
-       i = nxr+1
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             volume_flow_l(1) = volume_flow_l(1) - u(k,j,i) * dzw(k) * dy * rho_air(k)             &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_s )  THEN
-       j = nys
-       DO  i = nxl, nxr
-          DO  k = nzb+1, nzt
-             volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k) * dx * rho_air(k)             &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-       ENDDO
-    ENDIF
-    IF ( bc_dirichlet_n )  THEN
-       j = nyn+1
-       DO  i = nxl, nxr
-          DO  k = nzb+1, nzt
-             volume_flow_l(2) = volume_flow_l(2) - v(k,j,i) * dzw(k) * dx * rho_air(k)             &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Top boundary
-    k = nzt
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          volume_flow_l(3) = volume_flow_l(3) - rho_air_zw(k) * w(k,j,i) * dx * dy
-       ENDDO
-    ENDDO
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flow_l, volume_flow, 3, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    volume_flow = volume_flow_l
-#endif
-
-    w_correct = SUM( volume_flow ) * d_area_t * drho_air_zw(nzt)
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzt, nzt + 1
-             w(k,j,i) = w(k,j,i) + w_correct                                                       &
-                                   * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL  cpu_log( log_point(58), 'offline nesting', 'stop' )
-
-    IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_mass_conservation', 'end' )
-
- END SUBROUTINE nesting_offl_mass_conservation
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the lateral and top boundary conditions in case the PALM domain is nested offline in a
-!> mesoscale model. Further, average boundary data and determine mean profiles, further used for
-!> correct damping in the sponge layer.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_bc
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    INTEGER(iwp) ::  i  !< running index x-direction
-    INTEGER(iwp) ::  j  !< running index y-direction
-    INTEGER(iwp) ::  k  !< running index z-direction
-    INTEGER(iwp) ::  n  !< running index for chemical species
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  pt_ref    !< reference profile for potential temperature
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  pt_ref_l  !< reference profile for potential temperature on subdomain
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  q_ref     !< reference profile for mixing ratio
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  q_ref_l   !< reference profile for mixing ratio on subdomain
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  u_ref     !< reference profile for u-component
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  u_ref_l   !< reference profile for u-component on subdomain
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  v_ref     !< reference profile for v-component
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  v_ref_l   !< reference profile for v-component on subdomain
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  var_1d    !< pre-interpolated profile for LOD1 mode
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_chem    !< reference profile for chemical species
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_chem_l  !< reference profile for chemical species on subdomain
-
-    IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_bc', 'start' )
-
-    CALL  cpu_log( log_point(58), 'offline nesting', 'start' )
-!
-!-- Initialize mean profiles, derived from boundary data, to zero.
-    pt_ref   = 0.0_wp
-    q_ref    = 0.0_wp
-    u_ref    = 0.0_wp
-    v_ref    = 0.0_wp
-
-    pt_ref_l = 0.0_wp
-    q_ref_l  = 0.0_wp
-    u_ref_l  = 0.0_wp
-    v_ref_l  = 0.0_wp
-!
-!-- If required, allocate temporary arrays to compute chemistry mean profiles
-    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-       ALLOCATE( ref_chem(nzb:nzt+1,1:UBOUND( chem_species, 1 ) )   )
-       ALLOCATE( ref_chem_l(nzb:nzt+1,1:UBOUND( chem_species, 1 ) ) )
-       ref_chem   = 0.0_wp
-       ref_chem_l = 0.0_wp
-    ENDIF
-!
-!-- Set boundary conditions of u-, v-, w-component, as well as q, and pt.
-!-- Note, boundary values at the left boundary: i=-1 (v,w,pt,q) and i=0 (u), at the right boundary:
-!-- i=nxr+1 (all), at the south boundary: j=-1 (u,w,pt,q) and j=0 (v), at the north boundary:
-!-- j=nyn+1 (all).
-!-- Please note, at the left (for u) and south (for v) boundary, values for u and v are set also at
-!-- i/j=-1, since these values are used in boundary_conditions() to restore prognostic values.
-!-- Further, sum up data to calculate mean profiles from boundary data, used for Rayleigh damping.
-    IF ( bc_dirichlet_l  )  THEN
-!
-!--    u-component
-       IF ( lod == 2 )  THEN
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                u(k,j,i_bound_u) = interpolate_in_time( nest_offl%u_l(0,k,j),                      &
-                                                        nest_offl%u_l(1,k,j),                      &
-                                                        fac_dt ) *                                 &
-                                   MERGE( 1.0_wp, 0.0_wp,                                          &
-                                          BTEST( wall_flags_total_0(k,j,i_bound_u), 1 ) )
-             ENDDO
-             u(:,j,i_bound_u-1) = u(:,j,i_bound_u)
-             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j,i_bound_u)
-          ENDDO
-       ELSE
-!
-!--       Pre-interpolate profile before mapping onto the boundaries.
-          DO  k = nzb+1, nzt
-             var_1d(k) = interpolate_in_time( nest_offl%u_l(0,k,1),                                &
-                                              nest_offl%u_l(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  j = nys, nyn
-             u(nzb+1:nzt,j,i_bound_u) = var_1d(nzb+1:nzt) *                                        &
-                                     MERGE( 1.0_wp, 0.0_wp,                                        &
-                                            BTEST( wall_flags_total_0(nzb+1:nzt,j,i_bound_u), 1 ) )
-             u(:,j,i_bound_u-1) = u(:,j,i_bound_u)
-             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j,i_bound_u)
-          ENDDO
-       ENDIF
-!
-!--    w-component
-       IF ( lod == 2 )  THEN
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt-1
-                w(k,j,i_bound) = interpolate_in_time( nest_offl%w_l(0,k,j),                        &
-                                                      nest_offl%w_l(1,k,j),                        &
-                                                      fac_dt ) *                                   &
-                                 MERGE( 1.0_wp, 0.0_wp,                                            &
-                                        BTEST( wall_flags_total_0(k,j,i_bound), 3 ) )
-             ENDDO
-             w(nzt,j,i_bound) = w(nzt-1,j,i_bound)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt-1
-             var_1d(k) = interpolate_in_time( nest_offl%w_l(0,k,1),                                &
-                                              nest_offl%w_l(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  j = nys, nyn
-             w(nzb+1:nzt-1,j,i_bound) = var_1d(nzb+1:nzt-1) *                                      &
-                                      MERGE( 1.0_wp, 0.0_wp,                                       &
-                                             BTEST( wall_flags_total_0(nzb+1:nzt-1,j,i_bound), 3 ) )
-             w(nzt,j,i_bound) = w(nzt-1,j,i_bound)
-          ENDDO
-       ENDIF
-!
-!--    v-component
-       IF ( lod == 2 )  THEN
-          DO  j = nysv, nyn
-             DO  k = nzb+1, nzt
-                v(k,j,i_bound) = interpolate_in_time( nest_offl%v_l(0,k,j),                        &
-                                                      nest_offl%v_l(1,k,j),                        &
-                                                      fac_dt ) *                                   &
-                                 MERGE( 1.0_wp, 0.0_wp,                                            &
-                                        BTEST( wall_flags_total_0(k,j,i_bound), 2 ) )
-             ENDDO
-             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j,i_bound)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt
-             var_1d(k) = interpolate_in_time( nest_offl%v_l(0,k,1),                                &
-                                              nest_offl%v_l(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  j = nysv, nyn
-             v(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt) *                                          &
-                                      MERGE( 1.0_wp, 0.0_wp,                                       &
-                                             BTEST( wall_flags_total_0(nzb+1:nzt,j,i_bound), 2 ) )
-             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j,i_bound)
-          ENDDO
-       ENDIF
-!
-!--    Potential temperature
-       IF ( .NOT. neutral )  THEN
-          IF ( lod == 2 )  THEN
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   pt(k,j,i_bound) = interpolate_in_time( nest_offl%pt_l(0,k,j),                   &
-                                                          nest_offl%pt_l(1,k,j),                   &
-                                                          fac_dt )
-                ENDDO
-                pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j,i_bound)
-             ENDDO
-          ELSE
-             DO  k = nzb+1, nzt
-                var_1d(k) = interpolate_in_time( nest_offl%pt_l(0,k,1),                            &
-                                                 nest_offl%pt_l(1,k,1),                            &
-                                                 fac_dt )
-             ENDDO
-             DO  j = nys, nyn
-                pt(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
-                pt_ref_l(nzb+1:nzt)     = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j,i_bound)
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Humidity
-       IF ( humidity )  THEN
-          IF ( lod == 2 )  THEN
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   q(k,j,i_bound) = interpolate_in_time( nest_offl%q_l(0,k,j),                     &
-                                                         nest_offl%q_l(1,k,j),                     &
-                                                         fac_dt )
-                ENDDO
-                q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j,i_bound)
-             ENDDO
-          ELSE
-             DO  k = nzb+1, nzt
-                var_1d(k) = interpolate_in_time( nest_offl%q_l(0,k,1),                             &
-                                                 nest_offl%q_l(1,k,1),                             &
-                                                 fac_dt )
-             ENDDO
-             DO  j = nys, nyn
-                q(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
-                q_ref_l(nzb+1:nzt)     = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j,i_bound)
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Chemistry
-       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-          DO  n = 1, UBOUND( chem_species, 1 )
-             IF ( nest_offl%chem_from_file_l(n) )  THEN
-                IF ( lod == 2 )  THEN
-                   DO  j = nys, nyn
-                      DO  k = nzb+1, nzt
-                         chem_species(n)%conc(k,j,i_bound) = interpolate_in_time(                  &
-                                                                        nest_offl%chem_l(0,k,j,n), &
-                                                                        nest_offl%chem_l(1,k,j,n), &
-                                                                        fac_dt                   )
-                      ENDDO
-                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
-                                                + chem_species(n)%conc(nzb+1:nzt,j,i_bound)
-                   ENDDO
-                ELSE
-                   DO  k = nzb+1, nzt
-                      var_1d(k) = interpolate_in_time( nest_offl%chem_l(0,k,1,n),                  &
-                                                       nest_offl%chem_l(1,k,1,n),                  &
-                                                       fac_dt )
-                   ENDDO
-                   DO  j = nys, nyn
-                      chem_species(n)%conc(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
-                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
-                                                + chem_species(n)%conc(nzb+1:nzt,j,i_bound)
-                   ENDDO
-                ENDIF
-             ENDIF
-          ENDDO
-       ENDIF
-
-    ENDIF
-
-    IF ( bc_dirichlet_r  )  THEN
-!
-!--    u-component
-       IF ( lod == 2 )  THEN
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                u(k,j,i_bound_u) = interpolate_in_time( nest_offl%u_r(0,k,j),                      &
-                                                        nest_offl%u_r(1,k,j),                      &
-                                                        fac_dt ) *                                 &
-                                   MERGE( 1.0_wp, 0.0_wp,                                          &
-                                          BTEST( wall_flags_total_0(k,j,i_bound_u), 1 ) )
-             ENDDO
-             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j,i_bound_u)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt
-             var_1d(k) = interpolate_in_time( nest_offl%u_r(0,k,1),                                &
-                                              nest_offl%u_r(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  j = nys, nyn
-             u(nzb+1:nzt,j,i_bound_u) = var_1d(nzb+1:nzt) *                                        &
-                                      MERGE( 1.0_wp, 0.0_wp,                                       &
-                                             BTEST( wall_flags_total_0(nzb+1:nzt,j,i_bound_u), 1 ) )
-             u_ref_l(nzb+1:nzt)       = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j,i_bound_u)
-          ENDDO
-       ENDIF
-!
-!--    w-component
-       IF ( lod == 2 )  THEN
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt-1
-                w(k,j,i_bound) = interpolate_in_time( nest_offl%w_r(0,k,j),                        &
-                                                      nest_offl%w_r(1,k,j),                        &
-                                                      fac_dt ) *                                   &
-                                 MERGE( 1.0_wp, 0.0_wp,                                            &
-                                        BTEST( wall_flags_total_0(k,j,i_bound), 3 ) )
-             ENDDO
-             w(nzt,j,i_bound) = w(nzt-1,j,i_bound)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt-1
-             var_1d(k) = interpolate_in_time( nest_offl%w_r(0,k,1),                                &
-                                              nest_offl%w_r(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  j = nys, nyn
-             w(nzb+1:nzt-1,j,i_bound) = var_1d(nzb+1:nzt-1) *                                      &
-                                  MERGE( 1.0_wp, 0.0_wp,                                           &
-                                         BTEST( wall_flags_total_0(nzb+1:nzt-1,j,i_bound), 3 ) )
-             w(nzt,j,i_bound) = w(nzt-1,j,i_bound)
-          ENDDO
-       ENDIF
-!
-!--    v-component
-       IF ( lod == 2 )  THEN
-          DO  j = nysv, nyn
-             DO  k = nzb+1, nzt
-                v(k,j,i_bound) = interpolate_in_time( nest_offl%v_r(0,k,j),                        &
-                                                      nest_offl%v_r(1,k,j),                        &
-                                                      fac_dt ) *                                   &
-                                 MERGE( 1.0_wp, 0.0_wp,                                            &
-                                        BTEST( wall_flags_total_0(k,j,i_bound), 2 ) )
-             ENDDO
-             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j,i_bound)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt
-             var_1d(k) = interpolate_in_time( nest_offl%v_r(0,k,1),                                &
-                                              nest_offl%v_r(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  j = nysv, nyn
-             v(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt) *                                          &
-                                    MERGE( 1.0_wp, 0.0_wp,                                         &
-                                           BTEST( wall_flags_total_0(nzb+1:nzt,j,i_bound), 2 ) )
-             v_ref_l(nzb+1:nzt)     = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j,i_bound)
-          ENDDO
-       ENDIF
-!
-!--    Potential temperature
-       IF ( .NOT. neutral )  THEN
-          IF ( lod == 2 )  THEN
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   pt(k,j,i_bound) = interpolate_in_time( nest_offl%pt_r(0,k,j),                   &
-                                                          nest_offl%pt_r(1,k,j),                   &
-                                                          fac_dt )
-                ENDDO
-                pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j,i_bound)
-             ENDDO
-          ELSE
-             DO  k = nzb+1, nzt
-                var_1d(k) = interpolate_in_time( nest_offl%pt_r(0,k,1),                            &
-                                                 nest_offl%pt_r(1,k,1),                            &
-                                                 fac_dt )
-             ENDDO
-             DO  j = nys, nyn
-                pt(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
-                pt_ref_l(nzb+1:nzt)     = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j,i_bound)
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Humidity
-       IF ( humidity )  THEN
-          IF ( lod == 2 )  THEN
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   q(k,j,i_bound) = interpolate_in_time( nest_offl%q_r(0,k,j),                     &
-                                                         nest_offl%q_r(1,k,j),                     &
-                                                         fac_dt )
-                ENDDO
-                q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j,i_bound)
-             ENDDO
-          ELSE
-             DO  k = nzb+1, nzt
-                var_1d(k) = interpolate_in_time( nest_offl%q_r(0,k,1),                             &
-                                                 nest_offl%q_r(1,k,1),                             &
-                                                 fac_dt )
-             ENDDO
-             DO  j = nys, nyn
-                q(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
-                q_ref_l(nzb+1:nzt)     = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j,i_bound)
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Chemistry
-       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-          DO  n = 1, UBOUND( chem_species, 1 )
-             IF ( nest_offl%chem_from_file_r(n) )  THEN
-                IF ( lod == 2 )  THEN
-                   DO  j = nys, nyn
-                      DO  k = nzb+1, nzt
-                         chem_species(n)%conc(k,j,i_bound) = interpolate_in_time(                  &
-                                                                        nest_offl%chem_r(0,k,j,n), &
-                                                                        nest_offl%chem_r(1,k,j,n), &
-                                                                        fac_dt                   )
-                      ENDDO
-                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
-                                                + chem_species(n)%conc(nzb+1:nzt,j,i_bound)
-                   ENDDO
-                ELSE
-                   DO  k = nzb+1, nzt
-                      var_1d(k) = interpolate_in_time( nest_offl%chem_r(0,k,1,n),                  &
-                                                       nest_offl%chem_r(1,k,1,n),                  &
-                                                       fac_dt )
-                   ENDDO
-                   DO  j = nys, nyn
-                      chem_species(n)%conc(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
-                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
-                                                + chem_species(n)%conc(nzb+1:nzt,j,i_bound)
-                   ENDDO
-                ENDIF
-             ENDIF
-          ENDDO
-       ENDIF
-
-    ENDIF
-
-    IF ( bc_dirichlet_n )  THEN
-!
-!--    v-component
-       IF ( lod == 2 )  THEN
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt
-                v(k,j_bound_v,i) = interpolate_in_time( nest_offl%v_n(0,k,i),                      &
-                                                        nest_offl%v_n(1,k,i),                      &
-                                                        fac_dt ) *                                 &
-                                   MERGE( 1.0_wp, 0.0_wp,                                          &
-                                          BTEST( wall_flags_total_0(k,j_bound_v,i), 2 ) )
-             ENDDO
-             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j_bound_v,i)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt
-             var_1d(k) = interpolate_in_time( nest_offl%v_n(0,k,1),                                &
-                                              nest_offl%v_n(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  i = nxl, nxr
-             v(nzb+1:nzt,j_bound_v,i) = var_1d(nzb+1:nzt) *                                        &
-                                  MERGE( 1.0_wp, 0.0_wp,                                           &
-                                         BTEST( wall_flags_total_0(nzb+1:nzt,j_bound_v,i), 2 ) )
-             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j_bound_v,i)
-          ENDDO
-       ENDIF
-!
-!--    w-component
-       IF ( lod == 2 )  THEN
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt-1
-                w(k,j_bound,i) = interpolate_in_time( nest_offl%w_n(0,k,i),                        &
-                                                      nest_offl%w_n(1,k,i),                        &
-                                                      fac_dt ) *                                   &
-                                 MERGE( 1.0_wp, 0.0_wp,                                            &
-                                        BTEST( wall_flags_total_0(k,j_bound,i), 3 ) )
-             ENDDO
-             w(nzt,j_bound,i) = w(nzt-1,j_bound,i)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt-1
-             var_1d(k) = interpolate_in_time( nest_offl%w_n(0,k,1),                                &
-                                              nest_offl%w_n(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  i = nxl, nxr
-             w(nzb+1:nzt-1,j_bound,i) = var_1d(nzb+1:nzt-1) *                                      &
-                                  MERGE( 1.0_wp, 0.0_wp,                                           &
-                                         BTEST( wall_flags_total_0(nzb+1:nzt-1,j_bound,i), 3 ) )
-             w(nzt,j_bound,i) = w(nzt-1,j_bound,i)
-          ENDDO
-       ENDIF
-!
-!--    u-component
-       IF ( lod == 2 )  THEN
-          DO  i = nxlu, nxr
-             DO  k = nzb+1, nzt
-                u(k,j_bound,i) = interpolate_in_time( nest_offl%u_n(0,k,i),                        &
-                                                      nest_offl%u_n(1,k,i),                        &
-                                                      fac_dt ) *                                   &
-                                 MERGE( 1.0_wp, 0.0_wp,                                            &
-                                        BTEST( wall_flags_total_0(k,j_bound,i), 1 ) )
-             ENDDO
-             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j_bound,i)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt
-             var_1d(k) = interpolate_in_time( nest_offl%u_n(0,k,1),                                &
-                                              nest_offl%u_n(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  i = nxlu, nxr
-             u(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt) *                                          &
-                                    MERGE( 1.0_wp, 0.0_wp,                                         &
-                                           BTEST( wall_flags_total_0(nzb+1:nzt,j_bound,i), 1 ) )
-             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j_bound,i)
-          ENDDO
-       ENDIF
-!
-!--    Potential temperature
-       IF ( .NOT. neutral )  THEN
-          IF ( lod == 2 )  THEN
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   pt(k,j_bound,i) = interpolate_in_time( nest_offl%pt_n(0,k,i),                   &
-                                                          nest_offl%pt_n(1,k,i),                   &
-                                                          fac_dt )
-                ENDDO
-                pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j_bound,i)
-             ENDDO
-          ELSE
-             DO  k = nzb+1, nzt
-                var_1d(k) = interpolate_in_time( nest_offl%pt_n(0,k,1),                            &
-                                                 nest_offl%pt_n(1,k,1),                            &
-                                                 fac_dt )
-             ENDDO
-             DO  i = nxl, nxr
-                pt(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
-                pt_ref_l(nzb+1:nzt)     = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j_bound,i)
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Humidity
-       IF ( humidity )  THEN
-          IF ( lod == 2 )  THEN
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   q(k,j_bound,i) = interpolate_in_time( nest_offl%q_n(0,k,i),                     &
-                                                         nest_offl%q_n(1,k,i),                     &
-                                                         fac_dt )
-                ENDDO
-                q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j_bound,i)
-             ENDDO
-          ELSE
-             DO  k = nzb+1, nzt
-                var_1d(k) = interpolate_in_time( nest_offl%q_n(0,k,1),                             &
-                                                 nest_offl%q_n(1,k,1),                             &
-                                                 fac_dt )
-             ENDDO
-             DO  i = nxl, nxr
-                q(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
-                q_ref_l(nzb+1:nzt)     = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j_bound,i)
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Chemistry
-       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-          DO  n = 1, UBOUND( chem_species, 1 )
-             IF ( nest_offl%chem_from_file_n(n) )  THEN
-                IF ( lod == 2 )  THEN
-                   DO  i = nxl, nxr
-                      DO  k = nzb+1, nzt
-                         chem_species(n)%conc(k,j_bound,i) = interpolate_in_time(                  &
-                                                                     nest_offl%chem_n(0,k,i,n),    &
-                                                                     nest_offl%chem_n(1,k,i,n),    &
-                                                                     fac_dt                    )
-                      ENDDO
-                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
-                                                + chem_species(n)%conc(nzb+1:nzt,j_bound,i)
-                   ENDDO
-                ELSE
-                   DO  k = nzb+1, nzt
-                      var_1d(k) = interpolate_in_time( nest_offl%chem_n(0,k,1,n),                  &
-                                                       nest_offl%chem_n(1,k,1,n),                  &
-                                                       fac_dt )
-                   ENDDO
-                   DO  i = nxl, nxr
-                      chem_species(n)%conc(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
-                      ref_chem_l(nzb+1:nzt,n)                   = ref_chem_l(nzb+1:nzt,n) +        &
-                                                                  chem_species(n)                  &
-                                                                  %conc(nzb+1:nzt,j_bound,i)
-                   ENDDO
-                ENDIF
-             ENDIF
-          ENDDO
-       ENDIF
-    ENDIF
-
-    IF ( bc_dirichlet_s )  THEN
-!
-!--    v-component
-       IF ( lod == 2 )  THEN
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt
-                v(k,j_bound_v,i) = interpolate_in_time( nest_offl%v_s(0,k,i),                      &
-                                                        nest_offl%v_s(1,k,i),                      &
-                                                        fac_dt ) *                                 &
-                                   MERGE( 1.0_wp, 0.0_wp,                                          &
-                                          BTEST( wall_flags_total_0(k,j_bound_v,i), 2 ) )
-             ENDDO
-             v(:,j_bound_v-1,i) = v(:,j_bound_v,i)
-             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j_bound_v,i)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt
-             var_1d(k) = interpolate_in_time( nest_offl%v_s(0,k,1),                                &
-                                              nest_offl%v_s(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  i = nxl, nxr
-             v(nzb+1:nzt,j_bound_v,i) = var_1d(nzb+1:nzt) *                                        &
-                                      MERGE( 1.0_wp, 0.0_wp,                                       &
-                                             BTEST( wall_flags_total_0(nzb+1:nzt,j_bound_v,i), 2 ) )
-             v(:,j_bound_v-1,i) = v(:,j_bound_v,i)
-             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j_bound_v,i)
-          ENDDO
-       ENDIF
-!
-!--    w-component
-       IF ( lod == 2 )  THEN
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt-1
-                w(k,j_bound,i) = interpolate_in_time( nest_offl%w_s(0,k,i),                        &
-                                                      nest_offl%w_s(1,k,i),                        &
-                                                      fac_dt ) *                                   &
-                                 MERGE( 1.0_wp, 0.0_wp,                                            &
-                                        BTEST( wall_flags_total_0(k,j_bound,i), 3 ) )
-             ENDDO
-             w(nzt,j_bound,i) = w(nzt-1,j_bound,i)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt-1
-             var_1d(k) = interpolate_in_time( nest_offl%w_s(0,k,1),                                &
-                                              nest_offl%w_s(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  i = nxl, nxr
-             w(nzb+1:nzt-1,j_bound,i) = var_1d(nzb+1:nzt-1) *                                      &
-                                      MERGE( 1.0_wp, 0.0_wp,                                       &
-                                             BTEST( wall_flags_total_0(nzb+1:nzt-1,j_bound,i), 3 ) )
-             w(nzt,j_bound,i) = w(nzt-1,j_bound,i)
-          ENDDO
-       ENDIF
-!
-!--    u-component
-       IF ( lod == 2 )  THEN
-          DO  i = nxlu, nxr
-             DO  k = nzb+1, nzt
-                u(k,j_bound,i) = interpolate_in_time( nest_offl%u_s(0,k,i),                        &
-                                                      nest_offl%u_s(1,k,i),                        &
-                                                      fac_dt ) *                                   &
-                                 MERGE( 1.0_wp, 0.0_wp,                                            &
-                                        BTEST( wall_flags_total_0(k,j_bound,i), 1 ) )
-             ENDDO
-             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j_bound,i)
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt
-             var_1d(k) = interpolate_in_time( nest_offl%u_s(0,k,1),                                &
-                                              nest_offl%u_s(1,k,1),                                &
-                                              fac_dt )
-          ENDDO
-          DO  i = nxlu, nxr
-             u(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt) *                                          &
-                                      MERGE( 1.0_wp, 0.0_wp,                                       &
-                                             BTEST( wall_flags_total_0(nzb+1:nzt,j_bound,i), 1 ) )
-             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j_bound,i)
-          ENDDO
-       ENDIF
-!
-!--    Potential temperature
-       IF ( .NOT. neutral )  THEN
-          IF ( lod == 2 )  THEN
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   pt(k,j_bound,i) = interpolate_in_time( nest_offl%pt_s(0,k,i),                   &
-                                                          nest_offl%pt_s(1,k,i),                   &
-                                                          fac_dt )
-                ENDDO
-                pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j_bound,i)
-             ENDDO
-          ELSE
-             DO  k = nzb+1, nzt
-                var_1d(k) = interpolate_in_time( nest_offl%pt_s(0,k,1),                            &
-                                                 nest_offl%pt_s(1,k,1),                            &
-                                                 fac_dt )
-             ENDDO
-             DO  i = nxl, nxr
-                pt(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
-                pt_ref_l(nzb+1:nzt)     = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j_bound,i)
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Humidity
-       IF ( humidity )  THEN
-          IF ( lod == 2 )  THEN
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   q(k,j_bound,i) = interpolate_in_time( nest_offl%q_s(0,k,i),                     &
-                                                         nest_offl%q_s(1,k,i),                     &
-                                                         fac_dt )
-                ENDDO
-                q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j_bound,i)
-             ENDDO
-          ELSE
-             DO  k = nzb+1, nzt
-                var_1d(k) = interpolate_in_time( nest_offl%q_s(0,k,1),                             &
-                                                 nest_offl%q_s(1,k,1),                             &
-                                                 fac_dt )
-             ENDDO
-             DO  i = nxl, nxr
-                q(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
-                q_ref_l(nzb+1:nzt)     = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j_bound,i)
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Chemistry
-       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-          DO  n = 1, UBOUND( chem_species, 1 )
-             IF ( nest_offl%chem_from_file_s(n) )  THEN
-                IF ( lod == 2 )  THEN
-                   DO  i = nxl, nxr
-                      DO  k = nzb+1, nzt
-                         chem_species(n)%conc(k,j_bound,i) = interpolate_in_time(                  &
-                                                                        nest_offl%chem_s(0,k,i,n), &
-                                                                        nest_offl%chem_s(1,k,i,n), &
-                                                                        fac_dt  )
-                      ENDDO
-                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
-                                                + chem_species(n)%conc(nzb+1:nzt,j_bound,i)
-                   ENDDO
-                ELSE
-                   DO  k = nzb+1, nzt
-                      var_1d(k) = interpolate_in_time( nest_offl%chem_s(0,k,1,n),                  &
-                                                       nest_offl%chem_s(1,k,1,n),                  &
-                                                       fac_dt )
-                   ENDDO
-                   DO  i = nxl, nxr
-                      chem_species(n)%conc(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
-                      ref_chem_l(nzb+1:nzt,n)                   = ref_chem_l(nzb+1:nzt,n) +        &
-                                                                  chem_species(n)                  &
-                                                                  %conc(nzb+1:nzt,j_bound,i)
-                   ENDDO
-                ENDIF
-             ENDIF
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Top boundary
-!-- u-component
-    IF ( lod == 2 )  THEN
-       DO  i = nxlu, nxr
-          DO  j = nys, nyn
-             u(nzt+1,j,i) = interpolate_in_time( nest_offl%u_top(0,j,i),                           &
-                                                 nest_offl%u_top(1,j,i),                           &
-                                                 fac_dt ) *                                        &
-                            MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzt+1,j,i), 1 ) )
-             u_ref_l(nzt+1) = u_ref_l(nzt+1) + u(nzt+1,j,i)
-          ENDDO
-       ENDDO
-    ELSE
-       var_1d(nzt+1) = interpolate_in_time( nest_offl%u_top(0,1,1),                                &
-                                            nest_offl%u_top(1,1,1),                                &
-                                            fac_dt )
-       u(nzt+1,nys:nyn,nxlu:nxr) = var_1d(nzt+1) *                                                 &
-                                   MERGE( 1.0_wp, 0.0_wp,                                          &
-                                          BTEST( wall_flags_total_0(nzt+1,nys:nyn,nxlu:nxr), 1 ) )
-       u_ref_l(nzt+1) = u_ref_l(nzt+1) + SUM( u(nzt+1,nys:nyn,nxlu:nxr) )
-    ENDIF
-!
-!--    For left boundary set boundary condition for u-component also at top grid point.
-!--    Note, this has no effect on the numeric solution, only for data output.
-    IF ( bc_dirichlet_l )  u(nzt+1,:,nxl) = u(nzt+1,:,nxlu)
-!
-!-- v-component
-    IF ( lod == 2 )  THEN
-       DO  i = nxl, nxr
-          DO  j = nysv, nyn
-             v(nzt+1,j,i) = interpolate_in_time( nest_offl%v_top(0,j,i),                           &
-                                                 nest_offl%v_top(1,j,i),                           &
-                                                 fac_dt ) *                                        &
-                            MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzt+1,j,i), 2 ) )
-             v_ref_l(nzt+1) = v_ref_l(nzt+1) + v(nzt+1,j,i)
-          ENDDO
-       ENDDO
-    ELSE
-       var_1d(nzt+1) = interpolate_in_time( nest_offl%v_top(0,1,1),                                &
-                                            nest_offl%v_top(1,1,1),                                &
-                                            fac_dt )
-       v(nzt+1,nysv:nyn,nxl:nxr) = var_1d(nzt+1) *                                                 &
-                                   MERGE( 1.0_wp, 0.0_wp,                                          &
-                                          BTEST( wall_flags_total_0(nzt+1,nysv:nyn,nxl:nxr), 2 ) )
-       v_ref_l(nzt+1) = v_ref_l(nzt+1) + SUM( v(nzt+1,nysv:nyn,nxl:nxr) )
-    ENDIF
-!
-!-- For south boundary set boundary condition for v-component also at top grid point.
-!-- Note, this has no effect on the numeric solution, only for data output.
-    IF ( bc_dirichlet_s )  v(nzt+1,nys,:) = v(nzt+1,nysv,:)
-!
-!-- w-component
-    IF ( lod == 2 )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             w(nzt,j,i) = interpolate_in_time( nest_offl%w_top(0,j,i),                             &
-                                               nest_offl%w_top(1,j,i),                             &
-                                               fac_dt ) *                                          &
-                          MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzt,j,i), 3 ) )
-             w(nzt+1,j,i) = w(nzt,j,i)
-          ENDDO
-       ENDDO
-    ELSE
-       var_1d(nzt) = interpolate_in_time( nest_offl%w_top(0,1,1),                                  &
-                                          nest_offl%w_top(1,1,1),                                  &
-                                          fac_dt )
-       w(nzt,nys:nyn,nxl:nxr) = var_1d(nzt) *                                                      &
-                                MERGE( 1.0_wp, 0.0_wp,                                             &
-                                       BTEST( wall_flags_total_0(nzt,nys:nyn,nxl:nxr), 3 ) )
-       w(nzt+1,nys:nyn,nxl:nxr) = w(nzt,nys:nyn,nxl:nxr)
-    ENDIF
-!
-!-- Potential temperture
-    IF ( .NOT. neutral )  THEN
-       IF ( lod == 2 )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                pt(nzt+1,j,i) = interpolate_in_time( nest_offl%pt_top(0,j,i),                      &
-                                                     nest_offl%pt_top(1,j,i),                      &
-                                                     fac_dt )
-                pt_ref_l(nzt+1) = pt_ref_l(nzt+1) + pt(nzt+1,j,i)
-             ENDDO
-          ENDDO
-       ELSE
-          var_1d(nzt+1) = interpolate_in_time( nest_offl%pt_top(0,1,1),                            &
-                                               nest_offl%pt_top(1,1,1),                            &
-                                               fac_dt )
-          pt(nzt+1,nys:nyn,nxl:nxr) = var_1d(nzt+1)
-          pt_ref_l(nzt+1) = pt_ref_l(nzt+1) + SUM( pt(nzt+1,nys:nyn,nxl:nxr) )
-       ENDIF
-    ENDIF
-!
-!--    humidity
-    IF ( humidity )  THEN
-       IF ( lod == 2 )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                q(nzt+1,j,i) = interpolate_in_time( nest_offl%q_top(0,j,i),                        &
-                                                    nest_offl%q_top(1,j,i),                        &
-                                                    fac_dt )
-                q_ref_l(nzt+1) = q_ref_l(nzt+1) + q(nzt+1,j,i)
-             ENDDO
-          ENDDO
-       ELSE
-          var_1d(nzt+1) = interpolate_in_time( nest_offl%q_top(0,1,1),                             &
-                                               nest_offl%q_top(1,1,1),                             &
-                                               fac_dt )
-          q(nzt+1,nys:nyn,nxl:nxr) = var_1d(nzt+1)
-          q_ref_l(nzt+1) = q_ref_l(nzt+1) + SUM( q(nzt+1,nys:nyn,nxl:nxr) )
-       ENDIF
-    ENDIF
-
-    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-       DO  n = 1, UBOUND( chem_species, 1 )
-          IF ( nest_offl%chem_from_file_t(n) )  THEN
-             IF ( lod == 2 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      chem_species(n)%conc(nzt+1,j,i) = interpolate_in_time(                       &
-                                                           nest_offl%chem_top(0,j,i,n),            &
-                                                           nest_offl%chem_top(1,j,i,n),            &
-                                                           fac_dt          )
-                      ref_chem_l(nzt+1,n) = ref_chem_l(nzt+1,n) + chem_species(n)%conc(nzt+1,j,i)
-                   ENDDO
-                ENDDO
-             ELSE
-                var_1d(nzt+1) = interpolate_in_time( nest_offl%chem_top(0,1,1,n),                  &
-                                                     nest_offl%chem_top(1,1,1,n),                  &
-                                                     fac_dt )
-                chem_species(n)%conc(nzt+1,nys:nyn,nxl:nxr) = var_1d(nzt+1)
-                ref_chem_l(nzt+1,n) = ref_chem_l(nzt+1,n) +                                        &
-                                      SUM( chem_species(n)%conc(nzt+1,nys:nyn,nxl:nxr) )
-             ENDIF
-          ENDIF
-       ENDDO
-    ENDIF
-!
-!-- Moreover, set Neumann boundary condition for subgrid-scale TKE, passive scalar, dissipation, and
-!-- chemical species if required.
-    IF ( rans_mode  .AND.  rans_tke_e )  THEN
-       IF (  bc_dirichlet_l )  diss(:,:,nxl-1) = diss(:,:,nxl)
-       IF (  bc_dirichlet_r )  diss(:,:,nxr+1) = diss(:,:,nxr)
-       IF (  bc_dirichlet_s )  diss(:,nys-1,:) = diss(:,nys,:)
-       IF (  bc_dirichlet_n )  diss(:,nyn+1,:) = diss(:,nyn,:)
-    ENDIF
-!        IF ( .NOT. constant_diffusion )  THEN
-!           IF (  bc_dirichlet_l )  e(:,:,nxl-1) = e(:,:,nxl)
-!           IF (  bc_dirichlet_r )  e(:,:,nxr+1) = e(:,:,nxr)
-!           IF (  bc_dirichlet_s )  e(:,nys-1,:) = e(:,nys,:)
-!           IF (  bc_dirichlet_n )  e(:,nyn+1,:) = e(:,nyn,:)
-!           e(nzt+1,:,:) = e(nzt,:,:)
-!        ENDIF
-!        IF ( passive_scalar )  THEN
-!           IF (  bc_dirichlet_l )  s(:,:,nxl-1) = s(:,:,nxl)
-!           IF (  bc_dirichlet_r )  s(:,:,nxr+1) = s(:,:,nxr)
-!           IF (  bc_dirichlet_s )  s(:,nys-1,:) = s(:,nys,:)
-!           IF (  bc_dirichlet_n )  s(:,nyn+1,:) = s(:,nyn,:)
-!        ENDIF
-
-    CALL exchange_horiz( u, nbgp )
-    CALL exchange_horiz( v, nbgp )
-    CALL exchange_horiz( w, nbgp )
-    IF ( .NOT. neutral )  CALL exchange_horiz( pt, nbgp )
-    IF ( humidity      )  CALL exchange_horiz( q,  nbgp )
-    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-       DO  n = 1, UBOUND( chem_species, 1 )
-!
-!--       Do local exchange only when necessary, i.e. when data is coming from dynamic file.
-          IF ( nest_offl%chem_from_file_t(n) )  CALL exchange_horiz( chem_species(n)%conc, nbgp )
-       ENDDO
-    ENDIF
-!
-!-- Set top boundary condition at all horizontal grid points, also at the lateral boundary grid
-!-- points.
-    w(nzt+1,:,:) = w(nzt,:,:)
-!
-!-- Offline nesting for salsa
-    IF ( salsa )  CALL salsa_nesting_offl_bc
-!
-!-- Calculate the mean profiles. These are later stored on u_init, v_init, etc., in order to adjust
-!-- the Rayleigh damping under time-evolving atmospheric conditions accordingly - damping against
-!-- the representative mean profiles, not against the initial profiles. Note, in LOD = 1 case no
-!-- averaging is required.
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( u_ref_l, u_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
-    CALL MPI_ALLREDUCE( v_ref_l, v_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
-    IF ( humidity )  THEN
-       CALL MPI_ALLREDUCE( q_ref_l, q_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
-    ENDIF
-    IF ( .NOT. neutral )  THEN
-       CALL MPI_ALLREDUCE( pt_ref_l, pt_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
-    ENDIF
-    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-       CALL MPI_ALLREDUCE( ref_chem_l, ref_chem, ( nzt+1-nzb+1 ) * SIZE( ref_chem(nzb,:) ),        &
-                           MPI_REAL, MPI_SUM, comm2d, ierr )
-    ENDIF
-#else
-    u_ref  = u_ref_l
-    v_ref  = v_ref_l
-    IF ( humidity )       q_ref    = q_ref_l
-    IF ( .NOT. neutral )  pt_ref   = pt_ref_l
-    IF ( air_chemistry  .AND.  nesting_offline_chem )  ref_chem = ref_chem_l
-#endif
-!
-!-- Average data. Note, reference profiles up to nzt are derived from lateral boundaries, at the
-!-- model top it is derived from the top boundary. Thus, number of input data is different from
-!-- nzb:nzt compared to nzt+1.
-!-- Derived from lateral boundaries.
-    u_ref(nzb:nzt) = u_ref(nzb:nzt) / REAL( 2.0_wp * ( ny + 1 + nx     ), KIND = wp )
-    v_ref(nzb:nzt) = v_ref(nzb:nzt) / REAL( 2.0_wp * ( ny   + nx + 1   ), KIND = wp )
-    IF ( humidity )                                                                                &
-       q_ref(nzb:nzt) = q_ref(nzb:nzt)   / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
-    IF ( .NOT. neutral )                                                                           &
-       pt_ref(nzb:nzt) = pt_ref(nzb:nzt) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
-    IF ( air_chemistry  .AND.  nesting_offline_chem )                                              &
-       ref_chem(nzb:nzt,:) = ref_chem(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
-!
-!-- Derived from top boundary.
-    u_ref(nzt+1) = u_ref(nzt+1) / REAL( ( ny + 1 ) * ( nx     ), KIND = wp )
-    v_ref(nzt+1) = v_ref(nzt+1) / REAL( ( ny     ) * ( nx + 1 ), KIND = wp )
-    IF ( humidity )                                                                                &
-       q_ref(nzt+1) = q_ref(nzt+1)   / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
-    IF ( .NOT. neutral )                                                                           &
-       pt_ref(nzt+1) = pt_ref(nzt+1) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
-    IF ( air_chemistry  .AND.  nesting_offline_chem )                                              &
-       ref_chem(nzt+1,:) = ref_chem(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ),KIND = wp )
-!
-!-- Write onto init profiles, which are used for damping. Also set lower boundary condition for
-!-- scalars (not required for u and v as these are zero at k=nzb).
-    u_init = u_ref
-    v_init = v_ref
-    IF ( humidity      )  THEN
-       q_init      = q_ref
-       q_init(nzb) = q_init(nzb+1)
-    ENDIF
-    IF ( .NOT. neutral )  THEN
-       pt_init      = pt_ref
-       pt_init(nzb) = pt_init(nzb+1)
-    ENDIF
-
-    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-       DO  n = 1, UBOUND( chem_species, 1 )
-          IF ( nest_offl%chem_from_file_t(n) )  THEN
-             chem_species(n)%conc_pr_init(:)   = ref_chem(:,n)
-             chem_species(n)%conc_pr_init(nzb) = chem_species(n)%conc_pr_init(nzb+1)
-          ENDIF
-       ENDDO
-    ENDIF
-    IF ( ALLOCATED( ref_chem   ) )  DEALLOCATE( ref_chem   )
-    IF ( ALLOCATED( ref_chem_l ) )  DEALLOCATE( ref_chem_l )
-!
-!-- Further, adjust Rayleigh damping height in case of time-changing conditions.
-!-- Therefore, calculate boundary-layer depth first.
-    CALL nesting_offl_calc_zi
-    CALL adjust_sponge_layer
-
-    CALL  cpu_log( log_point(58), 'offline nesting', 'stop' )
-
-    IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_bc', 'end' )
-
-
- END SUBROUTINE nesting_offl_bc
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-!--------------------------------------------------------------------------------------------------!
-!>  Update of the geostrophic wind components. Note, currently this routine is not invoked.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_geostrophic_wind
-
-    INTEGER(iwp) ::  k
-!
-!--    Update geostrophic wind components from dynamic input file.
-    DO  k = nzb+1, nzt
-       ug(k) = interpolate_in_time( nest_offl%ug(0,k), nest_offl%ug(1,k), fac_dt )
-       vg(k) = interpolate_in_time( nest_offl%vg(0,k), nest_offl%vg(1,k), fac_dt )
-    ENDDO
-    ug(nzt+1) = ug(nzt)
-    vg(nzt+1) = vg(nzt)
-
- END SUBROUTINE nesting_offl_geostrophic_wind
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-!--------------------------------------------------------------------------------------------------!
-!>  Determine the interpolation constant for time interpolation. The calculation is separated from
-!>  the nesting_offl_bc and nesting_offl_geostrophic_wind in order to be independent on the order of
-!> calls.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_interpolation_factor
-!
-!-- Determine interpolation factor and limit it to 1. This is because t+dt can slightly exceed
-!-- time(tind_p) before boundary data is updated again.
-    fac_dt = ( time_since_reference_point - nest_offl%time(nest_offl%tind) + dt_3d ) /             &
-             ( nest_offl%time(nest_offl%tind_p) - nest_offl%time(nest_offl%tind) )
-
-    fac_dt = MIN( 1.0_wp, fac_dt )
-
- END SUBROUTINE nesting_offl_interpolation_factor
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-!--------------------------------------------------------------------------------------------------!
-!> Calculates the boundary-layer depth from the boundary data, according to bulk-Richardson
-!> criterion.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_calc_zi
-
-    INTEGER(iwp) :: i                             !< loop index in x-direction
-    INTEGER(iwp) :: j                             !< loop index in y-direction
-    INTEGER(iwp) :: k                             !< loop index in z-direction
-    INTEGER(iwp) :: k_max_loc                     !< index of maximum wind speed along z-direction
-    INTEGER(iwp) :: k_surface                     !< topography top index in z-direction
-    INTEGER(iwp) :: num_boundary_gp_non_cyclic    !< number of non-cyclic boundaries, used for averaging ABL depth
-    INTEGER(iwp) :: num_boundary_gp_non_cyclic_l  !< number of non-cyclic boundaries, used for averaging ABL depth
-
-    REAL(wp) ::  ri_bulk                 !< bulk Richardson number
-    REAL(wp) ::  ri_bulk_crit = 0.25_wp  !< critical bulk Richardson number
-    REAL(wp) ::  topo_max                !< maximum topography level in model domain
-    REAL(wp) ::  topo_max_l              !< maximum topography level in subdomain
-    REAL(wp) ::  vpt_surface             !< near-surface virtual potential temperature
-    REAL(wp) ::  zi_l                    !< mean boundary-layer depth on subdomain
-    REAL(wp) ::  zi_local                !< local boundary-layer depth
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  vpt_col  !< vertical profile of virtual potential temperature at (j,i)-grid point
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  uv_abs   !< vertical profile of horizontal wind speed at (j,i)-grid point
-
-
-!
-!-- Calculate mean boundary-layer height from boundary data.
-!-- Start with the left and right boundaries.
-    zi_l      = 0.0_wp
-    num_boundary_gp_non_cyclic_l = 0
-    IF ( bc_dirichlet_l  .OR.  bc_dirichlet_r )  THEN
-!
-!--    Sum-up and store number of boundary grid points used for averaging ABL depth
-       num_boundary_gp_non_cyclic_l = num_boundary_gp_non_cyclic_l + nxr - nxl + 1
-!
-!--    Determine index along x. Please note, index indicates boundary grid point for scalars.
-       i = MERGE( -1, nxr + 1, bc_dirichlet_l )
-
-       DO  j = nys, nyn
-!
-!--       Determine topography top index at current (j,i) index
-          k_surface = topo_top_ind(j,i,0)
-!
-!--       Pre-compute surface virtual temperature. Therefore, use 2nd prognostic level according to
-!--       Heinze et al. (2017).
-          IF ( humidity )  THEN
-             vpt_surface = pt(k_surface+2,j,i) * ( 1.0_wp + 0.61_wp * q(k_surface+2,j,i) )
-             vpt_col     = pt(:,j,i) * ( 1.0_wp + 0.61_wp * q(:,j,i) )
-          ELSE
-             vpt_surface = pt(k_surface+2,j,i)
-             vpt_col     = pt(:,j,i)
-          ENDIF
-!
-!--       Calculate local boundary layer height from bulk Richardson number, i.e. the height where
-!--       the bulk Richardson number exceeds its critical value of 0.25
-!--       (according to Heinze et al., 2017).
-!--       Note, no interpolation of u- and v-component is made, as both are mainly mean inflow
-!--       profiles with very small spatial variation.
-!--       Add a safety factor in case the velocity term becomes zero. This may happen if overhanging
-!--       3D structures are directly located at the boundary, where velocity inside the building is
-!--       zero (k_surface is the index of the lowest upward-facing surface).
-          uv_abs(:) = SQRT( MERGE( u(:,j,i+1), u(:,j,i), bc_dirichlet_l )**2 + v(:,j,i)**2 )
-!
-!--       Determine index of the maximum wind speed
-          k_max_loc = MAXLOC( uv_abs(:), DIM = 1 ) - 1
-
-          zi_local = 0.0_wp
-          DO  k = k_surface+1, nzt
-             ri_bulk = zu(k) * g / vpt_surface *                                                   &
-                       ( vpt_col(k) - vpt_surface ) / ( uv_abs(k) + 1E-5_wp )
-!
-!--          Check if critical Richardson number is exceeded. Further, check if there is a maxium in
-!--          the wind profile in order to detect also ABL heights in the stable boundary layer.
-             IF ( zi_local == 0.0_wp  .AND.  ( ri_bulk > ri_bulk_crit .OR. k == k_max_loc ) )      &
-                zi_local = zu(k)
-          ENDDO
-!
-!--       Assure that the minimum local boundary-layer depth is at least at the second vertical grid
-!--       level.
-          zi_l = zi_l + MAX( zi_local, zu(k_surface+2) )
-
-       ENDDO
-
-    ENDIF
-!
-!-- Do the same at the north and south boundaries.
-    IF ( bc_dirichlet_s  .OR.  bc_dirichlet_n )  THEN
-
-       num_boundary_gp_non_cyclic_l = num_boundary_gp_non_cyclic_l + nxr - nxl + 1
-
-       j = MERGE( -1, nyn + 1, bc_dirichlet_s )
-
-       DO  i = nxl, nxr
-          k_surface = topo_top_ind(j,i,0)
-
-          IF ( humidity )  THEN
-             vpt_surface = pt(k_surface+2,j,i) * ( 1.0_wp + 0.61_wp * q(k_surface+2,j,i) )
-             vpt_col     = pt(:,j,i) * ( 1.0_wp + 0.61_wp * q(:,j,i) )
-          ELSE
-             vpt_surface = pt(k_surface+2,j,i)
-             vpt_col  = pt(:,j,i)
-          ENDIF
-
-          uv_abs(:) = SQRT( u(:,j,i)**2 + MERGE( v(:,j+1,i), v(:,j,i), bc_dirichlet_s )**2 )
-!
-!--       Determine index of the maximum wind speed
-          k_max_loc = MAXLOC( uv_abs(:), DIM = 1 ) - 1
-
-          zi_local = 0.0_wp
-          DO  k = k_surface+1, nzt
-             ri_bulk = zu(k) * g / vpt_surface *                                                   &
-                       ( vpt_col(k) - vpt_surface ) / ( uv_abs(k) + 1E-5_wp )
-!
-!--          Check if critical Richardson number is exceeded. Further, check if there is a maxium in
-!--          the wind profile in order to detect also ABL heights in the stable boundary layer.
-             IF ( zi_local == 0.0_wp  .AND.  ( ri_bulk > ri_bulk_crit .OR. k == k_max_loc ) )      &
-                zi_local = zu(k)
-          ENDDO
-          zi_l = zi_l + MAX( zi_local, zu(k_surface+2) )
-
-       ENDDO
-
-    ENDIF
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( zi_l, zi_ribulk, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-    CALL MPI_ALLREDUCE( num_boundary_gp_non_cyclic_l, num_boundary_gp_non_cyclic,                  &
-                        1, MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-    zi_ribulk = zi_l
-    num_boundary_gp_non_cyclic = num_boundary_gp_non_cyclic_l
-#endif
-    zi_ribulk = zi_ribulk / REAL( num_boundary_gp_non_cyclic, KIND = wp )
-!
-!-- Finally, check if boundary layer depth is not below the any topography.
-!-- zi_ribulk will be used to adjust rayleigh damping height, i.e. the lower level of the sponge
-!-- layer, as well as to adjust the synthetic turbulence generator accordingly. If Rayleigh damping
-!-- would be applied near buildings, etc., this would spoil the simulation results.
-    topo_max_l = zw(MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ))
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( topo_max_l, topo_max, 1, MPI_REAL, MPI_MAX, comm2d, ierr )
-#else
-    topo_max     = topo_max_l
-#endif
-!        zi_ribulk = MAX( zi_ribulk, topo_max )
-
- END SUBROUTINE nesting_offl_calc_zi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-!--------------------------------------------------------------------------------------------------!
-!> Adjust the height where the rayleigh damping starts, i.e. the lower level of the sponge layer.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE adjust_sponge_layer
-
-    INTEGER(iwp) :: k   !< loop index in z-direction
-
-    REAL(wp) ::  rdh    !< updated Rayleigh damping height
-
-
-    IF ( rayleigh_damping_height > 0.0_wp  .AND.  rayleigh_damping_factor > 0.0_wp )  THEN
-!
-!--    Update Rayleigh-damping height and re-calculate height-depending damping coefficients.
-!--    Assure that rayleigh damping starts well above the boundary layer.
-       rdh = MIN( MAX( zi_ribulk * 1.3_wp, 10.0_wp * dz(1) ),                                      &
-                  0.8_wp * zu(nzt), rayleigh_damping_height )
-!
-!--       Update Rayleigh damping factor
-       DO  k = nzb+1, nzt
-          IF ( zu(k) >= rdh )  THEN
-             rdf(k) = rayleigh_damping_factor *                                                    &
-                      ( SIN( pi * 0.5_wp * ( zu(k) - rdh ) / ( zu(nzt) - rdh ) ) )**2
-          ENDIF
-       ENDDO
-       rdf_sc = rdf
-
-    ENDIF
-
- END SUBROUTINE adjust_sponge_layer
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Performs consistency checks
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_check_parameters
-!
-!-- Check if offline nesting is applied in nested child domain.
-    IF ( nesting_offline  .AND.  child_domain )  THEN
-       message_string = 'Offline nesting is only applicable in root model.'
-       CALL message( 'offline_nesting_check_parameters', 'PA0622', 1, 2, 0, 6, 0 )
-    ENDIF
-
- END SUBROUTINE nesting_offl_check_parameters
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads the parameter list nesting_offl_parameters
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_parin
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter file
-
-    INTEGER(iwp) ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /nesting_offl_parameters/  switch_off_module
-
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, nesting_offl_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    nesting_offl_parameters namelist was found and read correctly. Enable the
-!--    offline nesting.
-       IF ( .NOT. switch_off_module )  nesting_offline = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    nesting_offl_parameters namelist was found but contained errors. Print an error message
-!--    including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'nesting_offl_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE nesting_offl_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Writes information about offline nesting into HEADER file
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_header ( io )
-
-    INTEGER(iwp), INTENT(IN) ::  io  !< Unit of the output file
-
-    WRITE ( io, 1 )
-    IF ( nesting_offline )  THEN
-       WRITE ( io, 3 )
-    ELSE
-       WRITE ( io, 2 )
-    ENDIF
-
-1 FORMAT (//' Offline nesting in COSMO model:'/' -------------------------------'/)
-2 FORMAT (' --> No offlince nesting is used (default) ')
-3 FORMAT (' --> Offlince nesting is used. Boundary data is read from dynamic input file ')
-
- END SUBROUTINE nesting_offl_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate arrays used to read boundary data from NetCDF file and initialize boundary data.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_init
-
-    INTEGER(iwp) ::  i   !< loop index for x-direction
-    INTEGER(iwp) ::  j   !< loop index for y-direction
-    INTEGER(iwp) ::  n   !< running index for chemical species
-
-!
-!-- Before arrays for the boundary data are allocated, the LOD of the dynamic input data at the
-!-- boundaries is read.
-#if defined ( __netcdf )
-!
-!-- Open file in read-only mode
-    CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), pids_id )
-!
-!-- Read attributes for LOD. In order to gurantee that also older drivers, where attribute is not
-!-- given, are working, do not abort the run but assume LOD2 forcing.
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_east_pt,  .FALSE., 'ls_forcing_left_pt', .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_east_qv,  .FALSE., 'ls_forcing_left_qv', .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_east_u,   .FALSE., 'ls_forcing_left_u',  .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_east_v,   .FALSE., 'ls_forcing_left_v',  .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_east_w,   .FALSE., 'ls_forcing_left_w',  .FALSE. )
-
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_north_pt, .FALSE., 'ls_forcing_north_pt', .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_north_qv, .FALSE., 'ls_forcing_north_qv', .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_north_u,  .FALSE., 'ls_forcing_north_u',  .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_north_v,  .FALSE., 'ls_forcing_north_v',  .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_north_w,  .FALSE., 'ls_forcing_north_w',  .FALSE. )
-
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_south_pt, .FALSE., 'ls_forcing_south_pt', .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_south_qv, .FALSE., 'ls_forcing_south_qv', .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_south_u,  .FALSE., 'ls_forcing_south_u',  .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_south_v,  .FALSE., 'ls_forcing_south_v',  .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_south_w,  .FALSE., 'ls_forcing_south_w',  .FALSE. )
-
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_west_pt,  .FALSE., 'ls_forcing_right_pt', .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_west_qv,  .FALSE., 'ls_forcing_right_qv', .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_west_u,   .FALSE., 'ls_forcing_right_u',  .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_west_v,   .FALSE., 'ls_forcing_right_v',  .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_west_w,   .FALSE., 'ls_forcing_right_w',  .FALSE. )
-
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_top_pt,   .FALSE., 'ls_forcing_top_pt', .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_top_qv,   .FALSE., 'ls_forcing_top_qv', .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_top_u,    .FALSE., 'ls_forcing_top_u',  .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_top_v,    .FALSE., 'ls_forcing_top_v',  .FALSE. )
-    CALL get_attribute( pids_id, char_lod, nest_offl%lod_top_w,    .FALSE., 'ls_forcing_top_w',  .FALSE. )
-
-    CALL close_input_file( pids_id )
-#endif
-!
-!-- Temporary workaround until most of the dynamic drivers contain a LOD attribute. So far INIFOR
-!-- did not provide the LOD attribute. In order to still use these older dynamic drivers, provide a
-!-- temporary workaround. If the LOD is not given, a NetCDF interal error will occur but the
-!-- simulation will not be aborted since the no_abort flag is passed. However, the respective
-!-- attribute value might be given an arbitrary number. Hence, check for valid LOD's and manually
-!-- set them to LOD 2 (as assumed so far). Note, this workaround should be removed later (date of
-!-- reference: 6. Oct. 2020).
-    IF ( nest_offl%lod_east_pt /= 1  .AND.  nest_offl%lod_east_pt /= 2 )  nest_offl%lod_east_pt = 2
-    IF ( nest_offl%lod_east_qv /= 1  .AND.  nest_offl%lod_east_qv /= 2 )  nest_offl%lod_east_qv = 2
-    IF ( nest_offl%lod_east_u  /= 1  .AND.  nest_offl%lod_east_u  /= 2 )  nest_offl%lod_east_u  = 2
-    IF ( nest_offl%lod_east_v  /= 1  .AND.  nest_offl%lod_east_v  /= 2 )  nest_offl%lod_east_v  = 2
-    IF ( nest_offl%lod_east_w  /= 1  .AND.  nest_offl%lod_east_w  /= 2 )  nest_offl%lod_east_w  = 2
-
-    IF ( nest_offl%lod_north_pt /= 1  .AND.  nest_offl%lod_north_pt /= 2 )  nest_offl%lod_north_pt = 2
-    IF ( nest_offl%lod_north_qv /= 1  .AND.  nest_offl%lod_north_qv /= 2 )  nest_offl%lod_north_qv = 2
-    IF ( nest_offl%lod_north_u  /= 1  .AND.  nest_offl%lod_north_u  /= 2 )  nest_offl%lod_north_u  = 2
-    IF ( nest_offl%lod_north_v  /= 1  .AND.  nest_offl%lod_north_v  /= 2 )  nest_offl%lod_north_v  = 2
-    IF ( nest_offl%lod_north_w  /= 1  .AND.  nest_offl%lod_north_w  /= 2 )  nest_offl%lod_north_w  = 2
-
-    IF ( nest_offl%lod_south_pt /= 1  .AND.  nest_offl%lod_south_pt /= 2 )  nest_offl%lod_south_pt = 2
-    IF ( nest_offl%lod_south_qv /= 1  .AND.  nest_offl%lod_south_qv /= 2 )  nest_offl%lod_south_qv = 2
-    IF ( nest_offl%lod_south_u  /= 1  .AND.  nest_offl%lod_south_u  /= 2 )  nest_offl%lod_south_u  = 2
-    IF ( nest_offl%lod_south_v  /= 1  .AND.  nest_offl%lod_south_v  /= 2 )  nest_offl%lod_south_v  = 2
-    IF ( nest_offl%lod_south_w  /= 1  .AND.  nest_offl%lod_south_w  /= 2 )  nest_offl%lod_south_w  = 2
-
-    IF ( nest_offl%lod_west_pt /= 1  .AND.  nest_offl%lod_west_pt /= 2 )  nest_offl%lod_west_pt = 2
-    IF ( nest_offl%lod_west_qv /= 1  .AND.  nest_offl%lod_west_qv /= 2 )  nest_offl%lod_west_qv = 2
-    IF ( nest_offl%lod_west_u  /= 1  .AND.  nest_offl%lod_west_u  /= 2 )  nest_offl%lod_west_u  = 2
-    IF ( nest_offl%lod_west_v  /= 1  .AND.  nest_offl%lod_west_v  /= 2 )  nest_offl%lod_west_v  = 2
-    IF ( nest_offl%lod_west_w  /= 1  .AND.  nest_offl%lod_west_w  /= 2 )  nest_offl%lod_west_w  = 2
-
-    IF ( nest_offl%lod_top_pt /= 1  .AND.  nest_offl%lod_top_pt /= 2 )  nest_offl%lod_top_pt = 2
-    IF ( nest_offl%lod_top_qv /= 1  .AND.  nest_offl%lod_top_qv /= 2 )  nest_offl%lod_top_qv = 2
-    IF ( nest_offl%lod_top_u  /= 1  .AND.  nest_offl%lod_top_u  /= 2 )  nest_offl%lod_top_u  = 2
-    IF ( nest_offl%lod_top_v  /= 1  .AND.  nest_offl%lod_top_v  /= 2 )  nest_offl%lod_top_v  = 2
-    IF ( nest_offl%lod_top_w  /= 1  .AND.  nest_offl%lod_top_w  /= 2 )  nest_offl%lod_top_w  = 2
-!
-!-- For consistency, check if all boundary input variables have the same LOD.
-    IF ( MAX( nest_offl%lod_east_pt,  nest_offl%lod_east_qv,  nest_offl%lod_east_u,                &
-              nest_offl%lod_east_v,   nest_offl%lod_east_w,                                        &
-              nest_offl%lod_north_pt, nest_offl%lod_north_qv, nest_offl%lod_north_u,               &
-              nest_offl%lod_north_v,  nest_offl%lod_north_w,                                       &
-              nest_offl%lod_south_pt, nest_offl%lod_south_qv, nest_offl%lod_south_u,               &
-              nest_offl%lod_south_v,  nest_offl%lod_south_w,                                       &
-              nest_offl%lod_north_pt, nest_offl%lod_north_qv, nest_offl%lod_north_u,               &
-              nest_offl%lod_north_v,  nest_offl%lod_north_w,                                       &
-              nest_offl%lod_top_pt,   nest_offl%lod_top_qv,   nest_offl%lod_top_u,                 &
-              nest_offl%lod_top_v,    nest_offl%lod_top_w )                                        &
-            /=                                                                                     &
-         MIN( nest_offl%lod_east_pt,  nest_offl%lod_east_qv,  nest_offl%lod_east_u,                &
-              nest_offl%lod_east_v,   nest_offl%lod_east_w,                                        &
-              nest_offl%lod_north_pt, nest_offl%lod_north_qv, nest_offl%lod_north_u,               &
-              nest_offl%lod_north_v,  nest_offl%lod_north_w,                                       &
-              nest_offl%lod_south_pt, nest_offl%lod_south_qv, nest_offl%lod_south_u,               &
-              nest_offl%lod_south_v,  nest_offl%lod_south_w,                                       &
-              nest_offl%lod_north_pt, nest_offl%lod_north_qv, nest_offl%lod_north_u,               &
-              nest_offl%lod_north_v,  nest_offl%lod_north_w,                                       &
-              nest_offl%lod_top_pt,   nest_offl%lod_top_qv,   nest_offl%lod_top_u,                 &
-              nest_offl%lod_top_v,    nest_offl%lod_top_w ) )  THEN
-       message_string = 'A mixture of different LOD for the provided boundary data is not ' //     &
-                        'possible.'
-       CALL message( 'nesting_offl_init', 'PA0504', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- As all LODs are the same, store it.
-    lod = nest_offl%lod_east_u
-!
-!-- Allocate arrays for geostrophic wind components. Arrays will incorporate 2 time levels in order
-!-- to interpolate in between.
-    ALLOCATE( nest_offl%ug(0:1,1:nzt) )
-    ALLOCATE( nest_offl%vg(0:1,1:nzt) )
-!
-!-- Set index range according to the given LOD in order to allocate the input arrays.
-    IF ( bc_dirichlet_l  .OR.  bc_dirichlet_r  )  THEN
-       IF ( lod == 2 )  THEN
-          j_start   = nys
-          j_start_v = nysv
-          j_end     = nyn
-       ELSE
-          j_start   = 1
-          j_start_v = 1
-          j_end     = 1
-       ENDIF
-    ENDIF
-
-    IF ( bc_dirichlet_n  .OR.  bc_dirichlet_s )  THEN
-       IF( lod == 2 )  THEN
-          i_start   = nxl
-          i_start_u = nxlu
-          i_end     = nxr
-       ELSE
-          i_start   = 1
-          i_start_u = 1
-          i_end     = 1
-       ENDIF
-    ENDIF
-!
-!-- Allocate arrays for reading left/right boundary values. Arrays will incorporate 2 time levels in
-!-- order to interpolate in between. Depending on the given LOD, the x-, or y-dimension will be
-!-- either nxl:nxr, or nys:nyn (for LOD=2), or it reduces to one element for LOD=1. If the core has
-!-- no lateral boundary, allocate a dummy array as well, in order to enable netcdf parallel access.
-!-- Dummy arrays will be allocated with dimension length zero.
-    IF ( bc_dirichlet_l )  THEN
-       ALLOCATE( nest_offl%u_l(0:1,nzb+1:nzt,j_start:j_end)  )
-       ALLOCATE( nest_offl%v_l(0:1,nzb+1:nzt,j_start_v:j_end) )
-       ALLOCATE( nest_offl%w_l(0:1,nzb+1:nzt-1,j_start:j_end) )
-       IF ( humidity )       ALLOCATE( nest_offl%q_l(0:1,nzb+1:nzt,j_start:j_end)  )
-       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_l(0:1,nzb+1:nzt,j_start:j_end) )
-       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
-          ALLOCATE( nest_offl%chem_l(0:1,nzb+1:nzt,j_start:j_end,1:UBOUND( chem_species, 1 )) )
-    ELSE
-       ALLOCATE( nest_offl%u_l(1:1,1:1,1:1)  )
-       ALLOCATE( nest_offl%v_l(1:1,1:1,1:1)  )
-       ALLOCATE( nest_offl%w_l(1:1,1:1,1:1)  )
-       IF ( humidity )       ALLOCATE( nest_offl%q_l(1:1,1:1,1:1)  )
-       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_l(1:1,1:1,1:1)  )
-       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
-          ALLOCATE( nest_offl%chem_l(1:1,1:1,1:1,1:UBOUND( chem_species, 1 )) )
-    ENDIF
-    IF ( bc_dirichlet_r )  THEN
-       ALLOCATE( nest_offl%u_r(0:1,nzb+1:nzt,j_start:j_end)  )
-       ALLOCATE( nest_offl%v_r(0:1,nzb+1:nzt,j_start_v:j_end) )
-       ALLOCATE( nest_offl%w_r(0:1,nzb+1:nzt-1,j_start:j_end) )
-       IF ( humidity )       ALLOCATE( nest_offl%q_r(0:1,nzb+1:nzt,j_start:j_end)  )
-       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_r(0:1,nzb+1:nzt,j_start:j_end) )
-       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
-          ALLOCATE( nest_offl%chem_r(0:1,nzb+1:nzt,j_start:j_end,1:UBOUND( chem_species, 1 )) )
-    ELSE
-       ALLOCATE( nest_offl%u_r(1:1,1:1,1:1)  )
-       ALLOCATE( nest_offl%v_r(1:1,1:1,1:1)  )
-       ALLOCATE( nest_offl%w_r(1:1,1:1,1:1)  )
-       IF ( humidity )       ALLOCATE( nest_offl%q_r(1:1,1:1,1:1)  )
-       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_r(1:1,1:1,1:1)  )
-       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
-          ALLOCATE( nest_offl%chem_r(1:1,1:1,1:1,1:UBOUND( chem_species, 1 )) )
-    ENDIF
-!
-!-- Allocate arrays for reading north/south boundary values. Arrays will incorporate 2 time levels
-!-- in order to interpolate in between. If the core has no boundary, allocate a dummy array, in
-!-- order to enable netcdf parallel access. Dummy arrays will be allocated with dimension length
-!-- zero.
-    IF ( bc_dirichlet_n )  THEN
-       ALLOCATE( nest_offl%u_n(0:1,nzb+1:nzt,i_start_u:i_end) )
-       ALLOCATE( nest_offl%v_n(0:1,nzb+1:nzt,i_start:i_end)  )
-       ALLOCATE( nest_offl%w_n(0:1,nzb+1:nzt-1,i_start:i_end) )
-       IF ( humidity )       ALLOCATE( nest_offl%q_n(0:1,nzb+1:nzt,i_start:i_end)  )
-       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_n(0:1,nzb+1:nzt,i_start:i_end) )
-       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
-          ALLOCATE( nest_offl%chem_n(0:1,nzb+1:nzt,i_start:i_end,1:UBOUND( chem_species, 1 )) )
-    ELSE
-       ALLOCATE( nest_offl%u_n(1:1,1:1,1:1)  )
-       ALLOCATE( nest_offl%v_n(1:1,1:1,1:1)  )
-       ALLOCATE( nest_offl%w_n(1:1,1:1,1:1)  )
-       IF ( humidity )       ALLOCATE( nest_offl%q_n(1:1,1:1,1:1)  )
-       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_n(1:1,1:1,1:1)  )
-       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
-          ALLOCATE( nest_offl%chem_n(1:1,1:1,1:1,1:UBOUND( chem_species, 1 )) )
-    ENDIF
-    IF ( bc_dirichlet_s )  THEN
-       ALLOCATE( nest_offl%u_s(0:1,nzb+1:nzt,i_start_u:i_end) )
-       ALLOCATE( nest_offl%v_s(0:1,nzb+1:nzt,i_start:i_end)  )
-       ALLOCATE( nest_offl%w_s(0:1,nzb+1:nzt-1,i_start:i_end) )
-       IF ( humidity )       ALLOCATE( nest_offl%q_s(0:1,nzb+1:nzt,i_start:i_end)  )
-       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_s(0:1,nzb+1:nzt,i_start:i_end) )
-       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
-          ALLOCATE( nest_offl%chem_s(0:1,nzb+1:nzt,i_start:i_end,1:UBOUND( chem_species, 1 )) )
-    ELSE
-       ALLOCATE( nest_offl%u_s(1:1,1:1,1:1)  )
-       ALLOCATE( nest_offl%v_s(1:1,1:1,1:1)  )
-       ALLOCATE( nest_offl%w_s(1:1,1:1,1:1)  )
-       IF ( humidity )       ALLOCATE( nest_offl%q_s(1:1,1:1,1:1)  )
-       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_s(1:1,1:1,1:1)  )
-       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
-          ALLOCATE( nest_offl%chem_s(1:1,1:1,1:1,1:UBOUND( chem_species, 1 )) )
-    ENDIF
-!
-!-- Allocate arrays for reading data at the top boundary. In contrast to the lateral boundaries,
-!-- each core reads these data so that no dummy arrays need to be allocated.
-    IF ( lod == 2 )  THEN
-       ALLOCATE( nest_offl%u_top(0:1,nys:nyn,nxlu:nxr) )
-       ALLOCATE( nest_offl%v_top(0:1,nysv:nyn,nxl:nxr) )
-       ALLOCATE( nest_offl%w_top(0:1,nys:nyn,nxl:nxr)  )
-       IF ( humidity )       ALLOCATE( nest_offl%q_top(0:1,nys:nyn,nxl:nxr)  )
-       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_top(0:1,nys:nyn,nxl:nxr) )
-       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
-          ALLOCATE( nest_offl%chem_top(0:1,nys:nyn,nxl:nxr,1:UBOUND( chem_species, 1 )) )
-    ELSE
-       ALLOCATE( nest_offl%u_top(0:1,1:1,1:1) )
-       ALLOCATE( nest_offl%v_top(0:1,1:1,1:1) )
-       ALLOCATE( nest_offl%w_top(0:1,1:1,1:1)  )
-       IF ( humidity )       ALLOCATE( nest_offl%q_top(0:1,1:1,1:1)  )
-       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_top(0:1,1:1,1:1) )
-       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
-          ALLOCATE( nest_offl%chem_top(0:1,1:1,1:1,1:UBOUND( chem_species, 1 )) )
-    ENDIF
-!
-!-- For chemical species, create the names of the variables. This is necessary to identify the
-!-- respective variable and write it onto the correct array in the chem_species datatype.
-    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-       ALLOCATE( nest_offl%chem_from_file_l(1:UBOUND( chem_species, 1 )) )
-       ALLOCATE( nest_offl%chem_from_file_n(1:UBOUND( chem_species, 1 )) )
-       ALLOCATE( nest_offl%chem_from_file_r(1:UBOUND( chem_species, 1 )) )
-       ALLOCATE( nest_offl%chem_from_file_s(1:UBOUND( chem_species, 1 )) )
-       ALLOCATE( nest_offl%chem_from_file_t(1:UBOUND( chem_species, 1 )) )
-
-       ALLOCATE( nest_offl%var_names_chem_l(1:UBOUND( chem_species, 1 )) )
-       ALLOCATE( nest_offl%var_names_chem_n(1:UBOUND( chem_species, 1 )) )
-       ALLOCATE( nest_offl%var_names_chem_r(1:UBOUND( chem_species, 1 )) )
-       ALLOCATE( nest_offl%var_names_chem_s(1:UBOUND( chem_species, 1 )) )
-       ALLOCATE( nest_offl%var_names_chem_t(1:UBOUND( chem_species, 1 )) )
-!
-!--    Initialize flags that indicate whether the variable is on file or not. Please note, this is
-!--    only necessary for chemistry variables.
-       nest_offl%chem_from_file_l(:) = .FALSE.
-       nest_offl%chem_from_file_n(:) = .FALSE.
-       nest_offl%chem_from_file_r(:) = .FALSE.
-       nest_offl%chem_from_file_s(:) = .FALSE.
-       nest_offl%chem_from_file_t(:) = .FALSE.
-
-       DO  n = 1, UBOUND( chem_species, 1 )
-          nest_offl%var_names_chem_l(n) = nest_offl%char_l // TRIM(chem_species(n)%name)
-          nest_offl%var_names_chem_n(n) = nest_offl%char_n // TRIM(chem_species(n)%name)
-          nest_offl%var_names_chem_r(n) = nest_offl%char_r // TRIM(chem_species(n)%name)
-          nest_offl%var_names_chem_s(n) = nest_offl%char_s // TRIM(chem_species(n)%name)
-          nest_offl%var_names_chem_t(n) = nest_offl%char_t // TRIM(chem_species(n)%name)
-       ENDDO
-    ENDIF
-!
-!-- Offline nesting for salsa
-    IF ( salsa )  CALL salsa_nesting_offl_init
-!
-!-- Before initial data input is initiated, check if dynamic input file is present.
-    IF ( .NOT. input_pids_dynamic )  THEN
-       message_string = 'nesting_offline = .TRUE. requires dynamic '  //                           &
-                         'input file ' // TRIM( input_file_dynamic ) // TRIM( coupling_char )
-       CALL message( 'nesting_offl_init', 'PA0546', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Read COSMO data at lateral and top boundaries
-    CALL nesting_offl_input
-!
-!-- Check if sufficient time steps are provided to cover the entire simulation. Note, dynamic input
-!-- is only required for the 3D simulation, not for the soil/wall spinup. However, as the spinup
-!-- time is added to the end_time, this must be considered here.
-    IF ( end_time - spinup_time > nest_offl%time(nest_offl%nt-1) )  THEN
-       message_string = 'end_time of the simulation exceeds the ' //                               &
-                        'time dimension in the dynamic input file.'
-       CALL message( 'nesting_offl_init', 'PA0183', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Set indicies for boundary grid points
-    IF ( bc_dirichlet_l  .OR.  bc_dirichlet_r )  THEN
-       i_bound   = MERGE( nxl  - 1, nxr + 1, bc_dirichlet_l )
-       i_bound_u = MERGE( nxlu - 1, nxr + 1, bc_dirichlet_l )
-    ENDIF
-    IF ( bc_dirichlet_n  .OR.  bc_dirichlet_s )  THEN
-       j_bound   = MERGE( nys  - 1, nyn + 1, bc_dirichlet_s )
-       j_bound_v = MERGE( nysv - 1, nyn + 1, bc_dirichlet_s )
-    ENDIF
-!
-!-- Initialize boundary data. Please note, do not initialize boundaries in case of restart runs.
-!-- This case the boundaries are already initialized and the boundary data from file would be on the
-!-- wrong time level.
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-!
-!--    Distinguish between LOD = 1 and LOD = 2 inititialization
-       IF ( lod == 2 )  THEN
-          IF ( bc_dirichlet_l )  THEN
-             u(nzb+1:nzt,nys:nyn,i_bound_u) = nest_offl%u_l(0,nzb+1:nzt,nys:nyn)
-             v(nzb+1:nzt,nysv:nyn,i_bound)  = nest_offl%v_l(0,nzb+1:nzt,nysv:nyn)
-             w(nzb+1:nzt-1,nys:nyn,i_bound) = nest_offl%w_l(0,nzb+1:nzt-1,nys:nyn)
-             IF ( .NOT. neutral )  pt(nzb+1:nzt,nys:nyn,i_bound) = nest_offl%pt_l(0,nzb+1:nzt,nys:nyn)
-             IF ( humidity      )  q(nzb+1:nzt,nys:nyn,i_bound)  = nest_offl%q_l(0,nzb+1:nzt,nys:nyn)
-             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-                DO  n = 1, UBOUND( chem_species, 1 )
-                   IF( nest_offl%chem_from_file_l(n) )  THEN
-                      chem_species(n)%conc(nzb+1:nzt,nys:nyn,i_bound) =                            &
-                                                             nest_offl%chem_l(0,nzb+1:nzt,nys:nyn,n)
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDIF
-          IF ( bc_dirichlet_r )  THEN
-             u(nzb+1:nzt,nys:nyn,i_bound_u) = nest_offl%u_r(0,nzb+1:nzt,nys:nyn)
-             v(nzb+1:nzt,nysv:nyn,i_bound)  = nest_offl%v_r(0,nzb+1:nzt,nysv:nyn)
-             w(nzb+1:nzt-1,nys:nyn,i_bound) = nest_offl%w_r(0,nzb+1:nzt-1,nys:nyn)
-             IF ( .NOT. neutral )  pt(nzb+1:nzt,nys:nyn,i_bound) = nest_offl%pt_r(0,nzb+1:nzt,nys:nyn)
-             IF ( humidity      )  q(nzb+1:nzt,nys:nyn,i_bound)  = nest_offl%q_r(0,nzb+1:nzt,nys:nyn)
-             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-                DO  n = 1, UBOUND( chem_species, 1 )
-                   IF( nest_offl%chem_from_file_r(n) )  THEN
-                      chem_species(n)%conc(nzb+1:nzt,nys:nyn,i_bound) =                            &
-                                                             nest_offl%chem_r(0,nzb+1:nzt,nys:nyn,n)
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDIF
-
-          IF ( bc_dirichlet_n)  THEN
-             u(nzb+1:nzt,j_bound,nxlu:nxr)  = nest_offl%u_n(0,nzb+1:nzt,nxlu:nxr)
-             v(nzb+1:nzt,j_bound_v,nxl:nxr) = nest_offl%v_n(0,nzb+1:nzt,nxl:nxr)
-             w(nzb+1:nzt-1,j_bound,nxl:nxr) = nest_offl%w_n(0,nzb+1:nzt-1,nxl:nxr)
-             IF ( .NOT. neutral )  pt(nzb+1:nzt,j_bound,nxl:nxr) = nest_offl%pt_n(0,nzb+1:nzt,nxl:nxr)
-             IF ( humidity      )  q(nzb+1:nzt,j_bound,nxl:nxr)  = nest_offl%q_n(0,nzb+1:nzt,nxl:nxr)
-             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-                DO  n = 1, UBOUND( chem_species, 1 )
-                   IF( nest_offl%chem_from_file_n(n) )  THEN
-                      chem_species(n)%conc(nzb+1:nzt,j_bound,nxl:nxr) =                            &
-                                                             nest_offl%chem_n(0,nzb+1:nzt,nxl:nxr,n)
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDIF
-          IF ( bc_dirichlet_s)  THEN
-             u(nzb+1:nzt,j_bound,nxlu:nxr)  = nest_offl%u_s(0,nzb+1:nzt,nxlu:nxr)
-             v(nzb+1:nzt,j_bound_v,nxl:nxr) = nest_offl%v_s(0,nzb+1:nzt,nxl:nxr)
-             w(nzb+1:nzt-1,j_bound,nxl:nxr) = nest_offl%w_s(0,nzb+1:nzt-1,nxl:nxr)
-             IF ( .NOT. neutral )  pt(nzb+1:nzt,j_bound,nxl:nxr) = nest_offl%pt_s(0,nzb+1:nzt,nxl:nxr)
-             IF ( humidity      )  q(nzb+1:nzt,j_bound,nxl:nxr)  = nest_offl%q_s(0,nzb+1:nzt,nxl:nxr)
-             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-                DO  n = 1, UBOUND( chem_species, 1 )
-                   IF( nest_offl%chem_from_file_s(n) )  THEN
-                      chem_species(n)%conc(nzb+1:nzt,j_bound,nxl:nxr) =                            &
-                                                             nest_offl%chem_s(0,nzb+1:nzt,nxl:nxr,n)
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDIF
-
-          u(nzt+1,nys:nyn,nxlu:nxr) = nest_offl%u_top(0,nys:nyn,nxlu:nxr)
-          v(nzt+1,nysv:nyn,nxl:nxr) = nest_offl%v_top(0,nysv:nyn,nxl:nxr)
-          w(nzt,nys:nyn,nxl:nxr)    = nest_offl%w_top(0,nys:nyn,nxl:nxr)
-          w(nzt+1,nys:nyn,nxl:nxr)  = nest_offl%w_top(0,nys:nyn,nxl:nxr)
-          IF ( .NOT. neutral )  pt(nzt+1,nys:nyn,nxl:nxr) = nest_offl%pt_top(0,nys:nyn,nxl:nxr)
-          IF ( humidity )       q(nzt+1,nys:nyn,nxl:nxr)  = nest_offl%q_top(0,nys:nyn,nxl:nxr)
-          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-             DO  n = 1, UBOUND( chem_species, 1 )
-                IF( nest_offl%chem_from_file_t(n) )  THEN
-                   chem_species(n)%conc(nzt+1,nys:nyn,nxl:nxr) =                                   &
-                                                             nest_offl%chem_top(0,nys:nyn,nxl:nxr,n)
-                ENDIF
-             ENDDO
-          ENDIF
-!
-!--    LOD 1
-       ELSE
-          IF ( bc_dirichlet_l )  THEN
-             DO  j = nys, nyn
-                u(nzb+1:nzt,j,i_bound_u) = nest_offl%u_l(0,nzb+1:nzt,1)
-                w(nzb+1:nzt-1,j,i_bound) = nest_offl%w_l(0,nzb+1:nzt-1,1)
-             ENDDO
-             DO  j = nysv, nyn
-                v(nzb+1:nzt,j,i_bound)  = nest_offl%v_l(0,nzb+1:nzt,1)
-             ENDDO
-             IF ( .NOT. neutral )  THEN
-                DO  j = nys, nyn
-                   pt(nzb+1:nzt,j,i_bound) = nest_offl%pt_l(0,nzb+1:nzt,1)
-                ENDDO
-             ENDIF
-             IF ( humidity      )  THEN
-                DO  j = nys, nyn
-                   q(nzb+1:nzt,j,i_bound)  = nest_offl%q_l(0,nzb+1:nzt,1)
-                ENDDO
-             ENDIF
-             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-                DO  n = 1, UBOUND( chem_species, 1 )
-                   IF( nest_offl%chem_from_file_l(n) )  THEN
-                      DO  j = nys, nyn
-                         chem_species(n)%conc(nzb+1:nzt,j,i_bound) =                               &
-                                                                   nest_offl%chem_l(0,nzb+1:nzt,1,n)
-                      ENDDO
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDIF
-          IF ( bc_dirichlet_r )  THEN
-             DO  j = nys, nyn
-                u(nzb+1:nzt,j,i_bound_u) = nest_offl%u_r(0,nzb+1:nzt,1)
-                w(nzb+1:nzt-1,j,i_bound) = nest_offl%w_r(0,nzb+1:nzt-1,1)
-             ENDDO
-             DO  j = nysv, nyn
-                v(nzb+1:nzt,j,i_bound)  = nest_offl%v_r(0,nzb+1:nzt,1)
-             ENDDO
-             IF ( .NOT. neutral )  THEN
-                DO  j = nys, nyn
-                   pt(nzb+1:nzt,j,i_bound) = nest_offl%pt_r(0,nzb+1:nzt,1)
-                ENDDO
-             ENDIF
-             IF ( humidity      )  THEN
-                DO  j = nys, nyn
-                   q(nzb+1:nzt,j,i_bound)  = nest_offl%q_r(0,nzb+1:nzt,1)
-                ENDDO
-             ENDIF
-             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-                DO  n = 1, UBOUND( chem_species, 1 )
-                   IF( nest_offl%chem_from_file_r(n) )  THEN
-                      DO  j = nys, nyn
-                         chem_species(n)%conc(nzb+1:nzt,j,i_bound) =                               &
-                                                                   nest_offl%chem_r(0,nzb+1:nzt,1,n)
-                      ENDDO
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDIF
-          IF ( bc_dirichlet_n )  THEN
-             DO  i = nxlu, nxr
-                u(nzb+1:nzt,j_bound,i)  = nest_offl%u_n(0,nzb+1:nzt,1)
-             ENDDO
-             DO  i = nxl, nxr
-                v(nzb+1:nzt,j_bound_v,i) = nest_offl%v_n(0,nzb+1:nzt,1)
-                w(nzb+1:nzt-1,j_bound,i) = nest_offl%w_n(0,nzb+1:nzt-1,1)
-             ENDDO
-             IF ( .NOT. neutral )  THEN
-                DO  i = nxl, nxr
-                   pt(nzb+1:nzt,j_bound,i) = nest_offl%pt_n(0,nzb+1:nzt,1)
-                ENDDO
-             ENDIF
-             IF ( humidity      )  THEN
-                DO  i = nxl, nxr
-                   q(nzb+1:nzt,j_bound,i)  = nest_offl%q_n(0,nzb+1:nzt,1)
-                ENDDO
-             ENDIF
-             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-                DO  n = 1, UBOUND( chem_species, 1 )
-                   IF( nest_offl%chem_from_file_n(n) )  THEN
-                      DO  i = nxl, nxr
-                         chem_species(n)%conc(nzb+1:nzt,j_bound,i) =                               &
-                                                                   nest_offl%chem_n(0,nzb+1:nzt,1,n)
-                      ENDDO
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDIF
-          IF ( bc_dirichlet_s )  THEN
-             DO  i = nxlu, nxr
-                u(nzb+1:nzt,j_bound,i)  = nest_offl%u_s(0,nzb+1:nzt,1)
-             ENDDO
-             DO  i = nxl, nxr
-                v(nzb+1:nzt,j_bound_v,i) = nest_offl%v_s(0,nzb+1:nzt,1)
-                w(nzb+1:nzt-1,j_bound,i) = nest_offl%w_s(0,nzb+1:nzt-1,1)
-             ENDDO
-             IF ( .NOT. neutral )  THEN
-                DO  i = nxl, nxr
-                   pt(nzb+1:nzt,j_bound,i) = nest_offl%pt_s(0,nzb+1:nzt,1)
-                ENDDO
-             ENDIF
-             IF ( humidity      )  THEN
-                DO  i = nxl, nxr
-                   q(nzb+1:nzt,j_bound,i)  = nest_offl%q_s(0,nzb+1:nzt,1)
-                ENDDO
-             ENDIF
-             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-                DO  n = 1, UBOUND( chem_species, 1 )
-                   IF( nest_offl%chem_from_file_s(n) )  THEN
-                      DO  i = nxl, nxr
-                         chem_species(n)%conc(nzb+1:nzt,j_bound,i) =                               &
-                                                                   nest_offl%chem_s(0,nzb+1:nzt,1,n)
-                      ENDDO
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDIF
-
-          u(nzt+1,nys:nyn,nxlu:nxr) = nest_offl%u_top(0,1,1)
-          v(nzt+1,nysv:nyn,nxl:nxr) = nest_offl%v_top(0,1,1)
-          w(nzt,nys:nyn,nxl:nxr)    = nest_offl%w_top(0,1,1)
-          w(nzt+1,nys:nyn,nxl:nxr)  = nest_offl%w_top(0,1,1)
-          IF ( .NOT. neutral )  pt(nzt+1,nys:nyn,nxl:nxr) = nest_offl%pt_top(0,1,1)
-          IF ( humidity )       q(nzt+1,nys:nyn,nxl:nxr)  = nest_offl%q_top(0,1,1)
-          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
-             DO  n = 1, UBOUND( chem_species, 1 )
-                IF( nest_offl%chem_from_file_t(n) )  THEN
-                   chem_species(n)%conc(nzt+1,nys:nyn,nxl:nxr) = nest_offl%chem_top(0,1,1,n)
-                ENDIF
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    In case of offline nesting the pressure forms itself based on the prescribed lateral
-!--    boundary conditions. Hence, explicit forcing by pressure gradients via geostrophic wind
-!--    components is not necessary and would be canceled out by the perturbation pressure otherwise.
-!--    For this reason, set geostrophic wind components to zero.
-       ug(nzb+1:nzt) = 0.0_wp
-       vg(nzb+1:nzt) = 0.0_wp
-
-    ENDIF
-!
-!-- After boundary data is initialized, mask topography at the boundaries for the velocity
-!-- components.
-    u = MERGE( u, 0.0_wp, BTEST( wall_flags_total_0, 1 ) )
-    v = MERGE( v, 0.0_wp, BTEST( wall_flags_total_0, 2 ) )
-    w = MERGE( w, 0.0_wp, BTEST( wall_flags_total_0, 3 ) )
-!
-!-- Initial calculation of the boundary layer depth from the prescribed boundary data. This is
-!-- required for initialize the synthetic turbulence generator correctly.
-    CALL nesting_offl_calc_zi
-!
-!-- After boundary data is initialized, ensure mass conservation. Not necessary in restart runs.
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-       CALL nesting_offl_mass_conservation
-    ENDIF
-
- END SUBROUTINE nesting_offl_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-!--------------------------------------------------------------------------------------------------!
-!> Interpolation function, used to interpolate boundary data in time.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION interpolate_in_time( var_t1, var_t2, fac  )
-
-    REAL(wp)            :: fac                  !< interpolation factor
-    REAL(wp)            :: interpolate_in_time  !< time-interpolated boundary value
-    REAL(wp)            :: var_t1               !< boundary value at t1
-    REAL(wp)            :: var_t2               !< boundary value at t2
-
-    interpolate_in_time = ( 1.0_wp - fac ) * var_t1 + fac * var_t2
-
- END FUNCTION interpolate_in_time
-
-
-
- END MODULE nesting_offl_mod
Index: palm/trunk/SOURCE/netcdf.f90
===================================================================
--- palm/trunk/SOURCE/netcdf.f90	(revision 1)
+++ palm/trunk/SOURCE/netcdf.f90	(revision 1)
@@ -0,0 +1,3517 @@
+#if defined( __ibmy_special )
+@PROCESS NOOPTimize
+#endif
+ SUBROUTINE define_netcdf_header( callmode, extend, av )
+
+!------------------------------------------------------------------------------!
+! Current revisions:
+! ------------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: netcdf.f90,v $
+! Revision 1.12  2006/09/26 19:35:16  raasch
+! Bugfix yv coordinates for yz cross sections
+!
+! Revision 1.11  2006/08/22 14:13:11  raasch
+! Extension for timeseries information of particle groups,
+! xz and yz cross sections now up to nzt+1
+!
+! Revision 1.10  2006/08/04 14:51:42  raasch
+! Extensions for output of particle time series
+! do2d_unit and do3d_unit now defined as 2d-arrays
+!
+! Revision 1.9  2006/06/13 13:01:08  raasch
+! Some errors of revision 1.8 removed
+!
+! Revision 1.8  2006/06/02 15:23:13  raasch
+! x- and y-coordinates of 2d- and 3d-variables are now precisely defined
+! depending on which grid (u-, v- or scalar) the respective variable is defined
+!
+! Revision 1.7  2006/04/21 14:23:47  letzel
+! Error removed in extend mode when checking whether the selected cross sections
+! match those in the already existing NetCDF file.
+!
+! Revision 1.6  2006/04/11 14:58:47  raasch
+! pl_spectra renamed data_output_sp
+!
+! Revision 1.5  2006/02/23 12:42:07  raasch
+! Extensions for output of 2d/3d time averaged data, definition of grids for
+! user-defined output quantities,
+! error removed getting the variable ids for _ext for profiles and time series,
+! ebene renamed section, pl1d_anz renamed dopr_n,
+! error number argument for handle_netcdf_error,
+! no optimization on ibmy due to compiler error
+!
+! Revision 1.4  2005/12/06 16:42:57  raasch
+! Error in netcdf variable declaration for statistic_regions /= 0 removed
+!
+! Revision 1.3  2005/10/20 15:40:17  raasch
+! real number of particles is additionally contained as a variable on the
+! particle data file,
+! pr_xz added to vertical cross sections,
+! error removed in calculating y axis data for yz cross sections
+!
+! Revision 1.2  2005/06/26 20:04:31  raasch
+! Particle output extended, 2d- and 3d-files are not opened if there is no
+! output for these files (pl2d=pl3d=' ')
+!
+! Revision 1.1  2005/05/18 15:37:16  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! In case of extend = .FALSE.:
+! Define all necessary dimensions, axes and variables for the different
+! NetCDF datasets. This subroutine is called from check_open after a new
+! dataset is created. It leaves the open NetCDF files ready to write.
+!
+! In case of extend = .TRUE.:
+! Find out if dimensions and variables of an existing file match the values
+! of the actual run. If so, get all necessary informations (ids, etc.) from
+! this file.
+!
+! Parameter av can assume values 0 (non-averaged data) and 1 (time averaged
+! data)
+!------------------------------------------------------------------------------!
+#if defined( __netcdf )
+
+    USE arrays_3d
+    USE constants
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE netcdf_control
+    USE pegrid
+    USE particle_attributes
+    USE profil_parameter
+    USE spectrum
+    USE statistics
+
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=2)              ::  suffix
+    CHARACTER (LEN=2), INTENT (IN) ::  callmode
+    CHARACTER (LEN=3)              ::  suffix1
+    CHARACTER (LEN=4)              ::  grid_x, grid_y, grid_z
+    CHARACTER (LEN=6)              ::  mode
+    CHARACTER (LEN=10)             ::  netcdf_var_name, netcdf_var_name_base, &
+                                       precision, var
+    CHARACTER (LEN=80)             ::  time_average_text
+    CHARACTER (LEN=2000)           ::  var_list, var_list_old
+
+    INTEGER ::  av, i, id_x, id_y, id_z, j, ns, ns_old, nz_old
+
+    INTEGER, DIMENSION(1) ::  id_dim_time_old, id_dim_x_yz_old,  &
+                              id_dim_y_xz_old, id_dim_zu_sp_old, &
+                              id_dim_zu_xy_old, id_dim_zu_3d_old
+
+    LOGICAL ::  found
+
+    LOGICAL, INTENT (INOUT) ::  extend
+
+    LOGICAL, SAVE ::  init_netcdf = .FALSE.
+
+    REAL, DIMENSION(1) ::  last_time_coordinate
+
+    REAL, DIMENSION(:), ALLOCATABLE ::  netcdf_data
+
+
+!
+!-- Initializing actions (return to calling routine check_parameters afterwards)
+    IF ( .NOT. init_netcdf )  THEN
+!
+!--    Check and set accuracy for NetCDF output. First set default value
+       nc_precision = NF90_REAL4
+
+       i = 1
+       DO  WHILE ( netcdf_precision(i) /= ' ' )
+          j = INDEX( netcdf_precision(i), '_' )
+          IF ( j == 0 )  THEN
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ define_netcdf_header: netcdf_precision must ',  &
+                             'contain a "_"    netcdf_precision(', i, ')="', &
+                             TRIM( netcdf_precision(i) ),'"'
+             ENDIF
+             CALL local_stop
+          ENDIF
+
+          var       = netcdf_precision(i)(1:j-1)
+          precision = netcdf_precision(i)(j+1:)
+
+          IF ( precision == 'NF90_REAL4' )  THEN
+             j = NF90_REAL4
+          ELSEIF ( precision == 'NF90_REAL8' )  THEN
+             j = NF90_REAL8
+          ELSE
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ define_netcdf_header: illegal netcdf precision: ',&
+                             'netcdf_precision(', i, ')="', &
+                             TRIM( netcdf_precision(i) ),'"'
+             ENDIF
+             CALL local_stop
+          ENDIF
+
+          SELECT CASE ( var )
+             CASE ( 'xy' )
+                nc_precision(1) = j
+             CASE ( 'xz' )
+                nc_precision(2) = j
+             CASE ( 'yz' )
+                nc_precision(3) = j
+             CASE ( '2d' )
+                nc_precision(1:3) = j
+             CASE ( '3d' )
+                nc_precision(4) = j
+             CASE ( 'pr' )
+                nc_precision(5) = j
+             CASE ( 'ts' )
+                nc_precision(6) = j
+             CASE ( 'sp' )
+                nc_precision(7) = j
+             CASE ( 'prt' )
+                nc_precision(8) = j
+             CASE ( 'all' )
+                nc_precision    = j
+
+             CASE DEFAULT
+                IF ( myid == 0 )  THEN
+                   PRINT*, '+++ define_netcdf_header: unknown variable in ',   &
+                              'inipar assignment: netcdf_precision(', i, ')="',&
+                                TRIM( netcdf_precision(i) ),'"'
+                ENDIF
+                CALL local_stop                
+
+          END SELECT
+
+          i = i + 1
+          IF ( i > 10 )  EXIT
+       ENDDO
+
+       init_netcdf = .TRUE.
+
+       RETURN
+
+    ENDIF
+
+!
+!-- Determine the mode to be processed
+    IF ( extend )  THEN
+       mode = callmode // '_ext'
+    ELSE
+       mode = callmode // '_new'
+    ENDIF
+
+!
+!-- Select the mode to be processed. Possibilities are xy, xz, yz, pr and ts.
+    SELECT CASE ( mode )
+
+       CASE ( '3d_new' )
+
+!
+!--       Define some global attributes of the dataset
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'Conventions', &
+                                  'COARDS' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 62 )
+
+          IF ( av == 0 )  THEN
+             time_average_text = ' '
+          ELSE
+             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
+                                                            averaging_interval
+          ENDIF
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) //    &
+                                  TRIM( time_average_text ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 63 )
+          IF ( av == 1 )  THEN
+             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
+             nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'time_avg', &
+                                     TRIM( time_average_text ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 63 )
+          ENDIF
+
+!
+!--       Define time coordinate for volume data (unlimited dimension)
+          nc_stat = NF90_DEF_DIM( id_set_3d(av), 'time', NF90_UNLIMITED, &
+                                  id_dim_time_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 64 )
+
+          nc_stat = NF90_DEF_VAR( id_set_3d(av), 'time', NF90_DOUBLE, &
+                                  id_dim_time_3d(av), id_var_time_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 65 )
+
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_time_3d(av), 'units', &
+                                  'seconds')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 66 )
+
+!
+!--       Define spatial dimensions and coordinates:
+!--       Define vertical coordinate grid (zu grid)
+          nc_stat = NF90_DEF_DIM( id_set_3d(av), 'zu_3d', nz_do3d-nzb+1, &
+                                  id_dim_zu_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 67 )
+
+          nc_stat = NF90_DEF_VAR( id_set_3d(av), 'zu_3d', NF90_DOUBLE, &
+                                  id_dim_zu_3d(av), id_var_zu_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 68 )
+
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zu_3d(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 69 )
+
+!
+!--       Define vertical coordinate grid (zw grid)
+          nc_stat = NF90_DEF_DIM( id_set_3d(av), 'zw_3d', nz_do3d-nzb+1, &
+                                  id_dim_zw_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 70 )
+
+          nc_stat = NF90_DEF_VAR( id_set_3d(av), 'zw_3d', NF90_DOUBLE, &
+                                  id_dim_zw_3d(av), id_var_zw_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 71 )
+
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zw_3d(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 72 )
+
+!
+!--       Define x-axis (for scalar position)
+          nc_stat = NF90_DEF_DIM( id_set_3d(av), 'x', nx+2, id_dim_x_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 73 )
+
+          nc_stat = NF90_DEF_VAR( id_set_3d(av), 'x', NF90_DOUBLE, &
+                                  id_dim_x_3d(av), id_var_x_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 74 )
+
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_x_3d(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 75 )
+
+!
+!--       Define x-axis (for u position)
+          nc_stat = NF90_DEF_DIM( id_set_3d(av), 'xu', nx+2, id_dim_xu_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 358 )
+
+          nc_stat = NF90_DEF_VAR( id_set_3d(av), 'xu', NF90_DOUBLE, &
+                                  id_dim_xu_3d(av), id_var_xu_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 359 )
+
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_xu_3d(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 360 )
+
+!
+!--       Define y-axis (for scalar position)
+          nc_stat = NF90_DEF_DIM( id_set_3d(av), 'y', ny+2, id_dim_y_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 76 )
+
+          nc_stat = NF90_DEF_VAR( id_set_3d(av), 'y', NF90_DOUBLE, &
+                                  id_dim_y_3d(av), id_var_y_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 77 )
+
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_y_3d(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 78 )
+
+!
+!--       Define y-axis (for v position)
+          nc_stat = NF90_DEF_DIM( id_set_3d(av), 'yv', ny+2, id_dim_yv_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 361 )
+
+          nc_stat = NF90_DEF_VAR( id_set_3d(av), 'yv', NF90_DOUBLE, &
+                                  id_dim_yv_3d(av), id_var_yv_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 362 )
+
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_yv_3d(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 363 )
+
+!
+!--       Define the variables
+          var_list = ';'
+          i = 1
+
+          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
+
+!
+!--          Check for the grid
+             found = .TRUE.
+             SELECT CASE ( do3d(av,i) )
+!
+!--             Most variables are defined on the scalar grid
+                CASE ( 'e', 'p', 'pc', 'pr', 'pt', 'q', 'ql', 'ql_c', 'ql_v', &
+                       'ql_vp', 'qv', 's', 'vpt' )
+
+                   grid_x = 'x'
+                   grid_y = 'y'
+                   grid_z = 'zu'
+!
+!--             u grid
+                CASE ( 'u' )
+
+                   grid_x = 'xu'
+                   grid_y = 'y'
+                   grid_z = 'zu'
+!
+!--             v grid
+                CASE ( 'v' )
+
+                   grid_x = 'x'
+                   grid_y = 'yv'
+                   grid_z = 'zu'
+!
+!--             w grid
+                CASE ( 'w' )
+
+                   grid_x = 'x'
+                   grid_y = 'y'
+                   grid_z = 'zw'
+
+                CASE DEFAULT
+!
+!--                Check for user-defined quantities
+                   CALL user_define_netcdf_grid( do3d(av,i), found, grid_x, &
+                                                 grid_y, grid_z )
+
+             END SELECT
+
+!
+!--          Select the respective dimension ids
+             IF ( grid_x == 'x' )  THEN
+                id_x = id_dim_x_3d(av)
+             ELSEIF ( grid_x == 'xu' )  THEN
+                id_x = id_dim_xu_3d(av)
+             ENDIF
+
+             IF ( grid_y == 'y' )  THEN
+                id_y = id_dim_y_3d(av)
+             ELSEIF ( grid_y == 'yv' )  THEN
+                id_y = id_dim_yv_3d(av)
+             ENDIF
+
+             IF ( grid_z == 'zu' )  THEN
+                id_z = id_dim_zu_3d(av)
+             ELSEIF ( grid_z == 'zw' )  THEN
+                id_z = id_dim_zw_3d(av)
+             ENDIF
+
+!
+!--          Define the grid
+             nc_stat = NF90_DEF_VAR( id_set_3d(av), do3d(av,i),                &
+                                     nc_precision(4),                          &
+                                   (/ id_x, id_y, id_z, id_dim_time_3d(av) /), &
+                                     id_var_do3d(av,i) )
+
+             IF ( .NOT. found )  THEN
+                PRINT*, '+++ define_netcdf_header: no grid defined for', &
+                             ' variable ', do3d(av,i)
+             ENDIF
+
+             var_list = TRIM( var_list ) // TRIM( do3d(av,i) ) // ';'
+
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 79 )
+!
+!--          Store the 'real' name of the variable (with *, for example)
+!--          in the long_name attribute. This is evaluated by Ferret,
+!--          for example.
+             nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_do3d(av,i), &
+                                     'long_name', do3d(av,i) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 80 )
+!
+!--          Define the variable's unit
+             nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_do3d(av,i), &
+                                     'units', TRIM( do3d_unit(av,i) ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 357 )
+
+             i = i + 1
+
+          ENDDO
+
+!
+!--       No arrays to output
+          IF ( i == 1 )  RETURN
+!             nc_stat = NF90_CLOSE( id_set_3d(av) )
+!             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 9999 )
+!             RETURN
+!          ENDIF
+
+!
+!--       Write the list of variables as global attribute (this is used by
+!--       restart runs and by combine_plot_fields)
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 81 )
+
+!
+!--       Leave NetCDF define mode
+          nc_stat = NF90_ENDDEF( id_set_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 82 )
+
+!
+!--       Write data for x and xu axis (shifted by -dx/2)
+          ALLOCATE( netcdf_data(0:nx+1) )
+
+          DO  i = 0, nx+1
+             netcdf_data(i) = i * dx
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_x_3d(av), netcdf_data, &
+                                  start = (/ 1 /), count = (/ nx+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 83 )
+
+          DO  i = 0, nx+1
+             netcdf_data(i) = ( i - 0.5 ) * dx
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_xu_3d(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ nx+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 385 )
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Write data for y and yv axis (shifted by -dy/2)
+          ALLOCATE( netcdf_data(0:ny+1) )
+
+          DO  i = 0, ny+1
+             netcdf_data(i) = i * dy
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_y_3d(av), netcdf_data, &
+                                  start = (/ 1 /), count = (/ ny+2 /))
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 84 )
+
+          DO  i = 0, ny+1
+             netcdf_data(i) = ( i - 0.5 ) * dy
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_yv_3d(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ ny+2 /))
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 387 )
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Write zu and zw data (vertical axes)
+          nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zu_3d(av),    &
+                                  zu(nzb:nz_do3d), start = (/ 1 /), &
+                                  count = (/ nz_do3d-nzb+1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 85 )
+
+          nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zw_3d(av),    &
+                                  zw(nzb:nz_do3d), start = (/ 1 /), &
+                                  count = (/ nz_do3d-nzb+1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 86 )
+
+
+       CASE ( '3d_ext' )
+
+!
+!--       Get the list of variables and compare with the actual run.
+!--       First var_list_old has to be reset, since GET_ATT does not assign
+!--       trailing blanks.
+          var_list_old = ' '
+          nc_stat = NF90_GET_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 87 )
+
+          var_list = ';'
+          i = 1
+          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
+             var_list = TRIM(var_list) // TRIM( do3d(av,i) ) // ';'
+             i = i + 1
+          ENDDO
+
+          IF ( av == 0 )  THEN
+             var = '(3d)'
+          ELSE
+             var = '(3d_av)'
+          ENDIF
+
+          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for volume data ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' variable mismatch.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Get and compare the number of vertical gridpoints
+          nc_stat = NF90_INQ_VARID( id_set_3d(av), 'zu_3d', id_var_zu_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 88 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_zu_3d(av), &
+                                           dimids = id_dim_zu_3d_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 89 )
+          id_dim_zu_3d(av) = id_dim_zu_3d_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_zu_3d(av), &
+                                            len = nz_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 90 )
+
+          IF ( nz_do3d-nzb+1 /= nz_old )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for volume data ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' mismatch in number of'
+             PRINT*, '             vertical grid points (nz_do3d).'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Get the id of the time coordinate (unlimited coordinate) and its
+!--       last index on the file. The next time level is pl3d..count+1.
+!--       The current time must be larger than the last output time
+!--       on the file.
+          nc_stat = NF90_INQ_VARID( id_set_3d(av), 'time', id_var_time_3d(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 91 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_time_3d(av), &
+                                           dimids = id_dim_time_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 92 )
+          id_dim_time_3d(av) = id_dim_time_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_time_3d(av), &
+                                            len = do3d_time_count(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 93 )
+
+          nc_stat = NF90_GET_VAR( id_set_3d(av), id_var_time_3d(av), &
+                                  last_time_coordinate,              &
+                                  start = (/ do3d_time_count(av) /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 94 )
+
+          IF ( last_time_coordinate(1) >= simulated_time )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for volume data ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended becaus' // &
+                                   'e the current output time'
+             PRINT*, '             is less or equal than the last output t' // &
+                                   'ime on this file.'
+             PRINT*, '             New file is created instead.'
+             do3d_time_count(av) = 0
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Dataset seems to be extendable.
+!--       Now get the variable ids.
+          i = 1
+          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
+             nc_stat = NF90_INQ_VARID( id_set_3d(av), TRIM( do3d(av,i) ), &
+                                       id_var_do3d(av,i) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 95 )
+             i = i + 1
+          ENDDO
+
+!
+!--       Change the titel attribute on file
+          nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 96 )
+          PRINT*, '*** NetCDF file for volume data ' // TRIM( var ) // &
+                       ' from previous run found.'
+          PRINT*, '    This file will be extended.'
+
+
+       CASE ( 'xy_new' )
+
+!
+!--       Define some global attributes of the dataset
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'Conventions', &
+                                  'COARDS' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 97 )
+
+          IF ( av == 0 )  THEN
+             time_average_text = ' '
+          ELSE
+             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
+                                                            averaging_interval
+          ENDIF
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) //    &
+                                  TRIM( time_average_text ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 98 )
+          IF ( av == 1 )  THEN
+             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
+             nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'time_avg', &
+                                     TRIM( time_average_text ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 98 )
+          ENDIF
+
+!
+!--       Define time coordinate for xy sections (unlimited dimension)
+          nc_stat = NF90_DEF_DIM( id_set_xy(av), 'time', NF90_UNLIMITED, &
+                                  id_dim_time_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 99 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xy(av), 'time', NF90_DOUBLE, &
+                                  id_dim_time_xy(av), id_var_time_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 100 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_time_xy(av), 'units', &
+                                  'seconds')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 101 )
+
+!
+!--       Define the spatial dimensions and coordinates for xy-sections.
+!--       First, determine the number of horizontal sections to be written.
+          IF ( section(1,1) == -9999 )  THEN
+             RETURN
+          ELSE
+             ns = 1
+             DO WHILE ( section(ns,1) /= -9999  .AND.  ns <= 100 )
+                ns = ns + 1
+             ENDDO
+             ns = ns - 1
+          ENDIF
+
+!
+!--       Define vertical coordinate grid (zu grid)
+          nc_stat = NF90_DEF_DIM( id_set_xy(av), 'zu_xy', ns, id_dim_zu_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 102 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zu_xy', NF90_DOUBLE, &
+                                  id_dim_zu_xy(av), id_var_zu_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 103 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zu_xy(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 104 )
+
+!
+!--       Define vertical coordinate grid (zw grid)
+          nc_stat = NF90_DEF_DIM( id_set_xy(av), 'zw_xy', ns, id_dim_zw_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 105 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zw_xy', NF90_DOUBLE, &
+                                  id_dim_zw_xy(av), id_var_zw_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 106 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zw_xy(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 107 )
+
+!
+!--       Define a pseudo vertical coordinate grid for the surface variables
+!--       u* and t* to store their height level
+          nc_stat = NF90_DEF_DIM( id_set_xy(av), 'zu1_xy', 1, &
+                                  id_dim_zu1_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 108 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zu1_xy', NF90_DOUBLE, &
+                                  id_dim_zu1_xy(av), id_var_zu1_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 109 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zu1_xy(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 110 )
+
+!
+!--       Define a variable to store the layer indices of the horizontal cross
+!--       sections, too
+          nc_stat = NF90_DEF_VAR( id_set_xy(av), 'ind_z_xy', NF90_DOUBLE, &
+                                  id_dim_zu_xy(av), id_var_ind_z_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 111 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_ind_z_xy(av), 'units', &
+                                  'gridpoints')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 112 )
+
+!
+!--       Define x-axis (for scalar position)
+          nc_stat = NF90_DEF_DIM( id_set_xy(av), 'x', nx+2, id_dim_x_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 113 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xy(av), 'x', NF90_DOUBLE, &
+                                  id_dim_x_xy(av), id_var_x_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 114 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_x_xy(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 115 )
+
+!
+!--       Define x-axis (for u position)
+          nc_stat = NF90_DEF_DIM( id_set_xy(av), 'xu', nx+2, id_dim_xu_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 388 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xy(av), 'xu', NF90_DOUBLE, &
+                                  id_dim_xu_xy(av), id_var_xu_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 389 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_xu_xy(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 390 )
+
+!
+!--       Define y-axis (for scalar position)
+          nc_stat = NF90_DEF_DIM( id_set_xy(av), 'y', ny+2, id_dim_y_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 116 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xy(av), 'y', NF90_DOUBLE, &
+                                  id_dim_y_xy(av), id_var_y_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 117 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_y_xy(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 118 )
+
+!
+!--       Define y-axis (for scalar position)
+          nc_stat = NF90_DEF_DIM( id_set_xy(av), 'yv', ny+2, id_dim_yv_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 364 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xy(av), 'yv', NF90_DOUBLE, &
+                                  id_dim_yv_xy(av), id_var_yv_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 365 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_yv_xy(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 366 )
+
+!
+!--       Define the variables
+          var_list = ';'
+          i = 1
+
+          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+
+             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
+!
+!--             If there is a star in the variable name (u* or t*), it is a
+!--             surface variable. Define it with id_dim_zu1_xy.
+                IF ( INDEX( do2d(av,i), '*' ) /= 0 )  THEN
+!
+!--                First, remove those characters not allowed by NetCDF
+                   netcdf_var_name = do2d(av,i)
+                   CALL clean_netcdf_varname( netcdf_var_name )
+
+                   nc_stat = NF90_DEF_VAR( id_set_xy(av), netcdf_var_name,     &
+                                           nc_precision(1),                    &
+                                           (/ id_dim_x_xy(av), id_dim_y_xy(av),&
+                                              id_dim_zu1_xy(av),               &
+                                              id_dim_time_xy(av) /),           &
+                                           id_var_do2d(av,i) )
+
+                   var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+
+                ELSE
+
+!
+!--                Check for the grid
+                   found = .TRUE.
+                   SELECT CASE ( do2d(av,i) )
+!
+!--                   Most variables are defined on the zu grid
+                      CASE ( 'e_xy', 'p_xy', 'pc_xy', 'pr_xy', 'pt_xy', 'q_xy',&
+                             'ql_xy', 'ql_c_xy', 'ql_v_xy', 'ql_vp_xy',        &
+                             'qv_xy', 's_xy', 'vpt_xy' )
+
+                         grid_x = 'x'
+                         grid_y = 'y'
+                         grid_z = 'zu'
+!
+!--                   u grid
+                      CASE ( 'u_xy' )
+
+                         grid_x = 'xu'
+                         grid_y = 'y'
+                         grid_z = 'zu'
+!
+!--                   v grid
+                      CASE ( 'v_xy' )
+
+                         grid_x = 'x'
+                         grid_y = 'yv'
+                         grid_z = 'zu'
+!
+!--                   w grid
+                      CASE ( 'w_xy' )
+
+                         grid_x = 'x'
+                         grid_y = 'y'
+                         grid_z = 'zw'
+
+                      CASE DEFAULT
+!
+!--                      Check for user-defined quantities
+                         CALL user_define_netcdf_grid( do2d(av,i), found, &
+                                                       grid_x, grid_y, grid_z )
+
+                   END SELECT
+
+!
+!--                Select the respective dimension ids
+                   IF ( grid_x == 'x' )  THEN
+                      id_x = id_dim_x_xy(av)
+                   ELSEIF ( grid_x == 'xu' )  THEN
+                      id_x = id_dim_xu_xy(av)
+                   ENDIF
+
+                   IF ( grid_y == 'y' )  THEN
+                      id_y = id_dim_y_xy(av)
+                   ELSEIF ( grid_y == 'yv' )  THEN
+                      id_y = id_dim_yv_xy(av)
+                   ENDIF
+
+                   IF ( grid_z == 'zu' )  THEN
+                      id_z = id_dim_zu_xy(av)
+                   ELSEIF ( grid_z == 'zw' )  THEN
+                      id_z = id_dim_zw_xy(av)
+                   ENDIF
+
+!
+!--                Define the grid
+                   nc_stat = NF90_DEF_VAR( id_set_xy(av), do2d(av,i),          &
+                                           nc_precision(1),                    &
+                                   (/ id_x, id_y, id_z, id_dim_time_xy(av) /), &
+                                           id_var_do2d(av,i) )
+
+                   IF ( .NOT. found )  THEN
+                      PRINT*, '+++ define_netcdf_header: no grid defined ', &
+                                   'for variable ', do2d(av,i)
+                   ENDIF
+
+                   var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
+
+                ENDIF
+
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 119 )
+!
+!--             Store the 'real' name of the variable (with *, for example)
+!--             in the long_name attribute. This is evaluated by Ferret,
+!--             for example.
+                nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_do2d(av,i), &
+                                        'long_name', do2d(av,i) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 120 )
+!
+!--             Define the variable's unit
+                nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_do2d(av,i), &
+                                        'units', TRIM( do2d_unit(av,i) ) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 354 )
+             ENDIF
+
+             i = i + 1
+
+          ENDDO
+
+!
+!--       No arrays to output. Close the netcdf file and return.
+          IF ( i == 1 )  RETURN
+!             nc_stat = NF90_CLOSE( id_set_xy(av) )
+!             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 9999 )
+!             RETURN
+!          ENDIF
+
+!
+!--       Write the list of variables as global attribute (this is used by
+!--       restart runs and by combine_plot_fields)
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 121 )
+
+!
+!--       Leave NetCDF define mode
+          nc_stat = NF90_ENDDEF( id_set_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 122 )
+
+!
+!--       Write axis data: z_xy, x, y
+          ALLOCATE( netcdf_data(1:ns) )
+
+!
+!--       Write zu data
+          DO  i = 1, ns
+             IF( section(i,1) == -1 )  THEN
+                netcdf_data(i) = -1.0  ! section averaged along z
+             ELSE
+                netcdf_data(i) = zu( section(i,1) )
+             ENDIF
+          ENDDO
+          nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu_xy(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 123 )
+
+!
+!--       Write zw data
+          DO  i = 1, ns
+             IF( section(i,1) == -1 )  THEN
+                netcdf_data(i) = -1.0  ! section averaged along z
+             ELSE
+                netcdf_data(i) = zw( section(i,1) )
+             ENDIF
+          ENDDO
+          nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zw_xy(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 124 )
+
+!
+!--       Write gridpoint number data
+          netcdf_data(1:ns) = section(1:ns,1)
+          nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_ind_z_xy(av), &
+                                  netcdf_data, start = (/ 1 /),       &
+                                  count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 125 )
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Write the cross section height u*, t*
+          nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu1_xy(av), &
+                                  (/ zu(nzb+1) /), start = (/ 1 /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 126 )
+
+!
+!--       Write data for x and xu axis (shifted by -dx/2)
+          ALLOCATE( netcdf_data(0:nx+1) )
+
+          DO  i = 0, nx+1
+             netcdf_data(i) = i * dx
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_x_xy(av), netcdf_data, &
+                                  start = (/ 1 /), count = (/ nx+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 127 )
+
+          DO  i = 0, nx+1
+             netcdf_data(i) = ( i - 0.5 ) * dx
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_xu_xy(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ nx+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 367 )
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Write data for y and yv axis (shifted by -dy/2)
+          ALLOCATE( netcdf_data(0:ny+1) )
+
+          DO  i = 0, ny+1
+             netcdf_data(i) = i * dy
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_y_xy(av), netcdf_data, &
+                                  start = (/ 1 /), count = (/ ny+2 /))
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 128 )
+
+          DO  i = 0, ny+1
+             netcdf_data(i) = ( i - 0.5 ) * dy
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_yv_xy(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ ny+2 /))
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 368 )
+
+          DEALLOCATE( netcdf_data )
+
+
+       CASE ( 'xy_ext' )
+
+!
+!--       Get the list of variables and compare with the actual run.
+!--       First var_list_old has to be reset, since GET_ATT does not assign
+!--       trailing blanks.
+          var_list_old = ' '
+          nc_stat = NF90_GET_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 129 )
+
+          var_list = ';'
+          i = 1
+          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
+                netcdf_var_name = do2d(av,i)
+                CALL clean_netcdf_varname( netcdf_var_name )
+                var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+             ENDIF
+             i = i + 1
+          ENDDO
+
+          IF ( av == 0 )  THEN
+             var = '(xy)'
+          ELSE
+             var = '(xy_av)'
+          ENDIF
+
+          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' variable mismatch.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Calculate the number of current sections
+          ns = 1
+          DO WHILE ( section(ns,1) /= -9999  .AND.  ns <= 100 )
+             ns = ns + 1
+          ENDDO
+          ns = ns - 1
+
+!
+!--       Get and compare the number of horizontal cross sections
+          nc_stat = NF90_INQ_VARID( id_set_xy(av), 'zu_xy', id_var_zu_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 130 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_zu_xy(av), &
+                                           dimids = id_dim_zu_xy_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 131 )
+          id_dim_zu_xy(av) = id_dim_zu_xy_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_zu_xy(av), &
+                                            len = ns_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 132 )
+
+          IF ( ns /= ns_old )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' mismatch in number of'
+             PRINT*, '             cross sections.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Get and compare the heights of the cross sections
+          ALLOCATE( netcdf_data(1:ns_old) )
+
+          nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_zu_xy(av), netcdf_data )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 133 )
+
+          DO  i = 1, ns
+             IF ( section(i,1) /= -1 )  THEN
+                IF ( zu(section(i,1)) /= netcdf_data(i) )  THEN
+                   PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                     TRIM( var ) // ' from previuos run found,'
+                   PRINT*, '             but this file cannot be extended' // &
+                                      ' due to mismatch in cross'
+                   PRINT*, '             section levels.'
+                   PRINT*, '             New file is created instead.'
+                   extend = .FALSE.
+                   RETURN
+                ENDIF
+             ELSE
+                IF ( -1.0 /= netcdf_data(i) )  THEN
+                   PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                     TRIM( var ) // ' from previuos run found,'
+                   PRINT*, '             but this file cannot be extended' // &
+                                      ' due to mismatch in cross'
+                   PRINT*, '             section levels.'
+                   PRINT*, '             New file is created instead.'
+                   extend = .FALSE.
+                   RETURN
+                ENDIF
+             ENDIF
+          ENDDO
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Get the id of the time coordinate (unlimited coordinate) and its
+!--       last index on the file. The next time level is do2d..count+1.
+!--       The current time must be larger than the last output time
+!--       on the file.
+          nc_stat = NF90_INQ_VARID( id_set_xy(av), 'time', id_var_time_xy(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 134 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_time_xy(av), &
+                                           dimids = id_dim_time_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 135 )
+          id_dim_time_xy(av) = id_dim_time_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_time_xy(av), &
+                                            len = do2d_xy_time_count(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 136 )
+
+          nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_time_xy(av),    &
+                                  last_time_coordinate,                 &
+                                  start = (/ do2d_xy_time_count(av) /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 137 )
+
+          IF ( last_time_coordinate(1) >= simulated_time )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for cross sections ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended becaus' // &
+                                   'e the current output time'
+             PRINT*, '             is less or equal than the last output t' // &
+                                   'ime on this file.'
+             PRINT*, '             New file is created instead.'
+             do2d_xy_time_count(av) = 0
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Dataset seems to be extendable.
+!--       Now get the variable ids.
+          i = 1
+          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
+                netcdf_var_name = do2d(av,i)
+                CALL clean_netcdf_varname( netcdf_var_name )
+                nc_stat = NF90_INQ_VARID( id_set_xy(av), netcdf_var_name, &
+                                          id_var_do2d(av,i) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 138 )
+             ENDIF
+             i = i + 1
+          ENDDO
+
+!
+!--       Change the titel attribute on file
+          nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 139 )
+          PRINT*, '*** NetCDF file for cross-sections ' // TRIM( var ) // &
+                       ' from previous run found.'
+          PRINT*, '    This file will be extended.'
+
+
+       CASE ( 'xz_new' )
+
+!
+!--       Define some global attributes of the dataset
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'Conventions', &
+                                  'COARDS' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 140 )
+
+          IF ( av == 0 )  THEN
+             time_average_text = ' '
+          ELSE
+             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
+                                                            averaging_interval
+          ENDIF
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header )  //   &
+                                  TRIM( time_average_text ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 141 )
+          IF ( av == 1 )  THEN
+             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
+             nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'time_avg', &
+                                     TRIM( time_average_text ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 141 )
+          ENDIF
+
+!
+!--       Define time coordinate for xz sections (unlimited dimension)
+          nc_stat = NF90_DEF_DIM( id_set_xz(av), 'time', NF90_UNLIMITED, &
+                                  id_dim_time_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 142 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xz(av), 'time', NF90_DOUBLE, &
+                                  id_dim_time_xz(av), id_var_time_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 143 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_time_xz(av), 'units', &
+                                  'seconds')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 144 )
+
+!
+!--       Define the spatial dimensions and coordinates for xz-sections.
+!--       First, determine the number of vertical sections to be written.
+          IF ( section(1,2) == -9999 )  THEN
+             RETURN
+          ELSE
+             ns = 1
+             DO WHILE ( section(ns,2) /= -9999  .AND.  ns <= 100 )
+                ns = ns + 1
+             ENDDO
+             ns = ns - 1
+          ENDIF
+
+!
+!--       Define y-axis (for scalar position)
+          nc_stat = NF90_DEF_DIM( id_set_xz(av), 'y_xz', ns, id_dim_y_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 145 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xz(av), 'y_xz', NF90_DOUBLE, &
+                                  id_dim_y_xz(av), id_var_y_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 146 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_y_xz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 147 )
+
+!
+!--       Define y-axis (for v position)
+          nc_stat = NF90_DEF_DIM( id_set_xz(av), 'yv_xz', ns, id_dim_yv_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 369 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xz(av), 'yv_xz', NF90_DOUBLE, &
+                                  id_dim_yv_xz(av), id_var_yv_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 370 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_yv_xz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 371 )
+
+!
+!--       Define a variable to store the layer indices of the vertical cross
+!--       sections
+          nc_stat = NF90_DEF_VAR( id_set_xz(av), 'ind_y_xz', NF90_DOUBLE, &
+                                  id_dim_y_xz(av), id_var_ind_y_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 148 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_ind_y_xz(av), 'units', &
+                                  'gridpoints')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 149 )
+
+!
+!--       Define x-axis (for scalar position)
+          nc_stat = NF90_DEF_DIM( id_set_xz(av), 'x', nx+2, id_dim_x_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 150 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xz(av), 'x', NF90_DOUBLE, &
+                                  id_dim_x_xz(av), id_var_x_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 151 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_x_xz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 152 )
+
+!
+!--       Define x-axis (for u position)
+          nc_stat = NF90_DEF_DIM( id_set_xz(av), 'xu', nx+2, id_dim_xu_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 372 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xz(av), 'xu', NF90_DOUBLE, &
+                                  id_dim_xu_xz(av), id_var_xu_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 373 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_xu_xz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 374 )
+
+!
+!--       Define the two z-axes (zu and zw)
+          nc_stat = NF90_DEF_DIM( id_set_xz(av), 'zu', nz+2, id_dim_zu_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 153 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xz(av), 'zu', NF90_DOUBLE, &
+                                  id_dim_zu_xz(av), id_var_zu_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 154 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_zu_xz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 155 )
+
+          nc_stat = NF90_DEF_DIM( id_set_xz(av), 'zw', nz+2, id_dim_zw_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 156 )
+
+          nc_stat = NF90_DEF_VAR( id_set_xz(av), 'zw', NF90_DOUBLE, &
+                                  id_dim_zw_xz(av), id_var_zw_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 157 )
+
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_zw_xz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 158 )
+
+
+!
+!--       Define the variables
+          var_list = ';'
+          i = 1
+
+          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+
+             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
+
+!
+!--             Check for the grid
+                found = .TRUE.
+                SELECT CASE ( do2d(av,i) )
+!
+!--                Most variables are defined on the zu grid
+                   CASE ( 'e_xz', 'p_xz', 'pc_xz', 'pr_xz', 'pt_xz', 'q_xz',  &
+                          'ql_xz', 'ql_c_xz', 'ql_v_xz', 'ql_vp_xz', 'qv_xz', &
+                          's_xz', 'vpt_xz' )
+
+                      grid_x = 'x'
+                      grid_y = 'y'
+                      grid_z = 'zu'
+!
+!--                u grid
+                   CASE ( 'u_xz' )
+
+                      grid_x = 'xu'
+                      grid_y = 'y'
+                      grid_z = 'zu'
+!
+!--                v grid
+                   CASE ( 'v_xz' )
+
+                      grid_x = 'x'
+                      grid_y = 'yv'
+                      grid_z = 'zu'
+!
+!--                w grid
+                   CASE ( 'w_xz' )
+
+                      grid_x = 'x'
+                      grid_y = 'y'
+                      grid_z = 'zw'
+
+                   CASE DEFAULT
+!
+!--                   Check for user-defined quantities
+                      CALL user_define_netcdf_grid( do2d(av,i), found, &
+                                                    grid_x, grid_y, grid_z )
+
+                END SELECT
+
+!
+!--             Select the respective dimension ids
+                IF ( grid_x == 'x' )  THEN
+                   id_x = id_dim_x_xz(av)
+                ELSEIF ( grid_x == 'xu' )  THEN
+                   id_x = id_dim_xu_xz(av)
+                ENDIF
+
+                IF ( grid_y == 'y' )  THEN
+                   id_y = id_dim_y_xz(av)
+                ELSEIF ( grid_y == 'yv' )  THEN
+                   id_y = id_dim_yv_xz(av)
+                ENDIF
+
+                IF ( grid_z == 'zu' )  THEN
+                   id_z = id_dim_zu_xz(av)
+                ELSEIF ( grid_z == 'zw' )  THEN
+                   id_z = id_dim_zw_xz(av)
+                ENDIF
+
+!
+!--             Define the grid
+                nc_stat = NF90_DEF_VAR( id_set_xz(av), do2d(av,i),             &
+                                        nc_precision(2),                       &
+                                   (/ id_x, id_y, id_z, id_dim_time_xz(av) /), &
+                                        id_var_do2d(av,i) )
+
+                IF ( .NOT. found )  THEN
+                   PRINT*, '+++ define_netcdf_header: no grid defined for', &
+                                ' variable ', do2d(av,i)
+                ENDIF
+
+                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
+
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 159 )
+!
+!--             Store the 'real' name of the variable (with *, for example)
+!--             in the long_name attribute. This is evaluated by Ferret,
+!--             for example.
+                nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_do2d(av,i), &
+                                        'long_name', do2d(av,i) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 160 )
+!
+!--             Define the variable's unit
+                nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_do2d(av,i), &
+                                        'units', TRIM( do2d_unit(av,i) ) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 355 )
+             ENDIF
+
+             i = i + 1
+
+          ENDDO
+
+!
+!--       No arrays to output. Close the netcdf file and return.
+          IF ( i == 1 )  RETURN
+!             nc_stat = NF90_CLOSE( id_set_xz(av) )
+!             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 9999 )
+!             RETURN
+!          ENDIF
+
+!
+!--       Write the list of variables as global attribute (this is used by
+!--       restart runs and by combine_plot_fields)
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 161 )
+
+!
+!--       Leave NetCDF define mode
+          nc_stat = NF90_ENDDEF( id_set_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 162 )
+
+!
+!--       Write axis data: y_xz, x, zu, zw
+          ALLOCATE( netcdf_data(1:ns) )
+
+!
+!--       Write y_xz data
+          DO  i = 1, ns
+             IF( section(i,2) == -1 )  THEN
+                netcdf_data(i) = -1.0  ! section averaged along y
+             ELSE
+                netcdf_data(i) = section(i,2) * dy
+             ENDIF
+          ENDDO
+          nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_y_xz(av), netcdf_data, &
+                                  start = (/ 1 /), count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 163 )
+
+!
+!--       Write yv_xz data 
+          DO  i = 1, ns
+             IF( section(i,2) == -1 )  THEN
+                netcdf_data(i) = -1.0  ! section averaged along y
+             ELSE
+                netcdf_data(i) = ( section(i,2) - 0.5 ) * dy
+             ENDIF
+          ENDDO
+          nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_yv_xz(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 375 )
+
+!
+!--       Write gridpoint number data
+          netcdf_data(1:ns) = section(1:ns,2)
+          nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_ind_y_xz(av), &
+                                  netcdf_data, start = (/ 1 /),       &
+                                  count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 164 )
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Write data for x and xu axis (shifted by -dx/2)
+          ALLOCATE( netcdf_data(0:nx+1) )
+
+          DO  i = 0, nx+1
+             netcdf_data(i) = i * dx
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_x_xz(av), netcdf_data, &
+                                  start = (/ 1 /), count = (/ nx+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 165 )
+
+          DO  i = 0, nx+1
+             netcdf_data(i) = ( i - 0.5 ) * dx
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_xu_xz(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ nx+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 376 )
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Write zu and zw data (vertical axes)
+          ALLOCATE( netcdf_data(0:nz+1) )
+
+          netcdf_data(0:nz+1) = zu(nzb:nzt+1)
+          nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zu_xz(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ nz+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 166 )
+
+          netcdf_data(0:nz+1) = zw(nzb:nzt+1)
+          nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zw_xz(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ nz+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 167 )
+
+          DEALLOCATE( netcdf_data )
+
+
+       CASE ( 'xz_ext' )
+
+!
+!--       Get the list of variables and compare with the actual run.
+!--       First var_list_old has to be reset, since GET_ATT does not assign
+!--       trailing blanks.
+          var_list_old = ' '
+          nc_stat = NF90_GET_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 168 )
+
+          var_list = ';'
+          i = 1
+          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
+                netcdf_var_name = do2d(av,i)
+                CALL clean_netcdf_varname( netcdf_var_name )
+                var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+             ENDIF
+             i = i + 1
+          ENDDO
+
+          IF ( av == 0 )  THEN
+             var = '(xz)'
+          ELSE
+             var = '(xz_av)'
+          ENDIF
+
+          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' variable mismatch.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Calculate the number of current sections
+          ns = 1
+          DO WHILE ( section(ns,2) /= -9999  .AND.  ns <= 100 )
+             ns = ns + 1
+          ENDDO
+          ns = ns - 1
+
+!
+!--       Get and compare the number of vertical cross sections
+          nc_stat = NF90_INQ_VARID( id_set_xz(av), 'y_xz', id_var_y_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 169 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_y_xz(av), &
+                                           dimids = id_dim_y_xz_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 170 )
+          id_dim_y_xz(av) = id_dim_y_xz_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_y_xz(av), &
+                                            len = ns_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 171 )
+
+          IF ( ns /= ns_old )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' mismatch in number of'
+             PRINT*, '             cross sections.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Get and compare the heights of the cross sections
+          ALLOCATE( netcdf_data(1:ns_old) )
+
+          nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_y_xz(av), netcdf_data )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 172 )
+
+          DO  i = 1, ns
+             IF ( section(i,2) /= -1 )  THEN
+                IF ( ( section(i,2) * dy ) /= netcdf_data(i) )  THEN
+                   PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                     TRIM( var ) // ' from previuos run found,'
+                   PRINT*, '             but this file cannot be extended' // &
+                                      ' due to mismatch in cross'
+                   PRINT*, '             section indices.'
+                   PRINT*, '             New file is created instead.'
+                   extend = .FALSE.
+                   RETURN
+                ENDIF
+             ELSE
+                IF ( -1.0 /= netcdf_data(i) )  THEN
+                   PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                     TRIM( var ) // ' from previuos run found,'
+                   PRINT*, '             but this file cannot be extended' // &
+                                      ' due to mismatch in cross'
+                   PRINT*, '             section indices.'
+                   PRINT*, '             New file is created instead.'
+                   extend = .FALSE.
+                   RETURN
+                ENDIF
+             ENDIF
+          ENDDO
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Get the id of the time coordinate (unlimited coordinate) and its
+!--       last index on the file. The next time level is do2d..count+1.
+!--       The current time must be larger than the last output time
+!--       on the file.
+          nc_stat = NF90_INQ_VARID( id_set_xz(av), 'time', id_var_time_xz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 173 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_time_xz(av), &
+                                           dimids = id_dim_time_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 174 )
+          id_dim_time_xz(av) = id_dim_time_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_time_xz(av), &
+                                            len = do2d_xz_time_count(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 175 )
+
+          nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_time_xz(av),    &
+                                  last_time_coordinate,                 &
+                                  start = (/ do2d_xz_time_count(av) /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 176 )
+
+          IF ( last_time_coordinate(1) >= simulated_time )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for cross sections ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended becaus' // &
+                                   'e the current output time'
+             PRINT*, '             is less or equal than the last output t' // &
+                                   'ime on this file.'
+             PRINT*, '             New file is created instead.'
+             do2d_xz_time_count(av) = 0
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Dataset seems to be extendable.
+!--       Now get the variable ids.
+          i = 1
+          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
+                netcdf_var_name = do2d(av,i)
+                CALL clean_netcdf_varname( netcdf_var_name )
+                nc_stat = NF90_INQ_VARID( id_set_xz(av), netcdf_var_name, &
+                                          id_var_do2d(av,i) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 177 )
+             ENDIF
+             i = i + 1
+          ENDDO
+
+!
+!--       Change the titel attribute on file
+          nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 178 )
+          PRINT*, '*** NetCDF file for cross-sections ' // TRIM( var ) // &
+                       ' from previous run found.'
+          PRINT*, '    This file will be extended.'
+
+
+       CASE ( 'yz_new' )
+
+!
+!--       Define some global attributes of the dataset
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'Conventions', &
+                                  'COARDS' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 179 )
+
+          IF ( av == 0 )  THEN
+             time_average_text = ' '
+          ELSE
+             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
+                                                            averaging_interval
+          ENDIF
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) //    &
+                                  TRIM( time_average_text ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 180 )
+          IF ( av == 1 )  THEN
+             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
+             nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'time_avg', &
+                                     TRIM( time_average_text ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 180 )
+          ENDIF
+
+!
+!--       Define time coordinate for yz sections (unlimited dimension)
+          nc_stat = NF90_DEF_DIM( id_set_yz(av), 'time', NF90_UNLIMITED, &
+                                  id_dim_time_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 181 )
+
+          nc_stat = NF90_DEF_VAR( id_set_yz(av), 'time', NF90_DOUBLE, &
+                                  id_dim_time_yz(av), id_var_time_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 182 )
+
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_time_yz(av), 'units', &
+                                  'seconds')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 183 )
+
+!
+!--       Define the spatial dimensions and coordinates for yz-sections.
+!--       First, determine the number of vertical sections to be written.
+          IF ( section(1,3) == -9999 )  THEN
+             RETURN
+          ELSE
+             ns = 1
+             DO WHILE ( section(ns,3) /= -9999  .AND.  ns <= 100 )
+                ns = ns + 1
+             ENDDO
+             ns = ns - 1
+          ENDIF
+
+!
+!--       Define x axis (for scalar position)
+          nc_stat = NF90_DEF_DIM( id_set_yz(av), 'x_yz', ns, id_dim_x_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 184 )
+
+          nc_stat = NF90_DEF_VAR( id_set_yz(av), 'x_yz', NF90_DOUBLE, &
+                                  id_dim_x_yz(av), id_var_x_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 185 )
+
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_x_yz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 186 )
+
+!
+!--       Define x axis (for u position)
+          nc_stat = NF90_DEF_DIM( id_set_yz(av), 'xu_yz', ns, id_dim_xu_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 377 )
+
+          nc_stat = NF90_DEF_VAR( id_set_yz(av), 'xu_yz', NF90_DOUBLE, &
+                                  id_dim_xu_yz(av), id_var_xu_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 378 )
+
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_xu_yz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 379 )
+
+!
+!--       Define a variable to store the layer indices of the vertical cross
+!--       sections
+          nc_stat = NF90_DEF_VAR( id_set_yz(av), 'ind_x_yz', NF90_DOUBLE, &
+                                  id_dim_x_yz(av), id_var_ind_x_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 187 )
+
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_ind_x_yz(av), 'units', &
+                                  'gridpoints')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 188 )
+
+!
+!--       Define y-axis (for scalar position)
+          nc_stat = NF90_DEF_DIM( id_set_yz(av), 'y', ny+2, id_dim_y_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 189 )
+
+          nc_stat = NF90_DEF_VAR( id_set_yz(av), 'y', NF90_DOUBLE, &
+                                  id_dim_y_yz(av), id_var_y_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 190 )
+
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_y_yz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 191 )
+
+!
+!--       Define y-axis (for v position)
+          nc_stat = NF90_DEF_DIM( id_set_yz(av), 'yv', ny+2, id_dim_yv_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 380 )
+
+          nc_stat = NF90_DEF_VAR( id_set_yz(av), 'yv', NF90_DOUBLE, &
+                                  id_dim_yv_yz(av), id_var_yv_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 381 )
+
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_yv_yz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 382 )
+
+!
+!--       Define the two z-axes (zu and zw)
+          nc_stat = NF90_DEF_DIM( id_set_yz(av), 'zu', nz+2, id_dim_zu_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 192 )
+
+          nc_stat = NF90_DEF_VAR( id_set_yz(av), 'zu', NF90_DOUBLE, &
+                                  id_dim_zu_yz(av), id_var_zu_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 193 )
+
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_zu_yz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 194 )
+
+          nc_stat = NF90_DEF_DIM( id_set_yz(av), 'zw', nz+2, id_dim_zw_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 195 )
+
+          nc_stat = NF90_DEF_VAR( id_set_yz(av), 'zw', NF90_DOUBLE, &
+                                  id_dim_zw_yz(av), id_var_zw_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 196 )
+
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_zw_yz(av), 'units', &
+                                  'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 197 )
+
+
+!
+!--       Define the variables
+          var_list = ';'
+          i = 1
+
+          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+
+             IF ( INDEX( do2d(av,i), 'yz' ) /= 0 )  THEN
+
+!
+!--             Check for the grid
+                found = .TRUE.
+                SELECT CASE ( do2d(av,i) )
+!
+!--                Most variables are defined on the zu grid
+                   CASE ( 'e_yz', 'p_yz', 'pc_yz', 'pr_yz', 'pt_yz', 'q_yz',  &
+                          'ql_yz', 'ql_c_yz', 'ql_v_yz', 'ql_vp_yz', 'qv_yz', &
+                          's_yz', 'vpt_yz' )
+
+                      grid_x = 'x'
+                      grid_y = 'y'
+                      grid_z = 'zu'
+!
+!--                u grid
+                   CASE ( 'u_yz' )
+
+                      grid_x = 'xu'
+                      grid_y = 'y'
+                      grid_z = 'zu'
+!
+!--                v grid
+                   CASE ( 'v_yz' )
+
+                      grid_x = 'x'
+                      grid_y = 'yv'
+                      grid_z = 'zu'
+!
+!--                w grid
+                   CASE ( 'w_yz' )
+
+                      grid_x = 'x'
+                      grid_y = 'y'
+                      grid_z = 'zw'
+
+                   CASE DEFAULT
+!
+!--                   Check for user-defined quantities
+                      CALL user_define_netcdf_grid( do2d(av,i), found, &
+                                                    grid_x, grid_y, grid_z )
+
+                END SELECT
+
+!
+!--             Select the respective dimension ids
+                IF ( grid_x == 'x' )  THEN
+                   id_x = id_dim_x_yz(av)
+                ELSEIF ( grid_x == 'xu' )  THEN
+                   id_x = id_dim_xu_yz(av)
+                ENDIF
+
+                IF ( grid_y == 'y' )  THEN
+                   id_y = id_dim_y_yz(av)
+                ELSEIF ( grid_y == 'yv' )  THEN
+                   id_y = id_dim_yv_yz(av)
+                ENDIF
+
+                IF ( grid_z == 'zu' )  THEN
+                   id_z = id_dim_zu_yz(av)
+                ELSEIF ( grid_z == 'zw' )  THEN
+                   id_z = id_dim_zw_yz(av)
+                ENDIF
+
+!
+!--             Define the grid
+                nc_stat = NF90_DEF_VAR( id_set_yz(av), do2d(av,i),             &
+                                        nc_precision(3),                       &
+                                   (/ id_x, id_y, id_z, id_dim_time_yz(av) /), &
+                                        id_var_do2d(av,i) )
+
+                IF ( .NOT. found )  THEN
+                   PRINT*, '+++ define_netcdf_header: no grid defined for', &
+                                ' variable ', do2d(av,i)
+                ENDIF
+
+                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
+
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 198 )
+!
+!--             Store the 'real' name of the variable (with *, for example)
+!--             in the long_name attribute. This is evaluated by Ferret,
+!--             for example.
+                nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_do2d(av,i), &
+                                        'long_name', do2d(av,i) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 199 )
+!
+!--             Define the variable's unit
+                nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_do2d(av,i), &
+                                        'units', TRIM( do2d_unit(av,i) ) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 356 )
+             ENDIF
+
+             i = i + 1
+
+          ENDDO
+
+!
+!--       No arrays to output. Close the netcdf file and return.
+          IF ( i == 1 )  RETURN
+!             nc_stat = NF90_CLOSE( id_set_yz(av) )
+!             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 9999 )
+!             RETURN
+!          ENDIF
+
+!
+!--       Write the list of variables as global attribute (this is used by
+!--       restart runs and by combine_plot_fields)
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 200 )
+
+!
+!--       Leave NetCDF define mode
+          nc_stat = NF90_ENDDEF( id_set_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 201 )
+
+!
+!--       Write axis data: x_yz, y, zu, zw
+          ALLOCATE( netcdf_data(1:ns) )
+
+!
+!--       Write x_yz data
+          DO  i = 1, ns
+             IF( section(i,3) == -1 )  THEN
+                netcdf_data(i) = -1.0  ! section averaged along x
+             ELSE
+                netcdf_data(i) = section(i,3) * dx
+             ENDIF
+          ENDDO
+          nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_x_yz(av), netcdf_data, &
+                                  start = (/ 1 /), count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 202 )
+
+!
+!--       Write x_yz data (xu grid)
+          DO  i = 1, ns
+             IF( section(i,3) == -1 )  THEN
+                netcdf_data(i) = -1.0  ! section averaged along x
+             ELSE
+                netcdf_data(i) = (section(i,3)-0.5) * dx
+             ENDIF
+          ENDDO
+          nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_xu_yz(av), netcdf_data, &
+                                  start = (/ 1 /), count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 383 )
+
+!
+!--       Write gridpoint number data
+          netcdf_data(1:ns) = section(1:ns,3)
+          nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_ind_x_yz(av), &
+                                  netcdf_data, start = (/ 1 /),       &
+                                  count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 203 )
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Write data for y and yv axis (shifted by -dy/2)
+          ALLOCATE( netcdf_data(0:ny+1) )
+
+          DO  j = 0, ny+1
+             netcdf_data(j) = j * dy
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_y_yz(av), netcdf_data, &
+                                  start = (/ 1 /), count = (/ ny+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 204 )
+
+          DO  j = 0, ny+1
+             netcdf_data(j) = ( j - 0.5 ) * dy
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_yv_yz(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ ny+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 384 )
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Write zu and zw data (vertical axes)
+          ALLOCATE( netcdf_data(0:nz+1) )
+
+          netcdf_data(0:nz+1) = zu(nzb:nzt+1)
+          nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zu_yz(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ nz+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 205 )
+
+          netcdf_data(0:nz+1) = zw(nzb:nzt+1)
+          nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zw_yz(av), &
+                                  netcdf_data, start = (/ 1 /),    &
+                                  count = (/ nz+2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 206 )
+
+          DEALLOCATE( netcdf_data )
+
+
+       CASE ( 'yz_ext' )
+
+!
+!--       Get the list of variables and compare with the actual run.
+!--       First var_list_old has to be reset, since GET_ATT does not assign
+!--       trailing blanks.
+          var_list_old = ' '
+          nc_stat = NF90_GET_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 207 )
+
+          var_list = ';'
+          i = 1
+          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+             IF ( INDEX( do2d(av,i), 'yz' ) /= 0 )  THEN
+                netcdf_var_name = do2d(av,i)
+                CALL clean_netcdf_varname( netcdf_var_name )
+                var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+             ENDIF
+             i = i + 1
+          ENDDO
+
+          IF ( av == 0 )  THEN
+             var = '(yz)'
+          ELSE
+             var = '(yz_av)'
+          ENDIF
+
+          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' variable mismatch.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Calculate the number of current sections
+          ns = 1
+          DO WHILE ( section(ns,3) /= -9999  .AND.  ns <= 100 )
+             ns = ns + 1
+          ENDDO
+          ns = ns - 1
+
+!
+!--       Get and compare the number of vertical cross sections
+          nc_stat = NF90_INQ_VARID( id_set_yz(av), 'x_yz', id_var_x_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 208 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_x_yz(av), &
+                                           dimids = id_dim_x_yz_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 209 )
+          id_dim_x_yz(av) = id_dim_x_yz_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_x_yz(av), &
+                                            len = ns_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 210 )
+
+          IF ( ns /= ns_old )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' mismatch in number of'
+             PRINT*, '             cross sections.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Get and compare the heights of the cross sections
+          ALLOCATE( netcdf_data(1:ns_old) )
+
+          nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_x_yz(av), netcdf_data )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 211 )
+
+          DO  i = 1, ns
+             IF ( section(i,3) /= -1 )  THEN
+                IF ( ( section(i,3) * dx ) /= netcdf_data(i) )  THEN
+                   PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                     TRIM( var ) // ' from previuos run found,'
+                   PRINT*, '             but this file cannot be extended' // &
+                                      ' due to mismatch in cross'
+                   PRINT*, '             section indices.'
+                   PRINT*, '             New file is created instead.'
+                   extend = .FALSE.
+                   RETURN
+                ENDIF
+             ELSE
+                IF ( -1.0 /= netcdf_data(i) )  THEN
+                   PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+                                     TRIM( var ) // ' from previuos run found,'
+                   PRINT*, '             but this file cannot be extended' // &
+                                      ' due to mismatch in cross'
+                   PRINT*, '             section indices.'
+                   PRINT*, '             New file is created instead.'
+                   extend = .FALSE.
+                   RETURN
+                ENDIF
+             ENDIF
+          ENDDO
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Get the id of the time coordinate (unlimited coordinate) and its
+!--       last index on the file. The next time level is pl2d..count+1.
+!--       The current time must be larger than the last output time
+!--       on the file.
+          nc_stat = NF90_INQ_VARID( id_set_yz(av), 'time', id_var_time_yz(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 212 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_time_yz(av), &
+                                           dimids = id_dim_time_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 213 )
+          id_dim_time_yz(av) = id_dim_time_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_time_yz(av), &
+                                            len = do2d_yz_time_count(av) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 214 )
+
+          nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_time_yz(av),    &
+                                  last_time_coordinate,                 &
+                                  start = (/ do2d_yz_time_count(av) /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 215 )
+
+          IF ( last_time_coordinate(1) >= simulated_time )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for cross sections ' // &
+                                   TRIM( var ) // ' from previuos run found,'
+             PRINT*, '             but this file cannot be extended becaus' // &
+                                   'e the current output time'
+             PRINT*, '             is less or equal than the last output t' // &
+                                   'ime on this file.'
+             PRINT*, '             New file is created instead.'
+             do2d_yz_time_count(av) = 0
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Dataset seems to be extendable.
+!--       Now get the variable ids.
+          i = 1
+          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+             IF ( INDEX( do2d(av,i), 'yz' ) /= 0 )  THEN
+                netcdf_var_name = do2d(av,i)
+                CALL clean_netcdf_varname( netcdf_var_name )
+                nc_stat = NF90_INQ_VARID( id_set_yz(av), netcdf_var_name, &
+                                          id_var_do2d(av,i) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 216 )
+             ENDIF
+             i = i + 1
+          ENDDO
+
+!
+!--       Change the titel attribute on file
+          nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 217 )
+          PRINT*, '*** NetCDF file for cross-sections ' // TRIM( var ) // &
+                       ' from previous run found.'
+          PRINT*, '    This file will be extended.'
+
+
+       CASE ( 'pr_new' )
+
+!
+!--       Define some global attributes of the dataset
+          IF ( averaging_interval_pr /= 0.0 )  THEN
+             WRITE (time_average_text,'('', '',F7.1,'' s average'')') &
+                                                            averaging_interval_pr
+             nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title',   &
+                                     TRIM( run_description_header ) //  &
+                                     TRIM( time_average_text ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 218 )
+
+             WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_pr
+             nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'time_avg', &
+                                     TRIM( time_average_text ) )
+          ELSE
+             nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title', &
+                                     TRIM( run_description_header ) )
+          ENDIF
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 219 )
+
+!
+!--       Define time coordinate for profiles (unlimited dimension)
+          nc_stat = NF90_DEF_DIM( id_set_pr, 'time', NF90_UNLIMITED, &
+                                  id_dim_time_pr )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 220 )
+
+          nc_stat = NF90_DEF_VAR( id_set_pr, 'time', NF90_DOUBLE, &
+                                  id_dim_time_pr, id_var_time_pr )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 221 )
+
+          nc_stat = NF90_PUT_ATT( id_set_pr, id_var_time_pr, 'units', 'seconds')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 222 )
+
+!
+!--       Define the variables
+          var_list = ';'
+          DO  i = 1, dopr_n
+!
+!--          First, remove those characters not allowed by NetCDF
+             netcdf_var_name = data_output_pr(i)
+             CALL clean_netcdf_varname( netcdf_var_name )
+
+             IF ( statistic_regions == 0 )  THEN
+
+!
+!--             Define the z-axes (each variable gets its own z-axis)
+                nc_stat = NF90_DEF_DIM( id_set_pr, 'z'//TRIM(netcdf_var_name), &
+                                        nzt+2-nzb, id_dim_z_pr(i,0) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 223 )
+
+                nc_stat = NF90_DEF_VAR( id_set_pr, 'z'//TRIM(netcdf_var_name), &
+                                        NF90_DOUBLE, id_dim_z_pr(i,0),         &
+                                        id_var_z_pr(i,0) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 224 )
+
+                nc_stat = NF90_PUT_ATT( id_set_pr, id_var_z_pr(i,0), 'units', &
+                                        'meters' )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 225 )
+
+!
+!--             Define the variable
+                nc_stat = NF90_DEF_VAR( id_set_pr, netcdf_var_name,           &
+                                        nc_precision(5), (/ id_dim_z_pr(i,0), &
+                                        id_dim_time_pr /), id_var_dopr(i,0) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 226 )
+
+                nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,0), &
+                                        'long_name', TRIM( data_output_pr(i) ) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 227 )
+
+                nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,0), &
+                                        'units', TRIM( dopr_unit(i) ) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 228 )
+
+                var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+
+             ELSE
+!
+!--             If statistic regions are defined, add suffix _SR+#SR to the
+!--             names
+                DO  j = 0, statistic_regions
+                   WRITE ( suffix, '(''_'',I1)' )  j
+
+!
+!--                Define the z-axes (each variable gets it own z-axis)
+                   nc_stat = NF90_DEF_DIM( id_set_pr,                          &
+                                           'z'//TRIM(netcdf_var_name)//suffix, &
+                                           nzt+2-nzb, id_dim_z_pr(i,j) )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 229 )
+
+                   nc_stat = NF90_DEF_VAR( id_set_pr,                          &
+                                           'z'//TRIM(netcdf_var_name)//suffix, &
+                                           nc_precision(5), id_dim_z_pr(i,j),  &
+                                           id_var_z_pr(i,j) )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 230 )
+
+                   nc_stat = NF90_PUT_ATT( id_set_pr, id_var_z_pr(i,j), &
+                                           'units', 'meters' )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 231 )
+
+!
+!--                Define the variable
+                   nc_stat = NF90_DEF_VAR( id_set_pr,                         &
+                                           TRIM( netcdf_var_name ) // suffix, &
+                                           nc_precision(5),                   &
+                                           (/ id_dim_z_pr(i,j),               &
+                                           id_dim_time_pr /), id_var_dopr(i,j) )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 232 )
+
+                   nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,j),        &
+                                           'long_name',                        &
+                                           TRIM( data_output_pr(i) ) // ' SR ' &
+                                           // suffix(2:2) )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 233 )
+
+                   nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,j), &
+                                           'units', TRIM( dopr_unit(i) ) )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 234 )
+
+                   var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+                              suffix // ';'
+
+                ENDDO
+
+             ENDIF
+
+          ENDDO
+
+!
+!--       Write the list of variables as global attribute (this is used by
+!--       restart runs)
+          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', var_list )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 235 )
+
+!
+!--       Define normalization variables (as time series)
+          DO  i = 1, dopr_norm_num
+
+             nc_stat = NF90_DEF_VAR( id_set_pr, 'NORM_' // &
+                                     TRIM( dopr_norm_names(i) ), &
+                                     nc_precision(5), (/ id_dim_time_pr /), &
+                                     id_var_norm_dopr(i) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 236 )
+
+             nc_stat = NF90_PUT_ATT( id_set_pr, id_var_norm_dopr(i), &
+                                     'long_name',                    &
+                                     TRIM( dopr_norm_longnames(i) ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 237 )
+
+          ENDDO
+
+!
+!--       Leave NetCDF define mode
+          nc_stat = NF90_ENDDEF( id_set_pr )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 238 )
+
+!
+!--       Write z-axes data
+          DO  i = 1, dopr_n
+             DO  j = 0, statistic_regions
+
+                nc_stat = NF90_PUT_VAR( id_set_pr, id_var_z_pr(i,j),      &
+                                        hom(nzb:nzt+1,2,dopr_index(i),0), &
+                                        start = (/ 1 /),                  &
+                                        count = (/ nzt-nzb+2 /) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 239 )
+
+             ENDDO
+          ENDDO
+
+
+       CASE ( 'pr_ext' )
+
+!
+!--       Get the list of variables and compare with the actual run.
+!--       First var_list_old has to be reset, since GET_ATT does not assign
+!--       trailing blanks.
+          var_list_old = ' '
+          nc_stat = NF90_GET_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 240 )
+
+          var_list = ';'
+          DO  i = 1, dopr_n
+
+             netcdf_var_name = data_output_pr(i)
+             CALL clean_netcdf_varname( netcdf_var_name )
+
+             IF ( statistic_regions == 0 )  THEN
+                var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+             ELSE
+                DO  j = 0, statistic_regions
+                   WRITE ( suffix, '(''_'',I1)' )  j
+                   var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+                              suffix // ';'
+                ENDDO
+             ENDIF
+
+          ENDDO
+
+          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for vertical profiles from' // &
+                                   ' previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' variable mismatch.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Get the id of the time coordinate (unlimited coordinate) and its
+!--       last index on the file. The next time level is dopr..count+1.
+!--       The current time must be larger than the last output time
+!--       on the file.
+          nc_stat = NF90_INQ_VARID( id_set_pr, 'time', id_var_time_pr )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 241 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_pr, id_var_time_pr, &
+                                           dimids = id_dim_time_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 242 )
+          id_dim_time_pr = id_dim_time_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_pr, id_dim_time_pr, &
+                                            len = dopr_time_count )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 243 )
+
+          nc_stat = NF90_GET_VAR( id_set_pr, id_var_time_pr,        &
+                                  last_time_coordinate,             &
+                                  start = (/ dopr_time_count /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 244 )
+
+          IF ( last_time_coordinate(1) >= simulated_time )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for vertical profiles from' // &
+                                   ' previuos run found,'
+             PRINT*, '             but this file cannot be extended becaus' // &
+                                   'e the current output time'
+             PRINT*, '             is less or equal than the last output t' // &
+                                   'ime on this file.'
+             PRINT*, '             New file is created instead.'
+             dopr_time_count = 0
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Dataset seems to be extendable.
+!--       Now get the variable ids.
+          i = 1
+          DO  i = 1, dopr_n
+ 
+             netcdf_var_name_base = data_output_pr(i)
+             CALL clean_netcdf_varname( netcdf_var_name_base )
+
+             IF ( statistic_regions == 0 )  THEN
+                nc_stat = NF90_INQ_VARID( id_set_pr, netcdf_var_name_base, &
+                                          id_var_dopr(i,0) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 245 )
+             ELSE
+                DO  j = 0, statistic_regions
+                   WRITE ( suffix, '(''_'',I1)' )  j
+                   netcdf_var_name = TRIM( netcdf_var_name_base ) // suffix
+                   nc_stat = NF90_INQ_VARID( id_set_pr, netcdf_var_name, &
+                                             id_var_dopr(i,j) )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 246 )
+                ENDDO
+             ENDIF
+
+          ENDDO
+
+!
+!--       Get ids of the normalization variables
+          DO  i = 1, dopr_norm_num
+             nc_stat = NF90_INQ_VARID( id_set_pr,                             &
+                                       'NORM_' // TRIM( dopr_norm_names(i) ), &
+                                       id_var_norm_dopr(i) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 247 )
+          ENDDO
+
+!
+!--       Change the title attribute on file
+          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 248 )
+          PRINT*, '*** NetCDF file for vertical profiles from previous run' // &
+                       ' found.'
+          PRINT*, '    This file will be extended.'
+
+
+       CASE ( 'ts_new' )
+
+!
+!--       Define some global attributes of the dataset
+          nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 249 )
+
+!
+!--       Define time coordinate for time series (unlimited dimension)
+          nc_stat = NF90_DEF_DIM( id_set_ts, 'time', NF90_UNLIMITED, &
+                                  id_dim_time_ts )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 250 )
+
+          nc_stat = NF90_DEF_VAR( id_set_ts, 'time', NF90_DOUBLE, &
+                                  id_dim_time_ts, id_var_time_ts )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 251 )
+
+          nc_stat = NF90_PUT_ATT( id_set_ts, id_var_time_ts, 'units', 'seconds')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 252 )
+
+!
+!--       Define the variables
+          var_list = ';'
+          DO  i = 1, dots_num
+!
+!--          First, remove those characters not allowed by NetCDF
+             netcdf_var_name = dots_label(i)
+             CALL clean_netcdf_varname( netcdf_var_name )
+
+             IF ( statistic_regions == 0 )  THEN
+
+                nc_stat = NF90_DEF_VAR( id_set_ts, netcdf_var_name,            &
+                                        nc_precision(6), (/ id_dim_time_ts /), &
+                                        id_var_dots(i,0) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 253 )
+
+                nc_stat = NF90_PUT_ATT( id_set_ts, id_var_dots(i,0), &
+                                        'long_name', TRIM( dots_label(i) ) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 254 )
+
+                nc_stat = NF90_PUT_ATT( id_set_ts, id_var_dots(i,0), &
+                                        'units', TRIM( dots_unit(i) ) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 255 )
+
+                var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+
+             ELSE
+!
+!--             If statistic regions are defined, add suffix _SR+#SR to the
+!--             names
+                DO  j = 0, statistic_regions
+                   WRITE ( suffix, '(''_'',I1)' )  j
+
+                   nc_stat = NF90_DEF_VAR( id_set_ts,                         &
+                                           TRIM( netcdf_var_name ) // suffix, &
+                                           nc_precision(6),                   &
+                                           (/ id_dim_time_ts /),              &
+                                           id_var_dots(i,j) )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 256 )
+
+                   nc_stat = NF90_PUT_ATT( id_set_ts, id_var_dots(i,j),       &
+                                           'long_name',                       &
+                                           TRIM( dots_label(i) ) // ' SR ' // &
+                                           suffix(2:2) )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 257 )
+
+                   var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+                              suffix // ';'
+
+                ENDDO
+
+             ENDIF
+
+          ENDDO
+
+!
+!--       Write the list of variables as global attribute (this is used by
+!--       restart runs)
+          nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', var_list )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 258 )
+
+!
+!--       Leave NetCDF define mode
+          nc_stat = NF90_ENDDEF( id_set_ts )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 259 )
+
+
+       CASE ( 'ts_ext' )
+
+!
+!--       Get the list of variables and compare with the actual run.
+!--       First var_list_old has to be reset, since GET_ATT does not assign
+!--       trailing blanks.
+          var_list_old = ' '
+          nc_stat = NF90_GET_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 260 )
+
+          var_list = ';'
+          i = 1
+          DO  i = 1, dots_num
+
+             netcdf_var_name = dots_label(i)
+             CALL clean_netcdf_varname( netcdf_var_name )
+
+             IF ( statistic_regions == 0 )  THEN
+                var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+             ELSE
+                DO  j = 0, statistic_regions
+                   WRITE ( suffix, '(''_'',I1)' )  j
+                   var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+                              suffix // ';'
+                ENDDO
+             ENDIF
+
+          ENDDO
+
+          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for time series from' //&
+                                   ' previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' variable mismatch.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Get the id of the time coordinate (unlimited coordinate) and its
+!--       last index on the file. The next time level is dots..count+1.
+!--       The current time must be larger than the last output time
+!--       on the file.
+          nc_stat = NF90_INQ_VARID( id_set_ts, 'time', id_var_time_ts )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 261 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_ts, id_var_time_ts, &
+                                           dimids = id_dim_time_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 262 )
+          id_dim_time_ts = id_dim_time_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_ts, id_dim_time_ts, &
+                                            len = dots_time_count )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 263 )
+
+          nc_stat = NF90_GET_VAR( id_set_ts, id_var_time_ts,        &
+                                  last_time_coordinate,             &
+                                  start = (/ dots_time_count /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 264 )
+
+          IF ( last_time_coordinate(1) >= simulated_time )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for time series from' // &
+                                   ' previuos run found,'
+             PRINT*, '             but this file cannot be extended becaus' // &
+                                   'e the current output time'
+             PRINT*, '             is less or equal than the last output t' // &
+                                   'ime on this file.'
+             PRINT*, '             New file is created instead.'
+             dots_time_count = 0
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Dataset seems to be extendable.
+!--       Now get the variable ids
+          i = 1
+          DO  i = 1, dots_num
+ 
+             netcdf_var_name_base = dots_label(i)
+             CALL clean_netcdf_varname( netcdf_var_name_base )
+
+             IF ( statistic_regions == 0 )  THEN
+                nc_stat = NF90_INQ_VARID( id_set_ts, netcdf_var_name_base, &
+                                          id_var_dots(i,0) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 265 )
+             ELSE
+                DO  j = 0, statistic_regions
+                   WRITE ( suffix, '(''_'',I1)' )  j
+                   netcdf_var_name = TRIM( netcdf_var_name_base ) // suffix
+                   nc_stat = NF90_INQ_VARID( id_set_ts, netcdf_var_name, &
+                                             id_var_dots(i,j) )
+                   IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 266 )
+                ENDDO
+             ENDIF
+
+          ENDDO
+
+!
+!--       Change the title attribute on file
+          nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 267 )
+          PRINT*, '*** NetCDF file for time series from previous run found.'
+          PRINT*, '    This file will be extended.'
+
+
+       CASE ( 'sp_new' )
+
+!
+!--       Define some global attributes of the dataset
+          IF ( averaging_interval_sp /= 0.0 )  THEN
+             WRITE (time_average_text,'('', '',F7.1,'' s average'')') &
+                                                            averaging_interval_sp
+             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title',  &
+                                     TRIM( run_description_header ) // &
+                                     TRIM( time_average_text ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 268 )
+
+             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval_sp
+             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', &
+                                     TRIM( time_average_text ) )
+          ELSE
+             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', &
+                                     TRIM( run_description_header ) )
+          ENDIF
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 269 )
+
+!
+!--       Define time coordinate for spectra (unlimited dimension)
+          nc_stat = NF90_DEF_DIM( id_set_sp, 'time', NF90_UNLIMITED, &
+                                  id_dim_time_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 270 )
+
+          nc_stat = NF90_DEF_VAR( id_set_sp, 'time', NF90_DOUBLE, &
+                                  id_dim_time_sp, id_var_time_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 271 )
+
+          nc_stat = NF90_PUT_ATT( id_set_sp, id_var_time_sp, 'units', 'seconds')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 272 )
+
+!
+!--       Define the spatial dimensions and coordinates for spectra.
+!--       First, determine the number of vertical levels for which spectra
+!--       are to be output.
+          ns = 1
+          DO WHILE ( comp_spectra_level(ns) /= 999999  .AND.  ns <= 100 )
+             ns = ns + 1
+          ENDDO
+          ns = ns - 1
+
+!
+!--       Define vertical coordinate grid (zu grid)
+          nc_stat = NF90_DEF_DIM( id_set_sp, 'zu_sp', ns, id_dim_zu_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 273 )
+
+          nc_stat = NF90_DEF_VAR( id_set_sp, 'zu_sp', NF90_DOUBLE, &
+                                  id_dim_zu_sp, id_var_zu_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 274 )
+
+          nc_stat = NF90_PUT_ATT( id_set_sp, id_var_zu_sp, 'units', 'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 275 )
+
+!
+!--       Define vertical coordinate grid (zw grid)
+          nc_stat = NF90_DEF_DIM( id_set_sp, 'zw_sp', ns, id_dim_zw_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 276 )
+
+          nc_stat = NF90_DEF_VAR( id_set_sp, 'zw_sp', NF90_DOUBLE, &
+                                  id_dim_zw_sp, id_var_zw_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 277 )
+
+          nc_stat = NF90_PUT_ATT( id_set_sp, id_var_zw_sp, 'units', 'meters' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 278 )
+
+!
+!--       Define x-axis
+          nc_stat = NF90_DEF_DIM( id_set_sp, 'k_x', nx/2, id_dim_x_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 279 )
+
+          nc_stat = NF90_DEF_VAR( id_set_sp, 'k_x', NF90_DOUBLE, id_dim_x_sp, &
+                                  id_var_x_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 280 )
+
+          nc_stat = NF90_PUT_ATT( id_set_sp, id_var_x_sp, 'units', 'm-1' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 281 )
+
+!
+!--       Define y-axis
+          nc_stat = NF90_DEF_DIM( id_set_sp, 'k_y', ny/2, id_dim_y_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 282 )
+
+          nc_stat = NF90_DEF_VAR( id_set_sp, 'k_y', NF90_DOUBLE, id_dim_y_sp, &
+                                  id_var_y_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 283 )
+
+          nc_stat = NF90_PUT_ATT( id_set_sp, id_var_y_sp, 'units', 'm-1' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 284 )
+
+!
+!--       Define the variables
+          var_list = ';'
+          i = 1
+          DO WHILE ( data_output_sp(i) /= ' '  .AND.  i <= 10 )
+
+             IF ( INDEX( spectra_direction(i), 'x' ) /= 0 )  THEN
+
+!
+!--             Define the variable
+                netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
+                IF ( data_output_sp(i) == 'w' )  THEN
+                   nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name,      &
+                                           nc_precision(7), (/ id_dim_x_sp, &
+                                           id_dim_zw_sp, id_dim_time_sp /), &
+                                           id_var_dospx(i) )
+                ELSE
+                   nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name,      &
+                                           nc_precision(7), (/ id_dim_x_sp, &
+                                           id_dim_zu_sp, id_dim_time_sp /), &
+                                           id_var_dospx(i) )
+                ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 285 )
+
+                nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospx(i), &
+                                        'long_name', netcdf_var_name )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 286 )
+
+                nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospx(i), &
+                                        'units', 'unknown' )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 287 )
+
+                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
+
+             ENDIF
+
+             IF ( INDEX( spectra_direction(i), 'y' ) /= 0 )  THEN
+
+!
+!--             Define the variable
+                netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
+                IF ( data_output_sp(i) == 'w' )  THEN
+                   nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name,      &
+                                           nc_precision(7), (/ id_dim_y_sp, &
+                                           id_dim_zw_sp, id_dim_time_sp /), &
+                                           id_var_dospy(i) )
+                ELSE
+                   nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name,      &
+                                           nc_precision(7), (/ id_dim_y_sp, &
+                                           id_dim_zu_sp, id_dim_time_sp /), &
+                                           id_var_dospy(i) )
+                ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 288 )
+
+                nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospy(i), &
+                                        'long_name', netcdf_var_name )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 289 )
+
+                nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospy(i), &
+                                        'units', 'unknown' )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 290 )
+
+                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
+
+             ENDIF
+
+             i = i + 1
+
+          ENDDO
+
+!
+!--       Write the list of variables as global attribute (this is used by
+!--       restart runs)
+          nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', var_list )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 291 )
+
+!
+!--       Leave NetCDF define mode
+          nc_stat = NF90_ENDDEF( id_set_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 292 )
+
+!
+!--       Write axis data: zu_sp, zw_sp, k_x, k_y
+          ALLOCATE( netcdf_data(1:ns) )
+
+!
+!--       Write zu data
+          netcdf_data(1:ns) = zu( comp_spectra_level(1:ns) )
+          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zu_sp, netcdf_data, &
+                                  start = (/ 1 /), count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 293 )
+
+!
+!--       Write zw data
+          netcdf_data(1:ns) = zw( comp_spectra_level(1:ns) )
+          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zw_sp, netcdf_data, &
+                                  start = (/ 1 /), count = (/ ns /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 294 )
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Write data for x and y axis (wavenumbers)
+          ALLOCATE( netcdf_data(nx/2) )
+          DO  i = 1, nx/2
+             netcdf_data(i) = 2.0 * pi * i / ( dx * ( nx + 1 ) )
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_x_sp, netcdf_data, &
+                                  start = (/ 1 /), count = (/ nx/2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 295 )
+
+          DEALLOCATE( netcdf_data )
+
+          ALLOCATE( netcdf_data(ny/2) )
+          DO  i = 1, ny/2
+             netcdf_data(i) = 2.0 * pi * i / ( dy * ( ny + 1 ) )
+          ENDDO
+
+          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_y_sp, netcdf_data, &
+                                  start = (/ 1 /), count = (/ ny/2 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 296 )
+
+          DEALLOCATE( netcdf_data )
+
+
+       CASE ( 'sp_ext' )
+
+!
+!--       Get the list of variables and compare with the actual run.
+!--       First var_list_old has to be reset, since GET_ATT does not assign
+!--       trailing blanks.
+          var_list_old = ' '
+          nc_stat = NF90_GET_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 297 )
+
+          var_list = ';'
+          i = 1
+          DO WHILE ( data_output_sp(i) /= ' '  .AND.  i <= 10 )
+
+             IF ( INDEX( spectra_direction(i), 'x' ) /= 0 )  THEN
+                netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
+                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
+             ENDIF
+
+             IF ( INDEX( spectra_direction(i), 'y' ) /= 0 )  THEN
+                netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
+                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
+             ENDIF
+
+             i = i + 1
+
+          ENDDO
+
+          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for spectra from previous ' //&
+                                   'run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' variable mismatch.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Determine the number of current vertical levels for which spectra
+!--       shall be output
+          ns = 1
+          DO WHILE ( comp_spectra_level(ns) /= 999999  .AND.  ns <= 100 )
+             ns = ns + 1
+          ENDDO
+          ns = ns - 1
+
+!
+!--       Get and compare the number of vertical levels
+          nc_stat = NF90_INQ_VARID( id_set_sp, 'zu_sp', id_var_zu_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 298 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_zu_sp, &
+                                           dimids = id_dim_zu_sp_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 299 )
+          id_dim_zu_sp = id_dim_zu_sp_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_zu_sp, &
+                                            len = ns_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 300 )
+
+          IF ( ns /= ns_old )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for spectra from previous ' //&
+                                   'run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' mismatch in number of'
+             PRINT*, '             vertical levels.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Get and compare the heights of the cross sections
+          ALLOCATE( netcdf_data(1:ns_old) )
+
+          nc_stat = NF90_GET_VAR( id_set_sp, id_var_zu_sp, netcdf_data )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 301 )
+
+          DO  i = 1, ns
+             IF ( zu(comp_spectra_level(i)) /= netcdf_data(i) )  THEN
+                PRINT*, '+++ WARNING: NetCDF file for spectra from previou' // &
+                                   's run found,'
+                PRINT*, '             but this file cannot be extended due' // &
+                                   ' to mismatch in heights'
+                PRINT*, '             of vertical levels.'
+                PRINT*, '             New file is created instead.'
+                extend = .FALSE.
+                RETURN
+             ENDIF
+          ENDDO
+
+          DEALLOCATE( netcdf_data )
+
+!
+!--       Get the id of the time coordinate (unlimited coordinate) and its
+!--       last index on the file. The next time level is plsp..count+1.
+!--       The current time must be larger than the last output time
+!--       on the file.
+          nc_stat = NF90_INQ_VARID( id_set_sp, 'time', id_var_time_sp )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 302 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_time_sp, &
+                                           dimids = id_dim_time_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 303 )
+          id_dim_time_sp = id_dim_time_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_time_sp, &
+                                            len = dosp_time_count )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 304 )
+
+          nc_stat = NF90_GET_VAR( id_set_sp, id_var_time_sp,        &
+                                  last_time_coordinate,             &
+                                  start = (/ dosp_time_count /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 305 )
+
+          IF ( last_time_coordinate(1) >= simulated_time )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for spectra from previous ' // &
+                                   'run found,'
+             PRINT*, '             but this file cannot be extended becaus' // &
+                                   'e the current output time'
+             PRINT*, '             is less or equal than the last output t' // &
+                                   'ime on this file.'
+             PRINT*, '             New file is created instead.'
+             dosp_time_count = 0
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Dataset seems to be extendable.
+!--       Now get the variable ids.
+          i = 1
+          DO WHILE ( data_output_sp(i) /= ' '  .AND.  i <= 10 )
+
+             IF ( INDEX( spectra_direction(i), 'x' ) /= 0 )  THEN
+                netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
+                nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, &
+                                          id_var_dospx(i) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 306 )
+             ENDIF
+
+             IF ( INDEX( spectra_direction(i), 'y' ) /= 0 )  THEN
+                netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
+                nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, &
+                                          id_var_dospy(i) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 307 )
+             ENDIF
+
+             i = i + 1
+
+          ENDDO
+
+!
+!--       Change the titel attribute on file
+          IF ( averaging_interval_sp /= 0.0 )  THEN
+             WRITE (time_average_text,'('', '',F7.1,'' s average'')') &
+                                                            averaging_interval_sp
+             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title',  &
+                                     TRIM( run_description_header ) // &
+                                     TRIM( time_average_text ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 308 )
+
+             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval_sp
+             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', &
+                                     TRIM( time_average_text ) )
+          ELSE
+             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', &
+                                     TRIM( run_description_header ) )
+          ENDIF
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 309 )
+
+          PRINT*, '*** NetCDF file for spectra from previous run found.'
+          PRINT*, '    This file will be extended.'
+
+
+       CASE ( 'pt_new' )
+
+!
+!--       Define some global attributes of the dataset
+          nc_stat = NF90_PUT_ATT( id_set_prt, NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 310 )
+
+!
+!--       Define time coordinate for particles (unlimited dimension)
+          nc_stat = NF90_DEF_DIM( id_set_prt, 'time', NF90_UNLIMITED, &
+                                  id_dim_time_prt )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 311 )
+
+          nc_stat = NF90_DEF_VAR( id_set_prt, 'time', NF90_DOUBLE, &
+                                  id_dim_time_prt, id_var_time_prt )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 312 )
+
+          nc_stat = NF90_PUT_ATT( id_set_prt, id_var_time_prt, 'units', &
+                                  'seconds' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 313 )
+
+!
+!--       Define particle coordinate (maximum particle number)
+          nc_stat = NF90_DEF_DIM( id_set_prt, 'particle_number', &
+                                  maximum_number_of_particles, id_dim_prtnum )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 314 )
+
+          nc_stat = NF90_DEF_VAR( id_set_prt, 'particle_number', NF90_DOUBLE, &
+                                  id_dim_prtnum, id_var_prtnum )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 315 )
+
+          nc_stat = NF90_PUT_ATT( id_set_prt, id_var_prtnum, 'units', &
+                                  'particle number' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 316 )
+
+!
+!--       Define variable which contains the real number of particles in use
+          nc_stat = NF90_DEF_VAR( id_set_prt, 'real_num_of_prt', NF90_INT, &
+                                  id_dim_time_prt, id_var_rnop_prt )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 317 )
+
+          nc_stat = NF90_PUT_ATT( id_set_prt, id_var_rnop_prt, 'units', &
+                                  'particle number' )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 318 )
+
+!
+!--       Define the variables
+          DO  i = 1, 17
+
+             nc_stat = NF90_DEF_VAR( id_set_prt, prt_var_names(i),         &
+                                     nc_precision(8),                      &
+                                     (/ id_dim_prtnum, id_dim_time_prt /), &
+                                     id_var_prt(i) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 319 )
+
+             nc_stat = NF90_PUT_ATT( id_set_prt, id_var_prt(i), &
+                                     'long_name', TRIM( prt_var_names(i) ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 320 )
+
+             nc_stat = NF90_PUT_ATT( id_set_prt, id_var_prt(i), &
+                                     'units', TRIM( prt_var_units(i) ) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 321 )
+
+          ENDDO
+
+!
+!--       Leave NetCDF define mode
+          nc_stat = NF90_ENDDEF( id_set_prt )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 322 )
+
+
+       CASE ( 'pt_ext' )
+
+!
+!--       Get the id of the time coordinate (unlimited coordinate) and its
+!--       last index on the file. The next time level is prt..count+1.
+!--       The current time must be larger than the last output time
+!--       on the file.
+          nc_stat = NF90_INQ_VARID( id_set_prt, 'time', id_var_time_prt )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 323 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_prt, id_var_time_prt, &
+                                           dimids = id_dim_time_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 324 )
+          id_dim_time_prt = id_dim_time_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_prt, id_dim_time_prt, &
+                                            len = prt_time_count )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 325 )
+
+          nc_stat = NF90_GET_VAR( id_set_prt, id_var_time_prt,  &
+                                  last_time_coordinate,         &
+                                  start = (/ prt_time_count /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 326 )
+
+          IF ( last_time_coordinate(1) >= simulated_time )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for particles from previous ' //&
+                                   'run found,'
+             PRINT*, '             but this file cannot be extended becaus' // &
+                                   'e the current output time'
+             PRINT*, '             is less or equal than the last output t' // &
+                                   'ime on this file.'
+             PRINT*, '             New file is created instead.'
+             prt_time_count = 0
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Dataset seems to be extendable.
+!--       Now get the variable ids.
+          nc_stat = NF90_INQ_VARID( id_set_prt, 'real_num_of_prt', &
+                                    id_var_rnop_prt )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 327 )
+
+          DO  i = 1, 17
+
+             nc_stat = NF90_INQ_VARID( id_set_prt, prt_var_names(i), &
+                                       id_var_prt(i) )
+             IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 328 )
+
+          ENDDO
+
+          IF ( myid == 0 )  THEN
+             PRINT*, '*** NetCDF file for particles from previous run found.'
+             PRINT*, '    This file will be extended.'
+          ENDIF
+
+
+       CASE ( 'ps_new' )
+
+!
+!--       Define some global attributes of the dataset
+          nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 396 )
+
+!
+!--       Define time coordinate for particle time series (unlimited dimension)
+          nc_stat = NF90_DEF_DIM( id_set_pts, 'time', NF90_UNLIMITED, &
+                                  id_dim_time_pts )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 397 )
+
+          nc_stat = NF90_DEF_VAR( id_set_pts, 'time', NF90_DOUBLE, &
+                                  id_dim_time_pts, id_var_time_pts )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 398 )
+
+          nc_stat = NF90_PUT_ATT( id_set_pts, id_var_time_pts, 'units', &
+                                  'seconds')
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 399 )
+
+!
+!--       Define the variables. If more than one particle group is defined,
+!--       define seperate variables for each group
+          var_list = ';'
+          DO  i = 1, dopts_num
+
+!
+!--          First, remove those characters not allowed by NetCDF
+             netcdf_var_name = dopts_label(i)
+             CALL clean_netcdf_varname( netcdf_var_name )
+
+             DO  j = 0, number_of_particle_groups
+
+                IF ( j == 0 )  THEN
+                   suffix1 = ''
+                ELSE
+                   WRITE ( suffix1, '(''_'',I2.2)' )  j
+                ENDIF
+
+                nc_stat = NF90_DEF_VAR( id_set_pts,                         &
+                                        TRIM( netcdf_var_name ) // suffix1, &
+                                        nc_precision(6),                    &
+                                        (/ id_dim_time_pts /),              &
+                                        id_var_dopts(i,j) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 400 )
+
+                IF ( j == 0 )  THEN
+                   nc_stat = NF90_PUT_ATT( id_set_pts, id_var_dopts(i,j), &
+                                           'long_name', &
+                                           TRIM( dopts_label(i) ) )
+                ELSE
+                   nc_stat = NF90_PUT_ATT( id_set_pts, id_var_dopts(i,j), &
+                                           'long_name', &
+                                           TRIM( dopts_label(i) ) // ' PG ' // &
+                                           suffix1(2:3) )
+                ENDIF
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 401 )
+
+                nc_stat = NF90_PUT_ATT( id_set_pts, id_var_dopts(i,j), &
+                                        'units', TRIM( dopts_unit(i) ) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 402 )
+
+                var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+                           suffix1 // ';'
+
+                IF ( number_of_particle_groups == 1 )  EXIT
+
+             ENDDO
+
+          ENDDO
+
+!
+!--       Write the list of variables as global attribute (this is used by
+!--       restart runs)
+          nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 403 )
+
+!
+!--       Leave NetCDF define mode
+          nc_stat = NF90_ENDDEF( id_set_pts )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 404 )
+
+
+       CASE ( 'ps_ext' )
+
+!
+!--       Get the list of variables and compare with the actual run.
+!--       First var_list_old has to be reset, since GET_ATT does not assign
+!--       trailing blanks.
+          var_list_old = ' '
+          nc_stat = NF90_GET_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', &
+                                  var_list_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 405 )
+
+          var_list = ';'
+          i = 1
+          DO  i = 1, dopts_num
+
+             netcdf_var_name = dopts_label(i)
+             CALL clean_netcdf_varname( netcdf_var_name )
+
+             DO  j = 0, number_of_particle_groups
+
+                IF ( j == 0 )  THEN
+                   suffix1 = ''
+                ELSE
+                   WRITE ( suffix1, '(''_'',I2.2)' )  j
+                ENDIF
+
+                var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+                           suffix1 // ';'
+
+                IF ( number_of_particle_groups == 1 )  EXIT
+
+             ENDDO
+
+          ENDDO
+
+          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for particle time series ' //&
+                                   'from previuos run found,'
+             PRINT*, '             but this file cannot be extended due to' // &
+                                   ' variable mismatch.'
+             PRINT*, '             New file is created instead.'
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Get the id of the time coordinate (unlimited coordinate) and its
+!--       last index on the file. The next time level is dots..count+1.
+!--       The current time must be larger than the last output time
+!--       on the file.
+          nc_stat = NF90_INQ_VARID( id_set_pts, 'time', id_var_time_pts )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 406 )
+
+          nc_stat = NF90_INQUIRE_VARIABLE( id_set_pts, id_var_time_pts, &
+                                           dimids = id_dim_time_old )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 407 )
+          id_dim_time_pts = id_dim_time_old(1)
+
+          nc_stat = NF90_INQUIRE_DIMENSION( id_set_pts, id_dim_time_pts, &
+                                            len = dopts_time_count )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 408 )
+
+          nc_stat = NF90_GET_VAR( id_set_pts, id_var_time_pts,    &
+                                  last_time_coordinate,           &
+                                  start = (/ dopts_time_count /), &
+                                  count = (/ 1 /) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 409 )
+
+          IF ( last_time_coordinate(1) >= simulated_time )  THEN
+             PRINT*, '+++ WARNING: NetCDF file for time series from' // &
+                                   ' previuos run found,'
+             PRINT*, '             but this file cannot be extended becaus' // &
+                                   'e the current output time'
+             PRINT*, '             is less or equal than the last output t' // &
+                                   'ime on this file.'
+             PRINT*, '             New file is created instead.'
+             dopts_time_count = 0
+             extend = .FALSE.
+             RETURN
+          ENDIF
+
+!
+!--       Dataset seems to be extendable.
+!--       Now get the variable ids
+          i = 1
+          DO  i = 1, dopts_num
+ 
+             netcdf_var_name_base = dopts_label(i)
+             CALL clean_netcdf_varname( netcdf_var_name_base )
+
+             DO  j = 0, number_of_particle_groups
+
+                IF ( j == 0 )  THEN
+                   suffix1 = ''
+                ELSE
+                   WRITE ( suffix1, '(''_'',I2.2)' )  j
+                ENDIF
+
+                netcdf_var_name = TRIM( netcdf_var_name_base ) // suffix1
+
+                nc_stat = NF90_INQ_VARID( id_set_pts, netcdf_var_name, &
+                                          id_var_dopts(i,j) )
+                IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 410 )
+
+                IF ( number_of_particle_groups == 1 )  EXIT
+
+             ENDDO
+
+          ENDDO
+
+!
+!--       Change the title attribute on file
+          nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 411 )
+          PRINT*, '*** NetCDF file for particle time series from previous ', &
+                       'run found.'
+          PRINT*, '    This file will be extended.'
+
+
+       CASE DEFAULT
+
+          PRINT*, '+++ define_netcdf_header: mode "', mode, '" not supported'
+
+    END SELECT
+
+#endif
+ END SUBROUTINE define_netcdf_header
+
+
+
+ SUBROUTINE handle_netcdf_error( errno )
+#if defined( __netcdf )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Prints out a text message corresponding to the current status.
+!------------------------------------------------------------------------------!
+
+    USE netcdf
+    USE netcdf_control
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER ::  errno
+
+    IF ( nc_stat /= NF90_NOERR )  THEN
+       PRINT*, '+++ netcdf error ', errno,': ', TRIM( NF90_STRERROR( nc_stat ) )
+#if defined( __parallel )
+       CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+       CALL local_stop
+#endif
+    ENDIF
+
+#endif
+ END SUBROUTINE handle_netcdf_error
+
+
+
+ SUBROUTINE clean_netcdf_varname( string )
+#if defined( __netcdf )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Replace those characters in string which are not allowed by NetCDF.
+!------------------------------------------------------------------------------!
+
+    USE netcdf_control
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=10), INTENT(INOUT) ::  string
+
+    INTEGER ::  i, ic
+
+    DO  i = 1, replace_num
+       DO
+          ic = INDEX( string, replace_char(i) )
+          IF ( ic /= 0 )  THEN
+             string(ic:ic) = replace_by(i)
+          ELSE
+             EXIT
+          ENDIF
+       ENDDO
+    ENDDO
+
+#endif
+ END SUBROUTINE clean_netcdf_varname
Index: palm/trunk/SOURCE/netcdf_data_input_mod.f90
===================================================================
--- palm/trunk/SOURCE/netcdf_data_input_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,5467 +1,0 @@
-!> @file netcdf_data_input_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Minor formatting adjustments and some comments added in get_variable_surf
-!
-! 4878 2021-02-18 09:47:49Z suehring
-! Rename resize_array into add_ghost_layers; remove number of passed indices; replace subroutine
-! calls with interface name
-!
-! 4877 2021-02-17 16:17:35Z suehring
-! Add interface for resize_array and add subroutine to resize 2d-real arrays
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Check if netCDF file actually exists before opening it for reading.
-!
-! 4807 2020-12-02 21:02:28Z gronemeier
-! Deactivated reading of building_obstruction_full due to improper implementation (conflicts with
-! building_obstruction_f and it is also not used anywhere else in the code).
-!
-! 4806 2020-12-02 21:00:32Z gronemeier
-! file re-formatted to follow the PALM coding standard
-!
-! 4724 2020-10-06 17:20:39Z suehring
-! - New routines to read LOD=1 variables from dynamic input file
-! - add no_abort option to all get_attribute routines
-!
-! 4641 2020-08-13 09:57:07Z suehring
-! To follow (UC)2 standard, change default of attribute data_content
-!
-! 4507 2020-04-22 18:21:45Z gronemeier
-! - bugfix: check terrain height for fill values directly after reading
-! - changes:
-!   - remove check for negative zt
-!   - add reference height from input file upon PALM reference height (origin_z)
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added,
-! bugfixes for calls of exchange horiz 2d
-!
-! 4435 2020-03-03 10:38:41Z raasch
-! temporary bugfix to avoid compile problems with older NetCDFD libraries on IMUK machines
-!
-! 4434 2020-03-03 10:02:18Z oliver.maas
-! added optional netcdf data input for wtm array input parameters
-!
-! 4404 2020-02-12 17:01:53Z suehring
-! Fix misplaced preprocessor directives.
-!
-! 4401 2020-02-11 16:19:09Z suehring
-! Define a default list of coordinate reference system variables used when no static driver input is
-! available
-!
-! 4400 2020-02-10 20:32:41Z suehring
-! - Routine to inquire default fill values added
-! - netcdf_data_input_att and netcdf_data_input_var routines removed
-!
-! 4392 2020-01-31 16:14:57Z pavelkrc
-! (resler) Decrease length of reading buffer (fix problem of ifort/icc compilers)
-!
-! 4389 2020-01-29 08:22:42Z raasch
-! Error messages refined for reading ASCII topo file, also reading of topo file revised so that
-! statement labels and goto statements are not required any more
-!
-! 4388 2020-01-28 16:36:55Z raasch
-! bugfix for error messages while reading ASCII topo file
-!
-! 4387 2020-01-28 11:44:20Z banzhafs
-! Added subroutine get_variable_string_generic ( ) and added to interface get_variable to circumvent
-! unknown application-specific restrictions in existing function get_variable_string ( ), which is
-! retained for backward compatibility (ECC)
-!
-! 4370 2020-01-10 14:00:44Z raasch
-! collective read switched off on NEC Aurora to avoid hang situations
-!
-! 4362 2020-01-07 17:15:02Z suehring
-! Input of plant canopy variables from static driver moved to plant-canopy model
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Correct single message calls, local checks must be given by the respective mpi rank.
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4321 2019-12-04 10:26:38Z pavelkrc
-! Further revise check for surface fractions
-!
-! 4313 2019-11-27 14:07:00Z suehring
-! Checks for surface fractions revised
-!
-! 4312 2019-11-27 14:06:25Z suehring
-! Open input files with read-only attribute instead of write attribute.
-!
-! 4280 2019-10-29 14:34:15Z monakurppa
-! Remove id_emis flags from get_variable_4d_to_3d_real and get_variable_5d_to_4d_real
-!
-! 4258 2019-10-07 13:29:08Z suehring
-! - Migrate input of soil temperature and moisture to land-surface model.
-! - Remove interpolate routines and move the only required subroutine to land-surface model.
-!
-! 4247 2019-09-30 10:18:24Z pavelkrc
-! Add reading and processing of building_surface_pars
-!
-! 4226 2019-09-10 17:03:24Z suehring
-! - Netcdf input routine for dimension length renamed
-! - Move offline-nesting-specific checks to nesting_offl_mod
-! - Module-specific input of boundary data for offline nesting moved to nesting_offl_mod
-! - Define module specific data type for offline nesting in nesting_offl_mod
-!
-! 4190 2019-08-27 15:42:37Z suehring
-! type real_1d changed to real_1d_3d
-!
-! 4186 2019-08-23 16:06:14Z suehring
-! Minor formatting adjustments
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4178 2019-08-21 11:13:06Z suehring
-! Implement input of external radiation forcing. Therefore, provide public subroutines and
-! variables.
-!
-! 4150 2019-08-08 20:00:47Z suehring
-! Some variables are given the public attribute, in order to call netcdf input from single routines
-!
-! 4125 2019-07-29 13:31:44Z suehring
-! To enable netcdf-parallel access for lateral boundary data (dynamic input), zero number of
-! elements are passed to the respective get_variable routine for non-boundary cores.
-!
-! 4100 2019-07-17 08:11:29Z forkel
-! Made check for input_pids_dynamic and 'inifor' more general
-!
-! 4012 2019-05-31 15:19:05Z monakurppa
-!
-! 3994 2019-05-22 18:08:09Z suehring
-! Remove single location message
-!
-! 3976 2019-05-15 11:02:34Z hellstea
-! Remove unused variables from last commit
-!
-! 3969 2019-05-13 12:14:33Z suehring
-! - clean-up index notations for emission_values to eliminate magic numbers
-! - introduce temporary variable dum_var_5d as well as subroutines get_var_5d_real and
-!   get_var_5d_real_dynamic
-! - remove emission-specific code in generic get_variable routines
-! - in subroutine netcdf_data_input_chemistry_data change netCDF LOD 1 (default) emission_values to
-!   the following index order: z, y, x, species, category
-! - in subroutine netcdf_data_input_chemistry_data changed netCDF LOD 2 pre-processed
-!   emission_values to the following index order: time, z, y, x, species
-! - in type chem_emis_att_type replace nspec with n_emiss_species but retained nspec for backward
-!   compatibility with salsa_mod. (E.C. Chan)
-!
-! 3961 2019-05-08 16:12:31Z suehring
-! Revise checks for building IDs and types
-!
-! 3943 2019-05-02 09:50:41Z maronga
-! Temporarily disabled some (faulty) checks for static driver.
-!
-! 3942 2019-04-30 13:08:30Z kanani
-! Fix: increase LEN of all NetCDF attribute values (caused crash in netcdf_create_global_atts due to
-!      insufficient length)
-!
-! 3941 2019-04-30 09:48:33Z suehring
-! Move check for grid dimension to an earlier point in time when first array is read.
-! Improve checks for building types / IDs with respect to 2D/3D buildings.
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3864 2019-04-05 09:01:56Z monakurppa
-! get_variable_4d_to_3d_real modified to enable read in data of type data(t,y,x,n) one timestep at
-! a time + some routines made public
-!
-! 3855 2019-04-03 10:00:59Z suehring
-! Typo removed
-!
-! 3854 2019-04-02 16:59:33Z suehring
-! Bugfix in one of the checks. Typo removed.
-!
-! 3744 2019-02-15 18:38:58Z suehring
-! Enable mesoscale offline nesting for chemistry variables as well as initialization of chemistry
-! via dynamic input file.
-!
-! 3705 2019-01-29 19:56:39Z suehring
-! Interface for attribute input of 8-bit and 32-bit integer
-!
-! 3704 2019-01-29 19:51:41Z suehring
-! unused variables removed
-!
-! 2696 2017-12-14 17:12:51Z kanani
-! Initial revision (suehring)
-!
-! Authors:
-! --------
-! @author Matthias Suehring
-! @author Edward C. Chan
-! @author Emanuele Russo
-!
-! Description:
-! ------------
-!> Modulue contains routines to input data according to Palm input data
-!> standart using dynamic and static input files.
-!> @todo - Chemistry: revise reading of netcdf file and ajdust formatting according to standard!!!
-!>         (ecc/done)
-!> @todo - Order input alphabetically
-!> @todo - Revise error messages and error numbers
-!> @todo - Input of missing quantities (chemical species, emission rates)
-!> @todo - Definition and input of still missing variable attributes (ecc/what are they?)
-!> @todo - Input of initial geostrophic wind profiles with cyclic conditions.
-!> @todo - remove z dimension from default_emission_data nad preproc_emission_data and correpsonding
-!>         subroutines get_var_5d_real and get_var_5d_dynamic (ecc)
-!> @todo - decpreciate chem_emis_att_type@nspec (ecc)
-!> @todo - depreciate subroutines get_variable_4d_to_3d_real and get_variable_5d_to_4d_real (ecc)
-!> @todo - introduce useful debug_message(s)
-!--------------------------------------------------------------------------------------------------!
- MODULE netcdf_data_input_mod
-
-    USE control_parameters,                                                                        &
-        ONLY:  coupling_char, io_blocks, io_group
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nxl,                                                                                &
-               nxr,                                                                                &
-               nys,                                                                                &
-               nyn
-
-    USE kinds
-
-#if defined ( __netcdf )
-    USE NETCDF
-#endif
-
-    USE pegrid
-
-    USE surface_mod,                                                                               &
-        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win
-!
-!-- Define type for dimensions.
-    TYPE dims_xy
-       INTEGER(iwp) :: nx                             !< dimension length in x
-       INTEGER(iwp) :: ny                             !< dimension length in y
-       INTEGER(iwp) :: nz                             !< dimension length in z
-       REAL(wp), DIMENSION(:), ALLOCATABLE :: x       !< dimension array in x
-       REAL(wp), DIMENSION(:), ALLOCATABLE :: y       !< dimension array in y
-       REAL(wp), DIMENSION(:), ALLOCATABLE :: z       !< dimension array in z
-    END TYPE dims_xy
-
-    TYPE init_type
-
-       CHARACTER(LEN=16) ::  init_char = 'init_atmosphere_'           !< leading substring for init variables
-       CHARACTER(LEN=23) ::  origin_time = '2000-01-01 00:00:00 +00'  !< reference time of input data
-
-       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem  !< list of chemistry variable names that can potentially be
-                                                                         !< on file
-
-       INTEGER(iwp) ::  lod_msoil !< level of detail - soil moisture
-       INTEGER(iwp) ::  lod_pt    !< level of detail - pt
-       INTEGER(iwp) ::  lod_q     !< level of detail - q
-       INTEGER(iwp) ::  lod_tsoil !< level of detail - soil temperature
-       INTEGER(iwp) ::  lod_u     !< level of detail - u-component
-       INTEGER(iwp) ::  lod_v     !< level of detail - v-component
-       INTEGER(iwp) ::  lod_w     !< level of detail - w-component
-       INTEGER(iwp) ::  nx        !< number of scalar grid points along x in dynamic input file
-       INTEGER(iwp) ::  nxu       !< number of u grid points along x in dynamic input file
-       INTEGER(iwp) ::  ny        !< number of scalar grid points along y in dynamic input file
-       INTEGER(iwp) ::  nyv       !< number of v grid points along y in dynamic input file
-       INTEGER(iwp) ::  nzs       !< number of vertical soil levels in dynamic input file
-       INTEGER(iwp) ::  nzu       !< number of vertical levels on scalar grid in dynamic input file
-       INTEGER(iwp) ::  nzw       !< number of vertical levels on w grid in dynamic input file
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  lod_chem !< level of detail - chemistry variables
-
-       LOGICAL ::  from_file_msoil  = .FALSE. !< flag indicating whether soil moisture is already initialized from file
-       LOGICAL ::  from_file_pt     = .FALSE. !< flag indicating whether pt is already initialized from file
-       LOGICAL ::  from_file_q      = .FALSE. !< flag indicating whether q is already initialized from file
-       LOGICAL ::  from_file_tsoil  = .FALSE. !< flag indicating whether soil temperature is already initialized from file
-       LOGICAL ::  from_file_u      = .FALSE. !< flag indicating whether u is already initialized from file
-       LOGICAL ::  from_file_ug     = .FALSE. !< flag indicating whether ug is already initialized from file
-       LOGICAL ::  from_file_v      = .FALSE. !< flag indicating whether v is already initialized from file
-       LOGICAL ::  from_file_vg     = .FALSE. !< flag indicating whether ug is already initialized from file
-       LOGICAL ::  from_file_w      = .FALSE. !< flag indicating whether w is already initialized from file
-
-       LOGICAL, DIMENSION(:), ALLOCATABLE ::  from_file_chem !< flag indicating whether chemistry variable is read from file
-
-       REAL(wp) ::  fill_msoil              !< fill value for soil moisture
-       REAL(wp) ::  fill_pt                 !< fill value for pt
-       REAL(wp) ::  fill_q                  !< fill value for q
-       REAL(wp) ::  fill_tsoil              !< fill value for soil temperature
-       REAL(wp) ::  fill_u                  !< fill value for u
-       REAL(wp) ::  fill_v                  !< fill value for v
-       REAL(wp) ::  fill_w                  !< fill value for w
-       REAL(wp) ::  latitude = 0.0_wp       !< latitude of the lower left corner
-       REAL(wp) ::  longitude = 0.0_wp      !< longitude of the lower left corner
-       REAL(wp) ::  origin_x = 500000.0_wp  !< UTM easting of the lower left corner
-       REAL(wp) ::  origin_y = 0.0_wp       !< UTM northing of the lower left corner
-       REAL(wp) ::  origin_z = 0.0_wp       !< reference height of input data
-       REAL(wp) ::  rotation_angle = 0.0_wp !< rotation angle of input data
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  fill_chem    !< fill value - chemistry variables
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  msoil_1d     !< initial vertical profile of soil moisture
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt_init      !< initial vertical profile of pt
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  q_init       !< initial vertical profile of q
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  tsoil_1d     !< initial vertical profile of soil temperature
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  u_init       !< initial vertical profile of u
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ug_init      !< initial vertical profile of ug
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  v_init       !< initial vertical profile of v
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  vg_init      !< initial vertical profile of ug
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  w_init       !< initial vertical profile of w
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z_soil       !< vertical levels in soil in dynamic input file, used for interpolation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu_atmos     !< vertical levels at scalar grid in dynamic input file, used for
-                                                            !< interpolation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw_atmos     !< vertical levels at w grid in dynamic input file, used for
-                                                            !< interpolation
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  chem_init  !< initial vertical profiles of chemistry variables
-
-
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  msoil_3d  !< initial 3d soil moisture provide by Inifor and interpolated onto
-                                                             !< soil grid
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  tsoil_3d  !< initial 3d soil temperature provide by Inifor and interpolated onto
-                                                             !< soil grid
-
-    END TYPE init_type
-!
-!-- Data type for the general information of chemistry emissions, do not dependent on the particular chemical species
-    TYPE chem_emis_att_type
-!
-!--    DIMENSIONS
-       INTEGER(iwp)                                 :: nspec=0            !< no of chem species provided in emission_values
-       INTEGER(iwp)                                 :: n_emiss_species=0  !< no of chem species provided in emission_values
-                                                                          !< same function as nspec, which will be depreciated (ecc)
-       INTEGER(iwp)                                 :: ncat=0             !< number of emission categories
-       INTEGER(iwp)                                 :: nvoc=0             !< number of VOC components
-       INTEGER(iwp)                                 :: npm=0              !< number of PM components
-       INTEGER(iwp)                                 :: nnox=2             !< number of NOx components: NO and NO2
-       INTEGER(iwp)                                 :: nsox=2             !< number of SOX components: SO and SO4
-       INTEGER(iwp)                                 :: nhoursyear         !< number of hours of a specific year in the HOURLY mode
-                                                                          !< of the default mode
-       INTEGER(iwp)                                 :: nmonthdayhour      !< number of month days and hours in the MDH mode
-                                                                          !< of the default mode
-       INTEGER(iwp)                                 :: dt_emission        !< Number of emissions timesteps for one year
-                                                                          !< in the pre-processed emissions case
-!
-!--    1d emission input variables
-       CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: pm_name       !< Names of PM components
-       CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: cat_name      !< Emission category names
-       CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: species_name  !< Names of emission chemical species
-       CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: voc_name      !< Names of VOCs components
-       CHARACTER (LEN=25)                           :: units         !< Units
-
-       INTEGER(iwp)                                 :: i_hour         !< indices for assigning emission values at different
-                                                                      !< timesteps
-       INTEGER(iwp),ALLOCATABLE, DIMENSION(:)       :: cat_index      !< Indices for emission categories
-       INTEGER(iwp),ALLOCATABLE, DIMENSION(:)       :: species_index  !< Indices for emission chem species
-
-       REAL(wp),ALLOCATABLE, DIMENSION(:)           :: xm             !< Molecular masses of emission chem species
-
-!--    2d emission input variables
-       REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: hourly_emis_time_factor  !< Time factors for HOURLY emissions (DEFAULT mode)
-       REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: mdh_emis_time_factor     !< Time factors for MDH emissions (DEFAULT mode)
-       REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: nox_comp                 !< Composition of NO and NO2
-       REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: sox_comp                 !< Composition of SO2 and SO4
-       REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: voc_comp                 !< Composition of VOC components (not fixed)
-
-!--    3d emission input variables
-       REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)       :: pm_comp                  !< Composition of PM components (not fixed)
-
-    END TYPE chem_emis_att_type
-
-
-!-- Data type for the values of chemistry emissions
-    TYPE chem_emis_val_type
-
-       !REAL(wp),ALLOCATABLE, DIMENSION(:,:)     :: stack_height           !< stack height (ecc / to be implemented)
-       REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    :: default_emission_data  !< Emission input values for LOD1 (DEFAULT mode)
-       REAL(wp),ALLOCATABLE, DIMENSION(:,:,:,:)  :: preproc_emission_data  !< Emission input values for LOD2 (PRE-PROCESSED mode)
-
-    END TYPE chem_emis_val_type
-
-!
-!-- Define data structures for different input data types.
-!-- 8-bit Integer 2D
-    TYPE int_2d_8bit
-       INTEGER(KIND=1) ::  fill = -127                      !< fill value
-       INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE ::  var !< respective variable
-
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-    END TYPE int_2d_8bit
-!
-!-- 8-bit Integer 3D
-    TYPE int_3d_8bit
-       INTEGER(KIND=1) ::  fill = -127                           !< fill value
-       INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  var_3d !< respective variable
-
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-    END TYPE int_3d_8bit
-!
-!-- 32-bit Integer 2D
-    TYPE int_2d_32bit
-       INTEGER(iwp) ::  fill = -9999                      !< fill value
-       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  var  !< respective variable
-
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-    END TYPE int_2d_32bit
-!
-!-- Define data type to read 1D or 3D real variables.
-    TYPE real_1d_3d
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-
-       INTEGER(iwp) ::  lod = -1        !< level-of-detail
-
-       REAL(wp) ::  fill = -9999.9_wp                  !< fill value
-
-       REAL(wp), DIMENSION(:),     ALLOCATABLE ::  var1d     !< respective 1D variable
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  var3d     !< respective 3D variable
-    END TYPE real_1d_3d
-!
-!-- Define data type to read 2D real variables
-    TYPE real_2d
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-
-       INTEGER(iwp) ::  lod             !< level-of-detail
-
-       REAL(wp) ::  fill = -9999.9_wp                 !< fill value
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var  !< respective variable
-    END TYPE real_2d
-
-!
-!-- Define data type to read 3D real variables
-    TYPE real_3d
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-
-       INTEGER(iwp) ::  nz   !< number of grid points along vertical dimension
-
-       REAL(wp) ::  fill = -9999.9_wp                   !< fill value
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  var  !< respective variable
-    END TYPE real_3d
-!
-!-- Define data structure where the dimension and type of the input depends on the given level of
-!-- detail.
-!-- For buildings, the input is either 2D float, or 3d byte.
-    TYPE build_in
-       INTEGER(iwp)    ::  lod = 1                               !< level of detail
-       INTEGER(KIND=1) ::  fill2 = -127                          !< fill value for lod = 2
-       INTEGER(iwp)    ::  nz                                    !< number of vertical layers in file
-       INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  var_3d !< 3d variable (lod = 2)
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z                 !< vertical coordinate for 3D building, used for consistency check
-
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-
-       REAL(wp)                              ::  fill1 = -9999.9_wp !< fill values for lod = 1
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_2d             !< 2d variable (lod = 1)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  oro_max            !< terraing height under particular buildings
-    END TYPE build_in
-
-!
-!-- For soil_type, the input is either 2D or 3D one-byte integer.
-    TYPE soil_in
-       INTEGER(iwp)                                   ::  lod = 1      !< level of detail
-       INTEGER(KIND=1)                                ::  fill = -127  !< fill value for lod = 2
-       INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE   ::  var_2d       !< 2d variable (lod = 1)
-       INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  var_3d       !< 3d variable (lod = 2)
-
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-    END TYPE soil_in
-
-!
-!-- Define data type for fractions between surface types
-    TYPE fracs
-       INTEGER(iwp)                            ::  nf             !< total number of fractions
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nfracs         !< dimension array for fraction
-
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-
-       REAL(wp)                                ::  fill = -9999.9_wp  !< fill value
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  frac               !< respective fraction between different surface types
-    END TYPE fracs
-!
-!-- Data type for parameter lists, Depending on the given level of detail, the input is 3D or 4D
-    TYPE pars
-       INTEGER(iwp)                            ::  lod = 1         !< level of detail
-       INTEGER(iwp)                            ::  np              !< total number of parameters
-       INTEGER(iwp)                            ::  nz              !< vertical dimension - number of soil layers
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  layers          !< dimension array for soil layers
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  pars            !< dimension array for parameters
-
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-
-       REAL(wp)                                  ::  fill = -9999.9_wp !< fill value
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  pars_xy           !< respective parameters, level of detail = 1
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  pars_xyz          !< respective parameters, level of detail = 2
-    END TYPE pars
-!
-!-- Data type for surface parameter lists
-    TYPE pars_surf
-       INTEGER(iwp)                                ::  np          !< total number of parameters
-       INTEGER(iwp)                                ::  nsurf       !< number of local surfaces
-       INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  index_ji    !< index for beginning and end of surfaces at (j,i)
-       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   ::  coords      !< (k,j,i,norm_z,norm_y,norm_x)
-                                                                   !< k,j,i:                surface position
-                                                                   !< norm_z,norm_y,norm_x: surface normal vector
-
-       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default
-                                        !< values are used
-
-       REAL(wp)                              ::  fill = -9999.9_wp !< fill value
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pars              !< respective parameters per surface
-    END TYPE pars_surf
-!
-!-- Define type for global file attributes
-!-- Please refer to the PALM data standard for a detailed description of each attribute.
-    TYPE global_atts_type
-       CHARACTER(LEN=200) ::  acronym = ' '                           !< acronym of institution
-       CHARACTER(LEN=7)   ::  acronym_char = 'acronym'                !< name of attribute
-       CHARACTER(LEN=200) ::  author  = ' '                           !< first name, last name, email adress
-       CHARACTER(LEN=6)   ::  author_char = 'author'                  !< name of attribute
-       CHARACTER(LEN=200) ::  campaign = 'PALM-4U'                    !< name of campaign
-       CHARACTER(LEN=8)   ::  campaign_char = 'campaign'              !< name of attribute
-       CHARACTER(LEN=200) ::  comment = ' '                           !< comment to data
-       CHARACTER(LEN=7)   ::  comment_char = 'comment'                !< name of attribute
-       CHARACTER(LEN=200) ::  contact_person = ' '                    !< first name, last name, email adress
-       CHARACTER(LEN=14)  ::  contact_person_char = 'contact_person'  !< name of attribute
-       CHARACTER(LEN=200) ::  conventions = 'CF-1.7'                  !< netCDF convention
-       CHARACTER(LEN=11)  ::  conventions_char = 'Conventions'        !< name of attribute
-       CHARACTER(LEN=23 ) ::  creation_time = ' '                     !< creation time of data set
-       CHARACTER(LEN=13)  ::  creation_time_char = 'creation_time'    !< name of attribute
-       CHARACTER(LEN=200) ::  data_content = 'airmeteo'               !< content of data set
-       CHARACTER(LEN=12)  ::  data_content_char = 'data_content'      !< name of attribute
-       CHARACTER(LEN=200) ::  dependencies = ' '                      !< dependencies of data set
-       CHARACTER(LEN=12)  ::  dependencies_char = 'dependencies'      !< name of attribute
-       CHARACTER(LEN=200) ::  history = ' '                           !< information about data processing
-       CHARACTER(LEN=7)   ::  history_char = 'history'                !< name of attribute
-       CHARACTER(LEN=200) ::  institution = ' '                       !< name of responsible institution
-       CHARACTER(LEN=11)  ::  institution_char = 'institution'        !< name of attribute
-       CHARACTER(LEN=200) ::  keywords = ' '                          !< keywords of data set
-       CHARACTER(LEN=8)   ::  keywords_char = 'keywords'              !< name of attribute
-       CHARACTER(LEN=200) ::  licence = ' '                           !< licence of data set
-       CHARACTER(LEN=7)   ::  licence_char = 'licence'                !< name of attribute
-       CHARACTER(LEN=200) ::  location = ' '                          !< place which refers to data set
-       CHARACTER(LEN=8)   ::  location_char = 'location'              !< name of attribute
-       CHARACTER(LEN=10)  ::  origin_lat_char = 'origin_lat'          !< name of attribute
-       CHARACTER(LEN=10)  ::  origin_lon_char = 'origin_lon'          !< name of attribute
-       CHARACTER(LEN=23 ) ::  origin_time = '2000-01-01 00:00:00 +00' !< reference time
-       CHARACTER(LEN=11)  ::  origin_time_char = 'origin_time'        !< name of attribute
-       CHARACTER(LEN=8)   ::  origin_x_char = 'origin_x'              !< name of attribute
-       CHARACTER(LEN=8)   ::  origin_y_char = 'origin_y'              !< name of attribute
-       CHARACTER(LEN=8)   ::  origin_z_char = 'origin_z'              !< name of attribute
-       CHARACTER(LEN=12)  ::  palm_version_char = 'palm_version'      !< name of attribute
-       CHARACTER(LEN=200) ::  references = ' '                        !< literature referring to data set
-       CHARACTER(LEN=10)  ::  references_char = 'references'          !< name of attribute
-       CHARACTER(LEN=14)  ::  rotation_angle_char = 'rotation_angle'  !< name of attribute
-       CHARACTER(LEN=200) ::  site = ' '                              !< name of model domain
-       CHARACTER(LEN=4)   ::  site_char = 'site'                      !< name of attribute
-       CHARACTER(LEN=200) ::  source = ' '                            !< source of data set
-       CHARACTER(LEN=6)   ::  source_char = 'source'                  !< name of attribute
-       CHARACTER(LEN=200) ::  title = ' '                             !< title of data set
-       CHARACTER(LEN=5)   ::  title_char = 'title'                    !< name of attribute
-       CHARACTER(LEN=7)   ::  version_char = 'version'                !< name of attribute
-
-       INTEGER(iwp) ::  version              !< version of data set
-
-       REAL(wp) ::  fillvalue = -9999.0      !< default fill value
-       REAL(wp) ::  origin_lat               !< latitude of lower left corner
-       REAL(wp) ::  origin_lon               !< longitude of lower left corner
-       REAL(wp) ::  origin_x                 !< easting (UTM coordinate) of lower left corner
-       REAL(wp) ::  origin_y                 !< northing (UTM coordinate) of lower left corner
-       REAL(wp) ::  origin_z                 !< reference height
-       REAL(wp) ::  palm_version             !< PALM version of data set
-       REAL(wp) ::  rotation_angle           !< rotation angle of coordinate system of data set
-    END TYPE global_atts_type
-!
-!-- Define type for coordinate reference system (crs)
-    TYPE crs_type
-       CHARACTER(LEN=200) ::  epsg_code = 'EPSG:25831'                   !< EPSG code
-       CHARACTER(LEN=200) ::  grid_mapping_name = 'transverse_mercator'  !< name of grid mapping
-       CHARACTER(LEN=200) ::  long_name = 'coordinate reference system'  !< name of variable crs
-       CHARACTER(LEN=200) ::  units = 'm'                                !< unit of crs
-
-       REAL(wp) ::  false_easting = 500000.0_wp                   !< false easting
-       REAL(wp) ::  false_northing = 0.0_wp                       !< false northing
-       REAL(wp) ::  inverse_flattening = 298.257223563_wp         !< 1/f (default for WGS84)
-       REAL(wp) ::  latitude_of_projection_origin = 0.0_wp        !< latitude of projection origin
-       REAL(wp) ::  longitude_of_central_meridian = 3.0_wp        !< longitude of central meridian of UTM zone (default: zone 31)
-       REAL(wp) ::  longitude_of_prime_meridian = 0.0_wp          !< longitude of prime meridian
-       REAL(wp) ::  scale_factor_at_central_meridian = 0.9996_wp  !< scale factor of UTM coordinates
-       REAL(wp) ::  semi_major_axis = 6378137.0_wp                !< length of semi major axis (default for WGS84)
-    END TYPE crs_type
-
-!
-!-- Define variables
-    TYPE(crs_type)  ::  coord_ref_sys  !< coordinate reference system
-
-    TYPE(dims_xy)   ::  dim_static     !< data structure for x, y-dimension in static input file
-
-    TYPE(init_type) ::  init_3d     !< data structure for the initialization of the 3D flow and soil fields
-    TYPE(init_type) ::  init_model  !< data structure for the initialization of the model
-
-!
-!-- Define 2D variables of type NC_BYTE
-    TYPE(int_2d_8bit)  ::  albedo_type_f     !< input variable for albedo type
-    TYPE(int_2d_8bit)  ::  building_type_f   !< input variable for building type
-    TYPE(int_2d_8bit)  ::  pavement_type_f   !< input variable for pavenment type
-    TYPE(int_2d_8bit)  ::  street_crossing_f !< input variable for water type
-    TYPE(int_2d_8bit)  ::  street_type_f     !< input variable for water type
-    TYPE(int_2d_8bit)  ::  vegetation_type_f !< input variable for vegetation type
-    TYPE(int_2d_8bit)  ::  water_type_f      !< input variable for water type
-!
-!-- Define 3D variables of type NC_BYTE
-    TYPE(int_3d_8bit)  ::  building_obstruction_f    !< input variable for building obstruction
-    ! TYPE(int_3d_8bit)  ::  building_obstruction_full !< input variable for building obstruction
-!
-!-- Define 2D variables of type NC_INT
-    TYPE(int_2d_32bit) ::  building_id_f     !< input variable for building ID
-!
-!-- Define 2D variables of type NC_FLOAT
-    TYPE(real_2d) ::  terrain_height_f       !< input variable for terrain height
-    TYPE(real_2d) ::  uvem_irradiance_f      !< input variable for uvem irradiance lookup table
-    TYPE(real_2d) ::  uvem_integration_f     !< input variable for uvem integration
-!
-!-- Define 3D variables of type NC_FLOAT
-    TYPE(real_3d) ::  root_area_density_lsm_f !< input variable for root area density - parametrized vegetation
-    TYPE(real_3d) ::  uvem_radiance_f         !< input variable for uvem radiance lookup table
-    TYPE(real_3d) ::  uvem_projarea_f         !< input variable for uvem projection area lookup table
-!
-!-- Define input variable for buildings
-    TYPE(build_in) ::  buildings_f           !< input variable for buildings
-!
-!-- Define input variables for soil_type
-    TYPE(soil_in)  ::  soil_type_f           !< input variable for soil type
-
-    TYPE(fracs) ::  surface_fraction_f       !< input variable for surface fraction
-
-    TYPE(pars)  ::  albedo_pars_f              !< input variable for albedo parameters
-    TYPE(pars)  ::  building_pars_f            !< input variable for building parameters
-    TYPE(pars)  ::  pavement_pars_f            !< input variable for pavement parameters
-    TYPE(pars)  ::  pavement_subsurface_pars_f !< input variable for pavement parameters
-    TYPE(pars)  ::  soil_pars_f                !< input variable for soil parameters
-    TYPE(pars)  ::  vegetation_pars_f          !< input variable for vegetation parameters
-    TYPE(pars)  ::  water_pars_f               !< input variable for water parameters
-
-    TYPE(pars_surf)  ::  building_surface_pars_f  !< input variable for building surface parameters
-
-    TYPE(chem_emis_att_type)                             ::  chem_emis_att    !< Input Information of Chemistry Emission Data from
-                                                                              !< netcdf
-    TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:)  ::  chem_emis        !< Input Chemistry Emission Data from netcdf
-
-    CHARACTER(LEN=3)  ::  char_lod  = 'lod'         !< name of level-of-detail attribute in NetCDF file
-
-    CHARACTER(LEN=10) ::  char_fill = '_FillValue'        !< name of fill value attribute in NetCDF file
-
-    CHARACTER(LEN=100) ::  input_file_static  = 'PIDS_STATIC'  !< Name of file which comprises static input data
-    CHARACTER(LEN=100) ::  input_file_dynamic = 'PIDS_DYNAMIC' !< Name of file which comprises dynamic input data
-    CHARACTER(LEN=100) ::  input_file_chem    = 'PIDS_CHEM'    !< Name of file which comprises chemistry input data
-    CHARACTER(LEN=100) ::  input_file_uvem    = 'PIDS_UVEM'    !< Name of file which comprises static uv_exposure model input data
-    CHARACTER(LEN=100) ::  input_file_vm      = 'PIDS_VM'      !< Name of file which comprises virtual measurement data
-    CHARACTER(LEN=100) ::  input_file_wtm     = 'PIDS_WTM'     !< Name of file which comprises wind turbine model input data
-
-    CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::  string_values  !< output of string variables read from netcdf input files
-    CHARACTER(LEN=50), DIMENSION(:), ALLOCATABLE ::  vars_pids      !< variable in input file
-
-    INTEGER(iwp)                                     ::  id_emis        !< NetCDF id of input file for chemistry emissions: TBD: It
-                                                                        !< has to be removed
-
-    INTEGER(iwp) ::  nc_stat         !< return value of nf90 function call
-    INTEGER(iwp) ::  num_var_pids    !< number of variables in file
-    INTEGER(iwp) ::  pids_id         !< file id
-
-    LOGICAL ::  input_pids_static  = .FALSE.   !< Flag indicating whether Palm-input-data-standard file containing static
-                                               !< information exists
-    LOGICAL ::  input_pids_dynamic = .FALSE.   !< Flag indicating whether Palm-input-data-standard file containing dynamic
-                                               !< information exists
-    LOGICAL ::  input_pids_chem    = .FALSE.   !< Flag indicating whether Palm-input-data-standard file containing chemistry
-                                               !< information exists
-    LOGICAL ::  input_pids_uvem    = .FALSE.   !< Flag indicating whether uv-expoure-model input file containing static information
-                                               !< exists
-    LOGICAL ::  input_pids_vm      = .FALSE.   !< Flag indicating whether input file for virtual measurements exist
-    LOGICAL ::  input_pids_wtm     = .FALSE.   !< Flag indicating whether input file for wind turbine model exists
-
-    LOGICAL ::  collective_read = .FALSE.      !< Enable NetCDF collective read
-
-    REAL(wp), DIMENSION(8) ::  crs_list        !< list of coord_ref_sys values
-
-    TYPE(global_atts_type) ::  input_file_atts !< global attributes of input file
-
-    SAVE
-
-    PRIVATE
-
-    INTERFACE netcdf_data_input_check_dynamic
-       MODULE PROCEDURE netcdf_data_input_check_dynamic
-    END INTERFACE netcdf_data_input_check_dynamic
-
-    INTERFACE netcdf_data_input_check_static
-       MODULE PROCEDURE netcdf_data_input_check_static
-    END INTERFACE netcdf_data_input_check_static
-
-    INTERFACE netcdf_data_input_chemistry_data
-       MODULE PROCEDURE netcdf_data_input_chemistry_data
-    END INTERFACE netcdf_data_input_chemistry_data
-
-    INTERFACE get_dimension_length
-       MODULE PROCEDURE get_dimension_length
-    END INTERFACE get_dimension_length
-
-    INTERFACE inquire_fill_value
-       MODULE PROCEDURE inquire_fill_value_int
-       MODULE PROCEDURE inquire_fill_value_real
-    END INTERFACE inquire_fill_value
-
-    INTERFACE netcdf_data_input_inquire_file
-       MODULE PROCEDURE netcdf_data_input_inquire_file
-    END INTERFACE netcdf_data_input_inquire_file
-
-    INTERFACE netcdf_data_input_init
-       MODULE PROCEDURE netcdf_data_input_init
-    END INTERFACE netcdf_data_input_init
-
-    INTERFACE netcdf_data_input_init_3d
-       MODULE PROCEDURE netcdf_data_input_init_3d
-    END INTERFACE netcdf_data_input_init_3d
-
-    INTERFACE netcdf_data_input_surface_data
-       MODULE PROCEDURE netcdf_data_input_surface_data
-    END INTERFACE netcdf_data_input_surface_data
-
-    INTERFACE netcdf_data_input_uvem
-       MODULE PROCEDURE netcdf_data_input_uvem
-    END INTERFACE netcdf_data_input_uvem
-
-    INTERFACE get_variable
-       MODULE PROCEDURE get_variable_1d_char
-       MODULE PROCEDURE get_variable_1d_int
-       MODULE PROCEDURE get_variable_1d_real
-       MODULE PROCEDURE get_variable_2d_int8
-       MODULE PROCEDURE get_variable_2d_int32
-       MODULE PROCEDURE get_variable_2d_real
-       MODULE PROCEDURE get_variable_2d_real_dynamic
-       MODULE PROCEDURE get_variable_3d_int8
-       MODULE PROCEDURE get_variable_3d_real
-       MODULE PROCEDURE get_variable_3d_real_dynamic
-       MODULE PROCEDURE get_variable_4d_to_3d_real
-       MODULE PROCEDURE get_variable_4d_real
-       MODULE PROCEDURE get_variable_5d_to_4d_real
-       MODULE PROCEDURE get_variable_5d_real           ! (ecc) temp subroutine 4 reading 5D NC arrays
-       MODULE PROCEDURE get_variable_5d_real_dynamic   ! 2B removed as z is out of emission_values
-       MODULE PROCEDURE get_variable_string
-       MODULE PROCEDURE get_variable_string_generic    ! (ecc) generic string function
-
-    END INTERFACE get_variable
-
-    INTERFACE get_variable_pr
-       MODULE PROCEDURE get_variable_pr
-    END INTERFACE get_variable_pr
-
-    INTERFACE get_attribute
-       MODULE PROCEDURE get_attribute_real
-       MODULE PROCEDURE get_attribute_int8
-       MODULE PROCEDURE get_attribute_int32
-       MODULE PROCEDURE get_attribute_string
-    END INTERFACE get_attribute
-
-    INTERFACE add_ghost_layers
-       MODULE PROCEDURE add_ghost_layers_2d_int8
-       MODULE PROCEDURE add_ghost_layers_2d_int32
-       MODULE PROCEDURE add_ghost_layers_2d_real
-       MODULE PROCEDURE add_ghost_layers_3d_int8
-       MODULE PROCEDURE add_ghost_layers_3d_real
-       MODULE PROCEDURE add_ghost_layers_4d_real
-    END INTERFACE add_ghost_layers
-
-!
-!-- Public data structures
-    PUBLIC real_1d_3d,                                                                             &
-           real_2d,                                                                                &
-           real_3d
-!
-!-- Public variables
-    PUBLIC albedo_pars_f,                                                                          &
-           albedo_type_f,                                                                          &
-           buildings_f,                                                                            &
-           building_id_f,                                                                          &
-           building_pars_f,                                                                        &
-           building_surface_pars_f,                                                                &
-           building_type_f,                                                                        &
-           char_fill,                                                                              &
-           char_lod,                                                                               &
-           chem_emis,                                                                              &
-           chem_emis_att,                                                                          &
-           chem_emis_att_type,                                                                     &
-           chem_emis_val_type,                                                                     &
-           coord_ref_sys,                                                                          &
-           crs_list,                                                                               &
-           init_3d,                                                                                &
-           init_model,                                                                             &
-           input_file_atts,                                                                        &
-           input_file_dynamic,                                                                     &
-           input_file_static,                                                                      &
-           input_file_vm,                                                                          &
-           input_file_wtm,                                                                         &
-           input_pids_static,                                                                      &
-           input_pids_dynamic,                                                                     &
-           input_pids_vm,                                                                          &
-           input_pids_wtm,                                                                         &
-           num_var_pids,                                                                           &
-           pavement_pars_f,                                                                        &
-           pavement_subsurface_pars_f,                                                             &
-           pavement_type_f,                                                                        &
-           pids_id,                                                                                &
-           root_area_density_lsm_f,                                                                &
-           soil_pars_f,                                                                            &
-           soil_type_f,                                                                            &
-           street_crossing_f,                                                                      &
-           street_type_f,                                                                          &
-           surface_fraction_f,                                                                     &
-           terrain_height_f,                                                                       &
-           vars_pids,                                                                              &
-           vegetation_pars_f,                                                                      &
-           vegetation_type_f,                                                                      &
-           water_pars_f,                                                                           &
-           water_type_f
-!
-!-- Public uv exposure variables
-    PUBLIC building_obstruction_f,                                                                 &
-           input_file_uvem,                                                                        &
-           input_pids_uvem,                                                                        &
-           netcdf_data_input_uvem,                                                                 &
-           uvem_integration_f,                                                                     &
-           uvem_irradiance_f,                                                                      &
-           uvem_projarea_f,                                                                        &
-           uvem_radiance_f
-
-!
-!-- Public subroutines
-    PUBLIC add_ghost_layers,                                                                       &
-           check_existence,                                                                        &
-           close_input_file,                                                                       &
-           get_attribute,                                                                          &
-           get_dimension_length,                                                                   &
-           get_variable,                                                                           &
-           get_variable_pr,                                                                        &
-           inquire_fill_value,                                                                     &
-           inquire_num_variables,                                                                  &
-           inquire_variable_names,                                                                 &
-           netcdf_data_input_check_dynamic,                                                        &
-           netcdf_data_input_check_static,                                                         &
-           netcdf_data_input_chemistry_data,                                                       &
-           netcdf_data_input_inquire_file,                                                         &
-           netcdf_data_input_init,                                                                 &
-           netcdf_data_input_init_3d,                                                              &
-           netcdf_data_input_surface_data,                                                         &
-           netcdf_data_input_topo,                                                                 &
-           open_read_file
-
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Inquires whether NetCDF input files according to Palm-input-data standard exist. Moreover, basic
-!> checks are performed.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_data_input_inquire_file
-
-    USE control_parameters,                                                                        &
-        ONLY:  topo_no_distinct
-
-    IMPLICIT NONE
-
-#if defined ( __netcdf )
-    INQUIRE( FILE = TRIM( input_file_static )   // TRIM( coupling_char ),                          &
-             EXIST = input_pids_static  )
-    INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ),                           &
-             EXIST = input_pids_dynamic )
-    INQUIRE( FILE = TRIM( input_file_chem )    // TRIM( coupling_char ),                           &
-             EXIST = input_pids_chem )
-    INQUIRE( FILE = TRIM( input_file_uvem )    // TRIM( coupling_char ),                           &
-             EXIST = input_pids_uvem )
-    INQUIRE( FILE = TRIM( input_file_vm )      // TRIM( coupling_char ),                           &
-             EXIST = input_pids_vm )
-    INQUIRE( FILE = TRIM( input_file_wtm )     // TRIM( coupling_char ),                           &
-             EXIST = input_pids_wtm )
-#endif
-
-!
-!-- As long as topography can be input via ASCII format, no distinction between building and terrain
-!-- can be done. This case, classify all surfaces as default type. Same in case land-surface and
-!-- urban-surface model are not applied.
-    IF ( .NOT. input_pids_static )  THEN
-       topo_no_distinct = .TRUE.
-    ENDIF
-
- END SUBROUTINE netcdf_data_input_inquire_file
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads global attributes and coordinate reference system required for initialization of the model.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_data_input_init
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  id_mod     !< NetCDF id of input file
-    INTEGER(iwp) ::  var_id_crs !< NetCDF id of variable crs
-
-!
-!-- Define default list of crs attributes. This is required for coordinate transformation.
-    crs_list = (/ coord_ref_sys%semi_major_axis,                                                   &
-                  coord_ref_sys%inverse_flattening,                                                &
-                  coord_ref_sys%longitude_of_prime_meridian,                                       &
-                  coord_ref_sys%longitude_of_central_meridian,                                     &
-                  coord_ref_sys%scale_factor_at_central_meridian,                                  &
-                  coord_ref_sys%latitude_of_projection_origin,                                     &
-                  coord_ref_sys%false_easting,                                                     &
-                  coord_ref_sys%false_northing /)
-
-    IF ( .NOT. input_pids_static )  RETURN
-
-#if defined ( __netcdf )
-!
-!-- Open file in read-only mode
-    CALL open_read_file( TRIM( input_file_static ) // TRIM( coupling_char ), id_mod )
-!
-!-- Read global attributes
-    CALL get_attribute( id_mod, input_file_atts%origin_lat_char,                                   &
-                        input_file_atts%origin_lat, .TRUE. )
-
-    CALL get_attribute( id_mod, input_file_atts%origin_lon_char,                                   &
-                        input_file_atts%origin_lon, .TRUE. )
-
-    CALL get_attribute( id_mod, input_file_atts%origin_time_char,                                  &
-                        input_file_atts%origin_time, .TRUE. )
-
-    CALL get_attribute( id_mod, input_file_atts%origin_x_char,                                     &
-                        input_file_atts%origin_x, .TRUE. )
-
-    CALL get_attribute( id_mod, input_file_atts%origin_y_char,                                     &
-                        input_file_atts%origin_y, .TRUE. )
-
-    CALL get_attribute( id_mod, input_file_atts%origin_z_char,                                     &
-                        input_file_atts%origin_z, .TRUE. )
-
-    CALL get_attribute( id_mod, input_file_atts%rotation_angle_char,                               &
-                        input_file_atts%rotation_angle, .TRUE. )
-
-    CALL get_attribute( id_mod, input_file_atts%author_char,                                       &
-                        input_file_atts%author, .TRUE., no_abort=.FALSE. )
-
-    CALL get_attribute( id_mod, input_file_atts%contact_person_char,                               &
-                        input_file_atts%contact_person, .TRUE., no_abort=.FALSE. )
-    CALL get_attribute( id_mod, input_file_atts%institution_char,                                  &
-                        input_file_atts%institution,    .TRUE., no_abort=.FALSE. )
-    CALL get_attribute( id_mod, input_file_atts%acronym_char,                                      &
-                        input_file_atts%acronym,        .TRUE., no_abort=.FALSE. )
-
-    CALL get_attribute( id_mod, input_file_atts%campaign_char,                                     &
-                        input_file_atts%campaign, .TRUE., no_abort=.FALSE. )
-    CALL get_attribute( id_mod, input_file_atts%location_char,                                     &
-                        input_file_atts%location, .TRUE., no_abort=.FALSE. )
-    CALL get_attribute( id_mod, input_file_atts%site_char,                                         &
-                        input_file_atts%site,     .TRUE., no_abort=.FALSE. )
-
-    CALL get_attribute( id_mod, input_file_atts%source_char,                                       &
-                        input_file_atts%source,     .TRUE., no_abort=.FALSE. )
-    CALL get_attribute( id_mod, input_file_atts%references_char,                                   &
-                        input_file_atts%references, .TRUE., no_abort=.FALSE. )
-    CALL get_attribute( id_mod, input_file_atts%keywords_char,                                     &
-                        input_file_atts%keywords,   .TRUE., no_abort=.FALSE. )
-    CALL get_attribute( id_mod, input_file_atts%licence_char,                                      &
-                        input_file_atts%licence,    .TRUE., no_abort=.FALSE. )
-    CALL get_attribute( id_mod, input_file_atts%comment_char,                                      &
-                        input_file_atts%comment,    .TRUE., no_abort=.FALSE. )
-!
-!-- Read coordinate reference system if available
-    nc_stat = NF90_INQ_VARID( id_mod, 'crs', var_id_crs )
-    IF ( nc_stat == NF90_NOERR )  THEN
-       CALL get_attribute( id_mod, 'epsg_code', coord_ref_sys%epsg_code, .FALSE., 'crs' )
-       CALL get_attribute( id_mod, 'false_easting', coord_ref_sys%false_easting, .FALSE., 'crs' )
-       CALL get_attribute( id_mod, 'false_northing', coord_ref_sys%false_northing, .FALSE., 'crs' )
-       CALL get_attribute( id_mod, 'grid_mapping_name', coord_ref_sys%grid_mapping_name, .FALSE.,  &
-                           'crs' )
-       CALL get_attribute( id_mod, 'inverse_flattening', coord_ref_sys%inverse_flattening, .FALSE.,&
-                           'crs' )
-       CALL get_attribute( id_mod, 'latitude_of_projection_origin',                                &
-                           coord_ref_sys%latitude_of_projection_origin, .FALSE., 'crs' )
-       CALL get_attribute( id_mod, 'long_name', coord_ref_sys%long_name, .FALSE., 'crs' )
-       CALL get_attribute( id_mod, 'longitude_of_central_meridian',                                &
-                           coord_ref_sys%longitude_of_central_meridian, .FALSE., 'crs' )
-       CALL get_attribute( id_mod, 'longitude_of_prime_meridian',                                  &
-                           coord_ref_sys%longitude_of_prime_meridian, .FALSE., 'crs' )
-       CALL get_attribute( id_mod, 'scale_factor_at_central_meridian',                             &
-                           coord_ref_sys%scale_factor_at_central_meridian, .FALSE., 'crs' )
-       CALL get_attribute( id_mod, 'semi_major_axis', coord_ref_sys%semi_major_axis, .FALSE., 'crs')
-       CALL get_attribute( id_mod, 'units', coord_ref_sys%units, .FALSE., 'crs' )
-    ELSE
-!
-!--    Calculate central meridian from origin_lon
-       coord_ref_sys%longitude_of_central_meridian =                                               &
-                                   CEILING( input_file_atts%origin_lon / 6.0_wp ) * 6.0_wp - 3.0_wp
-    ENDIF
-!
-!-- Finally, close input file
-    CALL close_input_file( id_mod )
-#endif
-!
-!-- Copy latitude, longitude, origin_z, rotation angle on init type.
-!-- Note: A shifting height might have already been saved to orgin_z in init_grid; therefore, do not
-!--       override but add the reference height from the input file.
-    init_model%latitude       = input_file_atts%origin_lat
-    init_model%longitude      = input_file_atts%origin_lon
-    init_model%origin_time    = input_file_atts%origin_time
-    init_model%origin_x       = input_file_atts%origin_x
-    init_model%origin_y       = input_file_atts%origin_y
-    init_model%origin_z       = init_model%origin_z + input_file_atts%origin_z
-    init_model%rotation_angle = input_file_atts%rotation_angle
-
-!
-!-- Update list of crs attributes. This is required for coordinate transformation.
-    crs_list = (/ coord_ref_sys%semi_major_axis,                                                   &
-                  coord_ref_sys%inverse_flattening,                                                &
-                  coord_ref_sys%longitude_of_prime_meridian,                                       &
-                  coord_ref_sys%longitude_of_central_meridian,                                     &
-                  coord_ref_sys%scale_factor_at_central_meridian,                                  &
-                  coord_ref_sys%latitude_of_projection_origin,                                     &
-                  coord_ref_sys%false_easting,                                                     &
-                  coord_ref_sys%false_northing /)
-!
-!-- In case of nested runs, each model domain might have different longitude and latitude, which
-!-- would result in different Coriolis parameters and sun-zenith angles. To avoid this, longitude
-!-- and latitude in each model domain will be set to the values of the root model. Please note, this
-!-- synchronization is required already here.
-#if defined( __parallel )
-    CALL MPI_BCAST( init_model%latitude,  1, MPI_REAL, 0, MPI_COMM_WORLD, ierr )
-    CALL MPI_BCAST( init_model%longitude, 1, MPI_REAL, 0, MPI_COMM_WORLD, ierr )
-#endif
-
- END SUBROUTINE netcdf_data_input_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads Chemistry NETCDF Input data, such as emission values, emission species, etc.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_data_input_chemistry_data( emt_att, emt )
-
-    USE chem_modules,                                                                              &
-        ONLY:  emiss_lod, surface_csflux_name, time_fac_type
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nys, nyn
-
-    IMPLICIT NONE
-
-    TYPE(chem_emis_att_type), INTENT(INOUT)                            ::  emt_att
-    TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:), INTENT(INOUT) ::  emt
-
-    INTEGER(iwp) ::  i, j, k      !< generic counters
-    INTEGER(iwp) ::  ispec        !< index for number of emission species in input
-    INTEGER(iwp) ::  len_dims     !< Length of dimension
-    INTEGER(iwp) ::  num_vars     !< number of variables in netcdf input file
-
-!
-!-- dum_var_4d are designed to read in emission_values from the chemistry netCDF file.
-!-- Currently the vestigial "z" dimension in emission_values makes it a 5D array, hence the
-!-- corresponding dum_var_5d array. When the "z" dimension is removed completely, dum_var_4d will be
-!-- used instead (ecc 20190425)
-
-!    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)    ::  dum_var_4d  !< temp array 4 4D chem emission data
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:,:) ::  dum_var_5d  !< temp array 4 5D chem emission data
-
-!
-!-- Start processing data
-!
-!-- Emission LOD 0 (Parameterized mode)
-    IF ( emiss_lod == 0 )  THEN
-
-!
-!--    For reference (ecc)
-!       IF (TRIM(mode_emis) == "PARAMETERIZED" .OR. TRIM(mode_emis) == "parameterized") THEN
-
-       ispec=1
-       emt_att%n_emiss_species = 0
-
-!
-!--    Number of species
-       DO  WHILE ( TRIM( surface_csflux_name( ispec ) ) /= 'novalue' )
-
-          emt_att%n_emiss_species = emt_att%n_emiss_species + 1
-          ispec = ispec + 1
-!
-!--       Followling line retained for compatibility with salsa_mod which still uses emt_att%nspec
-!--       heavily (ecc)
-          emt_att%nspec = emt_att%nspec + 1
-
-       ENDDO
-
-!
-!--    Allocate emission values data type arrays
-       ALLOCATE( emt(emt_att%n_emiss_species) )
-
-!
-!--    Read emission species names
-
-!
-!--    Allocate space for strings
-       ALLOCATE( emt_att%species_name(emt_att%n_emiss_species) )
-
-       DO  ispec = 1, emt_att%n_emiss_species
-          emt_att%species_name(ispec) = TRIM( surface_csflux_name(ispec) )
-       ENDDO
-
-!
-!-- LOD 1 (default mode) and LOD 2 (pre-processed mode)
-    ELSE
-
-#if defined ( __netcdf )
-
-       IF ( .NOT. input_pids_chem )  RETURN
-
-!
-!--    First we allocate memory space for the emission species and then we differentiate between
-!--    LOD 1 (default mode) and LOD 2 (pre-processed mode)
-
-!
-!--    Open emission data file ( {palmcase}_chemistry )
-       CALL open_read_file( TRIM( input_file_chem ) // TRIM( coupling_char ), id_emis )
-
-!
-!--    Inquire number of variables
-       CALL inquire_num_variables( id_emis, num_vars )
-
-!
-!--    Get general dimension lengths: only # species and # categories.
-!--    Other dimensions depend on the emission mode or specific components.
-       CALL get_dimension_length( id_emis, emt_att%n_emiss_species, 'nspecies' )
-
-!
-!--    Backward compatibility for salsa_mod (ecc)
-       emt_att%nspec = emt_att%n_emiss_species
-
-!
-!--    Allocate emission values data type arrays
-       ALLOCATE( emt(emt_att%n_emiss_species) )
-
-!
-!--    Reading in species names
-
-!
-!--    Allocate memory for species names
-       ALLOCATE( emt_att%species_name(emt_att%n_emiss_species) )
-
-!
-!--    Retrieve variable name (again, should use n_emiss_strlen)
-       CALL get_variable( id_emis, 'emission_name', string_values, emt_att%n_emiss_species )
-       emt_att%species_name=string_values
-
-!
-!--    Dealocate string_values previously allocated in get_variable call
-       IF ( ALLOCATED( string_values ) )  DEALLOCATE( string_values )
-
-!
-!--    Reading in species indices
-
-!
-!--    Allocate memory for species indices
-       ALLOCATE( emt_att%species_index(emt_att%n_emiss_species) )
-
-!
-!--    Retrieve variable data
-       CALL get_variable( id_emis, 'emission_index', emt_att%species_index )
-!
-!--    Now the routine has to distinguish between chemistry emission LOD 1 (default mode) and LOD 2
-!--    (pre-processed mode)
-
-!
-!--    Start of emission LOD 1 (default mode)
-       IF ( emiss_lod == 1 )  THEN
-!
-!--       For reference (ecc)
-!          IF (TRIM(mode_emis) == "DEFAULT" .OR. TRIM(mode_emis) == "default") THEN
-
-!
-!--       Get number of emission categories
-          CALL get_dimension_length( id_emis, emt_att%ncat, 'ncat' )
-
-!--       Reading in emission categories indices
-          ALLOCATE( emt_att%cat_index(emt_att%ncat) )
-
-!
-!--       Retrieve variable data
-          CALL get_variable( id_emis, 'emission_cat_index', emt_att%cat_index )
-
-
-!
-!-- Loop through individual species to get basic information on VOC/PM/NOX/SOX
-
-!---------------------------------------------------------------------------------------------------
-!-- Note - Check array indices for reading in names and species in LOD1 (default mode) for the
-!--        various mode splits as all id_emis conditionals have been removed from get_var_functions.
-!--        In theory this would mean all arrays should be read from 0 to n-1 (C convention) as
-!--        opposed to 1 to n (FORTRAN convention). Keep this in mind !!
-!--        (ecc 20190424)
-!--------------------------------------------------------------------------------------------------
-
-          DO  ispec = 1, emt_att%n_emiss_species
-
-!
-!--          VOC data (name and composition)
-             IF ( TRIM( emt_att%species_name(ispec) ) == "VOC"  .OR.                               &
-                  TRIM( emt_att%species_name(ispec) ) == "voc" )  THEN
-
-!
-!--             VOC name
-                CALL get_dimension_length( id_emis, emt_att%nvoc, 'nvoc' )
-                ALLOCATE( emt_att%voc_name(emt_att%nvoc) )
-                CALL get_variable ( id_emis,"emission_voc_name", string_values, emt_att%nvoc )
-                emt_att%voc_name = string_values
-                IF ( ALLOCATED( string_values ) )  DEALLOCATE( string_values )
-
-!
-!--             VOC composition
-                ALLOCATE( emt_att%voc_comp(emt_att%ncat,emt_att%nvoc) )
-                CALL get_variable( id_emis, "composition_voc", emt_att%voc_comp, 1, emt_att%ncat,  &
-                                    1, emt_att%nvoc )
-
-             ENDIF  ! VOC
-
-!
-!--          PM data (name and composition)
-             IF ( TRIM( emt_att%species_name(ispec) ) == "PM"  .OR.                                &
-                  TRIM( emt_att%species_name(ispec) ) == "pm")  THEN
-
-!
-!--             PM name
-                CALL get_dimension_length( id_emis, emt_att%npm, 'npm' )
-                ALLOCATE( emt_att%pm_name(emt_att%npm) )
-                CALL get_variable ( id_emis, "pm_name", string_values, emt_att%npm )
-                emt_att%pm_name = string_values
-                IF ( ALLOCATED( string_values ) )  DEALLOCATE( string_values )
-
-!
-!--             PM composition (PM1, PM2.5 and PM10)
-                len_dims = 3  ! PM1, PM2.5, PM10
-                ALLOCATE( emt_att%pm_comp(emt_att%ncat,emt_att%npm,len_dims) )
-                CALL get_variable( id_emis, "composition_pm", emt_att%pm_comp, 1, emt_att%ncat, 1, &
-                                   emt_att%npm, 1, len_dims )
-
-             ENDIF  ! PM
-
-!
-!--          NOX (NO and NO2)
-             IF ( TRIM( emt_att%species_name(ispec) ) == "NOX"  .OR.                               &
-                  TRIM( emt_att%species_name(ispec) ) == "nox" )  THEN
-
-                ALLOCATE( emt_att%nox_comp(emt_att%ncat,emt_att%nnox) )
-                CALL get_variable( id_emis, "composition_nox", emt_att%nox_comp, 1, emt_att%ncat,  &
-                                   1, emt_att%nnox )
-
-             ENDIF  ! NOX
-
-!
-!--          SOX (SO2 and SO4)
-             IF ( TRIM( emt_att%species_name(ispec) ) == "SOX"  .OR.                               &
-                  TRIM( emt_att%species_name(ispec) ) == "sox" )  THEN
-
-                ALLOCATE( emt_att%sox_comp(emt_att%ncat,emt_att%nsox) )
-                CALL get_variable( id_emis, "composition_sox", emt_att%sox_comp, 1, emt_att%ncat,  &
-                                   1, emt_att%nsox )
-
-             ENDIF  ! SOX
-
-          ENDDO  ! do ispec
-
-!
-!--       Emission time scaling factors (hourly and MDH data)
-
-!
-!--       Hour
-          IF ( TRIM( time_fac_type ) == "HOUR"  .OR.  TRIM( time_fac_type ) == "hour" )  THEN
-
-             CALL get_dimension_length( id_emis, emt_att%nhoursyear, 'nhoursyear' )
-             ALLOCATE( emt_att%hourly_emis_time_factor(emt_att%ncat,emt_att%nhoursyear) )
-             CALL get_variable( id_emis, "emission_time_factors", emt_att%hourly_emis_time_factor, &
-                                1, emt_att%ncat, 1, emt_att%nhoursyear )
-
-!
-!--       MDH
-          ELSEIF ( TRIM( time_fac_type )  ==  "MDH"  .OR.  TRIM( time_fac_type )  ==  "mdh" )  THEN
-
-             CALL get_dimension_length( id_emis, emt_att%nmonthdayhour, 'nmonthdayhour' )
-             ALLOCATE( emt_att%mdh_emis_time_factor(emt_att%ncat,emt_att%nmonthdayhour) )
-             CALL get_variable( id_emis, "emission_time_factors", emt_att%mdh_emis_time_factor,    &
-                                1, emt_att%ncat, 1, emt_att%nmonthdayhour )
-
-!
-!--       Error (time factor undefined)
-          ELSE
-
-             message_string = 'We are in the DEFAULT chemistry emissions mode: '  //               &
-                              '     !no time-factor type specified!'              //               &
-                              'Please specify the value of time_fac_type:'        //               &
-                              '         either "MDH" or "HOUR"'
-             CALL message( 'netcdf_data_input_chemistry_data', 'CM0200', 2, 2, 0, 6, 0 )
-
-
-          ENDIF  ! time_fac_type
-
-!
-!--       Read in default (LOD1) emissions from chemisty netCDF file per species
-
-!
-!--       Note - At the moment the data is read in per species, but in the future it would be much
-!--              more sensible to read in per species per time step to reduce memory consumption
-!--              and, to a smaller degree, dimensionality of data exchange (I expect this will be
-!--              necessary when the problem size is large).
-          DO  ispec = 1, emt_att%n_emiss_species
-
-!
-!--          Allocate space for species specific emission values.
-!--          Note - This array is extended by 1 cell in each horizontal direction to compensate for
-!--                 an apparent linear offset. The reason of this offset is not known but it has
-!--                 been determined to take place beyond the scope of this module, and has little to
-!--                 do with index conventions.
-!--                 That is, setting the array horizontal limit from nx0:nx1 to 1:(nx1-nx0+1) or
-!--                 nx0+1:nx1+1 did not result in correct or definite behavior.
-!--                 This must be looked at at some point by the Hannover team but for now this
-!--                 workaround is deemed reasonable (ecc 20190417).
-             IF ( .NOT. ALLOCATED( emt(ispec)%default_emission_data ) )  THEN
-                ALLOCATE( emt(ispec)%default_emission_data(emt_att%ncat,nys:nyn+1,nxl:nxr+1) )
-             ENDIF
-!
-!--          Allocate dummy variable w/ index order identical to that shown in the netCDF header
-             ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1,emt_att%ncat) )
-!
-!--          Get variable.  Be very careful
-!--          I am using get_variable_5d_real_dynamic (note logical argument at the end)
-!--          1) use Fortran index convention (i.e., 1 to N)
-!--          2) index order must be in reverse order from above allocation order
-             CALL get_variable( id_emis, "emission_values", dum_var_5d, 1, ispec,                  &
-                                nxl+1,     nys+1,     1, emt_att%ncat, 1,                          &
-                                nxr-nxl+1, nyn-nys+1, emt_att%dt_emission, .FALSE. )
-!
-!--          Assign temp array to data structure then deallocate temp array
-!--          Note - Indices are shifted from nx0:nx1 to nx0+1:nx1+1 to offset the emission data
-!--                 array to counter said domain offset.
-!--                 (ecc 20190417)
-             DO  k = 1, emt_att%ncat
-                DO  j = nys+1, nyn+1
-                   DO  i = nxl+1, nxr+1
-                      emt(ispec)%default_emission_data(k,j,i) = dum_var_5d(1,j-1,i-1,1,k)
-                   ENDDO
-                ENDDO
-             ENDDO
-
-             DEALLOCATE( dum_var_5d )
-
-          ENDDO  ! ispec
-!
-!--       Units
-          CALL get_attribute( id_emis, "units", emt_att%units, .FALSE., "emission_values" )
-
-!
-!--       End default mode
-
-
-!
-!--    Start LOD 2 (pre-processed mode)
-       ELSEIF ( emiss_lod == 2 )  THEN
-
-!      For reference (ecc)
-!       ELSEIF( TRIM( mode_emis ) == "PRE-PROCESSED" .OR. TRIM( mode_emis ) == "pre-processed")  THEN
-
-!
-!--       For LOD 2 only VOC and emission data need to be read
-!--       Note - Check array indices for reading in names and species in LOD2 (pre-processed mode)
-!--       for the various mode splits as all id_emis conditionals have been removed from
-!--       get_var_functions. In theory this would mean all arrays should be read from 0 to n-1
-!--       (C convention) as opposed to 1 to n (FORTRAN convention). Keep this in mind!!
-!--       (ecc 20190424)
-          DO  ispec = 1, emt_att%n_emiss_species
-
-!
-!--          VOC data (name and composition)
-             IF ( TRIM( emt_att%species_name(ispec) ) == "VOC"  .OR.                               &
-                  TRIM( emt_att%species_name(ispec) ) == "voc" )  THEN
-
-!
-!--             VOC name
-                CALL get_dimension_length( id_emis, emt_att%nvoc, 'nvoc' )
-                ALLOCATE( emt_att%voc_name(emt_att%nvoc) )
-                CALL get_variable( id_emis, "emission_voc_name", string_values, emt_att%nvoc )
-                emt_att%voc_name = string_values
-                IF ( ALLOCATED( string_values ) )  DEALLOCATE( string_values )
-
-!
-!--             VOC composition
-                ALLOCATE( emt_att%voc_comp(emt_att%ncat,emt_att%nvoc) )
-                CALL get_variable( id_emis, "composition_voc", emt_att%voc_comp, 1, emt_att%ncat,  &
-                                   1, emt_att%nvoc )
-             ENDIF  ! VOC
-
-          ENDDO  ! ispec
-
-!
-!--       Emission data
-          CALL get_dimension_length( id_emis, emt_att%dt_emission, 'time' )
-
-!
-!--       Read in pre-processed (LOD2) emissions from chemisty netCDF file per species
-
-!
-!--       Note - At the moment the data is read in per species, but in the future it would be much
-!--              more sensible to read in per species per time step to reduce memory consumption
-!--              and, to a smaller degree, dimensionality of data exchange (I expect this will be
-!--              necessary when the problem size is large).
-          DO  ispec = 1, emt_att%n_emiss_species
-
-!
-!--          Allocate space for species specific emission values.
-!--          Note - This array is extended by 1 cell in each horizontal direction to compensate for
-!--                 an apparent linear offset. The reason of this offset is not known but it has
-!--                 been determined to take place beyond the scope of this module, and has little to
-!--                 do with index conventions.
-!--                 That is, setting the array horizontal limit from nx0:nx1 to 1:(nx1-nx0+1) or
-!--                 nx0+1:nx1+1 did not result in correct or definite behavior.
-!--                 This must be looked at at some point by the Hannover team but for now this
-!--                 workaround is deemed reasonable (ecc 20190417).
-
-             IF ( .NOT. ALLOCATED( emt(ispec)%preproc_emission_data ) )  THEN
-                ALLOCATE( emt(ispec)%preproc_emission_data(                                        &
-                             emt_att%dt_emission, 1, nys:nyn+1, nxl:nxr+1) )
-             ENDIF
-!
-!--          Allocate dummy variable w/ index order identical to that shown in the netCDF header
-             ALLOCATE( dum_var_5d(emt_att%dt_emission,1,nys:nyn,nxl:nxr,1) )
-!
-!--          Get variable.  Be very careful.
-!--          I am using get_variable_5d_real_dynamic (note logical argument at the end)
-!--          1) use Fortran index convention (i.e., 1 to N)
-!--          2) index order must be in reverse order from above allocation order
-             CALL get_variable( id_emis, "emission_values", dum_var_5d, ispec,                     &
-                                nxl+1,     nys+1,     1, 1, 1,                                     &
-                                nxr-nxl+1, nyn-nys+1, 1, emt_att%dt_emission, .FALSE. )
-!
-!--          Assign temp array to data structure then deallocate temp array.
-!--          Note - Indices are shifted from nx0:nx1 to nx0+1:nx1+1 to offset the emission data
-!--                 array to counter mentioned unkonwn offset.
-!--                 (ecc 20190417)
-
-             DO  k = 1, emt_att%dt_emission
-                DO  j = nys+1, nyn+1
-                   DO  i = nxl+1, nxr+1
-                      emt(ispec)%preproc_emission_data(k,1,j,i) = dum_var_5d(k,1,j-1,i-1,1)
-                   ENDDO
-                ENDDO
-             ENDDO
-
-             DEALLOCATE( dum_var_5d )
-
-          ENDDO  ! ispec
-!
-!--       Units
-          CALL get_attribute( id_emis, "units", emt_att%units, .FALSE. , "emission_values" )
-
-       ENDIF  ! LOD1 & LOD2 (default and pre-processed mode)
-
-       CALL close_input_file( id_emis )
-
-#endif
-
-    ENDIF ! LOD0 (parameterized mode)
-
- END SUBROUTINE netcdf_data_input_chemistry_data
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads surface classification data, such as vegetation and soil type, etc. .
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_data_input_surface_data
-
-    USE control_parameters,                                                                        &
-        ONLY:  land_surface, urban_surface
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_2d, exchange_horiz_2d_byte, exchange_horiz_2d_int
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nxl, nxr, nyn, nys
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< variable names in static input file
-
-    INTEGER(iwp) ::  id_surf   !< NetCDF id of input file
-    INTEGER(iwp) ::  k         !< running index along z-direction
-    INTEGER(iwp) ::  k2        !< running index
-    INTEGER(iwp) ::  num_vars  !< number of variables in input file
-    INTEGER(iwp) ::  nz_soil   !< number of soil layers in file
-
-!
-!-- If not static input file is available, skip this routine
-    IF ( .NOT. input_pids_static )  RETURN
-!
-!-- Measure CPU time
-    CALL cpu_log( log_point_s(82), 'NetCDF input', 'start' )
-!
-!-- Skip the following if no land-surface or urban-surface module are applied. This case, no one of
-!-- the following variables is used anyway.
-    IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  RETURN
-
-#if defined ( __netcdf )
-!
-!-- Open file in read-only mode
-    CALL open_read_file( TRIM( input_file_static ) // TRIM( coupling_char ) , id_surf )
-!
-!-- Inquire all variable names.
-!-- This will be used to check whether an optional input variable exists or not.
-    CALL inquire_num_variables( id_surf, num_vars )
-
-    ALLOCATE( var_names(1:num_vars) )
-    CALL inquire_variable_names( id_surf, var_names )
-!
-!-- Read vegetation type and required attributes
-    IF ( check_existence( var_names, 'vegetation_type' ) )  THEN
-       vegetation_type_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, vegetation_type_f%fill, .FALSE., 'vegetation_type' )
-
-       ALLOCATE( vegetation_type_f%var(nys:nyn,nxl:nxr) )
-
-       CALL get_variable( id_surf, 'vegetation_type', vegetation_type_f%var, nxl, nxr, nys, nyn )
-    ELSE
-       vegetation_type_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Read soil type and required attributes
-    IF ( check_existence( var_names, 'soil_type' ) )  THEN
-       soil_type_f%from_file = .TRUE.
-!
-!--    Note, lod is currently not on file; skip for the moment
-!       CALL get_attribute( id_surf, char_lod,                                                      &
-!                           soil_type_f%lod,                                                        &
-!                           .FALSE., 'soil_type' )
-       CALL get_attribute( id_surf, char_fill, soil_type_f%fill, .FALSE., 'soil_type' )
-
-       IF ( soil_type_f%lod == 1 )  THEN
-
-          ALLOCATE( soil_type_f%var_2d(nys:nyn,nxl:nxr)  )
-
-          CALL get_variable( id_surf, 'soil_type', soil_type_f%var_2d, nxl, nxr, nys, nyn )
-
-       ELSEIF ( soil_type_f%lod == 2 )  THEN
-!
-!--       Obtain number of soil layers from file.
-          CALL get_dimension_length( id_surf, nz_soil, 'zsoil' )
-
-          ALLOCATE( soil_type_f%var_3d(0:nz_soil,nys:nyn,nxl:nxr) )
-
-          CALL get_variable( id_surf, 'soil_type', soil_type_f%var_3d, nxl, nxr, nys, nyn, 0,      &
-                             nz_soil )
-
-       ENDIF
-    ELSE
-       soil_type_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Read pavement type and required attributes
-    IF ( check_existence( var_names, 'pavement_type' ) )  THEN
-       pavement_type_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, pavement_type_f%fill, .FALSE., 'pavement_type' )
-
-       ALLOCATE( pavement_type_f%var(nys:nyn,nxl:nxr)  )
-
-       CALL get_variable( id_surf, 'pavement_type', pavement_type_f%var, nxl, nxr, nys, nyn )
-    ELSE
-       pavement_type_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Read water type and required attributes
-    IF ( check_existence( var_names, 'water_type' ) )  THEN
-       water_type_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, water_type_f%fill, .FALSE., 'water_type' )
-
-       ALLOCATE( water_type_f%var(nys:nyn,nxl:nxr)  )
-
-       CALL get_variable( id_surf, 'water_type', water_type_f%var, nxl, nxr, nys, nyn )
-
-    ELSE
-       water_type_f%from_file = .FALSE.
-    ENDIF
-!
-!-- Read relative surface fractions of vegetation, pavement and water.
-    IF ( check_existence( var_names, 'surface_fraction' ) )  THEN
-       surface_fraction_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, surface_fraction_f%fill, .FALSE., 'surface_fraction')
-!
-!--    Inquire number of surface fractions
-       CALL get_dimension_length( id_surf, surface_fraction_f%nf, 'nsurface_fraction' )
-!
-!--    Allocate dimension array and input array for surface fractions
-       ALLOCATE( surface_fraction_f%nfracs(0:surface_fraction_f%nf-1) )
-       ALLOCATE( surface_fraction_f%frac(0:surface_fraction_f%nf-1,nys:nyn,nxl:nxr) )
-!
-!--    Get dimension of surface fractions
-       CALL get_variable( id_surf, 'nsurface_fraction', surface_fraction_f%nfracs )
-!
-!--    Read surface fractions
-       CALL get_variable( id_surf, 'surface_fraction', surface_fraction_f%frac,                    &
-                          nxl, nxr, nys, nyn, 0, surface_fraction_f%nf-1 )
-    ELSE
-       surface_fraction_f%from_file = .FALSE.
-    ENDIF
-!
-!-- Read building parameters and related information
-    IF ( check_existence( var_names, 'building_pars' ) )  THEN
-       building_pars_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, building_pars_f%fill, .FALSE., 'building_pars' )
-!
-!--    Inquire number of building parameters
-       CALL get_dimension_length( id_surf, building_pars_f%np, 'nbuilding_pars' )
-!
-!--    Allocate dimension array and input array for building parameters
-       ALLOCATE( building_pars_f%pars(0:building_pars_f%np-1) )
-       ALLOCATE( building_pars_f%pars_xy(0:building_pars_f%np-1,nys:nyn,nxl:nxr) )
-!
-!--    Get dimension of building parameters
-       CALL get_variable( id_surf, 'nbuilding_pars', building_pars_f%pars )
-!
-!--    Read building_pars
-       CALL get_variable( id_surf, 'building_pars', building_pars_f%pars_xy,                       &
-                          nxl, nxr, nys, nyn, 0, building_pars_f%np-1 )
-    ELSE
-       building_pars_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Read building surface parameters
-    IF ( check_existence( var_names, 'building_surface_pars' ) )  THEN
-       building_surface_pars_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, building_surface_pars_f%fill, .FALSE.,              &
-                           'building_surface_pars' )
-!
-!--    Read building_surface_pars
-       CALL get_variable_surf( id_surf, 'building_surface_pars', building_surface_pars_f )
-    ELSE
-       building_surface_pars_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Read albedo type and required attributes
-    IF ( check_existence( var_names, 'albedo_type' ) )  THEN
-       albedo_type_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, albedo_type_f%fill, .FALSE.,  'albedo_type' )
-
-       ALLOCATE( albedo_type_f%var(nys:nyn,nxl:nxr)  )
-
-       CALL get_variable( id_surf, 'albedo_type', albedo_type_f%var, nxl, nxr, nys, nyn )
-    ELSE
-       albedo_type_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Read albedo parameters and related information
-    IF ( check_existence( var_names, 'albedo_pars' ) )  THEN
-       albedo_pars_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, albedo_pars_f%fill, .FALSE., 'albedo_pars' )
-!
-!--    Inquire number of albedo parameters
-       CALL get_dimension_length( id_surf, albedo_pars_f%np, 'nalbedo_pars' )
-!
-!--    Allocate dimension array and input array for albedo parameters
-       ALLOCATE( albedo_pars_f%pars(0:albedo_pars_f%np-1) )
-       ALLOCATE( albedo_pars_f%pars_xy(0:albedo_pars_f%np-1,nys:nyn,nxl:nxr) )
-!
-!--    Get dimension of albedo parameters
-       CALL get_variable( id_surf, 'nalbedo_pars', albedo_pars_f%pars )
-
-       CALL get_variable( id_surf, 'albedo_pars', albedo_pars_f%pars_xy,                           &
-                          nxl, nxr, nys, nyn, 0, albedo_pars_f%np-1 )
-    ELSE
-       albedo_pars_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Read pavement parameters and related information
-    IF ( check_existence( var_names, 'pavement_pars' ) )  THEN
-       pavement_pars_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, pavement_pars_f%fill, .FALSE., 'pavement_pars' )
-!
-!--    Inquire number of pavement parameters
-       CALL get_dimension_length( id_surf, pavement_pars_f%np, 'npavement_pars' )
-!
-!--    Allocate dimension array and input array for pavement parameters
-       ALLOCATE( pavement_pars_f%pars(0:pavement_pars_f%np-1) )
-       ALLOCATE( pavement_pars_f%pars_xy(0:pavement_pars_f%np-1,nys:nyn,nxl:nxr) )
-!
-!--    Get dimension of pavement parameters
-       CALL get_variable( id_surf, 'npavement_pars', pavement_pars_f%pars )
-
-       CALL get_variable( id_surf, 'pavement_pars', pavement_pars_f%pars_xy,                       &
-                          nxl, nxr, nys, nyn, 0, pavement_pars_f%np-1 )
-    ELSE
-       pavement_pars_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Read pavement subsurface parameters and related information
-    IF ( check_existence( var_names, 'pavement_subsurface_pars' ) )  THEN
-       pavement_subsurface_pars_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, pavement_subsurface_pars_f%fill, .FALSE.,           &
-                           'pavement_subsurface_pars' )
-!
-!--    Inquire number of parameters
-       CALL get_dimension_length( id_surf, pavement_subsurface_pars_f%np,                          &
-                                  'npavement_subsurface_pars' )
-!
-!--    Inquire number of soil layers
-       CALL get_dimension_length( id_surf, pavement_subsurface_pars_f%nz, 'zsoil' )
-!
-!--    Allocate dimension array and input array for pavement parameters
-       ALLOCATE( pavement_subsurface_pars_f%pars(0:pavement_subsurface_pars_f%np-1) )
-       ALLOCATE( pavement_subsurface_pars_f%pars_xyz(0:pavement_subsurface_pars_f%np-1,            &
-                                                     0:pavement_subsurface_pars_f%nz-1,            &
-                                                     nys:nyn,nxl:nxr) )
-!
-!--    Get dimension of pavement parameters
-       CALL get_variable( id_surf, 'npavement_subsurface_pars', pavement_subsurface_pars_f%pars )
-
-       CALL get_variable( id_surf, 'pavement_subsurface_pars', pavement_subsurface_pars_f%pars_xyz,&
-                          nxl, nxr, nys, nyn, 0, pavement_subsurface_pars_f%nz-1,                  &
-                          0, pavement_subsurface_pars_f%np-1 )
-    ELSE
-       pavement_subsurface_pars_f%from_file = .FALSE.
-    ENDIF
-
-
-!
-!-- Read vegetation parameters and related information
-    IF ( check_existence( var_names, 'vegetation_pars' ) )  THEN
-       vegetation_pars_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, vegetation_pars_f%fill, .FALSE., 'vegetation_pars' )
-!
-!--    Inquire number of vegetation parameters
-       CALL get_dimension_length( id_surf, vegetation_pars_f%np, 'nvegetation_pars' )
-!
-!--    Allocate dimension array and input array for surface fractions
-       ALLOCATE( vegetation_pars_f%pars(0:vegetation_pars_f%np-1) )
-       ALLOCATE( vegetation_pars_f%pars_xy(0:vegetation_pars_f%np-1,nys:nyn,nxl:nxr) )
-!
-!--    Get dimension of the parameters
-       CALL get_variable( id_surf, 'nvegetation_pars', vegetation_pars_f%pars )
-       CALL get_variable( id_surf, 'vegetation_pars', vegetation_pars_f%pars_xy,                   &
-                          nxl, nxr, nys, nyn, 0, vegetation_pars_f%np-1 )
-    ELSE
-       vegetation_pars_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Read root parameters/distribution and related information
-    IF ( check_existence( var_names, 'soil_pars' ) )  THEN
-       soil_pars_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, soil_pars_f%fill, .FALSE., 'soil_pars' )
-       CALL get_attribute( id_surf, char_lod, soil_pars_f%lod, .FALSE., 'soil_pars' )
-
-!
-!--    Inquire number of soil parameters
-       CALL get_dimension_length( id_surf, soil_pars_f%np, 'nsoil_pars' )
-!
-!--    Read parameters array
-       ALLOCATE( soil_pars_f%pars(0:soil_pars_f%np-1) )
-       CALL get_variable( id_surf, 'nsoil_pars', soil_pars_f%pars )
-
-!
-!--    In case of level of detail 2, also inquire number of vertical soil layers, allocate memory
-!--    and read the respective dimension.
-       IF ( soil_pars_f%lod == 2 )  THEN
-          CALL get_dimension_length( id_surf, soil_pars_f%nz, 'zsoil' )
-
-          ALLOCATE( soil_pars_f%layers(0:soil_pars_f%nz-1) )
-          CALL get_variable( id_surf, 'zsoil', soil_pars_f%layers )
-
-       ENDIF
-
-!
-!--    Read soil parameters, depending on level of detail
-       IF ( soil_pars_f%lod == 1 )  THEN
-          ALLOCATE( soil_pars_f%pars_xy(0:soil_pars_f%np-1,nys:nyn,nxl:nxr) )
-
-          CALL get_variable( id_surf, 'soil_pars', soil_pars_f%pars_xy,                            &
-                             nxl, nxr, nys, nyn, 0, soil_pars_f%np-1 )
-
-       ELSEIF ( soil_pars_f%lod == 2 )  THEN
-          ALLOCATE( soil_pars_f%pars_xyz(0:soil_pars_f%np-1,0:soil_pars_f%nz-1,nys:nyn,nxl:nxr) )
-          CALL get_variable( id_surf, 'soil_pars', soil_pars_f%pars_xyz,                           &
-                             nxl, nxr, nys, nyn, 0, soil_pars_f%nz-1, 0, soil_pars_f%np-1 )
-       ENDIF
-    ELSE
-       soil_pars_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Read water parameters and related information
-    IF ( check_existence( var_names, 'water_pars' ) )  THEN
-       water_pars_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, water_pars_f%fill, .FALSE., 'water_pars' )
-!
-!--    Inquire number of water parameters
-       CALL get_dimension_length( id_surf, water_pars_f%np, 'nwater_pars' )
-!
-!--    Allocate dimension array and input array for water parameters
-       ALLOCATE( water_pars_f%pars(0:water_pars_f%np-1) )
-       ALLOCATE( water_pars_f%pars_xy(0:water_pars_f%np-1,nys:nyn,nxl:nxr) )
-!
-!--    Get dimension of water parameters
-       CALL get_variable( id_surf, 'nwater_pars', water_pars_f%pars )
-       CALL get_variable( id_surf, 'water_pars', water_pars_f%pars_xy,                             &
-                          nxl, nxr, nys, nyn, 0, water_pars_f%np-1 )
-    ELSE
-       water_pars_f%from_file = .FALSE.
-    ENDIF
-!
-!-- Read root area density - parametrized vegetation
-    IF ( check_existence( var_names, 'root_area_dens_s' ) )  THEN
-       root_area_density_lsm_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, root_area_density_lsm_f%fill, .FALSE.,              &
-                           'root_area_dens_s' )
-!
-!--    Obtain number of soil layers from file and allocate variable
-       CALL get_dimension_length( id_surf, root_area_density_lsm_f%nz, 'zsoil' )
-       ALLOCATE( root_area_density_lsm_f%var(0:root_area_density_lsm_f%nz-1,nys:nyn,nxl:nxr) )
-
-!
-!--    Read root-area density
-       CALL get_variable( id_surf, 'root_area_dens_s', root_area_density_lsm_f%var,                &
-                          nxl, nxr, nys, nyn, 0, root_area_density_lsm_f%nz-1 )
-
-    ELSE
-       root_area_density_lsm_f%from_file = .FALSE.
-    ENDIF
-!
-!-- Read street type and street crossing
-    IF ( check_existence( var_names, 'street_type' ) )  THEN
-       street_type_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, street_type_f%fill, .FALSE., 'street_type' )
-       ALLOCATE( street_type_f%var(nys:nyn,nxl:nxr) )
-       CALL get_variable( id_surf, 'street_type', street_type_f%var, nxl, nxr, nys, nyn )
-    ELSE
-       street_type_f%from_file = .FALSE.
-    ENDIF
-
-    IF ( check_existence( var_names, 'street_crossing' ) )  THEN
-       street_crossing_f%from_file = .TRUE.
-       CALL get_attribute( id_surf, char_fill, street_crossing_f%fill, .FALSE., 'street_crossing' )
-       ALLOCATE( street_crossing_f%var(nys:nyn,nxl:nxr) )
-       CALL get_variable( id_surf, 'street_crossing', street_crossing_f%var, nxl, nxr, nys, nyn )
-    ELSE
-       street_crossing_f%from_file = .FALSE.
-    ENDIF
-
-!
-!-- Still missing: root_resolved and building_surface_pars.
-!-- Will be implemented as soon as they are available.
-
-!
-!-- Finally, close input file
-    CALL close_input_file( id_surf )
-#endif
-!
-!-- End of CPU measurement
-    CALL cpu_log( log_point_s(82), 'NetCDF input', 'stop' )
-
-!
-!-- Exchange ghost points for surface variables. Therefore, resize variables.
-    IF ( albedo_type_f%from_file )  THEN
-       CALL add_ghost_layers( albedo_type_f%var )
-       CALL exchange_horiz_2d_byte( albedo_type_f%var, nys, nyn, nxl, nxr, nbgp )
-    ENDIF
-    IF ( pavement_type_f%from_file )  THEN
-       CALL add_ghost_layers( pavement_type_f%var )
-       CALL exchange_horiz_2d_byte( pavement_type_f%var, nys, nyn, nxl, nxr, nbgp )
-    ENDIF
-    IF ( soil_type_f%from_file  .AND.  ALLOCATED( soil_type_f%var_2d ) )  THEN
-       CALL add_ghost_layers( soil_type_f%var_2d )
-       CALL exchange_horiz_2d_byte( soil_type_f%var_2d, nys, nyn, nxl, nxr, nbgp )
-    ENDIF
-    IF ( vegetation_type_f%from_file )  THEN
-       CALL add_ghost_layers( vegetation_type_f%var )
-       CALL exchange_horiz_2d_byte( vegetation_type_f%var, nys, nyn, nxl, nxr, nbgp )
-    ENDIF
-    IF ( water_type_f%from_file )  THEN
-       CALL add_ghost_layers( water_type_f%var )
-       CALL exchange_horiz_2d_byte( water_type_f%var, nys, nyn, nxl, nxr, nbgp )
-    ENDIF
-
-!
-!-- Exchange ghost points for 3/4-D variables. For the sake of simplicity, loop further dimensions
-!-- to use 2D exchange routines. Unfortunately this is necessary, else new MPI-data types need to be
-!-- introduced just for 2 variables.
-    IF ( soil_type_f%from_file  .AND.  ALLOCATED( soil_type_f%var_3d ) )  THEN
-       CALL add_ghost_layers( soil_type_f%var_3d, 0, nz_soil )
-       DO  k = 0, nz_soil
-          CALL exchange_horiz_2d_byte( soil_type_f%var_3d(k,:,:), nys, nyn, nxl, nxr, nbgp )
-       ENDDO
-    ENDIF
-
-    IF ( surface_fraction_f%from_file )  THEN
-       CALL add_ghost_layers( surface_fraction_f%frac, 0, surface_fraction_f%nf-1 )
-       DO  k = 0, surface_fraction_f%nf-1
-          CALL exchange_horiz_2d( surface_fraction_f%frac(k,:,:) )
-       ENDDO
-    ENDIF
-
-    IF ( building_pars_f%from_file )  THEN
-       CALL add_ghost_layers( building_pars_f%pars_xy, 0, building_pars_f%np-1 )
-       DO  k = 0, building_pars_f%np-1
-          CALL exchange_horiz_2d( building_pars_f%pars_xy(k,:,:) )
-       ENDDO
-    ENDIF
-
-    IF ( albedo_pars_f%from_file )  THEN
-       CALL add_ghost_layers( albedo_pars_f%pars_xy, 0, albedo_pars_f%np-1 )
-       DO  k = 0, albedo_pars_f%np-1
-          CALL exchange_horiz_2d( albedo_pars_f%pars_xy(k,:,:) )
-       ENDDO
-    ENDIF
-
-    IF ( pavement_pars_f%from_file )  THEN
-       CALL add_ghost_layers( pavement_pars_f%pars_xy, 0, pavement_pars_f%np-1 )
-       DO  k = 0, pavement_pars_f%np-1
-          CALL exchange_horiz_2d( pavement_pars_f%pars_xy(k,:,:) )
-       ENDDO
-    ENDIF
-
-    IF ( vegetation_pars_f%from_file )  THEN
-       CALL add_ghost_layers( vegetation_pars_f%pars_xy, 0, vegetation_pars_f%np-1 )
-       DO  k = 0, vegetation_pars_f%np-1
-          CALL exchange_horiz_2d( vegetation_pars_f%pars_xy(k,:,:) )
-       ENDDO
-    ENDIF
-
-    IF ( water_pars_f%from_file )  THEN
-       CALL add_ghost_layers( water_pars_f%pars_xy, 0, water_pars_f%np-1 )
-       DO  k = 0, water_pars_f%np-1
-          CALL exchange_horiz_2d( water_pars_f%pars_xy(k,:,:) )
-       ENDDO
-    ENDIF
-
-    IF ( root_area_density_lsm_f%from_file )  THEN
-       CALL add_ghost_layers( root_area_density_lsm_f%var, 0, root_area_density_lsm_f%nz-1 )
-       DO  k = 0, root_area_density_lsm_f%nz-1
-          CALL exchange_horiz_2d( root_area_density_lsm_f%var(k,:,:) )
-       ENDDO
-    ENDIF
-
-    IF ( soil_pars_f%from_file )  THEN
-       IF ( soil_pars_f%lod == 1 )  THEN
-          CALL add_ghost_layers( soil_pars_f%pars_xy, 0, soil_pars_f%np-1 )
-          DO  k = 0, soil_pars_f%np-1
-             CALL exchange_horiz_2d( soil_pars_f%pars_xy(k,:,:) )
-          ENDDO
-
-       ELSEIF ( soil_pars_f%lod == 2 )  THEN
-          CALL add_ghost_layers( soil_pars_f%pars_xyz, 0, soil_pars_f%np-1, 0, soil_pars_f%nz-1 )
-
-          DO  k2 = 0, soil_pars_f%nz-1
-             DO  k = 0, soil_pars_f%np-1
-                CALL exchange_horiz_2d( soil_pars_f%pars_xyz(k,k2,:,:) )
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
-    IF ( pavement_subsurface_pars_f%from_file )  THEN
-       CALL add_ghost_layers( pavement_subsurface_pars_f%pars_xyz,                                 &
-                              0, pavement_subsurface_pars_f%np-1,                                  &
-                              0, pavement_subsurface_pars_f%nz-1 )
-
-       DO  k2 = 0, pavement_subsurface_pars_f%nz-1
-          DO  k = 0, pavement_subsurface_pars_f%np-1
-             CALL exchange_horiz_2d( pavement_subsurface_pars_f%pars_xyz(k,k2,:,:) )
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE netcdf_data_input_surface_data
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads uvem lookup table information.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_data_input_uvem
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nyn, nys
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< variable names in static input file
-
-
-    INTEGER(iwp) ::  id_uvem       !< NetCDF id of uvem lookup table input file
-    INTEGER(iwp) ::  nli = 35      !< dimension length of lookup table in x
-    INTEGER(iwp) ::  nlj =  9      !< dimension length of lookup table in y
-    INTEGER(iwp) ::  nlk = 90      !< dimension length of lookup table in z
-    INTEGER(iwp) ::  num_vars      !< number of variables in netcdf input file
-!
-!-- Input via uv exposure model lookup table input
-    IF ( input_pids_uvem )  THEN
-
-#if defined ( __netcdf )
-!
-!--    Open file in read-only mode
-       CALL open_read_file( TRIM( input_file_uvem ) // TRIM( coupling_char ), id_uvem )
-!
-!--    At first, inquire all variable names.
-!--    This will be used to check whether an input variable exist or not.
-       CALL inquire_num_variables( id_uvem, num_vars )
-!
-!--    Allocate memory to store variable names and inquire them.
-       ALLOCATE( var_names(1:num_vars) )
-       CALL inquire_variable_names( id_uvem, var_names )
-!
-!--    uvem integration
-       IF ( check_existence( var_names, 'int_factors' ) )  THEN
-          uvem_integration_f%from_file = .TRUE.
-!
-!--       Input 2D uvem integration.
-          ALLOCATE( uvem_integration_f%var(0:nlj,0:nli)  )
-          CALL get_variable( id_uvem, 'int_factors', uvem_integration_f%var, 0, nli, 0, nlj )
-       ELSE
-          uvem_integration_f%from_file = .FALSE.
-       ENDIF
-!
-!--    uvem irradiance
-       IF ( check_existence( var_names, 'irradiance' ) )  THEN
-          uvem_irradiance_f%from_file = .TRUE.
-!
-!--       Input 2D uvem irradiance.
-          ALLOCATE( uvem_irradiance_f%var(0:nlk, 0:2)  )
-          CALL get_variable( id_uvem, 'irradiance', uvem_irradiance_f%var, 0, 2, 0, nlk )
-       ELSE
-          uvem_irradiance_f%from_file = .FALSE.
-       ENDIF
-!
-!--    uvem porjection areas
-       IF ( check_existence( var_names, 'projarea' ) )  THEN
-          uvem_projarea_f%from_file = .TRUE.
-!
-!--       Input 3D uvem projection area (human geometgry)
-          ALLOCATE( uvem_projarea_f%var(0:2,0:nlj,0:nli)  )
-          CALL get_variable( id_uvem, 'projarea', uvem_projarea_f%var, 0, nli, 0, nlj, 0, 2 )
-       ELSE
-          uvem_projarea_f%from_file = .FALSE.
-       ENDIF
-!
-!--    uvem radiance
-       IF ( check_existence( var_names, 'radiance' ) )  THEN
-          uvem_radiance_f%from_file = .TRUE.
-!
-!--       Input 3D uvem radiance
-          ALLOCATE( uvem_radiance_f%var(0:nlk,0:nlj,0:nli)  )
-          CALL get_variable( id_uvem, 'radiance', uvem_radiance_f%var, 0, nli, 0, nlj, 0, nlk )
-       ELSE
-          uvem_radiance_f%from_file = .FALSE.
-       ENDIF
-!
-!--    Read building obstruction
-!      @bug This part is deactivated due to improper implementation: conflicts with
-!           building_obstruction_f and it is also not used anywhere else in the code
-!        IF ( check_existence( var_names, 'obstruction' ) )  THEN
-!           building_obstruction_full%from_file = .TRUE.
-! !
-! !--       Input 3D uvem building obstruction
-!           ALLOCATE( building_obstruction_full%var_3d(0:44,0:2,0:2) )
-!           CALL get_variable( id_uvem, 'obstruction', building_obstruction_full%var_3d, &
-!                              0, 2, 0, 2, 0, 44 )
-!        ELSE
-!           building_obstruction_full%from_file = .FALSE.
-!        ENDIF
-!
-       IF ( check_existence( var_names, 'obstruction' ) )  THEN
-          building_obstruction_f%from_file = .TRUE.
-!
-!--       Input 3D uvem building obstruction
-          ALLOCATE( building_obstruction_f%var_3d(0:44,nys:nyn,nxl:nxr) )
-          CALL get_variable( id_uvem, 'obstruction', building_obstruction_f%var_3d,                &
-                             nxl, nxr, nys, nyn, 0, 44 )
-       ELSE
-          building_obstruction_f%from_file = .FALSE.
-       ENDIF
-!
-!--    Close uvem lookup table input file
-       CALL close_input_file( id_uvem )
-#else
-       CONTINUE
-#endif
-    ENDIF
-
- END SUBROUTINE netcdf_data_input_uvem
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads orography and building information.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_data_input_topo
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string, topography
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz_2d_byte, exchange_horiz_2d_int
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxr, ny, nyn, nys, nzb
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< variable names in static input file
-
-
-    INTEGER(iwp) ::  i             !< running index along x-direction
-    INTEGER(iwp) ::  id_topo       !< NetCDF id of topograhy input file
-    INTEGER(iwp) ::  ii            !< running index for IO blocks
-    INTEGER(iwp) ::  io_status     !< status after reading the ascii topo file
-    INTEGER(iwp) ::  j             !< running index along y-direction
-    INTEGER(iwp) ::  num_vars      !< number of variables in netcdf input file
-    INTEGER(iwp) ::  skip_n_rows   !< counting variable to skip rows while reading topography file
-
-    REAL(wp) ::  dum           !< dummy variable to skip columns while reading topography file
-
-
-!
-!-- CPU measurement
-    CALL cpu_log( log_point_s(83), 'NetCDF/ASCII input topo', 'start' )
-!
-!-- Input via palm-input data standard
-    IF ( input_pids_static )  THEN
-#if defined ( __netcdf )
-!
-!--    Open file in read-only mode
-       CALL open_read_file( TRIM( input_file_static ) // TRIM( coupling_char ), id_topo )
-!
-!--    At first, inquire all variable names.
-!--    This will be used to check whether an input variable exists or not.
-       CALL inquire_num_variables( id_topo, num_vars )
-!
-!--    Allocate memory to store variable names and inquire them.
-       ALLOCATE( var_names(1:num_vars) )
-       CALL inquire_variable_names( id_topo, var_names )
-!
-!--    Read x, y - dimensions. Only required for consistency checks.
-       CALL get_dimension_length( id_topo, dim_static%nx, 'x' )
-       CALL get_dimension_length( id_topo, dim_static%ny, 'y' )
-       ALLOCATE( dim_static%x(0:dim_static%nx-1) )
-       ALLOCATE( dim_static%y(0:dim_static%ny-1) )
-       CALL get_variable( id_topo, 'x', dim_static%x )
-       CALL get_variable( id_topo, 'y', dim_static%y )
-!
-!--    Check whether dimension size in input file matches the model dimensions
-       IF ( dim_static%nx-1 /= nx  .OR.  dim_static%ny-1 /= ny )  THEN
-          message_string = 'Static input file: horizontal dimension in ' //                        &
-                           'x- and/or y-direction ' //                                             &
-                           'do not match the respective model dimension'
-          CALL message( 'netcdf_data_input_mod', 'PA0548', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Check if grid spacing of provided input data matches the respective grid spacing in the
-!--    model.
-       IF ( ABS( dim_static%x(1) - dim_static%x(0) - dx ) > 10E-6_wp  .OR.                         &
-            ABS( dim_static%y(1) - dim_static%y(0) - dy ) > 10E-6_wp )  THEN
-          message_string = 'Static input file: horizontal grid spacing ' //                        &
-                           'in x- and/or y-direction ' //                                          &
-                           'do not match the respective model grid spacing.'
-          CALL message( 'netcdf_data_input_mod', 'PA0549', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Terrain height. First, get variable-related _FillValue attribute
-       IF ( check_existence( var_names, 'zt' ) )  THEN
-          terrain_height_f%from_file = .TRUE.
-          CALL get_attribute( id_topo, char_fill, terrain_height_f%fill, .FALSE., 'zt' )
-!
-!--       Input 2D terrain height.
-          ALLOCATE( terrain_height_f%var(nys:nyn,nxl:nxr)  )
-
-          CALL get_variable( id_topo, 'zt', terrain_height_f%var, nxl, nxr, nys, nyn )
-
-       ELSE
-          terrain_height_f%from_file = .FALSE.
-       ENDIF
-
-!
-!--    Read building height. First, read its _FillValue attribute, as well as lod attribute
-       buildings_f%from_file = .FALSE.
-       IF ( check_existence( var_names, 'buildings_2d' ) )  THEN
-          buildings_f%from_file = .TRUE.
-          CALL get_attribute( id_topo, char_lod, buildings_f%lod, .FALSE., 'buildings_2d' )
-          CALL get_attribute( id_topo, char_fill, buildings_f%fill1, .FALSE., 'buildings_2d' )
-
-!
-!--       Read 2D buildings
-          IF ( buildings_f%lod == 1 )  THEN
-             ALLOCATE( buildings_f%var_2d(nys:nyn,nxl:nxr) )
-             CALL get_variable( id_topo, 'buildings_2d',                                           &
-                                buildings_f%var_2d,                                                &
-                                nxl, nxr, nys, nyn )
-          ELSE
-             message_string = 'NetCDF attribute lod ' //                                           &
-                              '(level of detail) is not set ' //                                   &
-                              'properly for buildings_2d.'
-             CALL message( 'netcdf_data_input_mod', 'PA0540', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-!
-!--    If available, also read 3D building information. If both are available, use 3D information.
-       IF ( check_existence( var_names, 'buildings_3d' ) )  THEN
-          buildings_f%from_file = .TRUE.
-          CALL get_attribute( id_topo, char_lod, buildings_f%lod, .FALSE., 'buildings_3d' )
-          CALL get_attribute( id_topo, char_fill, buildings_f%fill2, .FALSE., 'buildings_3d' )
-          CALL get_dimension_length( id_topo, buildings_f%nz, 'z' )
-!
-!--       Read 3D buildings
-          IF ( buildings_f%lod == 2 )  THEN
-             ALLOCATE( buildings_f%z(nzb:buildings_f%nz-1) )
-             CALL get_variable( id_topo, 'z', buildings_f%z )
-             ALLOCATE( buildings_f%var_3d(nzb:buildings_f%nz-1, nys:nyn,nxl:nxr) )
-             buildings_f%var_3d = 0
-             CALL get_variable( id_topo, 'buildings_3d', buildings_f%var_3d, nxl, nxr, nys, nyn, 0,&
-                                buildings_f%nz-1 )
-          ELSE
-             message_string = 'NetCDF attribute lod (level of detail) is not set ' //              &
-                              'properly for buildings_3d.'
-             CALL message( 'netcdf_data_input_mod', 'PA0541', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-!
-!--    Read building IDs and its FillValue attribute. Further required for mapping buildings on top
-!--    of orography.
-       IF ( check_existence( var_names, 'building_id' ) )  THEN
-          building_id_f%from_file = .TRUE.
-          CALL get_attribute( id_topo, char_fill, building_id_f%fill, .FALSE., 'building_id' )
-          ALLOCATE( building_id_f%var(nys:nyn,nxl:nxr) )
-          CALL get_variable( id_topo, 'building_id', building_id_f%var, nxl, nxr, nys, nyn )
-       ELSE
-          building_id_f%from_file = .FALSE.
-       ENDIF
-!
-!--    Read building_type and required attributes.
-       IF ( check_existence( var_names, 'building_type' ) )  THEN
-          building_type_f%from_file = .TRUE.
-          CALL get_attribute( id_topo, char_fill, building_type_f%fill, .FALSE., 'building_type' )
-          ALLOCATE( building_type_f%var(nys:nyn,nxl:nxr) )
-          CALL get_variable( id_topo, 'building_type', building_type_f%var, nxl, nxr, nys, nyn )
-       ELSE
-          building_type_f%from_file = .FALSE.
-       ENDIF
-!
-!--    Close topography input file
-       CALL close_input_file( id_topo )
-#else
-       CONTINUE
-#endif
-!
-!-- ASCII input
-    ELSEIF ( TRIM( topography ) == 'read_from_file' )  THEN
-
-       DO  ii = 0, io_blocks-1
-          IF ( ii == io_group )  THEN
-
-             OPEN( 90, FILE='TOPOGRAPHY_DATA' // TRIM( coupling_char ), STATUS='OLD',              &
-                       FORM='FORMATTED', IOSTAT=io_status )
-
-             IF ( io_status > 0 )  THEN
-                message_string = 'file TOPOGRAPHY_DATA' //                                         &
-                                 TRIM( coupling_char ) // ' does not exist'
-                CALL message( 'netcdf_data_input_mod', 'PA0208', 1, 2, 0, 6, 0 )
-             ENDIF
-
-!
-!--          Read topography PE-wise. Rows are read from nyn to nys, columns are read from nxl to
-!--          nxr. At first, ny-nyn rows need to be skipped.
-             skip_n_rows = 0
-             DO  WHILE ( skip_n_rows < ny - nyn )
-                READ( 90, * )
-                skip_n_rows = skip_n_rows + 1
-             ENDDO
-!
-!--          Read data from nyn to nys and nxl to nxr. Therefore, skip column until nxl-1 is reached
-             ALLOCATE( buildings_f%var_2d(nys:nyn,nxl:nxr) )
-             DO  j = nyn, nys, -1
-
-                READ( 90, *, IOSTAT=io_status )  ( dum, i = 0, nxl-1 ),                            &
-                                                 ( buildings_f%var_2d(j,i), i = nxl, nxr )
-
-                IF ( io_status > 0 )  THEN
-                   WRITE( message_string, '(A,1X,I5,1X,A)' ) 'error reading line', ny-j+1,         &
-                                          'of file TOPOGRAPHY_DATA' // TRIM( coupling_char )
-                   CALL message( 'netcdf_data_input_mod', 'PA0209', 2, 2, myid, 6, 0 )
-                ELSEIF ( io_status < 0 )  THEN
-                   WRITE( message_string, '(A,1X,I5)' ) 'end of line or file detected for '//      &
-                               'file TOPOGRAPHY_DATA' // TRIM( coupling_char ) // ' at line', ny-j+1
-                   CALL message( 'netcdf_data_input_mod', 'PA0704', 2, 2, myid, 6, 0 )
-                ENDIF
-
-             ENDDO
-
-             CLOSE( 90 )
-             buildings_f%from_file = .TRUE.
-
-          ENDIF
-#if defined( __parallel )
-          CALL MPI_BARRIER( comm2d, ierr )
-#endif
-       ENDDO
-
-    ENDIF
-!
-!-- End of CPU measurement
-    CALL cpu_log( log_point_s(83), 'NetCDF/ASCII input topo', 'stop' )
-
-!
-!-- Check for minimum requirement to setup building topography. If buildings are provided, also an
-!-- ID and a type are required.
-!-- Note, doing this check in check_parameters will be too late (data will be used for grid
-!-- inititialization before).
-    IF ( input_pids_static )  THEN
-       IF ( buildings_f%from_file  .AND.  .NOT. building_id_f%from_file )  THEN
-          message_string = 'If building heights are prescribed in ' //                             &
-                           'static input file, also an ID is required.'
-          CALL message( 'netcdf_data_input_mod', 'PA0542', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    IF ( terrain_height_f%from_file )  THEN
-!
-!--    Check orography for fill-values.
-!--    For the moment, give an error message. More advanced methods, e.g. a nearest neighbor
-!--    algorithm as used in GIS systems might be implemented later.
-!--    Note: This check must be placed here as terrain_height_f is altered within init_grid which is
-!--    called before netcdf_data_input_check_static
-       IF ( ANY( terrain_height_f%var == terrain_height_f%fill ) )  THEN
-          message_string = 'NetCDF variable zt is not ' // 'allowed to have missing data'
-          CALL message( 'netcdf_data_input_mod', 'PA0550', 2, 2, myid, 6, 0 )
-       ENDIF
-    ELSE
-!
-!--    In case no terrain height is provided by static input file, allocate array nevertheless and
-!--    set terrain height to 0, which simplifies topography initialization.
-       ALLOCATE( terrain_height_f%var(nys:nyn,nxl:nxr) )
-       terrain_height_f%var = 0.0_wp
-    ENDIF
-!
-!-- Finally, exchange 1 ghost point for building ID and type.
-!-- In case of non-cyclic boundary conditions set Neumann conditions at the lateral boundaries.
-    IF ( building_id_f%from_file )  THEN
-       CALL add_ghost_layers( building_id_f%var )
-       CALL exchange_horiz_2d_int( building_id_f%var, nys, nyn, nxl, nxr, nbgp )
-    ENDIF
-
-    IF ( building_type_f%from_file )  THEN
-       CALL add_ghost_layers( building_type_f%var )
-       CALL exchange_horiz_2d_byte( building_type_f%var, nys, nyn, nxl, nxr, nbgp )
-    ENDIF
-
- END SUBROUTINE netcdf_data_input_topo
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads initialization data of u, v, w, pt, q, geostrophic wind components, as well as soil
-!> moisture and soil temperature, derived from larger-scale model (COSMO) by Inifor.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_data_input_init_3d
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  pt, q, u, v, w, zu, zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  air_chemistry, bc_lr_cyc, bc_ns_cyc, humidity, message_string, neutral
-
-    USE indices,                                                                                   &
-        ONLY:  nx, nxl, nxlu, nxr, ny, nyn, nys, nysv, nzb, nz, nzt
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names
-
-    INTEGER(iwp) ::  id_dynamic  !< NetCDF id of dynamic input file
-    INTEGER(iwp) ::  n           !< running index for chemistry variables
-    INTEGER(iwp) ::  num_vars    !< number of variables in netcdf input file
-
-    LOGICAL      ::  check_passed         !< flag indicating if a check passed
-    LOGICAL      ::  dynamic_3d = .TRUE.  !< flag indicating that 3D data is read from dynamic file
-
-!
-!-- Skip routine if no input file with dynamic input data is available.
-    IF ( .NOT. input_pids_dynamic )  RETURN
-!
-!-- Please note, Inifor is designed to provide initial data for u and v for the prognostic grid
-!-- points in case of lateral Dirichlet conditions.
-!-- This means that Inifor provides data from nxlu:nxr (for u) and from nysv:nyn (for v) at the left
-!-- and south domain boundary, respectively.
-!-- However, as work-around for the moment, PALM will run with cyclic conditions and will be
-!-- initialized with data provided by Inifor boundaries in case of Dirichlet.
-!-- Hence, simply set set nxlu/nysv to 1 (will be reset to its original value at the end of this
-!-- routine).
-    IF ( bc_lr_cyc  .AND.  nxl == 0 )  nxlu = 1
-    IF ( bc_ns_cyc  .AND.  nys == 0 )  nysv = 1
-
-!
-!-- CPU measurement
-    CALL cpu_log( log_point_s(85), 'NetCDF input init', 'start' )
-
-#if defined ( __netcdf )
-!
-!-- Open file in read-only mode
-    CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dynamic )
-
-!
-!-- At first, inquire all variable names.
-    CALL inquire_num_variables( id_dynamic, num_vars )
-!
-!-- Allocate memory to store variable names.
-    ALLOCATE( var_names(1:num_vars) )
-    CALL inquire_variable_names( id_dynamic, var_names )
-!
-!-- Read vertical dimension of scalar und w grid.
-    CALL get_dimension_length( id_dynamic, init_3d%nzu, 'z'     )
-    CALL get_dimension_length( id_dynamic, init_3d%nzw, 'zw'    )
-!
-!-- Read also the horizontal dimensions. These are used just used for checking the compatibility
-!-- with the PALM grid before reading.
-    CALL get_dimension_length( id_dynamic, init_3d%nx,  'x'  )
-    CALL get_dimension_length( id_dynamic, init_3d%nxu, 'xu' )
-    CALL get_dimension_length( id_dynamic, init_3d%ny,  'y'  )
-    CALL get_dimension_length( id_dynamic, init_3d%nyv, 'yv' )
-
-!
-!-- Check for correct horizontal and vertical dimension. Please note, checks are performed directly
-!-- here and not called from check_parameters as some varialbes are still not allocated there.
-!-- Moreover, please note, u- and v-grid has 1 grid point less on Inifor grid.
-    IF ( init_3d%nx-1 /= nx  .OR.  init_3d%nxu-1 /= nx - 1  .OR.                                   &
-         init_3d%ny-1 /= ny  .OR.  init_3d%nyv-1 /= ny - 1 )  THEN
-       message_string = 'Number of horizontal grid points in '//                                   &
-                        'dynamic input file does not match ' //                                    &
-                        'the number of numeric grid points.'
-       CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( init_3d%nzu /= nz )  THEN
-       message_string = 'Number of vertical grid points in '//                                     &
-                        'dynamic input file does not match ' //                                    &
-                        'the number of numeric grid points.'
-       CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Read vertical dimensions. Later, these are required for eventual inter- and extrapolations of
-!-- the initialization data.
-    IF ( check_existence( var_names, 'z' ) )  THEN
-       ALLOCATE( init_3d%zu_atmos(1:init_3d%nzu) )
-       CALL get_variable( id_dynamic, 'z', init_3d%zu_atmos )
-    ENDIF
-    IF ( check_existence( var_names, 'zw' ) )  THEN
-       ALLOCATE( init_3d%zw_atmos(1:init_3d%nzw) )
-       CALL get_variable( id_dynamic, 'zw', init_3d%zw_atmos )
-    ENDIF
-!
-!-- Check for consistency between vertical coordinates in dynamic driver and numeric grid.
-!-- Please note, depending on compiler options both may be  equal up to a certain threshold, and
-!-- differences between the numeric grid and vertical coordinate in the driver can built-up to
-!-- 10E-1-10E-0 m. For this reason, the check is performed not for exactly matching values.
-    IF ( ANY( ABS( zu(1:nzt)   - init_3d%zu_atmos(1:init_3d%nzu) ) > 10E-1 )  .OR.                 &
-         ANY( ABS( zw(1:nzt-1) - init_3d%zw_atmos(1:init_3d%nzw) ) > 10E-1 ) )  THEN
-       message_string = 'Vertical grid in dynamic driver does not ' // 'match the numeric grid.'
-       CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Read initial geostrophic wind components at t = 0 (index 1 in file).
-    IF ( check_existence( var_names, 'ls_forcing_ug' ) )  THEN
-       ALLOCATE( init_3d%ug_init(nzb:nzt+1) )
-       init_3d%ug_init = 0.0_wp
-       CALL get_variable_pr( id_dynamic, 'ls_forcing_ug', 1, init_3d%ug_init(1:nzt) )
-!
-!--    Set top-boundary condition (Neumann)
-       init_3d%ug_init(nzt+1) = init_3d%ug_init(nzt)
-       init_3d%from_file_ug = .TRUE.
-    ELSE
-       init_3d%from_file_ug = .FALSE.
-    ENDIF
-
-    IF ( check_existence( var_names, 'ls_forcing_vg' ) )  THEN
-       ALLOCATE( init_3d%vg_init(nzb:nzt+1) )
-       init_3d%vg_init = 0.0_wp
-       CALL get_variable_pr( id_dynamic, 'ls_forcing_vg', 1, init_3d%vg_init(1:nzt) )
-!
-!--    Set top-boundary condition (Neumann)
-       init_3d%vg_init(nzt+1) = init_3d%vg_init(nzt)
-       init_3d%from_file_vg = .TRUE.
-    ELSE
-       init_3d%from_file_vg = .FALSE.
-    ENDIF
-!
-!-- Read inital 3D data of u, v, w, pt and q, derived from COSMO model. Read PE-wise yz-slices.
-!-- Please note, the u-, v- and w-component are defined on different grids with one element less in
-!-- the x-, y-, and z-direction, respectively. Hence, reading is subdivided into separate loops.
-!-- Read u-component
-    IF ( check_existence( var_names, 'init_atmosphere_u' ) )  THEN
-!
-!--    Read attributes for the fill value and level-of-detail
-       CALL get_attribute( id_dynamic, char_fill, init_3d%fill_u, .FALSE., 'init_atmosphere_u' )
-       CALL get_attribute( id_dynamic, char_lod, init_3d%lod_u, .FALSE., 'init_atmosphere_u' )
-!
-!--    level-of-detail 1 - read initialization profile
-       IF ( init_3d%lod_u == 1 )  THEN
-          ALLOCATE( init_3d%u_init(nzb:nzt+1) )
-          init_3d%u_init = 0.0_wp
-          CALL get_variable( id_dynamic, 'init_atmosphere_u', init_3d%u_init(nzb+1:nzt) )
-!
-!--       Set top-boundary condition (Neumann)
-          init_3d%u_init(nzt+1) = init_3d%u_init(nzt)
-!
-!--    level-of-detail 2 - read 3D initialization data
-       ELSEIF ( init_3d%lod_u == 2 )  THEN
-          CALL get_variable( id_dynamic, 'init_atmosphere_u', u(nzb+1:nzt,nys:nyn,nxlu:nxr),       &
-                             nxlu, nys+1, nzb+1, nxr-nxlu+1, nyn-nys+1, init_3d%nzu, dynamic_3d )
-!
-!--       Set value at leftmost model grid point nxl = 0. This is because Inifor provides data only
-!--       from 1:nx-1 since it assumes non-cyclic conditions.
-          IF ( nxl == 0 )  u(nzb+1:nzt,nys:nyn,nxl) = u(nzb+1:nzt,nys:nyn,nxlu)
-!
-!--       Set bottom and top-boundary
-          u(nzb,:,:)   = u(nzb+1,:,:)
-          u(nzt+1,:,:) = u(nzt,:,:)
-       ENDIF
-       init_3d%from_file_u = .TRUE.
-    ELSE
-       message_string = 'Missing initial data for u-component'
-       CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Read v-component
-    IF ( check_existence( var_names, 'init_atmosphere_v' ) )  THEN
-!
-!--    Read attributes for the fill value and level-of-detail
-       CALL get_attribute( id_dynamic, char_fill, init_3d%fill_v, .FALSE., 'init_atmosphere_v' )
-       CALL get_attribute( id_dynamic, char_lod, init_3d%lod_v, .FALSE., 'init_atmosphere_v' )
-!
-!--    level-of-detail 1 - read initialization profile
-       IF ( init_3d%lod_v == 1 )  THEN
-          ALLOCATE( init_3d%v_init(nzb:nzt+1) )
-          init_3d%v_init = 0.0_wp
-          CALL get_variable( id_dynamic, 'init_atmosphere_v', init_3d%v_init(nzb+1:nzt) )
-!
-!--       Set top-boundary condition (Neumann)
-          init_3d%v_init(nzt+1) = init_3d%v_init(nzt)
-!
-!--    level-of-detail 2 - read 3D initialization data
-       ELSEIF ( init_3d%lod_v == 2 )  THEN
-
-          CALL get_variable( id_dynamic, 'init_atmosphere_v', v(nzb+1:nzt,nysv:nyn,nxl:nxr),       &
-                             nxl+1, nysv, nzb+1, nxr-nxl+1, nyn-nysv+1, init_3d%nzu, dynamic_3d )
-!
-!--       Set value at southmost model grid point nys = 0. This is because Inifor provides data only
-!--       from 1:ny-1 since it assumes non-cyclic conditions.
-          IF ( nys == 0 )  v(nzb+1:nzt,nys,nxl:nxr) = v(nzb+1:nzt,nysv,nxl:nxr)
-!
-!--       Set bottom and top-boundary
-          v(nzb,:,:)   = v(nzb+1,:,:)
-          v(nzt+1,:,:) = v(nzt,:,:)
-       ENDIF
-       init_3d%from_file_v = .TRUE.
-    ELSE
-       message_string = 'Missing initial data for v-component'
-       CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Read w-component
-    IF ( check_existence( var_names, 'init_atmosphere_w' ) )  THEN
-!
-!--    Read attributes for the fill value and level-of-detail
-       CALL get_attribute( id_dynamic, char_fill, init_3d%fill_w, .FALSE., 'init_atmosphere_w' )
-       CALL get_attribute( id_dynamic, char_lod, init_3d%lod_w, .FALSE., 'init_atmosphere_w' )
-!
-!--    level-of-detail 1 - read initialization profile
-       IF ( init_3d%lod_w == 1 )  THEN
-          ALLOCATE( init_3d%w_init(nzb:nzt+1) )
-          init_3d%w_init = 0.0_wp
-          CALL get_variable( id_dynamic, 'init_atmosphere_w', init_3d%w_init(nzb+1:nzt-1) )
-!
-!--       Set top-boundary condition (Neumann)
-          init_3d%w_init(nzt:nzt+1) = init_3d%w_init(nzt-1)
-!
-!--    level-of-detail 2 - read 3D initialization data
-       ELSEIF ( init_3d%lod_w == 2 )  THEN
-
-          CALL get_variable( id_dynamic, 'init_atmosphere_w', w(nzb+1:nzt-1,nys:nyn,nxl:nxr),      &
-                             nxl+1, nys+1, nzb+1, nxr-nxl+1, nyn-nys+1, init_3d%nzw, dynamic_3d )
-!
-!--       Set bottom and top-boundary
-          w(nzb,:,:)   = 0.0_wp
-          w(nzt,:,:)   = w(nzt-1,:,:)
-          w(nzt+1,:,:) = w(nzt-1,:,:)
-       ENDIF
-       init_3d%from_file_w = .TRUE.
-    ELSE
-       message_string = 'Missing initial data for w-component'
-       CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Read potential temperature
-    IF ( .NOT. neutral )  THEN
-       IF ( check_existence( var_names, 'init_atmosphere_pt' ) )  THEN
-!
-!--       Read attributes for the fill value and level-of-detail
-          CALL get_attribute( id_dynamic, char_fill, init_3d%fill_pt, .FALSE., 'init_atmosphere_pt')
-          CALL get_attribute( id_dynamic, char_lod, init_3d%lod_pt, .FALSE., 'init_atmosphere_pt' )
-!
-!--       level-of-detail 1 - read initialization profile
-          IF ( init_3d%lod_pt == 1 )  THEN
-             ALLOCATE( init_3d%pt_init(nzb:nzt+1) )
-             CALL get_variable( id_dynamic, 'init_atmosphere_pt', init_3d%pt_init(nzb+1:nzt) )
-!
-!--          Set Neumann top and surface boundary condition for initial profil
-             init_3d%pt_init(nzb)   = init_3d%pt_init(nzb+1)
-             init_3d%pt_init(nzt+1) = init_3d%pt_init(nzt)
-!
-!--       level-of-detail 2 - read 3D initialization data
-          ELSEIF ( init_3d%lod_pt == 2 )  THEN
-
-             CALL get_variable( id_dynamic, 'init_atmosphere_pt', pt(nzb+1:nzt,nys:nyn,nxl:nxr),   &
-                                nxl+1, nys+1, nzb+1, nxr-nxl+1, nyn-nys+1, init_3d%nzu, dynamic_3d )
-!
-!--          Set bottom and top-boundary
-             pt(nzb,:,:)   = pt(nzb+1,:,:)
-             pt(nzt+1,:,:) = pt(nzt,:,:)
-          ENDIF
-          init_3d%from_file_pt = .TRUE.
-       ELSE
-          message_string = 'Missing initial data for ' // 'potential temperature'
-          CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-!
-!-- Read mixing ratio
-    IF ( humidity )  THEN
-       IF ( check_existence( var_names, 'init_atmosphere_qv' ) )  THEN
-!
-!--       Read attributes for the fill value and level-of-detail
-          CALL get_attribute( id_dynamic, char_fill, init_3d%fill_q, .FALSE., 'init_atmosphere_qv' )
-          CALL get_attribute( id_dynamic, char_lod, init_3d%lod_q, .FALSE., 'init_atmosphere_qv' )
-!
-!--       level-of-detail 1 - read initialization profile
-          IF ( init_3d%lod_q == 1 )  THEN
-             ALLOCATE( init_3d%q_init(nzb:nzt+1) )
-             CALL get_variable( id_dynamic, 'init_atmosphere_qv', init_3d%q_init(nzb+1:nzt) )
-!
-!--          Set bottom and top boundary condition (Neumann)
-             init_3d%q_init(nzb)   = init_3d%q_init(nzb+1)
-             init_3d%q_init(nzt+1) = init_3d%q_init(nzt)
-!
-!--       level-of-detail 2 - read 3D initialization data
-          ELSEIF ( init_3d%lod_q == 2 )  THEN
-
-             CALL get_variable( id_dynamic, 'init_atmosphere_qv', q(nzb+1:nzt,nys:nyn,nxl:nxr),    &
-                                nxl+1, nys+1, nzb+1, nxr-nxl+1, nyn-nys+1, init_3d%nzu, dynamic_3d )
-!
-!--          Set bottom and top-boundary
-             q(nzb,:,:)   = q(nzb+1,:,:)
-             q(nzt+1,:,:) = q(nzt,:,:)
-          ENDIF
-          init_3d%from_file_q = .TRUE.
-       ELSE
-          message_string = 'Missing initial data for ' // 'mixing ratio'
-          CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-!
-!-- Read chemistry variables.
-!-- Please note, for the moment, only LOD=1 is allowed
-    IF ( air_chemistry )  THEN
-!
-!--    Allocate chemistry input profiles, as well as arrays for fill values and LOD's.
-       ALLOCATE( init_3d%chem_init(nzb:nzt+1,1:UBOUND( init_3d%var_names_chem, 1 )) )
-       ALLOCATE( init_3d%fill_chem(1:UBOUND( init_3d%var_names_chem, 1 )) )
-       ALLOCATE( init_3d%lod_chem(1:UBOUND( init_3d%var_names_chem, 1 ))  )
-
-       DO  n = 1, UBOUND( init_3d%var_names_chem, 1 )
-          IF ( check_existence( var_names, TRIM( init_3d%var_names_chem(n) ) ) )  THEN
-!
-!--          Read attributes for the fill value and level-of-detail
-             CALL get_attribute( id_dynamic, char_fill, init_3d%fill_chem(n), .FALSE.,             &
-                                 TRIM( init_3d%var_names_chem(n) ) )
-             CALL get_attribute( id_dynamic, char_lod, init_3d%lod_chem(n), .FALSE.,               &
-                                 TRIM( init_3d%var_names_chem(n) ) )
-!
-!--          Give message that only LOD=1 is allowed.
-             IF ( init_3d%lod_chem(n) /= 1 )  THEN
-                message_string = 'For chemistry variables only LOD=1 is ' // 'allowed.'
-                CALL message( 'netcdf_data_input_mod', 'PA0586', 1, 2, 0, 6, 0 )
-             ENDIF
-!
-!--          level-of-detail 1 - read initialization profile
-             CALL get_variable( id_dynamic, TRIM( init_3d%var_names_chem(n) ),                     &
-                                init_3d%chem_init(nzb+1:nzt,n) )
-!
-!--          Set bottom and top boundary condition (Neumann)
-             init_3d%chem_init(nzb,n)   = init_3d%chem_init(nzb+1,n)
-             init_3d%chem_init(nzt+1,n) = init_3d%chem_init(nzt,n)
-             init_3d%from_file_chem(n)  = .TRUE.
-          ENDIF
-       ENDDO
-    ENDIF
-!
-!-- Close input file
-    CALL close_input_file( id_dynamic )
-#endif
-!
-!-- End of CPU measurement
-    CALL cpu_log( log_point_s(85), 'NetCDF input init', 'stop' )
-!
-!-- Finally, check if the input data has any fill values. Please note, checks depend on the LOD of
-!-- the input data.
-    IF ( init_3d%from_file_u )  THEN
-       check_passed = .TRUE.
-       IF ( init_3d%lod_u == 1 )  THEN
-          IF ( ANY( init_3d%u_init(nzb+1:nzt+1) == init_3d%fill_u ) )  check_passed = .FALSE.
-       ELSEIF ( init_3d%lod_u == 2 )  THEN
-          IF ( ANY( u(nzb+1:nzt+1,nys:nyn,nxlu:nxr) == init_3d%fill_u ) )  check_passed = .FALSE.
-       ENDIF
-       IF ( .NOT. check_passed )  THEN
-          message_string = 'NetCDF input for init_atmosphere_u must ' //                           &
-                           'not contain any _FillValues'
-          CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    IF ( init_3d%from_file_v )  THEN
-       check_passed = .TRUE.
-       IF ( init_3d%lod_v == 1 )  THEN
-          IF ( ANY( init_3d%v_init(nzb+1:nzt+1) == init_3d%fill_v ) )  check_passed = .FALSE.
-       ELSEIF ( init_3d%lod_v == 2 )  THEN
-          IF ( ANY( v(nzb+1:nzt+1,nysv:nyn,nxl:nxr) == init_3d%fill_v ) )  check_passed = .FALSE.
-       ENDIF
-       IF ( .NOT. check_passed )  THEN
-          message_string = 'NetCDF input for init_atmosphere_v must ' //                           &
-                           'not contain any _FillValues'
-          CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    IF ( init_3d%from_file_w )  THEN
-       check_passed = .TRUE.
-       IF ( init_3d%lod_w == 1 )  THEN
-          IF ( ANY( init_3d%w_init(nzb+1:nzt) == init_3d%fill_w ) )  check_passed = .FALSE.
-       ELSEIF ( init_3d%lod_w == 2 )  THEN
-          IF ( ANY( w(nzb+1:nzt,nys:nyn,nxl:nxr) == init_3d%fill_w ) )  check_passed = .FALSE.
-       ENDIF
-       IF ( .NOT. check_passed )  THEN
-          message_string = 'NetCDF input for init_atmosphere_w must ' //                           &
-                           'not contain any _FillValues'
-          CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    IF ( init_3d%from_file_pt )  THEN
-       check_passed = .TRUE.
-       IF ( init_3d%lod_pt == 1 )  THEN
-          IF ( ANY( init_3d%pt_init(nzb+1:nzt+1) == init_3d%fill_pt ) )  check_passed = .FALSE.
-       ELSEIF ( init_3d%lod_pt == 2 )  THEN
-          IF ( ANY( pt(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_pt ) )  check_passed = .FALSE.
-       ENDIF
-       IF ( .NOT. check_passed )  THEN
-          message_string = 'NetCDF input for init_atmosphere_pt must ' //                          &
-                           'not contain any _FillValues'
-          CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    IF ( init_3d%from_file_q )  THEN
-       check_passed = .TRUE.
-       IF ( init_3d%lod_q == 1 )  THEN
-          IF ( ANY( init_3d%q_init(nzb+1:nzt+1) == init_3d%fill_q ) )  check_passed = .FALSE.
-       ELSEIF ( init_3d%lod_q == 2 )  THEN
-          IF ( ANY( q(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_q ) )  check_passed = .FALSE.
-       ENDIF
-       IF ( .NOT. check_passed )  THEN
-          message_string = 'NetCDF input for init_atmosphere_q must ' //                           &
-                           'not contain any _FillValues'
-          CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-!
-!-- Workaround for cyclic conditions. Please see above for further explanation.
-    IF ( bc_lr_cyc  .AND.  nxl == 0 )  nxlu = nxl
-    IF ( bc_ns_cyc  .AND.  nys == 0 )  nysv = nys
-
- END SUBROUTINE netcdf_data_input_init_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Checks input file for consistency and minimum requirements.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_data_input_check_dynamic
-
-    USE control_parameters,                                                                        &
-        ONLY:  initializing_actions, message_string
-
-    IMPLICIT NONE
-!
-!-- Dynamic input file must also be present if initialization via inifor is prescribed.
-    IF ( .NOT. input_pids_dynamic  .AND.  INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
-       message_string = 'initializing_actions = inifor requires dynamic ' //                       &
-                        'input file ' // TRIM( input_file_dynamic ) // TRIM( coupling_char )
-       CALL message( 'netcdf_data_input_mod', 'PA0547', 1, 2, 0, 6, 0 )
-    ENDIF
-
- END SUBROUTINE netcdf_data_input_check_dynamic
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Checks input file for consistency and minimum requirements.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_data_input_check_static
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zu
-
-    USE control_parameters,                                                                        &
-        ONLY:  land_surface, message_string, urban_surface
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nyn, nys, wall_flags_total_0
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !< loop index along x-direction
-    INTEGER(iwp) ::  j       !< loop index along y-direction
-    INTEGER(iwp) ::  n_surf  !< number of different surface types at given location
-
-    LOGICAL      ::  check_passed  !< flag indicating if a check passed
-
-!
-!-- Return if no static input file is available
-    IF ( .NOT. input_pids_static )  RETURN
-!
-!-- Check for correct dimension of surface_fractions, should run from 0-2.
-    IF ( surface_fraction_f%from_file )  THEN
-       IF ( surface_fraction_f%nf-1 > 2 )  THEN
-          message_string = 'nsurface_fraction must not be larger than 3.'
-          CALL message( 'netcdf_data_input_mod', 'PA0580', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-!
-!-- If 3D buildings are read, check if building information is consistent to numeric grid.
-    IF ( buildings_f%from_file )  THEN
-       IF ( buildings_f%lod == 2 )  THEN
-          IF ( buildings_f%nz > SIZE( zu ) )  THEN
-             message_string = 'Reading 3D building data - too much ' //                            &
-                              'data points along the vertical coordinate.'
-             CALL message( 'netcdf_data_input_mod', 'PA0552', 2, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( ANY( ABS( buildings_f%z(0:buildings_f%nz-1) - zu(0:buildings_f%nz-1) ) > 1E-6_wp ) )&
-          THEN
-             message_string = 'Reading 3D building data - vertical ' //                            &
-                              'coordinate do not match numeric grid.'
-             CALL message( 'netcdf_data_input_mod', 'PA0553', 2, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-
-!
-!-- Skip further checks concerning buildings and natural surface properties if no urban surface and
-!-- land surface model are applied.
-    IF (  .NOT. land_surface  .AND.  .NOT. urban_surface )  RETURN
-!
-!-- Check for minimum requirement of surface-classification data in case static input file is used.
-    IF ( ( .NOT. vegetation_type_f%from_file .OR.                                                  &
-           .NOT. pavement_type_f%from_file   .OR.                                                  &
-           .NOT. water_type_f%from_file      .OR.                                                  &
-           .NOT. soil_type_f%from_file            )  .OR.                                          &
-          ( urban_surface  .AND.  .NOT. building_type_f%from_file ) )  THEN
-       message_string = 'Minimum requirement for surface classification is not fulfilled. At ' //  &
-                        'least vegetation_type, pavement_type, soil_type and water_type are ' //   &
-                        'required. If urban-surface model is applied, also building_type is required'
-       CALL message( 'netcdf_data_input_mod', 'PA0554', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check for general availability of input variables.
-!-- If vegetation_type is 0 at any location, vegetation_pars as well as root_area_dens_s are
-!-- required.
-    IF ( vegetation_type_f%from_file )  THEN
-       IF ( ANY( vegetation_type_f%var == 0 ) )  THEN
-          IF ( .NOT. vegetation_pars_f%from_file )  THEN
-             message_string = 'If vegetation_type = 0 at any location, ' //                        &
-                              'vegetation_pars is required'
-             CALL message( 'netcdf_data_input_mod', 'PA0555', 2, 2, myid, 6, 0 )
-          ENDIF
-          IF ( .NOT. root_area_density_lsm_f%from_file )  THEN
-             message_string = 'If vegetation_type = 0 at any location, ' //                        &
-                              'root_area_dens_s is required'
-             CALL message( 'netcdf_data_input_mod', 'PA0556', 2, 2, myid, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- If soil_type is zero at any location, soil_pars is required.
-    IF ( soil_type_f%from_file )  THEN
-       check_passed = .TRUE.
-       IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
-          IF ( ANY( soil_type_f%var_2d == 0 ) )  THEN
-             IF ( .NOT. soil_pars_f%from_file )  check_passed = .FALSE.
-          ENDIF
-       ELSE
-          IF ( ANY( soil_type_f%var_3d == 0 ) )  THEN
-             IF ( .NOT. soil_pars_f%from_file )  check_passed = .FALSE.
-          ENDIF
-       ENDIF
-       IF ( .NOT. check_passed )  THEN
-          message_string = 'If soil_type = 0 at any location, soil_pars is required'
-          CALL message( 'netcdf_data_input_mod', 'PA0557', 2, 2, myid, 6, 0 )
-       ENDIF
-    ENDIF
-!
-!-- Buildings require a type in case of urban-surface model.
-    IF ( buildings_f%from_file  .AND.  .NOT. building_type_f%from_file  )  THEN
-       message_string = 'If buildings are provided, also building_type is required'
-       CALL message( 'netcdf_data_input_mod', 'PA0581', 2, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Buildings require an ID.
-    IF ( buildings_f%from_file  .AND.  .NOT. building_id_f%from_file  )  THEN
-       message_string = 'If buildings are provided, also building_id is required'
-       CALL message( 'netcdf_data_input_mod', 'PA0582', 2, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- If building_type is zero at any location, building_pars is required.
-    IF ( building_type_f%from_file )  THEN
-       IF ( ANY( building_type_f%var == 0 ) )  THEN
-          IF ( .NOT. building_pars_f%from_file )  THEN
-             message_string = 'If building_type = 0 at any location, ' //                          &
-                              'building_pars is required'
-             CALL message( 'netcdf_data_input_mod', 'PA0558', 2, 2, myid, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- If building_type is provided, also building_id is needed (due to the filtering algorithm).
-    IF ( building_type_f%from_file  .AND.  .NOT. building_id_f%from_file )  THEN
-       message_string = 'If building_type is provided, also building_id is required'
-       CALL message( 'netcdf_data_input_mod', 'PA0519', 2, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- If albedo_type is zero at any location, albedo_pars is required.
-    IF ( albedo_type_f%from_file )  THEN
-       IF ( ANY( albedo_type_f%var == 0 ) )  THEN
-          IF ( .NOT. albedo_pars_f%from_file )  THEN
-             message_string = 'If albedo_type = 0 at any location, albedo_pars is required'
-             CALL message( 'netcdf_data_input_mod', 'PA0559', 2, 2, myid, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- If pavement_type is zero at any location, pavement_pars is required.
-    IF ( pavement_type_f%from_file )  THEN
-       IF ( ANY( pavement_type_f%var == 0 ) )  THEN
-          IF ( .NOT. pavement_pars_f%from_file )  THEN
-             message_string = 'If pavement_type = 0 at any location, pavement_pars is required'
-             CALL message( 'netcdf_data_input_mod', 'PA0560', 2, 2, myid, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- If pavement_type is zero at any location, also pavement_subsurface_pars is required.
-    IF ( pavement_type_f%from_file )  THEN
-       IF ( ANY( pavement_type_f%var == 0 ) )  THEN
-          IF ( .NOT. pavement_subsurface_pars_f%from_file )  THEN
-             message_string = 'If pavement_type = 0 at any location, ' //                          &
-                              'pavement_subsurface_pars is required'
-             CALL message( 'netcdf_data_input_mod', 'PA0561', 2, 2, myid, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- If water_type is zero at any location, water_pars is required.
-    IF ( water_type_f%from_file )  THEN
-       IF ( ANY( water_type_f%var == 0 ) )  THEN
-          IF ( .NOT. water_pars_f%from_file )  THEN
-             message_string = 'If water_type = 0 at any location, water_pars is required'
-             CALL message( 'netcdf_data_input_mod', 'PA0562', 2, 2, myid, 6, 0 )
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- Check for local consistency of the input data.
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-!
-!--       For each (y,x)-location at least one of the parameters vegetation_type, pavement_type,
-!--       building_type, or water_type must be set to a nonÂ­missing value.
-          IF ( land_surface  .AND.  .NOT. urban_surface )  THEN
-             IF ( vegetation_type_f%var(j,i) == vegetation_type_f%fill  .AND.                      &
-                  pavement_type_f%var(j,i)   == pavement_type_f%fill    .AND.                      &
-                  water_type_f%var(j,i)      == water_type_f%fill )  THEN
-                WRITE( message_string, * ) 'At least one of the parameters '//                     &
-                                           'vegetation_type, pavement_type, ' //                   &
-                                           'or water_type must be set '//                          &
-                                           'to a non-missing value. Grid point: ', j, i
-                CALL message( 'netcdf_data_input_mod', 'PA0563', 2, 2, myid, 6, 0 )
-             ENDIF
-          ELSEIF ( land_surface  .AND.  urban_surface )  THEN
-             IF ( vegetation_type_f%var(j,i) == vegetation_type_f%fill  .AND.                      &
-                  pavement_type_f%var(j,i)   == pavement_type_f%fill    .AND.                      &
-                  building_type_f%var(j,i)   == building_type_f%fill    .AND.                      &
-                  water_type_f%var(j,i)      == water_type_f%fill )  THEN
-                WRITE( message_string, * ) 'At least one of the parameters '//                     &
-                                           'vegetation_type, pavement_type, '  //                  &
-                                           'building_type, or water_type must be set '//           &
-                                           'to a non-missing value. Grid point: ', j, i
-                CALL message( 'netcdf_data_input_mod', 'PA0563', 2, 2, myid, 6, 0 )
-             ENDIF
-          ENDIF
-
-!
-!--       Note that a soil_type is required for each location (y,x) where either vegetation_type or
-!--       pavement_type is a nonÂ­missing value.
-          IF ( ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill  .OR.                        &
-                 pavement_type_f%var(j,i)   /= pavement_type_f%fill ) )  THEN
-             check_passed = .TRUE.
-             IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
-                IF ( soil_type_f%var_2d(j,i) == soil_type_f%fill )  check_passed = .FALSE.
-             ELSE
-                IF ( ANY( soil_type_f%var_3d(:,j,i) == soil_type_f%fill) )  check_passed = .FALSE.
-             ENDIF
-
-             IF ( .NOT. check_passed )  THEN
-                message_string = 'soil_type is required for each '//                               &
-                                 'location (y,x) where vegetation_type or ' //                     &
-                                 'pavement_type is a non-missing value.'
-                CALL message( 'netcdf_data_input_mod', 'PA0564', 2, 2, myid, 6, 0 )
-             ENDIF
-          ENDIF
-!
-!--       Check for consistency of given types. At the moment, only one of vegetation, pavement, or
-!--       water-type can be set. This is because no tile approach is yet implemented in the
-!--       land-surface model. Later, when this is possible, surface fraction needs to be given and
-!--       the sum must not be larger than 1. Please note, in case more than one type is given at a
-!--       pixel, an error message will be given.
-          n_surf = 0
-          IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill )  n_surf = n_surf + 1
-          IF ( water_type_f%var(j,i)      /= water_type_f%fill      )  n_surf = n_surf + 1
-          IF ( pavement_type_f%var(j,i)   /= pavement_type_f%fill   )  n_surf = n_surf + 1
-
-          IF ( n_surf > 1 )  THEN
-             WRITE( message_string, * ) 'More than one surface type (vegetation, ' //              &
-                                        'pavement, water) is given at a location. ' //             &
-                                        'Please note, this is not possible at ' //                 &
-                                        'the moment as no tile approach has been ' // &
-                                        'yet implemented. (i,j) = ', i, j
-             CALL message( 'netcdf_data_input_mod', 'PA0565',               &
-                            2, 2, myid, 6, 0 )
-
-!              IF ( .NOT. surface_fraction_f%from_file )  THEN
-!                 message_string = 'More than one surface type (vegetation '//                     &
-!                                  'pavement, water) is given at a location. '//                   &
-!                                  'Please note, this is not possible at ' //                      &
-!                                  'the moment as no tile approach is yet ' //                     &
-!                                  'implemented.'
-!                 message_string = 'If more than one surface type is ' //                          &
-!                                  'given at a location, surface_fraction ' //                     &
-!                                  'must be provided.'
-!                 CALL message( 'netcdf_data_input_mod', 'PA0565', 2, 2, myid, 6, 0 )
-!              ELSEIF ( ANY ( surface_fraction_f%frac(:,j,i) ==  surface_fraction_f%fill ) )  THEN
-!                 message_string = 'If more than one surface type is ' //                          &
-!                                  'given at a location, surface_fraction ' //                     &
-!                                  'must be provided.'
-!                 CALL message( 'netcdf_data_input_mod', 'PA0565', 2, 2, myid, 6, 0 )
-!              ENDIF
-          ENDIF
-!
-!--       Check for further mismatches. e.g. relative fractions exceed 1 or vegetation_type is set
-!--       but surface vegetation fraction is zero, etc..
-          IF ( surface_fraction_f%from_file )  THEN
-!
-!--          If surface fractions is given, also check that only one type is given.
-             IF ( SUM( MERGE( 1, 0, surface_fraction_f%frac(:,j,i) /= 0.0_wp  .AND.                &
-                                    surface_fraction_f%frac(:,j,i) /= surface_fraction_f%fill )    &
-                     ) > 1 )                                                                       &
-             THEN
-                WRITE( message_string, * ) 'surface_fraction is given for more ' //                &
-                                           'than one type. ' //                                    &
-                                           'Please note, this is not possible at ' //              &
-                                           'the moment as no tile approach has ' //                &
-                                           'yet been implemented. (i, j) = ', i, j
-                CALL message( 'netcdf_data_input_mod', 'PA0676', 2, 2, myid, 6, 0 )
-             ENDIF
-!
-!--          Sum of relative fractions must be 1. Note, attributed to type conversions due to
-!--          reading, the sum of surface fractions might be not exactly 1. Hence, the sum is check
-!--          with a tolerance. Later, in the land-surface model, the relative fractions are
-!--          normalized to one. Actually, surface fractions shall be _FillValue at building grid
-!--          points, however, in order to relax this requirement and allow that surface-fraction can
-!--          also be zero at these grid points, only perform this check at locations where some
-!--          vegetation, pavement or water is defined.
-             IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill  .OR.                       &
-                  pavement_type_f%var(j,i)   /= pavement_type_f%fill    .OR.                       &
-                  water_type_f%var(j,i)      /= water_type_f%fill )  THEN
-                IF ( SUM ( surface_fraction_f%frac(0:2,j,i) ) > 1.0_wp + 1E-8_wp  .OR.             &
-                     SUM ( surface_fraction_f%frac(0:2,j,i) ) < 1.0_wp - 1E-8_wp )  THEN
-                   WRITE( message_string, * ) 'The sum of all land-surface fractions ' //          &
-                                              'must equal 1. (i, j) = ', i, j
-                   CALL message( 'netcdf_data_input_mod', 'PA0566', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDIF
-!
-!--          Relative fraction for a type must not be zero at locations where this type is set.
-             IF ( ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill  .AND.                    &
-                    ( surface_fraction_f%frac(ind_veg_wall,j,i) == 0.0_wp .OR.                     &
-                      surface_fraction_f%frac(ind_veg_wall,j,i) == surface_fraction_f%fill )       &
-                  )  .OR.                                                                          &
-                  ( pavement_type_f%var(j,i) /= pavement_type_f%fill       .AND.                   &
-                    ( surface_fraction_f%frac(ind_pav_green,j,i) == 0.0_wp .OR.                    &
-                      surface_fraction_f%frac(ind_pav_green,j,i) == surface_fraction_f%fill )      &
-                  )  .OR.                                                                          &
-                  ( water_type_f%var(j,i) /= water_type_f%fill             .AND.                   &
-                   ( surface_fraction_f%frac(ind_wat_win,j,i) == 0.0_wp      .OR.                  &
-                     surface_fraction_f%frac(ind_wat_win,j,i) == surface_fraction_f%fill )         &
-                  ) )  THEN
-                WRITE( message_string, * ) 'Mismatch in setting of '     //                        &
-                                           'surface_fraction. Vegetation-, pavement-, or ' //      &
-                                           'water surface is given at (i,j) = ( ', i, j,           &
-                                           ' ), but surface fraction is 0 for the given type.'
-                CALL message( 'netcdf_data_input_mod', 'PA0567', 2, 2, myid, 6, 0 )
-             ENDIF
-!
-!--          Relative fraction for a type must not contain non-zero values if this type is not set.
-             IF ( ( vegetation_type_f%var(j,i) == vegetation_type_f%fill    .AND.                  &
-                    ( surface_fraction_f%frac(ind_veg_wall,j,i) /= 0.0_wp   .AND.                  &
-                      surface_fraction_f%frac(ind_veg_wall,j,i) /= surface_fraction_f%fill )       &
-                  )  .OR.                                                                          &
-                  ( pavement_type_f%var(j,i) == pavement_type_f%fill        .AND.                  &
-                    ( surface_fraction_f%frac(ind_pav_green,j,i) /= 0.0_wp .AND.                   &
-                      surface_fraction_f%frac(ind_pav_green,j,i) /= surface_fraction_f%fill )      &
-                  )  .OR.                                                                          &
-                  ( water_type_f%var(j,i) == water_type_f%fill           .AND.                     &
-                    ( surface_fraction_f%frac(ind_wat_win,j,i) /= 0.0_wp .AND.                     &
-                      surface_fraction_f%frac(ind_wat_win,j,i) /= surface_fraction_f%fill )        &
-                  ) )  THEN
-                WRITE( message_string, * ) 'Mismatch in setting of '     //                        &
-                                           'surface_fraction. Vegetation-, pavement-, or '//       &
-                                           'water surface is not given at (i,j) = ( ', i, j,       &
-                                           ' ), but surface fraction is not 0 for the ' //         &
-                                           'given type.'
-                CALL message( 'netcdf_data_input_mod', 'PA0568', 2, 2, myid, 6, 0 )
-             ENDIF
-          ENDIF
-!
-!--       Check vegetation_pars. If vegetation_type is 0, all parameters need to be set, otherwise,
-!--       single parameters set by vegetation_type can be overwritten.
-          IF ( vegetation_type_f%from_file )  THEN
-             IF ( vegetation_type_f%var(j,i) == 0 )  THEN
-                IF ( ANY( vegetation_pars_f%pars_xy(:,j,i) == vegetation_pars_f%fill ) )  THEN
-                   message_string = 'If vegetation_type(y,x) = 0, all '  //                        &
-                                    'parameters of vegetation_pars at ' //                         &
-                                    'this location must be set.'
-                   CALL message( 'netcdf_data_input_mod', 'PA0569', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDIF
-          ENDIF
-!
-!--       Check root distribution. If vegetation_type is 0, all levels must be set.
-          IF ( vegetation_type_f%from_file )  THEN
-             IF ( vegetation_type_f%var(j,i) == 0 )  THEN
-                IF ( ANY( root_area_density_lsm_f%var(:,j,i) == root_area_density_lsm_f%fill ) )   &
-                THEN
-                   message_string = 'If vegetation_type(y,x) = 0, all ' //                         &
-                                    'levels of root_area_dens_s ' //                               &
-                                    'must be set at this location.'
-                   CALL message( 'netcdf_data_input_mod', 'PA0570', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDIF
-          ENDIF
-!
-!--       Check soil parameters. If soil_type is 0, all parameters must be set.
-          IF ( soil_type_f%from_file )  THEN
-             check_passed = .TRUE.
-             IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
-                IF ( soil_type_f%var_2d(j,i) == 0 )  THEN
-                   IF ( ANY( soil_pars_f%pars_xy(:,j,i) == soil_pars_f%fill ) )                    &
-                      check_passed = .FALSE.
-                ENDIF
-             ELSE
-                IF ( ANY( soil_type_f%var_3d(:,j,i) == 0 ) )  THEN
-                   IF ( ANY( soil_pars_f%pars_xy(:,j,i) == soil_pars_f%fill ) )                    &
-                      check_passed = .FALSE.
-                ENDIF
-             ENDIF
-             IF ( .NOT. check_passed )  THEN
-                message_string = 'If soil_type(y,x) = 0, all levels of '  //                       &
-                                 'soil_pars at this location must be set.'
-                CALL message( 'netcdf_data_input_mod', 'PA0571', 2, 2, myid, 6, 0 )
-             ENDIF
-          ENDIF
-
-!
-!--       Check building parameters. If building_type is 0, all parameters must be set.
-          IF ( building_type_f%from_file )  THEN
-             IF ( building_type_f%var(j,i) == 0 )  THEN
-                IF ( ANY( building_pars_f%pars_xy(:,j,i) == building_pars_f%fill ) )  THEN
-                   message_string = 'If building_type(y,x) = 0, all ' //                           &
-                                    'parameters of building_pars at this ' //                      &
-                                    'location must be set.'
-                   CALL message( 'netcdf_data_input_mod', 'PA0572', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDIF
-          ENDIF
-!
-!--       Check if building_type is set at each building and vice versa.
-!--       Please note, buildings are already processed and filtered.
-!--       For this reason, consistency checks are based on wall_flags_total_0 rather than
-!--       buildings_f (buildings are represented by bit 6 in wall_flags_total_0).
-          IF ( building_type_f%from_file  .AND.  buildings_f%from_file )  THEN
-             IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) )  .AND.                             &
-                  building_type_f%var(j,i) == building_type_f%fill  .OR.                           &
-                  .NOT. ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) )  .AND.                       &
-                  building_type_f%var(j,i) /= building_type_f%fill )  THEN
-                WRITE( message_string, * ) 'Each location where a ' //                             &
-                                           'building is set requires a type ' //                   &
-                                           '( and vice versa ) in case the ' //                    &
-                                           'urban-surface model is applied. ' //                   &
-                                           'i, j = ', i, j
-                CALL message( 'netcdf_data_input_mod', 'PA0573', 2, 2, myid, 6, 0 )
-             ENDIF
-          ENDIF
-!
-!--       Check if at each location where a building is present also an ID is set and vice versa.
-          IF ( buildings_f%from_file )  THEN
-             IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) )  .AND.                             &
-                  building_id_f%var(j,i) == building_id_f%fill  .OR.                               &
-                  .NOT. ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) )  .AND.                       &
-                  building_id_f%var(j,i) /= building_id_f%fill )  THEN
-                WRITE( message_string, * ) 'Each location where a ' //                             &
-                                           'building is set requires an ID ' //                    &
-                                           '( and vice versa ). i, j = ', i, j
-                CALL message( 'netcdf_data_input_mod', 'PA0574', 2, 2, myid, 6, 0 )
-             ENDIF
-          ENDIF
-!
-!--       Check if building ID is set where a bulding is defined.
-          IF ( buildings_f%from_file )  THEN
-             IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) )  .AND.                             &
-                  building_id_f%var(j,i) == building_id_f%fill )  THEN
-                WRITE( message_string, * ) 'Each building grid point ' // 'requires an ID.', i, j
-                CALL message( 'netcdf_data_input_mod', 'PA0575', 2, 2, myid, 6, 0 )
-             ENDIF
-          ENDIF
-!
-!--       Check albedo parameters. If albedo_type is 0, all parameters must be set.
-          IF ( albedo_type_f%from_file )  THEN
-             IF ( albedo_type_f%var(j,i) == 0 )  THEN
-                IF ( ANY( albedo_pars_f%pars_xy(:,j,i) == albedo_pars_f%fill ) )  THEN
-                   message_string = 'If albedo_type(y,x) = 0, all ' //                             &
-                                    'parameters of albedo_pars at this ' //                        &
-                                    'location must be set.'
-                   CALL message( 'netcdf_data_input_mod', 'PA0576', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDIF
-          ENDIF
-
-!
-!--       Check pavement parameters. If pavement_type is 0, all parameters of pavement_pars must be
-!--       set at this location.
-          IF ( pavement_type_f%from_file )  THEN
-             IF ( pavement_type_f%var(j,i) == 0 )  THEN
-                IF ( ANY( pavement_pars_f%pars_xy(:,j,i) == pavement_pars_f%fill ) )  THEN
-                   message_string = 'If pavement_type(y,x) = 0, all ' //                           &
-                                    'parameters of pavement_pars at this '//                       &
-                                    'location must be set.'
-                   CALL message( 'netcdf_data_input_mod', 'PA0577', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDIF
-          ENDIF
-!
-!--       Check pavement-subsurface parameters. If pavement_type is 0, all parameters of
-!--       pavement_subsurface_pars must be set at this location.
-          IF ( pavement_type_f%from_file )  THEN
-             IF ( pavement_type_f%var(j,i) == 0 )  THEN
-                IF ( ANY( pavement_subsurface_pars_f%pars_xyz(:,:,j,i) ==                          &
-                          pavement_subsurface_pars_f%fill ) )  THEN
-                   message_string = 'If pavement_type(y,x) = 0, all '   //                         &
-                                    'parameters of '                    //                         &
-                                    'pavement_subsurface_pars at this ' //                         &
-                                    'location must be set.'
-                   CALL message( 'netcdf_data_input_mod', 'PA0578', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDIF
-          ENDIF
-
-!
-!--       Check water parameters. If water_type is 0, all parameters must be set  at this location.
-          IF ( water_type_f%from_file )  THEN
-             IF ( water_type_f%var(j,i) == 0 )  THEN
-                IF ( ANY( water_pars_f%pars_xy(:,j,i) == water_pars_f%fill ) )  THEN
-                   message_string = 'If water_type(y,x) = 0, all ' //                              &
-                                    'parameters of water_pars at this ' //                         &
-                                    'location must be set.'
-                   CALL message( 'netcdf_data_input_mod', 'PA0579', 2, 2, myid, 6, 0 )
-                ENDIF
-             ENDIF
-          ENDIF
-
-       ENDDO
-    ENDDO
-
- END SUBROUTINE netcdf_data_input_check_static
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resize 8-bit 2D Integer array: (nys:nyn,nxl:nxr) -> (nysg:nyng,nxlg:nxrg)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE add_ghost_layers_2d_int8( var )
-
-    IMPLICIT NONE
-
-    INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE ::  var     !< treated variable
-    INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE ::  var_tmp !< temporary copy
-!
-!-- Allocate temporary variable
-    ALLOCATE( var_tmp(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Temporary copy of the variable
-    var_tmp(nys:nyn,nxl:nxr) = var(nys:nyn,nxl:nxr)
-!
-!-- Resize the array
-    DEALLOCATE( var )
-    ALLOCATE( var(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Transfer temporary copy back to original array
-    var(nys:nyn,nxl:nxr) = var_tmp(nys:nyn,nxl:nxr)
-
- END SUBROUTINE add_ghost_layers_2d_int8
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resize 32-bit 2D Integer array: (nys:nyn,nxl:nxr) -> (nysg:nyng,nxlg:nxrg)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE add_ghost_layers_2d_int32( var )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  var     !< treated variable
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  var_tmp !< temporary copy
-!
-!-- Allocate temporary variable
-    ALLOCATE( var_tmp(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Temporary copy of the variable
-    var_tmp(nys:nyn,nxl:nxr) = var(nys:nyn,nxl:nxr)
-!
-!-- Resize the array
-    DEALLOCATE( var )
-    ALLOCATE( var(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Transfer temporary copy back to original array
-    var(nys:nyn,nxl:nxr) = var_tmp(nys:nyn,nxl:nxr)
-
- END SUBROUTINE add_ghost_layers_2d_int32
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resize 2D float array: (nys:nyn,nxl:nxr) -> (nysg:nyng,nxlg:nxrg)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE add_ghost_layers_2d_real( var )
-
-    IMPLICIT NONE
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var     !< treated variable
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_tmp !< temporary copy
-!
-!-- Allocate temporary variable
-    ALLOCATE( var_tmp(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Temporary copy of the variable
-    var_tmp(nys:nyn,nxl:nxr) = var(nys:nyn,nxl:nxr)
-!
-!-- Resize the array
-    DEALLOCATE( var )
-    ALLOCATE( var(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Transfer temporary copy back to original array
-    var(nys:nyn,nxl:nxr) = var_tmp(nys:nyn,nxl:nxr)
-
- END SUBROUTINE add_ghost_layers_2d_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resize 8-bit 3D Integer array: (:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE add_ghost_layers_3d_int8( var, ks, ke )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ke  !< upper bound of treated array in z-direction
-    INTEGER(iwp) ::  ks  !< lower bound of treated array in z-direction
-
-    INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  var     !< treated variable
-    INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  var_tmp !< temporary copy
-!
-!-- Allocate temporary variable
-    ALLOCATE( var_tmp(ks:ke,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Temporary copy of the variable
-    var_tmp(ks:ke,nys:nyn,nxl:nxr) = var(ks:ke,nys:nyn,nxl:nxr)
-!
-!-- Resize the array
-    DEALLOCATE( var )
-    ALLOCATE( var(ks:ke,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Transfer temporary copy back to original array
-    var(ks:ke,nys:nyn,nxl:nxr) = var_tmp(ks:ke,nys:nyn,nxl:nxr)
-
- END SUBROUTINE add_ghost_layers_3d_int8
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resize 3D Real array: (:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE add_ghost_layers_3d_real( var, ks, ke )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ke  !< upper bound of treated array in z-direction
-    INTEGER(iwp) ::  ks  !< lower bound of treated array in z-direction
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  var     !< treated variable
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  var_tmp !< temporary copy
-!
-!-- Allocate temporary variable
-    ALLOCATE( var_tmp(ks:ke,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Temporary copy of the variable
-    var_tmp(ks:ke,nys:nyn,nxl:nxr) = var(ks:ke,nys:nyn,nxl:nxr)
-!
-!-- Resize the array
-    DEALLOCATE( var )
-    ALLOCATE( var(ks:ke,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Transfer temporary copy back to original array
-    var(ks:ke,nys:nyn,nxl:nxr) = var_tmp(ks:ke,nys:nyn,nxl:nxr)
-
- END SUBROUTINE add_ghost_layers_3d_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resize 4D Real array: (:,:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE add_ghost_layers_4d_real( var, k1s, k1e, k2s, k2e )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k1e  !< upper bound of treated array in z-direction
-    INTEGER(iwp) ::  k1s  !< lower bound of treated array in z-direction
-    INTEGER(iwp) ::  k2e  !< upper bound of treated array along parameter space
-    INTEGER(iwp) ::  k2s  !< lower bound of treated array along parameter space
-
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  var      !< treated variable
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  var_tmp  !< temporary copy
-!
-!-- Allocate temporary variable
-    ALLOCATE( var_tmp(k1s:k1e,k2s:k2e,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Temporary copy of the variable
-    var_tmp(k1s:k1e,k2s:k2e,nys:nyn,nxl:nxr) = var(k1s:k1e,k2s:k2e,nys:nyn,nxl:nxr)
-!
-!-- Resize the array
-    DEALLOCATE( var )
-    ALLOCATE( var(k1s:k1e,k2s:k2e,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
-!
-!-- Transfer temporary copy back to original array
-    var(k1s:k1e,k2s:k2e,nys:nyn,nxl:nxr) = var_tmp(k1s:k1e,k2s:k2e,nys:nyn,nxl:nxr)
-
- END SUBROUTINE add_ghost_layers_4d_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Checks if a given variables is on file
-!--------------------------------------------------------------------------------------------------!
- FUNCTION check_existence( vars_in_file, var_name )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  var_name                    !< variable to be checked
-    CHARACTER(LEN=*), DIMENSION(:) ::  vars_in_file  !< list of variables in file
-
-    INTEGER(iwp) ::  i                              !< loop variable
-
-    LOGICAL ::  check_existence                     !< flag indicating whether a variable exist or not - actual return value
-
-    i = 1
-    check_existence = .FALSE.
-    DO  WHILE ( i <= SIZE( vars_in_file ) )
-       check_existence = TRIM( vars_in_file(i) ) == TRIM( var_name )  .OR.  check_existence
-       i = i + 1
-    ENDDO
-
-    RETURN
-
- END FUNCTION check_existence
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Closes an existing netCDF file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE close_input_file( id )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(INOUT) ::  id  !< file id
-
-#if defined( __netcdf )
-    nc_stat = NF90_CLOSE( id )
-    CALL handle_error( 'close', 540 )
-#endif
-
- END SUBROUTINE close_input_file
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Opens an existing netCDF file for reading only and returns its id.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE open_read_file( filename, id )
-
-    USE control_parameters,                                                                        &
-        ONLY: message_string
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*), INTENT(IN) ::  filename    !< filename
-    INTEGER(iwp), INTENT(INOUT)   ::  id          !< file id
-    LOGICAL                       ::  file_exists !< true if file exists
-
-#if defined( __netcdf )
-!
-!-- Check if requested file exists
-    INQUIRE( FILE=filename, EXIST=file_exists )
-
-    IF ( .NOT. file_exists )  THEN
-       WRITE( message_string, * ) 'Required input file "' // filename // '" does not exist!'
-       CALL message( 'open_read_file', 'PA0516', 2, 2, 0, 6, 1 )
-    ENDIF
-
-#if defined( __netcdf4_parallel )
-!
-!-- If __netcdf4_parallel is defined, parrallel NetCDF will be used.
-    nc_stat = NF90_OPEN( filename, IOR( NF90_NOWRITE, NF90_MPIIO ), id, COMM = comm2d,             &
-                         INFO = MPI_INFO_NULL )
-!
-!-- In case the previous open call fails, check for possible Netcdf 3 file, and open it. However,
-!-- this case, disable parallel access.
-    IF( nc_stat /= NF90_NOERR )  THEN
-       nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id )
-       collective_read = .FALSE.
-    ELSE
-#if defined( __nec )
-       collective_read = .FALSE.   ! collective read causes hang situations on NEC Aurora
-#else
-       collective_read = .TRUE.
-#endif
-    ENDIF
-#else
-!
-!-- All MPI processes open the file and read it (but not in parallel).
-    nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id )
-#endif
-
-    CALL handle_error( 'open_read_file', 539 )
-
-#endif
- END SUBROUTINE open_read_file
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads global or variable-related attributes of type INTEGER (32-bit)
-!--------------------------------------------------------------------------------------------------!
-  SUBROUTINE get_attribute_int32( id, attribute_name, value, global, variable_name, no_abort )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)            ::  attribute_name   !< attribute name
-    CHARACTER(LEN=*), OPTIONAL  ::  variable_name    !< variable name
-
-    INTEGER(iwp), INTENT(IN)    ::  id               !< file id
-    INTEGER(iwp)                ::  id_var           !< variable id
-    INTEGER(iwp), INTENT(INOUT) ::  value            !< read value
-
-    LOGICAL                       ::  check_error    !< flag indicating if handle_error shall be checked
-    LOGICAL, INTENT(IN)           ::  global         !< flag indicating global attribute
-    LOGICAL, INTENT(IN), OPTIONAL ::  no_abort       !< flag indicating if errors should be checked
-#if defined( __netcdf )
-
-    IF ( PRESENT( no_abort ) )  THEN
-       check_error = no_abort
-    ELSE
-       check_error = .TRUE.
-    ENDIF
-!
-!-- Read global attribute
-    IF ( global )  THEN
-       nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
-       IF ( check_error)  CALL handle_error( 'get_attribute_int32 global', 522, attribute_name )
-!
-!-- Read attributes referring to a single variable. Therefore, first inquire variable id
-    ELSE
-       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-       IF ( check_error)  CALL handle_error( 'get_attribute_int32', 522, attribute_name )
-       nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
-       IF ( check_error)  CALL handle_error( 'get_attribute_int32', 522, attribute_name )
-    ENDIF
-#endif
-
- END SUBROUTINE get_attribute_int32
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads global or variable-related attributes of type INTEGER (8-bit)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_attribute_int8( id, attribute_name, value, global, variable_name, no_abort )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)            ::  attribute_name   !< attribute name
-    CHARACTER(LEN=*), OPTIONAL  ::  variable_name    !< variable name
-
-    INTEGER(iwp), INTENT(IN)    ::  id               !< file id
-    INTEGER(iwp)                ::  id_var           !< variable id
-    INTEGER(KIND=1), INTENT(INOUT) ::  value         !< read value
-
-    LOGICAL                       ::  check_error    !< flag indicating if handle_error shall be checked
-    LOGICAL, INTENT(IN), OPTIONAL ::  no_abort       !< flag indicating if errors should be checked
-    LOGICAL, INTENT(IN)           ::  global         !< flag indicating global attribute
-#if defined( __netcdf )
-
-    IF ( PRESENT( no_abort ) )  THEN
-       check_error = no_abort
-    ELSE
-       check_error = .TRUE.
-    ENDIF
-!
-!-- Read global attribute
-    IF ( global )  THEN
-       nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
-       IF ( check_error)  CALL handle_error( 'get_attribute_int8 global', 523, attribute_name )
-!
-!-- Read attributes referring to a single variable. Therefore, first inquire variable id
-    ELSE
-       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-       IF ( check_error)  CALL handle_error( 'get_attribute_int8', 523, attribute_name )
-       nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
-       IF ( check_error)  CALL handle_error( 'get_attribute_int8', 523, attribute_name )
-    ENDIF
-#endif
-
- END SUBROUTINE get_attribute_int8
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads global or variable-related attributes of type REAL
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_attribute_real( id, attribute_name, value, global, variable_name, no_abort )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)            ::  attribute_name   !< attribute name
-    CHARACTER(LEN=*), OPTIONAL  ::  variable_name    !< variable name
-
-    INTEGER(iwp), INTENT(IN)    ::  id               !< file id
-    INTEGER(iwp)                ::  id_var           !< variable id
-
-    LOGICAL                       ::  check_error    !< flag indicating if handle_error shall be checked
-    LOGICAL, INTENT(IN)           ::  global         !< flag indicating global attribute
-    LOGICAL, INTENT(IN), OPTIONAL ::  no_abort       !< flag indicating if errors should be checked
-
-    REAL(wp), INTENT(INOUT)     ::  value            !< read value
-#if defined( __netcdf )
-
-    IF ( PRESENT( no_abort ) )  THEN
-       check_error = no_abort
-    ELSE
-       check_error = .TRUE.
-    ENDIF
-!
-!-- Read global attribute
-    IF ( global )  THEN
-       nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
-       IF ( check_error)  CALL handle_error( 'get_attribute_real global', 524, attribute_name )
-!
-!-- Read attributes referring to a single variable. Therefore, first inquire variable id
-    ELSE
-       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-       IF ( check_error)  CALL handle_error( 'get_attribute_real', 524, attribute_name )
-       nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
-       IF ( check_error)  CALL handle_error( 'get_attribute_real', 524, attribute_name )
-    ENDIF
-#endif
-
- END SUBROUTINE get_attribute_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads global or variable-related attributes of type CHARACTER
-!> Remark: reading attributes of type NF_STRING return an error code 56 -
-!> Attempt to convert between text & numbers.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_attribute_string( id, attribute_name, value, global, variable_name, no_abort )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)                ::  attribute_name   !< attribute name
-    CHARACTER(LEN=*), INTENT(INOUT) ::  value            !< read value
-    CHARACTER(LEN=*), OPTIONAL      ::  variable_name    !< variable name
-
-    INTEGER(iwp), INTENT(IN)    ::  id               !< file id
-    INTEGER(iwp)                ::  id_var           !< variable id
-
-    LOGICAL ::  check_error                          !< flag indicating if handle_error shall be checked
-    LOGICAL, INTENT(IN) ::  global                   !< flag indicating global attribute
-    LOGICAL, INTENT(IN), OPTIONAL ::  no_abort       !< flag indicating if errors should be checked
-#if defined( __netcdf )
-
-    IF ( PRESENT( no_abort ) )  THEN
-       check_error = no_abort
-    ELSE
-       check_error = .TRUE.
-    ENDIF
-!
-!-- Read global attribute
-    IF ( global )  THEN
-       nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
-       IF ( check_error)  CALL handle_error( 'get_attribute_string global', 525, attribute_name )
-!
-!-- Read attributes referring to a single variable. Therefore, first inquire variable id
-    ELSE
-       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-       IF ( check_error)  CALL handle_error( 'get_attribute_string', 525, attribute_name )
-
-       nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
-       IF ( check_error)  CALL handle_error( 'get_attribute_string',525, attribute_name )
-
-    ENDIF
-#endif
-
- END SUBROUTINE get_attribute_string
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Get dimension array for a given dimension
-!--------------------------------------------------------------------------------------------------!
-  SUBROUTINE get_dimension_length( id, dim_len, variable_name )
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100)          ::  dum              !< dummy variable to receive return character
-    CHARACTER(LEN=*)            ::  variable_name    !< dimension name
-
-    INTEGER(iwp)                ::  dim_len          !< dimension size
-    INTEGER(iwp), INTENT(IN)    ::  id               !< file id
-    INTEGER(iwp)                ::  id_dim           !< dimension id
-
-#if defined( __netcdf )
-!
-!-- First, inquire dimension ID
-    nc_stat = NF90_INQ_DIMID( id, TRIM( variable_name ), id_dim )
-    CALL handle_error( 'get_dimension_length', 526, variable_name )
-!
-!-- Inquire dimension length
-    nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, dum, LEN = dim_len )
-    CALL handle_error( 'get_dimension_length', 526, variable_name )
-
-#endif
-
- END SUBROUTINE get_dimension_length
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Routine for reading-in a character string from the chem emissions netcdf input file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_string( id, variable_name, var_string, names_number )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*)                                             :: variable_name    !< variable name
-    CHARACTER (LEN=25), ALLOCATABLE, DIMENSION(:), INTENT(INOUT)  :: var_string
-    CHARACTER (LEN=1), ALLOCATABLE, DIMENSION(:,:)                :: tmp_var_string   !< variable to be read
-
-    INTEGER(iwp)              :: i,j                    !< index to go through the length of the dimensions
-    INTEGER(iwp), INTENT(IN)  :: id                     !< file id
-    INTEGER(iwp)              :: id_var                 !< variable id
-    INTEGER(iwp), INTENT(IN)  :: names_number           !< number of names
-    INTEGER(iwp)              :: max_string_length=25   !< this is both the maximum length of a name, but also the number of the
-                                                        !< components of the first dimensions (rows)
-#if defined( __netcdf )
-
-    ALLOCATE( tmp_var_string(max_string_length,names_number) )
-
-    ALLOCATE( var_string(names_number) )
-
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-
-!
-!-- Get variable
-!-- Start cycle over the emission species
-    DO  i = 1, names_number
-!
-!--    Read the first letter of each component
-       nc_stat = NF90_GET_VAR( id, id_var, var_string(i), start = (/ 1,i /), count = (/ 1,1 /) )
-       CALL handle_error( 'get_variable_string', 701 )
-!
-!--    Start cycle over charachters
-       DO  j = 1, max_string_length
-!
-!--       Read the rest of the components of the name
-          nc_stat = NF90_GET_VAR( id, id_var, tmp_var_string(j,i), start = (/ j,i /),              &
-                                  count = (/ 1,1 /) )
-          CALL handle_error( 'get_variable_string', 702 )
-
-          IF ( IACHAR( tmp_var_string(j,i) ) == 0 )  THEN
-               tmp_var_string(j,i)=''
-          ENDIF
-
-          IF ( j>1 )  THEN
-!
-!--          Concatenate first letter of the name and the others
-             var_string(i)=TRIM( var_string(i) ) // TRIM( tmp_var_string(j,i) )
-          ENDIF
-       ENDDO
-    ENDDO
-
-#endif
-
- END SUBROUTINE get_variable_string
-
-
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Generalized routine for reading strings from a netCDF variable to replace existing
-!> get_variable_string ( )
-!>
-!> Improvements:
-!>   - Expanded string size limit from 25 to 512
-!>   - No longer removes spaces between text magically (this seems to have been aimed at a very
-!>     specific application, but I don't know what)
-!>   - Simplified implementation
-!>
-!> Caveats:
-!>   - Somehow I could not get the subroutine to work with str_array(:,:) so I reverted to a
-!>     hard-coded str_array(:,512), hopefully large enough for most general applications. This also
-!>     means the character variable used for str_array must be of size (:,512)
-!>     (ecc 20200128)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_string_generic ( id, var_name, str_array, num_str, str_len )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*),                INTENT(IN)    :: var_name       !< netCDF variable name
-    CHARACTER(LEN=512), ALLOCATABLE, INTENT(INOUT) :: str_array(:)   !< output string array
-
-    INTEGER(iwp)              :: buf_len   !< string buffer size
-    INTEGER(iwp)              :: id_var    !< netCDF variable ID
-    INTEGER(iwp), INTENT(IN)  :: id        !< netCDF file ID
-    INTEGER(iwp)              :: k         !< generic counter
-    INTEGER(iwp), INTENT(IN)  :: num_str   !< number of string elements in array
-    INTEGER(iwp), INTENT(IN)  :: str_len   !< size of each string element
-
-#if defined( __netcdf )
-
-!
-!-- Set buffer length to up to hard-coded string size
-    buf_len = MIN( ABS(str_len), 512 )
-
-!
-!-- Allocate necessary memories for string variables
-    ALLOCATE( str_array(num_str) )
-!
-!-- Get variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM(var_name), id_var )
-!
-!-- Extract string variables
-    DO  k = 1, num_str
-       str_array(k) = ''
-       nc_stat = NF90_GET_VAR( id, id_var, str_array(k), start = (/ 1, k /),                       &
-                               count = (/ buf_len, 1 /)  )
-       CALL handle_error ( 'get_variable_string_generic', 702 )
-    ENDDO
-
-#endif
-
- END SUBROUTINE get_variable_string_generic
-
-
-!--------------------------------------------------------------------------------------------------!
-!    Description:
-!    ------------
-!>   Reads a character variable in a 1D array
-!--------------------------------------------------------------------------------------------------!
-  SUBROUTINE get_variable_1d_char( id, variable_name, var )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)            ::  variable_name          !< variable name
-
-    CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) ::  var  !< variable to be read
-
-    INTEGER(iwp)                ::  i                !< running index over variable dimension
-    INTEGER(iwp), INTENT(IN)    ::  id               !< file id
-    INTEGER(iwp)                ::  id_var           !< dimension id
-
-    INTEGER(iwp), DIMENSION(2)  ::  dimid            !< dimension IDs
-    INTEGER(iwp), DIMENSION(2)  ::  dimsize          !< dimension size
-
-#if defined( __netcdf )
-
-!
-!-- First, inquire variable ID
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-    CALL handle_error( 'get_variable_1d_int', 527, variable_name )
-!
-!-- Inquire dimension IDs
-    nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, dimids = dimid(1:2) )
-    CALL handle_error( 'get_variable_1d_char', 527, variable_name )
-!
-!-- Read dimesnion length
-    nc_stat = NF90_INQUIRE_DIMENSION( id, dimid(1), LEN = dimsize(1) )
-    nc_stat = NF90_INQUIRE_DIMENSION( id, dimid(2), LEN = dimsize(2) )
-
-!
-!-- Read character array. Note, each element is read individually, in order to better separate
-!-- single strings.
-    DO  i = 1, dimsize(2)
-       nc_stat = NF90_GET_VAR( id, id_var, var(i),                                                 &
-                               start = (/ 1, i /),                                                 &
-                               count = (/ dimsize(1), 1 /) )
-       CALL handle_error( 'get_variable_1d_char', 527, variable_name )
-    ENDDO
-
-#endif
-
- END SUBROUTINE get_variable_1d_char
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 1D integer variable from file.
-!--------------------------------------------------------------------------------------------------!
-  SUBROUTINE get_variable_1d_int( id, variable_name, var )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)            ::  variable_name    !< variable name
-
-    INTEGER(iwp), INTENT(IN)    ::  id               !< file id
-    INTEGER(iwp)                ::  id_var           !< dimension id
-
-    INTEGER(iwp), DIMENSION(:), INTENT(INOUT) ::  var  !< variable to be read
-#if defined( __netcdf )
-
-!
-!-- First, inquire variable ID
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-    CALL handle_error( 'get_variable_1d_int', 527, variable_name )
-!
-!-- Read variable
-    nc_stat = NF90_GET_VAR( id, id_var, var )
-    CALL handle_error( 'get_variable_1d_int', 527, variable_name )
-
-#endif
-
- END SUBROUTINE get_variable_1d_int
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 1D float variable from file.
-!--------------------------------------------------------------------------------------------------!
-  SUBROUTINE get_variable_1d_real( id, variable_name, var, is, count_elements )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)            ::  variable_name    !< variable name
-
-    INTEGER(iwp), INTENT(IN), OPTIONAL ::  count_elements   !< number of elements to be read
-    INTEGER(iwp), INTENT(IN)           ::  id               !< file id
-    INTEGER(iwp)                       ::  id_var           !< dimension id
-    INTEGER(iwp), INTENT(IN), OPTIONAL ::  is               !< start index
-
-    REAL(wp), DIMENSION(:), INTENT(INOUT) ::  var    !< variable to be read
-#if defined( __netcdf )
-!
-!-- First, inquire variable ID
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-    CALL handle_error( 'get_variable_1d_real', 528, variable_name )
-!
-!-- Read variable
-    IF ( PRESENT( is ) )  THEN
-       nc_stat = NF90_GET_VAR( id, id_var, var, start = (/ is /), count = (/ count_elements /) )
-       CALL handle_error( 'get_variable_1d_real', 528, variable_name )
-    ELSE
-       nc_stat = NF90_GET_VAR( id, id_var, var )
-       CALL handle_error( 'get_variable_1d_real', 528, variable_name )
-    ENDIF
-
-#endif
-
- END SUBROUTINE get_variable_1d_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a time-dependent 1D float variable from file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_pr( id, variable_name, t, var )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)                      ::  variable_name    !< variable name
-
-    INTEGER(iwp), INTENT(IN)              ::  id               !< file id
-    INTEGER(iwp), DIMENSION(1:2)          ::  id_dim           !< dimension ids
-    INTEGER(iwp)                          ::  id_var           !< dimension id
-    INTEGER(iwp)                          ::  n_file           !< number of data-points in file along z dimension
-    INTEGER(iwp), INTENT(IN)              ::  t                !< timestep number
-
-    REAL(wp), DIMENSION(:), INTENT(INOUT) ::  var              !< variable to be read
-
-#if defined( __netcdf )
-!
-!-- First, inquire variable ID
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Inquire dimension size of vertical dimension
-    nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim )
-    nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(1), LEN = n_file )
-!
-!-- Read variable.
-    nc_stat = NF90_GET_VAR( id, id_var, var,                                                       &
-                            start = (/ 1,      t     /),                                           &
-                            count = (/ n_file, 1     /) )
-    CALL handle_error( 'get_variable_pr', 529, variable_name )
-#endif
-
- END SUBROUTINE get_variable_pr
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a per-surface pars variable from file. Because all surfaces are stored as flat 1-D array,
-!> each PE has to scan the data and find the surface indices belonging to its subdomain. During this
-!> scan, it also builds a necessary (j,i) index.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_surf( id, variable_name, surf )
-
-    USE pegrid
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nys, nyn
-
-    USE control_parameters,                                                                        &
-        ONLY: dz, message_string
-
-    USE grid_variables,                                                                            &
-        ONLY: ddx, ddy
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY: pi
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), PARAMETER                   ::  nsurf_pars_read = 2**15  !< read buffer size (value > 10^15 makes problem with
-                                                                           !< ifort)
-
-    CHARACTER(LEN=*)                          ::  variable_name !< variable name
-
-    INTEGER(iwp)                              ::  i             !< grid index in x-direction
-    INTEGER(iwp)                              ::  j             !< grid index in y-direction
-    INTEGER(iwp), INTENT(IN)                  ::  id            !< file id
-    INTEGER(iwp)                              ::  id_azimuth    !< azimuth variable id
-    INTEGER(iwp)                              ::  id_var        !< variable id
-    INTEGER(iwp)                              ::  id_xs         !< xs variable id
-    INTEGER(iwp)                              ::  id_ys         !< ys variable id
-    INTEGER(iwp)                              ::  id_zs         !< zs variable id
-    INTEGER(iwp)                              ::  id_zenith     !< zeith variable id
-    INTEGER(iwp)                              ::  is            !< local surface index
-    INTEGER(iwp)                              ::  is0, isc      !< read surface start and count
-    INTEGER(iwp)                              ::  isurf         !< netcdf surface index
-    INTEGER(iwp)                              ::  nsurf         !< total number of surfaces in file
-
-    INTEGER(iwp), DIMENSION(6)                ::  coords        !< integer coordinates of surface location
-    INTEGER(iwp), DIMENSION(2)                ::  id_dim        !< dimension ids
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nsurf_ji      !< numbers of surfaces by coords
-
-    REAL(wp)                                  ::  oro_max_l     !< maximum terrain height under building
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE       ::  azimuth       !< read buffer for azimuth(s)
-    REAL(wp), DIMENSION(:), ALLOCATABLE       ::  zenith        !< read buffer for zenith(s)
-    REAL(wp), DIMENSION(:), ALLOCATABLE       ::  xs            !< surface coordinate array of x-dimension
-    REAL(wp), DIMENSION(:), ALLOCATABLE       ::  ys            !< surface coordinate array of y-dimension
-    REAL(wp), DIMENSION(:), ALLOCATABLE       ::  zs            !< surface coordinate array of z-dimension
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE     ::  pars_read     !< read buffer for the building parameters
-
-    TYPE(pars_surf)                           ::  surf          !< parameters variable to be loaded
-
-
-#if defined( __netcdf )
-!
-!-- First, inquire variable ID's
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-    nc_stat = NF90_INQ_VARID( id, 'zs',                  id_zs )
-    nc_stat = NF90_INQ_VARID( id, 'ys',                  id_ys )
-    nc_stat = NF90_INQ_VARID( id, 'xs',                  id_xs )
-    nc_stat = NF90_INQ_VARID( id, 'zenith',              id_zenith )
-    nc_stat = NF90_INQ_VARID( id, 'azimuth',             id_azimuth )
-!
-!-- Inquire dimension sizes for the number of surfaces and parameters given
-    nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim )
-    nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(1), LEN = nsurf )
-    nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(2), LEN = surf%np )
-
-    ALLOCATE( pars_read( nsurf_pars_read, surf%np ),                                               &
-              zs(nsurf_pars_read), ys(nsurf_pars_read),                                            &
-              xs(nsurf_pars_read), zenith(nsurf_pars_read),                                        &
-              azimuth(nsurf_pars_read),                                                            &
-              nsurf_ji(nys:nyn,nxl:nxr) )
-
-    nsurf_ji(:,:) = 0
-!
-!-- Scan surface coordinates, count locally
-    is0 = 1
-    DO
-       isc = MIN(nsurf_pars_read, nsurf - is0 + 1)
-       IF ( isc <= 0 )  EXIT
-
-       nc_stat = NF90_GET_VAR( id, id_ys, ys,                                                      &
-                               start = (/ is0 /),                                                  &
-                               count = (/ isc /) )
-       nc_stat = NF90_GET_VAR( id, id_xs, xs,                                                      &
-                               start = (/ is0 /),                                                  &
-                               count = (/ isc /) )
-       nc_stat = NF90_GET_VAR( id, id_zenith, zenith,                                              &
-                               start = (/ is0 /), &
-                               count = (/ isc /) )
-       nc_stat = NF90_GET_VAR( id, id_azimuth, azimuth,                                            &
-                               start = (/ is0 /),                                                  &
-                               count = (/ isc /) )
-       CALL handle_error( 'get_variable_surf', 682, 'azimuth' )
-
-       DO  isurf = 1, isc
-!
-!--       Parse coordinates, detect if belongs to subdomain
-          coords = transform_coords( xs(isurf), ys(isurf), zenith(isurf), azimuth(isurf) )
-          IF ( coords(2) < nys  .OR.  coords(2) > nyn  .OR.                                        &
-               coords(3) < nxl  .OR.  coords(3) > nxr )  CYCLE
-
-          nsurf_ji(coords(2),coords(3)) = nsurf_ji(coords(2),coords(3)) + 1
-       ENDDO
-       is0 = is0 + isc
-    ENDDO
-!
-!-- Populate reverse index from surface counts
-    ALLOCATE( surf%index_ji( 2,nys:nyn,nxl:nxr ) )
-    isurf = 1
-    DO  j = nys, nyn
-       DO  i = nxl, nxr
-          surf%index_ji(:,j,i) = (/ isurf, isurf + nsurf_ji(j,i) - 1 /)
-          isurf = isurf + nsurf_ji(j,i)
-       ENDDO
-    ENDDO
-
-    surf%nsurf = isurf - 1
-    ALLOCATE( surf%pars(0:surf%np-1,surf%nsurf),                                                   &
-              surf%coords(6,surf%nsurf) )
-!
-!-- Scan surfaces again, saving pars into allocated structures
-    nsurf_ji(:,:) = 0
-    is0 = 1
-    DO
-       isc = MIN(nsurf_pars_read, nsurf - is0 + 1)
-       IF ( isc <= 0 )  EXIT
-
-       nc_stat = NF90_GET_VAR( id, id_var, pars_read(1:isc, 1:surf%np),                            &
-                               start = (/ is0, 1       /),                                         &
-                               count = (/ isc, surf%np /) )
-       CALL handle_error( 'get_variable_surf', 683, variable_name )
-
-       nc_stat = NF90_GET_VAR( id, id_zs, zs,                                                      &
-                               start = (/ is0 /),                                                  &
-                               count = (/ isc /) )
-       nc_stat = NF90_GET_VAR( id, id_ys, ys,                                                      &
-                               start = (/ is0 /),                                                  &
-                               count = (/ isc /) )
-       nc_stat = NF90_GET_VAR( id, id_xs, xs,                                                      &
-                               start = (/ is0 /),                                                  &
-                               count = (/ isc /) )
-       nc_stat = NF90_GET_VAR( id, id_zenith, zenith,                                              &
-                               start = (/ is0 /),                                                  &
-                               count = (/ isc /) )
-       nc_stat = NF90_GET_VAR( id, id_azimuth, azimuth,                                            &
-                               start = (/ is0 /),                                                  &
-                               count = (/ isc /) )
-
-       DO  isurf = 1, isc
-!
-!--       Parse coordinates, detect if belongs to subdomain
-          coords = transform_coords( xs(isurf), ys(isurf), zenith(isurf), azimuth(isurf) )
-          IF ( coords(2) < nys  .OR.  coords(2) > nyn  .OR.                                        &
-               coords(3) < nxl  .OR.  coords(3) > nxr )  CYCLE
-!
-!--       Determine maximum terrain under building (base z-coordinate). Using normal vector to
-!--       locate building inner coordinates.
-          oro_max_l = buildings_f%oro_max(coords(2)-coords(5),coords(3)-coords(6))
-          IF ( oro_max_l == buildings_f%fill1 )  THEN
-             WRITE( message_string, * ) 'Found building surface on '   //                          &
-                                        'non-building coordinates (xs, ys, zenith, azimuth): ',    &
-                                        xs(isurf), ys(isurf), zenith(isurf), azimuth(isurf)
-             CALL message( 'get_variable_surf', 'PA0684', 2, 2, myid, 6, 0 )
-          ENDIF
-!
-!--       Urban layer has no stretching, therefore using dz(1) instead of linear searching through
-!--       zu/zw.
-          coords(1) = NINT( ( zs(isurf) + oro_max_l ) / dz(1) + 0.5_wp + 0.5_wp * coords(4),       &
-                            KIND=iwp )
-!
-!--       Save surface entry
-          is = surf%index_ji(1,coords(2),coords(3)) + nsurf_ji(coords(2),coords(3))
-          surf%pars(:,is) = pars_read(isurf,:)
-          surf%coords(:,is) = coords(:)
-
-          nsurf_ji(coords(2),coords(3)) = nsurf_ji(coords(2),coords(3)) + 1
-       ENDDO
-
-       is0 = is0 + isc
-    ENDDO
-
-    DEALLOCATE( pars_read, zs, ys, xs, zenith, azimuth, nsurf_ji )
-
- CONTAINS
-
-    PURE FUNCTION transform_coords( x, y, zenith, azimuth )
-
-       INTEGER(iwp), DIMENSION(6) ::  transform_coords !< (k,j,i,norm_z,norm_y,norm_x)
-
-       REAL(wp), INTENT(in) ::  azimuth  !< surface normal azimuth angle in degrees
-       REAL(wp), INTENT(in) ::  x        !< surface centre coordinate in x in metres from origin
-       REAL(wp), INTENT(in) ::  y        !< surface centre coordinate in y in metres from origin
-       REAL(wp), INTENT(in) ::  zenith   !< surface normal zenith angle in degrees
-
-       transform_coords(4) = NINT( COS( zenith * pi / 180.0_wp ), KIND=iwp )
-       IF ( transform_coords(4) == 0 )  THEN
-          transform_coords(5) = NINT( COS( azimuth * pi / 180.0_wp ), KIND=iwp)
-          transform_coords(6) = NINT( SIN( azimuth * pi / 180.0_wp ), KIND=iwp)
-       ELSE
-          transform_coords(5) = 0.0_wp
-          transform_coords(6) = 0.0_wp
-       ENDIF
-
-       transform_coords(1) = -999.0_wp ! not calculated here
-       transform_coords(2) = NINT( y * ddy - 0.5_wp + 0.5_wp * transform_coords(5), KIND=iwp )
-       transform_coords(3) = NINT( x * ddx - 0.5_wp + 0.5_wp * transform_coords(6), KIND=iwp )
-
-    END FUNCTION transform_coords
-#endif
-
- END SUBROUTINE get_variable_surf
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 2D REAL variable from a file. Reading is done processor-wise, i.e. each core reads its
-!> own domain in slices along x.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_2d_real( id, variable_name, var, is, ie, js, je )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< variable name
-
-    INTEGER(iwp)                  ::  i               !< running index along x direction
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  ie              !< start index for subdomain input along x direction
-    INTEGER(iwp)                  ::  is              !< end index for subdomain input along x direction
-    INTEGER(iwp)                  ::  j               !< running index along y direction
-    INTEGER(iwp)                  ::  je              !< start index for subdomain input along y direction
-    INTEGER(iwp)                  ::  js              !< end index for subdomain input along y direction
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  tmp   !< temporary variable to read data from file according
-                                                      !< to its reverse memory access
-    REAL(wp), DIMENSION(:,:), INTENT(INOUT) ::  var   !< variable to be read
-
-
-#if defined( __netcdf )
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-    IF ( collective_read )  THEN
-#if defined( __netcdf4_parallel )
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-#endif
-    ENDIF
-
-!
-!-- Allocate temporary variable according to memory access on file.
-    ALLOCATE( tmp(is:ie,js:je) )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1 /),                             &
-                            count = (/ ie-is+1, je-js+1 /) )
-    CALL handle_error( 'get_variable_2d_real', 530, variable_name )
-!
-!-- Resort data. Please note, dimension subscripts of var all start at 1.
-    DO  i = is, ie
-       DO  j = js, je
-          var(j-js+1,i-is+1) = tmp(i,j)
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_2d_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 2D 32-bit INTEGER variable from file. Reading is done processor-wise, i.e. each core
-!> reads its own domain in slices along x.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_2d_int32( id, variable_name, var, is, ie, js, je )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< variable name
-
-    INTEGER(iwp)                  ::  i               !< running index along x direction
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  ie              !< start index for subdomain input along x direction
-    INTEGER(iwp)                  ::  is              !< end index for subdomain input along x direction
-    INTEGER(iwp)                  ::  j               !< running index along y direction
-    INTEGER(iwp)                  ::  je              !< start index for subdomain input along y direction
-    INTEGER(iwp)                  ::  js              !< end index for subdomain input along y direction
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   ::  tmp  !< temporary variable to read data from file according
-                                                         !< to its reverse memory access
-    INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) ::  var  !< variable to be read
-
-
-#if defined( __netcdf )
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-    IF ( collective_read )  THEN
-#if defined( __netcdf4_parallel )
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-#endif
-    ENDIF
-!
-!-- Allocate temporary variable according to memory access on file.
-    ALLOCATE( tmp(is:ie,js:je) )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1 /),                             &
-                            count = (/ ie-is+1, je-js+1 /) )
-
-    CALL handle_error( 'get_variable_2d_int32', 531, variable_name )
-!
-!-- Resort data. Please note, dimension subscripts of var all start at 1.
-    DO  i = is, ie
-       DO  j = js, je
-          var(j-js+1,i-is+1) = tmp(i,j)
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_2d_int32
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 2D 8-bit INTEGER variable from file. Reading is done processor-wise, i.e. each core reads
-!> its own domain in slices along x.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_2d_int8( id, variable_name, var, is, ie, js, je )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< variable name
-
-    INTEGER(iwp)                  ::  i               !< running index along x direction
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  ie              !< start index for subdomain input along x direction
-    INTEGER(iwp)                  ::  is              !< end index for subdomain input along x direction
-    INTEGER(iwp)                  ::  j               !< running index along y direction
-    INTEGER(iwp)                  ::  je              !< start index for subdomain input along y direction
-    INTEGER(iwp)                  ::  js              !< end index for subdomain input along y direction
-
-    INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE   ::  tmp  !< temporary variable to read data from file according
-                                                            !< to its reverse memory access
-    INTEGER(KIND=1), DIMENSION(:,:), INTENT(INOUT) ::  var  !< variable to be read
-
-
-#if defined( __netcdf )
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-    IF ( collective_read )  THEN
-#if defined( __netcdf4_parallel )
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-#endif
-    ENDIF
-!
-!-- Allocate temporary variable according to memory access on file.
-    ALLOCATE( tmp(is:ie,js:je) )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp,                                                       &
-                            start = (/ is+1,      js+1 /),                                         &
-                            count = (/ ie-is + 1, je-js+1 /) )
-
-    CALL handle_error( 'get_variable_2d_int8', 532, variable_name )
-!
-!-- Resort data. Please note, dimension subscripts of var all start at 1.
-    DO  i = is, ie
-       DO  j = js, je
-          var(j-js+1,i-is+1) = tmp(i,j)
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_2d_int8
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 3D 8-bit INTEGER variable from file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_3d_int8( id, variable_name, var, is, ie, js, je, ks, ke )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< variable name
-
-    INTEGER(iwp)                  ::  i               !< index along x direction
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  ie              !< start index for subdomain input along x direction
-    INTEGER(iwp)                  ::  is              !< end index for subdomain input along x direction
-    INTEGER(iwp)                  ::  j               !< index along y direction
-    INTEGER(iwp)                  ::  je              !< start index for subdomain input along y direction
-    INTEGER(iwp)                  ::  js              !< end index for subdomain input along y direction
-    INTEGER(iwp)                  ::  k               !< index along any 3rd dimension
-    INTEGER(iwp)                  ::  ke              !< start index of 3rd dimension
-    INTEGER(iwp)                  ::  ks              !< end index of 3rd dimension
-
-    INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp  !< temporary variable to read data from file according
-                                                              !< to its reverse memory access
-
-    INTEGER(KIND=1), DIMENSION(:,:,:), INTENT(INOUT) ::  var  !< variable to be read
-#if defined( __netcdf )
-
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-    IF ( collective_read )  THEN
-#if defined( __netcdf4_parallel )
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-#endif
-    ENDIF
-!
-!-- Allocate temporary variable according to memory access on file.
-    ALLOCATE( tmp(is:ie,js:je,ks:ke) )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1, ks+1 /),                       &
-                            count = (/ ie-is+1, je-js+1, ke-ks+1 /) )
-
-    CALL handle_error( 'get_variable_3d_int8', 533, variable_name )
-!
-!-- Resort data. Please note, dimension subscripts of var all start at 1.
-    DO  i = is, ie
-       DO  j = js, je
-          DO  k = ks, ke
-             var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k)
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_3d_int8
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 3D float variable from file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_3d_real( id, variable_name, var, is, ie, js, je, ks, ke )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< variable name
-
-    INTEGER(iwp)                  ::  i               !< index along x direction
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  ie              !< start index for subdomain input along x direction
-    INTEGER(iwp)                  ::  is              !< end index for subdomain input along x direction
-    INTEGER(iwp)                  ::  j               !< index along y direction
-    INTEGER(iwp)                  ::  je              !< start index for subdomain input along y direction
-    INTEGER(iwp)                  ::  js              !< end index for subdomain input along y direction
-    INTEGER(iwp)                  ::  k               !< index along any 3rd dimension
-    INTEGER(iwp)                  ::  ke              !< start index of 3rd dimension
-    INTEGER(iwp)                  ::  ks              !< end index of 3rd dimension
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp !< temporary variable to read data from file according
-                                                      !< to its reverse memory access
-
-    REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) ::  var !< variable to be read
-#if defined( __netcdf )
-
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-    IF ( collective_read )  THEN
-#if defined( __netcdf4_parallel )
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-#endif
-    ENDIF
-!
-!-- Allocate temporary variable according to memory access on file.
-    ALLOCATE( tmp(is:ie,js:je,ks:ke) )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1, ks+1 /),                       &
-                            count = (/ ie-is+1, je-js+1, ke-ks+1 /) )
-
-    CALL handle_error( 'get_variable_3d_real', 534, variable_name )
-!
-!-- Resort data. Please note, dimension subscripts of var all start at 1.
-    DO  i = is, ie
-       DO  j = js, je
-          DO  k = ks, ke
-             var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k)
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_3d_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 4D float variable from file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_4d_real( id, variable_name, var, is, ie, js, je, k1s, k1e, k2s, k2e )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< variable name
-
-    INTEGER(iwp)                  ::  i               !< index along x direction
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  ie              !< start index for subdomain input along x direction
-    INTEGER(iwp)                  ::  is              !< end index for subdomain input along x direction
-    INTEGER(iwp)                  ::  j               !< index along y direction
-    INTEGER(iwp)                  ::  je              !< start index for subdomain input along y direction
-    INTEGER(iwp)                  ::  js              !< end index for subdomain input along y direction
-    INTEGER(iwp)                  ::  k1              !< index along 3rd direction
-    INTEGER(iwp)                  ::  k1e             !< start index for 3rd dimension
-    INTEGER(iwp)                  ::  k1s             !< end index for 3rd dimension
-    INTEGER(iwp)                  ::  k2              !< index along 4th direction
-    INTEGER(iwp)                  ::  k2e             !< start index for 4th dimension
-    INTEGER(iwp)                  ::  k2s             !< end index for 4th dimension
-
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   ::  tmp  !< temporary variable to read data from file according
-                                                         !< to its reverse memory access
-    REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) ::  var  !< variable to be read
-
-
-#if defined( __netcdf )
-
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-    IF ( collective_read )  THEN
-#if defined( __netcdf4_parallel )
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-#endif
-    ENDIF
-
-!
-!-- Allocate temporary variable according to memory access on file.
-    ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e) )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1, k1s+1, k2s+1 /),               &
-                            count = (/ ie-is+1, je-js+1, k1e-k1s+1, k2e-k2s+1 /) )
-
-       CALL handle_error( 'get_variable_4d_real', 535, variable_name )
-!
-!-- Resort data. Please note, dimension subscripts of var all start at 1.
-    DO  i = is, ie
-       DO  j = js, je
-          DO  k1 = k1s, k1e
-             DO  k2 = k2s, k2e
-                var(k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_4d_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 4D float variable from file and store it to a 3-d variable.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_4d_to_3d_real( id, variable_name, var, ns, is, ie, js, je, ks, ke )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< variable name
-
-    INTEGER(iwp)                  ::  i               !< index along x direction
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  ie              !< end index for subdomain input along x direction
-    INTEGER(iwp)                  ::  is              !< start index for subdomain input along x direction
-    INTEGER(iwp)                  ::  j               !< index along y direction
-    INTEGER(iwp)                  ::  je              !< end index for subdomain input along y direction
-    INTEGER(iwp)                  ::  js              !< start index for subdomain input along y direction
-    INTEGER(iwp)                  ::  k               !< index along any 4th dimension
-    INTEGER(iwp)                  ::  ke              !< end index of 4th dimension
-    INTEGER(iwp)                  ::  ks              !< start index of 4th dimension
-    INTEGER(iwp)                  ::  ns              !< start index for subdomain input along n dimension
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp !< temporary variable to read data from file according
-                                                      !< to its reverse memory access
-
-    REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) ::  var  !< variable where the read data have to be stored:
-                                                       !< one dimension is reduced in the process
-
-
-#if defined( __netcdf )
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-    IF ( collective_read )  THEN
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-    ENDIF
-!
-!-- Allocate temporary variable according to memory access on file.
-    ALLOCATE( tmp(is:ie,js:je,ks:ke) )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1, ks+1, ns+1 /),                 &
-                            count = (/ ie-is+1, je-js+1, ke-ks+1, 1   /) )
-
-    CALL handle_error( 'get_variable_4d_to_3d_real', 536, variable_name )
-!
-!-- Resort data. Please note, dimension subscripts of var all start at 1.
-    DO  i = is, ie
-       DO  j = js, je
-          DO  k = ks, ke
-             var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k)
-          ENDDO
-       ENDDO
-    ENDDO
-
-   DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_4d_to_3d_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 3D float variables from dynamic driver with the last dimension only having 1 entry
-!> (time,z). Please note, the passed arguments are start indices and number of elements in each
-!> dimension, which is in contrast to the other 3d versions where start- and end indices are passed.
-!> The different handling compared to get_variable_2d_real is due to its different start-index
-!> treatment.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_2d_real_dynamic( id, variable_name, var, i1s, i2s, count_1, count_2 )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< variable name
-
-    INTEGER(iwp)                  ::  count_1         !< number of elements to be read along 1st dimension (with respect to file)
-    INTEGER(iwp)                  ::  count_2         !< number of elements to be read along 2nd dimension (with respect to file)
-    INTEGER(iwp)                  ::  i1              !< running index along 1st dimension on file
-    INTEGER(iwp)                  ::  i1s             !< start index for subdomain input along 1st dimension (with respect to file)
-    INTEGER(iwp)                  ::  i2              !< running index along 2nd dimension on file
-    INTEGER(iwp)                  ::  i2s             !< start index for subdomain input along 2nd dimension (with respect to file)
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  lb1             !< lower bound of 1st dimension (with respect to file)
-    INTEGER(iwp)                  ::  lb2             !< lower bound of 2nd dimension (with respect to file)
-    INTEGER(iwp)                  ::  ub1             !< upper bound of 1st dimension (with respect to file)
-    INTEGER(iwp)                  ::  ub2             !< upper bound of 2nd dimension (with respect to file)
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  tmp   !< temporary variable to read data from file according to its reverse memory
-                                                      !< access
-
-    REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) ::  var !< input variable
-
-
-#if defined( __netcdf )
-!
-!-- Inquire variable id.
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Allocate temporary variable according to memory access on file.
-!-- Therefore, determine dimension bounds of input array.
-    lb1 = LBOUND( var,2 )
-    ub1 = UBOUND( var,2 )
-    lb2 = LBOUND( var,1 )
-    ub2 = UBOUND( var,1 )
-
-    ALLOCATE( tmp(lb1:ub1,lb2:ub2) )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ i1s, i2s /),                               &
-                            count = (/ count_1, count_2 /) )
-
-    CALL handle_error( 'get_variable_2d_real_dynamic', 537, variable_name )
-!
-!-- Resort data. Please note, dimension subscripts of var all start at 1.
-    DO i2 = lb2, ub2
-       DO  i1 = lb1, ub1
-          var(i2,i1,1) = tmp(i1,i2)
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_2d_real_dynamic
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 3D float variables from dynamic driver, such as time-dependent xy-, xz- or yz-boundary
-!> data as well as 3D initialization data. Please note, the passed arguments are start indices and
-!> number of elements in each dimension, which is in contrast to the other 3d versions where start-
-!> and end indices are passed. The different handling of 3D dynamic variables is due to its
-!> asymmetry for the u- and v component.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_3d_real_dynamic( id, variable_name, var, i1s, i2s, i3s,                   &
-                                          count_1, count_2, count_3, par_access )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< variable name
-
-    INTEGER(iwp)                  ::  count_1         !< number of elements to be read along 1st dimension (with respect to file)
-    INTEGER(iwp)                  ::  count_2         !< number of elements to be read along 2nd dimension (with respect to file)
-    INTEGER(iwp)                  ::  count_3         !< number of elements to be read along 3rd dimension (with respect to file)
-    INTEGER(iwp)                  ::  i1              !< running index along 1st dimension on file
-    INTEGER(iwp)                  ::  i1s             !< start index for subdomain input along 1st dimension (with respect to file)
-    INTEGER(iwp)                  ::  i2              !< running index along 2nd dimension on file
-    INTEGER(iwp)                  ::  i2s             !< start index for subdomain input along 2nd dimension (with respect to file)
-    INTEGER(iwp)                  ::  i3              !< running index along 3rd dimension on file
-    INTEGER(iwp)                  ::  i3s             !< start index of 3rd dimension, in dynamic file this is either time
-                                                      !<(2D boundary) or z (3D)
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  lb1             !< lower bound of 1st dimension (with respect to file)
-    INTEGER(iwp)                  ::  lb2             !< lower bound of 2nd dimension (with respect to file)
-    INTEGER(iwp)                  ::  lb3             !< lower bound of 3rd dimension (with respect to file)
-    INTEGER(iwp)                  ::  ub1             !< upper bound of 1st dimension (with respect to file)
-    INTEGER(iwp)                  ::  ub2             !< upper bound of 2nd dimension (with respect to file)
-    INTEGER(iwp)                  ::  ub3             !< upper bound of 3rd dimension (with respect to file)
-
-    LOGICAL                       ::  par_access      !< additional flag indicating whether parallel read operations should be
-                                                      !< performed or not
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp !< temporary variable to read data from file according
-                                                      !< to its reverse memory access
-
-    REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) ::  var !< input variable
-
-
-#if defined( __netcdf )
-!
-!-- Inquire variable id.
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-!-- Please note, in contrast to the other input routines where each PEs reads its subdomain data,
-!-- dynamic input data not by all PEs, only by those which encompass lateral model boundaries.
-!-- Hence, collective read operations are only enabled for top-boundary data.
-    IF ( collective_read  .AND.  par_access )  THEN
-#if defined( __netcdf4_parallel )
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-#endif
-    ENDIF
-!
-!-- Allocate temporary variable according to memory access on file.
-!-- Therefore, determine dimension bounds of input array.
-    lb1 = LBOUND( var,3 )
-    ub1 = UBOUND( var,3 )
-    lb2 = LBOUND( var,2 )
-    ub2 = UBOUND( var,2 )
-    lb3 = LBOUND( var,1 )
-    ub3 = UBOUND( var,1 )
-    ALLOCATE( tmp(lb1:ub1,lb2:ub2,lb3:ub3) )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ i1s, i2s, i3s /),                          &
-                            count = (/ count_1, count_2, count_3 /) )
-
-    CALL handle_error( 'get_variable_3d_real_dynamic', 537, variable_name )
-!
-!-- Resort data. Please note, dimension subscripts of var all start at 1.
-    DO  i3 = lb3, ub3
-       DO i2 = lb2, ub2
-          DO  i1 = lb1, ub1
-             var(i3,i2,i1) = tmp(i1,i2,i3)
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_3d_real_dynamic
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 5D float variable from file and store it to a 4-d variable.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_5d_to_4d_real( id, variable_name, var, ns, ts, te, is, ie, js, je, ks, ke )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< variable name
-
-    INTEGER(iwp)                  ::  i               !< index along x direction
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  ie              !< end index for subdomain input along x direction
-    INTEGER(iwp)                  ::  is              !< start index for subdomain input along x direction
-    INTEGER(iwp)                  ::  j               !< index along y direction
-    INTEGER(iwp)                  ::  je              !< end index for subdomain input along y direction
-    INTEGER(iwp)                  ::  js              !< start index for subdomain input along y direction
-    INTEGER(iwp)                  ::  k               !< index along any 5th dimension
-    INTEGER(iwp)                  ::  ke              !< end index of 5th dimension
-    INTEGER(iwp)                  ::  ks              !< start index of 5th dimension
-    INTEGER(iwp)                  ::  ns              !< start index for subdomain input along n dimension: ns coincides here with
-                                                      !< ne, since, we select only one value along the 1st dimension n
-    INTEGER(iwp)                  ::  t               !< index along t direction
-    INTEGER(iwp)                  ::  te              !< end index for subdomain input along t direction
-    INTEGER(iwp)                  ::  ts              !< start index for subdomain input along t direction
-
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   ::  tmp  !< temporary variable to read data from file according to its reverse
-                                                         !< memory access
-    REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) ::  var  !< variable to be read
-#if defined( __netcdf )
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-    IF ( collective_read )  THEN
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-    ENDIF
-!
-!-- Allocate temporary variable according to memory access on file.
-    ALLOCATE( tmp(ks:ke,js:je,is:is,ts:te) )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ ks+1, js+1, is+1, ts+1, ns /),             &
-                            count = (/ ke-ks+1, je-js+1, ie-is+1, te-ts+1, 1 /) )
-
-    CALL handle_error( 'get_variable_5d_to_4d_real', 538, variable_name )
-!
-!-- Resort data. Please note, dimension subscripts of var all start at 1.
-    DO  t = ts, te
-       DO  i = is, ie
-          DO  j = js, je
-             DO  k = ks, ke
-                var(t-ts+1,i-is+1,j-js+1,k-ks+1) = tmp(k,j,i,t)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_5d_to_4d_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 5D float variable from file.
-!> Note - This subroutine is used specific for reading NC variable emission_values having a "z"
-!>        dimension. Mentioned dimension is to be removed in the future and this subroutine shall
-!>        be depreciated accordingly. (ecc 20190418)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_5d_real( id, variable_name, var, is, ie, js, je, k1s, k1e, k2s, k2e, k3s, &
-                                  k3e )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)          ::  variable_name  !< variable name
-
-    INTEGER(iwp)              :: i       !< i index
-    INTEGER(iwp), INTENT(IN)  :: id      !< netCDF file ID (ncid)
-    INTEGER(iwp)              :: id_var  !< netCDF variable ID (varid)
-    INTEGER(iwp)              :: ie      !< i index start
-    INTEGER(iwp)              :: is      !< i index end
-    INTEGER(iwp)              :: j       !< j index
-    INTEGER(iwp)              :: je      !< j index start
-    INTEGER(iwp)              :: js      !< j index end
-    INTEGER(iwp)              :: k1      !< k1 index
-    INTEGER(iwp)              :: k1e     !< k1 index start
-    INTEGER(iwp)              :: k1s     !< k1 index end
-    INTEGER(iwp)              :: k2      !< k2 index
-    INTEGER(iwp)              :: k2e     !< k2 index start
-    INTEGER(iwp)              :: k2s     !< k2 index end
-    INTEGER(iwp)              :: k3      !< k3 index
-    INTEGER(iwp)              :: k3e     !< k3 index start
-    INTEGER(iwp)              :: k3s     !< k3 index end
-
-    REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE    :: tmp  !< temp array to read data from file
-    REAL(wp), DIMENSION(:,:,:,:,:), INTENT(INOUT)  :: var  !< variable to be read
-
-#if defined( __netcdf )
-
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-    IF ( collective_read )  THEN
-
-#if defined( __netcdf4_parallel )
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-#endif
-
-    ENDIF
-
-!
-!-- Allocate temporary variable according to memory access on file.
-    ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e,k3s:k3e) )
-
-!
-!-- Get variable from file
-    nc_stat = NF90_GET_VAR ( id, id_var, tmp, start = (/ is+1, js+1, k1s+1, k2s+1, k3s+1 /),       &
-                             count = (/ ie-is+1, je-js+1, k1e-k1s+1, k2e-k2s+1, k3e-k3s+1 /) )
-
-    CALL handle_error( 'get_variable_5d_real', 535, variable_name )
-
-!
-!-- Resort (reverse index order) and standardize (from 1 to N) output array
-    DO  i = is, ie
-       DO  j = js, je
-          DO  k1 = k1s, k1e
-             DO  k2 = k2s, k2e
-                DO k3 = k3s, k3e
-                   var(k3-k3s+1,k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2,k3)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_5d_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 5D float variables from dynamic driver, such as time-dependent xy-, xz- or yz-boundary
-!> data as well as 5D initialization data. Please note, the passed arguments are start indices and
-!> number of elements in each dimension, which is in contrast to the other 3d versions where start-
-!> and end indices are passed. The different handling of 5D dynamic variables is due to its
-!> asymmetry for the u- and v component.
-!> Note(1) - This subroutine is more flexible than get_variable_xd_real as it provides much better
-!>           control over starting and count indices.
-!>           (ecc 20190418)
-!> Note(2) - This subroutine is used specific for reading NC variable emission_values having a "z"
-!>           dimension. Mentioned dimension is to be removed in the future and this subroutine shall
-!>           be depreciated accordingly (ecc 20190418)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_variable_5d_real_dynamic( id, variable_name, var, i1s, i2s, i3s, i4s, i5s,         &
-                                          count_1, count_2, count_3, count_4, count_5, par_access )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)          ::  variable_name  !< variable name
-
-    INTEGER(iwp)              ::  count_1  !< # elements read in dimension 1 wrt file
-    INTEGER(iwp)              ::  count_2  !< # elements read in dimension 2 wrt file
-    INTEGER(iwp)              ::  count_3  !< # elements read in dimension 3 wrt file
-    INTEGER(iwp)              ::  count_4  !< # elements read in dimension 4 wrt file
-    INTEGER(iwp)              ::  count_5  !< # elements read in dimension 5 wrt file
-    INTEGER(iwp)              ::  i1       !< index for dimension 1 on file
-    INTEGER(iwp)              ::  i1s      !< starting index for dimension 1 hyperslab
-    INTEGER(iwp)              ::  i2       !< index for dimension 2 on file
-    INTEGER(iwp)              ::  i2s      !< starting index for dimension 2 hyperslab
-    INTEGER(iwp)              ::  i3       !< index for dimension 3 on file
-    INTEGER(iwp)              ::  i3s      !< starting index for dimension 3 hyperslab
-    INTEGER(iwp)              ::  i4       !< index for dimension 4 on file
-    INTEGER(iwp)              ::  i4s      !< starting index for dimension 4 hyperslab
-    INTEGER(iwp)              ::  i5       !< index for dimension 5 on file
-    INTEGER(iwp)              ::  i5s      !< starting index for dimension 5 hyperslab
-    INTEGER(iwp), INTENT(IN)  ::  id       !< netCDF file id (ncid)
-    INTEGER(iwp)              ::  id_var   !< netCDF variable id (varid)
-    INTEGER(iwp)              ::  lb1      !< lower bound of dimension 1 wrt file
-    INTEGER(iwp)              ::  lb2      !< lower bound of dimension 2 wrt file
-    INTEGER(iwp)              ::  lb3      !< lower bound of dimension 3 wrt file
-    INTEGER(iwp)              ::  lb4      !< lower bound of dimension 4 wrt file
-    INTEGER(iwp)              ::  lb5      !< lower bound of dimension 5 wrt file
-    INTEGER(iwp)              ::  ub1      !< upper bound of dimension 1 wrt file
-    INTEGER(iwp)              ::  ub2      !< upper bound of dimension 2 wrt file
-    INTEGER(iwp)              ::  ub3      !< upper bound of dimension 3 wrt file
-    INTEGER(iwp)              ::  ub4      !< upper bound of dimension 4 wrt file
-    INTEGER(iwp)              ::  ub5      !< upper bound of dimension 5 wrt file
-
-    LOGICAL                   ::  par_access     !< additional flag indicating parallel read
-
-    REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE    ::  tmp  !< temporary variable to read data from file according to its reverse
-                                                            !< array index order
-    REAL(wp), DIMENSION(:,:,:,:,:), INTENT(INOUT)  ::  var  !< input variable
-
-
-#if defined( __netcdf )
-!
-!-- Inquire variable id.
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-
-!
-!-- Check for collective read-operation and set respective NetCDF flags if required.
-!-- Please note, in contrast to the other input routines where each PEs reads its subdomain data,
-!-- dynamic input data not by all PEs, only by those which encompass lateral model boundaries.
-!-- Hence, collective read operations are only enabled for top-boundary data.
-    IF ( collective_read  .AND.  par_access )  THEN
-
-#if defined( __netcdf4_parallel )
-       nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
-#endif
-
-    ENDIF
-
-!
-!-- Allocate temporary variable according to memory access on file.
-!-- Therefore, determine dimension bounds of input array.
-    lb1 = LBOUND( var,5 )
-    ub1 = UBOUND( var,5 )
-    lb2 = LBOUND( var,4 )
-    ub2 = UBOUND( var,4 )
-    lb3 = LBOUND( var,3 )
-    ub3 = UBOUND( var,3 )
-    lb4 = LBOUND( var,2 )
-    ub4 = UBOUND( var,2 )
-    lb5 = LBOUND( var,1 )
-    ub5 = UBOUND( var,1 )
-    ALLOCATE( tmp(lb1:ub1,lb2:ub2,lb3:ub3,lb4:ub4,lb5:ub5) )
-
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ i1s, i2s, i3s, i4s, i5s /),                &
-                            count = (/ count_1, count_2, count_3, count_4, count_5 /) )
-
-    CALL handle_error( 'get_variable_3d_real_dynamic', 537, variable_name )
-
-!
-!-- Assign temp array to output.  Note reverse index order
-    DO  i5 = lb5, ub5
-       DO  i4 = lb4, ub4
-          DO  i3 = lb3, ub3
-             DO i2 = lb2, ub2
-                DO  i1 = lb1, ub1
-                   var(i5,i4,i3,i2,i1) = tmp(i1,i2,i3,i4,i5)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( tmp )
-#endif
-
- END SUBROUTINE get_variable_5d_real_dynamic
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Inquires the number of variables in a file
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE inquire_num_variables( id, num_vars )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN)      ::  id              !< file id
-    INTEGER(iwp), INTENT(INOUT)   ::  num_vars        !< number of variables in a file
-
-
-#if defined( __netcdf )
-    nc_stat = NF90_INQUIRE( id, NVARIABLES = num_vars )
-    CALL handle_error( 'inquire_num_variables', 539 )
-#endif
-
- END SUBROUTINE inquire_num_variables
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Inquires the variable names belonging to a file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE inquire_variable_names( id, var_names )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) ::  var_names   !< return variable - variable names
-
-    INTEGER(iwp)                                  ::  i           !< loop variable
-    INTEGER(iwp), INTENT(IN)                      ::  id          !< file id
-    INTEGER(iwp)                                  ::  num_vars    !< number of variables (unused return parameter)
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE       ::  varids      !< dummy array to strore variable ids temporarily
-
-
-#if defined( __netcdf )
-    ALLOCATE( varids(1:SIZE(var_names)) )
-    nc_stat = NF90_INQ_VARIDS( id, NVARS = num_vars, VARIDS = varids )
-    CALL handle_error( 'inquire_variable_names', 540 )
-
-    DO  i = 1, SIZE(var_names)
-       nc_stat = NF90_INQUIRE_VARIABLE( id, varids(i), NAME = var_names(i) )
-       CALL handle_error( 'inquire_variable_names', 540 )
-    ENDDO
-
-    DEALLOCATE( varids )
-#endif
-
- END SUBROUTINE inquire_variable_names
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Inquires the _FillValue settings of an integer variable.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE inquire_fill_value_int( id, var_name, nofill, fill_value )
-
-    CHARACTER(LEN=*), INTENT(IN) ::  var_name    !< variable name
-
-    INTEGER(iwp), INTENT(IN)  ::  id          !< file id
-    INTEGER(iwp)              ::  id_var      !< netCDF variable id (varid)
-    INTEGER(iwp)              ::  fill_value  !< fill value
-    INTEGER(iwp)              ::  nofill      !< flag indicating whether fill values are set or not
-
-
-#if defined( __netcdf )
-    nc_stat = NF90_INQ_VARID( id, TRIM( var_name ), id_var )
-    nc_stat = NF90_INQ_VAR_FILL(id, id_var, no_fill, fill_value )
-#endif
-!
-!-- Further line is just to avoid compiler warnings. nofill might be used in future.
-    IF ( nofill == 0  .OR.  nofill /= 0 )  CONTINUE
-
- END SUBROUTINE inquire_fill_value_int
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Inquires the _FillValue settings of a real variable.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE inquire_fill_value_real( id, var_name, nofill, fill_value )
-
-    CHARACTER(LEN=*), INTENT(IN) ::  var_name    !< variable name
-
-    INTEGER(iwp), INTENT(IN)  ::  id          !< file id
-    INTEGER(iwp)              ::  id_var      !< netCDF variable id (varid)
-    INTEGER(iwp)              ::  nofill      !< flag indicating whether fill values are set or not
-
-#if defined( __imuk_old )
-    INTEGER(iwp)              ::  fill_value_int  !< fill value workaround
-#endif
-    REAL(wp), INTENT(OUT)     ::  fill_value  !< fill value
-
-
-#if defined( __netcdf )
-    nc_stat = NF90_INQ_VARID( id, TRIM( var_name ), id_var )
-#if defined( __imuk_old )
-    nc_stat = NF90_INQ_VAR_FILL(id, id_var, no_fill, fill_value_int )
-    fill_value = fill_value_int
-#else
-    nc_stat = NF90_INQ_VAR_FILL(id, id_var, no_fill, fill_value )
-#endif
-#endif
-!
-!-- Further line is just to avoid compiler warnings. nofill might be used in future.
-    IF ( nofill == 0  .OR.  nofill /= 0 )  CONTINUE
-
- END SUBROUTINE inquire_fill_value_real
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prints out a text message corresponding to the current status.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE handle_error( routine_name, errno, name )
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=6)           ::  message_identifier  !< string for the error number
-    CHARACTER(LEN=*), OPTIONAL ::  name                !< name of variable where reading failed
-    CHARACTER(LEN=*)           ::  routine_name        !< routine name where the error happened
-
-    INTEGER(iwp) ::  errno
-
-
-#if defined( __netcdf )
-    IF ( nc_stat /= NF90_NOERR )  THEN
-
-       WRITE( message_identifier, '(''NC'',I4.4)' )  errno
-
-       IF ( PRESENT( name ) )  THEN
-          message_string = "Problem reading attribute/variable - " //                              &
-                           TRIM(name) // ": " // TRIM( NF90_STRERROR( nc_stat ) )
-       ELSE
-          message_string = TRIM( NF90_STRERROR( nc_stat ) )
-       ENDIF
-
-       CALL message( routine_name, message_identifier, 2, 2, myid, 6, 1 )
-
-    ENDIF
-#endif
-
- END SUBROUTINE handle_error
-
-
- END MODULE netcdf_data_input_mod
Index: palm/trunk/SOURCE/netcdf_interface_mod.f90
===================================================================
--- palm/trunk/SOURCE/netcdf_interface_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,6711 +1,0 @@
-!> @file netcdf_interface_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! size of some local arrays for profiles increased from 400 to 500
-!
-! 4853 2021-01-25 07:56:09Z raasch
-! size of some local arrays for profiles increased from 300 to 400
-!
-! 4844 2021-01-18 09:22:26Z raasch
-! bugfix: size of some profile arrays increased
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! file re-formatted to follow the PALM coding standard
-!
-! 4742 2020-10-14 15:11:02Z schwenkel
-! Implement snow and graupel (bulk microphysics)
-!
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-!
-! 4455 2020-03-11 12:20:29Z Giersch
-! Axis attribute added to netcdf output
-!
-! 4400 2020-02-10 20:32:41Z suehring
-! Move routine to transform coordinates from netcdf_interface_mod to
-! basic_constants_and_equations_mod
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Adjusted output of multi-agent system for biometeorology
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! Replace function date_time_string by call to get_date_time
-!
-! 4223 2019-09-10 09:20:47Z gronemeier
-! replaced rotation angle from input-netCDF file by namelist parameter 'rotation_angle'
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4127 2019-07-30 14:47:10Z suehring
-! - Introduce new vertical dimension for plant-canopy output.
-! - Temporarlily disable masked output for soil (merge from branch resler)
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to avoid runtime error
-! (Loop variable has been modified) in time_integration
-!
-! 4046 2019-06-21 17:32:04Z knoop
-! removal of special treatment for usm_define_netcdf_grid call
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! Rename subroutines in module for diagnostic quantities
-!
-! 4029 2019-06-14 14:04:35Z raasch
-! netcdf variable NF90_NOFILL is used as argument instead of "1" in calls to NF90_DEF_VAR_FILL
-!
-! 3995 2019-05-22 18:59:54Z suehring
-! output of turbulence intensity added
-!
-! 3994 2019-05-22 18:08:09Z suehring
-! remove origin time from time unit, compose origin_time_string within subroutine
-! netcdf_create_global_atts
-!
-! 3954 2019-05-06 12:49:42Z gronemeier
-! bugfix: corrected format for date_time_string
-!
-! 3953 2019-05-06 12:11:55Z gronemeier
-! bugfix: set origin_time and starting point of time coordinate according to day_of_year_init and
-!         time_utc_init
-!
-! 3942 2019-04-30 13:08:30Z kanani
-! Add specifier to netcdf_handle_error to simplify identification of attribute
-! causing the error
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! bugfix in im_define_netcdf_grid argument list
-!
-! 3745 2019-02-15 18:57:56Z suehring
-! Add indoor model
-!
-! 3744 2019-02-15 18:38:58Z suehring
-! Bugfix: - initialize return values to ensure they are set before returning (routine
-!           define_geo_coordinates)
-!         - change order of dimensions for some variables
-!
-! 3727 2019-02-08 14:52:10Z gronemeier
-! make several routines publicly available
-!
-! 3701 2019-01-26 18:57:21Z knoop
-! Statement added to prevent compiler warning about unused variable
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Move the control parameter "salsa" from salsa_mod to control_parameters (M. Kurppa)
-!
-! Revision 1.1  2005/05/18 15:37:16  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> In case of extend = .FALSE.:
-!> Define all necessary dimensions, axes and variables for the different netCDF datasets. This
-!> subroutine is called from check_open after a new dataset is created. It leaves the open netCDF
-!> files ready to write.
-!>
-!> In case of extend = .TRUE.:
-!> Find out if dimensions and variables of an existing file match the values of the actual run. If
-!> so, get all necessary information (ids, etc.) from this file.
-!>
-!> Parameter av can assume values 0 (non-averaged data) and 1 (time averaged data)
-!>
-!> @todo calculation of output time levels for parallel NetCDF still does not cover every exception
-!        (change of dt_do, end_time in restart)
-!> @todo timeseries and profile output still needs to be rewritten to allow modularization
-!> @todo output 2d UTM coordinates without global arrays
-!> @todo output longitude/latitude also with non-parallel output (3d and xy)
-!--------------------------------------------------------------------------------------------------!
- MODULE netcdf_interface
-
-    USE control_parameters,                                                                        &
-        ONLY:  biometeorology,                                                                     &
-               fl_max,                                                                             &
-               max_masks,                                                                          &
-               multi_agent_system_end,                                                             &
-               multi_agent_system_start,                                                           &
-               rotation_angle,                                                                     &
-               var_fl_max,                                                                         &
-               varnamelength
-    USE kinds
-#if defined( __netcdf )
-    USE NETCDF
-#endif
-    USE mas_global_attributes,                                                                     &
-        ONLY:  dim_size_agtnum
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY: coord_ref_sys,                                                                       &
-              crs_list,                                                                            &
-              init_model
-
-    PRIVATE
-
-    INTEGER(iwp), PARAMETER ::  dopr_norm_num = 7, dopts_num = 29, dots_max = 100
-    INTEGER(iwp) ::  dots_num  = 25  !< number of timeseries defined by default
-    INTEGER(iwp) ::  dots_soil = 26  !< starting index for soil-timeseries
-    INTEGER(iwp) ::  dots_rad  = 32  !< starting index for radiation-timeseries
-
-    CHARACTER (LEN=16) :: heatflux_output_unit       !< unit for heatflux output
-    CHARACTER (LEN=16) :: waterflux_output_unit      !< unit for waterflux output
-    CHARACTER (LEN=16) :: momentumflux_output_unit   !< unit for momentumflux output
-    CHARACTER (LEN=40) :: netcdf_data_format_string
-
-    CHARACTER (LEN=16), DIMENSION(13) ::  agt_var_names =                                          &
-          (/ 'ag_id           ', 'ag_x            ', 'ag_y            ',                           &
-             'ag_wind         ', 'ag_temp         ', 'ag_group        ',                           &
-             'ag_iPT          ', 'ag_PM10         ', 'ag_PM25         ',                           &
-             'not_used        ', 'not_used        ', 'not_used        ',                           &
-             'not_used        ' /)
-
-    CHARACTER (LEN=16), DIMENSION(13) ::  agt_var_units =                                          &
-          (/ 'dim_less        ', 'meters          ', 'meters          ',                           &
-             'm/s             ', 'K               ', 'dim_less        ',                           &
-             'C               ', 'tbd             ', 'tbd             ',                           &
-             'tbd             ', 'not_used        ', 'not_used        ',                           &
-             'not_used        ' /)
-
-    CHARACTER (LEN=20), DIMENSION(fl_max)            :: dofl_dim_label_x
-    CHARACTER (LEN=20), DIMENSION(fl_max)            :: dofl_dim_label_y
-    CHARACTER (LEN=20), DIMENSION(fl_max)            :: dofl_dim_label_z
-    CHARACTER (LEN=20), DIMENSION(fl_max*var_fl_max) :: dofl_label
-    CHARACTER (LEN=20), DIMENSION(fl_max*var_fl_max) :: dofl_unit
-
-    CHARACTER (LEN=7), DIMENSION(dopr_norm_num) ::  dopr_norm_names =                              &
-         (/ 'wtheta0', 'ws2    ', 'tsw2   ', 'ws3    ', 'ws2tsw ', 'wstsw2 ', 'z_i    ' /)
-
-    CHARACTER (LEN=7), DIMENSION(dopr_norm_num) ::  dopr_norm_longnames =                          &
-         (/ 'wtheta0', 'w*2    ', 't*w2   ', 'w*3    ', 'w*2t*w ', 'w*t*w2 ', 'z_i    ' /)
-
-    CHARACTER (LEN=9), DIMENSION(500) ::  dopr_unit = 'unknown'
-
-    CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_label =                                       &
-          (/ 'tnpt   ', 'x_     ', 'y_     ', 'z_     ', 'z_abs  ', 'u      ',                     &
-             'v      ', 'w      ', 'u"     ', 'v"     ', 'w"     ', 'npt_up ',                     &
-             'w_up   ', 'w_down ', 'radius ', 'r_min  ', 'r_max  ', 'npt_max',                     &
-             'npt_min', 'x*2    ', 'y*2    ', 'z*2    ', 'u*2    ', 'v*2    ',                     &
-             'w*2    ', 'u"2    ', 'v"2    ', 'w"2    ', 'npt*2  ' /)
-
-    CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_unit =                                        &
-          (/ 'number ', 'm      ', 'm      ', 'm      ', 'm      ', 'm/s    ',                     &
-             'm/s    ', 'm/s    ', 'm/s    ', 'm/s    ', 'm/s    ', 'number ',                     &
-             'm/s    ', 'm/s    ', 'm      ', 'm      ', 'm      ', 'number ',                     &
-             'number ', 'm2     ', 'm2     ', 'm2     ', 'm2/s2  ', 'm2/s2  ',                     &
-             'm2/s2  ', 'm2/s2  ', 'm2/s2  ', 'm2/s2  ', 'number2' /)
-
-    CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_label =                                        &
-          (/ 'E            ', 'E*           ', 'dt           ',                                    &
-             'us*          ', 'th*          ', 'umax         ',                                    &
-             'vmax         ', 'wmax         ', 'div_new      ',                                    &
-             'div_old      ', 'zi_wtheta    ', 'zi_theta     ',                                    &
-             'w*           ', 'w"theta"0    ', 'w"theta"     ',                                    &
-             'wtheta       ', 'theta(0)     ', 'theta(z_mo)  ',                                    &
-             'w"u"0        ', 'w"v"0        ', 'w"q"0        ',                                    &
-             'ol           ', 'q*           ', 'w"s"         ',                                    &
-             's*           ', 'ghf          ', 'qsws_liq     ',                                    &
-             'qsws_soil    ', 'qsws_veg     ', 'r_a          ',                                    &
-             'r_s          ',                                                                      &
-             'rad_net      ', 'rad_lw_in    ', 'rad_lw_out   ',                                    &
-             'rad_sw_in    ', 'rad_sw_out   ', 'rrtm_aldif   ',                                    &
-             'rrtm_aldir   ', 'rrtm_asdif   ', 'rrtm_asdir   ',                                    &
-             ( 'unknown      ', i9 = 1, dots_max-40 ) /)
-
-    CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_unit =                                         &
-          (/ 'm2/s2        ', 'm2/s2        ', 's            ',                                    &
-             'm/s          ', 'K            ', 'm/s          ',                                    &
-             'm/s          ', 'm/s          ', 's-1          ',                                    &
-             's-1          ', 'm            ', 'm            ',                                    &
-             'm/s          ', 'K m/s        ', 'K m/s        ',                                    &
-             'K m/s        ', 'K            ', 'K            ',                                    &
-             'm2/s2        ', 'm2/s2        ', 'kg m/s       ',                                    &
-             'm            ', 'kg/kg        ', 'kg m/(kg s)  ',                                    &
-             'kg/kg        ', 'W/m2         ', 'W/m2         ',                                    &
-             'W/m2         ', 'W/m2         ', 's/m          ',                                    &
-             's/m          ',                                                                      &
-             'W/m2         ', 'W/m2         ', 'W/m2         ',                                    &
-             'W/m2         ', 'W/m2         ', '             ',                                    &
-             '             ', '             ', '             ',                                    &
-             ( 'unknown      ', i9 = 1, dots_max-40 ) /)
-
-    CHARACTER (LEN=20), DIMENSION(11) ::  netcdf_precision = ' '
-
-    CHARACTER (LEN=7), DIMENSION(0:1,500) ::  do2d_unit, do3d_unit
-
-!    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_names = &
-!          (/ 'pt_age          ', 'pt_dvrp_size    ', 'pt_origin_x     ', &
-!             'pt_origin_y     ', 'pt_origin_z     ', 'pt_radius       ', &
-!             'pt_speed_x      ', 'pt_speed_y      ', 'pt_speed_z      ', &
-!             'pt_weight_factor', 'pt_x            ', 'pt_y            ', &
-!             'pt_z            ', 'pt_color        ', 'pt_group        ', &
-!             'pt_tailpoints   ', 'pt_tail_id      ', 'pt_density_ratio', &
-!             'pt_exp_arg      ', 'pt_exp_term     ', 'not_used        ', &
-!             'not_used        ', 'not_used        ', 'not_used        ', &
-!             'not_used        ' /)
-
-!    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_units = &
-!          (/ 'seconds         ', 'meters          ', 'meters          ', &
-!             'meters          ', 'meters          ', 'meters          ', &
-!             'm/s             ', 'm/s             ', 'm/s             ', &
-!             'factor          ', 'meters          ', 'meters          ', &
-!             'meters          ', 'none            ', 'none            ', &
-!             'none            ', 'none            ', 'ratio           ', &
-!             'none            ', 'none            ', 'not_used        ', &
-!             'not_used        ', 'not_used        ', 'not_used        ', &
-!             'not_used        ' /)
-
-    INTEGER(iwp) ::  dofl_time_count
-
-    INTEGER(iwp) ::  id_dim_agtnum, id_dim_time_agt, id_dim_time_fl, id_dim_time_pr,               &
-                     id_dim_time_pts, id_dim_time_sp, id_dim_time_ts, id_dim_x_sp, id_dim_y_sp,    &
-                     id_dim_zu_sp, id_dim_zw_sp,                                                   &
-                     id_set_agt, id_set_fl, id_set_pr, id_set_prt, id_set_pts, id_set_sp,          &
-                     id_set_ts,                                                                    &
-                     id_var_agtnum, id_var_time_agt, id_var_time_fl, id_var_rnoa_agt,              &
-                     id_var_time_pr, id_var_time_pts, id_var_time_sp, id_var_time_ts, id_var_x_sp, &
-                     id_var_y_sp, id_var_zu_sp, id_var_zw_sp,                                      &
-                     nc_stat
-
-    INTEGER      ::  netcdf_data_format = 2  !< NetCDF3 64bit offset format
-    INTEGER      ::  netcdf_deflate = 0      !< NetCDF compression, default: no
-                                             !< compression
-
-    INTEGER(iwp), DIMENSION(20)            ::  id_var_agt
-    INTEGER(iwp), DIMENSION(10)            ::  id_var_dospx, id_var_dospy
-    INTEGER(iwp), DIMENSION(dopr_norm_num) ::  id_var_norm_dopr
-!    INTEGER(iwp), DIMENSION(20)            ::  id_var_prt
-    INTEGER(iwp), DIMENSION(11)            ::  nc_precision
-
-    INTEGER(iwp), DIMENSION(fl_max)            ::  id_dim_x_fl, id_dim_y_fl, id_dim_z_fl
-    INTEGER(iwp), DIMENSION(fl_max*var_fl_max) :: id_var_dofl
-    INTEGER(iwp), DIMENSION(fl_max)            ::  id_var_x_fl, id_var_y_fl, id_var_z_fl
-
-    INTEGER(iwp), DIMENSION(0:1) ::  id_dim_time_xy, id_dim_time_xz, id_dim_time_yz,               &
-                                     id_dim_time_3d, id_dim_x_xy, id_dim_xu_xy, id_dim_x_xz,       &
-                                     id_dim_xu_xz, id_dim_x_yz, id_dim_xu_yz, id_dim_x_3d,         &
-                                     id_dim_xu_3d, id_dim_y_xy, id_dim_yv_xy, id_dim_y_xz,         &
-                                     id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, id_dim_y_3d,         &
-                                     id_dim_yv_3d, id_dim_zs_xy, id_dim_zs_xz, id_dim_zs_yz,       &
-                                     id_dim_zs_3d, id_dim_zpc_3d, id_dim_zu_xy, id_dim_zu1_xy,     &
-                                     id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy,       &
-                                     id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d,                     &
-                                     id_set_xy, id_set_xz, id_set_yz, id_set_3d,                   &
-                                     id_var_ind_x_yz, id_var_ind_y_xz, id_var_ind_z_xy,            &
-                                     id_var_time_xy, id_var_time_xz, id_var_time_yz,               &
-                                     id_var_time_3d, id_var_x_xy, id_var_xu_xy, id_var_x_xz,       &
-                                     id_var_xu_xz, id_var_x_yz, id_var_xu_yz, id_var_x_3d,         &
-                                     id_var_xu_3d, id_var_y_xy, id_var_yv_xy, id_var_y_xz,         &
-                                     id_var_yv_xz, id_var_y_yz, id_var_yv_yz, id_var_y_3d,         &
-                                     id_var_yv_3d, id_var_zs_xy, id_var_zs_xz, id_var_zs_yz,       &
-                                     id_var_zs_3d, id_var_zpc_3d, id_var_zusi_xy, id_var_zusi_3d,  &
-                                     id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, id_var_zu_yz,      &
-                                     id_var_zu_3d, id_var_zwwi_xy, id_var_zwwi_3d, id_var_zw_xy,   &
-                                     id_var_zw_xz, id_var_zw_yz, id_var_zw_3d
-
-    INTEGER(iwp), DIMENSION(0:2,0:1) ::  id_var_eutm_3d, id_var_eutm_xy, id_var_eutm_xz,           &
-                                         id_var_eutm_yz,                                           &
-                                         id_var_nutm_3d, id_var_nutm_xy, id_var_nutm_xz,           &
-                                         id_var_nutm_yz
-
-    INTEGER(iwp), DIMENSION(0:2,0:1) ::  id_var_lat_3d, id_var_lat_xy, id_var_lat_xz,              &
-                                         id_var_lat_yz,                                            &
-                                         id_var_lon_3d, id_var_lon_xy, id_var_lon_xz, id_var_lon_yz
-
-
-    INTEGER(iwp), DIMENSION(dopts_num,0:10) ::  id_var_dopts
-    INTEGER(iwp), DIMENSION(0:1,500)        ::  id_var_do2d, id_var_do3d
-    INTEGER(iwp), DIMENSION(500,0:99)       ::  id_dim_z_pr, id_var_dopr, id_var_z_pr
-    INTEGER(iwp), DIMENSION(dots_max,0:99)  ::  id_var_dots
-
-!
-!-- Masked output
-    CHARACTER (LEN=7), DIMENSION(max_masks,0:1,100) ::  domask_unit
-
-    INTEGER(iwp), DIMENSION(1:max_masks,0:1) ::  id_dim_time_mask, id_dim_x_mask, id_dim_xu_mask,  &
-                                                 id_dim_y_mask, id_dim_yv_mask, id_dim_zs_mask,    &
-                                                 id_dim_zu_mask, id_dim_zw_mask,                   &
-                                                 id_set_mask,                                      &
-                                                 id_var_time_mask, id_var_x_mask, id_var_xu_mask,  &
-                                                 id_var_y_mask, id_var_yv_mask, id_var_zs_mask,    &
-                                                 id_var_zu_mask, id_var_zw_mask,                   &
-                                                 id_var_zusi_mask, id_var_zwwi_mask
-
-
-    INTEGER(iwp), DIMENSION(1:max_masks,0:1,100) ::  id_var_domask
-    INTEGER(iwp), DIMENSION(0:2,1:max_masks,0:1) ::  id_var_eutm_mask, id_var_nutm_mask
-    INTEGER(iwp), DIMENSION(0:2,1:max_masks,0:1) ::  id_var_lat_mask, id_var_lon_mask
-
-
-    LOGICAL ::  output_for_t0 = .FALSE.
-
-    REAL(wp) ::  fill_value = -9999.0_wp    !< value for the _FillValue attribute
-
-
-    PUBLIC  dofl_dim_label_x, dofl_dim_label_y, dofl_dim_label_z, dofl_label, dofl_time_count,     &
-            dofl_unit, domask_unit, dopr_unit, dopts_num, dots_label, dots_max, dots_num, dots_rad,&
-            dots_soil, dots_unit, do2d_unit, do3d_unit, fill_value, id_set_agt, id_set_fl,         &
-            id_set_mask, id_set_pr, id_set_prt, id_set_pts, id_set_sp, id_set_ts, id_set_xy,       &
-            id_set_xz, id_set_yz, id_set_3d, id_var_agt, id_var_domask, id_var_dofl, id_var_dopr,  &
-            id_var_dopts, id_var_dospx, id_var_dospy, id_var_dots, id_var_do2d, id_var_do3d,       &
-            id_var_norm_dopr, id_var_time_agt, id_var_time_fl, id_var_time_mask, id_var_time_pr,   &
-            id_var_rnoa_agt, id_var_time_pts, id_var_time_sp, id_var_time_ts, id_var_time_xy,      &
-            id_var_time_xz, id_var_time_yz, id_var_time_3d, id_var_x_fl, id_var_y_fl, id_var_z_fl, &
-            nc_stat, netcdf_data_format, netcdf_data_format_string, netcdf_deflate,                &
-            netcdf_precision, output_for_t0, heatflux_output_unit, waterflux_output_unit,          &
-            momentumflux_output_unit
-
-    SAVE
-
-    INTERFACE netcdf_create_dim
-       MODULE PROCEDURE netcdf_create_dim
-    END INTERFACE netcdf_create_dim
-
-    INTERFACE netcdf_create_file
-       MODULE PROCEDURE netcdf_create_file
-    END INTERFACE netcdf_create_file
-
-    INTERFACE netcdf_create_global_atts
-       MODULE PROCEDURE netcdf_create_global_atts
-    END INTERFACE netcdf_create_global_atts
-
-    INTERFACE netcdf_create_var
-       MODULE PROCEDURE netcdf_create_var
-    END INTERFACE netcdf_create_var
-
-    INTERFACE netcdf_create_att
-       MODULE PROCEDURE netcdf_create_att_string
-    END INTERFACE netcdf_create_att
-
-    INTERFACE netcdf_define_header
-       MODULE PROCEDURE netcdf_define_header
-    END INTERFACE netcdf_define_header
-
-    INTERFACE netcdf_handle_error
-       MODULE PROCEDURE netcdf_handle_error
-    END INTERFACE netcdf_handle_error
-
-    INTERFACE netcdf_open_write_file
-       MODULE PROCEDURE netcdf_open_write_file
-    END INTERFACE netcdf_open_write_file
-
-    PUBLIC netcdf_create_att, netcdf_create_dim, netcdf_create_file, netcdf_create_global_atts,    &
-           netcdf_create_var, netcdf_define_header, netcdf_handle_error, netcdf_open_write_file
-
- CONTAINS
-
- SUBROUTINE netcdf_define_header( callmode, extend, av )
-
-#if defined( __netcdf )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zu, zw
-
-    USE biometeorology_mod,                                                                        &
-        ONLY:  bio_define_netcdf_grid
-
-    USE chemistry_model_mod,                                                                       &
-        ONLY:  chem_define_netcdf_grid
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  convert_utm_to_geographic,                                                          &
-               pi
-
-    USE control_parameters,                                                                        &
-        ONLY:  agent_time_unlimited, air_chemistry, averaging_interval, averaging_interval_pr,     &
-               data_output_pr, domask, dopr_n, dopr_time_count, dopts_time_count, dots_time_count, &
-               do2d, do2d_at_begin, do2d_xz_time_count, do3d, do3d_at_begin, do2d_yz_time_count,   &
-               dt_data_output_av, dt_do2d_xy, dt_do2d_xz, dt_do2d_yz, dt_do3d, dt_write_agent_data,&
-               mask_size, do2d_xy_time_count, do3d_time_count, domask_time_count, end_time,        &
-               indoor_model, land_surface, mask_size_l, mask_i, mask_i_global, mask_j,             &
-               mask_j_global, mask_k_global, mask_surface, message_string, ntdim_2d_xy,            &
-               ntdim_2d_xz, ntdim_2d_yz, ntdim_3d, nz_do3d, ocean_mode, plant_canopy,              &
-               run_description_header, salsa, section, simulated_time, simulated_time_at_begin,    &
-               skip_time_data_output_av, skip_time_do2d_xy, skip_time_do2d_xz, skip_time_do2d_yz,  &
-               skip_time_do3d, topography, num_leg, num_var_fl, urban_surface
-
-    USE diagnostic_output_quantities_mod,                                                          &
-        ONLY:  doq_define_netcdf_grid
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy, zu_s_inner, zw_w_inner
-
-    USE gust_mod,                                                                                  &
-        ONLY: gust_define_netcdf_grid, gust_module_enabled
-
-    USE indices,                                                                                   &
-        ONLY:  nx, nxl, nxr, ny, nys, nyn, nz ,nzb, nzt
-
-    USE kinds
-
-    USE indoor_model_mod,                                                                          &
-        ONLY: im_define_netcdf_grid
-
-    USE land_surface_model_mod,                                                                    &
-        ONLY: lsm_define_netcdf_grid, nzb_soil, nzt_soil, nzs, zs
-
-    USE ocean_mod,                                                                                 &
-        ONLY:  ocean_define_netcdf_grid
-
-    USE pegrid
-
-    USE particle_attributes,                                                                       &
-        ONLY:  number_of_particle_groups
-
-    USE plant_canopy_model_mod,                                                                    &
-        ONLY:  pch_index, pcm_define_netcdf_grid
-
-    USE profil_parameter,                                                                          &
-        ONLY:  crmax, cross_profiles, dopr_index, profile_columns, profile_rows
-
-    USE radiation_model_mod,                                                                       &
-        ONLY: radiation, radiation_define_netcdf_grid
-
-    USE salsa_mod,                                                                                 &
-        ONLY:  salsa_define_netcdf_grid
-
-    USE spectra_mod,                                                                               &
-        ONLY:  averaging_interval_sp, comp_spectra_level, data_output_sp, dosp_time_count,         &
-               spectra_direction
-
-    USE statistics,                                                                                &
-        ONLY:  hom, statistic_regions
-
-    USE turbulence_closure_mod,                                                                    &
-        ONLY:  tcm_define_netcdf_grid
-
-    USE urban_surface_mod,                                                                         &
-        ONLY:  usm_define_netcdf_grid
-
-    USE user,                                                                                      &
-        ONLY:  user_module_enabled, user_define_netcdf_grid
-
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=2), INTENT (IN) ::  callmode              !<
-    CHARACTER (LEN=4000)           ::  char_cross_profiles   !<
-    CHARACTER (LEN=4)              ::  grid_x                !<
-    CHARACTER (LEN=4)              ::  grid_y                !<
-    CHARACTER (LEN=4)              ::  grid_z                !<
-    CHARACTER (LEN=6)              ::  mode                  !<
-    CHARACTER (LEN=20)             ::  netcdf_var_name       !<
-    CHARACTER (LEN=10)             ::  precision             !<
-    CHARACTER (LEN=3)              ::  suffix                !<
-    CHARACTER (LEN=80)             ::  time_average_text     !<
-    CHARACTER (LEN=varnamelength)  ::  trimvar               !< TRIM of output-variable string
-    CHARACTER (LEN=10)             ::  var                   !<
-    CHARACTER (LEN=4000)           ::  var_list              !<
-    CHARACTER (LEN=4000)           ::  var_list_old          !<
-
-    CHARACTER (LEN=100), DIMENSION(1:crmax) ::  cross_profiles_adj   !<
-    CHARACTER (LEN=100), DIMENSION(1:crmax) ::  cross_profiles_char  !<
-
-    INTEGER(iwp) ::  av                                      !<
-    INTEGER(iwp) ::  cross_profiles_count                    !<
-    INTEGER(iwp) ::  cross_profiles_maxi                     !<
-    INTEGER(iwp) ::  delim                                   !<
-    INTEGER(iwp) ::  delim_old                               !<
-    INTEGER(iwp) ::  file_id                                 !<
-    INTEGER(iwp) ::  i                                       !<
-    INTEGER(iwp) ::  id_last                                 !<
-    INTEGER(iwp) ::  id_x                                    !<
-    INTEGER(iwp) ::  id_y                                    !<
-    INTEGER(iwp) ::  id_z                                    !<
-    INTEGER(iwp) ::  j                                       !<
-    INTEGER(iwp) ::  k                                       !<
-    INTEGER(iwp) ::  kk                                      !<
-    INTEGER(iwp) ::  l                                       !<
-    INTEGER(iwp) ::  mid                                     !< masked output running index
-    INTEGER(iwp) ::  ns                                      !<
-    INTEGER(iwp) ::  ns_do                                   !< actual value of ns for soil model data
-    INTEGER(iwp) ::  ns_old                                  !<
-    INTEGER(iwp) ::  ntime_count                             !< number of time levels found in file
-    INTEGER(iwp) ::  nz_old                                  !<
-
-    INTEGER(iwp), SAVE ::  oldmode                           !<
-
-    INTEGER(iwp), DIMENSION(1) ::  id_dim_time_old           !<
-    INTEGER(iwp), DIMENSION(1) ::  id_dim_x_yz_old           !<
-    INTEGER(iwp), DIMENSION(1) ::  id_dim_y_xz_old           !<
-    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_sp_old          !<
-    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_xy_old          !<
-    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_3d_old          !<
-    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_mask_old        !<
-
-
-    INTEGER(iwp), DIMENSION(1:crmax) ::  cross_profiles_numb !<
-
-    LOGICAL, INTENT (INOUT) ::  extend                       !<
-    LOGICAL                 ::  found                        !<
-
-    LOGICAL, SAVE ::  init_netcdf = .FALSE.                  !<
-
-    REAL(wp) ::  cos_rot_angle                               !< cosine of rotation_angle
-    REAL(wp) ::  eutm                                        !< easting (UTM)
-    REAL(wp) ::  nutm                                        !< northing (UTM)
-    REAL(wp) ::  shift_x                                     !< shift of x coordinate
-    REAL(wp) ::  shift_y                                     !< shift of y coordinate
-    REAL(wp) ::  sin_rot_angle                               !< sine of rotation_angle
-
-    REAL(wp), DIMENSION(1) ::  last_time_coordinate          !< last time value in file
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE   ::  netcdf_data    !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  netcdf_data_2d !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lat            !< latitude
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lon            !< longitude
-
-
-!
-!-- Initializing actions
-    IF ( .NOT. init_netcdf )  THEN
-!
-!--    Check and set accuracy for netCDF output. First set default value.
-       nc_precision = NF90_REAL4
-
-       i = 1
-       DO  WHILE ( netcdf_precision(i) /= ' ' )
-          j = INDEX( netcdf_precision(i), '_' )
-          IF ( j == 0 )  THEN
-             WRITE ( message_string, * ) 'netcdf_precision must contain a ',                       &
-                                         '"_"netcdf_precision(', i, ')="',                         &
-                                         TRIM( netcdf_precision(i) ),'"'
-             CALL message( 'netcdf_define_header', 'PA0241', 2, 2, 0, 6, 0 )
-          ENDIF
-
-          var       = netcdf_precision(i)(1:j-1)
-          precision = netcdf_precision(i)(j+1:)
-
-          IF ( precision == 'NF90_REAL4' )  THEN
-             j = NF90_REAL4
-          ELSEIF ( precision == 'NF90_REAL8' )  THEN
-             j = NF90_REAL8
-          ELSE
-             WRITE ( message_string, * ) 'illegal netcdf precision: ',                             &
-                                         'netcdf_precision(', i, ')="',                            &
-                                         TRIM( netcdf_precision(i) ),'"'
-             CALL message( 'netcdf_define_header', 'PA0242', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          SELECT CASE ( var )
-             CASE ( 'xy' )
-                nc_precision(1) = j
-             CASE ( 'xz' )
-                nc_precision(2) = j
-             CASE ( 'yz' )
-                nc_precision(3) = j
-             CASE ( '2d' )
-                nc_precision(1:3) = j
-             CASE ( '3d' )
-                nc_precision(4) = j
-             CASE ( 'pr' )
-                nc_precision(5) = j
-             CASE ( 'ts' )
-                nc_precision(6) = j
-             CASE ( 'sp' )
-                nc_precision(7) = j
-             CASE ( 'prt' )
-                nc_precision(8) = j
-             CASE ( 'masks' )
-                nc_precision(11) = j
-             CASE ( 'fl' )
-                nc_precision(9) = j
-             CASE ( 'all' )
-                nc_precision    = j
-
-             CASE DEFAULT
-                WRITE ( message_string, * ) 'unknown variable in ' // 'initialization_parameters ',&
-                                            'assignment: netcdf_precision(', i, ')="',             &
-                                            TRIM( netcdf_precision(i) ),'"'
-                CALL message( 'netcdf_define_header', 'PA0243', 1, 2, 0, 6, 0 )
-
-          END SELECT
-
-          i = i + 1
-          IF ( i > 50 )  EXIT
-       ENDDO
-
-!
-!--    Check for allowed parameter range
-       IF ( netcdf_deflate < 0  .OR.  netcdf_deflate > 9 )  THEN
-          WRITE ( message_string, '(A,I3,A)' ) 'netcdf_deflate out of ' // 'range & given value: ',&
-                                               netcdf_deflate, ', allowed range: 0-9'
-          CALL message( 'netcdf_define_header', 'PA0355', 2, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Data compression does not work with parallel NetCDF/HDF5
-       IF ( netcdf_deflate > 0  .AND.  netcdf_data_format /= 3 )  THEN
-          message_string = 'netcdf_deflate reset to 0'
-          CALL message( 'netcdf_define_header', 'PA0356', 0, 1, 0, 6, 0 )
-
-          netcdf_deflate = 0
-       ENDIF
-
-       init_netcdf = .TRUE.
-
-    ENDIF
-
-!
-!-- Determine the mode to be processed
-    IF ( extend )  THEN
-       mode = callmode // '_ext'
-    ELSE
-       mode = callmode // '_new'
-    ENDIF
-
-!
-!-- Select the mode to be processed. Possibilities are 3d, ma (mask), xy, xz, yz, pr (profiles), ps
-!-- (particle timeseries), fl (flight data), ts (timeseries) or sp (spectra).
-    SELECT CASE ( mode )
-
-       CASE ( 'ma_new' )
-
-!
-!--       Decompose actual parameter file_id (=formal parameter av) into mid and av
-          file_id = av
-          IF ( file_id <= 200+max_masks )  THEN
-             mid = file_id - 200
-             av = 0
-          ELSE
-             mid = file_id - (200+max_masks)
-             av = 1
-          ENDIF
-
-!
-!--       Define some global attributes of the dataset
-          IF ( av == 0 )  THEN
-             CALL netcdf_create_global_atts( id_set_mask(mid,av), 'podsmasked',                    &
-                                             TRIM( run_description_header ), 464 )
-             time_average_text = ' '
-          ELSE
-             CALL netcdf_create_global_atts( id_set_mask(mid,av), 'podsmasked',                    &
-                                             TRIM( run_description_header ), 464 )
-             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
-             nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'time_avg',                 &
-                                     TRIM( time_average_text ) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 466 )
-          ENDIF
-
-!
-!--       Define time coordinate for volume data (unlimited dimension)
-          CALL netcdf_create_dim( id_set_mask(mid,av), 'time', NF90_UNLIMITED,                     &
-                                  id_dim_time_mask(mid,av), 467 )
-          CALL netcdf_create_var( id_set_mask(mid,av),                                             &
-                                  (/ id_dim_time_mask(mid,av) /), 'time',                          &
-                                  NF90_DOUBLE, id_var_time_mask(mid,av),                           &
-                                 'seconds', 'time', 468, 469, 000 )
-          CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av),                   &
-                                  'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av), 'axis', 'T', 000)
-
-!
-!--       Define spatial dimensions and coordinates:
-          IF ( mask_surface(mid) )  THEN
-!
-!--          In case of terrain-following output, the vertical dimensions are indices, not meters.
-             CALL netcdf_create_dim( id_set_mask(mid,av), 'ku_above_surf',                         &
-                                     mask_size(mid,3), id_dim_zu_mask(mid,av),                     &
-                                     470 )
-             CALL netcdf_create_var( id_set_mask(mid,av),                                          &
-                                     (/ id_dim_zu_mask(mid,av) /),                                 &
-                                     'ku_above_surf',                                              &
-                                     NF90_DOUBLE, id_var_zu_mask(mid,av),                          &
-                                     '1', 'grid point above terrain',                              &
-                                     471, 472, 000 )
-             CALL netcdf_create_att( id_set_mask(mid,av), id_var_zu_mask(mid,av), 'axis', 'Z', 000)
-
-             CALL netcdf_create_dim( id_set_mask(mid,av), 'kw_above_surf',                         &
-                                     mask_size(mid,3), id_dim_zw_mask(mid,av),                     &
-                                     473 )
-             CALL netcdf_create_var( id_set_mask(mid,av),                                          &
-                                     (/ id_dim_zw_mask(mid,av) /),                                 &
-                                     'kw_above_surf',                                              &
-                                     NF90_DOUBLE, id_var_zw_mask(mid,av),                          &
-                                    '1', 'grid point above terrain',                               &
-                                    474, 475, 000 )
-             CALL netcdf_create_att( id_set_mask(mid,av),id_var_zw_mask(mid,av), 'axis', 'Z', 000)
-          ELSE
-!
-!--          Define vertical coordinate grid (zu grid)
-             CALL netcdf_create_dim( id_set_mask(mid,av), 'zu_3d',                                 &
-                                     mask_size(mid,3), id_dim_zu_mask(mid,av),                     &
-                                     470 )
-             CALL netcdf_create_var( id_set_mask(mid,av),                                          &
-                                     (/ id_dim_zu_mask(mid,av) /), 'zu_3d',                        &
-                                     NF90_DOUBLE, id_var_zu_mask(mid,av),                          &
-                                     'meters', '', 471, 472, 000 )
-             CALL netcdf_create_att( id_set_mask(mid,av), id_var_zu_mask(mid,av), 'axis', 'Z', 000)
-!
-!--          Define vertical coordinate grid (zw grid)
-             CALL netcdf_create_dim( id_set_mask(mid,av), 'zw_3d',                                 &
-                                     mask_size(mid,3), id_dim_zw_mask(mid,av),                     &
-                                     473 )
-             CALL netcdf_create_var( id_set_mask(mid,av),                                          &
-                                     (/ id_dim_zw_mask(mid,av) /), 'zw_3d',                        &
-                                     NF90_DOUBLE, id_var_zw_mask(mid,av),                          &
-                                    'meters', '', 474, 475, 000 )
-             CALL netcdf_create_att( id_set_mask(mid,av), id_var_zw_mask(mid,av), 'axis', 'Z', 000)
-          ENDIF
-!
-!--       Define x-axis (for scalar position)
-          CALL netcdf_create_dim( id_set_mask(mid,av), 'x', mask_size(mid,1),                      &
-                                  id_dim_x_mask(mid,av), 476 )
-          CALL netcdf_create_var( id_set_mask(mid,av),                                             &
-                                  (/ id_dim_x_mask(mid,av) /), 'x',                                &
-                                  NF90_DOUBLE, id_var_x_mask(mid,av),                              &
-                                  'meters', '', 477, 478, 000 )
-          CALL netcdf_create_att( id_set_mask(mid,av), id_var_x_mask(mid,av), 'axis', 'X', 000)
-!
-!--       Define x-axis (for u position)
-          CALL netcdf_create_dim( id_set_mask(mid,av), 'xu', mask_size(mid,1),                     &
-                                  id_dim_xu_mask(mid,av), 479 )
-          CALL netcdf_create_var( id_set_mask(mid,av),                                             &
-                                  (/ id_dim_xu_mask(mid,av) /), 'xu',                              &
-                                  NF90_DOUBLE, id_var_xu_mask(mid,av),                             &
-                                  'meters', '', 480, 481, 000 )
-          CALL netcdf_create_att( id_set_mask(mid,av), id_var_xu_mask(mid,av), 'axis', 'X', 000)
-!
-!--       Define y-axis (for scalar position)
-          CALL netcdf_create_dim( id_set_mask(mid,av), 'y', mask_size(mid,2),                      &
-                                  id_dim_y_mask(mid,av), 482 )
-          CALL netcdf_create_var( id_set_mask(mid,av),                                             &
-                                  (/ id_dim_y_mask(mid,av) /), 'y',                                &
-                                  NF90_DOUBLE, id_var_y_mask(mid,av),                              &
-                                  'meters', '', 483, 484, 000 )
-          CALL netcdf_create_att( id_set_mask(mid,av), id_var_y_mask(mid,av), 'axis', 'Y', 000)
-!
-!--       Define y-axis (for v position)
-          CALL netcdf_create_dim( id_set_mask(mid,av), 'yv', mask_size(mid,2),                     &
-                                  id_dim_yv_mask(mid,av), 485 )
-          CALL netcdf_create_var( id_set_mask(mid,av),                                             &
-                                  (/ id_dim_yv_mask(mid,av) /),                                    &
-                                  'yv', NF90_DOUBLE, id_var_yv_mask(mid,av),                       &
-                                  'meters', '', 486, 487, 000 )
-          CALL netcdf_create_att( id_set_mask(mid,av), id_var_yv_mask(mid,av), 'axis', 'Y', 000)
-!
-!--       Define UTM and geographic coordinates
-          CALL define_geo_coordinates( id_set_mask(mid,av),                                        &
-                                       (/ id_dim_x_mask(mid,av), id_dim_xu_mask(mid,av) /),        &
-                                       (/ id_dim_y_mask(mid,av), id_dim_yv_mask(mid,av) /),        &
-                                       id_var_eutm_mask(:,mid,av), id_var_nutm_mask(:,mid,av),     &
-                                       id_var_lat_mask(:,mid,av), id_var_lon_mask(:,mid,av)    )
-!
-!--       Define coordinate-reference system
-          CALL netcdf_create_crs( id_set_mask(mid,av), 000 )
-!
-!--       In case of non-flat topography define 2d-arrays containing the height information. Only
-!--       for parallel netcdf output.
-          IF ( TRIM( topography ) /= 'flat'  .AND.  netcdf_data_format > 4 )  THEN
-!
-!--          Define zusi = zu(nzb_s_inner)
-             CALL netcdf_create_var( id_set_mask(mid,av),                                          &
-                                     (/ id_dim_x_mask(mid,av), id_dim_y_mask(mid,av) /), 'zusi',   &
-                                     NF90_DOUBLE, id_var_zusi_mask(mid,av),                        &
-                                     'meters', 'zu(nzb_s_inner)', 488, 489, 490 )
-!
-!--          Define zwwi = zw(nzb_w_inner)
-             CALL netcdf_create_var( id_set_mask(mid,av),                                          &
-                                     (/ id_dim_x_mask(mid,av), id_dim_y_mask(mid,av) /), 'zwwi',   &
-                                     NF90_DOUBLE, id_var_zwwi_mask(mid,av),                        &
-                                     'meters', 'zw(nzb_w_inner)', 491, 492, 493 )
-          ENDIF
-
-          IF ( land_surface )  THEN
-!
-!--          Define vertical coordinate grid (zw grid)
-             CALL netcdf_create_dim( id_set_mask(mid,av), 'zs_3d',                                 &
-                                     mask_size(mid,3), id_dim_zs_mask(mid,av),                     &
-                                     536 )
-             CALL netcdf_create_var( id_set_mask(mid,av),                                          &
-                                     (/ id_dim_zs_mask(mid,av) /), 'zs_3d',                        &
-                                     NF90_DOUBLE, id_var_zs_mask(mid,av),                          &
-                                     'meters', '', 537, 555, 000 )
-             CALL netcdf_create_att( id_set_mask(mid,av), id_var_zs_mask(mid,av), 'axis', 'Z', 000)
-          ENDIF
-
-!
-!--       Define the variables
-          var_list = ';'
-          i = 1
-
-          DO  WHILE ( domask(mid,av,i)(1:1) /= ' ' )
-
-             trimvar = TRIM( domask(mid,av,i) )
-!
-!--          Check for the grid
-             found = .FALSE.
-             SELECT CASE ( trimvar )
-!
-!--             Most variables are defined on the scalar grid
-                CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr',                                    &
-                       'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv',                       &
-                       's', 'theta', 'thetal', 'thetav', 'qi', 'ni', 'qg', 'ng', 'qs', 'ns' )
-
-                   grid_x = 'x'
-                   grid_y = 'y'
-                   grid_z = 'zu'
-!
-!--             u grid
-                CASE ( 'u' )
-
-                   grid_x = 'xu'
-                   grid_y = 'y'
-                   grid_z = 'zu'
-!
-!--             v grid
-                CASE ( 'v' )
-
-                   grid_x = 'x'
-                   grid_y = 'yv'
-                   grid_z = 'zu'
-!
-!--             w grid
-                CASE ( 'w' )
-
-                   grid_x = 'x'
-                   grid_y = 'y'
-                   grid_z = 'zw'
-
-
-                CASE DEFAULT
-!
-!--                Check for quantities defined in other modules
-                   CALL tcm_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-
-                   IF ( .NOT. found  .AND.  air_chemistry )  THEN
-                      CALL chem_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-                   IF ( .NOT. found )                                                              &
-                      CALL doq_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-
-                   IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
-                      CALL gust_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-                   IF ( .NOT. found  .AND. land_surface )  THEN
-                      CALL lsm_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-                   IF ( .NOT. found  .AND.  ocean_mode )  THEN
-                      CALL ocean_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-                   IF ( .NOT. found  .AND.  plant_canopy )  THEN
-                      CALL pcm_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-                   IF ( .NOT. found  .AND.  radiation )  THEN
-                      CALL radiation_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-                   ENDIF
-!
-!--                Check for SALSA quantities
-                   IF ( .NOT. found  .AND.  salsa )  THEN
-                      CALL salsa_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-                   IF ( .NOT. found  .AND.  urban_surface )  THEN
-                      CALL usm_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-                   ENDIF
-!
-!--                Now check for user-defined quantities
-                   IF ( .NOT. found  .AND.  user_module_enabled )  THEN
-                      CALL user_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-                   IF ( .NOT. found )  THEN
-                      WRITE ( message_string, * ) 'no grid defined for variable ', TRIM( trimvar )
-                      CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, 6, 0 )
-                   ENDIF
-
-             END SELECT
-
-!
-!--          Select the respective dimension ids
-             IF ( grid_x == 'x' )  THEN
-                id_x = id_dim_x_mask(mid,av)
-             ELSEIF ( grid_x == 'xu' )  THEN
-                id_x = id_dim_xu_mask(mid,av)
-             ENDIF
-
-             IF ( grid_y == 'y' )  THEN
-                id_y = id_dim_y_mask(mid,av)
-             ELSEIF ( grid_y == 'yv' )  THEN
-                id_y = id_dim_yv_mask(mid,av)
-             ENDIF
-
-             IF ( grid_z == 'zu' )  THEN
-                id_z = id_dim_zu_mask(mid,av)
-             ELSEIF ( grid_z == 'zw' )  THEN
-                id_z = id_dim_zw_mask(mid,av)
-             ELSEIF ( grid_z == "zs" )  THEN
-                id_z = id_dim_zs_mask(mid,av)
-             ENDIF
-
-!
-!--          Define the grid
-             CALL netcdf_create_var( id_set_mask(mid,av),                                          &
-                                     (/ id_x, id_y, id_z, id_dim_time_mask(mid,av) /),             &
-                                     domask(mid,av,i), nc_precision(11),                           &
-                                     id_var_domask(mid,av,i),                                      &
-                                     TRIM( domask_unit(mid,av,i) ),                                &
-                                     domask(mid,av,i), 494, 495, 496, .TRUE. )
-
-             var_list = TRIM( var_list ) // TRIM( domask(mid,av,i) ) // ';'
-
-             i = i + 1
-
-          ENDDO
-
-!
-!--       No arrays to output
-          IF ( i == 1 )  RETURN
-
-!
-!--       Write the list of variables as global attribute (this is used by restart runs and by
-!--       combine_plot_fields).
-          nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'VAR_LIST', var_list )
-          CALL netcdf_handle_error( 'netcdf_define_header', 497 )
-
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_mask(mid,av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 498 )
-
-!
-!--       Write data for x (shifted by +dx/2) and xu axis
-          ALLOCATE( netcdf_data(mask_size(mid,1)) )
-
-          netcdf_data = ( mask_i_global(mid,:mask_size(mid,1)) + 0.5_wp ) * dx
-
-          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_x_mask(mid,av),                      &
-                                  netcdf_data, start = (/ 1 /),                                    &
-                                  count = (/ mask_size(mid,1) /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 499 )
-
-          netcdf_data = mask_i_global(mid,:mask_size(mid,1)) * dx
-
-          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_xu_mask(mid,av),                     &
-                                  netcdf_data, start = (/ 1 /),                                    &
-                                  count = (/ mask_size(mid,1) /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 500 )
-
-          DEALLOCATE( netcdf_data )
-
-!
-!--       Write data for y (shifted by +dy/2) and yv axis
-          ALLOCATE( netcdf_data(mask_size(mid,2)) )
-
-          netcdf_data = ( mask_j_global(mid,:mask_size(mid,2)) + 0.5_wp ) * dy
-
-          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_y_mask(mid,av),                      &
-                                  netcdf_data, start = (/ 1 /),                                    &
-                                  count = (/ mask_size(mid,2) /))
-          CALL netcdf_handle_error( 'netcdf_define_header', 501 )
-
-          netcdf_data = mask_j_global(mid,:mask_size(mid,2)) * dy
-
-          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_yv_mask(mid,av),                     &
-                                  netcdf_data, start = (/ 1 /),                                    &
-                                  count = (/ mask_size(mid,2) /))
-          CALL netcdf_handle_error( 'netcdf_define_header', 502 )
-
-          DEALLOCATE( netcdf_data )
-
-!
-!--       Write UTM coordinates
-          IF ( rotation_angle == 0.0_wp )  THEN
-!
-!--          1D in case of no rotation
-             cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-!
-!--          x coordinates
-             ALLOCATE( netcdf_data(mask_size(mid,1)) )
-             DO  k = 0, 2
-!
-!--             Scalar grid points
-                IF ( k == 0 )  THEN
-                   shift_x = 0.5
-!
-!--             u grid points
-                ELSEIF ( k == 1 )  THEN
-                   shift_x = 0.0
-!
-!--             v grid points
-                ELSEIF ( k == 2 )  THEN
-                   shift_x = 0.5
-                ENDIF
-
-                netcdf_data = init_model%origin_x + cos_rot_angle                                  &
-                                 * ( mask_i_global(mid,:mask_size(mid,1)) + shift_x ) * dx
-
-                nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                       &
-                                        id_var_eutm_mask(k,mid,av),                                &
-                                        netcdf_data, start = (/ 1 /),                              &
-                                        count = (/ mask_size(mid,1) /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 555 )
-
-             ENDDO
-             DEALLOCATE( netcdf_data )
-!
-!--          y coordinates
-             ALLOCATE( netcdf_data(mask_size(mid,2)) )
-             DO  k = 0, 2
-!
-!--             Scalar grid points
-                IF ( k == 0 )  THEN
-                   shift_y = 0.5
-!
-!--             u grid points
-                ELSEIF ( k == 1 )  THEN
-                   shift_y = 0.5
-!
-!--             v grid points
-                ELSEIF ( k == 2 )  THEN
-                   shift_y = 0.0
-                ENDIF
-
-                netcdf_data = init_model%origin_y + cos_rot_angle                                  &
-                                 * ( mask_j_global(mid,:mask_size(mid,2)) + shift_y ) * dy
-
-                nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                       &
-                                        id_var_nutm_mask(k,mid,av),                                &
-                                        netcdf_data, start = (/ 1 /),                              &
-                                        count = (/ mask_size(mid,2) /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-             ENDDO
-             DEALLOCATE( netcdf_data )
-
-          ELSE
-!
-!--          2D in case of rotation
-             ALLOCATE( netcdf_data_2d(mask_size(mid,1),mask_size(mid,2)) )
-             cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-             sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-             DO  k = 0, 2
-!
-!--            Scalar grid points
-               IF ( k == 0 )  THEN
-                  shift_x = 0.5 ; shift_y = 0.5
-!
-!--            u grid points
-               ELSEIF ( k == 1 )  THEN
-                  shift_x = 0.0 ; shift_y = 0.5
-!
-!--            v grid points
-               ELSEIF ( k == 2 )  THEN
-                  shift_x = 0.5 ; shift_y = 0.0
-               ENDIF
-
-               DO  j = 1, mask_size(mid,2)
-                  DO  i = 1, mask_size(mid,1)
-                     netcdf_data_2d(i,j) = init_model%origin_x                                     &
-                                         + cos_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx &
-                                         + sin_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy
-                  ENDDO
-               ENDDO
-
-               nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                        &
-                                       id_var_eutm_mask(k,mid,av),                                 &
-                                       netcdf_data_2d, start = (/ 1, 1 /),                         &
-                                       count = (/ mask_size(mid,1), mask_size(mid,2) /) )
-               CALL netcdf_handle_error( 'netcdf_define_header', 555 )
-
-               DO  j = 1, mask_size(mid,2)
-                  DO  i = 1, mask_size(mid,1)
-                     netcdf_data_2d(i,j) = init_model%origin_y                                     &
-                                         - sin_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx &
-                                         + cos_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy
-                  ENDDO
-               ENDDO
-
-               nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                        &
-                                       id_var_nutm_mask(k,mid,av),                                 &
-                                       netcdf_data_2d, start = (/ 1, 1 /),                         &
-                                       count = (/ mask_size(mid,1), mask_size(mid,2) /) )
-               CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-             ENDDO
-             DEALLOCATE( netcdf_data_2d )
-          ENDIF
-!
-!--       Write lon and lat data.
-          ALLOCATE( lat(mask_size(mid,1),mask_size(mid,2)) )
-          ALLOCATE( lon(mask_size(mid,1),mask_size(mid,2)) )
-          cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-          sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-          DO  k = 0, 2
-!
-!--          Scalar grid points
-             IF ( k == 0 )  THEN
-                shift_x = 0.5 ; shift_y = 0.5
-!
-!--          u grid points
-             ELSEIF ( k == 1 )  THEN
-                shift_x = 0.0 ; shift_y = 0.5
-!
-!--          v grid points
-             ELSEIF ( k == 2 )  THEN
-                shift_x = 0.5 ; shift_y = 0.0
-             ENDIF
-
-             DO  j = 1, mask_size(mid,2)
-                DO  i = 1, mask_size(mid,1)
-                   eutm = init_model%origin_x                                                      &
-                          + cos_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx                &
-                          + sin_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy
-                   nutm = init_model%origin_y                                                      &
-                          - sin_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx                &
-                          + cos_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy
-
-                   CALL  convert_utm_to_geographic( crs_list, eutm, nutm, lon(i,j), lat(i,j) )
-                ENDDO
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                          &
-                                     id_var_lon_mask(k,mid,av),                                    &
-                                     lon, start = (/ 1, 1 /),                                      &
-                                     count = (/ mask_size(mid,1), mask_size(mid,2) /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                          &
-                                     id_var_lat_mask(k,mid,av),                                    &
-                                     lat, start = (/ 1, 1 /),                                      &
-                                     count = (/ mask_size(mid,1), mask_size(mid,2) /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-          ENDDO
-
-          DEALLOCATE( lat )
-          DEALLOCATE( lon )
-!
-!--       Write zu and zw data (vertical axes)
-          ALLOCATE( netcdf_data(mask_size(mid,3)) )
-
-          IF ( mask_surface(mid) )  THEN
-
-             netcdf_data = mask_k_global(mid,:mask_size(mid,3))
-
-             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av),                  &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ mask_size(mid,3) /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 503 )
-
-             netcdf_data = mask_k_global(mid,:mask_size(mid,3))
-
-             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av),                  &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ mask_size(mid,3) /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 504 )
-
-          ELSE
-
-             netcdf_data = zu( mask_k_global(mid,:mask_size(mid,3)) )
-
-             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av),                  &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ mask_size(mid,3) /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 503 )
-
-             netcdf_data = zw( mask_k_global(mid,:mask_size(mid,3)) )
-
-             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av),                  &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ mask_size(mid,3) /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 504 )
-
-          ENDIF
-
-          DEALLOCATE( netcdf_data )
-
-!
-!--       In case of non-flat topography write height information
-          IF ( TRIM( topography ) /= 'flat'  .AND.  netcdf_data_format > 4 )  THEN
-
-             ALLOCATE( netcdf_data_2d(mask_size_l(mid,1),mask_size_l(mid,2)) )
-             netcdf_data_2d = zu_s_inner( mask_i(mid,:mask_size_l(mid,1)),                         &
-                                          mask_j(mid,:mask_size_l(mid,2)) )
-
-             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                          &
-                                     id_var_zusi_mask(mid,av),                                     &
-                                     netcdf_data_2d,                                               &
-                                     start = (/ 1, 1 /),                                           &
-                                     count = (/ mask_size_l(mid,1), mask_size_l(mid,2) /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 505 )
-
-             netcdf_data_2d = zw_w_inner( mask_i(mid,:mask_size_l(mid,1)),                         &
-                                          mask_j(mid,:mask_size_l(mid,2)) )
-
-             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                          &
-                                     id_var_zwwi_mask(mid,av),                                     &
-                                     netcdf_data_2d,                                               &
-                                     start = (/ 1, 1 /),                                           &
-                                     count = (/ mask_size_l(mid,1), mask_size_l(mid,2) /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 506 )
-
-             DEALLOCATE( netcdf_data_2d )
-
-          ENDIF
-!
-!--       Soil is not in masked output for now - disable temporary this block
-!          IF ( land_surface )  THEN
-!
-!--          Write zs data (vertical axes for soil model), use negative values
-!--          to indicate soil depth
-!             ALLOCATE( netcdf_data(mask_size(mid,3)) )
-!
-!             netcdf_data = zs( mask_k_global(mid,:mask_size(mid,3)) )
-!
-!             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zs_mask(mid,av), &
-!                                     netcdf_data, start = (/ 1 /), &
-!                                     count = (/ mask_size(mid,3) /) )
-!             CALL netcdf_handle_error( 'netcdf_define_header', 538 )
-!
-!             DEALLOCATE( netcdf_data )
-!
-!          ENDIF
-
-!
-!--       Restore original parameter file_id (=formal parameter av) into av
-          av = file_id
-
-
-       CASE ( 'ma_ext' )
-
-!
-!--       Decompose actual parameter file_id (=formal parameter av) into mid and av
-          file_id = av
-          IF ( file_id <= 200+max_masks )  THEN
-             mid = file_id - 200
-             av = 0
-          ELSE
-             mid = file_id - (200+max_masks)
-             av = 1
-          ENDIF
-
-!
-!--       Get the list of variables and compare with the actual run.
-!--       First var_list_old has to be reset, since GET_ATT does not assign trailing blanks.
-          var_list_old = ' '
-          nc_stat = NF90_GET_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'VAR_LIST', var_list_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 507 )
-
-          var_list = ';'
-          i = 1
-          DO WHILE ( domask(mid,av,i)(1:1) /= ' ' )
-             var_list = TRIM(var_list) // TRIM( domask(mid,av,i) ) // ';'
-             i = i + 1
-          ENDDO
-
-          IF ( av == 0 )  THEN
-             var = '(mask)'
-          ELSE
-             var = '(mask_av)'
-          ENDIF
-
-          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
-             WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),                          &
-                                         ' data for mask', mid, ' from previous run found,',       &
-                                         '&but this file cannot be extended due to variable ',     &
-                                         'mismatch.&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0335', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get and compare the number of vertical gridpoints
-          nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'zu_3d', id_var_zu_mask(mid,av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 508 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av),                                    &
-                                           id_var_zu_mask(mid,av),                                 &
-                                           dimids = id_dim_zu_mask_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 509 )
-          id_dim_zu_mask(mid,av) = id_dim_zu_mask_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av),                                   &
-                                            id_dim_zu_mask(mid,av),                                &
-                                            LEN = nz_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 510 )
-
-          IF ( mask_size(mid,3) /= nz_old )  THEN
-             WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),                          &
-                                         '&data for mask', mid, ' from previous run found,',       &
-                                         ' but this file cannot be extended due to mismatch in ',  &
-                                         ' number of vertical grid points.',                       &
-                                         '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0336', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is plmask..count+1.
-!--       The current time must be larger than the last output time on the file.
-          nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'time', id_var_time_mask(mid,av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 511 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av),                                    &
-                                           id_var_time_mask(mid,av),                               &
-                                           dimids = id_dim_time_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 512 )
-          id_dim_time_mask(mid,av) = id_dim_time_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av),                                   &
-                                            id_dim_time_mask(mid,av),                              &
-                                            LEN = domask_time_count(mid,av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 513 )
-
-          nc_stat = NF90_GET_VAR( id_set_mask(mid,av),                                             &
-                                  id_var_time_mask(mid,av),                                        &
-                                  last_time_coordinate,                                            &
-                                  start = (/ domask_time_count(mid,av) /),                         &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 514 )
-
-          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-             WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),                          &
-                                         ' data for mask', mid, ' from previous run found,',       &
-                                         '&but this file cannot be extended because the current ', &
-                                         'output time is less or equal than the last output time ',&
-                                         'on this file.&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0337', 0, 1, 0, 6, 0 )
-             domask_time_count(mid,av) = 0
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the variable ids.
-          i = 1
-          DO WHILE ( domask(mid,av,i)(1:1) /= ' ' )
-             nc_stat = NF90_INQ_VARID( id_set_mask(mid,av),                                        &
-                                       TRIM( domask(mid,av,i) ),                                   &
-                                       id_var_domask(mid,av,i) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 515 )
-             i = i + 1
-          ENDDO
-
-!
-!--       Update the title attribute on file.
-!--       In order to avoid 'data mode' errors if updated attributes are larger than their original
-!--       size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF
-!--       calls. This implies a possible performance loss due to data copying; an alternative
-!--       strategy would be to ensure equal attribute size in a job chain. Maybe revise later.
-          IF ( av == 0 )  THEN
-             time_average_text = ' '
-          ELSE
-             WRITE (time_average_text, '('', '',F7.1,'' s average'')')  averaging_interval
-          ENDIF
-          nc_stat = NF90_REDEF( id_set_mask(mid,av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 516 )
-          nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'title',                       &
-                                  TRIM( run_description_header ) // TRIM( time_average_text ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 517 )
-          nc_stat = NF90_ENDDEF( id_set_mask(mid,av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 518 )
-          WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ), ' data for mask', mid,      &
-                                     ' from previous run found.', ' &This file will be extended.'
-          CALL message( 'define_netcdf_header', 'PA0338', 0, 0, 0, 6, 0 )
-!
-!--       Restore original parameter file_id (=formal parameter av) into av
-          av = file_id
-
-
-       CASE ( '3d_new' )
-
-!
-!--       Define some global attributes of the dataset
-          IF ( av == 0 )  THEN
-             CALL netcdf_create_global_atts( id_set_3d(av), '3d',                                  &
-                                             TRIM( run_description_header ), 62 )
-             time_average_text = ' '
-          ELSE
-             CALL netcdf_create_global_atts( id_set_3d(av), '3d_av',                               &
-                                             TRIM( run_description_header ), 62 )
-             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
-             nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'time_avg',                       &
-                                     TRIM( time_average_text ) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 63 )
-          ENDIF
-
-!
-!--       Define time coordinate for volume data.
-!--       For parallel output the time dimensions has to be limited, otherwise the performance drops
-!--       significantly.
-          IF ( netcdf_data_format < 5 )  THEN
-             CALL netcdf_create_dim( id_set_3d(av), 'time', NF90_UNLIMITED, id_dim_time_3d(av), 64 )
-          ELSE
-             CALL netcdf_create_dim( id_set_3d(av), 'time', ntdim_3d(av), id_dim_time_3d(av), 523 )
-          ENDIF
-
-          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_time_3d(av) /), 'time', NF90_DOUBLE,    &
-                                  id_var_time_3d(av), 'seconds', 'time', 65, 66, 00 )
-          CALL netcdf_create_att( id_set_3d(av), id_var_time_3d(av), 'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_3d(av), id_var_time_3d(av), 'axis', 'T', 000)
-!
-!--       Define spatial dimensions and coordinates:
-!--       Define vertical coordinate grid (zu grid)
-          CALL netcdf_create_dim( id_set_3d(av), 'zu_3d', nz_do3d-nzb+1, id_dim_zu_3d(av), 67 )
-          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zu_3d(av) /), 'zu_3d', NF90_DOUBLE,     &
-                                  id_var_zu_3d(av), 'meters', '', 68, 69, 00 )
-          CALL netcdf_create_att( id_set_3d(av), id_var_zu_3d(av), 'axis', 'Z', 000)
-!
-!--       Define vertical coordinate grid (zw grid)
-          CALL netcdf_create_dim( id_set_3d(av), 'zw_3d', nz_do3d-nzb+1, id_dim_zw_3d(av), 70 )
-          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zw_3d(av) /), 'zw_3d', NF90_DOUBLE,     &
-                                  id_var_zw_3d(av), 'meters', '', 71, 72, 00 )
-          CALL netcdf_create_att( id_set_3d(av), id_var_zw_3d(av), 'axis', 'Z', 000)
-!
-!--       Define x-axis (for scalar position)
-          CALL netcdf_create_dim( id_set_3d(av), 'x', nx+1, id_dim_x_3d(av), 73 )
-          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av) /), 'x', NF90_DOUBLE,          &
-                                  id_var_x_3d(av), 'meters', '', 74, 75, 00 )
-          CALL netcdf_create_att( id_set_3d(av), id_var_x_3d(av), 'axis', 'X', 000)
-!
-!--       Define x-axis (for u position)
-          CALL netcdf_create_dim( id_set_3d(av), 'xu', nx+1, id_dim_xu_3d(av), 358 )
-          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_xu_3d(av) /), 'xu', NF90_DOUBLE,        &
-                                  id_var_xu_3d(av), 'meters', '', 359, 360, 000 )
-          CALL netcdf_create_att( id_set_3d(av), id_var_xu_3d(av), 'axis', 'X', 000)
-!
-!--       Define y-axis (for scalar position)
-          CALL netcdf_create_dim( id_set_3d(av), 'y', ny+1, id_dim_y_3d(av), 76 )
-          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_y_3d(av) /), 'y', NF90_DOUBLE,          &
-                                  id_var_y_3d(av), 'meters', '', 77, 78, 00 )
-          CALL netcdf_create_att( id_set_3d(av), id_var_y_3d(av), 'axis', 'Y', 000)
-!
-!--       Define y-axis (for v position)
-          CALL netcdf_create_dim( id_set_3d(av), 'yv', ny+1, id_dim_yv_3d(av), 361 )
-          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_yv_3d(av) /), 'yv', NF90_DOUBLE,        &
-                                  id_var_yv_3d(av), 'meters', '', 362, 363, 000 )
-          CALL netcdf_create_att( id_set_3d(av), id_var_yv_3d(av), 'axis', 'Y', 000)
-!
-!--       Define UTM and geographic coordinates
-          CALL define_geo_coordinates( id_set_3d(av),                                              &
-                                       (/ id_dim_x_3d(av), id_dim_xu_3d(av) /),                    &
-                                       (/ id_dim_y_3d(av), id_dim_yv_3d(av) /),                    &
-                                       id_var_eutm_3d(:,av), id_var_nutm_3d(:,av),                 &
-                                       id_var_lat_3d(:,av), id_var_lon_3d(:,av)    )
-!
-!--       Define coordinate-reference system
-          CALL netcdf_create_crs( id_set_3d(av), 000 )
-!
-!--       In case of non-flat topography define 2d-arrays containing the height information. Only
-!--       output 2d topography information in case of parallel output.
-          IF ( TRIM( topography ) /= 'flat'  .AND.  netcdf_data_format > 4 )  THEN
-!
-!--          Define zusi = zu(nzb_s_inner)
-             CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av), id_dim_y_3d(av) /), 'zusi',&
-                                     NF90_DOUBLE, id_var_zusi_3d(av), 'meters', 'zu(nzb_s_inner)', &
-                                     413, 414, 415 )
-!
-!--          Define zwwi = zw(nzb_w_inner)
-             CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av), id_dim_y_3d(av) /), 'zwwi',&
-                                     NF90_DOUBLE, id_var_zwwi_3d(av), 'meters', 'zw(nzb_w_inner)', &
-                                     416, 417, 418 )
-
-          ENDIF
-
-          IF ( land_surface )  THEN
-!
-!--          Define vertical coordinate grid (zs grid)
-             CALL netcdf_create_dim( id_set_3d(av), 'zs_3d',                                       &
-                                     nzt_soil-nzb_soil+1, id_dim_zs_3d(av), 70 )
-             CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zs_3d(av) /), 'zs_3d', NF90_DOUBLE,  &
-                                     id_var_zs_3d(av), 'meters', '', 71, 72, 00 )
-             CALL netcdf_create_att( id_set_3d(av), id_var_zs_3d(av), 'axis', 'Z', 000)
-
-          ENDIF
-
-          IF ( plant_canopy )  THEN
-!
-!--          Define vertical coordinate grid (zpc grid)
-             CALL netcdf_create_dim( id_set_3d(av), 'zpc_3d', pch_index+1, id_dim_zpc_3d(av), 70 )
-             !netcdf_create_dim(ncid, dim_name, ncdim_type, ncdim_id, error_no)
-             CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zpc_3d(av) /), 'zpc_3d', NF90_DOUBLE,&
-                                     id_var_zpc_3d(av), 'meters', '', 71, 72, 00 )
-             CALL netcdf_create_att( id_set_3d(av), id_var_zpc_3d(av), 'axis', 'Z', 000)
-
-          ENDIF
-
-!
-!--       Define the variables
-          var_list = ';'
-          i = 1
-
-          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
-!
-!--          Temporary solution to account for data output within the new urban surface model
-!--          (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
-             trimvar = TRIM( do3d(av,i) )
-             IF ( urban_surface  .AND.  trimvar(1:4) == 'usm_' )  THEN
-                trimvar = 'usm_output'
-             ENDIF
-!
-!--          Check for the grid
-             found = .FALSE.
-             SELECT CASE ( trimvar )
-!
-!--             Most variables are defined on the scalar grid
-                CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr',                                    &
-                       'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv',                       &
-                       's', 'theta', 'thetal', 'thetav', 'qi', 'ni', 'qg', 'ng', 'qs', 'ns'  )
-
-                   grid_x = 'x'
-                   grid_y = 'y'
-                   grid_z = 'zu'
-!
-!--             u grid
-                CASE ( 'u' )
-
-                   grid_x = 'xu'
-                   grid_y = 'y'
-                   grid_z = 'zu'
-!
-!--             v grid
-                CASE ( 'v' )
-
-                   grid_x = 'x'
-                   grid_y = 'yv'
-                   grid_z = 'zu'
-!
-!--             w grid
-                CASE ( 'w' )
-
-                   grid_x = 'x'
-                   grid_y = 'y'
-                   grid_z = 'zw'
-
-!
-!--             Block of urban surface model outputs
-                CASE ( 'usm_output' )
-                   CALL usm_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-
-                CASE DEFAULT
-
-                   CALL tcm_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-
-!
-!--                Check for land surface quantities
-                   IF ( .NOT. found  .AND.  land_surface )  THEN
-                      CALL lsm_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-                   ENDIF
-!
-!--                Check for ocean quantities
-                   IF ( .NOT. found  .AND.  ocean_mode )  THEN
-                      CALL ocean_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-!
-!--                Check for plant canopy quantities
-                   IF ( .NOT. found  .AND.  plant_canopy )  THEN
-                      CALL pcm_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-!
-!--                Check for radiation quantities
-                   IF ( .NOT. found  .AND.  radiation )  THEN
-                      CALL radiation_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-!--                Check for gust module quantities
-                   IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
-                      CALL gust_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-                   ENDIF
-!
-!--                Check for indoor model quantities
-                   IF ( .NOT. found  .AND.  indoor_model ) THEN
-                      CALL im_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-!
-!--                Check for biometeorology quantities
-                   IF ( .NOT. found  .AND.  biometeorology )  THEN
-                      CALL bio_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-!
-!--                Check for chemistry quantities
-                   IF ( .NOT. found  .AND.  air_chemistry )  THEN
-                      CALL chem_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-!
-!--                Check for SALSA quantities
-                   IF ( .NOT. found  .AND.  salsa )  THEN
-                      CALL salsa_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-                   ENDIF
-!
-!--                Check for user-defined quantities
-                   IF ( .NOT. found  .AND.  user_module_enabled )  THEN
-                      CALL user_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-                   ENDIF
-
-                   IF ( .NOT. found )                                                              &
-                      CALL doq_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z )
-
-                   IF ( .NOT. found )  THEN
-                      WRITE ( message_string, * ) 'no grid defined for variable ',                 &
-                                                  TRIM( do3d(av,i) )
-                      CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, 6, 0 )
-                   ENDIF
-
-             END SELECT
-
-!
-!--          Select the respective dimension ids
-             IF ( grid_x == 'x' )  THEN
-                id_x = id_dim_x_3d(av)
-             ELSEIF ( grid_x == 'xu' )  THEN
-                id_x = id_dim_xu_3d(av)
-             ENDIF
-
-             IF ( grid_y == 'y' )  THEN
-                id_y = id_dim_y_3d(av)
-             ELSEIF ( grid_y == 'yv' )  THEN
-                id_y = id_dim_yv_3d(av)
-             ENDIF
-
-             IF ( grid_z == 'zu' )  THEN
-                id_z = id_dim_zu_3d(av)
-             ELSEIF ( grid_z == 'zw' )  THEN
-                id_z = id_dim_zw_3d(av)
-             ELSEIF ( grid_z == 'zs' )  THEN
-                id_z = id_dim_zs_3d(av)
-             ELSEIF ( grid_z == 'zpc' )  THEN
-                id_z = id_dim_zpc_3d(av)
-             ENDIF
-
-!
-!--          Define the grid
-             CALL netcdf_create_var( id_set_3d(av),(/ id_x, id_y, id_z, id_dim_time_3d(av) /),     &
-                                     do3d(av,i), nc_precision(4), id_var_do3d(av,i),               &
-                                     TRIM( do3d_unit(av,i) ), do3d(av,i), 79, 80, 357, .TRUE. )
-#if defined( __netcdf4_parallel )
-             IF ( netcdf_data_format > 4 )  THEN
-!
-!--             Set no fill for every variable to increase performance.
-                nc_stat = NF90_DEF_VAR_FILL( id_set_3d(av), id_var_do3d(av,i), NF90_NOFILL, 0 )
-                CALL netcdf_handle_error( 'netcdf_define_header', 532 )
-!
-!--             Set collective io operations for parallel io
-                nc_stat = NF90_VAR_PAR_ACCESS( id_set_3d(av), id_var_do3d(av,i), NF90_COLLECTIVE )
-                CALL netcdf_handle_error( 'netcdf_define_header', 445 )
-             ENDIF
-#endif
-             var_list = TRIM( var_list ) // TRIM( do3d(av,i) ) // ';'
-
-             i = i + 1
-
-          ENDDO
-
-!
-!--       No arrays to output
-          IF ( i == 1 )  RETURN
-
-!
-!--       Write the list of variables as global attribute (this is used by restart runs and by
-!--       combine_plot_fields).
-          nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', var_list )
-          CALL netcdf_handle_error( 'netcdf_define_header', 81 )
-
-!
-!--       Set general no fill, otherwise the performance drops significantly for parallel output.
-          nc_stat = NF90_SET_FILL( id_set_3d(av), NF90_NOFILL, oldmode )
-          CALL netcdf_handle_error( 'netcdf_define_header', 528 )
-
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_3d(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 82 )
-
-!
-!--       These data are only written by PE0 for parallel output to increase the performance.
-          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
-!
-!--          Write data for x (shifted by +dx/2) and xu axis
-             ALLOCATE( netcdf_data(0:nx) )
-
-             DO  i = 0, nx
-                netcdf_data(i) = ( i + 0.5 ) * dx
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_x_3d(av),                               &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ nx+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 83 )
-
-             DO  i = 0, nx
-                netcdf_data(i) = i * dx
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_xu_3d(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ nx+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 385 )
-
-             DEALLOCATE( netcdf_data )
-
-!
-!--          Write data for y (shifted by +dy/2) and yv axis
-             ALLOCATE( netcdf_data(0:ny) )
-
-             DO  i = 0, ny
-                netcdf_data(i) = ( i + 0.5_wp ) * dy
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_y_3d(av),                               &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ny+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 84 )
-
-             DO  i = 0, ny
-                netcdf_data(i) = i * dy
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_yv_3d(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ny+1 /))
-             CALL netcdf_handle_error( 'netcdf_define_header', 387 )
-
-             DEALLOCATE( netcdf_data )
-
-!
-!--          Write UTM coordinates
-             IF ( rotation_angle == 0.0_wp )  THEN
-!
-!--             1D in case of no rotation
-                cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-!
-!--             x coordinates
-                ALLOCATE( netcdf_data(0:nx) )
-                DO  k = 0, 2
-!
-!--                Scalar grid points
-                   IF ( k == 0 )  THEN
-                      shift_x = 0.5
-!
-!--                u grid points
-                   ELSEIF ( k == 1 )  THEN
-                      shift_x = 0.0
-!
-!--                v grid points
-                   ELSEIF ( k == 2 )  THEN
-                      shift_x = 0.5
-                   ENDIF
-
-                   DO  i = 0, nx
-                     netcdf_data(i) = init_model%origin_x + cos_rot_angle * ( i + shift_x ) * dx
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_eutm_3d(k,av),                    &
-                                           netcdf_data, start = (/ 1 /),                           &
-                                           count = (/ nx+1 /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data )
-!
-!--             y coordinates
-                ALLOCATE( netcdf_data(0:ny) )
-                DO  k = 0, 2
-!
-!--                Scalar grid points
-                   IF ( k == 0 )  THEN
-                      shift_y = 0.5
-!
-!--                u grid points
-                   ELSEIF ( k == 1 )  THEN
-                      shift_y = 0.5
-!
-!--                v grid points
-                   ELSEIF ( k == 2 )  THEN
-                      shift_y = 0.0
-                   ENDIF
-
-                   DO  j = 0, ny
-                      netcdf_data(j) = init_model%origin_y + cos_rot_angle * ( j + shift_y ) * dy
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_nutm_3d(k,av),                    &
-                                           netcdf_data, start = (/ 1 /),                           &
-                                           count = (/ ny+1 /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data )
-
-             ELSE
-!
-!--             2D in case of rotation
-                ALLOCATE( netcdf_data_2d(0:nx,0:ny) )
-                cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-                sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-                DO  k = 0, 2
-!
-!--               Scalar grid points
-                  IF ( k == 0 )  THEN
-                     shift_x = 0.5 ; shift_y = 0.5
-!
-!--               u grid points
-                  ELSEIF ( k == 1 )  THEN
-                     shift_x = 0.0 ; shift_y = 0.5
-!
-!--               v grid points
-                  ELSEIF ( k == 2 )  THEN
-                     shift_x = 0.5 ; shift_y = 0.0
-                  ENDIF
-
-                  DO  j = 0, ny
-                     DO  i = 0, nx
-                        netcdf_data_2d(i,j) = init_model%origin_x                                  &
-                                              + cos_rot_angle * ( i + shift_x ) * dx               &
-                                              + sin_rot_angle * ( j + shift_y ) * dy
-                     ENDDO
-                  ENDDO
-
-                  nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_eutm_3d(k,av),                     &
-                                          netcdf_data_2d, start = (/ 1, 1 /),                      &
-                                          count = (/ nx+1, ny+1 /) )
-                  CALL netcdf_handle_error( 'netcdf_define_header', 555 )
-
-                  DO  j = 0, ny
-                     DO  i = 0, nx
-                        netcdf_data_2d(i,j) = init_model%origin_y                                  &
-                                              - sin_rot_angle * ( i + shift_x ) * dx  &
-                                              + cos_rot_angle * ( j + shift_y ) * dy
-                     ENDDO
-                  ENDDO
-
-                  nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_nutm_3d(k,av),                     &
-                                          netcdf_data_2d, start = (/ 1, 1 /),                      &
-                                          count = (/ nx+1, ny+1 /) )
-                  CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data_2d )
-             ENDIF
-!
-!--          Write zu and zw data (vertical axes)
-             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zu_3d(av),                              &
-                                     zu(nzb:nz_do3d), start = (/ 1 /),                             &
-                                     count = (/ nz_do3d-nzb+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 85 )
-
-
-             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zw_3d(av),                              &
-                                     zw(nzb:nz_do3d), start = (/ 1 /),                             &
-                                     count = (/ nz_do3d-nzb+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 86 )
-
-             IF ( land_surface )  THEN
-!
-!--             Write zs grid
-                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zs_3d(av),                           &
-                                        - zs(nzb_soil:nzt_soil), start = (/ 1 /),                  &
-                                        count = (/ nzt_soil-nzb_soil+1 /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 86 )
-             ENDIF
-
-             IF ( plant_canopy )  THEN
-!
-!--             Write zpc grid
-                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zpc_3d(av),                          &
-                                        zu(nzb:nzb+pch_index), start = (/ 1 /),                    &
-                                        count = (/ pch_index+1 /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 86 )
-             ENDIF
-
-          ENDIF
-!
-!--       Write lon and lat data. Only for parallel output.
-          IF ( netcdf_data_format > 4 )  THEN
-
-             ALLOCATE( lat(nxl:nxr,nys:nyn) )
-             ALLOCATE( lon(nxl:nxr,nys:nyn) )
-             cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-             sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-             DO  k = 0, 2
-!
-!--             Scalar grid points
-                IF ( k == 0 )  THEN
-                   shift_x = 0.5 ; shift_y = 0.5
-!
-!--             u grid points
-                ELSEIF ( k == 1 )  THEN
-                   shift_x = 0.0 ; shift_y = 0.5
-!
-!--             v grid points
-                ELSEIF ( k == 2 )  THEN
-                   shift_x = 0.5 ; shift_y = 0.0
-                ENDIF
-
-                DO  j = nys, nyn
-                   DO  i = nxl, nxr
-                      eutm = init_model%origin_x                                                   &
-                             + cos_rot_angle * ( i + shift_x ) * dx                                &
-                             + sin_rot_angle * ( j + shift_y ) * dy
-                      nutm = init_model%origin_y                                                   &
-                             - sin_rot_angle * ( i + shift_x ) * dx                                &
-                             + cos_rot_angle * ( j + shift_y ) * dy
-
-                      CALL  convert_utm_to_geographic( crs_list, eutm, nutm, lon(i,j), lat(i,j) )
-                   ENDDO
-                ENDDO
-
-                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_lon_3d(k,av),                        &
-                                        lon, start = (/ nxl+1, nys+1 /),                           &
-                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_lat_3d(k,av),                        &
-                                        lat, start = (/ nxl+1, nys+1 /),                           &
-                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-             ENDDO
-
-             DEALLOCATE( lat )
-             DEALLOCATE( lon )
-
-          ENDIF
-!
-!--       In case of non-flat topography write height information. Only for parallel netcdf output.
-          IF ( TRIM( topography ) /= 'flat'  .AND.  netcdf_data_format > 4 )  THEN
-
-!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),                         &
-!                                        zu_s_inner(nxl:nxr+1,nys:nyn),                             &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
-!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),                         &
-!                                        zu_s_inner(nxl:nxr,nys:nyn+1),                             &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
-!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),                         &
-!                                        zu_s_inner(nxl:nxr+1,nys:nyn+1),                           &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
-!             ELSE
-                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),                         &
-                                        zu_s_inner(nxl:nxr,nys:nyn),                               &
-                                        start = (/ nxl+1, nys+1 /),                                &
-                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
-!             ENDIF
-             CALL netcdf_handle_error( 'netcdf_define_header', 419 )
-
-!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),                         &
-!                                        zw_w_inner(nxl:nxr+1,nys:nyn),                             &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
-!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),                         &
-!                                        zw_w_inner(nxl:nxr,nys:nyn+1),                             &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
-!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),                         &
-!                                        zw_w_inner(nxl:nxr+1,nys:nyn+1),                           &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
-!             ELSE
-                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),                         &
-                                        zw_w_inner(nxl:nxr,nys:nyn),                               &
-                                        start = (/ nxl+1, nys+1 /),                                &
-                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
-!             ENDIF
-             CALL netcdf_handle_error( 'netcdf_define_header', 420 )
-
-          ENDIF
-
-       CASE ( '3d_ext' )
-
-!
-!--       Get the list of variables and compare with the actual run.
-!--       First var_list_old has to be reset, since GET_ATT does not assign trailing blanks.
-          var_list_old = ' '
-          nc_stat = NF90_GET_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', var_list_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 87 )
-
-          var_list = ';'
-          i = 1
-          DO  WHILE ( do3d(av,i)(1:1) /= ' ' )
-             var_list = TRIM( var_list ) // TRIM( do3d(av,i) ) // ';'
-             i = i + 1
-          ENDDO
-
-          IF ( av == 0 )  THEN
-             var = '(3d)'
-          ELSE
-             var = '(3d_av)'
-          ENDIF
-
-          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
-             message_string = 'netCDF file for volume data ' // TRIM( var ) //                     &
-                              ' from previous run found,' //                                       &
-                              '&but this file cannot be extended due to' //                        &
-                              ' variable mismatch.' // '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0245', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get and compare the number of vertical gridpoints
-          nc_stat = NF90_INQ_VARID( id_set_3d(av), 'zu_3d', id_var_zu_3d(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 88 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_zu_3d(av),                        &
-                                           dimids = id_dim_zu_3d_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 89 )
-          id_dim_zu_3d(av) = id_dim_zu_3d_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_zu_3d(av), LEN = nz_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 90 )
-
-          IF ( nz_do3d-nzb+1 /= nz_old )  THEN
-              message_string = 'netCDF file for volume data ' // TRIM( var ) //                    &
-                               ' from previous run found,' //                                      &
-                               '&but this file cannot be extended due to' //                       &
-                               ' mismatch in number of' // ' vertical grid points (nz_do3d).' //   &
-                               '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0246', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is pl3d..count+1.
-!--       The current time must be larger than the last output time on the file.
-          nc_stat = NF90_INQ_VARID( id_set_3d(av), 'time', id_var_time_3d(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 91 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_time_3d(av),                      &
-                                           dimids = id_dim_time_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 92 )
-
-          id_dim_time_3d(av) = id_dim_time_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_time_3d(av), LEN = ntime_count )
-          CALL netcdf_handle_error( 'netcdf_define_header', 93 )
-
-!
-!--       For non-parallel output use the last output time level of the netcdf file because the time
-!--       dimension is unlimited. In case of parallel output the variable ntime_count could get the
-!--       value of 9*10E36 because the time dimension is limited.
-          IF ( netcdf_data_format < 5 ) do3d_time_count(av) = ntime_count
-
-          nc_stat = NF90_GET_VAR( id_set_3d(av), id_var_time_3d(av),                               &
-                                  last_time_coordinate,                                            &
-                                  start = (/ do3d_time_count(av) /),                               &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 94 )
-
-          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-             message_string = 'netCDF file for volume data ' // TRIM( var ) //                     &
-                              ' from previous run found,' //                                       &
-                              '&but this file cannot be extended because' //                       &
-                              ' the current output time' //                                        &
-                              '&is less or equal than the last output time' // ' on this file.' // &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0247', 0, 1, 0, 6, 0 )
-             do3d_time_count(av) = 0
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-          IF ( netcdf_data_format > 4 )  THEN
-!
-!--          Check if the needed number of output time levels is increased compared to the number of
-!--          time levels in the existing file.
-             IF ( ntdim_3d(av) > ntime_count )  THEN
-                message_string = 'netCDF file for volume data ' // TRIM( var ) //                  &
-                                 ' from previous run found,' //                                    &
-                                 '&but this file cannot be extended becaus' //                     &
-                                 'e the number of output time levels has b' //                     &
-                                 'een increased compared to the previous s' // 'imulation.' //     &
-                                 '&New file is created instead.'
-                CALL message( 'define_netcdf_header', 'PA0388', 0, 1, 0, 6, 0 )
-                do3d_time_count(av) = 0
-                extend = .FALSE.
-!
-!--             Recalculate the needed time levels for the new file.
-                IF ( av == 0 )  THEN
-                   ntdim_3d(0) = CEILING( ( end_time - MAX( skip_time_do3d,                        &
-                                                            simulated_time_at_begin )              &
-                                          ) / dt_do3d )
-                   IF ( do3d_at_begin )  ntdim_3d(0) = ntdim_3d(0) + 1
-                ELSE
-                   ntdim_3d(1) = CEILING( ( end_time - MAX( skip_time_data_output_av,              &
-                                                            simulated_time_at_begin )              &
-                                          ) / dt_data_output_av )
-                ENDIF
-                RETURN
-             ENDIF
-          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the variable ids.
-          i = 1
-          DO  WHILE ( do3d(av,i)(1:1) /= ' ' )
-             nc_stat = NF90_INQ_VARID( id_set_3d(av), TRIM( do3d(av,i) ), id_var_do3d(av,i) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 95 )
-#if defined( __netcdf4_parallel )
-!
-!--          Set collective io operations for parallel io
-             IF ( netcdf_data_format > 4 )  THEN
-                nc_stat = NF90_VAR_PAR_ACCESS( id_set_3d(av), id_var_do3d(av,i), NF90_COLLECTIVE )
-                CALL netcdf_handle_error( 'netcdf_define_header', 453 )
-             ENDIF
-#endif
-             i = i + 1
-          ENDDO
-
-!
-!--       Update the title attribute on file.
-!--       In order to avoid 'data mode' errors if updated attributes are larger than their original
-!--       size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF
-!--       calls. This implies a possible performance loss due to data copying; an alternative
-!--       strategy would be to ensure equal attribute size. Maybe revise later.
-          IF ( av == 0 )  THEN
-             time_average_text = ' '
-          ELSE
-             WRITE ( time_average_text, '('', '',F7.1,'' s average'')' ) averaging_interval
-          ENDIF
-          nc_stat = NF90_REDEF( id_set_3d(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 429 )
-          nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title',                             &
-                                  TRIM( run_description_header ) // TRIM( time_average_text ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 96 )
-          nc_stat = NF90_ENDDEF( id_set_3d(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 430 )
-          message_string = 'netCDF file for volume data ' // TRIM( var ) //                        &
-                           ' from previous run found.' // '&This file will be extended.'
-          CALL message( 'define_netcdf_header', 'PA0248', 0, 0, 0, 6, 0 )
-
-
-       CASE ( 'ag_new' )
-
-!
-!--       Define some global attributes of the dataset
-          nc_stat = NF90_PUT_ATT( id_set_agt, NF90_GLOBAL, 'title', TRIM( run_description_header ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 330 )
-!
-!--       Switch for unlimited time dimension
-          IF ( agent_time_unlimited ) THEN
-             CALL netcdf_create_dim( id_set_agt, 'time', NF90_UNLIMITED, id_dim_time_agt, 331 )
-          ELSE
-             CALL netcdf_create_dim( id_set_agt, 'time',                                           &
-                                     INT( ( MIN( multi_agent_system_end, end_time ) -              &
-                                            multi_agent_system_start ) /                           &
-                                            dt_write_agent_data * 1.1 ),                           &
-                                     id_dim_time_agt, 331 )
-          ENDIF
-
-          CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /), 'time', NF90_REAL4,           &
-                                  id_var_time_agt, 'seconds', 'time', 332, 333, 000 )
-          CALL netcdf_create_att( id_set_agt, id_var_time_agt, 'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_agt, id_var_time_agt, 'axis', 'T', 000)
-
-          CALL netcdf_create_dim( id_set_agt, 'agent_number', dim_size_agtnum, id_dim_agtnum, 334 )
-
-          CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum /), 'agent_number', NF90_REAL4,     &
-                                  id_var_agtnum, 'agent number', '', 335, 336, 000 )
-!
-!--       Define variable which contains the real number of agents in use
-          CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /), 'real_num_of_agt', NF90_REAL4,&
-                                  id_var_rnoa_agt, 'agent number', '', 337, 338, 000 )
-          i = 1
-          CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum, id_dim_time_agt /),                &
-                                  agt_var_names(i), NF90_DOUBLE, id_var_agt(i),                    &
-                                  TRIM( agt_var_units(i) ), TRIM( agt_var_names(i) ),              &
-                                  339, 340, 341 )
-!
-!--       Define the variables
-          DO  i = 2, 6
-             CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum, id_dim_time_agt /),             &
-                                     agt_var_names(i), NF90_REAL4, id_var_agt(i),                  &
-                                     TRIM( agt_var_units(i) ), TRIM( agt_var_names(i) ),           &
-                                     339, 340, 341 )
-
-          ENDDO
-!
-!--       Define vars for biometeorology
-          IF ( biometeorology )  THEN
-             CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum, id_dim_time_agt /),             &
-                                     agt_var_names(7), nc_precision(8), id_var_agt(7),             &
-                                     TRIM( agt_var_units(7) ), TRIM( agt_var_names(7) ),           &
-                                     339, 340, 341 )
-          ENDIF
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_agt )
-          CALL netcdf_handle_error( 'netcdf_define_header', 342 )
-
-
-!        CASE ( 'ag_ext' )
-! !+?agent extend output for restart runs has to be adapted
-!
-! !
-! !--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-! !--       The next time level is prt..count+1.
-! !--       The current time must be larger than the last output time on the file.
-!           nc_stat = NF90_INQ_VARID( id_set_agt, 'time', id_var_time_agt )
-!           CALL netcdf_handle_error( 'netcdf_define_header', 343 )
-!
-!           nc_stat = NF90_INQUIRE_VARIABLE( id_set_agt, id_var_time_agt, dimids = id_dim_time_old )
-!           CALL netcdf_handle_error( 'netcdf_define_header', 344 )
-!           id_dim_time_agt = id_dim_time_old(1)
-!
-!           nc_stat = NF90_INQUIRE_DIMENSION( id_set_agt, id_dim_time_agt, LEN = agt_time_count )
-!           CALL netcdf_handle_error( 'netcdf_define_header', 345 )
-!
-!           nc_stat = NF90_GET_VAR( id_set_agt, id_var_time_agt,                                   &
-!                                   last_time_coordinate,                                          &
-!                                   start = (/ agt_time_count /),                                  &
-!                                   count = (/ 1 /) )
-!           CALL netcdf_handle_error( 'netcdf_define_header', 346 )
-!
-!           IF ( last_time_coordinate(1) >= simulated_time )  THEN
-!              message_string = 'netCDF file for agents ' //'from previous run found,' //           &
-!                               '&but this file cannot be extended because' //                      &
-!                               ' the current output time' //                &
-!                               '&is less or equal than the last output time' // ' on this file.' //&
-!                               '&New file is created instead.'
-!              CALL message( 'define_netcdf_header', 'PA0265', 0, 1, 0, 6, 0 )
-!              agt_time_count = 0
-!              extend = .FALSE.
-!              RETURN
-!           ENDIF
-!
-! !
-! !--       Dataset seems to be extendable.
-! !--       Now get the variable ids.
-!           nc_stat = NF90_INQ_VARID( id_set_agt, 'real_num_of_agt', id_var_rnoa_agt )
-!           CALL netcdf_handle_error( 'netcdf_define_header', 347 )
-!
-!           DO  i = 1, 17
-!
-!              nc_stat = NF90_INQ_VARID( id_set_agt, agt_var_names(i), id_var_prt(i) )
-!              CALL netcdf_handle_error( 'netcdf_define_header', 348 )
-!
-!           ENDDO
-!
-!           message_string = 'netCDF file for particles ' //'from previous run found.' //           &
-!                            '&This file will be extended.'
-!           CALL message( 'define_netcdf_header', 'PA0266', 0, 0, 0, 6, 0 )
-
-
-       CASE ( 'xy_new' )
-
-!
-!--       Define some global attributes of the dataset
-          IF ( av == 0 )  THEN
-             CALL netcdf_create_global_atts( id_set_xy(av), 'xy', TRIM( run_description_header ),  &
-                                             97 )
-             time_average_text = ' '
-          ELSE
-             CALL netcdf_create_global_atts( id_set_xy(av), 'xy_av',                               &
-                                             TRIM( run_description_header ), 97 )
-             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
-             nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'time_avg',                       &
-                                     TRIM( time_average_text ) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 98 )
-          ENDIF
-
-!
-!--       Define time coordinate for xy sections.
-!--       For parallel output the time dimensions has to be limited, otherwise the performance drops
-!--       significantly.
-          IF ( netcdf_data_format < 5 )  THEN
-             CALL netcdf_create_dim( id_set_xy(av), 'time', NF90_UNLIMITED, id_dim_time_xy(av), 99 )
-          ELSE
-             CALL netcdf_create_dim( id_set_xy(av), 'time', ntdim_2d_xy(av), id_dim_time_xy(av),   &
-                                     524 )
-          ENDIF
-
-          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_time_xy(av) /), 'time', NF90_DOUBLE,    &
-                                  id_var_time_xy(av), 'seconds', 'time', 100, 101, 000 )
-          CALL netcdf_create_att( id_set_xy(av), id_var_time_xy(av), 'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_xy(av), id_var_time_xy(av), 'axis', 'T', 000)
-!
-!--       Define the spatial dimensions and coordinates for xy-sections.
-!--       First, determine the number of horizontal sections to be written.
-          IF ( section(1,1) == -9999 )  THEN
-             RETURN
-          ELSE
-             ns = 1
-             DO  WHILE ( section(ns,1) /= -9999  .AND.  ns <= 100 )
-                ns = ns + 1
-             ENDDO
-             ns = ns - 1
-          ENDIF
-
-!
-!--       Define vertical coordinate grid (zu grid)
-          CALL netcdf_create_dim( id_set_xy(av), 'zu_xy', ns, id_dim_zu_xy(av), 102 )
-          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu_xy(av) /), 'zu_xy', NF90_DOUBLE,     &
-                                  id_var_zu_xy(av), 'meters', '', 103, 104, 000 )
-          CALL netcdf_create_att( id_set_xy(av), id_var_zu_xy(av), 'axis', 'Z', 000)
-!
-!--       Define vertical coordinate grid (zw grid)
-          CALL netcdf_create_dim( id_set_xy(av), 'zw_xy', ns, id_dim_zw_xy(av), 105 )
-          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zw_xy(av) /), 'zw_xy', NF90_DOUBLE,     &
-                                  id_var_zw_xy(av), 'meters', '', 106, 107, 000 )
-          CALL netcdf_create_att( id_set_xy(av), id_var_zw_xy(av), 'axis', 'Z', 000)
-
-          IF ( land_surface )  THEN
-
-             ns_do = 1
-             DO  WHILE ( section(ns_do,1) /= -9999  .AND.  ns_do < nzs )
-                ns_do = ns_do + 1
-             ENDDO
-!
-!--          Define vertical coordinate grid (zs grid)
-             CALL netcdf_create_dim( id_set_xy(av), 'zs_xy', ns_do, id_dim_zs_xy(av), 539 )
-             CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zs_xy(av) /), 'zs_xy', NF90_DOUBLE,  &
-                                     id_var_zs_xy(av), 'meters', '', 540, 541, 000 )
-             CALL netcdf_create_att( id_set_xy(av), id_var_zs_xy(av), 'axis', 'Z', 000)
-
-          ENDIF
-
-!
-!--       Define a pseudo vertical coordinate grid for the surface variables u* and t* to store
-!--       their height level.
-          CALL netcdf_create_dim( id_set_xy(av), 'zu1_xy', 1, id_dim_zu1_xy(av), 108 )
-          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu1_xy(av) /), 'zu1_xy', NF90_DOUBLE,   &
-                                  id_var_zu1_xy(av), 'meters', '', 109, 110, 000 )
-          CALL netcdf_create_att( id_set_xy(av), id_var_zu1_xy(av), 'axis', 'Z', 000)
-!
-!--       Define a variable to store the layer indices of the horizontal cross sections, too.
-          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu_xy(av) /), 'ind_z_xy', NF90_DOUBLE,  &
-                                  id_var_ind_z_xy(av), 'gridpoints', '', 111, 112, 000 )
-!
-!--       Define x-axis (for scalar position)
-          CALL netcdf_create_dim( id_set_xy(av), 'x', nx+1, id_dim_x_xy(av), 113 )
-          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av) /), 'x', NF90_DOUBLE,          &
-                                  id_var_x_xy(av), 'meters', '', 114, 115, 000 )
-          CALL netcdf_create_att( id_set_xy(av), id_var_x_xy(av), 'axis', 'X', 000)
-!
-!--       Define x-axis (for u position)
-          CALL netcdf_create_dim( id_set_xy(av), 'xu', nx+1, id_dim_xu_xy(av), 388 )
-          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_xu_xy(av) /), 'xu', NF90_DOUBLE,        &
-                                  id_var_xu_xy(av), 'meters', '', 389, 390, 000 )
-          CALL netcdf_create_att( id_set_xy(av), id_var_xu_xy(av), 'axis', 'X', 000)
-!
-!--       Define y-axis (for scalar position)
-          CALL netcdf_create_dim( id_set_xy(av), 'y', ny+1, id_dim_y_xy(av), 116 )
-          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_y_xy(av) /), 'y', NF90_DOUBLE,          &
-                                  id_var_y_xy(av), 'meters', '', 117, 118, 000 )
-          CALL netcdf_create_att( id_set_xy(av), id_var_y_xy(av), 'axis', 'Y', 000)
-!
-!--       Define y-axis (for scalar position)
-          CALL netcdf_create_dim( id_set_xy(av), 'yv', ny+1, id_dim_yv_xy(av), 364 )
-          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_yv_xy(av) /), 'yv', NF90_DOUBLE,        &
-                                  id_var_yv_xy(av), 'meters', '', 365, 366, 000 )
-          CALL netcdf_create_att( id_set_xy(av), id_var_yv_xy(av), 'axis', 'Y', 000)
-!
-!--       Define UTM and geographic coordinates
-          CALL define_geo_coordinates( id_set_xy(av),                                              &
-                                       (/ id_dim_x_xy(av), id_dim_xu_xy(av) /),                    &
-                                       (/ id_dim_y_xy(av), id_dim_yv_xy(av) /),                    &
-                                       id_var_eutm_xy(:,av), id_var_nutm_xy(:,av),                 &
-                                       id_var_lat_xy(:,av), id_var_lon_xy(:,av)    )
-!
-!--       Define coordinate-reference system
-          CALL netcdf_create_crs( id_set_xy(av), 000 )
-!
-!--       In case of non-flat topography define 2d-arrays containing the height information. Only
-!--       for parallel netcdf output.
-          IF ( TRIM( topography ) /= 'flat'  .AND.  netcdf_data_format > 4  )  THEN
-!
-!--          Define zusi = zu(nzb_s_inner)
-             CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av), id_dim_y_xy(av) /), 'zusi',&
-                                     NF90_DOUBLE, id_var_zusi_xy(av), 'meters', 'zu(nzb_s_inner)', &
-                                     421, 422, 423 )
-!
-!--          Define zwwi = zw(nzb_w_inner)
-             CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av), id_dim_y_xy(av) /), 'zwwi',&
-                                     NF90_DOUBLE, id_var_zwwi_xy(av), 'meters', 'zw(nzb_w_inner)', &
-                                     424, 425, 426 )
-
-          ENDIF
-
-!
-!--       Define the variables
-          var_list = ';'
-          i = 1
-
-          DO  WHILE ( do2d(av,i)(1:1) /= ' ' )
-
-             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
-!
-!--             If there is a star in the variable name (u* or t*), it is a surface variable. Define
-!--             it with id_dim_zu1_xy.
-                IF ( INDEX( do2d(av,i), '*' ) /= 0 )  THEN
-
-                   CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av), id_dim_y_xy(av),     &
-                                           id_dim_zu1_xy(av), id_dim_time_xy(av) /), do2d(av,i),   &
-                                           nc_precision(1), id_var_do2d(av,i),                     &
-                                           TRIM( do2d_unit(av,i) ), do2d(av,i), 119, 120, 354,     &
-                                           .TRUE. )
-
-                ELSE
-
-!
-!--                Check for the grid
-                   found = .FALSE.
-                   SELECT CASE ( do2d(av,i) )
-!
-!--                   Most variables are defined on the zu grid
-                      CASE ( 'e_xy', 'nc_xy', 'ng_xy', 'ni_xy', 'nr_xy', 'ns_xy', 'p_xy',          &
-                             'pc_xy', 'pr_xy', 'prr_xy', 'q_xy',                                   &
-                             'qc_xy', 'qg_xy', 'qi_xy', 'ql_xy', 'ql_c_xy', 'ql_v_xy',             &
-                             'ql_vp_xy', 'qr_xy', 'qs_xy', 'qv_xy',                                &
-                             's_xy',                                                               &
-                             'theta_xy', 'thetal_xy', 'thetav_xy' )
-
-                         grid_x = 'x'
-                         grid_y = 'y'
-                         grid_z = 'zu'
-!
-!--                   u grid
-                      CASE ( 'u_xy' )
-
-                         grid_x = 'xu'
-                         grid_y = 'y'
-                         grid_z = 'zu'
-!
-!--                   v grid
-                      CASE ( 'v_xy' )
-
-                         grid_x = 'x'
-                         grid_y = 'yv'
-                         grid_z = 'zu'
-!
-!--                   w grid
-                      CASE ( 'w_xy' )
-
-                         grid_x = 'x'
-                         grid_y = 'y'
-                         grid_z = 'zw'
-
-
-                      CASE DEFAULT
-!
-!--                      Check for land surface quantities
-                         IF ( land_surface )  THEN
-                            CALL lsm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                         ENDIF
-
-                         IF ( .NOT. found )  THEN
-                            CALL tcm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                         ENDIF
-
-!
-!--                      Check for ocean quantities
-                         IF ( .NOT. found  .AND.  ocean_mode )  THEN
-                            CALL ocean_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y,      &
-                                                           grid_z )
-                         ENDIF
-!
-!--                      Check for radiation quantities
-                         IF ( .NOT. found  .AND.  radiation )  THEN
-                            CALL radiation_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y,  &
-                                                               grid_z )
-                         ENDIF
-
-!
-!--                      Check for SALSA quantities
-                         IF ( .NOT. found  .AND.  salsa )  THEN
-                            CALL salsa_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y,      &
-                                                           grid_z )
-                         ENDIF
-
-!
-!--                      Check for gust module quantities
-                         IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
-                            CALL gust_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y,       &
-                                                          grid_z )
-                         ENDIF
-!
-!--                      Check for biometeorology quantities
-                         IF ( .NOT. found  .AND.  biometeorology )  THEN
-                            CALL bio_define_netcdf_grid( do2d( av, i), found, grid_x, grid_y,      &
-                                                         grid_z )
-                         ENDIF
-!
-!--                      Check for chemistry quantities
-                         IF ( .NOT. found  .AND.  air_chemistry )  THEN
-                            CALL chem_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y,       &
-                                                          grid_z )
-                         ENDIF
-
-                         IF ( .NOT. found )                                                        &
-                            CALL doq_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-!
-!--                      Check for user-defined quantities
-                         IF ( .NOT. found  .AND.  user_module_enabled )  THEN
-                            CALL user_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y,       &
-                                                          grid_z )
-                         ENDIF
-
-                         IF ( .NOT. found )  THEN
-                            WRITE ( message_string, * ) 'no grid defined for', ' variable ',       &
-                                                        TRIM( do2d(av,i) )
-                            CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, 6, 0 )
-                         ENDIF
-
-                   END SELECT
-
-!
-!--                Select the respective dimension ids
-                   IF ( grid_x == 'x' )  THEN
-                      id_x = id_dim_x_xy(av)
-                   ELSEIF ( grid_x == 'xu' )  THEN
-                      id_x = id_dim_xu_xy(av)
-                   ENDIF
-
-                   IF ( grid_y == 'y' )  THEN
-                      id_y = id_dim_y_xy(av)
-                   ELSEIF ( grid_y == 'yv' )  THEN
-                      id_y = id_dim_yv_xy(av)
-                   ENDIF
-
-                   IF ( grid_z == 'zu' )  THEN
-                      id_z = id_dim_zu_xy(av)
-                   ELSEIF ( grid_z == 'zw' )  THEN
-                      id_z = id_dim_zw_xy(av)
-                   ELSEIF ( grid_z == 'zs' )  THEN
-                      id_z = id_dim_zs_xy(av)
-                   ELSEIF ( grid_z == 'zu1' )  THEN
-                      id_z = id_dim_zu1_xy(av)
-                   ENDIF
-
-!
-!--                Define the grid
-                   CALL netcdf_create_var( id_set_xy(av), (/ id_x, id_y, id_z,                     &
-                                           id_dim_time_xy(av) /), do2d(av,i), nc_precision(1),     &
-                                           id_var_do2d(av,i), TRIM( do2d_unit(av,i) ), do2d(av,i), &
-                                           119, 120, 354, .TRUE. )
-
-                ENDIF
-
-#if defined( __netcdf4_parallel )
-                IF ( netcdf_data_format > 4 )  THEN
-!
-!--                Set no fill for every variable to increase performance.
-                   nc_stat = NF90_DEF_VAR_FILL( id_set_xy(av), id_var_do2d(av,i), NF90_NOFILL, 0 )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 533 )
-!
-!--                Set collective io operations for parallel io
-                   nc_stat = NF90_VAR_PAR_ACCESS( id_set_xy(av), id_var_do2d(av,i),                &
-                                                  NF90_COLLECTIVE )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 448 )
-                ENDIF
-#endif
-                var_list = TRIM( var_list) // TRIM( do2d(av,i) ) // ';'
-
-             ENDIF
-
-             i = i + 1
-
-          ENDDO
-
-!
-!--       No arrays to output. Close the netcdf file and return.
-          IF ( i == 1 )  RETURN
-
-!
-!--       Write the list of variables as global attribute (this is used by restart runs and by
-!--       combine_plot_fields).
-          nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', var_list )
-          CALL netcdf_handle_error( 'netcdf_define_header', 121 )
-
-!
-!--       Set general no fill, otherwise the performance drops significantly for parallel output.
-          nc_stat = NF90_SET_FILL( id_set_xy(av), NF90_NOFILL, oldmode )
-          CALL netcdf_handle_error( 'netcdf_define_header', 529 )
-
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_xy(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 122 )
-
-!
-!--       These data are only written by PE0 for parallel output to increase the performance.
-          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
-
-!
-!--          Write axis data: z_xy, x, y
-             ALLOCATE( netcdf_data(1:ns) )
-
-!
-!--          Write zu data
-             DO  i = 1, ns
-                IF( section(i,1) == -1 )  THEN
-                   netcdf_data(i) = -1.0_wp  ! section averaged along z
-                ELSE
-                   netcdf_data(i) = zu( section(i,1) )
-                ENDIF
-             ENDDO
-             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu_xy(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ns /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 123 )
-
-!
-!--          Write zw data
-             DO  i = 1, ns
-                IF( section(i,1) == -1 )  THEN
-                   netcdf_data(i) = -1.0_wp  ! section averaged along z
-                ELSE
-                   netcdf_data(i) = zw( section(i,1) )
-                ENDIF
-             ENDDO
-             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zw_xy(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ns /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 124 )
-
-!
-!--          Write zs data
-             IF ( land_surface )  THEN
-                ns_do = 0
-                DO  i = 1, ns
-                   IF( section(i,1) == -1 )  THEN
-                      netcdf_data(i) = 1.0_wp  ! section averaged along z
-                      ns_do = ns_do + 1
-                   ELSEIF ( section(i,1) < nzs )  THEN
-                      netcdf_data(i) = - zs( section(i,1) )
-                      ns_do = ns_do + 1
-                   ENDIF
-                ENDDO
-
-                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zs_xy(av),                           &
-                                        netcdf_data(1:ns_do), start = (/ 1 /),                     &
-                                        count = (/ ns_do /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 124 )
-
-             ENDIF
-
-!
-!--          Write gridpoint number data
-             netcdf_data(1:ns) = section(1:ns,1)
-             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_ind_z_xy(av),                           &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ns /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 125 )
-
-             DEALLOCATE( netcdf_data )
-
-!
-!--          Write the cross section height u*, t*
-             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu1_xy(av),                             &
-                                     (/ zu(nzb+1) /), start = (/ 1 /),                             &
-                                     count = (/ 1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 126 )
-
-!
-!--          Write data for x (shifted by +dx/2) and xu axis
-             ALLOCATE( netcdf_data(0:nx) )
-
-             DO  i = 0, nx
-                netcdf_data(i) = ( i + 0.5_wp ) * dx
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_x_xy(av),                               &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ nx+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 127 )
-
-             DO  i = 0, nx
-                netcdf_data(i) = i * dx
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_xu_xy(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ nx+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 367 )
-
-             DEALLOCATE( netcdf_data )
-
-!
-!--          Write data for y (shifted by +dy/2) and yv axis
-             ALLOCATE( netcdf_data(0:ny+1) )
-
-             DO  i = 0, ny
-                netcdf_data(i) = ( i + 0.5_wp ) * dy
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_y_xy(av),                               &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ny+1 /))
-             CALL netcdf_handle_error( 'netcdf_define_header', 128 )
-
-             DO  i = 0, ny
-                netcdf_data(i) = i * dy
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_yv_xy(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ny+1 /))
-             CALL netcdf_handle_error( 'netcdf_define_header', 368 )
-
-             DEALLOCATE( netcdf_data )
-!
-!--          Write UTM coordinates
-             IF ( rotation_angle == 0.0_wp )  THEN
-!
-!--             1D in case of no rotation
-                cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-!
-!--             x coordinates
-                ALLOCATE( netcdf_data(0:nx) )
-                DO  k = 0, 2
-!
-!--                Scalar grid points
-                   IF ( k == 0 )  THEN
-                      shift_x = 0.5
-!
-!--                u grid points
-                   ELSEIF ( k == 1 )  THEN
-                      shift_x = 0.0
-!
-!--                v grid points
-                   ELSEIF ( k == 2 )  THEN
-                      shift_x = 0.5
-                   ENDIF
-
-                   DO  i = 0, nx
-                     netcdf_data(i) = init_model%origin_x + cos_rot_angle * ( i + shift_x ) * dx
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_eutm_xy(k,av),                    &
-                                           netcdf_data, start = (/ 1 /),                           &
-                                           count = (/ nx+1 /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data )
-!
-!--             y coordinates
-                ALLOCATE( netcdf_data(0:ny) )
-                DO  k = 0, 2
-!
-!--                Scalar grid points
-                   IF ( k == 0 )  THEN
-                      shift_y = 0.5
-!
-!--                u grid points
-                   ELSEIF ( k == 1 )  THEN
-                      shift_y = 0.5
-!
-!--                v grid points
-                   ELSEIF ( k == 2 )  THEN
-                      shift_y = 0.0
-                   ENDIF
-
-                   DO  j = 0, ny
-                      netcdf_data(j) = init_model%origin_y + cos_rot_angle * ( j + shift_y ) * dy
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_nutm_xy(k,av),                    &
-                                           netcdf_data, start = (/ 1 /),                           &
-                                           count = (/ ny+1 /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data )
-
-             ELSE
-!
-!--             2D in case of rotation
-                ALLOCATE( netcdf_data_2d(0:nx,0:ny) )
-                cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-                sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-                DO  k = 0, 2
-!
-!--               Scalar grid points
-                  IF ( k == 0 )  THEN
-                     shift_x = 0.5 ; shift_y = 0.5
-!
-!--               u grid points
-                  ELSEIF ( k == 1 )  THEN
-                     shift_x = 0.0 ; shift_y = 0.5
-!
-!--               v grid points
-                  ELSEIF ( k == 2 )  THEN
-                     shift_x = 0.5 ; shift_y = 0.0
-                  ENDIF
-
-                  DO  j = 0, ny
-                     DO  i = 0, nx
-                        netcdf_data_2d(i,j) = init_model%origin_x                                  &
-                                              + cos_rot_angle * ( i + shift_x ) * dx               &
-                                              + sin_rot_angle * ( j + shift_y ) * dy
-                     ENDDO
-                  ENDDO
-
-                  nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_eutm_xy(k,av),                     &
-                                          netcdf_data_2d, start = (/ 1, 1 /),                      &
-                                          count = (/ nx+1, ny+1 /) )
-                  CALL netcdf_handle_error( 'netcdf_define_header', 555 )
-
-                  DO  j = 0, ny
-                     DO  i = 0, nx
-                        netcdf_data_2d(i,j) = init_model%origin_y                                  &
-                                              - sin_rot_angle * ( i + shift_x ) * dx               &
-                                              + cos_rot_angle * ( j + shift_y ) * dy
-                     ENDDO
-                  ENDDO
-
-                  nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_nutm_xy(k,av),                     &
-                                          netcdf_data_2d, start = (/ 1, 1 /),                      &
-                                          count = (/ nx+1, ny+1 /) )
-                  CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data_2d )
-             ENDIF
-
-          ENDIF
-!
-!--       Write lon and lat data. Only for parallel output.
-          IF ( netcdf_data_format > 4 )  THEN
-
-             ALLOCATE( lat(nxl:nxr,nys:nyn) )
-             ALLOCATE( lon(nxl:nxr,nys:nyn) )
-             cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-             sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-             DO  k = 0, 2
-!
-!--             Scalar grid points
-                IF ( k == 0 )  THEN
-                   shift_x = 0.5 ; shift_y = 0.5
-!
-!--             u grid points
-                ELSEIF ( k == 1 )  THEN
-                   shift_x = 0.0 ; shift_y = 0.5
-!
-!--             v grid points
-                ELSEIF ( k == 2 )  THEN
-                   shift_x = 0.5 ; shift_y = 0.0
-                ENDIF
-
-                DO  j = nys, nyn
-                   DO  i = nxl, nxr
-                      eutm = init_model%origin_x                                                   &
-                             + cos_rot_angle * ( i + shift_x ) * dx                                &
-                             + sin_rot_angle * ( j + shift_y ) * dy
-                      nutm = init_model%origin_y                                                   &
-                             - sin_rot_angle * ( i + shift_x ) * dx                                &
-                             + cos_rot_angle * ( j + shift_y ) * dy
-
-                      CALL  convert_utm_to_geographic( crs_list, eutm, nutm, lon(i,j), lat(i,j) )
-                   ENDDO
-                ENDDO
-
-                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_lon_xy(k,av),                        &
-                                        lon, start = (/ nxl+1, nys+1 /),                           &
-                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_lat_xy(k,av),                        &
-                                        lat, start = (/ nxl+1, nys+1 /),                           &
-                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-             ENDDO
-
-             DEALLOCATE( lat )
-             DEALLOCATE( lon )
-
-          ENDIF
-!
-!--       In case of non-flat topography write height information. Only for
-!--       parallel netcdf output.
-          IF ( TRIM( topography ) /= 'flat'  .AND.  netcdf_data_format > 4  )  THEN
-
-!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),                         &
-!                                        zu_s_inner(nxl:nxr+1,nys:nyn),                             &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
-!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),                         &
-!                                        zu_s_inner(nxl:nxr,nys:nyn+1),                             &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
-!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),                         &
-!                                        zu_s_inner(nxl:nxr+1,nys:nyn+1),                           &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
-!             ELSE
-                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),                         &
-                                        zu_s_inner(nxl:nxr,nys:nyn),                               &
-                                        start = (/ nxl+1, nys+1 /),                                &
-                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
-!             ENDIF
-             CALL netcdf_handle_error( 'netcdf_define_header', 427 )
-
-!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),                         &
-!                                        zw_w_inner(nxl:nxr+1,nys:nyn),                             &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
-!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),                         &
-!                                        zw_w_inner(nxl:nxr,nys:nyn+1),                             &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
-!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
-!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),                         &
-!                                        zw_w_inner(nxl:nxr+1,nys:nyn+1),                           &
-!                                        start = (/ nxl+1, nys+1 /),                                &
-!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
-!             ELSE
-                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),                         &
-                                        zw_w_inner(nxl:nxr,nys:nyn),                               &
-                                        start = (/ nxl+1, nys+1 /),                                &
-                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
-!             ENDIF
-             CALL netcdf_handle_error( 'netcdf_define_header', 428 )
-
-          ENDIF
-
-       CASE ( 'xy_ext' )
-
-!
-!--       Get the list of variables and compare with the actual run.
-!--       First var_list_old has to be reset, since GET_ATT does not assign trailing blanks.
-          var_list_old = ' '
-          nc_stat = NF90_GET_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', var_list_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 129 )
-
-          var_list = ';'
-          i = 1
-          DO  WHILE ( do2d(av,i)(1:1) /= ' ' )
-             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
-                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
-             ENDIF
-             i = i + 1
-          ENDDO
-
-          IF ( av == 0 )  THEN
-             var = '(xy)'
-          ELSE
-             var = '(xy_av)'
-          ENDIF
-
-          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
-             message_string = 'netCDF file for cross-sections ' //                                 &
-                              TRIM( var ) // ' from previous run found,' //                        &
-                              '&but this file cannot be extended due to' //                        &
-                              ' variable mismatch.' // '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Calculate the number of current sections
-          ns = 1
-          DO  WHILE ( section(ns,1) /= -9999  .AND.  ns <= 100 )
-             ns = ns + 1
-          ENDDO
-          ns = ns - 1
-
-!
-!--       Get and compare the number of horizontal cross sections
-          nc_stat = NF90_INQ_VARID( id_set_xy(av), 'zu_xy', id_var_zu_xy(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 130 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_zu_xy(av),                        &
-                                           dimids = id_dim_zu_xy_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 131 )
-          id_dim_zu_xy(av) = id_dim_zu_xy_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_zu_xy(av), LEN = ns_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 132 )
-
-          IF ( ns /= ns_old )  THEN
-             message_string = 'netCDF file for cross-sections ' //                                 &
-                              TRIM( var ) // ' from previous run found,' //                        &
-                              '&but this file cannot be extended due to' //                        &
-                              ' mismatch in number of' // ' cross sections.' //                    &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get and compare the heights of the cross sections
-          ALLOCATE( netcdf_data(1:ns_old) )
-
-          nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_zu_xy(av), netcdf_data )
-          CALL netcdf_handle_error( 'netcdf_define_header', 133 )
-
-          DO  i = 1, ns
-             IF ( section(i,1) /= -1 )  THEN
-                IF ( zu(section(i,1)) /= netcdf_data(i) )  THEN
-                   message_string = 'netCDF file for cross-sections ' //                           &
-                                     TRIM( var ) // ' from previous run found,' //                 &
-                                     ' but this file cannot be extended' //                        &
-                                     ' due to mismatch in cross' // ' section levels.' //          &
-                                     ' New file is created instead.'
-                   CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 )
-                   extend = .FALSE.
-                   RETURN
-                ENDIF
-             ELSE
-                IF ( -1.0_wp /= netcdf_data(i) )  THEN
-                   message_string = 'netCDF file for cross-sections ' //                           &
-                                     TRIM( var ) // ' from previous run found,' //                 &
-                                     ' but this file cannot be extended' //                        &
-                                     ' due to mismatch in cross' // ' section levels.' //          &
-                                     ' New file is created instead.'
-                   CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 )
-                   extend = .FALSE.
-                   RETURN
-                ENDIF
-             ENDIF
-          ENDDO
-
-          DEALLOCATE( netcdf_data )
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is do2d..count+1.
-!--       The current time must be larger than the last output time on the file.
-          nc_stat = NF90_INQ_VARID( id_set_xy(av), 'time', id_var_time_xy(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 134 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_time_xy(av),                      &
-                                           dimids = id_dim_time_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 135 )
-          id_dim_time_xy(av) = id_dim_time_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_time_xy(av), LEN = ntime_count )
-          CALL netcdf_handle_error( 'netcdf_define_header', 136 )
-
-!
-!--       For non-parallel output use the last output time level of the netcdf file because the time
-!--       dimension is unlimited. In case of parallel output the variable ntime_count could get the
-!--       value of 9*10E36 because the time dimension is limited.
-          IF ( netcdf_data_format < 5 ) do2d_xy_time_count(av) = ntime_count
-
-          nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_time_xy(av),                               &
-                                  last_time_coordinate,                                            &
-                                  start = (/ do2d_xy_time_count(av) /),                            &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 137 )
-
-          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-             message_string = 'netCDF file for cross sections ' //                                 &
-                              TRIM( var ) // ' from previous run found,' //                        &
-                              '&but this file cannot be extended because' //                       &
-                              ' the current output time' //                                        &
-                              '&is less or equal than the last output time' // ' on this file.' // &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 )
-             do2d_xy_time_count(av) = 0
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-          IF ( netcdf_data_format > 4 )  THEN
-!
-!--          Check if the needed number of output time levels is increased compared to the number of
-!--          time levels in the existing file.
-             IF ( ntdim_2d_xy(av) > ntime_count )  THEN
-                message_string = 'netCDF file for cross sections ' //                              &
-                                 TRIM( var ) // ' from previous run found,' //                     &
-                                 '&but this file cannot be extended becaus' //                     &
-                                 'e the number of output time levels has b' //                     &
-                                 'een increased compared to the previous s' //                     &
-                                 'imulation.' // '&New file is created instead.'
-                CALL message( 'define_netcdf_header', 'PA0389', 0, 1, 0, 6, 0 )
-                do2d_xy_time_count(av) = 0
-                extend = .FALSE.
-!
-!--             Recalculate the needed time levels for the new file.
-                IF ( av == 0 )  THEN
-                   ntdim_2d_xy(0) = CEILING( ( end_time - MAX( skip_time_do2d_xy,                  &
-                                                               simulated_time_at_begin )           &
-                                             ) / dt_do2d_xy )
-                   IF ( do2d_at_begin )  ntdim_2d_xy(0) = ntdim_2d_xy(0) + 1
-                ELSE
-                   ntdim_2d_xy(1) = CEILING( ( end_time - MAX( skip_time_data_output_av,           &
-                                                               simulated_time_at_begin )           &
-                                             ) / dt_data_output_av )
-                ENDIF
-                RETURN
-             ENDIF
-          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the variable ids.
-          i = 1
-          DO  WHILE ( do2d(av,i)(1:1) /= ' ' )
-             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
-                nc_stat = NF90_INQ_VARID( id_set_xy(av), do2d(av,i), id_var_do2d(av,i) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 138 )
-#if defined( __netcdf4_parallel )
-!
-!--             Set collective io operations for parallel io
-                IF ( netcdf_data_format > 4 )  THEN
-                   nc_stat = NF90_VAR_PAR_ACCESS( id_set_xy(av), id_var_do2d(av,i),                &
-                                                  NF90_COLLECTIVE )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 454 )
-                ENDIF
-#endif
-             ENDIF
-             i = i + 1
-          ENDDO
-
-!
-!--       Update the title attribute on file.
-!--       In order to avoid 'data mode' errors if updated attributes are larger than their original
-!--       size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF
-!--       calls. This implies a possible performance loss due to data copying; an alternative
-!--       strategy would be to ensure equal attribute size in a job chain. Maybe revise later.
-          IF ( av == 0 )  THEN
-             time_average_text = ' '
-          ELSE
-             WRITE ( time_average_text, '('', '',F7.1,'' s average'')' ) averaging_interval
-          ENDIF
-          nc_stat = NF90_REDEF( id_set_xy(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 431 )
-          nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title',                             &
-                                  TRIM( run_description_header ) // TRIM( time_average_text ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 139 )
-          nc_stat = NF90_ENDDEF( id_set_xy(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 432 )
-          message_string = 'netCDF file for cross-sections ' //                                    &
-                            TRIM( var ) // ' from previous run found.' //                          &
-                           '&This file will be extended.'
-          CALL message( 'define_netcdf_header', 'PA0253', 0, 0, 0, 6, 0 )
-
-
-       CASE ( 'xz_new' )
-
-!
-!--       Define some global attributes of the dataset
-          IF ( av == 0 )  THEN
-             CALL netcdf_create_global_atts( id_set_xz(av), 'xz', TRIM( run_description_header ),  &
-                                             140 )
-             time_average_text = ' '
-          ELSE
-             CALL netcdf_create_global_atts( id_set_xz(av), 'xz_av',                               &
-                                             TRIM( run_description_header ), 140 )
-             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
-             nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'time_avg',                       &
-                                     TRIM( time_average_text ) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 141 )
-          ENDIF
-
-!
-!--       Define time coordinate for xz sections.
-!--       For parallel output the time dimensions has to be limited, otherwise the performance drops
-!--       significantly.
-          IF ( netcdf_data_format < 5 )  THEN
-             CALL netcdf_create_dim( id_set_xz(av), 'time', NF90_UNLIMITED, id_dim_time_xz(av),    &
-                                     142 )
-          ELSE
-             CALL netcdf_create_dim( id_set_xz(av), 'time', ntdim_2d_xz(av), id_dim_time_xz(av),   &
-                                     525 )
-          ENDIF
-
-          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_time_xz(av) /), 'time', NF90_DOUBLE,    &
-                                  id_var_time_xz(av), 'seconds', 'time', 143, 144, 000 )
-          CALL netcdf_create_att( id_set_xz(av), id_var_time_xz(av), 'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_xz(av), id_var_time_xz(av), 'axis', 'T', 000)
-!
-!--       Define the spatial dimensions and coordinates for xz-sections.
-!--       First, determine the number of vertical sections to be written.
-          IF ( section(1,2) == -9999 )  THEN
-             RETURN
-          ELSE
-             ns = 1
-             DO WHILE ( section(ns,2) /= -9999  .AND.  ns <= 100 )
-                ns = ns + 1
-             ENDDO
-             ns = ns - 1
-          ENDIF
-
-!
-!--       Define y-axis (for scalar position)
-          CALL netcdf_create_dim( id_set_xz(av), 'y_xz', ns, id_dim_y_xz(av), 145 )
-          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_y_xz(av) /), 'y_xz', NF90_DOUBLE,       &
-                                 id_var_y_xz(av), 'meters', '', 146, 147, 000 )
-          CALL netcdf_create_att( id_set_xz(av), id_var_y_xz(av), 'axis', 'Y', 000)
-!
-!--       Define y-axis (for v position)
-          CALL netcdf_create_dim( id_set_xz(av), 'yv_xz', ns, id_dim_yv_xz(av), 369 )
-          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_yv_xz(av) /), 'yv_xz', NF90_DOUBLE,     &
-                                  id_var_yv_xz(av), 'meters', '', 370, 371, 000 )
-          CALL netcdf_create_att( id_set_xz(av), id_var_yv_xz(av), 'axis', 'Y', 000)
-!
-!--       Define a variable to store the layer indices of the vertical cross sections
-          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_y_xz(av) /), 'ind_y_xz', NF90_DOUBLE,   &
-                                  id_var_ind_y_xz(av), 'gridpoints', '', 148, 149, 000 )
-!
-!--       Define x-axis (for scalar position)
-          CALL netcdf_create_dim( id_set_xz(av), 'x', nx+1, id_dim_x_xz(av), 150 )
-          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_x_xz(av) /), 'x', NF90_DOUBLE,          &
-                                  id_var_x_xz(av), 'meters', '', 151, 152, 000 )
-          CALL netcdf_create_att( id_set_xz(av), id_var_x_xz(av), 'axis', 'X', 000)
-!
-!--       Define x-axis (for u position)
-          CALL netcdf_create_dim( id_set_xz(av), 'xu', nx+1, id_dim_xu_xz(av), 372 )
-          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_xu_xz(av) /), 'xu', NF90_DOUBLE,        &
-                                  id_var_xu_xz(av), 'meters', '', 373, 374, 000 )
-          CALL netcdf_create_att( id_set_xz(av), id_var_xu_xz(av), 'axis', 'X', 000)
-
-!
-!--       Define the three z-axes (zu, zw, and zs)
-          CALL netcdf_create_dim( id_set_xz(av), 'zu', nz+2, id_dim_zu_xz(av), 153 )
-          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zu_xz(av) /), 'zu', NF90_DOUBLE,        &
-                                  id_var_zu_xz(av), 'meters', '', 154, 155, 000 )
-          CALL netcdf_create_att( id_set_xz(av), id_var_zu_xz(av), 'axis', 'Z', 000)
-
-          CALL netcdf_create_dim( id_set_xz(av), 'zw', nz+2, id_dim_zw_xz(av), 156 )
-          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zw_xz(av) /), 'zw', NF90_DOUBLE,        &
-                                  id_var_zw_xz(av), 'meters', '', 157, 158, 000 )
-          CALL netcdf_create_att( id_set_xz(av), id_var_zw_xz(av), 'axis', 'Z', 000)
-!
-!--       Define UTM and geographic coordinates
-          CALL define_geo_coordinates( id_set_xz(av),                                              &
-                                       (/ id_dim_x_xz(av), id_dim_xu_xz(av) /),                    &
-                                       (/ id_dim_y_xz(av), id_dim_yv_xz(av) /),                    &
-                                       id_var_eutm_xz(:,av), id_var_nutm_xz(:,av),                 &
-                                       id_var_lat_xz(:,av), id_var_lon_xz(:,av)    )
-!
-!--       Define coordinate-reference system
-          CALL netcdf_create_crs( id_set_xz(av), 000 )
-
-          IF ( land_surface )  THEN
-
-             CALL netcdf_create_dim( id_set_xz(av), 'zs', nzs, id_dim_zs_xz(av), 542 )
-             CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zs_xz(av) /), 'zs', NF90_DOUBLE,     &
-                                     id_var_zs_xz(av), 'meters', '', 543, 544, 000 )
-             CALL netcdf_create_att( id_set_xz(av), id_var_zs_xz(av), 'axis', 'Z', 000)
-
-          ENDIF
-
-!
-!--       Define the variables
-          var_list = ';'
-          i = 1
-
-          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
-
-             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
-
-!
-!--             Check for the grid
-                found = .FALSE.
-                SELECT CASE ( do2d(av,i) )
-!
-!--                Most variables are defined on the zu grid
-                   CASE ( 'e_xz', 'nc_xz', 'ng_xz', 'ni_xz', 'nr_xz', 'ns_xz', 'p_xz', 'pc_xz',    &
-                          'pr_xz', 'prr_xz', 'q_xz', 'qc_xz', 'qg_xz', 'qi_xz',                    &
-                          'ql_xz', 'ql_c_xz', 'ql_v_xz', 'ql_vp_xz', 'qr_xz', 'qs_xz',             &
-                          'qv_xz', 's_xz',                                                         &
-                          'theta_xz', 'thetal_xz', 'thetav_xz' )
-
-                      grid_x = 'x'
-                      grid_y = 'y'
-                      grid_z = 'zu'
-!
-!--                u grid
-                   CASE ( 'u_xz' )
-
-                      grid_x = 'xu'
-                      grid_y = 'y'
-                      grid_z = 'zu'
-!
-!--                v grid
-                   CASE ( 'v_xz' )
-
-                      grid_x = 'x'
-                      grid_y = 'yv'
-                      grid_z = 'zu'
-!
-!--                w grid
-                   CASE ( 'w_xz' )
-
-                      grid_x = 'x'
-                      grid_y = 'y'
-                      grid_z = 'zw'
-
-                   CASE DEFAULT
-
-!
-!--                   Check for land surface quantities
-                      IF ( land_surface )  THEN
-                         CALL lsm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-                      IF ( .NOT. found )  THEN
-                         CALL tcm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-!
-!--                   Check for ocean quantities
-                      IF ( .NOT. found  .AND.  ocean_mode )  THEN
-                         CALL ocean_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-!
-!--                   Check for radiation quantities
-                      IF ( .NOT. found  .AND.  radiation )  THEN
-                         CALL radiation_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y,     &
-                                                            grid_z )
-                      ENDIF
-!
-!--                   Check for SALSA quantities
-                      IF ( .NOT. found  .AND.  salsa )  THEN
-                         CALL salsa_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-!
-!--                   Check for gust module quantities
-                      IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
-                         CALL gust_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-!
-!--                   Check for chemistry quantities
-                      IF ( .NOT. found  .AND.  air_chemistry )  THEN
-                         CALL chem_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-                      IF ( .NOT. found )                                                           &
-                         CALL doq_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-
-!
-!--                   Check for user-defined quantities
-                      IF ( .NOT. found  .AND.  user_module_enabled )  THEN
-                         CALL user_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-                      IF ( .NOT. found )  THEN
-                         WRITE ( message_string, * ) 'no grid defined for', ' variable ',          &
-                                                     TRIM( do2d(av,i) )
-                         CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, 6, 0 )
-                      ENDIF
-
-                END SELECT
-
-!
-!--             Select the respective dimension ids
-                IF ( grid_x == 'x' )  THEN
-                   id_x = id_dim_x_xz(av)
-                ELSEIF ( grid_x == 'xu' )  THEN
-                   id_x = id_dim_xu_xz(av)
-                ENDIF
-
-                IF ( grid_y == 'y' )  THEN
-                   id_y = id_dim_y_xz(av)
-                ELSEIF ( grid_y == 'yv' )  THEN
-                   id_y = id_dim_yv_xz(av)
-                ENDIF
-
-                IF ( grid_z == 'zu' )  THEN
-                   id_z = id_dim_zu_xz(av)
-                ELSEIF ( grid_z == 'zw' )  THEN
-                   id_z = id_dim_zw_xz(av)
-                ELSEIF ( grid_z == 'zs' )  THEN
-                   id_z = id_dim_zs_xz(av)
-                ENDIF
-
-!
-!--             Define the grid
-                CALL netcdf_create_var( id_set_xz(av), (/ id_x, id_y, id_z, id_dim_time_xz(av) /), &
-                                        do2d(av,i), nc_precision(2), id_var_do2d(av,i),            &
-                                        TRIM( do2d_unit(av,i) ), do2d(av,i), 159, 160, 355, .TRUE. )
-
-#if defined( __netcdf4_parallel )
-
-                IF ( netcdf_data_format > 4 )  THEN
-!
-!--                Set no fill for every variable to increase performance.
-                   nc_stat = NF90_DEF_VAR_FILL( id_set_xz(av),     &
-                                                id_var_do2d(av,i), &
-                                                NF90_NOFILL, 0 )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 534 )
-!
-!--                Set independent io operations for parallel io. Collective io is only allowed in
-!--                case of a 1d-decomposition along x, because otherwise, not all PEs have output
-!--                data.
-                   IF ( npey == 1 )  THEN
-                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),                                &
-                                                     id_var_do2d(av,i),                            &
-                                                     NF90_COLLECTIVE )
-                   ELSE
-!
-!--                   Test simulations showed that the output of cross sections by all PEs in
-!--                   data_output_2d using NF90_COLLECTIVE is faster than the output by the first
-!--                   row of PEs in x-direction using NF90_INDEPENDENT.
-                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),                                &
-                                                     id_var_do2d(av,i),                            &
-                                                     NF90_COLLECTIVE )
-!                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),                                &
-!                                                     id_var_do2d(av,i),                            &
-!                                                     NF90_INDEPENDENT )
-                   ENDIF
-                   CALL netcdf_handle_error( 'netcdf_define_header', 449 )
-                ENDIF
-#endif
-                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
-
-             ENDIF
-
-             i = i + 1
-
-          ENDDO
-
-!
-!--       No arrays to output. Close the netcdf file and return.
-          IF ( i == 1 )  RETURN
-
-!
-!--       Write the list of variables as global attribute (this is used by restart runs and by
-!--       combine_plot_fields)
-          nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', var_list )
-          CALL netcdf_handle_error( 'netcdf_define_header', 161 )
-
-!
-!--       Set general no fill, otherwise the performance drops significantly for parallel output.
-          nc_stat = NF90_SET_FILL( id_set_xz(av), NF90_NOFILL, oldmode )
-          CALL netcdf_handle_error( 'netcdf_define_header', 530 )
-
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_xz(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 162 )
-
-!
-!--       These data are only written by PE0 for parallel output to increase the performance.
-          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
-
-!
-!--          Write axis data: y_xz, x, zu, zw
-             ALLOCATE( netcdf_data(1:ns) )
-
-!
-!--          Write y_xz data (shifted by +dy/2)
-             DO  i = 1, ns
-                IF( section(i,2) == -1 )  THEN
-                   netcdf_data(i) = -1.0_wp  ! section averaged along y
-                ELSE
-                   netcdf_data(i) = ( section(i,2) + 0.5_wp ) * dy
-                ENDIF
-             ENDDO
-             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_y_xz(av),                               &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ns /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 163 )
-
-!
-!--          Write yv_xz data
-             DO  i = 1, ns
-                IF( section(i,2) == -1 )  THEN
-                   netcdf_data(i) = -1.0_wp  ! section averaged along y
-                ELSE
-                   netcdf_data(i) = section(i,2) * dy
-                ENDIF
-             ENDDO
-             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_yv_xz(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ns /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 375 )
-
-!
-!--          Write gridpoint number data
-             netcdf_data(1:ns) = section(1:ns,2)
-             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_ind_y_xz(av),                           &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ns /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 164 )
-
-
-             DEALLOCATE( netcdf_data )
-
-!
-!--          Write data for x (shifted by +dx/2) and xu axis
-             ALLOCATE( netcdf_data(0:nx) )
-
-             DO  i = 0, nx
-                netcdf_data(i) = ( i + 0.5_wp ) * dx
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_x_xz(av),                               &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ nx+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 165 )
-
-             DO  i = 0, nx
-                netcdf_data(i) = i * dx
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_xu_xz(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ nx+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 377 )
-
-             DEALLOCATE( netcdf_data )
-
-!
-!--          Write zu and zw data (vertical axes)
-             ALLOCATE( netcdf_data(0:nz+1) )
-
-             netcdf_data(0:nz+1) = zu(nzb:nzt+1)
-             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zu_xz(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ nz+2 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 166 )
-
-             netcdf_data(0:nz+1) = zw(nzb:nzt+1)
-             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zw_xz(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ nz+2 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 167 )
-
-!
-!--          Write zs data
-             IF ( land_surface )  THEN
-                netcdf_data(0:nzs-1) = - zs(nzb_soil:nzt_soil)
-                nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zs_xz(av),                           &
-                                        netcdf_data(0:nzs), start = (/ 1 /),                       &
-                                        count = (/ nzt_soil-nzb_soil+1 /) )
-               CALL netcdf_handle_error( 'netcdf_define_header', 548 )
-             ENDIF
-
-             DEALLOCATE( netcdf_data )
-!
-!--          Write UTM coordinates
-             IF ( rotation_angle == 0.0_wp )  THEN
-!
-!--             1D in case of no rotation
-                cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-!
-!--             x coordinates
-                ALLOCATE( netcdf_data(0:nx) )
-                DO  k = 0, 2
-!
-!--                Scalar grid points
-                   IF ( k == 0 )  THEN
-                      shift_x = 0.5
-!
-!--                u grid points
-                   ELSEIF ( k == 1 )  THEN
-                      shift_x = 0.0
-!
-!--                v grid points
-                   ELSEIF ( k == 2 )  THEN
-                      shift_x = 0.5
-                   ENDIF
-
-                   DO  i = 0, nx
-                     netcdf_data(i) = init_model%origin_x + cos_rot_angle * ( i + shift_x ) * dx
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_eutm_xz(k,av),                    &
-                                           netcdf_data, start = (/ 1 /),                           &
-                                           count = (/ nx+1 /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data )
-!
-!--             y coordinates
-                ALLOCATE( netcdf_data(1:ns) )
-                DO  k = 0, 2
-!
-!--                Scalar grid points
-                   IF ( k == 0 )  THEN
-                      shift_y = 0.5
-!
-!--                u grid points
-                   ELSEIF ( k == 1 )  THEN
-                      shift_y = 0.5
-!
-!--                v grid points
-                   ELSEIF ( k == 2 )  THEN
-                      shift_y = 0.0
-                   ENDIF
-
-                   DO  i = 1, ns
-                      IF( section(i,2) == -1 )  THEN
-                         netcdf_data(i) = -1.0_wp  ! section averaged along y
-                      ELSE
-                         netcdf_data(i) = init_model%origin_y                                      &
-                                          + cos_rot_angle * ( section(i,2) + shift_y ) * dy
-                      ENDIF
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_nutm_xz(k,av),                    &
-                                           netcdf_data, start = (/ 1 /),                           &
-                                           count = (/ ns /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data )
-
-             ELSE
-!
-!--             2D in case of rotation
-                ALLOCATE( netcdf_data_2d(0:nx,1:ns) )
-                cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-                sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-                DO  k = 0, 2
-!
-!--                Scalar grid points
-                   IF ( k == 0 )  THEN
-                      shift_x = 0.5 ; shift_y = 0.5
-!
-!--                u grid points
-                   ELSEIF ( k == 1 )  THEN
-                      shift_x = 0.0 ; shift_y = 0.5
-!
-!--                v grid points
-                   ELSEIF ( k == 2 )  THEN
-                      shift_x = 0.5 ; shift_y = 0.0
-                   ENDIF
-
-                   DO  j = 1, ns
-                      IF( section(j,2) == -1 )  THEN
-                         netcdf_data_2d(:,j) = -1.0_wp  ! section averaged along y
-                      ELSE
-                         DO  i = 0, nx
-                            netcdf_data_2d(i,j) = init_model%origin_x                              &
-                                                  + cos_rot_angle * ( i + shift_x ) * dx           &
-                                                  + sin_rot_angle * ( section(j,2) + shift_y ) * dy
-                         ENDDO
-                      ENDIF
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_eutm_xz(k,av),                    &
-                                           netcdf_data_2d, start = (/ 1, 1 /),                     &
-                                           count = (/ nx+1, ns /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
-
-                   DO  j = 1, ns
-                      IF( section(j,2) == -1 )  THEN
-                         netcdf_data_2d(:,j) = -1.0_wp  ! section averaged along y
-                      ELSE
-                         DO  i = 0, nx
-                            netcdf_data_2d(i,j) = init_model%origin_y                              &
-                                                  - sin_rot_angle * ( i + shift_x ) * dx           &
-                                                  + cos_rot_angle * ( section(j,2) + shift_y ) * dy
-                         ENDDO
-                      ENDIF
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_nutm_xz(k,av),                    &
-                                           netcdf_data_2d, start = (/ 1, 1 /),                     &
-                                           count = (/ nx+1, ns /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data_2d )
-             ENDIF
-!
-!--          Write lon and lat data
-             ALLOCATE( lat(0:nx,1:ns) )
-             ALLOCATE( lon(0:nx,1:ns) )
-             cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-             sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-             DO  k = 0, 2
-!
-!--             Scalar grid points
-                IF ( k == 0 )  THEN
-                   shift_x = 0.5 ; shift_y = 0.5
-!
-!--             u grid points
-                ELSEIF ( k == 1 )  THEN
-                   shift_x = 0.0 ; shift_y = 0.5
-!
-!--             v grid points
-                ELSEIF ( k == 2 )  THEN
-                   shift_x = 0.5 ; shift_y = 0.0
-                ENDIF
-
-                DO  j = 1, ns
-                   IF( section(j,2) == -1 )  THEN
-                      lat(:,j) = -90.0_wp  ! section averaged along y
-                      lon(:,j) = -180.0_wp  ! section averaged along y
-                   ELSE
-                      DO  i = 0, nx
-                         eutm = init_model%origin_x                                                &
-                                + cos_rot_angle * ( i + shift_x ) * dx                             &
-                                + sin_rot_angle * ( section(j,2) + shift_y ) * dy
-                         nutm = init_model%origin_y                                                &
-                                - sin_rot_angle * ( i + shift_x ) * dx                             &
-                                + cos_rot_angle * ( section(j,2) + shift_y ) * dy
-
-                         CALL  convert_utm_to_geographic( crs_list, eutm, nutm, lon(i,j), lat(i,j) )
-                      ENDDO
-                   ENDIF
-                ENDDO
-
-                nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_lon_xz(k,av),                        &
-                                        lon, start = (/ 1, 1 /),                                   &
-                                        count = (/ nx+1, ns /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_lat_xz(k,av),                        &
-                                        lat, start = (/ 1, 1 /),                                   &
-                                        count = (/ nx+1, ns /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-             ENDDO
-
-             DEALLOCATE( lat )
-             DEALLOCATE( lon )
-
-          ENDIF
-
-
-       CASE ( 'xz_ext' )
-
-!
-!--       Get the list of variables and compare with the actual run.
-!--       First var_list_old has to be reset, since GET_ATT does not assign trailing blanks.
-          var_list_old = ' '
-          nc_stat = NF90_GET_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', var_list_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 168 )
-
-          var_list = ';'
-          i = 1
-          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
-             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
-                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
-             ENDIF
-             i = i + 1
-          ENDDO
-
-          IF ( av == 0 )  THEN
-             var = '(xz)'
-          ELSE
-             var = '(xz_av)'
-          ENDIF
-
-          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
-             message_string = 'netCDF file for cross-sections ' // TRIM( var ) //                  &
-                              ' from previous run found,' //                                       &
-                              '&but this file cannot be extended due to' //                        &
-                              ' variable mismatch.' // '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Calculate the number of current sections
-          ns = 1
-          DO WHILE ( section(ns,2) /= -9999  .AND.  ns <= 100 )
-             ns = ns + 1
-          ENDDO
-          ns = ns - 1
-
-!
-!--       Get and compare the number of vertical cross sections
-          nc_stat = NF90_INQ_VARID( id_set_xz(av), 'y_xz', id_var_y_xz(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 169 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_y_xz(av),                         &
-                                           dimids = id_dim_y_xz_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 170 )
-          id_dim_y_xz(av) = id_dim_y_xz_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_y_xz(av), LEN = ns_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 171 )
-
-          IF ( ns /= ns_old )  THEN
-             message_string = 'netCDF file for cross-sections ' // TRIM( var ) //                  &
-                              ' from previous run found,' //                                       &
-                              '&but this file cannot be extended due to' //                        &
-                              ' mismatch in number of' // ' cross sections.' //                    &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get and compare the heights of the cross sections
-          ALLOCATE( netcdf_data(1:ns_old) )
-
-          nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_y_xz(av), netcdf_data )
-          CALL netcdf_handle_error( 'netcdf_define_header', 172 )
-
-          DO  i = 1, ns
-             IF ( section(i,2) /= -1 )  THEN
-                IF ( ( ( section(i,2) + 0.5 ) * dy ) /= netcdf_data(i) )  THEN
-                   message_string = 'netCDF file for cross-sections ' // TRIM( var ) //            &
-                                    ' from previous run found,' //                                 &
-                                    ' but this file cannot be extended' //                         &
-                                    ' due to mismatch in cross' // ' section levels.' //           &
-                                     ' New file is created instead.'
-                   CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 )
-                   extend = .FALSE.
-                   RETURN
-                ENDIF
-             ELSE
-                IF ( -1.0_wp /= netcdf_data(i) )  THEN
-                   message_string = 'netCDF file for cross-sections ' // TRIM( var ) //            &
-                                    ' from previous run found,' //                                 &
-                                    ' but this file cannot be extended' //                         &
-                                     ' due to mismatch in cross' // ' section levels.' //          &
-                                     ' New file is created instead.'
-                   CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 )
-                   extend = .FALSE.
-                   RETURN
-                ENDIF
-             ENDIF
-          ENDDO
-
-          DEALLOCATE( netcdf_data )
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is do2d..count+1.
-!--       The current time must be larger than the last output time on the file.
-          nc_stat = NF90_INQ_VARID( id_set_xz(av), 'time', id_var_time_xz(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 173 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_time_xz(av),                      &
-                                           dimids = id_dim_time_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 174 )
-          id_dim_time_xz(av) = id_dim_time_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_time_xz(av), LEN = ntime_count )
-          CALL netcdf_handle_error( 'netcdf_define_header', 175 )
-
-!
-!--       For non-parallel output use the last output time level of the netcdf file because the time
-!--       dimension is unlimited. In case of parallel output the variable ntime_count could get the
-!--       value of 9*10E36 because the time dimension is limited.
-          IF ( netcdf_data_format < 5 ) do2d_xz_time_count(av) = ntime_count
-
-          nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_time_xz(av),                               &
-                                  last_time_coordinate,                                            &
-                                  start = (/ do2d_xz_time_count(av) /),                            &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 176 )
-
-          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-             message_string = 'netCDF file for cross sections ' // TRIM( var ) //                  &
-                              ' from previous run found,' //                                       &
-                              '&but this file cannot be extended because' //                       &
-                              ' the current output time' //                   &
-                              '&is less or equal than the last output time' // ' on this file.' // &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 )
-             do2d_xz_time_count(av) = 0
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-          IF ( netcdf_data_format > 4 )  THEN
-!
-!--          Check if the needed number of output time levels is increased compared to the number of
-!--          time levels in the existing file.
-             IF ( ntdim_2d_xz(av) > ntime_count )  THEN
-                message_string = 'netCDF file for cross sections ' // TRIM( var ) //               &
-                                 ' from previous run found,' //                                    &
-                                 '&but this file cannot be extended becaus' //                     &
-                                 'e the number of output time levels has b' //                     &
-                                 'een increased compared to the previous s' // 'imulation.' //     &
-                                 '&New file is created instead.'
-                CALL message( 'define_netcdf_header', 'PA0390', 0, 1, 0, 6, 0 )
-                do2d_xz_time_count(av) = 0
-                extend = .FALSE.
-!
-!--             Recalculate the needed time levels for the new file.
-                IF ( av == 0 )  THEN
-                   ntdim_2d_xz(0) = CEILING( ( end_time - MAX( skip_time_do2d_xz,                  &
-                                                               simulated_time_at_begin )           &
-                                             ) / dt_do2d_xz )
-                   IF ( do2d_at_begin )  ntdim_2d_xz(0) = ntdim_2d_xz(0) + 1
-                ELSE
-                   ntdim_2d_xz(1) = CEILING( ( end_time - MAX( skip_time_data_output_av,           &
-                                                               simulated_time_at_begin )           &
-                                             ) / dt_data_output_av )
-                ENDIF
-                RETURN
-             ENDIF
-          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the variable ids.
-          i = 1
-          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
-             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
-                nc_stat = NF90_INQ_VARID( id_set_xz(av), do2d(av,i), id_var_do2d(av,i) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 177 )
-#if defined( __netcdf4_parallel )
-!
-!--             Set independent io operations for parallel io. Collective io is only allowed in case
-!--             of a 1d-decomposition along x, because otherwise, not all PEs have output data.
-                IF ( netcdf_data_format > 4 )  THEN
-                   IF ( npey == 1 )  THEN
-                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),                                &
-                                                     id_var_do2d(av,i),                            &
-                                                     NF90_COLLECTIVE )
-                   ELSE
-!
-!--                   Test simulations showed that the output of cross sections by all PEs in
-!--                   data_output_2d using NF90_COLLECTIVE is faster than the output by the first
-!--                   row of PEs in x-direction using NF90_INDEPENDENT.
-                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),                                &
-                                                     id_var_do2d(av,i),                            &
-                                                     NF90_COLLECTIVE )
-!                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),                                &
-!                                                     id_var_do2d(av,i),                            &
-!                                                     NF90_INDEPENDENT )
-                   ENDIF
-                   CALL netcdf_handle_error( 'netcdf_define_header', 455 )
-                ENDIF
-#endif
-             ENDIF
-             i = i + 1
-          ENDDO
-
-!
-!--       Update the title attribute on file.
-!--       In order to avoid 'data mode' errors if updated attributes are larger than their original
-!--       size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF
-!--       calls. This implies a possible performance loss due to data copying; an alternative
-!--       strategy would be to ensure equal attribute size in a job chain. Maybe revise later.
-          IF ( av == 0 )  THEN
-             time_average_text = ' '
-          ELSE
-             WRITE ( time_average_text, '('', '',F7.1,'' s average'')' ) averaging_interval
-          ENDIF
-          nc_stat = NF90_REDEF( id_set_xz(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 433 )
-          nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'title',                             &
-                                  TRIM( run_description_header ) // TRIM( time_average_text ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 178 )
-          nc_stat = NF90_ENDDEF( id_set_xz(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 434 )
-          message_string = 'netCDF file for cross-sections ' // TRIM( var ) //                     &
-                           ' from previous run found.' // '&This file will be extended.'
-          CALL message( 'define_netcdf_header', 'PA0253', 0, 0, 0, 6, 0 )
-
-
-       CASE ( 'yz_new' )
-
-!
-!--       Define some global attributes of the dataset
-          IF ( av == 0 )  THEN
-             CALL netcdf_create_global_atts( id_set_yz(av), 'yz', TRIM( run_description_header ),  &
-                                             179 )
-             time_average_text = ' '
-          ELSE
-             CALL netcdf_create_global_atts( id_set_yz(av), 'yz_av',                               &
-                                             TRIM( run_description_header ), 179 )
-             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
-             nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'time_avg',                       &
-                                     TRIM( time_average_text ) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 180 )
-          ENDIF
-
-!
-!--       Define time coordinate for yz sections.
-!--       For parallel output the time dimensions has to be limited, otherwise the performance drops
-!--       significantly.
-          IF ( netcdf_data_format < 5 )  THEN
-             CALL netcdf_create_dim( id_set_yz(av), 'time', NF90_UNLIMITED, id_dim_time_yz(av),    &
-                                     181 )
-          ELSE
-             CALL netcdf_create_dim( id_set_yz(av), 'time', ntdim_2d_yz(av), id_dim_time_yz(av),   &
-                                     526 )
-          ENDIF
-
-          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_time_yz(av) /), 'time', NF90_DOUBLE,    &
-                                  id_var_time_yz(av), 'seconds', 'time', 182, 183, 000 )
-          CALL netcdf_create_att( id_set_yz(av), id_var_time_yz(av), 'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_yz(av), id_var_time_yz(av), 'axis', 'T', 000)
-!
-!--       Define the spatial dimensions and coordinates for yz-sections.
-!--       First, determine the number of vertical sections to be written.
-          IF ( section(1,3) == -9999 )  THEN
-             RETURN
-          ELSE
-             ns = 1
-             DO  WHILE ( section(ns,3) /= -9999  .AND.  ns <= 100 )
-                ns = ns + 1
-             ENDDO
-             ns = ns - 1
-          ENDIF
-
-!
-!--       Define x axis (for scalar position)
-          CALL netcdf_create_dim( id_set_yz(av), 'x_yz', ns, id_dim_x_yz(av), 184 )
-          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_x_yz(av) /), 'x_yz', NF90_DOUBLE,       &
-                                  id_var_x_yz(av), 'meters', '', 185, 186, 000 )
-          CALL netcdf_create_att( id_set_yz(av), id_var_x_yz(av), 'axis', 'X', 000)
-!
-!--       Define x axis (for u position)
-          CALL netcdf_create_dim( id_set_yz(av), 'xu_yz', ns, id_dim_xu_yz(av), 377 )
-          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_xu_yz(av) /), 'xu_yz', NF90_DOUBLE,     &
-                                  id_var_xu_yz(av), 'meters', '', 378, 379, 000 )
-          CALL netcdf_create_att( id_set_yz(av), id_var_xu_yz(av), 'axis', 'X', 000)
-!
-!--       Define a variable to store the layer indices of the vertical cross sections
-          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_x_yz(av) /), 'ind_x_yz', NF90_DOUBLE,   &
-                                  id_var_ind_x_yz(av), 'gridpoints', '', 187, 188, 000 )
-!
-!--       Define y-axis (for scalar position)
-          CALL netcdf_create_dim( id_set_yz(av), 'y', ny+1, id_dim_y_yz(av), 189 )
-          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_y_yz(av) /), 'y', NF90_DOUBLE,          &
-                                  id_var_y_yz(av), 'meters', '', 190, 191, 000 )
-          CALL netcdf_create_att( id_set_yz(av), id_var_y_yz(av), 'axis', 'Y', 000)
-!
-!--       Define y-axis (for v position)
-          CALL netcdf_create_dim( id_set_yz(av), 'yv', ny+1, id_dim_yv_yz(av), 380 )
-          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_yv_yz(av) /), 'yv', NF90_DOUBLE,        &
-                                  id_var_yv_yz(av), 'meters', '', 381, 382, 000 )
-          CALL netcdf_create_att( id_set_yz(av), id_var_yv_yz(av), 'axis', 'Y', 000)
-!
-!--       Define the two z-axes (zu and zw)
-          CALL netcdf_create_dim( id_set_yz(av), 'zu', nz+2, id_dim_zu_yz(av), 192 )
-          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zu_yz(av) /), 'zu', NF90_DOUBLE,        &
-                                  id_var_zu_yz(av), 'meters', '', 193, 194, 000 )
-          CALL netcdf_create_att( id_set_yz(av), id_var_zu_yz(av), 'axis', 'Z', 000)
-
-          CALL netcdf_create_dim( id_set_yz(av), 'zw', nz+2, id_dim_zw_yz(av), 195 )
-          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zw_yz(av) /), 'zw', NF90_DOUBLE,        &
-                                  id_var_zw_yz(av), 'meters', '', 196, 197, 000 )
-          CALL netcdf_create_att( id_set_yz(av), id_var_zw_yz(av), 'axis', 'Z', 000)
-!
-!--       Define UTM and geographic coordinates
-          CALL define_geo_coordinates( id_set_yz(av),                                              &
-                                       (/ id_dim_x_yz(av), id_dim_xu_yz(av) /),                    &
-                                       (/ id_dim_y_yz(av), id_dim_yv_yz(av) /),                    &
-                                       id_var_eutm_yz(:,av), id_var_nutm_yz(:,av),                 &
-                                       id_var_lat_yz(:,av), id_var_lon_yz(:,av)    )
-!
-!--       Define coordinate-reference system
-          CALL netcdf_create_crs( id_set_yz(av), 000 )
-
-          IF ( land_surface )  THEN
-
-             CALL netcdf_create_dim( id_set_yz(av), 'zs', nzs, id_dim_zs_yz(av), 545 )
-             CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zs_yz(av) /), 'zs', NF90_DOUBLE,     &
-                                     id_var_zs_yz(av), 'meters', '', 546, 547, 000 )
-             CALL netcdf_create_att( id_set_yz(av), id_var_zs_yz(av), 'axis', 'Z', 000)
-
-          ENDIF
-
-!
-!--       Define the variables
-          var_list = ';'
-          i = 1
-
-          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
-
-             IF ( INDEX( do2d(av,i), 'yz' ) /= 0 )  THEN
-
-!
-!--             Check for the grid
-                found = .FALSE.
-                SELECT CASE ( do2d(av,i) )
-!
-!--                Most variables are defined on the zu grid
-                   CASE ( 'e_yz', 'nc_yz', 'ng_yz', 'ni_yz', 'nr_yz', 'ns_yz', 'p_yz', 'pc_yz',    &
-                          'pr_yz','prr_yz', 'q_yz', 'qc_yz', 'qg_yz', 'qi_yz', 'ql_yz',            &
-                          'ql_c_yz', 'ql_v_yz', 'ql_vp_yz', 'qr_yz', 'qs_yz', 'qv_yz',             &
-                          's_yz',                                                                  &
-                          'theta_yz', 'thetal_yz', 'thetav_yz', 'ti_yz' )
-
-                      grid_x = 'x'
-                      grid_y = 'y'
-                      grid_z = 'zu'
-!
-!--                u grid
-                   CASE ( 'u_yz' )
-
-                      grid_x = 'xu'
-                      grid_y = 'y'
-                      grid_z = 'zu'
-!
-!--                v grid
-                   CASE ( 'v_yz' )
-
-                      grid_x = 'x'
-                      grid_y = 'yv'
-                      grid_z = 'zu'
-!
-!--                w grid
-                   CASE ( 'w_yz' )
-
-                      grid_x = 'x'
-                      grid_y = 'y'
-                      grid_z = 'zw'
-
-
-                   CASE DEFAULT
-!
-!--                   Check for land surface quantities
-                      IF ( land_surface )  THEN
-                         CALL lsm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-                      IF ( .NOT. found )  THEN
-                         CALL tcm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-!
-!--                   Check for ocean quantities
-                      IF ( .NOT. found  .AND.  ocean_mode )  THEN
-                         CALL ocean_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-!
-!--                   Check for radiation quantities
-                      IF ( .NOT. found  .AND.  radiation )  THEN
-                         CALL radiation_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y,     &
-                                                            grid_z )
-                      ENDIF
-!
-!--                   Check for SALSA quantities
-                      IF ( .NOT. found  .AND.  salsa )  THEN
-                         CALL salsa_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-!
-!--                   Check for gust module quantities
-                      IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
-                         CALL gust_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-!
-!--                   Check for chemistry quantities
-                      IF ( .NOT. found  .AND.  air_chemistry )  THEN
-                         CALL chem_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-                      IF ( .NOT. found )                                                           &
-                         CALL doq_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-!
-!--                   Check for user-defined quantities
-                      IF ( .NOT. found  .AND.  user_module_enabled )  THEN
-                         CALL user_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z )
-                      ENDIF
-
-                      IF ( .NOT. found )  THEN
-                         WRITE ( message_string, * ) 'no grid defined for', ' variable ',          &
-                                                     TRIM( do2d(av,i) )
-                         CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, 6, 0 )
-                      ENDIF
-
-                END SELECT
-
-!
-!--             Select the respective dimension ids
-                IF ( grid_x == 'x' )  THEN
-                   id_x = id_dim_x_yz(av)
-                ELSEIF ( grid_x == 'xu' )  THEN
-                   id_x = id_dim_xu_yz(av)
-                ENDIF
-
-                IF ( grid_y == 'y' )  THEN
-                   id_y = id_dim_y_yz(av)
-                ELSEIF ( grid_y == 'yv' )  THEN
-                   id_y = id_dim_yv_yz(av)
-                ENDIF
-
-                IF ( grid_z == 'zu' )  THEN
-                   id_z = id_dim_zu_yz(av)
-                ELSEIF ( grid_z == 'zw' )  THEN
-                   id_z = id_dim_zw_yz(av)
-                ELSEIF ( grid_z == 'zs' )  THEN
-                   id_z = id_dim_zs_yz(av)
-                ENDIF
-
-!
-!--             Define the grid
-                CALL netcdf_create_var( id_set_yz(av),  (/ id_x, id_y, id_z, id_dim_time_yz(av) /),&
-                                        do2d(av,i), nc_precision(3), id_var_do2d(av,i),            &
-                                        TRIM( do2d_unit(av,i) ), do2d(av,i), 198, 199, 356, .TRUE. )
-
-#if defined( __netcdf4_parallel )
-                IF ( netcdf_data_format > 4 )  THEN
-!
-!--                Set no fill for every variable to increase performance.
-                   nc_stat = NF90_DEF_VAR_FILL( id_set_yz(av),                                     &
-                                                id_var_do2d(av,i),                                 &
-                                                NF90_NOFILL, 0 )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 535 )
-!
-!--                Set independent io operations for parallel io. Collective io is only allowed in
-!--                case of a 1d-decomposition along y, because otherwise, not all PEs have output
-!--                data.
-                   IF ( npex == 1 )  THEN
-                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),                                &
-                                                     id_var_do2d(av,i),                            &
-                                                     NF90_COLLECTIVE )
-                   ELSE
-!
-!--                   Test simulations showed that the output of cross sections by all PEs in
-!--                   data_output_2d using NF90_COLLECTIVE is faster than the output by the first
-!--                   row of PEs in y-direction using NF90_INDEPENDENT.
-                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),                                &
-                                                     id_var_do2d(av,i),                            &
-                                                     NF90_COLLECTIVE )
-!                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),                                &
-!                                                     id_var_do2d(av,i),                            &
-!                                                     NF90_INDEPENDENT )
-                   ENDIF
-                   CALL netcdf_handle_error( 'netcdf_define_header', 450 )
-                ENDIF
-#endif
-                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
-
-             ENDIF
-
-             i = i + 1
-
-          ENDDO
-
-!
-!--       No arrays to output. Close the netcdf file and return.
-          IF ( i == 1 )  RETURN
-
-!
-!--       Write the list of variables as global attribute (this is used by restart runs and by
-!--       combine_plot_fields)
-          nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', var_list )
-          CALL netcdf_handle_error( 'netcdf_define_header', 200 )
-
-!
-!--       Set general no fill, otherwise the performance drops significantly for parallel output.
-          nc_stat = NF90_SET_FILL( id_set_yz(av), NF90_NOFILL, oldmode )
-          CALL netcdf_handle_error( 'netcdf_define_header', 531 )
-
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_yz(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 201 )
-
-!
-!--       These data are only written by PE0 for parallel output to increase the performance.
-          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
-
-!
-!--          Write axis data: x_yz, y, zu, zw
-             ALLOCATE( netcdf_data(1:ns) )
-
-!
-!--          Write x_yz data (shifted by +dx/2)
-             DO  i = 1, ns
-                IF( section(i,3) == -1 )  THEN
-                   netcdf_data(i) = -1.0_wp  ! section averaged along x
-                ELSE
-                   netcdf_data(i) = ( section(i,3) + 0.5_wp ) * dx
-                ENDIF
-             ENDDO
-             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_x_yz(av),                               &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ns /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 202 )
-
-!
-!--          Write x_yz data (xu grid)
-             DO  i = 1, ns
-                IF( section(i,3) == -1 )  THEN
-                   netcdf_data(i) = -1.0_wp  ! section averaged along x
-                ELSE
-                   netcdf_data(i) = section(i,3) * dx
-                ENDIF
-             ENDDO
-             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_xu_yz(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ns /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 383 )
-
-!
-!--          Write gridpoint number data
-             netcdf_data(1:ns) = section(1:ns,3)
-             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_ind_x_yz(av),                           &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ns /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 203 )
-
-             DEALLOCATE( netcdf_data )
-
-!
-!--          Write data for y (shifted by +dy/2) and yv axis
-             ALLOCATE( netcdf_data(0:ny) )
-
-             DO  j = 0, ny
-                netcdf_data(j) = ( j + 0.5_wp ) * dy
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_y_yz(av),                               &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ny+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 204 )
-
-             DO  j = 0, ny
-                netcdf_data(j) = j * dy
-             ENDDO
-
-             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_yv_yz(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ ny+1 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 384 )
-
-             DEALLOCATE( netcdf_data )
-
-!
-!--          Write zu and zw data (vertical axes)
-             ALLOCATE( netcdf_data(0:nz+1) )
-
-             netcdf_data(0:nz+1) = zu(nzb:nzt+1)
-             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zu_yz(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ nz+2 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 205 )
-
-             netcdf_data(0:nz+1) = zw(nzb:nzt+1)
-             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zw_yz(av),                              &
-                                     netcdf_data, start = (/ 1 /),                                 &
-                                     count = (/ nz+2 /) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 206 )
-
-             DEALLOCATE( netcdf_data )
-!
-!--          Write UTM coordinates
-             IF ( rotation_angle == 0.0_wp )  THEN
-!
-!--             1D in case of no rotation
-                cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-!
-!--             x coordinates
-                ALLOCATE( netcdf_data(1:ns) )
-                DO  k = 0, 2
-!
-!--                Scalar grid points
-                   IF ( k == 0 )  THEN
-                      shift_x = 0.5
-!
-!--                u grid points
-                   ELSEIF ( k == 1 )  THEN
-                      shift_x = 0.0
-!
-!--                v grid points
-                   ELSEIF ( k == 2 )  THEN
-                      shift_x = 0.5
-                   ENDIF
-
-                   DO  i = 1, ns
-                      IF( section(i,3) == -1 )  THEN
-                         netcdf_data(i) = -1.0_wp  ! section averaged along x
-                      ELSE
-                         netcdf_data(i) = init_model%origin_x                                      &
-                                          + cos_rot_angle * ( section(i,3) + shift_x ) * dx
-                      ENDIF
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_eutm_yz(k,av),                    &
-                                           netcdf_data, start = (/ 1 /),                           &
-                                           count = (/ ns /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data )
-!
-!--             y coordinates
-                ALLOCATE( netcdf_data(0:ny) )
-                DO  k = 0, 2
-!
-!--                Scalar grid points
-                   IF ( k == 0 )  THEN
-                      shift_y = 0.5
-!
-!--                u grid points
-                   ELSEIF ( k == 1 )  THEN
-                      shift_y = 0.5
-!
-!--                v grid points
-                   ELSEIF ( k == 2 )  THEN
-                      shift_y = 0.0
-                   ENDIF
-
-                   DO  i = 0, ny
-                     netcdf_data(i) = init_model%origin_y + cos_rot_angle * ( i + shift_y ) * dy
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_nutm_yz(k,av),                    &
-                                           netcdf_data, start = (/ 1 /),                           &
-                                           count = (/ ny+1 /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data )
-
-             ELSE
-!
-!--             2D in case of rotation
-                ALLOCATE( netcdf_data_2d(1:ns,0:ny) )
-                cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-                sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-                DO  k = 0, 2
-!
-!--                Scalar grid points
-                   IF ( k == 0 )  THEN
-                      shift_x = 0.5 ; shift_y = 0.5
-!
-!--                u grid points
-                   ELSEIF ( k == 1 )  THEN
-                      shift_x = 0.0 ; shift_y = 0.5
-!
-!--                v grid points
-                   ELSEIF ( k == 2 )  THEN
-                      shift_x = 0.5 ; shift_y = 0.0
-                   ENDIF
-
-                   DO  j = 0, ny
-                      DO  i = 1, ns
-                         IF( section(i,3) == -1 )  THEN
-                            netcdf_data_2d(i,:) = -1.0_wp !section averaged along x
-                         ELSE
-                            netcdf_data_2d(i,j) = init_model%origin_x                              &
-                                                 + cos_rot_angle * ( section(i,3) + shift_x ) * dx &
-                                                 + sin_rot_angle * ( j + shift_y ) * dy
-                         ENDIF
-                      ENDDO
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_eutm_yz(k,av),                    &
-                                           netcdf_data_2d, start = (/ 1, 1 /),                     &
-                                           count = (/ ns, ny+1 /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
-
-                   DO  j = 0, ny
-                      DO  i = 1, ns
-                         IF( section(i,3) == -1 )  THEN
-                            netcdf_data_2d(i,:) = -1.0_wp !section averaged along x
-                         ELSE
-                            netcdf_data_2d(i,j) = init_model%origin_y                              &
-                                                 - sin_rot_angle * ( section(i,3) + shift_x ) * dx &
-                                                 + cos_rot_angle * ( j + shift_y ) * dy
-                         ENDIF
-                      ENDDO
-                   ENDDO
-
-                   nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_nutm_yz(k,av),                    &
-                                           netcdf_data_2d, start = (/ 1, 1 /),                     &
-                                           count = (/ ns, ny+1 /) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                ENDDO
-                DEALLOCATE( netcdf_data_2d )
-             ENDIF
-!
-!--          Write lon and lat data
-             ALLOCATE( lat(1:ns,0:ny) )
-             ALLOCATE( lon(1:ns,0:ny) )
-             cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-             sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-             DO  k = 0, 2
-!
-!--             Scalar grid points
-                IF ( k == 0 )  THEN
-                   shift_x = 0.5 ; shift_y = 0.5
-!
-!--             u grid points
-                ELSEIF ( k == 1 )  THEN
-                   shift_x = 0.0 ; shift_y = 0.5
-!
-!--             v grid points
-                ELSEIF ( k == 2 )  THEN
-                   shift_x = 0.5 ; shift_y = 0.0
-                ENDIF
-
-                DO  j = 0, ny
-                   DO  i = 1, ns
-                      IF( section(i,3) == -1 )  THEN
-                         lat(i,:) = -90.0_wp   ! section averaged along x
-                         lon(i,:) = -180.0_wp  ! section averaged along x
-                      ELSE
-                         eutm = init_model%origin_x                                                &
-                                + cos_rot_angle * ( section(i,3) + shift_x ) * dx                  &
-                                + sin_rot_angle * ( j + shift_y ) * dy
-                         nutm = init_model%origin_y                                                &
-                                - sin_rot_angle * ( section(i,3) + shift_x ) * dx                  &
-                                + cos_rot_angle * ( j + shift_y ) * dy
-
-                         CALL convert_utm_to_geographic( crs_list, eutm, nutm, lon(i,j), lat(i,j) )
-                      ENDIF
-                   ENDDO
-                ENDDO
-
-                nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_lon_yz(k,av),                        &
-                                        lon, start = (/ 1, 1 /),                                   &
-                                        count = (/ ns, ny+1 /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-
-                nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_lat_yz(k,av),                        &
-                                        lat, start = (/ 1, 1 /),                                   &
-                                        count = (/ ns, ny+1 /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
-             ENDDO
-
-             DEALLOCATE( lat )
-             DEALLOCATE( lon )
-
-          ENDIF
-
-
-       CASE ( 'yz_ext' )
-
-!
-!--       Get the list of variables and compare with the actual run.
-!--       First var_list_old has to be reset, since GET_ATT does not assign trailing blanks.
-          var_list_old = ' '
-          nc_stat = NF90_GET_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', var_list_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 207 )
-
-          var_list = ';'
-          i = 1
-          DO  WHILE ( do2d(av,i)(1:1) /= ' ' )
-             IF ( INDEX( do2d(av,i), 'yz' ) /= 0 )  THEN
-                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
-             ENDIF
-             i = i + 1
-          ENDDO
-
-          IF ( av == 0 )  THEN
-             var = '(yz)'
-          ELSE
-             var = '(yz_av)'
-          ENDIF
-
-          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
-             message_string = 'netCDF file for cross-sections ' // TRIM( var ) //                  &
-                              ' from previous run found,' //                                       &
-                              '&but this file cannot be extended due to' //                        &
-                              ' variable mismatch.' // '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Calculate the number of current sections
-          ns = 1
-          DO WHILE ( section(ns,3) /= -9999  .AND.  ns <= 100 )
-             ns = ns + 1
-          ENDDO
-          ns = ns - 1
-
-!
-!--       Get and compare the number of vertical cross sections
-          nc_stat = NF90_INQ_VARID( id_set_yz(av), 'x_yz', id_var_x_yz(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 208 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_x_yz(av), &
-                                           dimids = id_dim_x_yz_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 209 )
-          id_dim_x_yz(av) = id_dim_x_yz_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_x_yz(av), LEN = ns_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 210 )
-
-          IF ( ns /= ns_old )  THEN
-             message_string = 'netCDF file for cross-sections ' // TRIM( var ) //                  &
-                              ' from previous run found,' //                                       &
-                              '&but this file cannot be extended due to' //                        &
-                              ' mismatch in number of' // ' cross sections.' //                    &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get and compare the heights of the cross sections
-          ALLOCATE( netcdf_data(1:ns_old) )
-
-          nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_x_yz(av), netcdf_data )
-          CALL netcdf_handle_error( 'netcdf_define_header', 211 )
-
-          DO  i = 1, ns
-             IF ( section(i,3) /= -1 )  THEN
-                IF ( ( ( section(i,3) + 0.5 ) * dx ) /= netcdf_data(i) )  THEN
-                   message_string = 'netCDF file for cross-sections ' // TRIM( var ) //            &
-                                    ' from previous run found,' //                                 &
-                                    ' but this file cannot be extended' //                         &
-                                    ' due to mismatch in cross' // ' section levels.' //           &
-                                    ' New file is created instead.'
-                   CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 )
-                   extend = .FALSE.
-                   RETURN
-                ENDIF
-             ELSE
-                IF ( -1.0_wp /= netcdf_data(i) )  THEN
-                   message_string = 'netCDF file for cross-sections ' // TRIM( var ) //            &
-                                    ' from previous run found,' //                                 &
-                                    ' but this file cannot be extended' //                         &
-                                    ' due to mismatch in cross' // ' section levels.' //           &
-                                    ' New file is created instead.'
-                   CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 )
-                   extend = .FALSE.
-                   RETURN
-                ENDIF
-             ENDIF
-          ENDDO
-
-          DEALLOCATE( netcdf_data )
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is pl2d..count+1.
-!--       The current time must be larger than the last output time on the file.
-          nc_stat = NF90_INQ_VARID( id_set_yz(av), 'time', id_var_time_yz(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 212 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_time_yz(av),                      &
-                                           dimids = id_dim_time_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 213 )
-          id_dim_time_yz(av) = id_dim_time_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_time_yz(av), LEN = ntime_count )
-          CALL netcdf_handle_error( 'netcdf_define_header', 214 )
-
-!
-!--       For non-parallel output use the last output time level of the netcdf file because the time
-!--       dimension is unlimited. In case of parallel output the variable ntime_count could get the
-!--       value of 9*10E36 because the time dimension is limited.
-          IF ( netcdf_data_format < 5 ) do2d_yz_time_count(av) = ntime_count
-
-          nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_time_yz(av),                               &
-                                  last_time_coordinate,                                            &
-                                  start = (/ do2d_yz_time_count(av) /),                            &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 215 )
-
-          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-             message_string = 'netCDF file for cross sections ' // TRIM( var ) //                  &
-                              ' from previous run found,' //                                       &
-                              '&but this file cannot be extended because' //                       &
-                              ' the current output time' //                                        &
-                              '&is less or equal than the last output time' // ' on this file.' // &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 )
-             do2d_yz_time_count(av) = 0
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-          IF ( netcdf_data_format > 4 )  THEN
-!
-!--          Check if the needed number of output time levels is increased
-!--          compared to the number of time levels in the existing file.
-             IF ( ntdim_2d_yz(av) > ntime_count )  THEN
-                message_string = 'netCDF file for cross sections ' // TRIM( var ) //               &
-                                 ' from previous run found,' //                                    &
-                                 '&but this file cannot be extended because' //                    &
-                                 ' the number of output time levels has ' //                       &
-                                 'been increased compared to the previous ' // 'simulation.' //    &
-                                 '&New file is created instead.'
-                CALL message( 'define_netcdf_header', 'PA0391', 0, 1, 0, 6, 0 )
-                do2d_yz_time_count(av) = 0
-                extend = .FALSE.
-!
-!--             Recalculate the needed time levels for the new file.
-                IF ( av == 0 )  THEN
-                   ntdim_2d_yz(0) = CEILING( ( end_time - MAX( skip_time_do2d_yz,                  &
-                                                               simulated_time_at_begin )           &
-                                             ) / dt_do2d_yz )
-                   IF ( do2d_at_begin )  ntdim_2d_yz(0) = ntdim_2d_yz(0) + 1
-                ELSE
-                   ntdim_2d_yz(1) = CEILING( ( end_time - MAX( skip_time_data_output_av,           &
-                                                               simulated_time_at_begin )           &
-                                             ) / dt_data_output_av )
-                ENDIF
-                RETURN
-             ENDIF
-          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the variable ids.
-          i = 1
-          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
-             IF ( INDEX( do2d(av,i), 'yz' ) /= 0 )  THEN
-                nc_stat = NF90_INQ_VARID( id_set_yz(av), do2d(av,i), id_var_do2d(av,i) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 216 )
-#if defined( __netcdf4_parallel )
-!
-!--             Set independent io operations for parallel io. Collective io is only allowed in case
-!--             of a 1d-decomposition along y, because otherwise, not all PEs have output data.
-                IF ( netcdf_data_format > 4 )  THEN
-                   IF ( npex == 1 )  THEN
-                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),                                &
-                                                     id_var_do2d(av,i),                            &
-                                                     NF90_COLLECTIVE )
-                   ELSE
-!
-!--                   Test simulations showed that the output of cross sections by all PEs in
-!--                   data_output_2d using NF90_COLLECTIVE is faster than the output by the first
-!--                   row of PEs in y-direction using NF90_INDEPENDENT.
-                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),                                &
-                                                     id_var_do2d(av,i),                            &
-                                                     NF90_COLLECTIVE )
-!                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),                                &
-!                                                     id_var_do2d(av,i),                            &
-!                                                     NF90_INDEPENDENT )
-                   ENDIF
-                   CALL netcdf_handle_error( 'netcdf_define_header', 450 )
-                ENDIF
-#endif
-             ENDIF
-             i = i + 1
-          ENDDO
-
-!
-!--       Update the title attribute on file.
-!--       In order to avoid 'data mode' errors if updated attributes are larger than their original
-!--       size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF
-!--       calls. This implies a possible performance loss due to data copying; an alternative
-!--       strategy would be to ensure equal attribute size in a job chain. Maybe revise later.
-          IF ( av == 0 )  THEN
-             time_average_text = ' '
-          ELSE
-             WRITE ( time_average_text, '('', '',F7.1,'' s average'')' )  averaging_interval
-          ENDIF
-          nc_stat = NF90_REDEF( id_set_yz(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 435 )
-          nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'title',                             &
-                                  TRIM( run_description_header ) // TRIM( time_average_text ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 217 )
-          nc_stat = NF90_ENDDEF( id_set_yz(av) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 436 )
-          message_string = 'netCDF file for cross-sections ' //                                    &
-                            TRIM( var ) // ' from previous run found.' //                          &
-                           '&This file will be extended.'
-          CALL message( 'define_netcdf_header', 'PA0253', 0, 0, 0, 6, 0 )
-
-
-       CASE ( 'pr_new' )
-
-!
-!--       Define some global attributes of the dataset
-
-          IF ( averaging_interval_pr /= 0.0_wp )  THEN
-             CALL netcdf_create_global_atts( id_set_pr, 'podsprav', TRIM( run_description_header ),&
-                                             451 )
-             WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_pr
-             nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'time_avg', TRIM( time_average_text ) )
-          ELSE
-             CALL netcdf_create_global_atts( id_set_pr, 'podspr', TRIM( run_description_header ),  &
-                                             451 )
-          ENDIF
-          CALL netcdf_handle_error( 'netcdf_define_header', 219 )
-!
-!--       Write number of columns and rows of coordinate systems to be plotted on one page to the
-!--       netcdf header.
-!--       This information can be used by palmplot.
-          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL,                                          &
-                                  'no_rows',                                                       &
-                                  profile_rows )
-          CALL netcdf_handle_error( 'netcdf_define_header', 519 )
-
-          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL,                                          &
-                                  'no_columns',                                                    &
-                                  profile_columns )
-          CALL netcdf_handle_error( 'netcdf_define_header', 520 )
-
-
-          cross_profiles_adj  = ADJUSTL( cross_profiles )
-          cross_profiles_numb = 999999
-          cross_profiles_char = ''
-
-!
-!--       Each profile defined in cross_profiles is written to an array (cross_profiles_char). The
-!--       number of the respective coordinate system is assigned in a second array
-!--       (cross_profiles_numb).
-          k = 1
-
-          DO  i = 1, crmax
-
-             IF ( TRIM( cross_profiles_adj(i) ) == ' ' )  EXIT
-             delim_old = 0
-
-             DO   j = 1, crmax
-                delim = INDEX( cross_profiles_adj(i)(delim_old+1:), ' ' )
-                IF ( delim == 1 )  EXIT
-                kk = MIN( crmax, k )
-                cross_profiles_char(kk) = cross_profiles_adj(i)(delim_old+1:delim_old+delim-1)
-                cross_profiles_numb(kk) = i
-                k = k + 1
-                cross_profiles_maxi  = i
-                delim_old = delim_old + delim
-             ENDDO
-
-          ENDDO
-
-          cross_profiles_count = MIN( crmax, k-1 )
-!
-!--       Check if all profiles defined in cross_profiles are defined in data_output_pr. If not,
-!--       they will be skipped.
-          DO  i = 1, cross_profiles_count
-             DO  j = 1, dopr_n
-
-                IF ( TRIM( cross_profiles_char(i) ) == TRIM( data_output_pr(j) ) )  THEN
-                   EXIT
-                ENDIF
-
-                IF ( j == dopr_n )  THEN
-                   cross_profiles_numb(i) = 999999
-                ENDIF
-
-             ENDDO
-          ENDDO
-
-          DO i = 1, crmax
-             IF ( cross_profiles_numb(i) == 999999 ) THEN
-                DO j = i + 1, crmax
-                   IF ( cross_profiles_numb(j) /= 999999 )  THEN
-                      cross_profiles_char(i) = cross_profiles_char(j)
-                      cross_profiles_numb(i) = cross_profiles_numb(j)
-                      cross_profiles_numb(j) = 999999
-                      EXIT
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDDO
-
-          DO i = 1, crmax-1
-             IF ( cross_profiles_numb(i + 1) == 999999 ) THEN
-                cross_profiles_count = i
-                EXIT
-             ENDIF
-          ENDDO
-!
-!--       Check if all profiles defined in data_output_pr are defined in cross_profiles. If not,
-!-        they will be added to cross_profiles.
-          DO  i = 1, dopr_n
-             DO  j = 1, cross_profiles_count
-
-                IF ( TRIM( cross_profiles_char(j) ) == TRIM( data_output_pr(i) ) )  THEN
-                   EXIT
-                ENDIF
-
-                IF ( ( j == cross_profiles_count )  .AND.  ( cross_profiles_count <= crmax - 1) )  &
-                THEN
-                   cross_profiles_count = cross_profiles_count + 1
-                   cross_profiles_maxi  = cross_profiles_maxi  + 1
-                   cross_profiles_char(MIN( crmax, cross_profiles_count )) =                       &
-                                                                           TRIM( data_output_pr(i) )
-                   cross_profiles_numb(MIN( crmax, cross_profiles_count )) = cross_profiles_maxi
-                ENDIF
-
-             ENDDO
-          ENDDO
-
-          IF ( cross_profiles_count >= crmax )  THEN
-             message_string = 'It is not allowed to arrange more than ' //                         &
-                              '100 profiles with & cross_profiles. Apart' //                       &
-                              ' from that, all profiles are saved & to ' // 'the netCDF file.'
-             CALL message( 'define_netcdf_header', 'PA0354', 0, 0, 0, 6, 0 )
-          ENDIF
-
-!
-!--       Writing cross_profiles to netcdf header. This information can be used by palmplot. Each
-!--       profile is separated by ",", each cross is separated by ";".
-          char_cross_profiles = ';'
-          id_last = 1
-          cross_profiles_count = MIN( cross_profiles_count, crmax )
-
-          DO  i = 1, cross_profiles_count
-
-             IF ( cross_profiles_numb(i) /= 999999 )  THEN
-                IF ( TRIM( char_cross_profiles ) == ';' )  THEN
-                   char_cross_profiles = TRIM( char_cross_profiles ) //                            &
-                                         TRIM( cross_profiles_char(i) )
-                ELSEIF ( id_last == cross_profiles_numb(i) )  THEN
-                   char_cross_profiles = TRIM( char_cross_profiles ) //                            &
-                                         ',' // TRIM( cross_profiles_char(i) )
-                ELSE
-                   char_cross_profiles = TRIM( char_cross_profiles ) //                            &
-                                         ';' // TRIM( cross_profiles_char(i) )
-                ENDIF
-                id_last = cross_profiles_numb(i)
-             ENDIF
-
-          ENDDO
-
-          char_cross_profiles = TRIM( char_cross_profiles ) // ';'
-
-          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'cross_profiles',                        &
-                                  TRIM( char_cross_profiles ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 521 )
-
-!
-!--       Define time coordinate for profiles (unlimited dimension)
-          CALL netcdf_create_dim( id_set_pr, 'time', NF90_UNLIMITED, id_dim_time_pr, 220 )
-          CALL netcdf_create_var( id_set_pr, (/ id_dim_time_pr /), 'time', NF90_DOUBLE,            &
-                                  id_var_time_pr, 'seconds', 'time', 221, 222, 000 )
-          CALL netcdf_create_att( id_set_pr, id_var_time_pr, 'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_pr, id_var_time_pr, 'axis', 'T', 000)
-!
-!--       Define the variables
-          var_list = ';'
-          DO  i = 1, dopr_n
-
-             IF ( statistic_regions == 0 )  THEN
-
-!
-!--             Define the z-axes (each variable gets its own z-axis)
-                CALL netcdf_create_dim( id_set_pr, 'z' // TRIM( data_output_pr(i) ), nzt+2-nzb,    &
-                                        id_dim_z_pr(i,0), 223 )
-                CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,0) /), 'z' //                  &
-                                        TRIM( data_output_pr(i) ), NF90_DOUBLE, id_var_z_pr(i,0),  &
-                                       'meters', '', 224, 225, 000 )
-                CALL netcdf_create_att( id_set_pr, id_var_z_pr(i,0), 'axis', 'Z', 000)
-!
-!--             Define the variable
-                CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,0), id_dim_time_pr /),         &
-                                        data_output_pr(i), nc_precision(5), id_var_dopr(i,0),      &
-                                        TRIM( dopr_unit(i) ), TRIM( data_output_pr(i) ), 226, 227, &
-                                        228 )
-
-                var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) //  ';'
-
-             ELSE
-!
-!--             If statistic regions are defined, add suffix _SR+#SR to the names.
-                DO  j = 0, statistic_regions
-                   WRITE ( suffix, '(''_'',I2.2)' )  j
-
-!
-!--                Define the z-axes (each variable gets it own z-axis)
-                   CALL netcdf_create_dim( id_set_pr, 'z' // TRIM(data_output_pr(i)) // suffix,    &
-                                           nzt+2-nzb, id_dim_z_pr(i,j), 229 )
-                   CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,j) /),'z' //                &
-                                           TRIM(data_output_pr(i)) // suffix, NF90_DOUBLE,         &
-                                           id_var_z_pr(i,j), 'meters', '', 230, 231, 000 )
-                   CALL netcdf_create_att( id_set_pr, id_var_z_pr(i,j), 'axis', 'Z', 000)
-!
-!--                Define the variable
-                   CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,j), id_dim_time_pr /),      &
-                                           TRIM(data_output_pr(i)) // suffix, nc_precision(5),     &
-                                           id_var_dopr(i,j), TRIM( dopr_unit(i) ),                 &
-                                           TRIM( data_output_pr(i) ) // ' SR ', 232, 233, 234 )
-
-                   var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) // suffix // ';'
-
-                ENDDO
-
-             ENDIF
-
-          ENDDO
-
-!
-!--       Write the list of variables as global attribute (this is used by restart runs).
-          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', var_list )
-          CALL netcdf_handle_error( 'netcdf_define_header', 235 )
-
-!
-!--       Define normalization variables (as time series)
-          DO  i = 1, dopr_norm_num
-
-             CALL netcdf_create_var( id_set_pr, (/ id_dim_time_pr /), 'NORM_' //                   &
-                                     TRIM( dopr_norm_names(i) ), nc_precision(5),                  &
-                                     id_var_norm_dopr(i), '', TRIM( dopr_norm_longnames(i) ), 236, &
-                                     000, 237 )
-
-          ENDDO
-
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_pr )
-          CALL netcdf_handle_error( 'netcdf_define_header', 238 )
-
-!
-!--       Write z-axes data
-          DO  i = 1, dopr_n
-             DO  j = 0, statistic_regions
-
-                nc_stat = NF90_PUT_VAR( id_set_pr, id_var_z_pr(i,j),                               &
-                                        hom(nzb:nzt+1,2,dopr_index(i),0),                          &
-                                        start = (/ 1 /),                                           &
-                                        count = (/ nzt-nzb+2 /) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 239 )
-
-             ENDDO
-          ENDDO
-
-
-       CASE ( 'pr_ext' )
-
-!
-!--       Get the list of variables and compare with the actual run.
-!--       First var_list_old has to be reset, since GET_ATT does not assign trailing blanks.
-          var_list_old = ' '
-          nc_stat = NF90_GET_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', var_list_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 240 )
-
-          var_list = ';'
-          DO  i = 1, dopr_n
-
-             IF ( statistic_regions == 0 )  THEN
-                var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) // ';'
-             ELSE
-                DO  j = 0, statistic_regions
-                   WRITE ( suffix, '(''_'',I2.2)' )  j
-                   var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) // suffix // ';'
-                ENDDO
-             ENDIF
-
-          ENDDO
-
-          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
-             message_string = 'netCDF file for vertical profiles ' // 'from previous run found,' //&
-                              '&but this file cannot be extended due to' //                        &
-                              ' variable mismatch.' // '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0254', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is dopr..count+1.
-!--       The current time must be larger than the last output time on the file.
-          nc_stat = NF90_INQ_VARID( id_set_pr, 'time', id_var_time_pr )
-          CALL netcdf_handle_error( 'netcdf_define_header', 241 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_pr, id_var_time_pr, dimids = id_dim_time_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 242 )
-          id_dim_time_pr = id_dim_time_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_pr, id_dim_time_pr, LEN = dopr_time_count )
-          CALL netcdf_handle_error( 'netcdf_define_header', 243 )
-
-          nc_stat = NF90_GET_VAR( id_set_pr, id_var_time_pr,                                       &
-                                  last_time_coordinate,                                            &
-                                  start = (/ dopr_time_count /),                                   &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 244 )
-
-          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-             message_string = 'netCDF file for vertical profiles ' // 'from previous run found,' //&
-                              '&but this file cannot be extended because' //                       &
-                              ' the current output time' //                                        &
-                              '&is less or equal than the last output ' // 'time on this file.' // &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0255', 0, 1, 0, 6, 0 )
-             dopr_time_count = 0
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the variable ids.
-          i = 1
-          DO  i = 1, dopr_n
-
-             IF ( statistic_regions == 0 )  THEN
-                nc_stat = NF90_INQ_VARID( id_set_pr, data_output_pr(i), id_var_dopr(i,0) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 245 )
-             ELSE
-                DO  j = 0, statistic_regions
-                   WRITE ( suffix, '(''_'',I2.2)' )  j
-                   netcdf_var_name = TRIM( data_output_pr(i) ) // suffix
-                   nc_stat = NF90_INQ_VARID( id_set_pr, netcdf_var_name, id_var_dopr(i,j) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 246 )
-                ENDDO
-             ENDIF
-
-          ENDDO
-
-!
-!--       Get ids of the normalization variables
-          DO  i = 1, dopr_norm_num
-             nc_stat = NF90_INQ_VARID( id_set_pr, 'NORM_' // TRIM( dopr_norm_names(i) ),           &
-                                       id_var_norm_dopr(i) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 247 )
-          ENDDO
-
-!
-!--       Update the title attribute on file.
-!--       In order to avoid 'data mode' errors if updated attributes are larger than their original
-!--       size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF
-!--       calls. This implies a possible performance loss due to data copying; an alternative
-!--       strategy would be to ensure equal attribute size in a job chain. Maybe revise later.
-          IF ( averaging_interval_pr == 0.0_wp )  THEN
-             time_average_text = ' '
-          ELSE
-             WRITE ( time_average_text, '('', '',F7.1,'' s average'')' )  averaging_interval_pr
-          ENDIF
-          nc_stat = NF90_REDEF( id_set_pr )
-          CALL netcdf_handle_error( 'netcdf_define_header', 437 )
-          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title',                                 &
-                                  TRIM( run_description_header ) // TRIM( time_average_text ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 248 )
-
-          nc_stat = NF90_ENDDEF( id_set_pr )
-          CALL netcdf_handle_error( 'netcdf_define_header', 438 )
-          message_string = 'netCDF file for vertical profiles ' // 'from previous run found.' //   &
-                           '&This file will be extended.'
-          CALL message( 'define_netcdf_header', 'PA0256', 0, 0, 0, 6, 0 )
-
-
-       CASE ( 'ts_new' )
-
-!
-!--       Define some global attributes of the dataset
-          CALL netcdf_create_global_atts( id_set_ts, 'podsts', TRIM(run_description_header), 329 )
-
-          ! nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', TRIM( run_description_header ) )
-          ! CALL netcdf_handle_error( 'netcdf_define_header', 249 )
-
-!
-!--       Define time coordinate for time series (unlimited dimension)
-          CALL netcdf_create_dim( id_set_ts, 'time', NF90_UNLIMITED, id_dim_time_ts, 250 )
-          CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), 'time', NF90_DOUBLE,            &
-                                  id_var_time_ts, 'seconds', 'time', 251, 252, 000 )
-          CALL netcdf_create_att( id_set_ts, id_var_time_ts, 'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_ts, id_var_time_ts, 'axis', 'T', 000)
-!
-!--       Define the variables
-          var_list = ';'
-          DO  i = 1, dots_num
-
-             IF ( statistic_regions == 0 )  THEN
-
-                CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), dots_label(i),            &
-                                        nc_precision(6), id_var_dots(i,0), TRIM( dots_unit(i) ),   &
-                                        TRIM( dots_label(i) ), 253, 254, 255 )
-
-                var_list = TRIM( var_list ) // TRIM( dots_label(i) ) // ';'
-
-             ELSE
-!
-!--             If statistic regions are defined, add suffix _SR+#SR to the names.
-                DO  j = 0, statistic_regions
-                   WRITE ( suffix, '(''_'',I2.2)' )  j
-
-                   CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), TRIM( dots_label(i) )  &
-                                           // suffix, nc_precision(6), id_var_dots(i,j),           &
-                                           TRIM( dots_unit(i) ), TRIM( dots_label(i) ) // ' SR ' //&
-                                           suffix(2:2), 256, 257, 347)
-
-                   var_list = TRIM( var_list ) // TRIM( dots_label(i) ) // &
-                              suffix // ';'
-
-                ENDDO
-
-             ENDIF
-
-          ENDDO
-
-!
-!--       Write the list of variables as global attribute (this is used by restart runs).
-          nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', var_list )
-          CALL netcdf_handle_error( 'netcdf_define_header', 258 )
-
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_ts )
-          CALL netcdf_handle_error( 'netcdf_define_header', 259 )
-
-
-       CASE ( 'ts_ext' )
-
-!
-!--       Get the list of variables and compare with the actual run.
-!--       First var_list_old has to be reset, since GET_ATT does not assign trailing blanks.
-          var_list_old = ' '
-          nc_stat = NF90_GET_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', var_list_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 260 )
-
-          var_list = ';'
-          i = 1
-          DO  i = 1, dots_num
-
-             IF ( statistic_regions == 0 )  THEN
-                var_list = TRIM( var_list ) // TRIM( dots_label(i) ) // ';'
-             ELSE
-                DO  j = 0, statistic_regions
-                   WRITE ( suffix, '(''_'',I2.2)' )  j
-                   var_list = TRIM( var_list ) // TRIM( dots_label(i) ) // suffix // ';'
-                ENDDO
-             ENDIF
-
-          ENDDO
-
-          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
-             message_string = 'netCDF file for time series ' // 'from previous run found,' //      &
-                              '&but this file cannot be extended due to' //                        &
-                              ' variable mismatch.' // '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0257', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is dots..count+1.
-!--       The current time must be larger than the last output time on the file.
-          nc_stat = NF90_INQ_VARID( id_set_ts, 'time', id_var_time_ts )
-          CALL netcdf_handle_error( 'netcdf_define_header', 261 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_ts, id_var_time_ts, dimids = id_dim_time_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 262 )
-          id_dim_time_ts = id_dim_time_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_ts, id_dim_time_ts, LEN = dots_time_count )
-          CALL netcdf_handle_error( 'netcdf_define_header', 263 )
-
-          nc_stat = NF90_GET_VAR( id_set_ts, id_var_time_ts,                                       &
-                                  last_time_coordinate,                                            &
-                                  start = (/ dots_time_count /),                                   &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 264 )
-
-          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-             message_string = 'netCDF file for time series ' // 'from previous run found,' //      &
-                              '&but this file cannot be extended because' //                       &
-                              ' the current output time' //                                        &
-                              '&is less or equal than the last output ' // 'time on this file.' // &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0258', 0, 1, 0, 6, 0 )
-             dots_time_count = 0
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the variable ids
-          i = 1
-          DO  i = 1, dots_num
-
-             IF ( statistic_regions == 0 )  THEN
-                nc_stat = NF90_INQ_VARID( id_set_ts, dots_label(i), id_var_dots(i,0) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 265 )
-             ELSE
-                DO  j = 0, statistic_regions
-                   WRITE ( suffix, '(''_'',I2.2)' )  j
-                   netcdf_var_name = TRIM( dots_label(i) ) // suffix
-                   nc_stat = NF90_INQ_VARID( id_set_ts, netcdf_var_name, id_var_dots(i,j) )
-                   CALL netcdf_handle_error( 'netcdf_define_header', 266 )
-                ENDDO
-             ENDIF
-
-          ENDDO
-
-!
-!--       Update the title attribute on file.
-!--       In order to avoid 'data mode' errors if updated attributes are larger than their original
-!--       size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF
-!--       calls. This implies a possible performance loss due to data copying; an alternative
-!--       strategy would be to ensure equal attribute size in a job chain. Maybe revise later.
-          nc_stat = NF90_REDEF( id_set_ts )
-          CALL netcdf_handle_error( 'netcdf_define_header', 439 )
-          nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', TRIM( run_description_header ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 267 )
-          nc_stat = NF90_ENDDEF( id_set_ts )
-          CALL netcdf_handle_error( 'netcdf_define_header', 440 )
-          message_string = 'netCDF file for time series ' // 'from previous run found.' //         &
-                           '&This file will be extended.'
-          CALL message( 'define_netcdf_header', 'PA0259', 0, 0, 0, 6, 0 )
-
-
-       CASE ( 'sp_new' )
-
-!
-!--       Define some global attributes of the dataset
-          IF ( averaging_interval_sp /= 0.0_wp )  THEN
-             WRITE ( time_average_text,'('', '',F7.1,'' s average'')' )  averaging_interval_sp
-             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title',                              &
-                                     TRIM( run_description_header ) // TRIM( time_average_text ) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 268 )
-
-             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval_sp
-             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', TRIM( time_average_text ) )
-          ELSE
-             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title',                              &
-                                     TRIM( run_description_header ) )
-          ENDIF
-          CALL netcdf_handle_error( 'netcdf_define_header', 269 )
-
-!
-!--       Define time coordinate for spectra (unlimited dimension)
-          CALL netcdf_create_dim( id_set_sp, 'time', NF90_UNLIMITED, id_dim_time_sp, 270 )
-          CALL netcdf_create_var( id_set_sp, (/ id_dim_time_sp /), 'time', NF90_DOUBLE,            &
-                                  id_var_time_sp, 'seconds', 'time', 271, 272, 000 )
-          CALL netcdf_create_att( id_set_sp, id_var_time_sp, 'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_sp, id_var_time_sp, 'axis', 'T', 000)
-!
-!--       Define the spatial dimensions and coordinates for spectra.
-!--       First, determine the number of vertical levels for which spectra are to be output.
-          ns = 1
-          DO WHILE ( comp_spectra_level(ns) /= 999999  .AND.  ns <= 100 )
-             ns = ns + 1
-          ENDDO
-          ns = ns - 1
-
-!
-!--       Define vertical coordinate grid (zu grid)
-          CALL netcdf_create_dim( id_set_sp, 'zu_sp', ns, id_dim_zu_sp, 273 )
-          CALL netcdf_create_var( id_set_sp, (/ id_dim_zu_sp /), 'zu_sp', NF90_DOUBLE,             &
-                                  id_var_zu_sp, 'meters', '', 274, 275, 000 )
-          CALL netcdf_create_att( id_set_sp, id_var_zu_sp, 'axis', 'Z', 000)
-!
-!--       Define vertical coordinate grid (zw grid)
-          CALL netcdf_create_dim( id_set_sp, 'zw_sp', ns, id_dim_zw_sp, 276 )
-          CALL netcdf_create_var( id_set_sp, (/ id_dim_zw_sp /), 'zw_sp', NF90_DOUBLE,             &
-                                  id_var_zw_sp, 'meters', '', 277, 278, 000 )
-          CALL netcdf_create_att( id_set_sp, id_var_zw_sp, 'axis', 'Z', 000)
-!
-!--       Define x-axis
-          CALL netcdf_create_dim( id_set_sp, 'k_x', nx/2, id_dim_x_sp, 279 )
-          CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp /), 'k_x', NF90_DOUBLE,                &
-                                  id_var_x_sp, 'm-1', '', 280, 281, 000 )
-          CALL netcdf_create_att( id_set_sp, id_var_x_sp, 'axis', 'X', 000)
-!
-!--       Define y-axis
-          CALL netcdf_create_dim( id_set_sp, 'k_y', ny/2, id_dim_y_sp, 282 )
-          CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp /), 'k_y', NF90_DOUBLE,                &
-                                  id_var_y_sp, 'm-1', '', 283, 284, 000 )
-          CALL netcdf_create_att( id_set_sp, id_var_y_sp, 'axis', 'Y', 000)
-!
-!--       Define the variables
-          var_list = ';'
-          i = 1
-          DO WHILE ( data_output_sp(i) /= ' '  .AND.  i <= 10 )
-!
-!--          First check for the vertical grid
-             found = .FALSE.
-             SELECT CASE ( data_output_sp(i) )
-!
-!--             Most variables are defined on the zu levels
-                CASE ( 'e', 'nc', 'ng', 'ni', 'nr', 'ns', 'p', 'pc', 'pr', 'prr',                  &
-                       'q', 'qc', 'qg', 'qi', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qs', 'qv',     &
-                       'rho_sea_water', 's', 'sa', &
-                       'theta', 'thetal', 'thetav', 'u', 'v' )
-
-                   grid_z = 'zu'
-!
-!--             zw levels
-                CASE ( 'w' )
-
-                   grid_z = 'zw'
-
-                CASE DEFAULT
-!
-!--                Check for user-defined quantities (found, grid_x and grid_y are dummies).
-                   IF ( user_module_enabled )  THEN
-                      CALL user_define_netcdf_grid( data_output_sp(i), found, grid_x, grid_y,      &
-                                                    grid_z )
-                   ENDIF
-
-             END SELECT
-
-             IF ( INDEX( spectra_direction(i), 'x' ) /= 0 )  THEN
-
-!
-!--             Define the variable
-                netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
-                IF ( TRIM( grid_z ) == 'zw' )  THEN
-                   CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp, id_dim_zw_sp,                &
-                                           id_dim_time_sp /), netcdf_var_name, nc_precision(7),    &
-                                           id_var_dospx(i), 'unknown', netcdf_var_name, 285, 286,  &
-                                           287 )
-                ELSE
-                   CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp, id_dim_zu_sp,                &
-                                           id_dim_time_sp /), netcdf_var_name, nc_precision(7),    &
-                                           id_var_dospx(i), 'unknown', netcdf_var_name, 285, 286,  &
-                                           287 )
-                ENDIF
-
-                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
-
-             ENDIF
-
-             IF ( INDEX( spectra_direction(i), 'y' ) /= 0 )  THEN
-
-!
-!--             Define the variable
-                netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
-                IF ( TRIM( grid_z ) == 'zw' )  THEN
-                   CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp, id_dim_zw_sp,                &
-                                           id_dim_time_sp /), netcdf_var_name, nc_precision(7),    &
-                                           id_var_dospy(i), 'unknown', netcdf_var_name, 288, 289,  &
-                                           290 )
-                ELSE
-                   CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp, id_dim_zu_sp,                &
-                                           id_dim_time_sp /), netcdf_var_name, nc_precision(7),    &
-                                           id_var_dospy(i), 'unknown', netcdf_var_name, 288, 289,  &
-                                           290 )
-                ENDIF
-
-                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
-
-             ENDIF
-
-             i = i + 1
-
-          ENDDO
-
-!
-!--       Write the list of variables as global attribute (this is used by restart runs)
-          nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', var_list )
-          CALL netcdf_handle_error( 'netcdf_define_header', 291 )
-
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_sp )
-          CALL netcdf_handle_error( 'netcdf_define_header', 292 )
-
-!
-!--       Write axis data: zu_sp, zw_sp, k_x, k_y
-          ALLOCATE( netcdf_data(1:ns) )
-
-!
-!--       Write zu data
-          netcdf_data(1:ns) = zu( comp_spectra_level(1:ns) )
-          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zu_sp, netcdf_data,                            &
-                                  start = (/ 1 /),                                                 &
-                                  count = (/ ns /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 293 )
-
-!
-!--       Write zw data
-          netcdf_data(1:ns) = zw( comp_spectra_level(1:ns) )
-          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zw_sp, netcdf_data,                            &
-                                  start = (/ 1 /),                                                 &
-                                  count = (/ ns /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 294 )
-
-          DEALLOCATE( netcdf_data )
-
-!
-!--       Write data for x and y axis (wavenumbers)
-          ALLOCATE( netcdf_data(nx/2) )
-          DO  i = 1, nx/2
-             netcdf_data(i) = 2.0_wp * pi * i / ( dx * ( nx + 1 ) )
-          ENDDO
-
-          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_x_sp, netcdf_data,                             &
-                                  start = (/ 1 /),                                                 &
-                                  count = (/ nx/2 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 295 )
-
-          DEALLOCATE( netcdf_data )
-
-          ALLOCATE( netcdf_data(ny/2) )
-          DO  i = 1, ny/2
-             netcdf_data(i) = 2.0_wp * pi * i / ( dy * ( ny + 1 ) )
-          ENDDO
-
-          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_y_sp, netcdf_data,                             &
-                                  start = (/ 1 /),                                                 &
-                                  count = (/ ny/2 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 296 )
-
-          DEALLOCATE( netcdf_data )
-
-
-       CASE ( 'sp_ext' )
-
-!
-!--       Get the list of variables and compare with the actual run.
-!--       First var_list_old has to be reset, since GET_ATT does not assign trailing blanks.
-          var_list_old = ' '
-          nc_stat = NF90_GET_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', var_list_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 297 )
-          var_list = ';'
-          i = 1
-          DO  WHILE ( data_output_sp(i) /= ' '  .AND.  i <= 10 )
-
-             IF ( INDEX( spectra_direction(i), 'x' ) /= 0 )  THEN
-                netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
-                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
-             ENDIF
-
-             IF ( INDEX( spectra_direction(i), 'y' ) /= 0 )  THEN
-                netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
-                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
-             ENDIF
-
-             i = i + 1
-
-          ENDDO
-
-          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
-             message_string = 'netCDF file for spectra  ' // 'from previous run found,' //         &
-                              '&but this file cannot be extended due to' //                        &
-                              ' variable mismatch.' // '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0260', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Determine the number of current vertical levels for which spectra shall be output.
-          ns = 1
-          DO  WHILE ( comp_spectra_level(ns) /= 999999  .AND.  ns <= 100 )
-             ns = ns + 1
-          ENDDO
-          ns = ns - 1
-
-!
-!--       Get and compare the number of vertical levels
-          nc_stat = NF90_INQ_VARID( id_set_sp, 'zu_sp', id_var_zu_sp )
-          CALL netcdf_handle_error( 'netcdf_define_header', 298 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_zu_sp, dimids = id_dim_zu_sp_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 299 )
-          id_dim_zu_sp = id_dim_zu_sp_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_zu_sp, LEN = ns_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 300 )
-
-          IF ( ns /= ns_old )  THEN
-             message_string = 'netCDF file for spectra ' // ' from previous run found,' //         &
-                              '&but this file cannot be extended due to' //                        &
-                              ' mismatch in number of' // ' vertical levels.' //                   &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0261', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get and compare the heights of the cross sections
-          ALLOCATE( netcdf_data(1:ns_old) )
-
-          nc_stat = NF90_GET_VAR( id_set_sp, id_var_zu_sp, netcdf_data )
-          CALL netcdf_handle_error( 'netcdf_define_header', 301 )
-
-          DO  i = 1, ns
-             IF ( zu(comp_spectra_level(i)) /= netcdf_data(i) )  THEN
-                message_string = 'netCDF file for spectra ' // ' from previous run found,' //      &
-                                 '&but this file cannot be extended due to' //                     &
-                                 ' mismatch in heights of' // ' vertical levels.' //               &
-                                 '&New file is created instead.'
-                CALL message( 'define_netcdf_header', 'PA0262', 0, 1, 0, 6, 0 )
-                extend = .FALSE.
-                RETURN
-             ENDIF
-          ENDDO
-
-          DEALLOCATE( netcdf_data )
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is plsp..count+1.
-!--       The current time must be larger than the last output time on the file.
-          nc_stat = NF90_INQ_VARID( id_set_sp, 'time', id_var_time_sp )
-          CALL netcdf_handle_error( 'netcdf_define_header', 302 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_time_sp, dimids = id_dim_time_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 303 )
-          id_dim_time_sp = id_dim_time_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_time_sp, LEN = dosp_time_count )
-          CALL netcdf_handle_error( 'netcdf_define_header', 304 )
-
-          nc_stat = NF90_GET_VAR( id_set_sp, id_var_time_sp,                                       &
-                                  last_time_coordinate,                                            &
-                                  start = (/ dosp_time_count /),                                   &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 305 )
-
-          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-             message_string = 'netCDF file for spectra ' // 'from previous run found,' //          &
-                              '&but this file cannot be extended because' //                       &
-                              ' the current output time' //                                        &
-                              '&is less or equal than the last output ' // 'time on this file.' // &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0263', 0, 1, 0, 6, 0 )
-             dosp_time_count = 0
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the variable ids.
-          i = 1
-          DO  WHILE ( data_output_sp(i) /= ' '  .AND.  i <= 10 )
-
-             IF ( INDEX( spectra_direction(i), 'x' ) /= 0 )  THEN
-                netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
-                nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, id_var_dospx(i) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 306 )
-             ENDIF
-
-             IF ( INDEX( spectra_direction(i), 'y' ) /= 0 )  THEN
-                netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
-                nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, id_var_dospy(i) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 307 )
-             ENDIF
-
-             i = i + 1
-
-          ENDDO
-
-!
-!--       Update the title attribute on file.
-!--       In order to avoid 'data mode' errors if updated attributes are larger than their original
-!--       size, NF90_PUT_ATT is called in 'define mode'enclosed by NF90_REDEF and NF90_ENDDEF
-!--       calls. This implies a possible performance loss due to data copying; an alternative
-!--       strategy would be to ensure equal attribute size in a job chain. Maybe revise later.
-          nc_stat = NF90_REDEF( id_set_sp )
-          CALL netcdf_handle_error( 'netcdf_define_header', 441 )
-          IF ( averaging_interval_sp /= 0.0_wp )  THEN
-             WRITE ( time_average_text, '('', '',F7.1,'' s average'')' ) averaging_interval_sp
-             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title',                              &
-                                     TRIM( run_description_header ) // TRIM( time_average_text ) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 308 )
-
-             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval_sp
-             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', TRIM( time_average_text ) )
-          ELSE
-             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title',                              &
-                                     TRIM( run_description_header ) )
-          ENDIF
-          CALL netcdf_handle_error( 'netcdf_define_header', 309 )
-          nc_stat = NF90_ENDDEF( id_set_sp )
-          CALL netcdf_handle_error( 'netcdf_define_header', 442 )
-          message_string = 'netCDF file for spectra ' // 'from previous run found.' //             &
-                           '&This file will be extended.'
-          CALL message( 'define_netcdf_header', 'PA0264', 0, 0, 0, 6, 0 )
-
-!
-!--     Currently disabled (DATA_PRT_NETCDF)
-!       CASE ( 'pt_new' )
-
-!
-!--       Define some global attributes of the dataset
-!          nc_stat = NF90_PUT_ATT( id_set_prt, NF90_GLOBAL, 'title', TRIM( run_description_header ) )
-!          CALL netcdf_handle_error( 'netcdf_define_header', 310 )
-
-!
-!--       Define time coordinate for particles (unlimited dimension)
-!          CALL netcdf_create_dim( id_set_prt, 'time', NF90_UNLIMITED, id_dim_time_prt, 311 )
-!          CALL netcdf_create_var( id_set_prt, (/ id_dim_time_prt /), 'time', NF90_DOUBLE,          &
-!                                  id_var_time_prt, 'seconds', '', 312, 313, 000 )
-!
-!--       netCDF4 allows more than one unlimited dimension
-!          CALL netcdf_create_dim( id_set_prt, 'particle_number', NF90_UNLIMITED, id_dim_prtnum,    &
-!                                  314 )
-
-!          CALL netcdf_create_var( id_set_prt, (/ id_dim_prtnum /), 'particle_number', NF90_DOUBLE, &
-!                                  id_var_prtnum, 'particle number', '', 315, 316, 000 )
-!
-!--       Define variable which contains the real number of particles in use
-!          CALL netcdf_create_var( id_set_prt, (/ id_dim_time_prt /), 'real_num_of_prt',            &
-!                                  NF90_DOUBLE, id_var_rnop_prt, 'particle number', '', 317, 318,   &
-!                                  000 )
-!
-!--       Define the variables
-!          DO  i = 1, 17
-
-!             CALL netcdf_create_var( id_set_prt, (/ id_dim_prtnum, id_dim_time_prt /),             &
-!                                     prt_var_names(i), nc_precision(8), id_var_prt(i),             &
-!                                     TRIM( prt_var_units(i) ), TRIM( prt_var_names(i) ), 319, 320, &
-!                                     321 )
-
-!          ENDDO
-
-!
-!--       Leave netCDF define mode
-!          nc_stat = NF90_ENDDEF( id_set_prt )
-!          CALL netcdf_handle_error( 'netcdf_define_header', 322 )
-
-!
-!--     Currently disabled (DATA_PRT_NETCDF)
-!       CASE ( 'pt_ext' )
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is prt..count+1.
-!--       The current time must be larger than the last output time on the file.
-!          nc_stat = NF90_INQ_VARID( id_set_prt, 'time', id_var_time_prt )
-!          CALL netcdf_handle_error( 'netcdf_define_header', 323 )
-
-!          nc_stat = NF90_INQUIRE_VARIABLE( id_set_prt, id_var_time_prt, dimids = id_dim_time_old )
-!          CALL netcdf_handle_error( 'netcdf_define_header', 324 )
-!          id_dim_time_prt = id_dim_time_old(1)
-
-!          nc_stat = NF90_INQUIRE_DIMENSION( id_set_prt, id_dim_time_prt, LEN = prt_time_count )
-!          CALL netcdf_handle_error( 'netcdf_define_header', 325 )
-
-!          nc_stat = NF90_GET_VAR( id_set_prt, id_var_time_prt,                                     &
-!                                  last_time_coordinate,                                            &
-!                                  start = (/ prt_time_count /),                                    &
-!                                  count = (/ 1 /) )
-!          CALL netcdf_handle_error( 'netcdf_define_header', 326 )
-
-!          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-!             message_string = 'netCDF file for particles ' // 'from previous run found,' //        &
-!                              '&but this file cannot be extended because' //                       &
-!                              ' the current output time' //                                        &
-!                              '&is less or equal than the last output ' // 'time on this file.' // &
-!                              '&New file is created instead.'
-!             CALL message( 'define_netcdf_header', 'PA0265', 0, 1, 0, 6, 0 )
-!             prt_time_count = 0
-!             extend = .FALSE.
-!             RETURN
-!          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the variable ids.
-!         nc_stat = NF90_INQ_VARID( id_set_prt, 'real_num_of_prt',id_var_rnop_prt )
-!         CALL netcdf_handle_error( 'netcdf_define_header', 327 )
-
-!          DO  i = 1, 17
-
-!             nc_stat = NF90_INQ_VARID( id_set_prt, prt_var_names(i), id_var_prt(i) )
-!             CALL netcdf_handle_error( 'netcdf_define_header', 328 )
-
-!          ENDDO
-
-!          message_string = 'netCDF file for particles ' // 'from previous run found.' //           &
-!                           '&This file will be extended.'
-!          CALL message( 'define_netcdf_header', 'PA0266', 0, 0, 0, 6, 0 )
-
-
-
-       CASE ( 'ps_new' )
-
-!
-!--       Define some global attributes of the dataset
-          nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', TRIM( run_description_header ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 396 )
-
-!
-!--       Define time coordinate for particle time series (unlimited dimension)
-          CALL netcdf_create_dim( id_set_pts, 'time', NF90_UNLIMITED, id_dim_time_pts, 397 )
-          CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /), 'time', NF90_DOUBLE,          &
-                                  id_var_time_pts, 'seconds', 'time', 398, 399, 000 )
-          CALL netcdf_create_att( id_set_pts, id_var_time_pts, 'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_pts, id_var_time_pts, 'axis', 'T', 000)
-!
-!--       Define the variables. If more than one particle group is defined, define seperate
-!--       variables for each group.
-          var_list = ';'
-          DO  i = 1, dopts_num
-
-             DO  j = 0, number_of_particle_groups
-
-                IF ( j == 0 )  THEN
-                   suffix = ''
-                ELSE
-                   WRITE ( suffix, '(''_'',I2.2)' )  j
-                ENDIF
-
-                IF ( j == 0 )  THEN
-                   CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /),                      &
-                                           TRIM( dopts_label(i) ) // suffix, nc_precision(6),      &
-                                           id_var_dopts(i,j), TRIM( dopts_unit(i) ),               &
-                                           TRIM( dopts_label(i) ), 400, 401, 402 )
-                ELSE
-                   CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /),                      &
-                                           TRIM( dopts_label(i) ) // suffix, nc_precision(6),      &
-                                           id_var_dopts(i,j), TRIM( dopts_unit(i) ),               &
-                                           TRIM( dopts_label(i) ) // ' PG ' // suffix(2:3),        &
-                                           400, 401, 402 )
-                ENDIF
-
-                var_list = TRIM( var_list ) // TRIM( dopts_label(i) ) // suffix // ';'
-
-                IF ( number_of_particle_groups == 1 )  EXIT
-
-             ENDDO
-
-          ENDDO
-
-!
-!--       Write the list of variables as global attribute (this is used by restart runs)
-          nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', var_list )
-          CALL netcdf_handle_error( 'netcdf_define_header', 403 )
-
-
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_pts )
-          CALL netcdf_handle_error( 'netcdf_define_header', 404 )
-
-
-       CASE ( 'ps_ext' )
-
-!
-!--       Get the list of variables and compare with the actual run.
-!--       First var_list_old has to be reset, since GET_ATT does not assign trailing blanks.
-          var_list_old = ' '
-          nc_stat = NF90_GET_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', var_list_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 405 )
-
-          var_list = ';'
-          i = 1
-          DO  i = 1, dopts_num
-
-             DO  j = 0, number_of_particle_groups
-
-                IF ( j == 0 )  THEN
-                   suffix = ''
-                ELSE
-                   WRITE ( suffix, '(''_'',I2.2)' )  j
-                ENDIF
-
-                var_list = TRIM( var_list ) // TRIM( dopts_label(i) ) // suffix // ';'
-
-                IF ( number_of_particle_groups == 1 )  EXIT
-
-             ENDDO
-
-          ENDDO
-
-          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
-             message_string = 'netCDF file for particle time series ' //                           &
-                              'from previous run found,' //                                        &
-                              '&but this file cannot be extended due to' //                        &
-                              ' variable mismatch.' // '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0267', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is dots..count+1.
-!--       The current time must be larger than the last output time on the file.
-          nc_stat = NF90_INQ_VARID( id_set_pts, 'time', id_var_time_pts )
-          CALL netcdf_handle_error( 'netcdf_define_header', 406 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_pts, id_var_time_pts, dimids = id_dim_time_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 407 )
-          id_dim_time_pts = id_dim_time_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_pts, id_dim_time_pts, LEN = dopts_time_count )
-          CALL netcdf_handle_error( 'netcdf_define_header', 408 )
-
-          nc_stat = NF90_GET_VAR( id_set_pts, id_var_time_pts,                                     &
-                                  last_time_coordinate,                                            &
-                                  start = (/ dopts_time_count /),                                  &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 409 )
-
-          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-             message_string = 'netCDF file for particle time series ' //                           &
-                              'from previous run found,' //                                        &
-                              '&but this file cannot be extended because' //                       &
-                              ' the current output time' //                                        &
-                              '&is less or equal than the last output ' // 'time on this file.' // &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0268', 0, 1, 0, 6, 0 )
-             dopts_time_count = 0
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the variable ids
-          i = 1
-          DO  i = 1, dopts_num
-
-             DO  j = 0, number_of_particle_groups
-
-                IF ( j == 0 )  THEN
-                   suffix = ''
-                ELSE
-                   WRITE ( suffix, '(''_'',I2.2)' )  j
-                ENDIF
-
-                netcdf_var_name = TRIM( dopts_label(i) ) // suffix
-
-                nc_stat = NF90_INQ_VARID( id_set_pts, netcdf_var_name, id_var_dopts(i,j) )
-                CALL netcdf_handle_error( 'netcdf_define_header', 410 )
-
-                IF ( number_of_particle_groups == 1 )  EXIT
-
-             ENDDO
-
-          ENDDO
-
-!
-!--       Update the title attribute on file.
-!--       In order to avoid 'data mode' errors if updated attributes are larger than their original
-!--       size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF
-!--       calls. This implies a possible performance loss due to data copying; an alternative
-!--       strategy would be to ensure equal attribute size in a job chain. Maybe revise later.
-          nc_stat = NF90_REDEF( id_set_pts )
-          CALL netcdf_handle_error( 'netcdf_define_header', 443 )
-          nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', TRIM( run_description_header ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 411 )
-          nc_stat = NF90_ENDDEF( id_set_pts )
-          CALL netcdf_handle_error( 'netcdf_define_header', 444 )
-          message_string = 'netCDF file for particle time series ' // 'from previous run found.' //&
-                           '&This file will be extended.'
-          CALL message( 'netcdf_define_header', 'PA0269', 0, 0, 0, 6, 0 )
-
-!
-!--    Flight data
-       CASE ( 'fl_new' )
-!
-!--       Define some global attributes of the dataset
-          nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'title', TRIM( run_description_header ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 249 )
-
-!
-!--       Define time and location coordinates for flight space-time series (unlimited dimension).
-!--       Error number must still be set appropriately.
-          CALL netcdf_create_dim( id_set_fl, 'time', NF90_UNLIMITED, id_dim_time_fl, 250 )
-          CALL netcdf_create_var( id_set_fl, (/ id_dim_time_fl /), 'time', NF90_DOUBLE,            &
-                                  id_var_time_fl, 'seconds', 'time', 251, 252, 000 )
-          CALL netcdf_create_att( id_set_fl, id_var_time_fl, 'standard_name', 'time', 000)
-          CALL netcdf_create_att( id_set_fl, id_var_time_fl, 'axis', 'T', 000)
-
-          DO l = 1, num_leg
-             CALL netcdf_create_dim( id_set_fl, dofl_dim_label_x(l), NF90_UNLIMITED,               &
-                                     id_dim_x_fl(l), 250 )
-             CALL netcdf_create_dim( id_set_fl, dofl_dim_label_y(l), NF90_UNLIMITED,               &
-                                     id_dim_y_fl(l), 250 )
-             CALL netcdf_create_dim( id_set_fl, dofl_dim_label_z(l), NF90_UNLIMITED,               &
-                                     id_dim_z_fl(l), 250 )
-
-             CALL netcdf_create_var( id_set_fl, (/ id_dim_x_fl(l) /), dofl_dim_label_x(l),         &
-                                     NF90_DOUBLE, id_var_x_fl(l), 'm', '', 251, 252, 000 )
-             CALL netcdf_create_var( id_set_fl, (/ id_dim_y_fl(l) /), dofl_dim_label_y(l),         &
-                                     NF90_DOUBLE, id_var_y_fl(l), 'm', '', 251, 252, 000 )
-             CALL netcdf_create_var( id_set_fl, (/ id_dim_z_fl(l) /), dofl_dim_label_z(l),         &
-                                     NF90_DOUBLE, id_var_z_fl(l), 'm', '', 251, 252, 000 )
-          ENDDO
-!
-!--       Define the variables
-          var_list = ';'
-          k = 1
-          DO  l = 1, num_leg
-             DO i = 1, num_var_fl
-
-                CALL netcdf_create_var( id_set_fl, (/ id_dim_time_fl /), dofl_label(k),            &
-                                        nc_precision(9), id_var_dofl(k), TRIM( dofl_unit(k) ),     &
-                                        TRIM( dofl_label(k) ), 253, 254, 255 )
-
-                k = k + 1
-
-             ENDDO
-
-          ENDDO
-
-!
-!--       Write the list of variables as global attribute (this is used by restart runs).
-          nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'VAR_LIST', var_list )
-          CALL netcdf_handle_error( 'netcdf_define_header', 258 )
-
-!
-!--       Leave netCDF define mode
-          nc_stat = NF90_ENDDEF( id_set_fl )
-          CALL netcdf_handle_error( 'netcdf_define_header', 259 )
-
-
-       CASE ( 'fl_ext' )
-
-!
-!--       Get the list of variables and compare with the actual run.
-!--       First var_list_old has to be reset, since GET_ATT does not assign trailing blanks.
-          var_list_old = ' '
-          nc_stat = NF90_GET_ATT( id_set_fl, NF90_GLOBAL, 'VAR_LIST', var_list_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 260 )
-
-          var_list = ';'
-          i = 1
-          DO  i = 1, num_leg * num_var_fl
-
-             var_list = TRIM( var_list ) // TRIM( dofl_label(i) ) // ';'
-
-          ENDDO
-
-          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
-             message_string = 'netCDF file for flight time series ' //                             &
-                              'from previous run found,' //                                        &
-                              '&but this file cannot be extended due to' //                        &
-                              ' variable mismatch.' // '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0257', 0, 1, 0, 6, 0 )
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Get the id of the time coordinate (unlimited coordinate) and its last index on the file.
-!--       The next time level is dofl_time_count+1.
-!--       The current time must be larger than the last output time on the file.
-          nc_stat = NF90_INQ_VARID( id_set_fl, 'time', id_var_time_fl )
-          CALL netcdf_handle_error( 'netcdf_define_header', 261 )
-
-          nc_stat = NF90_INQUIRE_VARIABLE( id_set_fl, id_var_time_fl, dimids = id_dim_time_old )
-          CALL netcdf_handle_error( 'netcdf_define_header', 262 )
-          id_dim_time_fl = id_dim_time_old(1)
-
-          nc_stat = NF90_INQUIRE_DIMENSION( id_set_fl, id_dim_time_fl, LEN = dofl_time_count )
-          CALL netcdf_handle_error( 'netcdf_define_header', 263 )
-
-          nc_stat = NF90_GET_VAR( id_set_fl, id_var_time_fl,                                       &
-                                  last_time_coordinate,                                            &
-                                  start = (/ dofl_time_count /),                                   &
-                                  count = (/ 1 /) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 264 )
-
-          IF ( last_time_coordinate(1) >= simulated_time )  THEN
-             message_string = 'netCDF file for flight-time series ' //                             &
-                              'from previous run found,' //                                        &
-                              '&but this file cannot be extended because' //                       &
-                              ' the current output time' //                                        &
-                              '&is less or equal than the last output ' // 'time on this file.' // &
-                              '&New file is created instead.'
-             CALL message( 'define_netcdf_header', 'PA0258', 0, 1, 0, 6, 0 )
-             dofl_time_count = 0
-             extend = .FALSE.
-             RETURN
-          ENDIF
-
-!
-!--       Dataset seems to be extendable.
-!--       Now get the remaining dimension and variable ids.
-          DO l = 1, num_leg
-             nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_x(l), id_var_x_fl(l) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 265 )
-             nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_y(l), id_var_y_fl(l) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 265 )
-             nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_z(l), id_var_z_fl(l) )
-             CALL netcdf_handle_error( 'netcdf_define_header', 265 )
-
-          ENDDO
-
-
-          DO  i = 1, num_leg * num_var_fl
-
-            nc_stat = NF90_INQ_VARID( id_set_fl, dofl_label(i), id_var_dofl(i) )
-            CALL netcdf_handle_error( 'netcdf_define_header', 265 )
-
-          ENDDO
-
-!
-!--       Update the title attribute on file.
-!--       In order to avoid 'data mode' errors if updated attributes are larger than their original
-!--       size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF
-!--       calls. This implies a possible performance loss due to data copying; an alternative
-!--       strategy would be to ensure equal attribute size in a job chain. Maybe revise later.
-          nc_stat = NF90_REDEF( id_set_fl )
-          CALL netcdf_handle_error( 'netcdf_define_header', 439 )
-          nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'title', TRIM( run_description_header ) )
-          CALL netcdf_handle_error( 'netcdf_define_header', 267 )
-          nc_stat = NF90_ENDDEF( id_set_fl )
-          CALL netcdf_handle_error( 'netcdf_define_header', 440 )
-          message_string = 'netCDF file for flight-time series ' // 'from previous run found.' //  &
-                           '&This file will be extended.'
-          CALL message( 'define_netcdf_header', 'PA0259', 0, 0, 0, 6, 0 )
-
-
-       CASE DEFAULT
-
-          message_string = 'mode "' // TRIM( mode) // '" not supported'
-          CALL message( 'netcdf_define_header', 'PA0270', 0, 0, 0, 6, 0 )
-
-    END SELECT
-
-#endif
- END SUBROUTINE netcdf_define_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Creates a netCDF file and give back the id. The parallel flag has to be TRUE for parallel netCDF
-!> output support.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_create_file( filename , id, parallel, errno )
-#if defined( __netcdf )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*), INTENT(IN) :: filename
-
-    INTEGER, INTENT(IN)           :: errno
-    INTEGER, INTENT(OUT)          :: id
-    INTEGER                       :: idum  !< dummy variable used to avoid compiler warnings about unused variables
-
-    LOGICAL, INTENT(IN)           :: parallel
-
-!
-!-- Next line is just to avoid compiler warning about unused variable
-    IF ( parallel )  idum = 0
-
-!
-!-- Create a new netCDF output file with requested netCDF format
-    IF ( netcdf_data_format == 1 )  THEN
-!
-!--    Classic netCDF format
-       nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id )
-
-    ELSEIF ( netcdf_data_format == 2 )  THEN
-!
-!--    64bit-offset format
-       nc_stat = NF90_CREATE( filename, IOR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ), id )
-
-#if defined( __netcdf4 )
-    ELSEIF ( netcdf_data_format == 3  .OR.  ( .NOT. parallel  .AND.  netcdf_data_format == 5 ) )   &
-    THEN
-!
-!--    netCDF4/HDF5 format
-       nc_stat = NF90_CREATE( filename, IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), id )
-
-    ELSEIF ( netcdf_data_format == 4  .OR.  ( .NOT. parallel  .AND.  netcdf_data_format == 6 ) )   &
-    THEN
-!
-!--    netCDF4/HDF5 format with classic model flag
-       nc_stat = NF90_CREATE( filename,                                                            &
-                              IOR( NF90_NOCLOBBER, IOR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ), id )
-
-#if defined( __netcdf4_parallel )
-    ELSEIF ( netcdf_data_format == 5  .AND.  parallel )  THEN
-!
-!--    netCDF4/HDF5 format, parallel
-       nc_stat = NF90_CREATE( filename, IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ),    &
-                              id, COMM = comm2d, INFO = MPI_INFO_NULL )
-
-    ELSEIF ( netcdf_data_format == 6  .AND.  parallel )  THEN
-!
-!--    netCDF4/HDF5 format with classic model flag, parallel
-       nc_stat = NF90_CREATE( filename,                                                            &
-                              IOR( NF90_NOCLOBBER,                                                 &
-                                   IOR( NF90_MPIIO, IOR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ) ),      &
-                              id, COMM = comm2d, INFO = MPI_INFO_NULL )
-
-#endif
-#endif
-    ENDIF
-
-    CALL netcdf_handle_error( 'netcdf_create_file', errno )
-#endif
- END SUBROUTINE netcdf_create_file
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Opens an existing netCDF file for writing and gives back the id.
-!> The parallel flag has to be TRUE for parallel netCDF output support.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_open_write_file( filename, id, parallel, errno )
-#if defined( __netcdf )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*), INTENT(IN) :: filename
-
-    INTEGER, INTENT(IN)           :: errno
-    INTEGER, INTENT(OUT)          :: id
-    LOGICAL, INTENT(IN)           :: parallel
-
-
-    IF ( netcdf_data_format < 5  .OR.  .NOT. parallel )  THEN
-       nc_stat = NF90_OPEN( filename, NF90_WRITE, id )
-#if defined( __netcdf4 )
-#if defined( __netcdf4_parallel )
-    ELSEIF ( netcdf_data_format > 4  .AND.  parallel )  THEN
-       nc_stat = NF90_OPEN( filename, IOR( NF90_WRITE, NF90_MPIIO ), id, COMM = comm2d,            &
-                            INFO = MPI_INFO_NULL )
-#endif
-#endif
-    ENDIF
-
-    CALL netcdf_handle_error( 'netcdf_open_write_file', errno )
-#endif
- END SUBROUTINE netcdf_open_write_file
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prints out a text message corresponding to the current status.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_handle_error( routine_name, errno )
-#if defined( __netcdf )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=6) ::  message_identifier
-    CHARACTER(LEN=*) ::  routine_name
-
-    INTEGER(iwp) ::  errno
-
-
-    IF ( nc_stat /= NF90_NOERR )  THEN
-
-       WRITE( message_identifier, '(''NC'',I4.4)' )  errno
-
-       message_string = TRIM( NF90_STRERROR( nc_stat ) )
-
-       CALL message( routine_name, message_identifier, 2, 2, 0, 6, 1 )
-
-    ENDIF
-
-#endif
- END SUBROUTINE netcdf_handle_error
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create a dimension in NetCDF file
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE netcdf_create_dim( ncid, dim_name, ncdim_type, ncdim_id, error_no )
-
-#if defined( __netcdf )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  dim_name
-
-    INTEGER, INTENT(IN)  ::  error_no
-    INTEGER, INTENT(IN)  ::  ncid
-    INTEGER, INTENT(OUT) ::  ncdim_id
-    INTEGER, INTENT(IN)  ::  ncdim_type
-
-!
-!-- Define time coordinate for volume data (unlimited dimension)
-    nc_stat = NF90_DEF_DIM( ncid, dim_name, ncdim_type, ncdim_id )
-    CALL netcdf_handle_error( 'netcdf_create_dim', error_no )
-
-#endif
-
- END SUBROUTINE netcdf_create_dim
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create a one dimensional variable in specific units in NetCDF file
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE netcdf_create_var( ncid, dim_id, var_name, var_type, var_id, unit_name, long_name,     &
-                               error_no1, error_no2, error_no3, fill )
-
-#if defined( __netcdf )
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  long_name
-    CHARACTER(LEN=*), INTENT(IN) ::  unit_name
-    CHARACTER(LEN=*), INTENT(IN) ::  var_name
-
-    INTEGER, INTENT(IN)  ::  error_no1
-    INTEGER, INTENT(IN)  ::  error_no2
-    INTEGER, INTENT(IN)  ::  error_no3
-    INTEGER, INTENT(IN)  ::  ncid
-    INTEGER, INTENT(OUT) ::  var_id
-    INTEGER, INTENT(IN)  ::  var_type
-
-    INTEGER, DIMENSION(:), INTENT(IN) ::  dim_id
-
-    LOGICAL, OPTIONAL ::  fill  !< indicates setting of _FillValue attribute
-
-
-!
-!-- Define variable
-    nc_stat = NF90_DEF_VAR( ncid, var_name, var_type, dim_id, var_id )
-    CALL netcdf_handle_error( 'netcdf_create_var', error_no1 )
-
-#if defined( __netcdf4 )
-!
-!-- Check if variable should be deflate (including shuffling) and if it is possible (only NetCDF4
-!-- with HDF5 supports compression).
-    IF ( netcdf_data_format > 2  .AND.  netcdf_deflate > 0 )  THEN
-       nc_stat = NF90_DEF_VAR_DEFLATE( ncid, var_id, 1, 1, netcdf_deflate )
-       CALL netcdf_handle_error( 'netcdf_create_var_deflate', error_no1 )
-    ENDIF
-#endif
-!
-!-- Set unit name if set
-    IF ( unit_name /= '' )  THEN
-       nc_stat = NF90_PUT_ATT( ncid, var_id, 'units', unit_name )
-       CALL netcdf_handle_error( 'netcdf_create_var', error_no2 )
-    ENDIF
-
-!
-!-- Set long name if set
-    IF ( long_name /= '' )  THEN
-       nc_stat = NF90_PUT_ATT( ncid, var_id, 'long_name', long_name )
-       CALL netcdf_handle_error( 'netcdf_create_var', error_no3 )
-    ENDIF
-
-!
-!-- Set _FillValue for all variables, except for dimension variables.
-!-- Set the fill values accordingly to the corresponding output precision.
-    IF ( PRESENT( fill ) )  THEN
-       IF ( var_type == NF90_REAL4 )  THEN
-          nc_stat = NF90_PUT_ATT( ncid, var_id, '_FillValue', REAL( fill_value, KIND = 4 ) )
-          CALL netcdf_handle_error( 'netcdf_create_var', 0 )
-       ELSE
-          nc_stat = NF90_PUT_ATT( ncid, var_id, '_FillValue', REAL( fill_value, KIND = 8 ) )
-          CALL netcdf_handle_error( 'netcdf_create_var', 0 )
-       ENDIF
-    ENDIF
-
-#endif
- END SUBROUTINE netcdf_create_var
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write attributes to file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_create_att_string( ncid, varid, name, value, err )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name    !< attribute name
-    CHARACTER(LEN=*), INTENT(IN) ::  value   !< attribute value
-
-    INTEGER, INTENT(IN) ::  err              !< error id
-    INTEGER, INTENT(IN) ::  ncid             !< file id
-
-    INTEGER, INTENT(IN), OPTIONAL ::  varid  !< variable id
-
-
-#if defined( __netcdf )
-    IF ( PRESENT( varid ) )  THEN
-       nc_stat = NF90_PUT_ATT( ncid, varid, TRIM( name ), TRIM( value ) )
-    ELSE
-       nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( name ), TRIM( value ) )
-    ENDIF
-    CALL netcdf_handle_error( 'netcdf_create_att_string', err )
-#endif
-
- END SUBROUTINE netcdf_create_att_string
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write a set of global attributes to file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_create_global_atts( ncid, data_content, title, error_no )
-
-    USE control_parameters,                                                                        &
-        ONLY:  revision, run_date, run_time, run_zone, runnr, version
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  input_file_atts
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  date_time_str_len, get_date_time
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=date_time_str_len) ::  origin_time_string  !< string containing date-time of origin
-
-    CHARACTER(LEN=*), INTENT(IN)  ::  data_content  !< describes the type of data in file
-    CHARACTER(LEN=*), INTENT(IN)  ::  title         !< file title
-
-    INTEGER, INTENT(IN)  ::  error_no  !< error number
-    INTEGER, INTENT(IN)  ::  ncid      !< file id
-
-!
-!-- Get date-time string for origin_time
-    CALL get_date_time( 0.0_wp, date_time_str=origin_time_string )
-
-#if defined( __netcdf )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'title', TRIM( title ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 1', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'Conventions', 'CF-1.7' )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 2', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'creation_time', TRIM( run_date ) // ' ' //         &
-                            TRIM( run_time ) // ' ' // run_zone(1:3) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 3', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'data_content', TRIM( data_content ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 4', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'version', runnr+1 )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 5', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_time', origin_time_string )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 6', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_lat', init_model%latitude )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 7', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_lon', init_model%longitude )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 8', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_x', init_model%origin_x )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 9', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_y', init_model%origin_y )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 10', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_z', init_model%origin_z )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 11', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'rotation_angle', rotation_angle )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 12', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'dependencies', '' )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 13', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'history', '' )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 14', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%author_char ),                &
-                            TRIM( input_file_atts%author ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 15', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%contact_person_char ),        &
-                            TRIM( input_file_atts%contact_person ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 16', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%institution_char ),           &
-                            TRIM( input_file_atts%institution ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 17', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%acronym_char ),               &
-                            TRIM( input_file_atts%acronym ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 18', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%campaign_char ),              &
-                            TRIM( input_file_atts%campaign ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 19', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%location_char ),              &
-                            TRIM( input_file_atts%location ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 20', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%site_char ),                  &
-                            TRIM( input_file_atts%site ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 21', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'source', TRIM( version ) // ' ' //                 &
-                            TRIM( revision ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 22', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%references_char ),            &
-                            TRIM( input_file_atts%references ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 23', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%keywords_char ),              &
-                            TRIM( input_file_atts%keywords ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 24', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%licence_char ),               &
-                            TRIM( input_file_atts%licence ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 25', error_no )
-    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%comment_char ),               &
-                            TRIM( input_file_atts%comment ) )
-    CALL netcdf_handle_error( 'netcdf_create_global_atts 26', error_no )
-
-#endif
-
- END SUBROUTINE netcdf_create_global_atts
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create a variable holding the coordinate-reference-system information.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE netcdf_create_crs( ncid, error_no )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN)  ::  error_no  !< error number
-    INTEGER, INTENT(IN)  ::  ncid      !< file id
-    INTEGER              ::  var_id    !< variable id
-
-#if defined( __netcdf )
-!
-!-- Define variable
-    nc_stat = NF90_DEF_VAR( ncid, 'crs', NF90_INT, VARID = var_id )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-!
-!-- Set attributes
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'epsg_code', coord_ref_sys%epsg_code )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'false_easting', coord_ref_sys%false_easting )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'false_northing', coord_ref_sys%false_northing )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'grid_mapping_name', coord_ref_sys%grid_mapping_name )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'inverse_flattening', coord_ref_sys%inverse_flattening )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'latitude_of_projection_origin',                         &
-                            coord_ref_sys%latitude_of_projection_origin )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'long_name', coord_ref_sys%long_name )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'longitude_of_central_meridian',                         &
-                            coord_ref_sys%longitude_of_central_meridian )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'longitude_of_prime_meridian',                           &
-                            coord_ref_sys%longitude_of_prime_meridian )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'scale_factor_at_central_meridian',                      &
-                            coord_ref_sys%scale_factor_at_central_meridian )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'semi_major_axis', coord_ref_sys%semi_major_axis )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-    nc_stat = NF90_PUT_ATT( ncid, var_id, 'units', coord_ref_sys%units )
-    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
-
-#endif
- END SUBROUTINE netcdf_create_crs
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define UTM coordinates and longitude and latitude in file.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE define_geo_coordinates( id_set, id_dim_x, id_dim_y, id_var_eutm, id_var_nutm,          &
-                                    id_var_lat, id_var_lon )
-
-    IMPLICIT NONE
-
-    INTEGER ::  i                    !< loop index
-    INTEGER, INTENT(IN)  ::  id_set  !< file id
-
-    INTEGER(iwp), DIMENSION(0:1), INTENT(IN) ::  id_dim_x  !< dimension id of x and xu
-    INTEGER(iwp), DIMENSION(0:1), INTENT(IN) ::  id_dim_y  !< dimension id of y and yv
-
-    INTEGER(iwp), DIMENSION(0:2), INTENT(OUT) ::  id_var_eutm  !< variable id for E_UTM coordinates
-    INTEGER(iwp), DIMENSION(0:2), INTENT(OUT) ::  id_var_lat   !< variable id for latitude coordinates
-    INTEGER(iwp), DIMENSION(0:2), INTENT(OUT) ::  id_var_lon   !< variable id for longitude coordinates
-    INTEGER(iwp), DIMENSION(0:2), INTENT(OUT) ::  id_var_nutm  !< variable id for N_UTM coordinates
-
-
-!
-!-- Initialize return values
-    id_var_lat  = -1
-    id_var_lon  = -1
-    id_var_eutm = -1
-    id_var_nutm = -1
-
-#if defined( __netcdf )
-!
-!-- Define UTM coordinates
-    IF ( rotation_angle == 0.0_wp )  THEN
-       CALL netcdf_create_var( id_set, (/ id_dim_x(0) /), 'E_UTM', NF90_DOUBLE, id_var_eutm(0),    &
-                               'm', 'easting', 000, 000, 000 )
-       CALL netcdf_create_var( id_set, (/ id_dim_y(0) /), 'N_UTM', NF90_DOUBLE, id_var_nutm(0),    &
-                               'm', 'northing', 000, 000, 000 )
-       CALL netcdf_create_var( id_set, (/ id_dim_x(1) /), 'Eu_UTM', NF90_DOUBLE, id_var_eutm(1),   &
-                               'm', 'easting', 000, 000, 000 )
-       CALL netcdf_create_var( id_set, (/ id_dim_y(0) /), 'Nu_UTM', NF90_DOUBLE, id_var_nutm(1),   &
-                               'm', 'northing', 000, 000, 000 )
-       CALL netcdf_create_var( id_set, (/ id_dim_x(0) /), 'Ev_UTM', NF90_DOUBLE, id_var_eutm(2),   &
-                               'm', 'easting', 000, 000, 000 )
-       CALL netcdf_create_var( id_set, (/ id_dim_y(1) /), 'Nv_UTM', NF90_DOUBLE, id_var_nutm(2),   &
-                               'm', 'northing', 000, 000, 000 )
-    ELSE
-       CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /),                             &
-                               'E_UTM', NF90_DOUBLE, id_var_eutm(0), 'm', 'easting',               &
-                               000, 000, 000 )
-       CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /),                             &
-                               'N_UTM', NF90_DOUBLE, id_var_nutm(0), 'm', 'northing',              &
-                               000, 000, 000 )
-       CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /),                             &
-                               'Eu_UTM', NF90_DOUBLE, id_var_eutm(1), 'm', 'easting',              &
-                               000, 000, 000 )
-       CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /),                             &
-                               'Nu_UTM', NF90_DOUBLE, id_var_nutm(1), 'm', 'northing',             &
-                               000, 000, 000 )
-       CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /),                             &
-                               'Ev_UTM', NF90_DOUBLE, id_var_eutm(2), 'm', 'easting',              &
-                               000, 000, 000 )
-       CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /),                             &
-                               'Nv_UTM', NF90_DOUBLE, id_var_nutm(2), 'm', 'northing',             &
-                               000, 000, 000 )
-    ENDIF
-!
-!-- Define geographic coordinates
-    CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), 'lon', NF90_DOUBLE,            &
-                            id_var_lon(0), 'degrees_east', 'longitude', 000, 000, 000 )
-    CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), 'lat', NF90_DOUBLE,            &
-                            id_var_lat(0), 'degrees_north', 'latitude', 000, 000, 000 )
-    CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), 'lonu', NF90_DOUBLE,           &
-                            id_var_lon(1), 'degrees_east', 'longitude', 000, 000, 000 )
-    CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), 'latu', NF90_DOUBLE,           &
-                            id_var_lat(1), 'degrees_north', 'latitude', 000, 000, 000 )
-    CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), 'lonv', NF90_DOUBLE,           &
-                            id_var_lon(2), 'degrees_east', 'longitude', 000, 000, 000 )
-    CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), 'latv', NF90_DOUBLE,           &
-                            id_var_lat(2), 'degrees_north', 'latitude', 000, 000, 000 )
-
-    DO  i = 0, 2
-       CALL netcdf_create_att( id_set, id_var_eutm(i), 'standard_name', 'projection_x_coordinate', &
-                               000 )
-       CALL netcdf_create_att( id_set, id_var_nutm(i), 'standard_name', 'projection_y_coordinate', &
-                               000 )
-
-       CALL netcdf_create_att( id_set, id_var_lat(i), 'standard_name', 'latitude', 000 )
-       CALL netcdf_create_att( id_set, id_var_lon(i), 'standard_name', 'longitude', 000 )
-    ENDDO
-
-#endif
- END SUBROUTINE define_geo_coordinates
-
-
- END MODULE netcdf_interface
Index: palm/trunk/SOURCE/ocean_mod.f90
===================================================================
--- palm/trunk/SOURCE/ocean_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2640 +1,0 @@
-!> @file ocean_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2017-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! file re-formatted to follow the PALM coding standard
-!
-! 4768 2020-11-02 19:11:23Z suehring
-! Enable 3D data output also with 64-bit precision
-!
-! 4731 2020-10-07 13:25:11Z schwenkel
-! Move exchange_horiz from time_integration to modules
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO for reading local arrays
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! vector directives added to force vectorization on Intel19 compiler
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4272 2019-10-23 15:18:57Z schwenkel
-! Further modularization of boundary conditions: moved boundary conditions to respective modules
-!
-! 4196 2019-08-29 11:02:06Z gronemeier
-! Consider rotation of model domain for calculating the Stokes drift
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4110 2019-07-22 17:05:21Z suehring
-! Pass integer flag array as well as boundary flags to WS scalar advection routine
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! implemented ocean_actions
-!
-! 3767 2019-02-27 08:18:02Z raasch
-! unused variable for file index and tmp_2d removed from rrd-subroutine parameter list
-!
-! 3719 2019-02-06 13:10:18Z kanani
-! Changed log_point to log_point_s, otherwise this overlaps with 'all progn.equations'
-! cpu measurement.
-!
-! 3684 2019-01-20 20:20:58Z knoop
-! nopointer option removed
-!
-! 3294 2018-10-01 02:37:10Z raasch
-! initial revision
-!
-!
-! Authors:
-! --------
-! @author Siegfried Raasch
-!
-! Description:
-! ------------
-!> This module contains relevant code for PALM's ocean mode, e.g. the prognostic equation for
-!> salinity, the equation of state for seawater, the Craik Leibovich force (Stokes force), and wave
-!> breaking effects
-!--------------------------------------------------------------------------------------------------!
- MODULE ocean_mod
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  diss_l_sa, diss_s_sa, flux_l_sa, flux_s_sa, prho, prho_1, rho_1, rho_ocean, sa,     &
-               sa_1, sa_2, sa_3, sa_init, sa_p, tsa_m
-
-    USE control_parameters,                                                                        &
-        ONLY:  atmos_ocean_sign, bottom_salinityflux, constant_top_salinityflux, loop_optimization,&
-               ocean_mode, restart_data_format_output, top_salinityflux, wall_salinityflux,        &
-               ws_scheme_sca
-
-    USE kinds
-
-    USE pegrid,                                                                                    &
-        ONLY:  threads_per_task
-
-    USE statistics,                                                                                &
-        ONLY:  sums_wssas_ws_l
-
-    USE indices,                                                                                   &
-        ONLY:  advc_flags_s, nbgp, nxl, nxr, nyn, nys, nzb, nzt, wall_flags_total_0
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_check_array, rrd_mpi_io, rrd_mpi_io_global_array, wrd_mpi_io,             &
-               wrd_mpi_io_global_array
-
-    USE surface_mod,                                                                               &
-        ONLY:  bc_h, surf_def_v, surf_def_h, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
-
-       USE exchange_horiz_mod,                                                                     &
-           ONLY:  exchange_horiz
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=20) ::  bc_sa_t = 'neumann'  !< namelist parameter
-
-    INTEGER(iwp) ::  ibc_sa_t                                    !< integer flag for bc_sa_t
-    INTEGER(iwp) ::  iran_ocean = -1234567                       !< random number used for wave breaking effects
-    INTEGER(iwp) ::  sa_vertical_gradient_level_ind(10) = -9999  !< grid index values of sa_vertical_gradient_level(s)
-
-    LOGICAL ::  salinity = .TRUE.             !< switch for using salinity
-    LOGICAL ::  stokes_force = .FALSE.        !< switch to switch on the Stokes force
-    LOGICAL ::  surface_cooling_switched_off = .FALSE.  !< variable to check if surface heat flux has been switched off
-    LOGICAL ::  wave_breaking = .FALSE.       !< switch to switch on wave breaking effects
-
-    REAL(wp) ::  alpha_wave_breaking = 3.0_wp !< coefficient for wave breaking generated turbulence from Noh et al. (2004), JPO
-    REAL(wp) ::  prho_reference               !< reference state of potential density at ocean surface
-    REAL(wp) ::  sa_surface = 35.0_wp         !< surface salinity, namelist parameter
-    REAL(wp) ::  sa_vertical_gradient(10) = 0.0_wp               !< namelist parameter
-    REAL(wp) ::  sa_vertical_gradient_level(10) = -999999.9_wp   !< namelist parameter
-    REAL(wp) ::  stokes_waveheight = 0.0_wp  !< wave height assumed for Stokes drift velocity
-    REAL(wp) ::  stokes_wavelength = 0.0_wp  !< wavelength assumed for Stokes drift velocity
-    REAL(wp) ::  surface_cooling_spinup_time = 999999.9_wp  !< time after which surface heat flux is switched off
-    REAL(wp) ::  timescale_wave_breaking     !< time scale of random forcing
-    REAL(wp) ::  u_star_wave_breaking        !< to store the absolute value of friction velocity at the ocean surface
-
-    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 /)
-                                               !< constants used in equation of state for seawater
-
-    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 /)
-                                              !< constants used in equation of state for seawater
-
-    SAVE
-
-    PUBLIC ::  bc_sa_t, ibc_sa_t, prho_reference, sa_surface, sa_vertical_gradient,                &
-               sa_vertical_gradient_level, sa_vertical_gradient_level_ind, stokes_force,           &
-               wave_breaking
-
-
-    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
-
-    INTERFACE ocean_check_parameters
-       MODULE PROCEDURE ocean_check_parameters
-    END INTERFACE ocean_check_parameters
-
-    INTERFACE ocean_check_data_output
-       MODULE PROCEDURE ocean_check_data_output
-    END INTERFACE ocean_check_data_output
-
-    INTERFACE ocean_check_data_output_pr
-       MODULE PROCEDURE ocean_check_data_output_pr
-    END INTERFACE ocean_check_data_output_pr
-
-    INTERFACE ocean_define_netcdf_grid
-       MODULE PROCEDURE ocean_define_netcdf_grid
-    END INTERFACE ocean_define_netcdf_grid
-
-    INTERFACE ocean_data_output_2d
-       MODULE PROCEDURE ocean_data_output_2d
-    END INTERFACE ocean_data_output_2d
-
-    INTERFACE ocean_data_output_3d
-       MODULE PROCEDURE ocean_data_output_3d
-    END INTERFACE ocean_data_output_3d
-
-    INTERFACE ocean_exchange_horiz
-       MODULE PROCEDURE ocean_exchange_horiz
-    END INTERFACE ocean_exchange_horiz
-
-    INTERFACE ocean_header
-       MODULE PROCEDURE ocean_header
-    END INTERFACE ocean_header
-
-    INTERFACE ocean_init
-       MODULE PROCEDURE ocean_init
-    END INTERFACE ocean_init
-
-    INTERFACE ocean_init_arrays
-       MODULE PROCEDURE ocean_init_arrays
-    END INTERFACE ocean_init_arrays
-
-    INTERFACE ocean_parin
-       MODULE PROCEDURE ocean_parin
-    END INTERFACE ocean_parin
-
-    INTERFACE ocean_actions
-       MODULE PROCEDURE ocean_actions
-       MODULE PROCEDURE ocean_actions_ij
-    END INTERFACE ocean_actions
-
-    INTERFACE ocean_prognostic_equations
-       MODULE PROCEDURE ocean_prognostic_equations
-       MODULE PROCEDURE ocean_prognostic_equations_ij
-    END INTERFACE ocean_prognostic_equations
-
-    INTERFACE ocean_boundary_conditions
-       MODULE PROCEDURE ocean_boundary_conditions
-    END INTERFACE ocean_boundary_conditions
-
-    INTERFACE ocean_swap_timelevel
-       MODULE PROCEDURE ocean_swap_timelevel
-    END INTERFACE ocean_swap_timelevel
-
-    INTERFACE ocean_rrd_global
-       MODULE PROCEDURE ocean_rrd_global_ftn
-       MODULE PROCEDURE ocean_rrd_global_mpi
-    END INTERFACE ocean_rrd_global
-
-    INTERFACE ocean_rrd_local
-       MODULE PROCEDURE ocean_rrd_local_ftn
-       MODULE PROCEDURE ocean_rrd_local_mpi
-    END INTERFACE ocean_rrd_local
-
-    INTERFACE ocean_wrd_global
-       MODULE PROCEDURE ocean_wrd_global
-    END INTERFACE ocean_wrd_global
-
-    INTERFACE ocean_wrd_local
-       MODULE PROCEDURE ocean_wrd_local
-    END INTERFACE ocean_wrd_local
-
-    INTERFACE ocean_3d_data_averaging
-       MODULE PROCEDURE ocean_3d_data_averaging
-    END INTERFACE ocean_3d_data_averaging
-
-    INTERFACE stokes_drift_terms
-       MODULE PROCEDURE stokes_drift_terms
-       MODULE PROCEDURE stokes_drift_terms_ij
-    END INTERFACE stokes_drift_terms
-
-    INTERFACE wave_breaking_term
-       MODULE PROCEDURE wave_breaking_term
-       MODULE PROCEDURE wave_breaking_term_ij
-    END INTERFACE wave_breaking_term
-
-    PRIVATE
-!
-!-- Add INTERFACES that must be available to other modules (alphabetical order)
-    PUBLIC eqn_state_seawater, ocean_actions, ocean_check_data_output, ocean_check_data_output_pr, &
-           ocean_check_parameters, ocean_data_output_2d, ocean_data_output_3d,                     &
-           ocean_exchange_horiz, ocean_define_netcdf_grid, ocean_header, ocean_init,               &
-           ocean_init_arrays, ocean_parin, ocean_prognostic_equations, ocean_swap_timelevel,       &
-           ocean_rrd_global, ocean_rrd_local, ocean_wrd_global, ocean_wrd_local,                   &
-           ocean_3d_data_averaging, ocean_boundary_conditions, stokes_drift_terms,                 &
-           wave_breaking_term
-
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! 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.
-!> TODO: so far, routine is not adjusted to use topography
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE eqn_state_seawater
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  hyp, prho, pt_p, rho_ocean, sa_p
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !< running index x direction
-    INTEGER(iwp) ::  j       !< running index y direction
-    INTEGER(iwp) ::  k       !< running index z direction
-    INTEGER(iwp) ::  m       !< running index surface elements
-
-    REAL(wp) ::  pden   !< temporary scalar user for calculating density
-    REAL(wp) ::  pnom   !< temporary scalar user for calculating density
-    REAL(wp) ::  p1     !< temporary scalar user for calculating density
-    REAL(wp) ::  p2     !< temporary scalar user for calculating density
-    REAL(wp) ::  p3     !< temporary scalar user for calculating density
-    REAL(wp) ::  pt1    !< temporary scalar user for calculating density
-    REAL(wp) ::  pt2    !< temporary scalar user for calculating density
-    REAL(wp) ::  pt3    !< temporary scalar user for calculating density
-    REAL(wp) ::  pt4    !< temporary scalar user for calculating density
-    REAL(wp) ::  sa1    !< temporary scalar user for calculating density
-    REAL(wp) ::  sa15   !< temporary scalar user for calculating density
-    REAL(wp) ::  sa2    !< temporary scalar user for calculating density
-
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+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_ocean(k,j,i) = pnom / pden
-
-          ENDDO
-
-!
-!--       Neumann conditions are assumed at top boundary and currently also at bottom boundary
-!--       (see comment lines below)
-          prho(nzt+1,j,i)      = prho(nzt,j,i)
-          rho_ocean(nzt+1,j,i) = rho_ocean(nzt,j,i)
-
-       ENDDO
-    ENDDO
-!
-!-- Neumann conditions at up/downward-facing surfaces
-    !$OMP PARALLEL DO PRIVATE( i, j, k )
-    DO  m = 1, bc_h(0)%ns
-       i = bc_h(0)%i(m)
-       j = bc_h(0)%j(m)
-       k = bc_h(0)%k(m)
-       prho(k-1,j,i)      = prho(k,j,i)
-       rho_ocean(k-1,j,i) = rho_ocean(k,j,i)
-    ENDDO
-!
-!-- Downward facing surfaces
-    !$OMP PARALLEL DO PRIVATE( i, j, k )
-    DO  m = 1, bc_h(1)%ns
-       i = bc_h(1)%i(m)
-       j = bc_h(1)%j(m)
-       k = bc_h(1)%k(m)
-       prho(k+1,j,i)      = prho(k,j,i)
-       rho_ocean(k+1,j,i) = rho_ocean(k,j,i)
-    ENDDO
-
- END SUBROUTINE eqn_state_seawater
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Same as above, but for grid point i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE eqn_state_seawater_ij( i, j )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  hyp, prho, pt_p, rho_ocean, sa_p
-
-    USE indices,                                                                                   &
-        ONLY:  nzb, nzt
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !< running index x direction
-    INTEGER(iwp) ::  j       !< running index y direction
-    INTEGER(iwp) ::  k       !< running index z direction
-    INTEGER(iwp) ::  m       !< running index surface elements
-    INTEGER(iwp) ::  surf_e  !< end index of surface elements at (j,i)-gridpoint
-    INTEGER(iwp) ::  surf_s  !< start index of surface elements at (j,i)-gridpoint
-
-    REAL(wp) ::  pden   !< temporary scalar user for calculating density
-    REAL(wp) ::  pnom   !< temporary scalar user for calculating density
-    REAL(wp) ::  p1     !< temporary scalar user for calculating density
-    REAL(wp) ::  p2     !< temporary scalar user for calculating density
-    REAL(wp) ::  p3     !< temporary scalar user for calculating density
-    REAL(wp) ::  pt1    !< temporary scalar user for calculating density
-    REAL(wp) ::  pt2    !< temporary scalar user for calculating density
-    REAL(wp) ::  pt3    !< temporary scalar user for calculating density
-    REAL(wp) ::  pt4    !< temporary scalar user for calculating density
-    REAL(wp) ::  sa1    !< temporary scalar user for calculating density
-    REAL(wp) ::  sa15   !< temporary scalar user for calculating density
-    REAL(wp) ::  sa2    !< temporary scalar user for calculating density
-
-
-    DO  k = nzb+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_ocean(k,j,i) = pnom / pden
-
-    ENDDO
-!
-!-- Neumann conditions at up/downward-facing walls
-    surf_s = bc_h(0)%start_index(j,i)
-    surf_e = bc_h(0)%end_index(j,i)
-    DO  m = surf_s, surf_e
-       k = bc_h(0)%k(m)
-       prho(k-1,j,i)      = prho(k,j,i)
-       rho_ocean(k-1,j,i) = rho_ocean(k,j,i)
-    ENDDO
-!
-!-- Downward facing surfaces
-    surf_s = bc_h(1)%start_index(j,i)
-    surf_e = bc_h(1)%end_index(j,i)
-    DO  m = surf_s, surf_e
-       k = bc_h(1)%k(m)
-       prho(k+1,j,i)      = prho(k,j,i)
-       rho_ocean(k+1,j,i) = rho_ocean(k,j,i)
-    ENDDO
-!
-!-- Neumann condition are assumed at top boundary
-    prho(nzt+1,j,i)      = prho(nzt,j,i)
-    rho_ocean(nzt+1,j,i) = rho_ocean(nzt,j,i)
-
- END SUBROUTINE eqn_state_seawater_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Equation of state for seawater as a function
-!--------------------------------------------------------------------------------------------------!
- REAL(wp) FUNCTION eqn_state_seawater_func( p, pt, sa )
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  p      !< temporary scalar user for calculating density
-    REAL(wp) ::  p1     !< temporary scalar user for calculating density
-    REAL(wp) ::  p2     !< temporary scalar user for calculating density
-    REAL(wp) ::  p3     !< temporary scalar user for calculating density
-    REAL(wp) ::  pt     !< temporary scalar user for calculating density
-    REAL(wp) ::  pt1    !< temporary scalar user for calculating density
-    REAL(wp) ::  pt2    !< temporary scalar user for calculating density
-    REAL(wp) ::  pt3    !< temporary scalar user for calculating density
-    REAL(wp) ::  pt4    !< temporary scalar user for calculating density
-    REAL(wp) ::  sa     !< temporary scalar user for calculating density
-    REAL(wp) ::  sa15   !< temporary scalar user for calculating density
-    REAL(wp) ::  sa2    !< temporary scalar user for calculating density
-
-
-!
-!-- Pressure is needed in dbar
-    p1 = p  * 1.0E-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
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads the ocean parameters namelist
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_parin
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter
-                                 !< file
-
-    INTEGER(iwp)  ::  io_status  !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /ocean_parameters/  bc_sa_t,                                                          &
-                                 bottom_salinityflux,                                              &
-                                 salinity,                                                         &
-                                 sa_surface,                                                       &
-                                 sa_vertical_gradient,                                             &
-                                 sa_vertical_gradient_level,                                       &
-                                 stokes_waveheight,                                                &
-                                 stokes_wavelength,                                                &
-                                 surface_cooling_spinup_time,                                      &
-                                 switch_off_module,                                                &
-                                 top_salinityflux,                                                 &
-                                 wall_salinityflux,                                                &
-                                 wave_breaking
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist called
-!-- ocean_parameters.
-    REWIND( 11 )
-    READ( 11, ocean_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    ocean_parameters namelist was found and read correctly. Set switch that enables PALM's ocean
-!--    mode.
-       IF ( .NOT. switch_off_module )  ocean_mode = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    ocean_parameters namelist was found but contained errors. Print an error message including
-!--    the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'ocean_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE ocean_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for the ocean mode
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_check_parameters
-
-    USE control_parameters,                                                                        &
-        ONLY:  coupling_char, coupling_mode, initializing_actions, message_string, use_top_fluxes
-
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run
-
-    IMPLICIT NONE
-
-
-!
-!-- Check for invalid combinations
-    IF ( nested_run )  THEN
-       message_string = 'ocean mode not allowed for nesting'
-       CALL message( 'ocean_check_parameters', 'PA0510', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
-       message_string = 'ocean mode does not allow cyclic-fill initialization'
-       CALL message( 'ocean_check_parameters', 'PA0511', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check ocean setting
-    IF ( TRIM( coupling_mode ) == 'uncoupled'  .AND.  TRIM( coupling_char ) == '_O' .AND.          &
-         .NOT. ocean_mode )  THEN
-
-!
-!--    Check whether an (uncoupled) atmospheric run has been declared as an ocean run (this setting
-!--    is done via palmrun-option -y)
-       message_string = 'ocean mode does not allow coupling_char = "' // TRIM( coupling_char ) //  &
-                        '" set by palmrun-option "-y"'
-       CALL message( 'ocean_check_parameters', 'PA0317', 1, 2, 0, 6, 0 )
-
-    ENDIF
-
-!
-!-- Ocean version must use flux boundary conditions at the top
-    IF ( .NOT. use_top_fluxes )  THEN
-       message_string = 'use_top_fluxes must be .TRUE. in ocean mode'
-       CALL message( 'ocean_check_parameters', 'PA0042', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Boundary conditions for salinity
-    IF ( bc_sa_t == 'dirichlet' )  THEN
-       ibc_sa_t = 0
-    ELSEIF ( bc_sa_t == 'neumann' )  THEN
-       ibc_sa_t = 1
-    ELSE
-       message_string = 'unknown boundary condition: bc_sa_t = "' // TRIM( bc_sa_t ) // '"'
-       CALL message( 'ocean_check_parameters', 'PA0068', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( top_salinityflux == 9999999.9_wp )  constant_top_salinityflux = .FALSE.
-
-    IF ( .NOT. salinity )  THEN
-       IF ( ( bottom_salinityflux /= 0.0_wp  .AND.  bottom_salinityflux /= 9999999.9_wp )  .OR.    &
-            ( top_salinityflux /= 0.0_wp     .AND.  top_salinityflux /= 9999999.9_wp    ) )        &
-       THEN
-          message_string = 'salinityflux must not be set for ocean run ' // 'without salinity'
-          CALL message( 'ocean_check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    IF ( ibc_sa_t == 1  .AND.  top_salinityflux == 9999999.9_wp )  THEN
-       message_string = 'boundary condition: bc_sa_t = "' // TRIM( bc_sa_t ) //                    &
-                        '" requires to set top_salinityflux'
-       CALL message( 'ocean_check_parameters', 'PA0069', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- A fixed salinity at the top implies Dirichlet boundary condition for salinity. In this case
-!-- specification of a constant salinity flux is forbidden.
-    IF ( ibc_sa_t == 0  .AND.  constant_top_salinityflux  .AND.  top_salinityflux /= 0.0_wp )  THEN
-       message_string = 'boundary condition: bc_sa_t = "' // TRIM( bc_sa_t ) //                    &
-                        '" is not allowed with top_salinityflux /= 0.0'
-       CALL message( 'ocean_check_parameters', 'PA0070', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Check if Stokes force is to be used
-    IF ( stokes_waveheight /= 0.0_wp  .AND.  stokes_wavelength /= 0.0_wp )  THEN
-       stokes_force = .TRUE.
-    ELSE
-       IF ( ( stokes_waveheight <= 0.0_wp .AND. stokes_wavelength >  0.0_wp )  .OR.                &
-            ( stokes_waveheight >  0.0_wp .AND. stokes_wavelength <= 0.0_wp )  .OR.                &
-            ( stokes_waveheight <  0.0_wp .AND. stokes_wavelength <  0.0_wp ) )                    &
-       THEN
-          message_string = 'wrong settings for stokes_wavelength and/or stokes_waveheight'
-          CALL message( 'ocean_check_parameters', 'PA0460', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
- END SUBROUTINE ocean_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_check_data_output( var, unit )
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  unit     !< unit of output variable
-    CHARACTER (LEN=*) ::  var      !< name of output variable
-
-
-    SELECT CASE ( TRIM( var ) )
-
-       CASE ( 'rho_sea_water' )
-          unit = 'kg/m3'
-
-       CASE ( 'sa' )
-          unit = 'psu'
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
- END SUBROUTINE ocean_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output of profiles
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zu, zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  data_output_pr
-
-    USE indices
-
-    USE profil_parameter
-
-    USE statistics
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
-    CHARACTER (LEN=*) ::  unit      !<
-    CHARACTER (LEN=*) ::  variable  !<
-
-    INTEGER(iwp) ::  var_count     !<
-
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'prho' )
-          dopr_index(var_count) = 71
-          dopr_unit             = 'kg/m3'
-          hom(:,2,71,:) = SPREAD( zu, 2, statistic_regions+1 )
-          unit = dopr_unit
-
-       CASE ( 'rho_sea_water' )
-          dopr_index(var_count) = 64
-          dopr_unit             = 'kg/m3'
-          hom(:,2,64,:) = SPREAD( zu, 2, statistic_regions+1 )
-          IF ( data_output_pr(var_count)(1:1) == '#' )  THEN
-             dopr_initial_index(var_count) = 77
-             hom(:,2,77,:)             = SPREAD( zu, 2, statistic_regions+1 )
-             hom(nzb,2,77,:)           = 0.0_wp    ! because zu(nzb) is negative
-             data_output_pr(var_count) = data_output_pr(var_count)(2:)
-          ENDIF
-          unit = dopr_unit
-
-       CASE ( 'sa', '#sa' )
-          dopr_index(var_count) = 23
-          dopr_unit             = 'psu'
-          hom(:,2,23,:) = SPREAD( zu, 2, statistic_regions+1 )
-          IF ( data_output_pr(var_count)(1:1) == '#' )  THEN
-             dopr_initial_index(var_count) = 26
-             hom(:,2,26,:)             = SPREAD( zu, 2, statistic_regions+1 )
-             hom(nzb,2,26,:)           = 0.0_wp    ! because zu(nzb) is negative
-             data_output_pr(var_count) = data_output_pr(var_count)(2:)
-          ENDIF
-          unit = dopr_unit
-
-       CASE ( 'w"sa"' )
-          dopr_index(var_count) = 65
-          dopr_unit             = 'psu m/s'
-          hom(:,2,65,:) = SPREAD( zw, 2, statistic_regions+1 )
-          unit = dopr_unit
-
-       CASE ( 'w*sa*' )
-          dopr_index(var_count) = 66
-          dopr_unit             = 'psu m/s'
-          hom(:,2,66,:) = SPREAD( zw, 2, statistic_regions+1 )
-          unit = dopr_unit
-
-       CASE ( 'wsa' )
-          dopr_index(var_count) = 67
-          dopr_unit             = 'psu m/s'
-          hom(:,2,67,:) = SPREAD( zw, 2, statistic_regions+1 )
-          unit = dopr_unit
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE ocean_check_data_output_pr
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define appropriate grid for netcdf variables.
-!> It is called out from subroutine netcdf.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_x   !< x grid of output variable
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y   !< y grid of output variable
-    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z   !< z grid of output variable
-    CHARACTER (LEN=*), INTENT(IN)  ::  var      !< name of output variable
-
-    LOGICAL, INTENT(OUT) ::  found   !< flag if output variable is found
-
-
-    found  = .TRUE.
-
-!
-!-- Check for the grid
-    SELECT CASE ( TRIM( var ) )
-
-       CASE ( 'rho_sea_water', 'rho_sea_water_xy', 'rho_sea_water_xz', 'rho_sea_water_yz', 'sa',   &
-              'sa_xy', 'sa_xz', 'sa_yz' )
-          grid_x = 'x'
-          grid_y = 'y'
-          grid_z = 'zu'
-
-       CASE DEFAULT
-          found  = .FALSE.
-          grid_x = 'none'
-          grid_y = 'none'
-          grid_z = 'none'
-
-    END SELECT
-
- END SUBROUTINE ocean_define_netcdf_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Average 3D data.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_3d_data_averaging( mode, variable )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  rho_ocean, sa
-
-    USE averaging,                                                                                 &
-        ONLY:  rho_ocean_av, sa_av
-
-    USE control_parameters,                                                                        &
-        ONLY:  average_count_3d
-
-    USE indices,                                                                                   &
-        ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  mode       !< flag defining mode 'allocate', 'sum' or 'average'
-    CHARACTER (LEN=*) ::  variable   !< name of variable
-
-    INTEGER(iwp) ::  i   !< loop index
-    INTEGER(iwp) ::  j   !< loop index
-    INTEGER(iwp) ::  k   !< loop index
-
-
-    IF ( mode == 'allocate' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'rho_sea_water' )
-             IF ( .NOT. ALLOCATED( rho_ocean_av ) )  THEN
-                ALLOCATE( rho_ocean_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             rho_ocean_av = 0.0_wp
-
-          CASE ( 'sa' )
-             IF ( .NOT. ALLOCATED( sa_av ) )  THEN
-                ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             sa_av = 0.0_wp
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'sum' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'rho_sea_water' )
-             IF ( ALLOCATED( rho_ocean_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rho_ocean_av(k,j,i) = rho_ocean_av(k,j,i) + rho_ocean(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'sa' )
-             IF ( ALLOCATED( sa_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         sa_av(k,j,i) = sa_av(k,j,i) + sa(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'average' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'rho_sea_water' )
-             IF ( ALLOCATED( rho_ocean_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rho_ocean_av(k,j,i) = rho_ocean_av(k,j,i) /                               &
-                                               REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'sa' )
-             IF ( ALLOCATED( sa_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         sa_av(k,j,i) = sa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-       END SELECT
-
-    ENDIF
-
- END SUBROUTINE ocean_3d_data_averaging
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define 2D output variables.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_data_output_2d( av, variable, found, grid, mode, local_pf, nzb_do, nzt_do )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  rho_ocean, sa
-
-    USE averaging,                                                                                 &
-        ONLY:  rho_ocean_av, sa_av
-
-    USE indices,                                                                                   &
-        ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, wall_flags_total_0
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  grid       !< name of vertical grid
-    CHARACTER (LEN=*) ::  mode       !< either 'xy', 'xz' or 'yz'
-    CHARACTER (LEN=*) ::  variable   !< name of variable
-
-    INTEGER(iwp) ::  av        !< flag for (non-)average output
-    INTEGER(iwp) ::  flag_nr   !< number of masking flag
-    INTEGER(iwp) ::  i         !< loop index
-    INTEGER(iwp) ::  j         !< loop index
-    INTEGER(iwp) ::  k         !< loop index
-    INTEGER(iwp) ::  nzb_do    !< vertical output index (bottom)
-    INTEGER(iwp) ::  nzt_do    !< vertical output index (top)
-
-    LOGICAL ::  found   !< flag if output variable is found
-    LOGICAL ::  resorted  !< flag if output is already resorted
-
-    REAL(wp) ::  fill_value = -999.0_wp  !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !< local array to which output data is resorted to
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
-
-
-    found = .TRUE.
-    resorted = .FALSE.
-!
-!-- Set masking flag for topography for not resorted arrays
-    flag_nr = 0
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'rho_sea_water_xy', 'rho_sea_water_xz', 'rho_sea_water_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rho_ocean
-          ELSE
-             IF ( .NOT. ALLOCATED( rho_ocean_av ) )  THEN
-                ALLOCATE( rho_ocean_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                rho_ocean_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => rho_ocean_av
-          ENDIF
-
-       CASE ( 'sa_xy', 'sa_xz', 'sa_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => sa
-          ELSE
-             IF ( .NOT. ALLOCATED( sa_av ) )  THEN
-                ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                sa_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => sa_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE DEFAULT
-          found = .FALSE.
-          grid  = 'none'
-
-    END SELECT
-
-    IF ( found .AND. .NOT. resorted )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_do, nzt_do
-                local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, KIND = wp ),     &
-                                         BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
-             ENDDO
-          ENDDO
-       ENDDO
-       resorted = .TRUE.
-    ENDIF
-
- END SUBROUTINE ocean_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define 3D output variables.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  rho_ocean, sa
-
-    USE averaging,                                                                                 &
-        ONLY:  rho_ocean_av, sa_av
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, wall_flags_total_0
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  variable   !< name of variable
-
-    INTEGER(iwp) ::  av        !< flag for (non-)average output
-    INTEGER(iwp) ::  flag_nr   !< number of masking flag
-    INTEGER(iwp) ::  i         !< loop index
-    INTEGER(iwp) ::  j         !< loop index
-    INTEGER(iwp) ::  k         !< loop index
-    INTEGER(iwp) ::  nzb_do    !< lower limit of the data output (usually 0)
-    INTEGER(iwp) ::  nzt_do    !< vertical upper limit of the data output (usually nz_do3d)
-
-    LOGICAL ::  found     !< flag if output variable is found
-    LOGICAL ::  resorted  !< flag if output is already resorted
-
-    REAL(wp) ::  fill_value = -999.0_wp  !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf   !< local
-                                  !< array to which output data is resorted to
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
-
-
-    found = .TRUE.
-    resorted = .FALSE.
-!
-!-- Set masking flag for topography for not resorted arrays
-    flag_nr = 0
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'rho_sea_water' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rho_ocean
-          ELSE
-             IF ( .NOT. ALLOCATED( rho_ocean_av ) )  THEN
-                ALLOCATE( rho_ocean_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                rho_ocean_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => rho_ocean_av
-          ENDIF
-
-       CASE ( 'sa' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => sa
-          ELSE
-             IF ( .NOT. ALLOCATED( sa_av ) )  THEN
-                ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                sa_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => sa_av
-          ENDIF
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
-
-    IF ( found  .AND.  .NOT. resorted )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_do, nzt_do
-                local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, KIND = wp ),     &
-                                         BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
-             ENDDO
-          ENDDO
-       ENDDO
-       resorted = .TRUE.
-    ENDIF
-
- END SUBROUTINE ocean_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exchange ghostpoints
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE ocean_exchange_horiz( location )
-
-       CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-       SELECT CASE ( location )
-
-          CASE ( 'before_prognostic_equation' )
-
-          CASE ( 'after_prognostic_equation' )
-
-             CALL exchange_horiz( sa_p, nbgp )
-             CALL exchange_horiz( rho_ocean, nbgp )
-             CALL exchange_horiz( prho, nbgp )
-
-       END SELECT
-
-    END SUBROUTINE ocean_exchange_horiz
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for ocean parameters
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_header( io )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  io   !< Unit of the output file
-
-
-!
-!-- Write ocean header
-    WRITE( io, 1 )
-    IF ( stokes_force  )  WRITE( io, 2 )  stokes_waveheight, stokes_wavelength
-    IF ( wave_breaking )  THEN
-       WRITE( io, 3 )  alpha_wave_breaking, timescale_wave_breaking
-    ENDIF
-    IF ( .NOT. salinity )  WRITE( io, 4 )
-    IF ( surface_cooling_spinup_time /= 999999.9_wp )  THEN
-       WRITE( io, 5 )  surface_cooling_spinup_time
-    ENDIF
-
-1   FORMAT (//' Ocean settings:'/' ------------------------------------------'/)
-2   FORMAT ('    --> Craik-Leibovich vortex force and Stokes drift switched',' on'/                &
-            '        waveheight: ',F4.1,' m   wavelength: ',F6.1,' m')
-3   FORMAT ('    --> wave breaking generated turbulence switched on'/                              &
-            '        alpha:    ',F4.1/'        timescale:',F5.1,' s')
-4   FORMAT ('    --> prognostic salinity equation is switched off' )
-5   FORMAT ('    --> surface heat flux is switched off after ',F8.1,' s')
-
- END SUBROUTINE ocean_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate arrays and assign pointers.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_init_arrays
-
-    USE indices,                                                                                   &
-        ONLY:  nxlg, nxrg, nyn, nyng, nys, nysg, nzb, nzt
-
-    IMPLICIT NONE
-
-    ALLOCATE( prho_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                               &
-              rho_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                &
-              sa_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                                 &
-              sa_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-
-    IF (  salinity )  THEN
-       ALLOCATE( sa_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ENDIF
-
-    IF ( ws_scheme_sca )  THEN
-       ALLOCATE( sums_wssas_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-       sums_wssas_ws_l = 0.0_wp
-    ENDIF
-
-    IF ( loop_optimization /= 'vector' )  THEN
-
-       IF ( ws_scheme_sca )  THEN
-          ALLOCATE( flux_s_sa(nzb+1:nzt,0:threads_per_task-1) )
-          ALLOCATE( 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) )
-          ALLOCATE( diss_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-       ENDIF
-
-    ENDIF
-
-    prho => prho_1
-    rho_ocean  => rho_1  ! routines calc_mean_profile and diffusion_e require density to be a pointer
-
-!
-!-- Initial assignment of pointers
-    IF ( salinity )  THEN
-       sa => sa_1;  sa_p => sa_2;  tsa_m => sa_3
-    ELSE
-       sa => sa_1;  sa_p => sa_1;  tsa_m => sa_3
-    ENDIF
-
- END SUBROUTINE ocean_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of quantities needed for the ocean mode
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_init
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzu, dzw, hyp, pt_init, ref_state, u_stokes_zu, u_stokes_zw, v_stokes_zu,           &
-               v_stokes_zw, zu, zw
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  g
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  pi
-
-    USE control_parameters,                                                                        &
-        ONLY:  initializing_actions, molecular_viscosity, rho_surface, rho_reference,              &
-               surface_pressure, top_momentumflux_u, top_momentumflux_v, use_single_reference_value
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxlg, nxrg, nyng, nys, nysg, nzb, nzt
-
-    USE kinds
-
-    USE pegrid,                                                                                    &
-        ONLY:  myid
-
-    USE statistics,                                                                                &
-        ONLY:  hom, statistic_regions
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< loop index
-    INTEGER(iwp) ::  j  !< loop index
-    INTEGER(iwp) ::  k  !< loop index
-    INTEGER(iwp) ::  n  !< loop index
-
-    REAL(wp) ::  alpha               !< angle of surface stress
-    REAL(wp) ::  dum                 !< dummy argument
-    REAL(wp) ::  pt_l                !< local scalar for pt used in equation of state function
-    REAL(wp) ::  sa_l                !< local scalar for sa used in equation of state function
-    REAL(wp) ::  velocity_amplitude  !< local scalar for amplitude of Stokes drift velocity
-    REAL(wp) ::  x                   !< temporary variable to store surface stress along x
-    REAL(wp) ::  y                   !< temporary variable to store surface stress along y
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  rho_ocean_init  !< local array for initial density
-
-    ALLOCATE( hyp(nzb:nzt+1) )
-
-
-!
-!-- In case of no restart run, calculate the inital salinity profile using the given salinity
-!-- gradients.
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-
-       sa_init = sa_surface
-!
-!--    Last arguments gives back the gradient at top level to be used as possible Neumann boundary
-!--    condition. This is not realized for the ocean mode, therefore a dummy argument is used.
-       IF ( salinity )  THEN
-          CALL init_vertical_profiles( sa_vertical_gradient_level_ind,                             &
-                                       sa_vertical_gradient_level,                                 &
-                                       sa_vertical_gradient, sa_init,                              &
-                                       sa_surface, dum )
-       ENDIF
-    ENDIF
-
-!
-!-- Initialize required 3d-arrays
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.                                &
-         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
-!
-!--    Initialization via computed 1D-model profiles
-       IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
-
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                sa(:,j,i) = sa_init
-             ENDDO
-          ENDDO
-
-       ENDIF
-!
-!--    Store initial profiles for output purposes etc.
-!--    Store initial salinity profile
-       hom(:,1,26,:)  = SPREAD( sa(:,nys,nxl), 2, statistic_regions+1 )
-!
-!--    Initialize old and new time levels.
-       tsa_m = 0.0_wp
-       sa_p  = sa
-
-    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
-
-!
-!--    Initialize new time levels (only done in order to set boundary values including ghost points)
-       sa_p = sa
-!
-!--    Allthough tendency arrays are set in prognostic_equations, they have to be predefined here
-!--    because they are used (but multiplied with 0) there before they are set.
-       tsa_m = 0.0_wp
-
-    ENDIF
-
-!
-!-- Set water density near the ocean surface
-    rho_surface = 1027.62_wp
-
-!
-!-- Set kinematic viscosity to sea water at 20C.
-!-- This changes the default value that is given for air!
-    molecular_viscosity = 1.05E-6_wp
-
-!
-!-- Change sign of buoyancy/stability terms because density gradient is used instead of the
-!-- potential temperature gradient to calculate the buoyancy.
-    atmos_ocean_sign = -1.0_wp
-
-!
-!-- Calculate initial vertical profile of hydrostatic pressure (in Pa) and the reference density
-!-- (used later in buoyancy term).
-!-- First step: Calculate pressure using reference density.
-    hyp(nzt+1) = surface_pressure * 100.0_wp
-    hyp(nzt)   = hyp(nzt+1) + rho_surface * g * 0.5_wp * dzu(nzt+1)
-    rho_ocean_init(nzt)   = rho_surface
-    rho_ocean_init(nzt+1) = rho_surface  ! only required for output
-
-    DO  k = nzt-1, 1, -1
-       hyp(k) = hyp(k+1) + rho_surface * g * dzu(k)
-    ENDDO
-    hyp(0) = hyp(1) + rho_surface * g * dzu(1)
-
-!
-!-- Second step: Iteratively calculate in situ density (based on presssure) and pressure
-!-- (based on in situ density)
-    DO  n = 1, 5
-
-       rho_reference = rho_surface * 0.5_wp * dzu(nzt+1)
-
-       DO  k = nzt, 0, -1
-
-          sa_l = 0.5_wp * ( sa_init(k) + sa_init(k+1) )
-          pt_l = 0.5_wp * ( pt_init(k) + pt_init(k+1) )
-
-          rho_ocean_init(k) = eqn_state_seawater_func( hyp(k), pt_l, sa_l )
-
-          rho_reference = rho_reference + rho_ocean_init(k) * dzu(k+1)
-
-       ENDDO
-
-       rho_reference = rho_reference / ( zw(nzt) - zu(nzb) )
-
-       hyp(nzt) = hyp(nzt+1) + rho_surface * g * 0.5_wp * dzu(nzt+1)
-       DO  k = nzt-1, 0, -1
-          hyp(k) = hyp(k+1) + g * 0.5_wp * ( rho_ocean_init(k) + rho_ocean_init(k+1) ) * dzu(k+1)
-       ENDDO
-
-    ENDDO
-
-!
-!-- Calculate the reference potential density
-    prho_reference = 0.0_wp
-    DO  k = 0, nzt
-
-       sa_l = 0.5_wp * ( sa_init(k) + sa_init(k+1) )
-       pt_l = 0.5_wp * ( pt_init(k) + pt_init(k+1) )
-
-       prho_reference = prho_reference + dzu(k+1) * eqn_state_seawater_func( 0.0_wp, pt_l, sa_l )
-
-    ENDDO
-
-    prho_reference = prho_reference / ( zu(nzt) - zu(nzb) )
-
-!
-!-- Calculate the 3d array of initial in situ and potential density, based on the initial
-!-- temperature and salinity profile.
-    CALL eqn_state_seawater
-
-!
-!-- Store initial density profile
-    hom(:,1,77,:)  = SPREAD( rho_ocean_init(:), 2, statistic_regions+1 )
-
-!
-!-- Set the reference state to be used in the buoyancy terms
-    IF ( use_single_reference_value )  THEN
-       ref_state(:) = rho_reference
-    ELSE
-       ref_state(:) = rho_ocean_init(:)
-    ENDIF
-
-!
-!-- Calculate the Stokes drift velocity profile
-    IF ( stokes_force )  THEN
-
-!
-!--    First, calculate angle of surface stress
-       x = -top_momentumflux_u
-       y = -top_momentumflux_v
-       IF ( x == 0.0_wp )  THEN
-          IF ( y > 0.0_wp )  THEN
-             alpha = pi / 2.0_wp
-          ELSEIF ( y < 0.0_wp )  THEN
-             alpha = 3.0_wp * pi / 2.0_wp
-          ENDIF
-       ELSE
-          IF ( x < 0.0_wp )  THEN
-             alpha = ATAN( y / x ) + pi
-          ELSE
-             IF ( y < 0.0_wp )  THEN
-                alpha = ATAN( y / x ) + 2.0_wp * pi
-             ELSE
-                alpha = ATAN( y / x )
-             ENDIF
-          ENDIF
-       ENDIF
-
-       velocity_amplitude = ( pi * stokes_waveheight / stokes_wavelength )**2 *                    &
-                            SQRT( g * stokes_wavelength / ( 2.0_wp * pi ) )
-
-       DO  k = nzb, nzt
-          u_stokes_zu(k) = velocity_amplitude * COS( alpha ) *                                     &
-                           EXP( 4.0_wp * pi * zu(k) / stokes_wavelength )
-          u_stokes_zw(k) = velocity_amplitude * COS( alpha ) *                                     &
-                           EXP( 4.0_wp * pi * zw(k) / stokes_wavelength )
-          v_stokes_zu(k) = velocity_amplitude * SIN( alpha ) *                                     &
-                           EXP( 4.0_wp * pi * zu(k) / stokes_wavelength )
-          v_stokes_zw(k) = velocity_amplitude * SIN( alpha ) *                 &
-                           EXP( 4.0_wp * pi * zw(k) / stokes_wavelength )
-       ENDDO
-       u_stokes_zu(nzt+1) = u_stokes_zw(nzt) ! because zu(nzt+1) changes the sign
-       u_stokes_zw(nzt+1) = u_stokes_zw(nzt) ! because zw(nzt+1) changes the sign
-       v_stokes_zu(nzt+1) = v_stokes_zw(nzt) ! because zu(nzt+1) changes the sign
-       v_stokes_zw(nzt+1) = v_stokes_zw(nzt) ! because zw(nzt+1) changes the sign
-
-    ENDIF
-
-!
-!-- Wave breaking effects
-    IF ( wave_breaking )  THEN
-!
-!--    Calculate friction velocity at ocean surface
-       u_star_wave_breaking = SQRT( SQRT( top_momentumflux_u**2 + top_momentumflux_v**2 ) )
-!
-!--    Set the time scale of random forcing. The vertical grid spacing at the ocean surface is
-!--    assumed as the length scale of turbulence.
-!--    Formula follows Noh et al. (2004), JPO
-       timescale_wave_breaking = 0.1_wp * dzw(nzt) / alpha_wave_breaking / u_star_wave_breaking
-!
-!--    Set random number seeds differently on the processor cores in order to create different
-!--    random number sequences
-       iran_ocean = iran_ocean + myid
-    ENDIF
-
- END SUBROUTINE ocean_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_actions( location )
-
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-    SELECT CASE ( location )
-
-       CASE ( 'before_timestep' )
-
-          IF ( ws_scheme_sca )  THEN
-             sums_wssas_ws_l = 0.0_wp
-          ENDIF
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE ocean_actions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid points i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_actions_ij( i, j, location )
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location  !< call location string
-
-    INTEGER(iwp)             ::  dummy     !< call location string
-    INTEGER(iwp), INTENT(IN) ::  i         !< grid index in x-direction
-    INTEGER(iwp), INTENT(IN) ::  j         !< grid index in y-direction
-
-
-    IF ( ocean_mode )   dummy = i + j
-
-    SELECT CASE ( location )
-
-       CASE ( 'before_timestep' )
-
-          IF ( ws_scheme_sca )  THEN
-             sums_wssas_ws_l = 0.0_wp
-          ENDIF
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE ocean_actions_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prognostic equation for salinity.
-!> Vector-optimized version
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_prognostic_equations
-
-    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_ws,                                                                                  &
-        ONLY:  advec_s_ws
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  rdf_sc, tend, tsa_m
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               dt_3d,                                                                              &
-               intermediate_timestep_count,                                                        &
-               intermediate_timestep_count_max,                                                    &
-               scalar_advec,                                                                       &
-               simulated_time,                                                                     &
-               timestep_scheme,                                                                    &
-               tsc,                                                                                &
-               ws_scheme_sca
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point_s
-
-    USE diffusion_s_mod,                                                                           &
-        ONLY:  diffusion_s
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !< loop index
-    INTEGER(iwp) ::  j       !< loop index
-    INTEGER(iwp) ::  k       !< loop index
-
-    REAL(wp)     ::  sbt     !< weighting factor for sub-time step
-
-
-!
-!-- Switch of the surface heat flux, if requested
-    IF ( surface_cooling_spinup_time /= 999999.9_wp )  THEN
-       IF ( .NOT. surface_cooling_switched_off  .AND.                                              &
-            simulated_time >= surface_cooling_spinup_time )  THEN
-
-          surf_def_h(2)%shf = 0.0_wp
-          surface_cooling_switched_off = .TRUE.
-
-       ENDIF
-    ENDIF
-
-!
-!-- Compute prognostic equations for the ocean mode.
-!-- First, start with salinity.
-    IF ( salinity )  THEN
-
-       CALL cpu_log( log_point_s(20), '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( advc_flags_s, sa, 'sa',                                           &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( sa )
-             ENDIF
-          ELSE
-             CALL advec_s_up( sa )
-          ENDIF
-       ENDIF
-
-       CALL diffusion_s( sa,                                                                       &
-                         surf_def_h(0)%sasws, surf_def_h(1)%sasws,                                 &
-                         surf_def_h(2)%sasws,                                                      &
-                         surf_lsm_h(0)%sasws, surf_lsm_h(1)%sasws,                                 &
-                         surf_usm_h(0)%sasws, surf_usm_h(1)%sasws,                                 &
-                         surf_def_v(0)%sasws, surf_def_v(1)%sasws,                                 &
-                         surf_def_v(2)%sasws, surf_def_v(3)%sasws,                                 &
-                         surf_lsm_v(0)%sasws, surf_lsm_v(1)%sasws,                                 &
-                         surf_lsm_v(2)%sasws, surf_lsm_v(3)%sasws,                                 &
-                         surf_usm_v(0)%sasws, surf_usm_v(1)%sasws,                                 &
-                         surf_usm_v(2)%sasws, surf_usm_v(3)%sasws )
-
-!       CALL user_actions( 'sa-tendency' ) ToDo: find general solution for dependency between modules
-
-!
-!--    Prognostic equation for salinity
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             !following directive is required to vectorize on Intel19
-             !DIR$ IVDEP
-             DO  k = nzb+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) )      &
-                                          )                                                        &
-                                            * MERGE( 1.0_wp, 0.0_wp,                               &
-                                                     BTEST( wall_flags_total_0(k,j,i), 0 )         &
-                                                   )
-                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+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+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_s(20), 'sa-equation', 'stop' )
-
-    ENDIF
-
-!
-!-- Calculate density by the equation of state for seawater
-    CALL cpu_log( log_point_s(21), 'eqns-seawater', 'start' )
-    CALL eqn_state_seawater
-    CALL cpu_log( log_point_s(21), 'eqns-seawater', 'stop' )
-
- END SUBROUTINE ocean_prognostic_equations
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prognostic equations for ocean mode (so far, salinity only)
-!> Cache-optimized version
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_prognostic_equations_ij( i, j, i_omp_start, tn )
-
-    USE advec_s_pw_mod,                                                                            &
-        ONLY:  advec_s_pw
-
-    USE advec_s_up_mod,                                                                            &
-        ONLY:  advec_s_up
-
-    USE advec_ws,                                                                                  &
-        ONLY:  advec_s_ws
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  diss_l_sa, diss_s_sa, flux_l_sa, flux_s_sa, rdf_sc, tend, tsa_m
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               dt_3d,                                                                              &
-               intermediate_timestep_count,                                                        &
-               intermediate_timestep_count_max,                                                    &
-               simulated_time,                                                                     &
-               timestep_scheme,                                                                    &
-               tsc,                                                                                &
-               ws_scheme_sca
-
-    USE diffusion_s_mod,                                                                           &
-        ONLY:  diffusion_s
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i             !< loop index x direction
-    INTEGER(iwp) ::  i_omp_start   !< first loop index of i-loop in calling routine prognostic_equations
-    INTEGER(iwp) ::  j             !< loop index y direction
-    INTEGER(iwp) ::  k             !< loop index z direction
-    INTEGER(iwp) ::  tn            !< task number of openmp task
-
-
-!
-!-- Switch of the surface heat flux, if requested
-    IF ( surface_cooling_spinup_time /= 999999.9_wp )  THEN
-       IF ( .NOT. surface_cooling_switched_off  .AND.                                              &
-            simulated_time >= surface_cooling_spinup_time )  THEN
-
-          surf_def_h(2)%shf = 0.0_wp
-          surface_cooling_switched_off = .TRUE.
-
-       ENDIF
-    ENDIF
-
-!
-!-- Compute prognostic equations for the ocean mode.
-!-- First, start with tendency-terms for salinity.
-    IF ( salinity )  THEN
-
-       tend(:,j,i) = 0.0_wp
-       IF ( timestep_scheme(1:5) == 'runge' )  THEN
-          IF ( ws_scheme_sca )  THEN
-             CALL advec_s_ws( advc_flags_s,                                                        &
-                              i, j, sa, 'sa', flux_s_sa,  diss_s_sa, flux_l_sa, diss_l_sa,         &
-                              i_omp_start, tn,                                                     &
-                              bc_dirichlet_l  .OR.  bc_radiation_l,                                &
-                              bc_dirichlet_n  .OR.  bc_radiation_n,                                &
-                              bc_dirichlet_r  .OR.  bc_radiation_r,                                &
-                              bc_dirichlet_s  .OR.  bc_radiation_s )
-          ELSE
-             CALL advec_s_pw( i, j, sa )
-          ENDIF
-       ELSE
-          CALL advec_s_up( i, j, sa )
-       ENDIF
-       CALL diffusion_s( i, j, sa,                                                                 &
-                         surf_def_h(0)%sasws, surf_def_h(1)%sasws, surf_def_h(2)%sasws,            &
-                         surf_lsm_h(0)%sasws, surf_lsm_h(1)%sasws,                                 &
-                         surf_usm_h(0)%sasws, surf_usm_h(1)%sasws,                                 &
-                         surf_def_v(0)%sasws, surf_def_v(1)%sasws, surf_def_v(2)%sasws,            &
-                         surf_def_v(3)%sasws,             &
-                         surf_lsm_v(0)%sasws, surf_lsm_v(1)%sasws, surf_lsm_v(2)%sasws,            &
-                         surf_lsm_v(3)%sasws,             &
-                         surf_usm_v(0)%sasws, surf_usm_v(1)%sasws, surf_usm_v(2)%sasws,            &
-                         surf_usm_v(3)%sasws )
-
-!       CALL user_actions( i, j, 'sa-tendency' ) ToDo: find general solution for dependency between modules
-
-!
-!--    Prognostic equation for salinity
-       DO  k = nzb+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) )              &
-                                    ) * MERGE( 1.0_wp, 0.0_wp,                                     &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 )               &
-                                             )
-
-          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+1, nzt
-                tsa_m(k,j,i) = tend(k,j,i)
-             ENDDO
-          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-             DO  k = nzb+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
-
-    ENDIF
-
-!
-!-- Calculate density by the equation of state for seawater
-    CALL eqn_state_seawater( i, j )
-
- END SUBROUTINE ocean_prognostic_equations_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Boundary conditions for ocean model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_boundary_conditions
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                            !< grid index x direction.
-    INTEGER(iwp) ::  j                            !< grid index y direction.
-    INTEGER(iwp) ::  k                            !< grid index z direction.
-    INTEGER(iwp) ::  l                            !< running index boundary type, for up- and downward-facing walls.
-    INTEGER(iwp) ::  m                            !< running index surface elements.
-
-!
-!--    Boundary conditions for salinity.
-!--    Bottom boundary: Neumann condition because salinity flux is always given.
-       DO  l = 0, 1
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-          DO  m = 1, bc_h(l)%ns
-             i = bc_h(l)%i(m)
-             j = bc_h(l)%j(m)
-             k = bc_h(l)%k(m)
-             sa_p(k+bc_h(l)%koff,j,i) = sa_p(k,j,i)
-          ENDDO
-       ENDDO
-!
-!--    Top boundary: Dirichlet or Neumann
-       IF ( ibc_sa_t == 0 )  THEN
-           sa_p(nzt+1,:,:) = sa(nzt+1,:,:)
-       ELSEIF ( ibc_sa_t == 1 )  THEN
-           sa_p(nzt+1,:,:) = sa_p(nzt,:,:)
-       ENDIF
-
- END SUBROUTINE ocean_boundary_conditions
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Swapping of timelevels.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_swap_timelevel( mod_count )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  mod_count  !< flag defining where pointers point to
-
-
-    SELECT CASE ( mod_count )
-
-       CASE ( 0 )
-          IF ( salinity )  THEN
-             sa => sa_1;    sa_p => sa_2
-          ENDIF
-
-       CASE ( 1 )
-          IF ( salinity )  THEN
-             sa => sa_2;    sa_p => sa_1
-          ENDIF
-
-    END SELECT
-
- END SUBROUTINE ocean_swap_timelevel
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_rrd_global_ftn( found )
-
-
-    USE control_parameters,                                                                        &
-        ONLY: length, restart_string
-
-
-    IMPLICIT NONE
-
-    LOGICAL, INTENT(OUT)  ::  found
-
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'bc_sa_t' )
-          READ ( 13 )  bc_sa_t
-
-       CASE ( 'bottom_salinityflux' )
-          READ ( 13 )  bottom_salinityflux
-
-       CASE ( 'salinity' )
-          READ ( 13 )  salinity
-
-       CASE ( 'sa_init' )
-          READ ( 13 )  sa_init
-
-       CASE ( 'sa_surface' )
-          READ ( 13 )  sa_surface
-
-       CASE ( 'sa_vertical_gradient' )
-          READ ( 13 )  sa_vertical_gradient
-
-       CASE ( 'sa_vertical_gradient_level' )
-          READ ( 13 )  sa_vertical_gradient_level
-
-       CASE ( 'stokes_waveheight' )
-          READ ( 13 )  stokes_waveheight
-
-       CASE ( 'stokes_wavelength' )
-          READ ( 13 )  stokes_wavelength
-
-       CASE ( 'surface_cooling_spinup_time' )
-          READ ( 13 )  surface_cooling_spinup_time
-
-       CASE ( 'top_salinityflux' )
-          READ ( 13 )  top_salinityflux
-
-       CASE ( 'wall_salinityflux' )
-          READ ( 13 )  wall_salinityflux
-
-       CASE ( 'wave_breaking' )
-          READ ( 13 )  wave_breaking
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE ocean_rrd_global_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_rrd_global_mpi
-
-    CALL rrd_mpi_io( 'bc_sa_t', bc_sa_t )
-    CALL rrd_mpi_io( 'bottom_salinityflux', bottom_salinityflux )
-    CALL rrd_mpi_io( 'salinity', salinity )
-    CALL rrd_mpi_io_global_array( 'sa_init', sa_init )
-    CALL rrd_mpi_io( 'sa_surface', sa_surface )
-    CALL rrd_mpi_io_global_array( 'sa_vertical_gradient', sa_vertical_gradient )
-    CALL rrd_mpi_io_global_array( 'sa_vertical_gradient_level', sa_vertical_gradient_level )
-    CALL rrd_mpi_io_global_array( 'sa_vertical_gradient_level_ind', sa_vertical_gradient_level_ind )
-    CALL rrd_mpi_io( 'stokes_waveheight', stokes_waveheight )
-    CALL rrd_mpi_io( 'stokes_wavelength', stokes_wavelength )
-    CALL rrd_mpi_io( 'surface_cooling_spinup_time', surface_cooling_spinup_time )
-    CALL rrd_mpi_io( 'top_salinityflux', top_salinityflux )
-    CALL rrd_mpi_io_global_array( 'wall_salinityflux', wall_salinityflux )
-    CALL rrd_mpi_io( 'wave_breaking', wave_breaking )
-
- END SUBROUTINE ocean_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,  &
-                                 nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
-
-    USE averaging,                                                                                 &
-        ONLY:  rho_ocean_av, sa_av
-
-    USE control_parameters,                                                                        &
-        ONLY:  length, restart_string
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nxlg, nxrg, nyng, nysg, nzb, nzt
-
-    USE pegrid
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k               !<
-    INTEGER(iwp) ::  nxlc            !<
-    INTEGER(iwp) ::  nxlf            !<
-    INTEGER(iwp) ::  nxl_on_file     !<
-    INTEGER(iwp) ::  nxrc            !<
-    INTEGER(iwp) ::  nxrf            !<
-    INTEGER(iwp) ::  nxr_on_file     !<
-    INTEGER(iwp) ::  nync            !<
-    INTEGER(iwp) ::  nynf            !<
-    INTEGER(iwp) ::  nyn_on_file     !<
-    INTEGER(iwp) ::  nysc            !<
-    INTEGER(iwp) ::  nysf            !<
-    INTEGER(iwp) ::  nys_on_file     !<
-
-    LOGICAL, INTENT(OUT)  ::  found
-
-    REAL(wp),                                                                                      &
-       DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp)    &
-       :: tmp_3d   !<
-
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'rho_ocean_av' )
-          IF ( .NOT. ALLOCATED( rho_ocean_av ) )  THEN
-             ALLOCATE( rho_ocean_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          rho_ocean_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'sa' )
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          sa(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                          &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'sa_av' )
-          IF ( .NOT. ALLOCATED( sa_av ) )  THEN
-              ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ ( 13 )  tmp_3d
-          sa_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                       &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE ocean_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_rrd_local_mpi
-
-    USE averaging,                                                                                 &
-        ONLY:  rho_ocean_av, sa_av
-
-    USE indices,                                                                                   &
-        ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt
-
-    IMPLICIT NONE
-
-    LOGICAL ::  array_found  !<
-
-
-    CALL rd_mpi_io_check_array( 'rho_ocean_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rho_ocean_av ) )                                                      &
-          ALLOCATE( rho_ocean_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rho_ocean_av', rho_ocean_av )
-    ENDIF
-
-    CALL rrd_mpi_io( 'sa', sa )
-
-    CALL rd_mpi_io_check_array( 'sa_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( sa_av ) )  ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'sa_av', sa_av )
-    ENDIF
-
- END SUBROUTINE ocean_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data for the ocean module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_wrd_global
-
-    IMPLICIT NONE
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL wrd_write_string( 'bc_sa_t' )
-       WRITE ( 14 )  bc_sa_t
-
-       CALL wrd_write_string( 'bottom_salinityflux' )
-       WRITE ( 14 )  bottom_salinityflux
-
-       CALL wrd_write_string( 'salinity' )
-       WRITE ( 14 )  salinity
-
-       CALL wrd_write_string( 'sa_init' )
-       WRITE ( 14 )  sa_init
-
-       CALL wrd_write_string( 'sa_surface' )
-       WRITE ( 14 )  sa_surface
-
-       CALL wrd_write_string( 'sa_vertical_gradient' )
-       WRITE ( 14 )  sa_vertical_gradient
-
-       CALL wrd_write_string( 'sa_vertical_gradient_level' )
-       WRITE ( 14 )  sa_vertical_gradient_level
-
-       CALL wrd_write_string( 'stokes_waveheight' )
-       WRITE ( 14 )  stokes_waveheight
-
-       CALL wrd_write_string( 'stokes_wavelength' )
-       WRITE ( 14 )  stokes_wavelength
-
-       CALL wrd_write_string( 'surface_cooling_spinup_time' )
-       WRITE ( 14 )  surface_cooling_spinup_time
-
-       CALL wrd_write_string( 'top_salinityflux' )
-       WRITE ( 14 )  top_salinityflux
-
-       CALL wrd_write_string( 'wall_salinityflux' )
-       WRITE ( 14 )  wall_salinityflux
-
-       CALL wrd_write_string( 'wave_breaking' )
-       WRITE ( 14 )  wave_breaking
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       CALL wrd_mpi_io( 'bc_sa_t', bc_sa_t )
-       CALL wrd_mpi_io( 'bottom_salinityflux', bottom_salinityflux )
-       CALL wrd_mpi_io( 'salinity', salinity )
-       CALL wrd_mpi_io_global_array( 'sa_init', sa_init )
-       CALL wrd_mpi_io( 'sa_surface', sa_surface )
-       CALL wrd_mpi_io_global_array( 'sa_vertical_gradient', sa_vertical_gradient )
-       CALL wrd_mpi_io_global_array( 'sa_vertical_gradient_level', sa_vertical_gradient_level )
-       CALL wrd_mpi_io_global_array( 'sa_vertical_gradient_level_ind',                             &
-                                     sa_vertical_gradient_level_ind )
-       CALL wrd_mpi_io( 'stokes_waveheight', stokes_waveheight )
-       CALL wrd_mpi_io( 'stokes_wavelength', stokes_wavelength )
-       CALL wrd_mpi_io( 'surface_cooling_spinup_time', surface_cooling_spinup_time )
-       CALL wrd_mpi_io( 'top_salinityflux', top_salinityflux )
-       CALL wrd_mpi_io_global_array( 'wall_salinityflux', wall_salinityflux )
-       CALL wrd_mpi_io( 'wave_breaking', wave_breaking )
-
-    ENDIF
-
- END SUBROUTINE ocean_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data for the ocean module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ocean_wrd_local
-
-    USE averaging,                                                                                 &
-        ONLY:  rho_ocean_av, sa_av
-
-    IMPLICIT NONE
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       IF ( ALLOCATED( rho_ocean_av ) )  THEN
-          CALL wrd_write_string( 'rho_ocean_av' )
-          WRITE ( 14 )  rho_ocean_av
-       ENDIF
-
-       CALL wrd_write_string( 'sa' )
-       WRITE ( 14 )  sa
-
-       IF ( ALLOCATED( sa_av ) )  THEN
-          CALL wrd_write_string( 'sa_av' )
-          WRITE ( 14 )  sa_av
-       ENDIF
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       IF ( ALLOCATED( rho_ocean_av ) )  CALL wrd_mpi_io( 'rho_ocean_av', rho_ocean_av )
-       CALL wrd_mpi_io( 'sa', sa )
-       IF ( ALLOCATED( sa_av ) )  CALL wrd_mpi_io( 'sa_av', sa_av )
-
-    ENDIF
-
- END SUBROUTINE ocean_wrd_local
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine calculates the Craik Leibovich vortex force and the additional effect of the Stokes
-!> drift on the Coriolis force.
-!> Call for all gridpoints.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stokes_drift_terms( component )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, u, u_stokes_zu, u_stokes_zw, v, v_stokes_zu, v_stokes_zw, w, tend
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  pi
-
-    USE control_parameters,                                                                        &
-        ONLY:  f, fs, message_string, rotation_angle
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxr, nys, nysv, nyn, nzb, nzt
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  component      !< component of momentum equation
-    INTEGER(iwp) ::  i              !< loop index along x
-    INTEGER(iwp) ::  j              !< loop index along y
-    INTEGER(iwp) ::  k              !< loop index along z
-
-    REAL(wp)     ::  cos_rot_angle  !< cosine of model rotation angle
-    REAL(wp)     ::  sin_rot_angle  !< sine of model rotation angle
-
-
-!
-!-- Compute Stokes terms for the respective velocity components
-    SELECT CASE ( component )
-
-!
-!--    u-component
-       CASE ( 1 )
-          DO  i = nxl, nxr
-             DO  j = nysv, nyn
-                DO  k = nzb+1, nzt
-                   tend(k,j,i) = tend(k,j,i) + v_stokes_zu(k) * (                                  &
-                                                  0.5 * ( v(k,j+1,i) - v(k,j+1,i-1)                &
-                                                        + v(k,j,i)   - v(k,j,i-1)   ) * ddx        &
-                                                - 0.5 * ( u(k,j+1,i) - u(k,j-1,i) )   * ddy        &
-                                                                )                                  &
-                                 + f * v_stokes_zu(k)
-                ENDDO
-             ENDDO
-          ENDDO
-
-!
-!--    v-component
-       CASE ( 2 )
-          DO  i = nxl, nxr
-             DO  j = nysv, nyn
-                DO  k = nzb+1, nzt
-                   tend(k,j,i) = tend(k,j,i) - u_stokes_zu(k) * (                                  &
-                                                  0.5 * ( v(k,j,i+1) - v(k,j,i-1) )   * ddx        &
-                                                - 0.5 * ( u(k,j,i) - u(k,j-1,i)                    &
-                                                        + u(k,j,i+1) - u(k,j-1,i+1) ) * ddy        &
-                                                                )              &
-                                 - f * u_stokes_zu(k)
-                ENDDO
-             ENDDO
-          ENDDO
-
-!
-!--    w-component
-       CASE ( 3 )
-
-!
-!--       Precalculate cosine and sine of rotation angle
-          cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-          sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   tend(k,j,i) = tend(k,j,i) + u_stokes_zw(k) *   (                                &
-                                                   0.5 * ( u(k+1,j,i) - u(k,j,i)                   &
-                                                         + u(k+1,j,i+1) - u(k,j,i+1)               &
-                                                         ) * ddzu(k+1)                             &
-                                                 - 0.5 * ( w(k,j,i+1) - w(k,j,i-1)                 &
-                                                         ) * ddx  )                                &
-                                             - v_stokes_zw(k) *      (                             &
-                                                   0.5 * ( w(k,j+1,i) - w(k,j-1,i)                 &
-                                                         ) * ddy                                   &
-                                                 - 0.5 * ( v(k+1,j,i) - v(k,j,i)                   &
-                                                         + v(k+1,j+1,i) - v(k,j+1,i)               &
-                                                         ) * ddzu(k) )                             &
-                                              + fs * (   sin_rot_angle * v_stokes_zw(k)            &
-                                                       + cos_rot_angle * u_stokes_zw(k)            &
-                                                     )
-                ENDDO
-             ENDDO
-          ENDDO
-
-       CASE DEFAULT
-          WRITE( message_string, * ) 'wrong component of Stokes force: ', component
-          CALL message( 'stokes_drift_terms', 'PA0091', 1, 2, 0, 6, 0 )
-
-    END SELECT
-
- END SUBROUTINE stokes_drift_terms
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine calculates the Craik Leibovich vortex force and the additional effect of the Stokes
-!> drift on the Coriolis force.
-!> Call for gridpoints i,j.
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE stokes_drift_terms_ij( i, j, component )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, u, u_stokes_zu, u_stokes_zw, v, v_stokes_zu, v_stokes_zw, w, tend
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  pi
-
-    USE control_parameters,                                                                        &
-        ONLY:  f, fs, message_string, rotation_angle
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nzb, nzt
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  component      !< component of momentum equation
-    INTEGER(iwp) ::  i              !< loop index along x
-    INTEGER(iwp) ::  j              !< loop index along y
-    INTEGER(iwp) ::  k              !< loop incex along z
-
-    REAL(wp)     ::  cos_rot_angle  !< cosine of model rotation angle
-    REAL(wp)     ::  sin_rot_angle  !< sine of model rotation angle
-
-
-!
-!-- Compute Stokes terms for the respective velocity components
-    SELECT CASE ( component )
-
-!
-!--    u-component
-       CASE ( 1 )
-          DO  k = nzb+1, nzt
-             tend(k,j,i) = tend(k,j,i) + v_stokes_zu(k) * (                                        &
-                                              0.5 * ( v(k,j+1,i) - v(k,j+1,i-1)                    &
-                                                    + v(k,j,i)   - v(k,j,i-1)   ) * ddx            &
-                                            - 0.5 * ( u(k,j+1,i) - u(k,j-1,i) )   * ddy            &
-                                                          )                                        &
-                                       + f * v_stokes_zu(k)
-          ENDDO
-!
-!--    v-component
-       CASE ( 2 )
-          DO  k = nzb+1, nzt
-             tend(k,j,i) = tend(k,j,i) - u_stokes_zu(k) * (                                        &
-                                              0.5 * ( v(k,j,i+1) - v(k,j,i-1) )   * ddx            &
-                                            - 0.5 * ( u(k,j,i) - u(k,j-1,i)                        &
-                                                    + u(k,j,i+1) - u(k,j-1,i+1) ) * ddy            &
-                                                          )                                        &
-                                       - f * u_stokes_zu(k)
-          ENDDO
-
-!
-!--    w-component
-       CASE ( 3 )
-
-!
-!--       Precalculate cosine and sine of rotation angle
-          cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-          sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
-
-          DO  k = nzb+1, nzt
-             tend(k,j,i) = tend(k,j,i) + u_stokes_zw(k) * ( 0.5 * ( u(k+1,j,i) - u(k,j,i)          &
-                                                                  + u(k+1,j,i+1) - u(k,j,i+1)      &
-                                                                  ) * ddzu(k+1)                    &
-                                                          - 0.5 * ( w(k,j,i+1) - w(k,j,i-1)        &
-                                                                  ) * ddx      )                   &
-                                       - v_stokes_zw(k) * ( 0.5 * ( w(k,j+1,i) - w(k,j-1,i)        &
-                                                                  ) * ddy                          &
-                                                          - 0.5 * ( v(k+1,j,i) - v(k,j,i)          &
-                                                                  + v(k+1,j+1,i) - v(k,j+1,i)      &
-                                                                  ) * ddzu(k)  )                   &
-                                       + fs * ( sin_rot_angle * v_stokes_zw(k)                     &
-                                              + cos_rot_angle * u_stokes_zw(k)                     &
-                                              )
-          ENDDO
-
-       CASE DEFAULT
-          WRITE( message_string, * ) ' wrong component: ', component
-          CALL message( 'stokes_drift_terms', 'PA0091', 1, 2, 0, 6, 0 )
-
-    END SELECT
-
- END SUBROUTINE stokes_drift_terms_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine calculates turbulence generated by wave breaking near the ocean surface, following
-!> a parameterization given in Noh et al. (2004), JPO
-!> Call for all gridpoints.
-!> TODO: so far, this routine only works if the model time step has about the same value as the time
-!>       scale of wave breaking!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wave_breaking_term( component )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  u_p, v_p
-
-    USE control_parameters,                                                                        &
-        ONLY:  dt_3d, message_string
-
-    USE indices,                                                                                   &
-        ONLY:  nxl, nxlu, nxr, nys, nysv, nyn, nzt
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  component  !< component of momentum equation
-    INTEGER(iwp) ::  i          !< loop index along x
-    INTEGER(iwp) ::  j          !< loop index along y
-
-    REAL(wp) ::  random_gauss  !< function that creates a random number with a Gaussian distribution
-
-
-!
-!-- Compute wave breaking terms for the respective velocity components.
-!-- Velocities are directly manipulated, since this is not a real force
-    SELECT CASE ( component )
-
-!
-!--    u-component
-       CASE ( 1 )
-          DO  i = nxlu, nxr
-             DO  j = nys, nyn
-                u_p(nzt,j,i) = u_p(nzt,j,i) +                                                      &
-                               ( random_gauss( iran_ocean, 1.0_wp ) - 1.0_wp )                     &
-                               * alpha_wave_breaking * u_star_wave_breaking                        &
-                               / timescale_wave_breaking * dt_3d
-             ENDDO
-          ENDDO
-!
-!--    v-component
-       CASE ( 2 )
-          DO  i = nxl, nxr
-             DO  j = nysv, nyn
-                v_p(nzt,j,i) = v_p(nzt,j,i) +                                                      &
-                               ( random_gauss( iran_ocean, 1.0_wp ) - 1.0_wp )                     &
-                               * alpha_wave_breaking * u_star_wave_breaking                        &
-                               / timescale_wave_breaking * dt_3d
-             ENDDO
-          ENDDO
-
-       CASE DEFAULT
-          WRITE( message_string, * ) 'wrong component of wave breaking: ', component
-          CALL message( 'stokes_drift_terms', 'PA0466', 1, 2, 0, 6, 0 )
-
-    END SELECT
-
- END SUBROUTINE wave_breaking_term
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine calculates turbulence generated by wave breaking near the ocean surface, following a
-!> parameterization given in Noh et al. (2004), JPO
-!> Call for gridpoint i,j.
-!> TODO: so far, this routine only works if the model time step has about the same value as the time
-!> scale of wave breaking!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wave_breaking_term_ij( i, j, component )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  u_p, v_p
-
-    USE control_parameters,                                                                        &
-        ONLY:  dt_3d, message_string
-
-    USE indices,                                                                                   &
-        ONLY:  nzt
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  component  !< component of momentum equation
-    INTEGER(iwp) ::  i          !< loop index along x
-    INTEGER(iwp) ::  j          !< loop index along y
-
-    REAL(wp) ::  random_gauss  !< function that creates a random number with a Gaussian distribution
-
-!
-!-- Compute wave breaking terms for the respective velocity components
-    SELECT CASE ( component )
-
-!
-!--    u-/v-component
-       CASE ( 1 )
-          u_p(nzt,j,i) = u_p(nzt,j,i) +                                                            &
-                         ( random_gauss( iran_ocean, 1.0_wp ) - 1.0_wp )                           &
-                         * alpha_wave_breaking * u_star_wave_breaking                              &
-                         / timescale_wave_breaking * dt_3d
-
-       CASE ( 2 )
-          v_p(nzt,j,i) = v_p(nzt,j,i) +                                                            &
-                         ( random_gauss( iran_ocean, 1.0_wp ) - 1.0_wp )                           &
-                         * alpha_wave_breaking * u_star_wave_breaking                              &
-                         / timescale_wave_breaking * dt_3d
-
-       CASE DEFAULT
-          WRITE( message_string, * ) 'wrong component of wave breaking: ', component
-          CALL message( 'stokes_drift_terms', 'PA0466', 1, 2, 0, 6, 0 )
-
-    END SELECT
-
- END SUBROUTINE wave_breaking_term_ij
-
-
- END MODULE ocean_mod
Index: palm/trunk/SOURCE/outflow_turbulence.f90
===================================================================
--- palm/trunk/SOURCE/outflow_turbulence.f90	(revision 4901)
+++ 	(revision )
@@ -1,171 +1,0 @@
-!> @file outflow_turbulence.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id: outflow_turbulence.f90 3241 2018-09-12 15:02:00Z raasch $
-! file re-formatted to follow the PALM coding standard
-!
-! 3241 2018-09-12 15:02:00Z raasch
-! Corrected "Former revisions" section
-!
-! 3241 2018-09-12 15:02:00Z raasch
-! unused variables removed
-!
-! 2050 2016-11-08 15:00:55Z gronemeier
-! Initial version
-!
-!
-! Description:
-! ------------
-!> Routine based on inflow_turbulence.f90. Copies values of 3d data from a 2d vertical source plane
-!> (defined by outflow_source_plane) to the outflow boundary.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE outflow_turbulence
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  e, pt, q, s, u, v, w
-
-    USE control_parameters,                                                                        &
-        ONLY:  humidity, passive_scalar, outflow_source_plane
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxr, nyn, nys, nyng, nysg, nzb, nzt
-
-    USE kinds
-
-    USE pegrid!,                                                                                    &
-        !ONLY:  comm1dx, id_outflow, id_outflow_source, ierr, myidx, status
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i        !< loop index
-    INTEGER(iwp) ::  j        !< loop index
-    INTEGER(iwp) ::  k        !< loop index
-    INTEGER(iwp) ::  l        !< loop index
-    INTEGER(iwp) ::  ngp_ofv  !< number of grid points stored in outflow_val
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,7,nbgp) ::  outflow_val  !< values to be copied to the outflow boundary
-
-
-    CALL cpu_log( log_point(56), 'outflow_turbulence', 'start' )
-!
-!-- Get number of grid points stored in outflow_val
-    ngp_ofv = ( nzt - nzb + 2 ) * ( nyn - nys + 1 + 2 * nbgp ) * 7 * nbgp
-!
-!-- Get position of the source plane inside the palm grid
-    i = outflow_source_plane * ddx
-!
-!-- Use instantaneous values instead of averaged profiles
-#if defined( __parallel )
-    IF ( myidx == id_outflow_source )  THEN
-       DO  l = 1, nbgp
-          DO  j = nysg, nyng
-             DO  k = nzb, nzt + 1
-
-                outflow_val(k,j,1,l) = u(k,j,i)
-                outflow_val(k,j,2,l) = v(k,j,i)
-                outflow_val(k,j,3,l) = w(k,j,i)
-                outflow_val(k,j,4,l) = pt(k,j,i)
-                outflow_val(k,j,5,l) = e(k,j,i)
-                IF ( humidity  )                                                                   &
-                   outflow_val(k,j,6,l) = q(k,j,i)
-                IF ( passive_scalar )                                                              &
-                   outflow_val(k,j,7,l) = s(k,j,i)
-
-            ENDDO
-          ENDDO
-          i = i + 1
-       ENDDO
-
-    ENDIF
-#else
-    DO  l = 1, nbgp
-       DO  j = nysg, nyng
-          DO  k = nzb, nzt+1
-
-             outflow_val(k,j,1,l) = u(k,j,i)
-             outflow_val(k,j,2,l) = v(k,j,i)
-             outflow_val(k,j,3,l) = w(k,j,i)
-             outflow_val(k,j,4,l) = pt(k,j,i)
-             outflow_val(k,j,5,l) = e(k,j,i)
-             IF ( humidity  )                                                                      &
-                outflow_val(k,j,6,l) = q(k,j,i)
-             IF ( passive_scalar )                                                                 &
-                outflow_val(k,j,7,l) = s(k,j,i)
-
-          ENDDO
-       ENDDO
-       i = i + 1
-    ENDDO
-#endif
-
-!
-!-- For parallel runs, send the values to the respective outflow PE
-#if defined( __parallel )
-    IF ( myidx == id_outflow_source  .AND.  myidx /= id_outflow )  THEN
-
-       CALL MPI_SEND( outflow_val(nzb,nysg,1,1), ngp_ofv, MPI_REAL, id_outflow, 1, comm1dx, ierr )
-
-    ELSEIF ( myidx /= id_outflow_source  .AND.  myidx == id_outflow )  THEN
-
-       outflow_val = 0.0_wp
-       CALL MPI_RECV( outflow_val(nzb,nysg,1,1), ngp_ofv, MPI_REAL, id_outflow_source, 1, comm1dx, &
-                      status, ierr )
-
-    ENDIF
-#endif
-
-!
-!-- Copy values to the outflow
-    IF ( nxr == nx )  THEN
-
-       DO  j = nysg, nyng
-          DO  k = nzb, nzt + 1
-
-             u(k,j,nx+1:nx+nbgp)  = outflow_val(k,j,1,1:nbgp)
-             v(k,j,nx+1:nx+nbgp)  = outflow_val(k,j,2,1:nbgp)
-             w(k,j,nx+1:nx+nbgp)  = outflow_val(k,j,3,1:nbgp)
-             pt(k,j,nx+1:nx+nbgp) = outflow_val(k,j,4,1:nbgp)
-             e(k,j,nx+1:nx+nbgp)  = outflow_val(k,j,5,1:nbgp)
-             e(k,j,nx+1:nx+nbgp)  = MAX( e(k,j,nx+1:nx+nbgp), 0.0_wp )
-
-             IF ( humidity )                                                                       &
-                q(k,j,nx+1:nx+nbgp)  = outflow_val(k,j,6,1:nbgp)
-             IF ( passive_scalar )                                                                 &
-                s(k,j,nx+1:nx+nbgp)  = outflow_val(k,j,7,1:nbgp)
-
-          ENDDO
-       ENDDO
-
-
-    ENDIF
-
-    CALL cpu_log( log_point(56), 'outflow_turbulence', 'stop' )
-
- END SUBROUTINE outflow_turbulence
Index: palm/trunk/SOURCE/package_parin.f90
===================================================================
--- palm/trunk/SOURCE/package_parin.f90	(revision 1)
+++ palm/trunk/SOURCE/package_parin.f90	(revision 1)
@@ -0,0 +1,173 @@
+ SUBROUTINE package_parin
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: package_parin.f90,v $
+! Revision 1.18  2006/08/04 14:52:23  raasch
+! +dt_dopts, dt_min_part, end_time_prel, particles_per_point,
+! use_sgs_for_particles in particles_par
+!
+! Revision 1.17  2006/04/11 14:59:05  raasch
+! pl_spectra renamed data_output_sp
+!
+! Revision 1.16  2006/02/23 12:43:24  raasch
+! +number_of_particle_groups, skip_particles_for_tail, use_particle_tails in
+! particles_par,
+! +skip_time_dosp in spectra_par,
+! dt_plsp renamed dt_dosp, default setting of dt_dops,
+! set flag particle_advection
+!
+! Revision 1.15  2005/06/26 20:05:42  raasch
+! diameter renamed radius
+!
+! Revision 1.14  2003/10/29 09:01:29  raasch
+! +diameter in particles_par, uniform_psize renamed dvrp_psize
+!
+! Revision 1.13  2003/08/01 08:43:33  raasch
+! +slicer_range_limits_dvrp in dvrp_graphics_par
+!
+! Revision 1.12  2003/03/16 09:42:11  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.11  2002/09/12 13:06:50  raasch
+! +density_ratio in particles_par
+!
+! Revision 1.10  2002/04/16 08:10:08  raasch
+! +variables for particle boundary conditions, +vertical_particle_advection
+! in particles_par
+!
+! Revision 1.9  2001/11/12 16:07:04  raasch
+! +read_particles_from_restartfile
+!
+! Revision 1.7  2001/08/21 09:52:55  raasch
+! +superelevation, superelevation_x, superelevation_y in dvrp_graphics_par,
+! +maximum_number_of_particles, maximum_number_of_tailpoints,
+! maximum_tailpoint_age, minimum_tailpoint_distance in particles_par
+!
+! Revision 1.6  2001/07/12 12:42:49  raasch
+! +several new parameters in dvrp_graphics_par and particles_par
+!
+! Revision 1.5  2001/03/30 07:37:56  raasch
+! Namelist names changed,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.4  2001/01/25 07:10:48  raasch
+! +write_particle_informations
+!
+! Revision 1.2  2001/01/05 15:13:34  raasch
+! Spectra package added
+!
+! Revision 1.1  2000/12/28 13:21:57  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! This subroutine reads from the NAMELIST file variables controling model
+! software packages which are used optionally in the run.
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE dvrp_variables
+    USE particle_attributes
+    USE spectrum
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=80) ::  zeile
+
+    NAMELIST /dvrp_graphics_par/  dt_dvrp, dvrp_directory, dvrp_file,          &
+                                  dvrp_host, dvrp_output, dvrp_password,       &
+                                  dvrp_username, mode_dvrp,                    &
+                                  slicer_range_limits_dvrp, superelevation,    &
+                                  superelevation_x, superelevation_y, threshold
+    NAMELIST /particles_par/      bc_par_b, bc_par_lr, bc_par_ns, bc_par_t,    &
+                                  density_ratio, radius, dt_dopts,             &
+                                  dt_min_part, dt_prel,                        &
+                                  dt_write_particle_data, dvrp_psize,          &
+                                  end_time_prel, initial_weighting_factor,     &
+                                  maximum_number_of_particles,                 &
+                                  maximum_number_of_tailpoints,                &
+                                  maximum_tailpoint_age,                       &
+                                  minimum_tailpoint_distance,                  &
+                                  number_of_particle_groups,                   &
+                                  particles_per_point,                         &
+                                  particle_advection_start,                    &
+                                  particle_maximum_age, pdx, pdy, pdz, psb,    &
+                                  psl, psn, psr, pss, pst,                     &
+                                  random_start_position,                       &
+                                  read_particles_from_restartfile,             &
+                                  skip_particles_for_tail, use_particle_tails, &
+                                  use_sgs_for_particles,                       &
+                                  vertical_particle_advection,                 &
+                                  write_particle_statistics
+    NAMELIST /spectra_par/        averaging_interval_sp, comp_spectra_level,   &
+                                  data_output_sp, dt_dosp, plot_spectra_level, &
+                                  skip_time_dosp, spectra_direction
+
+!
+!-- Position the namelist-file at the beginning (it was already opened in
+!-- parin), search for the namelist-group of the package and position the
+!-- file at this line. Do the same for each optionally used package.
+    zeile = ' '
+
+#if defined( __dvrp_graphics )
+    REWIND ( 11 )
+    zeile = ' '
+    DO   WHILE ( INDEX( zeile, '&dvrp_graphics_par' ) == 0 )
+       READ ( 11, '(A)', END=10 )  zeile
+    ENDDO
+    BACKSPACE ( 11 )
+
+!
+!-- Read user-defined namelist
+    READ ( 11, dvrp_graphics_par )
+
+ 10 CONTINUE
+#endif
+
+#if defined( __particles )
+    REWIND ( 11 )
+    zeile = ' '
+    DO   WHILE ( INDEX( zeile, '&particles_par' ) == 0 )
+       READ ( 11, '(A)', END=20 )  zeile
+    ENDDO
+    BACKSPACE ( 11 )
+
+!
+!-- Read user-defined namelist
+    READ ( 11, particles_par )
+
+!
+!-- Set flag that indicates that particles are switched on
+    particle_advection = .TRUE.
+
+ 20 CONTINUE
+#endif
+
+#if defined( __spectra )
+    REWIND ( 11 )
+    zeile = ' '
+    DO   WHILE ( INDEX( zeile, '&spectra_par' ) == 0 )
+       READ ( 11, '(A)', END=30 )  zeile
+    ENDDO
+    BACKSPACE ( 11 )
+
+!
+!-- Read user-defined namelist
+    READ ( 11, spectra_par )
+
+!
+!-- Default setting of dt_dosp here (instead of check_parameters), because its
+!-- current value is needed in init_pegrid
+    IF ( dt_dosp == 9999999.9 )  dt_dosp = dt_data_output
+
+ 30 CONTINUE
+#endif
+
+ END SUBROUTINE package_parin
Index: palm/trunk/SOURCE/palm.f90
===================================================================
--- palm/trunk/SOURCE/palm.f90	(revision 4901)
+++ palm/trunk/SOURCE/palm.f90	(revision 1)
@@ -1,80 +1,70 @@
-! !> @file palm.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+#if defined( __vtk )
+ SUBROUTINE palm
+#else
+ PROGRAM palm
+#endif
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! TEST: open(9)
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4539 2020-05-18 14:05:17Z raasch
-! log point name changed
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4496 2020-04-15 08:37:26Z raasch
-! bugfix: coupling character added to restart output filename
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4414 2020-02-19 20:16:04Z suehring
-! Call to module_interface_init_numerics
-!
-! 4400 2020-02-10 20:32:41Z suehring
-! Add interface to initialize data output with dom
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! implement new palm_date_time_mod
-!
-! 4094 2019-07-12 09:24:21Z gronemeier
-! Corrected "Former revisions" section
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! Rename subroutines in module for diagnostic quantities
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! new module for calculation and output of diagnostic quantities added
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction
-! of additional debug messages
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! unused variable removed
-!
-! 3719 2019-02-06 13:10:18Z kanani
-! Included cpu measurement for wall/soil spinup
-!
-! 3703 2019-01-29 16:43:53Z knoop
-! Some interface calls moved to module_interface + cleanup
-!
-! 3648 2019-01-02 16:35:46Z suehring
-! Rename subroutines for surface-data output
+! $Log: palm.f90,v $
+! Revision 1.10  2006/08/04 14:53:12  raasch
+! Distibution of run description header removed, call of header moved behind
+! init_3d_model
+!
+! Revision 1.9  2006/02/23 12:44:43  raasch
+! plot_.. renamed data_output_..
+!
+! Revision 1.8  2004/04/30 12:31:07  raasch
+! Missing cpp-instructions added, leap_frog changed to time_integration
+!
+! Revision 1.7  2003/05/09 14:46:49  raasch
+! String converted to integer before send via broadcast due to Linux MPICH
+! problem
+!
+! Revision 1.6  2003/03/16 09:42:17  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.5  2002/12/19 15:53:59  raasch
+! Routine local_tremain_ini moved from init_3d_model to here
+!
+! Revision 1.4  2001/08/21 09:53:35  raasch
+! comm_palm is now used as the global communicator since one PE maybe split from
+! MPI_COMM_WORLD for usage in dvrp-graphics
+!
+! Revision 1.3  2001/03/30 07:39:41  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.),
+! closing of unit 14 moved from routine write_3d_binary to this routine
+!
+! Revision 1.2  2001/01/25 07:15:06  raasch
+! Program name changed to PALM, module test_variables removed.
+! Initialization of dvrp logging as well as exit of dvrp moved to new
+! subroutines init_dvrp_logging and close_dvrp (file init_dvrp.f90)
+!
+! Revision 1.23  2001/01/05 15:13:51  raasch
+! +module spectrum
+!
+! Revision 1.22  2001/01/02 17:32:55  raasch
+! Subroutine close_files renamed to close_file, now called with an argument
+!
+! Revision 1.21  2000/12/28 13:32:16  raasch
+! Call of MPI_FINALIZE moved to the end of the program. At the beginning
+! comm2d is set to MPI_COMM_WORLD (it was undefined before).
+! Call of write_particles at the end. Open and close of DVRP-Software at the
+! beginning and at the end (optionally, by cpp-directives)
+!
+! Revision 1.20  2000/04/27 06:42:43  raasch
+! closing call to dvrp-software (if used) at the end of the run,
+! old revision remarks deleted
+!
+! Revision 1.19  2000/01/25 15:29:23  letzel
+! All comments translated into English
+!
+! Revision 1.18  1999/11/25 16:27:49  raasch
+! Bei Benutzung von VTK-Grafik wird Modell als UP in C++ - Programm eingebunden
 !
 ! Revision 1.1  1997/07/24 11:23:35  raasch
@@ -84,170 +74,43 @@
 ! Description:
 ! ------------
-!> Large-Eddy Simulation (LES) model for atmospheric and oceanic boundary-layer flows,
-!> see the PALM homepage https://palm-model.org for further information
-!--------------------------------------------------------------------------------------------------!
- PROGRAM palm
+! Large-Eddy Simulation (LES) model for the convective boundary layer, 
+! optimized for use on parallel machines (implementation realized using the
+! Message Passing Interface (MPI)). The model can also be run on vector machines
+! (less well optimized) and workstations. Versions for the different types of 
+! machines are controlled via cpp-directives.
+! Model runs are only feasible using the ksh-script mrun.
+!------------------------------------------------------------------------------!
 
 
     USE arrays_3d
+    USE constants
+    USE cpulog
+    USE dvrp_variables
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE model_1d
+    USE particle_attributes
+    USE pegrid
+    USE spectrum
+    USE statistics
+    USE control_parameters
+
+    IMPLICIT NONE
+
+!
+!-- Local variables
+    CHARACTER (LEN=9) ::  time_to_string
+    CHARACTER (LEN=1) ::  cdum
+    INTEGER           ::  i, run_description_header_i(80)
 
 #if defined( __parallel )
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert
-#endif
-
-    USE control_parameters,                                                                        &
-        ONLY:  coupling_char, do2d_at_begin, do3d_at_begin, io_blocks, io_group, message_string,   &
-               restart_data_format_output, runnr, simulated_time_chr, spinup,                      &
-               time_since_reference_point, user_interface_current_revision,                        &
-               user_interface_required_revision, version, write_binary
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  child_domain, constant_diffusion, humidity, initializing_actions, neutral,          &
-               passive_scalar
-#endif
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, cpu_statistics, log_point
-
-#if defined( __parallel )
-    USE cpulog,                                                                                    &
-        ONLY:  log_point_s
-#endif
-
-    USE diagnostic_output_quantities_mod,                                                          &
-        ONLY:  doq_calculate
-
-#if defined( __parallel )
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp
-#endif
-
-    USE kinds
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_init_numerics,                                                     &
-               module_interface_init_output,                                                       &
-               module_interface_last_actions
-
-
-    USE multi_agent_system_mod,                                                                    &
-        ONLY:  agents_active, mas_last_actions
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  netcdf_data_input_inquire_file, netcdf_data_input_init,                             &
-               netcdf_data_input_surface_data, netcdf_data_input_topo
-
-    USE pegrid
-
-#if defined( __parallel )
-    USE pmc_particle_interface,                                                                    &
-        ONLY: pmcp_g_alloc_win
-
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run, pmci_child_initialize, pmci_init, pmci_modelconfiguration,              &
-               pmci_parent_initialize
-#endif
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_close, rd_mpi_io_open
-
-    USE surface_data_output_mod,                                                                   &
-        ONLY:  surface_data_output_last_action
-
-    USE write_restart_data_mod,                                                                    &
-        ONLY:  wrd_global, wrd_local
-
-#if defined( __parallel )  &&  defined( _OPENACC )
-    USE openacc
-#endif
-
-
-    IMPLICIT NONE
-
-!
-!-- Local variables
-    CHARACTER(LEN=9) ::  time_to_string  !<
-
-    INTEGER(iwp)     ::  i                   !< loop counter for blocked I/O
-#if defined( __parallel) && defined( _OPENACC )
-    INTEGER(acc_device_kind) :: device_type      !< device type for OpenACC
-    INTEGER(iwp)             :: local_comm       !< local communicator (shared memory)
-    INTEGER(iwp)             :: local_num_procs  !< local number of processes
-    INTEGER(iwp)             :: local_id         !< local id
-    INTEGER(iwp)             ::  num_devices     !< number of devices visible to OpenACC
-    INTEGER(iwp)             ::  my_device       !< device used by this process
-#endif
-
-    version = 'PALM 6.0'
-    user_interface_required_revision = 'r4495'
-
-#if defined( __parallel )
-!
-!-- MPI initialisation. comm2d is preliminary set, because it will be defined in init_pegrid but is
-!-- used before in cpu_log.
+!
+!-- MPI initialisation. comm2d is preliminary set, because
+!-- it will be defined in init_pegrid but is used before in cpu_log.
     CALL MPI_INIT( ierr )
-
-!
-!-- Initialize the coupling for nested-domain runs comm_palm is the communicator which includes all
-!-- PEs (MPI processes) available for this (nested) model. If it is not a nested run, comm_palm is
-!-- returned as MPI_COMM_WORLD.
-    CALL cpu_log( log_point_s(70), 'pmci_init', 'start' )
-    CALL pmci_init( comm_palm )
-    CALL cpu_log( log_point_s(70), 'pmci_init', 'stop' )
-    comm2d = comm_palm
-!
-!-- Get the (preliminary) number of MPI processes and the local PE-id (in case of a further
-!-- communicator splitting in init_coupling, these numbers will be changed in init_pegrid).
-    IF ( nested_run )  THEN
-
-       CALL MPI_COMM_SIZE( comm_palm, numprocs, ierr )
-       CALL MPI_COMM_RANK( comm_palm, myid, ierr )
-
-    ELSE
-
-       CALL MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr )
-       CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr )
-!
-!--    Initialize PE topology in case of coupled atmosphere-ocean runs (comm_palm will be splitted
-!--    in init_coupling)
-       CALL init_coupling
-    ENDIF
-
-#ifdef _OPENACC
-!
-!-- Select OpenACC device to use in this process. For this find out how many neighbors there are
-!-- running on the same node and which id this process is.
-    IF ( nested_run )  THEN
-       CALL MPI_COMM_SPLIT_TYPE( comm_palm, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, local_comm,    &
-                                 ierr )
-    ELSE
-       CALL MPI_COMM_SPLIT_TYPE( MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL,           &
-                                 local_comm, ierr )
-    ENDIF
-    CALL MPI_COMM_SIZE( local_comm, local_num_procs, ierr )
-    CALL MPI_COMM_RANK( local_comm, local_id, ierr )
-
-!
-!-- This loop including the barrier is a workaround for PGI compiler versions up to and including
-!-- 18.4. Later releases are able to select their GPUs in parallel, without running into spurious
-!-- errors.
-    DO i = 0, local_num_procs-1
-       CALL MPI_BARRIER( local_comm, ierr )
-
-       IF ( i == local_id )  THEN
-          device_type = acc_get_device_type()
-          num_devices = acc_get_num_devices( device_type )
-          my_device = MOD( local_id, num_devices )
-          CALL acc_set_device_num( my_device, device_type )
-       ENDIF
-    ENDDO
-
-    CALL MPI_COMM_FREE( local_comm, ierr )
-#endif
+    CALL MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr )
+    comm_palm = MPI_COMM_WORLD
+    comm2d    = MPI_COMM_WORLD
 #endif
 
@@ -262,15 +125,12 @@
 
 !
-!-- Open a file for debug output
-    WRITE (myid_char,'(''_'',I6.6)')  myid
-    OPEN( 9, FILE='DEBUG'//TRIM( coupling_char )//myid_char, FORM='FORMATTED' )
-
-!
-!-- Initialize dvrp logging. Also, one PE maybe split from the global communicator for doing the
-!-- dvrp output. In that case, the number of PEs available for PALM is reduced by one and
-!-- communicator comm_palm is changed respectively.
+!-- Initialize dvrp logging. Also, one PE maybe split from the global
+!-- communicator for doing the dvrp output. In that case, the number of
+!-- PEs available for PALM is reduced by one and communicator comm_palm
+!-- is changed respectively.
 #if defined( __parallel )
     CALL MPI_COMM_RANK( comm_palm, myid, ierr )
 #endif
+    CALL init_dvrp_logging
 
 !
@@ -279,87 +139,19 @@
 
 !
-!-- Check for the user's interface version
-    IF ( user_interface_current_revision /= user_interface_required_revision )  THEN
-       message_string = 'current user-interface revision "' //                                     &
-                        TRIM( user_interface_current_revision ) // '" does ' //                    &
-                        'not match the required revision ' //                                      &
-                        TRIM( user_interface_required_revision )
-        CALL message( 'palm', 'PA0169', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
 !-- Determine processor topology and local array indices
     CALL init_pegrid
-!
-!-- Check if input file according to input-data standard exists
-    CALL netcdf_data_input_inquire_file
-!
-!-- Read topography input data if required. This is required before the numerical grid is finally
-!-- created in init_grid.
-    CALL netcdf_data_input_topo
-!
-!-- Generate grid parameters, initialize generic topography and further process topography
-!-- information if required.
+
+!
+!-- Generate grid parameters
     CALL init_grid
-!
-!-- Initialize boundary conditions and numerics such as the multigrid solver or the advection
-!-- routine
-    CALL module_interface_init_numerics
-!
-!-- Read global attributes if available.
-    CALL netcdf_data_input_init
-!
-!-- Read surface classification data, e.g. vegetation and soil types, water surfaces, etc., if
-!-- available. Some of these data is required before check parameters is invoked.
-    CALL netcdf_data_input_surface_data
+
 !
 !-- Check control parameters and deduce further quantities
     CALL check_parameters
 
+    OPEN( 9, FILE='DEBUG'//myid_char, FORM='FORMATTED' )
+!
+!-- Initialize all necessary variables
     CALL init_3d_model
-
-    CALL module_interface_init_output
-
-#if defined( __parallel )
-!
-!-- Coupling protocol setup for nested-domain runs
-    IF ( nested_run )  THEN
-       CALL pmci_modelconfiguration
-!
-!--    Receive and interpolate initial data on children.
-!--    Child initialization must be made first if the model is both child and parent if necessary.
-       IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-          CALL pmci_child_initialize
-!
-!--       Send initial condition data from parent to children
-          CALL pmci_parent_initialize
-!
-!--       Exchange_horiz is needed after the nest initialization
-          IF ( child_domain )  THEN
-             CALL exchange_horiz( u, nbgp )
-             CALL exchange_horiz( v, nbgp )
-             CALL exchange_horiz( w, nbgp )
-             IF ( .NOT. neutral )  THEN
-                CALL exchange_horiz( pt, nbgp )
-             ENDIF
-             IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e, nbgp )
-             IF ( humidity )  THEN
-                CALL exchange_horiz( q, nbgp )
-                IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-                  CALL exchange_horiz( qc, nbgp )
-                  CALL exchange_horiz( nc, nbgp )
-                ENDIF
-                IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-                   CALL exchange_horiz( qr, nbgp )
-                   CALL exchange_horiz( nr, nbgp )
-                ENDIF
-             ENDIF
-             IF ( passive_scalar )  CALL exchange_horiz( s, nbgp )
-          ENDIF
-       ENDIF
-
-       CALL pmcp_g_alloc_win                    ! Must be called after pmci_child_initialize and pmci_parent_initialize
-    ENDIF
-#endif
 
 !
@@ -370,117 +162,45 @@
 
 !
-!-- Integration of the non-atmospheric equations (land surface model, urban surface model)
-    IF ( spinup )  THEN
-       CALL cpu_log( log_point(41), 'wall/soil spinup', 'start' )
-       CALL time_integration_spinup
-       CALL cpu_log( log_point(41), 'wall/soil spinup', 'stop' )
-    ENDIF
-
-!
 !-- Set start time in format hh:mm:ss
-    simulated_time_chr = time_to_string( time_since_reference_point )
+    simulated_time_chr = time_to_string( simulated_time )
 
 !
 !-- If required, output of initial arrays
     IF ( do2d_at_begin )  THEN
-       CALL doq_calculate    !TODO, will be called twice
-
        CALL data_output_2d( 'xy', 0 )
        CALL data_output_2d( 'xz', 0 )
        CALL data_output_2d( 'yz', 0 )
     ENDIF
-
     IF ( do3d_at_begin )  THEN
-       CALL doq_calculate    !TODO, will be called twice
-
        CALL data_output_3d( 0 )
     ENDIF
 
 !
-!-- Integration of the model equations using timestep-scheme
+!-- Integration of the model equations using the leap-frog scheme
     CALL time_integration
 
 !
-!-- If required, write binary data for restart runs
-    IF ( write_binary )  THEN
-
-       CALL cpu_log( log_point(22), 'write-restart-data', 'start' )
-
-       CALL location_message( 'writing restart data', 'start' )
-
-       IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-          DO  i = 0, io_blocks-1
-             IF ( i == io_group )  THEN
-
-!
-!--             Open binary file
-                CALL check_open( 14 )
-!
-!--             Write control parameters and other global variables for restart.
-                IF ( myid == 0 )  CALL wrd_global
-!
-!--             Write processor specific flow field data for restart runs
-                CALL wrd_local
-!
-!--             Close binary file
-                CALL close_file( 14 )
-
-             ENDIF
-#if defined( __parallel )
-             CALL MPI_BARRIER( comm2d, ierr )
-#endif
-          ENDDO
-
-       ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-!
-!--       Open MPI-IO restart file
-          CALL rd_mpi_io_open( 'write', 'BINOUT' // TRIM( coupling_char ) )
-!
-!--       Write control parameters and other global variables for restart.
-          CALL wrd_global
-!
-!--       Write processor specific flow field data for restart runs
-          CALL wrd_local
-!
-!--       Close restart File
-          CALL rd_mpi_io_close
-
-       ENDIF
-
-       CALL location_message( 'writing restart data', 'finished' )
-
-       CALL cpu_log( log_point(22), 'write-restart-data', 'stop' )
-
-    ENDIF
-!
-!-- Last actions for surface output, for instantaneous and time-averaged data
-    CALL surface_data_output_last_action( 0 )
-    CALL surface_data_output_last_action( 1 )
+!-- If required, write binary data for model continuation runs
+    IF ( write_binary(1:4) == 'true' )  CALL write_3d_binary
+
+!
+!-- If required, write binary particle data
+    CALL write_particles
 
 !
 !-- If required, repeat output of header including the required CPU-time
     IF ( myid == 0 )  CALL header
-!
-!-- Perform module specific last actions
+
+!
+!-- If required, final user-defined actions, and
+!-- last actions on the open files and close files. Unit 14 was opened
+!-- in write_3d_binary but it is closed here, to allow writing on this
+!-- unit in routine user_last_actions.
     CALL cpu_log( log_point(4), 'last actions', 'start' )
-
-    IF ( myid == 0 .AND. agents_active )  CALL mas_last_actions ! ToDo: move to module_interface
-
-    CALL module_interface_last_actions
-
+    CALL user_last_actions
+    IF ( write_binary(1:4) == 'true' )  CALL close_file( 14 )
+    CALL close_file( 0 )
+    CALL close_dvrp
     CALL cpu_log( log_point(4), 'last actions', 'stop' )
-
-!
-!-- Close files
-    CALL close_file( 0 )
-
-!
-!-- Write run number to file (used by palmrun to create unified cycle numbers for output files).
-    IF ( myid == 0  .AND.  runnr > 0 )  THEN
-       OPEN( 90, FILE='RUN_NUMBER', FORM='FORMATTED' )
-       WRITE( 90, '(I4)' )  runnr
-       CLOSE( 90 )
-    ENDIF
 
 !
@@ -493,3 +213,9 @@
 #endif
 
+#if defined( __vtk )
+ END SUBROUTINE palm
+#else
  END PROGRAM palm
+#endif
+
+
Index: palm/trunk/SOURCE/palm_date_time_mod.f90
===================================================================
--- palm/trunk/SOURCE/palm_date_time_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,658 +1,0 @@
-!> @file palm_date_time_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4680 2020-09-16 10:20:34Z gronemeier
-! Add option to fix date and time; renamed set_reference_date_time to init_date_time
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Add days of northward- and southward equinox
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! Complete rework of module date_and_time_mod:
-!  - renamed module to prevent confusion with FORTRAN Standard routine date_and_time
-!  - introduce date_time_type
-!  - add set_reference_date_time
-!  - add get_date_time
-!  - capsule whole calculation of date and time variables within this routine
-!  - removed all variables/routines not belonging to this module
-!
-!
-! Authors:
-! --------
-!> @author Tobias Gronemeier (LUH)
-!
-! Description:
-! ------------
-!> This routine calculates all needed information on date and time used by other modules
-!>
-!> @todo Consider leap seconds
-!> @note Time_zone only supports full-hour time zones, i.e., time zones like Australian Central
-!>       Standard Time (UTC+9.5) are not possible
-!--------------------------------------------------------------------------------------------------!
- MODULE palm_date_time_mod
-
-    USE control_parameters,                                                                        &
-         ONLY:  message_string
-
-    USE kinds
-
-    IMPLICIT NONE
-
-!
-!-- Parameter Definition
-    INTEGER(iwp), PARAMETER ::  date_time_str_len  = 23_iwp                                 !< length of date_time strings
-    INTEGER(iwp), PARAMETER ::  days_per_week      = 7_iwp                                  !< days in a week
-    INTEGER(iwp), PARAMETER ::  hours_per_day      = 24_iwp                                 !< hours in a day
-    INTEGER(iwp), PARAMETER ::  minutes_per_hour   = 60_iwp                                 !< minutes in an hour
-    INTEGER(iwp), PARAMETER ::  months_per_year    = 12_iwp                                 !< months in a year
-!
-!-- Day of year of the mean northward and southward equinox (summer and winter half year)
-    INTEGER(iwp), PARAMETER ::  northward_equinox  = 80_iwp                                 !< Mar 21 (leap year: Mar 20)
-    INTEGER(iwp), PARAMETER ::  southward_equinox  = 264_iwp                                !< Sep 21 (leap year: Sep 20)
-
-    CHARACTER(LEN=3), DIMENSION(days_per_week), PARAMETER ::                                       &
-       weekdays = (/"Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"/)                       !< names of weekdays
-
-    INTEGER, DIMENSION(months_per_year), PARAMETER ::                                              &
-       days_per_month_noleapyear = (/31,28,31,30,31,30,31,31,30,31,30,31/)                  !< days for each month (no leap year)
-
-    INTEGER, DIMENSION(months_per_year), PARAMETER ::                                              &
-       days_per_month_leapyear = (/31,29,31,30,31,30,31,31,30,31,30,31/)                    !< days for each month (leap year)
-
-    INTEGER, DIMENSION(121), PARAMETER ::  leap_years = &                                   !< list of leap years
-        (/ 1804_iwp, 1808_iwp, 1812_iwp, 1816_iwp, 1820_iwp, 1824_iwp, 1828_iwp, 1832_iwp,         &
-           1836_iwp, 1840_iwp, 1844_iwp, 1848_iwp, 1852_iwp, 1856_iwp, 1860_iwp, 1864_iwp,         &
-           1868_iwp, 1872_iwp, 1876_iwp, 1880_iwp, 1884_iwp, 1888_iwp, 1892_iwp, 1896_iwp,         &
-           1904_iwp, 1908_iwp, 1912_iwp, 1916_iwp, 1920_iwp, 1924_iwp, 1928_iwp, 1932_iwp,         &
-           1936_iwp, 1940_iwp, 1944_iwp, 1948_iwp, 1952_iwp, 1956_iwp, 1960_iwp, 1964_iwp,         &
-           1968_iwp, 1972_iwp, 1976_iwp, 1980_iwp, 1984_iwp, 1988_iwp, 1992_iwp, 1996_iwp,         &
-           2000_iwp, 2004_iwp, 2008_iwp, 2012_iwp, 2016_iwp, 2020_iwp, 2024_iwp, 2028_iwp,         &
-           2032_iwp, 2036_iwp, 2040_iwp, 2044_iwp, 2048_iwp, 2052_iwp, 2056_iwp, 2060_iwp,         &
-           2064_iwp, 2068_iwp, 2072_iwp, 2076_iwp, 2080_iwp, 2084_iwp, 2088_iwp, 2092_iwp,         &
-           2096_iwp, 2104_iwp, 2108_iwp, 2112_iwp, 2116_iwp, 2120_iwp, 2124_iwp, 2128_iwp,         &
-           2132_iwp, 2136_iwp, 2140_iwp, 2144_iwp, 2148_iwp, 2152_iwp, 2156_iwp, 2160_iwp,         &
-           2164_iwp, 2168_iwp, 2172_iwp, 2176_iwp, 2180_iwp, 2184_iwp, 2188_iwp, 2192_iwp,         &
-           2196_iwp, 2204_iwp, 2208_iwp, 2212_iwp, 2216_iwp, 2220_iwp, 2224_iwp, 2228_iwp,         &
-           2232_iwp, 2236_iwp, 2240_iwp, 2244_iwp, 2248_iwp, 2252_iwp, 2256_iwp, 2260_iwp,         &
-           2264_iwp, 2268_iwp, 2272_iwp, 2276_iwp, 2280_iwp, 2284_iwp, 2288_iwp, 2292_iwp,         &
-           2296_iwp /)
-
-    REAL(wp),     PARAMETER ::  seconds_per_minute = 60.0_wp                                !< seconds in a minute
-    REAL(wp),     PARAMETER ::  seconds_per_hour   = seconds_per_minute * minutes_per_hour  !< seconds in an hour
-    REAL(wp),     PARAMETER ::  seconds_per_day    = seconds_per_hour * hours_per_day       !< seconds in a day
-
-!
-!-- Type Definition
-    TYPE date_time_type
-       INTEGER(iwp)                        ::  year           = -HUGE(0_iwp)               !< year
-       INTEGER(iwp)                        ::  month          = -HUGE(0_iwp)               !< month of year
-       INTEGER(iwp)                        ::  day            = -HUGE(0_iwp)               !< day of month
-       INTEGER(iwp)                        ::  hour           = -HUGE(0_iwp)               !< hour of day
-       INTEGER(iwp)                        ::  minute         = -HUGE(0_iwp)               !< minute of hour
-       INTEGER(iwp)                        ::  zone           = -HUGE(0_iwp)               !< time zone
-
-       REAL(wp)                            ::  second         = -HUGE(0.0_wp)              !< second of minute
-       REAL(wp)                            ::  second_of_year = -HUGE(0.0_wp)              !< second of year
-
-       INTEGER(iwp)                        ::  days_per_year  = -HUGE(0_iwp)               !< days within a year
-
-       INTEGER, DIMENSION(months_per_year) ::  days_per_month = days_per_month_noleapyear  !< list of total days per month
-    END TYPE date_time_type
-
-!
-!-- Variable Declaration
-    LOGICAL              ::  date_is_fixed              = .FALSE.  !< if true, date is fixed (time can still change)
-    LOGICAL              ::  reference_date_time_is_set = .FALSE.  !< true if reference_date_time is set
-    LOGICAL              ::  time_is_fixed              = .FALSE.  !< if true, time does not change at all
-
-    TYPE(date_time_type) ::  reference_date_time                   !< reference date-time
-
-    SAVE
-
-    PRIVATE
-!
-!-- Set reference date and time
-    INTERFACE init_date_time
-        MODULE PROCEDURE init_date_time
-    END INTERFACE init_date_time
-!
-!-- Return date and time information
-    INTERFACE get_date_time
-       MODULE PROCEDURE get_date_time
-    END INTERFACE get_date_time
-!
-!-- Public Interfaces
-    PUBLIC                                                                                         &
-       get_date_time,                                                                              &
-       init_date_time
-!
-!-- Public variables
-    PUBLIC                                                                                         &
-       date_time_str_len,                                                                          &
-       days_per_week,                                                                              &
-       hours_per_day,                                                                              &
-       minutes_per_hour,                                                                           &
-       months_per_year,                                                                            &
-       northward_equinox,                                                                          &
-       seconds_per_minute,                                                                         &
-       seconds_per_hour,                                                                           &
-       seconds_per_day,                                                                            &
-       southward_equinox,                                                                          &
-       weekdays
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize date-time setting by defining a global reference date-time and choosing a variable or
-!> fixed date.
-!> Only a single call is allowed to this routine during execution.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_date_time( date_time_str, use_fixed_date, use_fixed_time )
-
-    CHARACTER(LEN=date_time_str_len), INTENT(IN) ::  date_time_str  !< string containing date-time information
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  use_fixed_date  !< flag to fix date
-    LOGICAL, INTENT(IN), OPTIONAL ::  use_fixed_time  !< flag to fix time
-
-!
-!-- Check if date and time are already set
-    IF ( reference_date_time_is_set )  THEN
-       !> @note This error should never be observed by a user.
-       !>       It can only appear if the code was modified.
-       WRITE( message_string, * ) 'Multiple calls to init_date_time detected.&' //                 &
-                                  'This routine must not be called more than once.'
-       CALL message( 'init_date_time', 'PA0680', 2, 2, 0, 6, 0 )
-       RETURN
-
-    ELSE
-
-       reference_date_time = convert_string_to_date_time( date_time_str )
-
-       reference_date_time_is_set = .TRUE.
-
-       IF ( PRESENT( use_fixed_date ) )  date_is_fixed = use_fixed_date
-       IF ( PRESENT( use_fixed_time ) )  time_is_fixed = use_fixed_time
-
-    ENDIF
-
- END SUBROUTINE init_date_time
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Return requested date-time information of the reference time + time_since_reference.
-!> An alternative reference date-time string can be specified via 'reference_date_time_str'.
-!> Call to this routine is only possible if a reference time is either specified in the call itself
-!> via 'reference_date_time_str' or previously set by calling routine 'init_date_time'.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_date_time( time_since_reference, reference_date_time_str, year, month, day, hour,  &
-                           minute, second, zone, second_of_day, second_of_year, day_of_year,       &
-                           day_of_week, weekday, date_time_str, days_per_month, days_per_year )
-
-    CHARACTER(LEN=date_time_str_len), INTENT(OUT), OPTIONAL ::  date_time_str            !< date-time as string
-    CHARACTER(LEN=1)                                        ::  plus_minus               !< either '+' or '-'
-    CHARACTER(LEN=date_time_str_len), INTENT(IN),  OPTIONAL ::  reference_date_time_str  !< alternative reference date-time
-    CHARACTER(LEN=3),                 INTENT(OUT), OPTIONAL ::  weekday                  !< weekday
-
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  day              !< day of month
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  day_of_week      !< number of weekday
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  day_of_year      !< day of the year
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  days_per_year    !< days per year
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  hour             !< hour of day
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  minute           !< minute of hour
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  month            !< month of year
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  year             !< year
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  zone             !< time zone
-
-    INTEGER(iwp), DIMENSION(months_per_year), INTENT(OUT), OPTIONAL ::  days_per_month   !< days per year
-
-    REAL(wp), INTENT(OUT), OPTIONAL ::  second                        !< second of minute
-    REAL(wp), INTENT(OUT), OPTIONAL ::  second_of_day                 !< second of day
-    REAL(wp), INTENT(OUT), OPTIONAL ::  second_of_year                !< second of year
-    REAL(wp), INTENT(IN)            ::  time_since_reference          !< seconds between reference time and current time
-
-    TYPE(date_time_type)            ::  date_time                     !< date-time which to return
-    TYPE(date_time_type)            ::  internal_reference_date_time  !< internal reference date-time
-
-!
-!-- Check if a reference date-time is given
-    IF ( .NOT. reference_date_time_is_set  .AND.  .NOT. PRESENT( reference_date_time_str ) )  THEN
-       !> @note This error should never be observed by a user.
-       !>       It can only appear if the code was modified.
-       WRITE( message_string, * ) 'No reference date-time defined. '//                             &
-                                  'Returning date-time information is not possible. ' //           &
-                                  'Either specify reference_date_time_str ' //                     &
-                                  'or set a reference via init_date_time.'
-       CALL message( 'get_date_time', 'PA0677', 2, 2, 0, 6, 0 )
-       RETURN
-    ENDIF
-!
-!-- Set internal reference date-time
-    IF ( PRESENT( reference_date_time_str ) )  THEN
-       internal_reference_date_time = convert_string_to_date_time( reference_date_time_str )
-    ELSE
-       internal_reference_date_time = reference_date_time
-    ENDIF
-
-    IF ( time_is_fixed )  THEN
-!
-!--    If time shall not change, set new time to reference time
-       date_time = internal_reference_date_time
-    ELSE
-!
-!--    Add time to reference time
-       date_time = add_date_time( time_since_reference, internal_reference_date_time )
-!
-!--    If date shall be fixed, revert it to the reference date if changed
-       IF ( date_is_fixed )  THEN
-          IF ( date_time%year /= internal_reference_date_time%year  .OR.                           &
-               get_day_of_year( date_time ) /= get_day_of_year( internal_reference_date_time ) )   &
-          THEN
-
-             date_time%year  = internal_reference_date_time%year
-             date_time%month = internal_reference_date_time%month
-             date_time%day   = internal_reference_date_time%day
-             date_time       = update_leapyear_setting( date_time )
-             date_time%second_of_year = get_second_of_year( date_time )
-
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- Set requested return values
-    IF ( PRESENT( year           ) )  year           = date_time%year
-    IF ( PRESENT( month          ) )  month          = date_time%month
-    IF ( PRESENT( day            ) )  day            = date_time%day
-    IF ( PRESENT( hour           ) )  hour           = date_time%hour
-    IF ( PRESENT( minute         ) )  minute         = date_time%minute
-    IF ( PRESENT( second         ) )  second         = date_time%second
-    IF ( PRESENT( zone           ) )  zone           = date_time%zone
-    IF ( PRESENT( second_of_year ) )  second_of_year = date_time%second_of_year
-    IF ( PRESENT( second_of_day  ) )  second_of_day  = get_second_of_day( date_time )
-    IF ( PRESENT( day_of_year    ) )  day_of_year    = get_day_of_year( date_time )
-    IF ( PRESENT( day_of_week    ) )  day_of_week    = get_day_of_week( date_time )
-    IF ( PRESENT( weekday        ) )  weekday        = weekdays( get_day_of_week( date_time ) )
-    IF ( PRESENT( days_per_month ) )  days_per_month = date_time%days_per_month
-    IF ( PRESENT( days_per_year  ) )  days_per_year  = date_time%days_per_year
-
-    IF ( PRESENT( date_time_str ) )  THEN
-       IF ( date_time%zone < 0_iwp )  THEN
-          plus_minus = '-'
-       ELSE
-          plus_minus = '+'
-       ENDIF
-       WRITE( UNIT = date_time_str,                                                                &
-              FMT = '(I4,"-",I2.2,"-",I2.2,1X,I2.2,":",I2.2,":",I2.2,1X,A1,I2.2)' )                &
-          date_time%year, date_time%month, date_time%day,                                          &
-          date_time%hour, date_time%minute, INT( date_time%second ),                               &
-          plus_minus, ABS( date_time%zone )
-    ENDIF
-
- END SUBROUTINE get_date_time
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Convert a date-time string into a date_time object.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION convert_string_to_date_time( date_time_str )  RESULT( date_time )
-
-    CHARACTER(LEN=date_time_str_len), INTENT(IN) ::  date_time_str  !< date-time as string
-
-    INTEGER(iwp)                                 ::  read_status    !< returned status of read command
-
-    TYPE(date_time_type)                         ::  date_time      !< requested date-time object
-
-!
-!-- Decompose string to date-time information
-    READ( UNIT = date_time_str( 1: 4), IOSTAT = read_status, FMT = '(I4)'   )  date_time%year
-    IF ( read_status == 0 )  THEN
-       READ( UNIT = date_time_str( 6: 7), IOSTAT = read_status, FMT = '(I2)'   )  date_time%month
-    ENDIF
-    IF ( read_status == 0 )  THEN
-       READ( UNIT = date_time_str( 9:10), IOSTAT = read_status, FMT = '(I2)'   )  date_time%day
-    ENDIF
-    IF ( read_status == 0 )  THEN
-       READ( UNIT = date_time_str(12:13), IOSTAT = read_status, FMT = '(I2)'   )  date_time%hour
-    ENDIF
-    IF ( read_status == 0 )  THEN
-       READ( UNIT = date_time_str(15:16), IOSTAT = read_status, FMT = '(I2)'   )  date_time%minute
-    ENDIF
-    IF ( read_status == 0 )  THEN
-       READ( UNIT = date_time_str(18:19), IOSTAT = read_status, FMT = '(F2.0)' )  date_time%second
-    ENDIF
-    IF ( read_status == 0 )  THEN
-       READ( UNIT = date_time_str(21:23), IOSTAT = read_status, FMT = '(I3)'   )  date_time%zone
-    ENDIF
-
-    IF ( read_status /= 0 )  THEN
-       WRITE( message_string, * ) 'Error while converting date-time string. ' //                   &
-                                  'Please check format of date-time string: "' //                  &
-                                  TRIM( date_time_str ) // '". ' //                                &
-                                  'Format must be "YYYY-MM-DD hh:mm:ss ZZZ".'
-       CALL message( 'convert_string_to_date_time', 'PA0678', 2, 2, 0, 6, 0 )
-       RETURN
-    ENDIF
-
-    date_time = update_leapyear_setting( date_time )
-
-    IF ( check_date( date_time, date_time_str ) == 0 )  THEN
-
-       date_time%second_of_year = get_second_of_year( date_time )
-
-!
-!--    Shift time to UTC and set zone to UTC
-       date_time = add_date_time( REAL( -1 * date_time%zone, KIND = wp ) * seconds_per_hour,       &
-                                  date_time )
-       date_time%zone = 0_iwp
-    ENDIF
-
- END FUNCTION convert_string_to_date_time
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Add time increment (in seconds) to given date-time and return shifted date-time
-!--------------------------------------------------------------------------------------------------!
- FUNCTION add_date_time( inc_seconds, date_time_base ) RESULT( date_time )
-
-    INTEGER(iwp)                      ::  i                 !< loop index
-
-    REAL(wp)                          ::  seconds_left      !< seconds which must still be added to new date-time
-    REAL(wp)                          ::  seconds_per_year  !< number of seconds in a year
-
-    REAL(wp),             INTENT(IN)  ::  inc_seconds       !< seconds to be added to date-time
-
-    TYPE(date_time_type)              ::  date_time         !< shifted date-time
-    TYPE(date_time_type), INTENT(IN)  ::  date_time_base    !< date-time to be shifted
-
-!
-!-- Define some parameters
-    date_time = date_time_base
-    seconds_per_year = REAL( date_time%days_per_year,  KIND = wp ) * seconds_per_day
-!
-!-- Shift time
-    date_time%second_of_year = date_time%second_of_year + inc_seconds
-!
-!-- Check if year changes.
-!-- First, if year is reduced
-    DO WHILE ( date_time%second_of_year < 0.0_wp )
-       date_time%year           = date_time%year - 1_iwp
-       date_time                = update_leapyear_setting( date_time )
-       seconds_per_year         = REAL( date_time%days_per_year * seconds_per_day, KIND = wp )
-       date_time%second_of_year = date_time%second_of_year + seconds_per_year
-    ENDDO
-!
-!-- Now, if year is increased
-    DO WHILE ( date_time%second_of_year > seconds_per_year )
-       date_time%year           = date_time%year + 1_iwp
-       date_time                = update_leapyear_setting( date_time )
-       date_time%second_of_year = date_time%second_of_year - seconds_per_year
-       seconds_per_year         = REAL( date_time%days_per_year * seconds_per_day, KIND = wp )
-    ENDDO
-!
-!-- Based on updated year and second_of_year, update month, day, hour, minute, second
-    DO  i = 1, months_per_year
-       IF ( date_time%second_of_year < SUM( date_time%days_per_month(1:i) ) * seconds_per_day )    &
-       THEN
-          date_time%month  = i
-          seconds_left     = date_time%second_of_year                                              &
-                              - REAL( SUM( date_time%days_per_month(1:i-1) ), KIND=wp )            &
-                              * seconds_per_day
-          date_time%day    = INT( seconds_left / seconds_per_day, KIND = iwp ) + 1_iwp
-          seconds_left     = seconds_left                                                          &
-                              - REAL( date_time%day - 1_iwp, KIND = wp ) * seconds_per_day
-          date_time%hour   = INT( seconds_left / seconds_per_hour, KIND = iwp )
-          seconds_left     = seconds_left - REAL( date_time%hour, KIND = wp ) * seconds_per_hour
-          date_time%minute = INT( seconds_left / seconds_per_minute, KIND = iwp )
-          date_time%second = seconds_left - REAL( date_time%minute, KIND = wp ) * seconds_per_minute
-          EXIT
-       ENDIF
-    ENDDO
-
- END FUNCTION add_date_time
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Return day of year of given date.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION get_day_of_year( date_time )  RESULT( day_of_year )
-
-    INTEGER(iwp)                     ::  day_of_year         !< day of the year
-
-    TYPE(date_time_type), INTENT(IN) ::  date_time           !< date of which to calculate day of year
-    TYPE(date_time_type)             ::  date_time_internal  !< internal copy of input date-time
-
-
-    date_time_internal = update_leapyear_setting( date_time )
-
-    day_of_year = date_time_internal%day &
-                + SUM( date_time_internal%days_per_month(:date_time_internal%month-1) )
-
- END FUNCTION get_day_of_year
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Return second of day of given time.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION get_second_of_day( date_time )  RESULT( second_of_day )
-
-    REAL(wp)                         ::  second_of_day  !< second of the day
-
-    TYPE(date_time_type), INTENT(IN) ::  date_time      !< date of which to calculate second of the day
-
-
-    second_of_day = date_time%second                                                               &
-                     + REAL( ( date_time%hour * minutes_per_hour ) + date_time%minute, KIND = wp ) &
-                     * seconds_per_minute
-
- END FUNCTION get_second_of_day
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Return second of year of given date-time.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION get_second_of_year( date_time )  RESULT( second_of_year )
-
-    REAL(wp)                         ::  second_of_year  !< second of the year
-
-    TYPE(date_time_type), INTENT(IN) ::  date_time       !< date of which to calculate second of the year
-
-
-    second_of_year = get_second_of_day( date_time )                                                &
-                     + REAL( get_day_of_year( date_time ) - 1_iwp, KIND = wp ) * seconds_per_day
-
- END FUNCTION get_second_of_year
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Return index of the day of the week of the given date-time.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION get_day_of_week( date_time_in )  RESULT( day_of_week )
-
-    INTEGER(iwp)                     ::  day_difference                            !< day between given date and reference
-    INTEGER(iwp)                     ::  day_of_week                               !< day of the week
-    INTEGER(iwp)                     ::  date_time_internal_reference_day_of_week  !< day of week of reference date
-
-    TYPE(date_time_type), INTENT(IN) ::  date_time_in                              !< date of which to get the weekday
-    TYPE(date_time_type)             ::  date_time_internal                        !< internal date-time
-
-!
-!-- Define reference date from which on the current day of week can be determined
-    date_time_internal%year                  = 2000_iwp
-    date_time_internal%month                 = 1_iwp
-    date_time_internal%day                   = 1_iwp
-    date_time_internal_reference_day_of_week = 6_iwp
-
-!
-!-- First, get the difference if both dates would be in the same year
-    day_difference = get_day_of_year( date_time_in ) - get_day_of_year( date_time_internal )
-!
-!-- Now, shift the year and add the corresponding number of days to the difference
-    IF ( date_time_internal%year < date_time_in%year )  THEN
-
-       DO WHILE ( date_time_internal%year /= date_time_in%year )
-
-          date_time_internal = update_leapyear_setting( date_time_internal )
-          day_difference = day_difference + date_time_internal%days_per_year
-
-          date_time_internal%year = date_time_internal%year + 1_iwp
-
-       ENDDO
-
-    ELSEIF ( date_time_internal%year > date_time_in%year )  THEN
-
-       DO WHILE ( date_time_internal%year /= date_time_in%year )
-
-          date_time_internal%year = date_time_internal%year - 1_iwp
-
-          date_time_internal = update_leapyear_setting( date_time_internal )
-          day_difference = day_difference - date_time_internal%days_per_year
-
-       ENDDO
-
-    ENDIF
-!
-!-- Remove full weeks of day_difference and shift day_of_week of reference by remaining days.
-    day_of_week = date_time_internal_reference_day_of_week + MOD( day_difference, days_per_week )
-
-    IF ( day_of_week > days_per_week )  THEN
-!
-!--    Shift index again if it is next week (above days_per_week)...
-       day_of_week = day_of_week - days_per_week
-    ELSEIF ( day_of_week <= 0_iwp )  THEN
-!
-!--    ...or if it is last week (below 1)
-       day_of_week = day_of_week + days_per_week
-    ENDIF
-
- END FUNCTION get_day_of_week
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check if given year is a leap year and update days per month accordingly.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION update_leapyear_setting( date_time_in )  RESULT( date_time_out )
-
-    TYPE(date_time_type), INTENT(IN) ::  date_time_in   !< input date-time
-    TYPE(date_time_type)             ::  date_time_out  !< return date-time
-
-
-    date_time_out = date_time_in
-
-    IF ( ANY( date_time_in%year == leap_years ) )  THEN
-       date_time_out%days_per_month = days_per_month_leapyear
-    ELSE
-      date_time_out%days_per_month = days_per_month_noleapyear
-    ENDIF
-
-    date_time_out%days_per_year = SUM( date_time_out%days_per_month )
-
- END FUNCTION update_leapyear_setting
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check if given date and time are valid. Returns 0 if all checks are passed.
-!> @todo Revise error message. ATM, gives only last errorneous value even if multiple values violate
-!>       the bounds.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION check_date( date_time, date_time_str )  RESULT( error_code )
-
-
-    CHARACTER(LEN=6), DIMENSION(7), PARAMETER ::  error_str_list =  &  !< string used for error message
-       (/'year  ', 'month ', 'day   ', 'hour  ', 'minute', 'second', 'zone  '/)
-
-    CHARACTER(LEN=date_time_str_len), INTENT(IN) ::  date_time_str     !< date-time as string
-
-    INTEGER(iwp)                                 ::  error_code        !< error code
-
-    TYPE(date_time_type),             INTENT(IN) ::  date_time         !< date-time to be checked
-
-
-    error_code = 0
-!
-!-- Check date
-    IF ( date_time%month < 1_iwp  .OR.  date_time%month > months_per_year )  THEN
-       error_code = 2
-    ELSE
-       IF ( date_time%day < 1_iwp  .OR.                                                            &
-            date_time%day > date_time%days_per_month(date_time%month) )  THEN
-          error_code = 3
-       ENDIF
-    ENDIF
-!
-!-- Check time
-    IF ( date_time%hour < 0_iwp  .OR.  date_time%hour > hours_per_day )  THEN
-       error_code = 4
-    ELSE
-        IF ( date_time%minute < 0_iwp  .OR.  date_time%minute > minutes_per_hour )  THEN
-           error_code = 5
-        ELSE
-           IF ( date_time%second < 0.0_wp  .OR.  date_time%second >= seconds_per_minute )  THEN
-              error_code = 6
-           ENDIF
-        ENDIF
-    ENDIF
-!
-!-- Check time zone.
-!-- Bounds defined by maximum and minimum time zone present on earth
-    IF ( date_time%zone < -12_iwp  .OR.  date_time%zone > 14_iwp )  THEN
-       error_code = 7
-    ENDIF
-!
-!-- Raise error if any check is marked invalid
-    IF ( error_code /= 0 )  THEN
-       WRITE( message_string, * ) 'Date-time values out of bounds: "' //                           &
-                                  TRIM( error_str_list(error_code) ) //                            &
-                                  '" is out of bounds. Please check date-time string: "' //        &
-                                  TRIM( date_time_str ) // '". ' //                                &
-                                  'Format must be "YYYY-MM-DD hh:mm:ss ZZZ".'
-       CALL message( 'check_date', 'PA0679', 2, 2, 0, 6, 0 )
-       RETURN
-    ENDIF
-
- END FUNCTION check_date
-
- END MODULE palm_date_time_mod
Index: palm/trunk/SOURCE/parin.f90
===================================================================
--- palm/trunk/SOURCE/parin.f90	(revision 4901)
+++ palm/trunk/SOURCE/parin.f90	(revision 1)
@@ -1,113 +1,114 @@
-!> @file parin.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ SUBROUTINE parin
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! internal switch removed from namelist
-!
-! 4845 2021-01-18 11:15:37Z raasch
-! -use_cmax
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more,
-! deprecated namelists removed
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! file re-formatted to follow the PALM coding standard
-!
-! 4783 2020-11-13 13:58:45Z raasch
-! bugfix for reading restart data with MPI-I/O (does not work with blockwise I/O)
-!
-! 4680 2020-09-16 10:20:34Z gronemeier
-! Add option to fix date or time of the simulation
-!
-! 4565 2020-06-15 08:30:38Z oliver.maas
-! added pt_surface_heating_rate
-!
-! 4564 2020-06-12 14:03:36Z raasch
-! Vertical nesting method of Huq et al. (2019) removed
-!
-! 4536 2020-05-17 17:24:13Z raasch
-! bugfix for restart data format query
-!
-! 4505 2020-04-20 15:37:15Z schwenkel
-! Add flag for saturation check
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! removed recycling_yshift
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod
-!
-! 4146 2019-08-07 07:47:36Z gronemeier
-! added rotation_angle to initialization_parameters
-!
-! 4191 2019-08-27 15:45:07Z gronemeier
-! bugfix: add recycling_method_for_thermodynamic_quantities to inipar namelist
-!
-! 4183 2019-08-23 07:33:16Z oliver.maas
-! replaced recycle_absolute_quantities by recycling_method_for_thermodynamic_quantities
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4176 2019-08-20 14:10:41Z oliver.maas
-! added recycle_absolute_quantities to initialization_parameters namelist
-!
-! 4173 2019-08-20 12:04:06Z gronemeier
-! add vdi_internal_controls
-!
-! 4131 2019-08-02 11:06:18Z monakurppa
-! Allocate hom and hom_sum to allow profile output for salsa variables.
-!
-! 4079 2019-07-09 18:04:41Z suehring
-! +monotonic_limiter_z
-!
-! 4022 2019-06-12 11:52:39Z suehring
-! Change default top boundary condition for pressure to Neumann in offline nesting case
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! Introduce alternative switch for debug output during timestepping
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3806 2019-03-21 12:45:50Z raasch
-! additional check for lateral boundary conditions added
-!
-! 3747 2019-02-16 15:15:23Z gronemeier
-! removed setting of parameter region
-!
-! 3746 2019-02-16 12:41:27Z gronemeier
-! Removed most_method
-!
-! 3649 2019-01-02 16:52:21Z suehring
-! Delete debug-print statements
-!
+! $Log: parin.f90,v $
+! Revision 1.57  2007/02/11 13:11:22  raasch
+! Values of environment variables are now read from file ENVPAR instead of
+! reading them with a system call, + NAMELIST envpar
+!
+! Revision 1.56  2006/08/22 14:13:56  raasch
+! +dz_max in inipar
+!
+! Revision 1.55  2006/08/04 14:53:43  raasch
+! +use_upstream_for_tke
+!
+! Revision 1.54  2006/03/17 08:45:44  raasch
+! +skip_time_data_output_av
+!
+! Revision 1.53  2006/02/23 12:46:19  raasch
+! parameters for 2d/3d averaging,
+! +conserve_volume_flow, dissipation_1d, e_min, mixing_length_1d, topography, &
+! wall_heatflux in inipar,
+! +data_output, netcdf_64bit, skip_time_dosp, skip_time_dopr, etc. in d3par,
+! allocation of nanz_2dh and nanz_3d moved to init_3d_model, ebene renamed
+! section, average_period_pr1d removed, average_period_pl1d renamed
+! averaging_interval_pr, dt_average renamed dt_averaging_input_pr,
+! +parameters for single building topography settings
+!
+! Revision 1.52  2005/06/29 10:21:15  steinfeld
+! +ug_surface, ug_vertical_gradient, ug_vertical_gradient_level,
+!  vg_surface, vg_vertical_gradient, vg_vertical_gradient_level in inipar;
+! arrays ug and vg are allocated during initialization runs
+!
+! Revision 1.51  2005/06/26 20:06:26  raasch
+! +cloud_droplets in inipar
+!
+! Revision 1.50  2005/05/18 15:40:49  raasch
+! +netcdf_precision in inipar, +data_output_format in d3par
+!
+! Revision 1.49  2005/04/23 09:35:23  raasch
+! fcl_factor renamed cfl_factor
+!
+! Revision 1.48  2005/03/26 20:42:17  raasch
+! +bc_lr, bc_ns, call_psolver_at_all_substeps, inflow_disturbance_begin, &
+! inflow_disturbance_end, km_damp_max, outflow_damping_width in inipar
+!
+! Revision 1.47  2004/04/30 12:32:06  raasch
+! +grid_matching in inipar, impulse_advec renamed momentum_advec
+!
+! Revision 1.46  2003/10/29 09:03:06  raasch
+! +mg_cycles, mg_switch_to_pe0_level in d3par
+!
+! Revision 1.45  2003/03/16 09:42:23  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.44  2003/03/14 13:45:24  raasch
+! +random_generator in inipar
+!
+! Revision 1.43  2003/03/12 16:35:55  raasch
+! Reading of environment variable tasks_per_node moved from poisfft_hybrid
+! to here
+!
+! Revision 1.42  2002/12/19 15:55:31  raasch
+! Saving preliminary process-id-string for opening unit 14 (binary output for
+! restart). Array hom is allocated during first run only, allocation during
+! restart runs will now be done in read_var_list.
+! +dt_restart, restart_time in d3par, STOP statement replaced by call of
+! subroutine local_stop
+!
+! Revision 1.41  2002/04/16 08:10:50  raasch
+! +bc_s_b, bc_s_t, surface_scalarflux, s_surface, s_surface_initial_change,
+! s_vertical_gradient, s_vertical_gradient_level in inipar
+!
+! Revision 1.40  2001/08/21 09:54:27  raasch
+! MPI_COMM_WORLD replaced by comm_palm, +wall_adjustment in inipar
+!
+! Revision 1.39  2001/07/20 13:10:07  raasch
+! +cycle_mg, ngsrb, residual_limit in d3par
+!
+! Revision 1.38  2001/03/30 07:43:55  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.),
+! namelist d3par can also be omitted in the initial run
+!
+! Revision 1.37  2001/01/29 12:30:26  raasch
+! +passive_scalar in inipar
+!
+! Revision 1.36  2001/01/25 07:17:39  raasch
+! +fft_method, use_surface_fluxes in inipar
+!
+! Revision 1.35  2001/01/02 17:32:13  raasch
+! Unit 11 closed at the end of the subroutine
+!
+! Revision 1.34  2000/12/28 13:24:51  raasch
+! Call of package_parin. dt_dvrp and threshold moved
+! from d3par to other namelists in subroutine package_parin
+!
+! Revision 1.33  2000/04/27 06:55:20  raasch
+! +npex, npey in initial parameter list, comments have to be translated yet,
+! -dt_plisos, dt_plpart, +dt_dvrp, threshold, in run-time parameter list,
+! all comments translated into English, old revision remarks deleted
+!
+! Revision 1.32  2000/04/13 13:03:06  schroeter
+! Erweitern der Parameterlist fuer Wolkenphysik
+!
+! Revision 1.31  2000/01/10  10:05:55  10:05:55  raasch (Siegfried Raasch)
+! +use_ug_for_galilei_tr
+! 
 ! Revision 1.1  1997/07/24 11:22:50  raasch
 ! Initial revision
@@ -116,366 +117,106 @@
 ! Description:
 ! ------------
-!> This subroutine reads variables controling the run from the NAMELIST files
-!>
-!> @todo: Revise max_pr_cs (profiles for chemistry)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE parin
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  pt_init, q_init, ref_state, s_init, sa_init, ug, u_init, v_init, vg
-
-    USE chem_modules
-
+! This subroutine reads variables controling the run from the NAMELIST files
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE averaging
     USE control_parameters
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log_barrierwait
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nx, ny, nz
-
-    USE kinds
-
-    USE model_1d_mod,                                                                              &
-        ONLY:  damp_level_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_parin
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  netcdf_data_format, netcdf_deflate, netcdf_precision
-
+    USE grid_variables
+    USE indices
+    USE model_1d
     USE pegrid
-
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run, nesting_mode
-
-    USE profil_parameter,                                                                          &
-        ONLY:  cross_profiles, profile_columns, profile_rows
-
-    USE progress_bar,                                                                              &
-        ONLY :  progress_bar_disabled
-
-    USE read_restart_data_mod,                                                                     &
-        ONLY:  rrd_global
-
-    USE statistics,                                                                                &
-        ONLY:  hom, hom_sum, pr_palm, statistic_regions
-
-    USE turbulence_closure_mod,                                                                    &
-        ONLY:  rans_const_c, rans_const_sigma
-
+    USE profil_parameter
+    USE statistics
 
     IMPLICIT NONE
 
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter
-                                 !< file
-
-    INTEGER(iwp) ::  global_id      !< process id with respect to MPI_COMM_WORLD
-    INTEGER(iwp) ::  global_procs   !< # of procs with respect to MPI_COMM_WORLD
-    INTEGER(iwp) ::  i              !<
-    INTEGER(iwp) ::  io_status      !< status after reading the namelist files
-
-
-    NAMELIST /initialization_parameters/  alpha_surface,                                           &
-                                          approximation,                                           &
-                                          bc_e_b,                                                  &
-                                          bc_lr,                                                   &
-                                          bc_ns,                                                   &
-                                          bc_p_b,                                                  &
-                                          bc_p_t,                                                  &
-                                          bc_pt_b,                                                 &
-                                          bc_pt_t,                                                 &
-                                          bc_q_b,                                                  &
-                                          bc_q_t,                                                  &
-                                          bc_s_b,                                                  &
-                                          bc_s_t,                                                  &
-                                          bc_uv_b,                                                 &
-                                          bc_uv_t,                                                 &
-                                          building_height,                                         &
-                                          building_length_x,                                       &
-                                          building_length_y,                                       &
-                                          building_wall_left,                                      &
-                                          building_wall_south,                                     &
-                                          calc_soil_moisture_during_spinup,                        &
-                                          call_psolver_at_all_substeps,                            &
-                                          canyon_height,                                           &
-                                          canyon_wall_left,                                        &
-                                          canyon_wall_south,                                       &
-                                          canyon_width_x,                                          &
-                                          canyon_width_y,                                          &
-                                          cfl_factor,                                              &
-                                          check_realistic_q,                                       &
-                                          cloud_droplets,                                          &
-                                          collective_wait,                                         &
-                                          complex_terrain,                                         &
-                                          conserve_volume_flow,                                    &
-                                          conserve_volume_flow_mode,                               &
-                                          constant_flux_layer,                                     &
-                                          coupling_start_time,                                     &
-                                          cycle_mg,                                                &
-                                          damp_level_1d,                                           &
-                                          data_output_during_spinup,                               &
-                                          dissipation_1d,                                          &
-                                          dp_external,                                             &
-                                          dp_level_b,                                              &
-                                          dp_smooth, dpdxy,                                        &
-                                          dt,                                                      &
-                                          dt_pr_1d,                                                &
-                                          dt_run_control_1d,                                       &
-                                          dt_spinup,                                               &
-                                          dx,                                                      &
-                                          dy,                                                      &
-                                          dz,                                                      &
-                                          dz_max,                                                  &
-                                          dz_stretch_factor,                                       &
-                                          dz_stretch_level,                                        &
-                                          dz_stretch_level_start,                                  &
-                                          dz_stretch_level_end,                                    &
-                                          e_init,                                                  &
-                                          e_min,                                                   &
-                                          end_time_1d,                                             &
-                                          ensemble_member_nr,                                      &
-                                          fft_method,                                              &
-                                          flux_input_mode,                                         &
-                                          flux_output_mode,                                        &
-                                          galilei_transformation,                                  &
-                                          humidity,                                                &
-                                          inflow_damping_height,                                   &
-                                          inflow_damping_width,                                    &
-                                          inflow_disturbance_begin,                                &
-                                          inflow_disturbance_end,                                  &
-                                          initializing_actions,                                    &
-                                          km_constant,                                             &
-                                          large_scale_forcing,                                     &
-                                          large_scale_subsidence,                                  &
-                                          latitude,                                                &
-                                          longitude,                                               &
-                                          loop_optimization,                                       &
-                                          lsf_exception,                                           &
-                                          masking_method,                                          &
-                                          mg_cycles,                                               &
-                                          mg_switch_to_pe0_level,                                  &
-                                          mixing_length_1d,                                        &
-                                          momentum_advec,                                          &
-                                          monotonic_limiter_z,                                     &
-                                          netcdf_precision,                                        &
-                                          neutral,                                                 &
-                                          ngsrb,                                                   &
-                                          nsor,                                                    &
-                                          nsor_ini,                                                &
-                                          nudging,                                                 &
-                                          nx,                                                      &
-                                          ny,                                                      &
-                                          nz,                                                      &
-                                          omega,                                                   &
-                                          omega_sor,                                               &
-                                          origin_date_time,                                        &
-                                          outflow_source_plane,                                    &
-                                          passive_scalar,                                          &
-                                          prandtl_number,                                          &
-                                          psolver,                                                 &
-                                          pt_damping_factor,                                       &
-                                          pt_damping_width,                                        &
-                                          pt_reference, pt_surface,                                &
-                                          pt_surface_heating_rate,                                 &
-                                          pt_surface_initial_change,                               &
-                                          pt_vertical_gradient,                                    &
-                                          pt_vertical_gradient_level,                              &
-                                          q_surface,                                               &
-                                          q_surface_initial_change,                                &
-                                          q_vertical_gradient,                                     &
-                                          q_vertical_gradient_level,                               &
-                                          random_generator,                                        &
-                                          random_heatflux,                                         &
-                                          rans_const_c,                                            &
-                                          rans_const_sigma,                                        &
-                                          rayleigh_damping_factor,                                 &
-                                          rayleigh_damping_height,                                 &
-                                          recycling_method_for_thermodynamic_quantities,           &
-                                          recycling_width,                                         &
-                                          reference_state,                                         &
-                                          residual_limit,                                          &
-                                          restart_data_format,                                     &
-                                          restart_data_format_input,                               &
-                                          restart_data_format_output,                              &
-                                          rotation_angle,                                          &
-                                          roughness_length,                                        &
-                                          s_surface,                                               &
-                                          s_surface_initial_change,                                &
-                                          s_vertical_gradient,                                     &
-                                          s_vertical_gradient_level,                               &
-                                          scalar_advec,                                            &
-                                          scalar_rayleigh_damping,                                 &
-                                          spinup_time,                                             &
-                                          spinup_pt_amplitude,                                     &
-                                          spinup_pt_mean,                                          &
-                                          statistic_regions,                                       &
-                                          subs_vertical_gradient,                                  &
-                                          subs_vertical_gradient_level,                            &
-                                          surface_heatflux,                                        &
-                                          surface_pressure,                                        &
-                                          surface_scalarflux,                                      &
-                                          surface_waterflux,                                       &
-                                          timestep_scheme,                                         &
-                                          topography,                                              &
-                                          topography_grid_convention,                              &
-                                          top_heatflux,                                            &
-                                          top_momentumflux_u,                                      &
-                                          top_momentumflux_v,                                      &
-                                          top_scalarflux,                                          &
-                                          transpose_compute_overlap,                               &
-                                          tunnel_height,                                           &
-                                          tunnel_length,                                           &
-                                          tunnel_wall_depth,                                       &
-                                          tunnel_width_x,                                          &
-                                          tunnel_width_y,                                          &
-                                          turbulence_closure,                                      &
-                                          turbulent_inflow,                                        &
-                                          turbulent_outflow,                                       &
-                                          u_bulk,                                                  &
-                                          u_profile,                                               &
-                                          ug_surface,                                              &
-                                          ug_vertical_gradient,                                    &
-                                          ug_vertical_gradient_level,                              &
-                                          use_fixed_date,                                          &
-                                          use_fixed_time,                                          &
-                                          use_free_convection_scaling,                             &
-                                          use_ug_for_galilei_tr,                                   &
-                                          use_subsidence_tendencies,                               &
-                                          use_surface_fluxes,                                      &
-                                          use_top_fluxes,                                          &
-                                          use_upstream_for_tke,                                    &
-                                          uv_heights,                                              &
-                                          v_bulk,                                                  &
-                                          v_profile,                                               &
-                                          vdi_checks,                                              &
-                                          vg_surface,                                              &
-                                          vg_vertical_gradient,                                    &
-                                          vg_vertical_gradient_level,                              &
-                                          wall_adjustment,                                         &
-                                          wall_heatflux,                                           &
-                                          wall_humidityflux,                                       &
-                                          wall_scalarflux,                                         &
-                                          y_shift,                                                 &
-                                          zeta_max,                                                &
-                                          zeta_min,                                                &
-                                          z0h_factor
-
-    NAMELIST /runtime_parameters/  averaging_interval,                                             &
-                                   averaging_interval_pr,                                          &
-                                   cpu_log_barrierwait,                                            &
-                                   create_disturbances,                                            &
-                                   cross_profiles,                                                 &
-                                   data_output,                                                    &
-                                   data_output_2d_on_each_pe,                                      &
-                                   data_output_masks,                                              &
-                                   data_output_pr,                                                 &
-                                   debug_output,                                                   &
-                                   debug_output_timestep,                                          &
-                                   disturbance_amplitude,                                          &
-                                   disturbance_energy_limit,                                       &
-                                   disturbance_level_b,                                            &
-                                   disturbance_level_t,                                            &
-                                   do2d_at_begin,                                                  &
-                                   do3d_at_begin,                                                  &
-                                   dt,                                                             &
-                                   dt_averaging_input,                                             &
-                                   dt_averaging_input_pr,                                          &
-                                   dt_coupling,                                                    &
-                                   dt_data_output,                                                 &
-                                   dt_data_output_av,                                              &
-                                   dt_disturb,                                                     &
-                                   dt_domask,                                                      &
-                                   dt_dopr,                                                        &
-                                   dt_dopr_listing,                                                &
-                                   dt_dots,                                                        &
-                                   dt_do2d_xy,                                                     &
-                                   dt_do2d_xz,                                                     &
-                                   dt_do2d_yz,                                                     &
-                                   dt_do3d,                                                        &
-                                   dt_max,                                                         &
-                                   dt_restart,                                                     &
-                                   dt_run_control,                                                 &
-                                   end_time,                                                       &
-                                   force_print_header,                                             &
-                                   mask_k_over_surface,                                            &
-                                   mask_scale_x,                                                   &
-                                   mask_scale_y,                                                   &
-                                   mask_scale_z,                                                   &
-                                   mask_x,                                                         &
-                                   mask_y,                                                         &
-                                   mask_z,                                                         &
-                                   mask_x_loop,                                                    &
-                                   mask_y_loop,                                                    &
-                                   mask_z_loop,                                                    &
-                                   netcdf_data_format,                                             &
-                                   netcdf_deflate,                                                 &
-                                   normalizing_region,                                             &
-                                   npex,                                                           &
-                                   npey,                                                           &
-                                   nz_do3d,                                                        &
-                                   profile_columns,                                                &
-                                   profile_rows,                                                   &
-                                   restart_time,                                                   &
-                                   section_xy,                                                     &
-                                   section_xz,                                                     &
-                                   section_yz,                                                     &
-                                   restart_data_format,                                            &
-                                   restart_data_format_input,                                      &
-                                   restart_data_format_output,                                     &
-                                   skip_time_data_output,                                          &
-                                   skip_time_data_output_av,                                       &
-                                   skip_time_dopr,                                                 &
-                                   skip_time_do2d_xy,                                              &
-                                   skip_time_do2d_xz,                                              &
-                                   skip_time_do2d_yz,                                              &
-                                   skip_time_do3d,                                                 &
-                                   skip_time_domask,                                               &
-                                   synchronous_exchange,                                           &
-                                   termination_time_needed
-
-    NAMELIST /envpar/  host,                                                                       &
-                       maximum_cpu_time_allowed,                                                   &
-                       maximum_parallel_io_streams,                                                &
-                       progress_bar_disabled,                                                      &
-                       read_svf,                                                                   &
-                       revision,                                                                   &
-                       run_identifier,                                                             &
-                       tasks_per_node,                                                             &
-                       write_binary,                                                               &
-                       write_svf
-
-!
-!-- First read values of environment variables (this NAMELIST file is generated by palmrun)
-    CALL location_message( 'reading environment parameters from ENVPAR', 'start' )
-
-    OPEN( 90, FILE='ENVPAR', STATUS='OLD', FORM='FORMATTED', IOSTAT=io_status )
-
-    IF ( io_status /= 0 )  THEN
-       message_string = 'local file ENVPAR not found' //                                           &
-                        '&some variables for steering may not be properly set'
-       CALL message( 'parin', 'PA0276', 0, 1, 0, 6, 0 )
-    ELSE
-       READ( 90, envpar, IOSTAT=io_status )
-       IF ( io_status < 0 )  THEN
-          message_string = 'no envpar-NAMELIST found in local file '  //                           &
-                           'ENVPAR& or some variables for steering may not be properly set'
-          CALL message( 'parin', 'PA0278', 0, 1, 0, 6, 0 )
-       ELSEIF ( io_status > 0 )  THEN
-          message_string = 'errors in local file ENVPAR' //                                        &
-                           '&some variables for steering may not be properly set'
-          CALL message( 'parin', 'PA0277', 0, 1, 0, 6, 0 )
-       ENDIF
-       CLOSE( 90 )
-    ENDIF
-
-    CALL location_message( 'reading environment parameters from ENVPAR', 'finished' )
-
-    CALL location_message( 'reading NAMELIST parameters from PARIN', 'start' )
+    INTEGER ::  idum
+
+
+    NAMELIST /inipar/  adjust_mixing_length, alpha_surface, bc_e_b, bc_lr, &
+                       bc_ns, bc_p_b, bc_p_t, bc_pt_b, bc_pt_t, bc_q_b, &
+                       bc_q_t,bc_s_b, bc_s_t, bc_uv_b, bc_uv_t, &
+                       building_height, building_length_x, building_length_y, &
+                       building_wall_left, building_wall_south, &
+                       cloud_droplets, cloud_physics, conserve_volume_flow, &
+                       cut_spline_overshoot, damp_level_1d, dissipation_1d, &
+                       dt, dt_pr_1d, dt_run_control_1d, dx, dy, dz, dz_max, &
+                       dz_stretch_factor, dz_stretch_level, e_min, &
+                       end_time_1d, fft_method, galilei_transformation, &
+                       grid_matching, inflow_disturbance_begin, &
+                       inflow_disturbance_end, initializing_actions, &
+                       km_constant, km_damp_max, long_filter_factor, &
+                       mixing_length_1d, moisture, momentum_advec, &
+                       netcdf_precision, npex, npey, nsor_ini, nx, ny, nz, &
+                       omega, outflow_damping_width, overshoot_limit_e, &
+                       overshoot_limit_pt, overshoot_limit_u, &
+                       overshoot_limit_v, overshoot_limit_w, passive_scalar, &
+                       phi, prandtl_layer, precipitation, pt_surface, &
+                       pt_surface_initial_change, pt_vertical_gradient, &
+                       pt_vertical_gradient_level, q_surface, &
+                       q_surface_initial_change, q_vertical_gradient, &
+                       q_vertical_gradient_level, radiation, random_generator, &
+                       random_heatflux, rif_max, rif_min, roughness_length, &
+                       scalar_advec, statistic_regions, surface_heatflux, &
+                       surface_pressure, surface_scalarflux, surface_waterflux,&
+                       s_surface, s_surface_initial_change, &
+                       s_vertical_gradient, s_vertical_gradient_level, &
+                       timestep_scheme, topography, ug_surface, &
+                       ug_vertical_gradient, ug_vertical_gradient_level, &
+                       ups_limit_e, ups_limit_pt, ups_limit_u, ups_limit_v, &
+                       ups_limit_w, use_surface_fluxes, use_ug_for_galilei_tr, &
+                       use_upstream_for_tke, vg_surface, vg_vertical_gradient, &
+                       vg_vertical_gradient_level, wall_adjustment, &
+                       wall_heatflux
+
+
+    NAMELIST /d3par/   averaging_interval,  averaging_interval_pr, &
+                       call_psolver_at_all_substeps, cfl_factor, &
+                       create_disturbances, cross_normalized_x, &
+                       cross_normalized_y, cross_profiles, cross_ts_uymax, &
+                       cross_ts_uymin, cross_xtext, cycle_mg, data_output, &
+                       data_output_format, data_output_pr, data_output_ts, &
+                       data_output_2d_on_each_pe, disturbance_amplitude, &
+                       disturbance_energy_limit, disturbance_level_b, &
+                       disturbance_level_t, do2d_at_begin, do3d_at_begin, &
+                       do3d_compress, do3d_comp_prec, dt, dt_averaging_input, &
+                       dt_averaging_input_pr, dt_data_output, &
+                       dt_data_output_av, dt_disturb, dt_dopr, &
+                       dt_dopr_listing, dt_dots, dt_do2d_xy, dt_do2d_xz, &
+                       dt_do2d_yz, dt_do3d, dt_restart, dt_run_control, &
+                       end_time, force_print_header, mg_cycles, &
+                       mg_switch_to_pe0_level, netcdf_64bit, ngsrb, &
+                       normalizing_region, nsor, nz_do3d, omega_sor, &
+                       prandtl_number, profile_columns, profile_rows, psolver, &
+                       rayleigh_damping_factor, rayleigh_damping_height, &
+                       residual_limit, restart_time, section_xy, section_xz, &
+                       section_yz, skip_time_data_output, &
+                       skip_time_data_output_av, skip_time_dopr, &
+                       skip_time_dosp, skip_time_do2d_xy, skip_time_do2d_xz, &
+                       skip_time_do2d_yz, skip_time_do3d, &
+                       termination_time_needed, use_prior_plot1d_parameters, &
+                       z_max_do1d, z_max_do1d_normalized, z_max_do2d
+
+
+    NAMELIST /envpar/  host, maximum_cpu_time_allowed, run_identifier, &
+                       tasks_per_node, write_binary
+
+
+#if defined( __parallel )
+!
+!-- Preliminary determination of processor-id which is needed here to open the
+!-- input files belonging to the corresponding processor and to produce
+!-- messages by PE0 only (myid and myid_char are later determined in
+!-- init_pegrid)
+    CALL MPI_COMM_RANK( comm_palm, myid, ierr )
+    WRITE (myid_char,'(''_'',I4.4)')  myid
+!
+!-- Since on IBM machines the process rank may be changed when the final
+!-- communicator is defined, save the preliminary processor-id for opening
+!-- the binary output file for restarts (unit 14), because otherwise
+!-- a mismatch occurs when reading this file in the next job
+    myid_char_14 = myid_char
+#endif
 
 !
@@ -485,284 +226,86 @@
 !
 !-- Read the control parameters for initialization.
-!-- The namelist "initialisation_parameters" must be provided in the NAMELIST-file.
-    READ( 11, initialization_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status > 0 )  THEN
-!
-!--    initialisation_parameters namelist was found but countained errors. Print an error message
-!-     including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'initialization_parameters', line )
-
-    ELSEIF ( io_status < 0 )  THEN
-!
-!--    initialisation_parametes namelist was not found. Return a message.
-       message_string = 'no initialization_parameters-namelist found'
-       CALL message( 'parin', 'PA0272', 1, 2, 0, 6, 0 )
-
-    ENDIF
-!
-!-- Try to read runtime parameters given by the user for this run (namelist "runtime_parameters").
-!-- The namelist "runtime_parmeters" can be omitted. In that case default values are used for the
-!-- parameters.
-    REWIND( 11 )
-    READ( 11, runtime_parameters, IOSTAT=io_status )
-
-    IF ( io_status > 0 )  THEN
-!
-!--    Namelist runtime_parameters was found but contained errors. Print an error message including
-!--    the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'runtime_parameters', line )
-
-    ENDIF
-
-!
-!-- Check for module namelists and read them
-    CALL module_interface_parin
-
-!
-!-- Calculate the number of groups into which parallel I/O is split.
-!-- The default for files which are opened by all PEs (or where each PE opens its own independent
-!-- file) is, that all PEs are doing input/output in parallel at the same time. This might cause
-!-- performance or even more severe problems depending on the configuration of the underlying file
-!-- system.
-!-- Calculation of the number of blocks and the I/O group must be based on all PEs involved in this
-!-- run. Since myid and numprocs are related to the comm2d communicator, which gives only a subset
-!-- of all PEs in case of nested runs, that information must be inquired again from the global
-!-- communicator.
-!-- First, set the default:
-#if defined( __parallel )
-    CALL MPI_COMM_RANK( MPI_COMM_WORLD, global_id, ierr )
-    CALL MPI_COMM_SIZE( MPI_COMM_WORLD, global_procs, ierr )
-#else
-    global_id    = 0
-    global_procs = 1
-#endif
-    IF ( maximum_parallel_io_streams == -1  .OR.  maximum_parallel_io_streams > global_procs )  THEN
-       maximum_parallel_io_streams = global_procs
-    ENDIF
-!
-!-- Now calculate the number of io_blocks and the io_group to which the respective PE belongs. I/O
-!-- of the groups is done in serial, but in parallel for all PEs belonging to the same group.
-    io_blocks = global_procs / maximum_parallel_io_streams
-    io_group  = MOD( global_id+1, io_blocks )
-
-!
-!-- If required, read control parameters from restart file (produced by a prior run). All PEs are
-!-- reading from file created by PE0 (see check_open)
-    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
-
-!
-!--    If not set by the user in the runtime parameters, the data format for restart input needs to
-!--    be set now! This is normally done later in check parameters.
-       IF ( TRIM( restart_data_format ) /= 'fortran_binary'  .AND.                                 &
-            TRIM( restart_data_format ) /= 'mpi'             .AND.                                 &
-            TRIM( restart_data_format ) /= 'mpi_shared_memory' )  THEN
-          message_string = 'illegal restart data format "' // TRIM( restart_data_format ) // '"'
-          CALL message( 'parin', 'PA0724', 1, 2, 0, 6, 0 )
-       ENDIF
-       IF ( TRIM( restart_data_format_input ) == 'undefined' )  THEN
-          restart_data_format_input = restart_data_format
-       ENDIF
-
-!
-!--    Blockwise I/O does not work together with MPI-I/O
-       IF ( restart_data_format_input(1:3) == 'mpi'  .AND.  io_blocks /= 1 )  THEN
-          CALL rrd_global
-       ELSE
-!
-!--       Data is read in parallel by groups of PEs
-          DO  i = 0, io_blocks-1
-             IF ( i == io_group )  THEN
-                CALL rrd_global
-             ENDIF
-#if defined( __parallel )
-             CALL MPI_BARRIER( comm2d, ierr )
-#endif
-          ENDDO
-       ENDIF
-
-
+!-- The namelist "inipar" must be provided in the NAMELIST-file. If this is
+!-- not the case and the file contains - instead of "inipar" - any other
+!-- namelist, a read error is created on t3e and control is transferred
+!-- to the statement with label 10. Therefore, on t3e machines one can not
+!-- distinguish between errors produced by a wrong "inipar" namelist or
+!-- because this namelist is totally missing.
+    READ ( 11, inipar, ERR=10, END=11 )
+    GOTO 12
+ 10 IF ( myid == 0 )  THEN
+       PRINT*, '+++ parin: errors in \$inipar'
+       PRINT*, '           or no \$inipar-namelist found (CRAY-machines only)' 
+    ENDIF
+    CALL local_stop
+ 11 IF ( myid == 0 )  THEN
+       PRINT*, '+++ parin: no \$inipar-namelist found'
+    ENDIF
+    CALL local_stop
+
+!
+!-- If required, read control parameters from restart file (produced by
+!-- a prior run)
+ 12 IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
+
+       CALL read_var_list
 !
 !--    Increment the run count
        runnr = runnr + 1
-!
-!--    In case of a restart run, the number of user-defined profiles on the restart file (already
-!--    stored in max_pr_user) has to match the one given for the current run. max_pr_user_tmp is
-!--    calculated in user_parin and max_pr_user is read in via rrd_global.
-       IF ( max_pr_user /= max_pr_user_tmp )  THEN
-          WRITE( message_string, * ) 'the number of user-defined ',                                &
-                                     'profiles given in data_output_pr (', max_pr_user_tmp,        &
-                                     ') does not match the one ',                                  &
-                                     'found in the restart file (', max_pr_user, ')'
-          CALL message( 'user_parin', 'UI0009', 1, 2, 0, 6, 0 )
-       ENDIF
+
     ELSE
-       max_pr_user = max_pr_user_tmp
-    ENDIF
-!
-!-- Activate spinup
-    IF ( land_surface  .OR.  urban_surface )  THEN
-       IF ( spinup_time > 0.0_wp )  THEN
-          coupling_start_time = spinup_time
-          time_since_reference_point = simulated_time - coupling_start_time
-          IF ( spinup_pt_mean == 9999999.9_wp )  THEN
-             spinup_pt_mean = pt_surface
+!
+!--    This is not a restart job.
+!--    Check, if the grid point numbers are well defined.
+       IF ( nx <= 0 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ parin: no value or wrong value given for nx: nx=', nx
           ENDIF
-          end_time = end_time + spinup_time
-          IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-             spinup = .TRUE.
-          ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .AND.                      &
-                   time_since_reference_point > 0.0_wp )  THEN
-             data_output_during_spinup = .FALSE.  !< required for correct ntdim calculation
-                                                  !< in check_parameters for restart run
-          ENDIF
-       ENDIF
-    ENDIF
-
-!
-!-- In case of nested runs, explicitly set nesting boundary conditions.
-!-- This will overwrite the user settings and basic defaults.
-!-- bc_lr and bc_ns always need to be cyclic for vertical nesting.
-    IF ( nested_run )  THEN
-       IF ( nesting_mode == 'vertical' )  THEN
-          IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
-             WRITE ( message_string, *) 'bc_lr and bc_ns were set to ,',                           &
-                                        'cyclic for vertical nesting'
-             CALL message( 'parin', 'PA0428', 0, 0, 0, 6, 0 )
-             bc_lr   = 'cyclic'
-             bc_ns   = 'cyclic'
-          ENDIF
-          IF ( child_domain )  THEN
-             bc_uv_t  = 'nested'
-             bc_pt_t  = 'nested'
-             bc_q_t   = 'nested'
-             bc_s_t   = 'nested'
-             bc_cs_t  = 'nested'
-             bc_p_t   = 'neumann'
-          ENDIF
-!
-!--    For other nesting modes only set boundary conditions for nested domains.
-       ELSE
-          IF ( child_domain )  THEN
-             bc_lr    = 'nested'
-             bc_ns    = 'nested'
-             bc_uv_t  = 'nested'
-             bc_pt_t  = 'nested'
-             bc_q_t   = 'nested'
-             bc_s_t   = 'nested'
-             bc_cs_t  = 'nested'
-             bc_p_t   = 'neumann'
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- Set boundary conditions also in case the model is offline-nested in larger-scale models.
-    IF ( nesting_offline )  THEN
-       bc_lr    = 'nesting_offline'
-       bc_ns    = 'nesting_offline'
-       bc_uv_t  = 'nesting_offline'
-       bc_pt_t  = 'nesting_offline'
-       bc_q_t   = 'nesting_offline'
-     !  bc_s_t   = 'nesting_offline'  ! scalar boundary condition is not clear yet
-     !  bc_cs_t  = 'nesting_offline'  ! same for chemical species
-       bc_p_t   = 'neumann'
-    ENDIF
-
-!
-!-- In case of nested runs, make sure that initializing_actions = 'set_constant_profiles' even
-!-- though the constant-profiles initializations for the prognostic variables will be overwritten by
-!-- pmci_child_initialize and pmci_parent_initialize. This is, however, important e.g. to make sure
-!-- that diagnostic variables are set properly. An exception is made in case of restart runs and if
-!-- user decides to do everything by its own.
-    IF ( child_domain  .AND.  .NOT. ( TRIM( initializing_actions ) == 'read_restart_data'     .OR. &
-                                      TRIM( initializing_actions ) == 'set_constant_profiles' .OR. &
-                                      TRIM( initializing_actions ) == 'by_user' )                  &
-                                    )  THEN
-       message_string = 'initializing_actions = ' // TRIM( initializing_actions ) //               &
-                        ' has been ' // 'changed to set_constant_profiles in child ' // 'domain.'
-       CALL message( 'parin', 'PA0492', 0, 0, 0, 6, 0 )
-
-       initializing_actions = 'set_constant_profiles'
-    ENDIF
-!
-!-- Check validity of lateral boundary conditions. This has to be done here because they are already
-!-- used in init_pegrid and init_grid and therefore cannot be check in check_parameters
-    IF ( bc_lr /= 'cyclic'               .AND.  bc_lr /= 'dirichlet/radiation'  .AND.              &
-         bc_lr /= 'radiation/dirichlet'  .AND.  bc_lr /= 'nested'               .AND.              &
-         bc_lr /= 'nesting_offline' )  THEN
-       message_string = 'unknown boundary condition: bc_lr = "' // TRIM( bc_lr ) // '"'
-       CALL message( 'parin', 'PA0049', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( bc_ns /= 'cyclic'               .AND.  bc_ns /= 'dirichlet/radiation'  .AND.              &
-         bc_ns /= 'radiation/dirichlet'  .AND.  bc_ns /= 'nested'               .AND.              &
-         bc_ns /= 'nesting_offline' )  THEN
-       message_string = 'unknown boundary condition: bc_ns = "' // TRIM( bc_ns ) // '"'
-       CALL message( 'parin', 'PA0050', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Set internal variables used for speed optimization in if clauses
-    IF ( bc_lr /= 'cyclic' )               bc_lr_cyc    = .FALSE.
-    IF ( bc_lr == 'dirichlet/radiation' )  bc_lr_dirrad = .TRUE.
-    IF ( bc_lr == 'radiation/dirichlet' )  bc_lr_raddir = .TRUE.
-    IF ( bc_ns /= 'cyclic' )               bc_ns_cyc    = .FALSE.
-    IF ( bc_ns == 'dirichlet/radiation' )  bc_ns_dirrad = .TRUE.
-    IF ( bc_ns == 'radiation/dirichlet' )  bc_ns_raddir = .TRUE.
-!
-!-- Radiation-Dirichlet conditions are allowed along one of the horizontal directions only.
-!-- In general, such conditions along x and y may work, but require a) some code changes (e.g.
-!-- concerning allocation of c_u, c_v ... arrays), and b) a careful model setup by the user, in
-!-- order to guarantee that there is a clearly defined outflow at two sides.
-!-- Otherwise, the radiation condition may produce wrong results.
-    IF ( ( bc_lr_dirrad .OR. bc_lr_raddir )  .AND.  ( bc_ns_dirrad .OR. bc_ns_raddir ) )  THEN
-       message_string = 'bc_lr = "' // TRIM( bc_lr ) // '" and bc_ns = "' // TRIM( bc_ns ) //      &
-                        '" are not allowed to be set at the same time'
-       CALL message( 'parin', 'PA0589', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check in case of initial run, if the grid point numbers are well defined and allocate some
-!-- arrays which are already needed in init_pegrid or check_parameters. During restart jobs, these
-!-- arrays will be allocated in rrd_global. All other arrays are allocated in init_3d_model.
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-
-       IF ( nx <= 0 )  THEN
-          WRITE( message_string, * ) 'no value or wrong value given', ' for nx: nx=', nx
-          CALL message( 'parin', 'PA0273', 1, 2, 0, 6, 0 )
+          CALL local_stop
        ENDIF
        IF ( ny <= 0 )  THEN
-          WRITE( message_string, * ) 'no value or wrong value given', ' for ny: ny=', ny
-          CALL message( 'parin', 'PA0274', 1, 2, 0, 6, 0 )
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ parin: no value or wrong value given for ny: ny=', ny
+          ENDIF
+          CALL local_stop
        ENDIF
        IF ( nz <= 0 )  THEN
-          WRITE( message_string, * ) 'no value or wrong value given', ' for nz: nz=', nz
-          CALL message( 'parin', 'PA0275', 1, 2, 0, 6, 0 )
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ parin: no value or wrong value given for nz: nz=', nz
+          ENDIF
+          CALL local_stop
        ENDIF
 
 !
-!--    As a side condition, routine flow_statistics require at least 14 vertical grid levels (they
-!--    are used to store time-series data)
-!>     @todo   Remove this restriction
-       IF ( nz < 14 )  THEN
-          WRITE( message_string, * ) 'nz >= 14 is required'
-          CALL message( 'parin', 'PA0362', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    ATTENTION: in case of changes to the following statement please also check the allocate
-!--               statement in routine rrd_global
-       ALLOCATE( pt_init(0:nz+1), q_init(0:nz+1), s_init(0:nz+1),                                  &
-                 ref_state(0:nz+1), sa_init(0:nz+1), ug(0:nz+1),                                   &
-                 u_init(0:nz+1), v_init(0:nz+1), vg(0:nz+1),                                       &
-                 hom(0:nz+1,2,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:statistic_regions),     &
-                 hom_sum(0:nz+1,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:statistic_regions) )
-
-       hom = 0.0_wp
-
-    ENDIF
+!--    Allocate arrays which will be already initialized in init_pegrid or
+!--    check_parameters. During restart jobs, these arrays will be allocated
+!--    in read_var_list. All other arrays are allocated in init_3d_model.
+       ALLOCATE( ug(0:nz+1), vg(0:nz+1), &
+                 pt_init(0:nz+1), q_init(0:nz+1), u_init(0:nz+1), &
+                 v_init(0:nz+1),                                  &
+                 hom(0:nz+1,2,var_hom,0:statistic_regions) )
+       hom = 0.0
+
+    ENDIF
+
+!
+!-- Definition of names of areas used for computing statistics. They must
+!-- be defined at this place, because they are allowed to be redefined by
+!-- the user in user_parin.
+    region = 'total domain'
+
+!
+!-- Read runtime parameters given by the user for this run (namelist "d3par").
+!-- The namelist "d3par" can be omitted. In that case, default values are
+!-- used for the parameters.
+    READ ( 11, d3par, END=20 )
+
+!
+!-- Read control parameters for optionally used model software packages
+ 20 CALL package_parin
+
+!
+!-- Read user-defined variables
+    CALL user_parin
 
 !
@@ -770,5 +313,29 @@
     CALL close_file( 11 )
 
-    CALL location_message( 'reading NAMELIST parameters from PARIN', 'finished' )
+!
+!-- Read values of environment variables (this NAMELIST file is generated by
+!-- mrun)
+    OPEN ( 90, FILE='ENVPAR', STATUS='OLD', FORM='FORMATTED', ERR=30 )
+    READ ( 90, envpar, ERR=31, END=32 )
+    CLOSE ( 90 )
+    RETURN
+
+ 30 IF ( myid == 0 )  THEN
+       PRINT*, '+++ parin: WARNING: local file ENVPAR not found'
+       PRINT*, '           some variables for steering may not be properly set'
+    ENDIF
+    RETURN
+
+ 31 IF ( myid == 0 )  THEN
+       PRINT*, '+++ parin: WARNING: errors in local file ENVPAR'
+       PRINT*, '           some variables for steering may not be properly set'
+    ENDIF
+    RETURN
+
+ 32 IF ( myid == 0 )  THEN
+       PRINT*, '+++ parin: WARNING: no envpar-NAMELIST found in local file ', &
+                           'ENVPAR'
+       PRINT*, '           some variables for steering may not be properly set'
+    ENDIF
 
  END SUBROUTINE parin
Index: palm/trunk/SOURCE/plant_canopy_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/plant_canopy_model_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2696 +1,0 @@
-!> @file plant_canopy_model_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-! Copyright 2017-2021 Institute of Computer Science of the
-!                     Czech Academy of Sciences, Prague
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more,
-! deprecaed namelist name removed
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! file re-formatted to follow the PALM coding standard
-!
-! 4770 2020-11-03 14:04:53Z suehring
-! Consider basal-area density as an additional sink for momentum in the prognostic equations for
-! momentum and SGS TKE
-!
-! 4768 2020-11-02 19:11:23Z suehring
-! Enable 3D data output also with 64-bit precision
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4525 2020-05-10 17:05:07Z raasch
-! bugfix for reading/writing pcm_...rate_av with MPI-IO
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO for reading local arrays
-!
-! 4515 2020-04-30 16:37:18Z suehring
-! Rename error number again since this was recently given in -r 4511
-!
-! 4514 2020-04-30 16:29:59Z suehring
-! - Bugfix in output of pcm_heatrate_av in a restart run. In order to fix this, pch_index is now
-!   output for a restart run. Therefore, define global restart routines.
-! - Error message number renamed and check for PA0505 revised in order to also consider natural
-!   surfaces with plant-canopy.
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4457 2020-03-11 14:20:43Z raasch
-!
-! use statement for exchange horiz added
-! (salim) removed the error message PA0672 to consider PC 3d data via ascii file
-!
-! 4392 2020-01-31 16:14:57Z pavelkrc (resler)
-! Make pcm_heatrate_av, pcm_latentrate_av public to allow calculation of averaged Bowen ratio in the
-! user procedure
-!
-! 4381 2020-01-20 13:51:46Z suehring
-! Give error message 313 only once
-!
-! 4363 2020-01-07 18:11:28Z suehring
-! Fix for last commit
-!
-! 4362 2020-01-07 17:15:02Z suehring
-! Input of plant canopy variables from static driver moved to plant-canopy model
-!
-! 4361 2020-01-07 12:22:38Z suehring
-! - Remove unused arrays in pmc_rrd_local
-! - Remove one exchange of ghost points
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! - Bugfix, read restart data for time-averaged pcm output quantities
-! - Output of plant-canopy quantities will fill values
-!
-! 4356 2019-12-20 17:09:33Z suehring
-! Correct single message call, local check must be given by the respective mpi rank.
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4342 2019-12-16 13:49:14Z Giersch
-! Use statements moved to module level, ocean dependency removed, redundant variables removed
-!
-! 4341 2019-12-16 10:43:49Z motisi
-! - Unification of variable names: pc_-variables now pcm_-variables (pc_latent_rate,
-!                                  pc_heating_rate, pc_transpiration_rate)
-! - Removal of pcm_bowenratio output
-! - Renamed canopy-mode 'block' to 'homogeneous'
-! - Renamed value 'read_from_file_3d' to 'read_from_file'
-! - Removal of confusing comment lines
-! - Replacement of k_wall by topo_top_ind
-! - Removal of Else-Statement in tendency-calculation
-!
-! 4335 2019-12-12 16:39:05Z suehring
-! Fix for LAD at building edges also implemented in vector branch.
-!
-! 4331 2019-12-10 18:25:02Z suehring
-! Typo corrected
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4314 2019-11-29 10:29:20Z suehring
-! - Bugfix, plant canopy was still considered at building edges on for the u- and v-component.
-! - Relax restriction of LAD on building tops. LAD is only omitted at locations where building grid
-!   points emerged artificially by the topography filtering.
-!
-! 4309 2019-11-26 18:49:59Z suehring
-! Typo
-!
-! 4302 2019-11-22 13:15:56Z suehring
-! Omit tall canopy mapped on top of buildings
-!
-! 4279 2019-10-29 08:48:17Z scharf
-! unused variables removed
-!
-! 4258 2019-10-07 13:29:08Z scharf
-! changed check for static driver and fixed bugs in initialization and header
-!
-! 4258 2019-10-07 13:29:08Z suehring
-! Check if any LAD is prescribed when plant-canopy model is applied.
-!
-! 4226 2019-09-10 17:03:24Z suehring
-! Bugfix, missing initialization of heating rate
-!
-! 4221 2019-09-09 08:50:35Z suehring
-! Further bugfix in 3d data output for plant canopy
-!
-! 4216 2019-09-04 09:09:03Z suehring
-! Bugfixes in 3d data output
-!
-! 4205 2019-08-30 13:25:00Z suehring
-! Missing working precision + bugfix in calculation of wind speed
-!
-! 4188 2019-08-26 14:15:47Z suehring
-! Minor adjustment in error number
-!
-! 4187 2019-08-26 12:43:15Z suehring
-! Give specific error numbers instead of PA0999
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4127 2019-07-30 14:47:10Z suehring
-! Output of 3D plant canopy variables changed. It is now relative to the local terrain rather than
-! located at the acutal vertical level in the model. This way, the vertical dimension of the output
-! can be significantly reduced.
-! (merge from branch resler)
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3864 2019-04-05 09:01:56Z monakurppa
-! unsed variables removed
-!
-! 3745 2019-02-15 18:57:56Z suehring
-! Bugfix in transpiration, floating invalid when temperature becomes > 40 degrees
-!
-! 3744 2019-02-15 18:38:58Z suehring
-! Some interface calls moved to module_interface + cleanup
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! unused variables removed
-!
-! 138 2007-11-28 10:03:58Z letzel
-! Initial revision
-!
-! Description:
-! ------------
-!> 1) Initialization of the canopy model, e.g. construction of leaf area density profile
-!>    (subroutine pcm_init).
-!> 2) Calculation of sinks and sources of momentum, heat and scalar concentration due to canopy
-!>    elements (subroutine pcm_tendency).
-!
-! @todo - precalculate constant terms in pcm_calc_transpiration_rate
-! @todo - unify variable names (pcm_, pc_, ...)
-! @todo - get rid-off dependency on radiation model
-!--------------------------------------------------------------------------------------------------!
- MODULE plant_canopy_model_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzu, dzw, e, exner, hyp, pt, q, s, tend, u, v, w, zu, zw
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  c_p, degc_to_k, l_v, lv_d_cp, r_d, rd_d_rv
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY: bulk_cloud_model, microphysics_seifert
-
-    USE control_parameters,                                                                        &
-        ONLY: average_count_3d,                                                                    &
-              coupling_char,                                                                       &
-              debug_output,                                                                        &
-              dt_3d,                                                                               &
-              dz,                                                                                  &
-              humidity,                                                                            &
-              land_surface,                                                                        &
-              length,                                                                              &
-              message_string,                                                                      &
-              ocean_mode,                                                                          &
-              passive_scalar,                                                                      &
-              plant_canopy,                                                                        &
-              restart_data_format_output,                                                          &
-              restart_string,                                                                      &
-              urban_surface
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nysv, nz, nzb, nzt,         &
-               topo_top_ind, wall_flags_total_0
-
-    USE kinds
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  char_fill,                                                                          &
-               check_existence,                                                                    &
-               close_input_file,                                                                   &
-               get_attribute,                                                                      &
-               get_dimension_length,                                                               &
-               get_variable,                                                                       &
-               input_file_static,                                                                  &
-               input_pids_static,                                                                  &
-               inquire_num_variables,                                                              &
-               inquire_variable_names,                                                             &
-               num_var_pids,                                                                       &
-               open_read_file,                                                                     &
-               pids_id,                                                                            &
-               real_3d,                                                                            &
-               vars_pids
-
-    USE pegrid
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_check_array,                                                              &
-               rrd_mpi_io,                                                                         &
-               wrd_mpi_io
-
-    USE surface_mod,                                                                               &
-        ONLY: surf_def_h, surf_lsm_h, surf_usm_h
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=30) ::  canopy_mode = 'homogeneous'           !< canopy coverage
-    INTEGER(iwp) ::  pch_index = 0                                 !< plant canopy height/top index
-
-    INTEGER(iwp) ::  lad_vertical_gradient_level_ind(10) = -9999   !< lad-profile levels (index)
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  pch_index_ji     !< local plant canopy top
-
-    LOGICAL ::  calc_beta_lad_profile = .FALSE.       !< switch for calc. of lad from beta func.
-    LOGICAL ::  plant_canopy_transpiration = .FALSE.  !< flag to switch calculation of transpiration and corresponding latent heat
-                                                      !< for resolved plant canopy inside radiation model
-                                                      !< (calls subroutine pcm_calc_transpiration_rate from module plant_canopy_mod)
-
-    REAL(wp) ::  alpha_lad = 9999999.9_wp                        !< coefficient for lad calculation
-    REAL(wp) ::  beta_lad = 9999999.9_wp                         !< coefficient for lad calculation
-    REAL(wp) ::  canopy_drag_coeff = 0.0_wp                      !< canopy drag coefficient (parameter)
-    REAL(wp) ::  cthf = 0.0_wp                                   !< canopy top heat flux
-    REAL(wp) ::  dt_plant_canopy = 0.0_wp                        !< timestep account. for canopy drag
-    REAL(wp) ::  ext_coef = 0.6_wp                               !< extinction coefficient
-    REAL(wp) ::  lad_surface = 0.0_wp                            !< lad surface value
-    REAL(wp) ::  lad_type_coef(0:10) = 1.0_wp                    !< multiplicative coeficients for particular types
-                                                                 !< of plant canopy (e.g. deciduous tree during winter)
-    REAL(wp) ::  lad_vertical_gradient(10) = 0.0_wp              !< lad gradient
-    REAL(wp) ::  lad_vertical_gradient_level(10) = -9999999.9_wp !< lad-prof. levels (in m)
-    REAL(wp) ::  lai_beta = 0.0_wp                               !< leaf area index (lai) for lad calc.
-    REAL(wp) ::  leaf_scalar_exch_coeff = 0.0_wp                 !< canopy scalar exchange coeff.
-    REAL(wp) ::  leaf_surface_conc = 0.0_wp                      !< leaf surface concentration
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  lad            !< leaf area density
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pre_lad        !< preliminary lad
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  bad_s                    !< basal-area density on scalar-grid
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  cum_lai_hf               !< cumulative lai for heatflux calc.
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  lad_s                    !< lad on scalar-grid
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_heating_rate         !< plant canopy heating rate
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_heatrate_av          !< array for averaging plant canopy sensible heating rate
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_latent_rate          !< plant canopy latent heating rate
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_latentrate_av        !< array for averaging plant canopy latent heating rate
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_transpiration_rate   !< plant canopy transpiration rate
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_transpirationrate_av !< array for averaging plant canopy transpiration rate
-
-    TYPE(real_3d) ::  basal_area_density_f    !< input variable for basal area density - resolved vegetation
-    TYPE(real_3d) ::  leaf_area_density_f     !< input variable for leaf area density - resolved vegetation
-    TYPE(real_3d) ::  root_area_density_lad_f !< input variable for root area density - resolved vegetation
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public functions
-    PUBLIC pcm_calc_transpiration_rate,                                                            &
-           pcm_check_data_output,                                                                  &
-           pcm_check_parameters,                                                                   &
-           pcm_3d_data_averaging,                                                                  &
-           pcm_data_output_3d,                                                                     &
-           pcm_define_netcdf_grid,                                                                 &
-           pcm_header,                                                                             &
-           pcm_init,                                                                               &
-           pcm_parin,                                                                              &
-           pcm_rrd_global,                                                                         &
-           pcm_rrd_local,                                                                          &
-           pcm_tendency,                                                                           &
-           pcm_wrd_global,                                                                         &
-           pcm_wrd_local
-
-!
-!-- Public variables and constants
-    PUBLIC canopy_drag_coeff, pcm_heating_rate, pcm_transpiration_rate, pcm_latent_rate,           &
-           canopy_mode, cthf, dt_plant_canopy, lad, lad_s, pch_index, plant_canopy_transpiration,  &
-           pcm_heatrate_av, pcm_latentrate_av
-
-    INTERFACE pcm_calc_transpiration_rate
-       MODULE PROCEDURE pcm_calc_transpiration_rate
-    END INTERFACE pcm_calc_transpiration_rate
-
-    INTERFACE pcm_check_data_output
-       MODULE PROCEDURE pcm_check_data_output
-    END INTERFACE pcm_check_data_output
-
-    INTERFACE pcm_check_parameters
-       MODULE PROCEDURE pcm_check_parameters
-    END INTERFACE pcm_check_parameters
-
-    INTERFACE pcm_3d_data_averaging
-       MODULE PROCEDURE pcm_3d_data_averaging
-    END INTERFACE pcm_3d_data_averaging
-
-    INTERFACE pcm_data_output_3d
-       MODULE PROCEDURE pcm_data_output_3d
-    END INTERFACE pcm_data_output_3d
-
-    INTERFACE pcm_define_netcdf_grid
-       MODULE PROCEDURE pcm_define_netcdf_grid
-    END INTERFACE pcm_define_netcdf_grid
-
-     INTERFACE pcm_header
-       MODULE PROCEDURE pcm_header
-    END INTERFACE pcm_header
-
-    INTERFACE pcm_init
-       MODULE PROCEDURE pcm_init
-    END INTERFACE pcm_init
-
-    INTERFACE pcm_parin
-       MODULE PROCEDURE pcm_parin
-    END INTERFACE pcm_parin
-
-    INTERFACE pcm_read_plant_canopy_3d
-       MODULE PROCEDURE pcm_read_plant_canopy_3d
-    END INTERFACE pcm_read_plant_canopy_3d
-
-    INTERFACE pcm_rrd_local
-       MODULE PROCEDURE pcm_rrd_local_ftn
-       MODULE PROCEDURE pcm_rrd_local_mpi
-    END INTERFACE pcm_rrd_local
-
-    INTERFACE pcm_rrd_global
-       MODULE PROCEDURE pcm_rrd_global_ftn
-       MODULE PROCEDURE pcm_rrd_global_mpi
-    END INTERFACE pcm_rrd_global
-
-    INTERFACE pcm_tendency
-       MODULE PROCEDURE pcm_tendency
-       MODULE PROCEDURE pcm_tendency_ij
-    END INTERFACE pcm_tendency
-
-    INTERFACE pcm_wrd_local
-       MODULE PROCEDURE pcm_wrd_local
-    END INTERFACE pcm_wrd_local
-
-    INTERFACE pcm_wrd_global
-       MODULE PROCEDURE pcm_wrd_global
-    END INTERFACE pcm_wrd_global
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of the plant canopy transpiration rate based on the Jarvis-Stewart with
-!> parametrizations described in Daudet et al. (1999; Agricult. and Forest Meteorol. 97) and Ngao,
-!> Adam and Saudreau (2017;  Agricult. and Forest Meteorol 237-238). Model functions f1-f4 were
-!> adapted from Stewart (1998; Agric. and Forest. Meteorol. 43) instead, because they are valid for
-!> broader intervals of values. Funcion f4 used in form present in van Wijk et al. (1998; Tree
-!> Physiology 20).
-!>
-!> This subroutine is called from subroutine radiation_interaction after the calculation of
-!> radiation in plant canopy boxes.
-!> (arrays pcbinsw and pcbinlw).
-!>
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pcm_calc_transpiration_rate(i, j, k, kk, pcbsw, pcblw, pcbtr, pcblh)
-
-!
-!--  Input parameters
-     INTEGER(iwp), INTENT(IN) ::  i, j, k, kk        !< indices of the pc gridbox
-     REAL(wp), INTENT(IN)     ::  pcblw              !< lw radiation in gridbox (W)
-     REAL(wp), INTENT(IN)     ::  pcbsw              !< sw radiation in gridbox (W)
-     REAL(wp), INTENT(OUT)    ::  pcblh              !< latent heat from transpiration dT/dt (K/s)
-     REAL(wp), INTENT(OUT)    ::  pcbtr              !< transpiration rate dq/dt (kg/kg/s)
-
-!--  Variables and parameters for calculation of transpiration rate
-     REAL(wp), PARAMETER ::  gama_psychr = 66.0_wp !< psychrometric constant (Pa/K)
-     REAL(wp), PARAMETER ::  g_s_max = 0.01        !< maximum stomatal conductivity (m/s)
-     REAL(wp), PARAMETER ::  m_soil = 0.4_wp       !< soil water content (needs to adjust or take from LSM)
-     REAL(wp), PARAMETER ::  m_wilt = 0.01_wp      !< wilting point soil water content (needs to adjust or take from LSM)
-     REAL(wp), PARAMETER ::  m_sat = 0.51_wp       !< saturation soil water content (needs to adjust or take from LSM)
-     REAL(wp), PARAMETER ::  t2_min = 0.0_wp       !< minimal temperature for calculation of f2
-     REAL(wp), PARAMETER ::  t2_max = 40.0_wp      !< maximal temperature for calculation of f2
-
-     REAL(wp) ::  d_fact
-     REAL(wp) ::  e_eq
-     REAL(wp) ::  e_imp
-     REAL(wp) ::  evapor_rate
-     REAL(wp) ::  f1
-     REAL(wp) ::  f2
-     REAL(wp) ::  f3
-     REAL(wp) ::  f4
-     REAL(wp) ::  g_b
-     REAL(wp) ::  g_s
-     REAL(wp) ::  rad
-     REAL(wp) ::  rswc
-     REAL(wp) ::  sat_press
-     REAL(wp) ::  sat_press_d
-     REAL(wp) ::  temp
-     REAL(wp) ::  v_lad
-     REAL(wp) ::  vpd
-     REAL(wp) ::  wind_speed
-
-!
-!--  Temperature (deg C)
-     temp = pt(k,j,i) * exner(k) - degc_to_k
-!
-!--  Coefficient for conversion of radiation to grid to radiation to unit leaves surface
-     v_lad = 1.0_wp / ( MAX( lad_s(kk,j,i), 1.0E-10_wp ) * dx * dy * dz(1) )
-!
-!--  Magnus formula for the saturation pressure (see Ngao, Adam and Saudreau (2017) eq. 1)
-!--  There are updated formulas available, kept consistent with the rest of the parametrization
-     sat_press = 610.8_wp * EXP( 17.27_wp * temp / ( temp + 237.3_wp ) )
-!
-!--  Saturation pressure derivative (derivative of the above)
-     sat_press_d = sat_press * 17.27_wp * 237.3_wp / ( temp + 237.3_wp )**2
-!
-!--  Wind speed
-     wind_speed = SQRT( ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) )**2 +                                &
-                        ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) )**2 +                                &
-                        ( 0.5_wp * ( w(k,j,i) + w(k-1,j,i) ) )**2 )
-!
-!--  Aerodynamic conductivity (Daudet et al. (1999) eq. 14
-     g_b = 0.01_wp * wind_speed + 0.0071_wp
-!
-!--  Radiation flux per leaf surface unit
-     rad = pcbsw * v_lad
-!
-!--  First function for calculation of stomatal conductivity (radiation dependency)
-!--  Stewart (1988; Agric. and Forest. Meteorol. 43) eq. 17
-     f1 = rad * ( 1000.0_wp + 42.1_wp ) / 1000.0_wp / ( rad + 42.1_wp )
-!
-!--  Second function for calculation of stomatal conductivity (temperature dependency)
-!--  Stewart (1988; Agric. and Forest. Meteorol. 43) eq. 21
-     f2 = MAX( t2_min, ( temp - t2_min ) * MAX( 0.0_wp, t2_max - temp )**( ( t2_max - 16.9_wp ) /  &
-                                                                           ( 16.9_wp - t2_min ) )  &
-               / ( ( 16.9_wp - t2_min ) * ( t2_max - 16.9_wp )**( ( t2_max - 16.9_wp ) /           &
-                                                                  ( 16.9_wp - t2_min ) ) ) )
-!
-!--  Water pressure deficit
-!--  Ngao, Adam and Saudreau (2017) eq. 6 but with water vapour partial pressure
-     vpd = MAX( sat_press - q(k,j,i) * hyp(k) / rd_d_rv, 0._wp )
-!
-!--  Third function for calculation of stomatal conductivity (water pressure deficit dependency)
-!--  Ngao, Adam and Saudreau (2017) Table 1, limited from below according to Stewart (1988)
-!--  The coefficients of the linear dependence should better correspond to broad-leaved trees than
-!--  the coefficients from Stewart (1988) which correspond to conifer trees.
-     vpd = MIN( MAX( vpd, 770.0_wp ), 3820.0_wp )
-     f3 = -2E-4_wp * vpd + 1.154_wp
-!
-!--  Fourth function for calculation of stomatal conductivity (soil moisture dependency)
-!--  Residual soil water content
-!--  van Wijk et al. (1998; Tree Physiology 20) eq. 7
-!--  TODO - over LSM surface might be calculated from LSM parameters
-     rswc = ( m_sat - m_soil ) / ( m_sat - m_wilt )
-!
-!--  van Wijk et al. (1998; Tree Physiology 20) eq. 5-6 (it is a reformulation of eq. 22-23 of
-!--  Stewart(1988))
-     f4 = MAX( 0.0_wp, MIN( 1.0_wp - 0.041_wp * EXP( 3.2_wp * rswc ), 1.0_wp - 0.041_wp ) )
-!
-!--  Stomatal conductivity
-!--  Stewart (1988; Agric. and Forest. Meteorol. 43) eq. 12
-!--  (notation according to Ngao, Adam and Saudreau (2017) and others)
-     g_s = g_s_max * f1 * f2 * f3 * f4 + 1.0E-10_wp
-!
-!--  Decoupling factor
-!--  Daudet et al. (1999) eq. 6
-     d_fact = ( sat_press_d / gama_psychr + 2.0_wp ) /                                             &
-              ( sat_press_d / gama_psychr + 2.0_wp + 2.0_wp * g_b / g_s )
-!
-!--  Equilibrium evaporation rate
-!--  Daudet et al. (1999) eq. 4
-     e_eq = ( pcbsw + pcblw ) * v_lad * sat_press_d /                                              &
-            gama_psychr / ( sat_press_d / gama_psychr + 2.0_wp ) / l_v
-!
-!--  Imposed evaporation rate
-!--  Daudet et al. (1999) eq. 5
-     e_imp = r_d * pt(k,j,i) * exner(k) / hyp(k) * c_p * g_s * vpd / gama_psychr / l_v
-!
-!--  Evaporation rate
-!--  Daudet et al. (1999) eq. 3
-!--  (evaporation rate is limited to non-negative values)
-     evapor_rate = MAX( d_fact * e_eq + ( 1.0_wp - d_fact ) * e_imp, 0.0_wp )
-!
-!--  Conversion of evaporation rate to q tendency in gridbox
-!--  dq/dt = E * LAD * V_g / (rho_air * V_g)
-     pcbtr = evapor_rate * r_d * pt(k,j,i) * exner(k) * lad_s(kk,j,i) / hyp(k)  !-- = dq/dt
-!
-!--  latent heat from evaporation
-     pcblh = pcbtr * lv_d_cp  !-- = - dT/dt
-
- END SUBROUTINE pcm_calc_transpiration_rate
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output for plant canopy model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pcm_check_data_output( var, unit )
-
-    CHARACTER (LEN=*) ::  unit  !<
-    CHARACTER (LEN=*) ::  var   !<
-
-
-    SELECT CASE ( TRIM( var ) )
-
-       CASE ( 'pcm_heatrate' )
-!
-!--       Output of heatrate can be only done if it is explicitely set by cthf, or parametrized by
-!--       absorption of radiation. The latter, however, is only available if radiation_interactions
-!--       are on. Note, these are enabled if land-surface or urban-surface is switched-on. Using
-!--       radiation_interactions_on directly is not possible since it belongs to the
-!--       radition_model, which in turn depends on the plant-canopy model, creating circular
-!--       dependencies.
-          IF ( cthf == 0.0_wp  .AND.  ( .NOT. urban_surface .AND. .NOT. land_surface ) )  THEN
-             message_string = 'output of "' // TRIM( var ) // '" requi' //                         &
-                              'res setting of parameter cthf /= 0.0'
-             CALL message( 'pcm_check_data_output', 'PA0718', 1, 2, 0, 6, 0 )
-          ENDIF
-          unit = 'K s-1'
-
-       CASE ( 'pcm_transpirationrate' )
-          unit = 'kg kg-1 s-1'
-
-       CASE ( 'pcm_latentrate' )
-          unit = 'K s-1'
-
-       CASE ( 'pcm_bad', 'pcm_lad' )
-          unit = 'm2 m-3'
-
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE pcm_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for plant canopy model
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_check_parameters
-
-       IF ( ocean_mode )  THEN
-          message_string = 'plant_canopy = .TRUE. is not allowed in the ocean'
-          CALL message( 'pcm_check_parameters', 'PA0696', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( canopy_drag_coeff == 0.0_wp )  THEN
-          message_string = 'plant_canopy = .TRUE. requires a non-zero drag ' //                    &
-                           'coefficient & given value is canopy_drag_coeff = 0.0'
-          CALL message( 'pcm_check_parameters', 'PA0041', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( ( alpha_lad /= 9999999.9_wp .AND. beta_lad == 9999999.9_wp )  .OR.                     &
-            beta_lad /= 9999999.9_wp  .AND.  alpha_lad == 9999999.9_wp )  THEN
-          message_string = 'using the beta function for the construction ' //                      &
-                           'of the leaf area density profile requires '    //                      &
-                           'both alpha_lad and beta_lad to be /= 9999999.9'
-          CALL message( 'pcm_check_parameters', 'PA0118', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( calc_beta_lad_profile  .AND.  lai_beta == 0.0_wp )  THEN
-          message_string = 'using the beta function for the construction ' //                      &
-                           'of the leaf area density profile requires '    //                      &
-                           'a non-zero lai_beta, but given value is '      //                      &
-                           'lai_beta = 0.0'
-          CALL message( 'pcm_check_parameters', 'PA0119', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( calc_beta_lad_profile  .AND.  lad_surface /= 0.0_wp )  THEN
-          message_string = 'simultaneous setting of alpha_lad /= 9999999.9 '//                     &
-                           'combined with beta_lad /= 9999999.9 '           //                     &
-                           'and lad_surface /= 0.0 is not possible, '       //                     &
-                           'use either vertical gradients or the beta '     //                     &
-                           'function for the construction of the leaf area '//                     &
-                           'density profile'
-          CALL message( 'pcm_check_parameters', 'PA0120', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-          message_string = 'plant_canopy = .TRUE. requires cloud_scheme /= seifert_beheng'
-          CALL message( 'pcm_check_parameters', 'PA0360', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    END SUBROUTINE pcm_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine for averaging 3D data
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pcm_3d_data_averaging( mode, variable )
-
-    CHARACTER (LEN=*) ::  mode    !<
-    CHARACTER (LEN=*) ::  variable !<
-
-    INTEGER(iwp) ::  i            !<
-    INTEGER(iwp) ::  j            !<
-    INTEGER(iwp) ::  k            !<
-
-
-    IF ( mode == 'allocate' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'pcm_heatrate' )
-             IF ( .NOT. ALLOCATED( pcm_heatrate_av ) )  THEN
-                ALLOCATE( pcm_heatrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             pcm_heatrate_av = 0.0_wp
-
-
-          CASE ( 'pcm_latentrate' )
-             IF ( .NOT. ALLOCATED( pcm_latentrate_av ) )  THEN
-                ALLOCATE( pcm_latentrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             pcm_latentrate_av = 0.0_wp
-
-
-          CASE ( 'pcm_transpirationrate' )
-             IF ( .NOT. ALLOCATED( pcm_transpirationrate_av ) )  THEN
-                ALLOCATE( pcm_transpirationrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             pcm_transpirationrate_av = 0.0_wp
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSE IF ( mode == 'sum' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'pcm_heatrate' )
-             IF ( ALLOCATED( pcm_heatrate_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      IF ( pch_index_ji(j,i) /= 0 )  THEN
-                         DO  k = 0, pch_index_ji(j,i)
-                            pcm_heatrate_av(k,j,i) = pcm_heatrate_av(k,j,i) +                      &
-                                                     pcm_heating_rate(k,j,i)
-                         ENDDO
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-
-          CASE ( 'pcm_latentrate' )
-             IF ( ALLOCATED( pcm_latentrate_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      IF ( pch_index_ji(j,i) /= 0 )  THEN
-                         DO  k = 0, pch_index_ji(j,i)
-                            pcm_latentrate_av(k,j,i) = pcm_latentrate_av(k,j,i) +                  &
-                                                       pcm_latent_rate(k,j,i)
-                         ENDDO
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-
-          CASE ( 'pcm_transpirationrate' )
-             IF ( ALLOCATED( pcm_transpirationrate_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      IF ( pch_index_ji(j,i) /= 0 )  THEN
-                         DO  k = 0, pch_index_ji(j,i)
-                            pcm_transpirationrate_av(k,j,i) = pcm_transpirationrate_av(k,j,i) +    &
-                                                              pcm_transpiration_rate(k,j,i)
-                         ENDDO
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSE IF ( mode == 'average' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'pcm_heatrate' )
-             IF ( ALLOCATED( pcm_heatrate_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      IF ( pch_index_ji(j,i) /= 0 )  THEN
-                         DO  k = 0, pch_index_ji(j,i)
-                            pcm_heatrate_av(k,j,i) = pcm_heatrate_av(k,j,i)                        &
-                                                     / REAL( average_count_3d, KIND=wp )
-                         ENDDO
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-
-          CASE ( 'pcm_latentrate' )
-             IF ( ALLOCATED( pcm_latentrate_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      IF ( pch_index_ji(j,i) /= 0 )  THEN
-                         DO  k = 0, pch_index_ji(j,i)
-                            pcm_latentrate_av(k,j,i) = pcm_latentrate_av(k,j,i)                    &
-                                                       / REAL( average_count_3d, KIND=wp )
-                         ENDDO
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-
-          CASE ( 'pcm_transpirationrate' )
-             IF ( ALLOCATED( pcm_transpirationrate_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      IF ( pch_index_ji(j,i) /= 0 )  THEN
-                         DO  k = 0, pch_index_ji(j,i)
-                            pcm_transpirationrate_av(k,j,i) = pcm_transpirationrate_av(k,j,i)      &
-                                                              / REAL( average_count_3d, KIND=wp )
-                         ENDDO
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-       END SELECT
-
-    ENDIF
-
- END SUBROUTINE pcm_3d_data_averaging
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 3D output variables.
-!> Note, 3D plant-canopy output has it's own vertical output dimension, meaning that 3D output is
-!> relative to the model surface now rather than at the actual grid point where the plant canopy is
-!> located.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-
-    CHARACTER (LEN=*) ::  variable !< treated variable
-
-    INTEGER(iwp) ::  av     !< flag indicating instantaneous or averaged data output
-    INTEGER(iwp) ::  i      !< grid index x-direction
-    INTEGER(iwp) ::  j      !< grid index y-direction
-    INTEGER(iwp) ::  k      !< grid index z-direction
-    INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
-    INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
-
-    LOGICAL      ::  found  !< flag indicating if variable is found
-
-    REAL(wp)     ::  fill_value !< fill value
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !< data output array
-
-
-    found = .TRUE.
-
-    local_pf = REAL( fill_value, KIND = 4 )
-
-    SELECT CASE ( TRIM( variable ) )
-!
-!--    Note, to save memory arrays for heating are allocated from 0:pch_index.
-!--    Thus, output must be relative to these array indices. Further, check whether the output is
-!--    within the vertical output range, i.e. nzb_do:nzt_do, which is necessary as local_pf is only
-!--    allocated for this index space. Note, plant-canopy output has a separate vertical output
-!--    coordinate zlad, so that output is mapped down to the surface.
-       CASE ( 'pcm_heatrate' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = MAX( 1, nzb_do ), MIN( pch_index_ji(j,i), nzt_do )
-                      local_pf(i,j,k) = pcm_heating_rate(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = MAX( 1, nzb_do ), MIN( pch_index_ji(j,i), nzt_do )
-                      local_pf(i,j,k) = pcm_heatrate_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-
-       CASE ( 'pcm_latentrate' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = MAX( 1, nzb_do ), MIN( pch_index_ji(j,i), nzt_do )
-                      local_pf(i,j,k) = pcm_latent_rate(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = MAX( 1, nzb_do ), MIN( pch_index_ji(j,i), nzt_do )
-                      local_pf(i,j,k) = pcm_latentrate_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-
-       CASE ( 'pcm_transpirationrate' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = MAX( 1, nzb_do ), MIN( pch_index_ji(j,i), nzt_do )
-                      local_pf(i,j,k) = pcm_transpiration_rate(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = MAX( 1, nzb_do ), MIN( pch_index_ji(j,i), nzt_do )
-                      local_pf(i,j,k) = pcm_transpirationrate_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-
-       CASE ( 'pcm_lad' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = MAX( 1, nzb_do ), MIN( pch_index_ji(j,i), nzt_do )
-                      local_pf(i,j,k) = lad_s(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-
-       CASE ( 'pcm_bad' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = MAX( 1, nzb_do ), MIN( pch_index_ji(j,i), nzt_do )
-                      local_pf(i,j,k) = bad_s(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE pcm_data_output_3d
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining appropriate grid for netcdf variables.
-!> It is called from subroutine netcdf.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pcm_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-     CHARACTER (LEN=*), INTENT(IN)  ::  var         !<
-     CHARACTER (LEN=*), INTENT(OUT) ::  grid_x      !<
-     CHARACTER (LEN=*), INTENT(OUT) ::  grid_y      !<
-     CHARACTER (LEN=*), INTENT(OUT) ::  grid_z      !<
-
-     LOGICAL, INTENT(OUT)           ::  found       !<
-
-
-     found  = .TRUE.
-
-!
-!--  Check for the grid. zpc is zu(nzb:nzb+pch_index)
-     SELECT CASE ( TRIM( var ) )
-
-        CASE ( 'pcm_heatrate', 'pcm_bad', 'pcm_lad', 'pcm_transpirationrate', 'pcm_latentrate' )
-           grid_x = 'x'
-           grid_y = 'y'
-           grid_z = 'zpc'
-
-        CASE DEFAULT
-           found  = .FALSE.
-           grid_x = 'none'
-           grid_y = 'none'
-           grid_z = 'none'
-     END SELECT
-
- END SUBROUTINE pcm_define_netcdf_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for plant canopy model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pcm_header ( io )
-
-    CHARACTER (LEN=10) ::  coor_chr            !<
-    CHARACTER (LEN=86) ::  coordinates         !<
-    CHARACTER (LEN=86) ::  gradients           !<
-    CHARACTER (LEN=86) ::  leaf_area_density   !<
-    CHARACTER (LEN=86) ::  slices              !<
-
-    INTEGER(iwp)              ::  i   !<
-    INTEGER(iwp),  INTENT(IN) ::  io  !< Unit of the output file
-    INTEGER(iwp)              ::  k   !<
-
-    REAL(wp) ::  canopy_height       !< canopy height (in m)
-
-
-    canopy_height = zw(pch_index)
-
-    WRITE( io, 1 )  canopy_mode, canopy_height, pch_index, canopy_drag_coeff
-    IF ( passive_scalar )  THEN
-       WRITE( io, 2 )  leaf_scalar_exch_coeff, leaf_surface_conc
-    ENDIF
-
-!
-!-- Heat flux at the top of vegetation
-    WRITE( io, 3 )  cthf
-
-!
-!-- Leaf area density profile, calculated either from given vertical gradients or from beta
-!-- probability density function.
-    IF ( .NOT. calc_beta_lad_profile )  THEN
-
-!      Building output strings, starting with surface value
-       WRITE( leaf_area_density, '(F7.4)' )  lad_surface
-       gradients = '------'
-       slices = '     0'
-       coordinates = '   0.0'
-       DO  i = 1, UBOUND( lad_vertical_gradient_level_ind, DIM=1 )
-          IF  ( lad_vertical_gradient_level_ind(i) /= -9999 )  THEN
-
-             WRITE( coor_chr, '(F7.2)' ) lad(lad_vertical_gradient_level_ind(i))
-             leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
-
-             WRITE( coor_chr, '(F7.2)' ) lad_vertical_gradient(i)
-             gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
-
-             WRITE( coor_chr, '(I7)' ) lad_vertical_gradient_level_ind(i)
-             slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
-
-             WRITE( coor_chr, '(F7.1)' ) lad_vertical_gradient_level(i)
-             coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
-          ELSE
-             EXIT
-          ENDIF
-       ENDDO
-
-       WRITE( io, 4 )  TRIM( coordinates ), TRIM( leaf_area_density ), TRIM( gradients ),          &
-                       TRIM( slices )
-
-    ELSE
-
-       WRITE( leaf_area_density, '(F7.4)' )  lad_surface
-       coordinates = '   0.0'
-
-       DO  k = 1, pch_index
-
-          WRITE( coor_chr,'(F7.2)' )  lad(k)
-          leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
-
-          WRITE(coor_chr,'(F7.1)')  zu(k)
-          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
-
-       ENDDO
-
-       WRITE( io, 5 ) TRIM( coordinates ), TRIM( leaf_area_density ), alpha_lad, beta_lad, lai_beta
-
-    ENDIF
-
-1   FORMAT (/ /' Vegetation canopy (drag) model:' / ' ------------------------------' //           &
-              ' Canopy mode: ', A / ' Canopy height: ', F6.2, 'm (',I4,' grid points)' /           &
-              ' Leaf drag coefficient: ', F6.2 /)
-2   FORMAT (/ ' Scalar exchange coefficient: ',F6.2 /                                              &
-              ' Scalar concentration at leaf surfaces in kg/m**3: ', F6.2 /)
-3   FORMAT ( ' Predefined constant heatflux at the top of the vegetation: ', F6.2, ' K m/s')
-4   FORMAT (/ ' Characteristic levels of the leaf area density:' //                                &
-              ' Height:              ', A, '  m' /                                                 &
-              ' Leaf area density:   ', A, '  m**2/m**3' /                                         &
-              ' Gradient:            ', A, '  m**2/m**4' /                                         &
-              ' Gridpoint:           ', A )
-5   FORMAT (//' Characteristic levels of the leaf area density and coefficients:' //               &
-              ' Height:              ', A, '  m' /                                                 &
-              ' Leaf area density:   ', A, '  m**2/m**3' /                                         &
-              ' Coefficient alpha: ',F6.2 /                                                        &
-              ' Coefficient beta: ',F6.2 /                                                         &
-              ' Leaf area index: ',F6.2,'  m**2/m**2' /)
-
-    END SUBROUTINE pcm_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the plant canopy model
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_init
-
-       USE exchange_horiz_mod,                                                                     &
-           ONLY:  exchange_horiz
-
-       INTEGER(iwp) ::  i   !< running index
-       INTEGER(iwp) ::  j   !< running index
-       INTEGER(iwp) ::  k   !< running index
-       INTEGER(iwp) ::  m   !< running index
-
-       LOGICAL ::  lad_on_top = .FALSE.  !< dummy flag to indicate that LAD is defined on a building roof
-       LOGICAL ::  bad_on_top = .FALSE.  !< dummy flag to indicate that BAD is defined on a building roof
-
-       REAL(wp) ::  canopy_height   !< canopy height for lad-profile construction
-       REAL(wp) ::  gradient        !< gradient for lad-profile construction
-       REAL(wp) ::  int_bpdf        !< vertical integral for lad-profile construction
-       REAL(wp) ::  lad_max         !< maximum LAD value in the model domain, used to perform a check
-
-
-       IF ( debug_output )  CALL debug_message( 'pcm_init', 'start' )
-!
-!--    Allocate one-dimensional arrays for the computation of the leaf area density (lad) profile
-       ALLOCATE( lad(0:nz+1), pre_lad(0:nz+1) )
-       lad = 0.0_wp
-       pre_lad = 0.0_wp
-
-!
-!--    Set flag that indicates that the lad-profile shall be calculated by using a beta probability
-!--    density function
-       IF ( alpha_lad /= 9999999.9_wp  .AND.  beta_lad /= 9999999.9_wp )  THEN
-          calc_beta_lad_profile = .TRUE.
-       ENDIF
-
-
-!
-!--    Compute the profile of leaf area density used in the plant canopy model. The profile can
-!--    either be constructed from prescribed vertical gradients of the leaf area density or by using
-!--    a beta probability density function (see e.g. Markkanen et al., 2003: Boundary-Layer
-!--    Meteorology, 106, 437-459)
-       IF ( .NOT. calc_beta_lad_profile )  THEN
-
-!
-!--       Use vertical gradients for lad-profile construction
-          i = 1
-          gradient = 0.0_wp
-
-          lad(0) = lad_surface
-          lad_vertical_gradient_level_ind(1) = 0
-
-          DO  k = 1, pch_index
-             IF ( i < 11 )  THEN
-                IF ( lad_vertical_gradient_level(i) < zu(k)  .AND.                                 &
-                     lad_vertical_gradient_level(i) >= 0.0_wp )  THEN
-                   gradient = lad_vertical_gradient(i)
-                   lad_vertical_gradient_level_ind(i) = k - 1
-                   i = i + 1
-                ENDIF
-             ENDIF
-             IF ( gradient /= 0.0_wp )  THEN
-                IF ( k /= 1 )  THEN
-                   lad(k) = lad(k-1) + dzu(k) * gradient
-                ELSE
-                   lad(k) = lad_surface + dzu(k) * gradient
-                ENDIF
-             ELSE
-                lad(k) = lad(k-1)
-             ENDIF
-          ENDDO
-
-!
-!--       In case of no given leaf area density gradients, choose a vanishing gradient. This
-!--       information is used for the HEADER and the RUN_CONTROL file.
-          IF ( lad_vertical_gradient_level(1) == -9999999.9_wp )  THEN
-             lad_vertical_gradient_level(1) = 0.0_wp
-          ENDIF
-
-       ELSE
-
-!
-!--       Use beta function for lad-profile construction
-          int_bpdf = 0.0_wp
-          canopy_height = zw(pch_index)
-
-          DO  k = 0, pch_index
-             int_bpdf = int_bpdf +                                                                 &
-                                 ( ( ( zw(k) / canopy_height )**( alpha_lad-1.0_wp ) ) *           &
-                                   ( ( 1.0_wp - ( zw(k) / canopy_height ) )**( beta_lad-1.0_wp ) ) &
-                                   * ( ( zw(k+1)-zw(k) ) / canopy_height ) )
-          ENDDO
-
-!
-!--       Preliminary lad profile (defined on w-grid)
-          DO  k = 0, pch_index
-             pre_lad(k) =  lai_beta *                                                              &
-                              ( ( ( zw(k) / canopy_height )**( alpha_lad-1.0_wp ) )                &
-                                * ( ( 1.0_wp - ( zw(k) / canopy_height ) )**( beta_lad-1.0_wp ) )  &
-                                / int_bpdf                                                         &
-                              ) / canopy_height
-          ENDDO
-
-!
-!--       Final lad profile (defined on scalar-grid level, since most prognostic quantities are
-!--       defined there, hence, less interpolation is required when calculating the canopy
-!--       tendencies)
-          lad(0) = pre_lad(0)
-          DO  k = 1, pch_index
-             lad(k) = 0.5 * ( pre_lad(k-1) + pre_lad(k) )
-          ENDDO
-
-       ENDIF
-
-!
-!--    Allocate 3D-array for the leaf-area density (lad_s) as well as for basal-area densitiy
-!--    (bad_s). Note, by default bad_s is zero.
-       ALLOCATE( lad_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ALLOCATE( bad_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       bad_s = 0.0_wp
-!
-!--    Initialization of the canopy coverage in the model domain:
-!--    Setting the parameter canopy_mode = 'homogeneous' initializes a canopy, which fully covers
-!--    the domain surface
-       SELECT CASE ( TRIM( canopy_mode ) )
-
-          CASE ( 'homogeneous' )
-
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   lad_s(:,j,i) = lad(:)
-                ENDDO
-             ENDDO
-
-          CASE ( 'read_from_file' )
-!
-!--          Read plant canopy
-             IF ( input_pids_static )  THEN
-!
-!--             Open the static input file
-#if defined( __netcdf )
-                CALL open_read_file( TRIM( input_file_static ) //                                  &
-                                     TRIM( coupling_char ),                                        &
-                                     pids_id )
-
-                CALL inquire_num_variables( pids_id, num_var_pids )
-!
-!--             Allocate memory to store variable names and read them
-                ALLOCATE( vars_pids(1:num_var_pids) )
-                CALL inquire_variable_names( pids_id, vars_pids )
-!
-!--             Read leaf area density - resolved vegetation
-                IF ( check_existence( vars_pids, 'lad' ) )  THEN
-                   leaf_area_density_f%from_file = .TRUE.
-                   CALL get_attribute( pids_id, char_fill,                                         &
-                                       leaf_area_density_f%fill,                                   &
-                                       .FALSE., 'lad' )
-!
-!--                Inquire number of vertical vegetation layer
-                   CALL get_dimension_length( pids_id,                                             &
-                                              leaf_area_density_f%nz,                              &
-                                              'zlad' )
-!
-!--                Allocate variable for leaf-area density
-                   ALLOCATE( leaf_area_density_f%var                                               &
-                                                 (0:leaf_area_density_f%nz-1,nys:nyn,nxl:nxr) )
-
-                   CALL get_variable( pids_id, 'lad', leaf_area_density_f%var, nxl, nxr, nys, nyn, &
-                                      0, leaf_area_density_f%nz-1 )
-
-                ELSE
-                   leaf_area_density_f%from_file = .FALSE.
-                ENDIF
-!
-!--             Read basal area density - resolved vegetation
-                IF ( check_existence( vars_pids, 'bad' ) )  THEN
-                   basal_area_density_f%from_file = .TRUE.
-                   CALL get_attribute( pids_id, char_fill,                                         &
-                                       basal_area_density_f%fill,                                  &
-                                       .FALSE., 'bad' )
-!
-!--                Inquire number of vertical vegetation layer
-                   CALL get_dimension_length( pids_id,                                             &
-                                              basal_area_density_f%nz,                             &
-                                              'zlad' )
-!
-!--                Allocate variable
-                   ALLOCATE( basal_area_density_f%var                                              &
-                                                  (0:basal_area_density_f%nz-1,nys:nyn,nxl:nxr) )
-
-                   CALL get_variable( pids_id, 'bad', basal_area_density_f%var, nxl, nxr, nys, nyn,&
-                                      0, basal_area_density_f%nz-1 )
-                ELSE
-                   basal_area_density_f%from_file = .FALSE.
-                ENDIF
-!
-!--             Read root area density - resolved vegetation
-                IF ( check_existence( vars_pids, 'root_area_dens_r' ) )  THEN
-                   root_area_density_lad_f%from_file = .TRUE.
-                   CALL get_attribute( pids_id, char_fill,                                         &
-                                       root_area_density_lad_f%fill,                               &
-                                       .FALSE., 'root_area_dens_r' )
-!
-!--                Inquire number of vertical soil layers
-                   CALL get_dimension_length( pids_id,                                             &
-                                              root_area_density_lad_f%nz,                          &
-                                              'zsoil' )
-!
-!--                Allocate variable
-                   ALLOCATE( root_area_density_lad_f%var                                           &
-                                                 (0:root_area_density_lad_f%nz-1,nys:nyn,nxl:nxr) )
-
-                   CALL get_variable( pids_id, 'root_area_dens_r', root_area_density_lad_f%var,    &
-                                      nxl, nxr, nys, nyn, 0, root_area_density_lad_f%nz-1 )
-                ELSE
-                   root_area_density_lad_f%from_file = .FALSE.
-                ENDIF
-
-                DEALLOCATE( vars_pids )
-!
-!--             Finally, close the input file and deallocate temporary array
-                CALL close_input_file( pids_id )
-#endif
-             ENDIF
-
-!
-!--          Initialize LAD with data from file. If LAD is given in NetCDF file, use these values,
-!--          else take LAD profiles from ASCII file.
-!--          Please note, in NetCDF file LAD is only given up to the maximum canopy top, indicated
-!--          by leaf_area_density_f%nz.
-             lad_s = 0.0_wp
-             IF ( leaf_area_density_f%from_file )  THEN
-!
-!--             Set also pch_index, used to be the upper bound of the vertical loops. Therefore, use
-!--             the global top of the canopy layer.
-                pch_index = leaf_area_density_f%nz - 1
-
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = 0, leaf_area_density_f%nz - 1
-                         IF ( leaf_area_density_f%var(k,j,i) /=  leaf_area_density_f%fill )        &
-                            lad_s(k,j,i) = leaf_area_density_f%var(k,j,i)
-                      ENDDO
-!
-!--                   Check if resolved vegetation is mapped onto buildings.
-!--                   In general, this is allowed and also meaningful, e.g. when trees carry across
-!--                   roofs. However, due to the topography filtering, new building grid points can
-!--                   emerge at locations where also plant canopy is defined. As a result, plant
-!--                   canopy is mapped on top of roofs, with siginficant impact on the downstream
-!--                   flow field and the nearby surface radiation. In order to avoid that plant
-!--                   canopy is mistakenly mapped onto building roofs, check for building grid
-!--                   points (bit 6) that emerge from the filtering (bit 4) and set LAD to zero at
-!--                   these artificially created building grid points. This case, an informative
-!--                   message is given.
-                      IF ( ANY( lad_s(:,j,i) /= 0.0_wp )                 .AND.                     &
-                           ANY( BTEST( wall_flags_total_0(:,j,i), 6 ) )  .AND.                     &
-                           ANY( BTEST( wall_flags_total_0(:,j,i), 4 ) ) )  THEN
-                         lad_s(:,j,i) = 0.0_wp
-                         lad_on_top   = .TRUE.
-                      ENDIF
-                   ENDDO
-                ENDDO
-#if defined( __parallel )
-               CALL MPI_ALLREDUCE( MPI_IN_PLACE, lad_on_top, 1, MPI_LOGICAL, MPI_LOR, comm2d, ierr)
-#endif
-                IF ( lad_on_top )  THEN
-                   WRITE( message_string, * )                                                      &
-                                        'Resolved plant-canopy is defined on top of an ' //        &
-                                        'artificially created building grid point(s) '//           &
-                                        'the filtering) - LAD/BAD profile is omitted at this / ' //&
-                                        'these grid point(s).'
-                   CALL message( 'pcm_init', 'PA0313', 0, 0, 0, 6, 0 )
-                ENDIF
-                CALL exchange_horiz( lad_s, nbgp )
-!
-!            ASCII file
-!--          Initialize canopy parameters canopy_drag_coeff, leaf_scalar_exch_coeff,
-!--          leaf_surface_conc from file which contains complete 3D data (separate vertical profiles
-!--          for each location).
-             ELSE
-                CALL pcm_read_plant_canopy_3d
-             ENDIF
-!
-!--          Initialize LAD with data from file. If LAD is given in NetCDF file, use these values,
-!--          else take LAD profiles from ASCII file.
-!--          Please note, in NetCDF file LAD is only given up to the maximum canopy top, indicated
-!--          by basal_area_density_f%nz.
-             bad_s = 0.0_wp
-             IF ( basal_area_density_f%from_file )  THEN
-!
-!--             Set also pch_index, used to be the upper bound of the vertical loops. Therefore, use
-!--             the global top of the canopy layer.
-                pch_index = basal_area_density_f%nz - 1
-
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = 0, basal_area_density_f%nz - 1
-                         IF ( basal_area_density_f%var(k,j,i) /= basal_area_density_f%fill )       &
-                            bad_s(k,j,i) = basal_area_density_f%var(k,j,i)
-                      ENDDO
-!
-!--                   Check if resolved vegetation is mapped onto buildings.
-!--                   Please see comment for leaf_area density
-                      IF ( ANY( bad_s(:,j,i) /= 0.0_wp )                 .AND.                     &
-                           ANY( BTEST( wall_flags_total_0(:,j,i), 6 ) )  .AND.                     &
-                           ANY( BTEST( wall_flags_total_0(:,j,i), 4 ) ) )  THEN
-                         bad_s(:,j,i) = 0.0_wp
-                         bad_on_top   = .TRUE.
-                      ENDIF
-                   ENDDO
-                ENDDO
-#if defined( __parallel )
-               CALL MPI_ALLREDUCE( MPI_IN_PLACE, bad_on_top, 1, MPI_LOGICAL, MPI_LOR, comm2d, ierr)
-#endif
-                IF ( bad_on_top )  THEN
-                   WRITE( message_string, * )                                                      &
-                                        'Resolved plant-canopy is defined on top of an ' //        &
-                                        'artificially created building grid point(s) '//           &
-                                        'the filtering) - LAD/BAD profile is omitted at this / ' //&
-                                        'these grid point(s).'
-                   CALL message( 'pcm_init', 'PA0313', 0, 0, 0, 6, 0 )
-                ENDIF
-                CALL exchange_horiz( bad_s, nbgp )
-             ENDIF
-
-          CASE DEFAULT
-!
-!--          The DEFAULT case is reached either if the parameter canopy mode contains a wrong
-!--          character string or if the user has coded a special case in the user interface.
-!--          There, the subroutine user_init_plant_canopy checks which of these two conditions
-!--          applies.
-             CALL user_init_plant_canopy
-
-       END SELECT
-!
-!--    Check that at least one grid point has an LAD /= 0, else this may cause errors in the
-!--    radiation model.
-       lad_max = MAXVAL( lad_s )
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( MPI_IN_PLACE, lad_max, 1, MPI_REAL, MPI_MAX, comm2d, ierr)
-#endif
-       IF ( lad_max <= 0.0_wp )  THEN
-          message_string = 'Plant-canopy model is switched-on but no ' //                          &
-                           'plant canopy is present in the model domain.'
-          CALL message( 'pcm_init', 'PA0685', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    Initialize 2D index array indicating canopy top index.
-       ALLOCATE( pch_index_ji(nysg:nyng,nxlg:nxrg) )
-       pch_index_ji = 0
-
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-             DO  k = 0, pch_index
-                IF ( lad_s(k,j,i) /= 0.0_wp  .OR.  bad_s(k,j,i) /= 0.0_wp )  pch_index_ji(j,i) = k
-             ENDDO
-!
-!--          Check whether topography and local vegetation on top exceed height of the model domain.
-             IF ( topo_top_ind(j,i,0) + pch_index_ji(j,i) >= nzt + 1 )  THEN
-                message_string =  'Local vegetation height on top of ' //                          &
-                                  'topography exceeds height of model domain.'
-                CALL message( 'pcm_init', 'PA0674', 2, 2, myid, 6, 0 )
-             ENDIF
-
-          ENDDO
-       ENDDO
-!
-!--    Calculate global pch_index value (index of top of plant canopy from ground)
-       pch_index = MAXVAL( pch_index_ji )
-!
-!--    Exchange pch_index from all processors
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( MPI_IN_PLACE, pch_index, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr)
-#endif
-!
-!--    Allocation of arrays pcm_heating_rate, pcm_transpiration_rate and pcm_latent_rate
-       ALLOCATE( pcm_heating_rate(0:pch_index,nysg:nyng,nxlg:nxrg) )
-       pcm_heating_rate = 0.0_wp
-
-       IF ( humidity )  THEN
-          ALLOCATE( pcm_transpiration_rate(0:pch_index,nysg:nyng,nxlg:nxrg) )
-          pcm_transpiration_rate = 0.0_wp
-          ALLOCATE( pcm_latent_rate(0:pch_index,nysg:nyng,nxlg:nxrg) )
-          pcm_latent_rate = 0.0_wp
-       ENDIF
-!
-!--    Initialization of the canopy heat source distribution due to heating of the canopy layers by
-!--    incoming solar radiation, in case that a non-zero
-!--    value is set for the canopy top heat flux (cthf), which equals the available net radiation at
-!--    canopy top.
-!--    The heat source distribution is calculated by a decaying exponential function of the downward
-!--    cumulative leaf area index (cum_lai_hf), assuming that the foliage inside the plant canopy is
-!--    heated by solar radiation penetrating the canopy layers according to the distribution of net
-!--    radiation as suggested by Brown & Covey (1966; Agric. Meteorol. 3, 73â96). This approach has
-!--    been applied e.g. by Shaw & Schumann (1992; Bound.-Layer Meteorol. 61, 47â64).
-!--    When using the radiation_interactions, canopy heating (pcm_heating_rate) and plant canopy
-!--    transpiration (pcm_transpiration_rate, pcm_latent_rate) are calculated in the RTM after the
-!--    calculation of radiation.
-       IF ( cthf /= 0.0_wp )  THEN
-
-          ALLOCATE( cum_lai_hf(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!
-!--       Piecewise calculation of the cumulative leaf area index by vertical integration of the
-!--       leaf area density
-          cum_lai_hf(:,:,:) = 0.0_wp
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                DO  k = pch_index_ji(j,i)-1, 0, -1
-                   IF ( k == pch_index_ji(j,i)-1 )  THEN
-                      cum_lai_hf(k,j,i) = cum_lai_hf(k+1,j,i) +                                    &
-                                          ( 0.5_wp * lad_s(k+1,j,i) *                              &
-                                            ( zw(k+1) - zu(k+1) ) )  +                             &
-                                          ( 0.5_wp * ( 0.5_wp * ( lad_s(k+1,j,i) +                 &
-                                                                  lad_s(k,j,i) ) +                 &
-                                                       lad_s(k+1,j,i) ) *                          &
-                                            ( zu(k+1) - zw(k) ) )
-                   ELSE
-                      cum_lai_hf(k,j,i) = cum_lai_hf(k+1,j,i) +                                    &
-                                          ( 0.5_wp * ( 0.5_wp * ( lad_s(k+2,j,i) +                 &
-                                                                  lad_s(k+1,j,i) ) +               &
-                                                       lad_s(k+1,j,i) ) *                          &
-                                            ( zw(k+1) - zu(k+1) ) )  +                             &
-                                          ( 0.5_wp * ( 0.5_wp * ( lad_s(k+1,j,i) +                 &
-                                                                  lad_s(k,j,i) ) +                 &
-                                                       lad_s(k+1,j,i) ) *                          &
-                                            ( zu(k+1) - zw(k) ) )
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-
-!
-!--       In areas with canopy the surface value of the canopy heat flux distribution overrides the
-!--       surface heat flux (shf),
-!--       Start with default surface type
-          DO  m = 1, surf_def_h(0)%ns
-             i = surf_def_h(0)%i(m)
-             j = surf_def_h(0)%j(m)
-             IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                                    &
-                surf_def_h(0)%shf(m) = cthf * EXP( -ext_coef * cum_lai_hf(0,j,i) )
-          ENDDO
-!
-!--       Natural surfaces
-          DO  m = 1, surf_lsm_h(0)%ns
-             i = surf_lsm_h(0)%i(m)
-             j = surf_lsm_h(0)%j(m)
-             IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                                    &
-                surf_lsm_h(0)%shf(m) = cthf * EXP( -ext_coef * cum_lai_hf(0,j,i) )
-          ENDDO
-!
-!--       Urban surfaces
-          DO  m = 1, surf_usm_h(0)%ns
-             i = surf_usm_h(0)%i(m)
-             j = surf_usm_h(0)%j(m)
-             IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                                    &
-                surf_usm_h(0)%shf(m) = cthf * EXP( -ext_coef * cum_lai_hf(0,j,i) )
-          ENDDO
-!
-!
-!--       Calculation of the heating rate (K/s) within the different layers of the plant canopy.
-!--       Calculation is only necessary in areas covered with canopy.
-!--       Within the different canopy layers the plant-canopy heating rate (pcm_heating_rate) is
-!--       calculated as the vertical divergence of the canopy heat fluxes at the top and bottom of
-!--       the respective layer.
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                DO  k = 1, pch_index_ji(j,i)
-                   IF ( cum_lai_hf(0,j,i) /= 0.0_wp )  THEN
-                      pcm_heating_rate(k,j,i) = cthf *                                             &
-                                                ( EXP( -ext_coef * cum_lai_hf(k,j,i) ) -           &
-                                                  EXP( -ext_coef * cum_lai_hf(k-1,j,i) ) ) / dzw(k)
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ENDIF
-
-       IF ( debug_output )  CALL debug_message( 'pcm_init', 'end' )
-
-    END SUBROUTINE pcm_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &plant_canopy_parameters for plant canopy model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pcm_parin
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter file
-
-    INTEGER(iwp) ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /plant_canopy_parameters/  alpha_lad,                                                 &
-                                        beta_lad,                                                  &
-                                        canopy_drag_coeff,                                         &
-                                        canopy_mode,                                               &
-                                        cthf,                                                      &
-                                        lad_surface,                                               &
-                                        lad_type_coef,                                             &
-                                        lad_vertical_gradient,                                     &
-                                        lad_vertical_gradient_level,                               &
-                                        lai_beta,                                                  &
-                                        leaf_scalar_exch_coeff,                                    &
-                                        leaf_surface_conc,                                         &
-                                        pch_index,                                                 &
-                                        plant_canopy_transpiration,                                &
-                                        switch_off_module
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the user-defined namelist
-!-- plant_canopy_parameters.
-    REWIND( 11 )
-    READ( 11, plant_canopy_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    plant_canopy_parameters namelist was found and read correctly. Set flag that indicates that
-!--    the plant-canopy model is switched on.
-       IF ( .NOT. switch_off_module )  plant_canopy = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    plant_canopy_parameters namelist was found but contained errors. Print an error message
-!--    including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'plant_canopy_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE pcm_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> Loads 3D plant canopy data from file. File format is as follows:
-!>
-!> num_levels
-!> dtype,x,y,pctype,value(nzb),value(nzb+1), ... ,value(nzb+num_levels-1)
-!> dtype,x,y,pctype,value(nzb),value(nzb+1), ... ,value(nzb+num_levels-1)
-!> dtype,x,y,pctype,value(nzb),value(nzb+1), ... ,value(nzb+num_levels-1)
-!> ...
-!>
-!> i.e. first line determines number of levels and further lines represent plant canopy data, one
-!> line per column and variable. In each data line, dtype represents variable to be set:
-!>
-!> dtype=1: leaf area density (lad_s)
-!> dtype=2....n: some additional plant canopy input data quantity
-!>
-!> Zeros are added automatically above num_levels until top of domain. Any non-specified (x,y)
-!> columns have zero values as default.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_read_plant_canopy_3d
-
-       USE exchange_horiz_mod,                                                                     &
-           ONLY:  exchange_horiz
-
-       INTEGER(iwp) ::  dtype     !< type of input data (1=lad)
-       INTEGER(iwp) ::  i         !< running index
-       INTEGER(iwp) ::  j         !< running index
-       INTEGER(iwp) ::  kk        !<
-       INTEGER(iwp) ::  nzp       !< number of vertical layers of plant canopy
-       INTEGER(iwp) ::  nzpltop   !<
-       INTEGER(iwp) ::  nzpl      !<
-       INTEGER(iwp) ::  pctype    !< type of plant canopy (deciduous,non-deciduous,...)
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  col   !< vertical column of input data
-
-!
-!--    Initialize lad_s array
-       lad_s = 0.0_wp
-
-!
-!--    Open and read plant canopy input data
-       OPEN( 152, FILE='PLANT_CANOPY_DATA_3D' // TRIM( coupling_char ), ACCESS='SEQUENTIAL',       &
-                  ACTION='READ', STATUS='OLD', FORM='FORMATTED', ERR=515 )
-       READ( 152, *, ERR=516, END=517 )  nzp   !< read first line = number of vertical layers
-       nzpltop = MIN(nzt+1, nzb+nzp-1)
-       nzpl = nzpltop - nzb + 1    !< no. of layers to assign
-       ALLOCATE( col(0:nzp-1) )
-
-       DO
-          READ( 152, *, ERR=516, END=517 ) dtype, i, j, pctype, col(:)
-          IF ( i < nxlg  .OR.  i > nxrg  .OR.  j < nysg  .OR.  j > nyng )  CYCLE
-
-          SELECT CASE ( dtype )
-             CASE( 1 )   !< leaf area density
-!
-!--             This is just the pure canopy layer assumed to be grounded to a flat domain surface.
-!--             At locations where plant canopy sits on top of any kind of topography, the vertical
-!--             plant column must be "lifted", which is done in SUBROUTINE pcm_tendency.
-                IF ( pctype < 0  .OR.  pctype > 10 )  THEN   !< incorrect plant canopy type
-                   WRITE( message_string, * ) 'Incorrect type of plant canopy. '   //              &
-                                              'Allowed values 0 <= pctype <= 10, ' //              &
-                                              'but pctype is ', pctype
-                   CALL message( 'pcm_read_plant_canopy_3d', 'PA0349', 1, 2, 0, 6, 0 )
-                ENDIF
-                kk = topo_top_ind(j,i,0)
-                lad_s(nzb:nzpltop-kk, j, i) = col(kk:nzpl-1)*lad_type_coef(pctype)
-             CASE DEFAULT
-                WRITE( message_string, '(a,i2,a)' )                                                &
-                     'Unknown record type in file PLANT_CANOPY_DATA_3D: "', dtype, '"'
-                CALL message( 'pcm_read_plant_canopy_3d', 'PA0530', 1, 2, 0, 6, 0 )
-          END SELECT
-       ENDDO
-
-515    message_string = 'error opening file PLANT_CANOPY_DATA_3D'
-       CALL message( 'pcm_read_plant_canopy_3d', 'PA0531', 1, 2, 0, 6, 0 )
-
-516    message_string = 'error reading file PLANT_CANOPY_DATA_3D'
-       CALL message( 'pcm_read_plant_canopy_3d', 'PA0532', 1, 2, 0, 6, 0 )
-
-517    CLOSE( 152 )
-       DEALLOCATE( col )
-
-       CALL exchange_horiz( lad_s, nbgp )
-
-    END SUBROUTINE pcm_read_plant_canopy_3d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_rrd_global_ftn( found )
-
-       LOGICAL, INTENT(OUT) ::  found
-
-
-       found = .TRUE.
-
-       SELECT CASE ( restart_string(1:length) )
-
-          CASE ( 'pch_index' )
-             READ( 13 )  pch_index
-
-          CASE DEFAULT
-
-             found = .FALSE.
-
-       END SELECT
-
-    END SUBROUTINE pcm_rrd_global_ftn
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_rrd_global_mpi
-
-       CALL rrd_mpi_io( 'pch_index', pch_index )
-
-    END SUBROUTINE pcm_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, &
-                                  nyn_on_file, nysf, nysc, nys_on_file, found )
-
-       INTEGER(iwp) ::  k               !<
-       INTEGER(iwp) ::  nxl_on_file     !<
-       INTEGER(iwp) ::  nxlc            !<
-       INTEGER(iwp) ::  nxlf            !<
-       INTEGER(iwp) ::  nxr_on_file     !<
-       INTEGER(iwp) ::  nxrc            !<
-       INTEGER(iwp) ::  nxrf            !<
-       INTEGER(iwp) ::  nyn_on_file     !<
-       INTEGER(iwp) ::  nync            !<
-       INTEGER(iwp) ::  nynf            !<
-       INTEGER(iwp) ::  nys_on_file     !<
-       INTEGER(iwp) ::  nysc            !<
-       INTEGER(iwp) ::  nysf            !<
-
-       LOGICAL, INTENT(OUT) ::  found
-
-       REAL(wp), DIMENSION( 0:pch_index,                                                           &
-                            nys_on_file-nbgp:nyn_on_file+nbgp,                                     &
-                            nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d2  !< temporary 3D array for entire vertical
-                                                                           !< extension of canopy layer
-       found = .TRUE.
-
-
-       SELECT CASE ( restart_string(1:length) )
-
-          CASE ( 'pcm_heatrate_av' )
-             IF ( .NOT. ALLOCATED( pcm_heatrate_av ) )  THEN
-                ALLOCATE( pcm_heatrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) )
-                pcm_heatrate_av = 0.0_wp
-             ENDIF
-             IF ( k == 1 )  READ( 13 )  tmp_3d2
-             pcm_heatrate_av(0:pch_index,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                &
-                        tmp_3d2(0:pch_index,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'pcm_latentrate_av' )
-             IF ( .NOT. ALLOCATED( pcm_latentrate_av ) )  THEN
-                ALLOCATE( pcm_latentrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) )
-                pcm_latentrate_av = 0.0_wp
-             ENDIF
-             IF ( k == 1 )  READ( 13 )  tmp_3d2
-             pcm_latentrate_av(0:pch_index,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =              &
-                        tmp_3d2(0:pch_index,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE ( 'pcm_transpirationrate_av' )
-             IF ( .NOT. ALLOCATED( pcm_transpirationrate_av ) )  THEN
-                ALLOCATE( pcm_transpirationrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) )
-                pcm_transpirationrate_av = 0.0_wp
-             ENDIF
-             IF ( k == 1 )  READ( 13 )  tmp_3d2
-             pcm_transpirationrate_av(0:pch_index,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =       &
-                        tmp_3d2(0:pch_index,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-          CASE DEFAULT
-
-             found = .FALSE.
-
-       END SELECT
-
-    END SUBROUTINE pcm_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_rrd_local_mpi
-
-       IMPLICIT NONE
-
-       LOGICAL ::  array_found  !<
-
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  tmp_3d  !< temporary array to store pcm data with
-                                                           !< non-standard vertical index bounds
-
-!
-!--    Plant canopy arrays have non standard reduced vertical index bounds. They are stored with
-!--    full vertical bounds (bzb:nzt+1) in the restart file and must be re-stored after reading.
-       CALL rd_mpi_io_check_array( 'pcm_heatrate_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( pcm_heatrate_av ) )  THEN
-             ALLOCATE( pcm_heatrate_av(nzb:pch_index,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'pcm_heatrate_av', tmp_3d )
-          pcm_heatrate_av = tmp_3d(nzb:pch_index,:,:)
-          DEALLOCATE( tmp_3d )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'pcm_latentrate_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( pcm_latentrate_av ) )  THEN
-             ALLOCATE( pcm_latentrate_av(nzb:pch_index,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'pcm_latentrate_av', tmp_3d )
-          pcm_latentrate_av = tmp_3d(nzb:pch_index,:,:)
-          DEALLOCATE( tmp_3d )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'pcm_transpirationrate_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( pcm_transpirationrate_av ) )  THEN
-             ALLOCATE( pcm_transpirationrate_av(nzb:pch_index,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'pcm_transpirationrate_av', tmp_3d )
-          pcm_transpirationrate_av = tmp_3d(nzb:pch_index,:,:)
-          DEALLOCATE( tmp_3d )
-       ENDIF
-
-    END SUBROUTINE pcm_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of the tendency terms, accounting for the effect of the plant canopy on momentum and
-!> scalar quantities.
-!>
-!> The canopy is located where the leaf area density lad_s(k,j,i) > 0.0 (defined on scalar grid), as
-!> initialized in subroutine pcm_init.
-!> The lad on the w-grid is vertically interpolated from the surrounding lad_s. The upper boundary
-!> of the canopy is defined on the w-grid at k = pch_index. Here, the lad is zero.
-!>
-!> The canopy drag must be limited (previously accounted for by calculation of a limiting canopy
-!> timestep for the determination of the maximum LES timestep in subroutine timestep), since it is
-!> physically impossible that the canopy drag alone can locally change the sign of a velocity
-!> component. This limitation is realized by calculating preliminary tendencies and velocities. It
-!> is subsequently checked if the preliminary new velocity has a different sign than the current
-!> velocity. If so, the tendency is limited in a way that the velocity can at maximum be reduced to
-!> zero by the canopy drag.
-!>
-!>
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_tendency( component )
-
-       INTEGER(iwp) ::  component !< prognostic variable (u,v,w,pt,q,e)
-       INTEGER(iwp) ::  i         !< running index
-       INTEGER(iwp) ::  j         !< running index
-       INTEGER(iwp) ::  k         !< running index
-       INTEGER(iwp) ::  kk        !< running index for flat lad arrays
-
-       LOGICAL ::  building_edge_e !< control flag indicating an eastward-facing building edge
-       LOGICAL ::  building_edge_n !< control flag indicating a north-facing building edge
-       LOGICAL ::  building_edge_s !< control flag indicating a south-facing building edge
-       LOGICAL ::  building_edge_w !< control flag indicating a westward-facing building edge
-
-       REAL(wp) ::  bad_local !< local bad value
-       REAL(wp) ::  ddt_3d    !< inverse of the LES timestep (dt_3d)
-       REAL(wp) ::  lad_local !< local lad value
-       REAL(wp) ::  pre_tend  !< preliminary tendency
-       REAL(wp) ::  pre_u     !< preliminary u-value
-       REAL(wp) ::  pre_v     !< preliminary v-value
-       REAL(wp) ::  pre_w     !< preliminary w-value
-
-
-       ddt_3d = 1.0_wp / dt_3d
-
-!
-!--    Compute drag for the three velocity components and the SGS-TKE:
-       SELECT CASE ( component )
-
-!
-!--       u-component
-          CASE ( 1 )
-             DO  i = nxlu, nxr
-                DO  j = nys, nyn
-!
-!--                Set control flags indicating east- and westward-orientated building edges. Note,
-!--                building_egde_w is set from the perspective of the potential rooftop grid point,
-!--                while building_edge_e is set from the perspective of the non-building grid point.
-                   building_edge_w =              ANY( BTEST( wall_flags_total_0(:,j,i),   6 ) )   &
-                                     .AND.  .NOT. ANY( BTEST( wall_flags_total_0(:,j,i-1), 6 ) )
-                   building_edge_e =              ANY( BTEST( wall_flags_total_0(:,j,i-1), 6 ) )   &
-                                     .AND.  .NOT. ANY( BTEST( wall_flags_total_0(:,j,i),   6 ) )
-!
-!--                Determine topography-top index on u-grid
-                   DO  k = topo_top_ind(j,i,1)+1, topo_top_ind(j,i,1) + pch_index_ji(j,i)
-
-                      kk = k - topo_top_ind(j,i,1)   !- lad arrays are defined flat
-!
-!--                   In order to create sharp boundaries of the plant canopy, the lad on the u-grid
-!--                   at index (k,j,i) is equal to lad_s(k,j,i), rather than being interpolated from
-!--                   the surrounding lad_s, because this would yield smaller lad at the canopy
-!--                   boundaries than inside of the canopy.
-!--                   For the same reason, the lad at the rightmost(i+1)canopy boundary on the
-!--                   u-grid equals lad_s(k,j,i), which is considered in the next if-statement.
-!--                   Note, at left-sided building edges this is not applied, here the LAD equals
-!--                   the LAD at grid point (k,j,i), in order to avoid that LAD is mistakenly mapped
-!--                   on top of a roof where (usually) no LAD is defined. The same is also valid for
-!--                   bad_s.
-                      lad_local = lad_s(kk,j,i)
-                      IF ( lad_local == 0.0_wp  .AND.  lad_s(kk,j,i-1) > 0.0_wp                    &
-                           .AND.  .NOT. building_edge_w )  lad_local = lad_s(kk,j,i-1)
-
-                      bad_local = bad_s(kk,j,i)
-                      IF ( bad_local == 0.0_wp  .AND.  bad_s(kk,j,i-1) > 0.0_wp                    &
-                           .AND.  .NOT. building_edge_w )  bad_local = bad_s(kk,j,i-1)
-!
-!--                   In order to avoid that LAD is mistakenly considered at right-sided building
-!--                   edges (here the topography-top index for the u-component at index j,i is still
-!--                   on the building while the topography top for the scalar isn't), LAD is taken
-!--                   from grid point (j,i-1). The same is also valid for bad_s.
-                      IF ( lad_local > 0.0_wp  .AND.  lad_s(kk,j,i-1) == 0.0_wp                    &
-                           .AND.  building_edge_e )  lad_local = lad_s(kk,j,i-1)
-                      IF ( bad_local > 0.0_wp  .AND.  bad_s(kk,j,i-1) == 0.0_wp                    &
-                           .AND.  building_edge_e )  bad_local = bad_s(kk,j,i-1)
-
-                      pre_tend = 0.0_wp
-                      pre_u = 0.0_wp
-!
-!--                   Calculate preliminary value (pre_tend) of the tendency
-                      pre_tend = - canopy_drag_coeff *                                             &
-                                   ( lad_local + bad_local ) *                                     &
-                                   SQRT( u(k,j,i)**2 +                                             &
-                                         ( 0.25_wp * ( v(k,j,i-1) +                                &
-                                                       v(k,j,i)   +                                &
-                                                       v(k,j+1,i) +                                &
-                                                       v(k,j+1,i-1) )                              &
-                                         )**2 +                                                    &
-                                         ( 0.25_wp * ( w(k-1,j,i-1) +                              &
-                                                       w(k-1,j,i)   +                              &
-                                                       w(k,j,i-1)   +                              &
-                                                       w(k,j,i) )                                  &
-                                         )**2                                                      &
-                                       ) *                                                         &
-                                   u(k,j,i)
-
-!
-!--                   Calculate preliminary new velocity, based on pre_tend
-                      pre_u = u(k,j,i) + dt_3d * pre_tend
-!
-!--                   Compare sign of old velocity and new preliminary velocity,
-!--                   and in case the signs are different, limit the tendency
-                      IF ( SIGN( pre_u,u(k,j,i) ) /= pre_u )  THEN
-                         pre_tend = - u(k,j,i) * ddt_3d
-                      ENDIF
-!
-!--                   Calculate final tendency
-                      tend(k,j,i) = tend(k,j,i) + pre_tend
-
-                   ENDDO
-                ENDDO
-             ENDDO
-
-!
-!--       v-component
-          CASE ( 2 )
-             DO  i = nxl, nxr
-                DO  j = nysv, nyn
-!
-!--                Set control flags indicating north- and southward-orientated building edges.
-!--                Note, building_egde_s is set from the perspective of the potential rooftop grid
-!--                point, while building_edge_n is set from the perspective of the non-building grid
-!--                point.
-                   building_edge_s =              ANY( BTEST( wall_flags_total_0(:,j,i),   6 ) )   &
-                                     .AND.  .NOT. ANY( BTEST( wall_flags_total_0(:,j-1,i), 6 ) )
-                   building_edge_n =              ANY( BTEST( wall_flags_total_0(:,j-1,i), 6 ) )   &
-                                     .AND.  .NOT. ANY( BTEST( wall_flags_total_0(:,j,i),   6 ) )
-!
-!--                Determine topography-top index on v-grid
-                   DO  k = topo_top_ind(j,i,2)+1, topo_top_ind(j,i,2) + pch_index_ji(j,i)
-
-                      kk = k - topo_top_ind(j,i,2)   !- lad arrays are defined flat
-!
-!--                   In order to create sharp boundaries of the plant canopy, the lad on the v-grid
-!--                   at index (k,j,i) is equal to lad_s(k,j,i), rather than being interpolated from
-!--                   the surrounding lad_s, because this would yield smaller lad at the canopy
-!--                   boundaries  than inside of the canopy.
-!--                   For the same reason, the lad at the northmost (j+1) canopy boundary on the
-!--                   v-grid equals lad_s(k,j,i), which is considered in the next if-statement.
-!--                   Note, at left-sided building edges this is not applied, here the LAD equals
-!--                   the LAD at grid point (k,j,i), in order to avoid that LAD is mistakenly mapped
-!--                   on top of a roof where (usually) no LAD is defined.
-!--                   The same is also valid for bad_s.
-                      lad_local = lad_s(kk,j,i)
-                      IF ( lad_local == 0.0_wp  .AND.  lad_s(kk,j-1,i) > 0.0_wp                    &
-                           .AND.  .NOT. building_edge_s )  lad_local = lad_s(kk,j-1,i)
-
-                      bad_local = bad_s(kk,j,i)
-                      IF ( bad_local == 0.0_wp  .AND.  bad_s(kk,j-1,i) > 0.0_wp                    &
-                           .AND.  .NOT. building_edge_s )  bad_local = bad_s(kk,j-1,i)
-!
-!--                   In order to avoid that LAD is mistakenly considered at right-sided building
-!--                   edges (here the topography-top index for the u-component at index j,i is still
-!--                   on the building while the topography top for the scalar isn't), LAD is taken
-!--                   from grid point (j,i-1). The same is also valid for bad_s.
-                      IF ( lad_local > 0.0_wp  .AND.  lad_s(kk,j-1,i) == 0.0_wp                    &
-                           .AND.  building_edge_n )  lad_local = lad_s(kk,j-1,i)
-
-                      IF ( bad_local > 0.0_wp  .AND.  bad_s(kk,j-1,i) == 0.0_wp                    &
-                           .AND.  building_edge_n )  bad_local = bad_s(kk,j-1,i)
-
-                      pre_tend = 0.0_wp
-                      pre_v = 0.0_wp
-!
-!--                   Calculate preliminary value (pre_tend) of the tendency
-                      pre_tend = - canopy_drag_coeff *                                             &
-                                   ( lad_local + bad_local ) *                                     &
-                                   SQRT( ( 0.25_wp * ( u(k,j-1,i)   +                              &
-                                                       u(k,j-1,i+1) +                              &
-                                                       u(k,j,i)     +                              &
-                                                       u(k,j,i+1) )                                &
-                                         )**2 +                                                    &
-                                         v(k,j,i)**2 +                                             &
-                                         ( 0.25_wp * ( w(k-1,j-1,i) +                              &
-                                                       w(k-1,j,i)   +                              &
-                                                       w(k,j-1,i)   +                              &
-                                                       w(k,j,i) )                                  &
-                                         )**2                                                      &
-                                       ) *                                                         &
-                                   v(k,j,i)
-
-!
-!--                   Calculate preliminary new velocity, based on pre_tend
-                      pre_v = v(k,j,i) + dt_3d * pre_tend
-!
-!--                   Compare sign of old velocity and new preliminary velocity, and in case the
-!--                   signs are different, limit the tendency.
-                      IF ( SIGN( pre_v,v(k,j,i) ) /= pre_v )  THEN
-                         pre_tend = - v(k,j,i) * ddt_3d
-                      ELSE
-                         pre_tend = pre_tend
-                      ENDIF
-!
-!--                   Calculate final tendency
-                      tend(k,j,i) = tend(k,j,i) + pre_tend
-
-                   ENDDO
-                ENDDO
-             ENDDO
-
-!
-!--       w-component
-          CASE ( 3 )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-!
-!--                Determine topography-top index on w-grid
-                   DO  k = topo_top_ind(j,i,3)+1, topo_top_ind(j,i,3) + pch_index_ji(j,i) - 1
-
-                      kk = k - topo_top_ind(j,i,3)   !- lad arrays are defined flat
-
-                      pre_tend = 0.0_wp
-                      pre_w = 0.0_wp
-!
-!--                   Calculate preliminary value (pre_tend) of the tendency
-                      pre_tend = - canopy_drag_coeff *                                             &
-                                   ( 0.5_wp * ( lad_s(kk+1,j,i) + lad_s(kk,j,i) ) +                &
-                                     0.5_wp * ( bad_s(kk+1,j,i) + bad_s(kk,j,i) ) ) *              &
-                                   SQRT( ( 0.25_wp * ( u(k,j,i)   +                                &
-                                                       u(k,j,i+1) +                                &
-                                                       u(k+1,j,i) +                                &
-                                                       u(k+1,j,i+1) )                              &
-                                         )**2 +                                                    &
-                                         ( 0.25_wp * ( v(k,j,i)   +                                &
-                                                       v(k,j+1,i) +                                &
-                                                       v(k+1,j,i) +                                &
-                                                       v(k+1,j+1,i) )                              &
-                                         )**2 +                                                    &
-                                         w(k,j,i)**2                                               &
-                                       ) *                                                         &
-                                   w(k,j,i)
-!
-!--                   Calculate preliminary new velocity, based on pre_tend
-                      pre_w = w(k,j,i) + dt_3d * pre_tend
-!
-!--                   Compare sign of old velocity and new preliminary velocity, and in case the
-!--                   signs are different, limit the tendency
-                      IF ( SIGN( pre_w,w(k,j,i) ) /= pre_w )  THEN
-                         pre_tend = - w(k,j,i) * ddt_3d
-                      ELSE
-                         pre_tend = pre_tend
-                      ENDIF
-!
-!--                   Calculate final tendency
-                      tend(k,j,i) = tend(k,j,i) + pre_tend
-
-                   ENDDO
-                ENDDO
-             ENDDO
-
-!
-!--       potential temperature
-          CASE ( 4 )
-             IF ( humidity )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-!--                   Determine topography-top index on scalar-grid
-                      DO  k = topo_top_ind(j,i,0)+1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
-                         kk = k - topo_top_ind(j,i,0)   !- lad arrays are defined flat
-                         tend(k,j,i) = tend(k,j,i) + pcm_heating_rate(kk,j,i) - pcm_latent_rate(kk,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-!--                   Determine topography-top index on scalar-grid
-                      DO  k = topo_top_ind(j,i,0)+1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
-                         kk = k - topo_top_ind(j,i,0)   !- lad arrays are defined flat
-                         tend(k,j,i) = tend(k,j,i) + pcm_heating_rate(kk,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-!
-!--       humidity
-          CASE ( 5 )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-!
-!--                Determine topography-top index on scalar-grid
-                   DO  k = topo_top_ind(j,i,0)+1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
-
-                      kk = k - topo_top_ind(j,i,0)   !- lad arrays are defined flat
-
-                      IF ( .NOT. plant_canopy_transpiration )  THEN
-                         ! pcm_transpiration_rate is calculated in radiation model
-                         ! in case of plant_canopy_transpiration = .T.
-                         ! to include also the dependecy to the radiation
-                         ! in the plant canopy box
-                         pcm_transpiration_rate(kk,j,i) = - leaf_scalar_exch_coeff                 &
-                                                            * lad_s(kk,j,i) *                      &
-                                                            SQRT( ( 0.5_wp * ( u(k,j,i) +          &
-                                                                               u(k,j,i+1) )        &
-                                                                  )**2 +                           &
-                                                                  ( 0.5_wp * ( v(k,j,i) +          &
-                                                                               v(k,j+1,i) )        &
-                                                                  )**2 +                           &
-                                                                  ( 0.5_wp * ( w(k-1,j,i) +        &
-                                                                               w(k,j,i) )          &
-                                                                  )**2                             &
-                                                                ) *                                &
-                                                            ( q(k,j,i) - leaf_surface_conc )
-                      ENDIF
-
-                      tend(k,j,i) = tend(k,j,i) + pcm_transpiration_rate(kk,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-
-!
-!--       sgs-tke
-          CASE ( 6 )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-!
-!--                Determine topography-top index on scalar-grid
-                   DO  k = topo_top_ind(j,i,0)+1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
-
-                      kk = k - topo_top_ind(j,i,0)   !- lad arrays are defined flat
-                      tend(k,j,i) = tend(k,j,i) -  2.0_wp * canopy_drag_coeff *                    &
-                                                   ( lad_s(kk,j,i) + bad_s(kk,j,i) ) *             &
-                                                   SQRT( ( 0.5_wp * ( u(k,j,i) +                   &
-                                                                      u(k,j,i+1) )                 &
-                                                         )**2 +                                    &
-                                                         ( 0.5_wp * ( v(k,j,i) +                   &
-                                                                      v(k,j+1,i) )                 &
-                                                         )**2 +                                    &
-                                                         ( 0.5_wp * ( w(k,j,i) +                   &
-                                                                      w(k+1,j,i) )                 &
-                                                         )**2                                      &
-                                                       ) *                                         &
-                                                   e(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--       scalar concentration
-          CASE ( 7 )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-!
-!--                Determine topography-top index on scalar-grid
-                   DO  k = topo_top_ind(j,i,0)+1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
-
-                      kk = k - topo_top_ind(j,i,0)   !- lad arrays are defined flat
-                      tend(k,j,i) = tend(k,j,i) -  leaf_scalar_exch_coeff *                        &
-                                                   lad_s(kk,j,i) *                                 &
-                                                   SQRT( ( 0.5_wp * ( u(k,j,i) +                   &
-                                                                      u(k,j,i+1) )                 &
-                                                         )**2 +                                    &
-                                                         ( 0.5_wp * ( v(k,j,i) +                   &
-                                                                      v(k,j+1,i) )                 &
-                                                         )**2 +                                    &
-                                                         ( 0.5_wp * ( w(k-1,j,i) +                 &
-                                                                      w(k,j,i) )                   &
-                                                         )**2                                      &
-                                                       ) *                                         &
-                                                   ( s(k,j,i) - leaf_surface_conc )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-
-
-          CASE DEFAULT
-
-             WRITE( message_string, * ) 'wrong component: ', component
-             CALL message( 'pcm_tendency', 'PA0279', 1, 2, 0, 6, 0 )
-
-       END SELECT
-
-    END SUBROUTINE pcm_tendency
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of the tendency terms, accounting for the effect of the plant canopy on momentum and
-!> scalar quantities.
-!>
-!> The canopy is located where the leaf area density lad_s(k,j,i) > 0.0 (defined on scalar grid), as
-!> initialized in subroutine pcm_init.
-!> The lad on the w-grid is vertically interpolated from the surrounding lad_s. The upper boundary
-!> of the canopy is defined on the w-grid at k = pch_index. Here, the lad is zero.
-!>
-!> The canopy drag must be limited (previously accounted for by calculation of a limiting canopy
-!> timestep for the determination of the maximum LES timestep in subroutine timestep), since it is
-!> physically impossible that the canopy drag alone can locally change the sign of a velocity
-!> component. This limitation is realized by calculating preliminary tendencies and velocities. It
-!> is subsequently checked if the preliminary new velocity has a different sign than the current
-!> velocity. If so, the tendency is limited in a way that the velocity can at maximum be reduced to
-!> zero by the canopy drag.
-!>
-!>
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_tendency_ij( i, j, component )
-
-       INTEGER(iwp) ::  component !< prognostic variable (u,v,w,pt,q,e)
-       INTEGER(iwp) ::  i         !< running index
-       INTEGER(iwp) ::  j         !< running index
-       INTEGER(iwp) ::  k         !< running index
-       INTEGER(iwp) ::  kk        !< running index for flat lad arrays
-
-       LOGICAL ::  building_edge_e !< control flag indicating an eastward-facing building edge
-       LOGICAL ::  building_edge_n !< control flag indicating a north-facing building edge
-       LOGICAL ::  building_edge_s !< control flag indicating a south-facing building edge
-       LOGICAL ::  building_edge_w !< control flag indicating a westward-facing building edge
-
-       REAL(wp) ::  bad_local !< local lad value
-       REAL(wp) ::  ddt_3d    !< inverse of the LES timestep (dt_3d)
-       REAL(wp) ::  lad_local !< local lad value
-       REAL(wp) ::  pre_tend  !< preliminary tendency
-       REAL(wp) ::  pre_u     !< preliminary u-value
-       REAL(wp) ::  pre_v     !< preliminary v-value
-       REAL(wp) ::  pre_w     !< preliminary w-value
-
-
-       ddt_3d = 1.0_wp / dt_3d
-!
-!--    Compute drag for the three velocity components and the SGS-TKE
-       SELECT CASE ( component )
-
-!
-!--       u-component
-          CASE ( 1 )
-!
-!--          Set control flags indicating east- and westward-orientated building edges. Note,
-!--          building_egde_w is set from the perspective of the potential rooftop grid point, while
-!--          building_edge_e is set from the perspective of the non-building grid point.
-             building_edge_w =       ANY( BTEST( wall_flags_total_0(:,j,i),   6 ) )  .AND.         &
-                               .NOT. ANY( BTEST( wall_flags_total_0(:,j,i-1), 6 ) )
-             building_edge_e =       ANY( BTEST( wall_flags_total_0(:,j,i-1), 6 ) )  .AND.         &
-                               .NOT. ANY( BTEST( wall_flags_total_0(:,j,i),   6 ) )
-!
-!--          Determine topography-top index on u-grid
-             DO  k = topo_top_ind(j,i,1) + 1, topo_top_ind(j,i,1) + pch_index_ji(j,i)
-
-                kk = k - topo_top_ind(j,i,1)  !- lad arrays are defined flat
-
-!
-!--             In order to create sharp boundaries of the plant canopy, the lad on the u-grid at
-!--             index (k,j,i) is equal to lad_s(k,j,i), rather than being interpolated from the
-!--             surrounding lad_s, because this would yield smaller lad at the canopy boundaries
-!--             than inside of the canopy.
-!--             For the same reason, the lad at the rightmost(i+1)canopy boundary on the u-grid
-!--             equals lad_s(k,j,i), which is considered in the next if-statement. Note, at
-!--             left-sided building edges this is not applied, here the LAD is equals the LAD at
-!--             grid point (k,j,i), in order to avoid that LAD is mistakenly mapped on top of a roof
-!--             where (usually) is no LAD is defined.
-!--             The same is also valid for bad_s.
-                lad_local = lad_s(kk,j,i)
-                IF ( lad_local == 0.0_wp  .AND.  lad_s(kk,j,i-1) > 0.0_wp  .AND.                   &
-                     .NOT. building_edge_w )  lad_local = lad_s(kk,j,i-1)
-
-                bad_local = bad_s(kk,j,i)
-                IF ( bad_local == 0.0_wp  .AND.  bad_s(kk,j,i-1) > 0.0_wp  .AND.                   &
-                     .NOT. building_edge_w )  bad_local = bad_s(kk,j,i-1)
-!
-!--             In order to avoid that LAD is mistakenly considered at right-sided building edges
-!--             (here the topography-top index for the u-component at index j,i is still on the
-!--             building while the topography top for the scalar isn't), LAD is taken from grid
-!--             point (j,i-1). The same is also valid for bad_s.
-                IF ( lad_local > 0.0_wp  .AND.  lad_s(kk,j,i-1) == 0.0_wp  .AND.                   &
-                     building_edge_e )  lad_local = lad_s(kk,j,i-1)
-                IF ( bad_local > 0.0_wp  .AND.  bad_s(kk,j,i-1) == 0.0_wp  .AND.                   &
-                     building_edge_e )  bad_local = bad_s(kk,j,i-1)
-
-                pre_tend = 0.0_wp
-                pre_u = 0.0_wp
-!
-!--             Calculate preliminary value (pre_tend) of the tendency
-                pre_tend = - canopy_drag_coeff *                                                   &
-                             ( lad_local + bad_local ) *                                           &
-                             SQRT( u(k,j,i)**2 +                                                   &
-                                   ( 0.25_wp * ( v(k,j,i-1)  +                                     &
-                                                 v(k,j,i)    +                                     &
-                                                 v(k,j+1,i)  +                                     &
-                                                 v(k,j+1,i-1) )                                    &
-                                   )**2 +                                                          &
-                                   ( 0.25_wp * ( w(k-1,j,i-1) +                                    &
-                                                 w(k-1,j,i)   +                                    &
-                                                 w(k,j,i-1)   +                                    &
-                                                 w(k,j,i) )                                        &
-                                   )**2                                                            &
-                                 ) *                                                               &
-                             u(k,j,i)
-
-!
-!--             Calculate preliminary new velocity, based on pre_tend
-                pre_u = u(k,j,i) + dt_3d * pre_tend
-!
-!--             Compare sign of old velocity and new preliminary velocity, and in case the signs are
-!--             different, limit the tendency.
-                IF ( SIGN( pre_u,u(k,j,i) ) /= pre_u )  THEN
-                   pre_tend = - u(k,j,i) * ddt_3d
-                ELSE
-                   pre_tend = pre_tend
-                ENDIF
-!
-!--             Calculate final tendency
-                tend(k,j,i) = tend(k,j,i) + pre_tend
-             ENDDO
-
-
-!
-!--       v-component
-          CASE ( 2 )
-!
-!--          Set control flags indicating north- and southward-orientated building edges. Note,
-!--          building_egde_s is set from the perspective of the potential rooftop grid point, while
-!--          building_edge_n is set from the perspective of the non-building grid point.
-             building_edge_s =       ANY( BTEST( wall_flags_total_0(:,j,i),   6 ) )  .AND.         &
-                               .NOT. ANY( BTEST( wall_flags_total_0(:,j-1,i), 6 ) )
-             building_edge_n =       ANY( BTEST( wall_flags_total_0(:,j-1,i), 6 ) )  .AND.         &
-                               .NOT. ANY( BTEST( wall_flags_total_0(:,j,i),   6 ) )
-!
-!--          Determine topography-top index on v-grid
-             DO  k = topo_top_ind(j,i,2) + 1, topo_top_ind(j,i,2) + pch_index_ji(j,i)
-
-                kk = k - topo_top_ind(j,i,2)  !- lad arrays are defined flat
-!
-!--             In order to create sharp boundaries of the plant canopy, the lad on the v-grid at
-!--             index (k,j,i) is equal to lad_s(k,j,i), rather than being interpolated from the
-!--             surrounding lad_s, because this would yield smaller lad at the canopy boundaries
-!--             than inside of the canopy.
-!--             For the same reason, the lad at the northmost (j+1) canopy boundary on the v-grid
-!--             equals lad_s(k,j,i), which is considered in the next if-statement. Note, at
-!--             left-sided building edges this is not applied, here the LAD is equals the LAD at
-!--             grid point (k,j,i), in order to avoid that LAD is mistakenly mapped on top of a roof
-!--             where (usually) is no LAD is defined.
-!--             The same is also valid for bad_s.
-                lad_local = lad_s(kk,j,i)
-                IF ( lad_local == 0.0_wp  .AND.  lad_s(kk,j-1,i) > 0.0_wp  .AND.                   &
-                     .NOT. building_edge_s )  lad_local = lad_s(kk,j-1,i)
-
-                bad_local = bad_s(kk,j,i)
-                IF ( bad_local == 0.0_wp  .AND.  bad_s(kk,j-1,i) > 0.0_wp  .AND.                   &
-                     .NOT. building_edge_s )  bad_local = bad_s(kk,j-1,i)
-!
-!--             In order to avoid that LAD is mistakenly considered at right-sided building edges
-!--             (here the topography-top index for the u-component at index j,i is still on the
-!--             building while the topography top for the scalar isn't), LAD is taken from grid
-!--             point (j,i-1). The same is also valid for bad_s.
-                IF ( lad_local > 0.0_wp  .AND.  lad_s(kk,j-1,i) == 0.0_wp  .AND.                   &
-                     building_edge_n )  lad_local = lad_s(kk,j-1,i)
-                IF ( bad_local > 0.0_wp  .AND.  bad_s(kk,j-1,i) == 0.0_wp  .AND.                   &
-                     building_edge_n )  bad_local = bad_s(kk,j-1,i)
-
-                pre_tend = 0.0_wp
-                pre_v = 0.0_wp
-!
-!--             Calculate preliminary value (pre_tend) of the tendency
-                pre_tend = - canopy_drag_coeff *                                                   &
-                             ( lad_local + bad_local ) *                                           &
-                             SQRT( ( 0.25_wp * ( u(k,j-1,i)   +                                    &
-                                                 u(k,j-1,i+1) +                                    &
-                                                 u(k,j,i)     +                                    &
-                                                 u(k,j,i+1) )                                      &
-                                   )**2 +                                                          &
-                                   v(k,j,i)**2 +                                                   &
-                                   ( 0.25_wp * ( w(k-1,j-1,i) +                                    &
-                                                 w(k-1,j,i)   +                                    &
-                                                 w(k,j-1,i)   +                                    &
-                                                 w(k,j,i) )                                        &
-                                   )**2                                                            &
-                                 ) *                                                               &
-                             v(k,j,i)
-
-!
-!--             Calculate preliminary new velocity, based on pre_tend
-                pre_v = v(k,j,i) + dt_3d * pre_tend
-!
-!--             Compare sign of old velocity and new preliminary velocity,
-!--             and in case the signs are different, limit the tendency
-                IF ( SIGN( pre_v,v(k,j,i) ) /= pre_v )  THEN
-                   pre_tend = - v(k,j,i) * ddt_3d
-                ELSE
-                   pre_tend = pre_tend
-                ENDIF
-!
-!--             Calculate final tendency
-                tend(k,j,i) = tend(k,j,i) + pre_tend
-             ENDDO
-
-
-!
-!--       w-component
-          CASE ( 3 )
-!
-!--          Determine topography-top index on w-grid
-             DO  k = topo_top_ind(j,i,3) + 1, topo_top_ind(j,i,3) + pch_index_ji(j,i) - 1
-
-                kk = k - topo_top_ind(j,i,3)  !- lad arrays are defined flat
-
-                pre_tend = 0.0_wp
-                pre_w = 0.0_wp
-!
-!--             Calculate preliminary value (pre_tend) of the tendency
-                pre_tend = - canopy_drag_coeff *                                                   &
-                             ( 0.5_wp * ( lad_s(kk+1,j,i) + lad_s(kk,j,i) ) +                      &
-                               0.5_wp * ( bad_s(kk+1,j,i) + bad_s(kk,j,i) ) ) *                    &
-                             SQRT( ( 0.25_wp * ( u(k,j,i)    +                                     &
-                                                 u(k,j,i+1)  +                                     &
-                                                 u(k+1,j,i)  +                                     &
-                                                 u(k+1,j,i+1) )                                    &
-                                   )**2 +                                                          &
-                                   ( 0.25_wp * ( v(k,j,i)    +                                     &
-                                                 v(k,j+1,i)  +                                     &
-                                                 v(k+1,j,i)  +                                     &
-                                                 v(k+1,j+1,i) )                                    &
-                                   )**2 +                                                          &
-                                   w(k,j,i)**2                                                     &
-                                 ) *                                                               &
-                             w(k,j,i)
-!
-!--             Calculate preliminary new velocity, based on pre_tend
-                pre_w = w(k,j,i) + dt_3d * pre_tend
-!
-!--             Compare sign of old velocity and new preliminary velocity, and in case the signs are
-!--             different, limit the tendency.
-                IF ( SIGN( pre_w,w(k,j,i) ) /= pre_w )  THEN
-                   pre_tend = - w(k,j,i) * ddt_3d
-                ELSE
-                   pre_tend = pre_tend
-                ENDIF
-!
-!--             Calculate final tendency
-                tend(k,j,i) = tend(k,j,i) + pre_tend
-             ENDDO
-
-!
-!--       potential temperature
-          CASE ( 4 )
-!
-!--          Determine topography-top index on scalar grid
-             IF ( humidity )  THEN
-                DO  k = topo_top_ind(j,i,0) + 1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
-                   kk = k - topo_top_ind(j,i,0)  !- lad arrays are defined flat
-                   tend(k,j,i) = tend(k,j,i) + pcm_heating_rate(kk,j,i) - pcm_latent_rate(kk,j,i)
-                ENDDO
-             ELSE
-                DO  k = topo_top_ind(j,i,0) + 1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
-                   kk = k - topo_top_ind(j,i,0)  !- lad arrays are defined flat
-                   tend(k,j,i) = tend(k,j,i) + pcm_heating_rate(kk,j,i)
-                ENDDO
-             ENDIF
-
-!
-!--       humidity
-          CASE ( 5 )
-!
-!--          Determine topography-top index on scalar grid
-             DO  k = topo_top_ind(j,i,0) + 1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
-                kk = k - topo_top_ind(j,i,0)  !- lad arrays are defined flat
-                IF ( .NOT. plant_canopy_transpiration )  THEN
-                   ! pcm_transpiration_rate is calculated in radiation model
-                   ! in case of plant_canopy_transpiration = .T.
-                   ! to include also the dependecy to the radiation
-                   ! in the plant canopy box
-                   pcm_transpiration_rate(kk,j,i) = - leaf_scalar_exch_coeff                       &
-                                                    * lad_s(kk,j,i) *                              &
-                                                    SQRT( ( 0.5_wp * ( u(k,j,i) +                  &
-                                                                       u(k,j,i+1) )                &
-                                                          )**2  +                                  &
-                                                          ( 0.5_wp * ( v(k,j,i) +                  &
-                                                                       v(k,j+1,i) )                &
-                                                          )**2 +                                   &
-                                                          ( 0.5_wp * ( w(k-1,j,i) +                &
-                                                                       w(k,j,i) )                  &
-                                                          )**2                                     &
-                                                        ) *                                        &
-                                                    ( q(k,j,i) - leaf_surface_conc )
-                ENDIF
-
-                tend(k,j,i) = tend(k,j,i) + pcm_transpiration_rate(kk,j,i)
-
-             ENDDO
-
-!
-!--       sgs-tke
-          CASE ( 6 )
-!
-!--          Determine topography-top index on scalar grid
-             DO  k = topo_top_ind(j,i,0) + 1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
-
-                kk = k - topo_top_ind(j,i,0)
-                tend(k,j,i) = tend(k,j,i) -  2.0_wp * canopy_drag_coeff *                          &
-                                             ( lad_s(kk,j,i) + bad_s(kk,j,i) ) *                   &
-                                             SQRT( ( 0.5_wp * ( u(k,j,i) +                         &
-                                                                u(k,j,i+1) )                       &
-                                                   )**2 +                                          &
-                                                   ( 0.5_wp * ( v(k,j,i) +                         &
-                                                                v(k,j+1,i) )                       &
-                                                   )**2 +                                          &
-                                                   ( 0.5_wp * ( w(k,j,i) +                         &
-                                                                w(k+1,j,i) )                       &
-                                                   )**2                                            &
-                                                 ) *                                               &
-                                             e(k,j,i)
-             ENDDO
-!
-!--       scalar concentration
-          CASE ( 7 )
-!
-!--          Determine topography-top index on scalar grid
-             DO  k = topo_top_ind(j,i,0) + 1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
-
-                kk = k - topo_top_ind(j,i,0)
-                tend(k,j,i) = tend(k,j,i) -  leaf_scalar_exch_coeff *                              &
-                                             lad_s(kk,j,i) *                                       &
-                                             SQRT( ( 0.5_wp * ( u(k,j,i) +                         &
-                                                                u(k,j,i+1) )                       &
-                                                   )**2  +                                         &
-                                                   ( 0.5_wp * ( v(k,j,i) +                         &
-                                                                v(k,j+1,i) )                       &
-                                                   )**2 +                                          &
-                                                   ( 0.5_wp * ( w(k-1,j,i) +                       &
-                                                                w(k,j,i) )                         &
-                                                   )**2                                            &
-                                                 ) *                                               &
-                                             ( s(k,j,i) - leaf_surface_conc )
-             ENDDO
-
-       CASE DEFAULT
-
-          WRITE( message_string, * ) 'wrong component: ', component
-          CALL message( 'pcm_tendency', 'PA0279', 1, 2, 0, 6, 0 )
-
-       END SELECT
-
-    END SUBROUTINE pcm_tendency_ij
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine writes global restart data
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_wrd_global
-
-       IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-          CALL wrd_write_string( 'pch_index' )
-          WRITE( 14 )  pch_index
-
-       ELSE IF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-          CALL wrd_mpi_io( 'pch_index', pch_index )
-
-       ENDIF
-
-    END SUBROUTINE pcm_wrd_global
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine writes local (subdomain) restart data
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE pcm_wrd_local
-
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  tmp_3d  !< temporary array to store pcm data with
-                                                           !< non-standard vertical index bounds
-
-
-       IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-          IF ( ALLOCATED( pcm_heatrate_av ) )  THEN
-             CALL wrd_write_string( 'pcm_heatrate_av' )
-             WRITE( 14 )  pcm_heatrate_av
-          ENDIF
-
-          IF ( ALLOCATED( pcm_latentrate_av ) )  THEN
-             CALL wrd_write_string( 'pcm_latentrate_av' )
-             WRITE( 14 )  pcm_latentrate_av
-          ENDIF
-
-          IF ( ALLOCATED( pcm_transpirationrate_av ) )  THEN
-             CALL wrd_write_string( 'pcm_transpirationrate_av' )
-             WRITE( 14 )  pcm_transpirationrate_av
-          ENDIF
-
-       ELSE IF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-!
-!--       Plant canopy arrays have non standard reduced vertical index bounds. They are stored with
-!--       full vertical bounds (bzb:nzt+1) in the restart file and must be re-stored before writing.
-          IF ( ALLOCATED( pcm_heatrate_av ) )  THEN
-             ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             tmp_3d(nzb:pch_index,:,:)     = pcm_heatrate_av
-             tmp_3d(pch_index+1:nzt+1,:,:) = 0.0_wp
-             CALL wrd_mpi_io( 'pcm_heatrate_av', tmp_3d )
-             DEALLOCATE( tmp_3d )
-          ENDIF
-          IF ( ALLOCATED( pcm_latentrate_av ) )  THEN
-             ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             tmp_3d(nzb:pch_index,:,:)     = pcm_latentrate_av
-             tmp_3d(pch_index+1:nzt+1,:,:) = 0.0_wp
-             CALL wrd_mpi_io( 'pcm_latentrate_av', tmp_3d )
-             DEALLOCATE( tmp_3d )
-          ENDIF
-          IF ( ALLOCATED( pcm_transpirationrate_av ) )  THEN
-             ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             tmp_3d(nzb:pch_index,:,:)     = pcm_transpirationrate_av
-             tmp_3d(pch_index+1:nzt+1,:,:) = 0.0_wp
-             CALL wrd_mpi_io( 'pcm_transpirationrate_av', tmp_3d )
-             DEALLOCATE( tmp_3d )
-          ENDIF
-
-       ENDIF
-
-    END SUBROUTINE pcm_wrd_local
-
-
- END MODULE plant_canopy_model_mod
Index: palm/trunk/SOURCE/pmc_child_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_child_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,983 +1,0 @@
-MODULE pmc_child
-
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! Support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4360 2020-01-07 11:25:50Z suehring
-!
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3964 2019-05-09 09:48:32Z suehring
-! Remove unused variable
-!
-! 3963 2019-05-08 20:09:11Z suehring
-! Bugfixes in initial settings of child and parent communication patterns.
-!
-! 3945 2019-05-02 11:29:27Z raasch
-!
-! 3932 2019-04-24 17:31:34Z suehring
-! Typo removed
-!
-! 2019-02-25 15:31:42Z raasch
-! Statement added to avoid compiler warning
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Explicit kind settings
-!
-! 1762 2016-02-25 12:31:13Z hellstea
-! Initial revision by K. Ketelsen
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Child part of Palm Model Coupler
-!--------------------------------------------------------------------------------------------------!
-
-#if defined( __parallel )
-
-    USE, INTRINSIC ::  iso_c_binding
-
-    USE MPI
-
-    USE kinds
-
-    USE pmc_general,                                                                               &
-        ONLY:  arraydef,                                                                           &
-               childdef,                                                                           &
-               da_desclen,                                                                         &
-               da_namedef,                                                                         &
-               da_namelen,                                                                         &
-               pedef,                                                                              &
-               pmc_da_name_err,                                                                    &
-               pmc_g_setname,                                                                      &
-               pmc_max_array,                                                                      &
-               pmc_status_ok
-
-    USE pmc_handle_communicator,                                                                   &
-        ONLY:  m_model_comm,                                                                       &
-               m_model_npes,                                                                       &
-               m_model_rank,                                                                       &
-               m_to_parent_comm
-
-    USE pmc_mpi_wrapper,                                                                           &
-        ONLY:  pmc_alloc_mem,                                                                      &
-               pmc_bcast,                                                                          &
-               pmc_inter_bcast,                                                                    &
-               pmc_time
-
-    IMPLICIT NONE
-
-
-    PRIVATE
-    SAVE
-
-    INTEGER(iwp) ::  myindex = 0             !< counter and unique number for data arrays
-    INTEGER(iwp) ::  next_array_in_list = 0  !<
-
-    TYPE(childdef), PUBLIC ::  me  !<
-
-
-    INTERFACE pmc_childinit
-        MODULE PROCEDURE pmc_childinit
-    END INTERFACE pmc_childinit
-
-    INTERFACE pmc_c_clear_next_array_list
-        MODULE PROCEDURE pmc_c_clear_next_array_list
-    END INTERFACE pmc_c_clear_next_array_list
-
-    INTERFACE pmc_c_getbuffer
-        MODULE PROCEDURE pmc_c_getbuffer
-    END INTERFACE pmc_c_getbuffer
-
-    INTERFACE pmc_c_getnextarray
-        MODULE PROCEDURE pmc_c_getnextarray
-    END INTERFACE pmc_c_getnextarray
-
-    INTERFACE pmc_c_get_2d_index_list
-        MODULE PROCEDURE pmc_c_get_2d_index_list
-    END INTERFACE pmc_c_get_2d_index_list
-
-    INTERFACE pmc_c_putbuffer
-        MODULE PROCEDURE pmc_c_putbuffer
-    END INTERFACE pmc_c_putbuffer
-
-    INTERFACE pmc_c_setind_and_allocmem
-        MODULE PROCEDURE pmc_c_setind_and_allocmem
-    END INTERFACE pmc_c_setind_and_allocmem
-
-    INTERFACE pmc_c_set_dataarray
-        MODULE PROCEDURE pmc_c_set_dataarray_2d
-        MODULE PROCEDURE pmc_c_set_dataarray_3d
-        MODULE PROCEDURE pmc_c_set_dataarray_ip2d
-    END INTERFACE pmc_c_set_dataarray
-
-    INTERFACE pmc_set_dataarray_name
-        MODULE PROCEDURE pmc_set_dataarray_name
-        MODULE PROCEDURE pmc_set_dataarray_name_lastentry
-    END INTERFACE pmc_set_dataarray_name
-
-
-    PUBLIC pmc_childinit,                                                                          &
-           pmc_c_clear_next_array_list,                                                            &
-           pmc_c_getbuffer,                                                                        &
-           pmc_c_getnextarray,                                                                     &
-           pmc_c_putbuffer,                                                                        &
-           pmc_c_setind_and_allocmem,                                                              &
-           pmc_c_set_dataarray,                                                                    &
-           pmc_set_dataarray_name,                                                                 &
-           pmc_c_get_2d_index_list
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_childinit
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i      !<
-    INTEGER(iwp) ::  istat  !<
-
-!
-!-- Get / define the MPI environment.
-    me%model_comm = m_model_comm
-    me%inter_comm = m_to_parent_comm
-
-    CALL MPI_COMM_RANK( me%model_comm, me%model_rank, istat )
-    CALL MPI_COMM_SIZE( me%model_comm, me%model_npes, istat )
-    CALL MPI_COMM_REMOTE_SIZE( me%inter_comm, me%inter_npes, istat )
-!
-!-- Intra-communicator is used for MPI_GET.
-    CALL MPI_INTERCOMM_MERGE( me%inter_comm, .TRUE., me%intra_comm, istat )
-    CALL MPI_COMM_RANK( me%intra_comm, me%intra_rank, istat )
-
-    ALLOCATE( me%pes(me%inter_npes) )
-!
-!-- Allocate an array of type arraydef for all parent processes to store information of then
-!-- transfer array.
-    DO  i = 1, me%inter_npes
-       ALLOCATE( me%pes(i)%array_list(pmc_max_array) )
-    ENDDO
-
- END SUBROUTINE pmc_childinit
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_set_dataarray_name( parentarraydesc, parentarrayname, childarraydesc,              &
-                                    childarrayname, istat )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  childarraydesc   !<
-    CHARACTER(LEN=*), INTENT(IN) ::  childarrayname   !<
-    CHARACTER(LEN=*), INTENT(IN) ::  parentarraydesc  !<
-    CHARACTER(LEN=*), INTENT(IN) ::  parentarrayname  !<
-
-    INTEGER(iwp), INTENT(OUT) ::  istat  !<
-!
-!-- Local variables
-    INTEGER(iwp) ::  mype  !<
-
-    TYPE(da_namedef) ::  myname  !<
-
-
-    istat = pmc_status_ok
-!
-!-- Check length of array names.
-    IF ( LEN( TRIM( parentarrayname) ) > da_namelen  .OR.                                          &
-         LEN( TRIM( childarrayname ) ) > da_namelen )  THEN
-       istat = pmc_da_name_err
-    ENDIF
-
-    IF ( m_model_rank == 0 )  THEN
-       myindex = myindex + 1
-       myname%couple_index = myindex
-       myname%parentdesc   = TRIM( parentarraydesc )
-       myname%nameonparent = TRIM( parentarrayname )
-       myname%childdesc    = TRIM( childarraydesc )
-       myname%nameonchild  = TRIM( childarrayname )
-    ENDIF
-
-!
-!-- Broadcast to all child processes.
-!-- The complete description of a transfer array is broadcasted.
-    CALL pmc_bcast( myname%couple_index, 0, comm=m_model_comm )
-    CALL pmc_bcast( myname%parentdesc,   0, comm=m_model_comm )
-    CALL pmc_bcast( myname%nameonparent, 0, comm=m_model_comm )
-    CALL pmc_bcast( myname%childdesc,    0, comm=m_model_comm )
-    CALL pmc_bcast( myname%nameonchild,  0, comm=m_model_comm )
-
-!
-!-- Broadcast to all parent processes.
-!-- The complete description of an transfer array names is broadcasted also to all parent processes.
-!-- Only the root PE of the broadcasts to parent is using intra communicator.
-    IF ( m_model_rank == 0 )  THEN
-        mype = MPI_ROOT
-    ELSE
-        mype = MPI_PROC_NULL
-    ENDIF
-
-    CALL pmc_bcast( myname%couple_index, mype, comm=m_to_parent_comm )
-    CALL pmc_bcast( myname%parentdesc,   mype, comm=m_to_parent_comm )
-    CALL pmc_bcast( myname%nameonparent, mype, comm=m_to_parent_comm )
-    CALL pmc_bcast( myname%childdesc,    mype, comm=m_to_parent_comm )
-    CALL pmc_bcast( myname%nameonchild,  mype, comm=m_to_parent_comm )
-
-    CALL pmc_g_setname( me, myname%couple_index, myname%nameonchild )
-
- END SUBROUTINE pmc_set_dataarray_name
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_set_dataarray_name_lastentry( lastentry )
-
-    IMPLICIT NONE
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  lastentry  !<
-!
-!-- Local variables
-    INTEGER ::  idum  !<
-    INTEGER ::  mype  !<
-
-    TYPE(dA_namedef) ::  myname  !<
-
-    myname%couple_index = -1
-
-    IF ( m_model_rank == 0 )  THEN
-       mype = MPI_ROOT
-    ELSE
-       mype = MPI_PROC_NULL
-    ENDIF
-
-    CALL pmc_bcast( myname%couple_index, mype, comm=m_to_parent_comm )
-
-!
-!-- Next statement is just to avoid compiler warnings about unused variables
-    IF ( PRESENT( lastentry ) )  idum = 1
-
- END SUBROUTINE pmc_set_dataarray_name_lastentry
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_c_get_2d_index_list
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  dummy               !<
-    INTEGER(iwp) ::  i, ierr, i2, j, nr  !<
-    INTEGER(iwp) ::  indwin              !< MPI window object
-    INTEGER(iwp) ::  indwin2             !< MPI window object
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  disp      !< Displacement unit (Integer = 4, floating poit = 8
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize   !< Size of MPI window 2 (in bytes)
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  win_size  !< Size of MPI window 1 (in bytes)
-
-    INTEGER, DIMENSION(me%inter_npes*2) ::  nrele  !< Number of Elements of a horizontal slice
-
-    INTEGER, DIMENSION(:), POINTER ::  myind  !<
-
-    TYPE(pedef), POINTER ::  ape  !> Pointer to pedef structure
-
-
-    win_size = STORAGE_SIZE( dummy ) / 8
-    CALL MPI_WIN_CREATE( dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm, indwin, ierr )
-!
-!-- Close window on child side and open on parent side
-    CALL MPI_WIN_FENCE( 0, indwin, ierr )
-!
-!-- Between the two MPI_WIN_FENCE calls, the parent can fill the RMA window.
-!-- Close window on parent side and open on child side.
-
-    CALL MPI_WIN_FENCE( 0, indwin, ierr )
-
-    DO  i = 1, me%inter_npes
-       disp = me%model_rank * 2
-       CALL MPI_GET( nrele((i-1)*2+1), 2, MPI_INTEGER, i-1, disp, 2, MPI_INTEGER, indwin, ierr )
-    ENDDO
-!
-!-- MPI_GET is non-blocking -> data in nrele is not available until MPI_FENCE is called.
-    CALL MPI_WIN_FENCE( 0, indwin, ierr )
-!
-!-- Allocate memory for index array
-    winsize = 0
-    DO  i = 1, me%inter_npes
-       ape => me%pes(i)
-       i2 = ( i-1 ) * 2 + 1
-       nr = nrele(i2+1)
-       IF ( nr > 0 )  THEN
-          ALLOCATE( ape%locind(nr) )
-       ELSE
-          NULLIFY( ape%locind )
-       ENDIF
-       winsize = MAX( INT( nr, MPI_ADDRESS_KIND ), winsize )
-    ENDDO
-
-    ALLOCATE( myind(2*winsize) )
-    winsize = 1
-!
-!-- Local buffer used in MPI_GET can but must not be inside the MPI Window.
-!-- Here, we use a dummy for the MPI window because the parent processes do not access the RMA
-!-- window via MPI_GET or MPI_PUT.
-    CALL MPI_WIN_CREATE( dummy, winsize, iwp, MPI_INFO_NULL, me%intra_comm, indwin2, ierr )
-!
-!-- MPI_GET is non-blocking -> data in nrele is not available until MPI_FENCE is called.
-
-    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
-!
-!-- Between the two MPI_WIN_FENCE calls, the parent can fill the RMA window
-
-    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
-
-    DO  i = 1, me%inter_npes
-       ape => me%pes(i)
-       nr = nrele(i*2)
-       IF ( nr > 0 )  THEN
-          disp = nrele(2*(i-1)+1)
-          CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , i-1, 0, indwin2, ierr )
-          CALL MPI_GET( myind, 2*nr, MPI_INTEGER, i-1, disp, 2*nr, MPI_INTEGER, indwin2, ierr )
-          CALL MPI_WIN_UNLOCK( i-1, indwin2, ierr )
-          DO  j = 1, nr
-             ape%locind(j)%i = myind(2*j-1)
-             ape%locind(j)%j = myind(2*j)
-          ENDDO
-          ape%nrele = nr
-       ELSE
-          ape%nrele = -1
-       ENDIF
-    ENDDO
-!
-!-- Don't know why, but this barrier is necessary before we can free the windows.
-    CALL MPI_BARRIER( me%intra_comm, ierr )
-
-    CALL MPI_WIN_FREE( indWin,  ierr )
-    CALL MPI_WIN_FREE( indwin2, ierr )
-    DEALLOCATE( myind )
-
- END SUBROUTINE pmc_c_get_2d_index_list
-
-
-
- SUBROUTINE pmc_c_clear_next_array_list
-
-    IMPLICIT NONE
-
-    next_array_in_list = 0
-
- END SUBROUTINE pmc_c_clear_next_array_list
-
-
-
- LOGICAL FUNCTION pmc_c_getnextarray( myname )
-
-!
-!--  List handling is still required to get minimal interaction with pmc_interface.
-     CHARACTER(LEN=*), INTENT(OUT) ::  myname  !<
-!
-!-- Local variables
-    TYPE(pedef), POINTER    :: ape  !<
-    TYPE(arraydef), POINTER :: ar   !<
-
-
-    next_array_in_list = next_array_in_list + 1
-!
-!-- Array names are the same on all child PEs, so take first process to get the name.
-    ape => me%pes(1)
-!
-!-- Check if all arrays have been processed.
-    IF ( next_array_in_list > ape%nr_arrays )  THEN
-       pmc_c_getnextarray = .FALSE.
-       RETURN
-    ENDIF
-
-    ar => ape%array_list( next_array_in_list )
-
-    myname = ar%name
-!
-!-- Return TRUE if annother array.
-!-- If all array have been processed, the RETURN statement a couple of lines above is active.
-
-    pmc_c_getnextarray = .TRUE.
-
- END FUNCTION pmc_c_getnextarray
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_c_set_dataarray_2d( array )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !<
-    INTEGER(iwp) ::  nrdims  !<
-
-    INTEGER(iwp), DIMENSION(4) ::  dims  !<
-
-    REAL(wp), INTENT(IN) , DIMENSION(:,:), POINTER ::  array  !<
-
-    TYPE(C_PTR)             ::  array_adr  !<
-    TYPE(arraydef), POINTER ::  ar         !<
-    TYPE(pedef), POINTER    ::  ape        !<
-
-
-    dims    = 1
-    nrdims  = 2
-    dims(1) = SIZE( array, 1 )
-    dims(2) = SIZE( array, 2 )
-
-    array_adr = C_LOC( array )
-
-    DO  i = 1, me%inter_npes
-       ape => me%pes(i)
-       ar  => ape%array_list(next_array_in_list)
-       ar%nrdims = nrdims
-       ar%dimkey = nrdims
-       ar%a_dim  = dims
-       ar%data   = array_adr
-    ENDDO
-
- END SUBROUTINE pmc_c_set_dataarray_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_c_set_dataarray_ip2d( array )
-
-    IMPLICIT NONE
-
-    INTEGER(idp), INTENT(IN) , DIMENSION(:,:), POINTER ::  array  !<
-
-    INTEGER(iwp) ::  i       !<
-    INTEGER(iwp) ::  nrdims  !<
-
-    INTEGER(iwp), DIMENSION(4) ::  dims  !<
-
-    TYPE(C_PTR)             ::  array_adr  !<
-    TYPE(arraydef), POINTER ::  ar         !<
-    TYPE(pedef), POINTER    ::  ape        !<
-
-    dims    = 1
-    nrdims  = 2
-    dims(1) = SIZE( array, 1 )
-    dims(2) = SIZE( array, 2 )
-
-    array_adr = C_LOC( array )
-
-    DO  i = 1, me%inter_npes
-       ape => me%pes(i)
-       ar  => ape%array_list(next_array_in_list)
-       ar%nrdims = nrdims
-       ar%dimkey = 22
-       ar%a_dim  = dims
-       ar%data   = array_adr
-    ENDDO
-
- END SUBROUTINE pmc_c_set_dataarray_ip2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_c_set_dataarray_3d (array)
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !<
-    INTEGER(iwp) ::  nrdims  !<
-
-    INTEGER(iwp), DIMENSION (4) ::  dims  !<
-
-    REAL(wp), INTENT(IN), DIMENSION(:,:,:), POINTER ::  array  !<
-
-    TYPE(C_PTR)             ::  array_adr  !<
-    TYPE(pedef), POINTER    ::  ape        !<
-    TYPE(arraydef), POINTER ::  ar         !<
-
-
-    dims    = 1
-    nrdims  = 3
-    dims(1) = SIZE( array, 1 )
-    dims(2) = SIZE( array, 2 )
-    dims(3) = SIZE( array, 3 )
-
-    array_adr = C_LOC( array )
-
-    DO  i = 1, me%inter_npes
-       ape => me%pes(i)
-       ar  => ape%array_list(next_array_in_list)
-       ar%nrdims = nrdims
-       ar%dimkey = nrdims
-       ar%a_dim  = dims
-       ar%data   = array_adr
-    ENDDO
-
- END SUBROUTINE pmc_c_set_dataarray_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_c_setind_and_allocmem
-
-    IMPLICIT NONE
-
-!
-!-- Naming convention for appendices:  _pc  -> parent to child transfer
-!--                                    _cp  -> child to parent transfer
-!--                                    recv -> parent to child transfer
-!--                                    send -> child to parent transfer
-
-    INTEGER(iwp), PARAMETER ::  noindex = -1  !<
-
-    INTEGER(iwp) ::  arlen        !<
-    INTEGER(iwp) ::  i            !<
-    INTEGER(iwp) ::  ierr         !<
-    INTEGER(iwp) ::  istat        !<
-    INTEGER(iwp) ::  j            !<
-    INTEGER(iwp) ::  lo_nr_arrays !<
-    INTEGER(iwp) ::  myindex      !<
-    INTEGER(iwp) ::  rcount       !<
-    INTEGER(iwp) ::  tag          !<
-    INTEGER(iwp) ::  total_npes   !<
-
-    INTEGER(idp)                   ::  bufsize  !< size of MPI data window
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  myindex_s  !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  myindex_r  !<
-
-    REAL(wp), DIMENSION(:), POINTER, SAVE ::  base_array_cp  !< base array
-    REAL(wp), DIMENSION(:), POINTER, SAVE ::  base_array_pc  !< base array
-
-    TYPE(pedef), POINTER    ::  ape       !<
-    TYPE(arraydef), POINTER ::  ar        !<
-
-    Type(C_PTR)             ::  base_ptr  !<
-
-
-    CALL MPI_COMM_SIZE (me%intra_comm, total_npes, ierr)
-
-    lo_nr_arrays = me%pes(1)%nr_arrays
-
-    ALLOCATE( myindex_s(lo_nr_arrays,0:total_npes-1) )
-    ALLOCATE( myindex_r(lo_nr_arrays,0:total_npes-1) )
-
-    myindex_s = 0
-
-!
-!-- Receive indices from child.
-    CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER, myindex_r, lo_nr_arrays, MPI_INTEGER, &
-                       me%intra_comm, ierr )
-
-    myindex = 0
-    bufsize = 8
-!
-!-- Parent to child direction.
-!-- First stride: compute size and set index.
-    DO  i = 1, me%inter_npes
-       ape => me%pes(i)
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-          ar%recvindex = myindex_r(j,i-1)
-!
-!--       Determine max, because child buffer is allocated only once.
-!--       All 2D and 3d arrays use the same buffer.
-
-          IF ( ar%nrdims == 3 )  THEN
-             bufsize = MAX( bufsize, INT( ar%a_dim(1)*ar%a_dim(2)*ar%a_dim(3), MPI_ADDRESS_KIND ) )
-          ELSE
-             bufsize = MAX( bufsize, INT( ar%a_dim(1)*ar%a_dim(2), MPI_ADDRESS_KIND ) )
-          ENDIF
-       ENDDO
-    ENDDO
-
-!
-!-- Create RMA (one sided communication) data buffer.
-!-- The buffer for MPI_GET can be PE local, i.e. it can but must not be part of the MPI RMA window.
-    CALL pmc_alloc_mem( base_array_pc, bufsize, base_ptr )
-    me%totalbuffersize = bufsize*wp  ! Total buffer size in byte
-!
-!-- Second stride: set buffer pointer.
-    DO  i = 1, me%inter_npes
-       ape => me%pes(i)
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-          ar%recvbuf = base_ptr
-       ENDDO
-    ENDDO
-!
-!-- Child to parent direction.
-    myindex = 1
-    rcount  = 0
-    bufsize = 8
-
-    myindex_s = 0
-    myindex_r = 0
-
-    DO  i = 1, me%inter_npes
-       ape => me%pes(i)
-       tag = 300
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-          IF ( ar%nrdims == 2 )  THEN
-             arlen = ape%nrele
-          ELSEIF( ar%nrdims == 3 )  THEN
-             arlen = ape%nrele*ar%a_dim(1)
-          ENDIF
-
-          IF ( ape%nrele > 0 )  THEN
-             ar%sendindex = myindex
-          ELSE
-             ar%sendindex = noindex
-          ENDIF
-
-          myindex_s(j,i-1) = ar%sendindex
-
-          IF ( ape%nrele > 0 )  THEN
-             ar%sendsize = arlen
-             myindex     = myindex + arlen
-             bufsize     = bufsize + arlen
-          ENDIF
-
-       ENDDO
-
-    ENDDO
-!
-!-- Send indices to parent.
-
-    CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER, myindex_r, lo_nr_arrays, MPI_INTEGER, &
-                       me%intra_comm, ierr)
-
-    DEALLOCATE( myindex_s )
-    DEALLOCATE( myindex_r )
-
-!
-!-- Create RMA (one sided communication) window for data buffer child to parent transfer.
-!-- The buffer of MPI_GET (counter part of transfer) can be PE-local, i.e. it can but must not be
-!-- part of the MPI RMA window. Only one RMA window is required to prepare the data:
-!--        for parent -> child transfer on the parent side
-!-- and
-!--        for child -> parent transfer on the child side
-    CALL pmc_alloc_mem( base_array_cp, bufsize )
-    me%totalbuffersize = bufsize * wp  ! Total buffer size in byte
-
-    winSize = me%totalbuffersize
-
-    CALL MPI_WIN_CREATE( base_array_cp, winsize, wp, MPI_INFO_NULL, me%intra_comm,                 &
-                         me%win_parent_child, ierr )
-    CALL MPI_WIN_FENCE( 0, me%win_parent_child, ierr )
-    CALL MPI_BARRIER( me%intra_comm, ierr )
-!
-!-- Second stride: set buffer pointer.
-    DO  i = 1, me%inter_npes
-       ape => me%pes(i)
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-          IF ( ape%nrele > 0 )  THEN
-             ar%sendbuf = C_LOC( base_array_cp(ar%sendindex) )
-!
-!--          TODO: If this is an error to be really expected, replace the following message by a
-!--                meaningful standard PALM message using the message-routine.
-             IF ( ar%sendindex+ar%sendsize > bufsize )  THEN
-                WRITE( 0,'(a,i4,4i7,1x,a)') 'Child buffer too small ', i, ar%sendindex,            &
-                       ar%sendsize, ar%sendindex+ar%sendsize, bufsize, TRIM( ar%name )
-                CALL MPI_ABORT( MPI_COMM_WORLD, istat, ierr )
-             ENDIF
-          ENDIF
-       ENDDO
-    ENDDO
-
- END SUBROUTINE pmc_c_setind_and_allocmem
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_c_getbuffer( waittime, particle_transfer )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ierr     !<
-    INTEGER(iwp) ::  ij       !<
-    INTEGER(iwp) ::  ip       !<
-    INTEGER(iwp) ::  j        !<
-    INTEGER(iwp) ::  myindex  !<
-    INTEGER(iwp) ::  nr       !< number of elements to get from parent
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp  !<
-    INTEGER,DIMENSION(1)           ::  buf_shape    !<
-
-    INTEGER(idp), POINTER, DIMENSION(:)   ::  ibuf      !<
-    INTEGER(idp), POINTER, DIMENSION(:,:) ::  idata_2d  !<
-
-    LOGICAL ::  lo_ptrans  !<
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  particle_transfer  !<
-
-    REAL(wp)                            ::  t1  !<
-    REAL(wp)                            ::  t2  !<
-
-    REAL(wp), POINTER, DIMENSION(:)     ::  buf      !<
-    REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d  !<
-    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
-
-    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
-
-    TYPE(pedef), POINTER    ::  ape  !<
-    TYPE(arraydef), POINTER ::  ar   !<
-
-
-
-!
-!-- Synchronization of the model is done in pmci_synchronize. Therefore the RMA window can be filled
-!-- without sychronization at this point and a barrier is not necessary.
-
-!-- In case waittime is present, the following barrier is necessary to insure the same number of
-!-- barrier calls on parent and child. This means, that here on child side two barriers are called
-!-- successively. The parent is filling its buffer between the two barrier calls.
-
-!-- Please note that waittime has to be set in pmc_s_fillbuffer AND pmc_c_getbuffer.
-    IF ( PRESENT( waittime ) )  THEN
-       t1 = pmc_time()
-       CALL MPI_BARRIER( me%intra_comm, ierr )
-       t2 = pmc_time()
-       waittime = t2 - t1
-    ENDIF
-
-    lo_ptrans = .FALSE.
-    IF ( PRESENT( particle_transfer) )  lo_ptrans = particle_transfer
-
-!
-!-- Wait for buffer to be filled.
-!
-!-- The parent side (in pmc_s_fillbuffer) is filling the buffer in the MPI RMA window. When the
-!-- filling is complet, a MPI_BARRIER is called. The child is not allowd to access the parent-buffer
-!-- before it is completely filled. Therefore the following barrier is required.
-
-    CALL MPI_BARRIER( me%intra_comm, ierr )
-
-    DO  ip = 1, me%inter_npes
-       ape => me%pes(ip)
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-
-          IF ( ar%dimkey == 2  .AND.  .NOT.  lo_ptrans)  THEN
-             nr = ape%nrele
-          ELSEIF ( ar%dimkey == 3  .AND.  .NOT.  lo_ptrans)  THEN
-             nr = ape%nrele * ar%a_dim(1)
-          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
-             nr = ape%nrele
-          ELSE
-             CYCLE   ! Particle arrays are not transferd here
-          ENDIF
-          buf_shape(1) = nr
-          IF ( lo_ptrans )  THEN
-             CALL C_F_POINTER( ar%recvbuf, ibuf, buf_shape )
-          ELSE
-             CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
-          ENDIF
-!
-!--       MPI passive target RMA
-!--       One data array is fetchted from MPI RMA window on parent
-
-          IF ( nr > 0 )  THEN
-             target_disp = ar%recvindex - 1
-             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip-1, 0, me%win_parent_child, ierr )
-             IF ( lo_ptrans )  THEN
-                CALL MPI_GET( ibuf, nr*8, MPI_BYTE, ip-1, target_disp, nr*8, MPI_BYTE, &  !There is no MPI_INTEGER8 datatype
-                              me%win_parent_child, ierr )
-             ELSE
-                CALL MPI_GET( buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL,                  &
-                              me%win_parent_child, ierr )
-             ENDIF
-             CALL MPI_WIN_UNLOCK( ip-1, me%win_parent_child, ierr )
-          ENDIF
-          myindex = 1
-          IF ( ar%dimkey == 2  .AND.  .NOT.  lo_ptrans)  THEN
-
-             CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
-             DO  ij = 1, ape%nrele
-                data_2d(ape%locind(ij)%j,ape%locind(ij)%i) = buf(myindex)
-                myindex = myindex + 1
-             ENDDO
-
-          ELSEIF ( ar%dimkey == 3  .AND.  .NOT.  lo_ptrans)  THEN
-
-             CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3) )
-             DO  ij = 1, ape%nrele
-                data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i) = buf(myindex:myindex+ar%a_dim(1)-1)
-                myindex = myindex+ar%a_dim(1)
-             ENDDO
-
-          ELSEIF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
-             CALL C_F_POINTER( ar%data, idata_2d, ar%a_dim(1:2) )
-
-             DO  ij = 1, ape%nrele
-                idata_2d(ape%locind(ij)%j,ape%locind(ij)%i) = ibuf(myindex)
-                myindex = myindex + 1
-             ENDDO
-
-          ENDIF
-       ENDDO
-    ENDDO
-
- END SUBROUTINE pmc_c_getbuffer
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_c_putbuffer( waittime , particle_transfer )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ierr     !<
-    INTEGER(iwp) ::  ij       !<
-    INTEGER(iwp) ::  ip       !<
-    INTEGER(iwp) ::  j        !<
-    INTEGER(iwp) ::  myindex  !<
-
-    INTEGER(iwp), DIMENSION(1) ::  buf_shape  !<
-
-    INTEGER(idp), POINTER, DIMENSION(:)   ::  ibuf      !<
-    INTEGER(idp), POINTER, DIMENSION(:,:) ::  idata_2d  !<
-
-    LOGICAL, INTENT(IN), OPTIONAL   ::  particle_transfer  !<
-
-    LOGICAL ::  lo_ptrans  !<
-
-    REAL(wp) ::  t1  !<
-    REAL(wp) ::  t2  !<
-
-    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
-
-    REAL(wp), POINTER, DIMENSION(:)     ::  buf      !<
-    REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d  !<
-    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
-
-    TYPE(pedef), POINTER    ::  ape  !<
-    TYPE(arraydef), POINTER ::  ar   !<
-
-!
-!-- Wait for empty buffer.
-!-- Switch RMA epoche.
-
-    t1 = pmc_time()
-    CALL MPI_BARRIER( me%intra_comm, ierr )
-    t2 = pmc_time()
-    IF ( PRESENT( waittime ) )  waittime = t2 - t1
-
-    lo_ptrans = .FALSE.
-    IF ( PRESENT( particle_transfer) )  lo_ptrans = particle_transfer
-
-    DO  ip = 1, me%inter_npes
-       ape => me%pes(ip)
-       DO  j = 1, ape%nr_arrays
-          ar => aPE%array_list(j)
-          myindex = 1
-
-          IF ( ar%dimkey == 2  .AND.  .NOT.  lo_ptrans )  THEN
-
-             buf_shape(1) = ape%nrele
-             CALL C_F_POINTER( ar%sendbuf, buf,     buf_shape     )
-             CALL C_F_POINTER( ar%data,    data_2d, ar%a_dim(1:2) )
-             DO  ij = 1, ape%nrele
-                buf(myindex) = data_2d(ape%locind(ij)%j,ape%locind(ij)%i)
-                myindex = myindex + 1
-             ENDDO
-
-          ELSEIF ( ar%dimkey == 3  .AND.  .NOT.  lo_ptrans )  THEN
-
-             buf_shape(1) = ape%nrele*ar%a_dim(1)
-             CALL C_F_POINTER( ar%sendbuf, buf,     buf_shape     )
-             CALL C_F_POINTER( ar%data,    data_3d, ar%a_dim(1:3) )
-             DO  ij = 1, ape%nrele
-                buf(myindex:myindex+ar%a_dim(1)-1) = data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i)
-                myindex = myindex + ar%a_dim(1)
-             ENDDO
-
-          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
-
-             buf_shape(1) = ape%nrele
-             CALL C_F_POINTER( ar%sendbuf, ibuf,     buf_shape     )
-             CALL C_F_POINTER( ar%data,    idata_2d, ar%a_dim(1:2) )
-
-             DO  ij = 1, ape%nrele
-                ibuf(myindex) = idata_2d(ape%locind(ij)%j,ape%locind(ij)%i)
-                myindex = myindex + 1
-             ENDDO
-
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!-- Buffer is filled.
-!-- Switch RMA epoche.
-
-    CALL MPI_Barrier(me%intra_comm, ierr)
-
- END SUBROUTINE pmc_c_putbuffer
-
-#endif
- END MODULE pmc_child
Index: palm/trunk/SOURCE/pmc_general_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_general_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,207 +1,0 @@
-!> @file pmc_general_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Reformatted to follow PALM coding standard
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Interface pmc_sort removed. Subroutine description added.
-!
-! 4649 2020-08-25 12:11:17Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! Support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3945 2019-05-02 11:29:27Z raasch
-!
-! 2019-04-24 17:31:34Z suehring
-! Increase character length so that also chemistry variable names fully fit
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Determine number of coupled arrays dynamically.
-!
-! 1762 2016-02-25 12:31:13Z hellstea
-! Initial revision by K. Ketelsen
-!
-! Authors:
-! --------
-!> @author Klaus Ketelsen (no affiliation)
-!
-! Description:
-! ------------
-!> Structure definition and utilities of Palm Model Coupler
-!--------------------------------------------------------------------------------------------------!
- MODULE pmc_general
-
-#if defined( __parallel )
-    USE, INTRINSIC ::  ISO_C_BINDING
-
-    USE kinds
-
-    USE MPI
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  pmc_max_array  !< max # of arrays which can be coupled
-                                    !< - will be determined dynamically in pmc_interface
-
-    INTEGER(iwp), PARAMETER ::  da_desclen       =  8  !<
-    INTEGER(iwp), PARAMETER ::  da_namelen       = 16  !<
-    INTEGER(iwp), PARAMETER ::  pmc_da_name_err  = 10  !<
-    INTEGER(iwp), PARAMETER ::  pmc_max_models   = 64  !<
-    INTEGER(iwp), PARAMETER ::  pmc_status_ok    =  0  !<
-    INTEGER(iwp), PARAMETER ::  pmc_status_error = -1  !<
-
-    TYPE ::  xy_ind  !< pair of indices in horizontal plane
-       INTEGER(iwp) ::  i  !<
-       INTEGER(iwp) ::  j  !<
-    END TYPE
-
-    TYPE ::  arraydef
-       CHARACTER(LEN=da_namelen) ::  Name  !< name of array
-
-       INTEGER(iwp) ::  coupleindex  !<
-       INTEGER(iwp) ::  dimkey       !< key for NR dimensions and array type
-       INTEGER(iwp) ::  nrdims       !< number of dimensions
-       INTEGER(iwp) ::  RecvSize     !< size in receive buffer
-       INTEGER(iwp) ::  SendSize     !< size in send buffer
-       INTEGER(idp) ::  RecvIndex    !< index in receive buffer
-       INTEGER(idp) ::  SendIndex    !< index in send buffer
-
-       INTEGER(iwp), DIMENSION(4) ::  a_dim  !< size of dimensions
-
-       TYPE(C_PTR) ::  data     !< pointer of data in parent space
-       TYPE(C_PTR) ::  SendBuf  !< data pointer in send buffer
-       TYPE(C_PTR) ::  RecvBuf  !< data pointer in receive buffer
-
-       TYPE(arraydef), POINTER ::  next  !<
-
-       TYPE(C_PTR), DIMENSION(2) ::  po_data  !< base pointers, pmc_s_set_active_data_array
-                                              !< sets active pointer
-    END TYPE arraydef
-
-    TYPE ::  pedef
-       INTEGER(iwp) ::  nr_arrays = 0  !< number of arrays which will be transfered
-       INTEGER(iwp) ::  nrele          !< number of elements, same for all arrays
-
-       TYPE(arraydef), POINTER, DIMENSION(:) ::  array_list  !< list of data arrays to be transfered
-
-       TYPE(xy_ind), POINTER, DIMENSION(:) ::  locInd  !< xy index local array for remote PE
-    END TYPE pedef
-
-    TYPE ::  childdef
-       INTEGER(iwp) ::  inter_comm        !< inter communicator model and child
-       INTEGER(iwp) ::  inter_npes        !< number of PEs child model
-       INTEGER(iwp) ::  intra_comm        !< intra communicator model and child
-       INTEGER(iwp) ::  intra_rank        !< rank within intra_comm
-       INTEGER(iwp) ::  model_comm        !< communicator of this model
-       INTEGER(iwp) ::  model_npes        !< number of PEs this model
-       INTEGER(iwp) ::  model_rank        !< rank of this model
-       INTEGER(idp) ::  totalbuffersize   !<
-       INTEGER(iwp) ::  win_parent_child  !< MPI RMA for preparing data on parent AND child side
-
-       TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all child PEs
-    END TYPE childdef
-
-    TYPE ::  da_namedef  !< data array name definition
-       CHARACTER(LEN=da_desclen) ::  childdesc     !< child array description
-       CHARACTER(LEN=da_namelen) ::  nameonchild   !< name of array within child
-       CHARACTER(LEN=da_namelen) ::  nameonparent  !< name of array within parent
-       CHARACTER(LEN=da_desclen) ::  parentdesc    !< parent array description
-
-       INTEGER(iwp) ::  couple_index  !< unique number of array
-    END TYPE da_namedef
-
-    TYPE(arraydef), POINTER ::  next  !<
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public functions
-    PUBLIC pmc_g_setname
-
-!
-!-- Public variables, constants and types
-    PUBLIC arraydef,                                                                               &
-           childdef,                                                                               &
-           da_desclen,                                                                             &
-           da_namedef,                                                                             &
-           da_namelen,                                                                             &
-           next,                                                                                   &
-           pedef,                                                                                  &
-           pmc_da_name_err,                                                                        &
-           pmc_max_array,                                                                          &
-           pmc_max_models,                                                                         &
-           pmc_status_error,                                                                       &
-           pmc_status_ok,                                                                          &
-           xy_ind
-
-    INTERFACE pmc_g_setname
-       MODULE PROCEDURE pmc_g_setname
-    END INTERFACE pmc_g_setname
-
-
- CONTAINS
-
-
-!---------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Add array to list of arraydef structure. No the arra "name" is schedules for parent child transfer
-!---------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_g_setname( mychild, couple_index, aname )
-
-    CHARACTER(LEN=*), INTENT(IN) ::  aname  !<
-
-    INTEGER(iwp) ::  i  !<
-
-    INTEGER(iwp), INTENT(IN) ::  couple_index  !<
-
-    TYPE(childdef), INTENT(INOUT) ::  mychild  !<
-
-    TYPE(pedef), POINTER ::  ape  !<
-
-
-!
-!-- Assign array to next free index in array list.
-!-- Set name of array in arraydef structure
-    DO  i = 1, mychild%inter_npes
-       ape => mychild%pes(i)
-       ape%nr_arrays = ape%nr_arrays + 1
-       ape%array_list(ape%nr_arrays)%name        = aname
-       ape%array_list(ape%nr_arrays)%coupleindex = couple_index
-    ENDDO
-
- END SUBROUTINE pmc_g_setname
-#endif
-
-
- END MODULE pmc_general
Index: palm/trunk/SOURCE/pmc_handle_communicator_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_handle_communicator_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,555 +1,0 @@
-!> @file pmc_handle_communicator_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! User switch for particle coupling added
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Canopy-restricted anterpolation introduced. New namelist parameter anterpolation_starting_height 
-! introduced for controlling canopy-restricted anterpolation.
-!
-! 4650 2020-08-25 14:35:50Z raasch
-! bugfix for r4649
-!
-! 4649 2020-08-25 12:11:17Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! Support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3888 2019-04-12 09:18:10Z hellstea
-! Missing MPI_BCAST of anterpolation_buffer_width added.
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3819 2019-03-27 11:01:36Z hellstea
-! Adjustable anterpolation buffer introduced on all nest boundaries, it is controlled by the new
-! nesting_parameters parameter anterpolation_buffer_width.
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! nestpar renamed to nesting_parameters
-!
-! 1762 2016-02-25 12:31:13Z hellstea
-! Initial revision by K. Ketelsen
-!
-! Description:
-! ------------
-! Handle MPI communicator in PALM model coupler
-!--------------------------------------------------------------------------------------------------!
- MODULE PMC_handle_communicator
-#if defined( __parallel )
-    USE kinds
-
-    USE MPI
-
-    USE pmc_general,                                                                               &
-        ONLY: pmc_max_models,                                                                      &
-              pmc_status_error,                                                                    &
-              pmc_status_ok
-
-
-    USE control_parameters,                                                                        &
-        ONLY: message_string
-
-    IMPLICIT NONE
-
-!
-!-- ATTENTION: Do not change the order of variable declarations in the following TYPE definition,
-!-- because the order must follow the order in which the layout data is given in the NAMELIST file.
-    TYPE pmc_layout
-
-       CHARACTER(LEN=32) ::  name  !<
-
-       INTEGER ::  id            !<
-       INTEGER ::  parent_id     !<
-       INTEGER ::  npe_total     !<
-
-       REAL(wp) ::  lower_left_x  !<
-       REAL(wp) ::  lower_left_y  !<
-
-    END TYPE pmc_layout
-
-    PUBLIC  pmc_status_ok, pmc_status_error  !<
-
-    INTEGER, PARAMETER, PUBLIC ::  pmc_error_npes        = 1  !< illegal number of processes
-    INTEGER, PARAMETER, PUBLIC ::  pmc_namelist_error    = 2  !< error(s) in nesting_parameters namelist
-    INTEGER, PARAMETER, PUBLIC ::  pmc_no_namelist_found = 3  !< no couple layout namelist found
-
-    INTEGER ::  m_my_cpl_id   !< coupler id of this model
-    INTEGER ::  m_ncpl        !< number of couplers given in nesting_parameters namelist
-    INTEGER ::  m_parent_id   !< coupler id of parent of this model
-    INTEGER ::  m_world_comm  !< global nesting communicator
-
-    TYPE(pmc_layout), PUBLIC, DIMENSION(pmc_max_models) ::  m_couplers  !< information of all couplers
-
-    INTEGER, PUBLIC ::  m_model_comm          !< communicator of this model
-    INTEGER, PUBLIC ::  m_model_npes          !<
-    INTEGER, PUBLIC ::  m_model_rank          !<
-    INTEGER, PUBLIC ::  m_to_parent_comm      !< communicator to the parent
-    INTEGER, PUBLIC ::  m_world_rank          !<
-    INTEGER         ::  m_parent_remote_size  !< number of processes in the parent model
-    INTEGER         ::  m_world_npes          !<
-    INTEGER         ::  peer_comm             !< peer_communicator for inter communicators
-
-    INTEGER, DIMENSION(pmc_max_models), PUBLIC ::  m_to_child_comm   !< communicator to the child(ren)
-    INTEGER, DIMENSION(:), POINTER, PUBLIC ::  pmc_parent_for_child  !<
-
-
-    INTERFACE pmc_get_model_info
-       MODULE PROCEDURE pmc_get_model_info
-    END INTERFACE pmc_get_model_info
-
-    INTERFACE pmc_is_rootmodel
-       MODULE PROCEDURE pmc_is_rootmodel
-    END INTERFACE pmc_is_rootmodel
-
-    PUBLIC pmc_get_model_info, pmc_init_model, pmc_is_rootmodel   !<
-
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_init_model( comm, nesting_datatransfer_mode, nesting_mode,                         &
-                            anterpolation_buffer_width, anterpolation_starting_height,             &
-                            particle_coupling, pmc_status )
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string
-
-    USE pegrid,                                                                                    &
-        ONLY:  myid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode  !<
-    CHARACTER(LEN=8), INTENT(INOUT) ::  nesting_mode               !<
-
-    INTEGER, INTENT(INOUT) ::  anterpolation_buffer_width  !< Boundary buffer width for anterpolation
-    INTEGER, INTENT(INOUT) ::  comm                        !<
-    INTEGER, INTENT(INOUT) ::  pmc_status                  !<
-
-    REAL(wp), INTENT(INOUT) ::  anterpolation_starting_height  !< steering parameter for canopy restricted anterpolation 
-    LOGICAL, INTENT(INOUT)  ::  particle_coupling              !< switch for particle coupling (default .TRUE.)
-    
-    INTEGER ::  childcount     !<
-    INTEGER ::  i              !<
-    INTEGER ::  ierr           !<
-    INTEGER ::  istat          !<
-    INTEGER ::  m_my_cpl_rank  !<
-    INTEGER ::  tag            !<
-
-    INTEGER, DIMENSION(pmc_max_models)   ::  activeparent  !< I am active parent for this child ID
-    INTEGER, DIMENSION(pmc_max_models+1) ::  start_pe      !<
-
-    pmc_status   = pmc_status_ok
-    comm         = -1
-    m_world_comm = MPI_COMM_WORLD
-    m_my_cpl_id  = -1
-    childcount   =  0
-    activeparent = -1
-    start_pe(:)  =  0
-
-    CALL MPI_COMM_RANK( MPI_COMM_WORLD, m_world_rank, istat )
-    CALL MPI_COMM_SIZE( MPI_COMM_WORLD, m_world_npes, istat )
-!
-!-- Only process 0 of root model reads
-    IF ( m_world_rank == 0 )  THEN
-
-       CALL read_coupling_layout( nesting_datatransfer_mode, nesting_mode,                         &
-            anterpolation_buffer_width, anterpolation_starting_height, particle_coupling,          &
-            pmc_status )
-
-       IF ( pmc_status /= pmc_no_namelist_found  .AND.                                             &
-            pmc_status /= pmc_namelist_error )                                                     &
-       THEN
-!
-!--       Calculate start PE of every model
-          start_pe(1) = 0
-          DO  i = 2, m_ncpl+1
-             start_pe(i) = start_pe(i-1) + m_couplers(i-1)%npe_total
-          ENDDO
-
-!
-!--       The sum of numbers of processes requested by all the domains must be equal to the total
-!--       number of processes of the run
-          IF ( start_pe(m_ncpl+1) /= m_world_npes )  THEN
-             WRITE( message_string, '(2A,I6,2A,I6,A)' )                                            &
-                                                'nesting-setup requires different number of ',     &
-                                                'MPI procs (', start_pe(m_ncpl+1), ') than ',      &
-                                                'provided (', m_world_npes,')'
-             CALL message( 'pmc_init_model', 'PA0229', 3, 2, 0, 6, 0 )
-          ENDIF
-
-       ENDIF
-
-    ENDIF
-!
-!-- Broadcast the read status. This synchronises all other processes with process 0 of the root
-!-- model. Without synchronisation, they would not behave in the correct way (e.g. they would not
-!-- return in case of a missing NAMELIST).
-    CALL MPI_BCAST( pmc_status, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
-
-    IF ( pmc_status == pmc_no_namelist_found )  THEN
-!
-!--    Not a nested run; return the MPI_WORLD communicator
-       comm = MPI_COMM_WORLD
-       RETURN
-
-    ELSEIF ( pmc_status == pmc_namelist_error )  THEN
-!
-!--    Only the root model gives the error message. Others are aborted by the message-routine with
-!--    MPI_ABORT. Must be done this way since myid and comm2d have not yet been assigned at this
-!--    point.
-       IF ( m_world_rank == 0 )  THEN
-          message_string = 'errors in \$nesting_parameters'
-          CALL message( 'pmc_init_model', 'PA0223', 3, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDIF
-
-    CALL MPI_BCAST( m_ncpl,          1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
-    CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
-!
-!-- Broadcast coupling layout
-    DO  i = 1, m_ncpl
-       CALL MPI_BCAST( m_couplers(i)%name, LEN( m_couplers(i)%name ),                              &
-                       MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
-       CALL MPI_BCAST( m_couplers(i)%id,           1, MPI_INTEGER, 0,                              &
-                       MPI_COMM_WORLD, istat )
-       CALL MPI_BCAST( m_couplers(i)%Parent_id,    1, MPI_INTEGER, 0,                              &
-                       MPI_COMM_WORLD, istat )
-       CALL MPI_BCAST( m_couplers(i)%npe_total,    1, MPI_INTEGER, 0,                              &
-                       MPI_COMM_WORLD, istat )
-       CALL MPI_BCAST( m_couplers(i)%lower_left_x, 1, MPI_REAL,    0,                              &
-                       MPI_COMM_WORLD, istat )
-       CALL MPI_BCAST( m_couplers(i)%lower_left_y, 1, MPI_REAL,    0,                              &
-                       MPI_COMM_WORLD, istat )
-    ENDDO
-    CALL MPI_BCAST( nesting_mode, LEN( nesting_mode ), MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
-    CALL MPI_BCAST( nesting_datatransfer_mode, LEN(nesting_datatransfer_mode), MPI_CHARACTER, 0,   &
-                    MPI_COMM_WORLD, istat )
-    CALL MPI_BCAST( anterpolation_buffer_width, 1, MPI_INT, 0, MPI_COMM_WORLD, istat )
-    CALL MPI_BCAST( anterpolation_starting_height, 1, MPI_REAL, 0, MPI_COMM_WORLD, istat )
-    CALL MPI_BCAST( particle_coupling, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, istat )
-!
-!-- Assign global MPI processes to individual models by setting the couple id
-    DO  i = 1, m_ncpl
-       IF ( m_world_rank >= start_pe(i)  .AND.  m_world_rank < start_pe(i+1) )  THEN
-          m_my_cpl_id = i
-          EXIT
-       ENDIF
-    ENDDO
-    m_my_cpl_rank = m_world_rank - start_pe(i)
-!
-!-- MPI_COMM_WORLD is the communicator for ALL models (MPI-1 approach). The communictors for the
-!-- individual models as created by MPI_COMM_SPLIT. The color of the model is represented by the
-!-- coupler id
-    CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, m_my_cpl_id, m_my_cpl_rank, comm, istat )
-!
-!-- Get size and rank of the model running on this process
-    CALL  MPI_COMM_RANK( comm, m_model_rank, istat )
-    CALL  MPI_COMM_SIZE( comm, m_model_npes, istat )
-!
-!-- Broadcast (from process 0) the parent id and id of every model
-    DO  i = 1, m_ncpl
-       CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
-       CALL MPI_BCAST( m_couplers(i)%id,        1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
-    ENDDO
-!
-!-- Save the current model communicator for pmc internal use
-    m_model_comm = comm
-
-!
-!-- Create intercommunicator between the parent and children.
-!-- MPI_INTERCOMM_CREATE creates an intercommunicator between 2 groups of different colors. The
-!-- grouping was done above with MPI_COMM_SPLIT. A duplicate of MPI_COMM_WORLD is created and used
-!-- as peer communicator (peer_comm) for MPI_INTERCOMM_CREATE.
-    CALL MPI_COMM_DUP( MPI_COMM_WORLD, peer_comm, ierr )
-    DO  i = 2, m_ncpl
-       IF ( m_couplers(i)%parent_id == m_my_cpl_id )  THEN
-!
-!--       Identify all children models of the current model and create inter-communicators to
-!--       connect between the current model and its children models.
-          tag = 500 + i
-          CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, start_pe(i), tag, m_to_child_comm(i),     &
-                                     istat )
-          childcount = childcount + 1
-          activeparent(i) = 1
-       ELSEIF ( i == m_my_cpl_id)  THEN
-!
-!--       Create an inter-communicator to connect between the current model and its parent model.
-          tag = 500 + i
-          CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, start_pe(m_couplers(i)%parent_id), tag,   &
-                                     m_to_parent_comm, istat )
-       ENDIF
-    ENDDO
-!
-!-- If I am a parent, count the number of children I have. Although this loop is symmetric on all
-!-- processes, the "activeparent" flag is true (==1) on the respective individual process only.
-    ALLOCATE( pmc_parent_for_child(childcount+1) )
-
-    childcount = 0
-    DO  i = 2, m_ncpl
-       IF ( activeparent(i) == 1 )  THEN
-          childcount = childcount + 1
-          pmc_parent_for_child(childcount) = i
-       ENDIF
-    ENDDO
-!
-!-- Get the size of the parent model
-    IF ( m_my_cpl_id > 1 )  THEN
-       CALL MPI_COMM_REMOTE_SIZE( m_to_parent_comm, m_parent_remote_size, istat )
-    ELSE
-!
-!--    The root model does not have a parent
-       m_parent_remote_size = -1
-    ENDIF
-!
-!-- Set myid to non-zero value except for the root domain. This is a setting for the message routine
-!-- which is called at the end of pmci_init. That routine outputs messages for myid = 0, only.
-!-- However, myid has not been assigened so far, so that all processes of the root model would
-!-- output a message. To avoid this, set myid to some other value except for process 0 of the root
-!-- domain.
-    IF ( m_world_rank /= 0 )  myid = 1
-
- END SUBROUTINE PMC_init_model
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_get_model_info( comm_world_nesting, cpl_id, cpl_name, cpl_parent_id, lower_left_x, &
-                                lower_left_y, ncpl, npe_total, request_for_cpl_id )
-!
-!-- Provide module private variables of the pmc for PALM
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(OUT), OPTIONAL ::  cpl_name   !<
-
-    INTEGER, INTENT(IN), OPTIONAL ::  request_for_cpl_id   !<
-
-    INTEGER, INTENT(OUT), OPTIONAL ::  comm_world_nesting  !<
-    INTEGER, INTENT(OUT), OPTIONAL ::  cpl_id              !<
-    INTEGER, INTENT(OUT), OPTIONAL ::  cpl_parent_id       !<
-    INTEGER, INTENT(OUT), OPTIONAL ::  ncpl                !<
-    INTEGER, INTENT(OUT), OPTIONAL ::  npe_total           !<
-
-    INTEGER ::  requested_cpl_id                           !<
-
-    REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_x       !<
-    REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_y       !<
-
-!
-!-- Set the requested coupler id
-    IF ( PRESENT( request_for_cpl_id ) )  THEN
-       requested_cpl_id = request_for_cpl_id
-!
-!--    Check for allowed range of values
-       IF ( requested_cpl_id < 1  .OR.  requested_cpl_id > m_ncpl )  RETURN
-    ELSE
-       requested_cpl_id = m_my_cpl_id
-    ENDIF
-!
-!-- Return the requested information
-    IF ( PRESENT( comm_world_nesting )  )  THEN
-       comm_world_nesting = m_world_comm
-    ENDIF
-    IF ( PRESENT( cpl_id )        )  THEN
-       cpl_id = requested_cpl_id
-    ENDIF
-    IF ( PRESENT( cpl_parent_id ) )  THEN
-       cpl_parent_id = m_couplers(requested_cpl_id)%parent_id
-    ENDIF
-    IF ( PRESENT( cpl_name )      )  THEN
-       cpl_name = m_couplers(requested_cpl_id)%name
-    ENDIF
-    IF ( PRESENT( ncpl )          )  THEN
-       ncpl = m_ncpl
-    ENDIF
-    IF ( PRESENT( npe_total )     )  THEN
-       npe_total = m_couplers(requested_cpl_id)%npe_total
-    ENDIF
-    IF ( PRESENT( lower_left_x )  )  THEN
-       lower_left_x = m_couplers(requested_cpl_id)%lower_left_x
-    ENDIF
-    IF ( PRESENT( lower_left_y )  )  THEN
-       lower_left_y = m_couplers(requested_cpl_id)%lower_left_y
-    ENDIF
-
- END SUBROUTINE pmc_get_model_info
-
-
-
- LOGICAL function pmc_is_rootmodel( )
-
-    IMPLICIT NONE
-
-    pmc_is_rootmodel = ( m_my_cpl_id == 1 )
-
- END FUNCTION pmc_is_rootmodel
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode,                         &
-                                  anterpolation_buffer_width, anterpolation_starting_height,       &
-                                  particle_coupling, pmc_status )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode  !<
-    CHARACTER(LEN=8), INTENT(INOUT) ::  nesting_mode               !<
-
-    INTEGER, INTENT(INOUT)      ::  anterpolation_buffer_width  !< Boundary buffer width for anterpolation
-    INTEGER(iwp), INTENT(INOUT) ::  pmc_status                  !<
-
-    REAL(wp), INTENT(INOUT) ::  anterpolation_starting_height   !< steering parameter for canopy restricted anterpolation
-    LOGICAL, INTENT(INOUT)  ::  particle_coupling               !< switch for particle coupling (default .TRUE.)
-
-    INTEGER(iwp) ::  bad_llcorner  !<
-    INTEGER(iwp) ::  i             !<
-    INTEGER(iwp) ::  io_status     !<
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    TYPE(pmc_layout), DIMENSION(pmc_max_models) ::  domain_layouts  !<
-
-    NAMELIST /nesting_parameters/  anterpolation_buffer_width,                                     &
-                                   anterpolation_starting_height,                                  &
-                                   domain_layouts,                                                 &
-                                   nesting_datatransfer_mode,                                      &
-                                   nesting_mode,                                                   &
-                                   switch_off_module,                                              &
-                                   particle_coupling
-
-
-!
-!-- Initialize some coupling variables
-    domain_layouts(1:pmc_max_models)%id = -1
-    m_ncpl =   0
-
-    pmc_status = pmc_no_namelist_found
-!
-!-- Open the NAMELIST-file and read the nesting layout
-    CALL check_open( 11 )
-    READ ( 11, nesting_parameters, IOSTAT = io_status )
-!
-!-- Set filepointer to the beginning of the file. Otherwise process 0 will later be unable to read
-!-- the inipar-NAMELIST
-    REWIND ( 11 )
-
-    IF ( io_status == 0 )  THEN
-!
-!--    nesting_parameters namelist was found and read correctly. Enable the nesting by setting
-!--    the palm model coupler status respectively.
-       IF ( .NOT. switch_off_module )  THEN
-          pmc_status = pmc_status_ok
-       ELSE
-          RETURN
-       ENDIF
-    ELSEIF ( io_status < 0 )  THEN
-!
-!--    No nesting_parameters-NAMELIST found
-       RETURN
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    Errors in reading nesting_parameters-NAMELIST
-       pmc_status = pmc_namelist_error
-       RETURN
-    ENDIF
-
-!
-!-- Output location message
-    CALL location_message( 'initialize communicators for nesting', 'start' )
-!
-!-- Assign the layout to the corresponding internally used variable m_couplers
-    m_couplers = domain_layouts
-!
-!-- Get the number of nested models given in the nesting_parameters-NAMELIST
-    DO  i = 1, pmc_max_models
-!
-!--    When id=-1 is found for the first time, the list of domains is finished
-       IF ( m_couplers(i)%id == -1  .OR.  i == pmc_max_models )  THEN
-          IF ( m_couplers(i)%id == -1 )  THEN
-             m_ncpl = i - 1
-             EXIT
-          ELSE
-             m_ncpl = pmc_max_models
-          ENDIF
-       ENDIF
-    ENDDO
-!
-!-- Make sure that all domains have equal lower left corner in case of vertical nesting
-    IF ( nesting_mode == 'vertical' )  THEN
-       bad_llcorner = 0
-       DO  i = 1, m_ncpl
-          IF ( domain_layouts(i)%lower_left_x /= 0.0_wp .OR.                                       &
-               domain_layouts(i)%lower_left_y /= 0.0_wp )  THEN
-             bad_llcorner = bad_llcorner + 1
-             domain_layouts(i)%lower_left_x = 0.0_wp
-             domain_layouts(i)%lower_left_y = 0.0_wp
-          ENDIF
-       ENDDO
-       IF ( bad_llcorner /= 0)  THEN
-          WRITE( message_string, *)  'at least one dimension of lower ',                           &
-                                     'left corner of one domain is not 0. ',                       &
-                                     'All lower left corners were set to (0, 0)'
-          CALL message( 'read_coupling_layout', 'PA0427', 0, 0, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    CALL location_message( 'initialize communicators for nesting', 'finished' )
-
- END SUBROUTINE read_coupling_layout
-
-#endif
- END MODULE pmc_handle_communicator
Index: palm/trunk/SOURCE/pmc_interface_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_interface_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,5606 +1,0 @@
-!> @file pmc_interface_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! User switch for particle coupling added. Some code reformatting according to follow PALM coding standard.
-! Some missing doxygen comments added.
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Bugfix in setting up the nesting configuration for chemical and aerosol species in case of more
-! than one child domain
-!
-! 4775 2020-11-06 12:18:28Z raasch
-! Further bugfix for r4774
-!
-! 4774 2020-11-06 07:50:30Z hellstea
-! Temporary bugfix for r4771: default for anterpolation_starting_height changed.
-!
-! 4773 2020-11-04 16:30:24Z hellstea
-! Canopy-restricted anterpolation introduced. New namelist parameter anterpolation_starting_height
-! introduced for controlling canopy-restricted anterpolation.
-!
-! 4745 2020-10-15 16:37:13Z suehring
-! Adjustement of face-area calculation to 3D-topographies
-!
-! 4734 2020-10-09 13:21:06Z suehring
-! Bugfix for RANS-RANS nesting and minor revision in the TKE treatment (only logical control)
-!
-! 4665 2020-09-03 14:04:24Z hellstea
-! Interpolation and anterpolation subroutines renamed and all missing subroutine description
-! comments added. 
-!
-! 4649 2020-08-25 12:11:17Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4508 2020-04-24 13:32:20Z raasch
-! Salsa variable name changed
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! Bugfix: cpp-directives and variable declarations for serial mode added
-!
-! 4413 2020-02-19 15:52:19Z hellstea
-! All the USE-statements within subroutines moved up to the module declaration section.
-!
-! 4385 2020-01-27 08:37:37Z hellstea
-! Error messages PA0425 and PA0426 made more specific
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4273 2019-10-24 13:40:54Z monakurppa
-! Add a logical switch nesting_chem and rename nest_salsa to nesting_salsa
-!
-! 4260 2019-10-09 14:04:03Z hellstea
-! Rest of the possibly round-off-error sensitive grid-line matching tests changed to round-off-error
-! tolerant forms throughout the module.
-!
-! 4249 2019-10-01 12:27:47Z hellstea
-! Several grid-line matching tests changed to a round-off-error tolerant form in pmci_setup_parent,
-! pmci_define_index_mapping and pmci_check_grid_matching.
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4029 2019-06-14 14:04:35Z raasch
-! nest_chemistry switch removed
-!
-! 4026 2019-06-12 16:50:15Z suehring
-! Masked topography at boundary grid points in mass conservation, in order to
-! avoid that mean velocities within topography are imposed
-!
-! 4011 2019-05-31 14:34:03Z hellstea
-! Mass (volume) flux correction included to ensure global mass conservation for child domains.
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3984 2019-05-16 15:17:03Z hellstea
-! Commenting improved, pmci_map_fine_to_coarse_grid renamed as pmci_map_child_grid_to_parent_grid,
-! set_child_edge_coords renamed as pmci_set_child_edge_coords, some variables renamed, etc.
-!
-! 3979 2019-05-15 13:54:29Z hellstea
-! Bugfix in pmc_interp_1sto_sn. This bug had effect only in case of 1-d domain decomposition with
-! npex = 1.
-!
-! 3976 2019-05-15 11:02:34Z hellstea
-! Child initialization also for the redundant ghost points behind the nested boundaries added
-! (2nd and 3rd ghost-point layers and corners).
-!
-! 3948 2019-05-03 14:49:57Z hellstea
-! Some variables renamed, a little cleaning up and some commenting improvements
-!
-! 3947 2019-05-03 07:56:44Z hellstea
-! The checks included in 3946 are extended for the z-direction and moved into its own subroutine
-! called from pmci_define_index_mapping.
-!
-! 3946 2019-05-02 14:18:59Z hellstea
-! Check added for child domains too small in terms of number of parent-grid cells so that
-! anterpolation is not possible. Checks added for too wide anterpolation buffer for the same reason.
-! Some minor code reformatting done.
-!
-! 3945 2019-05-02 11:29:27Z raasch
-!
-! 3932 2019-04-24 17:31:34Z suehring
-! Add missing if statements for call of pmc_set_dataarray_name for TKE and dissipation.
-!
-! 3888 2019-04-12 09:18:10Z hellstea
-! Variables renamed, commenting improved etc.
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3883 2019-04-10 12:51:50Z hellstea
-! Checks and error messages improved and extended. All the child index bounds in the parent-grid
-! index space are made module variables. Function get_number_of_childs renamed
-! get_number_of_children. A number of variables renamed and qite a lot of other code reshaping made
-! all around the module.
-!
-! 3876 2019-04-08 18:41:49Z knoop
-! Implemented nesting for salsa variables.
-!
-! 3833 2019-03-28 15:04:04Z forkel
-! replaced USE chem_modules by USE chem_gasphase_mod
-!
-! 3822 2019-03-27 13:10:23Z hellstea
-! Temporary increase of the vertical dimension of the parent-grid arrays and workarrc_t is cancelled
-! as unnecessary.
-!
-! 3819 2019-03-27 11:01:36Z hellstea
-! Adjustable anterpolation buffer introduced on all nest boundaries, it is controlled by the new
-! nesting_parameters parameter anterpolation_buffer_width.
-!
-! 3804 2019-03-19 13:46:20Z hellstea
-! Anterpolation domain is lowered from kct-1 to kct-3 to avoid exessive kinetic energy from building
-! up in CBL flows.
-!
-! 3803 2019-03-19 13:44:40Z hellstea
-! A bug fixed in lateral boundary interpolations. Dimension of val changed from 5 to 3 in
-! pmci_setup_parent and pmci_setup_child.
-!
-! 3794 2019-03-15 09:36:33Z raasch
-! Two remaining unused variables removed
-!
-! 3792 2019-03-14 16:50:07Z hellstea
-! Interpolations improved. Large number of obsolete subroutines removed.
-! All unused variables removed.
-!
-! 3741 2019-02-13 16:24:49Z hellstea
-! Interpolations and child initialization adjusted to handle set ups with child pe-subdomain
-! dimension not integer divisible by the grid-spacing ratio in the respective direction. Set ups
-! with pe-subdomain dimension smaller than the grid-spacing ratio in the respective direction are
-! now forbidden.
-!
-! 3708 2019-01-30 12:58:13Z hellstea
-! Checks for parent / child grid line matching introduced.
-! Interpolation of nest-boundary-tangential velocity components revised.
-!
-! 3697 2019-01-24 17:16:13Z hellstea
-! Bugfix: upper k-bound in the child initialization interpolation pmci_interp_1sto_all corrected.
-! Copying of the nest boundary values into the redundant 2nd and 3rd ghost-node layers is added to
-! the pmci_interp_1sto_*-routines.
-!
-! 3681 2019-01-18 15:06:05Z hellstea
-! Linear interpolations are replaced by first order interpolations. The linear interpolation
-! routines are still included but not called. In the child inititialization the interpolation is
-! also changed to 1st order and the linear interpolation is not kept.
-! Subroutine pmci_map_fine_to_coarse_grid is rewritten.
-! Several changes in pmci_init_anterp_tophat.
-! Child's parent-grid arrays (uc, vc,...) are made non-overlapping on the PE-subdomain boundaries in
-! order to allow grid-spacing ratios higher than nbgp. Subroutine pmci_init_tkefactor is removed as
-! unnecessary.
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Remove unused variable simulated_time
-!
-! 1762 2016-02-25 12:31:13Z hellstea
-! Initial revision by A. Hellsten
-!
-! Description:
-! ------------
-! Domain nesting interface routines. The low-level inter-domain communication is conducted by the
-! PMC-library routines.
-!
-! @todo Remove array_3d variables from USE statements thate not used in the routine
-! @todo Data transfer of qc and nc is prepared but not activated
-!--------------------------------------------------------------------------------------------------!
- MODULE pmc_interface
-
-#if ! defined( __parallel )
-!
-!-- Serial mode does not allow nesting, but requires the following variables as steering quantities
-    USE kinds
-
-    IMPLICIT NONE
-
-    PUBLIC
-
-    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'none'  !< steering parameter for 1- or 2-way nesting
-
-    INTEGER(iwp), SAVE ::  comm_world_nesting  !< Global nesting communicator
-    INTEGER(iwp), SAVE ::  cpl_id  = 1         !<
-
-    LOGICAL, SAVE ::  nested_run = .FALSE.        !< general switch
-    LOGICAL, SAVE ::  rans_mode_parent = .FALSE.  !< parent model mode (.F.-LES mode, .T.-RANS mode)
-
-#else
-
-    USE ISO_C_BINDING
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  diss,                                                                               &
-               diss_2,                                                                             &
-               dzu,                                                                                &
-               dzw,                                                                                &
-               e,                                                                                  &
-               e_p,                                                                                &
-               e_2,                                                                                &
-               nc,                                                                                 &
-               nc_2,                                                                               &
-               nc_p,                                                                               &
-               nr,                                                                                 &
-               nr_2,                                                                               &
-               pt,                                                                                 &
-               pt_2,                                                                               &
-               q,                                                                                  &
-               q_2,                                                                                &
-               qc,                                                                                 &
-               qc_2,                                                                               &
-               qr,                                                                                 &
-               qr_2,                                                                               &
-               s,                                                                                  &
-               s_2,                                                                                &
-               u,                                                                                  &
-               u_p,                                                                                &
-               u_2,                                                                                &
-               v,                                                                                  &
-               v_p,                                                                                &
-               v_2,                                                                                &
-               w,                                                                                  &
-               w_p,                                                                                &
-               w_2,                                                                                &
-               zu,                                                                                 &
-               zw
-
-    USE chem_gasphase_mod,                                                                         &
-        ONLY:  nspec
-
-    USE chem_modules,                                                                              &
-        ONLY:  chem_species,                                                                       &
-               ibc_cs_b,                                                                           &
-               nesting_chem
-
-    USE chemistry_model_mod,                                                                       &
-        ONLY:  spec_conc_2
-
-    USE control_parameters,                                                                        &
-        ONLY:  air_chemistry,                                                                      &
-               bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               child_domain,                                                                       &
-               constant_diffusion,                                                                 &
-               constant_flux_layer,                                                                &
-               coupling_char,                                                                      &
-               debug_output_timestep,                                                              &
-               dt_restart,                                                                         &
-               dt_3d,                                                                              &
-               dz,                                                                                 &
-               end_time,                                                                           &
-               humidity,                                                                           &
-               ibc_pt_b,                                                                           &
-               ibc_q_b,                                                                            &
-               ibc_s_b,                                                                            &
-               ibc_uv_b,                                                                           &
-               message_string,                                                                     &
-               neutral,                                                                            &
-               passive_scalar,                                                                     &
-               rans_mode,                                                                          &
-               rans_tke_e,                                                                         &
-               restart_time,                                                                       &
-               roughness_length,                                                                   &
-               salsa,                                                                              &
-               time_restart,                                                                       &
-               topography,                                                                         &
-               volume_flow
-
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx,                                                                                 &
-               dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxlu,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               ny,                                                                                 &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nysv,                                                                               &
-               nz,                                                                                 &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               topo_top_ind,                                                                       &
-               wall_flags_total_0
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model,                                                                   &
-               microphysics_morrison,                                                              &
-               microphysics_seifert
-
-    USE particle_attributes,                                                                       &
-        ONLY:  particle_advection
-
-    USE kinds
-
-#if defined( __parallel )
-    USE MPI
-
-    USE pegrid,                                                                                    &
-        ONLY:  collective_wait,                                                                    &
-               comm1dx,                                                                            &
-               comm1dy,                                                                            &
-               comm2d,                                                                             &
-               myid,                                                                               &
-               myidx,                                                                              &
-               myidy,                                                                              &
-               numprocs,                                                                           &
-               pdims,                                                                              &
-               pleft,                                                                              &
-               pnorth,                                                                             &
-               pright,                                                                             &
-               psouth,                                                                             &
-               status
-
-    USE pmc_child,                                                                                 &
-        ONLY:  pmc_childinit,                                                                      &
-               pmc_c_clear_next_array_list,                                                        &
-               pmc_c_getnextarray,                                                                 &
-               pmc_c_get_2d_index_list,                                                            &
-               pmc_c_getbuffer,                                                                    &
-               pmc_c_putbuffer,                                                                    &
-               pmc_c_setind_and_allocmem,                                                          &
-               pmc_c_set_dataarray,                                                                &
-               pmc_set_dataarray_name
-
-    USE pmc_general,                                                                               &
-        ONLY:  da_namelen,                                                                         &
-               pmc_max_array
-
-    USE pmc_handle_communicator,                                                                   &
-        ONLY:  pmc_get_model_info,                                                                 &
-               pmc_init_model,                                                                     &
-               pmc_is_rootmodel,                                                                   &
-               pmc_no_namelist_found,                                                              &
-               pmc_parent_for_child,                                                               &
-               m_couplers
-
-    USE pmc_mpi_wrapper,                                                                           &
-        ONLY:  pmc_bcast,                                                                          &
-               pmc_recv_from_child,                                                                &
-               pmc_recv_from_parent,                                                               &
-               pmc_send_to_child,                                                                  &
-               pmc_send_to_parent
-
-    USE pmc_parent,                                                                                &
-        ONLY:  pmc_parentinit,                                                                     &
-               pmc_s_clear_next_array_list,                                                        &
-               pmc_s_fillbuffer,                                                                   &
-               pmc_s_getdata_from_buffer,                                                          &
-               pmc_s_getnextarray,                                                                 &
-               pmc_s_setind_and_allocmem,                                                          &
-               pmc_s_set_active_data_array,                                                        &
-               pmc_s_set_dataarray,                                                                &
-               pmc_s_set_2d_index_list
-
-#endif
-
-    USE salsa_mod,                                                                                 &
-        ONLY:  aerosol_mass,                                                                       &
-               aerosol_number,                                                                     &
-               gconc_2,                                                                            &
-               ibc_aer_b,                                                                          &
-               mconc_2,                                                                            &
-               nbins_aerosol,                                                                      &
-               ncomponents_mass,                                                                   &
-               nconc_2,                                                                            &
-               nesting_salsa,                                                                      &
-               ngases_salsa,                                                                       &
-               salsa_gas,                                                                          &
-               salsa_gases_from_chem
-
-    USE surface_mod,                                                                               &
-        ONLY:  bc_h,                                                                               &
-               surf_def_h,                                                                         &
-               surf_lsm_h,                                                                         &
-               surf_usm_h
-
-    IMPLICIT NONE
-
-
-    PRIVATE
-!
-!-- Constants
-    INTEGER(iwp), PARAMETER ::  child_to_parent = 2            !< Parameter for pmci_parent_datatrans indicating the direction of
-                                                               !< transfer
-    INTEGER(iwp), PARAMETER ::  interpolation_scheme_lrsn = 2  !< Interpolation scheme to be used on lateral boundaries
-    INTEGER(iwp), PARAMETER ::  interpolation_scheme_t = 3     !< Interpolation scheme to be used on top boundary
-    INTEGER(iwp), PARAMETER ::  parent_to_child = 1            !< Parameter for pmci_parent_datatrans indicating the direction of
-                                                               !< transfer
-
-    REAL(wp), PARAMETER ::  tolefac = 1.0E-6_wp  !< Relative tolerence for grid-line matching tests and comparisons
-!
-!-- Coupler setup
-    CHARACTER(LEN=32), SAVE ::  cpl_name  !<
-
-    INTEGER(iwp), SAVE ::  comm_world_nesting  !< Global nesting communicator
-    INTEGER(iwp), SAVE ::  cpl_id  = 1         !< Model (domain) id (1 for root, 2,... for nested domains).
-    INTEGER(iwp), SAVE ::  cpl_npe_total       !<
-    INTEGER(iwp), SAVE ::  cpl_parent_id       !<
-
-!
-!-- Control parameters
-    CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !< steering parameter for data-transfer mode
-    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'             !< steering parameter for 1- or 2-way nesting
-
-    INTEGER(iwp), SAVE ::  anterpolation_buffer_width = 2  !< Boundary buffer width for anterpolation
-
-    REAL(wp), SAVE ::  anterpolation_starting_height = 9999999.9_wp  !< steering parameter for canopy restricted anterpolation
-
-    LOGICAL, SAVE ::  nested_run = .FALSE.        !< general switch
-    LOGICAL, SAVE ::  particle_coupling = .TRUE.  !< switch for particle coupling (meaningful only when lpm is used) 
-    LOGICAL, SAVE ::  rans_mode_parent = .FALSE.  !< mode of parent model (.F. - LES mode, .T. - RANS mode)
-!
-!-- Geometry
-    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC ::  coord_x             !< Array for the absolute x-coordinates
-    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC ::  coord_y             !< Array for the absolute y-coordinates
-    REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_x  !< x-coordinate of the lower left corner of the domain
-    REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_y  !< y-coordinate of the lower left corner of the domain
-!
-!-- Children's parent-grid arrays
-    INTEGER(iwp), SAVE, DIMENSION(:,:), ALLOCATABLE :: kpb_anterp  !< Lower limit of kp in anterpolation 
-    INTEGER(iwp), SAVE, DIMENSION(5), PUBLIC ::  parent_bound  !< subdomain index bounds for children's parent-grid arrays
-
-    INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  nr_partc   !<
-    INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  part_adrc  !<
-
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  dissc  !< Parent-grid array on child domain - dissipation rate
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ec     !< Parent-grid array on child domain - SGS TKE
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nrc    !< Parent-grid array on child domain -
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ncc    !< Parent-grid array on child domain -
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ptc    !< Parent-grid array on child domain - potential temperature
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_c    !< Parent-grid array on child domain -
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qcc    !< Parent-grid array on child domain -
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qrc    !< Parent-grid array on child domain -
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sc     !< Parent-grid array on child domain -
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uc     !< Parent-grid array on child domain - velocity component u
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vc     !< Parent-grid array on child domain - velocity component v
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wc     !< Parent-grid array on child domain - velocity component w
-
-    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  aerosol_mass_c    !< Aerosol mass
-    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  aerosol_number_c  !< Aerosol number
-    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  chem_spec_c       !< Parent-grid array on child domain
-                                                                                  !< - chemical species
-    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  salsa_gas_c       !< SALSA gases
-!
-!-- Grid-spacing ratios.
-    INTEGER(iwp), SAVE ::  igsr  !< Integer grid-spacing ratio in i-direction
-    INTEGER(iwp), SAVE ::  jgsr  !< Integer grid-spacing ratio in j-direction
-    INTEGER(iwp), SAVE ::  kgsr  !< Integer grid-spacing ratio in k-direction
-!
-!-- Global parent-grid index bounds
-    INTEGER(iwp), SAVE ::  iplg  !< Leftmost parent-grid array ip index of the whole child domain
-    INTEGER(iwp), SAVE ::  iprg  !< Rightmost parent-grid array ip index of the whole child domain
-    INTEGER(iwp), SAVE ::  jpsg  !< Southmost parent-grid array jp index of the whole child domain
-    INTEGER(iwp), SAVE ::  jpng  !< Northmost parent-grid array jp index of the whole child domain
-!
-!-- Local parent-grid index bounds. Different sets of index bounds are needed for parent-grid arrays
-!-- (uc, etc), for index mapping arrays (iflu, etc) and for work arrays (workarr_lr, etc). This is
-!-- because these arrays have different dimensions depending on the location of the subdomain
-!-- relative to boundaries and corners.
-    INTEGER(iwp), SAVE ::  ipl   !< Left index limit for children's parent-grid arrays
-    INTEGER(iwp), SAVE ::  ipla  !< Left index limit for allocation of index-mapping and other auxiliary arrays
-    INTEGER(iwp), SAVE ::  iplw  !< Left index limit for children's parent-grid work arrays
-    INTEGER(iwp), SAVE ::  ipr   !< Right index limit for children's parent-grid arrays
-    INTEGER(iwp), SAVE ::  ipra  !< Right index limit for allocation of index-mapping and other auxiliary arrays
-    INTEGER(iwp), SAVE ::  iprw  !< Right index limit for children's parent-grid work arrays
-    INTEGER(iwp), SAVE ::  jpn   !< North index limit for children's parent-grid arrays
-    INTEGER(iwp), SAVE ::  jpna  !< North index limit for allocation of index-mapping and other auxiliary arrays
-    INTEGER(iwp), SAVE ::  jpnw  !< North index limit for children's parent-grid work arrays
-    INTEGER(iwp), SAVE ::  jps   !< South index limit for children's parent-grid arrays
-    INTEGER(iwp), SAVE ::  jpsa  !< South index limit for allocation of index-mapping and other auxiliary arrays
-    INTEGER(iwp), SAVE ::  jpsw  !< South index limit for children's parent-grid work arrays
-!
-!-- Highest prognostic parent-grid k-indices.
-    INTEGER(iwp), SAVE ::  kcto  !< Upper bound for k in anterpolation of variables other than w.
-    INTEGER(iwp), SAVE ::  kctw  !< Upper bound for k in anterpolation of w.
-!
-!-- Child-array indices to be precomputed and stored for anterpolation.
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflu   !< child index indicating left bound of parent grid box on u-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuu   !< child index indicating right bound of parent grid box on u-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflo   !< child index indicating left bound of parent grid box on scalar-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuo   !< child index indicating right bound of parent grid box on scalar-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jflv   !< child index indicating south bound of parent grid box on v-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuv   !< child index indicating north bound of parent grid box on v-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jflo   !< child index indicating south bound of parent grid box on scalar-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuo   !< child index indicating north bound of parent grid box on scalar-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflw   !< child index indicating lower bound of parent grid box on w-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuw   !< child index indicating upper bound of parent grid box on w-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflo   !< child index indicating lower bound of parent grid box on scalar-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuo   !< child index indicating upper bound of parent grid box on scalar-grid
-!
-!-- Number of child-grid nodes within anterpolation cells to be precomputed for anterpolation.
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_s  !< number of child grid points contributing to a parent grid
-                                                                   !< node in anterpolation, scalar-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_u  !< number of child grid points contributing to a parent grid
-                                                                   !< node in anterpolation, u-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_v  !< number of child grid points contributing to a parent grid
-                                                                   !< node in anterpolation, v-grid
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_w  !< number of child grid points contributing to a parent grid
-                                                                   !< node in anterpolation, w-grid
-!
-!-- Work arrays for interpolation and user-defined type definitions for horizontal work-array exchange
-    INTEGER(iwp) ::  workarr_lr_exchange_type   !< type definition for work-array exchange on left and right boundaries
-    INTEGER(iwp) ::  workarr_sn_exchange_type   !< type definition for work-array exchange on south and north boundaries
-    INTEGER(iwp) ::  workarr_t_exchange_type_x  !< type definition for work-array exchange on top boundary between left-right
-                                                !< neighbouring subdomains
-    INTEGER(iwp) ::  workarr_t_exchange_type_y  !< type definition for work-array exchange on top boundary between south-north
-                                                !< neighbouring subdomains
-
-    INTEGER(iwp), DIMENSION(3) ::  parent_grid_info_int  !< Array for communicating the parent-grid dimensions to its children.
-
-    REAL(wp), DIMENSION(6) ::  face_area              !< Surface area of each boundary face
-    REAL(wp), DIMENSION(7) ::  parent_grid_info_real  !< Array for communicating the real-type parent-grid parameters to its
-                                                      !< children.
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  workarr_lr  !< work array for interpolation on left and right boundaries
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  workarr_sn  !< work array for interpolation on south and north boundaries
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  workarr_t   !< work array for interpolation on top boundary
-
-    TYPE parentgrid_def
-       INTEGER(iwp) ::  nx  !<
-       INTEGER(iwp) ::  ny  !<
-       INTEGER(iwp) ::  nz  !<
-       REAL(wp) ::  dx                  !<
-       REAL(wp) ::  dy                  !<
-       REAL(wp) ::  dz                  !<
-       REAL(wp) ::  lower_left_coord_x  !<
-       REAL(wp) ::  lower_left_coord_y  !<
-       REAL(wp) ::  xend                !<
-       REAL(wp) ::  yend                !<
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  coord_x  !<
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  coord_y  !<
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzu      !<
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzw      !<
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu       !<
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw       !<
-    END TYPE parentgrid_def
-
-    TYPE(parentgrid_def), SAVE, PUBLIC ::  pg  !< Parent-grid information package of type parentgrid_def
-!
-!-- Variables for particle coupling
-    TYPE, PUBLIC :: childgrid_def
-       INTEGER(iwp) ::  nx          !<
-       INTEGER(iwp) ::  ny          !<
-       INTEGER(iwp) ::  nz          !<
-       REAL(wp)     ::  dx          !<
-       REAL(wp)     ::  dy          !<
-       REAL(wp)     ::  dz          !<
-       REAL(wp)     ::  lx_coord    !< 
-       REAL(wp)     ::  rx_coord    !< 
-       REAL(wp)     ::  sy_coord    !< 
-       REAL(wp)     ::  ny_coord    !< 
-       REAL(wp)     ::  uz_coord    !< 
-       REAL(wp)     ::  lx_coord_b  !< 
-       REAL(wp)     ::  rx_coord_b  !< 
-       REAL(wp)     ::  sy_coord_b  !< 
-       REAL(wp)     ::  ny_coord_b  !< 
-       REAL(wp)     ::  uz_coord_b  !<        
-    END TYPE childgrid_def
-
-    TYPE(childgrid_def), SAVE, ALLOCATABLE, DIMENSION(:), PUBLIC ::  childgrid  !<
-
-    INTEGER(idp), ALLOCATABLE,DIMENSION(:,:), PUBLIC,TARGET ::  nr_part   !<
-    INTEGER(idp), ALLOCATABLE,DIMENSION(:,:), PUBLIC,TARGET ::  part_adr  !<
-
-
-    INTERFACE pmci_boundary_conds
-       MODULE PROCEDURE pmci_boundary_conds
-    END INTERFACE pmci_boundary_conds
-
-    INTERFACE pmci_check_setting_mismatches
-       MODULE PROCEDURE pmci_check_setting_mismatches
-    END INTERFACE
-
-    INTERFACE pmci_child_initialize
-       MODULE PROCEDURE pmci_child_initialize
-    END INTERFACE
-
-    INTERFACE pmci_synchronize
-       MODULE PROCEDURE pmci_synchronize
-    END INTERFACE
-
-    INTERFACE pmci_datatrans
-       MODULE PROCEDURE pmci_datatrans
-    END INTERFACE pmci_datatrans
-
-    INTERFACE pmci_ensure_nest_mass_conservation
-       MODULE PROCEDURE pmci_ensure_nest_mass_conservation
-    END INTERFACE pmci_ensure_nest_mass_conservation
-
-    INTERFACE pmci_ensure_nest_mass_conservation_vertical
-       MODULE PROCEDURE pmci_ensure_nest_mass_conservation_vertical
-    END INTERFACE pmci_ensure_nest_mass_conservation_vertical
-
-    INTERFACE pmci_init
-       MODULE PROCEDURE pmci_init
-    END INTERFACE
-
-    INTERFACE pmci_modelconfiguration
-       MODULE PROCEDURE pmci_modelconfiguration
-    END INTERFACE
-
-    INTERFACE pmci_parent_initialize
-       MODULE PROCEDURE pmci_parent_initialize
-    END INTERFACE
-
-    INTERFACE get_number_of_children
-       MODULE PROCEDURE get_number_of_children
-    END  INTERFACE get_number_of_children
-
-    INTERFACE get_childid
-       MODULE PROCEDURE get_childid
-    END  INTERFACE get_childid
-
-    INTERFACE get_child_edges
-       MODULE PROCEDURE get_child_edges
-    END  INTERFACE get_child_edges
-
-    INTERFACE get_child_gridspacing
-       MODULE PROCEDURE get_child_gridspacing
-    END  INTERFACE get_child_gridspacing
-
-    INTERFACE pmci_set_swaplevel
-       MODULE PROCEDURE pmci_set_swaplevel
-    END INTERFACE pmci_set_swaplevel
-
-    PUBLIC child_to_parent,                                                                        &
-           comm_world_nesting,                                                                     &
-           cpl_id,                                                                                 &
-           nested_run,                                                                             &
-           nesting_datatransfer_mode,                                                              &
-           nesting_mode,                                                                           &
-           parent_to_child,                                                                        &
-           particle_coupling,                                                                      &
-           rans_mode_parent
-
-    PUBLIC pmci_boundary_conds
-    PUBLIC pmci_child_initialize
-    PUBLIC pmci_datatrans
-    PUBLIC pmci_init
-    PUBLIC pmci_modelconfiguration
-    PUBLIC pmci_parent_initialize
-    PUBLIC pmci_synchronize
-    PUBLIC pmci_set_swaplevel
-    PUBLIC get_number_of_children, get_childid, get_child_edges, get_child_gridspacing
-    PUBLIC pmci_ensure_nest_mass_conservation
-    PUBLIC pmci_ensure_nest_mass_conservation_vertical
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Find out if this is a nested run and if so, read and broadcast the nesting parameters and set
-!> the communicators accordingly.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_init( world_comm )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(OUT) ::  world_comm  !< global communicator
-
-#if defined( __parallel )
-
-    INTEGER(iwp) ::  pmc_status  !< status parameter indicating if the nesting_parameters namelist
-                                 !< was succesfully input or not  
-
-
-    CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode,                      &
-                         anterpolation_buffer_width, anterpolation_starting_height,                &
-                         particle_coupling, pmc_status )
-    IF ( pmc_status == pmc_no_namelist_found )  THEN
-!
-!--    This is not a nested run
-       world_comm = MPI_COMM_WORLD
-       cpl_id     = 1
-       cpl_name   = ""
-
-       RETURN
-
-    ENDIF
-!
-!-- Check steering parameter values
-    IF ( TRIM( nesting_mode ) /= 'one-way'  .AND.                                                  &
-         TRIM( nesting_mode ) /= 'two-way'  .AND.                                                  &
-         TRIM( nesting_mode ) /= 'vertical' )                                                      &
-    THEN
-       message_string = 'illegal nesting mode: ' // TRIM( nesting_mode )
-       CALL message( 'pmci_init', 'PA0417', 3, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade'  .AND.                                     &
-         TRIM( nesting_datatransfer_mode ) /= 'mixed'    .AND.                                     &
-         TRIM( nesting_datatransfer_mode ) /= 'overlap' )                                          &
-    THEN
-       message_string = 'illegal nesting datatransfer mode: ' // TRIM( nesting_datatransfer_mode )
-       CALL message( 'pmci_init', 'PA0418', 3, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Set the general steering switch which tells PALM that it is a nested run
-    nested_run = .TRUE.
-!
-!-- Get some variables required by the pmc-interface (and in some cases in the PALM code out of the
-!-- pmci) out of the pmc-core
-    CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting, cpl_id = cpl_id,             &
-                             cpl_parent_id = cpl_parent_id, cpl_name = cpl_name,                   &
-                             npe_total = cpl_npe_total, lower_left_x = lower_left_coord_x,         &
-                             lower_left_y = lower_left_coord_y )
-!
-!-- Set the steering switch which tells the models that they are nested (of course the root domain
-!-- is not nested)
-    IF ( .NOT.  pmc_is_rootmodel() )  THEN
-       child_domain = .TRUE.
-       WRITE( coupling_char, '(A2,I2.2)') '_N', cpl_id
-    ENDIF
-
-!
-!-- Message that communicators for nesting are initialized.
-!-- Attention: myid has been set at the end of pmc_init_model in order to guarantee that only PE0 of
-!-- the root domain does the output.
-    CALL location_message( 'initialize model nesting', 'finished' )
-!
-!-- Reset myid to its default value
-    myid = 0
-#else
-!
-!-- Nesting cannot be used in serial mode. cpl_id is set to root domain (1) because no location
-!-- messages would be generated otherwise. world_comm is given a dummy value to avoid compiler
-!-- warnings (INTENT(OUT) must get an explicit value).
-!-- Note that this branch is only to avoid compiler warnings. The actual execution never reaches
-!-- here because the call of this subroutine is already enclosed by  #if defined( __parallel ).
-    cpl_id     = 1
-    nested_run = .FALSE.
-    world_comm = 1
-#endif
-
- END SUBROUTINE pmci_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define the nesting setup.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_modelconfiguration
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ncpl  !< number of nest domains
-
-
-#if defined( __parallel )
-    CALL location_message( 'setup the nested model configuration', 'start' )
-    CALL cpu_log( log_point_s(79), 'pmci_model_config', 'start' )
-!
-!-- Compute absolute coordinates for all models
-    CALL pmci_setup_coordinates         ! CONTAIN THIS
-!
-!-- Determine the number of coupled arrays
-    CALL pmci_num_arrays                ! CONTAIN THIS
-!
-!-- Initialize the child (must be called before pmc_setup_parent)
-!-- Klaus, extend this comment to explain why it must be called before
-    CALL pmci_setup_child               ! CONTAIN THIS
-!
-!-- Initialize PMC parent
-    CALL pmci_setup_parent              ! CONTAIN THIS
-!
-!-- Check for mismatches between settings of master and child variables
-!-- (e.g., all children have to follow the end_time settings of the root master)
-    CALL pmci_check_setting_mismatches  ! CONTAIN THIS
-!
-!-- Set flag file for combine_plot_fields for processing the nest output data
-    OPEN( 90, FILE = '3DNESTING', FORM = 'FORMATTED' )
-    CALL pmc_get_model_info( ncpl = ncpl )
-    WRITE( 90, '(I2)' )  ncpl
-    CLOSE( 90 )
-
-    CALL cpu_log( log_point_s(79), 'pmci_model_config', 'stop' )
-    CALL location_message( 'setup the nested model configuration', 'finished' )
-#endif
-
- END SUBROUTINE pmci_modelconfiguration
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prepare the coupling environment for the current parent domain.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_setup_parent
-
-#if defined( __parallel )
-    IMPLICIT NONE
-
-    CHARACTER(LEN=32) ::  myname  !< String for variable name such as 'u'
-
-    INTEGER(iwp) ::  child_id    !< Child id-number for the child m
-    INTEGER(iwp) ::  ierr        !< MPI-error code
-    INTEGER(iwp) ::  kp          !< Parent-grid index n the z-direction
-    INTEGER(iwp) ::  lb = 1      !< Running index for aerosol size bins
-    INTEGER(iwp) ::  lc = 1      !< Running index for aerosol mass bins
-    INTEGER(iwp) ::  lg = 1      !< Running index for SALSA gases
-    INTEGER(iwp) ::  m           !< Loop index over all children of the current parent
-    INTEGER(iwp) ::  msib        !< Loop index over all other children than m in case of siblings (parallel children)
-    INTEGER(iwp) ::  n = 1       !< Running index for chemical species
-    INTEGER(iwp) ::  nx_child    !< Number of child-grid points in the x-direction
-    INTEGER(iwp) ::  ny_child    !< Number of child-grid points in the y-direction
-    INTEGER(iwp) ::  nz_child    !< Number of child-grid points in the z-direction
-    INTEGER(iwp) ::  sibling_id  !< Child id-number for the child msib (sibling of child m)
-
-    INTEGER(iwp), DIMENSION(3) ::  child_grid_dim  !< Array for receiving the child-grid dimensions from the children
-
-    LOGICAL :: m_left_in_msib   !< Logical auxiliary parameter for the overlap test: true if the left border
-                                !< of the child m is within the x-range of the child msib
-    LOGICAL :: m_right_in_msib  !< Logical auxiliary parameter for the overlap test: true if the right border
-                                !< of the child m is within the x-range of the child msib
-    LOGICAL :: msib_left_in_m   !< Logical auxiliary parameter for the overlap test: true if the left border
-                                !< of the child msib is within the x-range of the child m
-    LOGICAL :: msib_right_in_m  !< Logical auxiliary parameter for the overlap test: true if the right border
-                                !< of the child msib is within the x-range of the child m
-    LOGICAL :: m_south_in_msib  !< Logical auxiliary parameter for the overlap test: true if the south border
-                                !< of the child m is within the y-range of the child msib
-    LOGICAL :: m_north_in_msib  !< Logical auxiliary parameter for the overlap test: true if the north border
-                                !< of the child m is within the y-range of the child msib
-    LOGICAL :: msib_south_in_m  !< Logical auxiliary parameter for the overlap test: true if the south border
-                                !< of the child msib is within the y-range of the child m
-    LOGICAL :: msib_north_in_m  !< Logical auxiliary parameter for the overlap test: true if the north border
-                                !< of the child msib is within the y-range of the child m
-
-    REAL(wp) ::  child_height         !< Height of the child domain defined on the child side as zw(nzt+1)
-    REAL(wp) ::  dx_child             !< Child-grid spacing in the x-direction
-    REAL(wp) ::  dy_child             !< Child-grid spacing in the y-direction
-    REAL(wp) ::  dz_child             !< Child-grid spacing in the z-direction
-    REAL(wp) ::  left_limit           !< Left limit for the absolute x-coordinate of the child left boundary
-    REAL(wp) ::  north_limit          !< North limit for the absolute y-coordinate of the child north boundary
-    REAL(wp) ::  right_limit          !< Right limit for the absolute x-coordinate of the child right boundary
-    REAL(wp) ::  south_limit          !< South limit for the absolute y-coordinate of the child south boundary
-    REAL(wp) ::  upper_right_coord_x  !< Absolute x-coordinate of the upper right corner of the child domain
-    REAL(wp) ::  upper_right_coord_y  !< Absolute y-coordinate of the upper right corner of the child domain
-    REAL(wp) ::  xez                  !< Minimum separation in the x-direction required between the child and
-                                      !< parent boundaries (left or right)
-    REAL(wp) ::  yez                  !< Minimum separation in the y-direction required between the child and
-                                      !< parent boundaries (south or north)
-    REAL(wp) ::  tolex                !< Tolerance for grid-line matching in x-direction
-    REAL(wp) ::  toley                !< Tolerance for grid-line matching in y-direction
-    REAL(wp) ::  tolez                !< Tolerance for grid-line matching in z-direction
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_coord_x  !< Child domain x-coordinate array
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_coord_y  !< Child domain y-coordinate array
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_x_left   !< Minimum x-coordinate of the child domain including the ghost
-                                                           !< point layers
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_x_right  !< Maximum x-coordinate of the child domain including the ghost
-                                                           !< point layers
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_y_north  !< Maximum y-coordinate of the child domain including the ghost
-                                                           !< point layers
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_y_south  !< Minimum y-coordinate of the child domain including the ghost
-                                                           !< point layers
-
-    REAL(wp), DIMENSION(5) ::  child_grid_info  !< Array for receiving the child-grid spacings etc from the children
-
-!
-!-- Grid-line tolerances.
-    tolex = tolefac * dx
-    toley = tolefac * dy
-    tolez = tolefac * dz(1)
-!
-!-- Initialize the current pmc parent.
-    CALL pmc_parentinit
-!
-!-- Corners of all children of the present parent. Note that SIZE( pmc_parent_for_child ) = 1 if we
-!-- have no children.
-    IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 )  .AND.  myid == 0 )  THEN
-       ALLOCATE( child_x_left(1:SIZE(  pmc_parent_for_child ) - 1) )
-       ALLOCATE( child_x_right(1:SIZE( pmc_parent_for_child ) - 1) )
-       ALLOCATE( child_y_south(1:SIZE( pmc_parent_for_child ) - 1) )
-       ALLOCATE( child_y_north(1:SIZE( pmc_parent_for_child ) - 1) )
-    ENDIF
-    IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 ) )  THEN
-       ALLOCATE( childgrid(1:SIZE( pmc_parent_for_child ) - 1) )
-    ENDIF
-!
-!-- Get coordinates from all children and check that the children match the parent domain and each
-!-- others. Note that SIZE( pmc_parent_for_child ) = 1 if we have no children, hence the loop is
-!-- not executed at all.
-    DO  m = 1, SIZE( pmc_parent_for_child ) - 1
-
-       child_id = pmc_parent_for_child(m)
-!
-!--    Set counter variables for chemical and aerosol species back to one for each child domain
-       n  = 1
-       lb = 1
-       lc = 1
-       lg = 1
-
-       IF ( myid == 0 )  THEN
-
-          CALL pmc_recv_from_child( child_id, child_grid_dim,  SIZE( child_grid_dim ), 0, 123,     &
-                                    ierr )
-          CALL pmc_recv_from_child( child_id, child_grid_info, SIZE( child_grid_info ), 0, 124,    &
-                                    ierr )
-
-          nx_child     = child_grid_dim(1)
-          ny_child     = child_grid_dim(2)
-          dx_child     = child_grid_info(3)
-          dy_child     = child_grid_info(4)
-          dz_child     = child_grid_info(5)
-          child_height = child_grid_info(1)
-!
-!--       Find the highest child-domain level in the parent grid for the reduced z transfer
-          DO  kp = 1, nzt
-             IF ( zw(kp) - child_height > tolez )  THEN
-                nz_child = kp
-                EXIT
-             ENDIF
-          ENDDO
-!
-!--       Get absolute coordinates from the child
-          ALLOCATE( child_coord_x(-nbgp:nx_child+nbgp) )
-          ALLOCATE( child_coord_y(-nbgp:ny_child+nbgp) )
-
-          CALL pmc_recv_from_child( child_id, child_coord_x, SIZE( child_coord_x ), 0, 11, ierr )
-          CALL pmc_recv_from_child( child_id, child_coord_y, SIZE( child_coord_y ), 0, 12, ierr )
-
-          parent_grid_info_real(1) = lower_left_coord_x
-          parent_grid_info_real(2) = lower_left_coord_y
-          parent_grid_info_real(3) = dx
-          parent_grid_info_real(4) = dy
-
-          upper_right_coord_x      = lower_left_coord_x + ( nx + 1 ) * dx
-          upper_right_coord_y      = lower_left_coord_y + ( ny + 1 ) * dy
-          parent_grid_info_real(5) = upper_right_coord_x
-          parent_grid_info_real(6) = upper_right_coord_y
-          parent_grid_info_real(7) = dz(1)
-
-          parent_grid_info_int(1)  = nx
-          parent_grid_info_int(2)  = ny
-          parent_grid_info_int(3)  = nz_child
-!
-!--       Check that the child domain matches its parent domain.
-          IF ( nesting_mode == 'vertical' )  THEN
-!
-!--          In case of vertical nesting, the lateral boundaries must match exactly.
-             right_limit = upper_right_coord_x
-             north_limit = upper_right_coord_y
-             IF ( ABS( child_coord_x(nx_child+1) - right_limit ) > tolex )  THEN
-                WRITE( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
-                       ') domain right edge does not match its parent right edge'
-                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
-             ENDIF
-             IF ( ABS( child_coord_y(ny_child+1) - north_limit ) > toley )  THEN
-                WRITE( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
-                       ') domain north edge does not match its parent north edge'
-                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
-             ENDIF
-          ELSE
-!
-!--          In case of 3-D nesting, check that the child domain is completely inside its parent
-!--          domain.
-             xez = ( nbgp + 1 ) * dx
-             yez = ( nbgp + 1 ) * dy
-             left_limit  = lower_left_coord_x + xez
-             right_limit = upper_right_coord_x - xez
-             south_limit = lower_left_coord_y + yez
-             north_limit = upper_right_coord_y - yez
-             IF ( left_limit - child_coord_x(0) > tolex )  THEN
-                WRITE( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
-                       ') domain does not fit in its parent domain, left edge is either too ' //   &
-                       'close or outside its parent left edge'
-                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
-             ENDIF
-             IF ( child_coord_x(nx_child+1) - right_limit > tolex )  THEN
-                WRITE( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
-                       ') domain does not fit in its parent domain, right edge is either too ' //  &
-                       'close or outside its parent right edge'
-                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
-             ENDIF
-             IF ( south_limit - child_coord_y(0) > toley )  THEN
-                WRITE( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
-                       ') domain does not fit in its parent domain, south edge is either too ' //  &
-                       'close or outside its parent south edge'
-                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
-             ENDIF
-             IF ( child_coord_y(ny_child+1) - north_limit > toley )  THEN
-                WRITE( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
-                       ') domain does not fit in its parent domain, north edge is either too ' //  &
-                       'close or outside its parent north edge'
-                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
-             ENDIF
-          ENDIF
-!
-!--       Child domain must be lower than the parent domain such that the top ghost layer of the
-!--       child grid does not exceed the parent domain top boundary.
-          IF ( child_height - zw(nzt) > tolez ) THEN
-             WRITE( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                    &
-                    ') domain does not fit in its parent domain, top edge is either too ' //       &
-                    'close or above its parent top edge'
-             CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
-          ENDIF
-!
-!--       If parallel child domains (siblings) do exist ( m > 1 ), check that they do not overlap.
-          child_x_left(m)  = child_coord_x(-nbgp)
-          child_x_right(m) = child_coord_x(nx_child+nbgp)
-          child_y_south(m) = child_coord_y(-nbgp)
-          child_y_north(m) = child_coord_y(ny_child+nbgp)
-
-          IF ( nesting_mode /= 'vertical' )  THEN
-!
-!--          Note that the msib-loop is executed only if ( m > 1 ).
-!--          Also note that the tests have to be done both ways (m vs msib and msib vs m) in order
-!--          to detect all the possible overlap situations.
-             DO  msib = 1, m - 1
-!
-!--             Set some logical auxiliary parameters to simplify the IF-condition.
-                m_left_in_msib  = ( child_x_left(m)  >= child_x_left(msib)  - tolex )  .AND.       &
-                                  ( child_x_left(m)  <= child_x_right(msib) + tolex )
-                m_right_in_msib = ( child_x_right(m) >= child_x_left(msib)  - tolex )  .AND.       &
-                                  ( child_x_right(m) <= child_x_right(msib) + tolex )
-                msib_left_in_m  = ( child_x_left(msib)  >= child_x_left(m)  - tolex )  .AND.       &
-                                  ( child_x_left(msib)  <= child_x_right(m) + tolex )
-                msib_right_in_m = ( child_x_right(msib) >= child_x_left(m)  - tolex )  .AND.       &
-                                  ( child_x_right(msib) <= child_x_right(m) + tolex )
-                m_south_in_msib = ( child_y_south(m) >= child_y_south(msib) - toley )  .AND.       &
-                                  ( child_y_south(m) <= child_y_north(msib) + toley )
-                m_north_in_msib = ( child_y_north(m) >= child_y_south(msib) - toley )  .AND.       &
-                                  ( child_y_north(m) <= child_y_north(msib) + toley )
-                msib_south_in_m = ( child_y_south(msib) >= child_y_south(m) - toley )  .AND.       &
-                                  ( child_y_south(msib) <= child_y_north(m) + toley )
-                msib_north_in_m = ( child_y_north(msib) >= child_y_south(m) - toley )  .AND.       &
-                                  ( child_y_north(msib) <= child_y_north(m) + toley )
-
-                IF ( ( m_left_in_msib  .OR.  m_right_in_msib  .OR.                                 &
-                       msib_left_in_m  .OR.  msib_right_in_m )  .AND.                              &
-                     ( m_south_in_msib  .OR.  m_north_in_msib  .OR.                                &
-                       msib_south_in_m  .OR.  msib_north_in_m ) )  THEN
-                   sibling_id = pmc_parent_for_child(msib)
-                   WRITE( message_string, "(a,i2,a,i2,a)" ) 'nested parallel child domains (ids: ',&
-                          child_id, ' and ', sibling_id, ') overlap'
-                   CALL message( 'pmci_setup_parent', 'PA0426', 3, 2, 0, 6, 0 )
-                ENDIF
-
-             ENDDO
-          ENDIF
-
-          CALL pmci_set_child_edge_coords
-
-          DEALLOCATE( child_coord_x )
-          DEALLOCATE( child_coord_y )
-!
-!--       Send information about operating mode (LES or RANS) to child. This will be used to
-!--       control TKE nesting and setting boundary conditions properly.
-          CALL pmc_send_to_child( child_id, rans_mode, 1, 0, 19, ierr )
-!
-!--       Send parent grid information to child
-          CALL pmc_send_to_child( child_id, parent_grid_info_real, SIZE( parent_grid_info_real ),  &
-                                  0, 21, ierr )
-          CALL pmc_send_to_child( child_id, parent_grid_info_int,  3, 0, 22, ierr )
-!
-!--       Send local grid to child
-          CALL pmc_send_to_child( child_id, coord_x, nx+1+2*nbgp, 0, 24, ierr )
-          CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25, ierr )
-!
-!--       Also send the dzu-, dzw-, zu- and zw-arrays here
-          CALL pmc_send_to_child( child_id, dzu, nz_child + 1, 0, 26, ierr )
-          CALL pmc_send_to_child( child_id, dzw, nz_child + 1, 0, 27, ierr )
-          CALL pmc_send_to_child( child_id, zu,  nz_child + 2, 0, 28, ierr )
-          CALL pmc_send_to_child( child_id, zw,  nz_child + 2, 0, 29, ierr )
-
-       ENDIF  ! ( myid == 0 )
-
-       CALL MPI_BCAST( nz_child, 1, MPI_INTEGER, 0, comm2d, ierr )
-
-       CALL MPI_BCAST( childgrid(m), STORAGE_SIZE( childgrid( 1 ) ) / 8, MPI_BYTE, 0, comm2d, ierr )
-!
-!--    Set up the index-list which is an integer array that maps the child index space on the parent
-!--    index- and subdomain spaces.
-       CALL pmci_create_index_list
-!
-!--    Include couple arrays into parent content.
-!--    The adresses of the PALM 2D or 3D array (here parent grid) which are candidates for coupling
-!--    are stored once into the pmc context. While data transfer, the arrays do not have to be
-!--    specified again
-       CALL pmc_s_clear_next_array_list
-       DO WHILE ( pmc_s_getnextarray( child_id, myname ) )
-          IF ( INDEX( TRIM( myname ), 'chem_' ) /= 0 )  THEN
-             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = n )
-             n = n + 1
-          ELSEIF ( INDEX( TRIM( myname ), 'an_' ) /= 0 )  THEN
-             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lb )
-             lb = lb + 1
-          ELSEIF ( INDEX( TRIM( myname ), 'am_' ) /= 0 )  THEN
-             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lc )
-             lc = lc + 1
-          ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0  .AND.  .NOT. salsa_gases_from_chem )  THEN
-             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lg )
-             lg = lg + 1
-          ELSE
-             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child )
-          ENDIF
-       ENDDO
-
-       CALL pmc_s_setind_and_allocmem( child_id )
-
-    ENDDO  ! m
-
-    IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 )  .AND.  myid == 0 )  THEN
-       DEALLOCATE( child_x_left )
-       DEALLOCATE( child_x_right )
-       DEALLOCATE( child_y_south )
-       DEALLOCATE( child_y_north )
-    ENDIF
-
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create the index list
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_create_index_list
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ilist            !< Index-list index running over the child's parent-grid jc,ic-space
-    INTEGER(iwp) ::  index_list_size  !< Dimension 2 of the array index_list
-    INTEGER(iwp) ::  ierr             !< MPI error code
-    INTEGER(iwp) ::  ip               !< Running parent-grid index on the child domain in the x-direction
-    INTEGER(iwp) ::  jp               !< Running parent-grid index on the child domain in the y-direction
-    INTEGER(iwp) ::  n                !< Running index over child subdomains
-    INTEGER(iwp) ::  nrx              !< Parent subdomain dimension in the x-direction
-    INTEGER(iwp) ::  nry              !< Parent subdomain dimension in the y-direction
-    INTEGER(iwp) ::  pex              !< Two-dimensional subdomain (pe) index in the x-direction
-    INTEGER(iwp) ::  pey              !< Two-dimensional subdomain (pe) index in the y-direction
-    INTEGER(iwp) ::  parent_pe        !< Parent subdomain index (one-dimensional)
-
-    INTEGER(iwp), DIMENSION(2) ::  pe_indices_2d                          !< Array for two-dimensional subdomain (pe)
-                                                                          !< indices needed for MPI_CART_RANK
-    INTEGER(iwp), DIMENSION(2) ::  size_of_childs_parent_grid_bounds_all  !< Dimensions of childs_parent_grid_bounds_all
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  childs_parent_grid_bounds_all  !< Array that contains the child's
-                                                                                  !< parent-grid index
-                                                                                  !< bounds for all its subdomains (pes)
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  index_list                     !< Array that maps the child index space on
-                                                                                  !< the parent index- and subdomain spaces
-
-    IF ( myid == 0 )  THEN
-
-       CALL pmc_recv_from_child( child_id, size_of_childs_parent_grid_bounds_all, 2, 0, 40, ierr )
-       ALLOCATE( childs_parent_grid_bounds_all(size_of_childs_parent_grid_bounds_all(1),           &
-                                               size_of_childs_parent_grid_bounds_all(2)) )
-       CALL pmc_recv_from_child( child_id, childs_parent_grid_bounds_all,                          &
-                                 SIZE( childs_parent_grid_bounds_all ), 0, 41, ierr )
-!
-!--    Compute size (dimension) of the index_list.
-       index_list_size = 0
-       DO  n = 1, size_of_childs_parent_grid_bounds_all(2)
-          index_list_size = index_list_size +                                                      &
-               ( childs_parent_grid_bounds_all(4,n) - childs_parent_grid_bounds_all(3,n) + 1 ) *   &
-               ( childs_parent_grid_bounds_all(2,n) - childs_parent_grid_bounds_all(1,n) + 1 )
-       ENDDO
-
-       ALLOCATE( index_list(6,index_list_size) )
-
-       nrx = nxr - nxl + 1
-       nry = nyn - nys + 1
-       ilist = 0
-!
-!--    Loop over all children PEs
-       DO  n = 1, size_of_childs_parent_grid_bounds_all(2)           !
-!
-!--       Subspace along y required by actual child PE
-          DO  jp = childs_parent_grid_bounds_all(3,n), childs_parent_grid_bounds_all(4,n)  ! jp = jps, jpn of child PE# n
-!
-!--          Subspace along x required by actual child PE
-             DO  ip = childs_parent_grid_bounds_all(1,n), childs_parent_grid_bounds_all(2,n)  ! ip = ipl, ipr of child PE# n
-
-                pex = ip / nrx
-                pey = jp / nry
-                pe_indices_2d(1) = pex
-                pe_indices_2d(2) = pey
-                CALL MPI_CART_RANK( comm2d, pe_indices_2d, parent_pe, ierr )
-
-                ilist = ilist + 1
-!
-!--             First index in parent array  ! TO_DO: Klaus, please explain better
-                index_list(1,ilist) = ip - ( pex * nrx ) + 1 + nbgp
-!
-!--             Second index in parent array  ! TO_DO: Klaus, please explain better
-                index_list(2,ilist) = jp - ( pey * nry ) + 1 + nbgp
-!
-!--             x index of child's parent grid
-                index_list(3,ilist) = ip - childs_parent_grid_bounds_all(1,n) + 1
-!
-!--             y index of child's parent grid
-                index_list(4,ilist) = jp - childs_parent_grid_bounds_all(3,n) + 1
-!
-!--             PE number of child
-                index_list(5,ilist) = n - 1
-!
-!--             PE number of parent
-                index_list(6,ilist) = parent_pe
-
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    TO_DO: Klaus: comment what is done here
-       CALL pmc_s_set_2d_index_list( child_id, index_list(:,1:ilist) )
-
-    ELSE
-!
-!--    TO_DO: Klaus: comment why this dummy allocation is required
-       ALLOCATE( index_list(6,1) )
-       CALL pmc_s_set_2d_index_list( child_id, index_list )
-    ENDIF
-
-    DEALLOCATE( index_list )
-
- END SUBROUTINE pmci_create_index_list
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Store the child-edge coordinates.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_set_child_edge_coords
-    IMPLICIT  NONE
-
-    INTEGER(iwp) ::  nbgp_lpm = 1  !< Number of ghost-point layers used for lpm (Klaus, is this correct?)
-
-
-    nbgp_lpm = MIN( nbgp_lpm, nbgp )
-
-    childgrid(m)%nx = nx_child
-    childgrid(m)%ny = ny_child
-    childgrid(m)%nz = nz_child
-    childgrid(m)%dx = dx_child
-    childgrid(m)%dy = dy_child
-    childgrid(m)%dz = dz_child
-
-    childgrid(m)%lx_coord   = child_coord_x(0)
-    childgrid(m)%lx_coord_b = child_coord_x(-nbgp_lpm)
-    childgrid(m)%rx_coord   = child_coord_x(nx_child) + dx_child
-    childgrid(m)%rx_coord_b = child_coord_x(nx_child+nbgp_lpm) + dx_child
-    childgrid(m)%sy_coord   = child_coord_y(0)
-    childgrid(m)%sy_coord_b = child_coord_y(-nbgp_lpm)
-    childgrid(m)%ny_coord   = child_coord_y(ny_child) + dy_child
-    childgrid(m)%ny_coord_b = child_coord_y(ny_child+nbgp_lpm) + dy_child
-    childgrid(m)%uz_coord   = child_grid_info(2)
-    childgrid(m)%uz_coord_b = child_grid_info(1)
-
- END SUBROUTINE pmci_set_child_edge_coords
-
-#endif
- END SUBROUTINE pmci_setup_parent
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prepare the coupling environment for the current child domain.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_setup_child
-
-#if defined( __parallel )
-    IMPLICIT NONE
-
-    CHARACTER(LEN=da_namelen) ::  myname      !< Name of the variable to be coupled
-    CHARACTER(LEN=5)          ::  salsa_char  !< Name extension for the variable name in case of SALSA variable
-
-    INTEGER(iwp) ::  ierr  !< MPI error code
-    INTEGER(iwp) ::  lb    !< Running index for aerosol size bins
-    INTEGER(iwp) ::  lc    !< Running index for aerosol mass bins
-    INTEGER(iwp) ::  lg    !< Running index for SALSA gases
-    INTEGER(iwp) ::  n     !< Running index for number of chemical species
-
-    INTEGER(iwp), DIMENSION(3) ::  child_grid_dim  !< Array for sending the child-grid dimensions to parent
-
-    REAL(wp), DIMENSION(5) ::  child_grid_info  !< Array for sending the child-grid spacings etc to parent
-
-!
-!-- Child setup
-!-- Root model does not have a parent and is not a child, therefore no child setup on root model
-    IF ( .NOT. pmc_is_rootmodel() )  THEN
-!
-!--    KLaus, add a description here what pmc_childinit does
-       CALL pmc_childinit
-!
-!--    The arrays, which actually will be exchanged between child and parent are defined Here AND
-!--    ONLY HERE. If a variable is removed, it only has to be removed from here. Please check, if
-!--    the arrays are in the list of POSSIBLE exchange arrays in subroutines:
-!--    pmci_set_array_pointer (for parent arrays)
-!--    pmci_create_childs_parent_grid_arrays (for child's parent-grid arrays)
-       CALL pmc_set_dataarray_name( 'parent', 'u', 'child', 'u', ierr )
-       CALL pmc_set_dataarray_name( 'parent', 'v', 'child', 'v', ierr )
-       CALL pmc_set_dataarray_name( 'parent', 'w', 'child', 'w', ierr )
-!
-!--    Set data array name for TKE. Please note, nesting of TKE is actually only done if both parent
-!--    and child are in LES or in RANS mode. Due to design of model coupler, however, data array
-!--    names must be already available at this point, though the control flag whether data shall
-!--    be interpolated / anterpolated is not available yet.
-       CALL pmc_set_dataarray_name( 'parent', 'e', 'child', 'e', ierr )
-!
-!--    Nesting of dissipation rate only if both parent and child are in RANS mode and TKE-epsilon
-!--    closure is applied. Please see also comment for TKE above.
-       CALL pmc_set_dataarray_name( 'parent', 'diss', 'child', 'diss', ierr )
-
-       IF ( .NOT. neutral )  THEN
-          CALL pmc_set_dataarray_name( 'parent', 'pt' ,'child', 'pt', ierr )
-       ENDIF
-
-       IF ( humidity )  THEN
-
-          CALL pmc_set_dataarray_name( 'parent', 'q', 'child', 'q', ierr )
-
-          IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-            CALL pmc_set_dataarray_name( 'parent', 'qc', 'child', 'qc', ierr )
-            CALL pmc_set_dataarray_name( 'parent', 'nc', 'child', 'nc', ierr )
-          ENDIF
-
-          IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-             CALL pmc_set_dataarray_name( 'parent', 'qr', 'child', 'qr', ierr )
-             CALL pmc_set_dataarray_name( 'parent', 'nr', 'child', 'nr', ierr )
-          ENDIF
-
-       ENDIF
-
-       IF ( passive_scalar )  THEN
-          CALL pmc_set_dataarray_name( 'parent', 's', 'child', 's', ierr )
-       ENDIF
-
-       IF ( particle_advection )  THEN
-          CALL pmc_set_dataarray_name( 'parent', 'nr_part', 'child', 'nr_part', ierr )
-          CALL pmc_set_dataarray_name( 'parent', 'part_adr', 'child', 'part_adr', ierr )
-       ENDIF
-
-       IF ( air_chemistry  .AND.  nesting_chem )  THEN
-          DO n = 1, nspec
-             CALL pmc_set_dataarray_name( 'parent', 'chem_' // TRIM( chem_species(n)%name ),       &
-                                          'child',  'chem_' // TRIM( chem_species(n)%name ), ierr )
-          ENDDO
-       ENDIF
-
-       IF ( salsa  .AND.  nesting_salsa )  THEN
-          DO  lb = 1, nbins_aerosol
-             WRITE( salsa_char,'(i0)' ) lb
-             CALL pmc_set_dataarray_name( 'parent', 'an_' // TRIM( salsa_char ),                   &
-                                          'child',  'an_' // TRIM( salsa_char ), ierr )
-          ENDDO
-          DO  lc = 1, nbins_aerosol * ncomponents_mass
-             WRITE( salsa_char,'(i0)' ) lc
-             CALL pmc_set_dataarray_name( 'parent', 'am_' // TRIM( salsa_char ),                   &
-                                          'child',  'am_' // TRIM( salsa_char ), ierr )
-          ENDDO
-          IF ( .NOT. salsa_gases_from_chem )  THEN
-             DO  lg = 1, ngases_salsa
-                WRITE( salsa_char,'(i0)' ) lg
-                CALL pmc_set_dataarray_name( 'parent', 'sg_' // TRIM( salsa_char ),                &
-                                             'child',  'sg_' // TRIM( salsa_char ), ierr )
-             ENDDO
-          ENDIF
-       ENDIF
-
-       CALL pmc_set_dataarray_name( lastentry = .TRUE. )
-!
-!--    Send grid to parent
-       child_grid_dim(1)  = nx
-       child_grid_dim(2)  = ny
-       child_grid_dim(3)  = nz
-       child_grid_info(1) = zw(nzt+1)
-       child_grid_info(2) = zw(nzt)
-       child_grid_info(3) = dx
-       child_grid_info(4) = dy
-       child_grid_info(5) = dz(1)
-
-       IF ( myid == 0 )  THEN
-
-          CALL pmc_send_to_parent( child_grid_dim, SIZE( child_grid_dim ), 0, 123, ierr )
-          CALL pmc_send_to_parent( child_grid_info, SIZE( child_grid_info ), 0, 124, ierr )
-          CALL pmc_send_to_parent( coord_x, nx + 1 + 2 * nbgp, 0, 11, ierr )
-          CALL pmc_send_to_parent( coord_y, ny + 1 + 2 * nbgp, 0, 12, ierr )
-
-          CALL pmc_recv_from_parent( rans_mode_parent, 1, 0, 19, ierr )
-!
-!--       Receive parent-grid information.
-          CALL pmc_recv_from_parent( parent_grid_info_real, SIZE( parent_grid_info_real ), 0, 21,  &
-                                     ierr )
-          CALL pmc_recv_from_parent( parent_grid_info_int,  3, 0, 22, ierr )
-
-       ENDIF
-
-       CALL MPI_BCAST( parent_grid_info_real, SIZE( parent_grid_info_real ), MPI_REAL, 0, comm2d,  &
-                       ierr )
-       CALL MPI_BCAST( parent_grid_info_int, 3, MPI_INTEGER, 0, comm2d, ierr )
-
-       pg%dx = parent_grid_info_real(3)
-       pg%dy = parent_grid_info_real(4)
-       pg%dz = parent_grid_info_real(7)
-       pg%nx = parent_grid_info_int(1)
-       pg%ny = parent_grid_info_int(2)
-       pg%nz = parent_grid_info_int(3)
-!
-!--    Allocate 1-D arrays for parent-grid coordinates and grid-spacings in the z-direction
-       ALLOCATE( pg%coord_x(-nbgp:pg%nx+nbgp) )
-       ALLOCATE( pg%coord_y(-nbgp:pg%ny+nbgp) )
-       ALLOCATE( pg%dzu(1:pg%nz+1) )
-       ALLOCATE( pg%dzw(1:pg%nz+1) )
-       ALLOCATE( pg%zu(0:pg%nz+1) )
-       ALLOCATE( pg%zw(0:pg%nz+1) )
-!
-!--    Get parent-grid coordinates and grid-spacings in the z-direction from the parent
-       IF ( myid == 0)  THEN
-          CALL pmc_recv_from_parent( pg%coord_x, pg%nx+1+2*nbgp, 0, 24, ierr )
-          CALL pmc_recv_from_parent( pg%coord_y, pg%ny+1+2*nbgp, 0, 25, ierr )
-          CALL pmc_recv_from_parent( pg%dzu, pg%nz+1, 0, 26, ierr )
-          CALL pmc_recv_from_parent( pg%dzw, pg%nz+1, 0, 27, ierr )
-          CALL pmc_recv_from_parent( pg%zu, pg%nz+2, 0, 28, ierr )
-          CALL pmc_recv_from_parent( pg%zw, pg%nz+2, 0, 29, ierr )
-       ENDIF
-!
-!--    Broadcast this information
-       CALL MPI_BCAST( pg%coord_x, pg%nx+1+2*nbgp, MPI_REAL, 0, comm2d, ierr )
-       CALL MPI_BCAST( pg%coord_y, pg%ny+1+2*nbgp, MPI_REAL, 0, comm2d, ierr )
-       CALL MPI_BCAST( pg%dzu, pg%nz+1, MPI_REAL, 0, comm2d, ierr )
-       CALL MPI_BCAST( pg%dzw, pg%nz+1, MPI_REAL, 0, comm2d, ierr )
-       CALL MPI_BCAST( pg%zu, pg%nz+2,  MPI_REAL, 0, comm2d, ierr )
-       CALL MPI_BCAST( pg%zw, pg%nz+2,  MPI_REAL, 0, comm2d, ierr )
-       CALL MPI_BCAST( rans_mode_parent, 1, MPI_LOGICAL, 0, comm2d, ierr )
-!
-!--    Find the index bounds for the nest domain in the parent-grid index space
-       CALL pmci_map_child_grid_to_parent_grid
-!
-!--    TO_DO: Klaus give a comment what is happening here
-       CALL pmc_c_get_2d_index_list
-!
-!--    Include couple arrays into child content
-!--    TO_DO: Klaus: better explain the above comment (what is child content?)
-       CALL  pmc_c_clear_next_array_list
-
-       n  = 1
-       lb = 1
-       lc = 1
-       lg = 1
-
-       DO  WHILE ( pmc_c_getnextarray( myname ) )
-!
-!--       Note that pg%nz is not the original nz of parent, but the highest parent-grid level needed
-!--       for nesting. Note that in case of chemical species or SALSA variables an additional
-!--       parameter needs to be passed. The parameter is required to set the pointer correctly to
-!--       the chemical-species or SALSA data structure. Hence, first check if the current variable
-!--       is a chemical species or a SALSA variable. If so, pass index id of respective sub-variable
-!--       (species or bin) and increment this subsequently.
-          IF ( INDEX( TRIM( myname ), 'chem_' ) /= 0 )  THEN
-             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz, n )
-             n = n + 1
-          ELSEIF ( INDEX( TRIM( myname ), 'an_' ) /= 0 )  THEN
-             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz, lb )
-             lb = lb + 1
-          ELSEIF ( INDEX( TRIM( myname ), 'am_' ) /= 0 )  THEN
-             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz, lc )
-             lc = lc + 1
-          ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0  .AND.  .NOT.  salsa_gases_from_chem )  THEN
-             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz, lg )
-             lg = lg + 1
-          ELSE
-             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz )
-          ENDIF
-       ENDDO
-       CALL pmc_c_setind_and_allocmem
-!
-!--    Precompute the index-mapping arrays
-       CALL pmci_define_index_mapping
-!
-!--    Check that the child and parent grid lines do match
-       CALL pmci_check_grid_matching
-!
-!--    Compute surface areas of the nest-boundary faces
-       CALL pmci_compute_face_areas
-!       
-!--    Compute anterpolation lower kp-index bounds if necessary
-       CALL pmci_compute_kpb_anterp 
-    ENDIF
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Determine index bounds of interpolation/anterpolation area in the parent-grid index space.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_map_child_grid_to_parent_grid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ip     !< Running parent-grid index in the x-direction
-    INTEGER(iwp) ::  iauxl  !< Offset between the index bound ipl and the auxiliary index bound ipla
-    INTEGER(iwp) ::  iauxr  !< Offset between the index bound ipr and the auxiliary index bound ipra
-    INTEGER(iwp) ::  ijaux  !< Temporary variable for receiving the index bound from the neighbouring subdomain
-    INTEGER(iwp) ::  jp     !< Running parent-grid index in the y-direction
-    INTEGER(iwp) ::  jauxs  !< Offset between the index bound jps and the auxiliary index bound jpsa
-    INTEGER(iwp) ::  jauxn  !< Offset between the index bound jpn and the auxiliary index bound jpna
-
-    INTEGER(iwp), DIMENSION(4) ::  parent_bound_global  !< Transfer array for global parent-grid index bounds
-    INTEGER(iwp), DIMENSION(2) ::  size_of_array        !< For sending the dimensions of parent_bound_all to parent
-
-    INTEGER(iwp), DIMENSION(5,numprocs) ::  parent_bound_all  !< Transfer array for parent-grid index bounds
-
-    REAL(wp) ::  tolex  !< Tolerance for grid-line matching in x-direction
-    REAL(wp) ::  toley  !< Tolerance for grid-line matching in y-direction
-    REAL(wp) ::  xexl   !< Parent-grid array exceedance behind the left edge of the child PE subdomain
-    REAL(wp) ::  xexr   !< Parent-grid array exceedance behind the right edge of the child PE subdomain
-    REAL(wp) ::  xpl    !< Requested left-edge x-coordinate of the parent-grid array domain (at the internal boundaries
-                        !< the real edge may differ from this in some cases as explained in the comment block below)
-    REAL(wp) ::  xpr    !< Requested right-edge x-coordinate of the parent-grid array domain (at the internal boundaries
-                        !< the real edge may differ from this in some cases as explained in the comment block below)
-    REAL(wp) ::  yexs   !< Parent-grid array exceedance behind the south edge of the child PE subdomain
-    REAL(wp) ::  yexn   !< Parent-grid array exceedance behind the north edge of the child PE subdomain
-    REAL(wp) ::  yps    !< Requested south-edge y-coordinate of the parent-grid array domain (at the internal boundaries
-                        !< the real edge may differ from this in some cases as explained in the comment block below)
-    REAL(wp) ::  ypn    !< Requested south-edge y-coordinate of the parent-grid array domain (at the internal boundaries
-                        !< the real edge may differ from this in some cases as explained in the comment block below)
-
-!
-!-- Determine the index limits for the child's parent-grid arrays (such as uc for example).
-!-- Note that at the outer edges of the child domain (nest boundaries) these arrays exceed the
-!-- boundary by two parent-grid cells. At the internal boundaries, there are no exceedances and
-!-- thus no overlaps with the neighbouring subdomain. If at least half of the parent-grid cell is
-!-- within the current child sub-domain, then it is included in the current sub-domain's
-!-- parent-grid array. Else the parent-grid cell is included in the neighbouring subdomain's
-!-- parent-grid array, or not included at all if we are at the outer edge of the child domain.
-!-- This may occur especially when a large grid-spacing ratio is used.
-!
-!-- Tolerances for grid-line matching.
-    tolex = tolefac * dx
-    toley = tolefac * dy
-!
-!-- Left boundary.
-!-- Extension by two parent-grid cells behind the boundary, see the comment block above.
-    IF ( bc_dirichlet_l )  THEN
-       xexl  = 2.0_wp * pg%dx
-       iauxl = 0
-    ELSE
-       xexl  = 0.0_wp
-       iauxl = 1
-    ENDIF
-    xpl     = coord_x(nxl) - xexl
-    DO  ip = 0, pg%nx
-       IF ( pg%coord_x(ip) + 0.5_wp * pg%dx >= xpl - tolex )  THEN
-          ipl = MAX( 0, ip )
-          EXIT
-       ENDIF
-    ENDDO
-!
-!-- Right boundary.
-!-- Extension by two parent-grid cells behind the boundary, see the comment block above.
-    IF ( bc_dirichlet_r )  THEN
-       xexr  = 2.0_wp * pg%dx
-       iauxr = 0
-    ELSE
-       xexr  = 0.0_wp
-       iauxr = 1
-    ENDIF
-    xpr  = coord_x(nxr+1) + xexr
-    DO  ip = pg%nx, 0 , -1
-       IF ( pg%coord_x(ip) + 0.5_wp * pg%dx <= xpr + tolex )  THEN
-          ipr = MIN( pg%nx, MAX( ipl, ip ) )
-          EXIT
-       ENDIF
-    ENDDO
-!
-!-- South boundary.
-!-- Extension by two parent-grid cells behind the boundary, see the comment block above.
-    IF ( bc_dirichlet_s )  THEN
-       yexs  = 2.0_wp * pg%dy
-       jauxs = 0
-    ELSE
-       yexs  = 0.0_wp
-       jauxs = 1
-    ENDIF
-    yps  = coord_y(nys) - yexs
-    DO  jp = 0, pg%ny
-       IF ( pg%coord_y(jp) + 0.5_wp * pg%dy >= yps - toley )  THEN
-          jps = MAX( 0, jp )
-          EXIT
-       ENDIF
-    ENDDO
-!
-!-- North boundary.
-!-- Extension by two parent-grid cells behind the boundary, see the comment block above.
-    IF  ( bc_dirichlet_n )  THEN
-       yexn  = 2.0_wp * pg%dy
-       jauxn = 0
-    ELSE
-       yexn  = 0.0_wp
-       jauxn = 1
-    ENDIF
-    ypn  = coord_y(nyn+1) + yexn
-    DO  jp = pg%ny, 0 , -1
-       IF ( pg%coord_y(jp) + 0.5_wp * pg%dy <= ypn + toley )  THEN
-          jpn = MIN( pg%ny, MAX( jps, jp ) )
-          EXIT
-       ENDIF
-    ENDDO
-!
-!-- Make sure that the indexing is contiguous (no gaps, no overlaps). This is a safety measure
-!-- mainly for cases with high grid-spacing ratio and narrow child subdomains.
-    IF ( pdims(1) > 1 )  THEN
-       IF ( nxl == 0 )  THEN
-          CALL MPI_SEND( ipr, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
-       ELSE IF ( nxr == nx )  THEN
-          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, pleft, 717, comm2d, status, ierr )
-          ipl = ijaux + 1
-       ELSE
-          CALL MPI_SEND( ipr, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
-          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, pleft, 717, comm2d, status, ierr )
-          ipl = ijaux + 1
-       ENDIF
-    ENDIF
-
-    IF ( pdims(2) > 1 )  THEN
-       IF ( nys == 0 )  THEN
-          CALL MPI_SEND( jpn, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
-       ELSE IF ( nyn == ny )  THEN
-          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, psouth, 719, comm2d, status, ierr )
-          jps = ijaux + 1
-       ELSE
-          CALL MPI_SEND( jpn, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
-          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, psouth, 719, comm2d, status, ierr )
-          jps = ijaux + 1
-       ENDIF
-    ENDIF
-
-    WRITE( 9,"('pmci_map_child_grid_to_parent_grid. Parent-grid array bounds: ',4(i4,2x))" )       &
-           ipl, ipr, jps, jpn
-    FLUSH(9)
-
-    parent_bound(1) = ipl
-    parent_bound(2) = ipr
-    parent_bound(3) = jps
-    parent_bound(4) = jpn
-    parent_bound(5) = myid
-!
-!-- The following auxiliary index bounds are used for allocating index mapping and some other
-!-- auxiliary arrays.
-    ipla = ipl - iauxl
-    ipra = ipr + iauxr
-    jpsa = jps - jauxs
-    jpna = jpn + jauxn
-!
-!-- The index-bounds parent_bound of all subdomains of the current child domain must be sent to the
-!-- parent in order for the parent to create the index list. For this reason, the parent_bound
-!-- arrays are packed together in single array parent_bound_all using MPI_GATHER. Note that
-!-- MPI_Gather receives data from all processes in the rank order This fact is exploited in creating
-!-- the index list in pmci_create_index_list.
-    CALL MPI_GATHER( parent_bound, 5, MPI_INTEGER, parent_bound_all, 5, MPI_INTEGER, 0, comm2d,    &
-                     ierr )
-
-    IF ( myid == 0 )  THEN
-       size_of_array(1) = SIZE( parent_bound_all, 1 )
-       size_of_array(2) = SIZE( parent_bound_all, 2 )
-       CALL pmc_send_to_parent( size_of_array, 2, 0, 40, ierr )
-       CALL pmc_send_to_parent( parent_bound_all, SIZE( parent_bound_all ), 0, 41, ierr )
-!
-!--    Determine the global parent-grid index bounds
-       parent_bound_global(1) = MINVAL( parent_bound_all(1,:) )
-       parent_bound_global(2) = MAXVAL( parent_bound_all(2,:) )
-       parent_bound_global(3) = MINVAL( parent_bound_all(3,:) )
-       parent_bound_global(4) = MAXVAL( parent_bound_all(4,:) )
-    ENDIF
-!
-!-- Broadcast the global parent-grid index bounds to all current child processes
-    CALL MPI_BCAST( parent_bound_global, 4, MPI_INTEGER, 0, comm2d, ierr )
-    iplg = parent_bound_global(1)
-    iprg = parent_bound_global(2)
-    jpsg = parent_bound_global(3)
-    jpng = parent_bound_global(4)
-    WRITE( 9, "('pmci_map_child_grid_to_parent_grid. Global parent-grid index bounds iplg, iprg, jpsg, jpng: ',4(i4,2x))" ) &
-                iplg, iprg, jpsg, jpng
-    FLUSH( 9 )
-
- END SUBROUTINE pmci_map_child_grid_to_parent_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Precomputation of the mapping between the child- and parent-grid indices.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_define_index_mapping
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !< child-grid index in the x-direction
-    INTEGER(iwp) ::  ii      !< parent-grid index in the x-direction
-    INTEGER(iwp) ::  istart  !< starting index for the index-mapping search loop in the x-direction 
-    INTEGER(iwp) ::  ir      !< search-loop running index in the x-direction
-    INTEGER(iwp) ::  iw      !< child-grid index limited to -1 <= iw <= nx+1 for wall_flags_total_0
-    INTEGER(iwp) ::  j       !< child-grid index in the y-direction
-    INTEGER(iwp) ::  jj      !< parent-grid index in the y-direction
-    INTEGER(iwp) ::  jstart  !< starting index for the index-mapping search loop in the y-direction
-    INTEGER(iwp) ::  jr      !< search-loop running index in the y-direction
-    INTEGER(iwp) ::  jw      !< child-grid index limited to -1 <= jw <= ny+1 for wall_flags_total_0
-    INTEGER(iwp) ::  k       !< child-grid index in the z-direction
-    INTEGER(iwp) ::  kk      !< parent-grid index in the z-direction
-    INTEGER(iwp) ::  kstart  !< starting index for the index-mapping search loop in the z-direction
-    INTEGER(iwp) ::  kw      !< child-grid index limited to kw <= nzt+1 for wall_flags_total_0
-
-    REAL(wp) ::  tolex  !< tolerance for grid-line matching in x-direction
-    REAL(wp) ::  toley  !< tolerance for grid-line matching in y-direction
-    REAL(wp) ::  tolez  !< tolerance for grid-line matching in z-direction
-
-!
-!-- Grid-line tolerances.
-    tolex = tolefac * dx
-    toley = tolefac * dy
-    tolez = tolefac * dz(1)
-!
-!-- Allocate child-grid work arrays for interpolation.
-    igsr = NINT( pg%dx / dx, iwp )
-    jgsr = NINT( pg%dy / dy, iwp )
-    kgsr = NINT( pg%dzw(1) / dzw(1), iwp )
-    WRITE(9,"('igsr, jgsr, kgsr: ',3(i3,2x))") igsr, jgsr, kgsr
-    FLUSH(9)
-!
-!-- Determine index bounds for the parent-grid work arrays for interpolation and allocate them.
-    CALL pmci_allocate_workarrays
-!
-!-- Define the MPI-datatypes for parent-grid work array exchange between the PE-subdomains.
-    CALL pmci_create_workarray_exchange_datatypes
-!
-!-- First determine kcto and kctw which refer to the uppermost parent-grid levels below the child
-!-- top-boundary level. Note that these comparison tests are not round-off-error sensitive and
-!-- therefore tolerance buffering is not needed here.
-    kk = 0
-    DO WHILE ( pg%zu(kk) <= zu(nzt) )
-       kk = kk + 1
-    ENDDO
-    kcto = kk - 1
-
-    kk = 0
-    DO WHILE ( pg%zw(kk) <= zw(nzt-1) )
-       kk = kk + 1
-    ENDDO
-    kctw = kk - 1
-
-    WRITE( 9, "('kcto, kctw = ', 2(i3,2x))" ) kcto, kctw
-    FLUSH( 9 )
-!
-!-- In case of two-way coupling, check that the child domain is sufficiently large in terms of the
-!-- number of parent-grid cells covered. Otherwise anterpolation is not possible.
-    IF ( nesting_mode == 'two-way')  THEN
-       CALL pmci_check_child_domain_size
-    ENDIF
-
-    ALLOCATE( iflu(ipla:ipra) )
-    ALLOCATE( iflo(ipla:ipra) )
-    ALLOCATE( ifuu(ipla:ipra) )
-    ALLOCATE( ifuo(ipla:ipra) )
-    ALLOCATE( jflv(jpsa:jpna) )
-    ALLOCATE( jflo(jpsa:jpna) )
-    ALLOCATE( jfuv(jpsa:jpna) )
-    ALLOCATE( jfuo(jpsa:jpna) )
-    ALLOCATE( kflw(0:pg%nz+1) )
-    ALLOCATE( kflo(0:pg%nz+1) )
-    ALLOCATE( kfuw(0:pg%nz+1) )
-    ALLOCATE( kfuo(0:pg%nz+1) )
-    ALLOCATE( ijkfc_u(0:pg%nz+1,jpsa:jpna,ipla:ipra) )
-    ALLOCATE( ijkfc_v(0:pg%nz+1,jpsa:jpna,ipla:ipra) )
-    ALLOCATE( ijkfc_w(0:pg%nz+1,jpsa:jpna,ipla:ipra) )
-    ALLOCATE( ijkfc_s(0:pg%nz+1,jpsa:jpna,ipla:ipra) )
-
-    ijkfc_u = 0
-    ijkfc_v = 0
-    ijkfc_w = 0
-    ijkfc_s = 0
-!
-!-- i-indices of u for each ii-index value
-    istart = nxlg
-    DO  ii = ipla, ipra
-!
-!--    The parent and child grid lines do always match in x, hence we use only the local
-!--    k,j-child-grid plane for the anterpolation. However, iflu still has to be stored separately
-!--    as these index bounds are passed as arguments to the interpolation and anterpolation
-!--    subroutines. Note that this comparison test is round-off-error sensitive and therefore
-!--    tolerance buffering is needed here.
-       i = istart
-       DO WHILE ( pg%coord_x(ii) - coord_x(i) > tolex  .AND. i < nxrg )
-          i = i + 1
-       ENDDO
-       iflu(ii) = MIN( MAX( i, nxlg ), nxrg )
-       ifuu(ii) = iflu(ii)
-       istart   = iflu(ii)
-!
-!--    Print out the index bounds for checking and debugging purposes
-       WRITE( 9, "('pmci_define_index_mapping, ii, iflu, ifuu: ', 3(i4,2x))" ) ii, iflu(ii),       &
-                                                                               ifuu(ii)
-       FLUSH( 9 )
-    ENDDO
-    WRITE( 9, * )
-!
-!-- i-indices of others for each ii-index value. Note that these comparison tests are not
-!-- round-off-error sensitive and therefore tolerance buffering is not needed here.
-    istart = nxlg
-    DO  ii = ipla, ipra
-       i = istart
-       DO WHILE ( ( coord_x(i) + 0.5_wp * dx < pg%coord_x(ii) )  .AND.  ( i < nxrg ) )
-          i  = i + 1
-       ENDDO
-       iflo(ii) = MIN( MAX( i, nxlg ), nxrg )
-       ir = i
-       DO WHILE ( ( coord_x(ir) + 0.5_wp * dx < pg%coord_x(ii) + pg%dx )  .AND.  ( i < nxrg+1 ) )
-          i  = i + 1
-          ir = MIN( i, nxrg )
-       ENDDO
-       ifuo(ii) = MIN( MAX( i-1, iflo(ii) ), nxrg )
-       istart = iflo(ii)
-!
-!--    Print out the index bounds for checking and debugging purposes
-       WRITE( 9, "('pmci_define_index_mapping, ii, iflo, ifuo: ', 3(i4,2x))" ) ii, iflo(ii),       &
-                                                                               ifuo(ii)
-       FLUSH( 9 )
-    ENDDO
-    WRITE( 9, * )
-!
-!-- j-indices of v for each jj-index value
-    jstart = nysg
-    DO  jj = jpsa, jpna
-!
-!--    The parent and child grid lines do always match in y, hence we use only the local
-!--    k,i-child-grid plane for the anterpolation. However, jcnv still has to be stored separately
-!--    as these index bounds are passed as arguments to the interpolation and anterpolation
-!--    subroutines. Note that this comparison test is round-off-error sensitive and therefore
-!--    tolerance buffering is needed here.
-       j = jstart
-       DO WHILE ( pg%coord_y(jj) - coord_y(j) > toley  .AND.  j < nyng )
-          j = j + 1
-       ENDDO
-       jflv(jj) = MIN( MAX( j, nysg ), nyng )
-       jfuv(jj) = jflv(jj)
-       jstart   = jflv(jj)
-!
-!--    Print out the index bounds for checking and debugging purposes
-       WRITE( 9, "('pmci_define_index_mapping, jj, jflv, jfuv: ', 3(i4,2x))" ) jj, jflv(jj),       &
-                                                                               jfuv(jj)
-       FLUSH(9)
-    ENDDO
-    WRITE( 9, * )
-!
-!-- j-indices of others for each jj-index value
-!-- Note that these comparison tests are not round-off-error sensitive and therefore tolerance
-!-- buffering is not needed here.
-    jstart = nysg
-    DO  jj = jpsa, jpna
-       j = jstart
-       DO WHILE ( ( coord_y(j) + 0.5_wp * dy < pg%coord_y(jj) ) .AND. ( j < nyng ) )
-          j  = j + 1
-       ENDDO
-       jflo(jj) = MIN( MAX( j, nysg ), nyng )
-       jr = j
-       DO WHILE ( ( coord_y(jr) + 0.5_wp * dy < pg%coord_y(jj) + pg%dy ) .AND. ( j < nyng+1 ) )
-          j  = j + 1
-          jr = MIN( j, nyng )
-       ENDDO
-       jfuo(jj) = MIN( MAX( j-1, jflo(jj) ), nyng )
-       jstart = jflo(jj)
-!
-!--    Print out the index bounds for checking and debugging purposes
-       WRITE( 9, "('pmci_define_index_mapping, jj, jflo, jfuo: ', 3(i4,2x))" ) jj, jflo(jj),       &
-                                                                               jfuo(jj)
-       FLUSH( 9 )
-    ENDDO
-    WRITE( 9, * )
-!
-!-- k-indices of w for each kk-index value
-!-- Note that anterpolation index limits are needed also for the top boundary ghost cell level
-!-- because they are used also in the interpolation.
-    kstart  = 0
-    kflw(0) = 0
-    kfuw(0) = 0
-    DO  kk = 1, pg%nz+1
-!
-!--    The parent and child grid lines do always match in z, hence we use only the local
-!--    j,i-child-grid plane for the anterpolation. However, kctw still has to be stored separately
-!--    as these index bounds are passed as arguments to the interpolation and anterpolation
-!--    subroutines. Note that this comparison test is round-off-error sensitive and therefore
-!--    tolerance buffering is needed here.
-       k = kstart
-       DO WHILE ( ( pg%zw(kk) - zw(k) > tolez )  .AND.  ( k < nzt+1 ) )
-          k = k + 1
-       ENDDO
-       kflw(kk) = MIN( MAX( k, 1 ), nzt + 1 )
-       kfuw(kk) = kflw(kk)
-       kstart   = kflw(kk)
-!
-!--    Print out the index bounds for checking and debugging purposes
-       WRITE( 9, "('pmci_define_index_mapping, kk, kflw, kfuw: ', 4(i4,2x), 2(e12.5,2x))" )        &
-              kk, kflw(kk), kfuw(kk), nzt,  pg%zu(kk), pg%zw(kk)
-       FLUSH( 9 )
-    ENDDO
-    WRITE( 9, * )
-!
-!-- k-indices of others for each kk-index value
-    kstart  = 0
-    kflo(0) = 0
-    kfuo(0) = 0
-!
-!-- Note that anterpolation index limits are needed also for the top boundary ghost cell level
-!-- because they are used also in the interpolation. Note that these comparison tests are not
-!-- round-off-error sensitive and therefore tolerance buffering is not needed here.
-    DO  kk = 1, pg%nz+1
-       k = kstart
-       DO WHILE ( ( zu(k) < pg%zw(kk-1) )  .AND.  ( k <= nzt ) )
-          k = k + 1
-       ENDDO
-       kflo(kk) = MIN( MAX( k, 1 ), nzt + 1 )
-       DO WHILE ( ( zu(k) < pg%zw(kk) )  .AND.  ( k <= nzt+1 ) )
-          k = k + 1
-          IF ( k > nzt + 1 ) EXIT  ! This EXIT is to prevent zu(k) from flowing over.
-       ENDDO
-       kfuo(kk) = MIN( MAX( k-1, kflo(kk) ), nzt + 1 )
-       kstart = kflo(kk)
-    ENDDO
-!
-!-- Print out the index bounds for checking and debugging purposes
-    DO  kk = 1, pg%nz+1
-       WRITE( 9, "('pmci_define_index_mapping, kk, kflo, kfuo: ', 4(i4,2x), 2(e12.5,2x))" )        &
-              kk, kflo(kk), kfuo(kk), nzt,  pg%zu(kk), pg%zw(kk)
-       FLUSH( 9 )
-    ENDDO
-    WRITE( 9, * )
-!
-!-- Precomputation of number of child-grid nodes inside parent-grid cells. Note that ii, jj, and kk
-!-- are parent-grid indices. This information is needed in the anterpolation. The indices for
-!-- wall_flags_total_0 (kw,jw,iw) must be limited to the range [-1,...,nx/ny/nzt+1] in order to
-!-- avoid zero values on the outer ghost nodes.
-    DO  ii = ipla, ipra
-       DO  jj = jpsa, jpna
-          DO  kk = 0, pg%nz+1
-!
-!--          u-component
-             DO  i = iflu(ii), ifuu(ii)
-                iw = MAX( MIN( i, nx+1 ), -1 )
-                DO  j = jflo(jj), jfuo(jj)
-                   jw = MAX( MIN( j, ny+1 ), -1 )
-                   DO  k = kflo(kk), kfuo(kk)
-                      kw = MIN( k, nzt+1 )
-                      ijkfc_u(kk,jj,ii) = ijkfc_u(kk,jj,ii)                                        &
-                                          + MERGE( 1, 0, BTEST( wall_flags_total_0(kw,jw,iw), 1 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--          v-component
-             DO  i = iflo(ii), ifuo(ii)
-                iw = MAX( MIN( i, nx+1 ), -1 )
-                DO  j = jflv(jj), jfuv(jj)
-                   jw = MAX( MIN( j, ny+1 ), -1 )
-                   DO  k = kflo(kk), kfuo(kk)
-                      kw = MIN( k, nzt+1 )
-                      ijkfc_v(kk,jj,ii) = ijkfc_v(kk,jj,ii)                                        &
-                                          + MERGE( 1, 0, BTEST( wall_flags_total_0(kw,jw,iw), 2 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--          Scalars
-             DO  i = iflo(ii), ifuo(ii)
-                iw = MAX( MIN( i, nx+1 ), -1 )
-                DO  j = jflo(jj), jfuo(jj)
-                   jw = MAX( MIN( j, ny+1 ), -1 )
-                   DO  k = kflo(kk), kfuo(kk)
-                      kw = MIN( k, nzt+1 )
-                      ijkfc_s(kk,jj,ii) = ijkfc_s(kk,jj,ii)                                        &
-                                          + MERGE( 1, 0, BTEST( wall_flags_total_0(kw,jw,iw), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--          w-component
-             DO  i = iflo(ii), ifuo(ii)
-                iw = MAX( MIN( i, nx+1 ), -1 )
-                DO  j = jflo(jj), jfuo(jj)
-                   jw = MAX( MIN( j, ny+1 ), -1 )
-                   DO  k = kflw(kk), kfuw(kk)
-                      kw = MIN( k, nzt+1 )
-                      ijkfc_w(kk,jj,ii) = ijkfc_w(kk,jj,ii)                                        &
-                                          + MERGE( 1, 0, BTEST( wall_flags_total_0(kw,jw,iw), 3 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-          ENDDO  ! kk
-       ENDDO  ! jj
-    ENDDO  ! ii
-
- END SUBROUTINE pmci_define_index_mapping
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check if the child domain is too small in terms of number of parent-grid cells covered so that
-!> anterpolation buffers fill the whole domain so that anterpolation not possible. Also, check that
-!> anterpolation_buffer_width is not too large to prevent anterpolation.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_check_child_domain_size
-
-    IMPLICIT NONE
-
-!
-!-- First x-direction
-    IF ( iplg + 3 + anterpolation_buffer_width > iprg - 3 - anterpolation_buffer_width )  THEN
-       IF ( iprg - iplg + 1 < 7 )  THEN
-!
-!--       Error
-          WRITE( message_string, * ) 'child domain too narrow for anterpolation in x-direction'
-          CALL message( 'pmci_check_child_domain_size', 'PA0652', 3, 2, 0, 6, 0 )
-       ELSE IF ( iprg - iplg + 1 < 11 )  THEN
-!
-!--       Warning
-          WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0'
-          CALL message( 'pmci_check_child_domain_size', 'PA0653', 0, 1, 0, 6, 0 )
-          anterpolation_buffer_width = 0
-       ELSE
-!
-!--       Informative message
-          WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to ' //     &
-                                     'default value 2'
-          CALL message( 'pmci_check_child_domain_size', 'PA0654', 0, 0, 0, 6, 0 )
-          anterpolation_buffer_width = 2
-       ENDIF
-    ENDIF
-!
-!-- Then y-direction
-    IF ( jpsg + 3 + anterpolation_buffer_width > jpng - 3 - anterpolation_buffer_width )  THEN
-       IF ( jpng - jpsg + 1 < 7 )  THEN
-!
-!--       Error
-          WRITE( message_string, * ) 'child domain too narrow for anterpolation in y-direction'
-          CALL message( 'pmci_check_child_domain_size', 'PA0652', 3, 2, 0, 6, 0 )
-       ELSE IF ( jpng - jpsg + 1 < 11 )  THEN
-!
-!--       Warning
-          WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0'
-          CALL message( 'pmci_check_child_domain_size', 'PA0653', 0, 1, 0, 6, 0 )
-          anterpolation_buffer_width = 0
-       ELSE
-!
-!--       Informative message
-          WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to ' //     &
-                                     'default value 2'
-          CALL message( 'pmci_check_child_domain_size', 'PA0654', 0, 0, 0, 6, 0 )
-          anterpolation_buffer_width = 2
-       ENDIF
-    ENDIF
-!
-!-- Finally z-direction
-    IF ( kctw - 1 - anterpolation_buffer_width < 1 )  THEN
-       IF ( kctw - 1 < 1 )  THEN
-!
-!--       Error
-          WRITE( message_string, * ) 'child domain too shallow for anterpolation in z-direction'
-          CALL message( 'pmci_check_child_domain_size', 'PA0652', 3, 2, 0, 6, 0 )
-       ELSE IF ( kctw - 3 < 1 )  THEN
-!
-!--       Warning
-          WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0'
-          CALL message( 'pmci_check_child_domain_size', 'PA0653', 0, 1, 0, 6, 0 )
-          anterpolation_buffer_width = 0
-       ELSE
-!
-!--       Informative message
-          WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to ' //     &
-                                     'default value 2'
-          CALL message( 'pmci_check_child_domain_size', 'PA0654', 0, 0, 0, 6, 0 )
-          anterpolation_buffer_width = 2
-       ENDIF
-    ENDIF
-
- END SUBROUTINE pmci_check_child_domain_size
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate parent-grid work-arrays for interpolation.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_allocate_workarrays
- 
-    IMPLICIT NONE
-
-!
-!-- Determine and store the PE-subdomain dependent index bounds
-    IF ( bc_dirichlet_l )  THEN
-       iplw = ipl + 1
-    ELSE
-       iplw = ipl - 1
-    ENDIF
-
-    IF ( bc_dirichlet_r )  THEN
-       iprw = ipr - 1
-    ELSE
-       iprw = ipr + 1
-    ENDIF
-
-    IF ( bc_dirichlet_s )  THEN
-       jpsw = jps + 1
-    ELSE
-       jpsw = jps - 1
-    ENDIF
-
-    IF ( bc_dirichlet_n )  THEN
-       jpnw = jpn - 1
-    ELSE
-       jpnw = jpn + 1
-    ENDIF
-!
-!-- Left and right boundaries.
-    ALLOCATE( workarr_lr(0:pg%nz+1,jpsw:jpnw,0:2) )
-!
-!-- South and north boundaries.
-    ALLOCATE( workarr_sn(0:pg%nz+1,0:2,iplw:iprw) )
-!
-!-- Top boundary.
-    ALLOCATE( workarr_t(0:2,jpsw:jpnw,iplw:iprw) )
-
- END SUBROUTINE pmci_allocate_workarrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define and create specific MPI-datatypes for the interpolation work-array exchange. 
-!> Exhcanges are needed to make these arrays contiguous over the horizontal direction on the
-!> plane of the boundary. 
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_create_workarray_exchange_datatypes
-
-    IMPLICIT NONE
-
-!
-!-- For the left and right boundaries
-    CALL MPI_TYPE_VECTOR( 3, pg%nz+2, (jpnw-jpsw+1)*(pg%nz+2), MPI_REAL, workarr_lr_exchange_type, &
-                          ierr )
-    CALL MPI_TYPE_COMMIT( workarr_lr_exchange_type, ierr )
-!
-!-- For the south and north boundaries
-    CALL MPI_TYPE_VECTOR( 1, 3*(pg%nz+2), 3*(pg%nz+2), MPI_REAL, workarr_sn_exchange_type, ierr )
-    CALL MPI_TYPE_COMMIT( workarr_sn_exchange_type, ierr )
-!
-!-- For the top-boundary x-slices
-    CALL MPI_TYPE_VECTOR( iprw-iplw+1, 3, 3*(jpnw-jpsw+1), MPI_REAL, workarr_t_exchange_type_x,    &
-                          ierr )
-    CALL MPI_TYPE_COMMIT( workarr_t_exchange_type_x, ierr )
-!
-!-- For the top-boundary y-slices
-    CALL MPI_TYPE_VECTOR( 1, 3*(jpnw-jpsw+1), 3*(jpnw-jpsw+1), MPI_REAL,                           &
-                          workarr_t_exchange_type_y, ierr )
-    CALL MPI_TYPE_COMMIT( workarr_t_exchange_type_y, ierr )
-
- END SUBROUTINE pmci_create_workarray_exchange_datatypes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check that the grid lines of child and parent do match. Also check that the child subdomain
-!> width is not smaller than the parent grid spacing in the respective direction.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_check_grid_matching
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  non_int_gsr_x = 0                    !< Flag for non-integer grid-spacing ration in x-direction
-    INTEGER(iwp) ::  non_int_gsr_y = 0                    !< Flag for non-integer grid-spacing ration in y-direction
-    INTEGER(iwp) ::  non_int_gsr_z = 0                    !< Flag for non-integer grid-spacing ration in z-direction
-    INTEGER(iwp) ::  non_matching_height = 0              !< Flag for non-matching child-domain height
-    INTEGER(iwp) ::  non_matching_lower_left_corner = 0   !< Flag for non-matching lower left corner
-    INTEGER(iwp) ::  non_matching_upper_right_corner = 0  !< Flag for non-matching upper right corner
-    INTEGER(iwp) ::  too_narrow_pesd_x = 0                !< Flag for too narrow pe-subdomain in x-direction
-    INTEGER(iwp) ::  too_narrow_pesd_y = 0                !< Flag for too narrow pe-subdomain in y-direction
-
-    REAL(wp) ::  child_ngp_x_l                            !< Number of gridpoints in child subdomain in x-direction
-                                                          !< converted to REAL(wp)
-    REAL(wp) ::  child_ngp_y_l                            !< Number of gridpoints in child subdomain in y-direction
-                                                          !< converted to REAL(wp)
-    REAL(wp) ::  gridline_mismatch_x                      !< Mismatch between the parent and child gridlines in the x-direction
-    REAL(wp) ::  gridline_mismatch_y                      !< Mismatch between the parent and child gridlines in the y-direction
-    REAL(wp) ::  gsr_mismatch_x                           !< Deviation of the grid-spacing ratio from the nearest integer value,
-                                                          !< the x-direction
-    REAL(wp) ::  gsr_mismatch_y                           !< Deviation of the grid-spacing ratio from the nearest integer value, the
-                                                          !< y-direction
-    REAL(wp) ::  tolex                                    !< Tolerance for grid-line matching in x-direction
-    REAL(wp) ::  toley                                    !< Tolerance for grid-line matching in y-direction
-    REAL(wp) ::  tolez                                    !< Tolerance for grid-line matching in z-direction
-    REAL(wp) ::  upper_right_coord_x                      !< X-coordinate of the upper right corner of the child domain
-    REAL(wp) ::  upper_right_coord_y                      !< Y-coordinate of the upper right corner of the child domain
-
-
-    IF ( myid == 0 )  THEN
-
-       tolex = tolefac * dx
-       toley = tolefac * dy
-       tolez = tolefac * dz(1)
-!
-!--    First check that the child domain lower left corner matches the parent grid lines.
-       gridline_mismatch_x = ABS( NINT( lower_left_coord_x / pg%dx ) * pg%dx - lower_left_coord_x )
-       gridline_mismatch_y = ABS( NINT( lower_left_coord_y / pg%dy ) * pg%dy - lower_left_coord_y )
-       IF ( gridline_mismatch_x > tolex ) non_matching_lower_left_corner = 1
-       IF ( gridline_mismatch_y > toley ) non_matching_lower_left_corner = 1
-!
-!--    Then check that the child doman upper right corner matches the parent grid lines.
-       upper_right_coord_x = lower_left_coord_x + ( nx + 1 ) * dx
-       upper_right_coord_y = lower_left_coord_y + ( ny + 1 ) * dy
-       gridline_mismatch_x = ABS( NINT( upper_right_coord_x / pg%dx ) * pg%dx - upper_right_coord_x )
-       gridline_mismatch_y = ABS( NINT( upper_right_coord_y / pg%dy ) * pg%dy - upper_right_coord_y )
-       IF ( gridline_mismatch_x > tolex ) non_matching_upper_right_corner = 1
-       IF ( gridline_mismatch_y > toley ) non_matching_upper_right_corner = 1
-!
-!--    Also check that the cild domain height matches the parent grid lines.
-       IF ( MOD( zw(nzt), pg%dz ) > tolez ) non_matching_height = 1
-!
-!--    Check that the grid-spacing ratios in each direction are integer valued.
-       gsr_mismatch_x = ABS( NINT( pg%dx / dx ) * dx - pg%dx )
-       gsr_mismatch_y = ABS( NINT( pg%dy / dy ) * dy - pg%dy )
-       IF ( gsr_mismatch_x > tolex )  non_int_gsr_x = 1
-       IF ( gsr_mismatch_y > toley )  non_int_gsr_y = 1
-!
-!--    In the z-direction, all levels need to be checked separately against grid stretching which is
-!--    not allowed.
-       DO  n = 0, kctw+1
-          IF ( ABS( pg%zw(n) - zw(kflw(n)) ) > tolez )  non_int_gsr_z = 1
-       ENDDO
-
-       child_ngp_x_l = REAL( nxr - nxl + 1, KIND=wp )
-       IF ( child_ngp_x_l / REAL( igsr, KIND=wp ) < 1.0_wp )  too_narrow_pesd_x = 1
-       child_ngp_y_l = REAL( nyn - nys + 1, KIND=wp )
-       IF ( child_ngp_y_l / REAL( jgsr, KIND=wp ) < 1.0_wp )  too_narrow_pesd_y = 1
-
-       IF ( non_matching_height > 0 )  THEN
-          WRITE( message_string, * ) 'nested child domain height must match ',                     &
-                                     'its parent grid lines'
-          CALL message( 'pmci_check_grid_matching', 'PA0414', 3, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( non_matching_lower_left_corner > 0 )  THEN
-          WRITE( message_string, * ) 'nested child domain lower left ',                            &
-                                     'corner must match its parent grid lines'
-          CALL message( 'pmci_check_grid_matching', 'PA0414', 3, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( non_matching_upper_right_corner > 0 )  THEN
-          WRITE( message_string, * ) 'nested child domain upper right ',                           &
-                                     'corner must match its parent grid lines'
-          CALL message( 'pmci_check_grid_matching', 'PA0414', 3, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( non_int_gsr_x > 0 )  THEN
-          WRITE( message_string, * ) 'nesting grid-spacing ratio ( parent dx / child dx ) ',       &
-                                     'must have an integer value'
-          CALL message( 'pmci_check_grid_matching', 'PA0416', 3, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( non_int_gsr_y > 0 )  THEN
-          WRITE( message_string, * ) 'nesting grid-spacing ratio ( parent dy / child dy ) ',       &
-                                     'must have an integer value'
-          CALL message( 'pmci_check_grid_matching', 'PA0416', 3, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( non_int_gsr_z > 0 )  THEN
-          WRITE( message_string, * ) 'nesting grid-spacing ratio ( parent dz / child dz ) ',       &
-                                     'must have an integer value for each z-level'
-          CALL message( 'pmci_check_grid_matching', 'PA0416', 3, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( too_narrow_pesd_x > 0 )  THEN
-         WRITE( message_string, * ) 'child subdomain width in x-direction must not be ',           &
-                                     'smaller than its parent grid dx. Change the PE-grid ',       &
-                                     'setting (npex, npey) to satisfy this requirement.'
-          CALL message( 'pmci_check_grid_matching', 'PA0587', 3, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( too_narrow_pesd_y > 0 )  THEN
-          WRITE( message_string, * ) 'child subdomain width in y-direction must not be ',          &
-                                     'smaller than its parent grid dy. Change the PE-grid ',       &
-                                     'setting (npex, npey) to satisfy this requirement.'
-          CALL message( 'pmci_check_grid_matching', 'PA0587', 3, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDIF  !  ( myid == 0 )
-
- END SUBROUTINE pmci_check_grid_matching
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the areas of the domain boundary faces: left, right, south, north and top.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_compute_face_areas
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !< Running index in the x-direction
-    INTEGER(iwp) ::  j       !< Running index in the y-direction
-    INTEGER(iwp) ::  k       !< Running index in the z-direction
-    INTEGER(iwp) ::  n       !< Running index over boundary faces
-
-    REAL(wp) ::  face_area_local  !< Local (for the current pe) integral face area of the left boundary
-    REAL(wp) ::  sub_sum          !< Intermediate sum in order to improve the accuracy of the summation
-
-!
-!-- Sum up the volume flow through the left boundary
-    face_area(1) = 0.0_wp
-    face_area_local = 0.0_wp
-    IF ( bc_dirichlet_l )  THEN
-       i = 0
-       DO  j = nys, nyn
-          sub_sum = 0.0_wp
-          DO  k = nzb + 1, nzt
-             sub_sum = sub_sum + dzw(k) * MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-          face_area_local =  face_area_local + dy * sub_sum
-       ENDDO
-    ENDIF
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( face_area_local, face_area(1), 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    face_area(1) = face_area_local
-#endif
-!
-!-- Sum up the volume flow through the right boundary
-    face_area(2) = 0.0_wp
-    face_area_local = 0.0_wp
-    IF ( bc_dirichlet_r )  THEN
-       i = nx
-       DO  j = nys, nyn
-          sub_sum = 0.0_wp
-          DO  k = nzb + 1, nzt
-             sub_sum = sub_sum + dzw(k) * MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-          face_area_local =  face_area_local + dy * sub_sum
-       ENDDO
-    ENDIF
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( face_area_local, face_area(2), 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    face_area(2) = face_area_local
-#endif
-!
-!-- Sum up the volume flow through the south boundary
-    face_area(3) = 0.0_wp
-    face_area_local = 0.0_wp
-    IF ( bc_dirichlet_s )  THEN
-       j = 0
-       DO  i = nxl, nxr
-          sub_sum = 0.0_wp
-          DO  k = nzb + 1, nzt
-             sub_sum = sub_sum + dzw(k) * MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-          face_area_local = face_area_local + dx * sub_sum
-       ENDDO
-    ENDIF
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( face_area_local, face_area(3), 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    face_area(3) = face_area_local
-#endif
-!
-!-- Sum up the volume flow through the north boundary
-    face_area(4) = 0.0_wp
-    face_area_local = 0.0_wp
-    IF ( bc_dirichlet_n )  THEN
-       j = ny
-       DO  i = nxl, nxr
-          sub_sum = 0.0_wp
-          DO  k = nzb + 1, nzt
-             sub_sum = sub_sum + dzw(k) * MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-          face_area_local = face_area_local + dx * sub_sum
-       ENDDO
-    ENDIF
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( face_area_local, face_area(4), 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    face_area(4) = face_area_local
-#endif
-!
-!-- The top face area does not depend on the topography at all.
-    face_area(5) = ( nx + 1 ) * ( ny + 1 ) * dx * dy
-!
-!-- The 6th element is used for the total area
-    face_area(6) = 0.0_wp
-    DO  n = 1, 5
-       face_area(6) = face_area(6) + face_area(n)
-    ENDDO
-
-!    write( 9, "(6(e12.5,2x))") ( face_area(n), n = 1, 6 )
-!    flush( 9 )
-
- END SUBROUTINE pmci_compute_face_areas
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define the anterpolation starting kp-indices for all jp,ip based on the obstacle-canopy 
-!> topograhy for canopy-restricted anterpolation. Note that this is based on the child terrain
-!> topography information since it is difficult to access the parent topography information 
-!> from the child. This means that these topographies are assumed to be close to each other. 
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_compute_kpb_anterp
-
-    INTEGER(iwp) ::  ic                     !< Child-grid index in the x-direction
-    INTEGER(iwp) ::  ip                     !< Parent-grid index in the x-direction
-    INTEGER(iwp) ::  jc                     !< Child-grid index in the y-direction
-    INTEGER(iwp) ::  jp                     !< Parent-grid index in the y-direction
-    INTEGER(iwp) ::  terrain_surf_k_child   !< Local terrain height k index in the child grid
-    INTEGER(iwp) ::  terrain_surf_k_parent  !< Local terrain height k index in the parent grid
-
-    
-    ALLOCATE( kpb_anterp(jps:jpn,ipl:ipr) )
-    kpb_anterp(jps:jpn,ipl:ipr) = 0
-   
-    IF ( nesting_mode /= 'one-way'  .AND.  topography /= 'flat' )  THEN
-!      
-!--    Check if the value was given by user or not
-       IF ( anterpolation_starting_height > 9000000.0_wp )  THEN
-!
-!--       Currently, the default-value definition is not used, but kpb_anterp    
-!--       is simply left to zero. The default value-definition will be
-!--       activated later.
-          anterpolation_starting_height = 0.0_wp
-          RETURN
-       ELSEIF ( anterpolation_starting_height == -1.0_wp )  THEN
-!
-!--       As a workaround, the future default calculation of the anterpolation starting height
-!--       is switched on by giving -1.0
-          CALL default_anterpolation_starting_height( 99 )
-       ENDIF
-
-       DO  ip = ipl, ipr
-          DO  jp = jps, jpn            
-             terrain_surf_k_parent = 0
-             DO  ic = iflo(ip), ifuo(ip)
-                DO  jc = jflo(jp), jfuo(jp)
-                   terrain_surf_k_child = MINLOC(                                                   &
-                        MERGE( 1, 0, BTEST( wall_flags_total_0(:,jc,ic), 5 ) ), DIM = 1 ) - 1
-                   terrain_surf_k_parent = MAX( terrain_surf_k_child, terrain_surf_k_parent )
-                ENDDO
-             ENDDO
-             terrain_surf_k_parent = NINT( terrain_surf_k_parent / REAL( kgsr, wp ) )
-             kpb_anterp(jp,ip) = terrain_surf_k_parent + NINT( anterpolation_starting_height / pg%dz )
-          ENDDO
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE pmci_compute_kpb_anterp
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute a default value for the anterpolation_starting_height for the canopy-restricted 
-!> anterpolation. The default value is based on a given percentile of the child building height 
-!> distribution. This operation is based on the child-grid information.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE default_anterpolation_starting_height( percentile_level ) 
-   
-    INTEGER(iwp), INTENT(IN) ::  percentile_level  !< Selected percentile level (1,...,99)
-
-    INTEGER(iwp) ::  ic                            !< Child-grid index in the x-direction
-    INTEGER(iwp) ::  ierr                          !< MPI-error code
-    INTEGER(iwp) ::  im                            !< Grid index in the x-direction of the currently
-                                                   !< globally highest building node
-    INTEGER(iwp) ::  jc                            !< Child-grid index in the y-direction
-    INTEGER(iwp), DIMENSION(2) :: ji_maxloc        !< jc and ic indices of the local maximum height
-    INTEGER(iwp) ::  jm                            !< Grid index in the y-direction of the currently
-                                                   !< globally highest building node
-    INTEGER(iwp) ::  num_building_nodes            !< Global number of jc,ic-nodes under buildings
-    INTEGER(iwp) ::  num_building_nodes_l          !< Local number of jc,ic-nodes under buildings
-    INTEGER(iwp) ::  num_highest_nodes             !< The number of highest building nodes above the
-                                                   !< percentile value
-    INTEGER(iwp) ::  n                             !< Running index for the sorting loop 
-    INTEGER(iwp) ::  pid_highest                   !< Process id of the process where the currently
-                                                   !< highest building node was found.
-    INTEGER(iwp) ::  terrain_surf_k                !< Local terrain height k index in the child grid
-                                                  
-    REAL(wp) ::  global_currently_highest          !< Globally highest building node currently in the
-                                                   !< search loop
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  building_height  !< Temporary array for buiding heights
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  max_height         !< Maximum buiding heights of each 
-                                                               !< process 
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  max_height_l       !< max_height_l( myid ) is the local 
-                                                               !< maximum buiding height of the 
-                                                               !< current process while the other 
-                                                               !< elements are zeroes
-    
-    ALLOCATE( building_height(nys:nyn,nxl:nxr) )
-!
-!-- Find the building heights and temporarily store them in building_height(nys:nyn,nxl:nxr).    
-!-- Also find the number of nodes occupied by buildings
-    num_building_nodes_l = 0
-    num_building_nodes   = 0
-    DO  ic = nxl, nxr
-       DO  jc = nys, nyn
-          terrain_surf_k  = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jc,ic), 5 ) ),         &
-                                    DIM = 1 ) - 1
-          IF ( topo_top_ind(jc,ic,5) > terrain_surf_k )  THEN                      
-             building_height(jc,ic) = dz(1) * ( topo_top_ind(jc,ic,5) - terrain_surf_k + 1 )
-             num_building_nodes_l = num_building_nodes_l + 1
-          ENDIF
-       ENDDO
-    ENDDO
-    
-    CALL MPI_ALLREDUCE( num_building_nodes_l, num_building_nodes, 1, MPI_INT, MPI_SUM, comm2d, ierr )
-    
-    num_highest_nodes = MAX( 1, NINT( num_building_nodes * ( 100 - percentile_level ) / 100.0_wp ) )
-!    
-!-- Find global percentile value
-    ALLOCATE( max_height_l(0:numprocs-1) )
-    ALLOCATE( max_height(0:numprocs-1) )
-    max_height_l = 0.0_wp
-!
-!-- Search loop for the num_highest_nodes highest nodes globally.
-    DO  n = 1, num_highest_nodes
-       max_height = 0.0_wp
-       max_height_l(myid) = MAXVAL( building_height )
-       CALL MPI_ALLREDUCE( max_height_l, max_height, numprocs, MPI_REAL, MPI_SUM, comm2d, ierr )
-       global_currently_highest = MAXVAL( max_height )
-       pid_highest = MAXLOC( max_height, DIM = 1 ) - 1
-!       
-!--    Set the globally currently highest height to zero in order to find the next 
-!--    highest node in the next loop cycle.
-       IF ( pid_highest == myid )  THEN
-          ji_maxloc = MAXLOC( building_height )
-          jm = ji_maxloc(1) - 1 + nys 
-          im = ji_maxloc(2) - 1 + nxl
-          building_height(jm,im) = 0.0_wp
-       ENDIF
-    ENDDO
-!
-!-- Now after the search-loop, global_currently_highest is the desired percentile 
-!-- value. Add two parent-grid dz in order to create appropriate clearance above the
-!-- roofs in cases of evenly distributed building height such as simple 
-!-- cuboid-array test cases.
-    anterpolation_starting_height = global_currently_highest + 2.0_wp * pg%dz
-
-    WRITE( 9, * )
-    WRITE( 9, "('A default value is defined and set for anterpolation_starting_height = ', f4.1, ' m.' )" )  &
-         anterpolation_starting_height
-    WRITE( 9, * )
-
-    DEALLOCATE( max_height_l )
-    DEALLOCATE( max_height )
-    DEALLOCATE( building_height )
-    
- END SUBROUTINE default_anterpolation_starting_height
-
-#endif
-
- END SUBROUTINE pmci_setup_child
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Translate the coordinates of the current domain into the root coordinate system and store them 
-!> (z remains the same).  
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_setup_coordinates
-
-#if defined( __parallel )
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< grid index in the x-direction
-    INTEGER(iwp) ::  j  !< grid index in the y-direction
-
-!
-!-- Create coordinate arrays.
-    ALLOCATE( coord_x(-nbgp:nx+nbgp) )
-    ALLOCATE( coord_y(-nbgp:ny+nbgp) )
-
-    DO  i = -nbgp, nx + nbgp
-       coord_x(i) = lower_left_coord_x + i * dx
-    ENDDO
-
-    DO  j = -nbgp, ny + nbgp
-       coord_y(j) = lower_left_coord_y + j * dy
-    ENDDO
-
-#endif
- END SUBROUTINE pmci_setup_coordinates
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> In this subroutine the number of coupled arrays is determined.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_num_arrays
-
-#if defined( __parallel )
-    IMPLICIT NONE
-!
-!-- The number of coupled arrays depends on the model settings. At least 5 arrays need to be
-!-- coupled (u, v, w, e, diss).  Please note, actually e and diss (TKE and dissipation rate) are
-!-- only required if RANS-RANS nesting is applied, but memory is allocated nevertheless. This is
-!-- because the information whether they are needed or not is retrieved at a later point in time.
-!-- In case e and diss are not needed, they are also not exchanged between parent and child.
-    pmc_max_array = 5
-!
-!-- pt
-    IF ( .NOT. neutral )  pmc_max_array = pmc_max_array + 1
-
-    IF ( humidity )  THEN
-!
-!--    q
-       pmc_max_array = pmc_max_array + 1
-!
-!--    qc, nc
-       IF ( bulk_cloud_model  .AND.  microphysics_morrison )                                       &
-          pmc_max_array = pmc_max_array + 2
-!
-!--    qr, nr
-       IF ( bulk_cloud_model  .AND.  microphysics_seifert )                                        &
-          pmc_max_array = pmc_max_array + 2
-    ENDIF
-!
-!-- s
-    IF ( passive_scalar )  pmc_max_array = pmc_max_array + 1
-!
-!-- nr_part, part_adr
-    IF ( particle_advection )  pmc_max_array = pmc_max_array + 2
-!
-!-- Chemistry, depends on number of species
-    IF ( air_chemistry  .AND.  nesting_chem )  pmc_max_array = pmc_max_array + nspec
-!
-!-- SALSA, depens on the number aerosol size bins and chemical components + the number of default
-!-- gases
-    IF ( salsa  .AND.  nesting_salsa )  pmc_max_array = pmc_max_array + nbins_aerosol +            &
-                                                        nbins_aerosol * ncomponents_mass
-    IF ( .NOT. salsa_gases_from_chem )  pmc_max_array = pmc_max_array + ngases_salsa
-
-#endif
-
- END SUBROUTINE pmci_num_arrays
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Assigns the pointer to the array to be coupled. 
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_set_array_pointer( name, child_id, nz_child, n )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name  !<
-
-    INTEGER(iwp), INTENT(IN) ::  child_id  !<
-    INTEGER(iwp), INTENT(IN) ::  nz_child  !<
-
-    INTEGER(iwp), INTENT(IN), OPTIONAL ::  n  !< index of chemical species
-
-#if defined( __parallel )
-!
-!-- Local variables:
-    INTEGER(iwp) ::  ierr  !< MPI error code
-
-    INTEGER(idp), POINTER, DIMENSION(:,:) ::  i_2d  !<
-
-    REAL(wp), POINTER, DIMENSION(:,:)   ::  p_2d      !<
-    REAL(wp), POINTER, DIMENSION(:,:,:) ::  p_3d      !<
-    REAL(wp), POINTER, DIMENSION(:,:,:) ::  p_3d_sec  !<
-
-
-    NULLIFY( p_3d )
-    NULLIFY( p_2d )
-    NULLIFY( i_2d )
-!
-!-- List of array names, which can be coupled.
-!-- In case of 3D please change also the second array for the pointer version
-    IF ( TRIM(name) == "u"          )  p_3d => u
-    IF ( TRIM(name) == "v"          )  p_3d => v
-    IF ( TRIM(name) == "w"          )  p_3d => w
-    IF ( TRIM(name) == "e"          )  p_3d => e
-    IF ( TRIM(name) == "pt"         )  p_3d => pt
-    IF ( TRIM(name) == "q"          )  p_3d => q
-    IF ( TRIM(name) == "qc"         )  p_3d => qc
-    IF ( TRIM(name) == "qr"         )  p_3d => qr
-    IF ( TRIM(name) == "nr"         )  p_3d => nr
-    IF ( TRIM(name) == "nc"         )  p_3d => nc
-    IF ( TRIM(name) == "s"          )  p_3d => s
-    IF ( TRIM(name) == "diss"       )  p_3d => diss
-    IF ( TRIM(name) == "nr_part"    )  i_2d => nr_part
-    IF ( TRIM(name) == "part_adr"   )  i_2d => part_adr
-    IF ( INDEX( TRIM(name), "chem_" ) /= 0 )  p_3d => chem_species(n)%conc
-    IF ( INDEX( TRIM(name), "an_" ) /= 0 )  p_3d => aerosol_number(n)%conc
-    IF ( INDEX( TRIM(name), "am_" ) /= 0 )  p_3d => aerosol_mass(n)%conc
-    IF ( INDEX( TRIM(name), "sg_" ) /= 0  .AND.  .NOT. salsa_gases_from_chem )                     &
-       p_3d => salsa_gas(n)%conc
-!
-!-- Next line is just an example for a 2D array (not active for coupling!)
-!-- Please note, that z0 has to be declared as TARGET array in modules.f90.
-!    IF ( TRIM(name) == "z0" )    p_2d => z0
-    IF ( TRIM(name) == "u"    )  p_3d_sec => u_2
-    IF ( TRIM(name) == "v"    )  p_3d_sec => v_2
-    IF ( TRIM(name) == "w"    )  p_3d_sec => w_2
-    IF ( TRIM(name) == "e"    )  p_3d_sec => e_2
-    IF ( TRIM(name) == "pt"   )  p_3d_sec => pt_2
-    IF ( TRIM(name) == "q"    )  p_3d_sec => q_2
-    IF ( TRIM(name) == "qc"   )  p_3d_sec => qc_2
-    IF ( TRIM(name) == "qr"   )  p_3d_sec => qr_2
-    IF ( TRIM(name) == "nr"   )  p_3d_sec => nr_2
-    IF ( TRIM(name) == "nc"   )  p_3d_sec => nc_2
-    IF ( TRIM(name) == "s"    )  p_3d_sec => s_2
-    IF ( TRIM(name) == "diss" )  p_3d_sec => diss_2
-    IF ( INDEX( TRIM(name), "chem_" ) /= 0 )  p_3d_sec => spec_conc_2(:,:,:,n)
-    IF ( INDEX( TRIM(name), "an_" )   /= 0 )  p_3d_sec => nconc_2(:,:,:,n)
-    IF ( INDEX( TRIM(name), "am_" )   /= 0 )  p_3d_sec => mconc_2(:,:,:,n)
-    IF ( INDEX( TRIM(name), "sg_" )   /= 0  .AND.  .NOT.  salsa_gases_from_chem )                  &
-       p_3d_sec => gconc_2(:,:,:,n)
-
-    IF ( ASSOCIATED( p_3d ) )  THEN
-       CALL pmc_s_set_dataarray( child_id, p_3d, nz_child, nz, array_2 = p_3d_sec )
-    ELSEIF  ( ASSOCIATED( p_2d ) )  THEN
-       CALL pmc_s_set_dataarray( child_id, p_2d )
-    ELSEIF  ( ASSOCIATED( i_2d ) )  THEN
-       CALL pmc_s_set_dataarray( child_id, i_2d )
-    ELSE
-!
-!--    Give only one message for the root domain
-       IF ( pmc_is_rootmodel()  .AND.  myid == 0 )  THEN
-          message_string = 'pointer for array "' // TRIM( name ) // '" can''t be associated'
-          CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
-       ELSE
-!
-!--       Avoid others to continue
-          CALL MPI_BARRIER( comm2d, ierr )
-       ENDIF
-
-    ENDIF
-
-#endif
-
- END SUBROUTINE pmci_set_array_pointer
-
-
-
- INTEGER FUNCTION get_number_of_children()
-
-    IMPLICIT NONE
-
-
-#if defined( __parallel )
-    get_number_of_children = SIZE( pmc_parent_for_child ) - 1
-#else
-    get_number_of_children = 0
-#endif
-
-    RETURN
-
- END FUNCTION get_number_of_children
-
-
-
- INTEGER FUNCTION get_childid( id_index )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  id_index   !<
-
-
-#if defined( __parallel )
-    get_childid = pmc_parent_for_child(id_index)
-#else
-    get_childid = 0
-#endif
-
-    RETURN
-
- END FUNCTION get_childid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Provides the child grid edge coordinates for pmc_particle_interface.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b, sy_coord, sy_coord_b,  &
-                             ny_coord, ny_coord_b, uz_coord, uz_coord_b )
-
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) ::  m  !<
-
-    REAL(wp),INTENT(OUT) ::  lx_coord, lx_coord_b  !<
-    REAL(wp),INTENT(OUT) ::  ny_coord, ny_coord_b  !<
-    REAL(wp),INTENT(OUT) ::  rx_coord, rx_coord_b  !<
-    REAL(wp),INTENT(OUT) ::  sy_coord, sy_coord_b  !<
-    REAL(wp),INTENT(OUT) ::  uz_coord, uz_coord_b  !<
-
-
-#if defined( __parallel )
-
-    lx_coord = childgrid(m)%lx_coord
-    rx_coord = childgrid(m)%rx_coord
-    sy_coord = childgrid(m)%sy_coord
-    ny_coord = childgrid(m)%ny_coord
-    uz_coord = childgrid(m)%uz_coord
-
-    lx_coord_b = childgrid(m)%lx_coord_b
-    rx_coord_b = childgrid(m)%rx_coord_b
-    sy_coord_b = childgrid(m)%sy_coord_b
-    ny_coord_b = childgrid(m)%ny_coord_b
-    uz_coord_b = childgrid(m)%uz_coord_b
-
-#endif
-
- END SUBROUTINE get_child_edges
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Provides the child grid spacings for pmc_particle_interface.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE  get_child_gridspacing( m, dx, dy,dz )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  m  !<
-
-    REAL(wp), INTENT(OUT) ::  dx,dy  !<
-
-    REAL(wp), INTENT(OUT), OPTIONAL ::  dz  !<
-
-
-#if defined( __parallel )
-
-    dx = childgrid(m)%dx
-    dy = childgrid(m)%dy
-    IF ( PRESENT( dz ) )  THEN
-       dz = childgrid(m)%dz
-    ENDIF
-
-#endif
-
- END SUBROUTINE get_child_gridspacing
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate child's parent-grid arrays for data transfer between parent and child.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_create_childs_parent_grid_arrays( name, is, ie, js, je, nzc, n  )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name  !<
-
-    INTEGER(iwp), INTENT(IN) ::  ie   !<  RENAME ie, is, je, js?
-    INTEGER(iwp), INTENT(IN) ::  is   !<
-    INTEGER(iwp), INTENT(IN) ::  je   !<
-    INTEGER(iwp), INTENT(IN) ::  js   !<
-    INTEGER(iwp), INTENT(IN) ::  nzc  !<  nzc is pg%nz, but note that pg%nz is not the original nz of parent,
-                                      !<  but the highest parent-grid level needed for nesting.
-    INTEGER(iwp), INTENT(IN), OPTIONAL ::  n  !< number of chemical species / salsa variables
-
-#if defined( __parallel )
-!
-!-- Local variables:
-    INTEGER(iwp) ::  ierr  !<
-
-    INTEGER(idp), POINTER,DIMENSION(:,:) ::  i_2d  !<
-
-    REAL(wp), POINTER,DIMENSION(:,:) ::  p_2d  !<
-
-    REAL(wp), POINTER,DIMENSION(:,:,:) ::  p_3d  !<
-
-    NULLIFY( p_3d )
-    NULLIFY( p_2d )
-    NULLIFY( i_2d )
-!
-!-- List of array names, which can be coupled
-    IF ( TRIM( name ) == "u" )  THEN
-       IF ( .NOT. ALLOCATED( uc ) )  ALLOCATE( uc(0:nzc+1,js:je,is:ie) )
-       p_3d => uc
-    ELSEIF ( TRIM( name ) == "v" )  THEN
-       IF ( .NOT. ALLOCATED( vc ) )  ALLOCATE( vc(0:nzc+1,js:je,is:ie) )
-       p_3d => vc
-    ELSEIF ( TRIM( name ) == "w" )  THEN
-       IF ( .NOT. ALLOCATED( wc ) )  ALLOCATE( wc(0:nzc+1,js:je,is:ie) )
-       p_3d => wc
-    ELSEIF ( TRIM( name ) == "e" )  THEN
-       IF ( .NOT. ALLOCATED( ec ) )  ALLOCATE( ec(0:nzc+1,js:je,is:ie) )
-       p_3d => ec
-    ELSEIF ( TRIM( name ) == "diss" )  THEN
-       IF ( .NOT. ALLOCATED( dissc ) )  ALLOCATE( dissc(0:nzc+1,js:je,is:ie) )
-       p_3d => dissc
-    ELSEIF ( TRIM( name ) == "pt")  THEN
-       IF ( .NOT. ALLOCATED( ptc ) )  ALLOCATE( ptc(0:nzc+1,js:je,is:ie) )
-       p_3d => ptc
-    ELSEIF ( TRIM( name ) == "q")  THEN
-       IF ( .NOT. ALLOCATED( q_c ) )  ALLOCATE( q_c(0:nzc+1,js:je,is:ie) )
-       p_3d => q_c
-    ELSEIF ( TRIM( name ) == "qc")  THEN
-       IF ( .NOT. ALLOCATED( qcc ) )  ALLOCATE( qcc(0:nzc+1,js:je,is:ie) )
-       p_3d => qcc
-    ELSEIF ( TRIM( name ) == "qr")  THEN
-       IF ( .NOT. ALLOCATED( qrc ) )  ALLOCATE( qrc(0:nzc+1,js:je,is:ie) )
-       p_3d => qrc
-    ELSEIF ( TRIM( name ) == "nr")  THEN
-       IF ( .NOT. ALLOCATED( nrc ) )  ALLOCATE( nrc(0:nzc+1,js:je,is:ie) )
-       p_3d => nrc
-    ELSEIF ( TRIM( name ) == "nc")  THEN
-       IF ( .NOT. ALLOCATED( ncc ) )  ALLOCATE( ncc(0:nzc+1,js:je,is:ie) )
-       p_3d => ncc
-    ELSEIF ( TRIM( name ) == "s")  THEN
-       IF ( .NOT. ALLOCATED( sc ) )  ALLOCATE( sc(0:nzc+1,js:je,is:ie) )
-       p_3d => sc
-    ELSEIF ( TRIM( name ) == "nr_part") THEN
-       IF ( .NOT. ALLOCATED( nr_partc ) )  ALLOCATE( nr_partc(js:je,is:ie) )
-       i_2d => nr_partc
-    ELSEIF ( TRIM( name ) == "part_adr") THEN
-       IF ( .NOT. ALLOCATED( part_adrc ) )  ALLOCATE( part_adrc(js:je,is:ie) )
-       i_2d => part_adrc
-    ELSEIF ( TRIM( name(1:5) ) == "chem_" )  THEN
-       IF ( .NOT. ALLOCATED( chem_spec_c ) ) ALLOCATE( chem_spec_c(0:nzc+1,js:je,is:ie,1:nspec) )
-       p_3d => chem_spec_c(:,:,:,n)
-    ELSEIF ( TRIM( name(1:3) ) == "an_" )  THEN
-       IF ( .NOT. ALLOCATED( aerosol_number_c ) )                                                  &
-          ALLOCATE( aerosol_number_c(0:nzc+1,js:je,is:ie,1:nbins_aerosol) )
-       p_3d => aerosol_number_c(:,:,:,n)
-    ELSEIF ( TRIM( name(1:3) ) == "am_" )  THEN
-       IF ( .NOT. ALLOCATED( aerosol_mass_c ) )                                                    &
-          ALLOCATE( aerosol_mass_c(0:nzc+1,js:je,is:ie,1:(nbins_aerosol*ncomponents_mass) ) )
-       p_3d => aerosol_mass_c(:,:,:,n)
-    ELSEIF ( TRIM( name(1:3) ) == "sg_"  .AND.  .NOT. salsa_gases_from_chem )  THEN
-       IF ( .NOT. ALLOCATED( salsa_gas_c ) )                                                       &
-          ALLOCATE( salsa_gas_c(0:nzc+1,js:je,is:ie,1:ngases_salsa) )
-       p_3d => salsa_gas_c(:,:,:,n)
-    !ELSEIF (trim(name) == "z0") then
-       !IF (.not.allocated(z0c))  allocate(z0c(js:je, is:ie))
-       !p_2d => z0c
-    ENDIF
-
-    IF ( ASSOCIATED( p_3d ) )  THEN
-       CALL pmc_c_set_dataarray( p_3d )
-    ELSEIF ( ASSOCIATED( p_2d ) )  THEN
-       CALL pmc_c_set_dataarray( p_2d )
-    ELSEIF ( ASSOCIATED( i_2d ) )  THEN
-       CALL pmc_c_set_dataarray( i_2d )
-    ELSE
-!
-!--    Give only one message for the first child domain.
-       IF ( cpl_id == 2  .AND.  myid == 0 )  THEN
-          message_string = 'pointer for array "' // TRIM( name ) // '" can''t be associated'
-          CALL message( 'pmci_create_childs_parent_grid_arrays', 'PA0170', 3, 2, 0, 6, 0 )
-       ELSE
-!
-!--          Prevent others from continuing in case the abort is to come.
-          CALL MPI_BARRIER( comm2d, ierr )
-       ENDIF
-
-    ENDIF
-
-#endif
- END SUBROUTINE pmci_create_childs_parent_grid_arrays
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Send data for the children in order to let them create initial conditions by interpolating the
-!> parent-domain fields.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_parent_initialize
- 
-#if defined( __parallel )
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  child_id  !<
-    INTEGER(iwp) ::  m         !<
-
-    REAL(wp) ::  waittime  !<
-
-
-    DO  m = 1, SIZE( pmc_parent_for_child ) - 1
-       child_id = pmc_parent_for_child(m)
-       CALL pmc_s_fillbuffer( child_id, waittime=waittime )
-    ENDDO
-
-#endif
- END SUBROUTINE pmci_parent_initialize
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create initial conditions for the current child domain by interpolating the parent-domain fields.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_child_initialize
-
-#if defined( __parallel )
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ic  !< Child-grid index in x-direction
-    INTEGER(iwp) ::  jc  !< Child-grid index in y-direction
-    INTEGER(iwp) ::  kc  !< Child-grid index in z-direction
-    INTEGER(iwp) ::  lb  !< Running index for aerosol size bins
-    INTEGER(iwp) ::  lc  !< Running index for aerosol mass bins
-    INTEGER(iwp) ::  lg  !< Running index for salsa gases
-    INTEGER(iwp) ::  n   !< Running index for chemical species
-
-    REAL(wp) ::  waittime  !< Waiting time
-
-!
-!-- Root model is never anyone's child
-    IF ( .NOT.  pmc_is_rootmodel() )  THEN
-!
-!--    Get data from the parent
-       CALL pmc_c_getbuffer( waittime = waittime )
-!
-!--    The interpolation.
-       CALL pmci_interp_all ( u, uc, kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, 'u' )
-       CALL pmci_interp_all ( v, vc, kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, 'v' )
-       CALL pmci_interp_all ( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, kfuw, 'w' )
-
-       IF ( (       rans_mode_parent  .AND.         rans_mode )  .OR.                              &
-            ( .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                               &
-              .NOT. constant_diffusion ) )  THEN
-          CALL pmci_interp_all ( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 'e' )
-       ENDIF
-
-       IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-          CALL pmci_interp_all ( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-       ENDIF
-
-       IF ( .NOT. neutral )  THEN
-          CALL pmci_interp_all ( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-       ENDIF
-
-       IF ( humidity )  THEN
-
-          CALL pmci_interp_all ( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-
-          IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-             CALL pmci_interp_all ( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-             CALL pmci_interp_all ( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-          ENDIF
-
-          IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-             CALL pmci_interp_all ( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-             CALL pmci_interp_all ( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-          ENDIF
-
-       ENDIF
-
-       IF ( passive_scalar )  THEN
-          CALL pmci_interp_all ( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-       ENDIF
-
-       IF ( air_chemistry  .AND.  nesting_chem )  THEN
-          DO  n = 1, nspec
-             CALL pmci_interp_all ( chem_species(n)%conc, chem_spec_c(:,:,:,n),               &
-                                         kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-          ENDDO
-       ENDIF
-
-       IF ( salsa  .AND.  nesting_salsa )  THEN
-          DO  lb = 1, nbins_aerosol
-             CALL pmci_interp_all ( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),      &
-                                         kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-          ENDDO
-          DO  lc = 1, nbins_aerosol * ncomponents_mass
-             CALL pmci_interp_all ( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),          &
-                                         kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-          ENDDO
-          IF ( .NOT. salsa_gases_from_chem )  THEN
-             DO  lg = 1, ngases_salsa
-                CALL pmci_interp_all ( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),             &
-                                            kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
-             ENDDO
-          ENDIF
-       ENDIF
-
-       IF ( topography /= 'flat' )  THEN
-!
-!--       Inside buildings set velocities back to zero.
-          DO  ic = nxlg, nxrg
-             DO  jc = nysg, nyng
-                DO  kc = nzb, nzt
-                   u(kc,jc,ic)   = MERGE( u(kc,jc,ic), 0.0_wp,                                     &
-                                   BTEST( wall_flags_total_0(kc,jc,ic), 1 ) )
-                   v(kc,jc,ic)   = MERGE( v(kc,jc,ic), 0.0_wp,                                     &
-                                   BTEST( wall_flags_total_0(kc,jc,ic), 2 ) )
-                   w(kc,jc,ic)   = MERGE( w(kc,jc,ic), 0.0_wp,                                     &
-                                   BTEST( wall_flags_total_0(kc,jc,ic), 3 ) )
-                   u_p(kc,jc,ic) = MERGE( u_p(kc,jc,ic), 0.0_wp,                                   &
-                                   BTEST( wall_flags_total_0(kc,jc,ic), 1 ) )
-                   v_p(kc,jc,ic) = MERGE( v_p(kc,jc,ic), 0.0_wp,                                   &
-                                   BTEST( wall_flags_total_0(kc,jc,ic), 2 ) )
-                   w_p(kc,jc,ic) = MERGE( w_p(kc,jc,ic), 0.0_wp,                                   &
-                                   BTEST( wall_flags_total_0(kc,jc,ic), 3 ) )
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interpolation of the internal values for the child-domain initialization.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_interp_all( child_array, parent_array, kct, ifl, ifu, jfl, jfu, kfl, kfu, var )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1), INTENT(IN) ::  var  !<  Variable symbol: 'u', 'v', 'w' or 's'
-
-    INTEGER(iwp), INTENT(IN) ::  kct  !< The parent-grid index in z-direction just below the boundary value node
-
-    INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifl  !<  Indicates start index of child cells belonging to certain
-                                                            !<  parent cell - x direction
-    INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifu  !<  Indicates end index of child cells belonging to certain
-                                                            !<  parent cell - x direction
-    INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfl  !<  Indicates start index of child cells belonging to certain
-                                                            !<  parent cell - y direction
-    INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfu  !<  Indicates end index of child cells belonging to certain
-                                                            !<  parent cell - y direction
-    INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfl  !<  Indicates start index of child cells belonging to certain
-                                                            !<  parent cell - z direction
-    INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfu  !<  Indicates end index of child cells belonging to certain
-                                                            !<  parent cell - z direction
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  child_array  !<  Child-grid array
-
-    REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(IN) ::  parent_array  !<  Parent-grid array
-
-!
-!-- Local variables:
-    INTEGER(iwp) ::  ic        !< Running child-grid index in the x-direction
-    INTEGER(iwp) ::  icb       !< Index pointing to the first redundant ghost point layer behind the actual boundary
-                               !< ghost point layer in the x-direction
-    INTEGER(iwp) ::  icbc      !< Index pointing to the boundary ghost point layer in the x-direction
-    INTEGER(iwp) ::  icfirst   !< Leftmost child-grid index initialized by the main loops (usually icfirst == icl_init)
-    INTEGER(iwp) ::  iclast    !< Rightmost child-grid index initialized by the main loops (usually iclast == icr_init)
-    INTEGER(iwp) ::  icl_init  !< Left child-grid index bound for initialization in the x-direction
-    INTEGER(iwp) ::  icr_init  !< Right child-grid index bound for initialization in the x-direction
-    INTEGER(iwp) ::  ip        !< Running parent-grid index in the x-direction
-    INTEGER(iwp) ::  ipl_init  !< Left parent-grid index bound for initialization in the x-direction
-    INTEGER(iwp) ::  ipr_init  !< Right parent-grid index bound for initialization in the x-direction
-    INTEGER(iwp) ::  jc        !< Running child-grid index in the y-direction
-    INTEGER(iwp) ::  jcb       !< Index pointing to the first redundant ghost point layer behind the actual boundary
-                               !< ghost point layer in the y-direction
-    INTEGER(iwp) ::  jcbc      !< Index pointing to the boundary ghost point layer in the y-direction
-    INTEGER(iwp) ::  jcfirst   !< Southmost child-grid index initialized by the main loops (usually jcfirst == jcs_init)
-    INTEGER(iwp) ::  jclast    !< Northmost child-grid index initialized by the main loops (usually jclast == jcn_init)
-    INTEGER(iwp) ::  jcs_init  !< South child-grid index bound for initialization in the y-direction
-    INTEGER(iwp) ::  jcn_init  !< North child-grid index bound for initialization in the y-direction
-    INTEGER(iwp) ::  jp        !< Running parent-grid index in the y-direction
-    INTEGER(iwp) ::  jps_init  !< South parent-grid index bound for initialization in the y-direction
-    INTEGER(iwp) ::  jpn_init  !< North parent-grid index bound for initialization in the y-direction
-    INTEGER(iwp) ::  kc        !< Running child-grid index in the z-direction
-    INTEGER(iwp) ::  kp        !< Running parent-grid index in the z-direction
-
-
-    ipl_init = ipl
-    ipr_init = ipr
-    jps_init = jps
-    jpn_init = jpn
-    icl_init = nxl
-    icr_init = nxr
-    jcs_init = nys
-    jcn_init = nyn
-
-    icbc = -1
-    icb  = -2
-    jcbc = -1
-    jcb  = -2
-    IF ( var == 'u' )  THEN
-       icbc =  0
-       icb  = -1
-    ELSE IF ( var == 'v' )  THEN
-       jcbc =  0
-       jcb  = -1
-    ENDIF
-
-    IF ( nesting_mode /= 'vertical' )  THEN
-       IF ( bc_dirichlet_l )  THEN
-          ipl_init = ipl + 1
-          icl_init = nxl - 1
-!
-!--       For u, nxl is a ghost node, but not for the other variables
-          IF ( var == 'u' )  THEN
-             ipl_init = ipl + 2
-             icl_init = nxl
-          ENDIF
-       ENDIF
-       IF ( bc_dirichlet_s )  THEN
-          jps_init = jps + 1
-          jcs_init = nys - 1
-!
-!--       For v, nys is a ghost node, but not for the other variables
-          IF ( var == 'v' )  THEN
-             jps_init = jps + 2
-             jcs_init = nys
-          ENDIF
-       ENDIF
-       IF ( bc_dirichlet_r )  THEN
-          ipr_init = ipr - 1
-          icr_init = nxr + 1
-       ENDIF
-       IF ( bc_dirichlet_n )  THEN
-          jpn_init = jpn - 1
-          jcn_init = nyn + 1
-       ENDIF
-    ENDIF
-
-    child_array(:,:,:) = 0.0_wp
-
-    IF ( var == 'u' )  THEN
-
-       icfirst = ifl(ipl_init)
-       iclast  = ifl(ipr_init+1) - 1
-       jcfirst = jfl(jps_init)
-       jclast  = jfu(jpn_init)
-       DO  ip = ipl_init, ipr_init
-          DO  jp = jps_init, jpn_init
-             DO  kp = 0, kct + 1
-
-                DO  ic = ifl(ip), ifl(ip+1)-1
-                   DO  jc = jfl(jp), jfu(jp)
-                      DO  kc = kfl(kp), MIN( kfu(kp), nzt+1 )
-                         child_array(kc,jc,ic) = parent_array(kp,jp,ip)
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ELSE IF ( var == 'v' )  THEN
-
-       icfirst = ifl(ipl_init)
-       iclast  = ifu(ipr_init)
-       jcfirst = jfl(jps_init)
-       jclast  = jfl(jpn_init+1) - 1
-       DO  ip = ipl_init, ipr_init
-          DO  jp = jps_init, jpn_init
-             DO  kp = 0, kct + 1
-
-                DO  ic = ifl(ip), ifu(ip)
-                   DO  jc = jfl(jp), jfl(jp+1)-1
-                      DO  kc = kfl(kp), MIN( kfu(kp), nzt+1 )
-                         child_array(kc,jc,ic) = parent_array(kp,jp,ip)
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ELSE IF ( var == 'w' )  THEN
-
-       icfirst = ifl(ipl_init)
-       iclast  = ifu(ipr_init)
-       jcfirst = jfl(jps_init)
-       jclast  = jfu(jpn_init)
-       DO  ip = ipl_init, ipr_init
-          DO  jp = jps_init, jpn_init
-             DO  kp = 1, kct + 1
-
-                DO  ic = ifl(ip), ifu(ip)
-                   DO  jc = jfl(jp), jfu(jp)
-!
-!--                   Because the kp-loop for w starts from kp=1 instead of 0
-                      child_array(nzb,jc,ic) = 0.0_wp
-                      DO  kc = kfu(kp-1)+1, kfu(kp)
-                         child_array(kc,jc,ic) = parent_array(kp,jp,ip)
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ELSE   ! Scalars
-
-       icfirst = ifl(ipl_init)
-       iclast  = ifu(ipr_init)
-       jcfirst = jfl(jps_init)
-       jclast  = jfu(jpn_init)
-       DO  ip = ipl_init, ipr_init
-          DO  jp = jps_init, jpn_init
-             DO  kp = 0, kct + 1
-
-                DO  ic = ifl(ip), ifu(ip)
-                   DO  jc = jfl(jp), jfu(jp)
-                      DO  kc = kfl(kp), MIN( kfu(kp), nzt+1 )
-                         child_array(kc,jc,ic) = parent_array(kp,jp,ip)
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ENDIF  ! var
-!
-!-- If the number of grid points in child subdomain in x- or y-direction
-!-- (nxr - nxl + 1 and/or nyn - nys + 1) is not integer divisible by the grid spacing ratio in its
-!-- direction (igsr and/or jgsr), the above loops will return with unfilled gaps in the initial
-!-- fields. These gaps, if present, are filled here.
-    IF ( icfirst > icl_init )  THEN
-       DO  ic = icl_init, icfirst - 1
-          child_array(:,:,ic) = child_array(:,:,icfirst)
-       ENDDO
-    ENDIF
-    IF ( iclast < icr_init )  THEN
-       DO  ic = iclast + 1, icr_init
-          child_array(:,:,ic) = child_array(:,:,iclast)
-       ENDDO
-    ENDIF
-    IF ( jcfirst > jcs_init )  THEN
-       DO  jc = jcs_init, jcfirst - 1
-          child_array(:,jc,:) = child_array(:,jcfirst,:)
-       ENDDO
-    ENDIF
-    IF ( jclast < jcn_init )  THEN
-       DO  jc = jclast + 1, jcn_init
-          child_array(:,jc,:) = child_array(:,jclast,:)
-       ENDDO
-    ENDIF
-!
-!-- Finally, make sure that also the redundant 2nd and 3rd ghost-node layers including the corners
-!-- are properly filled up.
-    IF ( nys == 0 )  THEN
-       DO  jc = -nbgp, jcb  ! jcb = -2 if var == v, else jcb = -1
-          child_array(0:nzt+1,jc,nxlg:nxrg) = child_array(0:nzt+1,jcbc,nxlg:nxrg)
-       ENDDO
-    ENDIF
-    IF ( nyn == ny )  THEN
-       DO  jc = ny+2, ny+nbgp
-          child_array(0:nzt+1,jc,nxlg:nxrg) = child_array(0:nzt+1,ny+1,nxlg:nxrg)
-       ENDDO
-    ENDIF
-    IF ( nxl == 0 )  THEN
-       DO  ic = -nbgp, icb  ! icb = -2 if var == u, else icb = -1
-          child_array(0:nzt+1,nysg:nyng,ic) = child_array(0:nzt+1,nysg:nyng,icbc)
-       ENDDO
-    ENDIF
-    IF ( nxr == nx )  THEN
-       DO  ic = nx+2, nx+nbgp
-          child_array(0:nzt+1,nysg:nyng,ic) = child_array(0:nzt+1,nysg:nyng,nx+1)
-       ENDDO
-    ENDIF
-
- END SUBROUTINE pmci_interp_all
-
-#endif
- END SUBROUTINE pmci_child_initialize
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check for mismatches between settings of root and child variables (e.g., all children have to
-!> follow the end_time settings of the root model). The root model overwrites variables in the
-!> other models, so these variables only need to be set once in file PARIN.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_check_setting_mismatches
-
-#if defined( __parallel )
-    IMPLICIT NONE
-
-    INTEGER ::  ierr  !<  MPI error code
-
-    REAL(wp) ::  dt_restart_root    !<
-    REAL(wp) ::  end_time_root      !<
-    REAL(wp) ::  restart_time_root  !<
-    REAL(wp) ::  time_restart_root  !<
-
-!
-!-- Check the time to be simulated. Here, and in the following, the root process communicates the
-!-- respective variable to all others, and its value will then be compared with the local values.
-    IF ( pmc_is_rootmodel() )  end_time_root = end_time
-    CALL MPI_BCAST( end_time_root, 1, MPI_REAL, 0, comm_world_nesting, ierr )
-
-    IF ( .NOT. pmc_is_rootmodel() )  THEN
-       IF ( end_time /= end_time_root )  THEN
-          WRITE( message_string, * )  'mismatch between root model and child settings:& ' //       &
-                                      'end_time(root) = ', end_time_root,                          &
-                                      '& end_time(child) = ', end_time, '& child value is set',    &
-                                      ' to root value'
-          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, 0 )
-          end_time = end_time_root
-       ENDIF
-    ENDIF
-!
-!-- Same for restart time
-    IF ( pmc_is_rootmodel() )  restart_time_root = restart_time
-    CALL MPI_BCAST( restart_time_root, 1, MPI_REAL, 0, comm_world_nesting, ierr )
-
-    IF ( .NOT. pmc_is_rootmodel() )  THEN
-       IF ( restart_time /= restart_time_root )  THEN
-          WRITE( message_string, * )  'mismatch between root model and child settings: & ' //      &
-                                      'restart_time(root) = ', restart_time_root,                  &
-                                      '& restart_time(child) = ', restart_time, '& child ',        &
-                                      'value is set to root value'
-          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, 0 )
-          restart_time = restart_time_root
-       ENDIF
-    ENDIF
-!
-!-- Same for dt_restart
-    IF ( pmc_is_rootmodel() )  dt_restart_root = dt_restart
-    CALL MPI_BCAST( dt_restart_root, 1, MPI_REAL, 0, comm_world_nesting, ierr )
-
-    IF ( .NOT. pmc_is_rootmodel() )  THEN
-       IF ( dt_restart /= dt_restart_root )  THEN
-          WRITE( message_string, * )  'mismatch between root model and ',                          &
-                                      'child settings: & dt_restart(root) = ', dt_restart_root,    &
-                                      '& dt_restart(child) = ', dt_restart, '& child ',            &
-                                      'value is set to root value'
-          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, 0 )
-          dt_restart = dt_restart_root
-       ENDIF
-    ENDIF
-!
-!-- Same for time_restart
-    IF ( pmc_is_rootmodel() )  time_restart_root = time_restart
-    CALL MPI_BCAST( time_restart_root, 1, MPI_REAL, 0, comm_world_nesting, ierr )
-
-    IF ( .NOT. pmc_is_rootmodel() )  THEN
-       IF ( time_restart /= time_restart_root )  THEN
-          WRITE( message_string, * )  'mismatch between root model and child settings: & ' //      &
-                                      'time_restart(root) = ', time_restart_root,                  &
-                                      '& time_restart(child) = ', time_restart, '& child ',        &
-                                      'value is set to root value'
-          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, 0 )
-          time_restart = time_restart_root
-       ENDIF
-    ENDIF
-
-#endif
-
- END SUBROUTINE pmci_check_setting_mismatches
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Unify the time steps for each model and synchronize using MPI_ALLREDUCE with the MPI_MIN
-!> operator over all processes using the global communicator MPI_COMM_WORLD.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_synchronize
-
-#if defined( __parallel )
-
-   IMPLICIT NONE
-
-   INTEGER(iwp) ::  ierr  !< MPI error code
-
-   REAL(wp) ::  dtl  !< Local time step of the current process
-   REAL(wp) ::  dtg  !< Global time step defined as the global minimum of dtl of all processes
-
-
-   IF ( debug_output_timestep )  CALL debug_message( 'pmci_synchronize', 'start' )
-
-   dtl = dt_3d
-   CALL MPI_ALLREDUCE( dtl, dtg, 1, MPI_REAL, MPI_MIN, MPI_COMM_WORLD, ierr )
-   dt_3d  = dtg
-
-   IF ( debug_output_timestep )  CALL debug_message( 'pmci_synchronize', 'end' )
-
-#endif
- END SUBROUTINE pmci_synchronize
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> After each Runge-Kutta sub-timestep, alternately set buffer one or buffer two active
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_set_swaplevel( swaplevel )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  swaplevel  !< swaplevel (1 or 2) of PALM's timestep
-
-    INTEGER(iwp) ::  child_id  !<  Child id of the child number m
-    INTEGER(iwp) ::  m         !<  Loop index over all children of the current parent
-
-#if defined( __parallel )
-    DO  m = 1, SIZE( pmc_parent_for_child ) - 1
-       child_id = pmc_parent_for_child(m)
-       CALL pmc_s_set_active_data_array( child_id, swaplevel )
-    ENDDO
-#endif
- END SUBROUTINE pmci_set_swaplevel
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine controls the nesting according to the nestpar parameter nesting_mode (two-way
-!> (default) or one-way) and the order of anterpolations according to the nestpar parameter
-!> nesting_datatransfer_mode (cascade, overlap or mixed (default)). Although nesting_mode is a
-!> variable of this module, pass it as an argument to allow for example to force one-way
-!> initialization phase. Note that interpolation ( parent_to_child ) must always be carried out
-!> before anterpolation ( child_to_parent ).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_datatrans( local_nesting_mode )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  local_nesting_mode  !<  Nesting mode: 'one-way', 'two-way' or 'vertical'
-
-#if defined( __parallel )
-
-    IF ( debug_output_timestep )  CALL debug_message( 'pmci_datatrans', 'start' )
-
-    IF ( TRIM( local_nesting_mode ) == 'one-way' )  THEN
-
-       CALL pmci_child_datatrans( parent_to_child )
-       CALL pmci_parent_datatrans( parent_to_child )
-
-    ELSE
-
-       IF ( nesting_datatransfer_mode == 'cascade' )  THEN
-
-          CALL pmci_child_datatrans( parent_to_child )
-          CALL pmci_parent_datatrans( parent_to_child )
-
-          CALL pmci_parent_datatrans( child_to_parent )
-          CALL pmci_child_datatrans( child_to_parent )
-
-       ELSEIF ( nesting_datatransfer_mode == 'overlap')  THEN
-
-          CALL pmci_parent_datatrans( parent_to_child )
-          CALL pmci_child_datatrans( parent_to_child )
-
-          CALL pmci_child_datatrans( child_to_parent )
-          CALL pmci_parent_datatrans( child_to_parent )
-
-       ELSEIF ( TRIM( nesting_datatransfer_mode ) == 'mixed' )  THEN
-
-          CALL pmci_parent_datatrans( parent_to_child )
-          CALL pmci_child_datatrans( parent_to_child )
-
-          CALL pmci_parent_datatrans( child_to_parent )
-          CALL pmci_child_datatrans( child_to_parent )
-
-       ENDIF
-
-    ENDIF
-
-    IF ( debug_output_timestep )  CALL debug_message( 'pmci_datatrans', 'end' )
-
-#endif
- END SUBROUTINE pmci_datatrans
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Wrapper routine including the parent-side calls to all the data-transfer routines. 
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_parent_datatrans( direction )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  direction  !<  Direction of the data transfer: 'parent_to_child' or 'child_to_parent'
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  child_id  !<  Child id of the child number m
-    INTEGER(iwp) ::  i         !<  Parent-grid index in x-direction
-    INTEGER(iwp) ::  j         !<  Parent-grid index in y-direction
-    INTEGER(iwp) ::  k         !<  Parent-grid index in z-direction
-    INTEGER(iwp) ::  m         !<  Loop index over all children of the current parent
-
-
-    DO  m = 1, SIZE( pmc_parent_for_child ) - 1
-       child_id = pmc_parent_for_child(m)
-       IF ( direction == parent_to_child )  THEN
-          CALL cpu_log( log_point_s(71), 'pmc parent send', 'start' )
-          CALL pmc_s_fillbuffer( child_id )
-          CALL cpu_log( log_point_s(71), 'pmc parent send', 'stop' )
-       ELSE
-!
-!--       Communication from child to parent
-          CALL cpu_log( log_point_s(72), 'pmc parent recv', 'start' )
-          child_id = pmc_parent_for_child(m)
-          CALL pmc_s_getdata_from_buffer( child_id )
-          CALL cpu_log( log_point_s(72), 'pmc parent recv', 'stop' )
-!
-!--       The anterpolated data is now available in u etc
-          IF ( topography /= 'flat' )  THEN
-!
-!--          Inside buildings/topography reset velocities back to zero.
-!--          Scalars (pt, q, s, km, kh, p, sa, ...) are ignored at present, maybe revise later.
-!--          Resetting of e is removed as unnecessary since e is not interpolated, and as incorrect
-!--          since it overran the default Neumann condition (bc_e_b).
-             DO   i = nxlg, nxrg
-                DO   j = nysg, nyng
-                   DO  k = nzb, nzt+1
-                      u(k,j,i) = MERGE( u(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-                      v(k,j,i) = MERGE( v(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-                      w(k,j,i) = MERGE( w(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-!
-!--                 TO_DO: zero setting of temperature within topography creates wrong results
-!                   pt(nzb:nzb_s_inner(j,i),j,i) = 0.0_wp
-!                   IF ( humidity  .OR.  passive_scalar )  THEN
-!                      q(nzb:nzb_s_inner(j,i),j,i) = 0.0_wp
-!                   ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-    ENDDO  ! m
-
-#endif
- END SUBROUTINE pmci_parent_datatrans
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Wrapper routine including the child-side calls to all the data-transfer and processing routines. 
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_child_datatrans( direction )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  direction  !< transfer direction: parent_to_child or child_to_parent
-
-#if defined( __parallel )
-
-    REAL(wp), DIMENSION(1) ::  dtl  !< time step size
-
-
-    dtl = dt_3d
-    IF ( .NOT.  pmc_is_rootmodel() )  THEN
-
-       IF ( direction == parent_to_child )  THEN
-
-          CALL cpu_log( log_point_s(73), 'pmc child recv', 'start' )
-          CALL pmc_c_getbuffer( )
-          CALL cpu_log( log_point_s(73), 'pmc child recv', 'stop' )
-
-          CALL cpu_log( log_point_s(75), 'pmc interpolation', 'start' )
-          CALL pmci_interpolation
-          CALL cpu_log( log_point_s(75), 'pmc interpolation', 'stop' )
-
-       ELSE
-!
-!--       direction == child_to_parent
-          CALL cpu_log( log_point_s(76), 'pmc anterpolation', 'start' )
-          CALL pmci_anterpolation
-          CALL cpu_log( log_point_s(76), 'pmc anterpolation', 'stop' )
-
-          CALL cpu_log( log_point_s(74), 'pmc child send', 'start' )
-          CALL pmc_c_putbuffer( )
-          CALL cpu_log( log_point_s(74), 'pmc child send', 'stop' )
-
-       ENDIF
-    ENDIF
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> A wrapper routine for all interpolation actions.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_interpolation
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ibgp  !< Index running over the nbgp boundary ghost points in i-direction
-    INTEGER(iwp) ::  jbgp  !< Index running over the nbgp boundary ghost points in j-direction
-    INTEGER(iwp) ::  lb    !< Running index for aerosol size bins
-    INTEGER(iwp) ::  lc    !< Running index for aerosol mass bins
-    INTEGER(iwp) ::  lg    !< Running index for salsa gases
-    INTEGER(iwp) ::  n     !< Running index for number of chemical species
-
-!
-!-- In case of vertical nesting no interpolation is needed for the horizontal boundaries
-    IF ( nesting_mode /= 'vertical' )  THEN
-!
-!--    Left border pe:
-       IF ( bc_dirichlet_l )  THEN
-
-          CALL pmci_interp_lr( u, uc, kcto, jflo, jfuo, kflo, kfuo, 'l', 'u' )
-          CALL pmci_interp_lr( v, vc, kcto, jflv, jfuv, kflo, kfuo, 'l', 'v' )
-          CALL pmci_interp_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'l', 'w' )
-!
-!--       Treatment of TKE. Interpolation is only required if parent and child operate in RANS mode,
-!--       else, interpolation is replaced by a Neumann condition.
-          IF ( rans_mode_parent  .AND.  rans_mode )  THEN
-              CALL pmci_interp_lr( e, ec, kcto, jflo, jfuo, kflo, kfuo, 'l', 'e' )
-          ELSE
-             DO  ibgp = -nbgp, -1
-                e(nzb:nzt,nys:nyn,ibgp) = e(nzb:nzt,nys:nyn,0)
-             ENDDO
-          ENDIF
-
-          IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-             CALL pmci_interp_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
-          ENDIF
-
-          IF ( .NOT. neutral )  THEN
-             CALL pmci_interp_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
-          ENDIF
-
-          IF ( humidity )  THEN
-
-             CALL pmci_interp_lr( q, q_c, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
-
-             IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-                CALL pmci_interp_lr( qc, qcc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
-                CALL pmci_interp_lr( nc, ncc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
-             ENDIF
-
-             IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-                CALL pmci_interp_lr( qr, qrc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
-                CALL pmci_interp_lr( nr, nrc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
-             ENDIF
-
-          ENDIF
-
-          IF ( passive_scalar )  THEN
-             CALL pmci_interp_lr( s, sc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
-          ENDIF
-
-          IF ( air_chemistry  .AND.  nesting_chem )  THEN
-             DO  n = 1, nspec
-                CALL pmci_interp_lr( chem_species(n)%conc, chem_spec_c(:,:,:,n),                   &
-                                     kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
-             ENDDO
-          ENDIF
-
-          IF ( salsa  .AND.  nesting_salsa )  THEN
-             DO  lb = 1, nbins_aerosol
-                CALL pmci_interp_lr( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),          &
-                                     kcto, jflo, jfuo, kflo, kfuo, 'l', 's')
-             ENDDO
-             DO  lc = 1, nbins_aerosol * ncomponents_mass
-                CALL pmci_interp_lr( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),              &
-                                     kcto, jflo, jfuo, kflo, kfuo, 'l', 's')
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  lg = 1, ngases_salsa
-                   CALL pmci_interp_lr( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),                 &
-                                        kcto, jflo, jfuo, kflo, kfuo, 'l', 's')
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ENDIF
-!
-!--    Right border pe
-       IF ( bc_dirichlet_r )  THEN
-
-          CALL pmci_interp_lr( u, uc, kcto, jflo, jfuo, kflo, kfuo, 'r', 'u' )
-          CALL pmci_interp_lr( v, vc, kcto, jflv, jfuv, kflo, kfuo, 'r', 'v' )
-          CALL pmci_interp_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'r', 'w' )
-!
-!--       Treatment of TKE. Interpolation is only required if parent and child operate in RANS mode,
-!--       else, interpolation is replaced by a Neumann condition.
-          IF ( rans_mode_parent  .AND.  rans_mode )  THEN
-             CALL pmci_interp_lr( e, ec, kcto, jflo, jfuo, kflo, kfuo, 'r', 'e' )
-          ELSE
-             DO  ibgp = nx+1, nx+nbgp
-                e(nzb:nzt,nys:nyn,ibgp) = e(nzb:nzt,nys:nyn,nx)
-             ENDDO
-          ENDIF
-
-          IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-             CALL pmci_interp_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-          ENDIF
-
-          IF (  .NOT.  neutral )  THEN
-             CALL pmci_interp_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-          ENDIF
-
-          IF ( humidity )  THEN
-             CALL pmci_interp_lr( q, q_c, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-
-             IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-                CALL pmci_interp_lr( qc, qcc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-                CALL pmci_interp_lr( nc, ncc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-             ENDIF
-
-             IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-                CALL pmci_interp_lr( qr, qrc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-                CALL pmci_interp_lr( nr, nrc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-             ENDIF
-
-          ENDIF
-
-          IF ( passive_scalar )  THEN
-             CALL pmci_interp_lr( s, sc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-          ENDIF
-
-          IF ( air_chemistry  .AND.  nesting_chem )  THEN
-             DO  n = 1, nspec
-                CALL pmci_interp_lr( chem_species(n)%conc, chem_spec_c(:,:,:,n),                    &
-                                     kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-             ENDDO
-          ENDIF
-
-          IF ( salsa  .AND.  nesting_salsa )  THEN
-             DO  lb = 1, nbins_aerosol
-                CALL pmci_interp_lr( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),           &
-                                          kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-             ENDDO
-             DO  lc = 1, nbins_aerosol * ncomponents_mass
-                CALL pmci_interp_lr( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),               &
-                                     kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  lg = 1, ngases_salsa
-                   CALL pmci_interp_lr( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),                  &
-                                        kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ENDIF
-!
-!--    South border pe
-       IF ( bc_dirichlet_s )  THEN
-
-          CALL pmci_interp_sn( v, vc, kcto, iflo, ifuo, kflo, kfuo, 's', 'v' )
-          CALL pmci_interp_sn( w, wc, kctw, iflo, ifuo, kflw, kfuw, 's', 'w' )
-          CALL pmci_interp_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 's', 'u' )
-!
-!--       Treatment of TKE. Interpolation is only required if parent and child operate in RANS mode,
-!--       else, interpolation is replaced by a Neumann condition.
-          IF ( rans_mode_parent  .AND.  rans_mode )  THEN
-             CALL pmci_interp_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 's', 'e' )
-          ELSE
-             DO  jbgp = -nbgp, -1
-                e(nzb:nzt,jbgp,nxl:nxr) = e(nzb:nzt,0,nxl:nxr)
-             ENDDO
-          ENDIF
-
-          IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-             CALL pmci_interp_sn( diss, dissc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-          ENDIF
-
-          IF (  .NOT.  neutral )  THEN
-             CALL pmci_interp_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-          ENDIF
-
-          IF ( humidity )  THEN
-             CALL pmci_interp_sn( q, q_c, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-
-             IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-                CALL pmci_interp_sn( qc, qcc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-                CALL pmci_interp_sn( nc, ncc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-             ENDIF
-
-             IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-                CALL pmci_interp_sn( qr, qrc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-                CALL pmci_interp_sn( nr, nrc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-             ENDIF
-
-          ENDIF
-
-          IF ( passive_scalar )  THEN
-             CALL pmci_interp_sn( s, sc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-          ENDIF
-
-          IF ( air_chemistry  .AND.  nesting_chem )  THEN
-             DO  n = 1, nspec
-                CALL pmci_interp_sn( chem_species(n)%conc, chem_spec_c(:,:,:,n),                   &
-                                     kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-             ENDDO
-          ENDIF
-
-          IF ( salsa  .AND.  nesting_salsa )  THEN
-             DO  lb = 1, nbins_aerosol
-                CALL pmci_interp_sn( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),          &
-                                     kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-             ENDDO
-             DO  lc = 1, nbins_aerosol * ncomponents_mass
-                CALL pmci_interp_sn( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),              &
-                                     kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  lg = 1, ngases_salsa
-                   CALL pmci_interp_sn( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),                 &
-                                        kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ENDIF
-!
-!--    North border pe
-       IF ( bc_dirichlet_n )  THEN
-
-          CALL pmci_interp_sn( v, vc, kcto, iflo, ifuo, kflo, kfuo, 'n', 'v' )
-          CALL pmci_interp_sn( w, wc, kctw, iflo, ifuo, kflw, kfuw, 'n', 'w' )
-          CALL pmci_interp_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 'n', 'u' )
-!
-!--       Treatment of TKE. Interpolation is only required if parent and child operate in RANS mode,
-!--       else, interpolation is replaced by a Neumann condition.
-          IF ( rans_mode_parent  .AND.  rans_mode )  THEN
-             CALL pmci_interp_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 'n', 'e' )
-          ELSE
-             DO  jbgp = ny+1, ny+nbgp
-                e(nzb:nzt,jbgp,nxl:nxr) = e(nzb:nzt,ny,nxl:nxr)
-             ENDDO
-          ENDIF
-
-          IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-             CALL pmci_interp_sn( diss, dissc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-          ENDIF
-
-          IF (  .NOT.  neutral )  THEN
-             CALL pmci_interp_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-          ENDIF
-
-          IF ( humidity )  THEN
-             CALL pmci_interp_sn( q, q_c, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-
-             IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-                CALL pmci_interp_sn( qc, qcc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-                CALL pmci_interp_sn( nc, ncc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-             ENDIF
-
-             IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-                CALL pmci_interp_sn( qr, qrc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-                CALL pmci_interp_sn( nr, nrc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-             ENDIF
-
-          ENDIF
-
-          IF ( passive_scalar )  THEN
-             CALL pmci_interp_sn( s, sc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-          ENDIF
-
-          IF ( air_chemistry  .AND.  nesting_chem )  THEN
-             DO  n = 1, nspec
-                CALL pmci_interp_sn( chem_species(n)%conc, chem_spec_c(:,:,:,n),                   &
-                                     kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-             ENDDO
-          ENDIF
-
-          IF ( salsa  .AND.  nesting_salsa )  THEN
-             DO  lb = 1, nbins_aerosol
-                CALL pmci_interp_sn( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),          &
-                                     kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-             ENDDO
-             DO  lc = 1, nbins_aerosol * ncomponents_mass
-                CALL pmci_interp_sn( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),              &
-                                     kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  lg = 1, ngases_salsa
-                   CALL pmci_interp_sn( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),                 &
-                                        kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-    ENDIF       ! IF ( nesting_mode /= 'vertical' )
-!
-!-- All PEs are top-border PEs
-    CALL pmci_interp_t( w, wc, kctw, iflo, ifuo, jflo, jfuo, 'w' )
-    CALL pmci_interp_t( u, uc, kcto, iflu, ifuu, jflo, jfuo, 'u' )
-    CALL pmci_interp_t( v, vc, kcto, iflo, ifuo, jflv, jfuv, 'v' )
-!
-!-- Treatment of TKE. Interpolation is only required if parent and child operate in RANS mode,
-!-- else, interpolation is replaced by a Neumann condition.
-    IF ( rans_mode_parent  .AND.  rans_mode )  THEN
-       CALL pmci_interp_t( e, ec, kcto, iflo, ifuo, jflo, jfuo, 'e' )
-    ELSE
-       e(nzt+1,nys:nyn,nxl:nxr) = e(nzt,nys:nyn,nxl:nxr)
-    ENDIF
-
-    IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-       CALL pmci_interp_t( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, 's' )
-    ENDIF
-
-    IF ( .NOT. neutral )  THEN
-       CALL pmci_interp_t( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, 's' )
-    ENDIF
-
-    IF ( humidity )  THEN
-       CALL pmci_interp_t( q, q_c, kcto, iflo, ifuo, jflo, jfuo, 's' )
-       IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-          CALL pmci_interp_t( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, 's' )
-          CALL pmci_interp_t( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, 's' )
-       ENDIF
-       IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-          CALL pmci_interp_t( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, 's' )
-          CALL pmci_interp_t( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, 's' )
-       ENDIF
-    ENDIF
-
-    IF ( passive_scalar )  THEN
-       CALL pmci_interp_t( s, sc, kcto, iflo, ifuo, jflo, jfuo, 's' )
-    ENDIF
-
-    IF ( air_chemistry  .AND.  nesting_chem )  THEN
-       DO  n = 1, nspec
-          CALL pmci_interp_t( chem_species(n)%conc, chem_spec_c(:,:,:,n),                          &
-                              kcto, iflo, ifuo, jflo, jfuo, 's' )
-       ENDDO
-    ENDIF
-
-    IF ( salsa  .AND.  nesting_salsa )  THEN
-       DO  lb = 1, nbins_aerosol
-          CALL pmci_interp_t( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),                 &
-                              kcto, iflo, ifuo, jflo, jfuo, 's' )
-       ENDDO
-       DO  lc = 1, nbins_aerosol * ncomponents_mass
-          CALL pmci_interp_t( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),                     &
-                              kcto, iflo, ifuo, jflo, jfuo, 's' )
-       ENDDO
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-          DO  lg = 1, ngases_salsa
-             CALL pmci_interp_t( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),                        &
-                                 kcto, iflo, ifuo, jflo, jfuo, 's' )
-          ENDDO
-       ENDIF
-    ENDIF
-
- END SUBROUTINE pmci_interpolation
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> A wrapper routine for all anterpolation actions. Note that TKE is not anterpolated.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_anterpolation
- 
-    IMPLICIT NONE
-    INTEGER(iwp) ::  lb  !< running index for aerosol size bins
-    INTEGER(iwp) ::  lc  !< running index for aerosol mass bins
-    INTEGER(iwp) ::  lg  !< running index for salsa gases
-    INTEGER(iwp) ::  n   !< running index for number of chemical species
-
-
-    CALL pmci_anterp_var( u,  uc,  kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )
-    CALL pmci_anterp_var( v,  vc,  kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )
-    CALL pmci_anterp_var( w,  wc,  kctw, iflo, ifuo, jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' )
-!
-!-- Anterpolation of TKE and dissipation rate if parent and child are in
-!-- RANS mode.
-    IF ( rans_mode_parent  .AND.  rans_mode )  THEN
-       CALL pmci_anterp_var( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' )
-!
-!--    Anterpolation of dissipation rate only if TKE-e closure is applied.
-       IF ( rans_tke_e )  THEN
-          CALL pmci_anterp_var( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo,              &
-                                ijkfc_s, 'diss' )
-       ENDIF
-
-    ENDIF
-
-    IF ( .NOT. neutral )  THEN
-       CALL pmci_anterp_var( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'pt' )
-    ENDIF
-
-    IF ( humidity )  THEN
-
-       CALL pmci_anterp_var( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'q' )
-
-       IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-
-          CALL pmci_anterp_var( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'qc' )
-
-          CALL pmci_anterp_var( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'nc' )
-
-       ENDIF
-
-       IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-
-          CALL pmci_anterp_var( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'qr' )
-
-          CALL pmci_anterp_var( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'nr' )
-
-       ENDIF
-
-    ENDIF
-
-    IF ( passive_scalar )  THEN
-       CALL pmci_anterp_var( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
-    ENDIF
-
-    IF ( air_chemistry  .AND.  nesting_chem )  THEN
-       DO  n = 1, nspec
-          CALL pmci_anterp_var( chem_species(n)%conc, chem_spec_c(:,:,:,n),                        &
-                                kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
-       ENDDO
-    ENDIF
-
-    IF ( salsa  .AND.  nesting_salsa )  THEN
-       DO  lb = 1, nbins_aerosol
-          CALL pmci_anterp_var( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),               &
-                                kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
-       ENDDO
-       DO  lc = 1, nbins_aerosol * ncomponents_mass
-          CALL pmci_anterp_var( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),                   &
-                                kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
-       ENDDO
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-          DO  lg = 1, ngases_salsa
-             CALL pmci_anterp_var( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),                      &
-                                   kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
-          ENDDO
-       ENDIF
-    ENDIF
-
- END SUBROUTINE pmci_anterpolation
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interpolation of ghost-node values used as the child-domain boundary conditions. This subroutine
-!> handles the left and right boundaries.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_interp_lr( child_array, parent_array, kct, jfl, jfu, kfl, kfu, edge, var )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1), INTENT(IN) ::  edge  !< edge symbol: 'l' or 'r'
-    CHARACTER(LEN=1), INTENT(IN) ::  var   !< variable symbol: 'u', 'v', 'w' or 's'
-
-    INTEGER(iwp), INTENT(IN) ::  kct  !< the parent-grid index in z-direction just below the boundary value node
-
-    INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfl  !< indicates start index of child cells belonging to certain
-                                                            !< parent cell - y direction
-    INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfu  !< indicates end index of child cells belonging to certain
-                                                            !< parent cell - y direction
-    INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfl  !< indicates start index of child cells belonging to certain
-                                                            !< parent cell - z direction
-    INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfu  !< indicates end index of child cells belonging to certain
-                                                            !< parent cell - z direction
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  child_array  !< Child-grid array
-
-    REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(IN) ::  parent_array  !< Parent-grid array
-
-!
-!-- Local variables:
-    INTEGER(iwp) ::  icb    !< fixed child-grid index in the x-direction pointing to the node just behind the
-                            !< boundary-value node
-    INTEGER(iwp) ::  icbc   !< fixed child-grid index in the x-direction pointing to the boundary-value nodes
-    INTEGER(iwp) ::  icbgp  !< index running over the redundant boundary ghost points in the x-direction
-    INTEGER(iwp) ::  ierr   !< MPI error code
-    INTEGER(iwp) ::  ipbeg  !< parent-grid index in the x-direction pointing to the starting point of workarr_lr
-                            !< in the parent-grid array
-    INTEGER(iwp) ::  ipw    !< reduced parent-grid index in the x-direction for workarr_lr pointing to
-                            !< the boundary ghost node
-    INTEGER(iwp) ::  ipwp   !< reduced parent-grid index in the x-direction for workarr_lr pointing to
-                            !< the first prognostic node
-    INTEGER(iwp) ::  jc     !< running child-grid index in the y-direction
-    INTEGER(iwp) ::  jp     !< running parent-grid index in the y-direction
-    INTEGER(iwp) ::  kc     !< running child-grid index in the z-direction
-    INTEGER(iwp) ::  kp     !< running parent-grid index in the z-direction
-
-    REAL(wp) ::  cb          !< interpolation coefficient for the boundary ghost node
-    REAL(wp) ::  cp          !< interpolation coefficient for the first prognostic node
-    REAL(wp) ::  c_interp_1  !< value interpolated to the flux point in x direction from the parent-grid data
-    REAL(wp) ::  c_interp_2  !< auxiliary value interpolated  to the flux point in x direction from the parent-grid data
-    
-!
-!-- Check which edge is to be handled
-    IF ( edge == 'l' )  THEN
-!
-!--    For u, nxl is a ghost node, but not for the other variables
-       IF ( var == 'u' )  THEN
-          icbc  = nxl
-          icb   = icbc - 1
-          ipw   = 2
-          ipwp  = ipw        ! This is redundant when var == 'u'
-          ipbeg = ipl
-       ELSE
-          icbc  = nxl - 1
-          icb   = icbc - 1
-          ipw   = 1
-          ipwp  = 2
-          ipbeg = ipl
-       ENDIF
-    ELSEIF ( edge == 'r' )  THEN
-       IF ( var == 'u' )  THEN
-          icbc  = nxr + 1
-          icb   = icbc + 1
-          ipw   = 1
-          ipwp  = ipw        ! This is redundant when var == 'u'
-          ipbeg = ipr - 2
-       ELSE
-          icbc  = nxr + 1
-          icb   = icbc + 1
-          ipw   = 1
-          ipwp  = 0
-          ipbeg = ipr - 2
-       ENDIF
-    ENDIF
-!
-!-- Interpolation coefficients
-    IF ( interpolation_scheme_lrsn == 1 )  THEN
-       cb = 1.0_wp  ! 1st-order upwind
-    ELSE IF ( interpolation_scheme_lrsn == 2 )  THEN
-       cb = 0.5_wp  ! 2nd-order central
-    ELSE
-       cb = 0.5_wp  ! 2nd-order central (default)
-    ENDIF
-    cp = 1.0_wp - cb
-!
-!-- Substitute the necessary parent-grid data to the work array workarr_lr.
-    workarr_lr = 0.0_wp
-    IF ( pdims(2) > 1 )  THEN
-
-       IF ( bc_dirichlet_s )  THEN
-          workarr_lr(0:pg%nz+1,jpsw:jpnw-1,0:2) = parent_array(0:pg%nz+1,jpsw:jpnw-1,ipbeg:ipbeg+2)
-       ELSE IF ( bc_dirichlet_n )  THEN
-          workarr_lr(0:pg%nz+1,jpsw+1:jpnw,0:2) = parent_array(0:pg%nz+1,jpsw+1:jpnw,ipbeg:ipbeg+2)
-       ELSE
-          workarr_lr(0:pg%nz+1,jpsw+1:jpnw-1,0:2) = parent_array(0:pg%nz+1,jpsw+1:jpnw-1,          &
-                                                                 ipbeg:ipbeg+2)
-       ENDIF
-!
-!--    South-north exchange if more than one PE subdomain in the y-direction. Note that in case of
-!--    3-D nesting the south (psouth == MPI_PROC_NULL) and north (pnorth == MPI_PROC_NULL)
-!--    boundaries are not exchanged because the nest domain is not cyclic.
-!--    From south to north
-       CALL MPI_SENDRECV( workarr_lr(0,jpsw+1,0), 1, workarr_lr_exchange_type, psouth,  0,         &
-                          workarr_lr(0,jpnw,0), 1, workarr_lr_exchange_type, pnorth,  0, comm2d,   &
-                          status, ierr )
-!
-!--    From north to south
-       CALL MPI_SENDRECV( workarr_lr(0,jpnw-1,0), 1, workarr_lr_exchange_type, pnorth,  1,         &
-                          workarr_lr(0,jpsw,0), 1, workarr_lr_exchange_type, psouth,  1, comm2d,   &
-                          status, ierr )
-
-    ELSE
-       workarr_lr(0:pg%nz+1,jpsw:jpnw,0:2) = parent_array(0:pg%nz+1,jpsw:jpnw,ipbeg:ipbeg+2)
-    ENDIF
-
-    IF ( var == 'u' )  THEN
-
-       DO  jp = jpsw, jpnw
-          DO  kp = 0, kct
-
-             DO  jc = jfl(jp), jfu(jp)
-                DO  kc = kfl(kp), kfu(kp)
-                   child_array(kc,jc,icbc) = workarr_lr(kp,jp,ipw)
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ELSE IF ( var == 'v' )  THEN
-
-       DO  jp = jpsw, jpnw-1
-          DO  kp = 0, kct
-!
-!--          First interpolate to the flux point
-             c_interp_1 = cb * workarr_lr(kp,jp,ipw)   + cp * workarr_lr(kp,jp,ipwp)
-             c_interp_2 = cb * workarr_lr(kp,jp+1,ipw) + cp * workarr_lr(kp,jp+1,ipwp)
-!
-!--          Use averages of the neighbouring matching grid-line values
-             DO  jc = jfl(jp), jfl(jp+1)
-                child_array(kfl(kp):kfu(kp),jc,icbc) = 0.5_wp * ( c_interp_1 + c_interp_2 )
-             ENDDO
-!
-!--          Then set the values along the matching grid-lines
-             IF  ( MOD( jfl(jp), jgsr ) == 0 )  THEN
-                child_array(kfl(kp):kfu(kp),jfl(jp),icbc) = c_interp_1
-             ENDIF
-          ENDDO
-       ENDDO
-!
-!--    Finally, set the values along the last matching grid-line
-       IF ( MOD( jfl(jpnw), jgsr ) == 0 )  THEN
-          DO  kp = 0, kct
-             c_interp_1 = cb * workarr_lr(kp,jpnw,ipw) + cp * workarr_lr(kp,jpnw,ipwp)
-             child_array(kfl(kp):kfu(kp),jfl(jpnw),icbc) = c_interp_1
-          ENDDO
-       ENDIF
-!
-!--    A gap may still remain in some cases if the subdomain size is not divisible by the
-!--    grid-spacing ratio. In such a case, fill the gap. Note however, this operation may produce
-!--    some additional momentum conservation error.
-       IF ( jfl(jpnw) < nyn )  THEN
-          DO  kp = 0, kct
-             DO  jc = jfl(jpnw) + 1, nyn
-                child_array(kfl(kp):kfu(kp),jc,icbc) = child_array(kfl(kp):kfu(kp),jfl(jpnw),icbc)
-             ENDDO
-          ENDDO
-       ENDIF
-
-    ELSE IF ( var == 'w' )  THEN
-
-       DO  jp = jpsw, jpnw
-          DO  kp = 0, kct + 1   ! It is important to go up to kct+1
-!
-!--          Interpolate to the flux point
-             c_interp_1 = cb * workarr_lr(kp,jp,ipw) + cp * workarr_lr(kp,jp,ipwp)
-!
-!--          First substitute only the matching-node values
-             child_array(kfu(kp),jfl(jp):jfu(jp),icbc) = c_interp_1
-
-          ENDDO
-       ENDDO
-
-       DO  jp = jpsw, jpnw
-          DO  kp = 1, kct + 1   ! It is important to go up to kct+1
-!
-!--          Then fill up the nodes in between with the averages
-             DO  kc = kfu(kp-1) + 1, kfu(kp) - 1
-                child_array(kc,jfl(jp):jfu(jp),icbc) = 0.5_wp * ( child_array(kfu(kp-1),           &
-                                                                  jfl(jp):jfu(jp),icbc)            &
-                                                       + child_array(kfu(kp),jfl(jp):jfu(jp),icbc) )
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ELSE   ! Any scalar
-
-       DO  jp = jpsw, jpnw
-          DO  kp = 0, kct
-!
-!--          Interpolate to the flux point
-             c_interp_1 = cb * workarr_lr(kp,jp,ipw) + cp * workarr_lr(kp,jp,ipwp)
-             DO  jc = jfl(jp), jfu(jp)
-                DO  kc = kfl(kp), kfu(kp)
-                   child_array(kc,jc,icbc) = c_interp_1
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ENDIF  ! var
-!
-!-- Fill up also the redundant 2nd and 3rd ghost-node layers
-    IF ( edge == 'l' )  THEN
-       DO  icbgp = -nbgp, icb
-          child_array(0:nzt+1,nysg:nyng,icbgp) = child_array(0:nzt+1,nysg:nyng,icbc)
-       ENDDO
-    ELSEIF ( edge == 'r' )  THEN
-       DO  icbgp = icb, nx+nbgp
-          child_array(0:nzt+1,nysg:nyng,icbgp) = child_array(0:nzt+1,nysg:nyng,icbc)
-       ENDDO
-    ENDIF
-
- END SUBROUTINE pmci_interp_lr
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interpolation of ghost-node values used as the child-domain boundary conditions. This subroutine
-!> handles the south and north boundaries.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_interp_sn( child_array, parent_array, kct, ifl, ifu, kfl, kfu, edge, var )
- 
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1), INTENT(IN) ::  edge  !< edge symbol: 's' or 'n'
-    CHARACTER(LEN=1), INTENT(IN) ::  var   !< variable symbol: 'u', 'v', 'w' or 's'
-
-    INTEGER(iwp), INTENT(IN) ::  kct  !< the parent-grid index in z-direction just below the boundary value node
-
-    INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifl  !< indicates start index of child cells belonging to certain
-                                                            !< parent cell - x direction
-    INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifu  !< indicates end index of child cells belonging to certain
-                                                            !< parent cell - x direction
-    INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfl  !< indicates start index of child cells belonging to certain
-                                                            !< parent cell - z direction
-    INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfu  !< indicates end index of child cells belonging to certain
-                                                            !< parent cell - z direction
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  child_array  !< Child-grid array
-
-    REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(IN) ::  parent_array  !< Parent-grid array
-!
-!-- Local variables:
-    INTEGER(iwp) ::  ic     !< running child-grid index in the x-direction
-    INTEGER(iwp) ::  ierr   !< MPI error code
-    INTEGER(iwp) ::  ip     !< running parent-grid index in the x-direction
-    INTEGER(iwp) ::  jcb    !< fixed child-grid index in the y-direction pointing to the node just behind the
-                            !< boundary-value node
-    INTEGER(iwp) ::  jcbc   !< fixed child-grid index in the y-direction pointing to the boundary-value nodes
-    INTEGER(iwp) ::  jcbgp  !< index running over the redundant boundary ghost points in y-direction
-    INTEGER(iwp) ::  jpbeg  !< parent-grid index in the y-direction pointing to the starting point of workarr_sn
-                            !< in the parent-grid array
-    INTEGER(iwp) ::  jpw    !< reduced parent-grid index in the y-direction for workarr_sn pointing to
-                            !< the boundary ghost node
-    INTEGER(iwp) ::  jpwp   !< reduced parent-grid index in the y-direction for workarr_sn pointing to
-                            !< the first prognostic node
-    INTEGER(iwp) ::  kc     !< running child-grid index in the z-direction
-    INTEGER(iwp) ::  kp     !< running parent-grid index in the z-direction
-
-    REAL(wp) ::  cb          !< interpolation coefficient for the boundary ghost node
-    REAL(wp) ::  cp          !< interpolation coefficient for the first prognostic node
-    REAL(wp) ::  c_interp_1  !< value interpolated to the flux point in x direction from the parent-grid data
-    REAL(wp) ::  c_interp_2  !< auxiliary value interpolated  to the flux point in x direction from the parent-grid data
-
-!
-!-- Check which edge is to be handled: south or north
-    IF ( edge == 's' )  THEN
-!
-!--    For v, nys is a ghost node, but not for the other variables
-       IF ( var == 'v' )  THEN
-          jcbc  = nys
-          jcb   = jcbc - 1
-          jpw   = 2
-          jpwp  = 2         ! This is redundant when var == 'v'
-          jpbeg = jps
-       ELSE
-          jcbc  = nys - 1
-          jcb   = jcbc - 1
-          jpw   = 1
-          jpwp  = 2
-          jpbeg = jps
-       ENDIF
-    ELSEIF ( edge == 'n' )  THEN
-       IF ( var == 'v' )  THEN
-          jcbc  = nyn + 1
-          jcb   = jcbc + 1
-          jpw   = 1
-          jpwp  = 0         ! This is redundant when var == 'v'
-          jpbeg = jpn - 2
-       ELSE
-          jcbc  = nyn + 1
-          jcb   = jcbc + 1
-          jpw   = 1
-          jpwp  = 0
-          jpbeg = jpn - 2
-       ENDIF
-    ENDIF
-!
-!-- Interpolation coefficients
-    IF ( interpolation_scheme_lrsn == 1 )  THEN
-       cb = 1.0_wp  ! 1st-order upwind
-    ELSE IF ( interpolation_scheme_lrsn == 2 )  THEN
-       cb = 0.5_wp  ! 2nd-order central
-    ELSE
-       cb = 0.5_wp  ! 2nd-order central (default)
-    ENDIF
-    cp = 1.0_wp - cb
-!
-!-- Substitute the necessary parent-grid data to the work array workarr_sn.
-    workarr_sn = 0.0_wp
-    IF ( pdims(1) > 1 )  THEN
-
-       IF ( bc_dirichlet_l )  THEN
-          workarr_sn(0:pg%nz+1,0:2,iplw:iprw-1) = parent_array(0:pg%nz+1,jpbeg:jpbeg+2,iplw:iprw-1)
-       ELSE IF ( bc_dirichlet_r )  THEN
-          workarr_sn(0:pg%nz+1,0:2,iplw+1:iprw) = parent_array(0:pg%nz+1,jpbeg:jpbeg+2,iplw+1:iprw)
-       ELSE
-          workarr_sn(0:pg%nz+1,0:2,iplw+1:iprw-1) = parent_array(0:pg%nz+1,jpbeg:jpbeg+2,          &
-                                                                 iplw+1:iprw-1)
-       ENDIF
-!
-!--    Left-right exchange if more than one PE subdomain in the x-direction. Note that in case of
-!--    3-D nesting the left (pleft == MPI_PROC_NULL) and right (pright == MPI_PROC_NULL) boundaries
-!--    are not exchanged because the nest domain is not cyclic.
-!--    From left to right
-       CALL MPI_SENDRECV( workarr_sn(0,0,iplw+1), 1, workarr_sn_exchange_type, pleft,   0,         &
-                          workarr_sn(0,0,iprw), 1, workarr_sn_exchange_type, pright, 0, comm2d,    &
-                          status, ierr )
-!
-!--    From right to left
-       CALL MPI_SENDRECV( workarr_sn(0,0,iprw-1), 1, workarr_sn_exchange_type, pright,  1,         &
-                          workarr_sn(0,0,iplw), 1, workarr_sn_exchange_type, pleft, 1, comm2d,     &
-                          status, ierr )
-
-    ELSE
-       workarr_sn(0:pg%nz+1,0:2,iplw:iprw) = parent_array(0:pg%nz+1,jpbeg:jpbeg+2,iplw:iprw)
-    ENDIF
-
-    IF ( var == 'v' )  THEN
-
-       DO  ip = iplw, iprw
-          DO  kp = 0, kct
-
-             DO  ic = ifl(ip), ifu(ip)
-                DO  kc = kfl(kp), kfu(kp)
-                   child_array(kc,jcbc,ic) = workarr_sn(kp,jpw,ip)
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ELSE IF ( var == 'u' )  THEN
-
-       DO  ip = iplw, iprw - 1
-          DO  kp = 0, kct
-!
-!--          First interpolate to the flux point
-             c_interp_1 = cb * workarr_sn(kp,jpw,ip)   + cp * workarr_sn(kp,jpwp,ip)
-             c_interp_2 = cb * workarr_sn(kp,jpw,ip+1) + cp * workarr_sn(kp,jpwp,ip+1)
-!
-!--          Use averages of the neighbouring matching grid-line values
-             DO  ic = ifl(ip), ifl(ip+1)
-                child_array(kfl(kp):kfu(kp),jcbc,ic) = 0.5_wp * ( c_interp_1 + c_interp_2 )
-             ENDDO
-!
-!--          Then set the values along the matching grid-lines
-             IF ( MOD( ifl(ip), igsr ) == 0 )  THEN
-                child_array(kfl(kp):kfu(kp),jcbc,ifl(ip)) = c_interp_1
-             ENDIF
-
-          ENDDO
-       ENDDO
-!
-!--    Finally, set the values along the last matching grid-line
-       IF ( MOD( ifl(iprw), igsr ) == 0 )  THEN
-          DO  kp = 0, kct
-             c_interp_1 = cb * workarr_sn(kp,jpw,iprw) + cp * workarr_sn(kp,jpwp,iprw)
-             child_array(kfl(kp):kfu(kp),jcbc,ifl(iprw)) = c_interp_1
-          ENDDO
-       ENDIF
-!
-!--    A gap may still remain in some cases if the subdomain size is not divisible by the
-!--    grid-spacing ratio. In such a case, fill the gap. Note however, this operation may produce
-!--    some additional momentum conservation error.
-       IF ( ifl(iprw) < nxr )  THEN
-          DO  kp = 0, kct
-             DO  ic = ifl(iprw) + 1, nxr
-                child_array(kfl(kp):kfu(kp),jcbc,ic) = child_array(kfl(kp):kfu(kp),jcbc,ifl(iprw))
-             ENDDO
-          ENDDO
-       ENDIF
-
-    ELSE IF ( var == 'w' )  THEN
-
-       DO  ip = iplw, iprw
-          DO  kp = 0, kct + 1   ! It is important to go up to kct+1
-!
-!--          Interpolate to the flux point
-             c_interp_1 = cb * workarr_sn(kp,jpw,ip) + cp * workarr_sn(kp,jpwp,ip)
-!
-!--          First substitute only the matching-node values
-             child_array(kfu(kp),jcbc,ifl(ip):ifu(ip)) = c_interp_1
-
-          ENDDO
-       ENDDO
-
-       DO  ip = iplw, iprw
-          DO  kp = 1, kct + 1   ! It is important to go up to kct + 1
-!
-!--          Then fill up the nodes in between with the averages
-             DO  kc = kfu(kp-1) + 1, kfu(kp) - 1
-                child_array(kc,jcbc,ifl(ip):ifu(ip)) = 0.5_wp * ( child_array(kfu(kp-1),           &
-                                                                  jcbc,ifl(ip):ifu(ip))            &
-                                                       + child_array(kfu(kp),jcbc,ifl(ip):ifu(ip)) )
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ELSE   ! Any scalar
-
-       DO  ip = iplw, iprw
-          DO  kp = 0, kct
-!
-!--          Interpolate to the flux point
-             c_interp_1 = cb * workarr_sn(kp,jpw,ip) + cp * workarr_sn(kp,jpwp,ip)
-             DO  ic = ifl(ip), ifu(ip)
-                DO  kc = kfl(kp), kfu(kp)
-                   child_array(kc,jcbc,ic) = c_interp_1
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ENDIF  ! var
-!
-!-- Fill up also the redundant 2nd and 3rd ghost-node layers
-    IF ( edge == 's' )  THEN
-       DO  jcbgp = -nbgp, jcb
-          child_array(0:nzt+1,jcbgp,nxlg:nxrg) = child_array(0:nzt+1,jcbc,nxlg:nxrg)
-       ENDDO
-    ELSEIF ( edge == 'n' )  THEN
-       DO  jcbgp = jcb, ny+nbgp
-          child_array(0:nzt+1,jcbgp,nxlg:nxrg) = child_array(0:nzt+1,jcbc,nxlg:nxrg)
-       ENDDO
-    ENDIF
-
- END SUBROUTINE pmci_interp_sn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interpolation of ghost-node values used as the child-domain boundary conditions. This subroutine
-!> handles the top boundary.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_interp_t( child_array, parent_array, kct, ifl, ifu, jfl, jfu, var )
- 
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1), INTENT(IN) ::  var  !< variable symbol: 'u', 'v', 'w' or 's'
-
-    INTEGER(iwp), INTENT(IN) ::  kct  !< the parent-grid index in z-direction just below the boundary value node
-
-    INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifl  !< indicates start index of child cells belonging to certain
-                                                            !< parent cell - x direction
-    INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifu  !< indicates end index of child cells belonging to certain
-                                                            !< parent cell - x direction
-    INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfl  !< indicates start index of child cells belonging to certain
-                                                            !< parent cell - y direction
-    INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfu  !< indicates end index of child cells belonging to certain
-                                                            !< parent cell - y direction
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  child_array  !< Child-grid array
-
-    REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(IN) ::  parent_array  !< Parent-grid array
-
-!
-!-- Local variables:
-    INTEGER(iwp) ::  ic          !< running child-grid index in the x-direction
-    INTEGER(iwp) ::  ierr        !< MPI error code
-    INTEGER(iwp) ::  iplc        !< lower parent-grid index limit in the x-direction for copying parent-grid
-                                 !< array data to workarr_t
-    INTEGER(iwp) ::  iprc        !< upper parent-grid index limit in the x-direction for copying parent-grid
-                                 !< array data to workarr_t
-    INTEGER(iwp) ::  jc          !< running child-grid index in the y-direction
-    INTEGER(iwp) ::  jpsc        !< lower parent-grid index limit in the y-direction for copying parent-grid
-                                 !< array data to workarr_t
-    INTEGER(iwp) ::  jpnc        !< upper parent-grid-index limit in the y-direction for copying parent-grid
-                                 !< array data to workarr_t
-    INTEGER(iwp) ::  kc          !< vertical child-grid index fixed to the boundary-value level
-    INTEGER(iwp) ::  ip          !< running parent-grid index in the x-direction
-    INTEGER(iwp) ::  jp          !< running parent-grid index in the y-direction
-    INTEGER(iwp) ::  kpw         !< reduced parent-grid index in the z-direction for workarr_t pointing to
-                                 !< the boundary ghost node
-
-    REAL(wp) ::  c31         !< interpolation coefficient for the 3rd-order WS scheme
-    REAL(wp) ::  c32         !< interpolation coefficient for the 3rd-order WS scheme
-    REAL(wp) ::  c33         !< interpolation coefficient for the 3rd-order WS scheme
-    REAL(wp) ::  c_interp_1  !< value interpolated to the flux point in z direction from the parent-grid data
-    REAL(wp) ::  c_interp_2  !< auxiliary value interpolated to the flux point in z direction from the parent-grid data
-
-
-    IF ( var == 'w' )  THEN
-       kc = nzt
-    ELSE
-       kc = nzt + 1
-    ENDIF
-    kpw = 1
-!
-!-- Interpolation coefficients
-    IF ( interpolation_scheme_t == 1 )  THEN
-       c31 =  0.0_wp           ! 1st-order upwind
-       c32 =  1.0_wp
-       c33 =  0.0_wp
-    ELSE IF ( interpolation_scheme_t == 2 )  THEN
-       c31 =  0.5_wp           ! 2nd-order central
-       c32 =  0.5_wp
-       c33 =  0.0_wp
-    ELSE
-       c31 =  2.0_wp / 6.0_wp  ! 3rd-order WS upwind biased (default)
-       c32 =  5.0_wp / 6.0_wp
-       c33 = -1.0_wp / 6.0_wp
-    ENDIF
-!
-!-- Substitute the necessary parent-grid data to the work array. Note that the dimension of
-!-- workarr_t is (0:2,jpsw:jpnw,iplw:iprw) and the jc?w and ic?w-index bounds depend on the location
-!-- of the PE-subdomain relative to the side boundaries.
-    iplc = iplw + 1
-    iprc = iprw - 1
-    jpsc = jpsw + 1
-    jpnc = jpnw - 1
-    IF ( bc_dirichlet_l )  THEN
-       iplc = iplw
-    ENDIF
-    IF ( bc_dirichlet_r )  THEN
-       iprc = iprw
-    ENDIF
-    IF ( bc_dirichlet_s )  THEN
-       jpsc = jpsw
-    ENDIF
-    IF ( bc_dirichlet_n )  THEN
-       jpnc = jpnw
-    ENDIF
-    workarr_t = 0.0_wp
-    workarr_t(0:2,jpsc:jpnc,iplc:iprc) = parent_array(kct:kct+2,jpsc:jpnc,iplc:iprc)
-!
-!-- Left-right exchange if more than one PE subdomain in the x-direction. Note that in case of 3-D
-!-- nesting the left and right boundaries are not exchanged because the nest domain is not cyclic.
-    IF ( pdims(1) > 1 )  THEN
-!
-!--    From left to right
-       CALL MPI_SENDRECV( workarr_t(0,jpsw,iplw+1), 1, workarr_t_exchange_type_y, pleft, 0,        &
-                          workarr_t(0,jpsw,iprw), 1, workarr_t_exchange_type_y, pright, 0,         &
-                          comm2d, status, ierr )
-!
-!--    From right to left
-       CALL MPI_SENDRECV( workarr_t(0,jpsw,iprw-1), 1, workarr_t_exchange_type_y, pright, 1,       &
-                          workarr_t(0,jpsw,iplw), 1, workarr_t_exchange_type_y, pleft,  1,         &
-                          comm2d, status, ierr )
-    ENDIF
-!
-!-- South-north exchange if more than one PE subdomain in the y-direction.
-!-- Note that in case of 3-D nesting the south and north boundaries are not exchanged because the
-!-- nest domain is not cyclic.
-    IF ( pdims(2) > 1 )  THEN
-!
-!--    From south to north
-       CALL MPI_SENDRECV( workarr_t(0,jpsw+1,iplw), 1, workarr_t_exchange_type_x, psouth, 2,       &
-                          workarr_t(0,jpnw,iplw), 1, workarr_t_exchange_type_x, pnorth, 2,         &
-                          comm2d, status, ierr )
-!
-!--    From north to south
-       CALL MPI_SENDRECV( workarr_t(0,jpnw-1,iplw), 1, workarr_t_exchange_type_x, pnorth, 3,       &
-                          workarr_t(0,jpsw,iplw), 1, workarr_t_exchange_type_x, psouth, 3,         &
-                          comm2d, status, ierr )
-    ENDIF
-
-    IF  ( var == 'w' )  THEN
-       DO  ip = iplw, iprw
-          DO  jp = jpsw, jpnw
-
-             DO  ic = ifl(ip), ifu(ip)
-                DO  jc = jfl(jp), jfu(jp)
-                   child_array(kc,jc,ic) = workarr_t(kpw,jp,ip)
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ELSE IF  ( var == 'u' )  THEN
-
-       DO  ip = iplw, iprw - 1
-          DO  jp = jpsw, jpnw
-!
-!--          First interpolate to the flux point using the 3rd-order WS scheme
-             c_interp_1 = c31 * workarr_t(kpw-1,jp,ip)   + c32 * workarr_t(kpw,jp,ip)              &
-                        + c33 * workarr_t(kpw+1,jp,ip)
-             c_interp_2 = c31 * workarr_t(kpw-1,jp,ip+1) + c32 * workarr_t(kpw,jp,ip+1)            &
-                        + c33 * workarr_t(kpw+1,jp,ip+1)
-!
-!--          Use averages of the neighbouring matching grid-line values
-             DO  ic = ifl(ip), ifl(ip+1)
-                child_array(kc,jfl(jp):jfu(jp),ic) = 0.5_wp * ( c_interp_1 + c_interp_2 )
-             ENDDO
-!
-!--          Then set the values along the matching grid-lines
-             IF ( MOD( ifl(ip), igsr ) == 0 )  THEN
-!
-!--             First interpolate to the flux point using the 3rd-order WS scheme
-                c_interp_1 = c31 * workarr_t(kpw-1,jp,ip) + c32 * workarr_t(kpw,jp,ip)             &
-                           + c33 * workarr_t(kpw+1,jp,ip)
-                child_array(kc,jfl(jp):jfu(jp),ifl(ip)) = c_interp_1
-             ENDIF
-
-          ENDDO
-       ENDDO
-!
-!--    Finally, set the values along the last matching grid-line
-       IF  ( MOD( ifl(iprw), igsr ) == 0 )  THEN
-          DO  jp = jpsw, jpnw
-!
-!--          First interpolate to the flux point using the 3rd-order WS scheme
-             c_interp_1 = c31 * workarr_t(kpw-1,jp,iprw) + c32 * workarr_t(kpw,jp,iprw)            &
-                        + c33 * workarr_t(kpw+1,jp,iprw)
-             child_array(kc,jfl(jp):jfu(jp),ifl(iprw)) = c_interp_1
-          ENDDO
-       ENDIF
-!
-!--    A gap may still remain in some cases if the subdomain size is not divisible by the
-!--    grid-spacing ratio. In such a case, fill the gap. Note however, this operation may produce
-!--    some additional momentum conservation error.
-       IF ( ifl(iprw) < nxr )  THEN
-          DO  jp = jpsw, jpnw
-             DO  ic = ifl(iprw) + 1, nxr
-                child_array(kc,jfl(jp):jfu(jp),ic) = child_array(kc,jfl(jp):jfu(jp),ifl(iprw))
-             ENDDO
-          ENDDO
-       ENDIF
-
-    ELSE IF  ( var == 'v' )  THEN
-
-       DO  ip = iplw, iprw
-          DO  jp = jpsw, jpnw-1
-!
-!--          First interpolate to the flux point using the 3rd-order WS scheme
-             c_interp_1 = c31 * workarr_t(kpw-1,jp,ip)   + c32 * workarr_t(kpw,jp,ip)              &
-                        + c33 * workarr_t(kpw+1,jp,ip)
-             c_interp_2 = c31 * workarr_t(kpw-1,jp+1,ip) + c32 * workarr_t(kpw,jp+1,ip)            &
-                        + c33 * workarr_t(kpw+1,jp+1,ip)
-!
-!--          Use averages of the neighbouring matching grid-line values
-             DO  jc = jfl(jp), jfl(jp+1)
-                child_array(kc,jc,ifl(ip):ifu(ip)) = 0.5_wp * ( c_interp_1 + c_interp_2 )
-             ENDDO
-!
-!--          Then set the values along the matching grid-lines
-             IF ( MOD( jfl(jp), jgsr ) == 0 )  THEN
-                c_interp_1 = c31 * workarr_t(kpw-1,jp,ip) + c32 * workarr_t(kpw,jp,ip)             &
-                           + c33 * workarr_t(kpw+1,jp,ip)
-                child_array(kc,jfl(jp),ifl(ip):ifu(ip)) = c_interp_1
-             ENDIF
-
-          ENDDO
-
-       ENDDO
-!
-!--    Finally, set the values along the last matching grid-line
-       IF ( MOD( jfl(jpnw), jgsr ) == 0 )  THEN
-          DO  ip = iplw, iprw
-!
-!--          First interpolate to the flux point using the 3rd-order WS scheme
-             c_interp_1 = c31 * workarr_t(kpw-1,jpnw,ip) + c32 * workarr_t(kpw,jpnw,ip)            &
-                        + c33 * workarr_t(kpw+1,jpnw,ip)
-             child_array(kc,jfl(jpnw),ifl(ip):ifu(ip)) = c_interp_1
-          ENDDO
-       ENDIF
-!
-!--    A gap may still remain in some cases if the subdomain size is not divisible by the
-!--    grid-spacing ratio. In such a case, fill the gap. Note however, this operation may produce
-!--    some additional momentum conservation error.
-       IF  ( jfl(jpnw) < nyn )  THEN
-          DO  ip = iplw, iprw
-             DO  jc = jfl(jpnw)+1, nyn
-                child_array(kc,jc,ifl(ip):ifu(ip)) = child_array(kc,jfl(jpnw),ifl(ip):ifu(ip))
-             ENDDO
-          ENDDO
-       ENDIF
-
-    ELSE  ! Any scalar variable
-
-       DO  ip = iplw, iprw
-          DO  jp = jpsw, jpnw
-!
-!--          First interpolate to the flux point using the 3rd-order WS scheme
-             c_interp_1 = c31 * workarr_t(kpw-1,jp,ip) + c32 * workarr_t(kpw,jp,ip)                &
-                        + c33 * workarr_t(kpw+1,jp,ip)
-             DO  ic = ifl(ip), ifu(ip)
-                DO  jc = jfl(jp), jfu(jp)
-                   child_array(kc,jc,ic) = c_interp_1
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ENDIF  ! var
-!
-!-- Just fill up the redundant second ghost-node layer in case of var == w.
-    IF ( var == 'w' )  THEN
-       child_array(nzt+1,:,:) = child_array(nzt,:,:)
-    ENDIF
-
- END SUBROUTINE pmci_interp_t
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Anterpolation of internal-node values of one variable to be used as the parent-domain values. 
-!> This subroutine is based on the first-order numerical integration of the child-grid values 
-!> contained within the anterpolation cell (Clark & Farley, Journal of the Atmospheric
-!> Sciences 41(3), 1984).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_anterp_var( child_array, parent_array, kct, ifl, ifu, jfl, jfu, kfl, kfu,         &
-                             ijkfc, var )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  var  !< variable symbol: 'u', 'v', 'w' or 's'
-
-    INTEGER(iwp), INTENT(IN) ::  kct  !< top boundary index for anterpolation along z
-
-    INTEGER(iwp), DIMENSION(0:pg%nz+1,jpsa:jpna,ipla:ipra), INTENT(IN) ::  ijkfc  !< number of child grid points contributing
-                                                                                  !< to a parent grid box
-    INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifl  !< indicates start index of child cells belonging to certain
-                                                            !< parent cell - x direction
-    INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifu  !< indicates end index of child cells belonging to certain
-                                                            !< parent cell - x direction
-    INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfl  !< indicates start index of child cells belonging to certain
-                                                            !< parent cell - y direction
-    INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfu  !< indicates end index of child cells belonging to certain
-                                                            !< parent cell - y direction
-    INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfl  !< indicates start index of child cells belonging to certain
-                                                            !< parent cell - z direction
-    INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfu  !< indicates end index of child cells belonging to certain
-                                                            !< parent cell - z direction
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  child_array  !< child-grid array
-
-    REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(INOUT) ::  parent_array  !< parent-grid array
-
-!
-!-- Local variables:
-    INTEGER(iwp) ::  ic              !< running index x-direction - child grid
-    INTEGER(iwp) ::  ip              !< running index x-direction - parent grid
-    INTEGER(iwp) ::  ipl_anterp      !< left boundary index for anterpolation along x
-    INTEGER(iwp) ::  ipr_anterp      !< right boundary index for anterpolation along x
-    INTEGER(iwp) ::  jc              !< running index y-direction - child grid
-    INTEGER(iwp) ::  jp              !< running index y-direction - parent grid
-    INTEGER(iwp) ::  jpn_anterp      !< north boundary index for anterpolation along y
-    INTEGER(iwp) ::  jps_anterp      !< south boundary index for anterpolation along y
-    INTEGER(iwp) ::  kc              !< running index z-direction - child grid
-    INTEGER(iwp) ::  kp              !< running index z-direction - parent grid
-    INTEGER(iwp) ::  kpt_anterp      !< top boundary index for anterpolation along z
-    INTEGER(iwp) ::  var_flag        !< bit number used to flag topography on respective grid
-
-    REAL(wp) ::  cellsum  !< sum of respective child cells belonging to parent cell
-
-!
-!-- Define the index bounds ipl_anterp, ipr_anterp, jps_anterp and jpn_anterp.
-!-- Note that kcb_anterp is simply zero and kct_anterp depends on kct which enters here as a
-!-- parameter and it is determined in pmci_define_index_mapping. Note that the grid points directly
-!-- used also for interpolation (from parent to child) are always excluded from anterpolation, e.g.
-!-- anterpolation is maximally only from 0:kct-1, since kct is directly used for interpolation.
-!-- Similar restriction is applied to the lateral boundaries as well. An additional buffer is also
-!-- applied (default value for anterpolation_buffer_width = 2) in order to avoid unphysical
-!-- accumulation of kinetic energy.
-    ipl_anterp = ipl
-    ipr_anterp = ipr
-    jps_anterp = jps
-    jpn_anterp = jpn
-!
-!-- kpb_anterp is a function of jp and ip and it is set in the initialization phase in 
-!-- pmci_compute_kpb_anterp.
-    kpt_anterp = kct - 1 - anterpolation_buffer_width
-
-    IF ( nesting_mode /= 'vertical' )  THEN
-!
-!--    Set the anterpolation buffers on the lateral boundaries
-       ipl_anterp = MAX( ipl, iplg + 3 + anterpolation_buffer_width )
-       ipr_anterp = MIN( ipr, iprg - 3 - anterpolation_buffer_width )
-       jps_anterp = MAX( jps, jpsg + 3 + anterpolation_buffer_width )
-       jpn_anterp = MIN( jpn, jpng - 3 - anterpolation_buffer_width )
-
-    ENDIF
-!
-!-- Set masking bit for topography flags
-    IF ( var == 'u' )  THEN
-       var_flag = 1
-    ELSEIF ( var == 'v' )  THEN
-       var_flag = 2
-    ELSEIF ( var == 'w' )  THEN
-       var_flag = 3
-    ELSE
-       var_flag = 0
-    ENDIF
-!
-!-- Note that ip, jp, and kp are parent-grid indices and ic,jc, and kc are child-grid indices.
-    DO  ip = ipl_anterp, ipr_anterp
-       DO  jp = jps_anterp, jpn_anterp
-!
-!--       If the user has set anterpolation_starting_height less than the canopy height, the 
-!--       anterpolation is made also within buildings for simplicity, and even under elevated 
-!--       terrain if anterpolation_starting_height is set smaller than terrain height.
-          DO  kp = kpb_anterp(jp,ip), kpt_anterp
-             cellsum = 0.0_wp
-             DO  ic = ifl(ip), ifu(ip)
-                DO  jc = jfl(jp), jfu(jp)
-                   DO  kc = kfl(kp), kfu(kp)
-                      cellsum = cellsum + MERGE( child_array(kc,jc,ic), 0.0_wp,                    &
-                                                 BTEST( wall_flags_total_0(kc,jc,ic), var_flag ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-!
-!--          In case all child grid points are inside topography, i.e. ijkfc and cellsum are zero,
-!--          also parent solution would have zero values at that grid point, which may cause
-!--          problems in particular for the temperature. Therefore, in case cellsum is zero, keep
-!--          the parent solution at this point.
-             IF ( ijkfc(kp,jp,ip) /= 0 )  THEN
-                parent_array(kp,jp,ip) = cellsum / REAL( ijkfc(kp,jp,ip), KIND = wp )
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-
- END SUBROUTINE pmci_anterp_var
-
-#endif
-
- END SUBROUTINE pmci_child_datatrans
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set boundary conditions for the prognostic quantities after interpolation and anterpolation at
-!> upward- and downward facing surfaces.
-!> @todo: add Dirichlet boundary conditions for pot. temperature, humdidity and passive scalar.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_boundary_conds
-
-#if defined( __parallel )
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ic  !< index along x-direction
-    INTEGER(iwp) ::  jc  !< index along y-direction
-    INTEGER(iwp) ::  kc  !< index along z-direction
-    INTEGER(iwp) ::  lb  !< running index for aerosol size bins
-    INTEGER(iwp) ::  lc  !< running index for aerosol mass bins
-    INTEGER(iwp) ::  lg  !< running index for salsa gases
-    INTEGER(iwp) ::  m   !< running index for surface type
-    INTEGER(iwp) ::  n   !< running index for number of chemical species
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'pmci_boundary_conds', 'start' )
-!
-!-- Set Dirichlet boundary conditions for horizontal velocity components
-    IF ( ibc_uv_b == 0 )  THEN
-!
-!--    Upward-facing surfaces
-       DO  m = 1, bc_h(0)%ns
-          ic = bc_h(0)%i(m)
-          jc = bc_h(0)%j(m)
-          kc = bc_h(0)%k(m)
-          u(kc-1,jc,ic) = 0.0_wp
-          v(kc-1,jc,ic) = 0.0_wp
-       ENDDO
-!
-!--    Downward-facing surfaces
-       DO  m = 1, bc_h(1)%ns
-          ic = bc_h(1)%i(m)
-          jc = bc_h(1)%j(m)
-          kc = bc_h(1)%k(m)
-          u(kc+1,jc,ic) = 0.0_wp
-          v(kc+1,jc,ic) = 0.0_wp
-       ENDDO
-    ENDIF
-!
-!-- Set Dirichlet boundary conditions for vertical velocity component
-!-- Upward-facing surfaces
-    DO  m = 1, bc_h(0)%ns
-       ic = bc_h(0)%i(m)
-       jc = bc_h(0)%j(m)
-       kc = bc_h(0)%k(m)
-       w(kc-1,jc,ic) = 0.0_wp
-    ENDDO
-!
-!-- Downward-facing surfaces
-    DO  m = 1, bc_h(1)%ns
-       ic = bc_h(1)%i(m)
-       jc = bc_h(1)%j(m)
-       kc = bc_h(1)%k(m)
-       w(kc+1,jc,ic) = 0.0_wp
-    ENDDO
-!
-!-- Set Neumann boundary conditions for potential temperature
-    IF ( .NOT. neutral )  THEN
-       IF ( ibc_pt_b == 1 )  THEN
-          DO  m = 1, bc_h(0)%ns
-             ic = bc_h(0)%i(m)
-             jc = bc_h(0)%j(m)
-             kc = bc_h(0)%k(m)
-             pt(kc-1,jc,ic) = pt(kc,jc,ic)
-          ENDDO
-          DO  m = 1, bc_h(1)%ns
-             ic = bc_h(1)%i(m)
-             jc = bc_h(1)%j(m)
-             kc = bc_h(1)%k(m)
-             pt(kc+1,jc,ic) = pt(kc,jc,ic)
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Set Neumann boundary conditions for humidity and cloud-physical quantities
-    IF ( humidity )  THEN
-       IF ( ibc_q_b == 1 )  THEN
-          DO  m = 1, bc_h(0)%ns
-             ic = bc_h(0)%i(m)
-             jc = bc_h(0)%j(m)
-             kc = bc_h(0)%k(m)
-             q(kc-1,jc,ic) = q(kc,jc,ic)
-          ENDDO
-          DO  m = 1, bc_h(1)%ns
-             ic = bc_h(1)%i(m)
-             jc = bc_h(1)%j(m)
-             kc = bc_h(1)%k(m)
-             q(kc+1,jc,ic) = q(kc,jc,ic)
-          ENDDO
-       ENDIF
-       IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-          DO  m = 1, bc_h(0)%ns
-             ic = bc_h(0)%i(m)
-             jc = bc_h(0)%j(m)
-             kc = bc_h(0)%k(m)
-             nc(kc-1,jc,ic) = 0.0_wp
-             qc(kc-1,jc,ic) = 0.0_wp
-          ENDDO
-          DO  m = 1, bc_h(1)%ns
-             ic = bc_h(1)%i(m)
-             jc = bc_h(1)%j(m)
-             kc = bc_h(1)%k(m)
-
-             nc(kc+1,jc,ic) = 0.0_wp
-             qc(kc+1,jc,ic) = 0.0_wp
-          ENDDO
-       ENDIF
-
-       IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-          DO  m = 1, bc_h(0)%ns
-             ic = bc_h(0)%i(m)
-             jc = bc_h(0)%j(m)
-             kc = bc_h(0)%k(m)
-             nr(kc-1,jc,ic) = 0.0_wp
-             qr(kc-1,jc,ic) = 0.0_wp
-          ENDDO
-          DO  m = 1, bc_h(1)%ns
-             ic = bc_h(1)%i(m)
-             jc = bc_h(1)%j(m)
-             kc = bc_h(1)%k(m)
-             nr(kc+1,jc,ic) = 0.0_wp
-             qr(kc+1,jc,ic) = 0.0_wp
-          ENDDO
-       ENDIF
-
-    ENDIF
-!
-!-- Set Neumann boundary conditions for passive scalar
-    IF ( passive_scalar )  THEN
-       IF ( ibc_s_b == 1 )  THEN
-          DO  m = 1, bc_h(0)%ns
-             ic = bc_h(0)%i(m)
-             jc = bc_h(0)%j(m)
-             kc = bc_h(0)%k(m)
-             s(kc-1,jc,ic) = s(kc,jc,ic)
-          ENDDO
-          DO  m = 1, bc_h(1)%ns
-             ic = bc_h(1)%i(m)
-             jc = bc_h(1)%j(m)
-             kc = bc_h(1)%k(m)
-             s(kc+1,jc,ic) = s(kc,jc,ic)
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Set Neumann boundary conditions for chemical species
-    IF ( air_chemistry  .AND.  nesting_chem )  THEN
-       IF ( ibc_cs_b == 1 )  THEN
-          DO  n = 1, nspec
-             DO  m = 1, bc_h(0)%ns
-                ic = bc_h(0)%i(m)
-                jc = bc_h(0)%j(m)
-                kc = bc_h(0)%k(m)
-                chem_species(n)%conc(kc-1,jc,ic) = chem_species(n)%conc(kc,jc,ic)
-             ENDDO
-             DO  m = 1, bc_h(1)%ns
-                ic = bc_h(1)%i(m)
-                jc = bc_h(1)%j(m)
-                kc = bc_h(1)%k(m)
-                chem_species(n)%conc(kc+1,jc,ic) = chem_species(n)%conc(kc,jc,ic)
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Set Neumann boundary conditions for aerosols and salsa gases
-    IF ( salsa  .AND.  nesting_salsa )  THEN
-       IF ( ibc_aer_b == 1 )  THEN
-          DO  m = 1, bc_h(0)%ns
-             ic = bc_h(0)%i(m)
-             jc = bc_h(0)%j(m)
-             kc = bc_h(0)%k(m)
-             DO  lb = 1, nbins_aerosol
-                aerosol_number(lb)%conc(kc-1,jc,ic) = aerosol_number(lb)%conc(kc,jc,ic)
-             ENDDO
-             DO  lc = 1, nbins_aerosol * ncomponents_mass
-                aerosol_mass(lc)%conc(kc-1,jc,ic) = aerosol_mass(lc)%conc(kc,jc,ic)
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  lg = 1, ngases_salsa
-                   salsa_gas(lg)%conc(kc-1,jc,ic) = salsa_gas(lg)%conc(kc,jc,ic)
-                ENDDO
-             ENDIF
-          ENDDO
-          DO  m = 1, bc_h(1)%ns
-             ic = bc_h(1)%i(m)
-             jc = bc_h(1)%j(m)
-             kc = bc_h(1)%k(m)
-             DO  lb = 1, nbins_aerosol
-                aerosol_number(lb)%conc(kc+1,jc,ic) = aerosol_number(lb)%conc(kc,jc,ic)
-             ENDDO
-             DO  lc = 1, nbins_aerosol * ncomponents_mass
-                aerosol_mass(lc)%conc(kc+1,jc,ic) = aerosol_mass(lc)%conc(kc,jc,ic)
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  lg = 1, ngases_salsa
-                   salsa_gas(lg)%conc(kc+1,jc,ic) = salsa_gas(lg)%conc(kc,jc,ic)
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDIF
-    ENDIF
-
-    IF ( debug_output_timestep )  CALL debug_message( 'pmci_boundary_conds', 'end' )
-
-#endif
- END SUBROUTINE pmci_boundary_conds
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Adjust the volume-flow rate through the nested boundaries so that the net volume flow through
-!> all boundaries of the current nest domain becomes zero.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_ensure_nest_mass_conservation
- 
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !< running index in the x-direction
-    INTEGER(iwp) ::  ierr  !< MPI error code
-    INTEGER(iwp) ::  j     !< running index in the y-direction
-    INTEGER(iwp) ::  k     !< running index in the z-direction
-    INTEGER(iwp) ::  n     !< running index over the boundary faces: l, r, s, n and t
-
-    REAL(wp) ::  dxdy                  !< surface area of grid cell top face
-    REAL(wp) ::  innor                 !< inner normal vector of the grid cell face
-    REAL(wp) ::  sub_sum               !< intermediate sum for reducing the loss of signifigant digits in 2-D summations
-    REAL(wp) ::  u_corr_left           !< correction added to the left boundary value of u
-    REAL(wp) ::  u_corr_right          !< correction added to the right boundary value of u
-    REAL(wp) ::  v_corr_south          !< correction added to the south boundary value of v
-    REAL(wp) ::  v_corr_north          !< correction added to the north boundary value of v
-    REAL(wp) ::  volume_flux_integral  !< surface integral of volume flux over the domain boundaries
-    REAL(wp) ::  volume_flux_local     !< surface integral of volume flux over the subdomain boundary face
-    REAL(wp) ::  w_corr_top            !< correction added to the top boundary value of w
-
-    REAL(wp), DIMENSION(5) ::  volume_flux  !< surface integral of volume flux over each boundary face of the domain
-
-!
-!-- Sum up the volume flow through the left boundary
-    volume_flux(1) = 0.0_wp
-    volume_flux_local = 0.0_wp
-    IF ( bc_dirichlet_l )  THEN
-       i = 0
-       innor = dy
-       DO   j = nys, nyn
-          sub_sum = 0.0_wp
-          DO   k = nzb+1, nzt
-             sub_sum = sub_sum + innor * u(k,j,i) * dzw(k)                                         &
-                       * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-          volume_flux_local = volume_flux_local + sub_sum
-       ENDDO
-    ENDIF
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flux_local, volume_flux(1), 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    volume_flux(1) = volume_flux_local
-#endif
-!
-!-- Sum up the volume flow through the right boundary
-    volume_flux(2) = 0.0_wp
-    volume_flux_local = 0.0_wp
-    IF ( bc_dirichlet_r )  THEN
-       i = nx + 1
-       innor = -dy
-       DO   j = nys, nyn
-          sub_sum = 0.0_wp
-          DO   k = nzb+1, nzt
-             sub_sum = sub_sum + innor * u(k,j,i) * dzw(k)                                         &
-                       * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-          volume_flux_local = volume_flux_local + sub_sum
-       ENDDO
-    ENDIF
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flux_local, volume_flux(2), 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    volume_flux(2) = volume_flux_local
-#endif
-!
-!-- Sum up the volume flow through the south boundary
-    volume_flux(3) = 0.0_wp
-    volume_flux_local = 0.0_wp
-    IF ( bc_dirichlet_s )  THEN
-       j = 0
-       innor = dx
-       DO   i = nxl, nxr
-          sub_sum = 0.0_wp
-          DO   k = nzb+1, nzt
-             sub_sum = sub_sum + innor * v(k,j,i) * dzw(k)                                         &
-                       * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-          volume_flux_local = volume_flux_local + sub_sum
-       ENDDO
-    ENDIF
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flux_local, volume_flux(3), 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    volume_flux(3) = volume_flux_local
-#endif
-!
-!-- Sum up the volume flow through the north boundary
-    volume_flux(4) = 0.0_wp
-    volume_flux_local = 0.0_wp
-    IF ( bc_dirichlet_n )  THEN
-       j = ny + 1
-       innor = -dx
-       DO  i = nxl, nxr
-          sub_sum = 0.0_wp
-          DO  k = nzb+1, nzt
-             sub_sum = sub_sum + innor * v(k,j,i) * dzw(k)                                         &
-                       * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-          volume_flux_local = volume_flux_local + sub_sum
-       ENDDO
-    ENDIF
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flux_local, volume_flux(4), 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    volume_flux(4) = volume_flux_local
-#endif
-!
-!-- Sum up the volume flow through the top boundary
-    volume_flux(5) = 0.0_wp
-    volume_flux_local = 0.0_wp
-    dxdy = dx * dy
-    k = nzt
-    DO  i = nxl, nxr
-       sub_sum = 0.0_wp
-       DO   j = nys, nyn
-          sub_sum = sub_sum - w(k,j,i) * dxdy  ! Minus, because the inner unit normal vector is (0,0,-1)
-       ENDDO
-       volume_flux_local = volume_flux_local + sub_sum
-    ENDDO
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flux_local, volume_flux(5), 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    volume_flux(5) = volume_flux_local
-#endif
-
-    volume_flux_integral = 0.0_wp
-    DO  n = 1, 5
-       volume_flux_integral = volume_flux_integral + volume_flux(n)
-    ENDDO
-!
-!-- Correction equally distributed to all nest boundaries, area_total must be used as area.
-!-- Note that face_area(6) is the total area (=sum from 1 to 5)
-    w_corr_top   = volume_flux_integral / face_area(6)
-    u_corr_left  =-w_corr_top
-    u_corr_right = w_corr_top
-    v_corr_south =-w_corr_top
-    v_corr_north = w_corr_top
-!!
-!!-- Just print out the net volume fluxes through each boundary. Only the root process prints.
-!    if ( myid == 0 )  then
-!       write( 9, "(5(e14.7,2x),4x,e14.7,4x,e12.5,4x,5(e14.7,2x))" )                                &
-!            volume_flux(1), volume_flux(2), volume_flux(3), volume_flux(4), volume_flux(5),        &
-!            volume_flux_integral, c_correc,                                                        &
-!            u_corr_left, u_corr_right,  v_corr_south, v_corr_north, w_corr_top
-!       flush( 9 )
-!    endif
-!
-!-- Correct the top-boundary value of w
-    DO   i = nxl, nxr
-       DO   j = nys, nyn
-          DO  k = nzt, nzt + 1
-             w(k,j,i) = w(k,j,i) + w_corr_top
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Correct the left-boundary value of u
-    IF ( bc_dirichlet_l )  THEN
-       DO  i = nxlg, nxl
-          DO  j = nys, nyn
-             DO  k = nzb + 1, nzt
-                u(k,j,i) = u(k,j,i) + u_corr_left                                                  &
-                           * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Correct the right-boundary value of u
-    IF ( bc_dirichlet_r )  THEN
-       DO  i = nxr+1, nxrg
-          DO  j = nys, nyn
-             DO  k = nzb + 1, nzt
-                u(k,j,i) = u(k,j,i) + u_corr_right                                                 &
-                           * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Correct the south-boundary value of v
-    IF ( bc_dirichlet_s )  THEN
-       DO  i = nxl, nxr
-          DO  j = nysg, nys
-             DO  k = nzb + 1, nzt
-                v(k,j,i) = v(k,j,i) + v_corr_south                                                 &
-                           * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Correct the north-boundary value of v
-    IF ( bc_dirichlet_n )  THEN
-       DO  i = nxl, nxr
-          DO  j = nyn+1, nyng
-             DO  k = nzb + 1, nzt
-                v(k,j,i) = v(k,j,i) + v_corr_north                                                 &
-                           * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
-
- END SUBROUTINE pmci_ensure_nest_mass_conservation
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Adjust the volume-flow rate through the top boundary so that the net volume flow through 
-!> all boundaries of the current nest domain becomes zero.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmci_ensure_nest_mass_conservation_vertical
- 
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !< running index in the x-direction
-    INTEGER(iwp) ::  ierr  !< MPI error code
-    INTEGER(iwp) ::  j     !< running index in the y-direction
-    INTEGER(iwp) ::  k     !< running index in the z-direction
-
-    REAL(wp) ::  dxdy               !< surface area of grid cell top face
-    REAL(wp) ::  sub_sum            !< intermediate sum for reducing the loss of signifigant digits in 2-D summations
-    REAL(wp) ::  top_area           !< top boundary face area
-    REAL(wp) ::  volume_flux        !< surface integral of volume flux over the top boundary face
-    REAL(wp) ::  volume_flux_local  !< surface integral of volume flux over the subdomain boundary face
-    REAL(wp) ::  w_corr_top         !< correction added to the top boundary value of w
-
-
-    top_area = face_area(5)
-!
-!-- Sum up the volume flow through the top boundary
-    volume_flux = 0.0_wp
-    volume_flux_local = 0.0_wp
-    dxdy = dx * dy
-    k = nzt
-    DO  i = nxl, nxr
-       sub_sum = 0.0_wp
-       DO   j = nys, nyn
-          sub_sum = sub_sum - w(k,j,i) * dxdy  ! Minus, because the inner unit normal vector is (0,0,-1)
-       ENDDO
-       volume_flux_local = volume_flux_local + sub_sum
-    ENDDO
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flux_local, volume_flux, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    volume_flux = volume_flux_local
-#endif
-
-    w_corr_top   = volume_flux / top_area
-!!
-!!-- Just print out the net volume fluxes through each boundary. Only the root process prints.
-!    if ( myid == 0 )  then
-!       write( 9, "(5(e14.7,2x),4x,e14.7,4x,e12.5,4x,5(e14.7,2x))" )                                &
-!            volume_flux(1), volume_flux(2), volume_flux(3), volume_flux(4), volume_flux(5),        &
-!            volume_flux_integral, c_correc,                                                        &
-!            u_corr_left, u_corr_right,  v_corr_south, v_corr_north, w_corr_top
-!       flush( 9 )
-!    endif
-!
-!-- Correct the top-boundary value of w
-    DO   i = nxl, nxr
-       DO   j = nys, nyn
-          DO  k = nzt, nzt + 1
-             w(k,j,i) = w(k,j,i) + w_corr_top
-          ENDDO
-       ENDDO
-    ENDDO
-
- END SUBROUTINE pmci_ensure_nest_mass_conservation_vertical
-
-#endif
-END MODULE pmc_interface
Index: palm/trunk/SOURCE/pmc_mpi_wrapper_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_mpi_wrapper_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,859 +1,0 @@
- MODULE pmc_mpi_wrapper
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
-!
-! Current revisions:
-! ------------------
-!
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! Support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Extent interface by logical buffer
-!
-! 1762 2016-02-25 12:31:13Z hellstea
-! Initial revision by K. Ketelsen
-!
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-! MPI Wrapper of Palm Model Coupler
-!--------------------------------------------------------------------------------------------------!
-
-#if defined( __parallel )
-    USE, INTRINSIC ::  ISO_C_BINDING
-
-    USE MPI
-
-    USE kinds
-    USE pmc_handle_communicator,                                                                   &
-        ONLY: m_model_comm,                                                                        &
-              m_model_rank,                                                                        &
-              m_to_child_comm,                                                                     &
-              m_to_parent_comm
-
-
-    IMPLICIT NONE
-
-
-    PRIVATE
-    SAVE
-
-    INTERFACE pmc_send_to_parent
-       MODULE PROCEDURE pmc_send_to_parent_integer
-       MODULE PROCEDURE pmc_send_to_parent_integer_2
-       MODULE PROCEDURE pmc_send_to_parent_real_r1
-       MODULE PROCEDURE pmc_send_to_parent_real_r2
-       MODULE PROCEDURE pmc_send_to_parent_real_r3
-    END INTERFACE pmc_send_to_parent
-
-    INTERFACE pmc_recv_from_parent
-       MODULE PROCEDURE pmc_recv_from_parent_logical
-       MODULE PROCEDURE pmc_recv_from_parent_integer
-       MODULE PROCEDURE pmc_recv_from_parent_real_r1
-       MODULE PROCEDURE pmc_recv_from_parent_real_r2
-       MODULE PROCEDURE pmc_recv_from_parent_real_r3
-    END INTERFACE pmc_recv_from_parent
-
-    INTERFACE pmc_send_to_child
-       MODULE PROCEDURE pmc_send_to_child_logical
-       MODULE PROCEDURE pmc_send_to_child_integer
-       MODULE PROCEDURE pmc_send_to_child_real_r1
-       MODULE PROCEDURE pmc_send_to_child_real_r2
-       MODULE PROCEDURE pmc_send_to_child_real_r3
-    END INTERFACE pmc_send_to_child
-
-    INTERFACE pmc_recv_from_child
-       MODULE PROCEDURE pmc_recv_from_child_integer
-       MODULE PROCEDURE pmc_recv_from_child_integer_2
-       MODULE PROCEDURE pmc_recv_from_child_real_r1
-       MODULE PROCEDURE pmc_recv_from_child_real_r2
-       MODULE PROCEDURE pmc_recv_from_child_real_r3
-    END INTERFACE pmc_recv_from_child
-
-    INTERFACE pmc_bcast
-       MODULE PROCEDURE pmc_bcast_integer
-       MODULE PROCEDURE pmc_bcast_character
-    END INTERFACE pmc_bcast
-
-    INTERFACE pmc_inter_bcast
-       MODULE PROCEDURE pmc_inter_bcast_integer_1
-    END INTERFACE pmc_inter_bcast
-
-    INTERFACE pmc_alloc_mem
-       MODULE PROCEDURE pmc_alloc_mem_integer_1
-       MODULE PROCEDURE pmc_alloc_mem_Real_1
-    END INTERFACE pmc_alloc_mem
-
-    INTERFACE pmc_time
-       MODULE PROCEDURE pmc_time
-    END INTERFACE pmc_time
-
-    PUBLIC pmc_alloc_mem,                                                                          &
-           pmc_bcast,                                                                              &
-           pmc_inter_bcast,                                                                        &
-           pmc_recv_from_child,                                                                    &
-           pmc_recv_from_parent,                                                                   &
-           pmc_send_to_child,                                                                      &
-           pmc_send_to_parent,                                                                     &
-           pmc_time
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_recv_from_parent_logical( buf, n, parent_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  n            !<
-    INTEGER, INTENT(IN) ::  parent_rank  !<
-    INTEGER, INTENT(IN) ::  tag          !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    LOGICAL, INTENT(OUT) ::  buf   !<
-
-    ierr = 0
-    CALL MPI_RECV( buf, n, MPI_LOGICAL, parent_rank, tag, m_to_parent_comm, MPI_STATUS_IGNORE,     &
-                   ierr )
-
- END SUBROUTINE pmc_recv_from_parent_logical
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_send_to_child_logical( child_id, buf, n, child_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  child_id    !<
-    INTEGER, INTENT(IN) ::  child_rank  !<
-    INTEGER, INTENT(IN) ::  n           !<
-    INTEGER, INTENT(IN) ::  tag         !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    LOGICAL, INTENT(IN) ::  buf  !<
-
-    ierr = 0
-    CALL MPI_SEND( buf, n, MPI_LOGICAL, child_rank, tag, m_to_child_comm(child_id), ierr )
-
- END SUBROUTINE pmc_send_to_child_logical
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_send_to_parent_integer( buf, n, parent_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  n            !<
-    INTEGER, INTENT(IN) ::  parent_rank  !<
-    INTEGER, INTENT(IN) ::  tag          !<
-
-    INTEGER, DIMENSION(:), INTENT(IN) ::  buf  !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-
-    ierr = 0
-    CALL MPI_SEND( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm, ierr )
-
- END SUBROUTINE pmc_send_to_parent_integer
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_recv_from_parent_integer( buf, n, parent_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  n            !<
-    INTEGER, INTENT(IN) ::  parent_rank  !<
-    INTEGER, INTENT(IN) ::  tag          !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    INTEGER, DIMENSION(:), INTENT(OUT) :: buf  !<
-
-
-    ierr = 0
-    CALL MPI_RECV( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm, MPI_STATUS_IGNORE,     &
-                   ierr )
-
- END SUBROUTINE pmc_recv_from_parent_integer
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_send_to_parent_integer_2( buf, n, parent_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) :: n            !<
-    INTEGER, INTENT(IN) :: parent_rank  !<
-    INTEGER, INTENT(IN) :: tag          !<
-
-    INTEGER, DIMENSION(:,:), INTENT(IN) :: buf  !<
-
-    INTEGER, INTENT(OUT) :: ierr  !<
-
-
-    ierr = 0
-    CALL MPI_SEND( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm, ierr )
-
- END SUBROUTINE pmc_send_to_parent_integer_2
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_send_to_parent_real_r1( buf, n, parent_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-
-    INTEGER, INTENT(IN) ::  n            !<
-    INTEGER, INTENT(IN) ::  parent_rank  !<
-    INTEGER, INTENT(IN) ::  tag          !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:), INTENT(IN) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
-
- END SUBROUTINE pmc_send_to_parent_real_r1
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_recv_from_parent_real_r1( buf, n, parent_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  n            !<
-    INTEGER, INTENT(IN) ::  parent_rank  !<
-    INTEGER, INTENT(IN) ::  tag          !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:), INTENT(OUT) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, MPI_STATUS_IGNORE, ierr )
-
- END SUBROUTINE pmc_recv_from_parent_real_r1
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_send_to_parent_real_r2( buf, n, parent_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  n            !<
-    INTEGER, INTENT(IN) ::  parent_rank  !<
-    INTEGER, INTENT(IN) ::  tag          !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:,:), INTENT(IN) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
-
- END SUBROUTINE pmc_send_to_parent_real_r2
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_recv_from_parent_real_r2( buf, n, parent_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  n            !<
-    INTEGER, INTENT(IN) ::  parent_rank  !<
-    INTEGER, INTENT(IN) ::  tag          !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-     REAL(wp), DIMENSION(:,:), INTENT(OUT) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, MPI_STATUS_IGNORE, ierr )
-
- END SUBROUTINE pmc_recv_from_parent_real_r2
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_send_to_parent_real_r3( buf, n, parent_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  n            !<
-    INTEGER, INTENT(IN) ::  parent_rank  !<
-    INTEGER, INTENT(IN) ::  tag          !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:,:,:), INTENT(IN) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
-
- END SUBROUTINE pmc_send_to_parent_real_r3
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_recv_from_parent_real_r3( buf, n, parent_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  n            !<
-    INTEGER, INTENT(IN) ::  parent_rank  !<
-    INTEGER, INTENT(IN) ::  tag          !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:,:,:), INTENT(OUT) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, MPI_STATUS_IGNORE, ierr )
-
- END SUBROUTINE pmc_recv_from_parent_real_r3
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_send_to_child_integer( child_id, buf, n, child_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  child_id    !<
-    INTEGER, INTENT(IN) ::  child_rank  !<
-    INTEGER, INTENT(IN) ::  n           !<
-    INTEGER, INTENT(IN) ::  tag         !<
-
-    INTEGER, DIMENSION(:), INTENT(IN) ::  buf  !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-
-    ierr = 0
-    CALL MPI_SEND( buf, n, MPI_INTEGER, child_rank, tag, m_to_child_comm(child_id), ierr )
-
- END SUBROUTINE pmc_send_to_child_integer
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_recv_from_child_integer( child_id, buf, n, child_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  child_id    !<
-    INTEGER, INTENT(IN) ::  child_rank  !<
-    INTEGER, INTENT(IN) ::  n           !<
-    INTEGER, INTENT(IN) ::  tag         !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    INTEGER, DIMENSION(:), INTENT(INOUT) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_RECV( buf, n, MPI_INTEGER, child_rank, tag, m_to_child_comm(child_id),                &
-                   MPI_STATUS_IGNORE, ierr )
-
- END SUBROUTINE pmc_recv_from_child_integer
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_recv_from_child_integer_2( child_id, buf, n, child_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  child_id    !<
-    INTEGER, INTENT(IN) ::  child_rank  !<
-    INTEGER, INTENT(IN) ::  n           !<
-    INTEGER, INTENT(IN) ::  tag         !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    INTEGER, DIMENSION(:,:), INTENT(OUT) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_RECV( buf, n, MPI_INTEGER, child_rank, tag, m_to_child_comm(child_id),                &
-                   MPI_STATUS_IGNORE, ierr )
-
- END SUBROUTINE pmc_recv_from_child_integer_2
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_send_to_child_real_r1( child_id, buf, n, child_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  child_id    !<
-    INTEGER, INTENT(IN) ::  child_rank  !<
-    INTEGER, INTENT(IN) ::  n           !<
-    INTEGER, INTENT(IN) ::  tag         !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:), INTENT(IN) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag, m_to_child_comm(child_id), ierr )
-
- END SUBROUTINE pmc_send_to_child_real_r1
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_recv_from_child_real_r1( child_id, buf, n, child_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  child_id    !<
-    INTEGER, INTENT(IN) ::  child_rank  !<
-    INTEGER, INTENT(IN) ::  n           !<
-    INTEGER, INTENT(IN) ::  tag         !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:), INTENT(INOUT) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag, m_to_child_comm(child_id),                   &
-                   MPI_STATUS_IGNORE, ierr )
-
- END SUBROUTINE pmc_recv_from_child_real_r1
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_send_to_child_real_r2( child_id, buf, n, child_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  child_id    !<
-    INTEGER, INTENT(IN) ::  child_rank  !<
-    INTEGER, INTENT(IN) ::  n           !<
-    INTEGER, INTENT(IN) ::  tag         !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:,:), INTENT(IN) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag, m_to_child_comm(child_id), ierr )
-
- END SUBROUTINE pmc_send_to_child_real_r2
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_recv_from_child_real_r2( child_id, buf, n, child_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  child_id    !<
-    INTEGER, INTENT(IN) ::  child_rank  !<
-    INTEGER, INTENT(IN) ::  n           !<
-    INTEGER, INTENT(IN) ::  tag         !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:,:), INTENT(OUT) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag, m_to_child_comm(child_id),                   &
-                   MPI_STATUS_IGNORE, ierr )
-
- END SUBROUTINE pmc_recv_from_child_real_r2
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_send_to_child_real_r3( child_id, buf, n, child_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  child_id    !<
-    INTEGER, INTENT(IN) ::  child_rank  !<
-    INTEGER, INTENT(IN) ::  n           !<
-    INTEGER, INTENT(IN) ::  tag         !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:,:,:), INTENT(IN) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag, m_to_child_comm(child_id), ierr )
-
- END SUBROUTINE pmc_send_to_child_real_r3
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_recv_from_child_real_r3( child_id, buf, n, child_rank, tag, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  child_id    !<
-    INTEGER, INTENT(IN) ::  child_rank  !<
-    INTEGER, INTENT(IN) ::  n           !<
-    INTEGER, INTENT(IN) ::  tag         !<
-
-    INTEGER, INTENT(OUT) ::  ierr  !<
-
-    REAL(wp), DIMENSION(:,:,:), INTENT(OUT) ::  buf  !<
-
-
-    ierr = 0
-    CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag, m_to_child_comm(child_id),                   &
-                   MPI_STATUS_IGNORE, ierr )
-
- END SUBROUTINE pmc_recv_from_child_real_r3
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_bcast_integer( buf, root_pe, comm, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  root_pe  !<
-
-    INTEGER, INTENT(INOUT) ::  buf  !<
-
-    INTEGER, INTENT(IN), OPTIONAL ::  comm  !<
-
-    INTEGER, INTENT(OUT), OPTIONAL ::  ierr  !<
-
-    INTEGER ::  mycomm  !<
-    INTEGER ::  myerr   !<
-
-
-    IF ( PRESENT( comm ) )  THEN
-       mycomm = comm
-    ELSE
-       mycomm = m_model_comm
-    ENDIF
-
-    CALL MPI_BCAST( buf, 1, MPI_INTEGER, root_pe, mycomm, myerr )
-
-    IF ( PRESENT( ierr ) )  THEN
-       ierr = myerr
-    ENDIF
-
- END SUBROUTINE pmc_bcast_integer
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_bcast_character( buf, root_pe, comm, ierr )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(INOUT) ::  buf  !<
-
-    INTEGER, INTENT(IN) ::  root_pe  !<
-
-    INTEGER, INTENT(IN), OPTIONAL ::  comm  !<
-
-    INTEGER, INTENT(OUT), OPTIONAL ::  ierr  !<
-
-    INTEGER ::  mycomm  !<
-    INTEGER ::  myerr   !<
-
-
-    IF ( PRESENT( comm ) )  THEN
-       mycomm = comm
-    ELSE
-       mycomm = m_model_comm
-    ENDIF
-
-    CALL MPI_BCAST( buf, LEN( buf ), MPI_CHARACTER, root_pe, mycomm, myerr )
-
-    IF ( PRESENT( ierr ) )  THEN
-       ierr = myerr
-    ENDIF
-
- END SUBROUTINE pmc_bcast_character
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_inter_bcast_integer_1( buf, child_id, ierr )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN),optional ::  child_id  !<
-
-    INTEGER, INTENT(OUT),optional ::  ierr  !<
-
-    INTEGER, INTENT(INOUT),DIMENSION(:) ::  buf  !<
-
-    INTEGER ::  mycomm   !<
-    INTEGER ::  myerr    !<
-    INTEGER ::  root_pe  !<
-
-!
-!-- Process 0 on parent broadcast to all child processes
-    IF ( PRESENT( child_id ) )  THEN
-
-       mycomm = m_to_child_comm(child_id)
-
-       IF ( m_model_rank == 0 )  THEN
-          root_pe = MPI_ROOT
-       ELSE
-          root_pe = MPI_PROC_NULL
-       ENDIF
-
-    ELSE
-       mycomm  = m_to_parent_comm
-       root_pe = 0
-    ENDIF
-
-    CALL MPI_BCAST( buf, SIZE( buf ), MPI_INTEGER, root_pe, mycomm, myerr )
-
-    IF ( PRESENT( ierr ) )  THEN
-       ierr = myerr
-    ENDIF
-
- END SUBROUTINE pmc_inter_bcast_integer_1
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_alloc_mem_integer_1( iarray, idim1 )
-!
-!-- Allocate memory with MPI_ALLOC_MEM using intermediate C-pointer
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  idim1  !<
-
-    INTEGER ::  ierr  !<
-
-    INTEGER, DIMENSION(1) ::  ashape  !<
-
-    INTEGER, DIMENSION(:), POINTER, INTENT(INOUT) ::  iarray  !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
-
-    TYPE(C_PTR) ::  p_myind  !<
-
-
-    winsize = idim1 * STORAGE_SIZE( ierr ) / 8
-
-    CALL MPI_ALLOC_MEM( winsize, MPI_INFO_NULL, p_myind, ierr )
-    ashape(1) = idim1
-    CALL C_F_POINTER( p_myind, iarray, ashape )
-
- END SUBROUTINE pmc_alloc_mem_integer_1
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_alloc_mem_real_1( array, idim1, base_ptr )
-
-    IMPLICIT NONE
-
-    INTEGER(idp), INTENT(IN) ::  idim1  !<
-
-    INTEGER :: ierr  !<
-
-    INTEGER, DIMENSION(1) ::  ashape  !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
-
-    REAL(KIND=wp), DIMENSION(:), POINTER, INTENT(INOUT) ::  array  !<
-
-    TYPE(C_PTR) :: p_myind  !<
-
-    TYPE(C_PTR), INTENT(OUT), OPTIONAL ::  base_ptr  !<
-
-
-    winsize = idim1 * wp
-
-    CALL MPI_ALLOC_MEM( winsize , MPI_INFO_NULL, p_myind, ierr )
-    ashape(1) = idim1
-    CALL C_F_POINTER( p_myind, array, ashape )
-
-    IF ( PRESENT( base_ptr ) )  THEN
-       base_ptr = p_myind
-    ENDIF
-
- END SUBROUTINE pmc_alloc_mem_Real_1
-
-
-
- FUNCTION pmc_time()
-
-    REAL(KIND=wp) :: pmc_time  !<
-
-
-    pmc_time = MPI_WTIME()
-
-  END FUNCTION pmc_time
-
-#endif
- END MODULE pmc_mpi_wrapper
Index: palm/trunk/SOURCE/pmc_parent_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_parent_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,1168 +1,0 @@
-!> @file pmc_parent_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Reformatted to follow PALM coding standard
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! pmc_s_set_2d_index_list revised for accelerating the code. Subroutine
-! description added.
-!
-! 4649 2020-08-25 12:11:17Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! Support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4360 2020-01-07 11:25:50Z suehring
-!
-!
-! 4213 2019-09-02 14:25:56Z suehring
-! Allocate array for index_list_2d also for zero-size arrays, in order to avoid errors when array
-! bound checks are enabled
-!
-! 4212 2019-09-02 14:23:05Z suehring
-! Corrected "Former revisions" section
-!
-! 3962 2019-05-08 19:40:33Z suehring
-! Bugfixes in initial settings of child and parent communication patterns.
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Explicit kind settings
-!
-! 1762 2016-02-25 12:31:13Z hellstea
-! Initial revision by K. Ketelsen
-!
-! Authors:
-! --------
-!> @author Klaus Ketelsen (no affiliation)
-!
-! Description:
-! ------------
-!> Parent part of Palm Model Coupler
-!--------------------------------------------------------------------------------------------------!
- MODULE pmc_parent
-
-#if defined( __parallel )
-    USE, INTRINSIC ::  ISO_C_BINDING
-
-    USE MPI
-
-    USE kinds
-
-    USE pmc_general,                                                                               &
-        ONLY: arraydef,                                                                            &
-              childdef,                                                                            &
-              da_namedef,                                                                          &
-              da_namelen,                                                                          &
-              pedef,                                                                               &
-              pmc_g_setname,                                                                       &
-              pmc_max_array,                                                                       &
-              pmc_max_models
-
-    USE pmc_handle_communicator,                                                                   &
-        ONLY: m_model_comm,                                                                        &
-              m_model_rank,                                                                        &
-              m_model_npes,                                                                        &
-              m_to_child_comm,                                                                     &
-              m_world_rank,                                                                        &
-              pmc_parent_for_child
-
-    USE pmc_mpi_wrapper,                                                                           &
-        ONLY: pmc_alloc_mem,                                                                       &
-              pmc_bcast,                                                                           &
-              pmc_time
-
-
-    IMPLICIT NONE
-
-    INTEGER ::  next_array_in_list = 0  !<
-
-    TYPE childindexdef
-       INTEGER ::  nrpoints  !<
-
-       INTEGER, DIMENSION(:,:), ALLOCATABLE ::  index_list_2d  !<
-    END TYPE childindexdef
-
-    TYPE(childdef), DIMENSION(pmc_max_models) ::  children  !<
-
-    TYPE(childindexdef), DIMENSION(pmc_max_models) ::  indchildren  !<
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public functions
-    PUBLIC pmc_parent_for_child
-
-!
-!-- Public variables, constants and types
-    PUBLIC children,                                                                               &
-           pmc_parentinit,                                                                         &
-           pmc_s_clear_next_array_list,                                                            &
-           pmc_s_fillbuffer,                                                                       &
-           pmc_s_getdata_from_buffer,                                                              &
-           pmc_s_getnextarray,                                                                     &
-           pmc_s_setind_and_allocmem,                                                              &
-           pmc_s_set_active_data_array,                                                            &
-           pmc_s_set_dataarray,                                                                    &
-           pmc_s_set_2d_index_list,                                                                &
-           pmc_s_get_child_npes
-
-    INTERFACE pmc_parentinit
-       MODULE PROCEDURE  pmc_parentinit
-    END INTERFACE pmc_parentinit
-
-    INTERFACE pmc_s_set_2d_index_list
-       MODULE PROCEDURE pmc_s_set_2d_index_list
-    END INTERFACE pmc_s_set_2d_index_list
-
-    INTERFACE pmc_s_clear_next_array_list
-       MODULE PROCEDURE pmc_s_clear_next_array_list
-    END INTERFACE pmc_s_clear_next_array_list
-
-    INTERFACE pmc_s_getnextarray
-       MODULE PROCEDURE pmc_s_getnextarray
-    END INTERFACE pmc_s_getnextarray
-
-    INTERFACE pmc_s_set_dataarray
-       MODULE PROCEDURE pmc_s_set_dataarray_2d
-       MODULE PROCEDURE pmc_s_set_dataarray_3d
-       MODULE PROCEDURE pmc_s_set_dataarray_ip2d
-    END INTERFACE pmc_s_set_dataarray
-
-    INTERFACE pmc_s_setind_and_allocmem
-       MODULE PROCEDURE pmc_s_setind_and_allocmem
-    END INTERFACE pmc_s_setind_and_allocmem
-
-    INTERFACE pmc_s_fillbuffer
-       MODULE PROCEDURE pmc_s_fillbuffer
-    END INTERFACE pmc_s_fillbuffer
-
-    INTERFACE pmc_s_getdata_from_buffer
-       MODULE PROCEDURE pmc_s_getdata_from_buffer
-    END INTERFACE pmc_s_getdata_from_buffer
-
-    INTERFACE pmc_s_set_active_data_array
-       MODULE PROCEDURE pmc_s_set_active_data_array
-    END INTERFACE pmc_s_set_active_data_array
-
-    INTERFACE pmc_s_get_child_npes
-       MODULE PROCEDURE pmc_s_get_child_npes
-    END INTERFACE pmc_s_get_child_npes
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> If this thread is intended as parent, initialize parent part of parent-client data transfer
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_parentinit
-
-    INTEGER(iwp) ::  childid  !<
-    INTEGER(iwp) ::  i        !<
-    INTEGER(iwp) ::  istat    !<
-    INTEGER(iwp) ::  j        !<
-
-
-    DO  i = 1, SIZE( pmc_parent_for_child ) - 1
-       childid = pmc_parent_for_child( i )
-
-       children(childid)%model_comm = m_model_comm
-       children(childid)%inter_comm = m_to_child_comm(childid)
-
-!
-!--    Get rank and size
-       CALL MPI_COMM_RANK( children(childid)%model_comm, children(childid)%model_rank, istat )
-       CALL MPI_COMM_SIZE( children(childid)%model_comm, children(childid)%model_npes, istat )
-       CALL MPI_COMM_REMOTE_SIZE( children(childid)%inter_comm, children(childid)%inter_npes,      &
-                                  istat )
-
-!
-!--    Intra communicator is used for MPI_GET
-       CALL MPI_INTERCOMM_MERGE( children(childid)%inter_comm, .FALSE.,                            &
-                                 children(childid)%intra_comm, istat )
-       CALL MPI_COMM_RANK( children(childid)%intra_comm, children(childid)%intra_rank, istat )
-
-       ALLOCATE( children(childid)%pes(children(childid)%inter_npes) )
-
-!
-!--    Allocate array of TYPE arraydef for all child PEs to store information of the transfer array
-       DO  j = 1, children(childid)%inter_npes
-         ALLOCATE( children(childid)%pes(j)%array_list(pmc_max_array) )
-       ENDDO
-
-       CALL get_da_names_from_child( childid )
-    ENDDO
-
- END SUBROUTINE pmc_parentinit
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> thread 0 transfers the index list, which contains all parent grid cells involved in
-!> parent client data transfer to the thread, on which this grid cell is located
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_s_set_2d_index_list( childid, index_list )
-
-     INTEGER(iwp) ::  ian        !<
-     INTEGER(iwp) ::  i          !<
-     INTEGER(iwp) ::  ip         !<
-     INTEGER(iwp) ::  istat      !<
-     INTEGER(iwp) ::  max_cells  !<
-
-     INTEGER(iwp), INTENT(IN) ::  childid  !<
-
-     INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) ::  index_list  !<
-
-     INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  cells_on_pe  !<
-
-     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  lo_ind_list  !<
-
-
-     IF ( m_model_rank == 0 )  THEN
-!
-!--     Compute maximum number of grid cells located on one parent thread
-        ALLOCATE( cells_on_pe(0:m_model_npes-1) )
-        cells_on_pe = 0
-
-        DO  i = 1, SIZE( index_list, 2 )
-           cells_on_pe(index_list(6,i )) = cells_on_pe(index_list(6,i ))+1
-        ENDDO
-
-        max_cells = MAXVAL( cells_on_pe )
-
-!
-!--     Allocate temp array for thread dependent transfer of index_list
-        ALLOCATE( lo_ind_list(SIZE( index_list,1 ),max_cells) )
-
-        DO  ip = 0, m_model_npes-1
-!
-!--        Split into parent processes
-           ian = 0
-
-           DO  i = 1, SIZE( index_list, 2 )
-              IF ( index_list(6,i) == ip )  THEN
-                 ian = ian+1
-                 lo_ind_list(:,ian) = index_list(:,i)
-              ENDIF
-           ENDDO
-
-!
-!--        Send data to other parent processes
-           IF ( ip == 0 )  THEN
-              indchildren(childid)%nrpoints = ian
-!
-!--           Allocate array for index_list_2d. Note, the array will also be allocated in case
-!--           ian = 0, in order to avoid errors when array bounds are checked.
-              ALLOCATE( indchildren(childid)%index_list_2d(6,1:ian) )
-              IF ( ian > 0 )  THEN
-                  indchildren(childid)%index_list_2d(:,1:ian) = lo_ind_list(:,1:ian)
-              ENDIF
-           ELSE
-              CALL MPI_SEND( ian, 1, MPI_INTEGER, ip, 1000, m_model_comm, istat )
-              IF ( ian > 0 )  THEN
-                  CALL MPI_SEND( lo_ind_list, 6*ian, MPI_INTEGER, ip, 1001, m_model_comm, istat )
-              ENDIF
-           ENDIF
-        ENDDO
-
-        DEALLOCATE( lo_ind_list )
-        DEALLOCATE( cells_on_pe )
-     ELSE
-        CALL MPI_RECV( indchildren(childid)%nrpoints, 1, MPI_INTEGER, 0, 1000, m_model_comm,       &
-                       MPI_STATUS_IGNORE, istat )
-        ian = indchildren(childid)%nrpoints
-!
-!--     Allocate array for index_list_2d. Note, the array will also be allocated in case ian=0, in
-!--     order to avoid errors when array bounds are checked.
-        ALLOCATE( indchildren(childid)%index_list_2d(6,1:ian) )
-        IF ( ian > 0 )  THEN
-           CALL MPI_RECV( indchildren(childid)%index_list_2d, 6*ian, MPI_INTEGER, 0, 1001,         &
-                          m_model_comm, MPI_STATUS_IGNORE, istat)
-        ENDIF
-     ENDIF
-
-     CALL set_pe_index_list( children(childid), indchildren(childid)%index_list_2d,                &
-                             indchildren(childid)%nrpoints )
-
- END SUBROUTINE pmc_s_set_2d_index_list
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Before creating an array list with arrays schedule for parent client transfer
-!> make sure that the list is empty
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_s_clear_next_array_list
-
-    next_array_in_list = 0
-
- END SUBROUTINE pmc_s_clear_next_array_list
-
-
- LOGICAL FUNCTION pmc_s_getnextarray( childid, myname )
-
-!
-!-- Althoug there are no linked lists any more in PMC, this call still looks like working with a list
-    CHARACTER(LEN=*), INTENT(OUT) ::  myname  !<
-
-    INTEGER(iwp), INTENT(IN) ::  childid  !<
-
-    TYPE(pedef),    POINTER ::  ape  !<
-
-    TYPE(arraydef), POINTER ::  ar  !<
-
-
-    next_array_in_list = next_array_in_list + 1
-
-!
-!-- Array names are the same on all children processes, so take first process to get the name
-    ape => children(childid)%pes(1)
-
-    IF ( next_array_in_list > ape%nr_arrays )  THEN
-!
-!--    All arrays are done
-       pmc_s_getnextarray = .FALSE.
-       RETURN
-    ENDIF
-
-    ar => ape%array_list(next_array_in_list)
-    myname = ar%name
-
-!
-!-- Return true if there is still an array in the list
-    pmc_s_getnextarray = .TRUE.
-
- END FUNCTION pmc_s_getnextarray
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> add 2D real array to list of arrays scheduled for parent-client transfer
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_s_set_dataarray_2d( childid, array, array_2 )
-
-    INTEGER(iwp) ::  nrdims  !<
-
-    INTEGER(iwp), INTENT(IN) ::  childid  !<
-
-    INTEGER(iwp), DIMENSION(4) ::  dims  !<
-
-    REAL(wp), INTENT(IN), DIMENSION(:,:), POINTER ::  array  !<
-
-    REAL(wp), INTENT(IN), DIMENSION(:,:), POINTER, OPTIONAL ::  array_2  !<
-
-    TYPE(C_PTR) ::  array_adr   !<
-    TYPE(C_PTR) ::  second_adr  !<
-
-
-    dims      = 1
-    nrdims    = 2
-    dims(1)   = SIZE( array, 1 )
-    dims(2)   = SIZE( array, 2 )
-    array_adr = C_LOC( array )
-
-    IF ( PRESENT( array_2 ) )  THEN
-       second_adr = C_LOC( array_2 )
-       CALL pmc_s_setarray( childid, nrdims, dims, array_adr, second_adr = second_adr )
-    ELSE
-       CALL pmc_s_setarray( childid, nrdims, dims, array_adr )
-    ENDIF
-
- END SUBROUTINE pmc_s_set_dataarray_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> add 2D integer array to list of arrays scheduled for parent-client transfer
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_s_set_dataarray_ip2d( childid, array )
-
-    INTEGER(iwp) ::  nrdims  !<
-
-    INTEGER(iwp), DIMENSION(4) ::  dims  !<
-
-    INTEGER(iwp), INTENT(IN) ::  childid  !<
-
-    INTEGER(idp), INTENT(IN), DIMENSION(:,:), POINTER ::  array  !<
-
-    TYPE(C_PTR) ::  array_adr  !<
-
-
-    dims      = 1
-    nrdims    = 2
-    dims(1)   = SIZE( array, 1 )
-    dims(2)   = SIZE( array, 2 )
-    array_adr = C_LOC( array )
-
-    CALL pmc_s_setarray( childid, nrdims, dims, array_adr , dimkey = 22 )
-
- END SUBROUTINE pmc_s_set_dataarray_ip2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> add 3D real array to list of arrays scheduled for parent-client transfer
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_s_set_dataarray_3d( childid, array, nz_cl, nz, array_2 )
-
-    INTEGER(iwp) ::  nrdims  !<
-
-    INTEGER(iwp), INTENT(IN) ::  childid  !<
-    INTEGER(iwp), INTENT(IN) ::  nz       !<
-    INTEGER(iwp), INTENT(IN) ::  nz_cl    !<
-
-    INTEGER(iwp), DIMENSION(4) ::  dims  !<
-
-    REAL(wp), INTENT(IN), DIMENSION(:,:,:), POINTER ::  array  !<
-
-    REAL(wp), INTENT(IN), DIMENSION(:,:,:), POINTER, OPTIONAL ::  array_2  !<
-
-    TYPE(C_PTR) ::  array_adr   !<
-    TYPE(C_PTR) ::  second_adr  !<
-
-
-    nrdims  = 3
-    dims(1) = SIZE( array, 1 )
-    dims(2) = SIZE( array, 2 )
-    dims(3) = SIZE( array, 3 )
-    dims(4) = nz_cl+dims(1)-nz  ! Works for first dimension 1:nz and 0:nz+1
-
-    array_adr = C_LOC( array )
-!
-!-- In PALM's pointer version, two indices have to be stored internally.
-!-- The active address of the data array is set in swap_timelevel.
-    IF ( PRESENT( array_2 ) )  THEN
-      second_adr = C_LOC( array_2 )
-      CALL pmc_s_setarray( childid, nrdims, dims, array_adr, second_adr = second_adr )
-    ELSE
-       CALL pmc_s_setarray( childid, nrdims, dims, array_adr )
-    ENDIF
-
- END SUBROUTINE pmc_s_set_dataarray_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Naming convention for appendices:   _pc  -> parent to child transfer
-!>                                     _cp  -> child to parent transfer
-!>                                     send -> parent to child transfer
-!>                                     recv -> child to parent transfer
-!>
-!> @todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_s_setind_and_allocmem( childid )
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string
-
-    INTEGER(iwp) ::  arlen         !<
-    INTEGER(iwp) ::  i             !<
-    INTEGER(iwp) ::  ierr          !<
-    INTEGER(iwp) ::  j             !<
-    INTEGER(iwp) ::  lo_nr_arrays  !< store number of arrays in  local variiab le
-    INTEGER(iwp) ::  myindex       !<
-    INTEGER(iwp) ::  total_npes    !< Total Number of PEs Parent and Child
-    INTEGER(idp) ::  bufsize       !< size of MPI data window
-
-    INTEGER(iwp), INTENT(IN) ::  childid  !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  myindex_s  !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  myindex_r  !<
-
-    REAL(wp),DIMENSION(:), POINTER, SAVE ::  base_array_cp  !< base array for child to parent transfer
-    REAL(wp),DIMENSION(:), POINTER, SAVE ::  base_array_pc  !< base array for parent to child transfer
-
-    TYPE(C_PTR) ::  base_ptr  !<
-
-    TYPE(pedef), POINTER ::  ape  !<
-
-    TYPE(arraydef), POINTER ::  ar   !<
-
-
-    call MPI_COMM_SIZE( children(childid)%intra_comm, total_npes, ierr )
-!
-!-- Parent to child direction
-    myindex = 1
-    bufsize = 8
-
-!
-!-- All Child processes get the same number of arrays.
-!-- Therfore the number of arrays form the first Child process can be used for Dimension.
-    lo_nr_arrays = children(childid)%pes(1)%nr_arrays
-
-    ALLOCATE( myindex_s(lo_nr_arrays,0:total_npes-1) )
-    ALLOCATE( myindex_r(lo_nr_arrays,0:total_npes-1) )
-
-    myindex_s = 0
-
-!
-!-- First stride: compute size and set index
-    DO  i = 1, children(childid)%inter_npes
-       ape => children(childid)%pes(i)
-       DO  j = 1, ape%nr_arrays
-          ar  => ape%array_list(j)
-          IF ( ar%nrdims == 2 )  THEN
-             arlen = ape%nrele
-          ELSEIF ( ar%nrdims == 3 )  THEN
-             arlen = ape%nrele * ar%a_dim(4)
-          ELSE
-             arlen = -1
-          ENDIF
-          ar%sendindex = myindex
-
-!
-!--       Using intra communicator for MPU_Alltoall, the numbers of the child processes are after
-!--       the parent ones.
-          myindex_s(j,i-1+children(childid)%model_npes) = myindex
-
-          myindex = myindex + arlen
-          bufsize = bufsize + arlen
-          ar%sendsize = arlen
-       ENDDO
-    ENDDO
-
-!
-!-- Using MPI_Alltoall to send indices from  Parent to Child
-!-- The data comming back from the child processes are ignored.
-    CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER, myindex_r, lo_nr_arrays, MPI_INTEGER, &
-                       children(childid)%intra_comm, ierr )
-
-!
-!-- Using MPI_Alltoall to receive indices from Child
-    myindex_s = 0
-    myindex_r = 0
-
-    CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER, myindex_r, lo_nr_arrays, MPI_INTEGER, &
-                       children(childid)%intra_comm, ierr )
-
-!
-!-- Create RMA (One Sided Communication) window for data buffer parent to child transfer.
-!-- The buffer of MPI_GET (counterpart of transfer) can be PE-local, i.e. it can but must not be
-!-- part of the MPI RMA window. Only one RMA window is required to prepare the data for:
-!--          parent -> child transfer on the parent side
-!-- and for:
-!--          child -> parent transfer on the child side
-    CALL pmc_alloc_mem( base_array_pc, bufsize )
-    children(childid)%totalbuffersize = bufsize * wp
-
-    winsize = bufsize * wp
-    CALL MPI_WIN_CREATE( base_array_pc, winsize, wp, MPI_INFO_NULL, children(childid)%intra_comm,  &
-                         children(childid)%win_parent_child, ierr )
-
-!
-!-- Open window to set data
-    CALL MPI_WIN_FENCE( 0, children(childid)%win_parent_child, ierr )
-
-!
-!-- Second stride: set buffer pointer
-    DO  i = 1, children(childid)%inter_npes
-       ape => children(childid)%pes(i)
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-          ar%sendbuf = C_LOC( base_array_pc(ar%sendindex) )
-          IF ( ar%sendindex + ar%sendsize > bufsize )  THEN
-             WRITE( message_string, '(a,i4,4i7,1x,a)' ) 'parent buffer too small ',i ,             &
-                    ar%sendindex, ar%sendsize, ar%sendindex + ar%sendsize, bufsize, TRIM( ar%name )
-             CALL message( 'pmc_s_setind_and_allocmem', 'PA0429', 3, 2, 0, 6, 0 )
-          ENDIF
-       ENDDO
-    ENDDO
-
-!
-!-- Child to parent direction
-    bufsize = 8
-
-!
-!-- First stride: compute size and set index
-    DO  i = 1, children(childid)%inter_npes
-       ape => children(childid)%pes(i)
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-!
-!--       Receive index from child
-          IF ( ar%nrdims == 3 )  THEN
-             bufsize = MAX( bufsize, INT( ape%nrele * ar%a_dim(4), MPI_ADDRESS_KIND ) )
-          ELSE
-             bufsize = MAX( bufsize, INT( ape%nrele, MPI_ADDRESS_KIND ) )
-          ENDIF
-          ar%recvindex = myindex_r(j,i-1+children(childid)%model_npes)
-        ENDDO
-    ENDDO
-
-    DEALLOCATE( myindex_s )
-    DEALLOCATE( myindex_r )
-
-!
-!-- Create RMA (one sided communication, RMA = Remote Memory Access) data buffer.
-!-- The buffer for MPI_GET can be PE local, i.e. it can but must not be part of the MPI RMA window.
-    CALL pmc_alloc_mem( base_array_cp, bufsize, base_ptr )
-    children(childid)%totalbuffersize = bufsize * wp
-
-    CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
-
-!
-!-- Second stride: set buffer pointer
-    DO  i = 1, children(childid)%inter_npes
-       ape => children(childid)%pes(i)
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-          ar%recvbuf = base_ptr
-       ENDDO
-    ENDDO
-
- END SUBROUTINE pmc_s_setind_and_allocmem
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Fill buffer in RMA window to enable the client to fetch the dat with MPI_Get
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_s_fillbuffer( childid, waittime, particle_transfer )
-
-    INTEGER(iwp) ::  ierr     !<
-    INTEGER(iwp) ::  ij       !<
-    INTEGER(iwp) ::  ip       !<
-    INTEGER(iwp) ::  j        !<
-    INTEGER(iwp) ::  myindex  !<
-
-    INTEGER(iwp), INTENT(IN) ::  childid   !<
-
-    INTEGER(iwp), DIMENSION(1) ::  buf_shape  !<
-
-    INTEGER(idp), POINTER, DIMENSION(:) ::  ibuf  !<
-
-    INTEGER(idp), POINTER, DIMENSION(:,:) ::  idata_2d  !<
-
-    LOGICAL ::  lo_ptrans  !<
-
-    LOGICAL, INTENT(IN), OPTIONAL   ::  particle_transfer  !<
-
-    REAL(wp) ::  t1  !<
-    REAL(wp) ::  t2  !<
-
-    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
-
-    REAL(wp), POINTER, DIMENSION(:) ::  buf  !<
-
-    REAL(wp), POINTER, DIMENSION(:,:) ::  data_2d  !<
-
-    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
-
-    TYPE(pedef), POINTER ::  ape  !<
-
-    TYPE(arraydef), POINTER ::  ar   !<
-
-!
-!-- Synchronization of the model is done in pmci_synchronize. Therefor the RMA window can be filled
-!-- without sychronization at this point and a barrier is not necessary.
-!-- Please note that waittime has to be set in pmc_s_fillbuffer AND pmc_c_getbuffer.
-    IF ( PRESENT( waittime ) )  THEN
-      t1 = pmc_time()
-      CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
-      t2 = pmc_time()
-      waittime = t2 - t1
-    ENDIF
-
-    lo_ptrans = .FALSE.
-    IF ( PRESENT( particle_transfer ) )    lo_ptrans = particle_transfer
-
-    DO  ip = 1, children(childid)%inter_npes
-       ape => children(childid)%pes(ip)
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-          myindex = 1
-          IF ( ar%dimkey == 2 .AND. .NOT.lo_ptrans  )  THEN         ! PALM 2D REAL*8 Array
-             buf_shape(1) = ape%nrele
-             CALL C_F_POINTER( ar%sendbuf, buf, buf_shape )
-             CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
-             DO  ij = 1, ape%nrele
-                buf(myindex) = data_2d(ape%locind(ij)%j,ape%locind(ij)%i)
-                myindex = myindex + 1
-             ENDDO
-          ELSEIF ( ar%dimkey == 3  .AND. .NOT.lo_ptrans  )  THEN      ! PALM 3D REAL*8 Array
-             buf_shape(1) = ape%nrele*ar%a_dim(4)
-             CALL C_F_POINTER( ar%sendbuf, buf, buf_shape )
-             CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3) )
-             DO  ij = 1, ape%nrele
-                buf(myindex:myindex+ar%a_dim(4)-1) =                                               &
-                data_3d(1:ar%a_dim(4),ape%locind(ij)%j,ape%locind(ij)%i)
-                myindex = myindex + ar%a_dim(4)
-             ENDDO
-          ELSEIF ( ar%dimkey == 22 .AND. lo_ptrans  )  THEN  ! 2D INTEGER*8 Array for particle Transfer
-             buf_shape(1) = ape%nrele
-             CALL C_F_POINTER( ar%sendbuf, ibuf, buf_shape )
-             CALL C_F_POINTER( ar%data, idata_2d, ar%a_dim(1:2) )
-             DO  ij = 1, ape%nrele
-                ibuf(myindex) = idata_2d(ape%locind(ij)%j,ape%locind(ij)%i)
-                myindex = myindex + 1
-             ENDDO
-          ENDIF
-        ENDDO
-    ENDDO
-
-!
-!-- Buffer is filled
-    CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
-
- END SUBROUTINE pmc_s_fillbuffer
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Get client data from RMM window
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_s_getdata_from_buffer( childid, waittime , particle_transfer, child_process_nr )
-
-    INTEGER(iwp) ::  ierr       !<
-    INTEGER(iwp) ::  ij         !<
-    INTEGER(iwp) ::  ip         !<
-    INTEGER(iwp) ::  ip_start   !<
-    INTEGER(iwp) ::  ip_end     !<
-    INTEGER(iwp) ::  j          !<
-    INTEGER(iwp) ::  myindex    !<
-    INTEGER(iwp) ::  nr         !<
-    INTEGER(iwp) ::  target_pe  !<
-
-    INTEGER(iwp), INTENT(IN) ::  childid  !<
-
-    INTEGER(iwp), INTENT(IN), OPTIONAL ::  child_process_nr  !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp  !<
-
-    INTEGER(iwp), DIMENSION(1) ::  buf_shape  !<
-
-    INTEGER(idp), POINTER, DIMENSION(:) ::  ibuf  !<
-
-    INTEGER(idp), POINTER, DIMENSION(:,:) ::  idata_2d  !<
-
-    LOGICAL ::  lo_ptrans  !<
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  particle_transfer  !<
-
-    REAL(wp) ::  t1  !<
-    REAL(wp) ::  t2  !<
-
-    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
-
-    REAL(wp), POINTER, DIMENSION(:) ::  buf  !<
-
-    REAL(wp), POINTER, DIMENSION(:,:) ::  data_2d  !<
-
-    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
-
-    TYPE(pedef), POINTER  ::  ape  !<
-
-    TYPE(arraydef), POINTER ::  ar   !<
-
-
-    t1 = pmc_time()
-
-    IF( PRESENT( child_process_nr ) )  THEN
-       ip_start = child_process_nr
-       ip_end   = child_process_nr
-    ELSE
-       ip_start = 1
-       ip_end   = children(childid)%inter_npes
-    END IF
-
-    lo_ptrans = .FALSE.
-    IF ( PRESENT( particle_transfer ) )  lo_ptrans = particle_transfer
-
-    IF(ip_start == 1)  THEN
-!
-!--    Wait for child to fill buffer
-       CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
-       t2 = pmc_time() - t1
-       IF ( PRESENT( waittime ) )  waittime = t2
-
-       CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
-    ENDIF
-
-    DO  ip = ip_start, ip_end
-       ape => children(childid)%pes(ip)
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-
-          IF ( ar%recvindex < 0 )  CYCLE
-
-          IF ( ar%dimkey == 2  .AND.  .NOT. lo_ptrans  )  THEN
-             nr = ape%nrele
-          ELSEIF ( ar%dimkey == 3  .AND.  .NOT. lo_ptrans  )  THEN
-             nr = ape%nrele * ar%a_dim(4)
-          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
-             nr = ape%nrele
-          ELSE
-             CYCLE            ! Particle arrays are not transfered here
-          ENDIF
-
-          buf_shape(1) = nr
-
-          IF(lo_ptrans)   THEN
-             CALL C_F_POINTER( ar%recvbuf, ibuf, buf_shape )
-          ELSE
-             CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
-          ENDIF
-
-!
-!--       MPI passive target RMA
-          IF ( nr > 0 )  THEN
-             target_disp = ar%recvindex - 1
-!
-!--          Child processes are located behind parent process
-             target_pe = ip - 1 + m_model_npes
-             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED, target_pe, 0, children(childid)%win_parent_child, &
-                                ierr )
-             IF ( lo_ptrans )  THEN
-                CALL MPI_GET( ibuf, nr * 8, MPI_BYTE, target_pe, target_disp, nr * 8,              &
-                              !There is no MPI_INTEGER8 datatype
-                              MPI_BYTE, children(childid)%win_parent_child, ierr )
-             ELSE
-                CALL MPI_GET( buf, nr, MPI_REAL, target_pe, target_disp, nr, MPI_REAL,             &
-                              children(childid)%win_parent_child, ierr )
-             ENDIF
-             CALL MPI_WIN_UNLOCK( target_pe, children(childid)%win_parent_child, ierr )
-          ENDIF
-
-          myindex = 1
-
-          IF ( ar%dimkey == 2  .AND.  .NOT. lo_ptrans )  THEN
-             CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
-             DO  ij = 1, ape%nrele
-                data_2d(ape%locind(ij)%j,ape%locind(ij)%i) = buf(myindex)
-                myindex = myindex + 1
-             ENDDO
-          ELSE IF ( ar%dimkey == 3  .AND.  .NOT. lo_ptrans )  THEN
-             CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3) )
-             DO  ij = 1, ape%nrele
-                data_3d(1:ar%a_dim(4),ape%locind(ij)%j,ape%locind(ij)%i) =                         &
-                buf(myindex:myindex+ar%a_dim(4)-1)
-                myindex = myindex + ar%a_dim(4)
-             ENDDO
-          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
-             CALL C_F_POINTER( ar%data, idata_2d, ar%a_dim(1:2) )
-             DO  ij = 1, ape%nrele
-                idata_2d(ape%locind(ij)%j,ape%locind(ij)%i) = ibuf(myindex)
-                myindex = myindex + 1
-             ENDDO
-          ENDIF
-       ENDDO
-    ENDDO
-
- END SUBROUTINE pmc_s_getdata_from_buffer
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> broadcast name of transfer arrays from child thread 0 to parent threads
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE get_da_names_from_child( childid )
-
-!
-!-- Get data array description and name from child
-    INTEGER(iwp), INTENT(IN) ::  childid  !<
-
-    TYPE(da_namedef) ::  myname  !<
-
-
-    DO
-       CALL pmc_bcast( myname%couple_index, 0, comm=m_to_child_comm(childid) )
-
-       IF ( myname%couple_index == -1 )  EXIT
-
-       CALL pmc_bcast( myname%parentdesc,   0, comm=m_to_child_comm(childid) )
-       CALL pmc_bcast( myname%nameonparent, 0, comm=m_to_child_comm(childid) )
-       CALL pmc_bcast( myname%childdesc,    0, comm=m_to_child_comm(childid) )
-       CALL pmc_bcast( myname%nameonchild,  0, comm=m_to_child_comm(childid) )
-
-       CALL pmc_g_setname( children(childid), myname%couple_index, myname%nameonparent )
-   ENDDO
-
- END SUBROUTINE get_da_names_from_child
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_s_setarray( childid, nrdims, dims, array_adr, second_adr, dimkey )
-
-!
-!-- Set array for child inter process 0
-    INTEGER(iwp) ::  i  !< local counter
-
-    INTEGER(iwp), INTENT(IN) :: childid  !<
-    INTEGER(iwp), INTENT(IN) :: nrdims   !<
-
-    INTEGER(iwp), INTENT(IN), OPTIONAL :: dimkey  !<
-
-    INTEGER(iwp), INTENT(IN), DIMENSION(:) :: dims  !<
-
-    TYPE(C_PTR), INTENT(IN) :: array_adr  !<
-
-    TYPE(C_PTR), INTENT(IN), OPTIONAL ::  second_adr  !<
-
-    TYPE(pedef), POINTER ::  ape  !<
-
-    TYPE(arraydef), POINTER ::  ar   !<
-
-
-    DO  i = 1, children(childid)%inter_npes
-       ape => children(childid)%pes(i)
-       ar  => ape%array_list(next_array_in_list)
-       ar%nrdims = nrdims
-       ar%dimkey = nrdims
-
-       IF( PRESENT( dimkey ) )  ar%dimkey = dimkey
-       ar%a_dim  = dims
-       ar%data   = array_adr
-       IF ( PRESENT( second_adr ) )  THEN
-          ar%po_data(1) = array_adr
-          ar%po_data(2) = second_adr
-       ELSE
-          ar%po_data(1) = C_NULL_PTR
-          ar%po_data(2) = C_NULL_PTR
-       ENDIF
-    ENDDO
-
- END SUBROUTINE pmc_s_setarray
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_s_set_active_data_array( childid, iactive )
-
-    INTEGER(iwp) :: ip  !<
-    INTEGER(iwp) :: j   !<
-
-    INTEGER(iwp), INTENT(IN) ::  childid  !<
-    INTEGER(iwp), INTENT(IN) ::  iactive  !<
-
-    TYPE(pedef), POINTER ::  ape  !<
-
-    TYPE(arraydef), POINTER ::  ar   !<
-
-    DO  ip = 1, children(childid)%inter_npes
-       ape => children(childid)%pes(ip)
-       DO  j = 1, ape%nr_arrays
-          ar => ape%array_list(j)
-          IF ( MOD( ar%dimkey, 10 ) == 2 )  CYCLE  !Not for 2D array
-          IF ( iactive == 1  .OR.  iactive == 2 )  THEN
-             ar%data = ar%po_data(iactive)
-          ENDIF
-       ENDDO
-    ENDDO
-
- END SUBROUTINE pmc_s_set_active_data_array
-
-
- !--------------------------------------------------------------------------------------------------!
- ! Description:
- ! ------------
- !> @todo: Missing function description.
- !--------------------------------------------------------------------------------------------------!
- INTEGER FUNCTION pmc_s_get_child_npes( child_id )
-
-   INTEGER(iwp),INTENT(IN) ::  child_id  !<
-
-   pmc_s_get_child_npes = children(child_id)%inter_npes
-
-   RETURN
-
- END FUNCTION pmc_s_get_child_npes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE set_pe_index_list( mychild, index_list, nrp )
-
-    INTEGER(iwp) :: i        !<
-    INTEGER(iwp) :: ierr     !<
-    INTEGER(iwp) :: ind      !<
-    INTEGER(iwp) :: indwin   !<
-    INTEGER(iwp) :: indwin2  !<
-    INTEGER(iwp) :: i2       !<
-    INTEGER(iwp) :: j        !<
-    INTEGER(iwp) :: rempe    !<
-
-    TYPE(childdef), INTENT(INOUT) ::  mychild  !<
-
-    INTEGER(iwp), DIMENSION(mychild%inter_npes) ::  remind  !<
-
-    INTEGER(iwp), INTENT(IN) ::  nrp  !<
-
-    INTEGER(iwp), INTENT(IN), DIMENSION(:,:) ::  index_list  !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
-
-    INTEGER(iwp), DIMENSION(:), POINTER ::  remindw  !<
-    INTEGER(iwp), DIMENSION(:), POINTER ::  rldef    !<
-
-    TYPE(pedef), POINTER ::  ape  !<
-
-
-!
-!-- First, count entries for every remote child process
-    DO  i = 1, mychild%inter_npes
-       ape => mychild%pes(i)
-       ape%nrele = 0
-    ENDDO
-
-!
-!-- Loop over number of coarse grid cells
-    DO  j = 1, nrp
-       rempe = index_list(5,j) + 1   ! Process number on remote process
-       ape => mychild%pes(rempe)
-       ape%nrele = ape%nrele + 1     ! Increment number of elements for this child process
-    ENDDO
-
-    DO  i = 1, mychild%inter_npes
-       ape => mychild%pes(i)
-       ALLOCATE( ape%locind(ape%nrele) )
-    ENDDO
-
-    remind = 0
-
-!
-!-- Second, create lists
-!-- Loop over number of coarse grid cells
-    DO  j = 1, nrp
-       rempe = index_list(5,j) + 1
-       ape => mychild%pes(rempe)
-       remind(rempe)     = remind(rempe) + 1
-       ind               = remind(rempe)
-       ape%locind(ind)%i = index_list(1,j)
-       ape%locind(ind)%j = index_list(2,j)
-    ENDDO
-
-!
-!-- Prepare number of elements for children processes
-    CALL pmc_alloc_mem( rldef, mychild%inter_npes * 2 )
-
-!
-!-- Number of child processes * size of INTEGER (i just arbitrary INTEGER)
-    winsize = mychild%inter_npes * STORAGE_SIZE( i ) / 8 * 2
-
-    CALL MPI_WIN_CREATE( rldef, winsize, iwp, MPI_INFO_NULL, mychild%intra_comm, indwin, ierr )
-
-!
-!-- Open window to set data
-    CALL MPI_WIN_FENCE( 0, indwin, ierr )
-
-    rldef(1) = 0            ! Index on remote process 0
-    rldef(2) = remind(1)    ! Number of elements on remote process 0
-
-!
-!-- Reserve buffer for index array
-    DO  i = 2, mychild%inter_npes
-       i2          = ( i - 1 ) * 2 + 1
-       rldef(i2)   = rldef(i2-2) + rldef(i2-1) * 2  ! Index on remote process
-       rldef(i2+1) = remind(i)                      ! Number of elements on remote process
-    ENDDO
-
-!
-!-- Close window to allow child to access data
-    CALL MPI_WIN_FENCE( 0, indwin, ierr )
-
-!
-!-- Child has retrieved data
-    CALL MPI_WIN_FENCE( 0, indwin, ierr )
-
-    i2 = 2 * mychild%inter_npes - 1
-    winsize = ( rldef(i2) + rldef(i2+1) ) * 2
-
-!
-!-- Make sure, MPI_ALLOC_MEM works
-    winsize = MAX( winsize, INT( 1, MPI_ADDRESS_KIND ) )
-
-    CALL pmc_alloc_mem( remindw, INT( winsize ) )
-
-    CALL MPI_BARRIER( m_model_comm, ierr )
-    CALL MPI_WIN_CREATE( remindw, winsize * STORAGE_SIZE( i ) / 8, iwp, MPI_INFO_NULL,             &
-                         mychild%intra_comm, indwin2, ierr )
-
-!
-!-- Open window to set data
-    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
-
-!
-!-- Create the 2D index list
-    DO  j = 1, nrp
-       rempe = index_list(5,j) + 1    ! Process number on remote process
-       ape => mychild%pes(rempe)
-       i2    = rempe * 2 - 1
-       ind   = rldef(i2) + 1
-       remindw(ind)   = index_list(3,j)
-       remindw(ind+1) = index_list(4,j)
-       rldef(i2)      = rldef(i2)+2
-    ENDDO
-
-!
-!-- All data are set
-    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
-
-!
-!-- Don't know why, but this barrier is necessary before windows can be freed
-!-- TODO: find out why this is required
-    CALL MPI_BARRIER( mychild%intra_comm, ierr )
-
-    CALL MPI_WIN_FREE( indwin, ierr )
-    CALL MPI_WIN_FREE( indwin2, ierr )
-
-!
-!-- TODO: check if the following idea needs to be done
-!-- Should work, Problem with MPI implementation
-!-- https://www.lrz.de/services/software/parallel/mpi/onesided
-!-- CALL MPI_Free_mem (remindw, ierr)
-
- END SUBROUTINE set_pe_index_list
-#endif
-
-
- END MODULE pmc_parent
Index: palm/trunk/SOURCE/pmc_particle_interface.f90
===================================================================
--- palm/trunk/SOURCE/pmc_particle_interface.f90	(revision 4901)
+++ 	(revision )
@@ -1,1269 +1,0 @@
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! User switch for particle coupling added. Some code reformatting according to follow PALM coding standard.
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! Support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! Bugfix: preprocessor directives for serial mode added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4043 2019-06-18 16:59:00Z schwenkel
-! Remove min_nr_particle
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! Coarse bound renamed as parent_bound and icl, icr, jcs, jcn as ipl, ipr, jps, jpn.
-!
-! 3883 2019-04-10 12:51:50Z hellstea
-! Function get_number_of_childs renamed to get_number_of_children and cg renamed to pg according to
-! their definitions in pmc_interface_mod
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Unused variables removed
-!
-! Initial Version (by Klaus Ketelsen)
-!
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-! Introduce particle transfer in nested models.
-! Interface to palm lpm model to handel particle transfer between parent and child model.
-!--------------------------------------------------------------------------------------------------!
- MODULE pmc_particle_interface
-  
-#if defined( __parallel )
-
-    USE, INTRINSIC ::  ISO_C_BINDING
-
-    USE MPI
-
-    USE kinds
-
-    USE pegrid,                                                                                     &
-         ONLY: myidx,                                                                               &
-               myidy
-
-    USE indices,                                                                                    &
-         ONLY: nbgp,                                                                                &
-               nx,                                                                                  &
-               nxl,                                                                                 &
-               nxr,                                                                                 &
-               nxlg,                                                                                &
-               nxrg,                                                                                &
-               ny,                                                                                  &
-               nys,                                                                                 &
-               nyn,                                                                                 &
-               nysg,                                                                                &
-               nyng,                                                                                &
-               nzb,                                                                                 &
-               nzt
-
-    USE grid_variables,                                                                             &
-         ONLY:  dx,                                                                                 &
-                dy
-
-    USE arrays_3d,                                                                                  &
-         ONLY: zw
-
-    USE control_parameters,                                                                         &
-         ONLY:  message_string
-
-    USE particle_attributes,                                                                        &
-         ONLY:  alloc_factor,                                                                       &
-                grid_particles,                                                                     &
-                ibc_par_lr,                                                                         &
-                ibc_par_ns,                                                                         &
-                ibc_par_t,                                                                          &
-                particles,                                                                          &
-                particle_type,                                                                      &
-                prt_count,                                                                          &
-                number_of_particles,                                                                &
-                zero_particle
-
-!     USE lpm_pack_and_sort_mod
-
-#if defined( __parallel )
-    USE pmc_general,                                                                                &
-         ONLY: pedef
-
-    USE pmc_parent,                                                                                 &
-         ONLY: children,                                                                            &
-               pmc_s_fillbuffer,                                                                    &
-               pmc_s_getdata_from_buffer,                                                           &
-               pmc_s_get_child_npes
-
-    USE pmc_child,                                                                                  &
-         ONLY:  me,                                                                                 &
-                pmc_c_getbuffer,                                                                    &
-                pmc_c_putbuffer
-
-    USE pmc_interface,                                                                              &
-         ONLY:  coord_x,                                                                            &
-                coord_y,                                                                            &
-                cpl_id,                                                                             &
-                get_childid,                                                                        &
-                get_child_edges,                                                                    &
-                get_child_gridspacing,                                                              &
-                get_number_of_children,                                                             &
-                lower_left_coord_x,                                                                 &
-                lower_left_coord_y,                                                                 &
-                nested_run,                                                                         &
-                nr_part,                                                                            &
-                nr_partc,                                                                           &
-                parent_bound,                                                                       &
-                particle_coupling,                                                                  &
-                part_adr,                                                                           &
-                part_adrc,                                                                          &
-                pg
-
-    USE pmc_handle_communicator,                                                                    &
-         ONLY:  pmc_parent_for_child
-
-    USE pmc_mpi_wrapper,                                                                            &
-         ONLY:   pmc_recv_from_child,                                                               &
-                pmc_send_to_parent
-
-#endif
-
-    IMPLICIT NONE
-
-    PRIVATE
-    SAVE
-
-    TYPE  coarse_particle_def
-       INTEGER(iwp) ::  nr_particle  !<
-
-       TYPE(particle_type),ALLOCATABLE,DIMENSION(:) ::  parent_particles  !<
-    END TYPE  coarse_particle_def
-
-    INTEGER(iwp),PARAMETER ::  max_nr_particle_in_rma_win = 100000  !<
-    INTEGER(iwp),PARAMETER ::  min_particles_per_column   = 100     !<
-
-
-    INTEGER(iwp) ::  nr_fine_in_coarse   !< Number of fine grid cells in coarse grid (one direction)
-    INTEGER(iwp) ::  particle_win_child  !<
-
-    INTEGER(iwp),ALLOCATABLE,DIMENSION(:) ::  particle_win_parent  !<
-
-    TYPE(C_PTR), ALLOCATABLE,DIMENSION(:) ::  buf_ptr  !<
-
-    TYPE(particle_type), DIMENSION(:),POINTER ::  particle_in_win  !<
-
-    TYPE(coarse_particle_def),ALLOCATABLE,DIMENSION(:,:) ::  coarse_particles  !<
-
-    INTERFACE pmcp_g_init
-       MODULE PROCEDURE pmcp_g_init
-    END  INTERFACE pmcp_g_init
-   
-    INTERFACE pmcp_g_alloc_win
-       MODULE PROCEDURE pmcp_g_alloc_win
-    END  INTERFACE pmcp_g_alloc_win
-
-    INTERFACE pmcp_c_get_particle_from_parent
-       MODULE PROCEDURE pmcp_c_get_particle_from_parent
-    END  INTERFACE pmcp_c_get_particle_from_parent
-
-    INTERFACE pmcp_c_send_particle_to_parent
-       MODULE PROCEDURE pmcp_c_send_particle_to_parent
-    END  INTERFACE pmcp_c_send_particle_to_parent
-
-    INTERFACE pmcp_p_fill_particle_win
-       MODULE PROCEDURE pmcp_p_fill_particle_win
-    END  INTERFACE pmcp_p_fill_particle_win
-
-    INTERFACE pmcp_p_empty_particle_win
-       MODULE PROCEDURE pmcp_p_empty_particle_win
-    END  INTERFACE pmcp_p_empty_particle_win
-    
-    INTERFACE pmcp_g_print_number_of_particles
-       MODULE PROCEDURE pmcp_g_print_number_of_particles
-    END  INTERFACE pmcp_g_print_number_of_particles
-
-    INTERFACE pmcp_p_delete_particles_in_fine_grid_area
-       MODULE PROCEDURE pmcp_p_delete_particles_in_fine_grid_area
-    END  INTERFACE pmcp_p_delete_particles_in_fine_grid_area
-
-    PUBLIC pmcp_g_init, pmcp_g_alloc_win, pmcp_c_get_particle_from_parent
-    PUBLIC pmcp_c_send_particle_to_parent, pmcp_p_fill_particle_win, pmcp_g_print_number_of_particles
-    PUBLIC pmcp_p_empty_particle_win, pmcp_p_delete_particles_in_fine_grid_area
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> General routine:
-!> Initializing actions of the particle interface check particle boundary conditions for the child
-!> models
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmcp_g_init
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  nr_childs  !< Number of child models of the current model
-
-#if defined( __parallel )
-
-    nr_childs = get_number_of_children()
-!
-!-- Check if the current model has child models
-    IF ( nr_childs > 0 )  THEN
-       ALLOCATE( nr_part(nysg:nyng, nxlg:nxrg) )
-       ALLOCATE( part_adr(nysg:nyng, nxlg:nxrg) )
-       nr_part  = 0
-       part_adr = 0
-    ENDIF
-!
-!-- Set the boundary conditions to nested for all non root (i.e child) models
-    IF ( cpl_id > 1 )  THEN
-       IF ( particle_coupling )  THEN
-          IF ( ibc_par_t /= 3 )  THEN
-             ibc_par_t  = 3
-             message_string = 'In Child model:  ibc_par_t is automatically set to nested '
-             CALL message( 'pmcp_g_init ', 'PA0477', 0, 1, 0, 6, 0 )
-          ENDIF
-
-          IF ( ibc_par_lr /= 3 )  THEN
-             ibc_par_lr = 3
-             message_string = 'In Child model:  ibc_par_lr is automatically set to nested '
-             CALL message( 'pmcp_g_init ', 'PA0478', 0, 1, 0, 6, 0 )
-          ENDIF
-
-          IF ( ibc_par_ns /= 3 )  THEN
-             ibc_par_ns = 3
-             message_string = 'In Child model:  ibc_par_ns is automatically set to nested '
-             CALL message( 'pmcp_g_init ', 'PA0479', 0, 1, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-    ENDIF
-
-#endif
- END SUBROUTINE pmcp_g_init
-
-  
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> General routine:
-!> Allocate the MPI windows
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmcp_g_alloc_win
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  child_id   !< Id of a child model
-    INTEGER(iwp) ::  ierr       !< error code
-    INTEGER(iwp) ::  ipl        !< left boundary in coarse(parent) index space
-    INTEGER(iwp) ::  ipr        !< right boundary in coarse(parent) index space
-    INTEGER(iwp) ::  jps        !< south boundary in coarse(parent) index space
-    INTEGER(iwp) ::  jpn        !< north boundary in coarse(parent) index space
-    INTEGER(iwp) ::  m          !< loop index
-    INTEGER(iwp) ::  nr_childs  !< Number of child models of the current model
-
-    INTEGER ::  parsize  !<
-
-    INTEGER(iwp),DIMENSION(1) ::  buf_shape  !<
-
-    TYPE(C_PTR), SAVE ::  ptr  !<
-
-    TYPE(particle_type),DIMENSION(:),POINTER ::  win_buffer  !<
-
-
-#if defined( __parallel )
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  parsize_mpi_address_kind  !<
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize                   !<
-
-!
-!-- If the model has a parent model prepare the structures for transfer
-    IF ( cpl_id > 1 )  THEN
-
-       parsize_mpi_address_kind = STORAGE_SIZE(zero_particle) / 8
-
-       CALL MPI_ALLOC_MEM( parsize_mpi_address_kind , MPI_INFO_NULL, ptr, ierr )
-       parsize = parsize_mpi_address_kind
-       buf_shape(1) = 1
-       CALL C_F_POINTER( ptr, win_buffer, buf_shape )
-       CALL MPI_WIN_CREATE( win_buffer, parsize_mpi_address_kind, parsize, MPI_INFO_NULL,          &
-                            me%intra_comm, particle_win_child, ierr )
-
-!
-!--    Child domain boundaries in the parent index space
-       ipl = parent_bound(1)
-       ipr = parent_bound(2)
-       jps = parent_bound(3)
-       jpn = parent_bound(4)
-
-       ALLOCATE( coarse_particles(jps:jpn,ipl:ipr) )
-
-       coarse_particles(:,:)%nr_particle = 0
-    ENDIF
-
-!
-!-- If the model has child models prepare the structures for transfer
-    nr_childs = get_number_of_children()
-    IF ( nr_childs > 0 )   THEN
-       ALLOCATE( particle_win_parent(nr_childs) )
-       ALLOCATE( buf_ptr(nr_childs) )
-       DO  m = 1, nr_childs
-          child_id = get_childid(m)
-          parsize_mpi_address_kind = STORAGE_SIZE(zero_particle) / 8
-          parsize = parsize_mpi_address_kind
-
-          winsize = max_nr_particle_in_rma_win * parsize_mpi_address_kind
-          CALL MPI_ALLOC_MEM( winsize , MPI_INFO_NULL, buf_ptr(m), ierr )
-          buf_shape(1) = max_nr_particle_in_rma_win
-          CALL C_F_POINTER( buf_ptr(m), win_buffer, buf_shape )
-          CALL MPI_WIN_CREATE( win_buffer, winsize, parsize, MPI_INFO_NULL,                        &
-                               children(child_id)%intra_comm, particle_win_parent(m), ierr )
-          ENDDO
-    ENDIF
-
-#endif
- END SUBROUTINE pmcp_g_alloc_win
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Child routine:
-!> Read/get particles out of the parent MPI window
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmcp_c_get_particle_from_parent
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !< x grid index
-    INTEGER(iwp) ::  ierr  !< error code
-    INTEGER(iwp) ::  ij    !< combined xy index for the buffer array
-    INTEGER(iwp) ::  ip    !< loop index (child PEs)
-    INTEGER(iwp) ::  ipl   !< left boundary in coarse(parent) index space
-    INTEGER(iwp) ::  j     !< y grid index
-    INTEGER(iwp) ::  jps   !< south boundary in coarse(parent) index space
-    INTEGER(iwp) ::  nr    !< number of particles to receive from a parent box
-
-    INTEGER ::  parsize !<
-
-#if defined( __parallel )
-    TYPE(pedef), POINTER ::  ape  !< TO_DO Klaus: give a description and better name of the variable
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  parsize_mpi_address_kind  !<
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp               !<
-
-    IF ( cpl_id > 1 )  THEN
-
-       CALL pmc_c_getbuffer( particle_transfer = .TRUE. ) !Get number of particle/column and offset in RMA window xx
-
-!
-!--    Wait for buffer to fill.
-!
-!--    The parent side (in pmc_s_fillbuffer) is filling the buffer in the MPI RMA window. When the
-!--    filling is complete, a MPI_BARRIER is called. The child is not allowd to access the
-!--    parent-buffer before it is completely filled. Synchronization is done implicitely in
-!--    pmc_c_getbuffer and pmc_s_fillbuffer on the parent side.
-
-       ipl = parent_bound(1)
-       jps = parent_bound(3)
-
-       DO  ip = 1, me%inter_npes
-
-          ape => me%pes(ip)
-
-          DO  ij = 1, ape%nrele
-              j  = ape%locind(ij)%j + jps - 1
-              i  = ape%locind(ij)%i + ipl - 1
-              nr = nr_partc(j,i)
-              IF ( nr > 0 )  THEN
-
-                 CALL check_and_alloc_coarse_particle (i, j, nr)
-                 parsize_mpi_address_kind = STORAGE_SIZE(zero_particle) / 8
-                 parsize = parsize_mpi_address_kind
-                 target_disp = part_adrc(j,i) - 1
-                 CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip - 1, 0, particle_win_child, ierr )
-                 CALL MPI_GET( coarse_particles(j,i)%parent_particles, nr * parsize, MPI_BYTE,     &
-                               ip - 1, target_disp, nr * parsize, MPI_BYTE, particle_win_child,    &
-                               ierr )
-                 CALL MPI_WIN_UNLOCK( ip - 1, particle_win_child, ierr )
-             ENDIF
-             coarse_particles(j,i)%nr_particle = nr
-          ENDDO
-       ENDDO
-
-       CALL c_copy_particle_to_child_grid
-    ENDIF
-
-#endif
- END SUBROUTINE pmcp_c_get_particle_from_parent
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Child routine:
-!> Write/put particles into the parent MPI window
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmcp_c_send_particle_to_parent
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  disp_offset             !<
-    INTEGER(iwp) ::  i                       !< x loop index
-    INTEGER(iwp) ::  ierr                    !< error code
-    INTEGER(iwp) ::  ij                      !< combined xy index for the buffer array
-    INTEGER(iwp) ::  ip                      !< loop index (child PEs)
-    INTEGER(iwp) ::  ipl                     !< left boundary in coarse(parent) index space
-    INTEGER(iwp) ::  ipr                     !< right boundary in coarse(parent) index space
-    INTEGER(iwp) ::  j                       !< y loop index
-    INTEGER(iwp) ::  jpn                     !< north boundary in coarse(parent) index space
-    INTEGER(iwp) ::  jps                     !< south boundary in coarse(parent) index space
-    INTEGER(iwp) ::  max_nr_particle_per_pe  !< maximum number of particles per PE (depending on grid apect ratio)
-    INTEGER(iwp) ::  n                       !< shorter variable name for nr_fine_in_coarse
-    INTEGER(iwp) ::  nr                      !< shorter variabel name for nr_partc
-    INTEGER(iwp) ::  pe_offset               !< offset index of the current PE
-
-    INTEGER ::  parsize  !<
-
-    REAL(wp) ::  eps=0.00001  !< used in calculations to avoid rounding errors
-    REAL(wp) ::  xx           !< number of fine grid cells inside a coarse grid cell in x-direction
-    REAL(wp) ::  yy           !< number of fine grid cells inside a coarse grid cell in y-direction
-
- !   TYPE(particle_type) ::  dummy_part !< dummy particle (needed for size calculations)
-
-#if defined( __parallel )
-    TYPE(pedef), POINTER ::  ape  !< TO_DO Klaus: give a description and better name of the variable
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  parsize_mpi_address_kind  !<
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp               !<
-
-
-    IF ( cpl_id > 1 )  THEN
-       CALL c_copy_particle_to_coarse_grid
-
-!
-!--    Child domain boundaries in the parent index space
-
-       ipl = parent_bound(1)
-       ipr = parent_bound(2)
-       jps = parent_bound(3)
-       jpn = parent_bound(4)
-
-       nr_partc = 0
-
-       DO i = ipl, ipr
-          DO j = jps, jpn
-             nr_partc(j,i) = coarse_particles(j,i)%nr_particle
-          ENDDO
-       ENDDO
-       part_adrc = 0
-
-!
-!--    Compute number of fine grid cells in coarse grid (one direction)
-       xx = ( pg%dx + eps ) / dx ! +eps to avoid rounding error
-       yy = ( pg%dy + eps ) / dy
-       nr_fine_in_coarse = MAX( INT( xx ), INT( yy ) )
-
-       IF ( MOD( coord_x(0), pg%dx ) /= 0.0 .OR. MOD( coord_y(0), pg%dy ) /= 0.0 )  THEN
-          nr_fine_in_coarse = nr_fine_in_coarse + 1
-       ENDIF
-
-!
-!--    Assign a number to my child PE to select different areas in the RMA window on server side
-!--    With this number a square of child PEs is defined which share the same coarse grid cells
-
-       n           = nr_fine_in_coarse ! Local variable n to make folloing statements shorter
-       pe_offset   = MOD( myidx, n ) * n + MOD( myidy, n)
-       max_nr_particle_per_pe = max_nr_particle_in_rma_win / ( n * n )
-       disp_offset            = pe_offset * max_nr_particle_per_pe
-       parsize_mpi_address_kind = STORAGE_SIZE(zero_particle) /8
-       parsize = parsize_mpi_address_kind
-       DO  ip = 1, me%inter_npes
-
-          ape => me%pes(ip)
-
-          target_disp = disp_offset
-          DO  ij = 1, ape%nrele
-             j  = ape%locind(ij)%j + jps - 1
-             i  = ape%locind(ij)%i + ipl - 1
-             nr = nr_partc(j,i)
-             IF( nr > 0 )  THEN
-                IF ( target_disp + nr - disp_offset >= max_nr_particle_per_pe )  THEN
-                   WRITE( 9, * ) 'RMA window too small on child ',                                 &
-                                 target_disp + nr - disp_offset, max_nr_particle_per_pe,           &
-                                 max_nr_particle_in_rma_win
-                   message_string = 'RMA window too small on child'
-                   CALL message( 'pmci_create_child_arrays', 'PA0480', 3, 2, 0, 6, 0 )
-                ENDIF
-                CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip - 1, 0, particle_win_child, ierr )
-                CALL MPI_PUT( coarse_particles(j,i)%parent_particles, nr * parsize, MPI_BYTE,      &
-                              ip - 1, target_disp, nr * parsize, MPI_BYTE,  particle_win_child,    &
-                              ierr )
-                CALL MPI_WIN_UNLOCK( ip - 1, particle_win_child, ierr )
-                part_adrc(j,i) = target_disp + 1
-                target_disp    = target_disp + nr
-             ENDIF
-          ENDDO
-       ENDDO
-
-       CALL pmc_c_putbuffer ( particle_transfer = .TRUE. )   !Send new number of particle/column and offset to parent
-
-    ENDIF
-
-#endif
- END SUBROUTINE pmcp_c_send_particle_to_parent
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parent routine:
-!> Write particles into the MPI window
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmcp_p_fill_particle_win
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  child_id             !< id of the child model
-    INTEGER(iwp) ::  i                    !< x grid box index
-    INTEGER(iwp) ::  ij                   !< combined xy index for the buffer array
-    INTEGER(iwp) ::  ip                   !< loop index (child PEs)
-    INTEGER(iwp) ::  j                    !< y grid box index
-    INTEGER(iwp) ::  k                    !< z grid box index
-    INTEGER(iwp) ::  m                    !< loop index (number of childs)
-    INTEGER(iwp) ::  n                    !< loop index (number of particles)
-    INTEGER(iwp) ::  nr_part_col          !< Number of particles to transfer per column
-    INTEGER(iwp) ::  number_of_particles  !<
-    INTEGER(iwp) ::  pindex               !<
-    INTEGER(iwp) ::  tot_particle_count   !< Total number of particles per child
-
-    INTEGER(iwp),DIMENSION(1) ::  buf_shape  !<
-
-    LOGICAL      ::  active_particle  !< Particles located in the fine/child grid area are marked as active (to be transferred)
-    LOGICAL,SAVE ::  lfirst = .TRUE.  !<
-
-    REAL(wp) ::  dx_child    !< child grid spacing
-    REAL(wp) ::  dy_child    !< child grid spacing
-    REAL(wp) ::  dz_child    !< child grid spacing
-    REAL(wp) ::  ny_coord    !< north coordinate of child grid
-    REAL(wp) ::  ny_coord_b  !< north coordinate of child grid boundary
-    REAL(wp) ::  lx_coord    !< left coordinate of child grid
-    REAL(wp) ::  lx_coord_b  !< left coordinate of child grid boundary
-    REAL(wp) ::  rx_coord    !< right coordinate of child grid
-    REAL(wp) ::  rx_coord_b  !< right coordinate of child grid boundary
-    REAL(wp) ::  sy_coord    !< south coordinate of child grid
-    REAL(wp) ::  sy_coord_b  !< south coordinate of child grid boundary
-    REAL(wp) ::  uz_coord    !< upper coordinate of child grid
-    REAL(wp) ::  uz_coord_b  !< upper coordinate of child grid boundary
-    REAL(wp) ::  x           !< particle position
-    REAL(wp) ::  y           !< particle position
-    REAL(wp) ::  z           !< particle position
-
-
-#if defined( __parallel )
-    TYPE(pedef), POINTER ::  ape  !< TO_DO Klaus: give a description and better name of the variable
-
-    DO  m = 1, get_number_of_children()
-
-       child_id = get_childid(m)
-
-       CALL get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b, sy_coord, sy_coord_b,  &
-                             ny_coord, ny_coord_b, uz_coord, uz_coord_b)
-
-       CALL get_child_gridspacing( m, dx_child, dy_child, dz_child )
-
-       IF ( lfirst )   THEN
-          WRITE( 9, '(a,5f10.2)' ) 'edges          ', lx_coord,rx_coord, sy_coord, ny_coord,       &
-                                                      uz_coord
-          WRITE( 9, '(a,5f10.2)' ) 'edges boundary ', lx_coord_b, rx_coord_b, sy_coord_b,          &
-                                                      ny_coord_b, uz_coord_b
-          WRITE( 9, '(a,5f10.2)' ) 'child spacing  ', dx_child, dy_child, dz_child,                &
-                                                      lower_left_coord_x,lower_left_coord_y
-     ENDIF
-!
-!--    Reset values for every child
-       tot_particle_count = 0
-       nr_part  = 0
-       part_adr = 0
-       pindex   = 1
-
-       buf_shape(1) = max_nr_particle_in_rma_win
-       CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
-
-       DO  ip = 1, children(child_id)%inter_npes
-
-          ape => children(child_id)%pes(ip)
-
-          nr_part_col   = 0
-
-          DO  ij = 1, ape%nrele
-
-!
-!--          Inside the PMC adressing of 3d arrays starts with 1
-             i = ape%locind(ij)%i + nxl - nbgp - 1
-             j = ape%locind(ij)%j + nys - nbgp - 1
-             nr_part_col = 0   ! Number of particles to transfer per column
-             part_adr(j,i) = pindex
-
-             DO  k = nzb + 1, nzt
-                number_of_particles = prt_count(k,j,i)
-
-                IF ( number_of_particles <= 0 )  CYCLE
-
-                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-
-                ! Select particles within boundary area
-
-                DO  n = 1, number_of_particles
-                   x = particles(n)%x
-                   y = particles(n)%y
-                   z = particles(n)%z
-!
-!--                Check if the particle is located in the fine grid area
-                   active_particle = ( (x > lx_coord .AND. x < rx_coord) .AND.                     &
-                                       (y > sy_coord .AND. y < ny_coord) .AND.                     &
-                                       (z > 0.000000001 .AND. z < uz_coord) )
-                   IF ( active_particle .AND. particles(n)%particle_mask )  THEN
-
-                      particle_in_win(pindex) = particles(n)
-!
-!--                   Change particle positions and origin relative to global origin
-                      particle_in_win(pindex)%x = particle_in_win(pindex)%x + lower_left_coord_x
-                      particle_in_win(pindex)%y = particle_in_win(pindex)%y + lower_left_coord_y
-                      particle_in_win(pindex)%origin_x = particle_in_win(pindex)%origin_x          &
-                                                         + lower_left_coord_x
-                      particle_in_win(pindex)%origin_y = particle_in_win(pindex)%origin_y          &
-                                                         + lower_left_coord_y
-
-                      tot_particle_count = tot_particle_count + 1
-                      nr_part_col        = nr_part_col + 1
-                      pindex             = pindex + 1
-                      IF ( pindex > max_nr_particle_in_rma_win )  THEN
-                         WRITE( 9, * ) 'RMA window too small on parent ', pindex,                  &
-                                                                          max_nr_particle_in_rma_win
-                         message_string = 'RMA window too small on parent'
-                         CALL message( 'pmci_create_child_arrays', 'PA0481', 3, 2, 0, 6, 0 )   ! PA number has to be adjusted
-                     ENDIF
-                   END IF
-                ENDDO
-             ENDDO
-             nr_part(j,i) = nr_part_col
-          ENDDO
-       ENDDO
-
-       CALL pmc_s_fillbuffer( child_id, particle_transfer = .TRUE. )
-    ENDDO
-
-    lfirst = .FALSE.
-
-#endif
- END SUBROUTINE pmcp_p_fill_particle_win
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parent routine:
-!> Delete particles from the MPI window
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmcp_p_empty_particle_win
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  child_id  !< model id of the child
-    INTEGER(iwp) ::  ip        !< loop index (child PEs)
-    INTEGER(iwp) ::  m         !< loop index (number of childs)
-
-    INTEGER(iwp),DIMENSION(1) ::  buf_shape  !<
-
-#if defined( __parallel )
-    DO  m = 1, get_number_of_children()
-
-       child_id = get_childid(m)
-
-       buf_shape(1) = max_nr_particle_in_rma_win
-       CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
-
-!
-!--    In some cells of the coarse grid, there are contributions from more than one child process.
-!--    Therefore p_copy_particle_to_org_grid is done for one child process per call
-       DO  ip = 1, pmc_s_get_child_npes( child_id )
-
-          nr_part  = 0
-          part_adr = 0
-
-          CALL pmc_s_getdata_from_buffer( child_id, particle_transfer = .TRUE.,                    &
-                                          child_process_nr = ip )
-          CALL p_copy_particle_to_org_grid( m )
-       ENDDO
-
-    ENDDO
-
-#endif
- END SUBROUTINE pmcp_p_empty_particle_win
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parent routine:
-!> After the transfer mark all parent particles that are still inside on of the child areas for
-!> deletion.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmcp_p_delete_particles_in_fine_grid_area
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< loop index (x grid)
-    INTEGER(iwp) ::  j  !< loop index (y grid)
-    INTEGER(iwp) ::  k  !< loop index (z grid)
-    INTEGER(iwp) ::  m  !< loop index (number of particles)
-    INTEGER(iwp) ::  n  !< loop index (number of childs)
-
-    LOGICAL ::  to_delete  !< particles outside of model domain are marked as to_delete
-
-    REAL(wp) ::  dx_child    !< child grid spacing
-    REAL(wp) ::  dy_child    !< child grid spacing
-    REAL(wp) ::  dz_child    !< child grid spacing
-    REAL(wp) ::  ny_coord    !< north coordinate of child grid
-    REAL(wp) ::  ny_coord_b  !< north coordinate of child grid boundary
-    REAL(wp) ::  lx_coord    !< left coordinate of child grid
-    REAL(wp) ::  lx_coord_b  !< left coordinate of child grid boundary
-    REAL(wp) ::  rx_coord    !< right coordinate of child grid
-    REAL(wp) ::  rx_coord_b  !< right coordinate of child grid boundary
-    REAL(wp) ::  sy_coord    !< south coordinate of child grid
-    REAL(wp) ::  sy_coord_b  !< south coordinate of child grid boundary
-    REAL(wp) ::  uz_coord    !< upper coordinate of child grid
-    REAL(wp) ::  uz_coord_b  !< upper coordinate of child grid boundary
-    REAL(wp) ::  x           !< particle position
-    REAL(wp) ::  y           !< particle position
-    REAL(wp) ::  z           !< particle position
-
-#if defined( __parallel )
-    DO  m = 1, get_number_of_children()
-       CALL get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b, sy_coord, sy_coord_b,  &
-                             ny_coord, ny_coord_b, uz_coord, uz_coord_b )
-
-
-       CALL get_child_gridspacing( m, dx_child, dy_child, dz_child )
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb, nzt
-                number_of_particles = prt_count(k,j,i)
-
-                IF ( number_of_particles == 0 )  CYCLE
-
-                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-
-                DO  n = 1, number_of_particles
-                   x = particles(n)%x
-                   y = particles(n)%y
-                   z = particles(n)%z
-
-                   to_delete = ( (x > lx_coord .AND. x < rx_coord) .AND.                           &
-                                 (y > sy_coord .AND. y < ny_coord) .AND.                           &
-                                 (z > 0.000000001 .AND. z < uz_coord) )
-
-                   IF ( to_delete )  THEN
-                      particles(n)%particle_mask = .FALSE.
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ENDDO
-
-#endif
- END SUBROUTINE pmcp_p_delete_particles_in_fine_grid_area
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> General routine:
-!> Print the total number of of the current model and its child models into a file
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmcp_g_print_number_of_particles( my_time, local_nr_particles )
-
-    USE pegrid,                                                                                    &
-        ONLY: myid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=16) ::  fname  !< filename
-
-    INTEGER(iwp) ::  child_id            !<
-    INTEGER(iwp) ::  child_nr_particles  !< total number of particles in all child models
-    INTEGER(iwp) ::  ierr                !< error code
-    INTEGER(iwp) ::  m                   !< loop index (number of childs
-
-    INTEGER(iwp),INTENT(IN) ::  local_nr_particles  !<
-
-    INTEGER(iwp),DIMENSION(2) ::  ivalr  !< integer value to be received
-    INTEGER(iwp),DIMENSION(2) ::  ivals  !< integer value to be send
-
-    LOGICAL, SAVE ::  is_file_open=.FALSE.  !<
-
-    REAL(wp),INTENT(IN) ::  my_time  !<
-
-
-#if defined( __parallel )
-    child_nr_particles = 0
-    IF ( myid == 0 )  THEN
-       IF ( cpl_id > 1 )  THEN
-          ivals(1) = local_nr_particles
-          CALL pmc_send_to_parent( ivals, 1, 0, 400, ierr )
-       ENDIF
-       DO  m = 1, SIZE( pmc_parent_for_child ) - 1
-
-          child_id = pmc_parent_for_child(m)
-          CALL pmc_recv_from_child( child_id, ivalr, 1, 0, 400, ierr )
-          child_nr_particles = child_nr_particles + ivalr(1)
-       ENDDO
-
-       IF ( SIZE( pmc_parent_for_child ) > 1 )  THEN
-          IF ( .NOT. is_file_open )  THEN  !kk muss noch auf file_open umgestellt werden
-             WRITE( fname, '(a,i2.2)' ) 'nr_particles_', cpl_id
-             OPEN ( 333, FILE = fname )
-             is_file_open = .true.
-          ENDIF
-          WRITE( 333, '(f12.2,3i10)' ) my_time, local_nr_particles + child_nr_particles,           &
-                                       local_nr_particles, child_nr_particles
-       ENDIF
-    ENDIF
-
-#endif
- END SUBROUTINE pmcp_g_print_number_of_particles
-
-
-!--------------------------------------------------------------------------------------------------!
-!--------------------------------------------------------------------------------------------------!
-! Private subroutines
-!--------------------------------------------------------------------------------------------------!
-!--------------------------------------------------------------------------------------------------!
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Child routine
-!> Update the size of the local buffer (coarse_particles)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE check_and_alloc_coarse_particle( ic, jc, nr, with_copy )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp),INTENT(IN) ::  ic  !< coarse x grid index
-    INTEGER(iwp),INTENT(IN) ::  jc  !< coarse y grid index
-    INTEGER(iwp),INTENT(IN) ::  nr  !< number of particles to be transferred/stored in local buffer
-
-    INTEGER(iwp) ::  new_size  !< new size of the local buffer
-    INTEGER(iwp) ::  old_size  !< old size of the local buffer
-
-    LOGICAL :: with_copy_lo  !< local variable of with copy
-
-    LOGICAL,INTENT(IN),OPTIONAL ::  with_copy  !< copy particles in buffer? or reallocate empty buffer
-
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  tmp_particles_d  !<
-
-#if defined( __parallel )
-    with_copy_lo = .FALSE.
-    IF ( PRESENT( with_copy ) )  with_copy_lo = with_copy
-
-    IF ( .NOT. ALLOCATED( coarse_particles(jc,ic)%parent_particles ) )  THEN
-       new_size = MAX( nr, min_particles_per_column )
-       ALLOCATE( coarse_particles(jc,ic)%parent_particles(new_size) )
-    ELSEIF ( nr > SIZE( coarse_particles(jc,ic)%parent_particles ) )  THEN
-
-       old_size = SIZE( coarse_particles(jc,ic)%parent_particles )
-       new_size = old_size * ( 1.0_wp + alloc_factor / 100.0_wp )
-       new_size = MAX( nr, new_size, old_size + min_particles_per_column )
-
-!
-!--    Copy existing particles to new particle buffer
-       IF ( with_copy_lo )  THEN
-          ALLOCATE( tmp_particles_d(old_size) )
-          tmp_particles_d(1:old_size) = coarse_particles(jc,ic)%parent_particles
-
-          DEALLOCATE( coarse_particles(jc,ic)%parent_particles )
-          ALLOCATE( coarse_particles(jc,ic)%parent_particles(new_size) )
-
-          coarse_particles(jc,ic)%parent_particles(1:old_size)          = tmp_particles_d(1:old_size)
-          coarse_particles(jc,ic)%parent_particles(old_size+1:new_size) = zero_particle
-
-          DEALLOCATE( tmp_particles_d )
-!
-!--    allocate or reallocate an empty buffer
-       ELSE
-          DEALLOCATE( coarse_particles(jc,ic)%parent_particles )
-          ALLOCATE( coarse_particles(jc,ic)%parent_particles(new_size) )
-       ENDIF
-    ENDIF
-
-#endif
- END SUBROUTINE check_and_alloc_coarse_particle
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Child routine:
-!> Copy/sort particles out of the local buffer into the respective grid boxes
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE c_copy_particle_to_child_grid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ic   !< coarse x grid index
-    INTEGER(iwp) ::  ipl  !< left boundary in coarse(parent) index space
-    INTEGER(iwp) ::  ipr  !< right boundary in coarse(parent) index space
-    INTEGER(iwp) ::  ip   !< x grid index
-    INTEGER(iwp) ::  jc   !< coarse y grid index
-    INTEGER(iwp) ::  jpn  !< north boundary in coarse(parent) index space
-    INTEGER(iwp) ::  jps  !< south boundary in coarse(parent) index space
-    INTEGER(iwp) ::  jp   !< y grid index
-    INTEGER(iwp) ::  kp   !< z grid index
-    INTEGER(iwp) ::  n    !< loop index (number of particles)
-    INTEGER(iwp) ::  nr   !< short variable for name number or particles
-
-    REAL(wp) ::  xc   !< child x coordinate
-    REAL(wp) ::  xoc  !< child x origin
-    REAL(wp) ::  yc   !< child y coordinate
-    REAL(wp) ::  yoc  !< child y origin
-    REAL(wp) ::  zc   !< child z coordinate
-
-#if defined( __parallel )
-!
-!-- Child domain boundaries in the parent index space
-    ipl = parent_bound(1)
-    ipr = parent_bound(2)
-    jps = parent_bound(3)
-    jpn = parent_bound(4)
-
-    DO  ic = ipl, ipr
-       DO  jc = jps, jpn
-          nr = coarse_particles(jc,ic)%nr_particle
-
-          IF ( nr > 0 )  THEN
-             DO  n = 1, nr
-                xc =  coarse_particles(jc,ic)%parent_particles(n)%x-lower_left_coord_x
-                yc =  coarse_particles(jc,ic)%parent_particles(n)%y-lower_left_coord_y
-                zc =  coarse_particles(jc,ic)%parent_particles(n)%z
-                xoc = coarse_particles(jc,ic)%parent_particles(n)%origin_x-lower_left_coord_x
-                yoc = coarse_particles(jc,ic)%parent_particles(n)%origin_y-lower_left_coord_y
-                ip = xc / dx
-                jp = yc / dy
-                kp = nzt
-                DO WHILE ( zw(kp-1) > zc .AND. kp > nzb + 1 )  ! kk search loop has to be optimzed !!!
-                   kp = kp - 1
-                ENDDO
-
-                IF ( ip >= nxl  .AND.  ip <= nxr  .AND.  jp >= nys  .AND.  jp <= nyn )  THEN
-                   prt_count(kp,jp,ip) = prt_count(kp,jp,ip) + 1
-                   IF ( prt_count(kp,jp,ip) > SIZE( grid_particles(kp,jp,ip)%particles ) )  THEN
-                      CALL pmc_realloc_particles_array( ip, jp, kp )
-                   ENDIF
-                   coarse_particles(jc,ic)%parent_particles(n)%x = xc         ! Adjust coordinates to child grid
-                   coarse_particles(jc,ic)%parent_particles(n)%y = yc
-                   coarse_particles(jc,ic)%parent_particles(n)%origin_x = xoc ! Adjust origins to child grid
-                   coarse_particles(jc,ic)%parent_particles(n)%origin_y = yoc
-                   grid_particles(kp,jp,ip)%particles(prt_count(kp,jp,ip))                         &
-                                                       = coarse_particles(jc,ic)%parent_particles(n)
-                ENDIF
-             ENDDO
-          ENDIF
-       ENDDO
-    ENDDO
-
-#endif
- END SUBROUTINE c_copy_particle_to_child_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Child routine:
-!> Copy particles which left the model area into the local buffer
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE c_copy_particle_to_coarse_grid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !< loop index (x grid)
-    INTEGER(iwp) ::  ic    !< loop index (coarse x grid)
-    INTEGER(iwp) ::  ipl   !< left boundary in coarse(parent) index space
-    INTEGER(iwp) ::  ipr   !< left boundary in coarse(parent) index space
-    INTEGER(iwp) ::  ierr  !< error code
-    INTEGER(iwp) ::  j     !< loop index (y grid)
-    INTEGER(iwp) ::  jc    !< loop index (coarse y grid)
-    INTEGER(iwp) ::  jps   !< south boundary in coarse(parent) index space
-    INTEGER(iwp) ::  jpn   !< north boundary in coarse(parent) index space
-    INTEGER(iwp) ::  k     !< loop index (z grid)
-    INTEGER(iwp) ::  n     !< loop index (number of particles)
-
-    LOGICAL ::  boundary_particle  !<
-
-    REAL(wp) ::  x        !< x coordinate
-    REAL(wp) ::  xo       !< x origin
-    REAL(wp) ::  x_left   !< absolute left boundary
-    REAL(wp) ::  x_right  !< absolute right boundary
-    REAL(wp) ::  y        !< left boundary in coarse(parent) index space
-    REAL(wp) ::  yo       !< y origin
-    REAL(wp) ::  y_north  !< absolute north boundary
-    REAL(wp) ::  y_south  !< absoulte south boundary
-    REAL(wp) ::  z        !< z coordinate
-
-#if defined( __parallel )
-!
-!-- Child domain boundaries in the parent index space
-
-    ipl = parent_bound(1)
-    ipr = parent_bound(2)
-    jps = parent_bound(3)
-    jpn = parent_bound(4)
-
-!
-!-- Absolute coordinates
-    x_left  = coord_x(0)
-    x_right = coord_x(nx) + dx
-    y_south = coord_y(0)
-    y_north = coord_y(ny) + dy
-!
-!-- Clear Particle Buffer
-    DO  ic = ipl, ipr
-       DO  jc = jps, jpn
-          coarse_particles(jc,ic)%nr_particle = 0
-       ENDDO
-    ENDDO
-
-!
-!-- Determine particles which leave the inner area in east or west dirextion.
-!-- Compute only first (nxl) and last (nxr) loop iterration.
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb + 1, nzt
-             number_of_particles = prt_count(k,j,i)
-             IF ( number_of_particles <= 0 )  CYCLE
-             particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-             DO  n = 1, number_of_particles
-                IF ( particles(n)%particle_mask )  THEN
-                   x  = particles(n)%x+ lower_left_coord_x
-                   y  = particles(n)%y+ lower_left_coord_y
-                   xo = particles(n)%origin_x + lower_left_coord_x
-                   yo = particles(n)%origin_y + lower_left_coord_y
-                   z  = particles(n)%z
-
-                   boundary_particle = .FALSE.
-                   boundary_particle = boundary_particle .OR. ( x < x_left  .OR. x > x_right )
-                   boundary_particle = boundary_particle .OR. ( y < y_south .OR. y > y_north )
-                   boundary_particle = boundary_particle .OR. ( z > zw(nzt) )
-
-                   IF ( boundary_particle )  THEN
-                      ic = x / pg%dx                     !TODO anpassen auf Mehrfachnesting
-                      jc = y / pg%dy
-
-                      IF ( ic >= ipl  .AND.  ic <= ipr  .AND.  jc >= jps  .AND.  jc <= jpn )  THEN
-                         coarse_particles(jc,ic)%nr_particle = coarse_particles(jc,ic)%nr_particle &
-                                                               + 1
-                         CALL check_and_alloc_coarse_particle( ic, jc,                             &
-                                                               coarse_particles(jc,ic)%nr_particle,&
-                                                               with_copy = .TRUE. )
-
-                         coarse_particles(jc,ic)%parent_particles(                                 &
-                         coarse_particles(jc,ic)%nr_particle) = particles(n)
-                         coarse_particles(jc,ic)%parent_particles(                                 &
-                         coarse_particles(jc,ic)%nr_particle)%x = x   !Adapt to global coordinates
-                         coarse_particles(jc,ic)%parent_particles(                                 &
-                         coarse_particles(jc,ic)%nr_particle)%y = y
-                         coarse_particles(jc,ic)%parent_particles(                                 &
-                         coarse_particles(jc,ic)%nr_particle)%origin_x = xo
-                         coarse_particles(jc,ic)%parent_particles(                                 &
-                         coarse_particles(jc,ic)%nr_particle)%origin_y = yo
-!
-!--                      Mark particle as deleted after copying it to the transfer buffer
-                         grid_particles(k,j,i)%particles(n)%particle_mask = .FALSE.
-                      ELSE
-                         WRITE( 9, '(a,10i6)' ) 'This should not happen ', i, j, k, ic, jc, ipl,   &
-                                                                           ipr, jps, jpn
-                         CALL MPI_Abort( MPI_COMM_WORLD, 9999, ierr )
-                      ENDIF
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Pack particles (eliminate those marked for deletion), determine new number of particles
-!    CALL lpm_sort_in_subboxes
-
-#endif
- END SUBROUTINE c_copy_particle_to_coarse_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parent routine:
-!> Copy/sort particles from the MPI window into the respective grid boxes
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE p_copy_particle_to_org_grid( m )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !< loop index (x grid)
-    INTEGER(iwp) ::  j       !< loop index (y grid)
-    INTEGER(iwp) ::  k       !< loop index (z grid)
-    INTEGER(iwp) ::  n       !< loop index (nr part)
-    INTEGER(iwp) ::  nr      !< short variable name for nr_part
-    INTEGER(iwp) ::  pindex  !< short variable name part_adr
-
-    INTEGER(iwp),INTENT(IN) ::  m  !<
-
-    INTEGER(iwp),DIMENSION(1) ::  buf_shape  !<
-
-    REAL(wp) ::  x   !< x coordinate
-    REAL(wp) ::  xo  !< x origin
-    REAL(wp) ::  y   !< y coordinate
-    REAL(wp) ::  yo  !< y origin
-    REAL(wp) ::  z   !< z coordinate
-
-
-#if defined( __parallel )
-    buf_shape(1) = max_nr_particle_in_rma_win
-    CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          nr = nr_part(j,i)
-          IF ( nr > 0 )  THEN
-             pindex = part_adr(j,i)
-             DO  n = 1, nr
-                x = particle_in_win(pindex)%x-lower_left_coord_x
-                y = particle_in_win(pindex)%y-lower_left_coord_y
-                z = particle_in_win(pindex)%z
-                xo = particle_in_win(pindex)%origin_x-lower_left_coord_x
-                yo = particle_in_win(pindex)%origin_y-lower_left_coord_y
-                k = nzt + 1
-                DO WHILE ( zw(k-1) > z .AND. k > nzb + 1 )  ! kk search loop has to be optimzed !!!
-                   k = k - 1
-                END DO
-
-                prt_count(k,j,i) = prt_count(k,j,i) + 1
-                IF ( prt_count(k,j,i) > SIZE( grid_particles(k,j,i)%particles ) )  THEN
-                   CALL pmc_realloc_particles_array( i, j, k )
-                ENDIF
-                grid_particles(k,j,i)%particles(prt_count(k,j,i)) = particle_in_win(pindex)
-
-!
-!--             Update particle positions and origins relative to parent domain
-                grid_particles(k,j,i)%particles(prt_count(k,j,i))%x = x
-                grid_particles(k,j,i)%particles(prt_count(k,j,i))%y = y
-                grid_particles(k,j,i)%particles(prt_count(k,j,i))%origin_x = xo
-                grid_particles(k,j,i)%particles(prt_count(k,j,i))%origin_y = yo
-                pindex = pindex + 1
-             ENDDO
-          ENDIF
-       ENDDO
-    ENDDO
-
-#endif
- END SUBROUTINE p_copy_particle_to_org_grid
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> If the allocated memory for the particle array do not suffice to add arriving particles from
-!> neighbour grid cells, this subrouting reallocates the particle array to assure enough memory is
-!> available.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pmc_realloc_particles_array( i, j, k, size_in )
-
-
-    INTEGER(iwp) ::  new_size  !<
-    INTEGER(iwp) ::  old_size  !<
-
-    INTEGER(iwp), INTENT(IN) ::  i  !<
-    INTEGER(iwp), INTENT(IN) ::  j  !<
-    INTEGER(iwp), INTENT(IN) ::  k  !<
-
-    INTEGER(iwp), INTENT(IN), OPTIONAL ::  size_in  !<
-
-
-    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, 1, old_size + 1 )
-
-    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:new_size)
-
-    RETURN
-
- END SUBROUTINE pmc_realloc_particles_array
-
-#endif
-END MODULE pmc_particle_interface
Index: palm/trunk/SOURCE/poisfft.f90
===================================================================
--- palm/trunk/SOURCE/poisfft.f90	(revision 1)
+++ palm/trunk/SOURCE/poisfft.f90	(revision 1)
@@ -0,0 +1,1540 @@
+ MODULE poisfft_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: poisfft.f90,v $
+! Revision 1.24  2006/08/04 15:00:24  raasch
+! Default setting of the thread number tn in case of not using OpenMP
+!
+! Revision 1.23  2006/02/23 12:48:38  raasch
+! Additional compiler directive in routine tridia_1dd for preventing loop
+! exchange on NEC-SX6
+!
+! Revision 1.22  2005/05/18 15:53:00  raasch
+! Missing argument in ffty
+!
+! Revision 1.21  2005/03/26 20:51:59  raasch
+! Use of module indices removed from routine split_1dd since it caused errors
+! in case of nx /= ny
+!
+! Revision 1.20  2004/04/30 12:38:09  raasch
+! Parts of former poisfft_hybrid moved to this subroutine,
+! former subroutine changed to a module, renaming of FFT-subroutines and
+! -module, FFTs completely substituted by calls of fft_x and fft_y,
+! NAG fft used in the non-parallel case completely removed, l in maketri
+! is now a 1d-array, variables passed by modules instead of using parameter
+! lists, enlarged transposition arrays introduced
+!
+! Revision 1.19  2003/04/16 13:11:16  raasch
+! Internal fft method calls substituted by calls of fft_x_1dd and fft_y_1dd
+!
+! Revision 1.18  2003/03/16 09:44:45  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.17  2003/03/12 16:36:34  raasch
+! System specific version for NEC included (equivalent to CRAY scilib
+! calls, but different subroutine names; the CRAY names are replaced with
+! NEC names by cpp), size of array work1 is expanded because NEC routines
+! need more memory
+!
+! Revision 1.15  2002/06/11 13:14:31  raasch
+! System specific version for IBM included (parallel case only)
+!
+! Revision 1.13  2001/01/25 22:19:18  letzel
+! All comments translated into English.
+!
+! Revision 1.12  2001/01/23 01:53:04  raasch
+! Total revision of parallel and non-paralle fft-routines. Additional
+! implementation of the singleton algorithm.
+!
+! Revision 1.9  1998/07/27 08:12:56  schroeter
+! Berechnung von l in maketri geschieht nun ausserhalb
+! der k-Schleife, da unabhaengig von k, dadurch
+! Rechenzeitersparnis
+!
+! Revision 1.8  1998/07/24 07:52:09  schroeter
+! Anpassung des Druckloesealgorithmusses an Vorgehensweise
+! von Schmidt, Schumann und Volkert
+! (DFVLR-Mitteilung 84-15, S. 20-26)
+!
+! Revision 1.1  1997/07/24 11:24:14  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! See below.
+!------------------------------------------------------------------------------!
+
+!--------------------------------------------------------------------------!
+!                             poisfft                                      !
+!                                                                          !
+!                Original version: Stephan Siano (pois3d)                  !
+!                                                                          !
+!  Institute of Meteorology and Climatology, University of Hannover        !
+!                             Germany                                      !
+!                                                                          !
+!  Version as of July 23,1996                                              !
+!                                                                          !
+!                                                                          !
+!        Version for parallel computers: Siegfried Raasch                  !
+!                                                                          !
+!  Version as of July 03,1997                                              !
+!                                                                          !
+!  Solves the Poisson equation with a 2D spectral method                   !
+!        d^2 p / dx^2 + d^2 p / dy^2 + d^2 p / dz^2 = s                    !
+!                                                                          !
+!  Input:                                                                  !
+!  real    ar                 contains in the (nnx,nny,nnz) elements,      !
+!                             starting from the element (1,nys,nxl), the   !
+!                             values for s                                 !
+!  real    work               Temporary array                              !
+!                                                                          !
+!  Output:                                                                 !
+!  real    ar                 contains the solution for p                  !
+!--------------------------------------------------------------------------!
+
+    USE fft_xy
+    USE indices
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    PRIVATE
+    PUBLIC  poisfft, poisfft_init
+
+    INTERFACE poisfft
+       MODULE PROCEDURE poisfft
+    END INTERFACE poisfft
+
+    INTERFACE poisfft_init
+       MODULE PROCEDURE poisfft_init
+    END INTERFACE poisfft_init
+
+ CONTAINS
+
+    SUBROUTINE poisfft_init
+
+       CALL fft_init
+
+    END SUBROUTINE poisfft_init
+
+
+    SUBROUTINE poisfft( ar, work )
+
+       USE cpulog
+       USE interfaces
+       USE pegrid
+
+       IMPLICIT NONE
+
+       REAL, DIMENSION(1:nza,nys:nyna,nxl:nxra) ::  ar, work
+
+
+       CALL cpu_log( log_point_s(3), 'poisfft', 'start' )
+
+!
+!--    Two-dimensional Fourier Transformation in x- and y-direction.
+#if defined( __parallel )
+       IF ( pdims(2) == 1 )  THEN
+
+!
+!--       1d-domain-decomposition along x:
+!--       FFT along y and transposition y --> x
+          CALL ffty_tr_yx( ar, work, ar )
+
+!
+!--       FFT along x, solving the tridiagonal system and backward FFT
+          CALL fftx_tri_fftx( ar )
+
+!
+!--       Transposition x --> y and backward FFT along y
+          CALL tr_xy_ffty( ar, work, ar )
+
+       ELSEIF ( pdims(1) == 1 )  THEN
+
+!
+!--       1d-domain-decomposition along y:
+!--       FFT along x and transposition x --> y
+          CALL fftx_tr_xy( ar, work, ar )
+
+!
+!--       FFT along y, solving the tridiagonal system and backward FFT
+          CALL ffty_tri_ffty( ar )
+
+!
+!--       Transposition y --> x and backward FFT along x
+          CALL tr_yx_fftx( ar, work, ar )
+
+       ELSE
+
+!
+!--       2d-domain-decomposition
+!--       Transposition z --> x
+          CALL cpu_log( log_point_s(5), 'transpo forward', 'start' )
+          CALL transpose_zx( ar, work, ar, work, ar )
+          CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
+
+          CALL cpu_log( log_point_s(4), 'fft_x', 'start' )
+          CALL fftxp( ar, 'forward' )
+          CALL cpu_log( log_point_s(4), 'fft_x', 'pause' )
+
+!
+!--       Transposition x --> y
+          CALL cpu_log( log_point_s(5), 'transpo forward', 'continue' )
+          CALL transpose_xy( ar, work, ar, work, ar )
+          CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
+
+          CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
+          CALL fftyp( ar, 'forward' )
+          CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
+
+!
+!--       Transposition y --> z
+          CALL cpu_log( log_point_s(5), 'transpo forward', 'continue' )
+          CALL transpose_yz( ar, work, ar, work, ar )
+          CALL cpu_log( log_point_s(5), 'transpo forward', 'stop' )
+
+!
+!--       Solve the Poisson equation in z-direction in cartesian space.
+          CALL cpu_log( log_point_s(6), 'tridia', 'start' )
+          CALL tridia( ar )
+          CALL cpu_log( log_point_s(6), 'tridia', 'stop' )
+
+!
+!--       Inverse Fourier Transformation
+!--       Transposition z --> y
+          CALL cpu_log( log_point_s(8), 'transpo invers', 'start' )
+          CALL transpose_zy( ar, work, ar, work, ar )
+          CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
+
+          CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
+          CALL fftyp( ar, 'backward' )
+          CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
+
+!
+!--       Transposition y --> x
+          CALL cpu_log( log_point_s(8), 'transpo invers', 'continue' )
+          CALL transpose_yx( ar, work, ar, work, ar )
+          CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
+
+          CALL cpu_log( log_point_s(4), 'fft_x', 'continue' )
+          CALL fftxp( ar, 'backward' )
+          CALL cpu_log( log_point_s(4), 'fft_x', 'stop' )
+
+!
+!--       Transposition x --> z
+          CALL cpu_log( log_point_s(8), 'transpo invers', 'continue' )
+          CALL transpose_xz( ar, work, ar, work, ar )
+          CALL cpu_log( log_point_s(8), 'transpo invers', 'stop' )
+
+       ENDIF
+
+#else
+
+!
+!--    Two-dimensional Fourier Transformation along x- and y-direction.
+       CALL cpu_log( log_point_s(4), 'fft_x', 'start' )
+       CALL fftx( ar, 'forward' )
+       CALL cpu_log( log_point_s(4), 'fft_x', 'pause' )
+       CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
+       CALL ffty( ar, 'forward' )
+       CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
+
+!
+!--    Solve the Poisson equation in z-direction in cartesian space.
+       CALL cpu_log( log_point_s(6), 'tridia', 'start' )
+       CALL tridia( ar )
+       CALL cpu_log( log_point_s(6), 'tridia', 'stop' )
+
+!
+!--    Inverse Fourier Transformation.
+       CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
+       CALL ffty( ar, 'backward' )
+       CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
+       CALL cpu_log( log_point_s(4), 'fft_x', 'continue' )
+       CALL fftx( ar, 'backward' )
+       CALL cpu_log( log_point_s(4), 'fft_x', 'stop' )
+
+#endif
+
+       CALL cpu_log( log_point_s(3), 'poisfft', 'stop' )
+
+    END SUBROUTINE poisfft
+
+
+
+    SUBROUTINE tridia( ar )
+
+!------------------------------------------------------------------------------!
+! solves the linear system of equations:
+!
+! -(4 pi^2(i^2/(dx^2*nnx^2)+j^2/(dy^2*nny^2))+
+!   1/(dzu(k)*dzw(k))+1/(dzu(k-1)*dzw(k)))*p(i,j,k)+
+! 1/(dzu(k)*dzw(k))*p(i,j,k+1)+1/(dzu(k-1)*dzw(k))*p(i,j,k-1)=d(i,j,k)
+!
+! by using the Thomas algorithm
+!------------------------------------------------------------------------------!
+
+       USE arrays_3d
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k, nnyh
+
+       REAL, DIMENSION(nxl_z:nxr_z,0:nz-1)   ::  ar1
+       REAL, DIMENSION(5,nxl_z:nxr_z,0:nz-1) ::  tri
+
+#if defined( __parallel )
+       REAL    ::  ar(nxl_z:nxr_za,nys_z:nyn_za,1:nza)
+#else
+       REAL    ::  ar(1:nz,nys_z:nyn_z,nxl_z:nxr_z)
+#endif
+
+
+       nnyh = (ny+1) / 2
+
+!
+!--    Define constant elements of the tridiagonal matrix.
+       DO  k = 0, nz-1
+          DO  i = nxl_z, nxr_z
+             tri(2,i,k) = ddzu(k+1) * ddzw(k+1)
+             tri(3,i,k) = ddzu(k+2) * ddzw(k+1)
+          ENDDO
+       ENDDO
+
+#if defined( __parallel )
+!
+!--    Repeat for all y-levels.
+       DO  j = nys_z, nyn_z
+          IF ( j <= nnyh )  THEN
+             CALL maketri( tri, j )
+          ELSE
+             CALL maketri( tri, ny+1-j )
+          ENDIF
+          CALL split( tri )
+          CALL substi( ar, ar1, tri, j )
+       ENDDO
+#else
+!
+!--    First y-level.
+       CALL maketri( tri, nys_z )
+       CALL split( tri )
+       CALL substi( ar, ar1, tri, 0 )
+
+!
+!--    Further y-levels.
+       DO  j = 1, nnyh - 1
+          CALL maketri( tri, j )
+          CALL split( tri )
+          CALL substi( ar, ar1, tri, j )
+          CALL substi( ar, ar1, tri, ny+1-j )
+       ENDDO
+       CALL maketri( tri, nnyh )
+       CALL split( tri )
+       CALL substi( ar, ar1, tri, nnyh+nys )
+#endif
+
+    CONTAINS
+
+       SUBROUTINE maketri( tri, j )
+
+!------------------------------------------------------------------------------!
+! Computes the i- and j-dependent component of the matrix
+!------------------------------------------------------------------------------!
+
+          USE arrays_3d
+          USE constants
+          USE control_parameters
+          USE grid_variables
+
+          IMPLICIT NONE
+
+          INTEGER ::  i, j, k, nnxh
+          REAL    ::  a, c
+          REAL    ::  ll(nxl_z:nxr_z)
+          REAL    ::  tri(5,nxl_z:nxr_z,0:nz-1)
+
+
+          nnxh = ( nx + 1 ) / 2
+
+!
+!--       Provide the tridiagonal matrix for solution of the Poisson equation in
+!--       Fourier space. The coefficients are computed following the method of
+!--       Schmidt et al. (DFVLR-Mitteilung 84-15), which departs from Stephan
+!--       Siano's original version by discretizing the Poisson equation,
+!--       before it is Fourier-transformed
+#if defined( __parallel )
+          DO  i = nxl_z, nxr_z
+             IF ( i >= 0 .AND. i < nnxh )  THEN
+                ll(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / &
+                                          FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+                        2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+                                          FLOAT( ny+1 ) ) ) / ( dy * dy )
+             ELSEIF ( i == nnxh )  THEN
+                ll(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
+                                          FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+                        2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+                                          FLOAT( ny+1 ) ) ) / ( dy * dy )
+             ELSE
+                ll(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
+                                          FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+                        2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+                                          FLOAT( ny+1 ) ) ) / ( dy * dy )
+             ENDIF
+             DO  k = 0,nz-1
+                a = -1.0 * ddzu(k+2) * ddzw(k+1)
+                c = -1.0 * ddzu(k+1) * ddzw(k+1)
+                tri(1,i,k) = a + c - ll(i)
+             ENDDO
+          ENDDO
+#else
+          DO  i = 0, nnxh
+             ll(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / FLOAT( nx+1 ) ) ) / &
+                           ( dx * dx ) + &
+                     2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / FLOAT( ny+1 ) ) ) / &
+                           ( dy * dy )
+             DO  k = 0, nz-1
+                a = -1.0 * ddzu(k+2) * ddzw(k+1)
+                c = -1.0 * ddzu(k+1) * ddzw(k+1)
+                tri(1,i,k) = a + c - ll(i)
+                IF ( i >= 1 .and. i < nnxh )  THEN
+                   tri(1,nx+1-i,k) = tri(1,i,k)
+                ENDIF
+             ENDDO
+          ENDDO
+#endif
+          IF ( ibc_p_b == 1  .OR.  ibc_p_b == 2 )  THEN
+             DO  i = nxl_z, nxr_z
+                tri(1,i,0) = tri(1,i,0) + tri(2,i,0)
+             ENDDO
+          ENDIF
+          IF ( ibc_p_t == 1 )  THEN
+             DO  i = nxl_z, nxr_z
+                tri(1,i,nz-1) = tri(1,i,nz-1) + tri(3,i,nz-1)
+             ENDDO
+          ENDIF
+
+       END SUBROUTINE maketri
+
+
+       SUBROUTINE substi( ar, ar1, tri, j )
+
+!------------------------------------------------------------------------------!
+! Substitution (Forward and Backward) (Thomas algorithm)
+!------------------------------------------------------------------------------!
+
+          IMPLICIT NONE
+
+          INTEGER ::  i, j, k
+          REAL    ::  ar1(nxl_z:nxr_z,0:nz-1)
+          REAL    ::  tri(5,nxl_z:nxr_z,0:nz-1)
+#if defined( __parallel )
+          REAL    ::  ar(nxl_z:nxr_za,nys_z:nyn_za,1:nza)
+#else
+          REAL    ::  ar(1:nz,nys_z:nyn_z,nxl_z:nxr_z)
+#endif
+
+!
+!--       Forward substitution.
+          DO  i = nxl_z, nxr_z
+#if defined( __parallel )
+             ar1(i,0) = ar(i,j,1)
+#else
+             ar1(i,0) = ar(1,j,i)
+#endif
+          ENDDO
+          DO  k = 1, nz - 1
+             DO  i = nxl_z, nxr_z
+#if defined( __parallel )
+                ar1(i,k) = ar(i,j,k+1) - tri(5,i,k) * ar1(i,k-1)
+#else
+                ar1(i,k) = ar(k+1,j,i) - tri(5,i,k) * ar1(i,k-1)
+#endif
+             ENDDO
+          ENDDO
+
+!
+!--       Backward substitution.
+          DO  i = nxl_z, nxr_z
+#if defined( __parallel )
+             ar(i,j,nz) = ar1(i,nz-1) / tri(4,i,nz-1)
+#else
+             ar(nz,j,i) = ar1(i,nz-1) / tri(4,i,nz-1)
+#endif
+          ENDDO
+          DO  k = nz-2, 0, -1
+             DO  i = nxl_z, nxr_z
+#if defined( __parallel )
+                ar(i,j,k+1) = ( ar1(i,k) - tri(3,i,k) * ar(i,j,k+2) ) &
+                              / tri(4,i,k)
+#else
+                ar(k+1,j,i) = ( ar1(i,k) - tri(3,i,k) * ar(k+2,j,i) ) &
+                              / tri(4,i,k)
+#endif
+             ENDDO
+          ENDDO
+
+       END SUBROUTINE substi
+
+
+       SUBROUTINE split( tri )
+
+!------------------------------------------------------------------------------!
+! Splitting of the tridiagonal matrix (Thomas algorithm)
+!------------------------------------------------------------------------------!
+
+          IMPLICIT NONE
+
+          INTEGER ::  i, k
+          REAL    ::  tri(5,nxl_z:nxr_z,0:nz-1)
+
+!
+!--       Splitting.
+          DO  i = nxl_z, nxr_z
+             tri(4,i,0) = tri(1,i,0)
+          ENDDO
+          DO  k = 1, nz-1
+             DO  i = nxl_z, nxr_z
+                tri(5,i,k) = tri(2,i,k) / tri(4,i,k-1)
+                tri(4,i,k) = tri(1,i,k) - tri(3,i,k-1) * tri(5,i,k)
+             ENDDO
+          ENDDO
+
+       END SUBROUTINE split
+
+    END SUBROUTINE tridia
+
+
+#if defined( __parallel )
+    SUBROUTINE fftxp( ar, direction )
+
+!------------------------------------------------------------------------------!
+! Fourier-transformation along x-direction                 Parallelized version
+!------------------------------------------------------------------------------!
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  direction
+       INTEGER           ::  j, k
+       REAL              ::  ar(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa)
+
+!
+!--    Performing the fft with one of the methods implemented
+       DO  k = nzb_x, nzt_x
+          DO  j = nys_x, nyn_x
+             CALL fft_x( ar(0:nx,j,k), direction )
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE fftxp
+
+#else
+    SUBROUTINE fftx( ar, direction )
+
+!------------------------------------------------------------------------------!
+! Fourier-transformation along x-direction                 Non parallel version
+!------------------------------------------------------------------------------!
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  direction
+       INTEGER           ::  i, j, k
+       REAL              ::  ar(1:nz,0:ny,0:nx)
+
+!
+!--    Performing the fft with one of the methods implemented
+       DO  k = 1, nz
+          DO  j = 0, ny
+             CALL fft_x( ar(k,j,0:nx), direction )
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE fftx
+#endif
+
+
+#if defined( __parallel )
+    SUBROUTINE fftyp( ar, direction )
+
+!------------------------------------------------------------------------------!
+! Fourier-transformation along y-direction                 Parallelized version
+!------------------------------------------------------------------------------!
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  direction
+       INTEGER           ::  i, k
+       REAL              ::  ar(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya)
+
+!
+!--    Performing the fft with one of the methods implemented
+       DO  k = nzb_y, nzt_y
+          DO  i = nxl_y, nxr_y
+             CALL fft_y( ar(0:ny,i,k), direction )
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE fftyp
+
+#else
+    SUBROUTINE ffty( ar, direction )
+
+!------------------------------------------------------------------------------!
+! Fourier-transformation along y-direction                 Non parallel version
+!------------------------------------------------------------------------------!
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  direction
+       INTEGER           ::  i, k
+       REAL              ::  ar(1:nz,0:ny,0:nx)
+
+!
+!--    Performing the fft with one of the methods implemented
+       DO  k = 1, nz
+          DO  i = 0, nx
+             CALL fft_y( ar(k,0:ny,i), direction )
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE ffty
+#endif
+
+#if defined( __parallel )
+    SUBROUTINE ffty_tr_yx( f_in, work, f_out )
+
+!------------------------------------------------------------------------------!
+!  Fourier-transformation along y with subsequent transposition y --> x for
+!  a 1d-decomposition along x
+!
+!  ATTENTION: The performance of this routine is much faster on the NEC-SX6,
+!             if the first index of work_ffty_vec is odd. Otherwise
+!             memory bank conflicts may occur (especially if the index is a
+!             multiple of 128). That's why work_ffty_vec is dimensioned as
+!             0:ny+1.
+!             Of course, this will not work if users are using an odd number
+!             of gridpoints along y.
+!------------------------------------------------------------------------------!
+
+       USE control_parameters
+       USE cpulog
+       USE indices
+       USE interfaces
+       USE pegrid
+       USE transpose_indices
+
+       IMPLICIT NONE
+
+       INTEGER            ::  i, iend, iouter, ir, j, k
+       INTEGER, PARAMETER ::  stridex = 4
+
+       REAL, DIMENSION(0:ny,stridex)                    ::  work_ffty
+#if defined( __nec )
+       REAL, DIMENSION(0:ny+1,1:nz,nxl:nxr)             ::  work_ffty_vec
+#endif
+       REAL, DIMENSION(1:nza,0:nya,nxl:nxra)            ::  f_in
+       REAL, DIMENSION(nnx,1:nza,nys_x:nyn_xa,pdims(1)) ::  f_out
+       REAL, DIMENSION(nxl:nxra,1:nza,0:nya)            ::  work
+
+!
+!--    Carry out the FFT along y, where all data are present due to the
+!--    1d-decomposition along x. Resort the data in a way that x becomes
+!--    the first index.
+       CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
+
+       IF ( host(1:3) == 'nec' )  THEN
+#if defined( __nec )
+!
+!--       Code optimized for vector processors
+!$OMP     PARALLEL PRIVATE ( i, j, k, work_ffty_vec )
+!$OMP     DO
+          DO  i = nxl, nxr
+
+             DO  j = 0, ny
+                DO  k = 1, nz
+                   work_ffty_vec(j,k,i) = f_in(k,j,i)
+                ENDDO
+             ENDDO
+
+             CALL fft_y_m( work_ffty_vec(:,:,i), ny+1, 'forward' )
+
+          ENDDO
+
+!$OMP     DO
+          DO  k = 1, nz
+             DO  j = 0, ny
+                DO  i = nxl, nxr
+                   work(i,k,j) = work_ffty_vec(j,k,i)
+                ENDDO
+             ENDDO
+          ENDDO
+!$OMP     END PARALLEL
+#endif
+
+       ELSE
+
+!
+!--       Cache optimized code.
+!--       The i-(x-)direction is split into a strided outer loop and an inner
+!--       loop for better cache performance
+!$OMP     PARALLEL PRIVATE (i,iend,iouter,ir,j,k,work_ffty)
+!$OMP     DO
+          DO  iouter = nxl, nxr, stridex
+
+             iend = MIN( iouter+stridex-1, nxr )  ! Upper bound for inner i loop
+
+             DO  k = 1, nz
+
+                DO  i = iouter, iend
+
+                   ir = i-iouter+1  ! counter within a stride
+                   DO  j = 0, ny
+                      work_ffty(j,ir) = f_in(k,j,i)
+                   ENDDO
+!
+!--                FFT along y
+                   CALL fft_y( work_ffty(:,ir), 'forward' )
+
+                ENDDO
+
+!
+!--             Resort
+                DO  j = 0, ny
+                   DO  i = iouter, iend
+                      work(i,k,j) = work_ffty(j,i-iouter+1)
+                   ENDDO
+                ENDDO
+
+             ENDDO
+
+          ENDDO
+!$OMP     END PARALLEL
+
+       ENDIF
+       CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
+
+!
+!--    Transpose array
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+       CALL MPI_ALLTOALL( work(nxl,1,0),      sendrecvcount_xy, MPI_REAL, &
+                          f_out(1,1,nys_x,1), sendrecvcount_xy, MPI_REAL, &
+                          comm1dx, ierr )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+    END SUBROUTINE ffty_tr_yx
+
+
+    SUBROUTINE tr_xy_ffty( f_in, work, f_out )
+
+!------------------------------------------------------------------------------!
+!  Transposition x --> y with a subsequent backward Fourier transformation for
+!  a 1d-decomposition along x
+!------------------------------------------------------------------------------!
+
+       USE control_parameters
+       USE cpulog
+       USE indices
+       USE interfaces
+       USE pegrid
+       USE transpose_indices
+
+       IMPLICIT NONE
+
+       INTEGER            ::  i, iend, iouter, ir, j, k
+       INTEGER, PARAMETER ::  stridex = 4
+
+       REAL, DIMENSION(0:ny,stridex)                    ::  work_ffty
+#if defined( __nec )
+       REAL, DIMENSION(0:ny+1,1:nz,nxl:nxr)             ::  work_ffty_vec
+#endif
+       REAL, DIMENSION(nnx,1:nza,nys_x:nyn_xa,pdims(1)) ::  f_in
+       REAL, DIMENSION(1:nza,0:nya,nxl:nxra)            ::  f_out
+       REAL, DIMENSION(nxl:nxra,1:nza,0:nya)            ::  work
+
+!
+!--    Transpose array
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+       CALL MPI_ALLTOALL( f_in(1,1,nys_x,1), sendrecvcount_xy, MPI_REAL, &
+                          work(nxl,1,0),     sendrecvcount_xy, MPI_REAL, &
+                          comm1dx, ierr )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!--    Resort the data in a way that y becomes the first index and carry out the
+!--    backward fft along y.
+       CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
+
+       IF ( host(1:3) == 'nec' )  THEN
+#if defined( __nec )
+!
+!--       Code optimized for vector processors
+!$OMP     PARALLEL PRIVATE ( i, j, k, work_ffty_vec )
+!$OMP     DO
+          DO  k = 1, nz
+             DO  j = 0, ny
+                DO  i = nxl, nxr
+                   work_ffty_vec(j,k,i) = work(i,k,j)
+                ENDDO
+             ENDDO
+          ENDDO
+
+!$OMP     DO
+          DO  i = nxl, nxr
+
+             CALL fft_y_m( work_ffty_vec(:,:,i), ny+1, 'backward' )
+
+             DO  j = 0, ny
+                DO  k = 1, nz
+                   f_out(k,j,i) = work_ffty_vec(j,k,i)
+                ENDDO
+             ENDDO
+
+          ENDDO
+!$OMP     END PARALLEL
+#endif
+
+       ELSE
+
+!
+!--       Cache optimized code.
+!--       The i-(x-)direction is split into a strided outer loop and an inner
+!--       loop for better cache performance
+!$OMP     PARALLEL PRIVATE ( i, iend, iouter, ir, j, k, work_ffty )
+!$OMP     DO
+          DO  iouter = nxl, nxr, stridex
+
+             iend = MIN( iouter+stridex-1, nxr )  ! Upper bound for inner i loop
+
+             DO  k = 1, nz
+!
+!--             Resort
+                DO  j = 0, ny
+                   DO  i = iouter, iend
+                      work_ffty(j,i-iouter+1) = work(i,k,j)
+                   ENDDO
+                ENDDO
+
+                DO  i = iouter, iend
+
+!
+!--                FFT along y
+                   ir = i-iouter+1  ! counter within a stride
+                   CALL fft_y( work_ffty(:,ir), 'backward' )
+
+                   DO  j = 0, ny
+                      f_out(k,j,i) = work_ffty(j,ir)
+                   ENDDO
+                ENDDO
+
+             ENDDO
+
+          ENDDO
+!$OMP     END PARALLEL
+
+       ENDIF
+
+       CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
+
+    END SUBROUTINE tr_xy_ffty
+
+
+    SUBROUTINE fftx_tri_fftx( ar )
+
+!------------------------------------------------------------------------------!
+!  FFT along x, solution of the tridiagonal system and backward FFT for
+!  a 1d-decomposition along x
+!
+!  WARNING: this subroutine may still not work for hybrid parallelization
+!           with OpenMP (for possible necessary changes see the original
+!           routine poisfft_hybrid, developed by Klaus Ketelsen, May 2002)
+!------------------------------------------------------------------------------!
+
+       USE control_parameters
+       USE cpulog
+       USE grid_variables
+       USE indices
+       USE interfaces
+       USE pegrid
+       USE transpose_indices
+
+       IMPLICIT NONE
+
+       character(len=3) ::  myth_char
+
+       INTEGER ::  i, j, k, m, n, omp_get_thread_num, tn
+
+       REAL, DIMENSION(0:nx)                            ::  work_fftx
+       REAL, DIMENSION(0:nx,1:nz)                       ::  work_trix
+       REAL, DIMENSION(nnx,1:nza,nys_x:nyn_xa,pdims(1)) ::  ar
+       REAL, DIMENSION(:,:,:,:), ALLOCATABLE            ::  tri
+
+
+       CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'start' )
+
+       ALLOCATE( tri(5,0:nx,0:nz-1,0:threads_per_task-1) )
+
+       tn = 0              ! Default thread number in case of one thread
+!$OMP  PARALLEL DO PRIVATE ( i, j, k, m, n, tn, work_fftx, work_trix )
+       DO  j = nys_x, nyn_x
+
+!$        tn = omp_get_thread_num()
+
+          IF ( host(1:3) == 'nec' )  THEN
+!
+!--          Code optimized for vector processors
+             DO  k = 1, nz
+
+                m = 0
+                DO  n = 1, pdims(1)
+                   DO  i = 1, nnx_pe( n-1 ) ! WARN: pcoord(i) should be used!!
+                      work_trix(m,k) = ar(i,k,j,n)
+                      m = m + 1
+                   ENDDO
+                ENDDO
+
+             ENDDO
+
+             CALL fft_x_m( work_trix, 'forward' )
+
+          ELSE
+!
+!--          Cache optimized code
+             DO  k = 1, nz
+
+                m = 0
+                DO  n = 1, pdims(1)
+                   DO  i = 1, nnx_pe( n-1 ) ! WARN: pcoord(i) should be used!!
+                      work_fftx(m) = ar(i,k,j,n)
+                      m = m + 1
+                   ENDDO
+                ENDDO
+
+                CALL fft_x( work_fftx, 'forward' )
+
+                DO  i = 0, nx
+                   work_trix(i,k) = work_fftx(i)
+                ENDDO
+
+             ENDDO
+
+          ENDIF
+
+!
+!--       Solve the linear equation system
+          CALL tridia_1dd( ddx2, ddy2, nx, ny, j, work_trix, tri(:,:,:,tn) )
+
+          IF ( host(1:3) == 'nec' )  THEN
+!
+!--          Code optimized for vector processors
+             CALL fft_x_m( work_trix, 'backward' )
+
+             DO  k = 1, nz
+
+                m = 0
+                DO  n = 1, pdims(1)
+                   DO  i = 1, nnx_pe( n-1 ) ! WARN: pcoord(i) should be used!!
+                      ar(i,k,j,n) = work_trix(m,k)
+                      m = m + 1
+                   ENDDO
+                ENDDO
+
+             ENDDO
+
+          ELSE
+!
+!--          Cache optimized code
+             DO  k = 1, nz
+
+                DO  i = 0, nx
+                   work_fftx(i) = work_trix(i,k)
+                ENDDO
+
+                CALL fft_x( work_fftx, 'backward' )
+
+                m = 0
+                DO  n = 1, pdims(1)
+                   DO  i = 1, nnx_pe( n-1 ) ! WARN: pcoord(i) should be used!!
+                      ar(i,k,j,n) = work_fftx(m)
+                      m = m + 1
+                   ENDDO
+                ENDDO
+
+             ENDDO
+
+          ENDIF
+
+       ENDDO
+
+       DEALLOCATE( tri )
+
+       CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'stop' )
+
+    END SUBROUTINE fftx_tri_fftx
+
+
+    SUBROUTINE fftx_tr_xy( f_in, work, f_out )
+
+!------------------------------------------------------------------------------!
+!  Fourier-transformation along x with subsequent transposition x --> y for
+!  a 1d-decomposition along y
+!
+!  ATTENTION: The NEC-branch of this routine may significantly profit from
+!             further optimizations. So far, performance is much worse than
+!             for routine ffty_tr_yx (more than three times slower).
+!------------------------------------------------------------------------------!
+
+       USE control_parameters
+       USE cpulog
+       USE indices
+       USE interfaces
+       USE pegrid
+       USE transpose_indices
+
+       IMPLICIT NONE
+
+       INTEGER            ::  i, j, k
+
+       REAL, DIMENSION(0:nx,1:nz,nys:nyn)               ::  work_fftx
+       REAL, DIMENSION(1:nza,nys:nyna,0:nxa)            ::  f_in
+       REAL, DIMENSION(nny,1:nza,nxl_y:nxr_ya,pdims(2)) ::  f_out
+       REAL, DIMENSION(nys:nyna,1:nza,0:nxa)            ::  work
+
+!
+!--    Carry out the FFT along x, where all data are present due to the
+!--    1d-decomposition along y. Resort the data in a way that y becomes
+!--    the first index.
+       CALL cpu_log( log_point_s(4), 'fft_x', 'start' )
+
+       IF ( host(1:3) == 'nec' )  THEN
+!
+!--       Code for vector processors
+!$OMP     PARALLEL PRIVATE ( i, j, k, work_fftx )
+!$OMP     DO
+          DO  i = 0, nx
+
+             DO  j = nys, nyn
+                DO  k = 1, nz
+                   work_fftx(i,k,j) = f_in(k,j,i)
+                ENDDO
+             ENDDO
+
+          ENDDO
+
+!$OMP     DO
+          DO  j = nys, nyn
+
+             CALL fft_x_m( work_fftx(:,:,j), 'forward' )
+
+             DO  k = 1, nz
+                DO  i = 0, nx
+                   work(j,k,i) = work_fftx(i,k,j)
+                ENDDO
+             ENDDO
+
+          ENDDO
+!$OMP     END PARALLEL
+
+       ELSE
+
+!
+!--       Cache optimized code (there might be still a potential for better
+!--       optimization).
+!$OMP     PARALLEL PRIVATE (i,j,k,work_fftx)
+!$OMP     DO
+          DO  i = 0, nx
+
+             DO  j = nys, nyn
+                DO  k = 1, nz
+                   work_fftx(i,k,j) = f_in(k,j,i)
+                ENDDO
+             ENDDO
+
+          ENDDO
+
+!$OMP     DO
+          DO  j = nys, nyn
+             DO  k = 1, nz
+
+                CALL fft_x( work_fftx(0:nx,k,j), 'forward' )
+
+                DO  i = 0, nx
+                   work(j,k,i) = work_fftx(i,k,j)
+                ENDDO
+             ENDDO
+
+          ENDDO
+!$OMP     END PARALLEL
+
+       ENDIF
+       CALL cpu_log( log_point_s(4), 'fft_x', 'pause' )
+
+!
+!--    Transpose array
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+       CALL MPI_ALLTOALL( work(nys,1,0),      sendrecvcount_xy, MPI_REAL, &
+                          f_out(1,1,nxl_y,1), sendrecvcount_xy, MPI_REAL, &
+                          comm1dy, ierr )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+    END SUBROUTINE fftx_tr_xy
+
+
+    SUBROUTINE tr_yx_fftx( f_in, work, f_out )
+
+!------------------------------------------------------------------------------!
+!  Transposition y --> x with a subsequent backward Fourier transformation for
+!  a 1d-decomposition along x
+!------------------------------------------------------------------------------!
+
+       USE control_parameters
+       USE cpulog
+       USE indices
+       USE interfaces
+       USE pegrid
+       USE transpose_indices
+
+       IMPLICIT NONE
+
+       INTEGER            ::  i, j, k
+
+       REAL, DIMENSION(0:nx,1:nz,nys:nyn)               ::  work_fftx
+       REAL, DIMENSION(nny,1:nza,nxl_y:nxr_ya,pdims(2)) ::  f_in
+       REAL, DIMENSION(1:nza,nys:nyna,0:nxa)            ::  f_out
+       REAL, DIMENSION(nys:nyna,1:nza,0:nxa)            ::  work
+
+!
+!--    Transpose array
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+       CALL MPI_ALLTOALL( f_in(1,1,nxl_y,1), sendrecvcount_xy, MPI_REAL, &
+                          work(nys,1,0),     sendrecvcount_xy, MPI_REAL, &
+                          comm1dy, ierr )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!--    Carry out the FFT along x, where all data are present due to the
+!--    1d-decomposition along y. Resort the data in a way that y becomes
+!--    the first index.
+       CALL cpu_log( log_point_s(4), 'fft_x', 'continue' )
+
+       IF ( host(1:3) == 'nec' )  THEN
+!
+!--       Code optimized for vector processors
+!$OMP     PARALLEL PRIVATE ( i, j, k, work_fftx )
+!$OMP     DO
+          DO  j = nys, nyn
+
+             DO  k = 1, nz
+                DO  i = 0, nx
+                   work_fftx(i,k,j) = work(j,k,i)
+                ENDDO
+             ENDDO
+
+             CALL fft_x_m( work_fftx(:,:,j), 'backward' )
+
+          ENDDO
+
+!$OMP     DO
+          DO  i = 0, nx
+             DO  j = nys, nyn
+                DO  k = 1, nz
+                   f_out(k,j,i) = work_fftx(i,k,j)
+                ENDDO
+             ENDDO
+          ENDDO
+!$OMP     END PARALLEL
+
+       ELSE
+
+!
+!--       Cache optimized code (there might be still a potential for better
+!--       optimization).
+!$OMP     PARALLEL PRIVATE (i,j,k,work_fftx)
+!$OMP     DO
+          DO  j = nys, nyn
+             DO  k = 1, nz
+
+                DO  i = 0, nx
+                   work_fftx(i,k,j) = work(j,k,i)
+                ENDDO
+
+                CALL fft_x( work_fftx(0:nx,k,j), 'backward' )
+
+             ENDDO
+          ENDDO
+
+!$OMP     DO
+          DO  i = 0, nx
+             DO  j = nys, nyn
+                DO  k = 1, nz
+                   f_out(k,j,i) = work_fftx(i,k,j)
+                ENDDO
+             ENDDO
+          ENDDO
+!$OMP     END PARALLEL
+
+       ENDIF
+       CALL cpu_log( log_point_s(4), 'fft_x', 'stop' )
+
+    END SUBROUTINE tr_yx_fftx
+
+
+    SUBROUTINE ffty_tri_ffty( ar )
+
+!------------------------------------------------------------------------------!
+!  FFT along y, solution of the tridiagonal system and backward FFT for
+!  a 1d-decomposition along y
+!
+!  WARNING: this subroutine may still not work for hybrid parallelization
+!           with OpenMP (for possible necessary changes see the original
+!           routine poisfft_hybrid, developed by Klaus Ketelsen, May 2002)
+!------------------------------------------------------------------------------!
+
+       USE control_parameters
+       USE cpulog
+       USE grid_variables
+       USE indices
+       USE interfaces
+       USE pegrid
+       USE transpose_indices
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k, m, n, omp_get_thread_num, tn
+
+       REAL, DIMENSION(0:ny)                            ::  work_ffty
+       REAL, DIMENSION(0:ny,1:nz)                       ::  work_triy
+       REAL, DIMENSION(nny,1:nza,nxl_y:nxr_ya,pdims(2)) ::  ar
+       REAL, DIMENSION(:,:,:,:), ALLOCATABLE            ::  tri
+
+
+       CALL cpu_log( log_point_s(39), 'fft_y + tridia', 'start' )
+
+       ALLOCATE( tri(5,0:ny,0:nz-1,0:threads_per_task-1) )
+
+       tn = 0           ! Default thread number in case of one thread
+!$OMP  PARALLEL PRIVATE ( i, j, k, m, n, tn, work_ffty, work_triy )
+!$OMP  DO
+       DO  i = nxl_y, nxr_y
+
+!$        tn = omp_get_thread_num()
+
+          IF ( host(1:3) == 'nec' )  THEN
+!
+!--          Code optimized for vector processors
+             DO  k = 1, nz
+
+                m = 0
+                DO  n = 1, pdims(2)
+                   DO  j = 1, nny_pe( n-1 ) ! WARN: pcoord(j) should be used!!
+                      work_triy(m,k) = ar(j,k,i,n)
+                      m = m + 1
+                   ENDDO
+                ENDDO
+
+             ENDDO
+
+             CALL fft_y_m( work_triy, ny, 'forward' )
+
+          ELSE
+!
+!--          Cache optimized code
+             DO  k = 1, nz
+
+                m = 0
+                DO  n = 1, pdims(2)
+                   DO  j = 1, nny_pe( n-1 ) ! WARN: pcoord(j) should be used!!
+                      work_ffty(m) = ar(j,k,i,n)
+                      m = m + 1
+                   ENDDO
+                ENDDO
+
+                CALL fft_y( work_ffty, 'forward' )
+
+                DO  j = 0, ny
+                   work_triy(j,k) = work_ffty(j)
+                ENDDO
+
+             ENDDO
+
+          ENDIF
+
+!
+!--       Solve the linear equation system
+          CALL tridia_1dd( ddy2, ddx2, ny, nx, i, work_triy, tri(:,:,:,tn) )
+
+          IF ( host(1:3) == 'nec' )  THEN
+!
+!--          Code optimized for vector processors
+             CALL fft_y_m( work_triy, ny, 'backward' )
+
+             DO  k = 1, nz
+
+                m = 0
+                DO  n = 1, pdims(2)
+                   DO  j = 1, nny_pe( n-1 ) ! WARN: pcoord(j) should be used!!
+                      ar(j,k,i,n) = work_triy(m,k)
+                      m = m + 1
+                   ENDDO
+                ENDDO
+
+             ENDDO
+
+          ELSE
+!
+!--          Cache optimized code
+             DO  k = 1, nz
+
+                DO  j = 0, ny
+                   work_ffty(j) = work_triy(j,k)
+                ENDDO
+
+                CALL fft_y( work_ffty, 'backward' )
+
+                m = 0
+                DO  n = 1, pdims(2)
+                   DO  j = 1, nny_pe( n-1 ) ! WARN: pcoord(j) should be used!!
+                      ar(j,k,i,n) = work_ffty(m)
+                      m = m + 1
+                   ENDDO
+                ENDDO
+
+             ENDDO
+
+          ENDIF
+
+       ENDDO
+!$OMP  END PARALLEL
+
+       DEALLOCATE( tri )
+
+       CALL cpu_log( log_point_s(39), 'fft_y + tridia', 'stop' )
+
+    END SUBROUTINE ffty_tri_ffty
+
+
+    SUBROUTINE tridia_1dd( ddx2, ddy2, nx, ny, j, ar, tri )
+
+!------------------------------------------------------------------------------!
+! Solves the linear system of equations for a 1d-decomposition along x (see
+! tridia)
+!
+! Attention:  when using the intel compiler, array tri must be passed as an
+!             argument to the contained subroutines. Otherwise addres faults
+!             will occur.
+!             On NEC, tri should not be passed (except for routine substi_1dd)
+!             because this causes very bad performance.
+!------------------------------------------------------------------------------!
+
+       USE arrays_3d
+       USE control_parameters
+
+       USE pegrid
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k, nnyh, nx, ny, omp_get_thread_num, tn
+
+       REAL    ::  ddx2, ddy2
+
+       REAL, DIMENSION(0:nx,1:nz)     ::  ar
+       REAL, DIMENSION(0:nx,0:nz-1)   ::  ar1
+       REAL, DIMENSION(5,0:nx,0:nz-1) ::  tri
+
+
+       nnyh = ( ny + 1 ) / 2
+
+!
+!--    Define constant elements of the tridiagonal matrix.
+!--    The compiler on SX6 does loop exchange. If 0:nx is a high power of 2, 
+!--    the exchanged loops create bank conflicts. The following directive
+!--    prohibits loop exchange and the loops perform much better.
+!       tn = omp_get_thread_num()
+!       WRITE( 120+tn, * ) '+++ id=',myid,' nx=',nx,' thread=', omp_get_thread_num()
+!       CALL FLUSH_( 120+tn )
+!CDIR NOLOOPCHG
+       DO  k = 0, nz-1
+          DO  i = 0,nx
+             tri(2,i,k) = ddzu(k+1) * ddzw(k+1)
+             tri(3,i,k) = ddzu(k+2) * ddzw(k+1)
+          ENDDO
+       ENDDO
+!       WRITE( 120+tn, * ) '+++ id=',myid,' end of first tridia loop   thread=', omp_get_thread_num()
+!       CALL FLUSH_( 120+tn )
+
+       IF ( j <= nnyh )  THEN
+#if defined( __lcmuk )
+          CALL maketri_1dd( j, tri )
+#else
+          CALL maketri_1dd( j )
+#endif
+       ELSE
+#if defined( __lcmuk )
+          CALL maketri_1dd( ny+1-j, tri )
+#else
+          CALL maketri_1dd( ny+1-j )
+#endif
+       ENDIF
+#if defined( __lcmuk )
+       CALL split_1dd( tri )
+#else
+       CALL split_1dd
+#endif
+       CALL substi_1dd( ar, tri )
+
+    CONTAINS
+
+#if defined( __lcmuk )
+       SUBROUTINE maketri_1dd( j, tri )
+#else
+       SUBROUTINE maketri_1dd( j )
+#endif
+
+!------------------------------------------------------------------------------!
+! computes the i- and j-dependent component of the matrix
+!------------------------------------------------------------------------------!
+
+          USE constants
+
+          IMPLICIT NONE
+
+          INTEGER ::  i, j, k, nnxh
+          REAL    ::  a, c
+
+          REAL, DIMENSION(0:nx) ::  l
+
+#if defined( __lcmuk )
+          REAL, DIMENSION(5,0:nx,0:nz-1) ::  tri
+#endif
+
+
+          nnxh = ( nx + 1 ) / 2
+!
+!--       Provide the tridiagonal matrix for solution of the Poisson equation in
+!--       Fourier space. The coefficients are computed following the method of
+!--       Schmidt et al. (DFVLR-Mitteilung 84-15), which departs from Stephan
+!--       Siano's original version by discretizing the Poisson equation,
+!--       before it is Fourier-transformed
+          DO  i = 0, nx
+             IF ( i >= 0 .AND. i < nnxh ) THEN
+                l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / &
+                                         FLOAT( nx+1 ) ) ) * ddx2 + &
+                       2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+                                         FLOAT( ny+1 ) ) ) * ddy2
+             ELSEIF ( i == nnxh ) THEN
+                l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
+                                         FLOAT( nx+1 ) ) ) * ddx2 + &
+                       2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+                                         FLOAT( ny+1 ) ) ) * ddy2
+             ELSE
+                l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
+                                         FLOAT( nx+1 ) ) ) * ddx2 + &
+                       2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+                                         FLOAT( ny+1 ) ) ) * ddy2
+             ENDIF
+          ENDDO
+
+          DO  k = 0, nz-1
+             DO  i = 0, nx
+                a = -1.0 * ddzu(k+2) * ddzw(k+1)
+                c = -1.0 * ddzu(k+1) * ddzw(k+1)
+                tri(1,i,k) = a + c - l(i)
+             ENDDO
+          ENDDO
+          IF ( ibc_p_b == 1  .OR.  ibc_p_b == 2 )  THEN
+             DO  i = 0, nx
+                tri(1,i,0) = tri(1,i,0) + tri(2,i,0)
+             ENDDO
+          ENDIF
+          IF ( ibc_p_t == 1 )  THEN
+             DO  i = 0, nx
+                tri(1,i,nz-1) = tri(1,i,nz-1) + tri(3,i,nz-1)
+             ENDDO
+          ENDIF
+
+       END SUBROUTINE maketri_1dd
+
+
+#if defined( __lcmuk )
+       SUBROUTINE split_1dd( tri )
+#else
+       SUBROUTINE split_1dd
+#endif
+
+!------------------------------------------------------------------------------!
+! Splitting of the tridiagonal matrix (Thomas algorithm)
+!------------------------------------------------------------------------------!
+
+          IMPLICIT NONE
+
+          INTEGER ::  i, k
+
+#if defined( __lcmuk )
+          REAL, DIMENSION(5,0:nx,0:nz-1) ::  tri
+#endif
+
+
+!
+!--       Splitting
+          DO  i = 0, nx
+             tri(4,i,0) = tri(1,i,0)
+          ENDDO
+          DO  k = 1, nz-1
+             DO  i = 0, nx
+                tri(5,i,k) = tri(2,i,k) / tri(4,i,k-1)
+                tri(4,i,k) = tri(1,i,k) - tri(3,i,k-1) * tri(5,i,k)
+             ENDDO
+          ENDDO
+
+       END SUBROUTINE split_1dd
+
+
+       SUBROUTINE substi_1dd( ar, tri )
+
+!------------------------------------------------------------------------------!
+! Substitution (Forward and Backward) (Thomas algorithm)
+!------------------------------------------------------------------------------!
+
+          IMPLICIT NONE
+
+          INTEGER ::  i, j, k
+
+          REAL, DIMENSION(0:nx,nz)       ::  ar
+          REAL, DIMENSION(0:nx,0:nz-1)   ::  ar1
+          REAL, DIMENSION(5,0:nx,0:nz-1) ::  tri
+
+!
+!--       Forward substitution
+          DO  i = 0, nx
+             ar1(i,0) = ar(i,1)
+          ENDDO
+          DO  k = 1, nz-1
+             DO  i = 0, nx
+                ar1(i,k) = ar(i,k+1) - tri(5,i,k) * ar1(i,k-1)
+             ENDDO
+          ENDDO
+
+!
+!--       Backward substitution
+          DO  i = 0, nx
+             ar(i,nz) = ar1(i,nz-1) / tri(4,i,nz-1)
+          ENDDO
+          DO  k = nz-2, 0, -1
+             DO  i = 0, nx
+                ar(i,k+1) = ( ar1(i,k) - tri(3,i,k) * ar(i,k+2) ) &
+                            / tri(4,i,k)
+             ENDDO
+          ENDDO
+
+       END SUBROUTINE substi_1dd
+
+    END SUBROUTINE tridia_1dd
+
+#endif
+
+ END MODULE poisfft_mod
Index: palm/trunk/SOURCE/poisfft_hybrid.f90
===================================================================
--- palm/trunk/SOURCE/poisfft_hybrid.f90	(revision 1)
+++ palm/trunk/SOURCE/poisfft_hybrid.f90	(revision 1)
@@ -0,0 +1,1075 @@
+ MODULE poisfft_hybrid_mod
+!------------------------------------------------------------------------------
+! 
+! Actual revisions: 
+! ----------------- 
+! 
+!
+! Former revisions: 
+! ----------------- 
+! $Log: poisfft_hybrid.f90,v $
+! Revision 1.11  2004/04/30 12:43:14  raasch
+! Renaming of fft routines, additional argument in calls of fft_y_m
+!
+! Revision 1.10  2003/08/01 08:49:30  raasch
+! Error removed: reqa=req after calling routine MPI_IRECV (cascade)
+!
+! Revision 1.9  2003/05/09 14:50:47  raasch
+! Parameters in calls of MPI_ALLTOALL, MPI_WAITALL changed in order to fulfill
+! f95 type and rank requirements
+!
+! Revision 1.8  2003/03/16 11:17:04  raasch
+! +module pegrid in poisfft_hybrid_ini
+!
+! Revision 1.7  2003/03/16 09:45:52  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.6  2003/03/16 09:11:42  raasch
+! Fortran error removed
+!
+! Revision 1.5  2003/03/14 13:45:53  raasch
+! Loop optimization in maketri_hybrid
+!
+! Revision 1.4  2003/03/12 16:37:22  raasch
+! Vectorized version (poisfft_hybrid_omp_vec) added, arguments ar and tri
+! passed to routine substi_hybrid (otherwise no vectorization and very
+! bad performance on NEC), reading of environment variable tasks_per_node
+! moved to routine parin
+!
+! Revision 1.3  2002/12/20 15:18:02  raasch
+! Variable statement restricted for parallel environment in subroutine
+! cascade
+!
+! Revision 1.2  2002/12/19 16:08:31  raasch
+! Preprocessor directive KKMP introduced (OMP does NOT work),
+! array tri will be a shared array in OpenMP loop, to get better cache
+! utilization, the i index  (x-direction) will be executed in stride
+! "istride" as outer loop and in a shorter inner loop,
+! overlapping of computation and communication realized by new routine
+! poisfft_hybrid_nodes, name of old routine poisfft_hybrid changed to
+! poisfft_hybrid_omp, STOP statement replaced by call of subroutine local_stop
+! 
+! 
+! Description: 
+! ------------ 
+! Solution of the Poisson equation with a 2D spectral method.  
+! Hybrid version for parallel computers using a 1D domain decomposition, 
+! realized with MPI, along x and parallelization with OPEN-MP along y
+! (routine poisfft_hybrid_omp). In a second version (poisfft_hybrid_nodes),
+! optimization is realized by overlapping of computation and communication
+! and by simultaneously executing as many communication calls as switches
+! per logical partition (LPAR) are available. This version comes into
+! effect if more than one node is used and if the environment variable
+! tasks_per_node is set in a way that it can be devided by switch_per_lpar
+! without any rest.
+!
+! WARNING: In case of OpenMP, there are problems with allocating large
+! arrays in parallel regions. 
+! 
+! Copyright   Klaus Ketelsen / Siegfried Raasch   May 2002
+!------------------------------------------------------------------------------!
+
+    USE fft_xy
+    USE indices
+    USE pegrid
+
+    IMPLICIT NONE
+
+    PRIVATE
+    PUBLIC poisfft_hybrid, poisfft_hybrid_ini
+
+    INTEGER, PARAMETER ::  switch_per_lpar = 2
+
+    INTEGER, SAVE ::  nxl_a, nxr_a, &      ! total   x dimension
+                      nxl_p, nxr_p, &      ! partial x dimension
+                      nys_a, nyn_a, &      ! total   y dimension
+                      nys_p, nyn_p, &      ! partial y dimension
+
+                      npe_s,        &      ! total number of PEs for solver
+                      nwords,       &      ! number of points to be exchanged
+                                           ! with MPI_ALLTOALL
+                      n_omp_threads        ! number of OpenMP threads
+
+!
+!-- Variables for multi node version (cluster version) using routine
+!-- poisfft_hybrid_nodes
+    INTEGER, SAVE :: comm_nodes,          & ! communicater nodes
+                     comm_node_all,       & ! communicater all PEs node version
+                     comm_tasks,          & ! communicater tasks
+                     me, me_node, me_task,& ! identity of this PE
+                     nodes,               & ! number of nodes
+                     tasks_per_logical_node = -1    ! default no cluster
+                      
+
+!
+!-- Public interfaces
+    INTERFACE poisfft_hybrid_ini
+       MODULE PROCEDURE poisfft_hybrid_ini
+    END INTERFACE poisfft_hybrid_ini
+
+    INTERFACE poisfft_hybrid
+       MODULE PROCEDURE poisfft_hybrid
+    END INTERFACE poisfft_hybrid
+
+!
+!-- Private interfaces
+    INTERFACE poisfft_hybrid_omp
+       MODULE PROCEDURE poisfft_hybrid_omp
+    END INTERFACE poisfft_hybrid_omp
+
+    INTERFACE poisfft_hybrid_omp_vec
+       MODULE PROCEDURE poisfft_hybrid_omp_vec
+    END INTERFACE poisfft_hybrid_omp_vec
+
+    INTERFACE poisfft_hybrid_nodes
+       MODULE PROCEDURE poisfft_hybrid_nodes
+    END INTERFACE poisfft_hybrid_nodes
+
+    INTERFACE tridia_hybrid
+       MODULE PROCEDURE tridia_hybrid
+    END INTERFACE tridia_hybrid
+
+    INTERFACE cascade
+       MODULE PROCEDURE cascade
+    END INTERFACE cascade
+
+ CONTAINS
+ 
+ 
+    SUBROUTINE poisfft_hybrid_ini
+
+       USE control_parameters
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=8)      ::  cdummy
+       INTEGER               ::  idummy, istat
+       INTEGER, DIMENSION(2) ::  coords, dims
+
+       LOGICAL, DIMENSION(2) ::  period = .false., re_dims
+
+
+!
+!--    Set the internal index values for the hybrid solver
+#if defined( __parallel )
+       npe_s = pdims(1)
+#else
+       npe_s = 1
+#endif
+       nxl_a = 0
+       nxr_a = nx
+       nxl_p = 0
+       nxr_p = ( ( nx+1 ) / npe_s ) - 1
+       nys_a = nys 
+       nyn_a = nyn
+       nys_p = 0
+       nyn_p = ( ( ny+1 ) / npe_s ) - 1
+
+       nwords = ( nxr_p-nxl_p+1 ) * nz * ( nyn_p-nys_p+1 )
+
+#if defined( __KKMP )
+       CALL LOCAL_GETENV( 'OMP_NUM_THREADS', 15, cdummy, idummy )
+       READ ( cdummy, '(I8)' )  n_omp_threads
+       IF ( myid == 0  .AND.  n_omp_threads > 1 )  THEN
+          PRINT*, '*** poisfft_hybrid_ini:  Number of OpenMP threads = ', &
+                  n_omp_threads
+       ENDIF
+#else
+       n_omp_threads = 1
+#endif
+!
+!--    Initialize the one-dimensional FFT routines
+       CALL fft_init
+
+!
+!--    Setup for multi node version (poisfft_hybrid_nodes)
+       IF ( n_omp_threads == 1  .AND.  &
+            ( host(1:4) == 'ibmh' .OR. host(1:4) == 'ibmb' ) )  THEN
+
+          IF ( tasks_per_node /= -9999 )  THEN
+!
+!--          Multi node version requires that the available number of
+!--          switches per logical partition must be an integral divisor
+!--          of the chosen number of tasks per node
+             IF ( MOD( tasks_per_node, switch_per_lpar ) == 0 )  THEN
+!
+!--             Set the switch which decides about usage of the multi node
+!--             version
+                IF ( tasks_per_node / switch_per_lpar > 1  .AND. &
+                     numprocs > tasks_per_node )  THEN
+                   tasks_per_logical_node = tasks_per_node / switch_per_lpar
+                ENDIF
+
+                IF ( myid == 0  .AND.  tasks_per_logical_node > -1 )  THEN
+                   PRINT*, '*** poisfft_hybrid_ini:  running optimized ', &
+                           'multinode version'
+                   PRINT*, '    switch_per_lpar        = ', switch_per_lpar
+                   PRINT*, '    tasks_per_lpar         = ', tasks_per_node
+                   PRINT*, '    tasks_per_logical_node = ', &
+                                                         tasks_per_logical_node
+                ENDIF
+
+             ENDIF
+          ENDIF
+       ENDIF
+
+!
+!--    Determine sub-topologies for multi node version
+       IF ( tasks_per_logical_node >= 2 )  THEN
+
+#if defined( __parallel )
+          nodes   = ( numprocs + tasks_per_logical_node - 1 ) / &
+                    tasks_per_logical_node
+          dims(1) = nodes
+          dims(2) = tasks_per_logical_node
+
+          CALL MPI_CART_CREATE( comm2d, 2, dims, period, .FALSE., &
+                                comm_node_all, istat )
+          CALL MPI_COMM_RANK( comm_node_all, me, istat )
+
+          re_dims(1) = .TRUE.
+          re_dims(2) = .FALSE.
+          CALL MPI_CART_SUB( comm_node_all, re_dims, comm_nodes, istat )
+          CALL MPI_COMM_RANK( comm_nodes, me_node, istat )
+
+          re_dims(1) = .FALSE.
+          re_dims(2) = .TRUE.
+          CALL MPI_CART_SUB( comm_node_all, re_dims, comm_tasks, istat )
+          CALL MPI_COMM_RANK( comm_tasks, me_task, istat )
+
+!          write(0,*) 'who am i',myid,me,me_node,me_task,nodes,&
+!                     tasks_per_logical_node
+#else
+          PRINT*, '+++ poisfft_hybrid_ini: parallel environment (MPI) required'
+          CALL local_stop
+#endif
+       ENDIF
+
+    END SUBROUTINE poisfft_hybrid_ini
+
+
+    SUBROUTINE poisfft_hybrid( ar )
+
+       USE control_parameters
+       USE interfaces
+
+       IMPLICIT NONE
+
+       REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) ::  ar
+
+       IF ( host(1:3) == 'nec' )  THEN
+          CALL poisfft_hybrid_omp_vec( ar )
+       ELSE
+          IF ( tasks_per_logical_node == -1 )  THEN
+             CALL poisfft_hybrid_omp( ar )
+          ELSE
+             CALL poisfft_hybrid_nodes( ar )
+          ENDIF
+       ENDIF
+
+    END SUBROUTINE poisfft_hybrid
+
+
+    SUBROUTINE poisfft_hybrid_omp ( ar )
+
+       USE cpulog
+       USE interfaces
+
+       IMPLICIT NONE
+
+       INTEGER, PARAMETER ::  istride = 4  ! stride of i loop
+       INTEGER ::  i, ii, ir, iei, iouter, istat, j, jj, k, m, n, jthread
+
+       REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) ::  ar
+
+       REAL, DIMENSION(0:nx)                 ::  fftx_ar
+       REAL, DIMENSION(0:ny,istride)         ::  ffty_ar
+ 
+       REAL, DIMENSION(0:nx,nz)              ::  tri_ar
+
+       REAL, DIMENSION(nxl_p:nxr_p,nz,nys_p:nyn_p,npe_s) ::  work1, work2
+#if defined( __KKMP )
+       INTEGER ::  omp_get_thread_num
+       REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  tri
+       ALLOCATE( tri(5,0:nx,0:nz-1,n_omp_threads ) )
+#else
+       REAL, DIMENSION(5,0:nx,0:nz-1,1)      ::  tri
+#endif
+
+
+       CALL cpu_log( log_point_s(30), 'poisfft_hybrid_omp', 'start' )
+
+       CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
+
+!$OMP  PARALLEL PRIVATE (i,iouter,ii,ir,iei,j,k,m,n,ffty_ar)
+!$OMP  DO
+!
+!--    Store grid points to be transformed on a 1d-array, do the fft
+!--    and sample the results on a 4d-array
+       DO  iouter = nxl_p, nxr_p, istride     ! stride loop, better cache
+          iei = MIN( iouter+istride-1, nxr_p )
+          DO  k = 1, nz
+
+             DO  i = iouter, iei
+                ii = nxl + i
+                ir = i - iouter + 1
+
+                DO  j = nys_a, nyn_a
+                   ffty_ar(j,ir) = ar(k,j,ii)
+                ENDDO
+   
+                CALL fft_y( ffty_ar(:,ir), 'forward' )
+             ENDDO
+
+             m = nys_a
+             DO  n = 1, npe_s
+                DO  j = nys_p, nyn_p
+                   DO  i = iouter, iei
+                      ir = i - iouter + 1
+                      work1(i,k,j,n) = ffty_ar(m,ir)
+                   ENDDO
+                   m = m+1
+                ENDDO
+             ENDDO
+   
+          ENDDO
+       ENDDO
+!$OMP  END PARALLEL
+
+       CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
+
+#if defined( __parallel )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+
+       CALL MPI_ALLTOALL( work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+                          work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+                          comm2d, istat )
+
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+#else
+       work2 = work1
+#endif
+
+       CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'start' )
+
+#if defined( __KKMP )
+!$OMP  PARALLEL PRIVATE (i,j,jj,k,m,n,fftx_ar,tri_ar,jthread)
+!$OMP  DO
+       DO  j = nys_p, nyn_p
+          jthread = omp_get_thread_num() + 1
+#else
+       DO  j = nys_p, nyn_p
+          jthread = 1
+#endif
+          DO  k = 1, nz
+
+             m = nxl_a
+             DO  n = 1, npe_s
+                DO  i = nxl_p, nxr_p
+                   fftx_ar(m) = work2(i,k,j,n)
+                   m = m+1
+                ENDDO
+             ENDDO
+
+             CALL fft_x( fftx_ar, 'forward' )
+
+             DO  i = nxl_a, nxr_a
+                tri_ar(i,k) = fftx_ar(i)
+             ENDDO
+
+          ENDDO
+  
+          jj = myid * (nyn_p-nys_p+1) + j
+          CALL tridia_hybrid( jj, tri_ar, tri(:,:,:,jthread))
+
+          DO  k = 1, nz
+             DO  i = nxl_a, nxr_a
+                fftx_ar(i) = tri_ar (i,k)
+             ENDDO
+
+             CALL fft_x( fftx_ar, 'backward' )
+
+             m = nxl_a
+             DO  n = 1, npe_s
+                DO  i = nxl_p, nxr_p
+                   work2(i,k,j,n) = fftx_ar(m)
+                   m = m+1
+                ENDDO
+             ENDDO
+
+          ENDDO
+       ENDDO
+#if defined( __KKMP )
+!$OMP  END PARALLEL
+#endif
+
+       CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'stop' )
+
+#if defined( __parallel )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' ) 
+       nwords = (nxr_p-nxl_p+1) * nz * (nyn_p-nys_p+1)
+
+       CALL MPI_ALLTOALL( work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+                          work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+                          comm2d, istat )
+
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+#else
+       work1 = work2
+#endif
+
+       CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
+
+!$OMP  PARALLEL PRIVATE (i,iouter,ii,ir,iei,j,k,m,n,ffty_ar)
+!$OMP  DO
+       DO  iouter = nxl_p, nxr_p, istride
+          iei = MIN( iouter+istride-1, nxr_p )
+          DO  k = 1, nz
+
+             m = nys_a
+             DO  n = 1, npe_s
+                DO  j = nys_p, nyn_p
+                   DO  i = iouter, iei
+                      ir = i - iouter + 1
+                      ffty_ar(m,ir) = work1 (i,k,j,n)
+                   ENDDO
+                   m = m+1
+                ENDDO
+             ENDDO
+
+             DO  i = iouter, iei
+                ii = nxl + i
+                ir = i - iouter + 1
+                CALL fft_y( ffty_ar(:,ir), 'backward' )
+
+                DO  j = nys_a, nyn_a
+                   ar(k,j,ii) = ffty_ar(j,ir)
+                ENDDO
+             ENDDO
+
+          ENDDO
+       ENDDO
+!$OMP  END PARALLEL
+
+       CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
+
+       CALL cpu_log( log_point_s(30), 'poisfft_hybrid_omp', 'stop' )
+
+#if defined( __KKMP )
+       DEALLOCATE( tri )
+#endif
+
+    END SUBROUTINE poisfft_hybrid_omp
+
+
+    SUBROUTINE poisfft_hybrid_omp_vec ( ar )
+
+       USE cpulog
+       USE interfaces
+
+       IMPLICIT NONE
+
+       INTEGER, PARAMETER ::  istride = 4  ! stride of i loop
+       INTEGER ::  i, ii, ir, iei, iouter, istat, j, jj, k, m, n, jthread
+
+       REAL, DIMENSION(0:nx,nz)               ::  tri_ar
+
+       REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr)  ::  ar
+
+       REAL, DIMENSION(0:ny+3,nz,nxl_p:nxr_p) ::  ffty_ar3
+       REAL, DIMENSION(0:nx+3,nz,nys_p:nyn_p) ::  fftx_ar3
+ 
+       REAL, DIMENSION(nxl_p:nxr_p,nz,nys_p:nyn_p,npe_s) ::  work1, work2
+#if defined( __KKMP )
+       INTEGER ::  omp_get_thread_num
+       REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  tri
+       ALLOCATE( tri(5,0:nx,0:nz-1,n_omp_threads ) )
+#else
+       REAL, DIMENSION(5,0:nx,0:nz-1,1)      ::  tri
+#endif
+
+
+       CALL cpu_log( log_point_s(30), 'poisfft_hybrid_vec', 'start' )
+
+       CALL cpu_log( log_point_s(7), 'fft_y_m', 'start' )
+
+!$OMP  PARALLEL PRIVATE (i,j,k,m,n)
+!$OMP  DO
+!
+!--    Store grid points to be transformed on a 1d-array, do the fft
+!--    and sample the results on a 4d-array
+       DO  i = nxl_p, nxr_p
+
+          DO  j = nys_a, nyn_a
+             DO  k = 1, nz
+                ffty_ar3(j,k,i) = ar(k,j,i+nxl)
+             ENDDO
+          ENDDO
+
+          CALL fft_y_m( ffty_ar3(:,:,i), ny+3, 'forward' )
+       ENDDO
+
+!$OMP  DO
+       DO  k = 1, nz
+          m = nys_a
+          DO  n = 1, npe_s
+             DO  j = nys_p, nyn_p
+                 DO  i = nxl_p, nxr_p
+                     work1(i,k,j,n) = ffty_ar3(m,k,i)
+                 ENDDO
+                 m = m+1
+             ENDDO
+          ENDDO
+       ENDDO
+!$OMP  END PARALLEL
+
+       CALL cpu_log( log_point_s(7), 'fft_y_m', 'pause' )
+
+#if defined( __parallel )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+       CALL MPI_ALLTOALL( work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+                          work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+                          comm2d, istat )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+#else
+       work2 = work1
+#endif
+
+       CALL cpu_log( log_point_s(33), 'fft_x_m + tridia', 'start' )
+
+#if defined( __KKMP )
+!$OMP  PARALLEL PRIVATE (i,j,jj,k,m,n,tri_ar,jthread)
+!$OMP  DO
+       DO  j = nys_p, nyn_p
+          jthread = omp_get_thread_num() + 1
+#else
+       DO  j = nys_p, nyn_p
+          jthread = 1
+#endif
+          DO  k = 1, nz
+
+             m = nxl_a
+             DO  n = 1, npe_s
+                DO  i = nxl_p, nxr_p
+                   fftx_ar3(m,k,j) = work2(i,k,j,n)
+                   m = m+1
+                ENDDO
+             ENDDO
+          ENDDO
+
+          CALL fft_x_m( fftx_ar3(:,:,j), 'forward' )
+
+          DO  k = 1, nz
+             DO  i = nxl_a, nxr_a
+                tri_ar(i,k) = fftx_ar3(i,k,j)
+             ENDDO
+          ENDDO
+  
+          jj = myid * (nyn_p-nys_p+1) + j
+          CALL tridia_hybrid( jj, tri_ar, tri(:,:,:,jthread))
+
+          DO  k = 1, nz
+             DO  i = nxl_a, nxr_a
+                fftx_ar3(i,k,j) = tri_ar (i,k)
+             ENDDO
+          ENDDO
+
+          CALL fft_x_m( fftx_ar3(:,:,j), 'backward' )
+
+          DO  k = 1, nz
+             m = nxl_a
+             DO  n = 1, npe_s
+                DO  i = nxl_p, nxr_p
+                   work2(i,k,j,n) = fftx_ar3(m,k,j)
+                   m = m+1
+                ENDDO
+             ENDDO
+          ENDDO
+
+       ENDDO
+#if defined( __KKMP )
+!$OMP  END PARALLEL
+#endif
+
+       CALL cpu_log( log_point_s(33), 'fft_x_m + tridia', 'stop' )
+
+#if defined( __parallel )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' ) 
+       nwords = (nxr_p-nxl_p+1) * nz * (nyn_p-nys_p+1)
+       CALL MPI_ALLTOALL( work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+                          work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+                          comm2d, istat )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+#else
+       work1 = work2
+#endif
+
+       CALL cpu_log( log_point_s(7), 'fft_y_m', 'continue' )
+
+!$OMP  PARALLEL PRIVATE (i,iouter,ii,ir,iei,j,k,m,n)
+!$OMP  DO
+       DO  k = 1, nz
+          m = nys_a
+          DO  n = 1, npe_s
+             DO  j = nys_p, nyn_p
+                 DO  i = nxl_p, nxr_p
+                     ffty_ar3(m,k,i) = work1(i,k,j,n)
+                 ENDDO
+                 m = m+1
+             ENDDO
+          ENDDO
+       ENDDO 
+
+!$OMP  DO
+       DO  i = nxl_p, nxr_p
+          CALL fft_y_m( ffty_ar3(:,:,i), ny+3, 'backward' )
+          DO  j = nys_a, nyn_a
+             DO  k = 1, nz
+                ar(k,j,i+nxl) = ffty_ar3(j,k,i)
+             ENDDO
+          ENDDO
+       ENDDO
+!$OMP  END PARALLEL
+
+       CALL cpu_log( log_point_s(7), 'fft_y_m', 'stop' )
+
+       CALL cpu_log( log_point_s(30), 'poisfft_hybrid_vec', 'stop' )
+
+#if defined( __KKMP )
+       DEALLOCATE( tri )
+#endif
+
+    END SUBROUTINE poisfft_hybrid_omp_vec
+
+
+    SUBROUTINE poisfft_hybrid_nodes ( ar )
+
+       USE cpulog
+       USE interfaces
+
+       IMPLICIT NONE
+
+       INTEGER, PARAMETER ::  istride = 4  ! stride of i loop
+       INTEGER            ::  i, iei, ii, iouter, ir, istat, j, jj, k, m, &
+                              n, nn, nt, nw1, nw2
+
+       REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) ::  ar
+
+       REAL, DIMENSION(0:nx)                 ::  fftx_ar
+       REAL, DIMENSION(0:ny,istride)         ::  ffty_ar
+ 
+       REAL, DIMENSION(0:nx,nz)              ::  tri_ar
+
+       REAL, DIMENSION(nxl_p:nxr_p,nz,tasks_per_logical_node, &
+                          nodes,nys_p:nyn_p) ::  work1,work2
+       REAL, DIMENSION(5,0:nx,0:nz-1)        ::  tri
+
+
+       CALL cpu_log( log_point_s(30), 'poisfft_hybrid_nodes', 'start' )
+
+       CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
+
+!
+!--    Store grid points to be transformed on a 1d-array, do the fft
+!--    and sample the results on a 4d-array
+       DO  iouter = nxl_p, nxr_p, istride  ! stride loop, better cache
+          iei = MIN( iouter+istride-1, nxr_p )
+          DO  k = 1, nz
+
+             DO  i = iouter, iei
+                ii = nxl + i
+                ir = i - iouter + 1
+
+                DO  j = nys_a, nyn_a
+                   ffty_ar(j,ir) = ar(k,j,ii)
+                ENDDO
+   
+                CALL fft_y( ffty_ar(:,ir), 'forward' )
+             ENDDO
+
+             m = nys_a
+             DO  nn = 1, nodes
+                DO  nt = 1, tasks_per_logical_node
+                   DO  j = nys_p, nyn_p
+                      DO  i = iouter, iei
+                         ir = i - iouter + 1
+                         work1(i,k,nt,nn,j) = ffty_ar(m,ir)
+                      ENDDO
+                      m = m+1
+                   ENDDO
+                ENDDO
+             ENDDO
+   
+          ENDDO
+       ENDDO
+
+       CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
+
+       CALL cpu_log( log_point_s(32), 'alltoall_task', 'start' )
+       nw1 = SIZE( work1, 1 ) * SIZE( work1, 2 )
+       DO  nn = 1, nodes
+           DO  j = nys_p, nyn_p
+#if defined( __parallel )
+              CALL MPI_ALLTOALL( work1(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
+                                 work2(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
+                                                     comm_tasks, istat )
+#endif
+           ENDDO
+       ENDDO
+       CALL cpu_log( log_point_s(32), 'alltoall_task', 'stop' )
+
+
+       DO  j = nys_p, nyn_p
+        
+          CALL cascade( 1, j, nys_p, nyn_p )
+          nw2 = nw1 * SIZE( work1, 3 )
+          CALL cpu_log( log_point_s(37), 'alltoall_node', 'start' )
+#if defined( __parallel )
+          CALL MPI_ALLTOALL( work2(nxl_p,1,1,1,j), nw2, MPI_REAL, &
+                             work1(nxl_p,1,1,1,j), nw2, MPI_REAL, &
+                                                  comm_nodes, istat )
+#endif
+          CALL cpu_log( log_point_s(37), 'alltoall_node', 'pause' )
+          CALL cascade( 2, j, nys_p, nyn_p )
+
+          CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'start' )
+          DO  k = 1, nz
+
+             m = nxl_a
+             DO  nn = 1, nodes
+                DO  nt = 1, tasks_per_logical_node
+                   DO  i = nxl_p, nxr_p
+                      fftx_ar(m) = work1(i,k,nt,nn,j)
+                      m = m+1
+                   ENDDO
+                ENDDO
+             ENDDO
+
+             CALL fft_x( fftx_ar, 'forward' )
+
+             DO  i = nxl_a, nxr_a
+                tri_ar(i,k) = fftx_ar(i)
+             ENDDO
+
+          ENDDO
+  
+          jj = myid * (nyn_p-nys_p+1) + j
+          CALL tridia_hybrid( jj, tri_ar, tri(:,:,:) )
+
+          DO  k = 1, nz
+             DO  i = nxl_a, nxr_a
+                fftx_ar(i) = tri_ar(i,k)
+             ENDDO
+
+             CALL fft_x( fftx_ar, 'backward' )
+
+             m = nxl_a
+             DO  nn = 1, nodes
+                DO  nt = 1, tasks_per_logical_node
+                   DO  i = nxl_p, nxr_p
+                      work1(i,k,nt,nn,j) = fftx_ar(m)
+                      m = m+1
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDDO
+
+          CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'stop' )
+          nw2 = nw1 * SIZE( work1, 3 )
+          CALL cpu_log( log_point_s(37), 'alltoall_node', 'continue' )
+#if defined( __parallel )
+          CALL MPI_ALLTOALL( work1(nxl_p,1,1,1,j), nw2, MPI_REAL, &
+                             work2(nxl_p,1,1,1,j), nw2, MPI_REAL, &
+                                                  comm_nodes, istat )
+#endif
+          CALL cpu_log( log_point_s(37), 'alltoall_node', 'stop' )
+
+       ENDDO
+
+       CALL cpu_log( log_point_s(32), 'alltoall_task', 'start' ) 
+       DO  nn = 1, nodes
+           DO  j = nys_p, nyn_p
+#if defined( __parallel )
+              CALL MPI_ALLTOALL( work2(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
+                                 work1(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
+                                                     comm_tasks, istat )
+#endif
+           ENDDO
+       ENDDO
+       CALL cpu_log( log_point_s(32), 'alltoall_task', 'stop' )
+
+       CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
+
+       DO  iouter = nxl_p, nxr_p, istride
+          iei = MIN( iouter+istride-1, nxr_p )
+          DO  k = 1, nz
+
+             m = nys_a
+             DO  nn = 1, nodes
+                DO  nt = 1, tasks_per_logical_node
+                   DO  j = nys_p, nyn_p
+                      DO  i = iouter, iei
+                         ir = i - iouter + 1
+                         ffty_ar(m,ir) = work1(i,k,nt,nn,j)
+                      ENDDO
+                      m = m+1
+                   ENDDO
+                ENDDO
+             ENDDO
+
+             DO  i = iouter, iei
+                ii = nxl + i
+                ir = i - iouter + 1
+                CALL fft_y( ffty_ar(:,ir), 'backward' )
+
+                DO  j = nys_a, nyn_a
+                   ar(k,j,ii) = ffty_ar(j,ir)
+                ENDDO
+             ENDDO
+
+          ENDDO
+       ENDDO
+
+       CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
+
+       CALL cpu_log( log_point_s(30), 'poisfft_hybrid_nodes', 'stop' )
+
+    END SUBROUTINE poisfft_hybrid_nodes
+
+
+
+    SUBROUTINE tridia_hybrid( j, ar, tri )
+
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k, nnyh
+       REAL, DIMENSION(0:nx,nz)       ::  ar
+       REAL, DIMENSION(0:nx,0:nz-1)   ::  ar1
+       REAL, DIMENSION(5,0:nx,0:nz-1) ::  tri
+
+       nnyh = (ny+1) / 2
+
+       tri = 0.0
+!
+!--    Define constant elements of the tridiagonal matrix.
+       DO  k = 0, nz-1
+          DO  i = 0,nx
+             tri(2,i,k) = ddzu(k+1) * ddzw(k+1)
+             tri(3,i,k) = ddzu(k+2) * ddzw(k+1)
+          ENDDO
+       ENDDO
+
+       IF ( j <= nnyh )  THEN
+          CALL maketri_hybrid( j )
+       ELSE
+          CALL maketri_hybrid( ny+1-j)
+       ENDIF
+       CALL zerleg_hybrid
+       CALL substi_hybrid( ar, tri )
+
+    CONTAINS
+
+       SUBROUTINE maketri_hybrid( j )
+
+!----------------------------------------------------------------------!
+!                         maketri                                      !
+!                                                                      !
+!       computes the i- and j-dependent component of the matrix        !
+!----------------------------------------------------------------------!
+
+          USE constants
+
+          IMPLICIT NONE
+
+          INTEGER ::  i, j, k, nnxh
+          REAL    ::  a, c
+
+          REAL, DIMENSION(0:nx) ::  l
+
+
+          nnxh = (nx+1) / 2
+!
+!--       Provide the tridiagonal matrix for solution of the Poisson equation
+!--       in Fourier space. The coefficients are computed following the method
+!--       of Schmidt et al. (DFVLR-Mitteilung 84-15) --> departs from Stephan
+!--       Siano's original version.
+          DO  i = 0,nx
+             IF ( i >= 0 .AND. i < nnxh ) THEN
+                l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / &
+                                        FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+                       2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+                                        FLOAT( ny+1 ) ) ) / ( dy * dy )
+             ELSEIF ( i == nnxh ) THEN
+                l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
+                                         FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+                       2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+                                         FLOAT(ny+1) ) ) / ( dy * dy )
+             ELSE
+                l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
+                                         FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+                       2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+                                         FLOAT( ny+1 ) ) ) / ( dy * dy )
+             ENDIF
+          ENDDO
+
+          DO  k = 0,nz-1
+             DO  i = 0, nx
+                a = -1.0 * ddzu(k+2) * ddzw(k+1)
+                c = -1.0 * ddzu(k+1) * ddzw(k+1)
+                tri(1,i,k) = a + c - l(i)
+             ENDDO
+          ENDDO
+          IF ( ibc_p_b == 1  .OR.  ibc_p_b == 2 )  THEN
+             DO  i = 0,nx
+                tri(1,i,0) = tri(1,i,0) + tri(2,i,0)
+             ENDDO
+          ENDIF
+          IF ( ibc_p_t == 1 )  THEN
+             DO  i = 0,nx
+                tri(1,i,nz-1) = tri(1,i,nz-1) + tri(3,i,nz-1)
+             ENDDO
+          ENDIF
+
+       END SUBROUTINE maketri_hybrid
+
+
+       SUBROUTINE zerleg_hybrid
+
+!----------------------------------------------------------------------!
+!                          zerleg                                      !
+!                                                                      !
+!       Splitting of the tridiagonal matrix (Thomas algorithm)         !
+!----------------------------------------------------------------------!
+
+          USE indices
+
+          IMPLICIT NONE
+
+          INTEGER ::  i, k
+
+!
+!--       Splitting
+          DO  i = 0, nx
+             tri(4,i,0) = tri(1,i,0)
+          ENDDO
+          DO  k = 1, nz-1
+             DO  i = 0,nx
+                tri(5,i,k) = tri(2,i,k) / tri(4,i,k-1)
+                tri(4,i,k) = tri(1,i,k) - tri(3,i,k-1) * tri(5,i,k)
+             ENDDO
+          ENDDO
+
+       END SUBROUTINE zerleg_hybrid
+
+       SUBROUTINE substi_hybrid( ar, tri )
+
+!----------------------------------------------------------------------!
+!                          substi                                      !
+!                                                                      !
+!       Substitution (Forward and Backward) (Thomas algorithm)         !
+!----------------------------------------------------------------------!
+
+          IMPLICIT NONE
+
+          INTEGER ::  i, j, k
+          REAL, DIMENSION(0:nx,nz)       ::  ar
+          REAL, DIMENSION(0:nx,0:nz-1)   ::  ar1
+          REAL, DIMENSION(5,0:nx,0:nz-1) ::  tri
+
+!
+!--       Forward substitution
+          DO  i = 0, nx
+             ar1(i,0) = ar(i,1)
+          ENDDO
+          DO  k = 1, nz - 1
+             DO  i = 0,nx
+                ar1(i,k) = ar(i,k+1) - tri(5,i,k) * ar1(i,k-1)
+             ENDDO
+          ENDDO
+
+!
+!--       Backward substitution
+          DO  i = 0,nx
+             ar(i,nz) = ar1(i,nz-1) / tri(4,i,nz-1)
+          ENDDO
+          DO  k = nz-2, 0, -1
+             DO  i = 0,nx
+                ar(i,k+1) = ( ar1(i,k) - tri(3,i,k) * ar(i,k+2) ) &
+                            / tri(4,i,k)
+             ENDDO
+          ENDDO
+
+       END SUBROUTINE substi_hybrid
+
+    END SUBROUTINE tridia_hybrid
+
+
+    SUBROUTINE cascade( loca, j, nys_p, nyn_p )
+
+       USE cpulog
+
+       IMPLICIT NONE
+
+       INTEGER ::  ier, j, loca, nyn_p, nys_p, req, reqa(1)
+       INTEGER, SAVE ::  tag = 10
+#if defined( __parallel )
+       INTEGER, DIMENSION(MPI_STATUS_SIZE) :: stat
+#endif
+
+       REAL ::  buf, buf1
+
+
+       buf  = 1.0
+       buf1 = 1.1
+       IF ( me_node == 0 )  THEN  ! first node only
+
+          SELECT CASE ( loca )
+
+             CASE ( 1 )  ! before alltoall
+
+                IF( me_task > 0 )  THEN  ! first task does not wait
+#if defined( __parallel )
+                   CALL MPI_SENDRECV( buf,  1, MPI_REAL, me_task-1, 0, &
+                                      buf1, 1, MPI_REAL, me_task-1, 0, &
+                                                 comm_tasks, stat,ierr )
+#endif
+                ELSEIF ( j > nys_p )  THEN
+                   req = 0
+                   tag = MOD( tag-10, 10 ) + 10
+#if defined( __parallel )
+                   CALL MPI_IRECV( buf, 1, MPI_REAL, tasks_per_logical_node-1,&
+                                   tag, comm_tasks, req, ierr )
+                   reqa = req
+                   CALL MPI_WAITALL( 1, reqa, stat, ierr )
+#endif
+                ENDIF
+
+             CASE ( 2 )  ! after alltoall
+
+                IF ( me_task < tasks_per_logical_node-1 )  THEN  ! last task
+#if defined( __parallel )
+                   CALL MPI_SENDRECV( buf,  1, MPI_REAL, me_task+1, 0, &
+                                      buf1, 1, MPI_REAL, me_task+1, 0, &
+                                                 comm_tasks, stat, ierr)
+#endif
+                ELSEIF ( j < nyn_p )  THEN
+                   req = 0
+                   tag = MOD( tag-10, 10 ) + 10
+#if defined( __parallel )
+                   CALL MPI_ISEND( buf, 1, MPI_REAL, 0, tag, comm_tasks, req, &
+                                   ierr )
+#endif
+                ENDIF
+
+          END SELECT
+
+       ENDIF
+
+    END SUBROUTINE cascade
+
+ END MODULE poisfft_hybrid_mod
Index: palm/trunk/SOURCE/poisfft_mod.f90
===================================================================
--- palm/trunk/SOURCE/poisfft_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,1480 +1,0 @@
-!> @file poisfft_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Formatting of OpenMP directives (J. Resler)
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! OMP bugfix
-!
-! 4649 2020-08-25 12:11:17Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4429 2020-02-27 15:24:30Z raasch
-! Statements added to avoid compile errors due to unused dummy arguments in serial mode
-!
-! 4366 2020-01-09 08:12:43Z raasch
-! Modification concerning NEC vectorizatio
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3690 2019-01-22 22:56:42Z knoop
-! OpenACC port for SPEC
-!
-! Revision 1.1  1997/07/24 11:24:14  raasch
-! Initial revision
-!
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Solves the Poisson equation with a 2D spectral method
-!>        d^2 p / dx^2 + d^2 p / dy^2 + d^2 p / dz^2 = s
-!>
-!> Input:
-!> real   ar   contains (nnz,nny,nnx) elements of the velocity divergence, starting from (1,nys,nxl)
-!>
-!> Output:
-!> real   ar   contains the solution for perturbation pressure p
-!--------------------------------------------------------------------------------------------------!
- MODULE poisfft_mod
-
-
-    USE fft_xy,                                                                                    &
-        ONLY:  fft_init,                                                                           &
-               fft_y,                                                                              &
-               fft_y_1d,                                                                           &
-               fft_y_m,                                                                            &
-               fft_x,                                                                              &
-               fft_x_1d,                                                                           &
-               fft_x_m,                                                                            &
-               temperton_fft_vec
-
-    USE indices,                                                                                   &
-        ONLY:  nnx,                                                                                &
-               nny,                                                                                &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxr,                                                                                &
-               ny,                                                                                 &
-               nys,                                                                                &
-               nyn,                                                                                &
-               nz
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_y,                                                                              &
-               nxl_z,                                                                              &
-               nxr_y,                                                                              &
-               nxr_z,                                                                              &
-               nys_x,                                                                              &
-               nys_z,                                                                              &
-               nyn_x,                                                                              &
-               nyn_z,                                                                              &
-               nzb_x,                                                                              &
-               nzb_y,                                                                              &
-               nzt_x,                                                                              &
-               nzt_y
-
-    USE tridia_solver,                                                                             &
-        ONLY:  tridia_1dd,                                                                         &
-               tridia_init,                                                                        &
-               tridia_substi,                                                                      &
-               tridia_substi_overlap
-
-    IMPLICIT NONE
-
-    LOGICAL, SAVE ::  poisfft_initialized = .FALSE.  !<
-
-    PRIVATE
-
-    PUBLIC  poisfft, poisfft_init
-
-    INTERFACE poisfft
-       MODULE PROCEDURE poisfft
-    END INTERFACE poisfft
-
-    INTERFACE poisfft_init
-       MODULE PROCEDURE poisfft_init
-    END INTERFACE poisfft_init
-
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Setup coefficients for FFT and the tridiagonal solver
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE poisfft_init
-
-    IMPLICIT NONE
-
-
-    CALL fft_init
-
-    CALL tridia_init
-
-    poisfft_initialized = .TRUE.
-
- END SUBROUTINE poisfft_init
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Two-dimensional Fourier Transformation in x- and y-direction.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE poisfft( ar )
-
-    USE control_parameters,                                                                        &
-        ONLY:  transpose_compute_overlap
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               cpu_log_nowait,                                                                     &
-               log_point_s
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ii           !<
-    INTEGER(iwp) ::  iind         !<
-    INTEGER(iwp) ::  inew         !<
-    INTEGER(iwp) ::  jj           !<
-    INTEGER(iwp) ::  jind         !<
-    INTEGER(iwp) ::  jnew         !<
-    INTEGER(iwp) ::  ki           !<
-    INTEGER(iwp) ::  kk           !<
-    INTEGER(iwp) ::  knew         !<
-    INTEGER(iwp) ::  n            !<
-    INTEGER(iwp) ::  nblk         !<
-    INTEGER(iwp) ::  nnx_y        !<
-    INTEGER(iwp) ::  nny_z        !<
-    INTEGER(iwp) ::  nnz_x        !<
-    INTEGER(iwp) ::  nxl_y_bound  !<
-    INTEGER(iwp) ::  nxr_y_bound  !<
-
-    INTEGER(iwp), DIMENSION(4) ::  isave  !<
-
-    REAL(wp), DIMENSION(1:nz,nys:nyn,nxl:nxr) ::  ar      !<
-    REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nz) ::  ar_inv  !<
-
-#define __acc_fft_device ( defined( _OPENACC ) && ( defined ( __cuda_fft ) ) )
-#if __acc_fft_device
-    !$ACC DECLARE CREATE(ar_inv)
-#endif
-
-    REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  ar1      !<
-    REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  f_in     !<
-    REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  f_inv    !<
-    REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  f_out_y  !<
-    REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  f_out_z  !<
-
-
-    CALL cpu_log( log_point_s(3), 'poisfft', 'start' )
-
-    IF ( .NOT. poisfft_initialized )  CALL poisfft_init
-
-#if !__acc_fft_device
-    !$ACC UPDATE HOST(ar)
-#endif
-
-#ifndef _OPENACC
-!
-!-- Two-dimensional Fourier Transformation in x- and y-direction.
-    IF ( pdims(2) == 1  .AND.  pdims(1) > 1 )  THEN
-
-!
-!--    1d-domain-decomposition along x:
-!--    FFT along y and transposition y --> x
-       CALL ffty_tr_yx( ar, ar )
-
-!
-!--    FFT along x, solving the tridiagonal system and backward FFT
-       CALL fftx_tri_fftx( ar )
-
-!
-!--    Transposition x --> y and backward FFT along y
-       CALL tr_xy_ffty( ar, ar )
-
-    ELSEIF ( pdims(1) == 1 .AND. pdims(2) > 1 )  THEN
-
-!
-!--    1d-domain-decomposition along y:
-!--    FFT along x and transposition x --> y
-       CALL fftx_tr_xy( ar, ar )
-
-!
-!--    FFT along y, solving the tridiagonal system and backward FFT
-       CALL ffty_tri_ffty( ar )
-
-!
-!--    Transposition y --> x and backward FFT along x
-       CALL tr_yx_fftx( ar, ar )
-
-    ELSEIF ( .NOT. transpose_compute_overlap )  THEN
-#endif
-
-!
-!--    2d-domain-decomposition or no decomposition (1 PE run)
-!--    Transposition z --> x
-       CALL cpu_log( log_point_s(5), 'transpo forward', 'start' )
-       CALL resort_for_zx( ar, ar_inv )
-       CALL transpose_zx( ar_inv, ar )
-       CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
-
-       CALL cpu_log( log_point_s(4), 'fft_x', 'start' )
-       IF ( temperton_fft_vec )  THEN
-!
-!--       Vector version outputs a transformed array ar_inv that does not require resorting
-!--       (which is done for ar further below)
-          CALL fft_x( ar, 'forward',  ar_inv=ar_inv)
-       ELSE
-          CALL fft_x( ar, 'forward')
-       ENDIF
-       CALL cpu_log( log_point_s(4), 'fft_x', 'pause' )
-
-!
-!--    Transposition x --> y
-       CALL cpu_log( log_point_s(5), 'transpo forward', 'continue' )
-       IF( .NOT. temperton_fft_vec )  CALL resort_for_xy( ar, ar_inv )
-       CALL transpose_xy( ar_inv, ar )
-       CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
-
-       CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
-       IF ( temperton_fft_vec )  THEN
-!
-!--       Input array ar_inv from fft_x can be directly used here.
-!--       The output (also in array ar_inv) does not require resorting below.
-          CALL fft_y( ar, 'forward', ar_inv = ar_inv, nxl_y_bound = nxl_y, nxr_y_bound = nxr_y,    &
-                      nxl_y_l = nxl_y, nxr_y_l = nxr_y )
-       ELSE
-          CALL fft_y( ar, 'forward', ar_tr = ar, nxl_y_bound = nxl_y, nxr_y_bound = nxr_y,         &
-                      nxl_y_l = nxl_y, nxr_y_l = nxr_y )
-       ENDIF
-       CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
-
-!
-!--    Transposition y --> z
-       CALL cpu_log( log_point_s(5), 'transpo forward', 'continue' )
-       IF ( .NOT. temperton_fft_vec )  CALL resort_for_yz( ar, ar_inv )
-       CALL transpose_yz( ar_inv, ar )
-       CALL cpu_log( log_point_s(5), 'transpo forward', 'stop' )
-
-!
-!--    Solve the tridiagonal equation system along z
-       CALL cpu_log( log_point_s(6), 'tridia', 'start' )
-       CALL tridia_substi( ar )
-       CALL cpu_log( log_point_s(6), 'tridia', 'stop' )
-
-!
-!--    Inverse Fourier Transformation
-!--    Transposition z --> y
-       CALL cpu_log( log_point_s(8), 'transpo invers', 'start' )
-       CALL transpose_zy( ar, ar_inv )
-!
-!--    The fft_y below (vector branch) can directly process ar_inv (i.e. does not require a
-!--    resorting)
-       IF ( .NOT. temperton_fft_vec )  CALL resort_for_zy( ar_inv, ar )
-       CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
-
-       CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
-       IF ( temperton_fft_vec )  THEN
-!
-!--       Output array ar_inv can be used as input to the below fft_x routine without resorting
-          CALL fft_y( ar, 'backward', ar_inv = ar_inv, nxl_y_bound = nxl_y, nxr_y_bound = nxr_y,   &
-                      nxl_y_l = nxl_y, nxr_y_l = nxr_y )
-       ELSE
-          CALL fft_y( ar, 'backward', ar_tr = ar, nxl_y_bound = nxl_y, nxr_y_bound = nxr_y,        &
-                      nxl_y_l = nxl_y, nxr_y_l = nxr_y )
-       ENDIF
-
-       CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
-
-!
-!--    Transposition y --> x
-       CALL cpu_log( log_point_s(8), 'transpo invers', 'continue' )
-       CALL transpose_yx( ar, ar_inv )
-       IF ( .NOT. temperton_fft_vec )  CALL resort_for_yx( ar_inv, ar )
-       CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
-
-       CALL cpu_log( log_point_s(4), 'fft_x', 'continue' )
-       IF ( temperton_fft_vec )  THEN
-          CALL fft_x( ar, 'backward',  ar_inv=ar_inv )
-       ELSE
-          CALL fft_x( ar, 'backward' )
-       ENDIF
-       CALL cpu_log( log_point_s(4), 'fft_x', 'stop' )
-
-!
-!--    Transposition x --> z
-       CALL cpu_log( log_point_s(8), 'transpo invers', 'continue' )
-       CALL transpose_xz( ar, ar_inv )
-       CALL resort_for_xz( ar_inv, ar )
-       CALL cpu_log( log_point_s(8), 'transpo invers', 'stop' )
-
-#ifndef _OPENACC
-    ELSE
-
-!
-!--    2d-domain-decomposition or no decomposition (1 PE run) with overlapping transposition / fft
-!--    cputime logging must not use barriers, which would prevent overlapping
-       ALLOCATE( f_out_y(0:ny,nxl_y:nxr_y,nzb_y:nzt_y), &
-                 f_out_z(0:nx,nys_x:nyn_x,nzb_x:nzt_x) )
-!
-!--    Transposition z --> x + subsequent fft along x
-       ALLOCATE( f_inv(nys:nyn,nxl:nxr,1:nz) )
-       CALL resort_for_zx( ar, f_inv )
-!
-!--    Save original indices and gridpoint counter
-       isave(1) = nz
-       isave(2) = nzb_x
-       isave(3) = nzt_x
-       isave(4) = sendrecvcount_zx
-!
-!--    Set new indices for transformation
-       nblk  = nz / pdims(1)
-       nz    = pdims(1)
-       nnz_x = 1
-       nzb_x = 1 + myidx * nnz_x
-       nzt_x = ( myidx + 1 ) * nnz_x
-       sendrecvcount_zx = nnx * nny * nnz_x
-
-       ALLOCATE( ar1(0:nx,nys_x:nyn_x,nzb_x:nzt_x) )
-       ALLOCATE( f_in(nys:nyn,nxl:nxr,1:nz) )
-
-       DO  kk = 1, nblk
-
-          IF ( kk == 1 )  THEN
-             CALL cpu_log( log_point_s(5), 'transpo forward', 'start', cpu_log_nowait )
-          ELSE
-             CALL cpu_log( log_point_s(5), 'transpo forward', 'continue', cpu_log_nowait )
-          ENDIF
-
-          DO  knew = 1, nz
-             ki = kk + nblk * ( knew - 1 )
-             f_in(:,:,knew) = f_inv(:,:,ki)
-          ENDDO
-
-          CALL transpose_zx( f_in, ar1(:,:,:))
-          CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
-
-          IF ( kk == 1 )  THEN
-             CALL cpu_log( log_point_s(4), 'fft_x', 'start', cpu_log_nowait )
-          ELSE
-             CALL cpu_log( log_point_s(4), 'fft_x', 'continue', cpu_log_nowait )
-          ENDIF
-
-          n = isave(2) + kk - 1
-          CALL fft_x( ar1(:,:,:), 'forward',  ar_2d = f_out_z(:,:,n) )
-          CALL cpu_log( log_point_s(4), 'fft_x', 'pause' )
-
-       ENDDO
-!
-!--    Restore original indices/counters
-       nz               = isave(1)
-       nzb_x            = isave(2)
-       nzt_x            = isave(3)
-       sendrecvcount_zx = isave(4)
-
-       DEALLOCATE( ar1, f_in, f_inv )
-
-!
-!--    Transposition x --> y + subsequent fft along y
-       ALLOCATE( f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) )
-       CALL resort_for_xy( f_out_z, f_inv )
-!
-!--    Save original indices and gridpoint counter
-       isave(1) = nx
-       isave(2) = nxl_y
-       isave(3) = nxr_y
-       isave(4) = sendrecvcount_xy
-!
-!--    Set new indices for transformation
-       nblk  = ( ( nx+1 ) / pdims(2) ) - 1
-       nx    = pdims(2)
-       nnx_y = 1
-       nxl_y = myidy * nnx_y
-       nxr_y = ( myidy + 1 ) * nnx_y - 1
-       sendrecvcount_xy = nnx_y * ( nyn_x-nys_x+1 ) * ( nzt_x-nzb_x+1 )
-
-       ALLOCATE( ar1(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) )
-       ALLOCATE( f_in(nys_x:nyn_x,nzb_x:nzt_x,0:nx) )
-
-       DO  ii = 0, nblk
-
-          CALL cpu_log( log_point_s(5), 'transpo forward', 'continue', cpu_log_nowait )
-
-          DO  inew = 0, nx-1
-             iind = ii + ( nblk + 1 ) * inew
-             f_in(:,:,inew) = f_inv(:,:,iind)
-          ENDDO
-
-          CALL transpose_xy( f_in, ar1(:,:,:) )
-
-          CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
-
-          IF ( ii == 1 )  THEN
-             CALL cpu_log( log_point_s(7), 'fft_y', 'start', cpu_log_nowait )
-          ELSE
-             CALL cpu_log( log_point_s(7), 'fft_y', 'continue', cpu_log_nowait )
-          ENDIF
-
-          nxl_y_bound = isave(2)
-          nxr_y_bound = isave(3)
-          n           = isave(2) + ii
-          CALL fft_y( ar1(:,:,:), 'forward', ar_tr = f_out_y, nxl_y_bound = nxl_y_bound,           &
-                      nxr_y_bound = nxr_y_bound, nxl_y_l = n, nxr_y_l = n )
-
-          CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
-
-       ENDDO
-!
-!--    Restore original indices/counters
-       nx               = isave(1)
-       nxl_y            = isave(2)
-       nxr_y            = isave(3)
-       sendrecvcount_xy = isave(4)
-
-       DEALLOCATE( ar1, f_in, f_inv )
-
-!
-!--    Transposition y --> z + subsequent tridia + resort for z --> y
-       ALLOCATE( f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) )
-       CALL resort_for_yz( f_out_y, f_inv )
-!
-!--    Save original indices and gridpoint counter
-       isave(1) = ny
-       isave(2) = nys_z
-       isave(3) = nyn_z
-       isave(4) = sendrecvcount_yz
-!
-!--    Set new indices for transformation
-       nblk             = ( ( ny+1 ) / pdims(1) ) - 1
-       ny               = pdims(1)
-       nny_z            = 1
-       nys_z            = myidx * nny_z
-       nyn_z            = ( myidx + 1 ) * nny_z - 1
-       sendrecvcount_yz = ( nxr_y-nxl_y+1 ) * nny_z * ( nzt_y-nzb_y+1 )
-
-       ALLOCATE( ar1(nxl_z:nxr_z,nys_z:nyn_z,1:nz) )
-       ALLOCATE( f_in(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) )
-
-       DO  jj = 0, nblk
-!
-!--       Forward Fourier Transformation
-!--       Transposition y --> z
-          CALL cpu_log( log_point_s(5), 'transpo forward', 'continue', cpu_log_nowait )
-
-          DO  jnew = 0, ny-1
-             jind = jj + ( nblk + 1 ) * jnew
-             f_in(:,:,jnew) = f_inv(:,:,jind)
-          ENDDO
-
-          CALL transpose_yz( f_in, ar1(:,:,:) )
-
-          IF ( jj == nblk )  THEN
-             CALL cpu_log( log_point_s(5), 'transpo forward', 'stop' )
-          ELSE
-             CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
-          ENDIF
-
-!
-!--       Solve the tridiagonal equation system along z
-          CALL cpu_log( log_point_s(6), 'tridia', 'start', cpu_log_nowait )
-
-          n = isave(2) + jj
-          CALL tridia_substi_overlap( ar1(:,:,:), n )
-
-          CALL cpu_log( log_point_s(6), 'tridia', 'stop' )
-
-!
-!--       Inverse Fourier Transformation
-!--       Transposition z --> y
-!--       Only one thread should call MPI routines, therefore forward and backward tranpose are in
-!--       the same section
-          IF ( jj == 0 )  THEN
-             CALL cpu_log( log_point_s(8), 'transpo invers', 'start', cpu_log_nowait )
-          ELSE
-             CALL cpu_log( log_point_s(8), 'transpo invers', 'continue', cpu_log_nowait )
-          ENDIF
-
-          CALL transpose_zy( ar1(:,:,:), f_in )
-
-          DO  jnew = 0, ny-1
-             jind = jj + ( nblk + 1 ) * jnew
-             f_inv(:,:,jind) = f_in(:,:,jnew)
-          ENDDO
-
-          CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
-
-       ENDDO
-!
-!--    Restore original indices/counters
-       ny               = isave(1)
-       nys_z            = isave(2)
-       nyn_z            = isave(3)
-       sendrecvcount_yz = isave(4)
-
-       CALL resort_for_zy( f_inv, f_out_y )
-
-       DEALLOCATE( ar1, f_in, f_inv )
-
-!
-!--    fft along y backward + subsequent transposition y --> x
-       ALLOCATE( f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) )
-!
-!--    Save original indices and gridpoint counter
-       isave(1) = nx
-       isave(2) = nxl_y
-       isave(3) = nxr_y
-       isave(4) = sendrecvcount_xy
-!
-!--    Set new indices for transformation
-       nblk             = ( ( nx+1 ) / pdims(2) ) - 1
-       nx               = pdims(2)
-       nnx_y            = 1
-       nxl_y            = myidy * nnx_y
-       nxr_y            = ( myidy + 1 ) * nnx_y - 1
-       sendrecvcount_xy = nnx_y * ( nyn_x-nys_x+1 ) * ( nzt_x-nzb_x+1 )
-
-       ALLOCATE( ar1(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) )
-       ALLOCATE( f_in(nys_x:nyn_x,nzb_x:nzt_x,0:nx) )
-
-       DO  ii = 0, nblk
-
-          CALL cpu_log( log_point_s(7), 'fft_y', 'continue', cpu_log_nowait )
-
-          n = isave(2) + ii
-          nxl_y_bound = isave(2)
-          nxr_y_bound = isave(3)
-
-          CALL fft_y( ar1(:,:,:), 'backward', ar_tr = f_out_y, nxl_y_bound = nxl_y_bound,          &
-                      nxr_y_bound = nxr_y_bound, nxl_y_l = n, nxr_y_l = n )
-
-          IF ( ii == nblk )  THEN
-             CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
-          ELSE
-             CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
-          ENDIF
-
-          CALL cpu_log( log_point_s(8), 'transpo invers', 'continue', cpu_log_nowait )
-
-          CALL transpose_yx( ar1(:,:,:), f_in )
-
-          DO  inew = 0, nx-1
-             iind = ii + (nblk+1) * inew
-             f_inv(:,:,iind) = f_in(:,:,inew)
-          ENDDO
-
-          CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
-
-       ENDDO
-!
-!--    Restore original indices/counters
-       nx               = isave(1)
-       nxl_y            = isave(2)
-       nxr_y            = isave(3)
-       sendrecvcount_xy = isave(4)
-
-       CALL resort_for_yx( f_inv, f_out_z )
-
-       DEALLOCATE( ar1, f_in, f_inv )
-
-!
-!--    fft along x backward + subsequent final transposition x --> z
-       ALLOCATE( f_inv(nys:nyn,nxl:nxr,1:nz) )
-!
-!--    Save original indices and gridpoint counter
-       isave(1) = nz
-       isave(2) = nzb_x
-       isave(3) = nzt_x
-       isave(4) = sendrecvcount_zx
-!
-!--    Set new indices for transformation
-       nblk             = nz / pdims(1)
-       nz               = pdims(1)
-       nnz_x            = 1
-       nzb_x            = 1 + myidx * nnz_x
-       nzt_x            = ( myidx + 1 ) * nnz_x
-       sendrecvcount_zx = nnx * nny * nnz_x
-
-       ALLOCATE( ar1(0:nx,nys_x:nyn_x,nzb_x:nzt_x) )
-       ALLOCATE( f_in(nys:nyn,nxl:nxr,1:nz) )
-
-       DO  kk = 1, nblk
-
-          CALL cpu_log( log_point_s(4), 'fft_x', 'continue', cpu_log_nowait )
-
-          n = isave(2) + kk - 1
-          CALL fft_x( ar1(:,:,:), 'backward', f_out_z(:,:,n) )
-
-          IF ( kk == nblk )  THEN
-             CALL cpu_log( log_point_s(4), 'fft_x', 'stop' )
-          ELSE
-             CALL cpu_log( log_point_s(4), 'fft_x', 'pause' )
-          ENDIF
-
-          CALL cpu_log( log_point_s(8), 'transpo invers', 'continue', cpu_log_nowait )
-
-          CALL transpose_xz( ar1(:,:,:), f_in )
-
-          DO  knew = 1, nz
-             ki = kk + nblk * ( knew - 1 )
-             f_inv(:,:,ki) = f_in(:,:,knew)
-          ENDDO
-
-          IF ( kk == nblk )  THEN
-             CALL cpu_log( log_point_s(8), 'transpo invers', 'stop' )
-          ELSE
-             CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
-          ENDIF
-
-       ENDDO
-!
-!--    Restore original indices/counters
-       nz               = isave(1)
-       nzb_x            = isave(2)
-       nzt_x            = isave(3)
-       sendrecvcount_zx = isave(4)
-
-       CALL resort_for_xz( f_inv, ar )
-
-       DEALLOCATE( ar1, f_in, f_inv )
-
-    ENDIF
-#endif
-
-#if !__acc_fft_device
-    !$ACC UPDATE DEVICE(ar)
-#endif
-
-    CALL cpu_log( log_point_s(3), 'poisfft', 'stop' )
-
- END SUBROUTINE poisfft
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Fourier-transformation along y with subsequent transposition y --> x for a 1d-decomposition
-!> along x.
-!>
-!> @attention The performance of this routine is much faster on the NEC-SX6, if the first index of
-!>            work_ffty_vec is odd. Otherwise memory bank conflicts may occur (especially if the
-!>            index is a multiple of 128). That's why work_ffty_vec is dimensioned as 0:ny+1.
-!>            Of course, this will not work if users are using an odd number of gridpoints along y.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ffty_tr_yx( f_in, f_out )
-
-    USE control_parameters,                                                                        &
-        ONLY:  loop_optimization
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !<
-    INTEGER(iwp) ::  iend    !<
-    INTEGER(iwp) ::  iouter  !<
-    INTEGER(iwp) ::  ir      !<
-    INTEGER(iwp) ::  j       !<
-    INTEGER(iwp) ::  k       !<
-
-    INTEGER(iwp), PARAMETER ::  stridex = 4  !<
-
-    REAL(wp), DIMENSION(1:nz,0:ny,nxl:nxr)             ::  f_in   !<
-    REAL(wp), DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) ::  f_out  !<
-    REAL(wp), DIMENSION(nxl:nxr,1:nz,0:ny)             ::  work   !<
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  work_ffty      !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  work_ffty_vec  !<
-
-!
-!-- Carry out the FFT along y, where all data are present due to the 1d-decomposition along x.
-!-- Resort the data in a way that x becomes the first index.
-    CALL cpu_log( log_point_s(7), 'fft_y_1d', 'start' )
-
-    IF ( loop_optimization == 'vector' )  THEN
-
-       ALLOCATE( work_ffty_vec(0:ny+1,1:nz,nxl:nxr) )
-!
-!--    Code optimized for vector processors
-       !$OMP PARALLEL PRIVATE ( i, j, k )
-       !$OMP DO
-       DO  i = nxl, nxr
-
-          DO  j = 0, ny
-             DO  k = 1, nz
-                work_ffty_vec(j,k,i) = f_in(k,j,i)
-             ENDDO
-          ENDDO
-
-          CALL fft_y_m( work_ffty_vec(:,:,i), ny+1, 'forward' )
-
-       ENDDO
-
-       !$OMP DO
-       DO  k = 1, nz
-          DO  j = 0, ny
-             DO  i = nxl, nxr
-                work(i,k,j) = work_ffty_vec(j,k,i)
-             ENDDO
-          ENDDO
-       ENDDO
-       !$OMP END PARALLEL
-
-       DEALLOCATE( work_ffty_vec )
-
-    ELSE
-!
-!--    Cache optimized code.
-       ALLOCATE( work_ffty(0:ny,stridex) )
-!
-!--    The i-(x-)direction is split into a strided outer loop and an inner loop for better cache
-!--    performance
-       !$OMP PARALLEL PRIVATE (i,iend,iouter,ir,j,k,work_ffty)
-       !$OMP DO
-       DO  iouter = nxl, nxr, stridex
-
-          iend = MIN( iouter+stridex-1, nxr )  ! Upper bound for inner i loop
-
-          DO  k = 1, nz
-
-             DO  i = iouter, iend
-
-                ir = i-iouter+1  ! Counter within a stride
-                DO  j = 0, ny
-                   work_ffty(j,ir) = f_in(k,j,i)
-                ENDDO
-!
-!--             FFT along y
-                CALL fft_y_1d( work_ffty(:,ir), 'forward' )
-
-             ENDDO
-
-!
-!--          Resort
-             DO  j = 0, ny
-                DO  i = iouter, iend
-                   work(i,k,j) = work_ffty(j,i-iouter+1)
-                ENDDO
-             ENDDO
-
-          ENDDO
-
-       ENDDO
-       !$OMP END PARALLEL
-
-       DEALLOCATE( work_ffty )
-
-    ENDIF
-
-    CALL cpu_log( log_point_s(7), 'fft_y_1d', 'pause' )
-
-!
-!-- Transpose array
-#if defined( __parallel )
-    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLTOALL( work(nxl,1,0), sendrecvcount_xy, MPI_REAL, f_out(1,1,nys_x,1),              &
-                       sendrecvcount_xy, MPI_REAL, comm1dx, ierr )
-    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
-#else
-!
-!-- Next line required to avoid compile error about unused dummy argument in serial mode
-    i = SIZE( f_out )
-#endif
-
- END SUBROUTINE ffty_tr_yx
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Transposition x --> y with a subsequent backward Fourier transformation for a 1d-decomposition
-!> along x
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tr_xy_ffty( f_in, f_out )
-
-    USE control_parameters,                                                                        &
-        ONLY:  loop_optimization
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !<
-    INTEGER(iwp) ::  iend    !<
-    INTEGER(iwp) ::  iouter  !<
-    INTEGER(iwp) ::  ir      !<
-    INTEGER(iwp) ::  j       !<
-    INTEGER(iwp) ::  k       !<
-
-    INTEGER(iwp), PARAMETER ::  stridex = 4  !<
-
-    REAL(wp), DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) ::  f_in   !<
-    REAL(wp), DIMENSION(1:nz,0:ny,nxl:nxr)             ::  f_out  !<
-    REAL(wp), DIMENSION(nxl:nxr,1:nz,0:ny)             ::  work   !<
-
-    REAL(wp), DIMENSION(:,:),   ALLOCATABLE ::  work_ffty      !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  work_ffty_vec  !<
-
-!
-!-- Transpose array
-#if defined( __parallel )
-    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLTOALL( f_in(1,1,nys_x,1), sendrecvcount_xy, MPI_REAL, work(nxl,1,0),               &
-                       sendrecvcount_xy, MPI_REAL, comm1dx, ierr )
-    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
-#else
-!
-!-- Next line required to avoid compile error about unused dummy argument in serial mode
-    i = SIZE( f_in )
-#endif
-
-!
-!-- Resort the data in a way that y becomes the first index and carry out the backward fft along y.
-    CALL cpu_log( log_point_s(7), 'fft_y_1d', 'continue' )
-
-    IF ( loop_optimization == 'vector' )  THEN
-
-       ALLOCATE( work_ffty_vec(0:ny+1,1:nz,nxl:nxr) )
-!
-!--    Code optimized for vector processors
-       !$OMP PARALLEL PRIVATE ( i, j, k )
-       !$OMP DO
-       DO  k = 1, nz
-          DO  j = 0, ny
-             DO  i = nxl, nxr
-                work_ffty_vec(j,k,i) = work(i,k,j)
-             ENDDO
-          ENDDO
-       ENDDO
-
-       !$OMP DO
-       DO  i = nxl, nxr
-
-          CALL fft_y_m( work_ffty_vec(:,:,i), ny+1, 'backward' )
-
-          DO  j = 0, ny
-             DO  k = 1, nz
-                f_out(k,j,i) = work_ffty_vec(j,k,i)
-             ENDDO
-          ENDDO
-
-       ENDDO
-       !$OMP END PARALLEL
-
-       DEALLOCATE( work_ffty_vec )
-
-    ELSE
-!
-!--    Cache optimized code.
-       ALLOCATE( work_ffty(0:ny,stridex) )
-!
-!--    The i-(x-)direction is split into a strided outer loop and an inner loop for better cache
-!--    performance
-       !$OMP PARALLEL PRIVATE ( i, iend, iouter, ir, j, k, work_ffty )
-       !$OMP DO
-       DO  iouter = nxl, nxr, stridex
-
-          iend = MIN( iouter+stridex-1, nxr )  ! Upper bound for inner i loop
-
-          DO  k = 1, nz
-!
-!--          Resort
-             DO  j = 0, ny
-                DO  i = iouter, iend
-                   work_ffty(j,i-iouter+1) = work(i,k,j)
-                ENDDO
-             ENDDO
-
-             DO  i = iouter, iend
-
-!
-!--             FFT along y
-                ir = i-iouter+1  ! Counter within a stride
-                CALL fft_y_1d( work_ffty(:,ir), 'backward' )
-
-                DO  j = 0, ny
-                   f_out(k,j,i) = work_ffty(j,ir)
-                ENDDO
-             ENDDO
-
-          ENDDO
-
-       ENDDO
-       !$OMP END PARALLEL
-
-       DEALLOCATE( work_ffty )
-
-    ENDIF
-
-    CALL cpu_log( log_point_s(7), 'fft_y_1d', 'stop' )
-
- END SUBROUTINE tr_xy_ffty
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> FFT along x, solution of the tridiagonal system and backward FFT for a 1d-decomposition along x
-!>
-!> @warning This subroutine may still not work for hybrid parallelization with OpenMP (for possible
-!>          necessary changes see the original routine poisfft_hybrid, developed by Klaus Ketelsen,
-!>          May 2002)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE fftx_tri_fftx( ar )
-
-    USE control_parameters,                                                                        &
-        ONLY:  loop_optimization
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2,                                                                               &
-               ddy2
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                   !<
-    INTEGER(iwp) ::  j                   !<
-    INTEGER(iwp) ::  k                   !<
-    INTEGER(iwp) ::  m                   !<
-    INTEGER(iwp) ::  n                   !<
-!$  INTEGER(iwp) ::  omp_get_thread_num  !<
-    INTEGER(iwp) ::  tn                  !<
-
-    REAL(wp), DIMENSION(0:nx)                          ::  work_fftx  !<
-    REAL(wp), DIMENSION(0:nx,1:nz)                     ::  work_trix  !<
-    REAL(wp), DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) ::  ar         !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE          ::  tri        !<
-
-
-    CALL cpu_log( log_point_s(33), 'fft_x_1d + tridia', 'start' )
-
-    ALLOCATE( tri(5,0:nx,0:nz-1,0:threads_per_task-1) )
-
-    tn = 0              ! Default thread number in case of one thread
-    !$OMP  PARALLEL DO PRIVATE ( i, j, k, m, n, tn, work_fftx, work_trix )
-    DO  j = nys_x, nyn_x
-
-!$     tn = omp_get_thread_num()
-
-       IF ( loop_optimization == 'vector' )  THEN
-!
-!--       Code optimized for vector processors
-          DO  k = 1, nz
-
-             m = 0
-             DO  n = 1, pdims(1)
-                DO  i = 1, nnx
-                   work_trix(m,k) = ar(i,k,j,n)
-                   m = m + 1
-                ENDDO
-             ENDDO
-
-          ENDDO
-
-          CALL fft_x_m( work_trix, 'forward' )
-
-       ELSE
-!
-!--       Cache optimized code
-          DO  k = 1, nz
-
-             m = 0
-             DO  n = 1, pdims(1)
-                DO  i = 1, nnx
-                   work_fftx(m) = ar(i,k,j,n)
-                   m = m + 1
-                ENDDO
-             ENDDO
-
-             CALL fft_x_1d( work_fftx, 'forward' )
-
-             DO  i = 0, nx
-                work_trix(i,k) = work_fftx(i)
-             ENDDO
-
-          ENDDO
-
-       ENDIF
-
-!
-!--    Solve the linear equation system
-       CALL tridia_1dd( ddx2, ddy2, nx, ny, j, work_trix, tri(:,:,:,tn) )
-
-       IF ( loop_optimization == 'vector' )  THEN
-!
-!--       Code optimized for vector processors
-          CALL fft_x_m( work_trix, 'backward' )
-
-          DO  k = 1, nz
-
-             m = 0
-             DO  n = 1, pdims(1)
-                DO  i = 1, nnx
-                   ar(i,k,j,n) = work_trix(m,k)
-                   m = m + 1
-                ENDDO
-             ENDDO
-
-          ENDDO
-
-       ELSE
-!
-!--       Cache optimized code
-          DO  k = 1, nz
-
-             DO  i = 0, nx
-                work_fftx(i) = work_trix(i,k)
-             ENDDO
-
-             CALL fft_x_1d( work_fftx, 'backward' )
-
-             m = 0
-             DO  n = 1, pdims(1)
-                DO  i = 1, nnx
-                   ar(i,k,j,n) = work_fftx(m)
-                   m = m + 1
-                ENDDO
-             ENDDO
-
-          ENDDO
-
-       ENDIF
-
-    ENDDO
-
-    DEALLOCATE( tri )
-
-    CALL cpu_log( log_point_s(33), 'fft_x_1d + tridia', 'stop' )
-
- END SUBROUTINE fftx_tri_fftx
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Fourier-transformation along x with subsequent transposition x --> y for a 1d-decomposition
-!> along y.
-!>
-!> @attention NEC-branch of this routine may significantly profit from further optimizations. So
-!>            far, performance is much worse than for routine ffty_tr_yx (more than three times
-!>            slower).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE fftx_tr_xy( f_in, f_out )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  loop_optimization
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp), DIMENSION(0:nx,1:nz,nys:nyn)             ::  work_fftx  !<
-    REAL(wp), DIMENSION(1:nz,nys:nyn,0:nx)             ::  f_in       !<
-    REAL(wp), DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) ::  f_out      !<
-    REAL(wp), DIMENSION(nys:nyn,1:nz,0:nx)             ::  work       !<
-
-!
-!--  Carry out the FFT along x, where all data are present due to the 1d-decomposition along y.
-!--  Resort the data in a way that y becomes the first index.
-     CALL cpu_log( log_point_s(4), 'fft_x_1d', 'start' )
-
-     IF ( loop_optimization == 'vector' )  THEN
-!
-!--    Code for vector processors
-       !$OMP  PARALLEL PRIVATE ( i, j, k )
-       !$OMP  DO
-       DO  i = 0, nx
-
-          DO  j = nys, nyn
-             DO  k = 1, nz
-                work_fftx(i,k,j) = f_in(k,j,i)
-             ENDDO
-          ENDDO
-
-       ENDDO
-
-       !$OMP  DO
-       DO  j = nys, nyn
-
-          CALL fft_x_m( work_fftx(:,:,j), 'forward' )
-
-          DO  k = 1, nz
-             DO  i = 0, nx
-                work(j,k,i) = work_fftx(i,k,j)
-             ENDDO
-          ENDDO
-
-       ENDDO
-       !$OMP  END PARALLEL
-
-    ELSE
-
-!
-!--    Cache optimized code (there might still be a potential for better optimization).
-       !$OMP  PARALLEL PRIVATE (i,j,k)
-       !$OMP  DO
-       DO  i = 0, nx
-
-          DO  j = nys, nyn
-             DO  k = 1, nz
-                work_fftx(i,k,j) = f_in(k,j,i)
-             ENDDO
-          ENDDO
-
-       ENDDO
-
-       !$OMP  DO
-       DO  j = nys, nyn
-          DO  k = 1, nz
-
-             CALL fft_x_1d( work_fftx(0:nx,k,j), 'forward' )
-
-             DO  i = 0, nx
-                work(j,k,i) = work_fftx(i,k,j)
-             ENDDO
-          ENDDO
-
-       ENDDO
-       !$OMP  END PARALLEL
-
-    ENDIF
-    CALL cpu_log( log_point_s(4), 'fft_x_1d', 'pause' )
-
-!
-!-- Transpose array
-#if defined( __parallel )
-    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLTOALL( work(nys,1,0), sendrecvcount_xy, MPI_REAL, f_out(1,1,nxl_y,1),              &
-                       sendrecvcount_xy, MPI_REAL, comm1dy, ierr )
-    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
-#else
-!
-!-- Next line required to avoid compile error about unused dummy argument in serial mode
-    i = SIZE( f_out )
-#endif
-
- END SUBROUTINE fftx_tr_xy
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Transposition y --> x with a subsequent backward Fourier transformation for a 1d-decomposition
-!> along x.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tr_yx_fftx( f_in, f_out )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  loop_optimization
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp), DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) ::  f_in       !<
-    REAL(wp), DIMENSION(1:nz,nys:nyn,0:nx)             ::  f_out      !<
-    REAL(wp), DIMENSION(nys:nyn,1:nz,0:nx)             ::  work       !<
-    REAL(wp), DIMENSION(0:nx,1:nz,nys:nyn)             ::  work_fftx  !<
-
-
-!
-!-- Transpose array
-#if defined( __parallel )
-    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLTOALL( f_in(1,1,nxl_y,1), sendrecvcount_xy, MPI_REAL, work(nys,1,0),               &
-                       sendrecvcount_xy, MPI_REAL, comm1dy, ierr )
-    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
-#else
-!
-!-- Next line required to avoid compile error about unused dummy argument in serial mode
-    i = SIZE( f_in )
-#endif
-
-!
-!-- Carry out the FFT along x, where all data are present due to the 1d-decomposition along y.
-!-- Resort the data in a way that y becomes the first index.
-    CALL cpu_log( log_point_s(4), 'fft_x_1d', 'continue' )
-
-    IF ( loop_optimization == 'vector' )  THEN
-!
-!--    Code optimized for vector processors
-!$OMP  PARALLEL PRIVATE ( i, j, k )
-!$OMP  DO
-       DO  j = nys, nyn
-
-          DO  k = 1, nz
-             DO  i = 0, nx
-                work_fftx(i,k,j) = work(j,k,i)
-             ENDDO
-          ENDDO
-
-          CALL fft_x_m( work_fftx(:,:,j), 'backward' )
-
-       ENDDO
-
-!$OMP  DO
-       DO  i = 0, nx
-          DO  j = nys, nyn
-             DO  k = 1, nz
-                f_out(k,j,i) = work_fftx(i,k,j)
-             ENDDO
-          ENDDO
-       ENDDO
-!$OMP  END PARALLEL
-
-    ELSE
-
-!
-!--    Cache optimized code (there might be still a potential for better optimization).
-!$OMP  PARALLEL PRIVATE (i,j,k)
-!$OMP  DO
-       DO  j = nys, nyn
-          DO  k = 1, nz
-
-             DO  i = 0, nx
-                work_fftx(i,k,j) = work(j,k,i)
-             ENDDO
-
-             CALL fft_x_1d( work_fftx(0:nx,k,j), 'backward' )
-
-          ENDDO
-       ENDDO
-
-!$OMP  DO
-       DO  i = 0, nx
-          DO  j = nys, nyn
-             DO  k = 1, nz
-                f_out(k,j,i) = work_fftx(i,k,j)
-             ENDDO
-          ENDDO
-       ENDDO
-!$OMP  END PARALLEL
-
-    ENDIF
-    CALL cpu_log( log_point_s(4), 'fft_x_1d', 'stop' )
-
- END SUBROUTINE tr_yx_fftx
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> FFT along y, solution of the tridiagonal system and backward FFT for a 1d-decomposition along y.
-!>
-!> @warning This subroutine may still not work for hybrid parallelization with OpenMP (for possible
-!>          necessary changes see the original routine poisfft_hybrid, developed by Klaus Ketelsen,
-!>          May 2002)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ffty_tri_ffty( ar )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  loop_optimization
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2,                                                                               &
-               ddy2
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                   !<
-    INTEGER(iwp) ::  j                   !<
-    INTEGER(iwp) ::  k                   !<
-    INTEGER(iwp) ::  m                   !<
-    INTEGER(iwp) ::  n                   !<
-!$  INTEGER(iwp) ::  omp_get_thread_num  !<
-    INTEGER(iwp) ::  tn                  !<
-
-    REAL(wp), DIMENSION(0:ny)                          ::  work_ffty  !<
-    REAL(wp), DIMENSION(0:ny,1:nz)                     ::  work_triy  !<
-    REAL(wp), DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) ::  ar         !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE          ::  tri        !<
-
-
-    CALL cpu_log( log_point_s(39), 'fft_y_1d + tridia', 'start' )
-
-    ALLOCATE( tri(5,0:ny,0:nz-1,0:threads_per_task-1) )
-
-    tn = 0           ! Default thread number in case of one thread
-!$OMP PARALLEL DO PRIVATE ( i, j, k, m, n, tn, work_ffty, work_triy )
-    DO  i = nxl_y, nxr_y
-
-!$     tn = omp_get_thread_num()
-
-       IF ( loop_optimization == 'vector' )  THEN
-!
-!--       Code optimized for vector processors
-          DO  k = 1, nz
-
-             m = 0
-             DO  n = 1, pdims(2)
-                DO  j = 1, nny
-                   work_triy(m,k) = ar(j,k,i,n)
-                   m = m + 1
-                ENDDO
-             ENDDO
-
-          ENDDO
-
-          CALL fft_y_m( work_triy, ny, 'forward' )
-
-       ELSE
-!
-!--       Cache optimized code
-          DO  k = 1, nz
-
-             m = 0
-             DO  n = 1, pdims(2)
-                DO  j = 1, nny
-                   work_ffty(m) = ar(j,k,i,n)
-                   m = m + 1
-                ENDDO
-             ENDDO
-
-             CALL fft_y_1d( work_ffty, 'forward' )
-
-             DO  j = 0, ny
-                work_triy(j,k) = work_ffty(j)
-             ENDDO
-
-          ENDDO
-
-       ENDIF
-
-!
-!--    Solve the linear equation system
-       CALL tridia_1dd( ddy2, ddx2, ny, nx, i, work_triy, tri(:,:,:,tn) )
-
-       IF ( loop_optimization == 'vector' )  THEN
-!
-!--       Code optimized for vector processors
-          CALL fft_y_m( work_triy, ny, 'backward' )
-
-          DO  k = 1, nz
-
-             m = 0
-             DO  n = 1, pdims(2)
-                DO  j = 1, nny
-                   ar(j,k,i,n) = work_triy(m,k)
-                   m = m + 1
-                ENDDO
-             ENDDO
-
-          ENDDO
-
-       ELSE
-!
-!--       Cache optimized code
-          DO  k = 1, nz
-
-             DO  j = 0, ny
-                work_ffty(j) = work_triy(j,k)
-             ENDDO
-
-             CALL fft_y_1d( work_ffty, 'backward' )
-
-             m = 0
-             DO  n = 1, pdims(2)
-                DO  j = 1, nny
-                   ar(j,k,i,n) = work_ffty(m)
-                   m = m + 1
-                ENDDO
-             ENDDO
-
-          ENDDO
-
-       ENDIF
-
-    ENDDO
-
-    DEALLOCATE( tri )
-
-    CALL cpu_log( log_point_s(39), 'fft_y_1d + tridia', 'stop' )
-
- END SUBROUTINE ffty_tri_ffty
-
- END MODULE poisfft_mod
Index: palm/trunk/SOURCE/poismg.f90
===================================================================
--- palm/trunk/SOURCE/poismg.f90	(revision 1)
+++ palm/trunk/SOURCE/poismg.f90	(revision 1)
@@ -0,0 +1,1113 @@
+ SUBROUTINE poismg( r )
+
+!------------------------------------------------------------------------------!
+! Attention: Loop unrolling and cache optimization in SOR-Red/Black method
+!            still does not bring the expected speedup on ibm! Further work
+!            is required.
+!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: poismg.f90,v $
+! Revision 1.6  2005/03/26 20:55:54  raasch
+! Implementation of non-cyclic (Neumann) horizontal boundary conditions,
+! routine prolong simplified (one call of exchange_horiz spared)
+!
+! Revision 1.5  2003/10/29 09:04:34  raasch
+! On a defined level, data are gathered on PE0 and further calculations are
+! carried out only on this PE.
+!
+! Revision 1.4  2003/03/16 09:45:57  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.3  2001/07/23 12:00:31  raasch
+! Neumann boundary conditions for the upper boundary and Diriclet conditions
+! for the lower boundary implemented
+!
+! Revision 1.2  2001/07/20 15:21:55  raasch
+! Praeprocessor directives included for allreduce
+!
+! Revision 1.1  2001/07/20 13:10:51  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Solves the Poisson equation for the perturbation pressure with a multigrid
+! V- or W-Cycle scheme.
+!
+! This multigrid method was originally developed for PALM by Joerg Uhlenbrock,
+! September 2000 - July 2001.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE cpulog    
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE pegrid
+
+    IMPLICIT NONE
+
+    REAL    ::  maxerror, maximum_mgcycles, residual_norm
+
+    REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ::  r
+
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  p3
+
+
+    CALL cpu_log( log_point_s(29), 'poismg', 'start' )
+
+
+!
+!-- Initialize arrays and variables used in this subroutine
+    ALLOCATE ( p3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+
+!
+!-- Some boundaries have to be added to divergence array
+    CALL exchange_horiz( d, 0, 0 )
+    d(nzb,:,:) = d(nzb+1,:,:)
+
+!
+!-- Initiation of the multigrid scheme. Does n cycles until the 
+!-- residual is smaller than the given limit. The accuracy of the solution 
+!-- of the poisson equation will increase with the number of cycles.
+!-- If the number of cycles is preset by the user, this number will be
+!-- carried out regardless of the accuracy.
+    grid_level_count =   0
+    mgcycles         =   0
+    IF ( mg_cycles == -1 )  THEN
+       maximum_mgcycles = 0
+       residual_norm    = 1.0 
+    ELSE
+       maximum_mgcycles = mg_cycles
+       residual_norm    = 0.0
+    ENDIF
+
+    DO WHILE ( residual_norm > residual_limit  .OR. &
+               mgcycles < maximum_mgcycles )
+
+       CALL next_mg_level( d, p, p3, r)
+        
+!
+!--    Calculate the residual if the user has not preset the number of
+!--    cycles to be performed
+       IF ( maximum_mgcycles == 0 )  THEN
+          CALL resid( d, p, r )
+          maxerror = SUM( r(nzb+1:nzt,nys:nyn,nxl:nxr)**2 )
+#if defined( __parallel )
+          CALL MPI_ALLREDUCE( maxerror, residual_norm, 1, MPI_REAL, MPI_SUM, &
+                              comm2d, ierr)
+#else
+          residual_norm = maxerror
+#endif
+          residual_norm = SQRT( residual_norm )
+       ENDIF
+
+       mgcycles = mgcycles + 1
+
+!
+!--    If the user has not limited the number of cycles, stop the run in case
+!--    of insufficient convergence
+       IF ( mgcycles > 1000  .AND.  mg_cycles == -1 )  THEN
+          IF ( myid == 0 )  THEN
+             PRINT*, '+++ poismg: no sufficient convergence within 1000 cycles'
+          ENDIF
+          CALL local_stop 
+       ENDIF
+
+    ENDDO
+
+    DEALLOCATE( p3 )
+
+    CALL cpu_log( log_point_s(29), 'poismg', 'stop' )
+
+ END SUBROUTINE poismg
+
+
+
+ SUBROUTINE resid( f_mg, p_mg, r )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Computes the residual of the perturbation pressure.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k, l
+
+    REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                                  &
+                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,                 &
+                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg, p_mg, r
+
+!
+!-- Calculate the residual
+    l = grid_level
+
+!$OMP PARALLEL PRIVATE (i,j,k)
+!$OMP DO
+    DO  i = nxl_mg(l), nxr_mg(l)
+       DO  j = nys_mg(l), nyn_mg(l) 
+          DO  k = nzb+1, nzt_mg(l)
+             r(k,j,i) = f_mg(k,j,i)                                      &
+                        - ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                        - ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                        - f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                        - f3_mg(k,l) * p_mg(k-1,j,i)                     &
+                        + f1_mg(k,l) * p_mg(k,j,i)
+          ENDDO
+       ENDDO
+    ENDDO
+!$OMP END PARALLEL
+
+!
+!-- Horizontal boundary conditions
+    CALL exchange_horiz( r, 0, 0 )
+
+    IF ( bc_lr /= 'cyclic' )  THEN
+       IF ( inflow_l .OR. outflow_l )  r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
+       IF ( inflow_r .OR. outflow_r )  r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
+    ENDIF
+
+    IF ( bc_ns /= 'cyclic' )  THEN
+       IF ( inflow_n .OR. outflow_n )  r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
+       IF ( inflow_s .OR. outflow_s )  r(:,nys_mg(l)-1,:) = r(:,nys_mg(l),:)
+    ENDIF
+
+!
+!-- Bottom and top boundary conditions
+    IF ( ibc_p_b == 1 )  THEN
+       r(nzb,:,: ) = r(nzb+1,:,:)
+    ELSE
+       r(nzb,:,: ) = 0.0
+    ENDIF
+
+    IF ( ibc_p_t == 1 )  THEN
+       r(nzt_mg(l)+1,:,: ) = r(nzt_mg(l),:,:)
+    ELSE
+       r(nzt_mg(l)+1,:,: ) = 0.0
+    ENDIF
+
+
+ END SUBROUTINE resid
+
+
+
+ SUBROUTINE restrict( f_mg, r )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Interpolates the residual on the next coarser grid with "full weighting"
+! scheme
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, ic, j, jc, k, kc, l
+
+    REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                            &
+                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,           &
+                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg
+
+    REAL, DIMENSION(nzb:nzt_mg(grid_level+1)+1,                          &
+                    nys_mg(grid_level+1)-1:nyn_mg(grid_level+1)+1,       &
+                    nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) ::  r
+
+!
+!-- Interpolate the residual
+    l = grid_level
+
+!$OMP PARALLEL PRIVATE (i,j,k,ic,jc,kc)
+!$OMP DO
+    DO  ic = nxl_mg(l), nxr_mg(l)    
+       i = 2*ic 
+       DO  jc = nys_mg(l), nyn_mg(l)  
+          j = 2*jc
+          DO  kc = nzb+1, nzt_mg(l)
+             k = 2*kc-1
+             f_mg(kc,jc,ic) = 1.0 / 64.0 * (                            &
+                              8.0 * r(k,j,i)                            &
+                            + 4.0 * ( r(k,j,i-1)     + r(k,j,i+1)     + &
+                                      r(k,j+1,i)     + r(k,j-1,i)     ) &
+                            + 2.0 * ( r(k,j-1,i-1)   + r(k,j+1,i-1)   + &
+                                      r(k,j-1,i+1)   + r(k,j+1,i+1)   ) &
+                            + 4.0 * r(k-1,j,i)                          &
+                            + 2.0 * ( r(k-1,j,i-1)   + r(k-1,j,i+1)   + &
+                                      r(k-1,j+1,i)   + r(k-1,j-1,i)   ) &
+                            +       ( r(k-1,j-1,i-1) + r(k-1,j+1,i-1) + &
+                                      r(k-1,j-1,i+1) + r(k-1,j+1,i+1) ) &
+                            + 4.0 * r(k+1,j,i)                          &
+                            + 2.0 * ( r(k+1,j,i-1)   + r(k+1,j,i+1)   + &
+                                      r(k+1,j+1,i)   + r(k+1,j-1,i)   ) &
+                            +       ( r(k+1,j-1,i-1) + r(k+1,j+1,i-1) + &
+                                      r(k+1,j-1,i+1) + r(k+1,j+1,i+1) ) &
+                                           ) 
+          ENDDO
+       ENDDO
+    ENDDO
+!$OMP END PARALLEL
+
+!
+!-- Horizontal boundary conditions
+    CALL exchange_horiz( f_mg, 0, 0 )
+
+    IF ( bc_lr /= 'cyclic' )  THEN
+       IF (inflow_l .OR. outflow_l)  f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
+       IF (inflow_r .OR. outflow_r)  f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
+    ENDIF
+
+    IF ( bc_ns /= 'cyclic' )  THEN
+       IF (inflow_n .OR. outflow_n)  f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
+       IF (inflow_s .OR. outflow_s)  f_mg(:,nys_mg(l)-1,:) = f_mg(:,nys_mg(l),:)
+    ENDIF
+
+!
+!-- Bottom and top boundary conditions
+    IF ( ibc_p_b == 1 )  THEN
+       f_mg(nzb,:,: ) = f_mg(nzb+1,:,:)
+    ELSE
+       f_mg(nzb,:,: ) = 0.0
+    ENDIF
+
+    IF ( ibc_p_t == 1 )  THEN
+       f_mg(nzt_mg(l)+1,:,: ) = f_mg(nzt_mg(l),:,:)
+    ELSE
+       f_mg(nzt_mg(l)+1,:,: ) = 0.0
+    ENDIF
+
+
+END SUBROUTINE restrict
+
+
+
+ SUBROUTINE prolong( p, temp )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Interpolates the correction of the perturbation pressure 
+! to the next finer grid.
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE pegrid
+    USE indices
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k, l
+
+    REAL, DIMENSION(nzb:nzt_mg(grid_level-1)+1,                           &
+                    nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,        &
+                    nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) ::  p
+
+    REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
+                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,          &
+                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  temp
+
+
+!
+!-- First, store elements of the coarser grid on the next finer grid
+    l = grid_level
+
+!$OMP PARALLEL PRIVATE (i,j,k)
+!$OMP DO
+    DO  i = nxl_mg(l-1), nxr_mg(l-1)
+       DO  j = nys_mg(l-1), nyn_mg(l-1)
+!CDIR NODEP
+          DO  k = nzb+1, nzt_mg(l-1)
+!
+!--          Points of the coarse grid are directly stored on the next finer
+!--          grid
+             temp(2*k-1,2*j,2*i) = p(k,j,i) 
+! 
+!--          Points between two coarse-grid points
+             temp(2*k-1,2*j,2*i+1) = 0.5 * ( p(k,j,i) + p(k,j,i+1) )
+             temp(2*k-1,2*j+1,2*i) = 0.5 * ( p(k,j,i) + p(k,j+1,i) )
+             temp(2*k,2*j,2*i)     = 0.5 * ( p(k,j,i) + p(k+1,j,i) )
+!
+!--          Points in the center of the planes stretched by four points
+!--          of the coarse grid cube
+             temp(2*k-1,2*j+1,2*i+1) = 0.25 * ( p(k,j,i)   + p(k,j,i+1) + &
+                                                p(k,j+1,i) + p(k,j+1,i+1) )
+             temp(2*k,2*j,2*i+1)     = 0.25 * ( p(k,j,i)   + p(k,j,i+1) + &
+                                                p(k+1,j,i) + p(k+1,j,i+1) )
+             temp(2*k,2*j+1,2*i)     = 0.25 * ( p(k,j,i)   + p(k,j+1,i) + &
+                                                p(k+1,j,i) + p(k+1,j+1,i) )
+!
+!--          Points in the middle of coarse grid cube
+             temp(2*k,2*j+1,2*i+1) = 0.125 * ( p(k,j,i)     + p(k,j,i+1)   + &
+                                               p(k,j+1,i)   + p(k,j+1,i+1) + &
+                                               p(k+1,j,i)   + p(k+1,j,i+1) + &
+                                               p(k+1,j+1,i) + p(k+1,j+1,i+1) )
+          ENDDO
+       ENDDO
+    ENDDO
+!$OMP END PARALLEL 
+                          
+!
+!-- Horizontal boundary conditions
+    CALL exchange_horiz( temp, 0, 0 )
+
+    IF ( bc_lr /= 'cyclic' )  THEN
+       IF (inflow_l .OR. outflow_l)  temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
+       IF (inflow_r .OR. outflow_r)  temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
+    ENDIF
+
+    IF ( bc_ns /= 'cyclic' )  THEN
+       IF (inflow_n .OR. outflow_n)  temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
+       IF (inflow_s .OR. outflow_s)  temp(:,nys_mg(l)-1,:) = temp(:,nys_mg(l),:)
+    ENDIF
+
+!
+!-- Bottom and top boundary conditions
+    IF ( ibc_p_b == 1 )  THEN
+       temp(nzb,:,: ) = temp(nzb+1,:,:)
+    ELSE
+       temp(nzb,:,: ) = 0.0
+    ENDIF
+
+    IF ( ibc_p_t == 1 )  THEN
+       temp(nzt_mg(l)+1,:,: ) = temp(nzt_mg(l),:,:)
+    ELSE
+       temp(nzt_mg(l)+1,:,: ) = 0.0
+    ENDIF
+
+  
+ END SUBROUTINE prolong
+
+
+ SUBROUTINE redblack( f_mg, p_mg )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Relaxation method for the multigrid scheme. A Gauss-Seidel iteration with
+! 3D-Red-Black decomposition (GS-RB) is used.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER :: colour, i, ic, j, jc, jj, k, l, n
+
+    LOGICAL :: unroll
+
+    REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                                 &
+                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,                &
+                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg, p_mg
+
+
+    l = grid_level
+
+    unroll = ( MOD( nyn_mg(l)-nys_mg(l)+1, 4 ) == 0  .AND. &
+               MOD( nxr_mg(l)-nxl_mg(l)+1, 2 ) == 0 )
+
+    DO  n = 1, ngsrb
+       
+       DO  colour = 1, 2
+
+          IF ( .NOT. unroll )  THEN
+             CALL cpu_log( log_point_s(36), 'redblack_no_unroll', 'start' )
+
+!
+!--          Without unrolling of loops, no cache optimization
+             DO  i = nxl_mg(l), nxr_mg(l), 2
+                DO  j = nys_mg(l) + 2 - colour, nyn_mg(l), 2 
+                   DO  k = nzb+1, nzt_mg(l), 2
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+                   ENDDO
+                ENDDO
+             ENDDO
+   
+             DO  i = nxl_mg(l)+1, nxr_mg(l), 2
+                DO  j = nys_mg(l) + (colour-1), nyn_mg(l), 2
+                   DO  k = nzb+1, nzt_mg(l), 2 
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+                   ENDDO
+                ENDDO
+             ENDDO
+  
+             DO  i = nxl_mg(l), nxr_mg(l), 2
+                DO  j = nys_mg(l) + (colour-1), nyn_mg(l), 2
+                   DO  k = nzb+2, nzt_mg(l), 2
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+                   ENDDO
+                ENDDO
+             ENDDO
+
+             DO  i = nxl_mg(l)+1, nxr_mg(l), 2
+                DO  j = nys_mg(l) + 2 - colour, nyn_mg(l), 2
+                   DO  k = nzb+2, nzt_mg(l), 2
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+                   ENDDO
+                ENDDO
+             ENDDO
+             CALL cpu_log( log_point_s(36), 'redblack_no_unroll', 'stop' )
+
+          ELSE
+
+!
+!--          Loop unrolling along y, only one i loop for better cache use
+             CALL cpu_log( log_point_s(38), 'redblack_unroll', 'start' )
+             DO  ic = nxl_mg(l), nxr_mg(l), 2
+                DO  jc = nys_mg(l), nyn_mg(l), 4
+                   i  = ic
+                   jj = jc+2-colour
+                   DO  k = nzb+1, nzt_mg(l), 2
+                      j = jj
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+                      j = jj+2
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+!                      j = jj+4
+!                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+!                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+!                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+!                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+!                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+!                                                    )
+!                      j = jj+6
+!                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+!                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+!                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+!                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+!                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+!                                                       )
+                   ENDDO
+   
+                   i  = ic+1
+                   jj = jc+colour-1
+                   DO  k = nzb+1, nzt_mg(l), 2 
+                      j =jj
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+                      j = jj+2
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+!                      j = jj+4
+!                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+!                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+!                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+!                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+!                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+!                                                       )
+!                      j = jj+6
+!                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+!                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+!                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+!                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+!                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+!                                                       )
+                   ENDDO
+
+                   i  = ic
+                   jj = jc+colour-1
+                   DO  k = nzb+2, nzt_mg(l), 2
+                      j =jj
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+                      j = jj+2
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+!                      j = jj+4
+!                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+!                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+!                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+!                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+!                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+!                                                       )
+!                      j = jj+6
+!                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+!                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+!                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+!                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+!                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+!                                                       )
+                   ENDDO
+
+                   i  = ic+1
+                   jj = jc+2-colour
+                   DO  k = nzb+2, nzt_mg(l), 2
+                      j =jj
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+                      j = jj+2
+                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+                                                       )
+!                      j = jj+4
+!                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+!                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+!                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+!                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+!                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+!                                                       )
+!                      j = jj+6
+!                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
+!                                ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+!                              + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+!                              + f2_mg(k,l) * p_mg(k+1,j,i)                     &
+!                              + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
+!                                                       )
+                   ENDDO
+
+                ENDDO
+             ENDDO
+             CALL cpu_log( log_point_s(38), 'redblack_unroll', 'stop' )
+
+          ENDIF
+
+!
+!--       Horizontal boundary conditions
+          CALL exchange_horiz( p_mg, 0, 0 )
+
+          IF ( bc_lr /= 'cyclic' )  THEN
+             IF ( inflow_l .OR. outflow_l )  THEN
+                p_mg(:,:,nxl_mg(l)-1) = p_mg(:,:,nxl_mg(l))
+             ENDIF
+             IF ( inflow_r .OR. outflow_r )  THEN
+                p_mg(:,:,nxr_mg(l)+1) = p_mg(:,:,nxr_mg(l))
+             ENDIF
+          ENDIF
+
+          IF ( bc_ns /= 'cyclic' )  THEN
+             IF ( inflow_n .OR. outflow_n )  THEN
+                p_mg(:,nyn_mg(l)+1,:) = p_mg(:,nyn_mg(l),:)
+             ENDIF
+             IF ( inflow_s .OR. outflow_s )  THEN
+                p_mg(:,nys_mg(l)-1,:) = p_mg(:,nys_mg(l),:)
+             ENDIF
+          ENDIF
+
+!
+!--       Bottom and top boundary conditions
+          IF ( ibc_p_b == 1 )  THEN
+             p_mg(nzb,:,: ) = p_mg(nzb+1,:,:)
+          ELSE
+             p_mg(nzb,:,: ) = 0.0
+          ENDIF
+
+          IF ( ibc_p_t == 1 )  THEN
+             p_mg(nzt_mg(l)+1,:,: ) = p_mg(nzt_mg(l),:,:)
+          ELSE
+             p_mg(nzt_mg(l)+1,:,: ) = 0.0
+          ENDIF
+
+       ENDDO
+
+    ENDDO
+
+
+ END SUBROUTINE redblack
+
+
+
+ SUBROUTINE mg_gather( f2, f2_sub )
+
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER ::  n, nwords, sender
+
+    REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                            &
+                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,           &
+                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f2
+
+    REAL, DIMENSION(nzb:mg_loc_ind(5,myid)+1,                            &
+                    mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,           &
+                    mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  f2_sub
+
+!
+!-- Find out the number of array elements of the subdomain array
+    nwords = SIZE( f2_sub )
+
+#if defined( __parallel )
+    CALL cpu_log( log_point_s(34), 'mg_gather', 'start' )
+
+    IF ( myid == 0 )  THEN
+!
+!--    Store the local subdomain array on the total array
+       f2(:,mg_loc_ind(3,0)-1:mg_loc_ind(4,0)+1, &
+            mg_loc_ind(1,0)-1:mg_loc_ind(2,0)+1) = f2_sub
+
+!
+!--    Receive the subdomain arrays from all other PEs and store them on the
+!--    total array
+       DO  n = 1, numprocs-1
+!
+!--       Receive the arrays in arbitrary order from the PEs.
+          CALL MPI_RECV( f2_sub(nzb,mg_loc_ind(3,0)-1,mg_loc_ind(1,0)-1),     &
+                         nwords, MPI_REAL, MPI_ANY_SOURCE, 1, comm2d, status, &
+                         ierr )
+          sender = status(MPI_SOURCE)
+          f2(:,mg_loc_ind(3,sender)-1:mg_loc_ind(4,sender)+1, &
+               mg_loc_ind(1,sender)-1:mg_loc_ind(2,sender)+1) = f2_sub
+       ENDDO
+
+    ELSE
+!
+!--    Send subdomain array to PE0
+       CALL MPI_SEND( f2_sub(nzb,mg_loc_ind(3,myid)-1,mg_loc_ind(1,myid)-1), &
+                      nwords, MPI_REAL, 0, 1, comm2d, ierr )
+    ENDIF
+
+    CALL cpu_log( log_point_s(34), 'mg_gather', 'stop' )
+#endif
+    
+ END SUBROUTINE mg_gather
+
+
+
+ SUBROUTINE mg_scatter( p2, p2_sub )
+!
+!-- TODO: It may be possible to improve the speed of this routine by using
+!-- non-blocking communication
+
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER ::  n, nwords, sender
+
+    REAL, DIMENSION(nzb:nzt_mg(grid_level-1)+1,                            &
+                    nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,         &
+                    nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  p2
+
+    REAL, DIMENSION(nzb:mg_loc_ind(5,myid)+1,                              &
+                    mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,             &
+                    mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  p2_sub
+
+!
+!-- Find out the number of array elements of the subdomain array
+    nwords = SIZE( p2_sub )
+
+#if defined( __parallel )
+    CALL cpu_log( log_point_s(35), 'mg_scatter', 'start' )
+
+    IF ( myid == 0 )  THEN
+!
+!--    Scatter the subdomain arrays to the other PEs by blocking
+!--    communication
+       DO  n = 1, numprocs-1
+
+          p2_sub = p2(:,mg_loc_ind(3,n)-1:mg_loc_ind(4,n)+1, &
+                        mg_loc_ind(1,n)-1:mg_loc_ind(2,n)+1)
+
+          CALL MPI_SEND( p2_sub(nzb,mg_loc_ind(3,0)-1,mg_loc_ind(1,0)-1), &
+                         nwords, MPI_REAL, n, 1, comm2d, ierr )
+
+       ENDDO
+
+!
+!--    Store data from the total array to the local subdomain array
+       p2_sub = p2(:,mg_loc_ind(3,0)-1:mg_loc_ind(4,0)+1, &
+                     mg_loc_ind(1,0)-1:mg_loc_ind(2,0)+1)
+
+    ELSE
+!
+!--    Receive subdomain array from PE0
+       CALL MPI_RECV( p2_sub(nzb,mg_loc_ind(3,myid)-1,mg_loc_ind(1,myid)-1), &
+                      nwords, MPI_REAL, 0, 1, comm2d, status, ierr )
+
+    ENDIF
+
+    CALL cpu_log( log_point_s(35), 'mg_scatter', 'stop' )
+#endif
+    
+ END SUBROUTINE mg_scatter
+
+
+
+ RECURSIVE SUBROUTINE next_mg_level( f_mg, p_mg, p3, r )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! This is where the multigrid technique takes place. V- and W- Cycle are
+! implemented and steered by the parameter "gamma". Parameter "nue" determines
+! the convergence of the multigrid iterative solution. There are nue times
+! RB-GS iterations. It should be set to "1" or "2", considering the time effort
+! one would like to invest. Last choice shows a very good converging factor,
+! but leads to an increase in computing time.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE grid_variables
+    USE indices
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k, nxl_mg_save, nxr_mg_save, nyn_mg_save, nys_mg_save, &
+                nzt_mg_save
+
+    LOGICAL ::  restore_boundary_lr_on_pe0, restore_boundary_ns_on_pe0
+
+    REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                                  &
+                 nys_mg(grid_level)-1:nyn_mg(grid_level)+1,                    &
+                 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg, p_mg, p3, r
+
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  f2, f2_sub, p2, p2_sub
+
+!
+!-- Restriction to the coarsest grid
+ 10 IF ( grid_level == 1 )  THEN
+
+!
+!--    Solution on the coarsest grid. Double the number of Gauss-Seidel
+!--    iterations in order to get a more accurate solution.
+       ngsrb = 2 * ngsrb
+       CALL redblack( f_mg, p_mg )
+       ngsrb = ngsrb / 2
+
+    ELSEIF ( grid_level /= 1 )  THEN
+
+       grid_level_count(grid_level) = grid_level_count(grid_level) + 1
+
+!
+!--    Solution on the actual grid level
+       CALL redblack( f_mg, p_mg )
+
+!
+!--    Determination of the actual residual
+       CALL resid( f_mg, p_mg, r )
+
+!
+!--    Restriction of the residual (finer grid values!) to the next coarser
+!--    grid. Therefore, the grid level has to be decremented now. nxl..nzt have
+!--    to be set to the coarse grid values, because these variables are needed
+!--    for the exchange of ghost points in routine exchange_horiz
+       grid_level = grid_level - 1
+       nxl = nxl_mg(grid_level)
+       nxr = nxr_mg(grid_level)
+       nys = nys_mg(grid_level)
+       nyn = nyn_mg(grid_level)
+       nzt = nzt_mg(grid_level)
+
+       ALLOCATE( f2(nzb:nzt_mg(grid_level)+1,                    &
+                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,   &
+                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1),  &
+                 p2(nzb:nzt_mg(grid_level)+1,                    &
+                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,   &
+                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) )
+
+       IF ( grid_level == mg_switch_to_pe0_level )  THEN
+!          print*, 'myid=',myid, ' restrict and switch to PE0. level=', grid_level
+!
+!--       From this level on, calculations are done on PE0 only.
+!--       First, carry out restriction on the subdomain.
+!--       Therefore, indices of the level have to be changed to subdomain values
+!--       in between (otherwise, the restrict routine would expect
+!--       the gathered array)
+          nxl_mg_save = nxl_mg(grid_level)
+          nxr_mg_save = nxr_mg(grid_level)
+          nys_mg_save = nys_mg(grid_level)
+          nyn_mg_save = nyn_mg(grid_level)
+          nzt_mg_save = nzt_mg(grid_level)
+          nxl_mg(grid_level) = mg_loc_ind(1,myid)
+          nxr_mg(grid_level) = mg_loc_ind(2,myid)
+          nys_mg(grid_level) = mg_loc_ind(3,myid)
+          nyn_mg(grid_level) = mg_loc_ind(4,myid)
+          nzt_mg(grid_level) = mg_loc_ind(5,myid)
+          nxl = mg_loc_ind(1,myid)
+          nxr = mg_loc_ind(2,myid)
+          nys = mg_loc_ind(3,myid)
+          nyn = mg_loc_ind(4,myid)
+          nzt = mg_loc_ind(5,myid)
+
+          ALLOCATE( f2_sub(nzb:nzt_mg(grid_level)+1,                    &
+                           nys_mg(grid_level)-1:nyn_mg(grid_level)+1,   &
+                           nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) )
+
+          CALL restrict( f2_sub, r )
+
+!
+!--       Restore the correct indices of this level
+          nxl_mg(grid_level) = nxl_mg_save
+          nxr_mg(grid_level) = nxr_mg_save
+          nys_mg(grid_level) = nys_mg_save
+          nyn_mg(grid_level) = nyn_mg_save
+          nzt_mg(grid_level) = nzt_mg_save
+          nxl = nxl_mg(grid_level)
+          nxr = nxr_mg(grid_level)
+          nys = nys_mg(grid_level)
+          nyn = nyn_mg(grid_level)
+          nzt = nzt_mg(grid_level)
+
+!
+!--       Gather all arrays from the subdomains on PE0
+          CALL mg_gather( f2, f2_sub )
+
+!
+!--       Set switch for routine exchange_horiz, that no ghostpoint exchange
+!--       has to be carried out from now on
+          mg_switch_to_pe0 = .TRUE.
+
+!
+!--       In case of non-cyclic lateral boundary conditions, both in- and
+!--       outflow conditions have to be used on PE0 after the switch, because
+!--       it then contains the total domain. Due to the virtual processor
+!--       grid, before the switch, PE0 can have in-/outflow at the left
+!--       and south wall only (or on opposite walls in case of a 1d
+!--       decomposition).
+          restore_boundary_lr_on_pe0 = .FALSE.
+          restore_boundary_ns_on_pe0 = .FALSE.
+          IF ( myid == 0 )  THEN
+             IF ( inflow_l  .AND.  .NOT. outflow_r )  THEN
+                outflow_r = .TRUE.
+                restore_boundary_lr_on_pe0 = .TRUE.
+             ENDIF
+             IF ( outflow_l  .AND.  .NOT. inflow_r )  THEN
+                inflow_r  = .TRUE.
+                restore_boundary_lr_on_pe0 = .TRUE.
+             ENDIF
+             IF ( inflow_s  .AND.  .NOT. outflow_n )  THEN
+                outflow_n = .TRUE.
+                restore_boundary_ns_on_pe0 = .TRUE.
+             ENDIF
+             IF ( outflow_s  .AND.  .NOT. inflow_n )  THEN
+                inflow_n  = .TRUE.
+                restore_boundary_ns_on_pe0 = .TRUE.
+             ENDIF
+          ENDIF
+
+          DEALLOCATE( f2_sub )
+
+       ELSE
+
+          CALL restrict( f2, r )
+
+       ENDIF
+       p2 = 0.0
+
+!
+!--    Repeat the same procedure till the coarsest grid is reached
+       IF ( myid == 0  .OR.  grid_level > mg_switch_to_pe0_level )  THEN
+          CALL next_mg_level( f2, p2, p3, r )
+       ENDIF
+
+    ENDIF
+
+!
+!-- Now follows the prolongation
+    IF ( grid_level >= 2 )  THEN
+
+!
+!--    Grid level has to be incremented on the PEs where next_mg_level
+!--    has not been called before (normally it is incremented at the end
+!--    of next_mg_level)
+       IF ( myid /= 0  .AND.  grid_level == mg_switch_to_pe0_level )  THEN
+          grid_level = grid_level + 1
+          nxl = nxl_mg(grid_level)
+          nxr = nxr_mg(grid_level)
+          nys = nys_mg(grid_level)
+          nyn = nyn_mg(grid_level)
+          nzt = nzt_mg(grid_level)
+       ENDIF
+
+!
+!--    Prolongation of the new residual. The values are transferred 
+!--    from the coarse to the next finer grid.
+       IF ( grid_level == mg_switch_to_pe0_level+1 )  THEN
+!
+!--       At this level, the new residual first has to be scattered from
+!--       PE0 to the other PEs
+          ALLOCATE( p2_sub(nzb:mg_loc_ind(5,myid)+1,             &
+                    mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,   &
+                    mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) )
+
+          CALL mg_scatter( p2, p2_sub )
+
+!
+!--       Therefore, indices of the previous level have to be changed to
+!--       subdomain values in between (otherwise, the prolong routine would
+!--       expect the gathered array)
+          nxl_mg_save = nxl_mg(grid_level-1)
+          nxr_mg_save = nxr_mg(grid_level-1)
+          nys_mg_save = nys_mg(grid_level-1)
+          nyn_mg_save = nyn_mg(grid_level-1)
+          nzt_mg_save = nzt_mg(grid_level-1)
+          nxl_mg(grid_level-1) = mg_loc_ind(1,myid)
+          nxr_mg(grid_level-1) = mg_loc_ind(2,myid)
+          nys_mg(grid_level-1) = mg_loc_ind(3,myid)
+          nyn_mg(grid_level-1) = mg_loc_ind(4,myid)
+          nzt_mg(grid_level-1) = mg_loc_ind(5,myid)
+
+!
+!--       Set switch for routine exchange_horiz, that ghostpoint exchange
+!--       has to be carried again out from now on
+          mg_switch_to_pe0 = .FALSE.
+
+!
+!--       In case of non-cyclic lateral boundary conditions, restore the
+!--       in-/outflow conditions on PE0
+          IF ( myid == 0 )  THEN
+             IF ( restore_boundary_lr_on_pe0 )  THEN
+                IF ( inflow_l  )  outflow_r = .FALSE.
+                IF ( outflow_l )  inflow_r  = .FALSE.
+             ENDIF
+             IF ( restore_boundary_ns_on_pe0 )  THEN
+                IF ( inflow_s  )  outflow_n = .FALSE.
+                IF ( outflow_s )  inflow_n  = .FALSE.
+             ENDIF
+          ENDIF
+
+          CALL prolong( p2_sub, p3 )
+
+!
+!--       Restore the correct indices of the previous level
+          nxl_mg(grid_level-1) = nxl_mg_save
+          nxr_mg(grid_level-1) = nxr_mg_save
+          nys_mg(grid_level-1) = nys_mg_save
+          nyn_mg(grid_level-1) = nyn_mg_save
+          nzt_mg(grid_level-1) = nzt_mg_save
+
+          DEALLOCATE( p2_sub )
+
+       ELSE
+
+          CALL prolong( p2, p3 )
+
+       ENDIF
+
+!
+!--    Temporary arrays for the actual grid are not needed any more
+       DEALLOCATE( p2, f2 )
+
+!
+!--    Computation of the new pressure correction. Therefore, 
+!--    values from prior grids are added up automatically stage by stage.
+       DO  i = nxl_mg(grid_level)-1, nxr_mg(grid_level)+1
+          DO  j = nys_mg(grid_level)-1, nyn_mg(grid_level)+1
+             DO  k = nzb, nzt_mg(grid_level)+1 
+                p_mg(k,j,i) = p_mg(k,j,i) + p3(k,j,i)
+             ENDDO
+          ENDDO
+       ENDDO
+
+!
+!--    Relaxation of the new solution
+       CALL redblack( f_mg, p_mg )
+
+    ENDIF
+
+!
+!-- The following few lines serve the steering of the multigrid scheme 
+    IF ( grid_level == maximum_grid_level )  THEN
+
+       GOTO 20
+
+    ELSEIF ( grid_level /= maximum_grid_level  .AND.  grid_level /= 1  .AND. &
+             grid_level_count(grid_level) /= gamma_mg )  THEN
+
+       GOTO 10
+
+    ENDIF
+
+!
+!-- Reset counter for the next call of poismg
+    grid_level_count(grid_level) = 0
+
+!
+!-- Continue with the next finer level. nxl..nzt have to be
+!-- set to the finer grid values, because these variables are needed for the
+!-- exchange of ghost points in routine exchange_horiz
+    grid_level = grid_level + 1
+    nxl = nxl_mg(grid_level)
+    nxr = nxr_mg(grid_level)
+    nys = nys_mg(grid_level)
+    nyn = nyn_mg(grid_level)
+    nzt = nzt_mg(grid_level)
+
+ 20 CONTINUE
+
+ END SUBROUTINE next_mg_level
Index: palm/trunk/SOURCE/poismg_mod.f90
===================================================================
--- palm/trunk/SOURCE/poismg_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2467 +1,0 @@
-!> @file poismg.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! bugfix in redblack algorithm: lower i,j indices need to start alternatively with even or odd
-! value on the coarsest grid level, if the subdomain has an uneven number of gridpoints along x/y
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! Use statement for exchange horiz added
-!
-! 4432 2020-02-28 07:43:21Z raasch
-! Bugfix for previous revision (vector directive was changed by mistake)
-!
-! 4429 2020-02-27 15:24:30Z raasch
-! Statement added to avoid compile error due to unused dummy argument
-! Bugfix: cpp-directives added for serial mode
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3725 2019-02-07 10:11:02Z raasch
-! Unused subroutine removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Unnecessary check eliminated
-!
-! Following optimisations have been made:
-! - Vectorisation (for Intel-CPUs) of the red-black algorithm by resorting array elements with even
-!   and odd indices
-! - Explicit boundary conditions for building walls removed (solver is running through the
-!   buildings)
-! - Reduced data transfer in case of ghost point exchange, because only "red" or "black" data points
-!   need to be exchanged. This is not applied for coarser grid levels, since for then the transfer
-!   time is latency bound
-!
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Solves the Poisson equation for the perturbation pressure with a multigrid V- or W-Cycle scheme.
-!>
-!> This multigrid method was originally developed for PALM by Joerg Uhlenbrock,
-!> September 2000 - July 2001. It has been optimised for speed by Klaus Ketelsen in November 2014.
-!>
-!> @attention Loop unrolling and cache optimization in SOR-Red/Black method still does not give the
-!             expected speedup!
-!>
-!> @todo Further work required.
-!--------------------------------------------------------------------------------------------------!
- MODULE poismg_mod
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               grid_level,                                                                         &
-               nesting_offline
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE kinds
-
-    USE pegrid
-
-    PRIVATE
-
-    INTEGER, SAVE                             ::  ind_even_odd    !< border index between even and odd k index
-
-    INTEGER, DIMENSION(:), SAVE, ALLOCATABLE  ::  even_odd_level  !< stores ind_even_odd for all MG levels
-
-    REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE ::  f1_mg_b, f2_mg_b, f3_mg_b  !< blocked version of f1_mg ...
-
-    INTERFACE poismg
-       MODULE PROCEDURE poismg
-    END INTERFACE poismg
-
-    INTERFACE sort_k_to_even_odd_blocks
-       MODULE PROCEDURE sort_k_to_even_odd_blocks
-!       MODULE PROCEDURE sort_k_to_even_odd_blocks_int
-       MODULE PROCEDURE sort_k_to_even_odd_blocks_1d
-    END INTERFACE sort_k_to_even_odd_blocks
-
-    PUBLIC poismg
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Solves the Poisson equation for the perturbation pressure with a multigrid V- or W-Cycle scheme.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE poismg( r )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  d,                                                                                  &
-               p_loc
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               gathered_size,                                                                      &
-               grid_level,                                                                         &
-               grid_level_count,                                                                   &
-               ibc_p_t,                                                                            &
-               maximum_grid_level,                                                                 &
-               message_string,                                                                     &
-               mgcycles,                                                                           &
-               mg_cycles,                                                                          &
-               mg_switch_to_pe0_level,                                                             &
-               residual_limit,                                                                     &
-               subdomain_size
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  nxl,                                                                                &
-               nxlg,                                                                               &
-               nxl_mg,                                                                             &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nxr_mg,                                                                             &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nys_mg,                                                                             &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  maxerror          !<
-    REAL(wp) ::  maximum_mgcycles  !<
-    REAL(wp) ::  residual_norm     !<
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ::  r  !<
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  p3  !<
-
-
-    CALL cpu_log( log_point_s(29), 'poismg', 'start' )
-!
-!-- Initialize arrays and variables used in this subroutine
-
-!-- If the number of grid points of the gathered grid, which is collected on PE0, is larger than the
-!-- number of grid points of a PE, than array p3 will be enlarged.
-    IF ( gathered_size > subdomain_size )  THEN
-       ALLOCATE( p3(nzb:nzt_mg(mg_switch_to_pe0_level)+1,nys_mg(                                   &
-                 mg_switch_to_pe0_level)-1:nyn_mg(mg_switch_to_pe0_level)+1,                       &
-                 nxl_mg(mg_switch_to_pe0_level)-1:nxr_mg(mg_switch_to_pe0_level)+1) )
-    ELSE
-       ALLOCATE ( p3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ENDIF
-
-    p3 = 0.0_wp
-
-
-!
-!-- Ghost boundaries have to be added to divergence array.
-!-- Exchange routine needs to know the grid level!
-    grid_level = maximum_grid_level
-    CALL exchange_horiz( d, 1)
-!
-!-- Set bottom and top boundary conditions
-    d(nzb,:,:) = d(nzb+1,:,:)
-    IF ( ibc_p_t == 1 )  d(nzt+1,:,: ) = d(nzt,:,:)
-!
-!-- Set lateral boundary conditions in non-cyclic case
-    IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  d(:,:,nxl-1) = d(:,:,nxl)
-       IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  d(:,:,nxr+1) = d(:,:,nxr)
-    ENDIF
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  d(:,nyn+1,:) = d(:,nyn,:)
-       IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  d(:,nys-1,:) = d(:,nys,:)
-    ENDIF
-!
-!-- Initiation of the multigrid scheme. Does n cycles until the residual is smaller than the given
-!-- limit. The accuracy of the solution of the poisson equation will increase with the number of
-!-- cycles. If the number of cycles is preset by the user, this number will be carried out
-!-- regardless of the accuracy.
-    grid_level_count =  0
-    mgcycles         =  0
-    IF ( mg_cycles == -1 )  THEN
-       maximum_mgcycles = 0
-       residual_norm    = 1.0_wp
-    ELSE
-       maximum_mgcycles = mg_cycles
-       residual_norm    = 0.0_wp
-    ENDIF
-
-!
-!-- Initial settings for sorting k-dimension from sequential order (alternate even/odd) into blocks
-!-- of even and odd or vice versa
-    CALL init_even_odd_blocks
-
-!
-!-- Sort input arrays in even/odd blocks along k-dimension
-    CALL sort_k_to_even_odd_blocks( d, grid_level )
-    CALL sort_k_to_even_odd_blocks( p_loc, grid_level )
-
-!
-!-- The complete multigrid cycles are running in block mode, i.e. over seperate data blocks of even
-!-- and odd indices
-    DO WHILE ( residual_norm > residual_limit  .OR.  mgcycles < maximum_mgcycles )
-
-       CALL next_mg_level( d, p_loc, p3, r)
-
-!
-!--    Calculate the residual if the user has not preset the number of cycles to be performed
-       IF ( maximum_mgcycles == 0 )  THEN
-          CALL resid( d, p_loc, r )
-          maxerror = SUM( r(nzb+1:nzt,nys:nyn,nxl:nxr)**2 )
-
-#if defined( __parallel )
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-             CALL MPI_ALLREDUCE( maxerror, residual_norm, 1, MPI_REAL, MPI_SUM, comm2d, ierr)
-#else
-             residual_norm = maxerror
-#endif
-          residual_norm = SQRT( residual_norm )
-       ENDIF
-
-       mgcycles = mgcycles + 1
-
-!
-!--    If the user has not limited the number of cycles, stop the run in case of insufficient
-!--    convergence
-       IF ( mgcycles > 1000  .AND.  mg_cycles == -1 )  THEN
-          message_string = 'no sufficient convergence within 1000 cycles'
-          CALL message( 'poismg', 'PA0283', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDDO
-
-    DEALLOCATE( p3 )
-!
-!-- Result has to be sorted back from even/odd blocks to sequential order
-    CALL sort_k_to_sequential( p_loc )
-!
-!-- Unset the grid level. Variable is used to determine the MPI datatypes for ghost point exchange
-    grid_level = 0
-
-    CALL cpu_log( log_point_s(29), 'poismg', 'stop' )
-
- END SUBROUTINE poismg
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computes the residual of the perturbation pressure.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE resid( f_mg, p_mg, r )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  rho_air_mg
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               ibc_p_b,                                                                            &
-               ibc_p_t
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2_mg,                                                                            &
-               ddy2_mg
-
-    USE indices,                                                                                   &
-        ONLY:  nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i    !< index variable along x
-    INTEGER(iwp) ::  j    !< index variable along y
-    INTEGER(iwp) ::  k    !< index variable along z
-    INTEGER(iwp) ::  l    !< index indicating grid level
-    INTEGER(iwp) ::  km1  !< index variable along z dimension (k-1)
-    INTEGER(iwp) ::  kp1  !< index variable along z dimension (k+1)
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !< velocity divergence
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !< perturbation pressure
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  r     !< residuum of perturbation pressure
-
-!
-!-- Calculate the residual
-    l = grid_level
-
-    CALL cpu_log( log_point_s(53), 'resid', 'start' )
-    !$OMP PARALLEL PRIVATE (i,j,k,km1,kp1)
-    !$OMP DO
-    DO  i = nxl_mg(l), nxr_mg(l)
-       DO  j = nys_mg(l), nyn_mg(l)
-             !DIR$ IVDEP
-          DO k = ind_even_odd+1, nzt_mg(l)
-             km1 = k-ind_even_odd-1
-             kp1 = k-ind_even_odd
-             r(k,j,i) = f_mg(k,j,i) - rho_air_mg(k,l) * ddx2_mg(l)                                 &
-                        * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                                        &
-                        - rho_air_mg(k,l) * ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )         &
-                        - f2_mg_b(k,l) * p_mg(kp1,j,i) - f3_mg_b(k,l) * p_mg(km1,j,i)              &
-                        + f1_mg_b(k,l) * p_mg(k,j,i)
-          ENDDO
-          !DIR$ IVDEP
-          DO k = nzb+1, ind_even_odd
-             km1 = k+ind_even_odd
-             kp1 = k+ind_even_odd+1
-             r(k,j,i) = f_mg(k,j,i) - rho_air_mg(k,l) * ddx2_mg(l)                                 &
-                        * ( p_mg(k,j,i+1) +  p_mg(k,j,i-1) ) - rho_air_mg(k,l) * ddy2_mg(l)        &
-                        * ( p_mg(k,j+1,i) +  p_mg(k,j-1,i) ) - f2_mg_b(k,l) * p_mg(kp1,j,i)        &
-                        - f3_mg_b(k,l) * p_mg(km1,j,i)       + f1_mg_b(k,l) * p_mg(k,j,i)
-          ENDDO
-       ENDDO
-    ENDDO
-    !$OMP END PARALLEL
-!
-!-- Horizontal boundary conditions
-    CALL exchange_horiz( r, 1)
-
-    IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-          r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
-       ENDIF
-       IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-          r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
-       ENDIF
-    ENDIF
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-          r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
-       ENDIF
-       IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-          r(:,nys_mg(l)-1,:) = r(:,nys_mg(l),:)
-       ENDIF
-    ENDIF
-
-!
-!-- Boundary conditions at bottom and top of the domain. Points may be within buildings, but that
-!-- doesn't matter.
-    IF ( ibc_p_b == 1 )  THEN
-!
-!--    Equivalent to r(nzb,:,: ) = r(nzb+1,:,:)
-       r(nzb,:,: ) = r(ind_even_odd+1,:,:)
-    ELSE
-       r(nzb,:,: ) = 0.0_wp
-    ENDIF
-
-    IF ( ibc_p_t == 1 )  THEN
-!
-!--    Equivalent to r(nzt_mg(l)+1,:,: ) = r(nzt_mg(l),:,:)
-       r(nzt_mg(l)+1,:,: ) = r(ind_even_odd,:,:)
-    ELSE
-       r(nzt_mg(l)+1,:,: ) = 0.0_wp
-    ENDIF
-
-    CALL cpu_log( log_point_s(53), 'resid', 'stop' )
-
- END SUBROUTINE resid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interpolates the residual on the next coarser grid with "full weighting" scheme
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE restrict( f_mg, r )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               ibc_p_b,                                                                            &
-               ibc_p_t
-
-    USE indices,                                                                                   &
-        ONLY:  nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i    !< index variable along x on finer grid
-    INTEGER(iwp) ::  ic   !< index variable along x on coarser grid
-    INTEGER(iwp) ::  j    !< index variable along y on finer grid
-    INTEGER(iwp) ::  jc   !< index variable along y on coarser grid
-    INTEGER(iwp) ::  k    !< index variable along z on finer grid
-    INTEGER(iwp) ::  kc   !< index variable along z on coarser grid
-    INTEGER(iwp) ::  l    !< index indicating finer grid level
-    INTEGER(iwp) ::  km1  !< index variable along z dimension (k-1 on finer level)
-    INTEGER(iwp) ::  kp1  !< index variable along z dimension (k+1 on finer level)
-
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !< Residual on coarser grid level
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level+1)+1,nys_mg(grid_level+1)-1:nyn_mg(grid_level+1)+1,  &
-                        nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) ::  r  !< Residual on finer grid level
-
-!
-!-- Interpolate the residual
-    l = grid_level
-
-    CALL cpu_log( log_point_s(54), 'restrict', 'start' )
-!
-!-- No wall treatment
-    !$OMP PARALLEL PRIVATE (i,j,k,ic,jc,kc,km1,kp1)
-    !$OMP DO SCHEDULE( STATIC )
-    DO  ic = nxl_mg(l), nxr_mg(l)
-       i = 2 * ic
-       DO  jc = nys_mg(l), nyn_mg(l)
-!
-!--       Calculation for the first point along k
-          j  = 2 * jc
-!
-!--       Calculation for the other points along k
-          !DIR$ IVDEP
-          DO  k = ind_even_odd+1, nzt_mg(l+1)    ! Fine grid at this point
-             km1 = k-ind_even_odd-1
-             kp1 = k-ind_even_odd
-             kc  = k-ind_even_odd               ! Coarse grid index
-
-             f_mg(kc,jc,ic) = 1.0_wp / 64.0_wp                                                     &
-                              * ( 8.0_wp * r(k,j,i) + 4.0_wp * ( r(k,j,i-1)     + r(k,j,i+1)       &
-                                                               + r(k,j+1,i)     + r(k,j-1,i)     ) &
-                                                    + 2.0_wp * ( r(k,j-1,i-1)   + r(k,j+1,i-1)     &
-                                                               + r(k,j-1,i+1)   + r(k,j+1,i+1)   ) &
-                                                    + 4.0_wp * r(km1,j,i)                          &
-                                                    + 2.0_wp * ( r(km1,j,i-1)   + r(km1,j,i+1)     &
-                                                               + r(km1,j+1,i)   + r(km1,j-1,i)   ) &
-                                                             + ( r(km1,j-1,i-1) + r(km1,j+1,i-1)   &
-                                                               + r(km1,j-1,i+1) + r(km1,j+1,i+1) ) &
-                                                    + 4.0_wp * r(kp1,j,i)                          &
-                                                    + 2.0_wp * ( r(kp1,j,i-1)   + r(kp1,j,i+1)     &
-                                                               + r(kp1,j+1,i)   + r(kp1,j-1,i)   ) &
-                                                             + ( r(kp1,j-1,i-1) + r(kp1,j+1,i-1)   &
-                                                               + r(kp1,j-1,i+1) + r(kp1,j+1,i+1) ) &
-                                )
-          ENDDO
-       ENDDO
-    ENDDO
-    !$OMP ENDDO
-    !$OMP END PARALLEL
-
-!
-!-- Ghost point exchange
-    CALL exchange_horiz( f_mg, 1)
-!
-!-- Horizontal boundary conditions
-    IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-          f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
-       ENDIF
-       IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-          f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
-       ENDIF
-    ENDIF
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-          f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
-       ENDIF
-       IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-          f_mg(:,nys_mg(l)-1,:) = f_mg(:,nys_mg(l),:)
-       ENDIF
-    ENDIF
-
-!
-!-- Boundary conditions at bottom and top of the domain. These points are not handled by the above
-!-- loop. Points may be within buildings, but that doesn't matter. Remark: f_mg is ordered
-!-- sequentielly after interpolation on coarse grid (is ordered in odd-even blocks further below).
-    IF ( ibc_p_b == 1 )  THEN
-       f_mg(nzb,:,: ) = f_mg(nzb+1,:,:)
-    ELSE
-       f_mg(nzb,:,: ) = 0.0_wp
-    ENDIF
-
-    IF ( ibc_p_t == 1 )  THEN
-       f_mg(nzt_mg(l)+1,:,: ) = f_mg(nzt_mg(l),:,:)
-    ELSE
-       f_mg(nzt_mg(l)+1,:,: ) = 0.0_wp
-    ENDIF
-
-    CALL cpu_log( log_point_s(54), 'restrict', 'stop' )
-!
-!-- Since residual is in sequential order after interpolation, an additional sorting in odd-even
-!-- blocks along z dimension is required at this point.
-    CALL sort_k_to_even_odd_blocks( f_mg , l)
-
- END SUBROUTINE restrict
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interpolates the correction of the perturbation pressure to the next finer grid.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE prolong( p, temp )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               ibc_p_b,                                                                            &
-               ibc_p_t
-    USE indices,                                                                                   &
-        ONLY:  nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i   !< index variable along x on coarser grid level
-    INTEGER(iwp) ::  j   !< index variable along y on coarser grid level
-    INTEGER(iwp) ::  k   !< index variable along z on coarser grid level
-    INTEGER(iwp) ::  l   !< index indicating finer grid level
-    INTEGER(iwp) ::  kp1 !< index variable along z
-    INTEGER(iwp) ::  ke  !< index for prolog even
-    INTEGER(iwp) ::  ko  !< index for prolog odd
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,  &
-                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) ::  p  !< perturbation pressure on coarser grid level
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  temp  !< perturbation pressure on finer grid level
-
-
-    CALL cpu_log( log_point_s(55), 'prolong', 'start' )
-
-!
-!-- First, store elements of the coarser grid on the next finer grid
-    l = grid_level
-    ind_even_odd = even_odd_level(grid_level-1)
-
-    !$OMP PARALLEL PRIVATE (i,j,k,kp1,ke,ko)
-    !$OMP DO
-    DO  i = nxl_mg(l-1), nxr_mg(l-1)
-       DO  j = nys_mg(l-1), nyn_mg(l-1)
-
-          !DIR$ IVDEP
-          DO  k = ind_even_odd+1, nzt_mg(l-1)
-             kp1 = k - ind_even_odd
-             ke  = 2 * ( k-ind_even_odd - 1 ) + 1
-             ko  = 2 * k - 1
-!
-!--          Points of the coarse grid are directly stored on the next finer grid
-             temp(ko,2*j,2*i)   = p(k,j,i)
-!
-!--          Points between two coarse-grid points
-             temp(ko,2*j,2*i+1) = 0.5_wp * ( p(k,j,i) + p(k,j,i+1) )
-             temp(ko,2*j+1,2*i) = 0.5_wp * ( p(k,j,i) + p(k,j+1,i) )
-             temp(ke,2*j,2*i)   = 0.5_wp * ( p(k,j,i) + p(kp1,j,i) )
-!
-!--          Points in the center of the planes stretched by four points of the coarse grid cube
-             temp(ko,2*j+1,2*i+1) = 0.25_wp * ( p(k,j,i)   + p(k,j,i+1) +                          &
-                                                p(k,j+1,i) + p(k,j+1,i+1) )
-             temp(ke,2*j,2*i+1)   = 0.25_wp * ( p(k,j,i)   + p(k,j,i+1) +                          &
-                                                p(kp1,j,i) + p(kp1,j,i+1) )
-             temp(ke,2*j+1,2*i)   = 0.25_wp * ( p(k,j,i)   + p(k,j+1,i) +                          &
-                                                p(kp1,j,i) + p(kp1,j+1,i) )
-!
-!--          Points in the middle of coarse grid cube
-             temp(ke,2*j+1,2*i+1) = 0.125_wp * ( p(k,j,i)     + p(k,j,i+1) + p(k,j+1,i)            &
-                                               + p(k,j+1,i+1) + p(kp1,j,i) + p(kp1,j,i+1)          &
-                                               + p(kp1,j+1,i) + p(kp1,j+1,i+1) )
-
-          ENDDO
-
-          !DIR$ IVDEP
-          DO  k = nzb+1, ind_even_odd
-             kp1 = k + ind_even_odd + 1
-             ke  = 2 * k
-             ko  = 2 * ( k + ind_even_odd )
-!
-!--          Points of the coarse grid are directly stored on the next finer grid
-             temp(ko,2*j,2*i)   = p(k,j,i)
-!
-!--          Points between two coarse-grid points
-             temp(ko,2*j,2*i+1) = 0.5_wp * ( p(k,j,i) + p(k,j,i+1) )
-             temp(ko,2*j+1,2*i) = 0.5_wp * ( p(k,j,i) + p(k,j+1,i) )
-             temp(ke,2*j,2*i)   = 0.5_wp * ( p(k,j,i) + p(kp1,j,i) )
-!
-!--          Points in the center of the planes stretched by four points
-!--          of the coarse grid cube
-             temp(ko,2*j+1,2*i+1) = 0.25_wp * ( p(k,j,i)   + p(k,j,i+1) +                          &
-                                                p(k,j+1,i) + p(k,j+1,i+1) )
-             temp(ke,2*j,2*i+1)   = 0.25_wp * ( p(k,j,i)   + p(k,j,i+1) +                          &
-                                                p(kp1,j,i) + p(kp1,j,i+1) )
-             temp(ke,2*j+1,2*i)   = 0.25_wp * ( p(k,j,i)   + p(k,j+1,i) +                          &
-                                                p(kp1,j,i) + p(kp1,j+1,i) )
-!
-!--          Points in the middle of coarse grid cube
-             temp(ke,2*j+1,2*i+1) = 0.125_wp * ( p(k,j,i)     + p(k,j,i+1) + p(k,j+1,i)            &
-                                               + p(k,j+1,i+1) + p(kp1,j,i) + p(kp1,j,i+1)          &
-                                               + p(kp1,j+1,i) + p(kp1,j+1,i+1) )
-
-          ENDDO
-
-       ENDDO
-    ENDDO
-    !$OMP END PARALLEL
-
-    ind_even_odd = even_odd_level(grid_level)
-!
-!-- Horizontal boundary conditions
-    CALL exchange_horiz( temp, 1)
-
-    IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-          temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
-       ENDIF
-       IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-          temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
-       ENDIF
-    ENDIF
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-          temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
-       ENDIF
-       IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-          temp(:,nys_mg(l)-1,:) = temp(:,nys_mg(l),:)
-       ENDIF
-    ENDIF
-
-!
-!-- Bottom and top boundary conditions
-    IF ( ibc_p_b == 1 )  THEN
-!
-!--    Equivalent to temp(nzb,:,: ) = temp(nzb+1,:,:)
-       temp(nzb,:,: ) = temp(ind_even_odd+1,:,:)
-    ELSE
-       temp(nzb,:,: ) = 0.0_wp
-    ENDIF
-
-    IF ( ibc_p_t == 1 )  THEN
-!
-!--    Equivalent to temp(nzt_mg(l)+1,:,: ) = temp(nzt_mg(l),:,:)
-       temp(nzt_mg(l)+1,:,: ) = temp(ind_even_odd,:,:)
-    ELSE
-       temp(nzt_mg(l)+1,:,: ) = 0.0_wp
-    ENDIF
-
-    CALL cpu_log( log_point_s(55), 'prolong', 'stop' )
-
- END SUBROUTINE prolong
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Relaxation method for the multigrid scheme. A Gauss-Seidel iteration with 3D-Red-Black
-!> decomposition (GS-RB) is used.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE redblack( f_mg, p_mg )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  rho_air_mg
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               ibc_p_b,                                                                            &
-               ibc_p_t,                                                                            &
-               ngsrb
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2_mg,                                                                            &
-               ddy2_mg
-
-    USE indices,                                                                                   &
-        ONLY:  nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  color  !< grid point color, either red or black
-    INTEGER(iwp) ::  i      !< index variable along x
-    INTEGER(iwp) ::  ic     !< index variable along x
-    INTEGER(iwp) ::  j      !< index variable along y
-    INTEGER(iwp) ::  jc     !< index variable along y
-    INTEGER(iwp) ::  jj     !< index variable along y
-    INTEGER(iwp) ::  k      !< index variable along z
-    INTEGER(iwp) ::  km1    !< index variable (k-1)
-    INTEGER(iwp) ::  kp1    !< index variable (k+1)
-    INTEGER(iwp) ::  l      !< grid level
-    INTEGER(iwp) ::  n      !< loop variable GauÃ-Seidel iterations
-    INTEGER(iwp) ::  save_nxl_mg  !< to save nxl_mg on coarsest level 1
-    INTEGER(iwp) ::  save_nys_mg  !< to save nys_mg on coarsest level 1
-
-
-    LOGICAL ::  adjust_lower_i_index  !< adjust lower limit of i loop in case of odd number of grid points
-    LOGICAL ::  adjust_lower_j_index  !< adjust lower limit of j loop in case of odd number of grid points
-    LOGICAL ::  unroll                !< flag indicating whether loop unrolling is possible
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !< residual of perturbation pressure
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !< perturbation pressure
-
-
-    l = grid_level
-
-    unroll = ( MOD( nyn_mg(l)-nys_mg(l)+1, 4 ) == 0  .AND.  MOD( nxr_mg(l)-nxl_mg(l)+1, 2 ) == 0 )
-
-!
-!-- The red/black decomposition requires that on the lower i,j indices need to start alternatively with an
-!-- even or odd value on the coarsest grid level, depending on the core-id, and if the subdomain has an
-!-- uneven number of gridpoints along x/y. Set the respective steering switches here.
-    IF ( l == 1  .AND.  MOD( myidx, 2 ) /= 0  .AND.  MOD( nxl_mg(l) - nxr_mg(l), 2 ) == 0 )  THEN
-       adjust_lower_i_index = .TRUE.
-       save_nxl_mg = nxl_mg(1)
-    ELSE
-       adjust_lower_i_index = .FALSE.
-    ENDIF
-    IF ( l == 1  .AND.  MOD( myidy, 2 ) /= 0  .AND.  MOD( nyn_mg(l) - nys_mg(l), 2 ) == 0 )  THEN
-       adjust_lower_j_index = .TRUE.
-       save_nys_mg = nys_mg(l)
-    ELSE
-       adjust_lower_j_index = .FALSE.
-    ENDIF
-
-
-    DO  n = 1, ngsrb
-
-       DO  color = 1, 2
-
-          IF ( .NOT. unroll )  THEN
-
-             CALL cpu_log( log_point_s(36), 'redblack_no_unroll_f', 'start' )
-
-             IF ( adjust_lower_i_index )  THEN
-                nxl_mg(l) = save_nxl_mg + 1
-             ENDIF
-
-             IF ( adjust_lower_j_index )  THEN
-                IF ( color == 1 )  THEN
-                  nys_mg(l) = save_nys_mg - 1
-                ELSE
-                  nys_mg(l) = save_nys_mg + 1
-                ENDIF
-             ENDIF
-!
-!--          Without unrolling of loops, no cache optimization
-             !$OMP PARALLEL PRIVATE (i,j,k,km1,kp1)
-             !$OMP DO
-             DO  i = nxl_mg(l), nxr_mg(l), 2
-                DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-                   !DIR$ IVDEP
-                   DO  k = ind_even_odd+1, nzt_mg(l)
-                      km1 = k-ind_even_odd-1
-                      kp1 = k-ind_even_odd
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l)                                          &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i) - f_mg(k,j,i)                   &
-                                       )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-             IF ( adjust_lower_i_index )  THEN
-                nxl_mg(l) = save_nxl_mg - 1
-             ENDIF
-
-             IF ( adjust_lower_j_index )  THEN
-                IF ( color == 1 )  THEN
-                  nys_mg(l) = save_nys_mg + 1
-                ELSE
-                  nys_mg(l) = save_nys_mg - 1
-                ENDIF
-             ENDIF
-
-             !$OMP DO
-             DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-                DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-                    !DIR$ IVDEP
-                    DO  k = ind_even_odd+1, nzt_mg(l)
-                      km1 = k-ind_even_odd-1
-                      kp1 = k-ind_even_odd
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-             IF ( adjust_lower_i_index )  THEN
-                nxl_mg(l) = save_nxl_mg + 1
-             ENDIF
-
-             IF ( adjust_lower_j_index )  THEN
-                IF ( color == 1 )  THEN
-                  nys_mg(l) = save_nys_mg + 1
-                ELSE
-                  nys_mg(l) = save_nys_mg - 1
-                ENDIF
-             ENDIF
-
-             !$OMP DO
-             DO  i = nxl_mg(l), nxr_mg(l), 2
-                DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-                   !DIR$ IVDEP
-                   DO  k = nzb+1, ind_even_odd
-                      km1 = k+ind_even_odd
-                      kp1 = k+ind_even_odd+1
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-             IF ( adjust_lower_i_index )  THEN
-                nxl_mg(l) = save_nxl_mg - 1
-             ENDIF
-
-             IF ( adjust_lower_j_index )  THEN
-                IF ( color == 1 )  THEN
-                  nys_mg(l) = save_nys_mg - 1
-                ELSE
-                  nys_mg(l) = save_nys_mg + 1
-                ENDIF
-             ENDIF
-
-             !$OMP DO
-             DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-                DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-                   !DIR$ IVDEP
-                   DO  k = nzb+1, ind_even_odd
-                      km1 = k+ind_even_odd
-                      kp1 = k+ind_even_odd+1
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-             CALL cpu_log( log_point_s(36), 'redblack_no_unroll_f', 'stop' )
-
-          ELSE
-!
-!--          Loop unrolling along y, only one i loop for better cache use
-             CALL cpu_log( log_point_s(38), 'redblack_unroll_f', 'start' )
-
-             !$OMP PARALLEL PRIVATE (i,j,k,ic,jc,km1,kp1,jj)
-             !$OMP DO
-             DO  ic = nxl_mg(l), nxr_mg(l), 2
-                DO  jc = nys_mg(l), nyn_mg(l), 4
-                   i  = ic
-                   jj = jc+2-color
-                   !DIR$ IVDEP
-                   DO  k = ind_even_odd+1, nzt_mg(l)
-                      km1 = k-ind_even_odd-1
-                      kp1 = k-ind_even_odd
-                      j   = jj
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-
-                      j = jj+2
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-                   ENDDO
-
-                   i  = ic+1
-                   jj = jc+color-1
-                   !DIR$ IVDEP
-                   DO  k = ind_even_odd+1, nzt_mg(l)
-                      km1 = k-ind_even_odd-1
-                      kp1 = k-ind_even_odd
-                      j   = jj
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-
-                      j = jj+2
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-                   ENDDO
-
-                   i  = ic
-                   jj = jc+color-1
-                   !DIR$ IVDEP
-                   DO  k = nzb+1, ind_even_odd
-                      km1 = k+ind_even_odd
-                      kp1 = k+ind_even_odd+1
-                      j   = jj
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-
-                      j = jj+2
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-                   ENDDO
-
-                   i  = ic+1
-                   jj = jc+2-color
-                   !DIR$ IVDEP
-                   DO  k = nzb+1, ind_even_odd
-                      km1 = k+ind_even_odd
-                      kp1 = k+ind_even_odd+1
-                      j   = jj
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-
-                      j = jj+2
-                      p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (                                      &
-                                      rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                                    ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )                              &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                    ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )                              &
-                                    + f2_mg_b(k,l) * p_mg(kp1,j,i)                                 &
-                                    + f3_mg_b(k,l) * p_mg(km1,j,i)                                 &
-                                    - f_mg(k,j,i)           )
-                   ENDDO
-
-                ENDDO
-             ENDDO
-             !$OMP END PARALLEL
-
-             CALL cpu_log( log_point_s(38), 'redblack_unroll_f', 'stop' )
-
-          ENDIF
-
-!
-!--       Horizontal boundary conditions
-          CALL special_exchange_horiz( p_mg, color )
-
-          IF ( .NOT. bc_lr_cyc )  THEN
-             IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-                p_mg(:,:,nxl_mg(l)-1) = p_mg(:,:,nxl_mg(l))
-             ENDIF
-             IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-                p_mg(:,:,nxr_mg(l)+1) = p_mg(:,:,nxr_mg(l))
-             ENDIF
-          ENDIF
-
-          IF ( .NOT. bc_ns_cyc )  THEN
-             IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-                p_mg(:,nyn_mg(l)+1,:) = p_mg(:,nyn_mg(l),:)
-             ENDIF
-             IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-                p_mg(:,nys_mg(l)-1,:) = p_mg(:,nys_mg(l),:)
-             ENDIF
-          ENDIF
-
-!
-!--       Bottom and top boundary conditions
-          IF ( ibc_p_b == 1 )  THEN
-!
-!--          Equivalent to p_mg(nzb,:,: ) = p_mg(nzb+1,:,:)
-             p_mg(nzb,:,: ) = p_mg(ind_even_odd+1,:,:)
-          ELSE
-             p_mg(nzb,:,: ) = 0.0_wp
-          ENDIF
-
-          IF ( ibc_p_t == 1 )  THEN
-!
-!--          Equivalent to p_mg(nzt_mg(l)+1,:,: ) = p_mg(nzt_mg(l),:,:)
-             p_mg(nzt_mg(l)+1,:,: ) = p_mg(ind_even_odd,:,:)
-          ELSE
-             p_mg(nzt_mg(l)+1,:,: ) = 0.0_wp
-          ENDIF
-
-       ENDDO
-
-    ENDDO
-
-!
-!-- Reset lower index limits to their standard values (may happen on coarsest levels only)
-    IF ( adjust_lower_i_index )  THEN
-       nxl_mg(l) = save_nxl_mg
-    ENDIF
-
-    IF ( adjust_lower_j_index )  THEN
-       nys_mg(l) = save_nys_mg
-    ENDIF
-
-
- END SUBROUTINE redblack
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sort k-dimension from sequential into blocks of even and odd. This is required to vectorize the
-!> red-black subroutine. Version for 3D-REAL arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sort_k_to_even_odd_blocks( p_mg , glevel )
-
-
-    USE indices,                                                                                   &
-        ONLY:  nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  glevel  !< grid level
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1,nys_mg(glevel)-1:nyn_mg(glevel)+1,                    &
-                        nxl_mg(glevel)-1:nxr_mg(glevel)+1) ::  p_mg  !< array to be sorted
-!
-!-- Local variables
-    INTEGER(iwp) ::  i    !< index variable along x
-    INTEGER(iwp) ::  ind  !< index variable along z
-    INTEGER(iwp) ::  j    !< index variable along y
-    INTEGER(iwp) ::  k    !< index variable along z
-    INTEGER(iwp) ::  l    !< grid level
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1) ::  tmp  !< odd-even sorted temporary array
-
-
-    CALL cpu_log( log_point_s(52), 'sort_k_to_even_odd', 'start' )
-
-    l = glevel
-    ind_even_odd = even_odd_level(l)
-
-    !$OMP PARALLEL PRIVATE (i,j,k,ind,tmp)
-    !$OMP DO
-    DO  i = nxl_mg(l)-1, nxr_mg(l)+1
-       DO  j = nys_mg(l)-1, nyn_mg(l)+1
-
-!
-!--       Sort the data with even k index
-          ind = nzb-1
-          DO  k = nzb, nzt_mg(l), 2
-             ind = ind + 1
-             tmp(ind) = p_mg(k,j,i)
-          ENDDO
-!
-!--       Sort the data with odd k index
-          DO  k = nzb+1, nzt_mg(l)+1, 2
-             ind = ind + 1
-             tmp(ind) = p_mg(k,j,i)
-          ENDDO
-
-          p_mg(:,j,i) = tmp
-
-       ENDDO
-    ENDDO
-    !$OMP END PARALLEL
-
-    CALL cpu_log( log_point_s(52), 'sort_k_to_even_odd', 'stop' )
-
- END SUBROUTINE sort_k_to_even_odd_blocks
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sort k-dimension from sequential into blocks of even and odd. This is required to vectorize the
-!> red-black subroutine. Version for 1D-REAL arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sort_k_to_even_odd_blocks_1d( f_mg, f_mg_b, glevel )
-
-
-    USE indices,                                                                                   &
-        ONLY:  nzb,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  glevel  !< grid level
-
-    REAL(wp), DIMENSION(nzb+1:nzt_mg(glevel)) ::  f_mg    !< 1D input array
-    REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1) ::  f_mg_b  !< 1D output array
-
-!
-!-- Local variables
-    INTEGER(iwp) ::  ind  !< index variable along z
-    INTEGER(iwp) ::  k    !< index variable along z
-
-
-    ind = nzb - 1
-!
-!-- Sort the data with even k index
-    DO  k = nzb, nzt_mg(glevel), 2
-       ind = ind + 1
-       IF ( k >= nzb+1  .AND.  k <= nzt_mg(glevel) )  THEN
-          f_mg_b(ind) = f_mg(k)
-       ENDIF
-    ENDDO
-!
-!-- Sort the data with odd k index
-    DO  k = nzb+1, nzt_mg(glevel)+1, 2
-       ind = ind + 1
-       IF( k >= nzb+1  .AND.  k <= nzt_mg(glevel) )  THEN
-          f_mg_b(ind) = f_mg(k)
-       ENDIF
-    ENDDO
-
- END SUBROUTINE sort_k_to_even_odd_blocks_1d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sort k-dimension from sequential into blocks of even and odd. This is required to vectorize the
-!> red-black subroutine. Version for 2D-INTEGER arrays
-!--------------------------------------------------------------------------------------------------!
-! SUBROUTINE sort_k_to_even_odd_blocks_int( i_mg , glevel )
-!
-!
-!    USE indices,                                                            &
-!        ONLY:  nxl_mg, nxr_mg, nys_mg, nyn_mg, nzb, nzt_mg
-!
-!    IMPLICIT NONE
-!
-!    INTEGER(iwp), INTENT(IN) ::  glevel  !< grid level
-!
-!    INTEGER(iwp), DIMENSION(nzb:nzt_mg(glevel)+1,                           &
-!                            nys_mg(glevel)-1:nyn_mg(glevel)+1,              &
-!                            nxl_mg(glevel)-1:nxr_mg(glevel)+1) ::           &
-!                                 i_mg    !< array to be sorted
-!!
-!!-- Local variables
-!    INTEGER(iwp) :: i        !< index variabel along x
-!    INTEGER(iwp) :: j        !< index variable along y
-!    INTEGER(iwp) :: k        !< index variable along z
-!    INTEGER(iwp) :: l        !< grid level
-!    INTEGER(iwp) :: ind      !< index variable along z
-!    INTEGER(iwp),DIMENSION(nzb:nzt_mg(glevel)+1) ::  tmp  !< temporary odd-even sorted array
-!
-!
-!    CALL cpu_log( log_point_s(52), 'sort_k_to_even_odd', 'start' )
-!
-!    l = glevel
-!    ind_even_odd = even_odd_level(l)
-!
-!    DO  i = nxl_mg(l)-1, nxr_mg(l)+1
-!       DO  j = nys_mg(l)-1, nyn_mg(l)+1
-!
-!
-!--       Sort the data with even k index
-!          ind = nzb-1
-!          DO  k = nzb, nzt_mg(l), 2
-!             ind = ind + 1
-!             tmp(ind) = i_mg(k,j,i)
-!          ENDDO
-!
-!--       Sort the data with odd k index
-!          DO  k = nzb+1, nzt_mg(l)+1, 2
-!             ind = ind + 1
-!             tmp(ind) = i_mg(k,j,i)
-!          ENDDO
-!
-!          i_mg(:,j,i) = tmp
-!
-!       ENDDO
-!    ENDDO
-!
-!    CALL cpu_log( log_point_s(52), 'sort_k_to_even_odd', 'stop' )
-!
-! END SUBROUTINE sort_k_to_even_odd_blocks_int
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sort k-dimension from blocks of even and odd into sequential
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sort_k_to_sequential( p_mg )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  grid_level
-
-    USE indices,                                                                                   &
-        ONLY:  nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !< array to be sorted
-!
-!-- Local variables
-    INTEGER(iwp) ::  i    !< index variable along x
-    INTEGER(iwp) ::  j    !< index variable along y
-    INTEGER(iwp) ::  k    !< index variable along z
-    INTEGER(iwp) ::  l    !< grid level
-    INTEGER(iwp) ::  ind  !< index variable along z
-
-    REAL(wp),DIMENSION(nzb:nzt_mg(grid_level)+1) ::  tmp  !<
-
-
-    l = grid_level
-
-    !$OMP PARALLEL PRIVATE (i,j,k,ind,tmp)
-    !$OMP DO
-    DO  i = nxl_mg(l)-1, nxr_mg(l)+1
-       DO  j = nys_mg(l)-1, nyn_mg(l)+1
-
-          ind = nzb - 1
-          tmp = p_mg(:,j,i)
-          DO  k = nzb, nzt_mg(l), 2
-             ind = ind + 1
-             p_mg(k,j,i) = tmp(ind)
-          ENDDO
-
-          DO  k = nzb+1, nzt_mg(l)+1, 2
-             ind = ind + 1
-             p_mg(k,j,i) = tmp(ind)
-          ENDDO
-       ENDDO
-    ENDDO
-    !$OMP END PARALLEL
-
- END SUBROUTINE sort_k_to_sequential
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Gather subdomain data from all PEs.
-!--------------------------------------------------------------------------------------------------!
-#if defined( __parallel )
- SUBROUTINE mg_gather( f2, f2_sub )
-
-    USE control_parameters,                                                                        &
-        ONLY:  grid_level
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  mg_loc_ind,                                                                         &
-               nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !<
-    INTEGER(iwp) ::  il      !<
-    INTEGER(iwp) ::  ir      !<
-    INTEGER(iwp) ::  j       !<
-    INTEGER(iwp) ::  jn      !<
-    INTEGER(iwp) ::  js      !<
-    INTEGER(iwp) ::  k       !<
-    INTEGER(iwp) ::  nwords  !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f2  !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f2_l  !<
-
-    REAL(wp), DIMENSION(nzb:mg_loc_ind(5,myid)+1,mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,        &
-                        mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  f2_sub  !<
-
-
-    CALL cpu_log( log_point_s(34), 'mg_gather', 'start' )
-
-    f2_l = 0.0_wp
-
-!
-!-- Store the local subdomain array on the total array
-    js = mg_loc_ind(3,myid)
-    IF ( south_border_pe )  js = js - 1
-    jn = mg_loc_ind(4,myid)
-    IF ( north_border_pe )  jn = jn + 1
-    il = mg_loc_ind(1,myid)
-    IF ( left_border_pe )   il = il - 1
-    ir = mg_loc_ind(2,myid)
-    IF ( right_border_pe )  ir = ir + 1
-    DO  i = il, ir
-       DO  j = js, jn
-          DO  k = nzb, nzt_mg(grid_level)+1
-             f2_l(k,j,i) = f2_sub(k,j,i)
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Find out the number of array elements of the total array
-    nwords = SIZE( f2 )
-
-!
-!-- Gather subdomain data from all PEs
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( f2_l(nzb,nys_mg(grid_level)-1,nxl_mg(grid_level)-1),                       &
-                        f2(nzb,nys_mg(grid_level)-1,nxl_mg(grid_level)-1), nwords, MPI_REAL,       &
-                        MPI_SUM, comm2d, ierr )
-
-    CALL cpu_log( log_point_s(34), 'mg_gather', 'stop' )
-
- END SUBROUTINE mg_gather
-#endif
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo It might be possible to improve the speed of this routine by using non-blocking
-!>       communication
-!--------------------------------------------------------------------------------------------------!
-#if defined( __parallel )
- SUBROUTINE mg_scatter( p2, p2_sub )
-
-    USE control_parameters,                                                                        &
-        ONLY:  grid_level
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  mg_loc_ind,                                                                         &
-               nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,  &
-                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  p2  !<
-
-    REAL(wp), DIMENSION(nzb:mg_loc_ind(5,myid)+1,mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,        &
-                        mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  p2_sub  !<
-
-
-    CALL cpu_log( log_point_s(35), 'mg_scatter', 'start' )
-
-    p2_sub = p2(:,mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,                                       &
-                  mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1)
-
-    CALL cpu_log( log_point_s(35), 'mg_scatter', 'stop' )
-
- END SUBROUTINE mg_scatter
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This is where the multigrid technique takes place. V- and W- Cycle are implemented and steered by
-!> the parameter "gamma". Parameter "nue" determines the convergence of the multigrid iterative
-!> solution. There are nue times RB-GS iterations. It should be set to "1" or "2", considering the
-!> time effort one would like to invest. Last choice shows a very good converging factor, but leads
-!> to an increase in computing time.
-!--------------------------------------------------------------------------------------------------!
- RECURSIVE SUBROUTINE next_mg_level( f_mg, p_mg, p3, r )
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_dirrad,                                                                       &
-               bc_lr_raddir,                                                                       &
-               bc_ns_dirrad,                                                                       &
-               bc_ns_raddir,                                                                       &
-               child_domain,                                                                       &
-               gamma_mg,                                                                           &
-               grid_level_count,                                                                   &
-               maximum_grid_level,                                                                 &
-               mg_switch_to_pe0_level,                                                             &
-               mg_switch_to_pe0,                                                                   &
-               ngsrb
-
-    USE indices,                                                                                   &
-        ONLY:  mg_loc_ind,                                                                         &
-               nxl,                                                                                &
-               nxl_mg,                                                                             &
-               nxr,                                                                                &
-               nxr_mg,                                                                             &
-               nys,                                                                                &
-               nys_mg,                                                                             &
-               nyn,                                                                                &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i            !< index variable along x
-    INTEGER(iwp) ::  j            !< index variable along y
-    INTEGER(iwp) ::  k            !< index variable along z
-    INTEGER(iwp) ::  nxl_mg_save  !<
-    INTEGER(iwp) ::  nxr_mg_save  !<
-    INTEGER(iwp) ::  nyn_mg_save  !<
-    INTEGER(iwp) ::  nys_mg_save  !<
-    INTEGER(iwp) ::  nzt_mg_save  !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg  !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg  !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p3    !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r     !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,  &
-                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  f2  !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,  &
-                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  p2  !<
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  f2_sub  !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  p2_sub  !<
-#endif
-
-!
-!-- Restriction to the coarsest grid
- 10 IF ( grid_level == 1 )  THEN
-
-!
-!--    Solution on the coarsest grid. Double the number of Gauss-Seidel iterations in order to get a
-!--    more accurate solution.
-       ngsrb = 2 * ngsrb
-
-       ind_even_odd = even_odd_level(grid_level)
-
-       CALL redblack( f_mg, p_mg )
-
-       ngsrb = ngsrb / 2
-
-
-    ELSEIF ( grid_level /= 1 )  THEN
-
-       grid_level_count(grid_level) = grid_level_count(grid_level) + 1
-
-!
-!--    Solution on the actual grid level
-       ind_even_odd = even_odd_level(grid_level)
-
-       CALL redblack( f_mg, p_mg )
-
-!
-!--    Determination of the actual residual
-       CALL resid( f_mg, p_mg, r )
-
-!--    Restriction of the residual (finer grid values!) to the next coarser grid. Therefore, the
-!--    grid level has to be decremented now. nxl..nzt have to be set to the coarse grid values,
-!--    because these variables are needed for the exchange of ghost points in routine exchange_horiz
-       grid_level = grid_level - 1
-
-       nxl = nxl_mg(grid_level)
-       nys = nys_mg(grid_level)
-       nxr = nxr_mg(grid_level)
-       nyn = nyn_mg(grid_level)
-       nzt = nzt_mg(grid_level)
-
-       IF ( grid_level == mg_switch_to_pe0_level )  THEN
-
-!
-!--       From this level on, calculations are done on PE0 only. First, carry out restriction on the
-!--       subdomain. Therefore, indices of the level have to be changed to subdomain values in
-!--       between (otherwise, the restrict routine would expect the gathered array).
-
-          nxl_mg_save = nxl_mg(grid_level)
-          nxr_mg_save = nxr_mg(grid_level)
-          nys_mg_save = nys_mg(grid_level)
-          nyn_mg_save = nyn_mg(grid_level)
-          nzt_mg_save = nzt_mg(grid_level)
-          nxl_mg(grid_level) = mg_loc_ind(1,myid)
-          nxr_mg(grid_level) = mg_loc_ind(2,myid)
-          nys_mg(grid_level) = mg_loc_ind(3,myid)
-          nyn_mg(grid_level) = mg_loc_ind(4,myid)
-          nzt_mg(grid_level) = mg_loc_ind(5,myid)
-          nxl = mg_loc_ind(1,myid)
-          nxr = mg_loc_ind(2,myid)
-          nys = mg_loc_ind(3,myid)
-          nyn = mg_loc_ind(4,myid)
-          nzt = mg_loc_ind(5,myid)
-
-          ALLOCATE( f2_sub(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,     &
-                           nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) )
-
-          CALL restrict( f2_sub, r )
-
-!
-!--       Restore the correct indices of this level
-          nxl_mg(grid_level) = nxl_mg_save
-          nxr_mg(grid_level) = nxr_mg_save
-          nys_mg(grid_level) = nys_mg_save
-          nyn_mg(grid_level) = nyn_mg_save
-          nzt_mg(grid_level) = nzt_mg_save
-          nxl = nxl_mg(grid_level)
-          nxr = nxr_mg(grid_level)
-          nys = nys_mg(grid_level)
-          nyn = nyn_mg(grid_level)
-          nzt = nzt_mg(grid_level)
-!
-!--       Gather all arrays from the subdomains on PE0
-#if defined( __parallel )
-          CALL mg_gather( f2, f2_sub )
-#endif
-
-!
-!--       Set switch for routine exchange_horiz, that no ghostpoint exchange has to be carried out
-!--       from now on
-          mg_switch_to_pe0 = .TRUE.
-
-!
-!--       In case of non-cyclic lateral boundary conditions, both in- and outflow conditions have to
-!--       be used on all PEs after the switch, because then they have the total domain.
-          IF ( bc_lr_dirrad )  THEN
-             bc_dirichlet_l  = .TRUE.
-             bc_dirichlet_r  = .FALSE.
-             bc_radiation_l  = .FALSE.
-             bc_radiation_r  = .TRUE.
-          ELSEIF ( bc_lr_raddir )  THEN
-             bc_dirichlet_l  = .FALSE.
-             bc_dirichlet_r  = .TRUE.
-             bc_radiation_l  = .TRUE.
-             bc_radiation_r  = .FALSE.
-          ELSEIF ( child_domain  .OR.  nesting_offline )  THEN
-             bc_dirichlet_l  = .TRUE.
-             bc_dirichlet_r  = .TRUE.
-          ENDIF
-
-          IF ( bc_ns_dirrad )  THEN
-             bc_dirichlet_n  = .TRUE.
-             bc_dirichlet_s  = .FALSE.
-             bc_radiation_n  = .FALSE.
-             bc_radiation_s  = .TRUE.
-          ELSEIF ( bc_ns_raddir )  THEN
-             bc_dirichlet_n  = .FALSE.
-             bc_dirichlet_s  = .TRUE.
-             bc_radiation_n  = .TRUE.
-             bc_radiation_s  = .FALSE.
-          ELSEIF ( child_domain  .OR.  nesting_offline)  THEN
-             bc_dirichlet_s  = .TRUE.
-             bc_dirichlet_n  = .TRUE.
-          ENDIF
-
-          DEALLOCATE( f2_sub )
-
-       ELSE
-
-          CALL restrict( f2, r )
-
-          ind_even_odd = even_odd_level(grid_level)  ! Must be after restrict
-
-       ENDIF
-
-       p2 = 0.0_wp
-
-!
-!--    Repeat the same procedure untill the coarsest grid is reached
-       CALL next_mg_level( f2, p2, p3, r )
-
-    ENDIF
-
-!
-!-- Now follows the prolongation
-    IF ( grid_level >= 2 )  THEN
-
-!
-!--    Prolongation of the new residual. The values are transferred from the coarse to the next
-!--    finer grid.
-       IF ( grid_level == mg_switch_to_pe0_level+1 )  THEN
-
-#if defined( __parallel )
-!
-!--       At this level, the new residual first has to be scattered from PE0 to the other PEs
-          ALLOCATE( p2_sub(nzb:mg_loc_ind(5,myid)+1,mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,     &
-                                                    mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) )
-
-          CALL mg_scatter( p2, p2_sub )
-
-!
-!--       Therefore, indices of the previous level have to be changed to subdomain values in between
-!--       (otherwise, the prolong routine would expect the gathered array).
-          nxl_mg_save = nxl_mg(grid_level-1)
-          nxr_mg_save = nxr_mg(grid_level-1)
-          nys_mg_save = nys_mg(grid_level-1)
-          nyn_mg_save = nyn_mg(grid_level-1)
-          nzt_mg_save = nzt_mg(grid_level-1)
-          nxl_mg(grid_level-1) = mg_loc_ind(1,myid)
-          nxr_mg(grid_level-1) = mg_loc_ind(2,myid)
-          nys_mg(grid_level-1) = mg_loc_ind(3,myid)
-          nyn_mg(grid_level-1) = mg_loc_ind(4,myid)
-          nzt_mg(grid_level-1) = mg_loc_ind(5,myid)
-
-!
-!--       Set switch for routine exchange_horiz, that ghost point exchange has to be carried out
-!--       again from now on
-          mg_switch_to_pe0 = .FALSE.
-
-!
-!--       For non-cyclic lateral boundary conditions and in case of nesting, restore the in-/outflow
-!--       conditions.
-          bc_dirichlet_l = .FALSE.;  bc_dirichlet_r = .FALSE.
-          bc_dirichlet_n = .FALSE.;  bc_dirichlet_s = .FALSE.
-          bc_radiation_l = .FALSE.;  bc_radiation_r = .FALSE.
-          bc_radiation_n = .FALSE.;  bc_radiation_s = .FALSE.
-
-          IF ( pleft == MPI_PROC_NULL )  THEN
-             IF ( bc_lr_dirrad  .OR.  child_domain  .OR.  nesting_offline )  THEN
-                bc_dirichlet_l = .TRUE.
-             ELSEIF ( bc_lr_raddir )  THEN
-                bc_radiation_l = .TRUE.
-             ENDIF
-          ENDIF
-
-          IF ( pright == MPI_PROC_NULL )  THEN
-             IF ( bc_lr_dirrad )  THEN
-                bc_radiation_r = .TRUE.
-             ELSEIF ( bc_lr_raddir  .OR.  child_domain  .OR.  nesting_offline )  THEN
-                bc_dirichlet_r = .TRUE.
-             ENDIF
-          ENDIF
-
-          IF ( psouth == MPI_PROC_NULL )  THEN
-             IF ( bc_ns_dirrad )  THEN
-                bc_radiation_s = .TRUE.
-             ELSEIF ( bc_ns_raddir  .OR.  child_domain  .OR.  nesting_offline )  THEN
-                bc_dirichlet_s = .TRUE.
-             ENDIF
-          ENDIF
-
-          IF ( pnorth == MPI_PROC_NULL )  THEN
-             IF ( bc_ns_dirrad  .OR.  child_domain  .OR.  nesting_offline )  THEN
-                bc_dirichlet_n = .TRUE.
-             ELSEIF ( bc_ns_raddir )  THEN
-                bc_radiation_n = .TRUE.
-             ENDIF
-          ENDIF
-
-          CALL prolong( p2_sub, p3 )
-
-!
-!--       Restore the correct indices of the previous level
-          nxl_mg(grid_level-1) = nxl_mg_save
-          nxr_mg(grid_level-1) = nxr_mg_save
-          nys_mg(grid_level-1) = nys_mg_save
-          nyn_mg(grid_level-1) = nyn_mg_save
-          nzt_mg(grid_level-1) = nzt_mg_save
-
-          DEALLOCATE( p2_sub )
-#endif
-
-       ELSE
-
-          CALL prolong( p2, p3 )
-
-       ENDIF
-
-!
-!--    Computation of the new pressure correction. Therefore, values from prior grids are added up
-!--    automatically stage by stage.
-       DO  i = nxl_mg(grid_level)-1, nxr_mg(grid_level)+1
-          DO  j = nys_mg(grid_level)-1, nyn_mg(grid_level)+1
-             DO  k = nzb, nzt_mg(grid_level)+1
-                p_mg(k,j,i) = p_mg(k,j,i) + p3(k,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
-
-!
-!--    Relaxation of the new solution
-       CALL redblack( f_mg, p_mg )
-
-    ENDIF
-
-
-!
-!-- The following few lines serve the steering of the multigrid scheme
-    IF ( grid_level == maximum_grid_level )  THEN
-
-       GOTO 20
-
-    ELSEIF ( grid_level /= maximum_grid_level  .AND.  grid_level /= 1  .AND.                       &
-             grid_level_count(grid_level) /= gamma_mg )  THEN
-
-       GOTO 10
-
-    ENDIF
-
-!
-!-- Reset counter for the next call of poismg
-    grid_level_count(grid_level) = 0
-
-!
-!-- Continue with the next finer level. nxl..nzt have to be set to the finer grid values, because
-!-- these variables are needed for the exchange of ghost points in routine exchange_horiz.
-    grid_level = grid_level + 1
-    ind_even_odd = even_odd_level(grid_level)
-
-    nxl = nxl_mg(grid_level)
-    nxr = nxr_mg(grid_level)
-    nys = nys_mg(grid_level)
-    nyn = nyn_mg(grid_level)
-    nzt = nzt_mg(grid_level)
-
- 20 CONTINUE
-
- END SUBROUTINE next_mg_level
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initial settings for sorting k-dimension from sequential order (alternate even/odd) into blocks
-!> of even and odd or vice versa
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_even_odd_blocks
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  f1_mg,                                                                              &
-               f2_mg,                                                                              &
-               f3_mg
-
-    USE control_parameters,                                                                        &
-        ONLY:  grid_level,                                                                         &
-               maximum_grid_level
-
-    USE indices,                                                                                   &
-        ONLY:  nzb,                                                                                &
-               nzt,                                                                                &
-               nzt_mg
-
-    USE indices,                                                                                   &
-        ONLY:  nzb,                                                                                &
-               nzt_mg
-
-    IMPLICIT NONE
-!
-!-- Local variables
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  l  !<
-
-    LOGICAL, SAVE ::  lfirst = .TRUE.  !<
-
-
-    IF ( .NOT. lfirst )  RETURN
-
-    ALLOCATE( even_odd_level(maximum_grid_level) )
-
-    ALLOCATE( f1_mg_b(nzb:nzt+1,maximum_grid_level), f2_mg_b(nzb:nzt+1,maximum_grid_level),        &
-              f3_mg_b(nzb:nzt+1,maximum_grid_level) )
-
-!
-!-- Set border index between the even and odd block
-    DO  i = maximum_grid_level, 1, -1
-       even_odd_level(i) = nzt_mg(i) / 2
-    ENDDO
-
-!
-!-- Sort grid coefficients used in red/black scheme and for calculating the residual to block
-!-- (even/odd) structure
-    DO  l = maximum_grid_level, 1 , -1
-       CALL sort_k_to_even_odd_blocks( f1_mg(nzb+1:nzt_mg(grid_level),l),                          &
-                                       f1_mg_b(nzb:nzt_mg(grid_level)+1,l), l )
-       CALL sort_k_to_even_odd_blocks( f2_mg(nzb+1:nzt_mg(grid_level),l),                          &
-                                       f2_mg_b(nzb:nzt_mg(grid_level)+1,l), l )
-       CALL sort_k_to_even_odd_blocks( f3_mg(nzb+1:nzt_mg(grid_level),l),                          &
-                                       f3_mg_b(nzb:nzt_mg(grid_level)+1,l), l )
-    ENDDO
-
-    lfirst = .FALSE.
-
- END SUBROUTINE init_even_odd_blocks
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Special exchange_horiz subroutine for use in redblack. Transfers only "red" or "black" data
-!> points.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE special_exchange_horiz( p_mg, color )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  grid_level
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  mg_switch_to_pe0_level,                                                             &
-               synchronous_exchange
-#endif
-
-    USE indices,                                                                                   &
-        ONLY:  nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-#if defined( __parallel )
-    USE indices,                                                                                   &
-        ONLY:  nxl,                                                                                &
-               nxr,                                                                                &
-               nys,                                                                                &
-               nyn,                                                                                &
-               nzt
-#endif
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  color  !< flag for grid point type (red or black)
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg   !< treated array
-
-
-#if defined ( __parallel )
-!
-!-- Local variables
-    INTEGER(iwp) ::  i    !< index variable along x
-    INTEGER(iwp) ::  i1   !< index variable along x on coarse level
-    INTEGER(iwp) ::  i2   !< index variable along x on coarse level
-
-    INTEGER(iwp) ::  j    !< index variable along y
-    INTEGER(iwp) ::  j1   !< index variable along y on coarse level
-    INTEGER(iwp) ::  j2   !< index variable along y on coarse level
-    INTEGER(iwp) ::  k    !< index variable along z
-    INTEGER(iwp) ::  l    !< short for grid level
-    INTEGER(iwp) ::  jys  !< index for lower local PE boundary along y
-    INTEGER(iwp) ::  jyn  !< index for upper local PE boundary along y
-    INTEGER(iwp) ::  ixl  !< index for lower local PE boundary along x
-    INTEGER(iwp) ::  ixr  !< index for upper local PE boundary along x
-
-    LOGICAL ::  synchronous_exchange_save  !< dummy to reset synchronous_exchange to prescribed value
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  temp  !< temporary array on next coarser grid level
-
-    synchronous_exchange_save = synchronous_exchange
-    synchronous_exchange      = .FALSE.
-
-    l = grid_level
-
-    ind_even_odd = even_odd_level(grid_level)
-
-!
-!-- Restricted transfer only on finer levels with enough data. Restricted transfer is not possible
-!-- for levels smaller or equal to 'switch to PE0 levels', since array bounds do not fit.
-!-- Moreover, it is not possible for the coarsest grid level, since the dimensions of temp are not
-!-- defined. For such cases, normal exchange_horiz is called.
-    IF ( l > 1 .AND. l > mg_switch_to_pe0_level + 1 .AND.                                          &
-         ( ngp_xz(grid_level) >= 900 .OR. ngp_yz(grid_level) >= 900 ) )  THEN
-
-       jys = nys_mg(grid_level-1)
-       jyn = nyn_mg(grid_level-1)
-       ixl = nxl_mg(grid_level-1)
-       ixr = nxr_mg(grid_level-1)
-       ALLOCATE( temp(nzb:nzt_mg(l-1)+1,jys-1:jyn+1,ixl-1:ixr+1) )
-!
-!--    Handling the even k Values
-!--    Collecting data for the north - south exchange
-!--    Since only every second value has to be transfered, data are stored on the next coarser grid
-!--    level, because the arrays on that level have just the required size
-       i1 = nxl_mg(grid_level-1)
-       i2 = nxl_mg(grid_level-1)
-
-       DO  i = nxl_mg(l), nxr_mg(l), 2
-          DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-
-             IF ( j == nys_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   temp(k-ind_even_odd,jys,i1) = p_mg(k,j,i)
-                ENDDO
-                i1 = i1 + 1
-
-             ENDIF
-
-             IF ( j == nyn_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   temp(k-ind_even_odd,jyn,i2) = p_mg(k,j,i)
-                ENDDO
-                i2 = i2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-          DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-
-             IF ( j == nys_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   temp(k-ind_even_odd,jys,i1) = p_mg(k,j,i)
-                ENDDO
-                i1 = i1 + 1
-
-             ENDIF
-
-             IF ( j == nyn_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   temp(k-ind_even_odd,jyn,i2) = p_mg(k,j,i)
-                ENDDO
-                i2 = i2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       grid_level = grid_level-1
-
-       nxl = nxl_mg(grid_level)
-       nys = nys_mg(grid_level)
-       nxr = nxr_mg(grid_level)
-       nyn = nyn_mg(grid_level)
-       nzt = nzt_mg(grid_level)
-
-       send_receive = 'ns'
-       CALL exchange_horiz( temp, 1 )
-
-       grid_level = grid_level+1
-
-       i1 = nxl_mg(grid_level-1)
-       i2 = nxl_mg(grid_level-1)
-
-       DO  i = nxl_mg(l), nxr_mg(l), 2
-          DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-
-             IF ( j == nys_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   p_mg(k,nyn_mg(l)+1,i) = temp(k-ind_even_odd,jyn+1,i1)
-                ENDDO
-                i1 = i1 + 1
-
-             ENDIF
-
-             IF ( j == nyn_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   p_mg(k,nys_mg(l)-1,i) = temp(k-ind_even_odd,jys-1,i2)
-                ENDDO
-                i2 = i2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-          DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-
-             IF ( j == nys_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   p_mg(k,nyn_mg(l)+1,i) = temp(k-ind_even_odd,jyn+1,i1)
-                ENDDO
-                i1 = i1 + 1
-
-             ENDIF
-
-             IF ( j == nyn_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   p_mg(k,nys_mg(l)-1,i) = temp(k-ind_even_odd,jys-1,i2)
-                ENDDO
-                i2 = i2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-!
-!--    Collecting data for the left - right exchange.
-!--    Since only every second value has to be transfered, data are stored on the next coarser grid
-!--    level, because the arrays on that level have just the required size.
-       j1 = nys_mg(grid_level-1)
-       j2 = nys_mg(grid_level-1)
-
-       DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-          DO  i = nxl_mg(l), nxr_mg(l), 2
-
-             IF ( i == nxl_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   temp(k-ind_even_odd,j1,ixl) = p_mg(k,j,i)
-                ENDDO
-                j1 = j1 + 1
-
-             ENDIF
-
-             IF ( i == nxr_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   temp(k-ind_even_odd,j2,ixr) = p_mg(k,j,i)
-                ENDDO
-                j2 = j2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-          DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-
-             IF ( i == nxl_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   temp(k-ind_even_odd,j1,ixl) = p_mg(k,j,i)
-                ENDDO
-                j1 = j1 + 1
-
-             ENDIF
-
-             IF ( i == nxr_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   temp(k-ind_even_odd,j2,ixr) = p_mg(k,j,i)
-                ENDDO
-                j2 = j2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       grid_level = grid_level-1
-       send_receive = 'lr'
-
-       CALL exchange_horiz( temp, 1 )
-
-       grid_level = grid_level+1
-
-       j1 = nys_mg(grid_level-1)
-       j2 = nys_mg(grid_level-1)
-
-       DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-          DO  i = nxl_mg(l), nxr_mg(l), 2
-
-             IF ( i == nxl_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   p_mg(k,j,nxr_mg(l)+1)  = temp(k-ind_even_odd,j1,ixr+1)
-                ENDDO
-                j1 = j1 + 1
-
-             ENDIF
-
-             IF ( i == nxr_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   p_mg(k,j,nxl_mg(l)-1)  = temp(k-ind_even_odd,j2,ixl-1)
-                ENDDO
-                j2 = j2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-          DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-
-             IF ( i == nxl_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   p_mg(k,j,nxr_mg(l)+1)  = temp(k-ind_even_odd,j1,ixr+1)
-                ENDDO
-                j1 = j1 + 1
-
-             ENDIF
-
-             IF ( i == nxr_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = ind_even_odd+1, nzt_mg(l)
-                   p_mg(k,j,nxl_mg(l)-1)  = temp(k-ind_even_odd,j2,ixl-1)
-                ENDDO
-                j2 = j2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-!
-!--    Now handling the even k values
-!--    Collecting data for the north - south exchange.
-!--    Since only every second value has to be transfered, data are stored on the next coarser grid
-!--    level, because the arrays on that level have just the required size.
-       i1 = nxl_mg(grid_level-1)
-       i2 = nxl_mg(grid_level-1)
-
-       DO  i = nxl_mg(l), nxr_mg(l), 2
-          DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-
-             IF ( j == nys_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   temp(k,jys,i1) = p_mg(k,j,i)
-                ENDDO
-                i1 = i1 + 1
-
-             ENDIF
-
-             IF ( j == nyn_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   temp(k,jyn,i2) = p_mg(k,j,i)
-                ENDDO
-                i2 = i2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-          DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-
-             IF ( j == nys_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   temp(k,jys,i1) = p_mg(k,j,i)
-                ENDDO
-                i1 = i1 + 1
-
-             ENDIF
-
-             IF ( j == nyn_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   temp(k,jyn,i2) = p_mg(k,j,i)
-                ENDDO
-                i2 = i2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       grid_level = grid_level-1
-
-       send_receive = 'ns'
-       CALL exchange_horiz( temp, 1 )
-
-       grid_level = grid_level+1
-
-       i1 = nxl_mg(grid_level-1)
-       i2 = nxl_mg(grid_level-1)
-
-       DO  i = nxl_mg(l), nxr_mg(l), 2
-          DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-
-             IF ( j == nys_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   p_mg(k,nyn_mg(l)+1,i) = temp(k,jyn+1,i1)
-                ENDDO
-                i1 = i1 + 1
-
-             ENDIF
-
-             IF ( j == nyn_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   p_mg(k,nys_mg(l)-1,i) = temp(k,jys-1,i2)
-                ENDDO
-                i2 = i2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-          DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-
-             IF ( j == nys_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   p_mg(k,nyn_mg(l)+1,i) = temp(k,jyn+1,i1)
-                ENDDO
-                i1 = i1 + 1
-
-             ENDIF
-
-             IF ( j == nyn_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   p_mg(k,nys_mg(l)-1,i) = temp(k,jys-1,i2)
-                ENDDO
-                i2 = i2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       j1 = nys_mg(grid_level-1)
-       j2 = nys_mg(grid_level-1)
-
-       DO  i = nxl_mg(l), nxr_mg(l), 2
-          DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-
-             IF ( i == nxl_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   temp(k,j1,ixl) = p_mg(k,j,i)
-                ENDDO
-                j1 = j1 + 1
-
-             ENDIF
-
-             IF ( i == nxr_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   temp(k,j2,ixr) = p_mg(k,j,i)
-                ENDDO
-                j2 = j2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-          DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-
-             IF ( i == nxl_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   temp(k,j1,ixl) = p_mg(k,j,i)
-                ENDDO
-                j1 = j1 + 1
-
-             ENDIF
-
-             IF ( i == nxr_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   temp(k,j2,ixr) = p_mg(k,j,i)
-                ENDDO
-                j2 = j2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       grid_level = grid_level-1
-
-       send_receive = 'lr'
-       CALL exchange_horiz( temp, 1 )
-
-       grid_level = grid_level+1
-
-       nxl = nxl_mg(grid_level)
-       nys = nys_mg(grid_level)
-       nxr = nxr_mg(grid_level)
-       nyn = nyn_mg(grid_level)
-       nzt = nzt_mg(grid_level)
-
-       j1 = nys_mg(grid_level-1)
-       j2 = nys_mg(grid_level-1)
-
-       DO  i = nxl_mg(l), nxr_mg(l), 2
-          DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-
-             IF ( i == nxl_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   p_mg(k,j,nxr_mg(l)+1)  = temp(k,j1,ixr+1)
-                ENDDO
-                j1 = j1 + 1
-
-             ENDIF
-
-             IF ( i == nxr_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   p_mg(k,j,nxl_mg(l)-1)  = temp(k,j2,ixl-1)
-                ENDDO
-                j2 = j2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-          DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-
-             IF ( i == nxl_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   p_mg(k,j,nxr_mg(l)+1)  = temp(k,j1,ixr+1)
-                ENDDO
-                j1 = j1 + 1
-
-             ENDIF
-
-             IF ( i == nxr_mg(l) )  THEN
-                !DIR$ IVDEP
-                DO  k = nzb+1, ind_even_odd
-                   p_mg(k,j,nxl_mg(l)-1)  = temp(k,j2,ixl-1)
-                ENDDO
-                j2 = j2 + 1
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-       DEALLOCATE( temp )
-
-    ELSE
-
-!
-!--    Standard horizontal ghost boundary exchange for small coarse grid levels, where the transfer
-!--    time is latency bound
-       CALL exchange_horiz( p_mg, 1 )
-
-    ENDIF
-
-!
-!-- Reset values to default PALM setup
-    synchronous_exchange   = synchronous_exchange_save
-    send_receive = 'al'
-#else
-
-!
-!-- Next line is to avoid compiler error due to unused dummy argument
-    IF ( color == 1234567 )  RETURN
-!
-!-- Standard horizontal ghost boundary exchange for small coarse grid levels, where the transfer
-!-- time is latency bound.
-    CALL exchange_horiz( p_mg, 1 )
-#endif
-
- END SUBROUTINE special_exchange_horiz
-
- END MODULE poismg_mod
Index: palm/trunk/SOURCE/poismg_noopt_mod.f90
===================================================================
--- palm/trunk/SOURCE/poismg_noopt_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2033 +1,0 @@
-!> @file poismg_noopt_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! bugfix in redblack algorithm: lower i,j indices need to start alternatively with even or odd
-! value on the coarsest grid level, if the subdomain has an uneven number of gridpoints along x/y
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! File re-formatted to follow the PALM coding standard
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! Use statement for exchange horiz added
-!
-! 4429 2020-02-27 15:24:30Z raasch
-! Bugfix: cpp-directives added for serial mode
-!
-! 4414 2020-02-19 20:16:04Z suehring
-! Remove double-declared use only construct.
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static
-! topography information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Unused variables removed
-!
-! Revision 1.1  2001/07/20 13:10:51  raasch
-! Initial revision
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Solves the Poisson equation for the perturbation pressure with a multigrid V- or W-Cycle scheme.
-!>
-!> This multigrid method was originally developed for PALM by Joerg Uhlenbrock,
-!> September 2000 - July 2001.
-!>
-!> @attention Loop unrolling and cache optimization in SOR-Red/Black method still does not give the
-!>            expected speedup!
-!>
-!> @todo Further work required.
-!> @todo Formatting adjustments required (indention after modularization)
-!--------------------------------------------------------------------------------------------------!
- MODULE poismg_noopt_mod
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               child_domain,                                                                       &
-               grid_level,                                                                         &
-               nesting_offline
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz,                                                                     &
-               exchange_horiz_int
-
-    USE kinds
-
-    USE pegrid
-
-    PRIVATE
-
-    INTERFACE poismg_noopt
-       MODULE PROCEDURE poismg_noopt
-    END INTERFACE poismg_noopt
-
-    INTERFACE poismg_noopt_init
-       MODULE PROCEDURE poismg_noopt_init
-    END INTERFACE poismg_noopt_init
-
-    PUBLIC poismg_noopt, poismg_noopt_init
-
- CONTAINS
-
-    SUBROUTINE poismg_noopt( r )
-
-       USE arrays_3d,                                                                              &
-           ONLY:  d,                                                                               &
-                  p_loc
-
-       USE control_parameters,                                                                     &
-           ONLY:  bc_lr_cyc,                                                                       &
-                  bc_ns_cyc,                                                                       &
-                  gathered_size,                                                                   &
-                  grid_level,                                                                      &
-                  grid_level_count,                                                                &
-                  ibc_p_t,                                                                         &
-                  maximum_grid_level,                                                              &
-                  message_string,                                                                  &
-                  mgcycles,                                                                        &
-                  mg_cycles,                                                                       &
-                  mg_switch_to_pe0_level,                                                          &
-                  residual_limit,                                                                  &
-                  subdomain_size
-
-       USE cpulog,                                                                                 &
-           ONLY:  cpu_log,                                                                         &
-                  log_point_s
-
-       USE indices,                                                                                &
-           ONLY:  nxl,                                                                             &
-                  nxlg,                                                                            &
-                  nxl_mg,                                                                          &
-                  nxr,                                                                             &
-                  nxrg,                                                                            &
-                  nxr_mg,                                                                          &
-                  nys,                                                                             &
-                  nysg,                                                                            &
-                  nys_mg,                                                                          &
-                  nyn,                                                                             &
-                  nyng,                                                                            &
-                  nyn_mg,                                                                          &
-                  nzb,                                                                             &
-                  nzt,                                                                             &
-                  nzt_mg
-
-       USE kinds
-
-       USE pegrid
-
-       IMPLICIT NONE
-
-       REAL(wp) ::  maxerror          !<
-       REAL(wp) ::  maximum_mgcycles  !<
-       REAL(wp) ::  residual_norm     !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ::  r  !<
-
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  p3  !<
-
-
-       CALL cpu_log( log_point_s(29), 'poismg_noopt', 'start' )
-!
-!--    Initialize arrays and variables used in this subroutine
-
-!--    If the number of grid points of the gathered grid, which is collected on PE0, is larger than
-!--    the number of grid points of an PE, than array p3 will be enlarged.
-       IF ( gathered_size > subdomain_size )  THEN
-          ALLOCATE( p3(nzb:nzt_mg(mg_switch_to_pe0_level)+1,nys_mg(                                &
-                    mg_switch_to_pe0_level)-1:nyn_mg(mg_switch_to_pe0_level)+1,                    &
-                    nxl_mg(mg_switch_to_pe0_level)-1:nxr_mg(mg_switch_to_pe0_level)+1) )
-       ELSE
-          ALLOCATE ( p3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-
-       p3 = 0.0_wp
-
-!
-!--    Ghost boundaries have to be added to divergence array.
-!--    Exchange routine needs to know the grid level!
-       grid_level = maximum_grid_level
-       CALL exchange_horiz( d, 1)
-!
-!--    Set bottom and top boundary conditions
-       d(nzb,:,:) = d(nzb+1,:,:)
-       IF ( ibc_p_t == 1 )  d(nzt+1,:,: ) = d(nzt,:,:)
-!
-!--    Set lateral boundary conditions in non-cyclic case
-       IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  d(:,:,nxl-1) = d(:,:,nxl)
-          IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  d(:,:,nxr+1) = d(:,:,nxr)
-       ENDIF
-       IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  d(:,nyn+1,:) = d(:,nyn,:)
-          IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  d(:,nys-1,:) = d(:,nys,:)
-       ENDIF
-
-!
-!--    Initiation of the multigrid scheme. Does n cycles until the residual is smaller than the
-!--    given limit. The accuracy of the solution of the poisson equation will increase with the
-!--    number of cycles. If the number of cycles is preset by the user, this number will be carried
-!--    out regardless of the accuracy.
-       grid_level_count =  0
-       mgcycles         =  0
-       IF ( mg_cycles == -1 )  THEN
-          maximum_mgcycles = 0
-          residual_norm    = 1.0_wp
-       ELSE
-          maximum_mgcycles = mg_cycles
-          residual_norm    = 0.0_wp
-       ENDIF
-
-       DO WHILE ( residual_norm > residual_limit  .OR.  mgcycles < maximum_mgcycles )
-
-          CALL next_mg_level_noopt( d, p_loc, p3, r)
-
-!
-!--       Calculate the residual if the user has not preset the number of cycles to be performed
-          IF ( maximum_mgcycles == 0 )  THEN
-             CALL resid_noopt( d, p_loc, r )
-             maxerror = SUM( r(nzb+1:nzt,nys:nyn,nxl:nxr)**2 )
-
-#if defined( __parallel )
-             IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-                CALL MPI_ALLREDUCE( maxerror, residual_norm, 1, MPI_REAL, MPI_SUM, comm2d, ierr)
-#else
-                residual_norm = maxerror
-#endif
-             residual_norm = SQRT( residual_norm )
-          ENDIF
-
-          mgcycles = mgcycles + 1
-
-!
-!--       If the user has not limited the number of cycles, stop the run in case of insufficient
-!--       convergence
-          IF ( mgcycles > 1000  .AND.  mg_cycles == -1 )  THEN
-             message_string = 'no sufficient convergence within 1000 cycles'
-             CALL message( 'poismg_noopt', 'PA0283', 1, 2, 0, 6, 0 )
-          ENDIF
-
-       ENDDO
-
-       DEALLOCATE( p3 )
-
-!
-!--    Unset the grid level. Variable is used to determine the MPI datatypes for ghost point
-!--    exchange
-       grid_level = 0
-
-       CALL cpu_log( log_point_s(29), 'poismg_noopt', 'stop' )
-
-    END SUBROUTINE poismg_noopt
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computes the residual of the perturbation pressure.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE resid_noopt( f_mg, p_mg, r )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  f1_mg,                                                                              &
-               f2_mg,                                                                              &
-               f3_mg,                                                                              &
-               rho_air_mg
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               ibc_p_b,                                                                            &
-               ibc_p_t
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2_mg,                                                                            &
-               ddy2_mg
-
-    USE indices,                                                                                   &
-        ONLY:  flags,                                                                              &
-               nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg,                                                                             &
-               wall_flags_1,                                                                       &
-               wall_flags_2,                                                                       &
-               wall_flags_3,                                                                       &
-               wall_flags_4,                                                                       &
-               wall_flags_5,                                                                       &
-               wall_flags_6,                                                                       &
-               wall_flags_7,                                                                       &
-               wall_flags_8,                                                                       &
-               wall_flags_9,                                                                       &
-               wall_flags_10
-
-
-
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-    INTEGER(iwp) ::  l  !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  r     !<
-
-!
-!-- Calculate the residual
-    l = grid_level
-
-!
-!-- Choose flag array of this level
-    SELECT CASE ( l )
-       CASE ( 1 )
-          flags => wall_flags_1
-       CASE ( 2 )
-          flags => wall_flags_2
-       CASE ( 3 )
-          flags => wall_flags_3
-       CASE ( 4 )
-          flags => wall_flags_4
-       CASE ( 5 )
-          flags => wall_flags_5
-       CASE ( 6 )
-          flags => wall_flags_6
-       CASE ( 7 )
-          flags => wall_flags_7
-       CASE ( 8 )
-          flags => wall_flags_8
-       CASE ( 9 )
-          flags => wall_flags_9
-       CASE ( 10 )
-          flags => wall_flags_10
-    END SELECT
-
-!$OMP PARALLEL PRIVATE (i,j,k)
-!$OMP DO
-    DO  i = nxl_mg(l), nxr_mg(l)
-       DO  j = nys_mg(l), nyn_mg(l)
-          DO  k = nzb+1, nzt_mg(l)
-             r(k,j,i) = f_mg(k,j,i) - rho_air_mg(k,l) * ddx2_mg(l) *                               &
-                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *                            &
-                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +                            &
-                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *                            &
-                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )                            &
-                        - rho_air_mg(k,l) * ddy2_mg(l) *                                           &
-                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *                            &
-                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +                            &
-                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *                            &
-                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )                            &
-                        - f2_mg(k,l) *                                                             &
-                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *                            &
-                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )                            &
-                        - f3_mg(k,l) *                                                             &
-                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *                            &
-                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )                            &
-                        + f1_mg(k,l) * p_mg(k,j,i)
-!
-!--          Residual within topography should be zero
-             r(k,j,i) = r(k,j,i) * ( 1.0_wp - IBITS( flags(k,j,i), 6, 1 ) )
-          ENDDO
-       ENDDO
-    ENDDO
-!$OMP END PARALLEL
-
-!
-!-- Horizontal boundary conditions
-    CALL exchange_horiz( r, 1)
-
-    IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-          r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
-       ENDIF
-       IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-          r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
-       ENDIF
-    ENDIF
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-          r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
-       ENDIF
-       IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-          r(:,nys_mg(l)-1,:) = r(:,nys_mg(l),:)
-       ENDIF
-    ENDIF
-
-!
-!-- Boundary conditions at bottom and top of the domain.
-!-- These points are not handled by the above loop. Points may be within buildings, but that
-!-- doesn't matter.
-    IF ( ibc_p_b == 1 )  THEN
-       r(nzb,:,: ) = r(nzb+1,:,:)
-    ELSE
-       r(nzb,:,: ) = 0.0_wp
-    ENDIF
-
-    IF ( ibc_p_t == 1 )  THEN
-       r(nzt_mg(l)+1,:,: ) = r(nzt_mg(l),:,:)
-    ELSE
-       r(nzt_mg(l)+1,:,: ) = 0.0_wp
-    ENDIF
-
-
- END SUBROUTINE resid_noopt
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interpolates the residual on the next coarser grid with "full weighting" scheme.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE restrict_noopt( f_mg, r )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               grid_level,                                                                         &
-               ibc_p_b,                                                                            &
-               ibc_p_t
-
-    USE indices,                                                                                   &
-        ONLY:  flags,                                                                              &
-               nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg,                                                                             &
-               wall_flags_1,                                                                       &
-               wall_flags_2,                                                                       &
-               wall_flags_3,                                                                       &
-               wall_flags_4,                                                                       &
-               wall_flags_5,                                                                       &
-               wall_flags_6,                                                                       &
-               wall_flags_7,                                                                       &
-               wall_flags_8,                                                                       &
-               wall_flags_9,                                                                       &
-               wall_flags_10
-
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i   !<
-    INTEGER(iwp) ::  ic  !<
-    INTEGER(iwp) ::  j   !<
-    INTEGER(iwp) ::  jc  !<
-    INTEGER(iwp) ::  k   !<
-    INTEGER(iwp) ::  kc  !<
-    INTEGER(iwp) ::  l   !<
-
-    REAL(wp) ::  rkjim    !<
-    REAL(wp) ::  rkjip    !<
-    REAL(wp) ::  rkjmi    !<
-    REAL(wp) ::  rkjmim   !<
-    REAL(wp) ::  rkjmip   !<
-    REAL(wp) ::  rkjpi    !<
-    REAL(wp) ::  rkjpim   !<
-    REAL(wp) ::  rkjpip   !<
-    REAL(wp) ::  rkmji    !<
-    REAL(wp) ::  rkmjim   !<
-    REAL(wp) ::  rkmjip   !<
-    REAL(wp) ::  rkmjmi   !<
-    REAL(wp) ::  rkmjmim  !<
-    REAL(wp) ::  rkmjmip  !<
-    REAL(wp) ::  rkmjpi   !<
-    REAL(wp) ::  rkmjpim  !<
-    REAL(wp) ::  rkmjpip  !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1)    ::  f_mg  !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level+1)+1,nys_mg(grid_level+1)-1:nyn_mg(grid_level+1)+1,  &
-                        nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) ::  r    !<
-
-!
-!-- Interpolate the residual
-    l = grid_level
-
-!
-!-- Choose flag array of the upper level
-    SELECT CASE ( l+1 )
-       CASE ( 1 )
-          flags => wall_flags_1
-       CASE ( 2 )
-          flags => wall_flags_2
-       CASE ( 3 )
-          flags => wall_flags_3
-       CASE ( 4 )
-          flags => wall_flags_4
-       CASE ( 5 )
-          flags => wall_flags_5
-       CASE ( 6 )
-          flags => wall_flags_6
-       CASE ( 7 )
-          flags => wall_flags_7
-       CASE ( 8 )
-          flags => wall_flags_8
-       CASE ( 9 )
-          flags => wall_flags_9
-       CASE ( 10 )
-          flags => wall_flags_10
-    END SELECT
-
-!$OMP PARALLEL PRIVATE (i,j,k,ic,jc,kc, rkjim,rkjip,rkjpi,rkjmi,rkjmim,rkjpim, &
-!$OMP rkjmip, rkjpip,rkmji,rkmjim,rkmjip,rkmjpi,rkmjmi,rkmjmim,rkmjpim,rkmjmip,&
-!$OMP rkmjpip          )
-!$OMP DO
-    DO  ic = nxl_mg(l), nxr_mg(l)
-       i = 2*ic
-       DO  jc = nys_mg(l), nyn_mg(l)
-          j = 2*jc
-          DO  kc = nzb+1, nzt_mg(l)
-             k = 2*kc-1
-!
-!--          Use implicit Neumann BCs if the respective gridpoint is inside the building
-             rkjim   = r(k,j,i-1) + IBITS( flags(k,j,i-1), 6, 1 ) * ( r(k,j,i) - r(k,j,i-1) )
-             rkjip   = r(k,j,i+1) + IBITS( flags(k,j,i+1), 6, 1 ) * ( r(k,j,i) - r(k,j,i+1) )
-             rkjpi   = r(k,j+1,i) + IBITS( flags(k,j+1,i), 6, 1 ) * ( r(k,j,i) - r(k,j+1,i) )
-             rkjmi   = r(k,j-1,i) + IBITS( flags(k,j-1,i), 6, 1 ) * ( r(k,j,i) - r(k,j-1,i) )
-             rkjmim  = r(k,j-1,i-1) + IBITS( flags(k,j-1,i-1), 6, 1 ) * ( r(k,j,i) - r(k,j-1,i-1) )
-             rkjpim  = r(k,j+1,i-1) + IBITS( flags(k,j+1,i-1), 6, 1 ) * ( r(k,j,i) - r(k,j+1,i-1) )
-             rkjmip  = r(k,j-1,i+1) + IBITS( flags(k,j-1,i+1), 6, 1 ) * ( r(k,j,i) - r(k,j-1,i+1) )
-             rkjpip  = r(k,j+1,i+1) + IBITS( flags(k,j+1,i+1), 6, 1 ) * ( r(k,j,i) - r(k,j+1,i+1) )
-             rkmji   = r(k-1,j,i) + IBITS( flags(k-1,j,i), 6, 1 ) * ( r(k,j,i) - r(k-1,j,i) )
-             rkmjim  = r(k-1,j,i-1) + IBITS( flags(k-1,j,i-1), 6, 1 ) * ( r(k,j,i) - r(k-1,j,i-1) )
-             rkmjip  = r(k-1,j,i+1) + IBITS( flags(k-1,j,i+1), 6, 1 ) * ( r(k,j,i) - r(k-1,j,i+1) )
-             rkmjpi  = r(k-1,j+1,i) + IBITS( flags(k-1,j+1,i), 6, 1 ) * ( r(k,j,i) - r(k-1,j+1,i) )
-             rkmjmi  = r(k-1,j-1,i) + IBITS( flags(k-1,j-1,i), 6, 1 ) * ( r(k,j,i) - r(k-1,j-1,i) )
-             rkmjmim = r(k-1,j-1,i-1) + IBITS( flags(k-1,j-1,i-1), 6, 1 )                          &
-                       * ( r(k,j,i) - r(k-1,j-1,i-1) )
-             rkmjpim = r(k-1,j+1,i-1) + IBITS( flags(k-1,j+1,i-1), 6, 1 )                          &
-                       * ( r(k,j,i) - r(k-1,j+1,i-1) )
-             rkmjmip = r(k-1,j-1,i+1) + IBITS( flags(k-1,j-1,i+1), 6, 1 )                          &
-                       * ( r(k,j,i) - r(k-1,j-1,i+1) )
-             rkmjpip = r(k-1,j+1,i+1) + IBITS( flags(k-1,j+1,i+1), 6, 1 )                          &
-                       * ( r(k,j,i) - r(k-1,j+1,i+1) )
-
-             f_mg(kc,jc,ic) = 1.0_wp / 64.0_wp                                                     &
-                              * ( 8.0_wp * r(k,j,i)                                                &
-                                  + 4.0_wp * ( rkjim  + rkjip  + rkjpi   + rkjmi  )                &
-                                  + 2.0_wp * ( rkjmim + rkjpim + rkjmip  + rkjpip )                &
-                                  + 4.0_wp * rkmji                                                 &
-                                  + 2.0_wp * ( rkmjim  + rkmjim  + rkmjpi  + rkmjmi  )             &
-                                  +          ( rkmjmim + rkmjpim + rkmjmip + rkmjpip )             &
-                                  + 4.0_wp * r(k+1,j,i)                                            &
-                                  + 2.0_wp * ( r(k+1,j,i-1)   + r(k+1,j,i+1)   +                   &
-                                               r(k+1,j+1,i)   + r(k+1,j-1,i)   )                   &
-                                  +          ( r(k+1,j-1,i-1) + r(k+1,j+1,i-1) +                   &
-                                               r(k+1,j-1,i+1) + r(k+1,j+1,i+1) )                   &
-                                )
-
-!          f_mg(kc,jc,ic) = 1.0_wp / 64.0_wp * (                                                    &
-!                           8.0_wp * r(k,j,i)                                                       &
-!                         + 4.0_wp * ( r(k,j,i-1)     + r(k,j,i+1)     +                            &
-!                                      r(k,j+1,i)     + r(k,j-1,i)     )                            &
-!                         + 2.0_wp * ( r(k,j-1,i-1)   + r(k,j+1,i-1)   +                            &
-!                                      r(k,j-1,i+1)   + r(k,j+1,i+1)   )                            &
-!                         + 4.0_wp * r(k-1,j,i)                                                     &
-!                         + 2.0_wp * ( r(k-1,j,i-1)   + r(k-1,j,i+1)   +                            &
-!                                      r(k-1,j+1,i)   + r(k-1,j-1,i)   )                            &
-!                         +          ( r(k-1,j-1,i-1) + r(k-1,j+1,i-1) +                            &
-!                                      r(k-1,j-1,i+1) + r(k-1,j+1,i+1) )                            &
-!                         + 4.0_wp * r(k+1,j,i)                                                     &
-!                         + 2.0_wp * ( r(k+1,j,i-1)   + r(k+1,j,i+1)   +                            &
-!                                      r(k+1,j+1,i)   + r(k+1,j-1,i)   )                            &
-!                         +          ( r(k+1,j-1,i-1) + r(k+1,j+1,i-1) +                            &
-!                                      r(k+1,j-1,i+1) + r(k+1,j+1,i+1) )                            &
-!                                             )
-          ENDDO
-       ENDDO
-    ENDDO
-!$OMP END PARALLEL
-
-!
-!-- Horizontal boundary conditions
-    CALL exchange_horiz( f_mg, 1)
-
-    IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-          f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
-       ENDIF
-       IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-          f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
-       ENDIF
-    ENDIF
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-          f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
-       ENDIF
-       IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-          f_mg(:,nys_mg(l)-1,:) = f_mg(:,nys_mg(l),:)
-       ENDIF
-    ENDIF
-
-!
-!-- Boundary conditions at bottom and top of the domain.
-!-- These points are not handled by the above loop. Points may be within buildings, but that
-!-- doesn't matter.
-    IF ( ibc_p_b == 1 )  THEN
-       f_mg(nzb,:,: ) = f_mg(nzb+1,:,:)
-    ELSE
-       f_mg(nzb,:,: ) = 0.0_wp
-    ENDIF
-
-    IF ( ibc_p_t == 1 )  THEN
-       f_mg(nzt_mg(l)+1,:,: ) = f_mg(nzt_mg(l),:,:)
-    ELSE
-       f_mg(nzt_mg(l)+1,:,: ) = 0.0_wp
-    ENDIF
-
-
- END SUBROUTINE restrict_noopt
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interpolates the correction of the perturbation pressure to the next finer grid.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE prolong_noopt( p, temp )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               ibc_p_b,                                                                            &
-               ibc_p_t
-    USE indices,                                                                                   &
-        ONLY:  nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-    INTEGER(iwp) ::  l  !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,  &
-                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) ::  p  !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1)      ::  temp  !<
-
-
-!
-!-- First, store elements of the coarser grid on the next finer grid
-    l = grid_level
-
-!$OMP PARALLEL PRIVATE (i,j,k)
-!$OMP DO
-    DO  i = nxl_mg(l-1), nxr_mg(l-1)
-       DO  j = nys_mg(l-1), nyn_mg(l-1)
-!CDIR NODEP
-          DO  k = nzb+1, nzt_mg(l-1)
-!
-!--          Points of the coarse grid are directly stored on the next finer grid
-             temp(2*k-1,2*j,2*i) = p(k,j,i)
-!
-!--          Points between two coarse-grid points
-             temp(2*k-1,2*j,2*i+1) = 0.5_wp * ( p(k,j,i) + p(k,j,i+1) )
-             temp(2*k-1,2*j+1,2*i) = 0.5_wp * ( p(k,j,i) + p(k,j+1,i) )
-             temp(2*k,2*j,2*i)     = 0.5_wp * ( p(k,j,i) + p(k+1,j,i) )
-!
-!--          Points in the center of the planes stretched by four points of the coarse grid cube
-             temp(2*k-1,2*j+1,2*i+1) = 0.25_wp * ( p(k,j,i)   + p(k,j,i+1) +                       &
-                                                   p(k,j+1,i) + p(k,j+1,i+1) )
-             temp(2*k,2*j,2*i+1)     = 0.25_wp * ( p(k,j,i)   + p(k,j,i+1) +                       &
-                                                   p(k+1,j,i) + p(k+1,j,i+1) )
-             temp(2*k,2*j+1,2*i)     = 0.25_wp * ( p(k,j,i)   + p(k,j+1,i) +                       &
-                                                   p(k+1,j,i) + p(k+1,j+1,i) )
-!
-!--          Points in the middle of coarse grid cube
-             temp(2*k,2*j+1,2*i+1) = 0.125_wp * ( p(k,j,i)     + p(k,j,i+1)   + p(k,j+1,i)   +     &
-                                                  p(k,j+1,i+1) + p(k+1,j,i)   + p(k+1,j,i+1) +     &
-                                                  p(k+1,j+1,i) + p(k+1,j+1,i+1) )
-          ENDDO
-       ENDDO
-    ENDDO
-!$OMP END PARALLEL
-
-!
-!-- Horizontal boundary conditions
-    CALL exchange_horiz( temp, 1)
-
-    IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-          temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
-       ENDIF
-       IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-          temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
-       ENDIF
-    ENDIF
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-          temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
-       ENDIF
-       IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-          temp(:,nys_mg(l)-1,:) = temp(:,nys_mg(l),:)
-       ENDIF
-    ENDIF
-
-!
-!-- Bottom and top boundary conditions
-    IF ( ibc_p_b == 1 )  THEN
-       temp(nzb,:,: ) = temp(nzb+1,:,:)
-    ELSE
-       temp(nzb,:,: ) = 0.0_wp
-    ENDIF
-
-    IF ( ibc_p_t == 1 )  THEN
-       temp(nzt_mg(l)+1,:,: ) = temp(nzt_mg(l),:,:)
-    ELSE
-       temp(nzt_mg(l)+1,:,: ) = 0.0_wp
-    ENDIF
-
-
- END SUBROUTINE prolong_noopt
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Relaxation method for the multigrid scheme. A Gauss-Seidel iteration with 3D-Red-Black
-!> decomposition (GS-RB) is used.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE redblack_noopt( f_mg, p_mg )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  f1_mg,                                                                              &
-               f2_mg,                                                                              &
-               f3_mg,                                                                              &
-               rho_air_mg
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               ibc_p_b,                                                                            &
-               ibc_p_t,                                                                            &
-               ngsrb
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2_mg,                                                                            &
-               ddy2_mg
-
-    USE indices,                                                                                   &
-        ONLY:  flags,                                                                              &
-               nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg,                                                                             &
-               wall_flags_1,                                                                       &
-               wall_flags_2,                                                                       &
-               wall_flags_3,                                                                       &
-               wall_flags_4,                                                                       &
-               wall_flags_5,                                                                       &
-               wall_flags_6,                                                                       &
-               wall_flags_7,                                                                       &
-               wall_flags_8,                                                                       &
-               wall_flags_9,                                                                       &
-               wall_flags_10
-
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  color  !<
-    INTEGER(iwp) ::  i      !<
-    INTEGER(iwp) ::  ic     !<
-    INTEGER(iwp) ::  j      !<
-    INTEGER(iwp) ::  jc     !<
-    INTEGER(iwp) ::  jj     !<
-    INTEGER(iwp) ::  k      !<
-    INTEGER(iwp) ::  l      !<
-    INTEGER(iwp) ::  n      !<
-    INTEGER(iwp) ::  save_nxl_mg  !< to save nxl_mg on coarsest level 1
-    INTEGER(iwp) ::  save_nys_mg  !< to save nys_mg on coarsest level 1
-
-    LOGICAL ::  adjust_lower_i_index  !< adjust lower limit of i loop in case of odd number of grid points
-    LOGICAL ::  adjust_lower_j_index  !< adjust lower limit of j loop in case of odd number of grid points
-    LOGICAL ::  unroll  !<
-
-    REAL(wp) ::  wall_left   !<
-    REAL(wp) ::  wall_north  !<
-    REAL(wp) ::  wall_right  !<
-    REAL(wp) ::  wall_south  !<
-    REAL(wp) ::  wall_total  !<
-    REAL(wp) ::  wall_top    !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !<
-
-    l = grid_level
-
-!
-!-- Choose flag array of this level
-    SELECT CASE ( l )
-       CASE ( 1 )
-          flags => wall_flags_1
-       CASE ( 2 )
-          flags => wall_flags_2
-       CASE ( 3 )
-          flags => wall_flags_3
-       CASE ( 4 )
-          flags => wall_flags_4
-       CASE ( 5 )
-          flags => wall_flags_5
-       CASE ( 6 )
-          flags => wall_flags_6
-       CASE ( 7 )
-          flags => wall_flags_7
-       CASE ( 8 )
-          flags => wall_flags_8
-       CASE ( 9 )
-          flags => wall_flags_9
-       CASE ( 10 )
-          flags => wall_flags_10
-    END SELECT
-
-    unroll = ( MOD( nyn_mg(l)-nys_mg(l)+1, 4 ) == 0  .AND.                                         &
-               MOD( nxr_mg(l)-nxl_mg(l)+1, 2 ) == 0 )
-
-!
-!-- The red/black decomposition requires that on the lower i,j indices need to start alternatively with an
-!-- even or odd value on the coarsest grid level, depending on the core-id, and if the subdomain has an
-!-- uneven number of gridpoints along x/y. Set the respective steering switches here.
-    IF ( l == 1  .AND.  MOD( myidx, 2 ) /= 0  .AND.  MOD( nxl_mg(l) - nxr_mg(l), 2 ) == 0 )  THEN
-       adjust_lower_i_index = .TRUE.
-       save_nxl_mg = nxl_mg(1)
-    ELSE
-       adjust_lower_i_index = .FALSE.
-    ENDIF
-    IF ( l == 1  .AND.  MOD( myidy, 2 ) /= 0  .AND.  MOD( nyn_mg(l) - nys_mg(l), 2 ) == 0 )  THEN
-       adjust_lower_j_index = .TRUE.
-       save_nys_mg = nys_mg(l)
-    ELSE
-       adjust_lower_j_index = .FALSE.
-    ENDIF
-
-
-    DO  n = 1, ngsrb
-
-       DO  color = 1, 2
-
-          IF ( .NOT. unroll )  THEN
-
-             CALL cpu_log( log_point_s(36), 'redblack_no_unroll_noopt', 'start' )
-
-             IF ( adjust_lower_i_index )  THEN
-                nxl_mg(l) = save_nxl_mg + 1
-             ENDIF
-
-             IF ( adjust_lower_j_index )  THEN
-                IF ( color == 1 )  THEN
-                  nys_mg(l) = save_nys_mg - 1
-                ELSE
-                  nys_mg(l) = save_nys_mg + 1
-                ENDIF
-             ENDIF
-!
-!--          Without unrolling of loops, no cache optimization
-             DO  i = nxl_mg(l), nxr_mg(l), 2
-                DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-                   DO  k = nzb+1, nzt_mg(l), 2
-!                   p_mg(k,j,i) = 1.0_wp / f1_mg(k,l) * (                    &
-!                             ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
-!                           + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
-!                           + f2_mg(k,l) * p_mg(k+1,j,i)                     &
-!                           + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i)       &
-!                                                    )
-
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-             IF ( adjust_lower_i_index )  THEN
-                nxl_mg(l) = save_nxl_mg - 1
-             ENDIF
-
-             IF ( adjust_lower_j_index )  THEN
-                IF ( color == 1 )  THEN
-                  nys_mg(l) = save_nys_mg + 1
-                ELSE
-                  nys_mg(l) = save_nys_mg - 1
-                ENDIF
-             ENDIF
-
-             DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-                DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-                   DO  k = nzb+1, nzt_mg(l), 2
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-             IF ( adjust_lower_i_index )  THEN
-                nxl_mg(l) = save_nxl_mg + 1
-             ENDIF
-
-             IF ( adjust_lower_j_index )  THEN
-                IF ( color == 1 )  THEN
-                  nys_mg(l) = save_nys_mg + 1
-                ELSE
-                  nys_mg(l) = save_nys_mg - 1
-                ENDIF
-             ENDIF
-
-             DO  i = nxl_mg(l), nxr_mg(l), 2
-                DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
-                   DO  k = nzb+2, nzt_mg(l), 2
-                     p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                             &
-                                   * ( rho_air_mg(k,l) * ddx2_mg(l) *                              &
-                                       ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *             &
-                                                     ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +             &
-                                         p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *             &
-                                                     ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )             &
-                                   + rho_air_mg(k,l) * ddy2_mg(l) *                                &
-                                       ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *             &
-                                                     ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +             &
-                                         p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *             &
-                                                     ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )             &
-                                   + f2_mg(k,l) *                                                  &
-                                       ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *             &
-                                                     ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )             &
-                                   + f3_mg(k,l) *                                                  &
-                                       ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *             &
-                                                     ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )             &
-                                   - f_mg(k,j,i)                                                   &
-                                     )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-             IF ( adjust_lower_i_index )  THEN
-                nxl_mg(l) = save_nxl_mg - 1
-             ENDIF
-
-             IF ( adjust_lower_j_index )  THEN
-                IF ( color == 1 )  THEN
-                  nys_mg(l) = save_nys_mg - 1
-                ELSE
-                  nys_mg(l) = save_nys_mg + 1
-                ENDIF
-             ENDIF
-
-             DO  i = nxl_mg(l)+1, nxr_mg(l), 2
-                DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
-                   DO  k = nzb+2, nzt_mg(l), 2
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-                   ENDDO
-                ENDDO
-             ENDDO
-             CALL cpu_log( log_point_s(36), 'redblack_no_unroll_noopt', 'stop' )
-
-          ELSE
-
-!
-!--          Loop unrolling along y, only one i loop for better cache use
-             CALL cpu_log( log_point_s(38), 'redblack_unroll_noopt', 'start' )
-             DO  ic = nxl_mg(l), nxr_mg(l), 2
-                DO  jc = nys_mg(l), nyn_mg(l), 4
-                   i  = ic
-                   jj = jc+2-color
-                   DO  k = nzb+1, nzt_mg(l), 2
-                      j = jj
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-
-                      j = jj+2
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-                   ENDDO
-
-                   i  = ic+1
-                   jj = jc+color-1
-                   DO  k = nzb+1, nzt_mg(l), 2
-                      j =jj
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-
-                      j = jj+2
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-                   ENDDO
-
-                   i  = ic
-                   jj = jc+color-1
-                   DO  k = nzb+2, nzt_mg(l), 2
-                      j =jj
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-
-                      j = jj+2
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-                   ENDDO
-
-                   i  = ic+1
-                   jj = jc+2-color
-                   DO  k = nzb+2, nzt_mg(l), 2
-                      j =jj
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-
-                      j = jj+2
-                      p_mg(k,j,i) = 1.0_wp / f1_mg(k,l)                                            &
-                                    * ( rho_air_mg(k,l) * ddx2_mg(l) *                             &
-                                        ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +            &
-                                          p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )            &
-                                    + rho_air_mg(k,l) * ddy2_mg(l) *                               &
-                                        ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +            &
-                                          p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )            &
-                                    + f2_mg(k,l) *                                                 &
-                                        ( p_mg(k+1,j,i) + IBITS( flags(k,j,i), 7, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k+1,j,i) ) )            &
-                                    + f3_mg(k,l) *                                                 &
-                                        ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) *            &
-                                                      ( p_mg(k,j,i) - p_mg(k-1,j,i) ) )            &
-                                    - f_mg(k,j,i)                                                  &
-                                      )
-                   ENDDO
-
-                ENDDO
-             ENDDO
-             CALL cpu_log( log_point_s(38), 'redblack_unroll_noopt', 'stop' )
-
-          ENDIF
-
-!
-!--       Horizontal boundary conditions
-          CALL exchange_horiz( p_mg, 1 )
-
-          IF ( .NOT. bc_lr_cyc )  THEN
-             IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-                p_mg(:,:,nxl_mg(l)-1) = p_mg(:,:,nxl_mg(l))
-             ENDIF
-             IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-                p_mg(:,:,nxr_mg(l)+1) = p_mg(:,:,nxr_mg(l))
-             ENDIF
-          ENDIF
-
-          IF ( .NOT. bc_ns_cyc )  THEN
-             IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-                p_mg(:,nyn_mg(l)+1,:) = p_mg(:,nyn_mg(l),:)
-             ENDIF
-             IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-                p_mg(:,nys_mg(l)-1,:) = p_mg(:,nys_mg(l),:)
-             ENDIF
-          ENDIF
-
-!
-!--       Bottom and top boundary conditions
-          IF ( ibc_p_b == 1 )  THEN
-             p_mg(nzb,:,: ) = p_mg(nzb+1,:,:)
-          ELSE
-             p_mg(nzb,:,: ) = 0.0_wp
-          ENDIF
-
-          IF ( ibc_p_t == 1 )  THEN
-             p_mg(nzt_mg(l)+1,:,: ) = p_mg(nzt_mg(l),:,:)
-          ELSE
-             p_mg(nzt_mg(l)+1,:,: ) = 0.0_wp
-          ENDIF
-
-       ENDDO
-
-    ENDDO
-
-!
-!-- Reset lower index limits to their standard values (may happen on coarsest levels only)
-    IF ( adjust_lower_i_index )  THEN
-       nxl_mg(l) = save_nxl_mg
-    ENDIF
-
-    IF ( adjust_lower_j_index )  THEN
-       nys_mg(l) = save_nys_mg
-    ENDIF
-
-!
-!-- Set pressure within topography and at the topography surfaces
-!$OMP PARALLEL PRIVATE (i,j,k,wall_left,wall_north,wall_right,wall_south,wall_top,wall_total)
-!$OMP DO
-    DO  i = nxl_mg(l), nxr_mg(l)
-       DO  j = nys_mg(l), nyn_mg(l)
-          DO  k = nzb, nzt_mg(l)
-!
-!--          First, set pressure inside topography to zero
-             p_mg(k,j,i) = p_mg(k,j,i) * ( 1.0_wp - IBITS( flags(k,j,i), 6, 1 ) )
-!
-!--          Second, determine if the grid point inside topography is adjacent to a wall and set its
-!--          value to a value given by the average of those values obtained from Neumann boundary
-!--          condition.
-             wall_left  = IBITS( flags(k,j,i-1), 5, 1 )
-             wall_right = IBITS( flags(k,j,i+1), 4, 1 )
-             wall_south = IBITS( flags(k,j-1,i), 3, 1 )
-             wall_north = IBITS( flags(k,j+1,i), 2, 1 )
-             wall_top   = IBITS( flags(k+1,j,i), 0, 1 )
-             wall_total = wall_left + wall_right + wall_south + wall_north + wall_top
-
-             IF ( wall_total > 0.0_wp )  THEN
-                p_mg(k,j,i) = 1.0_wp / wall_total * ( wall_left  * p_mg(k,j,i-1) +                 &
-                                                      wall_right * p_mg(k,j,i+1) +                 &
-                                                      wall_south * p_mg(k,j-1,i) +                 &
-                                                      wall_north * p_mg(k,j+1,i) +                 &
-                                                      wall_top   * p_mg(k+1,j,i) )
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-!$OMP END PARALLEL
-
-!
-!-- One more time horizontal boundary conditions
-    CALL exchange_horiz( p_mg, 1)
-
-
- END SUBROUTINE redblack_noopt
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Gather subdomain data from all PEs.
-!--------------------------------------------------------------------------------------------------!
-#if defined( __parallel )
- SUBROUTINE mg_gather_noopt( f2, f2_sub )
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  mg_loc_ind,                                                                         &
-               nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !<
-    INTEGER(iwp) ::  il      !<
-    INTEGER(iwp) ::  ir      !<
-    INTEGER(iwp) ::  j       !<
-    INTEGER(iwp) ::  jn      !<
-    INTEGER(iwp) ::  js      !<
-    INTEGER(iwp) ::  k       !<
-    INTEGER(iwp) ::  nwords  !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f2    !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f2_l  !<
-
-    REAL(wp), DIMENSION(nzb:mg_loc_ind(5,myid)+1,mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,        &
-                        mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  f2_sub  !<
-
-
-    CALL cpu_log( log_point_s(34), 'mg_gather_noopt', 'start' )
-
-    f2_l = 0.0_wp
-
-!
-!-- Store the local subdomain array on the total array
-    js = mg_loc_ind(3,myid)
-    IF ( south_border_pe )  js = js - 1
-    jn = mg_loc_ind(4,myid)
-    IF ( north_border_pe )  jn = jn + 1
-    il = mg_loc_ind(1,myid)
-    IF ( left_border_pe )   il = il - 1
-    ir = mg_loc_ind(2,myid)
-    IF ( right_border_pe )  ir = ir + 1
-    DO  i = il, ir
-       DO  j = js, jn
-          DO  k = nzb, nzt_mg(grid_level)+1
-             f2_l(k,j,i) = f2_sub(k,j,i)
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Find out the number of array elements of the total array
-    nwords = SIZE( f2 )
-
-!
-!-- Gather subdomain data from all PEs
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( f2_l(nzb,nys_mg(grid_level)-1,nxl_mg(grid_level)-1),                       &
-                        f2(nzb,nys_mg(grid_level)-1,nxl_mg(grid_level)-1), nwords, MPI_REAL,       &
-                        MPI_SUM, comm2d, ierr )
-
-    CALL cpu_log( log_point_s(34), 'mg_gather_noopt', 'stop' )
-
- END SUBROUTINE mg_gather_noopt
-#endif
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo It may be possible to improve the speed of this routine by using non-blocking communication
-!--------------------------------------------------------------------------------------------------!
-#if defined( __parallel )
- SUBROUTINE mg_scatter_noopt( p2, p2_sub )
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  mg_loc_ind,                                                                         &
-               nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nys_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,  &
-                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  p2  !<
-
-    REAL(wp), DIMENSION(nzb:mg_loc_ind(5,myid)+1,mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,        &
-                        mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  p2_sub  !<
-
-
-    CALL cpu_log( log_point_s(35), 'mg_scatter_noopt', 'start' )
-
-    p2_sub = p2(:,mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,                                       &
-                  mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1)
-
-    CALL cpu_log( log_point_s(35), 'mg_scatter_noopt', 'stop' )
-
- END SUBROUTINE mg_scatter_noopt
-#endif
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This is where the multigrid technique takes place. V- and W- Cycle are implemented and steered by
-!> the parameter "gamma". Parameter "nue" determines the convergence of the multigrid iterative
-!> solution. There are nue times RB-GS iterations. It should be set to "1" or "2", considering the
-!> time effort one would like to invest. Last choice shows a very good converging factor, but leads
-!> to an increase in computing time.
-!--------------------------------------------------------------------------------------------------!
- RECURSIVE SUBROUTINE next_mg_level_noopt( f_mg, p_mg, p3, r )
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_dirrad,                                                                       &
-               bc_lr_raddir,                                                                       &
-               bc_ns_dirrad,                                                                       &
-               bc_ns_raddir,                                                                       &
-               gamma_mg,                                                                           &
-               grid_level_count,                                                                   &
-               maximum_grid_level,                                                                 &
-               mg_switch_to_pe0_level,                                                             &
-               mg_switch_to_pe0,                                                                   &
-               ngsrb
-
-
-    USE indices,                                                                                   &
-        ONLY:  mg_loc_ind,                                                                         &
-               nxl,                                                                                &
-               nxl_mg,                                                                             &
-               nxr,                                                                                &
-               nxr_mg,                                                                             &
-               nys,                                                                                &
-               nys_mg,                                                                             &
-               nyn,                                                                                &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               nzt_mg
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i            !<
-    INTEGER(iwp) ::  j            !<
-    INTEGER(iwp) ::  k            !<
-    INTEGER(iwp) ::  nxl_mg_save  !<
-    INTEGER(iwp) ::  nxr_mg_save  !<
-    INTEGER(iwp) ::  nyn_mg_save  !<
-    INTEGER(iwp) ::  nys_mg_save  !<
-    INTEGER(iwp) ::  nzt_mg_save  !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg  !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg  !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p3    !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
-                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r     !<
-
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,  &
-                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  f2  !<
-    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,  &
-                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  p2  !<
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  f2_sub  !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  p2_sub  !<
-#endif
-
-!
-!-- Restriction to the coarsest grid
- 10 IF ( grid_level == 1 )  THEN
-
-!
-!--    Solution on the coarsest grid. Double the number of Gauss-Seidel iterations in order to get a
-!--    more accurate solution.
-       ngsrb = 2 * ngsrb
-
-       CALL redblack_noopt( f_mg, p_mg )
-
-       ngsrb = ngsrb / 2
-
-
-    ELSEIF ( grid_level /= 1 )  THEN
-
-       grid_level_count(grid_level) = grid_level_count(grid_level) + 1
-
-!
-!--    Solution on the actual grid level
-       CALL redblack_noopt( f_mg, p_mg )
-
-!
-!--    Determination of the actual residual
-       CALL resid_noopt( f_mg, p_mg, r )
-
-!
-!--    Restriction of the residual (finer grid values!) to the next coarser grid. Therefore, the
-!--    grid level has to be decremented now. nxl..nzt have to be set to the coarse grid values,
-!--    because these variables are needed for the exchange of ghost points in routine exchange_horiz
-       grid_level = grid_level - 1
-       nxl = nxl_mg(grid_level)
-       nys = nys_mg(grid_level)
-       nxr = nxr_mg(grid_level)
-       nyn = nyn_mg(grid_level)
-       nzt = nzt_mg(grid_level)
-
-       IF ( grid_level == mg_switch_to_pe0_level )  THEN
-
-!
-!--       From this level on, calculations are done on PE0 only. First, carry out restriction on the
-!--       subdomain. Therefore, indices of the level have to be changed to subdomain values in
-!--       between (otherwise, the restrict routine would expect the gathered array)
-
-          nxl_mg_save = nxl_mg(grid_level)
-          nxr_mg_save = nxr_mg(grid_level)
-          nys_mg_save = nys_mg(grid_level)
-          nyn_mg_save = nyn_mg(grid_level)
-          nzt_mg_save = nzt_mg(grid_level)
-          nxl_mg(grid_level) = mg_loc_ind(1,myid)
-          nxr_mg(grid_level) = mg_loc_ind(2,myid)
-          nys_mg(grid_level) = mg_loc_ind(3,myid)
-          nyn_mg(grid_level) = mg_loc_ind(4,myid)
-          nzt_mg(grid_level) = mg_loc_ind(5,myid)
-          nxl = mg_loc_ind(1,myid)
-          nxr = mg_loc_ind(2,myid)
-          nys = mg_loc_ind(3,myid)
-          nyn = mg_loc_ind(4,myid)
-          nzt = mg_loc_ind(5,myid)
-
-          ALLOCATE( f2_sub(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,     &
-                           nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) )
-
-          CALL restrict_noopt( f2_sub, r )
-
-!
-!--       Restore the correct indices of this level
-          nxl_mg(grid_level) = nxl_mg_save
-          nxr_mg(grid_level) = nxr_mg_save
-          nys_mg(grid_level) = nys_mg_save
-          nyn_mg(grid_level) = nyn_mg_save
-          nzt_mg(grid_level) = nzt_mg_save
-          nxl = nxl_mg(grid_level)
-          nxr = nxr_mg(grid_level)
-          nys = nys_mg(grid_level)
-          nyn = nyn_mg(grid_level)
-          nzt = nzt_mg(grid_level)
-!
-!--       Gather all arrays from the subdomains on PE0
-#if defined( __parallel )
-          CALL mg_gather_noopt( f2, f2_sub )
-#endif
-
-!
-!--       Set switch for routine exchange_horiz, that no ghostpoint exchange has to be carried out
-!--       from now on
-          mg_switch_to_pe0 = .TRUE.
-
-!
-!--       In case of non-cyclic lateral boundary conditions, both in- and outflow conditions have to
-!--       be used on all PEs after the switch, because then they have the total domain.
-          IF ( bc_lr_dirrad )  THEN
-             bc_dirichlet_l  = .TRUE.
-             bc_dirichlet_r  = .FALSE.
-             bc_radiation_l = .FALSE.
-             bc_radiation_r = .TRUE.
-          ELSEIF ( bc_lr_raddir )  THEN
-             bc_dirichlet_l  = .FALSE.
-             bc_dirichlet_r  = .TRUE.
-             bc_radiation_l = .TRUE.
-             bc_radiation_r = .FALSE.
-          ELSEIF ( child_domain  .OR.  nesting_offline )  THEN
-             bc_dirichlet_l = .TRUE.
-             bc_dirichlet_r = .TRUE.
-          ENDIF
-
-          IF ( bc_ns_dirrad )  THEN
-             bc_dirichlet_n  = .TRUE.
-             bc_dirichlet_s  = .FALSE.
-             bc_radiation_n = .FALSE.
-             bc_radiation_s = .TRUE.
-          ELSEIF ( bc_ns_raddir )  THEN
-             bc_dirichlet_n  = .FALSE.
-             bc_dirichlet_s  = .TRUE.
-             bc_radiation_n = .TRUE.
-             bc_radiation_s = .FALSE.
-          ELSEIF ( child_domain  .OR.  nesting_offline )  THEN
-             bc_dirichlet_s = .TRUE.
-             bc_dirichlet_n = .TRUE.
-          ENDIF
-
-          DEALLOCATE( f2_sub )
-
-       ELSE
-
-          CALL restrict_noopt( f2, r )
-
-       ENDIF
-
-       p2 = 0.0_wp
-
-!
-!--    Repeat the same procedure till the coarsest grid is reached
-       CALL next_mg_level_noopt( f2, p2, p3, r )
-
-    ENDIF
-
-!
-!-- Now follows the prolongation
-    IF ( grid_level >= 2 )  THEN
-
-!
-!--    Prolongation of the new residual. The values are transferred from the coarse to the next
-!--    finer grid.
-       IF ( grid_level == mg_switch_to_pe0_level+1 )  THEN
-
-#if defined( __parallel )
-!
-!--       At this level, the new residual first has to be scattered from PE0 to the other PEs
-          ALLOCATE( p2_sub(nzb:mg_loc_ind(5,myid)+1,mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,     &
-                                                    mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) )
-
-          CALL mg_scatter_noopt( p2, p2_sub )
-
-!
-!--       Therefore, indices of the previous level have to be changed to subdomain values in between
-!--       (otherwise, the prolong routine would expect the gathered array)
-          nxl_mg_save = nxl_mg(grid_level-1)
-          nxr_mg_save = nxr_mg(grid_level-1)
-          nys_mg_save = nys_mg(grid_level-1)
-          nyn_mg_save = nyn_mg(grid_level-1)
-          nzt_mg_save = nzt_mg(grid_level-1)
-          nxl_mg(grid_level-1) = mg_loc_ind(1,myid)
-          nxr_mg(grid_level-1) = mg_loc_ind(2,myid)
-          nys_mg(grid_level-1) = mg_loc_ind(3,myid)
-          nyn_mg(grid_level-1) = mg_loc_ind(4,myid)
-          nzt_mg(grid_level-1) = mg_loc_ind(5,myid)
-
-!
-!--       Set switch for routine exchange_horiz, that ghostpoint exchange has to be carried again
-!--       out from now on.
-          mg_switch_to_pe0 = .FALSE.
-
-!
-!--       For non-cyclic lateral boundary conditions and in case of nesting, restore the in-/outflow
-!--       conditions.
-          bc_dirichlet_l = .FALSE.;  bc_dirichlet_r = .FALSE.
-          bc_dirichlet_n = .FALSE.;  bc_dirichlet_s = .FALSE.
-          bc_radiation_l = .FALSE.;  bc_radiation_r = .FALSE.
-          bc_radiation_n = .FALSE.;  bc_radiation_s = .FALSE.
-
-          IF ( pleft == MPI_PROC_NULL )  THEN
-             IF ( bc_lr_dirrad  .OR.  child_domain  .OR.  nesting_offline )  THEN
-                bc_dirichlet_l = .TRUE.
-             ELSEIF ( bc_lr_raddir )  THEN
-                bc_radiation_l = .TRUE.
-             ENDIF
-          ENDIF
-
-          IF ( pright == MPI_PROC_NULL )  THEN
-             IF ( bc_lr_dirrad )  THEN
-                bc_radiation_r = .TRUE.
-             ELSEIF ( bc_lr_raddir  .OR.  child_domain  .OR.  nesting_offline )  THEN
-                bc_dirichlet_r = .TRUE.
-             ENDIF
-          ENDIF
-
-          IF ( psouth == MPI_PROC_NULL )  THEN
-             IF ( bc_ns_dirrad )  THEN
-                bc_radiation_s = .TRUE.
-             ELSEIF ( bc_ns_raddir  .OR.  child_domain  .OR.  nesting_offline )  THEN
-                bc_dirichlet_s = .TRUE.
-             ENDIF
-          ENDIF
-
-          IF ( pnorth == MPI_PROC_NULL )  THEN
-             IF ( bc_ns_dirrad  .OR.  child_domain  .OR.  nesting_offline )  THEN
-                bc_dirichlet_n = .TRUE.
-             ELSEIF ( bc_ns_raddir )  THEN
-                bc_radiation_n = .TRUE.
-             ENDIF
-          ENDIF
-
-          CALL prolong_noopt( p2_sub, p3 )
-
-!
-!--       Restore the correct indices of the previous level
-          nxl_mg(grid_level-1) = nxl_mg_save
-          nxr_mg(grid_level-1) = nxr_mg_save
-          nys_mg(grid_level-1) = nys_mg_save
-          nyn_mg(grid_level-1) = nyn_mg_save
-          nzt_mg(grid_level-1) = nzt_mg_save
-
-          DEALLOCATE( p2_sub )
-#endif
-
-       ELSE
-
-          CALL prolong_noopt( p2, p3 )
-
-       ENDIF
-
-!
-!--    Computation of the new pressure correction. Therefore, values from prior grids are added up
-!--    automatically stage by stage.
-       DO  i = nxl_mg(grid_level)-1, nxr_mg(grid_level)+1
-          DO  j = nys_mg(grid_level)-1, nyn_mg(grid_level)+1
-             DO  k = nzb, nzt_mg(grid_level)+1
-                p_mg(k,j,i) = p_mg(k,j,i) + p3(k,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
-
-!
-!--    Relaxation of the new solution
-       CALL redblack_noopt( f_mg, p_mg )
-
-    ENDIF
-
-
-!
-!-- The following few lines serve the steering of the multigrid scheme
-    IF ( grid_level == maximum_grid_level )  THEN
-
-       GOTO 20
-
-    ELSEIF ( grid_level /= maximum_grid_level  .AND.  grid_level /= 1  .AND.                       &
-             grid_level_count(grid_level) /= gamma_mg )  THEN
-
-       GOTO 10
-
-    ENDIF
-
-!
-!-- Reset counter for the next call of poismg_noopt
-    grid_level_count(grid_level) = 0
-
-!
-!-- Continue with the next finer level. nxl..nzt have to be set to the finer grid values, because
-!-- these variables are needed for the exchange of ghost points in routine exchange_horiz.
-    grid_level = grid_level + 1
-    nxl = nxl_mg(grid_level)
-    nxr = nxr_mg(grid_level)
-    nys = nys_mg(grid_level)
-    nyn = nyn_mg(grid_level)
-    nzt = nzt_mg(grid_level)
-
- 20 CONTINUE
-
- END SUBROUTINE next_mg_level_noopt
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @TODO: Missing subroutine description
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE poismg_noopt_init
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               masking_method,                                                                     &
-               maximum_grid_level,                                                                 &
-               psolver
-
-    USE indices,                                                                                   &
-        ONLY:  flags,                                                                              &
-               nxl_mg,                                                                             &
-               nxr_mg,                                                                             &
-               nyn_mg,                                                                             &
-               nys_mg,                                                                             &
-               nzb,                                                                                &
-               nzt_mg,                                                                             &
-               wall_flags_total_0,                                                                 &
-               wall_flags_1,                                                                       &
-               wall_flags_10,                                                                      &
-               wall_flags_2,                                                                       &
-               wall_flags_3,                                                                       &
-               wall_flags_4,                                                                       &
-               wall_flags_5,                                                                       &
-               wall_flags_6,                                                                       &
-               wall_flags_7,                                                                       &
-               wall_flags_8,                                                                       &
-               wall_flags_9
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i      !< index variable along x
-    INTEGER(iwp) ::  inc    !< incremental parameter for coarsening grid level
-    INTEGER(iwp) ::  j      !< index variable along y
-    INTEGER(iwp) ::  k      !< index variable along z
-    INTEGER(iwp) ::  l      !< loop variable indication current grid level
-    INTEGER(iwp) ::  nxl_l  !< index of left PE boundary for multigrid level
-    INTEGER(iwp) ::  nxr_l  !< index of right PE boundary for multigrid level
-    INTEGER(iwp) ::  nyn_l  !< index of north PE boundary for multigrid level
-    INTEGER(iwp) ::  nys_l  !< index of south PE boundary for multigrid level
-    INTEGER(iwp) ::  nzt_l  !< index of top PE boundary for multigrid level
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  topo_tmp  !<
-
-    IF ( psolver /= 'multigrid_noopt' )  RETURN
-!
-!-- Grid point increment of the current level.
-    inc = 1
-    DO  l = maximum_grid_level, 1 , -1
-!
-!--    Set grid_level as it is required for exchange_horiz_2d_int
-       grid_level = l
-
-       nxl_l = nxl_mg(l)
-       nxr_l = nxr_mg(l)
-       nys_l = nys_mg(l)
-       nyn_l = nyn_mg(l)
-       nzt_l = nzt_mg(l)
-!
-!--    Assign the flag level to be calculated
-       SELECT CASE ( l )
-          CASE ( 1 )
-             flags => wall_flags_1
-          CASE ( 2 )
-             flags => wall_flags_2
-          CASE ( 3 )
-             flags => wall_flags_3
-          CASE ( 4 )
-             flags => wall_flags_4
-          CASE ( 5 )
-             flags => wall_flags_5
-          CASE ( 6 )
-             flags => wall_flags_6
-          CASE ( 7 )
-             flags => wall_flags_7
-          CASE ( 8 )
-             flags => wall_flags_8
-          CASE ( 9 )
-             flags => wall_flags_9
-          CASE ( 10 )
-             flags => wall_flags_10
-       END SELECT
-
-!
-!--    Depending on the grid level, set the respective bits in case of neighbouring walls
-!--    Bit 0:  wall to the bottom
-!--    Bit 1:  wall to the top (not realized in remaining PALM code so far)
-!--    Bit 2:  wall to the south
-!--    Bit 3:  wall to the north
-!--    Bit 4:  wall to the left
-!--    Bit 5:  wall to the right
-!--    Bit 6:  inside building
-
-       flags = 0
-!
-!--    In case of masking method, flags are not set and multigrid method works like FFT-solver
-       IF ( .NOT. masking_method )  THEN
-
-!
-!--       Allocate temporary array for topography heights on coarser grid level. Please note, 2
-!--       ghost points are required, in order to calculate flags() on the interior ghost point.
-          ALLOCATE( topo_tmp(nzb:nzt_l+1,nys_l-1:nyn_l+1,nxl_l-1:nxr_l+1) )
-          topo_tmp = 0
-
-          DO  i = nxl_l, nxr_l
-             DO  j = nys_l, nyn_l
-                DO  k = nzb, nzt_l
-                   topo_tmp(k,j,i) = wall_flags_total_0(k*inc,j*inc,i*inc)
-                ENDDO
-             ENDDO
-          ENDDO
-          topo_tmp(nzt_l+1,:,:) = topo_tmp(nzt_l,:,:)
-!
-!--       Exchange ghost points on respective multigrid level. 2 ghost points are required, in order
-!--       to calculate flags on.
-!--       nys_l-1 / nyn_l+1 / nxl_l-1 / nxr_l+1.
-          CALL exchange_horiz_int( topo_tmp, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, 1 )
-!
-!--       Set non-cyclic boundary conditions on respective multigrid level
-          IF ( .NOT. bc_ns_cyc )  THEN
-             IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-!                 topo_tmp(:,-2,:) = topo_tmp(:,0,:)
-                topo_tmp(:,-1,:) = topo_tmp(:,0,:)
-             ENDIF
-             IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-!                 topo_tmp(:,nyn_l+2,:) = topo_tmp(:,nyn_l,:)
-                topo_tmp(:,nyn_l+1,:) = topo_tmp(:,nyn_l,:)
-             ENDIF
-          ENDIF
-          IF ( .NOT. bc_lr_cyc )  THEN
-             IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-!                 topo_tmp(:,:,-2) = topo_tmp(:,:,0)
-                topo_tmp(:,:,-1) = topo_tmp(:,:,0)
-             ENDIF
-             IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-!                 topo_tmp(:,:,nxr_l+2) = topo_tmp(:,:,nxr_l)
-                topo_tmp(:,:,nxr_l+1) = topo_tmp(:,:,nxr_l)
-             ENDIF
-          ENDIF
-
-          DO  i = nxl_l, nxr_l
-             DO  j = nys_l, nyn_l
-                DO  k = nzb, nzt_l
-!
-!--                Inside/outside building (inside building does not need further tests for walls)
-                   IF ( .NOT. BTEST( topo_tmp(k,j,i), 0 ) )  THEN
-
-                      flags(k,j,i) = IBSET( flags(k,j,i), 6 )
-
-                   ELSE
-!
-!--                   Bottom wall
-                      IF ( .NOT. BTEST( topo_tmp(k-1,j,i), 0 ) )  THEN
-                         flags(k,j,i) = IBSET( flags(k,j,i), 0 )
-                      ENDIF
-!
-!--                   South wall
-                      IF ( .NOT. BTEST( topo_tmp(k,j-1,i), 0 ) )  THEN
-                         flags(k,j,i) = IBSET( flags(k,j,i), 2 )
-                      ENDIF
-!
-!--                   North wall
-                      IF ( .NOT. BTEST( topo_tmp(k,j+1,i), 0 ) )  THEN
-                         flags(k,j,i) = IBSET( flags(k,j,i), 3 )
-                      ENDIF
-!
-!--                   Left wall
-                      IF ( .NOT. BTEST( topo_tmp(k,j,i-1), 0 ) )  THEN
-                         flags(k,j,i) = IBSET( flags(k,j,i), 4 )
-                      ENDIF
-!
-!--                   Right wall
-                      IF ( .NOT. BTEST( topo_tmp(k,j,i+1), 0 ) )  THEN
-                         flags(k,j,i) = IBSET( flags(k,j,i), 5 )
-                      ENDIF
-!
-!--                   Top wall
-                      IF ( .NOT. BTEST( topo_tmp(k+1,j,i), 0 ) )  THEN
-                         flags(k,j,i) = IBSET( flags(k,j,i), 7 )
-                      ENDIF
-
-                   ENDIF
-
-                ENDDO
-             ENDDO
-          ENDDO
-          flags(nzt_l+1,:,:) = flags(nzt_l,:,:)
-
-          CALL exchange_horiz_int( flags, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, 1 )
-
-          DEALLOCATE( topo_tmp )
-
-       ENDIF
-
-       inc = inc * 2
-
-    ENDDO
-!
-!-- Reset grid_level to "normal" grid
-    grid_level = 0
-
- END SUBROUTINE poismg_noopt_init
-
- END MODULE poismg_noopt_mod
Index: palm/trunk/SOURCE/posix_interface_mod.f90
===================================================================
--- palm/trunk/SOURCE/posix_interface_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,745 +1,0 @@
-!> @file posix_interface_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Routine fortran_sleep moved from old module posix_calls_from_fortran to here
-!
-! 4649 2020-08-25 12:11:17Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4628 2020-07-29 07:23:03Z raasch
-! Extensions required for MPI-I/O of particle data to restart files
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! Initial version (K. Ketelsen)
-!
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interface to some POSIX system calls, mainly used for read/write of restart files in non-parallel
-!> mode in MPI-IO compatible format.
-!--------------------------------------------------------------------------------------------------!
- MODULE posix_interface
-
-    USE ISO_C_BINDING
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    PRIVATE
-
-    SAVE
-
-!
-!-- Definitions copied from C include file fcntl.h
-    INTEGER, PARAMETER ::  o_creat  = 64  !< 0100 octal
-    INTEGER, PARAMETER ::  o_rdonly =  0  !<
-    INTEGER, PARAMETER ::  o_rdwr   =  2  !<
-    INTEGER, PARAMETER ::  o_wronly =  1  !<
-    INTEGER, PARAMETER ::  seek_set =  0  !<
-
-
-!
-!-- Interfaces for POSIX calls
-    INTERFACE
-       INTEGER(C_INT)  FUNCTION C_OPEN( pathname, flags, mode )  BIND( C, NAME = 'open' )
-          USE ISO_C_BINDING
-          IMPLICIT NONE
-          CHARACTER(KIND=C_CHAR), DIMENSION(128) ::  pathname  !<
-          INTEGER(KIND=C_INT), VALUE             ::  flags     !<
-          INTEGER(KIND=C_INT), VALUE             ::  mode      !<
-       END FUNCTION C_OPEN
-    END INTERFACE
-
-   INTERFACE
-      INTEGER(C_SIZE_T)  FUNCTION C_LSEEK( fd, offset, whence )  BIND( C, NAME = 'lseek' )
-         USE ISO_C_BINDING
-         IMPLICIT NONE
-         INTEGER(KIND=C_INT), VALUE    ::  fd      !<
-         INTEGER(KIND=C_SIZE_T), VALUE ::  offset  !<
-         INTEGER(KIND=C_INT), VALUE    ::  whence  !<
-      END FUNCTION C_LSEEK
-   END INTERFACE
-
-!
-!-- The read system call uses values of type off_t. There is no Fortran C_OFF_T, therefore  C_SIZE_T
-!-- has been used here, assuming both are 8 byte integers.
-    INTERFACE
-       INTEGER(C_SIZE_T)  FUNCTION C_READ( fd, buf, nr_byte )  BIND(C, NAME = 'read' )
-          USE ISO_C_BINDING
-          IMPLICIT NONE
-          INTEGER(KIND=C_INT), VALUE    ::  fd       !<
-          INTEGER(KIND=C_SIZE_T), VALUE ::  nr_byte  !<
-          TYPE(C_PTR), VALUE            ::  buf      !<
-          END FUNCTION C_READ
-    END INTERFACE
-
-    INTERFACE
-       INTEGER(C_SIZE_T)  FUNCTION C_WRITE( fd, buf, nr_byte )  BIND( C, NAME = 'write' )
-          USE ISO_C_BINDING
-          IMPLICIT NONE
-          INTEGER(KIND=C_INT), VALUE    ::  fd       !<
-          INTEGER(KIND=C_SIZE_T), VALUE ::  nr_byte  !<
-          TYPE(C_PTR), VALUE            ::  buf      !<
-       END FUNCTION C_WRITE
-    END INTERFACE
-
-    INTERFACE
-       INTEGER(C_INT)  FUNCTION C_CLOSE( fd )  BIND( C, NAME = 'close' )
-          USE ISO_C_BINDING
-          IMPLICIT NONE
-          INTEGER(KIND=C_INT), VALUE ::  fd  !<
-       END FUNCTION C_CLOSE
-    END INTERFACE
-
-!
-!-- Sleep function from C library
-    INTERFACE
-       FUNCTION fsleep( seconds )  BIND( C, NAME = 'sleep' )
-          IMPORT
-          INTEGER(C_INT)                    ::  fsleep   !<
-          INTEGER(C_INT), INTENT(IN), VALUE ::  seconds  !<
-       END FUNCTION fsleep
-    END INTERFACE
-
-!
-!-- PALM interfaces
-    INTERFACE fortran_sleep
-       MODULE PROCEDURE fortran_sleep
-    END INTERFACE fortran_sleep
-
-    INTERFACE posix_close
-       MODULE PROCEDURE posix_close
-    END INTERFACE posix_close
-
-    INTERFACE posix_lseek
-       MODULE PROCEDURE posix_lseek
-    END INTERFACE posix_lseek
-
-    INTERFACE posix_open
-       MODULE PROCEDURE posix_open
-    END INTERFACE posix_open
-
-    INTERFACE posix_read
-       MODULE PROCEDURE posix_read
-       MODULE PROCEDURE posix_read_char_array
-       MODULE PROCEDURE posix_read_int_1d
-       MODULE PROCEDURE posix_read_int_2d
-       MODULE PROCEDURE posix_read_i4_3d
-       MODULE PROCEDURE posix_read_i8_3d
-       MODULE PROCEDURE posix_read_offset_1d
-       MODULE PROCEDURE posix_read_real_1d
-       MODULE PROCEDURE posix_read_real_2d
-       MODULE PROCEDURE posix_read_real_3d
-    END INTERFACE posix_read
-
-    INTERFACE posix_write
-       MODULE PROCEDURE posix_write
-       MODULE PROCEDURE posix_write_char_array
-       MODULE PROCEDURE posix_write_int_1d
-       MODULE PROCEDURE posix_write_int_2d
-       MODULE PROCEDURE posix_write_i4_3d
-       MODULE PROCEDURE posix_write_i8_3d
-       MODULE PROCEDURE posix_write_offset_1d
-       MODULE PROCEDURE posix_write_real_1d
-       MODULE PROCEDURE posix_write_real_2d
-       MODULE PROCEDURE posix_write_real_3d
-    END INTERFACE posix_write
-
-    PUBLIC fortran_sleep,                                                                          &
-           posix_close,                                                                            &
-           posix_lseek,                                                                            &
-           posix_open,                                                                             &
-           posix_read,                                                                             &
-           posix_write
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Wait a specified amount of seconds
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE fortran_sleep( seconds )
-
-    INTEGER, INTENT(IN) ::  seconds             !< seconds to wait
-
-    INTEGER(C_INT)      ::  seconds_in_c        !< same as seconds
-    INTEGER(C_INT)      ::  sleep_return_value  !< returned value to sleep
-
-    seconds_in_c = seconds
-
-    sleep_return_value = fsleep( seconds_in_c )
-
- END SUBROUTINE fortran_sleep
-
-
- INTEGER FUNCTION posix_open( file_name, rd_flag )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)            ::  file_name     !<
-    CHARACTER(LEN=1), DIMENSION(:), POINTER ::  f_string      !<
-    CHARACTER(LEN=128), TARGET              ::  lo_file_name  !<
-
-    INTEGER(C_INT)                          ::  fd            !<
-    INTEGER(C_INT)                          ::  flags         !<
-    INTEGER(C_INT)                          ::  name_len      !<
-    INTEGER(C_INT)                          ::  mode          !<
-    INTEGER, DIMENSION(1)                   ::  bufshape      !<
-
-    LOGICAL, INTENT(IN)                     ::  rd_flag       !<
-
-    TYPE(C_PTR)                             ::  ptr           !<
-
-
-!
-!-- Note: There might be better solutions to convert FORTRAN string to C string but this works on
-!-- different FORTRAN compiler
-    name_len     = LEN( TRIM( file_name ) ) + 1
-    lo_file_name = TRIM( file_name ) // CHAR( 0 )
-    ptr          = C_LOC( lo_file_name(1:1) )
-    bufshape(1)  = name_len
-    CALL C_F_POINTER( ptr, f_string, bufshape )
-
-    mode = 420  ! Mode 644
-
-    IF ( rd_flag )  THEN
-       flags = o_rdonly
-       fd    = C_OPEN( f_string, flags, mode )  ! Open for reading
-    ELSE
-       flags = o_wronly + o_creat
-       fd    = C_OPEN( f_string, flags, mode )  ! Open for writing
-    ENDIF
-
-    posix_open = fd
-
- END FUNCTION posix_open
-
-
-
- SUBROUTINE posix_lseek( fid, offset )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN)                ::  fid     !<
-    INTEGER(KIND=C_INT)                ::  my_fid  !<
-    INTEGER(KIND=C_SIZE_T), INTENT(IN) ::  offset  !<
-    INTEGER(KIND=C_SIZE_T)             ::  retval  !<
-    INTEGER(KIND=C_INT)                ::  whence  !<
-
-
-    my_fid = fid
-    whence = seek_set
-
-    retval = C_LSEEK( my_fid, offset, whence )
-
- END SUBROUTINE posix_lseek
-
-
-
- SUBROUTINE posix_read_int_1d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                             ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                 ::  fid      !<
-    INTEGER, INTENT(IN)                                 ::  nw       !<
-    INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:) ::  data     !<
-    TYPE(C_PTR)                                         ::  buf      !<
-
-
-    nr_byte = nw*iwp
-    buf     = C_LOC( data )
-
-    CALL posix_read( fid, buf, nr_byte )
-
- END SUBROUTINE posix_read_int_1d
-
-
-
- SUBROUTINE posix_read_int_2d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                               ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                   ::  fid      !<
-    INTEGER, INTENT(IN)                                   ::  nw       !<
-    INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:,:) ::  data     !<
-    TYPE(C_PTR)                                           ::  buf      !<
-
-
-    nr_byte = nw * iwp
-    buf     = C_LOC( data )
-
-    CALL posix_read( fid, buf, nr_byte )
-
- END SUBROUTINE posix_read_int_2d
-
-
-
- SUBROUTINE posix_read_i4_3d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                                 ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                     ::  fid      !<
-    INTEGER, INTENT(IN)                                     ::  nw       !<
-    INTEGER(KIND=isp), INTENT(IN), TARGET, DIMENSION(:,:,:) ::  data     !<
-    TYPE(C_PTR)                                             ::  buf      !<
-
-
-    nr_byte = nw * isp
-    buf     = C_LOC( data )
-
-    CALL posix_read( fid, buf, nr_byte )
-
- END SUBROUTINE posix_read_i4_3d
-
-
-
- SUBROUTINE posix_read_i8_3d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                                 ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                     ::  fid      !<
-    INTEGER, INTENT(IN)                                     ::  nw       !<
-    INTEGER(KIND=idp), INTENT(IN), TARGET, DIMENSION(:,:,:) ::  data     !<
-    TYPE(C_PTR)                                             ::  buf      !<
-
-
-    nr_byte = nw * idp
-    buf     = C_LOC( data )
-
-    CALL posix_read( fid, buf, nr_byte )
-
- END SUBROUTINE posix_read_i8_3d
-
-
-
- SUBROUTINE posix_read_offset_1d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                                  ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                      ::  fid      !<
-    INTEGER, INTENT(IN)                                      ::  nw       !<
-    INTEGER(KIND=C_SIZE_T), INTENT(IN), TARGET, DIMENSION(:) ::  data     !<
-    TYPE(C_PTR)                                              ::  buf      !<
-
-
-    nr_byte = nw * C_SIZE_T
-    buf     = C_LOC( data )
-
-    CALL posix_read( fid, buf, nr_byte )
-
- END SUBROUTINE posix_read_offset_1d
-
-
-
- SUBROUTINE posix_read_real_1d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                         ::  nr_byte  !<
-    INTEGER, INTENT(IN)                             ::  fid      !<
-    INTEGER, INTENT(IN)                             ::  nw       !<
-
-    REAL(KIND=wp), INTENT(IN), TARGET, DIMENSION(:) ::  data     !<
-
-    TYPE(C_PTR)                                     ::  buf      !<
-
-
-    nr_byte = nw * wp
-    buf     = C_LOC( data )
-
-    CALL posix_read( fid, buf, nr_byte )
-
- END SUBROUTINE posix_read_real_1d
-
-
-
- SUBROUTINE posix_read_real_2d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                              ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                  ::  fid      !<
-    INTEGER, INTENT(IN)                                  ::  nw       !<
-
-    REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:) ::  data     !<
-
-    TYPE(C_PTR)                                          ::  buf      !<
-
-
-    nr_byte = nw * wp
-    buf     = C_LOC( data )
-
-    CALL posix_read( fid, buf, nr_byte )
-
- END SUBROUTINE posix_read_real_2d
-
-
-
- SUBROUTINE posix_read_real_3d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                                ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                    ::  fid      !<
-    INTEGER, INTENT(IN)                                    ::  nw       !<
-
-    REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:,:) ::  data     !<
-
-    TYPE(C_PTR)                                            ::  buf      !<
-
-
-    nr_byte = nw * wp
-    buf     = C_LOC( data )
-
-    CALL posix_read( fid, buf, nr_byte )
-
- END SUBROUTINE posix_read_real_3d
-
-
-
- SUBROUTINE posix_read( fid, buf, nb )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN)    ::  fid      !<
-    INTEGER , INTENT(IN)   ::  nb       !<
-    INTEGER(KIND=C_INT)    ::  my_fid   !<
-    INTEGER(KIND=C_SIZE_T) ::  nr_byte  !<
-    INTEGER(KIND=C_SIZE_T) ::  retval   !<
-
-    TYPE(C_PTR)            ::  buf      !<
-
-
-    my_fid  = fid
-    nr_byte = nb
-
-    retval = C_READ( my_fid, buf, nr_byte )
-
-!
-!-- The posix standard says that it is not guaranteed that all bytes are read in one read system
-!-- call. If retval is not equal to nr_byte, another system call has to be issued.
-!-- However, in all Unix distributions it is commonly accepted, that all bytes are read in one call
-!-- during during disk-IO. Therefore, here is only an error query and no reading in a while loop.
-    IF ( retval /= nr_byte )  THEN
-        WRITE( 6, * ) 'Number of bytes read does not match the number of requested bytes'
-        CALL abort
-    ENDIF
-
- END SUBROUTINE posix_read
-
-
-
- SUBROUTINE posix_read_char_array( fid, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), DIMENSION(:)   ::  data      !<
-    CHARACTER(LEN=LEN(data)), TARGET ::  data_buf  !<
-
-    INTEGER                          ::  i         !<
-    INTEGER, INTENT(IN)              ::  fid       !<
-    INTEGER(KIND=C_INT)              ::  my_fid    !<
-    INTEGER(KIND=C_SIZE_T)           ::  name_len  !<
-    INTEGER(KIND=C_SIZE_T)           ::  retval    !<
-
-    TYPE(C_PTR)                      ::  ptr       !<
-
-
-    my_fid  = fid
-
-    DO  i = 1, SIZE( data )
-       data_buf = data(i)
-       name_len = LEN( data(i) )
-       ptr      = C_LOC( data_buf(1:1) )
-       retval   = C_READ( my_fid, ptr, name_len )
-       data(i)  = data_buf
-    ENDDO
-
- END SUBROUTINE posix_read_char_array
-
-
-
- SUBROUTINE posix_write_int_1d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN)                                 ::  fid      !<
-    INTEGER ,INTENT(IN)                                 ::  nw       !<
-    INTEGER(KIND=C_INT)                                 ::  my_fid   !<
-    INTEGER(KIND=C_SIZE_T)                              ::  nr_byte  !<
-    INTEGER(KIND=C_SIZE_T)                              ::  retval   !<
-
-    INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:) ::  data     !<
-
-    TYPE(C_PTR)                                         ::  buf      !<
-
-
-    my_fid  = fid
-    nr_byte = nw * iwp
-    buf     = C_LOC( data )
-
-    retval = C_WRITE( my_fid, buf, nr_byte )
-
- END SUBROUTINE posix_write_int_1d
-
-
-
- SUBROUTINE posix_write_int_2d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                               ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                   ::  fid      !<
-    INTEGER, INTENT(IN)                                   ::  nw       !<
-
-    INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:,:) ::  data     !<
-
-    TYPE(C_PTR)                                           :: buf       !<
-
-
-    nr_byte = nw * iwp
-    buf     = C_LOC( data )
-
-    CALL posix_write( fid, buf, nr_byte )
-
- END SUBROUTINE posix_write_int_2d
-
-
-
- SUBROUTINE posix_write_i4_3d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                                 ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                     ::  fid      !<
-    INTEGER, INTENT(IN)                                     ::  nw       !<
-
-    INTEGER(KIND=isp), INTENT(IN), TARGET, DIMENSION(:,:,:) ::  data     !<
-
-    TYPE(C_PTR)                                             ::  buf      !<
-
-
-    nr_byte = nw * isp
-    buf     = C_LOC( data )
-
-    CALL posix_write( fid, buf, nr_byte )
-
- END SUBROUTINE posix_write_i4_3d
-
-
-
- SUBROUTINE posix_write_i8_3d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                                 ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                     ::  fid      !<
-    INTEGER, INTENT(IN)                                     ::  nw       !<
-
-    INTEGER(KIND=idp), INTENT(IN), TARGET, DIMENSION(:,:,:) ::  data     !<
-
-    TYPE(C_PTR)                                             ::  buf      !<
-
-
-    nr_byte = nw * idp
-    buf     = C_LOC( data )
-
-    CALL posix_write( fid, buf, nr_byte )
-
- END SUBROUTINE posix_write_i8_3d
-
-
-
- SUBROUTINE posix_write_offset_1d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                                  ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                      ::  fid      !<
-    INTEGER, INTENT(IN)                                      ::  nw       !<
-
-    INTEGER(KIND=C_SIZE_T), INTENT(IN), TARGET, DIMENSION(:) ::  data     !<
-
-    TYPE(C_PTR)                                              ::  buf      !<
-
-
-    nr_byte = nw * STORAGE_SIZE( data(1) ) / 8
-    buf     = C_LOC( data )
-
-    CALL posix_write(fid, buf, nr_byte )
-
- END SUBROUTINE posix_write_offset_1d
-
-
-
- SUBROUTINE posix_write_real_1d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                         ::  nr_byte   !<
-    INTEGER, INTENT(IN)                             ::  fid       !<
-    INTEGER, INTENT(IN)                             ::  nw        !<
-
-    REAL(KIND=wp), INTENT(IN), TARGET, DIMENSION(:) ::  data      !<
-
-    TYPE(C_PTR)                                     ::  buf       !<
-
-
-    nr_byte = nw * wp
-    buf     = C_LOC( data )
-
-    CALL posix_write( fid, buf, nr_byte )
-
- END SUBROUTINE posix_write_real_1d
-
-
-
- SUBROUTINE posix_write_real_2d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                              ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                  ::  fid      !<
-    INTEGER, INTENT(IN)                                  ::  nw       !<
-
-    REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:) ::  data     !<
-
-    TYPE(C_PTR)                                          ::  buf      !<
-
-
-    nr_byte = nw * wp
-    buf     = C_LOC( data )
-
-    CALL posix_write( fid, buf, nr_byte )
-
- END SUBROUTINE posix_write_real_2d
-
-
-
- SUBROUTINE posix_write_real_3d( fid, data, nw )
-
-    IMPLICIT NONE
-
-    INTEGER                                                ::  nr_byte  !<
-    INTEGER, INTENT(IN)                                    ::  fid      !<
-    INTEGER, INTENT(IN)                                    ::  nw       !<
-
-    REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:,:) ::  data     !<
-
-    TYPE(C_PTR)                                            ::  buf      !<
-
-
-    nr_byte = nw * wp
-    buf     = C_LOC( data )
-
-    CALL posix_write( fid, buf, nr_byte )
-
- END SUBROUTINE posix_write_real_3d
-
-
-
- SUBROUTINE posix_write( fid, buf, nb )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN)    ::  fid      !<
-    INTEGER , INTENT(IN)   ::  nb       !<
-    INTEGER(KIND=C_INT)    ::  my_fid   !<
-    INTEGER(KIND=C_SIZE_T) ::  nr_byte  !<
-    INTEGER(KIND=C_SIZE_T) ::  retval   !<
-
-    TYPE(C_PTR)            ::  buf      !<
-
-
-    my_fid  = fid
-    nr_byte = nb
-
-    retval = C_WRITE( my_fid, buf, nr_byte )
-
-    IF ( retval /= nr_byte )  THEN
-       WRITE( 6, * ) 'Number of bytes to write does not match the number of requested bytes'
-       CALL abort
-    ENDIF
-
- END SUBROUTINE posix_write
-
-
-
- SUBROUTINE posix_write_char_array( fid, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), DIMENSION(:)     ::  data      !<
-    CHARACTER(LEN=LEN(data)+1), TARGET ::  data_buf  !<
-
-    INTEGER                            ::  i         !<
-    INTEGER, INTENT(IN)                ::  fid       !<
-    INTEGER(KIND=C_INT)                ::  my_fid    !<
-    INTEGER(KIND=C_SIZE_T)             ::  name_len  !<
-    INTEGER(KIND=C_SIZE_T)             ::  retval    !<
-
-    TYPE(C_PTR)                        ::  ptr       !<
-
-
-    my_fid  = fid
-
-    DO  i = 1, SIZE( data )
-       data_buf = data(i) // CHAR( 0 )
-       name_len = LEN( data(i) )
-       ptr      = C_LOC( data_buf(1:1) )
-       retval   = C_WRITE( my_fid, ptr, name_len )
-    ENDDO
-
- END SUBROUTINE posix_write_char_array
-
-
-
- SUBROUTINE posix_close( fid )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN) ::  fid     !<
-    INTEGER(KIND=C_INT) ::  my_fid  !<
-    INTEGER(KIND=C_INT) ::  retval  !<
-
-
-    my_fid = fid
-
-    retval = C_CLOSE( my_fid )
-
- END SUBROUTINE posix_close
-
-
- END MODULE posix_interface
Index: palm/trunk/SOURCE/prandtl_fluxes.f90
===================================================================
--- palm/trunk/SOURCE/prandtl_fluxes.f90	(revision 1)
+++ palm/trunk/SOURCE/prandtl_fluxes.f90	(revision 1)
@@ -0,0 +1,428 @@
+ SUBROUTINE prandtl_fluxes
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: prandtl_fluxes.f90,v $
+! Revision 1.19  2006/04/26 12:24:35  raasch
+! +OpenMP directives and optimization (array assignments replaced by DO loops)
+!
+! Revision 1.18  2006/02/23 12:49:32  raasch
+! shf, ts, rif, us, usws, vsws, qs and qsws are now defined at the actual
+! surface of the model domain, i.e. either at the bottom or at the height
+! of the topography. Thus, zu(1) is replaced
+! by zp = ( zu(nzb_[variable]_inner(j,i)+1 - zw(nzb_[variable]_inner(j,i) ),
+! [variable](1,j,i) by [variable](nzb_[variable]_inner(j,i)+1,j,i) and
+! [variable](0,j,i) by [variable](nzb_[variable]_inner(j,i)  ,j,i).
+!
+! Revision 1.17  2004/04/30 12:43:50  raasch
+! rif_m replaced by rif (they are the same when used here)
+!
+! Revision 1.16  2003/11/20 15:13:26  raasch
+! Variable name (B) changed from capital to small
+!
+! Revision 1.15  2001/03/30 07:46:47  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.14  2001/01/29 12:33:38  raasch
+! Passive scalar is considered
+!
+! Revision 1.13  2001/01/25 07:23:22  raasch
+! Range of ts is limited, since otherwise overflow may occur on REAL*4
+! machines
+!
+! Revision 1.11  2001/01/22 07:50:34  raasch
+! Module test_variables removed
+!
+! Revision 1.10  2000/04/13 13:44:41  schroeter
+! + implentation of the Prandtl layer for the total water content
+!
+! Revision 1.9  2000/01/26  14:48:48  14:48:48  letzel (Marcus Letzel)
+! correct wrong time level of rif in computation of theta*,
+! all comments translated into English
+! 
+! Revision 1.8  1998/09/22 17:27:15  raasch
+! Testweise Randbedingung fuer TKE mit cm = 0.4, aber vorerst auskommentiert
+!
+! Revision 1.7  1998/08/05 06:54:23  raasch
+! Begrenzung von rif ist jetzt variabel (rif_max, rif_min)
+!
+! Revision 1.6  1998/07/06 12:30:01  raasch
+! + USE test_variables
+!
+! Revision 1.5  1998/04/15 11:22:58  raasch
+! Berechnung von theta* ueber Oberflaechentemperatur moeglich
+!
+! Revision 1.4  1998/03/11 11:53:22  raasch
+! Zusaetzliche untere Randbedingung fuer TKE ( (u*/0.1)**2 )
+!
+! Revision 1.3  1998/02/10 15:08:53  raasch
+! Grenzfall bei labiler Schichtung ( a=1, b=1 ) wird stabil gerechnet
+! Begrenzung von rif aktiviert
+!
+! Revision 1.2  1998/02/04 16:09:29  raasch
+! Berechnung der Waermefluesse
+!
+! Revision 1.1  1998/01/23 10:06:06  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Diagnostic computation of vertical fluxes in the Prandtl layer from the
+! values of the variables at grid point k=1
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE grid_variables
+    USE indices
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k
+    REAL    ::  a, b, rifm, uv_total, z_p
+
+!
+!-- Compute theta*
+    IF ( constant_heatflux )  THEN
+!
+!--    For a given heat flux in the Prandtl layer:
+!--    for u* use the value from the previous time step
+       !$OMP PARALLEL DO
+       DO  i = nxl-1, nxr+1
+          DO  j = nys-1, nyn+1
+             ts(j,i) = -shf(j,i) / ( us(j,i) + 1E-30 )
+!
+!--          ts must be limited, because otherwise overflow may occur in case of
+!--          us=0 when computing rif further below
+             IF ( ts(j,i) < -1.05E5 )  ts = -1.0E5
+             IF ( ts(j,i) >   1.0E5 )  ts =  1.0E5
+          ENDDO
+       ENDDO
+
+    ELSE
+!
+!--    For a given surface temperature:
+!--    (the Richardson number is still the one from the previous time step)
+       !$OMP PARALLEL DO PRIVATE( a, b, k, z_p )
+       DO  i = nxl-1, nxr+1
+          DO  j = nys-1, nyn+1
+
+             k   = nzb_s_inner(j,i)
+             z_p = zu(k+1) - zw(k)
+
+             IF ( rif(j,i) >= 0.0 )  THEN
+!
+!--             Stable stratification
+                ts(j,i) = kappa * ( pt(k+1,j,i) - pt(k,j,i) ) / (          &
+                                  LOG( z_p / z0(j,i) ) +                   &
+                                  5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+                                                                )
+             ELSE
+!
+!--             Unstable stratification
+                a = SQRT( 1.0 - 16.0 * rif(j,i) )
+                b = SQRT( 1.0 - 16.0 * rif(j,i) / z_p * z0(j,i) )
+!
+!--             If a borderline case occurs, the formula for stable
+!--             stratification must be used anyway, or else a zero division
+!--             would occur in the argument of the logarithm
+                IF ( a == 1.0  .OR.  b == 1.0 )  THEN
+                   ts(j,i) = kappa * ( pt(k+1,j,i) - pt(k,j,i) ) / (          &
+                                     LOG( z_p / z0(j,i) ) +                   &
+                                     5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+                                                                   )
+                ELSE
+                   ts(j,i) = kappa * ( pt(k+1,j,i) - pt(k,j,i) ) / (          &
+                                 LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) &
+                                                                   )
+                ENDIF
+             ENDIF
+
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Compute z_p/L (corresponds to the Richardson-flux number)
+    IF ( .NOT. moisture ) THEN
+       !$OMP PARALLEL DO PRIVATE( k, z_p )
+       DO  i = nxl-1, nxr+1
+          DO  j = nys-1, nyn+1
+             k   = nzb_s_inner(j,i)
+             z_p = zu(k+1) - zw(k)
+             rif(j,i) = z_p * kappa * g * ts(j,i) / &
+                        ( pt(k+1,j,i) * ( us(j,i)**2 + 1E-30 ) )
+!
+!--          Limit the value range of the Richardson numbers.
+!--          This is necessary for very small velocities (u,v --> 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 ( rif(j,i) < rif_min )  rif(j,i) = rif_min
+             IF ( rif(j,i) > rif_max )  rif(j,i) = rif_max
+          ENDDO
+       ENDDO
+    ELSE
+       !$OMP PARALLEL DO PRIVATE( k, z_p )
+       DO  i = nxl-1, nxr+1
+          DO  j = nys-1, nyn+1
+             k   = nzb_s_inner(j,i)
+             z_p = zu(k+1) - zw(k)
+             rif(j,i) = z_p * kappa * g *                            &
+                        ( ts(j,i) + 0.61 * pt(k+1,j,i) * qs(j,i) ) / &
+                        ( vpt(k+1,j,i) * ( us(j,i)**2 + 1E-30 ) )
+!
+!--          Limit the value range of the Richardson numbers.
+!--          This is necessary for very small velocities (u,v --> 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 ( rif(j,i) < rif_min )  rif(j,i) = rif_min
+             IF ( rif(j,i) > rif_max )  rif(j,i) = rif_max
+          ENDDO
+       ENDDO       
+    ENDIF
+
+!
+!-- Compute u* at the scalars' grid points
+    !$OMP PARALLEL DO PRIVATE( a, b, k, uv_total, z_p )
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+
+          k   = nzb_s_inner(j,i)
+          z_p = zu(k+1) - zw(k)
+
+!
+!--       Compute the absolute value of the horizontal velocity
+          uv_total = SQRT( ( 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) ) )**2 + &
+                           ( 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) ) )**2   &
+                         )
+
+          IF ( rif(j,i) >= 0.0 )  THEN
+!
+!--          Stable stratification
+             us(j,i) = kappa * uv_total / (                                &
+                                  LOG( z_p / z0(j,i) ) +                   &
+                                  5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+                                          )
+          ELSE
+!
+!--          Unstable stratification
+             a = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
+             b = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) / z_p * z0(j,i) ) )
+!
+!--          If a borderline case occurs, the formula for stable stratification
+!--          must be used anyway, or else a zero division would occur in the 
+!--          argument of the logarithm.
+             IF ( a == 1.0  .OR.  b == 1.0 )  THEN
+                us(j,i) = kappa * uv_total / (                                &
+                                     LOG( z_p / z0(j,i) ) +                   &
+                                     5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+                                             )
+             ELSE
+                us(j,i) = kappa * uv_total / (                               &
+                              LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) + &
+                              2.0 * ( ATAN( b ) - ATAN( a ) )                &
+                                             )
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+
+!
+!-- Compute u'w' for the total model domain.
+!-- First compute the corresponding component of u* and square it.
+    !$OMP PARALLEL DO PRIVATE( a, b, k, rifm, z_p )
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+
+          k   = nzb_u_inner(j,i)
+          z_p = zu(k+1) - zw(k)
+
+!
+!--       Compute Richardson-flux number for this point
+          rifm = 0.5 * ( rif(j,i-1) + rif(j,i) )
+          IF ( rifm >= 0.0 )  THEN
+!
+!--          Stable stratification
+             usws(j,i) = kappa * u(k+1,j,i) / (                           &
+                                     LOG( z_p / z0(j,i) ) +               &
+                                     5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
+                                              )
+          ELSE
+!
+!--          Unstable stratification
+             a = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifm ) )
+             b = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifm / z_p * z0(j,i) ) )
+!
+!--          If a borderline case occurs, the formula for stable stratification
+!--          must be used anyway, or else a zero division would occur in the 
+!--          argument of the logarithm. 
+             IF ( a == 1.0  .OR.  B == 1.0 )  THEN
+                usws(j,i) = kappa * u(k+1,j,i) / (                           &
+                                        LOG( z_p / z0(j,i) ) +               &
+                                        5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
+                                                 )
+             ELSE
+                usws(j,i) = kappa * u(k+1,j,i) / (                           &
+                              LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) + &
+                              2.0 * ( ATAN( b ) - ATAN( a ) )                &
+                                                 )
+             ENDIF
+          ENDIF
+          usws(j,i) = -usws(j,i) * ABS( usws(j,i) )
+       ENDDO
+    ENDDO
+
+!
+!-- Compute v'w' for the total model domain.
+!-- First compute the corresponding component of u* and square it.
+    !$OMP PARALLEL DO PRIVATE( a, b, k, rifm, z_p )
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+
+          k   = nzb_v_inner(j,i)
+          z_p = zu(k+1) - zw(k)
+
+!
+!--       Compute Richardson-flux number for this point
+          rifm = 0.5 * ( rif(j-1,i) + rif(j,i) )
+          IF ( rifm >= 0.0 )  THEN
+!
+!--          Stable stratification
+             vsws(j,i) = kappa * v(k+1,j,i) / (                           &
+                                     LOG( z_p / z0(j,i) ) +               &
+                                     5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
+                                              )
+          ELSE
+!
+!--          Unstable stratification
+             a = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifm ) )
+             b = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifm / z_p * z0(j,i) ) )
+!
+!--          If a borderline case occurs, the formula for stable stratification
+!--          must be used anyway, or else a zero division would occur in the 
+!--          argument of the logarithm.
+             IF ( a == 1.0  .OR.  b == 1.0 )  THEN
+                vsws(j,i) = kappa * v(k+1,j,i) / (                           &
+                                        LOG( z_p / z0(j,i) ) +               &
+                                        5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
+                                                 )
+             ELSE
+                vsws(j,i) = kappa * v(k+1,j,i) / (                           &
+                              LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) + &
+                              2.0 * ( ATAN( b ) - ATAN( a ) )                &
+                                                 )
+             ENDIF
+          ENDIF
+          vsws(j,i) = -vsws(j,i) * ABS( vsws(j,i) )
+       ENDDO
+    ENDDO
+
+!
+!-- If required compute q*
+    IF ( moisture  .OR.  passive_scalar )  THEN
+       IF ( constant_waterflux )  THEN
+!
+!--       For a given water flux in the Prandtl layer:
+          !$OMP PARALLEL DO
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                qs(j,i) = -qsws(j,i) / ( us(j,i) + 1E-30 )
+             ENDDO
+          ENDDO
+          
+       ELSE          
+          !$OMP PARALLEL DO PRIVATE( a, b, k, z_p )
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+
+                k   = nzb_s_inner(j,i)
+                z_p = zu(k+1) - zw(k)
+
+                IF ( rif(j,i) >= 0.0 )  THEN
+!
+!--                Stable stratification
+                   qs(j,i) = kappa * ( q(k+1,j,i) - q(k,j,i) ) / (         &
+                                  LOG( z_p / z0(j,i) ) +                   &
+                                  5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+                                                                 )
+                ELSE
+!
+!--                Unstable stratification
+                   a = SQRT( 1.0 - 16.0 * rif(j,i) )
+                   b = SQRT( 1.0 - 16.0 * rif(j,i) / z_p * z0(j,i) )
+!
+!--                If a borderline case occurs, the formula for stable
+!--                stratification must be used anyway, or else a zero division
+!--                would occur in the argument of the logarithm. 
+                   IF ( a == 1.0  .OR.  b == 1.0 )  THEN
+                      qs(j,i) = kappa * ( q(k+1,j,i) - q(k,j,i) ) / (         &
+                                     LOG( z_p / z0(j,i) ) +                   &
+                                     5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+                                                                    )
+                   ELSE
+                      qs(j,i) = kappa * ( q(k+1,j,i) - q(k,j,i) ) / (          &
+                                  LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) &
+                                                                    )
+                   ENDIF
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDIF
+    ENDIF
+
+!
+!-- Exchange the boundaries for u* and the momentum fluxes (fluxes only for
+!-- completeness's sake).
+    CALL exchange_horiz_2d( us )
+    CALL exchange_horiz_2d( usws )
+    CALL exchange_horiz_2d( vsws )
+    IF ( moisture  .OR.  passive_scalar )  CALL exchange_horiz_2d( qsws )
+
+!
+!-- Compute the vertical kinematic heat flux
+    IF ( .NOT. constant_heatflux )  THEN
+       !$OMP PARALLEL DO
+       DO  i = nxl-1, nxr+1
+          DO  j = nys-1, nyn+1
+             shf(j,i) = -ts(j,i) * us(j,i)
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Compute the vertical water/scalar flux
+    IF ( .NOT. constant_heatflux .AND. ( moisture .OR. passive_scalar ) ) THEN
+       !$OMP PARALLEL DO
+       DO  i = nxl-1, nxr+1
+          DO  j = nys-1, nyn+1
+             qsws(j,i) = -qs(j,i) * us(j,i)
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Bottom boundary condition for the TKE
+    IF ( ibc_e_b == 2 )  THEN
+       !$OMP PARALLEL DO
+       DO  i = nxl-1, nxr+1
+          DO  j = nys-1, nyn+1
+             e(nzb_s_inner(j,i)+1,j,i) = ( us(j,i) / 0.1 )**2
+!
+!--          As a test: cm = 0.4
+!            e(nzb_s_inner(j,i)+1,j,i) = ( us(j,i) / 0.4 )**2
+             e(nzb_s_inner(j,i),j,i)   = e(nzb_s_inner(j,i)+1,j,i)
+          ENDDO
+       ENDDO
+    ENDIF
+
+
+ END SUBROUTINE prandtl_fluxes
Index: palm/trunk/SOURCE/pres.f90
===================================================================
--- palm/trunk/SOURCE/pres.f90	(revision 4901)
+++ palm/trunk/SOURCE/pres.f90	(revision 1)
@@ -1,65 +1,99 @@
-!> @file pres.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ SUBROUTINE pres
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! bugfix: mean w removal not applied to ghost points of the total domain in case of non-cyclic
-! setups
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Bugfix in OpenMP directives - intel compiler do not allow reduction operations on array elements
-!
-! 4719 2020-10-01 11:28:33Z pavelkrc
-! Bugfix of previous commit (div_old discrepancy)
-!
-! 4717 2020-09-30 22:27:40Z pavelkrc
-! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
-! directives (J. Resler)
-!
-! 4651 2020-08-27 07:17:45Z raasch
-! preprocessor branch for ibm removed
-!
-! 4649 2020-08-25 12:11:17Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static
-! topography information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4015 2019-06-05 13:25:35Z raasch
-! variable child_domain_nvn eliminated
-!
-! 3849 2019-04-01 16:35:16Z knoop
-! OpenACC port for SPEC
+! $Log: pres.f90,v $
+! Revision 1.25  2006/04/26 13:26:12  raasch
+! OpenMP optimization (+localsum, threadsum)
+!
+! Revision 1.24  2006/02/23 12:50:08  raasch
+! nzb replaced by nzb_.._inner, optional volume flow control, calculation of
+! divergence sum reordered due to optimization
+!
+! Revision 1.23  2005/05/18 15:53:44  raasch
+! call conditions for poisfft_hybrid modified
+!
+! Revision 1.22  2005/03/26 20:57:24  raasch
+! Adjustments for non-cyclic boundary conditions: arguments added to routine
+! exchange_horiz, mean horizontal wind parallel to the outflow is calculated.
+!
+! Revision 1.21  2004/04/30 12:45:00  raasch
+! Most of the arguments removed from poisfft call, +module poisfft_mod,
+! poisfft is also used for 1d-decompositions, more memory has to be
+! allocated for tend, when an enlarged domain is used for transposition
+!
+! Revision 1.20  2003/03/16 09:46:02  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.19  2003/03/14 13:46:32  raasch
+! Optimization of loops (IBM-version and vectorizable version)
+!
+! Revision 1.18  2003/03/12 16:38:20  raasch
+! Simulated_time has been replaced by sums(nzb+1,4) in first if clause
+! in order to avoid run time errors due to compiler bugs on ibm and nec
+! machines, due to optimization, dividing d by dt_3d is now done in the
+! first loop (not in a seperated loop),
+! error removed: tend=p added after calling sor method
+!
+! Revision 1.17  2002/06/11 13:17:03  raasch
+! Hybrid solver included, array operations on d removed due to bad performance
+! on IBM, loops including the array d are combined, OpenMP directives added.
+! Total perturbation pressure is no more obtained iteratively (p=p+tend) from
+! the current perturbation pressure.
+!
+! Revision 1.16  2001/09/04  12:05:52  12:05:52  raasch (Siegfried Raasch)
+! Value of perturbation pressure is no more obtained iteratively (p = p + tend,
+! FFT-solver only)
+! 
+! Revision 1.15  2001/07/20 13:12:54  raasch
+! Multigrid method included
+!
+! Revision 1.14  2001/03/30 07:47:29  raasch
+! All arguments removed, dp replaced by tend, array work removed from
+! sor argument list,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.13  2001/01/22 07:53:53  raasch
+! Module test_variables removed
+!
+! Revision 1.12  2000/01/26 13:23:32  letzel
+! All comments translated into English
+!
+! Revision 1.11  1998/09/22 17:28:14  raasch
+! dp war bei SOR-Aufrufen bisher nicht initialisiert, entsprechend geaendert
+!
+! Revision 1.10  1998/07/06 12:30:22  raasch
+! + USE test_variables
+!
+! Revision 1.9  1998/04/15 11:23:20  raasch
+! Testweise Zusatzbedingung fuer den Druck am unteren Rand bei inhomogener
+! Oberflaechentemperatur (pt wird uebergeben)
+!
+! Revision 1.8  1998/03/30 11:37:59  raasch
+! Divergenzsummenberechnung (PEs) nach flow_statistics verlagert
+!
+! Revision 1.7  1998/03/25 13:56:16  raasch
+! dt in dt_3d umbenannt
+!
+! Revision 1.6  1997/09/16 06:38:37  raasch
+! Ueberfluessige Initialisierung von d entfernt
+!
+! Revision 1.5  1997/09/12 06:29:56  raasch
+! Randbedingungen umbenannt
+!
+! Revision 1.4  1997/09/09 08:30:27  raasch
+! Kehrwerte der Gitterweiten implementiert
+!
+! Revision 1.3  1997/08/26 06:34:16  raasch
+! Gesamtstoerdruck p wird in Bew.gleichungen mitgerechnet und ergibt sich
+! durch Summation des aktuellen Stoerdrucks dp, mit dem hier korrigiert wird
+!
+! Revision 1.2  1997/08/11 06:25:24  raasch
+! Felder werden ueber Formalparameterliste uebergeben.
 !
 ! Revision 1.1  1997/07/24 11:24:44  raasch
@@ -67,130 +101,30 @@
 !
 !
-!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Compute the divergence of the provisional velocity field. Solve the Poisson equation for the
-!> perturbation pressure. Compute the final velocities using this perturbation pressure. Compute the
-!> remaining divergence.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE pres
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  d,                                                                                  &
-               ddzu,                                                                               &
-               ddzu_pres,                                                                          &
-               ddzw,                                                                               &
-               dzw,                                                                                &
-               p,                                                                                  &
-               p_loc,                                                                              &
-               rho_air,                                                                            &
-               rho_air_zw,                                                                         &
-               tend,                                                                               &
-               u,                                                                                  &
-               v,                                                                                  &
-               w
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               child_domain,                                                                       &
-               conserve_volume_flow,                                                               &
-               coupling_mode,                                                                      &
-               dt_3d,                                                                              &
-               gathered_size,                                                                      &
-               ibc_p_b,                                                                            &
-               ibc_p_t,                                                                            &
-               intermediate_timestep_count,                                                        &
-               intermediate_timestep_count_max,                                                    &
-               mg_switch_to_pe0_level,                                                             &
-               nesting_offline,                                                                    &
-               psolver,                                                                            &
-               subdomain_size,                                                                     &
-               topography,                                                                         &
-               volume_flow,                                                                        &
-               volume_flow_area,                                                                   &
-               volume_flow_initial
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point,                                                                          &
-               log_point_s
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx,                                                                                &
-               ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               ngp_2dh_outer,                                                                      &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxl_mg,                                                                             &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nxr_mg,                                                                             &
-               ny,                                                                                 &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nys_mg,                                                                             &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nyn_mg,                                                                             &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               nzt_mg,                                                                             &
-               wall_flags_total_0
-
-    USE kinds
-
+! Compute the divergence of the provisional velocity field. Solve the Poisson
+! equation for the perturbation pressure. Compute the final velocities using
+! this perturbation pressure. Compute the remaining divergence.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE constants
+    USE control_parameters
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
     USE pegrid
-
-    USE pmc_interface,                                                                             &
-        ONLY:  nesting_mode
-
-    USE poisfft_mod,                                                                               &
-        ONLY:  poisfft
-
-    USE poismg_mod
-
-    USE poismg_noopt_mod
-
-    USE statistics,                                                                                &
-        ONLY:  statistic_regions,                                                                  &
-               sums_divnew_l,                                                                      &
-               sums_divold_l,                                                                      &
-               weight_pres,                                                                        &
-               weight_substep
-
-    USE surface_mod,                                                                               &
-        ONLY :  bc_h
+    USE poisfft_mod
+    USE poisfft_hybrid_mod
+    USE statistics
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-    INTEGER(iwp) ::  m  !<
-
-    REAL(wp) ::  ddt_3d            !<
-    REAL(wp) ::  d_weight_pres     !<
-    REAL(wp) ::  localsum          !<
-    REAL(wp) ::  threadsum         !<
-    REAL(wp) ::  weight_pres_l     !<
-    REAL(wp) ::  weight_substep_l  !<
-
-    REAL(wp), DIMENSION(1:3)   ::  volume_flow_l       !<
-    REAL(wp), DIMENSION(1:3)   ::  volume_flow_offset  !<
-    REAL(wp), DIMENSION(1:nzt) ::  w_l                 !<
-    REAL(wp), DIMENSION(1:nzt) ::  w_l_l               !<
+    INTEGER ::  i, j, k, sr
+
+    REAL    ::  localsum, threadsum
+
+    REAL, DIMENSION(1:2) ::  volume_flow_l, volume_flow_offset
 
 
@@ -198,181 +132,8 @@
 
 !
-!-- Calculate quantities to be used locally
-    ddt_3d = 1.0_wp / dt_3d
-    IF ( intermediate_timestep_count == 0 )  THEN
-!
-!--    If pres is called before initial time step
-       weight_pres_l    = 1.0_wp
-       d_weight_pres    = 1.0_wp
-       weight_substep_l = 1.0_wp
-    ELSE
-       weight_pres_l    = weight_pres(intermediate_timestep_count)
-       d_weight_pres    = 1.0_wp / weight_pres(intermediate_timestep_count)
-       weight_substep_l = weight_substep(intermediate_timestep_count)
-    ENDIF
-
-!
-!-- Multigrid method expects array d to have one ghost layer.
-!--
-    IF ( psolver(1:9) == 'multigrid' )  THEN
-
+!-- Multigrid method needs additional grid points for the divergence array
+    IF ( psolver == 'multigrid' )  THEN
        DEALLOCATE( d )
        ALLOCATE( d(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
-
-!
-!--    Since p is later used to hold the weighted average of the substeps, it cannot be used in the
-!--    iterative solver. Therefore, its initial value is stored on p_loc, which is then iteratively
-!--    advanced in every substep.
-       IF ( intermediate_timestep_count <= 1 )  THEN
-          DO  i = nxl-1, nxr+1
-             DO  j = nys-1, nyn+1
-                DO  k = nzb, nzt+1
-                   p_loc(k,j,i) = p(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-
-    ELSEIF ( psolver == 'sor'  .AND.  intermediate_timestep_count <= 1 )  THEN
-
-!
-!--    Since p is later used to hold the weighted average of the substeps, it cannot be used in the
-!--    iterative solver. Therefore, its initial value is stored on p_loc, which is then iteratively
-!--    advanced in every substep.
-       p_loc = p
-
-    ENDIF
-
-!
-!-- Conserve the volume flow at the outflow in case of non-cyclic lateral boundary conditions
-!-- WARNING: so far, this conservation does not work at the left/south boundary if the topography at
-!--          the inflow differs from that at the outflow! For this case, volume_flow_area needs
-!--          adjustment!
-!
-!-- Left/right
-    IF ( conserve_volume_flow  .AND.  ( bc_radiation_l .OR. bc_radiation_r ) )  THEN
-
-       volume_flow(1)   = 0.0_wp
-       volume_flow_l(1) = 0.0_wp
-
-       IF ( bc_radiation_l )  THEN
-          i = 0
-       ELSEIF ( bc_radiation_r )  THEN
-          i = nx+1
-       ENDIF
-
-       DO  j = nys, nyn
-!
-!--       Sum up the volume flow through the south/north boundary
-          DO  k = nzb+1, nzt
-             volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k)                               &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-       ENDDO
-
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm1dy, ierr )
-       CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL, MPI_SUM, comm1dy, ierr )
-#else
-       volume_flow = volume_flow_l
-#endif
-       volume_flow_offset(1) = ( volume_flow_initial(1) - volume_flow(1) ) / volume_flow_area(1)
-
-       DO  j = nysg, nyng
-          DO  k = nzb+1, nzt
-             u(k,j,i) = u(k,j,i) + volume_flow_offset(1)                                           &
-                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-!
-!-- South/north
-    IF ( conserve_volume_flow  .AND.  ( bc_radiation_n .OR. bc_radiation_s ) )  THEN
-
-       volume_flow(2)   = 0.0_wp
-       volume_flow_l(2) = 0.0_wp
-
-       IF ( bc_radiation_s )  THEN
-          j = 0
-       ELSEIF ( bc_radiation_n )  THEN
-          j = ny+1
-       ENDIF
-
-       DO  i = nxl, nxr
-!
-!--       Sum up the volume flow through the south/north boundary
-          DO  k = nzb+1, nzt
-             volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k)                               &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-       ENDDO
-
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm1dx, ierr )
-       CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL, MPI_SUM, comm1dx, ierr )
-#else
-       volume_flow = volume_flow_l
-#endif
-       volume_flow_offset(2) = ( volume_flow_initial(2) - volume_flow(2) ) / volume_flow_area(2)
-
-       DO  i = nxlg, nxrg
-          DO  k = nzb+1, nzt
-             v(k,j,i) = v(k,j,i) + volume_flow_offset(2)                                           &
-                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-!
-!-- Remove mean vertical velocity in case that Neumann conditions are used both at bottom and top
-!-- boundary. With Neumann conditions at both vertical boundaries, the solver cannot remove mean
-!-- vertical velocities. They should be removed, because incompressibility requires that the
-!-- vertical gradient of vertical velocity is zero. Since w=0 at the solid surface, it must be zero
-!-- everywhere.
-!-- This must not be done in case of a 3d-nesting child domain, because a mean vertical velocity
-!-- can physically exist in such a domain.
-!-- Also in case of offline nesting, mean vertical velocities may exist (and must not be removed),
-!-- caused by horizontal divergence/convergence of the large scale flow that is prescribed at the
-!-- side boundaries.
-!-- The removal cannot be done before the first initial time step because ngp_2dh_outer is not yet
-!-- known then.
-    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1  .AND.  .NOT. nesting_offline                           &
-         .AND. .NOT. ( child_domain .AND. nesting_mode /= 'vertical' )                             &
-         .AND. intermediate_timestep_count /= 0 )  THEN
-       w_l = 0.0_wp;  w_l_l = 0.0_wp
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                w_l_l(k) = w_l_l(k) + w(k,j,i)                                                     &
-                           * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( w_l_l(1), w_l(1), nzt, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-       w_l = w_l_l
-#endif
-       DO  k = 1, nzt
-          w_l(k) = w_l(k) / ngp_2dh_outer(k,0)
-       ENDDO
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                w(k,j,i) = w(k,j,i) - w_l(k)                                                       &
-                           * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    Instead of running the above loop over ghost points, they are set via exchange_horiz,
-!--    in order to correctly consider non-cyclic boundary conditions, where ghost boundaries
-!--    of the total domain must not be set. Otherwise w may continuously increase/decrease
-!--    at these points.
-       CALL exchange_horiz( w, nbgp )
     ENDIF
 
@@ -381,74 +142,155 @@
     CALL cpu_log( log_point_s(1), 'divergence', 'start' )
 
-    IF ( psolver(1:9) == 'multigrid' )  THEN
-       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
+    IF ( psolver == 'multigrid' )  THEN
+       !$OMP PARALLEL DO SCHEDULE( STATIC )
        DO  i = nxl-1, nxr+1
           DO  j = nys-1, nyn+1
              DO  k = nzb, nzt+1
-                d(k,j,i) = 0.0_wp
+                d(k,j,i) = 0.0
              ENDDO
           ENDDO
        ENDDO
     ELSE
-       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-       !$ACC PRESENT(d)
+       !$OMP PARALLEL DO SCHEDULE( STATIC )
+       DO  i = nxl, nxra
+          DO  j = nys, nyna
+             DO  k = nzb+1, nzta
+                d(k,j,i) = 0.0
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+    localsum  = 0.0
+    threadsum = 0.0
+
+#if defined( __ibm )
+    !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
+    !$OMP DO SCHEDULE( STATIC )
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb_s_inner(j,i)+1, nzt
+             d(k,j,i) = ( 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)
+          ENDDO
+!
+!--       Additional pressure boundary condition at the bottom boundary for 
+!--       inhomogeneous Prandtl layer heat fluxes and temperatures, respectively
+!--       dp/dz = -(dtau13/dx + dtau23/dy) + g*pt'/pt0.
+!--       This condition must not be applied at the start of a run, because then
+!--       flow_statistics has not yet been called and thus sums = 0.
+          IF ( ibc_p_b == 2  .AND.  sums(nzb+1,4) /= 0.0 )  THEN
+             k = nzb_s_inner(j,i)
+             d(k+1,j,i) = d(k+1,j,i) + (                                     &
+                                         ( usws(j,i+1) - usws(j,i) ) * ddx   &
+                                       + ( vsws(j+1,i) - vsws(j,i) ) * ddy   &
+                                       - g * ( pt(k+1,j,i) - sums(k+1,4) ) / &
+                                         sums(k+1,4)                         &
+                                       ) * ddzw(k+1)
+          ENDIF
+
+!
+!--       Compute possible PE-sum of divergences for flow_statistics
+          DO  k = nzb_s_inner(j,i)+1, nzt
+             threadsum = threadsum + ABS( d(k,j,i) )
+          ENDDO
+
+!
+!--       Velocity corrections are made with Euler step size. Right hand side
+!--       of Poisson equation has to be set appropriately
+          DO  k = nzb_s_inner(j,i)+1, nzt
+             d(k,j,i) = d(k,j,i) / dt_3d
+          ENDDO
+
+       ENDDO
+    ENDDO
+
+    localsum = localsum + threadsum
+    !$OMP END PARALLEL
+#else
+    IF ( ibc_p_b == 2 .AND. sums(nzb+1,4) /= 0.0 )  THEN
+       !$OMP PARALLEL PRIVATE (i,j,k)
+       !$OMP DO SCHEDULE( STATIC )
        DO  i = nxl, nxr
           DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                d(k,j,i) = 0.0_wp
-             ENDDO
-          ENDDO
-       ENDDO
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                d(k,j,i) = ( 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)
+             ENDDO
+          ENDDO
+!
+!--       Additional pressure boundary condition at the bottom boundary for
+!--       inhomogeneous Prandtl layer heat fluxes and temperatures, respectively
+!--       dp/dz = -(dtau13/dx + dtau23/dy) + g*pt'/pt0.
+!--       This condition must not be applied at the start of a run, because then
+!--       flow_statistics has not yet been called and thus sums = 0.
+          DO  j = nys, nyn
+              k = nzb_s_inner(j,i)
+              d(k+1,j,i) = d(k+1,j,i) + (                        &
+                             ( usws(j,i+1) - usws(j,i) ) * ddx   &
+                           + ( vsws(j+1,i) - vsws(j,i) ) * ddy   &
+                           - g * ( pt(k+1,j,i) - sums(k+1,4) ) / &
+                             sums(k+1,4)                         &
+                                        ) * ddzw(k+1)
+          ENDDO
+       ENDDO
+       !$OMP END PARALLEL
+
+    ELSE
+
+       !$OMP PARALLEL PRIVATE (i,j,k)
+       !$OMP DO SCHEDULE( STATIC )
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                d(k,j,i) = ( 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)
+             ENDDO
+          ENDDO
+       ENDDO
+       !$OMP END PARALLEL
+
     ENDIF
 
-    localsum  = 0.0_wp
-    threadsum = 0.0_wp
-
-    !$OMP PARALLEL PRIVATE (i,j,k)
+!
+!-- Compute possible PE-sum of divergences for flow_statistics
+    !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
     !$OMP DO SCHEDULE( STATIC )
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-    !$ACC PRESENT(u, v, w, rho_air, rho_air_zw, ddzw, wall_flags_total_0) &
-    !$ACC PRESENT(d)
     DO  i = nxl, nxr
        DO  j = nys, nyn
-          DO  k = 1, nzt
-             d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * rho_air(k) * ddx +                           &
-                          ( v(k,j+1,i) - v(k,j,i) ) * rho_air(k) * ddy +                           &
-                          ( w(k,j,i)   * rho_air_zw(k) - w(k-1,j,i) * rho_air_zw(k-1) )            &
-                          * ddzw(k) ) * ddt_3d * d_weight_pres                                     &
-                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
+          DO  k = nzb+1, nzt
+             threadsum = threadsum + ABS( d(k,j,i) )
           ENDDO
        ENDDO
     ENDDO
+    localsum = localsum + threadsum
     !$OMP END PARALLEL
 
 !
-!-- Compute possible PE-sum of divergences for flow_statistics. Carry out computation only at last
-!-- Runge-Kutta substep.
-    IF ( intermediate_timestep_count == intermediate_timestep_count_max  .OR.                      &
-         intermediate_timestep_count == 0 )  THEN
-       !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
-       !$OMP DO SCHEDULE( STATIC )
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-       !$ACC REDUCTION(+:threadsum) COPY(threadsum) &
-       !$ACC PRESENT(d)
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                threadsum = threadsum + ABS( d(k,j,i) )
-             ENDDO
-          ENDDO
-       ENDDO
-       localsum = localsum + threadsum * dt_3d * weight_pres_l
-       !$OMP END PARALLEL
-    ENDIF
-
-!
-!-- For completeness, set the divergence sum of all statistic regions to those of the total domain
-    IF ( intermediate_timestep_count == intermediate_timestep_count_max  .OR.                      &
-         intermediate_timestep_count == 0 )  THEN
-       sums_divold_l(0:statistic_regions) = localsum
-    ENDIF
+!-- Velocity corrections are made with Euler step size. Right hand side
+!-- of Poisson equation has to be set appropriately
+    !$OMP DO SCHEDULE( STATIC )
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb_s_inner(j,i)+1, nzt
+             d(k,j,i) = d(k,j,i) / dt_3d
+          ENDDO
+       ENDDO
+    ENDDO
+#endif
+
+!
+!-- For completeness, set the divergence sum of all statistic regions to those
+!-- of the total domain
+    sums_divold_l(0:statistic_regions) = localsum
+
+!
+!-- Determine absolute minimum/maximum (only for test cases, therefore as
+!-- comment line)
+!    CALL global_min_max( nzb+1, nzt, nys, nyn, nxl, nxr, d, 'abs', divmax, &
+!                         divmax_ijk )
 
     CALL cpu_log( log_point_s(1), 'divergence', 'stop' )
@@ -456,15 +298,38 @@
 !
 !-- Compute the pressure perturbation solving the Poisson equation
-    IF ( psolver == 'poisfft' )  THEN
+    IF ( psolver(1:7) == 'poisfft' )  THEN
+
+!
+!--    Enlarge the size of tend, used as a working array for the transpositions
+       IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+          DEALLOCATE( tend )
+          ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+       ENDIF
 
 !
 !--    Solve Poisson equation via FFT and solution of tridiagonal matrices
-       CALL poisfft( d )
-
-!
-!--    Store computed perturbation pressure and set boundary condition in z-direction
-       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-       !$ACC PRESENT(d, tend)
+       IF ( psolver == 'poisfft' )  THEN
+!
+!--       Solver for 2d-decomposition
+          CALL poisfft( d, tend )
+       ELSEIF ( psolver == 'poisfft_hybrid' )  THEN 
+!
+!--       Solver for 1d-decomposition (using MPI and OpenMP).
+!--       The old hybrid-solver is still included here, as long as there
+!--       are some optimization problems in poisfft
+          CALL poisfft_hybrid( d )
+       ENDIF
+
+!
+!--    Resize tend to its normal size
+       IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
+          DEALLOCATE( tend )
+          ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+       ENDIF
+
+!
+!--    Store computed perturbation pressure and set boundary condition in
+!--    z-direction
+       !$OMP PARALLEL DO
        DO  i = nxl, nxr
           DO  j = nys, nyn
@@ -477,52 +342,37 @@
 !
 !--    Bottom boundary:
-!--    This condition is only required for internal output. The pressure gradient
-!--    (dp(nzb+1)-dp(nzb))/dz is not used anywhere else.
+!--    This condition is only required for internal output. The pressure
+!--    gradient (dp(nzb+1)-dp(nzb))/dz is not used anywhere else.
        IF ( ibc_p_b == 1 )  THEN
 !
-!--       Neumann (dp/dz = 0). Using surface data type, first for non-natural surfaces, then for
-!--       natural and urban surfaces
-!--       Upward facing
-          !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC )
-          !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
-          !$ACC PRESENT(bc_h, tend)
-          DO  m = 1, bc_h(0)%ns
-             i = bc_h(0)%i(m)
-             j = bc_h(0)%j(m)
-             k = bc_h(0)%k(m)
-             tend(k-1,j,i) = tend(k,j,i)
-          ENDDO
-!
-!--       Downward facing
-          !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC )
-          !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
-          !$ACC PRESENT(bc_h, tend)
-          DO  m = 1, bc_h(1)%ns
-             i = bc_h(1)%i(m)
-             j = bc_h(1)%j(m)
-             k = bc_h(1)%k(m)
-             tend(k+1,j,i) = tend(k,j,i)
+!--       Neumann (dp/dz = 0)
+          !$OMP PARALLEL DO
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                tend(nzb_s_inner(j,i),j,i) = tend(nzb_s_inner(j,i)+1,j,i)
+             ENDDO
+          ENDDO
+
+       ELSEIF ( ibc_p_b == 2 )  THEN
+!
+!--       Neumann condition for inhomogeneous surfaces,
+!--       here currently still in the form of a zero gradient. Actually 
+!--       dp/dz = -(dtau13/dx + dtau23/dy) + g*pt'/pt0 would have to be used for
+!--       the computation (cf. above: computation of divergences).
+          !$OMP PARALLEL DO
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                tend(nzb_s_inner(j,i),j,i) = tend(nzb_s_inner(j,i)+1,j,i)
+             ENDDO
           ENDDO
 
        ELSE
 !
-!--       Dirichlet. Using surface data type, first for non-natural surfaces, then for natural and
-!--       urban surfaces
-!--       Upward facing
-          !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC )
-          DO  m = 1, bc_h(0)%ns
-             i = bc_h(0)%i(m)
-             j = bc_h(0)%j(m)
-             k = bc_h(0)%k(m)
-             tend(k-1,j,i) = 0.0_wp
-          ENDDO
-!
-!--       Downward facing
-          !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC )
-          DO  m = 1, bc_h(1)%ns
-             i = bc_h(1)%i(m)
-             j = bc_h(1)%j(m)
-             k = bc_h(1)%k(m)
-             tend(k+1,j,i) = 0.0_wp
+!--       Dirichlet
+          !$OMP PARALLEL DO
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                tend(nzb_s_inner(j,i),j,i) = 0.0
+             ENDDO
           ENDDO
 
@@ -534,7 +384,7 @@
 !
 !--       Neumann
-          !$OMP PARALLEL DO PRIVATE (i,j) SCHEDULE( STATIC )
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
+          !$OMP PARALLEL DO
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
                 tend(nzt+1,j,i) = tend(nzt,j,i)
              ENDDO
@@ -544,10 +394,8 @@
 !
 !--       Dirichlet
-          !$OMP PARALLEL DO PRIVATE (i,j) SCHEDULE( STATIC )
-          !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
-          !$ACC PRESENT(tend)
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                tend(nzt+1,j,i) = 0.0_wp
+          !$OMP PARALLEL DO
+          DO  i = nxl-1, nxr+1
+             DO  j = nys-1, nyn+1
+                tend(nzt+1,j,i) = 0.0
              ENDDO
           ENDDO
@@ -557,258 +405,214 @@
 !
 !--    Exchange boundaries for p
-       CALL exchange_horiz( tend, nbgp )
-
+       CALL exchange_horiz( tend, 0, 0 )
+      
     ELSEIF ( psolver == 'sor' )  THEN
 
 !
-!--    Solve Poisson equation for perturbation pressure using SOR-Red/Black scheme
-       CALL sor( d, ddzu_pres, ddzw, p_loc )
-       tend = p_loc
-
-    ELSEIF ( psolver(1:9) == 'multigrid' )  THEN
-
-!
-!--    Solve Poisson equation for perturbation pressure using Multigrid scheme, array tend is used
-!--    to store the residuals.
-
-!--    If the number of grid points of the gathered grid, which is collected on PE0, is larger than
-!--    the number of grid points of an PE, than array tend will be enlarged.
-       IF ( gathered_size > subdomain_size )  THEN
-          DEALLOCATE( tend )
-          ALLOCATE( tend(nzb:nzt_mg(mg_switch_to_pe0_level)+1,nys_mg(                              &
-                    mg_switch_to_pe0_level)-1:nyn_mg(mg_switch_to_pe0_level)+1,                    &
-                    nxl_mg(mg_switch_to_pe0_level)-1:nxr_mg(mg_switch_to_pe0_level)+1) )
-       ENDIF
-
-       IF ( psolver == 'multigrid' )  THEN
-          CALL poismg( tend )
-       ELSE
-          CALL poismg_noopt( tend )
-       ENDIF
-
-       IF ( gathered_size > subdomain_size )  THEN
-          DEALLOCATE( tend )
-          ALLOCATE( tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-
-!
-!--    Restore perturbation pressure on tend because this array is used further below to correct the
-!--    velocity fields
-       DO  i = nxl-1, nxr+1
+!--    Solve Poisson equation for perturbation pressure using SOR-Red/Black
+!--    scheme
+       CALL sor( d, ddzu, ddzw, p )
+       tend = p
+
+    ELSEIF ( psolver == 'multigrid' )  THEN
+
+!
+!--    Solve Poisson equation for perturbation pressure using Multigrid scheme,
+!--    array tend is used to store the residuals
+       CALL poismg( tend )
+ 
+!
+!--    Restore perturbation pressure on tend because this array is used
+!--    further below to correct the velocity fields
+       tend = p
+
+    ENDIF
+
+!
+!-- Store perturbation pressure on array p, used in the momentum equations
+    IF ( psolver(1:7) == 'poisfft' )  THEN
+!
+!--    Here, only the values from the left and right boundaries are copied
+!--    The remaining values are copied in the following loop due to speed
+!--    optimization
+       !$OMP PARALLEL DO
+       DO  j = nys-1, nyn+1
+          DO  k = nzb, nzt+1
+             p(k,j,nxl-1) = tend(k,j,nxl-1)
+             p(k,j,nxr+1) = tend(k,j,nxr+1)
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Correction of the provisional velocities with the current perturbation 
+!-- pressure just computed
+    IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  uvmean_outflow_l = 0.0
+    IF ( conserve_volume_flow )  THEN
+       volume_flow_l(1) = 0.0
+       volume_flow_l(2) = 0.0
+    ENDIF
+    !$OMP PARALLEL PRIVATE (i,j,k)
+    !$OMP DO
+    DO  i = nxl, nxr
+       IF ( psolver(1:7) == 'poisfft' )  THEN
           DO  j = nys-1, nyn+1
              DO  k = nzb, nzt+1
-                tend(k,j,i) = p_loc(k,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
+                p(k,j,i) = tend(k,j,i)
+             ENDDO
+          ENDDO
+       ENDIF
+       DO  j = nys, nyn
+          DO  k = nzb_w_inner(j,i)+1, nzt
+             w(k,j,i) = w(k,j,i) - dt_3d * &
+                                   ( tend(k+1,j,i) - tend(k,j,i) ) * ddzu(k+1)
+          ENDDO
+          DO  k = nzb_u_inner(j,i)+1, nzt
+             u(k,j,i) = u(k,j,i) - dt_3d * ( tend(k,j,i) - tend(k,j,i-1) ) * ddx
+          ENDDO
+          DO  k = nzb_v_inner(j,i)+1, nzt
+             v(k,j,i) = v(k,j,i) - dt_3d * ( tend(k,j,i) - tend(k,j-1,i) ) * ddy
+          ENDDO
+
+!
+!--       Sum up the horizontal velocity along the outflow plane (in case
+!--       of non-cyclic boundary conditions). The respective mean velocity
+!--       is calculated from this in routine boundary_conds.
+          IF ( outflow_l  .AND.  i == nxl )  THEN
+             !$OMP CRITICAL
+             DO  k = nzb, nzt+1
+                uvmean_outflow_l(k) = uvmean_outflow_l(k) + v(k,j,nxl)
+             ENDDO
+             !$OMP END CRITICAL
+          ELSEIF ( outflow_r  .AND.  i == nxr )  THEN
+             !$OMP CRITICAL
+             DO  k = nzb, nzt+1
+                uvmean_outflow_l(k) = uvmean_outflow_l(k) + v(k,j,nxr)
+             ENDDO
+             !$OMP END CRITICAL
+          ELSEIF ( outflow_s  .AND.  j == nys )  THEN
+             !$OMP CRITICAL
+             DO  k = nzb, nzt+1
+                uvmean_outflow_l(k) = uvmean_outflow_l(k) + u(k,nys,i)
+             ENDDO
+             !$OMP END CRITICAL
+          ELSEIF ( outflow_n  .AND.  j == nyn )  THEN
+             !$OMP CRITICAL
+             DO  k = nzb, nzt+1
+                uvmean_outflow_l(k) = uvmean_outflow_l(k) + u(k,nyn,i)
+             ENDDO
+             !$OMP END CRITICAL
+          ENDIF
+
+!
+!--       Sum up the volume flow through the right and north boundary
+          IF ( conserve_volume_flow  .AND.  i == nx )  THEN
+             !$OMP CRITICAL
+             DO  k = nzb_2d(j,i) + 1, nzt
+                volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzu(k)
+             ENDDO
+             !$OMP END CRITICAL
+          ENDIF
+          IF ( conserve_volume_flow  .AND.  j == ny )  THEN
+             !$OMP CRITICAL
+             DO  k = nzb_2d(j,i) + 1, nzt
+                volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzu(k)
+             ENDDO
+             !$OMP END CRITICAL
+          ENDIF
+
+       ENDDO
+    ENDDO
+    !$OMP END PARALLEL
+
+!
+!-- Conserve the volume flow
+    IF ( conserve_volume_flow )  THEN
+
+#if defined( __parallel )   
+       CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 2, MPI_REAL, &
+                           MPI_SUM, comm2d, ierr )  
+#else
+       volume_flow = volume_flow_l  
+#endif   
+
+       volume_flow_offset = ( volume_flow_initial - volume_flow ) / &
+                            volume_flow_area
+
+       !$OMP PARALLEL PRIVATE (i,j,k)
+       !$OMP DO
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_u_inner(j,i) + 1, nzt
+                u(k,j,i) = u(k,j,i) + volume_flow_offset(1)
+             ENDDO
+             DO  k = nzb_v_inner(j,i) + 1, nzt
+                v(k,j,i) = v(k,j,i) + volume_flow_offset(2)
+             ENDDO
+          ENDDO
+       ENDDO
+       !$OMP END PARALLEL
 
     ENDIF
 
 !
-!-- Store perturbation pressure on array p, used for pressure data output.
-!-- Ghost layers are added in the output routines (except sor-method: see below)
-    IF ( intermediate_timestep_count <= 1 )  THEN
-       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-       !$ACC PRESENT(p, tend)
-       DO  i = nxl-1, nxr+1
-          DO  j = nys-1, nyn+1
-             DO  k = nzb, nzt+1
-                p(k,j,i) = tend(k,j,i) * weight_substep_l
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ELSEIF ( intermediate_timestep_count > 1 )  THEN
-       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-       !$ACC PRESENT(p, tend)
-       DO  i = nxl-1, nxr+1
-          DO  j = nys-1, nyn+1
-             DO  k = nzb, nzt+1
-                p(k,j,i) = p(k,j,i) + tend(k,j,i) * weight_substep_l
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-!
-!-- SOR-method needs ghost layers for the next timestep
-    IF ( psolver == 'sor' )  CALL exchange_horiz( p, nbgp )
-
-!
-!-- Correction of the provisional velocities with the current perturbation pressure just computed
-    IF ( conserve_volume_flow  .AND.  ( bc_lr_cyc .OR. bc_ns_cyc ) )  THEN
-       volume_flow_l(1) = 0.0_wp
-       volume_flow_l(2) = 0.0_wp
-    ENDIF
-!
-!-- Add pressure gradients to the velocity components. Note, the loops are running over the entire
-!-- model domain, even though, in case of non-cyclic boundaries u- and v-component are not
-!-- prognostic at i=0 and j=0, respectiveley. However, in case of Dirichlet boundary conditions for
-!-- the velocities, zero-gradient conditions for the pressure are set, so that no modification is
-!-- imposed at the boundaries.
-    !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
-    !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k) &
-    !$ACC PRESENT(u, v, w, tend, ddzu, wall_flags_total_0)
+!-- Exchange of boundaries for the velocities
+    CALL exchange_horiz( u, uxrp,    0 )
+    CALL exchange_horiz( v,    0, vynp )
+    CALL exchange_horiz( w,    0,    0 )
+
+!
+!-- Compute the divergence of the corrected velocity field,
+!-- a possible PE-sum is computed in flow_statistics 
+    CALL cpu_log( log_point_s(1), 'divergence', 'start' )
+    sums_divnew_l = 0.0
+
+!
+!-- d must be reset to zero because it can contain nonzero values below the
+!-- topography
+    IF ( topography /= 'flat' )  d = 0.0
+
+    localsum  = 0.0
+    threadsum = 0.0
+
+    !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
+    !$OMP DO SCHEDULE( STATIC )
+#if defined( __ibm )
     DO  i = nxl, nxr
        DO  j = nys, nyn
-
+          DO  k = nzb_s_inner(j,i)+1, nzt
+             d(k,j,i) = ( 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)
+          ENDDO
           DO  k = nzb+1, nzt
-             w(k,j,i) = w(k,j,i) - dt_3d * ( tend(k+1,j,i) - tend(k,j,i) ) * ddzu(k+1)             &
-                        * weight_pres_l                                                            &
-                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-          ENDDO
-
-          DO  k = nzb+1, nzt
-             u(k,j,i) = u(k,j,i) - dt_3d * ( tend(k,j,i) - tend(k,j,i-1) ) * ddx * weight_pres_l   &
-                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-
-          DO  k = nzb+1, nzt
-             v(k,j,i) = v(k,j,i) - dt_3d * ( tend(k,j,i) - tend(k,j-1,i) ) * ddy * weight_pres_l   &
-                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-
+             threadsum = threadsum + ABS( d(k,j,i) )
+          ENDDO
        ENDDO
     ENDDO
-
-!
-!-- The vertical velocity is not set to zero at nzt + 1 for nested domains. Instead it is set to the
-!-- values of nzt (see routine vnest_boundary_conds or pmci_interp_tril_t) BEFORE calling the
-!-- pressure solver. To avoid jumps while plotting profiles, w at the top has to be set to the
-!-- values in height nzt after above modifications. Hint: w level nzt+1 does not impact results.
-    IF ( child_domain  .OR.  coupling_mode == 'vnested_fine' )  THEN
-       w(nzt+1,:,:) = w(nzt,:,:)
-    ENDIF
-
-!
-!-- Sum up the volume flow through the right and north boundary
-    IF ( conserve_volume_flow  .AND.  bc_lr_cyc  .AND.  bc_ns_cyc  .AND.  nxr == nx )  THEN
-       threadsum = 0.0_wp
-!
-!--    Summation of the volume flow is done on threadsum rather than on volumen_flow itself.
-!--    This is because intel compiler, when compiled with openmp, do not allow reduction
-!--    operation on array elements.
-       !$OMP PARALLEL DO PRIVATE (j,k) REDUCTION (+:threadsum)
+#else
+    DO  i = nxl, nxr
        DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             threadsum = threadsum + u(k,j,nxr) * dzw(k)                             &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr), 1 ) )
-          ENDDO
-       ENDDO
-       volume_flow_l(1) = threadsum
-
-    ENDIF
-
-    IF ( conserve_volume_flow  .AND.  bc_ns_cyc  .AND.  bc_lr_cyc  .AND. nyn == ny )  THEN
-       threadsum = 0.0_wp
-       !$OMP PARALLEL DO PRIVATE (j,k) REDUCTION (+:threadsum)
-       DO  i = nxl, nxr
-          DO  k = nzb+1, nzt
-             threadsum = threadsum + v(k,nyn,i) * dzw(k)                             &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn,i), 2 ) )
-           ENDDO
-       ENDDO
-       volume_flow_l(2) = threadsum
-
-    ENDIF
-
-!
-!-- Conserve the volume flow
-    IF ( conserve_volume_flow  .AND.  ( bc_lr_cyc  .AND.  bc_ns_cyc ) )  THEN
-
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 2, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-       volume_flow = volume_flow_l
+          DO  k = nzb_s_inner(j,i)+1, nzt
+             d(k,j,i) = ( 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)
+             threadsum = threadsum + ABS( d(k,j,i) )
+          ENDDO
+       ENDDO
+    ENDDO
 #endif
-
-       volume_flow_offset(1:2) = ( volume_flow_initial(1:2) - volume_flow(1:2) )                   &
-                                 / volume_flow_area(1:2)
-
-       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                u(k,j,i) = u(k,j,i) + volume_flow_offset(1)                                        &
-                           * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-             ENDDO
-             DO  k = nzb+1, nzt
-                v(k,j,i) = v(k,j,i) + volume_flow_offset(2)                                        &
-                           * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-!
-!-- Exchange of boundaries for the velocities
-    CALL exchange_horiz( u, nbgp )
-    CALL exchange_horiz( v, nbgp )
-    CALL exchange_horiz( w, nbgp )
-
-!
-!-- Compute the divergence of the corrected velocity field.
-!-- A possible PE-sum is computed in flow_statistics. Carry out computation only at last
-!-- Runge-Kutta step.
-    IF ( intermediate_timestep_count == intermediate_timestep_count_max  .OR.                      &
-         intermediate_timestep_count == 0 )  THEN
-       CALL cpu_log( log_point_s(1), 'divergence', 'start' )
-       sums_divnew_l = 0.0_wp
-
-!
-!--    d must be reset to zero because it can contain nonzero values below the topography
-       IF ( topography /= 'flat' )  d = 0.0_wp
-
-       localsum  = 0.0_wp
-       threadsum = 0.0_wp
-
-       !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
-       !$OMP DO SCHEDULE( STATIC )
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-       !$ACC PRESENT(u, v, w, rho_air, rho_air_zw, ddzw, wall_flags_total_0) &
-       !$ACC PRESENT(d)
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * rho_air(k) * ddx +    &
-                             ( v(k,j+1,i) - v(k,j,i) ) * rho_air(k) * ddy +    &
-                             ( w(k,j,i)   * rho_air_zw(k) - w(k-1,j,i) * rho_air_zw(k-1) )         &
-                             * ddzw(k) )                                                           &
-                           * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    Compute possible PE-sum of divergences for flow_statistics
-       !$OMP DO SCHEDULE( STATIC )
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-       !$ACC REDUCTION(+:threadsum) COPY(threadsum) &
-       !$ACC PRESENT(d)
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                threadsum = threadsum + ABS( d(k,j,i) )
-             ENDDO
-          ENDDO
-       ENDDO
-
-       localsum = localsum + threadsum
-       !$OMP END PARALLEL
-
-!
-!--    For completeness, set the divergence sum of all statistic regions to those of the total
-!--    domain
-       sums_divnew_l(0:statistic_regions) = localsum
-
-       CALL cpu_log( log_point_s(1), 'divergence', 'stop' )
-
-    ENDIF
+    localsum = localsum + threadsum
+    !$OMP END PARALLEL
+
+!
+!-- For completeness, set the divergence sum of all statistic regions to those
+!-- of the total domain
+    sums_divnew_l(0:statistic_regions) = localsum
+
+    CALL cpu_log( log_point_s(1), 'divergence', 'stop' )
 
     CALL cpu_log( log_point(8), 'pres', 'stop' )
 
+
  END SUBROUTINE pres
Index: palm/trunk/SOURCE/print_1d.f90
===================================================================
--- palm/trunk/SOURCE/print_1d.f90	(revision 4901)
+++ palm/trunk/SOURCE/print_1d.f90	(revision 1)
@@ -1,81 +1,66 @@
-!> @file print_1d.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ SUBROUTINE print_1d
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
+! $Log: print_1d.f90,v $
+! Revision 1.11  2006/02/23 12:50:43  raasch
+! Preliminary no output of time-averaged data
 !
+! Revision 1.10  2001/03/30 07:48:24  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.9  2001/01/22 20:51:40  letzel
+! All comments translated into English.
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! Renamed output variables
+! Revision 1.8  2001/01/22 07:55:14  raasch
+! Module test_variables removed
+!
+! Revision 1.7  1998/07/06 12:31:17  raasch
+! Mittelungszeitraum wird direkt durch average_period_pr1d angegeben,
+! + USE test_variables
+!
+! Revision 1.6  1998/03/30 11:38:16  raasch
+! Ausgaben fuer die (Teil-) Gebiete
+!
+! Revision 1.5  1998/03/25 13:56:31  raasch
+! Erweiterungen fuer Gebietsstatistiken
+!
+! Revision 1.4  1998/03/18 20:18:33  raasch
+! Zusaetzliche Header werden ausgegeben
+!
+! Revision 1.3  1998/03/03 08:01:28  raasch
+! Aufruf von flow_statistics erfolgt jetzt gegebenenfalls hier
+! Ausgabe von zeitlich gemittelten Profilen
+!
+! Revision 1.2  1998/02/10 15:09:16  raasch
+! Ausdruck von Werten im w-Niveau
 !
 ! Revision 1.1  1997/09/19 07:45:22  raasch
 ! Initial revision
 !
-!--------------------------------------------------------------------------------------------------!
+!
 ! Description:
 ! ------------
-!> List output of 1D-profiles.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE print_1d
+! List output of 1D-profiles.
+!------------------------------------------------------------------------------!
 
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zu,                                                                                 &
-               zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  run_description_header,                                                             &
-               simulated_time_chr
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point
-
-    USE indices,                                                                                   &
-        ONLY:  nzb,                                                                                &
-               nzt
-
-    USE kinds
-
+    USE arrays_3d
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
     USE pegrid
-
-    USE statistics,                                                                                &
-        ONLY:  flow_statistics_called,                                                             &
-               hom,                                                                                &
-               region,                                                                             &
-               statistic_regions
+    USE statistics
 
     IMPLICIT NONE
 
 
-    CHARACTER(LEN=20) ::  period_chr  !<
-
-    INTEGER(iwp) ::  k   !<
-    INTEGER(iwp) ::  sr  !<
+    CHARACTER (LEN=20) ::  period_chr
+    INTEGER ::  k, sr
 
 
@@ -102,41 +87,55 @@
 !
 !--       Write header.
-          WRITE( 16, 112 )
-          WRITE( 16, 100 )  TRIM( run_description_header ) // '    ' //                            &
-                            TRIM( region( sr ) ), TRIM( period_chr ), 'uv'
-          WRITE( 16, 105 )  TRIM( simulated_time_chr )
-          WRITE( 16, 111 )
+          WRITE ( 16, 112 )
+          WRITE ( 16, 100 )  TRIM( run_description_header ) // '    ' // &
+                             TRIM( region( sr ) ), TRIM( period_chr ), 'uv'
+          WRITE ( 16, 105 )  TRIM( simulated_time_chr )
+!          ELSE
+!             WRITE ( 16, 106 )  TRIM( simulated_time_chr ),           &
+!                                averaging_interval_pr, average_count_pr
+!          ENDIF
+          WRITE ( 16, 111 )
 
 !
 !--       Output of values on the scalar levels.
-          WRITE( 16, 120 )
-          WRITE( 16, 111 )
+          WRITE ( 16, 120 )
+          WRITE ( 16, 111 )
           DO  k = nzt+1, nzb, -1
-             WRITE( 16, 121)  k, zu(k), hom(k,1,1,sr), hom(k,1,1,sr) - hom(k,1,5,sr),              &
-                              hom(k,1,2,sr), hom(k,1,2,sr) - hom(k,1,6,sr), hom(k,1,4,sr),         &
-                              hom(k,1,4,sr) - hom(k,1,7,sr), hom(k,1,8,sr), hom(k,1,9,sr),         &
-                              hom(k,1,10,sr), hom(k,1,11,sr), zu(k), k
+             WRITE ( 16, 121)  k, zu(k), hom(k,1,1,sr),           &
+                               hom(k,1,1,sr) - hom(k,1,5,sr),     &
+                               hom(k,1,2,sr),                     &
+                               hom(k,1,2,sr) - hom(k,1,6,sr),     &
+                               hom(k,1,4,sr),                     &
+                               hom(k,1,4,sr) - hom(k,1,7,sr),     &
+                               hom(k,1,8,sr), hom(k,1,9,sr),      &
+                               hom(k,1,10,sr), hom(k,1,11,sr), zu(k), k
           ENDDO
-          WRITE( 16, 111 )
-          WRITE( 16, 120 )
-          WRITE( 16, 111 )
+          WRITE ( 16, 111 )
+          WRITE ( 16, 120 )
+          WRITE ( 16, 111 )
 
 !
 !--       Output of values on the w-levels.
-          WRITE( 16, 112 )
-          WRITE( 16, 100 )  TRIM( run_description_header ) // '    ' //                            &
-                            TRIM( region( sr ) ), TRIM( period_chr ), 'w'
-          WRITE( 16, 105 )  TRIM( simulated_time_chr )
-          WRITE( 16, 111 )
+          WRITE ( 16, 112 )
+          WRITE ( 16, 100 )  TRIM( run_description_header ) // '    ' // &
+                             TRIM( region( sr ) ), TRIM( period_chr ), 'w'
+          WRITE ( 16, 105 )  TRIM( simulated_time_chr )
+!          ELSE
+!             WRITE ( 16, 106 )  TRIM( simulated_time_chr ),           &
+!                                averaging_interval_pr, average_count_pr
+!          ENDIF
+          WRITE ( 16, 111 )
 
-          WRITE( 16, 130 )
-          WRITE( 16, 111 )
+          WRITE ( 16, 130 )
+          WRITE ( 16, 111 )
           DO  k = nzt+1, nzb, -1
-             WRITE( 16, 131)  k, zw(k), hom(k,1,16,sr), hom(k,1,18,sr), hom(k,1,12,sr),            &
-                              hom(k,1,19,sr), hom(k,1,14,sr), hom(k,1,20,sr), zw(k), k
+             WRITE ( 16, 131)  k, zw(k), hom(k,1,16,sr),            &
+                               hom(k,1,18,sr), hom(k,1,12,sr), &
+                               hom(k,1,19,sr), hom(k,1,14,sr), &
+                               hom(k,1,20,sr), zw(k), k
           ENDDO
-          WRITE( 16, 111 )
-          WRITE( 16, 130 )
-          WRITE( 16, 111 )
+          WRITE ( 16, 111 )
+          WRITE ( 16, 130 )
+          WRITE ( 16, 111 )
 
        ENDDO
@@ -144,19 +143,22 @@
     ENDIF
 
-    CALL cpu_log( log_point(18), 'print_1d', 'stop' )
+    CALL cpu_log( log_point(18), 'print_1d','stop', 'nobarrier' )
 
 !
 !-- Formats.
-100 FORMAT( 1X, A / 1X, 10( '-' ) / ' Horizontally', A, ' averaged profiles on the ', A, '-level' )
-105 FORMAT( ' Time: ', A )
-111 FORMAT( 1X, 131( '-' ) )
-112 FORMAT( / )
-120 FORMAT( '   k     zu      u     du     v     dv     theta dtheta ',                            &
-            ' e      Km    Kh     l    zu      k' )
-121 FORMAT( 1X, I4, 1X, F7.1, 1X, F6.2, 1X, F5.2, 1X, F6.2, 1X, F5.2, 2X, F6.2, 1X, F5.2, 1X,      &
-            F7.4, 1X, F5.2, 1X, F5.2, 1X, F6.2, 1X, F7.1, 2X, I4 )
-130 FORMAT( '   k     zw       w''theta''   wtheta     w''u''       wu       ',                    &
-            '  w''v''       wv        zw      k' )
-131 FORMAT( 1X, I4, 1X, F7.1, 6( 1X, E10.3 ), 1X, F7.1, 2X, I4 )
+100 FORMAT (1X,A/1X,10('-')/ &
+            ' Horizontally',A,' averaged profiles on the ',A,'-level')
+105 FORMAT (' Time: ',A)
+106 FORMAT (' Time: ',A,18X,'averaged over',F7.1,' s (',I4, &
+            ' Single times)')
+111 FORMAT (1X,131('-'))
+112 FORMAT (/)
+120 FORMAT ('   k     zu      u     du     v     dv     pt    dpt    ', &
+            'e      Km    Kh     l      zu      k')
+121 FORMAT (1X,I4,1X,F7.1,1X,F6.2,1X,F5.2,1X,F6.2,1X,F5.2,2X,F6.2,1X,F5.2, &
+            1X,F6.4,1X,F5.2,1X,F5.2,1X,F6.2,1X,F7.1,2X,I4)
+130 FORMAT ('   k     zw      w''pt''     wpt       w''u''      wu       ', &
+            ' w''v''      wv        zw      k')
+131 FORMAT (1X,I4,1X,F7.1,6(1X,E9.3),1X,F7.1,2X,I4)
 
 
Index: palm/trunk/SOURCE/production_e.f90
===================================================================
--- palm/trunk/SOURCE/production_e.f90	(revision 1)
+++ palm/trunk/SOURCE/production_e.f90	(revision 1)
@@ -0,0 +1,865 @@
+ MODULE production_e_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: production_e.f90,v $
+! Revision 1.21  2006/04/26 12:45:35  raasch
+! OpenMP parallelization of production_e_init
+!
+! Revision 1.20  2006/02/23 12:51:25  raasch
+! nzb_2d and nzb_diff_2d replaced by nzb_s_outer and nzb_diff_s_outer
+! respectively, momentum flux calculation at vertical walls using profile
+! functions, loop rearrangement for better vectorization
+!
+! Revision 1.19  2005/06/29 08:15:33  steinfeld
+! Error in calculating u_0 and v_0 removed (multiplication instead of
+! division by 2dz)
+!
+! Revision 1.18  2004/04/30 12:45:54  raasch
+! dptdz eliminated
+!
+! Revision 1.17  2004/01/30 10:36:00  raasch
+! Velocity gradients at the surface limited (see u_0, v_0),
+! scalar lower k index nzb_diff replaced by 2d-array nzb_diff_2d
+!
+! Revision 1.16  2003/03/12 16:40:22  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.15  2002/12/19 16:16:34  raasch
+! Calculation of deformation tensor re-designed (most of the finite
+! differences are now formed over two grid spacings, errors in derivatives
+! along y removed)
+!
+! Revision 1.14  2002/09/12 13:09:44  raasch
+! Error in calculating v_0 removed
+!
+! Revision 1.13  2002/06/11 13:19:04  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+! Calculation of u_0 and v_0 moved to the new subroutine production_e_init
+! due to the global communication necessary. These arrays are allocated only
+! once during the first call.
+!
+! Revision 1.12  2001/08/21 09:59:47  raasch
+! Special treatment at k=1 generally if surface fluxes are prescribed (not only
+! in case of a Prandtl layer). In these cases, the boundary conditions are
+! also included in the shear production term.
+!
+! Revision 1.11  2001/03/30 07:48:54  raasch
+! Calculation of shear production and buoyancy production is split into
+! two loops, arguments k1 and k2 are eliminated and now used as scalars,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.10  2001/01/22 07:56:19  raasch
+! Module test_variables removed
+!
+! Revision 1.9  2001/01/02 17:34:12  raasch
+! -dpt_dz_d, dpt_dz_u
+!
+! Revision 1.8  2000/07/03 13:00:24  raasch
+! Arguments k1 and k2 declared as pointers,
+! all comments tranlated into English
+!
+! Revision 1.7  2000/04/18 08:13:00  schroeter
+! Revision 1.5 rueckgaengig gemacht, Temperaturgrandient im
+! Auftriebtrem wird wieder durch zentrale Differenzen gebildet
+!
+! Revision 1.6  2000/04/13 14:24:02  schroeter
+! condsidering the influence of humidity to TKE-production
+!
+! Revision 1.5  99/02/17  09:29:18  09:29:18  raasch (Siegfried Raasch)
+! Vertikalscherung des Windes exakter formuliert
+! Temperaturgradient im Auftriebsterm enger gefasst, im stabilen Fall wird
+! jetzt das Minimum vom oberen und unteren Differenzenquotienten verwendet
+! 
+! Revision 1.4  1998/07/06 12:31:52  raasch
+! + USE test_variables
+!
+! Revision 1.3  1998/04/15 11:23:49  raasch
+! Im Fall einer Prandtl-Schicht wird die Energieproduktion bei nzb+1
+! jetzt immer mittels shf und sonst ueber dpt/dz berechnet (bisher nur bei
+! vorgegebenem Waermestrom)
+!
+! Revision 1.2  1998/02/19 07:10:51  raasch
+! vorgegebener Waermestrom wird gegebenenfalls im Auftriebsterm bei
+! k=nzb+1 direkt angegeben
+!
+! Revision 1.1  1997/09/19 07:45:35  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Production terms (shear + buoyancy) of the TKE
+!------------------------------------------------------------------------------!
+
+    PRIVATE
+    PUBLIC production_e, production_e_init
+    
+    LOGICAL, SAVE ::  first_call = .TRUE.
+
+    REAL, DIMENSION(:,:), ALLOCATABLE, SAVE ::  u_0, v_0
+
+    INTERFACE production_e
+       MODULE PROCEDURE production_e
+       MODULE PROCEDURE production_e_ij
+    END INTERFACE production_e
+    
+    INTERFACE production_e_init
+       MODULE PROCEDURE production_e_init
+    END INTERFACE production_e_init
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE production_e
+
+       USE arrays_3d
+       USE cloud_parameters
+       USE control_parameters
+       USE grid_variables
+       USE indices
+       USE statistics
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+
+       REAL    ::  def, dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz, &
+                   k1, k2, theta, temp, usvs, vsus, wsus, wsvs
+
+
+!
+!--    Calculate TKE production by shear
+       DO  i = nxl, nxr
+
+          DO  j = nys, nyn
+             DO  k = nzb_diff_s_outer(j,i), nzt-1
+
+                dudx  =        ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                dudy  = 0.25 * ( 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  * ( 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 * ( 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  * ( 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 * ( 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 * ( 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 * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                      dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                      dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                IF ( def < 0.0 )  def = 0.0
+
+                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+                
+             ENDDO
+          ENDDO
+
+          IF ( use_surface_fluxes )  THEN
+
+!
+!--          Position neben Gebaeudewand
+!--          2 - Wird immer ausgefuehrt. 'Boden und Wand: 
+!--          u_0,v_0 und Wall functions'
+             DO  j = nys, nyn
+
+                IF ( ( wall_e_x(j,i) /= 0.0 ) .OR. ( wall_e_y(j,i) /= 0.0 ) ) &
+                THEN
+
+                   k = nzb_diff_s_inner(j,i) - 1
+                   dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+                   IF ( wall_e_y(j,i) /= 0.0 )  THEN
+                      usvs = kappa * 0.5 * ( u(k,j,i) + u(k,j,i+1) ) &
+                             / LOG( 0.5 * dy / z0(j,i) )
+                      usvs = usvs * ABS( usvs )
+                      dudy = wall_e_y(j,i) * usvs / km(k,j,i)
+                   ELSE
+                      dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                      u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                   ENDIF
+                   dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                  u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
+
+                   IF ( wall_e_x(j,i) /= 0.0 )  THEN
+                      vsus = kappa * 0.5 * ( v(k,j,i) + v(k,j+1,i) ) &
+                             / LOG( 0.5 * dx / z0(j,i))
+                      vsus = vsus * ABS( vsus )
+                      dvdx = wall_e_x(j,i) * vsus / km(k,j,i)
+                   ELSE
+                      dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                      v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                   ENDIF
+                   dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+                   dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                  v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
+
+                   IF ( wall_e_x(j,i) /= 0.0 )  THEN
+                      wsus = kappa * 0.5 * ( w(k,j,i) + w(k-1,j,i) ) &
+                             / LOG( 0.5 * dx / z0(j,i))
+                      wsus = wsus * ABS( wsus )
+                      dwdx = wall_e_x(j,i) * wsus / km(k,j,i)
+                   ELSE
+                      dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                      w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                   ENDIF
+                   IF ( wall_e_y(j,i) /= 0.0 ) THEN
+                      wsvs = kappa * ( w(k,j,i) + w(k-1,j,i) ) &
+                             / LOG( 0.5 * dy / z0(j,i))
+                      wsvs = wsvs * ABS( wsvs )
+                      dwdy = wall_e_y(j,i) * wsvs / km(k,j,i)
+                   ELSE
+                      dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                      w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                   ENDIF
+                   dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+                   def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                         dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                   IF ( def < 0.0 )  def = 0.0
+
+                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                ENDIF
+
+             ENDDO
+
+!
+!--          3 - Wird nur ausgefuehrt, wenn mindestens ein Niveau
+!--          zwischen 2 und 4 liegt, d.h. ab einer Gebaeudemindest-
+!--          hoehe von 2 dz. 'Nur Wand: Wall functions'
+             DO  j = nys, nyn
+
+                IF ( ( wall_e_x(j,i) /= 0.0 ) .OR. ( wall_e_y(j,i) /= 0.0 ) ) &
+                THEN
+
+                   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
+                      IF ( wall_e_y(j,i) /= 0.0 )  THEN
+                         usvs = kappa * 0.5 * ( u(k,j,i) + u(k,j,i+1) ) &
+                                / LOG( 0.5 * dy / z0(j,i) )
+                         usvs = usvs * ABS( usvs )
+                         dudy = wall_e_y(j,i) * usvs / km(k,j,i)
+                      ELSE
+                         dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                         u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                      ENDIF
+                      dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                     u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+                      IF ( wall_e_x(j,i) /= 0.0 )  THEN
+                         vsus = kappa * 0.5 * ( v(k,j,i) + v(k,j+1,i) ) &
+                                / LOG( 0.5 * dx / z0(j,i))
+                         vsus = vsus * ABS( vsus )
+                         dvdx = wall_e_x(j,i) * vsus / km(k,j,i)
+                      ELSE
+                         dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                         v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                      ENDIF
+                      dvdy =       ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                      dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                     v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+                      IF ( wall_e_x(j,i) /= 0.0 )  THEN
+                         wsus = kappa * 0.5 * ( w(k,j,i) + w(k-1,j,i) ) &
+                                / LOG( 0.5 * dx / z0(j,i))
+                         wsus = wsus * ABS( wsus )
+                         dwdx = wall_e_x(j,i) * wsus / km(k,j,i)
+                      ELSE
+                         dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                         w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                      ENDIF
+                      IF ( wall_e_y(j,i) /= 0.0 )  THEN
+                         wsvs = kappa * ( w(k,j,i) + w(k-1,j,i) ) &
+                                / LOG( 0.5 * dy / z0(j,i))
+                         wsvs = wsvs * ABS( wsvs )
+                         dwdy = wall_e_y(j,i) * wsvs / km(k,j,i)
+                      ELSE
+                         dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                         w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                      ENDIF
+                      dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+                      def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                           dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 +  &
+                           dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                      IF ( def < 0.0 )  def = 0.0
+
+                      tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                   ENDDO
+
+                ENDIF
+
+             ENDDO
+
+!
+!--          4 - Wird immer ausgefuehrt.
+!--          'Sonderfall: Freie Atmosphaere' (wie bei 0)
+             DO  j = nys, nyn
+
+                IF ( ( wall_e_x(j,i) /= 0.0 ) .OR. ( wall_e_y(j,i) /= 0.0 ) ) &
+                THEN
+
+                   k = nzb_diff_s_outer(j,i)-1
+
+                   dudx  =        ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                   dudy  = 0.25 * ( 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  * ( 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 * ( 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  * ( 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 * ( 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 * ( 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 * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                         dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                   IF ( def < 0.0 )  def = 0.0
+
+                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                ENDIF
+
+             ENDDO
+
+!
+!--          Position ohne angrenzende Gebaeudewand
+!--          1 - Wird immer ausgefuehrt. 'Nur Boden: u_0,v_0'
+             DO  j = nys, nyn
+
+                IF ( ( wall_e_x(j,i) == 0.0 ) .AND. ( wall_e_y(j,i) == 0.0 ) ) &
+                THEN
+
+                   k = nzb_diff_s_inner(j,i)-1
+
+                   dudx  =        ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                   dudy  = 0.25 * ( 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  * ( 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 * ( 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  * ( 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 * ( 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 * ( 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 * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                         dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                   IF ( def < 0.0 )  def = 0.0
+
+                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+                
+                ENDIF
+
+             ENDDO
+
+          ENDIF
+
+!
+!--       Calculate TKE production by buoyancy
+          IF ( .NOT. moisture )  THEN
+
+             DO  j = nys, nyn
+
+                DO  k = nzb_diff_s_inner(j,i), nzt-1
+                   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
+
+             ENDDO
+
+          ELSE
+
+             DO  j = nys, nyn
+
+                DO  k = nzb_diff_s_inner(j,i), nzt-1
+
+                   IF ( .NOT. cloud_physics )  THEN
+                      k1 = 1.0 + 0.61 * q(k,j,i)
+                      k2 = 0.61 * pt(k,j,i)
+                   ELSE
+                      IF ( ql(k,j,i) == 0.0 )  THEN
+                         k1 = 1.0 + 0.61 * q(k,j,i)
+                         k2 = 0.61 * 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 - q(k,j,i) + 1.61 *                 &
+                                    ( q(k,j,i) - ql(k,j,i) ) *          &
+                              ( 1.0 + 0.622 * l_d_r / temp ) ) /        &
+                              ( 1.0 + 0.622 * 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 )
+                      ENDIF
+                   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)
+                ENDDO
+
+             ENDDO
+
+             IF ( use_surface_fluxes )  THEN
+
+                DO  j = nys, nyn
+
+                   k = nzb_diff_s_inner(j,i)-1
+
+                   IF ( .NOT. cloud_physics )  THEN
+                      k1 = 1.0 + 0.61 * q(k,j,i)
+                      k2 = 0.61 * pt(k,j,i)
+                   ELSE
+                      IF ( ql(k,j,i) == 0.0 )  THEN
+                         k1 = 1.0 + 0.61 * q(k,j,i)
+                         k2 = 0.61 * 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 - q(k,j,i) + 1.61 *                 &
+                                    ( q(k,j,i) - ql(k,j,i) ) *          &
+                              ( 1.0 + 0.622 * l_d_r / temp ) ) /        &
+                              ( 1.0 + 0.622 * 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 )
+                      ENDIF
+                   ENDIF
+
+                   tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+                                         ( k1* shf(j,i) + k2 * qsws(j,i) )
+                ENDDO
+
+             ENDIF
+
+          ENDIF
+
+       ENDDO
+
+    END SUBROUTINE production_e
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE production_e_ij( i, j )
+
+       USE arrays_3d
+       USE cloud_parameters
+       USE control_parameters
+       USE grid_variables
+       USE indices
+       USE statistics
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+
+       REAL    ::  def, dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz, &
+                   k1, k2, theta, temp, usvs, vsus, wsus,wsvs
+
+!
+!--    Calculate TKE production by shear
+       DO  k = nzb_diff_s_outer(j,i), nzt-1
+
+          dudx  =        ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+          dudy  = 0.25 * ( 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  * ( 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 * ( 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  * ( 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 * ( 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 * ( 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 * ( dudx**2 + dvdy**2 + dwdz**2 )                       &
+                + dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + dvdz**2 &
+                + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+          IF ( def < 0.0 )  def = 0.0
+
+          tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+                
+       ENDDO
+
+       IF ( use_surface_fluxes )  THEN
+
+          IF ( ( wall_e_x(j,i) /= 0.0 ) .OR. ( wall_e_y(j,i) /= 0.0 ) )  THEN
+!
+!--          Position neben Gebaeudewand
+!--          2 - Wird immer ausgefuehrt. 'Boden und Wand: 
+!--          u_0,v_0 und Wall functions'
+             k = nzb_diff_s_inner(j,i)-1
+
+             dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+             IF ( wall_e_y(j,i) /= 0.0 )  THEN
+                usvs = kappa * 0.5 * ( u(k,j,i) + u(k,j,i+1) ) &
+                       / LOG( 0.5 * dy / z0(j,i) )
+                usvs = usvs * ABS( usvs )
+                dudy = wall_e_y(j,i) * usvs / km(k,j,i)
+             ELSE
+                dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+             ENDIF
+             dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                            u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
+
+             IF ( wall_e_x(j,i) /= 0.0 )  THEN
+                vsus = kappa * 0.5 * ( v(k,j,i) + v(k,j+1,i) ) &
+                       / LOG( 0.5 * dx / z0(j,i))
+                vsus = vsus * ABS( vsus )
+                dvdx = wall_e_x(j,i) * vsus / km(k,j,i)
+             ELSE
+                dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+             ENDIF
+             dvdy =       ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+             dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                            v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
+
+             IF ( wall_e_x(j,i) /= 0.0 )  THEN
+                wsus = kappa * 0.5 * ( w(k,j,i) + w(k-1,j,i) ) &
+                       / LOG( 0.5 * dx / z0(j,i))
+                wsus = wsus * ABS( wsus )
+                dwdx = wall_e_x(j,i) * wsus / km(k,j,i)
+             ELSE
+                dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+             ENDIF
+             IF ( wall_e_y(j,i) /= 0.0 )  THEN
+                wsvs = kappa * ( w(k,j,i) + w(k-1,j,i) ) &
+                       / LOG( 0.5 * dy / z0(j,i))
+                wsvs = wsvs * ABS( wsvs )
+                dwdy = wall_e_y(j,i) * wsvs / km(k,j,i)
+             ELSE
+                dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+             ENDIF
+             dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+             def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                   dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                   dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+             IF ( def < 0.0 )  def = 0.0
+
+             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+!
+!--          3 - Wird nur ausgefuehrt, wenn mindestens ein Niveau
+!--          zwischen 2 und 4 liegt, d.h. ab einer Gebaeudemindest-
+!--          hoehe von 2 dz. 'Nur Wand: 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
+                IF ( wall_e_y(j,i) /= 0.0 )  THEN
+                   usvs = kappa * 0.5 * ( u(k,j,i) + u(k,j,i+1) ) &
+                          / LOG( 0.5 * dy / z0(j,i) )
+                   usvs = usvs * ABS( usvs )
+                   dudy = wall_e_y(j,i) * usvs / km(k,j,i)
+                ELSE
+                   dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                   u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                ENDIF
+                dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                               u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+                IF ( wall_e_x(j,i) /= 0.0 )  THEN
+                   vsus = kappa * 0.5 * ( v(k,j,i) + v(k,j+1,i) ) &
+                          / LOG( 0.5 * dx / z0(j,i))
+                   vsus = vsus * ABS( vsus )
+                   dvdx = wall_e_x(j,i) * vsus / km(k,j,i)
+                ELSE
+                   dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                   v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                ENDIF
+                dvdy =       ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                               v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+                IF ( wall_e_x(j,i) /= 0.0 )  THEN
+                   wsus = kappa * 0.5 * ( w(k,j,i) + w(k-1,j,i) ) &
+                          / LOG( 0.5 * dx / z0(j,i))
+                   wsus = wsus * ABS( wsus )
+                   dwdx = wall_e_x(j,i) * wsus / km(k,j,i)
+                ELSE
+                   dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                   w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                ENDIF
+                IF ( wall_e_y(j,i) /= 0.0 )  THEN
+                   wsvs = kappa * ( w(k,j,i) + w(k-1,j,i) ) &
+                          / LOG( 0.5 * dy / z0(j,i))
+                   wsvs = wsvs * ABS( wsvs )
+                   dwdy = wall_e_y(j,i) * wsvs / km(k,j,i)
+                ELSE
+                   dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                   w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                ENDIF
+                dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+                def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                      dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                      dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                IF ( def < 0.0 )  def = 0.0
+
+                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+             ENDDO
+
+!
+!--          4 - Wird immer ausgefuehrt.
+!--          'Sonderfall: Freie Atmosphaere' (wie bei 0)
+             k = nzb_diff_s_outer(j,i)-1
+
+             dudx  =        ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+             dudy  = 0.25 * ( 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  * ( 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 * ( 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  * ( 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 * ( 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 * ( 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 * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                   dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                   dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+             IF ( def < 0.0 )  def = 0.0
+
+             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+          ELSE
+
+!
+!--          Position ohne angrenzende Gebaeudewand
+!--          1 - Wird immer ausgefuehrt. 'Nur Boden: 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 * ( 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  * ( 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 * ( 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  * ( 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 * ( 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 * ( 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 * ( dudx**2 + dvdy**2 + dwdz**2 )                       &
+                   + dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + dvdz**2 &
+                   + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+             IF ( def < 0.0 )  def = 0.0
+
+             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+          ENDIF
+
+       ENDIF
+
+!
+!--    Calculate TKE production by buoyancy
+       IF ( .NOT. moisture )  THEN
+
+          DO  k = nzb_diff_s_inner(j,i), nzt-1
+             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
+
+       ELSE
+
+          DO  k = nzb_diff_s_inner(j,i), nzt-1
+
+             IF ( .NOT. cloud_physics )  THEN
+                k1 = 1.0 + 0.61 * q(k,j,i)
+                k2 = 0.61 * pt(k,j,i)
+             ELSE
+                IF ( ql(k,j,i) == 0.0 )  THEN
+                   k1 = 1.0 + 0.61 * q(k,j,i)
+                   k2 = 0.61 * 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 - q(k,j,i) + 1.61 *                 &
+                              ( q(k,j,i) - ql(k,j,i) ) *          &
+                        ( 1.0 + 0.622 * l_d_r / temp ) ) /        &
+                        ( 1.0 + 0.622 * 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 )
+                ENDIF
+             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)
+          ENDDO
+          IF ( use_surface_fluxes )  THEN
+             k = nzb_diff_s_inner(j,i)-1
+
+             IF ( .NOT. cloud_physics ) THEN
+                k1 = 1.0 + 0.61 * q(k,j,i)
+                k2 = 0.61 * pt(k,j,i)
+             ELSE
+                IF ( ql(k,j,i) == 0.0 )  THEN
+                   k1 = 1.0 + 0.61 * q(k,j,i)
+                   k2 = 0.61 * 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 - q(k,j,i) + 1.61 *                 &
+                              ( q(k,j,i) - ql(k,j,i) ) *          &
+                        ( 1.0 + 0.622 * l_d_r / temp ) ) /        &
+                        ( 1.0 + 0.622 * 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 )
+                ENDIF
+             ENDIF
+
+             tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+                                         ( k1* shf(j,i) + k2 * qsws(j,i) )
+          ENDIF
+
+       ENDIF
+
+    END SUBROUTINE production_e_ij
+
+
+    SUBROUTINE production_e_init
+
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, ku, kv
+
+       IF ( use_surface_fluxes )  THEN
+
+          IF ( first_call )  THEN
+             ALLOCATE( u_0(nys-1:nyn+1,nxl-1:nxr+1), &
+                       v_0(nys-1:nyn+1,nxl-1:nxr+1) )
+             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).
+!--       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
+             DO  j = nys, nyn
+
+                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 * ( km(ku,j,i) + km(ku,j,i-1) ) +       &
+                                   1.0E-20 )
+!                                  ( 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 * ( km(kv,j,i) + km(kv,j-1,i) ) +       &
+                                   1.0E-20 )
+!                                  ( 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 4901)
+++ palm/trunk/SOURCE/prognostic_equations.f90	(revision 1)
@@ -1,494 +1,545 @@
-!> @file prognostic_equations.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ MODULE prognostic_equations_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Move exchange_horiz from time_integration to modules
-!
-! 4717 2020-09-30 22:27:40Z pavelkrc
-! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
-! directives (J. Resler)
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4649 2020-08-25 12:11:17Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4370 2020-01-10 14:00:44Z raasch
-! Vector directives added to force vectorization on Intel19 compiler
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4110 2019-07-22 17:05:21Z suehring
-! Pass integer flag array to WS scalar advection routine which is now necessary as the flags may
-! differ for scalars, e.g. pt can be cyclic while chemical species may be non-cyclic. Further,
-! pass boundary flags.
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! Application of monotonic flux limiter for the vertical scalar advection up to the topography top
-! (only for the cache-optimized version at the moment). Please note, at the moment the limiter is
-! only applied for passive scalars.
-!
-! 4048 2019-06-21 21:00:21Z knoop
-! Moved tcm_prognostic_equations to module_interface
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3956 2019-05-07 12:32:52Z monakurppa
-! Removed salsa calls.
-!
-! 3931 2019-04-24 16:34:28Z schwenkel
-! Correct/complete module_interface introduction for chemistry model
-!
-! 3899 2019-04-16 14:05:27Z monakurppa
-! Corrections in the OpenMP version of salsa
-!
-! 3887 2019 -04-12 08:47:41Z schwenkel
-! Implicit Bugfix for chemistry model, loop for non_transport_physics over ghost points is avoided.
-! Instead introducing module_interface_exchange_horiz.
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3881 2019-04-10 09:31:22Z suehring
-! Bugfix in OpenMP directive
-!
-! 3880 2019-04-08 21:43:02Z knoop
-! Moved wtm_tendencies to module_interface_actions
-!
-! 3874 2019-04-08 16:53:48Z knoop
-! Added non_transport_physics module interfaces and moved bcm code into it
-!
-! 3872 2019-04-08 15:03:06Z knoop
-! Moving prognostic equations of bcm into bulk_cloud_model_mod
-!
-! 3864 2019-04-05 09:01:56Z monakurppa
-! Modifications made for salsa:
-! - salsa_prognostic_equations moved to salsa_mod (and the call to module_interface_mod)
-! - Renamed nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast --> ngases_salsa and
-!   loop indices b, c and sg to ib, ic and ig
-!
-! 3840 2019-03-29 10:35:52Z knoop
-! Added USE chem_gasphase_mod for nspec, nspec and spc_names
-!
-! 3820 2019-03-27 11:53:41Z forkel
-! Renamed do_depo to deposition_dry (ecc)
-!
-! 3797 2019-03-15 11:15:38Z forkel
-! Call chem_integegrate in OpenMP loop (ketelsen)
-!
-!
-! 3771 2019-02-28 12:19:33Z raasch
-! Preprocessor directivs fro rrtmg added
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! Unused variable removed
-!
-! 3719 2019-02-06 13:10:18Z kanani
-! Cleaned up chemistry cpu measurements
-!
-! 3684 2019-01-20 20:20:58Z knoop
-! OpenACC port for SPEC
+! $Log: prognostic_equations.f90,v $
+! Revision 1.21  2006/08/04 15:01:07  raasch
+! upstream scheme can be forced to be used for tke (use_upstream_for_tke)
+! regardless of the timestep scheme used for the other quantities,
+! new argument diss in call of diffusion_e
+!
+! Revision 1.20  2006/02/23 12:52:08  raasch
+! nzb_2d replaced by nzb_u/v/w/s_inner, +z0 in argument list of diffusion_u/v/w
+!
+! Revision 1.19  2005/06/29 10:33:41  steinfeld
+! Scalars ug and vg are replaced by homonymous arrays in order to allow for
+! the consideration of a potential dependency of the geostrophic wind
+! components on height
+!
+! Revision 1.18  2005/03/26 20:58:45  raasch
+! Extension of horizontal loop upper bounds for non-cyclic boundary conditions,
+! additional arguments km_damp_x/y for diffusion_u/v/w
+!
+! Revision 1.17  2004/04/30 12:46:40  raasch
+! impulse_advec renamed momentum_advec
+!
+! Revision 1.16  2004/01/30 10:36:57  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.15  2004/01/28 15:24:35  raasch
+! Runge-Kutta schemes available, steering variables at and bt in equations
+! replaced by array sct
+!
+! Revision 1.14  2003/03/12 16:40:48  raasch
+! New routine prognostic_equations_vec, optimized for vector processors
+!
+! Revision 1.13  2002/06/11 13:20:21  raasch
+! Single node optimization: loops i and j extracted from all those
+! tendency-subroutines which do not contain communication. Some communication
+! parts moved before the i,j loops. Call of particle advection moved to
+! subroutine leap_frog.
+! Former subroutine changed to a module which contains two versions: one
+! with loop optimization for the single equations and one version with one
+! big optimized loop containing all prognostic equations.
+!
+! Revision 1.12  2002/05/02 18:54:12  raasch
+! Timelevel t+dt re-introduced, Asselin filter and exchange of ghost points
+! moved to routine leap_frog
+!
+! Revision 1.11  2002/04/16  08:12:40  08:12:40  raasch (Siegfried Raasch)
+! Particle advection will be performed only after the simulated time has
+! exceeded a user defined limit
+! 
+! Revision 1.10  2001/09/04 12:10:28  raasch
+! Exchange of ghost points added for the time filtered arrays
+!
+! Revision 1.9  2001/08/21 09:59:03  raasch
+! Calls to user-interface for tendency terms added
+!
+! Revision 1.8  2001/03/30 07:50:26  raasch
+! Timelevel t+dt eliminated, Asselin filter included in prognostic equations,
+! calling arguments eliminated or cut down from advec_s_bc, production_e,
+! advec_*_ups,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.7  2001/01/29 12:34:20  raasch
+! Passive scalar is considered
+!
+! Revision 1.6  2001/01/22 07:57:20  raasch
+! Module test_variables removed
+!
+! Revision 1.5  2000/12/28 13:38:00  raasch
+! Advec_particles is called unconditionally
+!
+! Revision 1.4  2000/07/03 13:01:02  raasch
+! module pointer_interfaces added to reduce cpu-time and memory demands
+! of the compilation process, actual argument "work" eliminated from
+! parameter list of diffusion_e
+!
+! Revision 1.3  2000/04/27 07:09:57  raasch
+! Temperature offset is added at cyclic boundaries (x-direction) when using
+! a sloping surface
+!
+! Revision 1.2  2000/04/13 15:04:28  schroeter
+! prognostic equation for the total water content added, new routines:
+! calc_precipitation, impact_of_latent_heat, calc_radiation,
+! diffusion_pt renamed to diffusion_s, changes in the parameter list of
+! subroutines diffusion_e, buyoancy, production_e
 !
 ! Revision 1.1  2000/04/13 14:56:27  schroeter
 ! Initial revision
 !
-!--------------------------------------------------------------------------------------------------!
+!
 ! Description:
 ! ------------
-!> Solving the prognostic equations.
-!--------------------------------------------------------------------------------------------------!
- MODULE prognostic_equations_mod
-
-    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 advec_ws,                                                                                  &
-        ONLY:  advec_s_ws,                                                                         &
-               advec_u_ws,                                                                         &
-               advec_v_ws,                                                                         &
-               advec_w_ws
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  diss_l_e,                                                                           &
-               diss_l_pt,                                                                          &
-               diss_l_q,                                                                           &
-               diss_l_s,                                                                           &
-               diss_l_sa,                                                                          &
-               diss_s_e,                                                                           &
-               diss_s_pt,                                                                          &
-               diss_s_q,                                                                           &
-               diss_s_s,                                                                           &
-               diss_s_sa,                                                                          &
-               e,                                                                                  &
-               e_p,                                                                                &
-               flux_s_e,                                                                           &
-               flux_s_pt,                                                                          &
-               flux_s_q,                                                                           &
-               flux_s_s,                                                                           &
-               flux_s_sa,                                                                          &
-               flux_l_e,                                                                           &
-               flux_l_pt,                                                                          &
-               flux_l_q,                                                                           &
-               flux_l_s,                                                                           &
-               flux_l_sa,                                                                          &
-               pt,                                                                                 &
-               ptdf_x,                                                                             &
-               ptdf_y,                                                                             &
-               pt_init,                                                                            &
-               pt_p,                                                                               &
-               prho,                                                                               &
-               q,                                                                                  &
-               q_init,                                                                             &
-               q_p,                                                                                &
-               rdf,                                                                                &
-               rdf_sc,                                                                             &
-               ref_state,                                                                          &
-               rho_ocean,                                                                          &
-               s,                                                                                  &
-               s_init,                                                                             &
-               s_p,                                                                                &
-               tend,                                                                               &
-               te_m,                                                                               &
-               tpt_m,                                                                              &
-               tq_m,                                                                               &
-               ts_m,                                                                               &
-               tu_m,                                                                               &
-               tv_m,                                                                               &
-               tw_m,                                                                               &
-               u,                                                                                  &
-               ug,                                                                                 &
-               u_init,                                                                             &
-               u_p,                                                                                &
-               v,                                                                                  &
-               vg,                                                                                 &
-               vpt,                                                                                &
-               v_init,                                                                             &
-               v_p,                                                                                &
-               w,                                                                                  &
-               w_p
-
-    USE buoyancy_mod,                                                                              &
-        ONLY:  buoyancy
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               constant_diffusion,                                                                 &
-               debug_output_timestep,                                                              &
-               dp_external,                                                                        &
-               dp_level_ind_b,                                                                     &
-               dp_smooth_factor,                                                                   &
-               dpdxy,                                                                              &
-               dt_3d,                                                                              &
-               humidity,                                                                           &
-               intermediate_timestep_count,                                                        &
-               intermediate_timestep_count_max,                                                    &
-               land_surface,                                                                       &
-               large_scale_forcing,                                                                &
-               large_scale_subsidence,                                                             &
-               monotonic_limiter_z,                                                                &
-               neutral,                                                                            &
-               nudging,                                                                            &
-               ocean_mode,                                                                         &
-               passive_scalar,                                                                     &
-               plant_canopy,                                                                       &
-               pt_reference,                                                                       &
-               salsa,                                                                              &
-               scalar_advec,                                                                       &
-               scalar_advec,                                                                       &
-               simulated_time,                                                                     &
-               sloping_surface,                                                                    &
-               time_since_reference_point,                                                         &
-               timestep_scheme,                                                                    &
-               tsc,                                                                                &
-               urban_surface,                                                                      &
-               use_subsidence_tendencies,                                                          &
-               use_upstream_for_tke,                                                               &
-               wind_turbine,                                                                       &
-               ws_scheme_mom,                                                                      &
-               ws_scheme_sca
-
-
-
-
-
-    USE coriolis_mod,                                                                              &
-        ONLY:  coriolis
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point,                                                                          &
-               log_point_s
-
-    USE diffusion_s_mod,                                                                           &
-        ONLY:  diffusion_s
-
-    USE diffusion_u_mod,                                                                           &
-        ONLY:  diffusion_u
-
-    USE diffusion_v_mod,                                                                           &
-        ONLY:  diffusion_v
-
-    USE diffusion_w_mod,                                                                           &
-        ONLY:  diffusion_w
-
-    USE indices,                                                                                   &
-        ONLY:  advc_flags_s,                                                                       &
-               nbgp,                                                                               &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxlu,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nysv,                                                                               &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               wall_flags_total_0
-
-    USE kinds
-
-    USE lsf_nudging_mod,                                                                           &
-        ONLY:  ls_advec,                                                                           &
-               nudge
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_actions,                                                           &
-               module_interface_exchange_horiz,                                                    &
-               module_interface_non_advective_processes,                                           &
-               module_interface_prognostic_equations
-
-    USE ocean_mod,                                                                                 &
-        ONLY:  stokes_drift_terms,                                                                 &
-               stokes_force,                                                                       &
-               wave_breaking,                                                                      &
-               wave_breaking_term
-
-    USE plant_canopy_model_mod,                                                                    &
-        ONLY:  cthf,                                                                               &
-               pcm_tendency
-
-#if defined( __rrtmg )
-    USE radiation_model_mod,                                                                       &
-        ONLY:  radiation,                                                                          &
-               radiation_tendency,                                                                 &
-               skip_time_do_radiation
-#endif
-
-    USE statistics,                                                                                &
-        ONLY:  hom
-
-    USE subsidence_mod,                                                                            &
-        ONLY:  subsidence
-
-    USE surface_mod,                                                                               &
-        ONLY :  surf_def_h,                                                                        &
-                surf_def_v,                                                                        &
-                surf_lsm_h,                                                                        &
-                surf_lsm_v,                                                                        &
-                surf_usm_h,                                                                        &
-                surf_usm_v
+! Solving the prognostic equations and advecting particles.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE cpulog
+    USE grid_variables
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE pointer_interfaces
+    USE statistics
+
+    USE advec_s_pw_mod
+    USE advec_s_up_mod
+    USE advec_u_pw_mod
+    USE advec_u_up_mod
+    USE advec_v_pw_mod
+    USE advec_v_up_mod
+    USE advec_w_pw_mod
+    USE advec_w_up_mod
+    USE buoyancy_mod
+    USE calc_precipitation_mod
+    USE calc_radiation_mod
+    USE coriolis_mod
+    USE diffusion_e_mod
+    USE diffusion_s_mod
+    USE diffusion_u_mod
+    USE diffusion_v_mod
+    USE diffusion_w_mod
+    USE impact_of_latent_heat_mod
+    USE production_e_mod
+    USE user_actions_mod
+
+
+    PRIVATE
+    PUBLIC prognostic_equations, prognostic_equations_fast, &
+           prognostic_equations_vec
+
+    INTERFACE prognostic_equations
+       MODULE PROCEDURE prognostic_equations
+    END INTERFACE prognostic_equations
+
+    INTERFACE prognostic_equations_fast
+       MODULE PROCEDURE prognostic_equations_fast
+    END INTERFACE prognostic_equations_fast
+
+    INTERFACE prognostic_equations_vec
+       MODULE PROCEDURE prognostic_equations_vec
+    END INTERFACE prognostic_equations_vec
+
+
+ CONTAINS
+
+
+ SUBROUTINE prognostic_equations
+
+!------------------------------------------------------------------------------!
+! Version with single loop optimization
+!
+! (Optimized over each single prognostic equation.)
+!------------------------------------------------------------------------------!
 
     IMPLICIT NONE
 
-    PRIVATE
-    PUBLIC prognostic_equations_cache, prognostic_equations_vector
-
-    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
-
-
- 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
-
-
-    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          !<
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_cache', 'start' )
-!
-!-- Time measurement can only be performed for the whole set of equations
-    CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
-
-    !$OMP PARALLEL DO PRIVATE (i,j) SCHEDULE( STATIC )
+    CHARACTER (LEN=9) ::  time_to_string
+    INTEGER ::  i, j, k
+    REAL    ::  sat, sbt
+
+!
+!-- Calculate those variables needed in the tendency terms which need
+!-- global communication
+    CALL calc_mean_pt_profile( pt, 4 )
+    IF ( moisture )  CALL calc_mean_pt_profile( vpt, 44 )
+
+!
+!-- u-velocity component
+    CALL cpu_log( log_point(5), 'u-equation', 'start' )
+
+!
+!-- u-tendency terms with communication
+    IF ( momentum_advec == 'ups-scheme' )  THEN
+       tend = 0.0
+       CALL advec_u_ups
+    ENDIF
+
+!
+!-- u-tendency terms with no communication
+    DO  i = nxl, nxr+uxrp
+       DO  j = nys, nyn
+!
+!--       Tendency terms
+          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+             tend(:,j,i) = 0.0
+             CALL advec_u_pw( i, j )
+          ELSE
+             IF ( momentum_advec /= 'ups-scheme' )  THEN
+                tend(:,j,i) = 0.0
+                CALL advec_u_up( i, j )
+             ENDIF
+          ENDIF
+          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+             CALL diffusion_u( i, j, ddzu, ddzw, km_m, km_damp_y, tend, u_m,   &
+                               usws_m, v_m, w_m, z0 )
+          ELSE
+             CALL diffusion_u( i, j, ddzu, ddzw, km, km_damp_y, tend, u, usws, &
+                               v, w, z0 )
+          ENDIF
+          CALL coriolis( i, j, 1 )
+          IF ( sloping_surface )  CALL buoyancy( i, j, pt, 1, 4 )
+          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) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) +    &
+                          dt_3d * (                                            &
+                                   tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) &
+                                 - tsc(4) * ( p(k,j,i) - p(k,j,i-1) ) * ddx    &
+                                  ) -                                          &
+                           tsc(5) * rdf(k) * ( u(k,j,i) - ug(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 * tend(k,j,i) + 5.3125 * tu_m(k,j,i)
+                ENDDO
+             ENDIF
+          ENDIF
+
+       ENDDO
+    ENDDO
+
+    CALL cpu_log( log_point(5), 'u-equation', 'stop' )
+
+!
+!-- v-velocity component
+    CALL cpu_log( log_point(6), 'v-equation', 'start' )
+
+!
+!-- v-tendency terms with communication
+    IF ( momentum_advec == 'ups-scheme' )  THEN
+       tend = 0.0
+       CALL advec_v_ups
+    ENDIF
+
+!
+!-- v-tendency terms with no communication
+    DO  i = nxl, nxr
+       DO  j = nys, nyn+vynp
+!
+!--       Tendency terms
+          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+             tend(:,j,i) = 0.0
+             CALL advec_v_pw( i, j )
+          ELSE
+             IF ( momentum_advec /= 'ups-scheme' )  THEN
+                tend(:,j,i) = 0.0
+                CALL advec_v_up( i, j )
+             ENDIF
+          ENDIF
+          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+             CALL diffusion_v( i, j, ddzu, ddzw, km_m, km_damp_x, tend, u_m, &
+                               v_m, vsws_m, w_m, z0 )
+          ELSE
+             CALL diffusion_v( i, j, ddzu, ddzw, km, km_damp_x, tend, u, v,  &
+                               vsws, w, z0 )
+          ENDIF
+          CALL coriolis( i, j, 2 )
+          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) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) +    &
+                          dt_3d * (                                            &
+                                   tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) &
+                                 - tsc(4) * ( p(k,j,i) - p(k,j-1,i) ) * ddy    &
+                                  ) -                                          &
+                          tsc(5) * rdf(k) * ( v(k,j,i) - vg(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 * tend(k,j,i) + 5.3125 * tv_m(k,j,i)
+                ENDDO
+             ENDIF
+          ENDIF
+
+       ENDDO
+    ENDDO
+
+    CALL cpu_log( log_point(6), 'v-equation', 'stop' )
+
+!
+!-- w-velocity component
+    CALL cpu_log( log_point(7), 'w-equation', 'start' )
+
+!
+!-- w-tendency terms with communication
+    IF ( momentum_advec == 'ups-scheme' )  THEN
+       tend = 0.0
+       CALL advec_w_ups
+    ENDIF
+
+!
+!-- w-tendency terms with no communication
     DO  i = nxl, nxr
        DO  j = nys, nyn
 !
-!--       Calculate non advective processes for all other modules
-          CALL module_interface_non_advective_processes( i, j )
+!--       Tendency terms
+          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+             tend(:,j,i) = 0.0
+             CALL advec_w_pw( i, j )
+          ELSE
+             IF ( momentum_advec /= 'ups-scheme' )  THEN
+                tend(:,j,i) = 0.0
+                CALL advec_w_up( i, j )
+             ENDIF
+          ENDIF
+          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+             CALL diffusion_w( i, j, ddzu, ddzw, km_m, km_damp_x, km_damp_y,  &
+                               tend, u_m, v_m, w_m, z0 )
+          ELSE
+             CALL diffusion_w( i, j, ddzu, ddzw, km, km_damp_x, km_damp_y,    &
+                               tend, u, v, w, z0 )
+          ENDIF
+          CALL coriolis( i, j, 3 )
+          IF ( .NOT. moisture )  THEN
+             CALL buoyancy( i, j, pt, 3, 4 )
+          ELSE
+             CALL buoyancy( i, j, vpt, 3, 44 )
+          ENDIF
+          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) = ( 1.0-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) +    &
+                          dt_3d * (                                            &
+                                   tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) &
+                              - tsc(4) * ( p(k+1,j,i) - p(k,j,i) ) * ddzu(k+1) &
+                                  ) -                                          &
+                          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 * tend(k,j,i) + 5.3125 * tw_m(k,j,i)
+                ENDDO
+             ENDIF
+          ENDIF
+
        ENDDO
     ENDDO
-!
-!-- Module Inferface for exchange horiz after non_advective_processes but before advection.
-!-- Therefore, non_advective_processes must not run for ghost points.
-    CALL module_interface_exchange_horiz( 'before_prognostic_equation' )
-!
-!-- 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
+
+    CALL cpu_log( log_point(7), 'w-equation', 'stop' )
+
+!
+!-- potential temperature
+    CALL cpu_log( log_point(13), 'pt-equation', 'start' )
+
+!
+!-- pt-tendency terms with communication
+    IF ( scalar_advec == 'bc-scheme' )  THEN
+!
+!--    Bott-Chlond scheme always uses Euler time step. Thus:
+       sat = 1.0
+       sbt = 1.0
+       tend = 0.0
+       CALL advec_s_bc( pt, 'pt' )
+    ELSE
+       sat = tsc(1)
+       sbt = tsc(2)
+       IF ( tsc(2) /= 2.0  .AND.  scalar_advec == 'ups-scheme' )  THEN
+          tend = 0.0
+          CALL advec_s_ups( pt, 'pt' )
+       ENDIF
+    ENDIF
+          
+!
+!-- pt-tendency terms with no communication
     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
 !
-!--       Tendency terms for u-velocity component. Please note, in case of non-cyclic boundary
-!--       conditions the grid point i=0 is excluded from the prognostic equations for the
-!--       u-component.
-          IF ( i >= nxlu )  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 )
+!--       Tendency terms
+          IF ( scalar_advec == 'bc-scheme' )  THEN
+             CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tend )
+          ELSE
+             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+                tend(:,j,i) = 0.0
+                CALL advec_s_pw( i, j, pt )
+             ELSE
+                IF ( scalar_advec /= 'ups-scheme' )  THEN
+                   tend(:,j,i) = 0.0
+                   CALL advec_s_up( i, j, pt )
+                ENDIF
+             ENDIF
+             IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' ) &
+             THEN
+                CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, tend )
+             ELSE
+                CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tend )
+             ENDIF
+          ENDIF
+
+!
+!--       If required compute heating/cooling due to long wave radiation
+!--       processes
+          IF ( radiation )  THEN
+             CALL calc_radiation( i, j )
+          ENDIF
+
+!
+!--       If required compute impact of latent heat due to precipitation
+          IF ( precipitation )  THEN
+             CALL impact_of_latent_heat( i, j )
+          ENDIF
+          CALL user_actions( i, j, 'pt-tendency' )
+
+!
+!--       Prognostic equation for potential temperature
+          DO  k = nzb_s_inner(j,i)+1, nzt-1
+             pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) + &
+                           dt_3d * (                                           &
+                                     sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) &
+                                   ) -                                         &
+                           tsc(5) * rdf(k) * ( pt(k,j,i) - pt_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_s_inner(j,i)+1, nzt-1
+                   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-1
+                   tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tpt_m(k,j,i)
+                ENDDO
+             ENDIF
+          ENDIF
+
+       ENDDO
+    ENDDO
+
+    CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
+
+!
+!-- If required, compute prognostic equation for total water content / scalar
+    IF ( moisture  .OR.  passive_scalar )  THEN
+
+       CALL cpu_log( log_point(29), 'q/s-equation', 'start' )
+
+!
+!--    Scalar/q-tendency terms with communication
+       IF ( scalar_advec == 'bc-scheme' )  THEN
+!
+!--       Bott-Chlond scheme always uses Euler time step. Thus:
+          sat = 1.0
+          sbt = 1.0
+          tend = 0.0
+          CALL advec_s_bc( q, 'q' )
+       ELSE
+          sat = tsc(1)
+          sbt = tsc(2)
+          IF ( tsc(2) /= 2.0 )  THEN
+             IF ( scalar_advec == 'ups-scheme' )  THEN
+                tend = 0.0
+                CALL advec_s_ups( q, 'q' )
+             ENDIF
+          ENDIF
+       ENDIF
+
+!
+!--    Scalar/q-tendency terms with no communication
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+!
+!--          Tendency-terms
+             IF ( scalar_advec == 'bc-scheme' )  THEN
+                CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, tend )
+             ELSE
+                IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' ) THEN
+                   tend(:,j,i) = 0.0
+                   CALL advec_s_pw( i, j, q )
                 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' )
-
-!
-!--          Effect of Stokes drift (in ocean mode only)
-             IF ( stokes_force )  CALL stokes_drift_terms( i, j, 1 )
-
-             CALL module_interface_actions( i, j, 'u-tendency' )
-!
-!--          Prognostic equation for u-velocity component
-             DO  k = nzb+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) ) )           &
-                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-             ENDDO
-
-!
-!--          Add turbulence generated by wave breaking (in ocean mode only)
-             IF ( wave_breaking  .AND.                                                             &
-                  intermediate_timestep_count == intermediate_timestep_count_max )  THEN
-                CALL wave_breaking_term( i, j, 1 )
-             ENDIF
+                   IF ( scalar_advec /= 'ups-scheme' )  THEN
+                      tend(:,j,i) = 0.0
+                      CALL advec_s_up( i, j, q )
+                   ENDIF
+                ENDIF
+                IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )&
+                THEN
+                   CALL diffusion_s( i, j, ddzu, ddzw, kh_m, q_m, qsws_m, &
+                                     tend )
+                ELSE
+                   CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, tend )
+                ENDIF
+             ENDIF
+       
+!
+!--          If required compute decrease of total water content due to
+!--          precipitation
+             IF ( precipitation )  THEN
+                CALL calc_precipitation( i, j )
+             ENDIF
+             CALL user_actions( i, j, 'q-tendency' )
+
+!
+!--          Prognostic equation for total water content / scalar
+             DO  k = nzb_s_inner(j,i)+1, nzt-1
+                q_p(k,j,i) = ( 1 - sat ) * q_m(k,j,i) + sat * q(k,j,i) +       &
+                             dt_3d * (                                         &
+                                      sbt * tend(k,j,i) + tsc(3) * tq_m(k,j,i) &
+                                     ) -                                       &
+                             tsc(5) * rdf(k) * ( q(k,j,i) - q_init(k) )
+             ENDDO
 
 !
@@ -496,372 +547,116 @@
              IF ( timestep_scheme(1:5) == 'runge' )  THEN
                 IF ( intermediate_timestep_count == 1 )  THEN
-                   DO  k = nzb+1, nzt
-                      tu_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                   DO  k = nzb+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. Please note, in case of non-cyclic boundary
-!--       conditions the grid point j=0 is excluded from the prognostic equations for the
-!--       v-component.
-          IF ( j >= nysv )  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' )
-
-!
-!--          Effect of Stokes drift (in ocean mode only)
-             IF ( stokes_force )  CALL stokes_drift_terms( i, j, 2 )
-
-             CALL module_interface_actions( i, j, 'v-tendency' )
-!
-!--          Prognostic equation for v-velocity component
-             DO  k = nzb+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) ) )           &
-                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-             ENDDO
-
-!
-!--          Add turbulence generated by wave breaking (in ocean mode only)
-             IF ( wave_breaking  .AND.                                                             &
-                  intermediate_timestep_count == intermediate_timestep_count_max )  THEN
-                CALL wave_breaking_term( i, j, 2 )
-             ENDIF
-
-!
-!--          Calculate tendencies for the next Runge-Kutta step
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( intermediate_timestep_count == 1 )  THEN
-                   DO  k = nzb+1, nzt
-                      tv_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                   DO  k = nzb+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_mode )  THEN
-                CALL buoyancy( i, j, rho_ocean, 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 )
-
-!
-!--       Effect of Stokes drift (in ocean mode only)
-          IF ( stokes_force )  CALL stokes_drift_terms( i, j, 3 )
-
-          CALL module_interface_actions( i, j, 'w-tendency' )
-!
-!--       Prognostic equation for w-velocity component
-          DO  k = nzb+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) )                              &
-                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-          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+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+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( advc_flags_s, i, j, pt, 'pt', flux_s_pt, diss_s_pt,         &
-                                       flux_l_pt, diss_l_pt, i_omp_start, tn,                      &
-                                       bc_dirichlet_l  .OR.  bc_radiation_l,                       &
-                                       bc_dirichlet_n  .OR.  bc_radiation_n,                       &
-                                       bc_dirichlet_r  .OR.  bc_radiation_r,                       &
-                                       bc_dirichlet_s  .OR.  bc_radiation_s )
-                   ELSE
-                      CALL advec_s_pw( i, j, pt )
-                   ENDIF
-             ELSE
-                CALL advec_s_up( i, j, pt )
-             ENDIF
-             CALL diffusion_s( i, j, pt, surf_def_h(0)%shf, surf_def_h(1)%shf, surf_def_h(2)%shf,  &
-                               surf_lsm_h(0)%shf, surf_lsm_h(1)%shf,                               &
-                               surf_usm_h(0)%shf, surf_usm_h(1)%shf,                               &
-                               surf_def_v(0)%shf, surf_def_v(1)%shf, surf_def_v(2)%shf,            &
-                               surf_def_v(3)%shf, surf_lsm_v(0)%shf, surf_lsm_v(1)%shf,            &
-                               surf_lsm_v(2)%shf, surf_lsm_v(3)%shf, surf_usm_v(0)%shf,            &
-                               surf_usm_v(1)%shf, surf_usm_v(2)%shf, surf_usm_v(3)%shf )
-
-!
-!--          Consideration of heat sources within the plant canopy
-             IF ( plant_canopy  .AND.  (cthf /= 0.0_wp  .OR. urban_surface  .OR.  land_surface) )  &
-             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 defined( __rrtmg )
-!
-!--          If required, add tendency due to radiative heating/cooling
-             IF ( radiation  .AND.  simulated_time > skip_time_do_radiation )  THEN
-                CALL radiation_tendency ( i, j, tend )
-             ENDIF
-#endif
-
-             CALL module_interface_actions( i, j, 'pt-tendency' )
-!
-!--          Prognostic equation for potential temperature
-             DO  k = nzb+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) ) )                   &
-                              * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-             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+1, nzt
-                      tpt_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                   DO  k = nzb+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 total water content
-          IF ( humidity )  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( advc_flags_s, i, j, q, 'q', flux_s_q, diss_s_q, flux_l_q,      &
-                                    diss_l_q, i_omp_start, tn,                                     &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( i, j, q )
-                ENDIF
-             ELSE
-                CALL advec_s_up( i, j, q )
-             ENDIF
-             CALL diffusion_s( i, j, q, surf_def_h(0)%qsws, surf_def_h(1)%qsws,                    &
-                               surf_def_h(2)%qsws, surf_lsm_h(0)%qsws, surf_lsm_h(1)%qsws,         &
-                               surf_usm_h(0)%qsws, surf_usm_h(1)%qsws,                             &
-                               surf_def_v(0)%qsws, surf_def_v(1)%qsws, surf_def_v(2)%qsws,         &
-                               surf_def_v(3)%qsws, surf_lsm_v(0)%qsws, surf_lsm_v(1)%qsws,         &
-                               surf_lsm_v(2)%qsws, surf_lsm_v(3)%qsws, surf_usm_v(0)%qsws,         &
-                               surf_usm_v(1)%qsws, surf_usm_v(2)%qsws, surf_usm_v(3)%qsws )
-
-!
-!--          Sink or source of humidity 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 module_interface_actions( i, j, 'q-tendency' )
-
-!
-!--          Prognostic equation for total water content / scalar
-             DO  k = nzb+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) ) )                          &
-                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                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+1, nzt
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
                       tq_m(k,j,i) = tend(k,j,i)
                    ENDDO
                 ELSEIF ( intermediate_timestep_count < &
                          intermediate_timestep_count_max )  THEN
-                   DO  k = nzb+1, nzt
-                      tq_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tq_m(k,j,i)
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      tq_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tq_m(k,j,i)
                    ENDDO
                 ENDIF
              ENDIF
 
-          ENDIF
-
-!
-!--       If required, compute prognostic equation for scalar
-          IF ( 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
-!
-!--                For scalar advection apply monotonic flux limiter near topography.
-                   CALL advec_s_ws( advc_flags_s, i, j, s, 's', flux_s_s, diss_s_s, flux_l_s,      &
-                                    diss_l_s, i_omp_start, tn,                                     &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s,                          &
-                                    monotonic_limiter_z )
+          ENDDO
+       ENDDO
+
+       CALL cpu_log( log_point(29), 'q/s-equation', 'stop' )
+
+    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' )
+
+!
+!--    TKE-tendency terms with communication
+       CALL production_e_init
+       IF ( .NOT. use_upstream_for_tke )  THEN
+          IF ( scalar_advec == 'bc-scheme' )  THEN
+!
+!--          Bott-Chlond scheme always uses Euler time step. Thus:
+             sat = 1.0
+             sbt = 1.0
+             tend = 0.0
+             CALL advec_s_bc( e, 'e' )
+          ELSE
+             sat = tsc(1)
+             sbt = tsc(2)
+             IF ( tsc(2) /= 2.0 )  THEN
+                IF ( scalar_advec == 'ups-scheme' )  THEN
+                   tend = 0.0
+                   CALL advec_s_ups( e, 'e' )
+                ENDIF
+             ENDIF
+          ENDIF
+       ENDIF
+
+!
+!--    TKE-tendency terms with no communication
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+!
+!--          Tendency-terms
+             IF ( scalar_advec == 'bc-scheme'  .AND.  &
+                  .NOT. use_upstream_for_tke )  THEN
+                IF ( .NOT. moisture )  THEN
+                   CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+                                     l_grid, pt, rif, tend, zu )
                 ELSE
-                   CALL advec_s_pw( i, j, s )
+                   CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+                                     l_grid, vpt, rif, tend, zu )
                 ENDIF
              ELSE
-                CALL advec_s_up( i, j, s )
-             ENDIF
-             CALL diffusion_s( i, j, s, surf_def_h(0)%ssws, surf_def_h(1)%ssws,                    &
-                               surf_def_h(2)%ssws, surf_lsm_h(0)%ssws, surf_lsm_h(1)%ssws,         &
-                               surf_usm_h(0)%ssws, surf_usm_h(1)%ssws,                             &
-                               surf_def_v(0)%ssws, surf_def_v(1)%ssws, surf_def_v(2)%ssws,         &
-                               surf_def_v(3)%ssws, surf_lsm_v(0)%ssws, surf_lsm_v(1)%ssws,         &
-                               surf_lsm_v(2)%ssws, surf_lsm_v(3)%ssws, surf_usm_v(0)%ssws,         &
-                               surf_usm_v(1)%ssws, surf_usm_v(2)%ssws, surf_usm_v(3)%ssws )
-
-!
-!--          Sink or source of scalar concentration due to canopy elements
-             IF ( plant_canopy )  CALL pcm_tendency( i, j, 7 )
-
-!
-!--          Large scale advection, still need to be extended for scalars
-!              IF ( large_scale_forcing )  THEN
-!                 CALL ls_advec( i, j, simulated_time, 's' )
-!              ENDIF
-
-!
-!--          Nudging, still need to be extended for scalars
-!              IF ( nudging )  CALL nudge( i, j, simulated_time, 's' )
-
-!
-!--          If required compute influence of large-scale subsidence/ascent. Note, the last argument
-!--          is of no meaning in this case, as it is only used in conjunction with
-!--          large_scale_forcing, which is to date not implemented for scalars.
-             IF ( large_scale_subsidence  .AND.  .NOT. use_subsidence_tendencies  .AND.            &
-                  .NOT. large_scale_forcing )  THEN
-                CALL subsidence( i, j, tend, s, s_init, 3 )
-             ENDIF
-
-             CALL module_interface_actions( i, j, 's-tendency' )
-
-!
-!--          Prognostic equation for scalar
-             DO  k = nzb+1, nzt
-                s_p(k,j,i) = s(k,j,i)                                                              &
-                             + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * ts_m(k,j,i) )           &
-                                 - tsc(5) * rdf_sc(k) * ( s(k,j,i) - s_init(k) ) )                 &
-                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                IF ( s_p(k,j,i) < 0.0_wp )  s_p(k,j,i) = 0.1_wp * s(k,j,i)
+                IF ( use_upstream_for_tke )  THEN
+                   tend(:,j,i) = 0.0
+                   CALL advec_s_up( i, j, e )
+                ELSE
+                   IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' ) &
+                   THEN
+                      tend(:,j,i) = 0.0
+                      CALL advec_s_pw( i, j, e )
+                   ELSE
+                      IF ( scalar_advec /= 'ups-scheme' )  THEN
+                         tend(:,j,i) = 0.0
+                         CALL advec_s_up( i, j, e )
+                      ENDIF
+                   ENDIF
+                ENDIF
+                IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )&
+                THEN
+                   IF ( .NOT. moisture )  THEN
+                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
+                                        km_m, l_grid, pt_m, rif_m, tend, zu )
+                   ELSE
+                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
+                                        km_m, l_grid, vpt_m, rif_m, tend, zu )
+                   ENDIF
+                ELSE
+                   IF ( .NOT. moisture )  THEN
+                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+                                        l_grid, pt, rif, tend, zu )
+                   ELSE
+                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+                                        l_grid, vpt, rif, tend, zu )
+                   ENDIF
+                ENDIF
+             ENDIF
+             CALL production_e( i, j )
+             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-1
+                e_p(k,j,i) = ( 1 - sat ) * e_m(k,j,i) + sat * 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 )  e_p(k,j,i) = 0.1 * e(k,j,i)
              ENDDO
 
@@ -870,128 +665,468 @@
              IF ( timestep_scheme(1:5) == 'runge' )  THEN
                 IF ( intermediate_timestep_count == 1 )  THEN
-                   DO  k = nzb+1, nzt
-                      ts_m(k,j,i) = tend(k,j,i)
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      te_m(k,j,i) = tend(k,j,i)
                    ENDDO
-                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                   DO  k = nzb+1, nzt
-                      ts_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * ts_m(k,j,i)
+                ELSEIF ( intermediate_timestep_count < &
+                         intermediate_timestep_count_max )  THEN
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      te_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * te_m(k,j,i)
                    ENDDO
                 ENDIF
              ENDIF
 
-          ENDIF
-!
-!--       Calculate prognostic equations for all other modules
-          CALL module_interface_prognostic_equations( i, j, i_omp_start, tn )
-
-       ENDDO  ! loop over j
-    ENDDO  ! loop over i
-    !$OMP END PARALLEL
-
+          ENDDO
+       ENDDO
+
+       CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
+
+    ENDIF
+
+
+ END SUBROUTINE prognostic_equations
+
+
+ SUBROUTINE prognostic_equations_fast
+
+!------------------------------------------------------------------------------!
+! Version with one optimized loop over all equations. It is only allowed to
+! be called for the standard Piascek-Williams advection scheme.
+!
+! The call of this subroutine is embedded in two DO loops over i and j, thus
+! communication between CPUs is not allowed in this subroutine.
+!
+! (Optimized to avoid cache missings, i.e. for Power4/5-architectures.)
+!------------------------------------------------------------------------------!
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=9) ::  time_to_string
+    INTEGER ::  i, j, k
+
+
+!
+!-- Time measurement can only be performed for the whole set of equations
+    CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
+
+
+!
+!-- Calculate those variables needed in the tendency terms which need
+!-- global communication
+    CALL calc_mean_pt_profile( pt, 4 )
+    IF ( moisture )  CALL calc_mean_pt_profile( vpt, 44 )
+    IF ( .NOT. constant_diffusion )  CALL production_e_init
+
+
+!
+!-- Loop over all prognostic equations
+!$OMP PARALLEL private (i,j,k)
+!$OMP DO
+    DO  i = nxl, nxr+uxrp       ! Additional levels for non cyclic boundary
+       DO  j = nys, nyn+vynp    ! conditions are included
+!
+!--       Tendency terms for u-velocity component
+          IF ( j < nyn+1 )  THEN
+
+             tend(:,j,i) = 0.0
+             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+                CALL advec_u_pw( i, j )
+             ELSE
+                CALL advec_u_up( i, j )
+             ENDIF
+             IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' ) &
+             THEN
+                CALL diffusion_u( i, j, ddzu, ddzw, km_m, km_damp_y, tend,  &
+                                  u_m, usws_m, v_m, w_m, z0 )
+             ELSE
+                CALL diffusion_u( i, j, ddzu, ddzw, km, km_damp_y, tend, u, &
+                                  usws, v, w, z0 )
+             ENDIF
+             CALL coriolis( i, j, 1 )
+             IF ( sloping_surface )  CALL buoyancy( i, j, pt, 1, 4 )
+             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) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) + &
+                             dt_3d * (                                         &
+                                   tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) &
+                                 - tsc(4) * ( p(k,j,i) - p(k,j,i-1) ) * ddx    &
+                                     ) -                                       &
+                             tsc(5) * rdf(k) * ( u(k,j,i) - ug(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 * tend(k,j,i) + 5.3125 * tu_m(k,j,i)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+          ENDIF
+
+!
+!--       Tendency terms for v-velocity component
+          IF ( i < nxr+1 )  THEN
+
+             tend(:,j,i) = 0.0
+             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+                CALL advec_v_pw( i, j )
+             ELSE
+                CALL advec_v_up( i, j )
+             ENDIF
+             IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' ) &
+             THEN
+                CALL diffusion_v( i, j, ddzu, ddzw, km_m, km_damp_x, tend,     &
+                                  u_m, v_m, vsws_m, w_m, z0 )
+             ELSE
+                CALL diffusion_v( i, j, ddzu, ddzw, km, km_damp_x, tend, u, v, &
+                                  vsws, w, z0 )
+             ENDIF
+             CALL coriolis( i, j, 2 )
+             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) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) + &
+                             dt_3d * (                                         &
+                                   tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) &
+                                 - tsc(4) * ( p(k,j,i) - p(k,j-1,i) ) * ddy    &
+                                     ) -                                       &
+                             tsc(5) * rdf(k) * ( v(k,j,i) - vg(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 * tend(k,j,i) + 5.3125 * tv_m(k,j,i)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+          ENDIF
+
+!
+!--       Tendency terms for w-velocity component
+          IF ( i < nxr+1  .AND.  j < nyn+1 )  THEN
+
+             tend(:,j,i) = 0.0
+             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+                CALL advec_w_pw( i, j )
+             ELSE
+                CALL advec_w_up( i, j )
+             ENDIF
+             IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' ) &
+             THEN
+                CALL diffusion_w( i, j, ddzu, ddzw, km_m, km_damp_x,          &
+                                  km_damp_y, tend, u_m, v_m, w_m, z0 )
+             ELSE
+                CALL diffusion_w( i, j, ddzu, ddzw, km, km_damp_x, km_damp_y, &
+                                  tend, u, v, w, z0 )
+             ENDIF
+             CALL coriolis( i, j, 3 )
+             IF ( .NOT. moisture )  THEN
+                CALL buoyancy( i, j, pt, 3, 4 )
+             ELSE
+                CALL buoyancy( i, j, vpt, 3, 44 )
+             ENDIF
+             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) = ( 1.0-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) + &
+                             dt_3d * (                                         &
+                                   tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) &
+                              - tsc(4) * ( p(k+1,j,i) - p(k,j,i) ) * ddzu(k+1) &
+                                     ) -                                       &
+                             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 * tend(k,j,i) + 5.3125 * tw_m(k,j,i)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+!
+!--          Tendency terms for potential temperature
+             tend(:,j,i) = 0.0
+             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+                CALL advec_s_pw( i, j, pt )
+             ELSE
+                CALL advec_s_up( i, j, pt )
+             ENDIF
+             IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' ) &
+             THEN
+                CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, tend )
+             ELSE
+                CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tend )
+             ENDIF
+
+!
+!--          If required compute heating/cooling due to long wave radiation
+!--          processes
+             IF ( radiation )  THEN
+                CALL calc_radiation( i, j )
+             ENDIF
+
+!
+!--          If required compute impact of latent heat due to precipitation
+             IF ( precipitation )  THEN
+                CALL impact_of_latent_heat( i, j )
+             ENDIF
+             CALL user_actions( i, j, 'pt-tendency' )
+
+!
+!--          Prognostic equation for potential temperature
+             DO  k = nzb_s_inner(j,i)+1, nzt-1
+                pt_p(k,j,i) = ( 1.0-tsc(1) ) * pt_m(k,j,i) + tsc(1)*pt(k,j,i) +&
+                              dt_3d * (                                        &
+                                  tsc(2) * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) &
+                                      ) -                                      &
+                              tsc(5) * rdf(k) * ( pt(k,j,i) - pt_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_s_inner(j,i)+1, nzt-1
+                      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-1
+                      tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + &
+                                      5.3125 * tpt_m(k,j,i)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+!
+!--          If required, compute prognostic equation for total water content /
+!--          scalar
+             IF ( moisture  .OR.  passive_scalar )  THEN
+
+!
+!--             Tendency-terms for total water content / scalar
+                tend(:,j,i) = 0.0
+                IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' ) &
+                THEN
+                   CALL advec_s_pw( i, j, q )
+                ELSE
+                   CALL advec_s_up( i, j, q )
+                ENDIF
+                IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )&
+                THEN
+                   CALL diffusion_s( i, j, ddzu, ddzw, kh_m, q_m, qsws_m, tend )
+                ELSE
+                   CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, tend )
+                ENDIF
+       
+!
+!--             If required compute decrease of total water content due to
+!--             precipitation
+                IF ( precipitation )  THEN
+                   CALL calc_precipitation( i, j )
+                ENDIF
+                CALL user_actions( i, j, 'q-tendency' )
+
+!
+!--             Prognostic equation for total water content / scalar
+                DO  k = nzb_s_inner(j,i)+1, nzt-1
+                   q_p(k,j,i) = ( 1.0-tsc(1) ) * q_m(k,j,i) + tsc(1)*q(k,j,i) +&
+                                dt_3d * (                                      &
+                                   tsc(2) * tend(k,j,i) + tsc(3) * tq_m(k,j,i) &
+                                        ) -                                    &
+                                tsc(5) * rdf(k) * ( q(k,j,i) - q_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_s_inner(j,i)+1, nzt-1
+                         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-1
+                         tq_m(k,j,i) = -9.5625 * tend(k,j,i) + &
+                                        5.3125 * tq_m(k,j,i)
+                      ENDDO
+                   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
+                IF ( ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  &
+                     .AND.  .NOT. use_upstream_for_tke )  THEN
+                   CALL advec_s_pw( i, j, e )
+                ELSE
+                   CALL advec_s_up( i, j, e )
+                ENDIF
+                IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )&
+                THEN
+                   IF ( .NOT. moisture )  THEN
+                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
+                                        km_m, l_grid, pt_m, rif_m, tend, zu )
+                   ELSE
+                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
+                                        km_m, l_grid, vpt_m, rif_m, tend, zu )
+                   ENDIF
+                ELSE
+                   IF ( .NOT. moisture )  THEN
+                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+                                        l_grid, pt, rif, tend, zu )
+                   ELSE
+                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+                                        l_grid, vpt, rif, tend, zu )
+                   ENDIF
+                ENDIF
+                CALL production_e( i, j )
+                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-1
+                   e_p(k,j,i) = ( 1.0-tsc(1) ) * e_m(k,j,i) + tsc(1)*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 )  e_p(k,j,i) = 0.1 * 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-1
+                         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-1
+                         te_m(k,j,i) = -9.5625 * tend(k,j,i) + &
+                                        5.3125 * te_m(k,j,i)
+                      ENDDO
+                   ENDIF
+                ENDIF
+
+             ENDIF   ! TKE equation
+
+          ENDIF   ! Gridpoints excluding the non-cyclic wall
+
+       ENDDO
+    ENDDO
+!$OMP END PARALLEL
 
     CALL cpu_log( log_point(32), 'all progn.equations', 'stop' )
 
-    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_cache', 'end' )
-
- END SUBROUTINE prognostic_equations_cache
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Version for vector machines
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE prognostic_equations_vector
-
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp) ::  sbt  !<
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_vector', 'start' )
-!
-!-- Calculate non advective processes for all other modules
-    CALL module_interface_non_advective_processes
-!
-!-- Module Inferface for exchange horiz after non_advective_processes but before advection.
-!-- Therefore, non_advective_processes must not run for ghost points.
-    CALL module_interface_exchange_horiz( 'before_prognostic_equation' )
+
+ END SUBROUTINE prognostic_equations_fast
+
+
+ SUBROUTINE prognostic_equations_vec
+
+!------------------------------------------------------------------------------!
+! Version for vector machines
+!------------------------------------------------------------------------------!
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=9) ::  time_to_string
+    INTEGER ::  i, j, k
+    REAL    ::  sat, sbt
+
+!
+!-- Calculate those variables needed in the tendency terms which need
+!-- global communication
+    CALL calc_mean_pt_profile( pt, 4 )
+    IF ( moisture )  CALL calc_mean_pt_profile( vpt, 44 )
+
 !
 !-- u-velocity component
     CALL cpu_log( log_point(5), 'u-equation', 'start' )
 
-    !$ACC KERNELS PRESENT(tend)
-    tend = 0.0_wp
-    !$ACC END KERNELS
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_mom )  THEN
-          CALL advec_u_ws
-       ELSE
-          CALL advec_u_pw
-       ENDIF
+!
+!-- u-tendency terms with communication
+    IF ( momentum_advec == 'ups-scheme' )  THEN
+       tend = 0.0
+       CALL advec_u_ups
+    ENDIF
+
+!
+!-- u-tendency terms with no communication
+    IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+       tend = 0.0
+       CALL advec_u_pw
     ELSE
-       CALL advec_u_up
-    ENDIF
-    CALL diffusion_u
+       IF ( momentum_advec /= 'ups-scheme' )  THEN
+          tend = 0.0
+          CALL advec_u_up
+       ENDIF
+    ENDIF
+    IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+       CALL diffusion_u( ddzu, ddzw, km_m, km_damp_y, tend, u_m, usws_m, v_m, &
+                         w_m, z0 )
+    ELSE
+       CALL diffusion_u( ddzu, ddzw, km, km_damp_y, tend, u, usws, v, w, z0 )
+    ENDIF
     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' )
-
-!
-!-- Effect of Stokes drift (in ocean mode only)
-    IF ( stokes_force )  CALL stokes_drift_terms( 1 )
-
-    CALL module_interface_actions( 'u-tendency' )
+    IF ( sloping_surface )  CALL buoyancy( pt, 1, 4 )
+    CALL user_actions( 'u-tendency' )
 
 !
 !-- Prognostic equation for u-velocity component
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-    !$ACC PRESENT(u, tend, tu_m, u_init, rdf, wall_flags_total_0) &
-    !$ACC PRESENT(tsc(2:5)) &
-    !$ACC PRESENT(u_p)
-    DO  i = nxlu, nxr
+    DO  i = nxl, nxr+uxrp
        DO  j = nys, nyn
-!
-!--       Following directive is required to vectorize on Intel19
-          !DIR$ IVDEP
-          DO  k = nzb+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) ) )                       &
-                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
+          DO  k = nzb_u_inner(j,i)+1, nzt
+             u_p(k,j,i) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) +    &
+                          dt_3d * (                                            &
+                                   tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) &
+                                 - tsc(4) * ( p(k,j,i) - p(k,j,i-1) ) * ddx    &
+                                  ) -                                          &
+                          tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) )
           ENDDO
        ENDDO
     ENDDO
-
-!
-!-- Add turbulence generated by wave breaking (in ocean mode only)
-    IF ( wave_breaking .AND. intermediate_timestep_count == intermediate_timestep_count_max )  THEN
-       CALL wave_breaking_term( 1 )
-    ENDIF
 
 !
@@ -999,20 +1134,17 @@
     IF ( timestep_scheme(1:5) == 'runge' )  THEN
        IF ( intermediate_timestep_count == 1 )  THEN
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-          !$ACC PRESENT(tend, tu_m)
-          DO  i = nxlu, nxr
+          DO  i = nxl, nxr+uxrp
              DO  j = nys, nyn
-                DO  k = nzb+1, nzt
+                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
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-          !$ACC PRESENT(tend, tu_m)
-          DO  i = nxlu, nxr
+       ELSEIF ( intermediate_timestep_count < &
+                intermediate_timestep_count_max )  THEN
+          DO  i = nxl, nxr+uxrp
              DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   tu_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tu_m(k,j,i)
+                DO  k = nzb_u_inner(j,i)+1, nzt
+                   tu_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tu_m(k,j,i)
                 ENDDO
              ENDDO
@@ -1027,70 +1159,45 @@
     CALL cpu_log( log_point(6), 'v-equation', 'start' )
 
-    !$ACC KERNELS PRESENT(tend)
-    tend = 0.0_wp
-    !$ACC END KERNELS
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_mom )  THEN
-          CALL advec_v_ws
-       ELSE
-          CALL advec_v_pw
-       END IF
+!
+!-- v-tendency terms with communication
+    IF ( momentum_advec == 'ups-scheme' )  THEN
+       tend = 0.0
+       CALL advec_v_ups
+    ENDIF
+
+!
+!-- v-tendency terms with no communication
+    IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+       tend = 0.0
+       CALL advec_v_pw
     ELSE
-       CALL advec_v_up
-    ENDIF
-    CALL diffusion_v
+       IF ( momentum_advec /= 'ups-scheme' )  THEN
+          tend = 0.0
+          CALL advec_v_up
+       ENDIF
+    ENDIF
+    IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+       CALL diffusion_v( ddzu, ddzw, km_m, km_damp_x, tend, u_m, v_m, vsws_m, &
+                         w_m, z0 )
+    ELSE
+       CALL diffusion_v( ddzu, ddzw, km, km_damp_x, tend, u, v, vsws, w, z0 )
+    ENDIF
     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' )
-
-!
-!-- Effect of Stokes drift (in ocean mode only)
-    IF ( stokes_force )  CALL stokes_drift_terms( 2 )
-
-    CALL module_interface_actions( 'v-tendency' )
+    CALL user_actions( 'v-tendency' )
 
 !
 !-- Prognostic equation for v-velocity component
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-    !$ACC PRESENT(v, tend, tv_m, v_init, rdf, wall_flags_total_0) &
-    !$ACC PRESENT(tsc(2:5)) &
-    !$ACC PRESENT(v_p)
     DO  i = nxl, nxr
-       DO  j = nysv, nyn
-!
-!--       Following directive is required to vectorize on Intel19
-          !DIR$ IVDEP
-          DO  k = nzb+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) ) )                                &
-                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
+       DO  j = nys, nyn+vynp
+          DO  k = nzb_v_inner(j,i)+1, nzt
+             v_p(k,j,i) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) +    &
+                          dt_3d * (                                            &
+                                   tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) &
+                                 - tsc(4) * ( p(k,j,i) - p(k,j-1,i) ) * ddy    &
+                                  ) -                                          &
+                          tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) )
           ENDDO
        ENDDO
     ENDDO
-
-!
-!-- Add turbulence generated by wave breaking (in ocean mode only)
-    IF ( wave_breaking .AND. intermediate_timestep_count == intermediate_timestep_count_max )  THEN
-       CALL wave_breaking_term( 2 )
-    ENDIF
 
 !
@@ -1098,20 +1205,17 @@
     IF ( timestep_scheme(1:5) == 'runge' )  THEN
        IF ( intermediate_timestep_count == 1 )  THEN
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-          !$ACC PRESENT(tend, tv_m)
           DO  i = nxl, nxr
-             DO  j = nysv, nyn
-                DO  k = nzb+1, nzt
+             DO  j = nys, nyn+vynp
+                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
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-          !$ACC PRESENT(tend, tv_m)
+       ELSEIF ( intermediate_timestep_count < &
+                intermediate_timestep_count_max )  THEN
           DO  i = nxl, nxr
-             DO  j = nysv, nyn
-                DO  k = nzb+1, nzt
-                   tv_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tv_m(k,j,i)
+             DO  j = nys, nyn+vynp
+                DO  k = nzb_v_inner(j,i)+1, nzt
+                   tv_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tv_m(k,j,i)
                 ENDDO
              ENDDO
@@ -1126,57 +1230,48 @@
     CALL cpu_log( log_point(7), 'w-equation', 'start' )
 
-    !$ACC KERNELS PRESENT(tend)
-    tend = 0.0_wp
-    !$ACC END KERNELS
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_mom )  THEN
-          CALL advec_w_ws
-       ELSE
-          CALL advec_w_pw
-       ENDIF
+!
+!-- w-tendency terms with communication
+    IF ( momentum_advec == 'ups-scheme' )  THEN
+       tend = 0.0
+       CALL advec_w_ups
+    ENDIF
+
+!
+!-- w-tendency terms with no communication
+    IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+       tend = 0.0
+       CALL advec_w_pw
     ELSE
-       CALL advec_w_up
-    ENDIF
-    CALL diffusion_w
+       IF ( momentum_advec /= 'ups-scheme' )  THEN
+          tend = 0.0
+          CALL advec_w_up
+       ENDIF
+    ENDIF
+    IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+       CALL diffusion_w( ddzu, ddzw, km_m, km_damp_x, km_damp_y, tend, u_m, &
+                         v_m, w_m, z0 )
+    ELSE
+       CALL diffusion_w( ddzu, ddzw, km, km_damp_x, km_damp_y, tend, u, v, w, &
+                         z0 )
+    ENDIF
     CALL coriolis( 3 )
-
-    IF ( .NOT. neutral )  THEN
-       IF ( ocean_mode )  THEN
-          CALL buoyancy( rho_ocean, 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 )
-
-!
-!-- Effect of Stokes drift (in ocean mode only)
-    IF ( stokes_force )  CALL stokes_drift_terms( 3 )
-
-    CALL module_interface_actions( 'w-tendency' )
+    IF ( .NOT. moisture )  THEN
+       CALL buoyancy( pt, 3, 4 )
+    ELSE
+       CALL buoyancy( vpt, 3, 44 )
+    ENDIF
+    CALL user_actions( 'w-tendency' )
 
 !
 !-- Prognostic equation for w-velocity component
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-    !$ACC PRESENT(w, tend, tw_m, v_init, rdf, wall_flags_total_0) &
-    !$ACC PRESENT(tsc(2:5)) &
-    !$ACC PRESENT(w_p)
     DO  i = nxl, nxr
        DO  j = nys, nyn
-!
-!--       Following directive is required to vectorize on Intel19
-          !DIR$ IVDEP
-          DO  k = nzb+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) )                                       &
-                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
+          DO  k = nzb_w_inner(j,i)+1, nzt-1
+             w_p(k,j,i) = ( 1-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) +      &
+                          dt_3d * (                                            &
+                                   tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) &
+                              - tsc(4) * ( p(k+1,j,i) - p(k,j,i) ) * ddzu(k+1) &
+                                  ) -                                          &
+                          tsc(5) * rdf(k) * w(k,j,i)
           ENDDO
        ENDDO
@@ -1187,20 +1282,17 @@
     IF ( timestep_scheme(1:5) == 'runge' )  THEN
        IF ( intermediate_timestep_count == 1 )  THEN
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-          !$ACC PRESENT(tend, tw_m)
           DO  i = nxl, nxr
              DO  j = nys, nyn
-                DO  k = nzb+1, nzt-1
+                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
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-          !$ACC PRESENT(tend, tw_m)
+       ELSEIF ( intermediate_timestep_count < &
+                intermediate_timestep_count_max )  THEN
           DO  i = nxl, nxr
              DO  j = nys, nyn
-                DO  k = nzb+1, nzt-1
-                   tw_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tw_m(k,j,i)
+                DO  k = nzb_w_inner(j,i)+1, nzt-1
+                   tw_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tw_m(k,j,i)
                 ENDDO
              ENDDO
@@ -1211,221 +1303,165 @@
     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
+!
+!-- potential temperature
+    CALL cpu_log( log_point(13), 'pt-equation', 'start' )
+
+!
+!-- pt-tendency terms with communication
+    IF ( scalar_advec == 'bc-scheme' )  THEN
+!
+!--    Bott-Chlond scheme always uses Euler time step. Thus:
+       sat = 1.0
+       sbt = 1.0
+       tend = 0.0
+       CALL advec_s_bc( pt, 'pt' )
+    ELSE
+       sat = tsc(1)
        sbt = tsc(2)
+       IF ( tsc(2) /= 2.0  .AND.  scalar_advec == 'ups-scheme' )  THEN
+          tend = 0.0
+          CALL advec_s_ups( pt, 'pt' )
+       ENDIF
+    ENDIF
+          
+!
+!-- pt-tendency terms with no communication
+    IF ( scalar_advec == 'bc-scheme' )  THEN
+       CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tend )
+    ELSE
+       IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+          tend = 0.0
+          CALL advec_s_pw( pt )
+       ELSE
+          IF ( scalar_advec /= 'ups-scheme' )  THEN
+             tend = 0.0
+             CALL advec_s_up( pt )
+          ENDIF
+       ENDIF
+       IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+          CALL diffusion_s( ddzu, ddzw, kh_m, pt_m, shf_m, tend )
+       ELSE
+          CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tend )
+       ENDIF
+    ENDIF
+
+!
+!-- If required compute heating/cooling due to long wave radiation
+!-- processes
+    IF ( radiation )  THEN
+       CALL calc_radiation
+    ENDIF
+
+!
+!-- If required compute impact of latent heat due to precipitation
+    IF ( precipitation )  THEN
+       CALL impact_of_latent_heat
+    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-1
+             pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) +       &
+                           dt_3d * (                                           &
+                                     sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) &
+                                   ) -                                         &
+                           tsc(5) * rdf(k) * ( pt(k,j,i) - pt_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 = nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt-1
+                   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-1
+                   tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tpt_m(k,j,i)
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDIF
+    ENDIF
+
+    CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
+
+!
+!-- If required, compute prognostic equation for total water content / scalar
+    IF ( moisture  .OR.  passive_scalar )  THEN
+
+       CALL cpu_log( log_point(29), 'q/s-equation', 'start' )
+
+!
+!--    Scalar/q-tendency terms with communication
        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
-          !$ACC KERNELS PRESENT(tend)
-          tend = 0.0_wp
-          !$ACC END KERNELS
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( advc_flags_s, pt, 'pt',                                           &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( pt )
-             ENDIF
+!
+!--       Bott-Chlond scheme always uses Euler time step. Thus:
+          sat = 1.0
+          sbt = 1.0
+          tend = 0.0
+          CALL advec_s_bc( q, 'q' )
+       ELSE
+          sat = tsc(1)
+          sbt = tsc(2)
+          IF ( tsc(2) /= 2.0 )  THEN
+             IF ( scalar_advec == 'ups-scheme' )  THEN
+                tend = 0.0
+                CALL advec_s_ups( q, 'q' )
+             ENDIF
+          ENDIF
+       ENDIF
+
+!
+!--    Scalar/q-tendency terms with no communication
+       IF ( scalar_advec == 'bc-scheme' )  THEN
+          CALL diffusion_s( ddzu, ddzw, kh, q, qsws, tend )
+       ELSE
+          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+             tend = 0.0
+             CALL advec_s_pw( q )
           ELSE
-             CALL advec_s_up( pt )
-          ENDIF
-       ENDIF
-
-       CALL diffusion_s( pt, surf_def_h(0)%shf, surf_def_h(1)%shf, surf_def_h(2)%shf,              &
-                         surf_lsm_h(0)%shf, surf_lsm_h(1)%shf, surf_usm_h(0)%shf,                  &
-                         surf_usm_h(1)%shf, surf_def_v(0)%shf, surf_def_v(1)%shf,                  &
-                         surf_def_v(2)%shf, surf_def_v(3)%shf, surf_lsm_v(0)%shf,                  &
-                         surf_lsm_v(1)%shf, surf_lsm_v(2)%shf, surf_lsm_v(3)%shf,                  &
-                         surf_usm_v(0)%shf, surf_usm_v(1)%shf, surf_usm_v(2)%shf,                  &
-                         surf_usm_v(3)%shf )
-
-!
-!--    Consideration of heat sources within the plant canopy
-       IF ( plant_canopy  .AND.  (cthf /= 0.0_wp  .OR. urban_surface  .OR.  land_surface) )  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 defined( __rrtmg )
-!
-!--    If required, add tendency due to radiative heating/cooling
-       IF ( radiation  .AND.  simulated_time > skip_time_do_radiation )  THEN
-            CALL radiation_tendency ( tend )
-       ENDIF
-#endif
-
-       CALL module_interface_actions( 'pt-tendency' )
-
-!
-!--    Prognostic equation for potential temperature
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-       !$ACC PRESENT(pt, tend, tpt_m, wall_flags_total_0) &
-       !$ACC PRESENT(pt_init, rdf_sc, ptdf_x, ptdf_y) &
-       !$ACC PRESENT(tsc(3:5)) &
-       !$ACC PRESENT(pt_p)
+             IF ( scalar_advec /= 'ups-scheme' )  THEN
+                tend = 0.0
+                CALL advec_s_up( q )
+             ENDIF
+          ENDIF
+          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+             CALL diffusion_s( ddzu, ddzw, kh_m, q_m, qsws_m, tend )
+          ELSE
+             CALL diffusion_s( ddzu, ddzw, kh, q, qsws, tend )
+          ENDIF
+       ENDIF
+       
+!
+!--    If required compute decrease of total water content due to
+!--    precipitation
+       IF ( precipitation )  THEN
+          CALL calc_precipitation
+       ENDIF
+       CALL user_actions( 'q-tendency' )
+
+!
+!--    Prognostic equation for total water content / scalar
        DO  i = nxl, nxr
           DO  j = nys, nyn
-!
-!--          Following directive is required to vectorize on Intel19
-             !DIR$ IVDEP
-             DO  k = nzb+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) ) )                        &
-                              * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    Calculate tendencies for the next Runge-Kutta step
-       IF ( timestep_scheme(1:5) == 'runge' )  THEN
-          IF ( intermediate_timestep_count == 1 )  THEN
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-             !$ACC PRESENT(tend, tpt_m)
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      tpt_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-             !$ACC PRESENT(tend, tpt_m)
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+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 total water content
-    IF ( humidity )  THEN
-
-       CALL cpu_log( log_point(29), 'q-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( advc_flags_s, q, 'q',                                             &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
-             ELSE
-                CALL advec_s_pw( q )
-             ENDIF
-          ELSE
-             CALL advec_s_up( q )
-          ENDIF
-       ENDIF
-
-       CALL diffusion_s( q, surf_def_h(0)%qsws, surf_def_h(1)%qsws, surf_def_h(2)%qsws,            &
-                         surf_lsm_h(0)%qsws, surf_lsm_h(1)%qsws, surf_usm_h(0)%qsws,               &
-                         surf_usm_h(0)%qsws, surf_def_v(0)%qsws, surf_def_v(1)%qsws,               &
-                         surf_def_v(2)%qsws, surf_def_v(3)%qsws, surf_lsm_v(0)%qsws,               &
-                         surf_lsm_v(1)%qsws, surf_lsm_v(2)%qsws, surf_lsm_v(3)%qsws,               &
-                         surf_usm_v(0)%qsws, surf_usm_v(1)%qsws, surf_usm_v(2)%qsws,               &
-                         surf_usm_v(3)%qsws )
-
-!
-!--    Sink or source of humidity 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 module_interface_actions( 'q-tendency' )
-
-!
-!--    Prognostic equation for total water content
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-!
-!--          Following directive is required to vectorize on Intel19
-             !DIR$ IVDEP
-             DO  k = nzb+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) ) )                 &
-                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
+             DO  k = nzb_s_inner(j,i)+1, nzt-1
+                q_p(k,j,i) = ( 1 - sat ) * q_m(k,j,i) + sat * q(k,j,i) +       &
+                             dt_3d * (                                         &
+                                      sbt * tend(k,j,i) + tsc(3) * tq_m(k,j,i) &
+                                     ) -                                       &
+                             tsc(5) * rdf(k) * ( q(k,j,i) - q_init(k) )
              ENDDO
           ENDDO
@@ -1438,14 +1474,15 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
                       tq_m(k,j,i) = tend(k,j,i)
                    ENDDO
                 ENDDO
              ENDDO
-          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
+          ELSEIF ( intermediate_timestep_count < &
+                   intermediate_timestep_count_max )  THEN
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      tq_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tq_m(k,j,i)
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      tq_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tq_m(k,j,i)
                    ENDDO
                 ENDDO
@@ -1454,92 +1491,98 @@
        ENDIF
 
-       CALL cpu_log( log_point(29), 'q-equation', 'stop' )
-
-    ENDIF
-!
-!-- If required, compute prognostic equation for scalar
-    IF ( passive_scalar )  THEN
-
-       CALL cpu_log( log_point(66), '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
+       CALL cpu_log( log_point(29), 'q/s-equation', 'stop' )
+
+    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' )
+
+!
+!--    TKE-tendency terms with communication
+       CALL production_e_init
+       IF ( .NOT. use_upstream_for_tke )  THEN
+          IF ( scalar_advec == 'bc-scheme' )  THEN
 !
 !--          Bott-Chlond scheme always uses Euler time step. Thus:
-             sbt = 1.0_wp
-          ENDIF
-          tend = 0.0_wp
-          CALL advec_s_bc( s, 's' )
-
-       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( advc_flags_s, s, 's',                                             &
-                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
-                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
-                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
-                                 bc_dirichlet_s  .OR.  bc_radiation_s )
+             sat = 1.0
+             sbt = 1.0
+             tend = 0.0
+             CALL advec_s_bc( e, 'e' )
+          ELSE
+             sat = tsc(1)
+             sbt = tsc(2)
+             IF ( tsc(2) /= 2.0 )  THEN
+                IF ( scalar_advec == 'ups-scheme' )  THEN
+                   tend = 0.0
+                   CALL advec_s_ups( e, 'e' )
+                ENDIF
+             ENDIF
+          ENDIF
+       ENDIF
+
+!
+!--    TKE-tendency terms with no communication
+       IF ( scalar_advec == 'bc-scheme'  .AND.  .NOT. use_upstream_for_tke )  &
+       THEN
+          IF ( .NOT. moisture )  THEN
+             CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, pt, &
+                               rif, tend, zu )
+          ELSE
+             CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, vpt, &
+                               rif, tend, zu )
+          ENDIF
+       ELSE
+          IF ( use_upstream_for_tke )  THEN
+             tend = 0.0
+             CALL advec_s_up( e )
+          ELSE
+             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
+                tend = 0.0
+                CALL advec_s_pw( e )
              ELSE
-                CALL advec_s_pw( s )
+                IF ( scalar_advec /= 'ups-scheme' )  THEN
+                   tend = 0.0
+                   CALL advec_s_up( e )
+                ENDIF
+             ENDIF
+          ENDIF
+          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+             IF ( .NOT. moisture )  THEN
+                CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e_m, km_m, l_grid, &
+                                  pt_m, rif_m, tend, zu )
+             ELSE
+                CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e_m, km_m, l_grid, &
+                                  vpt_m, rif_m, tend, zu )
              ENDIF
           ELSE
-             CALL advec_s_up( s )
-          ENDIF
-       ENDIF
-
-       CALL diffusion_s( s, surf_def_h(0)%ssws, surf_def_h(1)%ssws, surf_def_h(2)%ssws,            &
-                         surf_lsm_h(0)%ssws, surf_lsm_h(1)%ssws, surf_usm_h(0)%ssws,               &
-                         surf_usm_h(1)%ssws, surf_def_v(0)%ssws, surf_def_v(1)%ssws,               &
-                         surf_def_v(2)%ssws, surf_def_v(3)%ssws, surf_lsm_v(0)%ssws,               &
-                         surf_lsm_v(1)%ssws, surf_lsm_v(2)%ssws, surf_lsm_v(3)%ssws,               &
-                         surf_usm_v(0)%ssws, surf_usm_v(1)%ssws, surf_usm_v(2)%ssws,               &
-                         surf_usm_v(3)%ssws )
-
-!
-!--    Sink or source of humidity due to canopy elements
-       IF ( plant_canopy ) CALL pcm_tendency( 7 )
-
-!
-!--    Large scale advection. Not implemented for scalars so far.
-!        IF ( large_scale_forcing )  THEN
-!           CALL ls_advec( simulated_time, 'q' )
-!        ENDIF
-
-!
-!--    Nudging. Not implemented for scalars so far.
-!        IF ( nudging )  CALL nudge( simulated_time, 'q' )
-
-!
-!--    If required compute influence of large-scale subsidence/ascent.
-!--    Not implemented for scalars so far.
-       IF ( large_scale_subsidence  .AND.  .NOT. use_subsidence_tendencies  .AND.                  &
-            .NOT. large_scale_forcing )  THEN
-         CALL subsidence( tend, s, s_init, 3 )
-       ENDIF
-
-       CALL module_interface_actions( 's-tendency' )
-
-!
-!--    Prognostic equation for total water content
+             IF ( .NOT. moisture )  THEN
+                CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, pt, &
+                                  rif, tend, zu )
+             ELSE
+                CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, vpt, &
+                                  rif, tend, zu )
+             ENDIF
+          ENDIF
+       ENDIF
+       CALL production_e
+       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
-!
-!--          Following directive is required to vectorize on Intel19
-             !DIR$ IVDEP
-             DO  k = nzb+1, nzt
-                s_p(k,j,i) = s(k,j,i)                                                              &
-                             + ( dt_3d * ( sbt * tend(k,j,i) + tsc(3) * ts_m(k,j,i) )              &
-                                 - tsc(5) * rdf_sc(k) * ( s(k,j,i) - s_init(k) ) )                 &
-                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                IF ( s_p(k,j,i) < 0.0_wp )  s_p(k,j,i) = 0.1_wp * s(k,j,i)
+             DO  k = nzb_s_inner(j,i)+1, nzt-1
+                e_p(k,j,i) = ( 1 - sat ) * e_m(k,j,i) + sat * 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 )  e_p(k,j,i) = 0.1 * e(k,j,i)
              ENDDO
           ENDDO
@@ -1552,14 +1595,15 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      ts_m(k,j,i) = tend(k,j,i)
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      te_m(k,j,i) = tend(k,j,i)
                    ENDDO
                 ENDDO
              ENDDO
-          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
+          ELSEIF ( intermediate_timestep_count < &
+                   intermediate_timestep_count_max )  THEN
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      ts_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * ts_m(k,j,i)
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      te_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * te_m(k,j,i)
                    ENDDO
                 ENDDO
@@ -1568,14 +1612,10 @@
        ENDIF
 
-       CALL cpu_log( log_point(66), 's-equation', 'stop' )
-
-    ENDIF
-!
-!-- Calculate prognostic equations for all other modules
-    CALL module_interface_prognostic_equations()
-
-    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_vector', 'end' )
-
- END SUBROUTINE prognostic_equations_vector
+       CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
+
+    ENDIF
+
+
+ END SUBROUTINE prognostic_equations_vec
 
 
Index: palm/trunk/SOURCE/progress_bar_mod.f90
===================================================================
--- palm/trunk/SOURCE/progress_bar_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,219 +1,0 @@
-!> @file progress_bar_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Increased printed length of run identifier, bugfix for restarts
-
-! 1468 2014-09-24 14:06:57Z maronga
-! Added support for progress file PROGRESS which is used in case of batch jobs
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine prints either a progress bar on the standard output in case of interactive runs, or
-!> it prints the progress in a separate file called PROGRESS.
-!--------------------------------------------------------------------------------------------------!
- MODULE progress_bar
-
-
-    USE control_parameters,                                                                        &
-        ONLY : end_time,                                                                           &
-               initializing_actions,                                                               &
-               run_identifier,                                                                     &
-               simulated_time,                                                                     &
-               simulated_time_at_begin,                                                            &
-               spinup_time,                                                                        &
-               time_restart
-
-    USE, INTRINSIC ::  ISO_FORTRAN_ENV,                                                            &
-        ONLY :  OUTPUT_UNIT
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    PRIVATE
-    PUBLIC   progress_bar_disabled, finish_progress_bar, output_progress_bar
-
-    CHARACTER(LEN=60) ::  bar      !< progress bar, initially filled with "_"
-    CHARACTER(LEN=60) ::  crosses  !< filled with "X"
-
-    INTEGER(iwp) ::  ilength !< length of progress bar filled with "X"
-
-    LOGICAL ::  progress_bar_disabled = .FALSE.   !< envpar-Namelist switch
-
-    LOGICAL ::  initialized = .FALSE. !< switch to determine if bar is initialized
-
-    REAL(wp) ::  time_to_be_simulated !< in sec
-
-    SAVE
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize the progress bar/file
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE init_progress_bar
-
-    IMPLICIT NONE
-
-!
-!-- Calculate the time to be simulated in this job (in case of automatic restarts the calculated
-!-- time will probably be larger than the time which will actually be simulated)
-    IF ( time_restart /= 9999999.9_wp  .AND.  time_restart < end_time  .AND.                       &
-         time_restart > simulated_time_at_begin )  THEN
-       time_to_be_simulated = time_restart - simulated_time_at_begin
-    ELSEIF ( initializing_actions == 'read_restart_data' )  THEN
-       time_to_be_simulated = end_time - simulated_time_at_begin
-    ELSE
-       time_to_be_simulated = end_time - simulated_time_at_begin - spinup_time
-    ENDIF
-
-    IF ( progress_bar_disabled )  THEN
-
-       CALL check_open ( 117 )
-       WRITE ( 117, FMT = '(A34,/)' ) run_identifier
-
-    ELSE
-       bar = '____________________________________________________________'
-       crosses = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
-!
-!--    Line feed on stdout to seperate the progress bar from previous messages
-       WRITE ( OUTPUT_UNIT, '(1X)' )
-#if defined( __intel_compiler )
-!
-!--    The Intel compiler does not allow to immediately flush the output buffer in case that option
-!--    ADVANCE = 'NO' is used in the write statement. A workaround is to set a special carriage
-!--    control feature and use "+" as first output character, but this is non-standard and only
-!--    available with the Intel compiler.
-       OPEN ( OUTPUT_UNIT, CARRIAGECONTROL = 'FORTRAN' )
-#endif
-
-    ENDIF
-
-    initialized = .TRUE.
-
- END SUBROUTINE init_progress_bar
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Print progress data to standard output (interactive) or to file (batch jobs)
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE output_progress_bar
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  remaining_time_in_percent       !< remaining time to be simulated in the job
-    REAL(wp) ::  remaining_time_in_percent_total !< total remaining time of the job chain
-
-    IF ( .NOT. initialized )  CALL init_progress_bar
-
-    IF ( initializing_actions == 'read_restart_data' )  THEN
-       remaining_time_in_percent = ( simulated_time - simulated_time_at_begin )                    &
-                                   / time_to_be_simulated
-
-       remaining_time_in_percent_total = simulated_time / end_time
-    ELSE
-       remaining_time_in_percent = ( simulated_time - simulated_time_at_begin - spinup_time )      &
-                                   / time_to_be_simulated
-
-       remaining_time_in_percent_total = ( ( simulated_time - spinup_time )                        &
-                                           / ( end_time       - spinup_time ) )
-    ENDIF
-
-!
-!-- In batch mode, use a file (PROGRESS), otherwise use progress bar
-    IF ( progress_bar_disabled )  THEN
-
-       BACKSPACE ( 117 )
-       WRITE ( 117, FMT = '(F5.2,1X,F5.2)' ) remaining_time_in_percent,                              &
-                                             remaining_time_in_percent_total
-       FLUSH( 117 )
-
-    ELSE
-
-!
-!--    Calculate length of progress bar
-       ilength = remaining_time_in_percent * 60.0_wp
-       ilength = MIN( ilength, 60 )
-
-       bar(1:ilength) = crosses(1:ilength)
-
-#if defined( __intel_compiler )
-       WRITE ( OUTPUT_UNIT, '(A,6X,''['',A,''] '',F5.1,'' left'')' ) '+', bar,                     &
-             MAX( 0.0_wp, ( 1.0_wp - remaining_time_in_percent ) * 100.0_wp )
-#else
-       WRITE ( OUTPUT_UNIT, '(A,6X,''['',A,''] '',F5.1,'' left'')', ADVANCE = 'NO' )  CHAR( 13 ),  &
-             bar, MAX( 0.0_wp, ( 1.0_wp - remaining_time_in_percent ) * 100.0_wp )
-#endif
-       FLUSH( OUTPUT_UNIT )
-
-    ENDIF
-
- END SUBROUTINE output_progress_bar
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Finalization of the progress bar/file
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE finish_progress_bar
-
-    IMPLICIT NONE
-
-    IF ( progress_bar_disabled )  THEN
-
-       CALL close_file ( 117 )
-
-    ELSE
-
-#if defined( __intel_compiler )
-!
-!--    Reset to the default carriage control
-       OPEN ( OUTPUT_UNIT, CARRIAGECONTROL = 'LIST' )
-#endif
-!
-!--    Line feed when simulation has finished
-       WRITE ( OUTPUT_UNIT, '(1X)' )
-
-    ENDIF
-
- END SUBROUTINE finish_progress_bar
-
-
- END MODULE progress_bar
Index: palm/trunk/SOURCE/radiation_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/radiation_model_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,13844 +1,0 @@
-!> @file radiation_model_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2015-2021 Institute of Computer Science of the Czech Academy of Sciences, Prague
-! Copyright 2015-2021 Czech Technical University in Prague
-! Copyright 1997-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! bugfix for r4898 (missing preprocessor directive added)
-!
-! 4898 2021-03-04 15:49:52Z raasch
-! MPI-IO for sky view factors implemented
-!
-! 4896 2021-03-03 16:10:18Z raasch
-! typo in file appendix removed
-!
-! 4875 2021-02-17 11:56:22Z scharf
-! bugfix for interpolating external radiation on first timestep
-!
-! 4874 2021-02-15 17:21:20Z raasch
-! bugfix for writing restart radiation arrays with MPI-IO
-!
-! 4867 2021-02-06 09:28:31Z moh.hefny
-! bugfix in allocating rad_lw_out_av
-!
-! 4858 2021-01-29 15:27:59Z raasch
-! default value for unscheduled calls of the radiation model set to FALSE,
-! rrtmg input file names changed
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more,
-! deprectaed namelist name removed
-!
-! 4836 2021-01-07 13:58:12Z raasch
-! openmp bugfix: some missing arrays added to reduction clause
-!
-! 4824 2020-12-12 20:45:23Z moh.hefny
-! Bugfix: change the unit of radiation fluxes, few formating changes
-!
-! 4801 2020-11-27 16:06:40Z raasch
-! bugfix for r4800
-!
-! 4800 2020-11-27 14:51:30Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4780 2020-11-10 11:17:10Z suehring
-! Albedo parameter list extended - building facades added
-!
-! 4780 2020-11-10 11:17:10Z suehring
-! Enable 3D data output also with 64-bit precision
-!
-! 4741 2020-10-14 14:32:50Z suehring
-! Add option to force calculation of horizontal mean profiles independent on data output
-!
-! 4717 2020-09-30 22:27:40Z pavelkrc
-! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP directives (J. Resler)
-!
-! 4713 2020-09-29 12:02:05Z pavelkrc
-! Correct OpenMP parallelization including cycles with cumulative variables (J. Resler)
-!
-! 4708 2020-09-28 17:42:58Z suehring
-! - Bugfix, correct mapping of RRTMG heating rates, as well as incoming/outgoing radiation onto the
-!   topography-following grid
-! - Add fill values to the output
-!
-! 4694 2020-09-23 15:09:19Z pavelkrc
-! Bugfix for tracing of maximum radiative fluxes
-!
-! 4686 2020-09-18 11:59:57Z pavelkrc
-! Silence compiler warning about unused variable in serial build
-!
-! 4684 2020-09-18 09:50:28Z pavelkrc
-! Bugfix to previous for serial build
-!
-! 4683 2020-09-18 09:23:09Z pavelkrc
-! Add option to limit the size of MPI_Alltoall calls
-!
-! 4679 2020-09-14 13:53:52Z pavelkrc
-! Enable warning about unrealistically large radiative fluxes by default
-!
-! 4678 2020-09-14 10:23:14Z pavelkrc
-! Fix zdirs indices for full3d in raytrace_2d
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Radiative transfer model RTM version 4.1
-! - Implementation of downward facing USM and LSM surfaces
-! - Removal of deprecated CSV inputs
-! - Bugfixes
-! Authors: J. Resler, P. Krc  (Institute of Computer Science, Prague)
-!
-! 4668 2020-09-09 13:00:16Z pavelkrc
-! Improve debug messages during timestepping
-!
-! 4664 2020-09-02 15:36:10Z gronemeier
-! Add additional debug messages around MPI-AlltoAllv calls
-!
-! 4662 2020-09-02 13:40:38Z pavelkrc
-! Bugfix of LAD in CSF generation in legacy raytracing
-!
-! 4661 2020-09-01 16:00:22Z pavelkrc
-! Bugfix for rad_angular_discretization = .FALSE.
-!
-! 4657 2020-08-28 16:53:45Z pavelkrc
-! Bugfix (silence compiler warning)
-!
-! 4656 2020-08-28 14:51:30Z pavelkrc
-! Bugfix for serial build
-!
-! 4653 2020-08-27 08:54:43Z pavelkrc
-! RTM version 4.0:
-! - Support full-3D geometry:
-!   * Downward faces can only be default type (temporary PALM limitation)
-!   * rad_angular_discretization = .FALSE. is not supported for full-3D cases
-! - Order faces in surf(l) by column
-! - Remove separate direction indices for urban and land faces
-! - Bugfix: skyvft output
-! Authors: P. Krc, J. Resler (Institute of Computer Science, Prague)
-!
-! 4644 2020-08-22 15:05:46Z pavelkrc
-! Bugfix: remove invalid reordering of vertical surfaces in RTM
-!
-! 4643 2020-08-17 09:19:42Z pavelkrc
-! - Bugfix: typo in index of surf%* arrays
-!
-! 4634 2020-08-05 15:42:28Z pavelkrc
-! - Bugfix: rtm_svf_, rtm_dif_ outputs
-! - Bugfix: correct average transparency for MRT factors
-!
-! 4587 2020-07-06 08:53:45Z pavelkrc
-! RTM version 3.1 (see also previous commits):
-! - rotation_angle supported
-! - Plant canopy box count minimized
-! - Multiple enhancements and bugfixes
-!
-! 4584 2020-06-29 13:16:14Z pavelkrc
-! Consider only boxes with LAD>0 as plant canopy (credit: S. Schubert)
-!
-! 4576 2020-06-24 17:58:55Z pavelkrc
-! Allow the use of rotation_angle in RTM
-!
-! 4574 2020-06-24 16:33:32Z pavelkrc
-! - Restructure code in radiation_check_data_output
-! - Move calculation of MPI global array offsets to a subroutine
-!
-! 4571 2020-06-24 08:59:06Z sebschub
-! Bugfix in vertical lad_s coordinate
-!
-! 4558 2020-06-10 16:27:30Z moh.hefny
-! Bugfix: - reset RTM output average values after each averaging timestep to zero
-!         - correct calculation of rtm_rad_net_av
-!
-! 4555 2020-06-05 21:52:00Z moh.hefny
-! Bugfix in averaging PC and MRT related quantities
-!
-! 4552 2020-06-02 20:33:29Z moh.hefny
-! Bugfix in IF statement in the emissivity coupling parameter for radiation-RTM
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! Bugfix for restart data format query
-!
-! 4531 2020-05-13 09:52:22Z moh.hefny
-! Bugfix in gather flux pabs_pc_lwdif in non_parallel case
-!
-! 4529 2020-05-12 09:14:57Z moh.hefny
-! - Added the following new features to the coupling of RTM-radiation model:
-!   1) Considering the vegetation interaction with LW in the coupling
-!   2) Considering PC emissivity in calculating the effective emissivity
-!   3) New algorithm for claculating the coupling parameters so that each term is calculated within
-!      its original line and not at the end.
-! - Minor formatting and comments changes
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! Added restart with MPI-IO for reading local arrays
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! Restart data handling with MPI-IO added
-!
-! 4493 2020-04-10 09:49:43Z pavelkrc
-! Avoid unstable direct normal radiation near horizon
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! Use statement for exchange horiz added
-!
-! 4452 2020-03-10 20:15:32Z suehring
-! Bugfix in calc_albedo
-!
-! 4442 2020-03-04 19:21:13Z suehring
-! - Change order of dimension in surface arrays %frac, %emissivity and %albedo to allow for better
-!   vectorization in the radiation interactions.
-! - Minor formatting issues
-!
-! 4441 2020-03-04 19:20:35Z suehring
-! Bugfixes: cpp-directives for serial mode moved, small changes to get serial mode compiled
-!
-! 4400 2020-02-10 20:32:41Z suehring
-! Initialize radiation arrays with zero
-!
-! 4392 2020-01-31 16:14:57Z pavelkrc
-! - Add debug tracing of large radiative fluxes (option trace_fluxes_above)
-! - Print exact counts of SVF and CSF if debut_output is enabled
-! - Update descriptions of RTM 3.0 and related comments
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Renamed pc_heating_rate, pc_transpiration_rate, pc_transpiration_rate to pcm_heating_rate,
-! pcm_latent_rate, pcm_transpiration_rate
-!
-! 4340 2019-12-16 08:17:03Z Giersch
-! Albedo indices for building_surface_pars are now declared as parameters to prevent an error if the
-! gfortran compiler with -Werror=unused-value is used
-!
-! 4291 2019-11-11 12:36:54Z moh.hefny
-! Enabled RTM in case of biometeorology even if there is no vertical surfaces or 3D vegetation in
-! the domain
-!
-! 4286 2019-10-30 16:01:14Z resler
-! - Fix wrong treating of time_rad during interpolation in radiation_model_mod
-! - Fix wrong checks of time_rad from dynamic driver in radiation_model_mod
-! - Add new directional model of human body for MRT: ellipsoid
-!
-! 4271 2019-10-23 10:46:41Z maronga
-! Bugfix: missing parentheses in calculation of snow albedo
-!
-! 4245 2019-09-30 08:40:37Z pavelkrc
-! Initialize explicit per-surface albedos from building_surface_pars
-!
-! 4238 2019-09-25 16:06:01Z suehring
-! Modify check in order to avoid equality comparisons of floating points
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! Implement new palm_date_time_mod
-!
-! 4226 2019-09-10 17:03:24Z suehring
-! - Netcdf input routine for dimension length renamed
-! - Define time variable for external radiation input relative to time_utc_init
-!
-! 4210 2019-09-02 13:07:09Z suehring
-! - Revise steering of splitting diffuse and direct radiation
-! - Bugfixes in checks
-! - Optimize mapping of radiation components onto 2D arrays, avoid unnecessary operations
-!
-! 4208 2019-09-02 09:01:07Z suehring
-! Bugfix in accessing albedo_pars in the clear-sky branch (merge from branch resler)
-!
-! 4198 2019-08-29 15:17:48Z gronemeier
-! Prohibit execution of radiation model if rotation_angle is not zero
-!
-! 4197 2019-08-29 14:33:32Z suehring
-! Revise steering of surface albedo initialization when albedo_pars is provided
-!
-! 4190 2019-08-27 15:42:37Z suehring
-! Implement external radiation forcing also for level-of-detail = 2 (horizontally 2D radiation)
-!
-! 4188 2019-08-26 14:15:47Z suehring
-! Minor adjustment in error message
-!
-! 4187 2019-08-26 12:43:15Z suehring
-! - Take external radiation from root domain dynamic input if not provided for each nested domain
-! - Combine MPI_ALLREDUCE calls to reduce mpi overhead
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4179 2019-08-21 11:16:12Z suehring
-! Remove debug prints
-!
-! 4178 2019-08-21 11:13:06Z suehring
-! External radiation forcing implemented.
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4157 2019-08-14 09:19:12Z suehring
-! Give informative message on raytracing distance only by core zero
-!
-! 4148 2019-08-08 11:26:00Z suehring
-! Comments added
-!
-! 4134 2019-08-02 18:39:57Z suehring
-! Bugfix in formatted write statement
-!
-! 4127 2019-07-30 14:47:10Z suehring
-! Remove unused pch_index (merge from branch resler)
-!
-! 4089 2019-07-11 14:30:27Z suehring
-! - Correct level 2 initialization of spectral albedos in rrtmg branch, long- and shortwave albedos
-!   were mixed-up.
-! - Change order of albedo_pars so that it is now consistent with the defined order of albedo_pars
-!   in PIDS
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to avoid runtime error
-! (Loop variable has been modified) in time_integration
-!
-! 4067 2019-07-01 13:29:25Z suehring
-! Bugfix, pass dummy string to MPI_INFO_SET (J. Resler)
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! Bugfix for masked data output
-!
-! 4008 2019-05-30 09:50:11Z moh.hefny
-! Bugfix in check variable when a variable's string is less than 3 characters is processed. All
-! variables now are checked if they belong to radiation
-!
-! 3992 2019-05-22 16:49:38Z suehring
-! Bugfix in rrtmg radiation branch in a nested run when the lowest prognistic grid points in a child
-! domain are all inside topography
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3943 2019-05-02 09:50:41Z maronga
-! Missing blank characteer added.
-!
-! 3900 2019-04-16 15:17:43Z suehring
-! Fixed initialization problem
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3881 2019-04-10 09:31:22Z suehring
-! Output of albedo and emissivity moved from USM, bugfixes in initialization of albedo
-!
-! 3861 2019-04-04 06:27:41Z maronga
-! Bugfix: factor of 4.0 required instead of 3.0 in calculation of rad_lw_out_change_0
-!
-! 3859 2019-04-03 20:30:31Z maronga
-! Added some descriptions
-!
-! 3847 2019-04-01 14:51:44Z suehring
-! Implement check for dt_radiation (must be > 0)
-!
-! 3846 2019-04-01 13:55:30Z suehring
-! Unused variable removed
-!
-! 3814 2019-03-26 08:40:31Z pavelkrc
-! Change zenith(0:0) and others to scalar.
-! Code review.
-! Rename exported nzu, nzp and related variables due to name conflict
-!
-! 3771 2019-02-28 12:19:33Z raasch
-! rrtmg preprocessor for directives moved/added, save attribute added to temporary pointers to avoid
-! compiler warnings about outlived pointer targets, statement added to avoid compiler warning about
-! unused variable
-!
-! 3769 2019-02-28 10:16:49Z moh.hefny
-! Removed unused variables and subroutine radiation_radflux_gridbox
-!
-! 3767 2019-02-27 08:18:02Z raasch
-! Unused variable for file index removed from rrd-subroutines parameter list
-!
-! 3760 2019-02-21 18:47:35Z moh.hefny
-! Bugfix: initialized simulated_time before calculating solar position to enable restart option with
-! reading in SVF from file(s).
-!
-! 3754 2019-02-19 17:02:26Z kanani
-! (resler, pavelkrc)
-! Bugfixes: add further required MRT factors to read/write_svf, fix for aggregating view factors to
-! eliminate local noise in reflected irradiance at mutually close surfaces (corners, presence of
-! trees) in the angular discretization scheme.
-!
-! 3752 2019-02-19 09:37:22Z resler
-! Added read/write number of MRT factors to the respective routines
-!
-! 3705 2019-01-29 19:56:39Z suehring
-! Make variables that are sampled in virtual measurement module public
-!
-! 3704 2019-01-29 19:51:41Z suehring
-! Some interface calls moved to module_interface + cleanup
-!
-! 3667 2019-01-10 14:26:24Z schwenkel
-! Modified check for rrtmg input files
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! nopointer option removed
-!
-! 1496 2014-12-02 17:25:50Z maronga
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Radiation models and interfaces:
-!> Constant, simple and RRTMG models, interface to external radiation model
-!> Radiative Transfer Model (RTM) version 3.0 for modelling of radiation
-!> Interactions within urban canopy or other surface layer in complex terrain
-!> Integrations of RTM with other PALM-4U modules:
-!> Integration with RRTMG, USM, LSM, PCM, BIO modules
-!>
-!> @todo Move variable definitions used in radiation_init only to the subroutine as they are no
-!>       longer required after initialization.
-!> @todo Output of full column vertical profiles used in RRTMG
-!> @todo Output of other rrtm arrays (such as volume mixing ratios)
-!> @todo Optimize radiation_tendency routines
-!>
-!> @note Many variables have a leading dummy dimension (0:0) in order to match the assume-size shape
-!>       expected by the RRTMG model.
-!--------------------------------------------------------------------------------------------------!
- MODULE radiation_model_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzw,                                                                                &
-               d_exner,                                                                            &
-               exner,                                                                              &
-               hyp,                                                                                &
-               nc,                                                                                 &
-               pt,                                                                                 &
-               p,                                                                                  &
-               q,                                                                                  &
-               ql,                                                                                 &
-               u,                                                                                  &
-               v,                                                                                  &
-               w,                                                                                  &
-               zu,                                                                                 &
-               zw
-
-
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  barometric_formula,                                                                 &
-               c_p,                                                                                &
-               g,                                                                                  &
-               lv_d_cp,                                                                            &
-               l_v,                                                                                &
-               pi,                                                                                 &
-               r_d,                                                                                &
-               rho_l,                                                                              &
-               solar_constant,                                                                     &
-               sigma_sb
-
-
-    USE calc_mean_profile_mod,                                                                     &
-        ONLY:  calc_mean_profile
-
-    USE control_parameters,                                                                        &
-        ONLY:  biometeorology,                                                                     &
-               cloud_droplets,                                                                     &
-               coupling_char,                                                                      &
-               debug_output,                                                                       &
-               debug_output_timestep,                                                              &
-               debug_string,                                                                       &
-               dt_3d,                                                                              &
-               dz,                                                                                 &
-               dt_spinup,                                                                          &
-               end_time,                                                                           &
-               humidity,                                                                           &
-               initializing_actions,                                                               &
-               io_blocks,                                                                          &
-               io_group,                                                                           &
-               land_surface,                                                                       &
-               large_scale_forcing,                                                                &
-               latitude,                                                                           &
-               longitude,                                                                          &
-               lsf_surf,                                                                           &
-               message_string,                                                                     &
-               plant_canopy,                                                                       &
-               pt_surface,                                                                         &
-               read_svf,                                                                           &
-               restart_data_format_input,                                                          &
-               restart_data_format_output,                                                         &
-               rho_surface,                                                                        &
-               simulated_time,                                                                     &
-               spinup_time,                                                                        &
-               surface_pressure,                                                                   &
-               time_since_reference_point,                                                         &
-               urban_surface,                                                                      &
-               varnamelength,                                                                      &
-               write_svf
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point,                                                                          &
-               log_point_s
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx,                                                                                &
-               ddy,                                                                                &
-               dx,                                                                                 &
-               dy
-
-    USE indices,                                                                                   &
-        ONLY:  nnx,                                                                                &
-               nny,                                                                                &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nx_on_file,                                                                         &
-               ny,                                                                                 &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               ny_on_file,                                                                         &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               topo_top_ind,                                                                       &
-               wall_flags_total_0
-
-    USE, INTRINSIC :: iso_c_binding
-
-    USE kinds
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model,                                                                   &
-               microphysics_morrison,                                                              &
-               na_init,                                                                            &
-               nc_const,                                                                           &
-               sigma_gc
-
-#if defined ( __netcdf )
-    USE NETCDF
-#endif
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  albedo_type_f,                                                                      &
-               albedo_pars_f,                                                                      &
-               building_type_f,                                                                    &
-               building_surface_pars_f,                                                            &
-               char_fill,                                                                          &
-               char_lod,                                                                           &
-               check_existence,                                                                    &
-               close_input_file,                                                                   &
-               get_attribute,                                                                      &
-               get_dimension_length,                                                               &
-               get_variable,                                                                       &
-               inquire_num_variables,                                                              &
-               inquire_variable_names,                                                             &
-               input_file_dynamic,                                                                 &
-               input_pids_dynamic,                                                                 &
-               num_var_pids,                                                                       &
-               pavement_type_f,                                                                    &
-               pids_id,                                                                            &
-               open_read_file,                                                                     &
-               real_1d_3d,                                                                         &
-               vars_pids,                                                                          &
-               vegetation_type_f,                                                                  &
-               water_type_f
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  date_time_str_len,                                                                  &
-               get_date_time,                                                                      &
-               hours_per_day,                                                                      &
-               seconds_per_hour
-
-    USE plant_canopy_model_mod,                                                                    &
-        ONLY:  lad_s,                                                                              &
-               pcm_heating_rate,                                                                   &
-               pcm_transpiration_rate,                                                             &
-               pcm_latent_rate,                                                                    &
-               plant_canopy_transpiration,                                                         &
-               pcm_calc_transpiration_rate
-
-    USE pegrid
-
-#if defined ( __rrtmg )
-    USE parrrsw,                                                                                   &
-        ONLY:  naerec,                                                                             &
-               nbndsw
-
-    USE parrrtm,                                                                                   &
-        ONLY:  nbndlw
-
-    USE rrtmg_lw_init,                                                                             &
-        ONLY:  rrtmg_lw_ini
-
-    USE rrtmg_sw_init,                                                                             &
-        ONLY:  rrtmg_sw_ini
-
-    USE rrtmg_lw_rad,                                                                              &
-        ONLY:  rrtmg_lw
-
-    USE rrtmg_sw_rad,                                                                              &
-        ONLY:  rrtmg_sw
-#endif
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_check_array,                                                              &
-               rrd_mpi_io,                                                                         &
-               wrd_mpi_io,                                                                         &
-               rd_mpi_io_open,                                                                     &
-               rd_mpi_io_surface_filetypes,                                                        &
-               rrd_mpi_io_surface,                                                                 &
-               wrd_mpi_io_surface,                                                                 &
-               rd_mpi_io_close,                                                                    &
-               tgh
-
-    USE statistics,                                                                                &
-        ONLY:  hom
-
-    USE surface_mod,                                                                               &
-        ONLY:  ind_pav_green,                                                                      &
-               ind_veg_wall,                                                                       &
-               ind_wat_win,                                                                        &
-               surf_def_h,                                                                         &
-               surf_lsm_h,                                                                         &
-               surf_lsm_v,                                                                         &
-               surf_type,                                                                          &
-               surf_usm_h,                                                                         &
-               surf_usm_v,                                                                         &
-               vertical_surfaces_exist
-
-    IMPLICIT NONE
-
-    CHARACTER(10) ::  radiation_scheme = 'clear-sky'  !< 'constant', 'clear-sky', or 'rrtmg'
-
-!
-!-- Predefined Land surface classes (albedo_type) after Briegleb (1992)
-    CHARACTER(37), DIMENSION(0:42), PARAMETER :: albedo_type_name = (/      &
-                                   'user defined                         ', & !  0
-                                   'ocean                                ', & !  1
-                                   'mixed farming, tall grassland        ', & !  2
-                                   'tall/medium grassland                ', & !  3
-                                   'evergreen shrubland                  ', & !  4
-                                   'short grassland/meadow/shrubland     ', & !  5
-                                   'evergreen needleleaf forest          ', & !  6
-                                   'mixed deciduous evergreen forest     ', & !  7
-                                   'deciduous forest                     ', & !  8
-                                   'tropical evergreen broadleaved forest', & !  9
-                                   'medium/tall grassland/woodland       ', & ! 10
-                                   'desert, sandy                        ', & ! 11
-                                   'desert, rocky                        ', & ! 12
-                                   'tundra                               ', & ! 13
-                                   'land ice                             ', & ! 14
-                                   'sea ice                              ', & ! 15
-                                   'snow                                 ', & ! 16
-                                   'bare soil                            ', & ! 17
-                                   'asphalt/concrete mix                 ', & ! 18
-                                   'asphalt (asphalt concrete)           ', & ! 19
-                                   'concrete (Portland concrete)         ', & ! 20
-                                   'sett                                 ', & ! 21
-                                   'paving stones                        ', & ! 22
-                                   'cobblestone                          ', & ! 23
-                                   'metal                                ', & ! 24
-                                   'wood                                 ', & ! 25
-                                   'gravel                               ', & ! 26
-                                   'fine gravel                          ', & ! 27
-                                   'pebblestone                          ', & ! 28
-                                   'woodchips                            ', & ! 29
-                                   'tartan (sports)                      ', & ! 30
-                                   'artifical turf (sports)              ', & ! 31
-                                   'clay (sports)                        ', & ! 32
-                                   'building (dummy)                     ', & ! 33
-                                   'building wall - reflecting facade    ', & ! 34
-                                   'building wall - bright facade        ', & ! 35
-                                   'building wall - other materials      ', & ! 36
-                                   'building window - double glazing     ', & ! 37
-                                   'building window - double glazing     ', & ! 38
-                                   'building window - reflecting         ', & ! 39
-                                   'building roof - reflecting           ', & ! 40
-                                   'building roof - bright               ', & ! 41
-                                   'building roof - other materials      '  & ! 42
-                                                         /)
-!
-!-- Indices of radiation-related input attributes in building_surface_pars
-!-- (other are in urban_surface_mod)
-    INTEGER(iwp), PARAMETER ::  ind_s_alb_b_wall  = 19  !< index for Broadband albedo of wall fraction
-    INTEGER(iwp), PARAMETER ::  ind_s_alb_l_wall  = 20  !< index for Longwave albedo of wall fraction
-    INTEGER(iwp), PARAMETER ::  ind_s_alb_s_wall  = 21  !< index for Shortwave albedo of wall fraction
-    INTEGER(iwp), PARAMETER ::  ind_s_alb_b_win   = 22  !< index for Broadband albedo of window fraction
-    INTEGER(iwp), PARAMETER ::  ind_s_alb_l_win   = 23  !< index for Longwave albedo of window fraction
-    INTEGER(iwp), PARAMETER ::  ind_s_alb_s_win   = 24  !< index for Shortwave albedo of window fraction
-    INTEGER(iwp), PARAMETER ::  ind_s_alb_b_green = 24  !< index for Broadband albedo of green fraction
-    INTEGER(iwp), PARAMETER ::  ind_s_alb_l_green = 25  !< index for Longwave albedo of green fraction
-    INTEGER(iwp), PARAMETER ::  ind_s_alb_s_green = 26  !< index for Shortwave albedo of green fraction
-
-    INTEGER(iwp) ::  albedo_type  = 9999999_iwp, &  !< Albedo surface type
-                     dots_rad     = 0_iwp           !< starting index for timeseries output
-    INTEGER(iwp) ::  day_of_year                    !< day of the current year
-
-    LOGICAL ::  unscheduled_radiation_calls = .FALSE., &  !< flag parameter indicating whether additional calls
-                                                          !< of the radiation code are allowed
-                constant_albedo = .FALSE.,             &  !< flag parameter indicating whether the albedo may
-                                                          !< change depending on zenith
-                force_radiation_call = .FALSE.,        &  !< flag parameter for unscheduled radiation calls
-                lw_radiation = .TRUE.,                 &  !< flag parameter indicating whether longwave radiation shall be calculated
-                radiation = .FALSE.,                   &  !< flag parameter indicating whether the radiation model is used
-                sun_up    = .TRUE.,                    &  !< flag parameter indicating whether the sun is up or down
-                sw_radiation = .TRUE.,                 &  !< flag parameter indicating whether shortwave
-                                                          !< radiation shall be calculated
-                sun_direction = .FALSE.,               &  !< flag parameter indicating whether solar direction shall be calculated
-                average_radiation = .FALSE.,           &  !< flag to set the calculation of radiation averaging for the domain
-                radiation_interactions = .FALSE.,      &  !< flag to activiate RTM (TRUE only if vertical
-                                                          !< urban/land surface and trees exist)
-                surface_reflections = .TRUE.,          &  !< flag to switch the calculation of radiation
-                                                          !<interaction between surfaces.
-                                                          !< When it switched off, only the effect of buildings and trees shadow
-                                                          !< will be considered. However fewer SVFs are expected.
-                radiation_interactions_on = .TRUE.        !< namelist flag to force RTM activiation regardless
-                                                          !<to vertical urban/land surface and trees
-
-    REAL(wp), PARAMETER ::  emissivity_atm_clsky = 0.8_wp  !< emissivity of the clear-sky atmosphere
-
-    REAL(wp) ::  albedo = 9999999.9_wp,           &  !< NAMELIST alpha
-                 albedo_lw_dif = 9999999.9_wp,    &  !< NAMELIST aldif
-                 albedo_lw_dir = 9999999.9_wp,    &  !< NAMELIST aldir
-                 albedo_sw_dif = 9999999.9_wp,    &  !< NAMELIST asdif
-                 albedo_sw_dir = 9999999.9_wp,    &  !< NAMELIST asdir
-                 decl_1,                          &  !< declination coef. 1
-                 decl_2,                          &  !< declination coef. 2
-                 decl_3,                          &  !< declination coef. 3
-                 dt_radiation = 0.0_wp,           &  !< radiation model timestep
-                 emissivity = 9999999.9_wp,       &  !< NAMELIST surface emissivity
-                 lon = 0.0_wp,                    &  !< longitude in radians
-                 lat = 0.0_wp,                    &  !< latitude in radians
-                 net_radiation = 0.0_wp,          &  !< net radiation at surface
-                 skip_time_do_radiation = 0.0_wp, &  !< Radiation model is not called before this time
-                 sky_trans,                       &  !< sky transmissivity
-                 time_radiation = 0.0_wp,         &  !< time since last call of radiation code
-                 trace_fluxes_above = 2000.0_wp,  &  !< NAMELIST option for debug printing of largest radiative fluxes
-                                                     !< (W/m2 for surfaces, W/m3 for PC). -1=off, 0=all fluxes
-                 min_stable_coszen = 0.0262_wp       !< 1.5 deg above horizon, eliminates most of circumsolar
-    REAL(wp) ::  cos_zenith                          !< cosine of solar zenith angle, also z-coordinate of solar unit vector
-    REAL(wp) ::  d_hours_day                         !< 1 / hours-per-day
-    REAL(wp) ::  d_seconds_hour                      !< 1 / seconds-per-hour
-    REAL(wp) ::  second_of_day                       !< second of the current day
-    REAL(wp) ::  sun_dir_lat                         !< y-coordinate of solar unit vector
-    REAL(wp) ::  sun_dir_lon                         !< x-coordinate of solar unit vector
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_net_av        !< average of net radiation (rad_net) at surface
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_lw_in_xy_av   !< average of incoming longwave radiation at surface
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_lw_out_xy_av  !< average of outgoing longwave radiation at surface
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_sw_in_xy_av   !< average of incoming shortwave radiation at surface
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_sw_out_xy_av  !< average of outgoing shortwave radiation at surface
-
-
-!
-!-- Land surface albedos for solar zenith angle of 60 degree after Briegleb (1992)
-!-- (broadband, longwave, shortwave ):   bb,      lw,      sw,
-    REAL(wp), DIMENSION(0:2,1:42), PARAMETER :: albedo_pars = RESHAPE( (/&
-                                   0.06_wp, 0.06_wp, 0.06_wp,            & !  1 - ocean
-                                   0.19_wp, 0.28_wp, 0.09_wp,            & !  2 - mixed farming, tall grassland
-                                   0.23_wp, 0.33_wp, 0.11_wp,            & !  3 - tall/medium grassland
-                                   0.23_wp, 0.33_wp, 0.11_wp,            & !  4 - evergreen shrubland
-                                   0.25_wp, 0.34_wp, 0.14_wp,            & !  5 - short grassland/meadow/shrubland
-                                   0.14_wp, 0.22_wp, 0.06_wp,            & !  6 - evergreen needleleaf forest
-                                   0.17_wp, 0.27_wp, 0.06_wp,            & !  7 - mixed deciduous forest
-                                   0.19_wp, 0.31_wp, 0.06_wp,            & !  8 - deciduous forest
-                                   0.14_wp, 0.22_wp, 0.06_wp,            & !  9 - tropical evergreen broadleaved forest
-                                   0.18_wp, 0.28_wp, 0.06_wp,            & ! 10 - medium/tall grassland/woodland
-                                   0.43_wp, 0.51_wp, 0.35_wp,            & ! 11 - desert, sandy
-                                   0.32_wp, 0.40_wp, 0.24_wp,            & ! 12 - desert, rocky
-                                   0.19_wp, 0.27_wp, 0.10_wp,            & ! 13 - tundra
-                                   0.77_wp, 0.65_wp, 0.90_wp,            & ! 14 - land ice
-                                   0.77_wp, 0.65_wp, 0.90_wp,            & ! 15 - sea ice
-                                   0.82_wp, 0.70_wp, 0.95_wp,            & ! 16 - snow
-                                   0.08_wp, 0.08_wp, 0.08_wp,            & ! 17 - bare soil
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 18 - asphalt/concrete mix
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 19 - asphalt (asphalt concrete)
-                                   0.30_wp, 0.30_wp, 0.30_wp,            & ! 20 - concrete (Portland concrete)
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 21 - sett
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 22 - paving stones
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 23 - cobblestone
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 24 - metal
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 25 - wood
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 26 - gravel
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 27 - fine gravel
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 28 - pebblestone
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 29 - woodchips
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 30 - tartan (sports)
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 31 - artificial turf (sports)
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 32 - clay (sports)
-                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 33 - building (dummy)
-                                   0.60_wp, 0.60_wp, 0.60_wp,            & ! 34 - building wall type 1 - reflecting facade
-                                   0.30_wp, 0.30_wp, 0.30_wp,            & ! 35 - building wall type 2 - bright facacde
-                                   0.07_wp, 0.07_wp, 0.07_wp,            & ! 36 - building wall type 3) - other materials
-                                   0.12_wp, 0.12_wp, 0.12_wp,            & ! 37 - building window type 1 - double glazing
-                                   0.17_wp, 0.18_wp, 0.18_wp,            & ! 38 - building window type 2 - triple glazing
-                                   0.48_wp, 0.48_wp, 0.48_wp,            & ! 39 - building window type 3 - reflecting
-                                   0.60_wp, 0.60_wp, 0.60_wp,            & ! 40 - building roof type 1 - reflecting
-                                   0.30_wp, 0.30_wp, 0.30_wp,            & ! 41 - building roof type 2 - bright
-                                   0.07_wp, 0.07_wp, 0.07_wp             & ! 42 - building roof type 3 - other materials
-                                 /), (/ 3, 42 /) )
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  &
-                        rad_lw_cs_hr,                   &  !< longwave clear sky radiation heating rate (K/s)
-                        rad_lw_cs_hr_av,                &  !< average of rad_lw_cs_hr
-                        rad_lw_hr,                      &  !< longwave radiation heating rate (K/s)
-                        rad_lw_hr_av,                   &  !< average of rad_sw_hr
-                        rad_lw_in,                      &  !< incoming longwave radiation (W/m2)
-                        rad_lw_in_av,                   &  !< average of rad_lw_in
-                        rad_lw_out,                     &  !< outgoing longwave radiation (W/m2)
-                        rad_lw_out_av,                  &  !< average of rad_lw_out
-                        rad_sw_cs_hr,                   &  !< shortwave clear sky radiation heating rate (K/s)
-                        rad_sw_cs_hr_av,                &  !< average of rad_sw_cs_hr
-                        rad_sw_hr,                      &  !< shortwave radiation heating rate (K/s)
-                        rad_sw_hr_av,                   &  !< average of rad_sw_hr
-                        rad_sw_in,                      &  !< incoming shortwave radiation (W/m2)
-                        rad_sw_in_av,                   &  !< average of rad_sw_in
-                        rad_sw_out,                     &  !< outgoing shortwave radiation (W/m2)
-                        rad_sw_out_av                      !< average of rad_sw_out
-
-
-!
-!-- Variables and parameters used in RRTMG only
-#if defined ( __rrtmg )
-    CHARACTER(LEN=12) ::  rrtm_input_file = 'RAD_SND_DATA'  !< name of the NetCDF input file (sounding data)
-
-
-!
-!-- Flag parameters to be passed to RRTMG (should not be changed until ice phase in clouds is allowed)
-    INTEGER(iwp), PARAMETER ::  rrtm_idrv     = 1, &  !< flag for longwave upward flux calculation option (0,1)
-                                rrtm_inflglw  = 2, &  !< flag for lw cloud optical properties (0,1,2)
-                                rrtm_iceflglw = 0, &  !< flag for lw ice particle specifications (0,1,2,3)
-                                rrtm_liqflglw = 1, &  !< flag for lw liquid droplet specifications
-                                rrtm_inflgsw  = 2, &  !< flag for sw cloud optical properties (0,1,2)
-                                rrtm_iceflgsw = 0, &  !< flag for sw ice particle specifications (0,1,2,3)
-                                rrtm_liqflgsw = 1     !< flag for sw liquid droplet specifications
-
-!
-!-- The following variables should only be changed with care, as this will require further setting
-!-- of some variables, which is currently not implemented (aerosols, ice phase).
-    INTEGER(iwp) ::  nzt_rad,           &  !< upper vertical limit for radiation calculations
-                     rrtm_icld = 0,     &  !< cloud flag (0: clear sky column, 1: cloudy column)
-                     rrtm_iaer = 0         !< aerosol option flag (0: no aerosol layers, for lw only: 6
-                                           !< (requires setting of rrtm_sw_ecaer), 10: one or more aerosol layers (not implemented)
-
-    INTEGER(iwp) ::  nc_stat  !< local variable for storin the result of netCDF calls for error message handling
-
-    LOGICAL ::  snd_exists = .FALSE.  !< flag parameter to check whether a user-defined input files exists
-    LOGICAL ::  sw_exists  = .FALSE.  !< flag parameter to check whether that required rrtmg sw file exists
-    LOGICAL ::  lw_exists  = .FALSE.  !< flag parameter to check whether that required rrtmg lw file exists
-
-
-    REAL(wp), PARAMETER ::  mol_mass_air_d_wv = 1.607793_wp  !< molecular weight dry air / water vapor
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  hyp_snd,     &  !< hypostatic pressure from sounding data (hPa)
-                                            rrtm_tsfc,   &  !< dummy array for storing surface temperature
-                                            t_snd           !< actual temperature from sounding data (hPa)
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rrtm_ccl4vmr,   &  !< CCL4 volume mixing ratio (g/mol)
-                                              rrtm_cfc11vmr,  &  !< CFC11 volume mixing ratio (g/mol)
-                                              rrtm_cfc12vmr,  &  !< CFC12 volume mixing ratio (g/mol)
-                                              rrtm_cfc22vmr,  &  !< CFC22 volume mixing ratio (g/mol)
-                                              rrtm_ch4vmr,    &  !< CH4 volume mixing ratio
-                                              rrtm_cicewp,    &  !< in-cloud ice water path (g/m2)
-                                              rrtm_cldfr,     &  !< cloud fraction (0,1)
-                                              rrtm_cliqwp,    &  !< in-cloud liquid water path (g/m2)
-                                              rrtm_co2vmr,    &  !< CO2 volume mixing ratio (g/mol)
-                                              rrtm_emis,      &  !< surface emissivity (0-1)
-                                              rrtm_h2ovmr,    &  !< H2O volume mixing ratio
-                                              rrtm_n2ovmr,    &  !< N2O volume mixing ratio
-                                              rrtm_o2vmr,     &  !< O2 volume mixing ratio
-                                              rrtm_o3vmr,     &  !< O3 volume mixing ratio
-                                              rrtm_play,      &  !< pressure layers (hPa, zu-grid)
-                                              rrtm_plev,      &  !< pressure layers (hPa, zw-grid)
-                                              rrtm_reice,     &  !< cloud ice effective radius (microns)
-                                              rrtm_reliq,     &  !< cloud water drop effective radius (microns)
-                                              rrtm_tlay,      &  !< actual temperature (K, zu-grid)
-                                              rrtm_tlev,      &  !< actual temperature (K, zw-grid)
-                                              rrtm_lwdflx,    &  !< RRTM output of incoming longwave radiation flux (W/m2)
-                                              rrtm_lwdflxc,   &  !< RRTM output of outgoing clear sky longwave radiation flux (W/m2)
-                                              rrtm_lwuflx,    &  !< RRTM output of outgoing longwave radiation flux (W/m2)
-                                              rrtm_lwuflxc,   &  !< RRTM output of incoming clear sky longwave radiation flux (W/m2)
-                                              rrtm_lwuflx_dt, &  !< RRTM output of incoming clear sky longwave radiation flux (W/m2)
-                                              rrtm_lwuflxc_dt,&  !< RRTM output of outgoing clear sky longwave radiation flux (W/m2)
-                                              rrtm_lwhr,      &  !< RRTM output of longwave radiation heating rate (K/d)
-                                              rrtm_lwhrc,     &  !< RRTM output of incoming longwave
-                                                                 !< clear sky radiation heating rate (K/d)
-                                              rrtm_swdflx,    &  !< RRTM output of incoming shortwave radiation flux (W/m2)
-                                              rrtm_swdflxc,   &  !< RRTM output of outgoing clear sky
-                                                                 !< shortwave radiation flux (W/m2)
-                                              rrtm_swuflx,    &  !< RRTM output of outgoing shortwave radiation flux (W/m2)
-                                              rrtm_swuflxc,   &  !< RRTM output of incoming clear sky
-                                                                 !< shortwave radiation flux (W/m2)
-                                              rrtm_swhr,      &  !< RRTM output of shortwave radiation heating rate (K/d)
-                                              rrtm_swhrc,     &  !< RRTM output of incoming shortwave
-                                                                 !< clear sky radiation heating rate (K/d)
-                                              rrtm_dirdflux,  &  !< RRTM output of incoming direct shortwave (W/m2)
-                                              rrtm_difdflux      !< RRTM output of incoming diffuse shortwave (W/m2)
-
-    REAL(wp), DIMENSION(1) ::  rrtm_aldif,     &  !< surface albedo for longwave diffuse radiation
-                               rrtm_aldir,     &  !< surface albedo for longwave direct radiation
-                               rrtm_asdif,     &  !< surface albedo for shortwave diffuse radiation
-                               rrtm_asdir         !< surface albedo for shortwave direct radiation
-
-!
-!-- Definition of arrays that are currently not used for calling RRTMG (due to setting of flag parameters)
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  rad_lw_cs_in,   &  !< incoming clear sky longwave radiation (W/m2) (not used)
-                                                rad_lw_cs_out,  &  !< outgoing clear sky longwave radiation (W/m2) (not used)
-                                                rad_sw_cs_in,   &  !< incoming clear sky shortwave radiation (W/m2) (not used)
-                                                rad_sw_cs_out,  &  !< outgoing clear sky shortwave radiation (W/m2) (not used)
-                                                rrtm_lw_tauaer, &  !< lw aerosol optical depth
-                                                rrtm_lw_taucld, &  !< lw in-cloud optical depth
-                                                rrtm_sw_taucld, &  !< sw in-cloud optical depth
-                                                rrtm_sw_ssacld, &  !< sw in-cloud single scattering albedo
-                                                rrtm_sw_asmcld, &  !< sw in-cloud asymmetry parameter
-                                                rrtm_sw_fsfcld, &  !< sw in-cloud forward scattering fraction
-                                                rrtm_sw_tauaer, &  !< sw aerosol optical depth
-                                                rrtm_sw_ssaaer, &  !< sw aerosol single scattering albedo
-                                                rrtm_sw_asmaer, &  !< sw aerosol asymmetry parameter
-                                                rrtm_sw_ecaer      !< sw aerosol optical detph at 0.55 microns (rrtm_iaer = 6 only)
-
-#endif
-!
-!-- Parameters of urban and land surface models
-    INTEGER(iwp) ::  nz_urban    !< number of layers of urban surface (will be calculated)
-    INTEGER(iwp) ::  nz_plant    !< number of layers of plant canopy (will be calculated)
-    INTEGER(iwp) ::  nz_urban_b  !< bottom layer of urban surface (will be calculated)
-    INTEGER(iwp) ::  nz_urban_t  !< top layer of urban surface (will be calculated)
-    INTEGER(iwp) ::  nz_plant_t  !< top layer of plant canopy (will be calculated)
-!
-!-- Parameters of urban and land surface models
-    INTEGER(iwp), PARAMETER ::  nzut_free = 3   !< number of free layers above top of of topography
-    INTEGER(iwp), PARAMETER ::  ndsvf = 2       !< number of dimensions of real values in SVF
-    INTEGER(iwp), PARAMETER ::  idsvf = 2       !< number of dimensions of integer values in SVF
-    INTEGER(iwp), PARAMETER ::  ndcsf = 1       !< number of dimensions of real values in CSF
-    INTEGER(iwp), PARAMETER ::  idcsf = 2       !< number of dimensions of integer values in CSF
-    INTEGER(iwp), PARAMETER ::  kdcsf = 4       !< number of dimensions of integer values in CSF calculation array
-    INTEGER(iwp), PARAMETER ::  id = 1          !< position of d-index in surfl and surf
-    INTEGER(iwp), PARAMETER ::  iz = 2          !< position of k-index in surfl and surf
-    INTEGER(iwp), PARAMETER ::  iy = 3          !< position of j-index in surfl and surf
-    INTEGER(iwp), PARAMETER ::  ix = 4          !< position of i-index in surfl and surf
-    INTEGER(iwp), PARAMETER ::  nidx_surf = 4   !< number of indices in surfl and surf
-    INTEGER(iwp), PARAMETER ::  nsurf_type = 5  !< number of surf types = surface directions
-    INTEGER(iwp), PARAMETER ::  iup    = 0      !< 0 - index of upward surface (ground or roof)
-    INTEGER(iwp), PARAMETER ::  idown  = 1      !< 1 - index of downward surface (overhanging)
-    INTEGER(iwp), PARAMETER ::  inorth = 2      !< 2 - index of northward facing wall
-    INTEGER(iwp), PARAMETER ::  isouth = 3      !< 3 - index of southward facing wall
-    INTEGER(iwp), PARAMETER ::  ieast  = 4      !< 4 - index of eastward facing wall
-    INTEGER(iwp), PARAMETER ::  iwest  = 5      !< 5 - index of westward facing wall
-
-    INTEGER(iwp), DIMENSION(0:nsurf_type), PARAMETER ::  idir = (/0, 0, 0, 0, 1,-1/)  !< surface normal direction x indices
-    INTEGER(iwp), DIMENSION(0:nsurf_type), PARAMETER ::  jdir = (/0, 0, 1,-1, 0, 0/)  !< surface normal direction y indices
-    INTEGER(iwp), DIMENSION(0:nsurf_type), PARAMETER ::  kdir = (/1,-1, 0, 0, 0, 0/)  !< surface normal direction z indices
-
-    REAL(wp), DIMENSION(0:nsurf_type) ::  facearea  !< area of single face in respective, direction (will be calc'd)
-
-!
-!-- Indices needed for RTM netcdf output subroutines
-    INTEGER(iwp), PARAMETER ::  nd = 6  !< number of directions
-
-    CHARACTER(LEN=6), DIMENSION(0:nd-1), PARAMETER ::  dirname = (/ '_up   ', '_down ', '_south', '_north', '_west ', '_east ' /) !<
-
-    INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER ::  dirint = (/ iup, idown, isouth, inorth, iwest, ieast /)  !< direction integers
-    INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER ::  diridx =  (/  0,     1,      1,      0,     3,     2 /)  !< mapping to surf_h
-                                                                                                            !<  and surf_v
-
-    INTEGER(iwp), DIMENSION(0:1), PARAMETER ::  dirint_h = (/ iup, idown /)                    !< mapping to surf_h directions
-    INTEGER(iwp), DIMENSION(0:3), PARAMETER ::  dirint_v = (/ inorth, isouth, ieast, iwest /)  !< mapping to surf_v directions
-!
-!-- Indices and sizes of urban and land surface models
-    INTEGER(iwp) ::  nsurfl  !< number of all surfaces in local processor
-    INTEGER(iwp) ::  nsurf   !< global number of surfaces in index array of surfaces (nsurf = proc nsurfs)
-
-    INTEGER(iwp), DIMENSION(:,:), POINTER ::  surf   !< coordinates of i-th surface in grid - surf[:,k] = [d, z, y, x, m]
-    INTEGER(iwp), DIMENSION(:,:), POINTER ::  surfl  !< coordinates of i-th local surface in local grid - surfl[:,k] =
-                                                     !< [d, z, y, x, m]
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  surfl_linear     !< dtto (linearly allocated array)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  surf_linear      !< dtto (linearly allocated array)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  nsurfs           !< array of number of all surfaces in individual processors
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  surfstart        !< starts of blocks of surfaces for individual
-                                                                        !< processors in array surf (indexed from 1)
-                                                                        !< respective block for particular processor is
-                                                                        !< surfstart[iproc+1]+1 : surfstart[iproc+1]+nsurfs[iproc+1]
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  surfl_col_start  !< start of surfaces in surfl
-                                                                        !< for each x,y column (local surfaces)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  surfg_col_start  !< start of surfaces in surfl
-                                                                        !< for each x,y column (all surfaces)
-!
-!-- Block variables needed for calculation of the plant canopy model inside the urban surface model
-    INTEGER(iwp) ::  npcbl = 0  !< number of the plant canopy gridboxes in local processor
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  pct   !< top layer of the plant canopy
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  pch   !< heights of the plant canopy
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  pcbl  !< k,j,i coordinates of l-th local plant canopy box pcbl[:,l] = [k, j, i]
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pcbinsw     !< array of absorbed sw radiation for local plant canopy box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pcbinswdir  !< array of absorbed direct sw radiation for local plant canopy box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pcbinswdif  !< array of absorbed diffusion sw radiation for local plant canopy box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pcbinlw     !< array of absorbed lw radiation for local plant canopy box
-!
-!-- Configuration parameters (they can be setup in PALM config)
-    INTEGER(iwp), PARAMETER ::  rad_version_len = 10  !< length of identification string of rad version
-
-    CHARACTER(rad_version_len), PARAMETER ::  rad_version = 'RAD v. 4.1'  !< identification of version of binary svf and
-                                                                          !< restart files
-
-    INTEGER(iwp) ::  bufsize_alltoall = 0          !< max no. of items to send in mpi_alltoall at once (0=infinite)
-    INTEGER(iwp) ::  mrt_nlevels = 0               !< number of vertical boxes above surface for which to calculate MRT
-    INTEGER(iwp) ::  nrefsteps = 3                 !< number of reflection steps to perform
-    INTEGER(iwp) ::  raytrace_discrete_elevs = 40  !< number of discretization steps for elevation (nadir to zenith)
-    INTEGER(iwp) ::  raytrace_discrete_azims = 80  !< number of discretization steps for azimuth (out of 360 degrees)
-    INTEGER(iwp) ::  svfnorm_report_num            !< number of SVF normalization thresholds to report
-
-    INTEGER(wp) ::  mrt_geom = 1  !< method for MRT direction weights simulating a sphere or a human body
-
-    LOGICAL ::  mrt_skip_roof = .TRUE.               !< do not calculate MRT above roof surfaces
-    LOGICAL ::  mrt_include_sw = .TRUE.              !< should MRT calculation include SW radiation as well?
-    LOGICAL ::  plant_lw_interact = .TRUE.           !< whether plant canopy interacts with LW radiation (in addition to SW)
-    LOGICAL ::  raytrace_mpi_rma = .TRUE.            !< use MPI RMA to access LAD and gridsurf from remote processes
-                                                     !< during raytracing
-    LOGICAL ::  rad_angular_discretization = .TRUE.  !< whether to use fixed resolution discretization of view factors for
-                                                     !< reflected radiation (as opposed to all mutually visible pairs)
-
-    REAL(wp), PARAMETER ::  ext_coef = 0.6_wp  !< extinction coefficient (a.k.a. alpha)
-
-    REAL(wp) ::  max_raytracing_dist = -999.0_wp  !< maximum distance for raytracing (in metres)
-    REAL(wp) ::  min_irrf_value = 1e-6_wp         !< minimum potential irradiance factor value for raytracing
-
-    REAL(wp), DIMENSION(2) ::  mrt_geom_params = (/ .12_wp, .88_wp /)  !< parameters for the selected method
-
-    REAL(wp), DIMENSION(1:30) ::  svfnorm_report_thresh = 1e21_wp         !< thresholds of SVF normalization values to report
-
-!
-!-- Radiation related arrays to be used in radiation_interaction routine
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_sw_in_dir   !< direct sw radiation
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_sw_in_diff  !< diffusion sw radiation
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_lw_in_diff  !< diffusion lw radiation
-!
-!-- Parameters required for RRTMG lower boundary condition
-    REAL(wp) :: albedo_urb      !< albedo value retuned to RRTMG boundary cond.
-    REAL(wp) :: emissivity_urb  !< emissivity value retuned to RRTMG boundary cond.
-    REAL(wp) :: t_rad_urb       !< temperature value retuned to RRTMG boundary cond.
-!
-!-- Type for calculation of svf
-    TYPE t_svf
-        INTEGER(iwp) :: isurflt  !<
-        INTEGER(iwp) :: isurfs   !<
-        REAL(wp) :: rsvf     !<
-        REAL(wp) :: rtransp  !<
-    END TYPE
-!
-!-- Type for calculation of csf
-    TYPE t_csf
-        INTEGER(iwp) :: ip      !<
-        INTEGER(iwp) :: itx     !<
-        INTEGER(iwp) :: ity     !<
-        INTEGER(iwp) :: itz     !<
-        INTEGER(iwp) :: isurfs  !< Idx of source face / -1 for sky
-        REAL(wp) :: rcvf  !< Canopy view factor for faces / canopy sink factor for sky (-1)
-    END TYPE
-!
-!-- Arrays storing the values of USM
-    INTEGER(iwp) ::  ndsidir  !< number of apparent solar directions used
-    INTEGER(iwp) ::  nmrtbl   !< No. of local grid boxes for which MRT is calculated
-    INTEGER(iwp) ::  nmrtf    !< number of MRT factors for local processor
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  dsidir_rev  !< dsidir_rev[ielev,iazim] = i for dsidir or -1 if not present
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mrtbl       !< coordinates of i-th local MRT box - surfl[:,i] = [z, y, x]
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mrtfsurf    !< mrtfsurf[:,imrtf] = index of target MRT box and
-                                                              !< source surface for mrtf[imrtf]
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  svfsurf     !< svfsurf[:,isvf] = index of target and source surface for svf[isvf]
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mrtf         !< array of MRT factors for each local MRT box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mrtft        !< array of MRT factors including transparency for each local MRT box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mrtsky       !< array of sky view factor for each local MRT box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mrtskyt      !< array of sky view factor including transparency for each local MRT box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mrtinsw      !< mean SW radiant flux for each MRT box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mrtinlw      !< mean LW radiant flux for each MRT box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mrt          !< mean radiant temperature for each MRT box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mrtinsw_av   !< time average mean SW radiant flux for each MRT box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mrtinlw_av   !< time average mean LW radiant flux for each MRT box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  mrt_av       !< time average mean radiant temperature for each MRT box
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutsw    !< array of total sw radiation outgoing from nonvirtual surfaces
-                                                         !< surfaces after all reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfins      !< array of sw radiation falling to local surface after i-th reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinl      !< array of lw radiation for local surface after i-th reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  skyvf        !< array of sky view factor for each local surface
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  skyvft       !< array of sky view factor including transparency for each local surface
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinsw     !< array of sw radiation falling to local surface including
-                                                         !< radiation from reflections
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlw     !< array of lw radiation falling to local surface including
-                                                         !< radiation from reflections
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswdir  !< array of direct sw radiation falling to local surface
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswdif  !< array of diffuse sw radiation from sky and model boundary
-                                                         !< falling to local surface
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlwdif  !< array of diffuse lw radiation from sky and model boundary
-                                                         !< falling to local surface
-                                                         !< Outward radiation is only valid for nonvirtual surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutsl    !< array of reflected sw radiation for local surface in i-th reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutll    !< array of reflected + emitted lw radiation for local
-                                                         !< surface in i-th reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfouts     !< array of reflected sw radiation for all surfaces in i-th reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutl     !< array of reflected + emitted lw radiation for all
-                                                         !< surfaces in i-th reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlg     !< global array of incoming lw radiation from plant canopy
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutlw    !< array of total lw radiation outgoing from nonvirtual surfaces
-                                                         !< surfaces after all reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfemitlwl  !< array of emitted lw radiation for local surface used to calculate
-                                                         !<effective surface temperature for radiation model
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dsitrans   !< dsidir[isvfl,i] = path transmittance of i-th
-                                                         !< direction of direct solar irradiance per target surface
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dsitransc  !< dtto per plant canopy box
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dsidir     !< dsidir[:,i] = unit vector of i-th
-                                                         !< direction of direct solar irradiance
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  mrtdsit    !< array of direct solar transparencies for each local MRT box
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  svf        !< array of shape view factors+direct irradiation factors
-                                                         !< for local surfaces
-
-
-!
-!-- Block variables needed for calculation of the plant canopy model inside the urban surface model
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  csfsurf  !< csfsurf[:,icsf] = index of target surface and
-                                                           !< csf grid index for csf[icsf]
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  csf  !< array of plant canopy sink fators + direct irradiation factors (transparency)
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  sub_lad  !< subset of lad_s within urban surface, transformed to plain Z coordinate
-#if defined( __parallel )
-    REAL(wp), DIMENSION(:), POINTER ::  sub_lad_g  !< sub_lad globalized (used to avoid MPI RMA calls in raytracing)
-#endif
-    INTEGER(iwp) ::  plantt_max  !<
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nzterrt  !< temporary global arrays for raytracing
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nzterrb  !< temporary global arrays for raytracing
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  plantt   !< temporary global arrays for raytracing
-
-    REAL(wp) ::  prototype_lad  !< prototype leaf area density for computing effective optical depth
-
-!
-!-- Arrays and variables for calculation of svf and csf
-    INTEGER(iwp), PARAMETER ::  gasize = 100000_iwp  !< initial size of growing arrays
-    INTEGER(iwp), PARAMETER ::  nsurf_type_u = 6     !< number of urban surf types (used in gridsurf)
-
-    INTEGER(iwp) ::  nsvfl              !< number of svf for local processor
-    INTEGER(iwp) ::  ncsfl              !< no. of csf in local processor needed only during calc_svf but must be here because it is
-                                        !< shared between subroutines calc_svf and raytrace
-    INTEGER(iwp) ::  nsvfla             !< dimmension of array allocated for storage of svf in local processor
-    INTEGER(iwp) ::  ncsfla             !< dimmension of array allocated for storage of csf in local processor
-    INTEGER(iwp) ::  nmrtfa             !< dimmension of array allocated for storage of mrt
-    INTEGER(iwp) ::  msvf, mcsf, mmrtf  !< mod for swapping the growing array
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  gridpcbl  !< reverse index of local pcbl[k,j,i]
-
-    INTEGER(iwp), DIMENSION(:,:,:,:), POINTER ::  gridsurf  !< reverse index of local surfl[d,k,j,i]
-                                                            !< (for case rad_angular_discretization)
-
-    REAL(wp), PARAMETER ::  grow_factor = 1.4_wp  !< growth factor of growing arrays
-
-    TYPE(t_svf), DIMENSION(:), POINTER ::  asvf   !< pointer to growing svc array
-    TYPE(t_csf), DIMENSION(:), POINTER ::  acsf   !< pointer to growing csf array
-    TYPE(t_svf), DIMENSION(:), POINTER ::  amrtf  !< pointer to growing mrtf array
-
-    TYPE(t_svf), DIMENSION(:), ALLOCATABLE, TARGET ::  asvf1, asvf2    !< realizations of svf array
-    TYPE(t_csf), DIMENSION(:), ALLOCATABLE, TARGET ::  acsf1, acsf2    !< realizations of csf array
-    TYPE(t_svf), DIMENSION(:), ALLOCATABLE, TARGET ::  amrtf1, amrtf2  !< realizations of mftf array
-
-
-!
-!-- Temporary arrays for calculation of csf in raytracing
-    INTEGER(iwp) ::  maxboxesg  !< max number of boxes ray can cross in the domain
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  lad_ip  !< array of numbers of process where lad is stored
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  boxes  !< coordinates of gridboxes being crossed by ray
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  crlens  !< array of crossing lengths of ray for particular grid boxes
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  win_lad       !< MPI RMA window for leaf area density
-    INTEGER(iwp) ::  win_gridsurf  !< MPI RMA window for reverse grid surface index
-
-    INTEGER(kind=MPI_ADDRESS_KIND), DIMENSION(:), ALLOCATABLE  ::  lad_disp  !< array of displaycements of lad
-                                                                             !< in local array of proc lad_ip
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  lad_s_ray  !< array of received lad_s for appropriate gridboxes crossed by ray
-#endif
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  target_surfl  !<
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  rt2_track  !<
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  rt2_track_dist  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  rt2_dist        !<
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rt2_track_lad  !<
-!
-!-- Arrays for time averages
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pcbinlw_av      !< Average of pcbinlw
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pcbinsw_av      !< Average of pcbinsw
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pcbinswdir_av   !< Average of pcbinswdir
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pcbinswdif_av   !< Average of pcbinswdif
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pcbinswref_av   !< Average of pcbinswref
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfradnet_av   !< average of net radiation to local surface including radiation
-                                                            !< from reflections
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinsw_av     !< average of sw radiation falling to local surface including
-                                                            !< radiation from reflections
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlw_av     !< average of lw radiation falling to local surface including
-                                                            !< radiation from reflections
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswdir_av  !< average of direct sw radiation falling to local surface
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswdif_av  !< average of diffuse sw radiation from sky and model boundary falling
-                                                            !< to local surface
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlwdif_av  !< average of diffuse lw radiation from sky and model boundary falling
-                                                            !< to local surface
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswref_av  !< average of sw radiation falling to surface from reflections
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlwref_av  !< average of lw radiation falling to surface from reflections
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutsw_av    !< average of total sw radiation outgoing from nonvirtual surfaces
-                                                            !<  surfaces after all reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutlw_av    !< average of total lw radiation outgoing from nonvirtual surfaces
-                                                            !< surfaces after all reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfins_av      !< average of array of residua of sw radiation absorbed in surface
-                                                            !< after last reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinl_av      !< average of array of residua of lw radiation absorbed in surface
-                                                            !< after last reflection
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!-- Energy balance variables
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!-- Parameters of the land, roof and wall surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  albedo_surf  !< albedo of the surface
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  emiss_surf   !< emissivity of the wall surface
-!
-!-- External radiation. Depending on the given level of detail either a 1D or a 3D array will be
-!-- allocated.
-    TYPE( real_1d_3d ) ::  rad_lw_in_f      !< external incoming longwave radiation, from observation or model
-    TYPE( real_1d_3d ) ::  rad_sw_in_f      !< external incoming shortwave radiation, from observation or model
-    TYPE( real_1d_3d ) ::  rad_sw_in_dif_f  !< external incoming shortwave radiation, diffuse part, from observation or model
-    TYPE( real_1d_3d ) ::  time_rad_f       !< time dimension for external radiation, from observation or model
-
-    INTERFACE radiation_check_data_output
-       MODULE PROCEDURE radiation_check_data_output
-    END INTERFACE radiation_check_data_output
-
-    INTERFACE radiation_check_data_output_ts
-       MODULE PROCEDURE radiation_check_data_output_ts
-    END INTERFACE radiation_check_data_output_ts
-
-    INTERFACE radiation_check_data_output_pr
-       MODULE PROCEDURE radiation_check_data_output_pr
-    END INTERFACE radiation_check_data_output_pr
-
-    INTERFACE radiation_check_parameters
-       MODULE PROCEDURE radiation_check_parameters
-    END INTERFACE radiation_check_parameters
-
-    INTERFACE radiation_clearsky
-       MODULE PROCEDURE radiation_clearsky
-    END INTERFACE radiation_clearsky
-
-    INTERFACE radiation_constant
-       MODULE PROCEDURE radiation_constant
-    END INTERFACE radiation_constant
-
-    INTERFACE radiation_control
-       MODULE PROCEDURE radiation_control
-    END INTERFACE radiation_control
-
-    INTERFACE radiation_3d_data_averaging
-       MODULE PROCEDURE radiation_3d_data_averaging
-    END INTERFACE radiation_3d_data_averaging
-
-    INTERFACE radiation_data_output_2d
-       MODULE PROCEDURE radiation_data_output_2d
-    END INTERFACE radiation_data_output_2d
-
-    INTERFACE radiation_data_output_3d
-       MODULE PROCEDURE radiation_data_output_3d
-    END INTERFACE radiation_data_output_3d
-
-    INTERFACE radiation_data_output_mask
-       MODULE PROCEDURE radiation_data_output_mask
-    END INTERFACE radiation_data_output_mask
-
-    INTERFACE radiation_define_netcdf_grid
-       MODULE PROCEDURE radiation_define_netcdf_grid
-    END INTERFACE radiation_define_netcdf_grid
-
-    INTERFACE radiation_header
-       MODULE PROCEDURE radiation_header
-    END INTERFACE radiation_header
-
-    INTERFACE radiation_init
-       MODULE PROCEDURE radiation_init
-    END INTERFACE radiation_init
-
-    INTERFACE radiation_parin
-       MODULE PROCEDURE radiation_parin
-    END INTERFACE radiation_parin
-
-    INTERFACE radiation_rrtmg
-       MODULE PROCEDURE radiation_rrtmg
-    END INTERFACE radiation_rrtmg
-
-#if defined( __rrtmg )
-    INTERFACE radiation_tendency
-       MODULE PROCEDURE radiation_tendency
-       MODULE PROCEDURE radiation_tendency_ij
-    END INTERFACE radiation_tendency
-#endif
-
-    INTERFACE radiation_rrd_local
-       MODULE PROCEDURE radiation_rrd_local_ftn
-       MODULE PROCEDURE radiation_rrd_local_mpi
-    END INTERFACE radiation_rrd_local
-
-    INTERFACE radiation_wrd_local
-       MODULE PROCEDURE radiation_wrd_local
-    END INTERFACE radiation_wrd_local
-
-    INTERFACE radiation_interaction
-       MODULE PROCEDURE radiation_interaction
-    END INTERFACE radiation_interaction
-
-    INTERFACE radiation_interaction_init
-       MODULE PROCEDURE radiation_interaction_init
-    END INTERFACE radiation_interaction_init
-
-    INTERFACE radiation_presimulate_solar_pos
-       MODULE PROCEDURE radiation_presimulate_solar_pos
-    END INTERFACE radiation_presimulate_solar_pos
-
-    INTERFACE radiation_calc_svf
-       MODULE PROCEDURE radiation_calc_svf
-    END INTERFACE radiation_calc_svf
-
-    INTERFACE radiation_write_svf
-       MODULE PROCEDURE radiation_write_svf
-    END INTERFACE radiation_write_svf
-
-    INTERFACE radiation_read_svf
-       MODULE PROCEDURE radiation_read_svf
-    END INTERFACE radiation_read_svf
-
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public functions / NEEDS SORTING
-    PUBLIC radiation_check_data_output,                                                            &
-           radiation_check_data_output_pr,                                                         &
-           radiation_check_data_output_ts,                                                         &
-           radiation_check_parameters,                                                             &
-           radiation_control,                                                                      &
-           radiation_header,                                                                       &
-           radiation_init,                                                                         &
-           radiation_parin,                                                                        &
-           radiation_3d_data_averaging,                                                            &
-           radiation_data_output_2d,                                                               &
-           radiation_data_output_3d,                                                               &
-           radiation_define_netcdf_grid,                                                           &
-           radiation_wrd_local,                                                                    &
-           radiation_rrd_local,                                                                    &
-           radiation_data_output_mask,                                                             &
-           radiation_calc_svf,                                                                     &
-           radiation_write_svf,                                                                    &
-           radiation_interaction,                                                                  &
-           radiation_interaction_init,                                                             &
-           radiation_read_svf,                                                                     &
-           radiation_presimulate_solar_pos
-
-
-!
-!-- Public variables and constants / NEEDS SORTING
-    PUBLIC albedo,                                                                                 &
-           albedo_type,                                                                            &
-           average_radiation,                                                                      &
-           cos_zenith,                                                                             &
-           calc_zenith,                                                                            &
-           decl_1,                                                                                 &
-           decl_2,                                                                                 &
-           decl_3,                                                                                 &
-           dirname,                                                                                &
-           diridx,                                                                                 &
-           dirint,                                                                                 &
-           dots_rad,                                                                               &
-           dt_radiation,                                                                           &
-           emissivity,                                                                             &
-           force_radiation_call,                                                                   &
-           idir,                                                                                   &
-           id,                                                                                     &
-           iz,                                                                                     &
-           iy,                                                                                     &
-           ix,                                                                                     &
-           iup,                                                                                    &
-           idown,                                                                                  &
-           inorth,                                                                                 &
-           isouth,                                                                                 &
-           ieast,                                                                                  &
-           iwest,                                                                                  &
-           idsvf,                                                                                  &
-           idcsf,                                                                                  &
-           jdir,                                                                                   &
-           kdir,                                                                                   &
-           kdcsf,                                                                                  &
-           lat,                                                                                    &
-           lon,                                                                                    &
-           mrt_geom,                                                                               &
-           mrt_geom_params,                                                                        &
-           mrt_include_sw,                                                                         &
-           mrt_nlevels,                                                                            &
-           mrtbl,                                                                                  &
-           mrtinsw,                                                                                &
-           mrtinlw,                                                                                &
-           nd,                                                                                     &
-           nmrtbl,                                                                                 &
-           nsurf_type,                                                                             &
-           nz_urban_b,                                                                             &
-           nz_urban_t,                                                                             &
-           nz_urban,                                                                               &
-           nsurf,                                                                                  &
-           ndsvf,                                                                                  &
-           ndcsf,                                                                                  &
-           pch,                                                                                    &
-           pct,                                                                                    &
-           rad_net_av,                                                                             &
-           radiation,                                                                              &
-           radiation_scheme,                                                                       &
-           radiation_interactions,                                                                 &
-           radiation_interactions_on,                                                              &
-           rad_sw_in_diff,                                                                         &
-           rad_sw_in_dir,                                                                          &
-           rad_lw_in,                                                                              &
-           rad_lw_in_av,                                                                           &
-           rad_lw_out,                                                                             &
-           rad_lw_out_av,                                                                          &
-           rad_lw_cs_hr,                                                                           &
-           rad_lw_cs_hr_av,                                                                        &
-           rad_lw_hr,                                                                              &
-           rad_lw_hr_av,                                                                           &
-           rad_sw_in,                                                                              &
-           rad_sw_in_av,                                                                           &
-           rad_sw_out,                                                                             &
-           rad_sw_out_av,                                                                          &
-           rad_sw_cs_hr,                                                                           &
-           rad_sw_cs_hr_av,                                                                        &
-           rad_sw_hr,                                                                              &
-           rad_sw_hr_av,                                                                           &
-           solar_constant,                                                                         &
-           skip_time_do_radiation,                                                                 &
-           skyvf,                                                                                  &
-           skyvft,                                                                                 &
-           sun_direction,                                                                          &
-           sun_dir_lat,                                                                            &
-           sun_dir_lon,                                                                            &
-           time_radiation,                                                                         &
-           unscheduled_radiation_calls
-
-
-#if defined ( __rrtmg )
-    PUBLIC radiation_tendency,                                                                     &
-           rrtm_aldif,                                                                             &
-           rrtm_aldir,                                                                             &
-           rrtm_asdif,                                                                             &
-           rrtm_asdir
-#endif
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine controls the calls of the radiation schemes
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_control
-
-
-    IMPLICIT NONE
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'radiation_control', 'start' )
-
-
-    SELECT CASE ( TRIM( radiation_scheme ) )
-
-       CASE ( 'constant' )
-          CALL radiation_constant
-
-       CASE ( 'clear-sky' )
-          CALL radiation_clearsky
-
-       CASE ( 'rrtmg' )
-          CALL radiation_rrtmg
-
-       CASE ( 'external' )
-!
-!--       During spinup apply clear-sky model
-          IF ( time_since_reference_point < 0.0_wp )  THEN
-             CALL radiation_clearsky
-          ELSE
-             CALL radiation_external
-          ENDIF
-
-       CASE DEFAULT
-
-    END SELECT
-
-    IF ( debug_output_timestep )  CALL debug_message( 'radiation_control', 'end' )
-
- END SUBROUTINE radiation_control
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output for radiation model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_check_data_output( variable, unit, i, ilen, k )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  data_output,                                                                        &
-               message_string
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  unit      !<
-    CHARACTER(LEN=*) ::  variable  !<
-
-    CHARACTER(LEN=varnamelength) ::   var  !< TRIM(variable)
-
-    INTEGER(iwp) ::  i, k        !<
-    INTEGER(iwp) ::  ilast_word  !<
-    INTEGER(iwp) ::  ilen        !<
-    INTEGER(iwp) ::  id          !<
-
-    LOGICAL ::  directional  !<
-
-    var = TRIM( variable )
-!
-!-- Identify directional variables
-    ilast_word = SCAN( var, '_', back = .TRUE. )
-    directional = .FALSE.
-    IF ( ilast_word > 0 )  THEN
-       DO  id = 0, nd-1
-          IF ( TRIM( var(ilast_word:) ) == TRIM( dirname(id) ) )  THEN
-             directional = .TRUE.
-             var = var(1:ilast_word-1)
-             EXIT
-          ENDIF
-       ENDDO
-    ENDIF
-
-    IF ( directional )  THEN
-       IF ( var(1:8) == 'rtm_svf_'  .OR.  var(1:8) == 'rtm_dif_' )  THEN
-          IF ( .NOT.  radiation )  THEN
-             message_string = 'output of "' // var // '" requires radiation = .TRUE.'
-             CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
-          ENDIF
-          unit = '1'
-       ELSE
-          SELECT CASE ( TRIM( var ) )
-             CASE ( 'rtm_rad_net', 'rtm_rad_insw', 'rtm_rad_inlw', 'rtm_rad_inswdir',              &
-                    'rtm_rad_inswdif', 'rtm_rad_inswref', 'rtm_rad_inlwdif', 'rtm_rad_inlwref',    &
-                    'rtm_rad_outsw', 'rtm_rad_outlw', 'rtm_rad_ressw', 'rtm_rad_reslw' )
-                IF ( .NOT.  radiation )  THEN
-                   message_string = 'output of "' // var // '" requires radiation = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = 'W/m2'
-
-             CASE ( 'rtm_skyvf', 'rtm_skyvft', 'rtm_surfalb', 'rtm_surfemis' )
-                IF ( .NOT.  radiation )  THEN
-                   message_string = 'output of "' // var // '" requires radiation = .TRUE.'
-                   CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
-                ENDIF
-                unit = '1'
-
-             CASE DEFAULT
-                unit = 'illegal'
-          END SELECT
-       ENDIF
-
-    ELSE
-       SELECT CASE ( var )
-          CASE ( 'rad_lw_cs_hr', 'rad_lw_hr', 'rad_sw_cs_hr', 'rad_sw_hr' )
-             IF ( .NOT.  radiation  .OR.  radiation_scheme /= 'rrtmg' )  THEN
-                message_string = '"output of "' // var // '" requires radiation = .TRUE. and ' //  &
-                                 'radiation_scheme = "rrtmg"'
-                CALL message( 'check_parameters', 'PA0406', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'K/h'
-
-          CASE ( 'rad_lw_in', 'rad_lw_out', 'rad_sw_in', 'rad_sw_out' )
-             IF ( .NOT.  radiation  .OR.  radiation_scheme /= 'rrtmg' )  THEN
-                message_string = '"output of "' // var // '" requires radiation = .TRUE. and ' //  &
-                                 'radiation_scheme = "rrtmg"'
-                CALL message( 'check_parameters', 'PA0406', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'W/m2'
-
-          CASE ( 'rad_net*', 'rad_lw_in*', 'rad_lw_out*', 'rad_sw_in*', 'rad_sw_out*' )
-             IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
-                message_string = 'illegal value for data_output: "' // var //                      &
-                                 '" & only 2d-horizontal cross sections are allowed for this value'
-                CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'W/m2'
-
-          CASE ( 'rrtm_aldif*', 'rrtm_aldir*', 'rrtm_asdif*', 'rrtm_asdir*' )
-             IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
-                message_string = 'illegal value for data_output: "' // var //                      &
-                                 '" & only 2d-horizontal cross sections are allowed for this value'
-                CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
-             ENDIF
-             IF ( .NOT.  radiation  .OR.  radiation_scheme /= "rrtmg" )  THEN
-                message_string = 'output of "' // var // '" requires radiation = .TRUE. and ' //   &
-                                 'radiation_scheme = "rrtmg"'
-                CALL message( 'check_parameters', 'PA0409', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = ''
-
-          CASE ( 'rtm_rad_pc_inlw', 'rtm_rad_pc_insw', 'rtm_rad_pc_inswdir', 'rtm_rad_pc_inswdif', &
-                 'rtm_rad_pc_inswref' )
-             IF ( .NOT.  radiation )  THEN
-                message_string = 'output of "' // var // '" requires radiation = .TRUE.'
-                CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'W'
-
-          CASE ( 'rtm_mrt', 'rtm_mrt_sw', 'rtm_mrt_lw'  )
-             IF ( .NOT.  radiation )  THEN
-                message_string = 'output of "' // var // '" requires radiation = .TRUE.'
-                CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
-             ENDIF
-             IF ( mrt_nlevels == 0 )  THEN
-                message_string = 'output of "' // var // '" requires mrt_nlevels > 0'
-                CALL message( 'check_parameters', 'PA0510', 1, 2, 0, 6, 0 )
-             ENDIF
-             IF ( var == 'rtm_mrt_sw'  .AND.  .NOT. mrt_include_sw )  THEN
-                message_string = 'output of "' // var // '" requires rtm_mrt_sw = .TRUE.'
-                CALL message( 'check_parameters', 'PA0511', 1, 2, 0, 6, 0 )
-             ENDIF
-             IF ( var == 'rtm_mrt' )  THEN
-                unit = 'K'
-             ELSE
-                unit = 'W m-2'
-             ENDIF
-
-          CASE DEFAULT
-             unit = 'illegal'
-
-       END SELECT
-    END IF
-
- END SUBROUTINE radiation_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set module-specific timeseries units and labels
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_check_data_output_ts( dots_max, dots_num )
-
-
-    INTEGER(iwp),INTENT(IN)    ::  dots_max  !<
-
-    INTEGER(iwp),INTENT(INOUT) ::  dots_num  !<
-
-!
-!-- Next line is just to avoid compiler warning about unused variable.
-    IF ( dots_max == 0 )  CONTINUE
-
-!
-!-- Temporary solution to add LSM and radiation time series to the default output
-    IF ( land_surface  .OR.  radiation )  THEN
-       IF ( TRIM( radiation_scheme ) == 'rrtmg' )  THEN
-          dots_num = dots_num + 15
-       ELSE
-          dots_num = dots_num + 11
-       ENDIF
-    ENDIF
-
-
- END SUBROUTINE radiation_check_data_output_ts
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output of profiles for radiation model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zu
-
-    USE control_parameters,                                                                        &
-        ONLY:  data_output_pr,                                                                     &
-               message_string
-
-    USE indices
-
-    USE profil_parameter
-
-    USE statistics
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  dopr_unit  !< local value of dopr_unit
-    CHARACTER(LEN=*) ::  unit       !<
-    CHARACTER(LEN=*) ::  variable   !<
-
-    INTEGER(iwp) ::  var_count  !<
-
-    SELECT CASE ( TRIM( variable ) )
-
-      CASE ( 'rad_net' )
-          IF ( (  .NOT.  radiation )  .OR.  radiation_scheme == 'constant' )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is' // &
-                              'not available for radiation = .FALSE. or ' //                       &
-                              'radiation_scheme = "constant"'
-             CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 99
-             dopr_unit  = 'W/m2'
-             hom(:,2,99,:)  = SPREAD( zw, 2, statistic_regions+1 )
-             unit = dopr_unit
-          ENDIF
-
-       CASE ( 'rad_lw_in' )
-          IF ( ( .NOT.  radiation)  .OR.  radiation_scheme == 'constant' )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is' // &
-                              'not available for radiation = .FALSE. or ' //                       &
-                              'radiation_scheme = "constant"'
-             CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 100
-             dopr_unit  = 'W/m2'
-             hom(:,2,100,:)  = SPREAD( zw, 2, statistic_regions+1 )
-             unit = dopr_unit
-          ENDIF
-
-       CASE ( 'rad_lw_out' )
-          IF ( ( .NOT. radiation )  .OR.  radiation_scheme == 'constant' )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is' // &
-                              'not available for radiation = .FALSE. or ' //                       &
-                              'radiation_scheme = "constant"'
-             CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 101
-             dopr_unit  = 'W/m2'
-             hom(:,2,101,:)  = SPREAD( zw, 2, statistic_regions+1 )
-             unit = dopr_unit
-          ENDIF
-
-       CASE ( 'rad_sw_in' )
-          IF ( (  .NOT. radiation )  .OR.  radiation_scheme == 'constant' )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is' // &
-                              'not available for radiation = .FALSE. or ' //                       &
-                              'radiation_scheme = "constant"'
-             CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 102
-             dopr_unit  = 'W/m2'
-             hom(:,2,102,:)  = SPREAD( zw, 2, statistic_regions+1 )
-             unit = dopr_unit
-          ENDIF
-
-       CASE ( 'rad_sw_out')
-          IF ( ( .NOT.  radiation )  .OR.  radiation_scheme == 'constant' )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is' // &
-                              'not available for radiation = .FALSE. or ' //                       &
-                              'radiation_scheme = "constant"'
-             CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 103
-             dopr_unit  = 'W/m2'
-             hom(:,2,103,:)  = SPREAD( zw, 2, statistic_regions+1 )
-             unit = dopr_unit
-          ENDIF
-
-       CASE ( 'rad_lw_cs_hr' )
-          IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is' // &
-                              'not available for radiation = .FALSE. or ' //                       &
-                              'radiation_scheme /= "rrtmg"'
-             CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 104
-             dopr_unit  = 'K/h'
-             hom(:,2,104,:)  = SPREAD( zu, 2, statistic_regions+1 )
-             unit = dopr_unit
-          ENDIF
-
-       CASE ( 'rad_lw_hr' )
-          IF ( ( .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is' // &
-                              'not available for radiation = .FALSE. or ' //                       &
-                              'radiation_scheme /= "rrtmg"'
-             CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 105
-             dopr_unit  = 'K/h'
-             hom(:,2,105,:)  = SPREAD( zu, 2, statistic_regions+1 )
-             unit = dopr_unit
-          ENDIF
-
-       CASE ( 'rad_sw_cs_hr' )
-          IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is' // &
-                              'not available for radiation = .FALSE. or ' //                       &
-                              'radiation_scheme /= "rrtmg"'
-             CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 106
-             dopr_unit  = 'K/h'
-             hom(:,2,106,:)  = SPREAD( zu, 2, statistic_regions+1 )
-             unit = dopr_unit
-          ENDIF
-
-       CASE ( 'rad_sw_hr' )
-          IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )  THEN
-             message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // ' is' // &
-                              'not available for radiation = .FALSE. or ' //                       &
-                              'radiation_scheme /= "rrtmg"'
-             CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
-          ELSE
-             dopr_index(var_count) = 107
-             dopr_unit  = 'K/h'
-             hom(:,2,107,:)  = SPREAD( zu, 2, statistic_regions+1 )
-             unit = dopr_unit
-          ENDIF
-
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE radiation_check_data_output_pr
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for radiation model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_check_parameters
-
-    USE control_parameters,                                                                        &
-        ONLY:  land_surface,                                                                       &
-               message_string,                                                                     &
-               urban_surface
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  input_pids_static
-
-    IMPLICIT NONE
-
-!
-!-- In case no urban-surface or land-surface model is applied, usage of a radiation model makes
-!-- no sense.
-    IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-       message_string = 'Usage of radiation module is only allowed if ' //                         &
-                        'land-surface and/or urban-surface model is applied.'
-       CALL message( 'check_parameters', 'PA0486', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( radiation_scheme /= 'constant'   .AND.  radiation_scheme /= 'clear-sky'  .AND.            &
-         radiation_scheme /= 'rrtmg'      .AND.  radiation_scheme /= 'external' )  THEN
-       message_string = 'unknown radiation_scheme = '//  TRIM( radiation_scheme )
-       CALL message( 'check_parameters', 'PA0405', 1, 2, 0, 6, 0 )
-    ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
-#if ! defined ( __rrtmg )
-       message_string = 'radiation_scheme = "rrtmg" requires compilation of PALM with ' //         &
-                        'pre-processor directive -D__rrtmg'
-       CALL message( 'check_parameters', 'PA0407', 1, 2, 0, 6, 0 )
-#endif
-#if defined ( __rrtmg ) && ! defined( __netcdf )
-       message_string = 'radiation_scheme = "rrtmg" requires the use of NetCDF (preprocessor ' //  &
-                        'directive -D__netcdf'
-       CALL message( 'check_parameters', 'PA0412', 1, 2, 0, 6, 0 )
-#endif
-
-    ENDIF
-!
-!-- Checks performed only if data is given via namelist only.
-    IF ( .NOT. input_pids_static )  THEN
-       IF ( albedo_type == 0  .AND.  albedo == 9999999.9_wp  .AND.          &
-            radiation_scheme == 'clear-sky')  THEN
-          message_string = 'radiation_scheme = "clear-sky" in combination with albedo_type = 0 ' //&
-                           'requires setting of albedo /= 9999999.9'
-          CALL message( 'check_parameters', 'PA0410', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( albedo_type == 0  .AND.  radiation_scheme == 'rrtmg'  .AND.                            &
-          ( albedo_lw_dif == 9999999.9_wp .OR. albedo_lw_dir == 9999999.9_wp  .OR.                 &
-            albedo_sw_dif == 9999999.9_wp .OR. albedo_sw_dir == 9999999.9_wp ) )  THEN
-          message_string = 'radiation_scheme = "rrtmg" in combination with albedo_type = 0 ' //    &
-                           'requires setting of albedo_lw_dif /= 9999999.9' //                     &
-                           'albedo_lw_dir /= 9999999.9 albedo_sw_dif /= 9999999.9 and' //          &
-                           'albedo_sw_dir /= 9999999.9'
-          CALL message( 'check_parameters', 'PA0411', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-!
-!-- Parallel rad_angular_discretization without raytrace_mpi_rma is not implemented
-!-- Serial mode does not allow mpi_rma
-#if defined( __parallel )
-    IF ( rad_angular_discretization  .AND.  .NOT. raytrace_mpi_rma )  THEN
-       message_string = 'rad_angular_discretization can only be used together with ' //            &
-                        'raytrace_mpi_rma or when no parallelization is applied.'
-       CALL message( 'readiation_check_parameters', 'PA0486', 1, 2, 0, 6, 0 )
-    ENDIF
-#else
-    IF ( raytrace_mpi_rma )  THEN
-       message_string = 'raytrace_mpi_rma = .T. not allowed in serial mode'
-       CALL message( 'readiation_check_parameters', 'PA0710', 1, 2, 0, 6, 0 )
-    ENDIF
-#endif
-
-    IF ( cloud_droplets  .AND.   radiation_scheme == 'rrtmg'  .AND.  average_radiation )  THEN
-       message_string = 'average_radiation = .T. with radiation_scheme = "rrtmg" in ' //           &
-                        'combination cloud_droplets = .T. is not implementd'
-       CALL message( 'check_parameters', 'PA0560', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Initialize svf normalization reporting histogram
-    svfnorm_report_num = 1
-    DO WHILE ( svfnorm_report_thresh(svfnorm_report_num) < 1e20_wp .AND. svfnorm_report_num <= 30 )
-       svfnorm_report_num = svfnorm_report_num + 1
-    ENDDO
-    svfnorm_report_num = svfnorm_report_num - 1
-!
-!-- Check for dt_radiation
-    IF ( dt_radiation <= 0.0 )  THEN
-       message_string = 'dt_radiation must be > 0.0'
-       CALL message( 'check_parameters', 'PA0591', 1, 2, 0, 6, 0 )
-    ENDIF
-
- END SUBROUTINE radiation_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the radiation model and Radiative Transfer Model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_init
-
-#if defined( __rrtmg )
-    USE control_parameters,                                                                        &
-        ONLY:  run_identifier
-#endif
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i          !< running index x-direction
-    INTEGER(iwp) ::  is         !< running index for input surface elements
-    INTEGER(iwp) ::  ioff       !< offset in x between surface element reference grid point in atmosphere and actual surface
-    INTEGER(iwp) ::  j          !< running index y-direction
-    INTEGER(iwp) ::  joff       !< offset in y between surface element reference grid point in atmosphere and actual surface
-    INTEGER(iwp) ::  k          !< running index z-direction
-    INTEGER(iwp) ::  l          !< running index for orientation of vertical surfaces
-    INTEGER(iwp) ::  m          !< running index for surface elements
-    INTEGER(iwp) ::  ntime = 0  !< number of available external radiation timesteps
-#if defined( __rrtmg )
-    INTEGER(iwp) ::  ind_type  !< running index for subgrid-surface tiles
-#endif
-    LOGICAL ::  radiation_input_root_domain  !< flag indicating the existence of a dynamic input file for the root domain
-
-
-    IF ( debug_output )  CALL debug_message( 'radiation_init', 'start' )
-!
-!-- Activate radiation_interactions according to the existence of vertical surfaces and/or trees
-!   or if biometeorology output is required for flat surfaces.
-!-- The namelist parameter radiation_interactions_on can override this behavior (this check cannot
-!-- be performed in check_parameters, because vertical_surfaces_exist is first set in
-!-- init_surface_arrays).
-    IF ( radiation_interactions_on )  THEN
-       IF ( vertical_surfaces_exist  .OR.  plant_canopy  .OR.  biometeorology )  THEN
-          radiation_interactions = .TRUE.
-          average_radiation      = .TRUE.
-       ELSE
-          radiation_interactions_on = .FALSE.   !< Reset namelist parameter: no interactions
-                                                !< Calculations necessary in case of flat surface
-       ENDIF
-    ELSEIF ( vertical_surfaces_exist  .OR.  plant_canopy  .OR.  biometeorology )  THEN
-       message_string = 'radiation_interactions_on is set to .FALSE. although vertical ' //        &
-                        'surfaces and/or trees or biometeorology exist is ON. The model will ' //  &
-                        'run without RTM (no shadows, no radiation reflections)'
-       CALL message( 'init_3d_model', 'PA0348', 0, 1, 0, 6, 0 )
-    ENDIF
-!
-!-- Precalculate some time constants
-    d_hours_day    = 1.0_wp / REAL( hours_per_day, KIND = wp )
-    d_seconds_hour = 1.0_wp / seconds_per_hour
-
-!
-!-- If required, initialize radiation interactions between surfaces via sky-view factors. This must
-!-- be done before radiation is initialized.
-    IF ( radiation_interactions )  CALL radiation_interaction_init
-!
-!-- Allocate array for storing the surface net radiation
-    DO  l = 0, 1
-       IF ( .NOT. ALLOCATED( surf_lsm_h(l)%rad_net )  .AND.  surf_lsm_h(l)%ns > 0  )  THEN
-          ALLOCATE( surf_lsm_h(l)%rad_net(1:surf_lsm_h(l)%ns) )
-          surf_lsm_h(l)%rad_net = 0.0_wp
-       ENDIF
-       IF ( .NOT. ALLOCATED( surf_usm_h(l)%rad_net )  .AND.  surf_usm_h(l)%ns > 0  )  THEN
-          ALLOCATE( surf_usm_h(l)%rad_net(1:surf_usm_h(l)%ns) )
-          surf_usm_h(l)%rad_net = 0.0_wp
-       ENDIF
-    ENDDO
-    DO  l = 0, 3
-       IF ( .NOT. ALLOCATED( surf_lsm_v(l)%rad_net )  .AND.  surf_lsm_v(l)%ns > 0  )  THEN
-          ALLOCATE( surf_lsm_v(l)%rad_net(1:surf_lsm_v(l)%ns) )
-          surf_lsm_v(l)%rad_net = 0.0_wp
-       ENDIF
-       IF ( .NOT. ALLOCATED( surf_usm_v(l)%rad_net )  .AND.  surf_usm_v(l)%ns > 0  )  THEN
-          ALLOCATE( surf_usm_v(l)%rad_net(1:surf_usm_v(l)%ns) )
-          surf_usm_v(l)%rad_net = 0.0_wp
-       ENDIF
-    ENDDO
-
-
-!
-!-- Allocate array for storing the surface longwave (out) radiation change
-    DO  l = 0, 1
-       IF ( .NOT. ALLOCATED( surf_lsm_h(l)%rad_lw_out_change_0 )  .AND.                            &
-          surf_lsm_h(l)%ns > 0 )  THEN
-          ALLOCATE( surf_lsm_h(l)%rad_lw_out_change_0(1:surf_lsm_h(l)%ns) )
-          surf_lsm_h(l)%rad_lw_out_change_0 = 0.0_wp
-       ENDIF
-       IF ( .NOT. ALLOCATED( surf_usm_h(l)%rad_lw_out_change_0 )  .AND.                            &
-                  surf_usm_h(l)%ns > 0 )  THEN
-          ALLOCATE( surf_usm_h(l)%rad_lw_out_change_0(1:surf_usm_h(l)%ns) )
-          surf_usm_h(l)%rad_lw_out_change_0 = 0.0_wp
-       ENDIF
-    ENDDO
-    DO  l = 0, 3
-       IF ( .NOT. ALLOCATED( surf_lsm_v(l)%rad_lw_out_change_0 )  .AND.                            &
-                  surf_lsm_v(l)%ns > 0 )  THEN
-          ALLOCATE( surf_lsm_v(l)%rad_lw_out_change_0(1:surf_lsm_v(l)%ns) )
-          surf_lsm_v(l)%rad_lw_out_change_0 = 0.0_wp
-       ENDIF
-       IF ( .NOT. ALLOCATED( surf_usm_v(l)%rad_lw_out_change_0 )  .AND.                            &
-                  surf_usm_v(l)%ns > 0 )  THEN
-          ALLOCATE( surf_usm_v(l)%rad_lw_out_change_0(1:surf_usm_v(l)%ns) )
-          surf_usm_v(l)%rad_lw_out_change_0 = 0.0_wp
-       ENDIF
-    ENDDO
-
-!
-!-- Allocate surface arrays for incoming/outgoing short/longwave radiation
-    DO  l = 0, 1
-       IF ( .NOT. ALLOCATED( surf_lsm_h(l)%rad_sw_in )  .AND.  surf_lsm_h(l)%ns > 0 )  THEN
-          ALLOCATE( surf_lsm_h(l)%rad_sw_in(1:surf_lsm_h(l)%ns)  )
-          ALLOCATE( surf_lsm_h(l)%rad_sw_out(1:surf_lsm_h(l)%ns) )
-          ALLOCATE( surf_lsm_h(l)%rad_sw_dir(1:surf_lsm_h(l)%ns) )
-          ALLOCATE( surf_lsm_h(l)%rad_sw_dif(1:surf_lsm_h(l)%ns) )
-          ALLOCATE( surf_lsm_h(l)%rad_sw_ref(1:surf_lsm_h(l)%ns) )
-          ALLOCATE( surf_lsm_h(l)%rad_sw_res(1:surf_lsm_h(l)%ns) )
-          ALLOCATE( surf_lsm_h(l)%rad_lw_in(1:surf_lsm_h(l)%ns)  )
-          ALLOCATE( surf_lsm_h(l)%rad_lw_out(1:surf_lsm_h(l)%ns) )
-          ALLOCATE( surf_lsm_h(l)%rad_lw_dif(1:surf_lsm_h(l)%ns) )
-          ALLOCATE( surf_lsm_h(l)%rad_lw_ref(1:surf_lsm_h(l)%ns) )
-          ALLOCATE( surf_lsm_h(l)%rad_lw_res(1:surf_lsm_h(l)%ns) )
-          surf_lsm_h(l)%rad_sw_in  = 0.0_wp
-          surf_lsm_h(l)%rad_sw_out = 0.0_wp
-          surf_lsm_h(l)%rad_sw_dir = 0.0_wp
-          surf_lsm_h(l)%rad_sw_dif = 0.0_wp
-          surf_lsm_h(l)%rad_sw_ref = 0.0_wp
-          surf_lsm_h(l)%rad_sw_res = 0.0_wp
-          surf_lsm_h(l)%rad_lw_in  = 0.0_wp
-          surf_lsm_h(l)%rad_lw_out = 0.0_wp
-          surf_lsm_h(l)%rad_lw_dif = 0.0_wp
-          surf_lsm_h(l)%rad_lw_ref = 0.0_wp
-          surf_lsm_h(l)%rad_lw_res = 0.0_wp
-       ENDIF
-       IF ( .NOT. ALLOCATED( surf_usm_h(l)%rad_sw_in )  .AND.  surf_usm_h(l)%ns > 0 )  THEN
-          ALLOCATE( surf_usm_h(l)%rad_sw_in(1:surf_usm_h(l)%ns)  )
-          ALLOCATE( surf_usm_h(l)%rad_sw_out(1:surf_usm_h(l)%ns) )
-          ALLOCATE( surf_usm_h(l)%rad_sw_dir(1:surf_usm_h(l)%ns) )
-          ALLOCATE( surf_usm_h(l)%rad_sw_dif(1:surf_usm_h(l)%ns) )
-          ALLOCATE( surf_usm_h(l)%rad_sw_ref(1:surf_usm_h(l)%ns) )
-          ALLOCATE( surf_usm_h(l)%rad_sw_res(1:surf_usm_h(l)%ns) )
-          ALLOCATE( surf_usm_h(l)%rad_lw_in(1:surf_usm_h(l)%ns)  )
-          ALLOCATE( surf_usm_h(l)%rad_lw_out(1:surf_usm_h(l)%ns) )
-          ALLOCATE( surf_usm_h(l)%rad_lw_dif(1:surf_usm_h(l)%ns) )
-          ALLOCATE( surf_usm_h(l)%rad_lw_ref(1:surf_usm_h(l)%ns) )
-          ALLOCATE( surf_usm_h(l)%rad_lw_res(1:surf_usm_h(l)%ns) )
-          surf_usm_h(l)%rad_sw_in  = 0.0_wp
-          surf_usm_h(l)%rad_sw_out = 0.0_wp
-          surf_usm_h(l)%rad_sw_dir = 0.0_wp
-          surf_usm_h(l)%rad_sw_dif = 0.0_wp
-          surf_usm_h(l)%rad_sw_ref = 0.0_wp
-          surf_usm_h(l)%rad_sw_res = 0.0_wp
-          surf_usm_h(l)%rad_lw_in  = 0.0_wp
-          surf_usm_h(l)%rad_lw_out = 0.0_wp
-          surf_usm_h(l)%rad_lw_dif = 0.0_wp
-          surf_usm_h(l)%rad_lw_ref = 0.0_wp
-          surf_usm_h(l)%rad_lw_res = 0.0_wp
-       ENDIF
-    ENDDO
-    DO  l = 0, 3
-       IF ( .NOT. ALLOCATED( surf_lsm_v(l)%rad_sw_in )  .AND.  surf_lsm_v(l)%ns > 0 )  THEN
-          ALLOCATE( surf_lsm_v(l)%rad_sw_in(1:surf_lsm_v(l)%ns)  )
-          ALLOCATE( surf_lsm_v(l)%rad_sw_out(1:surf_lsm_v(l)%ns) )
-          ALLOCATE( surf_lsm_v(l)%rad_sw_dir(1:surf_lsm_v(l)%ns) )
-          ALLOCATE( surf_lsm_v(l)%rad_sw_dif(1:surf_lsm_v(l)%ns) )
-          ALLOCATE( surf_lsm_v(l)%rad_sw_ref(1:surf_lsm_v(l)%ns) )
-          ALLOCATE( surf_lsm_v(l)%rad_sw_res(1:surf_lsm_v(l)%ns) )
-
-          ALLOCATE( surf_lsm_v(l)%rad_lw_in(1:surf_lsm_v(l)%ns)  )
-          ALLOCATE( surf_lsm_v(l)%rad_lw_out(1:surf_lsm_v(l)%ns) )
-          ALLOCATE( surf_lsm_v(l)%rad_lw_dif(1:surf_lsm_v(l)%ns) )
-          ALLOCATE( surf_lsm_v(l)%rad_lw_ref(1:surf_lsm_v(l)%ns) )
-          ALLOCATE( surf_lsm_v(l)%rad_lw_res(1:surf_lsm_v(l)%ns) )
-
-          surf_lsm_v(l)%rad_sw_in  = 0.0_wp
-          surf_lsm_v(l)%rad_sw_out = 0.0_wp
-          surf_lsm_v(l)%rad_sw_dir = 0.0_wp
-          surf_lsm_v(l)%rad_sw_dif = 0.0_wp
-          surf_lsm_v(l)%rad_sw_ref = 0.0_wp
-          surf_lsm_v(l)%rad_sw_res = 0.0_wp
-
-          surf_lsm_v(l)%rad_lw_in  = 0.0_wp
-          surf_lsm_v(l)%rad_lw_out = 0.0_wp
-          surf_lsm_v(l)%rad_lw_dif = 0.0_wp
-          surf_lsm_v(l)%rad_lw_ref = 0.0_wp
-          surf_lsm_v(l)%rad_lw_res = 0.0_wp
-       ENDIF
-       IF ( .NOT. ALLOCATED( surf_usm_v(l)%rad_sw_in )  .AND.  surf_usm_v(l)%ns > 0 )  THEN
-          ALLOCATE( surf_usm_v(l)%rad_sw_in(1:surf_usm_v(l)%ns)  )
-          ALLOCATE( surf_usm_v(l)%rad_sw_out(1:surf_usm_v(l)%ns) )
-          ALLOCATE( surf_usm_v(l)%rad_sw_dir(1:surf_usm_v(l)%ns) )
-          ALLOCATE( surf_usm_v(l)%rad_sw_dif(1:surf_usm_v(l)%ns) )
-          ALLOCATE( surf_usm_v(l)%rad_sw_ref(1:surf_usm_v(l)%ns) )
-          ALLOCATE( surf_usm_v(l)%rad_sw_res(1:surf_usm_v(l)%ns) )
-          ALLOCATE( surf_usm_v(l)%rad_lw_in(1:surf_usm_v(l)%ns)  )
-          ALLOCATE( surf_usm_v(l)%rad_lw_out(1:surf_usm_v(l)%ns) )
-          ALLOCATE( surf_usm_v(l)%rad_lw_dif(1:surf_usm_v(l)%ns) )
-          ALLOCATE( surf_usm_v(l)%rad_lw_ref(1:surf_usm_v(l)%ns) )
-          ALLOCATE( surf_usm_v(l)%rad_lw_res(1:surf_usm_v(l)%ns) )
-          surf_usm_v(l)%rad_sw_in  = 0.0_wp
-          surf_usm_v(l)%rad_sw_out = 0.0_wp
-          surf_usm_v(l)%rad_sw_dir = 0.0_wp
-          surf_usm_v(l)%rad_sw_dif = 0.0_wp
-          surf_usm_v(l)%rad_sw_ref = 0.0_wp
-          surf_usm_v(l)%rad_sw_res = 0.0_wp
-          surf_usm_v(l)%rad_lw_in  = 0.0_wp
-          surf_usm_v(l)%rad_lw_out = 0.0_wp
-          surf_usm_v(l)%rad_lw_dif = 0.0_wp
-          surf_usm_v(l)%rad_lw_ref = 0.0_wp
-          surf_usm_v(l)%rad_lw_res = 0.0_wp
-       ENDIF
-    ENDDO
-!
-!-- Fix net radiation in case of radiation_scheme = 'constant'
-    IF ( radiation_scheme == 'constant' )  THEN
-       DO  l = 0, 1
-          IF ( ALLOCATED( surf_lsm_h(l)%rad_net ) )  surf_lsm_h(l)%rad_net = net_radiation
-          IF ( ALLOCATED( surf_usm_h(l)%rad_net ) )  surf_usm_h(l)%rad_net = net_radiation
-       ENDDO
-!
-!--    @Todo: weight with inclination angle
-       DO  l = 0, 3
-          IF ( ALLOCATED( surf_lsm_v(l)%rad_net ) )  surf_lsm_v(l)%rad_net = net_radiation
-          IF ( ALLOCATED( surf_usm_v(l)%rad_net ) )  surf_usm_v(l)%rad_net = net_radiation
-       ENDDO
-!       radiation = .FALSE.
-!
-!-- Calculate orbital constants
-    ELSE
-       decl_1 = SIN( 23.45_wp * pi / 180.0_wp )
-       decl_2 = 2.0_wp * pi / 365.0_wp
-       decl_3 = decl_2 * 81.0_wp
-       lat    = latitude * pi / 180.0_wp
-       lon    = longitude * pi / 180.0_wp
-    ENDIF
-
-    IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'   .OR.              &
-         radiation_scheme == 'external' )  THEN
-!
-!--    Allocate arrays for incoming/outgoing short/longwave radiation
-       IF ( .NOT. ALLOCATED( rad_sw_in ) )  THEN
-          ALLOCATE( rad_sw_in(0:0,nysg:nyng,nxlg:nxrg) )
-          rad_sw_in = 0.0_wp
-       ENDIF
-       IF ( .NOT. ALLOCATED( rad_sw_out ) )  THEN
-          ALLOCATE( rad_sw_out(0:0,nysg:nyng,nxlg:nxrg) )
-          rad_sw_out = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_lw_in ) )  THEN
-          ALLOCATE( rad_lw_in(0:0,nysg:nyng,nxlg:nxrg) )
-          rad_lw_in = 0.0_wp
-       ENDIF
-       IF ( .NOT. ALLOCATED( rad_lw_out ) )  THEN
-          ALLOCATE( rad_lw_out(0:0,nysg:nyng,nxlg:nxrg) )
-          rad_lw_out = 0.0_wp
-       ENDIF
-
-!
-!--    Allocate average arrays for incoming/outgoing short/longwave radiation
-       IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
-          ALLOCATE( rad_sw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-       IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
-          ALLOCATE( rad_sw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
-          ALLOCATE( rad_lw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-       IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
-          ALLOCATE( rad_lw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-!
-!--    Allocate arrays for broadband albedo, and level 1 initialization via namelist paramter,
-!--    unless not already allocated.
-       DO  l = 0, 1
-          IF ( .NOT. ALLOCATED(surf_lsm_h(l)%albedo) )  THEN
-             ALLOCATE( surf_lsm_h(l)%albedo(1:surf_lsm_h(l)%ns,0:2) )
-             surf_lsm_h(l)%albedo    = albedo
-          ENDIF
-          IF ( .NOT. ALLOCATED(surf_usm_h(l)%albedo) )  THEN
-             ALLOCATE( surf_usm_h(l)%albedo(1:surf_usm_h(l)%ns,0:2) )
-             surf_usm_h(l)%albedo    = albedo
-          ENDIF
-       ENDDO
-       DO  l = 0, 3
-          IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) )  THEN
-             ALLOCATE( surf_lsm_v(l)%albedo(1:surf_lsm_v(l)%ns,0:2) )
-             surf_lsm_v(l)%albedo = albedo
-          ENDIF
-          IF ( .NOT. ALLOCATED( surf_usm_v(l)%albedo ) )  THEN
-             ALLOCATE( surf_usm_v(l)%albedo(1:surf_usm_v(l)%ns,0:2) )
-             surf_usm_v(l)%albedo = albedo
-          ENDIF
-       ENDDO
-!
-!--    Level 2 initialization of broadband albedo via given albedo_type.
-!--    Only if albedo_type is non-zero. In case of urban surface and input data is read from ASCII
-!--    file, albedo_type will be zero, so that albedo won't be overwritten.
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             IF ( surf_lsm_h(l)%albedo_type(m,ind_veg_wall) /= 0 )                                 &
-                surf_lsm_h(l)%albedo(m,ind_veg_wall) =                                             &
-                albedo_pars(0,surf_lsm_h(l)%albedo_type(m,ind_veg_wall))
-             IF ( surf_lsm_h(l)%albedo_type(m,ind_pav_green) /= 0 )                                &
-                surf_lsm_h(l)%albedo(m,ind_pav_green) =                                            &
-                albedo_pars(0,surf_lsm_h(l)%albedo_type(m,ind_pav_green))
-             IF ( surf_lsm_h(l)%albedo_type(m,ind_wat_win) /= 0 )                                  &
-                surf_lsm_h(l)%albedo(m,ind_wat_win) =                                              &
-                albedo_pars(0,surf_lsm_h(l)%albedo_type(m,ind_wat_win))
-          ENDDO
-          DO  m = 1, surf_usm_h(l)%ns
-             IF ( surf_usm_h(l)%albedo_type(m,ind_veg_wall) /= 0 )                                 &
-                surf_usm_h(l)%albedo(m,ind_veg_wall) =                                             &
-                albedo_pars(0,surf_usm_h(l)%albedo_type(m,ind_veg_wall))
-             IF ( surf_usm_h(l)%albedo_type(m,ind_pav_green) /= 0 )                                &
-                surf_usm_h(l)%albedo(m,ind_pav_green) =                                            &
-                albedo_pars(0,surf_usm_h(l)%albedo_type(m,ind_pav_green))
-             IF ( surf_usm_h(l)%albedo_type(m,ind_wat_win) /= 0 )                                  &
-                surf_usm_h(l)%albedo(m,ind_wat_win) =                                              &
-                albedo_pars(0,surf_usm_h(l)%albedo_type(m,ind_wat_win))
-          ENDDO
-       ENDDO
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             IF ( surf_lsm_v(l)%albedo_type(m,ind_veg_wall) /= 0 )                                 &
-                surf_lsm_v(l)%albedo(m,ind_veg_wall) =                                             &
-                albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_veg_wall))
-             IF ( surf_lsm_v(l)%albedo_type(m,ind_pav_green) /= 0 )                                &
-                surf_lsm_v(l)%albedo(m,ind_pav_green) =                                            &
-                albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_pav_green))
-             IF ( surf_lsm_v(l)%albedo_type(m,ind_wat_win) /= 0 )                                  &
-                surf_lsm_v(l)%albedo(m,ind_wat_win) =                                              &
-                albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_wat_win))
-          ENDDO
-          DO  m = 1, surf_usm_v(l)%ns
-             IF ( surf_usm_v(l)%albedo_type(m,ind_veg_wall) /= 0 )                                 &
-                surf_usm_v(l)%albedo(m,ind_veg_wall) =                                             &
-                albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_veg_wall))
-             IF ( surf_usm_v(l)%albedo_type(m,ind_pav_green) /= 0 )                                &
-                surf_usm_v(l)%albedo(m,ind_pav_green) =                                            &
-                albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_pav_green))
-             IF ( surf_usm_v(l)%albedo_type(m,ind_wat_win) /= 0 )                                  &
-                surf_usm_v(l)%albedo(m,ind_wat_win) =                                              &
-                albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_wat_win))
-          ENDDO
-       ENDDO
-
-!
-!--    Level 3 initialization at grid points where albedo type is zero.
-!--    In this case, albedo is taken from file. In case of constant radiation or clear sky, only
-!--    broadband albedo is given.
-       IF ( albedo_pars_f%from_file )  THEN
-!
-!--       Horizontal surfaces
-          DO  l = 0, 1
-             DO  m = 1, surf_lsm_h(l)%ns
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-                IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
-                   surf_lsm_h(l)%albedo(m,ind_veg_wall)  = albedo_pars_f%pars_xy(0,j,i)
-                   surf_lsm_h(l)%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i)
-                   surf_lsm_h(l)%albedo(m,ind_wat_win)   = albedo_pars_f%pars_xy(0,j,i)
-                ENDIF
-             ENDDO
-             DO  m = 1, surf_usm_h(l)%ns
-                i = surf_usm_h(l)%i(m)
-                j = surf_usm_h(l)%j(m)
-                IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
-                   surf_usm_h(l)%albedo(m,ind_veg_wall)  = albedo_pars_f%pars_xy(0,j,i)
-                   surf_usm_h(l)%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i)
-                   surf_usm_h(l)%albedo(m,ind_wat_win)   = albedo_pars_f%pars_xy(0,j,i)
-                ENDIF
-             ENDDO
-          ENDDO
-!
-!--       Vertical surfaces
-          DO  l = 0, 3
-             ioff = surf_lsm_v(l)%ioff
-             joff = surf_lsm_v(l)%joff
-             DO  m = 1, surf_lsm_v(l)%ns
-                i = surf_lsm_v(l)%i(m) + ioff
-                j = surf_lsm_v(l)%j(m) + joff
-                IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
-                   surf_lsm_v(l)%albedo(m,ind_veg_wall)  = albedo_pars_f%pars_xy(0,j,i)
-                   surf_lsm_v(l)%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i)
-                   surf_lsm_v(l)%albedo(m,ind_wat_win)   = albedo_pars_f%pars_xy(0,j,i)
-                ENDIF
-             ENDDO
-             ioff = surf_usm_v(l)%ioff
-             joff = surf_usm_v(l)%joff
-             DO  m = 1, surf_usm_v(l)%ns
-                i = surf_usm_v(l)%i(m) + ioff
-                j = surf_usm_v(l)%j(m) + joff
-                IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
-                   surf_usm_v(l)%albedo(m,ind_veg_wall)  = albedo_pars_f%pars_xy(0,j,i)
-                   surf_usm_v(l)%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i)
-                   surf_usm_v(l)%albedo(m,ind_wat_win)   = albedo_pars_f%pars_xy(0,j,i)
-                ENDIF
-             ENDDO
-          ENDDO
-
-       ENDIF
-!
-!--    Read explicit albedo values from building surface pars. If present, they override all less
-!--    specific albedo values and force an albedo_type to zero in order to take effect.
-       IF ( building_surface_pars_f%from_file )  THEN
-          DO  l = 0, 1
-             DO  m = 1, surf_usm_h(l)%ns
-                i = surf_usm_h(l)%i(m)
-                j = surf_usm_h(l)%j(m)
-                k = surf_usm_h(l)%k(m)
-!
-!--             Iterate over surfaces in column, check height and orientation
-                DO  is = building_surface_pars_f%index_ji(1,j,i),                                  &
-                         building_surface_pars_f%index_ji(2,j,i)
-                   IF ( building_surface_pars_f%coords(4,is) == -surf_usm_h(l)%koff .AND.          &
-                        building_surface_pars_f%coords(1,is) == k )  THEN
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /=                    &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%albedo(m,ind_veg_wall) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_b_wall,is)
-                         surf_usm_h(l)%albedo_type(m,ind_veg_wall) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /=                     &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%albedo(m,ind_wat_win) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_b_win,is)
-                         surf_usm_h(l)%albedo_type(m,ind_wat_win) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /=                   &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%albedo(m,ind_pav_green) =                                   &
-                         building_surface_pars_f%pars(ind_s_alb_b_green,is)
-                         surf_usm_h(l)%albedo_type(m,ind_pav_green) = 0
-                      ENDIF
-
-                      EXIT  ! Surface was found and processed
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-
-          DO  l = 0, 3
-             DO  m = 1, surf_usm_v(l)%ns
-                i = surf_usm_v(l)%i(m)
-                j = surf_usm_v(l)%j(m)
-                k = surf_usm_v(l)%k(m)
-!
-!--             Iterate over surfaces in column, check height and orientation
-                DO  is = building_surface_pars_f%index_ji(1,j,i),                                  &
-                         building_surface_pars_f%index_ji(2,j,i)
-                   IF ( building_surface_pars_f%coords(5,is) == -surf_usm_v(l)%joff .AND.          &
-                        building_surface_pars_f%coords(6,is) == -surf_usm_v(l)%ioff .AND.          &
-                        building_surface_pars_f%coords(1,is) == k )  THEN
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /=                    &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%albedo(m,ind_veg_wall) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_b_wall,is)
-                         surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /=                     &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%albedo(m,ind_wat_win) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_b_win,is)
-                         surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /=                   &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%albedo(m,ind_pav_green) =                                   &
-                         building_surface_pars_f%pars(ind_s_alb_b_green,is)
-                         surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0
-                      ENDIF
-
-                      EXIT  ! Surface was found and processed
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-!
-!-- Initialization actions for RRTMG
-    ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
-#if defined ( __rrtmg )
-!
-!--    Allocate albedos for short/longwave radiation, horizontal surfaces for wall/green/window
-!--    (USM) or vegetation/pavement/water surfaces (LSM).
-       DO  l = 0, 1
-          ALLOCATE( surf_lsm_h(l)%aldif(1:surf_lsm_h(l)%ns,0:2)      )
-          ALLOCATE( surf_lsm_h(l)%aldir(1:surf_lsm_h(l)%ns,0:2)      )
-          ALLOCATE( surf_lsm_h(l)%asdif(1:surf_lsm_h(l)%ns,0:2)      )
-          ALLOCATE( surf_lsm_h(l)%asdir(1:surf_lsm_h(l)%ns,0:2)      )
-          ALLOCATE( surf_lsm_h(l)%rrtm_aldif(1:surf_lsm_h(l)%ns,0:2) )
-          ALLOCATE( surf_lsm_h(l)%rrtm_aldir(1:surf_lsm_h(l)%ns,0:2) )
-          ALLOCATE( surf_lsm_h(l)%rrtm_asdif(1:surf_lsm_h(l)%ns,0:2) )
-          ALLOCATE( surf_lsm_h(l)%rrtm_asdir(1:surf_lsm_h(l)%ns,0:2) )
-
-          ALLOCATE( surf_usm_h(l)%aldif(1:surf_usm_h(l)%ns,0:2)      )
-          ALLOCATE( surf_usm_h(l)%aldir(1:surf_usm_h(l)%ns,0:2)      )
-          ALLOCATE( surf_usm_h(l)%asdif(1:surf_usm_h(l)%ns,0:2)      )
-          ALLOCATE( surf_usm_h(l)%asdir(1:surf_usm_h(l)%ns,0:2)      )
-          ALLOCATE( surf_usm_h(l)%rrtm_aldif(1:surf_usm_h(l)%ns,0:2) )
-          ALLOCATE( surf_usm_h(l)%rrtm_aldir(1:surf_usm_h(l)%ns,0:2) )
-          ALLOCATE( surf_usm_h(l)%rrtm_asdif(1:surf_usm_h(l)%ns,0:2) )
-          ALLOCATE( surf_usm_h(l)%rrtm_asdir(1:surf_usm_h(l)%ns,0:2) )
-
-!
-!--       Allocate broadband albedo (temporary for the current radiation implementations)
-          IF ( .NOT. ALLOCATED(surf_lsm_h(l)%albedo) )                                             &
-             ALLOCATE( surf_lsm_h(l)%albedo(1:surf_lsm_h(l)%ns,0:2) )
-          IF ( .NOT. ALLOCATED(surf_usm_h(l)%albedo) )                                             &
-             ALLOCATE( surf_usm_h(l)%albedo(1:surf_usm_h(l)%ns,0:2) )
-       ENDDO
-!
-!--    Allocate albedos for short/longwave radiation, vertical surfaces
-       DO  l = 0, 3
-
-          ALLOCATE( surf_lsm_v(l)%aldif(1:surf_lsm_v(l)%ns,0:2) )
-          ALLOCATE( surf_lsm_v(l)%aldir(1:surf_lsm_v(l)%ns,0:2) )
-          ALLOCATE( surf_lsm_v(l)%asdif(1:surf_lsm_v(l)%ns,0:2) )
-          ALLOCATE( surf_lsm_v(l)%asdir(1:surf_lsm_v(l)%ns,0:2) )
-
-          ALLOCATE( surf_lsm_v(l)%rrtm_aldif(1:surf_lsm_v(l)%ns,0:2) )
-          ALLOCATE( surf_lsm_v(l)%rrtm_aldir(1:surf_lsm_v(l)%ns,0:2) )
-          ALLOCATE( surf_lsm_v(l)%rrtm_asdif(1:surf_lsm_v(l)%ns,0:2) )
-          ALLOCATE( surf_lsm_v(l)%rrtm_asdir(1:surf_lsm_v(l)%ns,0:2) )
-
-          ALLOCATE( surf_usm_v(l)%aldif(1:surf_usm_v(l)%ns,0:2) )
-          ALLOCATE( surf_usm_v(l)%aldir(1:surf_usm_v(l)%ns,0:2) )
-          ALLOCATE( surf_usm_v(l)%asdif(1:surf_usm_v(l)%ns,0:2) )
-          ALLOCATE( surf_usm_v(l)%asdir(1:surf_usm_v(l)%ns,0:2) )
-
-          ALLOCATE( surf_usm_v(l)%rrtm_aldif(1:surf_usm_v(l)%ns,0:2) )
-          ALLOCATE( surf_usm_v(l)%rrtm_aldir(1:surf_usm_v(l)%ns,0:2) )
-          ALLOCATE( surf_usm_v(l)%rrtm_asdif(1:surf_usm_v(l)%ns,0:2) )
-          ALLOCATE( surf_usm_v(l)%rrtm_asdir(1:surf_usm_v(l)%ns,0:2) )
-!
-!--       Allocate broadband albedo (temporary for the current radiation implementations)
-          IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) )                                           &
-             ALLOCATE( surf_lsm_v(l)%albedo(1:surf_lsm_v(l)%ns,0:2) )
-          IF ( .NOT. ALLOCATED( surf_usm_v(l)%albedo ) )                                           &
-             ALLOCATE( surf_usm_v(l)%albedo(1:surf_usm_v(l)%ns,0:2) )
-
-       ENDDO
-!
-!--    Level 1 initialization of spectral albedos via namelist paramters. Please note, in this case
-!--    all surface tiles are initialized the same.
-       DO  l = 0, 1
-          IF ( surf_lsm_h(l)%ns > 0 )  THEN
-             surf_lsm_h(l)%aldif  = albedo_lw_dif
-             surf_lsm_h(l)%aldir  = albedo_lw_dir
-             surf_lsm_h(l)%asdif  = albedo_sw_dif
-             surf_lsm_h(l)%asdir  = albedo_sw_dir
-             surf_lsm_h(l)%albedo = albedo_sw_dif
-          ENDIF
-          IF ( surf_usm_h(l)%ns > 0 )  THEN
-             IF ( surf_usm_h(l)%albedo_from_ascii )  THEN
-                surf_usm_h(l)%aldif  = surf_usm_h(l)%albedo
-                surf_usm_h(l)%aldir  = surf_usm_h(l)%albedo
-                surf_usm_h(l)%asdif  = surf_usm_h(l)%albedo
-                surf_usm_h(l)%asdir  = surf_usm_h(l)%albedo
-             ELSE
-                surf_usm_h(l)%aldif  = albedo_lw_dif
-                surf_usm_h(l)%aldir  = albedo_lw_dir
-                surf_usm_h(l)%asdif  = albedo_sw_dif
-                surf_usm_h(l)%asdir  = albedo_sw_dir
-                surf_usm_h(l)%albedo = albedo_sw_dif
-             ENDIF
-          ENDIF
-       ENDDO
-       DO  l = 0, 3
-
-          IF ( surf_lsm_v(l)%ns > 0 )  THEN
-             surf_lsm_v(l)%aldif  = albedo_lw_dif
-             surf_lsm_v(l)%aldir  = albedo_lw_dir
-             surf_lsm_v(l)%asdif  = albedo_sw_dif
-             surf_lsm_v(l)%asdir  = albedo_sw_dir
-             surf_lsm_v(l)%albedo = albedo_sw_dif
-          ENDIF
-
-          IF ( surf_usm_v(l)%ns > 0 )  THEN
-             IF ( surf_usm_v(l)%albedo_from_ascii )  THEN
-                surf_usm_v(l)%aldif = surf_usm_v(l)%albedo
-                surf_usm_v(l)%aldir = surf_usm_v(l)%albedo
-                surf_usm_v(l)%asdif = surf_usm_v(l)%albedo
-                surf_usm_v(l)%asdir = surf_usm_v(l)%albedo
-             ELSE
-                surf_usm_v(l)%aldif = albedo_lw_dif
-                surf_usm_v(l)%aldir = albedo_lw_dir
-                surf_usm_v(l)%asdif = albedo_sw_dif
-                surf_usm_v(l)%asdir = albedo_sw_dir
-             ENDIF
-          ENDIF
-       ENDDO
-
-!
-!--    Level 2 initialization of spectral albedos via albedo_type.
-!--    Please note, for natural- and urban-type surfaces, a tile approach is applied so that the
-!--    resulting albedo is calculated via the weighted average of respective surface fractions.
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-!
-!--          Spectral albedos for vegetation/pavement/water surfaces
-             DO  ind_type = 0, 2
-                IF ( surf_lsm_h(l)%albedo_type(m,ind_type) /= 0 )  THEN
-                   surf_lsm_h(l)%aldif(m,ind_type) =                                               &
-                   albedo_pars(1,surf_lsm_h(l)%albedo_type(m,ind_type))
-                   surf_lsm_h(l)%asdif(m,ind_type) =                                               &
-                   albedo_pars(2,surf_lsm_h(l)%albedo_type(m,ind_type))
-                   surf_lsm_h(l)%aldir(m,ind_type) =                                               &
-                   albedo_pars(1,surf_lsm_h(l)%albedo_type(m,ind_type))
-                   surf_lsm_h(l)%asdir(m,ind_type) =                                               &
-                   albedo_pars(2,surf_lsm_h(l)%albedo_type(m,ind_type))
-                   surf_lsm_h(l)%albedo(m,ind_type) =                                              &
-                   albedo_pars(0,surf_lsm_h(l)%albedo_type(m,ind_type))
-                ENDIF
-             ENDDO
-
-          ENDDO
-!
-!--       For urban surface only if albedo has not been already initialized in the urban-surface
-!--       model via the ASCII file.
-          IF ( .NOT. surf_usm_h(l)%albedo_from_ascii )  THEN
-             DO  m = 1, surf_usm_h(l)%ns
-!
-!--             Spectral albedos for wall/green/window surfaces
-                DO  ind_type = 0, 2
-                   IF ( surf_usm_h(l)%albedo_type(m,ind_type) /= 0 )  THEN
-                      surf_usm_h(l)%aldif(m,ind_type) =                                            &
-                      albedo_pars(1,surf_usm_h(l)%albedo_type(m,ind_type))
-                      surf_usm_h(l)%asdif(m,ind_type) =                                            &
-                      albedo_pars(2,surf_usm_h(l)%albedo_type(m,ind_type))
-                      surf_usm_h(l)%aldir(m,ind_type) =                                            &
-                      albedo_pars(1,surf_usm_h(l)%albedo_type(m,ind_type))
-                      surf_usm_h(l)%asdir(m,ind_type) =                                            &
-                      albedo_pars(2,surf_usm_h(l)%albedo_type(m,ind_type))
-                      surf_usm_h(l)%albedo(m,ind_type) =                                           &
-                      albedo_pars(0,surf_usm_h(l)%albedo_type(m,ind_type))
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDDO
-
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-!
-!--          Spectral albedos for vegetation/pavement/water surfaces
-             DO  ind_type = 0, 2
-                IF ( surf_lsm_v(l)%albedo_type(m,ind_type) /= 0 )  THEN
-                   surf_lsm_v(l)%aldif(m,ind_type) =                                               &
-                   albedo_pars(1,surf_lsm_v(l)%albedo_type(m,ind_type))
-                   surf_lsm_v(l)%asdif(m,ind_type) =                                               &
-                   albedo_pars(2,surf_lsm_v(l)%albedo_type(m,ind_type))
-                   surf_lsm_v(l)%aldir(m,ind_type) =                                               &
-                   albedo_pars(1,surf_lsm_v(l)%albedo_type(m,ind_type))
-                   surf_lsm_v(l)%asdir(m,ind_type) =                                               &
-                   albedo_pars(2,surf_lsm_v(l)%albedo_type(m,ind_type))
-                   surf_lsm_v(l)%albedo(m,ind_type) =                                              &
-                   albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_type))
-                ENDIF
-             ENDDO
-          ENDDO
-!
-!--       For urban surface only if albedo has not been already initialized in the urban-surface
-!--       model via the ASCII file.
-          IF ( .NOT. surf_usm_v(l)%albedo_from_ascii )  THEN
-             DO  m = 1, surf_usm_v(l)%ns
-!
-!--             Spectral albedos for wall/green/window surfaces
-                DO  ind_type = 0, 2
-                   IF ( surf_usm_v(l)%albedo_type(m,ind_type) /= 0 )  THEN
-                      surf_usm_v(l)%aldif(m,ind_type) =                                            &
-                      albedo_pars(1,surf_usm_v(l)%albedo_type(m,ind_type))
-                      surf_usm_v(l)%asdif(m,ind_type) =                                            &
-                      albedo_pars(2,surf_usm_v(l)%albedo_type(m,ind_type))
-                      surf_usm_v(l)%aldir(m,ind_type) =                                            &
-                      albedo_pars(1,surf_usm_v(l)%albedo_type(m,ind_type))
-                      surf_usm_v(l)%asdir(m,ind_type) =                                            &
-                      albedo_pars(2,surf_usm_v(l)%albedo_type(m,ind_type))
-                      surf_usm_v(l)%albedo(m,ind_type) =                                           &
-                      albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_type))
-                   ENDIF
-                ENDDO
-
-             ENDDO
-          ENDIF
-       ENDDO
-!
-!--    Level 3 initialization at grid points where albedo type is zero.
-!--    This case, spectral albedos are taken from file if available
-       IF ( albedo_pars_f%from_file )  THEN
-!
-!--       Horizontal
-          DO  l = 0, 1
-             DO  m = 1, surf_lsm_h(l)%ns
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-!
-!--             Spectral albedos for vegetation/pavement/water surfaces
-                DO  ind_type = 0, 2
-                   IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )                       &
-                      surf_lsm_h(l)%albedo(m,ind_type) = albedo_pars_f%pars_xy(0,j,i)
-                   IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )                       &
-                      surf_lsm_h(l)%aldir(m,ind_type) = albedo_pars_f%pars_xy(1,j,i)
-                   IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )                       &
-                      surf_lsm_h(l)%aldif(m,ind_type) = albedo_pars_f%pars_xy(1,j,i)
-                   IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )                       &
-                      surf_lsm_h(l)%asdir(m,ind_type) = albedo_pars_f%pars_xy(2,j,i)
-                   IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )                       &
-                      surf_lsm_h(l)%asdif(m,ind_type) = albedo_pars_f%pars_xy(2,j,i)
-                ENDDO
-             ENDDO
-!
-!--          For urban surface only if albedo has not been already initialized in the urban-surface
-!--          model via the ASCII file.
-             IF ( .NOT. surf_usm_h(l)%albedo_from_ascii )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-!
-!--                Broadband albedos for wall/green/window surfaces
-                   DO  ind_type = 0, 2
-                      IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )                    &
-                         surf_usm_h(l)%albedo(m,ind_type) = albedo_pars_f%pars_xy(0,j,i)
-                   ENDDO
-!
-!--                Spectral albedos especially for building wall surfaces
-                   IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )  THEN
-                      surf_usm_h(l)%aldir(m,ind_veg_wall) = albedo_pars_f%pars_xy(1,j,i)
-                      surf_usm_h(l)%aldif(m,ind_veg_wall) = albedo_pars_f%pars_xy(1,j,i)
-                   ENDIF
-                   IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )  THEN
-                      surf_usm_h(l)%asdir(m,ind_veg_wall) = albedo_pars_f%pars_xy(2,j,i)
-                      surf_usm_h(l)%asdif(m,ind_veg_wall) = albedo_pars_f%pars_xy(2,j,i)
-                   ENDIF
-!
-!--                Spectral albedos especially for building green surfaces
-                   IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill )  THEN
-                      surf_usm_h(l)%aldir(m,ind_pav_green) = albedo_pars_f%pars_xy(3,j,i)
-                      surf_usm_h(l)%aldif(m,ind_pav_green) = albedo_pars_f%pars_xy(3,j,i)
-                   ENDIF
-                   IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill )  THEN
-                      surf_usm_h(l)%asdir(m,ind_pav_green) = albedo_pars_f%pars_xy(4,j,i)
-                      surf_usm_h(l)%asdif(m,ind_pav_green) = albedo_pars_f%pars_xy(4,j,i)
-                   ENDIF
-!
-!--                Spectral albedos especially for building window surfaces
-                   IF ( albedo_pars_f%pars_xy(5,j,i) /= albedo_pars_f%fill )  THEN
-                      surf_usm_h(l)%aldir(m,ind_wat_win) = albedo_pars_f%pars_xy(5,j,i)
-                      surf_usm_h(l)%aldif(m,ind_wat_win) = albedo_pars_f%pars_xy(5,j,i)
-                   ENDIF
-                   IF ( albedo_pars_f%pars_xy(6,j,i) /= albedo_pars_f%fill )  THEN
-                      surf_usm_h(l)%asdir(m,ind_wat_win) = albedo_pars_f%pars_xy(6,j,i)
-                      surf_usm_h(l)%asdif(m,ind_wat_win) = albedo_pars_f%pars_xy(6,j,i)
-                   ENDIF
-
-                ENDDO
-             ENDIF
-          ENDDO
-!
-!--       Vertical
-          DO  l = 0, 3
-             ioff = surf_lsm_v(l)%ioff
-             joff = surf_lsm_v(l)%joff
-
-             DO  m = 1, surf_lsm_v(l)%ns
-                i = surf_lsm_v(l)%i(m)
-                j = surf_lsm_v(l)%j(m)
-!
-!--             Spectral albedos for vegetation/pavement/water surfaces
-                DO  ind_type = 0, 2
-                   IF ( albedo_pars_f%pars_xy(0,j+joff,i+ioff) /= albedo_pars_f%fill )             &
-                      surf_lsm_v(l)%albedo(m,ind_type) = albedo_pars_f%pars_xy(0,j+joff,i+ioff)
-                   IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= albedo_pars_f%fill )             &
-                      surf_lsm_v(l)%aldir(m,ind_type) = albedo_pars_f%pars_xy(1,j+joff,i+ioff)
-                   IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= albedo_pars_f%fill )             &
-                      surf_lsm_v(l)%aldif(m,ind_type) = albedo_pars_f%pars_xy(1,j+joff,i+ioff)
-                   IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= albedo_pars_f%fill )             &
-                      surf_lsm_v(l)%asdir(m,ind_type) = albedo_pars_f%pars_xy(2,j+joff,i+ioff)
-                   IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= albedo_pars_f%fill )             &
-                      surf_lsm_v(l)%asdif(m,ind_type) = albedo_pars_f%pars_xy(2,j+joff,i+ioff)
-                ENDDO
-             ENDDO
-!
-!--          For urban surface only if albedo has not been already initialized in the urban-surface
-!--          model via the ASCII file.
-             IF ( .NOT. surf_usm_v(l)%albedo_from_ascii )  THEN
-                ioff = surf_usm_v(l)%ioff
-                joff = surf_usm_v(l)%joff
-
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-!
-!--                Broadband albedos for wall/green/window surfaces
-                   DO  ind_type = 0, 2
-                      IF ( albedo_pars_f%pars_xy(0,j+joff,i+ioff) /= albedo_pars_f%fill )          &
-                         surf_usm_v(l)%albedo(m,ind_type) = albedo_pars_f%pars_xy(0,j+joff,i+ioff)
-                   ENDDO
-!
-!--                Spectral albedos especially for building wall surfaces
-                   IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= albedo_pars_f%fill )  THEN
-                      surf_usm_v(l)%aldir(m,ind_veg_wall) = albedo_pars_f%pars_xy(1,j+joff,i+ioff)
-                      surf_usm_v(l)%aldif(m,ind_veg_wall) = albedo_pars_f%pars_xy(1,j+joff,i+ioff)
-                   ENDIF
-                   IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= albedo_pars_f%fill )  THEN
-                      surf_usm_v(l)%asdir(m,ind_veg_wall) = albedo_pars_f%pars_xy(2,j+joff,i+ioff)
-                      surf_usm_v(l)%asdif(m,ind_veg_wall) = albedo_pars_f%pars_xy(2,j+joff,i+ioff)
-                   ENDIF
-!
-!--                Spectral albedos especially for building green surfaces
-                   IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /= albedo_pars_f%fill )  THEN
-                      surf_usm_v(l)%aldir(m,ind_pav_green) = albedo_pars_f%pars_xy(3,j+joff,i+ioff)
-                      surf_usm_v(l)%aldif(m,ind_pav_green) = albedo_pars_f%pars_xy(3,j+joff,i+ioff)
-                   ENDIF
-                   IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /= albedo_pars_f%fill )  THEN
-                      surf_usm_v(l)%asdir(m,ind_pav_green) = albedo_pars_f%pars_xy(4,j+joff,i+ioff)
-                      surf_usm_v(l)%asdif(m,ind_pav_green) = albedo_pars_f%pars_xy(4,j+joff,i+ioff)
-                   ENDIF
-!
-!--                Spectral albedos especially for building window surfaces
-                   IF ( albedo_pars_f%pars_xy(5,j+joff,i+ioff) /= albedo_pars_f%fill )  THEN
-                      surf_usm_v(l)%aldir(m,ind_wat_win) = albedo_pars_f%pars_xy(5,j+joff,i+ioff)
-                      surf_usm_v(l)%aldif(m,ind_wat_win) = albedo_pars_f%pars_xy(5,j+joff,i+ioff)
-                   ENDIF
-                   IF ( albedo_pars_f%pars_xy(6,j+joff,i+ioff) /= albedo_pars_f%fill )  THEN
-                      surf_usm_v(l)%asdir(m,ind_wat_win) = albedo_pars_f%pars_xy(6,j+joff,i+ioff)
-                      surf_usm_v(l)%asdif(m,ind_wat_win) = albedo_pars_f%pars_xy(6,j+joff,i+ioff)
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDDO
-
-       ENDIF
-!
-!--    Read explicit albedo values from building surface pars. If present, they override all less
-!--    specific albedo values and force an albedo_type to zero in order to take effect.
-       IF ( building_surface_pars_f%from_file )  THEN
-          DO  l = 0, 1
-             DO  m = 1, surf_usm_h(l)%ns
-                i = surf_usm_h(l)%i(m)
-                j = surf_usm_h(l)%j(m)
-                k = surf_usm_h(l)%k(m)
-   !
-   !--          Iterate over surfaces in column, check height and orientation
-                DO  is = building_surface_pars_f%index_ji(1,j,i),                                  &
-                         building_surface_pars_f%index_ji(2,j,i)
-                   IF ( building_surface_pars_f%coords(4,is) == -surf_usm_h(l)%koff .AND.          &
-                        building_surface_pars_f%coords(1,is) == k )  THEN
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /=                    &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%albedo(m,ind_veg_wall) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_b_wall,is)
-                         surf_usm_h(l)%albedo_type(m,ind_veg_wall) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_l_wall,is) /=                    &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%aldir(m,ind_veg_wall) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_l_wall,is)
-                         surf_usm_h(l)%aldif(m,ind_veg_wall) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_l_wall,is)
-                         surf_usm_h(l)%albedo_type(m,ind_veg_wall) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_s_wall,is) /=                    &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%asdir(m,ind_veg_wall) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_s_wall,is)
-                         surf_usm_h(l)%asdif(m,ind_veg_wall) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_s_wall,is)
-                         surf_usm_h(l)%albedo_type(m,ind_veg_wall) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /=                     &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%albedo(m,ind_wat_win) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_b_win,is)
-                         surf_usm_h(l)%albedo_type(m,ind_wat_win) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_l_win,is) /=                     &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%aldir(m,ind_wat_win) =                                      &
-                         building_surface_pars_f%pars(ind_s_alb_l_win,is)
-                         surf_usm_h(l)%aldif(m,ind_wat_win) =                                      &
-                         building_surface_pars_f%pars(ind_s_alb_l_win,is)
-                         surf_usm_h(l)%albedo_type(m,ind_wat_win) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_s_win,is) /=                     &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%asdir(m,ind_wat_win) =                                      &
-                         building_surface_pars_f%pars(ind_s_alb_s_win,is)
-                         surf_usm_h(l)%asdif(m,ind_wat_win) =                                      &
-                         building_surface_pars_f%pars(ind_s_alb_s_win,is)
-                         surf_usm_h(l)%albedo_type(m,ind_wat_win) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /=                   &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%albedo(m,ind_pav_green) =                                   &
-                         building_surface_pars_f%pars(ind_s_alb_b_green,is)
-                         surf_usm_h(l)%albedo_type(m,ind_pav_green) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_l_green,is) /=                   &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%aldir(m,ind_pav_green) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_l_green,is)
-                         surf_usm_h(l)%aldif(m,ind_pav_green) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_l_green,is)
-                         surf_usm_h(l)%albedo_type(m,ind_pav_green) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_s_green,is) /=                   &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_h(l)%asdir(m,ind_pav_green) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_s_green,is)
-                         surf_usm_h(l)%asdif(m,ind_pav_green) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_s_green,is)
-                         surf_usm_h(l)%albedo_type(m,ind_pav_green) = 0
-                      ENDIF
-
-                      EXIT  ! Surface was found and processed
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-          DO  l = 0, 3
-             DO  m = 1, surf_usm_v(l)%ns
-                i = surf_usm_v(l)%i(m)
-                j = surf_usm_v(l)%j(m)
-                k = surf_usm_v(l)%k(m)
-!
-!--             Iterate over surfaces in column, check height and orientation
-                DO  is = building_surface_pars_f%index_ji(1,j,i),                                  &
-                         building_surface_pars_f%index_ji(2,j,i)
-                   IF ( building_surface_pars_f%coords(5,is) == -surf_usm_v(l)%joff .AND.          &
-                        building_surface_pars_f%coords(6,is) == -surf_usm_v(l)%ioff .AND.          &
-                        building_surface_pars_f%coords(1,is) == k )  THEN
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /=                    &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%albedo(m,ind_veg_wall) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_b_wall,is)
-                         surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_l_wall,is) /=                    &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%aldir(m,ind_veg_wall) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_l_wall,is)
-                         surf_usm_v(l)%aldif(m,ind_veg_wall) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_l_wall,is)
-                         surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_s_wall,is) /=                    &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%asdir(m,ind_veg_wall) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_s_wall,is)
-                         surf_usm_v(l)%asdif(m,ind_veg_wall) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_s_wall,is)
-                         surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /=                     &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%albedo(m,ind_wat_win) =                                     &
-                         building_surface_pars_f%pars(ind_s_alb_b_win,is)
-                         surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_l_win,is) /=                     &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%aldir(m,ind_wat_win) =                                      &
-                         building_surface_pars_f%pars(ind_s_alb_l_win,is)
-                         surf_usm_v(l)%aldif(m,ind_wat_win) =                                      &
-                         building_surface_pars_f%pars(ind_s_alb_l_win,is)
-                         surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_s_win,is) /=                     &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%asdir(m,ind_wat_win) =                                      &
-                         building_surface_pars_f%pars(ind_s_alb_s_win,is)
-                         surf_usm_v(l)%asdif(m,ind_wat_win) =                                      &
-                         building_surface_pars_f%pars(ind_s_alb_s_win,is)
-                         surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /=                   &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%albedo(m,ind_pav_green) =                                   &
-                         building_surface_pars_f%pars(ind_s_alb_b_green,is)
-                         surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_l_green,is) /=                   &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%aldir(m,ind_pav_green) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_l_green,is)
-                         surf_usm_v(l)%aldif(m,ind_pav_green) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_l_green,is)
-                         surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0
-                      ENDIF
-
-                      IF ( building_surface_pars_f%pars(ind_s_alb_s_green,is) /=                   &
-                           building_surface_pars_f%fill )  THEN
-                         surf_usm_v(l)%asdir(m,ind_pav_green) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_s_green,is)
-                         surf_usm_v(l)%asdif(m,ind_pav_green) =                                    &
-                         building_surface_pars_f%pars(ind_s_alb_s_green,is)
-                         surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0
-                      ENDIF
-
-                      EXIT  ! Surface was found and processed
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-
-!
-!--    Calculate initial values of current (cosine of) the zenith angle and whether the sun is up
-       CALL get_date_time( time_since_reference_point, day_of_year=day_of_year,                    &
-                           second_of_day=second_of_day )
-       CALL calc_zenith( day_of_year, second_of_day )
-!
-!--    Calculate initial surface albedo for different surfaces
-       IF ( .NOT. constant_albedo )  THEN
-#if defined( __netcdf )
-!
-!--       Horizontally aligned natural and urban surfaces
-          DO l = 0, 1
-             CALL calc_albedo( surf_lsm_h(l) )
-             CALL calc_albedo( surf_usm_h(l) )
-          ENDDO
-!
-!--       Vertically aligned natural and urban surfaces
-          DO  l = 0, 3
-             CALL calc_albedo( surf_lsm_v(l) )
-             CALL calc_albedo( surf_usm_v(l) )
-          ENDDO
-#endif
-       ELSE
-!
-!--       Initialize sun-inclination independent spectral albedos
-!--       Horizontal surfaces
-          DO  l = 0, 1
-             IF ( surf_lsm_h(l)%ns > 0 )  THEN
-                surf_lsm_h(l)%rrtm_aldir = surf_lsm_h(l)%aldir
-                surf_lsm_h(l)%rrtm_asdir = surf_lsm_h(l)%asdir
-                surf_lsm_h(l)%rrtm_aldif = surf_lsm_h(l)%aldif
-                surf_lsm_h(l)%rrtm_asdif = surf_lsm_h(l)%asdif
-             ENDIF
-             IF ( surf_usm_h(l)%ns > 0 )  THEN
-                surf_usm_h(l)%rrtm_aldir = surf_usm_h(l)%aldir
-                surf_usm_h(l)%rrtm_asdir = surf_usm_h(l)%asdir
-                surf_usm_h(l)%rrtm_aldif = surf_usm_h(l)%aldif
-                surf_usm_h(l)%rrtm_asdif = surf_usm_h(l)%asdif
-             ENDIF
-          ENDDO
-!
-!--       Vertical surfaces
-          DO  l = 0, 3
-             IF ( surf_lsm_v(l)%ns > 0 )  THEN
-                surf_lsm_v(l)%rrtm_aldir = surf_lsm_v(l)%aldir
-                surf_lsm_v(l)%rrtm_asdir = surf_lsm_v(l)%asdir
-                surf_lsm_v(l)%rrtm_aldif = surf_lsm_v(l)%aldif
-                surf_lsm_v(l)%rrtm_asdif = surf_lsm_v(l)%asdif
-             ENDIF
-             IF ( surf_usm_v(l)%ns > 0 )  THEN
-                surf_usm_v(l)%rrtm_aldir = surf_usm_v(l)%aldir
-                surf_usm_v(l)%rrtm_asdir = surf_usm_v(l)%asdir
-                surf_usm_v(l)%rrtm_aldif = surf_usm_v(l)%aldif
-                surf_usm_v(l)%rrtm_asdif = surf_usm_v(l)%asdif
-             ENDIF
-          ENDDO
-
-       ENDIF
-
-!
-!--    Allocate 3d arrays of radiative fluxes and heating rates
-       IF ( .NOT. ALLOCATED( rad_sw_in ) )  THEN
-          ALLOCATE( rad_sw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_sw_in = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
-          ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_sw_out ) )  THEN
-          ALLOCATE( rad_sw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_sw_out = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
-          ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_sw_hr ) )  THEN
-          ALLOCATE( rad_sw_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_sw_hr = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_sw_hr_av ) )  THEN
-          ALLOCATE( rad_sw_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_sw_hr_av = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_sw_cs_hr ) )  THEN
-          ALLOCATE( rad_sw_cs_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_sw_cs_hr = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) )  THEN
-          ALLOCATE( rad_sw_cs_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_sw_cs_hr_av = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_lw_in ) )  THEN
-          ALLOCATE( rad_lw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_lw_in = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
-          ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_lw_out ) )  THEN
-          ALLOCATE( rad_lw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-         rad_lw_out = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
-          ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_lw_hr ) )  THEN
-          ALLOCATE( rad_lw_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_lw_hr = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_lw_hr_av ) )  THEN
-          ALLOCATE( rad_lw_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_lw_hr_av = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_lw_cs_hr ) )  THEN
-          ALLOCATE( rad_lw_cs_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_lw_cs_hr = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) )  THEN
-          ALLOCATE( rad_lw_cs_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          rad_lw_cs_hr_av = 0.0_wp
-       ENDIF
-
-       ALLOCATE( rad_sw_cs_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ALLOCATE( rad_sw_cs_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       rad_sw_cs_in  = 0.0_wp
-       rad_sw_cs_out = 0.0_wp
-
-       ALLOCATE( rad_lw_cs_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ALLOCATE( rad_lw_cs_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       rad_lw_cs_in  = 0.0_wp
-       rad_lw_cs_out = 0.0_wp
-
-!
-!--    Allocate 1-element array for surface temperature
-!--    (RRTMG anticipates an array as passed argument).
-       ALLOCATE( rrtm_tsfc(1) )
-!
-!--    Allocate surface emissivity.
-!--    Values will be given directly before calling rrtm_lw.
-       ALLOCATE( rrtm_emis(0:0,1:nbndlw+1) )
-
-!
-!--    Initialize RRTMG, before check if files are existent
-       INQUIRE( FILE = 'RRTMG_LW', EXIST = lw_exists )
-       IF ( .NOT. lw_exists )  THEN
-          message_string = 'Input file RRTMG_LW for rrtmg model missing.& Please provide ' //      &
-                           TRIM( run_identifier ) // '_rlw file in the INPUT directory.'
-          CALL message( 'radiation_init', 'PA0583', 1, 2, 0, 6, 0 )
-       ENDIF
-       INQUIRE( FILE = 'RRTMG_SW', EXIST = sw_exists )
-       IF ( .NOT. sw_exists )  THEN
-          message_string = 'Input file RRTMG_SW for rrtmg model missing.& Please provide ' //      &
-                           TRIM( run_identifier ) // '_rsw file in the INPUT directory.'
-          CALL message( 'radiation_init', 'PA0584', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( lw_radiation )  CALL rrtmg_lw_ini ( c_p )
-       IF ( sw_radiation )  CALL rrtmg_sw_ini ( c_p )
-
-!
-!--    Set input files for RRTMG
-       INQUIRE( FILE = 'RAD_SND_DATA', EXIST = snd_exists )
-       IF ( .NOT. snd_exists )  THEN
-          rrtm_input_file = 'RRTMG_LW'
-       ENDIF
-
-!
-!--    Read vertical layers for RRTMG from sounding data
-!--    The routine provides nzt_rad, hyp_snd(1:nzt_rad), t_snd(nzt+2:nzt_rad), rrtm_play(1:nzt_rad),
-!--    rrtm_plev(1_nzt_rad+1), rrtm_tlay(nzt+2:nzt_rad), rrtm_tlev(nzt+2:nzt_rad+1)
-       CALL read_sounding_data
-
-!
-!--    Read trace gas profiles from file. This routine provides the rrtm_ arrays (1:nzt_rad+1)
-       CALL read_trace_gas_data
-#endif
-    ENDIF
-!
-!-- Initializaion actions exclusively required for external radiation forcing
-    IF ( radiation_scheme == 'external' )  THEN
-!
-!--    Open the radiation input file. Note, for child domain, a dynamic input file is often not
-!--    provided. In order to not need to duplicate the dynamic input file just for the radiation
-!--    input, take it from the dynamic file for the parent if not available for the child domain(s).
-!--    In this case this is possible because radiation input should be the same for each model.
-       INQUIRE( FILE = TRIM( input_file_dynamic ), EXIST = radiation_input_root_domain )
-
-       IF ( .NOT. input_pids_dynamic  .AND.  .NOT.  radiation_input_root_domain )  THEN
-          message_string = 'In case of external radiation forcing a dynamic input file is ' //     &
-                           'required. If no dynamic input for the child domain(s) is ' //          &
-                           'provided, at least one for the root domain is needed.'
-          CALL message( 'radiation_init', 'PA0315', 1, 2, 0, 6, 0 )
-       ENDIF
-#if defined( __netcdf )
-!
-!--    Open dynamic input file for child domain if available, else, open dynamic input file for the
-!--    root domain.
-       IF ( input_pids_dynamic )  THEN
-       CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), pids_id )
-       ELSEIF ( radiation_input_root_domain )  THEN
-          CALL open_read_file( TRIM( input_file_dynamic ), pids_id )
-       ENDIF
-
-       CALL inquire_num_variables( pids_id, num_var_pids )
-!
-!--    Allocate memory to store variable names and read them
-       ALLOCATE( vars_pids(1:num_var_pids) )
-       CALL inquire_variable_names( pids_id, vars_pids )
-!
-!--    Input time dimension.
-       IF ( check_existence( vars_pids, 'time_rad' ) )  THEN
-          CALL get_dimension_length( pids_id, ntime, 'time_rad' )
-
-          ALLOCATE( time_rad_f%var1d(0:ntime-1) )
-!
-!--       Read variable
-          CALL get_variable( pids_id, 'time_rad', time_rad_f%var1d )
-
-          time_rad_f%from_file = .TRUE.
-       ENDIF
-!
-!--    Input shortwave downwelling.
-       IF ( check_existence( vars_pids, 'rad_sw_in' ) )  THEN
-!
-!--       Get _FillValue attribute
-          CALL get_attribute( pids_id, char_fill, rad_sw_in_f%fill, .FALSE., 'rad_sw_in' )
-!
-!--       Get level-of-detail
-          CALL get_attribute( pids_id, char_lod, rad_sw_in_f%lod, .FALSE., 'rad_sw_in' )
-!
-!--       Level-of-detail 1 - radiation depends only on time_rad
-          IF ( rad_sw_in_f%lod == 1 )  THEN
-             ALLOCATE( rad_sw_in_f%var1d(0:ntime-1) )
-             CALL get_variable( pids_id, 'rad_sw_in', rad_sw_in_f%var1d )
-             rad_sw_in_f%from_file = .TRUE.
-!
-!--       Level-of-detail 2 - radiation depends on time_rad, y, x
-          ELSEIF ( rad_sw_in_f%lod == 2 )  THEN
-             ALLOCATE( rad_sw_in_f%var3d(0:ntime-1,nys:nyn,nxl:nxr) )
-
-             CALL get_variable( pids_id, 'rad_sw_in', rad_sw_in_f%var3d, nxl, nxr, nys, nyn, 0,    &
-                                ntime-1 )
-
-             rad_sw_in_f%from_file = .TRUE.
-          ELSE
-             message_string = '"rad_sw_in" has no valid lod attribute'
-             CALL message( 'radiation_init', 'PA0646', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-!
-!--    Input longwave downwelling.
-       IF ( check_existence( vars_pids, 'rad_lw_in' ) )  THEN
-!
-!--       Get _FillValue attribute
-          CALL get_attribute( pids_id, char_fill, rad_lw_in_f%fill, .FALSE., 'rad_lw_in' )
-!
-!--       Get level-of-detail
-          CALL get_attribute( pids_id, char_lod, rad_lw_in_f%lod, .FALSE., 'rad_lw_in' )
-!
-!--       Level-of-detail 1 - radiation depends only on time_rad
-          IF ( rad_lw_in_f%lod == 1 )  THEN
-             ALLOCATE( rad_lw_in_f%var1d(0:ntime-1) )
-             CALL get_variable( pids_id, 'rad_lw_in', rad_lw_in_f%var1d )
-             rad_lw_in_f%from_file = .TRUE.
-!
-!--       Level-of-detail 2 - radiation depends on time_rad, y, x
-          ELSEIF ( rad_lw_in_f%lod == 2 )  THEN
-             ALLOCATE( rad_lw_in_f%var3d(0:ntime-1,nys:nyn,nxl:nxr) )
-
-             CALL get_variable( pids_id, 'rad_lw_in', rad_lw_in_f%var3d, nxl, nxr, nys, nyn, 0,    &
-                                ntime-1 )
-
-             rad_lw_in_f%from_file = .TRUE.
-          ELSE
-             message_string = '"rad_lw_in" has no valid lod attribute'
-             CALL message( 'radiation_init', 'PA0646', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-!
-!--    Input shortwave downwelling, diffuse part.
-       IF ( check_existence( vars_pids, 'rad_sw_in_dif' ) )  THEN
-!
-!--       Read _FillValue attribute
-          CALL get_attribute( pids_id, char_fill, rad_sw_in_dif_f%fill, .FALSE., 'rad_sw_in_dif' )
-!
-!--       Get level-of-detail
-          CALL get_attribute( pids_id, char_lod, rad_sw_in_dif_f%lod, .FALSE., 'rad_sw_in_dif' )
-!
-!--       Level-of-detail 1 - radiation depends only on time_rad
-          IF ( rad_sw_in_dif_f%lod == 1 )  THEN
-             ALLOCATE( rad_sw_in_dif_f%var1d(0:ntime-1) )
-             CALL get_variable( pids_id, 'rad_sw_in_dif', rad_sw_in_dif_f%var1d )
-             rad_sw_in_dif_f%from_file = .TRUE.
-!
-!--       Level-of-detail 2 - radiation depends on time_rad, y, x
-          ELSEIF ( rad_sw_in_dif_f%lod == 2 )  THEN
-             ALLOCATE( rad_sw_in_dif_f%var3d(0:ntime-1,nys:nyn,nxl:nxr) )
-
-             CALL get_variable( pids_id, 'rad_sw_in_dif', rad_sw_in_dif_f%var3d, nxl, nxr, nys,    &
-                                nyn, 0, ntime-1 )
-
-             rad_sw_in_dif_f%from_file = .TRUE.
-          ELSE
-             message_string = '"rad_sw_in_dif" has no valid lod attribute'
-             CALL message( 'radiation_init', 'PA0646', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-!
-!--    Finally, close the input file and deallocate temporary arrays
-       DEALLOCATE( vars_pids )
-
-       CALL close_input_file( pids_id )
-#endif
-!
-!--    Make some consistency checks.
-       IF ( .NOT. rad_sw_in_f%from_file  .OR.  .NOT. rad_lw_in_f%from_file )  THEN
-          message_string = 'In case of external radiation forcing both, rad_sw_in and ' //         &
-                            'rad_lw_in are required.'
-          CALL message( 'radiation_init', 'PA0195', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( .NOT. time_rad_f%from_file )  THEN
-          message_string = 'In case of external radiation forcing dimension time_rad is required.'
-          CALL message( 'radiation_init', 'PA0196', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       CALL get_date_time( 0.0_wp, second_of_day=second_of_day )
-
-       IF ( end_time - spinup_time > time_rad_f%var1d(ntime-1) )  THEN
-          message_string = 'External radiation forcing does not cover the entire simulation time.'
-          CALL message( 'radiation_init', 'PA0314', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Check for fill values in radiation
-       IF ( ALLOCATED( rad_sw_in_f%var1d ) )  THEN
-          IF ( ANY( rad_sw_in_f%var1d == rad_sw_in_f%fill ) )  THEN
-             message_string = 'External radiation array "rad_sw_in" must not contain any ' //      &
-                              'fill values.'
-             CALL message( 'radiation_init', 'PA0197', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_in_f%var1d ) )  THEN
-          IF ( ANY( rad_lw_in_f%var1d == rad_lw_in_f%fill ) )  THEN
-             message_string = 'External radiation array "rad_lw_in" must not contain any ' //      &
-                              'fill values.'
-             CALL message( 'radiation_init', 'PA0198', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_in_dif_f%var1d ) )  THEN
-          IF ( ANY( rad_sw_in_dif_f%var1d == rad_sw_in_dif_f%fill ) )  THEN
-             message_string = 'External radiation array "rad_sw_in_dif" must not contain any ' //  &
-                              'fill values.'
-             CALL message( 'radiation_init', 'PA0199', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_in_f%var3d ) )  THEN
-          IF ( ANY( rad_sw_in_f%var3d == rad_sw_in_f%fill ) )  THEN
-             message_string = 'External radiation array "rad_sw_in" must not contain any ' //      &
-                              'fill values.'
-             CALL message( 'radiation_init', 'PA0197', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_in_f%var3d ) )  THEN
-          IF ( ANY( rad_lw_in_f%var3d == rad_lw_in_f%fill ) )  THEN
-             message_string = 'External radiation array "rad_lw_in" must not contain any ' //      &
-                              'fill values.'
-             CALL message( 'radiation_init', 'PA0198', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_in_dif_f%var3d ) )  THEN
-          IF ( ANY( rad_sw_in_dif_f%var3d == rad_sw_in_dif_f%fill ) )  THEN
-             message_string = 'External radiation array "rad_sw_in_dif" must not contain any ' //  &
-                              'fill values.'
-             CALL message( 'radiation_init', 'PA0199', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDIF
-!
-!--    Currently, 2D external radiation input is not possible in combination with topography where
-!--    average radiation is used.
-       IF ( ( rad_lw_in_f%lod == 2  .OR.  rad_sw_in_f%lod == 2  .OR.                               &
-              rad_sw_in_dif_f%lod == 2  )  .AND. average_radiation )  THEN
-          message_string = 'External radiation with lod = 2 is currently not possible with ' //    &
-                           'average_radiation = .T..'
-             CALL message( 'radiation_init', 'PA0670', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    All radiation input should have the same level of detail. The sum of lods divided by the
-!--    number of available radiation arrays must be 1 (if all are lod = 1) or 2 (if all are lod = 2).
-       IF ( REAL( MERGE( rad_lw_in_f%lod, 0, rad_lw_in_f%from_file ) +                             &
-                  MERGE( rad_sw_in_f%lod, 0, rad_sw_in_f%from_file ) +                             &
-                  MERGE( rad_sw_in_dif_f%lod, 0, rad_sw_in_dif_f%from_file ), KIND = wp ) /        &
-                ( MERGE( 1.0_wp, 0.0_wp, rad_lw_in_f%from_file ) +                                 &
-                  MERGE( 1.0_wp, 0.0_wp, rad_sw_in_f%from_file ) +                                 &
-                  MERGE( 1.0_wp, 0.0_wp, rad_sw_in_dif_f%from_file ) ) /= 1.0_wp  .AND.            &
-            REAL( MERGE( rad_lw_in_f%lod, 0, rad_lw_in_f%from_file ) +                             &
-                  MERGE( rad_sw_in_f%lod, 0, rad_sw_in_f%from_file ) +                             &
-                  MERGE( rad_sw_in_dif_f%lod, 0, rad_sw_in_dif_f%from_file ), KIND = wp ) /        &
-                ( MERGE( 1.0_wp, 0.0_wp, rad_lw_in_f%from_file ) +                                 &
-                  MERGE( 1.0_wp, 0.0_wp, rad_sw_in_f%from_file ) +                                 &
-                  MERGE( 1.0_wp, 0.0_wp, rad_sw_in_dif_f%from_file ) )                             &
-                  /= 2.0_wp )  THEN
-          message_string = 'External radiation input should have the same lod.'
-          CALL message( 'radiation_init', 'PA0673', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDIF
-!
-!-- Perform user actions if required
-    CALL user_init_radiation
-
-!
-!-- Calculate radiative fluxes at model start
-    SELECT CASE ( TRIM( radiation_scheme ) )
-
-       CASE ( 'rrtmg' )
-          CALL radiation_rrtmg
-
-       CASE ( 'clear-sky' )
-          CALL radiation_clearsky
-
-       CASE ( 'constant' )
-          CALL radiation_constant
-
-       CASE ( 'external' )
-!
-!--       During spinup apply clear-sky model
-          IF ( time_since_reference_point < 0.0_wp )  THEN
-             CALL radiation_clearsky
-          ELSE
-             CALL radiation_external
-          ENDIF
-
-       CASE DEFAULT
-
-    END SELECT
-
-!
-!-- If required, read or calculate and write out the SVF.
-    IF ( radiation_interactions )  THEN
-
-!
-!--    Find all discretized apparent solar positions for radiation interaction.
-       CALL radiation_presimulate_solar_pos
-
-       IF ( read_svf )  THEN
-!
-!--       Read sky-view factors and further required data from file
-          CALL radiation_read_svf()
-
-       ELSE
-!
-!--       Calculate svf and csf.
-          CALL radiation_calc_svf()
-       ENDIF
-
-       IF ( write_svf )  THEN
-!
-!--       Write svf, csf svfsurf and csfsurf data to file.
-          CALL radiation_write_svf()
-       ENDIF
-
-!
-!--    Adjust radiative fluxes.
-!--    In case of urban and land surfaces, also call an initial interaction.
-       CALL radiation_interaction
-
-    ENDIF
-
-    IF ( debug_output )  CALL debug_message( 'radiation_init', 'end' )
-
- END SUBROUTINE radiation_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Use external radiative forcing (short- and longwave downwelling radiation) from a driver
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_external
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  l   !< running index for surface orientation
-    INTEGER(iwp) ::  t   !< index of current timestep
-    INTEGER(iwp) ::  tm  !< index of previous timestep
-
-    LOGICAL ::  horizontal  !< flag indicating treatment of horinzontal surfaces
-
-    REAL(wp) ::  fac_dt              !< interpolation factor
-    REAL(wp) ::  second_of_day_init  !< second of the day at model start
-
-    TYPE(surf_type), POINTER ::  surf  !< pointer on respective surface type, used to generalize routine
-
-!
-!-- Calculate current zenith angle
-    CALL get_date_time( time_since_reference_point, day_of_year = day_of_year,                     &
-                        second_of_day = second_of_day )
-    CALL calc_zenith( day_of_year, second_of_day )
-!
-!-- Interpolate external radiation on current timestep
-    IF ( time_since_reference_point  <= 0.0_wp )  THEN
-       t      = 0
-       tm     = 0
-       fac_dt = 0
-    ELSE
-       CALL get_date_time( 0.0_wp, second_of_day=second_of_day_init )
-       t = 0
-       DO WHILE ( time_rad_f%var1d(t) <= time_since_reference_point )
-          t = t + 1
-       ENDDO
-
-       tm = MAX( t-1, 0 )
-
-       fac_dt = ( time_since_reference_point - time_rad_f%var1d(tm) + dt_3d ) /                    &
-                MAX( TINY( 1._wp ), ( time_rad_f%var1d(t)  - time_rad_f%var1d(tm) ) )
-       fac_dt = MIN( 1.0_wp, fac_dt )
-    ENDIF
-!
-!-- Call clear-sky calculation for each surface orientation.
-!-- First, horizontal surfaces
-    horizontal = .TRUE.
-    DO  l = 0, 1
-       surf => surf_lsm_h(l)
-       CALL radiation_external_surf
-       surf => surf_usm_h(l)
-       CALL radiation_external_surf
-    ENDDO
-    horizontal = .FALSE.
-!
-!-- Vertical surfaces
-    DO  l = 0, 3
-       surf => surf_lsm_v(l)
-       CALL radiation_external_surf
-       surf => surf_usm_v(l)
-       CALL radiation_external_surf
-    ENDDO
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Todo: Subroutine description missing!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_external_surf
-
-    USE control_parameters
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< grid index along x-dimension
-    INTEGER(iwp) ::  j  !< grid index along y-dimension
-    INTEGER(iwp) ::  k  !< grid index along z-dimension
-    INTEGER(iwp) ::  m  !< running index for surface elements
-
-    REAL(wp) ::  lw_in      !< downwelling longwave radiation, interpolated value
-    REAL(wp) ::  sw_in      !< downwelling shortwave radiation, interpolated value
-    REAL(wp) ::  sw_in_dif  !< downwelling diffuse shortwave radiation, interpolated value
-
-    IF ( surf%ns < 1 )  RETURN
-!
-!-- Level-of-detail = 1. Note, here it must be distinguished between averaged radiation and
-!-- non-averaged radiation for the upwelling fluxes.
-    IF ( rad_sw_in_f%lod == 1 )  THEN
-
-       sw_in = ( 1.0_wp - fac_dt ) * rad_sw_in_f%var1d(tm) + fac_dt * rad_sw_in_f%var1d(t)
-
-       lw_in = ( 1.0_wp - fac_dt ) * rad_lw_in_f%var1d(tm) + fac_dt * rad_lw_in_f%var1d(t)
-!
-!--    Limit shortwave incoming radiation to positive values, in order to overcome possible
-!--    observation errors.
-       sw_in = MAX( 0.0_wp, sw_in )
-       sw_in = MERGE( sw_in, 0.0_wp, sun_up )
-
-       surf%rad_sw_in = sw_in
-       surf%rad_lw_in = lw_in
-
-       IF ( average_radiation )  THEN
-          surf%rad_sw_out = albedo_urb * surf%rad_sw_in
-
-          surf%rad_lw_out = emissivity_urb * sigma_sb * t_rad_urb**4 +                             &
-                            ( 1.0_wp - emissivity_urb ) * surf%rad_lw_in
-
-          surf%rad_net = surf%rad_sw_in - surf%rad_sw_out + surf%rad_lw_in - surf%rad_lw_out
-
-          surf%rad_lw_out_change_0 = 4.0_wp * emissivity_urb * sigma_sb * t_rad_urb**3
-       ELSE
-          DO  m = 1, surf%ns
-             k = surf%k(m)
-             surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall)  * surf%albedo(m,ind_veg_wall)       &
-                                  + surf%frac(m,ind_pav_green) * surf%albedo(m,ind_pav_green)      &
-                                  + surf%frac(m,ind_wat_win)   * surf%albedo(m,ind_wat_win) )      &
-                                  * surf%rad_sw_in(m)
-
-             surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall)  * surf%emissivity(m,ind_veg_wall)   &
-                                  + surf%frac(m,ind_pav_green) * surf%emissivity(m,ind_pav_green)  &
-                                  + surf%frac(m,ind_wat_win)   * surf%emissivity(m,ind_wat_win) )  &
-                                  * sigma_sb * ( surf%pt_surface(m) * exner(k) )**4
-
-             surf%rad_lw_out_change_0(m) = ( surf%frac(m,ind_veg_wall) *                           &
-                                             surf%emissivity(m,ind_veg_wall)                       &
-                                           + surf%frac(m,ind_pav_green) *                          &
-                                             surf%emissivity(m,ind_pav_green)                      &
-                                           + surf%frac(m,ind_wat_win)   *                          &
-                                             surf%emissivity(m,ind_wat_win) ) * 4.0_wp * sigma_sb  &
-                                           * ( surf%pt_surface(m) * exner(k) )**3
-          ENDDO
-
-       ENDIF
-!
-!--    If diffuse shortwave radiation is available, store it on the respective files.
-       IF ( rad_sw_in_dif_f%from_file )  THEN
-          sw_in_dif= ( 1.0_wp - fac_dt ) * rad_sw_in_dif_f%var1d(tm)                               &
-                     + fac_dt * rad_sw_in_dif_f%var1d(t)
-
-          IF ( ALLOCATED( rad_sw_in_diff ) )  rad_sw_in_diff = sw_in_dif
-          IF ( ALLOCATED( rad_sw_in_dir  ) )  rad_sw_in_dir  = sw_in - sw_in_dif
-!
-!--       Diffuse longwave radiation equals the total downwelling longwave radiation
-          IF ( ALLOCATED( rad_lw_in_diff ) )  rad_lw_in_diff = lw_in
-       ENDIF
-!
-!-- level-of-detail = 2
-    ELSE
-
-       DO  m = 1, surf%ns
-          i = surf%i(m)
-          j = surf%j(m)
-          k = surf%k(m)
-
-          surf%rad_sw_in(m) = ( 1.0_wp - fac_dt ) * rad_sw_in_f%var3d(tm,j,i)                      &
-                              + fac_dt * rad_sw_in_f%var3d(t,j,i)
-!
-!--       Limit shortwave incoming radiation to positive values, in order to overcome possible
-!--       observation errors.
-          surf%rad_sw_in(m) = MAX( 0.0_wp, surf%rad_sw_in(m) )
-          surf%rad_sw_in(m) = MERGE( surf%rad_sw_in(m), 0.0_wp, sun_up )
-
-          surf%rad_lw_in(m) = ( 1.0_wp - fac_dt ) * rad_lw_in_f%var3d(tm,j,i)                      &
-                              + fac_dt * rad_lw_in_f%var3d(t,j,i)
-!
-!--       Weighted average according to surface fraction.
-          surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall)  * surf%albedo(m,ind_veg_wall)          &
-                               + surf%frac(m,ind_pav_green) * surf%albedo(m,ind_pav_green)         &
-                               + surf%frac(m,ind_wat_win)   * surf%albedo(m,ind_wat_win) )         &
-                               * surf%rad_sw_in(m)
-
-          surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall)  * surf%emissivity(m,ind_veg_wall)      &
-                               + surf%frac(m,ind_pav_green) * surf%emissivity(m,ind_pav_green)     &
-                               + surf%frac(m,ind_wat_win)   * surf%emissivity(m,ind_wat_win) )     &
-                               * sigma_sb * ( surf%pt_surface(m) * exner(k) )**4
-
-          surf%rad_lw_out_change_0(m) = ( surf%frac(m,ind_veg_wall) *                              &
-                                          surf%emissivity(m,ind_veg_wall)                          &
-                                        + surf%frac(m,ind_pav_green) *                             &
-                                          surf%emissivity(m,ind_pav_green)                         &
-                                        + surf%frac(m,ind_wat_win) *                               &
-                                          surf%emissivity(m,ind_wat_win) ) * 4.0_wp * sigma_sb     &
-                                        * ( surf%pt_surface(m) * exner(k) )**3
-
-          surf%rad_net(m) = surf%rad_sw_in(m) - surf%rad_sw_out(m) + surf%rad_lw_in(m) -           &
-                            surf%rad_lw_out(m)
-!
-!--       If diffuse shortwave radiation is available, store it on the respective files.
-          IF ( rad_sw_in_dif_f%from_file )  THEN
-             IF ( ALLOCATED( rad_sw_in_diff ) )                                                    &
-                rad_sw_in_diff(j,i) = ( 1.0_wp - fac_dt ) * rad_sw_in_dif_f%var3d(tm,j,i)          &
-                                      + fac_dt * rad_sw_in_dif_f%var3d(t,j,i)
-!
-!--          dir = sw_in - sw_in_dif.
-             IF ( ALLOCATED( rad_sw_in_dir  ) )                                                    &
-                rad_sw_in_dir(j,i)  = surf%rad_sw_in(m) - rad_sw_in_diff(j,i)
-!
-!--          Diffuse longwave radiation equals the total downwelling longwave radiation
-             IF ( ALLOCATED( rad_lw_in_diff ) )  rad_lw_in_diff(j,i) = surf%rad_lw_in(m)
-          ENDIF
-
-       ENDDO
-
-    ENDIF
-!
-!-- Store radiation also on 2D arrays, which are still used for direct-diffuse splitting. Note,
-!-- this is only required for horizontal surfaces, which covers all x,y position.
-    IF ( horizontal )  THEN
-       DO  m = 1, surf%ns
-          i = surf%i(m)
-          j = surf%j(m)
-
-          rad_sw_in(0,j,i)  = surf%rad_sw_in(m)
-          rad_lw_in(0,j,i)  = surf%rad_lw_in(m)
-          rad_sw_out(0,j,i) = surf%rad_sw_out(m)
-          rad_lw_out(0,j,i) = surf%rad_lw_out(m)
-       ENDDO
-    ENDIF
-
- END SUBROUTINE radiation_external_surf
-
- END SUBROUTINE radiation_external
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> A simple clear sky radiation model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_clearsky
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  l  !< running index for surface orientation
-
-    LOGICAL ::  horizontal  !< flag indicating treatment of horinzontal surfaces
-
-    REAL(wp) ::  pt1    !< potential temperature at first grid level or mean value at urban layer top
-    REAL(wp) ::  pt1_l  !< potential temperature at first grid level or mean value at urban layer top at local subdomain
-    REAL(wp) ::  ql1    !< liquid water mixing ratio at first grid level or mean value at urban layer top
-    REAL(wp) ::  ql1_l  !< liquid water mixing ratio at first grid level or mean value at urban layer top at local subdomain
-
-    TYPE(surf_type), POINTER ::  surf  !< pointer on respective surface type, used to generalize routine
-
-!
-!-- Calculate current zenith angle
-    CALL get_date_time( time_since_reference_point, day_of_year = day_of_year,                     &
-                        second_of_day = second_of_day )
-    CALL calc_zenith( day_of_year, second_of_day )
-
-!
-!-- Calculate sky transmissivity
-    sky_trans = 0.6_wp + 0.2_wp * cos_zenith
-
-!
-!-- Calculate value of the Exner function at model surface
-!
-!-- In case averaged radiation is used, calculate mean temperature and liquid water mixing ratio at
-!-- the urban-layer top.
-    IF ( average_radiation )  THEN
-       pt1 = 0.0_wp
-       IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1 = 0.0_wp
-
-       pt1_l = SUM( pt(nz_urban_t,nys:nyn,nxl:nxr) )
-       IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1_l = SUM( ql(nz_urban_t,nys:nyn,nxl:nxr) )
-
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( pt1_l, pt1, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_ALLREDUCE1:', ierr, pt1_l, pt1
-           FLUSH( 9 )
-       ENDIF
-
-       IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
-           CALL MPI_ALLREDUCE( ql1_l, ql1, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-           IF ( ierr /= 0 )  THEN
-               WRITE( 9, * ) 'Error MPI_ALLREDUCE2:', ierr, ql1_l, ql1
-               FLUSH( 9 )
-           ENDIF
-       ENDIF
-#else
-       pt1 = pt1_l
-       IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1 = ql1_l
-#endif
-
-       IF ( bulk_cloud_model  .OR.  cloud_droplets )  pt1 = pt1 + lv_d_cp / exner(nz_urban_t) * ql1
-!
-!--    Finally, divide by number of grid points
-       pt1 = pt1 / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )
-    ENDIF
-!
-!-- Call clear-sky calculation for each surface orientation.
-!-- First, horizontal surfaces
-    horizontal = .TRUE.
-    DO  l = 0, 1
-       surf => surf_lsm_h(l)
-       CALL radiation_clearsky_surf
-       surf => surf_usm_h(l)
-       CALL radiation_clearsky_surf
-    ENDDO
-    horizontal = .FALSE.
-!
-!-- Vertical surfaces
-    DO  l = 0, 3
-       surf => surf_lsm_v(l)
-       CALL radiation_clearsky_surf
-       surf => surf_usm_v(l)
-       CALL radiation_clearsky_surf
-    ENDDO
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Todo: Subroutine description missing.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_clearsky_surf
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< index x-direction
-    INTEGER(iwp) ::  j  !< index y-direction
-    INTEGER(iwp) ::  k  !< index z-direction
-    INTEGER(iwp) ::  m  !< running index for surface elements
-
-    IF ( surf%ns < 1 )  RETURN
-
-!
-!-- Calculate radiation fluxes and net radiation (rad_net) assuming homogeneous urban radiation
-!-- conditions.
-    IF ( average_radiation )  THEN
-
-       k = nz_urban_t
-
-       surf%rad_sw_in  = solar_constant * sky_trans * cos_zenith
-       surf%rad_sw_out = albedo_urb * surf%rad_sw_in
-
-       surf%rad_lw_in  = emissivity_atm_clsky * sigma_sb * ( pt1 * exner(k+1) )**4
-
-       surf%rad_lw_out = emissivity_urb * sigma_sb * ( t_rad_urb )**4 *                            &
-                         ( 1.0_wp - emissivity_urb ) * surf%rad_lw_in
-
-       surf%rad_net = surf%rad_sw_in - surf%rad_sw_out + surf%rad_lw_in - surf%rad_lw_out
-
-       surf%rad_lw_out_change_0 = 4.0_wp * emissivity_urb * sigma_sb * ( t_rad_urb )**3
-
-!
-!-- Calculate radiation fluxes and net radiation (rad_net) for each surface element.
-    ELSE
-
-       DO  m = 1, surf%ns
-          i = surf%i(m)
-          j = surf%j(m)
-          k = surf%k(m)
-
-          surf%rad_sw_in(m) = solar_constant * sky_trans * cos_zenith
-
-!
-!--       Weighted average according to surface fraction.
-!--       ATTENTION: when radiation interactions are switched on the calculated fluxes below are not
-!--       actually used as they are overwritten in radiation_interaction.
-          surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall)  * surf%albedo(m,ind_veg_wall)          &
-                               + surf%frac(m,ind_pav_green) * surf%albedo(m,ind_pav_green)         &
-                               + surf%frac(m,ind_wat_win)   * surf%albedo(m,ind_wat_win) )         &
-                               * surf%rad_sw_in(m)
-
-          surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall)  * surf%emissivity(m,ind_veg_wall)      &
-                               + surf%frac(m,ind_pav_green) * surf%emissivity(m,ind_pav_green)     &
-                               + surf%frac(m,ind_wat_win)   * surf%emissivity(m,ind_wat_win) )     &
-                               * sigma_sb * ( surf%pt_surface(m) * exner(nzb) )**4
-
-          surf%rad_lw_out_change_0(m) = ( surf%frac(m,ind_veg_wall)  *                             &
-                                          surf%emissivity(m,ind_veg_wall)                          &
-                                        + surf%frac(m,ind_pav_green) *                             &
-                                          surf%emissivity(m,ind_pav_green)                         &
-                                        + surf%frac(m,ind_wat_win)   *                             &
-                                          surf%emissivity(m,ind_wat_win) ) * 4.0_wp * sigma_sb     &
-                                        * ( surf%pt_surface(m) * exner(nzb) )** 3
-
-
-          IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
-             pt1 = pt(k,j,i) + lv_d_cp / exner(k) * ql(k,j,i)
-             surf%rad_lw_in(m) = emissivity_atm_clsky * sigma_sb * ( pt1 * exner(k) )**4
-          ELSE
-             surf%rad_lw_in(m) = emissivity_atm_clsky * sigma_sb * ( pt(k,j,i) * exner(k) )**4
-          ENDIF
-
-          surf%rad_net(m) = surf%rad_sw_in(m) - surf%rad_sw_out(m) + surf%rad_lw_in(m) -           &
-                            surf%rad_lw_out(m)
-
-       ENDDO
-
-    ENDIF
-
-!
-!-- Fill out values in radiation arrays. Note, this is only required for horizontal surfaces, which
-!-- covers all x,y position.
-    IF ( horizontal )  THEN
-       DO  m = 1, surf%ns
-          i = surf%i(m)
-          j = surf%j(m)
-          rad_sw_in(0,j,i)  = surf%rad_sw_in(m)
-          rad_sw_out(0,j,i) = surf%rad_sw_out(m)
-          rad_lw_in(0,j,i)  = surf%rad_lw_in(m)
-          rad_lw_out(0,j,i) = surf%rad_lw_out(m)
-       ENDDO
-    ENDIF
-
- END SUBROUTINE radiation_clearsky_surf
-
- END SUBROUTINE radiation_clearsky
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This scheme keeps the prescribed net radiation constant during the run
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_constant
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  l  !< running index for surface orientation
-
-    LOGICAL ::  horizontal  !< flag indicating treatment of horinzontal surfaces
-
-    REAL(wp) ::  pt1    !< potential temperature at first grid level or mean value at urban layer top
-    REAL(wp) ::  pt1_l  !< potential temperature at first grid level or mean value at urban layer top at local subdomain
-    REAL(wp) ::  ql1    !< liquid water mixing ratio at first grid level or mean value at urban layer top
-    REAL(wp) ::  ql1_l  !< liquid water mixing ratio at first grid level or mean value at urban layer top at local subdomain
-
-    TYPE(surf_type), POINTER ::  surf  !< pointer on respective surface type, used to generalize routine
-
-!
-!-- In case averaged radiation is used, calculate mean temperature and liquid water mixing ratio at
-!-- the urban-layer top.
-    IF ( average_radiation )  THEN
-       pt1 = 0.0_wp
-       IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1 = 0.0_wp
-
-       pt1_l = SUM( pt(nz_urban_t,nys:nyn,nxl:nxr) )
-       IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1_l = SUM( ql(nz_urban_t,nys:nyn,nxl:nxr) )
-
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( pt1_l, pt1, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_ALLREDUCE3:', ierr, pt1_l, pt1
-           FLUSH( 9 )
-       ENDIF
-       IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
-          CALL MPI_ALLREDUCE( ql1_l, ql1, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-          IF ( ierr /= 0 ) THEN
-              WRITE( 9, * ) 'Error MPI_ALLREDUCE4:', ierr, ql1_l, ql1
-              FLUSH( 9 )
-          ENDIF
-       ENDIF
-#else
-       pt1 = pt1_l
-       IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1 = ql1_l
-#endif
-       IF ( bulk_cloud_model  .OR.  cloud_droplets )  pt1 = pt1 + lv_d_cp / exner(nz_urban_t+1) *  &
-                                                            ql1
-!
-!--    Finally, divide by number of grid points
-       pt1 = pt1 / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )
-    ENDIF
-
-!
-!-- First, horizontal surfaces
-    horizontal = .TRUE.
-    DO  l = 0, 1
-       surf => surf_lsm_h(l)
-       CALL radiation_constant_surf
-       surf => surf_usm_h(l)
-       CALL radiation_constant_surf
-    ENDDO
-    horizontal = .FALSE.
-!
-!-- Vertical surfaces
-    DO  l = 0, 3
-       surf => surf_lsm_v(l)
-       CALL radiation_constant_surf
-       surf => surf_usm_v(l)
-       CALL radiation_constant_surf
-    ENDDO
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Todo: Subroutine description missing!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_constant_surf
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !< index x-direction
-    INTEGER(iwp) ::  ioff  !< offset between surface element and adjacent grid point along x
-    INTEGER(iwp) ::  j     !< index y-direction
-    INTEGER(iwp) ::  joff  !< offset between surface element and adjacent grid point along y
-    INTEGER(iwp) ::  k     !< index z-direction
-    INTEGER(iwp) ::  koff  !< offset between surface element and adjacent grid point along z
-    INTEGER(iwp) ::  m     !< running index for surface elements
-
-    IF ( surf%ns < 1 )  RETURN
-
-!-- Calculate homogenoeus urban radiation fluxes
-    IF ( average_radiation )  THEN
-
-       surf%rad_net = net_radiation
-
-       surf%rad_lw_in = emissivity_atm_clsky * sigma_sb * ( pt1 * exner(nz_urban_t+1) )**4
-
-       surf%rad_lw_out = emissivity_urb * sigma_sb * ( t_rad_urb )**4                              &
-                         + ( 1.0_wp - emissivity_urb ) & ! Shouldn't this be a bulk value -- emissivity_urb?
-                         * surf%rad_lw_in
-
-       surf%rad_lw_out_change_0 = 4.0_wp * emissivity_urb * sigma_sb * t_rad_urb**3
-
-       surf%rad_sw_in = ( surf%rad_net - surf%rad_lw_in + surf%rad_lw_out ) /                      &
-                        ( 1.0_wp - albedo_urb )
-
-       surf%rad_sw_out = albedo_urb * surf%rad_sw_in
-
-!
-!-- Calculate radiation fluxes for each surface element
-    ELSE
-!
-!--    Determine index offset between surface element and adjacent atmospheric grid point
-       ioff = surf%ioff
-       joff = surf%joff
-       koff = surf%koff
-
-!
-!--    Prescribe net radiation and estimate the remaining radiative fluxes
-       DO  m = 1, surf%ns
-          i = surf%i(m)
-          j = surf%j(m)
-          k = surf%k(m)
-
-          surf%rad_net(m) = net_radiation
-
-          IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
-             pt1 = pt(k,j,i) + lv_d_cp / exner(k) * ql(k,j,i)
-             surf%rad_lw_in(m) = emissivity_atm_clsky * sigma_sb * ( pt1 * exner(k) )**4
-          ELSE
-             surf%rad_lw_in(m) = emissivity_atm_clsky * sigma_sb * ( pt(k,j,i) * exner(k) )**4
-          ENDIF
-
-!
-!--       Weighted average according to surface fraction.
-          surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall)  * surf%emissivity(m,ind_veg_wall)      &
-                               + surf%frac(m,ind_pav_green) * surf%emissivity(m,ind_pav_green)     &
-                               + surf%frac(m,ind_wat_win)   * surf%emissivity(m,ind_wat_win) )     &
-                               * sigma_sb * ( surf%pt_surface(m) * exner(nzb) )**4
-
-          surf%rad_sw_in(m) = ( surf%rad_net(m) - surf%rad_lw_in(m) + surf%rad_lw_out(m) )         &
-                              / ( 1.0_wp - ( surf%frac(m,ind_veg_wall) *                           &
-                                             surf%albedo(m,ind_veg_wall)                           &
-                                           + surf%frac(m,ind_pav_green) *                          &
-                                             surf%albedo(m,ind_pav_green)                          &
-                                           + surf%frac(m,ind_wat_win) *                            &
-                                             surf%albedo(m,ind_wat_win)                            &
-                                           )                                                       &
-                                )
-
-          surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall)  * surf%albedo(m,ind_veg_wall)          &
-                               + surf%frac(m,ind_pav_green) * surf%albedo(m,ind_pav_green)         &
-                               + surf%frac(m,ind_wat_win)   * surf%albedo(m,ind_wat_win) )         &
-                               * surf%rad_sw_in(m)
-
-       ENDDO
-
-    ENDIF
-
-!
-!-- Fill out values in radiation arrays. Note, this is only required for horizontal surfaces, which
-!-- covers all x,y position.
-    IF ( horizontal )  THEN
-       DO  m = 1, surf%ns
-          i = surf%i(m)
-          j = surf%j(m)
-          rad_sw_in(0,j,i)  = surf%rad_sw_in(m)
-          rad_sw_out(0,j,i) = surf%rad_sw_out(m)
-          rad_lw_in(0,j,i)  = surf%rad_lw_in(m)
-          rad_lw_out(0,j,i) = surf%rad_lw_out(m)
-       ENDDO
-    ENDIF
-
- END SUBROUTINE radiation_constant_surf
-
-
- END SUBROUTINE radiation_constant
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for radiation model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_header ( io )
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  io  !< Unit of the output file
-
-
-!
-!-- Write radiation model header
-    WRITE( io, 3 )
-
-    IF ( radiation_scheme == 'constant' )  THEN
-       WRITE( io, 4 ) net_radiation
-    ELSEIF ( radiation_scheme == 'clear-sky' )  THEN
-       WRITE( io, 5 )
-    ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
-       WRITE( io, 6 )
-       IF ( .NOT. lw_radiation )  WRITE( io, 10 )
-       IF ( .NOT. sw_radiation )  WRITE( io, 11 )
-    ELSEIF ( radiation_scheme == 'external' )  THEN
-       WRITE( io, 14 )
-    ENDIF
-
-    IF ( albedo_type_f%from_file    .OR.  vegetation_type_f%from_file  .OR.                        &
-         pavement_type_f%from_file  .OR.  water_type_f%from_file       .OR.                        &
-         building_type_f%from_file )  THEN
-          WRITE( io, 13 )
-    ELSE
-       IF ( albedo_type == 0 )  THEN
-          WRITE( io, 7 ) albedo
-       ELSE
-          WRITE( io, 8 ) TRIM( albedo_type_name(albedo_type) )
-       ENDIF
-    ENDIF
-    IF ( constant_albedo )  THEN
-       WRITE( io, 9 )
-    ENDIF
-
-    WRITE( io, 12 ) dt_radiation
-
-
- 3 FORMAT ( //' Radiation model information:'/ ' ----------------------------'/ )
- 4 FORMAT ( '    --> Using constant net radiation: net_radiation = ', F6.2, // 'W/m**2' )
- 5 FORMAT ( '    --> Simple radiation scheme for clear sky is used (no clouds,', ' default)' )
- 6 FORMAT ( '    --> RRTMG scheme is used' )
- 7 FORMAT ( /'    User-specific surface albedo: albedo =', F6.3 )
- 8 FORMAT ( /'    Albedo is set for land surface type: ', A )
- 9 FORMAT ( /'    --> Albedo is fixed during the run' )
-10 FORMAT ( /'    --> Longwave radiation is disabled' )
-11 FORMAT ( /'    --> Shortwave radiation is disabled.' )
-12 FORMAT ( '    Timestep: dt_radiation = ', F6.2, '  s' )
-13 FORMAT ( /'    Albedo is set individually for each xy-location, according ',                    &
-                 'to given surface type.')
-14 FORMAT ( '    --> External radiation forcing is used' )
-
-
- END SUBROUTINE radiation_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &radiation_parameters for radiation model and RTM
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_parin
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter file
-
-    INTEGER(iwp) ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /radiation_parameters/ albedo,                                                        &
-                                    albedo_lw_dif,                                                 &
-                                    albedo_lw_dir,                                                 &
-                                    albedo_sw_dif,                                                 &
-                                    albedo_sw_dir,                                                 &
-                                    albedo_type,                                                   &
-                                    bufsize_alltoall,                                              &
-                                    constant_albedo,                                               &
-                                    dt_radiation,                                                  &
-                                    emissivity,                                                    &
-                                    lw_radiation,                                                  &
-                                    max_raytracing_dist,                                           &
-                                    min_irrf_value,                                                &
-                                    mrt_geom,                                                      &
-                                    mrt_geom_params,                                               &
-                                    mrt_include_sw,                                                &
-                                    mrt_nlevels,                                                   &
-                                    mrt_skip_roof,                                                 &
-                                    net_radiation,                                                 &
-                                    nrefsteps,                                                     &
-                                    plant_lw_interact,                                             &
-                                    rad_angular_discretization,                                    &
-                                    radiation_interactions_on,                                     &
-                                    radiation_scheme,                                              &
-                                    raytrace_discrete_azims,                                       &
-                                    raytrace_discrete_elevs,                                       &
-                                    raytrace_mpi_rma,                                              &
-                                    trace_fluxes_above,                                            &
-                                    skip_time_do_radiation,                                        &
-                                    surface_reflections,                                           &
-                                    svfnorm_report_thresh,                                         &
-                                    switch_off_module,                                             &
-                                    sw_radiation,                                                  &
-                                    unscheduled_radiation_calls
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, radiation_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    radiation_parameters namelist was found and read correctly. Set flag that indicates that the
-!--    radiation model is switched on.
-       IF ( .NOT. switch_off_module )  radiation = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    radiation_parameters namelist was found but contained errors. Print an error message
-!--    including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'radiation_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE radiation_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Implementation of the RRTMG radiation_scheme
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_rrtmg
-
-#if defined ( __rrtmg )
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  hours_per_day
-
-    USE particle_attributes,                                                                       &
-        ONLY:  grid_particles,                                                                     &
-               number_of_particles,                                                                &
-               particles,                                                                          &
-               prt_count
-
-
-    IMPLICIT NONE
-
-
-    INTEGER(iwp) ::  i, j, k, l, m, n  !< loop indices
-    INTEGER(iwp) ::  k_topo_l          !< topography top index
-    INTEGER(iwp) ::  k_topo            !< topography top index
-
-    REAL(wp) ::  d_hours_day  !< 1 / hours-per-day
-    REAL(wp) ::  nc_rad, &    !< number concentration of cloud droplets
-                 s_r2,   &    !< weighted sum over all droplets with r^2
-                 s_r3         !< weighted sum over all droplets with r^3
-
-    REAL(wp), DIMENSION(0:0) ::  zenith  !< to provide indexed array
-
-    REAL(wp), DIMENSION(0:nzt+1) ::  pt_av, q_av, ql_av  !<
-
-!
-!-- Just dummy arguments
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: rrtm_lw_taucld_dum,  &  !<
-                                               rrtm_lw_tauaer_dum,  &  !<
-                                               rrtm_sw_taucld_dum,  &  !<
-                                               rrtm_sw_ssacld_dum,  &  !<
-                                               rrtm_sw_asmcld_dum,  &  !<
-                                               rrtm_sw_fsfcld_dum,  &  !<
-                                               rrtm_sw_tauaer_dum,  &  !<
-                                               rrtm_sw_ssaaer_dum,  &  !<
-                                               rrtm_sw_asmaer_dum,  &  !<
-                                               rrtm_sw_ecaer_dum       !<
-
-!
-!-- Pre-calculate parameters
-    d_hours_day = 1.0_wp / REAL( hours_per_day, KIND = wp )
-
-!
-!-- Calculate current (cosine of) zenith angle and whether the sun is up
-    CALL get_date_time( time_since_reference_point, day_of_year = day_of_year,                     &
-                        second_of_day=second_of_day )
-    CALL calc_zenith( day_of_year, second_of_day )
-    zenith(0) = cos_zenith
-!
-!-- Calculate surface albedo. In case average radiation is applied, this is not required.
-#if defined( __netcdf )
-    IF ( .NOT. constant_albedo )  THEN
-!
-!--    Horizontally aligned default, natural and urban surfaces
-       DO  l = 0, 1
-          CALL calc_albedo( surf_lsm_h(l) )
-          CALL calc_albedo( surf_usm_h(l) )
-       ENDDO
-!
-!--    Vertically aligned default, natural and urban surfaces
-       DO  l = 0, 3
-          CALL calc_albedo( surf_lsm_v(l) )
-          CALL calc_albedo( surf_usm_v(l) )
-       ENDDO
-    ENDIF
-#endif
-
-!
-!-- Prepare input data for RRTMG
-
-!
-!-- In case of large scale forcing with surface data, calculate new pressure profile. nzt_rad might
-!-- be modified by these calls and all required arrays will then be re-allocated.
-    IF ( large_scale_forcing  .AND.  lsf_surf )  THEN
-       CALL read_sounding_data
-       CALL read_trace_gas_data
-    ENDIF
-
-
-    IF ( average_radiation )  THEN
-!
-!--    Determine minimum topography top index.
-       k_topo_l = MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) )
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( k_topo_l, k_topo, 1, MPI_INTEGER, MPI_MIN, comm2d, ierr )
-#else
-       k_topo = k_topo_l
-#endif
-
-       rrtm_asdir(1) = albedo_urb
-       rrtm_asdif(1) = albedo_urb
-       rrtm_aldir(1) = albedo_urb
-       rrtm_aldif(1) = albedo_urb
-
-       rrtm_emis = emissivity_urb
-!
-!--    Calculate mean pt profile.
-       CALL calc_mean_profile( pt, 4, .TRUE. )
-       pt_av = hom(:, 1, 4, 0)
-
-       IF ( humidity )  THEN
-          CALL calc_mean_profile( q, 41, .TRUE. )
-          q_av  = hom(:, 1, 41, 0)
-       ENDIF
-!
-!--    Prepare profiles of temperature and H2O volume mixing ratio
-       rrtm_tlev(0,k_topo+1) = t_rad_urb
-
-       IF ( bulk_cloud_model )  THEN
-
-          CALL calc_mean_profile( ql, 54, .TRUE. )
-          ! Average ql is now in hom(:, 1, 54, 0)
-          ql_av = hom(:, 1, 54, 0)
-
-          DO  k = nzb+1, nzt+1
-             rrtm_tlay(0,k) = pt_av(k) * ( (hyp(k) ) / 100000._wp )**.286_wp + lv_d_cp * ql_av(k)
-             rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * ( q_av(k) - ql_av(k) )
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt+1
-             rrtm_tlay(0,k) = pt_av(k) * ( (hyp(k) ) / 100000._wp )**.286_wp
-          ENDDO
-
-          IF ( humidity )  THEN
-             DO  k = nzb+1, nzt+1
-                rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * q_av(k)
-             ENDDO
-          ELSE
-             rrtm_h2ovmr(0,nzb+1:nzt+1) = 0.0_wp
-          ENDIF
-       ENDIF
-
-!
-!--    Avoid temperature/humidity jumps at the top of the PALM domain by linear interpolation from
-!--    nzt+2 to nzt+7. Jumps are induced by discrepancies between the values in the domain and
-!--    those above that are prescribed in RRTMG.
-       DO  k = nzt+2, nzt+7
-          rrtm_tlay(0,k) = rrtm_tlay(0,nzt+1) + ( rrtm_tlay(0,nzt+8) - rrtm_tlay(0,nzt+1) ) /      &
-                           ( rrtm_play(0,nzt+8) - rrtm_play(0,nzt+1) ) *                           &
-                           ( rrtm_play(0,k) - rrtm_play(0,nzt+1) )
-
-          rrtm_h2ovmr(0,k) = rrtm_h2ovmr(0,nzt+1) + ( rrtm_h2ovmr(0,nzt+8) -                       &
-                                                      rrtm_h2ovmr(0,nzt+1) ) /                     &
-                             ( rrtm_play(0,nzt+8) - rrtm_play(0,nzt+1) ) *                         &
-                             ( rrtm_play(0,k) - rrtm_play(0,nzt+1) )
-
-       ENDDO
-
-!--    Linear interpolation to zw grid. Loop reaches one level further up due to the staggered grid
-!--    in RRTMG.
-       DO  k = k_topo+2, nzt+8
-          rrtm_tlev(0,k) = rrtm_tlay(0,k-1) + ( rrtm_tlay(0,k) - rrtm_tlay(0,k-1) ) /              &
-                           ( rrtm_play(0,k) - rrtm_play(0,k-1) ) *                                 &
-                           ( rrtm_plev(0,k) - rrtm_play(0,k-1) )
-       ENDDO
-!
-!--    Calculate liquid water path and cloud fraction for each column.
-!--    Note that LWP is required in g/m2 instead of kg/kg m.
-       rrtm_cldfr  = 0.0_wp
-       rrtm_reliq  = 0.0_wp
-       rrtm_cliqwp = 0.0_wp
-       rrtm_icld   = 0
-
-       IF ( bulk_cloud_model )  THEN
-          DO  k = nzb+1, nzt+1
-             rrtm_cliqwp(0,k) =  ql_av(k) * 1000._wp * ( rrtm_plev(0,k) - rrtm_plev(0,k+1) ) *     &
-                                 100._wp / g
-
-             IF ( rrtm_cliqwp(0,k) > 0._wp )  THEN
-                rrtm_cldfr(0,k) = 1._wp
-                IF ( rrtm_icld == 0 )  rrtm_icld = 1
-
-!
-!--             Calculate cloud droplet effective radius
-                rrtm_reliq(0,k) = 1.0E6_wp * ( 3.0_wp * ql_av(k) * rho_surface /                   &
-                                  ( 4.0_wp * pi * nc_const * rho_l ) )**0.33333333333333_wp        &
-                                  * EXP( LOG( sigma_gc )**2 )
-!
-!--             Limit effective radius
-                IF ( rrtm_reliq(0,k) > 0.0_wp )  THEN
-                   rrtm_reliq(0,k) = MAX( rrtm_reliq(0,k), 2.5_wp )
-                   rrtm_reliq(0,k) = MIN( rrtm_reliq(0,k), 60.0_wp )
-                ENDIF
-             ENDIF
-          ENDDO
-       ENDIF
-
-!
-!--    Set surface temperature
-       rrtm_tsfc = t_rad_urb
-
-       IF ( lw_radiation )  THEN
-!
-!--       Due to technical reasons, copy optical depth to dummy arguments which are allocated on the
-!--       exact size as the rrtmg_lw is called. As one dimension is allocated with zero size,
-!--       compiler complains that rank of the array does not match that of the assumed-shaped
-!--       arguments in the RRTMG library. In order to avoid this, write to dummy arguments and
-!--       pass the entire dummy array. Seems to be the only existing work-around.
-          ALLOCATE( rrtm_lw_taucld_dum(1:nbndlw+1,0:0,k_topo+1:nzt_rad+1) )
-          ALLOCATE( rrtm_lw_tauaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndlw+1) )
-
-          rrtm_lw_taucld_dum = rrtm_lw_taucld(1:nbndlw+1,0:0,k_topo+1:nzt_rad+1)
-          rrtm_lw_tauaer_dum = rrtm_lw_tauaer(0:0,k_topo+1:nzt_rad+1,1:nbndlw+1)
-
-          CALL rrtmg_lw( 1, nzt_rad-k_topo, rrtm_icld, rrtm_idrv, rrtm_play(:,k_topo+1:),          &
-                         rrtm_plev(:,k_topo+1:), rrtm_tlay(:,k_topo+1:), rrtm_tlev(:,k_topo+1:),   &
-                         rrtm_tsfc, rrtm_h2ovmr(:,k_topo+1:), rrtm_o3vmr(:,k_topo+1:),             &
-                         rrtm_co2vmr(:,k_topo+1:), rrtm_ch4vmr(:,k_topo+1:),                       &
-                         rrtm_n2ovmr(:,k_topo+1:), rrtm_o2vmr(:,k_topo+1:),                        &
-                         rrtm_cfc11vmr(:,k_topo+1:), rrtm_cfc12vmr(:,k_topo+1:),                   &
-                         rrtm_cfc22vmr(:,k_topo+1:), rrtm_ccl4vmr(:,k_topo+1:), rrtm_emis,         &
-                         rrtm_inflglw, rrtm_iceflglw, rrtm_liqflglw, rrtm_cldfr(:,k_topo+1:),      &
-                         rrtm_lw_taucld_dum, rrtm_cicewp(:,k_topo+1:), rrtm_cliqwp(:,k_topo+1:),   &
-                         rrtm_reice(:,k_topo+1:), rrtm_reliq(:,k_topo+1:), rrtm_lw_tauaer_dum,     &
-                         rrtm_lwuflx(:,k_topo:), rrtm_lwdflx(:,k_topo:), rrtm_lwhr(:,k_topo+1:),   &
-                         rrtm_lwuflxc(:,k_topo:), rrtm_lwdflxc(:,k_topo:), rrtm_lwhrc(:,k_topo+1:),&
-                         rrtm_lwuflx_dt(:,k_topo:), rrtm_lwuflxc_dt(:,k_topo:) )
-
-          DEALLOCATE( rrtm_lw_taucld_dum )
-          DEALLOCATE( rrtm_lw_tauaer_dum )
-!
-!--       Save fluxes
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                k_topo_l = topo_top_ind(j,i,0)
-                DO  k = k_topo_l, nzt+1
-                   rad_lw_in(k,j,i)  = rrtm_lwdflx(0,k-k_topo_l+k_topo)
-                   rad_lw_out(k,j,i) = rrtm_lwuflx(0,k-k_topo_l+k_topo)
-                ENDDO
-             ENDDO
-          ENDDO
-          rad_lw_in_diff(:,:) = rrtm_lwdflx(0,k_topo)
-!
-!--       Save heating rates (convert from K/d to K/h).
-!--       Further, even though an aggregated radiation is computed, map signle-column profiles on
-!--       top of any topography, in order to obtain correct near surface radiation heating/cooling
-!--       rates.
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                k_topo_l = topo_top_ind(j,i,0)
-                DO  k = k_topo_l+1, nzt+1
-                   rad_lw_hr(k,j,i)    = rrtm_lwhr(0,k-k_topo_l+k_topo)  * d_hours_day
-                   rad_lw_cs_hr(k,j,i) = rrtm_lwhrc(0,k-k_topo_l+k_topo) * d_hours_day
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ENDIF
-
-       IF ( sw_radiation .AND. sun_up )  THEN
-!
-!--       Due to technical reasons, copy optical depths and other to dummy arguments which are
-!--       allocated on the exact size as the rrtmg_sw is called. As one dimesion is allocated with
-!--       zero size, compiler complains that rank of the array does not match that of the
-!--       assumed-shaped arguments in the RRTMG library. In order to avoid this, write to dummy
-!--       arguments and pass the entire dummy array. Seems to be the only existing work-around.
-          ALLOCATE( rrtm_sw_taucld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
-          ALLOCATE( rrtm_sw_ssacld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
-          ALLOCATE( rrtm_sw_asmcld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
-          ALLOCATE( rrtm_sw_fsfcld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
-          ALLOCATE( rrtm_sw_tauaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) )
-          ALLOCATE( rrtm_sw_ssaaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) )
-          ALLOCATE( rrtm_sw_asmaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) )
-          ALLOCATE( rrtm_sw_ecaer_dum(0:0,k_topo+1:nzt_rad+1,1:naerec+1)  )
-
-          rrtm_sw_taucld_dum = rrtm_sw_taucld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
-          rrtm_sw_ssacld_dum = rrtm_sw_ssacld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
-          rrtm_sw_asmcld_dum = rrtm_sw_asmcld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
-          rrtm_sw_fsfcld_dum = rrtm_sw_fsfcld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
-          rrtm_sw_tauaer_dum = rrtm_sw_tauaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1)
-          rrtm_sw_ssaaer_dum = rrtm_sw_ssaaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1)
-          rrtm_sw_asmaer_dum = rrtm_sw_asmaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1)
-          rrtm_sw_ecaer_dum  = rrtm_sw_ecaer(0:0,k_topo+1:nzt_rad+1,1:naerec+1)
-
-          CALL rrtmg_sw( 1, nzt_rad-k_topo, rrtm_icld, rrtm_iaer, rrtm_play(:,k_topo+1:nzt_rad+1), &
-                         rrtm_plev(:,k_topo+1:nzt_rad+2), rrtm_tlay(:,k_topo+1:nzt_rad+1),         &
-                         rrtm_tlev(:,k_topo+1:nzt_rad+2), rrtm_tsfc,                               &
-                         rrtm_h2ovmr(:,k_topo+1:nzt_rad+1), rrtm_o3vmr(:,k_topo+1:nzt_rad+1),      &
-                         rrtm_co2vmr(:,k_topo+1:nzt_rad+1), rrtm_ch4vmr(:,k_topo+1:nzt_rad+1),     &
-                         rrtm_n2ovmr(:,k_topo+1:nzt_rad+1), rrtm_o2vmr(:,k_topo+1:nzt_rad+1),      &
-                         rrtm_asdir, rrtm_asdif, rrtm_aldir, rrtm_aldif, zenith, 0.0_wp,           &
-                         day_of_year, solar_constant, rrtm_inflgsw, rrtm_iceflgsw, rrtm_liqflgsw,  &
-                         rrtm_cldfr(:,k_topo+1:nzt_rad+1), rrtm_sw_taucld_dum, rrtm_sw_ssacld_dum, &
-                         rrtm_sw_asmcld_dum, rrtm_sw_fsfcld_dum, rrtm_cicewp(:,k_topo+1:nzt_rad+1),&
-                         rrtm_cliqwp(:,k_topo+1:nzt_rad+1), rrtm_reice(:,k_topo+1:nzt_rad+1),      &
-                         rrtm_reliq(:,k_topo+1:nzt_rad+1), rrtm_sw_tauaer_dum,                     &
-                         rrtm_sw_ssaaer_dum, rrtm_sw_asmaer_dum, rrtm_sw_ecaer_dum,                &
-                         rrtm_swuflx(:,k_topo:nzt_rad+1), rrtm_swdflx(:,k_topo:nzt_rad+1),         &
-                         rrtm_swhr(:,k_topo+1:nzt_rad+1), rrtm_swuflxc(:,k_topo:nzt_rad+1),        &
-                         rrtm_swdflxc(:,k_topo:nzt_rad+1), rrtm_swhrc(:,k_topo+1:nzt_rad+1),       &
-                         rrtm_dirdflux(:,k_topo:nzt_rad+1), rrtm_difdflux(:,k_topo:nzt_rad+1) )
-
-          DEALLOCATE( rrtm_sw_taucld_dum )
-          DEALLOCATE( rrtm_sw_ssacld_dum )
-          DEALLOCATE( rrtm_sw_asmcld_dum )
-          DEALLOCATE( rrtm_sw_fsfcld_dum )
-          DEALLOCATE( rrtm_sw_tauaer_dum )
-          DEALLOCATE( rrtm_sw_ssaaer_dum )
-          DEALLOCATE( rrtm_sw_asmaer_dum )
-          DEALLOCATE( rrtm_sw_ecaer_dum )
-
-!
-!--       Save radiation fluxes for the entire depth of the model domain
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                k_topo_l = topo_top_ind(j,i,0)
-                DO  k = k_topo_l, nzt+1
-                   rad_sw_in(k,j,i)  = rrtm_swdflx(0,k-k_topo_l+k_topo)
-                   rad_sw_out(k,j,i) = rrtm_swuflx(0,k-k_topo_l+k_topo)
-                ENDDO
-             ENDDO
-          ENDDO
-!--       Save direct and diffuse SW radiation at the surface (required by RTM)
-          rad_sw_in_dir(:,:) = rrtm_dirdflux(0,k_topo)
-          rad_sw_in_diff(:,:) = rrtm_difdflux(0,k_topo)
-
-!
-!--       Save heating rates (convert from K/d to K/s)
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                k_topo_l = topo_top_ind(j,i,0)
-                DO  k = k_topo_l+1, nzt+1
-                   rad_sw_hr(k,j,i)    = rrtm_swhr(0,k-k_topo_l+k_topo)  * d_hours_day
-                   rad_sw_cs_hr(k,j,i) = rrtm_swhrc(0,k-k_topo_l+k_topo) * d_hours_day
-                ENDDO
-             ENDDO
-          ENDDO
-!
-!--    Solar radiation is zero during night
-       ELSE
-          rad_sw_in  = 0.0_wp
-          rad_sw_out = 0.0_wp
-          rad_sw_in_dir(:,:) = 0.0_wp
-          rad_sw_in_diff(:,:) = 0.0_wp
-       ENDIF
-!
-!-- RRTMG is called for each (j,i) grid point separately, starting at the highest topography level.
-!-- Here no RTM is used since average_radiation is false. In fact, this branch is only called for
-!-- homogeneous flat terrain so that the topography-top index is actually always zero.
-    ELSE
-!
-!--    Loop over all grid points
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-
-!
-!--          Prepare profiles of temperature and H2O volume mixing ratio
-             DO  m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                rrtm_tlev(0,nzb+1) = surf_lsm_h(0)%pt_surface(m) * exner(nzb)
-             ENDDO
-             DO  m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                rrtm_tlev(0,nzb+1) = surf_usm_h(0)%pt_surface(m) * exner(nzb)
-             ENDDO
-
-
-             IF ( bulk_cloud_model )  THEN
-                DO  k = nzb+1, nzt+1
-                   rrtm_tlay(0,k) = pt(k,j,i) * exner(k) + lv_d_cp * ql(k,j,i)
-                   rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * (q(k,j,i) - ql(k,j,i))
-                ENDDO
-             ELSEIF ( cloud_droplets )  THEN
-                DO  k = nzb+1, nzt+1
-                   rrtm_tlay(0,k) = pt(k,j,i) * exner(k) + lv_d_cp * ql(k,j,i)
-                   rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * q(k,j,i)
-                ENDDO
-             ELSE
-                DO  k = nzb+1, nzt+1
-                   rrtm_tlay(0,k) = pt(k,j,i) * exner(k)
-                ENDDO
-
-                IF ( humidity )  THEN
-                   DO  k = nzb+1, nzt+1
-                      rrtm_h2ovmr(0,k) =  mol_mass_air_d_wv * q(k,j,i)
-                   ENDDO
-                ELSE
-                   rrtm_h2ovmr(0,nzb+1:nzt+1) = 0.0_wp
-                ENDIF
-             ENDIF
-
-!
-!--          Avoid temperature/humidity jumps at the top of the LES domain by linear interpolation
-!--          from nzt+2 to nzt+7
-             DO  k = nzt+2, nzt+7
-                rrtm_tlay(0,k) = rrtm_tlay(0,nzt+1) + ( rrtm_tlay(0,nzt+8) - rrtm_tlay(0,nzt+1) ) /&
-                               ( rrtm_play(0,nzt+8) - rrtm_play(0,nzt+1) ) *                       &
-                               ( rrtm_play(0,k)     - rrtm_play(0,nzt+1) )
-
-                rrtm_h2ovmr(0,k) = rrtm_h2ovmr(0,nzt+1) +                                          &
-                                 ( rrtm_h2ovmr(0,nzt+8) - rrtm_h2ovmr(0,nzt+1) ) /                 &
-                                 ( rrtm_play(0,nzt+8)   - rrtm_play(0,nzt+1)   ) *                 &
-                                 ( rrtm_play(0,k)       - rrtm_play(0,nzt+1) )
-
-             ENDDO
-
-!--          Linear interpolation to zw grid
-             DO  k = nzb+2, nzt+8
-                rrtm_tlev(0,k) = rrtm_tlay(0,k-1) + (rrtm_tlay(0,k) - rrtm_tlay(0,k-1) ) /         &
-                               ( rrtm_play(0,k) - rrtm_play(0,k-1) ) *                             &
-                               ( rrtm_plev(0,k) - rrtm_play(0,k-1) )
-             ENDDO
-
-
-!
-!--          Calculate liquid water path and cloud fraction for each column.
-!--          Note that LWP is required in g/m2 instead of kg/kg m.
-             rrtm_cldfr  = 0.0_wp
-             rrtm_reliq  = 0.0_wp
-             rrtm_cliqwp = 0.0_wp
-             rrtm_icld   = 0
-
-             IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
-                DO  k = nzb+1, nzt+1
-                   rrtm_cliqwp(0,k) =  ql(k,j,i) * 1000.0_wp *                                     &
-                                     ( rrtm_plev(0,k) - rrtm_plev(0,k+1) ) * 100.0_wp / g
-
-                   IF ( rrtm_cliqwp(0,k) > 0.0_wp )  THEN
-                      rrtm_cldfr(0,k) = 1.0_wp
-                      IF ( rrtm_icld == 0 )  rrtm_icld = 1
-
-!
-!--                   Calculate cloud droplet effective radius
-                      IF ( bulk_cloud_model )  THEN
-!
-!--                      Calculate effective droplet radius. In case of using cloud_scheme =
-!--                      'morrison' and a non reasonable number of cloud droplets the inital aerosol
-!--                      number concentration is considered.
-                         IF ( microphysics_morrison )  THEN
-                            IF ( nc(k,j,i) > 1.0E-20_wp )  THEN
-                               nc_rad = nc(k,j,i)
-                            ELSE
-                               nc_rad = na_init
-                            ENDIF
-                         ELSE
-                            nc_rad = nc_const
-                         ENDIF
-
-                         rrtm_reliq(0,k) = 1.0E6_wp * ( 3.0_wp * ql(k,j,i) * rho_surface /         &
-                                         ( 4.0_wp * pi * nc_rad * rho_l ) )**0.33333333333333_wp * &
-                                           EXP( LOG( sigma_gc )**2 )
-
-                      ELSEIF ( cloud_droplets )  THEN
-                         number_of_particles = prt_count(k,j,i)
-
-                         IF (number_of_particles <= 0)  CYCLE
-                         particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                         s_r2 = 0.0_wp
-                         s_r3 = 0.0_wp
-
-                         DO  n = 1, number_of_particles
-                            IF ( particles(n)%particle_mask )  THEN
-                               s_r2 = s_r2 + particles(n)%radius**2 * particles(n)%weight_factor
-                               s_r3 = s_r3 + particles(n)%radius**3 * particles(n)%weight_factor
-                            ENDIF
-                         ENDDO
-
-                         IF ( s_r2 > 0.0_wp )  rrtm_reliq(0,k) = s_r3 / s_r2
-
-                      ENDIF
-
-!
-!--                   Limit effective radius
-                      IF ( rrtm_reliq(0,k) > 0.0_wp )  THEN
-                         rrtm_reliq(0,k) = MAX( rrtm_reliq(0,k), 2.5_wp )
-                         rrtm_reliq(0,k) = MIN( rrtm_reliq(0,k), 60.0_wp )
-                     ENDIF
-                   ENDIF
-                ENDDO
-             ENDIF
-
-!
-!--          Write surface emissivity and surface temperature at current surface element on
-!--          RRTMG-shaped array. Please note, as RRTMG is a single column model, surface attributes
-!--          are only obtained from upward facing horizontally aligned surfaces (for simplicity).
-!--          Taking surface attributes from horizontal and vertical walls would lead to multiple
-!--          solutions. Moreover, for natural- and urban-type surfaces, several surface classes can
-!--          exist at a surface element next to each other. To obtain bulk parameters, apply a
-!--          weighted average for these surfaces.
-             DO  m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                rrtm_emis = surf_lsm_h(0)%frac(m,ind_veg_wall) *                                   &
-                            surf_lsm_h(0)%emissivity(m,ind_veg_wall) +                             &
-                            surf_lsm_h(0)%frac(m,ind_pav_green) *                                  &
-                            surf_lsm_h(0)%emissivity(m,ind_pav_green) +                            &
-                            surf_lsm_h(0)%frac(m,ind_wat_win) *                                    &
-                            surf_lsm_h(0)%emissivity(m,ind_wat_win)
-                rrtm_tsfc = surf_lsm_h(0)%pt_surface(m) * exner(nzb)
-             ENDDO
-             DO  m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                rrtm_emis = surf_usm_h(0)%frac(m,ind_veg_wall) *                                   &
-                            surf_usm_h(0)%emissivity(m,ind_veg_wall) +                             &
-                            surf_usm_h(0)%frac(m,ind_pav_green) *                                  &
-                            surf_usm_h(0)%emissivity(m,ind_pav_green) +                            &
-                            surf_usm_h(0)%frac(m,ind_wat_win) *                                    &
-                            surf_usm_h(0)%emissivity(m,ind_wat_win)
-                rrtm_tsfc = surf_usm_h(0)%pt_surface(m) * exner(nzb)
-             ENDDO
-!
-!--          Obtain topography top index (lower bound of RRTMG). Is actually always zero.
-             k_topo = topo_top_ind(j,i,0)
-
-             IF ( lw_radiation )  THEN
-!
-!--             Due to technical reasons, copy optical depth to dummy arguments which are allocated
-!--             on the exact size as the rrtmg_lw is called. As one dimension is allocated with zero
-!--             size, compiler complains that rank of the array does not match that of the
-!--             assumed-shaped arguments in the RRTMG library. In order to avoid this, write to
-!--             dummy arguments and pass the entire dummy array. Seems to be the only existing
-!--             work-around.
-                ALLOCATE( rrtm_lw_taucld_dum(1:nbndlw+1,0:0,k_topo+1:nzt_rad+1) )
-                ALLOCATE( rrtm_lw_tauaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndlw+1) )
-
-                rrtm_lw_taucld_dum = rrtm_lw_taucld(1:nbndlw+1,0:0,k_topo+1:nzt_rad+1)
-                rrtm_lw_tauaer_dum = rrtm_lw_tauaer(0:0,k_topo+1:nzt_rad+1,1:nbndlw+1)
-
-                CALL rrtmg_lw( 1, nzt_rad-k_topo, rrtm_icld, rrtm_idrv,                            &
-                               rrtm_play(:,k_topo+1:nzt_rad+1), rrtm_plev(:,k_topo+1:nzt_rad+2),   &
-                               rrtm_tlay(:,k_topo+1:nzt_rad+1), rrtm_tlev(:,k_topo+1:nzt_rad+2),   &
-                               rrtm_tsfc, rrtm_h2ovmr(:,k_topo+1:nzt_rad+1),                       &
-                               rrtm_o3vmr(:,k_topo+1:nzt_rad+1), rrtm_co2vmr(:,k_topo+1:nzt_rad+1),&
-                               rrtm_ch4vmr(:,k_topo+1:nzt_rad+1),                                  &
-                               rrtm_n2ovmr(:,k_topo+1:nzt_rad+1),                                  &
-                               rrtm_o2vmr(:,k_topo+1:nzt_rad+1),                                   &
-                               rrtm_cfc11vmr(:,k_topo+1:nzt_rad+1),                                &
-                               rrtm_cfc12vmr(:,k_topo+1:nzt_rad+1),                                &
-                               rrtm_cfc22vmr(:,k_topo+1:nzt_rad+1),                                &
-                               rrtm_ccl4vmr(:,k_topo+1:nzt_rad+1), rrtm_emis, rrtm_inflglw,        &
-                               rrtm_iceflglw, rrtm_liqflglw, rrtm_cldfr(:,k_topo+1:nzt_rad+1),     &
-                               rrtm_lw_taucld_dum, rrtm_cicewp(:,k_topo+1:nzt_rad+1),              &
-                               rrtm_cliqwp(:,k_topo+1:nzt_rad+1), rrtm_reice(:,k_topo+1:nzt_rad+1),&
-                               rrtm_reliq(:,k_topo+1:nzt_rad+1), rrtm_lw_tauaer_dum,               &
-                               rrtm_lwuflx(:,k_topo:nzt_rad+1), rrtm_lwdflx(:,k_topo:nzt_rad+1),   &
-                               rrtm_lwhr(:,k_topo+1:nzt_rad+1), rrtm_lwuflxc(:,k_topo:nzt_rad+1),  &
-                               rrtm_lwdflxc(:,k_topo:nzt_rad+1), rrtm_lwhrc(:,k_topo+1:nzt_rad+1), &
-                               rrtm_lwuflx_dt(:,k_topo:nzt_rad+1),                                 &
-                               rrtm_lwuflxc_dt(:,k_topo:nzt_rad+1) )
-
-                DEALLOCATE( rrtm_lw_taucld_dum )
-                DEALLOCATE( rrtm_lw_tauaer_dum )
-!
-!--             Save fluxes
-                DO  k = k_topo, nzt+1
-                   rad_lw_in(k,j,i)  = rrtm_lwdflx(0,k)
-                   rad_lw_out(k,j,i) = rrtm_lwuflx(0,k)
-                ENDDO
-
-!
-!--             Save heating rates (convert from K/d to K/h)
-                DO  k = k_topo+1, nzt+1
-                   rad_lw_hr(k,j,i)    = rrtm_lwhr(0,k-k_topo)  * d_hours_day
-                   rad_lw_cs_hr(k,j,i) = rrtm_lwhrc(0,k-k_topo) * d_hours_day
-                ENDDO
-
-!
-!--             Save surface radiative fluxes and change in LW heating rate onto respective surface
-!--             elements
-!--             Horizontal surfaces
-                DO  l = 0, 1
-                   DO  m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i)
-                      surf_lsm_h(l)%rad_lw_in(m)           = rrtm_lwdflx(0,k_topo)
-                      surf_lsm_h(l)%rad_lw_out(m)          = rrtm_lwuflx(0,k_topo)
-                      surf_lsm_h(l)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo)
-                   ENDDO
-                   DO  m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i)
-                      surf_usm_h(l)%rad_lw_in(m)           = rrtm_lwdflx(0,k_topo)
-                      surf_usm_h(l)%rad_lw_out(m)          = rrtm_lwuflx(0,k_topo)
-                      surf_usm_h(l)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo)
-                   ENDDO
-                ENDDO
-!
-!--             Vertical surfaces. Fluxes are obtain at vertical level of the respective surface
-!--             element
-                DO  l = 0, 3
-                   DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
-                      k                                    = surf_lsm_v(l)%k(m)
-                      surf_lsm_v(l)%rad_lw_in(m)           = rrtm_lwdflx(0,k)
-                      surf_lsm_v(l)%rad_lw_out(m)          = rrtm_lwuflx(0,k)
-                      surf_lsm_v(l)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k)
-                   ENDDO
-                   DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
-                      k                                    = surf_usm_v(l)%k(m)
-                      surf_usm_v(l)%rad_lw_in(m)           = rrtm_lwdflx(0,k)
-                      surf_usm_v(l)%rad_lw_out(m)          = rrtm_lwuflx(0,k)
-                      surf_usm_v(l)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k)
-                   ENDDO
-                ENDDO
-
-             ENDIF
-
-             IF ( sw_radiation .AND. sun_up )  THEN
-!
-!--             Get albedo for direct/diffusive long/shortwave radiation at current (y,x)-location
-!--             from surface variables. Only obtain it from upward facing horizontal surfaces,
-!--             as RRTMG is a single column model. (Please note, only one loop will be entered,
-!--             controlled by start-end index.)
-                DO  m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                   rrtm_asdir(1) = SUM( surf_lsm_h(0)%frac(m,:) * surf_lsm_h(0)%rrtm_asdir(m,:) )
-                   rrtm_asdif(1) = SUM( surf_lsm_h(0)%frac(m,:) * surf_lsm_h(0)%rrtm_asdif(m,:) )
-                   rrtm_aldir(1) = SUM( surf_lsm_h(0)%frac(m,:) * surf_lsm_h(0)%rrtm_aldir(m,:) )
-                   rrtm_aldif(1) = SUM( surf_lsm_h(0)%frac(m,:) * surf_lsm_h(0)%rrtm_aldif(m,:) )
-                ENDDO
-                DO  m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                   rrtm_asdir(1) = SUM( surf_usm_h(0)%frac(m,:) * surf_usm_h(0)%rrtm_asdir(m,:) )
-                   rrtm_asdif(1) = SUM( surf_usm_h(0)%frac(m,:) * surf_usm_h(0)%rrtm_asdif(m,:) )
-                   rrtm_aldir(1) = SUM( surf_usm_h(0)%frac(m,:) * surf_usm_h(0)%rrtm_aldir(m,:) )
-                   rrtm_aldif(1) = SUM( surf_usm_h(0)%frac(m,:) * surf_usm_h(0)%rrtm_aldif(m,:) )
-                ENDDO
-!
-!--             Due to technical reasons, copy optical depths and other to dummy arguments which are
-!--             allocated on the exact size as the rrtmg_sw is called. As one dimension is allocated
-!--             with zero size, compiler complains that rank of the array does not match that of the
-!--             assumed-shaped arguments in the RRTMG library. In order to avoid this, write to
-!--             dummy arguments and pass the entire dummy array. Seems to be the only existing
-!--             work-around.
-                ALLOCATE( rrtm_sw_taucld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
-                ALLOCATE( rrtm_sw_ssacld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
-                ALLOCATE( rrtm_sw_asmcld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
-                ALLOCATE( rrtm_sw_fsfcld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
-                ALLOCATE( rrtm_sw_tauaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) )
-                ALLOCATE( rrtm_sw_ssaaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) )
-                ALLOCATE( rrtm_sw_asmaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) )
-                ALLOCATE( rrtm_sw_ecaer_dum(0:0,k_topo+1:nzt_rad+1,1:naerec+1)  )
-
-                rrtm_sw_taucld_dum = rrtm_sw_taucld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
-                rrtm_sw_ssacld_dum = rrtm_sw_ssacld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
-                rrtm_sw_asmcld_dum = rrtm_sw_asmcld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
-                rrtm_sw_fsfcld_dum = rrtm_sw_fsfcld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
-                rrtm_sw_tauaer_dum = rrtm_sw_tauaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1)
-                rrtm_sw_ssaaer_dum = rrtm_sw_ssaaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1)
-                rrtm_sw_asmaer_dum = rrtm_sw_asmaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1)
-                rrtm_sw_ecaer_dum  = rrtm_sw_ecaer(0:0,k_topo+1:nzt_rad+1,1:naerec+1)
-
-                CALL rrtmg_sw( 1, nzt_rad-k_topo, rrtm_icld, rrtm_iaer,                            &
-                               rrtm_play(:,k_topo+1:nzt_rad+1), rrtm_plev(:,k_topo+1:nzt_rad+2),   &
-                               rrtm_tlay(:,k_topo+1:nzt_rad+1), rrtm_tlev(:,k_topo+1:nzt_rad+2),   &
-                               rrtm_tsfc, rrtm_h2ovmr(:,k_topo+1:nzt_rad+1),                       &
-                               rrtm_o3vmr(:,k_topo+1:nzt_rad+1), rrtm_co2vmr(:,k_topo+1:nzt_rad+1),&
-                               rrtm_ch4vmr(:,k_topo+1:nzt_rad+1),                                  &
-                               rrtm_n2ovmr(:,k_topo+1:nzt_rad+1),                                  &
-                               rrtm_o2vmr(:,k_topo+1:nzt_rad+1), rrtm_asdir, rrtm_asdif,           &
-                               rrtm_aldir, rrtm_aldif, zenith, 0.0_wp, day_of_year,                &
-                               solar_constant, rrtm_inflgsw, rrtm_iceflgsw, rrtm_liqflgsw,         &
-                               rrtm_cldfr(:,k_topo+1:nzt_rad+1), rrtm_sw_taucld_dum,               &
-                               rrtm_sw_ssacld_dum, rrtm_sw_asmcld_dum, rrtm_sw_fsfcld_dum,         &
-                               rrtm_cicewp(:,k_topo+1:nzt_rad+1),                                  &
-                               rrtm_cliqwp(:,k_topo+1:nzt_rad+1),                                  &
-                               rrtm_reice(:,k_topo+1:nzt_rad+1), rrtm_reliq(:,k_topo+1:nzt_rad+1), &
-                               rrtm_sw_tauaer_dum, rrtm_sw_ssaaer_dum, rrtm_sw_asmaer_dum,         &
-                               rrtm_sw_ecaer_dum, rrtm_swuflx(:,k_topo:nzt_rad+1),                 &
-                               rrtm_swdflx(:,k_topo:nzt_rad+1), rrtm_swhr(:,k_topo+1:nzt_rad+1),   &
-                               rrtm_swuflxc(:,k_topo:nzt_rad+1), rrtm_swdflxc(:,k_topo:nzt_rad+1), &
-                               rrtm_swhrc(:,k_topo+1:nzt_rad+1), rrtm_dirdflux(:,k_topo:nzt_rad+1),&
-                               rrtm_difdflux(:,k_topo:nzt_rad+1) )
-
-                DEALLOCATE( rrtm_sw_taucld_dum )
-                DEALLOCATE( rrtm_sw_ssacld_dum )
-                DEALLOCATE( rrtm_sw_asmcld_dum )
-                DEALLOCATE( rrtm_sw_fsfcld_dum )
-                DEALLOCATE( rrtm_sw_tauaer_dum )
-                DEALLOCATE( rrtm_sw_ssaaer_dum )
-                DEALLOCATE( rrtm_sw_asmaer_dum )
-                DEALLOCATE( rrtm_sw_ecaer_dum )
-!
-!--             Save fluxes
-                DO  k = nzb, nzt+1
-                   rad_sw_in(k,j,i)  = rrtm_swdflx(0,k)
-                   rad_sw_out(k,j,i) = rrtm_swuflx(0,k)
-                ENDDO
-!
-!--             Save heating rates (convert from K/d to K/s)
-                DO  k = nzb+1, nzt+1
-                   rad_sw_hr(k,j,i)    = rrtm_swhr(0,k)  * d_hours_day
-                   rad_sw_cs_hr(k,j,i) = rrtm_swhrc(0,k) * d_hours_day
-                ENDDO
-
-!
-!--             Save surface radiative fluxes onto respective surface elements
-!--             Horizontal surfaces
-                DO  l = 0, 1
-                   DO   m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i)
-                      surf_lsm_h(l)%rad_sw_in(m)  = rrtm_swdflx(0,k_topo)
-                      surf_lsm_h(l)%rad_sw_out(m) = rrtm_swuflx(0,k_topo)
-                   ENDDO
-                   DO  m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i)
-                      surf_usm_h(l)%rad_sw_in(m)  = rrtm_swdflx(0,k_topo)
-                      surf_usm_h(l)%rad_sw_out(m) = rrtm_swuflx(0,k_topo)
-                   ENDDO
-                ENDDO
-!
-!--             Vertical surfaces. Fluxes are obtain at respective vertical level of the surface
-!--             element
-                DO  l = 0, 3
-                   DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
-                      k                           = surf_lsm_v(l)%k(m)
-                      surf_lsm_v(l)%rad_sw_in(m)  = rrtm_swdflx(0,k)
-                      surf_lsm_v(l)%rad_sw_out(m) = rrtm_swuflx(0,k)
-                   ENDDO
-                   DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
-                      k                           = surf_usm_v(l)%k(m)
-                      surf_usm_v(l)%rad_sw_in(m)  = rrtm_swdflx(0,k)
-                      surf_usm_v(l)%rad_sw_out(m) = rrtm_swuflx(0,k)
-                   ENDDO
-                ENDDO
-!
-!--          Solar radiation is zero during night
-             ELSE
-                rad_sw_in  = 0.0_wp
-                rad_sw_out = 0.0_wp
-!--          !!!!!!!! ATTENTION !!!!!!!!!!!!!!!
-!--          Surface radiative fluxes should be also set to zero here
-!--             Save surface radiative fluxes onto respective surface elements
-!--             Horizontal surfaces
-                DO  l = 0, 1
-                   DO  m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i)
-                      surf_lsm_h(l)%rad_sw_in(m)  = 0.0_wp
-                      surf_lsm_h(l)%rad_sw_out(m) = 0.0_wp
-                   ENDDO
-                   DO  m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i)
-                      surf_usm_h(l)%rad_sw_in(m)  = 0.0_wp
-                      surf_usm_h(l)%rad_sw_out(m) = 0.0_wp
-                   ENDDO
-                ENDDO
-!
-!--             Vertical surfaces. Fluxes are obtained at respective vertical level of the surface
-!--             element
-                DO  l = 0, 3
-                   DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
-                      k                           = surf_lsm_v(l)%k(m)
-                      surf_lsm_v(l)%rad_sw_in(m)  = 0.0_wp
-                      surf_lsm_v(l)%rad_sw_out(m) = 0.0_wp
-                   ENDDO
-                   DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
-                      k                           = surf_usm_v(l)%k(m)
-                      surf_usm_v(l)%rad_sw_in(m)  = 0.0_wp
-                      surf_usm_v(l)%rad_sw_out(m) = 0.0_wp
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-    ENDIF
-!
-!-- Finally, calculate surface net radiation for surface elements.
-    IF ( .NOT.  radiation_interactions )  THEN
-!--    First, for horizontal surfaces
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             surf_lsm_h(l)%rad_net(m) = surf_lsm_h(l)%rad_sw_in(m) - surf_lsm_h(l)%rad_sw_out(m) + &
-                                        surf_lsm_h(l)%rad_lw_in(m) - surf_lsm_h(l)%rad_lw_out(m)
-          ENDDO
-          DO  m = 1, surf_usm_h(l)%ns
-             surf_usm_h(l)%rad_net(m) = surf_usm_h(l)%rad_sw_in(m) - surf_usm_h(l)%rad_sw_out(m) + &
-                                        surf_usm_h(l)%rad_lw_in(m) - surf_usm_h(l)%rad_lw_out(m)
-          ENDDO
-       ENDDO
-!
-!--    Vertical surfaces.
-!--    Todo: weight with azimuth and zenith angle according to their orientation!
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             surf_lsm_v(l)%rad_net(m) = surf_lsm_v(l)%rad_sw_in(m) - surf_lsm_v(l)%rad_sw_out(m) + &
-                                        surf_lsm_v(l)%rad_lw_in(m) - surf_lsm_v(l)%rad_lw_out(m)
-          ENDDO
-          DO  m = 1, surf_usm_v(l)%ns
-             surf_usm_v(l)%rad_net(m) = surf_usm_v(l)%rad_sw_in(m) - surf_usm_v(l)%rad_sw_out(m) + &
-                                        surf_usm_v(l)%rad_lw_in(m) - surf_usm_v(l)%rad_lw_out(m)
-          ENDDO
-       ENDDO
-    ENDIF
-
-
-    CALL exchange_horiz( rad_lw_in, nbgp )
-    CALL exchange_horiz( rad_lw_out, nbgp )
-    CALL exchange_horiz( rad_lw_hr, nbgp )
-    CALL exchange_horiz( rad_lw_cs_hr, nbgp )
-
-    CALL exchange_horiz( rad_sw_in, nbgp )
-    CALL exchange_horiz( rad_sw_out, nbgp )
-    CALL exchange_horiz( rad_sw_hr, nbgp )
-    CALL exchange_horiz( rad_sw_cs_hr, nbgp )
-
-#endif
-
- END SUBROUTINE radiation_rrtmg
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the cosine of the zenith angle (variable is called zenith)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_zenith( day_of_year, second_of_day )
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  seconds_per_day
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  day_of_year  !< day of the year
-
-    REAL(wp) ::  declination  !< solar declination angle
-    REAL(wp) ::  hour_angle   !< solar hour angle
-
-    REAL(wp),INTENT(IN) ::  second_of_day  !< current time of the day in UTC
-
-!
-!-- Calculate solar declination and hour angle
-    declination = ASIN( decl_1 * SIN( decl_2 * REAL( day_of_year, KIND = wp ) - decl_3 ) )
-    hour_angle  = 2.0_wp * pi * ( second_of_day / seconds_per_day ) + lon - pi
-
-!
-!-- Calculate cosine of solar zenith angle
-    cos_zenith = SIN( lat ) * SIN( declination ) + COS( lat ) * COS( declination ) *               &
-                 COS( hour_angle )
-    cos_zenith = MAX( 0.0_wp, cos_zenith )
-
-!
-!-- Calculate solar directional vector
-    IF ( sun_direction )  THEN
-
-!
-!--    Direction in longitudes equals to sin(solar_azimuth) * sin(zenith)
-       sun_dir_lon = - SIN( hour_angle ) * COS( declination )
-
-!
-!--    Direction in latitues equals to cos(solar_azimuth) * sin(zenith)
-       sun_dir_lat = SIN( declination ) * COS( lat ) - COS( hour_angle ) * COS( declination ) *    &
-                     SIN( lat )
-    ENDIF
-
-!
-!-- Check if the sun is up (otheriwse shortwave calculations can be skipped)
-    IF ( cos_zenith > 0.0_wp )  THEN
-       sun_up = .TRUE.
-    ELSE
-       sun_up = .FALSE.
-    END IF
-
- END SUBROUTINE calc_zenith
-
-#if defined ( __rrtmg ) && defined ( __netcdf )
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates surface albedo components based on Briegleb (1992) and Briegleb et al. (1986)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_albedo( surf )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ind_type  !< running index surface tiles
-    INTEGER(iwp) ::  m         !< running index surface elements
-
-    TYPE(surf_type) ::  surf  !< treated surfaces
-
-    IF ( sun_up  .AND.  .NOT. average_radiation )  THEN
-
-       DO  m = 1, surf%ns
-!
-!--       Loop over surface elements
-          DO  ind_type = 0, SIZE( surf%albedo_type, 2 ) - 1
-
-!
-!--          Ocean
-             IF ( surf%albedo_type(m,ind_type) == 1 )  THEN
-                surf%rrtm_aldir(m,ind_type) = 0.026_wp / ( cos_zenith**1.7_wp + 0.065_wp ) +       &
-                                              0.15_wp * ( cos_zenith - 0.1_wp ) *                  &
-                                              ( cos_zenith - 0.5_wp ) * ( cos_zenith - 1.0_wp )
-                surf%rrtm_asdir(m,ind_type) = surf%rrtm_aldir(m,ind_type)
-!
-!--          Snow
-             ELSEIF ( surf%albedo_type(m,ind_type) == 16 )  THEN
-                IF ( cos_zenith < 0.5_wp )  THEN
-                   surf%rrtm_aldir(m,ind_type) = 0.5_wp * ( 1.0_wp - surf%aldif(m,ind_type) ) *    &
-                                                 ( ( 3.0_wp / ( 1.0_wp + 4.0_wp * cos_zenith ) ) - &
-                                                 1.0_wp )
-                   surf%rrtm_asdir(m,ind_type) = 0.5_wp * ( 1.0_wp - surf%asdif(m,ind_type) ) *    &
-                                                 ( ( 3.0_wp / ( 1.0_wp + 4.0_wp * cos_zenith ) ) - &
-                                                 1.0_wp )
-
-                   surf%rrtm_aldir(m,ind_type) = MIN( 0.98_wp, surf%rrtm_aldir(m,ind_type) )
-                   surf%rrtm_asdir(m,ind_type) = MIN( 0.98_wp, surf%rrtm_asdir(m,ind_type) )
-                ELSE
-                   surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type)
-                   surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type)
-                ENDIF
-!
-!--          Sea ice
-             ELSEIF ( surf%albedo_type(m,ind_type) == 15 )  THEN
-                surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type)
-                surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type)
-
-!
-!--          Asphalt
-             ELSEIF ( surf%albedo_type(m,ind_type) == 17 )  THEN
-                surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type)
-                surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type)
-
-
-!
-!--          Bare soil
-             ELSEIF ( surf%albedo_type(m,ind_type) == 18 )  THEN
-                surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type)
-                surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type)
-
-!
-!--          Land surfaces
-             ELSE
-                SELECT CASE ( surf%albedo_type(m,ind_type) )
-
-!
-!--                Surface types with strong zenith dependence
-                   CASE ( 1, 2, 3, 4, 11, 12, 13 )
-                      surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type) * 1.4_wp /              &
-                                                    ( 1.0_wp + 0.8_wp * cos_zenith )
-                      surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type) * 1.4_wp /              &
-                                                    ( 1.0_wp + 0.8_wp * cos_zenith )
-!
-!--                Surface types with weak zenith dependence
-                   CASE ( 5, 6, 7, 8, 9, 10, 14 )
-                      surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type) * 1.1_wp /              &
-                                                    ( 1.0_wp + 0.2_wp * cos_zenith )
-                      surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type) * 1.1_wp /              &
-                                                    ( 1.0_wp + 0.2_wp * cos_zenith )
-
-                   CASE DEFAULT
-
-                END SELECT
-             ENDIF
-!
-!--          Diffusive albedo is taken from Table 2
-             surf%rrtm_aldif(m,ind_type) = surf%aldif(m,ind_type)
-             surf%rrtm_asdif(m,ind_type) = surf%asdif(m,ind_type)
-          ENDDO
-       ENDDO
-!
-!-- Set albedo in case of average radiation
-    ELSEIF ( sun_up  .AND.  average_radiation )  THEN
-       surf%rrtm_asdir = albedo_urb
-       surf%rrtm_asdif = albedo_urb
-       surf%rrtm_aldir = albedo_urb
-       surf%rrtm_aldif = albedo_urb
-!
-!-- Darkness
-    ELSE
-       surf%rrtm_aldir = 0.0_wp
-       surf%rrtm_asdir = 0.0_wp
-       surf%rrtm_aldif = 0.0_wp
-       surf%rrtm_asdif = 0.0_wp
-    ENDIF
-
- END SUBROUTINE calc_albedo
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read sounding data (pressure and temperature) from RADIATION_DATA.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE read_sounding_data
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  id,           &  !< NetCDF id of input file
-                     id_dim_zrad,  &  !< pressure level id in the NetCDF file
-                     id_var,       &  !< NetCDF variable id
-                     k,            &  !< loop index
-                     nz_snd,       &  !< number of vertical levels in the sounding data
-                     nz_snd_start, &  !< start vertical index for sounding data to be used
-                     nz_snd_end       !< end vertical index for souding data to be used
-
-    REAL(wp) ::  t_surface  !< actual surface temperature
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  hyp_snd_tmp, &  !< temporary hydrostatic pressure profile (sounding)
-                                            t_snd_tmp       !< temporary temperature profile (sounding)
-
-!
-!-- In case of updates, deallocate arrays first (sufficient to check one array as the others are
-!-- automatically allocated). This is required because nzt_rad might change during the update
-    IF ( ALLOCATED( hyp_snd ) )  THEN
-       DEALLOCATE( hyp_snd )
-       DEALLOCATE( t_snd )
-       DEALLOCATE( rrtm_play )
-       DEALLOCATE( rrtm_plev )
-       DEALLOCATE( rrtm_tlay )
-       DEALLOCATE( rrtm_tlev )
-
-       DEALLOCATE( rrtm_cicewp )
-       DEALLOCATE( rrtm_cldfr )
-       DEALLOCATE( rrtm_cliqwp )
-       DEALLOCATE( rrtm_reice )
-       DEALLOCATE( rrtm_reliq )
-       DEALLOCATE( rrtm_lw_taucld )
-       DEALLOCATE( rrtm_lw_tauaer )
-
-       DEALLOCATE( rrtm_lwdflx )
-       DEALLOCATE( rrtm_lwdflxc )
-       DEALLOCATE( rrtm_lwuflx )
-       DEALLOCATE( rrtm_lwuflxc )
-       DEALLOCATE( rrtm_lwuflx_dt )
-       DEALLOCATE( rrtm_lwuflxc_dt )
-       DEALLOCATE( rrtm_lwhr )
-       DEALLOCATE( rrtm_lwhrc )
-
-       DEALLOCATE( rrtm_sw_taucld )
-       DEALLOCATE( rrtm_sw_ssacld )
-       DEALLOCATE( rrtm_sw_asmcld )
-       DEALLOCATE( rrtm_sw_fsfcld )
-       DEALLOCATE( rrtm_sw_tauaer )
-       DEALLOCATE( rrtm_sw_ssaaer )
-       DEALLOCATE( rrtm_sw_asmaer )
-       DEALLOCATE( rrtm_sw_ecaer )
-
-       DEALLOCATE( rrtm_swdflx )
-       DEALLOCATE( rrtm_swdflxc )
-       DEALLOCATE( rrtm_swuflx )
-       DEALLOCATE( rrtm_swuflxc )
-       DEALLOCATE( rrtm_swhr )
-       DEALLOCATE( rrtm_swhrc )
-       DEALLOCATE( rrtm_dirdflux )
-       DEALLOCATE( rrtm_difdflux )
-
-    ENDIF
-
-!
-!-- Open file for reading
-    nc_stat = NF90_OPEN( rrtm_input_file, NF90_NOWRITE, id )
-    CALL netcdf_handle_error_rad( 'read_sounding_data', 549 )
-
-!
-!-- Inquire dimension of z axis and save in nz_snd
-    nc_stat = NF90_INQ_DIMID( id, 'Pressure', id_dim_zrad )
-    nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim_zrad, len = nz_snd )
-    CALL netcdf_handle_error_rad( 'read_sounding_data', 551 )
-
-!
-!-- Allocate temporary array for storing pressure data
-    ALLOCATE( hyp_snd_tmp(1:nz_snd) )
-    hyp_snd_tmp = 0.0_wp
-
-
-!-- Read pressure from file
-    nc_stat = NF90_INQ_VARID( id, 'Pressure', id_var )
-    nc_stat = NF90_GET_VAR( id, id_var, hyp_snd_tmp(:), start = (/1/), count = (/nz_snd/) )
-    CALL netcdf_handle_error_rad( 'read_sounding_data', 552 )
-
-!
-!-- Allocate temporary array for storing temperature data
-    ALLOCATE( t_snd_tmp(1:nz_snd) )
-    t_snd_tmp = 0.0_wp
-
-!
-!-- Read temperature from file
-    nc_stat = NF90_INQ_VARID( id, 'ReferenceTemperature', id_var )
-    nc_stat = NF90_GET_VAR( id, id_var, t_snd_tmp(:), start = (/1/), count = (/nz_snd/) )
-    CALL netcdf_handle_error_rad( 'read_sounding_data', 553 )
-
-!
-!-- Calculate start of sounding data
-    nz_snd_start = nz_snd + 1
-    nz_snd_end   = nz_snd + 1
-
-!
-!-- Start filling vertical dimension at 10hPa above the model domain (hyp is in Pa, hyp_snd in hPa).
-    DO  k = 1, nz_snd
-       IF ( hyp_snd_tmp(k) < ( hyp(nzt+1) - 1000.0_wp) * 0.01_wp )  THEN
-          nz_snd_start = k
-          EXIT
-       END IF
-    END DO
-
-    IF ( nz_snd_start <= nz_snd )  THEN
-       nz_snd_end = nz_snd
-    END IF
-
-
-!
-!-- Calculate of total grid points for RRTMG calculations
-    nzt_rad = nzt + nz_snd_end - nz_snd_start + 1
-
-!
-!-- Save data above LES domain in hyp_snd, t_snd
-    ALLOCATE( hyp_snd(nzb+1:nzt_rad) )
-    ALLOCATE( t_snd(nzb+1:nzt_rad) )
-    hyp_snd = 0.0_wp
-    t_snd = 0.0_wp
-
-    hyp_snd(nzt+2:nzt_rad) = hyp_snd_tmp(nz_snd_start+1:nz_snd_end)
-    t_snd(nzt+2:nzt_rad)   = t_snd_tmp(nz_snd_start+1:nz_snd_end)
-
-    nc_stat = NF90_CLOSE( id )
-
-!
-!-- Calculate pressure levels on zu and zw grid. Sounding data is added at top of the LES domain.
-!-- This routine does not consider horizontal or vertical variability of pressure and temperature
-    ALLOCATE( rrtm_play(0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_plev(0:0,nzb+1:nzt_rad+2) )
-
-    t_surface = pt_surface * exner(nzb)
-    DO  k = nzb+1, nzt+1
-       rrtm_play(0,k) = hyp(k) * 0.01_wp
-       rrtm_plev(0,k) = barometric_formula(zw(k-1), pt_surface * exner(nzb), surface_pressure )
-    ENDDO
-
-    DO  k = nzt+2, nzt_rad
-       rrtm_play(0,k) = hyp_snd(k)
-       rrtm_plev(0,k) = 0.5_wp * ( rrtm_play(0,k) + rrtm_play(0,k-1) )
-    ENDDO
-    rrtm_plev(0,nzt_rad+1) = MAX( 0.5 * hyp_snd(nzt_rad), 1.5 * hyp_snd(nzt_rad) - 0.5 *           &
-                                  hyp_snd(nzt_rad-1) )
-    rrtm_plev(0,nzt_rad+2) = MIN( 1.0E-4_wp, 0.25_wp * rrtm_plev(0,nzt_rad+1) )
-
-    rrtm_play(0,nzt_rad+1) = 0.5 * rrtm_plev(0,nzt_rad+1)
-
-!
-!-- Calculate temperature/humidity levels at top of the LES domain.
-!-- Currently, the temperature is taken from sounding data (might lead to a temperature jump at
-!-- interface. To do: Humidity is currently not calculated above the LES domain.
-    ALLOCATE( rrtm_tlay(0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_tlev(0:0,nzb+1:nzt_rad+2) )
-
-    DO  k = nzt+8, nzt_rad
-       rrtm_tlay(0,k) = t_snd(k)
-    ENDDO
-    rrtm_tlay(0,nzt_rad+1) = 2.0_wp * rrtm_tlay(0,nzt_rad) - rrtm_tlay(0,nzt_rad-1)
-    DO k = nzt+9, nzt_rad+1
-       rrtm_tlev(0,k) = rrtm_tlay(0,k-1) + ( rrtm_tlay(0,k) - rrtm_tlay(0,k-1) ) /                 &
-                        ( rrtm_play(0,k) - rrtm_play(0,k-1) ) *                                    &
-                        ( rrtm_plev(0,k) - rrtm_play(0,k-1) )
-    ENDDO
-
-    rrtm_tlev(0,nzt_rad+2) = 2.0_wp * rrtm_tlay(0,nzt_rad+1) - rrtm_tlev(0,nzt_rad)
-!
-!-- Allocate remaining RRTMG arrays
-    ALLOCATE( rrtm_cicewp(0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_cldfr(0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_cliqwp(0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_reice(0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_reliq(0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_lw_taucld(1:nbndlw+1,0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_lw_tauaer(0:0,nzb+1:nzt_rad+1,1:nbndlw+1) )
-    ALLOCATE( rrtm_sw_taucld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_sw_ssacld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_sw_asmcld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_sw_fsfcld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_sw_tauaer(0:0,nzb+1:nzt_rad+1,1:nbndsw+1) )
-    ALLOCATE( rrtm_sw_ssaaer(0:0,nzb+1:nzt_rad+1,1:nbndsw+1) )
-    ALLOCATE( rrtm_sw_asmaer(0:0,nzb+1:nzt_rad+1,1:nbndsw+1) )
-    ALLOCATE( rrtm_sw_ecaer(0:0,nzb+1:nzt_rad+1,1:naerec+1) )
-
-!
-!-- The ice phase is currently not considered in PALM
-    rrtm_cicewp = 0.0_wp
-    rrtm_reice  = 0.0_wp
-
-!
-!-- Set other parameters (move to NAMELIST parameters in the future)
-    rrtm_lw_tauaer = 0.0_wp
-    rrtm_lw_taucld = 0.0_wp
-    rrtm_sw_taucld = 0.0_wp
-    rrtm_sw_ssacld = 0.0_wp
-    rrtm_sw_asmcld = 0.0_wp
-    rrtm_sw_fsfcld = 0.0_wp
-    rrtm_sw_tauaer = 0.0_wp
-    rrtm_sw_ssaaer = 0.0_wp
-    rrtm_sw_asmaer = 0.0_wp
-    rrtm_sw_ecaer  = 0.0_wp
-
-
-    ALLOCATE( rrtm_swdflx(0:0,nzb:nzt_rad+1) )
-    ALLOCATE( rrtm_swuflx(0:0,nzb:nzt_rad+1) )
-    ALLOCATE( rrtm_swhr(0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_swuflxc(0:0,nzb:nzt_rad+1) )
-    ALLOCATE( rrtm_swdflxc(0:0,nzb:nzt_rad+1) )
-    ALLOCATE( rrtm_swhrc(0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_dirdflux(0:0,nzb:nzt_rad+1) )
-    ALLOCATE( rrtm_difdflux(0:0,nzb:nzt_rad+1) )
-
-    rrtm_swdflx  = 0.0_wp
-    rrtm_swuflx  = 0.0_wp
-    rrtm_swhr    = 0.0_wp
-    rrtm_swuflxc = 0.0_wp
-    rrtm_swdflxc = 0.0_wp
-    rrtm_swhrc   = 0.0_wp
-    rrtm_dirdflux = 0.0_wp
-    rrtm_difdflux = 0.0_wp
-
-    ALLOCATE( rrtm_lwdflx(0:0,nzb:nzt_rad+1) )
-    ALLOCATE( rrtm_lwuflx(0:0,nzb:nzt_rad+1) )
-    ALLOCATE( rrtm_lwhr(0:0,nzb+1:nzt_rad+1) )
-    ALLOCATE( rrtm_lwuflxc(0:0,nzb:nzt_rad+1) )
-    ALLOCATE( rrtm_lwdflxc(0:0,nzb:nzt_rad+1) )
-    ALLOCATE( rrtm_lwhrc(0:0,nzb+1:nzt_rad+1) )
-
-    rrtm_lwdflx  = 0.0_wp
-    rrtm_lwuflx  = 0.0_wp
-    rrtm_lwhr    = 0.0_wp
-    rrtm_lwuflxc = 0.0_wp
-    rrtm_lwdflxc = 0.0_wp
-    rrtm_lwhrc   = 0.0_wp
-
-    ALLOCATE( rrtm_lwuflx_dt(0:0,nzb:nzt_rad+1) )
-    ALLOCATE( rrtm_lwuflxc_dt(0:0,nzb:nzt_rad+1) )
-
-    rrtm_lwuflx_dt = 0.0_wp
-    rrtm_lwuflxc_dt = 0.0_wp
-
- END SUBROUTINE read_sounding_data
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read trace gas data from file and convert into trace gas paths / volume mixing ratios. If a
-!> user-defined input file is provided it needs to follow the convections used in RRTMG (see
-!> respective netCDF files shipped with RRTMG)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE read_trace_gas_data
-
-    USE rrsw_ncpar
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), PARAMETER ::  num_trace_gases = 10  !< number of trace gases (absorbers)
-
-    CHARACTER(LEN=5), DIMENSION(num_trace_gases), PARAMETER ::      &  !< trace gas names
-    trace_names = (/'O3   ', 'CO2  ', 'CH4  ', 'N2O  ', 'O2   ',    &
-                    'CFC11', 'CFC12', 'CFC22', 'CCL4 ', 'H2O  '/)
-
-    INTEGER(iwp) ::  id,     &  !< NetCDF id
-                     k,      &  !< loop index
-                     m,      &  !< loop index
-                     n,      &  !< loop index
-                     nabs,   &  !< number of absorbers
-                     np,     &  !< number of pressure levels
-                     id_abs, &  !< NetCDF id of the respective absorber
-                     id_dim, &  !< NetCDF id of asborber's dimension
-                     id_var     !< NetCDf id ot the absorber
-
-    REAL(wp) ::  p_mls_l, &  !< pressure lower limit for interpolation
-                 p_mls_u, &  !< pressure upper limit for interpolation
-                 p_wgt_l, &  !< pressure weight lower limit for interpolation
-                 p_wgt_u, &  !< pressure weight upper limit for interpolation
-                 p_mls_m     !< mean pressure between upper and lower limits
-
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  p_mls,          &  !< pressure levels for the absorbers
-                                            rrtm_play_tmp,  &  !< temporary array for pressure zu-levels
-                                            rrtm_plev_tmp,  &  !< temporary array for pressure zw-levels
-                                            trace_path_tmp     !< temporary array for storing trace gas path data
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  trace_mls,      &  !< array for storing the absorber amounts
-                                              trace_mls_path, &  !< array for storing trace gas path data
-                                              trace_mls_tmp      !< temporary array for storing trace gas data
-
-
-!
-!-- In case of updates, deallocate arrays first (sufficient to check one array as the others are
-!-- automatically allocated)
-    IF ( ALLOCATED( rrtm_o3vmr ) )  THEN
-       DEALLOCATE( rrtm_o3vmr )
-       DEALLOCATE( rrtm_co2vmr )
-       DEALLOCATE( rrtm_ch4vmr )
-       DEALLOCATE( rrtm_n2ovmr )
-       DEALLOCATE( rrtm_o2vmr )
-       DEALLOCATE( rrtm_cfc11vmr )
-       DEALLOCATE( rrtm_cfc12vmr )
-       DEALLOCATE( rrtm_cfc22vmr )
-       DEALLOCATE( rrtm_ccl4vmr )
-       DEALLOCATE( rrtm_h2ovmr )
-    ENDIF
-
-!
-!-- Allocate trace gas profiles
-    ALLOCATE( rrtm_o3vmr(0:0,1:nzt_rad+1) )
-    ALLOCATE( rrtm_co2vmr(0:0,1:nzt_rad+1) )
-    ALLOCATE( rrtm_ch4vmr(0:0,1:nzt_rad+1) )
-    ALLOCATE( rrtm_n2ovmr(0:0,1:nzt_rad+1) )
-    ALLOCATE( rrtm_o2vmr(0:0,1:nzt_rad+1) )
-    ALLOCATE( rrtm_cfc11vmr(0:0,1:nzt_rad+1) )
-    ALLOCATE( rrtm_cfc12vmr(0:0,1:nzt_rad+1) )
-    ALLOCATE( rrtm_cfc22vmr(0:0,1:nzt_rad+1) )
-    ALLOCATE( rrtm_ccl4vmr(0:0,1:nzt_rad+1) )
-    ALLOCATE( rrtm_h2ovmr(0:0,1:nzt_rad+1) )
-
-!
-!-- Open file for reading
-    nc_stat = NF90_OPEN( rrtm_input_file, NF90_NOWRITE, id )
-    CALL netcdf_handle_error_rad( 'read_trace_gas_data', 549 )
-!
-!-- Inquire dimension ids and dimensions
-    nc_stat = NF90_INQ_DIMID( id, 'Pressure', id_dim )
-    CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
-    nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, len = np)
-    CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
-
-    nc_stat = NF90_INQ_DIMID( id, 'Absorber', id_dim )
-    CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
-    nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, len = nabs )
-    CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
-
-
-!
-!-- Allocate pressure, and trace gas arrays
-    ALLOCATE( p_mls(1:np) )
-    ALLOCATE( trace_mls(1:num_trace_gases,1:np) )
-    ALLOCATE( trace_mls_tmp(1:nabs,1:np) )
-
-
-    nc_stat = NF90_INQ_VARID( id, 'Pressure', id_var )
-    CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
-    nc_stat = NF90_GET_VAR( id, id_var, p_mls )
-    CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
-
-    nc_stat = NF90_INQ_VARID( id, 'AbsorberAmountMLS', id_var )
-    CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
-    nc_stat = NF90_GET_VAR( id, id_var, trace_mls_tmp )
-    CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
-
-
-!
-!-- Write absorber amounts (mls) to trace_mls
-    DO  n = 1, num_trace_gases
-       CALL getAbsorberIndex( TRIM( trace_names(n) ), id_abs )
-
-       trace_mls(n,1:np) = trace_mls_tmp(id_abs,1:np)
-
-!
-!--    Replace missing values by zero
-       WHERE ( trace_mls(n,:) > 2.0_wp )
-          trace_mls(n,:) = 0.0_wp
-       END WHERE
-    END DO
-
-    DEALLOCATE( trace_mls_tmp )
-
-    nc_stat = NF90_CLOSE( id )
-    CALL netcdf_handle_error_rad( 'read_trace_gas_data', 551 )
-
-!
-!-- Add extra pressure level for calculations of the trace gas paths
-    ALLOCATE( rrtm_play_tmp(1:nzt_rad+1) )
-    ALLOCATE( rrtm_plev_tmp(1:nzt_rad+2) )
-
-    rrtm_play_tmp(1:nzt_rad)   = rrtm_play(0,1:nzt_rad)
-    rrtm_plev_tmp(1:nzt_rad+1) = rrtm_plev(0,1:nzt_rad+1)
-    rrtm_play_tmp(nzt_rad+1)   = rrtm_plev(0,nzt_rad+1) * 0.5_wp
-    rrtm_plev_tmp(nzt_rad+2)   = MIN( 1.0E-4_wp, 0.25_wp * rrtm_plev(0,nzt_rad+1) )
-
-!
-!-- Calculate trace gas path (zero at surface) with interpolation to the sounding levels
-    ALLOCATE( trace_mls_path(1:nzt_rad+2,1:num_trace_gases) )
-
-    trace_mls_path(nzb+1,:) = 0.0_wp
-
-    DO  k = nzb+2, nzt_rad+2
-       DO  m = 1, num_trace_gases
-          trace_mls_path(k,m) = trace_mls_path(k-1,m)
-
-!
-!--       When the pressure level is higher than the trace gas pressure level, assume that
-          IF ( rrtm_plev_tmp(k-1) > p_mls(1) )  THEN
-
-             trace_mls_path(k,m) = trace_mls_path(k,m) + trace_mls(m,1) * ( rrtm_plev_tmp(k-1) -   &
-                                   MAX( p_mls(1), rrtm_plev_tmp(k) ) ) / g
-          ENDIF
-
-!
-!--       Integrate for each sounding level from the contributing p_mls levels
-          DO  n = 2, np
-!
-!--          Limit p_mls so that it is within the model level
-             p_mls_u = MIN( rrtm_plev_tmp(k-1), MAX( rrtm_plev_tmp(k), p_mls(n) ) )
-             p_mls_l = MIN( rrtm_plev_tmp(k-1), MAX( rrtm_plev_tmp(k), p_mls(n-1) ) )
-
-             IF ( p_mls_l > p_mls_u )  THEN
-
-!
-!--             Calculate weights for interpolation
-                p_mls_m = 0.5_wp * ( p_mls_l + p_mls_u )
-                p_wgt_u = ( p_mls(n-1) - p_mls_m ) / ( p_mls(n-1) - p_mls(n) )
-                p_wgt_l = ( p_mls_m - p_mls(n) )   / ( p_mls(n-1) - p_mls(n) )
-
-!
-!--             Add level to trace gas path
-                trace_mls_path(k,m) = trace_mls_path(k,m) + ( p_wgt_u * trace_mls(m,n) +           &
-                                      p_wgt_l * trace_mls(m,n-1) ) * (p_mls_l - p_mls_u) / g
-             ENDIF
-          ENDDO
-
-          IF ( rrtm_plev_tmp(k) < p_mls(np) )  THEN
-             trace_mls_path(k,m) = trace_mls_path(k,m) + trace_mls(m,np) *                         &
-                                   ( MIN( rrtm_plev_tmp(k-1), p_mls(np) ) - rrtm_plev_tmp(k) ) / g
-          ENDIF
-       ENDDO
-    ENDDO
-
-
-!
-!-- Prepare trace gas path profiles
-    ALLOCATE( trace_path_tmp(1:nzt_rad+1) )
-
-    DO  m = 1, num_trace_gases
-
-       trace_path_tmp(1:nzt_rad+1) = ( trace_mls_path(2:nzt_rad+2,m) -                             &
-                                       trace_mls_path(1:nzt_rad+1,m) ) * g /                       &
-                                     ( rrtm_plev_tmp(1:nzt_rad+1) - rrtm_plev_tmp(2:nzt_rad+2) )
-
-!
-!--    Save trace gas paths to the respective arrays
-       SELECT CASE ( TRIM( trace_names(m) ) )
-
-          CASE ( 'O3' )
-
-             rrtm_o3vmr(0,:) = trace_path_tmp(:)
-
-          CASE ( 'CO2' )
-
-             rrtm_co2vmr(0,:) = trace_path_tmp(:)
-
-          CASE ( 'CH4' )
-
-             rrtm_ch4vmr(0,:) = trace_path_tmp(:)
-
-          CASE ( 'N2O' )
-
-             rrtm_n2ovmr(0,:) = trace_path_tmp(:)
-
-          CASE ( 'O2' )
-
-             rrtm_o2vmr(0,:) = trace_path_tmp(:)
-
-          CASE ( 'CFC11' )
-
-             rrtm_cfc11vmr(0,:) = trace_path_tmp(:)
-
-          CASE ( 'CFC12' )
-
-             rrtm_cfc12vmr(0,:) = trace_path_tmp(:)
-
-          CASE ( 'CFC22' )
-
-             rrtm_cfc22vmr(0,:) = trace_path_tmp(:)
-
-          CASE ( 'CCL4' )
-
-             rrtm_ccl4vmr(0,:) = trace_path_tmp(:)
-
-          CASE ( 'H2O' )
-
-             rrtm_h2ovmr(0,:) = trace_path_tmp(:)
-
-          CASE DEFAULT
-
-       END SELECT
-
-    ENDDO
-
-    DEALLOCATE( trace_path_tmp )
-    DEALLOCATE( trace_mls_path )
-    DEALLOCATE( rrtm_play_tmp )
-    DEALLOCATE( rrtm_plev_tmp )
-    DEALLOCATE( trace_mls )
-    DEALLOCATE( p_mls )
-
- END SUBROUTINE read_trace_gas_data
-
-
- SUBROUTINE netcdf_handle_error_rad( routine_name, errno )
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string
-
-    USE NETCDF
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=6) ::  message_identifier  !<
-    CHARACTER(LEN=*) ::  routine_name        !<
-
-    INTEGER(iwp) ::  errno  !<
-
-    IF ( nc_stat /= NF90_NOERR )  THEN
-
-       WRITE( message_identifier, '(''NC'',I4.4)' )  errno
-       message_string = TRIM( NF90_STRERROR( nc_stat ) )
-
-       CALL message( routine_name, message_identifier, 2, 2, 0, 6, 1 )
-
-    ENDIF
-
- END SUBROUTINE netcdf_handle_error_rad
-#endif
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate temperature tendency due to radiative cooling/heating.
-!> Cache-optimized version.
-!--------------------------------------------------------------------------------------------------!
-#if defined( __rrtmg )
- SUBROUTINE radiation_tendency_ij( i, j, tend )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, j, k  !< loop indices
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tend  !< pt tendency term
-
-    IF ( radiation_scheme == 'rrtmg' )  THEN
-!
-!--    Calculate tendency based on heating rate
-       DO  k = nzb+1, nzt+1
-          tend(k,j,i) = tend(k,j,i) + ( rad_lw_hr(k,j,i) + rad_sw_hr(k,j,i) ) *                    &
-                        d_exner(k) * d_seconds_hour *                                              &
-                        MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE radiation_tendency_ij
-#endif
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate temperature tendency due to radiative cooling/heating.
-!> Vector-optimized version
-!--------------------------------------------------------------------------------------------------!
-#if defined( __rrtmg )
- SUBROUTINE radiation_tendency( tend )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, j, k  !< loop indices
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tend  !< pt tendency term
-
-    IF ( radiation_scheme == 'rrtmg' )  THEN
-!
-!--    Calculate tendency based on heating rate
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt+1
-                tend(k,j,i) = tend(k,j,i) + ( rad_lw_hr(k,j,i) + rad_sw_hr(k,j,i) ) *              &
-                              d_exner(k) * d_seconds_hour *                                        &
-                              MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE radiation_tendency
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Radiative Transfer Model (RTM) version 3.0 for modelling of radiation interactions within urban
-!> canopy or inside of surface layer in complex terrain. This subroutine calculates interaction of
-!> the solar SW and LW radiation with urban and land surfaces and updates all surface heatfluxes.
-!> It also calculates interactions of SW and LW radiation with resolved plant canopy and calculates
-!> the corresponding plant canopy heat fluxes. The subroutine also models spatial and temporal
-!> distribution of Mean Radiant Temperature (MRT). The resulting values are provided to other
-!> PALM-4U modules (RRTMG, USM, LSM, PCM and BIO).
-!>
-!> The new version 3.0 was radically rewritten from version 1.0. The most significant changes
-!> include new angular discretization scheme, redesigned and significantly optimized raytracing
-!> scheme, new processes included in modelling (e.g. intetrations of LW radiation with PC),
-!> integrated calculation of Mean Radiant Temperature (MRT), and improved and enhanced output and
-!> debug capabilities. This new version significantly improves effectivity of the paralelization and
-!> the scalability of the model and allows simulation of extensive domain with appropriate HPC
-!> resources.
-!>
-!> More info about RTM v.1.0. see:
-!> Resler et al., GMD. 2017, https://doi.org/10.5194/gmd-10-3635-2017
-!> Info about RTM v. 3.0 see: Krc et al. 2020 (to appear in GMD),
-!> Maronga et al., GMDD 2019,  https://doi.org/10.5194/gmd-2019-103
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE radiation_interaction
-
-    USE control_parameters,                                                                        &
-        ONLY:  rotation_angle
-
-     IMPLICIT NONE
-
-     INTEGER(iwp) ::  i, j, k, kk, d, refstep, m, mm, l   !<
-     INTEGER(iwp) ::  isurf, isurfsrc, isvf, icsf, ipcgb  !<
-     INTEGER(iwp) ::  imrt, imrtf                         !<
-     INTEGER(iwp) ::  isd                                 !< solar direction number
-     INTEGER(iwp) ::  pc_box_dimshift                     !< transform for best accuracy
-
-     REAL(wp) ::  asrc                                  !< area of source face
-     REAL(wp) ::  pcrad                                 !< irradiance from plant canopy
-     REAL(wp) ::  pc_box_area, pc_abs_frac, pc_abs_eff  !<
-     REAL(wp) ::  temp                                  !< temporary variable for calculation
-
-     REAL(wp), DIMENSION(3) ::  sunorig       !< grid rotated solar direction unit vector (zyx)
-     REAL(wp), DIMENSION(3) ::  sunorig_grid  !< grid squashed solar direction unit vector (zyx)
-
-     REAL(wp), DIMENSION(3,3) ::  mrot  !< grid rotation matrix (zyx)
-
-     REAL(wp), DIMENSION(0:nsurf_type) ::  costheta  !< direct irradiance factor of solar angle
-
-     REAL(wp), DIMENSION(3,0:nsurf_type) ::  vnorm  !< face direction normal vectors (zyx)
-
-     REAL(wp), DIMENSION(nz_urban_b:nz_urban_t) ::  pchf_prep  !< precalculated factor for canopy temperature tendency
-
-
-!
-!--  Variables for coupling the radiation modle (e.g. RRTMG) and RTM
-     REAL(wp) ::  area_norm         !< reference horizontal area of domain in all processor
-     REAL(wp) ::  pabsswl           !< total absorbed SW radiation energy in local processor (W)
-     REAL(wp) ::  pabssw            !< total absorbed SW radiation energy in all processors (W)
-     REAL(wp) ::  pabslwl           !< total absorbed LW radiation energy in local processor (W)
-     REAL(wp) ::  pabslw            !< total absorbed LW radiation energy in all processors (W)
-     REAL(wp) ::  pemitlwl          !< total emitted LW radiation energy in all processors (W)
-     REAL(wp) ::  pemitlw           !< total emitted LW radiation energy in all processors (W)
-     REAL(wp) ::  pinswl            !< total received SW radiation energy in local processor (W)
-     REAL(wp) ::  pinsw             !< total received SW radiation energy in all processor (W)
-     REAL(wp) ::  pinlwl            !< total received LW radiation energy in local processor (W)
-     REAL(wp) ::  pinlw             !< total received LW radiation energy in all processor (W)
-     REAL(wp) ::  pabs_surf_lwdifl  !< total absorbed LW radiation in surfaces from sky in local processor (W)
-     REAL(wp) ::  pabs_surf_lwdif   !< total absorbed LW radiation in surfaces from sky in all processors (W)
-     REAL(wp) ::  pabs_pc_lwdifl    !< total absorbed LW radiation in plant canopy from sky in local processor (W)
-     REAL(wp) ::  pabs_pc_lwdif     !< total absorbed LW radiation in plant canopy from sky in all processors (W)
-!
-!--  Rotation related variables
-     REAL(wp) ::  cos_rot            !< cosine of rotation_angle
-     REAL(wp) ::  sun_direct_factor  !< factor for direct normal radiation from direct horizontal
-     REAL(wp) ::  sin_rot            !< sine of rotation_angle
-     REAL(wp) ::  solar_azim         !< solar azimuth in rotated model coordinates
-#if defined( __parallel )
-     REAL(wp), DIMENSION(1:7) ::  combine_allreduce    !< dummy array used to combine several MPI_ALLREDUCE calls
-     REAL(wp), DIMENSION(1:7) ::  combine_allreduce_l  !< dummy array used to combine several MPI_ALLREDUCE calls
-#endif
-
-     IF ( debug_output_timestep )  THEN
-         WRITE( debug_string, * ) 'radiation_interaction', time_since_reference_point
-         CALL debug_message( debug_string, 'start' )
-     ENDIF
-
-     IF ( plant_canopy )  THEN
-         pchf_prep(:) = r_d * exner(nz_urban_b:nz_urban_t) / ( c_p * hyp(nz_urban_b:nz_urban_t) *  &
-                        dx * dy * dz(1) ) !< equals to 1 / (rho * c_p * Vbox * T)
-     ENDIF
-
-     sun_direction = .TRUE.
-     CALL get_date_time( time_since_reference_point, day_of_year=day_of_year,                      &
-                         second_of_day = second_of_day )
-     CALL calc_zenith( day_of_year, second_of_day ) !< Required also for diffusion radiation
-
-!
-!--  Prepare rotated normal vectors and irradiance factor
-     sin_rot = SIN( rotation_angle * pi / 180.0_wp )
-     cos_rot = COS( rotation_angle * pi / 180.0_wp )
-     vnorm(1,:) = kdir(:)
-     vnorm(2,:) = jdir(:)
-     vnorm(3,:) = idir(:)
-     mrot(1, :) = (/ 1._wp,  0._wp,   0._wp   /)
-     mrot(2, :) = (/ 0._wp,  cos_rot, sin_rot /)
-     mrot(3, :) = (/ 0._wp, -sin_rot, cos_rot /)
-     sunorig = (/ cos_zenith, sun_dir_lat, sun_dir_lon /)
-     sunorig = MATMUL( mrot, sunorig )
-     DO  d = 0, nsurf_type
-         costheta(d) = DOT_PRODUCT( sunorig, vnorm(:,d) )
-     ENDDO
-
-     IF ( cos_zenith > 0 )  THEN
-!
-!--      Now we will "squash" the sunorig vector by grid box size in each dimension, so that this
-!--      new direction vector will allow us to traverse the ray path within grid coordinates
-!--      directly
-         sunorig_grid = (/ sunorig(1) / dz(1), sunorig(2) / dy, sunorig(3) / dx /)
-!        sunorig_grid = sunorig_grid / norm2(sunorig_grid)
-         sunorig_grid = sunorig_grid / SQRT( SUM( sunorig_grid**2 ) )
-
-         IF ( npcbl > 0 )  THEN
-!
-!--         Precompute effective box depth with prototype Leaf Area Density
-            pc_box_dimshift = MAXLOC( ABS( sunorig ), 1) - 1
-            CALL box_absorb( CSHIFT( (/ dz(1), dy, dx/), pc_box_dimshift ), 60, prototype_lad,     &
-                             CSHIFT( ABS( sunorig ), pc_box_dimshift ), pc_box_area, pc_abs_frac )
-            pc_box_area = pc_box_area * ABS( sunorig( pc_box_dimshift + 1 ) / sunorig(1) )
-            pc_abs_eff = LOG( 1._wp - pc_abs_frac ) / prototype_lad
-         ENDIF
-     ENDIF
-!
-!--  Split downwelling shortwave radiation into a diffuse and a direct part. Note, if radiation
-!--  scheme is RRTMG or diffuse radiation is externally prescribed, this is not required. Please
-!--  note, in case of external radiation, the clear-sky model is applied during spinup, so that
-!--  radiation needs to be split also in this case.
-     IF ( radiation_scheme == 'constant'  .OR.  radiation_scheme == 'clear-sky'  .OR.              &
-          ( radiation_scheme == 'external'  .AND.  .NOT.  rad_sw_in_dif_f%from_file )  .OR.        &
-          ( radiation_scheme == 'external'  .AND.  time_since_reference_point < 0.0_wp ) )  THEN
-        CALL calc_diffusion_radiation
-     ENDIF
-
-!
-!--  First pass of radiation interaction:
-!--   1) direct and diffuse irradiance
-!--   2) thermal emissions
-!
-!--  Initialize relavant surface flux arrays and radiation energy sum
-!--  Surface flux
-     surfinswdir  = 0.0_wp
-     surfins      = 0.0_wp
-     surfinl      = 0.0_wp
-     surfoutsl(:) = 0.0_wp
-     surfoutll(:) = 0.0_wp
-     IF ( nmrtbl > 0 )  THEN
-        mrtinsw(:) = 0.0_wp
-        mrtinlw(:) = 0.0_wp
-     ENDIF
-     surfinlg(:) = 0.0_wp
-!
-!--  Radiation energy sum
-     pinlwl           = 0.0_wp
-     pinswl           = 0.0_wp
-     pemitlwl         = 0.0_wp
-     pabsswl          = 0.0_wp
-     pabslwl          = 0.0_wp
-     pabs_surf_lwdifl = 0.0_wp
-     pabs_pc_lwdifl   = 0.0_wp
-!
-!--  Set up thermal radiation from surfaces
-     mm = 1
-!--  Following code depends on the order of the execution. Do not parallelize by OpenMP!
-     DO  i = nxl, nxr
-        DO  j = nys, nyn
-!
-!--        Horizontal walls
-           DO  l = 0, 1
-!--           Urban
-              DO  m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i)
-                 surfoutll(mm) = SUM( surf_usm_h(l)%frac(m,:) * surf_usm_h(l)%emissivity(m,:) ) *  &
-                                 sigma_sb * surf_usm_h(l)%pt_surface(m)**4
-                 albedo_surf(mm) = SUM( surf_usm_h(l)%frac(m,:) * surf_usm_h(l)%albedo(m,:) )
-                 emiss_surf(mm)  = SUM( surf_usm_h(l)%frac(m,:) * surf_usm_h(l)%emissivity(m,:) )
-                 mm = mm + 1
-              ENDDO
-!
-!--           Land
-              DO  m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i)
-                 surfoutll(mm) = SUM( surf_lsm_h(l)%frac(m,:) * surf_lsm_h(l)%emissivity(m,:) ) *  &
-                                 sigma_sb * surf_lsm_h(l)%pt_surface(m)**4
-                 albedo_surf(mm) = SUM( surf_lsm_h(l)%frac(m,:) * surf_lsm_h(l)%albedo(m,:) )
-                 emiss_surf(mm)  = SUM( surf_lsm_h(l)%frac(m,:) * surf_lsm_h(l)%emissivity(m,:) )
-                 mm = mm + 1
-              ENDDO
-           ENDDO
-!
-!--        Vertical walls
-           DO  l = 0, 3
-!
-!--           Urban
-              DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
-                 surfoutll(mm) = SUM( surf_usm_v(l)%frac(m,:) * surf_usm_v(l)%emissivity(m,:) ) *  &
-                                 sigma_sb * surf_usm_v(l)%pt_surface(m)**4
-                 albedo_surf(mm) = SUM( surf_usm_v(l)%frac(m,:) * surf_usm_v(l)%albedo(m,:) )
-                 emiss_surf(mm)  = SUM( surf_usm_v(l)%frac(m,:) * surf_usm_v(l)%emissivity(m,:) )
-                 mm = mm + 1
-              ENDDO
-!
-!--           Land
-              DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
-                 surfoutll(mm) = SUM( surf_lsm_v(l)%frac(m,:) * surf_lsm_v(l)%emissivity(m,:) ) *  &
-                                 sigma_sb * surf_lsm_v(l)%pt_surface(m)**4
-                 albedo_surf(mm) = SUM( surf_lsm_v(l)%frac(m,:) * surf_lsm_v(l)%albedo(m,:) )
-                 emiss_surf(mm)  = SUM( surf_lsm_v(l)%frac(m,:) * surf_lsm_v(l)%emissivity(m,:) )
-                 mm = mm + 1
-              ENDDO
-           ENDDO
-        ENDDO
-     ENDDO
-
-     IF ( trace_fluxes_above >= 0.0_wp )  THEN
-        CALL radiation_print_debug_surf( 'surfoutll before initial pass', surfoutll )
-        CALL radiation_print_debug_horz( 'rad_lw_in_diff before initial pass', rad_lw_in_diff )
-        CALL radiation_print_debug_horz( 'rad_sw_in_diff before initial pass', rad_sw_in_diff )
-        CALL radiation_print_debug_horz( 'rad_sw_in_dir before initial pass', rad_sw_in_dir )
-     ENDIF
-
-#if defined( __parallel )
-!
-!--  Might be optimized and gather only values relevant for current processor
-     CALL MPI_ALLGATHERV( surfoutll, nsurfl, MPI_REAL, surfoutl, nsurfs, surfstart, MPI_REAL,      &
-                          comm2d, ierr ) ! nsurf global
-     IF ( ierr /= 0 )  THEN
-         WRITE( 9, * ) 'Error MPI_ALLGATHERV1:', ierr, SIZE( surfoutll ), nsurfl, SIZE( surfoutl ),&
-                       nsurfs, surfstart
-         FLUSH( 9 )
-     ENDIF
-#else
-     surfoutl(:) = surfoutll(:)  ! nsurf global
-#endif
-
-     IF ( surface_reflections)  THEN
-        !$OMP PARALLEL DO PRIVATE (i, j, k, isvf, isurf, isurfsrc, temp) SCHEDULE (STATIC)
-        DO  isvf = 1, nsvfl
-           isurf = svfsurf(1, isvf)
-           k     = surfl(iz, isurf)
-           j     = surfl(iy, isurf)
-           i     = surfl(ix, isurf)
-           isurfsrc = svfsurf(2, isvf)
-!
-!--        For surface-to-surface factors we calculate thermal radiation in 1st pass
-           IF ( plant_lw_interact )  THEN
-              temp = svf(1,isvf) * svf(2,isvf) * surfoutl(isurfsrc)
-           ELSE
-              temp = svf(1,isvf) * surfoutl(isurfsrc)
-           ENDIF
-           !$OMP ATOMIC
-           surfinl(isurf) = surfinl(isurf) + temp
-        ENDDO
-     ENDIF
-!
-!--  Diffuse radiation using sky view factor
-     !$OMP PARALLEL DO PRIVATE (i, j, d, isurf) REDUCTION(+:pinswl, pinlwl) SCHEDULE (STATIC)
-     DO  isurf = 1, nsurfl
-        j = surfl(iy, isurf)
-        i = surfl(ix, isurf)
-        d = surfl(id, isurf)
-        surfinswdif(isurf) = rad_sw_in_diff(j,i) * skyvft(isurf)
-!
-!--     Update received SW energy for RTM coupling
-        pinswl = pinswl + surfinswdif(isurf) * facearea(d)
-        IF ( plant_lw_interact )  THEN
-           surfinlwdif(isurf) = rad_lw_in_diff(j,i) * skyvft(isurf)
-        ELSE
-           surfinlwdif(isurf) = rad_lw_in_diff(j,i) * skyvf(isurf)
-        ENDIF
-!
-!--     Update received LW energy for RTM coupling
-        pinlwl = pinlwl + surfinlwdif(isurf) * facearea(d)
-     ENDDO
-!
-!--  MRT diffuse irradiance
-     !$OMP PARALLEL DO PRIVATE (i, j, imrt) SCHEDULE (STATIC)
-     DO  imrt = 1, nmrtbl
-        j = mrtbl(iy, imrt)
-        i = mrtbl(ix, imrt)
-        mrtinsw(imrt) = mrtskyt(imrt) * rad_sw_in_diff(j,i)
-        mrtinlw(imrt) = mrtsky(imrt) * rad_lw_in_diff(j,i)
-     ENDDO
-!
-!--  Direct radiation
-     IF ( cos_zenith > 0 )  THEN
-!
-!--     To avoid numerical instability near horizon depending on what direct radiation is used
-!--     (slightly different zenith angle, considering circumsolar etc.), we use a minimum value for
-!--     cos_zenith
-        sun_direct_factor = 1._wp / MAX( min_stable_coszen, cos_zenith )
-!
-!--     Identify solar direction vector (discretized number) (1)
-        solar_azim = ATAN2( sun_dir_lon, sun_dir_lat ) * ( 180.0_wp / pi ) - rotation_angle
-        j = FLOOR( ACOS( cos_zenith ) / pi * raytrace_discrete_elevs )
-        i = MODULO( NINT( solar_azim / 360.0_wp * raytrace_discrete_azims - 0.5_wp, iwp ),         &
-                          raytrace_discrete_azims )
-        isd = dsidir_rev(j, i)
-!
-!-- TODO: check if isd = -1 to report that this solar position is not precalculated
-        !$OMP PARALLEL DO PRIVATE (i, j, d, isurf)  REDUCTION(+:pinswl) SCHEDULE (STATIC)
-        DO  isurf = 1, nsurfl
-           j = surfl(iy, isurf)
-           i = surfl(ix, isurf)
-           d = surfl(id, isurf)
-           surfinswdir(isurf) = rad_sw_in_dir(j,i) * costheta(surfl(id, isurf)) *                  &
-                                dsitrans(isurf, isd) * sun_direct_factor
-!
-!--        Update received SW energy for RTM coupling
-           pinswl = pinswl + surfinswdir(isurf) * facearea(d)
-        ENDDO
-!
-!--     MRT direct irradiance
-        !$OMP PARALLEL DO PRIVATE (i, j, imrt) SCHEDULE (STATIC)
-        DO  imrt = 1, nmrtbl
-           j = mrtbl(iy, imrt)
-           i = mrtbl(ix, imrt)
-           mrtinsw(imrt) = mrtinsw(imrt) + mrtdsit(imrt, isd) * rad_sw_in_dir(j,i) *               &
-                           sun_direct_factor / 4.0_wp  ! Normal to sphere
-        ENDDO
-     ENDIF
-!
-!--  MRT first pass thermal
-     !$OMP PARALLEL DO PRIVATE (imrtf, imrt, isurfsrc, temp) SCHEDULE (STATIC)
-     DO  imrtf = 1, nmrtf
-        imrt          = mrtfsurf(1, imrtf)
-        isurfsrc      = mrtfsurf(2, imrtf)
-        temp          = mrtf(imrtf) * surfoutl(isurfsrc)
-        !$OMP ATOMIC
-        mrtinlw(imrt) = mrtinlw(imrt) + temp
-     ENDDO
-!
-!--  Absorption in each local plant canopy grid box from the first atmospheric pass of radiation
-     IF ( npcbl > 0 )  THEN
-         pcbinswdir(:) = 0.0_wp
-         pcbinswdif(:) = 0.0_wp
-         pcbinlw(:) = 0.0_wp
-
-         !$OMP PARALLEL DO PRIVATE (icsf, ipcgb, i, j, k, kk, isurfsrc, pc_abs_frac, pcrad, asrc) &
-         !$OMP&   REDUCTION(+:pinswl, pinlwl, pabslwl, pemitlwl, pabs_pc_lwdifl, pcbinlw, surfinlg) SCHEDULE (STATIC)
-         DO  icsf = 1, ncsfl
-            ipcgb    = csfsurf(1, icsf)
-            i        = pcbl(ix,ipcgb)
-            j        = pcbl(iy,ipcgb)
-            k        = pcbl(iz,ipcgb)
-            kk       = k - topo_top_ind(j,i,0)  ! lad arrays are defined flat
-            isurfsrc = csfsurf(2, icsf)
-
-             IF ( isurfsrc == -1 )  THEN
-!
-!--             Diffuse radiation from sky
-                pcbinswdif(ipcgb) = csf(1,icsf) * rad_sw_in_diff(j,i)
-!
-!--             Add to the sum of SW radiation energy
-                pinswl = pinswl + pcbinswdif(ipcgb)
-!
-!--             Absorbed diffuse LW radiation from sky minus emitted to sky
-                IF ( plant_lw_interact )  THEN
-                   pcbinlw(ipcgb) = csf(1,icsf) * ( rad_lw_in_diff(j, i) - sigma_sb *              &
-                                                    ( pt(k,j,i) * exner(k) )**4 )
-                   pinlwl = pinlwl + csf(1,icsf) * rad_lw_in_diff(j,i)
-                   pabslwl = pabslwl + csf(1,icsf) * rad_lw_in_diff(j,i)
-                   pemitlwl = pemitlwl + csf(1,icsf) * sigma_sb * ( pt(k,j,i) * exner(k) )**4
-                   pabs_pc_lwdifl = pabs_pc_lwdifl + csf(1,icsf) * rad_lw_in_diff(j,i)
-                ENDIF
-!
-!--             Direct solar radiation
-                IF ( cos_zenith > 0 )  THEN
-!
-!--                Estimate directed box absorption
-                   pc_abs_frac = 1.0_wp - exp( pc_abs_eff * lad_s(kk,j,i) )
-!
-!--                isd has already been established, see (1)
-                   pcbinswdir(ipcgb) = rad_sw_in_dir(j, i) * pc_box_area * pc_abs_frac *           &
-                                       dsitransc(ipcgb, isd)
-!
-!--               Add to the sum of SW radiation energy
-                  pinswl = pinswl + pcbinswdir(ipcgb)
-                ENDIF
-             ELSE
-                IF ( plant_lw_interact )  THEN
-!
-!--                Thermal emission from plan canopy towards respective face
-                   pcrad = sigma_sb * ( pt(k,j,i) * exner(k) )**4 * csf(1,icsf)
-                   surfinlg(isurfsrc) = surfinlg(isurfsrc) + pcrad
-!
-!--                Remove the flux above + absorb LW from first pass from surfaces
-                   asrc = facearea(surf(id, isurfsrc))
-                   pcbinlw(ipcgb) = pcbinlw(ipcgb)                      &
-                                    + (csf(1,icsf) * surfoutl(isurfsrc) & ! Absorb from first pass surf emit
-                                       - pcrad)                         & ! Remove emitted heatflux
-                                    * asrc
-                   pabslwl = pabslwl + csf(1,icsf) * surfoutl(isurfsrc) * asrc
-                   pemitlwl = pemitlwl + pcrad * asrc
-                ENDIF
-             ENDIF
-         ENDDO
-
-         pcbinsw(:) = pcbinswdir(:) + pcbinswdif(:)
-     ENDIF
-
-     IF ( trace_fluxes_above >= 0.0_wp )  THEN
-        CALL radiation_print_debug_surf( 'surfinl after initial pass', surfinl )
-        CALL radiation_print_debug_surf( 'surfinlwdif after initial pass', surfinlwdif )
-        CALL radiation_print_debug_surf( 'surfinswdif after initial pass', surfinswdif )
-        CALL radiation_print_debug_surf( 'surfinswdir after initial pass', surfinswdir )
-        IF ( npcbl > 0 )  THEN
-           CALL radiation_print_debug_pcb( 'pcbinlw after initial pass', pcbinlw )
-           CALL radiation_print_debug_pcb( 'pcbinswdif after initial pass', pcbinswdif )
-           CALL radiation_print_debug_pcb( 'pcbinswdir after initial pass', pcbinswdir )
-        ENDIF
-     ENDIF
-
-     IF ( plant_lw_interact )  THEN
-!
-!--     Exchange incoming lw radiation from plant canopy
-#if defined( __parallel )
-        CALL MPI_ALLREDUCE( MPI_IN_PLACE, surfinlg, nsurf, MPI_REAL, MPI_SUM, comm2d, ierr )
-        IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_ALLREDUCE:', ierr
-           FLUSH( 9 )
-        ENDIF
-        surfinl(:) = surfinl(:) + surfinlg(surfstart(myid)+1:surfstart(myid+1))
-#else
-        surfinl(:) = surfinl(:) + surfinlg(:)
-#endif
-     ENDIF
-
-     IF ( trace_fluxes_above >= 0.0_wp )  THEN
-        CALL radiation_print_debug_surf( 'surfinl after PC emiss', surfinl )
-     ENDIF
-
-     surfins     = surfinswdir + surfinswdif
-     surfinl     = surfinl + surfinlwdif
-     surfinsw    = surfins
-     surfinlw    = surfinl
-     surfoutsw   = 0.0_wp
-     surfoutlw   = surfoutll
-     surfemitlwl = surfoutll
-
-     IF ( .NOT.  surface_reflections )  THEN
-!
-!--     Set nrefsteps to 0 to disable reflections
-        nrefsteps = 0
-        surfoutsl = albedo_surf * surfins
-        surfoutll = ( 1.0_wp - emiss_surf ) * surfinl
-        surfoutsw = surfoutsw + surfoutsl
-        surfoutlw = surfoutlw + surfoutll
-     ENDIF
-!
-!--  Next passes of radiation interactions: Radiation reflections
-     DO  refstep = 1, nrefsteps
-
-        surfoutsl = albedo_surf * surfins
-!
-!--     For non-transparent surfaces, longwave albedo is 1 - emissivity
-        surfoutll = ( 1.0_wp - emiss_surf ) * surfinl
-
-        IF ( trace_fluxes_above >= 0.0_wp )  THEN
-           CALL radiation_print_debug_surf( 'surfoutll before reflective pass', surfoutll, refstep )
-           CALL radiation_print_debug_surf( 'surfoutsl before reflective pass', surfoutsl, refstep )
-        ENDIF
-
-#if defined( __parallel )
-        CALL MPI_ALLGATHERV( surfoutsl, nsurfl, MPI_REAL, surfouts, nsurfs, surfstart, MPI_REAL,   &
-                             comm2d, ierr )
-        IF ( ierr /= 0 )  THEN
-            WRITE( 9, * ) 'Error MPI_ALLGATHERV2:', ierr, SIZE( surfoutsl ), nsurfl,               &
-                          SIZE( surfouts ), nsurfs, surfstart
-            FLUSH( 9 )
-        ENDIF
-
-        CALL MPI_ALLGATHERV( surfoutll, nsurfl, MPI_REAL, surfoutl, nsurfs, surfstart, MPI_REAL,   &
-                             comm2d, ierr )
-        IF ( ierr /= 0 )  THEN
-            WRITE( 9, * ) 'Error MPI_ALLGATHERV3:', ierr, SIZE( surfoutll ), nsurfl,               &
-                          SIZE( surfoutl ), nsurfs, surfstart
-            FLUSH( 9 )
-        ENDIF
-
-#else
-        surfouts = surfoutsl
-        surfoutl = surfoutll
-#endif
-!
-!--     Reset for the input from next reflective pass
-        surfins = 0.0_wp
-        surfinl = 0.0_wp
-!
-!--     Reflected radiation
-        !$OMP PARALLEL DO PRIVATE (isvf, isurf, isurfsrc) SCHEDULE (STATIC)
-        DO  isvf = 1, nsvfl
-           isurf = svfsurf(1, isvf)
-           isurfsrc = svfsurf(2, isvf)
-           surfins(isurf) = surfins(isurf) + svf(1,isvf) * svf(2,isvf) * surfouts(isurfsrc)
-           IF ( plant_lw_interact )  THEN
-              surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * svf(2,isvf) * surfoutl(isurfsrc)
-           ELSE
-              surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * surfoutl(isurfsrc)
-           ENDIF
-        ENDDO
-!
-!--     NOTE: PC absorbtion and MRT from reflected can both be done at once after all reflections
-!--     if we do one more MPI_ALLGATHERV on surfout.
-!--     Advantage: less local computation. Disadvantage: one more collective MPI call.
-!
-!--     Radiation absorbed by plant canopy
-        !$OMP PARALLEL DO PRIVATE (icsf, ipcgb, isurfsrc, asrc, temp) SCHEDULE (STATIC)
-        DO  icsf = 1, ncsfl
-           ipcgb = csfsurf(1, icsf)
-           isurfsrc = csfsurf(2, icsf)
-           IF ( isurfsrc == -1 )  CYCLE ! sky->face only in 1st pass, not here
-!
-!--        Calculate source surface area. If the `surf' array is removed before timestepping starts
-!--        (future version), then asrc must be stored within `csf'
-           asrc = facearea(surf(id, isurfsrc))
-           temp = csf(1,icsf) * surfouts(isurfsrc) * asrc
-           !$OMP ATOMIC
-           pcbinsw(ipcgb) = pcbinsw(ipcgb) + temp
-           IF ( plant_lw_interact )  THEN
-              temp = csf(1,icsf) * surfoutl(isurfsrc) * asrc
-              !$OMP ATOMIC
-              pcbinlw(ipcgb) = pcbinlw(ipcgb) + temp
-           ENDIF
-        ENDDO
-!
-!--     MRT reflected
-        !$OMP PARALLEL DO PRIVATE (imrtf, imrt, isurfsrc, temp) SCHEDULE (STATIC)
-        DO  imrtf = 1, nmrtf
-           imrt          = mrtfsurf(1, imrtf)
-           isurfsrc      = mrtfsurf(2, imrtf)
-           temp          = mrtft(imrtf) * surfouts(isurfsrc)
-           !$OMP ATOMIC
-           mrtinsw(imrt) = mrtinsw(imrt) + temp
-           temp          = mrtf(imrtf) * surfoutl(isurfsrc)
-           !$OMP ATOMIC
-           mrtinlw(imrt) = mrtinlw(imrt) + temp
-        ENDDO
-
-        IF ( trace_fluxes_above >= 0.0_wp )  THEN
-           CALL radiation_print_debug_surf( 'surfinl after reflected pass', surfinl, refstep )
-           CALL radiation_print_debug_surf( 'surfins after reflected pass', surfins, refstep )
-           IF ( npcbl > 0 )  THEN
-              CALL radiation_print_debug_pcb( 'pcbinlw after reflected pass', pcbinlw, refstep )
-              CALL radiation_print_debug_pcb( 'pcbinsw after reflected pass', pcbinsw, refstep )
-           ENDIF
-        ENDIF
-
-        surfinsw  = surfinsw  + surfins
-        surfinlw  = surfinlw  + surfinl
-        surfoutsw = surfoutsw + surfoutsl
-        surfoutlw = surfoutlw + surfoutll
-
-     ENDDO ! refstep
-!
-!--  Push heat flux absorbed by plant canopy to respective 3D arrays and add absorbed SW radiation
-!--  energy for RTM coupling variables
-     IF ( npcbl > 0 )  THEN
-         pcm_heating_rate(:,:,:) = 0.0_wp
-         !$OMP PARALLEL DO PRIVATE (ipcgb, i, j, k, kk) REDUCTION(+:pabsswl) SCHEDULE (STATIC)
-         DO  ipcgb = 1, npcbl
-            j = pcbl(iy, ipcgb)
-            i = pcbl(ix, ipcgb)
-            k = pcbl(iz, ipcgb)
-!
-!--         Following expression equals former kk = k - nzb_s_inner(j,i)
-            kk = k - topo_top_ind(j,i,0)  ! lad arrays are defined flat
-            pcm_heating_rate(kk, j, i) = ( pcbinsw(ipcgb) + pcbinlw(ipcgb) ) * pchf_prep(k) *      &
-                                         pt(k, j, i) !-- = dT/dt
-!
-!--         Add the absorbed SW radiation energy by plant canopy
-            pabsswl = pabsswl + pcbinsw(ipcgb)
-         ENDDO
-
-         IF ( humidity .AND. plant_canopy_transpiration )  THEN
-!--          Calculation of plant canopy transpiration rate and correspondidng latent heat rate
-             pcm_transpiration_rate(:,:,:) = 0.0_wp
-             pcm_latent_rate(:,:,:) = 0.0_wp
-             !$OMP PARALLEL DO PRIVATE (ipcgb, i, j, k, kk) SCHEDULE (STATIC)
-             DO  ipcgb = 1, npcbl
-                i = pcbl(ix, ipcgb)
-                j = pcbl(iy, ipcgb)
-                k = pcbl(iz, ipcgb)
-                kk = k - topo_top_ind(j,i,0)  ! lad arrays are defined flat
-                CALL pcm_calc_transpiration_rate( i, j, k, kk, pcbinsw(ipcgb), pcbinlw(ipcgb),     &
-                                                  pcm_transpiration_rate(kk,j,i),                  &
-                                                  pcm_latent_rate(kk,j,i) )
-             ENDDO
-         ENDIF
-     ENDIF
-!
-!--  Calculate black body MRT (after all reflections)
-     IF ( nmrtbl > 0 )  THEN
-        IF ( mrt_include_sw )  THEN
-           mrt(:) = ( (mrtinsw(:) + mrtinlw(:) ) / sigma_sb)** 0.25_wp
-        ELSE
-           mrt(:) = ( mrtinlw(:) / sigma_sb )** 0.25_wp
-        ENDIF
-     ENDIF
-!
-!--  Transfer radiation arrays required for energy balance to the respective data types and
-!--  claculate relevant radiation model-RTM coupling terms
-     mm = 1
-!
-!--  Following code depends on the order of the execution. Do not parallelize by OpenMP!
-     DO  i = nxl, nxr
-        DO  j = nys, nyn
-!
-!--        Horizontal walls
-           DO  l = 0, 1
-!
-!--           Urban
-              DO  m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i)
-                 surf_usm_h(l)%rad_sw_in(m)  = surfinsw(mm)
-                 surf_usm_h(l)%rad_sw_out(m) = surfoutsw(mm)
-                 surf_usm_h(l)%rad_sw_dir(m) = surfinswdir(mm)
-                 surf_usm_h(l)%rad_sw_dif(m) = surfinswdif(mm)
-                 surf_usm_h(l)%rad_sw_ref(m) = surfinsw(mm) - surfinswdir(mm) - surfinswdif(mm)
-                 surf_usm_h(l)%rad_sw_res(m) = surfins(mm)
-                 surf_usm_h(l)%rad_lw_in(m)  = surfinlw(mm)
-                 surf_usm_h(l)%rad_lw_out(m) = surfoutlw(mm)
-                 surf_usm_h(l)%rad_net(m)    = surfinsw(mm) - surfoutsw(mm) + surfinlw(mm) -       &
-                                               surfoutlw(mm)
-                 surf_usm_h(l)%rad_net_l(m)  = surf_usm_h(l)%rad_net(m)
-                 surf_usm_h(l)%rad_lw_dif(m) = surfinlwdif(mm)
-                 surf_usm_h(l)%rad_lw_ref(m) = surfinlw(mm) - surfinlwdif(mm)
-                 surf_usm_h(l)%rad_lw_res(m) = surfinl(mm)
-                 mm = mm + 1
-              ENDDO
-!
-!--           Land
-              DO  m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i)
-                 surf_lsm_h(l)%rad_sw_in(m)  = surfinsw(mm)
-                 surf_lsm_h(l)%rad_sw_out(m) = surfoutsw(mm)
-                 surf_lsm_h(l)%rad_sw_dir(m) = surfinswdir(mm)
-                 surf_lsm_h(l)%rad_sw_dif(m) = surfinswdif(mm)
-                 surf_lsm_h(l)%rad_sw_ref(m) = surfinsw(mm) - surfinswdir(mm) - surfinswdif(mm)
-                 surf_lsm_h(l)%rad_sw_res(m) = surfins(mm)
-                 surf_lsm_h(l)%rad_lw_in(m)  = surfinlw(mm)
-                 surf_lsm_h(l)%rad_lw_out(m) = surfoutlw(mm)
-                 surf_lsm_h(l)%rad_net(m)    = surfinsw(mm) - surfoutsw(mm) + surfinlw(mm) -       &
-                                               surfoutlw(mm)
-                 surf_lsm_h(l)%rad_lw_dif(m) = surfinlwdif(mm)
-                 surf_lsm_h(l)%rad_lw_ref(m) = surfinlw(mm) - surfinlwdif(mm)
-                 surf_lsm_h(l)%rad_lw_res(m) = surfinl(mm)
-                 mm = mm + 1
-              ENDDO
-           ENDDO
-!
-!--        Vertical walls
-           DO  l = 0, 3
-!
-!--           Urban
-              DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
-                 surf_usm_v(l)%rad_sw_in(m)  = surfinsw(mm)
-                 surf_usm_v(l)%rad_sw_out(m) = surfoutsw(mm)
-                 surf_usm_v(l)%rad_sw_dir(m) = surfinswdir(mm)
-                 surf_usm_v(l)%rad_sw_dif(m) = surfinswdif(mm)
-                 surf_usm_v(l)%rad_sw_ref(m) = surfinsw(mm) - surfinswdir(mm) - surfinswdif(mm)
-                 surf_usm_v(l)%rad_sw_res(m) = surfins(mm)
-                 surf_usm_v(l)%rad_lw_in(m)  = surfinlw(mm)
-                 surf_usm_v(l)%rad_lw_out(m) = surfoutlw(mm)
-                 surf_usm_v(l)%rad_net(m)    = surfinsw(mm) - surfoutsw(mm) + surfinlw(mm) -       &
-                                               surfoutlw(mm)
-                 surf_usm_v(l)%rad_net_l(m)  = surf_usm_v(l)%rad_net(m)
-                 surf_usm_v(l)%rad_lw_dif(m) = surfinlwdif(mm)
-                 surf_usm_v(l)%rad_lw_ref(m) = surfinlw(mm) - surfinlwdif(mm)
-                 surf_usm_v(l)%rad_lw_res(m) = surfinl(mm)
-                 mm = mm + 1
-              ENDDO
-!
-!--           Land
-              DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
-                 surf_lsm_v(l)%rad_sw_in(m)  = surfinsw(mm)
-                 surf_lsm_v(l)%rad_sw_out(m) = surfoutsw(mm)
-                 surf_lsm_v(l)%rad_sw_dir(m) = surfinswdir(mm)
-                 surf_lsm_v(l)%rad_sw_dif(m) = surfinswdif(mm)
-                 surf_lsm_v(l)%rad_sw_ref(m) = surfinsw(mm) - surfinswdir(mm) - surfinswdif(mm)
-                 surf_lsm_v(l)%rad_sw_res(m) = surfins(mm)
-                 surf_lsm_v(l)%rad_lw_in(m)  = surfinlw(mm)
-                 surf_lsm_v(l)%rad_lw_out(m) = surfoutlw(mm)
-                 surf_lsm_v(l)%rad_net(m)    = surfinsw(mm) - surfoutsw(mm) + surfinlw(mm) -       &
-                                               surfoutlw(mm)
-                 surf_lsm_v(l)%rad_lw_dif(m) = surfinlwdif(mm)
-                 surf_lsm_v(l)%rad_lw_ref(m) = surfinlw(mm) - surfinlwdif(mm)
-                 surf_lsm_v(l)%rad_lw_res(m) = surfinl(mm)
-                 mm = mm + 1
-              ENDDO
-           ENDDO
-        ENDDO
-     ENDDO
-
-     !$OMP PARALLEL DO PRIVATE (i, d) REDUCTION(+:pabsswl, pabslwl, pemitlwl, pabs_surf_lwdifl) &
-     !$OMP&            SCHEDULE (STATIC)
-     DO  i = 1, nsurfl
-        d = surfl(id, i)
-!
-!--     RTM coupling terms
-!--     Sum of absorbed SW & LW radiation energy
-        pabsswl = pabsswl + ( 1.0_wp - albedo_surf(i) ) * surfinsw(i) * facearea(d)
-        pabslwl = pabslwl + emiss_surf(i) * surfinlw(i) * facearea(d)
-!
-!--     Sum of emitted LW radiation energy
-        pemitlwl = pemitlwl + surfemitlwl(i) * facearea(d)
-!
-!--     emiss1
-        pabs_surf_lwdifl = pabs_surf_lwdifl + emiss_surf(i) * facearea(d) * surfinlwdif(i)
-     ENDDO
-
-     DO  l = 0, 1
-        !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC)
-        DO  m = 1, surf_usm_h(l)%ns
-           surf_usm_h(l)%surfhf(m) = surf_usm_h(l)%rad_sw_in(m) + surf_usm_h(l)%rad_lw_in(m) -     &
-                                     surf_usm_h(l)%rad_sw_out(m) - surf_usm_h(l)%rad_lw_out(m)
-        ENDDO
-        !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC)
-        DO  m = 1, surf_lsm_h(l)%ns
-           surf_lsm_h(l)%surfhf(m) = surf_lsm_h(l)%rad_sw_in(m) + surf_lsm_h(l)%rad_lw_in(m) -     &
-                                     surf_lsm_h(l)%rad_sw_out(m) - surf_lsm_h(l)%rad_lw_out(m)
-        ENDDO
-     ENDDO
-
-     DO  l = 0, 3
-!
-!--     Urban
-        !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC)
-        DO  m = 1, surf_usm_v(l)%ns
-           surf_usm_v(l)%surfhf(m) = surf_usm_v(l)%rad_sw_in(m) + surf_usm_v(l)%rad_lw_in(m) -     &
-                                     surf_usm_v(l)%rad_sw_out(m) - surf_usm_v(l)%rad_lw_out(m)
-        ENDDO
-!
-!--     Land
-        !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC)
-        DO  m = 1, surf_lsm_v(l)%ns
-           surf_lsm_v(l)%surfhf(m) = surf_lsm_v(l)%rad_sw_in(m) + surf_lsm_v(l)%rad_lw_in(m) -     &
-                                     surf_lsm_v(l)%rad_sw_out(m) - surf_lsm_v(l)%rad_lw_out(m)
-
-        ENDDO
-     ENDDO
-!
-!--  Gather all rad flux energy in all processors. In order to reduce the number of MPI calls
-!--  (to reduce latencies), combine the required quantities in one array, sum it up, and
-!--  subsequently re-distribute back to the respective quantities.
-#if defined( __parallel )
-     combine_allreduce_l(1) = pinswl
-     combine_allreduce_l(2) = pinlwl
-     combine_allreduce_l(3) = pabsswl
-     combine_allreduce_l(4) = pabslwl
-     combine_allreduce_l(5) = pemitlwl
-     combine_allreduce_l(6) = pabs_surf_lwdifl
-     combine_allreduce_l(7) = pabs_pc_lwdifl
-
-     CALL MPI_ALLREDUCE( combine_allreduce_l, combine_allreduce, SIZE( combine_allreduce ),        &
-                         MPI_REAL, MPI_SUM, comm2d, ierr )
-
-     pinsw           = combine_allreduce(1)
-     pinlw           = combine_allreduce(2)
-     pabssw          = combine_allreduce(3)
-     pabslw          = combine_allreduce(4)
-     pemitlw         = combine_allreduce(5)
-     pabs_surf_lwdif = combine_allreduce(6)
-     pabs_pc_lwdif   = combine_allreduce(7)
-#else
-     pinsw           = pinswl
-     pinlw           = pinlwl
-     pabssw          = pabsswl
-     pabslw          = pabslwl
-     pemitlw         = pemitlwl
-     pabs_surf_lwdif = pabs_surf_lwdifl
-     pabs_pc_lwdif   = pabs_pc_lwdifl
-#endif
-!
-!--  Calculate the effective radiation surface parameters based on the parameterizations in Krc et
-!--  al. 2020
-
-!
-!--  (1) Albedo Eq. * in Krc et al. 2020
-     IF ( pinsw /= 0.0_wp )  albedo_urb = ( pinsw - pabssw ) / pinsw
-
-!
-!--  (2) Emmsivity Eq. * in Krc et al. 2020
-!--  emissivity_urb weighted average of surface and PC emissivity = absorbed LW
-!--  in [surfaces + plant canopy] / pinlw
-     emissivity_urb = (pabs_surf_lwdif + pabs_pc_lwdif) / pinlw
-!
-!--   (3) Temperature
-!--   effective horizontal area to account for the effect of vertical surfaces,
-!--   Eq. * in Krc et al. 2020
-      area_norm = pinlw / rad_lw_in_diff(nyn,nxl)
-!
-!--   Temperature, Eq. * in Krc et al. 2020
-      t_rad_urb = ( ( pemitlw - pabslw + emissivity_urb * pinlw ) /                                &
-                    ( emissivity_urb * sigma_sb * area_norm ) )**0.25_wp
-
-     IF ( debug_output_timestep )  CALL debug_message( 'radiation_interaction', 'end' )
-
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-!> Calculates radiation absorbed by box with given size and LAD.
-!>
-!> Simulates resol**2 rays (by equally spacing a bounding horizontal square conatining all possible
-!> rays that would cross the box) and calculates average transparency per ray. Returns fraction of
-!> absorbed radiation flux and area for which this fraction is effective.
-!--------------------------------------------------------------------------------------------------!
- PURE SUBROUTINE box_absorb( boxsize, resol, dens, uvec, area, absorb )
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, j  !<
-
-    INTEGER(iwp), INTENT(IN) ::  resol  !< No. of rays in x and y dimensions
-
-    REAL(wp) ::  xshift, yshift,               &  !<
-                 xmin, xmax, ymin, ymax,       &  !<
-                 xorig, yorig,                 &  !<
-                 dx1, dy1, dz1, dx2, dy2, dz2, &  !<
-                 crdist,                       &  !<
-                 transp                           !<
-
-    REAL(wp), INTENT(IN) ::  dens  !< box density (e.g. Leaf Area Density)
-
-    REAL(wp), INTENT(OUT) ::  area, &  !< horizontal area for flux absorbtion
-                              absorb   !< fraction of absorbed flux
-
-    REAL(wp), DIMENSION(3), INTENT(IN) ::  boxsize, &  !< z, y, x size of box in m
-                                           uvec        !< z, y, x unit vector of incoming flux
-
-   
-    xshift = uvec(3) / uvec(1) * boxsize(1)
-    xmin = MIN( 0._wp, - xshift )
-    xmax = boxsize(3) + MAX( 0._wp, - xshift )
-    yshift = uvec(2) / uvec(1) * boxsize(1)
-    ymin = MIN( 0._wp, - yshift )
-    ymax = boxsize(2) + MAX( 0._wp, - yshift )
-
-    transp = 0._wp
-    DO  i = 1, resol
-       xorig = xmin + ( xmax - xmin ) * ( i - .5_wp ) / resol
-       DO  j = 1, resol
-          yorig = ymin + ( ymax - ymin ) * ( j - .5_wp ) / resol
-
-          dz1 = 0._wp
-          dz2 = boxsize(1) / uvec(1)
-
-          IF ( uvec(2) > 0._wp )  THEN
-             dy1 = - yorig                / uvec(2)  !< Crossing with y=0
-             dy2 = ( boxsize(2) - yorig ) / uvec(2)  !< Crossing with y=boxsize(2)
-          ELSE  ! uvec(2) == 0
-             dy1 = - HUGE( 1._wp )
-             dy2 = HUGE( 1._wp )
-          ENDIF
-
-          IF ( uvec(3) > 0._wp )  THEN
-             dx1 = - xorig                / uvec(3)  !< Crossing with x=0
-             dx2 = ( boxsize(3) - xorig ) / uvec(3)  !< Crossing with x=boxsize(3)
-          ELSE  ! uvec(3) == 0
-             dx1 = - HUGE( 1._wp )
-             dx2 = HUGE( 1._wp )
-          ENDIF
-
-          crdist = MAX( 0._wp, ( MIN( dz2, dy2, dx2 ) - MAX( dz1, dy1, dx1 ) ) )
-          transp = transp + EXP( - ext_coef * dens * crdist )
-       ENDDO
-    ENDDO
-    transp = transp / resol**2
-    area = ( boxsize(3) + xshift ) * ( boxsize(2) + yshift )
-    absorb = 1._wp - transp
-
- END SUBROUTINE box_absorb
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine splits direct and diffusion dw radiation for RTM processing.
-!> It sould not be called in case the radiation model already does it.
-!> It follows Boland, Ridley & Brown (2008)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_diffusion_radiation
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  seconds_per_day
-
-    INTEGER(iwp) ::  i              !< grid index x-direction
-    INTEGER(iwp) ::  j              !< grid index y-direction
-    INTEGER(iwp) ::  days_per_year  !< days in the current year
-
-    REAL(wp), PARAMETER ::  lowest_solarUp = 0.1_wp  !< limit the sun elevation to protect stability of the calculation
-
-    REAL(wp) ::  clearnessIndex     !< clearness index
-    REAL(wp) ::  corrected_solarUp  !< corrected solar up radiation
-    REAL(wp) ::  diff_frac          !< diffusion fraction of the radiation
-    REAL(wp) ::  etr                !< extraterestrial radiation
-    REAL(wp) ::  horizontalETR      !< horizontal extraterestrial radiation
-    REAL(wp) ::  second_of_year     !< current second of the year
-    REAL(wp) ::  year_angle         !< angle
-
-!
-!--  Calculate current day and time based on the initial values and simulation time
-     CALL get_date_time( time_since_reference_point, second_of_year = second_of_year,              &
-                         days_per_year = days_per_year    )
-     year_angle = second_of_year / ( REAL( days_per_year, KIND = wp ) * seconds_per_day ) *        &
-                  2.0_wp * pi
-
-     etr = solar_constant * ( 1.00011_wp +  0.034221_wp * COS(year_angle) +                        &
-                                            0.001280_wp * SIN(year_angle) +                        &
-                                            0.000719_wp * COS(2.0_wp * year_angle) +               &
-                                            0.000077_wp * SIN(2.0_wp * year_angle) )
-
-!
-!--  Under a very low angle, we keep extraterestrial radiation at the last small value, therefore
-!--  the clearness index will be pushed towards 0 while keeping full continuity.
-     IF ( cos_zenith <= lowest_solarUp )  THEN
-         corrected_solarUp = lowest_solarUp
-     ELSE
-         corrected_solarUp = cos_zenith
-     ENDIF
-
-     horizontalETR = etr * corrected_solarUp
-
-     DO  i = nxl, nxr
-         DO  j = nys, nyn
-            clearnessIndex = rad_sw_in(0,j,i) / horizontalETR
-            diff_frac = 1.0_wp / ( 1.0_wp + EXP( -5.0033_wp + 8.6025_wp * clearnessIndex ) )
-            rad_sw_in_diff(j,i) = rad_sw_in(0,j,i) * diff_frac
-            rad_sw_in_dir(j,i)  = rad_sw_in(0,j,i) * ( 1.0_wp - diff_frac )
-            rad_lw_in_diff(j,i) = rad_lw_in(0,j,i)
-         ENDDO
-     ENDDO
-
- END SUBROUTINE calc_diffusion_radiation
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Print consecutive radiative extremes if requested to trace early radiation interaction
-!> instabilities.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_print_debug_surf( description, values, step )
-
-    CHARACTER(LEN=50)   ::  location      !<
-    CHARACTER(LEN=1024) ::  debug_string  !<
-
-    CHARACTER(LEN=*), INTENT(IN) ::  description  !<
-
-    INTEGER ::  isurf  !<
-
-    INTEGER(iwp), INTENT(IN), OPTIONAL ::  step  !<
-
-    REAL(wp) ::  x  !<
-
-    REAL(wp), DIMENSION(:), INTENT(IN) ::  values  !<
-
-
-
-
-
-
-
-
-    isurf = MAXLOC( values, DIM = 1 )
-    x = values(isurf)
-    IF ( x < trace_fluxes_above )  RETURN
-
-    IF ( PRESENT( step ) )  THEN
-       WRITE( location, '(A," #",I0)' ) description, step
-    ELSE
-       location = description
-    ENDIF
-
-    WRITE( debug_string, '("Maximum of ",A50," = ",F12.1," at coords i=",I4,", j=",I4,", ' //      &
-                         'k=",I4,", d=",I1,". Alb=",F7.3,", emis=",F7.3)' )                        &
-           location, x, surfl(ix,isurf), surfl(iy,isurf), surfl(iz,isurf), surfl(id,isurf),        &
-           albedo_surf(isurf), emiss_surf(isurf)
-    CALL debug_message( debug_string, 'info' )
-
- END SUBROUTINE
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing Subroutine Description!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_print_debug_pcb( description, values, step )
-
-    CHARACTER(LEN=50)   ::  location      !<
-    CHARACTER(LEN=1024) ::  debug_string  !<
-
-    CHARACTER(LEN=*), INTENT(IN) ::  description  !<
-
-    INTEGER ::  ipcb  !<
-
-    INTEGER(iwp), INTENT(IN), OPTIONAL ::  step  !<
-
-    REAL(wp) ::  x  !<
-
-    REAL(wp), DIMENSION(:), INTENT(in) ::  values  !<
-
-    IF ( npcbl <= 0 )  RETURN
-    ipcb = MAXLOC( values, DIM = 1 )
-    x = values(ipcb) / ( dx * dy * dz(1) )
-    IF ( x < trace_fluxes_above )  RETURN
-
-    IF ( PRESENT( step ) )  THEN
-       WRITE( location, '(A," #",I0)' ) description, step
-    ELSE
-       location = description
-    ENDIF
-
-    WRITE( debug_string, '("Maximum of ",A50," = ",F12.1," at coords i=",I4,", j=",I4,", k=",I4)' )&
-           location, x, pcbl(ix,ipcb), pcbl(iy,ipcb), pcbl(iz,ipcb)
-    CALL debug_message( debug_string, 'info' )
-
- END SUBROUTINE
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing Subroutine Description!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_print_debug_horz( description, values, step )
-
-    CHARACTER(LEN=50)   ::  location      !<
-    CHARACTER(LEN=1024) ::  debug_string  !<
-
-    CHARACTER(LEN=*), INTENT(IN) ::  description  !<
-
-    INTEGER(iwp), INTENT(IN), OPTIONAL ::  step  !<
-
-    INTEGER, DIMENSION(2) ::  ji  !<
-
-    REAL(wp) ::  x  !<
-
-    REAL(wp), DIMENSION(:,:), INTENT(IN) ::  values  !<
-
-    ji = MAXLOC( values )
-    x = values( ji(1), ji(2) )
-    IF ( x < trace_fluxes_above )  RETURN
-
-    IF ( PRESENT( step ) )  THEN
-       WRITE( location, '(A," #",I0)' ) description, step
-    ELSE
-       location = description
-    ENDIF
-
-    WRITE( debug_string, '("Maximum of ",A50," = ",F12.1," at coords i=",I4,", j=",I4)' )          &
-           location, x, ji(2), ji(1)
-    CALL debug_message( debug_string, 'info' )
-
- END SUBROUTINE
-
- END SUBROUTINE radiation_interaction
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine initializes structures needed for Radiative Transfer Model (RTM). This model
-!> calculates transformation processes of the radiation inside urban and land canopy layer. The
-!> module includes also the interaction of the radiation with the resolved plant canopy.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_interaction_init
-
-    USE control_parameters,                                                                        &
-        ONLY:  dz_stretch_level_start
-
-    USE plant_canopy_model_mod,                                                                    &
-        ONLY:  lad_s
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, j, k, l, m, d     !<
-    INTEGER(iwp) ::  icol                 !< flat column number (in (y,x) fortran order)
-    INTEGER(iwp) ::  isurf, ipcgb, imrt   !<
-    INTEGER(iwp) ::  k_topo               !< vertical index indicating topography top for given (j,i)
-    INTEGER(iwp) ::  nzptl, nzubl, nzutl  !<
-
-    REAL(wp) ::  mrl  !<
-#if defined( __parallel )
-    INTEGER(iwp) ::  minfo  !< MPI RMA window info handle
-
-    INTEGER(iwp), DIMENSION(:), POINTER, SAVE ::  gridsurf_rma  !< fortran pointer, but lower bounds are 1
-
-    TYPE(c_ptr) ::  gridsurf_rma_p  !< allocated c pointer
-
-#endif
-
-!
-!--  Precalculate face areas for different face directions using normal vector
-     DO  d = 0, nsurf_type
-        facearea(d) = 1._wp
-        IF ( idir(d) == 0 ) facearea(d) = facearea(d) * dx
-        IF ( jdir(d) == 0 ) facearea(d) = facearea(d) * dy
-        IF ( kdir(d) == 0 ) facearea(d) = facearea(d) * dz(1)
-     ENDDO
-!
-!-- Find nz_urban_b, nz_urban_t, nz_urban via wall_flag_0 array (nzb_s_inner will be removed later).
-!-- The following contruct finds the lowest / largest index for any upward-facing wall (see bit 12).
-    nzubl = MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) )
-    nzutl = MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,5) )
-
-    nzubl = MAX( nzubl, nzb )
-
-    IF ( plant_canopy )  THEN
-!
-!--     Allocate needed arrays
-        ALLOCATE( pct(nys:nyn,nxl:nxr) )
-        ALLOCATE( pch(nys:nyn,nxl:nxr) )
-!
-!--     Calculate plant canopy height
-        npcbl = 0
-        pct   = 0
-        pch   = 0
-        DO  i = nxl, nxr
-            DO  j = nys, nyn
-!
-!--            Find topography top index
-               k_topo = topo_top_ind(j,i,0)
-
-               DO  k = nzt+1, 1, -1
-                  IF ( lad_s(k,j,i) > 0.0_wp )  THEN
-!
-!--                   We are at the top of the pcs
-                      pct(j,i) = k + k_topo
-                      pch(j,i) = k
-                      npcbl = npcbl + COUNT( lad_s(1:k,j,i) > 0.0_wp )
-                      EXIT
-                  ENDIF
-               ENDDO
-            ENDDO
-        ENDDO
-
-        nzutl = MAX( nzutl, MAXVAL( pct ) )
-        nzptl = MAXVAL( pct )
-
-        prototype_lad = MAXVAL( lad_s ) * .9_wp  !< Better be *1.0 if lad is either 0 or maxval(lad) everywhere
-        IF ( prototype_lad <= 0._wp )  prototype_lad = .3_wp
-        !WRITE(message_string, '(a,f6.3)') 'Precomputing effective box optical ' &
-        !    // 'depth using prototype leaf area density = ', prototype_lad
-        !CALL message('radiation_interaction_init', 'PA0520', 0, 0, -1, 6, 0)
-    ENDIF
-
-    nzutl = MIN( nzutl + nzut_free, nzt )
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( nzubl, nz_urban_b, 1, MPI_INTEGER, MPI_MIN, comm2d, ierr )
-    IF ( ierr /= 0 )  THEN
-        WRITE( 9, * ) 'Error MPI_ALLREDUCE11:', ierr, nzubl, nz_urban_b
-        FLUSH( 9 )
-    ENDIF
-    CALL MPI_ALLREDUCE( nzutl, nz_urban_t, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
-    IF ( ierr /= 0 )  THEN
-        WRITE( 9, * ) 'Error MPI_ALLREDUCE12:', ierr, nzutl, nz_urban_t
-        FLUSH( 9 )
-    ENDIF
-    CALL MPI_ALLREDUCE( nzptl, nz_plant_t, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
-    IF ( ierr /= 0 )  THEN
-        WRITE( 9, * ) 'Error MPI_ALLREDUCE13:', ierr, nzptl, nz_plant_t
-        FLUSH( 9 )
-    ENDIF
-#else
-    nz_urban_b = nzubl
-    nz_urban_t = nzutl
-    nz_plant_t = nzptl
-#endif
-!
-!-- Stretching (non-uniform grid spacing) is not considered in the radiation model. Therefore,
-!-- vertical stretching has to be applied above the area where the parts of the radiation model
-!-- which assume constant grid spacing are active. ABS (...) is required because the default value
-!-- of dz_stretch_level_start is -9999999.9_wp (negative).
-    IF ( ABS( dz_stretch_level_start(1) ) <= zw(nz_urban_t) )  THEN
-       WRITE( message_string, * ) 'The lowest level where vertical stretching is applied have ' // &
-                                  'to be greater than ', zw(nz_urban_t)
-       CALL message( 'radiation_interaction_init', 'PA0496', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Global number of urban and plant layers
-    nz_urban = nz_urban_t - nz_urban_b + 1
-    nz_plant = nz_plant_t - nz_urban_b + 1
-!
-!-- Check max_raytracing_dist relative to urban surface layer height
-    mrl = 2.0_wp * nz_urban * dz(1)
-!
-!-- Set max_raytracing_dist to double the urban surface layer height, if not set
-    IF ( max_raytracing_dist == -999.0_wp )  THEN
-       max_raytracing_dist = mrl
-    ENDIF
-!   Check if max_raytracing_dist is set too low (here we only warn the user. Other option is to
-!-- correct the value again to double the urban surface layer height)
-    IF ( max_raytracing_dist  <  mrl )  THEN
-       WRITE( message_string, '(a,f6.1)' ) 'Max_raytracing_dist is set less than double the ' //   &
-                                           'urban surface layer height, i.e. ', mrl
-       CALL message( 'radiation_interaction_init', 'PA0521', 0, 0, 0, 6, 0 )
-    ENDIF
-!     IF ( max_raytracing_dist <= mrl ) THEN
-!        IF ( max_raytracing_dist /= -999.0_wp ) THEN
-! !-        max_raytracing_dist too low
-!           WRITE(message_string, '(a,f6.1)') 'Max_raytracing_dist too low, ' &
-!                 // 'override to value ', mrl
-!           CALL message('radiation_interaction_init', 'PA0521', 0, 0, -1, 6, 0)
-!        ENDIF
-!        max_raytracing_dist = mrl
-!     ENDIF
-!
-!-- Allocate urban surfaces grid
-!-- Calc number of surfaces in local proc
-    IF ( debug_output )  CALL debug_message( 'calculation of indices for surfaces', 'info' )
-
-    nsurfl = 0
-!
-!-- Number of horizontal surfaces including land- and roof surfaces in both USM and LSM. Note that
-!-- all horizontal surface elements are already counted in surface_mod.
-    DO  l = 0, 1
-       nsurfl = nsurfl + surf_usm_h(l)%ns + surf_lsm_h(l)%ns
-    ENDDO
-!
-!-- Number of vertical surfaces in both USM and LSM. Note that all vertical surface elements are
-!-- already counted in surface_mod.
-    DO  l = 0,3
-       nsurfl = nsurfl + surf_usm_v(l)%ns + surf_lsm_v(l)%ns
-    ENDDO
-!
-!-- Fill gridpcbl and pcbl
-    IF ( npcbl > 0 )  THEN
-        ALLOCATE( pcbl(iz:ix, 1:npcbl) )
-        ALLOCATE( gridpcbl(nz_urban_b:nz_plant_t,nys:nyn,nxl:nxr) )
-        pcbl = -1
-        gridpcbl(:,:,:) = 0
-        ipcgb = 0
-        DO  i = nxl, nxr
-           DO  j = nys, nyn
-!
-!--           Find topography top index
-              k_topo = topo_top_ind(j,i,0)
-
-              DO  k = k_topo + 1, pct(j,i)
-                 IF ( lad_s(k-k_topo,j,i) > 0.0_wp )  THEN
-                    ipcgb = ipcgb + 1
-                    gridpcbl(k,j,i) = ipcgb
-                    pcbl(:,ipcgb) = (/ k, j, i /)
-                 ENDIF
-              ENDDO
-           ENDDO
-        ENDDO
-        ALLOCATE( pcbinsw( 1:npcbl ) )
-        ALLOCATE( pcbinswdir( 1:npcbl ) )
-        ALLOCATE( pcbinswdif( 1:npcbl ) )
-        ALLOCATE( pcbinlw( 1:npcbl ) )
-    ENDIF
-
-!
-!-- Fill surfl (the ordering of local surfaces given by the following cycles must not be altered,
-!-- certain file input routines may depend on it).
-!
-!-- We allocate the array as linear and then use a two-dimensional pointer into it, because some MPI
-!-- implementations crash with 2D-allocated arrays.
-    ALLOCATE( surfl_linear(nidx_surf * nsurfl) )
-    surfl(1:nidx_surf,1:nsurfl) => surfl_linear(1:nidx_surf*nsurfl)
-    isurf = 0
-    IF ( rad_angular_discretization )  THEN
-!
-!--    Allocate and fill the reverse indexing array gridsurf
-#if defined( __parallel )
-!
-!--    raytrace_mpi_rma is asserted
-
-       CALL MPI_INFO_CREATE( minfo, ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_INFO_CREATE1:', ierr
-           FLUSH( 9 )
-       ENDIF
-       CALL MPI_INFO_SET( minfo, 'accumulate_ordering', 'none', ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_INFO_SET1:', ierr
-           FLUSH( 9 )
-       ENDIF
-       CALL MPI_INFO_SET( minfo, 'accumulate_ops', 'same_op', ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_INFO_SET2:', ierr
-           FLUSH( 9 )
-       ENDIF
-       CALL MPI_INFO_SET( minfo, 'same_size', 'true', ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_INFO_SET3:', ierr
-           FLUSH( 9 )
-       ENDIF
-       CALL MPI_INFO_SET( minfo, 'same_disp_unit', 'true', ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_INFO_SET4:', ierr
-           FLUSH( 9 )
-       ENDIF
-
-       CALL MPI_WIN_ALLOCATE( INT( STORAGE_SIZE( 1_iwp ) / 8 * nsurf_type_u * nz_urban * nny * nnx,&
-                              KIND = MPI_ADDRESS_KIND ), STORAGE_SIZE( 1_iwp ) / 8, minfo, comm2d, &
-                              gridsurf_rma_p, win_gridsurf, ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_WIN_ALLOCATE1:', ierr,                                         &
-                         INT( STORAGE_SIZE( 1_iwp ) / 8 * nsurf_type_u * nz_urban * nny * nnx,     &
-                         KIND = MPI_ADDRESS_KIND ), STORAGE_SIZE( 1_iwp ) / 8, win_gridsurf
-           FLUSH(9)
-       ENDIF
-
-       CALL MPI_INFO_FREE( minfo, ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_INFO_FREE1:', ierr
-           FLUSH( 9 )
-       ENDIF
-
-!
-!--    On Intel compilers, calling C_F_POINTER to transform a C pointer directly to a
-!--    multi-dimensional Fotran pointer leads to strange errors on dimension boundaries. However,
-!--    transforming to a 1D pointer and then redirecting a multidimensional pointer to it works fine.
-       CALL C_F_POINTER( gridsurf_rma_p, gridsurf_rma, (/ nsurf_type_u * nz_urban * nny * nnx /) )
-       gridsurf(0:nsurf_type_u-1, nz_urban_b:nz_urban_t, nys:nyn, nxl:nxr) =>                      &
-       gridsurf_rma(1:nsurf_type_u * nz_urban * nny * nnx)
-#else
-       ALLOCATE( gridsurf(0:nsurf_type_u-1,nz_urban_b:nz_urban_t,nys:nyn,nxl:nxr) )
-#endif
-       gridsurf(:,:,:,:) = -999
-    ENDIF
-
-    ALLOCATE( surfl_col_start(0:nnx*nny-1), surfg_col_start(0:(nx+1)*(ny+1)) )
-!
-!-- Add horizontal and vertical surface elements (land and urban surfaces) ordered by x,y column
-!-- (y most varying)
-!-- TODO: remove the hard coding of l = 0 to l = idirection
-    icol = 0
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-!
-!--       Save column start
-          surfl_col_start(icol) = isurf + 1
-          icol = icol + 1
-!
-!--       Horizontal surfaces
-          DO  l = 0, 1
-             DO  m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i)
-                k = surf_usm_h(l)%k(m)
-                isurf = isurf + 1
-                surfl(:,isurf) = (/dirint_h(l),k,j,i/)
-             ENDDO
-             DO  m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i)
-                k = surf_lsm_h(l)%k(m)
-                isurf = isurf + 1
-                surfl(:,isurf) = (/dirint_h(l),k,j,i/)
-             ENDDO
-          ENDDO
-!
-!--       Vertical surfaces
-          DO  l = 0, 3
-             DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
-                k = surf_usm_v(l)%k(m)
-                isurf = isurf + 1
-                surfl(:,isurf) = (/dirint_v(l),k,j,i/)
-             ENDDO
-             DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
-                k = surf_lsm_v(l)%k(m)
-                isurf = isurf + 1
-                surfl(:,isurf) = (/dirint_v(l),k,j,i/)
-             ENDDO
-          ENDDO
-
-       ENDDO
-    ENDDO
-!
-!-- Add local MRT boxes for the specified number of levels
-!-- !!!! NEEDS TO RETHINK AGAIN - With full 3D structure, only the one of the upward faced
-!-- !!!! horizontal surfaces should be taken (the lowest one = ground?). mrt_nlevels number of air
-!-- !!!! grid boxes might not be available in case of overhanging structures!
-    nmrtbl = 0
-    IF ( mrt_nlevels > 0 )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-!
-!--             Skip roof if requested
-                IF ( mrt_skip_roof  .AND.  surf_usm_h(0)%isroof_surf(m) )  CYCLE
-!
-!--             Cycle over specified no of levels
-                nmrtbl = nmrtbl + mrt_nlevels
-             ENDDO
-!
-!--          Ditto for LSM
-             DO  m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                nmrtbl = nmrtbl + mrt_nlevels
-             ENDDO
-          ENDDO
-       ENDDO
-
-       ALLOCATE( mrtbl(iz:ix,nmrtbl), mrtsky(nmrtbl), mrtskyt(nmrtbl), mrtinsw(nmrtbl),            &
-                 mrtinlw(nmrtbl), mrt(nmrtbl) )
-
-       imrt = 0
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-!
-!--             Skip roof if requested
-                IF ( mrt_skip_roof  .AND.  surf_usm_h(0)%isroof_surf(m) )  CYCLE
-!
-!--             Cycle over specified no of levels
-                l = surf_usm_h(0)%k(m)
-                DO  k = l, l + mrt_nlevels - 1
-                   imrt = imrt + 1
-                   mrtbl(:,imrt) = (/k,j,i/)
-                ENDDO
-             ENDDO
-!
-!--          Dtto for LSM
-             DO  m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                l = surf_lsm_h(0)%k(m)
-                DO  k = l, l + mrt_nlevels - 1
-                   imrt = imrt + 1
-                   mrtbl(:,imrt) = (/k,j,i/)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
-!
-!-- Broadband albedo of the land, roof and wall surface for domain border and sky set artifically
-!-- to 1.0 what allows us to calculate heat flux leaving over side and top borders of the domain
-    ALLOCATE( albedo_surf(nsurfl) )
-    albedo_surf = 1.0_wp
-!
-!-- Also allocate further array for emissivity with identical order of surface elements as radiation
-!-- arrays.
-    ALLOCATE( emiss_surf(nsurfl)  )
-
-
-!
-!-- Global array surf of indices of surfaces and displacement index array surfstart
-    ALLOCATE( nsurfs(0:numprocs-1) )
-
-#if defined( __parallel )
-    CALL MPI_ALLGATHER( nsurfl, 1, MPI_INTEGER, nsurfs, 1, MPI_INTEGER, comm2d, ierr )
-    IF ( ierr /= 0 )  THEN
-      WRITE( 9, * ) 'Error MPI_ALLGATHER1:', ierr, nsurfl, nsurfs
-      FLUSH( 9 )
-  ENDIF
-
-#else
-    nsurfs(0) = nsurfl
-#endif
-    ALLOCATE( surfstart(0:numprocs) )
-    k = 0
-    DO  i = 0, numprocs-1
-       surfstart(i) = k
-       k = k + nsurfs(i)
-    ENDDO
-    surfstart(numprocs) = k
-    nsurf = k
-!
-!-- We allocate the array as linear and then use a two-dimensional pointer into it, because some MPI
-!-- implementations crash with 2D-allocated arrays.
-    ALLOCATE( surf_linear(nidx_surf*nsurf) )
-    surf(1:nidx_surf,1:nsurf) => surf_linear(1:nidx_surf*nsurf)
-
-#if defined( __parallel )
-    CALL MPI_ALLGATHERV( surfl_linear, nsurfl * nidx_surf, MPI_INTEGER, surf_linear,               &
-                         nsurfs * nidx_surf, surfstart(0:numprocs-1) * nidx_surf, MPI_INTEGER,     &
-                         comm2d, ierr )
-    IF ( ierr /= 0 )  THEN
-        WRITE( 9, * ) 'Error MPI_ALLGATHERV4:', ierr, SIZE( surfl_linear ), nsurfl * nidx_surf,    &
-                      SIZE( surf_linear ), nsurfs * nidx_surf, surfstart(0:numprocs-1) * nidx_surf
-        FLUSH( 9 )
-    ENDIF
-#else
-    surf = surfl
-#endif
-!
-!-- Populate gridsurf with reverse global indices (->surf)
-    IF ( rad_angular_discretization )  THEN
-       DO  isurf = 1, nsurfl
-          gridsurf(surfl(id,isurf),surfl(iz,isurf), surfl(iy,isurf),surfl(ix,isurf)) = isurf +     &
-                                                                                     surfstart(myid)
-       ENDDO
-    ENDIF
-!
-!-- Gather column start indices
-#if defined( __parallel )
-    CALL MPI_ALLGATHER( surfl_col_start, nnx * nny, MPI_INTEGER, surfg_col_start, nnx * nny,       &
-                        MPI_INTEGER, comm2d, ierr )
-    IF ( ierr /= 0 )  THEN
-       WRITE( 9, * ) 'Error MPI_ALLGATHER1b:', ierr, surfl_col_start, surfg_col_start
-       FLUSH( 9 )
-    ENDIF
-!
-!-- Convert local indices (->surfl) to global (->surf)
-    DO  i = 0, numprocs-1
-       surfg_col_start(i*nnx*nny:(i+1)*nnx*nny-1) = surfg_col_start(i*nnx*nny:(i+1)*nnx*nny-1) +   &
-                                                    surfstart(i)
-    ENDDO
-#else
-    surfg_col_start(0:(nx+1)*(ny+1)-1) = surfl_col_start(0:(nx+1)*(ny+1)-1)
-#endif
-    surfg_col_start((nx+1)*(ny+1)) = nsurf+1
-!
-!-- Allocation of the arrays for direct and diffusion radiation
-    IF ( debug_output )  CALL debug_message( 'allocation of radiation arrays', 'info' )
-!-- rad_sw_in, rad_lw_in are computed in radiation model, splitting of direct and diffusion part is
-!-- done in calc_diffusion_radiation for now
-
-    ALLOCATE( rad_sw_in_dir(nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( rad_sw_in_diff(nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( rad_lw_in_diff(nysg:nyng,nxlg:nxrg) )
-    rad_sw_in_dir  = 0.0_wp
-    rad_sw_in_diff = 0.0_wp
-    rad_lw_in_diff = 0.0_wp
-!
-!-- Allocate radiation arrays
-    ALLOCATE( surfins(nsurfl) )
-    ALLOCATE( surfinl(nsurfl) )
-    ALLOCATE( surfinsw(nsurfl) )
-    ALLOCATE( surfinlw(nsurfl) )
-    ALLOCATE( surfinswdir(nsurfl) )
-    ALLOCATE( surfinswdif(nsurfl) )
-    ALLOCATE( surfinlwdif(nsurfl) )
-    ALLOCATE( surfoutsl(nsurfl) )
-    ALLOCATE( surfoutll(nsurfl) )
-    ALLOCATE( surfoutsw(nsurfl) )
-    ALLOCATE( surfoutlw(nsurfl) )
-    ALLOCATE( surfouts(nsurf) )
-    ALLOCATE( surfoutl(nsurf) )
-    ALLOCATE( surfinlg(nsurf) )
-    ALLOCATE( skyvf(nsurfl) )
-    ALLOCATE( skyvft(nsurfl) )
-    ALLOCATE( surfemitlwl(nsurfl) )
-
-!
-!-- In case of average_radiation, aggregated surface albedo and emissivity, also set initial value
-!-- for t_rad_urb.
-!-- For now set an arbitrary initial value.
-    IF ( average_radiation )  THEN
-       albedo_urb = 0.1_wp
-       emissivity_urb = 0.9_wp
-       t_rad_urb = pt_surface
-    ENDIF
-
- END SUBROUTINE radiation_interaction_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates shape view factors (SVF), plant sink canopy factors (PCSF), sky-view factors,
-!> discretized path for direct solar radiation, MRT factors and other preprocessed data needed for
-!> radiation_interaction inside RTM. This subroutine is called only once at the beginning of the
-!> simulation. The resulting factors can be stored to files and reused with other simulations
-!> utilizing the same surface and plant canopy structure.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_calc_svf
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, j, k, ip, jp                                                  !<
-    INTEGER(iwp) ::  isvf, ksvf, icsf, kcsf, npcsfl, isvf_surflt, imrt, imrtf, ipcgb  !<
-    INTEGER(iwp) ::  iaz, izn                                                         !< azimuth, zenith counters
-    INTEGER(iwp) ::  isurflt, isurfs, isurflt_prev                                    !<
-    INTEGER(iwp) ::  itarg0, itarg1                                                   !<
-    INTEGER(iwp) ::  max_track_len                                                    !< maximum 2d track length
-    INTEGER(iwp) ::  naz, nzn                                                         !< azimuth, zenith num of steps
-    INTEGER(idp) ::  ray_skip_maxdist, ray_skip_minval                                !< skipped raytracing counts
-    INTEGER(iwp) ::  sd, td                                                           !<
-    INTEGER(iwp) ::  udim                                                             !<
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  itarget  !< face indices of detected obstacles
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  icsflt   !<
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  kcsflt_l,kpcsflt_l  !<
-
-    INTEGER(iwp), DIMENSION(:,:), POINTER ::  kcsflt,kpcsflt  !<
-
-    LOGICAL ::  visible  !<
-
-    REAL(wp) ::  az0, zn0                             !< starting azimuth/zenith
-    REAL(wp) ::  azs, zns                             !< azimuth/zenith cycle step
-    REAL(wp) ::  az1, az2                             !< relative azimuth of section borders
-    REAL(wp) ::  azmid                                !< ray (center) azimuth
-    REAL(wp) ::  difvf                                !< differential view factor
-    REAL(wp) ::  transparency, rirrf, sqdist, svfsum  !<
-    REAL(wp) ::  yxlen                                !< |yxdir|
-
-
-    REAL(wp), DIMENSION(2) ::  yxdir   !< y,x *unit* vector of ray direction (in grid units)
-    REAL(wp), DIMENSION(3) ::  sa, ta  !< real coordinates z,y,x of source and target
-    REAL(wp), DIMENSION(3) ::  uv      !<
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  vffrac   !< view factor fractions for individual rays
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  vffrac0  !< dtto (original values)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  zdirs    !< directions in z (tangent of elevation)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  zcent    !< zenith angle centers
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  zbdry    !< zenith angle boundaries
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ztransp  !< array of transparency in z steps
-
-    REAL(wp),DIMENSION(:), ALLOCATABLE,TARGET ::  csflt_l, pcsflt_l  !<
-
-    REAL(wp),DIMENSION(:,:), POINTER ::  csflt, pcsflt  !<
-
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  minfo  !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  size_lad_rma  !<
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  nzterrtl_l  !<
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  nzterrbl_l  !<
-
-    INTEGER(iwp), DIMENSION(:,:), POINTER ::  nzterrtl  !<
-    INTEGER(iwp), DIMENSION(:,:), POINTER ::  nzterrbl  !<
-
-    REAL(wp), DIMENSION(:), POINTER, SAVE ::  lad_s_rma  !< fortran 1D pointer
-
-    TYPE(c_ptr) ::  lad_s_rma_p  !< allocated c pointer
-
-
-#endif
-!
-    INTEGER(iwp), DIMENSION(0:svfnorm_report_num) ::  svfnorm_counts  !<
-
-!
-!-- Calculation of the SVF
-    CALL location_message( 'calculating view factors for radiation interaction', 'start' )
-!
-!-- Initialize variables and temporary arrays for calculation of svf and csf
-    nsvfl  = 0
-    ncsfl  = 0
-    nsvfla = gasize
-    msvf   = 1
-    ALLOCATE( asvf1(nsvfla) )
-    asvf => asvf1
-    IF ( plant_canopy )  THEN
-        ncsfla = gasize
-        mcsf   = 1
-        ALLOCATE( acsf1(ncsfla) )
-        acsf => acsf1
-    ENDIF
-    nmrtf = 0
-    IF ( mrt_nlevels > 0 )  THEN
-       nmrtfa = gasize
-       mmrtf = 1
-       ALLOCATE( amrtf1(nmrtfa) )
-       amrtf => amrtf1
-    ENDIF
-    ray_skip_maxdist = 0
-    ray_skip_minval = 0
-!
-!-- Initialize temporary terrain and plant canopy height arrays (global 2D array!)
-    ALLOCATE( nzterrt(0:(nx+1)*(ny+1)-1) )
-    ALLOCATE( nzterrb(0:(nx+1)*(ny+1)-1) )
-#if defined( __parallel )
-    ALLOCATE( nzterrtl_l((nyn-nys+1)*(nxr-nxl+1)) )
-    ALLOCATE( nzterrbl_l((nyn-nys+1)*(nxr-nxl+1)) )
-    nzterrtl(nys:nyn,nxl:nxr) => nzterrtl_l(1:(nyn-nys+1)*(nxr-nxl+1))
-    nzterrbl(nys:nyn,nxl:nxr) => nzterrbl_l(1:(nyn-nys+1)*(nxr-nxl+1))
-    nzterrtl = topo_top_ind(nys:nyn,nxl:nxr,5)
-    nzterrbl = topo_top_ind(nys:nyn,nxl:nxr,0)
-    CALL MPI_ALLGATHER( nzterrtl_l, nnx*nny, MPI_INTEGER, nzterrt, nnx*nny, MPI_INTEGER, comm2d,   &
-                        ierr )
-    IF ( ierr /= 0 )  THEN
-        WRITE( 9, * ) 'Error MPI_ALLGATHER1t:', ierr, SIZE( nzterrtl_l ), nnx*nny, SIZE( nzterrt ),&
-                       nnx*nny
-        FLUSH(9)
-    ENDIF
-    CALL MPI_ALLGATHER( nzterrbl_l, nnx*nny, MPI_INTEGER, nzterrb, nnx*nny, MPI_INTEGER, comm2d,   &
-                        ierr )
-    IF ( ierr /= 0 )  THEN
-        WRITE( 9, * ) 'Error MPI_ALLGATHER1b:', ierr, SIZE( nzterrbl_l ), nnx*nny, SIZE( nzterrb ),&
-                      nnx*nny
-        FLUSH( 9 )
-    ENDIF
-    DEALLOCATE( nzterrtl_l )
-    DEALLOCATE( nzterrbl_l )
-#else
-    nzterrt = RESHAPE( topo_top_ind(nys:nyn,nxl:nxr,5), (/(nx+1)*(ny+1)/) )
-    nzterrb = RESHAPE( topo_top_ind(nys:nyn,nxl:nxr,0), (/(nx+1)*(ny+1)/) )
-#endif
-    IF ( plant_canopy )  THEN
-        ALLOCATE( plantt(0:(nx+1)*(ny+1)-1) )
-        maxboxesg = nx + ny + nz_plant + 1
-        max_track_len = nx + ny + 1
-!
-!--     Temporary arrays storing values for csf calculation during raytracing
-        ALLOCATE( boxes(3, maxboxesg) )
-        ALLOCATE( crlens(maxboxesg) )
-
-#if defined( __parallel )
-        CALL MPI_ALLGATHER( pct, nnx*nny, MPI_INTEGER, plantt, nnx*nny, MPI_INTEGER, comm2d, ierr )
-        IF ( ierr /= 0 )  THEN
-            WRITE( 9, * ) 'Error MPI_ALLGATHER2:', ierr, SIZE( pct ), nnx*nny, SIZE( plantt ),     &
-                          nnx*nny
-            FLUSH( 9 )
-        ENDIF
-!
-!--     Temporary arrays storing values for csf calculation during raytracing
-        ALLOCATE( lad_ip(maxboxesg) )
-        ALLOCATE( lad_disp(maxboxesg) )
-
-        IF ( raytrace_mpi_rma )  THEN
-            ALLOCATE( lad_s_ray(maxboxesg) )
-!
-!--         Set conditions for RMA communication
-            CALL MPI_INFO_CREATE( minfo, ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_INFO_CREATE2:', ierr
-                FLUSH( 9 )
-            ENDIF
-            CALL MPI_INFO_SET( minfo, 'accumulate_ordering', 'none', ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_INFO_SET5:', ierr
-                FLUSH( 9 )
-            ENDIF
-            CALL MPI_INFO_SET( minfo, 'accumulate_ops', 'same_op', ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_INFO_SET6:', ierr
-                FLUSH( 9 )
-            ENDIF
-            CALL MPI_INFO_SET( minfo, 'same_size', 'true', ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_INFO_SET7:', ierr
-                FLUSH( 9 )
-            ENDIF
-            CALL MPI_INFO_SET( minfo, 'same_disp_unit', 'true', ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_INFO_SET8:', ierr
-                FLUSH( 9 )
-            ENDIF
-
-!--         Allocate and initialize the MPI RMA window, must be in accordance with allocation of
-!--         lad_s in plant_canopy_model, optimization of memory should be done.
-!--         Argument X of function STORAGE_SIZE(X) needs arbitrary REAL(wp) value, set to 1.0_wp
-!--         for now.
-            size_lad_rma = STORAGE_SIZE( 1.0_wp ) / 8 * nnx * nny * nz_plant
-            CALL MPI_WIN_ALLOCATE( size_lad_rma, STORAGE_SIZE( 1.0_wp ) / 8, minfo, comm2d,        &
-                                    lad_s_rma_p, win_lad, ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_WIN_ALLOCATE2:', ierr, size_lad_rma,                      &
-                              STORAGE_SIZE( 1.0_wp ) / 8, win_lad
-                FLUSH( 9 )
-            ENDIF
-            CALL C_F_POINTER( lad_s_rma_p, lad_s_rma, (/ nz_plant*nny*nnx /) )
-            sub_lad(nz_urban_b:nz_plant_t, nys:nyn, nxl:nxr) => lad_s_rma(1:nz_plant*nny*nnx)
-        ELSE
-            ALLOCATE( sub_lad(nz_urban_b:nz_plant_t, nys:nyn, nxl:nxr) )
-        ENDIF
-#else
-        plantt = RESHAPE( pct(nys:nyn,nxl:nxr), (/(nx+1)*(ny+1)/) )
-        ALLOCATE( sub_lad(nz_urban_b:nz_plant_t, nys:nyn, nxl:nxr) )
-#endif
-        plantt_max = MAXVAL( plantt )
-        ALLOCATE( rt2_track(2, max_track_len), rt2_track_lad(nz_urban_b:plantt_max, max_track_len),&
-                  rt2_track_dist(0:max_track_len), rt2_dist(plantt_max-nz_urban_b+2) )
-
-        sub_lad(:,:,:) = 0._wp
-        DO  i = nxl, nxr
-           DO  j = nys, nyn
-              k = topo_top_ind(j,i,0)
-
-              sub_lad(k:nz_plant_t, j, i) = lad_s(0:nz_plant_t-k, j, i)
-           ENDDO
-        ENDDO
-
-#if defined( __parallel )
-        IF ( raytrace_mpi_rma )  THEN
-            CALL MPI_INFO_FREE( minfo, ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_INFO_FREE2:', ierr
-                FLUSH( 9 )
-            ENDIF
-            CALL MPI_WIN_LOCK_ALL( 0, win_lad, ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_WIN_LOCK_ALL1:', ierr, win_lad
-                FLUSH( 9 )
-            ENDIF
-
-        ELSE
-            ALLOCATE( sub_lad_g(0:(nx+1)*(ny+1)*nz_plant-1) )
-            CALL MPI_ALLGATHER( sub_lad, nnx*nny*nz_plant, MPI_REAL, sub_lad_g, nnx*nny*nz_plant,  &
-                                MPI_REAL, comm2d, ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_ALLGATHER3:', ierr, SIZE( sub_lad ), nnx*nny*nz_plant,    &
-                               SIZE( sub_lad_g ), nnx*nny*nz_plant
-                FLUSH( 9 )
-            ENDIF
-        ENDIF
-#endif
-    ENDIF
-
-!-- Prepare the MPI_Win for collecting the surface indices from the reverse index arrays gridsurf
-!-- from processors of target surfaces
-#if defined( __parallel )
-    IF ( rad_angular_discretization )  THEN
-!
-!--     raytrace_mpi_rma is asserted
-        CALL MPI_WIN_LOCK_ALL( 0, win_gridsurf, ierr )
-        IF ( ierr /= 0 )  THEN
-            WRITE( 9, * ) 'Error MPI_WIN_LOCK_ALL2:', ierr, win_gridsurf
-            FLUSH( 9 )
-        ENDIF
-    ENDIF
-#endif
-
-!
-!-- Directions opposite to face normals are not even calculated, they must be preset to 0
-    dsitrans(:,:) = 0._wp
-
-    DO  isurflt = 1, nsurfl
-!
-!--    Determine face centers
-       td = surfl(id, isurflt)
-       ta = (/ REAL( surfl(iz, isurflt), wp ) - 0.5_wp * kdir(td),                                 &
-               REAL( surfl(iy, isurflt), wp ) - 0.5_wp * jdir(td),                                 &
-               REAL( surfl(ix, isurflt), wp ) - 0.5_wp * idir(td)  /)
-!
-!--    Calculate sky view factor and raytrace DSI paths
-       skyvf(isurflt)  = 0._wp
-       skyvft(isurflt) = 0._wp
-!
-!--    Select a proper half-sphere for 2D raytracing
-       SELECT CASE ( td )
-          CASE ( iup )
-             az0 = 0._wp
-             naz = raytrace_discrete_azims
-             azs = 2._wp * pi / REAL( naz, wp )
-             zn0 = 0._wp
-             nzn = raytrace_discrete_elevs / 2
-             zns = pi / 2._wp / REAL( nzn, wp )
-          CASE ( idown )
-             az0 = 0._wp
-             naz = raytrace_discrete_azims
-             azs = 2._wp * pi / REAL( naz, wp )
-             zn0 = pi / 2._wp
-             nzn = raytrace_discrete_elevs / 2
-             zns = pi / 2._wp / REAL( nzn, wp )
-          CASE ( isouth )
-             az0 = pi / 2._wp
-             naz = raytrace_discrete_azims / 2
-             azs = pi / REAL( naz, wp )
-             zn0 = 0._wp
-             nzn = raytrace_discrete_elevs
-             zns = pi / REAL( nzn, wp )
-          CASE ( inorth )
-             az0 = - pi / 2._wp
-             naz = raytrace_discrete_azims / 2
-             azs = pi / REAL( naz, wp )
-             zn0 = 0._wp
-             nzn = raytrace_discrete_elevs
-             zns = pi / REAL( nzn, wp )
-          CASE ( iwest )
-             az0 = pi
-             naz = raytrace_discrete_azims / 2
-             azs = pi / REAL( naz, wp )
-             zn0 = 0._wp
-             nzn = raytrace_discrete_elevs
-             zns = pi / REAL( nzn, wp )
-          CASE ( ieast )
-             az0 = 0._wp
-             naz = raytrace_discrete_azims / 2
-             azs = pi / REAL( naz, wp )
-             zn0 = 0._wp
-             nzn = raytrace_discrete_elevs
-             zns = pi / REAL( nzn, wp )
-          CASE DEFAULT
-             WRITE( message_string, * ) 'ERROR: the surface type ', td, 'is not supported for ' // &
-                                        'calculating SVF'
-             CALL message( 'radiation_calc_svf', 'PA0488', 1, 2, 0, 6, 0 )
-       END SELECT
-
-       ALLOCATE( zdirs(1:nzn), zcent(1:nzn), zbdry(0:nzn), vffrac(1:nzn*naz), ztransp(1:nzn*naz),  &
-                 itarget(1:nzn*naz) )
-
-       itarg0 = 1
-       itarg1 = nzn
-       zcent(:) = (/( zn0 + ( REAL( izn, wp ) - .5_wp ) * zns, izn = 1, nzn )/)
-       zbdry(:) = (/( zn0 + REAL( izn, wp ) * zns, izn = 0, nzn )/)
-       IF ( td == iup )  THEN
-          vffrac(1:nzn) = ( COS( 2 * zbdry(0:nzn-1) ) - COS( 2 * zbdry(1:nzn) ) ) / 2._wp /        &
-                            REAL( naz, wp )
-!
-!--       For horizontal target, vf fractions are constant per azimuth
-          DO  iaz = 1, naz-1
-             vffrac(iaz*nzn+1:(iaz+1)*nzn) = vffrac(1:nzn)
-          ENDDO
-!
-!--    Sum of whole vffrac equals 1, verified
-       ELSEIF ( td == idown )  THEN
-          vffrac(1:nzn) = - ( COS( 2 * zbdry(0:nzn-1) ) - COS( 2 * zbdry(1:nzn) ) ) / 2._wp /      &
-                              REAL( naz, wp )
-          DO  iaz = 1, naz-1
-             vffrac(iaz*nzn+1:(iaz+1)*nzn) = vffrac(1:nzn)
-          ENDDO
-!
-!--    Sum of whole vffrac equals 1, verified
-       ENDIF
-!
-!--    Calculate sky-view factor and direct solar visibility using 2D raytracing
-       DO  iaz = 1, naz
-          azmid = az0 + ( REAL( iaz, wp ) - .5_wp ) * azs
-          IF ( td /= iup  .AND.  td /= idown )  THEN
-             az2 = REAL( iaz, wp ) * azs - pi / 2._wp
-             az1 = az2 - azs
-!
-!--          TODO precalculate after 1st line
-             vffrac(itarg0:itarg1) = ( SIN( az2 ) - SIN( az1 ) ) * (zbdry(1:nzn) - zbdry(0:nzn-1) +&
-                                     SIN( zbdry(0:nzn-1) ) * COS( zbdry(0:nzn-1) ) -               &
-                                     SIN( zbdry(1:nzn) ) * COS( zbdry(1:nzn) ) ) / ( 2._wp * pi )
-!
-!--       Sum of whole vffrac equals 1, verified
-          ENDIF
-          yxdir(:) = (/ COS( azmid ) / dy, SIN( azmid ) / dx /)
-          yxlen = SQRT( SUM( yxdir(:)**2 ) )
-          zdirs(:) = COS( zcent(:)) / (dz(1) * yxlen * SIN( zcent(:) ) )
-          yxdir(:) = yxdir(:) / yxlen
-
-          CALL raytrace_2d( ta, yxdir, nzn, zdirs, surfstart(myid) + isurflt, facearea(td),        &
-                            vffrac(itarg0:itarg1), .TRUE., .TRUE., .FALSE., ztransp(itarg0:itarg1),&
-                            itarget(itarg0:itarg1) )
-
-          skyvf(isurflt) = skyvf(isurflt) + SUM( vffrac(itarg0:itarg1),                            &
-                                                 MASK = ( itarget(itarg0:itarg1) < 0 ) )
-          skyvft(isurflt) = skyvft(isurflt) + SUM( ztransp(itarg0:itarg1) * vffrac(itarg0:itarg1), &
-                                                   MASK = ( itarget(itarg0:itarg1) < 0 ) )
-!
-!--       Save direct solar transparency
-          j = MODULO( NINT( azmid / ( 2._wp * pi ) * raytrace_discrete_azims - .5_wp, iwp ),       &
-                      raytrace_discrete_azims )
-!
-!--       For down direction there is no direct irradiance, otherwise az0=0
-          IF ( td /= idown )  THEN
-             DO  k = 1, raytrace_discrete_elevs/2
-                i = dsidir_rev(k-1, j)
-                IF ( i /= -1  .AND.  itarget(itarg0+k-1) < 0 )                                     &
-                   dsitrans(isurflt, i) = ztransp(itarg0+k-1)
-             ENDDO
-          ENDIF
-!
-!--       Advance itarget indices
-          itarg0 = itarg1 + 1
-          itarg1 = itarg1 + nzn
-       ENDDO
-
-       IF ( rad_angular_discretization )  THEN
-!
-!--       Sort itarget by face id
-          CALL quicksort_itarget( itarget, vffrac, ztransp, 1, nzn*naz )
-!
-!--       For aggregation, we need fractions multiplied by transmissivities
-          ztransp(:) = vffrac(:) * ztransp(:)
-!
-!--       Find the first valid position
-          itarg0 = 1
-          DO WHILE ( itarg0 <= nzn*naz )
-             IF ( itarget(itarg0) >= 0 )  EXIT
-             itarg0 = itarg0 + 1
-          ENDDO
-
-          DO  i = itarg0, nzn*naz
-!
-!--          For duplicate values, only sum up vf fraction value
-             IF ( i < nzn*naz )  THEN
-                IF ( itarget(i+1) == itarget(i) )  THEN
-                   vffrac(i+1) = vffrac(i+1) + vffrac(i)
-                   ztransp(i+1) = ztransp(i+1) + ztransp(i)
-                   CYCLE
-                ENDIF
-             ENDIF
-!
-!--          Write to the svf array
-             nsvfl = nsvfl + 1
-!
-!--          Check dimmension of asvf array and enlarge it if needed
-             IF ( nsvfla < nsvfl )  THEN
-                k = CEILING( REAL( nsvfla, KIND = wp ) * grow_factor )
-                IF ( msvf == 0 )  THEN
-                   msvf = 1
-                   ALLOCATE( asvf1(k) )
-                   asvf => asvf1
-                   asvf1(1:nsvfla) = asvf2
-                   DEALLOCATE( asvf2 )
-                ELSE
-                   msvf = 0
-                   ALLOCATE( asvf2(k) )
-                   asvf => asvf2
-                   asvf2(1:nsvfla) = asvf1
-                   DEALLOCATE( asvf1 )
-                ENDIF
-
-                IF ( debug_output )  THEN
-                   WRITE( debug_string, '(A,3I12)' ) 'Grow asvf:', nsvfl, nsvfla, k
-                   CALL debug_message( debug_string, 'info' )
-                ENDIF
-
-                nsvfla = k
-             ENDIF
-!
-!--          Write svf values into the array
-             asvf(nsvfl)%isurflt = isurflt
-             asvf(nsvfl)%isurfs = itarget(i)
-             asvf(nsvfl)%rsvf = vffrac(i)
-             asvf(nsvfl)%rtransp = ztransp(i) / vffrac(i)
-          END DO
-
-       ENDIF ! rad_angular_discretization
-
-       DEALLOCATE( zdirs, zcent, zbdry, vffrac, ztransp, itarget )  ! FIXME itarget shall be allocated only
-                                                                    ! in case of rad_angular_discretization
-!
-!--    Following calculations only required for surface_reflections
-       IF ( surface_reflections  .AND.  .NOT. rad_angular_discretization )  THEN
-
-          DO  isurfs = 1, nsurf
-             IF ( .NOT.  surface_facing( surfl(ix, isurflt), surfl(iy, isurflt),                   &
-                  surfl(iz, isurflt), surfl(id, isurflt), surf(ix, isurfs), surf(iy, isurfs),      &
-                  surf(iz, isurfs), surf(id, isurfs) ) )  THEN
-                CYCLE
-             ENDIF
-
-             sd = surf(id, isurfs)
-             sa = (/ REAL( surf(iz,isurfs), wp ) - 0.5_wp * kdir(sd),                              &
-                     REAL( surf(iy,isurfs), wp ) - 0.5_wp * jdir(sd),                              &
-                     REAL( surf(ix,isurfs), wp ) - 0.5_wp * idir(sd)  /)
-!
-!--          Unit vector source -> target
-             uv = (/ ( ta(1) - sa(1) ) * dz(1), ( ta(2) - sa(2) ) * dy, ( ta(3) - sa(3) ) * dx /)
-             sqdist = SUM( uv(:)**2 )
-             uv = uv / SQRT( sqdist )
-!
-!--          Reject raytracing above max distance
-             IF ( SQRT( sqdist ) > max_raytracing_dist )  THEN
-                ray_skip_maxdist = ray_skip_maxdist + 1
-                CYCLE
-             ENDIF
-
-             difvf = DOT_PRODUCT( (/ kdir(sd), jdir(sd), idir(sd) /), uv ) & ! Cosine of source normal and direction
-                 * DOT_PRODUCT( (/ kdir(td), jdir(td), idir(td) /), - uv ) & ! Cosine of target normal and reverse direction
-                 / ( pi * sqdist ) ! Square of distance between centers
-!
-!--          Irradiance factor (our unshaded shape view factor) = view factor per
-!--          differential target area * source area
-             rirrf = difvf * facearea(sd)
-!
-!--          Reject raytracing for potentially too small view factor values
-             IF ( rirrf < min_irrf_value )  THEN
-                 ray_skip_minval = ray_skip_minval + 1
-                 CYCLE
-             ENDIF
-!
-!--          Raytrace + process plant canopy sinks within
-             CALL raytrace( sa, ta, isurfs, difvf, facearea(td), .TRUE., visible, transparency )
-
-             IF ( .NOT.  visible )  CYCLE
-            ! rsvf = rirrf * transparency
-!
-!--          Write to the svf array
-             nsvfl = nsvfl + 1
-!
-!--          Check dimension of asvf array and enlarge it if needed
-             IF ( nsvfla < nsvfl )  THEN
-                k = CEILING( REAL( nsvfla, KIND = wp ) * grow_factor )
-                IF ( msvf == 0 )  THEN
-                   msvf = 1
-                   ALLOCATE( asvf1(k) )
-                   asvf => asvf1
-                   asvf1(1:nsvfla) = asvf2
-                   DEALLOCATE( asvf2 )
-                ELSE
-                   msvf = 0
-                   ALLOCATE( asvf2(k) )
-                   asvf => asvf2
-                   asvf2(1:nsvfla) = asvf1
-                   DEALLOCATE( asvf1 )
-                ENDIF
-
-                IF ( debug_output )  THEN
-                   WRITE( debug_string, '(A,3I12)' ) 'Grow asvf:', nsvfl, nsvfla, k
-                   CALL debug_message( debug_string, 'info' )
-                ENDIF
-
-                nsvfla = k
-             ENDIF
-!
-!--          Write svf values into the array
-             asvf(nsvfl)%isurflt = isurflt
-             asvf(nsvfl)%isurfs = isurfs
-             asvf(nsvfl)%rsvf = rirrf  ! We postopne multiplication by transparency
-             asvf(nsvfl)%rtransp = transparency  ! a.k.a. Direct Irradiance Factor
-          ENDDO
-       ENDIF
-    ENDDO
-
-!
-!-- Raytrace to canopy boxes to fill dsitransc
-!-- TODO: consider replacing by DSI rays toward surfaces
-    dsitransc(:,:) = 0._wp
-    az0 = 0._wp
-    naz = raytrace_discrete_azims
-    azs = 2._wp * pi / REAL( naz, wp )
-    zn0 = 0._wp
-    nzn = raytrace_discrete_elevs / 2
-    zns = pi / 2._wp / REAL( nzn, wp )
-    ALLOCATE( zdirs(1:nzn), zcent(1:nzn), vffrac(1:nzn), ztransp(1:nzn), itarget(1:nzn) )
-    zcent(:) = (/ ( zn0 + ( REAL( izn, wp ) - .5_wp ) * zns, izn = 1, nzn ) /)
-    vffrac(:) = 0._wp
-
-    DO  ipcgb = 1, npcbl
-       ta = (/ REAL( pcbl(iz,ipcgb), wp ),                                                         &
-               REAL( pcbl(iy,ipcgb), wp ),                                                         &
-               REAL( pcbl(ix,ipcgb), wp ) /)
-!
-!--    Calculate direct solar visibility using 2D raytracing
-       DO  iaz = 1, naz
-          azmid = az0 + ( REAL( iaz, wp ) - .5_wp ) * azs
-          yxdir(:) = (/ COS( azmid ) / dy, SIN( azmid ) / dx /)
-          yxlen = SQRT( SUM( yxdir(:)**2 ) )
-          zdirs(:) = COS( zcent(:) ) / ( dz(1) * yxlen * SIN( zcent(:) ) )
-          yxdir(:) = yxdir(:) / yxlen
-          CALL raytrace_2d( ta, yxdir, nzn, zdirs, -999, -999._wp, vffrac, .FALSE., .FALSE.,       &
-                            .TRUE., ztransp, itarget )
-!
-!--       Save direct solar transparency
-          j = MODULO( NINT( azmid / ( 2._wp * pi ) * raytrace_discrete_azims - .5_wp, iwp ),       &
-                     raytrace_discrete_azims )
-          DO  k = 1, raytrace_discrete_elevs / 2
-             i = dsidir_rev(k-1, j)
-             IF ( i /= -1  .AND.  itarget(k) < 0 )  dsitransc(ipcgb, i) = ztransp(k)
-          ENDDO
-       ENDDO
-    ENDDO
-    DEALLOCATE( zdirs, zcent, vffrac, ztransp, itarget )
-!
-!-- Raytrace to MRT boxes
-    IF ( nmrtbl > 0 )  THEN
-       mrtdsit(:,:) = 0._wp
-       mrtsky(:) = 0._wp
-       mrtskyt(:) = 0._wp
-       az0 = 0._wp
-       naz = raytrace_discrete_azims
-       azs = 2._wp * pi / REAL( naz, wp )
-       zn0 = 0._wp
-       nzn = raytrace_discrete_elevs
-       zns = pi / REAL( nzn, wp )
-       ALLOCATE( zdirs(1:nzn), zcent(1:nzn), zbdry(0:nzn), vffrac(1:nzn*naz), vffrac0(1:nzn),      &
-                 ztransp(1:nzn*naz), itarget(1:nzn*naz) )
-
-       zcent(:) = (/ ( zn0 + ( REAL( izn, wp ) - .5_wp ) * zns, izn = 1, nzn ) /)
-       zbdry(:) = (/ ( zn0 + REAL( izn, wp ) * zns, izn = 0, nzn ) /)
-       vffrac0(:) = ( COS( zbdry(0:nzn-1) ) - COS( zbdry(1:nzn) ) ) / 2._wp / REAL( naz, wp )
-!
-!--    Modify direction weights to simulate human body (lower weight for irradiance from zenith,
-!--    higher from sides) depending on selection.
-!--    For mrt_geom=0, no weighting is done (simulates spherical globe thermometer).
-       SELECT CASE ( mrt_geom )
-
-       CASE ( 1 )
-          vffrac0(:) = vffrac0(:) * MAX( 0._wp, SIN( zcent(:) ) * mrt_geom_params(2)               &
-                                              + COS( zcent(:) ) * mrt_geom_params(1) )
-          vffrac0(:) = vffrac0(:) / ( SUM( vffrac0 ) * REAL( naz, wp ) )
-
-       CASE ( 2 )
-          vffrac0(:) = vffrac0(:) * SQRT( ( mrt_geom_params(1) * COS( zcent(:) ) )** 2 +           &
-                       ( mrt_geom_params(2) * SIN( zcent(:) ) )** 2 )
-          vffrac0(:) = vffrac0(:) / ( SUM( vffrac0 ) * REAL( naz, wp ) )
-
-       END SELECT
-
-       DO  imrt = 1, nmrtbl
-          ta = (/ REAL( mrtbl(iz,imrt), wp ),                                                      &
-                  REAL( mrtbl(iy,imrt), wp ),                                                      &
-                  REAL( mrtbl(ix,imrt), wp ) /)
-!
-!--       vf fractions are constant per azimuth
-          DO  iaz = 0, naz-1
-             vffrac(iaz*nzn+1:(iaz+1)*nzn) = vffrac0(:)
-          ENDDO
-!
-!--       Sum of whole vffrac equals 1, verified
-          itarg0 = 1
-          itarg1 = nzn
-!
-!--       Calculate sky-view factor and direct solar visibility using 2D raytracing
-          DO  iaz = 1, naz
-             azmid = az0 + ( REAL( iaz, wp ) - .5_wp ) * azs
-             yxdir(:) = (/ COS( azmid ) / dy, SIN( azmid ) / dx /)
-             yxlen = SQRT( SUM( yxdir(:)**2 ) )
-             zdirs(:) = COS( zcent(:) ) / ( dz(1) * yxlen * SIN( zcent(:) ) )
-             yxdir(:) = yxdir(:) / yxlen
-
-             CALL raytrace_2d( ta, yxdir, nzn, zdirs, -999, -999._wp, vffrac(itarg0:itarg1),       &
-                               .TRUE., .FALSE., .TRUE., ztransp(itarg0:itarg1),                    &
-                               itarget(itarg0:itarg1) )
-!
-!--          Sky view factors for MRT
-             mrtsky(imrt) = mrtsky(imrt) + SUM( vffrac(itarg0:itarg1),                             &
-                                                MASK = ( itarget(itarg0:itarg1) < 0 ) )
-             mrtskyt(imrt) = mrtskyt(imrt) + SUM( ztransp(itarg0:itarg1) * vffrac(itarg0:itarg1),  &
-                                                  MASK = ( itarget(itarg0:itarg1) < 0 ) )
-!
-!--          Direct solar transparency for MRT
-             j = MODULO( NINT( azmid / ( 2._wp * pi ) * raytrace_discrete_azims - .5_wp, iwp ),    &
-                         raytrace_discrete_azims )
-             DO  k = 1, raytrace_discrete_elevs/2
-                i = dsidir_rev(k-1, j)
-                IF ( i /= -1  .AND.  itarget(itarg0+k-1) < 0 )                                     &
-                   mrtdsit(imrt, i) = ztransp(itarg0+k-1)
-             ENDDO
-!
-!--          Advance itarget indices
-             itarg0 = itarg1 + 1
-             itarg1 = itarg1 + nzn
-          ENDDO
-!
-!--       Sort itarget by face id
-          CALL quicksort_itarget( itarget, vffrac, ztransp, 1, nzn * naz )
-!
-!--       For aggregation, we need fractions multiplied by transmissivities
-          ztransp(:) = vffrac(:) * ztransp(:)
-!
-!--       Find the first valid position
-          itarg0 = 1
-          DO WHILE ( itarg0 <= nzn * naz )
-             IF ( itarget(itarg0) >= 0 )  EXIT
-             itarg0 = itarg0 + 1
-          ENDDO
-
-          DO  i = itarg0, nzn*naz
-!
-!--          For duplicate values, only sum up vf fraction value
-             IF ( i < nzn * naz )  THEN
-                IF ( itarget(i+1) == itarget(i) )  THEN
-                   vffrac(i+1) = vffrac(i+1) + vffrac(i)
-                   ztransp(i+1) = ztransp(i+1) + ztransp(i)
-                   CYCLE
-                ENDIF
-             ENDIF
-!
-!--          Write to the mrtf array
-             nmrtf = nmrtf + 1
-!
-!--          Check dimmension of mrtf array and enlarge it if needed
-             IF ( nmrtfa < nmrtf )  THEN
-                k = CEILING( REAL( nmrtfa, KIND = wp ) * grow_factor )
-                IF ( mmrtf == 0 )  THEN
-                   mmrtf = 1
-                   ALLOCATE( amrtf1(k) )
-                   amrtf => amrtf1
-                   amrtf1(1:nmrtfa) = amrtf2
-                   DEALLOCATE( amrtf2 )
-                ELSE
-                   mmrtf = 0
-                   ALLOCATE( amrtf2(k) )
-                   amrtf => amrtf2
-                   amrtf2(1:nmrtfa) = amrtf1
-                   DEALLOCATE( amrtf1 )
-                ENDIF
-
-                IF ( debug_output )  THEN
-                   WRITE( debug_string, '(A,3I12)' ) 'Grow amrtf:', nmrtf, nmrtfa, k
-                   CALL debug_message( debug_string, 'info' )
-                ENDIF
-
-                nmrtfa = k
-             ENDIF
-!
-!--          Write mrtf values into the array
-             amrtf(nmrtf)%isurflt = imrt
-             amrtf(nmrtf)%isurfs = itarget(i)
-             amrtf(nmrtf)%rsvf = vffrac(i)
-             amrtf(nmrtf)%rtransp = ztransp(i) / vffrac(i)
-          ENDDO  ! itarg
-
-       ENDDO  ! imrt
-       DEALLOCATE( zdirs, zcent, zbdry, vffrac, vffrac0, ztransp, itarget )
-!
-!--    Move MRT factors to final arrays
-       ALLOCATE( mrtf(nmrtf), mrtft(nmrtf), mrtfsurf(2,nmrtf) )
-       DO  imrtf = 1, nmrtf
-          mrtf(imrtf) = amrtf(imrtf)%rsvf
-          mrtft(imrtf) = amrtf(imrtf)%rsvf * amrtf(imrtf)%rtransp
-          mrtfsurf(:,imrtf) = (/amrtf(imrtf)%isurflt, amrtf(imrtf)%isurfs /)
-       ENDDO
-       IF ( ALLOCATED( amrtf1 ) )  DEALLOCATE( amrtf1 )
-       IF ( ALLOCATED( amrtf2 ) )  DEALLOCATE( amrtf2 )
-    ENDIF ! nmrtbl > 0
-
-    IF ( rad_angular_discretization )  THEN
-#if defined( __parallel )
-!
-!--    Finalize MPI_RMA communication established to get global index of the surface from grid
-!--    indices.
-!--    Flush all MPI window pending requests.
-       CALL MPI_WIN_FLUSH_ALL( win_gridsurf, ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_WIN_FLUSH_ALL1:', ierr, win_gridsurf
-           FLUSH( 9 )
-       ENDIF
-!
-!--    Unlock MPI window
-       CALL MPI_WIN_UNLOCK_ALL( win_gridsurf, ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_WIN_UNLOCK_ALL1:', ierr, win_gridsurf
-           FLUSH( 9 )
-       ENDIF
-!
-!--    Free MPI window
-       CALL MPI_WIN_FREE( win_gridsurf, ierr )
-       IF ( ierr /= 0 )  THEN
-           WRITE( 9, * ) 'Error MPI_WIN_FREE1:', ierr, win_gridsurf
-           FLUSH( 9 )
-       ENDIF
-#else
-       DEALLOCATE( gridsurf )
-#endif
-    ENDIF
-
-    IF ( debug_output )  CALL debug_message( 'waiting for completion of SVF and CSF ' //           &
-                                             'calculation in all processes', 'info' )
-!
-!-- Deallocate temporary global arrays
-    DEALLOCATE( nzterrt, nzterrb )
-
-    IF ( plant_canopy )  THEN
-!
-!--     Finalize mpi_rma communication and deallocate temporary arrays
-#if defined( __parallel )
-        IF ( raytrace_mpi_rma )  THEN
-            CALL MPI_WIN_FLUSH_ALL( win_lad, ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_WIN_FLUSH_ALL2:', ierr, win_lad
-                FLUSH( 9 )
-            ENDIF
-!
-!--         Unlock MPI window
-            CALL MPI_WIN_UNLOCK_ALL( win_lad, ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_WIN_UNLOCK_ALL2:', ierr, win_lad
-                FLUSH( 9 )
-            ENDIF
-!
-!--         Free MPI window
-            CALL MPI_WIN_FREE( win_lad, ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_WIN_FREE2:', ierr, win_lad
-                FLUSH( 9 )
-            ENDIF
-!
-!--         Deallocate temporary arrays storing values for csf calculation during raytracing
-            DEALLOCATE( lad_s_ray )
-!
-!--     sub_lad is the pointer to lad_s_rma in case of raytrace_mpi_rma and must not be
-!--     deallocated here
-        ELSE
-            DEALLOCATE( sub_lad )
-            DEALLOCATE( sub_lad_g )
-        ENDIF
-#else
-        DEALLOCATE( sub_lad )
-#endif
-        DEALLOCATE( boxes )
-        DEALLOCATE( crlens )
-        DEALLOCATE( plantt )
-        DEALLOCATE( rt2_track, rt2_track_lad, rt2_track_dist, rt2_dist )
-    ENDIF
-
-    IF ( debug_output )  CALL debug_message( 'calculation of the complete SVF array', 'info' )
-
-    IF ( rad_angular_discretization )  THEN
-       IF ( debug_output )  THEN
-          WRITE( debug_string, '("Load ",I0," SVFs from the structure array to plain arrays")' )   &
-                 nsvfl
-          CALL debug_message( debug_string, 'info' )
-       ENDIF
-       ALLOCATE( svf(ndsvf,nsvfl) )
-       ALLOCATE( svfsurf(idsvf,nsvfl) )
-
-       DO  isvf = 1, nsvfl
-          svf(:, isvf) = (/ asvf(isvf)%rsvf, asvf(isvf)%rtransp /)
-          svfsurf(:, isvf) = (/ asvf(isvf)%isurflt, asvf(isvf)%isurfs /)
-       ENDDO
-    ELSE
-       IF ( debug_output )  CALL debug_message( 'Start SVF sort', 'info' )
-!
-!--    Sort svf ( a version of quicksort )
-       CALL quicksort_svf( asvf, 1, nsvfl )
-!
-!--    Load svf from the structure array to plain arrays
-       IF ( debug_output )  THEN
-          WRITE( debug_string, '("Load ",I0," SVFs from the structure array to plain arrays")' )   &
-                 nsvfl
-          CALL debug_message( debug_string, 'info' )
-       ENDIF
-       ALLOCATE( svf(ndsvf,nsvfl) )
-       ALLOCATE( svfsurf(idsvf,nsvfl) )
-       svfnorm_counts(:) = 0._wp
-       isurflt_prev = -1
-       ksvf = 1
-       svfsum = 0._wp
-       DO  isvf = 1, nsvfl
-!
-!--       Normalize svf per target face
-          IF ( asvf(ksvf)%isurflt /= isurflt_prev )  THEN
-              IF ( isurflt_prev /= -1  .AND.  svfsum /= 0._wp )  THEN
-!
-!--               Update histogram of logged svf normalization values
-                  i = searchsorted( svfnorm_report_thresh, svfsum /                                &
-                                    ( 1._wp - skyvf( isurflt_prev ) ) )
-                  svfnorm_counts(i) = svfnorm_counts(i) + 1
-
-                  svf(1, isvf_surflt:isvf-1) = svf(1, isvf_surflt:isvf-1) /                        &
-                                               svfsum * ( 1._wp - skyvf( isurflt_prev ) )
-              ENDIF
-              isurflt_prev = asvf(ksvf)%isurflt
-              isvf_surflt = isvf
-              svfsum = asvf(ksvf)%rsvf !?? / asvf(ksvf)%rtransp
-          ELSE
-              svfsum = svfsum + asvf(ksvf)%rsvf !?? / asvf(ksvf)%rtransp
-          ENDIF
-
-          svf(:, isvf) = (/ asvf(ksvf)%rsvf, asvf(ksvf)%rtransp /)
-          svfsurf(:, isvf) = (/ asvf(ksvf)%isurflt, asvf(ksvf)%isurfs /)
-!
-!--       Next element
-          ksvf = ksvf + 1
-       ENDDO
-
-       IF ( isurflt_prev /= -1  .AND.  svfsum /= 0._wp )  THEN
-           i = searchsorted( svfnorm_report_thresh, svfsum / ( 1._wp - skyvf( isurflt_prev ) ) )
-           svfnorm_counts(i) = svfnorm_counts(i) + 1
-
-           svf(1, isvf_surflt:nsvfl) = svf(1, isvf_surflt:nsvfl) / svfsum *                        &
-                                       ( 1._wp - skyvf(isurflt_prev) )
-       ENDIF
-       WRITE( 9, * ) 'SVF normalization histogram: ', svfnorm_counts,  ' on thresholds: ',         &
-                     svfnorm_report_thresh(1:svfnorm_report_num), ' (val < thresh <= val)'
-!
-!-- TODO we should be able to deallocate skyvf, from now on we only need skyvft
-    ENDIF  ! rad_angular_discretization
-!
-!-- Deallocate temporary asvf array
-!-- DEALLOCATE(asvf) - ifort has a problem with deallocation of allocatable target via pointing
-!-- pointer - we need to test original targets
-    IF ( ALLOCATED( asvf1 ) )  THEN
-        DEALLOCATE( asvf1 )
-    ENDIF
-    IF ( ALLOCATED( asvf2 ) )  THEN
-        DEALLOCATE( asvf2 )
-    ENDIF
-
-    npcsfl = 0
-    IF ( plant_canopy )  THEN
-
-        IF ( debug_output )  CALL debug_message( 'Calculation of the complete CSF array', 'info' )
-!
-!--     Sort and merge csf for the last time, keeping the array size to minimum
-        CALL merge_and_grow_csf( - 1 )
-!
-!--     Aggregate csb among processors.
-!--     Allocate necessary arrays.
-        udim = MAX( ncsfl, 1 )
-        ALLOCATE( csflt_l(ndcsf*udim) )
-        csflt(1:ndcsf,1:udim) => csflt_l(1:ndcsf*udim)
-        ALLOCATE( kcsflt_l(kdcsf*udim) )
-        kcsflt(1:kdcsf,1:udim) => kcsflt_l(1:kdcsf*udim)
-        ALLOCATE( icsflt(0:numprocs-1) )
-
-!--     Fill out arrays of csf values and arrays of number of elements and displacements for
-!--     particular precessors.
-        icsflt = 0
-        ip = -1
-        j = -1
-        DO  kcsf = 1, ncsfl
-           j = j + 1
-           IF ( acsf(kcsf)%ip /= ip )  THEN
-!
-!--            New block of the processor number of elements of previous block
-               IF ( ip >= 0 )  icsflt(ip) = j
-!
-!--            Blank blocks
-               DO  jp = ip+1, acsf(kcsf)%ip-1
-!
-!--               Number of elements is zero, displacement is equal to previous
-                  icsflt(jp) = 0
-               ENDDO
-!
-!--            The actual block
-               ip = acsf(kcsf)%ip
-               j = 0
-           ENDIF
-           csflt(1,kcsf) = acsf(kcsf)%rcvf
-!
-!--        Fill out integer values of itz,ity,itx,isurfs
-           kcsflt(1,kcsf) = acsf(kcsf)%itz
-           kcsflt(2,kcsf) = acsf(kcsf)%ity
-           kcsflt(3,kcsf) = acsf(kcsf)%itx
-           kcsflt(4,kcsf) = acsf(kcsf)%isurfs
-        ENDDO
-!
-!--     Last blank blocks at the end of array
-        j = j+1
-        IF ( ip >= 0 )  icsflt(ip) = j
-        DO  jp = ip+1, numprocs-1
-!
-!--        Number of elements is zero, displacement is equal to previous
-           icsflt(jp) = 0
-        ENDDO
-!
-!--     Deallocate temporary acsf array
-!--     DEALLOCATE(acsf) - ifort has a problem with deallocation of allocatable target via pointing
-!--     pointer - we need to test original targets
-        IF ( ALLOCATED( acsf1 ) )  THEN
-            DEALLOCATE( acsf1 )
-        ENDIF
-        IF ( ALLOCATED( acsf2 ) )  THEN
-            DEALLOCATE( acsf2 )
-        ENDIF
-
-#if defined( __parallel )
-!
-!--     Exchange csf fields between processors
-        IF ( debug_output )  CALL debug_message( 'Exchange CSF fields between processors', 'start' )
-
-        CALL radiation_exchange_alltoall( icsflt, kdcsf, ndcsf, kcsflt_l, csflt_l, npcsfl,         &
-                                          kpcsflt_l, pcsflt_l )
-        pcsflt(1:ndcsf,1:npcsfl) => pcsflt_l(0:ndcsf*npcsfl-1)
-        kpcsflt(1:kdcsf,1:npcsfl) => kpcsflt_l(0:kdcsf*npcsfl-1)
-
-        IF ( debug_output )  CALL debug_message( 'Exchange CSF fields between processors', 'end' )
-
-#else
-        npcsfl = ncsfl
-        ALLOCATE( pcsflt(ndcsf,MAX( npcsfl, ndcsf )) )
-        ALLOCATE( kpcsflt(kdcsf,MAX( npcsfl,kdcsf )) )
-        pcsflt = csflt
-        kpcsflt = kcsflt
-!
-!--     Just silence compiler warning about unused variable
-        IF ( bufsize_alltoall <= 0 )  bufsize_alltoall = 0
-#endif
-!
-!--     Deallocate temporary arrays
-        DEALLOCATE( csflt_l )
-        DEALLOCATE( kcsflt_l )
-        DEALLOCATE( icsflt )
-!
-!--     Sort csf ( a version of quicksort )
-        IF ( debug_output )  CALL debug_message( 'Sort csf', 'info' )
-        CALL quicksort_csf2( kpcsflt, pcsflt, 1, npcsfl )
-!
-!--     Aggregate canopy sink factor records with identical box & source againg across all values
-!--     from all processors
-        IF ( debug_output )  CALL debug_message( 'Aggregate canopy sink factor records with ' //   &
-                                                 'identical box', 'info' )
-
-        IF ( npcsfl > 0 )  THEN
-            icsf = 1 !< reading index
-            kcsf = 1 !< writing index
-            DO WHILE ( icsf < npcsfl )
-!
-!--             Here kpcsf(kcsf) already has values from kpcsf(icsf)
-                IF ( kpcsflt(3,icsf) == kpcsflt(3,icsf+1)  .AND.                                   &
-                     kpcsflt(2,icsf) == kpcsflt(2,icsf+1)  .AND.                                   &
-                     kpcsflt(1,icsf) == kpcsflt(1,icsf+1)  .AND.                                   &
-                     kpcsflt(4,icsf) == kpcsflt(4,icsf+1) )  THEN
-
-                    pcsflt(1,kcsf) = pcsflt(1,kcsf) + pcsflt(1,icsf+1)
-!
-!--                 Advance reading index, keep writing index
-                    icsf = icsf + 1
-                ELSE
-!
-!--                 Not identical, just advance and copy
-                    icsf = icsf + 1
-                    kcsf = kcsf + 1
-                    kpcsflt(:,kcsf) = kpcsflt(:,icsf)
-                    pcsflt(:,kcsf) = pcsflt(:,icsf)
-                ENDIF
-            ENDDO
-!
-!--         Last written item is now also the last item in valid part of array
-            npcsfl = kcsf
-        ENDIF
-
-        ncsfl = npcsfl
-        IF ( ncsfl > 0 )  THEN
-            ALLOCATE( csf(ndcsf,ncsfl) )
-            ALLOCATE( csfsurf(idcsf,ncsfl) )
-            DO icsf = 1, ncsfl
-                csf(:,icsf) = pcsflt(:,icsf)
-                csfsurf(1,icsf) =  gridpcbl(kpcsflt(1,icsf),kpcsflt(2,icsf),kpcsflt(3,icsf))
-                csfsurf(2,icsf) =  kpcsflt(4,icsf)
-            ENDDO
-        ENDIF
-!
-!--     Deallocation of temporary arrays
-        IF ( npcbl > 0 )  DEALLOCATE( gridpcbl )
-        DEALLOCATE( pcsflt_l )
-        DEALLOCATE( kpcsflt_l )
-        IF ( debug_output )  THEN
-           WRITE( debug_string, '("Finished aggregating ",I0," CSFs.")' ) ncsfl
-           CALL debug_message( debug_string, 'info' )
-        ENDIF
-
-    ENDIF
-
-#if defined( __parallel )
-    CALL MPI_BARRIER( comm2d, ierr )
-#endif
-    CALL location_message( 'calculating view factors for radiation interaction', 'finished' )
-
-    RETURN  ! Todo: remove
-
-!    WRITE( message_string, * )  &
-!        'I/O error when processing shape view factors / ',  &
-!        'plant canopy sink factors / direct irradiance factors.'
-!    CALL message( 'init_urban_surface', 'PA0502', 2, 2, 0, 6, 0 )
-
- END SUBROUTINE radiation_calc_svf
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Raytracing for detecting obstacles and calculating compound canopy sink factors for RTM.
-!> (A simple obstacle detection would only need to process faces in 3 dimensions without any
-!> ordering.)
-!> Assumtions:
-!> -----------
-!> 1. The ray always originates from a face midpoint (only one coordinate equals *.5, i.e. wall)
-!>    and doesn't travel parallel to the surface (that would mean shape factor=0). Therefore, the
-!>    ray may never travel exactly along a face or an edge.
-!> 2. From grid bottom to urban surface top the grid has to be *equidistant* within each of the
-!>    dimensions, including vertical (but the resolution doesn't need to be the same in all three
-!>    dimensions).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE raytrace( src, targ, isrc, difvf, atarg, create_csf, visible, transparency )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ig        !< 1D index of gridbox in global 2D array
-    INTEGER(iwp) ::  i, k, d   !<
-    INTEGER(iwp) ::  maxboxes  !< max no of gridboxes visited
-    INTEGER(iwp) ::  ncsb      !< no of written plant canopy sinkboxes
-    INTEGER(iwp) ::  seldim    !< dimension to be incremented
-
-    INTEGER(iwp), INTENT(IN) ::  isrc  !< index of source face for csf
-
-    INTEGER(iwp), DIMENSION(3) ::  box       !< gridbox being crossed
-    INTEGER(iwp), DIMENSION(3) ::  dimnext   !< next dimension increments along path
-    INTEGER(iwp), DIMENSION(3) ::  dimdelta  !< dimension direction = +- 1
-
-    LOGICAL, INTENT(IN) ::  create_csf  !< whether to generate new CSFs during raytracing
-
-    LOGICAL, INTENT(OUT) ::  visible  !<
-
-    REAL(wp) ::  crmid     !< midpoint of crossing
-    REAL(wp) ::  cursink   !< sink factor for current canopy box
-    REAL(wp) ::  crlen     !< length of gridbox crossing
-    REAL(wp) ::  distance  !< euclidean along path
-    REAL(wp) ::  lastdist  !< beginning of current crossing
-    REAL(wp) ::  nextdist  !< end of current crossing
-    REAL(wp) ::  realdist  !< distance in meters per unit distance
-
-
-    REAL(wp) ::  eps = 1E-10_wp  !< epsilon for value comparison
-    REAL(wp) ::  lad_s_target    !< recieved lad_s of particular grid box
-
-    REAL(wp), INTENT(IN) ::  atarg  !< target surface area for csf
-    REAL(wp), INTENT(IN) ::  difvf  !< differential view factor for csf
-
-    REAL(wp), INTENT(OUT) ::  transparency  !< along whole path
-
-    REAL(wp), DIMENSION(3) :: delta        !< path vector
-    REAL(wp), DIMENSION(3) :: dimnextdist  !< distance for each dimension increments
-    REAL(wp), DIMENSION(3) :: uvect        !< unit vector
-
-    REAL(wp), DIMENSION(3), INTENT(IN) :: src, targ  !< real coordinates z,y,x
-
-
-!
-!-- Maximum number of gridboxes visited equals maximum number of boundaries crossed in each
-!-- dimension plus one. That's also the maximum number of plant canopy boxes written. We grow the
-!-- acsf array accordingly using exponential factor.
-    maxboxes = SUM( ABS( NINT( targ, iwp ) - NINT( src, iwp ) ) ) + 1
-    IF ( plant_canopy  .AND.  ncsfl + maxboxes > ncsfla )  THEN
-!
-!--     Use this code for growing by fixed exponential increments (equivalent to case where ncsfl
-!--     always increases by 1)
-!--     k = CEILING(grow_factor ** real(CEILING(log(real(ncsfl + maxboxes, kind=wp)) &
-!--                                            / log(grow_factor)), kind=wp))
-!--     Or use this code to simply always keep some extra space after growing
-        k = CEILING( REAL( ncsfl + maxboxes, KIND = wp ) * grow_factor )
-
-        CALL merge_and_grow_csf( k )
-    ENDIF
-
-    transparency = 1._wp
-    ncsb = 0
-
-    delta(:) = targ(:) - src(:)
-    distance = SQRT( SUM( delta(:)**2 ) )
-    IF ( distance == 0._wp )  THEN
-        visible = .TRUE.
-        RETURN
-    ENDIF
-    uvect(:) = delta(:) / distance
-    realdist = SQRT( SUM( ( uvect(:) * (/ dz(1), dy, dx /) )**2 ) )
-
-    lastdist = 0._wp
-!
-!-- Since all face coordinates have values *.5 and we'd like to use integers, all these have .5
-!-- added
-    DO  d = 1, 3
-       IF ( uvect(d) == 0._wp )  THEN
-           dimnext(d) = 999999999
-           dimdelta(d) = 999999999
-           dimnextdist(d) = 1.0E20_wp
-       ELSE IF ( uvect(d) > 0._wp )  THEN
-           dimnext(d) = CEILING( src(d) + .5_wp )
-           dimdelta(d) = 1
-           dimnextdist(d) = ( dimnext(d) - .5_wp - src(d) ) / uvect(d)
-       ELSE
-           dimnext(d) = FLOOR( src(d) + .5_wp )
-           dimdelta(d) = -1
-           dimnextdist(d) = ( dimnext(d) - .5_wp - src(d) ) / uvect(d)
-       ENDIF
-    ENDDO
-
-    DO
-!
-!--     Along what dimension will the next wall crossing be?
-        seldim = MINLOC( dimnextdist, 1 )
-        nextdist = dimnextdist(seldim)
-        IF ( nextdist > distance )  nextdist = distance
-
-        crlen = nextdist - lastdist
-        IF ( crlen > .001_wp )  THEN
-            crmid = ( lastdist + nextdist ) * .5_wp
-            box = NINT( src(:) + uvect(:) * crmid, iwp )
-!
-!--         Calculate index of the grid with global indices (box(2),box(3)) in the array nzterr and
-!--         plantt and id of the coresponding processor
-            CALL radiation_calc_global_offset( box(3), box(2), 0, 1, offs_glob = ig )
-            IF ( box(1) <= nzterrb(ig) )  THEN
-                visible = .FALSE.
-                RETURN
-            ENDIF
-
-            IF ( plant_canopy )  THEN
-                IF ( box(1) <= plantt(ig) )  THEN
-                    ncsb = ncsb + 1
-                    boxes(:,ncsb) = box
-                    crlens(ncsb) = crlen
-#if defined( __parallel )
-                    CALL radiation_calc_global_offset( box(3), box(2), box(1) - nz_urban_b,        &
-                                                       nz_plant, iproc = lad_ip(ncsb),             &
-                                                       offs_proc = lad_disp(ncsb) )
-#endif
-                ENDIF
-            ENDIF
-        ENDIF
-
-        IF ( ABS( distance - nextdist ) < eps )  EXIT
-        lastdist = nextdist
-        dimnext(seldim) = dimnext(seldim) + dimdelta(seldim)
-        dimnextdist(seldim) = ( dimnext(seldim) - .5_wp - src(seldim) ) / uvect(seldim)
-    ENDDO
-
-    IF ( plant_canopy )  THEN
-#if defined( __parallel )
-        IF ( raytrace_mpi_rma )  THEN
-!
-!--         Send requests for lad_s to appropriate processor
-            CALL cpu_log( log_point_s(77), 'rad_rma_lad', 'start' )
-            DO  i = 1, ncsb
-               CALL MPI_GET( lad_s_ray(i), 1, MPI_REAL, lad_ip(i), lad_disp(i), 1, MPI_REAL,       &
-                             win_lad, ierr )
-               IF ( ierr /= 0 )  THEN
-                   WRITE( 9, * ) 'Error MPI_GET1:', ierr, lad_s_ray(i), lad_ip(i), lad_disp(i),    &
-                                 win_lad
-                   FLUSH( 9 )
-               ENDIF
-            ENDDO
-!
-!--         Wait for all pending local requests to complete
-            CALL MPI_WIN_FLUSH_LOCAL_ALL( win_lad, ierr )
-            IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_WIN_FLUSH_LOCAL_ALL1:', ierr, win_lad
-                FLUSH( 9 )
-            ENDIF
-            CALL cpu_log( log_point_s(77), 'rad_rma_lad', 'stop' )
-
-        ENDIF
-#endif
-!
-!--     Calculate csf and transparency
-        DO  i = 1, ncsb
-#if defined( __parallel )
-           IF ( raytrace_mpi_rma )  THEN
-               lad_s_target = lad_s_ray(i)
-           ELSE
-               lad_s_target = sub_lad_g(lad_ip(i)*nnx*nny*nz_plant+lad_disp(i))
-           ENDIF
-#else
-           lad_s_target = sub_lad(boxes(1,i),boxes(2,i),boxes(3,i))
-#endif
-           IF ( lad_s_target <= 0.0_wp )  CYCLE  ! Under LAD top, but LAD=0
-
-           cursink = 1._wp - EXP( - ext_coef * lad_s_target * crlens(i) * realdist )
-
-           IF ( create_csf )  THEN
-!
-!--            Write svf values into the array
-               ncsfl = ncsfl + 1
-               acsf(ncsfl)%ip     = lad_ip(i)
-               acsf(ncsfl)%itx    = boxes(3,i)
-               acsf(ncsfl)%ity    = boxes(2,i)
-               acsf(ncsfl)%itz    = boxes(1,i)
-               acsf(ncsfl)%isurfs = isrc
-               acsf(ncsfl)%rcvf   = cursink * transparency * difvf * atarg
-           ENDIF  !< create_csf
-
-           transparency = transparency * ( 1._wp - cursink )
-
-        ENDDO
-    ENDIF
-
-    visible = .TRUE.
-
- END SUBROUTINE raytrace
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> A new, more efficient version of ray tracing algorithm that processes a whole arc instead of a
-!> single ray (new in RTM version 2.5).
-!>
-!> In all comments, horizon means tangent of horizon angle, i.e. vertical_delta /
-!> horizontal_distance
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE raytrace_2d( origin, yxdir, nrays, zdirs, iorig, aorig, vffrac, calc_svf, create_csf,  &
-                         skip_1st_pcb, transparency, itarget )
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, k, l, d        !<
-    INTEGER(iwp) ::  iray              !< index into zdirs
-    INTEGER(iwp) ::  isurf             !< index into surf(l)
-    INTEGER(iwp) ::  ip                !< number of processor where gridbox reside
-    INTEGER(iwp) ::  ip_last           !< previous number of processor where gridbox reside
-    INTEGER(iwp) ::  ig                !< 1D index of grid column in global 2D array
-    INTEGER(iwp) ::  ig_last           !< 1D index of previous column in global 2D array
-    INTEGER(iwp) ::  kz                !<
-    INTEGER(iwp) ::  lastdir           !< wall direction before hitting this column
-    INTEGER(iwp) ::  lowest_free_ray   !< index into zdirs
-    INTEGER(iwp) ::  lowest_mixed_ray  !< index into zdirs
-    INTEGER(iwp) ::  maxboxes          !< max no of CSF created
-    INTEGER(iwp) ::  nrays             !< number of rays (z directions) to raytrace
-    INTEGER(iwp) ::  nly               !< maximum  plant canopy height
-    INTEGER(iwp) ::  ntrack            !<
-    INTEGER(iwp) ::  zb0               !<
-    INTEGER(iwp) ::  zb1               !<
-    INTEGER(iwp) ::  nz                !<
-    INTEGER(iwp) ::  seldim            !< dimension to be incremented
-    INTEGER(iwp) ::  zsgn              !<
-
-
-    INTEGER(iwp), INTENT(IN) ::  iorig  !< index of origin face for csf
-
-    INTEGER(iwp), DIMENSION(2) ::  column      !< grid column being crossed
-    INTEGER(iwp), DIMENSION(2) ::  dimnext     !< next dimension increments along path
-    INTEGER(iwp), DIMENSION(2) ::  dimdelta    !< dimension direction = +- 1
-    INTEGER(iwp), DIMENSION(2) ::  lastcolumn  !<
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  down_col  !< downward oriented surfaces in current column
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  up_col    !< upward oriented surfaces in current column
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  vert_col  !< vertical faces from previous to current column
-
-    INTEGER(iwp), DIMENSION(nrays), INTENT(OUT) ::  itarget  !< global indices of target faces for zdirs or <0 for sky
-
-    LOGICAL ::  is_mixed_col  !< whether current column contains full-3D geometry
-
-    LOGICAL, INTENT(IN) ::  calc_svf      !< whether to calculate SFV (identify obstacle surfaces)
-    LOGICAL, INTENT(IN) ::  create_csf    !< whether to create canopy sink factors
-    LOGICAL, INTENT(IN) ::  skip_1st_pcb  !< whether to skip first plant canopy box during raytracing
-
-
-    REAL(wp) ::  crmid             !< midpoint of crossing
-    REAL(wp) ::  bdydim            !< boundary for current dimension
-    REAL(wp) ::  distance          !< euclidean along path
-    REAL(wp) ::  full_horizon      !< highest full horizon found after raytracing (z/hdist)
-    REAL(wp) ::  horz_full_entry   !< full horizon at entry to column
-    REAL(wp) ::  horz_full_exit    !< full horizon at exit from column
-    REAL(wp) ::  horz_mixed_entry  !< mixed horizon at entry to column
-    REAL(wp) ::  horz_mixed_exit   !< mixed horizon at exit from column
-    REAL(wp) ::  lastdist          !< beginning of current crossing
-    REAL(wp) ::  nextdist          !< end of current crossing
-
-    REAL(wp), INTENT(IN) ::  aorig  !< origin face area for csf
-
-
-    REAL(wp), DIMENSION(2) ::  crossdist    !< distances to boundary for dimensions
-    REAL(wp), DIMENSION(2) ::  dimnextdist  !< distance for each dimension increments
-    REAL(wp), DIMENSION(2) ::  yxorigin     !< horizontal copy of origin (y,x)
-
-    REAL(wp), DIMENSION(2), INTENT(IN) ::  yxdir  !< y,x *unit* vector of ray direction (in grid units)
-
-    REAL(wp), DIMENSION(3), INTENT(IN) ::  origin  !< z,y,x coordinates of ray origin
-
-    REAL(wp), DIMENSION(nrays), INTENT(IN) ::  vffrac  !< view factor fractions of each ray for csf
-    REAL(wp), DIMENSION(nrays), INTENT(IN) ::  zdirs   !< list of z directions to raytrace (z/hdist, grid, zenith->nadir)
-
-    REAL(wp), DIMENSION(nrays), INTENT(OUT) ::  transparency  !< transparencies of zdirs paths
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  lowest_lad  !< lowest column cell for which we need LAD
-    INTEGER(iwp) ::  wcount      !< RMA window item count
-
-    INTEGER(MPI_ADDRESS_KIND) ::  wdisp  !< RMA window displacement
-#endif
-
-    REAL(wp) ::  curtrans        !< transparency of current PC box crossing
-    REAL(wp) ::  dxxyy           !< square of real horizontal distance
-    REAL(wp) ::  eps = 1E-10_wp  !< epsilon for value comparison
-    REAL(wp) ::  qdist           !< ratio of real distance to z coord difference
-    REAL(wp) ::  zbottom, ztop   !< urban surface boundary in real numbers
-    REAL(wp) ::  zorig           !< z coordinate of ray column entry
-    REAL(wp) ::  zexit           !< z coordinate of ray column exit
-
-
-    yxorigin(:) = origin(2:3)
-    transparency(:) = 1._wp !-- Pre-set the all rays to transparent before reducing
-    full_horizon = - HUGE( 1._wp )
-    lowest_mixed_ray = nrays
-    lowest_free_ray = nrays
-    IF ( rad_angular_discretization )  THEN
-       ALLOCATE( target_surfl(nrays) )
-       target_surfl(:) = -1
-       lastdir = -999
-       lastcolumn(:) = -999
-       ALLOCATE( vert_col(nz_urban_b:nz_urban_t) )
-       ALLOCATE( up_col(nz_urban_b:nz_urban_t) )
-       ALLOCATE( down_col(nz_urban_b:nz_urban_t) )
-    ENDIF
-!
-!-- Determine distance to boundary (in 2D xy)
-    IF ( yxdir(1) > 0._wp )  THEN
-       bdydim = ny + .5_wp  !< North global boundary
-       crossdist(1) = ( bdydim - yxorigin(1) ) / yxdir(1)
-    ELSEIF ( yxdir(1) == 0._wp )  THEN
-       crossdist(1) = HUGE( 1._wp )
-    ELSE
-        bdydim = - .5_wp  !< South global boundary
-        crossdist(1) = ( bdydim - yxorigin(1) ) / yxdir(1)
-    ENDIF
-
-    IF ( yxdir(2) > 0._wp )  THEN
-        bdydim = nx + .5_wp  !< East global boundary
-        crossdist(2) = ( bdydim - yxorigin(2) ) / yxdir(2)
-    ELSEIF ( yxdir(2) == 0._wp )  THEN
-       crossdist(2) = HUGE( 1._wp )
-    ELSE
-        bdydim = -.5_wp  !< West global boundary
-        crossdist(2) = ( bdydim - yxorigin(2) ) / yxdir(2)
-    ENDIF
-    distance = MINVAL( crossdist, 1 )
-
-    IF ( plant_canopy )  THEN
-       rt2_track_dist(0) = 0._wp
-       rt2_track_lad(:,:) = 0._wp
-       nly = plantt_max - nz_urban_b + 1
-    ENDIF
-
-    ip_last = -1
-    ig_last = -1
-    lastdist = 0._wp
-
-!-- Since all face coordinates have values *.5 and we'd like to use integers, all these have
-!-- .5 added
-    DO  d = 1, 2
-       IF ( yxdir(d) == 0._wp )  THEN
-           dimnext(d) = HUGE( 1_iwp )
-           dimdelta(d) = HUGE( 1_iwp )
-           dimnextdist(d) = HUGE( 1._wp )
-       ELSE IF ( yxdir(d) > 0._wp )  THEN
-           dimnext(d) = FLOOR( yxorigin(d) + .5_wp ) + 1
-           dimdelta(d) = 1
-           dimnextdist(d) = ( dimnext(d) - .5_wp - yxorigin(d) ) / yxdir(d)
-       ELSE
-           dimnext(d) = CEILING( yxorigin(d) + .5_wp ) - 1
-           dimdelta(d) = -1
-           dimnextdist(d) = ( dimnext(d) - .5_wp - yxorigin(d) ) / yxdir(d)
-       ENDIF
-    ENDDO
-
-    ntrack = 0
-    DO
-!
-!--    Along what dimension will the next wall crossing be?
-       seldim = MINLOC( dimnextdist, 1 )
-       nextdist = dimnextdist(seldim)
-       IF ( nextdist > distance )  nextdist = distance
-
-       IF ( nextdist > lastdist )  THEN
-          ntrack = ntrack + 1
-          crmid = ( lastdist + nextdist ) * .5_wp
-          column = NINT( yxorigin(:) + yxdir(:) * crmid, iwp )
-!
-!--       Calculate index of the grid with global indices (column(1),column(2)) in the array
-!--       nzterrt/b and plantt and id of the coresponding processor
-          CALL radiation_calc_global_offset( column(2), column(1), 0, 1, iproc = ip,               &
-                                             offs_glob = ig )
-
-          IF ( ip_last < 0 )  THEN
-             horz_full_entry  = - HUGE( 1._wp )
-             horz_mixed_entry = - HUGE( 1._wp )
-          ELSE
-             horz_full_entry  = ( REAL( nzterrb(ig), wp ) + .5_wp - origin(1) ) / lastdist
-             horz_mixed_entry = ( REAL( nzterrt(ig), wp ) + .5_wp - origin(1) ) / lastdist
-          ENDIF
-          horz_full_exit  = ( REAL( nzterrb(ig), wp ) + .5_wp - origin(1) ) / nextdist
-          horz_mixed_exit = ( REAL( nzterrt(ig), wp ) + .5_wp - origin(1) ) / nextdist
-          is_mixed_col = ( nzterrt(ig) /= nzterrb(ig) )
-
-          IF ( rad_angular_discretization )  THEN
-!
-!--          Identify vertical full obstacles hit by rays in current column, mixed rays need to be
-!--          checked if they are already obstructed.
-             DO WHILE ( lowest_mixed_ray > lowest_free_ray )
-                IF ( zdirs(lowest_mixed_ray) > horz_full_entry )  EXIT
-!
-!--             This may only happen after 1st column, so lastdir and lastcolumn are valid
-                IF ( target_surfl(lowest_mixed_ray) < 0 )  THEN
-                   CALL request_itarget( lastdir, CEILING( - 0.5_wp + origin(1) +                  &
-                                                           zdirs(lowest_mixed_ray) * lastdist ),   &
-                                         lastcolumn(1), lastcolumn(2),                             &
-                                         target_surfl(lowest_mixed_ray) )
-                ENDIF
-                lowest_mixed_ray = lowest_mixed_ray - 1
-             ENDDO
-!
-!--          Identify vertical full obstacles hit by rays in current column, free rays need no
-!--          individual checks.
-             DO WHILE ( lowest_mixed_ray > 0 )
-                IF ( zdirs(lowest_mixed_ray) > horz_full_entry )  EXIT
-!
-!--             This may only happen after 1st column, so lastdir and lastcolumn are valid
-                CALL request_itarget( lastdir, CEILING( - 0.5_wp + origin(1) +                     &
-                                                        zdirs(lowest_mixed_ray) * lastdist ),      &
-                                      lastcolumn(1), lastcolumn(2), target_surfl(lowest_mixed_ray) )
-                lowest_mixed_ray = lowest_mixed_ray - 1
-             ENDDO
-             IF ( lowest_free_ray > lowest_mixed_ray )  lowest_free_ray = lowest_mixed_ray
-!
-!--          Identify targets for vertical mixed obstacles.
-!--          lowest_mixed_ray now points to bottom of vertical mixed obstacles.
-             IF ( is_mixed_col  .AND.  ip_last >= 0 )  THEN
-!
-!--             Load vertical surfaces belonging to previous column
-                vert_col(:) = -999
-                DO  isurf = surfg_col_start(ig_last), surfg_col_start(ig_last+1)-1
-                   IF ( surf(id, isurf) == lastdir )  THEN
-                      vert_col(surf(iz, isurf)) = isurf
-                   ENDIF
-                ENDDO
-!
-!--             Previously mixed rays need to be checked whether they are obstructed
-                DO  iray = lowest_mixed_ray, lowest_free_ray+1, -1
-                   IF ( zdirs(iray) > horz_mixed_entry )  EXIT
-                   IF ( target_surfl(iray) >= 0 )  CYCLE
-                   target_surfl(iray) = vert_col( CEILING( - 0.5_wp + origin(1) +                  &
-                                                           zdirs(iray) * lastdist) )  ! Contains -999 if missing surface
-                ENDDO
-!
-!--             Previously free rays cannot be obstructed yet
-                DO  iray = lowest_free_ray, 1, -1
-                   IF ( zdirs(iray) > horz_mixed_entry )  THEN
-!
-!--                   Extend mixed rays by raising the lowest_free ray (remains unchanged if this is
-!--                   hit in 1st iteration)
-                      lowest_free_ray = iray
-                      EXIT
-                   ENDIF
-                   target_surfl(iray) = vert_col( CEILING( - 0.5_wp + origin(1) + zdirs(iray) *    &
-                                                           lastdist ) )  ! Contains -999 if missing surface
-                ENDDO
-             ENDIF  ! End of mixed horizon
-!
-!--          Identify horizontal full obstacles hit by rays in current column, mixed rays need to be
-!--          checked if they are already obstructed.
-             DO WHILE ( lowest_mixed_ray > lowest_free_ray )
-                IF ( zdirs(lowest_mixed_ray) > horz_full_exit )  EXIT
-                IF ( target_surfl(lowest_mixed_ray) < 0 )  THEN
-                   CALL request_itarget( iup, nzterrb(ig)+1, column(1), column(2),                 &
-                                         target_surfl(lowest_mixed_ray) )
-                ENDIF
-                lowest_mixed_ray = lowest_mixed_ray - 1
-             ENDDO
-!
-!--          Identify horizontal full obstacles hit by rays in current column, free rays need no
-!--          individual checks.
-             DO WHILE ( lowest_mixed_ray > 0 )
-                IF ( zdirs(lowest_mixed_ray) > horz_full_exit )  EXIT
-                CALL request_itarget( iup, nzterrb(ig)+1, column(1), column(2),                    &
-                                      target_surfl(lowest_mixed_ray) )
-                lowest_mixed_ray = lowest_mixed_ray - 1
-             ENDDO
-             IF ( lowest_free_ray > lowest_mixed_ray )  lowest_free_ray = lowest_mixed_ray
-!
-!--          Identify targets for horizontal mixed obstacles.
-!--          lowest_mixed_ray now points _above_ horizontal full obstacles.
-             IF ( is_mixed_col )  THEN
-!
-!--             Load horizontal surfaces corresponding to current column
-                up_col(:) = - 999
-                down_col(:) = - 999
-                DO  isurf = surfg_col_start(ig), surfg_col_start(ig+1)-1
-                   SELECT CASE ( surf(id, isurf) )
-                   CASE ( iup )
-                      up_col(surf(iz, isurf)) = isurf
-                   CASE ( idown )
-                      down_col(surf(iz, isurf)) = isurf
-                   ENDSELECT
-                ENDDO
-!
-!--             Previously mixed rays need to be checked whether they are obstructed
-                DO  iray = lowest_mixed_ray, lowest_free_ray+1, -1
-                   IF ( zdirs(iray) > MAX( horz_mixed_entry, horz_mixed_exit ) )  EXIT
-                   IF ( target_surfl(iray) >= 0 )  CYCLE
-                   IF ( zdirs(iray) <= 0._wp )  THEN
-!
-!--                   Downward pointed ray, cycle k down from entry to exit, search for upward
-!--                   oriented faces
-                      DO  k = FLOOR( 0.5_wp + origin(1) + zdirs(iray) * lastdist ),                &
-                              CEILING( - 0.5_wp + origin(1) + zdirs(iray) * nextdist ) + 1, - 1
-                         target_surfl(iray) = up_col(k)  ! Contains -999 if missing surface
-                         IF ( target_surfl(iray) >= 0 )  EXIT
-                      ENDDO
-                   ELSE
-!
-!--                   Upward pointed ray, cycle k up from entry to exit, search for downward
-!--                   oriented faces
-                      DO  k = CEILING( - 0.5_wp + origin(1) + zdirs(iray) * lastdist ),            &
-                              FLOOR( 0.5_wp + origin(1) + zdirs(iray) * nextdist ) - 1
-                         target_surfl(iray) = down_col(k)  ! Contains -999 if missing surface
-                         IF ( target_surfl(iray) >= 0 )  EXIT
-                      ENDDO
-                   ENDIF
-                ENDDO
-!
-!--             Previously free rays cannot be obstructed yet
-                DO  iray = lowest_free_ray, 1, -1
-                   IF ( zdirs(iray) > MAX( horz_mixed_entry, horz_mixed_exit ) )  THEN
-!
-!--                   Extend mixed rays by raising the lowest_free ray (remains unchanged if this is
-!--                   hit in 1st iteration)
-                      lowest_free_ray = iray
-                      EXIT
-                   ENDIF
-                   IF ( zdirs(iray) <= 0._wp )  THEN
-!
-!--                   Downward pointed ray, cycle k down from entry to exit, search upward oriented
-!--                   faces
-                      DO  k = FLOOR( 0.5_wp + origin(1) + zdirs(iray) * lastdist ),                &
-                              CEILING( - 0.5_wp + origin(1) + zdirs(iray) * nextdist) + 1, - 1
-                         target_surfl(iray) = up_col(k)  ! Contains -999 if missing surface
-                         IF ( target_surfl(iray) >= 0 )  EXIT
-                      ENDDO
-                   ELSE
-!
-!--                   Upward pointed ray, cycle k up from entry to exit, search downward oriented
-!--                   faces
-                      DO  k = CEILING( - 0.5_wp + origin(1) + zdirs(iray) * lastdist ),            &
-                              FLOOR( 0.5_wp + origin(1) + zdirs(iray) * nextdist ) - 1
-                         target_surfl(iray) = down_col(k)  ! Contains -999 if missing surface
-                         IF ( target_surfl(iray) >= 0 )  EXIT
-                      ENDDO
-                   ENDIF
-                ENDDO
-             ENDIF  ! End of mixed horizon
-          ENDIF  ! rad_angular_discretization
-          full_horizon = MAX( full_horizon, horz_full_entry, horz_full_exit )
-
-          IF ( plant_canopy )  THEN
-             rt2_track(:, ntrack) = column(:)
-             rt2_track_dist(ntrack) = nextdist
-          ENDIF
-       ENDIF
-
-       IF ( nextdist + eps >= distance )  EXIT
-
-       IF ( rad_angular_discretization )  THEN
-!
-!--       Save wall direction of coming building column (= this air column)
-          IF ( seldim == 1 )  THEN
-             IF ( dimdelta(seldim) == 1 )  THEN
-                lastdir = isouth
-             ELSE
-                lastdir = inorth
-             ENDIF
-          ELSE
-             IF ( dimdelta(seldim) == 1 )  THEN
-                lastdir = iwest
-             ELSE
-                lastdir = ieast
-             ENDIF
-          ENDIF
-          lastcolumn = column
-       ENDIF
-       ip_last = ip
-       ig_last = ig
-       lastdist = nextdist
-       dimnext(seldim) = dimnext(seldim) + dimdelta(seldim)
-       dimnextdist(seldim) = ( dimnext(seldim) - .5_wp - yxorigin(seldim) ) / yxdir(seldim)
-    ENDDO
-
-    IF ( plant_canopy )  THEN
-!
-!--    Request LAD WHERE applicable
-
-#if defined( __parallel )
-       IF ( raytrace_mpi_rma )  THEN
-!
-!--       Send requests for lad_s to appropriate processor
-          !CALL cpu_log( log_point_s(77), 'usm_init_rma', 'start' )
-          DO  i = 1, ntrack
-             CALL radiation_calc_global_offset( rt2_track(2,i), rt2_track(1,i), 0, 1,              &
-                                                offs_glob = ig )
-
-             IF ( rad_angular_discretization  .AND.  calc_svf )  THEN
-!
-!--             For fixed view resolution, we need plant canopy even for rays to opposing surfaces
-                lowest_lad = nzterrb(ig) + 1
-             ELSE
-!
-!--             We only need LAD for rays directed above full horizon (to sky)
-                lowest_lad = CEILING( - 0.5_wp + origin(1) +                                       &
-                                      MIN( full_horizon * rt2_track_dist(i-1),  &  ! Entry
-                                           full_horizon * rt2_track_dist(i) ) )  ! Exit
-             ENDIF
-!
-!--          Skip asking for LAD where all plant canopy is under requested level
-             IF ( plantt(ig) < lowest_lad )  CYCLE
-
-             CALL radiation_calc_global_offset( rt2_track(2,i), rt2_track(1,i),                    &
-                                                lowest_lad - nz_urban_b, nz_plant, iproc = ip,     &
-                                                offs_proc = wdisp )
-             wcount = plantt(ig) - lowest_lad + 1
-!
-!--          TODO: send request ASAP - even during raytracing
-             CALL MPI_GET( rt2_track_lad(lowest_lad:plantt(ig), i), wcount, MPI_REAL, ip, wdisp,   &
-                           wcount, MPI_REAL, win_lad, ierr )
-             IF ( ierr /= 0 )  THEN
-                WRITE( 9, * ) 'Error MPI_GET2:', ierr, rt2_track_lad(lowest_lad:plantt(ig), i),    &
-                              wcount, ip, wdisp, win_lad
-                FLUSH( 9 )
-             ENDIF
-          ENDDO
-!
-!--       Wait for all pending local requests to complete
-!--       TODO: Wait selectively for each column later when needed
-          CALL MPI_WIN_FLUSH_LOCAL_ALL( win_lad, ierr )
-          IF ( ierr /= 0 )  THEN
-             WRITE( 9, * ) 'Error MPI_WIN_FLUSH_LOCAL_ALL2:', ierr, win_lad
-             FLUSH( 9 )
-          ENDIF
-          !CALL cpu_log( log_point_s(77), 'usm_init_rma', 'stop' )
-
-       ELSE  ! raytrace_mpi_rma = .F.
-          DO  i = 1, ntrack
-             CALL radiation_calc_global_offset( rt2_track(2,i), rt2_track(1,i), 0, nz_plant,       &
-                                                offs_glob = ig )
-             rt2_track_lad(nz_urban_b:plantt_max, i) = sub_lad_g(ig:ig+nly-1)
-          ENDDO
-       ENDIF
-#else
-       DO  i = 1, ntrack
-          rt2_track_lad(nz_urban_b:plantt_max, i) = sub_lad(rt2_track(1,i), rt2_track(2,i),        &
-                                                            nz_urban_b:plantt_max)
-       ENDDO
-#endif
-    ENDIF  ! plant_canopy
-
-    IF ( rad_angular_discretization )  THEN
-#if defined( __parallel )
-!
-!--    Wait for all gridsurf requests to complete
-       CALL MPI_WIN_FLUSH_LOCAL_ALL( win_gridsurf, ierr )
-       IF ( ierr /= 0 )  THEN
-          WRITE( 9, * ) 'Error MPI_WIN_FLUSH_LOCAL_ALL3:', ierr, win_gridsurf
-          FLUSH( 9 )
-       ENDIF
-#endif
-       itarget(:) = target_surfl(:)
-       DEALLOCATE( target_surfl )
-    ELSE
-       iray = nrays
-       DO WHILE ( iray > 0 )
-          IF ( zdirs(iray) > full_horizon )  EXIT
-          itarget(iray) = HUGE( 1_iwp )
-          iray = iray - 1
-       ENDDO
-       itarget(1:iray) = -1
-    ENDIF  ! rad_angular_discretization
-
-    IF ( plant_canopy )  THEN
-!
-!--    Skip the PCB around origin if requested (for MRT, the PCB might not be there)
-       IF ( skip_1st_pcb  .AND.  NINT( origin(1) ) <= plantt_max )  THEN
-          rt2_track_lad( NINT( origin(1), iwp ), 1 ) = 0._wp
-       ENDIF
-!
-!--    Assert that we have space allocated for CSFs
-       maxboxes = ( ntrack + MAX( CEILING( origin(1) - .5_wp ) - nz_urban_b, nz_urban_t -          &
-                                  CEILING( origin(1) - .5_wp ) ) ) * nrays
-       IF ( ncsfl + maxboxes > ncsfla )  THEN
-!
-!--       Use this code for growing by fixed exponential increments (equivalent to case where ncsfl
-!--       always increases by 1)
-!--       k = CEILING(grow_factor ** real(CEILING(log(real(ncsfl + maxboxes, kind=wp)) &
-!--                                              / log(grow_factor)), kind=wp))
-!--       Or use this code to simply always keep some extra space after growing
-          k = CEILING( REAL( ncsfl + maxboxes, KIND = wp ) * grow_factor )
-          CALL merge_and_grow_csf(k)
-       ENDIF
-!
-!--    Calculate transparencies and store new CSFs
-       zbottom = REAL( nz_urban_b, wp ) - .5_wp
-       ztop = REAL( plantt_max, wp ) + .5_wp
-!
-!--    Reverse direction of radiation (face->sky), only when calc_svf
-       IF ( calc_svf )  THEN
-          DO  i = 1, ntrack  ! For each column
-             dxxyy = ( ( dy * yxdir(1) )**2 + ( dx * yxdir(2) )**2 ) *                             &
-                     ( rt2_track_dist(i) - rt2_track_dist(i-1) )**2
-             CALL radiation_calc_global_offset( rt2_track(2,i), rt2_track(1,i), 0, 1, iproc = ip )
-
-             DO  k = 1, nrays  ! For each ray
-!
-!--             NOTE 6778:
-!--             With traditional svf discretization, CSFs under the horizon (i.e. for surface to
-!--             surface radiation) are created in raytrace(). With rad_angular_discretization, we
-!--             must create CSFs under horizon only for one direction, otherwise we would have
-!--             duplicate amount of energy. Although we could choose either of the two directions
-!--             (they differ only by discretization error with no bias), we choose the backward
-!--             direction, because it tends to cumulate high canopy sink factors closer to raytrace
-!--             origin, i.e. it should potentially cause less moiree.
-                IF ( .NOT. rad_angular_discretization )  THEN
-!
-!--                TODO: remove tradiational discretization (incompatible with full 3D)
-                   IF ( zdirs(k) <= full_horizon )  CYCLE
-                ENDIF
-
-                zorig = origin(1) + zdirs(k) * rt2_track_dist(i-1)
-                IF ( zorig <= zbottom  .OR.  zorig >= ztop )  CYCLE
-
-                zsgn = INT( SIGN( 1._wp, zdirs(k) ), iwp )
-                rt2_dist(1) = 0._wp
-                IF ( zdirs(k) == 0._wp )  THEN  ! Ray is exactly horizontal
-                   nz = 2
-                   rt2_dist(nz) = SQRT( dxxyy )
-                   kz = CEILING( - .5_wp + zorig, iwp )
-                ELSE
-                   zexit = MIN( MAX( origin(1) + zdirs(k) * rt2_track_dist(i), zbottom ), ztop )
-
-                   zb0 = FLOOR( zorig * zsgn - .5_wp ) + 1  ! Because it must be greater than orig
-                   zb1 = CEILING( zexit * zsgn - .5_wp ) - 1  ! Because it must be smaller than exit
-                   nz = MAX( zb1 - zb0 + 3, 2 )
-                   rt2_dist(nz) = SQRT( ( (zexit - zorig ) * dz(1) )**2 + dxxyy )
-                   qdist = rt2_dist(nz) / ( zexit - zorig )
-                   rt2_dist(2:nz-1) = (/ ( ( ( REAL( l, wp ) + .5_wp ) * zsgn - zorig ) * qdist,   &
-                                         l = zb0, zb1 ) /)
-                   kz = zb0 * zsgn
-                ENDIF
-
-                DO  l = 2, nz
-                   IF ( rt2_track_lad(kz, i) > 0._wp )  THEN
-                      curtrans = EXP( - ext_coef * rt2_track_lad(kz, i) * ( rt2_dist(l) -          &
-                                                                            rt2_dist(l-1) ) )
-
-                      IF ( create_csf )  THEN
-                         ncsfl = ncsfl + 1
-                         acsf(ncsfl)%ip = ip
-                         acsf(ncsfl)%itx = rt2_track(2,i)
-                         acsf(ncsfl)%ity = rt2_track(1,i)
-                         acsf(ncsfl)%itz = kz
-                         acsf(ncsfl)%isurfs = iorig
-                         acsf(ncsfl)%rcvf = ( 1._wp - curtrans ) * transparency(k) * vffrac(k)
-                      ENDIF
-
-                      transparency(k) = transparency(k) * curtrans
-                   ENDIF
-                   kz = kz + zsgn
-                ENDDO  ! l = 1, nz - 1
-             ENDDO  ! k = 1, nrays
-          ENDDO  ! i = 1, ntrack
-!
-!--       Reset rays above horizon to transparent (see NOTE 6778)
-          WHERE( itarget < 0 )  transparency = 1.0_wp
-       ENDIF
-!
-!--    Forward direction of radiation (sky->face), always
-       DO  i = ntrack, 1, -1  ! For each column backwards
-          dxxyy = ( ( dy * yxdir(1) )**2 + ( dx * yxdir(2) )**2 ) *                                &
-                  ( rt2_track_dist(i) - rt2_track_dist(i-1) )**2
-          CALL radiation_calc_global_offset( rt2_track(2,i), rt2_track(1,i), 0, 1, iproc = ip )
-
-          DO  k = 1, nrays  ! For each ray
-!
-!--          See NOTE 6778 above
-             IF ( itarget(k) >= 0 )  CYCLE
-
-             zexit = origin(1) + zdirs(k) * rt2_track_dist(i-1)
-             IF ( zexit <= zbottom  .OR.  zexit >= ztop )  CYCLE
-
-             zsgn = - INT( SIGN( 1._wp, zdirs(k) ), iwp )
-             rt2_dist(1) = 0._wp
-             IF ( zdirs(k) == 0._wp )  THEN  ! Ray is exactly horizontal
-                nz = 2
-                rt2_dist(nz) = SQRT( dxxyy )
-                kz = NINT( zexit, iwp )
-             ELSE
-                zorig = MIN( MAX( origin(1) + zdirs(k) * rt2_track_dist(i), zbottom ), ztop )
-
-                zb0 = FLOOR( zorig * zsgn - .5_wp ) + 1  ! Because it must be greater than orig
-                zb1 = CEILING( zexit * zsgn - .5_wp ) - 1  ! Because it must be smaller than exit
-                nz = MAX( zb1 - zb0 + 3, 2 )
-                rt2_dist(nz) = SQRT( ( ( zexit - zorig ) * dz(1) )**2 + dxxyy )
-                qdist = rt2_dist(nz) / ( zexit - zorig )
-                rt2_dist(2:nz-1) = (/ ( ( ( REAL( l, wp ) + .5_wp ) * zsgn - zorig ) * qdist,      &
-                                      l = zb0, zb1 ) /)
-                kz = zb0 * zsgn
-             ENDIF
-
-             DO  l = 2, nz
-                IF ( rt2_track_lad(kz, i) > 0._wp )  THEN
-                   curtrans = EXP( - ext_coef * rt2_track_lad(kz, i) *                             &
-                                  ( rt2_dist(l) - rt2_dist(l-1) ) )
-
-                   IF ( create_csf )  THEN
-                      ncsfl = ncsfl + 1
-                      acsf(ncsfl)%ip = ip
-                      acsf(ncsfl)%itx = rt2_track(2,i)
-                      acsf(ncsfl)%ity = rt2_track(1,i)
-                      acsf(ncsfl)%itz = kz
-                      acsf(ncsfl)%isurfs = -1
-                      acsf(ncsfl)%rcvf = ( 1._wp - curtrans ) * transparency(k) * aorig * vffrac(k)
-                   ENDIF   ! create_csf
-
-                   transparency(k) = transparency(k) * curtrans
-                ENDIF
-                kz = kz + zsgn
-             ENDDO  ! l = 1, nz - 1
-          ENDDO  ! k = 1, nrays
-       ENDDO  ! i = 1, ntrack
-    ENDIF  ! plant_canopy
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE request_itarget( d, z, y, x, isurfl )
-
-    INTEGER(iwp), INTENT(IN) ::  d, z, y, x  !<
-
-    INTEGER(iwp), TARGET, INTENT(OUT) ::  isurfl  !<
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  iproc  !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_displ  !< index of the grid in the local gridsurf array
-
-!
-!-- Calculate target processor and index in the remote local target gridsurf array
-    CALL radiation_calc_global_offset( x, y, ( z - nz_urban_b ) * nsurf_type_u + d,                &
-                                       nz_urban * nsurf_type_u, iproc = iproc,                     &
-                                       offs_proc = target_displ )
-!
-!-- Send MPI_Get request to obtain index target_surfl(i)
-    CALL MPI_GET( isurfl, 1, MPI_INTEGER, iproc, target_displ, 1, MPI_INTEGER, win_gridsurf, ierr )
-    IF ( ierr /= 0 )  THEN
-       WRITE( 9, * ) 'Error MPI_GET3:', ierr, isurfl, iproc, target_displ, win_gridsurf
-       FLUSH( 9 )
-    ENDIF
-#else
-!
-!-- Set index target_surfl(i)
-    isurfl = gridsurf(d,z,y,x)
-#endif
-
- END SUBROUTINE request_itarget
-
-
- END SUBROUTINE raytrace_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Calculates apparent solar positions for all timesteps and stores discretized positions for RTM.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_presimulate_solar_pos
-
-    USE control_parameters,                                                                        &
-       ONLY:  rotation_angle
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  it, i, j  !< loop indices
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dsidir_tmp  !< dsidir_tmp[:,i] = unit vector of i-th
-                                                          !< appreant solar direction
-
-    ALLOCATE( dsidir_rev(0:raytrace_discrete_elevs/2-1,0:raytrace_discrete_azims-1) )
-    dsidir_rev(:,:) = -1
-    ALLOCATE( dsidir_tmp(3, raytrace_discrete_elevs/2*raytrace_discrete_azims) )
-    ndsidir = 0
-    sun_direction = .TRUE.
-
-!
-!-- Process spinup time if configured
-    IF ( spinup_time > 0._wp )  THEN
-       DO  it = 0, CEILING( spinup_time / dt_spinup )
-          CALL simulate_pos( it * dt_spinup - spinup_time )
-       ENDDO
-    ENDIF
-!
-!-- Process simulation time
-    DO  it = 0, CEILING( ( end_time - spinup_time ) / dt_radiation )
-       CALL simulate_pos( it * dt_radiation )
-    ENDDO
-!
-!-- Allocate global vars which depend on ndsidir
-    ALLOCATE( dsidir ( 3, ndsidir ) )
-    dsidir(:,:) = dsidir_tmp(:, 1:ndsidir)
-    DEALLOCATE( dsidir_tmp )
-
-    ALLOCATE( dsitrans(nsurfl, ndsidir) )
-    ALLOCATE( dsitransc(npcbl, ndsidir) )
-    IF ( nmrtbl > 0 )  ALLOCATE( mrtdsit(nmrtbl, ndsidir) )
-
-    WRITE( message_string, * ) 'Precalculated', ndsidir, ' solar positions from ', it, ' timesteps.'
-    CALL message( 'radiation_presimulate_solar_pos', 'UI0013', 0, 0, 0, 6, 0 )
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Simuates a single position
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE simulate_pos( time_since_reference_local )
-
-    REAL(wp) ::  solar_azim  !< solar azimuth in rotated model coordinates
-
-    REAL(wp), INTENT(IN) ::  time_since_reference_local  !< local time since reference
-
-!
-!-- Update apparent solar position based on modified t_s_r_p
-    CALL get_date_time( time_since_reference_local, day_of_year = day_of_year,                     &
-                        second_of_day = second_of_day )
-    CALL calc_zenith( day_of_year, second_of_day )
-    IF ( cos_zenith > 0 )  THEN
-!
-!--    Identify solar direction vector (discretized number) 1)
-       solar_azim = ATAN2( sun_dir_lon, sun_dir_lat ) * ( 180.0_wp / pi ) - rotation_angle
-       i = MODULO( NINT( solar_azim / 360.0_wp * raytrace_discrete_azims - .5_wp, iwp ),           &
-                   raytrace_discrete_azims )
-       j = FLOOR( ACOS( cos_zenith ) / pi * raytrace_discrete_elevs )
-       IF ( dsidir_rev(j, i) == -1 )  THEN
-          ndsidir = ndsidir + 1
-          dsidir_tmp(:, ndsidir) =                                                                 &
-                            (/ COS( (REAL( j, wp ) + .5_wp ) * pi      / raytrace_discrete_elevs), &
-                               SIN( (REAL( j, wp ) + .5_wp ) * pi      / raytrace_discrete_elevs)  &
-                             * COS( (REAL( i, wp ) + .5_wp ) * 2_wp*pi / raytrace_discrete_azims), &
-                               SIN( (REAL( j, wp ) + .5_wp ) * pi      / raytrace_discrete_elevs)  &
-                             * SIN( (REAL( i, wp ) + .5_wp ) * 2_wp*pi / raytrace_discrete_azims) /)
-          dsidir_rev(j, i) = ndsidir
-       ENDIF
-    ENDIF
- END SUBROUTINE simulate_pos
-
- END SUBROUTINE radiation_presimulate_solar_pos
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Determines whether two faces are oriented towards each other in RTM. Since the surfaces follow
-!> the gird box surfaces, it checks first whether the two surfaces are directed in the same
-!> direction, then it checks if the two surfaces are located in confronted direction but facing away
-!> from each other, e.g. <--| |-->
-!--------------------------------------------------------------------------------------------------!
- PURE LOGICAL FUNCTION surface_facing( x, y, z, d, x2, y2, z2, d2 )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp),INTENT(IN) ::  x, y, z, d, x2, y2, z2, d2  !<
-
-    surface_facing = .FALSE.
-!
-!-- First check: are the two surfaces directed in the same direction
-    IF ( d == iup     .AND.  d2 == iup    )  RETURN
-    IF ( d == isouth  .AND.  d2 == isouth )  RETURN
-    IF ( d == inorth  .AND.  d2 == inorth )  RETURN
-    IF ( d == iwest   .AND.  d2 == iwest  )  RETURN
-    IF ( d == ieast   .AND.  d2 == ieast  )  RETURN
-!
-!-- Second check: are surfaces facing away from each other
-    SELECT CASE (d)
-        CASE (iup)                   !< Upward facing surfaces
-            IF ( z2 < z )  RETURN
-        CASE (isouth)                !< Southward facing surfaces
-            IF ( y2 > y )  RETURN
-        CASE (inorth)                !< Northward facing surfaces
-            IF ( y2 < y )  RETURN
-        CASE (iwest)                 !< Westward facing surfaces
-            IF ( x2 > x )  RETURN
-        CASE (ieast)                 !< Eastward facing surfaces
-            IF ( x2 < x )  RETURN
-    END SELECT
-
-    SELECT CASE (d2)
-        CASE (iup)                   !< Ground, roof
-            IF ( z < z2 )  RETURN
-        CASE (isouth)                !< South facing
-            IF ( y > y2 )  RETURN
-        CASE (inorth)                !< North facing
-            IF ( y < y2 )  RETURN
-        CASE (iwest)                 !< West facing
-            IF ( x > x2 )  RETURN
-        CASE (ieast)                 !< East facing
-            IF ( x < x2 )  RETURN
-        CASE (-1)
-            CONTINUE
-    END SELECT
-
-    surface_facing = .TRUE.
-
- END FUNCTION surface_facing
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads svf, svfsurf, csf, csfsurf and mrt factors data from saved file. This allows to skip their
-!> calculation during of RTM init phase. SVF means sky view factors and CSF means canopy sink
-!> factors.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_read_svf
-
-    IMPLICIT NONE
-
-    CHARACTER(rad_version_len) ::  rad_version_field  !<
-
-    CHARACTER(LEN=64) ::  rad_version_in  !< rad version on file
-
-    INTEGER(iwp) ::  i                      !<
-    INTEGER(iwp) ::  ncsfl_tot              !<
-    INTEGER(iwp) ::  ndsidir_from_file = 0  !<
-    INTEGER(iwp) ::  ndsidir_tot            !<
-    INTEGER(iwp) ::  npcbl_from_file   = 0  !<
-    INTEGER(iwp) ::  npcbl_tot              !<
-    INTEGER(iwp) ::  nsurfl_from_file  = 0  !<
-    INTEGER(iwp) ::  nsurfl_tot             !<
-    INTEGER(iwp) ::  nsvfl_tot              !< total (sum across all PEs) counter for the different IO variables
-    INTEGER(iwp) ::  nmrtbl_from_file  = 0  !<
-    INTEGER(iwp) ::  nmrtbl_tot             !<
-    INTEGER(iwp) ::  nmrtf_tot              !<
-
-    INTEGER(iwp), DIMENSION(4) ::  global_sum  !<
-    INTEGER(iwp), DIMENSION(4) ::  local_sum   !< variables to compute total counter
-
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_end    !< global end index
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_start  !< global start index
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  end_index     !< local end index
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  start_index   !< local start index
-
-    LOGICAL ::  data_to_read  !< flag indicating if data is available for current variable
-
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::  tmp  !<
-
-
-    IF ( TRIM( restart_data_format_input ) == 'fortran_binary' )  THEN
-
-       CALL location_message( 'reading sky view factors for radiation interaction ' //             &
-                              '(Fortran binary format)', 'start' )
-
-       DO  i = 0, io_blocks-1
-          IF ( i == io_group )  THEN
-
-!
-!--          numprocs_previous_run is only known in case of reading restart data. If a new initial
-!--          run which reads svf data is started the following query will be skipped.
-             IF ( initializing_actions == 'read_restart_data' )  THEN
-
-                IF ( numprocs_previous_run /= numprocs )  THEN
-                   WRITE( message_string, * ) 'A different number of processors between the run ', &
-                                              'that has written the svf data and the one that ',   &
-                                              'will read it is not allowed'
-                   CALL message( 'check_open', 'PA0491', 1, 2, 0, 6, 0 )
-                ENDIF
-
-             ENDIF
-
-!
-!--          Open binary file
-             CALL check_open( 88 )
-
-!
-!--          Read and check version
-             READ ( 88 ) rad_version_field
-             IF ( TRIM( rad_version_field ) /= TRIM( rad_version ) )  THEN
-                 WRITE( message_string, * ) 'Version of binary SVF file "',                        &
-                                            TRIM( rad_version_field ), '" does not match ',        &
-                                            'the version of model "', TRIM( rad_version ), '"'
-                 CALL message( 'radiation_read_svf', 'PA0482', 1, 2, 0, 6, 0 )
-             ENDIF
-
-!
-!--          Read nsvfl, ncsfl, nsurfl, nmrtf
-             READ ( 88 ) nsvfl, ncsfl, nsurfl_from_file, npcbl_from_file, ndsidir_from_file,       &
-                         nmrtbl_from_file, nmrtf
-
-             IF ( nsvfl < 0  .OR.  ncsfl < 0 )  THEN
-                 WRITE( message_string, * ) 'Wrong number of SVF or CSF'
-                 CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 )
-             ELSE
-                 WRITE(debug_string,*) 'Number of SVF, CSF, and nsurfl to read', nsvfl, ncsfl,     &
-                                       nsurfl_from_file
-                 IF ( debug_output )  CALL debug_message( debug_string, 'info' )
-             ENDIF
-
-             IF ( nsurfl_from_file /= nsurfl )  THEN
-                 WRITE( message_string, * ) 'nsurfl from SVF file does not match calculated ',     &
-                                            'nsurfl from radiation_interaction_init'
-                 CALL message( 'radiation_read_svf', 'PA0490', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             IF ( npcbl_from_file /= npcbl )  THEN
-                 WRITE( message_string, * ) 'npcbl from SVF file does not match calculated npcbl', &
-                                            ' from radiation_interaction_init'
-                 CALL message( 'radiation_read_svf', 'PA0493', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             IF ( ndsidir_from_file /= ndsidir )  THEN
-                 WRITE( message_string, * ) 'ndsidir from SVF file does not match calculated ',    &
-                                            'ndsidir from radiation_presimulate_solar_pos'
-                 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             IF ( nmrtbl_from_file /= nmrtbl )  THEN
-                 WRITE( message_string, * ) 'nmrtbl from SVF file does not match calculated ',     &
-                                            'nmrtbl from radiation_interaction_init'
-                 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 )
-             ELSE
-                 WRITE( debug_string, * ) 'Number of nmrtf to read ', nmrtf
-                 IF ( debug_output )  CALL debug_message( debug_string, 'info' )
-             ENDIF
-
-!
-!--          Arrays skyvf, skyvft, dsitrans and dsitransc are allready allocated in
-!--          radiation_interaction_init and radiation_presimulate_solar_pos
-             IF ( nsurfl > 0 )  THEN
-                READ( 88 ) skyvf
-                READ( 88 ) skyvft
-                READ( 88 ) dsitrans
-             ENDIF
-
-             IF ( plant_canopy  .AND.  npcbl > 0 )  THEN
-                READ( 88 )  dsitransc
-             ENDIF
-
-!
-!--          The allocation of svf, svfsurf, csf, csfsurf, mrtf, mrtft, and mrtfsurf happens in
-!--          routine radiation_calc_svf which is not called if the program enters
-!--          radiation_read_svf. Therefore these arrays have to be allocated in the following.
-             IF ( nsvfl > 0 )  THEN
-                ALLOCATE( svf(ndsvf,nsvfl) )
-                ALLOCATE( svfsurf(idsvf,nsvfl) )
-                READ( 88 ) svf
-                READ( 88 ) svfsurf
-             ENDIF
-
-             IF ( plant_canopy  .AND.  ncsfl > 0 )  THEN
-                ALLOCATE( csf(ndcsf,ncsfl) )
-                ALLOCATE( csfsurf(idcsf,ncsfl) )
-                READ( 88 ) csf
-                READ( 88 ) csfsurf
-             ENDIF
-
-             IF ( nmrtbl > 0 )  THEN
-                READ( 88 ) mrtsky
-                READ( 88 ) mrtskyt
-                READ( 88 ) mrtdsit
-             ENDIF
-
-             IF ( nmrtf > 0 )  THEN
-                ALLOCATE( mrtf(nmrtf) )
-                ALLOCATE( mrtft(nmrtf) )
-                ALLOCATE( mrtfsurf(2,nmrtf) )
-                READ( 88 ) mrtf
-                READ( 88 ) mrtft
-                READ( 88 ) mrtfsurf
-             ENDIF
-
-!
-!--          Close binary file
-             CALL close_file( 88 )
-
-          ENDIF
-#if defined( __parallel )
-          CALL MPI_BARRIER( comm2d, ierr )
-#endif
-       ENDDO
-
-       CALL location_message( 'reading sky view factors for radiation interaction ' //             &
-                              '(Fortran binary format)', 'finished' )
-
-
-    ELSEIF ( restart_data_format_input(1:3) == 'mpi' )  THEN
-
-!
-!--    In case of MPI-IO data is treated like surface data and the respective routines from
-!--    restart_data_mpi_io_mod are used for reading. Contrary to restart data, the virtual processor
-!--    grid can not be changed between writing and reading svf data.
-       CALL location_message( 'reading sky view factors for radiation interaction ' //             &
-                              '(MPI-IO format)', 'start' )
-!
-!--    Open MPI-IO svf file for reading the global data.
-       CALL rd_mpi_io_open( 'READ', 'SVFIN' // TRIM( coupling_char ),                              &
-                            open_for_global_io_only = .TRUE. )
-!
-!--    Check general header.
-       IF ( tgh%pes_along_x /= npex  .OR.  tgh%pes_along_y /= npey )  THEN
-!
-!--       Force re-calculation of svfs.
-          read_svf = .FALSE.
-          WRITE( message_string, '(A,I7,A,I7,A,I7,A,I7,A)' )                                       &
-              'virtual PE grid has changed between previous and current run &npex_prev = ',        &
-              tgh%pes_along_x, ' npey_prev = ', tgh%pes_along_y, ' npex_new = ', npex,             &
-              ' npey_new = ', npey, '&svf wil be re-calculated'
-          CALL message( 'radiation_read_svf', 'PA0517', 0, 0, 0, 6, 0 )
-          RETURN
-       ENDIF
-!
-!--    Read global variables
-       CALL rrd_mpi_io( 'rad_version', rad_version_in )
-       CALL rrd_mpi_io( 'nsvfl', nsvfl_tot )
-       CALL rrd_mpi_io( 'ncsfl', ncsfl_tot )
-       CALL rrd_mpi_io( 'nsurfl', nsurfl_from_file )
-       CALL rrd_mpi_io( 'npcbl', npcbl_from_file )
-       CALL rrd_mpi_io( 'ndsidir', ndsidir_from_file )
-       CALL rrd_mpi_io( 'nmrtbl', nmrtbl_from_file )
-       CALL rrd_mpi_io( 'nmrtf', nmrtf_tot )
-
-       CALL rd_mpi_io_close
-!
-!--    Compute global values of local counters.
-       local_sum(1) = nsurfl
-       local_sum(2) = npcbl
-       local_sum(3) = ndsidir
-       local_sum(4) = nmrtbl
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( local_sum, global_sum, SIZE(local_sum), MPI_INTEGER, MPI_SUM, comm2d,   &
-                           ierr)
-#else
-       global_sum = local_sum
-#endif
-       nsurfl_tot  = global_sum(1)
-       npcbl_tot   = global_sum(2)
-       ndsidir_tot = global_sum(3)
-       nmrtbl_tot  = global_sum(4)
-!
-!--    Check for errors.
-       nx_on_file = tgh%total_nx-1
-       ny_on_file = tgh%total_ny-1
-
-       IF ( nx_on_file /= nx  .OR.  ny_on_file /= ny )  THEN
-          WRITE( message_string, '(A,4(A,I7))' )                                                   &
-               'total number of grid points along x and y in file SVFIN do not match current run', &
-               '&nx_on_file = ', nx_on_file, ' ny_on_file = ', ny_on_file, ' nx = ', nx, ' ny = ', &
-               ny
-          CALL message( 'radiation_read_svf', 'PA0518', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( TRIM( rad_version_in ) /= TRIM( rad_version ) )  THEN
-          WRITE( message_string, * ) 'Version of binary SVF file "', TRIM( rad_version_field ),    &
-                                     '" does not match the version of model "',                    &
-                                     TRIM( rad_version ), '"'
-          CALL message( 'radiation_read_svf', 'PA0482', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( nsvfl_tot < 0  .OR.  ncsfl_tot < 0 )  THEN
-          WRITE( message_string, * ) 'Wrong number of SVF or CSF'
-          CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 )
-       ELSE
-          WRITE(debug_string,*) 'Number of SVF, CSF, and nsurfl to read', nsvfl_tot, ncsfl_tot,  &
-                                          nsurfl_tot
-          IF ( debug_output )  CALL debug_message( debug_string, 'info' )
-       ENDIF
-
-       IF ( nsurfl_from_file /= nsurfl_tot )  THEN
-          WRITE( message_string, * ) 'nsurfl from SVF file does not match calculated ',        &
-             'nsurfl from radiation_interaction_init'
-          CALL message( 'radiation_read_svf', 'PA0490', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( npcbl_from_file /= npcbl_tot )  THEN
-          WRITE( message_string, * ) 'npcbl from SVF file does not match calculated npcbl ',   &
-             'from radiation_interaction_init'
-          CALL message( 'radiation_read_svf', 'PA0493', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( ndsidir_from_file /= ndsidir_tot )  THEN
-          WRITE( message_string, * ) 'ndsidir from SVF file does not match calculated ',       &
-             'ndsidir from radiation_presimulate_solar_pos'
-          CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( nmrtbl_from_file /= nmrtbl_tot )  THEN
-          WRITE( message_string, * ) 'nmrtbl from SVF file does not match calculated nmrtbl ', &
-             'from radiation_interaction_init'
-          CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 )
-       ELSE
-          WRITE( debug_string, * ) 'Number of nmrtf to read ', nmrtf_tot
-          IF ( debug_output )  CALL debug_message( debug_string, 'info' )
-       ENDIF
-
-!
-!--    Open MPI-IO SVF file for read local data.
-       CALL rd_mpi_io_open( 'READ', 'SVFIN' // TRIM( coupling_char ) )
-
-       IF ( nsurfl_tot > 0 )  THEN
-!
-!--       Read global indices.
-          CALL rrd_mpi_io( 'nsurfl_global_start', global_start )
-          CALL rrd_mpi_io( 'nsurfl_global_end', global_end )
-!
-!--       Set file types of variables and compute local indices.
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start,    &
-                                            global_end )
-          nsurfl = end_index(nyn,nxr)
-
-          IF ( data_to_read )  THEN
-
-             CALL rrd_mpi_io_surface( 'skyvf', skyvf )
-             CALL rrd_mpi_io_surface( 'skyvft', skyvft )
-!
-!--          To avoid another overlay of rrd_mpi_io_surface, dsitrans is read as REAL tmp array.
-!--          The order of dimensions of dsitrans is different to the order expected by
-!--          rrd_mpi_io_surface. Therefor a tranpose of tmp is required.
-             ALLOCATE( tmp(SIZE(dsitrans,2),SIZE(dsitrans,1)) )
-             CALL rrd_mpi_io_surface( 'dsitrans', tmp )
-             dsitrans = TRANSPOSE( tmp )
-             DEALLOCATE( tmp )
-
-          ENDIF
-
-       ENDIF
-
-       IF ( npcbl_tot > 0 )  THEN
-
-          CALL rrd_mpi_io( 'npcbl_global_start', global_start )
-          CALL rrd_mpi_io( 'npcbl_global_end', global_end )
-
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start,    &
-                                            global_end )
-          npcbl = end_index(nyn,nxr)
-
-          IF ( data_to_read )  THEN
-
-             ALLOCATE( tmp(SIZE(dsitransc,2),SIZE(dsitransc,1)) )
-             CALL rrd_mpi_io_surface( 'dsitransc', tmp )
-             dsitransc = TRANSPOSE( tmp )
-             DEALLOCATE( tmp )
-
-          ENDIF
-
-       ENDIF
-
-       IF ( nsvfl_tot > 0 )  THEN
-
-          CALL rrd_mpi_io( 'nsvfl_global_start', global_start )
-          CALL rrd_mpi_io( 'nsvfl_global_end', global_end )
-
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start,    &
-                                            global_end )
-          nsvfl = end_index(nyn,nxr)
-
-          IF ( .NOT. ALLOCATED( svf )     )  ALLOCATE( svf(ndsvf,nsvfl) )
-          IF ( .NOT. ALLOCATED( svfsurf ) )  ALLOCATE( svfsurf(idsvf,nsvfl) )
-
-          IF ( data_to_read )  THEN
-
-             CALL rrd_mpi_io_surface( 'svf', svf )
-             ALLOCATE( tmp(SIZE(svfsurf,1),SIZE(svfsurf,2)) )
-             CALL rrd_mpi_io_surface( 'svfsurf', tmp )
-             svfsurf = tmp
-             DEALLOCATE( tmp )
-
-          ENDIF
-
-       ENDIF
-
-       IF ( plant_canopy  )  THEN
-
-          IF ( ncsfl_tot > 0 )  THEN
-
-             CALL rrd_mpi_io( 'ncsfl_global_start', global_start )
-             CALL rrd_mpi_io( 'ncsfl_global_end', global_end )
-
-             CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start, &
-                                               global_end )
-             ncsfl = end_index(nyn,nxr)
-
-             IF ( .NOT. ALLOCATED( csf )     )  ALLOCATE( csf(ndcsf,ncsfl) )
-             IF ( .NOT. ALLOCATED( csfsurf ) )  ALLOCATE( csfsurf(idcsf,ncsfl) )
-
-             IF ( data_to_read )  THEN
-
-                CALL rrd_mpi_io_surface( 'csf', csf )
-                ALLOCATE( tmp(SIZE(csfsurf,1),SIZE(csfsurf,2)) )
-                CALL rrd_mpi_io_surface( 'csfsurf', tmp )
-                csfsurf = tmp
-                DEALLOCATE( tmp )
-
-             ENDIF
-
-          ENDIF
-
-       ENDIF
-
-       IF ( nmrtbl_tot > 0 )  THEN
-
-          CALL rrd_mpi_io( 'nmrtbl_global_start', global_start )
-          CALL rrd_mpi_io( 'nmrtbl_global_end', global_end )
-
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start,    &
-                                            global_end )
-          nmrtbl = end_index(nyn,nxr)
-
-          IF ( data_to_read )  THEN
-
-             CALL rrd_mpi_io_surface( 'mrtsky', mrtsky )
-             CALL rrd_mpi_io_surface( 'mrtskyt', mrtskyt )
-             ALLOCATE( tmp(SIZE(mrtdsit,2),SIZE(mrtdsit,1)) )
-             CALL rrd_mpi_io_surface( 'mrtdsit', tmp )
-             mrtdsit = TRANSPOSE( tmp )
-             DEALLOCATE( tmp )
-
-          ENDIF
-
-       ENDIF
-
-       IF ( nmrtf_tot > 0 )  THEN
-
-          CALL rrd_mpi_io( 'nmrtf_global_start', global_start )
-          CALL rrd_mpi_io( 'nmrtf_global_end', global_end )
-
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start,    &
-                                            global_end )
-          nmrtf = end_index(nyn,nxr)
-
-          IF ( .NOT. ALLOCATED( mrtf )     )  ALLOCATE( mrtf(nmrtf) )
-          IF ( .NOT. ALLOCATED( mrtft )    )  ALLOCATE( mrtft(nmrtf) )
-          IF ( .NOT. ALLOCATED( mrtfsurf ) )  ALLOCATE( mrtfsurf(2,nmrtf) )
-
-          IF ( data_to_read )  THEN
-
-             CALL rrd_mpi_io_surface( 'mrtf', mrtf )
-             CALL rrd_mpi_io_surface( 'mrtft', mrtft )
-             ALLOCATE( tmp(SIZE(mrtfsurf,1),SIZE(mrtfsurf,2)) )
-             CALL rrd_mpi_io_surface( 'mrtfsurf', tmp )
-             mrtfsurf = tmp
-             DEALLOCATE( tmp )
-
-          ENDIF
-
-       ENDIF
-
-       CALL rd_mpi_io_close
-
-       CALL location_message( 'reading sky view factors for radiation interaction ' //             &
-                              '(MPI-IO format)', 'finished' )
-
-    ENDIF
-
- END SUBROUTINE radiation_read_svf
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine stores svf, svfsurf, csf, csfsurf and mrt data to a file. The stored factors can be
-!> reused in future simulation with the same geometry structure of the surfaces and resolved plant
-!> canopy.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_write_svf
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), PARAMETER ::  max_i4_value  = 2147483647  !< maximum positive INTEGER(4) value, 2**31 - 1
-
-    INTEGER(iwp) ::  i            !<
-    INTEGER(iwp) ::  ic           !<
-#if defined( __parallel )
-    INTEGER(iwp) ::  ierr         !<
-#endif
-    INTEGER(iwp) ::  ind          !<
-    INTEGER(iwp) ::  ipcgb        !<
-    INTEGER(iwp) ::  isurf        !<
-    INTEGER(iwp) ::  j            !<
-    INTEGER(iwp) ::  jc           !<
-    INTEGER(iwp) ::  ncsfl_tot    !<
-    INTEGER(iwp) ::  ndsidir_tot  !<
-    INTEGER(iwp) ::  nmrtbl_tot   !<
-    INTEGER(iwp) ::  nmrtf_tot    !<
-    INTEGER(iwp) ::  npcbl_tot    !<
-    INTEGER(iwp) ::  nsurfl_tot   !<
-    INTEGER(iwp) ::  nsvfl_tot    !< total (sum over all PEs) counter for the different IO variables
-
-    INTEGER(idp), DIMENSION(7) ::  local_sum   !< variables to compute total counter
-    INTEGER(idp), DIMENSION(7) ::  global_sum  !< INTEGER(idp) to allow check, if total number of values > 2G
-
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  end_index     !< local end index
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_end    !< global end index
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_start  !< global start index
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  lo_no         !< local number of values
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  start_index   !< local start index
-
-    LOGICAL ::  data_to_write  !<  flag indicating if data is available for writing
-
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::  tmp  !<
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL location_message( 'writing sky view factors for radiation interaction ' //             &
-                              '(Fortran binary format)', 'start' )
-
-       DO  i = 0, io_blocks-1
-          IF ( i == io_group )  THEN
-!
-!--          Open binary file
-             CALL check_open( 89 )
-
-             WRITE( 89 ) rad_version
-             WRITE( 89 ) nsvfl, ncsfl, nsurfl, npcbl, ndsidir, nmrtbl, nmrtf
-             IF ( nsurfl > 0 )  THEN
-                WRITE( 89 ) skyvf
-                WRITE( 89 ) skyvft
-                WRITE( 89 ) dsitrans
-             ENDIF
-             IF ( npcbl > 0 ) THEN
-                WRITE( 89 ) dsitransc
-             ENDIF
-             IF ( nsvfl > 0 ) THEN
-                WRITE( 89 ) svf
-                WRITE( 89 ) svfsurf
-             ENDIF
-             IF ( plant_canopy  .AND.  ncsfl > 0 )  THEN
-                 WRITE( 89 ) csf
-                 WRITE( 89 ) csfsurf
-             ENDIF
-             IF ( nmrtbl > 0 )  THEN
-                WRITE( 89 ) mrtsky
-                WRITE( 89 ) mrtskyt
-                WRITE( 89 ) mrtdsit
-             ENDIF
-             IF ( nmrtf > 0 )  THEN
-                 WRITE( 89 ) mrtf
-                 WRITE( 89 ) mrtft
-                 WRITE( 89 ) mrtfsurf
-             ENDIF
-!
-!--          Close binary file
-             CALL close_file( 89 )
-
-          ENDIF
-#if defined( __parallel )
-          CALL MPI_BARRIER( comm2d, ierr )
-#endif
-       ENDDO
-
-       CALL location_message( 'writing sky view factors for radiation interaction ' //             &
-                              '(Fortran binary format)', 'fnished' )
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-!
-!--    Sky view factor data is treated like surface data and the respective routines from
-!--    restart_data_mpi_io_mod are used for writing. In contrary to restart data, the virtual
-!--    processor grid can not be changed between writing and reading svf data.
-       CALL location_message( 'writing sky view factors for radiation interaction ' //             &
-                              '(MPI-IO format)', 'start' )
-
-!
-!--    Open MPI-IO svf file
-       CALL rd_mpi_io_open( 'write', 'SVFOUT' // TRIM( coupling_char ) )
-!
-!--    Write global variables.
-       CALL wrd_mpi_io( 'rad_version', rad_version )
-!
-!--    Sum local number of skyview factor values on all PEs.
-       local_sum(1) = nsvfl
-       local_sum(2) = ncsfl
-       local_sum(3) = nsurfl
-       local_sum(4) = npcbl
-       local_sum(5) = ndsidir
-       local_sum(6) = nmrtbl
-       local_sum(7) = nmrtf
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( local_sum, global_sum, SIZE( local_sum ), MPI_INTEGER8, MPI_SUM,        &
-                           comm2d, ierr)
-#else
-       global_sum = local_sum
-#endif
-!
-!--    Check, if total number of respective skyview values do not exceed 2**31-1
-       DO  i = 1, 7
-          IF ( global_sum(i) > max_i4_value )  THEN
-             WRITE( message_string, '(A,I1,A)' ) 'number of sky view factor values (', i,          &
-                                                 ') > 2**31-1'
-             CALL message( 'radiation_write_svf', 'PA0733', 1, 2, 0, 6, 0 )
-          ENDIF
-       ENDDO
-
-       nsvfl_tot   = global_sum(1)
-       ncsfl_tot   = global_sum(2)
-       nsurfl_tot  = global_sum(3)
-       npcbl_tot   = global_sum(4)
-       ndsidir_tot = global_sum(5)
-       nmrtbl_tot  = global_sum(6)
-       nmrtf_tot   = global_sum(7)
-!
-!--    Write total counters in header section of MPI-IO file.
-       CALL wrd_mpi_io( 'nsvfl', nsvfl_tot )
-       CALL wrd_mpi_io( 'ncsfl', ncsfl_tot )
-       CALL wrd_mpi_io( 'nsurfl', nsurfl_tot )
-       CALL wrd_mpi_io( 'npcbl', npcbl_tot )
-       CALL wrd_mpi_io( 'ndsidir', ndsidir_tot )
-       CALL wrd_mpi_io( 'nmrtbl', nmrtbl_tot )
-       CALL wrd_mpi_io( 'nmrtf', nmrtf_tot )
-!
-!--    Write local data.
-!--    All svf values are treated as surface values and use the respective routines from
-!--    restart_data_mpi_io_mod.
-       IF ( nsurfl > 0 )  THEN
-
-          lo_no = 0
-!
-!--       Count surface values on individual grid cells
-          DO  isurf = 1, nsurfl
-             jc = surfl(iy, isurf)
-             ic = surfl(ix, isurf)
-             lo_no(jc,ic) = lo_no(jc,ic) + 1
-          ENDDO
-!
-!--       Create local index array similar to surface routines.
-          ind = 1
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                start_index(j,i) = ind
-                end_index(j,i)   = start_index(j,i) + lo_no(j,i) - 1
-                ind = ind + lo_no(j,i)
-             ENDDO
-          ENDDO
-
-       ELSE
-
-          start_index = 1
-          end_index = 0
-
-       ENDIF
-!
-!--    Each PE has to call the next block, therefore nsurfl_tot is used.
-!--    This is required to use MPI_FILE_WRITE_All for writing.
-       IF ( nsurfl_tot > 0 )  THEN
-!
-!--       Set file types of variables for this block and compute global indices.
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start,   &
-                                            global_end )
-
-          CALL wrd_mpi_io( 'nsurfl_global_start', global_start )
-          CALL wrd_mpi_io( 'nsurfl_global_end', global_end )
-
-          IF ( data_to_write )  THEN
-
-             CALL wrd_mpi_io_surface( 'skyvf', skyvf )
-             CALL wrd_mpi_io_surface( 'skyvft', skyvft )
-!
-!--          To avoid another overlay of rrd_mpi_io_surface, dsitrans is written as REAL tmp array.
-!--          The order of dimensions of dsitrans is different to the order expected by
-!--          rrd_mpi_io_surface. Therefor a tranpose of tmp is required.
-             ALLOCATE( tmp(SIZE(dsitrans,2),SIZE(dsitrans,1)) )
-             tmp = TRANSPOSE( dsitrans )
-             CALL wrd_mpi_io_surface( 'dsitrans', tmp )
-             DEALLOCATE( tmp )
-
-          ENDIF
-
-       ENDIF
-
-       IF ( npcbl > 0 )  THEN
-
-          lo_no = 0
-          DO  isurf = 1, npcbl
-             jc = pcbl(iy,isurf)
-             ic = pcbl(ix,isurf)
-             lo_no(jc,ic) = lo_no(jc,ic) + 1
-          ENDDO
-
-          ind = 1
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                start_index(j,i) = ind
-                end_index(j,i)   = start_index(j,i) + lo_no(j,i) - 1
-                ind = ind+lo_no(j,i)
-             ENDDO
-          ENDDO
-
-       ELSE
-
-          start_index = 1
-          end_index = 0
-
-       ENDIF
-
-       IF ( npcbl_tot > 0 )  THEN
-
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start,   &
-                                            global_end )
-          CALL wrd_mpi_io( 'npcbl_global_start', global_start )
-          CALL wrd_mpi_io( 'npcbl_global_end', global_end )
-
-          IF ( data_to_write )  THEN
-
-             ALLOCATE( tmp(SIZE(dsitransc,2),SIZE(dsitransc,1)) )
-             tmp = TRANSPOSE( dsitransc )
-             CALL wrd_mpi_io_surface( 'dsitransc', tmp )
-             DEALLOCATE( tmp )
-          ENDIF
-       ENDIF
-
-       IF ( nsvfl > 0 )  THEN
-
-          lo_no = 0
-          DO  j = 1, SIZE( svfsurf, 2 )
-             isurf = svfsurf(1,j)
-             jc = surfl(iy,isurf)
-             ic = surfl(ix,isurf)
-             lo_no(jc,ic) = lo_no(jc,ic) + 1
-          ENDDO
-
-          ind = 1
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                start_index(j,i) = ind
-                end_index(j,i)   = start_index(j,i) + lo_no(j,i) - 1
-                ind = ind+lo_no(j,i)
-             ENDDO
-          ENDDO
-
-       ELSE
-
-          start_index = 1
-          end_index = 0
-       ENDIF
-
-       IF ( nsvfl_tot > 0 )  THEN
-
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start,   &
-                                            global_end )
-          CALL wrd_mpi_io( 'nsvfl_global_start', global_start )
-          CALL wrd_mpi_io( 'nsvfl_global_end', global_end )
-
-          IF ( data_to_write )  THEN
-
-             CALL wrd_mpi_io_surface( 'svf', svf )
-             ALLOCATE( tmp(SIZE(svfsurf,1),SIZE(svfsurf,2)) )
-             tmp(:,:) = svfsurf(:,:)
-             CALL wrd_mpi_io_surface( 'svfsurf', tmp )
-             DEALLOCATE( tmp )
-
-          ENDIF
-
-       ENDIF
-
-       IF ( plant_canopy  )  THEN
-
-          lo_no = 0
-          IF ( ncsfl > 0 )  THEN
-
-             DO  j = 1, ncsfl
-                ipcgb = csfsurf(1, j)
-                jc = pcbl(iy,ipcgb)
-                ic = pcbl(ix,ipcgb)
-                lo_no(jc,ic) = lo_no(jc,ic) + 1
-             ENDDO
-
-             ind = 1
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   start_index(j,i) = ind
-                   end_index(j,i)   = start_index(j,i) + lo_no(j,i) - 1
-                   ind = ind+lo_no(j,i)
-                ENDDO
-             ENDDO
-
-          ELSE
-
-             start_index = 1
-             end_index = -1
-
-          ENDIF
-
-          IF ( ncsfl_tot > 0 )  THEN
-
-             CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start,&
-                                               global_end )
-             CALL wrd_mpi_io( 'ncsfl_global_start', global_start )
-             CALL wrd_mpi_io( 'ncsfl_global_end', global_end )
-
-             IF ( data_to_write )  THEN
-
-                IF ( ALLOCATED( csf ) )  THEN
-                   CALL wrd_mpi_io_surface( 'csf', csf )
-                ELSE
-                   ALLOCATE( tmp(ndcsf,0) )
-                   CALL wrd_mpi_io_surface( 'csf', tmp )
-                   DEALLOCATE( tmp )
-                ENDIF
-
-                IF ( ALLOCATED( csfsurf ) )  THEN
-                   ALLOCATE( tmp(SIZE(csfsurf,1),SIZE(csfsurf,2)) )
-                   tmp(:,:) = csfsurf(:,:)
-                   CALL wrd_mpi_io_surface( 'csfsurf', tmp )
-                   DEALLOCATE( tmp )
-                ELSE
-                   ALLOCATE( tmp(idcsf,ncsfl) )
-                   CALL wrd_mpi_io_surface( 'csfsurf', tmp )
-                   DEALLOCATE( tmp )
-                ENDIF
-
-             ENDIF
-
-          ENDIF
-
-       ENDIF
-
-       IF ( nmrtbl > 0 )  THEN
-
-          lo_no = 0
-          DO  j = 1, nmrtbl
-             jc = mrtbl(iy,j)
-             ic = mrtbl(ix,j)
-             lo_no(jc,ic) = lo_no(jc,ic) + 1
-          ENDDO
-
-          ind = 1
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                start_index(j,i) = ind
-                end_index(j,i)   = start_index(j,i) + lo_no(j,i) - 1
-                ind = ind+lo_no(j,i)
-             ENDDO
-          ENDDO
-
-       ELSE
-
-          start_index = 1
-          end_index = 0
-       ENDIF
-
-       IF ( nmrtbl_tot > 0 )  THEN
-
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start,   &
-                                            global_end )
-          CALL wrd_mpi_io( 'nmrtbl_global_start', global_start )
-          CALL wrd_mpi_io( 'nmrtbl_global_end', global_end )
-
-          IF ( data_to_write )  THEN
-
-             CALL wrd_mpi_io_surface( 'mrtsky', mrtsky )
-             CALL wrd_mpi_io_surface( 'mrtskyt', mrtskyt )
-             ALLOCATE( tmp(SIZE(mrtdsit,2),SIZE(mrtdsit,1)) )
-             tmp = TRANSPOSE( mrtdsit )
-             CALL wrd_mpi_io_surface( 'mrtdsit', tmp )
-             DEALLOCATE( tmp )
-
-          ENDIF
-
-       ENDIF
-
-       IF ( nmrtf > 0 )  THEN
-
-          lo_no = 0
-          DO  j = 1, nmrtf
-             isurf = mrtfsurf(1,j)
-             jc = surfl(iy,isurf)
-             ic = surfl(ix,isurf)
-             lo_no(jc,ic) = lo_no(jc,ic) + 1
-          ENDDO
-
-          ind = 1
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                start_index(j,i) = ind
-                end_index(j,i)   = start_index(j,i) + lo_no(j,i) - 1
-                ind = ind+lo_no(j,i)
-             ENDDO
-          ENDDO
-
-       ELSE
-          start_index = 1
-          end_index = 0
-       ENDIF
-
-       IF ( nmrtf_tot > 0 )  THEN
-
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start,   &
-                                            global_end)
-          CALL wrd_mpi_io( 'nmrtf_global_start', global_start )
-          CALL wrd_mpi_io( 'nmrtf_global_end', global_end )
-
-          IF ( data_to_write )  THEN
-
-             CALL wrd_mpi_io_surface ( 'mrtf', mrtf )
-             CALL wrd_mpi_io_surface ( 'mrtft', mrtft )
-
-             ALLOCATE( tmp(SIZE(mrtfsurf,1),SIZE(mrtfsurf,2)) )
-             tmp = mrtfsurf
-             CALL wrd_mpi_io_surface( 'mrtfsurf', tmp )
-             DEALLOCATE( tmp )
-
-          ENDIF
-
-       ENDIF
-
-       CALL rd_mpi_io_close
-
-       CALL location_message( 'writing sky view factors for radiation interaction ' //             &
-                              '(MPI-IO format)', 'finished' )
-    ENDIF
-
- END SUBROUTINE radiation_write_svf
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Block of auxiliary subroutines for RTM:
-!> 1. quicksort and corresponding comparison
-!> 2. merge_and_grow_csf for implementation of "dynamical growing" array for csf
-!--------------------------------------------------------------------------------------------------!
-!-- quicksort.f -*-f90-*-
-!-- Author: t-nissie, adaptation J.Resler
-!-- License: GPLv3
-!-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
-!--------------------------------------------------------------------------------------------------!
- RECURSIVE SUBROUTINE quicksort_itarget( itarget, vffrac, ztransp, first, last )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, j  !<
-    INTEGER(iwp) ::  x, t  !<
-
-    INTEGER(iwp), INTENT(IN) :: first, last  !<
-
-    INTEGER(iwp), DIMENSION(:), INTENT(INOUT) ::  itarget  !<
-
-    REAL(wp) ::  tr  !<
-
-    REAL(wp), DIMENSION(:), INTENT(INOUT) ::  vffrac, ztransp  !<
-
-    IF ( first >= last )  RETURN
-    x = itarget(( first + last ) / 2)
-    i = first
-    j = last
-    DO
-        DO WHILE ( itarget(i) < x )
-           i = i+1
-        ENDDO
-        DO WHILE ( x < itarget(j) )
-            j = j-1
-        ENDDO
-        IF ( i >= j ) EXIT
-        t = itarget(i);  itarget(i) = itarget(j);  itarget(j) = t
-        tr = vffrac(i);  vffrac(i) = vffrac(j);  vffrac(j) = tr
-        tr = ztransp(i);  ztransp(i) = ztransp(j);  ztransp(j) = tr
-        i = i+1
-        j = j-1
-    ENDDO
-    IF ( first < i-1 )  CALL quicksort_itarget( itarget, vffrac, ztransp, first, i - 1 )
-    IF ( j+1 < last )  CALL quicksort_itarget( itarget, vffrac, ztransp, j + 1, last )
-
- END SUBROUTINE quicksort_itarget
-
-
-
- PURE FUNCTION svf_lt( svf1, svf2 ) result( res )
-
-    TYPE(t_svf), INTENT(in) :: svf1,svf2  !<
-    LOGICAL                  :: res       !<
-
-    IF ( svf1%isurflt < svf2%isurflt  .OR.    &
-       (svf1%isurflt == svf2%isurflt  .AND.  svf1%isurfs < svf2%isurfs) )  THEN
-        res = .TRUE.
-    ELSE
-        res = .FALSE.
-    ENDIF
-
- END FUNCTION svf_lt
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description!
-!--------------------------------------------------------------------------------------------------!
-!-- quicksort.f -*-f90-*-
-!-- Author: t-nissie, adaptation J.Resler
-!-- License: GPLv3
-!-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
-!--------------------------------------------------------------------------------------------------!
- RECURSIVE SUBROUTINE quicksort_svf( svfl, first, last )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, j  !<
-
-    INTEGER(iwp), INTENT(IN) ::  first, last  !<
-
-    TYPE(t_svf) :: x, t  !<
-
-    TYPE(t_svf), DIMENSION(:), INTENT(INOUT) ::  svfl  !<
-
-
-    IF ( first >= last )  RETURN
-    x = svfl(( first + last ) / 2)
-    i = first
-    j = last
-    DO
-        DO WHILE ( svf_lt(svfl(i),x) )
-           i = i+1
-        ENDDO
-        DO WHILE ( svf_lt(x,svfl(j)) )
-            j=j-1
-        ENDDO
-        IF ( i >= j ) EXIT
-        t = svfl(i);  svfl(i) = svfl(j);  svfl(j) = t
-        i= i+1
-        j= j-1
-    ENDDO
-    IF ( first < i-1 )  CALL quicksort_svf( svfl, first, i - 1 )
-    IF ( j+1 < last )  CALL quicksort_svf( svfl, j + 1, last )
-
- END SUBROUTINE quicksort_svf
-
-
-
- PURE FUNCTION csf_lt( csf1, csf2 ) result( res )
-
-    LOGICAL ::  res  !<
-
-    TYPE(t_csf), INTENT(in) ::  csf1,csf2  !<
-
-    IF ( csf1%ip < csf2%ip     .OR.                                                                &
-       ( csf1%ip == csf2%ip    .AND.  csf1%itx < csf2%itx )  .OR.                                  &
-       ( csf1%ip == csf2%ip    .AND.  csf1%itx == csf2%itx   .AND.  csf1%ity < csf2%ity )  .OR.    &
-       ( csf1%ip == csf2%ip    .AND.  csf1%itx == csf2%itx   .AND.  csf1%ity == csf2%ity   .AND.   &
-         csf1%itz < csf2%itz ) .OR.                                                                &
-       ( csf1%ip == csf2%ip    .AND.  csf1%itx == csf2%itx   .AND.  csf1%ity == csf2%ity   .AND.   &
-        csf1%itz == csf2%itz   .AND.  csf1%isurfs < csf2%isurfs ) )  THEN
-        res = .TRUE.
-    ELSE
-        res = .FALSE.
-    ENDIF
-
- END FUNCTION csf_lt
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description!
-!--------------------------------------------------------------------------------------------------!
-!-- quicksort.f -*-f90-*-
-!-- Author: t-nissie, adaptation J.Resler
-!-- License: GPLv3
-!-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
-!--------------------------------------------------------------------------------------------------!
- RECURSIVE SUBROUTINE quicksort_csf(csfl, first, last)
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, j  !<
-
-    INTEGER(iwp), INTENT(IN) ::  first, last  !<
-
-    TYPE(t_csf) ::  x, t  !<
-
-    TYPE(t_csf), DIMENSION(:), INTENT(INOUT) ::  csfl  !<
-
-
-    IF ( first >= last )  RETURN
-    x = csfl(( first + last ) / 2)
-    i = first
-    j = last
-    DO
-        DO WHILE ( csf_lt(csfl(i),x) )
-            i = i+1
-        ENDDO
-        DO WHILE ( csf_lt(x,csfl(j)) )
-            j = j-1
-        ENDDO
-        IF ( i >= j )  EXIT
-        t = csfl(i);  csfl(i) = csfl(j);  csfl(j) = t
-        i = i+1
-        j = j-1
-    ENDDO
-    IF ( first < i-1 )  CALL quicksort_csf( csfl, first, i-1 )
-    IF ( j+1 < last )  CALL quicksort_csf( csfl, j+1, last )
-
- END SUBROUTINE quicksort_csf
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Grows the CSF array in RTM exponentially when it is full. During that, the ray canopy sink
-!> factors with common source face and target plant canopy grid cell are merged together so that the
-!> size doesn't grow out of control.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE merge_and_grow_csf( newsize )
-
-   INTEGER(iwp) ::  iread, iwrite  !<
-
-   INTEGER(iwp), INTENT(IN) ::  newsize  !< new array size after grow, must be >= ncsfl
-                                         !< or -1 to shrink to minimum
-
-    TYPE(t_csf), DIMENSION(:), POINTER ::  acsfnew  !<
-
-
-    IF ( newsize == -1 )  THEN
-!
-!--     Merge in-place
-        acsfnew => acsf
-    ELSE
-!
-!--     Allocate new array
-        IF ( mcsf == 0 )  THEN
-            ALLOCATE( acsf1(newsize) )
-            acsfnew => acsf1
-        ELSE
-            ALLOCATE( acsf2(newsize) )
-            acsfnew => acsf2
-        ENDIF
-    ENDIF
-
-    IF ( ncsfl >= 1 )  THEN
-!
-!--     Sort csf in place (quicksort)
-        CALL quicksort_csf( acsf, 1, ncsfl )
-!
-!--     While moving to a new array, aggregate canopy sink factor records with identical box & source
-        acsfnew(1) = acsf(1)
-        iwrite = 1
-        DO iread = 2, ncsfl
-!
-!--         Here acsf(kcsf) already has values from acsf(icsf)
-            IF ( acsfnew(iwrite)%itx == acsf(iread)%itx                                            &
-                 .AND.  acsfnew(iwrite)%ity == acsf(iread)%ity                                     &
-                 .AND.  acsfnew(iwrite)%itz == acsf(iread)%itz                                     &
-                 .AND.  acsfnew(iwrite)%isurfs == acsf(iread)%isurfs )  THEN
-
-                acsfnew(iwrite)%rcvf = acsfnew(iwrite)%rcvf + acsf(iread)%rcvf
-!
-!--         Advance reading index, keep writing index
-            ELSE
-!
-!--             Not identical, just advance and copy
-                iwrite = iwrite + 1
-                acsfnew(iwrite) = acsf(iread)
-            ENDIF
-        ENDDO
-        ncsfl = iwrite
-    ENDIF
-
-    IF ( newsize == -1 )  THEN
-!
-!--     Allocate new array and copy shrinked data
-        IF ( mcsf == 0 )  THEN
-            ALLOCATE( acsf1(ncsfl) )
-            acsf1(1:ncsfl) = acsf2(1:ncsfl)
-        ELSE
-            ALLOCATE( acsf2(ncsfl) )
-            acsf2(1:ncsfl) = acsf1(1:ncsfl)
-        ENDIF
-    ENDIF
-!
-!-- Deallocate old array
-    IF ( mcsf == 0 )  THEN
-        mcsf = 1
-        acsf => acsf1
-        DEALLOCATE( acsf2 )
-    ELSE
-        mcsf = 0
-        acsf => acsf2
-        DEALLOCATE( acsf1 )
-    ENDIF
-    ncsfla = newsize
-
-    IF ( debug_output )  THEN
-       WRITE( debug_string, '(A,2I12)' ) 'Grow acsf2:', ncsfl, ncsfla
-       CALL debug_message( debug_string, 'info' )
-    ENDIF
-
- END SUBROUTINE merge_and_grow_csf
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> @Todo: Missing subroutine description!
-!--------------------------------------------------------------------------------------------------!
-!-- quicksort.f -*-f90-*-
-!-- Author: t-nissie, adaptation J.Resler
-!-- License: GPLv3
-!-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
-!--------------------------------------------------------------------------------------------------!
- RECURSIVE SUBROUTINE quicksort_csf2( kpcsflt, pcsflt, first, last )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, j  !<
-
-    INTEGER(iwp), INTENT(IN) ::  first, last  !<
-
-    INTEGER(iwp), DIMENSION(kdcsf) ::  x, t1  !<
-
-    INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) ::  kpcsflt  !<
-
-    REAL(wp), DIMENSION(ndcsf) ::  t2  !<
-
-    REAL(wp), DIMENSION(:,:), INTENT(INOUT) ::  pcsflt  !<
-
-
-    IF ( first >= last )  RETURN
-    x = kpcsflt(:, ( first + last ) / 2 )
-    i = first
-    j = last
-    DO
-        DO WHILE ( csf_lt2(kpcsflt(:,i),x) )
-            i = i+1
-        ENDDO
-        DO WHILE ( csf_lt2(x,kpcsflt(:,j)) )
-            j = j-1
-        ENDDO
-        IF ( i >= j )  EXIT
-        t1 = kpcsflt(:,i);  kpcsflt(:,i) = kpcsflt(:,j);  kpcsflt(:,j) = t1
-        t2 = pcsflt(:,i);  pcsflt(:,i) = pcsflt(:,j);  pcsflt(:,j) = t2
-        i=i+1
-        j=j-1
-    ENDDO
-    IF ( first < i-1 )  CALL quicksort_csf2( kpcsflt, pcsflt, first, i-1 )
-    IF ( j+1 < last )  CALL quicksort_csf2( kpcsflt, pcsflt, j+1, last )
-
- END SUBROUTINE quicksort_csf2
-
-
-
- PURE FUNCTION csf_lt2( item1, item2 ) result( res )
-
-    INTEGER(iwp), DIMENSION(kdcsf), INTENT(IN)  :: item1, item2  !<
-
-    LOGICAL :: res  !<
-
-    res = ( ( item1(3) < item2(3) )  .OR.  ( item1(3) == item2(3)  .AND.  item1(2) < item2(2) )    &
-            .OR.  ( item1(3) == item2(3)  .AND.  item1(2) == item2(2)  .AND.  item1(1) < item2(1) )&
-            .OR.  ( item1(3) == item2(3)  .AND.  item1(2) == item2(2)  .AND.  item1(1) == item2(1) &
-            .AND.  item1(4) < item2(4) ) )
-
- END FUNCTION csf_lt2
-
-
-
- PURE FUNCTION searchsorted( athresh, val ) result( ind )
-
-    INTEGER(iwp) ::  i    !<
-    INTEGER(iwp) ::  ind  !<
-
-    REAL(wp), INTENT(IN) ::  val  !<
-
-    REAL(wp), DIMENSION(:), INTENT(IN) ::  athresh  !<
-
-
-
-
-    DO i = LBOUND( athresh, 1 ), UBOUND( athresh, 1 )
-        IF ( val < athresh(i) )  THEN
-            ind = i - 1
-            RETURN
-        ENDIF
-    ENDDO
-    ind = UBOUND( athresh, 1 )
-
- END FUNCTION searchsorted
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> For given coordinates, calculates indices within a global 3D (or 2D if nlayers=1) field, e.g. an
-!> MPI one-sided window or an array which has been created using e.g. MPI_AllGather.
-!--------------------------------------------------------------------------------------------------!
- PURE SUBROUTINE radiation_calc_global_offset( i, j, k, nlayers, iproc, offs_proc, offs_glob )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  i        !< x-coordinate
-    INTEGER(iwp), INTENT(IN) ::  j        !< y-coordinate
-    INTEGER(iwp), INTENT(IN) ::  k        !< z-coordinate
-    INTEGER(iwp), INTENT(IN) ::  nlayers  !< number of z-layers
-
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  iproc  !< MPI process rank
-
-#if defined( __parallel )
-    INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(OUT), OPTIONAL ::  offs_proc  !< offset within MPI proc
-#else
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  offs_proc  !(actually unused without __parallel)
-#endif
-
-    INTEGER(iwp) ::  ipx          !< process index in x-direction
-    INTEGER(iwp) ::  ipy          !< process index in y-direction
-    INTEGER(iwp) ::  iproc_l      !< local variable for iproc
-    INTEGER(iwp) ::  oproc_l      !< local variable for offs_proc
-    INTEGER(iwp) ::  offs_pstart  !< global start of the MPI process
-
-    INTEGER(iwp), INTENT(OUT), OPTIONAL ::  offs_glob  !< global offset
-
-    ipx = i / nnx
-    ipy = j / nny
-    iproc_l = ipx * pdims(2) + ipy
-    IF ( PRESENT( iproc ) )  iproc = iproc_l
-
-    IF ( PRESENT( offs_proc )  .OR.  PRESENT( offs_glob ) )  THEN
-       oproc_l = ( i - ipx * nnx ) * nny * nlayers + &  ! Columns before
-                 ( j - ipy * nny ) * nlayers       + &  ! Rows in column
-                 k
-       IF ( PRESENT( offs_proc ) )  offs_proc = oproc_l
-       IF ( PRESENT( offs_glob ) )  THEN
-          offs_pstart = iproc_l * nnx * nny * nlayers
-          offs_glob = offs_pstart + oproc_l
-       ENDIF
-    ENDIF
-
- END SUBROUTINE radiation_calc_global_offset
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Performs MPI alltoall exchange for integer and floating-point data, optionally splitting the
-!> exchange to multiple iterations with maximum number of items per iteration.
-!--------------------------------------------------------------------------------------------------!
-#if defined( __parallel )
- SUBROUTINE radiation_exchange_alltoall( ntosend, npint, npfloat, isendbuf, fsendbuf, nrecv,       &
-                                         irecvbuf, frecvbuf )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i, j      !< iterators
-    INTEGER(iwp) ::  iproc     !< process iterator
-    INTEGER(iwp) ::  iter      !< current iteration
-    INTEGER(iwp) ::  niters    !< local number of iterations needed
-    INTEGER(iwp) ::  nitersg   !< global no. of iterations needed
-    INTEGER(iwp) ::  nmaxsend  !< max no. of records sent to each process in each iteration
-
-    INTEGER(iwp), INTENT(IN) ::  npint    !< no. of integers in a record
-    INTEGER(iwp), INTENT(IN) ::  npfloat  !< no. of floats in a record
-
-    INTEGER(iwp), INTENT(OUT) ::  nrecv  !< total no. of records received
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  drecv     !< received data displacements per proc
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  drecvnow  !< current receive displacements
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  dsend     !< sent data displacements per process
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  dsendnow  !< current send displacements
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nrecvnow  !< no. of items to receive in current iteration
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nsendnow  !< no. of items to send in current iteration
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ntorecv   !< no. of records to receive from each process
-
-    INTEGER(iwp), DIMENSION(0:), INTENT(IN) ::  isendbuf  !< send buffer with integers
-    INTEGER(iwp), DIMENSION(0:), INTENT(IN) ::  ntosend   !< number of records to send to each process
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE, INTENT(OUT) ::  irecvbuf  !< int receive buffer (will be allocated to proper size)
-
-    REAL(wp), DIMENSION(0:), INTENT(IN) ::  fsendbuf  !< send buffer with floats
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(OUT) ::  frecvbuf  !< float receive buffer
-
-
-    ALLOCATE( ntorecv(0:numprocs-1) )
-    ALLOCATE( dsend(0:numprocs) )
-    ALLOCATE( drecv(0:numprocs) )
-    ALLOCATE( dsendnow(0:numprocs-1) )
-    ALLOCATE( drecvnow(0:numprocs-1) )
-    ALLOCATE( nsendnow(0:numprocs-1) )
-    ALLOCATE( nrecvnow(0:numprocs-1) )
-!
-!-- Exchange send and receive sizes
-    CALL MPI_ALLTOALL( ntosend, 1, MPI_INTEGER, ntorecv, 1, MPI_INTEGER, comm2d, ierr )
-    IF ( ierr /= 0 )  THEN
-       WRITE( 9, * ) 'Error at MPI_ALLTOALL1:', ierr, ntosend, ntorecv
-       FLUSH( 9 )
-    ENDIF
-!
-!-- Calculate initial displacements
-    i = 0
-    j = 0
-    DO  iproc = 0, numprocs-1
-       dsend(iproc) = i
-       dsendnow(iproc) = i
-       drecv(iproc) = j
-       drecvnow(iproc) = j
-       i = i + ntosend(iproc)
-       j = j + ntorecv(iproc)
-    ENDDO
-    dsend(numprocs) = i  ! Behind last pos = sum of all to send
-    drecv(numprocs) = j  ! Behind last pos = sum of all to receive
-    nrecv = j
-!
-!-- Allocate receive buffers
-    ALLOCATE( irecvbuf(0:nrecv*npint-1) )
-    ALLOCATE( frecvbuf(0:nrecv*npfloat-1) )
-!
-!-- Determine number of iterations among all processes
-!-- (e.g. this process may have nothing to send and receive, yet some other still might)
-    IF ( bufsize_alltoall <= 0 )  THEN
-       nitersg = 1
-       nmaxsend = HUGE( nitersg )
-    ELSE
-       nmaxsend = bufsize_alltoall
-       niters = ( MAXVAL( ntosend(:) ) + nmaxsend - 1 ) / nmaxsend
-       CALL MPI_ALLREDUCE( niters, nitersg, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
-       IF ( nitersg > 1 )  THEN
-          WRITE( debug_string, '("The MPI_ALLTOALL call has been split to ",I8," iterations ' //   &
-                               'of max. ",I12," records each.")' ) nitersg, bufsize_alltoall
-          CALL debug_message( debug_string, 'info' )
-       ENDIF
-    ENDIF
-!
-!-- Iterate alltoall using max-sized buffers
-    DO  iter = 1, nitersg
-       nsendnow(:) = MIN( dsend(1:) - dsendnow(:), nmaxsend )
-       nrecvnow(:) = MIN( drecv(1:) - drecvnow(:), nmaxsend )
-!
-!--    Send integer data
-       CALL MPI_ALLTOALLV( isendbuf, nsendnow(:) * npint, dsendnow(:) * npint, MPI_INTEGER,        &
-                          irecvbuf, nrecvnow(:) * npint, drecvnow(:) * npint, MPI_INTEGER,         &
-                          comm2d, ierr )
-
-       IF ( ierr /= 0 )  THEN
-          WRITE( 9, * ) 'Error at MPI_ALLTOALLV 1:', ierr, iter, nmaxsend, dsend, dsendnow,        &
-                                                     nsendnow, drecv, drecvnow, nrecvnow
-          FLUSH( 9 )
-       ENDIF
-!
-!--    Send floating point data
-       CALL MPI_ALLTOALLV( fsendbuf, nsendnow(:) * npfloat, dsendnow(:) * npfloat, MPI_REAL,       &
-                           frecvbuf, nrecvnow(:) * npfloat, drecvnow(:) * npfloat, MPI_REAL,       &
-                           comm2d, ierr )
-
-       IF ( ierr /= 0 )  THEN
-          WRITE( 9, * ) 'Error at MPI_ALLTOALLV 2:', ierr, iter, nmaxsend, dsend, dsendnow,        &
-                                                     nsendnow, drecv, drecvnow, nrecvnow
-          FLUSH( 9 )
-       ENDIF
-!
-!--    Shift displacements for next iteration
-       dsendnow(:) = dsendnow(:) + nsendnow(:)
-       drecvnow(:) = drecvnow(:) + nrecvnow(:)
-    ENDDO
-
-    DEALLOCATE( ntorecv, dsend, drecv, dsendnow, drecvnow, nsendnow, nrecvnow )
-
- END SUBROUTINE radiation_exchange_alltoall
-#endif
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine for averaging 3D data
-!--------------------------------------------------------------------------------------------------!
-SUBROUTINE radiation_3d_data_averaging( mode, variable )
-
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  variable  !<
-    CHARACTER(LEN=*) ::  mode      !<
-
-    CHARACTER(LEN=varnamelength) ::  var  !<
-
-    INTEGER(iwp) ::  i                   !<
-    INTEGER(iwp) ::  imrt                !< index of MRT
-    INTEGER(iwp) ::  j                   !<
-    INTEGER(iwp) ::  k                   !<
-    INTEGER(iwp) ::  l, m                !< index of current surface element
-    INTEGER(iwp) ::  ids, idsint, isurf  !<
-
-    LOGICAL ::  match_lsm  !< flag indicating natural-type surface
-    LOGICAL ::  match_usm  !< flag indicating urban-type surface
-
-!
-!-- Find the real name of the variable
-    ids = -1
-    l = -1
-    var = TRIM( variable )
-    DO  i = 0, nd-1
-       k = LEN( TRIM( var ) )
-       j = LEN( TRIM( dirname(i) ) )
-       IF ( k - j + 1 >= 1_iwp )  THEN
-          IF ( TRIM( var(k-j+1:k) ) == TRIM( dirname(i) ) )  THEN
-              ids = i
-              idsint = dirint(ids)
-              var = var(:k-j)
-              EXIT
-          ENDIF
-       ENDIF
-    ENDDO
-    IF ( ids == -1 )  THEN
-        var = TRIM( variable )
-    ENDIF
-
-    IF ( mode == 'allocate' )  THEN
-
-       SELECT CASE ( TRIM( var ) )
-!
-!--          Block of large scale (e.g. RRTMG) radiation output variables
-             CASE ( 'rad_net*' )
-                IF ( .NOT. ALLOCATED( rad_net_av ) )  THEN
-                   ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_net_av = 0.0_wp
-
-             CASE ( 'rad_lw_in*' )
-                IF ( .NOT. ALLOCATED( rad_lw_in_xy_av ) )  THEN
-                   ALLOCATE( rad_lw_in_xy_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_lw_in_xy_av = 0.0_wp
-
-             CASE ( 'rad_lw_out*' )
-                IF ( .NOT. ALLOCATED( rad_lw_out_xy_av ) )  THEN
-                   ALLOCATE( rad_lw_out_xy_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_lw_out_xy_av = 0.0_wp
-
-             CASE ( 'rad_sw_in*' )
-                IF ( .NOT. ALLOCATED( rad_sw_in_xy_av ) )  THEN
-                   ALLOCATE( rad_sw_in_xy_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_sw_in_xy_av = 0.0_wp
-
-             CASE ( 'rad_sw_out*' )
-                IF ( .NOT. ALLOCATED( rad_sw_out_xy_av ) )  THEN
-                   ALLOCATE( rad_sw_out_xy_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_sw_out_xy_av = 0.0_wp
-
-             CASE ( 'rad_lw_in' )
-                IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
-                   ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_lw_in_av = 0.0_wp
-
-             CASE ( 'rad_lw_out' )
-                IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
-                   ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_lw_out_av = 0.0_wp
-
-             CASE ( 'rad_lw_cs_hr' )
-                IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) )  THEN
-                   ALLOCATE( rad_lw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_lw_cs_hr_av = 0.0_wp
-
-             CASE ( 'rad_lw_hr' )
-                IF ( .NOT. ALLOCATED( rad_lw_hr_av ) )  THEN
-                   ALLOCATE( rad_lw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_lw_hr_av = 0.0_wp
-
-             CASE ( 'rad_sw_in' )
-                IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
-                   ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_sw_in_av = 0.0_wp
-
-             CASE ( 'rad_sw_out' )
-                IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
-                   ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_sw_out_av = 0.0_wp
-
-             CASE ( 'rad_sw_cs_hr' )
-                IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) )  THEN
-                   ALLOCATE( rad_sw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_sw_cs_hr_av = 0.0_wp
-
-             CASE ( 'rad_sw_hr' )
-                IF ( .NOT. ALLOCATED( rad_sw_hr_av ) )  THEN
-                   ALLOCATE( rad_sw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                rad_sw_hr_av = 0.0_wp
-!
-!--          Block of RTM output variables
-             CASE ( 'rtm_rad_net' )
-!
-!--              Array of complete radiation balance
-                 IF ( .NOT.  ALLOCATED( surfradnet_av ) )  THEN
-                     ALLOCATE( surfradnet_av(nsurfl) )
-                 ENDIF
-                 surfradnet_av = 0.0_wp
-
-             CASE ( 'rtm_rad_insw' )
-!
-!--              Array of sw radiation falling to surface after i-th reflection
-                 IF ( .NOT.  ALLOCATED( surfinsw_av ) )  THEN
-                     ALLOCATE( surfinsw_av(nsurfl) )
-                 ENDIF
-                 surfinsw_av = 0.0_wp
-
-             CASE ( 'rtm_rad_inlw' )
-!
-!--              Array of lw radiation falling to surface after i-th reflection
-                 IF ( .NOT.  ALLOCATED( surfinlw_av ) )  THEN
-                     ALLOCATE( surfinlw_av(nsurfl) )
-                 ENDIF
-                 surfinlw_av = 0.0_wp
-
-             CASE ( 'rtm_rad_inswdir' )
-!
-!--              Array of direct sw radiation falling to surface from sun
-                 IF ( .NOT.  ALLOCATED( surfinswdir_av ) )  THEN
-                     ALLOCATE( surfinswdir_av(nsurfl) )
-                 ENDIF
-                 surfinswdir_av = 0.0_wp
-
-             CASE ( 'rtm_rad_inswdif' )
-!
-!--              Array of difusion sw radiation falling to surface from sky and borders of the domain
-                 IF ( .NOT.  ALLOCATED( surfinswdif_av ) )  THEN
-                     ALLOCATE( surfinswdif_av(nsurfl) )
-                 ENDIF
-                 surfinswdif_av = 0.0_wp
-
-             CASE ( 'rtm_rad_inswref' )
-!
-!--              Array of sw radiation falling to surface from reflections
-                 IF ( .NOT.  ALLOCATED( surfinswref_av ) )  THEN
-                     ALLOCATE( surfinswref_av(nsurfl) )
-                 ENDIF
-                 surfinswref_av = 0.0_wp
-
-             CASE ( 'rtm_rad_inlwdif' )
-!
-!--             Array of sw radiation falling to surface after i-th reflection
-                IF ( .NOT.  ALLOCATED( surfinlwdif_av ) )  THEN
-                     ALLOCATE( surfinlwdif_av(nsurfl) )
-                 ENDIF
-                 surfinlwdif_av = 0.0_wp
-
-             CASE ( 'rtm_rad_inlwref' )
-!
-!--              Array of lw radiation falling to surface from reflections
-                 IF ( .NOT.  ALLOCATED( surfinlwref_av ) )  THEN
-                     ALLOCATE( surfinlwref_av(nsurfl) )
-                 ENDIF
-                 surfinlwref_av = 0.0_wp
-
-             CASE ( 'rtm_rad_outsw' )
-!
-!--              Array of sw radiation emitted from surface after i-th reflection
-                 IF ( .NOT.  ALLOCATED( surfoutsw_av ) )  THEN
-                     ALLOCATE( surfoutsw_av(nsurfl) )
-                 ENDIF
-                 surfoutsw_av = 0.0_wp
-
-             CASE ( 'rtm_rad_outlw' )
-!
-!--              Array of lw radiation emitted from surface after i-th reflection
-                 IF ( .NOT.  ALLOCATED( surfoutlw_av ) )  THEN
-                     ALLOCATE( surfoutlw_av(nsurfl) )
-                     surfoutlw_av = 0.0_wp
-                 ENDIF
-             CASE ( 'rtm_rad_ressw' )
-!
-!--              Array of residua of sw radiation absorbed in surface after last reflection
-                 IF ( .NOT.  ALLOCATED( surfins_av ) )  THEN
-                     ALLOCATE( surfins_av(nsurfl) )
-                 ENDIF
-                 surfins_av = 0.0_wp
-
-             CASE ( 'rtm_rad_reslw' )
-!
-!--              Array of residua of lw radiation absorbed in surface after last reflection
-                 IF ( .NOT.  ALLOCATED( surfinl_av ) )  THEN
-                     ALLOCATE( surfinl_av(nsurfl) )
-                 ENDIF
-                 surfinl_av = 0.0_wp
-
-             CASE ( 'rtm_rad_pc_inlw' )
-!
-!--              Array of of lw radiation absorbed in plant canopy
-                 IF ( .NOT.  ALLOCATED( pcbinlw_av ) )  THEN
-                     ALLOCATE( pcbinlw_av(1:npcbl) )
-                     pcbinlw_av = 0.0_wp
-                 ENDIF
-
-             CASE ( 'rtm_rad_pc_insw' )
-!
-!--              Array of of sw radiation absorbed in plant canopy
-                 IF ( .NOT.  ALLOCATED( pcbinsw_av ) )  THEN
-                     ALLOCATE( pcbinsw_av(1:npcbl) )
-                 ENDIF
-                 pcbinsw_av = 0.0_wp
-
-             CASE ( 'rtm_rad_pc_inswdir' )
-!
-!--              Array of of direct sw radiation absorbed in plant canopy
-                 IF ( .NOT.  ALLOCATED( pcbinswdir_av ) )  THEN
-                     ALLOCATE( pcbinswdir_av(1:npcbl) )
-                 ENDIF
-                 pcbinswdir_av = 0.0_wp
-
-             CASE ( 'rtm_rad_pc_inswdif' )
-!
-!--              Array of of diffuse sw radiation absorbed in plant canopy
-                 IF ( .NOT.  ALLOCATED( pcbinswdif_av ) )  THEN
-                     ALLOCATE( pcbinswdif_av(1:npcbl) )
-                 ENDIF
-                 pcbinswdif_av = 0.0_wp
-
-             CASE ( 'rtm_rad_pc_inswref' )
-!
-!--              Array of of reflected sw radiation absorbed in plant canopy
-                 IF ( .NOT.  ALLOCATED( pcbinswref_av ) )  THEN
-                     ALLOCATE( pcbinswref_av(1:npcbl) )
-                 ENDIF
-                 pcbinswref_av = 0.0_wp
-
-             CASE ( 'rtm_mrt_sw' )
-                IF ( .NOT. ALLOCATED( mrtinsw_av ) )  THEN
-                   ALLOCATE( mrtinsw_av(nmrtbl) )
-                ENDIF
-                mrtinsw_av = 0.0_wp
-
-             CASE ( 'rtm_mrt_lw' )
-                IF ( .NOT. ALLOCATED( mrtinlw_av ) )  THEN
-                   ALLOCATE( mrtinlw_av(nmrtbl) )
-                ENDIF
-                mrtinlw_av = 0.0_wp
-
-             CASE ( 'rtm_mrt' )
-                IF ( .NOT. ALLOCATED( mrt_av ) )  THEN
-                   ALLOCATE( mrt_av(nmrtbl) )
-                ENDIF
-                mrt_av = 0.0_wp
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'sum' )  THEN
-
-       SELECT CASE ( TRIM( var ) )
-!
-!--       Block of large scale (e.g. RRTMG) radiation output variables only upward faced horizontal
-!--       surfaces are considered here
-          CASE ( 'rad_net*' )
-             IF ( ALLOCATED( rad_net_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                     IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         rad_net_av(j,i) = rad_net_av(j,i) + surf_lsm_h(0)%rad_net(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         rad_net_av(j,i) = rad_net_av(j,i) +                                       &
-                                         surf_usm_h(0)%rad_net(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_in*' )
-             IF ( ALLOCATED( rad_lw_in_xy_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i) + surf_lsm_h(0)%rad_lw_in(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i) + surf_usm_h(0)%rad_lw_in(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_out*' )
-             IF ( ALLOCATED( rad_lw_out_xy_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i) + surf_lsm_h(0)%rad_lw_out(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i) + surf_usm_h(0)%rad_lw_out(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_in*' )
-             IF ( ALLOCATED( rad_sw_in_xy_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i) + surf_lsm_h(0)%rad_sw_in(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i) + surf_usm_h(0)%rad_sw_in(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_out*' )
-             IF ( ALLOCATED( rad_sw_out_xy_av ) )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_lsm  .AND.  .NOT.  match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i) + surf_lsm_h(0)%rad_sw_out(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i) + surf_usm_h(0)%rad_sw_out(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_in' )
-             IF ( ALLOCATED( rad_lw_in_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i) + rad_lw_in(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_out' )
-             IF ( ALLOCATED( rad_lw_out_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i) + rad_lw_out(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_cs_hr' )
-             IF ( ALLOCATED( rad_lw_cs_hr_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_lw_cs_hr_av(k,j,i) = rad_lw_cs_hr_av(k,j,i) + rad_lw_cs_hr(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_hr' )
-             IF ( ALLOCATED( rad_lw_hr_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_lw_hr_av(k,j,i) = rad_lw_hr_av(k,j,i) + rad_lw_hr(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_in' )
-             IF ( ALLOCATED( rad_sw_in_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i) + rad_sw_in(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_out' )
-             IF ( ALLOCATED( rad_sw_out_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i) + rad_sw_out(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_cs_hr' )
-             IF ( ALLOCATED( rad_sw_cs_hr_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_sw_cs_hr_av(k,j,i) = rad_sw_cs_hr_av(k,j,i) + rad_sw_cs_hr(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_hr' )
-             IF ( ALLOCATED( rad_sw_hr_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_sw_hr_av(k,j,i) = rad_sw_hr_av(k,j,i) + rad_sw_hr(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-!
-!--       Block of RTM output variables
-          CASE ( 'rtm_rad_net' )
-!
-!--           Array of complete radiation balance
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                    surfradnet_av(isurf) = surfradnet_av(isurf) + surfinsw(isurf) -                &
-                                           surfoutsw(isurf) + surfinlw(isurf) - surfoutlw(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_insw' )
-!
-!--           Array of sw radiation falling to surface after i-th reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinsw_av(isurf) = surfinsw_av(isurf) + surfinsw(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inlw' )
-!
-!--           Array of lw radiation falling to surface after i-th reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinlw_av(isurf) = surfinlw_av(isurf) + surfinlw(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inswdir' )
-!
-!--           Array of direct sw radiation falling to surface from sun
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinswdir_av(isurf) = surfinswdir_av(isurf) + surfinswdir(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inswdif' )
-!
-!--           Array of diffusion sw radiation falling to surface from sky and borders of the domain
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinswdif_av(isurf) = surfinswdif_av(isurf) + surfinswdif(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inswref' )
-!
-!--           Array of sw radiation falling to surface from reflections
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinswref_av(isurf) = surfinswref_av(isurf) + surfinsw(isurf) -             &
-                                             surfinswdir(isurf) - surfinswdif(isurf)
-                 ENDIF
-              ENDDO
-
-
-          CASE ( 'rtm_rad_inlwdif' )
-!
-!--           Array of sw radiation falling to surface after i-th reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinlwdif_av(isurf) = surfinlwdif_av(isurf) + surfinlwdif(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inlwref' )
-!
-!--           Array of lw radiation falling to surface from reflections
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinlwref_av(isurf) = surfinlwref_av(isurf) +                               &
-                                             surfinlw(isurf) - surfinlwdif(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_outsw' )
-!
-!--           Array of sw radiation emitted from surface after i-th reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfoutsw_av(isurf) = surfoutsw_av(isurf) + surfoutsw(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_outlw' )
-!
-!--           Array of lw radiation emitted from surface after i-th reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfoutlw_av(isurf) = surfoutlw_av(isurf) + surfoutlw(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_ressw' )
-!
-!--           Array of residua of sw radiation absorbed in surface after last reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfins_av(isurf) = surfins_av(isurf) + surfins(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_reslw' )
-!
-!--           Array of residua of lw radiation absorbed in surface after last reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinl_av(isurf) = surfinl_av(isurf) + surfinl(isurf)
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_pc_inlw' )
-              DO  l = 1, npcbl
-                 pcbinlw_av(l) = pcbinlw_av(l) + pcbinlw(l)
-              ENDDO
-
-          CASE ( 'rtm_rad_pc_insw' )
-              DO  l = 1, npcbl
-                 pcbinsw_av(l) = pcbinsw_av(l) + pcbinsw(l)
-              ENDDO
-
-          CASE ( 'rtm_rad_pc_inswdir' )
-              DO  l = 1, npcbl
-                 pcbinswdir_av(l) = pcbinswdir_av(l) + pcbinswdir(l)
-              ENDDO
-
-          CASE ( 'rtm_rad_pc_inswdif' )
-              DO  l = 1, npcbl
-                 pcbinswdif_av(l) = pcbinswdif_av(l) + pcbinswdif(l)
-              ENDDO
-
-          CASE ( 'rtm_rad_pc_inswref' )
-              DO  l = 1, npcbl
-                 pcbinswref_av(l) = pcbinswref_av(l) + pcbinsw(l) - pcbinswdir(l) - pcbinswdif(l)
-              ENDDO
-
-          CASE ( 'rtm_mrt_sw' )
-             IF ( ALLOCATED( mrtinsw_av ) )  THEN
-                mrtinsw_av(:) = mrtinsw_av(:) + mrtinsw(:)
-             ENDIF
-
-          CASE ( 'rtm_mrt_lw' )
-             IF ( ALLOCATED( mrtinlw_av ) )  THEN
-                mrtinlw_av(:) = mrtinlw_av(:) + mrtinlw(:)
-             ENDIF
-
-          CASE ( 'rtm_mrt' )
-             IF ( ALLOCATED( mrt_av ) )  THEN
-                mrt_av(:) = mrt_av(:) + mrt(:)
-             ENDIF
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'average' )  THEN
-
-       SELECT CASE ( TRIM( var ) )
-!
-!--       Block of large scale (e.g. RRTMG) radiation output variables
-          CASE ( 'rad_net*' )
-             IF ( ALLOCATED( rad_net_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      rad_net_av(j,i) = rad_net_av(j,i) / REAL( average_count_3d, KIND = wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_in*' )
-             IF ( ALLOCATED( rad_lw_in_xy_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i) /                                &
-                                             REAL( average_count_3d, KIND = wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_out*' )
-             IF ( ALLOCATED( rad_lw_out_xy_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i) /                              &
-                                              REAL( average_count_3d, KIND = wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_in*' )
-             IF ( ALLOCATED( rad_sw_in_xy_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i) /                                &
-                                             REAL( average_count_3d, KIND = wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_out*' )
-             IF ( ALLOCATED( rad_sw_out_xy_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i) /                              &
-                                              REAL( average_count_3d, KIND = wp )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_in' )
-             IF ( ALLOCATED( rad_lw_in_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i) /                               &
-                                               REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_out' )
-             IF ( ALLOCATED( rad_lw_out_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i) /                             &
-                                                REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_cs_hr' )
-             IF ( ALLOCATED( rad_lw_cs_hr_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_lw_cs_hr_av(k,j,i) = rad_lw_cs_hr_av(k,j,i) /                         &
-                                                  REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_lw_hr' )
-             IF ( ALLOCATED( rad_lw_hr_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_lw_hr_av(k,j,i) = rad_lw_hr_av(k,j,i) /                               &
-                                               REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_in' )
-             IF ( ALLOCATED( rad_sw_in_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i) /                               &
-                                               REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_out' )
-             IF ( ALLOCATED( rad_sw_out_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i) /                             &
-                                                REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_cs_hr' )
-             IF ( ALLOCATED( rad_sw_cs_hr_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_sw_cs_hr_av(k,j,i) = rad_sw_cs_hr_av(k,j,i) /                         &
-                                                  REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'rad_sw_hr' )
-             IF ( ALLOCATED( rad_sw_hr_av ) )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         rad_sw_hr_av(k,j,i) = rad_sw_hr_av(k,j,i) /                               &
-                                               REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-!
-!--       Block of RTM output variables
-          CASE ( 'rtm_rad_net' )
-!
-!--           Array of complete radiation balance
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfradnet_av(isurf) = surfradnet_av(isurf) /                                 &
-                                            REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_insw' )
-!
-!--           Array of sw radiation falling to surface after i-th reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinsw_av(isurf) = surfinsw_av(isurf) / REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inlw' )
-!
-!--           Array of lw radiation falling to surface after i-th reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinlw_av(isurf) = surfinlw_av(isurf) / REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inswdir' )
-!
-!--           Array of direct sw radiation falling to surface from sun
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinswdir_av(isurf) = surfinswdir_av(isurf) /                               &
-                                             REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inswdif' )
-!
-!--           Array of diffusion sw radiation falling to surface from sky and borders of the domain
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinswdif_av(isurf) = surfinswdif_av(isurf) /                               &
-                                             REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inswref' )
-!
-!--           Array of sw radiation falling to surface from reflections
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinswref_av(isurf) = surfinswref_av(isurf) /                               &
-                                             REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inlwdif' )
-!
-!--           Array of sw radiation falling to surface after i-th reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinlwdif_av(isurf) = surfinlwdif_av(isurf) /                               &
-                                             REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_inlwref' )
-!
-!--           Array of lw radiation falling to surface from reflections
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinlwref_av(isurf) = surfinlwref_av(isurf) /                               &
-                                             REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_outsw' )
-!
-!--           Array of sw radiation emitted from surface after i-th reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfoutsw_av(isurf) = surfoutsw_av(isurf) / REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_outlw' )
-!
-!--           Array of lw radiation emitted from surface after i-th reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfoutlw_av(isurf) = surfoutlw_av(isurf) / REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_ressw' )
-!
-!--           Array of residua of sw radiation absorbed in surface after last reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfins_av(isurf) = surfins_av(isurf) / REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_reslw' )
-!
-!--           Array of residua of lw radiation absorbed in surface after last reflection
-              DO  isurf = 1, nsurfl
-                 IF ( surfl(id,isurf) == idsint )  THEN
-                     surfinl_av(isurf) = surfinl_av(isurf) / REAL( average_count_3d, KIND = wp )
-                 ENDIF
-              ENDDO
-
-          CASE ( 'rtm_rad_pc_inlw' )
-              DO  l = 1, npcbl
-                 pcbinlw_av(l) = pcbinlw_av(l) / REAL( average_count_3d, KIND = wp )
-              ENDDO
-
-          CASE ( 'rtm_rad_pc_insw' )
-              DO  l = 1, npcbl
-                 pcbinsw_av(l) = pcbinsw_av(l) / REAL( average_count_3d, KIND = wp )
-              ENDDO
-
-          CASE ( 'rtm_rad_pc_inswdir' )
-              DO  l = 1, npcbl
-                 pcbinswdir_av(l) = pcbinswdir_av(l) / REAL( average_count_3d, KIND = wp )
-              ENDDO
-
-          CASE ( 'rtm_rad_pc_inswdif' )
-              DO  l = 1, npcbl
-                 pcbinswdif_av(l) = pcbinswdif_av(l) / REAL( average_count_3d, KIND = wp )
-              ENDDO
-
-          CASE ( 'rtm_rad_pc_inswref' )
-              DO  l = 1, npcbl
-                 pcbinswref_av(l) = pcbinswref_av(l) / REAL( average_count_3d, KIND = wp )
-              ENDDO
-
-          CASE ( 'rtm_mrt_sw' )
-             IF ( ALLOCATED( mrtinsw_av ) )  THEN
-                DO  imrt = 1, nmrtbl
-                   mrtinsw_av(imrt) = mrtinsw_av(imrt) / REAL( average_count_3d, KIND = wp )
-                ENDDO
-             ENDIF
-
-          CASE ( 'rtm_mrt_lw' )
-             IF (  ALLOCATED( mrtinlw_av ) )  THEN
-                DO imrt = 1, nmrtbl
-                   mrtinlw_av(imrt) = mrtinlw_av(imrt) / REAL( average_count_3d, KIND = wp )
-                ENDDO
-             ENDIF
-
-          CASE ( 'rtm_mrt' )
-             IF ( ALLOCATED( mrt_av ) )  THEN
-                DO  imrt = 1, nmrtbl
-                   mrt_av(imrt) = mrt_av(imrt) / REAL( average_count_3d, KIND = wp )
-                ENDDO
-             ENDIF
-
-       END SELECT
-
-    ENDIF
-
-END SUBROUTINE radiation_3d_data_averaging
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining appropriate grid for netcdf variables.
-!> It is called out from subroutine netcdf.
-!--------------------------------------------------------------------------------------------------!
-SUBROUTINE radiation_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  variable  !<
-
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_x  !<
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_y  !<
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_z  !<
-
-    CHARACTER(LEN=varnamelength) ::  var  !<
-
-    LOGICAL, INTENT(OUT) ::  found  !<
-
-    found  = .TRUE.
-
-!
-!-- Check for the grid
-    var = TRIM( variable )
-!
-!-- RTM directional variables
-    IF ( var(1:12) == 'rtm_rad_net_'      .OR.  var(1:13) == 'rtm_rad_insw_'     .OR.              &
-         var(1:13) == 'rtm_rad_inlw_'     .OR.  var(1:16) == 'rtm_rad_inswdir_'  .OR.              &
-         var(1:16) == 'rtm_rad_inswdif_'  .OR.  var(1:16) == 'rtm_rad_inswref_'  .OR.              &
-         var(1:16) == 'rtm_rad_inlwdif_'  .OR.  var(1:16) == 'rtm_rad_inlwref_'  .OR.              &
-         var(1:14) == 'rtm_rad_outsw_'    .OR.  var(1:14) == 'rtm_rad_outlw_'    .OR.              &
-         var(1:14) == 'rtm_rad_ressw_'    .OR.  var(1:14) == 'rtm_rad_reslw_'    .OR.              &
-         var == 'rtm_rad_pc_inlw'         .OR.  var == 'rtm_rad_pc_insw'         .OR.              &
-         var == 'rtm_rad_pc_inswdir'      .OR.  var == 'rtm_rad_pc_inswdif'      .OR.              &
-         var == 'rtm_rad_pc_inswref'      .OR.  var(1:7) == 'rtm_svf'            .OR.              &
-         var(1:7) == 'rtm_dif'            .OR.  var(1:9) == 'rtm_skyvf'          .OR.              &
-         var(1:10) == 'rtm_skyvft'        .OR.  var(1:12) == 'rtm_surfalb_'      .OR.              &
-         var(1:13) == 'rtm_surfemis_'     .OR.  var == 'rtm_mrt'                 .OR.              &
-         var ==  'rtm_mrt_sw'             .OR.  var == 'rtm_mrt_lw' )  THEN
-
-         found = .TRUE.
-         grid_x = 'x'
-         grid_y = 'y'
-         grid_z = 'zu'
-    ELSE
-
-       SELECT CASE ( TRIM( var ) )
-
-          CASE ( 'rad_lw_cs_hr', 'rad_lw_hr', 'rad_sw_cs_hr', 'rad_sw_hr', 'rad_lw_cs_hr_xy',      &
-                 'rad_lw_hr_xy', 'rad_sw_cs_hr_xy', 'rad_sw_hr_xy', 'rad_lw_cs_hr_xz',             &
-                 'rad_lw_hr_xz', 'rad_sw_cs_hr_xz', 'rad_sw_hr_xz', 'rad_lw_cs_hr_yz',             &
-                 'rad_lw_hr_yz', 'rad_sw_cs_hr_yz', 'rad_sw_hr_yz' )
-             grid_x = 'x'
-             grid_y = 'y'
-             grid_z = 'zu'
-
-          CASE ( 'rad_lw_in', 'rad_lw_out', 'rad_sw_in', 'rad_sw_out', 'rad_lw_in_xy',             &
-                 'rad_lw_out_xy', 'rad_sw_in_xy','rad_sw_out_xy','rad_lw_in_xz','rad_lw_out_xz',   &
-                 'rad_sw_in_xz','rad_sw_out_xz', 'rad_lw_in_yz', 'rad_lw_out_yz', 'rad_sw_in_yz',  &
-                 'rad_sw_out_yz' )
-             grid_x = 'x'
-             grid_y = 'y'
-             grid_z = 'zw'
-
-
-          CASE DEFAULT
-             found  = .FALSE.
-             grid_x = 'none'
-             grid_y = 'none'
-             grid_z = 'none'
-
-           END SELECT
-       ENDIF
-
- END SUBROUTINE radiation_define_netcdf_grid
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 2D output variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do,    &
-                                      nzt_do, fill_value )
-
-    USE indices
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  grid      !<
-    CHARACTER(LEN=*) ::  mode      !<
-    CHARACTER(LEN=*) ::  variable  !<
-
-    INTEGER(iwp) ::  av      !<
-    INTEGER(iwp) ::  i       !<
-    INTEGER(iwp) ::  j       !<
-    INTEGER(iwp) ::  k       !<
-    INTEGER(iwp) ::  m       !< index of surface element at grid point (j,i)
-    INTEGER(iwp) ::  nzb_do  !<
-    INTEGER(iwp) ::  nzt_do  !<
-
-    LOGICAL ::  found  !<
-    LOGICAL ::  two_d  !< flag parameter that indicates 2D variables (horizontal cross sections)
-
-    REAL(wp) ::  fill_value  !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !<
-
-    found = .TRUE.
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'rad_net*_xy' )  ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-!
-!--                Obtain rad_net from its respective surface type
-!--                Only upward faced horizontal outputs are considered here
-!--                Natural-type surfaces
-                   DO  m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%rad_net(m)
-                   ENDDO
-!
-!--                Urban-type surfaces
-                   DO  m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%rad_net(m)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( rad_net_av ) )  THEN
-                ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) )
-                rad_net_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = rad_net_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'rad_lw_in*_xy' )  ! 2d-array
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-!
-!--                Obtain rad_net from its respective surface type
-!--                Natural-type surfaces
-                   DO  m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%rad_lw_in(m)
-                   ENDDO
-!
-!--                Urban-type surfaces
-                   DO  m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%rad_lw_in(m)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( rad_lw_in_xy_av ) )  THEN
-                ALLOCATE( rad_lw_in_xy_av(nysg:nyng,nxlg:nxrg) )
-                rad_lw_in_xy_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = rad_lw_in_xy_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'rad_lw_out*_xy' )  ! 2d-array
-          IF ( av == 0 ) THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-!
-!--                Obtain rad_net from its respective surface type
-!--                Natural-type surfaces
-                   DO  m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%rad_lw_out(m)
-                   ENDDO
-!
-!--                Urban-type surfaces
-                   DO  m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%rad_lw_out(m)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( rad_lw_out_xy_av ) )  THEN
-                ALLOCATE( rad_lw_out_xy_av(nysg:nyng,nxlg:nxrg) )
-                rad_lw_out_xy_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = rad_lw_out_xy_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'rad_sw_in*_xy' )  ! 2d-array
-          IF ( av == 0 ) THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-!
-!--                Obtain rad_net from its respective surface type
-!--                Natural-type surfaces
-                   DO  m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%rad_sw_in(m)
-                   ENDDO
-!
-!--                Urban-type surfaces
-                   DO  m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%rad_sw_in(m)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( rad_sw_in_xy_av ) )  THEN
-                ALLOCATE( rad_sw_in_xy_av(nysg:nyng,nxlg:nxrg) )
-                rad_sw_in_xy_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = rad_sw_in_xy_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'rad_sw_out*_xy' )  ! 2d-array
-          IF ( av == 0 ) THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-!
-!--                Obtain rad_net from its respective surface type
-!--                Natural-type surfaces
-                   DO  m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                      local_pf(i,j,nzb+1) = surf_lsm_h(0)%rad_sw_out(m)
-                   ENDDO
-!
-!--                Urban-type surfaces
-                   DO  m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                      local_pf(i,j,nzb+1) = surf_usm_h(0)%rad_sw_out(m)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( rad_sw_out_xy_av ) )  THEN
-                ALLOCATE( rad_sw_out_xy_av(nysg:nyng,nxlg:nxrg) )
-                rad_sw_out_xy_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = rad_sw_out_xy_av(j,i)
-                ENDDO
-             ENDDO
-          ENDIF
-          two_d = .TRUE.
-          grid = 'zu1'
-
-       CASE ( 'rad_lw_in_xy', 'rad_lw_in_xz', 'rad_lw_in_yz' )
-          IF ( av == 0 ) THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( rad_lw_in(k,j,i), fill_value,                       &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
-               ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_lw_in_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = rad_lw_in_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE ( 'rad_lw_out_xy', 'rad_lw_out_xz', 'rad_lw_out_yz' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( rad_lw_out(k,j,i), fill_value,                      &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
-               ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_lw_out_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = rad_lw_out_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE ( 'rad_lw_cs_hr_xy', 'rad_lw_cs_hr_xz', 'rad_lw_cs_hr_yz' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( rad_lw_cs_hr(k,j,i), fill_value,                    &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) )  THEN
-               ALLOCATE( rad_lw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_lw_cs_hr_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = rad_lw_cs_hr_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( mode == 'xy' )  grid = 'zw'
-
-       CASE ( 'rad_lw_hr_xy', 'rad_lw_hr_xz', 'rad_lw_hr_yz' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( rad_lw_hr(k,j,i), fill_value,                       &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( rad_lw_hr_av ) )  THEN
-               ALLOCATE( rad_lw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_lw_hr_av= REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = rad_lw_hr_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( mode == 'xy' )  grid = 'zw'
-
-       CASE ( 'rad_sw_in_xy', 'rad_sw_in_xz', 'rad_sw_in_yz' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( rad_sw_in(k,j,i), fill_value,                       &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
-               ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_sw_in_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = rad_sw_in_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE ( 'rad_sw_out_xy', 'rad_sw_out_xz', 'rad_sw_out_yz' )
-          IF ( av == 0 ) THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( rad_sw_out(k,j,i), fill_value,                      &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
-               ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_sw_out_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb, nzt+1
-                      local_pf(i,j,k) = rad_sw_out_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( mode == 'xy' )  grid = 'zu'
-
-       CASE ( 'rad_sw_cs_hr_xy', 'rad_sw_cs_hr_xz', 'rad_sw_cs_hr_yz' )
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( rad_sw_cs_hr(k,j,i), fill_value,                    &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) )  THEN
-               ALLOCATE( rad_sw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_sw_cs_hr_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = rad_sw_cs_hr_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( mode == 'xy' )  grid = 'zw'
-
-       CASE ( 'rad_sw_hr_xy', 'rad_sw_hr_xz', 'rad_sw_hr_yz' )
-          IF ( av == 0 ) THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( rad_sw_hr(k,j,i), fill_value,                       &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-            IF ( .NOT. ALLOCATED( rad_sw_hr_av ) )  THEN
-               ALLOCATE( rad_sw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_sw_hr_av = REAL( fill_value, KIND = wp )
-            ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = rad_sw_hr_av(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( mode == 'xy' )  grid = 'zw'
-
-       CASE DEFAULT
-          found = .FALSE.
-          grid  = 'none'
-
-    END SELECT
-
- END SUBROUTINE radiation_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 3D output variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-
-
-    USE indices
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  variable !<
-
-    CHARACTER(LEN=varnamelength) ::  var, surfid  !<
-
-    INTEGER(iwp) ::  av                                          !<
-    INTEGER(iwp) ::  i, j, k, l                                  !<
-    INTEGER(iwp) ::  nzb_do                                      !<
-    INTEGER(iwp) ::  nzt_do                                      !<
-    INTEGER(iwp) ::  ids,idsint,isurf,isvf,isurfs,isurflt,ipcgb  !<
-    INTEGER(iwp) ::  is, js, ks, istat                           !<
-
-    LOGICAL ::  found  !<
-
-    REAL(wp) ::  fill_value  !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !<
-
-
-
-
-
-    found = .TRUE.
-    var = TRIM( variable )
-!
-!-- Check if variable belongs to radiation related variables (starts with rad or rtm)
-    IF ( LEN( var ) < 3_iwp  )  THEN
-       found = .FALSE.
-       RETURN
-    ENDIF
-
-    IF ( var(1:3) /= 'rad'  .AND.  var(1:3) /= 'rtm' )  THEN
-       found = .FALSE.
-       RETURN
-    ENDIF
-
-    ids = -1
-    DO  i = 0, nd-1
-       k = LEN( TRIM( var ) )
-       j = LEN( TRIM( dirname(i) ) )
-       IF ( k - j + 1 >= 1_iwp )  THEN
-          IF ( TRIM( var(k-j+1:k) ) == TRIM( dirname(i) ) )  THEN
-             ids = i
-             idsint = dirint(ids)
-             var = var(:k-j)
-             EXIT
-          ENDIF
-       ENDIF
-    ENDDO
-    IF ( ids == -1 )  THEN
-        var = TRIM( variable )
-    ENDIF
-
-    IF ( (var(1:8) == 'rtm_svf_'  .OR.  var(1:8) == 'rtm_dif_')  .AND.  LEN( TRIM( var ) ) >= 13 ) &
-    THEN
-!
-!--     svf values to particular surface
-        surfid = var(9:)
-        i = INDEX( surfid, '_' )
-        j = INDEX( surfid(i+1:), '_' )
-        READ( surfid(1:i-1), *, IOSTAT = istat ) is
-        IF ( istat == 0 )  THEN
-            READ( surfid(i+1:i+j-1), *, IOSTAT = istat ) js
-        ENDIF
-        IF ( istat == 0 )  THEN
-            READ( surfid(i+j+1:), *, IOSTAT = istat ) ks
-        ENDIF
-        IF ( istat == 0 )  THEN
-            var = var(1:7)
-        ENDIF
-    ENDIF
-
-    local_pf = fill_value
-
-    SELECT CASE ( TRIM( var ) )
-!
-!--   Block of large scale radiation model (e.g. RRTMG) output variables
-      CASE ( 'rad_sw_in' )
-         IF ( av == 0 )  THEN
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = MERGE( rad_sw_in(k,j,i), fill_value,                        &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                  ENDDO
-               ENDDO
-            ENDDO
-         ELSE
-            IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
-               ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_sw_in_av = REAL( fill_value, KIND = wp )
-            ENDIF
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = rad_sw_in_av(k,j,i)
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-
-      CASE ( 'rad_sw_out' )
-         IF ( av == 0 )  THEN
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = MERGE( rad_sw_out(k,j,i), fill_value,                       &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                  ENDDO
-               ENDDO
-            ENDDO
-         ELSE
-            IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
-               ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_sw_out_av = REAL( fill_value, KIND = wp )
-            ENDIF
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = rad_sw_out_av(k,j,i)
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-
-      CASE ( 'rad_sw_cs_hr' )
-         IF ( av == 0 )  THEN
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = MERGE( rad_sw_cs_hr(k,j,i), fill_value,                     &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                  ENDDO
-               ENDDO
-            ENDDO
-         ELSE
-            IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) )  THEN
-               ALLOCATE( rad_sw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_sw_cs_hr_av = REAL( fill_value, KIND = wp )
-            ENDIF
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = rad_sw_cs_hr_av(k,j,i)
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-
-      CASE ( 'rad_sw_hr' )
-         IF ( av == 0 )  THEN
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = MERGE( rad_sw_hr(k,j,i), fill_value,                        &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                  ENDDO
-               ENDDO
-            ENDDO
-         ELSE
-            IF ( .NOT. ALLOCATED( rad_sw_hr_av ) )  THEN
-               ALLOCATE( rad_sw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_sw_hr_av = REAL( fill_value, KIND = wp )
-            ENDIF
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = rad_sw_hr_av(k,j,i)
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-
-      CASE ( 'rad_lw_in' )
-         IF ( av == 0 )  THEN
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = MERGE( rad_lw_in(k,j,i), fill_value,                        &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                  ENDDO
-               ENDDO
-            ENDDO
-         ELSE
-            IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
-               ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_lw_in_av = REAL( fill_value, KIND = wp )
-            ENDIF
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = rad_lw_in_av(k,j,i)
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-
-      CASE ( 'rad_lw_out' )
-         IF ( av == 0 )  THEN
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = MERGE( rad_lw_out(k,j,i), fill_value,                       &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                  ENDDO
-               ENDDO
-            ENDDO
-         ELSE
-            IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
-               ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_lw_out_av = REAL( fill_value, KIND = wp )
-            ENDIF
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = rad_lw_out_av(k,j,i)
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-
-      CASE ( 'rad_lw_cs_hr' )
-         IF ( av == 0 )  THEN
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = MERGE( rad_lw_cs_hr(k,j,i), fill_value,                     &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                  ENDDO
-               ENDDO
-            ENDDO
-         ELSE
-            IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) )  THEN
-               ALLOCATE( rad_lw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-               rad_lw_cs_hr_av = REAL( fill_value, KIND = wp )
-            ENDIF
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = rad_lw_cs_hr_av(k,j,i)
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-
-      CASE ( 'rad_lw_hr' )
-         IF ( av == 0 )  THEN
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = MERGE( rad_lw_hr(k,j,i), fill_value,                        &
-                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                  ENDDO
-               ENDDO
-            ENDDO
-         ELSE
-            IF ( .NOT. ALLOCATED( rad_lw_hr_av ) )  THEN
-               ALLOCATE( rad_lw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
-              rad_lw_hr_av = REAL( fill_value, KIND = wp )
-            ENDIF
-            DO  i = nxl, nxr
-               DO  j = nys, nyn
-                  DO  k = nzb_do, nzt_do
-                     local_pf(i,j,k) = rad_lw_hr_av(k,j,i)
-                  ENDDO
-               ENDDO
-            ENDDO
-         ENDIF
-
-      CASE ( 'rtm_rad_net' )
-!
-!--      Array of complete radiation balance
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) =                      &
-                  surfinsw(isurf) - surfoutsw(isurf) +  surfinlw(isurf) - surfoutlw(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfradnet_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_insw' )
-!
-!--      Array of sw radiation falling to surface after i-th reflection
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinsw(isurf)
-               ELSE
-                 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinsw_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_inlw' )
-!
-!--      Array of lw radiation falling to surface after i-th reflection
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlw(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlw_av(isurf)
-               ENDIF
-             ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_inswdir' )
-!
-!--      Array of direct sw radiation falling to surface from sun
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdir(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdir_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_inswdif' )
-!
-!--      Array of difusion sw radiation falling to surface from sky and borders of the domain
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdif(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdif_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_inswref' )
-!
-!--      Array of sw radiation falling to surface from reflections
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) =                      &
-                  surfinsw(isurf) - surfinswdir(isurf) - surfinswdif(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswref_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_inlwdif' )
-!
-!--      Array of difusion lw radiation falling to surface from sky and borders of the domain
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlwdif(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlwdif_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_inlwref' )
-!
-!--      Array of lw radiation falling to surface from reflections
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlw(isurf) -    &
-                                                                              surfinlwdif(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlwref_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_outsw' )
-!
-!--      Array of sw radiation emitted from surface after i-th reflection
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutsw(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutsw_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_outlw' )
-!
-!--      Array of lw radiation emitted from surface after i-th reflection
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutlw(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutlw_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_ressw' )
-!
-!--      Average of array of residua of sw radiation absorbed in surface after last reflection
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfins(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfins_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_reslw' )
-!
-!--      Average of array of residua of lw radiation absorbed in surface after last reflection
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               IF ( av == 0 )  THEN
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinl(isurf)
-               ELSE
-                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinl_av(isurf)
-               ENDIF
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_pc_inlw' )
-!
-!--      Array of lw radiation absorbed by plant canopy
-         DO  ipcgb = 1, npcbl
-            IF ( av == 0 )  THEN
-               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinlw(ipcgb)
-            ELSE
-               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinlw_av(ipcgb)
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_pc_insw' )
-!
-!--      Array of sw radiation absorbed by plant canopy
-         DO  ipcgb = 1, npcbl
-            IF ( av == 0 )  THEN
-              local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinsw(ipcgb)
-            ELSE
-              local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinsw_av(ipcgb)
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_pc_inswdir' )
-!
-!--      Array of direct sw radiation absorbed by plant canopy
-         DO  ipcgb = 1, npcbl
-            IF ( av == 0 )  THEN
-               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdir(ipcgb)
-            ELSE
-               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdir_av(ipcgb)
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_pc_inswdif' )
-!
-!--      Array of diffuse sw radiation absorbed by plant canopy
-         DO  ipcgb = 1, npcbl
-            IF ( av == 0 )  THEN
-               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdif(ipcgb)
-            ELSE
-               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdif_av(ipcgb)
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_rad_pc_inswref' )
-!
-!--      Array of reflected sw radiation absorbed by plant canopy
-         DO  ipcgb = 1, npcbl
-            IF ( av == 0 )  THEN
-               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) =                            &
-               pcbinsw(ipcgb) - pcbinswdir(ipcgb) - pcbinswdif(ipcgb)
-            ELSE
-               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswref_av(ipcgb)
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_mrt_sw' )
-         local_pf = REAL( fill_value, KIND = wp )
-         IF ( av == 0 )  THEN
-            DO  l = 1, nmrtbl
-               local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinsw(l)
-            ENDDO
-         ELSE
-            IF ( ALLOCATED( mrtinsw_av ) )  THEN
-               DO  l = 1, nmrtbl
-                  local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinsw_av(l)
-               ENDDO
-            ENDIF
-         ENDIF
-
-      CASE ( 'rtm_mrt_lw' )
-         local_pf = REAL( fill_value, KIND = wp )
-         IF ( av == 0 )  THEN
-            DO  l = 1, nmrtbl
-               local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinlw(l)
-            ENDDO
-         ELSE
-            IF ( ALLOCATED( mrtinlw_av ) )  THEN
-               DO  l = 1, nmrtbl
-                  local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinlw_av(l)
-               ENDDO
-            ENDIF
-         ENDIF
-
-      CASE ( 'rtm_mrt' )
-         local_pf = REAL( fill_value, KIND = wp )
-         IF ( av == 0 )  THEN
-            DO  l = 1, nmrtbl
-               local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrt(l)
-            ENDDO
-         ELSE
-            IF ( ALLOCATED( mrt_av ) )  THEN
-               DO  l = 1, nmrtbl
-                  local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrt_av(l)
-               ENDDO
-            ENDIF
-         ENDIF
-!
-!--   Block of RTM output variables
-!--   Variables are intended mainly for debugging and detailed analysis purposes
-      CASE ( 'rtm_skyvf' )
-!
-!--      Sky view factor
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = skyvf(isurf)
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_skyvft' )
-!
-!--      Sky view factor
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = skyvft(isurf)
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_svf', 'rtm_dif' )
-!
-!--      Shape view factors or iradiance factors to selected surface
-         IF ( TRIM( var ) == 'rtm_svf' )  THEN
-             k = 1
-         ELSE
-             k = 2
-         ENDIF
-         DO  isvf = 1, nsvfl
-            isurflt = svfsurf(1, isvf)
-            isurfs = svfsurf(2, isvf)
-
-            IF ( surf(ix,isurfs) == is  .AND.  surf(iy,isurfs) == js  .AND. surf(iz,isurfs) == ks  &
-                 .AND.  surfl(id,isurflt) == idsint )  THEN
-!
-!--            Correct source surface
-               local_pf(surfl(ix,isurflt),surfl(iy,isurflt),surfl(iz,isurflt)) = svf(k,isvf)
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_surfalb' )
-!
-!--      Surface albedo
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = albedo_surf(isurf)
-            ENDIF
-         ENDDO
-
-      CASE ( 'rtm_surfemis' )
-!
-!--      Surface emissivity, weighted average
-         DO  isurf = 1, nsurfl
-            IF ( surfl(id,isurf) == idsint )  THEN
-               local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = emiss_surf(isurf)
-            ENDIF
-         ENDDO
-
-      CASE DEFAULT
-         found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE radiation_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining masked data output
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_data_output_mask( av, variable, found, local_pf, mid )
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  variable  !<
-
-    CHARACTER(LEN=5) ::  grid  !< flag to distinquish between staggered grids
-
-    INTEGER(iwp) ::  av              !<
-    INTEGER(iwp) ::  i               !<
-    INTEGER(iwp) ::  j               !<
-    INTEGER(iwp) ::  k               !<
-    INTEGER(iwp) ::  mid             !< masked output running index
-    INTEGER(iwp) ::  topo_top_index  !< k index of highest horizontal surface
-
-    LOGICAL ::  found     !< true if output array was found
-    LOGICAL ::  resorted  !< true if array is resorted
-
-    REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  local_pf  !<
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to array which needs to be resorted for output
-
-
-    found    = .TRUE.
-    grid     = 's'
-    resorted = .FALSE.
-
-    SELECT CASE ( TRIM( variable ) )
-
-
-       CASE ( 'rad_lw_in' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rad_lw_in
-          ELSE
-             to_be_resorted => rad_lw_in_av
-          ENDIF
-
-       CASE ( 'rad_lw_out' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rad_lw_out
-          ELSE
-             to_be_resorted => rad_lw_out_av
-          ENDIF
-
-       CASE ( 'rad_lw_cs_hr' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rad_lw_cs_hr
-          ELSE
-             to_be_resorted => rad_lw_cs_hr_av
-          ENDIF
-
-       CASE ( 'rad_lw_hr' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rad_lw_hr
-          ELSE
-             to_be_resorted => rad_lw_hr_av
-          ENDIF
-
-       CASE ( 'rad_sw_in' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rad_sw_in
-          ELSE
-             to_be_resorted => rad_sw_in_av
-          ENDIF
-
-       CASE ( 'rad_sw_out' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rad_sw_out
-          ELSE
-             to_be_resorted => rad_sw_out_av
-          ENDIF
-
-       CASE ( 'rad_sw_cs_hr' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rad_sw_cs_hr
-          ELSE
-             to_be_resorted => rad_sw_cs_hr_av
-          ENDIF
-
-       CASE ( 'rad_sw_hr' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => rad_sw_hr
-          ELSE
-             to_be_resorted => rad_sw_hr_av
-          ENDIF
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
-!
-!-- Resort the array to be output, if not done above
-    IF ( found  .AND.  .NOT. resorted )  THEN
-       IF ( .NOT. mask_surface(mid) )  THEN
-!
-!--       Default masked output
-          DO  i = 1, mask_size_l(mid,1)
-             DO  j = 1, mask_size_l(mid,2)
-                DO  k = 1, mask_size_l(mid,3)
-                   local_pf(i,j,k) =  to_be_resorted(mask_k(mid,k), mask_j(mid,j), mask_i(mid,i))
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ELSE
-!
-!--       Terrain-following masked output
-          DO  i = 1, mask_size_l(mid,1)
-             DO  j = 1, mask_size_l(mid,2)
-!
-!--             Get k index of highest horizontal surface
-                topo_top_index = topo_top_ind(mask_j(mid,j), mask_i(mid,i), 0 )
-!
-!--             Save output array
-                DO  k = 1, mask_size_l(mid,3)
-                   local_pf(i,j,k) = to_be_resorted( MIN( topo_top_index+mask_k(mid,k), nzt+1 ),   &
-                                                     mask_j(mid,j), mask_i(mid,i) )
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ENDIF
-    ENDIF
-
-
-
- END SUBROUTINE radiation_data_output_mask
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine writes local (subdomain) restart data
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_wrd_local
-
-
-    IMPLICIT NONE
-
-    REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  tmp  !< temporary array for reading from file
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       IF ( ALLOCATED( rad_net_av ) )  THEN
-          CALL wrd_write_string( 'rad_net_av' )
-          WRITE( 14 )  rad_net_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_in_xy_av ) )  THEN
-          CALL wrd_write_string( 'rad_lw_in_xy_av' )
-          WRITE( 14 )  rad_lw_in_xy_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_out_xy_av ) )  THEN
-          CALL wrd_write_string( 'rad_lw_out_xy_av' )
-          WRITE( 14 )  rad_lw_out_xy_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_in_xy_av ) )  THEN
-          CALL wrd_write_string( 'rad_sw_in_xy_av' )
-          WRITE( 14 )  rad_sw_in_xy_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_out_xy_av ) )  THEN
-          CALL wrd_write_string( 'rad_sw_out_xy_av' )
-          WRITE( 14 )  rad_sw_out_xy_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_in ) )  THEN
-          CALL wrd_write_string( 'rad_lw_in' )
-          WRITE( 14 )  rad_lw_in
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_in_av ) )  THEN
-          CALL wrd_write_string( 'rad_lw_in_av' )
-          WRITE( 14 )  rad_lw_in_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_out ) )  THEN
-          CALL wrd_write_string( 'rad_lw_out' )
-          WRITE( 14 )  rad_lw_out
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_out_av) )  THEN
-          CALL wrd_write_string( 'rad_lw_out_av' )
-          WRITE( 14 )  rad_lw_out_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_cs_hr) )  THEN
-          CALL wrd_write_string( 'rad_lw_cs_hr' )
-          WRITE( 14 )  rad_lw_cs_hr
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_cs_hr_av) )  THEN
-          CALL wrd_write_string( 'rad_lw_cs_hr_av' )
-          WRITE( 14 )  rad_lw_cs_hr_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_hr) )  THEN
-          CALL wrd_write_string( 'rad_lw_hr' )
-          WRITE( 14 )  rad_lw_hr
-       ENDIF
-
-       IF ( ALLOCATED( rad_lw_hr_av) )  THEN
-          CALL wrd_write_string( 'rad_lw_hr_av' )
-          WRITE( 14 )  rad_lw_hr_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_in) )  THEN
-          CALL wrd_write_string( 'rad_sw_in' )
-          WRITE( 14 )  rad_sw_in
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_in_av) )  THEN
-          CALL wrd_write_string( 'rad_sw_in_av' )
-          WRITE( 14 )  rad_sw_in_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_out) )  THEN
-          CALL wrd_write_string( 'rad_sw_out' )
-          WRITE( 14 )  rad_sw_out
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_out_av) )  THEN
-          CALL wrd_write_string( 'rad_sw_out_av' )
-          WRITE( 14 )  rad_sw_out_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_cs_hr) )  THEN
-          CALL wrd_write_string( 'rad_sw_cs_hr' )
-          WRITE( 14 )  rad_sw_cs_hr
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_cs_hr_av) )  THEN
-          CALL wrd_write_string( 'rad_sw_cs_hr_av' )
-          WRITE( 14 )  rad_sw_cs_hr_av
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_hr) )  THEN
-          CALL wrd_write_string( 'rad_sw_hr' )
-          WRITE( 14 )  rad_sw_hr
-       ENDIF
-
-       IF ( ALLOCATED( rad_sw_hr_av) )  THEN
-          CALL wrd_write_string( 'rad_sw_hr_av' )
-          WRITE( 14 )  rad_sw_hr_av
-       ENDIF
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       IF ( ALLOCATED( rad_net_av ) )  CALL wrd_mpi_io( 'rad_net_av', rad_net_av )
-       IF ( ALLOCATED( rad_lw_in_xy_av ) )  CALL wrd_mpi_io( 'rad_lw_in_xy_av', rad_lw_in_xy_av )
-       IF ( ALLOCATED( rad_lw_out_xy_av ) )  CALL wrd_mpi_io( 'rad_lw_out_xy_av', rad_lw_out_xy_av )
-       IF ( ALLOCATED( rad_sw_in_xy_av ) )  CALL wrd_mpi_io( 'rad_sw_in_xy_av', rad_sw_in_xy_av )
-       IF ( ALLOCATED( rad_sw_out_xy_av ) )  CALL wrd_mpi_io( 'rad_sw_out_xy_av', rad_sw_out_xy_av )
-       IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.            &
-            radiation_scheme == 'external' )                                                       &
-       THEN
-          IF ( ALLOCATED( rad_lw_in ) )  THEN
-             tmp = rad_lw_in(0,:,:)
-             CALL wrd_mpi_io( 'rad_lw_in', tmp )
-          ENDIF
-          IF ( ALLOCATED( rad_lw_in_av ) )  THEN
-             tmp = rad_lw_in_av(0,:,:)
-             CALL wrd_mpi_io( 'rad_lw_in_av', tmp )
-          ENDIF
-          IF ( ALLOCATED( rad_lw_out ) )  THEN
-             tmp = rad_lw_out(0,:,:)
-             CALL wrd_mpi_io( 'rad_lw_out', tmp )
-          ENDIF
-          IF ( ALLOCATED( rad_lw_out_av ) )  THEN
-             tmp = rad_lw_out_av(0,:,:)
-             CALL wrd_mpi_io( 'rad_lw_out_av', tmp )
-          ENDIF
-       ELSE
-          IF ( ALLOCATED( rad_lw_in ) )  CALL wrd_mpi_io( 'rad_lw_in', rad_lw_in )
-          IF ( ALLOCATED( rad_lw_in_av ) )  CALL wrd_mpi_io( 'rad_lw_in_av', rad_lw_in_av )
-          IF ( ALLOCATED( rad_lw_out ) )  CALL wrd_mpi_io( 'rad_lw_out', rad_lw_out )
-          IF ( ALLOCATED( rad_lw_out_av) )  CALL wrd_mpi_io( 'rad_lw_out_av', rad_lw_out_av )
-       ENDIF
-       IF ( ALLOCATED( rad_lw_cs_hr) )  CALL wrd_mpi_io( 'rad_lw_cs_hr', rad_lw_cs_hr )
-       IF ( ALLOCATED( rad_lw_cs_hr_av) )  CALL wrd_mpi_io( 'rad_lw_cs_hr_av', rad_lw_cs_hr_av )
-       IF ( ALLOCATED( rad_lw_hr) )  CALL wrd_mpi_io( 'rad_lw_hr', rad_lw_hr )
-       IF ( ALLOCATED( rad_lw_hr_av) )  CALL wrd_mpi_io( 'rad_lw_hr_av', rad_lw_hr_av )
-       IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.            &
-            radiation_scheme == 'external' )                                                       &
-       THEN
-          IF ( ALLOCATED( rad_sw_in ) )  THEN
-             tmp = rad_sw_in(0,:,:)
-             CALL wrd_mpi_io( 'rad_sw_in', tmp )
-          ENDIF
-          IF ( ALLOCATED( rad_sw_in_av ) )  THEN
-             tmp = rad_sw_in_av(0,:,:)
-             CALL wrd_mpi_io( 'rad_sw_in_av', tmp )
-          ENDIF
-          IF ( ALLOCATED( rad_sw_out ) )  THEN
-             tmp = rad_sw_out(0,:,:)
-             CALL wrd_mpi_io( 'rad_sw_out', tmp )
-          ENDIF
-          IF ( ALLOCATED( rad_sw_out_av ) )  THEN
-             tmp = rad_sw_out_av(0,:,:)
-             CALL wrd_mpi_io( 'rad_sw_out_av', tmp )
-          ENDIF
-       ELSE
-          IF ( ALLOCATED( rad_sw_in) )  CALL wrd_mpi_io( 'rad_sw_in', rad_sw_in )
-          IF ( ALLOCATED( rad_sw_in_av) )  CALL wrd_mpi_io( 'rad_sw_in_av', rad_sw_in_av )
-          IF ( ALLOCATED( rad_sw_out) )  CALL wrd_mpi_io( 'rad_sw_out', rad_sw_out )
-          IF ( ALLOCATED( rad_sw_out_av) )  CALL wrd_mpi_io( 'rad_sw_out_av', rad_sw_out_av )
-       ENDIF
-       IF ( ALLOCATED( rad_sw_cs_hr) )  CALL wrd_mpi_io( 'rad_sw_cs_hr', rad_sw_cs_hr )
-       IF ( ALLOCATED( rad_sw_cs_hr_av) )  CALL wrd_mpi_io( 'rad_sw_cs_hr_av', rad_sw_cs_hr_av )
-       IF ( ALLOCATED( rad_sw_hr) )  CALL wrd_mpi_io( 'rad_sw_hr', rad_sw_hr )
-       IF ( ALLOCATED( rad_sw_hr_av) )  CALL wrd_mpi_io( 'rad_sw_hr_av', rad_sw_hr_av )
-
-    ENDIF
-
- END SUBROUTINE radiation_wrd_local
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf,    &
-                                     nync, nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d,   &
-                                     found )
-
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-    USE pegrid
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k            !<
-    INTEGER(iwp) ::  nxlc         !<
-    INTEGER(iwp) ::  nxlf         !<
-    INTEGER(iwp) ::  nxl_on_file  !<
-    INTEGER(iwp) ::  nxrc         !<
-    INTEGER(iwp) ::  nxrf         !<
-    INTEGER(iwp) ::  nxr_on_file  !<
-    INTEGER(iwp) ::  nync         !<
-    INTEGER(iwp) ::  nynf         !<
-    INTEGER(iwp) ::  nyn_on_file  !<
-    INTEGER(iwp) ::  nysc         !<
-    INTEGER(iwp) ::  nysf         !<
-    INTEGER(iwp) ::  nys_on_file  !<
-
-    LOGICAL, INTENT(OUT) ::  found  !<
-
-    REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::  tmp_2d  !<
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::  tmp_3d  !<
-
-    REAL(wp), DIMENSION(0:0,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::  tmp_3d2  !<
-
-
-    found = .TRUE.
-
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'rad_net_av' )
-          IF ( .NOT. ALLOCATED( rad_net_av ) )  THEN
-             ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_2d
-          rad_net_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_lw_in_xy_av' )
-          IF ( .NOT. ALLOCATED( rad_lw_in_xy_av ) )  THEN
-             ALLOCATE( rad_lw_in_xy_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_2d
-          rad_lw_in_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_lw_out_xy_av' )
-          IF ( .NOT. ALLOCATED( rad_lw_out_xy_av ) )  THEN
-             ALLOCATE( rad_lw_out_xy_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_2d
-          rad_lw_out_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
-          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_sw_in_xy_av' )
-          IF ( .NOT. ALLOCATED( rad_sw_in_xy_av ) )  THEN
-             ALLOCATE( rad_sw_in_xy_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_2d
-          rad_sw_in_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_sw_out_xy_av' )
-          IF ( .NOT. ALLOCATED( rad_sw_out_xy_av ) )  THEN
-             ALLOCATE( rad_sw_out_xy_av(nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_2d
-          rad_sw_out_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
-          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_lw_in' )
-          IF ( .NOT. ALLOCATED( rad_lw_in ) )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                ALLOCATE( rad_lw_in(0:0,nysg:nyng,nxlg:nxrg) )
-             ELSE
-                ALLOCATE( rad_lw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-          ENDIF
-          IF ( k == 1 )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                READ( 13 )  tmp_3d2
-                rad_lw_in(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                           &
-                tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ELSE
-                READ( 13 )  tmp_3d
-                rad_lw_in(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ENDIF
-          ENDIF
-
-       CASE ( 'rad_lw_in_av' )
-          IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                ALLOCATE( rad_lw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
-             ELSE
-                ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-          ENDIF
-          IF ( k == 1 )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                READ( 13 )  tmp_3d2
-                rad_lw_in_av(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                        &
-                tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ELSE
-                READ( 13 )  tmp_3d
-                rad_lw_in_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                          &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ENDIF
-          ENDIF
-
-       CASE ( 'rad_lw_out' )
-          IF ( .NOT. ALLOCATED( rad_lw_out ) )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                ALLOCATE( rad_lw_out(0:0,nysg:nyng,nxlg:nxrg) )
-             ELSE
-                ALLOCATE( rad_lw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-          ENDIF
-          IF ( k == 1 )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant' .OR.       &
-                  radiation_scheme == 'external' )  THEN
-                READ( 13 )  tmp_3d2
-                rad_lw_out(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                          &
-                tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ELSE
-                READ( 13 )  tmp_3d
-                rad_lw_out(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                            &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ENDIF
-          ENDIF
-
-       CASE ( 'rad_lw_out_av' )
-          IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                ALLOCATE( rad_lw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
-             ELSE
-                ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-          ENDIF
-          IF ( k == 1 )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                READ( 13 )  tmp_3d2
-                rad_lw_out_av(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                       &
-                tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ELSE
-                READ( 13 )  tmp_3d
-                rad_lw_out_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                         &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ENDIF
-          ENDIF
-
-       CASE ( 'rad_lw_cs_hr' )
-          IF ( .NOT. ALLOCATED( rad_lw_cs_hr ) )  THEN
-             ALLOCATE( rad_lw_cs_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_3d
-          rad_lw_cs_hr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                &
-          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_lw_cs_hr_av' )
-          IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) )  THEN
-             ALLOCATE( rad_lw_cs_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_3d
-          rad_lw_cs_hr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
-          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_lw_hr' )
-          IF ( .NOT. ALLOCATED( rad_lw_hr ) )  THEN
-             ALLOCATE( rad_lw_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_3d
-          rad_lw_hr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                   &
-          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_lw_hr_av' )
-          IF ( .NOT. ALLOCATED( rad_lw_hr_av ) )  THEN
-             ALLOCATE( rad_lw_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_3d
-          rad_lw_hr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                &
-          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_sw_in' )
-          IF ( .NOT. ALLOCATED( rad_sw_in ) )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                ALLOCATE( rad_sw_in(0:0,nysg:nyng,nxlg:nxrg) )
-             ELSE
-                ALLOCATE( rad_sw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-          ENDIF
-          IF ( k == 1 )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                READ( 13 )  tmp_3d2
-                rad_sw_in(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                           &
-                tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ELSE
-                READ( 13 )  tmp_3d
-                rad_sw_in(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ENDIF
-          ENDIF
-
-       CASE ( 'rad_sw_in_av' )
-          IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                ALLOCATE( rad_sw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
-             ELSE
-                ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-          ENDIF
-          IF ( k == 1 )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                READ( 13 )  tmp_3d2
-                rad_sw_in_av(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                        &
-                tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ELSE
-                READ( 13 )  tmp_3d
-                rad_sw_in_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                          &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ENDIF
-          ENDIF
-
-       CASE ( 'rad_sw_out' )
-          IF ( .NOT. ALLOCATED( rad_sw_out ) )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                ALLOCATE( rad_sw_out(0:0,nysg:nyng,nxlg:nxrg) )
-             ELSE
-                ALLOCATE( rad_sw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-          ENDIF
-          IF ( k == 1 )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                READ( 13 )  tmp_3d2
-                rad_sw_out(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                          &
-                tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ELSE
-                READ( 13 )  tmp_3d
-                rad_sw_out(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                            &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ENDIF
-          ENDIF
-
-       CASE ( 'rad_sw_out_av' )
-          IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                ALLOCATE( rad_sw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
-             ELSE
-                ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-          ENDIF
-          IF ( k == 1 )  THEN
-             IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.      &
-                  radiation_scheme == 'external' )  THEN
-                READ( 13 )  tmp_3d2
-                rad_sw_out_av(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                       &
-                tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ELSE
-                READ( 13 )  tmp_3d
-                rad_sw_out_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                         &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ENDIF
-          ENDIF
-
-       CASE ( 'rad_sw_cs_hr' )
-          IF ( .NOT. ALLOCATED( rad_sw_cs_hr ) )  THEN
-             ALLOCATE( rad_sw_cs_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_3d
-          rad_sw_cs_hr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                &
-          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_sw_cs_hr_av' )
-          IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) )  THEN
-             ALLOCATE( rad_sw_cs_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_3d
-          rad_sw_cs_hr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
-          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_sw_hr' )
-          IF ( .NOT. ALLOCATED( rad_sw_hr ) )  THEN
-             ALLOCATE( rad_sw_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_3d
-          rad_sw_hr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                   &
-          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'rad_sw_hr_av' )
-          IF ( .NOT. ALLOCATED( rad_sw_hr_av ) )  THEN
-             ALLOCATE( rad_sw_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( k == 1 )  READ( 13 )  tmp_3d
-          rad_lw_hr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                &
-          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE radiation_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE radiation_rrd_local_mpi
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    LOGICAL ::  array_found  !<
-
-    REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  tmp  !< temporary array for reading from file
-
-
-    CALL rd_mpi_io_check_array( 'rad_net_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_net_av ) )  ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_net_av', rad_net_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_lw_in_xy_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_lw_in_xy_av ) )  ALLOCATE( rad_lw_in_xy_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_lw_in_xy_av', rad_lw_in_xy_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_lw_out_xy_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_lw_out_xy_av ) )  ALLOCATE( rad_lw_out_xy_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_lw_out_xy_av', rad_lw_out_xy_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_sw_in_xy_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_sw_in_xy_av ) )  ALLOCATE( rad_sw_in_xy_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_sw_in_xy_av', rad_sw_in_xy_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_sw_out_xy_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_sw_out_xy_av ) )  ALLOCATE( rad_sw_out_xy_av(nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_sw_out_xy_av', rad_sw_out_xy_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_lw_in' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.            &
-            radiation_scheme == 'external' )  THEN
-          IF ( .NOT. ALLOCATED( rad_lw_in ) )  ALLOCATE( rad_lw_in(0:0,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_lw_in', tmp )
-          rad_lw_in(0,:,:) = tmp
-       ELSE
-          IF ( .NOT. ALLOCATED( rad_lw_in ) )  ALLOCATE( rad_lw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_lw_in', rad_lw_in )
-       ENDIF
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_lw_in_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.            &
-            radiation_scheme == 'external' )  THEN
-          IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  ALLOCATE( rad_lw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_lw_in_av', tmp )
-          rad_lw_in_av(0,:,:) = tmp
-       ELSE
-          IF ( .NOT. ALLOCATED( rad_lw_in_av ) )                                                   &
-          ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_lw_in_av', rad_lw_in_av )
-       ENDIF
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_lw_out' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.            &
-            radiation_scheme == 'external' )  THEN
-          IF ( .NOT. ALLOCATED( rad_lw_out ) )  ALLOCATE( rad_lw_out(0:0,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_lw_out', tmp )
-          rad_lw_out(0,:,:) = tmp
-       ELSE
-          IF ( .NOT. ALLOCATED( rad_lw_out ) )  ALLOCATE( rad_lw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_lw_out', rad_lw_out )
-       ENDIF
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_lw_out_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.            &
-            radiation_scheme == 'external' )  THEN
-          IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  ALLOCATE( rad_lw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_lw_out_av', tmp )
-          rad_lw_out_av(0,:,:) = tmp
-       ELSE
-          IF ( .NOT. ALLOCATED( rad_lw_out_av ) )                                                  &
-          ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_lw_out_av', rad_lw_out_av )
-       ENDIF
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_lw_cs_hr' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_lw_cs_hr ) )                                                      &
-       ALLOCATE( rad_lw_cs_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_lw_cs_hr', rad_lw_cs_hr )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_lw_cs_hr_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) )                                                   &
-       ALLOCATE( rad_lw_cs_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_lw_cs_hr_av', rad_lw_cs_hr_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_lw_hr' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_lw_hr ) )  ALLOCATE( rad_lw_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_lw_hr', rad_lw_hr )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_lw_hr_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_lw_hr_av ) )                                                      &
-       ALLOCATE( rad_lw_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_lw_hr_av', rad_lw_hr_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_sw_in' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.            &
-            radiation_scheme == 'external' )  THEN
-          IF ( .NOT. ALLOCATED( rad_sw_in ) )  ALLOCATE( rad_sw_in(0:0,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_sw_in', tmp )
-          rad_sw_in(0,:,:) = tmp
-       ELSE
-          IF ( .NOT. ALLOCATED( rad_sw_in ) )  ALLOCATE( rad_sw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_sw_in', rad_sw_in )
-       ENDIF
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_sw_in_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.            &
-            radiation_scheme == 'external' )  THEN
-          IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  ALLOCATE( rad_sw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_sw_in_av', tmp )
-          rad_sw_in_av(0,:,:) = tmp
-       ELSE
-          IF ( .NOT. ALLOCATED( rad_sw_in_av ) )                                                   &
-          ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_sw_in_av', rad_sw_in_av )
-       ENDIF
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_sw_out' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.            &
-            radiation_scheme == 'external' )  THEN
-          IF ( .NOT. ALLOCATED( rad_sw_out ) )  ALLOCATE( rad_sw_out(0:0,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_sw_out',  tmp)
-          rad_sw_out(0,:,:) = tmp
-       ELSE
-          IF ( .NOT. ALLOCATED( rad_sw_out ) )                                                     &
-          ALLOCATE( rad_sw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_sw_out',  rad_sw_out )
-       ENDIF
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_sw_out_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( radiation_scheme == 'clear-sky'  .OR.  radiation_scheme == 'constant'  .OR.            &
-            radiation_scheme == 'external' )  THEN
-          IF ( .NOT. ALLOCATED( rad_sw_out_av ) )                                                  &
-          ALLOCATE( rad_sw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_sw_out_av', tmp )
-          rad_sw_out_av(0,:,:) = tmp
-       ELSE
-          IF ( .NOT. ALLOCATED( rad_sw_out_av ) )                                                  &
-          ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'rad_sw_out_av', rad_sw_out_av )
-       ENDIF
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_sw_cs_hr' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_sw_cs_hr ) )                                                      &
-       ALLOCATE( rad_sw_cs_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_sw_cs_hr', rad_sw_cs_hr )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_sw_cs_hr_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) )                                                   &
-       ALLOCATE( rad_sw_cs_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_sw_cs_hr_av', rad_sw_cs_hr_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_sw_hr' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_sw_hr ) )  ALLOCATE( rad_sw_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_sw_hr', rad_sw_hr )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'rad_sw_hr_av' , found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( rad_sw_hr_av ) )                                                      &
-       ALLOCATE( rad_sw_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'rad_sw_hr_av', rad_sw_hr_av )
-    ENDIF
-
- END SUBROUTINE radiation_rrd_local_mpi
-
- END MODULE radiation_model_mod
Index: palm/trunk/SOURCE/random_function.f90
===================================================================
--- palm/trunk/SOURCE/random_function.f90	(revision 1)
+++ palm/trunk/SOURCE/random_function.f90	(revision 1)
@@ -0,0 +1,88 @@
+ MODULE random_function_mod
+!-------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: random_function.f90,v $
+! Revision 1.3  2003/10/29 09:06:57  raasch
+! Former function changed to a module.
+!
+! Revision 1.2  2001/01/22 08:00:23  raasch
+! Comments translated into English
+!
+! Revision 1.1  1998/02/04 16:09:45  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Random number generator, produces numbers equally distributed in interval [0,1]
+! This routine is taken from the "numerical recipies"
+!-------------------------------------------------------------------------------!
+
+    IMPLICIT NONE
+
+    PRIVATE
+
+    PUBLIC random_function, random_function_ini
+
+    INTEGER, PUBLIC, SAVE ::  random_iv(32), random_iy
+
+    INTERFACE random_function_ini
+       MODULE PROCEDURE random_function_ini
+    END INTERFACE random_function_ini
+
+    INTERFACE random_function
+       MODULE PROCEDURE random_function
+    END INTERFACE random_function
+
+ CONTAINS
+
+    SUBROUTINE random_function_ini
+
+       IMPLICIT NONE
+
+       random_iv = 0
+       random_iy = 0
+
+    END SUBROUTINE random_function_ini
+
+    FUNCTION random_function( idum )
+
+
+       IMPLICIT NONE
+
+       INTEGER ::  ia, idum, im, iq, ir, ndiv, ntab
+       REAL    ::  am, eps, random_function, ranf, rnmx
+
+       PARAMETER ( ia=16807, im=2147483647, am=1.0/im, iq=127773, ir=2836, &
+                   ntab=32, ndiv=1+(im-1)/ntab, eps=1.2e-7, rnmx=1.0-eps )
+
+       INTEGER ::  j, k
+
+
+       IF ( idum .le. 0  .or.  random_iy .eq. 0 )  THEN
+          idum = max (-idum,1)
+          DO  j = ntab+8,1,-1
+             k    = idum / iq
+             idum = ia * ( idum - k * iq ) - ir * k
+             IF ( idum .lt. 0 )  idum = idum + im
+             IF ( j .le. ntab )  random_iv(j) = idum
+          ENDDO
+          random_iy = random_iv(1)
+       ENDIF
+
+       k    = idum / iq
+       idum = ia * ( idum - k * iq ) - ir * k
+       IF ( idum .lt. 0 )  idum = idum + im
+       j            = 1 + random_iy / ndiv
+       random_iy    = random_iv(j)
+       random_iv(j) = idum
+       random_function  = min ( am * random_iy , rnmx )
+
+    END FUNCTION random_function
+
+ END MODULE random_function_mod
Index: palm/trunk/SOURCE/random_function_mod.f90
===================================================================
--- palm/trunk/SOURCE/random_function_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,139 +1,0 @@
-!> @file random_function_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4144 2019-08-06 09:11:47Z raasch
-! Relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
-!
-! 3802 2019-03-17 13:33:42Z raasch
-! Type conversion added to avoid compiler warning about constant integer division truncation
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
-! Revision 1.1  1998/02/04 16:09:45  raasch
-! Initial revision
-!
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Random number generator, produces numbers equally distributed in interval [0,1].
-!> This routine is taken from the "numerical recipes".
-!--------------------------------------------------------------------------------------------------!
- MODULE random_function_mod
-
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    PRIVATE
-
-    PUBLIC random_function, random_function_ini
-
-    INTEGER(iwp), PUBLIC, SAVE ::  random_iv(32)  !<
-    INTEGER(iwp), PUBLIC, SAVE ::  random_iy      !<
-
-    INTERFACE random_function_ini
-       MODULE PROCEDURE random_function_ini
-    END INTERFACE random_function_ini
-
-    INTERFACE random_function
-       MODULE PROCEDURE random_function
-    END INTERFACE random_function
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE random_function_ini
-
-    IMPLICIT NONE
-
-    random_iv = 0
-    random_iy = 0
-
- END SUBROUTINE random_function_ini
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing function description.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION random_function( idum )
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ia               !<
-    INTEGER(iwp) ::  idum             !<
-    INTEGER(iwp) ::  im               !<
-    INTEGER(iwp) ::  iq               !<
-    INTEGER(iwp) ::  ir               !<
-    INTEGER(iwp) ::  ndiv             !<
-    INTEGER(iwp) ::  ntab             !<
-
-    INTEGER(iwp) ::  j                !<
-    INTEGER(iwp) ::  k                !<
-
-    REAL(wp)     ::  am               !<
-    REAL(wp)     ::  eps              !<
-    REAL(wp)     ::  random_function  !<
-    REAL(wp)     ::  rnmx             !<
-
-    PARAMETER ( ia = 16807, im = 2147483647, am = 1.0_wp / im, iq = 127773, ir = 2836, ntab = 32,  &
-                ndiv = 1 + INT( REAL( im - 1 ) / ntab ), eps = 1.2e-7_wp, rnmx = 1.0_wp - eps )
-
-    IF ( idum <= 0  .OR.  random_iy == 0 )  THEN
-       idum = MAX( -idum, 1 )
-       DO  j = ntab + 8, 1, -1
-          k    = idum / iq
-          idum = ia * ( idum - k * iq ) - ir * k
-          IF ( idum < 0 )  idum = idum + im
-          IF ( j <= ntab )  random_iv(j) = idum
-       ENDDO
-       random_iy = random_iv(1)
-    ENDIF
-
-    k    = idum / iq
-    idum = ia * ( idum - k * iq ) - ir * k
-    IF ( idum < 0 )  idum = idum + im
-    j            = 1 + random_iy / ndiv
-    random_iy    = random_iv(j)
-    random_iv(j) = idum
-    random_function  = MIN( am * random_iy , rnmx )
-
- END FUNCTION random_function
-
- END MODULE random_function_mod
Index: palm/trunk/SOURCE/random_gauss.f90
===================================================================
--- palm/trunk/SOURCE/random_gauss.f90	(revision 4901)
+++ palm/trunk/SOURCE/random_gauss.f90	(revision 1)
@@ -1,35 +1,20 @@
-!> @file random_gauss.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ FUNCTION random_gauss( idum, upper_limit )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
+! $Log: random_gauss.f90,v $
+! Revision 1.4  2006/08/04 15:01:48  raasch
+! Range of random number is limited by an upper limit (new second parameter)
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.3  2003/10/29 09:08:04  raasch
+! Module random_function_mod is used
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
+! Revision 1.2  2001/01/22 08:03:31  raasch
+! Comments translated into English
 !
 ! Revision 1.1  1998/03/25 20:09:47  raasch
@@ -37,30 +22,16 @@
 !
 !
-!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Generates a gaussian distributed random number (mean value 1, sigma = 1)
-!> This routine is taken from the "numerical recipies".
-!--------------------------------------------------------------------------------------------------!
- FUNCTION random_gauss( idum, upper_limit )
+! Generates a gaussian distributed random number (mean value 1, sigma = 1)
+! This routine is taken from the "numerical recipies".
+!------------------------------------------------------------------------------!
 
-
-    USE kinds
-
-    USE random_function_mod,                                                                       &
-        ONLY:  random_function
+    USE random_function_mod
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  idum          !<
-    INTEGER(iwp) ::  iset          !<
-
-    REAL(wp)     ::  fac           !<
-    REAL(wp)     ::  gset          !<
-    REAL(wp)     ::  random_gauss  !<
-    REAL(wp)     ::  rsq           !<
-    REAL(wp)     ::  upper_limit   !<
-    REAL(wp)     ::  v1            !<
-    REAL(wp)     ::  v2            !<
+    INTEGER :: idum, iset
+    REAL    :: fac, gset, random_gauss, rsq, upper_limit, v1, v2
 
     SAVE  iset, gset
@@ -69,24 +40,25 @@
 
 !
-!-- Random numbers are created as long as they do not fall below the given upper limit
+!-- Random numbers are created as long as they do not fall below the given
+!-- upper limit
     DO
 
        IF ( iset == 0 )  THEN
-          rsq = 0.0_wp
-          DO  WHILE ( rsq >= 1.0_wp  .OR.  rsq == 0.0_wp )
-             v1  = 2.0_wp * random_function( idum ) - 1.0_wp
-             v2  = 2.0_wp * random_function( idum ) - 1.0_wp
+          rsq = 0.0
+          DO  WHILE ( rsq >= 1.0  .OR.  rsq == 0.0 )
+             v1  = 2.0 * random_function( idum ) - 1.0
+             v2  = 2.0 * random_function( idum ) - 1.0
              rsq = v1**2 + v2**2
           ENDDO
-          fac          = SQRT( -2.0_wp * LOG( rsq ) / rsq )
+          fac          = SQRT( -2.0 * LOG( rsq ) / rsq )
           gset         = v1 * fac
-          random_gauss = v2 * fac + 1.0_wp
+          random_gauss = v2 * fac + 1.0
           iset         = 1
        ELSE
-          random_gauss = gset + 1.0_wp
+          random_gauss = gset + 1.0
           iset         = 0
        ENDIF
 
-       IF ( ABS( random_gauss - 1.0_wp ) <= upper_limit )  EXIT
+       IF ( ABS( random_gauss - 1.0 ) <= upper_limit )  EXIT
 
     ENDDO
Index: palm/trunk/SOURCE/random_generator_parallel_mod.f90
===================================================================
--- palm/trunk/SOURCE/random_generator_parallel_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,648 +1,0 @@
-!> @file random_generator_parallel_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
-!
-! 4545 2020-05-22 13:17:57Z schwenkel
-! Add generator (using parallel mode) returning gaussian distributed random number
-!
-! 4438 2020-03-03 20:49:28Z raasch
-! - Rename variables to avoid confusion with subdomain grid indices
-! - Some formatting adjustments
-! - New routine to initialize spatial 1D-arrays independent on the 2D random-number array
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Unused variable removed
-!
-! 1400 2014-05-09 14:03:54Z knoop
-! Initial revision
-!
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This module contains and supports the random number generating routine ran_parallel.
-!> ran_parallel returns a uniform random deviate between 0.0 and 1.0 (exclusive of the end point
-!> values). Moreover, it contains a routine returning a normally distributed random number with mean
-!> zero and unity standard deviation. Additionally, it provides the generator with five integers for
-!> use as initial state space. The first tree integers (iran, jran, kran) are maintained as non
-!> negative values, while the last two (mran, nran) have 32-bit nonzero values. Also provided by
-!> this module is support for initializing or reinitializing the state space to a desired standard
-!> sequence number, hashing the initial values to random values and allocating and deallocating the
-!> internal workspace.
-!>
-!> This routine is taken from the "numerical recipies vol. 2"
-!--------------------------------------------------------------------------------------------------!
- MODULE random_generator_parallel
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(isp), SAVE ::  lenran = 0  !<
-    INTEGER(isp), SAVE ::  seq = 0     !<
-    INTEGER(isp), SAVE ::  iran0       !<
-    INTEGER(isp), SAVE ::  jran0       !<
-    INTEGER(isp), SAVE ::  kran0       !<
-    INTEGER(isp), SAVE ::  mran0       !<
-    INTEGER(isp), SAVE ::  nran0       !<
-    INTEGER(isp), SAVE ::  rans        !<
-
-    INTEGER(isp), DIMENSION(:, :), POINTER, SAVE ::  ranseeds  !<
-
-    INTEGER(isp), DIMENSION(:), POINTER, SAVE ::  iran  !<
-    INTEGER(isp), DIMENSION(:), POINTER, SAVE ::  jran  !<
-    INTEGER(isp), DIMENSION(:), POINTER, SAVE ::  kran  !<
-    INTEGER(isp), DIMENSION(:), POINTER, SAVE ::  mran  !<
-    INTEGER(isp), DIMENSION(:), POINTER, SAVE ::  nran  !<
-    INTEGER(isp), DIMENSION(:), POINTER, SAVE ::  ranv  !<
-
-    INTEGER(isp), DIMENSION(:,:), ALLOCATABLE   ::  id_random_array   !<
-    INTEGER(isp), DIMENSION(:,:,:), ALLOCATABLE ::  seq_random_array  !<
-
-    REAL(wp), SAVE ::  amm  !<
-
-    REAL(wp) ::  random_dummy = 0.0  !<
-
-    INTERFACE init_parallel_random_generator
-       MODULE PROCEDURE init_parallel_random_generator_1d
-       MODULE PROCEDURE init_parallel_random_generator_2d
-    END INTERFACE
-
-    INTERFACE random_number_parallel
-       MODULE PROCEDURE ran0_s
-    END INTERFACE
-
-    INTERFACE random_number_parallel_gauss
-       MODULE PROCEDURE gasdev_s
-    END INTERFACE
-
-    INTERFACE random_seed_parallel
-       MODULE PROCEDURE random_seed_parallel
-    END INTERFACE
-
-    INTERFACE ran_hash
-       MODULE PROCEDURE ran_hash_v
-    END INTERFACE
-
-    INTERFACE reallocate
-       MODULE PROCEDURE reallocate_iv,reallocate_im
-    END INTERFACE
-
-    INTERFACE arth
-       MODULE PROCEDURE arth_i
-    END INTERFACE
-
-    PRIVATE
-
-    PUBLIC random_number_parallel,                                                                 &
-           random_seed_parallel,                                                                   &
-           random_dummy,                                                                           &
-           id_random_array,                                                                        &
-           seq_random_array,                                                                       &
-           init_parallel_random_generator,                                                         &
-           random_number_parallel_gauss
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize the parallel random number generator for a 1-dimensional array.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_parallel_random_generator_1d( nxy, ns, ne, id_rand, seq_rand )
-
-    USE control_parameters,                                                                        &
-        ONLY: ensemble_member_nr
-
-    INTEGER(isp), INTENT(IN) ::  nxy  !< constant scaling with grid dimensions
-    INTEGER(isp), INTENT(IN) ::  ns   !< start index on subdomain
-    INTEGER(isp), INTENT(IN) ::  ne   !< end index on subdomain
-
-    INTEGER(iwp) ::  j  !< loop index
-
-    INTEGER(isp), DIMENSION(ns:ne)   ::  id_rand   !< initial IDs
-    INTEGER(isp), DIMENSION(5,ns:ne) ::  seq_rand  !< initial random seeds
-
-!
-!-- Asigning an ID to every vertical gridpoint column dependig on the ensemble run number.
-    DO  j = ns, ne
-       id_rand(j) = j * ( nxy + 1.0_wp ) + 1.0_wp + 1E6 * ( ensemble_member_nr - 1000 )
-    ENDDO
-!
-!-- Initializing with random_seed_parallel for every vertical gridpoint column.
-    random_dummy = 0
-    DO  j = ns, ne
-       CALL random_seed_parallel( random_sequence=id_rand(j) )
-       CALL random_number_parallel( random_dummy )
-       CALL random_seed_parallel( get=seq_rand(:,j) )
-    ENDDO
-
- END SUBROUTINE init_parallel_random_generator_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize the parallel random number generator for a specific subdomain.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_parallel_random_generator_2d( nx_l, nys_l, nyn_l, nxl_l, nxr_l )
-
-    USE kinds
-
-    USE control_parameters,                                                                        &
-        ONLY: ensemble_member_nr
-
-    IMPLICIT NONE
-
-    INTEGER(isp), INTENT(IN) ::  nx_l   !< constant
-    INTEGER(isp), INTENT(IN) ::  nys_l  !< local lower subdomain bound index in y-direction
-    INTEGER(isp), INTENT(IN) ::  nyn_l  !< local upper subdomain bound index in y-direction
-    INTEGER(isp), INTENT(IN) ::  nxl_l  !< local lower subdomain bound index in x-direction
-    INTEGER(isp), INTENT(IN) ::  nxr_l  !< local upper subdomain bound index in x-direction
-
-    INTEGER(iwp) ::  i  !< grid index x-direction
-    INTEGER(iwp) ::  j  !< grid index y-direction
-
-!-- Allocate ID-array and state-space-array
-    ALLOCATE ( seq_random_array(5,nys_l:nyn_l,nxl_l:nxr_l) )
-    ALLOCATE ( id_random_array(nys_l:nyn_l,nxl_l:nxr_l) )
-    seq_random_array = 0
-    id_random_array  = 0
-
-!-- Asigning an ID to every vertical gridpoint column dependig on the ensemble run number.
-    DO  i = nxl_l, nxr_l
-       DO  j = nys_l, nyn_l
-          id_random_array(j,i) = j * ( nx_l + 1.0_wp ) + i + 1.0_wp + 1E6 *                        &
-                                 ( ensemble_member_nr - 1000 )
-       ENDDO
-    ENDDO
-!-- Initializing with random_seed_parallel for every vertical gridpoint column.
-    random_dummy = 0
-    DO  i = nxl_l, nxr_l
-       DO  j = nys_l, nyn_l
-          CALL random_seed_parallel( random_sequence = id_random_array(j,i) )
-          CALL random_number_parallel( random_dummy )
-          CALL random_seed_parallel( get = seq_random_array(:,j,i) )
-       ENDDO
-    ENDDO
-
- END SUBROUTINE init_parallel_random_generator_2d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Lagged Fibonacci generator combined with a Marsaglia shift sequence. Returns as harvest a uniform
-!> random deviate between 0.0 and 1.0 (exclusive of the end point values). This generator has the
-!> same calling and initialization conventions as Fortran 90's random_number routine.
-!> Use random_seed_parallel to initialize or reinitialize to a particular sequence.
-!> The period of this generator is about 2.0 x 10^28, and it fully vectorizes.
-!> Validity of the integer model assumed by this generator is tested at initialization.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ran0_s( harvest )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    REAL(wp), INTENT(OUT) ::  harvest  !<
-!
-!-- Initialization routine in ran_state.
-    IF ( lenran < 1 )  CALL ran_init( 1 )
-!
-!-- Update Fibonacci generator, which has period p^2 + p + 1, p = 2^31 - 69.
-    rans = iran0 - kran0
-
-    IF ( rans < 0 )  rans = rans + 2147483579_isp
-
-    iran0 = jran0
-    jran0 = kran0
-    kran0 = rans
-!
-!-- Update Marsaglia shift sequence with period 2^32 - 1.
-    nran0 = IEOR( nran0, ISHFT( nran0, 13 ) )
-    nran0 = IEOR( nran0, ISHFT( nran0, -17 ) )
-    nran0 = IEOR( nran0, ISHFT( nran0, 5 ) )
-!
-!-- Combine the generators.
-    rans  = IEOR( nran0, rans )
-!
-!-- Make the result positive definite (note that amm is negative).
-    harvest = amm * MERGE( rans, NOT( rans ), rans < 0 )
-
- END SUBROUTINE ran0_s
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Returns in harvest a normally distributed deviate with zero mean and unit variance, using ran0_s
-!> as the source of uniform deviates. Following Numerical Recipes in Fortran90 (Press et al., 2nd
-!> edition, 1996, pp 1152ff). Note, instead of ran1_s, ran0_s is used.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE gasdev_s( harvest )
-
-    REAL(wp), INTENT(OUT) ::  harvest  !<
-
-    REAL(wp) ::  rsq  !<
-    REAL(wp) ::  v1   !<
-    REAL(wp) ::  v2   !<
-    REAL(wp), SAVE ::  g  !<
-
-    LOGICAL, SAVE ::  gaus_stored = .FALSE.  !<
-!
-!-- We have an extra deviate handy, so return it, and unset the flag.
-    IF ( gaus_stored )  THEN
-       harvest = g
-       gaus_stored = .FALSE.
-!
-!-- We donât have an extra deviate handy, so pick two uniform numbers in the square extending
-!-- from -1 to +1 in each direction
-    ELSE
-       DO
-          CALL ran0_s( v1 )
-          CALL ran0_s( v2 )
-          v1 = 2.0_wp * v1 - 1.0_wp
-          v2 = 2.0_wp * v2 - 1.0_wp
-!
-!--       See if they are in the unit circle
-          rsq = v1**2 + v2**2
-!
-!--       Otherwise try again.
-          IF ( rsq > 0.0  .AND.  rsq < 1.0 )  EXIT
-       ENDDO
-!
-!--    Now make the Box-Muller transformation to get two normal deviates.
-!--    Return one and save the other for next time. Set flag.
-       rsq = SQRT( - 2.0_sp * LOG( rsq ) / rsq )
-       harvest = v1 * rsq
-       g = v2 * rsq
-       gaus_stored = .TRUE.
-    ENDIF
-
- END SUBROUTINE gasdev_s
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize or reinitialize the random generator state space to vectors of size length.
-!> The saved variable seq is hashed (via calls to the module routine ran_hash) to create unique
-!> starting seeds, different for each vector component.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ran_init( length )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(isp), INTENT(IN) ::  length  !<
-
-    INTEGER(isp) ::  hg    !<
-    INTEGER(isp) ::  hgm   !<
-    INTEGER(isp) ::  hgng  !<
-
-    INTEGER(isp) ::  new   !<
-    INTEGER(isp) ::  j     !<
-    INTEGER(isp) ::  hgt   !<
-!
-!-- Simply return if enough space is already allocated.
-    IF ( length < lenran )  RETURN
-
-    hg = HUGE( 1_isp )
-    hgm = - hg
-    hgng = hgm - 1
-    hgt = hg
-
-!-- The following lines check that kind value isp is in fact a 32-bit integer with the usual
-!-- properties that we expect it to have (under negation and wrap-around addition).
-!-- If all of these tests are satisfied, then the routines that use this module are portable, even
-!-- though they go beyond Fortran 90's integer model.
-
-    IF ( hg /= 2147483647   )  CALL ran_error( 'arithmetic assumption 1 failed' )
-    IF ( hgng >= 0          )  CALL ran_error( 'arithmetic assumption 2 failed' )
-    IF ( hgt + 1 /= hgng    )  CALL ran_error( 'arithmetic assumption 3 failed' )
-    IF ( NOT( hg ) >= 0     )  CALL ran_error( 'arithmetic assumption 4 failed' )
-    IF ( NOT( hgng ) < 0    )  CALL ran_error( 'arithmetic assumption 5 failed' )
-    IF ( hg + hgng >= 0     )  CALL ran_error( 'arithmetic assumption 6 failed' )
-    IF ( NOT( - 1_isp ) < 0 )  CALL ran_error( 'arithmetic assumption 7 failed' )
-    IF ( NOT( 0_isp ) >= 0  )  CALL ran_error( 'arithmetic assumption 8 failed' )
-    IF ( NOT( 1_isp ) >= 0  )  CALL ran_error( 'arithmetic assumption 9 failed' )
-
-    IF ( lenran > 0 )  THEN                          ! Reallocate space, or ...
-
-       ranseeds => reallocate( ranseeds, length, 5 )
-       ranv => reallocate( ranv, length - 1 )
-       new = lenran + 1
-
-    ELSE                                            ! Allocate space.
-
-       ALLOCATE( ranseeds(length,5) )
-       ALLOCATE( ranv(length-1) )
-       new = 1                               !- Index of first location not yet initialized.
-       amm = NEAREST( 1.0_wp, - 1.0_wp ) / hgng
-!
-!--    Use of nearest is to ensure that returned random deviates are strictly less than 1.0.
-       IF  ( amm * hgng >= 1.0  .OR.  amm * hgng <= 0.0 )                                          &
-          CALL ran_error( 'arithmetic assumption 10 failed' )
-
-    END IF
-!
-!-- Set starting values, unique by seq and vector component.
-    ranseeds(new:,1) = seq
-    ranseeds(new:,2:5) = SPREAD( arth( new, 1, SIZE( ranseeds(new:,1) ) ), 2, 4 )
-
-    DO  j = 1, 4   ! Hash them.
-       CALL ran_hash( ranseeds(new:,j), ranseeds(new:,j+1) )
-    END DO
-
-    WHERE ( ranseeds(new:,1:3) < 0 )                                                              &
-       ranseeds(new:,1:3) = NOT( ranseeds(new:,1:3) )  ! Enforce nonnegativity.
-
-    WHERE ( ranseeds(new:,4:5) == 0 ) ranseeds(new:,4:5) = 1 ! Enforce nonzero.
-
-    IF ( new == 1 )  THEN ! Set scalar seeds.
-
-       iran0 = ranseeds(1,1)
-       jran0 = ranseeds(1,2)
-       kran0 = ranseeds(1,3)
-       mran0 = ranseeds(1,4)
-       nran0 = ranseeds(1,5)
-       rans  = nran0
-
-    END IF
-
-    IF ( length > 1 )  THEN   ! Point to vector seeds.
-
-       iran => ranseeds(2:,1)
-       jran => ranseeds(2:,2)
-       kran => ranseeds(2:,3)
-       mran => ranseeds(2:,4)
-       nran => ranseeds(2:,5)
-       ranv = nran
-
-    END IF
-
-    lenran = length
-
- END SUBROUTINE ran_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> User interface to release the workspace used by the random number routines.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ran_deallocate
-
-    IF ( lenran > 0 )  THEN
-
-       DEALLOCATE( ranseeds, ranv )
-       NULLIFY( ranseeds, ranv, iran, jran, kran, mran, nran )
-       lenran = 0
-
-    END IF
-
- END SUBROUTINE ran_deallocate
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> User interface for seeding the random number routines.
-!> Syntax is exactly like Fortran 90's random_seed routine, with one additional argument keyword:
-!> random_sequence, set to any integer value, causes an immediate new initialization, seeded by that
-!> integer.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE random_seed_parallel( random_sequence, state_size, put, get )
-
-    IMPLICIT NONE
-
-    INTEGER(isp), OPTIONAL, INTENT(IN)  ::  random_sequence  !<
-    INTEGER(isp), OPTIONAL, INTENT(OUT) ::  state_size       !<
-
-    INTEGER(isp), DIMENSION(:), OPTIONAL, INTENT(IN)  ::  put  !<
-    INTEGER(isp), DIMENSION(:), OPTIONAL, INTENT(OUT) ::  get  !<
-
-    IF ( PRESENT( state_size ) )  THEN
-
-       state_size = 5 * lenran
-
-    ELSE IF ( PRESENT( put ) )  THEN
-
-       IF ( lenran == 0 )  RETURN
-
-       ranseeds = RESHAPE( put, SHAPE( ranseeds ) )
-!
-!--    Enforce nonnegativity and nonzero conditions on any user-supplied seeds.
-       WHERE ( ranseeds(:,1:3) < 0 ) ranseeds(:,1:3) = NOT( ranseeds(:,1:3) )
-
-       WHERE ( ranseeds(:,4:5) == 0 ) ranseeds(:,4:5) = 1
-
-       iran0 = ranseeds(1,1)
-       jran0 = ranseeds(1,2)
-       kran0 = ranseeds(1,3)
-       mran0 = ranseeds(1,4)
-       nran0 = ranseeds(1,5)
-
-    ELSE IF ( PRESENT( get ) )  THEN
-
-       IF ( lenran == 0 )  RETURN
-
-       ranseeds(1,1:5) = (/ iran0, jran0, kran0, mran0, nran0 /)
-       get = RESHAPE( ranseeds, SHAPE( get ) )
-
-    ELSE IF ( PRESENT( random_sequence ) ) THEN
-
-       CALL ran_deallocate
-       seq = random_sequence
-
-    END IF
-
- END SUBROUTINE random_seed_parallel
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> DES-like hashing of two 32-bit integers, using shifts, xor's, and adds to make the internal
-!> nonlinear function.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ran_hash_v( il, ir )
-
-    IMPLICIT NONE
-
-    INTEGER(isp), DIMENSION(:), INTENT(INOUT) ::  il  !<
-    INTEGER(isp), DIMENSION(:), INTENT(INOUT) ::  ir  !<
-
-    INTEGER(isp), DIMENSION(size(il)) ::  is  !<
-
-    INTEGER(isp) :: j  !<
-
-    DO  j = 1, 4
-
-       is = ir
-       ir = IEOR( ir, ISHFT( ir, 5 ) ) + 1422217823
-       ir = IEOR( ir, ISHFT( ir, - 16 ) ) + 1842055030
-       ir = IEOR( ir, ISHFT( ir, 9 ) ) + 80567781
-       ir = IEOR( il, ir )
-       il = is
-    END DO
-
- END SUBROUTINE ran_hash_v
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> User interface to process error-messages produced by the random_number_parallel module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE ran_error( string )
-
-    USE control_parameters,                                                                        &
-      ONLY: message_string
-
-    CHARACTER(LEN=*), INTENT(IN) ::  string  !< Error message string
-
-    message_string = 'incompatible integer arithmetic: ' // TRIM( string )
-    CALL message( 'ran_init', 'PA0453', 1, 2, 0, 6, 0 )
-
- END SUBROUTINE ran_error
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reallocates the generators state space "ranseeds" to vectors of size length.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION reallocate_iv( p, n )
-
-    USE control_parameters,                                                                        &
-      ONLY: message_string
-
-    INTEGER(isp), DIMENSION(:), POINTER ::  p              !<
-    INTEGER(isp), DIMENSION(:), POINTER ::  reallocate_iv  !<
-
-    INTEGER(isp), INTENT(IN) ::  n  !<
-
-    INTEGER(isp) ::  nold  !<
-    INTEGER(isp) ::  ierr  !<
-
-    ALLOCATE( reallocate_iv(n), stat = ierr )
-
-    IF ( ierr /= 0 )  THEN
-       message_string = 'problem in attempt to allocate memory'
-       CALL message( 'reallocate_iv', 'PA0454', 1, 2, 0, 6, 0 )
-    END IF
-
-    IF ( .NOT. ASSOCIATED( p ) )  RETURN
-
-    nold = SIZE( p )
-
-    reallocate_iv(1:MIN( nold, n )) = p(1:MIN( nold, n ))
-
-    DEALLOCATE( p )
-
- END FUNCTION reallocate_iv
-
- FUNCTION reallocate_im( p, n, m )
-
-    USE control_parameters,                                                                        &
-      ONLY: message_string
-
-    INTEGER(isp), DIMENSION(:,:), POINTER ::  p              !<
-    INTEGER(isp), DIMENSION(:,:), POINTER ::  reallocate_im  !<
-
-    INTEGER(isp), INTENT(IN) ::  m  !<
-    INTEGER(isp), INTENT(IN) ::  n  !<
-
-    INTEGER(isp) ::  mold  !<
-    INTEGER(isp) ::  nold  !<
-    INTEGER(isp) ::  ierr  !<
-
-    ALLOCATE( reallocate_im(n,m), stat = ierr )
-
-    IF ( ierr /= 0 )  THEN
-       message_string = 'problem in attempt to allocate memory'
-       CALL message( 'reallocate_im', 'PA0454', 1, 2, 0, 6, 0 )
-    END IF
-
-    IF ( .NOT. ASSOCIATED( p ) )  RETURN
-
-    nold = SIZE( p, 1 )
-    mold = SIZE( p, 2 )
-
-    reallocate_im(1:MIN( nold, n ),1:MIN( mold, m )) = p(1:MIN( nold, n ),1:MIN( mold, m ))
-
-    DEALLOCATE(p)
-
- END FUNCTION reallocate_im
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reallocates the generators state space "ranseeds" to vectors of size length.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION arth_i( first, increment, n )
-
-    INTEGER(isp), INTENT(IN) ::  first      !<
-    INTEGER(isp), INTENT(IN) ::  increment  !<
-    INTEGER(isp), INTENT(IN) ::  n          !<
-
-    INTEGER(isp), DIMENSION(n) ::  arth_i  !<
-
-    INTEGER(isp) ::  k     !<
-    INTEGER(isp) ::  k2    !<
-    INTEGER(isp) ::  temp  !<
-
-    INTEGER(isp), PARAMETER ::  npar_arth = 16  !<
-    INTEGER(isp), PARAMETER ::  npar2_arth = 8  !<
-
-    IF ( n > 0 )  arth_i(1) = first
-
-    IF ( n <= npar_arth )  THEN
-
-       DO  k = 2, n
-          arth_i(k) = arth_i(k-1) + increment
-       END DO
-
-    ELSE
-
-       DO  k = 2, npar2_arth
-          arth_i(k) = arth_i(k-1) + increment
-       END DO
-
-       temp = increment * npar2_arth
-       k = npar2_arth
-
-       DO
-          IF ( k >= n )  EXIT
-          k2 = k + k
-          arth_i(k+1:MIN( k2, n )) = temp + arth_i(1:MIN( k, n - k ))
-          temp = temp + temp
-          k = k2
-       END DO
-
-    END IF
-
- END FUNCTION arth_i
-
-END MODULE random_generator_parallel
Index: palm/trunk/SOURCE/read_3d_binary.f90
===================================================================
--- palm/trunk/SOURCE/read_3d_binary.f90	(revision 1)
+++ palm/trunk/SOURCE/read_3d_binary.f90	(revision 1)
@@ -0,0 +1,502 @@
+ SUBROUTINE read_3d_binary
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: read_3d_binary.f90,v $
+! Revision 1.4  2006/08/04 15:02:32  raasch
+! +iran, iran_part
+!
+! Revision 1.3  2006/02/23 12:52:45  raasch
+! +volume_flow_area, volume_flow_initial, -hom_sum_pr,
+! reading arrays used for time-averaging
+!
+! Revision 1.2  2005/05/18 15:54:33  raasch
+! pl1d_callcount renamed dopr_time_count
+!
+! Revision 1.1  2004/04/30 12:47:27  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Binary input of variables and arrays from restart file
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE averaging
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE particle_attributes
+    USE pegrid
+    USE profil_parameter
+    USE random_function_mod
+    USE statistics
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=10) ::  binary_version, version_on_file
+    CHARACTER (LEN=20) ::  field_chr
+    CHARACTER (LEN=10),  DIMENSION(:), ALLOCATABLE ::  chdum10
+    CHARACTER (LEN=40),  DIMENSION(:), ALLOCATABLE ::  chdum40
+    CHARACTER (LEN=100), DIMENSION(:), ALLOCATABLE ::  chdum100
+
+    INTEGER ::  idum1, myid_on_file, numprocs_on_file, nxl_on_file, &
+                nxr_on_file, nyn_on_file, nys_on_file, nzb_on_file, nzt_on_file
+
+    INTEGER, DIMENSION(:), ALLOCATABLE ::  idum
+
+    REAL, DIMENSION(:), ALLOCATABLE ::  rdum
+
+!
+!-- Read data from previous model run. unit 13 already opened in parin
+    CALL cpu_log( log_point_s(14), 'read_3d_binary', 'start' )
+
+!
+!-- First compare the version numbers
+    READ ( 13 )  version_on_file
+    binary_version = '3.0'
+    IF ( TRIM( version_on_file ) /= TRIM( binary_version ) )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ init_3d_model: version mismatch concerning data ', &
+                  'from prior run'
+          PRINT*, '        version on file    = "', TRIM( version_on_file ),&
+                  '"'
+          PRINT*, '        version in program = "', TRIM( binary_version ), &
+                  '"'
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+!
+!-- Read and compare number of processors, processor-id and array ranges
+    READ ( 13 )  numprocs_on_file, myid_on_file, nxl_on_file, nxr_on_file, &
+                 nys_on_file, nyn_on_file, nzb_on_file, nzt_on_file
+
+    IF ( numprocs_on_file /= numprocs )  THEN
+       PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+       PRINT*, '                   from prior run on PE ', myid
+       PRINT*, '                   numprocs on file = ', numprocs_on_file
+       PRINT*, '                   numprocs         = ', numprocs
+       CALL local_stop
+    ENDIF
+
+    IF ( myid_on_file /= myid )  THEN
+       PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+       PRINT*, '                   from prior run'
+       PRINT*, '                   myid_on_file = ', myid_on_file
+       PRINT*, '                   myid         = ', myid
+#if defined( __parallel )
+       CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+       CALL local_stop
+#endif
+    ENDIF
+
+    IF ( nxl_on_file /= nxl )  THEN
+       PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+       PRINT*, '                   from prior run on PE ', myid
+       PRINT*, '                   nxl on file = ', nxl_on_file
+       PRINT*, '                   nxl         = ', nxl
+#if defined( __parallel )
+       CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+       CALL local_stop
+#endif
+    ENDIF
+
+    IF ( nxr_on_file /= nxr )  THEN
+       PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+       PRINT*, '                   from prior run on PE ', myid
+       PRINT*, '                   nxr on file = ', nxr_on_file
+       PRINT*, '                   nxr         = ', nxr
+#if defined( __parallel )
+       CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+       CALL local_stop
+#endif
+    ENDIF
+
+    IF ( nys_on_file /= nys )  THEN
+       PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+       PRINT*, '                   from prior run on PE ', myid
+       PRINT*, '                   nys on file = ', nys_on_file
+       PRINT*, '                   nys         = ', nys
+#if defined( __parallel )
+       CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+       CALL local_stop
+#endif
+    ENDIF
+
+    IF ( nyn_on_file /= nyn )  THEN
+       PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+       PRINT*, '                   from prior run on PE ', myid
+       PRINT*, '                   nyn on file = ', nyn_on_file
+       PRINT*, '                   nyn         = ', nyn
+#if defined( __parallel )
+       CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+       CALL local_stop
+#endif
+    ENDIF
+
+    IF ( nzb_on_file /= nzb )  THEN
+       PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+       PRINT*, '                   from prior run on PE ', myid
+       PRINT*, '                   nzb on file = ', nzb_on_file
+       PRINT*, '                   nzb         = ', nzb
+       CALL local_stop
+    ENDIF
+
+    IF ( nzt_on_file /= nzt )  THEN
+       PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+       PRINT*, '                   from prior run on PE ', myid
+       PRINT*, '                   nzt on file = ', nzt_on_file
+       PRINT*, '                   nzt         = ', nzt
+       CALL local_stop
+    ENDIF
+
+!
+!-- Local arrays that may be required for possible temporary information 
+!-- storage in the following
+    ALLOCATE( chdum10(crmax), chdum40(crmax), chdum100(crmax), &
+              idum(100*crmax), rdum(100*crmax) )
+
+!
+!-- Initialize spectra (for the case of just starting spectra computation
+!-- in continuation runs)
+    IF ( dt_dosp /= 9999999.9 )  THEN
+       spectrum_x = 0.0
+       spectrum_y = 0.0
+    ENDIF
+
+!
+!-- Read arrays
+!-- ATTENTION: If the following read commands have been altered, the 
+!-- ---------- version number of the variable binary_version must be altered,
+!--            too. Furthermore, the output list of arrays in write_3d_binary
+!--            must also be altered accordingly.
+    READ ( 13 )  field_chr
+    DO  WHILE ( TRIM( field_chr ) /= '*** end ***' )
+
+       SELECT CASE ( TRIM( field_chr ) )
+
+          CASE ( 'e' )
+             READ ( 13 )  e
+          CASE ( 'e_av' )
+             ALLOCATE( e_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  e_av
+          CASE ( 'e_m' )
+             READ ( 13 )  e_m
+          CASE ( 'iran' )
+             READ ( 13 )  iran, iran_part
+          CASE ( 'kh' )
+             READ ( 13 )  kh
+          CASE ( 'kh_m' )
+             READ ( 13 )  kh_m
+          CASE ( 'km' )
+             READ ( 13 )  km
+          CASE ( 'km_m' )
+             READ ( 13 )  km_m
+          CASE ( 'lwp_av' )
+             ALLOCATE( lwp_av(nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  lwp_av
+          CASE ( 'p' )
+             READ ( 13 )  p
+          CASE ( 'p_av' )
+             ALLOCATE( p_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  p_av
+          CASE ( 'pc_av' )
+             ALLOCATE( pc_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  pc_av
+          CASE ( 'pr_av' )
+             ALLOCATE( pr_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  pr_av
+          CASE ( 'pt' )
+             READ ( 13 )  pt
+          CASE ( 'pt_av' )
+             ALLOCATE( pt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  pt_av
+          CASE ( 'pt_m' )
+             READ ( 13 )  pt_m
+          CASE ( 'q' )
+             READ ( 13 )  q
+          CASE ( 'q_av' )
+             ALLOCATE( q_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  q_av
+          CASE ( 'q_m' )
+             READ ( 13 )  q_m
+          CASE ( 'ql' )
+             READ ( 13 )  ql
+          CASE ( 'ql_av' )
+             ALLOCATE( ql_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  ql_av
+          CASE ( 'ql_c_av' )
+             ALLOCATE( ql_c_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  ql_c_av
+          CASE ( 'ql_v_av' )
+             ALLOCATE( ql_v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  ql_v_av
+          CASE ( 'ql_vp_av' )
+             ALLOCATE( ql_vp_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  ql_vp_av
+          CASE ( 'qs' )
+             READ ( 13 )  qs
+          CASE ( 'qsws' )
+             READ ( 13 )  qsws
+          CASE ( 'qsws_m' )
+             READ ( 13 )  qsws_m
+          CASE ( 'qv_av' )
+             ALLOCATE( qv_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  qv_av
+          CASE ( 'random_iv' )
+             READ ( 13 )  random_iv
+             READ ( 13 )  random_iy
+          CASE ( 'rif' )
+             READ ( 13 )  rif
+          CASE ( 'rif_m' )
+             READ ( 13 )  rif_m
+          CASE ( 's_av' )
+             ALLOCATE( s_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  s_av
+          CASE ( 'shf' )
+             READ ( 13 )  shf
+          CASE ( 'shf_m' )
+             READ ( 13 )  shf_m
+          CASE ( 'spectrum_x' )
+             READ ( 13 )  spectrum_x
+          CASE ( 'spectrum_y' )
+             READ ( 13 )  spectrum_y
+          CASE ( 'ts' )
+             READ ( 13 )  ts
+          CASE ( 'ts_av' )
+             ALLOCATE( ts_av(nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  ts_av
+          CASE ( 'u' )
+             READ ( 13 )  u
+          CASE ( 'u_av' )
+             ALLOCATE( u_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  u_av
+          CASE ( 'u_m' )
+             READ ( 13 )  u_m
+          CASE ( 'us' )
+             READ ( 13 )  us
+          CASE ( 'usws' )
+             READ ( 13 )  usws
+          CASE ( 'usws_m' )
+             READ ( 13 )  usws_m
+          CASE ( 'us_av' )
+             ALLOCATE( us_av(nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  us_av
+          CASE ( 'v' )
+             READ ( 13 )  v
+          CASE ( 'volume_flow_area' )
+             READ ( 13 )  volume_flow_area
+          CASE ( 'volume_flow_initial' )
+             READ ( 13 )  volume_flow_initial
+          CASE ( 'v_av' )
+             ALLOCATE( v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  v_av
+          CASE ( 'v_m' )
+             READ (13 )   v_m
+          CASE ( 'vpt' )
+             READ ( 13 )  vpt
+          CASE ( 'vpt_av' )
+             ALLOCATE( vpt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  vpt_av
+          CASE ( 'vpt_m' )
+             READ ( 13 )  vpt_m
+          CASE ( 'vsws' )
+             READ ( 13 )  vsws
+          CASE ( 'vsws_m' )
+             READ ( 13 )  vsws_m
+          CASE ( 'w' )
+             READ ( 13 )  w
+          CASE ( 'w_av' )
+             ALLOCATE( w_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+             READ ( 13 )  w_av
+          CASE ( 'w_m' )
+             READ ( 13 )  w_m
+          CASE ( 'z0' )
+             READ ( 13 )  z0
+
+          CASE ( 'cross_linecolors' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_linecolors
+             ELSE
+                READ ( 13 )  idum
+             ENDIF
+          CASE ( 'cross_linestyles' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_linestyles
+             ELSE
+                READ ( 13 )  idum
+             ENDIF
+          CASE ( 'cross_normalized_x' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_normalized_x
+             ELSE
+                READ ( 13 )  chdum10
+             ENDIF
+          CASE ( 'cross_normalized_y' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_normalized_y
+             ELSE
+                READ ( 13 )  chdum10
+             ENDIF
+          CASE ( 'cross_normx_factor' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_normx_factor
+             ELSE
+                READ ( 13 )  rdum
+             ENDIF
+          CASE ( 'cross_normy_factor' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_normy_factor
+             ELSE
+                READ ( 13 )  rdum
+             ENDIF
+          CASE ( 'cross_profiles' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_profiles
+             ELSE
+                READ ( 13 )  chdum100
+             ENDIF
+          CASE ( 'cross_profile_n_coun' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_profile_number_count
+             ELSE
+                READ ( 13 )  idum(1:crmax)
+             ENDIF
+          CASE ( 'cross_profile_number' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_profile_numbers
+             ELSE
+                READ ( 13 )  idum
+             ENDIF
+          CASE ( 'cross_uxmax' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_uxmax
+             ELSE
+                READ ( 13 )  rdum(1:crmax)
+             ENDIF
+          CASE ( 'cross_uxmax_computed' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_uxmax_computed
+             ELSE
+                READ ( 13 )  rdum(1:crmax)
+             ENDIF
+          CASE ( 'cross_uxmax_normaliz' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_uxmax_normalized
+             ELSE
+                READ ( 13 )  rdum(1:crmax)
+             ENDIF
+          CASE ( 'cross_uxmax_norm_com' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_uxmax_normalized_computed
+             ELSE
+                READ ( 13 )  rdum(1:crmax)
+             ENDIF
+          CASE ( 'cross_uxmin' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_uxmin
+             ELSE
+                READ ( 13 )  rdum(1:crmax)
+             ENDIF
+          CASE ( 'cross_uxmin_computed' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_uxmin_computed
+             ELSE
+                READ ( 13 )  rdum(1:crmax)
+             ENDIF
+          CASE ( 'cross_uxmin_normaliz' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_uxmin_normalized
+             ELSE
+                READ ( 13 )  rdum(1:crmax)
+             ENDIF
+          CASE ( 'cross_uxmin_norm_com' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_uxmin_normalized_computed
+             ELSE
+                READ ( 13 )  rdum(1:crmax)
+             ENDIF
+          CASE ( 'cross_uymax' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_uymax
+             ELSE
+                READ ( 13 )  rdum(1:crmax)
+             ENDIF
+          CASE ( 'cross_uymin' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_uymin
+             ELSE
+                READ ( 13 )  rdum(1:crmax)
+             ENDIF
+          CASE ( 'cross_xtext' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  cross_xtext
+             ELSE
+                READ ( 13 )  chdum40
+             ENDIF
+          CASE ( 'dopr_crossindex' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  dopr_crossindex
+             ELSE
+                READ ( 13 )  idum(1:100)
+             ENDIF
+          CASE ( 'dopr_time_count' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  dopr_time_count
+             ELSE
+                READ ( 13 )  idum1
+             ENDIF
+          CASE ( 'hom_sum' )
+             READ ( 13 )  hom_sum
+          CASE ( 'profile_columns' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  profile_columns
+             ELSE
+                READ ( 13 )  idum1
+             ENDIF
+          CASE ( 'profile_number' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  profile_number
+             ELSE
+                READ ( 13 )  idum1
+             ENDIF
+          CASE ( 'profile_rows' )
+             IF ( use_prior_plot1d_parameters )  THEN
+                READ ( 13 )  profile_rows
+             ELSE
+                READ ( 13 )  idum1
+             ENDIF
+
+          CASE DEFAULT
+             PRINT*, '+++ init_3d_model: unknown field named "', &
+                     TRIM( field_chr ), '" found in'
+             PRINT*, '                   data from prior run on PE ', myid
+             CALL local_stop
+
+       END SELECT
+!
+!--    Read next character string
+       READ ( 13 )  field_chr
+
+    ENDDO
+
+    DEALLOCATE( chdum10, chdum40, chdum100, idum, rdum )
+
+!
+!-- End of time measuring for reading binary data
+    CALL cpu_log( log_point_s(14), 'read_3d_binary', 'stop' )
+
+ END SUBROUTINE read_3d_binary
Index: palm/trunk/SOURCE/read_restart_data_mod.f90
===================================================================
--- palm/trunk/SOURCE/read_restart_data_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2478 +1,0 @@
-!> @file read_restart_data_mod.f90
-!------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! revised output of surface data via MPI-IO for better performance,
-! therefore binary version number has changed
-!
-! 4848 2021-01-21 15:51:51Z gronemeier
-! bugfix: removed syn_turb_gen from restart files
-!
-! 4845 2021-01-18 11:15:37Z raasch
-! arrays removed that were required for radiation boundary conditions
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! include time_indoor into restart mechanism
-!
-! 4777 2020-11-06 14:50:49Z raasch
-! bugfix for reading spectra data with MPI-I/O (they are global arrays!)
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4617 2020-07-22 09:48:50Z raasch
-! check, if boundary conditions in the prerun are both set to cyclic
-!
-! 4590 2020-07-06 14:34:59Z suehring
-! Bugfix in allocation of hom and hom_sum in case of mpi-io restart when
-! chemistry or salsa are employed
-!
-! 4580 2020-06-29 07:54:21Z raasch
-! data handling with MPI-IO for cyclic-fill added (so far only for global data)
-!
-! 4564 2020-06-12 14:03:36Z raasch
-! Vertical nesting method of Huq et al. (2019) removed
-!
-! 4539 2020-05-18 14:05:17Z raasch
-! location message added
-!
-! 4536 2020-05-17 17:24:13Z raasch
-! binary version incremented
-!
-! 4534 2020-05-14 18:35:22Z raasch
-! adjustments for I/O on reduced number of cores using shared memory MPI
-!
-! 4518 2020-05-04 15:44:28Z suehring
-! Move input of diagnostic output quantities to doq_rrd_local
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! qsurf and ssurf added
-!
-! 4498 2020-04-15 14:26:31Z raasch
-! argument removed from rd_mpi_io_open
-!
-! 4496 2020-04-15 08:37:26Z raasch
-! bugfix: MPI barrier removed, coupling character added to input filename
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4435 2020-03-03 10:38:41Z raasch
-! bugfix for message that reports about files that are read from in case that the virtual PE grid
-! has chenged (in case of large number of files format was exceeded), detailed messages about the
-! files are now output to the debug file
-!
-! 4431 2020-02-27 23:23:01Z gronemeier
-! added u_center_av, v_center_av, wspeed_av
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Change automatic arrays to allocatable ones in rrd_local, in order to avoid
-! memory problems due to too small stack size for large jobs with intel
-! compiler. (J.Resler)
-!
-! 4331 2019-12-10 18:25:02Z suehring
-! Enable restart data for 2-m potential temperature output
-!
-! 4301 2019-11-22 12:09:09Z oliver.maas
-! removed recycling_yshift
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod and increased binary version
-!
-! 4146 2019-08-07 07:47:36Z gronemeier
-! Corrected "Former revisions" section
-!
-! 4131 2019-08-02 11:06:18Z monakurppa
-! Allocate hom and hom_sum to allow profile output for salsa variables.
-!
-! 4101 2019-07-17 15:14:26Z gronemeier
-! remove old_dt
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! input of uu_av, vv_av, ww_av added
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! bugfix for r3998, allocation of 3d temporary arrays of various dimensions revised
-!
-! 3998 2019-05-23 13:38:11Z suehring
-! Formatting adjustment
-!
-! 3994 2019-05-22 18:08:09Z suehring
-! output of turbulence intensity added
-!
-! 3988 2019-05-22 11:32:37Z kanani
-! + time_virtual_measurement (to enable steering of output interval)
-!
-! 3936 2019-04-26 15:38:02Z kanani
-! Enable time-averaged output of theta_2m* with restarts
-!
-! 3767 2019-02-27 08:18:02Z raasch
-! unused variables removed from rrd-subroutines parameter list
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! first argument removed from module_interface_rrd_*
-!
-! 3668 2019-01-14 12:49:24Z maronga
-! Removed most_method and increased binary version
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Implementation of the PALM module interface
-!
-! 2894 2018-03-15 09:17:58Z Giersch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Reads restart data from restart-file(s) (binary format).
-!>
-!> @todo: Revise max_pr_cs (profiles for chemistry)
-!> @todo: Modularize reading of restart data for diagnostic quantities, which
-!>        is not possible with the current module-interface structure
-!------------------------------------------------------------------------------!
- MODULE read_restart_data_mod
-
-
-    USE arrays_3d,                                                             &
-        ONLY:  inflow_damping_factor, mean_inflow_profiles, pt_init,           &
-               q_init, ref_state, sa_init, s_init, u_init, ug, v_init, vg,     &
-               e, kh, km, p, pt, q, ql, s, u, v, vpt, w
-
-    USE averaging
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    USE chem_modules,                                                                              &
-       ONLY: max_pr_cs
-
-    USE control_parameters
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point_s
-
-    USE grid_variables,                                                        &
-        ONLY:  dx, dy
-
-    USE gust_mod,                                                                                  &
-        ONLY:  gust_module_enabled
-
-    USE indices,                                                               &
-        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, nx_on_file, ny, nys, nysg, nyn, &
-               nyng, ny_on_file, nz, nzb, nzt
-
-    USE indoor_model_mod,                                                                          &
-        ONLY:  time_indoor
-
-    USE kinds
-
-    USE model_1d_mod,                                                          &
-        ONLY:  damp_level_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
-
-    USE module_interface,                                                      &
-        ONLY:  module_interface_rrd_global,                                    &
-               module_interface_rrd_local
-
-    USE netcdf_interface,                                                      &
-        ONLY:  netcdf_precision, output_for_t0
-
-    USE particle_attributes,                                                                       &
-        ONLY:  particle_advection
-
-    USE pegrid
-
-    USE radiation_model_mod,                                                   &
-        ONLY:  time_radiation
-
-    USE random_function_mod,                                                   &
-        ONLY:  random_iv, random_iy
-
-    USE random_generator_parallel,                                             &
-        ONLY:  id_random_array, seq_random_array
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_check_array, rd_mpi_io_close, rd_mpi_io_open, rrd_mpi_io,                 &
-               rrd_mpi_io_global_array
-
-    USE spectra_mod,                                                           &
-        ONLY:  average_count_sp, spectrum_x, spectrum_y
-
-    USE surface_mod,                                                           &
-        ONLY :  surface_rrd_local
-
-    USE statistics,                                                            &
-        ONLY:  statistic_regions, hom, hom_sum, pr_palm, u_max, u_max_ijk,     &
-               v_max, v_max_ijk, w_max, w_max_ijk, z_i
-
-    USE user,                                                                                      &
-        ONLY:  user_module_enabled
-
-    USE virtual_measurement_mod,                                               &
-        ONLY:  time_virtual_measurement
-
-
-    IMPLICIT NONE
-
-
-    INTERFACE rrd_global
-       MODULE PROCEDURE rrd_global
-    END INTERFACE rrd_global
-
-    INTERFACE rrd_read_parts_of_global
-       MODULE PROCEDURE rrd_read_parts_of_global
-    END INTERFACE rrd_read_parts_of_global
-
-    INTERFACE rrd_local
-       MODULE PROCEDURE rrd_local
-    END INTERFACE rrd_local
-
-    INTERFACE rrd_skip_global
-       MODULE PROCEDURE rrd_skip_global
-    END INTERFACE rrd_skip_global
-
-
-    PUBLIC rrd_global, rrd_read_parts_of_global, rrd_local, rrd_skip_global
-
-
- CONTAINS
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads values of global control variables from restart-file (binary format)
-!> created by PE0 of the previous run
-!------------------------------------------------------------------------------!
- SUBROUTINE rrd_global
-
-
-    CHARACTER(LEN=10) ::  binary_version_global  !<
-    CHARACTER(LEN=10) ::  version_on_file        !<
-    CHARACTER(LEN=20) ::  tmp_name               !< temporary variable
-
-    INTEGER ::  i                                !< loop index
-
-    LOGICAL ::  array_found                      !<
-    LOGICAL ::  found                            !<
-
-
-    CALL location_message( 'read global restart data', 'start' )
-
-!
-!-- Caution: When any of the read instructions have been changed, the
-!-- -------  version number stored in the variable binary_version_global has
-!--          to be increased. The same changes must also be done in wrd_write_global.
-    binary_version_global = '5.3'
-
-    IF ( TRIM( restart_data_format_input ) == 'fortran_binary' )  THEN
-!
-!--    Input in Fortran binary format
-       CALL check_open( 13 )
-!
-!--    Make version number check first
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-       READ ( 13 )  version_on_file
-
-       IF ( TRIM( version_on_file ) /= TRIM( binary_version_global ) )  THEN
-          WRITE( message_string, * ) 'version mismatch concerning ',           &
-                                     'binary_version_global:',                 &
-                                     '&version on file    = "',                &
-                                     TRIM( version_on_file ), '"',             &
-                                     '&version on program = "',                &
-                                     TRIM( binary_version_global ), '"'
-          CALL message( 'rrd_global', 'PA0296', 1, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--    Read number of PEs and horizontal index bounds of all PEs used in the
-!--    previous run
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       IF ( TRIM( restart_string(1:length) ) /= 'numprocs' )  THEN
-          WRITE( message_string, * ) 'numprocs not found in data from prior ', &
-                                     'run on PE ', myid
-          CALL message( 'rrd_global', 'PA0297', 1, 2, 0, 6, 0 )
-       ENDIF
-       READ ( 13 )  numprocs_previous_run
-
-       IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
-          ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
-       ENDIF
-
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       IF ( restart_string(1:length) /= 'hor_index_bounds' )  THEN
-          WRITE( message_string, * ) 'hor_index_bounds not found in data ',    &
-                                     'from prior run on PE ', myid
-          CALL message( 'rrd_global', 'PA0298', 1, 2, 0, 6, 0 )
-       ENDIF
-       READ ( 13 )  hor_index_bounds_previous_run
-
-!
-!--    Read vertical number of gridpoints and number of different areas used
-!--    for computing statistics. Allocate arrays depending on these values,
-!--    which are needed for the following read instructions.
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       IF ( restart_string(1:length) /= 'nz' )  THEN
-          WRITE( message_string, * ) 'nz not found in data from prior run ',   &
-                                     'on PE ', myid
-          CALL message( 'rrd_global', 'PA0299', 1, 2, 0, 6, 0 )
-       ENDIF
-       READ ( 13 )  nz
-
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       IF ( restart_string(1:length) /= 'max_pr_user' )  THEN
-          WRITE( message_string, * ) 'max_pr_user not found in data from ',    &
-                                     'prior run on PE ', myid
-          CALL message( 'rrd_global', 'PA0300', 1, 2, 0, 6, 0 )
-       ENDIF
-       READ ( 13 )  max_pr_user    ! This value is checked against the number of
-                                   ! user profiles given for the current run
-                                   ! in routine user_parin (it has to match)
-
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       IF ( restart_string(1:length) /= 'statistic_regions' )  THEN
-          WRITE( message_string, * ) 'statistic_regions not found in data ',   &
-                                     'from prior run on PE ', myid
-          CALL message( 'rrd_global', 'PA0301', 1, 2, 0, 6, 0 )
-       ENDIF
-       READ ( 13 )  statistic_regions
-
-!
-!--    The following global arrays (better to say, they have the same size and values on each
-!--    subdomain) are by default allocated in routine parin, but not in case of restarts!
-       IF ( .NOT. ALLOCATED( ug ) )  THEN
-          ALLOCATE( ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1),                                        &
-                    v_init(0:nz+1), pt_init(0:nz+1), q_init(0:nz+1),                               &
-                    ref_state(0:nz+1), s_init(0:nz+1), sa_init(0:nz+1),                            &
-                    hom(0:nz+1,2,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:statistic_regions),  &
-                    hom_sum(0:nz+1,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:statistic_regions) )
-       ENDIF
-
-!
-!--    Now read all control parameters:
-
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       DO WHILE ( restart_string(1:length) /= 'binary_version_local' )
-
-          found = .FALSE.
-
-          SELECT CASE ( restart_string(1:length) )
-
-             CASE ( 'advected_distance_x' )
-                READ ( 13 )  advected_distance_x
-             CASE ( 'advected_distance_y' )
-                READ ( 13 )  advected_distance_y
-             CASE ( 'alpha_surface' )
-                READ ( 13 )  alpha_surface
-             CASE ( 'average_count_pr' )
-                READ ( 13 )  average_count_pr
-             CASE ( 'average_count_sp' )
-                READ ( 13 )  average_count_sp
-             CASE ( 'average_count_3d' )
-                READ ( 13 )  average_count_3d
-             CASE ( 'bc_e_b' )
-                READ ( 13 )  bc_e_b
-             CASE ( 'bc_lr' )
-                READ ( 13 )  bc_lr
-             CASE ( 'bc_ns' )
-                READ ( 13 )  bc_ns
-             CASE ( 'bc_p_b' )
-                READ ( 13 )  bc_p_b
-             CASE ( 'bc_p_t' )
-                READ ( 13 )  bc_p_t
-             CASE ( 'bc_pt_b' )
-                READ ( 13 )  bc_pt_b
-             CASE ( 'bc_pt_t' )
-                READ ( 13 )  bc_pt_t
-             CASE ( 'bc_pt_t_val' )
-                READ ( 13 )  bc_pt_t_val
-             CASE ( 'bc_q_b' )
-                READ ( 13 )  bc_q_b
-             CASE ( 'bc_q_t' )
-                READ ( 13 )  bc_q_t
-             CASE ( 'bc_q_t_val' )
-                READ ( 13 )  bc_q_t_val
-             CASE ( 'bc_s_b' )
-                READ ( 13 )  bc_s_b
-             CASE ( 'bc_s_t' )
-                READ ( 13 )  bc_s_t
-             CASE ( 'bc_uv_b' )
-                READ ( 13 )  bc_uv_b
-             CASE ( 'bc_uv_t' )
-                READ ( 13 )  bc_uv_t
-             CASE ( 'building_height' )
-                READ ( 13 )  building_height
-             CASE ( 'building_length_x' )
-                READ ( 13 )  building_length_x
-             CASE ( 'building_length_y' )
-                READ ( 13 )  building_length_y
-             CASE ( 'building_wall_left' )
-                READ ( 13 )  building_wall_left
-             CASE ( 'building_wall_south' )
-                READ ( 13 )  building_wall_south
-             CASE ( 'call_psolver_at_all_substeps' )
-                READ ( 13 )  call_psolver_at_all_substeps
-             CASE ( 'canyon_height' )
-                READ ( 13 )  canyon_height
-             CASE ( 'canyon_wall_left' )
-                READ ( 13 )  canyon_wall_left
-             CASE ( 'canyon_wall_south' )
-                READ ( 13 )  canyon_wall_south
-             CASE ( 'canyon_width_x' )
-                READ ( 13 )  canyon_width_x
-             CASE ( 'canyon_width_y' )
-                READ ( 13 )  canyon_width_y
-             CASE ( 'cfl_factor' )
-                READ ( 13 )  cfl_factor
-             CASE ( 'cloud_droplets' )
-                READ ( 13 )  cloud_droplets
-             CASE ( 'collective_wait' )
-                READ ( 13 )  collective_wait
-             CASE ( 'conserve_volume_flow' )
-                READ ( 13 )  conserve_volume_flow
-             CASE ( 'conserve_volume_flow_mode' )
-                READ ( 13 )  conserve_volume_flow_mode
-             CASE ( 'constant_flux_layer' )
-                READ ( 13 )  constant_flux_layer
-             CASE ( 'coupling_start_time' )
-                READ ( 13 )  coupling_start_time
-             CASE ( 'current_timestep_number' )
-                READ ( 13 )  current_timestep_number
-             CASE ( 'cycle_mg' )
-                READ ( 13 )  cycle_mg
-             CASE ( 'damp_level_1d' )
-                READ ( 13 )  damp_level_1d
-             CASE ( 'origin_date_time' )
-                READ ( 13 )  origin_date_time
-             CASE ( 'dissipation_1d' )
-                READ ( 13 )  dissipation_1d
-             CASE ( 'do2d_xy_time_count' )
-                READ ( 13 )  do2d_xy_time_count
-             CASE ( 'do2d_xz_time_count' )
-                READ ( 13 )  do2d_xz_time_count
-             CASE ( 'do2d_yz_time_count' )
-                READ ( 13 )  do2d_yz_time_count
-             CASE ( 'do3d_time_count' )
-                READ ( 13 )  do3d_time_count
-             CASE ( 'dp_external' )
-                READ ( 13 )  dp_external
-             CASE ( 'dp_level_b' )
-                READ ( 13 )  dp_level_b
-             CASE ( 'dp_smooth' )
-                READ ( 13 )  dp_smooth
-             CASE ( 'dpdxy' )
-                READ ( 13 )  dpdxy
-             CASE ( 'dt_3d' )
-                READ ( 13 )  dt_3d
-             CASE ( 'dt_pr_1d' )
-                READ ( 13 )  dt_pr_1d
-             CASE ( 'dt_run_control_1d' )
-                READ ( 13 )  dt_run_control_1d
-             CASE ( 'dx' )
-                READ ( 13 )  dx
-             CASE ( 'dy' )
-                READ ( 13 )  dy
-             CASE ( 'dz' )
-                READ ( 13 )  dz
-             CASE ( 'dz_max' )
-                READ ( 13 )  dz_max
-             CASE ( 'dz_stretch_factor' )
-                READ ( 13 )  dz_stretch_factor
-             CASE ( 'dz_stretch_factor_array' )
-                READ ( 13 )  dz_stretch_factor_array
-             CASE ( 'dz_stretch_level' )
-                READ ( 13 )  dz_stretch_level
-             CASE ( 'dz_stretch_level_end' )
-                READ ( 13 )  dz_stretch_level_end
-             CASE ( 'dz_stretch_level_start' )
-                READ ( 13 )  dz_stretch_level_start
-             CASE ( 'e_min' )
-                READ ( 13 )  e_min
-             CASE ( 'end_time_1d' )
-                READ ( 13 )  end_time_1d
-             CASE ( 'fft_method' )
-                READ ( 13 )  fft_method
-             CASE ( 'first_call_lpm' )
-                READ ( 13 )  first_call_lpm
-             CASE ( 'galilei_transformation' )
-                READ ( 13 )  galilei_transformation
-             CASE ( 'hom' )
-                READ ( 13 )  hom
-             CASE ( 'hom_sum' )
-                READ ( 13 )  hom_sum
-             CASE ( 'humidity' )
-                READ ( 13 )  humidity
-             CASE ( 'inflow_damping_factor' )
-                IF ( .NOT. ALLOCATED( inflow_damping_factor ) )  THEN
-                   ALLOCATE( inflow_damping_factor(0:nz+1) )
-                ENDIF
-                READ ( 13 )  inflow_damping_factor
-             CASE ( 'inflow_damping_height' )
-                READ ( 13 )  inflow_damping_height
-             CASE ( 'inflow_damping_width' )
-                READ ( 13 )  inflow_damping_width
-             CASE ( 'inflow_disturbance_begin' )
-                READ ( 13 )  inflow_disturbance_begin
-             CASE ( 'inflow_disturbance_end' )
-                READ ( 13 )  inflow_disturbance_end
-             CASE ( 'km_constant' )
-                READ ( 13 )  km_constant
-             CASE ( 'large_scale_forcing' )
-                READ ( 13 )  large_scale_forcing
-             CASE ( 'large_scale_subsidence' )
-                READ ( 13 )  large_scale_subsidence
-             CASE ( 'latitude' )
-                READ ( 13 )  latitude
-             CASE ( 'longitude' )
-                READ ( 13 )  longitude
-             CASE ( 'loop_optimization' )
-                READ ( 13 )  loop_optimization
-             CASE ( 'masking_method' )
-                READ ( 13 )  masking_method
-             CASE ( 'mean_inflow_profiles' )
-                IF ( .NOT. ALLOCATED( mean_inflow_profiles ) )  THEN
-                   ALLOCATE( mean_inflow_profiles(0:nz+1,1:num_mean_inflow_profiles) )
-                ENDIF
-                READ ( 13 )  mean_inflow_profiles
-             CASE ( 'mg_cycles' )
-                READ ( 13 )  mg_cycles
-             CASE ( 'mg_switch_to_pe0_level' )
-                READ ( 13 )  mg_switch_to_pe0_level
-             CASE ( 'mixing_length_1d' )
-                READ ( 13 )  mixing_length_1d
-             CASE ( 'momentum_advec' )
-                READ ( 13 )  momentum_advec
-             CASE ( 'netcdf_precision' )
-                READ ( 13 )  netcdf_precision
-             CASE ( 'neutral' )
-                READ ( 13 )  neutral
-             CASE ( 'ngsrb' )
-                READ ( 13 )  ngsrb
-             CASE ( 'nsor' )
-                READ ( 13 )  nsor
-             CASE ( 'nsor_ini' )
-                READ ( 13 )  nsor_ini
-             CASE ( 'nudging' )
-                READ ( 13 )  nudging
-             CASE ( 'num_leg' )
-                READ ( 13 )  num_leg
-             CASE ( 'nx' )
-                READ ( 13 )  nx
-                nx_on_file = nx
-             CASE ( 'ny' )
-                READ ( 13 )  ny
-                ny_on_file = ny
-             CASE ( 'ocean_mode' )
-                READ ( 13 )  ocean_mode
-             CASE ( 'omega' )
-                READ ( 13 )  omega
-             CASE ( 'omega_sor' )
-                READ ( 13 )  omega_sor
-             CASE ( 'output_for_t0' )
-                READ (13)    output_for_t0
-             CASE ( 'passive_scalar' )
-                READ ( 13 )  passive_scalar
-             CASE ( 'prandtl_number' )
-                READ ( 13 )  prandtl_number
-             CASE ( 'psolver' )
-                READ ( 13 )  psolver
-             CASE ( 'pt_damping_factor' )
-                READ ( 13 )  pt_damping_factor
-             CASE ( 'pt_damping_width' )
-                READ ( 13 )  pt_damping_width
-             CASE ( 'pt_init' )
-                READ ( 13 )  pt_init
-             CASE ( 'pt_reference' )
-                READ ( 13 )  pt_reference
-             CASE ( 'pt_surface' )
-                READ ( 13 )  pt_surface
-             CASE ( 'pt_surface_initial_change' )
-                READ ( 13 )  pt_surface_initial_change
-             CASE ( 'pt_vertical_gradient' )
-                READ ( 13 )  pt_vertical_gradient
-             CASE ( 'pt_vertical_gradient_level' )
-                READ ( 13 )  pt_vertical_gradient_level
-             CASE ( 'pt_vertical_gradient_level_ind' )
-                READ ( 13 )  pt_vertical_gradient_level_ind
-             CASE ( 'q_init' )
-                READ ( 13 )  q_init
-             CASE ( 'q_surface' )
-                READ ( 13 )  q_surface
-             CASE ( 'q_surface_initial_change' )
-                READ ( 13 )  q_surface_initial_change
-             CASE ( 'q_vertical_gradient' )
-                READ ( 13 )  q_vertical_gradient
-             CASE ( 'q_vertical_gradient_level' )
-                READ ( 13 )  q_vertical_gradient_level
-             CASE ( 'q_vertical_gradient_level_ind' )
-                READ ( 13 )  q_vertical_gradient_level_ind
-             CASE ( 'random_generator' )
-                READ ( 13 )  random_generator
-             CASE ( 'random_heatflux' )
-                READ ( 13 )  random_heatflux
-             CASE ( 'rans_mode' )
-                READ ( 13 )  rans_mode
-             CASE ( 'rayleigh_damping_factor' )
-                READ ( 13 )  rayleigh_damping_factor
-             CASE ( 'rayleigh_damping_height' )
-                READ ( 13 )  rayleigh_damping_height
-             CASE ( 'recycling_width' )
-                READ ( 13 )  recycling_width
-             CASE ( 'ref_state' )
-                READ ( 13 )  ref_state
-             CASE ( 'reference_state' )
-                READ ( 13 )  reference_state
-             CASE ( 'residual_limit' )
-                READ ( 13 )  residual_limit
-             CASE ( 'roughness_length' )
-                READ ( 13 )  roughness_length
-             CASE ( 'run_coupled' )
-                READ ( 13 )  run_coupled
-             CASE ( 'runnr' )
-                READ ( 13 )  runnr
-             CASE ( 's_init' )
-                READ ( 13 )  s_init
-             CASE ( 's_surface' )
-                READ ( 13 )  s_surface
-             CASE ( 's_surface_initial_change' )
-                READ ( 13 )  s_surface_initial_change
-             CASE ( 's_vertical_gradient' )
-                READ ( 13 )  s_vertical_gradient
-             CASE ( 's_vertical_gradient_level' )
-                READ ( 13 )  s_vertical_gradient_level
-             CASE ( 's_vertical_gradient_level_ind' )
-                READ ( 13 )  s_vertical_gradient_level_ind
-             CASE ( 'scalar_advec' )
-                READ ( 13 )  scalar_advec
-             CASE ( 'simulated_time' )
-                READ ( 13 )  simulated_time
-             CASE ( 'spectrum_x' )
-                IF ( .NOT. ALLOCATED( spectrum_x ) )  THEN
-                   ALLOCATE( spectrum_x( 1:nx/2, 1:100, 1:10 ) )
-                ENDIF
-                READ ( 13 )  spectrum_x
-             CASE ( 'spectrum_y' )
-                IF ( .NOT. ALLOCATED( spectrum_y ) )  THEN
-                   ALLOCATE( spectrum_y( 1:ny/2, 1:100, 1:10 ) )
-                ENDIF
-                READ ( 13 )  spectrum_y
-             CASE ( 'spinup_time' )
-                READ ( 13 )  spinup_time
-             CASE ( 'subs_vertical_gradient' )
-                READ ( 13 )  subs_vertical_gradient
-             CASE ( 'subs_vertical_gradient_level' )
-                READ ( 13 )  subs_vertical_gradient_level
-             CASE ( 'subs_vertical_gradient_level_i' )
-                READ ( 13 )  subs_vertical_gradient_level_i
-             CASE ( 'surface_heatflux' )
-                READ ( 13 )  surface_heatflux
-             CASE ( 'surface_pressure' )
-                READ ( 13 )  surface_pressure
-             CASE ( 'surface_scalarflux' )
-                READ ( 13 )  surface_scalarflux
-             CASE ( 'surface_waterflux' )
-                READ ( 13 )  surface_waterflux
-             CASE ( 'time_coupling' )
-                READ ( 13 )  time_coupling
-             CASE ( 'time_disturb' )
-                READ ( 13 )  time_disturb
-             CASE ( 'time_do2d_xy' )
-                READ ( 13 )  time_do2d_xy
-             CASE ( 'time_do2d_xz' )
-                READ ( 13 )  time_do2d_xz
-             CASE ( 'time_do2d_yz' )
-                READ ( 13 )  time_do2d_yz
-             CASE ( 'time_do3d' )
-                READ ( 13 )  time_do3d
-             CASE ( 'time_do_av' )
-                READ ( 13 )  time_do_av
-             CASE ( 'time_do_sla' )
-                READ ( 13 )  time_do_sla
-             CASE ( 'time_domask' )
-                READ ( 13 )  time_domask
-             CASE ( 'time_dopr' )
-                READ ( 13 )  time_dopr
-             CASE ( 'time_dopr_av' )
-                READ ( 13 )  time_dopr_av
-             CASE ( 'time_dopr_listing' )
-                READ ( 13 )  time_dopr_listing
-             CASE ( 'time_dopts' )
-                READ ( 13 )  time_dopts
-             CASE ( 'time_dosp' )
-                READ ( 13 )  time_dosp
-             CASE ( 'time_dots' )
-                READ ( 13 )  time_dots
-             CASE ( 'time_indoor' )
-                READ ( 13 )  time_indoor
-             CASE ( 'time_radiation' )
-                READ ( 13 )  time_radiation
-             CASE ( 'time_restart' )
-                READ ( 13 )  time_restart
-             CASE ( 'time_run_control' )
-                READ ( 13 )  time_run_control
-             CASE ( 'time_since_reference_point' )
-                READ ( 13 )  time_since_reference_point
-             CASE ( 'time_virtual_measurement' )
-                READ ( 13 )  time_virtual_measurement
-             CASE ( 'timestep_scheme' )
-                READ ( 13 )  timestep_scheme
-             CASE ( 'top_heatflux' )
-                READ ( 13 )  top_heatflux
-             CASE ( 'top_momentumflux_u' )
-                READ ( 13 )  top_momentumflux_u
-             CASE ( 'top_momentumflux_v' )
-                READ ( 13 )  top_momentumflux_v
-             CASE ( 'top_scalarflux' )
-                READ ( 13 )  top_scalarflux
-             CASE ( 'topography' )
-                READ ( 13 )  topography
-             CASE ( 'topography_grid_convention' )
-                READ ( 13 )  topography_grid_convention
-             CASE ( 'tsc' )
-                READ ( 13 )  tsc
-             CASE ( 'tunnel_height' )
-                READ ( 13 )  tunnel_height
-             CASE ( 'tunnel_length' )
-                READ ( 13 )  tunnel_length
-             CASE ( 'tunnel_wall_depth' )
-                READ ( 13 )  tunnel_wall_depth
-             CASE ( 'tunnel_width_x' )
-                READ ( 13 )  tunnel_width_x
-             CASE ( 'tunnel_width_y' )
-                READ ( 13 )  tunnel_width_y
-             CASE ( 'turbulence_closure' )
-                READ ( 13 )  turbulence_closure
-             CASE ( 'turbulent_inflow' )
-                READ ( 13 )  turbulent_inflow
-             CASE ( 'u_bulk' )
-                READ ( 13 )  u_bulk
-             CASE ( 'u_init' )
-                READ ( 13 )  u_init
-             CASE ( 'u_max' )
-                READ ( 13 )  u_max
-             CASE ( 'u_max_ijk' )
-                READ ( 13 )  u_max_ijk
-             CASE ( 'ug' )
-                READ ( 13 )  ug
-             CASE ( 'ug_surface' )
-                READ ( 13 )  ug_surface
-             CASE ( 'ug_vertical_gradient' )
-                READ ( 13 )  ug_vertical_gradient
-             CASE ( 'ug_vertical_gradient_level' )
-                READ ( 13 )  ug_vertical_gradient_level
-             CASE ( 'ug_vertical_gradient_level_ind' )
-                READ ( 13 )  ug_vertical_gradient_level_ind
-             CASE ( 'use_surface_fluxes' )
-                READ ( 13 )  use_surface_fluxes
-             CASE ( 'use_top_fluxes' )
-                READ ( 13 )  use_top_fluxes
-             CASE ( 'use_ug_for_galilei_tr' )
-                READ ( 13 )  use_ug_for_galilei_tr
-             CASE ( 'use_upstream_for_tke' )
-                READ ( 13 )  use_upstream_for_tke
-             CASE ( 'v_bulk' )
-                READ ( 13 )  v_bulk
-             CASE ( 'v_init' )
-                READ ( 13 )  v_init
-             CASE ( 'v_max' )
-                READ ( 13 )  v_max
-             CASE ( 'v_max_ijk' )
-                READ ( 13 )  v_max_ijk
-             CASE ( 'vg' )
-                READ ( 13 )  vg
-             CASE ( 'vg_surface' )
-                READ ( 13 )  vg_surface
-             CASE ( 'vg_vertical_gradient' )
-                READ ( 13 )  vg_vertical_gradient
-             CASE ( 'vg_vertical_gradient_level' )
-                READ ( 13 )  vg_vertical_gradient_level
-             CASE ( 'vg_vertical_gradient_level_ind' )
-                READ ( 13 )  vg_vertical_gradient_level_ind
-             CASE ( 'virtual_flight' )
-                READ ( 13 )  virtual_flight
-             CASE ( 'volume_flow_area' )
-                READ ( 13 )  volume_flow_area
-             CASE ( 'volume_flow_initial' )
-                READ ( 13 )  volume_flow_initial
-             CASE ( 'w_max' )
-                READ ( 13 )  w_max
-             CASE ( 'w_max_ijk' )
-                READ ( 13 )  w_max_ijk
-             CASE ( 'wall_adjustment' )
-                READ ( 13 )  wall_adjustment
-             CASE ( 'wall_heatflux' )
-                READ ( 13 )  wall_heatflux
-             CASE ( 'wall_humidityflux' )
-                READ ( 13 )  wall_humidityflux
-             CASE ( 'wall_scalarflux' )
-                READ ( 13 )  wall_scalarflux
-             CASE ( 'y_shift' )
-                READ ( 13 )  y_shift
-             CASE ( 'z0h_factor' )
-                READ ( 13 )  z0h_factor
-             CASE ( 'zeta_max' )
-                READ ( 13 )  zeta_max
-             CASE ( 'zeta_min' )
-                READ ( 13 )  zeta_min
-             CASE ( 'z_i' )
-                READ ( 13 )  z_i
-
-             CASE DEFAULT
-!
-!--             Read global variables from of other modules
-                CALL module_interface_rrd_global( found )
-
-                IF ( .NOT. found )  THEN
-                   WRITE( message_string, * ) 'unknown variable named "',      &
-                                           restart_string(1:length),           &
-                                          '" found in global data from ',      &
-                                          'prior run on PE ', myid
-                CALL message( 'rrd_global', 'PA0302', 1, 2, 0, 6, 0 )
-
-                ENDIF
-
-          END SELECT
-!
-!--       Read next string
-          READ ( 13 )  length
-          READ ( 13 )  restart_string(1:length)
-
-       ENDDO  ! End of loop for reading the restart string
-
-       CALL close_file( 13 )
-
-    ELSEIF ( restart_data_format_input(1:3) == 'mpi' )  THEN
-!
-!--    Read global restart data using MPI-IO
-!--    ATTENTION: Arrays need to be read with routine rrd_mpi_io_global_array!
-
-!
-!--    Open the MPI-IO restart file.
-       CALL rd_mpi_io_open( 'read', 'BININ' // TRIM( coupling_char ),                              &
-                            open_for_global_io_only = .TRUE. )
-
-!
-!--    Make version number check first
-       CALL rrd_mpi_io( 'binary_version_global',  version_on_file )
-
-       IF ( TRIM( version_on_file ) /= TRIM( binary_version_global ) )  THEN
-          WRITE( message_string, * ) 'version mismatch concerning binary_version_global:',         &
-                                     '&version on file    = "', TRIM( version_on_file ), '"',      &
-                                     '&version in program = "', TRIM( binary_version_global ), '"'
-          CALL message( 'rrd_global', 'PA0296', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       CALL rrd_mpi_io( 'numprocs',  numprocs_previous_run )
-       CALL rrd_mpi_io( 'nz' , nz )
-       CALL rrd_mpi_io( 'max_pr_user',  max_pr_user )
-       CALL rrd_mpi_io( 'statistic_regions', statistic_regions )
-
-!
-!--    The following global arrays (better to say, they have the same size and values on each
-!--    subdomain) are by default allocated in routine parin, but not in case of restarts!
-       IF ( .NOT. ALLOCATED( ug ) )  THEN
-           ALLOCATE( ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1),                                       &
-                     v_init(0:nz+1), pt_init(0:nz+1), q_init(0:nz+1),                              &
-                     ref_state(0:nz+1), s_init(0:nz+1), sa_init(0:nz+1),                           &
-                     hom(0:nz+1,2,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:statistic_regions), &
-                     hom_sum(0:nz+1,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:statistic_regions) )
-       ENDIF
-
-       CALL rrd_mpi_io( 'advected_distance_x',  advected_distance_x )
-       CALL rrd_mpi_io( 'advected_distance_y', advected_distance_y )
-       CALL rrd_mpi_io( 'alpha_surface', alpha_surface )
-       CALL rrd_mpi_io( 'average_count_pr', average_count_pr )
-       CALL rrd_mpi_io( 'average_count_sp', average_count_sp )
-       CALL rrd_mpi_io( 'average_count_3d', average_count_3d )
-       CALL rrd_mpi_io( 'bc_e_b', bc_e_b )
-       CALL rrd_mpi_io( 'bc_lr', bc_lr )
-       CALL rrd_mpi_io( 'bc_ns', bc_ns )
-       CALL rrd_mpi_io( 'bc_p_b', bc_p_b )
-       CALL rrd_mpi_io( 'bc_p_t', bc_p_t )
-       CALL rrd_mpi_io( 'bc_pt_b', bc_pt_b )
-       CALL rrd_mpi_io( 'bc_pt_t', bc_pt_t )
-       CALL rrd_mpi_io( 'bc_pt_t_val', bc_pt_t_val )
-       CALL rrd_mpi_io( 'bc_q_b', bc_q_b )
-       CALL rrd_mpi_io( 'bc_q_t', bc_q_t )
-       CALL rrd_mpi_io( 'bc_q_t_val', bc_q_t_val )
-       CALL rrd_mpi_io( 'bc_s_b', bc_s_b )
-       CALL rrd_mpi_io( 'bc_s_t', bc_s_t )
-       CALL rrd_mpi_io( 'bc_uv_b', bc_uv_b )
-       CALL rrd_mpi_io( 'bc_uv_t', bc_uv_t )
-       CALL rrd_mpi_io( 'biometeorology', biometeorology )
-       CALL rrd_mpi_io( 'building_height', building_height )
-       CALL rrd_mpi_io( 'building_length_x', building_length_x )
-       CALL rrd_mpi_io( 'building_length_y', building_length_y )
-       CALL rrd_mpi_io( 'building_wall_left', building_wall_left )
-       CALL rrd_mpi_io( 'building_wall_south', building_wall_south )
-       CALL rrd_mpi_io( 'bulk_cloud_model', bulk_cloud_model )
-       CALL rrd_mpi_io( 'call_psolver_at_all_substeps', call_psolver_at_all_substeps )
-       CALL rrd_mpi_io( 'canyon_height', canyon_height )
-       CALL rrd_mpi_io( 'canyon_wall_left', canyon_wall_left )
-       CALL rrd_mpi_io( 'canyon_wall_south', canyon_wall_south )
-       CALL rrd_mpi_io( 'canyon_width_x',  canyon_width_x )
-       CALL rrd_mpi_io( 'canyon_width_y', canyon_width_y )
-       CALL rrd_mpi_io( 'cfl_factor', cfl_factor )
-       CALL rrd_mpi_io( 'cloud_droplets',  cloud_droplets )
-       CALL rrd_mpi_io( 'collective_wait', collective_wait )
-       CALL rrd_mpi_io( 'conserve_volume_flow', conserve_volume_flow )
-       CALL rrd_mpi_io( 'conserve_volume_flow_mode', conserve_volume_flow_mode )
-       CALL rrd_mpi_io( 'constant_flux_layer', constant_flux_layer )
-       CALL rrd_mpi_io( 'coupling_start_time', coupling_start_time )
-       CALL rrd_mpi_io( 'current_timestep_number', current_timestep_number )
-       CALL rrd_mpi_io( 'cycle_mg', cycle_mg )
-       CALL rrd_mpi_io( 'damp_level_1d', damp_level_1d )
-       CALL rrd_mpi_io( 'dissipation_1d', dissipation_1d )
-       CALL rrd_mpi_io_global_array( 'do2d_xy_time_count', do2d_xy_time_count )
-       CALL rrd_mpi_io_global_array( 'do2d_xz_time_count', do2d_xz_time_count )
-       CALL rrd_mpi_io_global_array( 'do2d_yz_time_count', do2d_yz_time_count )
-       CALL rrd_mpi_io_global_array( 'do3d_time_count', do3d_time_count )
-       CALL rrd_mpi_io( 'dp_external', dp_external )
-       CALL rrd_mpi_io( 'dp_level_b', dp_level_b )
-       CALL rrd_mpi_io( 'dp_smooth', dp_smooth )
-       CALL rrd_mpi_io_global_array( 'dpdxy', dpdxy )
-       CALL rrd_mpi_io( 'dt_3d', dt_3d )
-       CALL rrd_mpi_io( 'dt_pr_1d', dt_pr_1d )
-       CALL rrd_mpi_io( 'dt_run_control_1d', dt_run_control_1d )
-       CALL rrd_mpi_io( 'dx', dx )
-       CALL rrd_mpi_io( 'dy', dy )
-       CALL rrd_mpi_io_global_array( 'dz', dz )
-       CALL rrd_mpi_io( 'dz_max', dz_max )
-       CALL rrd_mpi_io( 'dz_stretch_factor', dz_stretch_factor )
-       CALL rrd_mpi_io_global_array( 'dz_stretch_factor_array', dz_stretch_factor_array )
-       CALL rrd_mpi_io( 'dz_stretch_level', dz_stretch_level )
-       CALL rrd_mpi_io_global_array( 'dz_stretch_level_end', dz_stretch_level_end )
-       CALL rrd_mpi_io_global_array( 'dz_stretch_level_start', dz_stretch_level_start )
-       CALL rrd_mpi_io( 'e_min', e_min )
-       CALL rrd_mpi_io( 'end_time_1d', end_time_1d )
-       CALL rrd_mpi_io( 'fft_method', fft_method )
-       CALL rrd_mpi_io( 'first_call_lpm', first_call_lpm )
-       CALL rrd_mpi_io( 'galilei_transformation', galilei_transformation )
-       CALL rrd_mpi_io( 'gust_module_enabled', gust_module_enabled )
-       CALL rrd_mpi_io_global_array( 'hom', hom )
-       CALL rrd_mpi_io_global_array( 'hom_sum', hom_sum )
-       CALL rrd_mpi_io( 'humidity', humidity )
-       CALL rd_mpi_io_check_array( 'inflow_damping_factor', found = array_found )
-       IF ( array_found )  THEN
-           IF ( .NOT. ALLOCATED( inflow_damping_factor ) )  THEN
-               ALLOCATE( inflow_damping_factor(0:nz+1) )
-           ENDIF
-           CALL rrd_mpi_io_global_array( 'inflow_damping_factor', inflow_damping_factor )
-       ENDIF
-       CALL rrd_mpi_io( 'inflow_damping_height', inflow_damping_height )
-       CALL rrd_mpi_io( 'inflow_damping_width', inflow_damping_width )
-       CALL rrd_mpi_io( 'inflow_disturbance_begin', inflow_disturbance_begin )
-       CALL rrd_mpi_io( 'inflow_disturbance_end', inflow_disturbance_end )
-       CALL rrd_mpi_io( 'km_constant', km_constant )
-       CALL rrd_mpi_io( 'large_scale_forcing', large_scale_forcing )
-       CALL rrd_mpi_io( 'large_scale_subsidence', large_scale_subsidence )
-       CALL rrd_mpi_io( 'latitude', latitude )
-       CALL rrd_mpi_io( 'longitude', longitude )
-       CALL rrd_mpi_io( 'loop_optimization', loop_optimization )
-       CALL rrd_mpi_io( 'masking_method', masking_method )
-       CALL rd_mpi_io_check_array( 'mean_inflow_profiles', found = array_found )
-       IF ( array_found)  THEN
-          IF ( .NOT. ALLOCATED( mean_inflow_profiles ) )  THEN
-             ALLOCATE( mean_inflow_profiles(0:nz+1,7) )
-          ENDIF
-          CALL rrd_mpi_io_global_array( 'mean_inflow_profiles', mean_inflow_profiles )
-       ENDIF
-       CALL rrd_mpi_io( 'mg_cycles', mg_cycles )
-       CALL rrd_mpi_io( 'mg_switch_to_pe0_level', mg_switch_to_pe0_level )
-       CALL rrd_mpi_io( 'mixing_length_1d', mixing_length_1d )
-       CALL rrd_mpi_io( 'momentum_advec', momentum_advec )
-!
-!--    There is no module procedure for CHARACTER arrays
-       DO  i = 1, SIZE( netcdf_precision , 1 )
-          WRITE( tmp_name, '(A,I2.2)' )  'netcdf_precision_', i
-          CALL rrd_mpi_io( TRIM( tmp_name ), netcdf_precision(i) )
-       ENDDO
-       CALL rrd_mpi_io( 'neutral', neutral )
-       CALL rrd_mpi_io( 'ngsrb', ngsrb )
-       CALL rrd_mpi_io( 'nsor', nsor )
-       CALL rrd_mpi_io( 'nsor_ini', nsor_ini )
-       CALL rrd_mpi_io( 'nudging', nudging )
-       CALL rrd_mpi_io( 'num_leg', num_leg )
-       CALL rrd_mpi_io( 'nx', nx )
-       nx_on_file = nx
-       CALL rrd_mpi_io( 'ny', ny )
-       ny_on_file = ny
-       CALL rrd_mpi_io( 'ocean_mode', ocean_mode )
-       CALL rrd_mpi_io( 'omega', omega )
-       CALL rrd_mpi_io( 'omega_sor', omega_sor )
-       CALL rrd_mpi_io( 'origin_date_time', origin_date_time )
-       CALL rrd_mpi_io( 'output_for_t0', output_for_t0 )
-       CALL rrd_mpi_io( 'particle_advection', particle_advection )
-       CALL rrd_mpi_io( 'passive_scalar', passive_scalar )
-       CALL rrd_mpi_io( 'prandtl_number', prandtl_number )
-       CALL rrd_mpi_io( 'psolver', psolver )
-       CALL rrd_mpi_io( 'pt_damping_factor', pt_damping_factor )
-       CALL rrd_mpi_io( 'pt_damping_width', pt_damping_width )
-       CALL rrd_mpi_io_global_array( 'pt_init', pt_init )
-       CALL rrd_mpi_io( 'pt_reference', pt_reference )
-       CALL rrd_mpi_io( 'pt_surface', pt_surface )
-       CALL rrd_mpi_io( 'pt_surface_initial_change', pt_surface_initial_change )
-       CALL rrd_mpi_io_global_array( 'pt_vertical_gradient', pt_vertical_gradient )
-       CALL rrd_mpi_io_global_array( 'pt_vertical_gradient_level', pt_vertical_gradient_level )
-       CALL rrd_mpi_io_global_array( 'pt_vertical_gradient_level_ind', pt_vertical_gradient_level_ind )
-       CALL rrd_mpi_io_global_array( 'q_init', q_init )
-       CALL rrd_mpi_io( 'q_surface', q_surface )
-       CALL rrd_mpi_io( 'q_surface_initial_change', q_surface_initial_change )
-       CALL rrd_mpi_io_global_array( 'q_vertical_gradient', q_vertical_gradient )
-       CALL rrd_mpi_io_global_array( 'q_vertical_gradient_level', q_vertical_gradient_level )
-       CALL rrd_mpi_io_global_array( 'q_vertical_gradient_level_ind', q_vertical_gradient_level_ind )
-       CALL rrd_mpi_io( 'random_generator', random_generator )
-       CALL rrd_mpi_io( 'random_heatflux', random_heatflux )
-       CALL rrd_mpi_io( 'rans_mode', rans_mode )
-       CALL rrd_mpi_io( 'rayleigh_damping_factor', rayleigh_damping_factor )
-       CALL rrd_mpi_io( 'rayleigh_damping_height', rayleigh_damping_height )
-       CALL rrd_mpi_io( 'recycling_width', recycling_width )
-       CALL rrd_mpi_io_global_array( 'ref_state', ref_state )
-       CALL rrd_mpi_io( 'reference_state', reference_state )
-       CALL rrd_mpi_io( 'residual_limit', residual_limit )
-       CALL rrd_mpi_io( 'roughness_length', roughness_length )
-       CALL rrd_mpi_io( 'run_coupled', run_coupled )
-       CALL rrd_mpi_io( 'runnr', runnr )
-       CALL rrd_mpi_io_global_array( 's_init', s_init )
-       CALL rrd_mpi_io( 's_surface', s_surface )
-       CALL rrd_mpi_io( 's_surface_initial_change', s_surface_initial_change )
-       CALL rrd_mpi_io_global_array( 's_vertical_gradient', s_vertical_gradient )
-       CALL rrd_mpi_io_global_array( 's_vertical_gradient_level', s_vertical_gradient_level )
-       CALL rrd_mpi_io_global_array( 's_vertical_gradient_level_ind', s_vertical_gradient_level_ind )
-       CALL rrd_mpi_io( 'scalar_advec', scalar_advec )
-       CALL rrd_mpi_io( 'simulated_time', simulated_time )
-       CALL rd_mpi_io_check_array( 'spectrum_x', found = array_found )
-       IF (array_found )  THEN
-           IF ( .NOT. ALLOCATED( spectrum_x ) )  THEN
-              ALLOCATE( spectrum_x( 1:nx/2, 1:100, 1:10 ) )
-           ENDIF
-           CALL rrd_mpi_io_global_array( 'spectrum_x', spectrum_x )
-       ENDIF
-       CALL rd_mpi_io_check_array( 'spectrum_y', found = array_found )
-       IF ( array_found )  THEN
-           IF ( .NOT. ALLOCATED( spectrum_y ) )  THEN
-              ALLOCATE( spectrum_y( 1:ny/2, 1:100, 1:10 ) )
-           ENDIF
-           CALL rrd_mpi_io_global_array( 'spectrum_y', spectrum_y )
-       ENDIF
-       CALL rrd_mpi_io( 'spinup_time ', spinup_time )
-       CALL rrd_mpi_io_global_array( 'subs_vertical_gradient', subs_vertical_gradient )
-       CALL rrd_mpi_io_global_array( 'subs_vertical_gradient_level', subs_vertical_gradient_level )
-       CALL rrd_mpi_io_global_array( 'subs_vertical_gradient_level_i', subs_vertical_gradient_level_i )
-       CALL rrd_mpi_io( 'surface_heatflux', surface_heatflux )
-       CALL rrd_mpi_io( 'surface_pressure', surface_pressure )
-       CALL rrd_mpi_io( 'surface_output', surface_output )
-       CALL rrd_mpi_io( 'surface_scalarflux', surface_scalarflux )
-       CALL rrd_mpi_io( 'surface_waterflux', surface_waterflux )
-       CALL rrd_mpi_io( 'time_coupling', time_coupling )
-       CALL rrd_mpi_io( 'time_disturb', time_disturb )
-       CALL rrd_mpi_io( 'time_do2d_xy', time_do2d_xy )
-       CALL rrd_mpi_io( 'time_do2d_xz', time_do2d_xz )
-       CALL rrd_mpi_io( 'time_do2d_yz', time_do2d_yz )
-       CALL rrd_mpi_io( 'time_do3d', time_do3d )
-       CALL rrd_mpi_io( 'time_do_av', time_do_av )
-       CALL rrd_mpi_io( 'time_do_sla', time_do_sla )
-       CALL rrd_mpi_io_global_array( 'time_domask', time_domask )
-       CALL rrd_mpi_io( 'time_dopr', time_dopr )
-       CALL rrd_mpi_io( 'time_dopr_av', time_dopr_av )
-       CALL rrd_mpi_io( 'time_dopr_listing', time_dopr_listing )
-       CALL rrd_mpi_io( 'time_dopts', time_dopts )
-       CALL rrd_mpi_io( 'time_dosp', time_dosp )
-       CALL rrd_mpi_io( 'time_dots', time_dots )
-       CALL rrd_mpi_io( 'time_indoor', time_indoor )
-       CALL rrd_mpi_io( 'time_radiation', time_radiation )
-       CALL rrd_mpi_io( 'time_restart', time_restart )
-       CALL rrd_mpi_io( 'time_run_control', time_run_control )
-       CALL rrd_mpi_io( 'time_since_reference_point', time_since_reference_point )
-       CALL rrd_mpi_io( 'time_virtual_measurement', time_virtual_measurement )
-       CALL rrd_mpi_io( 'timestep_scheme', timestep_scheme )
-       CALL rrd_mpi_io( 'top_heatflux', top_heatflux )
-       CALL rrd_mpi_io( 'top_momentumflux_u', top_momentumflux_u )
-       CALL rrd_mpi_io( 'top_momentumflux_v', top_momentumflux_v )
-       CALL rrd_mpi_io( 'top_scalarflux', top_scalarflux )
-       CALL rrd_mpi_io( 'topography', topography )
-       CALL rrd_mpi_io( 'topography_grid_convention', topography_grid_convention )
-       CALL rrd_mpi_io_global_array( 'tsc', tsc )
-       CALL rrd_mpi_io( 'tunnel_height', tunnel_height )
-       CALL rrd_mpi_io( 'tunnel_length', tunnel_length )
-       CALL rrd_mpi_io( 'tunnel_wall_depth', tunnel_wall_depth )
-       CALL rrd_mpi_io( 'tunnel_width_x', tunnel_width_x )
-       CALL rrd_mpi_io( 'tunnel_width_y', tunnel_width_y )
-       CALL rrd_mpi_io( 'turbulence_closure', turbulence_closure )
-       CALL rrd_mpi_io( 'turbulent_inflow', turbulent_inflow )
-       CALL rrd_mpi_io( 'u_bulk', u_bulk )
-       CALL rrd_mpi_io_global_array( 'u_init', u_init )
-       CALL rrd_mpi_io( 'u_max', u_max )
-       CALL rrd_mpi_io_global_array( 'u_max_ijk', u_max_ijk )
-       CALL rrd_mpi_io_global_array( 'ug', ug )
-       CALL rrd_mpi_io( 'ug_surface', ug_surface )
-       CALL rrd_mpi_io_global_array( 'ug_vertical_gradient', ug_vertical_gradient )
-       CALL rrd_mpi_io_global_array( 'ug_vertical_gradient_level', ug_vertical_gradient_level )
-       CALL rrd_mpi_io_global_array( 'ug_vertical_gradient_level_ind', ug_vertical_gradient_level_ind )
-       CALL rrd_mpi_io( 'use_surface_fluxes', use_surface_fluxes )
-       CALL rrd_mpi_io( 'use_top_fluxes', use_top_fluxes )
-       CALL rrd_mpi_io( 'use_ug_for_galilei_tr', use_ug_for_galilei_tr )
-       CALL rrd_mpi_io( 'use_upstream_for_tke', use_upstream_for_tke )
-       CALL rrd_mpi_io( 'user_module_enabled', user_module_enabled )
-       CALL rrd_mpi_io( 'v_bulk', v_bulk )
-       CALL rrd_mpi_io_global_array( 'v_init', v_init )
-       CALL rrd_mpi_io( 'v_max', v_max )
-       CALL rrd_mpi_io_global_array( 'v_max_ijk', v_max_ijk )
-       CALL rrd_mpi_io_global_array( 'vg', vg )
-       CALL rrd_mpi_io( 'vg_surface', vg_surface )
-       CALL rrd_mpi_io_global_array( 'vg_vertical_gradient', vg_vertical_gradient )
-       CALL rrd_mpi_io_global_array( 'vg_vertical_gradient_level', vg_vertical_gradient_level )
-       CALL rrd_mpi_io_global_array( 'vg_vertical_gradient_level_ind', vg_vertical_gradient_level_ind )
-       CALL rrd_mpi_io( 'virtual_flight', virtual_flight )
-       CALL rrd_mpi_io_global_array( 'volume_flow_area', volume_flow_area )
-       CALL rrd_mpi_io_global_array( 'volume_flow_initial', volume_flow_initial )
-       CALL rrd_mpi_io( 'w_max', w_max )
-       CALL rrd_mpi_io_global_array( 'w_max_ijk', w_max_ijk )
-       CALL rrd_mpi_io( 'wall_adjustment', wall_adjustment )
-       CALL rrd_mpi_io_global_array( 'wall_heatflux', wall_heatflux )
-       CALL rrd_mpi_io_global_array( 'wall_humidityflux', wall_humidityflux )
-       CALL rrd_mpi_io_global_array( 'wall_scalarflux', wall_scalarflux )
-       CALL rrd_mpi_io( 'y_shift', y_shift )
-       CALL rrd_mpi_io( 'z0h_factor', z0h_factor )
-       CALL rrd_mpi_io( 'zeta_max', zeta_max )
-       CALL rrd_mpi_io( 'zeta_min', zeta_min )
-       CALL rrd_mpi_io_global_array( 'z_i', z_i )
-
-!
-!--    Read global variables from of other modules
-       CALL module_interface_rrd_global
-
-!
-!--    Close restart file
-       CALL rd_mpi_io_close
-
-    ENDIF
-
-    CALL location_message( 'read global restart data', 'finished' )
-
- END SUBROUTINE rrd_global
-
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Skipping the global control variables from restart-file (binary format)
-!> except some information needed when reading restart data from a previous
-!> run which used a smaller total domain or/and a different domain decomposition
-!> (initializing_actions  == 'cyclic_fill').
-!------------------------------------------------------------------------------!
- SUBROUTINE rrd_read_parts_of_global
-
-
-    CHARACTER (LEN=10) ::  version_on_file
-    CHARACTER (LEN=20) ::  bc_lr_on_file
-    CHARACTER (LEN=20) ::  bc_ns_on_file
-    CHARACTER (LEN=20) ::  momentum_advec_check
-    CHARACTER (LEN=20) ::  scalar_advec_check
-    CHARACTER (LEN=1)  ::  cdum
-
-    INTEGER(iwp) ::  max_pr_user_on_file
-    INTEGER(iwp) ::  nz_on_file
-    INTEGER(iwp) ::  statistic_regions_on_file
-    INTEGER(iwp) ::  tmp_mpru
-    INTEGER(iwp) ::  tmp_sr
-
-    REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  hom_sum_on_file
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  hom_on_file
-
-
-    IF ( TRIM( restart_data_format_input ) == 'fortran_binary' )  THEN
-!
-!--    Input in Fortran binary format
-       CALL check_open( 13 )
-
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-       READ ( 13 )  version_on_file
-
-!
-!--    Read number of PEs and horizontal index bounds of all PEs used in previous run
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       IF ( restart_string(1:length) /= 'numprocs' )  THEN
-          WRITE( message_string, * ) 'numprocs not found in data from prior ', &
-                                     'run on PE ', myid
-          CALL message( 'rrd_read_parts_of_global', 'PA0297', 1, 2, 0, 6, 0 )
-       ENDIF
-       READ ( 13 )  numprocs_previous_run
-
-       IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
-          ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
-       ENDIF
-
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       IF ( restart_string(1:length) /= 'hor_index_bounds' )  THEN
-          WRITE( message_string, * ) 'hor_index_bounds not found in data ',    &
-                                     'from prior run on PE ', myid
-          CALL message( 'rrd_read_parts_of_global', 'PA0298', 1, 2, 0, 6, 0 )
-       ENDIF
-       READ ( 13 )  hor_index_bounds_previous_run
-
-!
-!--    Read vertical number of gridpoints and number of different areas used for computing
-!--    statistics. Allocate arrays depending on these values, which are needed for the following
-!--    read instructions.
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       IF ( restart_string(1:length) /= 'nz' )  THEN
-          message_string = 'nz not found in restart data file'
-          CALL message( 'rrd_read_parts_of_global', 'PA0303', 1, 2, 0, 6, 0 )
-       ENDIF
-       READ ( 13 )  nz_on_file
-       IF ( nz_on_file /= nz )  THEN
-          WRITE( message_string, * ) 'mismatch concerning number of ',         &
-                                     'gridpoints along z:',                    &
-                                     '&nz on file    = "', nz_on_file, '"',    &
-                                     '&nz from run   = "', nz, '"'
-          CALL message( 'rrd_read_parts_of_global', 'PA0304', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       IF ( restart_string(1:length) /= 'max_pr_user' )  THEN
-          message_string = 'max_pr_user not found in restart data file'
-          CALL message( 'rrd_read_parts_of_global', 'PA0305', 1, 2, 0, 6, 0 )
-       ENDIF
-       READ ( 13 )  max_pr_user_on_file
-       IF ( max_pr_user_on_file /= max_pr_user )  THEN
-          WRITE( message_string, * ) 'number of user profiles on res',         &
-                                     'tart data file differs from the ',       &
-                                     'current run:&max_pr_user on file    = "',&
-                                     max_pr_user_on_file, '"',                 &
-                                     '&max_pr_user from run   = "',            &
-                                     max_pr_user, '"'
-          CALL message( 'rrd_read_parts_of_global', 'PA0306', 0, 0, 0, 6, 0 )
-          tmp_mpru = MIN( max_pr_user_on_file, max_pr_user )
-       ELSE
-          tmp_mpru = max_pr_user
-       ENDIF
-
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       IF ( restart_string(1:length) /= 'statistic_regions' )  THEN
-          message_string = 'statistic_regions not found in restart data file'
-          CALL message( 'rrd_read_parts_of_global', 'PA0307', 1, 2, 0, 6, 0 )
-       ENDIF
-       READ ( 13 )  statistic_regions_on_file
-       IF ( statistic_regions_on_file /= statistic_regions )  THEN
-          WRITE( message_string, * ) 'statistic regions on restart data file ',&
-                                     'differ from the current run:',           &
-                                     '&statistic regions on file    = "',      &
-                                     statistic_regions_on_file, '"',           &
-                                     '&statistic regions from run   = "',      &
-                                      statistic_regions, '"',                  &
-                                     '&statistic data may be lost!'
-          CALL message( 'rrd_read_parts_of_global', 'PA0308', 0, 1, 0, 6, 0 )
-          tmp_sr = MIN( statistic_regions_on_file, statistic_regions )
-       ELSE
-          tmp_sr = statistic_regions
-       ENDIF
-
-!
-!--    Now read and check some control parameters and skip the rest
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-       DO  WHILE ( restart_string(1:length) /= 'binary_version_local' )
-
-          SELECT CASE ( restart_string(1:length) )
-
-             CASE ( 'average_count_pr' )
-                READ ( 13 )  average_count_pr
-                IF ( average_count_pr /= 0 )  THEN
-                   WRITE( message_string, * ) 'inflow profiles not ',          &
-                                  'temporally averaged. &Averaging will be ',  &
-                                  'done now using', average_count_pr,          &
-                                  ' samples.'
-                   CALL message( 'rrd_read_parts_of_global', 'PA0309',         &
-                                 0, 1, 0, 6, 0 )
-                ENDIF
-
-             CASE ( 'bc_lr' )
-                READ ( 13 )  bc_lr_on_file
-                IF ( TRIM( bc_lr_on_file ) /= 'cyclic' )  THEN
-                   message_string = 'bc_lr in the prerun was set /= "cyclic"'
-                   CALL message( 'rrd_read_parts_of_global', 'PA0498', 1, 2, 0, 6, 0 )
-                ENDIF
-
-             CASE ( 'bc_ns' )
-                READ ( 13 )  bc_ns_on_file
-                IF ( TRIM( bc_ns_on_file ) /= 'cyclic' )  THEN
-                   message_string = 'bc_ns in the prerun was set /= "cyclic"'
-                   CALL message( 'rrd_read_parts_of_global', 'PA0498', 1, 2, 0, 6, 0 )
-                ENDIF
-
-             CASE ( 'hom' )
-                ALLOCATE( hom_on_file(0:nz+1,2,pr_palm+max_pr_user_on_file,    &
-                          0:statistic_regions_on_file) )
-                READ ( 13 )  hom_on_file
-                hom(:,:,1:pr_palm+tmp_mpru,0:tmp_sr) =                         &
-                             hom_on_file(:,:,1:pr_palm+tmp_mpru,0:tmp_sr)
-                DEALLOCATE( hom_on_file )
-
-             CASE ( 'hom_sum' )
-                ALLOCATE( hom_sum_on_file(0:nz+1,pr_palm+max_pr_user_on_file,  &
-                          0:statistic_regions_on_file) )
-                READ ( 13 )  hom_sum_on_file
-                hom_sum(:,1:pr_palm+tmp_mpru,0:tmp_sr) =                       &
-                             hom_sum_on_file(:,1:pr_palm+tmp_mpru,0:tmp_sr)
-                DEALLOCATE( hom_sum_on_file )
-
-             CASE ( 'momentum_advec' )
-                momentum_advec_check = momentum_advec
-                READ ( 13 )  momentum_advec
-                IF ( TRIM( momentum_advec_check ) /= TRIM( momentum_advec ) )  &
-                THEN
-                   WRITE( message_string, * ) 'momentum_advec of the restart ',&
-                                  'run differs from momentum_advec of the ',   &
-                                  'initial run.'
-                   CALL message( 'rrd_read_parts_of_global', 'PA0100',         &
-                                 1, 2, 0, 6, 0 )
-                ENDIF
-
-             CASE ( 'nx' )
-                READ ( 13 )  nx_on_file
-
-             CASE ( 'ny' )
-                READ ( 13 )  ny_on_file
-
-             CASE ( 'ref_state' )
-                READ ( 13 )  ref_state
-
-             CASE ( 'scalar_advec' )
-                scalar_advec_check = scalar_advec
-                READ ( 13 )  scalar_advec
-                IF ( TRIM( scalar_advec_check ) /= TRIM( scalar_advec ) )      &
-                THEN
-                   WRITE( message_string, * ) 'scalar_advec of the restart ',  &
-                                  'run differs from scalar_advec of the ',     &
-                                  'initial run.'
-                   CALL message( 'rrd_read_parts_of_global', 'PA0101',         &
-                                 1, 2, 0, 6, 0 )
-                ENDIF
-
-             CASE DEFAULT
-
-                READ ( 13 )  cdum
-
-          END SELECT
-
-          READ ( 13 )  length
-          READ ( 13 )  restart_string(1:length)
-
-       ENDDO
-
-       CALL close_file( 13 )
-
-    ELSEIF ( restart_data_format_input(1:3) == 'mpi' )  THEN
-!
-!--    Open the MPI-IO restart file.
-       CALL rd_mpi_io_open( 'read', 'BININ' // TRIM( coupling_char ),                              &
-                            open_for_global_io_only = .TRUE. )
-
-!
-!--    Read vertical number of gridpoints and number of different areas used for computing
-!--    statistics. Allocate arrays depending on these values, which are required for the following
-!--    read instructions.
-       CALL rrd_mpi_io( 'nz', nz_on_file )
-       IF ( nz_on_file /= nz )  THEN
-          WRITE( message_string, * ) 'mismatch concerning number of gridpoints along z:',          &
-                                     '&nz on file    = "', nz_on_file, '"',                        &
-                                     '&nz from run   = "', nz, '"'
-          CALL message( 'rrd_read_parts_of_global', 'PA0304', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       CALL rrd_mpi_io( 'max_pr_user', max_pr_user_on_file )
-       IF ( max_pr_user_on_file /= max_pr_user )  THEN
-          WRITE( message_string, * ) 'number of user profiles on restart data file differs from ', &
-                                     'the current run:&max_pr_user on file    = "',                &
-                                     max_pr_user_on_file, '" &max_pr_user from run   = "',         &
-                                     max_pr_user, '"'
-          CALL message( 'rrd_read_parts_of_global', 'PA0306', 0, 0, 0, 6, 0 )
-          tmp_mpru = MIN( max_pr_user_on_file, max_pr_user )
-       ELSE
-          tmp_mpru = max_pr_user
-       ENDIF
-
-       CALL rrd_mpi_io( 'statistic_regions', statistic_regions_on_file )
-       IF ( statistic_regions_on_file /= statistic_regions )  THEN
-          WRITE( message_string, * ) 'statistic regions on restart data file ',&
-                                     'differ from the current run:',           &
-                                     '&statistic regions on file    = "',      &
-                                     statistic_regions_on_file, '"',           &
-                                     '&statistic regions from run   = "',      &
-                                      statistic_regions, '"',                  &
-                                     '&statistic data may be lost!'
-          CALL message( 'rrd_read_parts_of_global', 'PA0308', 0, 1, 0, 6, 0 )
-          tmp_sr = MIN( statistic_regions_on_file, statistic_regions )
-       ELSE
-          tmp_sr = statistic_regions
-       ENDIF
-
-!
-!--    Now read and check some control parameters and skip the rest.
-       CALL rrd_mpi_io( 'average_count_pr', average_count_pr )
-       IF ( average_count_pr /= 0 )  THEN
-          WRITE( message_string, * ) 'inflow profiles not ',          &
-                         'temporally averaged. &Averaging will be ',  &
-                         'done now using', average_count_pr,          &
-                         ' samples.'
-          CALL message( 'rrd_read_parts_of_global', 'PA0309', 0, 1, 0, 6, 0 )
-       ENDIF
-
-       ALLOCATE( hom_on_file(0:nz+1,2,pr_palm+max_pr_user_on_file,0:statistic_regions_on_file) )
-       CALL rrd_mpi_io_global_array( 'hom', hom_on_file )
-       hom(:,:,1:pr_palm+tmp_mpru,0:tmp_sr) = hom_on_file(:,:,1:pr_palm+tmp_mpru,0:tmp_sr)
-       DEALLOCATE( hom_on_file )
-
-       ALLOCATE( hom_sum_on_file(0:nz+1,pr_palm+max_pr_user_on_file, 0:statistic_regions_on_file) )
-       CALL rrd_mpi_io_global_array( 'hom_sum', hom_sum_on_file )
-       hom_sum(:,1:pr_palm+tmp_mpru,0:tmp_sr) = hom_sum_on_file(:,1:pr_palm+tmp_mpru,0:tmp_sr)
-       DEALLOCATE( hom_sum_on_file )
-
-       momentum_advec_check = momentum_advec
-       CALL rrd_mpi_io( 'momentum_advec', momentum_advec )
-       IF ( TRIM( momentum_advec_check ) /= TRIM( momentum_advec ) )  THEN
-          WRITE( message_string, * ) 'momentum_advec of the restart ',&
-                                  'run differs from momentum_advec of the ',   &
-                                  'initial run.'
-          CALL message( 'rrd_read_parts_of_global', 'PA0100', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       CALL rrd_mpi_io( 'bc_lr', bc_lr_on_file )
-       CALL rrd_mpi_io( 'bc_ns', bc_ns_on_file )
-       IF ( TRIM( bc_lr_on_file ) /= 'cyclic'  .OR.  TRIM( bc_ns_on_file ) /= 'cyclic' )  THEN
-          message_string = 'bc_lr and/or bc_ns in the prerun was set /= "cyclic"'
-          CALL message( 'rrd_read_parts_of_global', 'PA0498', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       scalar_advec_check = scalar_advec
-       CALL rrd_mpi_io( 'scalar_advec', scalar_advec )
-       IF ( TRIM( scalar_advec_check ) /= TRIM( scalar_advec ) )  THEN
-          WRITE( message_string, * ) 'scalar_advec of the restart ',  &
-                                  'run differs from scalar_advec of the ',     &
-                                  'initial run.'
-          CALL message( 'rrd_read_parts_of_global', 'PA0101', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       CALL rrd_mpi_io( 'nx', nx_on_file )
-       CALL rrd_mpi_io( 'ny', ny_on_file )
-       CALL rrd_mpi_io_global_array( 'ref_state', ref_state )
-
-!
-!--    Close restart file
-       CALL rd_mpi_io_close
-
-    ENDIF
-
-!
-!-- Calculate the temporal average of vertical profiles, if neccessary
-    IF ( average_count_pr /= 0 )  THEN
-       hom_sum = hom_sum / REAL( average_count_pr, KIND=wp )
-    ENDIF
-
- END SUBROUTINE rrd_read_parts_of_global
-
-
-! Description:
-! ------------
-!> Reads processor (subdomain) specific data of variables and arrays from restart file
-!> (binary format).
-!------------------------------------------------------------------------------!
- SUBROUTINE rrd_local
-
-
-    CHARACTER (LEN=7)  ::  myid_char_save
-    CHARACTER (LEN=10) ::  binary_version_local
-    CHARACTER (LEN=10) ::  version_on_file
-    CHARACTER (LEN=20) ::  tmp_name               !< temporary variable
-
-    INTEGER(iwp) ::  files_to_be_opened  !<
-    INTEGER(iwp) ::  i                   !<
-    INTEGER(iwp) ::  j                   !<
-    INTEGER(iwp) ::  k                   !<
-    INTEGER(iwp) ::  myid_on_file        !<
-    INTEGER(iwp) ::  numprocs_on_file    !<
-    INTEGER(iwp) ::  nxlc                !<
-    INTEGER(iwp) ::  nxlf                !<
-    INTEGER(iwp) ::  nxlpr               !<
-    INTEGER(iwp) ::  nxl_on_file         !<
-    INTEGER(iwp) ::  nxrc                !<
-    INTEGER(iwp) ::  nxrf                !<
-    INTEGER(iwp) ::  nxrpr               !<
-    INTEGER(iwp) ::  nxr_on_file         !<
-    INTEGER(iwp) ::  nync                !<
-    INTEGER(iwp) ::  nynf                !<
-    INTEGER(iwp) ::  nynpr               !<
-    INTEGER(iwp) ::  nyn_on_file         !<
-    INTEGER(iwp) ::  nysc                !<
-    INTEGER(iwp) ::  nysf                !<
-    INTEGER(iwp) ::  nyspr               !<
-    INTEGER(iwp) ::  nys_on_file         !<
-    INTEGER(iwp) ::  nzb_on_file         !<
-    INTEGER(iwp) ::  nzt_on_file         !<
-    INTEGER(iwp) ::  offset_x            !<
-    INTEGER(iwp) ::  offset_y            !<
-    INTEGER(iwp) ::  shift_x             !<
-    INTEGER(iwp) ::  shift_y             !<
-
-    INTEGER(iwp), DIMENSION(numprocs_previous_run) ::  file_list       !<
-    INTEGER(iwp), DIMENSION(numprocs_previous_run) ::  overlap_count   !<
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nxlfa      !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nxrfa      !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nynfa      !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nysfa      !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  offset_xa  !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  offset_ya  !<
-
-    INTEGER(isp), DIMENSION(:,:),   ALLOCATABLE ::  tmp_2d_id_random   !< temporary array for storing random generator data
-    INTEGER(isp), DIMENSION(:,:,:), ALLOCATABLE ::  tmp_2d_seq_random  !< temporary array for storing random generator data
-
-    LOGICAL ::  array_found                      !<
-    LOGICAL ::  found                            !<
-
-    REAL(wp), DIMENSION(:,:),   ALLOCATABLE   ::  tmp_2d         !< temporary array for storing 2D data
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3d         !< temporary array for storing 3D data
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3d_non_standard !< temporary array for storing 3D data
-                                                                 !< with non standard dimensions
-
-!
-!-- Read data from previous model run.
-    CALL cpu_log( log_point_s(14), 'read-restart-data-local', 'start' )
-
-    CALL location_message( 'reading local restart data', 'start' )
-
-    IF ( TRIM( restart_data_format_input ) == 'fortran_binary' )  THEN
-!
-!--    Input in Fortran binary format
-
-!
-!--    Allocate temporary buffer arrays. In previous versions, they were
-!--    declared as automated arrays, causing memory problems when these
-!--    were allocate on stack.
-       ALLOCATE( nxlfa(numprocs_previous_run,1000) )
-       ALLOCATE( nxrfa(numprocs_previous_run,1000) )
-       ALLOCATE( nynfa(numprocs_previous_run,1000) )
-       ALLOCATE( nysfa(numprocs_previous_run,1000) )
-       ALLOCATE( offset_xa(numprocs_previous_run,1000) )
-       ALLOCATE( offset_ya(numprocs_previous_run,1000) )
-
-!
-!--    Check which of the restart files contain data needed for the subdomain
-!--    of this PE
-       files_to_be_opened = 0
-
-       DO  i = 1, numprocs_previous_run
-!
-!--       Store array bounds of the previous run ("pr") in temporary scalars
-          nxlpr = hor_index_bounds_previous_run(1,i-1)
-          nxrpr = hor_index_bounds_previous_run(2,i-1)
-          nyspr = hor_index_bounds_previous_run(3,i-1)
-          nynpr = hor_index_bounds_previous_run(4,i-1)
-
-!
-!--       Determine the offsets. They may be non-zero in case that the total domain
-!--       on file is smaller than the current total domain.
-          offset_x = ( nxl / ( nx_on_file + 1 ) ) * ( nx_on_file + 1 )
-          offset_y = ( nys / ( ny_on_file + 1 ) ) * ( ny_on_file + 1 )
-
-!
-!--       Start with this offset and then check, if the subdomain on file
-!--       matches another time(s) in the current subdomain by shifting it
-!--       for nx_on_file+1, ny_on_file+1 respectively
-
-          shift_y = 0
-          j       = 0
-          DO WHILE (  nyspr+shift_y <= nyn-offset_y )
-
-             IF ( nynpr+shift_y >= nys-offset_y ) THEN
-
-                shift_x = 0
-                DO WHILE ( nxlpr+shift_x <= nxr-offset_x )
-
-                   IF ( nxrpr+shift_x >= nxl-offset_x ) THEN
-                      j = j +1
-                      IF ( j > 1000 )  THEN
-!
-!--                      Array bound exceeded
-                         message_string = 'data from subdomain of previous' //                        &
-                                          ' run mapped more than 1000 times'
-                         CALL message( 'rrd_local', 'PA0284', 2, 2, -1, 6, 1 )
-                      ENDIF
-
-                      IF ( j == 1 )  THEN
-                         files_to_be_opened = files_to_be_opened + 1
-                         file_list(files_to_be_opened) = i-1
-                      ENDIF
-
-                      offset_xa(files_to_be_opened,j) = offset_x + shift_x
-                      offset_ya(files_to_be_opened,j) = offset_y + shift_y
-!
-!--                   Index bounds of overlapping data
-                      nxlfa(files_to_be_opened,j) = MAX( nxl-offset_x-shift_x, nxlpr )
-                      nxrfa(files_to_be_opened,j) = MIN( nxr-offset_x-shift_x, nxrpr )
-                      nysfa(files_to_be_opened,j) = MAX( nys-offset_y-shift_y, nyspr )
-                      nynfa(files_to_be_opened,j) = MIN( nyn-offset_y-shift_y, nynpr )
-
-                   ENDIF
-
-                   shift_x = shift_x + ( nx_on_file + 1 )
-                ENDDO
-
-             ENDIF
-
-             shift_y = shift_y + ( ny_on_file + 1 )
-          ENDDO
-
-          IF ( j > 0 )  overlap_count(files_to_be_opened) = j
-
-       ENDDO
-
-!
-!--    Save the id-string of the current process, since myid_char may now be used
-!--    to open files created by PEs with other id.
-       myid_char_save = myid_char
-
-       IF ( files_to_be_opened /= 1  .OR.  numprocs /= numprocs_previous_run )  THEN
-          WRITE( message_string, * ) 'number of PEs or virtual PE-grid changed in restart run. & ',   &
-                                     'Set debug_output =.T. to get a list of files from which the & ',&
-                                     'single PEs will read respectively'
-          CALL message( 'rrd_local', 'PA0285', 0, 0, 0, 6, 0 )
-          IF ( debug_output )  THEN
-             IF ( files_to_be_opened <= 120 )  THEN
-                WRITE( debug_string, '(2A,1X,120(I6.6,1X))' )                                         &
-                     'number of PEs or virtual PE-grid changed in restart run.  PE will read from ',  &
-                     'files ', file_list(1:files_to_be_opened)
-             ELSE
-                WRITE( debug_string, '(3A,1X,120(I6.6,1X),A)' )                                      &
-                     'number of PEs or virtual PE-grid changed in restart run.  PE will read from ',  &
-                     'files ', file_list(1:120), '... and more'
-             ENDIF
-             CALL debug_message( 'rrd_local', 'info' )
-          ENDIF
-       ENDIF
-
-!
-!--    Read data from all restart files determined above
-       DO  i = 1, files_to_be_opened
-
-          j = file_list(i)
-!
-!--       Set the filename (underscore followed by four digit processor id)
-          WRITE (myid_char,'(''_'',I6.6)')  j
-
-!
-!--       Open the restart file. If this file has been created by PE0 (_000000),
-!--       the global variables at the beginning of the file have to be skipped
-!--       first.
-          CALL check_open( 13 )
-          IF ( j == 0 )  CALL rrd_skip_global
-
-!
-!--       First compare the version numbers
-          READ ( 13 )  length
-          READ ( 13 )  restart_string(1:length)
-          READ ( 13 )  version_on_file
-
-          binary_version_local = '5.1'
-          IF ( TRIM( version_on_file ) /= TRIM( binary_version_local ) )  THEN
-             WRITE( message_string, * ) 'version mismatch concerning ',                               &
-                                        'binary_version_local:',                                      &
-                                        '&version on file    = "', TRIM( version_on_file ), '"',      &
-                                        '&version in program = "', TRIM( binary_version_local ), '"'
-             CALL message( 'rrd_local', 'PA0286', 1, 2, 0, 6, 0 )
-          ENDIF
-
-!
-!--       Read number of processors, processor-id, and array ranges.
-!--       Compare the array ranges with those stored in the index bound array.
-          READ ( 13 )  numprocs_on_file, myid_on_file, nxl_on_file, nxr_on_file, nys_on_file,         &
-                       nyn_on_file, nzb_on_file, nzt_on_file
-
-          IF ( nxl_on_file /= hor_index_bounds_previous_run(1,j) )  THEN
-             WRITE( message_string, * ) 'problem with index bound nxl on ',                           &
-                                        'restart file "', myid_char, '"',                             &
-                                        '&nxl = ', nxl_on_file, ' but it should be',                  &
-                                        '&= ', hor_index_bounds_previous_run(1,j),                    &
-                                        '&from the index bound information array'
-             CALL message( 'rrd_local', 'PA0287', 2, 2, -1, 6, 1 )
-          ENDIF
-
-          IF ( nxr_on_file /= hor_index_bounds_previous_run(2,j) )  THEN
-              WRITE( message_string, * ) 'problem with index bound nxr on ',                          &
-                                         'restart file "', myid_char, '"'  ,                          &
-                                         ' nxr = ', nxr_on_file, ' but it should be',                 &
-                                         ' = ', hor_index_bounds_previous_run(2,j),                   &
-                                         ' from the index bound information array'
-             CALL message( 'rrd_local', 'PA0288', 2, 2, -1, 6, 1 )
-
-          ENDIF
-
-          IF ( nys_on_file /= hor_index_bounds_previous_run(3,j) )  THEN
-             WRITE( message_string, * ) 'problem with index bound nys on ',                           &
-                                        'restart file "', myid_char, '"',                             &
-                                        '&nys = ', nys_on_file, ' but it should be',                  &
-                                        '&= ', hor_index_bounds_previous_run(3,j),                    &
-                                        '&from the index bound information array'
-             CALL message( 'rrd_local', 'PA0289', 2, 2, -1, 6, 1 )
-          ENDIF
-
-          IF ( nyn_on_file /= hor_index_bounds_previous_run(4,j) )  THEN
-             WRITE( message_string, * ) 'problem with index bound nyn on ',                           &
-                                        'restart file "', myid_char, '"',                             &
-                                        '&nyn = ', nyn_on_file, ' but it should be',                  &
-                                        '&= ', hor_index_bounds_previous_run(4,j),                    &
-                                        '&from the index bound information array'
-             CALL message( 'rrd_local', 'PA0290', 2, 2, -1, 6, 1 )
-          ENDIF
-
-          IF ( nzb_on_file /= nzb )  THEN
-             WRITE( message_string, * ) 'mismatch between actual data and data ',                     &
-                                        'from prior run on PE ', myid,                                &
-                                        '&nzb on file = ', nzb_on_file,                               &
-                                        '&nzb         = ', nzb
-             CALL message( 'rrd_local', 'PA0291', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( nzt_on_file /= nzt )  THEN
-             WRITE( message_string, * ) 'mismatch between actual data and data ',                     &
-                                        'from prior run on PE ', myid,                                &
-                                        '&nzt on file = ', nzt_on_file,                               &
-                                        '&nzt         = ', nzt
-             CALL message( 'rrd_local', 'PA0292', 1, 2, 0, 6, 0 )
-          ENDIF
-
-!
-!--       Allocate temporary arrays sized as the arrays on the restart file
-          ALLOCATE( tmp_2d(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp),      &
-                    tmp_3d(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,                               &
-                           nxl_on_file-nbgp:nxr_on_file+nbgp) )
-
-!
-!--       Read arrays
-!--       ATTENTION: If the following read commands have been altered, the
-!--       ---------- version number of the variable binary_version_local must
-!--                  be altered, too. Furthermore, the output list of arrays in
-!--                  wrd_write_local must also be altered
-!--                  accordingly.
-          READ ( 13 )  length
-          READ ( 13 )  restart_string(1:length)
-
-
-!
-!--       Loop over processor specific field data
-          DO  WHILE ( restart_string(1:length) /= '*** end ***' )
-
-!
-!--          Map data on file as often as needed (data are read only for k=1)
-             DO  k = 1, overlap_count(i)
-
-                found = .FALSE.
-
-!
-!--             Get the index range of the subdomain on file which overlap with
-!--             the current subdomain
-                nxlf = nxlfa(i,k)
-                nxlc = nxlfa(i,k) + offset_xa(i,k)
-                nxrf = nxrfa(i,k)
-                nxrc = nxrfa(i,k) + offset_xa(i,k)
-                nysf = nysfa(i,k)
-                nysc = nysfa(i,k) + offset_ya(i,k)
-                nynf = nynfa(i,k)
-                nync = nynfa(i,k) + offset_ya(i,k)
-
-
-                SELECT CASE ( restart_string(1:length) )
-
-                   CASE ( 'ghf_av' )
-                      IF ( .NOT. ALLOCATED( ghf_av ) )  THEN
-                         ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      ghf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'e' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      e(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'e_av' )
-                      IF ( .NOT. ALLOCATED( e_av ) )  THEN
-                         ALLOCATE( e_av(nzb:nzt+1,nys-nbgp:nyn+nbgp,                                  &
-                                        nxl-nbgp:nxr+nbgp) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      e_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'kh' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      kh(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'kh_av' )
-                      IF ( .NOT. ALLOCATED( kh_av ) )  THEN
-                         ALLOCATE( kh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ))
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      kh_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'km' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      km(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'km_av' )
-                      IF ( .NOT. ALLOCATED( km_av ) )  THEN
-                         ALLOCATE( km_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ))
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      km_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'lpt_av' )
-                      IF ( .NOT. ALLOCATED( lpt_av ) )  THEN
-                         ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ))
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      lpt_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'lwp_av' )
-                      IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
-                         ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      lwp_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'p' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      p(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'p_av' )
-                      IF ( .NOT. ALLOCATED( p_av ) )  THEN
-                         ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      p_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'pt' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      pt(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'pt_av' )
-                      IF ( .NOT. ALLOCATED( pt_av ) )  THEN
-                         ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      pt_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'q' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      q(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'q_av' )
-                      IF ( .NOT. ALLOCATED( q_av ) )  THEN
-                         ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ))
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      q_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'ql' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      ql(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'ql_av' )
-                      IF ( .NOT. ALLOCATED( ql_av ) )  THEN
-                         ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      ql_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'qsurf_av' )
-                      IF ( .NOT. ALLOCATED( qsurf_av ) )  THEN
-                         ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      qsurf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'qsws_av' )
-                      IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
-                         ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      qsws_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                             &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'qv_av' )
-                      IF ( .NOT. ALLOCATED( qv_av ) )  THEN
-                         ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      qv_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'r_a_av' )
-                      IF ( .NOT. ALLOCATED( r_a_av ) )  THEN
-                         ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      r_a_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'random_iv' )  ! still unresolved issue
-                      IF ( k == 1 )  READ ( 13 )  random_iv
-                      IF ( k == 1 )  READ ( 13 )  random_iy
-
-                   CASE ( 'seq_random_array' )
-                      ALLOCATE( tmp_2d_id_random(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) )
-                      ALLOCATE( tmp_2d_seq_random(5,nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) )
-                      IF ( .NOT. ALLOCATED( id_random_array ) )  THEN
-                         ALLOCATE( id_random_array(nys:nyn,nxl:nxr) )
-                      ENDIF
-                      IF ( .NOT. ALLOCATED( seq_random_array ) )  THEN
-                         ALLOCATE( seq_random_array(5,nys:nyn,nxl:nxr) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d_id_random
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d_seq_random
-                      id_random_array(nysc:nync,nxlc:nxrc) = tmp_2d_id_random(nysf:nynf,nxlf:nxrf)
-                      seq_random_array(:,nysc:nync,nxlc:nxrc) = tmp_2d_seq_random(:,nysf:nynf,nxlf:nxrf)
-                      DEALLOCATE( tmp_2d_id_random, tmp_2d_seq_random )
-
-                   CASE ( 's' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      s(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 's_av' )
-                      IF ( .NOT. ALLOCATED( s_av ) )  THEN
-                         ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      s_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'shf_av' )
-                      IF ( .NOT. ALLOCATED( shf_av ) )  THEN
-                         ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      shf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                              &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'ssurf_av' )
-                      IF ( .NOT. ALLOCATED( ssurf_av ) )  THEN
-                         ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      ssurf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'ssws_av' )
-                      IF ( .NOT. ALLOCATED( ssws_av ) )  THEN
-                         ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      ssws_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                             &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'ts_av' )
-                      IF ( .NOT. ALLOCATED( ts_av ) )  THEN
-                         ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      ts_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                               &
-                           tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'tsurf_av' )
-                      IF ( .NOT. ALLOCATED( tsurf_av ) )  THEN
-                         ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      tsurf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'u' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      u(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'u_av' )
-                      IF ( .NOT. ALLOCATED( u_av ) )  THEN
-                         ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      u_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'us_av' )
-                      IF ( .NOT. ALLOCATED( us_av ) )  THEN
-                         ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      us_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                               &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'v' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      v(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'v_av' )
-                      IF ( .NOT. ALLOCATED( v_av ) )  THEN
-                         ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      v_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'vpt' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      vpt(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'vpt_av' )
-                      IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
-                         ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      vpt_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'w' )
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      w(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'w_av' )
-                      IF ( .NOT. ALLOCATED( w_av ) )  THEN
-                         ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_3d
-                      w_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
-                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'z0_av' )
-                      IF ( .NOT. ALLOCATED( z0_av ) )  THEN
-                         ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      z0_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                               &
-                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'z0h_av' )
-                      IF ( .NOT. ALLOCATED( z0h_av ) )  THEN
-                         ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      z0h_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                              &
-                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE ( 'z0q_av' )
-                      IF ( .NOT. ALLOCATED( z0q_av ) )  THEN
-                         ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
-                      ENDIF
-                      IF ( k == 1 )  READ ( 13 )  tmp_2d
-                      z0q_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                              &
-                      tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                   CASE DEFAULT
-
-!
-!--                   Read restart data of surfaces
-                      IF ( .NOT. found )  CALL surface_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf,   &
-                                                                  nxr_on_file, nynf, nyn_on_file,     &
-                                                                  nysf, nysc, nys_on_file, found )
-!
-!--                   Read restart data of other modules
-                      IF ( .NOT. found ) CALL module_interface_rrd_local(                             &
-                                                                  k, nxlf, nxlc, nxl_on_file, nxrf,   &
-                                                                  nxrc, nxr_on_file, nynf, nync,      &
-                                                                  nyn_on_file, nysf, nysc,            &
-                                                                  nys_on_file, tmp_2d, tmp_3d, found )
-
-
-                      IF ( .NOT. found )  THEN
-                         WRITE( message_string, * ) 'unknown variable named "',                       &
-                                                    restart_string(1:length),                         &
-                                                   '" found in subdomain data ',                      &
-                                                   'from prior run on PE ', myid
-                         CALL message( 'rrd_local', 'PA0302', 1, 2, 0, 6, 0 )
-
-                      ENDIF
-
-                END SELECT
-
-             ENDDO ! overlaploop
-
-!
-!--          Deallocate non standard array needed for specific variables only
-             IF ( ALLOCATED( tmp_3d_non_standard ) )  DEALLOCATE( tmp_3d_non_standard )
-
-!
-!--          Read next character string
-             READ ( 13 )  length
-             READ ( 13 )  restart_string(1:length)
-
-          ENDDO ! dataloop
-!
-!--       Close the restart file
-          CALL close_file( 13 )
-
-          DEALLOCATE( tmp_2d, tmp_3d )
-
-       ENDDO  ! loop over restart files
-!
-!--    Deallocate temporary buffer arrays
-       DEALLOCATE( nxlfa )
-       DEALLOCATE( nxrfa )
-       DEALLOCATE( nynfa )
-       DEALLOCATE( nysfa )
-       DEALLOCATE( offset_xa )
-       DEALLOCATE( offset_ya )
-!
-!--    Restore the original filename for the restart file to be written
-       myid_char = myid_char_save
-
-
-    ELSEIF ( restart_data_format_input(1:3) == 'mpi' )  THEN
-
-!
-!--    Read local restart data using MPI-IO
-!
-!--    Open the MPI-IO restart file.
-       CALL rd_mpi_io_open( 'read', 'BININ' // TRIM( coupling_char ) )
-
-
-       CALL rd_mpi_io_check_array( 'ghf_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF (.NOT. ALLOCATED( ghf_av ) )  ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'ghf_av', ghf_av )
-       ENDIF
-
-       CALL rrd_mpi_io( 'e', e )
-
-       CALL rd_mpi_io_check_array( 'e_av' , found = array_found )
-       IF ( array_found  )  THEN
-          IF ( .NOT. ALLOCATED( e_av ) )  ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'e_av', e_av )
-       ENDIF
-
-       CALL rrd_mpi_io( 'kh', kh )
-
-       CALL rd_mpi_io_check_array( 'kh_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( kh_av ) )  ALLOCATE( kh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'kh_av', kh_av )
-       ENDIF
-
-       CALL rrd_mpi_io( 'km' , km)
-
-       CALL rd_mpi_io_check_array( 'km_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( km_av ) )  ALLOCATE( km_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'km_av', km_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'lpt_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( lpt_av ) )  ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'lpt_av', lpt_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'lwp_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( lwp_av ) )  ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'lwp_av', lwp_av )
-       ENDIF
-
-       CALL rrd_mpi_io( 'p', p)
-
-       CALL rd_mpi_io_check_array( 'p_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( p_av ) )  ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'p_av', p_av )
-       ENDIF
-
-       CALL rrd_mpi_io( 'pt', pt)
-
-       CALL rd_mpi_io_check_array( 'pt_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( pt_av ) )  ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'pt_av', pt_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'q' , found = array_found )
-       IF ( array_found )  THEN
-          CALL rrd_mpi_io( 'q', q )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'q_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( q_av ) )  ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'q_av', q_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'ql' , found = array_found )
-       IF ( array_found )  THEN
-          CALL rrd_mpi_io( 'ql', ql )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'ql_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( ql_av ) )  ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'ql_av', ql_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'qsurf_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( qsurf_av ) )  ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'qsurf_av', qsurf_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'qsws_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( qsws_av ) )  ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'qsws_av', qsws_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'qv_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( qv_av ) )  ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'qv_av', qv_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'r_a_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( r_a_av ) )  ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'r_a_av', r_a_av )
-       ENDIF
-
-!
-!--    ATTENTION: The random seeds are global data! If independent values for every PE are required,
-!--    the general approach of PE indendent restart will be lost. That means that in general the
-!--    parallel random number generator in random_generator_parallel_mod should be used!
-       CALL rrd_mpi_io_global_array( 'random_iv', random_iv )
-       CALL rrd_mpi_io( 'random_iy', random_iy )
-
-       CALL rd_mpi_io_check_array( 'id_random_array' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( id_random_array ) )  ALLOCATE( id_random_array(nys:nyn,nxl:nxr) )
-          IF ( .NOT. ALLOCATED( seq_random_array ) )  ALLOCATE( seq_random_array(5,nys:nyn,nxl:nxr) )
-          CALL rrd_mpi_io( 'id_random_array', id_random_array)
-          DO  i = 1, SIZE( seq_random_array, 1 )
-             WRITE( tmp_name, '(A,I2.2)' )  'seq_random_array', i
-             CALL rrd_mpi_io( TRIM(tmp_name), seq_random_array(i,:,:) )
-          ENDDO
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 's' , found = array_found )
-       IF ( array_found )  THEN
-          CALL rrd_mpi_io( 's', s )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 's_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( s_av ) )  ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 's_av', s_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'shf_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( shf_av ) )  ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'shf_av', shf_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'ssurf_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( ssurf_av ) )  ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'ssurf_av', ssurf_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'ssws_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( ssws_av ) )  ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'ssws_av', ssws_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'ts_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( ts_av ) )  ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'ts_av', ts_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'tsurf_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( tsurf_av ) )  ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'tsurf_av', tsurf_av )
-       ENDIF
-
-       CALL rrd_mpi_io( 'u', u)
-
-       CALL rd_mpi_io_check_array( 'u_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( u_av ) )  ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'u_av', u_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'us_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( us_av ) )  ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'us_av', us_av )
-       ENDIF
-
-       CALL rrd_mpi_io( 'v', v )
-
-       CALL rd_mpi_io_check_array( 'v_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( v_av ) )  ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'v_av', v_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'vpt' , found = array_found )
-       IF ( array_found )  THEN
-          CALL rrd_mpi_io( 'vpt',  vpt)
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'vpt_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( vpt_av ) )  ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'vpt_av', vpt_av )
-       ENDIF
-
-       CALL rrd_mpi_io( 'w', w)
-
-       CALL rd_mpi_io_check_array( 'w_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( w_av ) )  ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'w_av', w_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'z0_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( z0_av ) )  ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'z0_av', z0_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'z0h_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( z0h_av ) )  ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'z0h_av', z0h_av )
-       ENDIF
-
-       CALL rd_mpi_io_check_array( 'z0q_av' , found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( z0q_av ) )  ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
-          CALL rrd_mpi_io( 'z0q_av', z0q_av )
-       ENDIF
-
-!
-!--    Read restart data of surfaces
-       CALL surface_rrd_local
-
-!
-!--    Read restart data of other modules
-       CALL module_interface_rrd_local
-
-!
-!--    Close restart file
-       CALL rd_mpi_io_close
-
-    ENDIF
-
-    CALL location_message( 'reading local restart data', 'finished' )
-!
-!-- End of time measuring for reading binary data
-    CALL cpu_log( log_point_s(14), 'read-restart-data-local', 'stop' )
-
- END SUBROUTINE rrd_local
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Skipping the global control variables from restart-file (binary format)
-!------------------------------------------------------------------------------!
- SUBROUTINE rrd_skip_global
-
-
-    CHARACTER (LEN=1) ::  cdum
-
-
-    READ ( 13 )  length
-    READ ( 13 )  restart_string(1:length)
-
-    DO  WHILE ( restart_string(1:length) /= 'binary_version_local' )
-
-       READ ( 13 )  cdum
-       READ ( 13 )  length
-       READ ( 13 )  restart_string(1:length)
-
-    ENDDO
-
-    BACKSPACE ( 13 )
-    BACKSPACE ( 13 )
-
-
- END SUBROUTINE rrd_skip_global
-
-
- END MODULE read_restart_data_mod
Index: palm/trunk/SOURCE/read_var_list.f90
===================================================================
--- palm/trunk/SOURCE/read_var_list.f90	(revision 1)
+++ palm/trunk/SOURCE/read_var_list.f90	(revision 1)
@@ -0,0 +1,490 @@
+ SUBROUTINE read_var_list
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: read_var_list.f90,v $
+! Revision 1.34  2006/08/22 14:14:27  raasch
+! +dz_max
+!
+! Revision 1.33  2006/08/04 15:04:08  raasch
+! +first_call_advec_particles, time_dopts, use_upstream_for_tke
+!
+! Revision 1.32  2006/02/23 12:53:31  raasch
+! +building parameters, conserve_volume_flow, dissipation_1d, e_min,
+! mixing_length_1d, topography,
+! -average_count_pl, time_average_pr,
+! nt_anz renamed current_timestep_number, ..pl.. renamed ..do..
+!
+! Revision 1.31  2005/06/29 09:12:49  steinfeld
+! +ug_surface, ug_vertical_gradient, ug_vertical_gradient_level,
+! ug_vertical_gradient_level_ind, vg_surface, vg_vertical_gradient,
+! vg_vertical_gradient_level, vg_vertical_gradient_level_ind;
+! allocation of the new arrays ug and vg
+!
+! Revision 1.30  2005/06/26 20:09:42  raasch
+! +cloud_droplets
+!
+! Revision 1.29  2005/05/18 15:55:12  raasch
+! +netcdf_precision
+!
+! Revision 1.28  2005/03/26 21:01:00  raasch
+! +bc_lr, bc_ns, inflow_disturbance_begin, inflow_disturbance_end, km_damp_max,
+! outflow_damping_width
+!
+! Revision 1.27  2004/04/30 12:49:56  raasch
+! +grid_matching, impulse_advec renamed momentum_advec
+!
+! Revision 1.26  2004/01/28 15:27:33  raasch
+! at and bt replaced by array tsc
+!
+! Revision 1.25  2003/10/29 09:10:41  raasch
+! +last_dt_change
+!
+! Revision 1.24  2003/03/14 13:47:15  raasch
+! +random_generator
+!
+! Revision 1.23  2002/12/19 16:18:27  raasch
+! Array hom, which was formerly read in init_3d_model, will now be allocated
+! and read here, binary version incremented to 2.2, +time_restart,
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.22  2002/04/16 08:21:06  raasch
+! +bc_s_b, bc_s_t, surface_scalarflux, s_surface, s_surface_initial_change,
+! s_vertical_gradient, s_vertical_gradient_level
+!
+! Revision 1.21  2001/08/21 10:01:23  raasch
+! +wall_adjustment
+!
+! Revision 1.20  2001/03/30 07:51:25  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.),
+! runtime and package parameters are not read from unit 13 any more
+!
+! Revision 1.19  2001/01/29 12:35:03  raasch
+! +passive_scalar
+!
+! Revision 1.18  2001/01/25 07:24:28  raasch
+! +fft_method, use_surface_fluxes
+!
+! Revision 1.17  2001/01/05 15:16:18  raasch
+! +average_count_sp, time_dosp
+!
+! Revision 1.16  2000/12/28 13:38:46  raasch
+! Module dvrp_variables removed, -particle_transport
+!
+! Revision 1.15  2000/04/27 06:57:04  raasch
+! +dt_dvrp, dvrp_filecount, npex, npey, threshold, time_dvrp
+! -dt_plisos, dt_plpart, time_plisos, time_plpart,
+! all comments translated into English, old revision remarks deleted
+!
+! Revision 1.14  2000/04/13 13:06:16  schroeter
+! Einlesen der Initialisierungsparameter fuer Rechnungen
+! mit Feuchte/Wolkenphysik
+!
+! Revision 1.13  2000/01/10  10:06:32  10:06:32  raasch (Siegfried Raasch)
+! +use_ug_for_galilei_tr
+! 
+! Revision 1.1  1998/03/18 20:18:48  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Reading values of control variables from restart-file (binary format)
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE averaging
+    USE grid_variables
+    USE indices
+    USE model_1d
+    USE pegrid
+    USE profil_parameter
+    USE statistics
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=10) ::  binary_version, version_on_file
+    CHARACTER (LEN=30) ::  variable_chr
+    
+    CALL check_open( 13 )
+
+!
+!-- Make version number check first
+    READ ( 13 )  version_on_file
+    binary_version = '3.0'
+    IF ( TRIM( version_on_file ) /= TRIM( binary_version ) )  THEN
+       IF ( myid == 0 )  THEN
+          PRINT*, '+++ read_var_list: version mismatch concerning control', &
+                  ' variables'
+          PRINT*, '                   version on file    = "', &
+                  TRIM( version_on_file ), '"'
+          PRINT*, '                   version on program = "', &
+                  TRIM( binary_version ), '"'
+       ENDIF
+       CALL local_stop
+    ENDIF
+
+!
+!-- Read vertical number of gridpoints and number of different areas used
+!-- for computing statistics. Allocate arrays depending on these values,
+!-- which are needed for the following read instructions.
+    READ ( 13 )  variable_chr
+    IF ( TRIM( variable_chr ) /= 'nz' )  THEN
+       PRINT*, '+++ read_var_list: nz not found in data from prior run on PE ',&
+               myid
+       CALL local_stop
+    ENDIF
+    READ ( 13 )  nz
+    READ ( 13 )  variable_chr
+    IF ( TRIM( variable_chr ) /= 'statistic_regions' )  THEN
+       PRINT*, '+++ read_var_list: statistic_regions not found in data from ', &
+                    'prior run on PE ', myid
+       CALL local_stop
+    ENDIF
+    READ ( 13 )  statistic_regions
+    ALLOCATE( ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1), v_init(0:nz+1), & 
+              pt_init(0:nz+1), q_init(0:nz+1), &
+              hom(0:nz+1,2,var_hom,0:statistic_regions) )
+
+!
+!-- Now read all control parameters:
+!-- Caution: When the following read instructions have been changed, the
+!-- -------  version number stored in the variable binary_version has to be
+!--          increased. The same changes must also be done in write_var_list.
+    READ ( 13 )  variable_chr
+    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
+
+       SELECT CASE ( TRIM( variable_chr ) )
+
+          CASE ( 'adjust_mixing_length' )
+             READ ( 13 )  adjust_mixing_length
+          CASE ( 'advected_distance_x' )
+             READ ( 13 )  advected_distance_x
+          CASE ( 'advected_distance_y' )
+             READ ( 13 )  advected_distance_y
+          CASE ( 'alpha_surface' )
+             READ ( 13 )  alpha_surface
+          CASE ( 'average_count_pr' )
+             READ ( 13 )  average_count_pr
+          CASE ( 'average_count_sp' )
+             READ ( 13 )  average_count_sp
+          CASE ( 'average_count_3d' )
+             READ ( 13 )  average_count_3d
+          CASE ( 'bc_e_b' )
+             READ ( 13 )  bc_e_b
+          CASE ( 'bc_lr' )
+             READ ( 13 )  bc_lr
+          CASE ( 'bc_ns' )
+             READ ( 13 )  bc_ns
+          CASE ( 'bc_p_b' )
+             READ ( 13 )  bc_p_b
+          CASE ( 'bc_p_t' )
+             READ ( 13 )  bc_p_t
+          CASE ( 'bc_pt_b' )
+             READ ( 13 )  bc_pt_b
+          CASE ( 'bc_pt_t' )
+             READ ( 13 )  bc_pt_t
+          CASE ( 'bc_pt_t_val' )
+             READ ( 13 )  bc_pt_t_val
+          CASE ( 'bc_q_b' )
+             READ ( 13 )  bc_q_b
+          CASE ( 'bc_q_t' )
+             READ ( 13 )  bc_q_t
+          CASE ( 'bc_q_t_val' )
+             READ ( 13 )  bc_q_t_val
+          CASE ( 'bc_s_b' )
+             READ ( 13 )  bc_s_b
+          CASE ( 'bc_s_t' )
+             READ ( 13 )  bc_s_t
+          CASE ( 'bc_uv_b' )
+             READ ( 13 )  bc_uv_b
+          CASE ( 'bc_uv_t' )
+             READ ( 13 )  bc_uv_t
+          CASE ( 'building_height' )
+             READ ( 13 )  building_height
+          CASE ( 'building_length_x' )
+             READ ( 13 )  building_length_x
+          CASE ( 'building_length_y' )
+             READ ( 13 )  building_length_y
+          CASE ( 'building_wall_left' )
+             READ ( 13 )  building_wall_left
+          CASE ( 'building_wall_south' )
+             READ ( 13 )  building_wall_south
+          CASE ( 'cloud_droplets' )
+             READ ( 13 )  cloud_droplets
+          CASE ( 'cloud_physics' )
+             READ ( 13 )  cloud_physics
+          CASE ( 'conserve_volume_flow' )
+             READ ( 13 )  conserve_volume_flow
+          CASE ( 'current_timestep_number' )
+             READ ( 13 )  current_timestep_number
+          CASE ( 'cut_spline_overshoot' )
+             READ ( 13 )  cut_spline_overshoot
+          CASE ( 'damp_level_1d' )
+             READ ( 13 )  damp_level_1d
+          CASE ( 'dissipation_1d' )
+             READ ( 13 )  dissipation_1d
+          CASE ( 'dt_fixed' )
+             READ ( 13 )  dt_fixed
+          CASE ( 'dt_pr_1d' )
+             READ ( 13 )  dt_pr_1d
+          CASE ( 'dt_run_control_1d' )
+             READ ( 13 )  dt_run_control_1d
+          CASE ( 'dt_3d' )
+             READ ( 13 )  dt_3d
+          CASE ( 'dvrp_filecount' )
+             READ ( 13 )  dvrp_filecount
+          CASE ( 'dx' )
+             READ ( 13 )  dx
+          CASE ( 'dy' )
+             READ ( 13 )  dy
+          CASE ( 'dz' )
+             READ ( 13 )  dz
+          CASE ( 'dz_max' )
+             READ ( 13 )  dz_max
+          CASE ( 'dz_stretch_factor' )
+             READ ( 13 )  dz_stretch_factor
+          CASE ( 'dz_stretch_level' )
+             READ ( 13 )  dz_stretch_level
+          CASE ( 'e_min' )
+             READ ( 13 )  e_min
+          CASE ( 'end_time_1d' )
+             READ ( 13 )  end_time_1d
+          CASE ( 'fft_method' )
+             READ ( 13 )  fft_method
+          CASE ( 'first_call_advec_particles' )
+             READ ( 13 )  first_call_advec_particles
+          CASE ( 'galilei_transformation' )
+             READ ( 13 )  galilei_transformation
+          CASE ( 'grid_matching' )
+             READ ( 13 )  grid_matching
+          CASE ( 'hom' )
+             READ ( 13 )  hom
+          CASE ( 'inflow_disturbance_begin' )
+             READ ( 13 )  inflow_disturbance_begin
+          CASE ( 'inflow_disturbance_end' )
+             READ ( 13 )  inflow_disturbance_end
+          CASE ( 'km_constant' )
+             READ ( 13 )  km_constant
+          CASE ( 'km_damp_max' )
+             READ ( 13 )  km_damp_max
+          CASE ( 'last_dt_change' )
+             READ ( 13 )  last_dt_change
+          CASE ( 'long_filter_factor' )
+             READ ( 13 )  long_filter_factor
+          CASE ( 'mixing_length_1d' )
+             READ ( 13 )  mixing_length_1d
+          CASE ( 'moisture' )
+             READ ( 13 )  moisture
+          CASE ( 'momentum_advec' )
+             READ ( 13 )  momentum_advec
+          CASE ( 'netcdf_precision' )
+             READ ( 13 )  netcdf_precision
+          CASE ( 'npex' )
+             READ ( 13 )  npex
+          CASE ( 'npey' )
+             READ ( 13 )  npey
+          CASE ( 'nsor_ini' )
+             READ ( 13 )  nsor_ini
+          CASE ( 'nx' )
+             READ ( 13 )  nx
+          CASE ( 'ny' )
+             READ ( 13 )  ny
+          CASE ( 'old_dt' )
+             READ ( 13 )  old_dt
+          CASE ( 'omega' )
+             READ ( 13 )  omega
+          CASE ( 'outflow_damping_width' )
+             READ ( 13 )  outflow_damping_width
+          CASE ( 'overshoot_limit_e' )
+             READ ( 13 )  overshoot_limit_e
+          CASE ( 'overshoot_limit_pt' )
+             READ ( 13 )  overshoot_limit_pt
+          CASE ( 'overshoot_limit_u' )
+             READ ( 13 )  overshoot_limit_u
+          CASE ( 'overshoot_limit_v' )
+             READ ( 13 )  overshoot_limit_v
+          CASE ( 'overshoot_limit_w' )
+             READ ( 13 )  overshoot_limit_w
+          CASE ( 'passive_scalar' )
+             READ ( 13 )  passive_scalar
+          CASE ( 'phi' )
+             READ ( 13 )  phi
+          CASE ( 'prandtl_layer' )
+             READ ( 13 )  prandtl_layer
+          CASE ( 'precipitation' )
+             READ ( 13 ) precipitation
+          CASE ( 'pt_init' )
+             READ ( 13 )  pt_init
+          CASE ( 'pt_surface' )
+             READ ( 13 )  pt_surface
+          CASE ( 'pt_surface_initial_change' )
+             READ ( 13 )  pt_surface_initial_change
+          CASE ( 'pt_vertical_gradient' )
+             READ ( 13 )  pt_vertical_gradient
+          CASE ( 'pt_vertical_gradient_level' )
+             READ ( 13 )  pt_vertical_gradient_level
+          CASE ( 'pt_vertical_gradient_level_ind' )
+             READ ( 13 )  pt_vertical_gradient_level_ind
+          CASE ( 'q_init' )
+             READ ( 13 )  q_init
+          CASE ( 'q_surface' )
+             READ ( 13 )  q_surface
+          CASE ( 'q_surface_initial_change' )
+             READ ( 13 )  q_surface_initial_change
+          CASE ( 'q_vertical_gradient' )
+             READ ( 13 )  q_vertical_gradient
+          CASE ( 'q_vertical_gradient_level' )
+             READ ( 13 )  q_vertical_gradient_level
+          CASE ( 'q_vertical_gradient_level_ind' )
+             READ ( 13 )  q_vertical_gradient_level_ind
+          CASE ( 'radiation' )
+             READ ( 13 )  radiation
+          CASE ( 'random_generator' )
+             READ ( 13 )  random_generator
+          CASE ( 'random_heatflux' )
+             READ ( 13 )  random_heatflux
+          CASE ( 'rif_max' )
+             READ ( 13 )  rif_max
+          CASE ( 'rif_min' )
+             READ ( 13 )  rif_min
+          CASE ( 'roughness_length' )
+             READ ( 13 )  roughness_length
+          CASE ( 'runnr' )
+             READ ( 13 )  runnr
+          CASE ( 'scalar_advec' )
+             READ ( 13 )  scalar_advec
+          CASE ( 'simulated_time' )
+             READ ( 13 )  simulated_time
+          CASE ( 'surface_heatflux' )
+             READ ( 13 )  surface_heatflux
+          CASE ( 'surface_pressure' )
+             READ ( 13 )  surface_pressure
+          CASE ( 'surface_scalarflux' )
+             READ ( 13 )  surface_scalarflux             
+          CASE ( 'surface_waterflux' )
+             READ ( 13 )  surface_waterflux             
+          CASE ( 's_surface' )
+             READ ( 13 )  s_surface
+          CASE ( 's_surface_initial_change' )
+             READ ( 13 )  s_surface_initial_change
+          CASE ( 's_vertical_gradient' )
+             READ ( 13 )  s_vertical_gradient
+          CASE ( 's_vertical_gradient_level' )
+             READ ( 13 )  s_vertical_gradient_level
+          CASE ( 'time_disturb' )
+             READ ( 13 )  time_disturb
+          CASE ( 'time_dopr' )
+             READ ( 13 )  time_dopr
+          CASE ( 'time_dopr_av' )
+             READ ( 13 )  time_dopr_av
+          CASE ( 'time_dopr_listing' )
+             READ ( 13 )  time_dopr_listing
+          CASE ( 'time_dopts' )
+             READ ( 13 )  time_dopts
+          CASE ( 'time_dosp' )
+             READ ( 13 )  time_dosp
+          CASE ( 'time_dots' )
+             READ ( 13 )  time_dots
+          CASE ( 'time_do2d_xy' )
+             READ ( 13 )  time_do2d_xy
+          CASE ( 'time_do2d_xz' )
+             READ ( 13 )  time_do2d_xz
+          CASE ( 'time_do2d_yz' )
+             READ ( 13 )  time_do2d_yz
+          CASE ( 'time_do3d' )
+             READ ( 13 )  time_do3d
+          CASE ( 'time_do_av' )
+             READ ( 13 )  time_do_av
+          CASE ( 'time_do_sla' )
+             READ ( 13 )  time_do_sla
+          CASE ( 'time_dvrp' )
+             READ ( 13 )  time_dvrp
+          CASE ( 'time_restart' )
+             READ ( 13 )  time_restart
+          CASE ( 'time_run_control' )
+             READ ( 13 )  time_run_control
+          CASE ( 'timestep_scheme' )
+             READ ( 13 )  timestep_scheme
+          CASE ( 'topography' )
+             READ ( 13 )  topography
+          CASE ( 'tsc' )
+             READ ( 13 )  tsc
+          CASE ( 'u_init' )
+             READ ( 13 )  u_init
+          CASE ( 'u_max' )
+             READ ( 13 )  u_max
+          CASE ( 'u_max_ijk' )
+             READ ( 13 )  u_max_ijk
+          CASE ( 'ug' )
+             READ ( 13 )  ug
+          CASE ( 'ug_surface' )
+             READ ( 13 )  ug_surface
+          CASE ( 'ug_vertical_gradient' )
+             READ ( 13 )  ug_vertical_gradient
+          CASE ( 'ug_vertical_gradient_level' )
+             READ ( 13 )  ug_vertical_gradient_level
+          CASE ( 'ug_vertical_gradient_level_ind' )
+             READ ( 13 )  ug_vertical_gradient_level_ind
+          CASE ( 'ups_limit_e' )
+             READ ( 13 )  ups_limit_e
+          CASE ( 'ups_limit_pt' )
+             READ ( 13 )  ups_limit_pt
+          CASE ( 'ups_limit_u' )
+             READ ( 13 )  ups_limit_u
+          CASE ( 'ups_limit_v' )
+             READ ( 13 )  ups_limit_v
+          CASE ( 'ups_limit_w' )
+             READ ( 13 )  ups_limit_w
+          CASE ( 'use_surface_fluxes' )
+             READ ( 13 )  use_surface_fluxes
+          CASE ( 'use_ug_for_galilei_tr' )
+             READ ( 13 )  use_ug_for_galilei_tr
+          CASE ( 'use_upstream_for_tke' )
+             READ ( 13 )  use_upstream_for_tke
+          CASE ( 'v_init' )
+             READ ( 13 )  v_init
+          CASE ( 'v_max' )
+             READ ( 13 )  v_max
+          CASE ( 'v_max_ijk' )
+             READ ( 13 )  v_max_ijk
+          CASE ( 'vg' )
+             READ ( 13 )  vg
+          CASE ( 'vg_surface' )
+             READ ( 13 )  vg_surface
+          CASE ( 'vg_vertical_gradient' )
+             READ ( 13 )  vg_vertical_gradient
+          CASE ( 'vg_vertical_gradient_level' )
+             READ ( 13 )  vg_vertical_gradient_level
+          CASE ( 'vg_vertical_gradient_level_ind' )
+             READ ( 13 )  vg_vertical_gradient_level_ind
+          CASE ( 'wall_adjustment' )
+             READ ( 13 )  wall_adjustment
+          CASE ( 'w_max' )
+             READ ( 13 )  w_max
+          CASE ( 'w_max_ijk' )
+             READ ( 13 )  w_max_ijk
+          CASE ( 'time-series-quantities' )
+             READ ( 13 )  cross_ts_uymax, cross_ts_uymax_computed, &
+                          cross_ts_uymin, cross_ts_uymin_computed
+
+          CASE DEFAULT
+             PRINT*, '+++ read_var_list: unknown variable named "', &
+                     TRIM( variable_chr ), '" found in'
+             PRINT*, '                   data from prior run on PE ', myid
+             CALL local_stop
+        END SELECT
+!
+!--    Read next string
+       READ ( 13 )  variable_chr
+
+    ENDDO
+
+
+ END SUBROUTINE read_var_list
Index: palm/trunk/SOURCE/restart_data_mpi_io_mod.f90
===================================================================
--- palm/trunk/SOURCE/restart_data_mpi_io_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,4857 +1,0 @@
-!> @file restart_data_mpi_io_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! more meaningful variable names assigned,
-! redundant code removed
-!
-! 4893 2021-03-02 16:39:14Z raasch
-! revised output of surface data via MPI-IO for better performance
-!
-! 4857 2021-01-26 07:24:41Z raasch
-! bugfix: allocation of 3d-int4 array moved from particle output to standard output
-!
-! 4832 2021-01-07 07:15:12Z raasch
-! some debug output flushed
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! interface for 3d logical arrays added
-!
-! 4694 2020-09-23 15:09:19Z pavelkrc
-! Fix name of subroutine in message
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4628 2020-07-29 07:23:03Z raasch
-! extensions required for MPI-I/O of particle data to restart files
-!
-! 4622 2020-07-23 09:02:23Z raasch
-! unused variables removed
-!
-! 4621 2020-07-23 08:15:59Z raasch
-! bugfixes for serial (non-parallel) mode
-!
-! 4619 2020-07-22 13:21:28Z raasch
-! unused variable removed
-!
-! 4617 2020-07-22 09:48:50Z raasch
-! Cyclic fill mode implemented
-!
-! 4598 2020-07-10 10:13:23Z suehring
-! Bugfix in treatment of 3D soil arrays
-!
-! 4591 2020-07-06 15:56:08Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4539 2020-05-18 14:05:17Z raasch
-! Checks added, if index limits in header are exceeded
-! Bugfix in rrd_mpi_io_int_2d
-!
-! 4536 2020-05-17 17:24:13Z raasch
-! Messages and debug output converted to PALM routines
-!
-! 4534 2020-05-14 18:35:22Z raasch
-! I/O on reduced number of cores added (using shared memory MPI)
-!
-! 4500 2020-04-17 10:12:45Z suehring
-! Fix too long lines
-!
-! 4498 2020-04-15 14:26:31Z raasch
-! Bugfix for creation of filetypes, argument removed from rd_mpi_io_open
-!
-! 4497 2020-04-15 10:20:51Z raasch
-! Last bugfix deactivated because of compile problems
-!
-! 4496 2020-04-15 08:37:26Z raasch
-! Problem with posix read arguments for surface data fixed
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! Initial version (K. Ketelsen), adjusted to PALM formatting standards (S. Raasch)
-!
-!
-! Description:
-! ------------
-!> Routines for restart data handling using MPI-IO.
-!--------------------------------------------------------------------------------------------------!
- MODULE restart_data_mpi_io_mod
-
-#if defined( __parallel )
-    USE MPI
-#else
-    USE posix_interface,                                                                           &
-        ONLY:  posix_close,                                                                        &
-               posix_lseek,                                                                        &
-               posix_open,                                                                         &
-               posix_read,                                                                         &
-               posix_write
-#endif
-
-    USE, INTRINSIC ::  ISO_C_BINDING
-
-    USE control_parameters,                                                                        &
-        ONLY:  debug_output,                                                                       &
-               debug_string,                                                                       &
-               include_total_domain_boundaries,                                                    &
-               message_string,                                                                     &
-               restart_data_format_input,                                                          &
-               restart_data_format_output,                                                         &
-               restart_file_size
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz,                                                                     &
-               exchange_horiz_2d
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nnx,                                                                                &
-               nny,                                                                                &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nx_on_file,                                                                         &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               ny,                                                                                 &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               ny_on_file,                                                                         &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nz,                                                                                 &
-               nzb,                                                                                &
-               nzt
-
-    USE kinds
-
-    USE particle_attributes,                                                                       &
-        ONLY:  grid_particles,                                                                     &
-               particles,                                                                          &
-               particle_type,                                                                      &
-               prt_count,                                                                          &
-               zero_particle
-
-    USE pegrid,                                                                                    &
-        ONLY:  comm1dx,                                                                            &
-               comm1dy,                                                                            &
-               comm2d,                                                                             &
-               communicator_configurations,                                                        &
-               myid,                                                                               &
-               myidx,                                                                              &
-               myidy,                                                                              &
-               numprocs,                                                                           &
-               pdims
-
-    USE shared_memory_io_mod,                                                                      &
-        ONLY:  domain_decomposition_grid_features,                                                 &
-               sm_class
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=128) ::  io_file_name  !> internal variable to communicate filename between different subroutines
-
-#if defined( __parallel )
-    INTEGER(iwp)            ::  ierr                              !< error status of MPI-calls
-    INTEGER(iwp), PARAMETER ::  rd_offset_kind = MPI_OFFSET_KIND  !< Adress or Offset kind
-    INTEGER(iwp), PARAMETER ::  rd_status_size = MPI_STATUS_SIZE  !<
-#else
-    INTEGER(iwp), PARAMETER ::  rd_offset_kind = C_SIZE_T         !<
-    INTEGER(iwp), PARAMETER ::  rd_status_size = 1                !< Not required in sequential mode
-#endif
-
-    INTEGER(iwp)            ::  debug_level = 1  !< TODO: replace with standard debug output steering
-
-    INTEGER(iwp)            ::  comm_io          !< Communicator for MPI-IO
-    INTEGER(iwp)            ::  fh = -1          !< MPI-IO file handle
-#if defined( __parallel )
-    INTEGER(iwp)            ::  ft_surf = -1     !< MPI filetype surface data
-    INTEGER(iwp)            ::  ft_2di_nb        !< MPI filetype 2D array INTEGER no outer boundary
-    INTEGER(iwp)            ::  ft_2d            !< MPI filetype 2D array REAL with outer boundaries
-    INTEGER(iwp)            ::  ft_3d            !< MPI filetype 3D array REAL with outer boundaries
-    INTEGER(iwp)            ::  ft_3di4 = -1     !< MPI filetype 3D array INTEGER*4
-    INTEGER(iwp)            ::  ft_3di8 = -1     !< MPI filetype 3D array INTEGER*8
-    INTEGER(iwp)            ::  ft_3dsoil        !< MPI filetype for 3d-soil array
-#endif
-    INTEGER(iwp)            ::  glo_start        !< global start index on this PE
-#if defined( __parallel )
-    INTEGER(iwp)            ::  win_2di          !<
-    INTEGER(iwp)            ::  win_2dr          !<
-    INTEGER(iwp)            ::  win_3di4 = -1    !<
-    INTEGER(iwp)            ::  win_3di8 = -1    !<
-    INTEGER(iwp)            ::  win_3dr          !<
-    INTEGER(iwp)            ::  win_3ds          !<
-    INTEGER(iwp)            ::  win_end   = -1   !<
-    INTEGER(iwp)            ::  win_glost = -1   !<
-    INTEGER(iwp)            ::  win_out   = -1   !<
-    INTEGER(iwp)            ::  win_start = -1   !<
-    INTEGER(iwp)            ::  win_surf = -1    !<
-#endif
-    INTEGER(iwp)            ::  total_number_of_surface_elements  !< total number of surface elements for one variable
-
-    INTEGER(KIND=rd_offset_kind) ::  array_position   !<
-    INTEGER(KIND=rd_offset_kind) ::  header_position  !<
-
-    INTEGER(iwp), DIMENSION(:,:), POINTER, CONTIGUOUS   ::  array_2di   !<
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  e_end_index       !< extended end index, every grid cell has at least one value
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  e_start_index     !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_end_index       !< module copy of end_index
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_start_index     !<
-    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  nr_surfaces_in_tb !< number of surface elements in transfer buffer
-    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  s_index_in_tb     !< start index of surface elements in transfer buffer
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  s_index_in_window !< start index for the pe in the rma window
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  transfer_index    !<
-!
-!-- Indices for cyclic fill
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  o_start_index   !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  c_start_index   !<
-!#if defined( __parallel )
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  o_end_index     !< extended end index, every grid cell has at least one value
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  c_end_index     !< extended end index, every grid cell has at least one value
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  c_global_start  !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  c_global_end    !<
-!#endif
-
-    INTEGER(isp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  array_3di4  !<
-    INTEGER(idp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  array_3di8  !<
-
-    LOGICAL ::  filetypes_created             !<
-    LOGICAL ::  io_on_limited_cores_per_node  !< switch to shared memory MPI-IO
-    LOGICAL ::  rd_flag                       !< file is opened for read
-    LOGICAL ::  wr_flag                       !< file is opened for write
-
-#if defined( __parallel )
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE       :: local_indices
-#endif
-
-    REAL(wp), DIMENSION(:), POINTER, CONTIGUOUS     ::  array_out      !<
-#if defined( __parallel )
-    REAL(wp), DIMENSION(:), POINTER, CONTIGUOUS     ::  array_1d       !<
-#endif
-    REAL(wp), DIMENSION(:,:), POINTER, CONTIGUOUS   ::  array_2d       !<
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  array_3d       !<
-    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  array_3d_soil  !<
-
-!
-!-- Variable to store the grid features (index bounds) of the temporary arrays that are used
-!-- to read and write the restart data. They differ depending on if the outer boundary of the
-!-- total domain is contained in the restart data or not. iog stands for IO-grid.
-    TYPE(domain_decomposition_grid_features) ::  iog  !<
-
-!
-!-- General Header (first 32 byte in restart file)
-    TYPE general_header
-       INTEGER(iwp) :: endian         !< little endian (1) or big endian (2) internal format
-       INTEGER(iwp) :: i_outer_bound  !< if 1, outer boundaries are stored in restart file
-       INTEGER(iwp) :: nr_arrays      !< number of arrays in restart files
-       INTEGER(iwp) :: nr_char        !< number of Text strings entries in header
-       INTEGER(iwp) :: nr_int         !< number of INTEGER entries in header
-       INTEGER(iwp) :: nr_real        !< number of REAL entries in header
-       INTEGER(iwp) :: pes_along_x    !< number of PEs along x-direction during writing restart file
-       INTEGER(iwp) :: pes_along_y    !< number of PEs along y-direction during writing restart file
-       INTEGER(iwp) :: total_nx       !< total number of points in x-direction
-       INTEGER(iwp) :: total_ny       !< total number of points in y-direction
-    END TYPE general_header
-
-    TYPE(general_header), TARGET, PUBLIC ::  tgh    !<
-
-    TYPE(sm_class)               ::  sm_io  !<
-
-!
-!-- Declaration of varibales for file header section
-    INTEGER(KIND=rd_offset_kind)                ::  header_int_index
-    INTEGER, PARAMETER                          ::  max_nr_int=256
-    CHARACTER(LEN=32), DIMENSION(max_nr_int)    ::  int_names
-    INTEGER(KIND=iwp), DIMENSION(max_nr_int)    ::  int_values
-
-    INTEGER(KIND=rd_offset_kind)                ::  header_char_index
-    INTEGER, PARAMETER                          ::  max_nr_char=128
-    CHARACTER(LEN=128), DIMENSION(max_nr_char)  ::  text_lines
-
-    INTEGER(KIND=rd_offset_kind)                ::  header_real_index
-    INTEGER, PARAMETER                          ::  max_nr_real=256
-    CHARACTER(LEN=32), DIMENSION(max_nr_real)   ::  real_names
-    REAL(KIND=wp), DIMENSION(max_nr_real)       ::  real_values
-
-    INTEGER(KIND=rd_offset_kind)                ::  header_array_index
-    INTEGER, PARAMETER                          ::  max_nr_arrays=600
-    CHARACTER(LEN=32), DIMENSION(max_nr_arrays) ::  array_names
-    INTEGER(KIND=rd_offset_kind), DIMENSION(max_nr_arrays) :: array_offset
-
-!
-!-- Variables to handle the cyclic fill initialization mode
-    INTEGER ::  comm_cyclic_fill  !< communicator for cyclic fill PEs
-#if defined( __parallel )
-    INTEGER ::  rmawin_2di        !< RMA window 2d INTEGER
-    INTEGER ::  rmawin_2d         !< RMA window 2d REAL
-    INTEGER ::  rmawin_3d         !< RMA window 3d
-#endif
-
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) ::  remote_pe
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) ::  remote_pe_s
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) ::  rma_offset
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) ::  rma_offset_s
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) ::  rmabuf_2di
-
-    LOGICAL ::  cyclic_fill_mode            !< arrays are filled cyclically with data from prerun
-    LOGICAL ::  pe_active_for_read = .TRUE. !< this PE is active for reading data from prerun or
-                                            !< restart run. For restarts all PEs are active.
-
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: rmabuf_2d
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: rmabuf_3d
-
-    TYPE(domain_decomposition_grid_features) ::  mainrun_grid  !< grid variables for the main run
-    TYPE(domain_decomposition_grid_features) ::  prerun_grid   !< grid variables for the prerun
-
-!
-!-- MPI_INTEGER8 is not standard MPI, but is supported on most MPI distibutions
-!-- If not suppported, a workaround could be enabled with the following preprocessor directive
-!#if defined( __NO_INTEGER8)
-!    INTEGER ::  MPI_INTEGER8  !< MPI data type INTEGER8
-!#endif
-
-    SAVE
-
-    PRIVATE
-
-    PUBLIC  restart_file_size, total_number_of_surface_elements
-
-!
-!-- PALM interfaces
-    INTERFACE rd_mpi_io_check_array
-       MODULE PROCEDURE rd_mpi_io_check_array
-    END INTERFACE rd_mpi_io_check_array
-
-    INTERFACE rd_mpi_io_close
-       MODULE PROCEDURE rd_mpi_io_close
-    END INTERFACE rd_mpi_io_close
-
-    INTERFACE rd_mpi_io_check_open
-       MODULE PROCEDURE rd_mpi_io_check_open
-    END INTERFACE rd_mpi_io_check_open
-
-    INTERFACE rd_mpi_io_open
-       MODULE PROCEDURE rd_mpi_io_open
-    END INTERFACE rd_mpi_io_open
-
-    INTERFACE rrd_mpi_io
-       MODULE PROCEDURE rrd_mpi_io_char
-       MODULE PROCEDURE rrd_mpi_io_int
-       MODULE PROCEDURE rrd_mpi_io_int_2d
-       MODULE PROCEDURE rrd_mpi_io_int4_3d
-       MODULE PROCEDURE rrd_mpi_io_int8_3d
-       MODULE PROCEDURE rrd_mpi_io_logical
-       MODULE PROCEDURE rrd_mpi_io_logical_3d
-       MODULE PROCEDURE rrd_mpi_io_real
-       MODULE PROCEDURE rrd_mpi_io_real_2d
-       MODULE PROCEDURE rrd_mpi_io_real_3d
-       MODULE PROCEDURE rrd_mpi_io_real_3d_soil
-    END INTERFACE rrd_mpi_io
-
-    INTERFACE rrd_mpi_io_global_array
-       MODULE PROCEDURE rrd_mpi_io_global_array_int_1d
-       MODULE PROCEDURE rrd_mpi_io_global_array_real_1d
-       MODULE PROCEDURE rrd_mpi_io_global_array_real_2d
-       MODULE PROCEDURE rrd_mpi_io_global_array_real_3d
-       MODULE PROCEDURE rrd_mpi_io_global_array_real_4d
-    END INTERFACE rrd_mpi_io_global_array
-
-    INTERFACE rrd_mpi_io_surface
-       MODULE PROCEDURE rrd_mpi_io_surface
-       MODULE PROCEDURE rrd_mpi_io_surface_2d
-    END INTERFACE rrd_mpi_io_surface
-
-    INTERFACE rrd_mpi_io_particles
-       MODULE PROCEDURE rrd_mpi_io_particles
-    END INTERFACE rrd_mpi_io_particles
-
-    INTERFACE rd_mpi_io_particle_filetypes
-       MODULE PROCEDURE rd_mpi_io_particle_filetypes
-    END INTERFACE rd_mpi_io_particle_filetypes
-
-    INTERFACE rd_mpi_io_surface_filetypes
-       MODULE PROCEDURE rd_mpi_io_surface_filetypes
-    END INTERFACE rd_mpi_io_surface_filetypes
-
-    INTERFACE wrd_mpi_io
-       MODULE PROCEDURE wrd_mpi_io_char
-       MODULE PROCEDURE wrd_mpi_io_int
-       MODULE PROCEDURE wrd_mpi_io_int_2d
-       MODULE PROCEDURE wrd_mpi_io_int4_3d
-       MODULE PROCEDURE wrd_mpi_io_int8_3d
-       MODULE PROCEDURE wrd_mpi_io_logical
-       MODULE PROCEDURE wrd_mpi_io_logical_3d
-       MODULE PROCEDURE wrd_mpi_io_real
-       MODULE PROCEDURE wrd_mpi_io_real_2d
-       MODULE PROCEDURE wrd_mpi_io_real_3d
-       MODULE PROCEDURE wrd_mpi_io_real_3d_soil
-    END INTERFACE wrd_mpi_io
-
-    INTERFACE wrd_mpi_io_global_array
-       MODULE PROCEDURE wrd_mpi_io_global_array_int_1d
-       MODULE PROCEDURE wrd_mpi_io_global_array_real_1d
-       MODULE PROCEDURE wrd_mpi_io_global_array_real_2d
-       MODULE PROCEDURE wrd_mpi_io_global_array_real_3d
-       MODULE PROCEDURE wrd_mpi_io_global_array_real_4d
-    END INTERFACE wrd_mpi_io_global_array
-
-    INTERFACE wrd_mpi_io_particles
-       MODULE PROCEDURE wrd_mpi_io_particles
-    END INTERFACE wrd_mpi_io_particles
-
-    INTERFACE wrd_mpi_io_surface
-       MODULE PROCEDURE wrd_mpi_io_surface
-       MODULE PROCEDURE wrd_mpi_io_surface_2d
-    END INTERFACE wrd_mpi_io_surface
-
-    PUBLIC  rd_mpi_io_check_array,                                                                 &
-            rd_mpi_io_check_open,                                                                  &
-            rd_mpi_io_close,                                                                       &
-            rd_mpi_io_open,                                                                        &
-            rd_mpi_io_particle_filetypes,                                                          &
-            rd_mpi_io_surface_filetypes,                                                           &
-            rrd_mpi_io,                                                                            &
-            rrd_mpi_io_global_array,                                                               &
-            rrd_mpi_io_particles,                                                                  &
-            rrd_mpi_io_surface,                                                                    &
-            wrd_mpi_io,                                                                            &
-            wrd_mpi_io_global_array,                                                               &
-            wrd_mpi_io_particles,                                                                  &
-            wrd_mpi_io_surface
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Open restart file for read or write with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rd_mpi_io_open( action, file_name, open_for_global_io_only )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  action     !<
-    CHARACTER(LEN=*), INTENT(IN) ::  file_name  !<
-
-    INTEGER(iwp)                 ::  i          !<
-    INTEGER(iwp)                 ::  gh_size    !<
-
-    INTEGER(KIND=rd_offset_kind) ::  offset     !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-
-    LOGICAL, INTENT(IN), OPTIONAL ::  open_for_global_io_only  !<
-    LOGICAL                       ::  set_filetype             !<
-
-#if ! defined( __parallel )
-    TYPE(C_PTR)                   ::  buf_ptr  !<
-#endif
-
-
-    offset = 0
-    io_on_limited_cores_per_node = .FALSE.
-
-    rd_flag = ( TRIM( action ) == 'READ'  .OR. TRIM( action ) == 'read'  )
-    wr_flag = ( TRIM( action ) == 'WRITE' .OR. TRIM( action ) == 'write' )
-
-    IF ( .NOT. ( rd_flag .OR. wr_flag ) )  THEN
-       message_string = 'illegal action "' // TRIM( action ) // '" for opening restart files'
-       CALL message( 'restart_data_mpi_io_mod', 'PA0720', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Store name of I/O file to communicate it internally within this module.
-    io_file_name = file_name
-!
-!-- Setup for IO on a limited number of PEs per node (using shared memory MPI)
-    IF ( rd_flag )  THEN
-       set_filetype = .TRUE.
-       IF ( TRIM( restart_data_format_input ) == 'mpi_shared_memory' )  THEN
-          io_on_limited_cores_per_node = .TRUE.
-       ENDIF
-    ENDIF
-
-    IF ( TRIM( restart_data_format_output ) == 'mpi_shared_memory' .AND.  wr_flag )  THEN
-       io_on_limited_cores_per_node = .TRUE.
-    ENDIF
-!
-!-- Shared memory MPI is not used for reading of global data
-    IF ( PRESENT( open_for_global_io_only )  .AND.  rd_flag )  THEN
-       IF ( open_for_global_io_only )  THEN
-          io_on_limited_cores_per_node = .FALSE.
-          set_filetype                 = .FALSE.
-       ENDIF
-    ENDIF
-
-!
-!-- Determine, if prerun data shall be read and mapped cyclically to the mainrun arrays.
-!-- In cyclic fill mode only a subset of the PEs will read.
-    cyclic_fill_mode   = .FALSE.
-    pe_active_for_read = .TRUE.
-
-    IF ( rd_flag  .AND.  .NOT. PRESENT( open_for_global_io_only )  .AND.                           &
-         nx_on_file < nx  .AND.  ny_on_file < ny )  THEN
-       cyclic_fill_mode = .TRUE.
-       CALL setup_cyclic_fill
-!
-!--    Shared memory IO on limited cores is not allowed for cyclic fill mode
-       CALL sm_io%sm_init_comm( .FALSE. )  !
-    ELSE
-       CALL sm_io%sm_init_comm( io_on_limited_cores_per_node )
-    ENDIF
-
-!
-!-- TODO: add a more detailed meaningful comment about what is happening here
-!-- activate model grid
-    IF( cyclic_fill_mode  .AND.  .NOT. pe_active_for_read )  THEN
-      CALL mainrun_grid%activate_grid_from_this_class()
-      RETURN
-    ENDIF
-
-
-!
-!-- Set communicator to be used. If all cores are doing I/O, comm2d is used as usual.
-    IF( sm_io%is_sm_active() )  THEN
-       comm_io = sm_io%comm_io
-    ELSEIF ( cyclic_fill_mode )  THEN
-       comm_io = comm_cyclic_fill
-    ELSE
-       comm_io = comm2d
-    ENDIF
-
-!
-!-- Create subarrays and file types
-    filetypes_created = .FALSE.
-
-!
-!-- In case of read it is not known yet if data include total domain. Filetypes will be created
-!-- further below.
-    IF ( wr_flag )  THEN
-       CALL rd_mpi_io_create_filetypes
-       filetypes_created = .TRUE.
-    ENDIF
-
-!
-!-- Open file for MPI-IO
-#if defined( __parallel )
-    IF ( sm_io%iam_io_pe )  THEN
-
-       IF ( rd_flag )  THEN
-
-          IF ( debug_output )  THEN
-             WRITE( debug_string, * )  'open joint restart file "' // TRIM( io_file_name ) //      &
-                                       '" for read with MPI-IO'
-             CALL debug_message( debug_string, 'start' )
-          ENDIF
-
-          CALL MPI_FILE_OPEN( comm_io, TRIM( io_file_name ), MPI_MODE_RDONLY, MPI_INFO_NULL, fh,   &
-                              ierr )
-
-          IF ( ierr /= 0 )  THEN
-             message_string = 'error opening restart file "' // TRIM( io_file_name ) //            &
-                              '" for reading with MPI-IO'
-             CALL message( 'rrd_mpi_io_open', 'PA0727', 3, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( debug_output )  THEN
-             WRITE( debug_string, * )  'open joint restart file "' // TRIM( io_file_name ) //      &
-                                       '" for read with MPI-IO'
-             CALL debug_message( debug_string, 'end' )
-          ENDIF
-
-       ELSEIF ( wr_flag )  THEN
-
-          IF ( debug_output )  THEN
-             WRITE( debug_string, * )  'open joint restart file "' // TRIM( io_file_name ) //      &
-                                       '" for write with MPI-IO'
-             CALL debug_message( debug_string, 'start' )
-          ENDIF
-
-          CALL MPI_FILE_OPEN( comm_io, TRIM( io_file_name ), MPI_MODE_CREATE+MPI_MODE_WRONLY,      &
-                              MPI_INFO_NULL, fh, ierr )
-
-          IF ( ierr /= 0 )  THEN
-             message_string = 'error opening restart file "' // TRIM( io_file_name ) //            &
-                              '" for writing with MPI-IO'
-             CALL message( 'rrd_mpi_io_open', 'PA0728', 3, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( debug_output )  THEN
-             WRITE( debug_string, * )  'open joint restart file "' // TRIM( io_file_name ) //      &
-                                       '" for write with MPI-IO'
-             CALL debug_message( debug_string, 'end' )
-          ENDIF
-
-       ENDIF
-
-    ENDIF
-#else
-    IF ( rd_flag )  THEN
-
-       IF ( debug_output )  THEN
-          WRITE( debug_string, * )  'open restart file "' // TRIM( io_file_name ) //               &
-                                    '" for read in serial mode (posix)'
-          CALL debug_message( debug_string, 'start' )
-       ENDIF
-
-       fh = posix_open( TRIM( io_file_name ), .TRUE. )
-
-       IF ( debug_output )  THEN
-          WRITE( debug_string, * )  'open restart file "' // TRIM( io_file_name ) //               &
-                                    '" for read in serial mode (posix)'
-          CALL debug_message( debug_string, 'end' )
-       ENDIF
-
-    ELSEIF ( wr_flag )  THEN
-
-       IF ( debug_output )  THEN
-          WRITE( debug_string, * )  'open restart file "' // TRIM( io_file_name ) //               &
-                                    '" for write in serial mode (posix)'
-          CALL debug_message( debug_string, 'start' )
-       ENDIF
-
-       fh = posix_open( TRIM( io_file_name ), .FALSE. )
-
-       IF ( debug_output )  THEN
-          WRITE( debug_string, * )  'open restart file "' // TRIM( io_file_name ) //               &
-                                    '" for write in serial mode (posix)'
-          CALL debug_message( debug_string, 'end' )
-       ENDIF
-
-    ENDIF
-
-    IF ( fh < 0 )  THEN
-       message_string = 'error opening restart file for posix I/O'
-       CALL message( 'restart_data_mpi_io_mod', 'PA0721', 1, 2, 0, 6, 0 )
-    ENDIF
-#endif
-
-    array_position  = 65536          !> Start offset for writing 2-D and 3.D arrays at 64 k
-    header_position = 0
-
-    header_int_index   = 1
-    header_char_index  = 1
-    header_real_index  = 1
-    header_array_index = 1
-
-    int_names    = ' '
-    int_values   = 0
-    text_lines   = ' '
-    real_names   = ' '
-    real_values  = 0.0
-    array_names  = ' '
-    array_offset = 0
-
-    int_names(1)     = 'nx'
-    int_values(1)    = nx
-    int_names(2)     = 'ny'
-    int_values(2)    = ny
-    int_names(3)     = 'nz'
-    int_values(3)    = nz
-    header_int_index = header_int_index+3
-
-    DO  i = 1, max_nr_arrays
-       array_offset(i) = 0
-       array_names(i)  = ' '
-    ENDDO
-
-    gh_size = STORAGE_SIZE( tgh ) / 8
-
-    IF ( rd_flag )  THEN
-       IF ( sm_io%iam_io_pe )  THEN
-!
-!--       File is open for reading
-#if defined( __parallel )
-!--       Set the default view
-          CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
-!
-!--       Read the file header size
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_READ( fh, tgh, gh_size, MPI_BYTE, status, ierr )
-#else
-          CALL posix_lseek( fh, header_position )
-          buf_ptr = C_LOC( tgh )
-          CALL posix_read( fh, buf_ptr, gh_size )
-#endif
-       ENDIF
-#if defined( __parallel )
-       IF ( sm_io%is_sm_active() )  THEN
-          CALL MPI_BCAST( tgh, gh_size, MPI_BYTE, 0, sm_io%comm_shared, ierr )
-       ENDIF
-#endif
-       header_position = header_position + gh_size
-
-       include_total_domain_boundaries = ( tgh%i_outer_bound == 1 )
-
-!
-!--    File types depend on boundaries of the total domain being included in data. This has been
-!--    checked with the previous statement.
-       IF ( set_filetype )  THEN
-          CALL rd_mpi_io_create_filetypes
-          filetypes_created = .TRUE.
-       ENDIF
-
-       IF ( sm_io%iam_io_pe )  THEN
-#if defined( __parallel )
-!
-!--       Read INTEGER values
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_READ( fh, int_names, SIZE( int_names ) * 32, MPI_CHAR, status, ierr )
-          header_position = header_position + SIZE( int_names ) * 32
-
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_READ (fh, int_values, SIZE( int_values ), MPI_INT, status, ierr )
-          header_position = header_position + SIZE( int_values ) * iwp
-!
-!--       Character entries
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_READ( fh, text_lines, SIZE( text_lines ) * 128, MPI_CHAR, status, ierr )
-          header_position = header_position + SIZE ( text_lines ) * 128
-!
-!--       REAL values
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_READ( fh, real_names, SIZE( real_names ) * 32, MPI_CHAR, status, ierr )
-          header_position = header_position + SIZE( real_names ) * 32
-
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_READ( fh, real_values, SIZE( real_values ), MPI_REAL, status, ierr )
-          header_position = header_position + SIZE( real_values ) * wp
-!
-!--       2d- and 3d-array headers
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_READ( fh, array_names, SIZE( array_names ) * 32, MPI_CHAR, status, ierr )
-          header_position = header_position + SIZE( array_names ) * 32
-
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_READ( fh, array_offset, SIZE( array_offset ) * MPI_OFFSET_KIND, MPI_BYTE,  &
-                              status,ierr )   ! there is no I*8 datatype in Fortran
-          header_position = header_position + SIZE( array_offset ) * rd_offset_kind
-#else
-          CALL posix_lseek( fh, header_position )
-          CALL posix_read( fh, int_names )
-          header_position = header_position + SIZE( int_names ) * 32
-
-          CALL posix_lseek( fh, header_position )
-          CALL posix_read( fh, int_values, SIZE( int_values ) )
-          header_position = header_position + SIZE( int_values ) * iwp
-!
-!--       Character entries
-          CALL posix_lseek( fh, header_position )
-          CALL posix_read( fh, text_lines )
-          header_position = header_position + SIZE( text_lines ) * 128
-!
-!--       REAL values
-          CALL posix_lseek( fh, header_position )
-          CALL posix_read( fh, real_names )
-          header_position = header_position + SIZE( real_names ) * 32
-
-          CALL posix_lseek( fh, header_position )
-          CALL posix_read( fh, real_values, SIZE( real_values ) )
-          header_position = header_position + SIZE( real_values ) * wp
-!
-!--       2d- and 3d-array headers
-          CALL posix_lseek( fh, header_position )
-          CALL posix_read( fh, array_names )
-          header_position = header_position + SIZE( array_names ) * 32
-
-          CALL posix_lseek( fh, header_position )
-          CALL posix_read( fh, array_offset, SIZE( array_offset ) ) ! there is no I*8 datatype in Fortran
-          header_position = header_position + SIZE( array_offset ) * rd_offset_kind
-#endif
-          IF ( debug_output )  CALL rd_mpi_io_print_header
-
-       ENDIF
-
-#if defined( __parallel )
-!
-!--    Broadcast header to all remaining cores that are not involved in I/O
-       IF ( sm_io%is_sm_active() )  THEN
-!
-!--        Not sure, that it is possible to broadcast CHARACTER array in one MPI_Bcast call
-           DO  i = 1, SIZE( int_names )
-              CALL MPI_BCAST( int_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
-           ENDDO
-           CALL MPI_BCAST( int_values, SIZE( int_values ), MPI_INTEGER, 0, sm_io%comm_shared, ierr )
-
-           DO  i = 1, SIZE( text_lines )
-              CALL MPI_BCAST( text_lines(i), 128, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
-           ENDDO
-
-           DO  i = 1, SIZE( real_names )
-              CALL MPI_BCAST( real_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
-           ENDDO
-           CALL MPI_BCAST( real_values, SIZE( real_values ), MPI_REAL, 0, sm_io%comm_shared, ierr )
-
-           DO  i = 1, SIZE( array_names )
-              CALL MPI_BCAST( array_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
-           ENDDO
-           CALL MPI_BCAST( array_offset, SIZE( array_offset )*8, MPI_BYTE, 0, sm_io%comm_shared,   &
-                           ierr )  ! there is no I*8 datatype in Fortran (array_offset is I*8!)
-
-           CALL MPI_BCAST( header_position, rd_offset_kind, MPI_BYTE, 0, sm_io%comm_shared, ierr )
-
-       ENDIF
-#endif
-
-
-    ENDIF
-
-!
-!-- TODO: describe in more detail what is happening here
-!-- activate model grid
-    IF ( cyclic_fill_mode )  CALL mainrun_grid%activate_grid_from_this_class()
-
- CONTAINS
-
-    SUBROUTINE setup_cyclic_fill
-
-       IMPLICIT NONE
-
-       INTEGER      ::  color  !< used to set the IO PEs for MPI_COMM_SPLIT
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  j      !<
-#if defined( __parallel )
-       INTEGER      ::  ierr   !<
-       INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !< size of RMA window
-#else
-       INTEGER(idp) ::  winsize
-#endif
-
-!
-!--    Save grid information of the mainrun, i.e. grid variables like nxl, nxr, nys, nyn and other
-!--    values are stored within the mainrun_grid structure
-       CALL mainrun_grid%save_grid_into_this_class()
-
-       ALLOCATE( remote_pe(0:nx_on_file,0:ny_on_file) )
-       ALLOCATE( remote_pe_s(0:nx_on_file,0:ny_on_file) )
-       ALLOCATE( rma_offset(0:nx_on_file,0:ny_on_file) )
-       ALLOCATE( rma_offset_s(0:nx_on_file,0:ny_on_file) )
-
-       remote_pe_s  = 0
-       rma_offset_s = 0
-!
-!--    Determine, if gridpoints of the prerun are located on this PE.
-!--    Set the (cyclic) prerun grid.
-       nxr = MIN( nxr, nx_on_file )
-       IF ( nxl > nx_on_file )  THEN
-          nxl = -99
-          nxr = -99
-          nnx = 0
-       ELSE
-          nnx =nxr-nxl+1
-       ENDIF
-
-       nyn = MIN( nyn, ny_on_file )
-       IF ( nys > ny_on_file )  THEN
-          nys = -99
-          nyn = -99
-          nny = 0
-       ELSE
-          nny = nyn-nys+1
-       ENDIF
-
-       nx = nx_on_file
-       ny = ny_on_file
-!
-!--    Determine, if this PE is doing IO
-       IF ( nnx > 0  .AND.  nny > 0 )  THEN
-          color = 1
-          pe_active_for_read = .TRUE.
-          remote_pe_s(nxl:nxr,nys:nyn) = myid   ! myid from comm2d
-          DO  j = nys, nyn
-             DO  i = nxl, nxr
-                rma_offset_s(i,j) = ( j-nys ) + ( i-nxl ) * nny
-             ENDDO
-          ENDDO
-       ELSE
-#if defined( __parallel )
-          color = MPI_UNDEFINED
-#endif
-          pe_active_for_read = .FALSE.
-       ENDIF
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( remote_pe_s,  remote_pe,  SIZE(remote_pe_s),  MPI_INTEGER, MPI_SUM,     &
-                           comm2d, ierr )
-       CALL MPI_ALLREDUCE( rma_offset_s, rma_offset, SIZE(rma_offset_s), MPI_INTEGER, MPI_SUM,     &
-                           comm2d, ierr )
-       CALL MPI_COMM_SPLIT( comm2d, color, 0, comm_cyclic_fill, ierr )
-
-       IF ( pe_active_for_read )  THEN
-          CALL MPI_COMM_SIZE( comm_cyclic_fill, numprocs, ierr )
-          CALL MPI_COMM_RANK( comm_cyclic_fill, myid, ierr )
-       ENDIF
-#else
-       remote_pe  = remote_pe_s
-       rma_offset = rma_offset_s
-       myid       = 0
-       numprocs   = 1
-#endif
-!
-!--    Allocate 2d buffers as RMA window, accessible on all PEs
-       IF ( pe_active_for_read )  THEN
-          ALLOCATE( rmabuf_2di(nys:nyn,nxl:nxr) )
-       ELSE
-          ALLOCATE( rmabuf_2di(1,1) )
-       ENDIF
-       winsize = SIZE( rmabuf_2di ) * iwp
-
-#if defined( __parallel )
-       CALL MPI_WIN_CREATE( rmabuf_2di, winsize, iwp, MPI_INFO_NULL, comm2d, rmawin_2di, ierr )
-       CALL MPI_WIN_FENCE( 0, rmawin_2di, ierr )
-#endif
-
-       IF ( pe_active_for_read )  THEN
-          ALLOCATE( rmabuf_2d(nys:nyn,nxl:nxr) )
-       ELSE
-          ALLOCATE( rmabuf_2d(1,1) )
-       ENDIF
-       winsize = SIZE( rmabuf_2d ) * wp
-
-#if defined( __parallel )
-       CALL MPI_WIN_CREATE( rmabuf_2d, winsize, wp, MPI_INFO_NULL, comm2d, rmawin_2d, ierr )
-       CALL MPI_WIN_FENCE( 0, rmawin_2d, ierr )
-#endif
-
-!
-!--    Allocate 3d buffer as RMA window, accessable on all PEs
-       IF ( pe_active_for_read )  THEN
-          ALLOCATE( rmabuf_3d(nzb:nzt+1,nys:nyn,nxl:nxr) )
-       ELSE
-          ALLOCATE( rmabuf_3d(1,1,1) )
-       ENDIF
-       winsize = SIZE( rmabuf_3d ) * wp
-
-#if defined( __parallel )
-       CALL MPI_WIN_CREATE( rmabuf_3d, winsize, wp, MPI_INFO_NULL, comm2d, rmawin_3d, ierr )
-       CALL MPI_WIN_FENCE( 0, rmawin_3d, ierr )
-#endif
-
-!
-!--    Save grid of the prerun, i.e. grid variables like nxl, nxr, nys, nyn and other values
-!--    are stored within the prerun_grid structure.
-!--    The prerun grid can later be activated by calling prerun_grid%activate_grid_from_this_class()
-       CALL prerun_grid%save_grid_into_this_class()
-       prerun_grid%comm2d = comm_cyclic_fill
-
-       DEALLOCATE( remote_pe_s, rma_offset_s )
-
-    END SUBROUTINE setup_cyclic_fill
-
- END SUBROUTINE rd_mpi_io_open
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check, if array exists in restart file
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rd_mpi_io_check_array( name, found )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name  !<
-
-    INTEGER(iwp) ::  i  !<
-
-    LOGICAl ::  found  !<
-
-
-    DO  i = 1, tgh%nr_arrays
-       IF ( TRIM( array_names(i) ) == TRIM( name ) )  THEN
-          array_position = array_offset(i)
-          found = .TRUE.
-          RETURN
-       ENDIF
-    ENDDO
-
-    found = .FALSE.
-
- END SUBROUTINE rd_mpi_io_check_array
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read INTEGER with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_int( name, value )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) :: name  !<
-
-    INTEGER(iwp)                   ::  i      !<
-    INTEGER(KIND=iwp), INTENT(OUT) ::  value  !<
-
-    LOGICAL ::  found  !<
-
-
-    found = .FALSE.
-    value = 0
-
-    DO  i = 1, tgh%nr_int
-       IF ( TRIM(int_names(i)) == TRIM( name ) )  THEN
-          value = int_values(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( .NOT. found )  THEN
-       message_string = 'INTEGER variable "' // TRIM( name ) // '" not found in restart file'
-       CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
-    ENDIF
-
- END SUBROUTINE rrd_mpi_io_int
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read REAL with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_real( name, value )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name   !<
-
-    INTEGER(iwp)                 ::  i      !<
-
-    LOGICAL                      ::  found  !<
-
-    REAL(KIND=wp), INTENT(OUT)   ::  value  !<
-
-
-    found = .FALSE.
-    value = 0.0
-
-    DO  i = 1, tgh%nr_real
-       IF ( TRIM(real_names(i)) == TRIM( name ) )  THEN
-          value = real_values(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( .NOT. found )  THEN
-       message_string = 'REAL variable "' // TRIM( name ) // '" not found in restart file'
-       CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
-    ENDIF
-
- END SUBROUTINE rrd_mpi_io_real
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 2d-real array with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_real_2d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name    !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-    INTEGER(iwp)                       ::  i       !<
-
-    LOGICAL                            ::  found   !<
-
-    REAL(wp), INTENT(INOUT), DIMENSION(nysg:nyng,nxlg:nxrg) ::  data  !<
-
-
-    found = .FALSE.
-
-    DO  i = 1, tgh%nr_arrays
-       IF ( TRIM(array_names(i)) == TRIM( name ) )  THEN
-          array_position = array_offset(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( found )  THEN
-
-       IF ( cyclic_fill_mode )  THEN
-
-          CALL rrd_mpi_io_real_2d_cyclic_fill
-
-       ELSE
-
-#if defined( __parallel )
-          CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited # of cores is inactive
-          IF ( sm_io%iam_io_pe )  THEN
-             CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL, &
-                                     ierr )
-             CALL MPI_FILE_READ_ALL( fh, array_2d, SIZE( array_2d ), MPI_REAL, status, ierr )
-          ENDIF
-          CALL sm_io%sm_node_barrier()
-#else
-          CALL posix_lseek( fh, array_position )
-          CALL posix_read( fh, array_2d, SIZE( array_2d ) )
-#endif
-
-          IF ( include_total_domain_boundaries )  THEN
-             DO  i = iog%nxl, iog%nxr
-                data(iog%nys-nbgp:iog%nyn-nbgp,i-nbgp) = array_2d(i,iog%nys:iog%nyn)
-             ENDDO
-             IF ( debug_level >= 2)  THEN
-                WRITE(9,*) 'r2f_ob ', TRIM(name),' ', SUM( data(nys:nyn,nxl:nxr) )
-             ENDIF
-          ELSE
-             DO  i = nxl, nxr
-                data(nys:nyn,i) = array_2d(i,nys:nyn)
-             ENDDO
-             IF ( debug_level >= 2)  THEN
-                WRITE(9,*) 'r2f ', TRIM( name ),' ', SUM( data(nys:nyn,nxl:nxr) )
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-       CALL exchange_horiz_2d( data )
-
-    ELSE
-       message_string = '2d-REAL array "' // TRIM( name ) // '" not found in restart file'
-       CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
-    ENDIF
-
-
- CONTAINS
-
-    SUBROUTINE rrd_mpi_io_real_2d_cyclic_fill
-
-       IMPLICIT NONE
-
-       INTEGER(iwp)    :: i         !<
-       INTEGER(iwp)    :: ie        !<
-       INTEGER(iwp)    :: is        !<
-       INTEGER(iwp)    :: i_remote  !<
-       INTEGER(iwp)    :: j         !<
-       INTEGER(iwp)    :: je        !<
-       INTEGER(iwp)    :: js        !<
-       INTEGER(iwp)    :: j_remote  !<
-       INTEGER(iwp)    :: nval      !<
-       INTEGER(iwp)    :: rem_pe    !<
-
-#if defined( __parallel )
-       INTEGER(iwp)    :: ierr      !<
-       INTEGER(KIND=MPI_ADDRESS_KIND) ::  rem_offs  !<
-#else
-       INTEGER(idp) ::  rem_offs
-#endif
-
-
-!
-!--    Reading 2d real array on prerun grid
-       CALL prerun_grid%activate_grid_from_this_class()
-
-       IF ( pe_active_for_read )  THEN
-#if defined( __parallel )
-          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL,    &
-                                  ierr )
-          CALL MPI_FILE_READ_ALL( fh, array_2d, SIZE( array_2d ), MPI_REAL, status, ierr )
-#endif
-          DO  i = nxl, nxr
-             rmabuf_2d(nys:nyn,i) = array_2d(i,nys:nyn)
-          ENDDO
-          data(nys:nyn,nxl:nxr) = rmabuf_2d     ! copy prerund data directly into output array data
-       ENDIF
-
-       CALL mainrun_grid%activate_grid_from_this_class()
-
-#if defined( __parallel )
-!
-!--    Close RMA window to allow remote access
-       CALL MPI_WIN_FENCE( 0, rmawin_2d, ierr )
-#endif
-
-!
-!--    TODO: describe in more detail what is happening in this IF/ELSE clause
-       IF ( .NOT. pe_active_for_read )  THEN
-
-          is = nxl
-          ie = nxr
-          js = nys
-          je = nyn
-
-       ELSE
-!
-!--       Extra get for cyclic data north of prerun data
-          is = nxl
-          ie = nxr
-          js = prerun_grid%nys+1
-          je = nyn
-          DO  i = is, ie
-             DO  j = js, je
-                i_remote = MOD(i,nx_on_file+1)
-                j_remote = MOD(j,ny_on_file+1)
-                rem_pe   = remote_pe(i_remote,j_remote)
-                rem_offs = rma_offset(i_remote,j_remote)
-                nval     = 1
-
-#if defined( __parallel )
-                IF ( rem_pe /= myid )  THEN
-                   CALL MPI_GET( data(j,i), nval, MPI_REAL, rem_pe, rem_offs, nval, MPI_REAL,      &
-                                 rmawin_2d, ierr )
-                ELSE
-                   data(j,i) = rmabuf_2d(j_remote,i_remote)
-                ENDIF
-#else
-                data(j,i) = array_2d(i_remote,j_remote)
-#endif
-             ENDDO
-          ENDDO
-!
-!--       Prepare setup for stripe right of prerun data
-          is = prerun_grid%nxr+1
-          ie = nxr
-          js = nys
-          je = nyn
-
-       ENDIF
-
-       DO  i = is, ie
-          DO j = js, je
-             i_remote = MOD(i,nx_on_file+1)
-             j_remote = MOD(j,ny_on_file+1)
-             rem_pe   = remote_pe(i_remote,j_remote)
-             rem_offs = rma_offset(i_remote,j_remote)
-             nval     = 1
-
-#if defined( __parallel )
-             IF ( rem_pe /= myid )  THEN
-                CALL MPI_GET( data(j,i), nval, MPI_REAL, rem_pe, rem_offs, nval, MPI_REAL,         &
-                              rmawin_2d, ierr )
-             ELSE
-                data(j,i) = rmabuf_2d(j_remote,i_remote)
-             ENDIF
-#else
-             data(j,i) = array_2d(i_remote,j_remote)
-#endif
-          ENDDO
-       ENDDO
-
-#if defined( __parallel )
-!
-!--    Reopen RMA window to allow filling
-       CALL MPI_WIN_FENCE( 0, rmawin_2d, ierr )
-#endif
-
-    END SUBROUTINE rrd_mpi_io_real_2d_cyclic_fill
-
- END SUBROUTINE rrd_mpi_io_real_2d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 2d-INTEGER array with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_int_2d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name    !<
-
-    INTEGER(iwp)                       ::  i       !<
-    INTEGER(iwp)                       ::  j       !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-
-    INTEGER(KIND=iwp), INTENT(INOUT), DIMENSION(:,:) ::  data  !<
-
-    LOGICAL ::  found  !<
-
-
-    found = .FALSE.
-
-    DO  i = 1, tgh%nr_arrays
-       IF ( TRIM(array_names(i)) == TRIM( name ) )  THEN
-          array_position = array_offset(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( found )  THEN
-
-       IF ( ( nxr - nxl + 1 + 2 * nbgp ) == SIZE( data, 2 ) )  THEN
-!
-!--       Output array with Halos.
-!--       ATTENTION: INTEGER arrays with ghost boundaries are not implemented yet. This kind of
-!--                  array would be dimensioned in the caller subroutine like this:
-!--                  INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg)::  data
-          message_string = '2d-INTEGER array with nbgp "' // TRIM( name ) // '" to be read ' //    &
-                           'from restart file is defined with illegal dimensions in the PALM code'
-          CALL message( 'rrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
-
-       ELSEIF ( (nxr - nxl + 1) == SIZE( data, 2 ) )  THEN
-!
-!--       INTEGER input array without Halos.
-!--       This kind of array is dimensioned in the caller subroutine
-!--       INTEGER, DIMENSION(nys:nyn,nxl:nxr) ::  data
-          IF ( cyclic_fill_mode )  THEN
-
-             CALL rrd_mpi_io_int_2d_cyclic_fill
-
-          ELSE
-
-#if defined( __parallel )
-             CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited # of cores is inactive
-             IF ( sm_io%iam_io_pe )  THEN
-                CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native',      &
-                                        MPI_INFO_NULL, ierr )
-                CALL MPI_FILE_READ_ALL( fh, array_2di, SIZE( array_2di ), MPI_INTEGER, status,     &
-                                        ierr )
-             ENDIF
-             CALL sm_io%sm_node_barrier()
-#else
-             CALL posix_lseek( fh, array_position )
-             CALL posix_read( fh, array_2di, SIZE( array_2di ) )
-#endif
-             DO  j = nys, nyn
-                DO  i = nxl, nxr
-                   data(j-nys+1,i-nxl+1) = array_2di(i,j)
-                ENDDO
-             ENDDO
-
-          ENDIF
-
-       ELSE
-
-          message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be read from restart ' // &
-                           'file is defined with illegal dimensions in the PALM code'
-          CALL message( 'rrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
-
-       ENDIF
-
-    ELSE
-
-       message_string = '2d-INTEGER array "' // TRIM( name ) // '" not found in restart file'
-       CALL message( 'rrd_mpi_io_int_2d', 'PA0722', 3, 2, 0, 6, 0 )
-
-    ENDIF
-
-
- CONTAINS
-
-    SUBROUTINE rrd_mpi_io_int_2d_cyclic_fill
-
-       IMPLICIT NONE
-
-       INTEGER(iwp)    :: i         !<
-       INTEGER(iwp)    :: ie        !<
-       INTEGER(iwp)    :: is        !<
-       INTEGER(iwp)    :: i_remote  !<
-       INTEGER(iwp)    :: j         !<
-       INTEGER(iwp)    :: je        !<
-       INTEGER(iwp)    :: js        !<
-       INTEGER(iwp)    :: j_remote  !<
-       INTEGER(iwp)    :: nval      !<
-       INTEGER(iwp)    :: rem_pe    !<
-
-#if defined( __parallel )
-       INTEGER(iwp)    :: ierr      !<
-       INTEGER(KIND=MPI_ADDRESS_KIND) ::  rem_offs  !<
-#else
-       INTEGER(idp) ::  rem_offs
-#endif
-
-
-       IF ( pe_active_for_read )  THEN
-          CALL prerun_grid%activate_grid_from_this_class()
-
-#if defined( __parallel )
-          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native',            &
-                                  MPI_INFO_NULL, ierr )
-          CALL MPI_FILE_READ_ALL( fh, array_2di, SIZE( array_2di ), MPI_INTEGER, status, ierr )
-#else
-          CALL posix_lseek( fh, array_position )
-          CALL posix_read( fh, array_2di, SIZE( array_2di ) )
-#endif
-          DO  i = nxl, nxr
-             rmabuf_2di(nys:nyn,i) = array_2di(i,nys:nyn)
-          ENDDO
-          data(1:nny,1:nnx) = rmabuf_2di
-
-          CALL mainrun_grid%activate_grid_from_this_class()
-       ENDIF
-
-#if defined( __parallel )
-!
-!--    Close RMA window to allow remote access
-       CALL MPI_WIN_FENCE( 0, rmawin_2di, ierr )
-#endif
-
-       is = nxl
-       ie = nxr
-       js = nys
-       je = nyn
-
-       DO  i = is, ie
-          DO  j = js, je
-             i_remote = MOD(i,nx_on_file+1)
-             j_remote = MOD(j,ny_on_file+1)
-             rem_pe   = remote_pe(i_remote,j_remote)
-             rem_offs = rma_offset(i_remote,j_remote)
-             nval     = 1
-#if defined( __parallel )
-             IF ( rem_pe /= myid )  THEN
-                CALL MPI_GET( data(j-nys+1,i-nxl+1), nval, MPI_INTEGER, rem_pe, rem_offs, nval,    &
-                              MPI_INTEGER, rmawin_2di, ierr)
-             ELSE
-                data(j-nys+1,i-nxl+1) = rmabuf_2di(j_remote,i_remote)
-             ENDIF
-#else
-             data(j-nys+1,i-nxl+1) = array_2di(i_remote,j_remote)
-#endif
-          ENDDO
-       ENDDO
-
-#if defined( __parallel )
-!
-!--    Reopen RMA window to allow filling
-       CALL MPI_WIN_FENCE( 0, rmawin_2di, ierr )
-#endif
-
-    END SUBROUTINE rrd_mpi_io_int_2d_cyclic_fill
-
- END SUBROUTINE rrd_mpi_io_int_2d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 3d-INTEGER*4 array with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_int4_3d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name    !<
-
-    INTEGER(iwp)                       ::  i       !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-
-    LOGICAL                            ::  found   !<
-
-    INTEGER(isp), INTENT(INOUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  data  !<
-
-
-    found = .FALSE.
-    data  = -1.0
-
-    DO  i = 1, tgh%nr_arrays
-       IF ( TRIM(array_names(i)) == TRIM( name ) )  THEN
-          array_position = array_offset(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( found )  THEN
-
-#if defined( __parallel )
-       CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited # of cores is inactive
-       IF( sm_io%iam_io_pe )  THEN
-          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_3di4, 'native',              &
-                                  MPI_INFO_NULL, ierr )
-          CALL MPI_FILE_READ_ALL( fh, array_3di4, SIZE( array_3di4 ), MPI_INTEGER, status, ierr )
-       ENDIF
-       CALL sm_io%sm_node_barrier()
-#else
-       CALL posix_lseek( fh, array_position )
-       CALL posix_read(fh, array_3di4, SIZE( array_3di4 ) )
-#endif
-       IF ( include_total_domain_boundaries )  THEN
-          DO  i = iog%nxl, iog%nxr
-             data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp) = array_3di4(:,i,iog%nys:iog%nyn)
-          ENDDO
-       ELSE
-          DO  i = nxl, nxr
-             data(:,nys:nyn,i) = array_3di4(:,i,nys:nyn)
-          ENDDO
-       ENDIF
-
-    ELSE
-
-       message_string = '3d-INTEGER*4 array "' // TRIM( name ) // '" not found in restart file'
-       CALL message( 'rrd_mpi_io_int4_3d', 'PA0722', 3, 2, 0, 6, 0 )
-
-    ENDIF
-
-
- END SUBROUTINE rrd_mpi_io_int4_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 3d-INTEGER*8 array with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_int8_3d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name    !<
-
-    INTEGER(iwp)                       ::  i       !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-
-    LOGICAL                            ::  found   !<
-
-    INTEGER(idp), INTENT(INOUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  data  !<
-
-
-    found = .FALSE.
-    data  = -1.0
-
-    DO  i = 1, tgh%nr_arrays
-       IF ( TRIM(array_names(i)) == TRIM( name ) )  THEN
-          array_position = array_offset(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( found )  THEN
-
-#if defined( __parallel )
-          CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited # of cores is inactive
-          IF( sm_io%iam_io_pe )  THEN
-             CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER8, ft_3di8, 'native', MPI_INFO_NULL, &
-                                     ierr )
-             CALL MPI_FILE_READ_ALL( fh, array_3di8, SIZE( array_3di8 ), MPI_INTEGER8, status, ierr )
-          ENDIF
-          CALL sm_io%sm_node_barrier()
-#else
-          CALL posix_lseek( fh, array_position )
-          CALL posix_read(fh, array_3di8, SIZE( array_3di8 ) )
-#endif
-          IF ( include_total_domain_boundaries )  THEN
-             DO  i = iog%nxl, iog%nxr
-                data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp) = array_3di8(:,i,iog%nys:iog%nyn)
-             ENDDO
-          ELSE
-             DO  i = nxl, nxr
-                data(:,nys:nyn,i) = array_3di8(:,i,nys:nyn)
-             ENDDO
-          ENDIF
-
-    ELSE
-
-       message_string = '3d-INTEGER*8 array "' // TRIM( name ) // '" not found in restart file'
-       CALL message( 'rrd_mpi_io_int8_3d', 'PA0722', 3, 2, 0, 6, 0 )
-
-    ENDIF
-
-
- END SUBROUTINE rrd_mpi_io_int8_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 2d-REAL array with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_real_3d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name    !<
-
-    INTEGER(iwp)                       ::  i       !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-
-    LOGICAL                            ::  found   !<
-
-    REAL(wp), INTENT(INOUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  data  !<
-
-
-    found = .FALSE.
-    data  = -1.0
-
-    DO  i = 1, tgh%nr_arrays
-       IF ( TRIM(array_names(i)) == TRIM( name ) )  THEN
-          array_position = array_offset(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( found )  THEN
-
-       IF ( cyclic_fill_mode )  THEN
-
-          CALL rrd_mpi_io_real_3d_cyclic_fill
-!
-!--       Cyclic fill mode requires to use the "cyclic" communicator, in order to initialize
-!--       grid points at the outer boundaries (ghost layers) of the total domain. These points
-!--       are not contained in the prerun data, because the prerun used cyclic boundary conditions.
-          CALL exchange_horiz( data, nbgp, alternative_communicator = 1 )
-
-       ELSE
-#if defined( __parallel )
-          CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited # of cores is inactive
-          IF( sm_io%iam_io_pe )  THEN
-             CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL, &
-                                     ierr )
-             CALL MPI_FILE_READ_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
-          ENDIF
-          CALL sm_io%sm_node_barrier()
-#else
-          CALL posix_lseek( fh, array_position )
-          CALL posix_read(fh, array_3d, SIZE( array_3d ) )
-#endif
-          IF ( include_total_domain_boundaries )  THEN
-             DO  i = iog%nxl, iog%nxr
-                data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp) = array_3d(:,i,iog%nys:iog%nyn)
-             ENDDO
-          ELSE
-             DO  i = nxl, nxr
-                data(:,nys:nyn,i) = array_3d(:,i,nys:nyn)
-             ENDDO
-          ENDIF
-
-          CALL exchange_horiz( data, nbgp )
-
-       ENDIF
-
-    ELSE
-
-       message_string = '3d-REAL array "' // TRIM( name ) // '" not found in restart file'
-       CALL message( 'rrd_mpi_io_real_3d', 'PA0722', 3, 2, 0, 6, 0 )
-
-    ENDIF
-
-
- CONTAINS
-
-    SUBROUTINE rrd_mpi_io_real_3d_cyclic_fill
-
-       IMPLICIT NONE
-
-       INTEGER(iwp)    :: i         !<
-       INTEGER(iwp)    :: ie        !<
-       INTEGER(iwp)    :: is        !<
-       INTEGER(iwp)    :: i_remote  !<
-       INTEGER(iwp)    :: j         !<
-       INTEGER(iwp)    :: je        !<
-       INTEGER(iwp)    :: js        !<
-       INTEGER(iwp)    :: j_remote  !<
-       INTEGER(iwp)    :: nval      !<
-       INTEGER(iwp)    :: rem_pe    !<
-
-#if defined( __parallel )
-       INTEGER(iwp)    :: ierr      !<
-       INTEGER(KIND=MPI_ADDRESS_KIND) ::  rem_offs  !<
-#else
-       INTEGER(idp) ::  rem_offs
-#endif
-
-
-       CALL prerun_grid%activate_grid_from_this_class()
-
-       IF ( pe_active_for_read )  THEN
-#if defined( __parallel )
-          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL,    &
-                                  ierr )
-          CALL MPI_FILE_READ_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
-#else
-          CALL posix_lseek( fh, array_position )
-          CALL posix_read( fh, array_3d, SIZE( array_3d ) )
-#endif
-          DO  i = nxl, nxr
-             rmabuf_3d(:,nys:nyn,i) = array_3d(:,i,nys:nyn)
-          ENDDO
-          data(:,nys:nyn,nxl:nxr) = rmabuf_3d
-       ENDIF
-       CALL mainrun_grid%activate_grid_from_this_class ()
-
-#if defined( __parallel )
-!
-!--    Close RMA window to allow remote access
-       CALL MPI_WIN_FENCE( 0, rmawin_3d, ierr )
-#endif
-
-       is = nxl
-       ie = nxr
-       js = nys
-       je = nyn
-
-       DO  i = is, ie
-          DO  j = js, je
-             i_remote = MOD( i, nx_on_file+1 )
-             j_remote = MOD( j, ny_on_file+1 )
-             rem_pe   = remote_pe(i_remote,j_remote)
-             rem_offs = rma_offset(i_remote,j_remote) * ( nzt-nzb+2 )
-             nval     = nzt-nzb+2
-
-#if defined( __parallel )
-             IF ( rem_pe /= myid )  THEN
-                CALL MPI_GET( data(nzb,j,i), nval, MPI_REAL, rem_pe, rem_offs, nval, MPI_REAL,     &
-                              rmawin_3d, ierr)
-             ELSE
-                data(:,j,i) = rmabuf_3d(:,j_remote,i_remote)
-             ENDIF
-#else
-             data(:,j,i) = array_3d(:,i_remote,j_remote)
-#endif
-          ENDDO
-       ENDDO
-
-#if defined( __parallel )
-!
-!--    Reopen RMA window to allow filling
-       CALL MPI_WIN_FENCE( 0, rmawin_3d, ierr )
-#endif
-
-    END SUBROUTINE rrd_mpi_io_real_3d_cyclic_fill
-
- END SUBROUTINE rrd_mpi_io_real_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 3d-REAL soil array with MPI-IO
-!> nzb_soil, nzt_soil are located in the module land_surface_model_mod. Since Fortran does not allow
-!> cross referencing of module variables, it is required to pass these variables as arguments.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_real_3d_soil( name, data, nzb_soil, nzt_soil )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name      !<
-
-    INTEGER(iwp)                       ::  i         !<
-    INTEGER, INTENT(IN)                ::  nzb_soil  !<
-    INTEGER, INTENT(IN)                ::  nzt_soil  !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status    !<
-    INTEGER(iwp)                       ::  ierr      !<
-#endif
-
-    LOGICAL                            ::  found     !<
-
-    REAL(wp), INTENT(INOUT), DIMENSION(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ::  data  !<
-
-
-!
-!-- Prerun data is not allowed to contain soil information so far
-    IF ( cyclic_fill_mode )  THEN
-       message_string = 'prerun data is not allowed to contain soil information'
-       CALL message( 'rrd_mpi_io_real_3d_soil', 'PA0729', 3, 2, -1, 6, 0 )
-    ENDIF
-
-    found = .FALSE.
-
-    DO  i = 1, tgh%nr_arrays
-       IF ( TRIM(array_names(i)) == TRIM( name ) )  THEN
-          array_position = array_offset(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( found )  THEN
-       CALL rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
-#if defined( __parallel )
-       CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited number of cores is inactive
-       IF ( sm_io%iam_io_pe )  THEN
-          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3dsoil, 'native',               &
-                                  MPI_INFO_NULL, ierr )
-          CALL MPI_FILE_READ_ALL( fh, array_3d_soil, SIZE( array_3d_soil ), MPI_REAL, status, ierr )
-          CALL MPI_TYPE_FREE( ft_3dsoil, ierr )
-       ENDIF
-       CALL sm_io%sm_node_barrier()
-#else
-       CALL posix_lseek( fh, array_position )
-       CALL posix_read( fh, array_3d_soil, SIZE( array_3d_soil ) )
-#endif
-       IF ( include_total_domain_boundaries )  THEN
-          DO  i = iog%nxl, iog%nxr
-             data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp) = array_3d_soil(:,i,iog%nys:iog%nyn)
-          ENDDO
-       ELSE
-          DO  i = nxl, nxr
-             data(:,nys:nyn,i) = array_3d_soil(:,i,nys:nyn)
-          ENDDO
-       ENDIF
-
-#if defined( __parallel )
-      IF ( sm_io%is_sm_active() )  THEN
-         CALL MPI_WIN_FREE( win_3ds, ierr )
-      ELSE
-         DEALLOCATE( array_3d_soil )
-      ENDIF
-#else
-      DEALLOCATE( array_3d_soil )
-#endif
-
-    ELSE
-
-       message_string = '3d-REAL soil array "' // TRIM( name ) // '" not found in restart file'
-       CALL message( 'rrd_mpi_io_real_3d_soil', 'PA0722', 3, 2, 0, 6, 0 )
-
-    ENDIF
-
- END SUBROUTINE rrd_mpi_io_real_3d_soil
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read CHARACTER with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_char( name, text )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)  ::  name   !<
-    CHARACTER(LEN=*), INTENT(OUT) ::  text   !<
-    CHARACTER(LEN=128)            ::  line   !<
-
-    INTEGER(iwp)                  ::  i      !<
-
-    LOGICAL                       ::  found  !<
-
-
-    found = .FALSE.
-    text = ' '
-
-    DO  i = 1, tgh%nr_char
-       line = text_lines(i)
-       IF ( TRIM( line(1:32) ) == TRIM( name ) )  THEN
-          text = line(33:)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( .NOT. found )  THEN
-       message_string = 'CHARACTER variable "' // TRIM( name ) // '" not found in restart file'
-       CALL message( 'rrd_mpi_io_char', 'PA0722', 3, 2, 0, 6, 0 )
-    ENDIF
-
- END SUBROUTINE rrd_mpi_io_char
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read LOGICAL with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_logical( name, value )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name                !<
-
-    INTEGER(iwp)                 ::  logical_as_integer  !<
-
-    LOGICAL, INTENT(OUT)         ::  value               !<
-
-
-    CALL rrd_mpi_io_int( name, logical_as_integer )
-    value = ( logical_as_integer == 1 )
-
- END SUBROUTINE rrd_mpi_io_logical
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 3D-LOGICAL with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_logical_3d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name                !<
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  logical_as_integer  !<
-
-    LOGICAL, INTENT(OUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  data  !<
-
-
-    CALL rrd_mpi_io_int4_3d( name, logical_as_integer )
-    data(:,:,:) = ( logical_as_integer(:,:,:) == 1 )
-
- END SUBROUTINE rrd_mpi_io_logical_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write INTEGER with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_int( name, value )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)  ::  name   !<
-
-    INTEGER(KIND=iwp), INTENT(IN) ::  value  !<
-
-
-    IF ( header_int_index == max_nr_int )  THEN
-       STOP '+++ maximum number of INTEGER entries in restart file header exceeded'
-    ENDIF
-
-    int_names(header_int_index)  = name
-    int_values(header_int_index) = value
-    header_int_index = header_int_index + 1
-
- END SUBROUTINE wrd_mpi_io_int
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> To do: Description missing!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_real( name, value )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name   !<
-
-    REAL(wp), INTENT(IN)         ::  value  !<
-
-
-    IF ( header_real_index == max_nr_real )  THEN
-       STOP '+++ maximum number of REAL entries in restart file header exceeded'
-    ENDIF
-
-    real_names(header_real_index)  = name
-    real_values(header_real_index) = value
-    header_real_index = header_real_index + 1
-
- END SUBROUTINE wrd_mpi_io_real
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 2d-REAL array with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_real_2d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name    !<
-
-    INTEGER(iwp)                       ::  i       !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-
-    REAL(wp), INTENT(IN), DIMENSION(nysg:nyng,nxlg:nxrg) ::  data  !<
-
-
-    IF ( header_array_index == max_nr_arrays )  THEN
-       message_string = 'maximum number of 2d/3d-array entries in restart file header exceeded'
-       CALL message( 'wrd_mpi_io_real_2d', 'PA0585', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    array_names(header_array_index)  = name
-    array_offset(header_array_index) = array_position
-    header_array_index = header_array_index + 1
-
-    IF ( include_total_domain_boundaries )  THEN
-!
-!--    Prepare output with outer boundaries
-       DO  i = iog%nxl, iog%nxr
-          array_2d(i,iog%nys:iog%nyn) = data(iog%nys-nbgp:iog%nyn-nbgp,i-nbgp)
-       ENDDO
-
-    ELSE
-!
-!--    Prepare output without outer boundaries
-       DO  i = nxl,nxr
-          array_2d(i,iog%nys:iog%nyn) = data(nys:nyn,i)
-       ENDDO
-
-    ENDIF
-
-#if defined( __parallel )
-    CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited number of cores is inactive
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL, ierr )
-       CALL MPI_FILE_WRITE_ALL( fh, array_2d, SIZE( array_2d), MPI_REAL, status, ierr )
-    ENDIF
-    CALL sm_io%sm_node_barrier()
-#else
-    CALL posix_lseek( fh, array_position )
-    CALL posix_write( fh, array_2d, SIZE( array_2d ) )
-#endif
-!
-!-- Type conversion required, otherwise right hand side brackets are calculated assuming 4 byte INT.
-!-- Maybe a compiler problem.
-    array_position = array_position + ( INT( iog%ny, KIND=rd_offset_kind ) + 1 ) *                 &
-                                      ( INT( iog%nx, KIND=rd_offset_kind ) + 1 ) * wp
-
- END SUBROUTINE wrd_mpi_io_real_2d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 2d-INTEGER array with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_int_2d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                  ::  name    !<
-
-    INTEGER(iwp)                                  ::  i       !<
-    INTEGER(iwp)                                  ::  j       !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size)            ::  status  !<
-#endif
-    INTEGER(KIND=iwp), INTENT(IN), DIMENSION(:,:) ::  data    !<
-
-
-    IF ( header_array_index == max_nr_arrays )  THEN
-       message_string = 'maximum number of 2d/3d-array entries in restart file header exceeded'
-       CALL message( 'wrd_mpi_io_int_2d', 'PA0585', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    array_names(header_array_index)  = name
-    array_offset(header_array_index) = array_position
-    header_array_index = header_array_index + 1
-
-    IF ( ( nxr - nxl + 1 + 2 * nbgp ) == SIZE( data, 2 ) )  THEN
-!
-!--    Integer arrays with ghost layers are not implemented yet. These kind of arrays would be
-!--    dimensioned in the caller subroutine as
-!--    INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg) ::  data
-       message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be written to restart ' //   &
-                        'file is defined with illegal dimensions in the PALM code'
-       CALL message( 'wrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
-
-    ELSEIF ( ( nxr-nxl+1 ) == SIZE( data, 2 ) )  THEN
-!
-!--    INTEGER input array without ghost layers.
-!--    This kind of array is dimensioned in the caller subroutine as
-!--    INTEGER, DIMENSION(nys:nyn,nxl:nxr) ::  data
-       DO  j = nys, nyn
-          DO  i = nxl, nxr
-             array_2di(i,j) = data(j-nys+1,i-nxl+1)
-          ENDDO
-       ENDDO
-#if defined( __parallel )
-       CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited number of cores is inactive
-       IF ( sm_io%iam_io_pe )  THEN
-          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native',            &
-                                  MPI_INFO_NULL, ierr )
-          CALL MPI_FILE_WRITE_ALL( fh, array_2di, SIZE( array_2di ), MPI_INTEGER, status, ierr )
-       ENDIF
-       CALL sm_io%sm_node_barrier()
-#else
-       CALL posix_lseek( fh, array_position )
-       CALL posix_write( fh, array_2di, SIZE( array_2di ) )
-#endif
-!
-!--    Type conversion required, otherwise rigth hand side brackets are calculated assuming 4 byte
-!--    INT. Maybe a compiler problem.
-       array_position = array_position + INT( (ny+1), KIND=rd_offset_kind ) *                      &
-                                         INT( (nx+1), KIND=rd_offset_kind ) * 4
-
-    ELSE
-
-       message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be written to restart ' //   &
-                        'file is defined with illegal dimensions in the PALM code'
-       CALL message( 'wrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
-
-    ENDIF
-
- END SUBROUTINE wrd_mpi_io_int_2d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 3d-INTEGER*4 array with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_int4_3d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name    !<
-
-    INTEGER(iwp)                       ::  i       !<
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-    INTEGER(isp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  data !<
-
-
-    IF ( header_array_index == max_nr_arrays )  THEN
-       message_string = 'maximum number of 2d/3d-array entries in restart file header exceeded'
-       CALL message( 'wrd_mpi_io_int4_3d', 'PA0585', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    array_names(header_array_index)  = name
-    array_offset(header_array_index) = array_position
-    header_array_index = header_array_index + 1
-
-    IF ( include_total_domain_boundaries )  THEN
-!
-!--    Prepare output of 3d-REAL-array with ghost layers. In the virtual PE grid, the first
-!--    dimension is PEs along x, and the second along y. For MPI-IO it is recommended to have the
-!--    index order of the array in the same way, i.e. the first dimension should be along x and the
-!--    second along y. For this reason, the original PALM data need to be swaped.
-       DO  i = iog%nxl, iog%nxr
-          array_3di4(:,i,iog%nys:iog%nyn) = data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp)
-       ENDDO
-
-    ELSE
-!
-!--    Prepare output of 3d-REAL-array without ghost layers
-       DO  i = nxl, nxr
-           array_3di4(:,i,iog%nys:iog%nyn) = data(:,nys:nyn,i)
-       ENDDO
-
-    ENDIF
-#if defined( __parallel )
-    CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited number of cores is inactive
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_3di4, 'native', MPI_INFO_NULL, ierr )
-       CALL MPI_FILE_WRITE_ALL( fh, array_3di4, SIZE( array_3di4 ), MPI_INTEGER, status, ierr )
-    ENDIF
-    CALL sm_io%sm_node_barrier()
-#else
-    CALL posix_lseek( fh, array_position )
-    CALL posix_write( fh, array_3di4, SIZE( array_3di4 ) )
-#endif
-!
-!-- Type conversion required, otherwise right hand side brackets are calculated assuming 4 byte INT.
-!-- Maybe a compiler problem.
-    array_position = array_position + INT(     (nz+2), KIND = rd_offset_kind ) *                   &
-                                      INT( (iog%ny+1), KIND = rd_offset_kind ) *                   &
-                                      INT( (iog%nx+1), KIND = rd_offset_kind ) * isp
-
- END SUBROUTINE wrd_mpi_io_int4_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 3d-INTEGER*8 array with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_int8_3d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name    !<
-
-    INTEGER(iwp)                       ::  i       !<
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-    INTEGER(idp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  data !<
-
-
-    IF ( header_array_index == max_nr_arrays )  THEN
-       message_string = 'maximum number of 2d/3d-array entries in restart file header exceeded'
-       CALL message( 'wrd_mpi_io_int8_3d', 'PA0585', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    array_names(header_array_index)  = name
-    array_offset(header_array_index) = array_position
-    header_array_index = header_array_index + 1
-
-    IF ( include_total_domain_boundaries )  THEN
-!
-!--    Prepare output of 3d-REAL-array with ghost layers. In the virtual PE grid, the first
-!--    dimension is PEs along x, and the second along y. For MPI-IO it is recommended to have the
-!--    index order of the array in the same way, i.e. the first dimension should be along x and the
-!--    second along y. For this reason, the original PALM data need to be swaped.
-       DO  i = iog%nxl, iog%nxr
-          array_3di8(:,i,iog%nys:iog%nyn) = data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp)
-       ENDDO
-
-    ELSE
-!
-!--    Prepare output of 3d-REAL-array without ghost layers
-       DO  i = nxl, nxr
-           array_3di8(:,i,iog%nys:iog%nyn) = data(:,nys:nyn,i)
-       ENDDO
-
-    ENDIF
-#if defined( __parallel )
-    CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited number of cores is inactive
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER8, ft_3di8, 'native', MPI_INFO_NULL, ierr )
-       CALL MPI_FILE_WRITE_ALL( fh, array_3di8, SIZE( array_3di8 ), MPI_INTEGER8, status, ierr )
-    ENDIF
-    CALL sm_io%sm_node_barrier()
-#else
-    CALL posix_lseek( fh, array_position )
-    CALL posix_write( fh, array_3di8, SIZE( array_3di8 ) )
-#endif
-!
-!-- Type conversion required, otherwise right hand side brackets are calculated assuming 4 byte INT.
-!-- Maybe a compiler problem.
-    array_position = array_position + INT(     (nz+2), KIND = rd_offset_kind ) *                   &
-                                      INT( (iog%ny+1), KIND = rd_offset_kind ) *                   &
-                                      INT( (iog%nx+1), KIND = rd_offset_kind ) * dp
-
- END SUBROUTINE wrd_mpi_io_int8_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 3d-REAL array with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_real_3d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name    !<
-
-    INTEGER(iwp)                       ::  i       !<
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-    REAL(wp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  data !<
-
-
-    IF ( header_array_index == max_nr_arrays )  THEN
-       message_string = 'maximum number of 2d/3d-array entries in restart file header exceeded'
-       CALL message( 'wrd_mpi_io_real_3d', 'PA0585', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    array_names(header_array_index)  = name
-    array_offset(header_array_index) = array_position
-    header_array_index = header_array_index + 1
-
-    IF ( include_total_domain_boundaries )  THEN
-!
-!--    Prepare output of 3d-REAL-array with ghost layers. In the virtual PE grid, the first
-!--    dimension is PEs along x, and the second along y. For MPI-IO it is recommended to have the
-!--    index order of the array in the same way, i.e. the first dimension should be along x and the
-!--    second along y. For this reason, the original PALM data need to be swaped.
-       DO  i = iog%nxl, iog%nxr
-          array_3d(:,i,iog%nys:iog%nyn) = data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp)
-       ENDDO
-
-    ELSE
-!
-!--    Prepare output of 3d-REAL-array without ghost layers
-       DO  i = nxl, nxr
-           array_3d(:,i,iog%nys:iog%nyn) = data(:,nys:nyn,i)
-       ENDDO
-
-    ENDIF
-#if defined( __parallel )
-    CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited number of cores is inactive
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL, ierr )
-       CALL MPI_FILE_WRITE_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
-    ENDIF
-    CALL sm_io%sm_node_barrier()
-#else
-    CALL posix_lseek( fh, array_position )
-    CALL posix_write( fh, array_3d, SIZE( array_3d ) )
-#endif
-!
-!-- Type conversion required, otherwise right hand side brackets are calculated assuming 4 byte INT.
-!-- Maybe a compiler problem.
-    array_position = array_position + INT(     (nz+2), KIND = rd_offset_kind ) *                   &
-                                      INT( (iog%ny+1), KIND = rd_offset_kind ) *                   &
-                                      INT( (iog%nx+1), KIND = rd_offset_kind ) * wp
-
-    IF ( debug_output )  THEN
-       WRITE (9,*) 'array_position real3d ', TRIM( name ), ' ', array_position
-       FLUSH( 9 )
-    ENDIF
-
- END SUBROUTINE wrd_mpi_io_real_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 3d-REAL soil array with MPI-IO.
-!> nzb_soil, nzt_soil are located in the module land_surface_model_mod. Since Fortran does not allow
-!> cross referencing of module variables, it is required to pass these variables as arguments.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_real_3d_soil( name, data, nzb_soil, nzt_soil )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name      !<
-
-    INTEGER(iwp)                       ::  i         !<
-    INTEGER, INTENT(IN)                ::  nzb_soil  !<
-    INTEGER, INTENT(IN)                ::  nzt_soil  !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-
-    REAL(wp), INTENT(IN), DIMENSION(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ::  data  !<
-
-
-    IF ( header_array_index == max_nr_arrays )  THEN
-       message_string = 'maximum number of 2d/3d-array entries in restart file header exceeded'
-       CALL message( 'wrd_mpi_io_real_3d_soil', 'PA0585', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    array_names(header_array_index)  = name
-    array_offset(header_array_index) = array_position
-    header_array_index = header_array_index + 1
-
-    CALL rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
-
-    IF ( include_total_domain_boundaries)  THEN
-!
-!--    Prepare output of 3d-REAL-array with ghost layers. In the virtual PE grid, the first
-!--    dimension is PEs along x, and the second along y. For MPI-IO it is recommended to have the
-!--    index order of the array in the same way, i.e. the first dimension should be along x and the
-!--    second along y. For this reason, the original PALM data need to be swaped.
-       DO  i = iog%nxl, iog%nxr
-          array_3d_soil(:,i,iog%nys:iog%nyn) = data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp)
-       ENDDO
-
-    ELSE
-!
-!--    Prepare output of 3d-REAL-array without ghost layers
-       DO  i = nxl, nxr
-          array_3d_soil(:,i,iog%nys:iog%nyn) = data(:,nys:nyn,i)
-       ENDDO
-
-    ENDIF
-#if defined( __parallel )
-    CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited number of cores is inactive
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3dsoil, 'native', MPI_INFO_NULL,   &
-                               ierr )
-       CALL MPI_FILE_WRITE_ALL( fh, array_3d_soil, SIZE( array_3d_soil ), MPI_REAL, status, ierr )
-    ENDIF
-    CALL sm_io%sm_node_barrier()
-
-    IF ( sm_io%is_sm_active() )  THEN
-       CALL MPI_WIN_FREE( win_3ds, ierr )
-    ELSE
-       DEALLOCATE( array_3d_soil )
-    ENDIF
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_TYPE_FREE( ft_3dsoil, ierr )
-    ENDIF
-#else
-    CALL posix_lseek( fh, array_position )
-    CALL posix_write( fh, array_3d_soil, SIZE( array_3d_soil ) )
-    DEALLOCATE( array_3d_soil )
-#endif
-!
-!-- Type conversion required, otherwise right hand side brackets are calculated assuming 4 byte INT.
-!-- Maybe a compiler problem.
-    array_position = array_position + INT( (nzt_soil-nzb_soil+1), KIND = rd_offset_kind ) *        &
-                                      INT( (iog%ny+1),            KIND = rd_offset_kind ) *        &
-                                      INT( (iog%nx+1),            KIND = rd_offset_kind ) * wp
-
- END SUBROUTINE wrd_mpi_io_real_3d_soil
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write CHARATCTER with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_char( name, text )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=128)           ::  lo_line  !<
-    CHARACTER(LEN=*), INTENT(IN) ::  name     !<
-    CHARACTER(LEN=*), INTENT(IN) ::  text     !<
-
-
-    IF ( header_char_index == max_nr_char )  THEN
-       STOP '+++ maximum number of CHARACTER entries in restart file header exceeded'
-    ENDIF
-
-    lo_line      = name
-    lo_line(33:) = text
-    text_lines(header_char_index) = lo_line
-    header_char_index = header_char_index + 1
-
- END SUBROUTINE wrd_mpi_io_char
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write LOGICAL with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_logical( name, value )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name                !<
-
-    INTEGER(iwp)                 ::  logical_as_integer  !<
-
-    LOGICAL, INTENT(IN)          ::  value               !<
-
-
-    IF ( value )  THEN
-       logical_as_integer = 1
-    ELSE
-       logical_as_integer = 0
-    ENDIF
-
-    CALL wrd_mpi_io_int( name, logical_as_integer )
-
- END SUBROUTINE wrd_mpi_io_logical
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 3D-LOGICAL with MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_logical_3d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name                !<
-
-    INTEGER(iwp) ::  i  !< loop index
-    INTEGER(iwp) ::  j  !< loop index
-    INTEGER(iwp) ::  k  !< loop index
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  logical_as_integer  !<
-
-    LOGICAL, INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  data   !<
-
-
-    DO  i = nxlg, nxrg
-       DO  j = nysg, nyng
-          DO  k = nzb, nzt+1
-             IF ( data(k,j,i) )  THEN
-                logical_as_integer(k,j,i) = 1
-             ELSE
-                logical_as_integer(k,j,i) = 0
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL wrd_mpi_io_int4_3d( name, logical_as_integer )
-
- END SUBROUTINE wrd_mpi_io_logical_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 1d-REAL global array with MPI-IO.
-!> Array contains identical data on all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_global_array_real_1d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)       ::  name    !<
-
-    INTEGER(iwp)                       ::  i       !<
-    INTEGER(KIND=rd_offset_kind)       ::  offset  !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status  !<
-#endif
-
-    LOGICAL                            ::  found   !<
-
-    REAL(KIND=wp), INTENT(INOUT), DIMENSION(:) ::  data  !<
-
-
-    offset = 0
-    found  = .FALSE.
-
-    DO  i = 1, tgh%nr_arrays
-       IF ( TRIM(array_names(i)) == TRIM( name ) )  THEN
-          array_position = array_offset(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-
-    IF ( found )  THEN
-
-!
-!--    Set default view
-#if defined( __parallel )
-       IF ( cyclic_fill_mode )  THEN        !kk This may be the general solution for all cases
-          IF ( pe_active_for_read )  THEN
-             CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
-             CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
-             CALL MPI_FILE_READ_ALL( fh, data, SIZE( data ), MPI_REAL, status, ierr )
-         ENDIF
-         CALL MPI_BCAST( data, SIZE( data ), MPI_REAL, 0, comm2d, ierr )
-       ELSE
-          IF( sm_io%iam_io_pe )  THEN
-             CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
-          ENDIF
-          IF ( myid == 0 )  THEN
-             CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
-             CALL MPI_FILE_READ( fh, data, SIZE( data ), MPI_REAL, status, ierr )
-          ENDIF
-          CALL MPI_BCAST( data, SIZE( data ), MPI_REAL, 0, comm2d, ierr )
-       ENDIF
-#else
-       CALL posix_lseek( fh, array_position )
-       CALL posix_read( fh, data, SIZE( data ) )
-#endif
-
-    ELSE
-
-       message_string = '1d/2d/3d/4d-REAL global array "' // TRIM( name ) // '" not found in ' //  &
-                        'restart file'
-       CALL message( 'rrd_mpi_io_global_array_real_1d', 'PA0722', 3, 2, 0, 6, 0 )
-
-    ENDIF
-
- END SUBROUTINE rrd_mpi_io_global_array_real_1d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 2d-REAL global array with MPI-IO.
-!> Array contains identical data on all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_global_array_real_2d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                      ::  name      !<
-
-    INTEGER, DIMENSION(1)                             ::  bufshape  !<
-
-    REAL(KIND=wp), INTENT(IN), DIMENSION(:,:), TARGET ::  data      !<
-    REAL(KIND=wp), POINTER, DIMENSION(:)              ::  buf       !<
-
-    TYPE(C_PTR)                                       ::  c_data    !<
-
-
-    c_data = C_LOC( data )
-    bufshape(1) = SIZE( data )
-    CALL C_F_POINTER( c_data, buf, bufshape )
-
-    CALL rrd_mpi_io_global_array_real_1d( name, buf )
-
- END SUBROUTINE rrd_mpi_io_global_array_real_2d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 3d-REAL global array with MPI-IO.
-!> Array contains identical data on all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_global_array_real_3d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                        ::  name      !<
-
-    INTEGER, DIMENSION(1)                               ::  bufshape  !<
-
-    REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:), TARGET ::  data      !<
-    REAL(KIND=wp), POINTER, DIMENSION(:)                ::  buf       !<
-
-    TYPE(C_PTR)                                         ::  c_data    !<
-
-
-    c_data = C_LOC( data )
-    bufshape(1) = SIZE( data )
-    CALL C_F_POINTER( c_data, buf, bufshape )
-
-    CALL rrd_mpi_io_global_array_real_1d( name, buf )
-
- END SUBROUTINE rrd_mpi_io_global_array_real_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 4d-REAL global array with MPI-IO.
-!> Array contains identical data on all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_global_array_real_4d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                          ::  name      !<
-
-    INTEGER, DIMENSION(1)                                 ::  bufshape  !<
-
-    REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:,:), TARGET ::  data      !<
-    REAL(KIND=wp), POINTER, DIMENSION(:)                  ::  buf       !<
-
-    TYPE(C_PTR)                                           ::  c_data    !<
-
-
-    c_data = C_LOC( data )
-    bufshape(1) = SIZE( data)
-    CALL C_F_POINTER( c_data, buf, bufshape )
-
-    CALL rrd_mpi_io_global_array_real_1d( name, buf )
-
- END SUBROUTINE rrd_mpi_io_global_array_real_4d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 1d-INTEGER global array with MPI-IO.
-!> Array contains identical data on all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_global_array_int_1d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                   ::  name    !<
-
-    INTEGER(iwp)                                   ::  i       !<
-    INTEGER(KIND=rd_offset_kind)                   ::  offset  !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size)             ::  status  !<
-#endif
-    INTEGER(KIND=iwp), INTENT(INOUT), DIMENSION(:) ::  data    !<
-
-    LOGICAL                                        ::  found   !<
-
-
-    offset = 0
-    found  = .FALSE.
-
-    DO  i = 1, tgh%nr_arrays
-       IF ( TRIM( array_names(i) ) == TRIM( name ) )  THEN
-          array_position = array_offset(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( found )  THEN
-!
-!--    Set default view
-#if defined( __parallel )
-       IF ( cyclic_fill_mode )  THEN      !kk This may be the general solution for all cases
-          IF ( pe_active_for_read )  THEN
-             CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
-             CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
-             CALL MPI_FILE_READ_ALL( fh, data, SIZE( data), MPI_INTEGER, status, ierr )
-          ENDIF
-          CALL MPI_BCAST( data, SIZE( data ), MPI_INTEGER, 0, comm2d, ierr )
-       ELSE
-          IF( sm_io%iam_io_pe )  THEN
-             CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
-          ENDIF
-          IF ( myid == 0 )  THEN
-             CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
-             CALL MPI_FILE_READ( fh, data, SIZE( data), MPI_INTEGER, status, ierr )
-          ENDIF
-          CALL MPI_BCAST( data, SIZE( data ), MPI_INTEGER, 0, comm2d, ierr )
-        ENDIF
-#else
-       CALL posix_lseek( fh, array_position )
-       CALL posix_read( fh, data, SIZE( data ) )
-#endif
-    ELSE
-
-       message_string = '1d-INTEGER global array "' // TRIM( name ) // '" not found in ' //        &
-                        'restart file'
-       CALL message( 'rrd_mpi_io_global_array_int_1d', 'PA0722', 3, 2, 0, 6, 0 )
-
-    ENDIF
-
- END SUBROUTINE rrd_mpi_io_global_array_int_1d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 1d-REAL global array with MPI-IO.
-!> Array contains identical data on all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_global_array_real_1d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)            ::  name    !<
-
-    INTEGER(KIND=rd_offset_kind)            ::  offset  !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size)      ::  status  !<
-#endif
-
-    REAL(KIND=wp), INTENT(IN), DIMENSION(:) ::  data    !<
-
-
-    offset = 0
-
-    IF ( header_array_index == max_nr_arrays )  THEN
-       message_string = 'maximum number of 2d/3d-array entries in restart file header exceeded'
-       CALL message( 'wrd_mpi_io_global_array_real_1d', 'PA0585', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    array_names(header_array_index)  = name
-    array_offset(header_array_index) = array_position
-    header_array_index = header_array_index + 1
-
-!
-!-- Set default view
-#if defined( __parallel )
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
-    ENDIF
-!
-!-- Only PE 0 writes replicated data
-    IF ( myid == 0 )  THEN
-       CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
-       CALL MPI_FILE_WRITE( fh, data, SIZE( data ), MPI_REAL, status, ierr )
-    ENDIF
-#else
-    CALL posix_lseek( fh, array_position )
-    CALL posix_write( fh, data, SIZE( data ) )
-#endif
-    array_position = array_position + SIZE( data ) * wp
-
- END SUBROUTINE wrd_mpi_io_global_array_real_1d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 2d-REAL global array with MPI-IO.
-!> Array contains identical data on all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_global_array_real_2d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                      ::  name      !<
-
-    INTEGER, DIMENSION(1)                             ::  bufshape  !<
-
-    REAL(KIND=wp), POINTER, DIMENSION(:)              ::  buf       !<
-    REAL(KIND=wp), INTENT(IN), DIMENSION(:,:), TARGET ::  data      !<
-
-    TYPE(C_PTR)                                       ::  c_data    !<
-
-
-    c_data = C_LOC( data )
-    bufshape(1) = SIZE( data)
-    CALL C_F_POINTER( c_data, buf, bufshape )
-
-    CALL wrd_mpi_io_global_array_real_1d( name, buf )
-
- END SUBROUTINE wrd_mpi_io_global_array_real_2d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 3d-REAL global array with MPI-IO.
-!> Array contains identical data on all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_global_array_real_3d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                        ::  name      !<
-
-    INTEGER, DIMENSION(1)                               ::  bufshape  !<
-
-    REAL(KIND=wp), POINTER, DIMENSION(:)                ::  buf       !<
-    REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:), TARGET ::  data      !<
-
-    TYPE(C_PTR)                                         ::  c_data    !<
-
-
-    c_data = C_LOC( data )
-    bufshape(1) = SIZE( data )
-    CALL C_F_POINTER( c_data, buf, bufshape )
-
-    CALL wrd_mpi_io_global_array_real_1d( name, buf )
-
- END SUBROUTINE wrd_mpi_io_global_array_real_3d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 4d-REAL global array with MPI-IO.
-!> Array contains identical data on all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_global_array_real_4d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                          ::  name      !<
-
-    INTEGER, DIMENSION(1)                                 ::  bufshape  !<
-
-    REAL(KIND=wp), POINTER, DIMENSION(:)                  ::  buf       !<
-    REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:,:), TARGET ::  data      !<
-
-    TYPE(C_PTR)                                           ::  c_data    !<
-
-
-    c_data = C_LOC( data )
-    bufshape(1) = SIZE( data)
-    CALL C_F_POINTER( c_data, buf, bufshape )
-
-    CALL wrd_mpi_io_global_array_real_1d( name, buf )
-
- END SUBROUTINE wrd_mpi_io_global_array_real_4d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 1d-INTEGER global array with MPI-IO.
-!> Array contains identical data on all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_global_array_int_1d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                ::  name    !<
-
-    INTEGER(KIND=rd_offset_kind)                ::  offset  !<
-
-    INTEGER(KIND=iwp), INTENT(IN), DIMENSION(:) ::  data    !<
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size)          ::  status  !<
-#endif
-
-    IF ( header_array_index == max_nr_arrays )  THEN
-       message_string = 'maximum number of 2d/3d-array entries in restart file header exceeded'
-       CALL message( 'wrd_mpi_io_global_array_int_1d', 'PA0585', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    offset = 0
-    array_names(header_array_index)  = name
-    array_offset(header_array_index) = array_position
-    header_array_index = header_array_index + 1
-
-!
-!-- Set default view
-#if defined( __parallel )
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
-    ENDIF
-!
-!-- Only PE 0 writes replicated data
-    IF ( myid == 0 )  THEN
-       CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
-       CALL MPI_FILE_WRITE( fh, data, SIZE( data), MPI_INTEGER, status, ierr )
-    ENDIF
-#else
-    CALL posix_lseek( fh, array_position )
-    CALL posix_write( fh, data, SIZE( data ) )
-#endif
-    array_position = array_position + SIZE( data ) * 4
-
- END SUBROUTINE wrd_mpi_io_global_array_int_1d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read particle data array with MPI-IO.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_particles( name, prt_global_index )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                       ::  name            !<
-    INTEGER(idp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  prt_global_index      !<
-
-    INTEGER(iwp)                       ::  array_size      !<
-    INTEGER(iwp)                       ::  byte_column     !<
-    INTEGER(iwp)                       ::  i               !<
-    INTEGER(iwp)                       ::  ind             !<
-    INTEGER(iwp)                       ::  j               !<
-    INTEGER(iwp)                       ::  k               !<
-    INTEGER(iwp)                       ::  n               !<
-    INTEGER(iwp)                       ::  particle_size   !<
-
-    INTEGER(KIND=rd_offset_kind)       ::  disp            !<
-    INTEGER(KIND=rd_offset_kind)       ::  offset          !<
-    INTEGER(KIND=rd_offset_kind)       ::  prt_nr_bytes    !<
-
-    LOGICAL                            ::  found           !<
-
-    REAL(dp)                           :: rr               !< there is no data type INTEGER*8 in MPI
-    REAL(dp)                           :: rs               !< use REAL*8 to compute max offset
-
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE, TARGET :: prt_data   !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status          !<
-#else
-    TYPE(C_PTR)                        ::  buf
-#endif
-
-    found = .FALSE.
-
-    DO  i = 1, tgh%nr_arrays
-       IF ( TRIM(array_names(i)) == TRIM( name ) )  THEN
-          array_position = array_offset(i)
-          found = .TRUE.
-          EXIT
-       ENDIF
-    ENDDO
-
-    IF ( found )  THEN
-
-       offset = 0
-
-       particle_size = STORAGE_SIZE(zero_particle) / 8  ! 8 here means number of bits/byte, NOT wp
-
-       array_size = 0
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             array_size = MAX( array_size, SUM(prt_count(:,j,i)) )
-          ENDDO
-       ENDDO
-
-       ALLOCATE( prt_data(MAX(array_size,1)) )
-
-!
-!--    Write columns of particle
-#if defined( __parallel )
-       CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
-#endif
-       prt_nr_bytes = 0
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             disp         = array_position + prt_global_index(nzb,j,i) * particle_size
-             byte_column  = SUM( prt_count(:,j,i) ) * particle_size
-             prt_nr_bytes = MAX( disp+byte_column, prt_nr_bytes )
-
-#if defined( __parallel )
-             CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited number of cores is inactive
-             IF ( byte_column > 0 )  THEN
-                CALL MPI_FILE_SEEK( fh, disp, MPI_SEEK_SET, ierr )
-                CALL MPI_FILE_READ( fh, prt_data, byte_column, MPI_BYTE, status, ierr )
-             ENDIF
-             CALL sm_io%sm_node_barrier()
-#else
-             buf = C_LOC(prt_data)     ! use C_PTR to avaid another overlay in posix interface
-             CALL posix_lseek( fh, disp )
-             CALL posix_read( fh, buf, byte_column )
-#endif
-             ind = 1
-             DO  k = nzb, nzt+1
-                DO  n = 1, prt_count(k,j,i)
-                   grid_particles(k,j,i)%particles(n) = prt_data(ind)
-                   ind = ind+1
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-#if defined( __parallel )
-       rs = prt_nr_bytes
-       CALL MPI_ALLREDUCE( rs, rr, 1, MPI_DOUBLE_PRECISION, MPI_MAX, comm2d, ierr )
-       prt_nr_bytes = rr
-#else
-       rr = rs
-#endif
-       array_position = prt_nr_bytes
-
-       DEALLOCATE( prt_data )
-
-    ENDIF
-
- END SUBROUTINE rrd_mpi_io_particles
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 1d-REAL surface data array with MPI-IO.
-!> This is a recursive subroutine. In case of cyclic fill mode it may call itself for reading parts
-!> of the prerun grid.
-!--------------------------------------------------------------------------------------------------!
- RECURSIVE SUBROUTINE rrd_mpi_io_surface( name, data, first_index )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name            !<
-
-    INTEGER(iwp), OPTIONAL       ::  first_index     !<
-    INTEGER(iwp)                 ::  i               !<
-    INTEGER(iwp)                 ::  j               !<
-    INTEGER(iwp)                 ::  lo_first_index  !<
-
-#if defined( __parallel )
-    INTEGER(iwp)                 ::  buf_start       !<
-    INTEGER(KIND=rd_offset_kind) ::  disp            !< displacement of actual indices
-    INTEGER(iwp)                 ::  ie              !<
-    INTEGER(iwp)                 ::  ind_gb          !<
-    INTEGER(iwp)                 ::  ind_out         !<
-    INTEGER(iwp)                 ::  is              !<
-    INTEGER(iwp)                 ::  n               !<
-    INTEGER(iwp)                 ::  n_trans         !<
-
-    INTEGER(iwp),DIMENSION(0:numprocs-1) ::  lo_index  !<
-    INTEGER, DIMENSION(rd_status_size)   ::  status    !<
-#endif
-    LOGICAL                      ::  found  !<
-
-    REAL(wp), INTENT(OUT), DIMENSION(:), TARGET ::  data  !<
-#if defined( __parallel )
-    REAL(wp),DIMENSION(:),ALLOCATABLE    ::  put_buffer  !<
-#endif
-
-
-    found = .FALSE.
-    lo_first_index = 1
-
-    IF ( PRESENT( first_index ) )   THEN
-       lo_first_index = first_index
-    ENDIF
-
-    DO  i = 1, tgh%nr_arrays
-        IF ( TRIM( array_names(i) ) == TRIM( name ) )  THEN
-!
-!--        ATTENTION: The total_number_of_surface_elements and wp MUST be INTERGER(8).
-!--        The compiler (at least Intel) first computes total_number_of_surface_elements*wp
-!--        and then does the conversion to INTEGER(8).
-!--        This may lead to wrong results when total_number_of_surface_elements*wp is > 2*10**6
-           array_position = array_offset(i) + ( lo_first_index - 1 ) *                             &
-                            INT( total_number_of_surface_elements, idp ) * INT( wp, idp )
-           found = .TRUE.
-           EXIT
-        ENDIF
-    ENDDO
-
-!
-!-- In case of 2d-data, name is written only once
-    IF ( lo_first_index == 1 )  THEN
-
-       array_names(header_array_index)  = name
-       array_offset(header_array_index) = array_position
-       header_array_index = header_array_index + 1
-
-    ENDIF
-
-    IF ( found )  THEN
-       IF ( cyclic_fill_mode )  THEN
-
-          CALL rrd_mpi_io_surface_cyclic_fill
-          RETURN
-
-       ELSE
-#if defined( __parallel )
-!
-!--       Read data from restart file
-          CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
-          IF ( sm_io%iam_io_pe )  THEN
-             CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_surf, 'native',              &
-                                     MPI_INFO_NULL, ierr )
-             CALL MPI_FILE_READ_ALL ( fh, array_out, SIZE(array_out), MPI_REAL, status, ierr )
-          ENDIF
-          CALL sm_io%sm_node_barrier()
-
-!
-!--       Copy data into transfer buffer. Data is organized in a way that only one MPI_PUT to the
-!--       respective PE ist required.
-          ALLOCATE( put_buffer(SUM( transfer_index(4,:) )) )
-
-          ind_gb = 1
-          DO  i = 1, SIZE( local_indices, 2 )
-             ind_out = local_indices(1,i)
-             DO  j = 1, local_indices(2,i)
-                put_buffer(ind_gb) = array_out(ind_out)
-                ind_out = ind_out + 1
-                ind_gb  = ind_gb  + 1
-             ENDDO
-          ENDDO
-!
-!--       Transfer data from I/O PEs to the respective PEs to which they belong.
-          CALL MPI_WIN_FENCE( 0, win_surf, ierr )
-
-          buf_start = 1
-          DO  n = 0, numprocs-1
-             n_trans = transfer_index(4,n)
-             IF ( n_trans > 0 )  THEN
-                disp = transfer_index(3,n) - 1
-                CALL MPI_PUT( put_buffer(buf_start), n_trans, MPI_REAL, n, disp, n_trans, MPI_REAL,&
-                              win_surf, ierr)
-                buf_start = buf_start + n_trans
-             ENDIF
-          ENDDO
-
-          CALL MPI_WIN_FENCE( 0, win_surf, ierr )
-          DEALLOCATE( put_buffer )
-!
-!--       Copy from RMA window into output array (data) to allow transfering data to target PEs.
-!--       Check, if the number of surface elements per horizontal gridbox match the index setup.
-          lo_index = nr_surfaces_in_tb
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                is = lo_index(s_index_in_window(j,i)) + 1
-                ie = is + m_end_index(j,i) - m_start_index(j,i)
-                data(m_start_index(j,i):m_end_index(j,i)) = array_1d(is:ie)
-                lo_index(s_index_in_window(j,i)) = lo_index(s_index_in_window(j,i)) +              &
-                                                   e_end_index(j,i) - e_start_index(j,i) + 1
-!
-!--             TODO: Test can be removed later.
-                IF ( e_end_index(j,i)-e_start_index(j,i)+1 /= NINT( array_1d(is-1) ) )  THEN
-                   WRITE( 9, '(A,6I8)' ) 'Nr surface elements does not match ', j, i,              &
-                                         e_start_index(j,i), e_end_index(j,i),                     &
-                                         e_end_index(j,i)-e_start_index(j,i)+1 ,                   &
-                                         NINT( array_1d(is-1) )
-                   FLUSH( 9 )
-                   CALL MPI_ABORT( comm2d, 1, ierr )
-                ENDIF
-             ENDDO
-          ENDDO
-
-
-#else
-          CALL posix_lseek( fh, array_position )
-          CALL posix_read( fh, array_out, SIZE(array_out) )
-
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                data(m_start_index(j,i):m_end_index(j,i)) =                                        &
-                                                   array_out(e_start_index(j,i)+1:e_end_index(j,i))
-!
-!--             TODO: Test can be removed later.
-                IF ( e_end_index(j,i)-e_start_index(j,i)+1 /= NINT(array_out(e_start_index(j,i))) )&
-                THEN
-                   WRITE( 9, '(A,6I8)' ) 'Nr surface elements does not match ', j, i,              &
-                                         e_start_index(j,i), e_end_index(j,i),                     &
-                                         e_end_index(j,i)-e_start_index(j,i)+1,                    &
-                                         NINT( array_out(e_start_index(j,i)) )
-                   FLUSH( 9 )
-                   CALL ABORT()
-                ENDIF
-             ENDDO
-          ENDDO
-#endif
-       ENDIF
-
-    ENDIF
-
- CONTAINS
-
-    SUBROUTINE rrd_mpi_io_surface_cyclic_fill
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i         !<
-       INTEGER(iwp) ::  ie        !<
-       INTEGER(iwp) ::  is        !<
-       INTEGER(iwp) ::  i_remote  !<
-       INTEGER(iwp) ::  j         !<
-       INTEGER(iwp) ::  je        !<
-       INTEGER(iwp) ::  js        !<
-       INTEGER(iwp) ::  j_remote  !<
-       INTEGER(iwp) ::  nval      !<
-       INTEGER(iwp) ::  rem_pe    !<
-
-#if defined( __parallel )
-       INTEGER(KIND=MPI_ADDRESS_KIND) ::  rem_offs  !<
-#else
-       INTEGER(idp) ::  rem_offs                    !<
-#endif
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  c_data  !<
-
-
-!
-!--    ATTENTION: This version allows only 1 surface element per grid cell.
-!
-!--    Activate grid of the smaller prerun, i.e. grid variables like nxl, nxr, nys, nyn and other
-!--    values are set according to the prerun settings.
-       CALL prerun_grid%activate_grid_from_this_class()
-
-       IF ( pe_active_for_read )  THEN
-
-          IF ( MAXVAL( m_end_index ) <= 0 )  THEN
-             CALL mainrun_grid%activate_grid_from_this_class()
-             IF ( debug_output )  THEN
-                CALL debug_message( 'PE inactive for reading restart or prerun data', 'start' )
-             ENDIF
-             RETURN
-          ENDIF
-
-          ALLOCATE( c_data(MAXVAL( m_end_index )) )
-
-!
-!--       Recursive CALL of rrd_mpi_io_surface.
-!--       rrd_mpi_io_surface is called with cyclic_fill_mode = .FALSE. on the smaller prerun grid.
-          cyclic_fill_mode = .FALSE.
-          CALL rrd_mpi_io_surface( name, c_data )
-          cyclic_fill_mode = .TRUE.
-
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                rmabuf_2d(j,i) = c_data(c_start_index(j,i))
-             ENDDO
-          ENDDO
-
-       ENDIF
-!
-!--    Activate grid of the mainrun, i.e. grid variables like nxl, nxr, nys, nyn and other values
-!--    are set according to the mainrun settings.
-       CALL mainrun_grid%activate_grid_from_this_class()
-
-#if defined( __parallel )
-!
-!--    Close RMA window to allow remote access
-       CALL MPI_WIN_FENCE( 0, rmawin_2d, ierr )
-#endif
-
-!
-!--   After reading surface data on the small grid, map these data in a cyclic way to all respective
-!--   grid points of the main run.
-      is = nxl
-      ie = nxr
-      js = nys
-      je = nyn
-
-       DO  i = is, ie
-          DO  j = js, je
-             i_remote = MOD( i, nx_on_file+1 )
-             j_remote = MOD( j, ny_on_file+1 )
-             rem_pe   = remote_pe(i_remote,j_remote)
-             rem_offs = rma_offset(i_remote,j_remote)
-             nval     = 1
-
-#if defined( __parallel )
-             IF ( rem_pe /= myid )  THEN
-                CALL MPI_GET( data(o_start_index(j,i)), nval, MPI_REAL, rem_pe, rem_offs, nval,    &
-                              MPI_REAL, rmawin_2d, ierr)
-             ELSE
-                data(o_start_index(j,i)) = rmabuf_2d(j_remote,i_remote)
-             ENDIF
-#else
-             data(o_start_index(j,i)) = array_2d(i_remote,j_remote)
-#endif
-          ENDDO
-       ENDDO
-
-#if defined( __parallel )
-!
-!--    Reopen RMA window to allow filling
-       CALL MPI_WIN_FENCE( 0, rmawin_2d, ierr )
-#endif
-
-       IF ( ALLOCATED( c_data ) )  DEALLOCATE( c_data )
-
-    END SUBROUTINE rrd_mpi_io_surface_cyclic_fill
-
- END SUBROUTINE rrd_mpi_io_surface
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 2d-REAL surface data array with MPI-IO.
-!> These consist of multiple 1d-REAL surface data arrays.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rrd_mpi_io_surface_2d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)          ::  name  !<
-
-    INTEGER(iwp)                          ::  i     !<
-
-    REAL(wp), INTENT(OUT), DIMENSION(:,:) ::  data  !<
-    REAL(wp), DIMENSION(SIZE( data,2))    ::  tmp   !<
-
-
-    DO  i = 1, SIZE( data, 1 )
-       CALL rrd_mpi_io_surface( name, tmp, first_index = i )
-       data(i,:) = tmp
-    ENDDO
-
-!
-!-- Comment from Klaus Ketelsen (September 2018)
-!-- The intention of the following loop was to let the compiler do the copying on return.
-!-- In my understanding it is standard conform to pass the second dimension to a 1d-array inside a
-!-- subroutine and the compiler is responsible to generate code for copying. Acually this works fine
-!-- for INTENT(IN) variables (wrd_mpi_io_surface_2d). For INTENT(OUT) like in this case the code
-!-- works on pgi compiler. But both, the Intel 16 and the Cray compiler show wrong answers using
-!-- this loop. That is the reason why the above auxiliary array tmp was introduced.
-!    DO  i = 1, SIZE(  data,1)
-!       CALL rrd_mpi_io_surface( name, data(i,:), first_index = i )
-!    ENDDO
-
- END SUBROUTINE rrd_mpi_io_surface_2d
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write particle data with MPI-IO.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_particles( name, prt_global_index )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)                       ::  name            !<
-    INTEGER(idp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  prt_global_index      !<
-
-    INTEGER(iwp)                       ::  array_size      !<
-    INTEGER(iwp)                       ::  byte_column     !<
-    INTEGER(iwp)                       ::  i               !<
-    INTEGER(iwp)                       ::  ind             !<
-    INTEGER(iwp)                       ::  j               !<
-    INTEGER(iwp)                       ::  k               !<
-    INTEGER(iwp)                       ::  n               !<
-    INTEGER(iwp)                       ::  particle_size   !<
-
-    INTEGER(KIND=rd_offset_kind)       ::  disp            !<
-    INTEGER(KIND=rd_offset_kind)       ::  offset          !<
-    INTEGER(KIND=rd_offset_kind)       ::  prt_nr_bytes    !<
-
-    REAL(dp)                           :: rs               !< use REAL*8 to compute max offset
-    REAL(dp)                           :: rr               !< there is no data type INTEGER*8 in MPI
-
-
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE, TARGET ::  prt_data   !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status          !<
-#else
-    TYPE(C_PTR)                        ::  buf
-#endif
-
-
-    offset = 0
-
-    array_names(header_array_index)  = TRIM(name)
-    array_offset(header_array_index) = array_position
-    header_array_index = header_array_index + 1
-
-    particle_size = STORAGE_SIZE( zero_particle ) / 8
-
-    array_size = 0
-    DO  i = nxl, nxr
-      DO  j = nys, nyn
-         array_size = MAX( array_size, SUM(prt_count(:,j,i)) )
-       ENDDO
-    ENDDO
-
-    ALLOCATE( prt_data(MAX(array_size,1)) )
-
-!
-!-- Write columns of particles.
-!-- The particles of a column are stored sequentially in the first dimension of the particles array.
-!-- Store only the particles of one cell would be possible with this setup, but the I/O portions
-!-- for a maximum of 100 particles are not big enough.
-#if defined( __parallel )
-    CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
-#endif
-    prt_nr_bytes = 0
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          disp         = array_position + prt_global_index(nzb,j,i) * particle_size
-          byte_column  = SUM( prt_count(:,j,i) ) * particle_size
-          prt_nr_bytes = MAX( disp+byte_column, prt_nr_bytes )
-
-          ind = 1
-          DO  k = nzb, nzt+1
-             DO  n = 1, prt_count(k,j,i)
-                prt_data(ind) = grid_particles(k,j,i)%particles(n)
-                ind = ind+1
-             ENDDO
-          ENDDO
-
-#if defined( __parallel )
-          CALL sm_io%sm_node_barrier()  ! Has no effect if I/O on limited number of cores is inactive
-          IF ( byte_column > 0 )  THEN
-             CALL MPI_FILE_SEEK( fh, disp, MPI_SEEK_SET, ierr )
-             CALL MPI_FILE_WRITE( fh, prt_data, byte_column, MPI_BYTE, status, ierr )
-          ENDIF
-          CALL sm_io%sm_node_barrier()
-#else
-          buf = C_LOC(prt_data)  ! use C_PTR to avoid another overlay in posix interface
-          CALL posix_lseek( fh, disp )
-          CALL posix_write( fh, buf, byte_column )
-#endif
-       ENDDO
-    ENDDO
-
-#if defined( __parallel )
-    rs = prt_nr_bytes
-    CALL MPI_ALLREDUCE( rs, rr, 1, MPI_DOUBLE_PRECISION, MPI_MAX, comm2d, ierr )
-    prt_nr_bytes = rr
-#else
-    rr = rs
-#endif
-    array_position = prt_nr_bytes
-
-    DEALLOCATE( prt_data )
-
- END SUBROUTINE wrd_mpi_io_particles
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write 1d-REAL surface data array with MPI-IO.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_surface( name, data, first_index )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name  !<
-
-    INTEGER(iwp), OPTIONAL ::  first_index     !<
-    INTEGER(iwp) ::  i               !<
-    INTEGER(iwp) ::  j               !<
-    INTEGER(iwp) ::  lo_first_index  !<
-#if defined( __parallel )
-    INTEGER(iwp) ::  buf_start       !<
-    INTEGER(iwp) ::  ie              !<
-    INTEGER(iwp) ::  is              !<
-    INTEGER(iwp) ::  ind_gb          !<
-    INTEGER(iwp) ::  ind_out         !<
-    INTEGER(iwp) ::  n               !<
-    INTEGER(iwp) ::  n_trans         !<
-#endif
-
-#if defined( __parallel )
-    INTEGER(KIND=MPI_ADDRESS_KIND) ::  disp    !< displacement in RMA window
-    INTEGER(KIND=rd_offset_kind)   ::  offset  !<
-
-    INTEGER(iwp), DIMENSION(0:numprocs-1)   ::  lo_index  !<
-    INTEGER(iwp), DIMENSION(rd_status_size) ::  status    !<
-#endif
-
-    REAL(wp), INTENT(IN), DIMENSION(:), TARGET ::  data  !<
-#if defined( __parallel )
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  get_buffer  !<
-#endif
-
-
-    lo_first_index = 1
-
-    IF ( PRESENT( first_index ) )  THEN
-       lo_first_index = first_index
-    ENDIF
-
-!
-!-- In case of 2d-data, name is written only once
-    IF ( lo_first_index == 1 )  THEN
-
-       IF ( header_array_index == max_nr_arrays )  THEN
-          message_string = 'maximum number of 2d/3d-array entries in restart file header exceeded'
-          CALL message( 'wrd_mpi_io_surface', 'PA0585', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       array_names(header_array_index)  = name
-       array_offset(header_array_index) = array_position
-       header_array_index = header_array_index + 1
-
-    ENDIF
-
-#if defined( __parallel )
-    offset = 0
-
-    ALLOCATE( get_buffer(SUM( transfer_index(4,:) )) )
-!
-!-- Copy from input array (data) to RMA window to allow the target PEs to get the appropiate data.
-!-- At this point, a dummy surface element is added. This makes sure that every x-y gridbox owns
-!-- at least one surface element. This way, bookkeeping becomes much easier.
-    lo_index = nr_surfaces_in_tb
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          is = lo_index(s_index_in_window(j,i)) + 1
-          ie = is + m_end_index(j,i) - m_start_index(j,i)
-!
-!--       Store number of surface elements in dummy additional surface element
-          array_1d(is-1)  = e_end_index(j,i) - e_start_index(j,i) + 1
-          array_1d(is:ie) = data(m_start_index(j,i):m_end_index(j,i))
-          lo_index(s_index_in_window(j,i)) = lo_index(s_index_in_window(j,i)) +                    &
-                                             e_end_index(j,i) - e_start_index(j,i) + 1
-       ENDDO
-    ENDDO
-!
-!-- On target PE, get data from source PEs which are assigned for output on this PE.
-    CALL MPI_WIN_FENCE( 0, win_surf, ierr )
-
-    buf_start = 1
-    DO  n = 0, numprocs-1
-       n_trans = transfer_index(4,n)
-       IF ( n_trans > 0 )  THEN
-          disp = transfer_index(3,n) - 1
-          CALL MPI_GET( get_buffer(buf_start), n_trans, MPI_REAL, n, disp, n_trans, MPI_REAL,      &
-                        win_surf, ierr )
-          buf_start = buf_start + n_trans
-       ENDIF
-    ENDDO
-
-    CALL MPI_WIN_FENCE( 0, win_surf, ierr )
-!
-!-- Copy data to output buffer. Here, the outpuf buffer matches the indices global_start and
-!-- global_end.
-    ind_gb  = 1
-    DO  i = 1, SIZE( local_indices, 2 )
-       ind_out = local_indices(1,i)
-       DO  j = 1, local_indices(2,i)
-          array_out(ind_out) = get_buffer(ind_gb)
-          ind_out = ind_out+1
-          ind_gb  = ind_gb+1
-       ENDDO
-    ENDDO
-
-    DEALLOCATE( get_buffer )
-
-!
-!-- Write data to disk.
-    CALL sm_io%sm_node_barrier()  ! has no effect if I/O on limited number of cores is inactive
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_surf, 'native', MPI_INFO_NULL,     &
-                               ierr )
-       CALL MPI_FILE_WRITE_ALL( fh, array_out, SIZE( array_out ), MPI_REAL, status, ierr )
-    ENDIF
-    CALL sm_io%sm_node_barrier()
-#else
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          array_out(e_start_index(j,i)) = e_end_index(j,i) - e_start_index(j,i) + 1
-          array_out(e_start_index(j,i)+1:e_end_index(j,i)) =                                       &
-                                                          data(m_start_index(j,i):m_end_index(j,i))
-       ENDDO
-    ENDDO
-
-    CALL posix_lseek( fh, array_position )
-    CALL posix_write( fh, array_out, SIZE(array_out) )
-#endif
-
-    array_position = array_position + total_number_of_surface_elements * wp
-
- END SUBROUTINE wrd_mpi_io_surface
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read 2d-REAL surface data array with MPI-IO.
-!> This consist of multiple 1d-REAL surface data arrays.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wrd_mpi_io_surface_2d( name, data )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)         ::  name  !<
-
-    INTEGER(iwp)                         ::  i     !<
-
-    REAL(wp), INTENT(IN), DIMENSION(:,:) ::  data  !<
-
-
-    DO  i = 1, SIZE( data, 1 )
-       CALL wrd_mpi_io_surface( name, data(i,:), first_index = i )
-    ENDDO
-
- END SUBROUTINE wrd_mpi_io_surface_2d
-
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Close restart file for MPI-IO
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rd_mpi_io_close
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)                       ::  gh_size  !<
-    INTEGER(KIND=rd_offset_kind)       ::  offset   !<
-#if defined( __parallel )
-    INTEGER, DIMENSION(rd_status_size) ::  status   !<
-#endif
-
-#if ! defined( __parallel )
-    TYPE(C_PTR)                        ::  buf_ptr  !<
-#endif
-
-
-    offset = 0
-
-    IF ( wr_flag  .AND.  sm_io%iam_io_pe )  THEN
-
-       tgh%nr_int      = header_int_index - 1
-       tgh%nr_char     = header_char_index - 1
-       tgh%nr_real     = header_real_index - 1
-       tgh%nr_arrays   = header_array_index - 1
-       tgh%total_nx    = iog%nx + 1
-       tgh%total_ny    = iog%ny + 1
-       tgh%pes_along_x = pdims(1)
-       tgh%pes_along_y = pdims(2)
-       IF ( include_total_domain_boundaries )  THEN   ! Not sure, if LOGICAL interpretation is the same for all compilers,
-          tgh%i_outer_bound = 1                       ! therefore store as INTEGER in general header
-       ELSE
-          tgh%i_outer_bound = 0
-       ENDIF
-!
-!--    Check for big/little endian format. This check is currently not used, and could be removed
-!--    if we can assume little endian as the default on all machines.
-       CALL rd_mpi_io_check_endian( tgh%endian )
-
-!
-!--    Set default view
-#if defined( __parallel )
-       CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
-#endif
-!
-!--    Write header file
-       gh_size = storage_size(tgh) / 8
-       IF ( myid == 0 )  THEN   ! myid = 0 always performs I/O, even if I/O is limited to some cores
-#if defined( __parallel )
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_WRITE( fh, tgh, gh_size, MPI_INT, status, ierr )
-          header_position = header_position + gh_size
-!
-!--       INTEGER values
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_WRITE( fh, int_names, SIZE( int_names ) * 32, MPI_CHAR, status, ierr )
-          header_position = header_position + SIZE( int_names ) * 32
-
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_WRITE( fh, int_values, SIZE( int_values ), MPI_INT, status, ierr )
-          header_position = header_position + SIZE( int_values ) * iwp
-!
-!--       Character entries
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_WRITE( fh, text_lines, SIZE( text_lines ) * 128, MPI_CHAR, status, ierr )
-          header_position = header_position + SIZE( text_lines ) * 128
-!
-!---      REAL values
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_WRITE( fh, real_names, SIZE( real_names ) * 32, MPI_CHAR, status, ierr )
-          header_position = header_position + SIZE( real_names ) * 32
-
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_WRITE( fh, real_values, SIZE( real_values ), MPI_REAL, status, ierr )
-          header_position = header_position + SIZE( real_values ) * wp
-!
-!--       2d- and 3d- distributed array headers, all replicated array headers
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_WRITE( fh, array_names, SIZE( array_names ) * 32, MPI_CHAR, status, ierr )
-          header_position = header_position + SIZE( array_names ) * 32
-
-          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
-          CALL MPI_FILE_WRITE( fh, array_offset, SIZE( array_offset ) * MPI_OFFSET_KIND, MPI_BYTE, &
-                               status, ierr )  ! There is no I*8 datatype in Fortran
-          header_position = header_position + SIZE( array_offset ) * rd_offset_kind
-#else
-          CALL posix_lseek( fh, header_position )
-          buf_ptr = C_LOC( tgh )
-          CALL posix_write( fh, buf_ptr, gh_size )
-          header_position = header_position + gh_size
-!
-!--       INTEGER values
-          CALL posix_lseek( fh, header_position )
-          CALL posix_write( fh, int_names )
-          header_position = header_position + SIZE( int_names ) * 32
-
-          CALL posix_lseek( fh, header_position )
-          CALL posix_write( fh, int_values, SIZE( int_values ) )
-          header_position = header_position + SIZE( int_values ) * iwp
-!
-!--       Character entries
-          CALL posix_lseek( fh, header_position )
-          CALL posix_write( fh, text_lines )
-          header_position = header_position + SIZE( text_lines ) * 128
-!
-!--       REAL values
-          CALL posix_lseek( fh, header_position )
-          CALL posix_write( fh, real_names )
-          header_position = header_position + SIZE( real_names ) * 32
-
-          CALL posix_lseek( fh, header_position )
-          CALL posix_write( fh, real_values, SIZE( real_values ) )
-          header_position = header_position + SIZE( real_values ) * wp
-!
-!--       2d- and 3d-distributed array headers, all replicated array headers
-          CALL posix_lseek( fh, header_position )
-          CALL posix_write( fh, array_names )
-          header_position = header_position + SIZE( array_names ) * 32
-
-          CALL posix_lseek( fh, header_position )
-          CALL posix_write( fh, array_offset, SIZE( array_offset ) )
-          header_position = header_position + SIZE( array_offset ) * rd_offset_kind
-#endif
-          IF ( debug_output )  CALL rd_mpi_io_print_header
-       ENDIF
-
-    ENDIF
-
-!
-!-- Free file types
-    CALL rd_mpi_io_free_filetypes
-
-!
-!-- Close MPI-IO files
-#if defined( __parallel )
-!
-!-- Free RMA windows
-    IF ( cyclic_fill_mode )  THEN
-       CALL MPI_WIN_FREE( rmawin_2di, ierr )
-       CALL MPI_WIN_FREE( rmawin_2d, ierr )
-       CALL MPI_WIN_FREE( rmawin_3d, ierr )
-    ENDIF
-#endif
-
-    IF ( ALLOCATED( e_start_index )     )   DEALLOCATE( e_start_index )
-    IF ( ALLOCATED( e_end_index )       )   DEALLOCATE( e_end_index )
-    IF ( ALLOCATED( m_start_index )     )   DEALLOCATE( m_start_index )
-    IF ( ALLOCATED( m_end_index )       )   DEALLOCATE( m_end_index )
-    IF ( ALLOCATED( nr_surfaces_in_tb ) )   DEALLOCATE( nr_surfaces_in_tb )
-    IF ( ALLOCATED( s_index_in_tb )     )   DEALLOCATE( s_index_in_tb )
-    IF ( ALLOCATED( s_index_in_window ) )   DEALLOCATE( s_index_in_window )
-    IF ( ALLOCATED( transfer_index )    )   DEALLOCATE( transfer_index )
-
-    IF ( .NOT. pe_active_for_read )  RETURN
-!
-!-- TODO: better explain the following message
-!-- In case on non cyclic read, pe_active_for_read is set .TRUE.
-    IF ( sm_io%iam_io_pe )  THEN
-
-#if defined( __parallel )
-       CALL MPI_FILE_CLOSE( fh, ierr )
-#else
-       CALL posix_close( fh )
-#endif
-
-    ENDIF
-
-    fh = -1
-
-    restart_file_size = array_position / ( 1024.0_dp * 1024.0_dp )
-
- END SUBROUTINE rd_mpi_io_close
-
-
-
- FUNCTION rd_mpi_io_check_open()  RESULT ( isopen )
-
-    LOGICAL ::  isopen
-
-    isopen = ( fh /= -1 )
-
- END FUNCTION rd_mpi_io_check_open
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine prepares a filetype and some variables for the I/O of surface data.
-!> Whenever a new set of start_index and end_index is used, rd_mpi_io_surface_filetypes has to be
-!> called. A main feature of this subroutine is computing the global start indices of the 1d- and
-!> 2d- surface arrays.
-!> Even if I/O is done by a limited number of cores only, the surface data are read by ALL cores!
-!> Reading them by some cores and then distributing the data would result in complicated code
-!> which is suspectable for errors and overloads the reading subroutine. Since reading of surface
-!> data is not time critical (data size is comparably small), it will be read by all cores.
-!--------------------------------------------------------------------------------------------------!
- RECURSIVE SUBROUTINE rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write,          &
-                                                   global_start, global_end )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  e_lo_start        !<
-    INTEGER(iwp) ::  i                 !<  loop index
-    INTEGER(iwp) ::  j                 !<  loop index
-    INTEGER(iwp) ::  index_offset      !<
-    INTEGER(iwp) ::  last_end_index    !<
-    INTEGER(iwp) ::  lo_start          !<
-    INTEGER(iwp) ::  nr_surfcells_pe   !<
-    INTEGER(iwp) ::  rest_cells_pe     !<
-    INTEGER(iwp) ::  rest_bound        !<
-#if defined( __parallel )
-    INTEGER(iwp) ::  io_end_index      !<
-    INTEGER(iwp) ::  io_start_index    !<
-    INTEGER(iwp) ::  n                 !<  loop index
-    INTEGER(iwp) ::  nr_previous       !<
-#endif
-
-    INTEGER(iwp), DIMENSION(0:numprocs-1,2) ::  nr_surfcells_all_s  !<
-    INTEGER(iwp), DIMENSION(0:numprocs-1,2) ::  nr_surfcells_all_r  !<
-#if defined( __parallel )
-    INTEGER(iwp), DIMENSION(1)              ::  dims1               !< global dimension for MPI_TYPE_CREATE_SUBARRAY
-    INTEGER(iwp), DIMENSION(1)              ::  lsize1              !< local size for MPI_TYPE_CREATE_SUBARRAY
-    INTEGER(iwp), DIMENSION(0:numprocs-1)   ::  nr_gp_with_surfaces_for_pe  !< number of horizontal gridpoints containing surface elements for the respective pe
-    INTEGER(iwp), DIMENSION(0:numprocs-1)   ::  nr_surface_elements_for_pe !< total number of surface elements for the respective pe
-    INTEGER(iwp), DIMENSION(0:pdims(1))     ::  nr_surf_cells_x     !<
-    INTEGER(iwp), DIMENSION(0:pdims(1))     ::  nr_surf_cells_x_s   !<
-    INTEGER(iwp), DIMENSION(1)              ::  start1              !< start index for MPI_TYPE_CREATE_SUBARRAY
-    INTEGER(iwp), DIMENSION(nxl:nxr)        ::  sum_y               !<
-#endif
-
-    INTEGER(iwp), INTENT(INOUT), DIMENSION(nys:nyn,nxl:nxr) ::  end_index     !< local end indx
-    INTEGER(iwp), INTENT(INOUT), DIMENSION(nys:nyn,nxl:nxr) ::  global_start  !< global start index
-    INTEGER(iwp), INTENT(INOUT), DIMENSION(nys:nyn,nxl:nxr) ::  global_end    !< global end index
-    INTEGER(iwp), INTENT(INOUT), DIMENSION(nys:nyn,nxl:nxr) ::  start_index   !< local start index
-#if defined( __parallel )
-    INTEGER(iwp), DIMENSION(0:myidy,nxl:nxr)    ::  nr_previous_y      !<
-    INTEGER(iwp), DIMENSION(0:pdims(2),nxl:nxr) ::  nr_surf_cells_y    !<
-    INTEGER(iwp), DIMENSION(0:pdims(2),nxl:nxr) ::  nr_surf_cells_y_s  !<
-    INTEGER(iwp), DIMENSION(4,0:numprocs-1)     ::  transfer_index_s   !<
-#endif
-
-    LOGICAL, INTENT(OUT) ::  data_to_write        !< returns .TRUE., if surface data have been written
-    LOGICAL              ::  only_dummy_elements  !< only dummy elements, i.e. no data to write
-
-
-!
-!-- Clean up previous calls.
-#if defined( __parallel )
-    IF ( win_surf /= -1 )  THEN
-       CALL MPI_WIN_FREE( win_surf, ierr )
-       DEALLOCATE( array_1d )
-       win_surf = -1
-    ENDIF
-    IF ( ft_surf /= -1  .AND.  sm_io%iam_io_pe )  THEN
-       CALL MPI_TYPE_FREE( ft_surf, ierr )
-    ENDIF
-    ft_surf = -1
-    IF ( sm_io%is_sm_active() )  THEN
-       IF ( win_out /= -1 )  THEN
-          CALL MPI_WIN_FREE( win_out, ierr )
-          win_out = -1
-       ENDIF
-    ELSE
-       IF ( ASSOCIATED( array_out ) )  DEALLOCATE( array_out )
-    ENDIF
-#else
-    IF ( ASSOCIATED( array_out ) )  DEALLOCATE( array_out )
-#endif
-
-    IF ( cyclic_fill_mode )  THEN
-       CALL cyclic_fill_surface_filetype
-       RETURN
-    ELSE
-       IF ( .NOT. ALLOCATED( e_end_index )        )  ALLOCATE( e_end_index(nys:nyn,nxl:nxr) )
-       IF ( .NOT. ALLOCATED( e_start_index )      )  ALLOCATE( e_start_index(nys:nyn,nxl:nxr) )
-       IF ( .NOT. ALLOCATED( m_end_index )        )  ALLOCATE( m_end_index(nys:nyn,nxl:nxr) )
-       IF ( .NOT. ALLOCATED( m_start_index )      )  ALLOCATE( m_start_index(nys:nyn,nxl:nxr) )
-       IF ( .NOT. ALLOCATED( nr_surfaces_in_tb )  )  ALLOCATE( nr_surfaces_in_tb(0:numprocs-1) )
-       IF ( .NOT. ALLOCATED( s_index_in_tb )      )  ALLOCATE( s_index_in_tb(0:numprocs-1) )
-       IF ( .NOT. ALLOCATED( s_index_in_window )  )  ALLOCATE( s_index_in_window(nys:nyn,nxl:nxr) )
-       IF ( .NOT. ALLOCATED( transfer_index )     )  ALLOCATE( transfer_index(4,0:numprocs-1) )
-    ENDIF
-
-    IF ( wr_flag)  THEN
-!
-!--    Add one dummy value at every grid box.
-!--    This allows to use MPI_FILE_WRITE_ALL and MPI_FILE_READ_ALL with subarray file type.
-       index_offset   = 0
-       last_end_index = 0
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             e_start_index(j,i) = start_index (j,i) + index_offset
-             IF ( end_index (j,i) - start_index(j,i) < 0 )  THEN
-                e_end_index (j,i) = last_end_index+1
-                last_end_index    = last_end_index+1
-             ELSE
-                e_end_index (j,i) = end_index(j,i) + index_offset + 1
-                last_end_index    = e_end_index (j,i)
-             ENDIF
-             index_offset = index_offset + 1
-           ENDDO
-       ENDDO
-#if defined( __parallel )
-!
-!--    Compute indices for global, PE independent 1-d surface element array.
-       nr_surf_cells_y_s = 0
-!
-!--    Count number of surface elements in y-direction for every x.
-       DO  i = nxl, nxr
-          nr_surf_cells_y_s(myidy,i) = SUM( e_end_index (:,i) - e_start_index (:,i) + 1 )
-       ENDDO
-!
-!--    Distribute these elements to all PEs along y.
-       CALL MPI_ALLREDUCE( nr_surf_cells_y_s, nr_surf_cells_y, SIZE( nr_surf_cells_y ),            &
-                           MPI_INTEGER, MPI_SUM, comm1dy, ierr )
-!
-!--    Sum all surface elements along y for individual x PEs
-       nr_surf_cells_x_s        = 0
-       nr_surf_cells_x_s(myidx) = SUM( nr_surf_cells_y )
-!
-!--    Distribute to all PEs along x.
-       CALL MPI_ALLREDUCE( nr_surf_cells_x_s, nr_surf_cells_x, SIZE( nr_surf_cells_x ),            &
-                           MPI_INTEGER, MPI_SUM, comm1dx, ierr )
-       DO  i = nxl, nxr
-          nr_previous_y(:,i) = 0
-          DO  n = 1, myidy
-             nr_previous_y(n,i) = nr_previous_y(n-1,i) + nr_surf_cells_y(n-1,i)
-          ENDDO
-       ENDDO
-
-       sum_y(nxl) = SUM( nr_surf_cells_y(:,nxl) )
-       DO  i = nxl, nxr
-          IF ( i > nxl )  THEN
-             sum_y(i) = sum_y(i-1) + SUM( nr_surf_cells_y(:,i) )
-          ENDIF
-       ENDDO
-
-       nr_previous = 0
-       IF ( myidx >= 1 )  THEN
-          nr_previous = SUM(nr_surf_cells_x(0:myidx-1))
-       ENDIF
-
-       global_start(nys,nxl) = 1 + nr_previous + nr_previous_y(myidy,nxl)
-       DO  j = nys+1, nyn
-          global_start(j,nxl) = global_start(j-1,nxl) + e_end_index(j-1,nxl) -                     &
-                                e_start_index(j-1,nxl) + 1
-       ENDDO
-
-       DO  i = nxl+1, nxr
-          global_start(nys,i) = 1 + nr_previous + nr_previous_y(myidy,i) + sum_y(i-1)
-          DO  j = nys+1, nyn
-             global_start(j,i) = global_start(j-1,i) + e_end_index(j-1,i) - e_start_index(j-1,i) + 1
-          ENDDO
-       ENDDO
-#else
-       global_start = e_start_index
-#endif
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             global_end(j,i) = global_start(j,i) + e_end_index (j,i) - e_start_index (j,i)
-          ENDDO
-       ENDDO
-
-    ELSE
-!
-!--    In case of read, compute e_start_index and e_end_index for current processor grid.
-!--    This data contains one extra value for every i and j.
-       e_lo_start = 1
-       lo_start   = 1
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             e_start_index(j,i) = e_lo_start
-             e_end_index(j,i)   = e_lo_start + global_end(j,i) - global_start(j,i)
-             e_lo_start         = e_lo_start + global_end(j,i) - global_start(j,i) + 1
-             start_index(j,i)   = lo_start
-             end_index(j,i)     = lo_start + global_end(j,i) - global_start(j,i) - 1
-             lo_start           = lo_start + global_end(j,i) - global_start(j,i)
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-    nr_surfcells_all_s = 0
-    nr_surfcells_all_s(myid,1) = MAXVAL( e_end_index ) ! don't split surface elements of one gridbox
-    nr_surfcells_all_s(myid,2) = MAXVAL( e_end_index - e_start_index )
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( nr_surfcells_all_s, nr_surfcells_all_r, SIZE( nr_surfcells_all_s ),        &
-                        MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-    nr_surfcells_all_r = nr_surfcells_all_s
-#endif
-
-    total_number_of_surface_elements = 0
-    DO  i = 0, numprocs-1
-       IF ( i == myid )  THEN
-          glo_start = total_number_of_surface_elements + 1
-       ENDIF
-       total_number_of_surface_elements = total_number_of_surface_elements + nr_surfcells_all_r(i,1)
-    ENDDO
-    only_dummy_elements = ( MAXVAL( nr_surfcells_all_r(:,2) ) <= 0 )
-
-!
-!-- Compute indices of equally distributed surface elements.
-!-- Number of surface elements scheduled for ouput on this PE:
-    nr_surfcells_pe  = total_number_of_surface_elements  / numprocs
-    rest_cells_pe    = MOD( total_number_of_surface_elements, numprocs )
-    rest_bound       = rest_cells_pe * ( nr_surfcells_pe + 1 )
-    m_start_index    = start_index
-    m_end_index      = end_index
-
-!
-!-- Compute number of surface elements on source PE, which have to be send to the corresponding
-!-- target PE.
-#if defined( __parallel )
-    nr_gp_with_surfaces_for_pe = 0
-    nr_surface_elements_for_pe = 0
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          IF ( rest_cells_pe == 0 )  THEN
-             s_index_in_window(j,i) = ( global_start(j,i) - 1 ) / nr_surfcells_pe
-          ELSE
-             IF ( global_start(j,i) <= rest_bound )  THEN
-                s_index_in_window(j,i) = ( global_start(j,i) - 1 ) / ( nr_surfcells_pe + 1 )
-             ELSE
-                s_index_in_window(j,i) = ( global_start(j,i) - rest_bound - 1 ) / nr_surfcells_pe
-                s_index_in_window(j,i) = s_index_in_window(j,i) + rest_cells_pe
-             ENDIF
-!
-!--          TODO: Test output, to be removed later.
-             IF ( s_index_in_window(j,i) >= numprocs )  THEN
-                WRITE( 9,'(A,8I8)' )  's_index_in_window ', j, i, s_index_in_window(j,i),          &
-                                      global_start(j,i) , nr_surfcells_pe
-                FLUSH( 9 )
-                CALL MPI_ABORT( comm2d, 1, ierr )
-             ENDIF
-          ENDIF
-          nr_gp_with_surfaces_for_pe(s_index_in_window(j,i)) =                                     &
-                                             nr_gp_with_surfaces_for_pe(s_index_in_window(j,i)) + 1
-          nr_surface_elements_for_pe(s_index_in_window(j,i)) =                                     &
-                                             nr_surface_elements_for_pe(s_index_in_window(j,i)) +  &
-                                             e_end_index(j,i) - e_start_index(j,i) + 1
-       ENDDO
-    ENDDO
-
-!
-!-- Compute start index in the transfer buffer on the source side for the corresponding target PE.
-    s_index_in_tb(0)     = 1
-    nr_surfaces_in_tb(0) = 1
-    DO  n = 1, numprocs-1
-       s_index_in_tb(n)     = s_index_in_tb(n-1)     + nr_gp_with_surfaces_for_pe(n-1)
-       nr_surfaces_in_tb(n) = nr_surfaces_in_tb(n-1) + nr_surface_elements_for_pe(n-1)
-    ENDDO
-!
-!-- Buffer distribution on the source side.
-    DO  n = 0, numprocs-1
-       transfer_index_s(1,n) = s_index_in_tb(n)
-       transfer_index_s(2,n) = nr_gp_with_surfaces_for_pe(n)
-       transfer_index_s(3,n) = nr_surfaces_in_tb(n)
-       transfer_index_s(4,n) = nr_surface_elements_for_pe(n)
-    ENDDO
-
-    CALL MPI_ALLTOALL( transfer_index_s, 4, MPI_INTEGER, transfer_index, 4, MPI_INTEGER, comm2d,   &
-                       ierr)
-!
-!-- Buffer distribution on the target side side.
-    CALL get_remote_indices()
-!
-!-- Create surface element file type.
-    IF ( total_number_of_surface_elements > 0 .AND. .NOT. only_dummy_elements)  THEN
-        data_to_write = .TRUE.
-    ELSE
-        data_to_write = .FALSE.
-    ENDIF
-
-    CALL MPI_ALLREDUCE( global_end(nyn,nxr), dims1(1), 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
-    start1(1) = MINVAL( local_indices(1,:) ) - 1
-    IF ( sm_io%is_sm_active() )  THEN
-       CALL MPI_ALLREDUCE( SUM( local_indices(2,:) ), lsize1(1), 1, MPI_INTEGER, MPI_SUM,          &
-                           sm_io%comm_shared, ierr )
-    ELSE
-       lsize1(1) = SUM( local_indices(2,:) )
-    ENDIF
-
-    IF ( sm_io%iam_io_pe )  THEN
-       IF ( total_number_of_surface_elements > 0 )  THEN
-           CALL MPI_TYPE_CREATE_SUBARRAY( 1, dims1, lsize1, start1, MPI_ORDER_FORTRAN, MPI_REAL,   &
-                                          ft_surf, ierr )
-           CALL MPI_TYPE_COMMIT( ft_surf, ierr )
-       ENDIF
-    ENDIF
-!
-!-- Allocate rma window to supply surface data to other PEs.
-    CALL rd_alloc_rma_mem( array_1d, SUM( nr_surface_elements_for_pe ), win_surf )
-!
-!-- Allocate shared array on IO-PE to supply data for MPI-IO (write or read).
-    IF ( sm_io%is_sm_active() )  THEN
-       IF ( sm_io%iam_io_pe )  THEN
-          io_start_index = start1(1) + 1
-          io_end_index   = start1(1) + lsize1(1)
-       ENDIF
-       CALL MPI_BCAST( io_start_index, 1, MPI_INTEGER, 0, sm_io%comm_shared, ierr )
-       CALL MPI_BCAST( io_end_index,   1, MPI_INTEGER, 0, sm_io%comm_shared, ierr )
-       CALL sm_io%sm_allocate_shared( array_out, io_start_index, io_end_index, win_out )
-    ELSE
-       ALLOCATE( array_out(start1(1)+1:start1(1)+lsize1(1)) )
-    ENDIF
-#else
-    IF ( total_number_of_surface_elements > 0  .AND.  .NOT. only_dummy_elements )  THEN
-        data_to_write = .TRUE.
-    ELSE
-        data_to_write = .FALSE.
-    ENDIF
-    ALLOCATE( array_out(1:total_number_of_surface_elements) )
-#endif
-
- CONTAINS
-
-    SUBROUTINE cyclic_fill_surface_filetype
-
-       INTEGER(iwp) ::  i  !<  loop index
-       INTEGER(iwp) ::  j  !<  loop index
-
-
-       IF ( .NOT. ALLOCATED( o_start_index ) )  ALLOCATE( o_start_index(nys:nyn,nxl:nxr) )
-       IF ( .NOT. ALLOCATED( o_end_index )   )  ALLOCATE( o_end_index(nys:nyn,nxl:nxr)   )
-
-       lo_start   = 1
-       DO  i = nxl, nxr
-           DO  j = nys, nyn
-               o_start_index(j,i) = lo_start
-               o_end_index(j,i)   = lo_start
-               lo_start           = lo_start + 1
-           ENDDO
-       ENDDO
-       start_index = o_start_index
-       end_index   = o_end_index
-
-       IF ( MAXVAL( global_end-global_start ) > 1 )  THEN
-          message_string = 'cylic-fill method does not allow more than one surface element ' //    &
-                           'per grid box'
-          CALL message( 'cyclic_fill_surface_filetype', 'PA0742', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Activate grid of the smaller prerun, i.e. grid variables like nxl, nxr, nys, nyn and others
-!--    are set according to the prerun layout.
-       CALL prerun_grid%activate_grid_from_this_class()
-
-       IF ( pe_active_for_read )  THEN
-
-          IF ( .NOT. ALLOCATED( c_global_start ) )  ALLOCATE( c_global_start(nys:nyn,nxl:nxr) )
-          IF ( .NOT. ALLOCATED( c_global_end )   )  ALLOCATE( c_global_end(nys:nyn,nxl:nxr)   )
-          IF ( .NOT. ALLOCATED( c_start_index )  )  ALLOCATE( c_start_index(nys:nyn,nxl:nxr)  )
-          IF ( .NOT. ALLOCATED( c_end_index )    )  ALLOCATE( c_end_index(nys:nyn,nxl:nxr)    )
-
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                c_global_start(j,i) = global_start(j,i)
-                c_global_end(j,i)   = global_end(j,i)
-             ENDDO
-          ENDDO
-!
-!--       Recursive call of rd_mpi_io_surface_filetypes.
-!--       Prerun data are read, but they are treated as if they are mainrun data, just on a smaller
-!--       grid.
-          cyclic_fill_mode = .FALSE.
-          CALL rd_mpi_io_surface_filetypes( c_start_index, c_end_index, data_to_write,             &
-                                            c_global_start, c_global_end )
-          cyclic_fill_mode = .TRUE.
-
-       ENDIF
-!
-!--    Activate grid of the mainrun, i.e. grid variables like nxl, nxr, nys, nyn and others
-!--    are set according to the mainrun layout.
-       CALL mainrun_grid%activate_grid_from_this_class()
-
-#if defined( __parallel )
-       CALL MPI_BCAST( data_to_write, 1, MPI_LOGICAL, 0, comm2d, ierr )
-#endif
-
-    END SUBROUTINE cyclic_fill_surface_filetype
-
-#if defined( __parallel )
-!
-!-- Get the indices of the surface elements inside the RMA window on the remote PE.
-!-- This information is required to fetch the surface element data on remote PEs
-!-- in rrd_mpi_io_surface and wrd_mpi_io_surface.
-    SUBROUTINE get_remote_indices
-
-       INTEGER(iwp) ::  buf_start  !<
-       INTEGER(iwp) ::  i          !<
-       INTEGER(iwp) ::  j          !<
-       INTEGER(iwp) ::  n          !<
-       INTEGER(iwp) ::  n_trans    !<
-       INTEGER(iwp) ::  win_ind    !<
-
-       INTEGER(KIND=MPI_ADDRESS_KIND) ::  disp     !< displacement in RMA window
-       INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !< size of RMA window
-
-       INTEGER(iwp), DIMENSION(0:numprocs-1) ::  lo_index         !<
-
-       INTEGER(iwp), POINTER, DIMENSION(:,:) ::  surf_val_index  !<
-
-
-       IF ( ALLOCATED( local_indices ) )  DEALLOCATE( local_indices )
-       ALLOCATE( local_indices(2,MAX( SUM( transfer_index(2,:) ), 2 )))
-
-       local_indices(1,:) = 0
-       local_indices(2,:) = 0
-
-       winsize = MAX( 2 * SUM( nr_gp_with_surfaces_for_pe ), 2 )
-
-       ALLOCATE( surf_val_index(2,winsize) )
-       winsize = winsize * iwp
-       CALL MPI_WIN_CREATE( surf_val_index, winsize, iwp, MPI_INFO_NULL, comm2d, win_ind, ierr )
-       CALL MPI_WIN_FENCE( 0, win_ind, ierr )
-
-       lo_index = s_index_in_tb
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             surf_val_index(1,lo_index(s_index_in_window(j,i))) = global_start(j,i)
-             surf_val_index(2,lo_index(s_index_in_window(j,i))) = global_end(j,i) -                &
-                                                                  global_start(j,i) + 1
-             lo_index(s_index_in_window(j,i)) = lo_index(s_index_in_window(j,i)) + 1
-          ENDDO
-       ENDDO
-
-       CALL MPI_WIN_FENCE( 0, win_ind, ierr )
-
-       buf_start = 1
-       DO  n = 0, numprocs-1
-          n_trans = transfer_index(2,n)
-          IF ( n_trans > 0 )  THEN
-             disp = 2 * ( transfer_index(1,n) - 1 )
-             CALL MPI_GET( local_indices(1,buf_start), 2*n_trans, MPI_INTEGER, n, disp, 2*n_trans, &
-                           MPI_INTEGER, win_ind, ierr )
-             buf_start = buf_start + n_trans
-          ENDIF
-       ENDDO
-
-       CALL MPI_WIN_FENCE( 0, win_ind, ierr )
-
-       buf_start = 1
-       DO  n = 0, numprocs-1
-          n_trans = transfer_index(2,n)
-          IF ( n_trans > 0 )  THEN
-             disp = transfer_index(1,n) - 1
-             buf_start = buf_start + n_trans
-          ENDIF
-       ENDDO
-
-       CALL MPI_WIN_FREE( win_ind, ierr )
-
-       DEALLOCATE( surf_val_index )
-
-    END SUBROUTINE get_remote_indices
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate memory and create window for one-sided communication (1-d INTEGER array)
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE rd_alloc_rma_mem( array, idim, win )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp), INTENT(IN)       ::  idim     !< Dimension of this 1-D array
-       INTEGER                        ::  ierr     !< MPI error code
-       INTEGER(iwp), INTENT(OUT)      ::  win      !< MPI window
-       INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !< size of RMA window
-
-       REAL(wp), DIMENSION(:), POINTER, INTENT(INOUT) ::  array  !< array to access RMA window locally
-
-
-       winsize = MAX( idim, 2 )
-       ALLOCATE( array(winsize) )
-       winsize = winsize * wp
-       CALL MPI_WIN_CREATE( array, winsize, wp, MPI_INFO_NULL, comm2d, win, ierr )
-       array = -1
-       CALL MPI_WIN_FENCE( 0, win, ierr )
-
-    END SUBROUTINE rd_alloc_rma_mem
-#endif
-
- END SUBROUTINE rd_mpi_io_surface_filetypes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine creates file types to access 2d-/3d-REAL arrays and 2d-INTEGER arrays
-!> distributed in blocks among processes to a single file that contains the global arrays.
-!--------------------------------------------------------------------------------------------------!
-  SUBROUTINE rd_mpi_io_create_filetypes
-
-    IMPLICIT NONE
-
-    INTEGER, DIMENSION(2) ::  dims2   !<
-    INTEGER, DIMENSION(2) ::  lize2   !<
-    INTEGER, DIMENSION(2) ::  start2  !<
-
-    INTEGER, DIMENSION(3) ::  dims3   !<
-    INTEGER, DIMENSION(3) ::  lize3   !<
-    INTEGER, DIMENSION(3) ::  start3  !<
-
-    TYPE(domain_decomposition_grid_features) ::  save_io_grid  !< temporary variable to store grid settings
-
-
-    IF ( sm_io%is_sm_active() )  THEN
-       save_io_grid = sm_io%io_grid
-    ENDIF
-
-    IF( .NOT. pe_active_for_read )  RETURN
-
-    IF ( cyclic_fill_mode )  CALL prerun_grid%activate_grid_from_this_class()
-
-!
-!-- Decision, if storage with or without ghost layers.
-!-- Please note that the indexing of the global array always starts at 0, even in Fortran.
-!-- Therefore the PE local indices have to be shifted by nbgp in the case with ghost layers.
-    IF ( include_total_domain_boundaries )  THEN
-
-       iog%nxl = nxl + nbgp
-       iog%nxr = nxr + nbgp
-       iog%nys = nys + nbgp
-       iog%nyn = nyn + nbgp
-       iog%nnx = nnx
-       iog%nny = nny
-       iog%nx  = nx + 2 * nbgp
-       iog%ny  = ny + 2 * nbgp
-       IF ( myidx == 0 )  THEN
-          iog%nxl = iog%nxl - nbgp
-          iog%nnx = iog%nnx + nbgp
-       ENDIF
-       IF ( myidx == pdims(1)-1 )  THEN
-          iog%nxr = iog%nxr + nbgp
-          iog%nnx = iog%nnx + nbgp
-       ENDIF
-       IF ( myidy == 0 )  THEN
-          iog%nys = iog%nys - nbgp
-          iog%nny = iog%nny + nbgp
-       ENDIF
-       IF ( myidy == pdims(2)-1 )  THEN
-          iog%nyn = iog%nyn + nbgp
-          iog%nny = iog%nny + nbgp
-       ENDIF
-
-       CALL sm_io%sm_adjust_outer_boundary()
-
-    ELSE
-
-       iog%nxl = nxl
-       iog%nxr = nxr
-       iog%nys = nys
-       iog%nyn = nyn
-       iog%nnx = nnx
-       iog%nny = nny
-       iog%nx  = nx
-       iog%ny  = ny
-
-    ENDIF
-
-    IF ( sm_io%is_sm_active() )  THEN
-#if defined( __parallel )
-       CALL sm_io%sm_allocate_shared( array_2d,  sm_io%io_grid%nxl, sm_io%io_grid%nxr,             &
-                                      sm_io%io_grid%nys, sm_io%io_grid%nyn, win_2dr )
-       CALL sm_io%sm_allocate_shared( array_2di, save_io_grid%nxl, save_io_grid%nxr,               &
-                                      save_io_grid%nys, save_io_grid%nyn, win_2di )
-       CALL sm_io%sm_allocate_shared( array_3d, nzb, nzt+1, sm_io%io_grid%nxl, sm_io%io_grid%nxr,  &
-                                      sm_io%io_grid%nys, sm_io%io_grid%nyn, win_3dr )
-       CALL sm_io%sm_allocate_shared( array_3di4, nzb, nzt+1, sm_io%io_grid%nxl, sm_io%io_grid%nxr,&
-                                      sm_io%io_grid%nys, sm_io%io_grid%nyn, win_3di4 )
-#endif
-    ELSE
-       ALLOCATE( array_2d(iog%nxl:iog%nxr,iog%nys:iog%nyn) )
-       ALLOCATE( array_2di(nxl:nxr,nys:nyn) )
-       ALLOCATE( array_3d(nzb:nzt+1,iog%nxl:iog%nxr,iog%nys:iog%nyn) )
-       ALLOCATE( array_3di4(nzb:nzt+1,iog%nxl:iog%nxr,iog%nys:iog%nyn) )
-       sm_io%io_grid = iog
-    ENDIF
-
-!
-!-- Create filetype for 2d-REAL array with ghost layers around the total domain
-    dims2(1)  = iog%nx + 1
-    dims2(2)  = iog%ny + 1
-
-    lize2(1)  = sm_io%io_grid%nnx
-    lize2(2)  = sm_io%io_grid%nny
-
-    start2(1) = sm_io%io_grid%nxl
-    start2(2) = sm_io%io_grid%nys
-
-#if defined( __parallel )
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_TYPE_CREATE_SUBARRAY( 2, dims2, lize2, start2, MPI_ORDER_FORTRAN, MPI_REAL,        &
-                                      ft_2d, ierr )
-       CALL MPI_TYPE_COMMIT( ft_2d, ierr )
-    ENDIF
-#endif
-!
-!-- Create filetype for 2d-INTEGER array without ghost layers around the total domain
-    dims2(1)  = nx + 1
-    dims2(2)  = ny + 1
-
-    IF ( sm_io%is_sm_active() )  THEN
-
-       lize2(1)  = save_io_grid%nnx
-       lize2(2)  = save_io_grid%nny
-
-       start2(1) = save_io_grid%nxl
-       start2(2) = save_io_grid%nys
-
-    ELSE
-
-       lize2(1)  = nnx
-       lize2(2)  = nny
-
-       start2(1) = nxl
-       start2(2) = nys
-
-    ENDIF
-
-#if defined( __parallel )
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_TYPE_CREATE_SUBARRAY( 2, dims2, lize2, start2, MPI_ORDER_FORTRAN, MPI_INTEGER,     &
-                                      ft_2di_nb, ierr )
-       CALL MPI_TYPE_COMMIT( ft_2di_nb, ierr )
-    ENDIF
-#endif
-!
-!-- Create filetype for 3d-REAL array
-    dims3(1)  = nz + 2
-    dims3(2)  = iog%nx + 1
-    dims3(3)  = iog%ny + 1
-
-    lize3(1)  = dims3(1)
-    lize3(2)  = sm_io%io_grid%nnx
-    lize3(3)  = sm_io%io_grid%nny
-
-    start3(1) = nzb
-    start3(2) = sm_io%io_grid%nxl
-    start3(3) = sm_io%io_grid%nys
-
-#if defined( __parallel )
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_REAL, ft_3d, &
-                                      ierr )
-       CALL MPI_TYPE_COMMIT( ft_3d, ierr )
-    ENDIF
-#endif
-
-    IF ( cyclic_fill_mode )  CALL mainrun_grid%activate_grid_from_this_class()
-
- END SUBROUTINE rd_mpi_io_create_filetypes
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine creates file types to access 3d-INTEGER*4 arrays and 3d-INTEGER*8 arrays
-!> distributed in blocks among processes to a single file that contains the global arrays.
-!> These types are only used for particle data.
-!--------------------------------------------------------------------------------------------------!
-  SUBROUTINE rd_mpi_io_particle_filetypes
-
-    IMPLICIT NONE
-
-    INTEGER, DIMENSION(3) ::  dims3   !<
-    INTEGER, DIMENSION(3) ::  lize3   !<
-    INTEGER, DIMENSION(3) ::  start3  !<
-
-    TYPE(domain_decomposition_grid_features) ::  save_io_grid  !< temporary variable to store grid settings
-
-!
-!-- MPI_INTEGER8 is not standard MPI, but is supported on most MPI distibutions
-!-- If not suppported, a workaround could be enabled with the following preprocessor directive
-!#if defined( __NO_INTEGER8)
-!    CALL MPI_TYPE_CONTIGUOUS( 2, MPI_INTEGER, MPI_INTEGER8, ierr )
-!    CALL MPI_TYPE_COMMIT( MPI_INTEGER8, ierr )
-!#endif
-
-    IF ( sm_io%is_sm_active() )  THEN
-       save_io_grid = sm_io%io_grid
-    ENDIF
-
-    IF( .NOT. pe_active_for_read )  RETURN
-
-!
-!-- Decision, if storage with or without ghost layers.
-!-- Please note that the indexing of the global array always starts at 0, even in Fortran.
-!-- Therefore the PE local indices have to be shifted by nbgp in the case with ghost layers.
-    IF ( include_total_domain_boundaries )  THEN
-
-       iog%nxl = nxl + nbgp
-       iog%nxr = nxr + nbgp
-       iog%nys = nys + nbgp
-       iog%nyn = nyn + nbgp
-       iog%nnx = nnx
-       iog%nny = nny
-       iog%nx  = nx + 2 * nbgp
-       iog%ny  = ny + 2 * nbgp
-       IF ( myidx == 0 )  THEN
-          iog%nxl = iog%nxl - nbgp
-          iog%nnx = iog%nnx + nbgp
-       ENDIF
-       IF ( myidx == pdims(1)-1 )  THEN
-          iog%nxr = iog%nxr + nbgp
-          iog%nnx = iog%nnx + nbgp
-       ENDIF
-       IF ( myidy == 0 )  THEN
-          iog%nys = iog%nys - nbgp
-          iog%nny = iog%nny + nbgp
-       ENDIF
-       IF ( myidy == pdims(2)-1 )  THEN
-          iog%nyn = iog%nyn + nbgp
-          iog%nny = iog%nny + nbgp
-       ENDIF
-
-       CALL sm_io%sm_adjust_outer_boundary()
-
-    ELSE
-
-       iog%nxl = nxl
-       iog%nxr = nxr
-       iog%nys = nys
-       iog%nyn = nyn
-       iog%nnx = nnx
-       iog%nny = nny
-       iog%nx  = nx
-       iog%ny  = ny
-
-    ENDIF
-
-    IF ( sm_io%is_sm_active() )  THEN
-#if defined( __parallel )
-       CALL sm_io%sm_allocate_shared( array_3di8, nzb, nzt+1, sm_io%io_grid%nxl, sm_io%io_grid%nxr,&
-                                      sm_io%io_grid%nys, sm_io%io_grid%nyn, win_3di8 )
-#endif
-    ELSE
-       ALLOCATE( array_3di8(nzb:nzt+1,iog%nxl:iog%nxr,iog%nys:iog%nyn) )
-
-       sm_io%io_grid = iog
-    ENDIF
-
-!
-!-- Create filetype for 3d INTEGER array
-    dims3(1)  = nz + 2
-    dims3(2)  = iog%nx + 1
-    dims3(3)  = iog%ny + 1
-
-    lize3(1)  = dims3(1)
-    lize3(2)  = sm_io%io_grid%nnx
-    lize3(3)  = sm_io%io_grid%nny
-
-    start3(1) = nzb
-    start3(2) = sm_io%io_grid%nxl
-    start3(3) = sm_io%io_grid%nys
-
-#if defined( __parallel )
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_INTEGER,     &
-                                      ft_3di4, ierr )
-       CALL MPI_TYPE_COMMIT( ft_3di4, ierr )
-
-       CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_INTEGER8,    &
-                                      ft_3di8, ierr )
-       CALL MPI_TYPE_COMMIT( ft_3di8, ierr )
-    ENDIF
-#endif
-
- END SUBROUTINE rd_mpi_io_particle_filetypes
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine creates file types to access 3d-soil arrays distributed in blocks among processes
-!> to a single file that contains the global arrays. It is not required for the serial mode.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN)   ::  nzb_soil  !<
-    INTEGER, INTENT(IN)   ::  nzt_soil  !<
-
-#if defined( __parallel )
-    INTEGER, DIMENSION(3) ::  dims3     !<
-    INTEGER, DIMENSION(3) ::  lize3     !<
-    INTEGER, DIMENSION(3) ::  start3    !<
-
-
-    IF ( sm_io%is_sm_active() )  THEN
-       CALL sm_io%sm_allocate_shared( array_3d_soil, nzb_soil, nzt_soil, sm_io%io_grid%nxl,        &
-                                      sm_io%io_grid%nxr, sm_io%io_grid%nys, sm_io%io_grid%nyn,     &
-                                      win_3ds )
-    ELSE
-       ALLOCATE( array_3d_soil(nzb_soil:nzt_soil,iog%nxl:iog%nxr,iog%nys:iog%nyn) )
-       sm_io%io_grid = iog
-    ENDIF
-
-!
-!-- Create filetype for 3d-soil array
-    dims3(1)  = nzt_soil - nzb_soil + 1
-    dims3(2)  = iog%nx + 1
-    dims3(3)  = iog%ny + 1
-
-    lize3(1)  = dims3(1)
-    lize3(2)  = sm_io%io_grid%nnx
-    lize3(3)  = sm_io%io_grid%nny
-
-    start3(1) = nzb_soil
-    start3(2) = sm_io%io_grid%nxl
-    start3(3) = sm_io%io_grid%nys
-
-    IF ( sm_io%iam_io_pe )  THEN
-       CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_REAL,        &
-                                      ft_3dsoil, ierr )
-       CALL MPI_TYPE_COMMIT( ft_3dsoil, ierr )
-    ENDIF
-#else
-    ALLOCATE( array_3d_soil(nzb_soil:nzt_soil,iog%nxl:iog%nxr,iog%nys:iog%nyn) )
-    sm_io%io_grid = iog
-#endif
-
- END SUBROUTINE rd_mpi_io_create_filetypes_3dsoil
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Free all file types that have been created for MPI-IO.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rd_mpi_io_free_filetypes
-
-    IMPLICIT NONE
-
-#if defined( __parallel )
-    IF ( filetypes_created )  THEN
-
-       IF ( sm_io%iam_io_pe )  THEN
-          CALL MPI_TYPE_FREE( ft_2d, ierr )
-          CALL MPI_TYPE_FREE( ft_2di_nb, ierr )
-          CALL MPI_TYPE_FREE( ft_3d, ierr )
-       ENDIF
-
-       IF ( sm_io%is_sm_active() )  THEN
-          CALL sm_io%sm_free_shared( win_2dr )
-          CALL sm_io%sm_free_shared( win_2di )
-          CALL sm_io%sm_free_shared( win_3dr )
-       ELSE
-          DEALLOCATE( array_2d, array_2di, array_3d )
-       ENDIF
-
-    ENDIF
-
-!
-!-- Free last surface filetype
-    IF ( sm_io%iam_io_pe .AND. ft_surf /= -1 )  THEN
-       CALL MPI_TYPE_FREE( ft_surf, ierr )
-    ENDIF
-
-    IF ( sm_io%is_sm_active() .AND.  win_surf /= -1 )  THEN
-       CALL sm_io%sm_free_shared( win_surf )
-    ENDIF
-
-!
-!-- Free last particle filetypes
-    IF ( sm_io%iam_io_pe .AND. ft_3di4 /= -1 )  THEN
-       CALL MPI_TYPE_FREE( ft_3di4, ierr )
-       ft_3di4 = -1
-    ENDIF
-    IF ( sm_io%iam_io_pe .AND. ft_3di8 /= -1 )  THEN
-       CALL MPI_TYPE_FREE( ft_3di8, ierr )
-       ft_3di8 = -1
-    ENDIF
-
-    IF ( sm_io%is_sm_active() .AND.  win_3di4 /= -1 )  THEN
-       CALL sm_io%sm_free_shared( win_3di4 )
-       win_3di4 = -1
-    ENDIF
-    IF ( sm_io%is_sm_active() .AND.  win_3di8 /= -1 )  THEN
-       CALL sm_io%sm_free_shared( win_3di8 )
-       win_3di8 = -1
-    ENDIF
-
-    IF ( win_start /= -1 )  THEN
-       CALL sm_io%sm_free_shared( win_start)
-       CALL sm_io%sm_free_shared( win_end)
-       CALL sm_io%sm_free_shared( win_glost)
-       win_start = -1
-       win_end   = -1
-       win_glost = -1
-    ENDIF
-
-    ft_surf  = -1
-    win_surf = -1
-#else
-    IF ( ASSOCIATED( array_2d )   )  DEALLOCATE( array_2d )
-    IF ( ASSOCIATED( array_2di )  )  DEALLOCATE( array_2di )
-    IF ( ASSOCIATED( array_3d )   )  DEALLOCATE( array_3d )
-    IF ( ASSOCIATED( array_3di4 ) )  DEALLOCATE( array_3di4 )
-    IF ( ASSOCIATED( array_3di8 ) )  DEALLOCATE( array_3di8 )
-#endif
-
- END SUBROUTINE rd_mpi_io_free_filetypes
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Print the restart data file header (MPI-IO format) for debugging.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rd_mpi_io_print_header
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-
-
-    WRITE (9,*)  'header position after reading the restart file header: ', header_position
-    WRITE (9,*)  ' '
-    WRITE (9,*)  'restart file header content:'
-    WRITE (9,*)  '----------------------------'
-    WRITE (9,*)  ' '
-
-    WRITE (9,*)  ' CHARACTER header values   Total number: ', tgh%nr_char
-    WRITE (9,*)  ' '
-    DO  i = 1, tgh%nr_char
-       WRITE( 9, '(I3,A,1X,A)' )  i, ': ', text_lines(i)(1:80)
-    ENDDO
-    WRITE (9,*)  ' '
-
-    WRITE (9,*) ' INTEGER header variables and values   Total number: ', tgh%nr_int
-    WRITE (9,*)  ' '
-    DO  i = 1, tgh%nr_int
-       WRITE(9,*)  ' variable: ', int_names(i), '  value: ', int_values(i)
-    ENDDO
-    WRITE (9,*)  ' '
-
-    WRITE (9,*)  ' REAL header variables and values   Total number: ', tgh%nr_real
-    WRITE (9,*)  ' '
-    DO  i = 1, tgh%nr_real
-       WRITE(9,*)  ' variable: ', real_names(i), '  value: ', real_values(i)
-    ENDDO
-    WRITE (9,*)  ' '
-
-    WRITE (9,*)  ' Header entries with offset (2d/3d arrays)   Total number: ', tgh%nr_arrays
-    WRITE (9,*)  ' '
-    DO  i = 1, tgh%nr_arrays
-       WRITE(9,*)  ' variable: ', array_names(i), '  offset: ', array_offset(i)
-    ENDDO
-    WRITE (9,*)  ' '
-
- END SUBROUTINE rd_mpi_io_print_header
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check if big/little endian data format is used.
-!> An int*4 pointer is set to a int*8 variable, the int*8 is set to 1, and then it is checked, if
-!> the first 4 bytes of the pointer are equal 1 (little endian) or not.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rd_mpi_io_check_endian( i_endian )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(out)                   ::  i_endian  !<
-    INTEGER(KIND=8), TARGET                ::  int8      !<
-
-    INTEGER, DIMENSION(1)                  ::  bufshape  !<
-    INTEGER(KIND=4), POINTER, DIMENSION(:) ::  int4      !<
-
-    TYPE(C_PTR)                            ::  ptr       !<
-
-
-    ptr = C_LOC( int8 )
-    bufshape(1) = 2
-    CALL C_F_POINTER( ptr, int4, bufshape )
-
-    int8 = 1
-
-    IF ( int4(1) == 1 )  THEN
-       i_endian = 1    ! Little endian
-    ELSE
-       i_endian = 2    ! Big endian
-    ENDIF
-
- END SUBROUTINE rd_mpi_io_check_endian
-
- END MODULE restart_data_mpi_io_mod
Index: palm/trunk/SOURCE/run_control.f90
===================================================================
--- palm/trunk/SOURCE/run_control.f90	(revision 4901)
+++ palm/trunk/SOURCE/run_control.f90	(revision 1)
@@ -1,36 +1,70 @@
-!> @file run_control.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ SUBROUTINE run_control
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
+! $Log: run_control.f90,v $
+! Revision 1.20  2006/06/02 15:23:47  raasch
+! cpp-directives extended for lctit
 !
+! Revision 1.19  2006/02/23 12:54:21  raasch
+! Output buffer is flushed also on NEC, nt_anz renamed current_timestep_number
 !
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
+! Revision 1.18  2004/01/30 10:38:26  raasch
+! Euler-step information removed in case of Runge-Kutta
 !
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
+! Revision 1.17  2003/10/29 09:13:18  raasch
+! Data are forced to be immediately written on disc on IBM and Linux clusters
+!
+! Revision 1.16  2003/04/16 13:12:39  raasch
+! Output format of iteration count enlarged
+!
+! Revision 1.15  2001/07/20 13:13:45  raasch
+! Additional output of the number of multigrid cycles used
+!
+! Revision 1.14  2001/03/30 07:52:24  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.13  2001/01/22 08:04:54  raasch
+! Module test_variables removed
+!
+! Revision 1.12  2001/01/03 13:46:12  letzel
+! File output and all comments translated into English.
+!
+! Revision 1.11  1998/09/22 17:29:49  raasch
+! Ausgabeformate t.w. um einige Kommastellen erweitert
+!
+! Revision 1.10  1998/07/06 12:32:56  raasch
+! + USE test_variables
+!
+! Revision 1.9  1998/04/21 16:23:48  raasch
+! Ausgabe von advected_distance
+!
+! Revision 1.8  1998/03/30 11:50:16  raasch
+! Divergenzen stehen jetzt in hom
+!
+! Revision 1.7  1998/03/25 13:57:06  raasch
+! Erweiterungen fuer Gebietsstatistiken,
+! dt in dt_3d umbenannt
+!
+! Revision 1.6  1998/03/18 20:19:50  raasch
+! Pruefen, ob Einheit 15 bereits geoeffnet ist
+!
+! Revision 1.5  1998/03/03 08:01:49  raasch
+! Aufruf von flow_statistics erfolgt jetzt gegebenenfalls hier,
+! Ausgabe von w* und z_i
+!
+! Revision 1.4  1998/02/04 16:10:46  raasch
+! e_total und e_pertu stehen jetzt im Feld hom
+!
+! Revision 1.3  1998/01/23 10:08:01  raasch
+! Ausgabe von u* und theta*
+!
+! Revision 1.2  1997/08/26 06:34:36  raasch
+! Schoenheitskorrekturen
 !
 ! Revision 1.1  1997/08/11 06:25:38  raasch
@@ -40,47 +74,17 @@
 ! Description:
 ! ------------
-!> Computation and output of run-control quantities
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE run_control
+! Computation and output of run-control quantities
+!------------------------------------------------------------------------------!
 
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point
-
-    USE control_parameters,                                                                        &
-        ONLY:  advected_distance_x,                                                                &
-               advected_distance_y,                                                                &
-               current_timestep_number,                                                            &
-               disturbance_created,                                                                &
-               dt_3d,                                                                              &
-               mgcycles,                                                                           &
-               run_control_header,                                                                 &
-               runnr,                                                                              &
-               simulated_time,                                                                     &
-               simulated_time_chr,                                                                 &
-               timestep_reason
-
-    USE indices,                                                                                   &
-        ONLY:  nzb
-
-    USE kinds
-
+    USE cpulog
+    USE indices
+    USE interfaces
     USE pegrid
-
-    USE statistics,                                                                                &
-        ONLY:  flow_statistics_called,                                                             &
-               hom,                                                                                &
-               pr_palm,                                                                            &
-               u_max,                                                                              &
-               u_max_ijk,                                                                          &
-               v_max,                                                                              &
-               v_max_ijk,                                                                          &
-               w_max,                                                                              &
-               w_max_ijk
+    USE statistics
+    USE control_parameters
 
     IMPLICIT NONE
 
-    CHARACTER (LEN=1) ::  disturb_chr  !<
+    CHARACTER (LEN=1) ::  change_chr, disturb_chr
 
 !
@@ -97,5 +101,6 @@
 
 !
-!--    Check, whether file unit is already open (may have been opened in header before)
+!--    Check, whether file unit is already open (may have been opened in header
+!--    before)
        CALL check_open( 15 )
 
@@ -108,4 +113,17 @@
 
 !
+!--    Output the the beginning of the run receives no information about an
+!--    Euler-timestep
+       IF ( dt_changed  .AND.  simulated_time /= 0.0  .AND. &
+            timestep_scheme(1:5) /= 'runge' )  THEN
+          IF ( timestep_scheme == 'leapfrog' )  THEN
+             change_chr = 'L'
+          ELSE
+             change_chr = 'E'
+          ENDIF
+       ELSE
+          change_chr = ' '
+       ENDIF
+!
 !--    If required, set disturbance flag
        IF ( disturbance_created )  THEN
@@ -114,19 +132,25 @@
           disturb_chr = ' '
        ENDIF
-       WRITE ( 15, 101 )  runnr, current_timestep_number, simulated_time_chr,                      &
-                          INT( ( simulated_time-INT( simulated_time ) ) * 100),                    &
-                          dt_3d, timestep_reason, u_max, disturb_chr, v_max, disturb_chr, w_max,   &
-                          hom(nzb,1,pr_palm,0), hom(nzb+8,1,pr_palm,0), hom(nzb+3,1,pr_palm,0),    &
-                          hom(nzb+6,1,pr_palm,0), hom(nzb+4,1,pr_palm,0), hom(nzb+5,1,pr_palm,0),  &
-                          hom(nzb+9,1,pr_palm,0), hom(nzb+10,1,pr_palm,0), u_max_ijk(1:3),         &
-                          v_max_ijk(1:3), w_max_ijk(1:3), advected_distance_x/1000.0_wp,           &
-                          advected_distance_y/1000.0_wp, mgcycles
+       WRITE ( 15, 101 )  runnr, current_timestep_number, simulated_time_chr,  &
+                          simulated_time-INT( simulated_time ), dt_3d,         &
+                          timestep_reason, change_chr, u_max, disturb_chr,     &
+                          v_max, disturb_chr, w_max, hom(nzb,1,var_hom,0),     &
+                          hom(nzb+8,1,var_hom,0), hom(nzb+3,1,var_hom,0),      &
+                          hom(nzb+6,1,var_hom,0), hom(nzb+4,1,var_hom,0),      &
+                          hom(nzb+5,1,var_hom,0), hom(nzb+9,1,var_hom,0),      &
+                          hom(nzb+10,1,var_hom,0), u_max_ijk(1:3),             &
+                          v_max_ijk(1:3), w_max_ijk(1:3),                      &
+                          advected_distance_x/1000.0,                          &
+                          advected_distance_y/1000.0, mgcycles
+#if defined( __ibm )
 !
 !--    Write buffer contents to disc immediately
-       FLUSH( 15 )
-
+       CALL FLUSH_( 15 )
+#elif defined( __lcmuk )  ||  defined( __lctit )  ||  defined( __nec )
+       CALL FLUSH( 15 )
+#endif
     ENDIF
 !
-!-- If required, reset disturbance flag. This has to be done outside the above
+!-- If required, reset disturbance flag. This has to be done outside the above 
 !-- IF-loop, because the flag would otherwise only be reset on PE0
     IF ( disturbance_created )  disturbance_created = .FALSE.
@@ -138,14 +162,15 @@
 100 FORMAT (///'Run-control output:'/ &
               &'------------------'// &
-          &'RUN  ITER. HH:MM:SS.SS    DT(E)     UMAX     VMAX     WMAX     U', &
-          &'*    W*      THETA*     Z_I     ENERG.   DISTENERG    DIVOLD    ', &
-          &' DIVNEW     UMAX(KJI)    VMAX(KJI)    WMAX(KJI)   ADVECX   ADVEC', &
-          &'Y   MGCYC'/                                                        &
-          &'----------------------------------------------------------------', &
-          &'----------------------------------------------------------------', &
-          &'----------------------------------------------------------------', &
-          &'---------')
-101 FORMAT (I3,1X,I6,1X,A8,'.',I2.2,1X,F8.4,A1,1X,F8.4,A1,F8.4,A1,F8.4,1X, F6.3,1X,F5.2,           &
-            2X,E10.3,2X,F6.0,1X,4(E10.3,1X),3(3(I4),1X),F8.3,1X,F8.3,5X,I3)
+           &'RUN  ITER. HH:MM:SS.SS   DT(E)     UMAX     VMAX     WMAX     U*', &
+           &'    W*   THETA*   Z_I     ENERG.   DISTENERG    DIVOLD     DIVNE', &
+           &'W     UMAX(KJI)    VMAX(KJI)    WMAX(KJI)   ADVECX   ADVECY   MG', &
+           &'CYC'/ &
+           &'----------------------------------------------------------------', &
+           &'----------------------------------------------------------------', &
+           &'----------------------------------------------------------------', &
+           &'--')
+101 FORMAT (I3,1X,I6,1X,A8,F3.2,1X,F7.4,A1,A1,F8.4,A1,F8.4,A1,F8.4,2X,F5.3,2X, &
+            F4.2, &
+            2X,F6.3,2X,F5.0,1X,4(E10.3,1X),3(3(I4),1X),F8.3,1X,F8.3,5X,I3)
 
  END SUBROUTINE run_control
Index: palm/trunk/SOURCE/salsa_mod.f90
===================================================================
--- palm/trunk/SOURCE/salsa_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,14198 +1,0 @@
-!> @file salsa_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM-4U.
-!
-! PALM-4U 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-4U 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 2018-2021 University of Helsinki
-! Copyright 1997-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Remove offset in terrain-following masked output
-!
-! 4873 2021-02-12 17:12:17Z monakurppa
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Bugfix in obtaining the correct timestamp in case of restart runs
-!
-! 4785 2020-11-15 20:11:14Z monakurppa
-! Fixing a segmentation fault in initialising aerosol and gas emissions
-!
-! 4768 2020-11-02 19:11:23Z suehring
-! Enable 3D data output also with 64-bit precision
-!
-! 4731 2020-10-07 13:25:11Z schwenkel
-! Move exchange_horiz from time_integration to modules
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4527 2020-05-11 09:39:55Z monakurppa
-! Correct a bug in salsa_wrd_global and salsa_check_data_output,
-! and add reglim to be read/written in the restart data
-!
-! 4525 2020-05-10 17:05:07Z raasch
-! added reading/writing of global restart data,
-! added reading/writing restart data with MPI-IO,
-! variable write_binary_salsa removed
-!
-! 4512 2020-04-30 12:55:34Z monakurppa
-! Fixed a bug in component_index_constructor: index out of bounds if all chemical
-! components are used
-!
-! 4508 2020-04-24 13:32:20Z raasch
-! decycling replaced by explicit setting of lateral boundary conditions (Siggi)
-!
-! 4487 2020-04-03 09:38:20Z raasch
-! bugfix for subroutine calls that contain the decycle_salsa switches as arguments
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! Bug fix to the previous commit: the logical switch monotonic_limiter_z missing
-! from advec_s_ws in salsa_tendency_ij
-!
-! 4478 2020-03-27 14:06:23Z monakurppa
-! Bug fixes:
-! - call salsa_driver in salsa_init also for the ghost points
-! - decycle flags missing from advec_s_ws call in salsa_tendency
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4442 2020-03-04 19:21:13Z suehring
-! Change order of dimension in surface array %frac to allow for better
-! vectorization.
-!
-! 4441 2020-03-04 19:20:35Z suehring
-! Bug fixes and reformatting for the restart data and averaged data output
-! - add missing arrays (averaged data output) in salsa_wrd_local and
-!   salsa_rrd_local
-! - set write_binary_salsa and read_restart_data_salsa to .T. by default
-! - restructure the average arrays for gases and total mass concentrations of
-!   chemical components: set to 4d arrays instead of separate arrays
-! - add allocation checks for averaged data output arrays
-!
-! 4416 2020-02-20 17:53:57Z monakurppa
-! Time index error in salsa_emission_setup
-!
-! 4380 2020-01-17 23:39:51Z monakurppa
-! - Error in saving the surface fluxes in an array that is applied in the
-!   deposition scheme
-! - Corrections in the header: aerosol bin diameters and lower bin limits not
-!   printed correctly
-!
-! 4364 2020-01-08 02:12:31Z monakurppa
-! Set time coordinate in the input data relative to origin_time rather than to
-! 00:00:00 UTC
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static
-! topography information used in wall_flags_static_0
-!
-! 4342 2019-12-16 13:49:14Z Giersch
-! cdc replaced by canopy_drag_coeff
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4315 2019-12-02 09:20:07Z monakurppa
-! Add an additional check for the time dimension PIDS_SALSA in
-! salsa_emission_setup and correct some error message identifiers.
-!
-! 4298 2019-11-21 15:59:16Z suehring
-! Bugfix, close netcdf input files after reading
-!
-! 4295 2019-11-14 06:15:31Z monakurppa
-!
-!
-! 4280 2019-10-29 14:34:15Z monakurppa
-! Corrected a bug in boundary conditions and fac_dt in offline nesting
-!
-! 4273 2019-10-24 13:40:54Z monakurppa
-! - Rename nest_salsa to nesting_salsa
-! - Correct some errors in boundary condition flags
-! - Add a check for not trying to output gas concentrations in salsa if the
-!   chemistry module is applied
-! - Set the default value of nesting_salsa and nesting_offline_salsa to .TRUE.
-!
-! 4272 2019-10-23 15:18:57Z schwenkel
-! Further modularization of boundary conditions: moved boundary conditions to
-! respective modules
-!
-! 4270 2019-10-23 10:46:20Z monakurppa
-! - Implement offline nesting for salsa
-! - Alphabetic ordering for module interfaces
-! - Remove init_aerosol_type and init_gases_type from salsa_parin and define them
-!   based on the initializing_actions
-! - parameter definition removed from "season" and "season_z01" is added to parin
-! - bugfix in application of index_hh after implementing the new
-!   palm_date_time_mod
-! - Reformat salsa emission data with LOD=2: size distribution given for each
-!   emission category
-!
-! 4268 2019-10-17 11:29:38Z schwenkel
-! Moving module specific boundary conditions from time_integration to module
-!
-! 4256 2019-10-07 10:08:52Z monakurppa
-! Document previous changes: use global variables nx, ny and nz in salsa_header
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod
-!
-! 4226 2019-09-10 17:03:24Z suehring
-! Netcdf input routine for dimension length renamed
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4167 2019-08-16 11:01:48Z suehring
-! Changed behaviour of masked output over surface to follow terrain and ignore
-! buildings (J.Resler, T.Gronemeier)
-!
-! 4131 2019-08-02 11:06:18Z monakurppa
-! - Add "salsa_" before each salsa output variable
-! - Add a possibility to output the number (salsa_N_UFP) and mass concentration
-!   (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller
-!   than 100 nm
-! - Implement aerosol emission mode "parameterized" which is based on the street
-!   type (similar to the chemistry module).
-! - Remove unnecessary nucleation subroutines.
-! - Add the z-dimension for gaseous emissions to correspond the implementation
-!   in the chemistry module
-!
-! 4118 2019-07-25 16:11:45Z suehring
-! - When Dirichlet condition is applied in decycling, the boundary conditions are
-!   only set at the ghost points and not at the prognostic grid points as done
-!   before
-! - Rename decycle_ns/lr to decycle_salsa_ns/lr and decycle_method to
-!   decycle_method_salsa
-! - Allocation and initialization of special advection flags salsa_advc_flags_s
-!   used for salsa. These are exclusively used for salsa variables to
-!   distinguish from the usually-used flags which might be different when
-!   decycling is applied in combination with cyclic boundary conditions.
-!   Moreover, salsa_advc_flags_s considers extended zones around buildings where
-!   the first-order upwind scheme is applied for the horizontal advection terms.
-!   This is done to overcome high concentration peaks due to stationary numerical
-!   oscillations caused by horizontal advection discretization.
-!
-! 4117 2019-07-25 08:54:02Z monakurppa
-! Pass integer flag array as well as boundary flags to WS scalar advection
-! routine
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! Slightly revise setting of boundary conditions at horizontal walls, use
-! data-structure offset index instead of pre-calculate it for each facing
-!
-! 4079 2019-07-09 18:04:41Z suehring
-! Application of monotonic flux limiter for the vertical scalar advection
-! up to the topography top (only for the cache-optimized version at the
-! moment).
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to
-! avoid runtime error (Loop variable has been modified) in time_integration
-!
-! 4058 2019-06-27 15:25:42Z knoop
-! Bugfix: to_be_resorted was uninitialized in case of s_H2O in 3d_data_averaging
-!
-! 4012 2019-05-31 15:19:05Z monakurppa
-! Merge salsa branch to trunk. List of changes:
-! - Error corrected in distr_update that resulted in the aerosol number size
-!   distribution not converging if the concentration was nclim.
-! - Added a separate output for aerosol liquid water (s_H2O)
-! - aerosol processes for a size bin are now calculated only if the aerosol
-!   number of concentration of that bin is > 2*nclim
-! - An initialisation error in the subroutine "deposition" corrected and the
-!   subroutine reformatted.
-! - stuff from salsa_util_mod.f90 moved into salsa_mod.f90
-! - calls for closing the netcdf input files added
-!
-! 3956 2019-05-07 12:32:52Z monakurppa
-! - Conceptual bug in depo_surf correct for urban and land surface model
-! - Subroutine salsa_tendency_ij optimized.
-! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds
-!   created. These are now called in module_interface.
-!   salsa_exchange_horiz_bounds after calling salsa_driver only when needed
-!   (i.e. every dt_salsa).
-!
-! 3924 2019-04-23 09:33:06Z monakurppa
-! Correct a bug introduced by the previous update.
-!
-! 3899 2019-04-16 14:05:27Z monakurppa
-! - remove unnecessary error / location messages
-! - corrected some error message numbers
-! - allocate source arrays only if emissions or dry deposition is applied.
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction
-! of additional debug messages
-!
-! 3876 2019-04-08 18:41:49Z knoop
-! Introduced salsa_actions module interface
-!
-! 3871 2019-04-08 14:38:39Z knoop
-! Major changes in formatting, performance and data input structure (see branch
-! the history for details)
-! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are
-!   normalised depending on the time, and lod=2 for preprocessed emissions
-!   (similar to the chemistry module).
-! - Additionally, 'uniform' emissions allowed. This emission is set constant on
-!   all horisontal upward facing surfaces and it is created based on parameters
-!   surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
-! - All emissions are now implemented as surface fluxes! No 3D sources anymore.
-! - Update the emission information by calling salsa_emission_update if
-!   skip_time_do_salsa >= time_since_reference_point and
-!   next_aero_emission_update <= time_since_reference_point
-! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid
-!   must match the one applied in the model.
-! - Gas emissions and background concentrations can be also read in in salsa_mod
-!   if the chemistry module is not applied.
-! - In deposition, information on the land use type can be now imported from
-!   the land use model
-! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
-! - Apply 100 character line limit
-! - Change all variable names from capital to lowercase letter
-! - Change real exponents to integer if possible. If not, precalculate the value
-!   value of exponent
-! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
-! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast -->
-!   ngases_salsa
-! - Rename ibc to index_bc, idu to index_du etc.
-! - Renamed loop indices b, c and sg to ib, ic and ig
-! - run_salsa subroutine removed
-! - Corrected a bud in salsa_driver: falsely applied ino instead of inh
-! - Call salsa_tendency within salsa_prognostic_equations which is called in
-!   module_interface_mod instead of prognostic_equations_mod
-! - Removed tailing white spaces and unused variables
-! - Change error message to start by PA instead of SA
-!
-! 3833 2019-03-28 15:04:04Z forkel
-! added USE chem_gasphase_mod for nvar, nspec and spc_names
-!
-! 3787 2019-03-07 08:43:54Z raasch
-! unused variables removed
-!
-! 3780 2019-03-05 11:19:45Z forkel
-! unused variable for file index removed from rrd-subroutines parameter list
-!
-! 3685 2019-01-21 01:02:11Z knoop
-! Some interface calls moved to module_interface + cleanup
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Implementation of the PALM module interface
-! 3412 2018-10-24 07:25:57Z monakurppa
-!
-! Authors:
-! --------
-! @author Mona Kurppa (University of Helsinki)
-!
-!
-! Description:
-! ------------
-!> Sectional aerosol module for large scale applications SALSA
-!> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass
-!> concentration as well as chemical composition. Includes aerosol dynamic
-!> processes: nucleation, condensation/evaporation of vapours, coagulation and
-!> deposition on tree leaves, ground and roofs.
-!> Implementation is based on formulations implemented in UCLALES-SALSA except
-!> for deposition which is based on parametrisations by Zhang et al. (2001,
-!> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3,
-!> 753-769)
-!>
-!> @todo Apply information from emission_stack_height to lift emission sources
-!> @todo Allow insoluble emissions
-!------------------------------------------------------------------------------!
- MODULE salsa_mod
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  c_p, g, p_0, pi, r_d
-
-    USE chem_gasphase_mod,                                                                         &
-        ONLY:  nspec, nvar, spc_names
-
-    USE chem_modules,                                                                              &
-        ONLY:  call_chem_at_all_substeps, chem_gasphase_on, chem_species
-
-    USE control_parameters,                                                                        &
-        ONLY:  air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,      &
-               bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, bc_radiation_l, bc_radiation_n, bc_radiation_r, &
-               bc_radiation_s, coupling_char, debug_output, dt_3d,                                 &
-               initializing_actions,                                                               &
-               intermediate_timestep_count,                                                        &
-               intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string,        &
-               monotonic_limiter_z, plant_canopy, pt_surface, restart_data_format_output, salsa,   &
-               scalar_advec, surface_pressure, time_since_reference_point, timestep_scheme, tsc,   &
-               urban_surface, ws_scheme_sca
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nz, nzt,             &
-               wall_flags_total_0
-
-    USE kinds
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  chem_emis_att_type, chem_emis_val_type
-
-    USE pegrid
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_check_array, rrd_mpi_io, rrd_mpi_io_global_array, wrd_mpi_io,             &
-               wrd_mpi_io_global_array
-
-    USE statistics,                                                                                &
-        ONLY:  sums_salsa_ws_l
-
-    IMPLICIT NONE
-!
-!-- SALSA constants:
-!
-!-- Local constants:
-    INTEGER(iwp), PARAMETER ::  luc_urban = 15     !< default landuse type for urban
-    INTEGER(iwp), PARAMETER ::  ngases_salsa  = 5  !< total number of gaseous tracers:
-                                                   !< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV
-                                                   !< (non-volatile OC), 5 = OCSV (semi-volatile)
-    INTEGER(iwp), PARAMETER ::  nmod = 7     !< number of modes for initialising the aerosol size distribution
-    INTEGER(iwp), PARAMETER ::  nreg = 2     !< Number of main size subranges
-    INTEGER(iwp), PARAMETER ::  maxspec = 7  !< Max. number of aerosol species
-
-
-    REAL(wp), PARAMETER ::  fill_value = -9999.0_wp    !< value for the _FillValue attribute
-!
-!-- Universal constants
-    REAL(wp), PARAMETER ::  abo    = 1.380662E-23_wp   !< Boltzmann constant (J/K)
-    REAL(wp), PARAMETER ::  alv    = 2.260E+6_wp       !< latent heat for H2O vaporisation (J/kg)
-    REAL(wp), PARAMETER ::  alv_d_rv  = 4896.96865_wp  !< alv / rv
-    REAL(wp), PARAMETER ::  am_airmol = 4.8096E-26_wp  !< Average mass of an air molecule (Jacobson 2005, Eq.2.3)
-    REAL(wp), PARAMETER ::  api6   = 0.5235988_wp      !< pi / 6
-    REAL(wp), PARAMETER ::  argas  = 8.314409_wp       !< Gas constant (J/(mol K))
-    REAL(wp), PARAMETER ::  argas_d_cpd = 8.281283865E-3_wp  !< argas per cpd
-    REAL(wp), PARAMETER ::  avo    = 6.02214E+23_wp    !< Avogadro constant (1/mol)
-    REAL(wp), PARAMETER ::  d_sa   = 5.539376964394570E-10_wp  !< diameter of condensing H2SO4 molecule (m)
-    REAL(wp), PARAMETER ::  for_ppm_to_nconc =  7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3))
-    REAL(wp), PARAMETER ::  epsoc  = 0.15_wp          !< water uptake of organic material
-    REAL(wp), PARAMETER ::  mclim  = 1.0E-23_wp       !< mass concentration min limit (kg/m3)
-    REAL(wp), PARAMETER ::  n3     = 158.79_wp        !< Number of H2SO4 molecules in 3 nm cluster if d_sa=5.54e-10m
-    REAL(wp), PARAMETER ::  nclim  = 1.0_wp           !< number concentration min limit (#/m3)
-    REAL(wp), PARAMETER ::  surfw0 = 0.073_wp         !< surface tension of water at 293 K (J/m2)
-!
-!-- Molar masses in kg/mol
-    REAL(wp), PARAMETER ::  ambc     = 12.0E-3_wp     !< black carbon (BC)
-    REAL(wp), PARAMETER ::  amdair   = 28.970E-3_wp   !< dry air
-    REAL(wp), PARAMETER ::  amdu     = 100.0E-3_wp    !< mineral dust
-    REAL(wp), PARAMETER ::  amh2o    = 18.0154E-3_wp  !< H2O
-    REAL(wp), PARAMETER ::  amh2so4  = 98.06E-3_wp    !< H2SO4
-    REAL(wp), PARAMETER ::  amhno3   = 63.01E-3_wp    !< HNO3
-    REAL(wp), PARAMETER ::  amn2o    = 44.013E-3_wp   !< N2O
-    REAL(wp), PARAMETER ::  amnh3    = 17.031E-3_wp   !< NH3
-    REAL(wp), PARAMETER ::  amo2     = 31.9988E-3_wp  !< O2
-    REAL(wp), PARAMETER ::  amo3     = 47.998E-3_wp   !< O3
-    REAL(wp), PARAMETER ::  amoc     = 150.0E-3_wp    !< organic carbon (OC)
-    REAL(wp), PARAMETER ::  amss     = 58.44E-3_wp    !< sea salt (NaCl)
-!
-!-- Densities in kg/m3
-    REAL(wp), PARAMETER ::  arhobc     = 2000.0_wp  !< black carbon
-    REAL(wp), PARAMETER ::  arhodu     = 2650.0_wp  !< mineral dust
-    REAL(wp), PARAMETER ::  arhoh2o    = 1000.0_wp  !< H2O
-    REAL(wp), PARAMETER ::  arhoh2so4  = 1830.0_wp  !< SO4
-    REAL(wp), PARAMETER ::  arhohno3   = 1479.0_wp  !< HNO3
-    REAL(wp), PARAMETER ::  arhonh3    = 1530.0_wp  !< NH3
-    REAL(wp), PARAMETER ::  arhooc     = 2000.0_wp  !< organic carbon
-    REAL(wp), PARAMETER ::  arhoss     = 2165.0_wp  !< sea salt (NaCl)
-!
-!-- Volume of molecule in m3/#
-    REAL(wp), PARAMETER ::  amvh2o   = amh2o /avo / arhoh2o      !< H2O
-    REAL(wp), PARAMETER ::  amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4
-    REAL(wp), PARAMETER ::  amvhno3  = amhno3 / avo / arhohno3   !< HNO3
-    REAL(wp), PARAMETER ::  amvnh3   = amnh3 / avo / arhonh3     !< NH3
-    REAL(wp), PARAMETER ::  amvoc    = amoc / avo / arhooc       !< OC
-    REAL(wp), PARAMETER ::  amvss    = amss / avo / arhoss       !< sea salt
-!
-!-- Constants for the dry deposition model by Petroff and Zhang (2010):
-!-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants
-!-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001))
-    REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = &
-        (/0.15,  4.0,   0.15,  3.0,   3.0,   0.5,   3.0,   -99., 0.5,  2.0,  1.0,   -99., -99., -99., 3.0/)
-    REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = &
-        (/0.887, 1.262, 0.887, 1.262, 1.262, 0.996, 0.996, -99., 0.7,  0.93, 0.996, -99., -99., -99., 1.262/)
-    REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = &
-        (/0.81,  0.216, 0.81,  0.216, 0.216, 0.191, 0.162, -99., 0.7,  0.14, 0.162, -99., -99., -99., 0.216/)
-    REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = &
-        (/0.162, 0.13,  0.162, 0.13,  0.13,  0.191, 0.081, -99., 0.191,0.086,0.081, -99., -99., -99., 0.13/)
-    REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = &
-        (/0.6,   0.47,  0.6,   0.47,  0.47,  0.47,  0.47,  -99., 0.6,  0.47, 0.47,  -99., -99., -99., 0.47/)
-    REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = &
-        (/0.0,   0.056, 0.0,   0.056, 0.056, 0.042, 0.056, -99., 0.042,0.014,0.056, -99., -99., -99., 0.056/)
-!
-!-- Constants for the dry deposition model by Zhang et al. (2001):
-!-- empirical constants "alpha" and "gamma" and characteristic radius "A" for
-!-- each land use category (15) and season (5)
-    REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = &
-        (/1.0, 0.6, 1.1, 0.8, 0.8, 1.2, 1.2, 50.0, 50.0, 1.3, 2.0, 50.0, 100.0, 100.0, 1.5/)
-    REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = &
-        (/0.56, 0.58, 0.56, 0.56, 0.56, 0.54, 0.54, 0.54, 0.54, 0.54, 0.54, 0.54, 0.50, 0.50, 0.56/)
-    REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 =  RESHAPE( (/&
-         2.0, 5.0, 2.0,  5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,&  ! SC1
-         2.0, 5.0, 2.0,  5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,&  ! SC2
-         2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,&  ! SC3
-         2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,&  ! SC4
-         2.0, 5.0, 2.0,  5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0 &  ! SC5
-                                                           /), (/ 15, 5 /) )
-!-- Land use categories (based on Z01 but the same applies here also for P10):
-!-- 1 = evergreen needleleaf trees,
-!-- 2 = evergreen broadleaf trees,
-!-- 3 = deciduous needleleaf trees,
-!-- 4 = deciduous broadleaf trees,
-!-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10),
-!-- 6 = grass (short grass for P10),
-!-- 7 = crops, mixed farming,
-!-- 8 = desert,
-!-- 9 = tundra,
-!-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10),
-!-- 11 = wetland with plants (long grass for P10)
-!-- 12 = ice cap and glacier,
-!-- 13 = inland water (inland lake for P10)
-!-- 14 = ocean (water for P10),
-!-- 15 = urban
-!
-!-- SALSA variables:
-    CHARACTER(LEN=20)  ::  bc_aer_b = 'neumann'                   !< bottom boundary condition
-    CHARACTER(LEN=20)  ::  bc_aer_l = 'undefined'                 !< left boundary condition
-    CHARACTER(LEN=20)  ::  bc_aer_n = 'undefined'                 !< north boundary condition
-    CHARACTER(LEN=20)  ::  bc_aer_r = 'undefined'                 !< right boundary condition
-    CHARACTER(LEN=20)  ::  bc_aer_s = 'undefined'                 !< south boundary condition
-    CHARACTER(LEN=20)  ::  bc_aer_t = 'neumann'                   !< top boundary condition
-    CHARACTER(LEN=20)  ::  depo_pcm_par = 'zhang2001'             !< or 'petroff2010'
-    CHARACTER(LEN=20)  ::  depo_pcm_type = 'deciduous_broadleaf'  !< leaf type
-    CHARACTER(LEN=20)  ::  depo_surf_par = 'zhang2001'            !< or 'petroff2010'
-    CHARACTER(LEN=100) ::  input_file_dynamic = 'PIDS_DYNAMIC'    !< file name for dynamic input
-    CHARACTER(LEN=100) ::  input_file_salsa   = 'PIDS_SALSA'      !< file name for emission data
-    CHARACTER(LEN=20)  ::  salsa_emission_mode = 'no_emission'    !< 'no_emission', 'uniform',
-                                                                  !< 'parameterized', 'read_from_file'
-    CHARACTER(LEN=3), DIMENSION(maxspec) ::  listspec = &  !< Active aerosols
-                                   (/'SO4','   ','   ','   ','   ','   ','   '/)
-
-    INTEGER(iwp) ::  communicator_salsa     !< stores the number of the MPI communicator to be used
-                                            !< for ghost layer data exchange
-                                            !< 1: cyclic, 2: cyclic along x, 3: cyclic along y,
-                                            !< 4: non-cyclic
-    INTEGER(iwp) ::  depo_pcm_par_num = 1   !< parametrisation type: 1=zhang2001, 2=petroff2010
-    INTEGER(iwp) ::  depo_pcm_type_num = 0  !< index for the dry deposition type on the plant canopy
-    INTEGER(iwp) ::  depo_surf_par_num = 1  !< parametrisation type: 1=zhang2001, 2=petroff2010
-    INTEGER(iwp) ::  end_subrange_1a = 1    !< last index for bin subrange 1a
-    INTEGER(iwp) ::  end_subrange_2a = 1    !< last index for bin subrange 2a
-    INTEGER(iwp) ::  end_subrange_2b = 1    !< last index for bin subrange 2b
-    INTEGER(iwp) ::  ibc_aer_b              !< index for the bottom boundary condition
-    INTEGER(iwp) ::  ibc_aer_t              !< index for the top boundary condition
-    INTEGER(iwp) ::  index_bc  = -1         !< index for black carbon (BC)
-    INTEGER(iwp) ::  index_du  = -1         !< index for dust
-    INTEGER(iwp) ::  index_nh  = -1         !< index for NH3
-    INTEGER(iwp) ::  index_no  = -1         !< index for HNO3
-    INTEGER(iwp) ::  index_oc  = -1         !< index for organic carbon (OC)
-    INTEGER(iwp) ::  index_so4 = -1         !< index for SO4 or H2SO4
-    INTEGER(iwp) ::  index_ss  = -1         !< index for sea salt
-    INTEGER(iwp) ::  init_aerosol_type = 0  !< Initial size distribution type
-                                            !< 0 = uniform (read from PARIN)
-                                            !< 1 = read vertical profiles from an input file
-    INTEGER(iwp) ::  init_gases_type = 0    !< Initial gas concentration type
-                                            !< 0 = uniform (read from PARIN)
-                                            !< 1 = read vertical profiles from an input file
-    INTEGER(iwp) ::  lod_gas_emissions = 0  !< level of detail of the gaseous emission data
-    INTEGER(iwp) ::  main_street_id = 0     !< lower bound of main street IDs for parameterized emission mode
-    INTEGER(iwp) ::  max_street_id = 0      !< upper bound of main street IDs for parameterized emission mode
-    INTEGER(iwp) ::  nbins_aerosol = 1      !< total number of size bins
-    INTEGER(iwp) ::  ncc   = 1              !< number of chemical components used
-    INTEGER(iwp) ::  ncomponents_mass = 1   !< total number of chemical compounds (ncc+1)
-                                            !< if particle water is advected)
-    INTEGER(iwp) ::  nj3 = 1                !< J3 parametrization (nucleation)
-                                            !< 1 = condensational sink (Kerminen&Kulmala, 2002)
-                                            !< 2 = coagulational sink (Lehtinen et al. 2007)
-                                            !< 3 = coagS+self-coagulation (Anttila et al. 2010)
-    INTEGER(iwp) ::  nsnucl = 0             !< Choice of the nucleation scheme:
-                                            !< 0 = off
-                                            !< 1 = binary nucleation
-                                            !< 2 = activation type nucleation
-                                            !< 3 = kinetic nucleation
-                                            !< 4 = ternary nucleation
-                                            !< 5 = nucleation with ORGANICs
-                                            !< 6 = activation type of nucleation with H2SO4+ORG
-                                            !< 7 = heteromolecular nucleation with H2SO4*ORG
-                                            !< 8 = homomolecular nucleation of H2SO4
-                                            !<     + heteromolecular nucleation with H2SO4*ORG
-                                            !< 9 = homomolecular nucleation of H2SO4 and ORG
-                                            !<     + heteromolecular nucleation with H2SO4*ORG
-    INTEGER(iwp) ::  salsa_pr_count = 0     !< counter for salsa variable profiles
-    INTEGER(iwp) ::  season_z01 = 1         !< For dry deposition by Zhang et al.: 1 = summer,
-                                            !< 2 = autumn (no harvest yet), 3 = late autumn
-                                            !< (already frost), 4 = winter, 5 = transitional spring
-    INTEGER(iwp) ::  side_street_id = 0     !< lower bound of side street IDs for parameterized emission mode
-    INTEGER(iwp) ::  start_subrange_1a = 1  !< start index for bin subranges: subrange 1a
-    INTEGER(iwp) ::  start_subrange_2a = 1  !<                                subrange 2a
-    INTEGER(iwp) ::  start_subrange_2b = 1  !<                                subrange 2b
-
-    INTEGER(iwp), DIMENSION(nreg) ::  nbin = (/ 3, 7/)  !< Number of size bins per subrange: 1 & 2
-
-    INTEGER(iwp), DIMENSION(ngases_salsa) ::  gas_index_chem = (/ 1, 1, 1, 1, 1/)  !< gas indices in chemistry_model_mod
-                                                                                   !< 1 = H2SO4, 2 = HNO3,
-                                                                                   !< 3 = NH3,   4 = OCNV, 5 = OCSV
-    INTEGER(iwp), DIMENSION(ngases_salsa) ::  emission_index_chem  !< gas indices in the gas emission file
-    INTEGER(iwp), DIMENSION(99) ::  salsa_pr_index  = 0            !< index for salsa profiles
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  k_topo_top  !< vertical index of the topography top
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE  ::  salsa_advc_flags_s !< flags used to degrade order of advection
-                                                                        !< scheme for salsa variables near walls and
-                                                                        !< lateral boundaries
-!
-!-- SALSA switches:
-    LOGICAL ::  advect_particle_water   = .TRUE.   !< Advect water concentration of particles
-    LOGICAL ::  bc_dirichlet_aer_l      = .FALSE.  !< flag for indicating a dirichlet condition at
-                                                   !< the left boundary
-    LOGICAL ::  bc_dirichlet_aer_n      = .FALSE.  !< flag for indicating a dirichlet condition at
-                                                   !< the north boundary
-    LOGICAL ::  bc_dirichlet_aer_r      = .FALSE.  !< flag for indicating a dirichlet condition at
-                                                   !< the right boundary
-    LOGICAL ::  bc_dirichlet_aer_s      = .FALSE.  !< flag for indicating a dirichlet condition at
-                                                   !< the south boundary
-    LOGICAL ::  bc_radiation_aer_l      = .FALSE.  !< flag for indicating a radiation/neumann
-                                                   !< condition at the left boundary
-    LOGICAL ::  bc_radiation_aer_n      = .FALSE.  !< flag for indicating a radiation/neumann
-                                                   !< condition at the north boundary
-    LOGICAL ::  bc_radiation_aer_r      = .FALSE.  !< flag for indicating a radiation/neumann
-                                                   !< condition at the right boundary
-    LOGICAL ::  bc_radiation_aer_s      = .FALSE.  !< flag for indicating a radiation/neumann
-                                                   !< condition at the south boundary
-    LOGICAL ::  include_emission        = .FALSE.  !< Include or not emissions
-    LOGICAL ::  feedback_to_palm        = .FALSE.  !< Allow feedback due to condensation of H2O
-    LOGICAL ::  nesting_salsa           = .TRUE.   !< Apply nesting for salsa
-    LOGICAL ::  nesting_offline_salsa   = .TRUE.   !< Apply offline nesting for salsa
-    LOGICAL ::  no_insoluble            = .FALSE.  !< Exclude insoluble chemical components
-    LOGICAL ::  read_restart_data_salsa = .TRUE.   !< Read restart data for salsa
-    LOGICAL ::  salsa_gases_from_chem   = .FALSE.  !< Transfer the gaseous components to SALSA
-    LOGICAL ::  van_der_waals_coagc     = .FALSE.  !< Include van der Waals and viscous forces in coagulation
-
-!
-!-- Process switches: nl* is read from the NAMELIST and is NOT changed.
-!--                   ls* is the switch used and will get the value of nl*
-!--                       except for special circumstances (spinup period etc.)
-    LOGICAL ::  nlcoag       = .FALSE.  !< Coagulation master switch
-    LOGICAL ::  lscoag       = .FALSE.  !<
-    LOGICAL ::  nlcnd        = .FALSE.  !< Condensation master switch
-    LOGICAL ::  lscnd        = .FALSE.  !<
-    LOGICAL ::  nlcndgas     = .FALSE.  !< Condensation of precursor gases
-    LOGICAL ::  lscndgas     = .FALSE.  !<
-    LOGICAL ::  nlcndh2oae   = .FALSE.  !< Condensation of H2O on aerosol
-    LOGICAL ::  lscndh2oae   = .FALSE.  !< particles (FALSE -> equilibrium calc.)
-    LOGICAL ::  nldepo       = .FALSE.  !< Deposition master switch
-    LOGICAL ::  lsdepo       = .FALSE.  !<
-    LOGICAL ::  nldepo_surf  = .FALSE.  !< Deposition on vegetation master switch
-    LOGICAL ::  lsdepo_surf  = .FALSE.  !<
-    LOGICAL ::  nldepo_pcm   = .FALSE.  !< Deposition on walls master switch
-    LOGICAL ::  lsdepo_pcm   = .FALSE.  !<
-    LOGICAL ::  nldistupdate = .TRUE.   !< Size distribution update master switch
-    LOGICAL ::  lsdistupdate = .FALSE.  !<
-    LOGICAL ::  lspartition  = .FALSE.  !< Partition of HNO3 and NH3
-
-    REAL(wp) ::  act_coeff = 1.0E-7_wp               !< Activation coefficient (1/s)
-    REAL(wp) ::  dt_salsa  = 0.00001_wp              !< Time step of SALSA
-    REAL(wp) ::  emiss_factor_main = 0.0_wp          !< relative emission factor for main streets
-    REAL(wp) ::  emiss_factor_side = 0.0_wp          !< relative emission factor for side streets
-    REAL(wp) ::  h2so4_init = nclim                  !< Init value for sulphuric acid gas
-    REAL(wp) ::  hno3_init  = nclim                  !< Init value for nitric acid gas
-    REAL(wp) ::  last_salsa_time = 0.0_wp            !< previous salsa call
-    REAL(wp) ::  next_aero_emission_update = 0.0_wp  !< previous emission update
-    REAL(wp) ::  next_gas_emission_update = 0.0_wp   !< previous emission update
-    REAL(wp) ::  nf2a = 1.0_wp                       !< Number fraction allocated to 2a-bins
-    REAL(wp) ::  nh3_init  = nclim                   !< Init value for ammonia gas
-    REAL(wp) ::  ocnv_init = nclim                   !< Init value for non-volatile organic gases
-    REAL(wp) ::  ocsv_init = nclim                   !< Init value for semi-volatile organic gases
-    REAL(wp) ::  rhlim = 1.20_wp                     !< RH limit in %/100. Prevents unrealistical RH
-    REAL(wp) ::  skip_time_do_salsa = 0.0_wp         !< Starting time of SALSA (s)
-!
-!-- Initial log-normal size distribution: mode diameter (dpg, metres),
-!-- standard deviation (sigmag) and concentration (n_lognorm, #/m3)
-    REAL(wp), DIMENSION(nmod) ::  dpg   = &
-                     (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/)
-    REAL(wp), DIMENSION(nmod) ::  sigmag  = &
-                                        (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
-    REAL(wp), DIMENSION(nmod) ::  n_lognorm = &
-                             (/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
-!
-!-- Initial mass fractions / chemical composition of the size distribution
-    REAL(wp), DIMENSION(maxspec) ::  mass_fracs_a = &  !< mass fractions between
-             (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)     !< aerosol species for A bins
-    REAL(wp), DIMENSION(maxspec) ::  mass_fracs_b = &  !< mass fractions between
-             (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)     !< aerosol species for B bins
-    REAL(wp), DIMENSION(nreg+1) ::  reglim = &         !< Min&max diameters of size subranges
-                                 (/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/)
-!
-!-- Initial log-normal size distribution of aerosol emissions: mode diameter (dpg, metres),
-!-- standard deviation (sigmag), concentration (n_lognorm, #/m3) and mass fractions of all chemical
-!-- components (listed in listspec) a (soluble) bins. Currently, non-soluble emissions are not
-!-- implemented.
-    REAL(wp), DIMENSION(nmod) ::  aerosol_flux_dpg   = &
-                     (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/)
-    REAL(wp), DIMENSION(nmod) ::  aerosol_flux_sigmag  = &
-                                        (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/)
-    REAL(wp), DIMENSION(maxspec) ::  aerosol_flux_mass_fracs_a = &
-                                                               (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
-    REAL(wp), DIMENSION(nmod) ::  surface_aerosol_flux = &
-                                 (/1.0E+8_wp, 1.0E+9_wp, 1.0E+5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bin_low_limits     !< to deliver information about
-                                                               !< the lower diameters per bin
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_am_t_val        !< vertical gradient of: aerosol mass
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_an_t_val        !< of: aerosol number
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  bc_gt_t_val        !< salsa gases near domain top
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  gas_emission_time  !< Time array in gas emission data (s)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  nsect              !< Background number concentrations
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  massacc            !< Mass accomodation coefficients
-!
-!-- SALSA derived datatypes:
-!
-!-- Component index
-    TYPE component_index
-       CHARACTER(len=3), ALLOCATABLE ::  comp(:)  !< Component name
-       INTEGER(iwp) ::  ncomp  !< Number of components
-       INTEGER(iwp), ALLOCATABLE ::  ind(:)  !< Component index
-    END TYPE component_index
-!
-!-- For matching LSM and USM surface types and the deposition module surface types
-    TYPE match_surface
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_lupg  !< index for pavement / green roofs
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_luvw  !< index for vegetation / walls
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  match_luww  !< index for water / windows
-    END TYPE match_surface
-!
-!-- Aerosol emission data attributes
-    TYPE salsa_emission_attribute_type
-
-       CHARACTER(LEN=25) ::   units
-
-       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   cat_name    !<
-       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   cc_name     !<
-       CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE ::   unit_time   !<
-       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names   !<
-
-       INTEGER(iwp) ::  lod = 0            !< level of detail
-       INTEGER(iwp) ::  nbins = 10         !< number of aerosol size bins
-       INTEGER(iwp) ::  ncat  = 0          !< number of emission categories
-       INTEGER(iwp) ::  ncc   = 7          !< number of aerosol chemical components
-       INTEGER(iwp) ::  nhoursyear = 0     !< number of hours: HOURLY mode
-       INTEGER(iwp) ::  nmonthdayhour = 0  !< number of month days and hours: MDH mode
-       INTEGER(iwp) ::  num_vars           !< number of variables
-       INTEGER(iwp) ::  nt  = 0            !< number of time steps
-       INTEGER(iwp) ::  nz  = 0            !< number of vertical levels
-       INTEGER(iwp) ::  tind               !< time index for reference time in salsa emission data
-
-       INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod = 0   !<
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  cat_index  !< Index of emission categories
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  cc_index   !< Index of chemical components
-
-       REAL(wp) ::  conversion_factor  !< unit conversion factor for aerosol emissions
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dmid         !< mean diameters of size bins (m)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rho          !< average density (kg/m3)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time         !< time (s)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time_factor  !< emission time factor
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z            !< height (m)
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  etf  !< emission time factor
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height
-
-    END TYPE salsa_emission_attribute_type
-!
-!-- The default size distribution and mass composition per emission category:
-!-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other
-!-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3
-    TYPE salsa_emission_mode_type
-
-       INTEGER(iwp) ::  ndm = 3  !< number of default modes
-       INTEGER(iwp) ::  ndc = 4  !< number of default categories
-
-       CHARACTER(LEN=25), DIMENSION(1:4) ::  cat_name_table = (/'traffic exhaust', &
-                                                                'road dust      ', &
-                                                                'wood combustion', &
-                                                                'other          '/)
-
-       INTEGER(iwp), DIMENSION(1:4) ::  cat_input_to_model   !<
-
-       REAL(wp), DIMENSION(1:3) ::  dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/)  !<
-       REAL(wp), DIMENSION(1:3) ::  ntot_table  !<
-       REAL(wp), DIMENSION(1:3) ::  sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /)  !<
-
-       REAL(wp), DIMENSION(1:maxspec,1:4) ::  mass_frac_table = &  !<
-          RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp, &
-                      0.0_wp,  0.05_wp, 0.0_wp,  0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
-                      0.0_wp,  0.5_wp,  0.5_wp,  0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp, &
-                      0.0_wp,  0.5_wp,  0.5_wp,  0.0_wp,  0.0_wp, 0.0_wp, 0.0_wp  &
-                   /), (/maxspec,4/) )
-
-       REAL(wp), DIMENSION(1:3,1:4) ::  pm_frac_table = & !< rel. mass
-                                     RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, &
-                                                 0.000_wp, 1.000_wp, 0.000_wp, &
-                                                 0.000_wp, 0.000_wp, 1.000_wp, &
-                                                 1.000_wp, 0.000_wp, 1.000_wp  &
-                                              /), (/3,4/) )
-
-    END TYPE salsa_emission_mode_type
-!
-!-- Aerosol emission data values
-    TYPE salsa_emission_value_type
-
-       REAL(wp) ::  fill  !< fill value
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mass_fracs  !< mass fractions per emis. category
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: num_fracs   !< number fractions per emis. category
-
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data      !< surface emission in PM
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data  !< surface emission per category
-
-    END TYPE salsa_emission_value_type
-!
-!-- Offline nesting data type
-    TYPE salsa_nest_offl_type
-
-       CHARACTER(LEN=16) ::  char_l = 'ls_forcing_left_'  !< leading substring at left boundary
-       CHARACTER(LEN=17) ::  char_n = 'ls_forcing_north_' !< leading substring at north boundary
-       CHARACTER(LEN=17) ::  char_r = 'ls_forcing_right_' !< leading substring at right boundary
-       CHARACTER(LEN=17) ::  char_s = 'ls_forcing_south_' !< leading substring at south boundary
-       CHARACTER(LEN=15) ::  char_t = 'ls_forcing_top_'   !< leading substring at top boundary
-
-       CHARACTER(LEN=5), DIMENSION(1:ngases_salsa) ::  gas_name = (/'H2SO4','HNO3 ','NH3  ','OCNV ','OCSV '/)
-
-       CHARACTER(LEN=25),  DIMENSION(:), ALLOCATABLE ::  cc_name    !< chemical component name
-       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< list of variable names
-
-       INTEGER(iwp) ::  id_dynamic  !< NetCDF id of dynamic input file
-       INTEGER(iwp) ::  ncc         !< number of aerosol chemical components
-       INTEGER(iwp) ::  nt          !< number of time levels in dynamic input file
-       INTEGER(iwp) ::  nzu         !< number of vertical levels on scalar grid in dynamic input file
-       INTEGER(iwp) ::  tind = 0    !< time index for reference time in mesoscale-offline nesting
-       INTEGER(iwp) ::  tind_p = 0  !< time index for following time in mesoscale-offline nesting
-
-       INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod = 0  !< to transfer chemical composition from input to model
-
-       LOGICAL ::  init  = .FALSE. !< flag indicating the initialisation of offline nesting
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dmid      !< vertical profile of aerosol bin diameters
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time      !< time in dynamic input file
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu_atmos  !< zu in dynamic input file
-
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_left   !< gas conc. at left boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_north  !< gas conc. at north boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_right  !< gas conc. at right boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_south  !< gas conc. at south boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  gconc_top    !< gas conc.at top boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_left   !< aerosol mass conc. at left boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_north  !< aerosol mass conc. at north boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_right  !< aerosol mass conc. at right boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_south  !< aerosol mass conc. at south boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mconc_top    !< aerosol mass conc. at top boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_left   !< aerosol number conc. at left boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_north  !< aerosol number conc. at north boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_right  !< aerosol number conc. at right boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_south  !< aerosol number conc. at south boundary
-       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  nconc_top    !< aerosol number conc. at top boundary
-
-    END TYPE salsa_nest_offl_type
-!
-!-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration)
-!-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in
-!-- dimension 4 as:
-!-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile)
-    TYPE salsa_variable
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE     ::  init  !<
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  diss_s     !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  flux_s     !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  source     !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_ws_l  !<
-
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  diss_l  !<
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  flux_l  !<
-
-       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  conc     !<
-       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  conc_p   !<
-       REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  tconc_m  !<
-
-    END TYPE salsa_variable
-!
-!-- Datatype used to store information about the binned size distributions of aerosols
-    TYPE t_section
-
-       REAL(wp) ::  dmid     !< bin middle diameter (m)
-       REAL(wp) ::  vhilim   !< bin volume at the high limit
-       REAL(wp) ::  vlolim   !< bin volume at the low limit
-       REAL(wp) ::  vratiohi !< volume ratio between the center and high limit
-       REAL(wp) ::  vratiolo !< volume ratio between the center and low limit
-       !******************************************************
-       ! ^ Do NOT change the stuff above after initialization !
-       !******************************************************
-       REAL(wp) ::  core    !< Volume of dry particle
-       REAL(wp) ::  dwet    !< Wet diameter or mean droplet diameter (m)
-       REAL(wp) ::  numc    !< Number concentration of particles/droplets (#/m3)
-       REAL(wp) ::  veqh2o  !< Equilibrium H2O concentration for each particle
-
-       REAL(wp), DIMENSION(maxspec+1) ::  volc !< Volume concentrations (m^3/m^3) of aerosols +
-                                               !< water. Since most of the stuff in SALSA is hard
-                                               !< coded, these *have to be* in the order
-                                               !< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
-    END TYPE t_section
-
-    TYPE(salsa_emission_attribute_type) ::  aero_emission_att  !< emission attributes
-    TYPE(salsa_emission_value_type)     ::  aero_emission      !< emission values
-    TYPE(salsa_emission_mode_type)      ::  def_modes          !< default emission modes
-
-    TYPE(chem_emis_att_type) ::  chem_emission_att  !< chemistry emission attributes
-
-    TYPE(chem_emis_val_type), DIMENSION(:), ALLOCATABLE ::  chem_emission  !< chemistry emissions
-
-    TYPE(t_section), DIMENSION(:), ALLOCATABLE ::  aero  !< local aerosol properties
-
-    TYPE(match_surface), DIMENSION(0:1) ::  lsm_to_depo_h  !< to match the deposition module and horizontal LSM surfaces
-    TYPE(match_surface), DIMENSION(0:1) ::  usm_to_depo_h  !< to match the deposition module and horizontal USM surfaces
-
-    TYPE(match_surface), DIMENSION(0:3) ::  lsm_to_depo_v  !< to match the deposition mod. and vertical LSM surfaces
-    TYPE(match_surface), DIMENSION(0:3) ::  usm_to_depo_v  !< to match the deposition mod. and vertical USM surfaces
-!
-!-- SALSA variables: as x = x(k,j,i,bin).
-!-- The 4th dimension contains all the size bins sequentially for each aerosol species  + water.
-!
-!-- Prognostic variables:
-!
-!-- Number concentration (#/m3)
-    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  aerosol_number  !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_1  !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_2  !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nconc_3  !<
-!
-!-- Mass concentration (kg/m3)
-    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  aerosol_mass  !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_1  !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_2  !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mconc_3  !<
-!
-!-- Gaseous concentrations (#/m3)
-    TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET ::  salsa_gas  !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_1  !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_2  !<
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  gconc_3  !<
-!
-!-- Diagnostic tracers
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  sedim_vd  !< sedimentation velocity per bin (m/s)
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ra_dry    !< aerosol dry radius (m)
-
-!-- Particle component index tables
-    TYPE(component_index) :: prtcl  !< Contains "getIndex" which gives the index for a given aerosol
-                                    !< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
-!
-!-- Offline nesting:
-    TYPE(salsa_nest_offl_type) ::  salsa_nest_offl  !< data structure for offline nesting
-!
-!-- Data output arrays:
-!
-!-- Integrated:
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ldsa_av  !< lung-deposited surface area
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ntot_av  !< total number concentration
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nufp_av  !< ultrafine particles (UFP)
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm01_av  !< PM0.1
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm25_av  !< PM2.5
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  pm10_av  !< PM10
-!
-!-- Bin specific mass and number concentrations:
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  mbins_av  !< bin mas
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  nbins_av  !< bin number
-!
-!-- Gases:
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  salsa_gases_av  !< gases
-!
-!-- In the particle phase:
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  s_h2o_av  !< liquid water
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  s_mass_av  !< mass components
-
-!
-!-- PALM interfaces:
-
-    INTERFACE salsa_actions
-       MODULE PROCEDURE salsa_actions
-       MODULE PROCEDURE salsa_actions_ij
-    END INTERFACE salsa_actions
-
-    INTERFACE salsa_3d_data_averaging
-       MODULE PROCEDURE salsa_3d_data_averaging
-    END INTERFACE salsa_3d_data_averaging
-
-    INTERFACE salsa_boundary_conditions
-       MODULE PROCEDURE salsa_boundary_conditions
-    END INTERFACE salsa_boundary_conditions
-
-    INTERFACE salsa_check_data_output
-       MODULE PROCEDURE salsa_check_data_output
-    END INTERFACE salsa_check_data_output
-
-    INTERFACE salsa_check_data_output_pr
-       MODULE PROCEDURE salsa_check_data_output_pr
-    END INTERFACE salsa_check_data_output_pr
-
-    INTERFACE salsa_check_parameters
-       MODULE PROCEDURE salsa_check_parameters
-    END INTERFACE salsa_check_parameters
-
-    INTERFACE salsa_data_output_2d
-       MODULE PROCEDURE salsa_data_output_2d
-    END INTERFACE salsa_data_output_2d
-
-    INTERFACE salsa_data_output_3d
-       MODULE PROCEDURE salsa_data_output_3d
-    END INTERFACE salsa_data_output_3d
-
-    INTERFACE salsa_data_output_mask
-       MODULE PROCEDURE salsa_data_output_mask
-    END INTERFACE salsa_data_output_mask
-
-    INTERFACE salsa_define_netcdf_grid
-       MODULE PROCEDURE salsa_define_netcdf_grid
-    END INTERFACE salsa_define_netcdf_grid
-
-    INTERFACE salsa_emission_update
-       MODULE PROCEDURE salsa_emission_update
-    END INTERFACE salsa_emission_update
-
-    INTERFACE salsa_exchange_horiz_bounds
-       MODULE PROCEDURE salsa_exchange_horiz_bounds
-    END INTERFACE salsa_exchange_horiz_bounds
-
-    INTERFACE salsa_header
-       MODULE PROCEDURE salsa_header
-    END INTERFACE salsa_header
-
-    INTERFACE salsa_init
-       MODULE PROCEDURE salsa_init
-    END INTERFACE salsa_init
-
-    INTERFACE salsa_init_arrays
-       MODULE PROCEDURE salsa_init_arrays
-    END INTERFACE salsa_init_arrays
-
-    INTERFACE salsa_nesting_offl_bc
-       MODULE PROCEDURE salsa_nesting_offl_bc
-    END INTERFACE salsa_nesting_offl_bc
-
-    INTERFACE salsa_nesting_offl_init
-       MODULE PROCEDURE salsa_nesting_offl_init
-    END INTERFACE salsa_nesting_offl_init
-
-    INTERFACE salsa_nesting_offl_input
-       MODULE PROCEDURE salsa_nesting_offl_input
-    END INTERFACE salsa_nesting_offl_input
-
-    INTERFACE salsa_non_advective_processes
-       MODULE PROCEDURE salsa_non_advective_processes
-       MODULE PROCEDURE salsa_non_advective_processes_ij
-    END INTERFACE salsa_non_advective_processes
-
-    INTERFACE salsa_parin
-       MODULE PROCEDURE salsa_parin
-    END INTERFACE salsa_parin
-
-    INTERFACE salsa_prognostic_equations
-       MODULE PROCEDURE salsa_prognostic_equations
-       MODULE PROCEDURE salsa_prognostic_equations_ij
-    END INTERFACE salsa_prognostic_equations
-
-    INTERFACE salsa_rrd_global
-       MODULE PROCEDURE salsa_rrd_global_ftn
-       MODULE PROCEDURE salsa_rrd_global_mpi
-    END INTERFACE salsa_rrd_global
-
-    INTERFACE salsa_rrd_local
-       MODULE PROCEDURE salsa_rrd_local_ftn
-       MODULE PROCEDURE salsa_rrd_local_mpi
-    END INTERFACE salsa_rrd_local
-
-    INTERFACE salsa_statistics
-       MODULE PROCEDURE salsa_statistics
-    END INTERFACE salsa_statistics
-
-    INTERFACE salsa_swap_timelevel
-       MODULE PROCEDURE salsa_swap_timelevel
-    END INTERFACE salsa_swap_timelevel
-
-    INTERFACE salsa_tendency
-       MODULE PROCEDURE salsa_tendency
-       MODULE PROCEDURE salsa_tendency_ij
-    END INTERFACE salsa_tendency
-
-    INTERFACE salsa_wrd_global
-       MODULE PROCEDURE salsa_wrd_global
-    END INTERFACE salsa_wrd_global
-
-    INTERFACE salsa_wrd_local
-       MODULE PROCEDURE salsa_wrd_local
-    END INTERFACE salsa_wrd_local
-
-
-    SAVE
-
-    PRIVATE
-!
-!-- Public functions:
-    PUBLIC salsa_3d_data_averaging,       &
-           salsa_actions,                 &
-           salsa_boundary_conditions,     &
-           salsa_check_data_output,       &
-           salsa_check_data_output_pr,    &
-           salsa_check_parameters,        &
-           salsa_data_output_2d,          &
-           salsa_data_output_3d,          &
-           salsa_data_output_mask,        &
-           salsa_define_netcdf_grid,      &
-           salsa_diagnostics,             &
-           salsa_emission_update,         &
-           salsa_exchange_horiz_bounds,   &
-           salsa_header,                  &
-           salsa_init,                    &
-           salsa_init_arrays,             &
-           salsa_nesting_offl_bc,         &
-           salsa_nesting_offl_init,       &
-           salsa_nesting_offl_input,      &
-           salsa_non_advective_processes, &
-           salsa_parin,                   &
-           salsa_prognostic_equations,    &
-           salsa_rrd_global,              &
-           salsa_rrd_local,               &
-           salsa_statistics,              &
-           salsa_swap_timelevel,          &
-           salsa_wrd_global,              &
-           salsa_wrd_local
-
-!
-!-- Public parameters, constants and initial values
-    PUBLIC bc_am_t_val,           &
-           bc_an_t_val,           &
-           bc_gt_t_val,           &
-           communicator_salsa,    &
-           ibc_aer_b,             &
-           init_aerosol_type,     &
-           init_gases_type,       &
-           nesting_salsa,         &
-           nesting_offline_salsa, &
-           salsa_gases_from_chem, &
-           skip_time_do_salsa
-!
-!-- Public variables
-    PUBLIC aerosol_mass,     &
-           aerosol_number,   &
-           gconc_2,          &
-           mconc_2,          &
-           nbins_aerosol,    &
-           ncomponents_mass, &
-           nconc_2,          &
-           ngases_salsa,     &
-           salsa_gas,        &
-           salsa_nest_offl
-
-
- CONTAINS
-
-!-------------------  -----------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &salsa_par for new modules
-!---------------------                    ---------------------------------------------------------!
- SUBROUTINE salsa_parin
-
-    USE control_parameters,                                                                        &
-        ONLY:  data_output_pr
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  line   !< dummy string that contains the current line of parameter file
-
-    INTEGER(iwp) ::  i                 !< loop index
-    INTEGER(iwp) ::  io_status         !< status after reading the namelist file
-    INTEGER(iwp) ::  max_pr_salsa_tmp  !< dummy variable
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /salsa_parameters/      aerosol_flux_dpg,                                             &
-                                     aerosol_flux_mass_fracs_a,                                    &
-                                     aerosol_flux_sigmag,                                          &
-                                     advect_particle_water,                                        &
-                                     bc_aer_b,                                                     &
-                                     bc_aer_l,                                                     &
-                                     bc_aer_n,                                                     &
-                                     bc_aer_r,                                                     &
-                                     bc_aer_s,                                                     &
-                                     bc_aer_t,                                                     &
-                                     depo_pcm_par,                                                 &
-                                     depo_pcm_type,                                                &
-                                     depo_surf_par,                                                &
-                                     dpg,                                                          &
-                                     dt_salsa,                                                     &
-                                     emiss_factor_main,                                            &
-                                     emiss_factor_side,                                            &
-                                     feedback_to_palm,                                             &
-                                     h2so4_init,                                                   &
-                                     hno3_init,                                                    &
-                                     listspec,                                                     &
-                                     main_street_id,                                               &
-                                     mass_fracs_a,                                                 &
-                                     mass_fracs_b,                                                 &
-                                     max_street_id,                                                &
-                                     n_lognorm,                                                    &
-                                     nbin,                                                         &
-                                     nesting_salsa,                                                &
-                                     nesting_offline_salsa,                                        &
-                                     nf2a,                                                         &
-                                     nh3_init,                                                     &
-                                     nj3,                                                          &
-                                     nlcnd,                                                        &
-                                     nlcndgas,                                                     &
-                                     nlcndh2oae,                                                   &
-                                     nlcoag,                                                       &
-                                     nldepo,                                                       &
-                                     nldepo_pcm,                                                   &
-                                     nldepo_surf,                                                  &
-                                     nldistupdate,                                                 &
-                                     nsnucl,                                                       &
-                                     ocnv_init,                                                    &
-                                     ocsv_init,                                                    &
-                                     reglim,                                                       &
-                                     salsa,                                                        &
-                                     salsa_emission_mode,                                          &
-                                     season_z01,                                                   &
-                                     sigmag,                                                       &
-                                     side_street_id,                                               &
-                                     skip_time_do_salsa,                                           &
-                                     surface_aerosol_flux,                                         &
-                                     switch_off_module,                                            &
-                                     van_der_waals_coagc
-
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, salsa_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    salsa_parameters namelist was found and read correctly. Enable salsa (salsa switch in
-!--    modules.f90).
-       IF ( .NOT. switch_off_module )  salsa = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    salsa_parameters namelist was found but contained errors. Print an error message including
-!--    the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'salsa_parameters', line )
-
-    ENDIF
-
-!
-!-- Update the number of output profiles
-    max_pr_salsa_tmp = 0
-    i = 1
-    DO WHILE ( data_output_pr(i) /= ' '  .AND.  i <= 100 )
-       IF ( TRIM( data_output_pr(i)(1:6) ) == 'salsa_' )  max_pr_salsa_tmp = max_pr_salsa_tmp + 1
-       i = i + 1
-    ENDDO
-    IF ( max_pr_salsa_tmp > 0 )  max_pr_salsa = max_pr_salsa_tmp
-
- END SUBROUTINE salsa_parin
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for salsa.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_check_parameters
-
-    USE control_parameters,                                                                        &
-        ONLY:  child_domain, humidity, initializing_actions, nesting_offline
-
-    IMPLICIT NONE
-
-!
-!-- Check that humidity is switched on
-    IF ( salsa  .AND.  .NOT.  humidity )  THEN
-       WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity
-       CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- For nested runs, explicitly set nesting boundary conditions.
-    IF ( child_domain )  THEN
-       IF ( nesting_salsa )  THEN
-          bc_aer_t = 'nested'
-       ELSE
-          bc_aer_t = 'neumann'
-       ENDIF
-    ENDIF
-!
-!-- Set boundary conditions also in case the model is offline-nested in larger-scale models.
-    IF ( nesting_offline )  THEN
-       IF ( nesting_offline_salsa )  THEN
-          bc_aer_t = 'nesting_offline'
-       ELSE
-          bc_aer_t = 'neumann'
-       ENDIF
-    ENDIF
-!
-!-- Set bottom boundary condition flag
-    IF ( bc_aer_b == 'dirichlet' )  THEN
-       ibc_aer_b = 0
-    ELSEIF ( bc_aer_b == 'neumann' )  THEN
-       ibc_aer_b = 1
-    ELSE
-       message_string = 'unknown boundary condition: bc_aer_b = "' // TRIM( bc_aer_t ) // '"'
-       CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Set top boundary conditions flag
-    IF ( bc_aer_t == 'dirichlet' )  THEN
-       ibc_aer_t = 0
-    ELSEIF ( bc_aer_t == 'neumann' )  THEN
-       ibc_aer_t = 1
-    ELSEIF ( bc_aer_t == 'initial_gradient' )  THEN
-       ibc_aer_t = 2
-    ELSEIF ( bc_aer_t == 'nested'  .OR.  bc_aer_t == 'nesting_offline' )  THEN
-       ibc_aer_t = 3
-    ELSE
-       message_string = 'unknown boundary condition: bc_aer_t = "' // TRIM( bc_aer_t ) // '"'
-       CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check J3 parametrisation
-    IF ( nj3 < 1  .OR.  nj3 > 3 )  THEN
-       message_string = 'unknown nj3 (must be 1-3)'
-       CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check bottom boundary condition in case of surface emissions
-    IF ( salsa_emission_mode /= 'no_emission'  .AND.  ibc_aer_b  == 0 ) THEN
-       message_string = 'salsa_emission_mode /= "no_emission" requires bc_aer_b = "Neumann"'
-       CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check left and right boundary conditions. First set default value if not set by user.
-    IF ( bc_aer_l == 'undefined' )  THEN
-       IF ( bc_lr == 'cyclic' )  THEN
-          bc_aer_l = 'cyclic'
-       ELSEIF ( bc_lr == 'dirichlet/radiation' )  THEN
-          bc_aer_l = 'dirichlet'
-       ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
-          bc_aer_l = 'neumann'
-       ENDIF
-    ENDIF
-    IF ( bc_aer_r == 'undefined' )  THEN
-       IF ( bc_lr == 'cyclic' )  THEN
-          bc_aer_r = 'cyclic'
-       ELSEIF ( bc_lr == 'dirichlet/radiation' )  THEN
-          bc_aer_r = 'neumann'
-       ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
-          bc_aer_r = 'dirichlet'
-       ENDIF
-    ENDIF
-    IF ( bc_aer_l /= 'dirichlet'  .AND.  bc_aer_l /= 'neumann'  .AND.  bc_aer_l /= 'cyclic' )  THEN
-       message_string = 'unknown boundary condition: bc_aer_l = "' // TRIM( bc_aer_l ) // '"'
-       CALL message( 'salsa_check_parameters','PA0626', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( bc_aer_r /= 'dirichlet'  .AND.  bc_aer_r /= 'neumann'  .AND.  bc_aer_r /= 'cyclic' )  THEN
-       message_string = 'unknown boundary condition: bc_aer_r = "' // TRIM( bc_aer_r ) // '"'
-       CALL message( 'salsa_check_parameters','PA0627', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check north and south boundary conditions. First set default value if not set by user.
-    IF ( bc_aer_n == 'undefined' )  THEN
-       IF ( bc_ns == 'cyclic' )  THEN
-          bc_aer_n = 'cyclic'
-       ELSEIF ( bc_ns == 'dirichlet/radiation' )  THEN
-          bc_aer_n = 'dirichlet'
-       ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
-          bc_aer_n = 'neumann'
-       ENDIF
-    ENDIF
-    IF ( bc_aer_s == 'undefined' )  THEN
-       IF ( bc_ns == 'cyclic' )  THEN
-          bc_aer_s = 'cyclic'
-       ELSEIF ( bc_ns == 'dirichlet/radiation' )  THEN
-          bc_aer_s = 'neumann'
-       ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
-          bc_aer_s = 'dirichlet'
-       ENDIF
-    ENDIF
-    IF ( bc_aer_n /= 'dirichlet'  .AND.  bc_aer_n /= 'neumann'  .AND.  bc_aer_n /= 'cyclic' )  THEN
-       message_string = 'unknown boundary condition: bc_aer_n = "' // TRIM( bc_aer_n ) // '"'
-       CALL message( 'salsa_check_parameters','PA0709', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( bc_aer_s /= 'dirichlet'  .AND.  bc_aer_s /= 'neumann'  .AND.  bc_aer_s /= 'cyclic' )  THEN
-       message_string = 'unknown boundary condition: bc_aer_s = "' // TRIM( bc_aer_s ) // '"'
-       CALL message( 'salsa_check_parameters','PA0711', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Cyclic conditions must be set identically at opposing boundaries
-    IF ( ( bc_aer_l == 'cyclic' .AND. bc_aer_r /= 'cyclic' )  .OR.                                 &
-         ( bc_aer_r == 'cyclic' .AND. bc_aer_l /= 'cyclic' ) )  THEN
-       message_string = 'boundary conditions bc_aer_l and bc_aer_r must both be cyclic or non-cyclic'
-       CALL message( 'salsa_check_parameters','PA0712', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( ( bc_aer_n == 'cyclic' .AND. bc_aer_s /= 'cyclic' )  .OR.                                 &
-         ( bc_aer_s == 'cyclic' .AND. bc_aer_n /= 'cyclic' ) )  THEN
-       message_string = 'boundary conditions bc_aer_n and bc_aer_s must both be cyclic or non-cyclic'
-       CALL message( 'salsa_check_parameters','PA0713', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Set the switches that control application of horizontal boundary conditions at the boundaries
-!-- of the total domain
-    IF ( bc_aer_n == 'dirichlet'  .AND.  nyn == ny )  bc_dirichlet_aer_n = .TRUE.
-    IF ( bc_aer_n == 'neumann'    .AND.  nyn == ny )  bc_radiation_aer_n = .TRUE.
-    IF ( bc_aer_s == 'dirichlet'  .AND.  nys ==  0 )  bc_dirichlet_aer_s = .TRUE.
-    IF ( bc_aer_s == 'neumann'    .AND.  nys ==  0 )  bc_radiation_aer_s = .TRUE.
-    IF ( bc_aer_l == 'dirichlet'  .AND.  nxl ==  0 )  bc_dirichlet_aer_l = .TRUE.
-    IF ( bc_aer_l == 'neumann'    .AND.  nxl ==  0 )  bc_radiation_aer_l = .TRUE.
-    IF ( bc_aer_r == 'dirichlet'  .AND.  nxr == nx )  bc_dirichlet_aer_r = .TRUE.
-    IF ( bc_aer_r == 'neumann'    .AND.  nxr == nx )  bc_radiation_aer_r = .TRUE.
-!
-!-- Set the communicator to be used for ghost layer data exchange
-!-- 1: cyclic, 2: cyclic along x, 3: cyclic along y, 4: non-cyclic
-    IF ( bc_aer_l == 'cyclic' )  THEN
-       IF ( bc_aer_s == 'cyclic' )  THEN
-          communicator_salsa = 1
-       ELSE
-          communicator_salsa = 2
-       ENDIF
-    ELSE
-       IF ( bc_aer_s == 'cyclic' )  THEN
-          communicator_salsa = 3
-       ELSE
-          communicator_salsa = 4
-       ENDIF
-    ENDIF
-!
-!-- Check whether emissions are applied
-    IF ( salsa_emission_mode /= 'no_emission' )  include_emission = .TRUE.
-!
-!-- Set the initialisation type: background concentration are read from PIDS_DYNAMIC if
-!-- initializing_actions = 'inifor set_constant_profiles'
-    IF ( INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
-       init_aerosol_type = 1
-       init_gases_type = 1
-    ENDIF
-!
-!-- If the run is not a restart run, set read_restart_data to .FALSE.
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-       read_restart_data_salsa = .FALSE.
-    ENDIF
-
- END SUBROUTINE salsa_check_parameters
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining appropriate grid for netcdf variables.
-!> It is called out from subroutine netcdf.
-!> Same grid as for other scalars (see netcdf_interface_mod.f90)
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_x   !<
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_y   !<
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_z   !<
-    CHARACTER(LEN=*), INTENT(IN)  ::  var      !<
-
-    LOGICAL, INTENT(OUT) ::  found   !<
-
-    found  = .TRUE.
-!
-!-- Check for the grid
-
-    IF ( var(1:6) == 'salsa_' )  THEN  ! same grid for all salsa output variables
-       grid_x = 'x'
-       grid_y = 'y'
-       grid_z = 'zu'
-    ELSE
-       found  = .FALSE.
-       grid_x = 'none'
-       grid_y = 'none'
-       grid_z = 'none'
-    ENDIF
-
- END SUBROUTINE salsa_define_netcdf_grid
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for new module
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_header( io )
-
-    USE indices,                                                                                   &
-        ONLY:  nx, ny, nz
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  io   !< Unit of the output file
-!
-!-- Write SALSA header
-    WRITE( io, 1 )
-    WRITE( io, 2 ) skip_time_do_salsa
-    WRITE( io, 3 ) dt_salsa
-    WRITE( io, 4 )  nz, ny, nx, nbins_aerosol
-    IF ( advect_particle_water )  THEN
-       WRITE( io, 5 )  nz, ny, nx, ncomponents_mass*nbins_aerosol, advect_particle_water
-    ELSE
-       WRITE( io, 5 )  nz, ny, nx, ncc*nbins_aerosol, advect_particle_water
-    ENDIF
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       WRITE( io, 6 )  nz, ny, nx, ngases_salsa, salsa_gases_from_chem
-    ENDIF
-    WRITE( io, 7 )
-    IF ( nsnucl > 0 )   WRITE( io, 8 ) nsnucl, nj3
-    IF ( nlcoag )       WRITE( io, 9 )
-    IF ( nlcnd )        WRITE( io, 10 ) nlcndgas, nlcndh2oae
-    IF ( lspartition )  WRITE( io, 11 )
-    IF ( nldepo )       WRITE( io, 12 ) nldepo_pcm, nldepo_surf
-    WRITE( io, 13 )  reglim, nbin, ( aero(:)%vlolim / api6 )**0.33333333_wp
-    WRITE( io, 25 )  aero(:)%dmid
-    IF ( init_aerosol_type == 0 )  WRITE( io, 14 ) nsect
-    WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init
-    ENDIF
-    WRITE( io, 17 )  init_aerosol_type, init_gases_type
-    IF ( init_aerosol_type == 0 )  THEN
-       WRITE( io, 18 )  dpg, sigmag, n_lognorm
-    ELSE
-       WRITE( io, 19 )
-    ENDIF
-    IF ( nesting_salsa )  WRITE( io, 20 )  nesting_salsa
-    IF ( nesting_offline_salsa )  WRITE( io, 21 )  nesting_offline_salsa
-    WRITE( io, 22 ) salsa_emission_mode
-    IF ( salsa_emission_mode == 'uniform' )  THEN
-       WRITE( io, 23 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag,                &
-                       aerosol_flux_mass_fracs_a
-    ENDIF
-    IF ( salsa_emission_mode == 'read_from_file' ) &
-    THEN
-       WRITE( io, 24 )
-    ENDIF
-    WRITE( io, 26 )  TRIM( bc_aer_b ), TRIM( bc_aer_t ), TRIM( bc_aer_s ), TRIM( bc_aer_n ),       &
-                     TRIM( bc_aer_l ), TRIM( bc_aer_r )
-
-1   FORMAT (//' SALSA information:'/                                                               &
-              ' ------------------------------'/)
-2   FORMAT ('    Starts at: skip_time_do_salsa = ', F10.2, '  s')
-3   FORMAT (/'    Timestep: dt_salsa = ', F6.2, '  s')
-4   FORMAT (/'    Array shape (z,y,x,bins):'/                                                      &
-             '       aerosol_number:  ', 4(I5))
-5   FORMAT (/'       aerosol_mass:    ', 4(I5),/                                                   &
-             '       (advect_particle_water = ', L1, ')')
-6   FORMAT ( '       salsa_gas: ', 4(I5),/                                                         &
-             '       (salsa_gases_from_chem = ', L1, ')')
-7   FORMAT (/'    Aerosol dynamic processes included: ')
-8   FORMAT (/'       nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')')
-9   FORMAT (/'       coagulation')
-10  FORMAT (/'       condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' )
-11  FORMAT (/'       dissolutional growth by HNO3 and NH3')
-12  FORMAT (/'       dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')')
-13  FORMAT (/'    Aerosol bin subrange limits (in metres): ',  3(ES10.2E3), /                      &
-             '    Number of size bins for each aerosol subrange: ', 2I3,/                          &
-             '    Aerosol bin lower limits (in metres): ', 12(ES10.2E3))
-25  FORMAT (/'    Bin geometric mean diameters (in metres): ', 12(ES10.2E3))
-14  FORMAT  ('    Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3))
-15  FORMAT (/'    Number of chemical components used: ', I1,/                                      &
-             '       Species: ',7(A6),/                                                            &
-             '    Initial relative contribution of each species to particle volume in:',/          &
-             '       a-bins: ', 7(F6.3),/                                                          &
-             '       b-bins: ', 7(F6.3))
-16  FORMAT (/'    Number of gaseous tracers used: ', I1,/                                          &
-             '    Initial gas concentrations:',/                                                   &
-             '       H2SO4: ',ES12.4E3, ' #/m**3',/                                                &
-             '       HNO3:  ',ES12.4E3, ' #/m**3',/                                                &
-             '       NH3:   ',ES12.4E3, ' #/m**3',/                                                &
-             '       OCNV:  ',ES12.4E3, ' #/m**3',/                                                &
-             '       OCSV:  ',ES12.4E3, ' #/m**3')
-17  FORMAT (/'   Initialising concentrations: ', /                                                 &
-             '      Aerosol size distribution: init_aerosol_type = ', I1,/                         &
-             '      Gas concentrations: init_gases_type = ', I1 )
-18  FORMAT ( '      Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', /                              &
-             '      Standard deviation: sigmag(nmod) = ', 7(F7.2),/                                &
-             '      Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' )
-19  FORMAT (/'      Size distribution read from a file.')
-20  FORMAT (/'   Nesting for salsa variables: ', L1 )
-21  FORMAT (/'   Offline nesting for salsa variables: ', L1 )
-22  FORMAT (/'   Emissions: salsa_emission_mode = ', A )
-23  FORMAT (/'      surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', /                             &
-             '      aerosol_flux_dpg     =  ', 7(F7.3), ' (m)', /                                  &
-             '      aerosol_flux_sigmag  =  ', 7(F7.2), /                                          &
-             '      aerosol_mass_fracs_a =  ', 7(ES12.4E3) )
-24  FORMAT (/'      (currently all emissions are soluble!)')
-26  FORMAT (/'   Boundary conditions for aerosols:', /                                             &
-             '      bottom/top:   ',A10,' / ',A10, /                                               &
-             '      north/south:  ',A10,' / ',A10, /                                               &
-             '      left/right:   ',A10,' / ',A10)
-
- END SUBROUTINE salsa_header
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate SALSA arrays and define pointers if required
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_init_arrays
-
-    USE advec_ws,                                                                                  &
-        ONLY: ws_init_flags_scalar
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  gases_available !< Number of available gas components in the chemistry model
-    INTEGER(iwp) ::  i               !< loop index for allocating
-    INTEGER(iwp) ::  ii              !< index for indexing chemical components
-    INTEGER(iwp) ::  l               !< loop index for allocating: surfaces
-    INTEGER(iwp) ::  lsp             !< loop index for chem species in the chemistry model
-
-    gases_available = 0
-!
-!-- Allocate prognostic variables (see salsa_swap_timelevel)
-!
-!-- Set derived indices:
-!-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA)
-    start_subrange_1a = 1  ! 1st index of subrange 1a
-    start_subrange_2a = start_subrange_1a + nbin(1)  ! 1st index of subrange 2a
-    end_subrange_1a   = start_subrange_2a - 1        ! last index of subrange 1a
-    end_subrange_2a   = end_subrange_1a + nbin(2)    ! last index of subrange 2a
-
-!
-!-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them
-    IF ( nf2a > 0.999999_wp  .AND.  SUM( mass_fracs_b ) < 0.00001_wp )  THEN
-       no_insoluble = .TRUE.
-       start_subrange_2b = end_subrange_2a+1  ! 1st index of subrange 2b
-       end_subrange_2b   = end_subrange_2a    ! last index of subrange 2b
-    ELSE
-       start_subrange_2b = start_subrange_2a + nbin(2)  ! 1st index of subrange 2b
-       end_subrange_2b   = end_subrange_2a + nbin(2)    ! last index of subrange 2b
-    ENDIF
-
-    nbins_aerosol = end_subrange_2b   ! total number of aerosol size bins
-!
-!-- Create index tables for different aerosol components
-    CALL component_index_constructor( prtcl, ncc, maxspec, listspec )
-
-    ncomponents_mass = ncc
-    IF ( advect_particle_water )  ncomponents_mass = ncc + 1  ! Add water
-!
-!-- Indices for chemical components used (-1 = not used)
-    ii = 0
-    IF ( is_used( prtcl, 'SO4' ) )  THEN
-       index_so4 = get_index( prtcl,'SO4' )
-       ii = ii + 1
-    ENDIF
-    IF ( is_used( prtcl,'OC' ) )  THEN
-       index_oc = get_index(prtcl, 'OC')
-       ii = ii + 1
-    ENDIF
-    IF ( is_used( prtcl, 'BC' ) )  THEN
-       index_bc = get_index( prtcl, 'BC' )
-       ii = ii + 1
-    ENDIF
-    IF ( is_used( prtcl, 'DU' ) )  THEN
-       index_du = get_index( prtcl, 'DU' )
-       ii = ii + 1
-    ENDIF
-    IF ( is_used( prtcl, 'SS' ) )  THEN
-       index_ss = get_index( prtcl, 'SS' )
-       ii = ii + 1
-    ENDIF
-    IF ( is_used( prtcl, 'NO' ) )  THEN
-       index_no = get_index( prtcl, 'NO' )
-       ii = ii + 1
-    ENDIF
-    IF ( is_used( prtcl, 'NH' ) )  THEN
-       index_nh = get_index( prtcl, 'NH' )
-       ii = ii + 1
-    ENDIF
-!
-!-- All species must be known
-    IF ( ii /= ncc )  THEN
-       message_string = 'Unknown aerosol species/component(s) given in the initialization'
-       CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Allocate:
-    ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass),                    &
-              bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),&
-              nsect(nbins_aerosol), massacc(nbins_aerosol) )
-    ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) )
-    IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-    ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-!
-!-- Initialise the sectional particle size distribution
-    CALL set_sizebins
-!
-!-- Aerosol number concentration
-    ALLOCATE( aerosol_number(nbins_aerosol) )
-    ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol),                                &
-              nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol),                                &
-              nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-    nconc_1 = 0.0_wp
-    nconc_2 = 0.0_wp
-    nconc_3 = 0.0_wp
-
-    DO i = 1, nbins_aerosol
-       aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => nconc_1(:,:,:,i)
-       aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => nconc_2(:,:,:,i)
-       aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i)
-       ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),                         &
-                 aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),                         &
-                 aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                 &
-                 aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                 &
-                 aerosol_number(i)%init(nzb:nzt+1),                                                &
-                 aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-       aerosol_number(i)%init = nclim
-       IF ( include_emission  .OR.  ( nldepo  .AND.  nldepo_surf ) )  THEN
-          ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) )
-          aerosol_number(i)%source = 0.0_wp
-       ENDIF
-    ENDDO
-
-!
-!-- Aerosol mass concentration
-    ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) )
-    ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol),               &
-              mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol),               &
-              mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) )
-    mconc_1 = 0.0_wp
-    mconc_2 = 0.0_wp
-    mconc_3 = 0.0_wp
-
-    DO i = 1, ncomponents_mass*nbins_aerosol
-       aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => mconc_1(:,:,:,i)
-       aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => mconc_2(:,:,:,i)
-       aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i)
-       ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),                           &
-                 aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),                           &
-                 aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                   &
-                 aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),                   &
-                 aerosol_mass(i)%init(nzb:nzt+1),                                                  &
-                 aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1)  )
-       aerosol_mass(i)%init = mclim
-       IF ( include_emission  .OR.  ( nldepo  .AND.  nldepo_surf ) )  THEN
-          ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) )
-          aerosol_mass(i)%source = 0.0_wp
-       ENDIF
-    ENDDO
-
-!
-!-- Surface fluxes: answs = aerosol number, amsws = aerosol mass
-!
-!-- Horizontal surfaces: default type
-    DO  l = 0, 2   ! upward (l=0), downward (l=1) and model top (l=2)
-       ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) )
-       ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
-       surf_def_h(l)%answs = 0.0_wp
-       surf_def_h(l)%amsws = 0.0_wp
-    ENDDO
-!
-!-- Horizontal surfaces: natural and urban type
-    DO l = 0, 1
-       ALLOCATE( surf_lsm_h(l)%answs( 1:surf_lsm_h(l)%ns, nbins_aerosol ) )
-       ALLOCATE( surf_lsm_h(l)%amsws( 1:surf_lsm_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
-       surf_lsm_h(l)%answs = 0.0_wp
-       surf_lsm_h(l)%amsws = 0.0_wp
-
-       ALLOCATE( surf_usm_h(l)%answs( 1:surf_usm_h(l)%ns, nbins_aerosol ) )
-       ALLOCATE( surf_usm_h(l)%amsws( 1:surf_usm_h(l)%ns, nbins_aerosol*ncomponents_mass ) )
-       surf_usm_h(l)%answs = 0.0_wp
-       surf_usm_h(l)%amsws = 0.0_wp
-    ENDDO
-!
-!-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing
-    DO  l = 0, 3
-       ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) )
-       surf_def_v(l)%answs = 0.0_wp
-       ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
-       surf_def_v(l)%amsws = 0.0_wp
-
-       ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) )
-       surf_lsm_v(l)%answs = 0.0_wp
-       ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
-       surf_lsm_v(l)%amsws = 0.0_wp
-
-       ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) )
-       surf_usm_v(l)%answs = 0.0_wp
-       ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) )
-       surf_usm_v(l)%amsws = 0.0_wp
-
-    ENDDO
-
-!
-!-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV)
-!-- (number concentration (#/m3) )
-!
-!-- If chemistry is on, read gas phase concentrations from there. Otherwise,
-!-- allocate salsa_gas array.
-
-    IF ( air_chemistry )  THEN
-       DO  lsp = 1, nvar
-          SELECT CASE ( TRIM( chem_species(lsp)%name ) )
-             CASE ( 'H2SO4', 'h2so4' )
-                gases_available = gases_available + 1
-                gas_index_chem(1) = lsp
-             CASE ( 'HNO3', 'hno3' )
-                gases_available = gases_available + 1
-                gas_index_chem(2) = lsp
-             CASE ( 'NH3', 'nh3' )
-                gases_available = gases_available + 1
-                gas_index_chem(3) = lsp
-             CASE ( 'OCNV', 'ocnv' )
-                gases_available = gases_available + 1
-                gas_index_chem(4) = lsp
-             CASE ( 'OCSV', 'ocsv' )
-                gases_available = gases_available + 1
-                gas_index_chem(5) = lsp
-          END SELECT
-       ENDDO
-
-       IF ( gases_available == ngases_salsa )  THEN
-          salsa_gases_from_chem = .TRUE.
-       ELSE
-          WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// &
-                                     'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)'
-       CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ELSE
-
-       ALLOCATE( salsa_gas(ngases_salsa) )
-       ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa),                 &
-                 gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa),                 &
-                 gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
-       gconc_1 = 0.0_wp
-       gconc_2 = 0.0_wp
-       gconc_3 = 0.0_wp
-
-       DO i = 1, ngases_salsa
-          salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => gconc_1(:,:,:,i)
-          salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => gconc_2(:,:,:,i)
-          salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i)
-          ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1),       &
-                    salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1),       &
-                    salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
-                    salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),&
-                    salsa_gas(i)%init(nzb:nzt+1),                              &
-                    salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-          salsa_gas(i)%init = nclim
-          IF ( include_emission )  THEN
-             ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) )
-             salsa_gas(i)%source = 0.0_wp
-          ENDIF
-       ENDDO
-!
-!--    Surface fluxes: gtsws = gaseous tracer flux
-!
-!--    Horizontal surfaces: default type
-       DO  l = 0, 2   ! upward (l=0), downward (l=1) and model top (l=2)
-          ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) )
-          surf_def_h(l)%gtsws = 0.0_wp
-       ENDDO
-!--    Horizontal surfaces: natural and urban type
-       DO l = 0, 1
-          ALLOCATE( surf_lsm_h(l)%gtsws( 1:surf_lsm_h(l)%ns, ngases_salsa ) )
-          surf_lsm_h(l)%gtsws = 0.0_wp
-          ALLOCATE( surf_usm_h(l)%gtsws( 1:surf_usm_h(l)%ns, ngases_salsa ) )
-          surf_usm_h(l)%gtsws = 0.0_wp
-       ENDDO
-!
-!--    Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and
-!--    westward (l=3) facing
-       DO  l = 0, 3
-          ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) )
-          surf_def_v(l)%gtsws = 0.0_wp
-          ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) )
-          surf_lsm_v(l)%gtsws = 0.0_wp
-          ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) )
-          surf_usm_v(l)%gtsws = 0.0_wp
-       ENDDO
-    ENDIF
-
-    IF ( ws_scheme_sca )  THEN
-
-       IF ( salsa )  THEN
-          ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-          sums_salsa_ws_l = 0.0_wp
-       ENDIF
-
-    ENDIF
-
-!
-!-- Large gradients near the boundaries may produce
-!-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is
-!-- applied near these boundaries. To get rid-off this, set-up additional flags that control the
-!-- order of the scalar advection scheme near the lateral boundaries for passive scalars with
-!-- decycling.
-    IF ( scalar_advec == 'ws-scheme' )  THEN
-
-       ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!
-!--    Bit 31 is used to identify extended degradation zones (please see
-!--    the following comment). Note, since several also other modules may access this bit but may
-!--    have other boundary conditions, the original value of wall_flags_total_0 bit 31 must not be
-!--    modified. Hence, store the boundary conditions directly on salsa_advc_flags_s.
-!--    salsa_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used
-!--    to control the numerical order.
-!--    Initialize with flag 31 only.
-       salsa_advc_flags_s = 0
-       salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_total_0, 31 ) )
-
-!
-!--    To initialise the advection flags appropriately, pass the boundary flags to
-!--    ws_init_flags_scalar. The last argument in ws_init_flags_scalar indicates that a passive
-!--    scalar is being treated and the horizontal advection terms are degraded already 2 grid points
-!--    before the lateral boundary. Also, extended degradation zones are applied, where
-!--    horizontal advection of scalars is discretised by the first-order scheme at all grid points
-!--    in the vicinity of buildings (<= 3 grid points). Even though no building is within the
-!--    numerical stencil, the first-order scheme is used. At fourth and fifth grid points, the order
-!--    of the horizontal advection scheme is successively upgraded.
-!--    These degradations of the advection scheme are done to avoid stationary numerical
-!--    oscillations, which are responsible for high concentration maxima that may appear e.g. under
-!--    shear-free stable conditions.
-       CALL ws_init_flags_scalar( bc_dirichlet_aer_l  .OR.  bc_radiation_aer_l,                    &
-                                  bc_dirichlet_aer_n  .OR.  bc_radiation_aer_n,                    &
-                                  bc_dirichlet_aer_r  .OR.  bc_radiation_aer_r,                    &
-                                  bc_dirichlet_aer_s  .OR.  bc_radiation_aer_s,                    &
-                                  salsa_advc_flags_s, .TRUE. )
-    ENDIF
-
-
- END SUBROUTINE salsa_init_arrays
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA.
-!> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are
-!> also merged here.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_init
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: i   !<
-    INTEGER(iwp) :: ib  !< loop index for aerosol number bins
-    INTEGER(iwp) :: ic  !< loop index for aerosol mass bins
-    INTEGER(iwp) :: ig  !< loop index for gases
-    INTEGER(iwp) :: j   !<
-
-    IF ( debug_output )  CALL debug_message( 'salsa_init', 'start' )
-
-    bin_low_limits = 0.0_wp
-    k_topo_top     = 0
-    nsect          = 0.0_wp
-    massacc        = 1.0_wp
-!
-!-- Initialise
-    IF ( nldepo )  sedim_vd = 0.0_wp
-
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       IF ( .NOT. read_restart_data_salsa )  THEN
-          salsa_gas(1)%conc = h2so4_init
-          salsa_gas(2)%conc = hno3_init
-          salsa_gas(3)%conc = nh3_init
-          salsa_gas(4)%conc = ocnv_init
-          salsa_gas(5)%conc = ocsv_init
-       ENDIF
-       DO  ig = 1, ngases_salsa
-          salsa_gas(ig)%conc_p    = 0.0_wp
-          salsa_gas(ig)%tconc_m   = 0.0_wp
-          salsa_gas(ig)%flux_s    = 0.0_wp
-          salsa_gas(ig)%diss_s    = 0.0_wp
-          salsa_gas(ig)%flux_l    = 0.0_wp
-          salsa_gas(ig)%diss_l    = 0.0_wp
-          salsa_gas(ig)%sums_ws_l = 0.0_wp
-          salsa_gas(ig)%conc_p    = salsa_gas(ig)%conc
-       ENDDO
-!
-!--    Set initial value for gas compound tracer
-       salsa_gas(1)%init = h2so4_init
-       salsa_gas(2)%init = hno3_init
-       salsa_gas(3)%init = nh3_init
-       salsa_gas(4)%init = ocnv_init
-       salsa_gas(5)%init = ocsv_init
-    ENDIF
-!
-!-- Aerosol radius in each bin: dry and wet (m)
-    ra_dry = 1.0E-10_wp
-!
-!-- Initialise location-dependent aerosol size distributions and chemical compositions:
-    CALL aerosol_init
-
-!-- Initalisation run of SALSA + calculate the vertical top index of the topography
-    DO  i = nxlg, nxrg
-       DO  j = nysg, nyng
-
-          k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,j,i), 12 ) ), &
-                                       DIM = 1 ) - 1
-
-          CALL salsa_driver( i, j, 1 )
-          CALL salsa_diagnostics( i, j )
-       ENDDO
-    ENDDO
-
-    DO  ib = 1, nbins_aerosol
-       aerosol_number(ib)%conc_p    = aerosol_number(ib)%conc
-       aerosol_number(ib)%tconc_m   = 0.0_wp
-       aerosol_number(ib)%flux_s    = 0.0_wp
-       aerosol_number(ib)%diss_s    = 0.0_wp
-       aerosol_number(ib)%flux_l    = 0.0_wp
-       aerosol_number(ib)%diss_l    = 0.0_wp
-       aerosol_number(ib)%sums_ws_l = 0.0_wp
-    ENDDO
-    DO  ic = 1, ncomponents_mass*nbins_aerosol
-       aerosol_mass(ic)%conc_p    = aerosol_mass(ic)%conc
-       aerosol_mass(ic)%tconc_m   = 0.0_wp
-       aerosol_mass(ic)%flux_s    = 0.0_wp
-       aerosol_mass(ic)%diss_s    = 0.0_wp
-       aerosol_mass(ic)%flux_l    = 0.0_wp
-       aerosol_mass(ic)%diss_l    = 0.0_wp
-       aerosol_mass(ic)%sums_ws_l = 0.0_wp
-    ENDDO
-!
-!
-!-- Initialise the deposition scheme and surface types
-    IF ( nldepo )  CALL init_deposition
-
-    IF ( include_emission )  THEN
-!
-!--    Read in and initialize emissions
-       CALL salsa_emission_setup( .TRUE. )
-       IF ( .NOT. salsa_gases_from_chem  .AND.  salsa_emission_mode == 'read_from_file' )  THEN
-          CALL salsa_gas_emission_setup( .TRUE. )
-       ENDIF
-    ENDIF
-!
-!-- Partition and dissolutional growth by gaseous HNO3 and NH3
-    IF ( index_no > 0  .AND.  index_nh > 0  .AND.  index_so4 > 0 )  lspartition = .TRUE.
-
-    IF ( debug_output )  CALL debug_message( 'salsa_init', 'end' )
-
- END SUBROUTINE salsa_init
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initializes particle size distribution grid by calculating size bin limits
-!> and mid-size for *dry* particles in each bin. Called from salsa_initialize
-!> (only at the beginning of simulation).
-!> Size distribution described using:
-!>   1) moving center method (subranges 1 and 2)
-!>      (Jacobson, Atmos. Env., 31, 131-144, 1997)
-!>   2) fixed sectional method (subrange 3)
-!> Size bins in each subrange are spaced logarithmically
-!> based on given subrange size limits and bin number.
-!
-!> Mona changed 06/2017: Use geometric mean diameter to describe the mean
-!> particle diameter in a size bin, not the arithmeric mean which clearly
-!> overestimates the total particle volume concentration.
-!
-!> Coded by:
-!> Hannele Korhonen (FMI) 2005
-!> Harri Kokkola (FMI) 2006
-!
-!> Bug fixes for box model + updated for the new aerosol datatype:
-!> Juha Tonttila (FMI) 2014
-!------------------------------------------------------------------------------!
- SUBROUTINE set_sizebins
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  cc  !< running index
-    INTEGER(iwp) ::  dd  !< running index
-
-    REAL(wp) ::  ratio_d  !< ratio of the upper and lower diameter of subranges
-
-    aero(:)%dwet     = 1.0E-10_wp
-    aero(:)%veqh2o   = 1.0E-10_wp
-    aero(:)%numc     = nclim
-    aero(:)%core     = 1.0E-10_wp
-    DO  cc = 1, maxspec+1    ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O
-       aero(:)%volc(cc) = 0.0_wp
-    ENDDO
-!
-!-- vlolim&vhilim: min & max *dry* volumes [fxm]
-!-- dmid: bin mid *dry* diameter (m)
-!-- vratiolo&vratiohi: volume ratio between the center and low/high limit
-!
-!-- 1) Size subrange 1:
-    ratio_d = reglim(2) / reglim(1)   ! section spacing (m)
-    DO  cc = start_subrange_1a, end_subrange_1a
-       aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d**( REAL( cc-1 ) / nbin(1) ) )**3
-       aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d**( REAL( cc ) / nbin(1) ) )**3
-       aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )**0.33333333_wp *                           &
-                             ( aero(cc)%vlolim / api6 )**0.33333333_wp )
-       aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 )
-       aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 )
-    ENDDO
-!
-!-- 2) Size subrange 2:
-!-- 2.1) Sub-subrange 2a: high hygroscopicity
-    ratio_d = reglim(3) / reglim(2)   ! section spacing
-    DO  dd = start_subrange_2a, end_subrange_2a
-       cc = dd - start_subrange_2a
-       aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d**( REAL( cc ) / nbin(2) ) )**3
-       aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d**( REAL( cc+1 ) / nbin(2) ) )**3
-       aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )**0.33333333_wp *                           &
-                             ( aero(dd)%vlolim / api6 )**0.33333333_wp )
-       aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 )
-       aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 )
-    ENDDO
-!
-!-- 2.2) Sub-subrange 2b: low hygroscopicity
-    IF ( .NOT. no_insoluble )  THEN
-       aero(start_subrange_2b:end_subrange_2b)%vlolim   = aero(start_subrange_2a:end_subrange_2a)%vlolim
-       aero(start_subrange_2b:end_subrange_2b)%vhilim   = aero(start_subrange_2a:end_subrange_2a)%vhilim
-       aero(start_subrange_2b:end_subrange_2b)%dmid     = aero(start_subrange_2a:end_subrange_2a)%dmid
-       aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi
-       aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo
-    ENDIF
-!
-!-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later
-    aero(:)%dwet = aero(:)%dmid
-!
-!-- Save bin limits (lower diameter) to be delivered to PALM if needed
-    DO cc = 1, nbins_aerosol
-       bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp
-    ENDDO
-
- END SUBROUTINE set_sizebins
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initilize altitude-dependent aerosol size distributions and compositions.
-!>
-!> Mona added 06/2017: Correct the number and mass concentrations by normalizing
-!< by the given total number and mass concentration.
-!>
-!> Tomi Raatikainen, FMI, 29.2.2016
-!------------------------------------------------------------------------------!
- SUBROUTINE aerosol_init
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  check_existence, close_input_file, get_dimension_length,                            &
-               get_attribute, get_variable,                                                        &
-               inquire_num_variables, inquire_variable_names,                                      &
-               open_read_file
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=25),  DIMENSION(:), ALLOCATABLE ::  cc_name    !< chemical component name
-    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< variable names
-
-    INTEGER(iwp) ::  ee        !< index: end
-    INTEGER(iwp) ::  i         !< loop index: x-direction
-    INTEGER(iwp) ::  ib        !< loop index: size bins
-    INTEGER(iwp) ::  ic        !< loop index: chemical components
-    INTEGER(iwp) ::  id_dyn    !< NetCDF id of PIDS_DYNAMIC_SALSA
-    INTEGER(iwp) ::  ig        !< loop index: gases
-    INTEGER(iwp) ::  j         !< loop index: y-direction
-    INTEGER(iwp) ::  k         !< loop index: z-direction
-    INTEGER(iwp) ::  lod_aero  !< level of detail of inital aerosol concentrations
-    INTEGER(iwp) ::  num_vars  !< number of variables
-    INTEGER(iwp) ::  pr_nbins  !< number of aerosol size bins in file
-    INTEGER(iwp) ::  pr_ncc    !< number of aerosol chemical components in file
-    INTEGER(iwp) ::  pr_nz     !< number of vertical grid-points in file
-    INTEGER(iwp) ::  prunmode  !< running mode of SALSA
-    INTEGER(iwp) ::  ss        !< index: start
-
-    INTEGER(iwp), DIMENSION(maxspec) ::  cc_in2mod
-
-    LOGICAL  ::  netcdf_extend = .FALSE. !< Flag: netcdf file exists
-
-    REAL(wp) ::  flag  !< flag to mask topography grid points
-
-    REAL(wp), DIMENSION(nbins_aerosol) ::  core   !< size of the bin mid aerosol particle
-
-    REAL(wp), DIMENSION(0:nz+1) ::  pnf2a   !< number fraction in 2a
-    REAL(wp), DIMENSION(0:nz+1) ::  pmfoc1a !< mass fraction of OC in 1a
-
-    REAL(wp), DIMENSION(0:nz+1,nbins_aerosol)   ::  pndist  !< vertical profile of size dist. (#/m3)
-    REAL(wp), DIMENSION(0:nz+1,maxspec)         ::  pmf2a   !< mass distributions in subrange 2a
-    REAL(wp), DIMENSION(0:nz+1,maxspec)         ::  pmf2b   !< mass distributions in subrange 2b
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pr_dmid  !< vertical profile of aerosol bin diameters
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pr_z     !< z levels of profiles
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_mass_fracs_a  !< mass fraction: a
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pr_mass_fracs_b  !< and b
-
-    cc_in2mod = 0
-    prunmode = 1
-!
-!-- Bin mean aerosol particle volume (m3)
-    core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
-!
-!-- Set concentrations to zero
-    pndist(:,:)  = 0.0_wp
-    pnf2a(:)     = nf2a
-    pmf2a(:,:)   = 0.0_wp
-    pmf2b(:,:)   = 0.0_wp
-    pmfoc1a(:)   = 0.0_wp
-
-    IF ( init_aerosol_type == 1 )  THEN
-!
-!--    Read input profiles from PIDS_DYNAMIC_SALSA
-#if defined( __netcdf )
-!
-!--    Location-dependent size distributions and compositions.
-       INQUIRE( FILE = TRIM( input_file_dynamic ) //  TRIM( coupling_char ), EXIST = netcdf_extend )
-       IF ( netcdf_extend )  THEN
-!
-!--       Open file in read-only mode
-          CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
-!
-!--       At first, inquire all variable names
-          CALL inquire_num_variables( id_dyn, num_vars )
-!
-!--       Allocate memory to store variable names
-          ALLOCATE( var_names(1:num_vars) )
-          CALL inquire_variable_names( id_dyn, var_names )
-!
-!--       Inquire vertical dimension and number of aerosol chemical components
-          CALL get_dimension_length( id_dyn, pr_nz, 'z' )
-          IF ( pr_nz /= nz )  THEN
-             WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
-                                        'the number of numeric grid points.'
-             CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 )
-          ENDIF
-          CALL get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
-!
-!--       Allocate memory
-          ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc),                              &
-                    pr_mass_fracs_b(nzb:nzt+1,pr_ncc) )
-          pr_mass_fracs_a = 0.0_wp
-          pr_mass_fracs_b = 0.0_wp
-!
-!--       Read vertical levels
-          CALL get_variable( id_dyn, 'z', pr_z )
-!
-!--       Read the names of chemical components
-          IF ( check_existence( var_names, 'composition_name' ) )  THEN
-             CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc )
-          ELSE
-             WRITE( message_string, * ) 'Missing composition_name in ' // TRIM( input_file_dynamic )
-             CALL message( 'aerosol_init', 'PA0655', 1, 2, 0, 6, 0 )
-          ENDIF
-!
-!--       Define the index of each chemical component in the model
-          DO  ic = 1, pr_ncc
-             SELECT CASE ( TRIM( cc_name(ic) ) )
-                CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
-                   cc_in2mod(1) = ic
-                CASE ( 'OC', 'oc' )
-                   cc_in2mod(2) = ic
-                CASE ( 'BC', 'bc' )
-                   cc_in2mod(3) = ic
-                CASE ( 'DU', 'du' )
-                   cc_in2mod(4) = ic
-                CASE ( 'SS', 'ss' )
-                   cc_in2mod(5) = ic
-                CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
-                   cc_in2mod(6) = ic
-                CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
-                   cc_in2mod(7) = ic
-             END SELECT
-          ENDDO
-
-          IF ( SUM( cc_in2mod ) == 0 )  THEN
-             message_string = 'None of the aerosol chemical components in ' // TRIM(               &
-                              input_file_dynamic ) // ' correspond to ones applied in SALSA.'
-             CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 )
-          ENDIF
-!
-!--       Vertical profiles of mass fractions of different chemical components:
-          IF ( check_existence( var_names, 'init_atmosphere_mass_fracs_a' ) )  THEN
-             CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a,           &
-                                0, pr_ncc-1, 0, pr_nz-1 )
-          ELSE
-             WRITE( message_string, * ) 'Missing init_atmosphere_mass_fracs_a in ' //              &
-                                        TRIM( input_file_dynamic )
-             CALL message( 'aerosol_init', 'PA0656', 1, 2, 0, 6, 0 )
-          ENDIF
-          CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b,              &
-                             0, pr_ncc-1, 0, pr_nz-1  )
-!
-!--       Match the input data with the chemical composition applied in the model
-          DO  ic = 1, maxspec
-             ss = cc_in2mod(ic)
-             IF ( ss == 0 )  CYCLE
-             pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss)
-             pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss)
-          ENDDO
-!
-!--       Aerosol concentrations: lod=1 (vertical profile of sectional number size distribution)
-          CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' )
-          IF ( lod_aero /= 1 )  THEN
-             message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol'
-             CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 )
-          ELSE
-!
-!--          Bin mean diameters in the input file
-             CALL get_dimension_length( id_dyn, pr_nbins, 'Dmid')
-             IF ( pr_nbins /= nbins_aerosol )  THEN
-                message_string = 'Number of size bins in init_atmosphere_aerosol does not match '  &
-                                 // 'with that applied in the model'
-                CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 )
-             ENDIF
-
-             ALLOCATE( pr_dmid(pr_nbins) )
-             pr_dmid    = 0.0_wp
-
-             CALL get_variable( id_dyn, 'Dmid', pr_dmid )
-!
-!--          Check whether the sectional representation conform to the one
-!--          applied in the model
-             IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) /                             &
-                              aero(1:nbins_aerosol)%dmid )  > 0.1_wp )  ) THEN
-                message_string = 'Mean diameters of the aerosol size bins in ' // TRIM(            &
-                                 input_file_dynamic ) // ' do not match with the sectional '//     &
-                                 'representation of the model.'
-                CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 )
-             ENDIF
-!
-!--          Inital aerosol concentrations
-             CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:),            &
-                                0, pr_nbins-1, 0, pr_nz-1 )
-          ENDIF
-!
-!--       Set bottom and top boundary condition (Neumann)
-          pmf2a(nzb,:)    = pmf2a(nzb+1,:)
-          pmf2a(nzt+1,:)  = pmf2a(nzt,:)
-          pmf2b(nzb,:)    = pmf2b(nzb+1,:)
-          pmf2b(nzt+1,:)  = pmf2b(nzt,:)
-          pndist(nzb,:)   = pndist(nzb+1,:)
-          pndist(nzt+1,:) = pndist(nzt,:)
-
-          IF ( index_so4 < 0 )  THEN
-             pmf2a(:,1) = 0.0_wp
-             pmf2b(:,1) = 0.0_wp
-          ENDIF
-          IF ( index_oc < 0 )  THEN
-             pmf2a(:,2) = 0.0_wp
-             pmf2b(:,2) = 0.0_wp
-          ENDIF
-          IF ( index_bc < 0 )  THEN
-             pmf2a(:,3) = 0.0_wp
-             pmf2b(:,3) = 0.0_wp
-          ENDIF
-          IF ( index_du < 0 )  THEN
-             pmf2a(:,4) = 0.0_wp
-             pmf2b(:,4) = 0.0_wp
-          ENDIF
-          IF ( index_ss < 0 )  THEN
-             pmf2a(:,5) = 0.0_wp
-             pmf2b(:,5) = 0.0_wp
-          ENDIF
-          IF ( index_no < 0 )  THEN
-             pmf2a(:,6) = 0.0_wp
-             pmf2b(:,6) = 0.0_wp
-          ENDIF
-          IF ( index_nh < 0 )  THEN
-             pmf2a(:,7) = 0.0_wp
-             pmf2b(:,7) = 0.0_wp
-          ENDIF
-
-          IF ( SUM( pmf2a ) < 0.00001_wp  .AND.  SUM( pmf2b ) < 0.00001_wp )  THEN
-             message_string = 'Error in initialising mass fractions of chemical components. ' //   &
-                              'Check that all chemical components are included in parameter file!'
-             CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 )
-          ENDIF
-!
-!--       Then normalise the mass fraction so that SUM = 1
-          DO  k = nzb, nzt+1
-             pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
-             IF ( SUM( pmf2b(k,:) ) > 0.0_wp )  pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
-          ENDDO
-
-          DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b )
-!
-!--       Close input file
-          CALL close_input_file( id_dyn )
-
-       ELSE
-          message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) //  &
-                           ' for SALSA missing!'
-          CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 )
-
-       ENDIF   ! netcdf_extend
-
-#else
-       message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// &
-                        'in compiling!'
-       CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 )
-
-#endif
-
-    ELSEIF ( init_aerosol_type == 0 )  THEN
-!
-!--    Mass fractions for species in a and b-bins
-       IF ( index_so4 > 0 )  THEN
-          pmf2a(:,1) = mass_fracs_a(index_so4)
-          pmf2b(:,1) = mass_fracs_b(index_so4)
-       ENDIF
-       IF ( index_oc > 0 )  THEN
-          pmf2a(:,2) = mass_fracs_a(index_oc)
-          pmf2b(:,2) = mass_fracs_b(index_oc)
-       ENDIF
-       IF ( index_bc > 0 )  THEN
-          pmf2a(:,3) = mass_fracs_a(index_bc)
-          pmf2b(:,3) = mass_fracs_b(index_bc)
-       ENDIF
-       IF ( index_du > 0 )  THEN
-          pmf2a(:,4) = mass_fracs_a(index_du)
-          pmf2b(:,4) = mass_fracs_b(index_du)
-       ENDIF
-       IF ( index_ss > 0 )  THEN
-          pmf2a(:,5) = mass_fracs_a(index_ss)
-          pmf2b(:,5) = mass_fracs_b(index_ss)
-       ENDIF
-       IF ( index_no > 0 )  THEN
-          pmf2a(:,6) = mass_fracs_a(index_no)
-          pmf2b(:,6) = mass_fracs_b(index_no)
-       ENDIF
-       IF ( index_nh > 0 )  THEN
-          pmf2a(:,7) = mass_fracs_a(index_nh)
-          pmf2b(:,7) = mass_fracs_b(index_nh)
-       ENDIF
-       DO  k = nzb, nzt+1
-          pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) )
-          IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) )
-       ENDDO
-
-       CALL size_distribution( n_lognorm, dpg, sigmag, nsect )
-!
-!--    Normalize by the given total number concentration
-       nsect = nsect * SUM( n_lognorm ) / SUM( nsect )
-       DO  ib = start_subrange_1a, end_subrange_2b
-          pndist(:,ib) = nsect(ib)
-       ENDDO
-    ENDIF
-
-    IF ( init_gases_type == 1 )  THEN
-!
-!--    Read input profiles from PIDS_CHEM
-#if defined( __netcdf )
-!
-!--    Location-dependent size distributions and compositions.
-       INQUIRE( FILE = TRIM( input_file_dynamic ) //  TRIM( coupling_char ), EXIST = netcdf_extend )
-       IF ( netcdf_extend  .AND.  .NOT. salsa_gases_from_chem )  THEN
-!
-!--       Open file in read-only mode
-          CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn )
-!
-!--       Inquire dimensions:
-          CALL get_dimension_length( id_dyn, pr_nz, 'z' )
-          IF ( pr_nz /= nz )  THEN
-             WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
-                                        'the number of numeric grid points.'
-             CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 )
-          ENDIF
-!
-!--       Read vertical profiles of gases:
-          CALL get_variable( id_dyn, 'init_atmosphere_H2SO4', salsa_gas(1)%init(nzb+1:nzt) )
-          CALL get_variable( id_dyn, 'init_atmosphere_HNO3',  salsa_gas(2)%init(nzb+1:nzt) )
-          CALL get_variable( id_dyn, 'init_atmosphere_NH3',   salsa_gas(3)%init(nzb+1:nzt) )
-          CALL get_variable( id_dyn, 'init_atmosphere_OCNV',  salsa_gas(4)%init(nzb+1:nzt) )
-          CALL get_variable( id_dyn, 'init_atmosphere_OCSV',  salsa_gas(5)%init(nzb+1:nzt) )
-!
-!--       Set Neumann top and surface boundary condition for initial + initialise concentrations
-          DO  ig = 1, ngases_salsa
-             salsa_gas(ig)%init(nzb)   =  salsa_gas(ig)%init(nzb+1)
-             salsa_gas(ig)%init(nzt+1) =  salsa_gas(ig)%init(nzt)
-             IF ( .NOT. read_restart_data_salsa )  THEN
-                DO  k = nzb, nzt+1
-                   salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k)
-                ENDDO
-             ENDIF
-          ENDDO
-!
-!--       Close input file
-          CALL close_input_file( id_dyn )
-
-       ELSEIF ( .NOT. netcdf_extend  .AND.  .NOT.  salsa_gases_from_chem )  THEN
-          message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) //  &
-                           ' for SALSA missing!'
-          CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 )
-
-       ENDIF   ! netcdf_extend
-#else
-       message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//&
-                        'compiling!'
-       CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 )
-
-#endif
-
-    ENDIF
-!
-!-- Both SO4 and OC are included, so use the given mass fractions
-    IF ( index_oc > 0  .AND.  index_so4 > 0 )  THEN
-       pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) )  ! Normalize
-!
-!-- Pure organic carbon
-    ELSEIF ( index_oc > 0 )  THEN
-       pmfoc1a(:) = 1.0_wp
-!
-!-- Pure SO4
-    ELSEIF ( index_so4 > 0 )  THEN
-       pmfoc1a(:) = 0.0_wp
-
-    ELSE
-       message_string = 'Either OC or SO4 must be active for aerosol region 1a!'
-       CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Initialize concentrations
-    DO  i = nxlg, nxrg
-       DO  j = nysg, nyng
-          DO  k = nzb, nzt+1
-!
-!--          Predetermine flag to mask topography
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--          a) Number concentrations
-!--          Region 1:
-             DO  ib = start_subrange_1a, end_subrange_1a
-                IF ( .NOT. read_restart_data_salsa )  THEN
-                   aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag
-                ENDIF
-                IF ( prunmode == 1 )  THEN
-                   aerosol_number(ib)%init = pndist(:,ib)
-                ENDIF
-             ENDDO
-!
-!--          Region 2:
-             IF ( nreg > 1 )  THEN
-                DO  ib = start_subrange_2a, end_subrange_2a
-                   IF ( .NOT. read_restart_data_salsa )  THEN
-                      aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag
-                   ENDIF
-                   IF ( prunmode == 1 )  THEN
-                      aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib)
-                   ENDIF
-                ENDDO
-                IF ( .NOT. no_insoluble )  THEN
-                   DO  ib = start_subrange_2b, end_subrange_2b
-                      IF ( pnf2a(k) < 1.0_wp )  THEN
-                         IF ( .NOT. read_restart_data_salsa )  THEN
-                            aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) *    &
-                                                             pndist(k,ib) * flag
-                         ENDIF
-                         IF ( prunmode == 1 )  THEN
-                            aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib)
-                         ENDIF
-                      ENDIF
-                   ENDDO
-                ENDIF
-             ENDIF
-!
-!--          b) Aerosol mass concentrations
-!--             bin subrange 1: done here separately due to the SO4/OC convention
-!
-!--          SO4:
-             IF ( index_so4 > 0 )  THEN
-                ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start
-                ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end
-                ib = start_subrange_1a
-                DO  ic = ss, ee
-                   IF ( .NOT. read_restart_data_salsa )  THEN
-                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) *          &
-                                                     pndist(k,ib) * core(ib) * arhoh2so4 * flag
-                   ENDIF
-                   IF ( prunmode == 1 )  THEN
-                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) &
-                                                 * core(ib) * arhoh2so4
-                   ENDIF
-                   ib = ib+1
-                ENDDO
-             ENDIF
-!
-!--          OC:
-             IF ( index_oc > 0 ) THEN
-                ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start
-                ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end
-                ib = start_subrange_1a
-                DO  ic = ss, ee
-                   IF ( .NOT. read_restart_data_salsa )  THEN
-                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) *    &
-                                                     core(ib) * arhooc * flag
-                   ENDIF
-                   IF ( prunmode == 1 )  THEN
-                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) *        &
-                                                 core(ib) * arhooc
-                   ENDIF
-                   ib = ib+1
-                ENDDO
-             ENDIF
-          ENDDO !< k
-
-          prunmode = 3  ! Init only once
-
-       ENDDO !< j
-    ENDDO !< i
-
-!
-!-- c) Aerosol mass concentrations
-!--    bin subrange 2:
-    IF ( nreg > 1 ) THEN
-
-       IF ( index_so4 > 0 ) THEN
-          CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 )
-       ENDIF
-       IF ( index_oc > 0 ) THEN
-          CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc )
-       ENDIF
-       IF ( index_bc > 0 ) THEN
-          CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc )
-       ENDIF
-       IF ( index_du > 0 ) THEN
-          CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu )
-       ENDIF
-       IF ( index_ss > 0 ) THEN
-          CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss )
-       ENDIF
-       IF ( index_no > 0 ) THEN
-          CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 )
-       ENDIF
-       IF ( index_nh > 0 ) THEN
-          CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 )
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE aerosol_init
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create a lognormal size distribution and discretise to a sectional
-!> representation.
-!------------------------------------------------------------------------------!
- SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib         !< running index: bin
-    INTEGER(iwp) ::  iteration  !< running index: iteration
-
-    REAL(wp) ::  d1         !< particle diameter (m, dummy)
-    REAL(wp) ::  d2         !< particle diameter (m, dummy)
-    REAL(wp) ::  delta_d    !< (d2-d1)/10
-    REAL(wp) ::  deltadp    !< bin width
-    REAL(wp) ::  dmidi      !< ( d1 + d2 ) / 2
-
-    REAL(wp), DIMENSION(:), INTENT(in) ::  in_dpg    !< geometric mean diameter (m)
-    REAL(wp), DIMENSION(:), INTENT(in) ::  in_ntot   !< number conc. (#/m3)
-    REAL(wp), DIMENSION(:), INTENT(in) ::  in_sigma  !< standard deviation
-
-    REAL(wp), DIMENSION(:), INTENT(inout) ::  psd_sect  !< sectional size distribution
-
-    DO  ib = start_subrange_1a, end_subrange_2b
-       psd_sect(ib) = 0.0_wp
-!
-!--    Particle diameter at the low limit (largest in the bin) (m)
-       d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp
-!
-!--    Particle diameter at the high limit (smallest in the bin) (m)
-       d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp
-!
-!--    Span of particle diameter in a bin (m)
-       delta_d = 0.1_wp * ( d2 - d1 )
-!
-!--    Iterate:
-       DO  iteration = 1, 10
-          d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp + ( ib - 1) * delta_d
-          d2 = d1 + delta_d
-          dmidi = 0.5_wp * ( d1 + d2 )
-          deltadp = LOG10( d2 / d1 )
-!
-!--       Size distribution
-!--       in_ntot = total number, total area, or total volume concentration
-!--       in_dpg = geometric-mean number, area, or volume diameter
-!--       n(k) = number, area, or volume concentration in a bin
-          psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) *           &
-                        LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp /              &
-                        ( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) )
-
-       ENDDO
-    ENDDO
-
- END SUBROUTINE size_distribution
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
-!>
-!> Tomi Raatikainen, FMI, 29.2.2016
-!------------------------------------------------------------------------------!
- SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ee        !< index: end
-    INTEGER(iwp) ::  i         !< loop index
-    INTEGER(iwp) ::  ib        !< loop index
-    INTEGER(iwp) ::  ic        !< loop index
-    INTEGER(iwp) ::  j         !< loop index
-    INTEGER(iwp) ::  k         !< loop index
-    INTEGER(iwp) ::  prunmode  !< 1 = initialise
-    INTEGER(iwp) ::  ss        !< index: start
-
-    INTEGER(iwp), INTENT(in) :: ispec  !< Aerosol species index
-
-    REAL(wp) ::  flag   !< flag to mask topography grid points
-
-    REAL(wp), INTENT(in) ::  prho !< Aerosol density
-
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pcore !< Aerosol bin mid core volume
-    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pnf2a !< Number fraction for 2a
-    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pmf2a !< Mass distributions for a
-    REAL(wp), DIMENSION(0:nz+1), INTENT(in)        ::  pmf2b !< and b bins
-
-    REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) ::  pndist !< Aerosol size distribution
-
-    prunmode = 1
-
-    DO i = nxlg, nxrg
-       DO j = nysg, nyng
-          DO k = nzb, nzt+1
-!
-!--          Predetermine flag to mask topography
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--          Regime 2a:
-             ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
-             ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
-             ib = start_subrange_2a
-             DO ic = ss, ee
-                IF ( .NOT. read_restart_data_salsa )  THEN
-                   aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib)&
-                                                  * pcore(ib) * prho * flag
-                ENDIF
-                IF ( prunmode == 1 )  THEN
-                   aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) *  &
-                                              pcore(ib) * prho
-                ENDIF
-                ib = ib + 1
-             ENDDO
-!
-!--          Regime 2b:
-             IF ( .NOT. no_insoluble )  THEN
-                ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b
-                ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b
-                ib = start_subrange_2a
-                DO ic = ss, ee
-                   IF ( .NOT. read_restart_data_salsa )  THEN
-                      aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k))&
-                                                     * pndist(k,ib) * pcore(ib) * prho * flag
-                   ENDIF
-                   IF ( prunmode == 1 )  THEN
-                      aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * &
-                                                 pndist(k,ib) * pcore(ib) * prho
-                   ENDIF
-                   ib = ib + 1
-                ENDDO  ! c
-
-             ENDIF
-          ENDDO   ! k
-
-          prunmode = 3  ! Init only once
-
-       ENDDO   ! j
-    ENDDO   ! i
-
- END SUBROUTINE set_aero_mass
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialise the matching between surface types in LSM and deposition models.
-!> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560
-!> (here referred as Z01).
-!------------------------------------------------------------------------------!
- SUBROUTINE init_deposition
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  l  !< loop index for vertical surfaces
-
-    LOGICAL :: match_lsm  !< flag to initilise LSM surfaces (if false, initialise USM surfaces)
-
-    IF ( depo_pcm_par == 'zhang2001' )  THEN
-       depo_pcm_par_num = 1
-    ELSEIF ( depo_pcm_par == 'petroff2010' )  THEN
-       depo_pcm_par_num = 2
-    ENDIF
-
-    IF ( depo_surf_par == 'zhang2001' )  THEN
-       depo_surf_par_num = 1
-    ELSEIF ( depo_surf_par == 'petroff2010' )  THEN
-       depo_surf_par_num = 2
-    ENDIF
-!
-!-- LSM: Pavement, vegetation and water
-    IF ( nldepo_surf  .AND.  land_surface )  THEN
-       match_lsm = .TRUE.
-       DO l = 0, 1
-          ALLOCATE( lsm_to_depo_h(l)%match_lupg(1:surf_lsm_h(l)%ns),                               &
-                    lsm_to_depo_h(l)%match_luvw(1:surf_lsm_h(l)%ns),                               &
-                    lsm_to_depo_h(l)%match_luww(1:surf_lsm_h(l)%ns) )
-          lsm_to_depo_h(l)%match_lupg = 0
-          lsm_to_depo_h(l)%match_luvw = 0
-          lsm_to_depo_h(l)%match_luww = 0
-          CALL match_sm_zhang( surf_lsm_h(l), lsm_to_depo_h(l)%match_lupg,                         &
-                               lsm_to_depo_h(l)%match_luvw, lsm_to_depo_h(l)%match_luww, match_lsm )
-       ENDDO
-       DO  l = 0, 3
-          ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns),                               &
-                    lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns),                               &
-                    lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) )
-          lsm_to_depo_v(l)%match_lupg = 0
-          lsm_to_depo_v(l)%match_luvw = 0
-          lsm_to_depo_v(l)%match_luww = 0
-          CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg,                         &
-                               lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm )
-       ENDDO
-    ENDIF
-!
-!-- USM: Green roofs/walls, wall surfaces and windows
-    IF ( nldepo_surf  .AND.  urban_surface )  THEN
-       match_lsm = .FALSE.
-       DO l = 0, 1
-          ALLOCATE( usm_to_depo_h(l)%match_lupg(1:surf_usm_h(l)%ns),                               &
-                    usm_to_depo_h(l)%match_luvw(1:surf_usm_h(l)%ns),                               &
-                    usm_to_depo_h(l)%match_luww(1:surf_usm_h(l)%ns) )
-          usm_to_depo_h(l)%match_lupg = 0
-          usm_to_depo_h(l)%match_luvw = 0
-          usm_to_depo_h(l)%match_luww = 0
-          CALL match_sm_zhang( surf_usm_h(l), usm_to_depo_h(l)%match_lupg,                         &
-                               usm_to_depo_h(l)%match_luvw, usm_to_depo_h(l)%match_luww, match_lsm )
-       ENDDO
-       DO  l = 0, 3
-          ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns),                               &
-                    usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns),                               &
-                    usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) )
-          usm_to_depo_v(l)%match_lupg = 0
-          usm_to_depo_v(l)%match_luvw = 0
-          usm_to_depo_v(l)%match_luww = 0
-          CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg,                         &
-                               usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm )
-       ENDDO
-    ENDIF
-
-    IF ( nldepo_pcm )  THEN
-       SELECT CASE ( depo_pcm_type )
-          CASE ( 'evergreen_needleleaf' )
-             depo_pcm_type_num = 1
-          CASE ( 'evergreen_broadleaf' )
-             depo_pcm_type_num = 2
-          CASE ( 'deciduous_needleleaf' )
-             depo_pcm_type_num = 3
-          CASE ( 'deciduous_broadleaf' )
-             depo_pcm_type_num = 4
-          CASE DEFAULT
-             message_string = 'depo_pcm_type not set correctly.'
-             CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 )
-       END SELECT
-    ENDIF
-
- END SUBROUTINE init_deposition
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Match the surface types in PALM and Zhang et al. 2001 deposition module
-!------------------------------------------------------------------------------!
- SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm )
-
-    USE surface_mod,                                                           &
-        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  m              !< index for surface elements
-    INTEGER(iwp) ::  pav_type_palm  !< pavement / green wall type in PALM
-    INTEGER(iwp) ::  veg_type_palm  !< vegetation / wall type in PALM
-    INTEGER(iwp) ::  wat_type_palm  !< water / window type in PALM
-
-    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_pav_green  !<  matching pavement/green walls
-    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_veg_wall   !<  matching vegetation/walls
-    INTEGER(iwp), DIMENSION(:), INTENT(inout) ::  match_wat_win    !<  matching water/windows
-
-    LOGICAL, INTENT(in) :: match_lsm  !< flag to initilise LSM surfaces (if false, initialise USM)
-
-    TYPE(surf_type), INTENT(in) :: surf  !< respective surface type
-
-    DO  m = 1, surf%ns
-       IF ( match_lsm )  THEN
-!
-!--       Vegetation (LSM):
-          IF ( surf%frac(m,ind_veg_wall) > 0 )  THEN
-             veg_type_palm = surf%vegetation_type(m)
-             SELECT CASE ( veg_type_palm )
-                CASE ( 0 )
-                   message_string = 'No vegetation type defined.'
-                   CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 )
-                CASE ( 1 )  ! bare soil
-                   match_veg_wall(m) = 6  ! grass in Z01
-                CASE ( 2 )  ! crops, mixed farming
-                   match_veg_wall(m) = 7  !  crops, mixed farming Z01
-                CASE ( 3 )  ! short grass
-                   match_veg_wall(m) = 6  ! grass in Z01
-                CASE ( 4 )  ! evergreen needleleaf trees
-                    match_veg_wall(m) = 1  ! evergreen needleleaf trees in Z01
-                CASE ( 5 )  ! deciduous needleleaf trees
-                   match_veg_wall(m) = 3  ! deciduous needleleaf trees in Z01
-                CASE ( 6 )  ! evergreen broadleaf trees
-                   match_veg_wall(m) = 2  ! evergreen broadleaf trees in Z01
-                CASE ( 7 )  ! deciduous broadleaf trees
-                   match_veg_wall(m) = 4  ! deciduous broadleaf trees in Z01
-                CASE ( 8 )  ! tall grass
-                   match_veg_wall(m) = 6  ! grass in Z01
-                CASE ( 9 )  ! desert
-                   match_veg_wall(m) = 8  ! desert in Z01
-                CASE ( 10 )  ! tundra
-                   match_veg_wall(m) = 9  ! tundra in Z01
-                CASE ( 11 )  ! irrigated crops
-                   match_veg_wall(m) = 7  !  crops, mixed farming Z01
-                CASE ( 12 )  ! semidesert
-                   match_veg_wall(m) = 8  ! desert in Z01
-                CASE ( 13 )  ! ice caps and glaciers
-                   match_veg_wall(m) = 12  ! ice cap and glacier in Z01
-                CASE ( 14 )  ! bogs and marshes
-                   match_veg_wall(m) = 11  ! wetland with plants in Z01
-                CASE ( 15 )  ! evergreen shrubs
-                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
-                CASE ( 16 )  ! deciduous shrubs
-                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
-                CASE ( 17 )  ! mixed forest/woodland
-                   match_veg_wall(m) = 5  ! mixed broadleaf and needleleaf trees in Z01
-                CASE ( 18 )  ! interrupted forest
-                   match_veg_wall(m) = 10  ! shrubs and interrupted woodlands in Z01
-             END SELECT
-          ENDIF
-!
-!--       Pavement (LSM):
-          IF ( surf%frac(m,ind_pav_green) > 0 )  THEN
-             pav_type_palm = surf%pavement_type(m)
-             IF ( pav_type_palm == 0 )  THEN  ! error
-                message_string = 'No pavement type defined.'
-                CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 )
-             ELSE
-                match_pav_green(m) = 15  ! urban in Z01
-             ENDIF
-          ENDIF
-!
-!--       Water (LSM):
-          IF ( surf%frac(m,ind_wat_win) > 0 )  THEN
-             wat_type_palm = surf%water_type(m)
-             IF ( wat_type_palm == 0 )  THEN  ! error
-                message_string = 'No water type defined.'
-                CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 )
-             ELSEIF ( wat_type_palm == 3 )  THEN
-                match_wat_win(m) = 14  ! ocean in Z01
-             ELSEIF ( wat_type_palm == 1  .OR.  wat_type_palm == 2 .OR.  wat_type_palm == 4        &
-                      .OR.  wat_type_palm == 5  )  THEN
-                match_wat_win(m) = 13  ! inland water in Z01
-             ENDIF
-          ENDIF
-       ELSE
-!
-!--       Wall surfaces (USM):
-          IF ( surf%frac(m,ind_veg_wall) > 0 )  THEN
-             match_veg_wall(m) = 15  ! urban in Z01
-          ENDIF
-!
-!--       Green walls and roofs (USM):
-          IF ( surf%frac(m,ind_pav_green) > 0 )  THEN
-             match_pav_green(m) =  6 ! (short) grass in Z01
-          ENDIF
-!
-!--       Windows (USM):
-          IF ( surf%frac(m,ind_wat_win) > 0 )  THEN
-             match_wat_win(m) = 15  ! urban in Z01
-          ENDIF
-       ENDIF
-
-    ENDDO
-
- END SUBROUTINE match_sm_zhang
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Swapping of timelevels
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_swap_timelevel( mod_count )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib   !<
-    INTEGER(iwp) ::  ic   !<
-    INTEGER(iwp) ::  icc  !<
-    INTEGER(iwp) ::  ig   !<
-
-    INTEGER(iwp), INTENT(IN) ::  mod_count  !<
-
-    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
-
-       SELECT CASE ( mod_count )
-
-          CASE ( 0 )
-
-             DO  ib = 1, nbins_aerosol
-                aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => nconc_1(:,:,:,ib)
-                aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib)
-
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic-1 ) * nbins_aerosol + ib
-                   aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => mconc_1(:,:,:,icc)
-                   aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc)
-                ENDDO
-             ENDDO
-
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => gconc_1(:,:,:,ig)
-                   salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig)
-                ENDDO
-             ENDIF
-
-          CASE ( 1 )
-
-             DO  ib = 1, nbins_aerosol
-                aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => nconc_2(:,:,:,ib)
-                aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic-1 ) * nbins_aerosol + ib
-                   aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => mconc_2(:,:,:,icc)
-                   aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc)
-                ENDDO
-             ENDDO
-
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   => gconc_2(:,:,:,ig)
-                   salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig)
-                ENDDO
-             ENDIF
-
-       END SELECT
-
-    ENDIF
-
- END SUBROUTINE salsa_swap_timelevel
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_rrd_global_ftn( found )
-
-    USE control_parameters,                                                    &
-        ONLY: length, restart_string
-
-
-    IMPLICIT NONE
-
-    LOGICAL, INTENT(OUT)  ::  found
-
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'listspec' )
-          READ ( 13 )  listspec
-
-       CASE ( 'nbin' )
-          READ ( 13 )  nbin
-
-       CASE ( 'nf2a' )
-          READ ( 13 )  nf2a
-
-       CASE ( 'ncc' )
-          READ ( 13 )  ncc
-
-       CASE ( 'mass_fracs_a' )
-          READ ( 13 )  mass_fracs_a
-
-       CASE ( 'mass_fracs_b' )
-          READ ( 13 )  mass_fracs_b
-
-       CASE ( 'reglim' )
-          READ ( 13 )  reglim
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE salsa_rrd_global_ftn
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_rrd_global_mpi
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1) ::  counter  !< counter used for output-variable names
-
-    INTEGER(iwp) ::  i  !< loop counter
-
-
-    DO  i = 1, 7
-       WRITE( counter, '(I1)' )  i
-       CALL rrd_mpi_io( 'listspec_' // counter, listspec(i) )
-    ENDDO
-
-    CALL rrd_mpi_io_global_array( 'nbin', nbin )
-    CALL rrd_mpi_io( 'nf2a', nf2a )
-    CALL rrd_mpi_io( 'ncc', ncc )
-    CALL rrd_mpi_io_global_array( 'mass_fracs_a', mass_fracs_a )
-    CALL rrd_mpi_io_global_array( 'mass_fracs_b', mass_fracs_b )
-    CALL rrd_mpi_io_global_array( 'reglim', reglim )
-
- END SUBROUTINE salsa_rrd_global_mpi
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,  &
-                                 nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
-
-    USE control_parameters,                                                                        &
-        ONLY:  length, restart_string
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib              !<
-    INTEGER(iwp) ::  ic              !<
-    INTEGER(iwp) ::  ig              !<
-    INTEGER(iwp) ::  k               !<
-    INTEGER(iwp) ::  nxlc            !<
-    INTEGER(iwp) ::  nxlf            !<
-    INTEGER(iwp) ::  nxl_on_file     !<
-    INTEGER(iwp) ::  nxrc            !<
-    INTEGER(iwp) ::  nxrf            !<
-    INTEGER(iwp) ::  nxr_on_file     !<
-    INTEGER(iwp) ::  nync            !<
-    INTEGER(iwp) ::  nynf            !<
-    INTEGER(iwp) ::  nyn_on_file     !<
-    INTEGER(iwp) ::  nysc            !<
-    INTEGER(iwp) ::  nysf            !<
-    INTEGER(iwp) ::  nys_on_file     !<
-
-    LOGICAL, INTENT(OUT)  ::  found  !<
-
-    REAL(wp), &
-       DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
-
-    found = .TRUE.
-
-       SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'aerosol_mass' )
-          DO  ic = 1, ncomponents_mass * nbins_aerosol
-             IF ( k == 1 )  READ ( 13 ) tmp_3d
-             aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                    &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-          ENDDO
-
-       CASE ( 'aerosol_number' )
-          DO  ib = 1, nbins_aerosol
-             IF ( k == 1 )  READ ( 13 ) tmp_3d
-             aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                  &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-          ENDDO
-
-       CASE( 'salsa_gases_av' )
-          IF ( .NOT. ALLOCATED( salsa_gases_av ) )  THEN
-             ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
-          ENDIF
-          DO  ig = 1, ngases_salsa
-             IF ( k == 1 )  READ ( 13 ) tmp_3d
-             salsa_gases_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ig) =                        &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-          ENDDO
-
-       CASE ( 'ldsa_av' )
-          IF ( .NOT. ALLOCATED( ldsa_av ) )  ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          IF ( k == 1 )  READ ( 13 ) tmp_3d
-          ldsa_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                     &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'mbins_av' )
-          IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
-             ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-          ENDIF
-          DO  ib = 1, nbins_aerosol
-             IF ( k == 1 )  READ ( 13 ) tmp_3d
-             mbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) =                              &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-          ENDDO
-
-       CASE ( 'nbins_av' )
-          IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
-             ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-          ENDIF
-          DO  ib = 1, nbins_aerosol
-             IF ( k == 1 )  READ ( 13 ) tmp_3d
-             nbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) =                              &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-          ENDDO
-
-       CASE ( 'ntot_av' )
-          IF ( .NOT. ALLOCATED( ntot_av ) )  ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          IF ( k == 1 )  READ ( 13 ) tmp_3d
-          ntot_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                     &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-          found = .TRUE.
-
-       CASE ( 'nufp_av' )
-          IF ( .NOT. ALLOCATED( nufp_av ) )  ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          IF ( k == 1 )  READ ( 13 ) tmp_3d
-          nufp_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                     &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'pm01_av' )
-          IF ( .NOT. ALLOCATED( pm01_av ) )  ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          IF ( k == 1 )  READ ( 13 ) tmp_3d
-          pm01_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                     &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'pm25_av' )
-          IF ( .NOT. ALLOCATED( pm25_av ) )  ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          IF ( k == 1 )  READ ( 13 ) tmp_3d
-          pm25_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                     &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'pm10_av' )
-          IF ( .NOT. ALLOCATED( pm10_av ) )  ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          IF ( k == 1 )  READ ( 13 ) tmp_3d
-          pm10_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                     &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 's_mass_av' )
-          IF ( .NOT. ALLOCATED( s_mass_av ) )  THEN
-             ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) )
-          ENDIF
-          DO  ic = 1, ncomponents_mass
-             IF ( k == 1 )  READ ( 13 ) tmp_3d
-             s_mass_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ic) =                             &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-          ENDDO
-
-       CASE ( 's_h2o_av' )
-          IF ( .NOT. ALLOCATED( s_h2o_av ) )  ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-          IF ( k == 1 )  READ ( 13 ) tmp_3d
-          s_h2o_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-       CASE ( 'salsa_gas' )
-          IF ( .NOT. salsa_gases_from_chem )  THEN
-             DO  ig = 1, ngases_salsa
-                IF ( k == 1 )  READ ( 13 ) tmp_3d
-                salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                    &
-                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-             ENDDO
-          ENDIF
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE salsa_rrd_local_ftn
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_rrd_local_mpi
-
-    USE indices,                                                               &
-        ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=3) ::  counter  !< counter used for input-variable names
-
-    INTEGER(iwp) ::  ib  !<
-    INTEGER(iwp) ::  ic  !<
-    INTEGER(iwp) ::  ig  !<
-
-    LOGICAL ::  array_found  !<
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  tmp_3d  !< temporary array to store aerosal data
-                                                        !< as single 3d-standard arrays
-
-
-    ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-    DO  ic = 1, nbins_aerosol * ncomponents_mass
-       WRITE( counter, '(I3.3)')  ic
-       CALL rrd_mpi_io( 'aerosol_mass_' // counter, tmp_3d )
-       aerosol_mass(ic)%conc = tmp_3d
-    ENDDO
-
-    DO  ib = 1, nbins_aerosol
-       WRITE( counter, '(I3.3)')  ib
-       CALL rrd_mpi_io( 'aerosol_number_' // counter, tmp_3d )
-       aerosol_number(ic)%conc = tmp_3d
-    ENDDO
-
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       CALL rd_mpi_io_check_array( 'salsa_gases_av_001', found = array_found )
-       IF ( array_found )  THEN
-          IF ( .NOT. ALLOCATED( salsa_gases_av ) )  THEN
-             ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,1:ngases_salsa) )
-          ENDIF
-          DO  ig = 1, ngases_salsa
-             WRITE( counter, '(I3.3)')  ig
-             CALL rrd_mpi_io( 'salsa_gases_av_' // counter , tmp_3d )
-             salsa_gases_av(:,:,:,ig) = tmp_3d
-          ENDDO
-       ENDIF
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'ldsa_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( ldsa_av ) )  ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'ldsa_av', ldsa_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'mbins_av_001', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
-          ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,1:nbins_aerosol) )
-       ENDIF
-       DO  ib = 1, nbins_aerosol
-          WRITE( counter, '(I3.3)')  ib
-          CALL rrd_mpi_io( 'mbins_av_' // counter, tmp_3d )
-          mbins_av(:,:,:,ib) = tmp_3d
-       ENDDO
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'nbins_av_001', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
-          ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,1:nbins_aerosol) )
-       ENDIF
-       DO  ib = 1, nbins_aerosol
-          WRITE( counter, '(I3.3)')  ib
-          CALL rrd_mpi_io( 'nbins_av_' // counter, tmp_3d )
-          nbins_av(:,:,:,ib) = tmp_3d
-       ENDDO
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'ntot_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( ntot_av ) )  ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'ntot_av', ntot_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'nufp_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( nufp_av ) )  ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'nufp_av', nufp_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'pm01_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( pm01_av ) )  ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'pm01_av', pm01_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'pm25_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( pm25_av ) )  ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'pm25_av', pm25_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 'pm10_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( pm10_av ) )  ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 'pm10_av', pm10_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 's_h20_av', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( s_h2o_av ) )  ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       CALL rrd_mpi_io( 's_h2o_av', s_h2o_av )
-    ENDIF
-
-    CALL rd_mpi_io_check_array( 's_mass_av_001', found = array_found )
-    IF ( array_found )  THEN
-       IF ( .NOT. ALLOCATED( s_mass_av ) )  THEN
-          ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,1:ncomponents_mass) )
-       ENDIF
-       DO  ic = 1, ncomponents_mass
-          WRITE( counter, '(I3.3)')  ib
-          CALL rrd_mpi_io( 's_mass_av_' // counter, tmp_3d )
-          s_mass_av(:,:,:,ic) = tmp_3d
-       ENDDO
-    ENDIF
-
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       DO  ig = 1, ngases_salsa
-          WRITE( counter, '(I3.3)')  ig
-          CALL rrd_mpi_io( 'salsa_gas_' // counter, tmp_3d )
-          salsa_gas(ig)%conc = tmp_3d
-       ENDDO
-    ENDIF
-
-    DEALLOCATE( tmp_3d )
-
- END SUBROUTINE salsa_rrd_local_mpi
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Write module-specific global restart data.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_wrd_global
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1) ::  counter  !< counter used for output-variable names
-
-    INTEGER(iwp) ::  i  !< loop counter
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL wrd_write_string( 'listspec' )
-       WRITE ( 14 )  listspec
-
-       CALL wrd_write_string( 'nbin' )
-       WRITE ( 14 )  nbin
-
-       CALL wrd_write_string( 'nf2a' )
-       WRITE ( 14 )  nf2a
-
-       CALL wrd_write_string( 'ncc' )
-       WRITE ( 14 )  ncc
-
-       CALL wrd_write_string( 'mass_fracs_a' )
-       WRITE ( 14 )  mass_fracs_a
-
-       CALL wrd_write_string( 'mass_fracs_b' )
-       WRITE ( 14 )  mass_fracs_b
-
-       CALL wrd_write_string( 'reglim' )
-       WRITE ( 14 )  reglim
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       DO  i = 1, 7
-          WRITE( counter, '(I1)' )  i
-          CALL wrd_mpi_io( 'listspec_' // counter, listspec(i) )
-       ENDDO
-
-       CALL wrd_mpi_io_global_array( 'nbin', nbin )
-       CALL wrd_mpi_io( 'nf2a', nf2a )
-       CALL wrd_mpi_io( 'ncc', ncc )
-       CALL wrd_mpi_io_global_array( 'mass_fracs_a', mass_fracs_a )
-       CALL wrd_mpi_io_global_array( 'mass_fracs_b', mass_fracs_b )
-       CALL wrd_mpi_io_global_array( 'reglim', reglim )
-
-    ENDIF
-
- END SUBROUTINE salsa_wrd_global
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective local restart data.
-!> Note that the following input variables in PARIN have to be equal between
-!> restart runs:
-!>    listspec, nbin, nf2a, ncc, mass_fracs_a, mass_fracs_b
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_wrd_local
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=3) ::  counter  !< counter used for output-variable names
-
-    INTEGER(iwp) ::  ib   !<
-    INTEGER(iwp) ::  ic   !<
-    INTEGER(iwp) ::  ig  !<
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  tmp_3d  !< temporary array to store aerosal data
-                                                        !< as single 3d-standard arrays
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL wrd_write_string( 'aerosol_mass' )
-       DO  ic = 1, nbins_aerosol * ncomponents_mass
-          WRITE ( 14 )  aerosol_mass(ic)%conc
-       ENDDO
-
-       CALL wrd_write_string( 'aerosol_number' )
-       DO  ib = 1, nbins_aerosol
-          WRITE ( 14 )  aerosol_number(ib)%conc
-       ENDDO
-
-       IF (  .NOT. salsa_gases_from_chem )  THEN
-
-          IF ( ALLOCATED( salsa_gases_av ) )  THEN
-             CALL wrd_write_string( 'salsa_gases_av' )
-             DO  ig = 1, ngases_salsa
-                WRITE ( 14 )  salsa_gases_av(:,:,:,ig)
-             ENDDO
-          ENDIF
-       ENDIF
-
-       IF ( ALLOCATED( ldsa_av ) )  THEN
-          CALL wrd_write_string( 'ldsa_av' )
-          WRITE ( 14 )  ldsa_av
-       ENDIF
-
-       IF ( ALLOCATED( mbins_av ) )  THEN
-          CALL wrd_write_string( 'mbins_av' )
-          DO  ib = 1, nbins_aerosol
-             WRITE ( 14 )  mbins_av(:,:,:,ib)
-          ENDDO
-       ENDIF
-
-       IF ( ALLOCATED( nbins_av ) )  THEN
-          CALL wrd_write_string( 'nbins_av' )
-          DO  ib = 1, nbins_aerosol
-             WRITE ( 14 )  nbins_av(:,:,:,ib)
-          ENDDO
-       ENDIF
-
-       IF ( ALLOCATED( ldsa_av ) )  THEN
-          CALL wrd_write_string( 'ntot_av' )
-          WRITE ( 14 )  ntot_av
-       ENDIF
-
-       IF ( ALLOCATED( nufp_av ) )  THEN
-          CALL wrd_write_string( 'nufp_av' )
-          WRITE ( 14 )  nufp_av
-       ENDIF
-
-       IF ( ALLOCATED( pm01_av ) )  THEN
-          CALL wrd_write_string( 'pm01_av' )
-          WRITE ( 14 )  pm01_av
-       ENDIF
-
-       IF ( ALLOCATED( pm25_av ) )  THEN
-          CALL wrd_write_string( 'pm25_av' )
-          WRITE ( 14 )  pm25_av
-       ENDIF
-
-       IF ( ALLOCATED( pm10_av ) )  THEN
-          CALL wrd_write_string( 'pm10_av' )
-          WRITE ( 14 )  pm10_av
-       ENDIF
-
-       IF ( ALLOCATED( s_mass_av ) )  THEN
-          CALL wrd_write_string( 's_mass_av' )
-          DO  ic = 1, ncomponents_mass
-             WRITE ( 14 )  s_mass_av(:,:,:,ic)
-          ENDDO
-       ENDIF
-
-       IF ( ALLOCATED( s_h2o_av ) )  THEN
-          CALL wrd_write_string( 's_h2o_av' )
-          WRITE ( 14 )  s_h2o_av
-       ENDIF
-
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-          CALL wrd_write_string( 'salsa_gas' )
-          DO  ig = 1, ngases_salsa
-             WRITE ( 14 )  salsa_gas(ig)%conc
-          ENDDO
-       ENDIF
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-       DO  ic = 1, nbins_aerosol * ncomponents_mass
-          WRITE( counter, '(I3.3)')  ic
-          tmp_3d = aerosol_mass(ic)%conc
-          CALL wrd_mpi_io( 'aerosol_mass_' // counter, tmp_3d )
-       ENDDO
-
-       DO  ib = 1, nbins_aerosol
-          WRITE( counter, '(I3.3)')  ib
-          tmp_3d = aerosol_number(ib)%conc
-          CALL wrd_mpi_io( 'aerosol_number_' // counter, tmp_3d )
-       ENDDO
-
-       IF (  .NOT. salsa_gases_from_chem )  THEN
-
-          IF ( ALLOCATED( salsa_gases_av ) )  THEN
-             DO  ig = 1, ngases_salsa
-                WRITE( counter, '(I3.3)')  ig
-                tmp_3d = salsa_gases_av(:,:,:,ig)
-                CALL wrd_mpi_io( 'salsa_gases_av_' // counter, tmp_3d )
-             ENDDO
-          ENDIF
-       ENDIF
-
-       IF ( ALLOCATED( ldsa_av ) )  CALL wrd_mpi_io( 'ldsa_av', ldsa_av )
-
-
-       IF ( ALLOCATED( mbins_av ) )  THEN
-          DO  ib = 1, nbins_aerosol
-             WRITE( counter, '(I3.3)')  ib
-             tmp_3d = mbins_av(:,:,:,ib)
-             CALL wrd_mpi_io( 'mbins_av_' // counter, tmp_3d )
-          ENDDO
-       ENDIF
-
-       IF ( ALLOCATED( nbins_av ) )  THEN
-          DO  ib = 1, nbins_aerosol
-             WRITE( counter, '(I3.3)')  ib
-             tmp_3d = nbins_av(:,:,:,ib)
-             CALL wrd_mpi_io( 'nbins_av_' // counter, tmp_3d )
-          ENDDO
-       ENDIF
-
-       IF ( ALLOCATED( ntot_av )  )  CALL wrd_mpi_io( 'ntot_av', ntot_av )
-       IF ( ALLOCATED( nufp_av )  )  CALL wrd_mpi_io( 'nufp_av', nufp_av )
-       IF ( ALLOCATED( pm01_av )  )  CALL wrd_mpi_io( 'pm01_av', pm01_av )
-       IF ( ALLOCATED( pm25_av )  )  CALL wrd_mpi_io( 'pm25_av', pm25_av )
-       IF ( ALLOCATED( pm10_av )  )  CALL wrd_mpi_io( 'pm10_av', pm10_av )
-       IF ( ALLOCATED( s_h2o_av ) )  CALL wrd_mpi_io( 's_h2o_av', s_h2o_av )
-
-       IF ( ALLOCATED( s_mass_av ) )  THEN
-          DO  ic = 1, ncomponents_mass
-             WRITE( counter, '(I3.3)')  ic
-             tmp_3d = s_mass_av(:,:,:,ic)
-             CALL wrd_mpi_io( 's_mass_av_' // counter, tmp_3d )
-          ENDDO
-       ENDIF
-
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-          DO  ig = 1, ngases_salsa
-             WRITE( counter, '(I3.3)')  ig
-             tmp_3d = salsa_gas(ig)%conc
-             CALL wrd_mpi_io( 'salsa_gas_' // counter, tmp_3d )
-          ENDDO
-       ENDIF
-
-       DEALLOCATE( tmp_3d )
-
-    ENDIF
-
- END SUBROUTINE salsa_wrd_local
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Performs necessary unit and dimension conversion between the host model and
-!> SALSA module, and calls the main SALSA routine.
-!> Partially adobted form the original SALSA boxmodel version.
-!> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA
-!> 05/2016 Juha: This routine is still pretty much in its original shape.
-!>               It's dumb as a mule and twice as ugly, so implementation of
-!>               an improved solution is necessary sooner or later.
-!> Juha Tonttila, FMI, 2014
-!> Jaakko Ahola, FMI, 2016
-!> Only aerosol processes included, Mona Kurppa, UHel, 2017
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_driver( i, j, prunmode )
-
-    USE arrays_3d,                                                                                 &
-        ONLY: pt_p, q_p, u, v, w
-
-    USE plant_canopy_model_mod,                                                                    &
-        ONLY: lad_s
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  endi    !< end index
-    INTEGER(iwp) ::  ib      !< loop index
-    INTEGER(iwp) ::  ic      !< loop index
-    INTEGER(iwp) ::  ig      !< loop index
-    INTEGER(iwp) ::  k_wall  !< vertical index of topography top
-    INTEGER(iwp) ::  k       !< loop index
-    INTEGER(iwp) ::  l       !< loop index
-    INTEGER(iwp) ::  nc_h2o  !< index of H2O in the prtcl index table
-    INTEGER(iwp) ::  ss      !< loop index
-    INTEGER(iwp) ::  str     !< start index
-    INTEGER(iwp) ::  vc      !< default index in prtcl
-
-    INTEGER(iwp), INTENT(in) ::  i         !< loop index
-    INTEGER(iwp), INTENT(in) ::  j         !< loop index
-    INTEGER(iwp), INTENT(in) ::  prunmode  !< 1: Initialization, 2: Spinup, 3: Regular runtime
-
-    REAL(wp) ::  cw_old  !< previous H2O mixing ratio
-    REAL(wp) ::  flag    !< flag to mask topography grid points
-    REAL(wp) ::  in_lad  !< leaf area density (m2/m3)
-    REAL(wp) ::  in_rh   !< relative humidity
-    REAL(wp) ::  zgso4   !< SO4
-    REAL(wp) ::  zghno3  !< HNO3
-    REAL(wp) ::  zgnh3   !< NH3
-    REAL(wp) ::  zgocnv  !< non-volatile OC
-    REAL(wp) ::  zgocsv  !< semi-volatile OC
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_adn  !< air density (kg/m3)
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_cs   !< H2O sat. vapour conc.
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_cw   !< H2O vapour concentration
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_p    !< pressure (Pa)
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_t    !< temperature (K)
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_u    !< wind magnitude (m/s)
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  kvis    !< kinematic viscosity of air(m2/s)
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  ppm_to_nconc  !< Conversion factor from ppm to #/m3
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) ::  schmidt_num  !< particle Schmidt number
-    REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) ::  vd           !< particle fall seed (m/s)
-
-    TYPE(t_section), DIMENSION(nbins_aerosol) ::  lo_aero   !< additional variable for OpenMP
-    TYPE(t_section), DIMENSION(nbins_aerosol) ::  aero_old  !< helper array
-
-    aero_old(:)%numc = 0.0_wp
-    in_lad           = 0.0_wp
-    in_u             = 0.0_wp
-    kvis             = 0.0_wp
-    lo_aero          = aero
-    schmidt_num      = 0.0_wp
-    vd               = 0.0_wp
-    zgso4            = nclim
-    zghno3           = nclim
-    zgnh3            = nclim
-    zgocnv           = nclim
-    zgocsv           = nclim
-!
-!-- Aerosol number is always set, but mass can be uninitialized
-    DO ib = 1, nbins_aerosol
-       lo_aero(ib)%volc(:)  = 0.0_wp
-       aero_old(ib)%volc(:) = 0.0_wp
-    ENDDO
-!
-!-- Set the salsa runtime config (How to make this more efficient?)
-    CALL set_salsa_runtime( prunmode )
-!
-!-- Calculate thermodynamic quantities needed in SALSA
-    CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw, cs_ij=in_cs, adn_ij=in_adn )
-!
-!-- Magnitude of wind: needed for deposition
-    IF ( lsdepo )  THEN
-       in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 +         &
-                               ( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 +         &
-                               ( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j,  i) ) )**2 )
-    ENDIF
-!
-!-- Calculate conversion factors for gas concentrations
-    ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:)
-!
-!-- Determine topography-top index on scalar grid
-    k_wall = k_topo_top(j,i)
-
-    DO k = nzb+1, nzt
-!
-!--    Predetermine flag to mask topography
-       flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!
-!--    Wind velocity for dry depositon on vegetation
-       IF ( lsdepo_pcm  .AND.  plant_canopy )  THEN
-          in_lad = lad_s( MAX( k-k_wall,0 ),j,i)
-       ENDIF
-!
-!--    For initialization and spinup, limit the RH with the parameter rhlim
-       IF ( prunmode < 3 ) THEN
-          in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim )
-       ELSE
-          in_cw(k) = in_cw(k)
-       ENDIF
-       cw_old = in_cw(k) !* in_adn(k)
-!
-!--    Set volume concentrations:
-!--    Sulphate (SO4) or sulphuric acid H2SO4
-       IF ( index_so4 > 0 )  THEN
-          vc = 1
-          str = ( index_so4-1 ) * nbins_aerosol + 1    ! start index
-          endi = index_so4 * nbins_aerosol             ! end index
-          ic = 1
-          DO ss = str, endi
-             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4
-             ic = ic+1
-          ENDDO
-          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
-       ENDIF
-!
-!--    Organic carbon (OC) compounds
-       IF ( index_oc > 0 )  THEN
-          vc = 2
-          str = ( index_oc-1 ) * nbins_aerosol + 1
-          endi = index_oc * nbins_aerosol
-          ic = 1
-          DO ss = str, endi
-             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc
-             ic = ic+1
-          ENDDO
-          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
-       ENDIF
-!
-!--    Black carbon (BC)
-       IF ( index_bc > 0 )  THEN
-          vc = 3
-          str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
-          endi = index_bc * nbins_aerosol
-          ic = 1 + end_subrange_1a
-          DO ss = str, endi
-             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc
-             ic = ic+1
-          ENDDO
-          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
-       ENDIF
-!
-!--    Dust (DU)
-       IF ( index_du > 0 )  THEN
-          vc = 4
-          str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
-          endi = index_du * nbins_aerosol
-          ic = 1 + end_subrange_1a
-          DO ss = str, endi
-             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu
-             ic = ic+1
-          ENDDO
-          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
-       ENDIF
-!
-!--    Sea salt (SS)
-       IF ( index_ss > 0 )  THEN
-          vc = 5
-          str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
-          endi = index_ss * nbins_aerosol
-          ic = 1 + end_subrange_1a
-          DO ss = str, endi
-             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss
-             ic = ic+1
-          ENDDO
-          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
-       ENDIF
-!
-!--    Nitrate (NO(3-)) or nitric acid HNO3
-       IF ( index_no > 0 )  THEN
-          vc = 6
-          str = ( index_no-1 ) * nbins_aerosol + 1
-          endi = index_no * nbins_aerosol
-          ic = 1
-          DO ss = str, endi
-             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3
-             ic = ic+1
-          ENDDO
-          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
-       ENDIF
-!
-!--    Ammonium (NH(4+)) or ammonia NH3
-       IF ( index_nh > 0 )  THEN
-          vc = 7
-          str = ( index_nh-1 ) * nbins_aerosol + 1
-          endi = index_nh * nbins_aerosol
-          ic = 1
-          DO ss = str, endi
-             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3
-             ic = ic+1
-          ENDDO
-          aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
-       ENDIF
-!
-!--    Water (always used)
-       nc_h2o = get_index( prtcl,'H2O' )
-       vc = 8
-       str = ( nc_h2o-1 ) * nbins_aerosol + 1
-       endi = nc_h2o * nbins_aerosol
-       ic = 1
-       IF ( advect_particle_water )  THEN
-          DO ss = str, endi
-             lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o
-             ic = ic+1
-          ENDDO
-       ELSE
-         lo_aero(1:nbins_aerosol)%volc(vc) = mclim
-       ENDIF
-       aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc)
-!
-!--    Number concentrations (numc) and particle sizes
-!--    (dwet = wet diameter, core = dry volume)
-       DO  ib = 1, nbins_aerosol
-          lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i)
-          aero_old(ib)%numc = lo_aero(ib)%numc
-          IF ( lo_aero(ib)%numc > nclim )  THEN
-             lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp
-             lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc
-          ELSE
-             lo_aero(ib)%dwet = lo_aero(ib)%dmid
-             lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3
-          ENDIF
-       ENDDO
-!
-!--    Calculate the ambient sizes of particles by equilibrating soluble fraction of particles with
-!--    water using the ZSR method.
-       in_rh = in_cw(k) / in_cs(k)
-       IF ( prunmode==1  .OR.  .NOT. advect_particle_water )  THEN
-          CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. )
-       ENDIF
-!
-!--    Gaseous tracer concentrations in #/m3
-       IF ( salsa_gases_from_chem )  THEN
-!
-!--       Convert concentrations in ppm to #/m3
-          zgso4  = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k)
-          zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k)
-          zgnh3  = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k)
-          zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k)
-          zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k)
-       ELSE
-          zgso4  = salsa_gas(1)%conc(k,j,i)
-          zghno3 = salsa_gas(2)%conc(k,j,i)
-          zgnh3  = salsa_gas(3)%conc(k,j,i)
-          zgocnv = salsa_gas(4)%conc(k,j,i)
-          zgocsv = salsa_gas(5)%conc(k,j,i)
-       ENDIF
-!
-!--    Calculate aerosol processes:
-!--    *********************************************************************************************
-!
-!--    Coagulation
-       IF ( lscoag )   THEN
-          CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) )
-       ENDIF
-!
-!--    Condensation
-       IF ( lscnd )   THEN
-          CALL condensation( lo_aero, zgso4, zgocnv, zgocsv,  zghno3, zgnh3, in_cw(k), in_cs(k),   &
-                             in_t(k), in_p(k), dt_salsa, prtcl )
-       ENDIF
-!
-!--    Deposition
-       IF ( lsdepo )  THEN
-          CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:),&
-                           vd(k,:) )
-       ENDIF
-!
-!--    Size distribution bin update
-       IF ( lsdistupdate )   THEN
-          CALL distr_update( lo_aero )
-       ENDIF
-!--    *********************************************************************************************
-
-       IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:)
-!
-!--    Calculate changes in concentrations
-       DO ib = 1, nbins_aerosol
-          aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc -   &
-                                           aero_old(ib)%numc ) * flag
-       ENDDO
-
-       IF ( index_so4 > 0 )  THEN
-          vc = 1
-          str = ( index_so4-1 ) * nbins_aerosol + 1
-          endi = index_so4 * nbins_aerosol
-          ic = 1
-          DO ss = str, endi
-             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
-                                            aero_old(ic)%volc(vc) ) * arhoh2so4 * flag
-             ic = ic+1
-          ENDDO
-       ENDIF
-
-       IF ( index_oc > 0 )  THEN
-          vc = 2
-          str = ( index_oc-1 ) * nbins_aerosol + 1
-          endi = index_oc * nbins_aerosol
-          ic = 1
-          DO ss = str, endi
-             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
-                                            aero_old(ic)%volc(vc) ) * arhooc * flag
-             ic = ic+1
-          ENDDO
-       ENDIF
-
-       IF ( index_bc > 0 )  THEN
-          vc = 3
-          str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a
-          endi = index_bc * nbins_aerosol
-          ic = 1 + end_subrange_1a
-          DO ss = str, endi
-             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
-                                            aero_old(ic)%volc(vc) ) * arhobc * flag
-             ic = ic+1
-          ENDDO
-       ENDIF
-
-       IF ( index_du > 0 )  THEN
-          vc = 4
-          str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a
-          endi = index_du * nbins_aerosol
-          ic = 1 + end_subrange_1a
-          DO ss = str, endi
-             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
-                                            aero_old(ic)%volc(vc) ) * arhodu * flag
-             ic = ic+1
-          ENDDO
-       ENDIF
-
-       IF ( index_ss > 0 )  THEN
-          vc = 5
-          str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a
-          endi = index_ss * nbins_aerosol
-          ic = 1 + end_subrange_1a
-          DO ss = str, endi
-             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
-                                            aero_old(ic)%volc(vc) ) * arhoss * flag
-             ic = ic+1
-          ENDDO
-       ENDIF
-
-       IF ( index_no > 0 )  THEN
-          vc = 6
-          str = ( index_no-1 ) * nbins_aerosol + 1
-          endi = index_no * nbins_aerosol
-          ic = 1
-          DO ss = str, endi
-             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
-                                            aero_old(ic)%volc(vc) ) * arhohno3 * flag
-             ic = ic+1
-          ENDDO
-       ENDIF
-
-       IF ( index_nh > 0 )  THEN
-          vc = 7
-          str = ( index_nh-1 ) * nbins_aerosol + 1
-          endi = index_nh * nbins_aerosol
-          ic = 1
-          DO ss = str, endi
-             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
-                                            aero_old(ic)%volc(vc) ) * arhonh3 * flag
-             ic = ic+1
-          ENDDO
-       ENDIF
-
-       IF ( advect_particle_water )  THEN
-          nc_h2o = get_index( prtcl,'H2O' )
-          vc = 8
-          str = ( nc_h2o-1 ) * nbins_aerosol + 1
-          endi = nc_h2o * nbins_aerosol
-          ic = 1
-          DO ss = str, endi
-             aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -&
-                                            aero_old(ic)%volc(vc) ) * arhoh2o * flag
-             ic = ic+1
-          ENDDO
-          IF ( prunmode == 1 )  THEN
-             nc_h2o = get_index( prtcl,'H2O' )
-             vc = 8
-             str = ( nc_h2o-1 ) * nbins_aerosol + 1
-             endi = nc_h2o * nbins_aerosol
-             ic = 1
-             DO ss = str, endi
-                aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), ( lo_aero(ic)%volc(vc) - &
-                                                aero_old(ic)%volc(vc) ) * arhoh2o )
-                IF ( k == nzb+1 )  THEN
-                   aerosol_mass(ss)%init(k-1) = aerosol_mass(ss)%init(k)
-                ELSEIF ( k == nzt  )  THEN
-                   aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k)
-                   aerosol_mass(ss)%conc(k+1,j,i) = aerosol_mass(ss)%init(k)
-                ENDIF
-                ic = ic+1
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Condensation of precursor gases
-       IF ( lscndgas )  THEN
-          IF ( salsa_gases_from_chem )  THEN
-!
-!--          SO4 (or H2SO4)
-             ig = gas_index_chem(1)
-             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 /               &
-                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
-!
-!--          HNO3
-             ig = gas_index_chem(2)
-             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 /              &
-                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
-!
-!--          NH3
-             ig = gas_index_chem(3)
-             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 /               &
-                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
-!
-!--          non-volatile OC
-             ig = gas_index_chem(4)
-             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv /              &
-                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
-!
-!--          semi-volatile OC
-             ig = gas_index_chem(5)
-             chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv /              &
-                                            ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag
-
-          ELSE
-!
-!--          SO4 (or H2SO4)
-             salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 -                       &
-                                        salsa_gas(1)%conc(k,j,i) ) * flag
-!
-!--          HNO3
-             salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 -                      &
-                                        salsa_gas(2)%conc(k,j,i) ) * flag
-!
-!--          NH3
-             salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 -                       &
-                                        salsa_gas(3)%conc(k,j,i) ) * flag
-!
-!--          non-volatile OC
-             salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv -                      &
-                                        salsa_gas(4)%conc(k,j,i) ) * flag
-!
-!--          semi-volatile OC
-             salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv -                      &
-                                        salsa_gas(5)%conc(k,j,i) ) * flag
-          ENDIF
-       ENDIF
-!
-!--    Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run.
-!--    This releases heat and changes pt. Assumes no temperature change during SALSA run.
-!--    q = r / (1+r), Euler method for integration
-!
-       IF ( feedback_to_palm )  THEN
-          q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )**2 *                &
-                       ( in_cw(k) - cw_old ) * in_adn(k) * flag
-          pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / &
-                        in_adn(k) + 1.0_wp )**2 * pt_p(k,j,i) / in_t(k) * flag
-       ENDIF
-
-    ENDDO   ! k
-
-!
-!-- Set surfaces and wall fluxes due to deposition
-    IF ( lsdepo  .AND.  lsdepo_surf  .AND.  prunmode == 3 )  THEN
-       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-          CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. )
-          DO  l = 0, 3
-             CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. )
-          ENDDO
-       ELSE
-          DO  l = 0, 1
-             CALL depo_surf( i, j, surf_usm_h(l), vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h(l) )
-          ENDDO
-          DO  l = 0, 3
-             CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., usm_to_depo_v(l) )
-          ENDDO
-          DO  l = 0, 1
-             CALL depo_surf( i, j, surf_lsm_h(l), vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h(l) )
-          ENDDO
-          DO  l = 0, 3
-             CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., lsm_to_depo_v(l) )
-          ENDDO
-       ENDIF
-    ENDIF
-
-    IF ( prunmode < 3 )  THEN
-       !$OMP MASTER
-       aero = lo_aero
-       !$OMP END MASTER
-    END IF
-
- END SUBROUTINE salsa_driver
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set logical switches according to the salsa_parameters options.
-!> Juha Tonttila, FMI, 2014
-!> Only aerosol processes included, Mona Kurppa, UHel, 2017
-!------------------------------------------------------------------------------!
- SUBROUTINE set_salsa_runtime( prunmode )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(in) ::  prunmode
-
-    SELECT CASE(prunmode)
-
-       CASE(1) !< Initialization
-          lscoag       = .FALSE.
-          lscnd        = .FALSE.
-          lscndgas     = .FALSE.
-          lscndh2oae   = .FALSE.
-          lsdepo       = .FALSE.
-          lsdepo_pcm   = .FALSE.
-          lsdepo_surf  = .FALSE.
-          lsdistupdate = .TRUE.
-          lspartition  = .FALSE.
-
-       CASE(2)  !< Spinup period
-          lscoag      = ( .FALSE. .AND. nlcoag   )
-          lscnd       = ( .TRUE.  .AND. nlcnd    )
-          lscndgas    = ( .TRUE.  .AND. nlcndgas )
-          lscndh2oae  = ( .TRUE.  .AND. nlcndh2oae )
-
-       CASE(3)  !< Run
-          lscoag       = nlcoag
-          lscnd        = nlcnd
-          lscndgas     = nlcndgas
-          lscndh2oae   = nlcndh2oae
-          lsdepo       = nldepo
-          lsdepo_pcm   = nldepo_pcm
-          lsdepo_surf  = nldepo_surf
-          lsdistupdate = nldistupdate
-    END SELECT
-
-
- END SUBROUTINE set_salsa_runtime
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates the absolute temperature (using hydrostatic pressure), saturation
-!> vapour pressure and mixing ratio over water, relative humidity and air
-!> density needed in the SALSA model.
-!> NOTE, no saturation adjustment takes place -> the resulting water vapour
-!> mixing ratio can be supersaturated, allowing the microphysical calculations
-!> in SALSA.
-!
-!> Juha Tonttila, FMI, 2014 (original SALSAthrm)
-!> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes)
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij )
-
-    USE arrays_3d,                                                                                 &
-        ONLY: pt, q, zu
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  barometric_formula, exner_function, ideal_gas_law_rho, magnus
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(in) ::  i  !<
-    INTEGER(iwp), INTENT(in) ::  j  !<
-
-    REAL(wp) ::  t_surface  !< absolute surface temperature (K)
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  e_s  !< saturation vapour pressure over water (Pa)
-
-    REAL(wp), DIMENSION(:), INTENT(inout) ::  adn_ij   !< air density (kg/m3)
-    REAL(wp), DIMENSION(:), INTENT(inout) ::  p_ij     !< air pressure (Pa)
-    REAL(wp), DIMENSION(:), INTENT(inout) ::  temp_ij  !< air temperature (K)
-
-    REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::  cw_ij  !< water vapour concentration (kg/m3)
-    REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::  cs_ij  !< saturation water vap. conc.(kg/m3)
-!
-!-- Pressure p_ijk (Pa) = hydrostatic pressure
-    t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp )
-    p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp )
-!
-!-- Absolute ambient temperature (K)
-    temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) )
-!
-!-- Air density
-    adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) )
-!
-!-- Water vapour concentration r_v (kg/m3)
-    IF ( PRESENT( cw_ij ) )  THEN
-       cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:)
-    ENDIF
-!
-!-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa)
-    IF ( PRESENT( cs_ij ) )  THEN
-       e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp /           &
-                temp_ij(:) ) )! magnus( temp_ij(:) )
-       cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:)
-    ENDIF
-
- END SUBROUTINE salsa_thrm_ij
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates ambient sizes of particles by equilibrating soluble fraction of
-!> particles with water using the ZSR method (Stokes and Robinson, 1966).
-!> Method:
-!> Following chemical components are assumed water-soluble
-!> - (ammonium) sulphate (100%)
-!> - sea salt (100 %)
-!> - organic carbon (epsoc * 100%)
-!> Exact thermodynamic considerations neglected.
-!> - If particles contain no sea salt, calculation according to sulphate
-!>   properties
-!> - If contain sea salt but no sulphate, calculation according to sea salt
-!>   properties
-!> - If contain both sulphate and sea salt -> the molar fraction of these
-!>   compounds determines which one of them is used as the basis of calculation.
-!> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is
-!> replaced by sulphate; thus only either sulphate + organics or sea salt +
-!> organics is included in the calculation of soluble fraction.
-!> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and
-!> optical properties of mixed-salt aerosols of atmospheric importance,
-!> J. Geophys. Res., 102 (D2), 1883-1893 (1997)
-!
-!> Coded by:
-!> Hannele Korhonen (FMI) 2005
-!> Harri Kokkola (FMI) 2006
-!> Matti Niskanen(FMI) 2012
-!> Anton Laakso  (FMI) 2013
-!> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014
-!
-!> fxm: should sea salt form a solid particle when prh is very low (even though
-!> it could be mixed with e.g. sulphate)?
-!> fxm: crashes if no sulphate or sea salt
-!> fxm: do we really need to consider Kelvin effect for subrange 2
-!------------------------------------------------------------------------------!
- SUBROUTINE equilibration( prh, ptemp, paero, init )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: ib      !< loop index
-    INTEGER(iwp) :: counti  !< loop index
-
-    LOGICAL, INTENT(in) ::  init   !< TRUE: Initialization, FALSE: Normal runtime: update water
-                                   !< content only for 1a
-
-    REAL(wp) ::  zaw      !< water activity [0-1]
-    REAL(wp) ::  zcore    !< Volume of dry particle
-    REAL(wp) ::  zdold    !< Old diameter
-    REAL(wp) ::  zdwet    !< Wet diameter or mean droplet diameter
-    REAL(wp) ::  zke      !< Kelvin term in the KÃ¶hler equation
-    REAL(wp) ::  zlwc     !< liquid water content [kg/m3-air]
-    REAL(wp) ::  zrh      !< Relative humidity
-
-    REAL(wp), DIMENSION(maxspec) ::  zbinmol  !< binary molality of each components (mol/kg)
-    REAL(wp), DIMENSION(maxspec) ::  zvpart   !< volume of chem. compounds in one particle
-
-    REAL(wp), INTENT(in) ::  prh    !< relative humidity [0-1]
-    REAL(wp), INTENT(in) ::  ptemp  !< temperature (K)
-
-    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
-
-    zaw       = 0.0_wp
-    zlwc      = 0.0_wp
-!
-!-- Relative humidity:
-    zrh = prh
-    zrh = MAX( zrh, 0.05_wp )
-    zrh = MIN( zrh, 0.98_wp)
-!
-!-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL
-    DO  ib = start_subrange_1a, end_subrange_1a   ! size bin
-
-       zbinmol = 0.0_wp
-       zdold   = 1.0_wp
-       zke     = 1.02_wp
-
-       IF ( paero(ib)%numc > nclim )  THEN
-!
-!--       Volume in one particle
-          zvpart = 0.0_wp
-          zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc
-          zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc
-!
-!--       Total volume and wet diameter of one dry particle
-          zcore = SUM( zvpart(1:2) )
-          zdwet = paero(ib)%dwet
-
-          counti = 0
-          DO  WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp )
-
-             zdold = MAX( zdwet, 1.0E-20_wp )
-             zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow
-!
-!--          Binary molalities (mol/kg):
-!--          Sulphate
-             zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 -     &
-                          3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp  * zaw**4
-!--          Organic carbon
-             zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
-!--          Nitric acid
-             zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 &
-                          + 5.510176187E+2_wp * zaw**3 - 1.460055286E+3_wp * zaw**4                &
-                          + 1.894467542E+3_wp * zaw**5 - 1.220611402E+3_wp * zaw**6                &
-                          + 3.098597737E+2_wp * zaw**7
-!
-!--          Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in
-!--          Seinfeld and Pandis (2006))
-             zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) +                 &
-                    epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) +                   &
-                    ( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6)
-!
-!--          Particle wet diameter (m)
-             zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) +    &
-                       zcore / api6 )**0.33333333_wp
-!
-!--          Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid
-!--          overflow.
-             zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp *  zdwet ) ) )
-
-             counti = counti + 1
-             IF ( counti > 1000 )  THEN
-                message_string = 'Subrange 1: no convergence!'
-                CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 )
-             ENDIF
-          ENDDO
-!
-!--       Instead of lwc, use the volume concentration of water from now on
-!--       (easy to convert...)
-          paero(ib)%volc(8) = zlwc / arhoh2o
-!
-!--       If this is initialization, update the core and wet diameter
-          IF ( init )  THEN
-             paero(ib)%dwet = zdwet
-             paero(ib)%core = zcore
-          ENDIF
-
-       ELSE
-!--       If initialization
-!--       1.2) empty bins given bin average values
-          IF ( init )  THEN
-             paero(ib)%dwet = paero(ib)%dmid
-             paero(ib)%core = api6 * paero(ib)%dmid**3
-          ENDIF
-
-       ENDIF
-
-    ENDDO  ! ib
-!
-!-- 2) Regime 2a: sulphate, OC, BC and sea salt
-!--    This is done only for initialization call, otherwise the water contents
-!--    are computed via condensation
-    IF ( init )  THEN
-       DO  ib = start_subrange_2a, end_subrange_2b
-!
-!--       Initialize
-          zke     = 1.02_wp
-          zbinmol = 0.0_wp
-          zdold   = 1.0_wp
-!
-!--       1) Particle properties calculated for non-empty bins
-          IF ( paero(ib)%numc > nclim )  THEN
-!
-!--          Volume in one particle [fxm]
-             zvpart = 0.0_wp
-             zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc
-!
-!--          Total volume and wet diameter of one dry particle [fxm]
-             zcore = SUM( zvpart(1:5) )
-             zdwet = paero(ib)%dwet
-
-             counti = 0
-             DO  WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp )
-
-                zdold = MAX( zdwet, 1.0E-20_wp )
-                zaw = zrh / zke
-!
-!--             Binary molalities (mol/kg):
-!--             Sulphate
-                zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 -  &
-                             3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp  * zaw**4
-!--             Organic carbon
-                zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o
-!--             Nitric acid
-                zbinmol(6) = 2.306844303E+1_wp          - 3.563608869E+1_wp * zaw -                &
-                             6.210577919E+1_wp * zaw**2 + 5.510176187E+2_wp * zaw**3 -             &
-                             1.460055286E+3_wp * zaw**4 + 1.894467542E+3_wp * zaw**5 -             &
-                             1.220611402E+3_wp * zaw**6 + 3.098597737E+2_wp * zaw**7
-!--             Sea salt (natrium chloride)
-                zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 -   &
-                             1.8458287E+2_wp * zaw**3 + 4.153689E+1_wp  * zaw**4
-!
-!--             Calculate the liquid water content (kg/m3-air)
-                zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) +              &
-                       epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) +            &
-                       ( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) +                &
-                       ( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5)
-
-!--             Particle wet radius (m)
-                zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 )  + &
-                           zcore / api6 )**0.33333333_wp
-!
-!--             Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006))
-                zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) )
-
-                counti = counti + 1
-                IF ( counti > 1000 )  THEN
-                   message_string = 'Subrange 2: no convergence!'
-                CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 )
-                ENDIF
-             ENDDO
-!
-!--          Liquid water content; instead of LWC use the volume concentration
-             paero(ib)%volc(8) = zlwc / arhoh2o
-             paero(ib)%dwet    = zdwet
-             paero(ib)%core    = zcore
-
-          ELSE
-!--          2.2) empty bins given bin average values
-             paero(ib)%dwet = paero(ib)%dmid
-             paero(ib)%core = api6 * paero(ib)%dmid**3
-          ENDIF
-
-       ENDDO   ! ib
-    ENDIF
-
- END SUBROUTINE equilibration
-
-!------------------------------------------------------------------------------!
-!> Description:
-!> ------------
-!> Calculation of the settling velocity vc (m/s) per aerosol size bin and
-!> deposition on plant canopy (lsdepo_pcm).
-!
-!> Deposition is based on either the scheme presented in:
-!> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to
-!> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1)
-!> OR
-!> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also
-!> collection due to turbulent impaction, hereafter P10)
-!
-!> Equation numbers refer to equation in Jacobson (2005): Fundamentals of
-!> Atmospheric Modeling, 2nd Edition.
-!
-!> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha
-!> Tonttila (KIT/FMI) and Zubair Maalick (UEF).
-!> Rewritten to PALM by Mona Kurppa (UH), 2017.
-!
-!> Call for grid point i,j,k
-!------------------------------------------------------------------------------!
-
- SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc )
-
-    USE plant_canopy_model_mod,                                                &
-        ONLY:  canopy_drag_coeff
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib   !< loop index
-    INTEGER(iwp) ::  ic   !< loop index
-
-    REAL(wp) ::  alpha             !< parameter, Table 3 in Z01
-    REAL(wp) ::  avis              !< molecular viscocity of air (kg/(m*s))
-    REAL(wp) ::  beta_im           !< parameter for turbulent impaction
-    REAL(wp) ::  c_brownian_diff   !< coefficient for Brownian diffusion
-    REAL(wp) ::  c_impaction       !< coefficient for inertial impaction
-    REAL(wp) ::  c_interception    !< coefficient for interception
-    REAL(wp) ::  c_turb_impaction  !< coefficient for turbulent impaction
-    REAL(wp) ::  depo              !< deposition velocity (m/s)
-    REAL(wp) ::  gamma             !< parameter, Table 3 in Z01
-    REAL(wp) ::  lambda            !< molecular mean free path (m)
-    REAL(wp) ::  mdiff             !< particle diffusivity coefficient
-    REAL(wp) ::  par_a             !< parameter A for the characteristic radius of collectors,
-                                   !< Table 3 in Z01
-    REAL(wp) ::  par_l             !< obstacle characteristic dimension in P10
-    REAL(wp) ::  pdn               !< particle density (kg/m3)
-    REAL(wp) ::  ustar             !< friction velocity (m/s)
-    REAL(wp) ::  va                !< thermal speed of an air molecule (m/s)
-
-    REAL(wp), INTENT(in) ::  adn    !< air density (kg/m3)
-    REAL(wp), INTENT(in) ::  lad    !< leaf area density (m2/m3)
-    REAL(wp), INTENT(in) ::  mag_u  !< wind velocity (m/s)
-    REAL(wp), INTENT(in) ::  tk     !< abs.temperature (K)
-
-    REAL(wp), INTENT(inout) ::  kvis   !< kinematic viscosity of air (m2/s)
-
-    REAL(wp), DIMENSION(nbins_aerosol) ::  beta   !< Cunningham slip-flow correction factor
-    REAL(wp), DIMENSION(nbins_aerosol) ::  Kn     !< Knudsen number
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zdwet  !< wet diameter (m)
-
-    REAL(wp), DIMENSION(:), INTENT(inout) ::  schmidt_num  !< particle Schmidt number
-    REAL(wp), DIMENSION(:), INTENT(inout) ::  vc  !< critical fall speed i.e. settling velocity of
-                                                  !< an aerosol particle (m/s)
-
-    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
-!
-!-- Initialise
-    depo  = 0.0_wp
-    pdn   = 1500.0_wp    ! default value
-    ustar = 0.0_wp
-!
-!-- Molecular viscosity of air (Eq. 4.54)
-    avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp
-!
-!-- Kinematic viscosity (Eq. 4.55)
-    kvis =  avis / adn
-!
-!-- Thermal velocity of an air molecule (Eq. 15.32)
-    va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) )
-!
-!-- Mean free path (m) (Eq. 15.24)
-    lambda = 2.0_wp * avis / ( adn * va )
-!
-!-- Particle wet diameter (m)
-    zdwet = paero(:)%dwet
-!
-!-- Knudsen number (Eq. 15.23)
-    Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow
-!
-!-- Cunningham slip-flow correction (Eq. 15.30)
-    beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) )
-!
-!-- Critical fall speed i.e. settling velocity  (Eq. 20.4)
-    vc = MIN( 1.0_wp, zdwet**2 * ( pdn - adn ) * g * beta / ( 18.0_wp * avis ) )
-!
-!-- Deposition on vegetation
-    IF ( lsdepo_pcm  .AND.  plant_canopy  .AND.  lad > 0.0_wp )  THEN
-!
-!--    Parameters for the land use category 'deciduous broadleaf trees'(Table 3)
-       alpha   = alpha_z01(depo_pcm_type_num)
-       gamma   = gamma_z01(depo_pcm_type_num)
-       par_a   = A_z01(depo_pcm_type_num, season_z01) * 1.0E-3_wp
-!
-!--    Deposition efficiencies from Table 1. Constants from Table 2.
-       par_l            = l_p10(depo_pcm_type_num) * 0.01_wp
-       c_brownian_diff  = c_b_p10(depo_pcm_type_num)
-       c_interception   = c_in_p10(depo_pcm_type_num)
-       c_impaction      = c_im_p10(depo_pcm_type_num)
-       beta_im          = beta_im_p10(depo_pcm_type_num)
-       c_turb_impaction = c_it_p10(depo_pcm_type_num)
-
-       DO  ib = 1, nbins_aerosol
-
-          IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
-
-!--       Particle diffusivity coefficient (Eq. 15.29)
-          mdiff = ( abo * tk * beta(ib) ) / ( 3.0_wp * pi * avis * zdwet(ib) )
-!
-!--       Particle Schmidt number (Eq. 15.36)
-          schmidt_num(ib) = kvis / mdiff
-!
-!--       Friction velocity for deposition on vegetation. Calculated following Prandtl (1925):
-          ustar = SQRT( canopy_drag_coeff ) * mag_u
-          SELECT CASE ( depo_pcm_par_num )
-
-             CASE ( 1 )   ! Zhang et al. (2001)
-                CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha,  gamma,  &
-                                   par_a, depo )
-             CASE ( 2 )   ! Petroff & Zhang (2010)
-                CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet,    &
-                                   par_l, c_brownian_diff, c_interception, c_impaction, beta_im,   &
-                                   c_turb_impaction, depo )
-          END SELECT
-!
-!--       Calculate the change in concentrations
-          paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa
-          DO  ic = 1, maxspec+1
-             paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa
-          ENDDO
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE deposition
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1).
-!------------------------------------------------------------------------------!
-
- SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo )
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  rs                !< overall quasi-laminar resistance for particles
-    REAL(wp) ::  stokes_num        !< Stokes number for smooth or bluff surfaces
-
-    REAL(wp), INTENT(in) ::  alpha        !< parameter, Table 3 in Z01
-    REAL(wp), INTENT(in) ::  gamma        !< parameter, Table 3 in Z01
-    REAL(wp), INTENT(in) ::  par_a        !< parameter A for the characteristic diameter of
-                                          !< collectors, Table 3 in Z01
-    REAL(wp), INTENT(in) ::  diameter     !< particle diameter
-    REAL(wp), INTENT(in) ::  schmidt_num  !< particle Schmidt number
-    REAL(wp), INTENT(in) ::  ustar        !< friction velocity (m/s)
-    REAL(wp), INTENT(in) ::  vc           !< terminal velocity (m/s)
-
-    REAL(wp), INTENT(inout)  ::  depo     !< deposition efficiency (m/s)
-
-    IF ( par_a > 0.0_wp )  THEN
-!
-!--    Initialise
-       rs = 0.0_wp
-!
-!--    Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
-       stokes_num = vc * ustar / ( g * par_a )
-!
-!--    The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5)
-       rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num**0.5_wp ) *                &
-                 ( schmidt_num**( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )**2 +          &
-                 0.5_wp * ( diameter / par_a )**2 ) ) )
-
-       depo = rs + vc
-
-    ELSE
-       depo = 0.0_wp
-    ENDIF
-
- END SUBROUTINE depo_vel_Z01
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2).
-!------------------------------------------------------------------------------!
-
- SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, &
-                          c_interception, c_impaction, beta_im, c_turb_impaction, depo )
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  stokes_num        !< Stokes number for smooth or bluff surfaces
-    REAL(wp) ::  tau_plus          !< dimensionless particle relaxation time
-    REAL(wp) ::  v_bd              !< deposition velocity due to Brownian diffusion
-    REAL(wp) ::  v_im              !< deposition velocity due to impaction
-    REAL(wp) ::  v_in              !< deposition velocity due to interception
-    REAL(wp) ::  v_it              !< deposition velocity due to turbulent impaction
-
-    REAL(wp), INTENT(in) ::  beta_im           !< parameter for turbulent impaction
-    REAL(wp), INTENT(in) ::  c_brownian_diff   !< coefficient for Brownian diffusion
-    REAL(wp), INTENT(in) ::  c_impaction       !< coefficient for inertial impaction
-    REAL(wp), INTENT(in) ::  c_interception    !< coefficient for interception
-    REAL(wp), INTENT(in) ::  c_turb_impaction  !< coefficient for turbulent impaction
-    REAL(wp), INTENT(in) ::  kvis_a       !< kinematic viscosity of air (m2/s)
-    REAL(wp), INTENT(in) ::  mag_u        !< wind velocity (m/s)
-    REAL(wp), INTENT(in) ::  par_l        !< obstacle characteristic dimension in P10
-    REAL(wp), INTENT(in) ::  diameter       !< particle diameter
-    REAL(wp), INTENT(in) ::  schmidt_num  !< particle Schmidt number
-    REAL(wp), INTENT(in) ::  ustar        !< friction velocity (m/s)
-    REAL(wp), INTENT(in) ::  vc           !< terminal velocity (m/s)
-
-    REAL(wp), INTENT(inout)  ::  depo     !< deposition efficiency (m/s)
-
-    IF ( par_l > 0.0_wp )  THEN
-!
-!--    Initialise
-       tau_plus = 0.0_wp
-       v_bd     = 0.0_wp
-       v_im     = 0.0_wp
-       v_in     = 0.0_wp
-       v_it     = 0.0_wp
-!
-!--    Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24)
-       stokes_num = vc * ustar / ( g * par_l )
-!
-!--    Non-dimensional relexation time of the particle on top of canopy
-       tau_plus = vc * ustar**2 / ( kvis_a * g )
-!
-!--    Brownian diffusion
-       v_bd = mag_u * c_brownian_diff * schmidt_num**( -0.66666666_wp ) *                          &
-              ( mag_u * par_l / kvis_a )**( -0.5_wp )
-!
-!--    Interception
-       v_in = mag_u * c_interception * diameter / par_l *                                          &
-              ( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) )
-!
-!--    Impaction: Petroff (2009) Eq. 18
-       v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2
-!
-!--    Turbulent impaction
-       IF ( tau_plus < 20.0_wp )  THEN
-          v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2
-       ELSE
-          v_it = c_turb_impaction
-       ENDIF
-
-       depo = ( v_bd + v_in + v_im + v_it + vc )
-
-    ELSE
-       depo = 0.0_wp
-    ENDIF
-
- END SUBROUTINE depo_vel_P10
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the dry deposition on horizontal and vertical surfaces. Implement
-!> as a surface flux.
-!> @todo aerodynamic resistance ignored for now (not important for
-!        high-resolution simulations)
-!------------------------------------------------------------------------------!
- SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array )
-
-    USE arrays_3d,                                                                                 &
-        ONLY: rho_air_zw
-
-    USE surface_mod,                                                                               &
-        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_type
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib      !< loop index
-    INTEGER(iwp) ::  ic      !< loop index
-    INTEGER(iwp) ::  icc     !< additional loop index
-    INTEGER(iwp) ::  k       !< loop index
-    INTEGER(iwp) ::  m       !< loop index
-    INTEGER(iwp) ::  surf_e  !< End index of surface elements at (j,i)-gridpoint
-    INTEGER(iwp) ::  surf_s  !< Start index of surface elements at (j,i)-gridpoint
-
-    INTEGER(iwp), INTENT(in) ::  i  !< loop index
-    INTEGER(iwp), INTENT(in) ::  j  !< loop index
-
-    LOGICAL, INTENT(in) ::  norm   !< to normalise or not
-
-    REAL(wp) ::  alpha             !< parameter, Table 3 in Z01
-    REAL(wp) ::  beta_im           !< parameter for turbulent impaction
-    REAL(wp) ::  c_brownian_diff   !< coefficient for Brownian diffusion
-    REAL(wp) ::  c_impaction       !< coefficient for inertial impaction
-    REAL(wp) ::  c_interception    !< coefficient for interception
-    REAL(wp) ::  c_turb_impaction  !< coefficient for turbulent impaction
-    REAL(wp) ::  gamma             !< parameter, Table 3 in Z01
-    REAL(wp) ::  norm_fac          !< normalisation factor (usually air density)
-    REAL(wp) ::  par_a             !< parameter A for the characteristic radius of collectors,
-                                   !< Table 3 in Z01
-    REAL(wp) ::  par_l             !< obstacle characteristic dimension in P10
-    REAL(wp) ::  rs                !< the overall quasi-laminar resistance for particles
-    REAL(wp) ::  tau_plus          !< dimensionless particle relaxation time
-    REAL(wp) ::  v_bd              !< deposition velocity due to Brownian diffusion
-    REAL(wp) ::  v_im              !< deposition velocity due to impaction
-    REAL(wp) ::  v_in              !< deposition velocity due to interception
-    REAL(wp) ::  v_it              !< deposition velocity due to turbulent impaction
-
-    REAL(wp), DIMENSION(nbins_aerosol) ::  depo      !< deposition efficiency
-    REAL(wp), DIMENSION(nbins_aerosol) ::  depo_sum  !< sum of deposition efficiencies
-
-    REAL(wp), DIMENSION(:), INTENT(in) ::  kvis   !< kinematic viscosity of air (m2/s)
-    REAL(wp), DIMENSION(:), INTENT(in) ::  mag_u  !< wind velocity (m/s)
-
-    REAL(wp), DIMENSION(:,:), INTENT(in) ::  schmidt_num   !< particle Schmidt number
-    REAL(wp), DIMENSION(:,:), INTENT(in) ::  vc            !< terminal velocity (m/s)
-
-    TYPE(match_surface), INTENT(in), OPTIONAL ::  match_array  !< match the deposition module and
-                                                               !< LSM/USM surfaces
-    TYPE(surf_type), INTENT(inout) :: surf                     !< respective surface type
-!
-!-- Initialise
-    depo     = 0.0_wp
-    depo_sum = 0.0_wp
-    rs       = 0.0_wp
-    surf_s   = surf%start_index(j,i)
-    surf_e   = surf%end_index(j,i)
-    tau_plus = 0.0_wp
-    v_bd     = 0.0_wp
-    v_im     = 0.0_wp
-    v_in     = 0.0_wp
-    v_it     = 0.0_wp
-!
-!-- Model parameters for the land use category. If LSM or USM is applied, import
-!-- characteristics. Otherwise, apply surface type "urban".
-    alpha   = alpha_z01(luc_urban)
-    gamma   = gamma_z01(luc_urban)
-    par_a   = A_z01(luc_urban, season_z01) * 1.0E-3_wp
-
-    par_l            = l_p10(luc_urban) * 0.01_wp
-    c_brownian_diff  = c_b_p10(luc_urban)
-    c_interception   = c_in_p10(luc_urban)
-    c_impaction      = c_im_p10(luc_urban)
-    beta_im          = beta_im_p10(luc_urban)
-    c_turb_impaction = c_it_p10(luc_urban)
-
-
-    IF ( PRESENT( match_array ) )  THEN  ! land or urban surface model
-
-       DO  m = surf_s, surf_e
-
-          k = surf%k(m)
-          norm_fac = 1.0_wp
-
-          IF ( norm )  norm_fac = rho_air_zw(k)  ! normalise vertical fluxes by air density
-
-          IF ( match_array%match_lupg(m) > 0 )  THEN
-             alpha = alpha_z01( match_array%match_lupg(m) )
-             gamma = gamma_z01( match_array%match_lupg(m) )
-             par_a = A_z01( match_array%match_lupg(m), season_z01 ) * 1.0E-3_wp
-
-             beta_im          = beta_im_p10( match_array%match_lupg(m) )
-             c_brownian_diff  = c_b_p10( match_array%match_lupg(m) )
-             c_impaction      = c_im_p10( match_array%match_lupg(m) )
-             c_interception   = c_in_p10( match_array%match_lupg(m) )
-             c_turb_impaction = c_it_p10( match_array%match_lupg(m) )
-             par_l            = l_p10( match_array%match_lupg(m) ) * 0.01_wp
-
-             DO  ib = 1, nbins_aerosol
-                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
-                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
-
-                SELECT CASE ( depo_surf_par_num )
-
-                   CASE ( 1 )
-                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
-                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
-                   CASE ( 2 )
-                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
-                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
-                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
-                                         c_turb_impaction, depo(ib) )
-                END SELECT
-             ENDDO
-             depo_sum = depo_sum + surf%frac(m,ind_pav_green) * depo
-          ENDIF
-
-          IF ( match_array%match_luvw(m) > 0 )  THEN
-             alpha = alpha_z01( match_array%match_luvw(m) )
-             gamma = gamma_z01( match_array%match_luvw(m) )
-             par_a = A_z01( match_array%match_luvw(m), season_z01 ) * 1.0E-3_wp
-
-             beta_im          = beta_im_p10( match_array%match_luvw(m) )
-             c_brownian_diff  = c_b_p10( match_array%match_luvw(m) )
-             c_impaction      = c_im_p10( match_array%match_luvw(m) )
-             c_interception   = c_in_p10( match_array%match_luvw(m) )
-             c_turb_impaction = c_it_p10( match_array%match_luvw(m) )
-             par_l            = l_p10( match_array%match_luvw(m) ) * 0.01_wp
-
-             DO  ib = 1, nbins_aerosol
-                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
-                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
-
-                SELECT CASE ( depo_surf_par_num )
-
-                   CASE ( 1 )
-                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
-                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
-                   CASE ( 2 )
-                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
-                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
-                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
-                                         c_turb_impaction, depo(ib) )
-                END SELECT
-             ENDDO
-             depo_sum = depo_sum + surf%frac(m,ind_veg_wall) * depo
-          ENDIF
-
-          IF ( match_array%match_luww(m) > 0 )  THEN
-             alpha = alpha_z01( match_array%match_luww(m) )
-             gamma = gamma_z01( match_array%match_luww(m) )
-             par_a = A_z01( match_array%match_luww(m), season_z01 ) * 1.0E-3_wp
-
-             beta_im          = beta_im_p10( match_array%match_luww(m) )
-             c_brownian_diff  = c_b_p10( match_array%match_luww(m) )
-             c_impaction      = c_im_p10( match_array%match_luww(m) )
-             c_interception   = c_in_p10( match_array%match_luww(m) )
-             c_turb_impaction = c_it_p10( match_array%match_luww(m) )
-             par_l            = l_p10( match_array%match_luww(m) ) * 0.01_wp
-
-             DO  ib = 1, nbins_aerosol
-                IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                     &
-                     schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
-
-                SELECT CASE ( depo_surf_par_num )
-
-                   CASE ( 1 )
-                      CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),              &
-                                         ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
-                   CASE ( 2 )
-                      CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),            &
-                                         schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,             &
-                                         c_brownian_diff, c_interception, c_impaction, beta_im,    &
-                                         c_turb_impaction, depo(ib) )
-                END SELECT
-             ENDDO
-             depo_sum = depo_sum + surf%frac(m,ind_wat_win) * depo
-          ENDIF
-
-          DO  ib = 1, nbins_aerosol
-             IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) )  CYCLE
-!
-!--          Calculate changes in surface fluxes due to dry deposition
-             IF ( include_emission )  THEN
-                surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp,                   &
-                                   depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp,                &
-                                       depo_sum(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i) )
-                ENDDO  ! ic
-             ELSE
-                surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   surf%amsws(m,icc) = -depo_sum(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i)
-                ENDDO  ! ic
-             ENDIF
-          ENDDO  ! ib
-
-       ENDDO
-
-    ELSE  ! default surfaces
-
-       DO  m = surf_s, surf_e
-
-          k = surf%k(m)
-          norm_fac = 1.0_wp
-
-          IF ( norm )  norm_fac = rho_air_zw(k)  ! normalise vertical fluxes by air density
-
-          DO  ib = 1, nbins_aerosol
-             IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim )  .OR.                        &
-                  schmidt_num(k+1,ib) < 1.0_wp )  CYCLE
-
-             SELECT CASE ( depo_surf_par_num )
-
-                CASE ( 1 )
-                   CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib),                 &
-                                      ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) )
-                CASE ( 2 )
-                   CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1),               &
-                                      schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l,                &
-                                      c_brownian_diff, c_interception, c_impaction, beta_im,       &
-                                      c_turb_impaction, depo(ib) )
-             END SELECT
-!
-!--          Calculate changes in surface fluxes due to dry deposition
-             IF ( include_emission )  THEN
-                surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp,                   &
-                                   depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) )
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp,                &
-                                       depo(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i) )
-                ENDDO  ! ic
-             ELSE
-                surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   surf%amsws(m,icc) = -depo(ib) *  norm_fac * aerosol_mass(icc)%conc(k,j,i)
-                ENDDO  ! ic
-             ENDIF
-          ENDDO  ! ib
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE depo_surf
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates particle loss and change in size distribution due to (Brownian)
-!> coagulation. Only for particles with dwet < 30 micrometres.
-!
-!> Method:
-!> Semi-implicit, non-iterative method: (Jacobson, 1994)
-!> Volume concentrations of the smaller colliding particles added to the bin of
-!> the larger colliding particles. Start from first bin and use the updated
-!> number and volume for calculation of following bins. NB! Our bin numbering
-!> does not follow particle size in subrange 2.
-!
-!> Schematic for bin numbers in different subranges:
-!>             1                            2
-!>    +-------------------------------------------+
-!>  a | 1 | 2 | 3 || 4 | 5 | 6 | 7 |  8 |  9 | 10||
-!>  b |           ||11 |12 |13 |14 | 15 | 16 | 17||
-!>    +-------------------------------------------+
-!
-!> Exact coagulation coefficients for each pressure level are scaled according
-!> to current particle wet size (linear scaling).
-!> Bins are organized in terms of the dry size of the condensation nucleus,
-!> while coagulation kernell is calculated with the actual hydrometeor
-!> size.
-!
-!> Called from salsa_driver
-!> fxm: Process selection should be made smarter - now just lots of IFs inside
-!>      loops
-!
-!> Coded by:
-!> Hannele Korhonen (FMI) 2005
-!> Harri Kokkola (FMI) 2006
-!> Tommi Bergman (FMI) 2012
-!> Matti Niskanen(FMI) 2012
-!> Anton Laakso  (FMI) 2013
-!> Juha Tonttila (FMI) 2014
-!------------------------------------------------------------------------------!
- SUBROUTINE coagulation( paero, ptstep, ptemp, ppres )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  index_2a !< corresponding bin in subrange 2a
-    INTEGER(iwp) ::  index_2b !< corresponding bin in subrange 2b
-    INTEGER(iwp) ::  ib       !< loop index
-    INTEGER(iwp) ::  ll       !< loop index
-    INTEGER(iwp) ::  mm       !< loop index
-    INTEGER(iwp) ::  nn       !< loop index
-
-    REAL(wp) ::  pressi          !< pressure
-    REAL(wp) ::  temppi          !< temperature
-    REAL(wp) ::  zdpart_mm       !< diameter of particle (m)
-    REAL(wp) ::  zdpart_nn       !< diameter of particle (m)
-    REAL(wp) ::  zminusterm      !< coagulation loss in a bin (1/s)
-
-    REAL(wp), INTENT(in) ::  ppres  !< ambient pressure (Pa)
-    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
-    REAL(wp), INTENT(in) ::  ptstep !< time step (s)
-
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zmpart     !< approximate mass of particles (kg)
-    REAL(wp), DIMENSION(maxspec+1)     ::  zplusterm  !< coagulation gain in a bin (for each
-                                                      !< chemical compound)
-    REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) ::  zcc  !< updated coagulation coeff. (m3/s)
-
-    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
-
-    zdpart_mm = 0.0_wp
-    zdpart_nn = 0.0_wp
-!
-!-- 1) Coagulation to coarse mode calculated in a simplified way:
-!--    CoagSink ~ Dp in continuum subrange --> 'effective' number conc. of coarse particles
-
-!-- 2) Updating coagulation coefficients
-!
-!-- Aerosol mass (kg). Density of 1500 kg/m3 assumed
-    zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 )     &
-                                * 1500.0_wp
-    temppi = ptemp
-    pressi = ppres
-    zcc    = 0.0_wp
-!
-!-- Aero-aero coagulation
-    DO  mm = 1, end_subrange_2b   ! smaller colliding particle
-       IF ( paero(mm)%numc < ( 2.0_wp * nclim ) )  CYCLE
-       DO  nn = mm, end_subrange_2b   ! larger colliding particle
-          IF ( paero(nn)%numc < ( 2.0_wp * nclim ) )  CYCLE
-
-          zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp )     ! Limit to 30 um
-          zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp )     ! Limit to 30 um
-!
-!--       Coagulation coefficient of particles (m3/s)
-          zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi )
-          zcc(nn,mm) = zcc(mm,nn)
-       ENDDO
-    ENDDO
-
-!
-!-- 3) New particle and volume concentrations after coagulation:
-!--    Calculated according to Jacobson (2005) eq. 15.9
-!
-!-- Aerosols in subrange 1a:
-    DO  ib = start_subrange_1a, end_subrange_1a
-       IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
-       zminusterm   = 0.0_wp
-       zplusterm(:) = 0.0_wp
-!
-!--    Particles lost by coagulation with larger aerosols
-       DO  ll = ib+1, end_subrange_2b
-          zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
-       ENDDO
-!
-!--    Coagulation gain in a bin: change in volume conc. (cm3/cm3):
-       DO ll = start_subrange_1a, ib - 1
-          zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
-          zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7)
-          zplusterm(8)   = zplusterm(8)   + zcc(ll,ib) * paero(ll)%volc(8)
-       ENDDO
-!
-!--    Volume and number concentrations after coagulation update [fxm]
-       paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) /  &
-                            ( 1.0_wp + ptstep * zminusterm )
-       paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) /  &
-                            ( 1.0_wp + ptstep * zminusterm )
-       paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *        &
-                        zcc(ib,ib) * paero(ib)%numc )
-    ENDDO
-!
-!-- Aerosols in subrange 2a:
-    DO  ib = start_subrange_2a, end_subrange_2a
-       IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
-       zminusterm   = 0.0_wp
-       zplusterm(:) = 0.0_wp
-!
-!--    Find corresponding size bin in subrange 2b
-       index_2b = ib - start_subrange_2a + start_subrange_2b
-!
-!--    Particles lost by larger particles in 2a
-       DO  ll = ib+1, end_subrange_2a
-          zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
-       ENDDO
-!
-!--    Particles lost by larger particles in 2b
-       IF ( .NOT. no_insoluble )  THEN
-          DO  ll = index_2b+1, end_subrange_2b
-             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
-          ENDDO
-       ENDIF
-!
-!--    Particle volume gained from smaller particles in subranges 1, 2a and 2b
-       DO  ll = start_subrange_1a, ib-1
-          zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2)
-          zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8)
-       ENDDO
-!
-!--    Particle volume gained from smaller particles in 2a
-!--    (Note, for components not included in the previous loop!)
-       DO  ll = start_subrange_2a, ib-1
-          zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5)
-       ENDDO
-!
-!--    Particle volume gained from smaller (and equal) particles in 2b
-       IF ( .NOT. no_insoluble )  THEN
-          DO  ll = start_subrange_2b, index_2b
-             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
-          ENDDO
-       ENDIF
-!
-!--    Volume and number concentrations after coagulation update [fxm]
-       paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) /  &
-                            ( 1.0_wp + ptstep * zminusterm )
-       paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *        &
-                        zcc(ib,ib) * paero(ib)%numc )
-    ENDDO
-!
-!-- Aerosols in subrange 2b:
-    IF ( .NOT. no_insoluble )  THEN
-       DO  ib = start_subrange_2b, end_subrange_2b
-          IF ( paero(ib)%numc < ( 2.0_wp * nclim ) )  CYCLE
-          zminusterm   = 0.0_wp
-          zplusterm(:) = 0.0_wp
-!
-!--       Find corresponding size bin in subsubrange 2a
-          index_2a = ib - start_subrange_2b + start_subrange_2a
-!
-!--       Particles lost to larger particles in subranges 2b
-          DO  ll = ib + 1, end_subrange_2b
-             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
-          ENDDO
-!
-!--       Particles lost to larger and equal particles in 2a
-          DO  ll = index_2a, end_subrange_2a
-             zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc
-          ENDDO
-!
-!--       Particle volume gained from smaller particles in subranges 1 & 2a
-          DO  ll = start_subrange_1a, index_2a - 1
-             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
-          ENDDO
-!
-!--       Particle volume gained from smaller particles in 2b
-          DO  ll = start_subrange_2b, ib - 1
-             zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8)
-          ENDDO
-!
-!--       Volume and number concentrations after coagulation update [fxm]
-          paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) &
-                                / ( 1.0_wp + ptstep * zminusterm )
-          paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep *     &
-                           zcc(ib,ib) * paero(ib)%numc )
-       ENDDO
-    ENDIF
-
- END SUBROUTINE coagulation
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of coagulation coefficients. Extended version of the function
-!> originally found in mo_salsa_init.
-!
-!> J. Tonttila, FMI, 05/2014
-!------------------------------------------------------------------------------!
- REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres )
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  fmdist  !< distance of flux matching (m)
-    REAL(wp) ::  knud_p  !< particle Knudsen number
-    REAL(wp) ::  mdiam   !< mean diameter of colliding particles (m)
-    REAL(wp) ::  mfp     !< mean free path of air molecules (m)
-    REAL(wp) ::  visc    !< viscosity of air (kg/(m s))
-
-    REAL(wp), INTENT(in) ::  diam1  !< diameter of colliding particle 1 (m)
-    REAL(wp), INTENT(in) ::  diam2  !< diameter of colliding particle 2 (m)
-    REAL(wp), INTENT(in) ::  mass1  !< mass of colliding particle 1 (kg)
-    REAL(wp), INTENT(in) ::  mass2  !< mass of colliding particle 2 (kg)
-    REAL(wp), INTENT(in) ::  pres   !< ambient pressure (Pa?) [fxm]
-    REAL(wp), INTENT(in) ::  temp   !< ambient temperature (K)
-
-    REAL(wp), DIMENSION (2) ::  beta    !< Cunningham correction factor
-    REAL(wp), DIMENSION (2) ::  dfpart  !< particle diffusion coefficient (m2/s)
-    REAL(wp), DIMENSION (2) ::  diam    !< diameters of particles (m)
-    REAL(wp), DIMENSION (2) ::  flux    !< flux in continuum and free molec. regime (m/s)
-    REAL(wp), DIMENSION (2) ::  knud    !< particle Knudsen number
-    REAL(wp), DIMENSION (2) ::  mpart   !< masses of particles (kg)
-    REAL(wp), DIMENSION (2) ::  mtvel   !< particle mean thermal velocity (m/s)
-    REAL(wp), DIMENSION (2) ::  omega   !< particle mean free path
-    REAL(wp), DIMENSION (2) ::  tva     !< temporary variable (m)
-!
-!-- Initialisation
-    coagc   = 0.0_wp
-!
-!-- 1) Initializing particle and ambient air variables
-    diam  = (/ diam1, diam2 /) !< particle diameters (m)
-    mpart = (/ mass1, mass2 /) !< particle masses (kg)
-!
-!-- Viscosity of air (kg/(m s))
-    visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) )
-!
-!-- Mean free path of air (m)
-    mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres
-!
-!-- 2) Slip correction factor for small particles
-    knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23)
-!
-!-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269)
-    beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) )
-!
-!-- 3) Particle properties
-!-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29)
-    dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam )
-!
-!-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32)
-    mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) )
-!
-!-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 )
-    omega = 8.0_wp * dfpart / ( pi * mtvel )
-!
-!-- Mean diameter (m)
-    mdiam = 0.5_wp * ( diam(1) + diam(2) )
-!
-!-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching
-!-- following Jacobson (2005):
-!
-!-- Flux in continuum regime (m3/s) (eq. 15.28)
-    flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) )
-!
-!-- Flux in free molec. regime (m3/s) (eq. 15.31)
-    flux(2) = pi * SQRT( ( mtvel(1)**2 ) + ( mtvel(2)**2 ) ) * ( mdiam**2 )
-!
-!-- temporary variables (m) to calculate flux matching distance (m)
-    tva(1) = ( ( mdiam + omega(1) )**3 - ( mdiam**2 + omega(1)**2 ) * SQRT( ( mdiam**2 +           &
-               omega(1)**2 ) ) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam
-    tva(2) = ( ( mdiam + omega(2) )**3 - ( mdiam**2 + omega(2)**2 ) * SQRT( ( mdiam**2 +           &
-               omega(2)**2 ) ) ) / ( 3.0_wp * mdiam * omega(2) ) - mdiam
-!
-!-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles
-!-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34)
-    fmdist = SQRT( tva(1)**2 + tva(2)**2 )
-!
-!-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33).
-!--    Here assumed coalescence efficiency 1!!
-    coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) )
-!
-!-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces
-    IF ( van_der_waals_coagc )  THEN
-       knud_p = SQRT( omega(1)**2 + omega(2)**2 ) / mdiam
-       IF ( knud_p >= 0.1_wp  .AND.  knud_p <= 10.0_wp )  THEN
-          coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) )
-       ELSE
-          coagc = coagc * 3.0_wp
-       ENDIF
-    ENDIF
-
- END FUNCTION coagc
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates the change in particle volume and gas phase
-!> concentrations due to nucleation, condensation and dissolutional growth.
-!
-!> Sulphuric acid and organic vapour: only condensation and no evaporation.
-!
-!> New gas and aerosol phase concentrations calculated according to Jacobson
-!> (1997): Numerical techniques to solve condensational and dissolutional growth
-!> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech.,
-!> 27, pp 491-498.
-!
-!> Following parameterization has been used:
-!> Molecular diffusion coefficient of condensing vapour (m2/s)
-!> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.)
-!> D = {1.d-7*sqrt(1/M_air + 1/M_gas)*T^1.75} / &
-!      {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 }
-!> M_air = 28.965 : molar mass of air (g/mol)
-!> d_air = 19.70  : diffusion volume of air
-!> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol)
-!> d_h2so4 = 51.96  : diffusion volume of h2so4
-!
-!> Called from main aerosol model
-!> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005)
-!
-!> Coded by:
-!> Hannele Korhonen (FMI) 2005
-!> Harri Kokkola (FMI) 2006
-!> Juha Tonttila (FMI) 2014
-!> Rewritten to PALM by Mona Kurppa (UHel) 2017
-!------------------------------------------------------------------------------!
- SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres,   &
-                          ptstep, prtcl )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ss      !< start index
-    INTEGER(iwp) ::  ee      !< end index
-
-    REAL(wp) ::  zcs_ocnv    !< condensation sink of nonvolatile organics (1/s)
-    REAL(wp) ::  zcs_ocsv    !< condensation sink of semivolatile organics (1/s)
-    REAL(wp) ::  zcs_su      !< condensation sink of sulfate (1/s)
-    REAL(wp) ::  zcs_tot     !< total condensation sink (1/s) (gases)
-    REAL(wp) ::  zcvap_new1  !< vapour concentration after time step (#/m3): sulphuric acid
-    REAL(wp) ::  zcvap_new2  !< nonvolatile organics
-    REAL(wp) ::  zcvap_new3  !< semivolatile organics
-    REAL(wp) ::  zdfvap      !< air diffusion coefficient (m2/s)
-    REAL(wp) ::  zdvap1      !< change in vapour concentration (#/m3): sulphuric acid
-    REAL(wp) ::  zdvap2      !< nonvolatile organics
-    REAL(wp) ::  zdvap3      !< semivolatile organics
-    REAL(wp) ::  zmfp        !< mean free path of condensing vapour (m)
-    REAL(wp) ::  zrh         !< Relative humidity [0-1]
-    REAL(wp) ::  zvisc       !< viscosity of air (kg/(m s))
-    REAL(wp) ::  zn_vs_c     !< ratio of nucleation of all mass transfer in the smallest bin
-    REAL(wp) ::  zxocnv      !< ratio of organic vapour in 3nm particles
-    REAL(wp) ::  zxsa        !< Ratio in 3nm particles: sulphuric acid
-
-    REAL(wp), INTENT(in) ::  ppres   !< ambient pressure (Pa)
-    REAL(wp), INTENT(in) ::  pcs     !< Water vapour saturation concentration (kg/m3)
-    REAL(wp), INTENT(in) ::  ptemp   !< ambient temperature (K)
-    REAL(wp), INTENT(in) ::  ptstep  !< timestep (s)
-
-    REAL(wp), INTENT(inout) ::  pchno3   !< Gas concentrations (#/m3): nitric acid HNO3
-    REAL(wp), INTENT(inout) ::  pc_nh3   !< ammonia NH3
-    REAL(wp), INTENT(inout) ::  pc_ocnv  !< non-volatile organics
-    REAL(wp), INTENT(inout) ::  pcocsv   !< semi-volatile organics
-    REAL(wp), INTENT(inout) ::  pc_sa    !< sulphuric acid H2SO4
-    REAL(wp), INTENT(inout) ::  pcw      !< Water vapor concentration (kg/m3)
-
-    REAL(wp), DIMENSION(nbins_aerosol)       ::  zbeta          !< transitional correction factor
-    REAL(wp), DIMENSION(nbins_aerosol)       ::  zcolrate       !< collision rate (1/s)
-    REAL(wp), DIMENSION(nbins_aerosol)       ::  zcolrate_ocnv  !< collision rate of OCNV (1/s)
-    REAL(wp), DIMENSION(start_subrange_1a+1) ::  zdfpart        !< particle diffusion coef. (m2/s)
-    REAL(wp), DIMENSION(nbins_aerosol)       ::  zdvoloc        !< change of organics volume
-    REAL(wp), DIMENSION(nbins_aerosol)       ::  zdvolsa        !< change of sulphate volume
-    REAL(wp), DIMENSION(2)                   ::  zj3n3          !< Formation massrate of molecules
-                                                                !< in nucleation, (molec/m3s),
-                                                                !< 1: H2SO4 and 2: organic vapor
-    REAL(wp), DIMENSION(nbins_aerosol)       ::  zknud          !< particle Knudsen number
-
-    TYPE(component_index), INTENT(in) :: prtcl  !< Keeps track which substances are used
-
-    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
-
-    zj3n3  = 0.0_wp
-    zrh    = pcw / pcs
-    zxocnv = 0.0_wp
-    zxsa   = 0.0_wp
-!
-!-- Nucleation
-    IF ( nsnucl > 0 )  THEN
-       CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa,     &
-                        zxocnv )
-    ENDIF
-!
-!-- Condensation on pre-existing particles
-    IF ( lscndgas )  THEN
-!
-!--    Initialise:
-       zdvolsa = 0.0_wp
-       zdvoloc = 0.0_wp
-       zcolrate = 0.0_wp
-!
-!--    1) Properties of air and condensing gases:
-!--    Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005))
-       zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) )
-!
-!--    Diffusion coefficient of air (m2/s)
-       zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres
-!
-!--    Mean free path (m): same for H2SO4 and organic compounds
-       zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
-!
-!--    2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)):
-!--       Size of condensing molecule considered only for nucleation mode (3 - 20 nm).
-!
-!--    Particle Knudsen number: condensation of gases on aerosols
-       ss = start_subrange_1a
-       ee = start_subrange_1a+1
-       zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa )
-       ss = start_subrange_1a+2
-       ee = end_subrange_2b
-       zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet
-!
-!--    Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin
-!--    interpolation function (Fuchs and Sutugin, 1971))
-       zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) *  &
-               ( zknud + zknud ** 2 ) )
-!
-!--    3) Collision rate of molecules to particles
-!--       Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm)
-!
-!--    Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005))
-       zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc&
-                 * paero(start_subrange_1a:start_subrange_1a+1)%dwet)
-!
-!--    Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in
-!--    Jacobson (2005))
-       ss = start_subrange_1a
-       ee = start_subrange_1a+1
-       zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *&
-                               zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
-       ss = start_subrange_1a+2
-       ee = end_subrange_2b
-       zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) *          &
-                                paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim )
-!
-!-- 4) Condensation sink (1/s)
-       zcs_tot = SUM( zcolrate )   ! total sink
-!
-!--    5) Changes in gas-phase concentrations and particle volume
-!
-!--    5.1) Organic vapours
-!
-!--    5.1.1) Non-volatile organic compound: condenses onto all bins
-       IF ( pc_ocnv > 1.0E+10_wp  .AND.  zcs_tot > 1.0E-30_wp  .AND. index_oc > 0 )  &
-       THEN
-!--       Ratio of nucleation vs. condensation rates in the smallest bin
-          zn_vs_c = 0.0_wp
-          IF ( zj3n3(2) > 1.0_wp )  THEN
-             zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) )
-          ENDIF
-!
-!--       Collision rate in the smallest bin, including nucleation and condensation (see
-!--       Jacobson (2005), eq. (16.73) )
-          zcolrate_ocnv = zcolrate
-          zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv
-!
-!--       Total sink for organic vapor
-          zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv
-!
-!--       New gas phase concentration (#/m3)
-          zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv )
-!
-!--       Change in gas concentration (#/m3)
-          zdvap2 = pc_ocnv - zcvap_new2
-!
-!--       Updated vapour concentration (#/m3)
-          pc_ocnv = zcvap_new2
-!
-!--       Volume change of particles (m3(OC)/m3(air))
-          zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2
-!
-!--       Change of volume due to condensation in 1a-2b
-          paero(start_subrange_1a:end_subrange_2b)%volc(2) =                                       &
-                                          paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
-!
-!--       Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005),
-!--       eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into
-!--       account the non-volatile organic vapors and thus the paero doesn't have to be updated.
-          IF ( zxocnv > 0.0_wp )  THEN
-             paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c *             &
-                                             zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv )
-          ENDIF
-       ENDIF
-!
-!--    5.1.2) Semivolatile organic compound: all bins except subrange 1
-       zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile org.
-       IF ( pcocsv > 1.0E+10_wp  .AND.  zcs_ocsv > 1.0E-30  .AND. is_used( prtcl,'OC') )  THEN
-!
-!--       New gas phase concentration (#/m3)
-          zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv )
-!
-!--       Change in gas concentration (#/m3)
-          zdvap3 = pcocsv - zcvap_new3
-!
-!--       Updated gas concentration (#/m3)
-          pcocsv = zcvap_new3
-!
-!--       Volume change of particles (m3(OC)/m3(air))
-          ss = start_subrange_2a
-          ee = end_subrange_2b
-          zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3
-!
-!--       Change of volume due to condensation in 1a-2b
-          paero(start_subrange_1a:end_subrange_2b)%volc(2) =                                       &
-                                          paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc
-       ENDIF
-!
-!--    5.2) Sulphate: condensed on all bins
-       IF ( pc_sa > 1.0E+10_wp  .AND.  zcs_tot > 1.0E-30_wp  .AND.  index_so4 > 0 )  THEN
-!
-!--    Ratio of mass transfer between nucleation and condensation
-          zn_vs_c = 0.0_wp
-          IF ( zj3n3(1) > 1.0_wp )  THEN
-             zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) )
-          ENDIF
-!
-!--       Collision rate in the smallest bin, including nucleation and condensation (see
-!--       Jacobson (2005), eq. (16.73))
-          zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa
-!
-!--       Total sink for sulfate (1/s)
-          zcs_su = zcs_tot + zj3n3(1) / pc_sa
-!
-!--       Sulphuric acid:
-!--       New gas phase concentration (#/m3)
-          zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su )
-!
-!--       Change in gas concentration (#/m3)
-          zdvap1 = pc_sa - zcvap_new1
-!
-!--       Updating vapour concentration (#/m3)
-          pc_sa = zcvap_new1
-!
-!--       Volume change of particles (m3(SO4)/m3(air)) by condensation
-          zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1
-!
-!--       Change of volume concentration of sulphate in aerosol [fxm]
-          paero(start_subrange_1a:end_subrange_2b)%volc(1) =                                       &
-                                          paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa
-!
-!--       Change of number concentration in the smallest bin caused by nucleation
-!--       (Jacobson (2005), equation (16.75))
-          IF ( zxsa > 0.0_wp )  THEN
-             paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c *             &
-                                             zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa)
-          ENDIF
-       ENDIF
-!
-!--    Partitioning of H2O, HNO3, and NH3: Dissolutional growth
-       IF ( lspartition  .AND.  ( pchno3 > 1.0E+10_wp  .OR.  pc_nh3 > 1.0E+10_wp ) )  THEN
-          CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep )
-       ENDIF
-    ENDIF
-!
-!-- Condensation of water vapour
-    IF ( lscndh2oae )  THEN
-       CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
-    ENDIF
-
- END SUBROUTINE condensation
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates the particle number and volume increase, and gas-phase
-!> concentration decrease due to nucleation subsequent growth to detectable size
-!> of 3 nm.
-!
-!> Method:
-!> When the formed clusters grow by condensation (possibly also by self-
-!> coagulation), their number is reduced due to scavenging to pre-existing
-!> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower
-!> than the real nucleation rate (at ~1 nm).
-!
-!> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3):
-!> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622.
-!> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994.
-!> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636.
-!
-!> c = aerosol of critical radius (1 nm)
-!> x = aerosol with radius 3 nm
-!> 2 = wet or mean droplet
-!
-!> Called from subroutine condensation (in module salsa_dynamics_mod.f90)
-!
-!> Calls one of the following subroutines:
-!>  - binnucl
-!>  - ternucl
-!>  - kinnucl
-!>  - actnucl
-!
-!> fxm: currently only sulphuric acid grows particles from 1 to 3 nm
-!>  (if asked from Markku, this is terribly wrong!!!)
-!
-!> Coded by:
-!> Hannele Korhonen (FMI) 2005
-!> Harri Kokkola (FMI) 2006
-!> Matti Niskanen(FMI) 2012
-!> Anton Laakso  (FMI) 2013
-!------------------------------------------------------------------------------!
-
- SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa,     &
-                        pxocnv )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  iteration
-
-    REAL(wp) ::  zc_h2so4     !< H2SO4 conc. (#/cm3) !UNITS!
-    REAL(wp) ::  zc_org       !< organic vapour conc. (#/cm3)
-    REAL(wp) ::  zcc_c        !< Cunningham correct factor for c = critical (1nm)
-    REAL(wp) ::  zcc_x        !< Cunningham correct factor for x = 3nm
-    REAL(wp) ::  zcoags_c     !< coagulation sink (1/s) for c = critical (1nm)
-    REAL(wp) ::  zcoags_x     !< coagulation sink (1/s) for x = 3nm
-    REAL(wp) ::  zcoagstot    !< total particle losses due to coagulation, including condensation
-                              !< and self-coagulation
-    REAL(wp) ::  zcocnv_local !< organic vapour conc. (#/m3)
-    REAL(wp) ::  zcsink       !< condensational sink (#/m2)
-    REAL(wp) ::  zcsa_local   !< H2SO4 conc. (#/m3)
-    REAL(wp) ::  zcv_c        !< mean relative thermal velocity (m/s) for c = critical (1nm)
-    REAL(wp) ::  zcv_x        !< mean relative thermal velocity (m/s) for x = 3nm
-    REAL(wp) ::  zdcrit       !< diameter of critical cluster (m)
-    REAL(wp) ::  zdelta_vap   !< change of H2SO4 and organic vapour concentration (#/m3)
-    REAL(wp) ::  zdfvap       !< air diffusion coefficient (m2/s)
-    REAL(wp) ::  zdmean       !< mean diameter of existing particles (m)
-    REAL(wp) ::  zeta         !< constant: proportional to ratio of CS/GR (m)
-                              !< (condensation sink / growth rate)
-    REAL(wp) ::  zgamma       !< proportionality factor ((nm2*m2)/h)
-    REAL(wp) ::  z_gr_clust   !< growth rate of formed clusters (nm/h)
-    REAL(wp) ::  z_gr_tot     !< total growth rate
-    REAL(wp) ::  zj3          !< number conc. of formed 3nm particles (#/m3)
-    REAL(wp) ::  zjnuc        !< nucleation rate at ~1nm (#/m3s)
-    REAL(wp) ::  z_k_eff      !< effective cogulation coefficient for freshly nucleated particles
-    REAL(wp) ::  zknud_c      !< Knudsen number for c = critical (1nm)
-    REAL(wp) ::  zknud_x      !< Knudsen number for x = 3nm
-    REAL(wp) ::  zkocnv       !< lever: zkocnv=1 --> organic compounds involved in nucleation
-    REAL(wp) ::  zksa         !< lever: zksa=1 --> H2SO4 involved in nucleation
-    REAL(wp) ::  zlambda      !< parameter for adjusting the growth rate due to self-coagulation
-    REAL(wp) ::  zm_c         !< particle mass (kg) for c = critical (1nm)
-    REAL(wp) ::  zm_para      !< Parameter m for calculating the coagulation sink (Eq. 5&6 in
-                              !< Lehtinen et al. 2007)
-    REAL(wp) ::  zm_x         !< particle mass (kg) for x = 3nm
-    REAL(wp) ::  zmfp         !< mean free path of condesing vapour(m)
-    REAL(wp) ::  zmixnh3      !< ammonia mixing ratio (ppt)
-    REAL(wp) ::  zmyy         !< gas dynamic viscosity (N*s/m2)
-    REAL(wp) ::  z_n_nuc      !< number of clusters/particles at the size range d1-dx (#/m3)
-    REAL(wp) ::  znoc         !< number of organic molecules in critical cluster
-    REAL(wp) ::  znsa         !< number of H2SO4 molecules in critical cluster
-
-    REAL(wp), INTENT(in) ::  pc_nh3   !< ammonia concentration (#/m3)
-    REAL(wp), INTENT(in) ::  pc_ocnv  !< conc. of non-volatile OC (#/m3)
-    REAL(wp), INTENT(in) ::  pc_sa    !< sulphuric acid conc. (#/m3)
-    REAL(wp), INTENT(in) ::  ppres    !< ambient air pressure (Pa)
-    REAL(wp), INTENT(in) ::  prh      !< ambient rel. humidity [0-1]
-    REAL(wp), INTENT(in) ::  ptemp    !< ambient temperature (K)
-    REAL(wp), INTENT(in) ::  ptstep   !< time step (s) of SALSA
-
-    REAL(wp), INTENT(inout) ::  pj3n3(2) !< formation mass rate of molecules (molec/m3s) for
-                                         !< 1: H2SO4 and 2: organic vapour
-
-    REAL(wp), INTENT(out) ::  pxocnv  !< ratio of non-volatile organic vapours in 3 nm particles
-    REAL(wp), INTENT(out) ::  pxsa    !< ratio of H2SO4 in 3 nm aerosol particles
-
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zbeta       !< transitional correction factor
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zcc_2       !< Cunningham correct factor:2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_2       !< mean relative thermal velocity (m/s): 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_c2      !< average velocity after coagulation: c & 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zcv_x2      !< average velocity after coagulation: x & 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_2       !< particle diffusion coefficient (m2/s): 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_c       !< particle diffusion coefficient (m2/s): c
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_c2      !< sum of diffusion coef. for c and 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_x       !< particle diffusion coefficient (m2/s): x
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zdc_x2      !< sum of diffusion coef. for: x & 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_2  !< zgamma_f for calculating zomega
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_c  !< zgamma_f for calculating zomega
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zgamma_f_x  !< zgamma_f for calculating zomega
-    REAL(wp), DIMENSION(nbins_aerosol) ::  z_k_c2      !< coagulation coef. in the continuum
-                                                       !< regime: c & 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  z_k_x2      !< coagulation coef. in the continuum
-                                                       !< regime: x & 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zknud       !< particle Knudsen number
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zknud_2     !< particle Knudsen number: 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zm_2        !< particle mass (kg): 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_2c   !< zomega (m) for calculating zsigma: c & 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_2x   !< zomega (m) for calculating zsigma: x & 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_c    !< zomega (m) for calculating zsigma: c
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zomega_x    !< zomega (m) for calculating zsigma: x
-    REAL(wp), DIMENSION(nbins_aerosol) ::  z_r_c2      !< sum of the radii: c & 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  z_r_x2      !< sum of the radii: x & 2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zsigma_c2   !<
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zsigma_x2   !<
-
-    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< aerosol properties
-!
-!-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit)
-    zjnuc  = 0.0_wp
-    znsa   = 0.0_wp
-    znoc   = 0.0_wp
-    zdcrit = 0.0_wp
-    zksa   = 0.0_wp
-    zkocnv = 0.0_wp
-
-    zc_h2so4 = pc_sa * 1.0E-6_wp   ! sulphuric acid conc. to #/cm3
-    zc_org   = pc_ocnv * 1.0E-6_wp   ! conc. of non-volatile OC to #/cm3
-    zmixnh3  = pc_nh3 * ptemp * argas / ( ppres * avo )
-
-    SELECT CASE ( nsnucl )
-!
-!--    Binary H2SO4-H2O nucleation
-       CASE(1)
-
-          CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit,  zksa, zkocnv )
-!
-!--    Activation type nucleation (See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914)
-       CASE(2)
-!
-!--       Nucleation rate (#/(m3 s))
-          zc_h2so4  = MAX( zc_h2so4, 1.0E4_wp  )
-          zc_h2so4  = MIN( zc_h2so4, 1.0E11_wp )
-          zjnuc = act_coeff * pc_sa  ! (#/(m3 s))
-!
-!--       Organic compounds not involved when kinetic nucleation is assumed.
-          zdcrit  = 7.9375E-10_wp   ! (m)
-          zkocnv  = 0.0_wp
-          zksa    = 1.0_wp
-          znoc    = 0.0_wp
-          znsa    = 2.0_wp
-!
-!--    Kinetically limited nucleation of (NH4)HSO4 clusters
-!--    (See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.)
-       CASE(3)
-!
-!--       Nucleation rate = coagcoeff*zpcsa**2 (#/(m3 s))
-          zc_h2so4  = MAX( zc_h2so4, 1.0E4_wp  )
-          zc_h2so4  = MIN( zc_h2so4, 1.0E11_wp )
-          zjnuc = 5.0E-13_wp * zc_h2so4**2.0_wp * 1.0E+6_wp
-!
-!--       Organic compounds not involved when kinetic nucleation is assumed.
-          zdcrit  = 7.9375E-10_wp   ! (m)
-          zkocnv  = 0.0_wp
-          zksa    = 1.0_wp
-          znoc    = 0.0_wp
-          znsa    = 2.0_wp
-!
-!--    Ternary H2SO4-H2O-NH3 nucleation
-       CASE(4)
-
-          CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv )
-!
-!--    Organic nucleation, J~[ORG] or J~[ORG]**2
-!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
-       CASE(5)
-!
-!--       Homomolecular nuleation rate
-          zjnuc = 1.3E-7_wp * pc_ocnv   ! (1/s) (Paasonen et al. Table 4: median a_org)
-!
-!--       H2SO4 not involved when pure organic nucleation is assumed.
-          zdcrit  = 1.5E-9  ! (m)
-          zkocnv  = 1.0_wp
-          zksa    = 0.0_wp
-          znoc    = 1.0_wp
-          znsa    = 0.0_wp
-!
-!--    Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG]
-!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
-       CASE(6)
-!
-!--       Nucleation rate  (#/m3/s)
-          zjnuc = 6.1E-7_wp * pc_sa + 0.39E-7_wp * pc_ocnv   ! (Paasonen et al. Table 3.)
-!
-!--       Both organic compounds and H2SO4 are involved when sumnucleation is assumed.
-          zdcrit  = 1.5E-9_wp   ! (m)
-          zkocnv  = 1.0_wp
-          zksa    = 1.0_wp
-          znoc    = 1.0_wp
-          znsa    = 1.0_wp
-!
-!--    Heteromolecular nucleation, J~[H2SO4]*[ORG]
-!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.)
-       CASE(7)
-!
-!--       Nucleation rate (#/m3/s)
-          zjnuc = 4.1E-14_wp * pc_sa * pc_ocnv * 1.0E6_wp   ! (Paasonen et al. Table 4: median)
-!
-!--       Both organic compounds and H2SO4 are involved when heteromolecular nucleation is assumed
-          zdcrit  = 1.5E-9_wp   ! (m)
-          zkocnv  = 1.0_wp
-          zksa    = 1.0_wp
-          znoc    = 1.0_wp
-          znsa    = 1.0_wp
-!
-!--    Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour,
-!--    J~[H2SO4]**2 + [H2SO4]*[ORG] (EUCAARI project)
-!--    (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242)
-       CASE(8)
-!
-!--       Nucleation rate (#/m3/s)
-          zjnuc = ( 1.1E-14_wp * zc_h2so4**2 + 3.2E-14_wp * zc_h2so4 * zc_org ) * 1.0E+6_wp
-!
-!--       Both organic compounds and H2SO4 are involved when SAnucleation is assumed
-          zdcrit  = 1.5E-9_wp   ! (m)
-          zkocnv  = 1.0_wp
-          zksa    = 1.0_wp
-          znoc    = 1.0_wp
-          znsa    = 3.0_wp
-!
-!--    Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4
-!--    and organic vapour, J~[H2SO4]**2 + [H2SO4]*[ORG]+[ORG]**2 (EUCAARI project)
-       CASE(9)
-!
-!--       Nucleation rate (#/m3/s)
-          zjnuc = ( 1.4E-14_wp * zc_h2so4**2 + 2.6E-14_wp * zc_h2so4 * zc_org + 0.037E-14_wp *     &
-                    zc_org**2 ) * 1.0E+6_wp
-!
-!--       Both organic compounds and H2SO4 are involved when SAORGnucleation is assumed
-          zdcrit  = 1.5E-9_wp   ! (m)
-          zkocnv  = 1.0_wp
-          zksa    = 1.0_wp
-          znoc    = 3.0_wp
-          znsa    = 3.0_wp
-
-    END SELECT
-
-    zcsa_local = pc_sa
-    zcocnv_local = pc_ocnv
-!
-!-- 2) Change of particle and gas concentrations due to nucleation
-!
-!-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation
-    IF ( nsnucl <= 4 )  THEN
-!
-!--    If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total
-!--    vapour concentration that is taking part to the nucleation is there for sulphuric acid
-!--    (sa = H2SO4) and non-volatile organic vapour is zero.
-       pxsa   = 1.0_wp   ! ratio of sulphuric acid in 3nm particles
-       pxocnv = 0.0_wp   ! ratio of non-volatile origanic vapour
-                                ! in 3nm particles
-    ELSEIF ( nsnucl > 4 )  THEN
-!
-!--    If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the
-!--    combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen
-!--    nucleation type and it has an effect also on the minimum ratio of the molecules present.
-       IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp )  THEN
-          pxsa   = 0.0_wp
-          pxocnv = 0.0_wp
-       ELSE
-          pxsa   = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc )
-          pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc )
-       ENDIF
-    ENDIF
-!
-!-- The change in total vapour concentration is the sum of the concentrations of the vapours taking
-!-- part to the nucleation (depends on the chosen nucleation scheme)
-    zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep )
-!
-!-- Nucleation rate J at ~1nm (#/m3s)
-    zjnuc = zdelta_vap / ( znoc + znsa )
-!
-!-- H2SO4 concentration after nucleation (#/m3)
-    zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa )
-!
-!-- Non-volative organic vapour concentration after nucleation (#/m3)
-    zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv )
-!
-!-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002)
-!
-!-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21)
-    z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local )
-!
-!-- 2.2.2) Condensational sink of pre-existing particle population
-!
-!-- Diffusion coefficient (m2/s)
-    zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres
-!
-!-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29)
-    zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) )
-!
-!-- Knudsen number
-    zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa )
-!
-!-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in
-!-- Kerminen and Kulmala, 2002)
-    zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) *      &
-            ( zknud + zknud**2 ) )
-!
-!-- Condensational sink (#/m2, Eq. 3)
-    zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc )
-!
-!-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3)
-    IF ( nj3 == 1 )  THEN   ! Kerminen and Kulmala (2002)
-!
-!--    Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3
-       IF ( zcsink < 1.0E-30_wp )  THEN
-          zeta = 0._dp
-       ELSE
-!
-!--       Mean diameter of backgroud population (nm)
-          zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp
-!
-!--       Proportionality factor (nm2*m2/h) (Eq. 22)
-          zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )**0.2_wp * ( zdmean / 150.0_wp )**0.048_wp *    &
-                   ( ptemp / 293.0_wp )**( -0.75_wp ) * ( arhoh2so4 / 1000.0_wp )**( -0.33_wp )
-!
-!--       Factor eta (nm, Eq. 11)
-          zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp )
-       ENDIF
-!
-!--    Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14)
-       zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) )
-
-    ELSEIF ( nj3 > 1 )  THEN   ! Lehtinen et al. (2007) or Anttila et al. (2010)
-!
-!--    Defining the parameter m (zm_para) for calculating the coagulation sink onto background
-!--    particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between
-!--    [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit )
-!--    (Lehtinen et al. 2007, Eq. 6).
-!--    The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in
-!--    Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm  and reglim = 3nm are both
-!--    in turn the "number 1" variables (Kulmala et al. 2001).
-!--    c = critical (1nm), x = 3nm, 2 = wet or mean droplet
-!
-!--    Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2
-       z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp
-       z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp
-!
-!--    Particle mass (kg) (comes only from H2SO4)
-       zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )**3 * arhoh2so4
-       zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )**3 * arhoh2so4
-       zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )**3 * arhoh2so4
-!
-!--    Mean relative thermal velocity between the particles (m/s)
-       zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) )
-       zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) )
-       zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) )
-!
-!--    Average velocity after coagulation
-       zcv_c2(:) = SQRT( zcv_c**2 + zcv_2**2 )
-       zcv_x2(:) = SQRT( zcv_x**2 + zcv_2**2 )
-!
-!--    Knudsen number (zmfp = mean free path of condensing vapour)
-       zknud_c = 2.0_wp * zmfp / zdcrit
-       zknud_x = 2.0_wp * zmfp / reglim(1)
-       zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet )
-!
-!--    Cunningham correction factors (Allen and Raabe, 1985)
-       zcc_c    = 1.0_wp + zknud_c    * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) )
-       zcc_x    = 1.0_wp + zknud_x    * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) )
-       zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) )
-!
-!--    Gas dynamic viscosity (N*s/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25)
-       zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp
-!
-!--    Particle diffusion coefficient (m2/s) (continuum regime)
-       zdc_c(:) = abo * ptemp * zcc_c    / ( 3.0_wp * pi * zmyy * zdcrit )
-       zdc_x(:) = abo * ptemp * zcc_x    / ( 3.0_wp * pi * zmyy * reglim(1) )
-       zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet )
-!
-!--    D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38)
-       zdc_c2 = zdc_c + zdc_2
-       zdc_x2 = zdc_x + zdc_2
-!
-!--    zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964)
-       zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c
-       zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x
-       zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2
-!
-!--    zomega (m) for calculating zsigma
-       zomega_c = ( ( z_r_c2 + zgamma_f_c )**3 - ( z_r_c2 ** 2 + zgamma_f_c )**1.5_wp ) /          &
-                  ( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2
-       zomega_x = ( ( z_r_x2 + zgamma_f_x )**3 - ( z_r_x2**2 + zgamma_f_x )** 1.5_wp ) /           &
-                  ( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2
-       zomega_2c = ( ( z_r_c2 + zgamma_f_2 )**3 - ( z_r_c2**2 + zgamma_f_2 )**1.5_wp ) /           &
-                   ( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2
-       zomega_2x = ( ( z_r_x2 + zgamma_f_2 )**3 - ( z_r_x2**2 + zgamma_f_2 )**1.5_wp ) /           &
-                   ( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2
-!
-!--    The distance (m) at which the two fluxes are matched (condensation and coagulation sinks)
-       zsigma_c2 = SQRT( zomega_c**2 + zomega_2c**2 )
-       zsigma_x2 = SQRT( zomega_x**2 + zomega_2x**2 )
-!
-!--    Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001)
-       z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) +                &
-               4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) )
-       z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) +                &
-               4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) )
-!
-!--    Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001)
-       zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) )
-       zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) )
-!
-!--    Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in
-!--    Lehtinen et al. 2007)
-       zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit )
-!
-!--    Parameter gamma for calculating the formation rate J of particles having
-!--    a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7)
-       zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp )
-
-       IF ( nj3 == 2 )  THEN   ! Lehtinen et al. (2007): coagulation sink
-!
-!--       Formation rate J before iteration (#/m3s)
-          zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / &
-                60.0_wp**2 ) ) )
-
-       ELSEIF ( nj3 == 3 )  THEN  ! Anttila et al. (2010): coagulation sink and self-coag.
-!
-!--       If air is polluted, the self-coagulation becomes important. Self-coagulation of small
-!--       particles < 3 nm.
-!
-!--       "Effective" coagulation coefficient between freshly-nucleated particles:
-          z_k_eff = 5.0E-16_wp   ! m3/s
-!
-!--       zlambda parameter for "adjusting" the growth rate due to the self-coagulation
-          zlambda = 6.0_wp
-
-          IF ( reglim(1) >= 10.0E-9_wp )  THEN   ! for particles >10 nm:
-             z_k_eff   = 5.0E-17_wp
-             zlambda = 3.0_wp
-          ENDIF
-!
-!--       Initial values for coagulation sink and growth rate  (m/s)
-          zcoagstot = zcoags_c
-          z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2
-!
-!--       Number of clusters/particles at the size range [d1,dx] (#/m3):
-          z_n_nuc = zjnuc / zcoagstot !< Initial guess
-!
-!--       Coagulation sink and growth rate due to self-coagulation:
-          DO  iteration = 1, 5
-             zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp   ! (1/s, Anttila et al., eq. 1)
-             z_gr_tot = z_gr_clust * 2.77777777E-7_wp +  1.5708E-6_wp * zlambda * zdcrit**3 *      &
-                      ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3)
-             zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq.7b)
-!
-!--          Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx])
-             z_n_nuc =  z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot )
-          ENDDO
-!
-!--       Calculate the final values with new z_n_nuc:
-          zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp   ! (1/s)
-          z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp *  zlambda * zdcrit**3 *    &
-                   ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s)
-          zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq.5a)
-
-       ENDIF
-    ENDIF
-!
-!-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean
-!-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since
-!-- CoagS ~ CS (4piD*CS'), we do *not* update H2SO4 concentration here but let condensation take
-!-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour
-    pj3n3(1) = zj3 * n3 * pxsa
-    pj3n3(2) = zj3 * n3 * pxocnv
-
- END SUBROUTINE nucleation
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the nucleation rate and the size of critical clusters assuming
-!> binary nucleation.
-!> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res.,
-!> 107(D22), 4622. Called from subroutine nucleation.
-!------------------------------------------------------------------------------!
- SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa,       &
-                     pk_ocnv )
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  za      !<
-    REAL(wp) ::  zb      !<
-    REAL(wp) ::  zc      !<
-    REAL(wp) ::  zcoll   !<
-    REAL(wp) ::  zlogsa  !<  LOG( zpcsa )
-    REAL(wp) ::  zlogrh  !<  LOG( zrh )
-    REAL(wp) ::  zm1     !<
-    REAL(wp) ::  zm2     !<
-    REAL(wp) ::  zma     !<
-    REAL(wp) ::  zmw     !<
-    REAL(wp) ::  zntot   !< number of molecules in critical cluster
-    REAL(wp) ::  zpcsa   !< sulfuric acid concentration
-    REAL(wp) ::  zrh     !< relative humidity
-    REAL(wp) ::  zroo    !<
-    REAL(wp) ::  zt      !< temperature
-    REAL(wp) ::  zv1     !<
-    REAL(wp) ::  zv2     !<
-    REAL(wp) ::  zx      !< mole fraction of sulphate in critical cluster
-    REAL(wp) ::  zxmass  !<
-
-    REAL(wp), INTENT(in) ::   pc_sa   !< H2SO4 conc. (#/cm3)
-    REAL(wp), INTENT(in) ::   prh     !< relative humidity [0-1
-    REAL(wp), INTENT(in) ::   ptemp   !< ambient temperature (K)
-
-    REAL(wp), INTENT(out) ::  pnuc_rate     !< nucleation rate (#/(m3 s))
-    REAL(wp), INTENT(out) ::  pn_crit_sa    !< number of H2SO4 molecules in cluster (#)
-    REAL(wp), INTENT(out) ::  pn_crit_ocnv  !< number of organic molecules in cluster (#)
-    REAL(wp), INTENT(out) ::  pd_crit       !< diameter of critical cluster (m)
-    REAL(wp), INTENT(out) ::  pk_sa         !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation.
-    REAL(wp), INTENT(out) ::  pk_ocnv       !< Lever: if pk_ocnv = 1, organic compounds are involved
-
-    pnuc_rate = 0.0_wp
-    pd_crit   = 1.0E-9_wp
-!
-!-- 1) Checking that we are in the validity range of the parameterization
-    zpcsa  = MAX( pc_sa, 1.0E4_wp  )
-    zpcsa  = MIN( zpcsa, 1.0E11_wp )
-    zrh    = MAX( prh,   0.0001_wp )
-    zrh    = MIN( zrh,   1.0_wp    )
-    zt     = MAX( ptemp, 190.15_wp )
-    zt     = MIN( zt,    300.15_wp )
-
-    zlogsa = LOG( zpcsa )
-    zlogrh   = LOG( prh )
-!
-!-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11)
-    zx = 0.7409967177282139_wp                  - 0.002663785665140117_wp * zt +                   &
-         0.002010478847383187_wp * zlogrh       - 0.0001832894131464668_wp* zt * zlogrh +          &
-         0.001574072538464286_wp * zlogrh**2    - 0.00001790589121766952_wp * zt * zlogrh**2 +     &
-         0.0001844027436573778_wp * zlogrh**3   - 1.503452308794887E-6_wp * zt * zlogrh**3 -       &
-         0.003499978417957668_wp * zlogsa     + 0.0000504021689382576_wp * zt * zlogsa
-!
-!-- 3) Nucleation rate (Eq. 12)
-    pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt -                                &
-                0.02739106114964264_wp * zt**2 + 0.00007228107239317088_wp * zt**3 +               &
-                5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh +                        &
-                0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt**2 * zlogrh +    &
-                0.0000404196487152575_wp * zt**3 * zlogrh +                                        &
-                ( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 -        &
-                0.0810269192332194_wp * zt * zlogrh**2 +                                           &
-                0.001435808434184642_wp * zt**2 * zlogrh**2 -                                      &
-                4.775796947178588E-6_wp * zt**3 * zlogrh**2 -                                      &
-                ( 2.912974063702185_wp * zlogrh**2 ) / zx - 3.588557942822751_wp * zlogrh**3 +     &
-                0.04950795302831703_wp * zt * zlogrh**3 -                                          &
-                0.0002138195118737068_wp * zt**2 * zlogrh**3 +                                     &
-                3.108005107949533E-7_wp * zt**3 * zlogrh**3 -                                      &
-                ( 0.02933332747098296_wp * zlogrh**3 ) / zx + 1.145983818561277_wp * zlogsa -      &
-                0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt**2 * zlogsa -    &
-                0.00002289467254710888_wp * zt**3 * zlogsa -                                       &
-                ( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa +   &
-                0.0808121412840917_wp * zt * zlogrh * zlogsa -                                     &
-                0.0004073815255395214_wp * zt**2 * zlogrh * zlogsa -                               &
-                4.019572560156515E-7_wp * zt**3 * zlogrh * zlogsa +                                &
-                ( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx +                                 &
-                1.62409850488771_wp * zlogrh**2 * zlogsa -                                         &
-                0.01601062035325362_wp * zt * zlogrh**2 * zlogsa +                                 &
-                0.00003771238979714162_wp*zt**2* zlogrh**2 * zlogsa +                              &
-                3.217942606371182E-8_wp * zt**3 * zlogrh**2 * zlogsa -                             &
-                ( 0.01132550810022116_wp * zlogrh**2 * zlogsa ) / zx +                             &
-                9.71681713056504_wp * zlogsa**2 - 0.1150478558347306_wp * zt * zlogsa**2 +         &
-                0.0001570982486038294_wp * zt**2 * zlogsa**2 +                                     &
-                4.009144680125015E-7_wp * zt**3 * zlogsa**2 +                                      &
-                ( 0.7118597859976135_wp * zlogsa**2 ) / zx -                                       &
-                1.056105824379897_wp * zlogrh * zlogsa**2 +                                        &
-                0.00903377584628419_wp * zt * zlogrh * zlogsa**2 -                                 &
-                0.00001984167387090606_wp * zt**2 * zlogrh * zlogsa**2 +                           &
-                2.460478196482179E-8_wp * zt**3 * zlogrh * zlogsa**2 -                             &
-                ( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx -                             &
-                0.1487119673397459_wp * zlogsa**3 + 0.002835082097822667_wp * zt * zlogsa**3 -     &
-                9.24618825471694E-6_wp * zt**2 * zlogsa**3 +                                       &
-                5.004267665960894E-9_wp * zt**3 * zlogsa**3 -                                      &
-                ( 0.01270805101481648_wp * zlogsa**3 ) / zx
-!
-!-- Nucleation rate in #/(cm3 s)
-    pnuc_rate = EXP( pnuc_rate )
-!
-!-- Check the validity of parameterization
-    IF ( pnuc_rate < 1.0E-7_wp )  THEN
-       pnuc_rate = 0.0_wp
-       pd_crit   = 1.0E-9_wp
-    ENDIF
-!
-!-- 4) Total number of molecules in the critical cluster (Eq. 13)
-    zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt +                               &
-              0.001024847927067835_wp * zt**2 - 2.186459697726116E-6_wp * zt**3 -                  &
-              0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh -                      &
-              0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt**2 * zlogrh -  &
-              6.70429719683894E-7_wp * zt**3 * zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx +  &
-              0.003223076552477191_wp * zlogrh**2 + 0.000852636632240633_wp * zt * zlogrh**2 -     &
-              0.00001547571354871789_wp * zt**2 * zlogrh**2 +                                      &
-              5.666608424980593E-8_wp * zt**3 * zlogrh**2 +                                        &
-              ( 0.03384437400744206_wp * zlogrh**2 ) / zx +                                        &
-              0.04743226764572505_wp * zlogrh**3 - 0.0006251042204583412_wp * zt * zlogrh**3 +     &
-              2.650663328519478E-6_wp * zt**2 * zlogrh**3 -                                        &
-              3.674710848763778E-9_wp * zt**3 * zlogrh**3 -                                        &
-              ( 0.0002672510825259393_wp * zlogrh**3 ) / zx - 0.01252108546759328_wp * zlogsa +    &
-              0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt**2 * zlogsa +  &
-              2.881946187214505E-7_wp * zt**3 * zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - &
-              0.0385459592773097_wp * zlogrh * zlogsa -                                            &
-              0.0006723156277391984_wp * zt * zlogrh * zlogsa  +                                   &
-              2.602884877659698E-6_wp * zt**2 * zlogrh * zlogsa +                                  &
-              1.194163699688297E-8_wp * zt**3 * zlogrh * zlogsa -                                  &
-              ( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx -                                  &
-              0.01837488495738111_wp * zlogrh**2 * zlogsa +                                        &
-              0.0001720723574407498_wp * zt * zlogrh**2 * zlogsa -                                 &
-              3.717657974086814E-7_wp * zt**2 * zlogrh**2 * zlogsa -                               &
-              5.148746022615196E-10_wp * zt**3 * zlogrh**2 * zlogsa +                              &
-              ( 0.0002686602132926594_wp * zlogrh**2 * zlogsa ) / zx -                             &
-              0.06199739728812199_wp * zlogsa**2 + 0.000906958053583576_wp * zt * zlogsa**2 -      &
-              9.11727926129757E-7_wp * zt**2 * zlogsa**2 -                                         &
-              5.367963396508457E-9_wp * zt**3 * zlogsa**2 -                                        &
-              ( 0.007742343393937707_wp * zlogsa**2 ) / zx +                                       &
-              0.0121827103101659_wp * zlogrh * zlogsa**2 -                                         &
-              0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 +                                 &
-              2.534598655067518E-7_wp * zt**2 * zlogrh * zlogsa**2 -                               &
-              3.635186504599571E-10_wp * zt**3 * zlogrh * zlogsa**2 +                              &
-              ( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx +                            &
-              0.0003201836700403512_wp * zlogsa**3 - 0.0000174761713262546_wp * zt * zlogsa**3 +   &
-              6.065037668052182E-8_wp * zt**2 * zlogsa**3 -                                        &
-              1.421771723004557E-11_wp * zt**3 * zlogsa**3 +                                       &
-              ( 0.0001357509859501723_wp * zlogsa**3 ) / zx
-    zntot = EXP( zntot )  ! in #
-!
-!-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14)
-    pn_crit_sa = zx * zntot
-    pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) )
-!
-!-- 6) Organic compounds not involved when binary nucleation is assumed
-    pn_crit_ocnv = 0.0_wp   ! number of organic molecules
-    pk_sa        = 1.0_wp   ! if = 1, H2SO4 involved in nucleation
-    pk_ocnv      = 0.0_wp   ! if = 1, organic compounds involved
-!
-!-- Set nucleation rate to collision rate
-    IF ( pn_crit_sa < 4.0_wp ) THEN
-!
-!--    Volumes of the colliding objects
-       zma    = 96.0_wp   ! molar mass of SO4 in g/mol
-       zmw    = 18.0_wp   ! molar mass of water in g/mol
-       zxmass = 1.0_wp    ! mass fraction of H2SO4
-       za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass *                                      &
-                                      ( 7.1630022_wp + zxmass *                                    &
-                                        ( -44.31447_wp + zxmass *                                  &
-                                          ( 88.75606 + zxmass *                                    &
-                                            ( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) )
-       zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass *                                 &
-                                        ( -0.03742148_wp + zxmass *                                &
-                                          ( 0.2565321_wp + zxmass *                                &
-                                            ( -0.5362872_wp + zxmass *                             &
-                                              ( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) )
-       zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass *                                &
-                                          ( 5.195706E-5_wp + zxmass *                              &
-                                            ( -3.717636E-4_wp + zxmass *                           &
-                                              ( 7.990811E-4_wp + zxmass *                          &
-                                                ( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) )
-!
-!--    Density for the sulphuric acid solution (Eq. 10 in Vehkamaki)
-       zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp   ! (kg/m^3
-       zm1  = 0.098_wp   ! molar mass of H2SO4 in kg/mol
-       zm2  = zm1
-       zv1  = zm1 / avo / zroo   ! volume
-       zv2  = zv1
-!
-!--    Collision rate
-       zcoll =  zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )**0.16666666_wp *                          &
-                SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) *                    &
-                ( zv1**0.33333333_wp + zv2**0.33333333_wp )**2 * 1.0E+6_wp    ! m3 -> cm3
-       zcoll = MIN( zcoll, 1.0E+10_wp )
-       pnuc_rate  = zcoll   ! (#/(cm3 s))
-
-    ELSE
-       pnuc_rate  = MIN( pnuc_rate, 1.0E+10_wp )
-    ENDIF
-    pnuc_rate = pnuc_rate * 1.0E+6_wp   ! (#/(m3 s))
-
- END SUBROUTINE binnucl
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the nucleation rate and the size of critical clusters assuming
-!> ternary nucleation. Parametrisation according to:
-!> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and
-!> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6.
-!------------------------------------------------------------------------------!
- SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit,      &
-                     pk_sa, pk_ocnv )
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  zlnj     !< logarithm of nucleation rate
-    REAL(wp) ::  zlognh3  !< LOG( pc_nh3 )
-    REAL(wp) ::  zlogrh   !< LOG( prh )
-    REAL(wp) ::  zlogsa   !< LOG( pc_sa )
-
-    REAL(wp), INTENT(in) ::   pc_nh3  !< ammonia mixing ratio (ppt)
-    REAL(wp), INTENT(in) ::   pc_sa   !< H2SO4 conc. (#/cm3)
-    REAL(wp), INTENT(in) ::   prh     !< relative humidity [0-1]
-    REAL(wp), INTENT(in) ::   ptemp   !< ambient temperature (K)
-
-    REAL(wp), INTENT(out) ::  pd_crit  !< diameter of critical cluster (m)
-    REAL(wp), INTENT(out) ::  pk_ocnv  !< if pk_ocnv = 1, organic compounds participate in nucleation
-    REAL(wp), INTENT(out) ::  pk_sa    !< if pk_sa = 1, H2SO4 participate in nucleation
-    REAL(wp), INTENT(out) ::  pn_crit_ocnv  !< number of organic molecules in cluster (#)
-    REAL(wp), INTENT(out) ::  pn_crit_sa    !< number of H2SO4 molecules in cluster (#)
-    REAL(wp), INTENT(out) ::  pnuc_rate     !< nucleation rate (#/(m3 s))
-!
-!-- 1) Checking that we are in the validity range of the parameterization.
-!--    Validity of parameterization : DO NOT REMOVE!
-    IF ( ptemp < 240.0_wp  .OR.  ptemp > 300.0_wp )  THEN
-       message_string = 'Invalid input value: ptemp'
-       CALL message( 'salsa_mod: ternucl', 'PA0689', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( prh < 0.05_wp  .OR.  prh > 0.95_wp )  THEN
-       message_string = 'Invalid input value: prh'
-       CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( pc_sa < 1.0E+4_wp  .OR.  pc_sa > 1.0E+9_wp )  THEN
-       message_string = 'Invalid input value: pc_sa'
-       CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 )
-    ENDIF
-    IF ( pc_nh3 < 0.1_wp  .OR.  pc_nh3 > 100.0_wp )  THEN
-       message_string = 'Invalid input value: pc_nh3'
-       CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    zlognh3 = LOG( pc_nh3 )
-    zlogrh  = LOG( prh )
-    zlogsa  = LOG( pc_sa )
-!
-!-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of
-!--    ternary nucleation of sulfuric acid - ammonia - water.
-    zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh +                                   &
-           1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 -         &
-           0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa -           &
-           ( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - &
-           ( 7.823815852128623_wp * prh * ptemp ) / zlogsa +                                       &
-           ( 0.3453602302090915_wp * ptemp**2 ) / zlogsa +                                         &
-           ( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa -                                  &
-           ( 0.000824007160514956_wp *ptemp**3 ) / zlogsa +                                        &
-           ( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa +                               &
-           3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa -                   &
-           0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa +  &
-           0.005612037586790018_wp * ptemp**2 * zlogsa +                                           &
-           0.001062588391907444_wp * prh * ptemp**2 * zlogsa -                                     &
-           9.74575691760229E-6_wp * ptemp**3 * zlogsa -                                            &
-           1.265595265137352E-6_wp * prh * ptemp**3 * zlogsa + 19.03593713032114_wp * zlogsa**2 -  &
-           0.1709570721236754_wp * ptemp * zlogsa**2 +                                             &
-           0.000479808018162089_wp * ptemp**2 * zlogsa**2 -                                        &
-           4.146989369117246E-7_wp * ptemp**3 * zlogsa**2 + 1.076046750412183_wp * zlognh3 +       &
-           0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 +         &
-           0.1905424394695381_wp * prh * ptemp * zlognh3 -                                         &
-           0.007960522921316015_wp * ptemp**2 * zlognh3 -                                          &
-           0.001657184248661241_wp * prh * ptemp**2 * zlognh3 +                                    &
-           7.612287245047392E-6_wp * ptemp**3 * zlognh3 +                                          &
-           3.417436525881869E-6_wp * prh * ptemp**3 * zlognh3 +                                    &
-           ( 0.1655358260404061_wp * zlognh3 ) / zlogsa +                                          &
-           ( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa +                                   &
-           ( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa -                                    &
-           ( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa -                             &
-           ( 0.04897027401984064_wp * ptemp**2 * zlognh3 ) / zlogsa +                              &
-           ( 0.01578269253599732_wp * prh * ptemp**2 * zlognh3 ) / zlogsa +                        &
-           ( 0.0001469672236351303_wp * ptemp**3 * zlognh3 ) / zlogsa -                            &
-           ( 0.00002935642836387197_wp * prh * ptemp**3 *zlognh3 ) / zlogsa +                      &
-           6.526451177887659_wp * zlogsa * zlognh3 -                                               &
-           0.2580021816722099_wp * ptemp * zlogsa * zlognh3 +                                      &
-           0.001434563104474292_wp * ptemp**2 * zlogsa * zlognh3 -                                 &
-           2.020361939304473E-6_wp * ptemp**3 * zlogsa * zlognh3 -                                 &
-           0.160335824596627_wp * zlogsa**2 * zlognh3 +                                            &
-           0.00889880721460806_wp * ptemp * zlogsa**2 * zlognh3 -                                  &
-           0.00005395139051155007_wp * ptemp**2 * zlogsa**2 * zlognh3 +                            &
-           8.39521718689596E-8_wp * ptemp**3 * zlogsa**2 * zlognh3 +                               &
-           6.091597586754857_wp * zlognh3**2 + 8.5786763679309_wp * prh * zlognh3**2 -             &
-           1.253783854872055_wp * ptemp * zlognh3**2 -                                             &
-           0.1123577232346848_wp * prh * ptemp * zlognh3**2 +                                      &
-           0.00939835595219825_wp * ptemp**2 * zlognh3**2 +                                        &
-           0.0004726256283031513_wp * prh * ptemp**2 * zlognh3**2 -                                &
-           0.00001749269360523252_wp * ptemp**3 * zlognh3**2 -                                     &
-           6.483647863710339E-7_wp * prh * ptemp**3 * zlognh3**2 +                                 &
-           ( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa +                                       &
-           ( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa -                                &
-           ( 0.02742195276078021_wp * ptemp**2 * zlognh3**2 ) / zlogsa +                           &
-           ( 0.00004934777934047135_wp * ptemp**3 * zlognh3**2 ) / zlogsa +                        &
-           41.30162491567873_wp * zlogsa * zlognh3**2 -                                            &
-           0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 +                                    &
-           0.000904383005178356_wp * ptemp**2 * zlogsa * zlognh3**2 -                              &
-           5.737876676408978E-7_wp * ptemp**3 * zlogsa * zlognh3**2 -                              &
-           2.327363918851818_wp * zlogsa**2 * zlognh3**2 +                                         &
-           0.02346464261919324_wp * ptemp * zlogsa**2 * zlognh3**2 -                               &
-           0.000076518969516405_wp * ptemp**2 * zlogsa**2 * zlognh3**2 +                           &
-           8.04589834836395E-8_wp * ptemp**3 * zlogsa**2 * zlognh3**2 -                            &
-           0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh +              &
-           0.005258130151226247_wp * ptemp**2 * zlogrh -                                           &
-           8.98037634284419E-6_wp * ptemp**3 * zlogrh +                                            &
-           ( 0.05993213079516759_wp * zlogrh ) / zlogsa +                                          &
-           ( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa -                                    &
-           ( 0.03624322255690942_wp * ptemp**2 * zlogrh ) / zlogsa +                               &
-           ( 0.00004933369382462509_wp * ptemp**3 * zlogrh ) / zlogsa -                            &
-           0.7327310805365114_wp * zlognh3 * zlogrh -                                              &
-           0.01841792282958795_wp * ptemp * zlognh3 * zlogrh +                                     &
-           0.0001471855981005184_wp * ptemp**2 * zlognh3 * zlogrh -                                &
-           2.377113195631848E-7_wp * ptemp**3 * zlognh3 * zlogrh
-    pnuc_rate = EXP( zlnj )   ! (#/(cm3 s))
-!
-!-- Check validity of parametrization
-    IF ( pnuc_rate < 1.0E-5_wp )  THEN
-       pnuc_rate = 0.0_wp
-       pd_crit   = 1.0E-9_wp
-    ELSEIF ( pnuc_rate > 1.0E6_wp )  THEN
-       message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s'
-       CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 )
-    ENDIF
-    pnuc_rate = pnuc_rate * 1.0E6_wp   ! (#/(m3 s))
-!
-!-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9)
-    pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj +                             &
-                 0.002988789927230632_wp * zlnj**2 - 0.3576046920535017_wp * ptemp -               &
-                 0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2
-!
-!-- Kinetic limit: at least 2 H2SO4 molecules in a cluster
-    pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp )
-!
-!-- 4) Size of the critical cluster in nm (Eq. 12)
-    pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj -                             &
-              7.822111731550752E-6_wp * zlnj**2 - 0.001567273351921166_wp * ptemp -                &
-              0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2
-    pd_crit = pd_crit * 2.0E-9_wp   ! Diameter in m
-!
-!-- 5) Organic compounds not involved when ternary nucleation assumed
-    pn_crit_ocnv = 0.0_wp
-    pk_sa   = 1.0_wp
-    pk_ocnv = 0.0_wp
-
- END SUBROUTINE ternucl
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of
-!> small particles. It calculates number of the particles in the size range
-!> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not
-!> valid for certain rational numbers, e.g. -4/3 and -3/2)
-!------------------------------------------------------------------------------!
- FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !< running index
-
-    REAL(wp) ::  d1            !< lower diameter limit
-    REAL(wp) ::  dx            !< upper diameter limit
-    REAL(wp) ::  zjnuc_t       !< initial nucleation rate (1/s)
-    REAL(wp) ::  zeta          !< ratio of CS/GR (m) (condensation sink / growth rate)
-    REAL(wp) ::  term1         !<
-    REAL(wp) ::  term2         !<
-    REAL(wp) ::  term3         !<
-    REAL(wp) ::  term4         !<
-    REAL(wp) ::  term5         !<
-    REAL(wp) ::  z_n_nuc_tayl  !< final nucleation rate (1/s)
-    REAL(wp) ::  z_gr_tot      !< total growth rate (nm/h)
-    REAL(wp) ::  zm_para       !< m parameter in Lehtinen et al. (2007), Eq. 6
-
-    z_n_nuc_tayl = 0.0_wp
-
-    DO  i = 0, 29
-       IF ( i == 0  .OR.  i == 1 )  THEN
-          term1 = 1.0_wp
-       ELSE
-          term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) )
-       END IF
-       term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1
-       term3 = zeta**i
-       term4 = term3 / term2
-       term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp
-       z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dx**term5 - d1**term5 )
-    ENDDO
-    z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot
-
- END FUNCTION z_n_nuc_tayl
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates the condensation of water vapour on aerosol particles. Follows the
-!> analytical predictor method by Jacobson (2005).
-!> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling
-!> (2nd edition).
-!------------------------------------------------------------------------------!
- SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib   !< loop index
-    INTEGER(iwp) ::  nstr !<
-
-    REAL(wp) ::  adt        !< internal timestep in this subroutine
-    REAL(wp) ::  rhoair     !< air density (kg/m3)
-    REAL(wp) ::  ttot       !< total time (s)
-    REAL(wp) ::  zact       !< Water activity
-    REAL(wp) ::  zaelwc1    !< Current aerosol water content (kg/m3)
-    REAL(wp) ::  zaelwc2    !< New aerosol water content after equilibrium calculation (kg/m3)
-    REAL(wp) ::  zbeta      !< Transitional correction factor
-    REAL(wp) ::  zcwc       !< Current water vapour mole concentration in aerosols (mol/m3)
-    REAL(wp) ::  zcwint     !< Current and new water vapour mole concentrations (mol/m3)
-    REAL(wp) ::  zcwn       !< New water vapour mole concentration (mol/m3)
-    REAL(wp) ::  zcwtot     !< Total water mole concentration (mol/m3)
-    REAL(wp) ::  zdfh2o     !< molecular diffusion coefficient (cm2/s) for water
-    REAL(wp) ::  zhlp1      !< intermediate variable to calculate the mass transfer coefficient
-    REAL(wp) ::  zhlp2      !< intermediate variable to calculate the mass transfer coefficient
-    REAL(wp) ::  zhlp3      !< intermediate variable to calculate the mass transfer coefficient
-    REAL(wp) ::  zknud      !< Knudsen number
-    REAL(wp) ::  zmfph2o    !< mean free path of H2O gas molecule
-    REAL(wp) ::  zrh        !< relative humidity [0-1]
-    REAL(wp) ::  zthcond    !< thermal conductivity of air (W/m/K)
-
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwcae     !< Current water mole concentrations
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwintae   !< Current and new aerosol water mole concentration
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwnae     !< New water mole concentration in aerosols
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zcwsurfae  !< Surface mole concentration
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zkelvin    !< Kelvin effect
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zmtae      !< Mass transfer coefficients
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zwsatae    !< Water saturation ratio above aerosols
-
-    REAL(wp), INTENT(in) ::  ppres   !< Air pressure (Pa)
-    REAL(wp), INTENT(in) ::  pcs     !< Water vapour saturation concentration (kg/m3)
-    REAL(wp), INTENT(in) ::  ptemp   !< Ambient temperature (K)
-    REAL(wp), INTENT(in) ::  ptstep  !< timestep (s)
-
-    REAL(wp), INTENT(inout) ::  pcw  !< Water vapour concentration (kg/m3)
-
-    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero  !< Aerosol properties
-!
-!-- Relative humidity [0-1]
-    zrh = pcw / pcs
-!
-!-- Calculate the condensation only for 2a/2b aerosol bins
-    nstr = start_subrange_2a
-!
-!-- Save the current aerosol water content, 8 in paero is H2O
-    zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
-!
-!-- Equilibration:
-    IF ( advect_particle_water )  THEN
-       IF ( zrh < 0.98_wp  .OR.  .NOT. lscndh2oae )  THEN
-          CALL equilibration( zrh, ptemp, paero, .TRUE. )
-       ELSE
-          CALL equilibration( zrh, ptemp, paero, .FALSE. )
-       ENDIF
-    ENDIF
-!
-!-- The new aerosol water content after equilibrium calculation
-    zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o
-!
-!-- New water vapour mixing ratio (kg/m3)
-    pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp )
-!
-!-- Initialise variables
-    zcwsurfae(:) = 0.0_wp
-    zhlp1        = 0.0_wp
-    zhlp2        = 0.0_wp
-    zhlp3        = 0.0_wp
-    zmtae(:)     = 0.0_wp
-    zwsatae(:)   = 0.0_wp
-!
-!-- Air:
-!-- Density (kg/m3)
-    rhoair = amdair * ppres / ( argas * ptemp )
-!
-!-- Thermal conductivity of air
-    zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp )
-!
-!-- Water vapour:
-!-- Molecular diffusion coefficient (cm2/s) (eq.16.17)
-    zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp**2 ) ) * SQRT( argas *   &
-               1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp /           &
-               ( pi * amh2o * 2.0E+3_wp ) )
-    zdfh2o = zdfh2o * 1.0E-4   ! Unit change to m^2/s
-!
-!-- Mean free path (eq. 15.25 & 16.29)
-    zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) )
-!
-!-- Kelvin effect (eq. 16.33)
-    zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) )
-
-    DO  ib = 1, nbins_aerosol
-       IF ( paero(ib)%numc > nclim  .AND.  zrh > 0.98_wp )  THEN
-!
-!--       Water activity
-          zact = acth2o( paero(ib) )
-!
-!--       Saturation mole concentration over flat surface. Limit the super-
-!--       saturation to max 1.01 for the mass transfer. Experimental!
-          zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o
-!
-!--       Equilibrium saturation ratio
-          zwsatae(ib) = zact * zkelvin(ib)
-!
-!--       Knudsen number (eq. 16.20)
-          zknud = 2.0_wp * zmfph2o / paero(ib)%dwet
-!
-!--       Transitional correction factor (Fuks & Sutugin, 1971)
-          zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp /                      &
-                  ( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) )
-!
-!--       Mass transfer of H2O: Eq. 16.64 but here D^eff =  zdfh2o * zbeta
-          zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta
-!
-!--       1st term on the left side of the denominator in eq. 16.55
-          zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp )
-!
-!--       2nd term on the left side of the denominator in eq. 16.55
-          zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp
-!
-!--       Full eq. 16.64: Mass transfer coefficient (1/s)
-          zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp )
-       ENDIF
-    ENDDO
-!
-!-- Current mole concentrations of water
-    zcwc        = pcw * rhoair / amh2o   ! as vapour
-    zcwcae(:)   = paero(:)%volc(8) * arhoh2o / amh2o   ! in aerosols
-    zcwtot      = zcwc + SUM( zcwcae )   ! total water concentration
-    zcwnae(:)   = 0.0_wp
-    zcwintae(:) = zcwcae(:)
-!
-!-- Substepping loop
-    zcwint = 0.0_wp
-    ttot   = 0.0_wp
-    DO  WHILE ( ttot < ptstep )
-       adt = 2.0E-2_wp   ! internal timestep
-!
-!--    New vapour concentration: (eq. 16.71)
-       zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) *       &
-                                   zcwsurfae(nstr:nbins_aerosol) ) )   ! numerator
-       zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) )   ! denomin.
-       zcwint = zhlp1 / zhlp2   ! new vapour concentration
-       zcwint = MIN( zcwint, zcwtot )
-       IF ( ANY( paero(:)%numc > nclim )  .AND. zrh > 0.98_wp )  THEN
-          DO  ib = nstr, nbins_aerosol
-             zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) *      &
-                                                   zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ),       &
-                                            0.05_wp * zcwcae(ib) )
-             zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib)
-          ENDDO
-       ENDIF
-       zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp )
-!
-!--    Update vapour concentration for consistency
-       zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) )
-!
-!--    Update "old" values for next cycle
-       zcwcae = zcwintae
-
-       ttot = ttot + adt
-
-    ENDDO   ! ADT
-
-    zcwn      = zcwint
-    zcwnae(:) = zcwintae(:)
-    pcw       = zcwn * amh2o / rhoair
-    paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o )
-
- END SUBROUTINE gpparth2o
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates the activity coefficient of liquid water
-!------------------------------------------------------------------------------!
- REAL(wp) FUNCTION acth2o( ppart, pcw )
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  zns  !< molar concentration of solutes (mol/m3)
-    REAL(wp) ::  znw  !< molar concentration of water (mol/m3)
-
-    REAL(wp), INTENT(in), OPTIONAL ::  pcw !< molar concentration of water (mol/m3)
-
-    TYPE(t_section), INTENT(in) ::  ppart !< Aerosol properties of a bin
-
-    zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + &
-            2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) +   &
-            ( ppart%volc(7) * arhonh3 / amnh3 ) )
-
-    IF ( PRESENT(pcw) ) THEN
-       znw = pcw
-    ELSE
-       znw = ppart%volc(8) * arhoh2o / amh2o
-    ENDIF
-!
-!-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface
-!--          = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21)
-!-- Assume activity coefficient of 1 for water
-    acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) )
-
- END FUNCTION acth2o
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates the dissolutional growth of particles (i.e. gas transfers to a
-!> particle surface and dissolves in liquid water on the surface). Treated here
-!> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3
-!> (Chapter 17.14 in Jacobson, 2005).
-!
-!> Called from subroutine condensation.
-!> Coded by:
-!> Harri Kokkola (FMI)
-!------------------------------------------------------------------------------!
- SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib  !< loop index
-
-    REAL(wp) ::  adt          !< timestep
-    REAL(wp) ::  zc_nh3_c     !< Current NH3 gas concentration
-    REAL(wp) ::  zc_nh3_int   !< Intermediate NH3 gas concentration
-    REAL(wp) ::  zc_nh3_n     !< New NH3 gas concentration
-    REAL(wp) ::  zc_nh3_tot   !< Total NH3 concentration
-    REAL(wp) ::  zc_hno3_c    !< Current HNO3 gas concentration
-    REAL(wp) ::  zc_hno3_int  !< Intermediate HNO3 gas concentration
-    REAL(wp) ::  zc_hno3_n    !< New HNO3 gas concentration
-    REAL(wp) ::  zc_hno3_tot  !< Total HNO3 concentration
-    REAL(wp) ::  zdfvap       !< Diffusion coefficient for vapors
-    REAL(wp) ::  zhlp1        !< intermediate variable
-    REAL(wp) ::  zhlp2        !< intermediate variable
-    REAL(wp) ::  zrh          !< relative humidity
-
-    REAL(wp), INTENT(in) ::  ppres      !< ambient pressure (Pa)
-    REAL(wp), INTENT(in) ::  pcs        !< water vapour saturation
-                                        !< concentration (kg/m3)
-    REAL(wp), INTENT(in) ::  ptemp      !< ambient temperature (K)
-    REAL(wp), INTENT(in) ::  ptstep     !< time step (s)
-
-    REAL(wp), INTENT(inout) ::  pghno3  !< nitric acid concentration (#/m3)
-    REAL(wp), INTENT(inout) ::  pgnh3   !< ammonia conc. (#/m3)
-    REAL(wp), INTENT(inout) ::  pcw     !< water vapour concentration (kg/m3)
-
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_hno3_ae     !< Activity coefficients for HNO3
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_hhso4_ae    !< Activity coefficients for HHSO4
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_nh3_ae      !< Activity coefficients for NH3
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zac_nh4hso2_ae  !< Activity coefficients for NH4HSO2
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zcg_hno3_eq_ae  !< Equilibrium gas concentration: HNO3
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zcg_nh3_eq_ae   !< Equilibrium gas concentration: NH3
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_int_ae  !< Intermediate HNO3 aerosol concentration
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_c_ae    !< Current HNO3 in aerosols
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_hno3_n_ae    !< New HNO3 in aerosols
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_int_ae   !< Intermediate NH3 aerosol concentration
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_c_ae     !< Current NH3 in aerosols
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zc_nh3_n_ae     !< New NH3 in aerosols
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zkel_hno3_ae    !< Kelvin effect for HNO3
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zkel_nh3_ae     !< Kelvin effects for NH3
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zmt_hno3_ae     !< Mass transfer coefficients for HNO3
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zmt_nh3_ae      !< Mass transfer coefficients for NH3
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zsat_hno3_ae    !< HNO3 saturation ratio over a surface
-    REAL(wp), DIMENSION(nbins_aerosol) ::  zsat_nh3_ae     !< NH3 saturation ratio over a surface
-
-    REAL(wp), DIMENSION(nbins_aerosol,maxspec) ::  zion_mols   !< Ion molalities from pdfite aerosols
-
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pbeta !< transitional correction factor for
-
-    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero !< Aerosol properties
-!
-!-- Initialise:
-    adt            = ptstep
-    zac_hhso4_ae   = 0.0_wp
-    zac_nh3_ae     = 0.0_wp
-    zac_nh4hso2_ae = 0.0_wp
-    zac_hno3_ae    = 0.0_wp
-    zcg_nh3_eq_ae  = 0.0_wp
-    zcg_hno3_eq_ae = 0.0_wp
-    zion_mols      = 0.0_wp
-    zsat_nh3_ae    = 1.0_wp
-    zsat_hno3_ae   = 1.0_wp
-!
-!-- Diffusion coefficient (m2/s)
-    zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres
-!
-!-- Kelvin effects (Jacobson (2005), eq. 16.33)
-    zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 /                               &
-                                    ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
-    zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 /                                 &
-                                   ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) )
-!
-!-- Current vapour mole concentrations (mol/m3)
-    zc_hno3_c = pghno3 / avo  ! HNO3
-    zc_nh3_c = pgnh3 / avo   ! NH3
-!
-!-- Current particle mole concentrations (mol/m3)
-    zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3
-    zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3
-!
-!-- Total mole concentrations: gas and particle phase
-    zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) )
-    zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) )
-!
-!-- Relative humidity [0-1]
-    zrh = pcw / pcs
-!
-!-- Mass transfer coefficients (Jacobson, Eq. 16.64)
-    zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
-    zmt_nh3_ae(:)  = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:)
-
-!
-!-- Get the equilibrium concentrations above aerosols
-    CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae,           &
-                                       zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae,      &
-                                       zion_mols )
-!
-!-- Calculate NH3 and HNO3 saturation ratios for aerosols
-    CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae,     &
-                                      zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae,     &
-                                      zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae )
-!
-!-- Intermediate gas concentrations of HNO3 and NH3
-    zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
-    zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) )
-    zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 )
-
-    zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
-    zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) )
-    zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 )
-
-    zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot )
-    zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot )
-!
-!-- Calculate the new concentration on aerosol particles
-    zc_hno3_int_ae = zc_hno3_c_ae
-    zc_nh3_int_ae = zc_nh3_c_ae
-    DO  ib = 1, nbins_aerosol
-       zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) /           &
-                            ( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) )
-       zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) /               &
-                           ( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) )
-    ENDDO
-
-    zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp )
-    zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp )
-!
-!-- Final molar gas concentration and molar particle concentration of HNO3
-    zc_hno3_n   = zc_hno3_int
-    zc_hno3_n_ae = zc_hno3_int_ae
-!
-!-- Final molar gas concentration and molar particle concentration of NH3
-    zc_nh3_n   = zc_nh3_int
-    zc_nh3_n_ae = zc_nh3_int_ae
-!
-!-- Model timestep reached - update the gas concentrations
-    pghno3 = zc_hno3_n * avo
-    pgnh3  = zc_nh3_n * avo
-!
-!-- Update the particle concentrations
-    DO  ib = start_subrange_1a, end_subrange_2b
-       paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3
-       paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3
-    ENDDO
-
- END SUBROUTINE gpparthno3
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the equilibrium concentrations above aerosols (reference?)
-!------------------------------------------------------------------------------!
- SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, &
-                                          pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib  !< loop index: aerosol bins
-
-    REAL(wp) ::  zhlp         !< intermediate variable
-    REAL(wp) ::  zp_hcl       !< Equilibrium vapor pressures (Pa) of HCl
-    REAL(wp) ::  zp_hno3      !< Equilibrium vapor pressures (Pa) of HNO3
-    REAL(wp) ::  zp_nh3       !< Equilibrium vapor pressures (Pa) of NH3
-    REAL(wp) ::  zwatertotal  !< Total water in particles (mol/m3)
-
-    REAL(wp), INTENT(in) ::  prh    !< relative humidity
-    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
-
-    REAL(wp), DIMENSION(maxspec) ::  zgammas  !< Activity coefficients
-    REAL(wp), DIMENSION(maxspec) ::  zions    !< molar concentration of ion (mol/m3)
-
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pcg_nh3_eq      !< equilibrium molar
-                                                                          !< concentration: of NH3
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pcg_hno3_eq     !< of HNO3
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_hhso4    !< activity coeff. of HHSO4
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_nh4      !< activity coeff. of NH3
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_nh4hso2  !< activity coeff. of NH4HSO2
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) ::  pgamma_hno3     !< activity coeff. of HNO3
-
-    REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) ::  pmols  !< Ion molalities
-
-    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  ppart  !< Aerosol properties
-
-    zgammas     = 0.0_wp
-    zhlp        = 0.0_wp
-    zions       = 0.0_wp
-    zp_hcl      = 0.0_wp
-    zp_hno3     = 0.0_wp
-    zp_nh3      = 0.0_wp
-    zwatertotal = 0.0_wp
-
-    DO  ib = 1, nbins_aerosol
-
-       IF ( ppart(ib)%numc < nclim )  CYCLE
-!
-!--    Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4
-       zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss &
-              + ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss -        &
-              ppart(ib)%volc(7) * arhonh3 / amnh3
-
-       zions(1) = zhlp                                   ! H+
-       zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3     ! NH4+
-       zions(3) = ppart(ib)%volc(5) * arhoss / amss       ! Na+
-       zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-)
-       zions(5) = 0.0_wp                                 ! HSO4-
-       zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3   ! NO3-
-       zions(7) = ppart(ib)%volc(5) * arhoss / amss       ! Cl-
-
-       zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o
-       IF ( zwatertotal > 1.0E-30_wp )  THEN
-          CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, &
-                                 pmols(ib,:) )
-       ENDIF
-!
-!--    Activity coefficients
-       pgamma_hno3(ib)    = zgammas(1)  ! HNO3
-       pgamma_nh4(ib)     = zgammas(3)  ! NH3
-       pgamma_nh4hso2(ib) = zgammas(6)  ! NH4HSO2
-       pgamma_hhso4(ib)   = zgammas(7)  ! HHSO4
-!
-!--    Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa)
-       pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp )
-       pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp )
-
-    ENDDO
-
-  END SUBROUTINE nitrate_ammonium_equilibrium
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate saturation ratios of NH4 and HNO3 for aerosols
-!------------------------------------------------------------------------------!
- SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq,    &
-                                         pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: ib   !< running index for aerosol bins
-
-    REAL(wp) ::  k_ll_h2o   !< equilibrium constants of equilibrium reactions:
-                            !< H2O(aq) <--> H+ + OH- (mol/kg)
-    REAL(wp) ::  k_ll_nh3   !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg)
-    REAL(wp) ::  k_gl_nh3   !< NH3(g) <--> NH3(aq) (mol/kg/atm)
-    REAL(wp) ::  k_gl_hno3  !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm)
-    REAL(wp) ::  zmol_no3   !< molality of NO3- (mol/kg)
-    REAL(wp) ::  zmol_h     !< molality of H+ (mol/kg)
-    REAL(wp) ::  zmol_so4   !< molality of SO4(2-) (mol/kg)
-    REAL(wp) ::  zmol_cl    !< molality of Cl- (mol/kg)
-    REAL(wp) ::  zmol_nh4   !< molality of NH4+ (mol/kg)
-    REAL(wp) ::  zmol_na    !< molality of Na+ (mol/kg)
-    REAL(wp) ::  zhlp1      !< intermediate variable
-    REAL(wp) ::  zhlp2      !< intermediate variable
-    REAL(wp) ::  zhlp3      !< intermediate variable
-    REAL(wp) ::  zxi        !< particle mole concentration ratio: (NH3+SS)/H2SO4
-    REAL(wp) ::  zt0        !< reference temp
-
-    REAL(wp), PARAMETER ::  a1 = -22.52_wp     !<
-    REAL(wp), PARAMETER ::  a2 = -1.50_wp      !<
-    REAL(wp), PARAMETER ::  a3 = 13.79_wp      !<
-    REAL(wp), PARAMETER ::  a4 = 29.17_wp      !<
-    REAL(wp), PARAMETER ::  b1 = 26.92_wp      !<
-    REAL(wp), PARAMETER ::  b2 = 26.92_wp      !<
-    REAL(wp), PARAMETER ::  b3 = -5.39_wp      !<
-    REAL(wp), PARAMETER ::  b4 = 16.84_wp      !<
-    REAL(wp), PARAMETER ::  K01 = 1.01E-14_wp  !<
-    REAL(wp), PARAMETER ::  K02 = 1.81E-5_wp   !<
-    REAL(wp), PARAMETER ::  K03 = 57.64_wp     !<
-    REAL(wp), PARAMETER ::  K04 = 2.51E+6_wp   !<
-
-    REAL(wp), INTENT(in) ::  ptemp  !< ambient temperature (K)
-
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pachhso4    !< activity coeff. of HHSO4
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pacnh4hso2  !< activity coeff. of NH4HSO2
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pachno3     !< activity coeff. of HNO3
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pchno3eq    !< eq. surface concentration: HNO3
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pchno3      !< current particle mole
-                                                                   !< concentration of HNO3 (mol/m3)
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pc_nh3      !< of NH3 (mol/m3)
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pkelhno3    !< Kelvin effect for HNO3
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) ::  pkelnh3     !< Kelvin effect for NH3
-
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) ::  psathno3 !< saturation ratio of HNO3
-    REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) ::  psatnh3  !< saturation ratio of NH3
-
-    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  ppart  !< Aerosol properties
-
-    zmol_cl  = 0.0_wp
-    zmol_h   = 0.0_wp
-    zmol_na  = 0.0_wp
-    zmol_nh4 = 0.0_wp
-    zmol_no3 = 0.0_wp
-    zmol_so4 = 0.0_wp
-    zt0      = 298.15_wp
-    zxi      = 0.0_wp
-!
-!-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005):
-!-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3
-    zhlp1 = zt0 / ptemp
-    zhlp2 = zhlp1 - 1.0_wp
-    zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1
-
-    k_ll_h2o  = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 )
-    k_ll_nh3  = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 )
-    k_gl_nh3  = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 )
-    k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 )
-
-    DO  ib = 1, nbins_aerosol
-
-       IF ( ppart(ib)%numc > nclim  .AND.  ppart(ib)%volc(8) > 1.0E-30_wp  )  THEN
-!
-!--       Molality of H+ and NO3-
-          zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc  &
-                  + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
-          zmol_no3 = pchno3(ib) / zhlp1  !< mol/kg
-!
-!--       Particle mole concentration ratio: (NH3+SS)/H2SO4
-          zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) *         &
-                  arhoh2so4 / amh2so4 )
-
-          IF ( zxi <= 2.0_wp )  THEN
-!
-!--          Molality of SO4(2-)
-             zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc +       &
-                     ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
-             zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1
-!
-!--          Molality of Cl-
-             zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc +       &
-                     ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o
-             zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1
-!
-!--          Molality of NH4+
-             zhlp1 =  pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) *    &
-                      arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o
-             zmol_nh4 = pc_nh3(ib) / zhlp1
-!
-!--          Molality of Na+
-             zmol_na = zmol_cl
-!
-!--          Molality of H+
-             zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na )
-
-          ELSE
-
-             zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2
-
-             IF ( zhlp2 > 1.0E-30_wp )  THEN
-                zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38
-             ELSE
-                zmol_h = 0.0_wp
-             ENDIF
-
-          ENDIF
-
-          zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3
-!
-!--       Saturation ratio for NH3 and for HNO3
-          IF ( zmol_h > 0.0_wp )  THEN
-             zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h )
-             zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 )
-             psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )**2 ) * zhlp3
-             psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1
-          ELSE
-             psatnh3(ib) = 1.0_wp
-             psathno3(ib) = 1.0_wp
-          ENDIF
-       ELSE
-          psatnh3(ib) = 1.0_wp
-          psathno3(ib) = 1.0_wp
-       ENDIF
-
-    ENDDO
-
-  END SUBROUTINE nitrate_ammonium_saturation
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prototype module for calculating the water content of a mixed inorganic/
-!> organic particle + equilibrium water vapour pressure above the solution
-!> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation
-!> of the partitioning of species between gas and aerosol. Based in a chamber
-!> study.
-!
-!> Written by Dave Topping. Pure organic component properties predicted by Mark
-!> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin.
-!> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6
-!> EUCAARI Integrated Project.
-!
-!> REFERENCES
-!> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at
-!>    298.15 K, J. Phys. Chem., 102A, 2155-2171.
-!> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and
-!>    dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738.
-!> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 -
-!>    Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222.
-!> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 -
-!>    Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242.
-!> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for
-!>    inorganic and Câ and Câ organic substances in SI units (book)
-!> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in
-!>    aqueous atmospheric aerosols, JGR, 110, D02201, 2005.
-!
-!> Queries concerning the use of this code through Gordon McFiggans,
-!> g.mcfiggans@manchester.ac.uk,
-!> Ownership: D. Topping, Centre for Atmospheric Sciences, University of
-!> Manchester, 2007
-!
-!> Rewritten to PALM by Mona Kurppa, UHel, 2017
-!------------------------------------------------------------------------------!
- SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3,       &
-                              gamma_out, mols_out )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  binary_case
-    INTEGER(iwp) ::  full_complexity
-
-    REAL(wp) ::  a                         !< auxiliary variable
-    REAL(wp) ::  act_product               !< ionic activity coef. product:
-                                           !< = (gamma_h2so4**3d0) / gamma_hhso4**2d0)
-    REAL(wp) ::  ammonium_chloride         !<
-    REAL(wp) ::  ammonium_chloride_eq_frac !<
-    REAL(wp) ::  ammonium_nitrate          !<
-    REAL(wp) ::  ammonium_nitrate_eq_frac  !<
-    REAL(wp) ::  ammonium_sulphate         !<
-    REAL(wp) ::  ammonium_sulphate_eq_frac !<
-    REAL(wp) ::  b                         !< auxiliary variable
-    REAL(wp) ::  binary_h2so4              !< binary H2SO4 activity coeff.
-    REAL(wp) ::  binary_hcl                !< binary HCL activity coeff.
-    REAL(wp) ::  binary_hhso4              !< binary HHSO4 activity coeff.
-    REAL(wp) ::  binary_hno3               !< binary HNO3 activity coeff.
-    REAL(wp) ::  binary_nh4hso4            !< binary NH4HSO4 activity coeff.
-    REAL(wp) ::  c                         !< auxiliary variable
-    REAL(wp) ::  charge_sum                !< sum of ionic charges
-    REAL(wp) ::  gamma_h2so4               !< activity coefficient
-    REAL(wp) ::  gamma_hcl                 !< activity coefficient
-    REAL(wp) ::  gamma_hhso4               !< activity coeffient
-    REAL(wp) ::  gamma_hno3                !< activity coefficient
-    REAL(wp) ::  gamma_nh3                 !< activity coefficient
-    REAL(wp) ::  gamma_nh4hso4             !< activity coefficient
-    REAL(wp) ::  h_out                     !<
-    REAL(wp) ::  h_real                    !< new hydrogen ion conc.
-    REAL(wp) ::  h2so4_hcl                 !< contribution of H2SO4
-    REAL(wp) ::  h2so4_hno3                !< contribution of H2SO4
-    REAL(wp) ::  h2so4_nh3                 !< contribution of H2SO4
-    REAL(wp) ::  h2so4_nh4hso4             !< contribution of H2SO4
-    REAL(wp) ::  hcl_h2so4                 !< contribution of HCL
-    REAL(wp) ::  hcl_hhso4                 !< contribution of HCL
-    REAL(wp) ::  hcl_hno3                  !< contribution of HCL
-    REAL(wp) ::  hcl_nh4hso4               !< contribution of HCL
-    REAL(wp) ::  henrys_temp_dep           !< temperature dependence of Henry's Law
-    REAL(wp) ::  hno3_h2so4                !< contribution of HNO3
-    REAL(wp) ::  hno3_hcl                  !< contribution of HNO3
-    REAL(wp) ::  hno3_hhso4                !< contribution of HNO3
-    REAL(wp) ::  hno3_nh3                  !< contribution of HNO3
-    REAL(wp) ::  hno3_nh4hso4              !< contribution of HNO3
-    REAL(wp) ::  hso4_out                  !<
-    REAL(wp) ::  hso4_real                 !< new bisulphate ion conc.
-    REAL(wp) ::  hydrochloric_acid         !<
-    REAL(wp) ::  hydrochloric_acid_eq_frac !<
-    REAL(wp) ::  k_h                       !< equilibrium constant for H+
-    REAL(wp) ::  k_hcl                     !< equilibrium constant of HCL
-    REAL(wp) ::  k_hno3                    !< equilibrium constant of HNO3
-    REAL(wp) ::  k_nh4                     !< equilibrium constant for NH4+
-    REAL(wp) ::  k_h2o                     !< equil. const. for water_surface
-    REAL(wp) ::  ln_h2so4_act              !< gamma_h2so4 = EXP(ln_h2so4_act)
-    REAL(wp) ::  ln_HCL_act                !< gamma_hcl = EXP( ln_HCL_act )
-    REAL(wp) ::  ln_hhso4_act              !< gamma_hhso4 = EXP(ln_hhso4_act)
-    REAL(wp) ::  ln_hno3_act               !< gamma_hno3 = EXP( ln_hno3_act )
-    REAL(wp) ::  ln_nh4hso4_act            !< gamma_nh4hso4 = EXP( ln_nh4hso4_act )
-    REAL(wp) ::  molality_ratio_nh3        !< molality ratio of NH3 (NH4+ and H+)
-    REAL(wp) ::  na2so4_h2so4              !< contribution of Na2SO4
-    REAL(wp) ::  na2so4_hcl                !< contribution of Na2SO4
-    REAL(wp) ::  na2so4_hhso4              !< contribution of Na2SO4
-    REAL(wp) ::  na2so4_hno3               !< contribution of Na2SO4
-    REAL(wp) ::  na2so4_nh3                !< contribution of Na2SO4
-    REAL(wp) ::  na2so4_nh4hso4            !< contribution of Na2SO4
-    REAL(wp) ::  nacl_h2so4                !< contribution of NaCl
-    REAL(wp) ::  nacl_hcl                  !< contribution of NaCl
-    REAL(wp) ::  nacl_hhso4                !< contribution of NaCl
-    REAL(wp) ::  nacl_hno3                 !< contribution of NaCl
-    REAL(wp) ::  nacl_nh3                  !< contribution of NaCl
-    REAL(wp) ::  nacl_nh4hso4              !< contribution of NaCl
-    REAL(wp) ::  nano3_h2so4               !< contribution of NaNO3
-    REAL(wp) ::  nano3_hcl                 !< contribution of NaNO3
-    REAL(wp) ::  nano3_hhso4               !< contribution of NaNO3
-    REAL(wp) ::  nano3_hno3                !< contribution of NaNO3
-    REAL(wp) ::  nano3_nh3                 !< contribution of NaNO3
-    REAL(wp) ::  nano3_nh4hso4             !< contribution of NaNO3
-    REAL(wp) ::  nh42so4_h2so4             !< contribution of NH42SO4
-    REAL(wp) ::  nh42so4_hcl               !< contribution of NH42SO4
-    REAL(wp) ::  nh42so4_hhso4             !< contribution of NH42SO4
-    REAL(wp) ::  nh42so4_hno3              !< contribution of NH42SO4
-    REAL(wp) ::  nh42so4_nh3               !< contribution of NH42SO4
-    REAL(wp) ::  nh42so4_nh4hso4           !< contribution of NH42SO4
-    REAL(wp) ::  nh4cl_h2so4               !< contribution of NH4Cl
-    REAL(wp) ::  nh4cl_hcl                 !< contribution of NH4Cl
-    REAL(wp) ::  nh4cl_hhso4               !< contribution of NH4Cl
-    REAL(wp) ::  nh4cl_hno3                !< contribution of NH4Cl
-    REAL(wp) ::  nh4cl_nh3                 !< contribution of NH4Cl
-    REAL(wp) ::  nh4cl_nh4hso4             !< contribution of NH4Cl
-    REAL(wp) ::  nh4no3_h2so4              !< contribution of NH4NO3
-    REAL(wp) ::  nh4no3_hcl                !< contribution of NH4NO3
-    REAL(wp) ::  nh4no3_hhso4              !< contribution of NH4NO3
-    REAL(wp) ::  nh4no3_hno3               !< contribution of NH4NO3
-    REAL(wp) ::  nh4no3_nh3                !< contribution of NH4NO3
-    REAL(wp) ::  nh4no3_nh4hso4            !< contribution of NH4NO3
-    REAL(wp) ::  nitric_acid               !<
-    REAL(wp) ::  nitric_acid_eq_frac       !< Equivalent fractions
-    REAL(wp) ::  press_hcl                 !< partial pressure of HCL
-    REAL(wp) ::  press_hno3                !< partial pressure of HNO3
-    REAL(wp) ::  press_nh3                 !< partial pressure of NH3
-    REAL(wp) ::  rh                        !< relative humidity [0-1]
-    REAL(wp) ::  root1                     !< auxiliary variable
-    REAL(wp) ::  root2                     !< auxiliary variable
-    REAL(wp) ::  so4_out                   !<
-    REAL(wp) ::  so4_real                  !< new sulpate ion concentration
-    REAL(wp) ::  sodium_chloride           !<
-    REAL(wp) ::  sodium_chloride_eq_frac   !<
-    REAL(wp) ::  sodium_nitrate            !<
-    REAL(wp) ::  sodium_nitrate_eq_frac    !<
-    REAL(wp) ::  sodium_sulphate           !<
-    REAL(wp) ::  sodium_sulphate_eq_frac   !<
-    REAL(wp) ::  solutes                   !<
-    REAL(wp) ::  sulphuric_acid            !<
-    REAL(wp) ::  sulphuric_acid_eq_frac    !<
-    REAL(wp) ::  temp                      !< temperature
-    REAL(wp) ::  water_total               !<
-
-    REAL(wp), DIMENSION(:) ::  gamma_out !< Activity coefficient for calculating the non-ideal
-                                         !< dissociation constants
-                                         !< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4,
-                                         !< 5: H2SO4**3/HHSO4**2, 6: NH4HSO2, 7: HHSO4
-    REAL(wp), DIMENSION(:) ::  ions      !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+,
-                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
-    REAL(wp), DIMENSION(7) ::  ions_mol  !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+,
-                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
-    REAL(wp), DIMENSION(:) ::  mols_out  !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+,
-                                         !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
-!
-!-- Value initialisation
-    binary_h2so4    = 0.0_wp
-    binary_hcl      = 0.0_wp
-    binary_hhso4    = 0.0_wp
-    binary_hno3     = 0.0_wp
-    binary_nh4hso4  = 0.0_wp
-    henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K
-    hcl_hno3        = 1.0_wp
-    h2so4_hno3      = 1.0_wp
-    nh42so4_hno3    = 1.0_wp
-    nh4no3_hno3     = 1.0_wp
-    nh4cl_hno3      = 1.0_wp
-    na2so4_hno3     = 1.0_wp
-    nano3_hno3      = 1.0_wp
-    nacl_hno3       = 1.0_wp
-    hno3_hcl        = 1.0_wp
-    h2so4_hcl       = 1.0_wp
-    nh42so4_hcl     = 1.0_wp
-    nh4no3_hcl      = 1.0_wp
-    nh4cl_hcl       = 1.0_wp
-    na2so4_hcl      = 1.0_wp
-    nano3_hcl       = 1.0_wp
-    nacl_hcl        = 1.0_wp
-    hno3_nh3        = 1.0_wp
-    h2so4_nh3       = 1.0_wp
-    nh42so4_nh3     = 1.0_wp
-    nh4no3_nh3      = 1.0_wp
-    nh4cl_nh3       = 1.0_wp
-    na2so4_nh3      = 1.0_wp
-    nano3_nh3       = 1.0_wp
-    nacl_nh3        = 1.0_wp
-    hno3_hhso4      = 1.0_wp
-    hcl_hhso4       = 1.0_wp
-    nh42so4_hhso4   = 1.0_wp
-    nh4no3_hhso4    = 1.0_wp
-    nh4cl_hhso4     = 1.0_wp
-    na2so4_hhso4    = 1.0_wp
-    nano3_hhso4     = 1.0_wp
-    nacl_hhso4      = 1.0_wp
-    hno3_h2so4      = 1.0_wp
-    hcl_h2so4       = 1.0_wp
-    nh42so4_h2so4   = 1.0_wp
-    nh4no3_h2so4    = 1.0_wp
-    nh4cl_h2so4     = 1.0_wp
-    na2so4_h2so4    = 1.0_wp
-    nano3_h2so4     = 1.0_wp
-    nacl_h2so4      = 1.0_wp
-!
-!-- New NH3 variables
-    hno3_nh4hso4    = 1.0_wp
-    hcl_nh4hso4     = 1.0_wp
-    h2so4_nh4hso4   = 1.0_wp
-    nh42so4_nh4hso4 = 1.0_wp
-    nh4no3_nh4hso4  = 1.0_wp
-    nh4cl_nh4hso4   = 1.0_wp
-    na2so4_nh4hso4  = 1.0_wp
-    nano3_nh4hso4   = 1.0_wp
-    nacl_nh4hso4    = 1.0_wp
-!
-!-- Juha Tonttila added
-    mols_out   = 0.0_wp
-    press_hno3 = 0.0_wp  !< Initialising vapour pressures over the
-    press_hcl  = 0.0_wp  !< multicomponent particle
-    press_nh3  = 0.0_wp
-    gamma_out  = 1.0_wp  !< i.e. don't alter the ideal mixing ratios if there's nothing there.
-!
-!-- 1) - COMPOSITION DEFINITIONS
-!
-!-- a) Inorganic ion pairing:
-!-- In order to calculate the water content, which is also used in calculating vapour pressures, one
-!-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by
-!-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts
-!-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl,
-!-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute.
-!-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl-
-!
-    charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7)
-    nitric_acid       = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum
-    hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum
-    sulphuric_acid    = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum
-    ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum
-    ammonium_nitrate  = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum
-    ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum
-    sodium_sulphate   = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum
-    sodium_nitrate    = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum
-    sodium_chloride   = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum
-    solutes = 0.0_wp
-    solutes = 3.0_wp * sulphuric_acid    + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid +     &
-              3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +&
-              3.0_wp * sodium_sulphate   + 2.0_wp * sodium_nitrate   + 2.0_wp * sodium_chloride
-!
-!-- b) Inorganic equivalent fractions:
-!-- These values are calculated so that activity coefficients can be expressed by a linear additive
-!-- rule, thus allowing more efficient calculations and future expansion (see more detailed
-!-- description below)
-    nitric_acid_eq_frac       = 2.0_wp * nitric_acid / solutes
-    hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes
-    sulphuric_acid_eq_frac    = 3.0_wp * sulphuric_acid / solutes
-    ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes
-    ammonium_nitrate_eq_frac  = 2.0_wp * ammonium_nitrate / solutes
-    ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes
-    sodium_sulphate_eq_frac   = 3.0_wp * sodium_sulphate / solutes
-    sodium_nitrate_eq_frac    = 2.0_wp * sodium_nitrate / solutes
-    sodium_chloride_eq_frac   = 2.0_wp * sodium_chloride / solutes
-!
-!-- Inorganic ion molalities
-    ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp )   ! H+
-    ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp )   ! NH4+
-    ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp )   ! Na+
-    ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp )   ! SO4(2-)
-    ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp )   ! HSO4(2-)
-    ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp )   !  NO3-
-    ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp )   ! Cl-
-
-!-- ***
-!-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value
-!-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by
-!-- Zaveri et al. 2005
-!
-!-- 2) - WATER CALCULATION
-!
-!-- a) The water content is calculated using the ZSR rule with solute concentrations calculated
-!-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or
-!-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic
-!-- equations for the water associated with each solute listed above. Binary water contents for
-!-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated
-!-- with the organic compound is calculated assuming ideality and that aw = RH.
-!
-!-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in
-!-- vapour pressure calculation.
-!
-!-- 3) - BISULPHATE ION DISSOCIATION CALCULATION
-!
-!-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium
-!-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated
-!-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of
-!-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as
-!-- described in 4) below, where both activity coefficients were fit to the output from ADDEM
-!-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity
-!-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and
-!-- relative humidity.
-!
-!-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are
-!-- used for simplification of the fit expressions when using limited composition regions. This
-!-- section of code calculates the bisulphate ion concentration.
-!
-    IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN
-!
-!--    HHSO4:
-       binary_case = 1
-       IF ( rh > 0.1_wp  .AND.  rh < 0.9_wp )  THEN
-          binary_hhso4 = -4.9521_wp * rh**3 + 9.2881_wp * rh**2 - 10.777_wp * rh + 6.0534_wp
-       ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.955_wp )  THEN
-          binary_hhso4 = -6.3777_wp * rh + 5.962_wp
-       ELSEIF ( rh >= 0.955_wp  .AND.  rh < 0.99_wp )  THEN
-          binary_hhso4 = 2367.2_wp * rh**3 - 6849.7_wp * rh**2 + 6600.9_wp * rh - 2118.7_wp
-       ELSEIF ( rh >= 0.99_wp  .AND.  rh < 0.9999_wp )  THEN
-          binary_hhso4 = 3E-7_wp * rh**5 - 2E-5_wp * rh**4 + 0.0004_wp * rh**3 - 0.0035_wp * rh**2 &
-                         + 0.0123_wp * rh - 0.3025_wp
-       ENDIF
-
-       IF ( nitric_acid > 0.0_wp )  THEN
-          hno3_hhso4 = -4.2204_wp * rh**4 + 12.193_wp * rh**3 - 12.481_wp * rh**2 + 6.459_wp * rh  &
-                       - 1.9004_wp
-       ENDIF
-
-       IF ( hydrochloric_acid > 0.0_wp )  THEN
-          hcl_hhso4 = -54.845_wp * rh**7 + 209.54_wp * rh**6 - 336.59_wp * rh**5 + 294.21_wp *     &
-                      rh**4 - 150.07_wp * rh**3 + 43.767_wp * rh**2 - 6.5495_wp * rh + 0.60048_wp
-       ENDIF
-
-       IF ( ammonium_sulphate > 0.0_wp )  THEN
-          nh42so4_hhso4 = 16.768_wp * rh**3 - 28.75_wp * rh**2 + 20.011_wp * rh - 8.3206_wp
-       ENDIF
-
-       IF ( ammonium_nitrate > 0.0_wp )  THEN
-          nh4no3_hhso4 = -17.184_wp * rh**4 + 56.834_wp * rh**3 - 65.765_wp * rh**2 +              &
-                         35.321_wp * rh - 9.252_wp
-       ENDIF
-
-       IF (ammonium_chloride > 0.0_wp )  THEN
-          IF ( rh < 0.2_wp .AND. rh >= 0.1_wp )  THEN
-             nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp
-          ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp )  THEN
-             nh4cl_hhso4 = -1.2981_wp * rh**3 + 4.7461_wp * rh**2 - 2.3269_wp * rh - 1.1259_wp
-          ENDIF
-       ENDIF
-
-       IF ( sodium_sulphate > 0.0_wp )  THEN
-          na2so4_hhso4 = 118.87_wp * rh**6 - 358.63_wp * rh**5 + 435.85_wp * rh**4 - 272.88_wp *   &
-                         rh**3 + 94.411_wp * rh**2 - 18.21_wp * rh + 0.45935_wp
-       ENDIF
-
-       IF ( sodium_nitrate > 0.0_wp )  THEN
-          IF ( rh < 0.2_wp  .AND.  rh >= 0.1_wp )  THEN
-             nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp
-          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.99_wp )  THEN
-             nano3_hhso4 = 0.5964_wp * rh**3 - 0.38967_wp * rh**2 + 1.7918_wp * rh - 1.9691_wp
-          ENDIF
-       ENDIF
-
-       IF ( sodium_chloride > 0.0_wp )  THEN
-          IF ( rh < 0.2_wp )  THEN
-             nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp
-          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.99_wp )  THEN
-             nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp
-          ENDIF
-       ENDIF
-
-       ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 +                            &
-                      hydrochloric_acid_eq_frac * hcl_hhso4 +                                      &
-                      ammonium_sulphate_eq_frac * nh42so4_hhso4 +                                  &
-                      ammonium_nitrate_eq_frac  * nh4no3_hhso4 +                                   &
-                      ammonium_chloride_eq_frac * nh4cl_hhso4 +                                    &
-                      sodium_sulphate_eq_frac   * na2so4_hhso4 +                                   &
-                      sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac   * nacl_hhso4
-
-       gamma_hhso4 = EXP( ln_hhso4_act )   ! molal activity coefficient of HHSO4
-
-!--    H2SO4 (sulphuric acid):
-       IF ( rh >= 0.1_wp  .AND.  rh < 0.9_wp )  THEN
-          binary_h2so4 = 2.4493_wp * rh**2 - 6.2326_wp * rh + 2.1763_wp
-       ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.98 )  THEN
-          binary_h2so4 = 914.68_wp * rh**3 - 2502.3_wp * rh**2 + 2281.9_wp * rh - 695.11_wp
-       ELSEIF ( rh >= 0.98  .AND.  rh < 0.9999 )  THEN
-          binary_h2so4 = 3.0E-8_wp * rh**4 - 5E-6_wp * rh**3 + 0.0003_wp * rh**2 - 0.0022_wp *     &
-                         rh - 1.1305_wp
-       ENDIF
-
-       IF ( nitric_acid > 0.0_wp )  THEN
-          hno3_h2so4 = - 16.382_wp * rh**5 + 46.677_wp * rh**4 - 54.149_wp * rh**3 + 34.36_wp *    &
-                         rh**2 - 12.54_wp * rh + 2.1368_wp
-       ENDIF
-
-       IF ( hydrochloric_acid > 0.0_wp )  THEN
-          hcl_h2so4 = - 14.409_wp * rh**5 + 42.804_wp * rh**4 - 47.24_wp * rh**3 + 24.668_wp *     &
-                        rh**2 - 5.8015_wp * rh + 0.084627_wp
-       ENDIF
-
-       IF ( ammonium_sulphate > 0.0_wp )  THEN
-          nh42so4_h2so4 = 66.71_wp * rh**5 - 187.5_wp * rh**4 + 210.57_wp * rh**3 - 121.04_wp *    &
-                          rh**2 + 39.182_wp * rh - 8.0606_wp
-       ENDIF
-
-       IF ( ammonium_nitrate > 0.0_wp )  THEN
-          nh4no3_h2so4 = - 22.532_wp * rh**4 + 66.615_wp * rh**3 - 74.647_wp * rh**2 + 37.638_wp * &
-                         rh - 6.9711_wp
-       ENDIF
-
-       IF ( ammonium_chloride > 0.0_wp )  THEN
-          IF ( rh >= 0.1_wp  .AND.  rh < 0.2_wp )  THEN
-             nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp
-          ELSEIF ( rh >= 0.2_wp  .AND.  rh < 0.9_wp )  THEN
-             nh4cl_h2so4 = 18.089_wp * rh**5 - 51.083_wp * rh**4 + 50.32_wp * rh**3 - 17.012_wp *  &
-                           rh**2 - 0.93435_wp * rh + 1.0548_wp
-          ELSEIF ( rh >= 0.9_wp  .AND.  rh < 0.99_wp )  THEN
-             nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp
-          ENDIF
-       ENDIF
-
-       IF ( sodium_sulphate > 0.0_wp )  THEN
-          na2so4_h2so4 = 29.843_wp * rh**4 - 69.417_wp * rh**3 + 61.507_wp * rh**2 - 29.874_wp *   &
-                         rh + 7.7556_wp
-       ENDIF
-
-       IF ( sodium_nitrate > 0.0_wp )  THEN
-          nano3_h2so4 = - 122.37_wp * rh**6 + 427.43_wp * rh**5 - 604.68_wp * rh**4 + 443.08_wp *  &
-                        rh**3 - 178.61_wp * rh**2 + 37.242_wp * rh - 1.9564_wp
-       ENDIF
-
-       IF ( sodium_chloride > 0.0_wp )  THEN
-          nacl_h2so4 = - 40.288_wp * rh**5 + 115.61_wp * rh**4 - 129.99_wp * rh**3 + 72.652_wp *   &
-                       rh**2 - 22.124_wp * rh + 4.2676_wp
-       ENDIF
-
-       ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 +                            &
-                      hydrochloric_acid_eq_frac * hcl_h2so4 +                                      &
-                      ammonium_sulphate_eq_frac * nh42so4_h2so4 +                                  &
-                      ammonium_nitrate_eq_frac  * nh4no3_h2so4 +                                   &
-                      ammonium_chloride_eq_frac * nh4cl_h2so4 +                                    &
-                      sodium_sulphate_eq_frac * na2so4_h2so4 +                                     &
-                      sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4
-
-       gamma_h2so4 = EXP( ln_h2so4_act )    ! molal activity coefficient
-!
-!--    Export activity coefficients
-       IF ( gamma_h2so4 > 1.0E-10_wp )  THEN
-          gamma_out(4) = gamma_hhso4**2 / gamma_h2so4
-       ENDIF
-       IF ( gamma_hhso4 > 1.0E-10_wp )  THEN
-          gamma_out(5) = gamma_h2so4**3 / gamma_hhso4**2
-       ENDIF
-!
-!--    Ionic activity coefficient product
-       act_product = gamma_h2so4**3 / gamma_hhso4**2
-!
-!--    Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0)
-       a = 1.0_wp
-       b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) /                        &
-           ( 99.0_wp * act_product ) ) )
-       c = ions(4) * ions(1)
-       root1 = ( ( -1.0_wp * b ) + ( ( ( b**2 ) - 4.0_wp * a * c )**0.5_wp ) ) / ( 2.0_wp * a )
-       root2 = ( ( -1.0_wp * b ) - ( ( ( b**2 ) - 4.0_wp * a * c) **0.5_wp ) ) / ( 2.0_wp * a )
-
-       IF ( root1 > ions(1)  .OR.  root1 < 0.0_wp )  THEN
-          root1 = 0.0_wp
-       ENDIF
-
-       IF ( root2 > ions(1)  .OR.  root2 < 0.0_wp )  THEN
-          root2 = 0.0_wp
-       ENDIF
-!
-!--    Calculate the new hydrogen ion, bisulphate ion and sulphate ion
-!--    concentration
-       h_real    = ions(1)
-       so4_real  = ions(4)
-       hso4_real = MAX( root1, root2 )
-       h_real   = ions(1) - hso4_real
-       so4_real = ions(4) - hso4_real
-!
-!--    Recalculate ion molalities
-       ions_mol(1) = h_real    / ( water_total * 18.01528E-3_wp )   ! H+
-       ions_mol(4) = so4_real  / ( water_total * 18.01528E-3_wp )   ! SO4(2-)
-       ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp )   ! HSO4(2-)
-
-       h_out    = h_real
-       hso4_out = hso4_real
-       so4_out  = so4_real
-
-    ELSE
-       h_out    = ions(1)
-       hso4_out = 0.0_wp
-       so4_out  = ions(4)
-    ENDIF
-
-!
-!-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3
-!
-!-- This section evaluates activity coefficients and vapour pressures using the water content
-!-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL.
-!-- The following procedure is used: Zaveri et al (2005) found that one could express the variation
-!-- of activity coefficients linearly in log-space if equivalent mole fractions were used.
-!-- So, by a taylor series expansion LOG( activity coefficient ) =
-!--    LOG( binary activity coefficient at a given RH ) +
-!--    (equivalent mole fraction compound A) *
-!--    ('interaction' parameter between A and condensing species) +
-!--    equivalent mole fraction compound B) *
-!--    ('interaction' parameter between B and condensing species).
-!-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space
-!-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm.
-!
-!-- They are given as a function of RH and vary with complexity ranging from linear to 5th order
-!-- polynomial expressions, the binary activity coefficients were calculated using AIM online.
-!-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the
-!-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are
-!-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants
-!-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed
-!-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit
-!-- the 'interaction' parameters explicitly to a general inorganic equilibrium model
-!-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation
-!-- and water content. This also allows us to consider one regime for all composition space, rather
-!-- than defining sulphate rich and sulphate poor regimes.
-!-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are
-!-- used for simplification of the fit expressions when using limited composition regions.
-!
-!-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3
-    IF ( ions(1) > 0.0_wp  .AND.  ions(6) > 0.0_wp )  THEN
-       binary_case = 1
-       IF ( rh > 0.1_wp  .AND.  rh < 0.98_wp )  THEN
-          IF ( binary_case == 1 )  THEN
-             binary_hno3 = 1.8514_wp * rh**3 - 4.6991_wp * rh**2 + 1.5514_wp * rh + 0.90236_wp
-          ELSEIF ( binary_case == 2 )  THEN
-             binary_hno3 = - 1.1751_wp * ( rh**2 ) - 0.53794_wp * rh + 1.2808_wp
-          ENDIF
-       ELSEIF ( rh >= 0.98_wp  .AND.  rh < 0.9999_wp )  THEN
-          binary_hno3 = 1244.69635941351_wp * rh**3 - 2613.93941099991_wp * rh**2 +                &
-                        1525.0684974546_wp * rh -155.946764059316_wp
-       ENDIF
-!
-!--    Contributions from other solutes
-       full_complexity = 1
-       IF ( hydrochloric_acid > 0.0_wp )  THEN   ! HCL
-          IF ( full_complexity == 1  .OR.  rh < 0.4_wp )  THEN
-             hcl_hno3 = 16.051_wp * rh**4 - 44.357_wp * rh**3 + 45.141_wp * rh**2 - 21.638_wp *    &
-                        rh + 4.8182_wp
-          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
-             hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp
-          ENDIF
-       ENDIF
-
-       IF ( sulphuric_acid > 0.0_wp )  THEN   ! H2SO4
-          IF ( full_complexity == 1  .OR.  rh < 0.4_wp )  THEN
-             h2so4_hno3 = - 3.0849_wp * rh**3 + 5.9609_wp * rh**2 - 4.468_wp * rh + 1.5658_wp
-          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
-             h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp
-          ENDIF
-       ENDIF
-
-       IF ( ammonium_sulphate > 0.0_wp )  THEN   ! NH42SO4
-          nh42so4_hno3 = 16.821_wp * rh**3 - 28.391_wp * rh**2 + 18.133_wp * rh - 6.7356_wp
-       ENDIF
-
-       IF ( ammonium_nitrate > 0.0_wp )  THEN   ! NH4NO3
-          nh4no3_hno3 = 11.01_wp * rh**3 - 21.578_wp * rh**2 + 14.808_wp * rh - 4.2593_wp
-       ENDIF
-
-       IF ( ammonium_chloride > 0.0_wp )  THEN   ! NH4Cl
-          IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
-             nh4cl_hno3 = - 1.176_wp * rh**3 + 5.0828_wp * rh**2 - 3.8792_wp * rh - 0.05518_wp
-          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
-             nh4cl_hno3 = 2.6219_wp * rh**2 - 2.2609_wp * rh - 0.38436_wp
-          ENDIF
-       ENDIF
-
-       IF ( sodium_sulphate > 0.0_wp )  THEN   ! Na2SO4
-          na2so4_hno3 = 35.504_wp * rh**4 - 80.101_wp * rh**3 + 67.326_wp * rh**2 - 28.461_wp *    &
-                        rh + 5.6016_wp
-       ENDIF
-
-       IF ( sodium_nitrate > 0.0_wp )  THEN   ! NaNO3
-          IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN
-             nano3_hno3 = 23.659_wp * rh**5 - 66.917_wp * rh**4 + 74.686_wp * rh**3 - 40.795_wp *  &
-                          rh**2 + 10.831_wp * rh - 1.4701_wp
-          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
-             nano3_hno3 = 14.749_wp * rh**4 - 35.237_wp * rh**3 + 31.196_wp * rh**2 - 12.076_wp *  &
-                          rh + 1.3605_wp
-          ENDIF
-       ENDIF
-
-       IF ( sodium_chloride > 0.0_wp )  THEN   ! NaCl
-          IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
-             nacl_hno3 = 13.682_wp * rh**4 - 35.122_wp * rh**3 + 33.397_wp * rh**2 - 14.586_wp *   &
-                         rh + 2.6276_wp
-          ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
-             nacl_hno3 = 1.1882_wp * rh**3 - 1.1037_wp * rh**2 - 0.7642_wp * rh + 0.6671_wp
-          ENDIF
-       ENDIF
-
-       ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 +                          &
-                     sulphuric_acid_eq_frac    * h2so4_hno3 +                                      &
-                     ammonium_sulphate_eq_frac * nh42so4_hno3 +                                    &
-                     ammonium_nitrate_eq_frac  * nh4no3_hno3 +                                     &
-                     ammonium_chloride_eq_frac * nh4cl_hno3 +                                      &
-                     sodium_sulphate_eq_frac * na2so4_hno3 +                                       &
-                     sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac   * nacl_hno3
-
-       gamma_hno3   = EXP( ln_hno3_act )   ! Molal activity coefficient of HNO3
-       gamma_out(1) = gamma_hno3
-!
-!--    Partial pressure calculation
-!--    k_hno3 = 2.51 * ( 10**6 )
-!--    k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984)
-       k_hno3     = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep )
-       press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3
-    ENDIF
-!
-!-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3
-!-- Follow the two solute approach of Zaveri et al. (2005)
-    IF ( ions(2) > 0.0_wp  .AND.  ions_mol(1) > 0.0_wp )  THEN
-!
-!--    NH4HSO4:
-       binary_nh4hso4 = 56.907_wp * rh**6 - 155.32_wp * rh**5 + 142.94_wp * rh**4 - 32.298_wp *    &
-                        rh**3 - 27.936_wp * rh**2 + 19.502_wp * rh - 4.2618_wp
-       IF ( nitric_acid > 0.0_wp)  THEN   ! HNO3
-          hno3_nh4hso4 = 104.8369_wp * rh**8 - 288.8923_wp * rh**7 + 129.3445_wp * rh**6 +         &
-                         373.0471_wp * rh**5 - 571.0385_wp * rh**4 + 326.3528_wp * rh**3 -         &
-                         74.169_wp * rh**2 - 2.4999_wp * rh + 3.17_wp
-       ENDIF
-
-       IF ( hydrochloric_acid > 0.0_wp)  THEN   ! HCL
-          hcl_nh4hso4 = - 7.9133_wp * rh**8 + 126.6648_wp * rh**7 - 460.7425_wp * rh**6 +          &
-                         731.606_wp * rh**5 - 582.7467_wp * rh**4 + 216.7197_wp * rh**3 -          &
-                         11.3934_wp * rh**2 - 17.7728_wp  * rh + 5.75_wp
-       ENDIF
-
-       IF ( sulphuric_acid > 0.0_wp)  THEN   ! H2SO4
-          h2so4_nh4hso4 = 195.981_wp * rh**8 - 779.2067_wp * rh**7 + 1226.3647_wp * rh**6 -        &
-                         964.0261_wp * rh**5 + 391.7911_wp * rh**4 - 84.1409_wp  * rh**3 +         &
-                          20.0602_wp * rh**2 - 10.2663_wp  * rh + 3.5817_wp
-       ENDIF
-
-       IF ( ammonium_sulphate > 0.0_wp)  THEN   ! NH42SO4
-          nh42so4_nh4hso4 = 617.777_wp * rh**8 -  2547.427_wp * rh**7 + 4361.6009_wp * rh**6 -     &
-                           4003.162_wp * rh**5 + 2117.8281_wp * rh**4 - 640.0678_wp * rh**3 +      &
-                            98.0902_wp * rh**2 -    2.2615_wp * rh - 2.3811_wp
-       ENDIF
-
-       IF ( ammonium_nitrate > 0.0_wp)  THEN   ! NH4NO3
-          nh4no3_nh4hso4 = - 104.4504_wp * rh**8 + 539.5921_wp * rh**7 - 1157.0498_wp * rh**6 +    &
-                            1322.4507_wp * rh**5 - 852.2475_wp * rh**4 + 298.3734_wp * rh**3 -     &
-                              47.0309_wp * rh**2 +    1.297_wp * rh - 0.8029_wp
-       ENDIF
-
-       IF ( ammonium_chloride > 0.0_wp)  THEN   ! NH4Cl
-          nh4cl_nh4hso4 = 258.1792_wp * rh**8 - 1019.3777_wp * rh**7 + 1592.8918_wp * rh**6 -      &
-                         1221.0726_wp * rh**5 +  442.2548_wp * rh**4 -   43.6278_wp * rh**3 -      &
-                            7.5282_wp * rh**2 -    3.8459_wp * rh + 2.2728_wp
-       ENDIF
-
-       IF ( sodium_sulphate > 0.0_wp)  THEN   ! Na2SO4
-          na2so4_nh4hso4 = 225.4238_wp * rh**8 - 732.4113_wp * rh**7 + 843.7291_wp * rh**6 -       &
-                           322.7328_wp * rh**5 -  88.6252_wp * rh**4 +  72.4434_wp * rh**3 +       &
-                            22.9252_wp * rh**2 -  25.3954_wp * rh + 4.6971_wp
-       ENDIF
-
-       IF ( sodium_nitrate > 0.0_wp)  THEN   ! NaNO3
-          nano3_nh4hso4 = 96.1348_wp * rh**8 - 341.6738_wp * rh**7 + 406.5314_wp * rh**6 -         &
-                          98.5777_wp * rh**5 - 172.8286_wp * rh**4 + 149.3151_wp * rh**3 -         &
-                          38.9998_wp * rh**2 -   0.2251_wp * rh + 0.4953_wp
-       ENDIF
-
-       IF ( sodium_chloride > 0.0_wp)  THEN   ! NaCl
-          nacl_nh4hso4 = 91.7856_wp * rh**8 - 316.6773_wp * rh**7 + 358.2703_wp * rh**6 -          &
-                         68.9142_wp * rh**5 - 156.5031_wp * rh**4 + 116.9592_wp * rh**3 -          &
-                         22.5271_wp * rh**2 - 3.7716_wp * rh + 1.56_wp
-       ENDIF
-
-       ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 +                      &
-                        hydrochloric_acid_eq_frac * hcl_nh4hso4 +                                  &
-                        sulphuric_acid_eq_frac * h2so4_nh4hso4 +                                   &
-                        ammonium_sulphate_eq_frac * nh42so4_nh4hso4 +                              &
-                        ammonium_nitrate_eq_frac * nh4no3_nh4hso4 +                                &
-                        ammonium_chloride_eq_frac * nh4cl_nh4hso4 +                                &
-                        sodium_sulphate_eq_frac * na2so4_nh4hso4 +                                 &
-                        sodium_nitrate_eq_frac * nano3_nh4hso4 +                                   &
-                        sodium_chloride_eq_frac * nacl_nh4hso4
-
-       gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4
-!
-!--    Molal activity coefficient of NO3-
-       gamma_out(6)  = gamma_nh4hso4
-!
-!--    Molal activity coefficient of NH4+
-       gamma_nh3     = gamma_nh4hso4**2 / gamma_hhso4**2
-       gamma_out(3)  = gamma_nh3
-!
-!--    This actually represents the ratio of the ammonium to hydrogen ion activity coefficients
-!--    (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and
-!--    the ratio of appropriate equilibrium constants
-!
-!--    Equilibrium constants
-!--    k_h = 57.64d0    ! Zaveri et al. (2005)
-       k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep )   ! after Chameides (1984)
-!--    k_nh4 = 1.81E-5_wp    ! Zaveri et al. (2005)
-       k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep )   ! Chameides (1984)
-!--    k_h2o = 1.01E-14_wp    ! Zaveri et al (2005)
-       k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep )   ! Chameides (1984)
-!
-       molality_ratio_nh3 = ions_mol(2) / ions_mol(1)
-!
-!--    Partial pressure calculation
-       press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) )
-
-    ENDIF
-!
-!-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL
-    IF ( ions(1) > 0.0_wp  .AND.  ions(7) > 0.0_wp )  THEN
-       binary_case = 1
-       IF ( rh > 0.1_wp  .AND.  rh < 0.98 )  THEN
-          IF ( binary_case == 1 )  THEN
-             binary_hcl = - 5.0179_wp * rh**3 + 9.8816_wp * rh**2 - 10.789_wp * rh + 5.4737_wp
-          ELSEIF ( binary_case == 2 )  THEN
-             binary_hcl = - 4.6221_wp * rh + 4.2633_wp
-          ENDIF
-       ELSEIF ( rh >= 0.98_wp  .AND.  rh < 0.9999_wp )  THEN
-          binary_hcl = 775.6111008626_wp * rh**3 - 2146.01320888771_wp * rh**2 +                   &
-                       1969.01979670259_wp *  rh - 598.878230033926_wp
-       ENDIF
-    ENDIF
-
-    IF ( nitric_acid > 0.0_wp )  THEN   ! HNO3
-       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
-          hno3_hcl = 9.6256_wp * rh**4 - 26.507_wp * rh**3 + 27.622_wp * rh**2 - 12.958_wp * rh +  &
-                     2.2193_wp
-       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
-          hno3_hcl = 1.3242_wp * rh**2 - 1.8827_wp * rh + 0.55706_wp
-       ENDIF
-    ENDIF
-
-    IF ( sulphuric_acid > 0.0_wp )  THEN   ! H2SO4
-       IF ( full_complexity == 1  .OR.  rh <= 0.4 )  THEN
-          h2so4_hcl = 1.4406_wp * rh**3 - 2.7132_wp * rh**2 + 1.014_wp * rh + 0.25226_wp
-       ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN
-          h2so4_hcl = 0.30993_wp * rh**2 - 0.99171_wp * rh + 0.66913_wp
-       ENDIF
-    ENDIF
-
-    IF ( ammonium_sulphate > 0.0_wp )  THEN   ! NH42SO4
-       nh42so4_hcl = 22.071_wp * rh**3 - 40.678_wp * rh**2 + 27.893_wp * rh - 9.4338_wp
-    ENDIF
-
-    IF ( ammonium_nitrate > 0.0_wp )  THEN   ! NH4NO3
-       nh4no3_hcl = 19.935_wp * rh**3 - 42.335_wp * rh**2 + 31.275_wp * rh - 8.8675_wp
-    ENDIF
-
-    IF ( ammonium_chloride > 0.0_wp )  THEN   ! NH4Cl
-       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
-          nh4cl_hcl = 2.8048_wp * rh**3 - 4.3182_wp * rh**2 + 3.1971_wp * rh - 1.6824_wp
-       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
-          nh4cl_hcl = 1.2304_wp * rh**2 - 0.18262_wp * rh - 1.0643_wp
-       ENDIF
-    ENDIF
-
-    IF ( sodium_sulphate > 0.0_wp )  THEN   ! Na2SO4
-       na2so4_hcl = 36.104_wp * rh**4 - 78.658_wp * rh**3 + 63.441_wp * rh**2 - 26.727_wp * rh +   &
-                    5.7007_wp
-    ENDIF
-
-    IF ( sodium_nitrate > 0.0_wp )  THEN   ! NaNO3
-       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
-          nano3_hcl = 54.471_wp * rh**5 - 159.42_wp * rh**4 + 180.25_wp * rh**3 - 98.176_wp * rh**2&
-                      + 25.309_wp * rh - 2.4275_wp
-       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
-          nano3_hcl = 21.632_wp * rh**4 - 53.088_wp * rh**3 + 47.285_wp * rh**2 - 18.519_wp * rh   &
-                      + 2.6846_wp
-       ENDIF
-    ENDIF
-
-    IF ( sodium_chloride > 0.0_wp )  THEN   ! NaCl
-       IF ( full_complexity == 1  .OR.  rh <= 0.4_wp )  THEN
-          nacl_hcl = 5.4138_wp * rh**4 - 12.079_wp * rh**3 + 9.627_wp * rh**2 - 3.3164_wp * rh +   &
-                     0.35224_wp
-       ELSEIF ( full_complexity == 0  .AND.  rh > 0.4_wp )  THEN
-          nacl_hcl = 2.432_wp * rh**3 - 4.3453_wp * rh**2 + 2.3834_wp * rh - 0.4762_wp
-       ENDIF
-    ENDIF
-
-    ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +&
-                 ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + &
-                 ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl +    &
-                 sodium_nitrate_eq_frac    * nano3_hcl + sodium_chloride_eq_frac   * nacl_hcl
-
-     gamma_hcl    = EXP( ln_HCL_act )   ! Molal activity coefficient
-     gamma_out(2) = gamma_hcl
-!
-!--  Equilibrium constant after Wagman et al. (1982) (and NIST database)
-     k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep )
-
-     press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl
-!
-!-- 5) Ion molility output
-    mols_out = ions_mol
-
- END SUBROUTINE inorganic_pdfite
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Update the particle size distribution. Put particles into corrects bins.
-!>
-!> Moving-centre method assumed, i.e. particles are allowed to grow to their
-!> exact size as long as they are not crossing the fixed diameter bin limits.
-!> If the particles in a size bin cross the lower or upper diameter limit, they
-!> are all moved to the adjacent diameter bin and their volume is averaged with
-!> the particles in the new bin, which then get a new diameter.
-!
-!> Moving-centre method minimises numerical diffusion.
-!------------------------------------------------------------------------------!
- SUBROUTINE distr_update( paero )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib      !< loop index
-    INTEGER(iwp) ::  mm      !< loop index
-    INTEGER(iwp) ::  counti  !< number of while loops
-
-    LOGICAL  ::  within_bins !< logical (particle belongs to the bin?)
-
-    REAL(wp) ::  znfrac  !< number fraction to be moved to the larger bin
-    REAL(wp) ::  zvfrac  !< volume fraction to be moved to the larger bin
-    REAL(wp) ::  zvexc   !< Volume in the grown bin which exceeds the bin upper limit
-    REAL(wp) ::  zvihi   !< particle volume at the high end of the bin
-    REAL(wp) ::  zvilo   !< particle volume at the low end of the bin
-    REAL(wp) ::  zvpart  !< particle volume (m3)
-    REAL(wp) ::  zvrat   !< volume ratio of a size bin
-
-    real(wp), dimension(nbins_aerosol) ::  dummy
-
-    TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) ::  paero !< aerosol properties
-
-    zvpart      = 0.0_wp
-    zvfrac      = 0.0_wp
-    within_bins = .FALSE.
-
-    dummy = paero(:)%numc
-!
-!-- Check if the volume of the bin is within bin limits after update
-    counti = 0
-    DO  WHILE ( .NOT. within_bins )
-       within_bins = .TRUE.
-!
-!--    Loop from larger to smaller size bins
-       DO  ib = end_subrange_2b-1, start_subrange_1a, -1
-          mm = 0
-          IF ( paero(ib)%numc > nclim )  THEN
-             zvpart = 0.0_wp
-             zvfrac = 0.0_wp
-
-             IF ( ib == end_subrange_2a )  CYCLE
-!
-!--          Dry volume
-             zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc
-!
-!--          Smallest bin cannot decrease
-             IF ( paero(ib)%vlolim > zvpart  .AND.  ib == start_subrange_1a ) CYCLE
-!
-!--          Decreasing bins
-             IF ( paero(ib)%vlolim > zvpart )  THEN
-                mm = ib - 1
-                IF ( ib == start_subrange_2b )  mm = end_subrange_1a    ! 2b goes to 1a
-
-                paero(mm)%numc = paero(mm)%numc + paero(ib)%numc
-                paero(ib)%numc = 0.0_wp
-                paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:)
-                paero(ib)%volc(:) = 0.0_wp
-                CYCLE
-             ENDIF
-!
-!--          If size bin has not grown, cycle.
-!--          Changed by Mona: compare to the arithmetic mean volume, as done originally. Now
-!--          particle volume is derived from the geometric mean diameter, not arithmetic (see
-!--          SUBROUTINE set_sizebins).
-             IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) &
-             CYCLE
-!
-!--          Avoid precision problems
-             IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp )  CYCLE
-!
-!--          Volume ratio of the size bin
-             zvrat = paero(ib)%vhilim / paero(ib)%vlolim
-!
-!--          Particle volume at the low end of the bin
-             zvilo = 2.0_wp * zvpart / ( 1.0_wp + zvrat )
-!
-!--          Particle volume at the high end of the bin
-             zvihi = zvrat * zvilo
-!
-!--          Volume in the grown bin which exceeds the bin upper limit
-             zvexc = 0.5_wp * ( zvihi + paero(ib)%vhilim )
-!
-!--          Number fraction to be moved to the larger bin
-             znfrac = MIN( 1.0_wp, ( zvihi - paero(ib)%vhilim) / ( zvihi - zvilo ) )
-!
-!--          Volume fraction to be moved to the larger bin
-             zvfrac = MIN( 0.99_wp, znfrac * zvexc / zvpart )
-             IF ( zvfrac < 0.0_wp )  THEN
-                message_string = 'Error: zvfrac < 0'
-                CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 )
-             ENDIF
-!
-!--          Update bin
-             mm = ib + 1
-!
-!--          Volume (cm3/cm3)
-             paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zvexc *             &
-                                 paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
-             paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zvexc *             &
-                                 paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) )
-
-!--          Number concentration (#/m3)
-             paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc
-             paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac )
-
-          ENDIF     ! nclim
-
-          IF ( paero(ib)%numc > nclim )   THEN
-             zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc  ! Note: dry volume!
-             within_bins = ( paero(ib)%vlolim < zvpart  .AND. zvpart < paero(ib)%vhilim )
-          ENDIF
-
-       ENDDO ! - ib
-
-       counti = counti + 1
-       IF ( counti > 100 )  THEN
-          message_string = 'Error: Aerosol bin update not converged'
-          CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDDO ! - within bins
-
- END SUBROUTINE distr_update
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> salsa_diagnostics: Update properties for the current timestep:
-!>
-!> Juha Tonttila, FMI, 2014
-!> Tomi Raatikainen, FMI, 2016
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_diagnostics( i, j )
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point_s
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib   !<
-    INTEGER(iwp) ::  ic   !<
-    INTEGER(iwp) ::  icc  !<
-    INTEGER(iwp) ::  ig   !<
-    INTEGER(iwp) ::  k    !<
-
-    INTEGER(iwp), INTENT(in) ::  i  !<
-    INTEGER(iwp), INTENT(in) ::  j  !<
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flag          !< flag to mask topography
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  flag_zddry    !< flag to mask zddry
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_adn        !< air density (kg/m3)
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_p          !< pressure
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  in_t          !< temperature (K)
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  mcsum         !< sum of mass concentration
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  ppm_to_nconc  !< Conversion factor: ppm to #/m3
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  zddry         !< particle dry diameter
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  zvol          !< particle volume
-
-    flag_zddry   = 0.0_wp
-    in_adn       = 0.0_wp
-    in_p         = 0.0_wp
-    in_t         = 0.0_wp
-    ppm_to_nconc = 1.0_wp
-    zddry        = 0.0_wp
-    zvol         = 0.0_wp
-
-    !$OMP MASTER
-    CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' )
-    !$OMP END MASTER
-
-!
-!-- Calculate thermodynamic quantities needed in SALSA
-    CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn )
-!
-!-- Calculate conversion factors for gas concentrations
-    ppm_to_nconc = for_ppm_to_nconc * in_p / in_t
-!
-!-- Predetermine flag to mask topography
-    flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,j,i), 0 ) )
-
-    DO  ib = 1, nbins_aerosol   ! aerosol size bins
-!
-!--    Remove negative values
-       aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag
-!
-!--    Calculate total mass concentration per bin
-       mcsum = 0.0_wp
-       DO  ic = 1, ncomponents_mass
-          icc = ( ic - 1 ) * nbins_aerosol + ib
-          mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag
-          aerosol_mass(icc)%conc(:,j,i) = MAX( mclim, aerosol_mass(icc)%conc(:,j,i) ) * flag
-       ENDDO
-!
-!--    Check that number and mass concentration match qualitatively
-       IF ( ANY( aerosol_number(ib)%conc(:,j,i) > nclim  .AND. mcsum <= 0.0_wp ) )  THEN
-          DO  k = nzb+1, nzt
-             IF ( aerosol_number(ib)%conc(k,j,i) >= nclim  .AND. mcsum(k) <= 0.0_wp )  THEN
-                aerosol_number(ib)%conc(k,j,i) = nclim * flag(k)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k)
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDIF
-!
-!--    Update aerosol particle radius
-       CALL bin_mixrat( 'dry', ib, i, j, zvol )
-       zvol = zvol / arhoh2so4    ! Why on sulphate?
-!
-!--    Particles smaller then 0.1 nm diameter are set to zero
-       zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp
-       flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp  .AND.                             &
-                           aerosol_number(ib)%conc(:,j,i) > nclim ) )
-!
-!--    Volatile species to the gas phase
-       IF ( index_so4 > 0 .AND. lscndgas )  THEN
-          ic = ( index_so4 - 1 ) * nbins_aerosol + ib
-          IF ( salsa_gases_from_chem )  THEN
-             ig = gas_index_chem(1)
-             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
-                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
-                                            ( amh2so4 * ppm_to_nconc ) * flag
-          ELSE
-             salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
-                                        amh2so4 * avo * flag_zddry * flag
-          ENDIF
-       ENDIF
-       IF ( index_oc > 0  .AND.  lscndgas )  THEN
-          ic = ( index_oc - 1 ) * nbins_aerosol + ib
-          IF ( salsa_gases_from_chem )  THEN
-             ig = gas_index_chem(5)
-             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
-                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
-                                            ( amoc * ppm_to_nconc ) * flag
-          ELSE
-             salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
-                                        amoc * avo * flag_zddry * flag
-          ENDIF
-       ENDIF
-       IF ( index_no > 0  .AND.  lscndgas )  THEN
-          ic = ( index_no - 1 ) * nbins_aerosol + ib
-          IF ( salsa_gases_from_chem )  THEN
-             ig = gas_index_chem(2)
-             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
-                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
-                                            ( amhno3 * ppm_to_nconc ) *flag
-          ELSE
-             salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
-                                        amhno3 * avo * flag_zddry * flag
-          ENDIF
-       ENDIF
-       IF ( index_nh > 0  .AND.  lscndgas )  THEN
-          ic = ( index_nh - 1 ) * nbins_aerosol + ib
-          IF ( salsa_gases_from_chem )  THEN
-             ig = gas_index_chem(3)
-             chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) +                         &
-                                            aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry /      &
-                                            ( amnh3 * ppm_to_nconc ) *flag
-          ELSE
-             salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) /  &
-                                        amnh3 * avo * flag_zddry *flag
-          ENDIF
-       ENDIF
-!
-!--    Mass and number to zero (insoluble species and water are lost)
-       DO  ic = 1, ncomponents_mass
-          icc = ( ic - 1 ) * nbins_aerosol + ib
-          aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i),      &
-                                                 flag_zddry > 0.0_wp )
-       ENDDO
-       aerosol_number(ib)%conc(:,j,i) = MERGE( nclim * flag, aerosol_number(ib)%conc(:,j,i),       &
-                                               flag_zddry > 0.0_wp )
-       ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry )
-
-    ENDDO
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       DO  ig = 1, ngases_salsa
-          salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag
-       ENDDO
-    ENDIF
-
-   !$OMP MASTER
-    CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' )
-   !$OMP END MASTER
-
- END SUBROUTINE salsa_diagnostics
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_actions( location )
-
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-    SELECT CASE ( location )
-
-       CASE ( 'before_timestep' )
-
-          IF ( ws_scheme_sca )  sums_salsa_ws_l = 0.0_wp
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE salsa_actions
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid points i,j
-!------------------------------------------------------------------------------!
-
- SUBROUTINE salsa_actions_ij( i, j, location )
-
-
-    INTEGER(iwp),      INTENT(IN) ::  i         !< grid index in x-direction
-    INTEGER(iwp),      INTENT(IN) ::  j         !< grid index in y-direction
-    CHARACTER (LEN=*), INTENT(IN) ::  location  !< call location string
-    INTEGER(iwp)  ::  dummy  !< call location string
-
-    IF ( salsa    )   dummy = i + j
-
-    SELECT CASE ( location )
-
-       CASE ( 'before_timestep' )
-
-          IF ( ws_scheme_sca )  sums_salsa_ws_l = 0.0_wp
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
-
- END SUBROUTINE salsa_actions_ij
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_non_advective_processes
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point_s
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-
-    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
-       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
-!
-!--       Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
-          CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                CALL salsa_diagnostics( i, j )
-                CALL salsa_driver( i, j, 3 )
-                CALL salsa_diagnostics( i, j )
-             ENDDO
-          ENDDO
-          CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
-       ENDIF
-    ENDIF
-
- END SUBROUTINE salsa_non_advective_processes
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid points i,j
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_non_advective_processes_ij( i, j )
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point_s
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  i  !< grid index in x-direction
-    INTEGER(iwp), INTENT(IN) ::  j  !< grid index in y-direction
-
-    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
-       IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
-!
-!--       Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step.
-          CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' )
-          CALL salsa_diagnostics( i, j )
-          CALL salsa_driver( i, j, 3 )
-          CALL salsa_diagnostics( i, j )
-          CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' )
-       ENDIF
-    ENDIF
-
- END SUBROUTINE salsa_non_advective_processes_ij
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Routine for exchange horiz of salsa variables.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_exchange_horiz_bounds ( location )
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point_s
-
-    USE exchange_horiz_mod,                                                    &
-        ONLY:  exchange_horiz
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib   !<
-    INTEGER(iwp) ::  ic   !<
-    INTEGER(iwp) ::  icc  !<
-    INTEGER(iwp) ::  ig   !<
-
-    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
-
-    SELECT CASE ( location )
-
-       CASE ( 'before_prognostic_equation' )
-
-          IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
-             IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa )  THEN
-
-                CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' )
-!
-!--             Exchange ghost points
-                DO  ib = 1, nbins_aerosol
-                   CALL exchange_horiz( aerosol_number(ib)%conc, nbgp,                             &
-                                        alternative_communicator = communicator_salsa )
-                   DO  ic = 1, ncomponents_mass
-                      icc = ( ic - 1 ) * nbins_aerosol + ib
-                      CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp,                           &
-                                           alternative_communicator = communicator_salsa )
-                   ENDDO
-                ENDDO
-                IF ( .NOT. salsa_gases_from_chem )  THEN
-                   DO  ig = 1, ngases_salsa
-                      CALL exchange_horiz( salsa_gas(ig)%conc, nbgp,                               &
-                                           alternative_communicator = communicator_salsa )
-                   ENDDO
-                ENDIF
-!
-!--             Apply only horizontal boundary conditions
-                CALL salsa_boundary_conditions( horizontal_conditions_only = .TRUE. )
-                CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' )
-!
-!--             Update last_salsa_time
-                last_salsa_time = time_since_reference_point
-             ENDIF
-          ENDIF
-
-       CASE ( 'after_prognostic_equation' )
-
-          IF ( salsa  .AND.  time_since_reference_point >= skip_time_do_salsa )  THEN
-             DO  ib = 1, nbins_aerosol
-                CALL exchange_horiz( aerosol_number(ib)%conc_p, nbgp,                              &
-                                     alternative_communicator = communicator_salsa )
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   CALL exchange_horiz( aerosol_mass(icc)%conc_p, nbgp,                            &
-                                        alternative_communicator = communicator_salsa )
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   CALL exchange_horiz( salsa_gas(ig)%conc_p, nbgp,                                &
-                                        alternative_communicator = communicator_salsa )
-                ENDDO
-             ENDIF
-          ENDIF
-
-       CASE ( 'after_anterpolation' )
-
-          IF ( salsa  .AND. time_since_reference_point >= skip_time_do_salsa )  THEN
-             DO  ib = 1, nbins_aerosol
-                CALL exchange_horiz( aerosol_number(ib)%conc, nbgp,                                &
-                                     alternative_communicator = communicator_salsa )
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp,                              &
-                                        alternative_communicator = communicator_salsa )
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   CALL exchange_horiz( salsa_gas(ig)%conc, nbgp,                                  &
-                                        alternative_communicator = communicator_salsa )
-                ENDDO
-             ENDIF
-          ENDIF
-
-    END SELECT
-
- END SUBROUTINE salsa_exchange_horiz_bounds
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the prognostic equation for aerosol number and mass, and gas
-!> concentrations. Cache-optimized.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i            !<
-    INTEGER(iwp) ::  i_omp_start  !<
-    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
-    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
-    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
-    INTEGER(iwp) ::  ig           !< loop index for salsa gases
-    INTEGER(iwp) ::  j            !<
-    INTEGER(iwp) ::  tn           !<
-
-    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
-!
-!--    Aerosol number
-       DO  ib = 1, nbins_aerosol
-!kk          sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
-          CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
-                               aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib,          &
-                               aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s,               &
-                               aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l,               &
-                               aerosol_number(ib)%init, .TRUE. )
-!kk          aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
-!
-!--       Aerosol mass
-          DO  ic = 1, ncomponents_mass
-             icc = ( ic - 1 ) * nbins_aerosol + ib
-!kk             sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
-             CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
-                                  aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic,        &
-                                  aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s,              &
-                                  aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l,              &
-                                  aerosol_mass(icc)%init, .TRUE. )
-!kk             aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
-
-          ENDDO  ! ic
-       ENDDO  ! ib
-!
-!--    Gases
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-
-          DO  ig = 1, ngases_salsa
-!kk             sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
-             CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc,           &
-                                  salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig,            &
-                                  salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,&
-                                  salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. )
-!kk             salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
-
-          ENDDO  ! ig
-
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE salsa_prognostic_equations_ij
-!
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the prognostic equation for aerosol number and mass, and gas
-!> concentrations. For vector machines.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_prognostic_equations()
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
-    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
-    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
-    INTEGER(iwp) ::  ig           !< loop index for salsa gases
-
-    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
-!
-!--    Aerosol number
-       DO  ib = 1, nbins_aerosol
-          sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l
-          CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,&
-                               aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. )
-          aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l
-!
-!--       Aerosol mass
-          DO  ic = 1, ncomponents_mass
-             icc = ( ic - 1 ) * nbins_aerosol + ib
-             sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l
-             CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,&
-                                  aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. )
-             aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l
-
-          ENDDO  ! ic
-       ENDDO  ! ib
-!
-!--    Gases
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-
-          DO  ig = 1, ngases_salsa
-             sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l
-             CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc,           &
-                                  salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. )
-             salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l
-
-          ENDDO  ! ig
-
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE salsa_prognostic_equations
-!
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Tendencies for aerosol number and mass and gas concentrations.
-!> Cache-optimized.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, &
-                               flux_l, diss_l, rs_init, do_sedimentation )
-
-    USE advec_ws,                                                                                  &
-        ONLY:  advec_s_ws
-
-    USE advec_s_pw_mod,                                                                            &
-        ONLY:  advec_s_pw
-
-    USE advec_s_up_mod,                                                                            &
-        ONLY:  advec_s_up
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, rdf_sc, tend
-
-    USE diffusion_s_mod,                                                                           &
-        ONLY:  diffusion_s
-
-    USE indices,                                                                                   &
-        ONLY:  wall_flags_total_0
-
-    USE surface_mod,                                                                               &
-        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN = *) ::  id  !<
-
-    INTEGER(iwp) ::  i            !<
-    INTEGER(iwp) ::  i_omp_start  !<
-    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
-    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
-    INTEGER(iwp) ::  icc          !< (c-1)*nbins_aerosol+b
-    INTEGER(iwp) ::  j            !<
-    INTEGER(iwp) ::  k            !<
-    INTEGER(iwp) ::  tn           !<
-
-    LOGICAL ::  do_sedimentation  !<
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  rs_init  !<
-
-    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  diss_s  !<
-    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  flux_s  !<
-
-    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  diss_l  !<
-    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  flux_l  !<
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  rs_p    !<
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  rs      !<
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  trs_m   !<
-
-    icc = ( ic - 1 ) * nbins_aerosol + ib
-!
-!-- Tendency-terms for reactive scalar
-    tend(:,j,i) = 0.0_wp
-!
-!-- Advection terms
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_sca )  THEN
-          CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l,       &
-                           i_omp_start, tn, bc_dirichlet_aer_l  .OR.  bc_radiation_aer_l,          &
-                           bc_dirichlet_aer_n  .OR.  bc_radiation_aer_n,                           &
-                           bc_dirichlet_aer_r  .OR.  bc_radiation_aer_r,                           &
-                           bc_dirichlet_aer_s  .OR.  bc_radiation_aer_s, monotonic_limiter_z )
-       ELSE
-          CALL advec_s_pw( i, j, rs )
-       ENDIF
-    ELSE
-       CALL advec_s_up( i, j, rs )
-    ENDIF
-!
-!-- Diffusion terms
-    SELECT CASE ( id )
-       CASE ( 'aerosol_number' )
-          CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib),                                   &
-                                      surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib),        &
-                                      surf_lsm_h(0)%answs(:,ib), surf_lsm_h(1)%answs(:,ib),        &
-                                      surf_usm_h(0)%answs(:,ib), surf_usm_h(1)%answs(:,ib),        &
-                                      surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib),        &
-                                      surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib),        &
-                                      surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib),        &
-                                      surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib),        &
-                                      surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib),        &
-                                      surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
-       CASE ( 'aerosol_mass' )
-          CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc),                                  &
-                                      surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc),      &
-                                      surf_lsm_h(0)%amsws(:,icc), surf_lsm_h(1)%amsws(:,icc),      &
-                                      surf_usm_h(0)%amsws(:,icc), surf_usm_h(1)%amsws(:,icc),      &
-                                      surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc),      &
-                                      surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc),      &
-                                      surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc),      &
-                                      surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc),      &
-                                      surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc),      &
-                                      surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
-       CASE ( 'salsa_gas' )
-          CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib),                                   &
-                                      surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib),        &
-                                      surf_lsm_h(0)%gtsws(:,ib), surf_lsm_h(1)%gtsws(:,ib),        &
-                                      surf_usm_h(0)%gtsws(:,ib), surf_usm_h(1)%gtsws(:,ib),        &
-                                      surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib),        &
-                                      surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib),        &
-                                      surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib),        &
-                                      surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib),        &
-                                      surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib),        &
-                                      surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
-    END SELECT
-!
-!-- Sedimentation and prognostic equation for aerosol number and mass
-    IF ( lsdepo  .AND.  do_sedimentation )  THEN
-!DIR$ IVDEP
-       DO  k = nzb+1, nzt
-          tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) -          &
-                                                     rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) )  &
-                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 0 ) )
-          rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )     &
-                                      - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )          &
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-          IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
-       ENDDO
-    ELSE
-!
-!--    Prognostic equation
-!DIR$ IVDEP
-       DO  k = nzb+1, nzt
-          rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )     &
-                                                - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )&
-                                  * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-          IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(k,j,i)
-       ENDDO
-    ENDIF
-!
-!-- Calculate tendencies for the next Runge-Kutta step
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( intermediate_timestep_count == 1 )  THEN
-          DO  k = nzb+1, nzt
-             trs_m(k,j,i) = tend(k,j,i)
-          ENDDO
-       ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-          DO  k = nzb+1, nzt
-             trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
-          ENDDO
-       ENDIF
-    ENDIF
-
- END SUBROUTINE salsa_tendency_ij
-!
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the tendencies for aerosol number and mass concentrations.
-!> For vector machines.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation )
-
-    USE advec_ws,                                                                                  &
-        ONLY:  advec_s_ws
-    USE advec_s_pw_mod,                                                                            &
-        ONLY:  advec_s_pw
-    USE advec_s_up_mod,                                                                            &
-        ONLY:  advec_s_up
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu, rdf_sc, tend
-    USE diffusion_s_mod,                                                                           &
-        ONLY:  diffusion_s
-    USE indices,                                                                                   &
-        ONLY:  wall_flags_total_0
-    USE surface_mod,                                                                               &
-        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN = *) ::  id
-
-    INTEGER(iwp) ::  ib           !< loop index for aerosol number bin OR gas index
-    INTEGER(iwp) ::  ic           !< loop index for aerosol mass bin
-    INTEGER(iwp) ::  icc  !< (c-1)*nbins_aerosol+b
-    INTEGER(iwp) ::  i    !<
-    INTEGER(iwp) ::  j    !<
-    INTEGER(iwp) ::  k    !<
-
-    LOGICAL ::  do_sedimentation  !<
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  rs_init !<
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  rs_p    !<
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  rs      !<
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  trs_m   !<
-
-    icc = ( ic - 1 ) * nbins_aerosol + ib
-!
-!-- Tendency-terms for reactive scalar
-    tend = 0.0_wp
-!
-!-- Advection terms
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_sca )  THEN
-          CALL advec_s_ws( salsa_advc_flags_s, rs, id,                                             &
-                           bc_dirichlet_aer_l  .OR.  bc_radiation_aer_l,                           &
-                           bc_dirichlet_aer_n  .OR.  bc_radiation_aer_n,                           &
-                           bc_dirichlet_aer_r  .OR.  bc_radiation_aer_r,                           &
-                           bc_dirichlet_aer_s  .OR.  bc_radiation_aer_s )
-       ELSE
-          CALL advec_s_pw( rs )
-       ENDIF
-    ELSE
-       CALL advec_s_up( rs )
-    ENDIF
-!
-!-- Diffusion terms
-    SELECT CASE ( id )
-       CASE ( 'aerosol_number' )
-          CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib),                                         &
-                                surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib),              &
-                                surf_lsm_h(0)%answs(:,ib), surf_lsm_h(1)%answs(:,ib),              &
-                                surf_usm_h(0)%answs(:,ib), surf_usm_h(1)%answs(:,ib),              &
-                                surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib),              &
-                                surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib),              &
-                                surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib),              &
-                                surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib),              &
-                                surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib),              &
-                                surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) )
-       CASE ( 'aerosol_mass' )
-          CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc),                                        &
-                                surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc),            &
-                                surf_lsm_h(0)%amsws(:,icc), surf_lsm_h(1)%amsws(:,icc),            &
-                                surf_usm_h(0)%amsws(:,icc), surf_usm_h(1)%amsws(:,icc),            &
-                                surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc),            &
-                                surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc),            &
-                                surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc),            &
-                                surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc),            &
-                                surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc),            &
-                                surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) )
-       CASE ( 'salsa_gas' )
-          CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib),                                         &
-                                surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib),              &
-                                surf_lsm_h(0)%gtsws(:,ib), surf_lsm_h(1)%gtsws(:,ib),              &
-                                surf_usm_h(0)%gtsws(:,ib), surf_usm_h(1)%gtsws(:,ib),              &
-                                surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib),              &
-                                surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib),              &
-                                surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib),              &
-                                surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib),              &
-                                surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib),              &
-                                surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) )
-    END SELECT
-!
-!-- Prognostic equation for a scalar
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-!
-!--       Sedimentation for aerosol number and mass
-          IF ( lsdepo  .AND.  do_sedimentation )  THEN
-             tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) *      &
-                                   sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) *              &
-                                   sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) *              &
-                                   MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt-1,j,i), 0 ) )
-          ENDIF
-          DO  k = nzb+1, nzt
-             rs_p(k,j,i) = rs(k,j,i) +  ( dt_3d  * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )&
-                                                  - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )&
-                                        ) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-             IF ( rs_p(k,j,i) < 0.0_wp )  rs_p(k,j,i) = 0.1_wp * rs(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+1, nzt
-                   trs_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+1, nzt
-                   trs_m(k,j,i) =  -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
- END SUBROUTINE salsa_tendency
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Boundary conditions for prognostic variables in SALSA
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_boundary_conditions( horizontal_conditions_only )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzu
-
-    USE surface_mod,                                                                               &
-        ONLY :  bc_h
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i    !< grid index x direction
-    INTEGER(iwp) ::  ib   !< index for aerosol size bins
-    INTEGER(iwp) ::  ic   !< index for chemical compounds in aerosols
-    INTEGER(iwp) ::  icc  !< additional index for chemical compounds in aerosols
-    INTEGER(iwp) ::  ig   !< idex for gaseous compounds
-    INTEGER(iwp) ::  j    !< grid index y direction
-    INTEGER(iwp) ::  k    !< grid index y direction
-    INTEGER(iwp) ::  l    !< running index boundary type, for up- and downward-facing walls
-    INTEGER(iwp) ::  m    !< running index surface elements
-
-    LOGICAL, OPTIONAL ::  horizontal_conditions_only  !< switch to set horizontal bc only
-
-    REAL(wp) ::  flag  !< flag to mask topography grid points
-
-    IF ( time_since_reference_point >= skip_time_do_salsa )  THEN
-
-       IF ( .NOT. PRESENT( horizontal_conditions_only ) )  THEN
-!
-!--       Surface conditions:
-          IF ( ibc_aer_b == 0 )  THEN   ! Dirichlet
-!
-!--          Run loop over all non-natural and natural walls. Note, in wall-datatype the k
-!--          coordinate belongs to the atmospheric grid point, therefore, set s_p at k-1
-             DO  l = 0, 1
-                !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
-                !$OMP DO
-                DO  m = 1, bc_h(l)%ns
-
-                   i = bc_h(l)%i(m)
-                   j = bc_h(l)%j(m)
-                   k = bc_h(l)%k(m)
-
-                   DO  ib = 1, nbins_aerosol
-                      aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) =                              &
-                                                       aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i)
-                      DO  ic = 1, ncomponents_mass
-                         icc = ( ic - 1 ) * nbins_aerosol + ib
-                         aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) =                            &
-                                                       aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i)
-                      ENDDO
-                   ENDDO
-                   IF ( .NOT. salsa_gases_from_chem )  THEN
-                      DO  ig = 1, ngases_salsa
-                         salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) =                                &
-                                                       salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i)
-                      ENDDO
-                   ENDIF
-
-                ENDDO
-                !$OMP END PARALLEL
-
-             ENDDO
-
-          ELSE   ! Neumann
-
-             DO  l = 0, 1
-                !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k )
-                !$OMP DO
-                DO  m = 1, bc_h(l)%ns
-
-                   i = bc_h(l)%i(m)
-                   j = bc_h(l)%j(m)
-                   k = bc_h(l)%k(m)
-
-                   DO  ib = 1, nbins_aerosol
-                      aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) =                              &
-                                                                  aerosol_number(ib)%conc_p(k,j,i)
-                      DO  ic = 1, ncomponents_mass
-                         icc = ( ic - 1 ) * nbins_aerosol + ib
-                         aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) =                            &
-                                                                  aerosol_mass(icc)%conc_p(k,j,i)
-                      ENDDO
-                   ENDDO
-                   IF ( .NOT. salsa_gases_from_chem ) THEN
-                      DO  ig = 1, ngases_salsa
-                         salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = salsa_gas(ig)%conc_p(k,j,i)
-                      ENDDO
-                   ENDIF
-
-                ENDDO
-                !$OMP END PARALLEL
-             ENDDO
-
-          ENDIF
-!
-!--       Top boundary conditions:
-          IF ( ibc_aer_t == 0 )  THEN   ! Dirichlet
-
-             DO  ib = 1, nbins_aerosol
-                aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:)
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:)
-                ENDDO
-             ENDIF
-
-          ELSEIF ( ibc_aer_t == 1 )  THEN   ! Neumann
-
-             DO  ib = 1, nbins_aerosol
-                aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:)
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:)
-                ENDDO
-             ENDIF
-
-          ELSEIF ( ibc_aer_t == 2 )  THEN   ! Initial gradient
-
-             DO  ib = 1, nbins_aerosol
-                aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) +        &
-                                                       bc_an_t_val(ib) * dzu(nzt+1)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) +       &
-                                                         bc_am_t_val(icc) * dzu(nzt+1)
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) +               &
-                                                     bc_gt_t_val(ig) * dzu(nzt+1)
-                ENDDO
-             ENDIF
-
-          ENDIF  ! top conditions
-
-!
-!--       Lateral boundary conditions
-          IF ( bc_dirichlet_aer_s )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  i = nxlg, nxrg
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                      aerosol_number(ib)%conc_p(k,nys-1,i) = aerosol_number(ib)%init(k) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                         aerosol_mass(icc)%conc_p(k,nys-1,i) = aerosol_mass(icc)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                         salsa_gas(ig)%conc_p(k,nys-1,i) = salsa_gas(ig)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ELSEIF ( bc_radiation_aer_s )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  i = nxlg, nxrg
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                      aerosol_number(ib)%conc_p(k,nys-1,i) = aerosol_number(ib)%conc_p(k,nys,i) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                         aerosol_mass(icc)%conc_p(k,nys-1,i) = aerosol_mass(icc)%conc_p(k,nys,i) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                         salsa_gas(ig)%conc_p(k,nys-1,i) = salsa_gas(ig)%conc_p(k,nys,i) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDIF
-
-          IF ( bc_dirichlet_aer_n )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  i = nxlg, nxrg
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                      aerosol_number(ib)%conc_p(k,nyn+1,i) = aerosol_number(ib)%init(k) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                         aerosol_mass(icc)%conc_p(k,nyn+1,i) = aerosol_mass(icc)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                         salsa_gas(ig)%conc_p(k,nyn+1,i) = salsa_gas(ig)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ELSEIF ( bc_radiation_aer_n )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  i = nxlg, nxrg
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                      aerosol_number(ib)%conc_p(k,nyn+1,i) = aerosol_number(ib)%conc_p(k,nyn,i) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                         aerosol_mass(icc)%conc_p(k,nyn+1,i) = aerosol_mass(icc)%conc_p(k,nyn,i) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                         salsa_gas(ig)%conc_p(k,nyn+1,i) = salsa_gas(ig)%conc_p(k,nyn,i) * flag
-                     ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDIF
-
-          IF ( bc_dirichlet_aer_l )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                      aerosol_number(ib)%conc_p(k,j,nxl-1) = aerosol_number(ib)%init(k) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                         aerosol_mass(icc)%conc_p(k,j,nxl-1) = aerosol_mass(icc)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                         salsa_gas(ig)%conc_p(k,j,nxl-1) = salsa_gas(ig)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ELSEIF ( bc_radiation_aer_l )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                      aerosol_number(ib)%conc_p(k,j,nxl-1) = aerosol_number(ib)%conc_p(k,j,nxl) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                         aerosol_mass(icc)%conc_p(k,j,nxl-1) = aerosol_mass(icc)%conc_p(k,j,nxl) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                         salsa_gas(ig)%conc_p(k,j,nxl-1) = salsa_gas(ig)%conc_p(k,j,nxl) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDIF
-
-          IF ( bc_dirichlet_aer_r )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                      aerosol_number(ib)%conc_p(k,j,nxr+1) = aerosol_number(ib)%init(k) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                         aerosol_mass(icc)%conc_p(k,j,nxr+1) = aerosol_mass(icc)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                         salsa_gas(ig)%conc_p(k,j,nxr+1) = salsa_gas(ig)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ELSEIF ( bc_radiation_aer_r )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                      aerosol_number(ib)%conc_p(k,j,nxr+1) = aerosol_number(ib)%conc_p(k,j,nxr) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                         aerosol_mass(icc)%conc_p(k,j,nxr+1) = aerosol_mass(icc)%conc_p(k,j,nxr) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                         salsa_gas(ig)%conc_p(k,j,nxr+1) = salsa_gas(ig)%conc_p(k,j,nxr) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDIF
-
-       ELSE
-!
-!--       Conditions for timelevel t (if called from salsa_exchange_horiz_bounds).
-!--       Only horizontal boundary conditions are set here.
-          IF ( bc_dirichlet_aer_s )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  i = nxlg, nxrg
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                      aerosol_number(ib)%conc(k,nys-1,i) = aerosol_number(ib)%init(k) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                         aerosol_mass(icc)%conc(k,nys-1,i) = aerosol_mass(icc)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                         salsa_gas(ig)%conc(k,nys-1,i) = salsa_gas(ig)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ELSEIF ( bc_radiation_aer_s )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  i = nxlg, nxrg
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                      aerosol_number(ib)%conc(k,nys-1,i) = aerosol_number(ib)%conc(k,nys,i) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                         aerosol_mass(icc)%conc(k,nys-1,i) = aerosol_mass(icc)%conc(k,nys,i) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) )
-                         salsa_gas(ig)%conc(k,nys-1,i) = salsa_gas(ig)%conc(k,nys,i) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDIF
-
-          IF ( bc_dirichlet_aer_n )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  i = nxlg, nxrg
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                      aerosol_number(ib)%conc(k,nyn+1,i) = aerosol_number(ib)%init(k) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                         aerosol_mass(icc)%conc(k,nyn+1,i) = aerosol_mass(icc)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                         salsa_gas(ig)%conc(k,nyn+1,i) = salsa_gas(ig)%init(k) * flag
-                     ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ELSEIF ( bc_radiation_aer_n )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  i = nxlg, nxrg
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                      aerosol_number(ib)%conc(k,nyn+1,i) = aerosol_number(ib)%conc(k,nyn,i) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                         aerosol_mass(icc)%conc(k,nyn+1,i) = aerosol_mass(icc)%conc(k,nyn,i) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  i = nxlg, nxrg
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) )
-                         salsa_gas(ig)%conc(k,nyn+1,i) = salsa_gas(ig)%conc(k,nyn,i) * flag
-                     ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDIF
-
-          IF ( bc_dirichlet_aer_l )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                      aerosol_number(ib)%conc(k,j,nxl-1) = aerosol_number(ib)%init(k) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                         aerosol_mass(icc)%conc(k,j,nxl-1) = aerosol_mass(icc)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                         salsa_gas(ig)%conc(k,j,nxl-1) = salsa_gas(ig)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ELSEIF ( bc_radiation_aer_l )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                      aerosol_number(ib)%conc(k,j,nxl-1) = aerosol_number(ib)%conc(k,j,nxl) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                         aerosol_mass(icc)%conc(k,j,nxl-1) = aerosol_mass(icc)%conc(k,j,nxl) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) )
-                         salsa_gas(ig)%conc(k,j,nxl-1) = salsa_gas(ig)%conc(k,j,nxl) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDIF
-
-          IF ( bc_dirichlet_aer_r )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                      aerosol_number(ib)%conc(k,j,nxr+1) = aerosol_number(ib)%init(k) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                         aerosol_mass(icc)%conc(k,j,nxr+1) = aerosol_mass(icc)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                         salsa_gas(ig)%conc(k,j,nxr+1) = salsa_gas(ig)%init(k) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ELSEIF ( bc_radiation_aer_r )  THEN
-
-             DO  ib = 1, nbins_aerosol
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                      aerosol_number(ib)%conc(k,j,nxr+1) = aerosol_number(ib)%conc(k,j,nxr) * flag
-                   ENDDO
-                ENDDO
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                         aerosol_mass(icc)%conc(k,j,nxr+1) = aerosol_mass(icc)%conc(k,j,nxr) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. salsa_gases_from_chem )  THEN
-                DO  ig = 1, ngases_salsa
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) )
-                         salsa_gas(ig)%conc(k,j,nxr+1) = salsa_gas(ig)%conc(k,j,nxr) * flag
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDIF
-
-       ENDIF  ! PRESENT( horizontal conditions only )
-
-    ENDIF
-
- END SUBROUTINE salsa_boundary_conditions
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates the total dry or wet mass concentration for individual bins
-!> Juha Tonttila (FMI) 2015
-!> Tomi Raatikainen (FMI) 2016
-!------------------------------------------------------------------------------!
- SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc )
-
-    IMPLICIT NONE
-
-    CHARACTER(len=*), INTENT(in) ::  itype  !< 'dry' or 'wet'
-
-    INTEGER(iwp) ::  ic                 !< loop index for mass bin number
-    INTEGER(iwp) ::  iend               !< end index: include water or not
-
-    INTEGER(iwp), INTENT(in) ::  ibin   !< index of the chemical component
-    INTEGER(iwp), INTENT(in) ::  i      !< loop index for x-direction
-    INTEGER(iwp), INTENT(in) ::  j      !< loop index for y-direction
-
-    REAL(wp), DIMENSION(:), INTENT(out) ::  mconc  !< total dry or wet mass concentration
-
-!-- Number of components
-    IF ( itype == 'dry' )  THEN
-       iend = prtcl%ncomp - 1
-    ELSE IF ( itype == 'wet' )  THEN
-       iend = prtcl%ncomp
-    ELSE
-       message_string = 'Error in itype!'
-       CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 )
-    ENDIF
-
-    mconc = 0.0_wp
-
-    DO  ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element
-       mconc = mconc + aerosol_mass(ic)%conc(:,j,i)
-    ENDDO
-
- END SUBROUTINE bin_mixrat
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sets surface fluxes
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_emission_update
-
-    IMPLICIT NONE
-
-    IF ( include_emission )  THEN
-
-       IF ( time_since_reference_point >= skip_time_do_salsa  )  THEN
-
-          IF ( next_aero_emission_update <=                                                        &
-               MAX( time_since_reference_point, 0.0_wp ) )  THEN
-             CALL salsa_emission_setup( .FALSE. )
-          ENDIF
-
-          IF ( next_gas_emission_update <=                                                         &
-               MAX( time_since_reference_point, 0.0_wp ) )  THEN
-             IF ( salsa_emission_mode == 'read_from_file'  .AND.  .NOT. salsa_gases_from_chem )    &
-             THEN
-                CALL salsa_gas_emission_setup( .FALSE. )
-             ENDIF
-          ENDIF
-
-       ENDIF
-    ENDIF
-
- END SUBROUTINE salsa_emission_update
-
-!------------------------------------------------------------------------------!
-!> Description:
-!> ------------
-!> Define aerosol fluxes: constant or read from a from file
-!> @todo - Emission stack height is not used yet. For default mode, emissions
-!>         are assumed to occur on upward facing horizontal surfaces.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_emission_setup( init )
-
-    USE control_parameters,                                                                        &
-        ONLY:  end_time, spinup_time
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
-               inquire_num_variables, inquire_variable_names,                                      &
-               get_dimension_length, open_read_file, street_type_f
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=80) ::  daytype = 'workday'  !< default day type
-    CHARACTER(LEN=25) ::  in_name              !< name of a gas in the input file
-    CHARACTER(LEN=25) ::  mod_name             !< name in the input file
-
-    INTEGER(iwp) ::  day_of_month   !< day of the month
-    INTEGER(iwp) ::  day_of_week    !< day of the week
-    INTEGER(iwp) ::  day_of_year    !< day of the year
-    INTEGER(iwp) ::  hour_of_day    !< hour of the day
-    INTEGER(iwp) ::  i              !< loop index
-    INTEGER(iwp) ::  ib             !< loop index: aerosol number bins
-    INTEGER(iwp) ::  ic             !< loop index: aerosol chemical components
-    INTEGER(iwp) ::  id_salsa       !< NetCDF id of aerosol emission input file
-    INTEGER(iwp) ::  in             !< loop index: emission category
-    INTEGER(iwp) ::  index_dd       !< index day
-    INTEGER(iwp) ::  index_hh       !< index hour
-    INTEGER(iwp) ::  index_mm       !< index month
-    INTEGER(iwp) ::  inn            !< loop index
-    INTEGER(iwp) ::  j              !< loop index
-    INTEGER(iwp) ::  month_of_year  !< month of the year
-    INTEGER(iwp) ::  ss             !< loop index
-
-    INTEGER(iwp), DIMENSION(maxspec) ::  cc_i2m   !<
-
-    LOGICAL  ::  netcdf_extend = .FALSE.  !< NetCDF input file exists
-
-    LOGICAL, INTENT(in) ::  init  !< if .TRUE. --> initialisation call
-
-    REAL(wp) ::  second_of_day  !< second of the day
-
-    REAL(wp), DIMENSION(24) ::  par_emis_time_factor =  & !< time factors for the parameterized mode
-                                                      (/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039, &
-                                                         0.056, 0.053, 0.051, 0.051, 0.052, 0.055, &
-                                                         0.059, 0.061, 0.064, 0.067, 0.069, 0.069, &
-                                                         0.049, 0.039, 0.039, 0.029, 0.024, 0.019 /)
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  nsect_emission  !< sectional number emission
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  source_array  !< temporary source array
-
-!
-!-- Define emissions:
-    SELECT CASE ( salsa_emission_mode )
-
-       CASE ( 'uniform', 'parameterized' )
-
-          IF ( init )  THEN  ! Do only once
-!
-!-           Form a sectional size distribution for the emissions
-             ALLOCATE( nsect_emission(1:nbins_aerosol),                                            &
-                       source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
-!
-!--          Precalculate a size distribution for the emission based on the mean diameter, standard
-!--          deviation and number concentration per each log-normal mode
-             CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag,  &
-                                     nsect_emission )
-             IF ( salsa_emission_mode == 'uniform' )  THEN
-                DO  ib = 1, nbins_aerosol
-                   source_array(:,:,ib) = nsect_emission(ib)
-                ENDDO
-             ELSE
-!
-!--             Get a time factor for the specific hour
-                IF ( .NOT.  ALLOCATED( aero_emission_att%time_factor ) )                           &
-                   ALLOCATE( aero_emission_att%time_factor(1) )
-                CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), hour=hour_of_day )
-                index_hh = hour_of_day
-                aero_emission_att%time_factor(1) = par_emis_time_factor(index_hh+1)
-
-                IF ( street_type_f%from_file )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         IF ( street_type_f%var(j,i) >= main_street_id  .AND.                      &
-                              street_type_f%var(j,i) < max_street_id )  THEN
-                            source_array(j,i,:) = nsect_emission(:) * emiss_factor_main *          &
-                                                  aero_emission_att%time_factor(1)
-                         ELSEIF ( street_type_f%var(j,i) >= side_street_id  .AND.                  &
-                                  street_type_f%var(j,i) < main_street_id )  THEN
-                            source_array(j,i,:) = nsect_emission(:) * emiss_factor_side *          &
-                                                  aero_emission_att%time_factor(1)
-                         ENDIF
-                      ENDDO
-                   ENDDO
-                ELSE
-                   WRITE( message_string, * ) 'salsa_emission_mode = "parameterized" but the '//  &
-                                              'street_type data is missing.'
-                   CALL message( 'salsa_emission_setup', 'PA0695', 1, 2, 0, 6, 0 )
-                ENDIF
-             ENDIF
-!
-!--          Check which chemical components are used
-             cc_i2m = 0
-             IF ( index_so4 > 0 ) cc_i2m(1) = index_so4
-             IF ( index_oc > 0 )  cc_i2m(2) = index_oc
-             IF ( index_bc > 0 )  cc_i2m(3) = index_bc
-             IF ( index_du > 0 )  cc_i2m(4) = index_du
-             IF ( index_ss > 0 )  cc_i2m(5) = index_ss
-             IF ( index_no > 0 )  cc_i2m(6) = index_no
-             IF ( index_nh > 0 )  cc_i2m(7) = index_nh
-!
-!--          Normalise mass fractions so that their sum is 1
-             aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a /                               &
-                                         SUM( aerosol_flux_mass_fracs_a(1:ncc ) )
-             IF ( salsa_emission_mode ==  'uniform' )  THEN
-!
-!--             Set uniform fluxes of default horizontal surfaces
-                CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array )
-             ELSE
-!
-!--             Set fluxes normalised based on the street type on land surfaces
-                CALL set_flux( surf_lsm_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array )
-             ENDIF
-
-             DEALLOCATE( nsect_emission, source_array )
-          ENDIF
-
-       CASE ( 'read_from_file' )
-!
-!--       Reset surface fluxes
-          surf_def_h(0)%answs = 0.0_wp
-          surf_def_h(0)%amsws = 0.0_wp
-          surf_lsm_h(0)%answs = 0.0_wp
-          surf_lsm_h(0)%amsws = 0.0_wp
-          surf_usm_h(0)%answs = 0.0_wp
-          surf_usm_h(0)%amsws = 0.0_wp
-
-!
-!--       Reset source arrays:
-          DO  ib = 1, nbins_aerosol
-             aerosol_number(ib)%source = 0.0_wp
-          ENDDO
-
-          DO  ic = 1, ncomponents_mass * nbins_aerosol
-             aerosol_mass(ic)%source = 0.0_wp
-          ENDDO
-
-#if defined( __netcdf )
-!
-!--       Check existence of PIDS_SALSA file
-          INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), EXIST = netcdf_extend )
-          IF ( .NOT. netcdf_extend )  THEN
-             message_string = 'Input file '// TRIM( input_file_salsa ) //  TRIM( coupling_char )&
-                              // ' missing!'
-             CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 )
-          ENDIF
-!
-!--       Open file in read-only mode
-          CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa )
-
-          IF ( init )  THEN
-!
-!--          Variable names
-             CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars )
-             ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) )
-             CALL inquire_variable_names( id_salsa, aero_emission_att%var_names )
-!
-!--          Read the index and name of chemical components
-             CALL get_dimension_length( id_salsa, aero_emission_att%ncc, 'composition_index' )
-             ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) )
-             CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index )
-
-             IF ( check_existence( aero_emission_att%var_names, 'composition_name' ) )  THEN
-                CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name,        &
-                                   aero_emission_att%ncc )
-             ELSE
-                message_string = 'Missing composition_name in ' // TRIM( input_file_salsa )
-                CALL message( 'salsa_emission_setup', 'PA0657', 1, 2, 0, 6, 0 )
-             ENDIF
-!
-!--          Find the corresponding chemical components in the model
-             aero_emission_att%cc_in2mod = 0
-             DO  ic = 1, aero_emission_att%ncc
-                in_name = aero_emission_att%cc_name(ic)
-                SELECT CASE ( TRIM( in_name ) )
-                   CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' )
-                      aero_emission_att%cc_in2mod(1) = ic
-                   CASE ( 'OC', 'oc', 'organics' )
-                      aero_emission_att%cc_in2mod(2) = ic
-                   CASE ( 'BC', 'bc' )
-                      aero_emission_att%cc_in2mod(3) = ic
-                   CASE ( 'DU', 'du' )
-                      aero_emission_att%cc_in2mod(4) = ic
-                   CASE ( 'SS', 'ss' )
-                      aero_emission_att%cc_in2mod(5) = ic
-                   CASE ( 'HNO3', 'hno3', 'NO', 'no', 'NO3', 'no3' )
-                      aero_emission_att%cc_in2mod(6) = ic
-                   CASE ( 'NH3', 'nh3', 'NH', 'nh', 'NH4', 'nh4' )
-                      aero_emission_att%cc_in2mod(7) = ic
-                END SELECT
-
-             ENDDO
-
-             IF ( SUM( aero_emission_att%cc_in2mod ) == 0 )  THEN
-                message_string = 'None of the aerosol chemical components in ' // TRIM(            &
-                                 input_file_salsa ) // ' correspond to the ones applied in SALSA.'
-                CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 )
-             ENDIF
-!
-!--          Get number of emission categories
-             CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' )
-!
-!--          Get the chemical composition (i.e. mass fraction of different species) in aerosols
-             IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) )  THEN
-                ALLOCATE( aero_emission%mass_fracs(1:aero_emission_att%ncat,                       &
-                                                   1:aero_emission_att%ncc) )
-                CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%mass_fracs,      &
-                                   0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 )
-             ELSE
-                message_string = 'Missing emission_mass_fracs in ' //  TRIM( input_file_salsa )
-                CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 )
-             ENDIF
-!
-!--          If the chemical component is not activated, set its mass fraction to 0 to avoid
-!--          inbalance between number and mass flux
-             IF ( index_so4 < 0  .AND.  aero_emission_att%cc_in2mod(1) > 0 )  THEN
-                aero_emission%mass_fracs(:,aero_emission_att%cc_in2mod(1)) = 0.0_wp
-                aero_emission_att%cc_in2mod(1) = 0
-             ENDIF
-             IF ( index_oc  < 0  .AND.  aero_emission_att%cc_in2mod(2) > 0 )  THEN
-                aero_emission%mass_fracs(:,aero_emission_att%cc_in2mod(2)) = 0.0_wp
-                aero_emission_att%cc_in2mod(2) = 0
-             ENDIF
-             IF ( index_bc  < 0  .AND.  aero_emission_att%cc_in2mod(3) > 0 )  THEN
-                aero_emission%mass_fracs(:,aero_emission_att%cc_in2mod(3)) = 0.0_wp
-                aero_emission_att%cc_in2mod(3) = 0
-             ENDIF
-             IF ( index_du  < 0  .AND.  aero_emission_att%cc_in2mod(4) > 0 )  THEN
-                aero_emission%mass_fracs(:,aero_emission_att%cc_in2mod(4)) = 0.0_wp
-                aero_emission_att%cc_in2mod(4) = 0
-             ENDIF
-             IF ( index_ss  < 0  .AND.  aero_emission_att%cc_in2mod(5) > 0 )  THEN
-                aero_emission%mass_fracs(:,aero_emission_att%cc_in2mod(5)) = 0.0_wp
-                aero_emission_att%cc_in2mod(5) = 0
-             ENDIF
-             IF ( index_no  < 0  .AND.  aero_emission_att%cc_in2mod(6) > 0 )  THEN
-                aero_emission%mass_fracs(:,aero_emission_att%cc_in2mod(6)) = 0.0_wp
-                aero_emission_att%cc_in2mod(6) = 0
-             ENDIF
-             IF ( index_nh  < 0  .AND.  aero_emission_att%cc_in2mod(7) > 0 )  THEN
-                aero_emission%mass_fracs(:,aero_emission_att%cc_in2mod(7)) = 0.0_wp
-                aero_emission_att%cc_in2mod(7) = 0
-             ENDIF
-!
-!--          Then normalise the mass fraction so that SUM = 1
-             DO  in = 1, aero_emission_att%ncat
-                aero_emission%mass_fracs(in,:) = aero_emission%mass_fracs(in,:) /                  &
-                                                 SUM( aero_emission%mass_fracs(in,:) )
-             ENDDO
-!
-!--          Inquire the fill value
-             CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE.,              &
-                                 'aerosol_emission_values' )
-!
-!--          Inquire units of emissions
-             CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE.,              &
-                                 'aerosol_emission_values' )
-!
-!--          Inquire the level of detail (lod)
-             CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE.,                  &
-                                 'aerosol_emission_values' )
-
-!
-!--          Read different emission information depending on the level of detail of emissions:
-
-!
-!--          Default mode:
-             IF ( aero_emission_att%lod == 1 )  THEN
-!
-!--             Unit conversion factor: convert to SI units (kg/m2/s)
-                IF ( aero_emission_att%units == 'kg/m2/yr' )  THEN
-                   aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp
-                ELSEIF ( aero_emission_att%units == 'g/m2/yr' )  THEN
-                   aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp
-                ELSE
-                   message_string = 'unknown unit for aerosol emissions: ' //                      &
-                                    TRIM( aero_emission_att%units ) // ' (lod1)'
-                   CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 )
-                ENDIF
-!
-!--             Allocate emission arrays
-                ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat),                   &
-                          aero_emission_att%rho(1:aero_emission_att%ncat),                         &
-                          aero_emission_att%time_factor(1:aero_emission_att%ncat) )
-!
-!--             Get emission category names and indices
-                IF ( check_existence( aero_emission_att%var_names, 'emission_category_name' ) )  THEN
-                   CALL get_variable( id_salsa, 'emission_category_name',                          &
-                                      aero_emission_att%cat_name,  aero_emission_att%ncat )
-                ELSE
-                   message_string = 'Missing emission_category_name in ' // TRIM( input_file_salsa )
-                   CALL message( 'salsa_emission_setup', 'PA0658', 1, 2, 0, 6, 0 )
-                ENDIF
-                CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index )
-!
-!--             Find corresponding emission categories
-                DO  in = 1, aero_emission_att%ncat
-                   in_name = aero_emission_att%cat_name(in)
-                   DO  ss = 1, def_modes%ndc
-                      mod_name = def_modes%cat_name_table(ss)
-                      IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) )  THEN
-                         def_modes%cat_input_to_model(ss) = in
-                      ENDIF
-                   ENDDO
-                ENDDO
-
-                IF ( SUM( def_modes%cat_input_to_model ) == 0 )  THEN
-                   message_string = 'None of the emission categories in ' //  TRIM(                &
-                                    input_file_salsa ) // ' match with the ones in the model.'
-                   CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 )
-                ENDIF
-!
-!--             Emission time factors: Find check whether emission time factors are given for each
-!--             hour of year OR based on month, day and hour
-!
-!--             For each hour of year:
-                IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) )  THEN
-                   CALL get_dimension_length( id_salsa, aero_emission_att%nhoursyear, 'nhoursyear' )
-                   ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat,                       &
-                                                   1:aero_emission_att%nhoursyear) )
-                   CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf,    &
-                                    0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 )
-!
-!--             Based on the month, day and hour:
-                ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) )  THEN
-                   CALL get_dimension_length( id_salsa, aero_emission_att%nmonthdayhour,           &
-                                              'nmonthdayhour' )
-                   ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat,                       &
-                                                   1:aero_emission_att%nmonthdayhour) )
-                   CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf,    &
-                                 0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 )
-                ELSE
-                   message_string = 'emission_time_factors should be given for each nhoursyear ' //&
-                                    'OR nmonthdayhour'
-                   CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 )
-                ENDIF
-!
-!--             Next emission update
-                CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
-                next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
-!
-!--             Calculate average mass density (kg/m3)
-                aero_emission_att%rho = 0.0_wp
-
-                IF ( cc_i2m(1) /= 0 )  aero_emission_att%rho = aero_emission_att%rho +  arhoh2so4 *&
-                                                               aero_emission%mass_fracs(:,cc_i2m(1))
-                IF ( cc_i2m(2) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhooc *    &
-                                                               aero_emission%mass_fracs(:,cc_i2m(2))
-                IF ( cc_i2m(3) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhobc *    &
-                                                               aero_emission%mass_fracs(:,cc_i2m(3))
-                IF ( cc_i2m(4) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhodu *    &
-                                                               aero_emission%mass_fracs(:,cc_i2m(4))
-                IF ( cc_i2m(5) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhoss *    &
-                                                               aero_emission%mass_fracs(:,cc_i2m(5))
-                IF ( cc_i2m(6) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhohno3 *  &
-                                                               aero_emission%mass_fracs(:,cc_i2m(6))
-                IF ( cc_i2m(7) /= 0 )  aero_emission_att%rho = aero_emission_att%rho + arhonh3 *   &
-                                                               aero_emission%mass_fracs(:,cc_i2m(7))
-!
-!--             Allocate and read surface emission data (in total PM, get_variable_3d_real)
-                ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) )
-                CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data,    &
-                                   0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn )
-
-!
-!--          Pre-processed mode
-             ELSEIF ( aero_emission_att%lod == 2 )  THEN
-!
-!--             Unit conversion factor: convert to SI units (#/m2/s)
-                IF ( aero_emission_att%units == '#/m2/s' )  THEN
-                   aero_emission_att%conversion_factor = 1.0_wp
-                ELSE
-                   message_string = 'unknown unit for aerosol emissions: ' //                      &
-                                    TRIM( aero_emission_att%units )
-                   CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 )
-                ENDIF
-!
-!--             Number of aerosol size bins in the emission data
-                CALL get_dimension_length( id_salsa, aero_emission_att%nbins, 'Dmid' )
-                IF ( aero_emission_att%nbins /= nbins_aerosol )  THEN
-                   message_string = 'The number of size bins in aerosol input data does not ' //   &
-                                    'correspond to the model set-up'
-                   CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 )
-                ENDIF
-!
-!--             Number of time steps in the emission data
-                CALL get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
-!
-!--             Allocate bin diameters, time and mass fraction array
-                ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol),                                 &
-                          aero_emission_att%time(0:aero_emission_att%nt-1),                        &
-                          aero_emission%num_fracs(1:aero_emission_att%ncat,1:nbins_aerosol) )
-!
-!--             Read mean diameters
-                CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid )
-!
-!--             Check whether the sectional representation of the aerosol size distribution conform
-!--             to the one applied in the model
-                IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) /           &
-                               aero(1:nbins_aerosol)%dmid ) > 0.1_wp )  )  THEN
-                   message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa )  &
-                                    // ' do not match with the ones in the model.'
-                   CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 )
-                ENDIF
-!
-!--             Read time stamps:
-                IF ( check_existence( aero_emission_att%var_names, 'time' ) )  THEN
-                   CALL get_variable( id_salsa, 'time', aero_emission_att%time )
-                ELSE
-                   message_string = 'Missing time in ' //  TRIM( input_file_salsa )
-                   CALL message( 'salsa_emission_setup', 'PA0660', 1, 2, 0, 6, 0 )
-                ENDIF
-!
-!--             Check if the provided data covers the entire simulation. The spinup time is added
-!--             to the end_time, this must be considered here.
-                IF ( end_time - spinup_time > aero_emission_att%time(aero_emission_att%nt-1) )  THEN
-                   message_string = 'end_time of the simulation exceeds the time dimension in ' // &
-                                    'the salsa input file.'
-                   CALL message( 'salsa_emission_setup', 'PA0692', 1, 2, 0, 6, 0 )
-                ENDIF
-!
-!--             Read emission number fractions per category
-                IF ( check_existence( aero_emission_att%var_names, 'emission_number_fracs' ) )  THEN
-                   CALL get_variable( id_salsa, 'emission_number_fracs', aero_emission%num_fracs,  &
-                                      0, nbins_aerosol-1, 0, aero_emission_att%ncat-1 )
-                ELSE
-                   message_string = 'Missing emission_number_fracs in ' //  TRIM( input_file_salsa )
-                   CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 )
-                ENDIF
-
-             ELSE
-                message_string = 'Unknown lod for aerosol_emission_values.'
-                CALL message( 'salsa_emission_setup','PA0637', 1, 2, 0, 6, 0 )
-
-             ENDIF  ! lod
-
-          ENDIF  ! init
-!
-!--       Define and set current emission values:
-!
-!--       Default type emissions (aerosol emission given as total mass emission per year):
-          IF ( aero_emission_att%lod == 1 )  THEN
-!
-!--          Emission time factors for each emission category at current time step
-             IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour )  THEN
-!
-!--             Get the index of the current hour
-                CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ),                     &
-                                    day_of_year=day_of_year, hour=hour_of_day )
-                index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
-                aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh+1)
-
-             ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour )  THEN
-!
-!--             Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
-!--             Needs to be calculated.)
-                CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), month=month_of_year,&
-                                    day=day_of_month, hour=hour_of_day, day_of_week=day_of_week )
-                index_mm = month_of_year
-                index_dd = months_per_year + day_of_week
-                SELECT CASE(TRIM(daytype))
-
-                   CASE ("workday")
-                      index_hh = months_per_year + days_per_week + hour_of_day
-
-                   CASE ("weekend")
-                      index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
-
-                   CASE ("holiday")
-                      index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
-
-                END SELECT
-                aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) *                &
-                                                aero_emission_att%etf(:,index_dd) *                &
-                                                aero_emission_att%etf(:,index_hh+1)
-             ENDIF
-
-!
-!--          Create a sectional number size distribution for emissions
-             ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
-             DO  in = 1, aero_emission_att%ncat
-
-                inn = def_modes%cat_input_to_model(in)
-!
-!--             Calculate the number concentration (1/m3) of a log-normal size distribution
-!--             following Jacobson (2005): Eq 13.25.
-                def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi *            &
-                                       ( def_modes%dpg_table )**3 *  EXP( 4.5_wp *                 &
-                                       LOG( def_modes%sigmag_table )**2 ) )
-!
-!--             Sectional size distibution (1/m3) from a log-normal one
-                CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table,                 &
-                                        def_modes%sigmag_table, nsect_emission )
-
-                source_array = 0.0_wp
-                DO  ib = 1, nbins_aerosol
-                   source_array(:,:,ib) = aero_emission%def_data(:,:,in) *                         &
-                                          aero_emission_att%conversion_factor /                    &
-                                          aero_emission_att%rho(in) * nsect_emission(ib) *         &
-                                          aero_emission_att%time_factor(in)
-                ENDDO
-!
-!--             Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes
-!--             only for either default, land or urban surface.
-                IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-                   CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod,                      &
-                                  aero_emission%mass_fracs(in,:), source_array )
-                ELSE
-                   CALL set_flux( surf_usm_h(0), aero_emission_att%cc_in2mod,                      &
-                                  aero_emission%mass_fracs(in,:), source_array )
-                   CALL set_flux( surf_lsm_h(0), aero_emission_att%cc_in2mod,                      &
-                                  aero_emission%mass_fracs(in,:), source_array )
-                ENDIF
-             ENDDO
-!
-!--          The next emission update is again after one hour
-             next_aero_emission_update = next_aero_emission_update + 3600.0_wp
-
-
-             DEALLOCATE( nsect_emission, source_array )
-!
-!--       Pre-processed:
-          ELSEIF ( aero_emission_att%lod == 2 )  THEN
-!
-!--          Obtain time index for current point in time.
-             aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time -                        &
-                                                   MAX( time_since_reference_point, 0.0_wp ) ),    &
-                                              DIM = 1 ) - 1
-!
-!--          Allocate the data input array always before reading in the data and deallocate after
-             ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat),       &
-                       source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) )
-!
-!--          Read in the next time step (get_variable_4d_to_3d_real)
-             CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data,   &
-                                aero_emission_att%tind, 0, aero_emission_att%ncat-1,               &
-                                nxl, nxr, nys, nyn )
-!
-!--          Calculate the sources per category and set surface fluxes
-             source_array = 0.0_wp
-             DO  in = 1, aero_emission_att%ncat
-                DO  ib = 1, nbins_aerosol
-                   source_array(:,:,ib) = aero_emission%preproc_data(:,:,in) *                     &
-                                          aero_emission%num_fracs(in,ib)
-                ENDDO
-!
-!--             Set fluxes only for either default, land and urban surface.
-                IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-                   CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod,                      &
-                                  aero_emission%mass_fracs(in,:), source_array )
-                ELSE
-                   CALL set_flux( surf_usm_h(0), aero_emission_att%cc_in2mod,                      &
-                                  aero_emission%mass_fracs(in,:), source_array )
-                   CALL set_flux( surf_lsm_h(0), aero_emission_att%cc_in2mod,                      &
-                                  aero_emission%mass_fracs(in,:), source_array )
-                ENDIF
-             ENDDO
-!
-!--          Determine the next emission update
-             next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2)
-
-             DEALLOCATE( aero_emission%preproc_data, source_array )
-
-          ENDIF
-!
-!--       Close input file
-          CALL close_input_file( id_salsa )
-#else
-          message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //&
-                           ' __netcdf is not used in compiling!'
-          CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 )
-
-#endif
-       CASE DEFAULT
-          message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode )
-          CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 )
-
-    END SELECT
-
-    CONTAINS
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sets the aerosol flux to aerosol arrays in 2a and 2b.
-!------------------------------------------------------------------------------!
-    SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array )
-
-       USE arrays_3d,                                                                              &
-           ONLY:  rho_air_zw
-
-       USE surface_mod,                                                                            &
-           ONLY:  surf_type
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i   !< loop index
-       INTEGER(iwp) ::  ib  !< loop index
-       INTEGER(iwp) ::  ic  !< loop index
-       INTEGER(iwp) ::  j   !< loop index
-       INTEGER(iwp) ::  k   !< loop index
-       INTEGER(iwp) ::  m   !< running index for surface elements
-
-       INTEGER(iwp), DIMENSION(:) ::  cc_i_mod   !< index of chemical component in the input data
-
-       REAL(wp) ::  so4_oc  !< mass fraction between SO4 and OC in 1a
-
-       REAL(wp), DIMENSION(:), INTENT(in) ::  mass_fracs  !< mass fractions of chemical components
-
-       REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) ::  source_array  !<
-
-       TYPE(surf_type), INTENT(inout) :: surface  !< respective surface type
-
-       so4_oc = 0.0_wp
-
-       DO  m = 1, surface%ns
-!
-!--       Get indices of respective grid point
-          i = surface%i(m)
-          j = surface%j(m)
-          k = surface%k(m)
-
-          DO  ib = 1, nbins_aerosol
-             IF ( source_array(j,i,ib) < nclim )  THEN
-                source_array(j,i,ib) = 0.0_wp
-             ENDIF
-!
-!--          Set mass fluxes.  First bins include only SO4 and/or OC.
-             IF ( ib <= end_subrange_1a )  THEN
-!
-!--             Both sulphate and organic carbon
-                IF ( index_so4 > 0  .AND.  index_oc > 0 )  THEN
-
-                   ic = ( index_so4 - 1 ) * nbins_aerosol + ib
-                   so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) +                  &
-                                                        mass_fracs(cc_i_mod(2)) )
-                   surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib)       &
-                                         * api6 * aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1)
-                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
-
-                   ic = ( index_oc - 1 ) * nbins_aerosol + ib
-                   surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) &
-                                         * api6 * aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1)
-                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
-!
-!--             Only sulphates
-                ELSEIF ( index_so4 > 0  .AND.  index_oc < 0 )  THEN
-                   ic = ( index_so4 - 1 ) * nbins_aerosol + ib
-                   surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 *       &
-                                         aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1)
-                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
-!
-!--             Only organic carbon
-                ELSEIF ( index_so4 < 0  .AND.  index_oc > 0 )  THEN
-                   ic = ( index_oc - 1 ) * nbins_aerosol + ib
-                   surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 *       &
-                                         aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1)
-                   aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic)
-                ENDIF
-
-             ELSE
-!
-!--             Sulphate
-                IF ( cc_i_mod(1) > 0 )  THEN
-                   ic = cc_i_mod(1)
-                   CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4,       &
-                                       source_array(j,i,ib) )
-                ENDIF
-!
-!--             Organic carbon
-                IF ( cc_i_mod(2) > 0 )  THEN
-                   ic = cc_i_mod(2)
-                   CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc,            &
-                                       source_array(j,i,ib) )
-                ENDIF
-!
-!--             Black carbon
-                IF ( cc_i_mod(3) > 0 )  THEN
-                   ic = cc_i_mod(3)
-                   CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc,           &
-                                       source_array(j,i,ib) )
-                ENDIF
-!
-!--             Dust
-                IF ( cc_i_mod(4) > 0 )  THEN
-                   ic = cc_i_mod(4)
-                   CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu,           &
-                                       source_array(j,i,ib) )
-                ENDIF
-!
-!--             Sea salt
-                IF ( cc_i_mod(5) > 0 )  THEN
-                   ic = cc_i_mod(5)
-                   CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss,           &
-                                       source_array(j,i,ib) )
-                ENDIF
-!
-!--             Nitric acid
-                IF ( cc_i_mod(6) > 0 )  THEN
-                    ic = cc_i_mod(6)
-                   CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3,         &
-                                       source_array(j,i,ib) )
-                ENDIF
-!
-!--             Ammonia
-                IF ( cc_i_mod(7) > 0 )  THEN
-                    ic = cc_i_mod(7)
-                   CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3,          &
-                                       source_array(j,i,ib) )
-                ENDIF
-
-             ENDIF
-!
-!--          Save number fluxes in the end
-             surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1)
-             aerosol_number(ib)%source(j,i) = surface%answs(m,ib)
-
-          ENDDO  ! ib
-       ENDDO  ! m
-
-    END SUBROUTINE set_flux
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sets the mass emissions to aerosol arrays in 2a and 2b.
-!------------------------------------------------------------------------------!
-    SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource )
-
-       USE arrays_3d,                                                                              &
-           ONLY:  rho_air_zw
-
-       USE surface_mod,                                                                            &
-           ONLY:  surf_type
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i   !< loop index
-       INTEGER(iwp) ::  j   !< loop index
-       INTEGER(iwp) ::  k   !< loop index
-       INTEGER(iwp) ::  ic  !< loop index
-
-       INTEGER(iwp), INTENT(in) :: ib        !< Aerosol size bin index
-       INTEGER(iwp), INTENT(in) :: ispec     !< Aerosol species index
-       INTEGER(iwp), INTENT(in) :: surf_num  !< index surface elements
-
-       REAL(wp), INTENT(in) ::  mass_frac    !< mass fraction of a chemical compound in all bins
-       REAL(wp), INTENT(in) ::  nsource      !< number source (#/m2/s)
-       REAL(wp), INTENT(in) ::  prho         !< Aerosol density
-
-       TYPE(surf_type), INTENT(inout) ::  surface  !< respective surface type
-!
-!--    Get indices of respective grid point
-       i = surface%i(surf_num)
-       j = surface%j(surf_num)
-       k = surface%k(surf_num)
-!
-!--    Subrange 2a:
-       ic = ( ispec - 1 ) * nbins_aerosol + ib
-       surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource *             &
-                                    aero(ib)%core * prho * rho_air_zw(k-1)
-       aerosol_mass(ic)%source(j,i) = surface%amsws(surf_num,ic)
-
-    END SUBROUTINE set_mass_flux
-
- END SUBROUTINE salsa_emission_setup
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sets the gaseous fluxes
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_gas_emission_setup( init )
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
-               inquire_num_variables, inquire_variable_names,                                      &
-               get_dimension_length, open_read_file
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=80) ::  daytype = 'workday'  !< default day type
-    CHARACTER(LEN=25) ::  in_name              !< name of a gas in the input file
-
-    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names   !<  variable names in input data
-
-
-    INTEGER(iwp) ::  day_of_month   !< day of the month
-    INTEGER(iwp) ::  day_of_week    !< day of the week
-    INTEGER(iwp) ::  day_of_year    !< day of the year
-    INTEGER(iwp) ::  hour_of_day    !< hour of the day
-    INTEGER(iwp) ::  id_chem        !< NetCDF id of chemistry emission file
-    INTEGER(iwp) ::  i              !< loop index
-    INTEGER(iwp) ::  ig             !< loop index
-    INTEGER(iwp) ::  in             !< running index for emission categories
-    INTEGER(iwp) ::  index_dd       !< index day
-    INTEGER(iwp) ::  index_hh       !< index hour
-    INTEGER(iwp) ::  index_mm       !< index month
-    INTEGER(iwp) ::  j              !< loop index
-    INTEGER(iwp) ::  month_of_year  !< month of the year
-    INTEGER(iwp) ::  num_vars       !< number of variables
-
-    LOGICAL  ::  netcdf_extend = .FALSE.  !< NetCDF input file exists
-
-    LOGICAL, INTENT(in) ::  init          !< if .TRUE. --> initialisation call
-
-    REAL(wp) ::  second_of_day    !< second of the day
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  time_factor  !< emission time factor
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  dum_var_3d  !<
-
-    REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::  dum_var_5d  !<
-
-!
-!-- Reset surface fluxes
-    surf_def_h(0)%gtsws = 0.0_wp
-    surf_lsm_h(0)%gtsws = 0.0_wp
-    surf_usm_h(0)%gtsws = 0.0_wp
-
-#if defined( __netcdf )
-!
-!-- Check existence of PIDS_CHEM file
-    INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend )
-    IF ( .NOT. netcdf_extend )  THEN
-       message_string = 'Input file PIDS_CHEM' //  TRIM( coupling_char ) // ' missing!'
-       CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Open file in read-only mode
-    CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem )
-
-    IF ( init )  THEN
-!
-!--    Read the index and name of chemical components
-       CALL get_dimension_length( id_chem, chem_emission_att%n_emiss_species, 'nspecies' )
-       ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) )
-       CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index )
-       CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name,                &
-                          chem_emission_att%n_emiss_species )
-!
-!--    Allocate emission data
-       ALLOCATE( chem_emission(1:chem_emission_att%n_emiss_species) )
-!
-!--    Find the corresponding indices in the model
-       emission_index_chem = 0
-       DO  ig = 1, chem_emission_att%n_emiss_species
-          in_name = chem_emission_att%species_name(ig)
-          SELECT CASE ( TRIM( in_name ) )
-             CASE ( 'H2SO4', 'h2so4' )
-                emission_index_chem(1) = ig
-             CASE ( 'HNO3', 'hno3' )
-                emission_index_chem(2) = ig
-             CASE ( 'NH3', 'nh3' )
-                emission_index_chem(3) = ig
-             CASE ( 'OCNV', 'ocnv' )
-                emission_index_chem(4) = ig
-             CASE ( 'OCSV', 'ocsv' )
-                emission_index_chem(5) = ig
-          END SELECT
-       ENDDO
-!
-!--    Inquire the fill value
-       CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' )
-!
-!--    Inquire units of emissions
-       CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' )
-!
-!--    Inquire the level of detail (lod)
-       CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' )
-!
-!--    Variable names
-       CALL inquire_num_variables( id_chem, num_vars )
-       ALLOCATE( var_names(1:num_vars) )
-       CALL inquire_variable_names( id_chem, var_names )
-!
-!--    Default mode: as total emissions per year
-       IF ( lod_gas_emissions == 1 )  THEN
-
-!
-!--       Get number of emission categories and allocate emission arrays
-          CALL get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
-          ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat),                         &
-                    time_factor(1:chem_emission_att%ncat) )
-!
-!--       Get emission category names and indices
-          CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name,        &
-                             chem_emission_att%ncat)
-          CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index )
-!
-!--       Emission time factors: Find check whether emission time factors are given for each hour
-!--       of year OR based on month, day and hour
-!
-!--       For each hour of year:
-          IF ( check_existence( var_names, 'nhoursyear' ) )  THEN
-             CALL get_dimension_length( id_chem, chem_emission_att%nhoursyear, 'nhoursyear' )
-             ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat,         &
-                                                                 1:chem_emission_att%nhoursyear) )
-             CALL get_variable( id_chem, 'emission_time_factors',                                  &
-                                chem_emission_att%hourly_emis_time_factor,                         &
-                                0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 )
-!
-!--       Based on the month, day and hour:
-          ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) )  THEN
-             CALL get_dimension_length( id_chem, chem_emission_att%nmonthdayhour, 'nmonthdayhour' )
-             ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat,            &
-                                                              1:chem_emission_att%nmonthdayhour) )
-             CALL get_variable( id_chem, 'emission_time_factors',                                  &
-                                chem_emission_att%mdh_emis_time_factor,                            &
-                                0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 )
-          ELSE
-             message_string = 'emission_time_factors should be given for each nhoursyear OR ' //   &
-                              'nmonthdayhour'
-             CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 )
-          ENDIF
-!
-!--       Next emission update
-          CALL get_date_time( time_since_reference_point, second_of_day=second_of_day )
-          next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour
-!
-!--       Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data
-!--       array is applied now here)
-          ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species,              &
-                               1:chem_emission_att%ncat) )
-          CALL get_variable( id_chem, 'emission_values', dum_var_5d, 0, chem_emission_att%ncat-1,  &
-                             0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0 )
-          DO  ig = 1, chem_emission_att%n_emiss_species
-             ALLOCATE( chem_emission(ig)%default_emission_data(nys:nyn,nxl:nxr,                    &
-                                                               1:chem_emission_att%ncat) )
-             DO  in = 1, chem_emission_att%ncat
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      chem_emission(ig)%default_emission_data(j,i,in) = dum_var_5d(1,j,i,ig,in)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-          DEALLOCATE( dum_var_5d )
-!
-!--    Pre-processed mode:
-       ELSEIF ( lod_gas_emissions == 2 )  THEN
-!
-!--       Number of time steps in the emission data
-          CALL get_dimension_length( id_chem, chem_emission_att%dt_emission, 'time' )
-!
-!--       Allocate and read time
-          ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) )
-          CALL get_variable( id_chem, 'time', gas_emission_time )
-       ELSE
-          message_string = 'Unknown lod for emission_values.'
-          CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 )
-       ENDIF  ! lod
-
-    ENDIF  ! init
-!
-!-- Define and set current emission values:
-
-    IF ( lod_gas_emissions == 1 )  THEN
-!
-!--    Emission time factors for each emission category at current time step
-       IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour )  THEN
-!
-!--       Get the index of the current hour
-          CALL get_date_time( time_since_reference_point, &
-                              day_of_year=day_of_year, hour=hour_of_day )
-          index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day
-          IF ( .NOT. ALLOCATED( time_factor ) )  ALLOCATE( time_factor(1:chem_emission_att%ncat) )
-          time_factor = 0.0_wp
-          time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh+1)
-
-       ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour )  THEN
-!
-!--       Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed.
-!--       Needs to be calculated.)
-          CALL get_date_time( time_since_reference_point, &
-                              month=month_of_year,        &
-                              day=day_of_month,           &
-                              hour=hour_of_day,           &
-                              day_of_week=day_of_week     )
-          index_mm = month_of_year
-          index_dd = months_per_year + day_of_week
-          SELECT CASE( TRIM( daytype ) )
-
-             CASE ("workday")
-                index_hh = months_per_year + days_per_week + hour_of_day
-
-             CASE ("weekend")
-                index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
-
-             CASE ("holiday")
-                index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
-
-          END SELECT
-          time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) *                       &
-                        chem_emission_att%mdh_emis_time_factor(:,index_dd) *                       &
-                        chem_emission_att%mdh_emis_time_factor(:,index_hh+1)
-       ENDIF
-!
-!--    Set gas emissions for each emission category
-       ALLOCATE( dum_var_3d(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
-
-       DO  in = 1, chem_emission_att%ncat
-          DO  ig = 1, chem_emission_att%n_emiss_species
-             dum_var_3d(:,:,ig) = chem_emission(ig)%default_emission_data(:,:,in)
-          ENDDO
-!
-!--       Set surface fluxes only for either default, land or urban surface
-          IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-             CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units,    &
-                                dum_var_3d, time_factor(in) )
-          ELSE
-             CALL set_gas_flux( surf_usm_h(0), emission_index_chem, chem_emission_att%units,    &
-                                dum_var_3d, time_factor(in) )
-             CALL set_gas_flux( surf_lsm_h(0), emission_index_chem, chem_emission_att%units,    &
-                                dum_var_3d, time_factor(in) )
-          ENDIF
-       ENDDO
-       DEALLOCATE( dum_var_3d )
-!
-!--    The next emission update is again after one hour
-       next_gas_emission_update = next_gas_emission_update + 3600.0_wp
-
-    ELSEIF ( lod_gas_emissions == 2 )  THEN
-!
-!--    Obtain time index for current point in time.
-       chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time -                                 &
-                                          MAX( time_since_reference_point, 0.0_wp ) ), DIM = 1 ) - 1
-!
-!--    Allocate the data input array always before reading in the data and deallocate after (NOTE
-!--    that "preprocessed" input data array is applied now here)
-       ALLOCATE( dum_var_5d(1,1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) )
-!
-!--    Read in the next time step
-       CALL get_variable( id_chem, 'emission_values', dum_var_5d,                                  &
-                          0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0,        &
-                          chem_emission_att%i_hour, chem_emission_att%i_hour )
-!
-!--    Set surface fluxes only for either default, land or urban surface
-       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-          CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units,          &
-                             dum_var_5d(1,1,:,:,:) )
-       ELSE
-          CALL set_gas_flux( surf_usm_h(0), emission_index_chem, chem_emission_att%units,          &
-                             dum_var_5d(1,1,:,:,:) )
-          CALL set_gas_flux( surf_lsm_h(0), emission_index_chem, chem_emission_att%units,          &
-                             dum_var_5d(1,1,:,:,:) )
-       ENDIF
-       DEALLOCATE ( dum_var_5d )
-!
-!--    Determine the next emission update
-       next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2)
-
-    ENDIF
-!
-!-- Close input file
-    CALL close_input_file( id_chem )
-
-#else
-    message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //   &
-                     ' __netcdf is not used in compiling!'
-    CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 )
-
-#endif
-
-    CONTAINS
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set gas fluxes for selected type of surfaces
-!------------------------------------------------------------------------------!
-    SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac )
-
-       USE arrays_3d,                                                                              &
-           ONLY: dzw, hyp, pt, rho_air_zw
-
-       USE grid_variables,                                                                         &
-           ONLY:  dx, dy
-
-       USE surface_mod,                                                                            &
-           ONLY:  surf_type
-
-       IMPLICIT NONE
-
-       CHARACTER(LEN=*), INTENT(in) ::  unit  !< flux unit in the input file
-
-       INTEGER(iwp) ::  ig  !< running index for gases
-       INTEGER(iwp) ::  i   !< loop index
-       INTEGER(iwp) ::  j   !< loop index
-       INTEGER(iwp) ::  k   !< loop index
-       INTEGER(iwp) ::  m   !< running index for surface elements
-
-       INTEGER(iwp), DIMENSION(:) ::  cc_i_mod   !< index of different gases in the input data
-
-       LOGICAL ::  use_time_fac  !< .TRUE. is time_fac present
-
-       REAL(wp), OPTIONAL ::  time_fac  !< emission time factor
-
-       REAL(wp), DIMENSION(ngases_salsa) ::  conv     !< unit conversion factor
-
-       REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species), INTENT(in) ::  source_array  !<
-
-       TYPE(surf_type), INTENT(inout) :: surface  !< respective surface type
-
-       conv = 1.0_wp
-       use_time_fac = PRESENT( time_fac )
-
-       DO  m = 1, surface%ns
-!
-!--       Get indices of respective grid point
-          i = surface%i(m)
-          j = surface%j(m)
-          k = surface%k(m)
-!
-!--       Unit conversion factor: convert to SI units (#/m2/s)
-          SELECT CASE ( TRIM( unit ) )
-             CASE ( 'kg/m2/yr' )
-                conv(1) = avo / ( amh2so4 * 3600.0_wp )
-                conv(2) = avo / ( amhno3 * 3600.0_wp )
-                conv(3) = avo / ( amnh3 * 3600.0_wp )
-                conv(4) = avo / ( amoc * 3600.0_wp )
-                conv(5) = avo / ( amoc * 3600.0_wp )
-             CASE ( 'g/m2/yr' )
-                conv(1) = avo / ( amh2so4 * 3.6E+6_wp )
-                conv(2) = avo / ( amhno3 * 3.6E+6_wp )
-                conv(3) = avo / ( amnh3 * 3.6E+6_wp )
-                conv(4) = avo / ( amoc * 3.6E+6_wp )
-                conv(5) = avo / ( amoc * 3.6E+6_wp )
-             CASE ( 'g/m2/s' )
-                conv(1) = avo / ( amh2so4 * 1000.0_wp )
-                conv(2) = avo / ( amhno3 * 1000.0_wp )
-                conv(3) = avo / ( amnh3 * 1000.0_wp )
-                conv(4) = avo / ( amoc * 1000.0_wp )
-                conv(5) = avo / ( amoc * 1000.0_wp )
-             CASE ( '#/m2/s' )
-                conv = 1.0_wp
-             CASE ( 'ppm/m2/s' )
-                conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )**0.286_wp *   &
-                       dx * dy * dzw(k)
-             CASE ( 'mumol/m2/s' )
-                conv = 1.0E-6_wp * avo
-             CASE DEFAULT
-                message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units )
-                CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 )
-
-          END SELECT
-
-          DO  ig = 1, ngases_salsa
-             IF (cc_i_mod(ig) < 1) CYCLE
-             IF ( use_time_fac )  THEN
-                surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac  &
-                                      * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
-             ELSE
-                surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig)             &
-                                      * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) )
-             ENDIF
-          ENDDO  ! ig
-
-       ENDDO  ! m
-
-    END SUBROUTINE set_gas_flux
-
- END SUBROUTINE salsa_gas_emission_setup
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output for salsa.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_check_data_output( var, unit )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  unit     !<
-    CHARACTER(LEN=*) ::  var      !<
-
-    INTEGER(iwp) ::  char_to_int   !< for converting character to integer
-
-    IF ( var(1:6) /= 'salsa_' )  THEN
-       unit = 'illegal'
-       RETURN
-    ENDIF
-!
-!-- Treat bin-specific outputs separately
-    IF ( var(7:11) ==  'N_bin' )  THEN
-       READ( var(12:),* ) char_to_int
-       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-          unit = '#/m3'
-       ELSE
-          unit = 'illegal'
-          RETURN
-       ENDIF
-
-    ELSEIF ( var(7:11) ==  'm_bin' )  THEN
-       READ( var(12:),* ) char_to_int
-       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-          unit = 'kg/m3'
-       ELSE
-          unit = 'illegal'
-          RETURN
-       ENDIF
-
-    ELSEIF ( var(7:11) == 's_H2O' )  THEN
-       IF ( .NOT. advect_particle_water )  THEN
-          message_string = 'to output s_H2O/s_H2O_av requires that advect_particle_water = .T.'
-          CALL message( 'check_parameters', 'PA0707', 1, 2, 0, 6, 0 )
-       ENDIF
-       unit = 'kg/m3'
-
-    ELSE
-       SELECT CASE ( TRIM( var(7:) ) )
-
-          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
-             IF (  air_chemistry )  THEN
-                message_string = 'gases are imported from the chemistry module and thus output '// &
-                                 'of "' // TRIM( var ) // '" is not allowed'
-                CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = '#/m3'
-
-          CASE ( 'LDSA' )
-             unit = 'mum2/cm3'
-
-          CASE ( 'PM0.1', 'PM2.5', 'PM10', 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
-             unit = 'kg/m3'
-
-          CASE ( 'N_UFP', 'Ntot' )
-             unit = '#/m3'
-
-          CASE DEFAULT
-             unit = 'illegal'
-
-       END SELECT
-    ENDIF
-
- END SUBROUTINE salsa_check_data_output
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check profile data output for salsa. Currently only for diagnostic variables
-!> Ntot, N_UFP, PM0.1, PM2.5, PM10 and LDSA
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_check_data_output_pr( var, var_count, unit, dopr_unit )
-
-    USE arrays_3d,                                                                                 &
-        ONLY: zu
-
-    USE profil_parameter,                                                                          &
-        ONLY:  dopr_index
-
-    USE statistics,                                                                                &
-        ONLY:  hom, pr_palm, statistic_regions
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  dopr_unit  !<
-    CHARACTER(LEN=*) ::  unit       !<
-    CHARACTER(LEN=*) ::  var        !<
-
-    INTEGER(iwp) ::  var_count     !<
-
-    IF ( var(1:6) /= 'salsa_' )  THEN
-       unit = 'illegal'
-       RETURN
-    ENDIF
-
-    SELECT CASE ( TRIM( var(7:) ) )
-
-       CASE( 'LDSA' )
-          salsa_pr_count = salsa_pr_count + 1
-          salsa_pr_index(salsa_pr_count) = 1
-          dopr_index(var_count) = pr_palm + salsa_pr_count
-          dopr_unit = 'mum2/cm3'
-          unit = dopr_unit
-          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
-
-       CASE( 'N_UFP' )
-          salsa_pr_count = salsa_pr_count + 1
-          salsa_pr_index(salsa_pr_count) = 2
-          dopr_index(var_count) = pr_palm + salsa_pr_count
-          dopr_unit = '#/m3'
-          unit = dopr_unit
-          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
-
-       CASE( 'Ntot' )
-          salsa_pr_count = salsa_pr_count + 1
-          salsa_pr_index(salsa_pr_count) = 3
-          dopr_index(var_count) = pr_palm + salsa_pr_count
-          dopr_unit = '#/m3'
-          unit = dopr_unit
-          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
-
-       CASE( 'PM0.1' )
-          salsa_pr_count = salsa_pr_count + 1
-          salsa_pr_index(salsa_pr_count) = 4
-          dopr_index(var_count) = pr_palm + salsa_pr_count
-          dopr_unit = 'kg/m3'
-          unit = dopr_unit
-          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
-
-       CASE( 'PM2.5' )
-          salsa_pr_count = salsa_pr_count + 1
-          salsa_pr_index(salsa_pr_count) = 5
-          dopr_index(var_count) = pr_palm + salsa_pr_count
-          dopr_unit = 'kg/m3'
-          unit = dopr_unit
-          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
-
-       CASE( 'PM10' )
-          salsa_pr_count = salsa_pr_count + 1
-          salsa_pr_index(salsa_pr_count) = 6
-          dopr_index(var_count) = pr_palm + salsa_pr_count
-          dopr_unit = 'kg/m3'
-          unit = dopr_unit
-          hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE salsa_check_data_output_pr
-
-!-------------------------------------------------------------------------------!
-!> Description:
-!> Calculation of horizontally averaged profiles for salsa.
-!-------------------------------------------------------------------------------!
- SUBROUTINE salsa_statistics( mode, sr, tn )
-
-    USE control_parameters,                                                                        &
-        ONLY:  max_pr_user
-
-    USE chem_modules,                                                                              &
-        ONLY:  max_pr_cs
-
-    USE statistics,                                                                                &
-        ONLY:  pr_palm, rmask, sums_l
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  mode  !<
-
-    INTEGER(iwp) ::  i    !< loop index
-    INTEGER(iwp) ::  ib   !< loop index
-    INTEGER(iwp) ::  ic   !< loop index
-    INTEGER(iwp) ::  ii   !< loop index
-    INTEGER(iwp) ::  ind  !< index in the statistical output
-    INTEGER(iwp) ::  j    !< loop index
-    INTEGER(iwp) ::  k    !< loop index
-    INTEGER(iwp) ::  sr   !< statistical region
-    INTEGER(iwp) ::  tn   !< thread number
-
-    REAL(wp) ::  df        !< For calculating LDSA: fraction of particles depositing in the alveolar
-                           !< (or tracheobronchial) region of the lung. Depends on the particle size
-    REAL(wp) ::  mean_d    !< Particle diameter in micrometres
-    REAL(wp) ::  temp_bin  !< temporary variable
-
-    IF ( mode == 'profiles' )  THEN
-       !$OMP DO
-       DO  ii = 1, salsa_pr_count
-
-          ind = pr_palm + max_pr_user + max_pr_cs + ii
-
-          SELECT CASE( salsa_pr_index(ii) )
-
-             CASE( 1 )  ! LDSA
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-   !
-   !--                      Diameter in micrometres
-                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
-   !
-   !--                      Deposition factor: alveolar
-                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
-                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
-                                   1.362_wp )**2 ) )
-   !
-   !--                      Lung-deposited surface area LDSA (units mum2/cm3)
-                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
-                                       aerosol_number(ib)%conc(k,j,i)
-                         ENDDO
-                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
-                                           MERGE( 1.0_wp, 0.0_wp,                                  &
-                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             CASE( 2 )  ! N_UFP
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )                          &
-                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
-                         ENDDO
-                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
-                                           MERGE( 1.0_wp, 0.0_wp,                                  &
-                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             CASE( 3 )  ! Ntot
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
-                         ENDDO
-                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
-                                           MERGE( 1.0_wp, 0.0_wp,                                  &
-                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             CASE( 4 )  ! PM0.1
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
-                                           MERGE( 1.0_wp, 0.0_wp,                                  &
-                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             CASE( 5 )  ! PM2.5
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
-                                           MERGE( 1.0_wp, 0.0_wp,                                  &
-                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-             CASE( 6 )  ! PM10
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr)  *         &
-                                           MERGE( 1.0_wp, 0.0_wp,                                  &
-                                           BTEST( wall_flags_total_0(k,j,i), 22 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-          END SELECT
-       ENDDO
-
-    ELSEIF ( mode == 'time_series' )  THEN
-!
-!--    TODO
-    ENDIF
-
- END SUBROUTINE salsa_statistics
-
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine for averaging 3D data
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_3d_data_averaging( mode, variable )
-
-    USE control_parameters,                                                                        &
-        ONLY:  average_count_3d
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)  ::  mode       !<
-    CHARACTER(LEN=10) ::  vari       !<
-    CHARACTER(LEN=*)  ::  variable   !<
-
-    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
-    INTEGER(iwp) ::  found_index  !<
-    INTEGER(iwp) ::  i            !<
-    INTEGER(iwp) ::  ib           !<
-    INTEGER(iwp) ::  ic           !<
-    INTEGER(iwp) ::  j            !<
-    INTEGER(iwp) ::  k            !<
-
-    REAL(wp) ::  df       !< For calculating LDSA: fraction of particles depositing in the alveolar
-                          !< (or tracheobronchial) region of the lung. Depends on the particle size
-    REAL(wp) ::  mean_d   !< Particle diameter in micrometres
-    REAL(wp) ::  temp_bin !< temporary variable
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
-
-    temp_bin = 0.0_wp
-
-    IF ( mode == 'allocate' )  THEN
-
-       IF ( variable(7:11) ==  'N_bin' )  THEN
-          IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
-             ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-          ENDIF
-          nbins_av = 0.0_wp
-
-       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
-          IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
-             ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-          ENDIF
-          mbins_av = 0.0_wp
-
-       ELSE
-
-          SELECT CASE ( TRIM( variable(7:) ) )
-
-             CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
-                IF ( .NOT. ALLOCATED( salsa_gases_av ) )  THEN
-                   ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
-                ENDIF
-                salsa_gases_av = 0.0_wp
-
-             CASE ( 'LDSA' )
-                IF ( .NOT. ALLOCATED( ldsa_av ) )  THEN
-                   ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ldsa_av = 0.0_wp
-
-             CASE ( 'N_UFP' )
-                IF ( .NOT. ALLOCATED( nufp_av ) )  THEN
-                   ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                nufp_av = 0.0_wp
-
-             CASE ( 'Ntot' )
-                IF ( .NOT. ALLOCATED( ntot_av ) )  THEN
-                   ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ntot_av = 0.0_wp
-
-             CASE ( 'PM0.1' )
-                IF ( .NOT. ALLOCATED( pm01_av ) )  THEN
-                   ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                pm01_av = 0.0_wp
-
-             CASE ( 'PM2.5' )
-                IF ( .NOT. ALLOCATED( pm25_av ) )  THEN
-                   ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                pm25_av = 0.0_wp
-
-             CASE ( 'PM10' )
-                IF ( .NOT. ALLOCATED( pm10_av ) )  THEN
-                   ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                pm10_av = 0.0_wp
-
-             CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
-                IF ( .NOT. ALLOCATED( s_mass_av ) )  THEN
-                   ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass+1) )
-                ENDIF
-                s_mass_av = 0.0_wp
-
-             CASE ( 's_H2O' )
-                IF ( .NOT. ALLOCATED( s_h2o_av ) )  THEN
-                   ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                s_h2o_av = 0.0_wp
-
-             CASE DEFAULT
-                CONTINUE
-
-          END SELECT
-
-       ENDIF
-
-    ELSEIF ( mode == 'sum' )  THEN
-
-       IF ( variable(7:11) ==  'N_bin' )  THEN
-          IF ( ALLOCATED( nbins_av ) )  THEN
-             READ( variable(12:),* ) char_to_int
-             IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-                ib = char_to_int
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
-          IF ( ALLOCATED( mbins_av ) )  THEN
-             READ( variable(12:),* ) char_to_int
-             IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-                ib = char_to_int
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         temp_bin = 0.0_wp
-                         DO  ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol
-                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                         ENDDO
-                         mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + temp_bin
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-       ELSE
-
-          SELECT CASE ( TRIM( variable(7:) ) )
-
-             CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
-                IF ( ALLOCATED( salsa_gases_av ) )  THEN
-
-                   vari = TRIM( variable(9:) )  ! remove salsa_g_ from beginning
-
-                   SELECT CASE( vari )
-
-                      CASE( 'H2SO4' )
-                         found_index = 1
-                      CASE( 'HNO3' )
-                         found_index = 2
-                      CASE( 'NH3' )
-                         found_index = 3
-                      CASE( 'OCNV' )
-                         found_index = 4
-                      CASE( 'OCSV' )
-                         found_index = 5
-
-                   END SELECT
-
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            salsa_gases_av(k,j,i,found_index) = salsa_gases_av(k,j,i,found_index)  &
-                                                                + salsa_gas(found_index)%conc(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'LDSA' )
-                IF ( ALLOCATED( ldsa_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            temp_bin = 0.0_wp
-                            DO  ib = 1, nbins_aerosol
-!
-!--                            Diameter in micrometres
-                               mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
-!
-!--                            Deposition factor: alveolar (use ra_dry)
-                               df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + &
-                                      2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) &
-                                      - 1.362_wp )**2 ) )
-!
-!--                            Lung-deposited surface area LDSA (units mum2/cm3)
-                               temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *             &
-                                          aerosol_number(ib)%conc(k,j,i)
-                            ENDDO
-                            ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'N_UFP' )
-                IF ( ALLOCATED( nufp_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            temp_bin = 0.0_wp
-                            DO  ib = 1, nbins_aerosol
-                               IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
-                                  temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
-                               ENDIF
-                            ENDDO
-                            nufp_av(k,j,i) = nufp_av(k,j,i) + temp_bin
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'Ntot' )
-               IF ( ALLOCATED( ntot_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            DO  ib = 1, nbins_aerosol
-                               ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i)
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'PM0.1' )
-                IF ( ALLOCATED( pm01_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            temp_bin = 0.0_wp
-                            DO  ib = 1, nbins_aerosol
-                               IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
-                                  DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                     temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                                  ENDDO
-                               ENDIF
-                            ENDDO
-                            pm01_av(k,j,i) = pm01_av(k,j,i) + temp_bin
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'PM2.5' )
-                IF ( ALLOCATED( pm25_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            temp_bin = 0.0_wp
-                            DO  ib = 1, nbins_aerosol
-                               IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
-                                  DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                     temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                                  ENDDO
-                               ENDIF
-                            ENDDO
-                            pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'PM10' )
-                IF ( ALLOCATED( pm10_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            temp_bin = 0.0_wp
-                            DO  ib = 1, nbins_aerosol
-                               IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
-                                  DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                     temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                                  ENDDO
-                               ENDIF
-                            ENDDO
-                            pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
-                IF ( ALLOCATED( s_mass_av ) )  THEN
-                   IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
-                      found_index = get_index( prtcl, TRIM( variable(9:) ) )
-                      DO  i = nxlg, nxrg
-                         DO  j = nysg, nyng
-                            DO  k = nzb, nzt+1
-                               DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
-                                  s_mass_av(k,j,i,found_index) = s_mass_av(k,j,i,found_index) +    &
-                                                                 aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ENDIF
-                ENDIF
-
-             CASE ( 's_H2O' )
-                IF ( ALLOCATED( s_H2O_av ) )  THEN
-                   found_index = get_index( prtcl,'H2O' )
-                   to_be_resorted => s_h2o_av
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
-                               s_h2o_av(k,j,i) = s_h2o_av(k,j,i) + aerosol_mass(ic)%conc(k,j,i)
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE DEFAULT
-                CONTINUE
-
-          END SELECT
-
-       ENDIF
-
-    ELSEIF ( mode == 'average' )  THEN
-
-       IF ( variable(7:11) ==  'N_bin' )  THEN
-          IF ( ALLOCATED( nbins_av ) )  THEN
-             READ( variable(12:),* ) char_to_int
-             IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-                ib = char_to_int
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-
-       ELSEIF ( variable(7:11) ==  'm_bin' )  THEN
-          IF ( ALLOCATED( mbins_av ) )  THEN
-             READ( variable(12:),* ) char_to_int
-             IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-                ib = char_to_int
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-       ELSE
-
-          SELECT CASE ( TRIM( variable(7:) ) )
-
-             CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
-                IF ( ALLOCATED( salsa_gases_av ) )  THEN
-                   IF ( TRIM( variable(9:) ) == 'H2SO4' )  THEN  ! 9: remove salsa_g_ from beginning
-                      found_index = 1
-                   ELSEIF ( TRIM( variable(9:) ) == 'HNO3' )  THEN
-                      found_index = 2
-                   ELSEIF ( TRIM( variable(9:) ) == 'NH3' )  THEN
-                      found_index = 3
-                   ELSEIF ( TRIM( variable(9:) ) == 'OCNV' )  THEN
-                      found_index = 4
-                   ELSEIF ( TRIM( variable(9:) ) == 'OCSV' )  THEN
-                      found_index = 5
-                   ENDIF
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            salsa_gases_av(k,j,i,found_index) = salsa_gases_av(k,j,i,found_index)  &
-                                                                / REAL( average_count_3d, KIND=wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'LDSA' )
-                IF ( ALLOCATED( ldsa_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'N_UFP' )
-                IF ( ALLOCATED( nufp_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            nufp_av(k,j,i) = nufp_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'Ntot' )
-                IF ( ALLOCATED( ntot_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'PM0.1' )
-                IF ( ALLOCATED( pm01_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            pm01_av(k,j,i) = pm01_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'PM2.5' )
-                IF ( ALLOCATED( pm25_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 'PM10' )
-                IF ( ALLOCATED( pm10_av ) )  THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         DO  k = nzb, nzt+1
-                            pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-
-             CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
-                IF ( ALLOCATED( s_mass_av ) )  THEN
-                   IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
-                      found_index = get_index( prtcl, TRIM( variable(9:) ) )
-                      DO  i = nxlg, nxrg
-                         DO  j = nysg, nyng
-                            DO  k = nzb, nzt+1
-                               s_mass_av(k,j,i,found_index) = s_mass_av(k,j,i,found_index) /       &
-                                                              REAL( average_count_3d, KIND=wp )
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ENDIF
-                ENDIF
-
-             CASE ( 's_H2O' )
-                to_be_resorted => s_h2o_av
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         to_be_resorted(k,j,i) = to_be_resorted(k,j,i) /                           &
-                                                 REAL( average_count_3d, KIND=wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-
-          END SELECT
-
-       ENDIF
-    ENDIF
-
- END SUBROUTINE salsa_3d_data_averaging
-
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 2D output variables
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do )
-
-    USE indices
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  grid       !<
-    CHARACTER(LEN=*) ::  mode       !<
-    CHARACTER(LEN=*) ::  variable   !<
-    CHARACTER(LEN=5) ::  vari       !<  trimmed format of variable
-
-    INTEGER(iwp) ::  av           !<
-    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
-    INTEGER(iwp) ::  found_index  !< index of a chemical compound
-    INTEGER(iwp) ::  i            !<
-    INTEGER(iwp) ::  ib           !< running index: size bins
-    INTEGER(iwp) ::  ic           !< running index: mass bins
-    INTEGER(iwp) ::  j            !<
-    INTEGER(iwp) ::  k            !<
-    INTEGER(iwp) ::  nzb_do       !<
-    INTEGER(iwp) ::  nzt_do       !<
-
-    LOGICAL ::  found  !<
-    LOGICAL ::  two_d  !< flag parameter to indicate 2D variables (horizontal cross sections)
-
-    REAL(wp) ::  df                       !< For calculating LDSA: fraction of particles
-                                          !< depositing in the alveolar (or tracheobronchial)
-                                          !< region of the lung. Depends on the particle size
-    REAL(wp) ::  mean_d                   !< Particle diameter in micrometres
-    REAL(wp) ::  temp_bin                 !< temporary array for calculating output variables
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< output
-!
-!-- Next statement is to avoid compiler warning about unused variable. May be removed in future.
-    IF ( two_d )  CONTINUE
-
-    found = .TRUE.
-    temp_bin  = 0.0_wp
-
-    IF ( variable(7:11)  == 'N_bin' )  THEN
-
-       READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
-       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-
-          ib = char_to_int
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value,   &
-                                               KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
-                ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-                nbins_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( mode == 'xy' )  grid = 'zu'
-       ENDIF
-
-    ELSEIF ( variable(7:11)  == 'm_bin' )  THEN
-
-       READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int
-       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-
-          ib = char_to_int
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      temp_bin = 0.0_wp
-                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
-                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                      ENDDO
-                      local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),            &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
-                ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-                mbins_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( mode == 'xy' )  grid = 'zu'
-       ENDIF
-
-    ELSE
-
-       SELECT CASE ( TRIM( variable( 7:LEN( TRIM( variable ) ) - 3 ) ) )  ! cut out _xy, _xz or _yz
-
-          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' )
-             vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) )  ! 9: remove salsa_g_
-             IF ( vari == 'H2SO4')  found_index = 1
-             IF ( vari == 'HNO3')   found_index = 2
-             IF ( vari == 'NH3')    found_index = 3
-             IF ( vari == 'OCNV')   found_index = 4
-             IF ( vari == 'OCSV')   found_index = 5
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i),              &
-                                                  REAL( fill_value,  KIND = wp ),                  &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( salsa_gases_av ) )  THEN
-                   ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
-                   salsa_gases_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( salsa_gases_av(k,j,i,found_index),               &
-                                                  REAL( fill_value, KIND = wp ),                   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( mode == 'xy' )  grid = 'zu'
-
-          CASE ( 'LDSA' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-!
-!--                         Diameter in micrometres
-                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
-!
-!--                         Deposition factor: alveolar
-                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
-                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
-                                   1.362_wp )**2 ) )
-!
-!--                         Lung-deposited surface area LDSA (units mum2/cm3)
-                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
-                                       aerosol_number(ib)%conc(k,j,i)
-                         ENDDO
-
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( ldsa_av ) )  THEN
-                   ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   ldsa_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( mode == 'xy' )  grid = 'zu'
-
-          CASE ( 'N_UFP' )
-
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
-                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
-                            ENDIF
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( nufp_av ) )  THEN
-                   ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   nufp_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( mode == 'xy' )  grid = 'zu'
-
-          CASE ( 'Ntot' )
-
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( ntot_av ) )  THEN
-                   ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   ntot_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( mode == 'xy' )  grid = 'zu'
-
-          CASE ( 'PM0.1' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( pm01_av ) )  THEN
-                   ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   pm01_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( mode == 'xy' )  grid = 'zu'
-
-          CASE ( 'PM2.5' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( pm25_av ) )  THEN
-                   ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   pm25_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( mode == 'xy' )  grid = 'zu'
-
-          CASE ( 'PM10' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin,  REAL( fill_value, KIND = wp ),        &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( pm10_av ) )  THEN
-                   ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   pm10_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( mode == 'xy' )  grid = 'zu'
-
-          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
-             vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) )  ! 9: remove salsa_s_
-             IF ( is_used( prtcl, vari ) )  THEN
-                found_index = get_index( prtcl, vari )
-                IF ( av == 0 )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb_do, nzt_do
-                            temp_bin = 0.0_wp
-                            DO  ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
-                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                            ENDDO
-                            local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),      &
-                                                     BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( s_mass_av ) )  THEN
-                      ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) )
-                      s_mass_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb_do, nzt_do
-                            local_pf(i,j,k) = MERGE( s_mass_av(k,j,i,found_index),                 &
-                                                     REAL( fill_value, KIND = wp ),                &
-                                                     BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-             ELSE
-                local_pf = fill_value
-             ENDIF
-
-             IF ( mode == 'xy' )  grid = 'zu'
-
-          CASE ( 's_H2O' )
-             found_index = get_index( prtcl, 'H2O' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol
-                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-     !           to_be_resorted => s_h2o_av
-                IF ( .NOT. ALLOCATED( s_h2o_av ) )  THEN
-                   ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   s_h2o_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( s_h2o_av(k,j,i), REAL( fill_value, KIND = wp ),  &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( mode == 'xy' )  grid = 'zu'
-
-          CASE DEFAULT
-             found = .FALSE.
-             grid  = 'none'
-
-       END SELECT
-
-    ENDIF
-
- END SUBROUTINE salsa_data_output_2d
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining 3D output variables
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-
-    USE indices
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(in) ::  variable   !<
-
-    INTEGER(iwp) ::  av           !<
-    INTEGER(iwp) ::  char_to_int  !< for converting character to integer
-    INTEGER(iwp) ::  found_index  !< index of a chemical compound
-    INTEGER(iwp) ::  ib           !< running index: size bins
-    INTEGER(iwp) ::  ic           !< running index: mass bins
-    INTEGER(iwp) ::  i            !<
-    INTEGER(iwp) ::  j            !<
-    INTEGER(iwp) ::  k            !<
-    INTEGER(iwp) ::  nzb_do       !<
-    INTEGER(iwp) ::  nzt_do       !<
-
-    LOGICAL ::  found      !<
-
-    REAL(wp) ::  df                       !< For calculating LDSA: fraction of particles
-                                          !< depositing in the alveolar (or tracheobronchial)
-                                          !< region of the lung. Depends on the particle size
-    REAL(wp) ::  mean_d                   !< Particle diameter in micrometres
-    REAL(wp) ::  temp_bin                 !< temporary array for calculating output variables
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< local
-
-    found     = .TRUE.
-    temp_bin  = 0.0_wp
-
-    IF ( variable(7:11) == 'N_bin' )  THEN
-       READ( variable(12:),* ) char_to_int
-       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-
-          ib = char_to_int
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value,   &
-                                               KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( nbins_av ) )  THEN
-                ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-                nbins_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-
-    ELSEIF ( variable(7:11) == 'm_bin' )  THEN
-       READ( variable(12:),* ) char_to_int
-       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-
-          ib = char_to_int
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      temp_bin = 0.0_wp
-                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
-                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                      ENDDO
-                      local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),            &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSE
-             IF ( .NOT. ALLOCATED( mbins_av ) )  THEN
-                ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) )
-                mbins_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ),  &
-                                               BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-
-    ELSE
-       SELECT CASE ( TRIM( variable(7:) ) )
-
-          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
-             IF ( TRIM( variable(7:) ) == 'g_H2SO4')  found_index = 1
-             IF ( TRIM( variable(7:) ) == 'g_HNO3')   found_index = 2
-             IF ( TRIM( variable(7:) ) == 'g_NH3')    found_index = 3
-             IF ( TRIM( variable(7:) ) == 'g_OCNV')   found_index = 4
-             IF ( TRIM( variable(7:) ) == 'g_OCSV')   found_index = 5
-
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i),              &
-                                                  REAL( fill_value, KIND = wp ),                   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( salsa_gases_av ) )  THEN
-                   ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) )
-                   salsa_gases_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-!                          local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value,         &
-!                                                KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                         local_pf(i,j,k) = MERGE( salsa_gases_av(k,j,i,found_index),               &
-                                                  REAL( fill_value, KIND = wp ),                   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'LDSA' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-!
-!--                         Diameter in micrometres
-                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
-!
-!--                         Deposition factor: alveolar
-                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
-                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
-                                   1.362_wp )**2 ) )
-!
-!--                         Lung-deposited surface area LDSA (units mum2/cm3)
-                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
-                                       aerosol_number(ib)%conc(k,j,i)
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( ldsa_av ) )  THEN
-                   ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   ldsa_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'N_UFP' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
-                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
-                            ENDIF
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( nufp_av ) )  THEN
-                   ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   nufp_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'Ntot' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( ntot_av ) )  THEN
-                   ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   ntot_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'PM0.1' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( pm01_av ) )  THEN
-                   ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   pm01_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'PM2.5' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( pm25_av ) )  THEN
-                   ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   pm25_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'PM10' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( pm10_av ) )  THEN
-                   ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   pm10_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ),   &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
-             IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN  ! 9: remove salsa_s_
-                found_index = get_index( prtcl, TRIM( variable(9:) ) )
-                IF ( av == 0 )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb_do, nzt_do
-                            temp_bin = 0.0_wp
-                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
-                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                            ENDDO
-                            local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),      &
-                                                     BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                   IF ( .NOT. ALLOCATED( s_mass_av ) )  THEN
-                      ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) )
-                      s_mass_av = REAL( fill_value, KIND = wp )
-                   ENDIF
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb_do, nzt_do
-                            local_pf(i,j,k) = MERGE( s_mass_av(k,j,i,found_index),                 &
-                                                     REAL( fill_value, KIND = wp ),                &
-                                                     BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-             ENDIF
-
-          CASE ( 's_H2O' )
-             found_index = get_index( prtcl, 'H2O' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         temp_bin = 0.0_wp
-                         DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
-                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                         ENDDO
-                         local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ),         &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                IF ( .NOT. ALLOCATED( s_h2o_av ) )  THEN
-                   ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                   s_h2o_av = REAL( fill_value, KIND = wp )
-                ENDIF
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_do, nzt_do
-                         local_pf(i,j,k) = MERGE( s_h2o_av(k,j,i), REAL( fill_value, KIND = wp ),  &
-                                                  BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE DEFAULT
-             found = .FALSE.
-
-       END SELECT
-    ENDIF
-
- END SUBROUTINE salsa_data_output_3d
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining mask output variables
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf, mid )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  tend
-
-    USE control_parameters,                                                                        &
-        ONLY:  mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=5) ::  grid      !< flag to distinquish between staggered grid
-    CHARACTER(LEN=*) ::  variable  !<
-    CHARACTER(LEN=7) ::  vari      !< trimmed format of variable
-
-    INTEGER(iwp) ::  av             !<
-    INTEGER(iwp) ::  char_to_int    !< for converting character to integer
-    INTEGER(iwp) ::  found_index    !< index of a chemical compound
-    INTEGER(iwp) ::  ib             !< loop index for aerosol size number bins
-    INTEGER(iwp) ::  ic             !< loop index for chemical components
-    INTEGER(iwp) ::  i              !< loop index in x-direction
-    INTEGER(iwp) ::  j              !< loop index in y-direction
-    INTEGER(iwp) ::  k              !< loop index in z-direction
-    INTEGER(iwp) ::  im             !< loop index for masked variables
-    INTEGER(iwp) ::  jm             !< loop index for masked variables
-    INTEGER(iwp) ::  kk             !< loop index for masked output in z-direction
-    INTEGER(iwp) ::  mid            !< masked output running index
-    INTEGER(iwp) ::  ktt            !< k index of lowest non-terrain grid point
-
-    LOGICAL ::  found      !<
-    LOGICAL ::  resorted   !<
-
-    REAL(wp) ::  df        !< For calculating LDSA: fraction of particles depositing in the alveolar
-                           !< (or tracheobronchial) region of the lung. Depends on the particle size
-    REAL(wp) ::  mean_d    !< Particle diameter in micrometres
-    REAL(wp) ::  temp_bin  !< temporary array for calculating output variables
-
-    REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  local_pf   !<
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), TARGET ::  temp_array  !< temporary array
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< pointer
-
-    found      = .TRUE.
-    resorted   = .FALSE.
-    grid       = 's'
-    tend       = 0.0_wp
-    temp_array = 0.0_wp
-    temp_bin   = 0.0_wp
-
-    IF ( variable(7:11) == 'N_bin' )  THEN
-       READ( variable(12:),* ) char_to_int
-       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-          ib = char_to_int
-          IF ( av == 0 )  THEN
-             IF ( .NOT. mask_surface(mid) )  THEN
-                DO  i = 1, mask_size_l(mid,1)
-                   DO  j = 1, mask_size_l(mid,2)
-                      DO  k = 1, mask_size_l(mid,3)
-                         local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j),  &
-                                                                    mask_i(mid,i) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                DO  i = 1, mask_size_l(mid,1)
-                   DO  j = 1, mask_size_l(mid,2)
-!
-!--                   Get k index of the lowest non-terrain grid point
-                      im = mask_i(mid,i)
-                      jm = mask_j(mid,j)
-                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ),        &
-                                    DIM = 1 ) - 1
-                      DO  k = 1, mask_size_l(mid,3)
-                         kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                      Set value if not in building, else set fill value
-                         IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                            local_pf(i,j,k) = fill_value
-                         ELSE
-                            local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im)
-                         ENDIF
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-             resorted = .TRUE.
-          ELSE
-             temp_array = nbins_av(:,:,:,ib)
-             to_be_resorted => temp_array
-          ENDIF
-       ENDIF
-
-    ELSEIF ( variable(7:11) == 'm_bin' )  THEN
-
-       READ( variable(12:),* ) char_to_int
-       IF ( char_to_int >= 1  .AND. char_to_int <= SUM( nbin ) )  THEN
-
-          ib = char_to_int
-          IF ( av == 0 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb, nz_do3d
-                      temp_bin = 0.0_wp
-                      DO  ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol
-                         temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                      ENDDO
-                      tend(k,j,i) = temp_bin
-                   ENDDO
-                ENDDO
-             ENDDO
-             IF ( .NOT. mask_surface(mid) )  THEN
-                DO  i = 1, mask_size_l(mid,1)
-                   DO  j = 1, mask_size_l(mid,2)
-                      DO  k = 1, mask_size_l(mid,3)
-                         local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSE
-                DO  i = 1, mask_size_l(mid,1)
-                   DO  j = 1, mask_size_l(mid,2)
-!
-!--                   Get k index of the lowest non-terrain grid point
-                      im = mask_i(mid,i)
-                      jm = mask_j(mid,j)
-                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),         &
-                                           DIM = 1 ) - 1
-                      DO  k = 1, mask_size_l(mid,3)
-                         kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                      Set value if not in building, else set fill value
-                         IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                            local_pf(i,j,k) = fill_value
-                         ELSE
-                            local_pf(i,j,k) = tend(kk,jm,im)
-                         ENDIF
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-             resorted = .TRUE.
-          ELSE
-             temp_array = mbins_av(:,:,:,ib)
-             to_be_resorted => temp_array
-          ENDIF
-       ENDIF
-
-    ELSE
-       SELECT CASE ( TRIM( variable(7:) ) )
-
-          CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV',  'g_OCSV' )
-             vari = TRIM( variable(7:) )
-             IF ( av == 0 )  THEN
-                IF ( vari == 'g_H2SO4')  to_be_resorted => salsa_gas(1)%conc
-                IF ( vari == 'g_HNO3')   to_be_resorted => salsa_gas(2)%conc
-                IF ( vari == 'g_NH3')    to_be_resorted => salsa_gas(3)%conc
-                IF ( vari == 'g_OCNV')   to_be_resorted => salsa_gas(4)%conc
-                IF ( vari == 'g_OCSV')   to_be_resorted => salsa_gas(5)%conc
-             ELSE
-                IF ( vari == 'g_H2SO4') temp_array = salsa_gases_av(:,:,:,1)
-                IF ( vari == 'g_HNO3')  temp_array = salsa_gases_av(:,:,:,2)
-                IF ( vari == 'g_NH3')   temp_array = salsa_gases_av(:,:,:,3)
-                IF ( vari == 'g_OCNV')  temp_array = salsa_gases_av(:,:,:,4)
-                IF ( vari == 'g_OCSV')  temp_array = salsa_gases_av(:,:,:,5)
-                to_be_resorted => temp_array
-             ENDIF
-
-          CASE ( 'LDSA' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nz_do3d
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-!
-!--                         Diameter in micrometres
-                            mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp
-!
-!--                         Deposition factor: alveolar
-                            df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) +    &
-                                   2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) -  &
-                                   1.362_wp )**2 ) )
-!
-!--                         Lung-deposited surface area LDSA (units mum2/cm3)
-                            temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp *                &
-                                       aerosol_number(ib)%conc(k,j,i)
-                         ENDDO
-                         tend(k,j,i) = temp_bin
-                      ENDDO
-                   ENDDO
-                ENDDO
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) = tend(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                to_be_resorted => ldsa_av
-             ENDIF
-
-          CASE ( 'N_UFP' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nz_do3d
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
-                               temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
-                            ENDIF
-                         ENDDO
-                         tend(k,j,i) = temp_bin
-                      ENDDO
-                   ENDDO
-                ENDDO
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) = tend(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                to_be_resorted => nufp_av
-             ENDIF
-
-          CASE ( 'Ntot' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nz_do3d
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i)
-                         ENDDO
-                         tend(k,j,i) = temp_bin
-                      ENDDO
-                   ENDDO
-                ENDDO
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) = tend(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                to_be_resorted => ntot_av
-             ENDIF
-
-          CASE ( 'PM0.1' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nz_do3d
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         tend(k,j,i) = temp_bin
-                      ENDDO
-                   ENDDO
-                ENDDO
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) = tend(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                to_be_resorted => pm01_av
-             ENDIF
-
-          CASE ( 'PM2.5' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nz_do3d
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         tend(k,j,i) = temp_bin
-                      ENDDO
-                   ENDDO
-                ENDDO
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ),     &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) = tend(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                to_be_resorted => pm25_av
-             ENDIF
-
-          CASE ( 'PM10' )
-             IF ( av == 0 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nz_do3d
-                         temp_bin = 0.0_wp
-                         DO  ib = 1, nbins_aerosol
-                            IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp )  THEN
-                               DO  ic = ib, nbins_aerosol * ncc, nbins_aerosol
-                                  temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                               ENDDO
-                            ENDIF
-                         ENDDO
-                         tend(k,j,i) = temp_bin
-                      ENDDO
-                   ENDDO
-                ENDDO
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) = tend( mask_k(mid,k),  mask_j(mid,j), mask_i(mid,i) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) = tend(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                to_be_resorted => pm10_av
-             ENDIF
-
-          CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' )
-             IF ( is_used( prtcl, TRIM( variable(9:) ) ) )  THEN
-                found_index = get_index( prtcl, TRIM( variable(9:) ) )
-                IF ( av == 0 )  THEN
-                   DO  i = nxl, nxr
-                      DO  j = nys, nyn
-                         DO  k = nzb, nz_do3d
-                            temp_bin = 0.0_wp
-                            DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
-                               temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                            ENDDO
-                            tend(k,j,i) = temp_bin
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                   IF ( .NOT. mask_surface(mid) )  THEN
-                      DO  i = 1, mask_size_l(mid,1)
-                         DO  j = 1, mask_size_l(mid,2)
-                            DO  k = 1, mask_size_l(mid,3)
-                               local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ELSE
-                      DO  i = 1, mask_size_l(mid,1)
-                         DO  j = 1, mask_size_l(mid,2)
-   !
-   !--                      Get k index of the lowest non-terrain grid point
-                            im = mask_i(mid,i)
-                            jm = mask_j(mid,j)
-                            ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),   &
-                                          DIM = 1 ) - 1
-                            DO  k = 1, mask_size_l(mid,3)
-                               kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-   !
-   !--                         Set value if not in building, else set fill value
-                               IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                                  local_pf(i,j,k) = fill_value
-                               ELSE
-                                  local_pf(i,j,k) = tend(kk,jm,im)
-                               ENDIF
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ENDIF
-                   resorted = .TRUE.
-                ELSE
-                   temp_array = s_mass_av(:,:,:,found_index)
-                   to_be_resorted => temp_array
-                ENDIF
-             ELSE
-                local_pf = fill_value
-             ENDIF
-
-          CASE ( 's_H2O' )
-             IF ( av == 0 )  THEN
-                found_index = get_index( prtcl, 'H2O' )
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nz_do3d
-                         temp_bin = 0.0_wp
-                         DO  ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol
-                            temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i)
-                         ENDDO
-                         tend(k,j,i) = temp_bin
-                      ENDDO
-                   ENDDO
-                ENDDO
-                IF ( .NOT. mask_surface(mid) )  THEN
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-                         DO  k = 1, mask_size_l(mid,3)
-                            local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                   DO  i = 1, mask_size_l(mid,1)
-                      DO  j = 1, mask_size_l(mid,2)
-!
-!--                      Get k index of the lowest non-terrain grid point
-                         im = mask_i(mid,i)
-                         jm = mask_j(mid,j)
-                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
-                                       DIM = 1 ) - 1
-                         DO  k = 1, mask_size_l(mid,3)
-                            kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                         Set value if not in building, else set fill value
-                            IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                               local_pf(i,j,k) = fill_value
-                            ELSE
-                               local_pf(i,j,k) =  tend(kk,jm,im)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-             ELSE
-                to_be_resorted => s_h2o_av
-             ENDIF
-
-          CASE DEFAULT
-             found = .FALSE.
-
-       END SELECT
-    ENDIF
-
-    IF ( found  .AND.  .NOT. resorted )  THEN
-       IF ( .NOT. mask_surface(mid) )  THEN
-!
-!--       Default masked output
-          DO  i = 1, mask_size_l(mid,1)
-             DO  j = 1, mask_size_l(mid,2)
-                DO  k = 1, mask_size_l(mid,3)
-                   local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
-                ENDDO
-             ENDDO
-          ENDDO
-       ELSE
-!
-!--       Terrain-following masked output
-          DO  i = 1, mask_size_l(mid,1)
-             DO  j = 1, mask_size_l(mid,2)
-!
-!--             Get k index of the lowest non-terrain grid point
-                im = mask_i(mid,i)
-                jm = mask_j(mid,j)
-                ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), DIM = 1 ) - 1
-                DO  k = 1, mask_size_l(mid,3)
-                   kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
-!
-!--                Set value if not in building, else set fill value
-                   IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) )  THEN
-                      local_pf(i,j,k) = fill_value
-                   ELSE
-                      local_pf(i,j,k) = to_be_resorted(kk,jm,im)
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
- END SUBROUTINE salsa_data_output_mask
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Creates index tables for different (aerosol) components
-!------------------------------------------------------------------------------!
- SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ii  !<
-    INTEGER(iwp) ::  jj  !<
-
-    INTEGER(iwp), INTENT(in) ::  nlist ! < Maximum number of components
-
-    INTEGER(iwp), INTENT(inout) ::  ncomp  !< Number of components
-
-    CHARACTER(LEN=3), INTENT(in) ::  listcomp(nlist)  !< List cof component names
-
-    TYPE(component_index), INTENT(inout) ::  self  !< Object containing the indices of different
-                                                   !< aerosol components
-
-    ncomp = 0
-
-    DO WHILE ( listcomp(ncomp+1) /= '  ' .AND. ncomp < nlist )
-       ncomp = ncomp + 1
-       IF ( ncomp > 6 )  EXIT
-    ENDDO
-
-    self%ncomp = ncomp
-    ALLOCATE( self%ind(ncomp), self%comp(ncomp) )
-
-    DO  ii = 1, ncomp
-       self%ind(ii) = ii
-    ENDDO
-
-    jj = 1
-    DO  ii = 1, nlist
-       IF ( listcomp(ii) == '') CYCLE
-       self%comp(jj) = listcomp(ii)
-       jj = jj + 1
-    ENDDO
-
- END SUBROUTINE component_index_constructor
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Gives the index of a component in the component list
-!------------------------------------------------------------------------------!
- INTEGER FUNCTION get_index( self, incomp )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(in) ::  incomp !< Component name
-
-    INTEGER(iwp) ::  ii  !< index
-
-    TYPE(component_index), INTENT(in) ::  self  !< Object containing the indices of different
-                                                !< aerosol components
-    IF ( ANY( self%comp == incomp ) )  THEN
-       ii = 1
-       DO WHILE ( (self%comp(ii) /= incomp) )
-          ii = ii + 1
-       ENDDO
-       get_index = ii
-    ELSEIF ( incomp == 'H2O' )  THEN
-       get_index = self%ncomp + 1
-    ELSE
-       WRITE( message_string, * ) 'Incorrect component name given!'
-       CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 )
-    ENDIF
-
- END FUNCTION get_index
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Tells if the (aerosol) component is being used in the simulation
-!------------------------------------------------------------------------------!
- LOGICAL FUNCTION is_used( self, icomp )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(in) ::  icomp !< Component name
-
-    TYPE(component_index), INTENT(in) ::  self  !< Object containing the indices of different
-                                                !< aerosol components
-
-    IF ( ANY(self%comp == icomp) ) THEN
-       is_used = .TRUE.
-    ELSE
-       is_used = .FALSE.
-    ENDIF
-
- END FUNCTION
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the lateral and top boundary conditions in case the PALM domain is
-!> nested offline in a mesoscale model. Further, average boundary data and
-!> determine mean profiles, further used for correct damping in the sponge
-!> layer.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_nesting_offl_bc
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, dt_3d,              &
-               time_since_reference_point
-
-    USE exchange_horiz_mod,                                                    &
-        ONLY:  exchange_horiz
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i    !< running index x-direction
-    INTEGER(iwp) ::  ib   !< running index for aerosol number bins
-    INTEGER(iwp) ::  ic   !< running index for aerosol mass bins
-    INTEGER(iwp) ::  icc  !< running index for aerosol mass bins
-    INTEGER(iwp) ::  ig   !< running index for gaseous species
-    INTEGER(iwp) ::  j    !< running index y-direction
-    INTEGER(iwp) ::  k    !< running index z-direction
-
-    REAL(wp) ::  fac_dt  !< interpolation factor
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_mconc    !< reference profile for aerosol mass
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_mconc_l  !< reference profile for aerosol mass: subdomain
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_nconc    !< reference profile for aerosol number
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_nconc_l  !< reference profile for aerosol_number: subdomain
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_gconc    !< reference profile for gases
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_gconc_l  !< reference profile for gases: subdomain
-
-!
-!-- Skip input if no forcing from larger-scale models is applied.
-    IF ( .NOT. nesting_offline_salsa )  RETURN
-!
-!-- Allocate temporary arrays to compute salsa mean profiles
-    ALLOCATE( ref_gconc(nzb:nzt+1,1:ngases_salsa), ref_gconc_l(nzb:nzt+1,1:ngases_salsa),          &
-              ref_mconc(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass),                               &
-              ref_mconc_l(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass),                             &
-              ref_nconc(nzb:nzt+1,1:nbins_aerosol), ref_nconc_l(nzb:nzt+1,1:nbins_aerosol) )
-    ref_gconc   = 0.0_wp
-    ref_gconc_l = 0.0_wp
-    ref_mconc   = 0.0_wp
-    ref_mconc_l = 0.0_wp
-    ref_nconc   = 0.0_wp
-    ref_nconc_l = 0.0_wp
-
-!
-!-- Determine interpolation factor and limit it to 1. This is because t+dt can slightly exceed
-!-- time(tind_p) before boundary data is updated again.
-    fac_dt = ( time_since_reference_point - salsa_nest_offl%time(salsa_nest_offl%tind) + dt_3d ) / &
-             ( salsa_nest_offl%time(salsa_nest_offl%tind_p) -                                      &
-               salsa_nest_offl%time(salsa_nest_offl%tind) )
-    fac_dt = MIN( 1.0_wp, fac_dt )
-
-    IF ( bc_dirichlet_l )  THEN
-       DO  ib = 1, nbins_aerosol
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                aerosol_number(ib)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) *                            &
-                                                  salsa_nest_offl%nconc_left(0,k,j,ib) + fac_dt *  &
-                                                  salsa_nest_offl%nconc_left(1,k,j,ib)
-             ENDDO
-             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
-                                         aerosol_number(ib)%conc(nzb+1:nzt,j,-1)
-          ENDDO
-          DO  ic = 1, ncomponents_mass
-             icc = ( ic-1 ) * nbins_aerosol + ib
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   aerosol_mass(icc)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) *                          &
-                                                    salsa_nest_offl%mconc_left(0,k,j,icc) + fac_dt &
-                                                    * salsa_nest_offl%mconc_left(1,k,j,icc)
-                ENDDO
-                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
-                                             aerosol_mass(icc)%conc(nzb+1:nzt,j,-1)
-             ENDDO
-          ENDDO
-       ENDDO
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-          DO  ig = 1, ngases_salsa
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   salsa_gas(ig)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) *                              &
-                                                salsa_nest_offl%gconc_left(0,k,j,ig) + fac_dt *    &
-                                                salsa_nest_offl%gconc_left(1,k,j,ig)
-                ENDDO
-                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
-                                            salsa_gas(ig)%conc(nzb+1:nzt,j,-1)
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
-    IF ( bc_dirichlet_r )  THEN
-       DO  ib = 1, nbins_aerosol
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                aerosol_number(ib)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) *                         &
-                                                  salsa_nest_offl%nconc_right(0,k,j,ib) + fac_dt * &
-                                                  salsa_nest_offl%nconc_right(1,k,j,ib)
-             ENDDO
-             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
-                                         aerosol_number(ib)%conc(nzb+1:nzt,j,nxr+1)
-          ENDDO
-          DO  ic = 1, ncomponents_mass
-             icc = ( ic-1 ) * nbins_aerosol + ib
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   aerosol_mass(icc)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) *                       &
-                                                    salsa_nest_offl%mconc_right(0,k,j,icc) + fac_dt&
-                                                    * salsa_nest_offl%mconc_right(1,k,j,icc)
-                ENDDO
-                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
-                                             aerosol_mass(icc)%conc(nzb+1:nzt,j,nxr+1)
-             ENDDO
-          ENDDO
-       ENDDO
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-          DO  ig = 1, ngases_salsa
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   salsa_gas(ig)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) *                           &
-                                                   salsa_nest_offl%gconc_right(0,k,j,ig) + fac_dt *&
-                                                   salsa_nest_offl%gconc_right(1,k,j,ig)
-                ENDDO
-                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
-                                            salsa_gas(ig)%conc(nzb+1:nzt,j,nxr+1)
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
-    IF ( bc_dirichlet_n )  THEN
-       DO  ib = 1, nbins_aerosol
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt
-                aerosol_number(ib)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) *                         &
-                                                  salsa_nest_offl%nconc_north(0,k,i,ib) + fac_dt * &
-                                                  salsa_nest_offl%nconc_north(1,k,i,ib)
-             ENDDO
-             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
-                                         aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,i)
-          ENDDO
-          DO  ic = 1, ncomponents_mass
-             icc = ( ic-1 ) * nbins_aerosol + ib
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   aerosol_mass(icc)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) *                       &
-                                                    salsa_nest_offl%mconc_north(0,k,i,icc) + fac_dt&
-                                                    * salsa_nest_offl%mconc_north(1,k,i,icc)
-                ENDDO
-                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
-                                             aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,i)
-             ENDDO
-          ENDDO
-       ENDDO
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-          DO  ig = 1, ngases_salsa
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   salsa_gas(ig)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) *                           &
-                                                   salsa_nest_offl%gconc_north(0,k,i,ig) + fac_dt *&
-                                                   salsa_nest_offl%gconc_north(1,k,i,ig)
-                ENDDO
-                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
-                                            salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,i)
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
-    IF ( bc_dirichlet_s )  THEN
-       DO  ib = 1, nbins_aerosol
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt
-                aerosol_number(ib)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) *                            &
-                                                  salsa_nest_offl%nconc_south(0,k,i,ib) + fac_dt * &
-                                                  salsa_nest_offl%nconc_south(1,k,i,ib)
-             ENDDO
-             ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) +                               &
-                                         aerosol_number(ib)%conc(nzb+1:nzt,-1,i)
-          ENDDO
-          DO  ic = 1, ncomponents_mass
-             icc = ( ic-1 ) * nbins_aerosol + ib
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   aerosol_mass(icc)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) *                          &
-                                                    salsa_nest_offl%mconc_south(0,k,i,icc) + fac_dt&
-                                                    * salsa_nest_offl%mconc_south(1,k,i,icc)
-                ENDDO
-                ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) +                          &
-                                             aerosol_mass(icc)%conc(nzb+1:nzt,-1,i)
-             ENDDO
-          ENDDO
-       ENDDO
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-          DO  ig = 1, ngases_salsa
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   salsa_gas(ig)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) *                              &
-                                                salsa_nest_offl%gconc_south(0,k,i,ig) + fac_dt *   &
-                                                salsa_nest_offl%gconc_south(1,k,i,ig)
-                ENDDO
-                ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) +                            &
-                                            salsa_gas(ig)%conc(nzb+1:nzt,-1,i)
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Top boundary
-    DO  ib = 1, nbins_aerosol
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             aerosol_number(ib)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) *                            &
-                                                  salsa_nest_offl%nconc_top(0,j,i,ib) + fac_dt *   &
-                                                  salsa_nest_offl%nconc_top(1,j,i,ib)
-             ref_nconc_l(nzt+1,ib) = ref_nconc_l(nzt+1,ib) + aerosol_number(ib)%conc(nzt+1,j,i)
-          ENDDO
-       ENDDO
-       DO  ic = 1, ncomponents_mass
-          icc = ( ic-1 ) * nbins_aerosol + ib
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                aerosol_mass(icc)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) *                          &
-                                                    salsa_nest_offl%mconc_top(0,j,i,icc) + fac_dt *&
-                                                    salsa_nest_offl%mconc_top(1,j,i,icc)
-                ref_mconc_l(nzt+1,icc) = ref_mconc_l(nzt+1,icc) + aerosol_mass(icc)%conc(nzt+1,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       DO  ig = 1, ngases_salsa
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                salsa_gas(ig)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) *                              &
-                                                salsa_nest_offl%gconc_top(0,j,i,ig) + fac_dt *     &
-                                                salsa_nest_offl%gconc_top(1,j,i,ig)
-                ref_gconc_l(nzt+1,ig) = ref_gconc_l(nzt+1,ig) + salsa_gas(ig)%conc(nzt+1,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Do local exchange
-    DO  ib = 1, nbins_aerosol
-       CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
-       DO  ic = 1, ncomponents_mass
-          icc = ( ic-1 ) * nbins_aerosol + ib
-          CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
-       ENDDO
-    ENDDO
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       DO  ig = 1, ngases_salsa
-          CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
-       ENDDO
-    ENDIF
-!
-!-- In case of Rayleigh damping, where the initial profiles are still used, update these profiles
-!-- from the averaged boundary data. But first, average these data.
-#if defined( __parallel )
-    IF ( .NOT. salsa_gases_from_chem )                                                             &
-       CALL MPI_ALLREDUCE( ref_gconc_l, ref_gconc, ( nzt+1-nzb+1 ) * SIZE( ref_gconc(nzb,:) ),     &
-                           MPI_REAL, MPI_SUM, comm2d, ierr )
-    CALL MPI_ALLREDUCE( ref_mconc_l, ref_mconc, ( nzt+1-nzb+1 ) * SIZE( ref_mconc(nzb,:) ),        &
-                        MPI_REAL, MPI_SUM, comm2d, ierr )
-    CALL MPI_ALLREDUCE( ref_nconc_l, ref_nconc, ( nzt+1-nzb+1 ) * SIZE( ref_nconc(nzb,:) ),        &
-                        MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    IF ( .NOT. salsa_gases_from_chem )  ref_gconc = ref_gconc_l
-    ref_mconc = ref_mconc_l
-    ref_nconc = ref_nconc_l
-#endif
-!
-!-- Average data. Note, reference profiles up to nzt are derived from lateral boundaries, at the
-!-- model top it is derived from the top boundary. Thus, number of input data is different from
-!-- nzb:nzt compared to nzt+1.
-!-- Derived from lateral boundaries.
-    IF ( .NOT. salsa_gases_from_chem )                                                             &
-       ref_gconc(nzb:nzt,:) = ref_gconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
-    ref_mconc(nzb:nzt,:) = ref_mconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
-    ref_nconc(nzb:nzt,:) = ref_nconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
-!
-!-- Derived from top boundary
-    IF ( .NOT. salsa_gases_from_chem )                                                             &
-       ref_gconc(nzt+1,:) = ref_gconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
-    ref_mconc(nzt+1,:) = ref_mconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
-    ref_nconc(nzt+1,:) = ref_nconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
-!
-!-- Write onto init profiles, which are used for damping. Also set lower boundary condition.
-    DO  ib = 1, nbins_aerosol
-       aerosol_number(ib)%init(:)   = ref_nconc(:,ib)
-       aerosol_number(ib)%init(nzb) = aerosol_number(ib)%init(nzb+1)
-       DO  ic = 1, ncomponents_mass
-          icc = ( ic-1 ) * nbins_aerosol + ib
-          aerosol_mass(icc)%init(:)   = ref_mconc(:,icc)
-          aerosol_mass(icc)%init(nzb) = aerosol_mass(icc)%init(nzb+1)
-       ENDDO
-    ENDDO
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       DO  ig = 1, ngases_salsa
-          salsa_gas(ig)%init(:)   = ref_gconc(:,ig)
-          salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1)
-       ENDDO
-    ENDIF
-
-    DEALLOCATE( ref_gconc, ref_gconc_l, ref_mconc, ref_mconc_l, ref_nconc, ref_nconc_l )
-
- END SUBROUTINE salsa_nesting_offl_bc
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate arrays used to read boundary data from NetCDF file and initialize
-!> boundary data.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_nesting_offl_init
-
-    USE control_parameters,                                                                        &
-        ONLY:  end_time, spinup_time
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  get_date_time
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ib          !< running index for aerosol number bins
-    INTEGER(iwp) ::  ic          !< running index for aerosol mass bins
-    INTEGER(iwp) ::  icc         !< additional running index for aerosol mass bins
-    INTEGER(iwp) ::  ig          !< running index for gaseous species
-    INTEGER(iwp) ::  nmass_bins  !< number of aerosol mass bins
-
-    nmass_bins = nbins_aerosol * ncomponents_mass
-!
-!-- Allocate arrays for reading boundary values. Arrays will incorporate 2 time levels in order to
-!-- interpolate in between.
-    IF ( nesting_offline_salsa )  THEN
-       IF ( bc_dirichlet_l )  THEN
-          ALLOCATE( salsa_nest_offl%nconc_left(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
-          ALLOCATE( salsa_nest_offl%mconc_left(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
-       ENDIF
-       IF ( bc_dirichlet_r )  THEN
-          ALLOCATE( salsa_nest_offl%nconc_right(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) )
-          ALLOCATE( salsa_nest_offl%mconc_right(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) )
-       ENDIF
-       IF ( bc_dirichlet_n )  THEN
-          ALLOCATE( salsa_nest_offl%nconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
-          ALLOCATE( salsa_nest_offl%mconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
-       ENDIF
-       IF ( bc_dirichlet_s )  THEN
-          ALLOCATE( salsa_nest_offl%nconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) )
-          ALLOCATE( salsa_nest_offl%mconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) )
-       ENDIF
-       ALLOCATE( salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol) )
-       ALLOCATE( salsa_nest_offl%mconc_top(0:1,nys:nyn,nxl:nxr,1:nmass_bins) )
-
-       IF ( .NOT. salsa_gases_from_chem )  THEN
-          IF ( bc_dirichlet_l )  THEN
-             ALLOCATE( salsa_nest_offl%gconc_left(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
-          ENDIF
-          IF ( bc_dirichlet_r )  THEN
-             ALLOCATE( salsa_nest_offl%gconc_right(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) )
-          ENDIF
-          IF ( bc_dirichlet_n )  THEN
-             ALLOCATE( salsa_nest_offl%gconc_north(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
-          ENDIF
-          IF ( bc_dirichlet_s )  THEN
-             ALLOCATE( salsa_nest_offl%gconc_south(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) )
-          ENDIF
-          ALLOCATE( salsa_nest_offl%gconc_top(0:1,nys:nyn,nxl:nxr,1:ngases_salsa) )
-       ENDIF
-
-!
-!--    Read data at lateral and top boundaries from a larger-scale model
-       CALL salsa_nesting_offl_input
-!
-!--    Check if sufficient time steps are provided to cover the entire simulation. Note, dynamic
-!--    input is only required for the 3D simulation, not for the soil/wall spinup. However, as the
-!--    spinup time is added to the end_time, this must be considered here.
-       IF ( end_time - spinup_time > salsa_nest_offl%time(salsa_nest_offl%nt-1) )  THEN
-          message_string = 'end_time of the simulation exceeds the time dimension in the dynamic'//&
-                           ' input file.'
-          CALL message( 'salsa_nesting_offl_init', 'PA0690', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( salsa_nest_offl%time(0) /= 0.0_wp )  THEN
-          message_string = 'Offline nesting: time dimension must start at 0.0.'
-          CALL message( 'salsa_nesting_offl_init', 'PA0691', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Initialize boundary data. Please note, do not initialize boundaries in case of restart runs.
-       IF ( .NOT. read_restart_data_salsa )  THEN
-          IF ( bc_dirichlet_l )  THEN
-             DO  ib = 1, nbins_aerosol
-                aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,-1) =                                    &
-                                                 salsa_nest_offl%nconc_left(0,nzb+1:nzt,nys:nyn,ib)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,-1) =                                  &
-                                                 salsa_nest_offl%mconc_left(0,nzb+1:nzt,nys:nyn,icc)
-                ENDDO
-             ENDDO
-             DO  ig = 1, ngases_salsa
-                salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,-1) =                                         &
-                                                 salsa_nest_offl%gconc_left(0,nzb+1:nzt,nys:nyn,ig)
-             ENDDO
-          ENDIF
-          IF ( bc_dirichlet_r )  THEN
-             DO  ib = 1, nbins_aerosol
-                aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,nxr+1) =                                 &
-                                                salsa_nest_offl%nconc_right(0,nzb+1:nzt,nys:nyn,ib)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,nxr+1) =                               &
-                                                salsa_nest_offl%mconc_right(0,nzb+1:nzt,nys:nyn,icc)
-                ENDDO
-             ENDDO
-             DO  ig = 1, ngases_salsa
-                salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,nxr+1) =                                      &
-                                                 salsa_nest_offl%gconc_right(0,nzb+1:nzt,nys:nyn,ig)
-             ENDDO
-          ENDIF
-          IF ( bc_dirichlet_n )  THEN
-             DO  ib = 1, nbins_aerosol
-                aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,nxl:nxr) =                                 &
-                                                salsa_nest_offl%nconc_north(0,nzb+1:nzt,nxl:nxr,ib)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,nxl:nxr) =                               &
-                                                salsa_nest_offl%mconc_north(0,nzb+1:nzt,nxl:nxr,icc)
-                ENDDO
-             ENDDO
-             DO  ig = 1, ngases_salsa
-                salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,nxl:nxr) =                                      &
-                                                 salsa_nest_offl%gconc_north(0,nzb+1:nzt,nxl:nxr,ig)
-             ENDDO
-          ENDIF
-          IF ( bc_dirichlet_s )  THEN
-             DO  ib = 1, nbins_aerosol
-                aerosol_number(ib)%conc(nzb+1:nzt,-1,nxl:nxr) =                                    &
-                                                salsa_nest_offl%nconc_south(0,nzb+1:nzt,nxl:nxr,ib)
-                DO  ic = 1, ncomponents_mass
-                   icc = ( ic - 1 ) * nbins_aerosol + ib
-                   aerosol_mass(icc)%conc(nzb+1:nzt,-1,nxl:nxr) =                                  &
-                                                salsa_nest_offl%mconc_south(0,nzb+1:nzt,nxl:nxr,icc)
-                ENDDO
-             ENDDO
-             DO  ig = 1, ngases_salsa
-                salsa_gas(ig)%conc(nzb+1:nzt,-1,nxl:nxr) =                                         &
-                                                 salsa_nest_offl%gconc_south(0,nzb+1:nzt,nxl:nxr,ig)
-             ENDDO
-          ENDIF
-       ENDIF
-    ENDIF
-
- END SUBROUTINE salsa_nesting_offl_init
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the lateral and top boundary conditions in case the PALM domain is
-!> nested offline in a mesoscale model. Further, average boundary data and
-!> determine mean profiles, further used for correct damping in the sponge
-!> layer.
-!------------------------------------------------------------------------------!
- SUBROUTINE salsa_nesting_offl_input
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
-               inquire_num_variables, inquire_variable_names,                                      &
-               get_dimension_length, open_read_file
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=25) ::  vname  !< variable name
-
-    INTEGER(iwp) ::  ic        !< running index for aerosol chemical components
-    INTEGER(iwp) ::  ig        !< running index for gases
-    INTEGER(iwp) ::  num_vars  !< number of variables in netcdf input file
-
-!
-!-- Skip input if no forcing from larger-scale models is applied.
-    IF ( .NOT. nesting_offline_salsa )  RETURN
-!
-!-- Initialise
-    IF ( .NOT. salsa_nest_offl%init )  THEN
-
-#if defined ( __netcdf )
-!
-!--    Open file in read-only mode
-       CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ),                   &
-                            salsa_nest_offl%id_dynamic )
-!
-!--    At first, inquire all variable names.
-       CALL inquire_num_variables( salsa_nest_offl%id_dynamic, num_vars )
-!
-!--    Allocate memory to store variable names.
-       ALLOCATE( salsa_nest_offl%var_names(1:num_vars) )
-       CALL inquire_variable_names( salsa_nest_offl%id_dynamic, salsa_nest_offl%var_names )
-!
-!--    Read time dimension, allocate memory and finally read time array
-       CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nt,&
-                                                    'time' )
-
-       IF ( check_existence( salsa_nest_offl%var_names, 'time' ) )  THEN
-          ALLOCATE( salsa_nest_offl%time(0:salsa_nest_offl%nt-1) )
-          CALL get_variable( salsa_nest_offl%id_dynamic, 'time', salsa_nest_offl%time )
-       ENDIF
-!
-!--    Read the vertical dimension
-       CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nzu, 'z' )
-       ALLOCATE( salsa_nest_offl%zu_atmos(1:salsa_nest_offl%nzu) )
-       CALL get_variable( salsa_nest_offl%id_dynamic, 'z', salsa_nest_offl%zu_atmos )
-!
-!--    Read the number of aerosol chemical components
-       CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%ncc,                 &
-                                  'composition_index' )
-!
-!--    Read the names of aerosol chemical components
-       CALL get_variable( salsa_nest_offl%id_dynamic, 'composition_name', salsa_nest_offl%cc_name, &
-                          salsa_nest_offl%ncc )
-!
-!--    Define the index of each chemical component in the model
-       DO  ic = 1, salsa_nest_offl%ncc
-          SELECT CASE ( TRIM( salsa_nest_offl%cc_name(ic) ) )
-             CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' )
-                salsa_nest_offl%cc_in2mod(1) = ic
-             CASE ( 'OC', 'oc' )
-                salsa_nest_offl%cc_in2mod(2) = ic
-             CASE ( 'BC', 'bc' )
-                salsa_nest_offl%cc_in2mod(3) = ic
-             CASE ( 'DU', 'du' )
-                salsa_nest_offl%cc_in2mod(4) = ic
-             CASE ( 'SS', 'ss' )
-                salsa_nest_offl%cc_in2mod(5) = ic
-             CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' )
-                salsa_nest_offl%cc_in2mod(6) = ic
-             CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' )
-                salsa_nest_offl%cc_in2mod(7) = ic
-          END SELECT
-       ENDDO
-       IF ( SUM( salsa_nest_offl%cc_in2mod ) == 0 )  THEN
-          message_string = 'None of the aerosol chemical components in ' //                        &
-                           TRIM( input_file_dynamic ) // ' correspond to ones applied in SALSA.'
-          CALL message( 'salsa_mod: salsa_nesting_offl_input', 'PA0693', 2, 2, 0, 6, 0 )
-       ENDIF
-
-       CALL close_input_file( salsa_nest_offl%id_dynamic )
-#endif
-    ENDIF
-!
-!-- Check if dynamic driver data input is required.
-    IF ( salsa_nest_offl%time(salsa_nest_offl%tind_p) <= MAX( time_since_reference_point, 0.0_wp)  &
-         .OR.  .NOT.  salsa_nest_offl%init )  THEN
-       CONTINUE
-!
-!-- Return otherwise
-    ELSE
-       RETURN
-    ENDIF
-!
-!-- Obtain time index for current point in time.
-    salsa_nest_offl%tind = MINLOC( ABS( salsa_nest_offl%time -                                     &
-                                        MAX( time_since_reference_point, 0.0_wp ) ), DIM = 1 ) - 1
-!
-!-- Note, in case of restart runs, the time index for the boundary data may indicate a time
-!-- in the future. This needs to be checked and corrected.
-    IF ( TRIM( initializing_actions ) == 'read_restart_data'  .AND.                                &
-         salsa_nest_offl%time(salsa_nest_offl%tind) > time_since_reference_point )  THEN
-       salsa_nest_offl%tind = salsa_nest_offl%tind - 1
-    ENDIF
-    salsa_nest_offl%tind_p = salsa_nest_offl%tind + 1
-!
-!-- Open file in read-only mode
-#if defined ( __netcdf )
-
-    CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ),                      &
-                         salsa_nest_offl%id_dynamic )
-!
-!-- Read data at the western boundary
-    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_left_aerosol',                      &
-                       salsa_nest_offl%nconc_left,                                                 &
-                       MERGE( 0, 1, bc_dirichlet_l ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_l ), &
-                       MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ),           &
-                       MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ),         &
-                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_l ),                         &
-                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l  ) )
-    IF ( bc_dirichlet_l )  THEN
-       salsa_nest_offl%nconc_left = MAX( nclim, salsa_nest_offl%nconc_left )
-       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
-                                    nyn, 'ls_forcing_left_mass_fracs_a', 1 )
-    ENDIF
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       DO  ig = 1, ngases_salsa
-          vname = salsa_nest_offl%char_l // salsa_nest_offl%gas_name(ig)
-          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
-                             salsa_nest_offl%gconc_left(:,:,:,ig),                                 &
-                             MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ),     &
-                             MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ),   &
-                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_l ),                   &
-                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) )
-          IF ( bc_dirichlet_l )  salsa_nest_offl%gconc_left(:,:,:,ig) =                            &
-                                                  MAX( nclim, salsa_nest_offl%gconc_left(:,:,:,ig) )
-       ENDDO
-    ENDIF
-!
-!-- Read data at the eastern boundary
-    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_right_aerosol',                     &
-                       salsa_nest_offl%nconc_right,                                                &
-                       MERGE( 0, 1, bc_dirichlet_r ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_r ), &
-                       MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ),           &
-                       MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ),         &
-                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_r ),                         &
-                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
-    IF ( bc_dirichlet_r )  THEN
-       salsa_nest_offl%nconc_right = MAX( nclim, salsa_nest_offl%nconc_right )
-       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, &
-                                    nyn, 'ls_forcing_right_mass_fracs_a', 2 )
-    ENDIF
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       DO  ig = 1, ngases_salsa
-          vname = salsa_nest_offl%char_r // salsa_nest_offl%gas_name(ig)
-          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
-                             salsa_nest_offl%gconc_right(:,:,:,ig),                                &
-                             MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ),     &
-                             MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ),   &
-                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_r ),                   &
-                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) )
-          IF ( bc_dirichlet_r )  salsa_nest_offl%gconc_right(:,:,:,ig) =                           &
-                                                 MAX( nclim, salsa_nest_offl%gconc_right(:,:,:,ig) )
-       ENDDO
-    ENDIF
-!
-!-- Read data at the northern boundary
-    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_north_aerosol',                     &
-                       salsa_nest_offl%nconc_north,                                                &
-                       MERGE( 0, 1, bc_dirichlet_n ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_n ), &
-                       MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ),           &
-                       MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ),         &
-                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_n ),                         &
-                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
-    IF ( bc_dirichlet_n )  THEN
-       salsa_nest_offl%nconc_north = MAX( nclim, salsa_nest_offl%nconc_north )
-       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
-                                    nxr, 'ls_forcing_north_mass_fracs_a', 3 )
-    ENDIF
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       DO  ig = 1, ngases_salsa
-          vname = salsa_nest_offl%char_n // salsa_nest_offl%gas_name(ig)
-          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
-                             salsa_nest_offl%gconc_north(:,:,:,ig),                                &
-                             MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ),     &
-                             MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ),   &
-                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_n ),                   &
-                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) )
-          IF ( bc_dirichlet_n )  salsa_nest_offl%gconc_north(:,:,:,ig) =                           &
-                                                 MAX( nclim, salsa_nest_offl%gconc_north(:,:,:,ig) )
-       ENDDO
-    ENDIF
-!
-!-- Read data at the southern boundary
-    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_south_aerosol',                     &
-                       salsa_nest_offl%nconc_south,                                                &
-                       MERGE( 0, 1, bc_dirichlet_s ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_s ), &
-                       MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ),           &
-                       MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ),         &
-                       MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_s ),                         &
-                       MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
-    IF ( bc_dirichlet_s )  THEN
-       salsa_nest_offl%nconc_south = MAX( nclim, salsa_nest_offl%nconc_south )
-       CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, &
-                                    nxr, 'ls_forcing_south_mass_fracs_a', 4 )
-    ENDIF
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       DO  ig = 1, ngases_salsa
-          vname = salsa_nest_offl%char_s // salsa_nest_offl%gas_name(ig)
-          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
-                             salsa_nest_offl%gconc_south(:,:,:,ig),                                &
-                             MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ),     &
-                             MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ),   &
-                             MERGE( salsa_nest_offl%tind,   1, bc_dirichlet_s ),                   &
-                             MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) )
-          IF ( bc_dirichlet_s )  salsa_nest_offl%gconc_south(:,:,:,ig) =                           &
-                                                 MAX( nclim, salsa_nest_offl%gconc_south(:,:,:,ig) )
-       ENDDO
-    ENDIF
-!
-!-- Read data at the top boundary
-    CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_top_aerosol',                       &
-                       salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol),             &
-                       0, nbins_aerosol-1, nxl, nxr, nys, nyn, salsa_nest_offl%tind,               &
-                       salsa_nest_offl%tind_p )
-    salsa_nest_offl%nconc_top = MAX( nclim, salsa_nest_offl%nconc_top )
-    CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nys, nyn, nxl, nxr, &
-                                 'ls_forcing_top_mass_fracs_a', 5 )
-    IF ( .NOT. salsa_gases_from_chem )  THEN
-       DO  ig = 1, ngases_salsa
-          vname = salsa_nest_offl%char_t // salsa_nest_offl%gas_name(ig)
-          CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ),                            &
-                             salsa_nest_offl%gconc_top(:,:,:,ig), nxl, nxr, nys, nyn,              &
-                             salsa_nest_offl%tind, salsa_nest_offl%tind_p )
-          salsa_nest_offl%gconc_top(:,:,:,ig) = MAX( nclim, salsa_nest_offl%gconc_top(:,:,:,ig) )
-       ENDDO
-    ENDIF
-!
-!-- Close input file
-    CALL close_input_file( salsa_nest_offl%id_dynamic )
-
-#endif
-!
-!-- Set control flag to indicate that initialization is already done
-    salsa_nest_offl%init = .TRUE.
-
- END SUBROUTINE salsa_nesting_offl_input
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sets the mass concentrations to aerosol arrays in 2a and 2b.
-!------------------------------------------------------------------------------!
- SUBROUTINE nesting_offl_aero_mass( ts, te, ks, ke, is, ie, varname_a, ibound )
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  get_variable
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=25) ::  varname_b  !< name for bins b
-
-    CHARACTER(LEN=*), INTENT(in) ::  varname_a  !< name for bins a
-
-    INTEGER(iwp) ::  ee                !< loop index: end
-    INTEGER(iwp) ::  i                 !< loop index
-    INTEGER(iwp) ::  ib                !< loop index
-    INTEGER(iwp) ::  ic                !< loop index
-    INTEGER(iwp) ::  k                 !< loop index
-    INTEGER(iwp) ::  ss                !< loop index: start
-    INTEGER(iwp) ::  t                 !< loop index
-    INTEGER(iwp) ::  type_so4_oc = -1  !<
-
-    INTEGER(iwp), INTENT(in) ::  ibound  !< index: 1=left, 2=right, 3=north, 4=south, 5=top
-    INTEGER(iwp), INTENT(in) ::  ie      !< loop index
-    INTEGER(iwp), INTENT(in) ::  is      !< loop index
-    INTEGER(iwp), INTENT(in) ::  ks      !< loop index
-    INTEGER(iwp), INTENT(in) ::  ke      !< loop index
-    INTEGER(iwp), INTENT(in) ::  ts      !< loop index
-    INTEGER(iwp), INTENT(in) ::  te      !< loop index
-
-    INTEGER(iwp), DIMENSION(maxspec) ::  cc_i2m   !<
-
-    REAL(wp) ::  pmf1a !< mass fraction in 1a
-
-    REAL(wp), DIMENSION(nbins_aerosol) ::  core   !< size of the bin mid aerosol particle
-
-    REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol) ::  to_nconc                   !<
-    REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol*ncomponents_mass) ::  to_mconc  !<
-
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mf2a !< Mass distributions for a
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  mf2b !< and b bins
-
-!
-!-- Variable name for insoluble mass fraction
-    varname_b = varname_a(1:LEN( TRIM( varname_a ) ) - 1 ) // 'b'
-!
-!-- Bin mean aerosol particle volume (m3)
-    core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3
-!
-!-- Allocate and read mass fraction arrays
-    ALLOCATE( mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc),                                         &
-              mf2b(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc) )
-    IF ( ibound == 5 )  THEN
-       CALL get_variable( salsa_nest_offl%id_dynamic, varname_a,                                   &
-                          mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1,   &
-                          is, ie, ks, ke, ts, te )
-    ELSE
-       CALL get_variable( salsa_nest_offl%id_dynamic, varname_a,                                   &
-                          mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1,   &
-                          is, ie, ks-1, ke-1, ts, te )
-    ENDIF
-!
-!-- If the chemical component is not activated, set its mass fraction to 0 to avoid mass inbalance
-    cc_i2m = salsa_nest_offl%cc_in2mod
-    IF ( index_so4 < 0  .AND. cc_i2m(1) > 0 )  mf2a(:,:,:,cc_i2m(1)) = 0.0_wp
-    IF ( index_oc < 0   .AND. cc_i2m(2) > 0 )  mf2a(:,:,:,cc_i2m(2)) = 0.0_wp
-    IF ( index_bc < 0   .AND. cc_i2m(3) > 0 )  mf2a(:,:,:,cc_i2m(3)) = 0.0_wp
-    IF ( index_du < 0   .AND. cc_i2m(4) > 0 )  mf2a(:,:,:,cc_i2m(4)) = 0.0_wp
-    IF ( index_ss < 0   .AND. cc_i2m(5) > 0 )  mf2a(:,:,:,cc_i2m(5)) = 0.0_wp
-    IF ( index_no < 0   .AND. cc_i2m(6) > 0 )  mf2a(:,:,:,cc_i2m(6)) = 0.0_wp
-    IF ( index_nh < 0   .AND. cc_i2m(7) > 0 )  mf2a(:,:,:,cc_i2m(7)) = 0.0_wp
-    mf2b = 0.0_wp
-!
-!-- Initialise variable type_so4_oc to indicate whether SO4 and/OC is included in mass fraction data
-    IF ( ( cc_i2m(1) > 0  .AND.  index_so4 > 0 )  .AND. ( cc_i2m(2) > 0  .AND.  index_oc > 0 ) )   &
-    THEN
-       type_so4_oc = 1
-    ELSEIF ( cc_i2m(1) > 0  .AND.  index_so4 > 0 )  THEN
-       type_so4_oc = 2
-    ELSEIF ( cc_i2m(2) > 0  .AND.  index_oc > 0 )  THEN
-       type_so4_oc = 3
-    ENDIF
-
-    SELECT CASE ( ibound )
-       CASE( 1 )
-          to_nconc = salsa_nest_offl%nconc_left
-          to_mconc = salsa_nest_offl%mconc_left
-       CASE( 2 )
-          to_nconc = salsa_nest_offl%nconc_right
-          to_mconc = salsa_nest_offl%mconc_right
-       CASE( 3 )
-          to_nconc = salsa_nest_offl%nconc_north
-          to_mconc = salsa_nest_offl%mconc_north
-       CASE( 4 )
-          to_nconc = salsa_nest_offl%nconc_south
-          to_mconc = salsa_nest_offl%mconc_south
-       CASE( 5 )
-          to_nconc = salsa_nest_offl%nconc_top
-          to_mconc = salsa_nest_offl%mconc_top
-    END SELECT
-!
-!-- Set mass concentrations:
-!
-!-- Regime 1:
-    SELECT CASE ( type_so4_oc )
-       CASE ( 1 )  ! Both SO4 and OC given
-
-          ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a  ! start
-          ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a    ! end
-          ib = start_subrange_1a
-          DO  ic = ss, ee
-             DO i = is, ie
-                DO k = ks, ke
-                   DO t = 0, 1
-                      pmf1a = mf2a(t,k,i,cc_i2m(1)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
-                      to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
-                   ENDDO
-                ENDDO
-             ENDDO
-             ib = ib + 1
-          ENDDO
-          ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
-          ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a   ! end
-          ib = start_subrange_1a
-          DO  ic = ss, ee
-             DO i = is, ie
-                DO k = ks, ke
-                   DO t = 0, 1
-                      pmf1a = mf2a(t,k,i,cc_i2m(2)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) )
-                      to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhooc
-                   ENDDO
-                ENDDO
-             ENDDO
-             ib = ib + 1
-          ENDDO
-       CASE ( 2 )  ! Only SO4
-          ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a  ! start
-          ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a    ! end
-          ib = start_subrange_1a
-          DO  ic = ss, ee
-             DO i = is, ie
-                DO k = ks, ke
-                   DO t = 0, 1
-                      to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhoh2so4
-                   ENDDO
-                ENDDO
-             ENDDO
-             ib = ib + 1
-          ENDDO
-       CASE ( 3 )  ! Only OC
-          ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start
-          ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a   ! end
-          ib = start_subrange_1a
-          DO  ic = ss, ee
-             DO i = is, ie
-                DO k = ks, ke
-                   DO t = 0, 1
-                      to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhooc
-                   ENDDO
-                ENDDO
-             ENDDO
-             ib = ib + 1
-          ENDDO
-    END SELECT
-!
-!-- Regimes 2a and 2b:
-    IF ( index_so4 > 0 ) THEN
-       CALL set_nest_mass( index_so4, 1, arhoh2so4 )
-    ENDIF
-    IF ( index_oc > 0 ) THEN
-       CALL set_nest_mass( index_oc, 2, arhooc )
-    ENDIF
-    IF ( index_bc > 0 ) THEN
-       CALL set_nest_mass( index_bc, 3, arhobc )
-    ENDIF
-    IF ( index_du > 0 ) THEN
-       CALL set_nest_mass( index_du, 4, arhodu )
-    ENDIF
-    IF ( index_ss > 0 ) THEN
-       CALL set_nest_mass( index_ss, 5, arhoss )
-    ENDIF
-    IF ( index_no > 0 ) THEN
-       CALL set_nest_mass( index_no, 6, arhohno3 )
-    ENDIF
-    IF ( index_nh > 0 ) THEN
-       CALL set_nest_mass( index_nh, 7, arhonh3 )
-    ENDIF
-
-    DEALLOCATE( mf2a, mf2b )
-
-    SELECT CASE ( ibound )
-       CASE( 1 )
-          salsa_nest_offl%mconc_left = to_mconc
-       CASE( 2 )
-          salsa_nest_offl%mconc_right = to_mconc
-       CASE( 3 )
-          salsa_nest_offl%mconc_north = to_mconc
-       CASE( 4 )
-          salsa_nest_offl%mconc_south = to_mconc
-       CASE( 5 )
-          salsa_nest_offl%mconc_top = to_mconc
-    END SELECT
-
-    CONTAINS
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set nesting boundaries for aerosol mass.
-!------------------------------------------------------------------------------!
-    SUBROUTINE set_nest_mass( ispec, ispec_def, prho )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  ic   !< chemical component index: default
-       INTEGER(iwp) ::  icc  !< loop index: mass bin
-
-       INTEGER(iwp), INTENT(in) ::  ispec      !< aerosol species index
-       INTEGER(iwp), INTENT(in) ::  ispec_def  !< default aerosol species index
-
-       REAL(wp), INTENT(in) ::  prho !< aerosol density
-!
-!--    Define the index of the chemical component in the input data
-       ic = salsa_nest_offl%cc_in2mod(ispec_def)
-
-       DO i = is, ie
-          DO k = ks, ke
-             DO t = 0, 1
-!
-!--             Regime 2a:
-                ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a
-                ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a
-                ib = start_subrange_2a
-                DO icc = ss, ee
-                   to_mconc(t,k,i,icc) = MAX( 0.0_wp, mf2a(t,k,i,ic) / SUM( mf2a(t,k,i,:) ) ) *    &
-                                         to_nconc(t,k,i,ib) * core(ib) * prho
-                   ib = ib + 1
-                ENDDO
-!
-!--             Regime 2b:
-                IF ( .NOT. no_insoluble )  THEN
-!
-!--                 TODO!
-                    mf2b(t,k,i,ic) = mf2b(t,k,i,ic)
-                ENDIF
-             ENDDO   ! k
-
-          ENDDO   ! j
-       ENDDO   ! i
-
-    END SUBROUTINE set_nest_mass
-
- END SUBROUTINE nesting_offl_aero_mass
-
-
- END MODULE salsa_mod
Index: palm/trunk/SOURCE/shared_memory_io_mod.f90
===================================================================
--- palm/trunk/SOURCE/shared_memory_io_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,1565 +1,0 @@
-!> @file shared_memory_io_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! bugfix for r4893 to avoid compile errors in serial mode
-!
-! 4893 2021-03-02 16:39:14Z raasch
-! revised output of surface data via MPI-IO for better performance
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! additions for output of particle time series
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4628 2020-07-29 07:23:03Z raasch
-! extensions required for MPI-I/O of particle data to restart files
-!
-! 4620 2020-07-22 14:11:16Z raasch
-! bugfix: variable definition changed
-!
-! 4618 2020-07-22 11:21:08Z raasch
-! unused variable removed
-!
-! Additions for cyclic fill mode
-! 
-! File re-formatted to follow the PALM coding standard
-!
-!
-! Initial version (Klaus Ketelsen)
-!
-! Description:
-! ------------
-!> Handle MPI-IO or NetCDF-IO shared memory arrays.
-!> This module performs the organization of new communicators, adapted PE-grids and allocation of
-!> shared memory arrays. The IO itself is not done here.
-!--------------------------------------------------------------------------------------------------!
- MODULE shared_memory_io_mod
-
-#if defined( __parallel )
-    USE MPI
-#endif
-
-    USE, INTRINSIC ::  ISO_C_BINDING
-
-    USE control_parameters,                                                                        &
-        ONLY: maximum_grid_level,                                                                  &
-              message_string,                                                                      &
-              mg_switch_to_pe0_level
-
-
-    USE indices,                                                                                   &
-        ONLY: nbgp,                                                                                &
-              nnx,                                                                                 &
-              nny,                                                                                 &
-              nnz,                                                                                 &
-              nx,                                                                                  &
-              nxl,                                                                                 &
-              nxlg,                                                                                &
-              nxr,                                                                                 &
-              nxrg,                                                                                &
-              ny,                                                                                  &
-              nyn,                                                                                 &
-              nyng,                                                                                &
-              nys,                                                                                 &
-              nysg,                                                                                &
-              nzb,                                                                                 &
-              nzt
-
-    USE kinds,                                                                                     &
-        ONLY: dp,                                                                                  &
-              idp,                                                                                 &
-              isp,                                                                                 &
-              iwp,                                                                                 &
-              sp,                                                                                  &
-              wp
-
-    USE pegrid,                                                                                    &
-        ONLY: comm1dx,                                                                             &
-              comm1dy,                                                                             &
-              comm2d,                                                                              &
-              comm_palm,                                                                           &
-              ierr,                                                                                &
-              myid,                                                                                &
-              myidx,                                                                               &
-              myidy,                                                                               &
-              npex,                                                                                &
-              npey,                                                                                &
-              numprocs,                                                                            &
-              pdims,                                                                               &
-              pleft,                                                                               &
-              pnorth,                                                                              &
-              pright,                                                                              &
-              psouth,                                                                              &
-              sendrecvcount_xy
-
-#if defined( __parallel )
-    USE pegrid,                                                                                    &
-        ONLY: pcoord,                                                                              &
-              reorder
-#endif
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_y, nxl_z, nxr_y, nxr_z, nys_x, nys_z, nyn_x, nyn_z, nzb_x, nzb_y, nzt_x, nzt_y
-
-    IMPLICIT NONE
-
-    PRIVATE
-
-    SAVE
-
-!
-!-- Type to store information about the domain decomposition grid
-    TYPE, PUBLIC ::  domain_decomposition_grid_features  !<
-
-       INTEGER(iwp) ::  comm2d    !<
-       INTEGER(iwp) ::  myid      !<
-       INTEGER(iwp) ::  nnx       !<
-       INTEGER(iwp) ::  nny       !<
-       INTEGER(iwp) ::  nx        !<
-       INTEGER(iwp) ::  nxl       !<
-       INTEGER(iwp) ::  nxr       !<
-       INTEGER(iwp) ::  ny        !<
-       INTEGER(iwp) ::  nyn       !<
-       INTEGER(iwp) ::  nys       !<
-       INTEGER(iwp) ::  numprocs  !<
-
-       CONTAINS
-
-          PROCEDURE, PASS(this), PUBLIC :: activate_grid_from_this_class
-          PROCEDURE, PASS(this), PUBLIC :: save_grid_into_this_class
-
-    END TYPE domain_decomposition_grid_features
-
-    TYPE, PUBLIC ::  sm_remote_array
-
-       TYPE(C_PTR)  ::  rem_ptr  !<
-       INTEGER(iwp) ::  d1e      !<
-       INTEGER(iwp) ::  d1s      !<
-       INTEGER(iwp) ::  d2e      !<
-       INTEGER(iwp) ::  d2s      !<
-       INTEGER(iwp) ::  d3e      !<
-       INTEGER(iwp) ::  d3s      !<
-       INTEGER(iwp) ::  d4e      !<
-       INTEGER(iwp) ::  d4s      !<
-
-    END TYPE sm_remote_array
-
-!
-!-- Class definition for shared memory instances.
-!-- For every use of shared memory IO, one instance of this class is created.
-    TYPE, PUBLIC ::  sm_class  !<
-
-       INTEGER(iwp) ::  nr_io_pe_per_node             !< typical configuration, 2 sockets per node
-       LOGICAL      ::  no_shared_Memory_in_this_run  !<
-
-       INTEGER(iwp) ::  comm_model            !< communicator of this model run
-!
-!--    Variables for the shared memory communicator
-       INTEGER(iwp), PUBLIC ::  comm_shared   !< communicator for processes with shared array
-       INTEGER(iwp), PUBLIC ::  sh_npes       !<
-       INTEGER(iwp), PUBLIC ::  sh_rank       !<
-
-!
-!--    Variables for the I/O virtual grid
-       INTEGER(iwp), PUBLIC ::  comm_io  !< communicator for all IO processes
-       INTEGER(iwp), PUBLIC ::  io_npes  !<
-       INTEGER(iwp), PUBLIC ::  io_rank  !<
-!
-!--    Variables for the node local communicator
-       INTEGER(iwp) ::  comm_node          !< communicator for all processes of current node
-       INTEGER(iwp) ::  io_pe_global_rank  !<
-       INTEGER(iwp) ::  n_npes             !<
-       INTEGER(iwp) ::  n_rank             !<
-
-       LOGICAL, PUBLIC ::  is_root_pe          !<
-       LOGICAL, PUBLIC ::  iam_io_pe = .TRUE.  !< this PE is an IO-PE
-
-       TYPE(domain_decomposition_grid_features), PUBLIC ::  io_grid  !< io grid features, depending on reading from prerun or main run
-
-       CONTAINS
-
-          PRIVATE
-
-          PROCEDURE, PASS(this), PUBLIC ::  is_sm_active
-          PROCEDURE, PASS(this), PUBLIC ::  sm_adjust_outer_boundary
-          PROCEDURE, PASS(this), PUBLIC ::  sm_free_shared
-          PROCEDURE, PASS(this), PUBLIC ::  sm_init_comm
-          PROCEDURE, PASS(this), PUBLIC ::  sm_init_data_output_particles
-          PROCEDURE, PASS(this), PUBLIC ::  sm_node_barrier
-#if defined( __parallel )
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_1d_32
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_1d_64
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_1di
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_2d_32
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_2d_64
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_2di
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_3d_32
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_3d_64
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_4d_32
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_4d_64
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_3di_32
-          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_3di_64
-          PROCEDURE, PASS(this), PUBLIC ::  sm_all_allocate_shared_3d_64
-
-          GENERIC, PUBLIC ::  sm_allocate_shared =>                                                &
-                                             sm_allocate_shared_1d_64,  sm_allocate_shared_1d_32,  &
-                                             sm_allocate_shared_2d_64,  sm_allocate_shared_2d_32,  &
-                                             sm_allocate_shared_2di,    sm_allocate_shared_3d_64,  &
-                                             sm_allocate_shared_4d_64,  sm_allocate_shared_4d_32,  &
-                                             sm_allocate_shared_3d_32,  sm_allocate_shared_1di,    &
-                                             sm_allocate_shared_3di_32, sm_allocate_shared_3di_64
-
-          GENERIC, PUBLIC ::  sm_all_allocate_shared => sm_all_allocate_shared_3d_64
-#endif
-    END TYPE sm_class
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create the communicator for shared memory groups and IO-PEs.
-!> Setup the grid for shared memory IO.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_init_comm( this, sm_active, comm_input )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(INOUT) ::  this  !< pointer to access internal variables of this call
-    INTEGER(iwp), INTENT(IN), OPTIONAL ::  comm_input  !< main model communicator (comm2d)
-
-#if defined( __parallel )
-    INTEGER ::  color              !<
-    INTEGER ::  max_npes_per_node  !< maximum number of PEs/node
-#endif
-
-    LOGICAL, INTENT(IN) ::  sm_active  !< flag to activate shared-memory IO
-
-
-    this%nr_io_pe_per_node = 2
-
-!
-!-- Next line is just to avoid compile errors in serial mode because of unused arguments
-    IF ( PRESENT( comm_input )  .AND.  sm_active )  CONTINUE
-
-#if defined( __parallel )
-    IF ( PRESENT( comm_input ) )  THEN
-       this%comm_model = comm_input
-    ELSE
-       this%comm_model = comm2d
-    ENDIF
-
-    this%no_shared_memory_in_this_run = .NOT. sm_active
-    this%comm_io = this%comm_model      ! preset in case of non shared-memory-IO
-
-    IF ( this%no_shared_memory_in_this_run )  THEN
-       this%iam_io_pe = .TRUE.
-       this%sh_rank   = 0
-       this%sh_npes   = 1
-       RETURN
-    ENDIF
-
-!
-!-- Determine, how many PEs are running on a node.
-    this%iam_io_pe = .FALSE.
-    CALL MPI_COMM_SPLIT_TYPE( this%comm_model, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL,             &
-                              this%comm_node, ierr )
-    CALL MPI_COMM_SIZE( this%comm_node, this%n_npes, ierr )
-    CALL MPI_COMM_RANK( this%comm_node, this%n_rank, ierr )
-
-    CALL MPI_ALLREDUCE( this%n_npes, max_npes_per_node, 1, MPI_INTEGER, MPI_MAX, this%comm_model,  &
-                        ierr )
-!
-!-- Decide, if the configuration can run with shared-memory IO
-    IF ( max_npes_per_node > 64 )  THEN
-!
-!--    Special configuration on the HLRN-IV system with 4 shared memory blocks/node
-       this%nr_io_pe_per_node = 4
-
-    ELSEIF ( max_npes_per_node <= 3 )  THEN
-!
-!--    No shared memory IO with less than 3 MPI tasks/node
-       this%no_shared_memory_in_this_run = .TRUE.
-       this%iam_io_pe = .TRUE.
-       RETURN
-    ENDIF
-
-!
-!-- No shared memory IO with small setups.
-    IF ( nx < 16  .OR.  ny < 16 )  THEN
-       this%no_shared_memory_in_this_run = .TRUE.
-       this%iam_io_pe = .TRUE.
-       RETURN
-    ENDIF
-
-!
-!-- Divide a node into shared memory groups, depending on the virtual x-y grid
-    CALL compute_color( color )
-!
-!-- If no shared memory IO possible, nothing is left to be done here.
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-
-!
-!-- Setup the shared memory area
-    CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
-    CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
-    CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
-
-!
-!-- Setup the communicator across the nodes depending on the shared memory rank.
-!-- All PEs with shared memory rank 0 will be I/O PEs.
-    color = this%sh_rank
-    CALL MPI_COMM_SPLIT( this%comm_model, color, 0, this%comm_io, ierr )
-
-    IF ( this%comm_io /= MPI_COMM_NULL )  THEN
-       CALL MPI_COMM_SIZE( this%comm_io, this%io_npes, ierr )
-       CALL MPI_COMM_RANK( this%comm_io, this%io_rank, ierr )
-    ELSE
-       this%io_npes = -1
-       this%io_rank = -1
-    ENDIF
-
-    IF ( this%sh_rank == 0 )  THEN
-       this%iam_io_pe = .TRUE.
-       this%io_pe_global_rank = myid
-    ENDIF
-    CALL MPI_BCAST( this%io_pe_global_rank, 1, MPI_INTEGER, 0, this%comm_shared, ierr )
-#else
-    this%iam_io_pe  = .TRUE.
-    this%comm_model = comm2d
-    this%sh_rank    = 0
-    this%sh_npes    = 1
-    this%no_shared_memory_in_this_run = .TRUE.
-#endif
-
-#if defined( __parallel )
- CONTAINS
-
- SUBROUTINE compute_color( color )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(OUT) ::  color  !<
-
-    INTEGER(iwp) ::  group_start    !<
-    INTEGER(iwp) ::  my_color       !<
-    INTEGER(iwp) ::  n              !<
-    INTEGER(iwp) ::  pe             !<
-    INTEGER(iwp) ::  sh_group_size  !<
-
-    INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) ::  local_dim_s   !<
-    INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) ::  local_dim_r   !<
-
-    TYPE(domain_decomposition_grid_features), DIMENSION(32) ::  node_grid  !<
-
-!
-!-- No shared memory I/O on one node jobs
-    IF ( numprocs < this%n_npes )  THEN
-       this%no_shared_memory_in_this_run = .TRUE.
-       RETURN
-    ENDIF
-
-    local_dim_s = 0
-    local_dim_s(1,this%n_rank) = nxl
-    local_dim_s(2,this%n_rank) = nxr
-    local_dim_s(3,this%n_rank) = nys
-    local_dim_s(4,this%n_rank) = nyn
-
-    node_grid%nyn = -1
-!
-!-- Distribute the x-y layout of all cores of a node to all node processes
-    CALL MPI_ALLREDUCE( local_dim_s, local_dim_r, SIZE( local_dim_s ), MPI_INTEGER, MPI_SUM,       &
-                        this%comm_node, ierr )
-    sh_group_size = ( max_npes_per_node + this%nr_io_pe_per_node - 1 ) / this%nr_io_pe_per_node
-
-    pe       = 0
-    my_color = 1  ! color is used to split the shared memory communicator into a communicator for
-                  ! io groups
-    group_start = pe
-    node_grid(my_color)%nxl = local_dim_r(1,group_start)
-    node_grid(my_color)%nxr = local_dim_r(2,group_start)
-    node_grid(my_color)%nys = local_dim_r(3,group_start)
-
-    DO  n = 1, this%n_npes-1
-
-       pe =  n
-       IF ( n > 0  .AND.  MOD( n,sh_group_size ) == 0 )  THEN
-!
-!--       If group boundary, start new IO group
-          node_grid(my_color)%nyn = local_dim_r(4,pe-1)
-          my_color = my_color + 1
-          group_start = pe
-          node_grid(my_color)%nxl = local_dim_r(1,group_start)
-          node_grid(my_color)%nxr = local_dim_r(2,group_start)
-          node_grid(my_color)%nys = local_dim_r(3,group_start)
-
-       ELSEIF ( local_dim_r(1,pe) /= node_grid(my_color)%nxl )  THEN
-!
-!--       If nxl changes, start new IO group
-          node_grid(my_color)%nyn = local_dim_r(4,pe-1)
-          my_color = my_color+1
-          group_start = pe
-          node_grid(my_color)%nxl = local_dim_r(1,group_start)
-          node_grid(my_color)%nxr = local_dim_r(2,group_start)
-          node_grid(my_color)%nys = local_dim_r(3,group_start)
-       ENDIF
-!
-!--    Save values for local PE
-       IF ( this%n_rank == pe )  THEN                                 !
-          color = my_color
-       ENDIF
-       IF ( n == this%n_npes-1 )  node_grid(my_color)%nyn = local_dim_r(4,pe)
-
-    ENDDO
-
-    IF ( this%n_rank == 0 )  THEN
-       color = 1
-    ENDIF
-
-    this%io_grid = node_grid(color)
-    this%io_grid%nnx = this%io_grid%nxr - this%io_grid%nxl + 1
-    this%io_grid%nny = this%io_grid%nyn - this%io_grid%nys + 1
-
- END SUBROUTINE compute_color
-#endif
-
- END SUBROUTINE sm_init_comm
-
-!
-!-- Initializing setup for output of particle time series.
-!-- This output always uses a shared memory to reduce the number of particle transfers.
- SUBROUTINE sm_init_data_output_particles( this )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(INOUT) ::  this  !< pointer to access internal variables of this call
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  color              !<
-    INTEGER(iwp) ::  ierr               !<
-    INTEGER(iwp) ::  max_npes_per_node  !< maximum number of PEs/node
-#endif
-
-    LOGICAL :: sm_active  !<
-
-
-    this%nr_io_pe_per_node = 2
-
-    sm_active       = .TRUE.   ! particle IO always uses shared memory
-    this%comm_model = comm2d
-
-    this%no_shared_memory_in_this_run = .NOT. sm_active
-    this%comm_io = this%comm_model  ! preset in case of non shared-memory-IO
-
-    IF ( this%no_shared_memory_in_this_run )  THEN
-       this%iam_io_pe = .TRUE.
-       RETURN
-    ENDIF
-
-#if defined( __parallel )
-!
-!-- Determine, how many PEs are running on a node.
-    this%iam_io_pe = .FALSE.
-    CALL MPI_COMM_SPLIT_TYPE( this%comm_model, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL,             &
-                              this%comm_node, ierr )
-    CALL MPI_COMM_SIZE( this%comm_node, this%n_npes, ierr )
-    CALL MPI_COMM_RANK( this%comm_node, this%n_rank, ierr )
-
-    CALL MPI_ALLREDUCE( this%n_npes, max_npes_per_node, 1, MPI_INTEGER, MPI_MAX, this%comm_model,  &
-                        ierr )
-!
-!-- TODO: better explanation
-!-- It has to be testet, if using memory blocks for an IO process (MPI shared Memory), or if it is
-!-- even better to use the complete node for MPI shared memory (this%nr_io_pe_per_node = 1).
-!-  In the latter case, the access to the MPI shared memory buffer is slower, the number of
-!-- particles to move between PEs will be much smaller.
-    IF ( max_npes_per_node > 64 )  THEN
-!
-!--    Special configuration on the HLRN-IV system with 4 shared memory blocks/node
-       this%nr_io_pe_per_node = 4
-    ENDIF
-
-    IF ( this%nr_io_pe_per_node == 1 )  THEN
-!
-!--    This branch is not realized so far
-       this%iam_io_pe   = ( this%n_rank == 0 )
-       this%comm_shared = this%comm_node
-       CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
-       CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
-
-    ELSEIF( this%nr_io_pe_per_node == 2 )  THEN
-
-       this%iam_io_pe = ( this%n_rank == 0  .OR.  this%n_rank == this%n_npes/2 )
-       IF ( this%n_rank < this%n_npes/2 )  THEN
-          color = 1
-       ELSE
-          color = 2
-       ENDIF
-       CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
-       CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
-       CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
-
-    ELSEIF( this%nr_io_pe_per_node == 4 )  THEN
-
-       this%iam_io_pe = ( this%n_rank == 0  .OR.  this%n_rank == this%n_npes/4  .OR.               &
-                          this%n_rank == this%n_npes/2  .OR.  this%n_rank == (3*this%n_npes)/4 )
-       IF ( this%n_rank < this%n_npes/4 )  THEN
-          color = 1
-       ELSEIF( this%n_rank < this%n_npes/2 )  THEN
-          color = 2
-       ELSEIF( this%n_rank < (3*this%n_npes)/4 )  THEN
-          color = 3
-       ELSE
-          color = 4
-       ENDIF
-       CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
-       CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
-       CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
-
-    ELSE
-
-       WRITE( *, * ) 'shared_memory_io_mod: internal error'
-       WRITE( *, * ) 'only 1, 2 or 4 shared memory groups per node are allowed '
-       WRITE( *, * ) 'here, ', this%nr_io_pe_per_node, ' groups have been set'
-       STOP
-
-    ENDIF
-
-!
-!-- Setup the shared memory area
-    CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
-    CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
-    CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
-
-!
-!-- Setup the communicator across the nodes depending on the shared memory rank.
-!-- All PEs with shared memory rank 0 will be I/O PEs.
-    color = this%sh_rank
-    CALL MPI_COMM_SPLIT( this%comm_model, color, 0, this%comm_io, ierr )
-
-    IF ( this%comm_io /= MPI_COMM_NULL )  THEN
-       CALL MPI_COMM_SIZE( this%comm_io, this%io_npes, ierr )
-       CALL MPI_COMM_RANK( this%comm_io, this%io_rank, ierr )
-    ELSE
-       this%io_npes = -1
-       this%io_rank = -1
-    ENDIF
-
-    IF ( this%sh_rank == 0 )  THEN
-       this%iam_io_pe = .TRUE.
-       this%io_pe_global_rank = myid
-    ENDIF
-    CALL MPI_BCAST( this%io_pe_global_rank, 1, MPI_INTEGER, 0, this%comm_shared, ierr )
-
-#else
-    this%iam_io_pe = .FALSE.
-#endif
-
- END SUBROUTINE sm_init_data_output_particles
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Function to return if shared Memory IO is active.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION is_sm_active( this ) RESULT( ac )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout) ::  this  !<
-
-    LOGICAL ::  ac  !<
-
-    ac = .NOT. this%no_shared_memory_in_this_run
-
- END FUNCTION is_sm_active
-
-
-#if defined( __parallel )
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 1d-REAL (64 bit) array on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_1d_64( this, p1, d1, d2, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)  ::  this
-
-    INTEGER(iwp)                    ::  disp_unit
-    INTEGER(iwp), INTENT(IN)        ::  d1
-    INTEGER(iwp), INTENT(IN)        ::  d2
-    INTEGER(iwp), SAVE              ::  pe_from = 0
-    INTEGER(iwp), INTENT(OUT)       ::  win
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  rem_size
-    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  wsize
-
-    INTEGER(iwp), DIMENSION(1)      ::  buf_shape
-
-    REAL(dp), DIMENSION(:), POINTER ::  buf
-    REAL(dp), DIMENSION(:), POINTER ::  p1
-
-    TYPE(C_PTR), SAVE               ::  base_ptr
-    TYPE(C_PTR), SAVE               ::  rem_ptr
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = d2 - d1 + 1
-    ELSE
-       wsize = 1
-    ENDIF
-    wsize = wsize * dp  ! please note, size is always in bytes, independently of the displacement
-                        ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(1) = d2 - d1 + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p1(d1:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_1d_64
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 1d-REAL (32 bit) array on PE 0 and pass address to all PEs
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_1d_32( this, p1, d1, d2, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)  ::  this
-
-    INTEGER(iwp)                    ::  disp_unit
-    INTEGER(iwp), INTENT(IN)        ::  d1
-    INTEGER(iwp), INTENT(IN)        ::  d2
-    INTEGER(iwp), SAVE              ::  pe_from = 0
-    INTEGER(iwp), INTENT(OUT)       ::  win
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  rem_size
-    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  wsize
-
-    INTEGER(iwp), DIMENSION(1)      ::  buf_shape
-
-    REAL(sp), DIMENSION(:), POINTER ::  buf
-    REAL(sp), DIMENSION(:), POINTER ::  p1
-
-    TYPE(C_PTR), SAVE               ::  base_ptr
-    TYPE(C_PTR), SAVE               ::  rem_ptr
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = d2 - d1 + 1
-    ELSE
-       wsize = 1
-    ENDIF
-    wsize = wsize * sp  ! Please note, size is always in bytes, independently of the displacement
-                       ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, sp, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(1) = d2 - d1 + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p1(d1:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_1d_32
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 1d-INTEGER array on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_1di( this, p1, d1, d2, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)  ::  this
-
-    INTEGER(iwp)                    ::  disp_unit
-    INTEGER(iwp), INTENT(IN)        ::  d1
-    INTEGER(iwp), INTENT(IN)        ::  d2
-    INTEGER(iwp), SAVE              ::  pe_from = 0
-    INTEGER(iwp), INTENT(OUT)       ::  win
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  rem_size
-    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  wsize
-
-    INTEGER(iwp), DIMENSION(1)          ::  buf_shape
-
-    INTEGER(iwp), DIMENSION(:), POINTER ::  buf
-    INTEGER(iwp), DIMENSION(:), POINTER ::  p1
-
-    TYPE(C_PTR), SAVE                   ::  base_ptr
-    TYPE(C_PTR), SAVE                   ::  rem_ptr
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = d2 - d1 + 1
-    ELSE
-       wsize = 1
-    ENDIF
-    wsize = wsize * iwp  ! Please note, size is always in bytes, independently of the displacement
-                       ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, iwp, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(1) = d2 - d1 + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p1(d1:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_1di
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 2d-REAL array (64 bit) on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_2d_64( this, p2, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(INOUT)    ::  this
-
-    INTEGER(iwp)                      ::  disp_unit
-    INTEGER(iwp), INTENT(IN)          ::  n_nxlg
-    INTEGER(iwp), INTENT(IN)          ::  n_nxrg
-    INTEGER(iwp), INTENT(IN)          ::  n_nyng
-    INTEGER(iwp), INTENT(IN)          ::  n_nysg
-    INTEGER(iwp), SAVE                ::  pe_from = 0
-    INTEGER(iwp), INTENT(OUT)         ::  win
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)    ::  rem_size
-    INTEGER(KIND=MPI_ADDRESS_KIND)    ::  wsize
-
-    INTEGER(iwp), DIMENSION(2)        ::  buf_shape
-
-    REAL(dp), DIMENSION(:,:), POINTER ::  buf
-    REAL(dp), DIMENSION(:,:), POINTER ::  p2
-
-    TYPE(C_PTR), SAVE                 ::  base_ptr
-    TYPE(C_PTR), SAVE                 ::  rem_ptr
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
-    ELSE
-       wsize = 1
-    ENDIF
-
-    wsize = wsize * dp  ! Please note, size is always in bytes, independently of the displacement
-                        ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(2) = n_nyng - n_nysg + 1
-    buf_shape(1) = n_nxrg - n_nxlg + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p2(n_nxlg:, n_nysg:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_2d_64
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 2d-REAL (32 Bit) array on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_2d_32( this, p2, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(INOUT)    ::  this
-
-    INTEGER(iwp)                      ::  disp_unit
-    INTEGER(iwp), INTENT(IN)          ::  n_nxlg
-    INTEGER(iwp), INTENT(IN)          ::  n_nxrg
-    INTEGER(iwp), INTENT(IN)          ::  n_nyng
-    INTEGER(iwp), INTENT(IN)          ::  n_nysg
-    INTEGER(iwp), SAVE                ::  pe_from = 0
-    INTEGER(iwp), INTENT(OUT)         ::  win
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)    ::  rem_size
-    INTEGER(KIND=MPI_ADDRESS_KIND)    ::  wsize
-
-    INTEGER(iwp), DIMENSION(2)        ::  buf_shape
-
-    REAL(sp), DIMENSION(:,:), POINTER ::  buf
-    REAL(sp), DIMENSION(:,:), POINTER ::  p2
-
-    TYPE(C_PTR), SAVE                 ::  base_ptr
-    TYPE(C_PTR), SAVE                 ::  rem_ptr
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
-    ELSE
-       wsize = 1
-    ENDIF
-
-    wsize = wsize * sp  ! Please note, size is always in bytes, independently of the displacement
-                        ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(2) = n_nyng - n_nysg + 1
-    buf_shape(1) = n_nxrg - n_nxlg + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p2(n_nxlg:, n_nysg:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_2d_32
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 2d-INTEGER array on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_2di( this, p2i, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)        ::  this         !<
-
-    INTEGER(iwp)                          ::  disp_unit    !<
-    INTEGER(iwp), INTENT(IN)              ::  n_nxlg       !<
-    INTEGER(iwp), INTENT(IN)              ::  n_nxrg       !<
-    INTEGER(iwp), INTENT(IN)              ::  n_nyng       !<
-    INTEGER(iwp), INTENT(IN)              ::  n_nysg       !<
-    INTEGER(iwp), SAVE                    ::  pe_from = 0  !<
-    INTEGER(iwp), INTENT(OUT)             ::  win          !<
-
-    INTEGER(kind=MPI_ADDRESS_KIND)        ::  rem_size     !<
-    INTEGER(kind=MPI_ADDRESS_KIND)        ::  wsize        !<
-
-    INTEGER(iwp), DIMENSION(2)            ::  buf_shape    !<
-
-    INTEGER(iwp), DIMENSION(:,:), POINTER ::  buf          !<
-    INTEGER(iwp), DIMENSION(:,:), POINTER ::  p2i          !<
-
-    TYPE(C_PTR), SAVE                     ::  base_ptr     !<
-    TYPE(C_PTR), SAVE                     ::  rem_ptr      !<
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
-    ELSE
-       wsize = 1
-    ENDIF
-
-    wsize = wsize * 4  ! Please note, size is always in bytes, independently of the displacement
-                       ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, 4, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(2) = n_nyng - n_nysg + 1
-    buf_shape(1) = n_nxrg - n_nxlg + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p2i(n_nxlg:, n_nysg:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_2di
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 3d-REAL (64 bit) array on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_3d_64( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)      ::  this         !<
-
-    INTEGER(iwp)                        ::  disp_unit    !<
-    INTEGER(iwp), INTENT(IN)            ::  d1e          !<
-    INTEGER(iwp), INTENT(IN)            ::  d1s          !<
-    INTEGER(iwp), INTENT(IN)            ::  d2e          !<
-    INTEGER(iwp), INTENT(IN)            ::  d2s          !<
-    INTEGER(iwp), INTENT(IN)            ::  d3e          !<
-    INTEGER(iwp), INTENT(IN)            ::  d3s          !<
-    INTEGER(iwp), SAVE                  ::  pe_from = 0  !<
-    INTEGER(iwp), INTENT(OUT)           ::  win          !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  rem_size     !<
-    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  wsize        !<
-
-    INTEGER(iwp), DIMENSION(3)          ::  buf_shape    !<
-
-    REAL(dp), DIMENSION(:,:,:), POINTER ::  buf          !<
-    REAL(dp), DIMENSION(:,:,:), POINTER ::  p3           !<
-
-    TYPE(C_PTR), SAVE                   ::  base_ptr     !<
-    TYPE(C_PTR), SAVE                   ::  rem_ptr      !<
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
-    ELSE
-       wsize = 1
-    ENDIF
-
-    wsize = wsize * dp ! Please note, size is always in bytes, independently of the displacement
-                       ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(3) = d3e - d3s + 1
-    buf_shape(2) = d2e - d2s + 1
-    buf_shape(1) = d1e - d1s + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p3(d1s:,d2s:,d3s:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_3d_64
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 3d-REAL (32 bit) array on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_3d_32( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)      ::  this
-
-    INTEGER(iwp)                        ::  disp_unit
-    INTEGER(iwp), INTENT(IN)            ::  d1e
-    INTEGER(iwp), INTENT(IN)            ::  d1s
-    INTEGER(iwp), INTENT(IN)            ::  d2e
-    INTEGER(iwp), INTENT(IN)            ::  d2s
-    INTEGER(iwp), INTENT(IN)            ::  d3e
-    INTEGER(iwp), INTENT(IN)            ::  d3s
-    INTEGER(iwp), SAVE                  ::  pe_from = 0
-    INTEGER(iwp), INTENT(OUT)           ::  win
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  rem_size
-    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  wsize
-
-    INTEGER(iwp), DIMENSION(3)          ::  buf_shape
-
-    REAL(sp), DIMENSION(:,:,:), POINTER ::  buf
-    REAL(sp), DIMENSION(:,:,:), POINTER ::  p3
-
-    TYPE(C_PTR), SAVE                   ::  base_ptr
-    TYPE(C_PTR), SAVE                   ::  rem_ptr
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
-    ELSE
-       wsize = 1
-    ENDIF
-
-    wsize = wsize * sp ! Please note, size is always in bytes, independently of the displacement
-                       ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, sp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(3) = d3e - d3s + 1
-    buf_shape(2) = d2e - d2s + 1
-    buf_shape(1) = d1e - d1s + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p3(d1s:,d2s:,d3s:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_3d_32
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 4d-REAL (64 bit) array on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_4d_64( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, d4s, d4e, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)        ::  this         !<
-
-    INTEGER                               ::  disp_unit    !<
-    INTEGER(iwp), INTENT(IN)              ::  d1e          !<
-    INTEGER(iwp), INTENT(IN)              ::  d1s          !<
-    INTEGER(iwp), INTENT(IN)              ::  d2e          !<
-    INTEGER(iwp), INTENT(IN)              ::  d2s          !<
-    INTEGER(iwp), INTENT(IN)              ::  d3e          !<
-    INTEGER(iwp), INTENT(IN)              ::  d3s          !<
-    INTEGER(iwp), INTENT(IN)              ::  d4e          !<
-    INTEGER(iwp), INTENT(IN)              ::  d4s          !<
-    INTEGER(iwp), SAVE                    ::  pe_from = 0  !<
-    INTEGER(iwp), INTENT(OUT)             ::  win          !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)        ::  rem_size     !<
-    INTEGER(KIND=MPI_ADDRESS_KIND)        ::  wsize        !<
-
-    INTEGER(iwp), DIMENSION(4)            ::  buf_shape    !<
-
-    REAL(dp), DIMENSION(:,:,:,:), POINTER ::  buf          !<
-    REAL(dp), DIMENSION(:,:,:,:), POINTER ::  p3           !<
-
-    TYPE(C_PTR), SAVE                     ::  base_ptr     !<
-    TYPE(C_PTR), SAVE                     ::  rem_ptr      !<
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = (d4e - d4s +1) * ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
-    ELSE
-       wsize = 1
-    ENDIF
-
-    wsize = wsize * dp ! Please note, size is always in bytes, independently of the displacement
-                       ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(4) = d4e - d4s + 1
-    buf_shape(3) = d3e - d3s + 1
-    buf_shape(2) = d2e - d2s + 1
-    buf_shape(1) = d1e - d1s + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p3(d1s:,d2s:,d3s:,d4s:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_4d_64
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 4d-REAL (32 bit) array on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_4d_32( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, d4s, d4e, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)        ::  this         !<
-
-    INTEGER                               ::  disp_unit    !<
-    INTEGER(iwp), INTENT(IN)              ::  d1e          !<
-    INTEGER(iwp), INTENT(IN)              ::  d1s          !<
-    INTEGER(iwp), INTENT(IN)              ::  d2e          !<
-    INTEGER(iwp), INTENT(IN)              ::  d2s          !<
-    INTEGER(iwp), INTENT(IN)              ::  d3e          !<
-    INTEGER(iwp), INTENT(IN)              ::  d3s          !<
-    INTEGER(iwp), INTENT(IN)              ::  d4e          !<
-    INTEGER(iwp), INTENT(IN)              ::  d4s          !<
-    INTEGER(iwp), SAVE                    ::  pe_from = 0  !<
-    INTEGER(iwp), INTENT(OUT)             ::  win          !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)        ::  rem_size     !<
-    INTEGER(KIND=MPI_ADDRESS_KIND)        ::  wsize        !<
-
-    INTEGER(iwp), DIMENSION(4)            ::  buf_shape    !<
-
-    REAL(sp), DIMENSION(:,:,:,:), POINTER ::  buf          !<
-    REAL(sp), DIMENSION(:,:,:,:), POINTER ::  p3           !<
-
-    TYPE(C_PTR), SAVE                     ::  base_ptr     !<
-    TYPE(C_PTR), SAVE                     ::  rem_ptr      !<
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = (d4e - d4s +1) * ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
-    ELSE
-       wsize = 1
-    ENDIF
-
-    wsize = wsize * sp ! Please note, size is always in bytes, independently of the displacement
-                       ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(4) = d4e - d4s + 1
-    buf_shape(3) = d3e - d3s + 1
-    buf_shape(2) = d2e - d2s + 1
-    buf_shape(1) = d1e - d1s + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p3(d1s:,d2s:,d3s:,d4s:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_4d_32
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 3d-INTEGER (32 bit) array on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_3di_32( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)          ::  this
-
-    INTEGER                                 ::  disp_unit
-    INTEGER(iwp), INTENT(IN)                ::  d1e
-    INTEGER(iwp), INTENT(IN)                ::  d1s
-    INTEGER(iwp), INTENT(IN)                ::  d2e
-    INTEGER(iwp), INTENT(IN)                ::  d2s
-    INTEGER(iwp), INTENT(IN)                ::  d3e
-    INTEGER(iwp), INTENT(IN)                ::  d3s
-    INTEGER(iwp), SAVE                      ::  pe_from = 0
-    INTEGER(iwp), INTENT(OUT)               ::  win
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)          ::  rem_size
-    INTEGER(KIND=MPI_ADDRESS_KIND)          ::  wsize
-
-    INTEGER(iwp), DIMENSION(3)              ::  buf_shape
-
-    INTEGER(isp), DIMENSION(:,:,:), POINTER ::  buf
-    INTEGER(isp), DIMENSION(:,:,:), POINTER ::  p3
-
-    TYPE(C_PTR), SAVE                       ::  base_ptr
-    TYPE(C_PTR), SAVE                       ::  rem_ptr
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
-    ELSE
-       wsize = 1
-    ENDIF
-
-    wsize = wsize * isp ! Please note, size is always in bytes, independently of the displacement
-                       ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, isp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(3) = d3e - d3s + 1
-    buf_shape(2) = d2e - d2s + 1
-    buf_shape(1) = d1e - d1s + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p3(d1s:,d2s:,d3s:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_3di_32
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 3d-INTEGER (64 bit) array on PE 0 and pass address to all PEs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_allocate_shared_3di_64( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)          ::  this         !<
-
-    INTEGER                                 ::  disp_unit    !<
-    INTEGER(iwp), INTENT(IN)                ::  d1e          !<
-    INTEGER(iwp), INTENT(IN)                ::  d1s          !<
-    INTEGER(iwp), INTENT(IN)                ::  d2e          !<
-    INTEGER(iwp), INTENT(IN)                ::  d2s          !<
-    INTEGER(iwp), INTENT(IN)                ::  d3e          !<
-    INTEGER(iwp), INTENT(IN)                ::  d3s          !<
-    INTEGER(iwp), SAVE                      ::  pe_from = 0  !<
-    INTEGER(iwp), INTENT(OUT)               ::  win          !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)          ::  rem_size     !<
-    INTEGER(KIND=MPI_ADDRESS_KIND)          ::  wsize        !<
-
-    INTEGER(iwp), DIMENSION(3)              ::  buf_shape    !<
-
-    INTEGER(idp), DIMENSION(:,:,:), POINTER ::  buf          !<
-    INTEGER(idp), DIMENSION(:,:,:), POINTER ::  p3           !<
-
-    TYPE(C_PTR), SAVE                       ::  base_ptr     !<
-    TYPE(C_PTR), SAVE                       ::  rem_ptr      !<
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-!
-!-- Allocate shared memory on node rank 0 PEs.
-    IF ( this%sh_rank == pe_from )  THEN
-       wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
-    ELSE
-       wsize = 1
-    ENDIF
-
-    wsize = wsize * idp ! Please note, size is always in bytes, independently of the displacement
-                        ! unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, idp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(3) = d3e - d3s + 1
-    buf_shape(2) = d2e - d2s + 1
-    buf_shape(1) = d1e - d1s + 1
-    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
-    p3(d1s:,d2s:,d3s:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_allocate_shared_3di_64
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate shared 3d-REAL (64 Bit) array on ALL PEs.
-!>
-!> Every PE allocates the local part of a node-shared array.
-!> The C-Pointer of this array and the local limits are broadcasted to all PEs of the node
-!> The information is store in an array of type sm_remote_array and can be retrieved
-!> by sm_remote_array to access remote data.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_all_allocate_shared_3d_64( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, remote_arrays, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout)      ::  this         !< class pointer
-    REAL(dp), DIMENSION(:,:,:), POINTER ::  p3           !< return local array pointer
-
-    INTEGER(iwp), INTENT(IN)            ::  d1e          !< end index dimension 1
-    INTEGER(iwp), INTENT(IN)            ::  d1s          !< start index dimension 1
-    INTEGER(iwp), INTENT(IN)            ::  d2e          !< end index dimension 2
-    INTEGER(iwp), INTENT(IN)            ::  d2s          !< start index dimension 2
-    INTEGER(iwp), INTENT(IN)            ::  d3e          !< end index dimension 3
-    INTEGER(iwp), INTENT(IN)            ::  d3s          !< start index dimension 3
-    INTEGER(iwp), INTENT(OUT)           ::  win          !< MPI Window
-
-    INTEGER(iwp), DIMENSION(3)          ::  buf_shape    !<
-    INTEGER(iwp)                        ::  disp_unit    !<
-    INTEGER(iwp)                        ::  i            !<
-    INTEGER(iwp), SAVE                  ::  pe_from = 0  !<
-
-    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  rem_size     !<
-    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  wsize        !<
-
-    REAL(dp), DIMENSION(:,:,:), POINTER ::  buf          !<
-
-    TYPE(sm_remote_array),INTENT(INOUT), DIMENSION(0:this%sh_npes-1) :: remote_arrays !< info about all remote arrays
-
-    TYPE(C_PTR), SAVE                   ::  base_ptr     !<
-
-    INTEGER(iwp),DIMENSION(6,0:this%sh_npes-1)              ::  all_indices_s
-    INTEGER(iwp),DIMENSION(6,0:this%sh_npes-1)              ::  all_indices
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-
-    all_indices_s = 0
-
-
-    wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
-
-    wsize = wsize * dp   ! Please note, size is always in bytes, independently of the displacement unit
-
-    CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
-!
-!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
-
-    all_indices_s(1,this%sh_rank) = d1s
-    all_indices_s(2,this%sh_rank) = d1e
-    all_indices_s(3,this%sh_rank) = d2s
-    all_indices_s(4,this%sh_rank) = d2e
-    all_indices_s(5,this%sh_rank) = d3s
-    all_indices_s(6,this%sh_rank) = d3e
-
-    CALL MPI_ALLREDUCE (all_indices_s ,all_indices, SIZE(all_indices_s), MPI_INTEGER, MPI_SUM, this%comm_shared, ierr)
-
-    DO i=0,this%sh_npes-1
-       CALL MPI_WIN_SHARED_QUERY( win, i, rem_size, disp_unit, remote_arrays(i)%rem_ptr, ierr )
-       remote_arrays(i)%d1s = all_indices(1,i)
-       remote_arrays(i)%d1e = all_indices(2,i)
-       remote_arrays(i)%d2s = all_indices(3,i)
-       remote_arrays(i)%d2e = all_indices(4,i)
-       remote_arrays(i)%d3s = all_indices(5,i)
-       remote_arrays(i)%d3e = all_indices(6,i)
-    END DO
-
-!
-!-- Convert C- to Fortran-pointer
-    buf_shape(3) = d3e - d3s + 1
-    buf_shape(2) = d2e - d2s + 1
-    buf_shape(1) = d1e - d1s + 1
-    CALL C_F_POINTER( remote_arrays(this%sh_rank)%rem_ptr, buf, buf_shape )
-    p3(d1s:,d2s:,d3s:) => buf
-!
-!-- Allocate shared memory in round robin on all PEs of a node.
-    pe_from = MOD( pe_from, this%sh_npes )
-
- END SUBROUTINE sm_all_allocate_shared_3d_64
-#endif
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> ???
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_adjust_outer_boundary( this )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout) ::  this  !<
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-
-    IF ( this%io_grid%nxl == 0 )  THEN
-       this%io_grid%nxl = this%io_grid%nxl - nbgp
-       this%io_grid%nnx = this%io_grid%nnx + nbgp
-    ENDIF
-
-    IF ( this%io_grid%nxr == nx  .OR.  npex == -1 )  THEN   ! npex == -1 if -D__parallel not set
-       this%io_grid%nxr = this%io_grid%nxr + nbgp
-       this%io_grid%nnx = this%io_grid%nnx + nbgp
-    ENDIF
-
-    IF ( this%io_grid%nys == 0 )  THEN
-       this%io_grid%nys = this%io_grid%nys - nbgp
-       this%io_grid%nny = this%io_grid%nny + nbgp
-    ENDIF
-
-    IF ( this%io_grid%nyn == ny .OR.  npey == -1 )  THEN   ! npey == -1 if -D__parallel not set
-       this%io_grid%nyn = this%io_grid%nyn + nbgp
-       this%io_grid%nny = this%io_grid%nny + nbgp
-    ENDIF
-
-    this%io_grid%nxl = this%io_grid%nxl + nbgp
-    this%io_grid%nxr = this%io_grid%nxr + nbgp
-    this%io_grid%nys = this%io_grid%nys + nbgp
-    this%io_grid%nyn = this%io_grid%nyn + nbgp
-    this%io_grid%nnx = this%io_grid%nnx
-    this%io_grid%nny = this%io_grid%nny
-
- END SUBROUTINE sm_adjust_outer_boundary
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Deallocate shared aray and free related window.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_free_shared( this, win )
-
-    IMPLICIT NONE
-
-    CLASS(sm_class), INTENT(inout) ::  this  !<
-
-    INTEGER(iwp), INTENT(INOUT)    ::  win   !<
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-#if defined( __parallel )
-    CALL MPI_WIN_FREE( win, ierr )
-#endif
-    win = -1
-
- END SUBROUTINE sm_free_shared
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> ...
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sm_node_barrier( this, win )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), OPTIONAL         ::  win   !<
-
-    CLASS(sm_class), INTENT(inout) ::  this  !<
-
-
-    IF ( this%no_shared_memory_in_this_run )  RETURN
-
-#if defined( __parallel )
-    CALL MPI_BARRIER( this%comm_shared, ierr )
-#endif
-    IF ( PRESENT(win) )  THEN
-#if defined( __parallel )
-       CALL MPI_WIN_FENCE(0, win, ierr )
-#else
-       CONTINUE
-#endif
-    ENDIF
-
- END SUBROUTINE sm_node_barrier
-
-
- SUBROUTINE save_grid_into_this_class( this )
-
-    IMPLICIT NONE
-
-    CLASS(domain_decomposition_grid_features), INTENT(inout) ::  this  !<
-
-       this%myid     = myid      !<
-       this%nnx      = nnx       !<
-       this%nny      = nny       !<
-       this%nx       = nx        !<
-       this%nxl      = nxl       !<
-       this%nxr      = nxr       !<
-       this%ny       = ny        !<
-       this%nyn      = nyn       !<
-       this%nys      = nys       !<
-       this%numprocs = numprocs  !<
-       this%comm2d   = comm2d    !<
-
- END SUBROUTINE save_grid_into_this_class
-
-
- SUBROUTINE activate_grid_from_this_class( this )
-
-    IMPLICIT NONE
-
-    CLASS(domain_decomposition_grid_features), INTENT(inout) ::  this  !<
-
-       myid     = this%myid      !<
-       nnx      = this%nnx       !<
-       nny      = this%nny       !<
-       nx       = this%nx        !<
-       nxl      = this%nxl       !<
-       nxr      = this%nxr       !<
-       ny       = this%ny        !<
-       nyn      = this%nyn       !<
-       nys      = this%nys       !<
-       numprocs = this%numprocs  !<
-       comm2d   = this%comm2d    !<
-
- END SUBROUTINE activate_grid_from_this_class
-
- END MODULE shared_memory_io_mod
Index: palm/trunk/SOURCE/singleton.f90
===================================================================
--- palm/trunk/SOURCE/singleton.f90	(revision 1)
+++ palm/trunk/SOURCE/singleton.f90	(revision 1)
@@ -0,0 +1,1123 @@
+ MODULE singleton
+
+!-----------------------------------------------------------------------------
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: singleton.f90,v $
+! Revision 1.2  2004/04/30 12:52:09  raasch
+! Shape of arrays is explicitly stored in ishape and handled to the
+! fft-routines instead of the shape-function (due to a compiler error on
+! decalpha)
+!
+! Revision 1.1  2002/05/02 18:56:59  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Multivariate Fast Fourier Transform
+!
+! Fortran 90 Implementation of Singleton's mixed-radix algorithm,
+! RC Singleton, Stanford Research Institute, Sept. 1968.
+!
+! Adapted from fftn.c, translated from Fortran 66 to C by Mark Olesen and
+! John Beale.
+!
+! Fourier transforms can be computed either in place, using assumed size
+! arguments, or by generic function, using assumed shape arguments.
+!
+!
+! Public:
+!
+!   fftkind                              kind parameter of complex arguments
+!                                        and function results.
+!
+!   fft(array, dim, inv, stat)           generic transform function
+!    COMPLEX(fftkind), DIMENSION(:,...,:), INTENT(IN)           :: array
+!    INTEGER,          DIMENSION(:),       INTENT(IN),  OPTIONAL:: dim
+!    LOGICAL,                              INTENT(IN),  OPTIONAL:: inv
+!    INTEGER,                              INTENT(OUT), OPTIONAL:: stat
+!
+!   fftn(array, shape, dim, inv, stat)   in place transform subroutine
+!    COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT)        :: array
+!    INTEGER,          DIMENSION(:), INTENT(IN)           :: shape
+!    INTEGER,          DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
+!    LOGICAL,                        INTENT(IN),  OPTIONAL:: inv
+!    INTEGER,                        INTENT(OUT), OPTIONAL:: stat
+!
+!
+! Formal Parameters:
+!
+!   array    The complex array to be transformed. array can be of arbitrary
+!            rank (i.e. up to seven).
+!
+!   shape    With subroutine fftn, the shape of the array to be transformed
+!            has to be passed separately, since fftradix - the internal trans-
+!            formation routine - will treat array always as one dimensional.
+!            The product of elements in shape must be the number of
+!            elements in array.
+!            Although passing array with assumed shape would have been nicer,
+!            I prefered assumed size in order to prevent the compiler from
+!            using a copy-in-copy-out mechanism. That would generally be
+!            necessary with fftn passing array to fftradix and with fftn
+!            being prepared for accepting non consecutive array sections.
+!            Using assumed size, it's up to the user to pass an array argu-
+!            ment, that can be addressed as continous one dimensional array
+!            without copying. Otherwise, transformation will not really be
+!            performed in place.
+!            On the other hand, since the rank of array and the size of
+!            shape needn't match, fftn is appropriate for handling more than
+!            seven dimensions.
+!            As far as function fft is concerned all this doesn't matter,
+!            because the argument will be copied anyway. Thus no extra
+!            shape argument is needed for fft.
+!
+! Optional Parameters:
+!
+!   dim      One dimensional integer array, containing the dimensions to be
+!            transformed. Default is (/1,...,N/) with N being the rank of
+!            array, i.e. complete transform. dim can restrict transformation
+!            to a subset of available dimensions. Its size must not exceed the
+!            rank of array or the size of shape respectivly.
+!
+!   inv      If .true., inverse transformation will be performed. Default is
+!            .false., i.e. forward transformation.
+!
+!   stat     If present, a system dependent nonzero status value will be
+!            returned in stat, if allocation of temporary storage failed.
+!
+!
+! Scaling:
+!
+!   Transformation results will always be scaled by the square root of the
+!   product of sizes of each dimension in dim. (See examples below)
+!
+!
+! Examples:
+!
+!   Let A be a L*M*N three dimensional complex array. Then
+!
+!     result = fft(A)
+!
+!   will produce a three dimensional transform, scaled by sqrt(L*M*N), while
+!
+!     call fftn(A, SHAPE(A))
+!
+!   will do the same in place.
+!
+!     result = fft(A, dim=(/1,3/))
+!
+!   will transform with respect to the first and the third dimension, scaled
+!   by sqrt(L*N).
+!
+!     result = fft(fft(A), inv=.true.)
+!
+!   should (approximately) reproduce A.
+!   With B having the same shape as A
+!
+!     result = fft(fft(A) * CONJG(fft(B)), inv=.true.)
+!
+!   will correlate A and B.
+!
+!
+! Remarks:
+!
+!   Following changes have been introduced with respect to fftn.c:
+!   - complex arguments and results are of type complex, rather than
+!     real an imaginary part separately.
+!   - increment parameter (magnitude of isign) has been dropped,
+!     inc is always one, direction of transform is given by inv.     
+!   - maxf and maxp have been dropped. The amount of temporary storage
+!     needed is determined by the fftradix routine. Both fftn and fft
+!     can handle any size of array. (Maybe they take a lot of time and
+!     memory, but they will do it)
+!
+!   Redesigning fftradix in a way, that it handles assumed shape arrays
+!   would have been desirable. However, I found it rather hard to do this
+!   in an efficient way. Problems were:
+!   - to prevent stride multiplications when indexing arrays. At least our
+!     compiler was not clever enough to discover that in fact additions
+!     would do the job as well. On the other hand, I haven't been clever
+!     enough to find an implementation using array operations.
+!   - fftradix is rather large and different versions would be necessaray
+!     for each possible rank of array.
+!   Consequently, in place transformation still needs the argument stored
+!   in a consecutive bunch of memory and can't be performed on array
+!   sections like A(100:199:-3, 50:1020). Calling fftn with such sections
+!   will most probably imply copy-in-copy-out. However, the function fft
+!   works with everything it gets and should be convenient to use.
+!
+! Michael Steffens, 09.12.96, <Michael.Steffens@mbox.muk.uni-hannover.de>
+! Restructured fftradix for better optimization. M. Steffens, 4 June 1997
+!-----------------------------------------------------------------------------
+
+    IMPLICIT NONE
+
+    PRIVATE
+    PUBLIC:: fft, fftn, fftkind
+
+    INTEGER, PARAMETER:: fftkind = KIND(0.0) ! adjust here for other precisions
+
+    REAL(fftkind), PARAMETER:: sin60 = 0.86602540378443865_fftkind
+    REAL(fftkind), PARAMETER:: cos72 = 0.30901699437494742_fftkind
+    REAL(fftkind), PARAMETER:: sin72 = 0.95105651629515357_fftkind
+    REAL(fftkind), PARAMETER:: pi    = 3.14159265358979323_fftkind
+
+    INTERFACE fft
+       MODULE PROCEDURE fft1d
+       MODULE PROCEDURE fft2d
+       MODULE PROCEDURE fft3d
+       MODULE PROCEDURE fft4d
+       MODULE PROCEDURE fft5d
+       MODULE PROCEDURE fft6d
+       MODULE PROCEDURE fft7d
+    END INTERFACE
+
+
+ CONTAINS
+
+
+ FUNCTION fft1d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+    COMPLEX(fftkind), DIMENSION(:), INTENT(IN)           :: array
+    INTEGER,          DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
+    LOGICAL,                        INTENT(IN),  OPTIONAL:: inv
+    INTEGER,                        INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+    COMPLEX(fftkind), DIMENSION(SIZE(array, 1)):: ft
+
+    INTEGER ::  ishape(1)
+
+!
+!-- Intrinsics used
+    INTRINSIC SIZE, SHAPE
+
+    ft = array
+    ishape = SHAPE( array )
+    CALL fftn(ft, ishape, inv = inv,  stat = stat)
+
+ END FUNCTION fft1d
+
+
+ FUNCTION fft2d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+    COMPLEX(fftkind), DIMENSION(:,:), INTENT(IN)           :: array
+    INTEGER,          DIMENSION(:),   INTENT(IN),  OPTIONAL:: dim
+    LOGICAL,                          INTENT(IN),  OPTIONAL:: inv
+    INTEGER,                          INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+    COMPLEX(fftkind), DIMENSION(SIZE(array, 1), SIZE(array, 2)):: ft
+
+    INTEGER ::  ishape(2)
+!
+!-- Intrinsics used
+    INTRINSIC SIZE, SHAPE
+
+    ft = array
+    ishape = SHAPE( array )
+    CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft2d
+
+
+ FUNCTION fft3d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+    COMPLEX(fftkind), DIMENSION(:,:,:), INTENT(IN)           :: array
+    INTEGER,          DIMENSION(:),     INTENT(IN),  OPTIONAL:: dim
+    LOGICAL,                            INTENT(IN),  OPTIONAL:: inv
+    INTEGER,                            INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+    COMPLEX(fftkind), &
+         DIMENSION(SIZE(array, 1), SIZE(array, 2), SIZE(array, 3)):: ft
+
+    INTEGER ::  ishape(3)
+
+!
+!-- Intrinsics used
+    INTRINSIC SIZE, SHAPE
+
+    ft = array
+    ishape = SHAPE( array)
+    CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft3d
+
+
+ FUNCTION fft4d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+    COMPLEX(fftkind), DIMENSION(:,:,:,:), INTENT(IN)           :: array
+    INTEGER,          DIMENSION(:),       INTENT(IN),  OPTIONAL:: dim
+    LOGICAL,                              INTENT(IN),  OPTIONAL:: inv
+    INTEGER,                              INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+    COMPLEX(fftkind), DIMENSION( &
+         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4)):: ft
+
+    INTEGER ::  ishape(4)
+!
+!-- Intrinsics used
+    INTRINSIC SIZE, SHAPE
+
+    ft = array
+    ishape = SHAPE( array )
+    CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft4d
+
+
+ FUNCTION fft5d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+    COMPLEX(fftkind), DIMENSION(:,:,:,:,:), INTENT(IN)           :: array
+    INTEGER,          DIMENSION(:),         INTENT(IN),  OPTIONAL:: dim
+    LOGICAL,                                INTENT(IN),  OPTIONAL:: inv
+    INTEGER,                                INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+    COMPLEX(fftkind), DIMENSION( &
+         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
+         SIZE(array, 5)):: ft
+
+    INTEGER ::  ishape(5)
+
+!
+!-- Intrinsics used
+    INTRINSIC SIZE, SHAPE
+
+    ft = array
+    ishape = SHAPE( array )
+    CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft5d
+
+
+ FUNCTION fft6d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+    COMPLEX(fftkind), DIMENSION(:,:,:,:,:,:), INTENT(IN)           :: array
+    INTEGER,          DIMENSION(:),           INTENT(IN),  OPTIONAL:: dim
+    LOGICAL,                                  INTENT(IN),  OPTIONAL:: inv
+    INTEGER,                                  INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+    COMPLEX(fftkind), DIMENSION( &
+         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
+         SIZE(array, 5), SIZE(array, 6)):: ft
+
+    INTEGER ::  ishape(6)
+
+!
+!-- Intrinsics used
+    INTRINSIC SIZE, SHAPE
+
+    ft = array
+    ishape = SHAPE( array )
+    CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft6d
+
+
+ FUNCTION fft7d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+    COMPLEX(fftkind), DIMENSION(:,:,:,:,:,:,:), INTENT(IN)           :: array
+    INTEGER,          DIMENSION(:),             INTENT(IN),  OPTIONAL:: dim
+    LOGICAL,                                    INTENT(IN),  OPTIONAL:: inv
+    INTEGER,                                    INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+    COMPLEX(fftkind), DIMENSION( &
+         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
+         SIZE(array, 5), SIZE(array, 6), SIZE(array, 7)):: ft
+
+    INTEGER ::  ishape(7)
+
+!
+!-- Intrinsics used
+    INTRINSIC SIZE, SHAPE
+
+    ft = array
+    ishape = SHAPE( array )
+    CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft7d
+
+
+ SUBROUTINE fftn(array, shape, dim, inv, stat)
+!
+!-- Formal parameters
+    COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT)        :: array
+    INTEGER,          DIMENSION(:), INTENT(IN)           :: shape
+    INTEGER,          DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
+    LOGICAL,                        INTENT(IN),  OPTIONAL:: inv
+    INTEGER,                        INTENT(OUT), OPTIONAL:: stat
+!
+!-- Local arrays
+    INTEGER, DIMENSION(SIZE(shape)):: d
+!
+!-- Local scalars
+    LOGICAL      :: inverse
+    INTEGER      :: i, ndim, ntotal
+    REAL(fftkind):: scale
+!
+!-- Intrinsics used
+    INTRINSIC PRESENT, MIN, PRODUCT, SIZE, SQRT
+
+!
+!-- Optional parameter settings
+    IF (PRESENT(inv)) THEN
+       inverse = inv
+    ELSE
+       inverse = .FALSE.
+    END IF
+    IF (PRESENT(dim)) THEN
+       ndim = MIN(SIZE(dim), SIZE(d))
+       d(1:ndim) = DIM(1:ndim)
+    ELSE
+       ndim = SIZE(d)
+       d = (/(i, i = 1, SIZE(d))/)
+    END IF
+
+    ntotal = PRODUCT(shape)
+    scale = SQRT(1.0_fftkind / PRODUCT(shape(d(1:ndim))))
+    DO i = 1, ntotal
+       array(i) = CMPLX(REAL(array(i)) * scale, AIMAG(array(i)) * scale, &
+            KIND=fftkind)
+    END DO
+
+    DO i = 1, ndim
+       CALL fftradix(array, ntotal, shape(d(i)), PRODUCT(shape(1:d(i))), &
+            inverse, stat)
+       IF (PRESENT(stat)) THEN
+          IF (stat /=0) RETURN
+       END IF
+    END DO
+
+ END SUBROUTINE fftn
+
+
+ SUBROUTINE fftradix(array, ntotal, npass, nspan, inv, stat)
+!
+!-- Formal parameters
+    COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT)        :: array
+    INTEGER,                        INTENT(IN)           :: ntotal, npass, nspan
+    LOGICAL,                        INTENT(IN)           :: inv
+    INTEGER,                        INTENT(OUT), OPTIONAL:: stat
+!
+!-- Local arrays
+    INTEGER,          DIMENSION(BIT_SIZE(0))     :: factor
+    COMPLEX(fftkind), DIMENSION(:), ALLOCATABLE  :: ctmp
+    REAL(fftkind),    DIMENSION(:), ALLOCATABLE  :: sine, cosine
+    INTEGER,          DIMENSION(:), ALLOCATABLE  :: perm
+!
+!-- Local scalars
+    INTEGER         :: maxfactor, nfactor, nsquare, nperm
+!
+!-- Intrinsics used
+    INTRINSIC MAXVAL, MOD, PRESENT, ISHFT, BIT_SIZE, SIN, COS, &
+         CMPLX, REAL, AIMAG
+
+    IF (npass <= 1) RETURN
+
+    CALL factorize(npass, factor, nfactor, nsquare)
+
+    maxfactor = MAXVAL(factor(:nfactor))
+    IF (nfactor - ISHFT(nsquare, 1) > 0) THEN
+       nperm = MAX(nfactor + 1, PRODUCT(factor(nsquare+1: nfactor-nsquare)) - 1)
+    ELSE
+       nperm = nfactor + 1
+    END IF
+
+    IF (PRESENT(stat)) THEN
+       ALLOCATE(ctmp(maxfactor), sine(maxfactor), cosine(maxfactor), STAT=stat)
+       IF (stat /= 0) RETURN
+       CALL transform(array, ntotal, npass, nspan, &
+            factor, nfactor, ctmp, sine, cosine, inv)
+       DEALLOCATE(sine, cosine, STAT=stat)
+       IF (stat /= 0) RETURN
+       ALLOCATE(perm(nperm), STAT=stat)
+       IF (stat /= 0) RETURN
+       CALL permute(array, ntotal, npass, nspan, &
+            factor, nfactor, nsquare, maxfactor, &
+            ctmp, perm)
+       DEALLOCATE(perm, ctmp, STAT=stat)
+       IF (stat /= 0) RETURN
+    ELSE
+       ALLOCATE(ctmp(maxfactor), sine(maxfactor), cosine(maxfactor))
+       CALL transform(array, ntotal, npass, nspan, &
+            factor, nfactor, ctmp, sine, cosine, inv)
+       DEALLOCATE(sine, cosine)
+       ALLOCATE(perm(nperm))
+       CALL permute(array, ntotal, npass, nspan, &
+            factor, nfactor, nsquare, maxfactor, &
+            ctmp, perm)
+       DEALLOCATE(perm, ctmp)
+    END IF
+
+
+  CONTAINS
+
+
+    SUBROUTINE factorize(npass, factor, nfactor, nsquare)
+!
+!--   Formal parameters
+      INTEGER,               INTENT(IN) :: npass
+      INTEGER, DIMENSION(*), INTENT(OUT):: factor
+      INTEGER,               INTENT(OUT):: nfactor, nsquare
+!
+!--   Local scalars
+      INTEGER:: j, jj, k
+
+      nfactor = 0
+      k = npass
+      DO WHILE (MOD(k, 16) == 0) 
+         nfactor = nfactor + 1
+         factor(nfactor) = 4
+         k = k / 16
+      END DO
+      j = 3
+      jj = 9
+      DO
+         DO WHILE (MOD(k, jj) == 0)
+            nfactor = nfactor + 1
+            factor(nfactor) = j
+            k = k / jj
+         END DO
+         j = j + 2
+         jj = j * j
+         IF (jj > k) EXIT
+      END DO
+      IF (k <= 4) THEN
+         nsquare = nfactor
+         factor(nfactor + 1) = k
+         IF (k /= 1) nfactor = nfactor + 1
+      ELSE 
+         IF (k - ISHFT(k / 4, 2) == 0) THEN
+            nfactor = nfactor + 1
+            factor(nfactor) = 2
+            k = k / 4
+         END IF
+         nsquare = nfactor
+         j = 2
+         DO
+            IF (MOD(k, j) == 0) THEN
+               nfactor = nfactor + 1
+               factor(nfactor) = j
+               k = k / j
+            END IF
+            j = ISHFT((j + 1) / 2, 1) + 1
+            IF (j > k) EXIT
+         END DO
+      END IF
+      IF (nsquare > 0) THEN
+         j = nsquare
+         DO
+            nfactor = nfactor + 1
+            factor(nfactor) = factor(j)
+            j = j - 1
+            IF (j==0) EXIT
+         END DO
+      END IF
+
+    END SUBROUTINE factorize
+
+
+    SUBROUTINE transform(array, ntotal, npass, nspan, &
+         factor, nfactor, ctmp, sine, cosine, inv) !-- compute fourier transform
+!
+!--   Formal parameters
+      COMPLEX(fftkind), DIMENSION(*), INTENT(IN OUT):: array
+      INTEGER,                        INTENT(IN)    :: ntotal, npass, nspan
+      INTEGER,          DIMENSION(*), INTENT(IN)    :: factor
+      INTEGER,                        INTENT(IN)    :: nfactor
+      COMPLEX(fftkind), DIMENSION(*), INTENT(OUT)   :: ctmp
+      REAL(fftkind),    DIMENSION(*), INTENT(OUT)   :: sine, cosine
+      LOGICAL,                        INTENT(IN)    :: inv
+!
+!--   Local scalars
+      INTEGER         :: ii, ispan
+      INTEGER         :: j, jc, jf, jj
+      INTEGER         :: k, kk, kspan, k1, k2, k3, k4
+      INTEGER         :: nn, nt
+      REAL(fftkind)   :: s60, c72, s72, pi2, radf
+      REAL(fftkind)   :: c1, s1, c2, s2, c3, s3, cd, sd, ak
+      COMPLEX(fftkind):: cc, cj, ck, cjp, cjm, ckp, ckm
+
+      c72 = cos72
+      IF (inv) THEN
+         s72 = sin72
+         s60 = sin60
+         pi2 = pi
+      ELSE
+         s72 = -sin72
+         s60 = -sin60
+         pi2 = -pi
+      END IF
+
+      nt = ntotal
+      nn = nt - 1
+      kspan = nspan
+      jc = nspan / npass
+      radf = pi2 * jc
+      pi2 = pi2 * 2.0_fftkind !-- use 2 PI from here on
+
+      ii = 0
+      jf = 0
+      DO
+         sd = radf / kspan
+         cd = SIN(sd)
+         cd = 2.0_fftkind * cd * cd
+         sd = SIN(sd + sd)
+         kk = 1
+         ii = ii + 1
+
+         SELECT CASE (factor(ii))
+         CASE (2)
+!
+!--         Transform for factor of 2 (including rotation factor)
+            kspan = kspan / 2
+            k1 = kspan + 2
+            DO
+               DO
+                  k2 = kk + kspan
+                  ck = array(k2)
+                  array(k2) = array(kk)-ck
+                  array(kk) = array(kk) + ck
+                  kk = k2 + kspan
+                  IF (kk > nn) EXIT
+               END DO
+               kk = kk - nn
+               IF (kk > jc) EXIT
+            END DO
+            IF (kk > kspan) RETURN
+            DO
+               c1 = 1.0_fftkind - cd
+               s1 = sd
+               DO
+                  DO
+                     DO
+                        k2 = kk + kspan
+                        ck = array(kk) - array(k2)
+                        array(kk) = array(kk) + array(k2)
+                        array(k2) = ck * CMPLX(c1, s1, KIND=fftkind)
+                        kk = k2 + kspan
+                        IF (kk >= nt) EXIT
+                     END DO
+                     k2 = kk - nt
+                     c1 = -c1
+                     kk = k1 - k2
+                     IF (kk <= k2) EXIT
+                  END DO
+                  ak = c1 - (cd * c1 + sd * s1)
+                  s1 = sd * c1 - cd * s1 + s1
+                  c1 = 2.0_fftkind - (ak * ak + s1 * s1)
+                  s1 = s1 * c1
+                  c1 = c1 * ak
+                  kk = kk + jc
+                  IF (kk >= k2) EXIT
+               END DO
+               k1 = k1 + 1 + 1
+               kk = (k1 - kspan) / 2 + jc
+               IF (kk > jc + jc) EXIT
+            END DO
+
+         CASE (4) !-- transform for factor of 4
+            ispan = kspan
+            kspan = kspan / 4
+
+            DO
+               c1 = 1.0_fftkind
+               s1 = 0.0_fftkind
+               DO
+                  DO
+                     k1 = kk + kspan
+                     k2 = k1 + kspan
+                     k3 = k2 + kspan
+                     ckp = array(kk) + array(k2)
+                     ckm = array(kk) - array(k2)
+                     cjp = array(k1) + array(k3)
+                     cjm = array(k1) - array(k3)
+                     array(kk) = ckp + cjp
+                     cjp = ckp - cjp
+                     IF (inv) THEN
+                        ckp = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=fftkind)
+                        ckm = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=fftkind)
+                     ELSE
+                        ckp = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=fftkind)
+                        ckm = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=fftkind)
+                     END IF
+!
+!--                  Avoid useless multiplies
+                     IF (s1 == 0.0_fftkind) THEN
+                        array(k1) = ckp
+                        array(k2) = cjp
+                        array(k3) = ckm
+                     ELSE
+                        array(k1) = ckp * CMPLX(c1, s1, KIND=fftkind)
+                        array(k2) = cjp * CMPLX(c2, s2, KIND=fftkind)
+                        array(k3) = ckm * CMPLX(c3, s3, KIND=fftkind)
+                     END IF
+                     kk = k3 + kspan
+                     IF (kk > nt) EXIT
+                  END DO
+
+                  c2 = c1 - (cd * c1 + sd * s1)
+                  s1 = sd * c1 - cd * s1 + s1
+                  c1 = 2.0_fftkind - (c2 * c2 + s1 * s1)
+                  s1 = s1 * c1
+                  c1 = c1 * c2
+!
+!--               Values of c2, c3, s2, s3 that will get used next time
+                  c2 = c1 * c1 - s1 * s1
+                  s2 = 2.0_fftkind * c1 * s1
+                  c3 = c2 * c1 - s2 * s1
+                  s3 = c2 * s1 + s2 * c1
+                  kk = kk - nt + jc
+                  IF (kk > kspan) EXIT
+               END DO
+               kk = kk - kspan + 1
+               IF (kk > jc) EXIT
+            END DO
+            IF (kspan == jc) RETURN
+
+         CASE default
+!
+!--         Transform for odd factors
+            k = factor(ii)
+            ispan = kspan
+            kspan = kspan / k
+
+            SELECT CASE (k)
+            CASE (3) !-- transform for factor of 3 (optional code)
+               DO
+                  DO
+                     k1 = kk + kspan
+                     k2 = k1 + kspan
+                     ck = array(kk)
+                     cj = array(k1) + array(k2)
+                     array(kk) = ck + cj
+                     ck = ck - CMPLX( &
+                          0.5_fftkind * REAL (cj), &
+                          0.5_fftkind * AIMAG(cj), &
+                          KIND=fftkind)
+                     cj = CMPLX( &
+                          (REAL (array(k1)) - REAL (array(k2))) * s60, &
+                          (AIMAG(array(k1)) - AIMAG(array(k2))) * s60, &
+                          KIND=fftkind)
+                     array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
+                     array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
+                     kk = k2 + kspan
+                     IF (kk >= nn) EXIT
+                  END DO
+                  kk = kk - nn
+                  IF (kk > kspan) EXIT
+               END DO
+
+            CASE (5) !-- transform for factor of 5 (optional code)
+               c2 = c72 * c72 - s72 * s72
+               s2 = 2.0_fftkind * c72 * s72
+               DO
+                  DO
+                     k1 = kk + kspan
+                     k2 = k1 + kspan
+                     k3 = k2 + kspan
+                     k4 = k3 + kspan
+                     ckp = array(k1) + array(k4)
+                     ckm = array(k1) - array(k4)
+                     cjp = array(k2) + array(k3)
+                     cjm = array(k2) - array(k3)
+                     cc = array(kk)
+                     array(kk) = cc + ckp + cjp
+                     ck = CMPLX(REAL(ckp) * c72, AIMAG(ckp) * c72, &
+                          KIND=fftkind) + &
+                          CMPLX(REAL(cjp) * c2,  AIMAG(cjp) * c2,  &
+                          KIND=fftkind) + cc
+                     cj = CMPLX(REAL(ckm) * s72, AIMAG(ckm) * s72, &
+                          KIND=fftkind) + &
+                          CMPLX(REAL(cjm) * s2,  AIMAG(cjm) * s2,  &
+                          KIND=fftkind)
+                     array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
+                     array(k4) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
+                     ck = CMPLX(REAL(ckp) * c2,  AIMAG(ckp) * c2,  &
+                          KIND=fftkind) + &
+                          CMPLX(REAL(cjp) * c72, AIMAG(cjp) * c72, &
+                          KIND=fftkind) + cc
+                     cj = CMPLX(REAL(ckm) * s2,  AIMAG(ckm) * s2,  &
+                          KIND=fftkind) - &
+                          CMPLX(REAL(cjm) * s72, AIMAG(cjm) * s72, &
+                          KIND=fftkind)
+                     array(k2) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
+                     array(k3) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
+                     kk = k4 + kspan
+                     IF (kk >= nn) EXIT
+                  END DO
+                  kk = kk - nn
+                  IF (kk > kspan) EXIT
+               END DO
+
+            CASE default
+               IF (k /= jf) THEN
+                  jf = k
+                  s1 = pi2 / k
+                  c1 = COS(s1)
+                  s1 = SIN(s1)
+                  cosine (jf) = 1.0_fftkind
+                  sine (jf) = 0.0_fftkind
+                  j = 1
+                  DO
+                     cosine (j) = cosine (k) * c1 + sine (k) * s1
+                     sine (j) = cosine (k) * s1 - sine (k) * c1
+                     k = k-1
+                     cosine (k) = cosine (j)
+                     sine (k) = -sine (j)
+                     j = j + 1
+                     IF (j >= k) EXIT
+                  END DO
+               END IF
+               DO
+                  DO
+                     k1 = kk
+                     k2 = kk + ispan
+                     cc = array(kk)
+                     ck = cc
+                     j = 1
+                     k1 = k1 + kspan
+                     DO
+                        k2 = k2 - kspan
+                        j = j + 1
+                        ctmp(j) = array(k1) + array(k2)
+                        ck = ck + ctmp(j)
+                        j = j + 1
+                        ctmp(j) = array(k1) - array(k2)
+                        k1 = k1 + kspan
+                        IF (k1 >= k2) EXIT
+                     END DO
+                     array(kk) = ck
+                     k1 = kk
+                     k2 = kk + ispan
+                     j = 1
+                     DO
+                        k1 = k1 + kspan
+                        k2 = k2 - kspan
+                        jj = j
+                        ck = cc
+                        cj = (0.0_fftkind, 0.0_fftkind)
+                        k = 1
+                        DO
+                           k = k + 1
+                           ck = ck + CMPLX( &
+                                REAL (ctmp(k)) * cosine(jj), &
+                                AIMAG(ctmp(k)) * cosine(jj), KIND=fftkind)
+                           k = k + 1
+                           cj = cj + CMPLX( &
+                                REAL (ctmp(k)) * sine(jj), &
+                                AIMAG(ctmp(k)) * sine(jj), KIND=fftkind)
+                           jj = jj + j
+                           IF (jj > jf) jj = jj - jf
+                           IF (k >= jf) EXIT
+                        END DO
+                        k = jf - j
+                        array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), &
+                             KIND=fftkind)
+                        array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), &
+                             KIND=fftkind)
+                        j = j + 1
+                        IF (j >= k) EXIT
+                     END DO
+                     kk = kk + ispan
+                     IF (kk > nn) EXIT
+                  END DO
+                  kk = kk - nn
+                  IF (kk > kspan) EXIT
+               END DO
+
+            END SELECT
+!
+!--         Multiply by rotation factor (except for factors of 2 and 4)
+            IF (ii == nfactor) RETURN
+            kk = jc + 1
+            DO
+               c2 = 1.0_fftkind - cd
+               s1 = sd
+               DO
+                  c1 = c2
+                  s2 = s1
+                  kk = kk + kspan
+                  DO
+                     DO
+                        array(kk) = CMPLX(c2, s2, KIND=fftkind) * array(kk)
+                        kk = kk + ispan
+                        IF (kk > nt) EXIT
+                     END DO
+                     ak = s1 * s2
+                     s2 = s1 * c2 + c1 * s2
+                     c2 = c1 * c2 - ak
+                     kk = kk - nt + kspan
+                     IF (kk > ispan) EXIT
+                  END DO
+                  c2 = c1 - (cd * c1 + sd * s1)
+                  s1 = s1 + sd * c1 - cd * s1
+                  c1 = 2.0_fftkind - (c2 * c2 + s1 * s1)
+                  s1 = s1 * c1
+                  c2 = c2 * c1
+                  kk = kk - ispan + jc
+                  IF (kk > kspan) EXIT
+               END DO
+               kk = kk - kspan + jc + 1
+               IF (kk > jc + jc) EXIT
+            END DO
+
+         END SELECT
+      END DO
+    END SUBROUTINE transform
+
+
+    SUBROUTINE permute(array, ntotal, npass, nspan, &
+         factor, nfactor, nsquare, maxfactor, &
+         ctmp, perm)
+!
+!--   Formal parameters
+      COMPLEX(fftkind), DIMENSION(*), INTENT(IN OUT):: array
+      INTEGER,                        INTENT(IN)    :: ntotal, npass, nspan
+      INTEGER,          DIMENSION(*), INTENT(IN OUT):: factor
+      INTEGER,                        INTENT(IN)    :: nfactor, nsquare
+      INTEGER,                        INTENT(IN)    :: maxfactor
+      COMPLEX(fftkind), DIMENSION(*), INTENT(OUT)   :: ctmp
+      INTEGER,          DIMENSION(*), INTENT(OUT)   :: perm
+!
+!--   Local scalars
+      INTEGER         :: ii, ispan
+      INTEGER         :: j, jc, jj
+      INTEGER         :: k, kk, kspan, kt, k1, k2, k3
+      INTEGER         :: nn, nt
+      COMPLEX(fftkind):: ck
+
+!
+!--   Permute the results to normal order---done in two stages
+!--   Permutation for square factors of n
+
+      nt = ntotal
+      nn = nt - 1
+      kt = nsquare
+      kspan = nspan
+      jc = nspan / npass
+
+      perm (1) = nspan
+      IF (kt > 0) THEN
+         k = kt + kt + 1
+         IF (nfactor < k) k = k - 1
+         j = 1
+         perm (k + 1) = jc
+         DO
+            perm (j + 1) = perm (j) / factor(j)
+            perm (k) = perm (k + 1) * factor(j)
+            j = j + 1
+            k = k - 1
+            IF (j >= k) EXIT
+         END DO
+         k3 = perm (k + 1)
+         kspan = perm (2)
+         kk = jc + 1
+         k2 = kspan + 1
+         j = 1
+
+         IF (npass /= ntotal) THEN
+            permute_multi: DO
+               DO
+                  DO
+                     k = kk + jc
+                     DO
+!
+!--                     Swap array(kk) <> array(k2)
+                        ck = array(kk)
+                        array(kk) = array(k2)
+                        array(k2) = ck
+                        kk = kk + 1
+                        k2 = k2 + 1
+                        IF (kk >= k) EXIT
+                     END DO
+                     kk = kk + nspan - jc
+                     k2 = k2 + nspan - jc
+                     IF (kk >= nt) EXIT
+                  END DO
+                  kk = kk - nt + jc
+                  k2 = k2 - nt + kspan
+                  IF (k2 >= nspan) EXIT
+               END DO
+               DO
+                  DO
+                     k2 = k2 - perm (j)
+                     j = j + 1
+                     k2 = perm (j + 1) + k2
+                     IF (k2 <= perm (j)) EXIT
+                  END DO
+                  j = 1
+                  DO
+                     IF (kk < k2) CYCLE permute_multi
+                     kk = kk + jc
+                     k2 = k2 + kspan
+                     IF (k2 >= nspan) EXIT
+                  END DO
+                  IF (kk >= nspan) EXIT
+               END DO
+               EXIT
+            END DO permute_multi
+         ELSE
+            permute_single: DO
+               DO
+!
+!--               Swap array(kk) <> array(k2)
+                  ck = array(kk)
+                  array(kk) = array(k2)
+                  array(k2) = ck
+                  kk = kk + 1
+                  k2 = k2 + kspan
+                  IF (k2 >= nspan) EXIT
+               END DO
+               DO
+                  DO
+                     k2 = k2 - perm (j)
+                     j = j + 1
+                     k2 = perm (j + 1) + k2
+                     IF (k2 <= perm (j)) EXIT
+                  END DO
+                  j = 1
+                  DO
+                     IF (kk < k2) CYCLE permute_single
+                     kk = kk + 1
+                     k2 = k2 + kspan
+                     IF (k2 >= nspan) EXIT
+                  END DO
+                  IF (kk >= nspan) EXIT
+               END DO
+               EXIT
+            END DO permute_single
+         END IF
+         jc = k3
+      END IF
+
+      IF (ISHFT(kt, 1) + 1 >= nfactor) RETURN
+
+      ispan = perm (kt + 1)
+!
+!--   Permutation for square-free factors of n
+      j = nfactor - kt
+      factor(j + 1) = 1
+      DO
+         factor(j) = factor(j) * factor(j+1)
+         j = j - 1
+         IF (j == kt) EXIT
+      END DO
+      kt = kt + 1
+      nn = factor(kt) - 1
+      j = 0
+      jj = 0
+      DO
+         k = kt + 1
+         k2 = factor(kt)
+         kk = factor(k)
+         j = j + 1
+         IF (j > nn) EXIT !-- exit infinite loop
+         jj = jj + kk
+         DO WHILE (jj >= k2)
+            jj = jj - k2
+            k2 = kk
+            k = k + 1
+            kk = factor(k)
+            jj = jj + kk
+         END DO
+         perm (j) = jj
+      END DO
+!
+!--   Determine the permutation cycles of length greater than 1
+      j = 0
+      DO
+         DO
+            j = j + 1
+            kk = perm(j)
+            IF (kk >= 0) EXIT
+         END DO
+         IF (kk /= j) THEN
+            DO
+               k = kk
+               kk = perm (k)
+               perm (k) = -kk
+               IF (kk == j) EXIT
+            END DO
+            k3 = kk
+         ELSE
+            perm (j) = -j
+            IF (j == nn) EXIT !-- exit infinite loop
+         END IF
+      END DO
+!
+!--   Reorder a and b, following the permutation cycles
+      DO
+         j = k3 + 1
+         nt = nt - ispan
+         ii = nt - 1 + 1
+         IF (nt < 0) EXIT !-- exit infinite loop
+         DO
+            DO
+               j = j-1
+               IF (perm(j) >= 0) EXIT
+            END DO
+            jj = jc
+            DO
+               kspan = jj
+               IF (jj > maxfactor) kspan = maxfactor
+               jj = jj - kspan
+               k = perm(j)
+               kk = jc * k + ii + jj
+               k1 = kk + kspan
+               k2 = 0
+               DO
+                  k2 = k2 + 1
+                  ctmp(k2) = array(k1)
+                  k1 = k1 - 1
+                  IF (k1 == kk) EXIT
+               END DO
+               DO
+                  k1 = kk + kspan
+                  k2 = k1 - jc * (k + perm(k))
+                  k = -perm(k)
+                  DO
+                     array(k1) = array(k2)
+                     k1 = k1 - 1
+                     k2 = k2 - 1
+                     IF (k1 == kk) EXIT
+                  END DO
+                  kk = k2
+                  IF (k == j) EXIT
+               END DO
+               k1 = kk + kspan
+               k2 = 0
+               DO
+                  k2 = k2 + 1
+                  array(k1) = ctmp(k2)
+                  k1 = k1 - 1
+                  IF (k1 == kk) EXIT
+               END DO
+               IF (jj == 0) EXIT
+            END DO
+            IF (j == 1) EXIT
+         END DO
+      END DO
+
+    END SUBROUTINE permute
+
+ END SUBROUTINE fftradix
+
+ END MODULE singleton
Index: palm/trunk/SOURCE/singleton_mod.f90
===================================================================
--- palm/trunk/SOURCE/singleton_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,1165 +1,0 @@
-!> @file singleton_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! Statement added to prevent compiler warning about unused variables
-!
-! Revision 1.1  2002/05/02 18:56:59  raasch
-! Initial revision
-!
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Multivariate Fast Fourier Transform
-!>
-!> Fortran 90 Implementation of Singleton's mixed-radix algorithm, RC Singleton, Stanford Research
-!> Institute, Sept. 1968.
-!>
-!> Adapted from fftn.c, translated from Fortran 66 to C by Mark Olesen and John Beale.
-!>
-!> Fourier transforms can be computed either in place, using assumed size arguments, or by generic
-!> function, using assumed shape arguments.
-!>
-!> Public:
-!>
-!>   fftkind                              kind parameter of complex arguments and function results.
-!>
-!>   fft(array, dim, inv, stat)           generic transform function
-!>    COMPLEX(fftkind), DIMENSION(:,...,:), INTENT(IN)           :: array
-!>    INTEGER,          DIMENSION(:),       INTENT(IN),  OPTIONAL:: dim
-!>    LOGICAL,                              INTENT(IN),  OPTIONAL:: inv
-!>    INTEGER,                              INTENT(OUT), OPTIONAL:: stat
-!>
-!>   fftn(array, shape, dim, inv, stat)   in place transform subroutine
-!>    COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT)        :: array
-!>    INTEGER,          DIMENSION(:), INTENT(IN)           :: shape
-!>    INTEGER,          DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
-!>    LOGICAL,                        INTENT(IN),  OPTIONAL:: inv
-!>    INTEGER,                        INTENT(OUT), OPTIONAL:: stat
-!>
-!>
-!> Formal Parameters:
-!>
-!>   array    The complex array to be transformed. Array can be of arbitrary rank (i.e. up to seven).
-!>
-!>   shape    With subroutine fftn, the shape of the array to be transformed has to be passed
-!>            separately, since fftradix - the internal transformation routine - will always treat
-!>            array as one dimensional. The product of elements in shape must be the number of
-!>            elements in array.
-!>            Although passing array with assumed shape would have been nicer, I prefered assumed
-!>            size in order to prevent the compiler from using a copy-in-copy-out mechanism. That
-!>            would generally be necessary with fftn passing array to fftradix and with fftn being
-!>            prepared for accepting non consecutive array sections. Using assumed size, it's up to
-!>            the user to pass an array argument, that can be addressed as continous one dimensional
-!>            array without copying. Otherwise, transformation will not really be performed in place.
-!>            On the other hand, since the rank of array and the size of shape needn't match, fftn
-!>            is appropriate for handling more than seven dimensions. As far as function fft is
-!>            concerned all this doesn't matter, because the argument will be copied anyway. Thus no
-!>            extra shape argument is needed for fft.
-!>
-!> Optional Parameters:
-!>
-!>   dim      One dimensional integer array, containing the dimensions to be transformed. Default
-!>            is (/1,...,N/) with N being the rank of array, i.e. complete transform. dim can
-!>            restrict transformation to a subset of available dimensions. Its size must not exceed
-!>            the rank of array or the size of shape respectivly.
-!>
-!>   inv      If .true., inverse transformation will be performed. Default is .false., i.e. forward
-!>            transformation.
-!>
-!>   stat     If present, a system dependent nonzero status value will be returned in stat, if
-!>            allocation of temporary storage failed.
-!>
-!>
-!> Scaling:
-!>
-!>   Transformation results will always be scaled by the square root of the product of sizes of each
-!>   dimension in dim. (See examples below)
-!>
-!>
-!> Examples:
-!>
-!>   Let A be a L*M*N three dimensional complex array. Then
-!>
-!>     result = fft(A)
-!>
-!>   will produce a three dimensional transform, scaled by sqrt(L*M*N), while
-!>
-!>     call fftn(A, SHAPE(A))
-!>
-!>   will do the same in place.
-!>
-!>     result = fft(A, dim=(/1,3/))
-!>
-!>   will transform with respect to the first and the third dimension, scaled by sqrt(L*N).
-!>
-!>     result = fft(fft(A), inv=.true.)
-!>
-!>   should (approximately) reproduce A.
-!>   With B having the same shape as A
-!>
-!>     result = fft(fft(A) * CONJG(fft(B)), inv=.true.)
-!>
-!>   will correlate A and B.
-!>
-!>
-!> Remarks:
-!>
-!>   Following changes have been introduced with respect to fftn.c:
-!>   - Complex arguments and results are of type complex, rather than real an imaginary part
-!>     separately.
-!>   - Increment parameter (magnitude of isign) has been dropped, inc is always one, direction of
-!>     transform is given by inv.
-!>   - maxf and maxp have been dropped. The amount of temporary storage needed is determined by the
-!>     fftradix routine. Both fftn and fft can handle any size of array. (Maybe they take a lot of
-!>     time and memory, but they will do it)
-!>
-!>   Redesigning fftradix in a way, that it handles assumed shape arrays would have been desirable.
-!>   However, I found it rather hard to do this in an efficient way. Problems were:
-!>   - To prevent stride multiplications when indexing arrays. At least our compiler was not clever
-!>     enough to discover that in fact additions would do the job as well. On the other hand, I
-!>     haven't been clever enough to find an implementation using array operations.
-!>   - fftradix is rather large and different versions would be necessaray for each possible rank of
-!>     array.
-!>   Consequently, in place transformation still needs the argument stored in a consecutive bunch of
-!>   memory and can't be performed on array sections like A(100:199:-3, 50:1020). Calling fftn with
-!>   such sections will most probably imply copy-in-copy-out. However, the function fft works with
-!>   everything it gets and should be convenient to use.
-!>
-!> Michael Steffens, 09.12.96, <Michael.Steffens@mbox.muk.uni-hannover.de>
-!> Restructured fftradix for better optimization. M. Steffens, 4 June 1997
-!--------------------------------------------------------------------------------------------------!
- MODULE singleton
-
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    PRIVATE
-    PUBLIC ::  fft   !<
-    PUBLIC ::  fftn  !<
-
-    REAL(wp), PARAMETER ::  cos72 = 0.30901699437494742_wp  !<
-    REAL(wp), PARAMETER ::  pi    = 3.14159265358979323_wp  !<
-    REAL(wp), PARAMETER ::  sin60 = 0.86602540378443865_wp  !<
-    REAL(wp), PARAMETER ::  sin72 = 0.95105651629515357_wp  !<
-
-    INTERFACE fft
-       MODULE PROCEDURE fft1d
-       MODULE PROCEDURE fft2d
-       MODULE PROCEDURE fft3d
-       MODULE PROCEDURE fft4d
-       MODULE PROCEDURE fft5d
-       MODULE PROCEDURE fft6d
-       MODULE PROCEDURE fft7d
-    END INTERFACE
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing function description.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION fft1d( array, dim, inv, stat ) RESULT( ft )
-!
-!-- Formal parameters
-    COMPLEX(wp),  DIMENSION(:), INTENT(IN)            ::  array  !<
-    INTEGER(iwp), DIMENSION(:), INTENT(IN),  OPTIONAL ::  dim    !<
-    INTEGER(iwp),               INTENT(OUT), OPTIONAL ::  stat   !<
-    LOGICAL,                    INTENT(IN),  OPTIONAL ::  inv    !<
-!
-!-- Function result
-    COMPLEX(wp), DIMENSION(SIZE(array, 1)) ::  ft  !<
-
-    INTEGER(iwp) ::  idum       !<
-    INTEGER(iwp) ::  ishape(1)  !<
-
-!
-!-- Intrinsics used
-    INTRINSIC SIZE, SHAPE
-
-    ft = array
-    ishape = SHAPE( array )
-    CALL fftn( ft, ishape, inv = inv,  stat = stat )
-!
-!-- Next statement to prevent compiler warning about unused variable
-    IF ( PRESENT( dim ) )  idum = 1
-
- END FUNCTION fft1d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing function description.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION fft2d( array, dim, inv, stat ) RESULT( ft )
-!
-!-- Formal parameters
-    COMPLEX(wp),  DIMENSION(:,:), INTENT(IN)            ::  array  !<
-    INTEGER(iwp), DIMENSION(:),   INTENT(IN),  OPTIONAL ::  dim    !<
-    INTEGER(iwp),                 INTENT(OUT), OPTIONAL ::  stat   !<
-    LOGICAL,                      INTENT(IN),  OPTIONAL ::  inv    !<
-!
-!-- Function result
-    COMPLEX(wp), DIMENSION(SIZE(array, 1), SIZE(array, 2)) ::  ft  !<
-
-    INTEGER(iwp) ::  ishape(2)  !<
-!
-!-- Intrinsics used
-    INTRINSIC SIZE, SHAPE
-
-    ft = array
-    ishape = SHAPE( array )
-    CALL fftn( ft, ishape, dim, inv, stat )
-
- END FUNCTION fft2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing function description.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION fft3d( array, dim, inv, stat ) RESULT( ft )
-!
-!-- Formal parameters
-    COMPLEX(wp),  DIMENSION(:,:,:), INTENT(IN)            ::  array  !<
-    INTEGER(iwp), DIMENSION(:),     INTENT(IN),  OPTIONAL ::  dim    !<
-    INTEGER(iwp),                   INTENT(OUT), OPTIONAL ::  stat   !<
-    LOGICAL,                        INTENT(IN),  OPTIONAL ::  inv    !<
-!
-!-- Function result
-    COMPLEX(wp), DIMENSION(SIZE(array, 1), SIZE(array, 2), SIZE(array, 3)) ::  ft  !<
-
-    INTEGER(iwp) ::  ishape(3)  !<
-
-!
-!-- Intrinsics used
-    INTRINSIC SIZE, SHAPE
-
-    ft = array
-    ishape = SHAPE( array)
-    CALL fftn(ft, ishape, dim, inv, stat)
-
- END FUNCTION fft3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing function description.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION fft4d( array, dim, inv, stat ) RESULT( ft )
-!
-!-- Formal parameters
-    COMPLEX(wp),  DIMENSION(:,:,:,:), INTENT(IN)            ::  array  !<
-    INTEGER(iwp), DIMENSION(:),       INTENT(IN),  OPTIONAL ::  dim    !<
-    INTEGER(iwp),                     INTENT(OUT), OPTIONAL ::  stat   !<
-    LOGICAL,                          INTENT(IN),  OPTIONAL ::  inv    !<
-!
-!-- Function result
-    COMPLEX(wp), DIMENSION(SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4)) ::  ft  !<
-
-    INTEGER(iwp) ::  ishape(4)  !<
-!
-!-- Intrinsics used
-    INTRINSIC SIZE, SHAPE
-
-    ft = array
-    ishape = SHAPE( array )
-    CALL fftn(ft, ishape, dim, inv, stat)
-
- END FUNCTION fft4d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing function description.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION fft5d( array, dim, inv, stat ) RESULT( ft )
-!
-!-- Formal parameters
-    COMPLEX(wp),  DIMENSION(:,:,:,:,:), INTENT(IN)            ::  array  !<
-    INTEGER(iwp), DIMENSION(:),         INTENT(IN),  OPTIONAL ::  dim    !<
-    INTEGER(iwp),                       INTENT(OUT), OPTIONAL ::  stat   !<
-    LOGICAL,                            INTENT(IN),  OPTIONAL ::  inv    !<
-!
-!-- Function result
-    COMPLEX(wp), DIMENSION(SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), SIZE(array, 5)) ::  ft  !<
-
-    INTEGER(iwp) ::  ishape(5)  !<
-
-!
-!-- Intrinsics used
-    INTRINSIC SIZE, SHAPE
-
-    ft = array
-    ishape = SHAPE( array )
-    CALL fftn(ft, ishape, dim, inv, stat)
-
- END FUNCTION fft5d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing function description.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION fft6d( array, dim, inv, stat ) RESULT( ft )
-!
-!-- Formal parameters
-    COMPLEX(wp),  DIMENSION(:,:,:,:,:,:), INTENT(IN)            ::  array  !<
-    INTEGER(iwp), DIMENSION(:),           INTENT(IN),  OPTIONAL ::  dim    !<
-    INTEGER(iwp),                         INTENT(OUT), OPTIONAL ::  stat   !<
-    LOGICAL,                              INTENT(IN),  OPTIONAL ::  inv    !<
-!
-!-- Function result
-    COMPLEX(wp), DIMENSION( SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4),        &
-                            SIZE(array, 5), SIZE(array, 6)) ::  ft  !<
-
-    INTEGER(iwp) ::  ishape(6)  !<
-
-!
-!-- Intrinsics used
-    INTRINSIC SIZE, SHAPE
-
-    ft = array
-    ishape = SHAPE( array )
-    CALL fftn(ft, ishape, dim, inv, stat)
-
- END FUNCTION fft6d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing function description.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION fft7d( array, dim, inv, stat ) RESULT( ft )
-!
-!-- Formal parameters
-    COMPLEX(wp), DIMENSION(:,:,:,:,:,:,:), INTENT(IN)            ::  array  !<
-    INTEGER(iwp),            DIMENSION(:), INTENT(IN),  OPTIONAL ::  dim    !<
-    INTEGER(iwp),                          INTENT(OUT), OPTIONAL ::  stat   !<
-    LOGICAL,                               INTENT(IN),  OPTIONAL ::  inv    !<
-!
-!-- Function result
-    COMPLEX(wp), DIMENSION( SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4),        &
-                            SIZE(array, 5), SIZE(array, 6), SIZE(array, 7)) ::  ft  !<
-
-    INTEGER(iwp) ::  ishape(7)  !<
-
-!
-!-- Intrinsics used
-    INTRINSIC SIZE, SHAPE
-
-    ft = array
-    ishape = SHAPE( array )
-    CALL fftn(ft, ishape, dim, inv, stat)
-
- END FUNCTION fft7d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE fftn( array, shape, dim, inv, stat )
-!
-!-- Formal parameters
-    COMPLEX(wp),  DIMENSION(*), INTENT(INOUT)         ::  array  !<
-    INTEGER(iwp), DIMENSION(:), INTENT(IN)            ::  shape  !<
-    INTEGER(iwp), DIMENSION(:), INTENT(IN),  OPTIONAL ::  dim    !<
-    INTEGER(iwp),               INTENT(OUT), OPTIONAL ::  stat   !<
-    LOGICAL,                    INTENT(IN),  OPTIONAL ::  inv    !<
-!
-!-- Local arrays
-    INTEGER(iwp), DIMENSION(SIZE(shape)) ::  d  !<
-!
-!-- Local scalars
-    LOGICAL      ::  inverse          !<
-    INTEGER(iwp) ::  i, ndim, ntotal  !<
-    REAL(wp)     ::  scale            !<
-!
-!-- Intrinsics used
-    INTRINSIC PRESENT, MIN, PRODUCT, SIZE, SQRT
-
-!
-!-- Optional parameter settings
-    IF ( PRESENT( inv ) )  THEN
-       inverse = inv
-    ELSE
-       inverse = .FALSE.
-    END IF
-    IF ( PRESENT( dim ) )  THEN
-       ndim = MIN( SIZE( dim ), SIZE( d ) )
-       d(1:ndim) = DIM( 1:ndim )
-    ELSE
-       ndim = SIZE( d )
-        d = (/( i, i = 1, SIZE( d ) )/)
-    END IF
-
-    ntotal = PRODUCT( shape )
-    scale = SQRT( 1.0_wp / PRODUCT( shape( d(1:ndim) ) ) )
-    DO  i = 1, ntotal
-       array(i) = CMPLX( REAL( array(i) ) * scale, AIMAG( array(i) ) * scale, KIND = wp )
-    END DO
-
-    DO  i = 1, ndim
-       CALL fftradix( array, ntotal, shape( d(i) ), PRODUCT( shape( 1:d(i) ) ), inverse, stat )
-       IF ( PRESENT( stat ) )  THEN
-          IF ( stat /= 0 )  RETURN
-       END IF
-    END DO
-
- END SUBROUTINE fftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE fftradix( array, ntotal, npass, nspan, inv, stat )
-!
-!-- Formal parameters
-    COMPLEX(wp),  DIMENSION(*), INTENT(INOUT)         ::  array                 !<
-    INTEGER(iwp),               INTENT(IN)            ::  ntotal, npass, nspan  !<
-    INTEGER(iwp),               INTENT(OUT), OPTIONAL ::  stat                  !<
-    LOGICAL,                    INTENT(IN)            ::  inv                   !<
-!
-!-- Local arrays
-    COMPLEX(wp),  DIMENSION(:), ALLOCATABLE ::  ctmp          !<
-    INTEGER(iwp), DIMENSION(BIT_SIZE(0))    ::  factor        !<
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  perm          !<
-    REAL(wp),     DIMENSION(:), ALLOCATABLE ::  sine, cosine  !<
-!
-!-- Local scalars
-    INTEGER(iwp) ::  maxfactor, nfactor, nsquare, nperm  !<
-!
-!-- Intrinsics used
-    INTRINSIC MAXVAL, MOD, PRESENT, ISHFT, BIT_SIZE, SIN, COS, CMPLX, REAL, AIMAG
-
-    IF ( npass <= 1 )  RETURN
-
-    CALL factorize( npass, factor, nfactor, nsquare )
-
-    maxfactor = MAXVAL( factor(:nfactor) )
-    IF ( nfactor - ISHFT( nsquare, 1 ) > 0 )  THEN
-       nperm = MAX( nfactor + 1, PRODUCT( factor(nsquare+1: nfactor-nsquare) ) - 1 )
-    ELSE
-       nperm = nfactor + 1
-    END IF
-
-    IF ( PRESENT( stat ) )  THEN
-       ALLOCATE( ctmp(maxfactor), sine(maxfactor), cosine(maxfactor), STAT = stat )
-       IF ( stat /= 0 )  RETURN
-       CALL transform( array, ntotal, npass, nspan, factor, nfactor, ctmp, sine, cosine, inv )
-       DEALLOCATE( sine, cosine, STAT = stat )
-       IF ( stat /= 0 )  RETURN
-       ALLOCATE( perm(nperm), STAT = stat )
-       IF ( stat /= 0 )  RETURN
-       CALL permute( array, ntotal, npass, nspan, factor, nfactor, nsquare, maxfactor, ctmp, perm )
-       DEALLOCATE( perm, ctmp, STAT = stat )
-       IF ( stat /= 0 )  RETURN
-    ELSE
-       ALLOCATE( ctmp(maxfactor), sine(maxfactor), cosine(maxfactor) )
-       CALL transform( array, ntotal, npass, nspan, factor, nfactor, ctmp, sine, cosine, inv )
-       DEALLOCATE( sine, cosine )
-       ALLOCATE( perm(nperm) )
-       CALL permute( array, ntotal, npass, nspan, factor, nfactor, nsquare, maxfactor, ctmp, perm )
-       DEALLOCATE( perm, ctmp )
-    END IF
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE factorize( npass, factor, nfactor, nsquare )
-!
-!-- Formal parameters
-    INTEGER(iwp),               INTENT(IN)  ::  npass             !<
-    INTEGER(iwp),               INTENT(OUT) ::  nfactor, nsquare  !<
-    INTEGER(iwp), DIMENSION(*), INTENT(OUT) ::  factor            !<
-!
-!-- Local scalars
-    INTEGER(iwp) ::  j, jj, k  !<
-
-    nfactor = 0
-    k = npass
-    DO WHILE ( MOD( k, 16 ) == 0 )
-       nfactor = nfactor + 1
-       factor(nfactor) = 4
-       k = k / 16
-    END DO
-    j = 3
-    jj = 9
-    DO
-       DO WHILE ( MOD( k, jj ) == 0 )
-          nfactor = nfactor + 1
-          factor(nfactor) = j
-          k = k / jj
-       END DO
-       j = j + 2
-       jj = j * j
-       IF ( jj > k )  EXIT
-    END DO
-    IF ( k <= 4 )  THEN
-       nsquare = nfactor
-       factor(nfactor + 1) = k
-       IF ( k /= 1 )  nfactor = nfactor + 1
-    ELSE
-       IF ( k - ISHFT( k / 4, 2 ) == 0 )  THEN
-          nfactor = nfactor + 1
-          factor(nfactor) = 2
-          k = k / 4
-       END IF
-       nsquare = nfactor
-       j = 2
-       DO
-          IF ( MOD(k, j) == 0 )  THEN
-             nfactor = nfactor + 1
-             factor(nfactor) = j
-             k = k / j
-          END IF
-          j = ISHFT( (j + 1) / 2, 1 ) + 1
-          IF ( j > k )  EXIT
-       END DO
-    END IF
-    IF ( nsquare > 0 )  THEN
-       j = nsquare
-       DO
-          nfactor = nfactor + 1
-          factor(nfactor) = factor(j)
-          j = j - 1
-          IF ( j == 0 )  EXIT
-       END DO
-    END IF
-
- END SUBROUTINE factorize
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE transform( array, ntotal, npass, nspan, factor, nfactor, ctmp, sine, cosine, inv )
-!-- Compute fourier transform
-
-!
-!-- Formal parameters
-    COMPLEX(wp),  DIMENSION(*), INTENT(IN OUT) ::  array                 !<
-    COMPLEX(wp),  DIMENSION(*), INTENT(OUT)    ::  ctmp                  !<
-    INTEGER(iwp),               INTENT(IN)     ::  ntotal, npass, nspan  !<
-    INTEGER(iwp), DIMENSION(*), INTENT(IN)     ::  factor                !<
-    INTEGER(iwp),               INTENT(IN)     ::  nfactor               !<
-    LOGICAL,                    INTENT(IN)     ::  inv                   !<
-    REAL(wp),     DIMENSION(*), INTENT(OUT)    ::  sine, cosine          !<
-!
-!-- Local scalars
-    COMPLEX(wp)  ::  cc, cj, ck, cjp, cjm, ckp, ckm      !<
-    INTEGER(iwp) ::  ii, ispan                           !<
-    INTEGER(iwp) ::  j, jc, jf, jj                       !<
-    INTEGER(iwp) ::  k, kk, kspan, k1, k2, k3, k4        !<
-    INTEGER(iwp) ::  nn, nt                              !<
-    REAL(wp)     ::  s60, c72, s72, pi2, radf            !<
-    REAL(wp)     ::  c1, s1, c2, s2, c3, s3, cd, sd, ak  !<
-
-    c72 = cos72
-    IF ( inv )  THEN
-       s72 = sin72
-       s60 = sin60
-       pi2 = pi
-    ELSE
-       s72 = - sin72
-       s60 = - sin60
-       pi2 = - pi
-    END IF
-
-    nt = ntotal
-    nn = nt - 1
-    kspan = nspan
-    jc = nspan / npass
-    radf = pi2 * jc
-    pi2 = pi2 * 2.0_wp !-- Use 2 PI from here on
-
-    ii = 0
-    jf = 0
-    DO
-       sd = radf / kspan
-       cd = SIN( sd )
-       cd = 2.0_wp * cd * cd
-       sd = SIN( sd + sd )
-       kk = 1
-       ii = ii + 1
-
-       SELECT CASE ( factor(ii) )
-       CASE ( 2 )
-!
-!--       Transform for factor of 2 (including rotation factor)
-          kspan = kspan / 2
-          k1 = kspan + 2
-          DO
-             DO
-                k2 = kk + kspan
-                ck = array(k2)
-                array(k2) = array(kk) - ck
-                array(kk) = array(kk) + ck
-                kk = k2 + kspan
-                IF ( kk > nn )  EXIT
-             END DO
-             kk = kk - nn
-             IF ( kk > jc )  EXIT
-          END DO
-          IF ( kk > kspan )  RETURN
-          DO
-             c1 = 1.0_wp - cd
-             s1 = sd
-             DO
-                DO
-                   DO
-                      k2 = kk + kspan
-                      ck = array(kk) - array(k2)
-                      array(kk) = array(kk) + array(k2)
-                      array(k2) = ck * CMPLX( c1, s1, KIND = wp )
-                      kk = k2 + kspan
-                      IF ( kk >= nt )  EXIT
-                   END DO
-                   k2 = kk - nt
-                   c1 = - c1
-                   kk = k1 - k2
-                   IF ( kk <= k2 )  EXIT
-                END DO
-                ak = c1 - (cd * c1 + sd * s1)
-                s1 = sd * c1 - cd * s1 + s1
-                c1 = 2.0_wp - ( ak * ak + s1 * s1 )
-                s1 = s1 * c1
-                c1 = c1 * ak
-                kk = kk + jc
-                IF ( kk >= k2 ) EXIT
-             END DO
-             k1 = k1 + 1 + 1
-             kk = ( k1 - kspan ) / 2 + jc
-             IF ( kk > jc + jc )  EXIT
-          END DO
-!
-!--    Transform for factor of 4
-       CASE ( 4 )
-          ispan = kspan
-          kspan = kspan / 4
-
-          DO
-             c1 = 1.0_wp
-             s1 = 0.0_wp
-             DO
-                DO
-                   k1 = kk + kspan
-                   k2 = k1 + kspan
-                   k3 = k2 + kspan
-                   ckp = array(kk) + array(k2)
-                   ckm = array(kk) - array(k2)
-                   cjp = array(k1) + array(k3)
-                   cjm = array(k1) - array(k3)
-                   array(kk) = ckp + cjp
-                   cjp = ckp - cjp
-                   IF ( inv )  THEN
-                      ckp = ckm + CMPLX( - AIMAG( cjm ), REAL( cjm ), KIND = wp )
-                      ckm = ckm + CMPLX( AIMAG( cjm ), - REAL( cjm ), KIND = wp )
-                   ELSE
-                      ckp = ckm + CMPLX( AIMAG( cjm ), - REAL( cjm ), KIND = wp )
-                      ckm = ckm + CMPLX( - AIMAG( cjm ), REAL( cjm ), KIND = wp )
-                   END IF
-!
-!--                Avoid useless multiplies
-                   IF ( s1 == 0.0_wp )  THEN
-                      array(k1) = ckp
-                      array(k2) = cjp
-                      array(k3) = ckm
-                   ELSE
-                      array(k1) = ckp * CMPLX( c1, s1, KIND = wp )
-                      array(k2) = cjp * CMPLX( c2, s2, KIND = wp )
-                      array(k3) = ckm * CMPLX( c3, s3, KIND = wp )
-                   END IF
-                   kk = k3 + kspan
-                   IF ( kk > nt )  EXIT
-                END DO
-
-                c2 = c1 - ( cd * c1 + sd * s1 )
-                s1 = sd * c1 - cd * s1 + s1
-                c1 = 2.0_wp - ( c2 * c2 + s1 * s1 )
-                s1 = s1 * c1
-                c1 = c1 * c2
-!
-!--             Values of c2, c3, s2, s3 that will get used next time
-                c2 = c1 * c1 - s1 * s1
-                s2 = 2.0_wp * c1 * s1
-                c3 = c2 * c1 - s2 * s1
-                s3 = c2 * s1 + s2 * c1
-                kk = kk - nt + jc
-                IF ( kk > kspan )  EXIT
-             END DO
-             kk = kk - kspan + 1
-             IF ( kk > jc )  EXIT
-          END DO
-          IF ( kspan == jc )  RETURN
-
-       CASE default
-!
-!--       Transform for odd factors
-          k = factor(ii)
-          ispan = kspan
-          kspan = kspan / k
-
-          SELECT CASE ( k )
-!
-!--       Transform for factor of 3 (optional code)
-          CASE ( 3 )
-             DO
-                DO
-                   k1 = kk + kspan
-                   k2 = k1 + kspan
-                   ck = array(kk)
-                   cj = array(k1) + array(k2)
-                   array(kk) = ck + cj
-                   ck = ck - CMPLX( 0.5_wp * REAL( cj ), 0.5_wp * AIMAG( cj ), KIND = wp )
-                   cj = CMPLX( ( REAL( array(k1) ) - REAL( array(k2) ) ) * s60,                    &
-                               ( AIMAG( array(k1) ) - AIMAG( array(k2) ) ) * s60, KIND = wp )
-                   array(k1) = ck + CMPLX( - AIMAG( cj ), REAL( cj ), KIND = wp )
-                   array(k2) = ck + CMPLX( AIMAG( cj ), - REAL( cj ), KIND = wp )
-                   kk = k2 + kspan
-                   IF ( kk >= nn )  EXIT
-                END DO
-                kk = kk - nn
-                IF ( kk > kspan )  EXIT
-             END DO
-!
-!--       Transform for factor of 5 (optional code)
-          CASE ( 5 )
-             c2 = c72 * c72 - s72 * s72
-             s2 = 2.0_wp * c72 * s72
-             DO
-                DO
-                   k1 = kk + kspan
-                   k2 = k1 + kspan
-                   k3 = k2 + kspan
-                   k4 = k3 + kspan
-                   ckp = array(k1) + array(k4)
-                   ckm = array(k1) - array(k4)
-                   cjp = array(k2) + array(k3)
-                   cjm = array(k2) - array(k3)
-                   cc = array(kk)
-                   array(kk) = cc + ckp + cjp
-                   ck = CMPLX( REAL( ckp ) * c72, AIMAG( ckp ) * c72, KIND = wp ) +                &
-                        CMPLX( REAL( cjp ) * c2,  AIMAG( cjp ) * c2,  KIND = wp ) + cc
-                   cj = CMPLX( REAL( ckm ) * s72, AIMAG( ckm ) * s72, KIND = wp) +                 &
-                        CMPLX( REAL( cjm ) * s2,  AIMAG( cjm ) * s2,  KIND = wp )
-                   array(k1) = ck + CMPLX( - AIMAG( cj ), REAL( cj ), KIND = wp )
-                   array(k4) = ck + CMPLX( AIMAG( cj ), - REAL( cj ), KIND = wp )
-                   ck = CMPLX( REAL( ckp ) * c2,  AIMAG( ckp ) * c2,  KIND = wp ) +                &
-                        CMPLX( REAL( cjp ) * c72, AIMAG( cjp ) * c72, KIND = wp ) + cc
-                   cj = CMPLX( REAL( ckm ) * s2,  AIMAG( ckm ) * s2,  KIND = wp ) -                &
-                        CMPLX( REAL( cjm ) * s72, AIMAG( cjm ) * s72, KIND = wp )
-                   array(k2) = ck + CMPLX( -AIMAG( cj ), REAL( cj ), KIND = wp )
-                   array(k3) = ck + CMPLX( AIMAG( cj ), - REAL( cj ), KIND = wp )
-                   kk = k4 + kspan
-                   IF ( kk >= nn )  EXIT
-                END DO
-                kk = kk - nn
-                IF ( kk > kspan )  EXIT
-             END DO
-
-          CASE default
-             IF ( k /= jf )  THEN
-                jf = k
-                s1 = pi2 / k
-                c1 = COS( s1 )
-                s1 = SIN( s1 )
-                cosine(jf) = 1.0_wp
-                sine(jf) = 0.0_wp
-                j = 1
-                DO
-                   cosine(j) = cosine(k) * c1 + sine(k) * s1
-                   sine(j) = cosine(k) * s1 - sine(k) * c1
-                   k = k - 1
-                   cosine(k) = cosine(j)
-                   sine(k) = - sine(j)
-                   j = j + 1
-                   IF ( j >= k )  EXIT
-                END DO
-             END IF
-             DO
-                DO
-                   k1 = kk
-                   k2 = kk + ispan
-                   cc = array(kk)
-                   ck = cc
-                   j = 1
-                   k1 = k1 + kspan
-                   DO
-                      k2 = k2 - kspan
-                      j = j + 1
-                      ctmp(j) = array(k1) + array(k2)
-                      ck = ck + ctmp(j)
-                      j = j + 1
-                      ctmp(j) = array(k1) - array(k2)
-                      k1 = k1 + kspan
-                      IF ( k1 >= k2 )  EXIT
-                   END DO
-                   array(kk) = ck
-                   k1 = kk
-                   k2 = kk + ispan
-                   j = 1
-                   DO
-                      k1 = k1 + kspan
-                      k2 = k2 - kspan
-                      jj = j
-                      ck = cc
-                      cj = ( 0.0_wp, 0.0_wp )
-                      k = 1
-                      DO
-                         k = k + 1
-                         ck = ck + CMPLX( REAL( ctmp(k) ) * cosine(jj), AIMAG( ctmp(k) ) *         &
-                                          cosine(jj), KIND = wp )
-                         k = k + 1
-                         cj = cj + CMPLX( REAL( ctmp(k) ) * sine(jj), AIMAG( ctmp(k) ) * sine(jj), &
-                                          KIND = wp )
-                         jj = jj + j
-                         IF ( jj > jf )  jj = jj - jf
-                         IF ( k >= jf )  EXIT
-                      END DO
-                      k = jf - j
-                      array(k1) = ck + CMPLX( - AIMAG( cj ), REAL( cj ), KIND = wp )
-                      array(k2) = ck + CMPLX( AIMAG( cj ), -REAL( cj ), KIND = wp )
-                      j = j + 1
-                      IF ( j >= k )  EXIT
-                   END DO
-                   kk = kk + ispan
-                   IF ( kk > nn )  EXIT
-                END DO
-                kk = kk - nn
-                IF ( kk > kspan )  EXIT
-             END DO
-
-          END SELECT
-!
-!--       Multiply by rotation factor (except for factors of 2 and 4)
-          IF ( ii == nfactor )  RETURN
-          kk = jc + 1
-          DO
-             c2 = 1.0_wp - cd
-             s1 = sd
-             DO
-                c1 = c2
-                s2 = s1
-                kk = kk + kspan
-                DO
-                   DO
-                      array(kk) = CMPLX( c2, s2, KIND = wp ) * array(kk)
-                      kk = kk + ispan
-                      IF ( kk > nt )  EXIT
-                   END DO
-                   ak = s1 * s2
-                   s2 = s1 * c2 + c1 * s2
-                   c2 = c1 * c2 - ak
-                   kk = kk - nt + kspan
-                   IF ( kk > ispan )  EXIT
-                END DO
-                c2 = c1 - ( cd * c1 + sd * s1 )
-                s1 = s1 + sd * c1 - cd * s1
-                c1 = 2.0_wp - ( c2 * c2 + s1 * s1 )
-                s1 = s1 * c1
-                c2 = c2 * c1
-                kk = kk - ispan + jc
-                IF ( kk > kspan )  EXIT
-             END DO
-             kk = kk - kspan + jc + 1
-             IF ( kk > jc + jc )  EXIT
-          END DO
-
-       END SELECT
-    END DO
- END SUBROUTINE transform
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE permute( array, ntotal, npass, nspan, factor, nfactor, nsquare, maxfactor, ctmp, perm )
-!
-!-- Formal parameters
-    COMPLEX(wp),  DIMENSION(*), INTENT(IN OUT) ::  array                 !<
-    COMPLEX(wp),  DIMENSION(*), INTENT(OUT)    ::  ctmp                  !<
-    INTEGER(iwp),               INTENT(IN)     ::  ntotal, npass, nspan  !<
-    INTEGER(iwp),               INTENT(IN)     ::  nfactor, nsquare      !<
-    INTEGER(iwp),               INTENT(IN)     ::  maxfactor             !<
-    INTEGER(iwp), DIMENSION(*), INTENT(IN OUT) ::  factor                !<
-    INTEGER(iwp), DIMENSION(*), INTENT(OUT)    ::  perm                  !<
-!
-!-- Local scalars
-    COMPLEX(wp)  ::  ck                            !<
-    INTEGER(iwp) ::  ii, ispan                     !<
-    INTEGER(iwp) ::  j, jc, jj                     !<
-    INTEGER(iwp) ::  k, kk, kspan, kt, k1, k2, k3  !<
-    INTEGER(iwp) ::  nn, nt                        !<
-!
-!-- Permute the results to normal order---done in two stages
-!-- Permutation for square factors of n
-
-    nt = ntotal
-    nn = nt - 1
-    kt = nsquare
-    kspan = nspan
-    jc = nspan / npass
-
-    perm (1) = nspan
-    IF ( kt > 0 )  THEN
-       k = kt + kt + 1
-       IF ( nfactor < k )  k = k - 1
-       j = 1
-       perm(k + 1) = jc
-       DO
-          perm(j + 1) = perm(j) / factor(j)
-          perm(k) = perm(k + 1) * factor(j)
-          j = j + 1
-          k = k - 1
-          IF ( j >= k )  EXIT
-       END DO
-       k3 = perm(k + 1)
-       kspan = perm(2)
-       kk = jc + 1
-       k2 = kspan + 1
-       j = 1
-
-       IF ( npass /= ntotal )  THEN
-          permute_multi: DO
-             DO
-                DO
-                   k = kk + jc
-                   DO
-!
-!--                   Swap array(kk) <> array(k2)
-                      ck = array(kk)
-                      array(kk) = array(k2)
-                      array(k2) = ck
-                      kk = kk + 1
-                      k2 = k2 + 1
-                      IF ( kk >= k )  EXIT
-                   END DO
-                   kk = kk + nspan - jc
-                   k2 = k2 + nspan - jc
-                   IF ( kk >= nt )  EXIT
-                END DO
-                kk = kk - nt + jc
-                k2 = k2 - nt + kspan
-                IF ( k2 >= nspan )  EXIT
-             END DO
-             DO
-                DO
-                   k2 = k2 - perm(j)
-                   j = j + 1
-                   k2 = perm(j + 1) + k2
-                   IF ( k2 <= perm(j) )  EXIT
-                END DO
-                j = 1
-                DO
-                   IF ( kk < k2 )  CYCLE permute_multi
-                   kk = kk + jc
-                   k2 = k2 + kspan
-                   IF ( k2 >= nspan )  EXIT
-                END DO
-                IF ( kk >= nspan )  EXIT
-             END DO
-             EXIT
-          END DO permute_multi
-       ELSE
-          permute_single: DO
-             DO
-!
-!--             Swap array(kk) <> array(k2)
-                ck = array(kk)
-                array(kk) = array(k2)
-                array(k2) = ck
-                kk = kk + 1
-                k2 = k2 + kspan
-                IF ( k2 >= nspan )  EXIT
-             END DO
-             DO
-                DO
-                   k2 = k2 - perm(j)
-                   j = j + 1
-                   k2 = perm(j + 1) + k2
-                   IF ( k2 <= perm(j) )  EXIT
-                END DO
-                j = 1
-                DO
-                   IF ( kk < k2 )  CYCLE permute_single
-                   kk = kk + 1
-                   k2 = k2 + kspan
-                   IF ( k2 >= nspan )  EXIT
-                END DO
-                IF ( kk >= nspan )  EXIT
-             END DO
-             EXIT
-          END DO permute_single
-       END IF
-       jc = k3
-    END IF
-
-    IF ( ISHFT( kt, 1 ) + 1 >= nfactor )  RETURN
-
-    ispan = perm(kt + 1)
-!
-!-- Permutation for square-free factors of n
-    j = nfactor - kt
-    factor( j + 1 ) = 1
-    DO
-       factor(j) = factor(j) * factor(j+1)
-       j = j - 1
-       IF ( j == kt )  EXIT
-    END DO
-    kt = kt + 1
-    nn = factor( kt ) - 1
-    j = 0
-    jj = 0
-    DO
-       k = kt + 1
-       k2 = factor(kt)
-       kk = factor(k)
-       j = j + 1
-       IF ( j > nn )  EXIT !-- Exit infinite loop
-       jj = jj + kk
-       DO WHILE ( jj >= k2 )
-          jj = jj - k2
-          k2 = kk
-          k = k + 1
-          kk = factor(k)
-          jj = jj + kk
-       END DO
-       perm(j) = jj
-    END DO
-!
-!-- Determine the permutation cycles of length greater than 1
-    j = 0
-    DO
-       DO
-          j = j + 1
-          kk = perm(j)
-          IF ( kk >= 0 )  EXIT
-       END DO
-       IF ( kk /= j )  THEN
-          DO
-             k = kk
-             kk = perm(k)
-             perm(k) = - kk
-             IF ( kk == j )  EXIT
-          END DO
-          k3 = kk
-       ELSE
-          perm(j) = - j
-          IF ( j == nn )  EXIT !-- Exit infinite loop
-       END IF
-    END DO
-!
-!-- Reorder a and b, following the permutation cycles
-    DO
-       j = k3 + 1
-       nt = nt - ispan
-       ii = nt - 1 + 1
-       IF ( nt < 0 )  EXIT !-- Exit infinite loop
-       DO
-          DO
-             j = j - 1
-             IF ( perm(j) >= 0 )  EXIT
-          END DO
-          jj = jc
-          DO
-             kspan = jj
-             IF ( jj > maxfactor )  kspan = maxfactor
-             jj = jj - kspan
-             k = perm(j)
-             kk = jc * k + ii + jj
-             k1 = kk + kspan
-             k2 = 0
-             DO
-                k2 = k2 + 1
-                ctmp(k2) = array(k1)
-                k1 = k1 - 1
-                IF ( k1 == kk )  EXIT
-             END DO
-             DO
-                k1 = kk + kspan
-                k2 = k1 - jc * ( k + perm(k) )
-                k = - perm(k)
-                DO
-                   array(k1) = array(k2)
-                   k1 = k1 - 1
-                   k2 = k2 - 1
-                   IF ( k1 == kk )  EXIT
-                END DO
-                kk = k2
-                IF ( k == j )  EXIT
-             END DO
-             k1 = kk + kspan
-             k2 = 0
-             DO
-                k2 = k2 + 1
-                array(k1) = ctmp(k2)
-                k1 = k1 - 1
-                IF ( k1 == kk )  EXIT
-             END DO
-             IF ( jj == 0 )  EXIT
-          END DO
-          IF ( j == 1 )  EXIT
-       END DO
-    END DO
-
- END SUBROUTINE permute
-
- END SUBROUTINE fftradix
-
- END MODULE singleton
Index: palm/trunk/SOURCE/sor.f90
===================================================================
--- palm/trunk/SOURCE/sor.f90	(revision 4901)
+++ palm/trunk/SOURCE/sor.f90	(revision 1)
@@ -1,113 +1,59 @@
-!> @file sor.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ SUBROUTINE sor( d, ddzu, ddzw, p )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! Use statement for exchange horiz added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Rename variables in mesoscale-offline nesting mode
+! $Log: sor.f90,v $
+! Revision 1.9  2005/03/26 21:02:23  raasch
+! Implementation of non-cyclic (Neumann) horizontal boundary conditions,
+! dx2,dy2 replaced by ddx2,ddy2
+!
+! Revision 1.8  2001/03/30 07:52:44  raasch
+! Arrays f1-f3 changed from dummy arguments to allocatable arrays,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.7  2001/01/30 21:41:25  letzel
+! All comments translated into English.
+!
+! Revision 1.6  2001/01/22 08:06:14  raasch
+! Module test_variables removed
+!
+! Revision 1.5  1998/07/06 12:33:13  raasch
+! + USE test_variables
+!
+! Revision 1.4  1997/09/12 06:30:12  raasch
+! Randbedingungen umbenannt
+!
+! Revision 1.3  1997/09/09 08:30:44  raasch
+! Kehrwerte der Gitterweiten implementiert
+!
+! Revision 1.2  1997/08/29 09:00:58  raasch
+! omega --> omega_sor
 !
 ! Revision 1.1  1997/08/11 06:25:56  raasch
 ! Initial revision
 !
-!--------------------------------------------------------------------------------------------------!
+!
 ! Description:
 ! ------------
-!> Solve the Poisson-equation with the SOR-Red/Black-scheme.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sor( d, ddzu, ddzw, p )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  rho_air,                                                                            &
-               rho_air_zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               ibc_p_b,                                                                            &
-               ibc_p_t,                                                                            &
-               n_sor,                                                                              &
-               omega_sor
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2,                                                                               &
-               ddy2
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nz,                                                                                 &
-               nzb,                                                                                &
-               nzt
-
-    USE kinds
+! Solve the Poisson-equation with the SOR-Red/Black-scheme.
+!-------------------------------------------------------------------------------!
+
+    USE grid_variables
+    USE indices
+    USE pegrid
+    USE control_parameters
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i     !<
-    INTEGER(iwp) ::  j     !<
-    INTEGER(iwp) ::  k     !<
-    INTEGER(iwp) ::  n     !<
-    INTEGER(iwp) ::  nxl1  !<
-    INTEGER(iwp) ::  nxl2  !<
-    INTEGER(iwp) ::  nys1  !<
-    INTEGER(iwp) ::  nys2  !<
-
-    REAL(wp) ::  ddzu(1:nz+1)   !<
-    REAL(wp) ::  ddzw(1:nzt+1)  !<
-
-    REAL(wp) ::  d(nzb+1:nzt,nys:nyn,nxl:nxr)      !<
-    REAL(wp) ::  p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !<
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  f1  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  f2  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  f3  !<
+    INTEGER ::  i, j, k, n, nxl1, nxl2, nys1, nys2
+    REAL    ::  ddzu(1:nz+1), ddzw(1:nz)
+    REAL    ::  d(nzb+1:nzt,nys:nyn,nxl:nxr),         &
+                p(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+    REAL, DIMENSION(:), ALLOCATABLE ::  f1, f2, f3
 
     ALLOCATE( f1(1:nz), f2(1:nz), f3(1:nz) )
@@ -116,7 +62,7 @@
 !-- Compute pre-factors.
     DO  k = 1, nz
-         f2(k) = ddzu(k+1) * ddzw(k) * rho_air_zw(k)
-         f3(k) = ddzu(k)   * ddzw(k) * rho_air_zw(k-1)
-         f1(k) = 2.0_wp * ( ddx2 + ddy2 ) * rho_air(k) + f2(k) + f3(k)
+         f2(k) = ddzu(k+1) * ddzw(k)
+         f3(k) = ddzu(k)   * ddzw(k)
+         f1(k) = 2.0 * ( ddx2 + ddy2 ) + f2(k) + f3(k)
     ENDDO
 
@@ -145,11 +91,11 @@
           DO  j = nys2, nyn, 2
              DO  k = nzb+1, nzt
-                p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * (                                        &
-                           rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) +                       &
-                           rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) +                       &
-                           f2(k) * p(k+1,j,i)                              +                       &
-                           f3(k) * p(k-1,j,i)                              -                       &
-                           d(k,j,i)                                        -                       &
-                           f1(k) * p(k,j,i)               )
+                p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * (            &
+                               ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) +    &
+                               ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) +    &
+                               f2(k) * p(k+1,j,i)                 +    &
+                               f3(k) * p(k-1,j,i)                 -    &
+                               d(k,j,i)                           -    &
+                               f1(k) * p(k,j,i)           )
              ENDDO
           ENDDO
@@ -159,11 +105,11 @@
           DO  j = nys1, nyn, 2
              DO  k = nzb+1, nzt
-                p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * (                                        &
-                           rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) +                       &
-                           rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) +                       &
-                           f2(k) * p(k+1,j,i)                              +                       &
-                           f3(k) * p(k-1,j,i)                              -                       &
-                           d(k,j,i)                                        -                       &
-                           f1(k) * p(k,j,i)               )
+                p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * (            &
+                               ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) +    &
+                               ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) +    &
+                               f2(k) * p(k+1,j,i)                 +    &
+                               f3(k) * p(k-1,j,i)                 -    &
+                               d(k,j,i)                           -    &
+                               f1(k) * p(k,j,i)           )
              ENDDO
           ENDDO
@@ -172,16 +118,15 @@
 !
 !--    Exchange of boundary values for p.
-       CALL exchange_horiz( p, nbgp )
-
+       CALL exchange_horiz( p, 0, 0 )
 
 !
 !--    Horizontal (Neumann) boundary conditions in case of non-cyclic boundaries
-       IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  p(:,:,nxl-1) = p(:,:,nxl)
-          IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  p(:,:,nxr+1) = p(:,:,nxr)
-       ENDIF
-       IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  p(:,nyn+1,:) = p(:,nyn,:)
-          IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  p(:,nys-1,:) = p(:,nys,:)
+       IF ( bc_lr /= 'cyclic' )  THEN
+          IF ( inflow_l .OR. outflow_l )  p(:,:,nxl-1) = p(:,:,nxl)
+          IF ( inflow_r .OR. outflow_r )  p(:,:,nxr+1) = p(:,:,nxr)
+       ENDIF
+       IF ( bc_ns /= 'cyclic' )  THEN
+          IF ( inflow_n .OR. outflow_n )  p(:,nyn+1,:) = p(:,nyn,:)
+          IF ( inflow_s .OR. outflow_s )  p(:,nys-1,:) = p(:,nys,:)
        ENDIF
 
@@ -191,11 +136,11 @@
           DO  j = nys1, nyn, 2
              DO  k = nzb+1, nzt
-                p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * (                                        &
-                           rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) +                       &
-                           rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) +                       &
-                           f2(k) * p(k+1,j,i)                              +                       &
-                           f3(k) * p(k-1,j,i)                              -                       &
-                           d(k,j,i)                                        -                       &
-                           f1(k) * p(k,j,i)               )
+                p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * (            &
+                               ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) +    &
+                               ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) +    &
+                               f2(k) * p(k+1,j,i)                 +    &
+                               f3(k) * p(k-1,j,i)                 -    &
+                               d(k,j,i)                           -    &
+                               f1(k) * p(k,j,i)           )
              ENDDO
           ENDDO
@@ -205,11 +150,11 @@
           DO  j = nys2, nyn, 2
              DO  k = nzb+1, nzt
-                p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * (                                        &
-                           rho_air(k) * ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) +                       &
-                           rho_air(k) * ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) +                       &
-                           f2(k) * p(k+1,j,i)                              +                       &
-                           f3(k) * p(k-1,j,i)                              -                       &
-                           d(k,j,i)                                        -                       &
-                           f1(k) * p(k,j,i)               )
+                p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * (            &
+                               ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) +    &
+                               ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) +    &
+                               f2(k) * p(k+1,j,i)                 +    &
+                               f3(k) * p(k-1,j,i)                 -    &
+                               d(k,j,i)                           -    &
+                               f1(k) * p(k,j,i)           )
              ENDDO
           ENDDO
@@ -218,34 +163,41 @@
 !
 !--    Exchange of boundary values for p.
-       CALL exchange_horiz( p, nbgp )
+       CALL exchange_horiz( p, 0, 0 )
 
 !
 !--    Boundary conditions top/bottom.
 !--    Bottom boundary
-       IF ( ibc_p_b == 1 )  THEN       ! Neumann
+       IF ( ibc_p_b == 1 )  THEN
+!
+!--       Neumann
           p(nzb,:,:) = p(nzb+1,:,:)
-       ELSE                            ! Dirichlet
-          p(nzb,:,:) = 0.0_wp
+       ELSE
+!
+!--       Dirichlet
+          p(nzb,:,:) = 0.0
        ENDIF
 
 !
 !--    Top boundary
-       IF ( ibc_p_t == 1 )  THEN       ! Neumann
+       IF ( ibc_p_t == 1 )  THEN
+!
+!--       Neumann
           p(nzt+1,:,:) = p(nzt,:,:)
-       ELSE                            ! Dirichlet
-          p(nzt+1,:,:) = 0.0_wp
+       ELSE
+!
+!--       Dirichlet
+          p(nzt+1,:,:) = 0.0
        ENDIF
 
 !
 !--    Horizontal (Neumann) boundary conditions in case of non-cyclic boundaries
-       IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  p(:,:,nxl-1) = p(:,:,nxl)
-          IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  p(:,:,nxr+1) = p(:,:,nxr)
-       ENDIF
-       IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  p(:,nyn+1,:) = p(:,nyn,:)
-          IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  p(:,nys-1,:) = p(:,nys,:)
-       ENDIF
-
+       IF ( bc_lr /= 'cyclic' )  THEN
+          IF ( inflow_l .OR. outflow_l )  p(:,:,nxl-1) = p(:,:,nxl)
+          IF ( inflow_r .OR. outflow_r )  p(:,:,nxr+1) = p(:,:,nxr)
+       ENDIF
+       IF ( bc_ns /= 'cyclic' )  THEN
+          IF ( inflow_n .OR. outflow_n )  p(:,nyn+1,:) = p(:,nyn,:)
+          IF ( inflow_s .OR. outflow_s )  p(:,nys-1,:) = p(:,nys,:)
+       ENDIF
 
     ENDDO
Index: palm/trunk/SOURCE/spectra_mod.f90
===================================================================
--- palm/trunk/SOURCE/spectra_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,882 +1,0 @@
-!> @file spectra_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more,
-! deprecated namelist removed
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4591 2020-07-06 15:56:08Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4429 2020-02-27 15:24:30Z raasch
-! Bugfix: preprocessor directives rearranged for serial mode
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3805 2019-03-20 15:26:35Z raasch
-! Unused variable removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Renamed output variables
-!
-! Revision 1.1  2001/01/05 15:08:07  raasch
-! Initial revision
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate horizontal spectra along x and y.
-!> ATTENTION: 1d-decomposition along y still needs improvement, because in that case the gridpoint
-!>            number along z still depends on the PE number because transpose_xz has to be used
-!>            (and possibly also transpose_zyd needs modification).
-!--------------------------------------------------------------------------------------------------!
- MODULE spectra_mod
-
-    USE kinds
-
-    PRIVATE
-
-    CHARACTER (LEN=10), DIMENSION(10) ::  data_output_sp  = ' '    !<
-    CHARACTER (LEN=2),  DIMENSION(10) ::  spectra_direction = 'x'  !<
-
-    INTEGER(iwp) ::  average_count_sp = 0              !<
-    INTEGER(iwp) ::  comp_spectra_level(100) = 999999  !<
-    INTEGER(iwp) ::  dosp_time_count = 0               !<
-    INTEGER(iwp) ::  n_sp_x = 0, n_sp_y = 0            !<
-
-    LOGICAL ::  calculate_spectra   = .FALSE.  !< internal switch that spectra are calculated
-    LOGICAL ::  spectra_initialized = .FALSE.  !< internal switch that spectra related quantities are initialized
-
-    REAL(wp) ::  averaging_interval_sp = 9999999.9_wp  !< averaging interval for spectra output
-    REAL(wp) ::  dt_dosp = 9999999.9_wp                !< time interval for spectra output
-    REAL(wp) ::  skip_time_dosp = 9999999.9_wp         !< no output of spectra data before this interval has passed
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  var_d  !<
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  spectrum_x  !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  spectrum_y  !<
-
-    SAVE
-
-    INTERFACE calc_spectra
-       MODULE PROCEDURE calc_spectra
-    END INTERFACE calc_spectra
-
-    INTERFACE preprocess_spectra
-       MODULE PROCEDURE preprocess_spectra
-    END INTERFACE preprocess_spectra
-
-#if defined( __parallel )
-    INTERFACE calc_spectra_x
-       MODULE PROCEDURE calc_spectra_x
-    END INTERFACE calc_spectra_x
-
-    INTERFACE calc_spectra_y
-       MODULE PROCEDURE calc_spectra_y
-    END INTERFACE calc_spectra_y
-#endif
-
-    INTERFACE spectra_check_parameters
-       MODULE PROCEDURE spectra_check_parameters
-    END INTERFACE spectra_check_parameters
-
-    INTERFACE spectra_header
-       MODULE PROCEDURE spectra_header
-    END INTERFACE spectra_header
-
-    INTERFACE spectra_init
-       MODULE PROCEDURE spectra_init
-    END INTERFACE spectra_init
-
-    INTERFACE spectra_parin
-       MODULE PROCEDURE spectra_parin
-    END INTERFACE spectra_parin
-
-    PUBLIC average_count_sp,                                                                       &
-           averaging_interval_sp,                                                                  &
-           calc_spectra,                                                                           &
-           calculate_spectra,                                                                      &
-           comp_spectra_level,                                                                     &
-           data_output_sp,                                                                         &
-           dosp_time_count,                                                                        &
-           dt_dosp,                                                                                &
-           n_sp_x,                                                                                 &
-           n_sp_y,                                                                                 &
-           skip_time_dosp,                                                                         &
-           spectra_check_parameters,                                                               &
-           spectra_direction,                                                                      &
-           spectra_header,                                                                         &
-           spectra_init,                                                                           &
-           spectra_parin,                                                                          &
-           spectrum_x,                                                                             &
-           spectrum_y,                                                                             &
-           var_d
-
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &spectra_par for calculating spectra
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE spectra_parin
-
-    USE control_parameters,                                                                        &
-        ONLY:  dt_data_output
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter file
-
-    INTEGER(iwp) ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /spectra_parameters/                                                                  &
-                            averaging_interval_sp,                                                 &
-                            comp_spectra_level,                                                    &
-                            data_output_sp,                                                        &
-                            dt_dosp,                                                               &
-                            skip_time_dosp,                                                        &
-                            spectra_direction,                                                     &
-                            switch_off_module
-!
-!-- Position the namelist-file at the beginning (it was already opened in parin), and try to read
-!-- the namelist.
-    REWIND( 11 )
-    READ( 11, spectra_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    spectra_parameters namelist was found and read correctly. Set flag to indicate that spectra
-!--    have to be calculated.
-       IF ( .NOT.  switch_off_module )  THEN
-          calculate_spectra = .TRUE.
-!--       Default setting of dt_dosp here (instead of check_parameters), because its current value
-!--       is needed in init_pegrid.
-          IF ( dt_dosp == 9999999.9_wp )  dt_dosp = dt_data_output
-       ENDIF
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    spectra_parameters namelist was found but contained errors. Print an error message including
-!--    the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'spectra_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE spectra_parin
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of spectra related variables
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE spectra_init
-
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               ny,                                                                                 &
-               nzb,                                                                                &
-               nzt
-
-    IMPLICIT NONE
-
-    IF ( spectra_initialized )  RETURN
-
-    IF ( dt_dosp /= 9999999.9_wp )  THEN
-
-       IF ( .NOT. ALLOCATED( spectrum_x ) )  THEN
-          ALLOCATE( spectrum_x( 1:nx/2, 1:100, 1:10 ) )
-          spectrum_x = 0.0_wp
-       ENDIF
-
-       IF ( .NOT. ALLOCATED( spectrum_y ) )  THEN
-          ALLOCATE( spectrum_y( 1:ny/2, 1:100, 1:10 ) )
-          spectrum_y = 0.0_wp
-       ENDIF
-
-       ALLOCATE( var_d(nzb:nzt+1) )
-       var_d = 0.0_wp
-    ENDIF
-
-    spectra_initialized = .TRUE.
-
- END SUBROUTINE spectra_init
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check spectra related quantities
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE spectra_check_parameters
-
-    USE control_parameters,                                                                        &
-        ONLY:  averaging_interval,                                                                 &
-               message_string,                                                                     &
-               skip_time_data_output
-
-    IMPLICIT NONE
-
-!
-!-- Check the average interval
-    IF ( averaging_interval_sp == 9999999.9_wp )  THEN
-       averaging_interval_sp = averaging_interval
-    ENDIF
-
-    IF ( averaging_interval_sp > dt_dosp )  THEN
-       WRITE( message_string, * )  'averaging_interval_sp = ', averaging_interval_sp,              &
-                                   ' must be <= dt_dosp = ', dt_dosp
-       CALL message( 'spectra_check_parameters', 'PA0087', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Set the default skip time interval for data output, if necessary
-    IF ( skip_time_dosp == 9999999.9_wp )  skip_time_dosp = skip_time_data_output
-
- END SUBROUTINE spectra_check_parameters
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for spectra
-!>
-!> @todo Output of netcdf data format and compression level
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE spectra_header ( io )
-
-    USE control_parameters,                                                                        &
-        ONLY:  dt_averaging_input_pr
-
-!    USE netcdf_interface,                                                                          &
-!        ONLY:  netcdf_data_format_string,                                                          &
-!               netcdf_deflate
-
-    IMPLICIT NONE
-
-!    CHARACTER (LEN=40) ::  output_format !< internal string
-
-    INTEGER(iwp) ::  i               !< internal counter
-    INTEGER(iwp), INTENT(IN) ::  io  !< unit of the output file
-
-!
-!-- Spectra output
-    IF ( dt_dosp /= 9999999.9_wp )  THEN
-       WRITE ( io, 1 )
-
-!       output_format = netcdf_data_format_string
-!       IF ( netcdf_deflate == 0 )  THEN
-!          WRITE ( io, 2 )  output_format
-!       ELSE
-!          WRITE ( io, 3 )  TRIM( output_format ), netcdf_deflate
-!       ENDIF
-       WRITE ( io, 2 )  'see profiles or other quantities'
-       WRITE ( io, 4 )  dt_dosp
-       IF ( skip_time_dosp /= 0.0_wp )  WRITE ( io, 5 )  skip_time_dosp
-       WRITE ( io, 6 )  ( data_output_sp(i), i = 1,10 ),                                           &
-                        ( spectra_direction(i), i = 1,10 ),                                        &
-                        ( comp_spectra_level(i), i = 1,100 ),                                      &
-                        averaging_interval_sp, dt_averaging_input_pr
-    ENDIF
-
-  1 FORMAT ('    Spectra:')
-  2 FORMAT ('       Output format: ',A/)
-!  3 FORMAT ('       Output format: ',A, '   compressed with level: ',I1/)
-  4 FORMAT ('       Output every ',F7.1,' s'/)
-  5 FORMAT ('       No output during initial ',F8.2,' s')
-  6 FORMAT ('       Arrays:     ', 10(A5,',')/                                                     &
-            '       Directions: ', 10(A5,',')/                                                     &
-            '       height levels  k = ', 20(I3,',')/                                              &
-            '                          ', 20(I3,',')/                                              &
-            '                          ', 20(I3,',')/                                              &
-            '                          ', 20(I3,',')/                                              &
-            '                          ', 19(I3,','),I3,'.'/                                       &
-            '       Time averaged over ', F7.1, ' s,' /                                            &
-            '       Profiles for the time averaging are taken every ',                             &
-                 F6.1,' s')
-
- END SUBROUTINE spectra_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE calc_spectra
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  d
-#if defined( __parallel )
-    USE arrays_3d,                                                                                 &
-        ONLY:  tend
-#endif
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               message_string,                                                                     &
-               psolver
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point
-
-    USE fft_xy,                                                                                    &
-        ONLY:  fft_init
-
-    USE indices,                                                                                   &
-        ONLY:  nxl,                                                                                &
-               nxr,                                                                                &
-               nyn,                                                                                &
-               nys,                                                                                &
-               nzb,                                                                                &
-               nzt
-
-    USE kinds
-
-    USE pegrid,                                                                                    &
-        ONLY:  myid
-#if defined( __parallel )
-    USE pegrid,                                                                                    &
-        ONLY:  pdims
-#endif
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  m   !<
-    INTEGER(iwp) ::  pr  !<
-
-
-!
-!-- Check if user gave any levels for spectra to be calculated
-    IF ( comp_spectra_level(1) == 999999 )  RETURN
-
-    CALL cpu_log( log_point(30), 'calc_spectra', 'start' )
-
-!
-!-- Initialize spectra related quantities
-    CALL spectra_init
-
-!
-!-- Initialize ffts
-    CALL fft_init
-
-!
-!-- Reallocate array d in required size
-    IF ( psolver(1:9) == 'multigrid' )  THEN
-       DEALLOCATE( d )
-       ALLOCATE( d(nzb+1:nzt,nys:nyn,nxl:nxr) )
-    ENDIF
-
-    m = 1
-    DO WHILE ( data_output_sp(m) /= ' '  .AND.  m <= 10 )
-!
-!--    Transposition from z --> x  ( y --> x in case of a 1d-decomposition along x)
-       IF ( INDEX( spectra_direction(m), 'x' ) /= 0 )  THEN
-
-!
-!--       Calculation of spectra works for cyclic boundary conditions only
-          IF ( .NOT. bc_lr_cyc )  THEN
-
-             message_string = 'non-cyclic lateral boundaries along x do' //                        &
-                              ' not &  allow calculation of spectra along x'
-             CALL message( 'calc_spectra', 'PA0160', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          CALL preprocess_spectra( m, pr )
-
-#if defined( __parallel )
-          IF ( pdims(2) /= 1 )  THEN
-             CALL resort_for_zx( d, tend )
-             CALL transpose_zx( tend, d )
-          ELSE
-             CALL transpose_yxd( d, d )
-          ENDIF
-          CALL calc_spectra_x( d, m )
-#else
-          message_string = 'sorry, calculation of spectra in non parallel mode& is still not ' //  &
-                           'realized'
-          CALL message( 'calc_spectra', 'PA0161', 1, 2, 0, 6, 0 )
-#endif
-
-       ENDIF
-
-!
-!--    Transposition from z --> y (d is rearranged only in case of a 1d-decomposition along x)
-       IF ( INDEX( spectra_direction(m), 'y' ) /= 0 )  THEN
-
-!
-!--       Calculation of spectra works for cyclic boundary conditions only
-          IF ( .NOT. bc_ns_cyc )  THEN
-             IF ( myid == 0 )  THEN
-                message_string = 'non-cyclic lateral boundaries along y' //                        &
-                                 ' do not & allow calculation of spectra along y'
-                CALL message( 'calc_spectra', 'PA0162', 1, 2, 0, 6, 0 )
-             ENDIF
-             CALL local_stop
-          ENDIF
-
-          CALL preprocess_spectra( m, pr )
-
-#if defined( __parallel )
-          CALL transpose_zyd( d, d )
-          CALL calc_spectra_y( d, m )
-#else
-          message_string = 'sorry, calculation of spectra in non parallel mode& is still not ' //  &
-                           'realized'
-          CALL message( 'calc_spectra', 'PA0161', 1, 2, 0, 6, 0 )
-#endif
-
-       ENDIF
-
-!
-!--    Increase counter for next spectrum
-       m = m + 1
-
-    ENDDO
-
-!
-!-- Increase counter for averaging process in routine plot_spectra
-    average_count_sp = average_count_sp + 1
-
-    CALL cpu_log( log_point(30), 'calc_spectra', 'stop' )
-
- END SUBROUTINE calc_spectra
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE preprocess_spectra( m, pr )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  d,                                                                                  &
-               pt,                                                                                 &
-               q,                                                                                  &
-               s,                                                                                  &
-               u,                                                                                  &
-               v,                                                                                  &
-               w
-
-    USE indices,                                                                                   &
-        ONLY:  ngp_2dh,                                                                            &
-               nxl,                                                                                &
-               nxr,                                                                                &
-               nyn,                                                                                &
-               nys,                                                                                &
-               nzb,                                                                                &
-               nzt
-
-    USE kinds
-
-#if defined( __parallel )
-    USE MPI
-
-    USE pegrid,                                                                                    &
-        ONLY:  collective_wait,                                                                    &
-               comm2d,                                                                             &
-               ierr
-#endif
-
-    USE statistics,                                                                                &
-        ONLY:  hom
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i   !<
-    INTEGER(iwp) ::  j   !<
-    INTEGER(iwp) ::  k   !<
-    INTEGER(iwp) ::  m   !<
-    INTEGER(iwp) ::  pr  !<
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  var_d_l  !<
-
-
-    SELECT CASE ( TRIM( data_output_sp(m) ) )
-
-    CASE ( 'u' )
-       pr = 1
-       d(nzb+1:nzt,nys:nyn,nxl:nxr) = u(nzb+1:nzt,nys:nyn,nxl:nxr)
-
-    CASE ( 'v' )
-       pr = 2
-       d(nzb+1:nzt,nys:nyn,nxl:nxr) = v(nzb+1:nzt,nys:nyn,nxl:nxr)
-
-    CASE ( 'w' )
-       pr = 3
-       d(nzb+1:nzt,nys:nyn,nxl:nxr) = w(nzb+1:nzt,nys:nyn,nxl:nxr)
-
-    CASE ( 'theta' )
-       pr = 4
-       d(nzb+1:nzt,nys:nyn,nxl:nxr) = pt(nzb+1:nzt,nys:nyn,nxl:nxr)
-
-    CASE ( 'q' )
-       pr = 41
-       d(nzb+1:nzt,nys:nyn,nxl:nxr) = q(nzb+1:nzt,nys:nyn,nxl:nxr)
-
-    CASE ( 's' )
-       pr = 117
-       d(nzb+1:nzt,nys:nyn,nxl:nxr) = s(nzb+1:nzt,nys:nyn,nxl:nxr)
-
-    CASE DEFAULT
-!
-!--    The DEFAULT case is reached either if the parameter data_output_sp(m) contains a wrong
-!--    character string or if the user has coded a special case in the user interface. There, the
-!--    subroutine user_spectra checks which of these two conditions applies.
-       CALL user_spectra( 'preprocess', m, pr )
-
-    END SELECT
-
-!
-!-- Subtract horizontal mean from the array, for which spectra have to be calculated. Moreover,
-!-- calculate variance of the respective quantitiy, later used for normalizing spectra output.
-    var_d_l(:) = 0.0_wp
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             d(k,j,i)   = d(k,j,i) - hom(k,1,pr,0)
-             var_d_l(k) = var_d_l(k) + d(k,j,i) * d(k,j,i)
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Compute total variance from local variances
-    var_d(:) = 0.0_wp
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( var_d_l(0), var_d(0), nzt+1-nzb, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    var_d(:) = var_d_l(:)
-#endif
-    var_d(:) = var_d(:) / ngp_2dh(0)
-
- END SUBROUTINE preprocess_spectra
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-#if defined( __parallel )
- SUBROUTINE calc_spectra_x( ddd, m )
-
-    USE fft_xy,                                                                                    &
-        ONLY:  fft_x_1d
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx
-
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               ny
-
-    USE kinds
-
-    USE MPI
-
-    USE pegrid,                                                                                    &
-        ONLY:  comm2d,                                                                             &
-               ierr,                                                                               &
-               myid
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nyn_x,                                                                              &
-               nys_x,                                                                              &
-               nzb_x,                                                                              &
-               nzt_x
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-    INTEGER(iwp) ::  m  !<
-    INTEGER(iwp) ::  n  !<
-
-    REAL(wp) ::  exponent      !<
-    REAL(wp) ::  sum_spec_dum  !< wavenumber-integrated spectrum
-
-    REAL(wp), DIMENSION(0:nx) ::  work  !<
-
-    REAL(wp), DIMENSION(0:nx/2) ::  sums_spectra_l  !<
-
-    REAL(wp), DIMENSION(0:nx/2,100) ::  sums_spectra  !<
-
-    REAL(wp), DIMENSION(0:nx,nys_x:nyn_x,nzb_x:nzt_x) ::  ddd  !<
-
-!
-!-- Exponent for geometric average
-    exponent = 1.0_wp / ( ny + 1.0_wp )
-
-!
-!-- Loop over all levels defined by the user
-    n = 1
-    DO WHILE ( comp_spectra_level(n) /= 999999  .AND.  n <= 100 )
-
-       k = comp_spectra_level(n)
-
-!
-!--    Calculate FFT only if the corresponding level is situated on this PE
-       IF ( k >= nzb_x  .AND.  k <= nzt_x )  THEN
-
-          DO  j = nys_x, nyn_x
-
-             work = ddd(0:nx,j,k)
-             CALL fft_x_1d( work, 'forward' )
-
-             ddd(0,j,k) = dx * work(0)**2
-             DO  i = 1, nx/2
-                ddd(i,j,k) = dx * ( work(i)**2 + work(nx+1-i)**2 )
-             ENDDO
-
-          ENDDO
-
-!
-!--       Local sum and geometric average of these spectra (WARNING: no global sum should be
-!--       performed, because floating point overflow may occur)
-          DO  i = 0, nx/2
-
-             sums_spectra_l(i) = 1.0_wp
-             DO  j = nys_x, nyn_x
-                sums_spectra_l(i) = sums_spectra_l(i) * ddd(i,j,k)**exponent
-             ENDDO
-
-          ENDDO
-
-       ELSE
-
-          sums_spectra_l = 1.0_wp
-
-       ENDIF
-
-!
-!--    Global sum of spectra on PE0 (from where they are written on file)
-       sums_spectra(:,n) = 0.0_wp
-#if defined( __parallel )
-       CALL MPI_BARRIER( comm2d, ierr )  ! Necessary?
-       CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), nx/2+1, MPI_REAL, MPI_PROD, 0,       &
-                        comm2d, ierr )
-#else
-       sums_spectra(:,n) = sums_spectra_l
-#endif
-!
-!--    Normalize spectra by variance
-       sum_spec_dum = SUM( sums_spectra(1:nx/2,n) )
-
-       IF ( sum_spec_dum /= 0.0_wp )  THEN
-          sums_spectra(1:nx/2,n) = sums_spectra(1:nx/2,n) * var_d(k) / sum_spec_dum
-       ENDIF
-       n = n + 1
-
-    ENDDO
-    n = n - 1
-
-    IF ( myid == 0 )  THEN
-!
-!--    Sum of spectra for later averaging (see routine data_output_spectra)
-       DO  i = 1, nx/2
-          DO k = 1, n
-             spectrum_x(i,k,m) = spectrum_x(i,k,m) + sums_spectra(i,k)
-          ENDDO
-       ENDDO
-
-    ENDIF
-!
-!-- n_sp_x is needed by data_output_spectra_x
-    n_sp_x = n
-
- END SUBROUTINE calc_spectra_x
-#endif
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
-#if defined( __parallel )
- SUBROUTINE calc_spectra_y( ddd, m )
-
-    USE fft_xy,                                                                                    &
-        ONLY:  fft_y_1d
-
-    USE grid_variables,                                                                            &
-        ONLY:  dy
-
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               ny
-
-    USE kinds
-
-    USE MPI
-
-    USE pegrid,                                                                                    &
-        ONLY:  comm2d,                                                                             &
-               ierr,                                                                               &
-               myid
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_yd,                                                                             &
-               nxr_yd,                                                                             &
-               nzb_yd,                                                                             &
-               nzt_yd
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-    INTEGER(iwp) ::  m  !<
-    INTEGER(iwp) ::  n  !<
-
-    REAL(wp) ::  exponent  !<
-    REAL(wp) ::  sum_spec_dum  !< wavenumber-integrated spectrum
-
-    REAL(wp), DIMENSION(0:ny) ::  work  !<
-
-    REAL(wp), DIMENSION(0:ny/2) ::  sums_spectra_l  !<
-
-    REAL(wp), DIMENSION(0:ny/2,100) ::  sums_spectra  !<
-
-    REAL(wp), DIMENSION(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd) :: ddd  !<
-
-
-!
-!-- Exponent for geometric average
-    exponent = 1.0_wp / ( nx + 1.0_wp )
-
-!
-!-- Loop over all levels defined by the user
-    n = 1
-    DO WHILE ( comp_spectra_level(n) /= 999999  .AND.  n <= 100 )
-
-       k = comp_spectra_level(n)
-
-!
-!--    Calculate FFT only if the corresponding level is situated on this PE
-       IF ( k >= nzb_yd  .AND.  k <= nzt_yd )  THEN
-
-          DO  i = nxl_yd, nxr_yd
-
-             work = ddd(0:ny,i,k)
-             CALL fft_y_1d( work, 'forward' )
-
-             ddd(0,i,k) = dy * work(0)**2
-             DO  j = 1, ny/2
-                ddd(j,i,k) = dy * ( work(j)**2 + work(ny+1-j)**2 )
-             ENDDO
-
-          ENDDO
-
-!
-!--       Local sum and geometric average of these spectra (WARNING: no global sum should be
-!--       performed, because floating point overflow may occur)
-          DO  j = 0, ny/2
-
-             sums_spectra_l(j) = 1.0_wp
-             DO  i = nxl_yd, nxr_yd
-                sums_spectra_l(j) = sums_spectra_l(j) * ddd(j,i,k)**exponent
-             ENDDO
-
-          ENDDO
-
-       ELSE
-
-          sums_spectra_l = 1.0_wp
-
-       ENDIF
-
-!
-!--    Global sum of spectra on PE0 (from where they are written on file)
-       sums_spectra(:,n) = 0.0_wp
-#if defined( __parallel )
-       CALL MPI_BARRIER( comm2d, ierr )  ! Necessary?
-       CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), ny/2+1, MPI_REAL, MPI_PROD, 0,       &
-                        comm2d, ierr )
-#else
-       sums_spectra(:,n) = sums_spectra_l
-#endif
-!
-!--    Normalize spectra by variance
-       sum_spec_dum = SUM( sums_spectra(1:ny/2,n) )
-       IF ( sum_spec_dum /= 0.0_wp )  THEN
-          sums_spectra(1:ny/2,n) = sums_spectra(1:ny/2,n) * var_d(k) / sum_spec_dum
-       ENDIF
-       n = n + 1
-
-    ENDDO
-    n = n - 1
-
-
-    IF ( myid == 0 )  THEN
-!
-!--    Sum of spectra for later averaging (see routine data_output_spectra)
-       DO  j = 1, ny/2
-          DO k = 1, n
-             spectrum_y(j,k,m) = spectrum_y(j,k,m) + sums_spectra(j,k)
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-!
-!-- n_sp_y is needed by data_output_spectra_y
-    n_sp_y = n
-
- END SUBROUTINE calc_spectra_y
-#endif
-
- END MODULE spectra_mod
Index: palm/trunk/SOURCE/spline_x.f90
===================================================================
--- palm/trunk/SOURCE/spline_x.f90	(revision 1)
+++ palm/trunk/SOURCE/spline_x.f90	(revision 1)
@@ -0,0 +1,548 @@
+ SUBROUTINE spline_x( vad_in_out, ad_v, var_char )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: spline_x.f90,v $
+! Revision 1.8  2004/04/30 12:54:20  raasch
+! Names of transpose indices changed, enlarged transposition arrays introduced
+!
+! Revision 1.7  2003/03/16 09:47:17  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.6  2001/03/30 07:53:19  raasch
+! Arrays r, vad and wrk_spline changed from 3D to 2D and removed from argument
+! list. Several loops over k/j (parallel/non-parallel) combined to one loop.
+! Application of long filter moved to this routine. All comments and identifiers
+! translated into English.
+!
+! Revision 1.5  2001/01/22 08:07:41  raasch
+! Module test_variables removed
+!
+! Revision 1.4  1999/03/25 07:32:31  raasch
+! Filterung der Ueberschwinger geschieht optional, ups_limit_e eingefuehrt,
+! Ueberschwinger werden in gewissen Grenzen erlaubt
+!
+! Revision 1.3  1999/02/26 17:53:26  schroeter
+! - Gradientenkontrolle fuer den nicht-parallelen Teil
+! - statistische Auswertung ueber den prozentualen Anteil des
+!   Upstream-Verfahrens an der Gesamtadvektion fuer nicht-
+!   parallelen Teil
+!
+! Revision 1.2  1999/02/17 09:30:19  raasch
+! Wertebegrenzung zur Verhinderung von Ueberschwingern
+!
+! Revision 1.1  1999/02/05 09:15:59  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-spline advection along x
+!
+! Input/output parameters:
+! ad_v       = advecting wind speed component
+! vad_in_out = quantity to be advected, excluding ghost- or cyclic boundaries
+!              result is given to the calling routine in this array
+! var_char   = string which defines the quantity to be advected
+!
+! Internal arrays:
+! r          = 2D-working array (right hand side of linear equation, buffer for
+!              Long filter)
+! tf         = tendency field (2D), used for long filter
+! vad        = quantity to be advected (2D), including ghost- or cyclic
+!              boundarys along the direction of advection
+! wrk_long   = working array (long coefficients)
+! wrk_spline = working array (spline coefficients)
+!------------------------------------------------------------------------------!
+
+    USE advection
+    USE grid_variables
+    USE indices
+    USE statistics
+    USE control_parameters
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  var_char
+
+    INTEGER ::  component, i, j, k, sr
+    REAL    ::  overshoot_limit, sm_faktor, t1, t2, t3, ups_limit
+    REAL, DIMENSION(:,:),   ALLOCATABLE ::  r, tf, vad, wrk_spline
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  wrk_long
+
+#if defined( __parallel )
+    REAL ::  ad_v(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),       &
+             vad_in_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa)
+#else
+    REAL ::  ad_v(nzb+1:nzt,nys:nyn,nxl:nxr),               &
+             vad_in_out(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+#endif
+
+!
+!-- Set criteria for switching between upstream- and upstream-spline-method
+    IF ( var_char == 'u' )  THEN
+       overshoot_limit = overshoot_limit_u
+       ups_limit       = ups_limit_u
+       component       = 1
+    ELSEIF (  var_char == 'v' )  THEN
+       overshoot_limit = overshoot_limit_v
+       ups_limit       = ups_limit_v
+       component       = 2
+    ELSEIF (  var_char == 'w' )  THEN
+       overshoot_limit = overshoot_limit_w
+       ups_limit       = ups_limit_w
+       component       = 3
+    ELSEIF (  var_char == 'pt' )  THEN
+       overshoot_limit = overshoot_limit_pt
+       ups_limit       = ups_limit_pt
+       component       = 4
+    ELSEIF (  var_char == 'e' )  THEN
+       overshoot_limit = overshoot_limit_e
+       ups_limit       = ups_limit_e
+       component       = 5
+    ENDIF
+
+!
+!-- Initialize calculation of relative upstream fraction
+    sums_up_fraction_l(component,1,:) = 0.0
+
+#if defined( __parallel )
+
+!
+!-- Allocate working arrays
+    ALLOCATE( r(-1:nx+1,nys_x:nyn_x), vad(-1:nx+1,nys_x:nyn_x), &
+              wrk_spline(0:nx,nys_x:nyn_x) )
+    IF ( long_filter_factor /= 0.0 )  THEN
+       ALLOCATE( tf(0:nx,nys_x:nyn_x), wrk_long(0:nx,nys_x:nyn_x,1:3) )
+    ENDIF
+
+!
+!-- Loop over all gridpoints along z
+    DO  k = nzb_x, nzt_x
+
+!
+!--    Store array to be advected on work array and add cyclic boundary along x
+       vad(0:nx,nys_x:nyn_x) = vad_in_out(0:nx,nys_x:nyn_x,k)
+       vad(-1,:)   = vad(nx,:)
+       vad(nx+1,:) = vad(0,:)
+
+!
+!--    Calculate right hand side
+       DO  j = nys_x, nyn_x
+          DO  i = 0, nx
+             r(i,j) = 3.0 * (                                                  &
+                            spl_tri_x(2,i) * ( vad(i,j) - vad(i-1,j) ) * ddx + &
+                            spl_tri_x(3,i) * ( vad(i+1,j) - vad(i,j) ) * ddx   &
+                            )
+          ENDDO
+       ENDDO
+
+!
+!--    Forward substitution
+       DO  j = nys_x, nyn_x
+          wrk_spline(0,j) = r(0,j)
+          DO  i = 1, nx
+             wrk_spline(i,j) = r(i,j) - spl_tri_x(5,i) * wrk_spline(i-1,j)
+          ENDDO
+       ENDDO
+
+!
+!--    Backward substitution (Sherman-Morrison-formula)
+       DO  j = nys_x, nyn_x
+          r(nx,j) = wrk_spline(nx,j) / spl_tri_x(4,nx)
+          DO  i = nx-1, 0, -1
+             r(i,j) = ( wrk_spline(i,j) - spl_tri_x(3,i) * r(i+1,j) ) / &
+                      spl_tri_x(4,i)
+          ENDDO
+          sm_faktor = ( r(0,j) + 0.5 * r(nx,j) / spl_gamma_x ) / &
+                      ( 1.0 + spl_z_x(0) + 0.5 * spl_z_x(nx) / spl_gamma_x )
+          DO  i = 0, nx
+             r(i,j) = r(i,j) - sm_faktor * spl_z_x(i)
+          ENDDO
+       ENDDO
+
+!
+!--    Add cyclic boundary to right hand side
+       r(-1,:)   = r(nx,:)
+       r(nx+1,:) = r(0,:)
+
+!
+!--    Calculate advection along x
+       DO  j = nys_x, nyn_x
+          DO  i = 0, nx
+
+             IF ( ad_v(i,j,k) == 0.0 )  THEN
+
+                vad_in_out(i,j,k) = vad(i,j)
+
+             ELSEIF ( ad_v(i,j,k) > 0.0 )  THEN
+
+                IF ( ABS( vad(i,j) - vad(i-1,j) ) <= ups_limit )  THEN
+                   vad_in_out(i,j,k) = vad(i,j) - dt_3d * ad_v(i,j,k) * &
+                                       ( vad(i,j) - vad(i-1,j) ) * ddx 
+!
+!--                Calculate upstream fraction in % (s. flow_statistics)
+                   DO  sr = 0, statistic_regions
+                      sums_up_fraction_l(component,1,sr) = &
+                               sums_up_fraction_l(component,1,sr) + 1.0
+                   ENDDO
+                ELSE
+                   t1 = ad_v(i,j,k) * dt_3d * ddx
+                   t2 = 3.0 * ( vad(i-1,j) - vad(i,j) ) + &
+                        ( 2.0 * r(i,j) + r(i-1,j) ) * dx
+                   t3 = 2.0 * ( vad(i-1,j) - vad(i,j) ) + &
+                        ( r(i,j) + r(i-1,j) ) * dx
+                   vad_in_out(i,j,k) = vad(i,j) - r(i,j) * t1 * dx + &
+                                       t2 * t1**2 - t3 * t1**3
+                   IF ( vad(i-1,j) == vad(i,j) )  THEN
+                      vad_in_out(i,j,k) = vad(i,j)
+                   ENDIF
+                ENDIF
+
+             ELSE
+
+                IF ( ABS( vad(i,j) - vad(i+1,j) ) <= ups_limit )  THEN
+                   vad_in_out(i,j,k) = vad(i,j) - dt_3d * ad_v(i,j,k) * &
+                                       ( vad(i+1,j) - vad(i,j) ) * ddx
+!
+!--                Calculate upstream fraction in % (s. flow_statistics)
+                   DO  sr = 0, statistic_regions
+                      sums_up_fraction_l(component,1,sr) = &
+                               sums_up_fraction_l(component,1,sr) + 1.0
+                   ENDDO
+                ELSE
+                   t1 = -ad_v(i,j,k) * dt_3d * ddx
+                   t2 = 3.0 * ( vad(i,j) - vad(i+1,j) ) + &
+                        ( 2.0 * r(i,j) + r(i+1,j) ) * dx
+                   t3 = 2.0 * ( vad(i,j) - vad(i+1,j) ) + &
+                        ( r(i,j) + r(i+1,j) ) * dx
+                   vad_in_out(i,j,k) = vad(i,j) + r(i,j) * t1 * dx - &
+                                       t2 * t1**2 + t3 * t1**3
+                   IF ( vad(i+1,j) == vad(i,j) )  THEN
+                      vad_in_out(i,j,k) = vad(i,j)
+                   ENDIF
+                ENDIF
+
+             ENDIF
+          ENDDO
+       ENDDO
+
+!
+!--    Limit values in order to prevent overshooting
+       IF ( cut_spline_overshoot )  THEN
+
+          DO  j = nys_x, nyn_x
+             DO  i = 0, nx
+                IF ( ad_v(i,j,k) > 0.0 ) THEN
+                   IF ( vad(i,j) > vad(i-1,j) )  THEN
+                      vad_in_out(i,j,k) = MIN( vad_in_out(i,j,k), &
+                                               vad(i,j)   + overshoot_limit )
+                      vad_in_out(i,j,k) = MAX( vad_in_out(i,j,k), &
+                                               vad(i-1,j) - overshoot_limit )
+                   ELSE
+                      vad_in_out(i,j,k) = MAX( vad_in_out(i,j,k), &
+                                               vad(i,j)   - overshoot_limit )
+                      vad_in_out(i,j,k) = MIN( vad_in_out(i,j,k), &
+                                               vad(i-1,j) + overshoot_limit )
+                   ENDIF
+                ELSE
+                   IF ( vad(i,j) > vad(i+1,j) )  THEN
+                      vad_in_out(i,j,k) = MIN( vad_in_out(i,j,k), &
+                                               vad(i,j)   + overshoot_limit )
+                      vad_in_out(i,j,k) = MAX( vad_in_out(i,j,k), &
+                                               vad(i+1,j) - overshoot_limit )
+                   ELSE
+                      vad_in_out(i,j,k) = MAX( vad_in_out(i,j,k), &
+                                               vad(i,j)   - overshoot_limit )
+                      vad_in_out(i,j,k) = MIN( vad_in_out(i,j,k), &
+                                               vad(i+1,j) + overshoot_limit )
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+!
+!--    Long-filter (acting on tendency only)
+       IF ( long_filter_factor /= 0.0 )  THEN
+
+!
+!--       Compute tendency
+          DO  j = nys_x, nyn_x
+             DO  i = 0, nx
+                tf(i,j) = vad_in_out(i,j,k) - vad(i,j)
+             ENDDO
+          ENDDO
+
+!
+!--       Apply the filter.
+          DO  j = nys_x, nyn_x
+             wrk_long(0,j,1) = 2.0 * ( 1.0 + long_filter_factor )
+             wrk_long(0,j,2) = ( 1.0 - long_filter_factor ) / wrk_long(0,j,1)
+             wrk_long(0,j,3) = ( long_filter_factor * tf(nx,j) + &
+                                 2.0 * tf(0,j) + tf(1,j)         &
+                               ) / wrk_long(0,j,1)
+             DO  i = 1, nx-1
+                wrk_long(i,j,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+                                  ( 1.0 - long_filter_factor ) * wrk_long(i-1,j,2)
+                wrk_long(i,j,2) = ( 1.0 - long_filter_factor ) / wrk_long(i,j,1)
+                wrk_long(i,j,3) = ( tf(i-1,j) + 2.0 * tf(i,j)  +               &
+                                    tf(i+1,j) - ( 1.0 - long_filter_factor ) * &
+                                    wrk_long(i-1,j,3) ) / wrk_long(i,j,1)
+             ENDDO
+             wrk_long(nx,j,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+                                ( 1.0 - long_filter_factor ) * wrk_long(nx-1,j,2)
+             wrk_long(nx,j,2) = ( 1.0 - long_filter_factor ) / wrk_long(nx,j,1)
+             wrk_long(nx,j,3) = ( tf(nx-1,j) + 2.0 * tf(nx,j) +  &
+                                  long_filter_factor * tf(0,j) - &
+                                  ( 1.0 - long_filter_factor ) * &
+                                  wrk_long(nx-1,j,3)             &
+                                ) / wrk_long(nx,j,1)
+             r(nx,j) = wrk_long(nx,j,3)
+          ENDDO
+
+          DO  i = nx-1, 0, -1
+             DO  j = nys_x, nyn_x
+                r(i,j) = wrk_long(i,j,3) - wrk_long(i,j,2) * r(i+1,j)
+             ENDDO
+          ENDDO
+
+          DO  j = nys_x, nyn_x 
+             DO  i = 0, nx
+                vad_in_out(i,j,k) = vad(i,j) + r(i,j)
+             ENDDO
+          ENDDO
+
+       ENDIF  ! Long filter
+
+    ENDDO
+
+#else
+
+!
+!-- Allocate working arrays
+    ALLOCATE( r(nzb+1:nzt,nxl-1:nxr+1), vad(nzb:nzt+1,nxl-1:nxr+1), &
+              wrk_spline(nzb+1:nzt,nxl-1:nxr+1) )
+    IF ( long_filter_factor /= 0.0 )  THEN
+       ALLOCATE( tf(nzb+1:nzt,nxl-1:nxr+1), wrk_long(nzb+1:nzt,0:nx,1:3) )
+    ENDIF
+
+!
+!-- Loop over all gridpoints along y
+    DO  j = nys, nyn
+    
+!
+!--    Store array to be advected on work array and add cyclic boundary along x
+       vad(:,:) = vad_in_out(:,j,:)
+       vad(:,-1)   = vad(:,nx)
+       vad(:,nx+1) = vad(:,0)
+
+!
+!--    Calculate right hand side
+       DO  i = 0, nx
+          DO  k = nzb+1, nzt
+             r(k,i) = 3.0 * (                                                  &
+                            spl_tri_x(2,i) * ( vad(k,i) - vad(k,i-1) ) * ddx + &
+                            spl_tri_x(3,i) * ( vad(k,i+1) - vad(k,i) ) * ddx   &
+                            )
+          ENDDO
+       ENDDO
+    
+!
+!--    Forward substitution
+       DO  k = nzb+1, nzt
+          wrk_spline(k,0) = r(k,0)
+       ENDDO
+
+       DO  i = 1, nx
+          DO  k = nzb+1, nzt
+             wrk_spline(k,i) = r(k,i) - spl_tri_x(5,i) * wrk_spline(k,i-1)
+          ENDDO
+       ENDDO
+
+!
+!--    Backward substitution (Sherman-Morrison-formula)
+       DO  k = nzb+1, nzt
+          r(k,nx) = wrk_spline(k,nx) / spl_tri_x(4,nx)
+       ENDDO
+
+       DO  k = nzb+1, nzt
+          DO  i = nx-1, 0, -1
+             r(k,i) = ( wrk_spline(k,i) - spl_tri_x(3,i) * r(k,i+1) ) / &
+                        spl_tri_x(4,i)
+          ENDDO
+          sm_faktor = ( r(k,0) + 0.5 * r(k,nx) / spl_gamma_x ) / &
+                      ( 1.0 + spl_z_x(0) + 0.5 * spl_z_x(nx) / spl_gamma_x )
+          DO  i = 0, nx
+             r(k,i) = r(k,i) - sm_faktor * spl_z_x(i)
+          ENDDO
+       ENDDO
+
+!
+!--    Add cyclic boundary to the right hand side
+       r(:,-1)   = r(:,nx)
+       r(:,nx+1) = r(:,0)
+
+!
+!--    Calculate advection along x
+       DO  i = 0, nx
+          DO  k = nzb+1, nzt
+
+             IF (ad_v(k,j,i) == 0.0)  THEN
+
+                vad_in_out(k,j,i) = vad(k,i)
+
+             ELSEIF ( ad_v(k,j,i) > 0.0)  THEN
+                
+                IF ( ABS( vad(k,i) - vad(k,i-1) ) <= ups_limit ) THEN
+                   vad_in_out(k,j,i) = vad(k,i) - dt_3d * ad_v(k,j,i) * &
+                                       ( vad(k,i) - vad(k,i-1) ) * ddx
+!
+!--                Calculate upstream fraction in % (s. flow_statistics)
+                   DO  sr = 0, statistic_regions
+                      sums_up_fraction_l(component,1,sr) = &
+                               sums_up_fraction_l(component,1,sr) + 1.0
+                   ENDDO
+                ELSE 
+                   t1 = ad_v(k,j,i) * dt_3d * ddx
+                   t2 = 3.0 * ( vad(k,i-1) - vad(k,i) ) + &
+                        ( 2.0 * r(k,i) + r(k,i-1) ) * dx
+                   t3 = 2.0 * ( vad(k,i-1) - vad(k,i) ) + &
+                        ( r(k,i) + r(k,i-1) ) * dx
+                   vad_in_out(k,j,i) = vad(k,i) - r(k,i) * t1 * dx + &
+                                       t2 * t1**2 - t3 * t1**3
+                   IF ( vad(k,i-1) == vad(k,i) )  THEN
+                      vad_in_out(k,j,i) = vad(k,i)
+                   ENDIF
+                ENDIF
+
+             ELSE
+
+                IF ( ABS( vad(k,i) - vad(k,i+1) ) <= ups_limit ) THEN
+                   vad_in_out(k,j,i) = vad(k,i) - dt_3d * ad_v(k,j,i) * &
+                                       ( vad(k,i+1) - vad(k,i) ) * ddx
+!
+!--                Calculate upstream fraction in % (s. flow_statistics)
+                   DO  sr = 0, statistic_regions
+                      sums_up_fraction_l(component,1,sr) = &
+                               sums_up_fraction_l(component,1,sr) + 1.0
+                   ENDDO
+                ELSE
+                   t1 = -ad_v(k,j,i) * dt_3d * ddx
+                   t2 = 3.0 * ( vad(k,i) - vad(k,i+1) ) + &
+                        ( 2.0 * r(k,i) + r(k,i+1)) * dx
+                   t3 = 2.0 * ( vad(k,i) - vad(k,i+1) ) + &
+                        ( r(k,i) + r(k,i+1) ) * dx
+                   vad_in_out(k,j,i) = vad(k,i) + r(k,i) * t1 * dx - &
+                                       t2 * t1**2 + t3 * t1**3
+                   IF ( vad(k,i+1) == vad(k,i) )  THEN
+                      vad_in_out(k,j,i) = vad(k,i)
+                   ENDIF
+                ENDIF
+
+             ENDIF
+          ENDDO
+       ENDDO
+
+!
+!--    Limit values in order to prevent overshooting
+       IF ( cut_spline_overshoot )  THEN
+
+          DO  i = 0, nx
+             DO  k =  nzb+1, nzt
+                IF ( ad_v(k,j,i) > 0.0 ) THEN
+                   IF ( vad(k,i) > vad(k,i-1) )  THEN
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k,i)   + overshoot_limit )
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k,i-1) - overshoot_limit )
+                   ELSE
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k,i)   - overshoot_limit )
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k,i-1) + overshoot_limit )
+                   ENDIF
+                ELSE
+                   IF ( vad(k,i) > vad(k,i+1) )  THEN
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k,i)   + overshoot_limit )
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k,i+1) - overshoot_limit )
+                   ELSE
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k,i)   - overshoot_limit )
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k,i+1) + overshoot_limit )
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+!
+!--    Long filter (acting on tendency only)
+       IF ( long_filter_factor /= 0.0 )  THEN
+
+!
+!--       Compute tendency
+          DO  i = nxl, nxr
+             DO  k = nzb+1, nzt
+                tf(k,i) = vad_in_out(k,j,i) - vad(k,i)
+             ENDDO
+          ENDDO
+
+!
+!--       Apply the filter
+          wrk_long(:,0,1) = 2.0 * ( 1.0 + long_filter_factor )
+          wrk_long(:,0,2) = ( 1.0 - long_filter_factor ) / wrk_long(:,0,1)
+          wrk_long(:,0,3) = ( long_filter_factor * tf(:,nx) + &
+                                   2.0 * tf(:,0) + tf(:,1) ) / wrk_long(:,0,1)
+
+          DO  i = 1, nx-1
+             DO  k = nzb+1, nzt
+                wrk_long(k,i,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+                                  ( 1.0 - long_filter_factor ) *       &
+                                  wrk_long(k,i-1,2)
+                wrk_long(k,i,2) = ( 1.0 - long_filter_factor ) / wrk_long(k,i,1)
+                wrk_long(k,i,3) = ( tf(k,i-1) + 2.0 * tf(k,i) +                &
+                                    tf(k,i+1) - ( 1.0 - long_filter_factor ) * &
+                                    wrk_long(k,i-1,3) ) / wrk_long(k,i,1)
+             ENDDO
+             wrk_long(:,nx,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+                                      ( 1.0 - long_filter_factor ) * &
+                                        wrk_long(:,nx-1,2)
+             wrk_long(:,nx,2) = ( 1.0 - long_filter_factor ) / wrk_long(:,nx,1)
+             wrk_long(:,nx,3) = ( tf(:,nx-1) + 2.0 * tf(:,nx) +    &
+                                    long_filter_factor * tf(:,0) - &
+                                    ( 1.0 - long_filter_factor ) * &
+                                    wrk_long(:,nx-1,3) ) / wrk_long(:,nx,1)
+             r(:,nx) = wrk_long(:,nx,3)
+          ENDDO
+          DO  i = nx-1, 0, -1
+             DO  k = nzb+1, nzt
+                r(k,i) = wrk_long(k,i,3) - wrk_long(k,i,2) * r(k,i+1)
+             ENDDO
+          ENDDO
+          DO  i = 0, nx
+             DO  k = nzb+1, nzt
+                vad_in_out(k,j,i) = vad(k,i) + r(k,i)
+             ENDDO
+          ENDDO
+
+       ENDIF  ! Long filter
+
+    ENDDO
+#endif
+
+    IF ( long_filter_factor /= 0.0 )  DEALLOCATE( tf, wrk_long )
+    DEALLOCATE( r, vad, wrk_spline )
+
+ END SUBROUTINE spline_x
Index: palm/trunk/SOURCE/spline_y.f90
===================================================================
--- palm/trunk/SOURCE/spline_y.f90	(revision 1)
+++ palm/trunk/SOURCE/spline_y.f90	(revision 1)
@@ -0,0 +1,553 @@
+ SUBROUTINE spline_y( vad_in_out, ad_v, var_char )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: spline_y.f90,v $
+! Revision 1.9  2004/04/30 12:54:37  raasch
+! Names of transpose indices changed, enlarged transposition arrays introduced
+!
+! Revision 1.8  2003/03/16 09:48:41  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.7  2001/03/30 07:53:40  raasch
+! Arrays r and wrk_spline changed from 3D to 2D and removed from argument
+! list. Several loops over k/i (parallel/non-parallel) combined to one loop.
+! Application of long filter moved to this routine. All comments and identifiers
+! translated into English.
+!
+! Revision 1.6  2001/01/22 08:09:04  raasch
+! Module test_variables removed
+!
+! Revision 1.5  1999/11/25 16:30:42  raasch
+! Laufindex-Fehler korrigiert
+!
+! Revision 1.4  1999/03/25 07:33:16  raasch
+! Filterung der Ueberschwinger geschieht optional, ups_limit_e eingefuehrt,
+! Ueberschwinger werden in gewissen Grenzen erlaubt
+!
+! Revision 1.3  1999/02/26 17:54:28  schroeter
+! - Gradientenkontrolle fuer den nicht-parallelen Teil
+! - statistische Auswertung ueber den prozentualen Anteil des
+!   Upstream-Verfahrens an der Gesamtadvektion fuer nicht-
+!   parallelen Teil
+!
+! Revision 1.2  1999/02/17 09:31:34  raasch
+! Test einer Wertebegrenzung zur Verhinderung von Ueberschwingern
+!
+! Revision 1.1  1999/02/05 09:16:31  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-spline advection along x
+!
+! Input/output parameters:
+! ad_v       = advecting wind speed component
+! vad_in_out = quantity to be advected, excluding ghost- or cyclic boundaries
+!              result is given to the calling routine in this array
+! var_char   = string which defines the quantity to be advected
+!
+! Internal arrays:
+! r          = 2D-working array (right hand side of linear equation, buffer for
+!              Long filter)
+! tf         = tendency field (2D), used for long filter
+! vad        = quantity to be advected (2D), including ghost- or cyclic
+!              boundarys along the direction of advection
+! wrk_long   = working array (long coefficients)
+! wrk_spline = working array (spline coefficients)
+!------------------------------------------------------------------------------!
+
+    USE advection
+    USE grid_variables
+    USE indices
+    USE statistics
+    USE control_parameters
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  var_char
+
+    INTEGER ::  component, i, j, k, sr
+    REAL    ::  overshoot_limit, sm_faktor, t1, t2, t3, ups_limit
+    REAL, DIMENSION(:,:), ALLOCATABLE   ::  r, tf, vad, wrk_spline
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  wrk_long
+
+#if defined( __parallel )
+    REAL ::  ad_v(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), &
+             vad_in_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya)
+#else
+    REAL ::  ad_v(nzb+1:nzt,nys:nyn,nxl:nxr), &
+             vad_in_out(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+#endif
+
+!
+!-- Set criteria for switching between upstream- and upstream-spline-method
+    IF ( var_char == 'u' )  THEN
+       overshoot_limit = overshoot_limit_u
+       ups_limit       = ups_limit_u
+       component       = 1
+    ELSEIF (  var_char == 'v' )  THEN
+       overshoot_limit = overshoot_limit_v
+       ups_limit       = ups_limit_v
+       component       = 2
+    ELSEIF (  var_char == 'w' )  THEN
+       overshoot_limit = overshoot_limit_w
+       ups_limit       = ups_limit_w
+       component       = 3
+    ELSEIF (  var_char == 'pt' )  THEN
+       overshoot_limit = overshoot_limit_pt
+       ups_limit       = ups_limit_pt
+       component       = 4
+    ELSEIF (  var_char == 'e' )  THEN
+       overshoot_limit = overshoot_limit_e
+       ups_limit       = ups_limit_e
+       component       = 5
+    ENDIF
+
+!
+!-- Initialize calculation of relative upstream fraction
+    sums_up_fraction_l(component,2,:) = 0.0
+
+#if defined( __parallel )
+
+!
+!-- Allocate working arrays
+    ALLOCATE( r(-1:ny+1,nxl_y:nxr_y),   &
+              vad(-1:ny+1,nxl_y:nxr_y), &
+              wrk_spline(0:ny,nxl_y:nxr_y) )
+    IF ( long_filter_factor /= 0.0 )  THEN
+       ALLOCATE( tf(0:ny,nxl_y:nxr_y), &
+                 wrk_long(0:ny,nxl_y:nxr_y,1:3) )
+    ENDIF
+
+!
+!-- Loop over all gridpoints along z
+    DO  k = nzb_y, nzt_y
+
+!
+!--    Store array to be advected on work array and add cyclic boundary along y
+       vad(0:ny,nxl_y:nxr_y) = vad_in_out(0:ny,nxl_y:nxr_y,k)
+       vad(-1,:)   = vad(ny,:)
+       vad(ny+1,:) = vad(0,:)
+
+!
+!--    Calculate right hand side
+       DO  i = nxl_y, nxr_y
+          DO  j = 0, ny
+             r(j,i) = 3.0 * (                                                  &
+                            spl_tri_y(2,j) * ( vad(j,i) - vad(j-1,i) ) * ddy + &
+                            spl_tri_y(3,j) * ( vad(j+1,i) - vad(j,i) ) * ddy   &
+                            )
+          ENDDO
+       ENDDO
+    
+!
+!--    Forward substitution
+       DO  i = nxl_y, nxr_y
+          wrk_spline(0,i) = r(0,i)
+          DO  j = 1, ny
+             wrk_spline(j,i) = r(j,i) - spl_tri_y(5,j) * wrk_spline(j-1,i)
+          ENDDO
+       ENDDO
+    
+!
+!--    Backward substitution (sherman-Morrison-formula)
+       DO  i = nxl_y, nxr_y
+          r(ny,i) = wrk_spline(ny,i) / spl_tri_y(4,ny)
+          DO  j = ny-1, 0, -1
+             r(j,i) = ( wrk_spline(j,i) - spl_tri_y(3,j) * r(j+1,i) ) / &
+                        spl_tri_y(4,j)
+          ENDDO
+          sm_faktor = ( r(0,i) + 0.5 * r(ny,i) / spl_gamma_y ) / &
+                      ( 1.0 + spl_z_y(0) + 0.5 * spl_z_y(ny) / spl_gamma_y )
+          DO  j = 0, ny
+             r(j,i) = r(j,i) - sm_faktor * spl_z_y(j)
+          ENDDO
+       ENDDO
+
+! 
+!--    Add cyclic boundary conditions to right hand side
+       r(-1,:)   = r(ny,:)
+       r(ny+1,:) = r(0,:)
+
+!
+!--    Calculate advection along y
+       DO  i = nxl_y, nxr_y
+          DO  j = 0, ny
+
+             IF ( ad_v(j,i,k) == 0.0 )  THEN
+
+                vad_in_out(j,i,k) = vad(j,i)
+
+             ELSEIF ( ad_v(j,i,k) > 0.0 )  THEN
+
+                IF ( ABS( vad(j,i) - vad(j-1,i) ) <= ups_limit )  THEN
+                   vad_in_out(j,i,k) = vad(j,i) - dt_3d * ad_v(j,i,k) * &
+                                       ( vad(j,i) - vad(j-1,i) ) * ddy
+!
+!--                Calculate upstream fraction in % (s. flow_statistics)
+                   DO  sr = 0, statistic_regions
+                      sums_up_fraction_l(component,2,sr) = &
+                               sums_up_fraction_l(component,2,sr) + 1.0
+                   ENDDO
+                ELSE
+                   t1 = ad_v(j,i,k) * dt_3d * ddy
+                   t2 = 3.0 * ( vad(j-1,i) - vad(j,i) ) + &
+                        ( 2.0 * r(j,i) + r(j-1,i) ) * dy
+                   t3 = 2.0 * ( vad(j-1,i) - vad(j,i) ) + &
+                              ( r(j,i) + r(j-1,i) ) * dy
+                   vad_in_out(j,i,k) = vad(j,i) - r(j,i) * t1 * dy + &
+                                       t2 * t1**2 - t3 * t1**3
+                   IF ( vad(j-1,i) == vad(j,i) )  THEN
+                      vad_in_out(j,i,k) = vad(j,i)
+                   ENDIF
+                ENDIF
+
+             ELSE
+
+                IF ( ABS( vad(j,i) - vad(j+1,i) ) <= ups_limit )  THEN
+                   vad_in_out(j,i,k) = vad(j,i) - dt_3d * ad_v(j,i,k) * &
+                                       ( vad(j+1,i) - vad(j,i) ) * ddy
+!
+!--                Calculate upstream fraction in % (s. flow_statistics)
+                   DO  sr = 0, statistic_regions
+                      sums_up_fraction_l(component,2,sr) = &
+                               sums_up_fraction_l(component,2,sr) + 1.0
+                   ENDDO
+                ELSE
+                   t1 = -ad_v(j,i,k) * dt_3d * ddy
+                   t2 = 3.0 * ( vad(j,i) - vad(j+1,i) ) + &
+                        ( 2.0 * r(j,i) + r(j+1,i) ) * dy
+                   t3 = 2.0 * ( vad(j,i) - vad(j+1,i) ) + &
+                        ( r(j,i) + r(j+1,i) ) * dy
+                   vad_in_out(j,i,k) = vad(j,i) + r(j,i) * t1 * dy - &
+                                       t2 * t1**2 + t3 * t1**3
+                   IF ( vad(j+1,i) == vad(j,i) )  THEN
+                      vad_in_out(j,i,k) = vad(j,i)
+                   ENDIF
+                ENDIF
+
+             ENDIF
+          ENDDO
+       ENDDO
+
+!
+!--    Limit values in order to prevent overshooting
+       IF ( cut_spline_overshoot )  THEN
+
+          DO  i = nxl_y, nxr_y
+             DO  j = 0, ny
+                IF ( ad_v(j,i,k) > 0.0 ) THEN
+                   IF ( vad(j,i) > vad(j-1,i) )  THEN
+                      vad_in_out(j,i,k) = MIN( vad_in_out(j,i,k), &
+                                               vad(j,i)   + overshoot_limit )
+                      vad_in_out(j,i,k) = MAX( vad_in_out(j,i,k), &
+                                               vad(j-1,i) - overshoot_limit )
+                   ELSE
+                      vad_in_out(j,i,k) = MAX( vad_in_out(j,i,k), &
+                                               vad(j,i)   - overshoot_limit )
+                      vad_in_out(j,i,k) = MIN( vad_in_out(j,i,k), &
+                                               vad(j-1,i) + overshoot_limit )
+                   ENDIF
+                ELSE
+                   IF ( vad(j,i) > vad(j+1,i) )  THEN
+                      vad_in_out(j,i,k) = MIN( vad_in_out(j,i,k), &
+                                               vad(j,i)   + overshoot_limit )
+                      vad_in_out(j,i,k) = MAX( vad_in_out(j,i,k), &
+                                               vad(j+1,i) - overshoot_limit )
+                   ELSE
+                      vad_in_out(j,i,k) = MAX( vad_in_out(j,i,k), &
+                                               vad(j,i)   - overshoot_limit )
+                      vad_in_out(j,i,k) = MIN( vad_in_out(j,i,k), &
+                                               vad(j+1,i) + overshoot_limit )
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+!
+!--    Long-filter (acting on tendency only)
+       IF ( long_filter_factor /= 0.0 )  THEN
+
+!
+!--       Compute tendency. Filter only acts on this quantity.
+          DO  i = nxl_y, nxr_y
+             DO  j = 0, ny
+                tf(j,i) = vad_in_out(j,i,k) - vad(j,i)
+             ENDDO
+          ENDDO
+
+!
+!--       Apply the filter.
+          DO  i = nxl_y, nxr_y
+             wrk_long(0,i,1) = 2.0 * ( 1.0 + long_filter_factor )
+             wrk_long(0,i,2) = ( 1.0 - long_filter_factor ) / wrk_long(0,i,1)
+             wrk_long(0,i,3) = ( long_filter_factor * tf(ny,i) + &
+                                2.0 * tf(0,i) + tf(1,i)          &
+                               ) / wrk_long(0,i,1)
+             DO  j = 1, ny-1
+                wrk_long(j,i,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+                                  ( 1.0 - long_filter_factor ) * wrk_long(j-1,i,2)
+                wrk_long(j,i,2) = ( 1.0 - long_filter_factor ) / wrk_long(j,i,1)
+                wrk_long(j,i,3) = ( tf(j-1,i) + 2.0 * tf(j,i) +                &
+                                    tf(j+1,i) - ( 1.0 - long_filter_factor ) * &
+                                    wrk_long(j-1,i,3) ) / wrk_long(j,i,1)
+             ENDDO
+             wrk_long(ny,i,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+                                ( 1.0 - long_filter_factor ) * wrk_long(ny-1,i,2)
+             wrk_long(ny,i,2) = ( 1.0 - long_filter_factor ) / wrk_long(ny,i,1)
+             wrk_long(ny,i,3) = ( tf(ny-1,i) + 2.0 * tf(ny,i) +  &
+                                  long_filter_factor * tf(0,i) - &
+                                  ( 1.0 - long_filter_factor ) * &
+                                  wrk_long(ny-1,i,3)             &
+                                ) / wrk_long(ny,i,1)
+             r(ny,i) = wrk_long(ny,i,3)
+          ENDDO
+
+          DO  j = ny-1, 0, -1
+             DO  i = nxl_y, nxr_y
+                r(j,i) = wrk_long(j,i,3) - wrk_long(j,i,2) * r(j+1,i)
+             ENDDO
+          ENDDO
+
+          DO  i = nxl_y, nxr_y
+             DO  j = 0, ny
+                vad_in_out(j,i,k) = vad(j,i) + r(j,i)
+             ENDDO
+          ENDDO
+
+       ENDIF  ! Long filter
+
+    ENDDO
+
+#else
+
+!
+!-- Allocate working arrays
+    ALLOCATE( r(nzb+1:nzt,nys-1:nyn+1), vad(nzb:nzt+1,nys-1:nyn+1), &
+              wrk_spline(nzb+1:nzt,nys-1:nyn+1) )
+    IF ( long_filter_factor /= 0.0 )  THEN
+       ALLOCATE( tf(nzb+1:nzt,nys-1:nyn+1), wrk_long(nzb+1:nzt,0:ny,1:3) )
+    ENDIF
+
+!
+!-- Loop over all gridpoints along x
+    DO  i = nxl, nxr
+
+!
+!--    Store array to be advected on work array and add cyclic boundary along x
+       vad(:,:)    = vad_in_out(:,:,i)
+       vad(:,-1)   = vad(:,ny)
+       vad(:,ny+1) = vad(:,0)
+
+!
+!--    Calculate right hand side
+       DO  j = 0, ny
+          DO  k = nzb+1, nzt
+             r(k,j) = 3.0 *  (                                                  &
+                             spl_tri_y(2,j) * ( vad(k,j) - vad(k,j-1) ) * ddy + &
+                             spl_tri_y(3,j) * ( vad(k,j+1) - vad(k,j) ) * ddy   &
+                             )
+          ENDDO
+       ENDDO
+    
+!
+!--    Forward substitution
+       DO  k = nzb+1, nzt
+          wrk_spline(k,0) = r(k,0)
+       ENDDO
+
+       DO  j = 1, ny
+          DO  k = nzb+1, nzt
+             wrk_spline(k,j) = r(k,j) - spl_tri_y(5,j) * wrk_spline(k,j-1)
+          ENDDO
+       ENDDO
+
+!
+!--    Backward substitution (Sherman-Morrison-formula)
+       DO  k = nzb+1, nzt
+          r(k,ny) = wrk_spline(k,ny) / spl_tri_y(4,ny)
+       ENDDO
+
+       DO  k = nzb+1, nzt
+          DO  j = ny-1, 0, -1
+             r(k,j) = ( wrk_spline(k,j) - spl_tri_y(3,j) * r(k,j+1) ) / &
+                        spl_tri_y(4,j)
+          ENDDO
+          sm_faktor = ( r(k,0) + 0.5 * r(k,ny) / spl_gamma_y ) / &
+                      ( 1.0 + spl_z_y(0) + 0.5 * spl_z_y(ny) / spl_gamma_y )
+          DO  j = 0, ny
+             r(k,j) = r(k,j) - sm_faktor * spl_z_y(j)
+          ENDDO
+       ENDDO
+
+!
+!--    Add cyclic boundary to the right hand side
+       r(:,-1)   = r(:,ny)
+       r(:,ny+1) = r(:,0)
+   
+!
+!--    Calculate advection along y
+       DO  j = 0, ny
+          DO  k = nzb+1, nzt
+
+             IF ( ad_v(k,j,i) == 0.0 )  THEN
+
+                vad_in_out(k,j,i) = vad(k,j)
+
+             ELSEIF ( ad_v(k,j,i) > 0.0 )  THEN
+
+                IF ( ABS( vad(k,j) - vad(k,j-1) ) <= ups_limit ) THEN
+                   vad_in_out(k,j,i) = vad(k,j) - dt_3d * ad_v(k,j,i) * &
+                                       ( vad(k,j) - vad(k,j-1) ) * ddy
+!
+!--                Calculate upstream fraction in % (s. flow_statistics)
+                   DO  sr = 0, statistic_regions
+                      sums_up_fraction_l(component,2,sr) = &
+                               sums_up_fraction_l(component,2,sr) + 1.0
+                   ENDDO
+                ELSE
+                   t1 = ad_v(k,j,i) * dt_3d * ddy
+                   t2 = 3.0 * ( vad(k,j-1) - vad(k,j) ) + &
+                        ( 2.0 * r(k,j) + r(k,j-1) ) * dy
+                   t3 = 2.0 * ( vad(k,j-1) - vad(k,j) ) + &
+                        ( r(k,j) + r(k,j-1) ) * dy
+                   vad_in_out(k,j,i) = vad(k,j) - r(k,j) * t1 * dy + &
+                                       t2 * t1**2 - t3 * t1**3
+                   IF ( vad(k,j-1) == vad(k,j) )  THEN
+                      vad_in_out(k,j,i) = vad(k,j)
+                   ENDIF
+                ENDIF
+
+             ELSE
+                
+                IF ( ABS( vad(k,j) - vad(k,j+1) ) <= ups_limit ) THEN
+                   vad_in_out(k,j,i) = vad(k,j) - dt_3d * ad_v(k,j,i) * &
+                                       ( vad(k,j+1) - vad(k,j) ) * ddy
+!
+!--                Calculate upstream fraction in % (s. flow_statistics)
+                   DO  sr = 0, statistic_regions
+                      sums_up_fraction_l(component,2,sr) = &
+                               sums_up_fraction_l(component,2,sr) + 1.0
+                   ENDDO
+                ELSE
+                   t1 = -ad_v(k,j,i) * dt_3d * ddy
+                   t2 = 3.0 * ( vad(k,j) - vad(k,j+1) ) + &
+                        ( 2.0 * r(k,j) + r(k,j+1) ) * dy
+                   t3 = 2.0 * ( vad(k,j) - vad(k,j+1) ) + &
+                        ( r(k,j) + r(k,j+1) ) * dy
+                   vad_in_out(k,j,i) = vad(k,j) + r(k,j) * t1 * dy - &
+                                       t2 * t1**2 + t3 * t1**3
+                   IF ( vad(k,j+1) == vad(k,j) )  THEN
+                      vad_in_out(k,j,i) = vad(k,j)
+                   ENDIF
+                ENDIF
+
+             ENDIF
+          ENDDO
+       ENDDO
+
+!
+!--    Limit values in order to prevent overshooting
+       IF ( cut_spline_overshoot )  THEN
+
+          DO  j = 0, ny
+             DO  k = nzb+1, nzt
+                IF ( ad_v(k,j,i) > 0.0 ) THEN
+                   IF ( vad(k,j) > vad(k,j-1) )  THEN
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k,j)   + overshoot_limit )
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k,j-1) - overshoot_limit )
+                   ELSE
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k,j)   - overshoot_limit )
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k,j-1) + overshoot_limit )
+                   ENDIF
+                ELSE
+                   IF ( vad(k,j) > vad(k,j+1) )  THEN
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k,j)   + overshoot_limit )
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k,j+1) - overshoot_limit )
+                   ELSE
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k,j)   - overshoot_limit )
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k,j+1) + overshoot_limit )
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+!
+!--    Long filter (acting on tendency only)
+       IF ( long_filter_factor /= 0.0 )  THEN
+
+!
+!--       Compute tendency
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                tf(k,j) = vad_in_out(k,j,i) - vad(k,j)
+             ENDDO
+          ENDDO
+
+!
+!--       Apply the filter
+          wrk_long(:,0,1) = 2.0 * ( 1.0 + long_filter_factor )
+          wrk_long(:,0,2) = ( 1.0 - long_filter_factor ) / wrk_long(:,0,1)
+          wrk_long(:,0,3) = ( long_filter_factor * tf(:,ny) + &
+                                   2.0 * tf(:,0) + tf(:,1) ) / wrk_long(:,0,1)
+
+          DO  j = 1, ny-1
+             DO  k = nzb+1, nzt
+                wrk_long(k,j,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+                                  ( 1.0 - long_filter_factor ) *       &
+                                  wrk_long(k,j-1,2)
+                wrk_long(k,j,2) = ( 1.0 - long_filter_factor ) / wrk_long(k,j,1)
+                wrk_long(k,j,3) = ( tf(k,j-1) + 2.0 * tf(k,j) +                &
+                                    tf(k,j+1) - ( 1.0 - long_filter_factor ) * &
+                                    wrk_long(k,j-1,3) ) / wrk_long(k,j,1)
+             ENDDO
+             wrk_long(:,ny,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+                                      ( 1.0 - long_filter_factor ) * &
+                                        wrk_long(:,ny-1,2)
+             wrk_long(:,ny,2) = ( 1.0 - long_filter_factor ) / wrk_long(:,ny,1)
+             wrk_long(:,ny,3) = ( tf(:,ny-1) + 2.0 * tf(:,ny) +    &
+                                    long_filter_factor * tf(:,0) - &
+                                    ( 1.0 - long_filter_factor ) * &
+                                    wrk_long(:,ny-1,3) ) / wrk_long(:,ny,1)
+             r(:,ny) = wrk_long(:,ny,3)
+          ENDDO
+          DO  j = ny-1, 0, -1
+             DO  k = nzb+1, nzt
+                r(k,j) = wrk_long(k,j,3) - wrk_long(k,j,2) * r(k,j+1)
+             ENDDO
+          ENDDO
+          DO  j = 0, ny
+             DO  k = nzb+1, nzt
+                vad_in_out(k,j,i) = vad(k,j) + r(k,j)
+             ENDDO
+          ENDDO
+
+       ENDIF  ! Long filter
+
+    ENDDO
+#endif
+
+    IF ( long_filter_factor /= 0.0 )  DEALLOCATE( tf, wrk_long )
+    DEALLOCATE( r, vad, wrk_spline )
+
+ END SUBROUTINE spline_y
Index: palm/trunk/SOURCE/spline_z.f90
===================================================================
--- palm/trunk/SOURCE/spline_z.f90	(revision 1)
+++ palm/trunk/SOURCE/spline_z.f90	(revision 1)
@@ -0,0 +1,453 @@
+ SUBROUTINE spline_z( vad_in_out, ad_v, dz_spline, spline_tri, var_char )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: spline_z.f90,v $
+! Revision 1.9  2005/06/29 08:22:56  steinfeld
+! Dependency of ug and vg on height considered in the determination of the
+! upper boundary condition for vad
+!
+! Revision 1.8  2004/04/30 12:55:23  raasch
+! Enlarged transposition arrays introduced
+!
+! Revision 1.7  2003/03/16 09:49:33  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.6  2001/03/30 07:54:07  raasch
+! Arrays r vad, and wrk_spline changed from 3D to 2D and removed from argument
+! list. Several loops over i combined to one loop.
+! Application of long filter moved to this routine. All comments and identifiers
+! translated into English.
+!
+! Revision 1.5  2001/01/22 08:10:21  raasch
+! Module test_variables removed
+!
+! Revision 1.4  1999/03/25 07:34:55  raasch
+! Filterung der Ueberschwinger geschieht optional, ups_limit_e eingefuehrt,
+! Ueberschwinger werden in gewissen Grenzen erlaubt
+!
+! Revision 1.3  1999/02/26 17:55:41  schroeter
+! - Gradientenkontrolle fuer den nicht-parallelen Teil
+! - statistische Auswertung ueber den prozentualen Anteil des
+!   Upstream-Verfahrens an der Gesamtadvektion fuer nicht-
+!   parallelen Teil
+!
+! Revision 1.2  1999/02/17 09:32:55  raasch
+! Wertebegrenzung zur Verhinderung von Ueberschwingern
+!
+! Revision 1.1  1999/02/05 09:17:16  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-spline advection along x
+!
+! Input/output parameters:
+! ad_v       = advecting wind speed component
+! dz_spline  = vertical grid spacing (dzu or dzw, depending on quantity to be
+!              advected)
+! spline_tri = grid spacing factors (spl_tri_zu or spl_tri_zw, depending on
+!              quantity to be advected)
+! vad_in_out = quantity to be advected, excluding ghost- or cyclic boundaries
+!              result is given to the calling routine in this array
+! var_char   = string which defines the quantity to be advected
+!
+! Internal arrays:
+! r          = 2D-working array (right hand side of linear equation, buffer for
+!              Long filter)
+! tf         = tendency field (2D), used for long filter
+! vad        = quantity to be advected (2D), including ghost- or cyclic
+!              boundarys along the direction of advection
+! wrk_long   = working array (long coefficients)
+! wrk_spline = working array (spline coefficients)
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE grid_variables
+    USE indices
+    USE statistics
+    USE control_parameters
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  var_char
+
+    INTEGER ::  component, i, j, k, sr
+    REAL ::     dzwd, dzwu, overshoot_limit, t1, t2, t3, ups_limit
+    REAL ::     dz_spline(1:nzt+1)
+    REAL ::     spline_tri(5,nzb:nzt+1)
+    REAL ::     ad_v(nzb+1:nzta,nys:nyna,nxl:nxra)
+
+    REAL, DIMENSION(:,:), ALLOCATABLE   ::  r, tf, vad, wrk_spline
+    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  wrk_long
+
+#if defined( __parallel )
+    REAL ::     vad_in_out(nzb+1:nzta,nys:nyna,nxl:nxra)
+#else
+    REAL ::     vad_in_out(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+#endif
+
+!
+!-- Set criteria for switching between upstream- and upstream-spline-method
+    IF ( var_char == 'u' )  THEN
+       overshoot_limit = overshoot_limit_u
+       ups_limit       = ups_limit_u
+       component       = 1
+    ELSEIF (  var_char == 'v' )  THEN
+       overshoot_limit = overshoot_limit_v
+       ups_limit       = ups_limit_v
+       component       = 2
+    ELSEIF (  var_char == 'w' )  THEN
+       overshoot_limit = overshoot_limit_w
+       ups_limit       = ups_limit_w
+       component       = 3
+    ELSEIF (  var_char == 'pt' )  THEN
+       overshoot_limit = overshoot_limit_pt
+       ups_limit       = ups_limit_pt
+       component       = 4
+    ELSEIF (  var_char == 'e' )  THEN
+       overshoot_limit = overshoot_limit_e
+       ups_limit       = ups_limit_e
+       component       = 5
+    ENDIF
+
+!
+!-- Allocate working arrays
+    ALLOCATE( r(nzb:nzt+1,nys:nyn), vad(nzb:nzt+1,nys:nyn), &
+              wrk_spline(nzb:nzt+1,nys:nyn) )
+    IF ( long_filter_factor /= 0.0 )  THEN
+       ALLOCATE( tf(nzb:nzt+1,nys:nyn), wrk_long(nzb+1:nzt,nys:nyn,1:3) )
+    ENDIF    
+
+!
+!-- Initialize calculation of relative upstream fraction
+    sums_up_fraction_l(component,3,:) = 0.0
+
+!
+!-- Loop over all gridpoints along x
+    DO  i = nxl, nxr
+
+!
+!--    Store array to be advected on work array
+       vad(nzb+1:nzt,:) = vad_in_out(nzb+1:nzt,nys:nyn,i)
+!
+!--    Add boundary conditions along z
+       IF ( var_char == 'u'  .OR.  var_char == 'v' )  THEN
+!
+!--       Bottom boundary
+!--       u- and v-component
+          IF ( ibc_uv_b == 0 )  THEN
+             vad(nzb,:) = -vad(nzb+1,:)
+          ELSE
+             vad(nzb,:) = vad(nzb+1,:)
+          ENDIF
+!
+!--       Top boundary
+!--       Dirichlet condition
+          IF ( ibc_uv_t == 0  .AND.  var_char == 'u' )  THEN
+!
+!--          u-component
+             vad(nzt+1,:) = ug(nzt+1)
+          ELSEIF ( ibc_uv_t == 0  .AND.  var_char == 'v' )  THEN
+!
+!--          v-component
+             vad(nzt+1,:) = vg(nzt+1)
+          ELSE
+!
+!--          Neumann condition
+             vad(nzt+1,:) = vad(nzt,:)
+          ENDIF
+
+       ELSEIF ( var_char == 'w' )  THEN
+!
+!--       Bottom and top boundary for w-component
+          vad(nzb,:)   = 0.0
+          vad(nzt+1,:) = 0.0
+
+       ELSEIF ( var_char == 'pt' )  THEN
+!
+!--       Bottom boundary for temperature
+          IF ( ibc_pt_b == 1 )  THEN
+             vad(nzb,:) = vad(nzb+1,:)
+          ELSE
+             vad(nzb,:) = pt(nzb,:,i)
+          ENDIF
+!
+!--       Top boundary for temperature
+          IF ( ibc_pt_t == 1 )  THEN
+             vad(nzt,:)   = vad(nzt-1,:) + bc_pt_t_val * dz_spline(nzt)
+             vad(nzt+1,:) = vad(nzt,:)   + bc_pt_t_val * dz_spline(nzt+1)
+          ELSE
+             vad(nzt,:)   = pt(nzt,nys:nyn,i)
+             vad(nzt+1,:) = pt(nzt+1,nys:nyn,i)
+          ENDIF
+
+       ELSEIF ( var_char == 'e' )  THEN
+!
+!--       Boundary conditions for TKE (Neumann in any case)
+          vad(nzb,:)   = vad(nzb+1,:)
+          vad(nzt,:)   = vad(nzt-1,:)
+          vad(nzt+1,:) = vad(nzt,:)
+
+       ENDIF
+
+!
+!--    Calculate right hand side
+       DO  j = nys, nyn
+          r(nzb,j)   = 3.0 * ( vad(nzb+1,j)-vad(nzb,j) ) / dz_spline(1)
+          r(nzt+1,j) = 3.0 * ( vad(nzt+1,j)-vad(nzt,j) ) / dz_spline(nzt+1)
+          DO  k = nzb+1, nzt
+             r(k,j) = 3.0 * (                                                   &
+                     spline_tri(2,k) * ( vad(k,j)-vad(k-1,j) ) / dz_spline(k)   &
+                   + spline_tri(3,k) * ( vad(k+1,j)-vad(k,j) ) / dz_spline(k+1) &
+                            )
+          ENDDO
+       ENDDO
+    
+!
+!--    Forward substitution
+       DO  j = nys, nyn
+          wrk_spline(nzb,j) = r(nzb,j)
+          DO  k = nzb+1, nzt+1
+             wrk_spline(k,j) = r(k,j) - spline_tri(5,k) * r(k-1,j)
+          ENDDO
+       ENDDO
+
+!
+!--    Backward substitution
+       DO  j = nys, nyn
+          r(nzt+1,j) = wrk_spline(nzt+1,j) / spline_tri(4,nzt+1)
+          DO  k = nzt, nzb, -1
+             r(k,j) = ( wrk_spline(k,j) - spline_tri(3,k) * r(k+1,j) ) / &
+                      spline_tri(4,k)
+          ENDDO
+       ENDDO
+    
+!
+!--    Calculate advection along z
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+
+             IF ( ad_v(k,j,i) == 0.0 ) THEN
+
+                vad_in_out(k,j,i) = vad(k,j)
+
+             ELSEIF ( ad_v(k,j,i) > 0.0 ) THEN
+
+                IF ( ABS( vad(k,j) - vad(k-1,j) ) <= ups_limit )  THEN
+                   vad_in_out(k,j,i) = vad(k,j) - dt_3d * ad_v(k,j,i) * &
+                                       ( vad(k,j) - vad(k-1,j) ) * ddzu(k)
+!
+!--                Calculate upstream fraction in % (s. flow_statistics)
+                   DO  sr = 0, statistic_regions
+                      sums_up_fraction_l(component,3,sr) = &
+                               sums_up_fraction_l(component,3,sr) + 1.0
+                   ENDDO
+                ELSE
+                   t1 = ad_v(k,j,i) * dt_3d / dz_spline(k)
+                   t2 = 3.0 * ( vad(k-1,j) - vad(k,j) ) + &
+                        ( 2.0 * r(k,j) + r(k-1,j) ) * dz_spline(k)
+                   t3 = 2.0 * ( vad(k-1,j) - vad(k,j) ) + &
+                        ( r(k,j) + r(k-1,j) ) * dz_spline(k)
+                   vad_in_out(k,j,i) = vad(k,j) - r(k,j) * t1* dz_spline(k) + &
+                                       t2 * t1**2 - t3 * t1**3
+                   IF ( vad(k-1,j) == vad(k,j) )  THEN
+                      vad_in_out(k,j,i) = vad(k,j)
+                   ENDIF
+                ENDIF
+
+             ELSE
+
+                IF( ABS( vad(k,j) - vad(k+1,j) ) <= ups_limit )  THEN
+                   vad_in_out(k,j,i) = vad(k,j) - dt_3d * ad_v(k,j,i) * &
+                                       ( vad(k+1,j) - vad(k,j) ) * ddzu(k+1)
+!
+!--                Calculate upstream fraction in % (s. flow_statistics)
+                   DO  sr = 0, statistic_regions
+                      sums_up_fraction_l(component,3,sr) = &
+                               sums_up_fraction_l(component,3,sr) + 1.0
+                   ENDDO
+                ELSE
+                   t1 = -ad_v(k,j,i) * dt_3d / dz_spline(k+1)
+                   t2 = 3.0 * ( vad(k,j) - vad(k+1,j) ) + &
+                        ( 2.0 * r(k,j) + r(k+1,j) ) * dz_spline(k+1)
+                   t3 = 2.0 * ( vad(k,j) - vad(k+1,j) ) + &
+                        ( r(k,j) + r(k+1,j) ) * dz_spline(k+1)
+                   vad_in_out(k,j,i) = vad(k,j) + r(k,j)*t1*dz_spline(k+1) - &
+                                       t2 * t1**2 + t3 * t1**3
+                   IF ( vad(k+1,j) == vad(k,j) )  THEN
+                      vad_in_out(k,j,i) = vad(k,j)
+                   ENDIF
+                ENDIF
+
+             ENDIF
+          ENDDO
+       ENDDO
+
+!
+!--    Limit values in order to prevent overshooting
+       IF ( cut_spline_overshoot )  THEN
+
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                IF ( ad_v(k,j,i) > 0.0 ) THEN
+                   IF ( vad(k,j) > vad(k-1,j) )  THEN
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k,j)   + overshoot_limit )
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k-1,j) - overshoot_limit )
+                   ELSE
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k,j)   - overshoot_limit )
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k-1,j) + overshoot_limit )
+                   ENDIF
+                ELSE
+                   IF ( vad(k,j) > vad(k+1,j) )  THEN
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k,j)   + overshoot_limit )
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k+1,j) - overshoot_limit )
+                   ELSE
+                      vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+                                               vad(k,j)   - overshoot_limit )
+                      vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+                                               vad(k+1,j) + overshoot_limit )
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+!
+!--    Long-filter (acting on tendency only)
+       IF ( long_filter_factor /= 0.0 )  THEN
+
+!
+!--       Compute tendency
+          DO  j = nys, nyn
+
+!
+!--          Depending on the quantity to be advected, the respective vertical 
+!--          boundary conditions must be applied.
+             IF ( var_char == 'u'  .OR.  var_char == 'v' ) THEN
+
+                IF ( ibc_uv_b == 0 )  THEN
+                   tf(nzb,j) = - ( vad_in_out(nzb+1,j,i) - vad(nzb+1,j) )
+                ELSE
+                   tf(nzb,j) = vad_in_out(nzb+1,j,i) - vad(nzb+1,j)
+                ENDIF
+
+                IF ( ibc_uv_t == 0 )  THEN
+                   tf(nzt+1,j) = 0.0
+                ELSE
+                   tf(nzt+1,j) = vad_in_out(nzt,j,i) - vad(nzt,j)
+                ENDIF
+
+             ELSEIF ( var_char == 'w' )  THEN
+
+                tf(nzb,j)   = 0.0
+                tf(nzt+1,j) = 0.0
+
+             ELSEIF ( var_char == 'pt' )  THEN
+
+                IF ( ibc_pt_b == 1 )  THEN
+                   tf(nzb,j) = vad_in_out(nzb+1,j,i) - vad(nzb+1,j)
+                ELSE
+                   tf(nzb,j) = 0.0
+                ENDIF
+
+                IF ( ibc_pt_t == 1 )  THEN
+                   vad_in_out(nzt,j,i) = vad_in_out(nzt-1,j,i) + bc_pt_t_val * &
+                                         dz_spline(nzt)
+                   tf(nzt+1,j) = vad_in_out(nzt,j,i) + bc_pt_t_val * &
+                                         dz_spline(nzt+1) - vad(nzt+1,j)
+                ELSE
+                   vad_in_out(nzt,j,i) = pt(nzt,j,i)
+                   tf(nzt+1,j) = 0.0
+                ENDIF
+
+             ENDIF
+
+             DO  k = nzb+1, nzt
+                tf(k,j) = vad_in_out(k,j,i) - vad(k,j)
+             ENDDO
+
+          ENDDO
+
+!
+!--       Apply the filter.
+          DO  j = nys, nyn
+
+             dzwd = dz_spline(1) / ( dz_spline(1) + dz_spline(2) )
+             dzwu = dz_spline(2) / ( dz_spline(1) + dz_spline(2) )
+
+             wrk_long(nzb+1,j,1) = 2.0 * ( 1.0 + long_filter_factor )
+             wrk_long(nzb+1,j,2) = ( 1.0 - long_filter_factor ) * dzwd / &
+                                     wrk_long(nzb+1,j,1)
+             wrk_long(nzb+1,j,3) = ( long_filter_factor * dzwu * tf(nzb,j) +  &
+                                     2.0 * tf(nzb+1,j) + dzwd * tf(nzb+2,j) &
+                                   ) / wrk_long(nzb+1,j,1)
+
+             DO  k = nzb+2, nzt-1
+
+                dzwd = dz_spline(k)   / ( dz_spline(k) + dz_spline(k+1) )
+                dzwu = dz_spline(k+1) / ( dz_spline(k) + dz_spline(k+1) )
+
+                wrk_long(k,j,1) = 2.0 * ( 1.0 + long_filter_factor ) -  &
+                                  ( 1.0 - long_filter_factor ) * dzwu * &
+                                  wrk_long(k-1,j,2)
+                wrk_long(k,j,2) = ( 1.0 - long_filter_factor ) * dzwd / &
+                                  wrk_long(k,j,1) 
+                wrk_long(k,j,3) = ( dzwu * tf(k-1,j) + 2.0 * tf(k,j) +   &
+                                    dzwd * tf(k+1,j) -                   &
+                                   ( 1.0 - long_filter_factor ) * dzwu * &
+                                  wrk_long(k-1,j,3)                      &
+                                  ) / wrk_long(k,j,1)
+             ENDDO
+
+             dzwd = dz_spline(nzt)   / ( dz_spline(nzt) + dz_spline(nzt+1) )
+             dzwu = dz_spline(nzt+1) / ( dz_spline(nzt) + dz_spline(nzt+1) )
+
+             wrk_long(nzt,j,1) = 2.0 * ( 1.0 + long_filter_factor ) -  &
+                                 ( 1.0 - long_filter_factor ) * dzwu * &
+                                 wrk_long(nzt-1,j,2)
+             wrk_long(nzt,j,2) = ( 1.0 - long_filter_factor ) * dzwd / &
+                                 wrk_long(nzt,j,1)
+             wrk_long(nzt,j,3) = ( dzwu * tf(nzt-1,j) + 2.0 * tf(nzt,j) +    & 
+                                   dzwd * long_filter_factor * tf(nzt+1,j) - &
+                                   ( 1.0 - long_filter_factor ) * dzwu *     &
+                                   wrk_long(nzt-1,j,3)                       &
+                                 ) / wrk_long(nzt,j,1)
+             r(nzt,j)     = wrk_long(nzt,j,3)
+
+          ENDDO
+
+          DO  j = nys, nyn
+             DO  k = nzt-1, nzb+1, -1
+                r(k,j) = wrk_long(k,j,3) - wrk_long(k,j,2) * r(k+1,j)
+             ENDDO
+          ENDDO
+
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                vad_in_out(k,j,i) = vad(k,j) + r(k,j)
+             ENDDO
+          ENDDO
+
+       ENDIF  ! Long filter
+
+    ENDDO
+
+    DEALLOCATE( r, vad, wrk_spline )
+    IF ( long_filter_factor /= 0.0 )  DEALLOCATE( tf, wrk_long )    
+
+ END SUBROUTINE spline_z
Index: palm/trunk/SOURCE/subsidence_mod.f90
===================================================================
--- palm/trunk/SOURCE/subsidence_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,388 +1,0 @@
-!> @file subsidence_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Add subroutine and variable description
-!
-! Revision 3.7 2009-12-11 14:15:58Z heinze
-! Initial revision
-!
-! Description:
-! ------------
-!> Impact of large-scale subsidence or ascent as tendency term for use in the prognostic equation of
-!> potential temperature. This enables the construction of a constant boundary layer height z_i with
-!> time.
-!--------------------------------------------------------------------------------------------------!
- MODULE subsidence_mod
-
-
-    IMPLICIT NONE
-
-    PRIVATE
-    PUBLIC  init_w_subsidence, subsidence
-
-    INTERFACE init_w_subsidence
-       MODULE PROCEDURE init_w_subsidence
-    END INTERFACE init_w_subsidence
-
-    INTERFACE subsidence
-       MODULE PROCEDURE subsidence
-       MODULE PROCEDURE subsidence_ij
-    END INTERFACE subsidence
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize vertical subsidence velocity w_subs.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE init_w_subsidence
-
-       USE arrays_3d,                                                                              &
-           ONLY:  dzu,                                                                             &
-                  w_subs,                                                                          &
-                  zu
-
-       USE control_parameters,                                                                     &
-           ONLY:  message_string,                                                                  &
-                  ocean_mode,                                                                      &
-                  subs_vertical_gradient,                                                          &
-                  subs_vertical_gradient_level,                                                    &
-                  subs_vertical_gradient_level_i
-
-       USE indices,                                                                                &
-           ONLY:  nzb,                                                                             &
-                  nzt
-
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i  !< loop index
-       INTEGER(iwp) ::  k  !< loop index
-
-       REAL(wp) ::  gradient    !< vertical gradient of subsidence velocity
-       REAL(wp) ::  ws_surface  !< subsidence velocity at the surface
-
-       IF ( .NOT. ALLOCATED( w_subs ) )  THEN
-          ALLOCATE( w_subs(nzb:nzt+1) )
-          w_subs = 0.0_wp
-       ENDIF
-
-       IF ( ocean_mode )  THEN
-          message_string = 'applying large scale vertical motion is not allowed for ocean mode'
-          CALL message( 'init_w_subsidence', 'PA0324', 2, 2, 0, 6, 0 )
-       ENDIF
-
-!
-!--   Compute the profile of the subsidence/ascent velocity using the given gradients
-      i = 1
-      gradient = 0.0_wp
-      ws_surface = 0.0_wp
-
-
-      subs_vertical_gradient_level_i(1) = 0
-      DO  k = 1, nzt+1
-         IF ( i < 11 )  THEN
-            IF ( subs_vertical_gradient_level(i) < zu(k)  .AND.                                    &
-                 subs_vertical_gradient_level(i) >= 0.0_wp )  THEN
-               gradient = subs_vertical_gradient(i) / 100.0_wp
-               subs_vertical_gradient_level_i(i) = k - 1
-               i = i + 1
-            ENDIF
-         ENDIF
-         IF ( gradient /= 0.0_wp )  THEN
-            IF ( k /= 1 )  THEN
-               w_subs(k) = w_subs(k-1) + dzu(k) * gradient
-            ELSE
-               w_subs(k) = ws_surface   + 0.5_wp * dzu(k) * gradient
-            ENDIF
-         ELSE
-            w_subs(k) = w_subs(k-1)
-         ENDIF
-      ENDDO
-
-!
-!--   In case of no given gradients for the subsidence/ascent velocity, choose zero gradient
-      IF ( subs_vertical_gradient_level(1) == -9999999.9_wp )  THEN
-         subs_vertical_gradient_level(1) = 0.0_wp
-      ENDIF
-
-    END SUBROUTINE init_w_subsidence
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Add effect of large-scale subsidence to variable.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE subsidence( tendency, var, var_init, ls_index )
-
-       USE arrays_3d,                                                                              &
-           ONLY:  ddzu,                                                                            &
-                  w_subs
-
-       USE control_parameters,                                                                     &
-           ONLY:  dt_3d,                                                                           &
-                  intermediate_timestep_count,                                                     &
-                  large_scale_forcing,                                                             &
-                  scalar_rayleigh_damping
-
-       USE indices,                                                                                &
-           ONLY:  nxl,                                                                             &
-                  nxlg,                                                                            &
-                  nxr,                                                                             &
-                  nxrg,                                                                            &
-                  nyn,                                                                             &
-                  nyng,                                                                            &
-                  nys,                                                                             &
-                  nysg,                                                                            &
-                  nzb,                                                                             &
-                  nzt,                                                                             &
-                  wall_flags_total_0
-
-       USE kinds
-
-       USE statistics,                                                                             &
-           ONLY:  sums_ls_l,                                                                       &
-                  weight_substep
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i         !< loop index
-       INTEGER(iwp) ::  j         !< loop index
-       INTEGER(iwp) ::  k         !< loop index
-       INTEGER(iwp) ::  ls_index  !< index of large-scale subsidence in sums_ls_l
-
-       REAL(wp) ::  tmp_tend  !< temporary tendency
-       REAL(wp) ::  tmp_grad  !< temporary gradient
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var       !< variable where to add subsidence
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency  !< tendency of var
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                      !< initialization profile of var
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                       !< modified profile of var
-
-       var_mod = var_init
-
-!
-!--    Influence of w_subsidence on the current tendency term
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-
-             DO  k = nzb+1, nzt
-                IF ( w_subs(k) < 0.0_wp )  THEN    ! large-scale subsidence
-                   tmp_tend = - w_subs(k) * ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1) *            &
-                              MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                ELSE   ! large-scale ascent
-                   tmp_tend = - w_subs(k) * ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k) *              &
-                              MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                ENDIF
-
-                tendency(k,j,i) = tendency(k,j,i) + tmp_tend
-
-                IF ( large_scale_forcing )  THEN
-                   sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend                        &
-                                           * weight_substep(intermediate_timestep_count)           &
-                                           * MERGE( 1.0_wp, 0.0_wp,                                &
-                                                    BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                ENDIF
-             ENDDO
-
-             IF ( large_scale_forcing )  THEN
-                sums_ls_l(nzt+1,ls_index) = sums_ls_l(nzt,ls_index)
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-!
-!--    Shifting of the initial profile is especially necessary with Rayleigh damping switched on
-       IF ( scalar_rayleigh_damping  .AND.  intermediate_timestep_count == 1 )  THEN
-          DO  k = nzb, nzt
-             IF ( w_subs(k) < 0.0_wp )  THEN      ! large-scale subsidence
-                var_mod(k) = var_init(k) - dt_3d * w_subs(k) *                                     &
-                             ( var_init(k+1) - var_init(k) ) * ddzu(k+1)
-             ENDIF
-          ENDDO
-!
-!--      At the upper boundary, the initial profile is shifted with aid of the gradient tmp_grad.
-!--      (This is ok if the gradients are linear.)
-         IF ( w_subs(nzt) < 0.0_wp )  THEN
-            tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
-            var_mod(nzt+1) = var_init(nzt+1) - dt_3d * w_subs(nzt+1) * tmp_grad
-         ENDIF
-
-
-         DO  k = nzt+1, nzb+1, -1
-            IF ( w_subs(k) >= 0.0_wp )  THEN  ! large-scale ascent
-               var_mod(k) = var_init(k) - dt_3d * w_subs(k) *                                      &
-                            ( var_init(k) - var_init(k-1) ) * ddzu(k)
-            ENDIF
-         ENDDO
-!
-!--      At the lower boundary shifting is not necessary because the subsidence velocity w_subs(nzb)
-!--      vanishes.
-         IF ( w_subs(nzb+1) >= 0.0_wp )  THEN
-            var_mod(nzb) = var_init(nzb)
-         ENDIF
-
-         var_init = var_mod
-      ENDIF
-
-
- END SUBROUTINE subsidence
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Add effect of large-scale subsidence to variable.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE subsidence_ij( i, j, tendency, var, var_init, ls_index )
-
-       USE arrays_3d,                                                                              &
-           ONLY:  ddzu,                                                                            &
-                  w_subs
-
-       USE control_parameters,                                                                     &
-           ONLY:  dt_3d,                                                                           &
-                  intermediate_timestep_count,                                                     &
-                  large_scale_forcing,                                                             &
-                  scalar_rayleigh_damping
-
-       USE indices,                                                                                &
-           ONLY:  nxl,                                                                             &
-                  nxlg,                                                                            &
-                  nxrg,                                                                            &
-                  nyng,                                                                            &
-                  nys,                                                                             &
-                  nysg,                                                                            &
-                  nzb,                                                                             &
-                  nzt,                                                                             &
-                  wall_flags_total_0
-
-       USE kinds
-
-       USE statistics,                                                                             &
-           ONLY:  sums_ls_l,                                                                       &
-                  weight_substep
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i         !< loop variable
-       INTEGER(iwp) ::  j         !< loop variable
-       INTEGER(iwp) ::  k         !< loop variable
-       INTEGER(iwp) ::  ls_index  !< index of large-scale subsidence in sums_ls_l
-
-       REAL(wp) ::  tmp_tend  !< temporary tendency
-       REAL(wp) ::  tmp_grad  !< temporary gradient
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var       !< variable where to add subsidence
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency  !< tendency of var
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                      !< initialization profile of var
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                       !< modified profile of var
-
-       var_mod = var_init
-
-!
-!--    Influence of w_subsidence on the current tendency term
-       DO  k = nzb+1, nzt
-          IF ( w_subs(k) < 0.0_wp )  THEN      ! large-scale subsidence
-             tmp_tend = - w_subs(k) * ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1)                    &
-                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-          ELSE                                 ! large-scale ascent
-             tmp_tend = - w_subs(k) * ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k)                      &
-                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-          ENDIF
-
-          tendency(k,j,i) = tendency(k,j,i) + tmp_tend
-
-          IF ( large_scale_forcing )  THEN
-             sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend                              &
-                                     * weight_substep(intermediate_timestep_count)                 &
-                                     * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-          ENDIF
-       ENDDO
-
-       IF ( large_scale_forcing )  THEN
-          sums_ls_l(nzt+1,ls_index) = sums_ls_l(nzt,ls_index)
-       ENDIF
-
-!
-!--    Shifting of the initial profile is especially necessary with Rayleigh damping switched on
-       IF ( scalar_rayleigh_damping  .AND.  intermediate_timestep_count == 1 )  THEN
-          IF ( i == nxl .AND. j == nys )  THEN ! shifting only once per PE
-
-             DO  k = nzb, nzt
-                IF ( w_subs(k) < 0.0_wp )  THEN      ! large-scale subsidence
-                   var_mod(k) = var_init(k) - dt_3d * w_subs(k) *                                  &
-                               ( var_init(k+1) - var_init(k) ) * ddzu(k+1)
-                ENDIF
-             ENDDO
-!
-!--          At the upper boundary, the initial profile is shifted with aid of the gradient
-!--          tmp_grad. (This is ok if the gradients are linear.)
-             IF ( w_subs(nzt) < 0.0_wp )  THEN
-                tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
-                var_mod(nzt+1) = var_init(nzt+1) - dt_3d * w_subs(nzt+1) * tmp_grad
-             ENDIF
-
-
-             DO  k = nzt+1, nzb+1, -1
-                IF ( w_subs(k) >= 0.0_wp )  THEN  ! large-scale ascent
-                   var_mod(k) = var_init(k) - dt_3d * w_subs(k) *                                  &
-                                ( var_init(k) - var_init(k-1) ) * ddzu(k)
-                ENDIF
-             ENDDO
-!
-!--          At the lower boundary shifting is not necessary because the subsidence velocity
-!--          w_subs(nzb) vanishes.
-             IF ( w_subs(nzb+1) >= 0.0_wp )  THEN
-                var_mod(nzb) = var_init(nzb)
-             ENDIF
-
-             var_init = var_mod
-
-          ENDIF
-       ENDIF
-
- END SUBROUTINE subsidence_ij
-
-
- END MODULE subsidence_mod
Index: palm/trunk/SOURCE/sum_up_3d_data.f90
===================================================================
--- palm/trunk/SOURCE/sum_up_3d_data.f90	(revision 4901)
+++ palm/trunk/SOURCE/sum_up_3d_data.f90	(revision 1)
@@ -1,72 +1,12 @@
-!> @file sum_up_3d_data.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ SUBROUTINE sum_up_3d_data
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4591 2020-07-06 15:56:08Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4516 2020-04-30 16:55:10Z suehring
-! Remove double index
-!
-! 4514 2020-04-30 16:29:59Z suehring
-! Enable output of qsurf and ssurf
-!
-! 4442 2020-03-04 19:21:13Z suehring
-! Change order of dimension in surface array %frac to allow for better vectorization.
-!
-! 4441 2020-03-04 19:20:35Z suehring
-! Move 2-m potential temperature output to diagnostic_output_quantities
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4048 2019-06-21 21:00:21Z knoop
-! Moved tcm_3d_data_averaging to module_interface
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! Modularize diagnostic output
-!
-! 3994 2019-05-22 18:08:09Z suehring
-! Output of turbulence intensity added
-!
-! 3943 2019-05-02 09:50:41Z maronga
-! Added output of qsws_av for green roofs.
-!
-! 3933 2019-04-25 12:33:20Z kanani
-! Formatting
-!
-! 3773 2019-03-01 08:56:57Z maronga
-! Added output of theta_2m*_xy_av
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! unused variables removed
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Implementation of the PALM module interface
-!
+! $Log: sum_up_3d_data.f90,v $
 ! Revision 1.1  2006/02/23 12:55:23  raasch
 ! Initial revision
@@ -75,136 +15,22 @@
 ! Description:
 ! ------------
-!> Sum-up the values of 3d-arrays. The real averaging is later done in routine average_3d_data.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE sum_up_3d_data
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzw,                                                                                &
-               d_exner,                                                                            &
-               e,                                                                                  &
-               heatflux_output_conversion,                                                         &
-               p,                                                                                  &
-               pt,                                                                                 &
-               q,                                                                                  &
-               ql,                                                                                 &
-               ql_c,                                                                               &
-               ql_v,                                                                               &
-               s,                                                                                  &
-               u,                                                                                  &
-               v,                                                                                  &
-               vpt,                                                                                &
-               w,                                                                                  &
-               waterflux_output_conversion
-
-    USE averaging,                                                                                 &
-        ONLY:  e_av,                                                                               &
-               ghf_av,                                                                             &
-               lpt_av,                                                                             &
-               lwp_av,                                                                             &
-               ol_av,                                                                              &
-               p_av,                                                                               &
-               pc_av,                                                                              &
-               pr_av,                                                                              &
-               pt_av,                                                                              &
-               q_av,                                                                               &
-               ql_av,                                                                              &
-               ql_c_av,                                                                            &
-               ql_v_av,                                                                            &
-               ql_vp_av,                                                                           &
-               qsurf_av,                                                                           &
-               qsws_av,                                                                            &
-               qv_av,                                                                              &
-               r_a_av,                                                                             &
-               s_av,                                                                               &
-               shf_av,                                                                             &
-               ssurf_av,                                                                           &
-               ssws_av,                                                                            &
-               ts_av,                                                                              &
-               tsurf_av,                                                                           &
-               u_av,                                                                               &
-               us_av,                                                                              &
-               v_av,                                                                               &
-               vpt_av,                                                                             &
-               w_av,                                                                               &
-               z0_av,                                                                              &
-               z0h_av,                                                                             &
-               z0q_av
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  c_p,                                                                                &
-               lv_d_cp,                                                                            &
-               l_v
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    USE control_parameters,                                                                        &
-        ONLY:  average_count_3d,                                                                   &
-               doav,                                                                               &
-               doav_n,                                                                             &
-               rho_surface,                                                                        &
-               urban_surface,                                                                      &
-               varnamelength
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point
-
-    USE indices,                                                                                   &
-        ONLY:  nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               topo_top_ind
-
-    USE kinds
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_3d_data_averaging
-
-    USE particle_attributes,                                                                       &
-        ONLY:  grid_particles,                                                                     &
-               number_of_particles,                                                                &
-               particles,                                                                          &
-               prt_count
-
-    USE surface_mod,                                                                               &
-        ONLY:  ind_pav_green,                                                                      &
-               ind_veg_wall,                                                                       &
-               ind_wat_win,                                                                        &
-               surf_def_h,                                                                         &
-               surf_lsm_h,                                                                         &
-               surf_usm_h
-
-    USE urban_surface_mod,                                                                         &
-        ONLY:  usm_3d_data_averaging
-
+! Sum-up the values of 3d-arrays. The real averaging is later done in routine
+! average_3d_data. 
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE averaging
+    USE cloud_parameters
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE particle_attributes
 
     IMPLICIT NONE
 
-    CHARACTER(LEN=varnamelength) ::  trimvar  !< TRIM of output-variable string
-
-    INTEGER(iwp) ::  i   !< grid index x direction
-    INTEGER(iwp) ::  ii  !< running index
-    INTEGER(iwp) ::  j   !< grid index y direction
-    INTEGER(iwp) ::  k   !< grid index x direction
-    INTEGER(iwp) ::  m   !< running index over surfacle elements
-    INTEGER(iwp) ::  n   !< running index over number of particles per grid box
-
-    LOGICAL ::  match_def  !< flag indicating default-type surface
-    LOGICAL ::  match_lsm  !< flag indicating natural-type surface
-    LOGICAL ::  match_usm  !< flag indicating urban-type surface
-
-    REAL(wp) ::  mean_r  !< mean-particle radius witin grid box
-    REAL(wp) ::  s_r2    !< mean-particle radius witin grid box to the power of two
-    REAL(wp) ::  s_r3    !< mean-particle radius witin grid box to the power of three
-
+    INTEGER ::  i, ii, j, k, n, psi
+
+    REAL    ::  mean_r, s_r3, s_r4
 
 
@@ -212,214 +38,132 @@
 
 !
-!-- Allocate and initialize the summation arrays if called for the very first time or the first time
-!-- after average_3d_data has been called (some or all of the arrays may have been already allocated
-!-- in rrd_local)
+!-- Allocate and initialize the summation arrays if called for the very first
+!-- time or the first time after average_3d_data has been called 
+!-- (some or all of the arrays may have been already allocated
+!-- in read_3d_binary)
     IF ( average_count_3d == 0 )  THEN
 
        DO  ii = 1, doav_n
 
-          trimvar = TRIM( doav(ii) )
-
-          SELECT CASE ( trimvar )
-
-             CASE ( 'ghf*' )
-                IF ( .NOT. ALLOCATED( ghf_av ) )  THEN
-                   ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ghf_av = 0.0_wp
+          SELECT CASE ( TRIM( doav(ii) ) )
 
              CASE ( 'e' )
                 IF ( .NOT. ALLOCATED( e_av ) )  THEN
-                   ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                e_av = 0.0_wp
-
-             CASE ( 'thetal' )
-                IF ( .NOT. ALLOCATED( lpt_av ) )  THEN
-                   ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                lpt_av = 0.0_wp
+                   ALLOCATE( e_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                e_av = 0.0
 
              CASE ( 'lwp*' )
                 IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
-                   ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                lwp_av = 0.0_wp
-
-             CASE ( 'ol*' )
-                IF ( .NOT. ALLOCATED( ol_av ) )  THEN
-                   ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ol_av = 0.0_wp
+                   ALLOCATE( lwp_av(nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                lwp_av = 0.0
 
              CASE ( 'p' )
                 IF ( .NOT. ALLOCATED( p_av ) )  THEN
-                   ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                p_av = 0.0_wp
+                   ALLOCATE( p_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                p_av = 0.0
 
              CASE ( 'pc' )
                 IF ( .NOT. ALLOCATED( pc_av ) )  THEN
-                   ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                pc_av = 0.0_wp
+                   ALLOCATE( pc_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                pc_av = 0.0
 
              CASE ( 'pr' )
                 IF ( .NOT. ALLOCATED( pr_av ) )  THEN
-                   ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                pr_av = 0.0_wp
-
-             CASE ( 'theta' )
+                   ALLOCATE( pr_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                pr_av = 0.0
+
+             CASE ( 'pt' )
                 IF ( .NOT. ALLOCATED( pt_av ) )  THEN
-                   ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                pt_av = 0.0_wp
+                   ALLOCATE( pt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                pt_av = 0.0
 
              CASE ( 'q' )
                 IF ( .NOT. ALLOCATED( q_av ) )  THEN
-                   ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                q_av = 0.0_wp
+                   ALLOCATE( q_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                q_av = 0.0
 
              CASE ( 'ql' )
                 IF ( .NOT. ALLOCATED( ql_av ) )  THEN
-                   ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ql_av = 0.0_wp
+                   ALLOCATE( ql_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                ql_av = 0.0
 
              CASE ( 'ql_c' )
                 IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
-                   ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ql_c_av = 0.0_wp
+                   ALLOCATE( ql_c_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                ql_c_av = 0.0
 
              CASE ( 'ql_v' )
                 IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
-                   ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ql_v_av = 0.0_wp
+                   ALLOCATE( ql_v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                ql_v_av = 0.0
 
              CASE ( 'ql_vp' )
                 IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
-                   ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ql_vp_av = 0.0_wp
-
-             CASE ( 'qsurf*' )
-                IF ( .NOT. ALLOCATED( qsurf_av ) )  THEN
-                   ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qsurf_av = 0.0_wp
-
-             CASE ( 'qsws*' )
-                IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
-                   ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qsws_av = 0.0_wp
+                   ALLOCATE( ql_vp_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                ql_vp_av = 0.0
 
              CASE ( 'qv' )
                 IF ( .NOT. ALLOCATED( qv_av ) )  THEN
-                   ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                qv_av = 0.0_wp
-
-             CASE ( 'r_a*' )
-                IF ( .NOT. ALLOCATED( r_a_av ) )  THEN
-                   ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                r_a_av = 0.0_wp
+                   ALLOCATE( qv_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                qv_av = 0.0
 
              CASE ( 's' )
                 IF ( .NOT. ALLOCATED( s_av ) )  THEN
-                   ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                s_av = 0.0_wp
-
-             CASE ( 'shf*' )
-                IF ( .NOT. ALLOCATED( shf_av ) )  THEN
-                   ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                shf_av = 0.0_wp
-
-             CASE ( 'ssurf*' )
-                IF ( .NOT. ALLOCATED( ssurf_av ) )  THEN
-                   ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ssurf_av = 0.0_wp
-
-             CASE ( 'ssws*' )
-                IF ( .NOT. ALLOCATED( ssws_av ) )  THEN
-                   ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ssws_av = 0.0_wp
+                   ALLOCATE( s_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                s_av = 0.0
 
              CASE ( 't*' )
                 IF ( .NOT. ALLOCATED( ts_av ) )  THEN
-                   ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                ts_av = 0.0_wp
-
-             CASE ( 'tsurf*' )
-                IF ( .NOT. ALLOCATED( tsurf_av ) )  THEN
-                   ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                tsurf_av = 0.0_wp
+                   ALLOCATE( ts_av(nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                ts_av = 0.0
 
              CASE ( 'u' )
                 IF ( .NOT. ALLOCATED( u_av ) )  THEN
-                   ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                u_av = 0.0_wp
-
-             CASE ( 'us*' )
+                   ALLOCATE( u_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                u_av = 0.0
+
+             CASE ( 'u*' )
                 IF ( .NOT. ALLOCATED( us_av ) )  THEN
-                   ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                us_av = 0.0_wp
+                   ALLOCATE( us_av(nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                us_av = 0.0
 
              CASE ( 'v' )
                 IF ( .NOT. ALLOCATED( v_av ) )  THEN
-                   ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                v_av = 0.0_wp
-
-             CASE ( 'thetav' )
+                   ALLOCATE( v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                v_av = 0.0
+
+             CASE ( 'vpt' )
                 IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
-                   ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                vpt_av = 0.0_wp
+                   ALLOCATE( vpt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                vpt_av = 0.0
 
              CASE ( 'w' )
                 IF ( .NOT. ALLOCATED( w_av ) )  THEN
-                   ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                w_av = 0.0_wp
-
-             CASE ( 'z0*' )
-                IF ( .NOT. ALLOCATED( z0_av ) )  THEN
-                   ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                z0_av = 0.0_wp
-
-             CASE ( 'z0h*' )
-                IF ( .NOT. ALLOCATED( z0h_av ) )  THEN
-                   ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                z0h_av = 0.0_wp
-
-             CASE ( 'z0q*' )
-                IF ( .NOT. ALLOCATED( z0q_av ) )  THEN
-                   ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
-                ENDIF
-                z0q_av = 0.0_wp
-
+                   ALLOCATE( w_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+                ENDIF
+                w_av = 0.0
 
              CASE DEFAULT
-
-!
-!--             Allocating and initializing data arrays for all other modules
-                CALL module_interface_3d_data_averaging( 'allocate', trimvar )
-
+!
+!--             User-defined quantity
+                CALL user_3d_data_averaging( 'allocate', doav(ii) )
 
           END SELECT
@@ -433,569 +177,201 @@
     DO  ii = 1, doav_n
 
-       trimvar = TRIM( doav(ii) )
 !
 !--    Store the array chosen on the temporary array.
-       SELECT CASE ( trimvar )
-
-          CASE ( 'ghf*' )
-             IF ( ALLOCATED( ghf_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-!
-!--                   Check whether grid point is a natural- or urban-type surface.
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-!
-!--                   In order to avoid double-counting of surface properties, always assume that
-!--                   natural-type surfaces are below urban type surfaces, e.g. in case of bridges.
-!--                   Further, take only the last suface element, i.e. the uppermost surface which
-!--                   would be visible from above
-                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         ghf_av(j,i) = ghf_av(j,i) + surf_lsm_h(0)%ghf(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         ghf_av(j,i) = ghf_av(j,i) + surf_usm_h(0)%frac(m,ind_veg_wall)  *            &
-                                                     surf_usm_h(0)%wghf_eb(m)        +                &
-                                                     surf_usm_h(0)%frac(m,ind_pav_green) *            &
-                                                     surf_usm_h(0)%wghf_eb_green(m)  +                &
-                                                     surf_usm_h(0)%frac(m,ind_wat_win)   *            &
-                                                     surf_usm_h(0)%wghf_eb_window(m)
+       SELECT CASE ( TRIM( doav(ii) ) )
+
+          CASE ( 'e' )
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'lwp*' )
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) * &
+                                                    dzw(1:nzt+1) )
+                ENDDO
+             ENDDO
+
+          CASE ( 'p' )
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'pc' )
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'pr' )
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      psi = prt_start_index(k,j,i)
+                      s_r3 = 0.0
+                      s_r4 = 0.0
+                      DO  n = psi, psi+prt_count(k,j,i)-1
+                         s_r3 = s_r3 + particles(n)%radius**3
+                         s_r4 = s_r4 + particles(n)%radius**4
+                      ENDDO
+                      IF ( s_r3 /= 0.0 )  THEN
+                         mean_r = s_r4 / s_r3
+                      ELSE
+                         mean_r = 0.0
                       ENDIF
+                      pr_av(k,j,i) = pr_av(k,j,i) + mean_r
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'pt' )
+             IF ( .NOT. cloud_physics ) THEN
+                DO  i = nxl-1, nxr+1
+                   DO  j = nys-1, nyn+1
+                      DO  k = nzb, nzt+1
+                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
+                      ENDDO
+                   ENDDO
+                ENDDO
+             ELSE
+                DO  i = nxl-1, nxr+1
+                   DO  j = nys-1, nyn+1
+                      DO  k = nzb, nzt+1
+                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + l_d_cp * &
+                                                       pt_d_t(k) * ql(k,j,i)
+                      ENDDO
                    ENDDO
                 ENDDO
              ENDIF
 
-          CASE ( 'e' )
-             IF ( ALLOCATED( e_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'thetal' )
-             IF ( ALLOCATED( lpt_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'lwp*' )
-             IF ( ALLOCATED( lwp_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) * dzw(1:nzt+1) )            &
-                                                                       * rho_surface
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ol*' )
-             IF ( ALLOCATED( ol_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         ol_av(j,i) = ol_av(j,i) + surf_def_h(0)%ol(m)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         ol_av(j,i) = ol_av(j,i) + surf_lsm_h(0)%ol(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         ol_av(j,i) = ol_av(j,i) + surf_usm_h(0)%ol(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'p' )
-             IF ( ALLOCATED( p_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'pc' )
-             IF ( ALLOCATED( pc_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'pr' )
-             IF ( ALLOCATED( pr_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         number_of_particles = prt_count(k,j,i)
-                         IF ( number_of_particles <= 0 )  CYCLE
-                         particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                         s_r2 = 0.0_wp
-                         s_r3 = 0.0_wp
-
-                         DO  n = 1, number_of_particles
-                            IF ( particles(n)%particle_mask )  THEN
-                               s_r2 = s_r2 + particles(n)%radius**2 * particles(n)%weight_factor
-                               s_r3 = s_r3 + particles(n)%radius**3 * particles(n)%weight_factor
-                            ENDIF
-                         ENDDO
-
-                         IF ( s_r2 > 0.0_wp )  THEN
-                            mean_r = s_r3 / s_r2
-                         ELSE
-                            mean_r = 0.0_wp
-                         ENDIF
-                         pr_av(k,j,i) = pr_av(k,j,i) + mean_r
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'theta' )
-             IF ( ALLOCATED( pt_av ) ) THEN
-                IF ( .NOT. bulk_cloud_model ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                            pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ELSE
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                            pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + lv_d_cp * d_exner(k)         &
-                                                                              * ql(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDIF
-             ENDIF
-
           CASE ( 'q' )
-             IF ( ALLOCATED( q_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+             
           CASE ( 'ql' )
-             IF ( ALLOCATED( ql_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'ql_c' )
-             IF ( ALLOCATED( ql_c_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'ql_v' )
-             IF ( ALLOCATED( ql_v_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'ql_vp' )
-             IF ( ALLOCATED( ql_vp_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb, nzt+1
-                         number_of_particles = prt_count(k,j,i)
-                         IF ( number_of_particles <= 0 )  CYCLE
-                         particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-                         DO  n = 1, number_of_particles
-                            IF ( particles(n)%particle_mask )  THEN
-                               ql_vp_av(k,j,i) = ql_vp_av(k,j,i) +                                 &
-                                                 particles(n)%weight_factor / number_of_particles
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'qsurf*' )
-             IF ( ALLOCATED( qsurf_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         qsurf_av(j,i) = qsurf_av(j,i) + surf_def_h(0)%q_surface(m)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         qsurf_av(j,i) = qsurf_av(j,i) + surf_lsm_h(0)%q_surface(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         qsurf_av(j,i) = qsurf_av(j,i) + surf_usm_h(0)%q_surface(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'qsws*' )
-!
-!--          In case of default surfaces, clean-up flux by density.
-!--          In case of land- and urban-surfaces, convert fluxes into dynamic units.
-!--          Question (maronga): are the .NOT. statements really required?
-             IF ( ALLOCATED( qsws_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         qsws_av(j,i) = qsws_av(j,i) + surf_def_h(0)%qsws(m) *                     &
-                                        waterflux_output_conversion(nzb)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         qsws_av(j,i) = qsws_av(j,i) + surf_lsm_h(0)%qsws(m) * l_v
-                      ELSEIF ( match_usm  .AND.  .NOT. match_lsm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         qsws_av(j,i) = qsws_av(j,i) + surf_usm_h(0)%qsws(m) * l_v
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + ql_vp(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'qv' )
-             IF ( ALLOCATED( qv_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'r_a*' )
-             IF ( ALLOCATED( r_a_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         r_a_av(j,i) = r_a_av(j,i) + surf_lsm_h(0)%r_a(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         r_a_av(j,i) = r_a_av(j,i) + surf_usm_h(0)%frac(m,ind_veg_wall)  *            &
-                                                     surf_usm_h(0)%r_a(m)       +                     &
-                                                     surf_usm_h(0)%frac(m,ind_pav_green) *            &
-                                                     surf_usm_h(0)%r_a_green(m) +                     &
-                                                     surf_usm_h(0)%frac(m,ind_wat_win)   *            &
-                                                     surf_usm_h(0)%r_a_window(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 's' )
-             IF ( ALLOCATED( s_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         s_av(k,j,i) = s_av(k,j,i) + s(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'shf*' )
-!
-!--          In case of default surfaces, clean-up flux by density.
-!--          In case of land- and urban-surfaces, convert fluxes into dynamic units.
-             IF ( ALLOCATED( shf_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         shf_av(j,i) = shf_av(j,i) + surf_def_h(0)%shf(m)  *                       &
-                                       heatflux_output_conversion(nzb)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         shf_av(j,i) = shf_av(j,i) + surf_lsm_h(0)%shf(m) * c_p
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         shf_av(j,i) = shf_av(j,i) + surf_usm_h(0)%shf(m) * c_p
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ssurf*' )
-             IF ( ALLOCATED( ssurf_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      k = topo_top_ind(j,i,0)
-                      ssurf_av(j,i) = ssurf_av(j,i) + s(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'ssws*' )
-             IF ( ALLOCATED( ssws_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         ssws_av(j,i) = ssws_av(j,i) + surf_def_h(0)%ssws(m)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         ssws_av(j,i) = ssws_av(j,i) + surf_lsm_h(0)%ssws(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         ssws_av(j,i) = ssws_av(j,i) + surf_usm_h(0)%ssws(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      s_av(k,j,i) = s_av(k,j,i) + q(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+             
           CASE ( 't*' )
-             IF ( ALLOCATED( ts_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         ts_av(j,i) = ts_av(j,i) + surf_def_h(0)%ts(m)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         ts_av(j,i) = ts_av(j,i) + surf_lsm_h(0)%ts(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         ts_av(j,i) = ts_av(j,i) + surf_usm_h(0)%ts(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'tsurf*' )
-             IF ( ALLOCATED( tsurf_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         tsurf_av(j,i) = tsurf_av(j,i) + surf_def_h(0)%pt_surface(m)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         tsurf_av(j,i) = tsurf_av(j,i) + surf_lsm_h(0)%pt_surface(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         tsurf_av(j,i) = tsurf_av(j,i) + surf_usm_h(0)%pt_surface(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   ts_av(j,i) = ts_av(j,i) + ts(j,i)
+                ENDDO
+             ENDDO
 
           CASE ( 'u' )
-             IF ( ALLOCATED( u_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'us*' )
-             IF ( ALLOCATED( us_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         us_av(j,i) = us_av(j,i) + surf_def_h(0)%us(m)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         us_av(j,i) = us_av(j,i) + surf_lsm_h(0)%us(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         us_av(j,i) = us_av(j,i) + surf_usm_h(0)%us(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'u*' )
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   us_av(j,i) = us_av(j,i) + us(j,i)
+                ENDDO
+             ENDDO
 
           CASE ( 'v' )
-             IF ( ALLOCATED( v_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'thetav' )
-             IF ( ALLOCATED( vpt_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'vpt' )
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE ( 'w' )
-             IF ( ALLOCATED( w_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'z0*' )
-             IF ( ALLOCATED( z0_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         z0_av(j,i) = z0_av(j,i) + surf_def_h(0)%z0(m)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         z0_av(j,i) = z0_av(j,i) + surf_lsm_h(0)%z0(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         z0_av(j,i) = z0_av(j,i) + surf_usm_h(0)%z0(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'z0h*' )
-             IF ( ALLOCATED( z0h_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         z0h_av(j,i) = z0h_av(j,i) + surf_def_h(0)%z0h(m)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         z0h_av(j,i) = z0h_av(j,i) + surf_lsm_h(0)%z0h(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         z0h_av(j,i) = z0h_av(j,i) + surf_usm_h(0)%z0h(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'z0q*' )
-             IF ( ALLOCATED( z0q_av ) ) THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
-                      match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                      match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                      IF ( match_def )  THEN
-                         m = surf_def_h(0)%end_index(j,i)
-                         z0q_av(j,i) = z0q_av(j,i) + surf_def_h(0)%z0q(m)
-                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                         m = surf_lsm_h(0)%end_index(j,i)
-                         z0q_av(j,i) = z0q_av(j,i) + surf_lsm_h(0)%z0q(m)
-                      ELSEIF ( match_usm )  THEN
-                         m = surf_usm_h(0)%end_index(j,i)
-                         z0q_av(j,i) = z0q_av(j,i) + surf_usm_h(0)%z0q(m)
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDIF
+             DO  i = nxl-1, nxr+1
+                DO  j = nys-1, nyn+1
+                   DO  k = nzb, nzt+1
+                      w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
 
           CASE DEFAULT
-
-!--          In case of urban surface variables it should be always checked if respective arrays are
-!--          allocated, at least in case of a restart run, as averaged usm arrays are not read from
-!--          file at the moment.
-             IF ( urban_surface )  THEN
-                CALL usm_3d_data_averaging( 'allocate', trimvar )
-             ENDIF
-
-!
-!--          Summing up data from all other modules
-             CALL module_interface_3d_data_averaging( 'sum', trimvar )
-
+!
+!--          User-defined quantity
+             CALL user_3d_data_averaging( 'sum', doav(ii) )
 
        END SELECT
@@ -1003,5 +379,5 @@
     ENDDO
 
-    CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
+    CALL cpu_log (log_point(34),'sum_up_3d_data','stop','nobarrier')
 
 
Index: palm/trunk/SOURCE/surface_coupler.f90
===================================================================
--- palm/trunk/SOURCE/surface_coupler.f90	(revision 4901)
+++ 	(revision )
@@ -1,795 +1,0 @@
-!> @file surface_coupler.f90
-!------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Implementation of downward facing USM and LSM surfaces
-! 
-! 4429 2020-02-27 15:24:30Z raasch
-! bugfix: preprocessor directives rearranged for serial mode
-! 
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-! 
-! 3655 2019-01-07 16:51:22Z knoop
-! Modularization of all bulk cloud physics code components
-!
-! 109 2007-08-28 15:26:47Z letzel
-! Initial revision
-!
-! Description:
-! ------------
-!> Data exchange at the interface between coupled models
-!------------------------------------------------------------------------------!
- SUBROUTINE surface_coupler
-#if defined( __parallel )
- 
-
-    USE arrays_3d,                                                             &
-        ONLY:  pt, rho_ocean, sa, total_2d_a, total_2d_o, u, v
-
-    USE basic_constants_and_equations_mod,                                     &
-        ONLY:  c_p, l_v
-
-    USE control_parameters,                                                    &
-        ONLY:  coupling_mode, coupling_mode_remote, coupling_topology,         &
-               humidity, humidity_remote, land_surface, message_string,        &
-               terminate_coupled, terminate_coupled_remote,                    &
-               time_since_reference_point, urban_surface
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point
-
-    USE indices,                                                               &
-        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, nx_a, nx_o, ny, nyn, nyng, nys, &
-               nysg, ny_a, ny_o, nzt
-
-    USE kinds
-
-    USE pegrid
-
-    USE surface_mod,                                                           &
-        ONLY :  surf_def_h, surf_lsm_h, surf_type, surf_usm_h
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                                    !< index variable x-direction 
-    INTEGER(iwp) ::  j                                    !< index variable y-direction 
-    INTEGER(iwp) ::  m                                    !< running index for surface elements
-
-    REAL(wp)    ::  cpw = 4218.0_wp                       !< heat capacity of water at constant pressure
-    REAL(wp)    ::  time_since_reference_point_rem        !< 
-    REAL(wp)    ::  total_2d(-nbgp:ny+nbgp,-nbgp:nx+nbgp) !< 
-
-    REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  surface_flux !< dummy array for surface fluxes on 2D grid
-
-
-    CALL cpu_log( log_point(39), 'surface_coupler', 'start' )
-
-
-
-!
-!-- In case of model termination initiated by the remote model 
-!-- (terminate_coupled_remote > 0), initiate termination of the local model. 
-!-- The rest of the coupler must then be skipped because it would cause an MPI 
-!-- intercomminucation hang.
-!-- If necessary, the coupler will be called at the beginning of the next 
-!-- restart run.
-
-    IF ( coupling_topology == 0 ) THEN
-       CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER, target_id, &
-                          0,                                                   &
-                          terminate_coupled_remote, 1, MPI_INTEGER, target_id, &
-                          0, comm_inter, status, ierr )
-    ELSE
-       IF ( myid == 0) THEN
-          CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER, &
-                             target_id, 0,                             &
-                             terminate_coupled_remote, 1, MPI_INTEGER, & 
-                             target_id, 0,                             &
-                             comm_inter, status, ierr )
-       ENDIF
-       CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, &
-                       ierr )
-
-       ALLOCATE( total_2d_a(-nbgp:ny_a+nbgp,-nbgp:nx_a+nbgp),       &
-                 total_2d_o(-nbgp:ny_o+nbgp,-nbgp:nx_o+nbgp) )
-
-    ENDIF
-
-    IF ( terminate_coupled_remote > 0 )  THEN
-       WRITE( message_string, * ) 'remote model "',                            &
-                                  TRIM( coupling_mode_remote ),                &
-                                  '" terminated',                              &
-                                  '&with terminate_coupled_remote = ',         &
-                                  terminate_coupled_remote,                    &
-                                  '&local model  "', TRIM( coupling_mode ),    &
-                                  '" has',                                     &
-                                  '&terminate_coupled = ',                     &
-                                   terminate_coupled
-       CALL message( 'surface_coupler', 'PA0310', 1, 2, 0, 6, 0 )
-       RETURN
-    ENDIF
- 
-
-!
-!-- Exchange the current simulated time between the models,
-!-- currently just for total_2d
-    IF ( coupling_topology == 0 ) THEN
-   
-       CALL MPI_SEND( time_since_reference_point, 1, MPI_REAL, target_id, 11, &
-                      comm_inter, ierr )
-       CALL MPI_RECV( time_since_reference_point_rem, 1, MPI_REAL, target_id, &
-                      11, comm_inter, status, ierr )
-    ELSE
-
-       IF ( myid == 0 ) THEN
-
-          CALL MPI_SEND( time_since_reference_point, 1, MPI_REAL, target_id, &
-                         11, comm_inter, ierr )
-          CALL MPI_RECV( time_since_reference_point_rem, 1, MPI_REAL,        &
-                         target_id, 11, comm_inter, status, ierr )
-
-       ENDIF
-
-       CALL MPI_BCAST( time_since_reference_point_rem, 1, MPI_REAL, 0, comm2d, &
-                       ierr )
-
-    ENDIF
-
-!
-!-- Exchange the interface data
-    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
-    
-!
-!--    Horizontal grid size and number of processors is equal in ocean and
-!--    atmosphere
-       IF ( coupling_topology == 0 )  THEN
-
-!
-!--       Send heat flux at bottom surface to the ocean. First, transfer from 
-!--       1D surface type to 2D grid.
-          CALL transfer_1D_to_2D_equal( surf_def_h(0)%shf, surf_lsm_h(0)%shf,     &
-                                        surf_usm_h(0)%shf )
-          CALL MPI_SEND( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, target_id, &
-                         12, comm_inter, ierr )
-!
-!--       Send humidity flux at bottom surface to the ocean. First, transfer
-!--       from 1D surface type to 2D grid.
-          CALL transfer_1D_to_2D_equal( surf_def_h(0)%qsws, surf_lsm_h(0)%qsws,   &
-                                        surf_usm_h(0)%qsws )
-          IF ( humidity )  THEN
-             CALL MPI_SEND( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL,         &
-                            target_id, 13, comm_inter, ierr )
-          ENDIF
-!
-!--       Receive temperature at the bottom surface from the ocean
-          CALL MPI_RECV( pt(0,nysg,nxlg), 1, type_xy, target_id, 14,           &
-                         comm_inter, status, ierr )
-!
-!--       Send the momentum flux (u) at bottom surface to the ocean. First, 
-!--       transfer from 1D surface type to 2D grid.
-          CALL transfer_1D_to_2D_equal( surf_def_h(0)%usws, surf_lsm_h(0)%usws,   &
-                                        surf_usm_h(0)%usws )
-          CALL MPI_SEND( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, target_id, &
-                         15, comm_inter, ierr )
-!
-!--       Send the momentum flux (v) at bottom surface to the ocean. First, 
-!--       transfer from 1D surface type to 2D grid.
-          CALL transfer_1D_to_2D_equal( surf_def_h(0)%vsws, surf_lsm_h(0)%vsws,   &
-                                        surf_usm_h(0)%vsws )
-          CALL MPI_SEND( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, target_id, &
-                         16, comm_inter, ierr )
-!
-!--       Receive u at the bottom surface from the ocean
-          CALL MPI_RECV( u(0,nysg,nxlg), 1, type_xy, target_id, 17,            &
-                         comm_inter, status, ierr )
-!
-!--       Receive v at the bottom surface from the ocean
-          CALL MPI_RECV( v(0,nysg,nxlg), 1, type_xy, target_id, 18,            &
-                         comm_inter, status, ierr )
-!
-!--    Horizontal grid size or number of processors differs between 
-!--    ocean and atmosphere
-       ELSE
-      
-!
-!--       Send heat flux at bottom surface to the ocean
-          total_2d_a = 0.0_wp
-          total_2d   = 0.0_wp
-!
-!--       Transfer from 1D surface type to 2D grid.
-          CALL transfer_1D_to_2D_unequal( surf_def_h(0)%shf, surf_lsm_h(0)%shf,   &
-                                          surf_usm_h(0)%shf )
-
-          CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, 0,  &
-                           comm2d, ierr )
-          CALL interpolate_to_ocean( 12 )   
-!
-!--       Send humidity flux at bottom surface to the ocean
-          IF ( humidity )  THEN
-             total_2d_a = 0.0_wp
-             total_2d   = 0.0_wp
-!
-!--          Transfer from 1D surface type to 2D grid.
-             CALL transfer_1D_to_2D_unequal( surf_def_h(0)%qsws,              &
-                                             surf_lsm_h(0)%qsws,                 &
-                                             surf_usm_h(0)%qsws )
-
-             CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, &
-                              0, comm2d, ierr )
-             CALL interpolate_to_ocean( 13 )
-          ENDIF
-!
-!--       Receive temperature at the bottom surface from the ocean
-          IF ( myid == 0 )  THEN
-             CALL MPI_RECV( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL,          &
-                            target_id, 14, comm_inter, status, ierr )   
-          ENDIF
-          CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, 0, comm2d, &
-                          ierr )
-          pt(0,nysg:nyng,nxlg:nxrg) = total_2d_a(nysg:nyng,nxlg:nxrg)
-!
-!--       Send momentum flux (u) at bottom surface to the ocean
-          total_2d_a = 0.0_wp 
-          total_2d   = 0.0_wp
-!
-!--       Transfer from 1D surface type to 2D grid.
-          CALL transfer_1D_to_2D_unequal( surf_def_h(0)%usws, surf_lsm_h(0)%usws, &
-                                          surf_usm_h(0)%usws )
-          CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, 0, &
-                           comm2d, ierr )
-          CALL interpolate_to_ocean( 15 )
-!
-!--       Send momentum flux (v) at bottom surface to the ocean
-          total_2d_a = 0.0_wp
-          total_2d   = 0.0_wp
-!
-!--       Transfer from 1D surface type to 2D grid.
-          CALL transfer_1D_to_2D_unequal( surf_def_h(0)%usws, surf_lsm_h(0)%usws, &
-                                          surf_usm_h(0)%usws )
-          CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, 0, &
-                           comm2d, ierr )
-          CALL interpolate_to_ocean( 16 )
-!
-!--       Receive u at the bottom surface from the ocean
-          IF ( myid == 0 )  THEN
-             CALL MPI_RECV( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
-                            target_id, 17, comm_inter, status, ierr )
-          ENDIF
-          CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, 0, comm2d, &
-                          ierr )
-          u(0,nysg:nyng,nxlg:nxrg) = total_2d_a(nysg:nyng,nxlg:nxrg)
-!
-!--       Receive v at the bottom surface from the ocean
-          IF ( myid == 0 )  THEN
-             CALL MPI_RECV( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
-                            target_id, 18, comm_inter, status, ierr )
-          ENDIF
-          CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, 0, comm2d, &
-                          ierr )
-          v(0,nysg:nyng,nxlg:nxrg) = total_2d_a(nysg:nyng,nxlg:nxrg)
-
-       ENDIF
-
-    ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
-
-!
-!--    Horizontal grid size and number of processors is equal
-!--    in ocean and atmosphere
-       IF ( coupling_topology == 0 ) THEN
-!
-!--       Receive heat flux at the sea surface (top) from the atmosphere
-          CALL MPI_RECV( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, target_id, 12, &
-                         comm_inter, status, ierr )
-          CALL transfer_2D_to_1D_equal( surf_def_h(2)%shf )
-!
-!--       Receive humidity flux from the atmosphere (bottom)
-!--       and add it to the heat flux at the sea surface (top)...
-          IF ( humidity_remote )  THEN
-             CALL MPI_RECV( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, &
-                            target_id, 13, comm_inter, status, ierr )
-             CALL transfer_2D_to_1D_equal( surf_def_h(2)%qsws )
-          ENDIF
-!
-!--       Send sea surface temperature to the atmosphere model
-          CALL MPI_SEND( pt(nzt,nysg,nxlg), 1, type_xy, target_id, 14, &
-                         comm_inter, ierr )
-!
-!--       Receive momentum flux (u) at the sea surface (top) from the atmosphere
-          CALL MPI_RECV( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, target_id, 15, &
-                         comm_inter, status, ierr )
-          CALL transfer_2D_to_1D_equal( surf_def_h(2)%usws )
-!
-!--       Receive momentum flux (v) at the sea surface (top) from the atmosphere
-          CALL MPI_RECV( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, target_id, 16, &
-                         comm_inter, status, ierr )
-          CALL transfer_2D_to_1D_equal( surf_def_h(2)%vsws )
-!
-!--       Send u to the atmosphere
-          CALL MPI_SEND( u(nzt,nysg,nxlg), 1, type_xy, target_id, 17, &
-                         comm_inter, ierr )
-!
-!--       Send v to the atmosphere
-          CALL MPI_SEND( v(nzt,nysg,nxlg), 1, type_xy, target_id, 18, &
-                         comm_inter, ierr )
-!
-!--    Horizontal gridsize or number of processors differs between 
-!--    ocean and atmosphere
-       ELSE
-!
-!--       Receive heat flux at the sea surface (top) from the atmosphere
-          IF ( myid == 0 )  THEN
-             CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
-                            target_id, 12, comm_inter, status, ierr )
-          ENDIF
-          CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, 0, comm2d, &
-                          ierr )
-          CALL transfer_2D_to_1D_unequal( surf_def_h(2)%shf )
-!
-!--       Receive humidity flux at the sea surface (top) from the atmosphere
-          IF ( humidity_remote )  THEN
-             IF ( myid == 0 )  THEN
-                CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
-                               target_id, 13, comm_inter, status, ierr )
-             ENDIF
-             CALL MPI_BARRIER( comm2d, ierr )
-             CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, 0, &
-                             comm2d, ierr)
-             CALL transfer_2D_to_1D_unequal( surf_def_h(2)%qsws )
-          ENDIF
-!
-!--       Send surface temperature to atmosphere
-          total_2d_o = 0.0_wp
-          total_2d   = 0.0_wp
-          total_2d(nys:nyn,nxl:nxr) = pt(nzt,nys:nyn,nxl:nxr)
-
-          CALL MPI_REDUCE( total_2d, total_2d_o, ngp_o, MPI_REAL, MPI_SUM, 0, &
-                           comm2d, ierr) 
-          CALL interpolate_to_atmos( 14 )
-!
-!--       Receive momentum flux (u) at the sea surface (top) from the atmosphere
-          IF ( myid == 0 )  THEN
-             CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
-                            target_id, 15, comm_inter, status, ierr )
-          ENDIF
-          CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
-                          0, comm2d, ierr )
-          CALL transfer_2D_to_1D_unequal( surf_def_h(2)%usws )
-!
-!--       Receive momentum flux (v) at the sea surface (top) from the atmosphere
-          IF ( myid == 0 )  THEN
-             CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
-                            target_id, 16, comm_inter, status, ierr )
-          ENDIF
-          CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, 0, comm2d, &
-                          ierr )
-          CALL transfer_2D_to_1D_unequal( surf_def_h(2)%vsws )
-!
-!--       Send u to atmosphere
-          total_2d_o = 0.0_wp  
-          total_2d   = 0.0_wp
-          total_2d(nys:nyn,nxl:nxr) = u(nzt,nys:nyn,nxl:nxr)
-          CALL MPI_REDUCE( total_2d, total_2d_o, ngp_o, MPI_REAL, MPI_SUM, 0, &
-                           comm2d, ierr )
-          CALL interpolate_to_atmos( 17 )
-!
-!--       Send v to atmosphere
-          total_2d_o = 0.0_wp
-          total_2d   = 0.0_wp
-          total_2d(nys:nyn,nxl:nxr) = v(nzt,nys:nyn,nxl:nxr)
-          CALL MPI_REDUCE( total_2d, total_2d_o, ngp_o, MPI_REAL, MPI_SUM, 0, &
-                           comm2d, ierr )
-          CALL interpolate_to_atmos( 18 )
-        
-       ENDIF
-
-!
-!--    Conversions of fluxes received from atmosphere
-       IF ( humidity_remote )  THEN
-!
-!--       Here top heat flux is still the sum of atmospheric bottom heat fluxes,
-!--       * latent heat of vaporization in m2/s2, or 540 cal/g, or 40.65 kJ/mol
-!--       /(rho_atm(=1.0)*c_p)
-          DO  m = 1, surf_def_h(2)%ns
-             i = surf_def_h(2)%i(m)
-             j = surf_def_h(2)%j(m)
-             
-             surf_def_h(2)%shf(m) = surf_def_h(2)%shf(m) +                     &
-                                    surf_def_h(2)%qsws(m) * l_v / c_p
-!
-!--          ...and convert it to a salinity flux at the sea surface (top)
-!--          following Steinhorn (1991), JPO 21, pp. 1681-1683:
-!--          S'w' = -S * evaporation / ( rho_water * ( 1 - S ) )
-             surf_def_h(2)%sasws(m) = -1.0_wp * sa(nzt,j,i) * 0.001_wp *       &
-                                      surf_def_h(2)%qsws(m) /                  &
-                                    ( rho_ocean(nzt,j,i) *                     &
-                                      ( 1.0_wp - sa(nzt,j,i) * 0.001_wp )      &
-                                    )
-          ENDDO
-       ENDIF
-
-!
-!--    Adjust the kinematic heat flux with respect to ocean density
-!--    (constants are the specific heat capacities for air and water), as well 
-!--    as momentum fluxes 
-       DO  m = 1, surf_def_h(2)%ns
-          i = surf_def_h(2)%i(m)
-          j = surf_def_h(2)%j(m)
-          surf_def_h(2)%shf(m) = surf_def_h(2)%shf(m) / rho_ocean(nzt,j,i) *   &
-                                 c_p / cpw
-
-          surf_def_h(2)%usws(m) = surf_def_h(2)%usws(m) / rho_ocean(nzt,j,i)
-          surf_def_h(2)%vsws(m) = surf_def_h(2)%vsws(m) / rho_ocean(nzt,j,i)
-       ENDDO
-
-    ENDIF
-
-    IF ( coupling_topology == 1 )  THEN
-       DEALLOCATE( total_2d_o, total_2d_a )
-    ENDIF
-
-    CALL cpu_log( log_point(39), 'surface_coupler', 'stop' )
-
-
-     CONTAINS 
-
-!       Description:
-!------------------------------------------------------------------------------!
-!>      Data transfer from 1D surface-data type to 2D dummy array for equal 
-!>      grids in atmosphere and ocean.
-!------------------------------------------------------------------------------!
-        SUBROUTINE transfer_1D_to_2D_equal( def_1d, lsm_1d, usm_1d )
-
-           IMPLICIT NONE
-
-            INTEGER(iwp) ::  i   !< running index x
-            INTEGER(iwp) ::  j   !< running index y
-            INTEGER(iwp) ::  m   !< running index surface type
-
-            REAL(wp), DIMENSION(1:surf_def_h(0)%ns) ::  def_1d !< 1D surface flux, default surfaces
-            REAL(wp), DIMENSION(1:surf_lsm_h(0)%ns) ::  lsm_1d !< 1D surface flux, natural surfaces
-            REAL(wp), DIMENSION(1:surf_usm_h(0)%ns) ::  usm_1d !< 1D surface flux, urban surfaces
-!
-!--         Transfer surface flux at default surfaces to 2D grid 
-            DO  m = 1, surf_def_h(0)%ns
-               i = surf_def_h(0)%i(m)
-               j = surf_def_h(0)%j(m)
-               surface_flux(j,i) = def_1d(m)
-            ENDDO
-!
-!--         Transfer surface flux at natural surfaces to 2D grid 
-            IF ( land_surface )  THEN 
-               DO  m = 1, SIZE(lsm_1d)
-                  i = surf_lsm_h(0)%i(m)
-                  j = surf_lsm_h(0)%j(m)
-                  surface_flux(j,i) = lsm_1d(m)
-               ENDDO
-            ENDIF
-!
-!--         Transfer surface flux at natural surfaces to 2D grid 
-            IF ( urban_surface )  THEN 
-               DO  m = 1, SIZE(usm_1d)
-                  i = surf_usm_h(0)%i(m)
-                  j = surf_usm_h(0)%j(m)
-                  surface_flux(j,i) = usm_1d(m)
-               ENDDO
-            ENDIF
-
-        END SUBROUTINE transfer_1D_to_2D_equal
-
-!       Description:
-!------------------------------------------------------------------------------!
-!>      Data transfer from 2D array for equal grids onto 1D surface-data type
-!>      array.
-!------------------------------------------------------------------------------!
-        SUBROUTINE transfer_2D_to_1D_equal( def_1d )
-
-           IMPLICIT NONE
-
-            INTEGER(iwp) ::  i   !< running index x
-            INTEGER(iwp) ::  j   !< running index y
-            INTEGER(iwp) ::  m   !< running index surface type
-
-            REAL(wp), DIMENSION(1:surf_def_h(2)%ns) ::  def_1d !< 1D surface flux, default surfaces
-!
-!--         Transfer surface flux to 1D surface type, only for default surfaces 
-            DO  m = 1, surf_def_h(2)%ns
-               i = surf_def_h(2)%i(m)
-               j = surf_def_h(2)%j(m)
-               def_1d(m) = surface_flux(j,i)
-            ENDDO
-
-        END SUBROUTINE transfer_2D_to_1D_equal
-
-!       Description:
-!------------------------------------------------------------------------------!
-!>      Data transfer from 1D surface-data type to 2D dummy array from unequal 
-!>      grids in atmosphere and ocean.
-!------------------------------------------------------------------------------!
-        SUBROUTINE transfer_1D_to_2D_unequal( def_1d, lsm_1d, usm_1d )
-
-           IMPLICIT NONE
-
-            INTEGER(iwp) ::  i   !< running index x
-            INTEGER(iwp) ::  j   !< running index y
-            INTEGER(iwp) ::  m   !< running index surface type
-
-            REAL(wp), DIMENSION(1:surf_def_h(0)%ns) ::  def_1d !< 1D surface flux, default surfaces
-            REAL(wp), DIMENSION(1:surf_lsm_h(0)%ns)    ::  lsm_1d !< 1D surface flux, natural surfaces
-            REAL(wp), DIMENSION(1:surf_usm_h(0)%ns)    ::  usm_1d !< 1D surface flux, urban surfaces
-!
-!--         Transfer surface flux at default surfaces to 2D grid. Transfer no
-!--         ghost-grid points since total_2d is a global array.
-            DO  m = 1, SIZE(def_1d)
-               i = surf_def_h(0)%i(m)
-               j = surf_def_h(0)%j(m)
-
-               IF ( i >= nxl  .AND.  i <= nxr  .AND.                           &
-                    j >= nys  .AND.  j <= nyn )  THEN
-                  total_2d(j,i) = def_1d(m)
-               ENDIF
-            ENDDO
-!
-!--         Transfer surface flux at natural surfaces to 2D grid 
-            IF ( land_surface )  THEN 
-               DO  m = 1, SIZE(lsm_1d)
-                  i = surf_lsm_h(0)%i(m)
-                  j = surf_lsm_h(0)%j(m)
-
-                  IF ( i >= nxl  .AND.  i <= nxr  .AND.                        &
-                       j >= nys  .AND.  j <= nyn )  THEN
-                     total_2d(j,i) = lsm_1d(m)
-                  ENDIF
-               ENDDO
-            ENDIF
-!
-!--         Transfer surface flux at natural surfaces to 2D grid 
-            IF ( urban_surface )  THEN 
-               DO  m = 1, SIZE(usm_1d)
-                  i = surf_usm_h(0)%i(m)
-                  j = surf_usm_h(0)%j(m)
-
-                  IF ( i >= nxl  .AND.  i <= nxr  .AND.                        &
-                       j >= nys  .AND.  j <= nyn )  THEN
-                     total_2d(j,i) = usm_1d(m)
-                  ENDIF
-               ENDDO
-            ENDIF
-
-        END SUBROUTINE transfer_1D_to_2D_unequal
-
-!       Description:
-!------------------------------------------------------------------------------!
-!>      Data transfer from 2D dummy array from unequal grids to 1D surface-data 
-!>      type.
-!------------------------------------------------------------------------------!
-        SUBROUTINE transfer_2D_to_1D_unequal( def_1d )
-
-           IMPLICIT NONE
-
-            INTEGER(iwp) ::  i   !< running index x
-            INTEGER(iwp) ::  j   !< running index y
-            INTEGER(iwp) ::  m   !< running index surface type
-
-            REAL(wp), DIMENSION(1:surf_def_h(2)%ns) ::  def_1d !< 1D surface flux, default surfaces
-!
-!--         Transfer 2D surface flux to default surfaces data type. Transfer no
-!--         ghost-grid points since total_2d is a global array.
-            DO  m = 1, SIZE(def_1d)
-               i = surf_def_h(2)%i(m)
-               j = surf_def_h(2)%j(m)
-
-               IF ( i >= nxl  .AND.  i <= nxr  .AND.                           &
-                    j >= nys  .AND.  j <= nyn )  THEN
-                  def_1d(m) = total_2d_o(j,i)
-               ENDIF
-            ENDDO
-
-
-        END SUBROUTINE transfer_2D_to_1D_unequal
-
-#endif
-  END SUBROUTINE surface_coupler
-
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
-#if defined( __parallel )
-
-  SUBROUTINE interpolate_to_atmos( tag )
-
-    USE arrays_3d,                                                             &
-        ONLY:  total_2d_a, total_2d_o
-
-    USE indices,                                                               &
-        ONLY:  nbgp, nx, nx_a, nx_o, ny, ny_a, ny_o
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  dnx  !< 
-    INTEGER(iwp) ::  dnx2 !< 
-    INTEGER(iwp) ::  dny  !< 
-    INTEGER(iwp) ::  dny2 !< 
-    INTEGER(iwp) ::  i    !< 
-    INTEGER(iwp) ::  ii   !< 
-    INTEGER(iwp) ::  j    !< 
-    INTEGER(iwp) ::  jj   !< 
-
-    INTEGER(iwp), intent(in) ::  tag !< 
-
-    CALL MPI_BARRIER( comm2d, ierr )
-
-    IF ( myid == 0 )  THEN
-!
-!--    Cyclic boundary conditions for the total 2D-grid
-       total_2d_o(-nbgp:-1,:) = total_2d_o(ny+1-nbgp:ny,:)
-       total_2d_o(:,-nbgp:-1) = total_2d_o(:,nx+1-nbgp:nx)
-
-       total_2d_o(ny+1:ny+nbgp,:) = total_2d_o(0:nbgp-1,:)
-       total_2d_o(:,nx+1:nx+nbgp) = total_2d_o(:,0:nbgp-1)
-
-!
-!--    Number of gridpoints of the fine grid within one mesh of the coarse grid
-       dnx = (nx_o+1) / (nx_a+1) 
-       dny = (ny_o+1) / (ny_a+1) 
-
-!
-!--    Distance for interpolation around coarse grid points within the fine
-!--    grid (note: 2*dnx2 must not be equal with dnx)
-       dnx2 = 2 * ( dnx / 2 )
-       dny2 = 2 * ( dny / 2 )
-
-       total_2d_a = 0.0_wp
-!
-!--    Interpolation from ocean-grid-layer to atmosphere-grid-layer
-       DO  j = 0, ny_a
-          DO  i = 0, nx_a 
-             DO  jj = 0, dny2
-                DO  ii = 0, dnx2
-                   total_2d_a(j,i) = total_2d_a(j,i) &
-                                     + total_2d_o(j*dny+jj,i*dnx+ii)
-                ENDDO
-             ENDDO
-             total_2d_a(j,i) = total_2d_a(j,i) / ( ( dnx2 + 1 ) * ( dny2 + 1 ) )
-          ENDDO
-       ENDDO
-! 
-!--    Cyclic boundary conditions for atmosphere grid
-       total_2d_a(-nbgp:-1,:) = total_2d_a(ny_a+1-nbgp:ny_a,:)
-       total_2d_a(:,-nbgp:-1) = total_2d_a(:,nx_a+1-nbgp:nx_a)
-       
-       total_2d_a(ny_a+1:ny_a+nbgp,:) = total_2d_a(0:nbgp-1,:)
-       total_2d_a(:,nx_a+1:nx_a+nbgp) = total_2d_a(:,0:nbgp-1)
-!
-!--    Transfer of the atmosphere-grid-layer to the atmosphere
-       CALL MPI_SEND( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, target_id, &
-                      tag, comm_inter, ierr )
-
-    ENDIF
-
-    CALL MPI_BARRIER( comm2d, ierr )
-
-  END SUBROUTINE interpolate_to_atmos
-
-#endif
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
-#if defined( __parallel )
-
-  SUBROUTINE interpolate_to_ocean( tag )
-
-    USE arrays_3d,                                                             &
-        ONLY:  total_2d_a, total_2d_o
-
-    USE indices,                                                               &
-        ONLY:  nbgp, nx, nx_a, nx_o, ny, ny_a, ny_o
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)             ::  dnx !< 
-    INTEGER(iwp)             ::  dny !< 
-    INTEGER(iwp)             ::  i   !< 
-    INTEGER(iwp)             ::  ii  !< 
-    INTEGER(iwp)             ::  j   !< 
-    INTEGER(iwp)             ::  jj  !< 
-    INTEGER(iwp), intent(in) ::  tag !< 
-
-    REAL(wp)                 ::  fl  !< 
-    REAL(wp)                 ::  fr  !< 
-    REAL(wp)                 ::  myl !< 
-    REAL(wp)                 ::  myr !< 
-
-    CALL MPI_BARRIER( comm2d, ierr )
-
-    IF ( myid == 0 )  THEN   
-
-!
-!--    Number of gridpoints of the fine grid within one mesh of the coarse grid
-       dnx = ( nx_o + 1 ) / ( nx_a + 1 ) 
-       dny = ( ny_o + 1 ) / ( ny_a + 1 ) 
-
-! 
-!--    Cyclic boundary conditions for atmosphere grid
-       total_2d_a(-nbgp:-1,:) = total_2d_a(ny+1-nbgp:ny,:)
-       total_2d_a(:,-nbgp:-1) = total_2d_a(:,nx+1-nbgp:nx)
-       
-       total_2d_a(ny+1:ny+nbgp,:) = total_2d_a(0:nbgp-1,:)
-       total_2d_a(:,nx+1:nx+nbgp) = total_2d_a(:,0:nbgp-1)
-!
-!--    Bilinear Interpolation from atmosphere grid-layer to ocean grid-layer
-       DO  j = 0, ny
-          DO  i = 0, nx
-             myl = ( total_2d_a(j+1,i)   - total_2d_a(j,i)   ) / dny
-             myr = ( total_2d_a(j+1,i+1) - total_2d_a(j,i+1) ) / dny
-             DO  jj = 0, dny-1
-                fl = myl*jj + total_2d_a(j,i)  
-                fr = myr*jj + total_2d_a(j,i+1)  
-                DO  ii = 0, dnx-1
-                   total_2d_o(j*dny+jj,i*dnx+ii) = ( fr - fl ) / dnx * ii + fl
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-! 
-!--    Cyclic boundary conditions for ocean grid
-       total_2d_o(-nbgp:-1,:) = total_2d_o(ny_o+1-nbgp:ny_o,:)
-       total_2d_o(:,-nbgp:-1) = total_2d_o(:,nx_o+1-nbgp:nx_o)
-
-       total_2d_o(ny_o+1:ny_o+nbgp,:) = total_2d_o(0:nbgp-1,:)
-       total_2d_o(:,nx_o+1:nx_o+nbgp) = total_2d_o(:,0:nbgp-1)
-
-       CALL MPI_SEND( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
-                      target_id, tag, comm_inter, ierr )
-
-    ENDIF
-
-    CALL MPI_BARRIER( comm2d, ierr )  
-
-  END SUBROUTINE interpolate_to_ocean
-
-#endif
Index: palm/trunk/SOURCE/surface_data_output_mod.f90
===================================================================
--- palm/trunk/SOURCE/surface_data_output_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,4884 +1,0 @@
-!> @file surface_data_output_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! revised output of surface data via MPI-IO for better performance
-!
-! 4892 2021-03-02 11:53:58Z suehring
-! Remove outdated error message.
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Bugfix: correct the down-ward surf_lsm index in the routine surface_data_output_collect_2d
-!
-! 4805 2020-12-02 12:05:34Z gronemeier
-! Bugfix: add time_dosurf to restart data
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4601 2020-07-14 12:06:09Z suehring
-! Minor simplification in name creation for IO variables in restart files.
-!
-! 4600 2020-07-13 18:50:12Z suehring
-! - Change: adjustmens for mpi-io - surface data is transformed to a 2D-based surface array
-!   before writing.
-! - Bugfix in counting of surface elements
-! - Bugfix in data-output of averaged surface data in case of restarts
-!
-! 4577 2020-06-25 09:53:58Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4547 2020-05-27 09:05:24Z moh.hefny
-! Added surface albedo and emissivity, which are defined using the tile approach
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! Bugfix for restart data format query
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! Bugfix for restart data format query
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! Added restart with MPI-IO for reading local arrays
-!
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-!
-! 4500 2020-04-17 10:12:45Z suehring
-! - Correct output of ground/wall heat flux at USM surfaces
-! - Add conversion factor to heat and momentum-flux output
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! Restart data handling with MPI-IO added
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! Bugfix: cpp-directives for serial mode added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Fix wrongly declared nc_stat variable in surface_data_output_mod
-!
-! 4205 2019-08-30 13:25:00Z suehring
-! - Correct x,y-coordinates of vertical surfaces in netcdf output
-! - Change definition of azimuth angle, reference is north 0 degree
-! - Zenith angle is always defined, also for vertical surfaces where it is 90 degree, while azimuth
-!   angle is only defined for vertical surfaces, not for horizontal ones
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4129 2019-07-31 12:56:07Z gronemeier
-! - Bugfix: corrected loop over horizontal default surfaces
-! - Change default setting of to_vtk and to_netcdf
-!
-! 4029 2019-06-14 14:04:35Z raasch
-! Netcdf variable NF90_NOFILL is used as argument instead of "1" in call to NF90_DEF_VAR_FILL
-!
-! 3881 2019-04-10 09:31:22Z suehring
-! Check for zero output timestep (not allowed in parallel NetCDF output mode)
-!
-! 3817 2019-03-26 13:53:57Z suehring
-! Correct output coordinates of vertical surface elements
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! Bugfix in surface_data_output_rrd_local (variable k removed)
-!
-! 3762 2019-02-25 16:54:16Z suehring
-! Remove unused variables and add preprocessor directives for variables that are used only when
-! netcdf4 is defined
-!
-! 3745 2019-02-15 18:57:56Z suehring
-! Output of waste_heat and innermost wall flux from indoor model
-!
-! 3744 2019-02-15 18:38:58Z suehring
-! Add azimuth and zenith to output file; set long-name attributes; clean-up coding layout
-!
-! 3735 2019-02-12 09:52:40Z suehring
-! - Split initialization into initialization of arrays and further initialization in order to enable
-!   reading of restart data.
-! - Consider restarts in surface data averaging.
-! - Correct error message numbers
-!
-! 3731 2019-02-11 13:06:27Z suehring
-! Bugfix: add cpp options
-!
-! 3727 2019-02-08 14:52:10Z gronemeier
-! Enable NetCDF output for surface data (suehring, gronemeier)
-!
-! 3691 2019-01-23 09:57:04Z suehring
-! Add output of surface-parallel flow speed
-!
-! 3648 2019-01-02 16:35:46Z suehring
-! Rename module and subroutines
-! 3420 2018-10-24 17:30:08Z gronemeier
-! Initial implementation from Klaus Ketelsen and Matthias Suehring
-!
-!
-! Authors:
-! --------
-! @author Klaus Ketelsen, Matthias Suehring, Tobias Gronemeier
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Generate output for surface data.
-!>
-!> @todo Create namelist file for post-processing tool.
-!--------------------------------------------------------------------------------------------------!
-
-MODULE surface_data_output_mod
-
-   USE kinds
-
-   USE arrays_3d,                                                                                  &
-       ONLY:  heatflux_output_conversion,                                                          &
-              momentumflux_output_conversion,                                                      &
-              waterflux_output_conversion,                                                         &
-              zu,                                                                                  &
-              zw
-
-   USE control_parameters,                                                                         &
-       ONLY:  coupling_char,                                                                       &
-              data_output_during_spinup,                                                           &
-              end_time,                                                                            &
-              message_string,                                                                      &
-              restart_data_format_output,                                                          &
-              run_description_header,                                                              &
-              simulated_time_at_begin,                                                             &
-              spinup_time,                                                                         &
-              surface_output
-
-   USE grid_variables,                                                                             &
-       ONLY: dx,                                                                                   &
-             dy
-
-   USE indices,                                                                                    &
-       ONLY: nxl,                                                                                  &
-             nxr,                                                                                  &
-             nys,                                                                                  &
-             nyn,                                                                                  &
-             nzb,                                                                                  &
-             nzt
-
-#if defined( __netcdf )
-   USE NETCDF
-#endif
-
-   USE netcdf_data_input_mod,                                                                      &
-       ONLY:  init_model
-
-   USE netcdf_interface,                                                                           &
-       ONLY:  nc_stat,                                                                             &
-              netcdf_create_att,                                                                   &
-              netcdf_create_dim,                                                                   &
-              netcdf_create_file,                                                                  &
-              netcdf_create_global_atts,                                                           &
-              netcdf_create_var,                                                                   &
-              netcdf_data_format,                                                                  &
-              netcdf_handle_error
-
-   USE pegrid
-
-   USE restart_data_mpi_io_mod,                                                                    &
-       ONLY:  rrd_mpi_io,                                                                          &
-              rd_mpi_io_check_array,                                                               &
-              rrd_mpi_io_surface,                                                                  &
-              rd_mpi_io_surface_filetypes,                                                         &
-              wrd_mpi_io,                                                                          &
-              wrd_mpi_io_surface
-
-   USE surface_mod,                                                                                &
-       ONLY:  ind_pav_green,                                                                       &
-              ind_veg_wall,                                                                        &
-              ind_wat_win,                                                                         &
-              surf_def_h,                                                                          &
-              surf_def_v,                                                                          &
-              surf_lsm_h,                                                                          &
-              surf_lsm_v,                                                                          &
-              surf_usm_h,                                                                          &
-              surf_usm_v
-
-   IMPLICIT NONE
-
-   TYPE surf_out                      !< data structure which contains all surfaces elements of all types on subdomain
-
-      INTEGER(iwp) ::  ns             !< number of surface elements on subdomain
-      INTEGER(iwp) ::  ns_total       !< total number of surface elements
-      INTEGER(iwp) ::  npoints        !< number of points / vertices which define a surface element (on subdomain)
-      INTEGER(iwp) ::  npoints_total  !< total number of points / vertices which define a surface element
-
-      INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  s  !< coordinate for NetCDF output, number of the surface element
-
-      REAL(wp) ::  fillvalue = -9999.0_wp  !< fillvalue for surface elements which are not defined
-
-      REAL(wp), DIMENSION(:), ALLOCATABLE   ::  azimuth   !< azimuth orientation coordinate for NetCDF output
-      REAL(wp), DIMENSION(:), ALLOCATABLE   ::  es_utm    !< E-UTM coordinate for NetCDF output
-      REAL(wp), DIMENSION(:), ALLOCATABLE   ::  ns_utm    !< E-UTM coordinate for NetCDF output
-      REAL(wp), DIMENSION(:), ALLOCATABLE   ::  xs        !< x-coordinate for NetCDF output
-      REAL(wp), DIMENSION(:), ALLOCATABLE   ::  ys        !< y-coordinate for NetCDF output
-      REAL(wp), DIMENSION(:), ALLOCATABLE   ::  zs        !< z-coordinate for NetCDF output
-      REAL(wp), DIMENSION(:), ALLOCATABLE   ::  zenith    !< zenith orientation coordinate for NetCDF output
-      REAL(wp), DIMENSION(:), ALLOCATABLE   ::  var_out   !< output variable
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_av    !< variable used for averaging
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  points    !< points  / vertices of a surface element
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  polygons  !< polygon data of a surface element
-   END TYPE surf_out
-
-   CHARACTER(LEN=100), DIMENSION(300)     ::  data_output_surf = ' '  !< namelist variable which describes the output variables
-   CHARACTER(LEN=100), DIMENSION(0:1,300) ::  dosurf = ' '            !< internal variable which describes the output variables
-                                                                      !< and separates averaged from non-averaged output
-   CHARACTER(LEN=100), DIMENSION(0:1,300) ::  dosurf_unit = ' '       !< internal variable which holds the unit of the given output
-                                                                      !< variable
-
-   INTEGER(iwp) ::  average_count_surf = 0  !< number of ensemble members used for averaging
-   INTEGER(iwp) ::  dosurf_no(0:1)     = 0  !< number of surface output quantities
-#if defined( __netcdf4_parallel )
-   INTEGER(iwp) ::  oldmode                 !< save old set-fill-mode of netcdf file (not needed, but required for routine call)
-
-   INTEGER(iwp), DIMENSION(0:1) ::  dosurf_time_count = 0  !< count of output time steps
-   INTEGER(iwp), DIMENSION(0:1) ::  id_dim_s_surf          !< netcdf ID for dimension s
-   INTEGER(iwp), DIMENSION(0:1) ::  id_dim_time_surf       !< netcdf ID for dimension time
-   INTEGER(iwp), DIMENSION(0:1) ::  id_set_surf            !< netcdf ID for file
-   INTEGER(iwp), DIMENSION(0:1) ::  id_var_azimuth_surf    !< netcdf ID for variable azimuth
-   INTEGER(iwp), DIMENSION(0:1) ::  id_var_etum_surf       !< netcdf ID for variable Es_UTM
-   INTEGER(iwp), DIMENSION(0:1) ::  id_var_nutm_surf       !< netcdf ID for variable Ns_UTM
-   INTEGER(iwp), DIMENSION(0:1) ::  id_var_time_surf       !< netcdf ID for variable time
-   INTEGER(iwp), DIMENSION(0:1) ::  id_var_s_surf          !< netcdf ID for variable s
-   INTEGER(iwp), DIMENSION(0:1) ::  id_var_xs_surf         !< netcdf ID for variable xs
-   INTEGER(iwp), DIMENSION(0:1) ::  id_var_ys_surf         !< netcdf ID for variable ys
-   INTEGER(iwp), DIMENSION(0:1) ::  id_var_zenith_surf     !< netcdf ID for variable zenith
-   INTEGER(iwp), DIMENSION(0:1) ::  id_var_zs_surf         !< netcdf ID for variable zs
-   INTEGER(iwp), DIMENSION(0:1) ::  ntdim_surf             !< number of output time steps
-
-   INTEGER(iwp), DIMENSION(0:1,300) ::  id_var_dosurf      !< netcdf ID for output variables
-#endif
-
-   LOGICAL ::  first_output(0:1) = .FALSE.  !< true if first output was already called
-   LOGICAL ::  to_netcdf         = .FALSE.  !< flag indicating parallel NetCDF output
-   LOGICAL ::  to_vtk            = .FALSE.  !< flag indicating binary surface-data output that can be further
-                                            !< processed to VTK format
-
-   REAL(wp) ::  averaging_interval_surf  = 9999999.9_wp  !< averaging interval
-   REAL(wp) ::  dt_dosurf                = 9999999.9_wp  !< time interval for instantaneous data output
-   REAL(wp) ::  dt_dosurf_av             = 9999999.9_wp  !< time interval for averaged data output
-   REAL(wp) ::  skip_time_dosurf         = 0.0_wp        !< skip time for instantaneous data output
-   REAL(wp) ::  skip_time_dosurf_av      = 0.0_wp        !< skip time for averaged data output
-   REAL(wp) ::  time_dosurf              = 0.0_wp        !< internal counter variable to check for instantaneous data output
-   REAL(wp) ::  time_dosurf_av           = 0.0_wp        !< internal counter variable to check for averaged data output
-
-   TYPE(surf_out) ::  surfaces  !< variable which contains all required output information
-
-   SAVE
-
-   PRIVATE
-
-   INTERFACE  surface_data_output
-      MODULE PROCEDURE surface_data_output
-   END INTERFACE  surface_data_output
-
-   INTERFACE  surface_data_output_averaging
-      MODULE PROCEDURE surface_data_output_averaging
-   END INTERFACE  surface_data_output_averaging
-
-   INTERFACE  surface_data_output_check_parameters
-      MODULE PROCEDURE surface_data_output_check_parameters
-   END INTERFACE  surface_data_output_check_parameters
-
-   INTERFACE  surface_data_output_init
-      MODULE PROCEDURE surface_data_output_init
-   END INTERFACE  surface_data_output_init
-
-   INTERFACE  surface_data_output_init_arrays
-      MODULE PROCEDURE surface_data_output_init_arrays
-   END INTERFACE  surface_data_output_init_arrays
-
-   INTERFACE  surface_data_output_last_action
-      MODULE PROCEDURE surface_data_output_last_action
-   END INTERFACE  surface_data_output_last_action
-
-   INTERFACE  surface_data_output_parin
-      MODULE PROCEDURE surface_data_output_parin
-   END INTERFACE  surface_data_output_parin
-
-   INTERFACE  surface_data_output_rrd_global
-      MODULE PROCEDURE surface_data_output_rrd_global_ftn
-      MODULE PROCEDURE surface_data_output_rrd_global_mpi
-   END INTERFACE  surface_data_output_rrd_global
-
-   INTERFACE  surface_data_output_rrd_local
-      MODULE PROCEDURE surface_data_output_rrd_local_ftn
-      MODULE PROCEDURE surface_data_output_rrd_local_mpi
-   END INTERFACE  surface_data_output_rrd_local
-
-   INTERFACE  surface_data_output_wrd_global
-      MODULE PROCEDURE surface_data_output_wrd_global
-   END INTERFACE  surface_data_output_wrd_global
-
-   INTERFACE  surface_data_output_wrd_local
-      MODULE PROCEDURE surface_data_output_wrd_local
-   END INTERFACE  surface_data_output_wrd_local
-
-   INTERFACE  surface_data_output_sum_up
-      MODULE PROCEDURE surface_data_output_sum_up_1d
-      MODULE PROCEDURE surface_data_output_sum_up_2d
-   END INTERFACE  surface_data_output_sum_up
-
-   INTERFACE  surface_data_output_collect
-      MODULE PROCEDURE surface_data_output_collect_1d
-      MODULE PROCEDURE surface_data_output_collect_2d
-   END INTERFACE  surface_data_output_collect
-
-!
-!--Public subroutines
-   PUBLIC surface_data_output,                                                                     &
-          surface_data_output_averaging,                                                           &
-          surface_data_output_check_parameters,                                                    &
-          surface_data_output_init,                                                                &
-          surface_data_output_init_arrays,                                                         &
-          surface_data_output_last_action,                                                         &
-          surface_data_output_parin,                                                               &
-          surface_data_output_rrd_global,                                                          &
-          surface_data_output_rrd_local,                                                           &
-          surface_data_output_wrd_local,                                                           &
-          surface_data_output_wrd_global
-!
-!--Public variables
-   PUBLIC average_count_surf,                                                                      &
-          averaging_interval_surf,                                                                 &
-          dt_dosurf,                                                                               &
-          dt_dosurf_av,                                                                            &
-          skip_time_dosurf,                                                                        &
-          skip_time_dosurf_av,                                                                     &
-          time_dosurf,                                                                             &
-          time_dosurf_av
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine counts the number of surfaces on each core and allocates arrays.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_init_arrays
-
-    IMPLICIT NONE
-
-!
-!-- Determine the number of surface elements on subdomain
-    surfaces%ns = surf_def_h(0)%ns + surf_lsm_h(0)%ns + surf_usm_h(0)%ns     & !horizontal upward-facing
-                + surf_def_h(1)%ns + surf_lsm_h(1)%ns + surf_usm_h(1)%ns     & !horizontal downard-facing
-                + surf_def_v(0)%ns + surf_lsm_v(0)%ns + surf_usm_v(0)%ns     & !northward-facing
-                + surf_def_v(1)%ns + surf_lsm_v(1)%ns + surf_usm_v(1)%ns     & !southward-facing
-                + surf_def_v(2)%ns + surf_lsm_v(2)%ns + surf_usm_v(2)%ns     & !westward-facing
-                + surf_def_v(3)%ns + surf_lsm_v(3)%ns + surf_usm_v(3)%ns       !eastward-facing
-!
-!--  Determine the total number of surfaces in the model domain
-#if defined( __parallel )
-     CALL MPI_ALLREDUCE( surfaces%ns, surfaces%ns_total, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-     surfaces%ns_total = surfaces%ns
-#endif
-!
-!-- Allocate output variable and set to _FillValue attribute
-    ALLOCATE ( surfaces%var_out(1:surfaces%ns) )
-    surfaces%var_out = surfaces%fillvalue
-!
-!-- If there is an output of time average output variables, allocate the required array.
-    IF ( dosurf_no(1) > 0 )  THEN
-       ALLOCATE ( surfaces%var_av(1:surfaces%ns,1:dosurf_no(1)) )
-       surfaces%var_av = 0.0_wp
-    ENDIF
-
- END SUBROUTINE surface_data_output_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization surface-data output data structure: calculation of vertices and polygon data for
-!> the surface elements, allocation of required arrays.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_init
-
-    IMPLICIT NONE
-
-#if defined( __netcdf4_parallel )
-    CHARACTER (LEN=100)  ::  filename           !< name of output file
-    CHARACTER (LEN=80)   ::  time_average_text  !< string written to file attribute time_avg
-    CHARACTER (LEN=4000) ::  var_list           !< list of variables written to NetCDF file
-
-    INTEGER(iwp) ::  av                 !< flag for averaged (=1) and non-averaged (=0) data
-#endif
-    INTEGER(iwp) ::  i                  !< grid index in x-direction, also running variable for counting non-average data output
-    INTEGER(iwp) ::  j                  !< grid index in y-direction, also running variable for counting average data output
-    INTEGER(iwp) ::  k                  !< grid index in z-direction
-    INTEGER(iwp) ::  l                  !< running index for surface-element orientation
-    INTEGER(iwp) ::  m                  !< running index for surface elements
-    INTEGER(iwp) ::  mm                 !< local counting variable for surface elements
-    INTEGER(iwp) ::  npg                !< counter variable for all surface elements ( or polygons )
-    INTEGER(iwp) ::  point_index_count  !< local counter variable for point index
-    INTEGER(iwp) ::  start_count        !< local start counter for the surface index
-
-    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  num_points_on_pe    !< array which contains the number of points on all mpi ranks
-    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  num_surfaces_on_pe  !< array which contains the number of surfaces on all mpi ranks
-    INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:,:) ::  point_index   !< dummy array used to check where the reference points for
-                                                                  !< surface polygons are located
-
-    REAL(wp) ::  az     !< azimuth angle, indicated the vertical orientation of a surface element
-    REAL(wp) ::  off_x  !< grid offset in x-direction between the stored grid index and the actual wall
-    REAL(wp) ::  off_y  !< grid offset in y-direction between the stored grid index and the actual wall
-#if defined( __netcdf4_parallel )
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  netcdf_data_1d  !< dummy array to output 1D data into netcdf file
-#endif
-
-!
-!-- If output to VTK format is enabled, initialize point and polygon data.
-!-- In a first step, count the number of points which are defining the surfaces and the polygons.
-    IF ( to_vtk )  THEN
-       ALLOCATE( point_index(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
-       point_index = -1
-!
-!--    Horizontal default surfaces
-       surfaces%npoints = 0
-       DO  l = 0, 1
-          DO  m = 1, surf_def_h(l)%ns
-!
-!--          Determine the indices of the respective grid cell inside the topography
-             i = surf_def_h(l)%i(m) + surf_def_h(l)%ioff
-             j = surf_def_h(l)%j(m) + surf_def_h(l)%joff
-             k = surf_def_h(l)%k(m) + surf_def_h(l)%koff
-!
-!--          Check if the vertices that define the surface element are already defined, if not,
-!--          increment the counter.
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = surfaces%npoints - 1
-             ENDIF
-             IF ( point_index(k,j,i+1) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j,i+1) = surfaces%npoints - 1
-             ENDIF
-             IF ( point_index(k,j+1,i+1) < 0 )  THEN
-                surfaces%npoints       = surfaces%npoints + 1
-                point_index(k,j+1,i+1) = surfaces%npoints - 1
-             ENDIF
-             IF ( point_index(k,j+1,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j+1,i) = surfaces%npoints - 1
-             ENDIF
-          ENDDO
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m) + surf_lsm_h(l)%ioff
-             j = surf_lsm_h(l)%j(m) + surf_lsm_h(l)%joff
-             k = surf_lsm_h(l)%k(m) + surf_lsm_h(l)%koff
-
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = surfaces%npoints - 1
-             ENDIF
-             IF ( point_index(k,j,i+1) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j,i+1) = surfaces%npoints - 1
-             ENDIF
-             IF ( point_index(k,j+1,i+1) < 0 )  THEN
-                surfaces%npoints       = surfaces%npoints + 1
-                point_index(k,j+1,i+1) = surfaces%npoints - 1
-             ENDIF
-             IF ( point_index(k,j+1,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j+1,i) = surfaces%npoints - 1
-             ENDIF
-          ENDDO
-          DO  m = 1, surf_usm_h(l)%ns
-             i = surf_usm_h(l)%i(m) + surf_usm_h(l)%ioff
-             j = surf_usm_h(l)%j(m) + surf_usm_h(l)%joff
-             k = surf_usm_h(l)%k(m) + surf_usm_h(l)%koff
-
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = surfaces%npoints - 1
-             ENDIF
-             IF ( point_index(k,j,i+1) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j,i+1) = surfaces%npoints - 1
-             ENDIF
-             IF ( point_index(k,j+1,i+1) < 0 )  THEN
-                surfaces%npoints       = surfaces%npoints + 1
-                point_index(k,j+1,i+1) = surfaces%npoints - 1
-             ENDIF
-             IF ( point_index(k,j+1,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j+1,i) = surfaces%npoints - 1
-             ENDIF
-          ENDDO
-       ENDDO
-!
-!--    Vertical surfaces
-       DO  l = 0, 3
-          DO  m = 1, surf_def_v(l)%ns
-!
-!--          Determine the indices of the respective grid cell inside the topography. Please note,
-!--          j-index for north-facing surfaces ( l==0 ) is identical to the reference j-index
-!--          outside the grid box. Equivalent for east-facing surfaces and i-index.
-             i = surf_def_v(l)%i(m) + MERGE( surf_def_v(l)%ioff, 0, l == 3 )
-             j = surf_def_v(l)%j(m) + MERGE( surf_def_v(l)%joff, 0, l == 1 )
-             k = surf_def_v(l)%k(m) + surf_def_v(l)%koff
-!
-!--          Lower left /front vertex
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = surfaces%npoints - 1
-             ENDIF
-!
-!--          Upper / lower right index for north- and south-facing surfaces
-             IF ( l == 0  .OR.  l == 1 )  THEN
-                IF ( point_index(k,j,i+1) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j,i+1) = surfaces%npoints - 1
-                ENDIF
-                IF ( point_index(k+1,j,i+1) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j,i+1) = surfaces%npoints - 1
-                ENDIF
-!
-!--          Upper / lower front index for east- and west-facing surfaces
-             ELSEIF ( l == 2  .OR.  l == 3 )  THEN
-                IF ( point_index(k,j+1,i) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j+1,i) = surfaces%npoints - 1
-                ENDIF
-                IF ( point_index(k+1,j+1,i) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j+1,i) = surfaces%npoints - 1
-                ENDIF
-             ENDIF
-!
-!--          Upper left / front vertex
-             IF ( point_index(k+1,j,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k+1,j,i) = surfaces%npoints - 1
-             ENDIF
-          ENDDO
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( surf_lsm_v(l)%ioff, 0, l == 3 )
-             j = surf_lsm_v(l)%j(m) + MERGE( surf_lsm_v(l)%joff, 0, l == 1 )
-             k = surf_lsm_v(l)%k(m) + surf_lsm_v(l)%koff
-!
-!--          Lower left /front vertex
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = surfaces%npoints - 1
-             ENDIF
-!
-!--          Upper / lower right index for north- and south-facing surfaces
-             IF ( l == 0  .OR.  l == 1 )  THEN
-                IF ( point_index(k,j,i+1) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j,i+1) = surfaces%npoints - 1
-                ENDIF
-                IF ( point_index(k+1,j,i+1) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j,i+1) = surfaces%npoints - 1
-                ENDIF
-!
-!--          Upper / lower front index for east- and west-facing surfaces
-             ELSEIF ( l == 2  .OR.  l == 3 )  THEN
-                IF ( point_index(k,j+1,i) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j+1,i) = surfaces%npoints - 1
-                ENDIF
-                IF ( point_index(k+1,j+1,i) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j+1,i) = surfaces%npoints - 1
-                ENDIF
-             ENDIF
-!
-!--          Upper left / front vertex
-             IF ( point_index(k+1,j,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k+1,j,i) = surfaces%npoints - 1
-             ENDIF
-          ENDDO
-
-          DO  m = 1, surf_usm_v(l)%ns
-             i = surf_usm_v(l)%i(m) + MERGE( surf_usm_v(l)%ioff, 0, l == 3 )
-             j = surf_usm_v(l)%j(m) + MERGE( surf_usm_v(l)%joff, 0, l == 1 )
-             k = surf_usm_v(l)%k(m) + surf_usm_v(l)%koff
-!
-!--          Lower left /front vertex
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = surfaces%npoints - 1
-             ENDIF
-!
-!--          Upper / lower right index for north- and south-facing surfaces
-             IF ( l == 0  .OR.  l == 1 )  THEN
-                IF ( point_index(k,j,i+1) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j,i+1) = surfaces%npoints - 1
-                ENDIF
-                IF ( point_index(k+1,j,i+1) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j,i+1) = surfaces%npoints - 1
-                ENDIF
-!
-!--          Upper / lower front index for east- and west-facing surfaces
-             ELSEIF ( l == 2  .OR.  l == 3 )  THEN
-                IF ( point_index(k,j+1,i) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j+1,i) = surfaces%npoints - 1
-                ENDIF
-                IF ( point_index(k+1,j+1,i) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j+1,i) = surfaces%npoints - 1
-                ENDIF
-             ENDIF
-!
-!--          Upper left / front vertex
-             IF ( point_index(k+1,j,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k+1,j,i) = surfaces%npoints - 1
-             ENDIF
-          ENDDO
-
-       ENDDO
-!
-!--    Allocate the number of points and polygons. Note, the number of polygons is identical to the
-!--    number of surfaces elements, whereas the number of points (vertices), which define the
-!--    polygons, can be larger.
-       ALLOCATE( surfaces%points(3,1:surfaces%npoints) )
-       ALLOCATE( surfaces%polygons(5,1:surfaces%ns)    )
-!
-!--    Note, PARAVIEW expects consecutively ordered points, in order to unambiguously identify
-!--    surfaces. Hence, all PEs should know where they start counting, depending on the number of
-!--    points on the other PE's with lower MPI rank.
-#if defined( __parallel )
-       CALL MPI_ALLGATHER( surfaces%npoints, 1, MPI_INTEGER, num_points_on_pe, 1, MPI_INTEGER,     &
-                           comm2d, ierr  )
-#else
-       num_points_on_pe = surfaces%npoints
-#endif
-
-!
-!--    After the number of vertices is counted, repeat the loops and define the vertices. Start with
-!--    the horizontal default surfaces. First, however, determine the offset where couting of points
-!--    should be started, which is the sum of points of all PE's with lower MPI rank.
-       i                 = 0
-       point_index_count = 0
-       DO WHILE  ( i < myid  .AND.  i <= SIZE( num_points_on_pe ) )
-          point_index_count = point_index_count + num_points_on_pe(i)
-          i                 = i + 1
-       ENDDO
-
-       surfaces%npoints = 0
-       point_index      = -1
-       npg              = 0
-
-       DO  l = 0, 1
-          DO  m = 1, surf_def_h(l)%ns
-!
-!--          Determine the indices of the respective grid cell inside the topography.
-             i = surf_def_h(l)%i(m) + surf_def_h(l)%ioff
-             j = surf_def_h(l)%j(m) + surf_def_h(l)%joff
-             k = surf_def_h(l)%k(m) + surf_def_h(l)%koff
-!
-!--          Check if the vertices that define the surface element are already defined, if not,
-!--          increment the counter.
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = point_index_count
-                point_index_count  = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-             IF ( point_index(k,j,i+1) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j,i+1) = point_index_count
-                point_index_count    = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j     - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-             IF ( point_index(k,j+1,i+1) < 0 )  THEN
-                surfaces%npoints       = surfaces%npoints + 1
-                point_index(k,j+1,i+1) = point_index_count
-                point_index_count      = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-             IF ( point_index(k,j+1,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j+1,i) = point_index_count
-                point_index_count    = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i     - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-
-             npg                        = npg + 1
-             surfaces%polygons(1,npg)   = 4
-             surfaces%polygons(2,npg)   = point_index(k,j,i)
-             surfaces%polygons(3,npg)   = point_index(k,j,i+1)
-             surfaces%polygons(4,npg)   = point_index(k,j+1,i+1)
-             surfaces%polygons(5,npg)   = point_index(k,j+1,i)
-          ENDDO
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m) + surf_lsm_h(l)%ioff
-             j = surf_lsm_h(l)%j(m) + surf_lsm_h(l)%joff
-             k = surf_lsm_h(l)%k(m) + surf_lsm_h(l)%koff
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = point_index_count
-                point_index_count  = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-             IF ( point_index(k,j,i+1) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j,i+1) = point_index_count
-                point_index_count    = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j     - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-             IF ( point_index(k,j+1,i+1) < 0 )  THEN
-                surfaces%npoints       = surfaces%npoints + 1
-                point_index(k,j+1,i+1) = point_index_count
-                point_index_count      = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-             IF ( point_index(k,j+1,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j+1,i) = point_index_count
-                point_index_count    = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i     - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-
-             npg                        = npg + 1
-             surfaces%polygons(1,npg)   = 4
-             surfaces%polygons(2,npg)   = point_index(k,j,i)
-             surfaces%polygons(3,npg)   = point_index(k,j,i+1)
-             surfaces%polygons(4,npg)   = point_index(k,j+1,i+1)
-             surfaces%polygons(5,npg)   = point_index(k,j+1,i)
-          ENDDO
-
-          DO  m = 1, surf_usm_h(l)%ns
-             i = surf_usm_h(l)%i(m) + surf_usm_h(l)%ioff
-             j = surf_usm_h(l)%j(m) + surf_usm_h(l)%joff
-             k = surf_usm_h(l)%k(m) + surf_usm_h(l)%koff
-
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = point_index_count
-                point_index_count  = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-             IF ( point_index(k,j,i+1) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j,i+1) = point_index_count
-                point_index_count    = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j     - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-             IF ( point_index(k,j+1,i+1) < 0 )  THEN
-                surfaces%npoints       = surfaces%npoints + 1
-                point_index(k,j+1,i+1) = point_index_count
-                point_index_count      = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-             IF ( point_index(k,j+1,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k,j+1,i) = point_index_count
-                point_index_count    = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i     - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-
-             npg                        = npg + 1
-             surfaces%polygons(1,npg)   = 4
-             surfaces%polygons(2,npg)   = point_index(k,j,i)
-             surfaces%polygons(3,npg)   = point_index(k,j,i+1)
-             surfaces%polygons(4,npg)   = point_index(k,j+1,i+1)
-             surfaces%polygons(5,npg)   = point_index(k,j+1,i)
-          ENDDO
-       ENDDO
-
-       DO  l = 0, 3
-          DO  m = 1, surf_def_v(l)%ns
-!
-!--          Determine the indices of the respective grid cell inside the topography.
-!--          NOTE, j-index for north-facing surfaces ( l==0 ) is identical to the reference j-index
-!--          outside the grid box. Equivalent for east-facing surfaces and i-index.
-             i = surf_def_v(l)%i(m) + MERGE( surf_def_v(l)%ioff, 0, l == 3 )
-             j = surf_def_v(l)%j(m) + MERGE( surf_def_v(l)%joff, 0, l == 1 )
-             k = surf_def_v(l)%k(m) + surf_def_v(l)%koff
-!
-!--          Lower left /front vertex
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = point_index_count
-                point_index_count  = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k-1)
-             ENDIF
-!
-!--          Upper / lower right index for north- and south-facing surfaces
-             IF ( l == 0  .OR.  l == 1 )  THEN
-                IF ( point_index(k,j,i+1) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j,i+1) = point_index_count
-                   point_index_count    = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j     - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k-1)
-                ENDIF
-                IF ( point_index(k+1,j,i+1) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j,i+1) = point_index_count
-                   point_index_count      = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j     - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k)
-                ENDIF
-!
-!--          Upper / lower front index for east- and west-facing surfaces
-             ELSEIF ( l == 2  .OR.  l == 3 )  THEN
-                IF ( point_index(k,j+1,i) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j+1,i) = point_index_count
-                   point_index_count    = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i     - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k-1)
-                ENDIF
-                IF ( point_index(k+1,j+1,i) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j+1,i) = point_index_count
-                   point_index_count      = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i     - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k)
-                ENDIF
-             ENDIF
-!
-!--          Upper left / front vertex
-             IF ( point_index(k+1,j,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k+1,j,i) = point_index_count
-                point_index_count    = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-
-             npg = npg + 1
-             IF ( l == 0  .OR.  l == 1 )  THEN
-                surfaces%polygons(1,npg)   = 4
-                surfaces%polygons(2,npg)   = point_index(k,j,i)
-                surfaces%polygons(3,npg)   = point_index(k,j,i+1)
-                surfaces%polygons(4,npg)   = point_index(k+1,j,i+1)
-                surfaces%polygons(5,npg)   = point_index(k+1,j,i)
-             ELSE
-                surfaces%polygons(1,npg)   = 4
-                surfaces%polygons(2,npg)   = point_index(k,j,i)
-                surfaces%polygons(3,npg)   = point_index(k,j+1,i)
-                surfaces%polygons(4,npg)   = point_index(k+1,j+1,i)
-                surfaces%polygons(5,npg)   = point_index(k+1,j,i)
-             ENDIF
-
-          ENDDO
-
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m) + MERGE( surf_lsm_v(l)%ioff, 0, l == 3 )
-             j = surf_lsm_v(l)%j(m) + MERGE( surf_lsm_v(l)%joff, 0, l == 1 )
-             k = surf_lsm_v(l)%k(m) + surf_lsm_v(l)%koff
-!
-!--          Lower left /front vertex
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = point_index_count
-                point_index_count  = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k-1)
-             ENDIF
-!
-!--          Upper / lower right index for north- and south-facing surfaces
-             IF ( l == 0  .OR.  l == 1 )  THEN
-                IF ( point_index(k,j,i+1) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j,i+1) = point_index_count
-                   point_index_count    = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j     - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k-1)
-                ENDIF
-                IF ( point_index(k+1,j,i+1) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j,i+1) = point_index_count
-                   point_index_count      = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j     - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k)
-                ENDIF
-!
-!--          Upper / lower front index for east- and west-facing surfaces
-             ELSEIF ( l == 2  .OR.  l == 3 )  THEN
-                IF ( point_index(k,j+1,i) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j+1,i) = point_index_count
-                   point_index_count    = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i     - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k-1)
-                ENDIF
-                IF ( point_index(k+1,j+1,i) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j+1,i) = point_index_count
-                   point_index_count      = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i     - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k)
-                ENDIF
-             ENDIF
-!
-!--          Upper left / front vertex
-             IF ( point_index(k+1,j,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k+1,j,i) = point_index_count
-                point_index_count    = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-
-             npg = npg + 1
-             IF ( l == 0  .OR.  l == 1 )  THEN
-                surfaces%polygons(1,npg)   = 4
-                surfaces%polygons(2,npg)   = point_index(k,j,i)
-                surfaces%polygons(3,npg)   = point_index(k,j,i+1)
-                surfaces%polygons(4,npg)   = point_index(k+1,j,i+1)
-                surfaces%polygons(5,npg)   = point_index(k+1,j,i)
-             ELSE
-                surfaces%polygons(1,npg)   = 4
-                surfaces%polygons(2,npg)   = point_index(k,j,i)
-                surfaces%polygons(3,npg)   = point_index(k,j+1,i)
-                surfaces%polygons(4,npg)   = point_index(k+1,j+1,i)
-                surfaces%polygons(5,npg)   = point_index(k+1,j,i)
-             ENDIF
-          ENDDO
-          DO  m = 1, surf_usm_v(l)%ns
-             i = surf_usm_v(l)%i(m) + MERGE( surf_usm_v(l)%ioff, 0, l == 3 )
-             j = surf_usm_v(l)%j(m) + MERGE( surf_usm_v(l)%joff, 0, l == 1 )
-             k = surf_usm_v(l)%k(m) + surf_usm_v(l)%koff
-!
-!--          Lower left /front vertex
-             IF ( point_index(k,j,i) < 0 )  THEN
-                surfaces%npoints   = surfaces%npoints + 1
-                point_index(k,j,i) = point_index_count
-                point_index_count  = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k-1)
-             ENDIF
-!
-!--          Upper / lower right index for north- and south-facing surfaces
-             IF ( l == 0  .OR.  l == 1 )  THEN
-                IF ( point_index(k,j,i+1) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j,i+1) = point_index_count
-                   point_index_count    = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j     - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k-1)
-                ENDIF
-                IF ( point_index(k+1,j,i+1) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j,i+1) = point_index_count
-                   point_index_count      = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i + 1 - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j     - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k)
-                ENDIF
-!
-!--          Upper / lower front index for east- and west-facing surfaces
-             ELSEIF ( l == 2  .OR.  l == 3 )  THEN
-                IF ( point_index(k,j+1,i) < 0 )  THEN
-                   surfaces%npoints     = surfaces%npoints + 1
-                   point_index(k,j+1,i) = point_index_count
-                   point_index_count    = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i     - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k-1)
-                ENDIF
-                IF ( point_index(k+1,j+1,i) < 0 )  THEN
-                   surfaces%npoints       = surfaces%npoints + 1
-                   point_index(k+1,j+1,i) = point_index_count
-                   point_index_count      = point_index_count + 1
-                   surfaces%points(1,surfaces%npoints) = ( i     - 0.5_wp ) * dx
-                   surfaces%points(2,surfaces%npoints) = ( j + 1 - 0.5_wp ) * dy
-                   surfaces%points(3,surfaces%npoints) = zw(k)
-                ENDIF
-             ENDIF
-!
-!--          Upper left / front vertex
-             IF ( point_index(k+1,j,i) < 0 )  THEN
-                surfaces%npoints     = surfaces%npoints + 1
-                point_index(k+1,j,i) = point_index_count
-                point_index_count    = point_index_count + 1
-                surfaces%points(1,surfaces%npoints) = ( i - 0.5_wp ) * dx
-                surfaces%points(2,surfaces%npoints) = ( j - 0.5_wp ) * dy
-                surfaces%points(3,surfaces%npoints) = zw(k)
-             ENDIF
-
-             npg = npg + 1
-             IF ( l == 0  .OR.  l == 1 )  THEN
-                surfaces%polygons(1,npg)   = 4
-                surfaces%polygons(2,npg)   = point_index(k,j,i)
-                surfaces%polygons(3,npg)   = point_index(k,j,i+1)
-                surfaces%polygons(4,npg)   = point_index(k+1,j,i+1)
-                surfaces%polygons(5,npg)   = point_index(k+1,j,i)
-             ELSE
-                surfaces%polygons(1,npg)   = 4
-                surfaces%polygons(2,npg)   = point_index(k,j,i)
-                surfaces%polygons(3,npg)   = point_index(k,j+1,i)
-                surfaces%polygons(4,npg)   = point_index(k+1,j+1,i)
-                surfaces%polygons(5,npg)   = point_index(k+1,j,i)
-             ENDIF
-          ENDDO
-
-       ENDDO
-!
-!--    Deallocate temporary dummy variable
-       DEALLOCATE ( point_index )
-!
-!--    Sum-up total number of vertices on domain. This will be needed for post-processing.
-       surfaces%npoints_total = 0
-#if defined( __parallel )
-        CALL MPI_ALLREDUCE( surfaces%npoints, surfaces%npoints_total, 1, MPI_INTEGER, MPI_SUM,     &
-                            comm2d, ierr )
-#else
-        surfaces%npoints_total = surfaces%npoints
-#endif
-     ENDIF
-!
-!--  If output to netcdf is enabled, set-up the coordinate arrays that unambiguously describe the
-!--  position and orientation of each surface element.
-     IF ( to_netcdf )  THEN
-!
-!--     Allocate local coordinate arrays
-        ALLOCATE( surfaces%s(1:surfaces%ns)       )
-        ALLOCATE( surfaces%xs(1:surfaces%ns)      )
-        ALLOCATE( surfaces%ys(1:surfaces%ns)      )
-        ALLOCATE( surfaces%zs(1:surfaces%ns)      )
-        ALLOCATE( surfaces%azimuth(1:surfaces%ns) )
-        ALLOCATE( surfaces%zenith(1:surfaces%ns)  )
-        ALLOCATE( surfaces%es_utm(1:surfaces%ns)  )
-        ALLOCATE( surfaces%ns_utm(1:surfaces%ns)  )
-!
-!--     Gather the number of surface on each processor, in order to number the surface elements in
-!--     ascending order with respect to the total number of surfaces in the domain.
-#if defined( __parallel )
-        CALL MPI_ALLGATHER( surfaces%ns, 1, MPI_INTEGER, num_surfaces_on_pe, 1, MPI_INTEGER,       &
-                            comm2d, ierr  )
-#else
-        num_surfaces_on_pe = surfaces%ns
-#endif
-!
-!--     First, however, determine the offset where couting of the surfaces should start (the sum of
-!--     surfaces on all PE's with lower MPI rank).
-        i           = 0
-        start_count = 1
-        DO WHILE  ( i < myid  .AND.  i <= SIZE( num_surfaces_on_pe ) )
-           start_count = start_count + num_surfaces_on_pe(i)
-           i           = i + 1
-        ENDDO
-!
-!--     Set coordinate arrays. For horizontal surfaces, azimuth angles are not defined (fill value).
-!--     Zenith angle is 0 (180) for upward (downward)-facing surfaces.
-        i  = start_count
-        mm = 1
-        DO l = 0, 1
-           DO  m = 1, surf_def_h(l)%ns
-              surfaces%s(mm)       = i
-              surfaces%xs(mm)      = ( surf_def_h(l)%i(m) + 0.5_wp ) * dx
-              surfaces%ys(mm)      = ( surf_def_h(l)%j(m) + 0.5_wp ) * dy
-              surfaces%zs(mm)      = zw(surf_def_h(l)%k(m)+surf_def_h(l)%koff)
-              surfaces%azimuth(mm) = surfaces%fillvalue
-              surfaces%zenith(mm)  = 180.0_wp * l
-              i                    = i + 1
-              mm                   = mm + 1
-           ENDDO
-           DO  m = 1, surf_lsm_h(l)%ns
-              surfaces%s(mm)       = i
-              surfaces%xs(mm)      = ( surf_lsm_h(l)%i(m) + 0.5_wp ) * dx
-              surfaces%ys(mm)      = ( surf_lsm_h(l)%j(m) + 0.5_wp ) * dy
-              surfaces%zs(mm)      = zw(surf_lsm_h(l)%k(m)+surf_lsm_h(l)%koff)
-              surfaces%azimuth(mm) = surfaces%fillvalue
-              surfaces%zenith(mm)  = 180.0_wp * l
-              i                    = i + 1
-              mm                   = mm + 1
-           ENDDO
-           DO  m = 1, surf_usm_h(l)%ns
-              surfaces%s(mm)       = i
-              surfaces%xs(mm)      = ( surf_usm_h(l)%i(m) + 0.5_wp ) * dx
-              surfaces%ys(mm)      = ( surf_usm_h(l)%j(m) + 0.5_wp ) * dy
-              surfaces%zs(mm)      = zw(surf_usm_h(l)%k(m)+surf_usm_h(l)%koff)
-              surfaces%azimuth(mm) = surfaces%fillvalue
-              surfaces%zenith(mm)  = 180.0_wp * l
-              i                    = i + 1
-              mm                   = mm + 1
-           ENDDO
-        ENDDO
-!
-!--     For vertical surfaces, zenith angles are not defined (fill value).
-!--     Azimuth angle: northward (0), eastward (90), southward (180), westward (270).
-!--     Note, for vertical surfaces, zenith angles are 90.0_wp.
-        DO  l = 0, 3
-           IF ( l == 0 )  THEN
-              az    = 0.0_wp
-              off_x = 0.5_wp
-              off_y = 0.0_wp
-           ELSEIF ( l == 1 )  THEN
-              az    = 180.0_wp
-              off_x = 0.5_wp
-              off_y = 1.0_wp
-           ELSEIF ( l == 2 )  THEN
-              az    = 90.0_wp
-              off_x = 0.0_wp
-              off_y = 0.5_wp
-           ELSEIF ( l == 3 )  THEN
-              az    = 270.0_wp
-              off_x = 1.0_wp
-              off_y = 0.5_wp
-           ENDIF
-
-           DO  m = 1, surf_def_v(l)%ns
-              surfaces%s(mm)       = i
-              surfaces%xs(mm)      = ( surf_def_v(l)%i(m) + off_x ) * dx
-              surfaces%ys(mm)      = ( surf_def_v(l)%j(m) + off_y ) * dy
-              surfaces%zs(mm)      = zu(surf_def_v(l)%k(m))
-              surfaces%azimuth(mm) = az
-              surfaces%zenith(mm)  = 90.0_wp
-              i                    = i + 1
-              mm                   = mm + 1
-           ENDDO
-           DO  m = 1, surf_lsm_v(l)%ns
-              surfaces%s(mm)       = i
-              surfaces%xs(mm)      = ( surf_lsm_v(l)%i(m) + off_x ) * dx
-              surfaces%ys(mm)      = ( surf_lsm_v(l)%j(m) + off_y ) * dy
-              surfaces%zs(mm)      = zu(surf_lsm_v(l)%k(m))
-              surfaces%azimuth(mm) = az
-              surfaces%zenith(mm)  = 90.0_wp
-              i                    = i + 1
-              mm                   = mm + 1
-           ENDDO
-           DO  m = 1, surf_usm_v(l)%ns
-              surfaces%s(mm)       = i
-              surfaces%xs(mm)      = ( surf_usm_v(l)%i(m) + off_x ) * dx
-              surfaces%ys(mm)      = ( surf_usm_v(l)%j(m) + off_y ) * dy
-              surfaces%zs(mm)      = zu(surf_usm_v(l)%k(m))
-              surfaces%azimuth(mm) = az
-              surfaces%zenith(mm)  = 90.0_wp
-              i                    = i + 1
-              mm                   = mm + 1
-           ENDDO
-        ENDDO
-!
-!--     Finally, define UTM coordinates, which are the x/y-coordinates plus the origin (lower-left
-!--     coordinate of the model domain).
-        surfaces%es_utm = surfaces%xs + init_model%origin_x
-        surfaces%ns_utm = surfaces%ys + init_model%origin_y
-!
-!--     Initialize NetCDF data output. Please note, local start position for the surface elements in
-!--     the NetCDF file is surfaces%s(1), while the number of surfaces on the subdomain is given by
-!--     surfaces%ns.
-#if defined( __netcdf4_parallel )
-
-!
-!--     Calculate number of time steps to be output
-        ntdim_surf(0) = dosurf_time_count(0) + CEILING( ( end_time - MAX(                          &
-                          MERGE( skip_time_dosurf, skip_time_dosurf + spinup_time,                 &
-                                 data_output_during_spinup ), simulated_time_at_begin )            &
-                                                        ) / dt_dosurf )
-
-        ntdim_surf(1) = dosurf_time_count(1) + CEILING( ( end_time - MAX(                          &
-                          MERGE( skip_time_dosurf_av, skip_time_dosurf_av + spinup_time,           &
-                                 data_output_during_spinup ), simulated_time_at_begin )            &
-                                                        ) / dt_dosurf_av )
-
-!
-!--     Create NetCDF4 files for parallel writing
-        DO  av = 0, 1
-!
-!--        If there is no instantaneous data (av=0) or averaged data (av=1) requested, do not create
-!--        the corresponding NetCDF file
-           IF ( dosurf_no(av) == 0 ) CYCLE
-
-           IF ( av == 0 )  THEN
-              filename = 'SURFACE_DATA_NETCDF' // TRIM( coupling_char )
-           ELSE
-              filename = 'SURFACE_DATA_AV_NETCDF' // TRIM( coupling_char )
-           ENDIF
-!
-!--        Open file using netCDF4/HDF5 format, parallel
-           nc_stat = NF90_CREATE( TRIM(filename),                                                  &
-                                  IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ),          &
-                                  id_set_surf(av), COMM = comm2d, INFO = MPI_INFO_NULL )
-           CALL netcdf_handle_error( 'surface_data_output_mod', 5550 )
-
-           !- Write some global attributes
-           IF ( av == 0 )  THEN
-              CALL netcdf_create_global_atts( id_set_surf(av), 'surface-data',                     &
-                                              TRIM( run_description_header ), 5551 )
-              time_average_text = ' '
-           ELSE
-              CALL netcdf_create_global_atts( id_set_surf(av), 'surface-data_av',                  &
-                                              TRIM( run_description_header ), 5552 )
-              WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval_surf
-              nc_stat = NF90_PUT_ATT( id_set_surf(av), NF90_GLOBAL, 'time_avg',                    &
-                                      TRIM( time_average_text ) )
-              CALL netcdf_handle_error( 'surface_data_output_mod', 5553 )
-           ENDIF
-
-
-!
-!--        Define time coordinate for surface data.
-!--        For parallel output the time dimension has to be limited (ntdim_surf), otherwise the
-!--        performance drops significantly.
-           CALL netcdf_create_dim( id_set_surf(av), 'time', ntdim_surf(av), id_dim_time_surf(av),  &
-                                   5554 )
-
-           CALL netcdf_create_var( id_set_surf(av), (/ id_dim_time_surf(av) /),                    &
-                                   'time', NF90_DOUBLE, id_var_time_surf(av),                      &
-                                   'seconds since '// TRIM(init_model%origin_time),                &
-                                   'time', 5555, 5555, 5555 )
-
-           CALL netcdf_create_att( id_set_surf(av), id_var_time_surf(av), 'standard_name', 'time', &
-                                   5556)
-
-           CALL netcdf_create_att( id_set_surf(av), id_var_time_surf(av), 'axis', 'T', 5557)
-!
-!--        Define spatial dimensions and coordinates:
-!--        Define index of surface element
-           CALL netcdf_create_dim( id_set_surf(av), 's', surfaces%ns_total, id_dim_s_surf(av),     &
-                                   5558 )
-           CALL netcdf_create_var( id_set_surf(av), (/ id_dim_s_surf(av) /), 's', NF90_DOUBLE,     &
-                                   id_var_s_surf(av), '1', 'number of surface element', 5559,      &
-                                   5559, 5559 )
-!
-!--        Define x coordinate
-           CALL netcdf_create_var( id_set_surf(av), (/ id_dim_s_surf(av) /), 'xs', NF90_DOUBLE,    &
-                                   id_var_xs_surf(av), 'meters',                                   &
-                                   'distance to origin in x-direction', 5561, 5561, 5561 )
-!
-!--         Define y coordinate
-           CALL netcdf_create_var( id_set_surf(av), (/ id_dim_s_surf(av) /), 'ys', NF90_DOUBLE,    &
-                                   id_var_ys_surf(av), 'meters',                                   &
-                                   'distance to origin in y-direction', 5562, 5562, 5562 )
-!
-!--        Define z coordinate
-           CALL netcdf_create_var( id_set_surf(av), (/ id_dim_s_surf(av) /), 'zs', NF90_DOUBLE,    &
-                                   id_var_zs_surf(av), 'meters', 'height', 5560, 5560, 5560 )
-           CALL netcdf_create_att( id_set_surf(av), id_var_zs_surf(av), 'standard_name', 'height', &
-                                   5583 )
-
-!
-!--        Define UTM coordinates
-           CALL netcdf_create_var( id_set_surf(av), (/ id_dim_s_surf(av) /), 'Es_UTM',             &
-                                   NF90_DOUBLE, id_var_etum_surf(av), 'meters', '', 5563, 5563,    &
-                                   5563 )
-           CALL netcdf_create_var( id_set_surf(av), (/ id_dim_s_surf(av) /), 'Ns_UTM',             &
-                                   NF90_DOUBLE, id_var_nutm_surf(av), 'meters', '', 5564, 5564,    &
-                                   5564 )
-
-!
-!--        Define angles
-           CALL netcdf_create_var( id_set_surf(av), (/ id_dim_s_surf(av) /), 'azimuth',            &
-                                   NF90_DOUBLE, id_var_azimuth_surf(av), 'degree',                 &
-                                   'azimuth angle', 5577, 5578, 5579, fill = .TRUE. )
-           CALL netcdf_create_att( id_set_surf(av), id_var_azimuth_surf(av), 'standard_name',      &
-                                   'surface_azimuth_angle', 5584 )
-
-           CALL netcdf_create_var( id_set_surf(av), (/ id_dim_s_surf(av) /), 'zenith',             &
-                                   NF90_DOUBLE, id_var_zenith_surf(av), 'degree', '', 5580, 5581,  &
-                                   5582, fill = .TRUE. )
-!
-!--        Define the variables
-           var_list = ';'
-           i = 1
-
-           DO WHILE ( dosurf(av,i)(1:1) /= ' ' )
-
-              CALL netcdf_create_var( id_set_surf(av),                                             &
-                                      (/ id_dim_s_surf(av), id_dim_time_surf(av) /), dosurf(av,i), &
-                                      NF90_REAL4, id_var_dosurf(av,i), dosurf_unit(av,i),          &
-                                      dosurf(av,i), 5565, 5565, 5565, .TRUE. )
-!
-!--           Set no fill for every variable to increase performance.
-              nc_stat = NF90_DEF_VAR_FILL( id_set_surf(av), id_var_dosurf(av,i), NF90_NOFILL, 0 )
-              CALL netcdf_handle_error( 'surface_data_output_init', 5566 )
-!
-!--           Set collective io operations for parallel io
-              nc_stat = NF90_VAR_PAR_ACCESS( id_set_surf(av), id_var_dosurf(av,i), NF90_COLLECTIVE )
-              CALL netcdf_handle_error( 'surface_data_output_init', 5567 )
-              var_list = TRIM( var_list ) // TRIM( dosurf(av,i) ) // ';'
-
-              i = i + 1
-
-           ENDDO
-!
-!--        Write the list of variables as global attribute (this is used by restart runs and by
-!--        combine_plot_fields)
-           nc_stat = NF90_PUT_ATT( id_set_surf(av), NF90_GLOBAL, 'VAR_LIST', var_list )
-           CALL netcdf_handle_error( 'surface_data_output_init', 5568 )
-
-!
-!--        Set general no fill, otherwise the performance drops significantly for parallel output.
-           nc_stat = NF90_SET_FILL( id_set_surf(av), NF90_NOFILL, oldmode )
-           CALL netcdf_handle_error( 'surface_data_output_init', 5569 )
-
-!
-!--        Leave netCDF define mode
-           nc_stat = NF90_ENDDEF( id_set_surf(av) )
-           CALL netcdf_handle_error( 'surface_data_output_init', 5570 )
-
-!
-!--        These data are only written by PE0 for parallel output to increase the performance.
-           IF ( myid == 0 )  THEN
-!
-!--           Write data for surface indices
-              ALLOCATE( netcdf_data_1d(1:surfaces%ns_total) )
-
-              DO  i = 1, surfaces%ns_total
-                 netcdf_data_1d(i) = i
-              ENDDO
-
-              nc_stat = NF90_PUT_VAR( id_set_surf(av), id_var_s_surf(av), netcdf_data_1d,          &
-                                      start = (/ 1 /), count = (/ surfaces%ns_total /) )
-              CALL netcdf_handle_error( 'surface_data_output_init', 5571 )
-
-              DEALLOCATE( netcdf_data_1d )
-
-           ENDIF
-
-!
-!--        Write surface positions to file
-           nc_stat = NF90_PUT_VAR( id_set_surf(av), id_var_xs_surf(av),                            &
-                                   surfaces%xs, start = (/ surfaces%s(1) /),                       &
-                                   count = (/ surfaces%ns /) )
-           CALL netcdf_handle_error( 'surface_data_output_init', 5572 )
-
-           nc_stat = NF90_PUT_VAR( id_set_surf(av), id_var_ys_surf(av), surfaces%ys,               &
-                                   start = (/ surfaces%s(1) /), count = (/ surfaces%ns /) )
-           CALL netcdf_handle_error( 'surface_data_output_init', 5573 )
-
-           nc_stat = NF90_PUT_VAR( id_set_surf(av), id_var_zs_surf(av), surfaces%zs,               &
-                                   start = (/ surfaces%s(1) /), count = (/ surfaces%ns /) )
-           CALL netcdf_handle_error( 'surface_data_output_init', 5574 )
-
-           nc_stat = NF90_PUT_VAR( id_set_surf(av), id_var_etum_surf(av), surfaces%es_utm,         &
-                                   start = (/ surfaces%s(1) /), count = (/ surfaces%ns /) )
-           CALL netcdf_handle_error( 'surface_data_output_init', 5575 )
-
-           nc_stat = NF90_PUT_VAR( id_set_surf(av), id_var_nutm_surf(av), surfaces%ns_utm,         &
-                                   start = (/ surfaces%s(1) /), count = (/ surfaces%ns /) )
-           CALL netcdf_handle_error( 'surface_data_output_init', 5576 )
-
-           nc_stat = NF90_PUT_VAR( id_set_surf(av), id_var_azimuth_surf(av), surfaces%azimuth,     &
-                                   start = (/ surfaces%s(1) /), count = (/ surfaces%ns /) )
-           CALL netcdf_handle_error( 'surface_data_output_init', 5585 )
-
-           nc_stat = NF90_PUT_VAR( id_set_surf(av), id_var_zenith_surf(av), surfaces%zenith,       &
-                                   start = (/ surfaces%s(1) /), count = (/ surfaces%ns /) )
-           CALL netcdf_handle_error( 'surface_data_output_init', 5586 )
-
-          ENDDO
-#endif
-
-     ENDIF
-
- END SUBROUTINE surface_data_output_init
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Routine for controlling the data output. Surface data is collected from different types of
-!> surfaces (default, natural, urban) and different orientation and written to one 1D-output array.
-!> Further, NetCDF routines are called to write the surface data in the respective NetCDF files.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output( av )
-
-    USE control_parameters,                                                                        &
-        ONLY:  io_blocks,                                                                          &
-               io_group,                                                                           &
-               time_since_reference_point
-
-#if defined( __parallel )
-    USE pegrid,                                                                                    &
-        ONLY:  comm2d,                                                                             &
-               ierr
-#endif
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  trimvar = ' '  !< dummy for single output variable
-
-    INTEGER(iwp) ::  av     !< id indicating average or non-average data output
-    INTEGER(iwp) ::  i      !< loop index
-    INTEGER(iwp) ::  l      !< running index for surface orientation
-    INTEGER(iwp) ::  m      !< running index for surface elements
-    INTEGER(iwp) ::  n_out  !< counter variables for surface output
-
-!
-!-- Return, if nothing to output
-    IF ( dosurf_no(av) == 0 )  RETURN
-!
-!-- In case of VTK output, check if binary files are open and write coordinates.
-    IF ( to_vtk )  THEN
-
-       CALL check_open( 25 + av )
-
-       IF ( .NOT. first_output(av) )  THEN
-          DO  i = 0, io_blocks - 1
-             IF ( i == io_group )  THEN
-                WRITE ( 25 + av )  surfaces%npoints
-                WRITE ( 25 + av )  surfaces%npoints_total
-                WRITE ( 25 + av )  surfaces%ns
-                WRITE ( 25 + av )  surfaces%ns_total
-                WRITE ( 25 + av )  surfaces%points
-                WRITE ( 25 + av )  surfaces%polygons
-             ENDIF
-#if defined( __parallel )
-             CALL MPI_BARRIER( comm2d, ierr )
-#endif
-             first_output(av) = .TRUE.
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- In case of NetCDF output, check if enough time steps are available in file and update time axis.
-    IF ( to_netcdf )  THEN
-#if defined( __netcdf4_parallel )
-       IF ( dosurf_time_count(av) + 1 > ntdim_surf(av) )  THEN
-          WRITE ( message_string, * ) 'Output of surface data is not given at t=',                 &
-                                      time_since_reference_point, 's because the maximum ',        &
-                                      'number of output time levels is exceeded.'
-          CALL message( 'surface_data_output', 'PA0539', 0, 1, 0, 6, 0 )
-
-          RETURN
-
-       ENDIF
-!
-!--    Update the netCDF time axis
-!--    In case of parallel output, this is only done by PE0 to increase the performance.
-       dosurf_time_count(av) = dosurf_time_count(av) + 1
-       IF ( myid == 0 )  THEN
-          nc_stat = NF90_PUT_VAR( id_set_surf(av), id_var_time_surf(av),                           &
-                                  (/ time_since_reference_point /),                                &
-                                  start = (/ dosurf_time_count(av) /), count = (/ 1 /) )
-          CALL netcdf_handle_error( 'surface_data_output', 6666 )
-       ENDIF
-#endif
-    ENDIF
-
-!
-!-- Cycle through output quantities and write them to file.
-    n_out = 0
-    DO  WHILE ( dosurf(av,n_out+1)(1:1) /= ' ' )
-
-       n_out   = n_out + 1
-       trimvar = TRIM( dosurf(av,n_out) )
-!
-!--    Set the output array to the _FillValue in case it is not defined for each type of surface.
-       surfaces%var_out = surfaces%fillvalue
-       SELECT CASE ( trimvar )
-
-          CASE ( 'us' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                  &
-                          surf_def_h(0)%us, surf_lsm_h(0)%us, surf_usm_h(0)%us,    &
-                          surf_def_h(1)%us, surf_lsm_h(1)%us, surf_usm_h(1)%us,    &
-                          surf_def_v(0)%us, surf_lsm_v(0)%us, surf_usm_v(0)%us,    &
-                          surf_def_v(1)%us, surf_lsm_v(1)%us, surf_usm_v(1)%us,    &
-                          surf_def_v(2)%us, surf_lsm_v(2)%us, surf_usm_v(2)%us,    &
-                          surf_def_v(3)%us, surf_lsm_v(3)%us, surf_usm_v(3)%us )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'ts' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                   &
-                          surf_def_h(0)%ts, surf_lsm_h(0)%ts, surf_usm_h(0)%ts,    &
-                          surf_def_h(1)%ts, surf_lsm_h(1)%ts, surf_usm_h(1)%ts,    &
-                          surf_def_v(0)%ts, surf_lsm_v(0)%ts, surf_usm_v(0)%ts,    &
-                          surf_def_v(1)%ts, surf_lsm_v(1)%ts, surf_usm_v(1)%ts,    &
-                          surf_def_v(2)%ts, surf_lsm_v(2)%ts, surf_usm_v(2)%ts,    &
-                          surf_def_v(3)%ts, surf_lsm_v(3)%ts, surf_usm_v(3)%ts )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'qs' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                  &
-                          surf_def_h(0)%qs, surf_lsm_h(0)%qs, surf_usm_h(0)%qs,    &
-                          surf_def_h(1)%qs, surf_lsm_h(1)%qs, surf_usm_h(1)%qs,    &
-                          surf_def_v(0)%qs, surf_lsm_v(0)%qs, surf_usm_v(0)%qs,    &
-                          surf_def_v(1)%qs, surf_lsm_v(1)%qs, surf_usm_v(1)%qs,    &
-                          surf_def_v(2)%qs, surf_lsm_v(2)%qs, surf_usm_v(2)%qs,    &
-                          surf_def_v(3)%qs, surf_lsm_v(3)%qs, surf_usm_v(3)%qs )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'ss' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                  &
-                          surf_def_h(0)%ss, surf_lsm_h(0)%ss, surf_usm_h(0)%ss,    &
-                          surf_def_h(1)%ss, surf_lsm_h(1)%ss, surf_usm_h(1)%ss,    &
-                          surf_def_v(0)%ss, surf_lsm_v(0)%ss, surf_usm_v(0)%ss,    &
-                          surf_def_v(1)%ss, surf_lsm_v(1)%ss, surf_usm_v(1)%ss,    &
-                          surf_def_v(2)%ss, surf_lsm_v(2)%ss, surf_usm_v(2)%ss,    &
-                          surf_def_v(3)%ss, surf_lsm_v(3)%ss, surf_usm_v(3)%ss )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'qcs' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%qcs, surf_lsm_h(0)%qcs, surf_usm_h(0)%qcs,    &
-                          surf_def_h(1)%qcs, surf_lsm_h(1)%qcs, surf_usm_h(1)%qcs,    &
-                          surf_def_v(0)%qcs, surf_lsm_v(0)%qcs, surf_usm_v(0)%qcs,    &
-                          surf_def_v(1)%qcs, surf_lsm_v(1)%qcs, surf_usm_v(1)%qcs,    &
-                          surf_def_v(2)%qcs, surf_lsm_v(2)%qcs, surf_usm_v(2)%qcs,    &
-                          surf_def_v(3)%qcs, surf_lsm_v(3)%qcs, surf_usm_v(3)%qcs )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'ncs' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%ncs, surf_lsm_h(0)%ncs, surf_usm_h(0)%ncs,    &
-                          surf_def_h(1)%ncs, surf_lsm_h(1)%ncs, surf_usm_h(1)%ncs,    &
-                          surf_def_v(0)%ncs, surf_lsm_v(0)%ncs, surf_usm_v(0)%ncs,    &
-                          surf_def_v(1)%ncs, surf_lsm_v(1)%ncs, surf_usm_v(1)%ncs,    &
-                          surf_def_v(2)%ncs, surf_lsm_v(2)%ncs, surf_usm_v(2)%ncs,    &
-                          surf_def_v(3)%ncs, surf_lsm_v(3)%ncs, surf_usm_v(3)%ncs )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'qis' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%qis, surf_lsm_h(0)%qis, surf_usm_h(0)%qis,    &
-                          surf_def_h(1)%qis, surf_lsm_h(1)%qis, surf_usm_h(1)%qis,    &
-                          surf_def_v(0)%qis, surf_lsm_v(0)%qis, surf_usm_v(0)%qis,    &
-                          surf_def_v(1)%qis, surf_lsm_v(1)%qis, surf_usm_v(1)%qis,    &
-                          surf_def_v(2)%qis, surf_lsm_v(2)%qis, surf_usm_v(2)%qis,    &
-                          surf_def_v(3)%qis, surf_lsm_v(3)%qis, surf_usm_v(3)%qis )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'nis' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%nis, surf_lsm_h(0)%nis, surf_usm_h(0)%nis,    &
-                          surf_def_h(1)%nis, surf_lsm_h(1)%nis, surf_usm_h(1)%nis,    &
-                          surf_def_v(0)%nis, surf_lsm_v(0)%nis, surf_usm_v(0)%nis,    &
-                          surf_def_v(1)%nis, surf_lsm_v(1)%nis, surf_usm_v(1)%nis,    &
-                          surf_def_v(2)%nis, surf_lsm_v(2)%nis, surf_usm_v(2)%nis,    &
-                          surf_def_v(3)%nis, surf_lsm_v(3)%nis, surf_usm_v(3)%nis )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'qrs' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%qrs, surf_lsm_h(0)%qrs, surf_usm_h(0)%qrs,    &
-                          surf_def_h(1)%qrs, surf_lsm_h(1)%qrs, surf_usm_h(1)%qrs,    &
-                          surf_def_v(0)%qrs, surf_lsm_v(0)%qrs, surf_usm_v(0)%qrs,    &
-                          surf_def_v(1)%qrs, surf_lsm_v(1)%qrs, surf_usm_v(1)%qrs,    &
-                          surf_def_v(2)%qrs, surf_lsm_v(2)%qrs, surf_usm_v(2)%qrs,    &
-                          surf_def_v(3)%qrs, surf_lsm_v(3)%qrs, surf_usm_v(3)%qrs )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'nrs' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%nrs, surf_lsm_h(0)%nrs, surf_usm_h(0)%nrs,    &
-                          surf_def_h(1)%nrs, surf_lsm_h(1)%nrs, surf_usm_h(1)%nrs,    &
-                          surf_def_v(0)%nrs, surf_lsm_v(0)%nrs, surf_usm_v(0)%nrs,    &
-                          surf_def_v(1)%nrs, surf_lsm_v(1)%nrs, surf_usm_v(1)%nrs,    &
-                          surf_def_v(2)%nrs, surf_lsm_v(2)%nrs, surf_usm_v(2)%nrs,    &
-                          surf_def_v(3)%nrs, surf_lsm_v(3)%nrs, surf_usm_v(3)%nrs )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'ol' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                  &
-                          surf_def_h(0)%ol, surf_lsm_h(0)%ol, surf_usm_h(0)%ol,    &
-                          surf_def_h(1)%ol, surf_lsm_h(1)%ol, surf_usm_h(1)%ol,    &
-                          surf_def_v(0)%ol, surf_lsm_v(0)%ol, surf_usm_v(0)%ol,    &
-                          surf_def_v(1)%ol, surf_lsm_v(1)%ol, surf_usm_v(1)%ol,    &
-                          surf_def_v(2)%ol, surf_lsm_v(2)%ol, surf_usm_v(2)%ol,    &
-                          surf_def_v(3)%ol, surf_lsm_v(3)%ol, surf_usm_v(3)%ol )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'z0' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                  &
-                          surf_def_h(0)%z0, surf_lsm_h(0)%z0, surf_usm_h(0)%z0,    &
-                          surf_def_h(1)%z0, surf_lsm_h(1)%z0, surf_usm_h(1)%z0,    &
-                          surf_def_v(0)%z0, surf_lsm_v(0)%z0, surf_usm_v(0)%z0,    &
-                          surf_def_v(1)%z0, surf_lsm_v(1)%z0, surf_usm_v(1)%z0,    &
-                          surf_def_v(2)%z0, surf_lsm_v(2)%z0, surf_usm_v(2)%z0,    &
-                          surf_def_v(3)%z0, surf_lsm_v(3)%z0, surf_usm_v(3)%z0 )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'z0h' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%z0h, surf_lsm_h(0)%z0h, surf_usm_h(0)%z0h,    &
-                          surf_def_h(1)%z0h, surf_lsm_h(1)%z0h, surf_usm_h(1)%z0h,    &
-                          surf_def_v(0)%z0h, surf_lsm_v(0)%z0h, surf_usm_v(0)%z0h,    &
-                          surf_def_v(1)%z0h, surf_lsm_v(1)%z0h, surf_usm_v(1)%z0h,    &
-                          surf_def_v(2)%z0h, surf_lsm_v(2)%z0h, surf_usm_v(2)%z0h,    &
-                          surf_def_v(3)%z0h, surf_lsm_v(3)%z0h, surf_usm_v(3)%z0h )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'z0q' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%z0q, surf_lsm_h(0)%z0q, surf_usm_h(0)%z0q,    &
-                          surf_def_h(1)%z0q, surf_lsm_h(1)%z0q, surf_usm_h(1)%z0q,    &
-                          surf_def_v(0)%z0q, surf_lsm_v(0)%z0q, surf_usm_v(0)%z0q,    &
-                          surf_def_v(1)%z0q, surf_lsm_v(1)%z0q, surf_usm_v(1)%z0q,    &
-                          surf_def_v(2)%z0q, surf_lsm_v(2)%z0q, surf_usm_v(2)%z0q,    &
-                          surf_def_v(3)%z0q, surf_lsm_v(3)%z0q, surf_usm_v(3)%z0q )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'theta1' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%pt1, surf_lsm_h(0)%pt1, surf_usm_h(0)%pt1,    &
-                          surf_def_h(1)%pt1, surf_lsm_h(1)%pt1, surf_usm_h(1)%pt1,    &
-                          surf_def_v(0)%pt1, surf_lsm_v(0)%pt1, surf_usm_v(0)%pt1,    &
-                          surf_def_v(1)%pt1, surf_lsm_v(1)%pt1, surf_usm_v(1)%pt1,    &
-                          surf_def_v(2)%pt1, surf_lsm_v(2)%pt1, surf_usm_v(2)%pt1,    &
-                          surf_def_v(3)%pt1, surf_lsm_v(3)%pt1, surf_usm_v(3)%pt1 )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'qv1' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%qv1, surf_lsm_h(0)%qv1, surf_usm_h(0)%qv1,    &
-                          surf_def_h(1)%qv1, surf_lsm_h(1)%qv1, surf_usm_h(1)%qv1,    &
-                          surf_def_v(0)%qv1, surf_lsm_v(0)%qv1, surf_usm_v(0)%qv1,    &
-                          surf_def_v(1)%qv1, surf_lsm_v(1)%qv1, surf_usm_v(1)%qv1,    &
-                          surf_def_v(2)%qv1, surf_lsm_v(2)%qv1, surf_usm_v(2)%qv1,    &
-                          surf_def_v(3)%qv1, surf_lsm_v(3)%qv1, surf_usm_v(3)%qv1 )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'thetav1' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                        &
-                          surf_def_h(0)%vpt1, surf_lsm_h(0)%vpt1, surf_usm_h(0)%vpt1,    &
-                          surf_def_h(1)%vpt1, surf_lsm_h(1)%vpt1, surf_usm_h(1)%vpt1,    &
-                          surf_def_v(0)%vpt1, surf_lsm_v(0)%vpt1, surf_usm_v(0)%vpt1,    &
-                          surf_def_v(1)%vpt1, surf_lsm_v(1)%vpt1, surf_usm_v(1)%vpt1,    &
-                          surf_def_v(2)%vpt1, surf_lsm_v(2)%vpt1, surf_usm_v(2)%vpt1,    &
-                          surf_def_v(3)%vpt1, surf_lsm_v(3)%vpt1, surf_usm_v(3)%vpt1 )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'usws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                        &
-                          surf_def_h(0)%usws, surf_lsm_h(0)%usws, surf_usm_h(0)%usws,    &
-                          surf_def_h(1)%usws, surf_lsm_h(1)%usws, surf_usm_h(1)%usws,    &
-                          surf_def_v(0)%usws, surf_lsm_v(0)%usws, surf_usm_v(0)%usws,    &
-                          surf_def_v(1)%usws, surf_lsm_v(1)%usws, surf_usm_v(1)%usws,    &
-                          surf_def_v(2)%usws, surf_lsm_v(2)%usws, surf_usm_v(2)%usws,    &
-                          surf_def_v(3)%usws, surf_lsm_v(3)%usws, surf_usm_v(3)%usws,    &
-                          momentumflux_output_conversion )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'vsws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                        &
-                          surf_def_h(0)%vsws, surf_lsm_h(0)%vsws, surf_usm_h(0)%vsws,    &
-                          surf_def_h(1)%vsws, surf_lsm_h(1)%vsws, surf_usm_h(1)%vsws,    &
-                          surf_def_v(0)%vsws, surf_lsm_v(0)%vsws, surf_usm_v(0)%vsws,    &
-                          surf_def_v(1)%vsws, surf_lsm_v(1)%vsws, surf_usm_v(1)%vsws,    &
-                          surf_def_v(2)%vsws, surf_lsm_v(2)%vsws, surf_usm_v(2)%vsws,    &
-                          surf_def_v(3)%vsws, surf_lsm_v(3)%vsws, surf_usm_v(3)%vsws,    &
-                          momentumflux_output_conversion )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'shf' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%shf, surf_lsm_h(0)%shf, surf_usm_h(0)%shf,    &
-                          surf_def_h(1)%shf, surf_lsm_h(1)%shf, surf_usm_h(1)%shf,    &
-                          surf_def_v(0)%shf, surf_lsm_v(0)%shf, surf_usm_v(0)%shf,    &
-                          surf_def_v(1)%shf, surf_lsm_v(1)%shf, surf_usm_v(1)%shf,    &
-                          surf_def_v(2)%shf, surf_lsm_v(2)%shf, surf_usm_v(2)%shf,    &
-                          surf_def_v(3)%shf, surf_lsm_v(3)%shf, surf_usm_v(3)%shf,    &
-                          heatflux_output_conversion )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-             ENDIF
-
-          CASE ( 'qsws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                        &
-                          surf_def_h(0)%qsws, surf_lsm_h(0)%qsws, surf_usm_h(0)%qsws,    &
-                          surf_def_h(1)%qsws, surf_lsm_h(1)%qsws, surf_usm_h(1)%qsws,    &
-                          surf_def_v(0)%qsws, surf_lsm_v(0)%qsws, surf_usm_v(0)%qsws,    &
-                          surf_def_v(1)%qsws, surf_lsm_v(1)%qsws, surf_usm_v(1)%qsws,    &
-                          surf_def_v(2)%qsws, surf_lsm_v(2)%qsws, surf_usm_v(2)%qsws,    &
-                          surf_def_v(3)%qsws, surf_lsm_v(3)%qsws, surf_usm_v(3)%qsws,    &
-                          waterflux_output_conversion )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'ssws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                        &
-                          surf_def_h(0)%ssws, surf_lsm_h(0)%ssws, surf_usm_h(0)%ssws,    &
-                          surf_def_h(1)%ssws, surf_lsm_h(1)%ssws, surf_usm_h(1)%ssws,    &
-                          surf_def_v(0)%ssws, surf_lsm_v(0)%ssws, surf_usm_v(0)%ssws,    &
-                          surf_def_v(1)%ssws, surf_lsm_v(1)%ssws, surf_usm_v(1)%ssws,    &
-                          surf_def_v(2)%ssws, surf_lsm_v(2)%ssws, surf_usm_v(2)%ssws,    &
-                          surf_def_v(3)%ssws, surf_lsm_v(3)%ssws, surf_usm_v(3)%ssws )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'qcsws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                           &
-                          surf_def_h(0)%qcsws, surf_lsm_h(0)%qcsws, surf_usm_h(0)%qcsws,    &
-                          surf_def_h(1)%qcsws, surf_lsm_h(1)%qcsws, surf_usm_h(1)%qcsws,    &
-                          surf_def_v(0)%qcsws, surf_lsm_v(0)%qcsws, surf_usm_v(0)%qcsws,    &
-                          surf_def_v(1)%qcsws, surf_lsm_v(1)%qcsws, surf_usm_v(1)%qcsws,    &
-                          surf_def_v(2)%qcsws, surf_lsm_v(2)%qcsws, surf_usm_v(2)%qcsws,    &
-                          surf_def_v(3)%qcsws, surf_lsm_v(3)%qcsws, surf_usm_v(3)%qcsws )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'ncsws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                           &
-                          surf_def_h(0)%ncsws, surf_lsm_h(0)%ncsws, surf_usm_h(0)%ncsws,    &
-                          surf_def_h(1)%ncsws, surf_lsm_h(1)%ncsws, surf_usm_h(1)%ncsws,    &
-                          surf_def_v(0)%ncsws, surf_lsm_v(0)%ncsws, surf_usm_v(0)%ncsws,    &
-                          surf_def_v(1)%ncsws, surf_lsm_v(1)%ncsws, surf_usm_v(1)%ncsws,    &
-                          surf_def_v(2)%ncsws, surf_lsm_v(2)%ncsws, surf_usm_v(2)%ncsws,    &
-                          surf_def_v(3)%ncsws, surf_lsm_v(3)%ncsws, surf_usm_v(3)%ncsws )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-
-          CASE ( 'qisws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                           &
-                          surf_def_h(0)%qisws, surf_lsm_h(0)%qisws, surf_usm_h(0)%qisws,    &
-                          surf_def_h(1)%qisws, surf_lsm_h(1)%qisws, surf_usm_h(1)%qisws,    &
-                          surf_def_v(0)%qisws, surf_lsm_v(0)%qisws, surf_usm_v(0)%qisws,    &
-                          surf_def_v(1)%qisws, surf_lsm_v(1)%qisws, surf_usm_v(1)%qisws,    &
-                          surf_def_v(2)%qisws, surf_lsm_v(2)%qisws, surf_usm_v(2)%qisws,    &
-                          surf_def_v(3)%qisws, surf_lsm_v(3)%qisws, surf_usm_v(3)%qisws )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'nisws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                           &
-                          surf_def_h(0)%nisws, surf_lsm_h(0)%nisws, surf_usm_h(0)%nisws,    &
-                          surf_def_h(1)%nisws, surf_lsm_h(1)%nisws, surf_usm_h(1)%nisws,    &
-                          surf_def_v(0)%nisws, surf_lsm_v(0)%nisws, surf_usm_v(0)%nisws,    &
-                          surf_def_v(1)%nisws, surf_lsm_v(1)%nisws, surf_usm_v(1)%nisws,    &
-                          surf_def_v(2)%nisws, surf_lsm_v(2)%nisws, surf_usm_v(2)%nisws,    &
-                          surf_def_v(3)%nisws, surf_lsm_v(3)%nisws, surf_usm_v(3)%nisws )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'qrsws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                           &
-                          surf_def_h(0)%qrsws, surf_lsm_h(0)%qrsws, surf_usm_h(0)%qrsws,    &
-                          surf_def_h(1)%qrsws, surf_lsm_h(1)%qrsws, surf_usm_h(1)%qrsws,    &
-                          surf_def_v(0)%qrsws, surf_lsm_v(0)%qrsws, surf_usm_v(0)%qrsws,    &
-                          surf_def_v(1)%qrsws, surf_lsm_v(1)%qrsws, surf_usm_v(1)%qrsws,    &
-                          surf_def_v(2)%qrsws, surf_lsm_v(2)%qrsws, surf_usm_v(2)%qrsws,    &
-                          surf_def_v(3)%qrsws, surf_lsm_v(3)%qrsws, surf_usm_v(3)%qrsws )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'nrsws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                           &
-                          surf_def_h(0)%nrsws, surf_lsm_h(0)%nrsws, surf_usm_h(0)%nrsws,    &
-                          surf_def_h(1)%nrsws, surf_lsm_h(1)%nrsws, surf_usm_h(1)%nrsws,    &
-                          surf_def_v(0)%nrsws, surf_lsm_v(0)%nrsws, surf_usm_v(0)%nrsws,    &
-                          surf_def_v(1)%nrsws, surf_lsm_v(1)%nrsws, surf_usm_v(1)%nrsws,    &
-                          surf_def_v(2)%nrsws, surf_lsm_v(2)%nrsws, surf_usm_v(2)%nrsws,    &
-                          surf_def_v(3)%nrsws, surf_lsm_v(3)%nrsws, surf_usm_v(3)%nrsws )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'sasws' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                           &
-                          surf_def_h(0)%sasws, surf_lsm_h(0)%sasws, surf_usm_h(0)%sasws,    &
-                          surf_def_h(1)%sasws, surf_lsm_h(1)%sasws, surf_usm_h(1)%sasws,    &
-                          surf_def_v(0)%sasws, surf_lsm_v(0)%sasws, surf_usm_v(0)%sasws,    &
-                          surf_def_v(1)%sasws, surf_lsm_v(1)%sasws, surf_usm_v(1)%sasws,    &
-                          surf_def_v(2)%sasws, surf_lsm_v(2)%sasws, surf_usm_v(2)%sasws,    &
-                          surf_def_v(3)%sasws, surf_lsm_v(3)%sasws, surf_usm_v(3)%sasws )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'q_surface' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                              &
-                    surf_def_h(0)%q_surface, surf_lsm_h(0)%q_surface, surf_usm_h(0)%q_surface, &
-                    surf_def_h(1)%q_surface, surf_lsm_h(1)%q_surface, surf_usm_h(1)%q_surface, &
-                    surf_def_v(0)%q_surface, surf_lsm_v(0)%q_surface, surf_usm_v(0)%q_surface, &
-                    surf_def_v(1)%q_surface, surf_lsm_v(1)%q_surface, surf_usm_v(1)%q_surface, &
-                    surf_def_v(2)%q_surface, surf_lsm_v(2)%q_surface, surf_usm_v(2)%q_surface, &
-                    surf_def_v(3)%q_surface, surf_lsm_v(3)%q_surface, surf_usm_v(3)%q_surface )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'theta_surface' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%pt_surface, surf_lsm_h(0)%pt_surface, surf_usm_h(0)%pt_surface, &
-                    surf_def_h(1)%pt_surface, surf_lsm_h(1)%pt_surface, surf_usm_h(1)%pt_surface, &
-                    surf_def_v(0)%pt_surface, surf_lsm_v(0)%pt_surface, surf_usm_v(0)%pt_surface, &
-                    surf_def_v(1)%pt_surface, surf_lsm_v(1)%pt_surface, surf_usm_v(1)%pt_surface, &
-                    surf_def_v(2)%pt_surface, surf_lsm_v(2)%pt_surface, surf_usm_v(2)%pt_surface, &
-                    surf_def_v(3)%pt_surface, surf_lsm_v(3)%pt_surface, surf_usm_v(3)%pt_surface )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'thetav_surface' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                  &
-                  surf_def_h(0)%vpt_surface, surf_lsm_h(0)%vpt_surface, surf_usm_h(0)%vpt_surface, &
-                  surf_def_h(1)%vpt_surface, surf_lsm_h(1)%vpt_surface, surf_usm_h(1)%vpt_surface, &
-                  surf_def_v(0)%vpt_surface, surf_lsm_v(0)%vpt_surface, surf_usm_v(0)%vpt_surface, &
-                  surf_def_v(1)%vpt_surface, surf_lsm_v(1)%vpt_surface, surf_usm_v(1)%vpt_surface, &
-                  surf_def_v(2)%vpt_surface, surf_lsm_v(2)%vpt_surface, surf_usm_v(2)%vpt_surface, &
-                  surf_def_v(3)%vpt_surface, surf_lsm_v(3)%vpt_surface, surf_usm_v(3)%vpt_surface )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_net' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                        &
-                    surf_def_h(0)%rad_net, surf_lsm_h(0)%rad_net, surf_usm_h(0)%rad_net, &
-                    surf_def_h(1)%rad_net, surf_lsm_h(1)%rad_net, surf_usm_h(1)%rad_net, &
-                    surf_def_v(0)%rad_net, surf_lsm_v(0)%rad_net, surf_usm_v(0)%rad_net, &
-                    surf_def_v(1)%rad_net, surf_lsm_v(1)%rad_net, surf_usm_v(1)%rad_net, &
-                    surf_def_v(2)%rad_net, surf_lsm_v(2)%rad_net, surf_usm_v(2)%rad_net, &
-                    surf_def_v(3)%rad_net, surf_lsm_v(3)%rad_net, surf_usm_v(3)%rad_net )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_lw_in' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                              &
-                    surf_def_h(0)%rad_lw_in, surf_lsm_h(0)%rad_lw_in, surf_usm_h(0)%rad_lw_in, &
-                    surf_def_h(1)%rad_lw_in, surf_lsm_h(1)%rad_lw_in, surf_usm_h(1)%rad_lw_in, &
-                    surf_def_v(0)%rad_lw_in, surf_lsm_v(0)%rad_lw_in, surf_usm_v(0)%rad_lw_in, &
-                    surf_def_v(1)%rad_lw_in, surf_lsm_v(1)%rad_lw_in, surf_usm_v(1)%rad_lw_in, &
-                    surf_def_v(2)%rad_lw_in, surf_lsm_v(2)%rad_lw_in, surf_usm_v(2)%rad_lw_in, &
-                    surf_def_v(3)%rad_lw_in, surf_lsm_v(3)%rad_lw_in, surf_usm_v(3)%rad_lw_in )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_lw_out' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%rad_lw_out, surf_lsm_h(0)%rad_lw_out, surf_usm_h(0)%rad_lw_out, &
-                    surf_def_h(1)%rad_lw_out, surf_lsm_h(1)%rad_lw_out, surf_usm_h(1)%rad_lw_out, &
-                    surf_def_v(0)%rad_lw_out, surf_lsm_v(0)%rad_lw_out, surf_usm_v(0)%rad_lw_out, &
-                    surf_def_v(1)%rad_lw_out, surf_lsm_v(1)%rad_lw_out, surf_usm_v(1)%rad_lw_out, &
-                    surf_def_v(2)%rad_lw_out, surf_lsm_v(2)%rad_lw_out, surf_usm_v(2)%rad_lw_out, &
-                    surf_def_v(3)%rad_lw_out, surf_lsm_v(3)%rad_lw_out, surf_usm_v(3)%rad_lw_out )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_sw_in' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                              &
-                    surf_def_h(0)%rad_sw_in, surf_lsm_h(0)%rad_sw_in, surf_usm_h(0)%rad_sw_in, &
-                    surf_def_h(1)%rad_sw_in, surf_lsm_h(1)%rad_sw_in, surf_usm_h(1)%rad_sw_in, &
-                    surf_def_v(0)%rad_sw_in, surf_lsm_v(0)%rad_sw_in, surf_usm_v(0)%rad_sw_in, &
-                    surf_def_v(1)%rad_sw_in, surf_lsm_v(1)%rad_sw_in, surf_usm_v(1)%rad_sw_in, &
-                    surf_def_v(2)%rad_sw_in, surf_lsm_v(2)%rad_sw_in, surf_usm_v(2)%rad_sw_in, &
-                    surf_def_v(3)%rad_sw_in, surf_lsm_v(3)%rad_sw_in, surf_usm_v(3)%rad_sw_in )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_sw_out' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                    &
-                    surf_def_h(0)%rad_sw_out, surf_lsm_h(0)%rad_sw_out, surf_usm_h(0)%rad_sw_out,    &
-                    surf_def_h(1)%rad_sw_out, surf_lsm_h(1)%rad_sw_out, surf_usm_h(1)%rad_sw_out,    &
-                    surf_def_v(0)%rad_sw_out, surf_lsm_v(0)%rad_sw_out, surf_usm_v(0)%rad_sw_out,    &
-                    surf_def_v(1)%rad_sw_out, surf_lsm_v(1)%rad_sw_out, surf_usm_v(1)%rad_sw_out,    &
-                    surf_def_v(2)%rad_sw_out, surf_lsm_v(2)%rad_sw_out, surf_usm_v(2)%rad_sw_out,    &
-                    surf_def_v(3)%rad_sw_out, surf_lsm_v(3)%rad_sw_out, surf_usm_v(3)%rad_sw_out )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'ghf' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-!
-!--             Sum up ground / wall heat flux. Note, for urban surfaces the wall heat flux is
-!--             aggregated from the different green, window and wall tiles.
-                DO  l = 0, 1
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%ghf(m) = surf_usm_h(l)%frac(m,ind_veg_wall) *                 &
-                                          surf_usm_h(l)%wghf_eb(m) +                              &
-                                          surf_usm_h(l)%frac(m,ind_pav_green) *                   &
-                                          surf_usm_h(l)%wghf_eb_green(m) +                        &
-                                          surf_usm_h(l)%frac(m,ind_wat_win) *                     &
-                                          surf_usm_h(l)%wghf_eb_window(m)
-                   ENDDO
-                ENDDO
-                DO  l = 0, 3
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%ghf(m) = surf_usm_v(l)%frac(m,ind_veg_wall) *                  &
-                                             surf_usm_v(l)%wghf_eb(m) +                            &
-                                             surf_usm_v(l)%frac(m,ind_pav_green) *                 &
-                                             surf_usm_v(l)%wghf_eb_green(m) +                      &
-                                             surf_usm_v(l)%frac(m,ind_wat_win) *                   &
-                                             surf_usm_v(l)%wghf_eb_window(m)
-                   ENDDO
-                ENDDO
-
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%ghf, surf_lsm_h(0)%ghf, surf_usm_h(0)%ghf,    &
-                          surf_def_h(1)%ghf, surf_lsm_h(1)%ghf, surf_usm_h(1)%ghf,    &
-                          surf_def_v(0)%ghf, surf_lsm_v(0)%ghf, surf_usm_v(0)%ghf,    &
-                          surf_def_v(1)%ghf, surf_lsm_v(1)%ghf, surf_usm_v(1)%ghf,    &
-                          surf_def_v(2)%ghf, surf_lsm_v(2)%ghf, surf_usm_v(2)%ghf,    &
-                          surf_def_v(3)%ghf, surf_lsm_v(3)%ghf, surf_usm_v(3)%ghf )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'r_a' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%r_a, surf_lsm_h(0)%r_a, surf_usm_h(0)%r_a,    &
-                          surf_def_h(1)%r_a, surf_lsm_h(1)%r_a, surf_usm_h(1)%r_a,    &
-                          surf_def_v(0)%r_a, surf_lsm_v(0)%r_a, surf_usm_v(0)%r_a,    &
-                          surf_def_v(1)%r_a, surf_lsm_v(1)%r_a, surf_usm_v(1)%r_a,    &
-                          surf_def_v(2)%r_a, surf_lsm_v(2)%r_a, surf_usm_v(2)%r_a,    &
-                          surf_def_v(3)%r_a, surf_lsm_v(3)%r_a, surf_usm_v(3)%r_a )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'r_soil' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                              &
-                          surf_def_h(0)%r_soil, surf_lsm_h(0)%r_soil, surf_usm_h(0)%r_soil,    &
-                          surf_def_h(1)%r_soil, surf_lsm_h(1)%r_soil, surf_usm_h(1)%r_soil,    &
-                          surf_def_v(0)%r_soil, surf_lsm_v(0)%r_soil, surf_usm_v(0)%r_soil,    &
-                          surf_def_v(1)%r_soil, surf_lsm_v(1)%r_soil, surf_usm_v(1)%r_soil,    &
-                          surf_def_v(2)%r_soil, surf_lsm_v(2)%r_soil, surf_usm_v(2)%r_soil,    &
-                          surf_def_v(3)%r_soil, surf_lsm_v(3)%r_soil, surf_usm_v(3)%r_soil )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'r_canopy' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                          surf_def_h(0)%r_canopy, surf_lsm_h(0)%r_canopy, surf_usm_h(0)%r_canopy, &
-                          surf_def_h(1)%r_canopy, surf_lsm_h(1)%r_canopy, surf_usm_h(1)%r_canopy, &
-                          surf_def_v(0)%r_canopy, surf_lsm_v(0)%r_canopy, surf_usm_v(0)%r_canopy, &
-                          surf_def_v(1)%r_canopy, surf_lsm_v(1)%r_canopy, surf_usm_v(1)%r_canopy, &
-                          surf_def_v(2)%r_canopy, surf_lsm_v(2)%r_canopy, surf_usm_v(2)%r_canopy, &
-                          surf_def_v(3)%r_canopy, surf_lsm_v(3)%r_canopy, surf_usm_v(3)%r_canopy )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'r_s' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                     &
-                          surf_def_h(0)%r_s, surf_lsm_h(0)%r_s, surf_usm_h(0)%r_s,    &
-                          surf_def_h(1)%r_s, surf_lsm_h(1)%r_s, surf_usm_h(1)%r_s,    &
-                          surf_def_v(0)%r_s, surf_lsm_v(0)%r_s, surf_usm_v(0)%r_s,    &
-                          surf_def_v(1)%r_s, surf_lsm_v(1)%r_s, surf_usm_v(1)%r_s,    &
-                          surf_def_v(2)%r_s, surf_lsm_v(2)%r_s, surf_usm_v(2)%r_s,    &
-                          surf_def_v(3)%r_s, surf_lsm_v(3)%r_s, surf_usm_v(3)%r_s )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_sw_dir' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%rad_sw_dir, surf_lsm_h(0)%rad_sw_dir, surf_usm_h(0)%rad_sw_dir, &
-                    surf_def_h(1)%rad_sw_dir, surf_lsm_h(1)%rad_sw_dir, surf_usm_h(1)%rad_sw_dir, &
-                    surf_def_v(0)%rad_sw_dir, surf_lsm_v(0)%rad_sw_dir, surf_usm_v(0)%rad_sw_dir, &
-                    surf_def_v(1)%rad_sw_dir, surf_lsm_v(1)%rad_sw_dir, surf_usm_v(1)%rad_sw_dir, &
-                    surf_def_v(2)%rad_sw_dir, surf_lsm_v(2)%rad_sw_dir, surf_usm_v(2)%rad_sw_dir, &
-                    surf_def_v(3)%rad_sw_dir, surf_lsm_v(3)%rad_sw_dir, surf_usm_v(3)%rad_sw_dir )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_sw_dif' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%rad_sw_dif, surf_lsm_h(0)%rad_sw_dif, surf_usm_h(0)%rad_sw_dif, &
-                    surf_def_h(1)%rad_sw_dif, surf_lsm_h(1)%rad_sw_dif, surf_usm_h(1)%rad_sw_dif, &
-                    surf_def_v(0)%rad_sw_dif, surf_lsm_v(0)%rad_sw_dif, surf_usm_v(0)%rad_sw_dif, &
-                    surf_def_v(1)%rad_sw_dif, surf_lsm_v(1)%rad_sw_dif, surf_usm_v(1)%rad_sw_dif, &
-                    surf_def_v(2)%rad_sw_dif, surf_lsm_v(2)%rad_sw_dif, surf_usm_v(2)%rad_sw_dif, &
-                    surf_def_v(3)%rad_sw_dif, surf_lsm_v(3)%rad_sw_dif, surf_usm_v(3)%rad_sw_dif )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_sw_ref' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%rad_sw_ref, surf_lsm_h(0)%rad_sw_ref, surf_usm_h(0)%rad_sw_ref, &
-                    surf_def_h(1)%rad_sw_ref, surf_lsm_h(1)%rad_sw_ref, surf_usm_h(1)%rad_sw_ref, &
-                    surf_def_v(0)%rad_sw_ref, surf_lsm_v(0)%rad_sw_ref, surf_usm_v(0)%rad_sw_ref, &
-                    surf_def_v(1)%rad_sw_ref, surf_lsm_v(1)%rad_sw_ref, surf_usm_v(1)%rad_sw_ref, &
-                    surf_def_v(2)%rad_sw_ref, surf_lsm_v(2)%rad_sw_ref, surf_usm_v(2)%rad_sw_ref, &
-                    surf_def_v(3)%rad_sw_ref, surf_lsm_v(3)%rad_sw_ref, surf_usm_v(3)%rad_sw_ref )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_sw_res' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%rad_sw_res, surf_lsm_h(0)%rad_sw_res, surf_usm_h(0)%rad_sw_res, &
-                    surf_def_h(1)%rad_sw_res, surf_lsm_h(1)%rad_sw_res, surf_usm_h(1)%rad_sw_res, &
-                    surf_def_v(0)%rad_sw_res, surf_lsm_v(0)%rad_sw_res, surf_usm_v(0)%rad_sw_res, &
-                    surf_def_v(1)%rad_sw_res, surf_lsm_v(1)%rad_sw_res, surf_usm_v(1)%rad_sw_res, &
-                    surf_def_v(2)%rad_sw_res, surf_lsm_v(2)%rad_sw_res, surf_usm_v(2)%rad_sw_res, &
-                    surf_def_v(3)%rad_sw_res, surf_lsm_v(3)%rad_sw_res, surf_usm_v(3)%rad_sw_res )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_lw_dif' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%rad_lw_dif, surf_lsm_h(0)%rad_lw_dif, surf_usm_h(0)%rad_lw_dif, &
-                    surf_def_h(1)%rad_lw_dif, surf_lsm_h(1)%rad_lw_dif, surf_usm_h(1)%rad_lw_dif, &
-                    surf_def_v(0)%rad_lw_dif, surf_lsm_v(0)%rad_lw_dif, surf_usm_v(0)%rad_lw_dif, &
-                    surf_def_v(1)%rad_lw_dif, surf_lsm_v(1)%rad_lw_dif, surf_usm_v(1)%rad_lw_dif, &
-                    surf_def_v(2)%rad_lw_dif, surf_lsm_v(2)%rad_lw_dif, surf_usm_v(2)%rad_lw_dif, &
-                    surf_def_v(3)%rad_lw_dif, surf_lsm_v(3)%rad_lw_dif, surf_usm_v(3)%rad_lw_dif )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_lw_ref' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%rad_lw_ref, surf_lsm_h(0)%rad_lw_ref, surf_usm_h(0)%rad_lw_ref, &
-                    surf_def_h(1)%rad_lw_ref, surf_lsm_h(1)%rad_lw_ref, surf_usm_h(1)%rad_lw_ref, &
-                    surf_def_v(0)%rad_lw_ref, surf_lsm_v(0)%rad_lw_ref, surf_usm_v(0)%rad_lw_ref, &
-                    surf_def_v(1)%rad_lw_ref, surf_lsm_v(1)%rad_lw_ref, surf_usm_v(1)%rad_lw_ref, &
-                    surf_def_v(2)%rad_lw_ref, surf_lsm_v(2)%rad_lw_ref, surf_usm_v(2)%rad_lw_ref, &
-                    surf_def_v(3)%rad_lw_ref, surf_lsm_v(3)%rad_lw_ref, surf_usm_v(3)%rad_lw_ref )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'rad_lw_res' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%rad_lw_res, surf_lsm_h(0)%rad_lw_res, surf_usm_h(0)%rad_lw_res, &
-                    surf_def_h(1)%rad_lw_res, surf_lsm_h(1)%rad_lw_res, surf_usm_h(1)%rad_lw_res, &
-                    surf_def_v(0)%rad_lw_res, surf_lsm_v(0)%rad_lw_res, surf_usm_v(0)%rad_lw_res, &
-                    surf_def_v(1)%rad_lw_res, surf_lsm_v(1)%rad_lw_res, surf_usm_v(1)%rad_lw_res, &
-                    surf_def_v(2)%rad_lw_res, surf_lsm_v(2)%rad_lw_res, surf_usm_v(2)%rad_lw_res, &
-                    surf_def_v(3)%rad_lw_res, surf_lsm_v(3)%rad_lw_res, surf_usm_v(3)%rad_lw_res )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-
-          CASE ( 'uvw1' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                          surf_def_h(0)%uvw_abs, surf_lsm_h(0)%uvw_abs, surf_usm_h(0)%uvw_abs,    &
-                          surf_def_h(1)%uvw_abs, surf_lsm_h(1)%uvw_abs, surf_usm_h(1)%uvw_abs,    &
-                          surf_def_v(0)%uvw_abs, surf_lsm_v(0)%uvw_abs, surf_usm_v(0)%uvw_abs,    &
-                          surf_def_v(1)%uvw_abs, surf_lsm_v(1)%uvw_abs, surf_usm_v(1)%uvw_abs,    &
-                          surf_def_v(2)%uvw_abs, surf_lsm_v(2)%uvw_abs, surf_usm_v(2)%uvw_abs,    &
-                          surf_def_v(3)%uvw_abs, surf_lsm_v(3)%uvw_abs, surf_usm_v(3)%uvw_abs )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-!
-!--       Waste heat from indoor model
-          CASE ( 'waste_heat' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%waste_heat, surf_lsm_h(0)%waste_heat, surf_usm_h(0)%waste_heat, &
-                    surf_def_h(1)%waste_heat, surf_lsm_h(1)%waste_heat, surf_usm_h(1)%waste_heat, &
-                    surf_def_v(0)%waste_heat, surf_lsm_v(0)%waste_heat, surf_usm_v(0)%waste_heat, &
-                    surf_def_v(1)%waste_heat, surf_lsm_v(1)%waste_heat, surf_usm_v(1)%waste_heat, &
-                    surf_def_v(2)%waste_heat, surf_lsm_v(2)%waste_heat, surf_usm_v(2)%waste_heat, &
-                    surf_def_v(3)%waste_heat, surf_lsm_v(3)%waste_heat, surf_usm_v(3)%waste_heat )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-!
-!--       Innermost building wall flux from indoor model
-          CASE ( 'im_hf' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                          surf_def_h(0)%iwghf_eb, surf_lsm_h(0)%iwghf_eb, surf_usm_h(0)%iwghf_eb, &
-                          surf_def_h(1)%iwghf_eb, surf_lsm_h(1)%iwghf_eb, surf_usm_h(1)%iwghf_eb, &
-                          surf_def_v(0)%iwghf_eb, surf_lsm_v(0)%iwghf_eb, surf_usm_v(0)%iwghf_eb, &
-                          surf_def_v(1)%iwghf_eb, surf_lsm_v(1)%iwghf_eb, surf_usm_v(1)%iwghf_eb, &
-                          surf_def_v(2)%iwghf_eb, surf_lsm_v(2)%iwghf_eb, surf_usm_v(2)%iwghf_eb, &
-                          surf_def_v(3)%iwghf_eb, surf_lsm_v(3)%iwghf_eb, surf_usm_v(3)%iwghf_eb )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-!
-!--       Surface albedo (tile approach)
-          CASE ( 'albedo' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                              &
-                          surf_def_h(0)%albedo, surf_lsm_h(0)%albedo, surf_usm_h(0)%albedo,    &
-                          surf_def_h(1)%albedo, surf_lsm_h(1)%albedo, surf_usm_h(1)%albedo,    &
-                          surf_def_v(0)%albedo, surf_lsm_v(0)%albedo, surf_usm_v(0)%albedo,    &
-                          surf_def_v(1)%albedo, surf_lsm_v(1)%albedo, surf_usm_v(1)%albedo,    &
-                          surf_def_v(2)%albedo, surf_lsm_v(2)%albedo, surf_usm_v(2)%albedo,    &
-                          surf_def_v(3)%albedo, surf_lsm_v(3)%albedo, surf_usm_v(3)%albedo )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-!
-!--       Surface emissivity (tile approach)
-          CASE ( 'emissivity' )
-!
-!--          Output of instantaneous data
-             IF ( av == 0 )  THEN
-                CALL surface_data_output_collect(                                                 &
-                    surf_def_h(0)%emissivity, surf_lsm_h(0)%emissivity, surf_usm_h(0)%emissivity, &
-                    surf_def_h(1)%emissivity, surf_lsm_h(1)%emissivity, surf_usm_h(1)%emissivity, &
-                    surf_def_v(0)%emissivity, surf_lsm_v(0)%emissivity, surf_usm_v(0)%emissivity, &
-                    surf_def_v(1)%emissivity, surf_lsm_v(1)%emissivity, surf_usm_v(1)%emissivity, &
-                    surf_def_v(2)%emissivity, surf_lsm_v(2)%emissivity, surf_usm_v(2)%emissivity, &
-                    surf_def_v(3)%emissivity, surf_lsm_v(3)%emissivity, surf_usm_v(3)%emissivity )
-             ELSE
-!
-!--             Output of averaged data
-                surfaces%var_out(:) = surfaces%var_av(:,n_out) / REAL( average_count_surf, KIND=wp )
-                surfaces%var_av(:,n_out) = 0.0_wp
-
-             ENDIF
-!
-!--          Add further variables:
-!--          'css', 'cssws', 'qsws_liq', 'qsws_soil', 'qsws_veg'
-
-       END SELECT
-!
-!--    Write to binary file:
-!--    - surfaces%points ( 3, 1-npoints )
-!--    - surfaces%polygons ( 5, 1-ns )
-!--    - surfaces%var_out ( 1-ns, time )
-!--    - Dimension: 1-nsurfaces, 1-npoints - can be ordered consecutively
-!--    - Distinguish between average and non-average data
-       IF ( to_vtk )  THEN
-          DO  i = 0, io_blocks - 1
-             IF ( i == io_group )  THEN
-                WRITE ( 25 + av )  LEN_TRIM( 'time' )
-                WRITE ( 25 + av )  'time'
-                WRITE ( 25 + av )  time_since_reference_point
-                WRITE ( 25 + av )  LEN_TRIM( trimvar )
-                WRITE ( 25 + av )  TRIM( trimvar )
-                WRITE ( 25 + av )  surfaces%var_out
-             ENDIF
-#if defined( __parallel )
-             CALL MPI_BARRIER( comm2d, ierr )
-#endif
-          ENDDO
-       ENDIF
-
-       IF ( to_netcdf )  THEN
-#if defined( __netcdf4_parallel )
-!
-!--       Write output array to file
-          nc_stat = NF90_PUT_VAR( id_set_surf(av), id_var_dosurf(av,n_out), surfaces%var_out,      &
-                                  start = (/ surfaces%s(1), dosurf_time_count(av) /),              &
-                                  count = (/ surfaces%ns, 1 /) )
-          CALL netcdf_handle_error( 'surface_data_output', 6667 )
-#endif
-       ENDIF
-
-    ENDDO
-
-!
-!-- If averaged output was written to NetCDF file, set the counter to zero
-    IF ( av == 1 )  average_count_surf = 0
-
- END SUBROUTINE surface_data_output
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Routine for controlling the data averaging.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_averaging
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  trimvar  !< dummy variable for current output variable
-
-    INTEGER(iwp) ::  l      !< running index for surface orientation
-    INTEGER(iwp) ::  m      !< running index for surface elements
-    INTEGER(iwp) ::  n_out  !< counter variables for surface output
-
-    n_out = 0
-    DO  WHILE ( dosurf(1,n_out+1)(1:1) /= ' ' )
-
-       n_out   = n_out + 1
-       trimvar = TRIM( dosurf(1,n_out) )
-
-       SELECT CASE ( trimvar )
-
-          CASE ( 'us' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%us, surf_lsm_h(0)%us, surf_usm_h(0)%us,                        &
-                     surf_def_h(1)%us, surf_lsm_h(1)%us, surf_usm_h(1)%us,                        &
-                     surf_def_v(0)%us, surf_lsm_v(0)%us, surf_usm_v(0)%us,                        &
-                     surf_def_v(1)%us, surf_lsm_v(1)%us, surf_usm_v(1)%us,                        &
-                     surf_def_v(2)%us, surf_lsm_v(2)%us, surf_usm_v(2)%us,                        &
-                     surf_def_v(3)%us, surf_lsm_v(3)%us, surf_usm_v(3)%us, n_out )
-
-          CASE ( 'ts' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%ts, surf_lsm_h(0)%ts, surf_usm_h(0)%ts,                        &
-                     surf_def_h(1)%ts, surf_lsm_h(1)%ts, surf_usm_h(1)%ts,                        &
-                     surf_def_v(0)%ts, surf_lsm_v(0)%ts, surf_usm_v(0)%ts,                        &
-                     surf_def_v(1)%ts, surf_lsm_v(1)%ts, surf_usm_v(1)%ts,                        &
-                     surf_def_v(2)%ts, surf_lsm_v(2)%ts, surf_usm_v(2)%ts,                        &
-                     surf_def_v(3)%ts, surf_lsm_v(3)%ts, surf_usm_v(3)%ts, n_out )
-
-          CASE ( 'qs' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%qs, surf_lsm_h(0)%qs, surf_usm_h(0)%qs,                        &
-                     surf_def_h(1)%qs, surf_lsm_h(1)%qs, surf_usm_h(1)%qs,                        &
-                     surf_def_v(0)%qs, surf_lsm_v(0)%qs, surf_usm_v(0)%qs,                        &
-                     surf_def_v(1)%qs, surf_lsm_v(1)%qs, surf_usm_v(1)%qs,                        &
-                     surf_def_v(2)%qs, surf_lsm_v(2)%qs, surf_usm_v(2)%qs,                        &
-                     surf_def_v(3)%qs, surf_lsm_v(3)%qs, surf_usm_v(3)%qs, n_out )
-
-          CASE ( 'ss' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%ss, surf_lsm_h(0)%ss, surf_usm_h(0)%ss,                        &
-                     surf_def_h(1)%ss, surf_lsm_h(1)%ss, surf_usm_h(1)%ss,                        &
-                     surf_def_v(0)%ss, surf_lsm_v(0)%ss, surf_usm_v(0)%ss,                        &
-                     surf_def_v(1)%ss, surf_lsm_v(1)%ss, surf_usm_v(1)%ss,                        &
-                     surf_def_v(2)%ss, surf_lsm_v(2)%ss, surf_usm_v(2)%ss,                        &
-                     surf_def_v(3)%ss, surf_lsm_v(3)%ss, surf_usm_v(3)%ss, n_out )
-
-          CASE ( 'qcs' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%qcs, surf_lsm_h(0)%qcs, surf_usm_h(0)%qcs,                     &
-                     surf_def_h(1)%qcs, surf_lsm_h(1)%qcs, surf_usm_h(1)%qcs,                     &
-                     surf_def_v(0)%qcs, surf_lsm_v(0)%qcs, surf_usm_v(0)%qcs,                     &
-                     surf_def_v(1)%qcs, surf_lsm_v(1)%qcs, surf_usm_v(1)%qcs,                     &
-                     surf_def_v(2)%qcs, surf_lsm_v(2)%qcs, surf_usm_v(2)%qcs,                     &
-                     surf_def_v(3)%qcs, surf_lsm_v(3)%qcs, surf_usm_v(3)%qcs, n_out )
-
-          CASE ( 'ncs' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%ncs, surf_lsm_h(0)%ncs, surf_usm_h(0)%ncs,                     &
-                     surf_def_h(1)%ncs, surf_lsm_h(1)%ncs, surf_usm_h(1)%ncs,                     &
-                     surf_def_v(0)%ncs, surf_lsm_v(0)%ncs, surf_usm_v(0)%ncs,                     &
-                     surf_def_v(1)%ncs, surf_lsm_v(1)%ncs, surf_usm_v(1)%ncs,                     &
-                     surf_def_v(2)%ncs, surf_lsm_v(2)%ncs, surf_usm_v(2)%ncs,                     &
-                     surf_def_v(3)%ncs, surf_lsm_v(3)%ncs, surf_usm_v(3)%ncs, n_out )
-
-          CASE ( 'qis' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%qis, surf_lsm_h(0)%qis, surf_usm_h(0)%qis,                     &
-                     surf_def_h(1)%qis, surf_lsm_h(1)%qis, surf_usm_h(1)%qis,                     &
-                     surf_def_v(0)%qis, surf_lsm_v(0)%qis, surf_usm_v(0)%qis,                     &
-                     surf_def_v(1)%qis, surf_lsm_v(1)%qis, surf_usm_v(1)%qis,                     &
-                     surf_def_v(2)%qis, surf_lsm_v(2)%qis, surf_usm_v(2)%qis,                     &
-                     surf_def_v(3)%qis, surf_lsm_v(3)%qis, surf_usm_v(3)%qis, n_out )
-
-          CASE ( 'nis' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%nis, surf_lsm_h(0)%nis, surf_usm_h(0)%nis,                     &
-                     surf_def_h(1)%nis, surf_lsm_h(1)%nis, surf_usm_h(1)%nis,                     &
-                     surf_def_v(0)%nis, surf_lsm_v(0)%nis, surf_usm_v(0)%nis,                     &
-                     surf_def_v(1)%nis, surf_lsm_v(1)%nis, surf_usm_v(1)%nis,                     &
-                     surf_def_v(2)%nis, surf_lsm_v(2)%nis, surf_usm_v(2)%nis,                     &
-                     surf_def_v(3)%nis, surf_lsm_v(3)%nis, surf_usm_v(3)%nis, n_out )
-
-          CASE ( 'qrs' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%qrs, surf_lsm_h(0)%qrs, surf_usm_h(0)%qrs,                     &
-                     surf_def_h(1)%qrs, surf_lsm_h(1)%qrs, surf_usm_h(1)%qrs,                     &
-                     surf_def_v(0)%qrs, surf_lsm_v(0)%qrs, surf_usm_v(0)%qrs,                     &
-                     surf_def_v(1)%qrs, surf_lsm_v(1)%qrs, surf_usm_v(1)%qrs,                     &
-                     surf_def_v(2)%qrs, surf_lsm_v(2)%qrs, surf_usm_v(2)%qrs,                     &
-                     surf_def_v(3)%qrs, surf_lsm_v(3)%qrs, surf_usm_v(3)%qrs, n_out )
-
-          CASE ( 'nrs' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%nrs, surf_lsm_h(0)%nrs, surf_usm_h(0)%nrs,                     &
-                     surf_def_h(1)%nrs, surf_lsm_h(1)%nrs, surf_usm_h(1)%nrs,                     &
-                     surf_def_v(0)%nrs, surf_lsm_v(0)%nrs, surf_usm_v(0)%nrs,                     &
-                     surf_def_v(1)%nrs, surf_lsm_v(1)%nrs, surf_usm_v(1)%nrs,                     &
-                     surf_def_v(2)%nrs, surf_lsm_v(2)%nrs, surf_usm_v(2)%nrs,                     &
-                     surf_def_v(3)%nrs, surf_lsm_v(3)%nrs, surf_usm_v(3)%nrs, n_out )
-
-          CASE ( 'ol' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%ol, surf_lsm_h(0)%ol, surf_usm_h(0)%ol,                        &
-                     surf_def_h(1)%ol, surf_lsm_h(1)%ol, surf_usm_h(1)%ol,                        &
-                     surf_def_v(0)%ol, surf_lsm_v(0)%ol, surf_usm_v(0)%ol,                        &
-                     surf_def_v(1)%ol, surf_lsm_v(1)%ol, surf_usm_v(1)%ol,                        &
-                     surf_def_v(2)%ol, surf_lsm_v(2)%ol, surf_usm_v(2)%ol,                        &
-                     surf_def_v(3)%ol, surf_lsm_v(3)%ol, surf_usm_v(3)%ol, n_out )
-
-          CASE ( 'z0' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%z0, surf_lsm_h(0)%z0, surf_usm_h(0)%z0,                        &
-                     surf_def_h(1)%z0, surf_lsm_h(1)%z0, surf_usm_h(1)%z0,                        &
-                     surf_def_v(0)%z0, surf_lsm_v(0)%z0, surf_usm_v(0)%z0,                        &
-                     surf_def_v(1)%z0, surf_lsm_v(1)%z0, surf_usm_v(1)%z0,                        &
-                     surf_def_v(2)%z0, surf_lsm_v(2)%z0, surf_usm_v(2)%z0,                        &
-                     surf_def_v(3)%z0, surf_lsm_v(3)%z0, surf_usm_v(3)%z0, n_out )
-
-          CASE ( 'z0h' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%z0h, surf_lsm_h(0)%z0h, surf_usm_h(0)%z0h,                     &
-                     surf_def_h(1)%z0h, surf_lsm_h(1)%z0h, surf_usm_h(1)%z0h,                     &
-                     surf_def_v(0)%z0h, surf_lsm_v(0)%z0h, surf_usm_v(0)%z0h,                     &
-                     surf_def_v(1)%z0h, surf_lsm_v(1)%z0h, surf_usm_v(1)%z0h,                     &
-                     surf_def_v(2)%z0h, surf_lsm_v(2)%z0h, surf_usm_v(2)%z0h,                     &
-                     surf_def_v(3)%z0h, surf_lsm_v(3)%z0h, surf_usm_v(3)%z0h, n_out )
-
-          CASE ( 'z0q' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%z0q, surf_lsm_h(0)%z0q, surf_usm_h(0)%z0q,                     &
-                     surf_def_h(1)%z0q, surf_lsm_h(1)%z0q, surf_usm_h(1)%z0q,                     &
-                     surf_def_v(0)%z0q, surf_lsm_v(0)%z0q, surf_usm_v(0)%z0q,                     &
-                     surf_def_v(1)%z0q, surf_lsm_v(1)%z0q, surf_usm_v(1)%z0q,                     &
-                     surf_def_v(2)%z0q, surf_lsm_v(2)%z0q, surf_usm_v(2)%z0q,                     &
-                     surf_def_v(3)%z0q, surf_lsm_v(3)%z0q, surf_usm_v(3)%z0q, n_out )
-
-          CASE ( 'theta1' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%pt1, surf_lsm_h(0)%pt1, surf_usm_h(0)%pt1,                     &
-                     surf_def_h(1)%pt1, surf_lsm_h(1)%pt1, surf_usm_h(1)%pt1,                     &
-                     surf_def_v(0)%pt1, surf_lsm_v(0)%pt1, surf_usm_v(0)%pt1,                     &
-                     surf_def_v(1)%pt1, surf_lsm_v(1)%pt1, surf_usm_v(1)%pt1,                     &
-                     surf_def_v(2)%pt1, surf_lsm_v(2)%pt1, surf_usm_v(2)%pt1,                     &
-                     surf_def_v(3)%pt1, surf_lsm_v(3)%pt1, surf_usm_v(3)%pt1, n_out )
-
-          CASE ( 'qv1' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%qv1, surf_lsm_h(0)%qv1, surf_usm_h(0)%qv1,                     &
-                     surf_def_h(1)%qv1, surf_lsm_h(1)%qv1, surf_usm_h(1)%qv1,                     &
-                     surf_def_v(0)%qv1, surf_lsm_v(0)%qv1, surf_usm_v(0)%qv1,                     &
-                     surf_def_v(1)%qv1, surf_lsm_v(1)%qv1, surf_usm_v(1)%qv1,                     &
-                     surf_def_v(2)%qv1, surf_lsm_v(2)%qv1, surf_usm_v(2)%qv1,                     &
-                     surf_def_v(3)%qv1, surf_lsm_v(3)%qv1, surf_usm_v(3)%qv1, n_out )
-
-          CASE ( 'thetav1' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%vpt1, surf_lsm_h(0)%vpt1, surf_usm_h(0)%vpt1,                  &
-                     surf_def_h(1)%vpt1, surf_lsm_h(1)%vpt1, surf_usm_h(1)%vpt1,                  &
-                     surf_def_v(0)%vpt1, surf_lsm_v(0)%vpt1, surf_usm_v(0)%vpt1,                  &
-                     surf_def_v(1)%vpt1, surf_lsm_v(1)%vpt1, surf_usm_v(1)%vpt1,                  &
-                     surf_def_v(2)%vpt1, surf_lsm_v(2)%vpt1, surf_usm_v(2)%vpt1,                  &
-                     surf_def_v(3)%vpt1, surf_lsm_v(3)%vpt1, surf_usm_v(3)%vpt1, n_out )
-
-          CASE ( 'usws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%usws, surf_lsm_h(0)%usws, surf_usm_h(0)%usws,                  &
-                     surf_def_h(1)%usws, surf_lsm_h(1)%usws, surf_usm_h(1)%usws,                  &
-                     surf_def_v(0)%usws, surf_lsm_v(0)%usws, surf_usm_v(0)%usws,                  &
-                     surf_def_v(1)%usws, surf_lsm_v(1)%usws, surf_usm_v(1)%usws,                  &
-                     surf_def_v(2)%usws, surf_lsm_v(2)%usws, surf_usm_v(2)%usws,                  &
-                     surf_def_v(3)%usws, surf_lsm_v(3)%usws, surf_usm_v(3)%usws, n_out,           &
-                     momentumflux_output_conversion )
-
-          CASE ( 'vsws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%vsws, surf_lsm_h(0)%vsws, surf_usm_h(0)%vsws,                  &
-                     surf_def_h(1)%vsws, surf_lsm_h(1)%vsws, surf_usm_h(1)%vsws,                  &
-                     surf_def_v(0)%vsws, surf_lsm_v(0)%vsws, surf_usm_v(0)%vsws,                  &
-                     surf_def_v(1)%vsws, surf_lsm_v(1)%vsws, surf_usm_v(1)%vsws,                  &
-                     surf_def_v(2)%vsws, surf_lsm_v(2)%vsws, surf_usm_v(2)%vsws,                  &
-                     surf_def_v(3)%vsws, surf_lsm_v(3)%vsws, surf_usm_v(3)%vsws, n_out,           &
-                     momentumflux_output_conversion )
-
-          CASE ( 'shf' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%shf, surf_lsm_h(0)%shf, surf_usm_h(0)%shf,                     &
-                     surf_def_h(1)%shf, surf_lsm_h(1)%shf, surf_usm_h(1)%shf,                     &
-                     surf_def_v(0)%shf, surf_lsm_v(0)%shf, surf_usm_v(0)%shf,                     &
-                     surf_def_v(1)%shf, surf_lsm_v(1)%shf, surf_usm_v(1)%shf,                     &
-                     surf_def_v(2)%shf, surf_lsm_v(2)%shf, surf_usm_v(2)%shf,                     &
-                     surf_def_v(3)%shf, surf_lsm_v(3)%shf, surf_usm_v(3)%shf, n_out,              &
-                     heatflux_output_conversion )
-
-          CASE ( 'qsws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%qsws, surf_lsm_h(0)%qsws, surf_usm_h(0)%qsws,                  &
-                     surf_def_h(1)%qsws, surf_lsm_h(1)%qsws, surf_usm_h(1)%qsws,                  &
-                     surf_def_v(0)%qsws, surf_lsm_v(0)%qsws, surf_usm_v(0)%qsws,                  &
-                     surf_def_v(1)%qsws, surf_lsm_v(1)%qsws, surf_usm_v(1)%qsws,                  &
-                     surf_def_v(2)%qsws, surf_lsm_v(2)%qsws, surf_usm_v(2)%qsws,                  &
-                     surf_def_v(3)%qsws, surf_lsm_v(3)%qsws, surf_usm_v(3)%qsws, n_out,           &
-                     waterflux_output_conversion )
-
-          CASE ( 'ssws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%ssws, surf_lsm_h(0)%ssws, surf_usm_h(0)%ssws,                  &
-                     surf_def_h(1)%ssws, surf_lsm_h(1)%ssws, surf_usm_h(1)%ssws,                  &
-                     surf_def_v(0)%ssws, surf_lsm_v(0)%ssws, surf_usm_v(0)%ssws,                  &
-                     surf_def_v(1)%ssws, surf_lsm_v(1)%ssws, surf_usm_v(1)%ssws,                  &
-                     surf_def_v(2)%ssws, surf_lsm_v(2)%ssws, surf_usm_v(2)%ssws,                  &
-                     surf_def_v(3)%ssws, surf_lsm_v(3)%ssws, surf_usm_v(3)%ssws, n_out )
-
-          CASE ( 'qcsws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%qcsws, surf_lsm_h(0)%qcsws, surf_usm_h(0)%qcsws,               &
-                     surf_def_h(1)%qcsws, surf_lsm_h(1)%qcsws, surf_usm_h(1)%qcsws,               &
-                     surf_def_v(0)%qcsws, surf_lsm_v(0)%qcsws, surf_usm_v(0)%qcsws,               &
-                     surf_def_v(1)%qcsws, surf_lsm_v(1)%qcsws, surf_usm_v(1)%qcsws,               &
-                     surf_def_v(2)%qcsws, surf_lsm_v(2)%qcsws, surf_usm_v(2)%qcsws,               &
-                     surf_def_v(3)%qcsws, surf_lsm_v(3)%qcsws, surf_usm_v(3)%qcsws, n_out )
-
-          CASE ( 'ncsws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%ncsws, surf_lsm_h(0)%ncsws, surf_usm_h(0)%ncsws,               &
-                     surf_def_h(1)%ncsws, surf_lsm_h(1)%ncsws, surf_usm_h(1)%ncsws,               &
-                     surf_def_v(0)%ncsws, surf_lsm_v(0)%ncsws, surf_usm_v(0)%ncsws,               &
-                     surf_def_v(1)%ncsws, surf_lsm_v(1)%ncsws, surf_usm_v(1)%ncsws,               &
-                     surf_def_v(2)%ncsws, surf_lsm_v(2)%ncsws, surf_usm_v(2)%ncsws,               &
-                     surf_def_v(3)%ncsws, surf_lsm_v(3)%ncsws, surf_usm_v(3)%ncsws, n_out )
-
-          CASE ( 'qisws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%qisws, surf_lsm_h(0)%qisws, surf_usm_h(0)%qisws,               &
-                     surf_def_h(1)%qisws, surf_lsm_h(1)%qisws, surf_usm_h(1)%qisws,               &
-                     surf_def_v(0)%qisws, surf_lsm_v(0)%qisws, surf_usm_v(0)%qisws,               &
-                     surf_def_v(1)%qisws, surf_lsm_v(1)%qisws, surf_usm_v(1)%qisws,               &
-                     surf_def_v(2)%qisws, surf_lsm_v(2)%qisws, surf_usm_v(2)%qisws,               &
-                     surf_def_v(3)%qisws, surf_lsm_v(3)%qisws, surf_usm_v(3)%qisws, n_out )
-
-          CASE ( 'nisws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%nisws, surf_lsm_h(0)%nisws, surf_usm_h(0)%nisws,               &
-                     surf_def_h(1)%nisws, surf_lsm_h(1)%nisws, surf_usm_h(1)%nisws,               &
-                     surf_def_v(0)%nisws, surf_lsm_v(0)%nisws, surf_usm_v(0)%nisws,               &
-                     surf_def_v(1)%nisws, surf_lsm_v(1)%nisws, surf_usm_v(1)%nisws,               &
-                     surf_def_v(2)%nisws, surf_lsm_v(2)%nisws, surf_usm_v(2)%nisws,               &
-                     surf_def_v(3)%nisws, surf_lsm_v(3)%nisws, surf_usm_v(3)%nisws, n_out )
-
-          CASE ( 'qrsws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%qrsws, surf_lsm_h(0)%qrsws, surf_usm_h(0)%qrsws,               &
-                     surf_def_h(1)%qrsws, surf_lsm_h(1)%qrsws, surf_usm_h(1)%qrsws,               &
-                     surf_def_v(0)%qrsws, surf_lsm_v(0)%qrsws, surf_usm_v(0)%qrsws,               &
-                     surf_def_v(1)%qrsws, surf_lsm_v(1)%qrsws, surf_usm_v(1)%qrsws,               &
-                     surf_def_v(2)%qrsws, surf_lsm_v(2)%qrsws, surf_usm_v(2)%qrsws,               &
-                     surf_def_v(3)%qrsws, surf_lsm_v(3)%qrsws, surf_usm_v(3)%qrsws, n_out )
-
-          CASE ( 'nrsws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%nrsws, surf_lsm_h(0)%nrsws, surf_usm_h(0)%nrsws,               &
-                     surf_def_h(1)%nrsws, surf_lsm_h(1)%nrsws, surf_usm_h(1)%nrsws,               &
-                     surf_def_v(0)%nrsws, surf_lsm_v(0)%nrsws, surf_usm_v(0)%nrsws,               &
-                     surf_def_v(1)%nrsws, surf_lsm_v(1)%nrsws, surf_usm_v(1)%nrsws,               &
-                     surf_def_v(2)%nrsws, surf_lsm_v(2)%nrsws, surf_usm_v(2)%nrsws,               &
-                     surf_def_v(3)%nrsws, surf_lsm_v(3)%nrsws, surf_usm_v(3)%nrsws, n_out )
-
-          CASE ( 'sasws' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%sasws, surf_lsm_h(0)%sasws, surf_usm_h(0)%sasws,               &
-                     surf_def_h(1)%sasws, surf_lsm_h(1)%sasws, surf_usm_h(1)%sasws,               &
-                     surf_def_v(0)%sasws, surf_lsm_v(0)%sasws, surf_usm_v(0)%sasws,               &
-                     surf_def_v(1)%sasws, surf_lsm_v(1)%sasws, surf_usm_v(1)%sasws,               &
-                     surf_def_v(2)%sasws, surf_lsm_v(2)%sasws, surf_usm_v(2)%sasws,               &
-                     surf_def_v(3)%sasws, surf_lsm_v(3)%sasws, surf_usm_v(3)%sasws, n_out )
-
-          CASE ( 'q_surface' )
-             CALL surface_data_output_sum_up(                                                    &
-                     surf_def_h(0)%q_surface, surf_lsm_h(0)%q_surface, surf_usm_h(0)%q_surface,  &
-                     surf_def_h(1)%q_surface, surf_lsm_h(1)%q_surface, surf_usm_h(1)%q_surface,  &
-                     surf_def_v(0)%q_surface, surf_lsm_v(0)%q_surface, surf_usm_v(0)%q_surface,  &
-                     surf_def_v(1)%q_surface, surf_lsm_v(1)%q_surface, surf_usm_v(1)%q_surface,  &
-                     surf_def_v(2)%q_surface, surf_lsm_v(2)%q_surface, surf_usm_v(2)%q_surface,  &
-                     surf_def_v(3)%q_surface, surf_lsm_v(3)%q_surface, surf_usm_v(3)%q_surface,  &
-                     n_out )
-
-          CASE ( 'theta_surface' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%pt_surface, surf_lsm_h(0)%pt_surface, surf_usm_h(0)%pt_surface,  &
-                  surf_def_h(1)%pt_surface, surf_lsm_h(1)%pt_surface, surf_usm_h(1)%pt_surface,  &
-                  surf_def_v(0)%pt_surface, surf_lsm_v(0)%pt_surface, surf_usm_v(0)%pt_surface,  &
-                  surf_def_v(1)%pt_surface, surf_lsm_v(1)%pt_surface, surf_usm_v(1)%pt_surface,  &
-                  surf_def_v(2)%pt_surface, surf_lsm_v(2)%pt_surface, surf_usm_v(2)%pt_surface,  &
-                  surf_def_v(3)%pt_surface, surf_lsm_v(3)%pt_surface, surf_usm_v(3)%pt_surface,  &
-                  n_out )
-
-          CASE ( 'thetav_surface' )
-             CALL surface_data_output_sum_up(                                                    &
-                surf_def_h(0)%vpt_surface, surf_lsm_h(0)%vpt_surface, surf_usm_h(0)%vpt_surface, &
-                surf_def_h(1)%vpt_surface, surf_lsm_h(1)%vpt_surface, surf_usm_h(1)%vpt_surface, &
-                surf_def_v(0)%vpt_surface, surf_lsm_v(0)%vpt_surface, surf_usm_v(0)%vpt_surface, &
-                surf_def_v(1)%vpt_surface, surf_lsm_v(1)%vpt_surface, surf_usm_v(1)%vpt_surface, &
-                surf_def_v(2)%vpt_surface, surf_lsm_v(2)%vpt_surface, surf_usm_v(2)%vpt_surface, &
-                surf_def_v(3)%vpt_surface, surf_lsm_v(3)%vpt_surface, surf_usm_v(3)%pt_surface,  &
-                n_out )
-
-          CASE ( 'rad_net' )
-             CALL surface_data_output_sum_up(                                                    &
-                     surf_def_h(0)%rad_net, surf_lsm_h(0)%rad_net, surf_usm_h(0)%rad_net,        &
-                     surf_def_h(1)%rad_net, surf_lsm_h(1)%rad_net, surf_usm_h(1)%rad_net,        &
-                     surf_def_v(0)%rad_net, surf_lsm_v(0)%rad_net, surf_usm_v(0)%rad_net,        &
-                     surf_def_v(1)%rad_net, surf_lsm_v(1)%rad_net, surf_usm_v(1)%rad_net,        &
-                     surf_def_v(2)%rad_net, surf_lsm_v(2)%rad_net, surf_usm_v(2)%rad_net,        &
-                     surf_def_v(3)%rad_net, surf_lsm_v(3)%rad_net, surf_usm_v(3)%rad_net,        &
-                     n_out )
-
-          CASE ( 'rad_lw_in' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%rad_lw_in, surf_lsm_h(0)%rad_lw_in, surf_usm_h(0)%rad_lw_in,     &
-                  surf_def_h(1)%rad_lw_in, surf_lsm_h(1)%rad_lw_in, surf_usm_h(1)%rad_lw_in,     &
-                  surf_def_v(0)%rad_lw_in, surf_lsm_v(0)%rad_lw_in, surf_usm_v(0)%rad_lw_in,     &
-                  surf_def_v(1)%rad_lw_in, surf_lsm_v(1)%rad_lw_in, surf_usm_v(1)%rad_lw_in,     &
-                  surf_def_v(2)%rad_lw_in, surf_lsm_v(2)%rad_lw_in, surf_usm_v(2)%rad_lw_in,     &
-                  surf_def_v(3)%rad_lw_in, surf_lsm_v(3)%rad_lw_in, surf_usm_v(3)%rad_lw_in,     &
-                  n_out )
-
-          CASE ( 'rad_lw_out' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%rad_lw_out, surf_lsm_h(0)%rad_lw_out, surf_usm_h(0)%rad_lw_out,  &
-                  surf_def_h(1)%rad_lw_out, surf_lsm_h(1)%rad_lw_out, surf_usm_h(1)%rad_lw_out,  &
-                  surf_def_v(0)%rad_lw_out, surf_lsm_v(0)%rad_lw_out, surf_usm_v(0)%rad_lw_out,  &
-                  surf_def_v(1)%rad_lw_out, surf_lsm_v(1)%rad_lw_out, surf_usm_v(1)%rad_lw_out,  &
-                  surf_def_v(2)%rad_lw_out, surf_lsm_v(2)%rad_lw_out, surf_usm_v(2)%rad_lw_out,  &
-                  surf_def_v(3)%rad_lw_out, surf_lsm_v(3)%rad_lw_out, surf_usm_v(3)%rad_lw_out,  &
-                  n_out )
-
-          CASE ( 'rad_sw_in' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%rad_sw_in, surf_lsm_h(0)%rad_sw_in, surf_usm_h(0)%rad_sw_in,     &
-                  surf_def_h(1)%rad_sw_in, surf_lsm_h(1)%rad_sw_in, surf_usm_h(1)%rad_sw_in,     &
-                  surf_def_v(0)%rad_sw_in, surf_lsm_v(0)%rad_sw_in, surf_usm_v(0)%rad_sw_in,     &
-                  surf_def_v(1)%rad_sw_in, surf_lsm_v(1)%rad_sw_in, surf_usm_v(1)%rad_sw_in,     &
-                  surf_def_v(2)%rad_sw_in, surf_lsm_v(2)%rad_sw_in, surf_usm_v(2)%rad_sw_in,     &
-                  surf_def_v(3)%rad_sw_in, surf_lsm_v(3)%rad_sw_in, surf_usm_v(3)%rad_sw_in,     &
-                  n_out )
-
-          CASE ( 'rad_sw_out' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%rad_sw_out, surf_lsm_h(0)%rad_sw_out, surf_usm_h(0)%rad_sw_out,  &
-                  surf_def_h(1)%rad_sw_out, surf_lsm_h(1)%rad_sw_out, surf_usm_h(1)%rad_sw_out,  &
-                  surf_def_v(0)%rad_sw_out, surf_lsm_v(0)%rad_sw_out, surf_usm_v(0)%rad_sw_out,  &
-                  surf_def_v(1)%rad_sw_out, surf_lsm_v(1)%rad_sw_out, surf_usm_v(1)%rad_sw_out,  &
-                  surf_def_v(2)%rad_sw_out, surf_lsm_v(2)%rad_sw_out, surf_usm_v(2)%rad_sw_out,  &
-                  surf_def_v(3)%rad_sw_out, surf_lsm_v(3)%rad_sw_out, surf_usm_v(3)%rad_sw_out,  &
-                  n_out )
-
-          CASE ( 'ghf' )
-!
-!--          Sum up ground / wall heat flux. Note, for urban surfaces the wall heat flux is
-!--          aggregated from the different green, window and wall tiles.
-             DO  l = 0, 1
-                DO  m = 1, surf_usm_h(l)%ns
-                   surf_usm_h(l)%ghf(m) = surf_usm_h(l)%frac(m,ind_veg_wall) *                    &
-                                       surf_usm_h(l)%wghf_eb(m) +                                 &
-                                       surf_usm_h(l)%frac(m,ind_pav_green) *                      &
-                                       surf_usm_h(l)%wghf_eb_green(m) +                           &
-                                       surf_usm_h(l)%frac(m,ind_wat_win) *                        &
-                                       surf_usm_h(l)%wghf_eb_window(m)
-                ENDDO
-             ENDDO
-             DO  l = 0, 3
-                DO  m = 1, surf_usm_v(l)%ns
-                   surf_usm_v(l)%ghf(m) = surf_usm_v(l)%frac(m,ind_veg_wall) *                     &
-                                          surf_usm_v(l)%wghf_eb(m) +                               &
-                                          surf_usm_v(l)%frac(m,ind_pav_green) *                    &
-                                          surf_usm_v(l)%wghf_eb_green(m) +                         &
-                                          surf_usm_v(l)%frac(m,ind_wat_win) *                      &
-                                          surf_usm_v(l)%wghf_eb_window(m)
-                ENDDO
-             ENDDO
-
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%ghf, surf_lsm_h(0)%ghf, surf_usm_h(0)%ghf,                     &
-                     surf_def_h(1)%ghf, surf_lsm_h(1)%ghf, surf_usm_h(1)%ghf,                     &
-                     surf_def_v(0)%ghf, surf_lsm_v(0)%ghf, surf_usm_v(0)%ghf,                     &
-                     surf_def_v(1)%ghf, surf_lsm_v(1)%ghf, surf_usm_v(1)%ghf,                     &
-                     surf_def_v(2)%ghf, surf_lsm_v(2)%ghf, surf_usm_v(2)%ghf,                     &
-                     surf_def_v(3)%ghf, surf_lsm_v(3)%ghf, surf_usm_v(3)%ghf, n_out )
-
-          CASE ( 'r_a' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%r_a, surf_lsm_h(0)%r_a, surf_usm_h(0)%r_a,                     &
-                     surf_def_h(1)%r_a, surf_lsm_h(1)%r_a, surf_usm_h(1)%r_a,                     &
-                     surf_def_v(0)%r_a, surf_lsm_v(0)%r_a, surf_usm_v(0)%r_a,                     &
-                     surf_def_v(1)%r_a, surf_lsm_v(1)%r_a, surf_usm_v(1)%r_a,                     &
-                     surf_def_v(2)%r_a, surf_lsm_v(2)%r_a, surf_usm_v(2)%r_a,                     &
-                     surf_def_v(3)%r_a, surf_lsm_v(3)%r_a, surf_usm_v(3)%r_a, n_out )
-
-          CASE ( 'r_soil' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%r_soil, surf_lsm_h(0)%r_soil, surf_usm_h(0)%r_soil,            &
-                     surf_def_h(1)%r_soil, surf_lsm_h(1)%r_soil, surf_usm_h(1)%r_soil,            &
-                     surf_def_v(0)%r_soil, surf_lsm_v(0)%r_soil, surf_usm_v(0)%r_soil,            &
-                     surf_def_v(1)%r_soil, surf_lsm_v(1)%r_soil, surf_usm_v(1)%r_soil,            &
-                     surf_def_v(2)%r_soil, surf_lsm_v(2)%r_soil, surf_usm_v(2)%r_soil,            &
-                     surf_def_v(3)%r_soil, surf_lsm_v(3)%r_soil, surf_usm_v(3)%r_soil, n_out )
-
-          CASE ( 'r_canopy' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%r_canopy, surf_lsm_h(0)%r_canopy, surf_usm_h(0)%r_canopy,      &
-                     surf_def_h(1)%r_canopy, surf_lsm_h(1)%r_canopy, surf_usm_h(1)%r_canopy,      &
-                     surf_def_v(0)%r_canopy, surf_lsm_v(0)%r_canopy, surf_usm_v(0)%r_canopy,      &
-                     surf_def_v(1)%r_canopy, surf_lsm_v(1)%r_canopy, surf_usm_v(1)%r_canopy,      &
-                     surf_def_v(2)%r_canopy, surf_lsm_v(2)%r_canopy, surf_usm_v(2)%r_canopy,      &
-                     surf_def_v(3)%r_canopy, surf_lsm_v(3)%r_canopy, surf_usm_v(3)%r_canopy,      &
-                     n_out )
-
-          CASE ( 'r_s' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%r_s, surf_lsm_h(0)%r_s, surf_usm_h(0)%r_s,                     &
-                     surf_def_h(1)%r_s, surf_lsm_h(1)%r_s, surf_usm_h(1)%r_s,                     &
-                     surf_def_v(0)%r_s, surf_lsm_v(0)%r_s, surf_usm_v(0)%r_s,                     &
-                     surf_def_v(1)%r_s, surf_lsm_v(1)%r_s, surf_usm_v(1)%r_s,                     &
-                     surf_def_v(2)%r_s, surf_lsm_v(2)%r_s, surf_usm_v(2)%r_s,                     &
-                     surf_def_v(3)%r_s, surf_lsm_v(3)%r_s, surf_usm_v(3)%r_s, n_out )
-
-
-          CASE ( 'rad_sw_dir' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%rad_sw_dir, surf_lsm_h(0)%rad_sw_dir, surf_usm_h(0)%rad_sw_dir,  &
-                  surf_def_h(1)%rad_sw_dir, surf_lsm_h(1)%rad_sw_dir, surf_usm_h(1)%rad_sw_dir,  &
-                  surf_def_v(0)%rad_sw_dir, surf_lsm_v(0)%rad_sw_dir, surf_usm_v(0)%rad_sw_dir,  &
-                  surf_def_v(1)%rad_sw_dir, surf_lsm_v(1)%rad_sw_dir, surf_usm_v(1)%rad_sw_dir,  &
-                  surf_def_v(2)%rad_sw_dir, surf_lsm_v(2)%rad_sw_dir, surf_usm_v(2)%rad_sw_dir,  &
-                  surf_def_v(3)%rad_sw_dir, surf_lsm_v(3)%rad_sw_dir, surf_usm_v(3)%rad_sw_dir,  &
-                  n_out )
-          CASE ( 'rad_sw_dif' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%rad_sw_dif, surf_lsm_h(0)%rad_sw_dif, surf_usm_h(0)%rad_sw_dif,  &
-                  surf_def_h(1)%rad_sw_dif, surf_lsm_h(1)%rad_sw_dif, surf_usm_h(1)%rad_sw_dif,  &
-                  surf_def_v(0)%rad_sw_dif, surf_lsm_v(0)%rad_sw_dif, surf_usm_v(0)%rad_sw_dif,  &
-                  surf_def_v(1)%rad_sw_dif, surf_lsm_v(1)%rad_sw_dif, surf_usm_v(1)%rad_sw_dif,  &
-                  surf_def_v(2)%rad_sw_dif, surf_lsm_v(2)%rad_sw_dif, surf_usm_v(2)%rad_sw_dif,  &
-                  surf_def_v(3)%rad_sw_dif, surf_lsm_v(3)%rad_sw_dif, surf_usm_v(3)%rad_sw_dif,  &
-                  n_out )
-
-          CASE ( 'rad_sw_ref' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%rad_sw_ref, surf_lsm_h(0)%rad_sw_ref, surf_usm_h(0)%rad_sw_ref,  &
-                  surf_def_h(1)%rad_sw_ref, surf_lsm_h(1)%rad_sw_ref, surf_usm_h(1)%rad_sw_ref,  &
-                  surf_def_v(0)%rad_sw_ref, surf_lsm_v(0)%rad_sw_ref, surf_usm_v(0)%rad_sw_ref,  &
-                  surf_def_v(1)%rad_sw_ref, surf_lsm_v(1)%rad_sw_ref, surf_usm_v(1)%rad_sw_ref,  &
-                  surf_def_v(2)%rad_sw_ref, surf_lsm_v(2)%rad_sw_ref, surf_usm_v(2)%rad_sw_ref,  &
-                  surf_def_v(3)%rad_sw_ref, surf_lsm_v(3)%rad_sw_ref, surf_usm_v(3)%rad_sw_ref,  &
-                  n_out )
-
-          CASE ( 'rad_sw_res' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%rad_sw_res, surf_lsm_h(0)%rad_sw_res, surf_usm_h(0)%rad_sw_res,  &
-                  surf_def_h(1)%rad_sw_res, surf_lsm_h(1)%rad_sw_res, surf_usm_h(1)%rad_sw_res,  &
-                  surf_def_v(0)%rad_sw_res, surf_lsm_v(0)%rad_sw_res, surf_usm_v(0)%rad_sw_res,  &
-                  surf_def_v(1)%rad_sw_res, surf_lsm_v(1)%rad_sw_res, surf_usm_v(1)%rad_sw_res,  &
-                  surf_def_v(2)%rad_sw_res, surf_lsm_v(2)%rad_sw_res, surf_usm_v(2)%rad_sw_res,  &
-                  surf_def_v(3)%rad_sw_res, surf_lsm_v(3)%rad_sw_res, surf_usm_v(3)%rad_sw_res,  &
-                  n_out )
-
-          CASE ( 'rad_lw_dif' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%rad_lw_dif, surf_lsm_h(0)%rad_lw_dif, surf_usm_h(0)%rad_lw_dif,  &
-                  surf_def_h(1)%rad_lw_dif, surf_lsm_h(1)%rad_lw_dif, surf_usm_h(1)%rad_lw_dif,  &
-                  surf_def_v(0)%rad_lw_dif, surf_lsm_v(0)%rad_lw_dif, surf_usm_v(0)%rad_lw_dif,  &
-                  surf_def_v(1)%rad_lw_dif, surf_lsm_v(1)%rad_lw_dif, surf_usm_v(1)%rad_lw_dif,  &
-                  surf_def_v(2)%rad_lw_dif, surf_lsm_v(2)%rad_lw_dif, surf_usm_v(2)%rad_lw_dif,  &
-                  surf_def_v(3)%rad_lw_dif, surf_lsm_v(3)%rad_lw_dif, surf_usm_v(3)%rad_lw_dif,  &
-                  n_out )
-
-          CASE ( 'rad_lw_ref' )
-             CALL surface_data_output_sum_up(                                                    &
-                  surf_def_h(0)%rad_lw_ref, surf_lsm_h(0)%rad_lw_ref, surf_usm_h(0)%rad_lw_ref,  &
-                  surf_def_h(1)%rad_lw_ref, surf_lsm_h(1)%rad_lw_ref, surf_usm_h(1)%rad_lw_ref,  &
-                  surf_def_v(0)%rad_lw_ref, surf_lsm_v(0)%rad_lw_ref, surf_usm_v(0)%rad_lw_ref,  &
-                  surf_def_v(1)%rad_lw_ref, surf_lsm_v(1)%rad_lw_ref, surf_usm_v(1)%rad_lw_ref,  &
-                  surf_def_v(2)%rad_lw_ref, surf_lsm_v(2)%rad_lw_ref, surf_usm_v(2)%rad_lw_ref,  &
-                  surf_def_v(3)%rad_lw_ref, surf_lsm_v(3)%rad_lw_ref, surf_usm_v(3)%rad_lw_ref,  &
-                  n_out )
-
-          CASE ( 'rad_lw_res' )
-             CALL surface_data_output_sum_up(                                                     &
-                  surf_def_h(0)%rad_lw_res, surf_lsm_h(0)%rad_lw_res, surf_usm_h(0)%rad_lw_res,  &
-                  surf_def_h(1)%rad_lw_res, surf_lsm_h(1)%rad_lw_res, surf_usm_h(1)%rad_lw_res,  &
-                  surf_def_v(0)%rad_lw_res, surf_lsm_v(0)%rad_lw_res, surf_usm_v(0)%rad_lw_res,  &
-                  surf_def_v(1)%rad_lw_res, surf_lsm_v(1)%rad_lw_res, surf_usm_v(1)%rad_lw_res,  &
-                  surf_def_v(2)%rad_lw_res, surf_lsm_v(2)%rad_lw_res, surf_usm_v(2)%rad_lw_res,  &
-                  surf_def_v(3)%rad_lw_res, surf_lsm_v(3)%rad_lw_res, surf_usm_v(3)%rad_lw_res,  &
-                  n_out )
-
-          CASE ( 'uvw1' )
-             CALL surface_data_output_sum_up(                                                    &
-                     surf_def_h(0)%uvw_abs, surf_lsm_h(0)%uvw_abs, surf_usm_h(0)%uvw_abs,        &
-                     surf_def_h(1)%uvw_abs, surf_lsm_h(1)%uvw_abs, surf_usm_h(1)%uvw_abs,        &
-                     surf_def_v(0)%uvw_abs, surf_lsm_v(0)%uvw_abs, surf_usm_v(0)%uvw_abs,        &
-                     surf_def_v(1)%uvw_abs, surf_lsm_v(1)%uvw_abs, surf_usm_v(1)%uvw_abs,        &
-                     surf_def_v(2)%uvw_abs, surf_lsm_v(2)%uvw_abs, surf_usm_v(2)%uvw_abs,        &
-                     surf_def_v(3)%uvw_abs, surf_lsm_v(3)%uvw_abs, surf_usm_v(3)%uvw_abs, n_out )
-
-          CASE ( 'waste_heat' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%waste_heat, surf_lsm_h(0)%waste_heat, surf_usm_h(0)%waste_heat,&
-                     surf_def_h(1)%waste_heat, surf_lsm_h(1)%waste_heat, surf_usm_h(1)%waste_heat,&
-                     surf_def_v(0)%waste_heat, surf_lsm_v(0)%waste_heat, surf_usm_v(0)%waste_heat,&
-                     surf_def_v(1)%waste_heat, surf_lsm_v(1)%waste_heat, surf_usm_v(1)%waste_heat,&
-                     surf_def_v(2)%waste_heat, surf_lsm_v(2)%waste_heat, surf_usm_v(2)%waste_heat,&
-                     surf_def_v(3)%waste_heat, surf_lsm_v(3)%waste_heat, surf_usm_v(3)%waste_heat,&
-                     n_out )
-
-          CASE ( 'im_hf' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%iwghf_eb, surf_lsm_h(0)%iwghf_eb, surf_usm_h(0)%iwghf_eb,      &
-                     surf_def_h(1)%iwghf_eb, surf_lsm_h(1)%iwghf_eb, surf_usm_h(1)%iwghf_eb,      &
-                     surf_def_v(0)%iwghf_eb, surf_lsm_v(0)%iwghf_eb, surf_usm_v(0)%iwghf_eb,      &
-                     surf_def_v(1)%iwghf_eb, surf_lsm_v(1)%iwghf_eb, surf_usm_v(1)%iwghf_eb,      &
-                     surf_def_v(2)%iwghf_eb, surf_lsm_v(2)%iwghf_eb, surf_usm_v(2)%iwghf_eb,      &
-                     surf_def_v(3)%iwghf_eb, surf_lsm_v(3)%iwghf_eb, surf_usm_v(3)%iwghf_eb,      &
-                     n_out )
-
-          CASE ( 'albedo' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%albedo, surf_lsm_h(0)%albedo, surf_usm_h(0)%albedo,            &
-                     surf_def_h(1)%albedo, surf_lsm_h(1)%albedo, surf_usm_h(1)%albedo,            &
-                     surf_def_v(0)%albedo, surf_lsm_v(0)%albedo, surf_usm_v(0)%albedo,            &
-                     surf_def_v(1)%albedo, surf_lsm_v(1)%albedo, surf_usm_v(1)%albedo,            &
-                     surf_def_v(2)%albedo, surf_lsm_v(2)%albedo, surf_usm_v(2)%albedo,            &
-                     surf_def_v(3)%albedo, surf_lsm_v(3)%albedo, surf_usm_v(3)%albedo, n_out )
-
-
-          CASE ( 'emissivity' )
-             CALL surface_data_output_sum_up(                                                     &
-                     surf_def_h(0)%emissivity, surf_lsm_h(0)%emissivity, surf_usm_h(0)%emissivity,&
-                     surf_def_h(1)%emissivity, surf_lsm_h(1)%emissivity, surf_usm_h(1)%emissivity,&
-                     surf_def_v(0)%emissivity, surf_lsm_v(0)%emissivity, surf_usm_v(0)%emissivity,&
-                     surf_def_v(1)%emissivity, surf_lsm_v(1)%emissivity, surf_usm_v(1)%emissivity,&
-                     surf_def_v(2)%emissivity, surf_lsm_v(2)%emissivity, surf_usm_v(2)%emissivity,&
-                     surf_def_v(3)%emissivity, surf_lsm_v(3)%emissivity, surf_usm_v(3)%emissivity,&
-                     n_out )
-
-       END SELECT
-    ENDDO
-
-
- END SUBROUTINE surface_data_output_averaging
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sum-up the surface data for average output variables.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_sum_up_1d(  var_def_h0, var_lsm_h0, var_usm_h0,        &
-                                            var_def_h1, var_lsm_h1, var_usm_h1,        &
-                                            var_def_v0, var_lsm_v0, var_usm_v0,        &
-                                            var_def_v1, var_lsm_v1, var_usm_v1,        &
-                                            var_def_v2, var_lsm_v2, var_usm_v2,        &
-                                            var_def_v3, var_lsm_v3, var_usm_v3,        &
-                                            n_out, fac )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k       !< height index of surface element
-    INTEGER(iwp) ::  m       !< running index for surface elements
-    INTEGER(iwp) ::  n_out   !< index for output variable
-    INTEGER(iwp) ::  n_surf  !< running index for surface elements
-
-    REAL(wp), DIMENSION(:), OPTIONAL                ::  fac                !< passed output conversion factor for heatflux output
-    REAL(wp), DIMENSION(nzb:nzt+1)                  ::  conversion_factor  !< effective array for output conversion factor
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_h0  !< output variable at upward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_h0  !< output variable at upward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_h0  !< output variable at upward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_h1  !< output variable at downward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_h1  !< output variable at downward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_h1  !< output variable at downward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_v0  !< output variable at northward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_v1  !< output variable at southward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_v2  !< output variable at eastward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_v3  !< output variable at westward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v0  !< output variable at northward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v1  !< output variable at southward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v2  !< output variable at eastward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v3  !< output variable at westward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_v0  !< output variable at northward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_v1  !< output variable at southward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_v2  !< output variable at eastward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_v3  !< output variable at westward-facing urban-type surfaces
-
-!
-!-- Set conversion factor to one if not present
-    IF ( .NOT. PRESENT( fac ) )  THEN
-       conversion_factor = 1.0_wp
-    ELSE
-       conversion_factor = fac
-    ENDIF
-!
-!-- Set counter variable to zero before the variable is written to the output array.
-    n_surf = 0
-
-!
-!-- Write the horizontal surfaces.
-!-- Before each variable is written to the output data structure, first check if the variable
-!-- for the respective surface type is defined. If a variable is not defined, skip the block and
-!-- increment the counter variable by the number of surface elements of this type. Usually this is
-!-- zero, however, there might be the situation that e.g. urban surfaces are defined but the
-!-- respective variable is not allocated for this surface type. To write the data on the exact
-!-- position, increment the counter.
-    IF ( ALLOCATED( var_def_h0 ) )  THEN
-       DO  m = 1, surf_def_h(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_h(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_def_h0(m) *          &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_h0 ) )  THEN
-       DO  m = 1, surf_lsm_h(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_h(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_lsm_h0(m) *        &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_h0 ) )  THEN
-       DO  m = 1, surf_usm_h(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_h(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_usm_h0(m) *          &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_def_h1 ) )  THEN
-       DO  m = 1, surf_def_h(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_h(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_def_h1(m) *          &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_h(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_h1 ) )  THEN
-       DO  m = 1, surf_lsm_h(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_h(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_lsm_h1(m) *         &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_h(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_h1 ) )  THEN
-       DO  m = 1, surf_usm_h(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_h(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_usm_h1(m) *          &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_h(1)%ns
-    ENDIF
-!
-!-- Write northward-facing
-    IF ( ALLOCATED( var_def_v0 ) )  THEN
-       DO  m = 1, surf_def_v(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_v(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_def_v0(m) *          &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v0 ) )  THEN
-       DO  m = 1, surf_lsm_v(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_v(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_lsm_v0(m) *          &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v0 ) )  THEN
-       DO  m = 1, surf_usm_v(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_v(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_usm_v0(m) *          &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(0)%ns
-    ENDIF
-!
-!-- Write southward-facing
-    IF ( ALLOCATED( var_def_v1 ) )  THEN
-       DO  m = 1, surf_def_v(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_v(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_def_v1(m) *          &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v1 ) )  THEN
-       DO  m = 1, surf_lsm_v(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_v(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_lsm_v1(m) *          &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v1 ) )  THEN
-       DO  m = 1, surf_usm_v(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_v(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) + var_usm_v1(m) *          &
-                                          conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(1)%ns
-    ENDIF
-!
-!-- Write eastward-facing
-    IF ( ALLOCATED( var_def_v2 ) )  THEN
-       DO  m = 1, surf_def_v(2)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_v(2)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + var_def_v2(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(2)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v2 ) )  THEN
-       DO  m = 1, surf_lsm_v(2)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_v(2)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + var_lsm_v2(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(2)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v2 ) )  THEN
-       DO  m = 1, surf_usm_v(2)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_v(2)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + var_usm_v2(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(2)%ns
-    ENDIF
-!
-!-- Write westward-facing
-    IF ( ALLOCATED( var_def_v3 ) )  THEN
-       DO  m = 1, surf_def_v(3)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_v(3)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + var_def_v3(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(3)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v3 ) )  THEN
-       DO  m = 1, surf_lsm_v(3)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_v(3)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + var_lsm_v3(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(3)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v3 ) )  THEN
-       DO  m = 1, surf_usm_v(3)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_v(3)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + var_usm_v3(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(3)%ns
-    ENDIF
-
- END SUBROUTINE surface_data_output_sum_up_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sum-up the surface data for average output variables for properties which are defined using tile
-!> approach.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_sum_up_2d(  var_def_h0, var_lsm_h0, var_usm_h0,        &
-                                            var_def_h1, var_lsm_h1, var_usm_h1,        &
-                                            var_def_v0, var_lsm_v0, var_usm_v0,        &
-                                            var_def_v1, var_lsm_v1, var_usm_v1,        &
-                                            var_def_v2, var_lsm_v2, var_usm_v2,        &
-                                            var_def_v3, var_lsm_v3, var_usm_v3,        &
-                                            n_out, fac )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k       !< height index of surface element
-    INTEGER(iwp) ::  m       !< running index for surface elements
-    INTEGER(iwp) ::  n_out   !< index for output variable
-    INTEGER(iwp) ::  n_surf  !< running index for surface elements
-
-    REAL(wp), DIMENSION(:), OPTIONAL                  ::  fac                !< passed output conversion factor for heatflux output
-    REAL(wp), DIMENSION(nzb:nzt+1)                    ::  conversion_factor  !< effective array for output conversion factor
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_h0  !< output variable at upward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_h0  !< output variable at upward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_h0  !< output variable at upward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_h1  !< output variable at downward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_h1  !< output variable at downward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_h1  !< output variable at downward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_v0  !< output variable at northward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_v1  !< output variable at southward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_v2  !< output variable at eastward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_v3  !< output variable at westward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v0  !< output variable at northward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v1  !< output variable at southward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v2  !< output variable at eastward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v3  !< output variable at westward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_v0  !< output variable at northward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_v1  !< output variable at southward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_v2  !< output variable at eastward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_v3  !< output variable at westward-facing urban-type surfaces
-
-!
-!-- Set conversion factor to one if not present
-    IF ( .NOT. PRESENT( fac ) )  THEN
-       conversion_factor = 1.0_wp
-    ELSE
-       conversion_factor = fac
-    ENDIF
-!
-!-- Set counter variable to zero before the variable is written to the output array.
-    n_surf = 0
-
-!
-!-- Write the horizontal surfaces.
-!-- Before each variable is written to the output data structure, first check if the variable
-!-- for the respective surface type is defined. If a variable is not defined, skip the block and
-!-- increment the counter variable by the number of surface elements of this type. Usually this is
-!-- zero, however, there might be the situation that e.g. urban surfaces are defined but the
-!-- respective variable is not allocated for this surface type. To write the data on the exact
-!-- position, increment the counter.
-    IF ( ALLOCATED( var_def_h0 ) )  THEN
-       DO  m = 1, surf_def_h(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_h(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                          + SUM ( surf_def_h(0)%frac(m,:) *                        &
-                                          var_def_h0(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_def_h1 ) )  THEN
-       DO  m = 1, surf_def_h(1)%ns
-          n_surf                   = n_surf + 1
-          k                             = surf_def_h(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_def_h(1)%frac(m,:) *                          &
-                                          var_def_h1(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_h(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_h0 ) )  THEN
-       DO  m = 1, surf_lsm_h(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_h(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_lsm_h(0)%frac(m,:) *                          &
-                                          var_lsm_h0(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_h1 ) )  THEN
-       DO  m = 1, surf_lsm_h(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_h(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_lsm_h(1)%frac(m,:) *                          &
-                                          var_lsm_h1(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_h(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_h0 ) )  THEN
-       DO  m = 1, surf_usm_h(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_h(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_usm_h(0)%frac(m,:) *                          &
-                                          var_usm_h0(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_h1 ) )  THEN
-       DO  m = 1, surf_usm_h(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_h(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_usm_h(1)%frac(m,:) *                          &
-                                          var_usm_h1(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_h(1)%ns
-    ENDIF
-!
-!-- Write northward-facing
-    IF ( ALLOCATED( var_def_v0 ) )  THEN
-       DO  m = 1, surf_def_v(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_v(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_def_v(0)%frac(m,:) *                          &
-                                          var_def_v0(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v0 ) )  THEN
-       DO  m = 1, surf_lsm_v(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_v(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_lsm_v(0)%frac(m,:) *                          &
-                                          var_lsm_v0(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v0 ) )  THEN
-       DO  m = 1, surf_usm_v(0)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_v(0)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_usm_v(0)%frac(m,:) *                          &
-                                          var_usm_v0(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(0)%ns
-    ENDIF
-!
-!-- Write southward-facing
-    IF ( ALLOCATED( var_def_v1 ) )  THEN
-       DO  m = 1, surf_def_v(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_v(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_def_v(1)%frac(m,:) *                          &
-                                          var_def_v1(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v1 ) )  THEN
-       DO  m = 1, surf_lsm_v(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_v(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_lsm_v(1)%frac(m,:) *                          &
-                                          var_lsm_v1(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v1 ) )  THEN
-       DO  m = 1, surf_usm_v(1)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_v(1)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_usm_v(1)%frac(m,:) *                          &
-                                          var_usm_v1(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(1)%ns
-    ENDIF
-!
-!-- Write eastward-facing
-    IF ( ALLOCATED( var_def_v2 ) )  THEN
-       DO  m = 1, surf_def_v(2)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_v(2)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_def_v(2)%frac(m,:) *                          &
-                                          var_def_v2(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(2)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v2 ) )  THEN
-       DO  m = 1, surf_lsm_v(2)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_v(2)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_lsm_v(2)%frac(m,:) *                          &
-                                          var_lsm_v2(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(2)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v2 ) )  THEN
-       DO  m = 1, surf_usm_v(2)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_v(2)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_usm_v(2)%frac(m,:) *                          &
-                                          var_usm_v2(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(2)%ns
-    ENDIF
-!
-!-- Write westward-facing
-    IF ( ALLOCATED( var_def_v3 ) )  THEN
-       DO  m = 1, surf_def_v(3)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_def_v(3)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_def_v(3)%frac(m,:) *                          &
-                                          var_def_v3(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(3)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v3 ) )  THEN
-       DO  m = 1, surf_lsm_v(3)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_lsm_v(3)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_lsm_v(3)%frac(m,:) *                          &
-                                          var_lsm_v3(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(3)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v3 ) )  THEN
-       DO  m = 1, surf_usm_v(3)%ns
-          n_surf                        = n_surf + 1
-          k                             = surf_usm_v(3)%k(m)
-          surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out)                            &
-                                        + SUM ( surf_usm_v(3)%frac(m,:) *                          &
-                                          var_usm_v3(m,:) ) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(3)%ns
-    ENDIF
-
- END SUBROUTINE surface_data_output_sum_up_2d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Collect the surface data from different types and different orientation.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_collect_1d( var_def_h0, var_lsm_h0, var_usm_h0,        &
-                                            var_def_h1, var_lsm_h1, var_usm_h1,        &
-                                            var_def_v0, var_lsm_v0, var_usm_v0,        &
-                                            var_def_v1, var_lsm_v1, var_usm_v1,        &
-                                            var_def_v2, var_lsm_v2, var_usm_v2,        &
-                                            var_def_v3, var_lsm_v3, var_usm_v3, fac )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k       !< height index of surface element
-    INTEGER(iwp) ::  m       !< running index for surface elements
-    INTEGER(iwp) ::  n_surf  !< running index for surface elements
-
-    REAL(wp), DIMENSION(:), OPTIONAL                ::  fac                !< passed output conversion factor for heatflux output
-    REAL(wp), DIMENSION(nzb:nzt+1)                  ::  conversion_factor  !< effective array for output conversion factor
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_h0  !< output variable at upward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_h1  !< output variable at downward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_h0  !< output variable at upward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_h1  !< output variable at downward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_h0  !< output variable at upward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_h1  !< output variable at downward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_v0  !< output variable at northward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_v1  !< output variable at southward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_v2  !< output variable at eastward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_def_v3  !< output variable at westward-facing default-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v0  !< output variable at northward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v1  !< output variable at southward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v2  !< output variable at eastward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v3  !< output variable at westward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_v0  !< output variable at northward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_v1  !< output variable at southward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_v2  !< output variable at eastward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(IN) ::  var_usm_v3  !< output variable at westward-facing urban-type surfaces
-
-!
-!-- Set conversion factor to one if not present
-    IF ( .NOT. PRESENT( fac ) )  THEN
-       conversion_factor = 1.0_wp
-    ELSE
-       conversion_factor = fac
-    ENDIF
-!
-!-- Set counter variable to zero before the variable is written to the output array.
-    n_surf = 0
-!
-!-- Write the horizontal surfaces.
-!-- Before each variable is written to the output data structure, first check if the variable
-!-- for the respective surface type is defined. If a variable is not defined, skip the block and
-!-- increment the counter variable by the number of surface elements of this type. Usually this is
-!-- zero, however, there might be the situation that e.g. urban surfaces are defined but the
-!-- respective variable is not allocated for this surface type. To write the data on the exact
-!-- position, increment the counter.
-    IF ( ALLOCATED( var_def_h0 ) )  THEN
-       DO  m = 1, surf_def_h(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_h(0)%k(m)
-          surfaces%var_out(n_surf) = var_def_h0(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_def_h1 ) )  THEN
-       DO  m = 1, surf_def_h(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_h(1)%k(m)
-          surfaces%var_out(n_surf) = var_def_h1(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_h(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_h0 ) )  THEN
-       DO  m = 1, surf_lsm_h(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_h(0)%k(m)
-          surfaces%var_out(n_surf) = var_lsm_h0(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_h1 ) )  THEN
-       DO  m = 1, surf_lsm_h(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_h(1)%k(m)
-          surfaces%var_out(n_surf) = var_lsm_h1(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_h(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_h0 ) )  THEN
-       DO  m = 1, surf_usm_h(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_h(0)%k(m)
-          surfaces%var_out(n_surf) = var_usm_h0(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_h1 ) )  THEN
-       DO  m = 1, surf_usm_h(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_h(1)%k(m)
-          surfaces%var_out(n_surf) = var_usm_h1(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_h(1)%ns
-    ENDIF
-!
-!-- Write northward-facing
-    IF ( ALLOCATED( var_def_v0 ) )  THEN
-       DO  m = 1, surf_def_v(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_v(0)%k(m)
-          surfaces%var_out(n_surf) = var_def_v0(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v0 ) )  THEN
-       DO  m = 1, surf_lsm_v(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_v(0)%k(m)
-          surfaces%var_out(n_surf) = var_lsm_v0(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v0 ) )  THEN
-       DO  m = 1, surf_usm_v(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_v(0)%k(m)
-          surfaces%var_out(n_surf) = var_usm_v0(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(0)%ns
-    ENDIF
-!
-!-- Write southward-facing
-    IF ( ALLOCATED( var_def_v1 ) )  THEN
-       DO  m = 1, surf_def_v(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_v(1)%k(m)
-          surfaces%var_out(n_surf) = var_def_v1(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v1 ) )  THEN
-       DO  m = 1, surf_lsm_v(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_v(1)%k(m)
-          surfaces%var_out(n_surf) = var_lsm_v1(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v1 ) )  THEN
-       DO  m = 1, surf_usm_v(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_v(1)%k(m)
-          surfaces%var_out(n_surf) = var_usm_v1(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(1)%ns
-    ENDIF
-!
-!-- Write eastward-facing
-    IF ( ALLOCATED( var_def_v2 ) )  THEN
-       DO  m = 1, surf_def_v(2)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_v(2)%k(m)
-          surfaces%var_out(n_surf) = var_def_v2(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(2)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v2 ) )  THEN
-       DO  m = 1, surf_lsm_v(2)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_v(2)%k(m)
-          surfaces%var_out(n_surf) = var_lsm_v2(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(2)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v2 ) )  THEN
-       DO  m = 1, surf_usm_v(2)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_v(2)%k(m)
-          surfaces%var_out(n_surf) = var_usm_v2(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(2)%ns
-    ENDIF
-!
-!-- Write westward-facing
-    IF ( ALLOCATED( var_def_v3 ) )  THEN
-       DO  m = 1, surf_def_v(3)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_v(3)%k(m)
-          surfaces%var_out(n_surf) = var_def_v3(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(3)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v3 ) )  THEN
-       DO  m = 1, surf_lsm_v(3)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_v(3)%k(m)
-          surfaces%var_out(n_surf) = var_lsm_v3(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(3)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v3 ) )  THEN
-       DO  m = 1, surf_usm_v(3)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_v(3)%k(m)
-          surfaces%var_out(n_surf) = var_usm_v3(m) * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(3)%ns
-    ENDIF
-
- END SUBROUTINE surface_data_output_collect_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Collect the surface data from different types and different orientation for properties which are
-!> defined using tile approach.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_collect_2d( var_def_h0, var_lsm_h0, var_usm_h0,       &
-                                            var_def_h1, var_lsm_h1, var_usm_h1,       &
-                                            var_def_v0, var_lsm_v0, var_usm_v0,       &
-                                            var_def_v1, var_lsm_v1, var_usm_v1,       &
-                                            var_def_v2, var_lsm_v2, var_usm_v2,       &
-                                            var_def_v3, var_lsm_v3, var_usm_v3, fac )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k       !< height index of surface element
-    INTEGER(iwp) ::  m       !< running index for surface elements
-    INTEGER(iwp) ::  n_surf  !< running index for surface elements
-
-    REAL(wp), DIMENSION(:), OPTIONAL                  ::  fac                !< passed output conversion factor for heatflux output
-    REAL(wp), DIMENSION(nzb:nzt+1)                    ::  conversion_factor  !< effective array for output conversion factor
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_h0  !< output variable at upward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_h1  !< output variable at downward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_h0  !< output variable at upward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_h1  !< output variable at downward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_h0  !< output variable at upward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_h1  !< output variable at downward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_v0  !< output variable at northward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_v1  !< output variable at southward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_v2  !< output variable at eastward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_def_v3  !< output variable at westward-facing default-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v0  !< output variable at northward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v1  !< output variable at southward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v2  !< output variable at eastward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_lsm_v3  !< output variable at westward-facing natural-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_v0  !< output variable at northward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_v1  !< output variable at southward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_v2  !< output variable at eastward-facing urban-type surfaces
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) ::  var_usm_v3  !< output variable at westward-facing urban-type surfaces
-
-!
-!-- Set conversion factor to one if not present
-    IF ( .NOT. PRESENT( fac ) )  THEN
-       conversion_factor = 1.0_wp
-    ELSE
-       conversion_factor = fac
-    ENDIF
-!
-!-- Set counter variable to zero before the variable is written to the output array.
-    n_surf = 0
-!
-!-- Write the horizontal surfaces.
-!-- Before each variable is written to the output data structure, first check if the variable
-!-- for the respective surface type is defined. If a variable is not defined, skip the block and
-!-- increment the counter variable by the number of surface elements of this type. Usually this is
-!-- zero, however, there might be the situation that e.g. urban surfaces are defined but the
-!-- respective variable is not allocated for this surface type. To write the data on the exact
-!-- position, increment the counter.
-    IF ( ALLOCATED( var_def_h0 ) )  THEN
-       DO  m = 1, surf_def_h(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_h(0)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_def_h(0)%frac(m,:) * var_def_h0(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_def_h1 ) )  THEN
-       DO  m = 1, surf_def_h(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_h(1)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_def_h(1)%frac(m,:) * var_def_h1(m,:) ) *          &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_h(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_h0 ) )  THEN
-       DO  m = 1, surf_lsm_h(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_h(0)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_lsm_h(0)%frac(m,:) * var_lsm_h0(m,:) ) *          &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_h1 ) )  THEN
-       DO  m = 1, surf_lsm_h(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_h(1)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_lsm_h(1)%frac(m,:) * var_lsm_h1(m,:) ) *         &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_h(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_h0 ) )  THEN
-       DO  m = 1, surf_usm_h(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_h(0)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_usm_h(0)%frac(m,:) * var_usm_h0(m,:) )            &
-                                     * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_h(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_h1 ) )  THEN
-       DO  m = 1, surf_usm_h(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_h(1)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_usm_h(1)%frac(m,:) * var_usm_h1(m,:) )            &
-                                     * conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_h(1)%ns
-    ENDIF
-!
-!-- Write northward-facing
-    IF ( ALLOCATED( var_def_v0 ) )  THEN
-       DO  m = 1, surf_def_v(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_v(0)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_def_v(0)%frac(m,:) * var_def_v0(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v0 ) )  THEN
-       DO  m = 1, surf_lsm_v(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_v(0)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_lsm_v(0)%frac(m,:) * var_lsm_v0(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(0)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v0 ) )  THEN
-       DO  m = 1, surf_usm_v(0)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_v(0)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_usm_v(0)%frac(m,:) * var_usm_v0(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(0)%ns
-    ENDIF
-!
-!-- Write southward-facing
-    IF ( ALLOCATED( var_def_v1 ) )  THEN
-       DO  m = 1, surf_def_v(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_v(1)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_def_v(1)%frac(m,:) * var_def_v1(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v1 ) )  THEN
-       DO  m = 1, surf_lsm_v(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_v(1)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_lsm_v(1)%frac(m,:) * var_lsm_v1(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(1)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v1 ) )  THEN
-       DO  m = 1, surf_usm_v(1)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_v(1)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_usm_v(1)%frac(m,:) * var_usm_v1(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(1)%ns
-    ENDIF
-!
-!-- Write eastward-facing
-    IF ( ALLOCATED( var_def_v2 ) )  THEN
-       DO  m = 1, surf_def_v(2)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_v(2)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_def_v(2)%frac(m,:) * var_def_v2(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(2)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v2 ) )  THEN
-       DO  m = 1, surf_lsm_v(2)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_v(2)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_lsm_v(2)%frac(m,:) * var_lsm_v2(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(2)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v2 ) )  THEN
-       DO  m = 1, surf_usm_v(2)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_v(2)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_usm_v(2)%frac(m,:) * var_usm_v2(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(2)%ns
-    ENDIF
-!
-!-- Write westward-facing
-    IF ( ALLOCATED( var_def_v3 ) )  THEN
-       DO  m = 1, surf_def_v(3)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_def_v(3)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_def_v(3)%frac(m,:) * var_def_v3(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_def_v(3)%ns
-    ENDIF
-    IF ( ALLOCATED( var_lsm_v3 ) )  THEN
-       DO  m = 1, surf_lsm_v(3)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_lsm_v(3)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_lsm_v(3)%frac(m,:) * var_lsm_v3(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_lsm_v(3)%ns
-    ENDIF
-    IF ( ALLOCATED( var_usm_v3 ) )  THEN
-       DO  m = 1, surf_usm_v(3)%ns
-          n_surf                   = n_surf + 1
-          k                        = surf_usm_v(3)%k(m)
-          surfaces%var_out(n_surf) = SUM ( surf_usm_v(3)%frac(m,:) * var_usm_v3(m,:) ) *           &
-                                     conversion_factor(k)
-       ENDDO
-    ELSE
-       n_surf = n_surf + surf_usm_v(3)%ns
-    ENDIF
-
- END SUBROUTINE surface_data_output_collect_2d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for output of surface parameters
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_parin
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter file
-
-    INTEGER(iwp) ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /surface_data_output_parameters/  averaging_interval_surf,                            &
-                                               data_output_surf,                                   &
-                                               dt_dosurf,                                          &
-                                               dt_dosurf_av,                                       &
-                                               skip_time_dosurf,                                   &
-                                               skip_time_dosurf_av,                                &
-                                               switch_off_module,                                  &
-                                               to_netcdf,                                          &
-                                               to_vtk
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, surface_data_output_parameters, IOSTAT=io_status )
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    surface_data_output_parameters namelist was found and read correctly. Set flag that indicates
-!--    that surface data output is switched on.
-       IF ( .NOT. switch_off_module )  surface_output = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    surface_data_output_parameters namelist was found but contained errors. Print an error
-!--    message including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'surface_data_output_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE surface_data_output_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check the input parameters for consistency. Further pre-process the given output variables, i.e.
-!> separate them into average and non-average output variables and map them onto internal output
-!> array.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_check_parameters
-
-    USE control_parameters,                                                                        &
-        ONLY:  averaging_interval,                                                                 &
-               dt_data_output,                                                                     &
-               indoor_model,                                                                       &
-               message_string
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  trimvar  !< dummy for single output variable
-    CHARACTER(LEN=100) ::  unit     !< dummy for unit of output variable
-
-    INTEGER(iwp) ::  av     !< id indicating average or non-average data output
-    INTEGER(iwp) ::  ilen   !< string length
-    INTEGER(iwp) ::  n_out  !< running index for number of output variables
-!
-!-- Check if any output file type is selected
-    IF ( .NOT. to_vtk  .AND.  .NOT. to_netcdf )  THEN
-       WRITE( message_string, * ) 'no output file type selected for surface-data output!&' //      &
-                                  'Set at least either "to_vtk" or "to_netcdf" to .TRUE.'
-       CALL message( 'surface_data_output_check_parameters', 'PA0662', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check the average interval
-    IF ( averaging_interval_surf == 9999999.9_wp )  THEN
-       averaging_interval_surf = averaging_interval
-    ENDIF
-!
-!-- Set the default data-output interval dt_data_output if necessary
-    IF ( dt_dosurf    == 9999999.9_wp )  dt_dosurf    = dt_data_output
-    IF ( dt_dosurf_av == 9999999.9_wp )  dt_dosurf_av = dt_data_output
-
-    IF ( averaging_interval_surf > dt_dosurf_av )  THEN
-       WRITE( message_string, * )  'averaging_interval_surf = ', averaging_interval_surf,          &
-                                   ' must be <= dt_dosurf_av = ', dt_dosurf_av
-       CALL message( 'surface_data_output_check_parameters', 'PA0536', 1, 2, 0, 6, 0 )
-    ENDIF
-
-#if ! defined( __netcdf4_parallel )
-!
-!-- Surface output via NetCDF requires parallel NetCDF
-    IF ( to_netcdf )  THEN
-       message_string = 'to_netcdf = .True. requires parallel NetCDF'
-       CALL message( 'surface_data_output_check_parameters', 'PA0116', 1, 2, 0, 6, 0 )
-    ENDIF
-#endif
-!
-!-- In case of parallel NetCDF output the output timestep must not be zero. This is because the
-!-- number of requiered output timesteps is pre-calculated, which is not possible with zero output
-!-- timestep.
-    IF ( netcdf_data_format > 4 )  THEN
-       IF ( dt_dosurf == 0.0_wp )  THEN
-          message_string = 'dt_dosurf = 0.0 while using a variable timestep and parallel ' //      &
-                           'netCDF4 is not allowed.'
-          CALL message( 'surface_data_output_check_parameters', 'PA0081', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( dt_dosurf_av == 0.0_wp )  THEN
-          message_string = 'dt_dosurf_av = 0.0 while using a variable timestep and parallel ' //   &
-                           'netCDF4 is not allowed.'
-          CALL message( 'surface_data_output_check_parameters', 'PA0081', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-!
-!-- Count number of output variables and separate output strings for average and non-average output
-!-- variables.
-    n_out = 0
-    DO WHILE ( data_output_surf(n_out+1)(1:1) /= ' ' )
-
-       n_out = n_out + 1
-       ilen = LEN_TRIM( data_output_surf(n_out) )
-       trimvar = TRIM( data_output_surf(n_out) )
-
-!
-!--    Check for data averaging
-       av = 0
-       IF ( ilen > 3 )  THEN
-          IF ( data_output_surf(n_out)(ilen-2:ilen) == '_av' )  THEN
-             trimvar = data_output_surf(n_out)(1:ilen-3)
-             av      = 1
-          ENDIF
-       ENDIF
-
-       dosurf_no(av) = dosurf_no(av) + 1
-       dosurf(av,dosurf_no(av)) = TRIM( trimvar )
-
-!
-!--    Check if all output variables are known and assign a unit
-       unit = 'not set'
-       SELECT CASE ( TRIM( trimvar ) )
-
-          CASE ( 'css', 'cssws', 'qsws_liq', 'qsws_soil', 'qsws_veg' )
-             message_string = TRIM( trimvar ) // ' is not yet implemented in the surface output'
-             CALL message( 'surface_data_output_check_parameters', 'PA0537', 1, 2, 0, 6, 0 )
-
-          CASE ( 'us', 'uvw1' )
-             unit = 'm/s'
-
-          CASE ( 'ss', 'qcs', 'ncs', 'qis', 'nis', 'qrs', 'nrs' )
-             unit = '1'
-
-          CASE ( 'z0', 'z0h', 'z0q', 'ol' )
-             unit = 'm'
-
-          CASE ( 'ts', 'theta1', 'thetav1', 'theta_surface', 'thetav_surface' )
-             unit = 'K'
-
-          CASE ( 'usws', 'vsws' )
-             unit = 'm2/s2'
-
-          CASE ( 'qcsws', 'ncsws', 'qisws', 'nisws', 'qrsws', 'nrsws', 'sasws' )
-
-          CASE ( 'shf' )
-             unit = 'K m/s'
-
-          CASE ( 'qsws' )
-             unit = 'kg/kg m/s'
-
-          CASE ( 'ssws' )
-             unit = 'kg/m2/s'
-
-          CASE ( 'qs', 'q_surface', 'qv1' )
-             unit = 'kg/kg'
-
-          CASE ( 'rad_net' )
-             unit = 'W/m2'
-
-          CASE ( 'rad_lw_in', 'rad_lw_out', 'rad_lw_dif', 'rad_lw_ref', 'rad_lw_res' )
-             unit = 'W/m2'
-
-          CASE ( 'rad_sw_in', 'rad_sw_out', 'rad_sw_dif', 'rad_sw_ref', 'rad_sw_res', 'rad_sw_dir' )
-             unit = 'W/m2'
-
-          CASE ( 'ghf' )
-             unit = 'W/m2'
-
-          CASE ( 'r_a', 'r_canopy', 'r_soil', 'r_s' )
-             unit = 's/m'
-
-          CASE ( 'waste_heat', 'im_hf' )
-             IF ( .NOT. indoor_model )  THEN
-                message_string = TRIM( trimvar ) // ' requires the indoor model'
-             CALL message( 'surface_data_output_check_parameters', 'PA0588', 1, 2, 0, 6, 0 )
-             ENDIF
-
-             unit = 'W/m2'
-
-          CASE ( 'albedo', 'emissivity' )
-             unit = '1'
-
-          CASE DEFAULT
-             message_string = TRIM( trimvar ) // ' is not part of the surface output'
-             CALL message( 'surface_data_output_check_parameters', 'PA0538', 1, 2, 0, 6, 0 )
-       END SELECT
-
-       dosurf_unit(av,dosurf_no(av)) = unit
-
-    ENDDO
-
- END SUBROUTINE surface_data_output_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Last action.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_last_action( av )
-
-   USE control_parameters,                                                                         &
-       ONLY:  io_blocks,                                                                           &
-              io_group
-
-#if defined( __parallel )
-   USE pegrid,                                                                                     &
-       ONLY:  comm2d,                                                                              &
-              ierr
-#endif
-
-   IMPLICIT NONE
-
-   INTEGER(iwp) ::  av  !< id indicating average or non-average data output
-   INTEGER(iwp) ::  i   !< loop index
-
-!
-!--Return, if nothing to output
-   IF ( dosurf_no(av) == 0 )  RETURN
-!
-!--If output to VTK files is enabled, check if files are open and write an end-of-file statement.
-   IF ( to_vtk )  THEN
-      CALL check_open( 25 + av )
-!
-!--   Write time coordinate
-      DO  i = 0, io_blocks - 1
-         IF ( i == io_group )  THEN
-            WRITE ( 25 + av )  LEN_TRIM( 'END' )
-            WRITE ( 25 + av )  'END'
-         ENDIF
-#if defined( __parallel )
-         CALL MPI_BARRIER( comm2d, ierr )
-#endif
-      ENDDO
-   ENDIF
-
- END SUBROUTINE surface_data_output_last_action
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!---------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_rrd_global_ftn( found )
-
-
-    USE control_parameters,                                                                        &
-        ONLY: length,                                                                              &
-              restart_string
-
-    IMPLICIT NONE
-
-    LOGICAL, INTENT(OUT) ::  found  !< flag indicating if variable was found
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'average_count_surf' )
-          READ ( 13 )  average_count_surf
-       CASE ( 'time_dosurf' )
-          READ ( 13 )  time_dosurf
-       CASE ( 'time_dosurf_av' )
-          READ ( 13 )  time_dosurf_av
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE surface_data_output_rrd_global_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_rrd_global_mpi
-
-    CALL rrd_mpi_io( 'average_count_surf', average_count_surf )
-    CALL rrd_mpi_io( 'time_dosurf', time_dosurf )
-    CALL rrd_mpi_io( 'time_dosurf_av', time_dosurf_av )
-
- END SUBROUTINE surface_data_output_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_rrd_local_ftn( found )
-
-
-    USE control_parameters,                                                                        &
-        ONLY: length,                                                                              &
-              restart_string
-
-    IMPLICIT NONE
-
-    LOGICAL, INTENT(OUT) ::  found
-
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'surfaces%var_av' )
-          READ ( 13 )  surfaces%var_av
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-       END SELECT
-
-
- END SUBROUTINE surface_data_output_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_rrd_local_mpi
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=3) ::  dum !< dummy string to create output-variable name
-
-    INTEGER(iwp) ::  i  !< grid index in x-direction
-    INTEGER(iwp) ::  j  !< grid index in y-direction
-    INTEGER(iwp) ::  l  !< running index surface orientation
-    INTEGER(iwp) ::  m  !< running index surface elements
-    INTEGER(iwp) ::  n  !< counting variable
-    INTEGER(iwp) ::  nv !< running index over number of variables
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  end_index           !< end index of surface data at (j,i)
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  global_end_index    !< end index array for surface data (MPI-IO)
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  global_start_index  !< start index array for surface data (MPI-IO)
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  num_surf            !< number of surface data at (j,i)
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  start_index         !< start index of surface data at (j,i)
-
-    LOGICAL ::  array_found  !< flag indicating whether variable is in restart data or not
-    LOGICAL ::  ldum         !< dummy variable
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surf_in !< input array in expected restart format
-
-!
-!-- Note, surface data which is written to file is organized in a different way than
-!-- the output surface data. The output surface data is a concatenated array of the
-!-- different surface types and orientations, while the mpi-io expects surface data that
-!-- is consecutive in terms of start- and end-index, i.e. organized along the (j,i)
-!-- grid index. Hence, data need to be tranformed back to the output surface data.
-    ALLOCATE( end_index(nys:nyn,nxl:nxr)          )
-    ALLOCATE( num_surf(nys:nyn,nxl:nxr)           )
-    ALLOCATE( start_index(nys:nyn,nxl:nxr)        )
-    ALLOCATE( global_start_index(nys:nyn,nxl:nxr) )
-
-    ALLOCATE( surf_in(1:surfaces%ns) )
-
-    CALL rd_mpi_io_check_array( 'surfaces%global_start_index', found = array_found )
-    IF ( array_found )  CALL rrd_mpi_io( 'surfaces%global_start_index', global_start_index )
-
-    CALL rd_mpi_io_check_array( 'surfaces%global_end_index', found = array_found )
-    IF ( array_found )  CALL rrd_mpi_io( 'surfaces%global_end_index', global_end_index )
-
-    CALL rd_mpi_io_surface_filetypes( start_index, end_index, ldum, global_start_index,            &
-                                      global_end_index )
-
-    DO  nv = 1, dosurf_no(1)
-       WRITE( dum, '(I3.3)' )  nv
-
-       CALL rd_mpi_io_check_array( 'surfaces%var_av' // TRIM( dum ), found = array_found )
-
-       IF ( array_found )  THEN
-
-          CALL rrd_mpi_io_surface( 'surfaces%var_av' // TRIM(dum), surf_in )
-!
-!--       Write temporary input variable back to surface-output data array.
-          n = 0
-          num_surf = 0
-          DO  l = 0, 1
-             DO  m = 1, surf_def_h(l)%ns
-                i = surf_def_h(l)%i(m)
-                j = surf_def_h(l)%j(m)
-                n                     = n + 1
-                surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i))
-                num_surf(j,i)         = num_surf(j,i) + 1
-             ENDDO
-             DO  m = 1, surf_lsm_h(l)%ns
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-                n                     = n + 1
-                surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i))
-                num_surf(j,i)         = num_surf(j,i) + 1
-             ENDDO
-             DO  m = 1, surf_usm_h(l)%ns
-                i = surf_usm_h(l)%i(m)
-                j = surf_usm_h(l)%j(m)
-                n                     = n + 1
-                surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i))
-                num_surf(j,i)         = num_surf(j,i) + 1
-             ENDDO
-          ENDDO
-
-          DO  l = 0, 3
-             DO  m = 1, surf_def_v(l)%ns
-                i = surf_def_v(l)%i(m)
-                j = surf_def_v(l)%j(m)
-                n                     = n + 1
-                surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i))
-                num_surf(j,i)         = num_surf(j,i) + 1
-             ENDDO
-             DO  m = 1, surf_lsm_v(l)%ns
-                i = surf_lsm_v(l)%i(m)
-                j = surf_lsm_v(l)%j(m)
-                n                     = n + 1
-                surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i))
-                num_surf(j,i)         = num_surf(j,i) + 1
-             ENDDO
-             DO  m = 1, surf_usm_v(l)%ns
-                i = surf_usm_v(l)%i(m)
-                j = surf_usm_v(l)%j(m)
-                n                     = n + 1
-                surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i))
-                num_surf(j,i)         = num_surf(j,i) + 1
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDDO
-
-
- END SUBROUTINE surface_data_output_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_wrd_global
-
-    IMPLICIT NONE
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL wrd_write_string( 'average_count_surf' )
-       WRITE ( 14 )  average_count_surf
-
-       CALL wrd_write_string( 'time_dosurf' )
-       WRITE ( 14 )  time_dosurf
-
-       CALL wrd_write_string( 'time_dosurf_av' )
-       WRITE ( 14 )  time_dosurf_av
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-      CALL wrd_mpi_io( 'average_count_surf', average_count_surf )
-      CALL wrd_mpi_io( 'time_dosurf', time_dosurf )
-      CALL wrd_mpi_io( 'time_dosurf_av', time_dosurf_av )
-
-    ENDIF
-
- END SUBROUTINE surface_data_output_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes restart data which individual on each PE
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_data_output_wrd_local
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=3) ::  dum !< dummy string to create output-variable name
-
-    INTEGER(iwp) ::  i                      !< grid index in x-direction
-    INTEGER(iwp) ::  j                      !< grid index in y-direction
-    INTEGER(iwp) ::  l                      !< running index surface orientation
-    INTEGER(iwp) ::  m                      !< running index surface elements
-    INTEGER(iwp) ::  n                      !< counting variable
-    INTEGER(iwp) ::  nv                     !< running index over number of variables
-    INTEGER(iwp) ::  start_index_aggregated !< sum of start-index at (j,i) over all surface types
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  end_index           !< end index of surface data at (j,i)
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  global_end_index    !< end index array for surface data (MPI-IO)
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  global_start_index  !< start index array for surface data (MPI-IO)
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  num_surf            !< number of surface data at (j,i)
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  start_index         !< start index of surface data at (j,i)
-
-    LOGICAL ::  surface_data_to_write  !< switch for MPI-I/O if PE has surface data to write
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  surf_out  !< surface data in expected restart format
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       IF ( ALLOCATED( surfaces%var_av ) )  THEN
-          CALL wrd_write_string( 'surfaces%var_av' )
-          WRITE ( 14 )  surfaces%var_av
-       ENDIF
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-!
-!--    Note, surface data which is written to file is organized in a different way than
-!--    the output surface data. The output surface data is a concatenated array of the
-!--    different surface types and orientations, while the mpi-io expects surface data that
-!--    is consecutive in terms of start- and end-index, i.e. organized along the (j,i)
-!--    grid index. Hence, data need to be tranformed before it can be written to file.
-       IF ( ALLOCATED( surfaces%var_av ) )  THEN
-          ALLOCATE( end_index(nys:nyn,nxl:nxr)          )
-          ALLOCATE( num_surf(nys:nyn,nxl:nxr)           )
-          ALLOCATE( start_index(nys:nyn,nxl:nxr)        )
-          ALLOCATE( global_start_index(nys:nyn,nxl:nxr) )
-          ALLOCATE( surf_out(1:surfaces%ns)             )
-!
-!--       Determine the start and end index at each (j,i)-pair and resort the surface data
-          start_index            = 1
-          end_index              = 0
-          start_index_aggregated = 1
-          num_surf = 0
-          DO  l = 0, 1
-             DO  m = 1, surf_def_h(l)%ns
-                i = surf_def_h(l)%i(m)
-                j = surf_def_h(l)%j(m)
-                num_surf(j,i) = num_surf(j,i) + 1
-             ENDDO
-             DO  m = 1, surf_lsm_h(l)%ns
-                i = surf_lsm_h(l)%i(m)
-                j = surf_lsm_h(l)%j(m)
-                num_surf(j,i) = num_surf(j,i) + 1
-             ENDDO
-             DO  m = 1, surf_usm_h(l)%ns
-                i = surf_usm_h(l)%i(m)
-                j = surf_usm_h(l)%j(m)
-                num_surf(j,i) = num_surf(j,i) + 1
-             ENDDO
-          ENDDO
-
-          DO  l = 0, 3
-             DO  m = 1, surf_def_v(l)%ns
-                i = surf_def_v(l)%i(m)
-                j = surf_def_v(l)%j(m)
-                num_surf(j,i) = num_surf(j,i) + 1
-             ENDDO
-             DO  m = 1, surf_lsm_v(l)%ns
-                i = surf_lsm_v(l)%i(m)
-                j = surf_lsm_v(l)%j(m)
-                num_surf(j,i) = num_surf(j,i) + 1
-             ENDDO
-             DO  m = 1, surf_usm_v(l)%ns
-                i = surf_usm_v(l)%i(m)
-                j = surf_usm_v(l)%j(m)
-                num_surf(j,i) = num_surf(j,i) + 1
-             ENDDO
-          ENDDO
-
-          start_index = 0
-          end_index   = 0
-          start_index_aggregated = 1
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                start_index(j,i)       = start_index_aggregated
-                end_index(j,i)         = start_index(j,i) + num_surf(j,i) - 1
-                start_index_aggregated = start_index_aggregated + num_surf(j,i)
-             ENDDO
-          ENDDO
-
-          CALL rd_mpi_io_surface_filetypes( start_index, end_index, surface_data_to_write,         &
-                                            global_start_index, global_end_index )
-
-          CALL wrd_mpi_io( 'surfaces%global_start_index', global_start_index )
-          CALL wrd_mpi_io( 'surfaces%global_end_index', global_end_index )
-
-          DO  nv = 1, dosurf_no(1)
-             n = 0
-             num_surf = 0
-             DO  l = 0, 1
-                DO  m = 1, surf_def_h(l)%ns
-                   i = surf_def_h(l)%i(m)
-                   j = surf_def_h(l)%j(m)
-                   n                                          = n + 1
-                   surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv)
-                   num_surf(j,i)                              = num_surf(j,i) + 1
-                ENDDO
-                DO  m = 1, surf_lsm_h(l)%ns
-                   i = surf_lsm_h(l)%i(m)
-                   j = surf_lsm_h(l)%j(m)
-                   n                                          = n + 1
-                   surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv)
-                   num_surf(j,i)                              = num_surf(j,i) + 1
-                ENDDO
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   n                                          = n + 1
-                   surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv)
-                   num_surf(j,i)                              = num_surf(j,i) + 1
-                ENDDO
-             ENDDO
-
-             DO  l = 0, 3
-                DO  m = 1, surf_def_v(l)%ns
-                   i = surf_def_v(l)%i(m)
-                   j = surf_def_v(l)%j(m)
-                   n                                          = n + 1
-                   surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv)
-                   num_surf(j,i)                              = num_surf(j,i) + 1
-                ENDDO
-                DO  m = 1, surf_lsm_v(l)%ns
-                   i = surf_lsm_v(l)%i(m)
-                   j = surf_lsm_v(l)%j(m)
-                   n                                          = n + 1
-                   surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv)
-                   num_surf(j,i)                              = num_surf(j,i) + 1
-                ENDDO
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   n                                          = n + 1
-                   surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv)
-                   num_surf(j,i)                              = num_surf(j,i) + 1
-                ENDDO
-             ENDDO
-
-             WRITE( dum, '(I3.3)' )  nv
-
-             CALL wrd_mpi_io_surface( 'surfaces%var_av' // TRIM( dum ), surf_out )
-          ENDDO
-
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE surface_data_output_wrd_local
-
-
-END MODULE surface_data_output_mod
Index: palm/trunk/SOURCE/surface_layer_fluxes_mod.f90
===================================================================
--- palm/trunk/SOURCE/surface_layer_fluxes_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2176 +1,0 @@
-!> @file surface_layer_fluxes_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Revision of 10-cm temperature at vertical walls - assume grid-cell temperature rather than employ
-! MOST
-!
-! 4717 2020-09-30 22:27:40Z pavelkrc
-! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
-! directives (J. Resler)
-!
-! 4691 2020-09-22 14:38:38Z suehring
-! Bugfix for commit 4593 in vector branch of calc_ol
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4594 2020-07-09 15:01:00Z suehring
-! Include k index in OMP PRIVATE statements
-!
-! 4593 2020-07-09 12:48:18Z suehring
-! - Pre-calculate ln(z/z0) at each timestep in order to reduce the number of log-calculations
-! - Bugfix - add missing density to fluxes of passive-scalars, chemistry and cloud-phyiscal
-!   quantities at upward-facing surfaces
-! - Move if-statement out of inner loop
-! - Remove unnecessary index referencing
-! 
-! 4562 2020-06-12 08:38:47Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4519 2020-05-05 17:33:30Z suehring
-! Add missing computation of passive scalar scaling parameter
-!
-! 4370 2020-01-10 14:00:44Z raasch
-! Bugfix: openacc porting for vector version of OL calculation added
-!
-! 4366 2020-01-09 08:12:43Z raasch
-! Vector version for calculation of Obukhov length via Newton iteration added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Calculation of diagnostic-only 2-m potential temperature moved to diagnostic_output_quantities.
-!
-! 4298 2019-11-21 15:59:16Z suehring
-! Calculation of 2-m temperature adjusted to the case the 2-m level is above the first grid point.
-!
-! 4258 2019-10-07 13:29:08Z suehring
-! Initialization of Obukhov lenght also at vertical surfaces (if allocated).
-!
-! 4237 2019-09-25 11:33:42Z knoop
-! Added missing OpenMP directives
-!
-! 4186 2019-08-23 16:06:14Z suehring
-! - To enable limitation of Obukhov length, move it before exit-cycle construct.
-!   Further, change the limit to 10E-5 in order to get rid-off unrealistic peaks in the heat fluxes
-!   during nighttime
-! - Unused variable removed
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3881 2019-04-10 09:31:22Z suehring
-! Assure that Obukhov length does not become zero
-!
-! 3834 2019-03-28 15:40:15Z forkel
-! Added USE chem_gasphase_mod
-!
-! 3787 2019-03-07 08:43:54Z raasch
-! Unused variables removed
-!
-! 3745 2019-02-15 18:57:56Z suehring
-! Bugfix, missing calculation of 10cm temperature at vertical building walls, required for indoor
-! model
-!
-! 3744 2019-02-15 18:38:58Z suehring
-! Some interface calls moved to module_interface + cleanup
-!
-! 3668 2019-01-14 12:49:24Z maronga
-! Removed methods "circular" and "lookup"
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! OpenACC port for SPEC
-!
-! Revision 1.1  1998/01/23 10:06:06  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Diagnostic computation of vertical fluxes in the constant flux layer from the values of the
-!> variables at grid point k=1 based on Newton iteration.
-!>
-!> @todo (Re)move large_scale_forcing actions
-!> @todo Check/optimize OpenMP directives
-!> @todo Simplify if conditions (which flux need to be computed in which case)
-!--------------------------------------------------------------------------------------------------!
- MODULE surface_layer_fluxes_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  d_exner,                                                                            &
-               drho_air_zw,                                                                        &
-               e,                                                                                  &
-               kh,                                                                                 &
-               nc,                                                                                 &
-               nr,                                                                                 &
-               pt,                                                                                 &
-               q,                                                                                  &
-               ql,                                                                                 &
-               qc,                                                                                 &
-               qr,                                                                                 &
-               s,                                                                                  &
-               u,                                                                                  &
-               v,                                                                                  &
-               vpt,                                                                                &
-               w,                                                                                  &
-               zu,                                                                                 &
-               zw,                                                                                 &
-               rho_air_zw
-
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  g,                                                                                  &
-               kappa,                                                                              &
-               lv_d_cp,                                                                            &
-               pi,                                                                                 &
-               rd_d_rv
-
-    USE chem_gasphase_mod,                                                                         &
-        ONLY:  nvar
-
-    USE chem_modules,                                                                              &
-        ONLY:  constant_csflux
-
-    USE cpulog
-
-    USE control_parameters,                                                                        &
-        ONLY:  air_chemistry,                                                                      &
-               cloud_droplets,                                                                     &
-               constant_heatflux,                                                                  &
-               constant_scalarflux,                                                                &
-               constant_waterflux,                                                                 &
-               coupling_mode,                                                                      &
-               debug_output_timestep,                                                              &
-               humidity,                                                                           &
-               ibc_e_b,                                                                            &
-               ibc_pt_b,                                                                           &
-               indoor_model,                                                                       &
-               land_surface,                                                                       &
-               large_scale_forcing,                                                                &
-               loop_optimization,                                                                  &
-               lsf_surf,                                                                           &
-               message_string,                                                                     &
-               neutral,                                                                            &
-               passive_scalar,                                                                     &
-               pt_surface,                                                                         &
-               q_surface,                                                                          &
-               run_coupled,                                                                        &
-               surface_pressure,                                                                   &
-               simulated_time,                                                                     &
-               time_since_reference_point,                                                         &
-               urban_surface,                                                                      &
-               use_free_convection_scaling,                                                        &
-               zeta_max,                                                                           &
-               zeta_min
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx,                                                                                 &
-               dy
-
-    USE indices,                                                                                   &
-        ONLY:  nzt
-
-    USE kinds
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY: bulk_cloud_model,                                                                    &
-              microphysics_morrison,                                                               &
-              microphysics_seifert
-
-    USE pegrid
-
-    USE land_surface_model_mod,                                                                    &
-        ONLY:  aero_resist_kray,                                                                   &
-               skip_time_do_lsm
-
-    USE surface_mod,                                                                               &
-        ONLY :  surf_def_h,                                                                        &
-                surf_def_v,                                                                        &
-                surf_lsm_h,                                                                        &
-                surf_lsm_v,                                                                        &
-                surf_type,                                                                         &
-                surf_usm_h,                                                                        &
-                surf_usm_v
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< loop index x direction
-    INTEGER(iwp) ::  j  !< loop index y direction
-    INTEGER(iwp) ::  k  !< loop index z direction
-    INTEGER(iwp) ::  l  !< loop index for surf type
-
-    LOGICAL ::  coupled_run         !< Flag for coupled atmosphere-ocean runs
-    LOGICAL ::  downward = .FALSE.  !< Flag indicating downward-facing horizontal surface
-    LOGICAL ::  mom_uv   = .FALSE.  !< Flag indicating calculation of usvs and vsus at vertical surfaces
-    LOGICAL ::  mom_w    = .FALSE.  !< Flag indicating calculation of wsus and wsvs at vertical surfaces
-    LOGICAL ::  mom_tke  = .FALSE.  !< Flag indicating calculation of momentum fluxes at vertical surfaces used for TKE production
-    LOGICAL ::  surf_vertical       !< Flag indicating vertical surfaces
-
-    REAL(wp) :: e_s                !< Saturation water vapor pressure
-    REAL(wp) :: ol_max = 1.0E6_wp  !< Maximum Obukhov length
-    REAL(wp) :: z_mo               !< Height of the constant flux layer where MOST is assumed
-
-    TYPE(surf_type), POINTER ::  surf  !< surf-type array, used to generalize subroutines
-
-
-    SAVE
-
-    PRIVATE
-
-    PUBLIC init_surface_layer_fluxes,                                                              &
-           phi_m,                                                                                  &
-           psi_h,                                                                                  &
-           psi_m,                                                                                  &
-           surface_layer_fluxes
-
-    INTERFACE init_surface_layer_fluxes
-       MODULE PROCEDURE init_surface_layer_fluxes
-    END INTERFACE init_surface_layer_fluxes
-
-    INTERFACE phi_m
-       MODULE PROCEDURE phi_m
-    END INTERFACE phi_m
-
-    INTERFACE psi_h
-       MODULE PROCEDURE psi_h
-    END INTERFACE psi_h
-
-    INTERFACE psi_m
-       MODULE PROCEDURE psi_m
-    END INTERFACE psi_m
-
-    INTERFACE surface_layer_fluxes
-       MODULE PROCEDURE surface_layer_fluxes
-    END INTERFACE surface_layer_fluxes
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Main routine to compute the surface fluxes.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_layer_fluxes
-
-    IMPLICIT NONE
-
-
-    IF ( debug_output_timestep )  CALL debug_message( 'surface_layer_fluxes', 'start' )
-
-    surf_vertical = .FALSE. !< flag indicating vertically orientated surface elements
-    downward      = .FALSE. !< flag indicating downward-facing surface elements
-!
-!-- First, precalculate ln(z/z0) for all surfaces. This is done each timestep, in order to account
-!-- for time-dependent roughness or user-modifications.
-    DO  l = 0, 1
-       IF ( surf_def_h(l)%ns >= 1 )  THEN
-          surf => surf_def_h(l)
-          CALL calc_ln
-       ENDIF
-       IF ( surf_lsm_h(l)%ns >= 1 )  THEN
-          surf => surf_lsm_h(l)
-          CALL calc_ln
-       ENDIF
-       IF ( surf_usm_h(l)%ns >= 1 )  THEN
-          surf => surf_usm_h(l)
-          CALL calc_ln
-       ENDIF
-    ENDDO
-
-    DO  l = 0, 3
-       IF ( surf_def_v(l)%ns >= 1 )  THEN
-          surf => surf_def_v(l)
-          CALL calc_ln
-       ENDIF
-       IF ( surf_lsm_v(l)%ns >= 1 )  THEN
-          surf => surf_lsm_v(l)
-          CALL calc_ln
-       ENDIF
-       IF ( surf_usm_v(l)%ns >= 1 )  THEN
-          surf => surf_usm_v(l)
-          CALL calc_ln
-       ENDIF
-    ENDDO
-!
-!-- Derive potential temperature and specific humidity at first grid level from the fields pt and q
-    DO  l = 0, 1
-!--    First call for horizontal default-type surfaces (l=0 - upward facing, l=1 - downward facing)
-       IF ( surf_def_h(l)%ns >= 1  )  THEN
-          surf => surf_def_h(l)
-          CALL calc_pt_q
-          IF ( .NOT. neutral )  THEN
-             CALL calc_pt_surface
-             IF ( humidity )  THEN
-                CALL calc_q_surface
-                CALL calc_vpt_surface
-             ENDIF
-          ENDIF
-       ENDIF
-!
-!--    Call for natural-type horizontal surfaces
-       IF ( surf_lsm_h(l)%ns >= 1  )  THEN
-          surf => surf_lsm_h(l)
-          CALL calc_pt_q
-       ENDIF
-!
-!--    Call for urban-type horizontal surfaces
-       IF ( surf_usm_h(l)%ns >= 1  )  THEN
-          surf => surf_usm_h(l)
-          CALL calc_pt_q
-       ENDIF
-    ENDDO
-!
-!-- Call for natural-type vertical surfaces
-    DO  l = 0, 3
-       IF ( surf_lsm_v(l)%ns >= 1  )  THEN
-          surf => surf_lsm_v(l)
-          CALL calc_pt_q
-       ENDIF
-
-!--    Call for urban-type vertical surfaces
-       IF ( surf_usm_v(l)%ns >= 1  )  THEN
-          surf => surf_usm_v(l)
-          CALL calc_pt_q
-       ENDIF
-    ENDDO
-
-!
-!-- First, calculate the new Obukhov length from precalculated values of log(z/z0) and wind speeds.
-!-- As a second step, then calculate new friction velocity, followed by the new scaling
-!-- parameters (th*, q*, etc.), and the new surface fluxes, if required. Note, each routine is called
-!-- for different surface types. First call for default-type horizontal surfaces, for natural- and
-!-- urban-type surfaces. Note, here only upward-facing horizontal surfaces are treated.
-!-- Note, calculation of log(z/z0) is redone each timestep, in order to account for time-dependent
-!-- values.
-!-- Start with default-type upward-facing horizontal surfaces
-    IF ( surf_def_h(0)%ns >= 1 )  THEN
-       surf => surf_def_h(0)
-       CALL calc_uvw_abs
-       IF ( .NOT. neutral )  CALL calc_ol
-       CALL calc_us
-       CALL calc_scaling_parameters
-       CALL calc_surface_fluxes
-    ENDIF
-!
-!-- Natural-type horizontal surfaces
-    IF ( surf_lsm_h(0)%ns >= 1 )  THEN
-       surf => surf_lsm_h(0)
-       CALL calc_uvw_abs
-       IF ( .NOT. neutral )  CALL calc_ol
-       CALL calc_us
-       CALL calc_scaling_parameters
-       CALL calc_surface_fluxes
-    ENDIF
-!
-!-- Urban-type horizontal surfaces
-    IF ( surf_usm_h(0)%ns >= 1 )  THEN
-       surf => surf_usm_h(0)
-       CALL calc_uvw_abs
-       IF ( .NOT. neutral )  CALL calc_ol
-       CALL calc_us
-       CALL calc_scaling_parameters
-       CALL calc_surface_fluxes
-!
-!--    Calculate 10cm temperature, required in indoor model
-       IF ( indoor_model )  CALL calc_pt_near_surface ( '10cm' )
-    ENDIF
-
-!
-!-- Treat downward-facing horizontal surfaces.
-!-- Stratification is not considered in this case, hence, no further distinction between different
-!-- most_method is required.
-    downward = .TRUE.
-!-- Default type.
-    IF ( surf_def_h(1)%ns >= 1 )  THEN
-       surf => surf_def_h(1)
-       CALL calc_uvw_abs
-       CALL calc_us
-       CALL calc_surface_fluxes
-    ENDIF
-!-- Natural surface type.
-    IF ( surf_lsm_h(1)%ns >= 1 )  THEN
-       surf => surf_lsm_h(1)
-       CALL calc_uvw_abs
-       CALL calc_us
-       CALL calc_surface_fluxes
-    ENDIF
-!-- Urban surface type.
-    IF ( surf_usm_h(1)%ns >= 1 )  THEN
-       surf => surf_usm_h(1)
-       CALL calc_uvw_abs
-       CALL calc_us
-       CALL calc_surface_fluxes
-    ENDIF
-    downward = .FALSE.
-!
-!-- Calculate surfaces fluxes at vertical surfaces for momentum and subgrid-scale TKE. No stability
-!-- is considered. Therefore, scaling parameters and Obukhov length do not need to be calculated and
-!-- no distinction in 'circular', 'Newton' or 'lookup' is necessary so far. Note, this will change
-!-- if stability is once considered.
-    surf_vertical = .TRUE.
-!
-!-- Calculate horizontal momentum fluxes at north- and south-facing surfaces(usvs).
-!-- For default-type surfaces
-    mom_uv = .TRUE.
-    DO  l = 0, 1
-       IF ( surf_def_v(l)%ns >= 1 )  THEN
-          surf => surf_def_v(l)
-!
-!--       Compute surface-parallel velocity
-          CALL calc_uvw_abs_v_ugrid
-!
-!--       Compute respective friction velocity on staggered grid
-          CALL calc_us
-!
-!--       Compute respective surface fluxes for momentum and TKE
-          CALL calc_surface_fluxes
-       ENDIF
-    ENDDO
-!
-!-- For natural-type surfaces. Please note, even though stability is not considered for the
-!-- calculation of momentum fluxes at vertical surfaces, scaling parameters and Obukhov length are
-!-- calculated nevertheless in this case. This is due to the requirement of ts in parameterization
-!-- of heat flux in land-surface model in case that aero_resist_kray is not true.
-    IF ( .NOT. aero_resist_kray )  THEN
-       DO  l = 0, 1
-          IF ( surf_lsm_v(l)%ns >= 1 )  THEN
-             surf => surf_lsm_v(l)
-!
-!--          Compute surface-parallel velocity
-             CALL calc_uvw_abs_v_ugrid
-!
-!--          Compute Obukhov length
-             IF ( .NOT. neutral )  CALL calc_ol
-!
-!--          Compute respective friction velocity on staggered grid
-             CALL calc_us
-!
-!--          Compute scaling parameters
-             CALL calc_scaling_parameters
-!
-!--          Compute respective surface fluxes for momentum and TKE
-             CALL calc_surface_fluxes
-          ENDIF
-       ENDDO
-!
-!-- No ts is required, so scaling parameters and Obukhov length do not need to be computed.
-    ELSE
-       DO  l = 0, 1
-          IF ( surf_lsm_v(l)%ns >= 1 )  THEN
-             surf => surf_lsm_v(l)
-!
-!--          Compute surface-parallel velocity
-             CALL calc_uvw_abs_v_ugrid
-!
-!--          Compute respective friction velocity on staggered grid
-             CALL calc_us
-!
-!--          Compute respective surface fluxes for momentum and TKE
-             CALL calc_surface_fluxes
-          ENDIF
-       ENDDO
-    ENDIF
-!
-!-- For urban-type surfaces
-    DO  l = 0, 1
-       IF ( surf_usm_v(l)%ns >= 1 )  THEN
-          surf => surf_usm_v(l)
-!
-!--       Compute surface-parallel velocity
-          CALL calc_uvw_abs_v_ugrid
-!
-!--       Compute respective friction velocity on staggered grid
-          CALL calc_us
-!
-!--       Compute respective surface fluxes for momentum and TKE
-          CALL calc_surface_fluxes
-!
-!--       Calculate 10cm temperature, required in indoor model
-          IF ( indoor_model )  CALL calc_pt_near_surface ( '10cm' )
-       ENDIF
-    ENDDO
-!
-!-- Calculate horizontal momentum fluxes at east- and west-facing surfaces (vsus).
-!-- For default-type surfaces
-    DO  l = 2, 3
-       IF ( surf_def_v(l)%ns >= 1  )  THEN
-          surf => surf_def_v(l)
-!
-!--       Compute surface-parallel velocity
-          CALL calc_uvw_abs_v_vgrid
-!
-!--       Compute respective friction velocity on staggered grid
-          CALL calc_us
-!
-!--       Compute respective surface fluxes for momentum and TKE
-          CALL calc_surface_fluxes
-       ENDIF
-    ENDDO
-!
-!-- For natural-type surfaces. Please note, even though stability is not considered for the
-!-- calculation of momentum fluxes at vertical surfaces, scaling parameters and Obukov length are
-!-- calculated nevertheless in this case. This is due to the requirement of ts in parameterization
-!-- of heat flux in land-surface model in case that aero_resist_kray is not true.
-    IF ( .NOT. aero_resist_kray )  THEN
-       DO  l = 2, 3
-          IF ( surf_lsm_v(l)%ns >= 1 )  THEN
-             surf => surf_lsm_v(l)
-!
-!--          Compute surface-parallel velocity
-             CALL calc_uvw_abs_v_vgrid
-!
-!--          Compute Obukhov length
-             IF ( .NOT. neutral )  CALL calc_ol
-!
-!--          Compute respective friction velocity on staggered grid
-             CALL calc_us
-!
-!--          Compute scaling parameters
-             CALL calc_scaling_parameters
-!
-!--          Compute respective surface fluxes for momentum and TKE
-             CALL calc_surface_fluxes
-          ENDIF
-       ENDDO
-    ELSE
-       DO  l = 2, 3
-          IF ( surf_lsm_v(l)%ns >= 1 )  THEN
-             surf => surf_lsm_v(l)
-!
-!--          Compute surface-parallel velocity
-             CALL calc_uvw_abs_v_vgrid
-!
-!--          Compute respective friction velocity on staggered grid
-             CALL calc_us
-!
-!--          Compute respective surface fluxes for momentum and TKE
-             CALL calc_surface_fluxes
-          ENDIF
-       ENDDO
-    ENDIF
-!
-!-- For urban-type surfaces
-    DO  l = 2, 3
-       IF ( surf_usm_v(l)%ns >= 1 )  THEN
-          surf => surf_usm_v(l)
-!
-!--       Compute surface-parallel velocity
-          CALL calc_uvw_abs_v_vgrid
-!
-!--       Compute respective friction velocity on staggered grid
-          CALL calc_us
-!
-!--       Compute respective surface fluxes for momentum and TKE
-          CALL calc_surface_fluxes
-!
-!--       Calculate 10cm temperature, required in indoor model
-          IF ( indoor_model )  CALL calc_pt_near_surface ( '10cm' )
-       ENDIF
-    ENDDO
-    mom_uv = .FALSE.
-!
-!-- Calculate horizontal momentum fluxes of w (wsus and wsvs) at vertial surfaces.
-    mom_w = .TRUE.
-!
-!-- Default-type surfaces
-    DO  l = 0, 3
-       IF ( surf_def_v(l)%ns >= 1 )  THEN
-          surf => surf_def_v(l)
-          CALL calc_uvw_abs_v_wgrid
-          CALL calc_us
-          CALL calc_surface_fluxes
-       ENDIF
-    ENDDO
-!
-!-- Natural-type surfaces
-    DO  l = 0, 3
-       IF ( surf_lsm_v(l)%ns >= 1 )  THEN
-          surf => surf_lsm_v(l)
-          CALL calc_uvw_abs_v_wgrid
-          CALL calc_us
-          CALL calc_surface_fluxes
-       ENDIF
-    ENDDO
-!
-!-- Urban-type surfaces
-    DO  l = 0, 3
-       IF ( surf_usm_v(l)%ns >= 1 )  THEN
-          surf => surf_usm_v(l)
-          CALL calc_uvw_abs_v_wgrid
-          CALL calc_us
-          CALL calc_surface_fluxes
-       ENDIF
-    ENDDO
-    mom_w = .FALSE.
-!
-!-- Calculate momentum fluxes usvs, vsus, wsus and wsvs at vertical surfaces for TKE production.
-!-- Note, here, momentum fluxes are defined at grid center and are not staggered as before.
-    mom_tke = .TRUE.
-!
-!-- Default-type surfaces
-    DO  l = 0, 3
-       IF ( surf_def_v(l)%ns >= 1 )  THEN
-          surf => surf_def_v(l)
-          CALL calc_uvw_abs_v_sgrid
-          CALL calc_us
-          CALL calc_surface_fluxes
-       ENDIF
-    ENDDO
-!
-!-- Natural-type surfaces
-    DO  l = 0, 3
-       IF ( surf_lsm_v(l)%ns >= 1 )  THEN
-          surf => surf_lsm_v(l)
-          CALL calc_uvw_abs_v_sgrid
-          CALL calc_us
-          CALL calc_surface_fluxes
-       ENDIF
-    ENDDO
-!
-!-- Urban-type surfaces
-    DO  l = 0, 3
-       IF ( surf_usm_v(l)%ns >= 1 )  THEN
-          surf => surf_usm_v(l)
-          CALL calc_uvw_abs_v_sgrid
-          CALL calc_us
-          CALL calc_surface_fluxes
-       ENDIF
-    ENDDO
-    mom_tke = .FALSE.
-
-    IF ( debug_output_timestep )  CALL debug_message( 'surface_layer_fluxes', 'end' )
-
- END SUBROUTINE surface_layer_fluxes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initializing actions for the surface layer routine.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_surface_layer_fluxes
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  l  !< running index for vertical surface orientation
-
-    CALL location_message( 'initializing surface layer', 'start' )
-
-!
-!-- In case of runs with neutral statification, set Obukhov length to a large value
-    IF ( neutral )  THEN
-       DO  l = 0, 1
-          IF ( surf_def_h(l)%ns >= 1  .AND.                                                        &
-               ALLOCATED( surf_def_h(l)%ol ) )  surf_def_h(l)%ol = 1.0E10_wp
-          IF ( surf_lsm_h(l)%ns    >= 1  .AND.                                                     &
-               ALLOCATED( surf_lsm_h(l)%ol ) )  surf_lsm_h(l)%ol = 1.0E10_wp
-          IF ( surf_usm_h(l)%ns    >= 1  .AND.                                                     &
-               ALLOCATED( surf_usm_h(l)%ol ) )  surf_usm_h(l)%ol = 1.0E10_wp
-       ENDDO
-       DO  l = 0, 3
-          IF ( surf_def_v(l)%ns >= 1  .AND.                                                        &
-               ALLOCATED( surf_def_v(l)%ol ) )  surf_def_v(l)%ol = 1.0E10_wp
-          IF ( surf_lsm_v(l)%ns >= 1  .AND.                                                        &
-               ALLOCATED( surf_lsm_v(l)%ol ) )  surf_lsm_v(l)%ol = 1.0E10_wp
-          IF ( surf_usm_v(l)%ns >= 1  .AND.                                                        &
-               ALLOCATED( surf_usm_v(l)%ol ) )  surf_usm_v(l)%ol = 1.0E10_wp
-       ENDDO
-
-    ENDIF
-
-    CALL location_message( 'initializing surface layer', 'finished' )
-
- END SUBROUTINE init_surface_layer_fluxes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute ln(z/z0).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_ln
-
-    INTEGER(iwp) ::  m     !< running index surface elements
-
-!
-!-- Note, ln(z/z0h) and ln(z/z0q) is also calculated even if neural simulations are applied.
-!-- This is because the scalar coefficients are also used for other scalars such as passive scalars,
-!-- chemistry and aerosols.
-    !$OMP PARALLEL DO PRIVATE( z_mo )
-    !$ACC PARALLEL LOOP PRIVATE(z_mo) &
-    !$ACC PRESENT(surf)
-    DO  m = 1, surf%ns
-       z_mo = surf%z_mo(m)
-       surf%ln_z_z0(m)  = LOG( z_mo / surf%z0(m) )
-       surf%ln_z_z0h(m) = LOG( z_mo / surf%z0h(m) )
-       surf%ln_z_z0q(m) = LOG( z_mo / surf%z0q(m) )
-    ENDDO
-
- END SUBROUTINE calc_ln
- 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the absolute value of the horizontal velocity (relative to the surface) for horizontal
-!> surface elements. This is required by all methods.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_uvw_abs
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !< running index x direction
-    INTEGER(iwp) ::  ibit  !< flag to mask computation of relative velocity in case of downward-facing surfaces
-    INTEGER(iwp) ::  j     !< running index y direction
-    INTEGER(iwp) ::  k     !< running index z direction
-    INTEGER(iwp) ::  m     !< running index surface elements
-
-    REAL(wp) ::  w_lfc  !< local free convection velocity scale
-!
-!-- ibit is 1 for upward-facing surfaces, zero for downward-facing surfaces.
-    ibit = MERGE( 1, 0, .NOT. downward )
-
-    IF ( use_free_convection_scaling )  THEN
-       !$OMP PARALLEL DO PRIVATE(i, j, k, w_lfc)
-       !$ACC PARALLEL LOOP PRIVATE(i, j, k, w_lfc) &
-       !$ACC PRESENT(surf, u, v)
-       DO  m = 1, surf%ns
-          i   = surf%i(m)
-          j   = surf%j(m)
-          k   = surf%k(m)
-
-!
-!--       Calculate free convection velocity scale w_lfc is use_free_convection_scaling = .T.. This
-!--       will maintain a horizontal velocity even for very weak wind convective conditions. SIGN is
-!--       used to set w_lfc to zero under stable conditions.
-          w_lfc = ABS(g / surf%pt1(m) * surf%z_mo(m) * surf%shf(m))
-          w_lfc = ( 0.5_wp * ( w_lfc + SIGN(w_lfc,surf%shf(m)) ) )**(0.33333_wp)
-!
-!--       Compute the absolute value of the horizontal velocity. (relative to the surface in case the
-!--       lower surface is the ocean). Please note, in new surface modelling concept the index values
-!--       changed, i.e. the reference grid point is not the surface-grid point itself but the first
-!--       grid point outside of the topography. Note, in case of coupled ocean-atmosphere simulations
-!--       relative velocity with respect to the ocean surface is used, hence, (k-1,j,i) values are used
-!--       to calculate the absolute velocity. However, this does not apply for downward-facing walls.
-!--       To mask this, use ibit, which checks for upward/downward-facing surfaces.
-          surf%uvw_abs(m) = SQRT( ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) - ( u(k-1,j,i) + u(k-1,j,i+1)  &
-                                                                       ) * ibit )                   &
-                                  )**2                                                              &
-                                + ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) - ( v(k-1,j,i) + v(k-1,j+1,i)  &
-                                                                       ) * ibit )                   &
-                                  )**2  + w_lfc**2 )
-       ENDDO
-    ELSE
-       !$OMP PARALLEL DO PRIVATE(i, j, k)
-       !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
-       !$ACC PRESENT(surf, u, v)
-       DO  m = 1, surf%ns
-          i   = surf%i(m)
-          j   = surf%j(m)
-          k   = surf%k(m)
-!
-!--       Compute the absolute value of the horizontal velocity. (relative to the surface in case the
-!--       lower surface is the ocean). Please note, in new surface modelling concept the index values
-!--       changed, i.e. the reference grid point is not the surface-grid point itself but the first
-!--       grid point outside of the topography. Note, in case of coupled ocean-atmosphere simulations
-!--       relative velocity with respect to the ocean surface is used, hence, (k-1,j,i) values are used
-!--       to calculate the absolute velocity. However, this does not apply for downward-facing walls.
-!--       To mask this, use ibit, which checks for upward/downward-facing surfaces.
-          surf%uvw_abs(m) = SQRT( ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) - ( u(k-1,j,i) + u(k-1,j,i+1)  &
-                                                                       ) * ibit )                   &
-                                  )**2                                                              &
-                                + ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) - ( v(k-1,j,i) + v(k-1,j+1,i)  &
-                                                                       ) * ibit )                   &
-                                  )**2 )
-       ENDDO
-    ENDIF
-
- END SUBROUTINE calc_uvw_abs
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the absolute value of the horizontal velocity (relative to the surface) for horizontal
-!> surface elements. This is required by all methods.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_uvw_abs_v_ugrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i    !< running index x direction
-    INTEGER(iwp) ::  j    !< running index y direction
-    INTEGER(iwp) ::  k    !< running index z direction
-    INTEGER(iwp) ::  m    !< running index surface elements
-
-    REAL(wp) ::  u_i  !< u-component on xu-grid
-    REAL(wp) ::  w_i  !< w-component on xu-grid
-
-
-    DO  m = 1, surf%ns
-       i   = surf%i(m)
-       j   = surf%j(m)
-       k   = surf%k(m)
-!
-!--    Compute the absolute value of the surface parallel velocity on u-grid.
-       u_i  = u(k,j,i)
-       w_i  = 0.25_wp * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) )
-
-       surf%uvw_abs(m) = SQRT( u_i**2 + w_i**2 )
-    ENDDO
-
- END SUBROUTINE calc_uvw_abs_v_ugrid
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the absolute value of the horizontal velocity (relative to the surface) for horizontal
-!> surface elements. This is required by all methods.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_uvw_abs_v_vgrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< running index x direction
-    INTEGER(iwp) ::  j  !< running index y direction
-    INTEGER(iwp) ::  k  !< running index z direction
-    INTEGER(iwp) ::  m  !< running index surface elements
-
-    REAL(wp) ::  v_i  !< v-component on yv-grid
-    REAL(wp) ::  w_i  !< w-component on yv-grid
-
-
-    DO  m = 1, surf%ns
-       i = surf%i(m)
-       j = surf%j(m)
-       k = surf%k(m)
-
-       v_i = u(k,j,i)
-       w_i = 0.25_wp * ( w(k-1,j-1,i) + w(k-1,j,i) + w(k,j-1,i) + w(k,j,i) )
-
-       surf%uvw_abs(m) = SQRT( v_i**2 + w_i**2 )
-    ENDDO
-
- END SUBROUTINE calc_uvw_abs_v_vgrid
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the absolute value of the horizontal velocity (relative to the surface) for horizontal
-!> surface elements. This is required by all methods.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_uvw_abs_v_wgrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i   !< running index x direction
-    INTEGER(iwp) ::  j   !< running index y direction
-    INTEGER(iwp) ::  k   !< running index z direction
-    INTEGER(iwp) ::  m   !< running index surface elements
-
-    REAL(wp) ::  u_i  !< u-component on x-zw-grid
-    REAL(wp) ::  v_i  !< v-component on y-zw-grid
-    REAL(wp) ::  w_i  !< w-component on zw-grid
-!
-!-- North- (l=0) and south-facing (l=1) surfaces
-    IF ( l == 0  .OR.  l == 1 )  THEN
-       DO  m = 1, surf%ns
-          i   = surf%i(m)
-          j   = surf%j(m)
-          k   = surf%k(m)
-
-          u_i  = 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  = 0.0_wp
-          w_i  = w(k,j,i)
-
-          surf%uvw_abs(m) = SQRT( u_i**2 + v_i**2 + w_i**2 )
-       ENDDO
-!
-!-- East- (l=2) and west-facing (l=3) surfaces
-    ELSE
-       DO  m = 1, surf%ns
-          i   = surf%i(m)
-          j   = surf%j(m)
-          k   = surf%k(m)
-
-          u_i  = 0.0_wp
-          v_i  = 0.25_wp * ( v(k+1,j+1,i) + v(k+1,j,i) + v(k,j+1,i) + v(k,j,i) )
-          w_i  = w(k,j,i)
-
-          surf%uvw_abs(m) = SQRT( u_i**2 + v_i**2 + w_i**2 )
-       ENDDO
-    ENDIF
-
- END SUBROUTINE calc_uvw_abs_v_wgrid
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Compute the absolute value of the horizontal velocity (relative to the surface) for horizontal
-!> surface elements. This is required by all methods.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_uvw_abs_v_sgrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< running index x direction
-    INTEGER(iwp) ::  j  !< running index y direction
-    INTEGER(iwp) ::  k  !< running index z direction
-    INTEGER(iwp) ::  m  !< running index surface elements
-
-    REAL(wp) ::  u_i  !< u-component on scalar grid
-    REAL(wp) ::  v_i  !< v-component on scalar grid
-    REAL(wp) ::  w_i  !< w-component on scalar grid
-
-!
-!-- North- (l=0) and south-facing (l=1) walls
-    IF ( l == 0  .OR.  l == 1 )  THEN
-       DO  m = 1, surf%ns
-          i   = surf%i(m)
-          j   = surf%j(m)
-          k   = surf%k(m)
-
-          u_i = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
-          v_i = 0.0_wp
-          w_i = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
-
-          surf%uvw_abs(m) = SQRT( u_i**2 + v_i**2 + w_i**2 )
-       ENDDO
-!
-!-- East- (l=2) and west-facing (l=3) walls
-    ELSE
-       DO  m = 1, surf%ns
-          i   = surf%i(m)
-          j   = surf%j(m)
-          k   = surf%k(m)
-
-          u_i = 0.0_wp
-          v_i = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
-          w_i = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
-
-          surf%uvw_abs(m) = SQRT( u_i**2 + v_i**2 + w_i**2 )
-       ENDDO
-    ENDIF
-
- END SUBROUTINE calc_uvw_abs_v_sgrid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the Obukhov length (L) and Richardson flux number (z/L)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_ol
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  iter  !< Newton iteration step
-    INTEGER(iwp) ::  m     !< loop variable over all horizontal wall elements
-
-    LOGICAL, DIMENSION(surf%ns) ::  convergence_reached  !< convergence switch for vectorization
-    !$ACC DECLARE CREATE( convergence_reached )
-
-    REAL(wp) ::  f       !< Function for Newton iteration: f = Ri - [...]/[...]^2 = 0
-    REAL(wp) ::  f_d_ol  !< Derivative of f
-    REAL(wp) ::  ol_l    !< Lower bound of L for Newton iteration
-    REAL(wp) ::  ol_m    !< Previous value of L for Newton iteration
-    REAL(wp) ::  ol_old  !< Previous time step value of L
-    REAL(wp) ::  ol_u    !< Upper bound of L for Newton iteration
-
-    REAL(wp), DIMENSION(surf%ns) ::  ol_old_vec  !< temporary array required for vectorization
-    REAL(wp), DIMENSION(surf%ns) ::  z_mo_vec    !< temporary array required for vectorization
-    !$ACC DECLARE CREATE( ol_old_vec, z_mo_vec )
-
-!
-!-- Evaluate bulk Richardson number (calculation depends on definition based on setting of boundary
-!-- conditions)
-    IF ( ibc_pt_b /= 1 )  THEN
-       IF ( humidity )  THEN
-          !$OMP PARALLEL DO PRIVATE( z_mo )
-          DO  m = 1, surf%ns
-             z_mo = surf%z_mo(m)
-             surf%rib(m) = g * z_mo * ( surf%vpt1(m) - surf%vpt_surface(m) ) /                     &
-                           ( surf%uvw_abs(m)**2 * surf%vpt1(m) + 1.0E-20_wp )
-          ENDDO
-       ELSE
-          !$OMP PARALLEL DO PRIVATE( z_mo )
-          DO  m = 1, surf%ns
-             z_mo = surf%z_mo(m)
-             surf%rib(m) = g * z_mo * ( surf%pt1(m) - surf%pt_surface(m) ) /                       &
-                           ( surf%uvw_abs(m)**2 * surf%pt1(m) + 1.0E-20_wp )
-          ENDDO
-       ENDIF
-    ELSE
-       IF ( humidity )  THEN
-          !$OMP PARALLEL DO PRIVATE( k, z_mo )
-          DO  m = 1, surf%ns
-             k = surf%k(m)
-             z_mo = surf%z_mo(m)
-             surf%rib(m) = - g * z_mo * ( ( 1.0_wp + 0.61_wp * surf%qv1(m) ) *                     &
-                           surf%shf(m) + 0.61_wp * surf%pt1(m) * surf%qsws(m) ) *                  &
-                           drho_air_zw(k-1) / ( surf%uvw_abs(m)**3 * surf%vpt1(m) * kappa**2       &
-                           + 1.0E-20_wp )
-          ENDDO
-       ELSE
-          !$OMP PARALLEL DO PRIVATE( k, z_mo )
-          !$ACC PARALLEL LOOP PRIVATE(k, z_mo) &
-          !$ACC PRESENT(surf, drho_air_zw)
-          DO  m = 1, surf%ns
-             k = surf%k(m)
-             z_mo = surf%z_mo(m)
-             surf%rib(m) = - g * z_mo * surf%shf(m) * drho_air_zw(k-1) /                           &
-                           ( surf%uvw_abs(m)**3 * surf%pt1(m) * kappa**2 + 1.0E-20_wp )
-          ENDDO
-       ENDIF
-    ENDIF
-
-    IF ( loop_optimization == 'cache' )  THEN
-!
-!--    Calculate the Obukhov length using Newton iteration
-       !$OMP PARALLEL DO PRIVATE(i, j, z_mo, ol_old, iter, ol_m, ol_l, ol_u, f, f_d_ol)
-       !$ACC PARALLEL LOOP PRIVATE(i, j, z_mo) &
-       !$ACC PRIVATE(ol_old, ol_m, ol_l, ol_u, f, f_d_ol) &
-       !$ACC PRESENT(surf)
-       DO  m = 1, surf%ns
-          i   = surf%i(m)
-          j   = surf%j(m)
-
-          z_mo = surf%z_mo(m)
-
-!
-!--       Store current value in case the Newton iteration fails
-          ol_old = surf%ol(m)
-
-!
-!--       Ensure that the bulk Richardson number and the Obukhov length have the same sign
-          IF ( surf%rib(m) * surf%ol(m) < 0.0_wp  .OR.  ABS( surf%ol(m) ) == ol_max )  THEN
-             IF ( surf%rib(m) > 1.0_wp ) surf%ol(m) =  0.01_wp
-             IF ( surf%rib(m) < 0.0_wp ) surf%ol(m) = -0.01_wp
-          ENDIF
-!
-!--       Iteration to find Obukhov length
-          iter = 0
-          DO
-             iter = iter + 1
-!
-!--          In case of divergence, use the value of the previous time step
-             IF ( iter > 1000 )  THEN
-                surf%ol(m) = ol_old
-                EXIT
-             ENDIF
-
-             ol_m = surf%ol(m)
-             ol_l = ol_m - 0.001_wp * ol_m
-             ol_u = ol_m + 0.001_wp * ol_m
-
-
-             IF ( ibc_pt_b /= 1 )  THEN
-!
-!--             Calculate f = Ri - [...]/[...]^2 = 0
-                f = surf%rib(m) - ( z_mo / ol_m ) * ( surf%ln_z_z0h(m)                             &
-                                                      - psi_h( z_mo / ol_m )                       &
-                                                      + psi_h( surf%z0h(m) / ol_m ) ) /            &
-                    ( surf%ln_z_z0(m) - psi_m( z_mo / ol_m )                                       &
-                                      + psi_m( surf%z0(m) /  ol_m ) )**2
-
-!
-!--             Calculate df/dL
-                f_d_ol = ( - ( z_mo / ol_u ) * ( surf%ln_z_z0h(m)                                  &
-                                                 - psi_h( z_mo / ol_u )                            &
-                                                 + psi_h( surf%z0h(m) / ol_u ) ) /                 &
-                           ( surf%ln_z_z0(m) - psi_m( z_mo / ol_u )                                &
-                                             + psi_m( surf%z0(m) / ol_u ) )**2                     &
-                           + ( z_mo / ol_l ) * ( surf%ln_z_z0h(m) - psi_h( z_mo / ol_l )           &
-                                                                  + psi_h( surf%z0h(m) / ol_l ) ) /&
-                           ( surf%ln_z_z0(m) - psi_m( z_mo / ol_l )                                &
-                                             + psi_m( surf%z0(m) / ol_l ) )**2 ) / ( ol_u - ol_l )
-             ELSE
-!
-!--             Calculate f = Ri - 1 /[...]^3 = 0
-                f = surf%rib(m) - ( z_mo / ol_m ) /                                                &
-                    ( surf%ln_z_z0(m) - psi_m( z_mo / ol_m ) + psi_m( surf%z0(m) / ol_m ) )**3
-
-!
-!--             Calculate df/dL
-                f_d_ol = ( - ( z_mo / ol_u ) / ( surf%ln_z_z0(m)                                   &
-                                                 - psi_m( z_mo / ol_u )                            &
-                                                 + psi_m( surf%z0(m) / ol_u )                      &
-                                               )**3                                                &
-                           + ( z_mo / ol_l ) / ( surf%ln_z_z0(m)                                   &
-                                                 - psi_m( z_mo / ol_l )                            &
-                                                 + psi_m( surf%z0(m) / ol_l )                      &
-                                               )**3                                                &
-                          ) / ( ol_u - ol_l )
-             ENDIF
-!
-!--          Calculate new L
-             surf%ol(m) = ol_m - f / f_d_ol
-
-!
-!--          Ensure that the bulk Richardson number and the Obukhov length have the same sign and
-!--          ensure convergence.
-             IF ( surf%ol(m) * ol_m < 0.0_wp )  surf%ol(m) = ol_m * 0.5_wp
-!
-!--          If unrealistic value occurs, set L to the maximum value that is allowed
-             IF ( ABS( surf%ol(m) ) > ol_max )  THEN
-                surf%ol(m) = ol_max
-                EXIT
-             ENDIF
-!
-!--          Assure that Obukhov length does not become zero. If the limit is reached, exit the loop.
-             IF ( ABS( surf%ol(m) ) < 1E-5_wp )  THEN
-                surf%ol(m) = SIGN( 1E-5_wp, surf%ol(m) )
-                EXIT
-             ENDIF
-!
-!--          Check for convergence
-             IF ( ABS( ( surf%ol(m) - ol_m ) /  surf%ol(m) ) < 1.0E-4_wp )  EXIT
-          ENDDO
-       ENDDO
-
-!
-!-- Vector Version
-    ELSE
-!
-!--    Calculate the Obukhov length using Newton iteration
-!--    First set arrays required for vectorization
-       !$ACC PARALLEL LOOP &
-       !$ACC PRESENT(surf)
-       DO  m = 1, surf%ns
-          z_mo_vec(m) = surf%z_mo(m)
-!
-!--       Store current value in case the Newton iteration fails
-          ol_old_vec(m) = surf%ol(m)
-!
-!--       Ensure that the bulk Richardson number and the Obukhov length have the same sign
-          IF ( surf%rib(m) * surf%ol(m) < 0.0_wp  .OR.  ABS( surf%ol(m) ) == ol_max )  THEN
-             IF ( surf%rib(m) > 1.0_wp ) surf%ol(m) =  0.01_wp
-             IF ( surf%rib(m) < 0.0_wp ) surf%ol(m) = -0.01_wp
-          ENDIF
-!
-!--       Initialize convergence flag
-          convergence_reached(m) = .FALSE.
-       ENDDO
-
-!
-!--    Iteration to find Obukhov length
-       iter = 0
-       DO
-          iter = iter + 1
-!
-!--       In case of divergence, use the value(s) of the previous time step
-          IF ( iter > 1000 )  THEN
-             !$ACC PARALLEL LOOP &
-             !$ACC PRESENT(surf)
-             DO  m = 1, surf%ns
-                IF ( .NOT. convergence_reached(m) )  surf%ol(m) = ol_old_vec(m)
-             ENDDO
-             EXIT
-          ENDIF
-
-          !$ACC PARALLEL LOOP PRIVATE(ol_m, ol_l, ol_u, f, f_d_ol) &
-          !$ACC PRESENT(surf)
-          DO  m = 1, surf%ns
-             IF ( convergence_reached(m) )  CYCLE
-
-             ol_m = surf%ol(m)
-             ol_l = ol_m - 0.001_wp * ol_m
-             ol_u = ol_m + 0.001_wp * ol_m
-
-
-             IF ( ibc_pt_b /= 1 )  THEN
-!
-!--             Calculate f = Ri - [...]/[...]^2 = 0
-                f = surf%rib(m) - ( z_mo_vec(m) / ol_m ) * ( surf%ln_z_z0h(m)                      &
-                                                           - psi_h( z_mo_vec(m) / ol_m )           &
-                                                           + psi_h( surf%z0h(m) / ol_m )           &
-                                                           ) /                                     &
-                                                           ( surf%ln_z_z0(m)                       &
-                                                          - psi_m( z_mo_vec(m) / ol_m )            &
-                                                          + psi_m( surf%z0(m) /  ol_m )            &
-                                                           )**2
-
-!
-!--             Calculate df/dL
-                f_d_ol = ( - ( z_mo_vec(m) / ol_u ) * ( surf%ln_z_z0h(m)                           &
-                                                        - psi_h( z_mo_vec(m) / ol_u )              &
-                                                        + psi_h( surf%z0h(m) / ol_u )              &
-                                                      ) /                                          &
-                                                      ( surf%ln_z_z0(m)                            &
-                                                        - psi_m( z_mo_vec(m) / ol_u )              &
-                                                        + psi_m( surf%z0(m) / ol_u )               &
-                                                      )**2                                         &
-                           + ( z_mo_vec(m) / ol_l ) * ( surf%ln_z_z0h(m)                           &
-                                                        - psi_h( z_mo_vec(m) / ol_l )              &
-                                                        + psi_h( surf%z0h(m) / ol_l )              &
-                                                      ) /                                          &
-                                                      ( surf%ln_z_z0(m)                            &
-                                                        - psi_m( z_mo_vec(m) / ol_l )              &
-                                                        + psi_m( surf%z0(m) / ol_l )               &
-                                                      )**2                                         &
-                         ) / ( ol_u - ol_l )
-             ELSE
-!
-!--             Calculate f = Ri - 1 /[...]^3 = 0
-                f = surf%rib(m) - ( z_mo_vec(m) / ol_m ) / ( surf%ln_z_z0(m)                       &
-                                                             - psi_m( z_mo_vec(m) / ol_m )         &
-                                                             + psi_m( surf%z0(m) / ol_m )          &
-                                                           )**3
-
-!
-!--             Calculate df/dL
-                f_d_ol = ( - ( z_mo_vec(m) / ol_u ) / ( surf%ln_z_z0(m)                            &
-                                                        - psi_m( z_mo_vec(m) / ol_u )              &
-                                                        + psi_m( surf%z0(m) / ol_u )               &
-                                                      )**3                                         &
-                           + ( z_mo_vec(m) / ol_l ) / ( surf%ln_z_z0(m)                            &
-                                                        - psi_m( z_mo_vec(m) / ol_l )              &
-                                                        + psi_m( surf%z0(m) / ol_l )               &
-                                                      )**3                                         &
-                         ) / ( ol_u - ol_l )
-             ENDIF
-!
-!--          Calculate new L
-             surf%ol(m) = ol_m - f / f_d_ol
-
-!
-!--          Ensure that the bulk Richardson number and the Obukhov length have the same sign and
-!--          ensure convergence.
-             IF ( surf%ol(m) * ol_m < 0.0_wp )  surf%ol(m) = ol_m * 0.5_wp
-
-!
-!--          Check for convergence
-!--          This check does not modify surf%ol, therefore this is done first
-             IF ( ABS( ( surf%ol(m) - ol_m ) /  surf%ol(m) ) < 1.0E-4_wp )  THEN
-                convergence_reached(m) = .TRUE.
-             ENDIF
-!
-!--          If unrealistic value occurs, set L to the maximum allowed value
-             IF ( ABS( surf%ol(m) ) > ol_max )  THEN
-                surf%ol(m) = ol_max
-                convergence_reached(m) = .TRUE.
-             ENDIF
-          ENDDO
-!
-!--       Assure that Obukhov length does not become zero
-          !$ACC PARALLEL LOOP &
-          !$ACC PRESENT(surf)
-          DO  m = 1, surf%ns
-             IF ( convergence_reached(m) )  CYCLE
-             IF ( ABS( surf%ol(m) ) < 1E-5_wp )  THEN
-                surf%ol(m) = SIGN( 10E-6_wp, surf%ol(m) )
-                convergence_reached(m) = .TRUE.
-             ENDIF
-          ENDDO
-
-          IF ( ALL( convergence_reached ) )  EXIT
-
-       ENDDO  ! End of iteration loop
-
-    ENDIF  ! End of vector branch
-
- END SUBROUTINE calc_ol
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate friction velocity u*.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_us
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  m  !< loop variable over all horizontal surf elements
-
-!
-!-- Compute u* at horizontal surfaces at the scalars' grid points
-    IF ( .NOT. surf_vertical )  THEN
-!
-!--    Compute u* at upward-facing surfaces
-       IF ( .NOT. downward )  THEN
-          !$OMP PARALLEL  DO PRIVATE( z_mo )
-          !$ACC PARALLEL LOOP PRIVATE(z_mo) &
-          !$ACC PRESENT(surf)
-          DO  m = 1, surf%ns
-             z_mo = surf%z_mo(m)
-!
-!--          Compute u* at the scalars' grid points
-             surf%us(m) = kappa * surf%uvw_abs(m) / ( surf%ln_z_z0(m)                              &
-                                                      - psi_m( z_mo / surf%ol(m) )                 &
-                                                      + psi_m( surf%z0(m) / surf%ol(m) ) )
-          ENDDO
-!
-!--    Compute u* at downward-facing surfaces. This case, do not consider any stability.
-       ELSE
-          !$OMP PARALLEL DO
-          !$ACC PARALLEL LOOP &
-          !$ACC PRESENT(surf)
-          DO  m = 1, surf%ns
-!
-!--          Compute u* at the scalars' grid points
-             surf%us(m) = kappa * surf%uvw_abs(m) / surf%ln_z_z0(m)
-          ENDDO
-       ENDIF
-!
-!-- Compute u* at vertical surfaces at the u/v/v grid, respectively.
-!-- No stability is considered in this case.
-    ELSE
-       !$OMP PARALLEL DO
-       !$ACC PARALLEL LOOP &
-       !$ACC PRESENT(surf)
-       DO  m = 1, surf%ns
-          surf%us(m) = kappa * surf%uvw_abs(m) / surf%ln_z_z0(m)
-       ENDDO
-    ENDIF
-
- END SUBROUTINE calc_us
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate potential temperature, specific humidity, and virtual potential temperature at first
-!> grid level.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_pt_q
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  m  !< loop variable over all horizontal surf elements
-
-    !$OMP PARALLEL DO PRIVATE( i, j, k )
-    !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
-    !$ACC PRESENT(surf, pt)
-    DO  m = 1, surf%ns
-       i = surf%i(m)
-       j = surf%j(m)
-       k = surf%k(m)
-
-#ifndef _OPENACC
-       IF ( bulk_cloud_model ) THEN
-          surf%pt1(m) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
-          surf%qv1(m) = q(k,j,i) - ql(k,j,i)
-       ELSEIF( cloud_droplets ) THEN
-          surf%pt1(m) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
-          surf%qv1(m) = q(k,j,i)
-       ELSE
-#endif
-          surf%pt1(m) = pt(k,j,i)
-#ifndef _OPENACC
-          IF ( humidity )  THEN
-             surf%qv1(m) = q(k,j,i)
-          ELSE
-#endif
-             surf%qv1(m) = 0.0_wp
-#ifndef _OPENACC
-          ENDIF
-       ENDIF
-
-       IF ( humidity )  THEN
-          surf%vpt1(m) = pt(k,j,i) * ( 1.0_wp + 0.61_wp * q(k,j,i) )
-       ENDIF
-#endif
-    ENDDO
-
- END SUBROUTINE calc_pt_q
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set potential temperature at surface grid level( only for upward-facing surfs ).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_pt_surface
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k_off  !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls)
-    INTEGER(iwp) ::  m      !< loop variable over all horizontal surf elements
-
-    k_off = surf%koff
-    !$OMP PARALLEL DO PRIVATE( i, j, k )
-    !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
-    !$ACC PRESENT(surf, pt)
-    DO  m = 1, surf%ns
-       i = surf%i(m)
-       j = surf%j(m)
-       k = surf%k(m)
-       surf%pt_surface(m) = pt(k+k_off,j,i)
-    ENDDO
-
- END SUBROUTINE calc_pt_surface
-
-!
-!-- Set mixing ratio at surface grid level. ( Only for upward-facing surfs. )
- SUBROUTINE calc_q_surface
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k_off  !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls)
-    INTEGER(iwp) ::  m      !< loop variable over all horizontal surf elements
-
-    k_off = surf%koff
-    !$OMP PARALLEL DO PRIVATE( i, j, k )
-    DO  m = 1, surf%ns
-       i = surf%i(m)
-       j = surf%j(m)
-       k = surf%k(m)
-       surf%q_surface(m) = q(k+k_off,j,i)
-    ENDDO
-
- END SUBROUTINE calc_q_surface
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set virtual potential temperature at surface grid level ( only for upward-facing surfs ).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_vpt_surface
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k_off  !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls)
-    INTEGER(iwp) ::  m      !< loop variable over all horizontal surf elements
-
-    k_off = surf%koff
-    !$OMP PARALLEL DO PRIVATE( i, j, k )
-    DO  m = 1, surf%ns
-       i = surf%i(m)
-       j = surf%j(m)
-       k = surf%k(m)
-       surf%vpt_surface(m) = vpt(k+k_off,j,i)
-
-    ENDDO
-
- END SUBROUTINE calc_vpt_surface
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the other MOST scaling parameters theta*, q*, (qc*, qr*, nc*, nr*)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_scaling_parameters
-
-    IMPLICIT NONE
-
-
-    INTEGER(iwp)  ::  lsp  !< running index for chemical species
-    INTEGER(iwp)  ::  m    !< loop variable over all horizontal surf elements
-!
-!-- Compute theta* at horizontal surfaces
-    IF ( constant_heatflux  .AND.  .NOT. surf_vertical )  THEN
-!
-!--    For a given heat flux in the surface layer:
-
-       !$OMP PARALLEL DO PRIVATE( i, j, k )
-       !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
-       !$ACC PRESENT(surf, drho_air_zw)
-       DO  m = 1, surf%ns
-          i = surf%i(m)
-          j = surf%j(m)
-          k = surf%k(m)
-          surf%ts(m) = -surf%shf(m) * drho_air_zw(k-1) / ( surf%us(m) + 1E-30_wp )
-!
-!--       ts must be limited, because otherwise overflow may occur in case of us=0 when computing
-!--       ol further below
-          IF ( surf%ts(m) < -1.05E5_wp )  surf%ts(m) = -1.0E5_wp
-          IF ( surf%ts(m) >  1.0E5_wp  )  surf%ts(m) =  1.0E5_wp
-       ENDDO
-
-    ELSEIF ( .NOT. surf_vertical ) THEN
-!
-!--    For a given surface temperature:
-       IF ( large_scale_forcing  .AND.  lsf_surf )  THEN
-
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-          DO  m = 1, surf%ns
-             i   = surf%i(m)
-             j   = surf%j(m)
-             k   = surf%k(m)
-             pt(k-1,j,i) = pt_surface
-          ENDDO
-       ENDIF
-
-       !$OMP PARALLEL DO PRIVATE( z_mo )
-       DO  m = 1, surf%ns
-          z_mo = surf%z_mo(m)
-          surf%ts(m) = kappa * ( surf%pt1(m) - surf%pt_surface(m) )                                &
-                       / ( surf%ln_z_z0h(m) - psi_h( z_mo / surf%ol(m) )                           &
-                                            + psi_h( surf%z0h(m) / surf%ol(m) ) )
-       ENDDO
-
-    ENDIF
-!
-!-- Compute theta* at vertical surfaces. This is only required in case of land-surface model, in
-!-- order to compute aerodynamical resistance.
-    IF ( surf_vertical )  THEN
-       !$OMP PARALLEL DO PRIVATE( i, j )
-       DO  m = 1, surf%ns
-          i          =  surf%i(m)
-          j          =  surf%j(m)
-          surf%ts(m) = -surf%shf(m) / ( surf%us(m) + 1E-30_wp )
-!
-!--       ts must be limited, because otherwise overflow may occur in case of us=0 when computing ol
-!--       further below
-          IF ( surf%ts(m) < -1.05E5_wp )  surf%ts(m) = -1.0E5_wp
-          IF ( surf%ts(m) >  1.0E5_wp  )  surf%ts(m) =  1.0E5_wp
-       ENDDO
-    ENDIF
-
-!
-!-- If required compute q* at horizontal surfaces
-    IF ( humidity )  THEN
-       IF ( constant_waterflux  .AND.  .NOT. surf_vertical )  THEN
-!
-!--       For a given water flux in the surface layer
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-             surf%qs(m) = -surf%qsws(m) * drho_air_zw(k-1) / ( surf%us(m) + 1E-30_wp )
-          ENDDO
-
-       ELSEIF ( .NOT. surf_vertical )  THEN
-          coupled_run = ( coupling_mode == 'atmosphere_to_ocean'  .AND.  run_coupled )
-
-          IF ( large_scale_forcing  .AND.  lsf_surf )  THEN
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, surf%ns
-                i = surf%i(m)
-                j = surf%j(m)
-                k = surf%k(m)
-                q(k-1,j,i) = q_surface
-
-             ENDDO
-          ENDIF
-
-!
-!--       Assume saturation for atmosphere coupled to ocean (but not in case of precursor runs)
-          IF ( coupled_run )  THEN
-             !$OMP PARALLEL DO PRIVATE( i, j, k, e_s )
-             DO  m = 1, surf%ns
-                i   = surf%i(m)
-                j   = surf%j(m)
-                k   = surf%k(m)
-                e_s = 6.1_wp * EXP( 0.07_wp * ( MIN( pt(k-1,j,i), pt(k,j,i) ) - 273.15_wp ) )
-                q(k-1,j,i) = rd_d_rv * e_s / ( surface_pressure - e_s )
-             ENDDO
-          ENDIF
-
-          IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
-             !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo )
-             DO  m = 1, surf%ns
-                i = surf%i(m)
-                j = surf%j(m)
-                k = surf%k(m)
-                z_mo = surf%z_mo(m)
-                surf%qs(m) = kappa * ( surf%qv1(m) - surf%q_surface(m) )                           &
-                             / ( surf%ln_z_z0q(m) - psi_h( z_mo / surf%ol(m) )                     &
-                                                  + psi_h( surf%z0q(m) / surf%ol(m) ) )
-             ENDDO
-          ELSE
-             !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo )
-             DO  m = 1, surf%ns
-                i = surf%i(m)
-                j = surf%j(m)
-                k = surf%k(m)
-                z_mo = surf%z_mo(m)
-                surf%qs(m) = kappa * ( q(k,j,i) - q(k-1,j,i) )                                     &
-                             / ( surf%ln_z_z0q(m) - psi_h( z_mo / surf%ol(m) )                     &
-                                                  + psi_h( surf%z0q(m) / surf%ol(m) ) )
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Compute q* at vertical surfaces
-       IF ( surf_vertical )  THEN
-          !$OMP PARALLEL DO PRIVATE( i, j )
-          DO  m = 1, surf%ns
-
-             i =  surf%i(m)
-             j =  surf%j(m)
-             surf%qs(m) = -surf%qsws(m) / ( surf%us(m) + 1E-30_wp )
-
-          ENDDO
-       ENDIF
-    ENDIF
-
-!
-!-- If required compute s*
-    IF ( passive_scalar )  THEN
-!
-!--    At horizontal surfaces
-       IF ( constant_scalarflux  .AND.  .NOT. surf_vertical )  THEN
-!
-!--       For a given scalar flux in the surface layer
-          !$OMP PARALLEL DO PRIVATE( i, j )
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-             surf%ss(m) = -surf%ssws(m) / ( surf%us(m) + 1E-30_wp )
-          ENDDO
-       ELSEIF ( .NOT. surf_vertical )  THEN
-
-          !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo )
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-             z_mo = surf%z_mo(m)
-
-             surf%ss(m) = kappa * ( s(k,j,i) - s(k-1,j,i) )                                        &
-                          / ( surf%ln_z_z0h(m) - psi_h( z_mo / surf%ol(m) )                        &
-                                               + psi_h( surf%z0h(m) / surf%ol(m) ) )
-          ENDDO
-       ENDIF
-!
-!--    At vertical surfaces
-       IF ( surf_vertical )  THEN
-          !$OMP PARALLEL DO PRIVATE( i, j )
-          DO  m = 1, surf%ns
-             i =  surf%i(m)
-             j =  surf%j(m)
-             surf%ss(m) = -surf%ssws(m) / ( surf%us(m) + 1E-30_wp )
-          ENDDO
-       ENDIF
-    ENDIF
-
-!
-!-- If required compute cs* (chemical species)
-    IF ( air_chemistry  )  THEN
-!
-!--    At horizontal surfaces
-       DO  lsp = 1, nvar
-          IF ( constant_csflux(lsp)  .AND.  .NOT.  surf_vertical )  THEN
-!--          For a given chemical species' flux in the surface layer
-             !$OMP PARALLEL DO PRIVATE( i, j )
-             DO  m = 1, surf%ns
-                i = surf%i(m)
-                j = surf%j(m)
-                surf%css(lsp,m) = -surf%cssws(lsp,m) / ( surf%us(m) + 1E-30_wp )
-             ENDDO
-          ENDIF
-       ENDDO
-!
-!--    At vertical surfaces
-       IF ( surf_vertical )  THEN
-          DO  lsp = 1, nvar
-             !$OMP PARALLEL DO PRIVATE( i, j )
-             DO  m = 1, surf%ns
-                i = surf%i(m)
-                j = surf%j(m)
-                surf%css(lsp,m) = -surf%cssws(lsp,m) / ( surf%us(m) + 1E-30_wp )
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
-!
-!-- If required compute qc* and nc*
-    IF ( bulk_cloud_model  .AND.  microphysics_morrison  .AND.  .NOT.  surf_vertical )  THEN
-       !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo )
-       DO  m = 1, surf%ns
-          i = surf%i(m)
-          j = surf%j(m)
-          k = surf%k(m)
-
-          z_mo = surf%z_mo(m)
-
-          surf%qcs(m) = kappa * ( qc(k,j,i) - qc(k-1,j,i) )                                        &
-                        / ( surf%ln_z_z0q(m) - psi_h( z_mo / surf%ol(m) )                          &
-                                             + psi_h( surf%z0q(m) / surf%ol(m) ) )
-
-          surf%ncs(m) = kappa * ( nc(k,j,i) - nc(k-1,j,i) )                                        &
-                        / ( surf%ln_z_z0q(m) - psi_h( z_mo / surf%ol(m) )                          &
-                                             + psi_h( surf%z0q(m) / surf%ol(m) ) )
-       ENDDO
-
-    ENDIF
-
-!
-!-- If required compute qr* and nr*
-    IF ( bulk_cloud_model  .AND.  microphysics_seifert  .AND.  .NOT. surf_vertical )  THEN
-       !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo )
-       DO  m = 1, surf%ns
-          i = surf%i(m)
-          j = surf%j(m)
-          k = surf%k(m)
-
-          z_mo = surf%z_mo(m)
-
-          surf%qrs(m) = kappa * ( qr(k,j,i) - qr(k-1,j,i) )                                        &
-                        / ( surf%ln_z_z0q(m) - psi_h( z_mo / surf%ol(m) )                          &
-                                             + psi_h( surf%z0q(m) / surf%ol(m) ) )
-
-          surf%nrs(m) = kappa * ( nr(k,j,i) - nr(k-1,j,i) )                                        &
-                        / ( surf%ln_z_z0q(m) - psi_h( z_mo / surf%ol(m) )                          &
-                                             + psi_h( surf%z0q(m) / surf%ol(m) ) )
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE calc_scaling_parameters
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate surface fluxes usws, vsws, shf, qsws, (qcsws, qrsws, ncsws, nrsws)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_surface_fluxes
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)  ::  lsp  !< running index for chemical species
-    INTEGER(iwp)  ::  m    !< loop variable over all horizontal surf elements
-
-    REAL(wp) ::  dum     !< dummy to precalculate logarithm
-    REAL(wp) ::  flag_u  !< flag indicating u-grid, used for calculation of horizontal momentum fluxes at vertical surfaces
-    REAL(wp) ::  flag_v  !< flag indicating v-grid, used for calculation of horizontal momentum fluxes at vertical surfaces
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  u_i     !< u-component interpolated onto scalar grid point, required for momentum fluxes
-                                                    !< at vertical surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  v_i     !< v-component interpolated onto scalar grid point, required for momentum fluxes
-                                                    !< at vertical surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  w_i     !< w-component interpolated onto scalar grid point, required for momentum fluxes
-                                                    !< at vertical surfaces
-
-!
-!-- Calcuate surface fluxes at horizontal walls
-    IF ( .NOT. surf_vertical )  THEN
-!
-!--    Compute u'w' for the total model domain at upward-facing surfaces. First compute the
-!--    corresponding component of u* and square it.
-       IF ( .NOT. downward )  THEN
-          !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo )
-          !$ACC PARALLEL LOOP PRIVATE(i, j, k, z_mo) &
-          !$ACC PRESENT(surf, u, rho_air_zw)
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-
-             z_mo = surf%z_mo(m)
-
-             surf%usws(m) = kappa * ( u(k,j,i) - u(k-1,j,i) )                                      &
-                            / ( surf%ln_z_z0(m) - psi_m( z_mo / surf%ol(m) )                       &
-                                                + psi_m( surf%z0(m) / surf%ol(m) ) )
-!
-!--          Please note, the computation of usws is not fully accurate. Actually a further
-!--          interpolation of us onto the u-grid, where usws is defined, is required. However, this
-!--          is not done as this would require several data transfers between 2D-grid and the
-!--          surf-type. The impact of the missing interpolation is negligible as several tests have
-!--          shown. Same also for ol.
-             surf%usws(m) = -surf%usws(m) * surf%us(m) * rho_air_zw(k-1)
-          ENDDO
-!
-!--    At downward-facing surfaces
-       ELSE
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-
-             surf%usws(m) = kappa * u(k,j,i) / surf%ln_z_z0(m)
-             surf%usws(m) = surf%usws(m) * surf%us(m) * rho_air_zw(k)
-          ENDDO
-       ENDIF
-
-!
-!--    Compute v'w' for the total model domain. First compute the corresponding component of u* and
-!--    square it.
-!--    Upward-facing surfaces
-       IF ( .NOT. downward )  THEN
-          !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo )
-          !$ACC PARALLEL LOOP PRIVATE(i, j, k, z_mo) &
-          !$ACC PRESENT(surf, v, rho_air_zw)
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-
-             z_mo = surf%z_mo(m)
-
-             surf%vsws(m) = kappa * ( v(k,j,i) - v(k-1,j,i) )                                      &
-                            / ( surf%ln_z_z0(m) - psi_m( z_mo / surf%ol(m) )                       &
-                                                + psi_m( surf%z0(m) / surf%ol(m) ) )
-!
-!--          Please note, the computation of vsws is not fully accurate. Actually a further
-!--          interpolation of us onto the v-grid, where vsws is defined, is required. However, this
-!--          is not done as this would require several data transfers between 2D-grid and the
-!--          surf-type. The impact of the missing interpolation is negligible as several tests have
-!--          shown. Same also for ol.
-             surf%vsws(m) = -surf%vsws(m) * surf%us(m) * rho_air_zw(k-1)
-          ENDDO
-!
-!--    Downward-facing surfaces
-       ELSE
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-
-             surf%vsws(m) = kappa * v(k,j,i) / surf%ln_z_z0(m)
-             surf%vsws(m) = surf%vsws(m) * surf%us(m) * rho_air_zw(k)
-          ENDDO
-       ENDIF
-!
-!--    Compute the vertical kinematic heat flux. Note, only upward-facing surfaces are considered,
-!--    at downward-facing surfaces the flux is not parametrized with a scaling parameter.
-       IF (  .NOT.  constant_heatflux  .AND.  ( ( time_since_reference_point <=  skip_time_do_lsm  &
-             .AND.  simulated_time > 0.0_wp )  .OR.  .NOT.  land_surface )  .AND.                  &
-             .NOT.  urban_surface  .AND.  .NOT. downward )  THEN
-          !$OMP PARALLEL DO PRIVATE( k )
-          DO  m = 1, surf%ns
-             k = surf%k(m)
-             surf%shf(m) = -surf%ts(m) * surf%us(m) * rho_air_zw(k-1)
-          ENDDO
-       ENDIF
-!
-!--    Compute the vertical water flux
-       IF (  .NOT.  constant_waterflux  .AND.  humidity  .AND.              &
-            ( ( time_since_reference_point <= skip_time_do_lsm  .AND.  simulated_time > 0.0_wp )   &
-            .OR.  .NOT.  land_surface  )  .AND.  .NOT.  urban_surface  .AND.  .NOT.  downward )    &
-            THEN
-          !$OMP PARALLEL DO PRIVATE( k )
-          DO  m = 1, surf%ns
-             k = surf%k(m)
-             surf%qsws(m) = -surf%qs(m) * surf%us(m) * rho_air_zw(k-1)
-          ENDDO
-       ENDIF
-!
-!--    Compute the vertical scalar flux
-       IF (  .NOT.  constant_scalarflux  .AND.  passive_scalar  .AND.  .NOT.  downward )  THEN
-          !$OMP PARALLEL DO PRIVATE( k )
-          DO  m = 1, surf%ns
-             k = surf%k(m)
-             surf%ssws(m) = -surf%ss(m) * surf%us(m) * rho_air_zw(k-1)
-          ENDDO
-       ENDIF
-!
-!--    Compute the vertical chemical species' flux
-       DO  lsp = 1, nvar
-          IF (  .NOT.  constant_csflux(lsp)  .AND.  air_chemistry  .AND.  .NOT.  downward )  THEN
-             !$OMP PARALLEL DO PRIVATE( k )
-             DO  m = 1, surf%ns
-                k = surf%k(m)
-                surf%cssws(lsp,m) = -surf%css(lsp,m) * surf%us(m) * rho_air_zw(k-1)
-             ENDDO
-          ENDIF
-       ENDDO
-
-!
-!--    Compute (turbulent) fluxes of cloud water content and cloud drop conc.
-       IF ( bulk_cloud_model  .AND.  microphysics_morrison  .AND.  .NOT. downward)  THEN
-          !$OMP PARALLEL DO PRIVATE( k )
-          DO  m = 1, surf%ns
-             k = surf%k(m)
-             surf%qcsws(m) = -surf%qcs(m) * surf%us(m) * rho_air_zw(k-1)
-             surf%ncsws(m) = -surf%ncs(m) * surf%us(m) * rho_air_zw(k-1)
-          ENDDO
-       ENDIF
-!
-!--    Compute (turbulent) fluxes of rain water content and rain drop conc.
-       IF ( bulk_cloud_model  .AND.  microphysics_seifert  .AND.  .NOT. downward)  THEN
-          !$OMP PARALLEL DO PRIVATE( k )
-          DO  m = 1, surf%ns
-             k = surf%k(m)
-             surf%qrsws(m) = -surf%qrs(m) * surf%us(m) * rho_air_zw(k-1)
-             surf%nrsws(m) = -surf%nrs(m) * surf%us(m) * rho_air_zw(k-1)
-          ENDDO
-       ENDIF
-
-!
-!--    Bottom boundary condition for the TKE.
-       IF ( ibc_e_b == 2 )  THEN
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-
-             e(k,j,i) = ( surf%us(m) / 0.1_wp )**2
-!
-!--          As a test: cm = 0.4
-!            e(k,j,i) = ( us(j,i) / 0.4_wp )**2
-             e(k-1,j,i) = e(k,j,i)
-
-          ENDDO
-       ENDIF
-!
-!-- Calcuate surface fluxes at vertical surfaces. No stability is considered.
-!-- Further, no density needs to be considered here.
-    ELSE
-!
-!--    Compute usvs l={0,1} and vsus l={2,3}
-       IF ( mom_uv )  THEN
-!
-!--       Generalize computation by introducing flags. At north- and south-facing surfaces
-!--       u-component is used, at east- and west-facing surfaces v-component is used.
-          flag_u = MERGE( 1.0_wp, 0.0_wp, l == 0  .OR.  l == 1 )
-          flag_v = MERGE( 1.0_wp, 0.0_wp, l == 2  .OR.  l == 3 )
-          !$OMP PARALLEL  DO PRIVATE( i, j, k )
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-
-             surf%mom_flux_uv(m) = kappa * ( flag_u * u(k,j,i) + flag_v * v(k,j,i) )  /            &
-                                   surf%ln_z_z0(m)
-
-            surf%mom_flux_uv(m) = - surf%mom_flux_uv(m) * surf%us(m)
-          ENDDO
-       ENDIF
-!
-!--    Compute wsus l={0,1} and wsvs l={2,3}
-       IF ( mom_w )  THEN
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-
-             surf%mom_flux_w(m) = kappa * w(k,j,i) / surf%ln_z_z0(m)
-
-             surf%mom_flux_w(m) = - surf%mom_flux_w(m) * surf%us(m)
-          ENDDO
-       ENDIF
-!
-!--    Compute momentum fluxes used for subgrid-scale TKE production at vertical surfaces. In
-!--    constrast to the calculated momentum fluxes at vertical surfaces before, which are defined on
-!--    the u/v/w-grid, respectively), the TKE fluxes are defined at the scalar grid.
-!--
-       IF ( mom_tke )  THEN
-!
-!--       Precalculate velocity components at scalar grid point.
-          ALLOCATE( u_i(1:surf%ns) )
-          ALLOCATE( v_i(1:surf%ns) )
-          ALLOCATE( w_i(1:surf%ns) )
-
-          IF ( l == 0  .OR.  l == 1 )  THEN
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, surf%ns
-                i = surf%i(m)
-                j = surf%j(m)
-                k = surf%k(m)
-
-                u_i(m) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
-                v_i(m) = 0.0_wp
-                w_i(m) = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
-             ENDDO
-          ELSE
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, surf%ns
-                i = surf%i(m)
-                j = surf%j(m)
-                k = surf%k(m)
-
-                u_i(m) = 0.0_wp
-                v_i(m) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
-                w_i(m) = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
-             ENDDO
-          ENDIF
-
-          !$OMP PARALLEL DO PRIVATE( i, j, dum )
-          DO  m = 1, surf%ns
-             i = surf%i(m)
-             j = surf%j(m)
-
-             dum = kappa / surf%ln_z_z0(m)
-!
-!--          usvs (l=0,1) and vsus (l=2,3)
-             surf%mom_flux_tke(0,m) = dum * ( u_i(m) + v_i(m) )
-!
-!--          wsvs (l=0,1) and wsus (l=2,3)
-             surf%mom_flux_tke(1,m) = dum * w_i(m)
-
-             surf%mom_flux_tke(0:1,m) = - surf%mom_flux_tke(0:1,m) * surf%us(m)
-          ENDDO
-!
-!--       Deallocate temporary arrays
-          DEALLOCATE( u_i )
-          DEALLOCATE( v_i )
-          DEALLOCATE( w_i )
-       ENDIF
-    ENDIF
-
- END SUBROUTINE calc_surface_fluxes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates temperature near surface (10 cm) for indoor model or 2 m temperature for output.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_pt_near_surface ( z_char )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN = *), INTENT(IN) ::  z_char  !< string identifier to identify z level
-
-    INTEGER(iwp) ::  m  !< running index for surface elements
-
-    SELECT CASE ( z_char)
-
-       CASE ( '10cm' )
-!
-!--       For horizontal upward-facing surfaces 10-cm temperature can be calculated using MOST.
-          IF ( .NOT.  downward  .AND.  .NOT. surf_vertical )  THEN
-             DO  m = 1, surf%ns
-                surf%pt_10cm(m) = surf%pt_surface(m) + surf%ts(m) / kappa                          &
-                               * ( LOG( 0.1_wp /  surf%z0h(m) ) - psi_h( 0.1_wp / surf%ol(m) )     &
-                                   + psi_h( surf%z0h(m) / surf%ol(m) ) )
-             ENDDO
-!
-!--       At vertical surfaces 10-cm temperature cannot be calculated via MOST as the Obukhov length
-!--       and temperature scaling parameter are not calculated. Hence, set 10-cm temperature to
-!--       the grid-cell temperature.
-          ELSE
-             DO  m = 1, surf%ns
-                surf%pt_10cm(m) = pt(surf%k(m)+surf%koff,surf%j(m)+surf%joff,surf%i(m)+surf%ioff)
-             ENDDO
-          ENDIF
-
-    END SELECT
-
- END SUBROUTINE calc_pt_near_surface
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Integrated stability function for momentum.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION psi_m( zeta )
-    !$ACC ROUTINE SEQ
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  psi_m  !< Integrated similarity function result
-    REAL(wp) ::  zeta   !< Stability parameter z/L
-    REAL(wp) ::  x      !< dummy variable
-
-    REAL(wp), PARAMETER ::  a = 1.0_wp            !< constant
-    REAL(wp), PARAMETER ::  b = 0.66666666666_wp  !< constant
-    REAL(wp), PARAMETER ::  c = 5.0_wp            !< constant
-    REAL(wp), PARAMETER ::  d = 0.35_wp           !< constant
-    REAL(wp), PARAMETER ::  c_d_d = c / d         !< constant
-    REAL(wp), PARAMETER ::  bc_d_d = b * c / d    !< constant
-
-
-    IF ( zeta < 0.0_wp )  THEN
-       x = SQRT( SQRT( 1.0_wp  - 16.0_wp * zeta ) )
-       psi_m = pi * 0.5_wp - 2.0_wp * ATAN( x ) + LOG( ( 1.0_wp + x )**2                           &
-               * ( 1.0_wp + x**2 ) * 0.125_wp )
-    ELSE
-
-       psi_m = - b * ( zeta - c_d_d ) * EXP( -d * zeta ) - a * zeta - bc_d_d
-!
-!--    Old version for stable conditions (only valid for z/L < 0.5) psi_m = - 5.0_wp * zeta
-
-    ENDIF
-
- END FUNCTION psi_m
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-!------------
-!> Integrated stability function for heat and moisture.
-!--------------------------------------------------------------------------------------------------!
- FUNCTION psi_h( zeta )
-    !$ACC ROUTINE SEQ
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  psi_h  !< Integrated similarity function result
-    REAL(wp) ::  zeta   !< Stability parameter z/L
-    REAL(wp) ::  x      !< dummy variable
-
-    REAL(wp), PARAMETER ::  a = 1.0_wp            !< constant
-    REAL(wp), PARAMETER ::  b = 0.66666666666_wp  !< constant
-    REAL(wp), PARAMETER ::  c = 5.0_wp            !< constant
-    REAL(wp), PARAMETER ::  d = 0.35_wp           !< constant
-    REAL(wp), PARAMETER ::  c_d_d = c / d         !< constant
-    REAL(wp), PARAMETER ::  bc_d_d = b * c / d    !< constant
-
-
-    IF ( zeta < 0.0_wp )  THEN
-       x = SQRT( 1.0_wp  - 16.0_wp * zeta )
-       psi_h = 2.0_wp * LOG( (1.0_wp + x ) / 2.0_wp )
-    ELSE
-       psi_h = - b * ( zeta - c_d_d ) * EXP( -d * zeta ) - (1.0_wp                                 &
-               + 0.66666666666_wp * a * zeta )**1.5_wp - bc_d_d + 1.0_wp
-!
-!--    Old version for stable conditions (only valid for z/L < 0.5)
-!--    psi_h = - 5.0_wp * zeta
-    ENDIF
-
- END FUNCTION psi_h
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates stability function for momentum
-!>
-!> @author Hauke Wurps
-!--------------------------------------------------------------------------------------------------!
- FUNCTION phi_m( zeta )
-    !$ACC ROUTINE SEQ
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  phi_m  !< Value of the function
-    REAL(wp) ::  zeta   !< Stability parameter z/L
-
-    REAL(wp), PARAMETER ::  a = 16.0_wp  !< constant
-    REAL(wp), PARAMETER ::  c = 5.0_wp   !< constant
-
-    IF ( zeta < 0.0_wp )  THEN
-       phi_m = 1.0_wp / SQRT( SQRT( 1.0_wp - a * zeta ) )
-    ELSE
-       phi_m = 1.0_wp + c * zeta
-    ENDIF
-
- END FUNCTION phi_m
-
- END MODULE surface_layer_fluxes_mod
Index: palm/trunk/SOURCE/surface_mod.f90
===================================================================
--- palm/trunk/SOURCE/surface_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,6069 +1,0 @@
-!> @file surface_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! variable renamed
-!
-! 4893 2021-03-02 16:39:14Z raasch
-! revised output of surface data via MPI-IO for better performance
-!
-! 4882 2021-02-19 22:49:44Z forkel
-! removed lsp in subroutine nitialize_top
-!
-! 4881 2021-02-19 22:05:08Z forkel
-! removed constant_top_csflux option
-!
-! 4877 2021-02-17 16:17:35Z suehring
-! bugfix in init_single_surface_properties for vertical surfaces
-!
-! 4850 2021-01-21 17:59:25Z suehring
-! +t_prev
-!
-! 4829 2021-01-06 10:11:39Z suehring
-! Bugfix in creating error-message string
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Calculate and store total number of surfaces within the model domain.
-!
-! 4694 2020-09-23 15:09:19Z pavelkrc
-! Fix reading of surface data from MPI restart file
-!
-! 4682 2020-09-17 14:13:27Z pavelkrc
-! Fix indexing of horizontal surfaces in write restart for full-3D cases
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4598 2020-07-10 10:13:23Z suehring
-! Revise surface-element mapping in mpi-io restart branch
-!
-! 4595 2020-07-09 17:18:21Z suehring
-! Fix accidently commented subroutine
-!
-! 4594 2020-07-09 15:01:00Z suehring
-! Bugfix, add acc directives for scalar-roughness length
-!
-! 4593 2020-07-09 12:48:18Z suehring
-! Add arrays for pre-calculated ln(z/z0)
-!
-! 4586 2020-07-01 16:16:43Z gronemeier
-! renamed Richardson flux number into gradient Richardson number (1D model)
-!
-! 4559 2020-06-11 08:51:48Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! Bugfix for restart data format query
-!
-! 4521 2020-05-06 11:39:49Z schwenkel
-! Rename variable
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! Added restart with MPI-IO for reading local arrays
-!
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! Restart data handling with MPI-IO added
-!
-! 4366 2020-01-09 08:12:43Z raasch
-! Workaround implemented to avoid vectorization bug on NEC Aurora
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Fix also remaining message calls.
-!
-! 4354 2019-12-19 16:10:18Z suehring
-! Bugfix in message call and specify error number
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4331 2019-12-10 18:25:02Z suehring
-! -pt_2m - array is moved to diagnostic_output_quantities
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4245 2019-09-30 08:40:37Z pavelkrc
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Remove functions get_topography_top_index. These are now replaced by precalculated arrays because
-! of too much CPU-time consumption
-!
-! 4159 2019-08-15 13:31:35Z suehring
-! Surface classification revised and adjusted to changes in init_grid
-!
-! 4156 2019-08-14 09:18:14Z schwenkel
-! Bugfix in case of cloud microphysics morrison
-!
-! 4150 2019-08-08 20:00:47Z suehring
-! Generic routine to initialize single surface properties added
-!
-! 4104 2019-07-17 17:08:20Z suehring
-! Bugfix, initialization of index space for boundary data structure accidantly run over ghost
-! points, causing a segmentation fault.
-!
-! 3943 2019-05-02 09:50:41Z maronga
-! - Revise initialization of the boundary data structure
-! - Add new data structure to set boundary conditions at vertical walls
-!
-! 3943 2019-05-02 09:50:41Z maronga
-! Removed qsws_eb as it is no longer needed.
-!
-! 3933 2019-04-25 12:33:20Z kanani
-! Add (de)allocation of pt_2m,
-! Bugfix: initialize pt_2m
-!
-! 3833 2019-03-28 15:04:04Z forkel
-! Added USE chem_gasphase_mod (chem_modules will not transport nvar and nspec anymore)
-!
-! 3772 2019-02-28 15:51:57Z suehring
-! Small change in the todo's
-!
-! 3767 2019-02-27 08:18:02Z raasch
-! Unused variables removed from rrd-subroutine parameter list
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! OpenACC directives added to avoid compiler warnings about unused variables, unused variable
-! removed
-!
-! 3745 2019-02-15 18:57:56Z suehring
-! +waste_heat
-!
-! 3744 2019-02-15 18:38:58Z suehring
-! OpenACC port for SPEC
-!
-! 2233 2017-05-30 18:08:54Z suehring
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Surface module defines derived data structures to treat surface-bounded grid cells. Three
-!> different types of surfaces are defined: default surfaces, natural surfaces, and urban surfaces.
-!> The module encompasses the allocation and initialization of surface arrays, and handles reading
-!> and writing restart data. In addition, a further derived data structure is defined, in order to
-!> set boundary conditions at surfaces.
-!> @todo For the moment, downward-facing surfaces are only classified as default type
-!> @todo Clean up urban-surface variables (some of them are not used any more)
-!> @todo Revise initialization of surface fluxes (especially for chemistry)
-!> @todo Get rid-off deallocation routines in restarts
-!--------------------------------------------------------------------------------------------------!
- MODULE surface_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  heatflux_input_conversion,                                                          &
-               momentumflux_input_conversion,                                                      &
-               rho_air,                                                                            &
-               rho_air_zw,                                                                         &
-               zu,                                                                                 &
-               zw,                                                                                 &
-               waterflux_input_conversion
-
-    USE chem_gasphase_mod,                                                                         &
-        ONLY:  nvar,                                                                               &
-               spc_names
-
-    USE chem_modules
-
-    USE control_parameters
-
-    USE indices,                                                                                   &
-        ONLY:  nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               wall_flags_total_0
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx,                                                                                 &
-               dy
-
-    USE kinds
-
-    USE model_1d_mod,                                                                              &
-        ONLY:  ri1d,                                                                               &
-               us1d,                                                                               &
-               usws1d,                                                                             &
-               vsws1d
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_surface_filetypes,                                                        &
-               rrd_mpi_io,                                                                         &
-               rrd_mpi_io_global_array,                                                            &
-               rrd_mpi_io_surface,                                                                 &
-               total_number_of_surface_elements,                                                   &
-               wrd_mpi_io,                                                                         &
-               wrd_mpi_io_global_array,                                                            &
-               wrd_mpi_io_surface
-
-    IMPLICIT NONE
-
-!
-!-- Data type used to identify grid-points where horizontal boundary conditions are applied
-    TYPE bc_type
-       INTEGER(iwp) ::  ioff  !< offset value in x-direction, used to determine index of surface element
-       INTEGER(iwp) ::  joff  !< offset value in y-direction, used to determine index of surface element
-       INTEGER(iwp) ::  koff  !< offset value in z-direction, used to determine index of surface element
-       INTEGER(iwp) ::  ns    !< number of surface elements on the PE
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  i  !< x-index linking to the PALM 3D-grid
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j  !< y-index linking to the PALM 3D-grid
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k  !< z-index linking to the PALM 3D-grid
-
-       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  end_index    !< end index within surface data type for given (j,i)
-       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  start_index  !< start index within surface data type for given (j,i)
-
-    END TYPE bc_type
-!
-!-- Data type used to identify and treat surface-bounded grid points
-    TYPE surf_type
-
-       INTEGER(iwp) ::  ioff        !< offset value in x-direction, used to determine index of surface element
-       INTEGER(iwp) ::  joff        !< offset value in y-direction, used to determine index of surface element
-       INTEGER(iwp) ::  koff        !< offset value in z-direction, used to determine index of surface element
-       INTEGER(iwp) ::  ns          !< number of surface elements on the PE
-       INTEGER(iwp) ::  ns_tot = 0  !< number of surface elements within the entire model domain
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  i  !< x-index linking to the PALM 3D-grid
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j  !< y-index linking to the PALM 3D-grid
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k  !< z-index linking to the PALM 3D-grid
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  facing  !< Bit indicating surface orientation
-
-       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  start_index  !< Start index within surface data type for given (j,i)
-       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  end_index    !< End index within surface data type for given (j,i)
-
-       LOGICAL ::  albedo_from_ascii = .FALSE. !< flag indicating that albedo for urban surfaces is input via ASCII format
-                                               !< (just for a workaround)
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z_mo     !< surface-layer height
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  uvw_abs  !< absolute surface-parallel velocity
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  us       !< friction velocity
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ts       !< scaling parameter temerature
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qs       !< scaling parameter humidity
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ss       !< scaling parameter passive scalar
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qcs      !< scaling parameter qc
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ncs      !< scaling parameter nc
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qis      !< scaling parameter qi
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  nis      !< scaling parameter ni
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qrs      !< scaling parameter qr
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  nrs      !< scaling parameter nr
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ol       !< Obukhov length
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rib      !< Richardson bulk number
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z0       !< roughness length for momentum
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z0h      !< roughness length for heat
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z0q      !< roughness length for humidity
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt1      !< potential temperature at first grid level
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qv1      !< mixing ratio at first grid level
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  vpt1     !< virtual potential temperature at first grid level
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  css    !< scaling parameter chemical species
-!
-!--    Pre-defined arrays for ln(z/z0)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ln_z_z0  !< ln(z/z0)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ln_z_z0h !< ln(z/z0h)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ln_z_z0q !< ln(z/z0q)
-!
-!--    Define arrays for surface fluxes
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  usws     !< vertical momentum flux for u-component at horizontal surfaces
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  vsws     !< vertical momentum flux for v-component at horizontal surfaces
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  shf      !< surface flux sensible heat
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws     !< surface flux latent heat
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ssws     !< surface flux passive scalar
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qcsws    !< surface flux qc
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ncsws    !< surface flux nc
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qisws    !< surface flux qi
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  nisws    !< surface flux ni
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qrsws    !< surface flux qr
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  nrsws    !< surface flux nr
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  sasws    !< surface flux salinity
-!--    Added for SALSA:
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  answs  !< surface flux aerosol number: dim 1: flux, dim 2: bin
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  amsws  !< surface flux aerosol mass:   dim 1: flux, dim 2: bin
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  gtsws  !< surface flux gesous tracers: dim 1: flux, dim 2: gas
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  cssws  !< surface flux chemical species
-!
-!--    Required for horizontal walls in production_e
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  u_0  !< virtual velocity component (see production_e_init for further explanation)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  v_0  !< virtual velocity component (see production_e_init for further explanation)
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  mom_flux_uv   !< momentum flux usvs and vsus at vertical surfaces
-                                                               !< (used in diffusion_u and diffusion_v)
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  mom_flux_w    !< momentum flux wsus and wsvs at vertical surfaces
-                                                               !< (used in diffusion_w)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  mom_flux_tke  !< momentum flux usvs, vsus, wsus, wsvs at vertical surfaces at grid
-                                                               !< center (used in production_e)
-!
-!--    Variables required for LSM as well as for USM
-       CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE ::  building_type_name    !< building type name at surface element
-       CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE ::  pavement_type_name    !< pavement type name at surface element
-       CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE ::  vegetation_type_name  !< water type at name surface element
-       CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE ::  water_type_name       !< water type at name surface element
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nzt_pavement     !< top index for pavement in soil
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  building_type    !< building type at surface element
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  pavement_type    !< pavement type at surface element
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  vegetation_type  !< vegetation type at surface element
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  water_type       !< water type at surface element
-
-       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  albedo_type  !< albedo type, for each fraction
-                                                                  !< (wall,green,window or vegetation,pavement water)
-
-       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  building_surface  !< flag parameter indicating that the surface element is covered
-                                                                 !< by buildings (no LSM actions, not implemented yet)
-       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  building_covered  !< flag indicating that buildings are on top of orography,
-                                                                 !< only used for vertical surfaces in LSM
-       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  pavement_surface    !< flag parameter for pavements
-       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  water_surface       !< flag parameter for water surfaces
-       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  vegetation_surface  !< flag parameter for natural land surfaces
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  albedo  !< broadband albedo for each surface fraction
-                                                         !< (LSM: vegetation, water, pavement; USM: wall, green, window)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  emissivity  !< emissivity of the surface, for each fraction
-                                                             !< (LSM: vegetation, water, pavement; USM: wall, green, window)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  frac  !< relative surface fraction
-                                                       !< (LSM: vegetation, water, pavement; USM: wall, green, window)
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  aldif       !< albedo for longwave diffusive radiation, solar angle of 60 degrees
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  aldir       !< albedo for longwave direct radiation, solar angle of 60 degrees
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  asdif       !< albedo for shortwave diffusive radiation, solar angle of 60 deg.
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  asdir       !< albedo for shortwave direct radiation, solar angle of 60 degrees
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  rrtm_aldif  !< albedo for longwave diffusive radiation, solar angle of 60 degrees
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  rrtm_aldir  !< albedo for longwave direct radiation, solar angle of 60 degrees
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  rrtm_asdif  !< albedo for shortwave diffusive radiation, solar angle of 60 deg.
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  rrtm_asdir  !< albedo for shortwave direct radiation, solar angle of 60 degrees
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  q_surface        !< skin-surface mixing ratio
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  pt_surface       !< skin-surface temperature
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  vpt_surface      !< skin-surface virtual temperature
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  rad_net          !< net radiation
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  rad_net_l        !< net radiation, used in USM
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_h         !< heat conductivity of soil/ wall (W/m/K)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_h_green   !< heat conductivity of green soil (W/m/K)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_h_window  !< heat conductivity of windows (W/m/K)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_h_def     !< default heat conductivity of soil (W/m/K)
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_lw_in   !< incoming longwave radiation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_lw_out  !< emitted longwave radiation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_lw_dif  !< incoming longwave radiation from sky
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_lw_ref  !< incoming longwave radiation from reflection
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_lw_res  !< resedual longwave radiation in surface after last reflection step
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_sw_in   !< incoming shortwave radiation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_sw_out  !< emitted shortwave radiation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_sw_dir  !< direct incoming shortwave radiation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_sw_dif  !< diffuse incoming shortwave radiation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_sw_ref  !< incoming shortwave radiation from reflection
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_sw_res  !< resedual shortwave radiation in surface after last reflection step
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  c_liq             !< liquid water coverage (of vegetated area)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  c_veg             !< vegetation coverage
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  f_sw_in           !< fraction of absorbed shortwave radiation by the surface layer
-                                                                 !< (not implemented yet)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ghf               !< ground heat flux
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  g_d               !< coefficient for dependence of r_canopy
-                                                                 !< on water vapour pressure deficit
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  lai               !< leaf area index
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  lambda_surface_u  !< coupling between surface and soil (depends on vegetation type)
-                                                                 !< (W/m2/K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  lambda_surface_s  !< coupling between surface and soil (depends on vegetation type)
-                                                                 !< (W/m2/K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws_liq          !< surface flux of latent heat (liquid water portion)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws_soil         !< surface flux of latent heat (soil portion)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws_veg          !< surface flux of latent heat (vegetation portion)
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_a           !< aerodynamic resistance
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_a_green     !< aerodynamic resistance at green fraction
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_a_window    !< aerodynamic resistance at window fraction
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_canopy      !< canopy resistance
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_soil        !< soil resistance
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_soil_min    !< minimum soil resistance
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_s           !< total surface resistance (combination of r_soil and r_canopy)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_canopy_min  !< minimum canopy (stomatal) resistance
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt_10cm  !< near surface air potential temperature at distance 10 cm from
-                                                        !< the surface (K)
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  alpha_vg         !< coef. of Van Genuchten
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_w         !< hydraulic diffusivity of soil (?)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  gamma_w          !< hydraulic conductivity of soil (W/m/K)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  gamma_w_sat      !< hydraulic conductivity at saturation
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  l_vg             !< coef. of Van Genuchten
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  m_fc             !< soil moisture at field capacity (m3/m3)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  m_res            !< residual soil moisture
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  m_sat            !< saturation soil moisture (m3/m3)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  m_wilt           !< soil moisture at permanent wilting point (m3/m3)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  n_vg             !< coef. Van Genuchten
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_c_total_def  !< default volumetric heat capacity of the (soil) layer (J/m3/K)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_c_total      !< volumetric heat capacity of the actual soil matrix (J/m3/K)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  root_fr          !< root fraction within the soil layers
-
-!--    Indoor model variables
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_prev      !< indoor temperature for facade element
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  waste_heat  !< waste heat
-!
-!--    Urban surface variables
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  surface_types  !< array of types of wall parameters
-
-       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  isroof_surf   !< flag indicating roof surfaces
-       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  ground_level  !< flag indicating ground floor level surfaces
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  target_temp_summer  !< indoor target temperature summer
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  target_temp_winter  !< indoor target temperature summer
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  c_surface           !< heat capacity of the wall surface skin (J/m2/K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  c_surface_green     !< heat capacity of the green surface skin (J/m2/K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  c_surface_window    !< heat capacity of the window surface skin (J/m2/K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  green_type_roof     !< type of the green roof
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  lambda_surf         !< heat conductivity between air and surface (W/m2/K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  lambda_surf_green   !< heat conductivity between air and green surface (W/m2/K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  lambda_surf_window  !< heat conductivity between air and window surface (W/m2/K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  thickness_wall      !< thickness of the wall, roof and soil layers
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  thickness_green     !< thickness of the green wall, roof and soil layers
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  thickness_window    !< thickness of the window wall, roof and soil layers
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  transmissivity      !< transmissivity of windows
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutsl  !< reflected shortwave radiation for local surface in i-th reflection
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutll  !< reflected + emitted longwave radiation for local surface
-                                                          !< in i-th reflection
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfhf     !< total radiation flux incoming to minus outgoing from local surface
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  tt_surface_wall_m    !< surface temperature tendency (K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  tt_surface_window_m  !< window surface temperature tendency (K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  tt_surface_green_m   !< green surface temperature tendency (K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wshf                 !< kinematic wall heat flux of sensible heat
-                                                                    !< (actually no longer needed)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wshf_eb              !< wall heat flux of sensible heat in wall normal direction
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wghf_eb          !< wall ground heat flux
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wghf_eb_window   !< window ground heat flux
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wghf_eb_green    !< green ground heat flux
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  iwghf_eb         !< indoor wall ground heat flux
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  iwghf_eb_window  !< indoor window ground heat flux
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_lw_out_change_0  !<
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinsw   !< shortwave radiation falling to local surface including radiation
-                                                          !< from reflections
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutsw  !< total shortwave radiation outgoing from nonvirtual surfaces surfaces
-                                                          !< after all reflection
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlw   !< longwave radiation falling to local surface including radiation from
-                                                          !< reflections
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutlw  !< total longwave radiation outgoing from nonvirtual surfaces surfaces
-                                                          !< after all reflection
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  n_vg_green      !< vangenuchten parameters
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  alpha_vg_green  !< vangenuchten parameters
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  l_vg_green      !< vangenuchten parameters
-
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_c_wall         !< volumetric heat capacity of the material ( J m-3 K-1 )
-                                                                    !< (= 2.19E6)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dz_wall            !< wall grid spacing (center-center)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddz_wall           !< 1/dz_wall
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dz_wall_stag       !< wall grid spacing (edge-edge)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddz_wall_stag      !< 1/dz_wall_stag
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tt_wall_m          !< t_wall prognostic array
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  zw                 !< wall layer depths (m)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_c_window       !< volumetric heat capacity of the window material ( J m-3 K-1 )
-                                                                    !< (= 2.19E6)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dz_window          !< window grid spacing (center-center)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddz_window         !< 1/dz_window
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dz_window_stag     !< window grid spacing (edge-edge)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddz_window_stag    !< 1/dz_window_stag
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tt_window_m        !< t_window prognostic array
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  zw_window          !< window layer depths (m)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_c_green        !< volumetric heat capacity of the green material ( J m-3 K-1 )
-                                                                    !< (= 2.19E6)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_c_total_green  !< volumetric heat capacity of the moist green material
-                                                                    !< ( J m-3 K-1 ) (= 2.19E6)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dz_green           !< green grid spacing (center-center)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddz_green          !< 1/dz_green
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dz_green_stag      !< green grid spacing (edge-edge)
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddz_green_stag     !< 1/dz_green_stag
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tt_green_m         !< t_green prognostic array
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  zw_green           !< green layer depths (m)
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  gamma_w_green_sat  !< hydraulic conductivity
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_w_green     !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  gamma_w_green      !< hydraulic conductivity
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tswc_h_m           !<
-
-!
-!--    Arrays for time averages
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_net_av          !< average of rad_net_l
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinsw_av         !< average of sw radiation falling to local surface including
-                                                                   !< radiation from reflections
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlw_av         !< average of lw radiation falling to local surface including
-                                                                   !< radiation from reflections
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswdir_av      !< average of direct sw radiation falling to local surface
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswdif_av      !< average of diffuse sw radiation from sky and model boundary
-                                                                   !< falling to local surface
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlwdif_av      !< average of diffuse lw radiation from sky and model boundary
-                                                                   !< falling to local surface
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswref_av      !< average of sw radiation falling to surface from reflections
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlwref_av      !< average of lw radiation falling to surface from reflections
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutsw_av        !< average of total sw radiation outgoing from nonvirtual
-                                                                   !< surfaces surfaces after all reflection
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutlw_av        !< average of total lw radiation outgoing from nonvirtual
-                                                                   !< surfaces after all reflection
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfins_av          !< average of array of residua of sw radiation absorbed in
-                                                                   !< surface after last reflection
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinl_av          !< average of array of residua of lw radiation absorbed in
-                                                                   !< surface after last reflection
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfhf_av           !< average of total radiation flux incoming to minus outgoing
-                                                                   !< from local surface
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wghf_eb_av          !< average of wghf_eb
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wghf_eb_window_av   !< average of wghf_eb window
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wghf_eb_green_av    !< average of wghf_eb window
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  iwghf_eb_av         !< indoor average of wghf_eb
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  iwghf_eb_window_av  !< indoor average of wghf_eb window
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wshf_eb_av          !< average of wshf_eb
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws_av             !< average of qsws
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws_veg_av         !< average of qsws_veg_eb
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws_liq_av         !< average of qsws_liq_eb
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_surf_wall_av      !< average of wall surface temperature (K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_surf_av           !< average of wall surface temperature (K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_surf_window_av    !< average of window surface temperature (K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_surf_green_av     !< average of green wall surface temperature (K)
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt_10cm_av  !< average of theta_10cm (K)
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  t_wall_av    !< Average of t_wall
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  t_window_av  !< Average of t_window
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  t_green_av   !< Average of t_green
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  swc_av       !< Average of swc
-
-    END TYPE surf_type
-
-    TYPE (bc_type), DIMENSION(0:1)  ::  bc_h  !< boundary condition data type, horizontal upward- and downward facing surfaces
-    TYPE (bc_type), DIMENSION(0:3)  ::  bc_v  !< boundary condition data type, vertical surfaces
-
-    TYPE (surf_type), DIMENSION(0:2), TARGET ::  surf_def_h  !< horizontal default surfaces (Up, Down, and Top)
-    TYPE (surf_type), DIMENSION(0:3), TARGET ::  surf_def_v  !< vertical default surfaces (North, South, East, West)
-    TYPE (surf_type), DIMENSION(0:1), TARGET ::  surf_lsm_h  !< horizontal natural land surfaces (Up, Down)
-    TYPE (surf_type), DIMENSION(0:3), TARGET ::  surf_lsm_v  !< vertical land surfaces (North, South, East, West)
-    TYPE (surf_type), DIMENSION(0:1), TARGET ::  surf_usm_h  !< horizontal urban surfaces (Up, Down)
-    TYPE (surf_type), DIMENSION(0:3), TARGET ::  surf_usm_v  !< vertical urban surfaces (North, South, East, West)
-
-    INTEGER(iwp), PARAMETER ::  ind_veg_wall  = 0  !< index for vegetation / wall-surface fraction, used for access of albedo,
-                                                   !< emissivity, etc., for each surface type
-    INTEGER(iwp), PARAMETER ::  ind_pav_green = 1  !< index for pavement / green-wall surface fraction, used for access of albedo,
-                                                   !< emissivity, etc., for each surface type
-    INTEGER(iwp), PARAMETER ::  ind_wat_win   = 2  !< index for water / window-surface fraction, used for access of albedo,
-                                                   !< emissivity, etc., for each surface type
-
-    INTEGER(iwp) ::  ns_h_on_file(0:2)  !< total number of horizontal surfaces with the same facing, required for writing
-                                        !< restart data
-    INTEGER(iwp) ::  ns_v_on_file(0:3)  !< total number of vertical surfaces with the same facing, required for writing restart data
-
-    LOGICAL ::  vertical_surfaces_exist     = .FALSE.  !< flag indicating that there are vertical urban/land surfaces
-                                                       !< in the domain (required to activiate RTM)
-
-    LOGICAL ::  surf_bulk_cloud_model       = .FALSE.  !< use cloud microphysics
-    LOGICAL ::  surf_microphysics_morrison  = .FALSE.  !< use 2-moment Morrison (add. prog. eq. for nc and qc)
-    LOGICAL ::  surf_microphysics_seifert   = .FALSE.  !< use 2-moment Seifert and Beheng scheme
-    LOGICAL ::  surf_microphysics_ice_phase = .FALSE.  !< use 2-moment Seifert and Beheng scheme
-
-
-    SAVE
-
-    PRIVATE
-
-    INTERFACE init_bc
-       MODULE PROCEDURE init_bc
-    END INTERFACE init_bc
-
-    INTERFACE init_single_surface_properties
-       MODULE PROCEDURE init_single_surface_properties
-    END INTERFACE init_single_surface_properties
-
-    INTERFACE init_surfaces
-       MODULE PROCEDURE init_surfaces
-    END INTERFACE init_surfaces
-
-    INTERFACE init_surface_arrays
-       MODULE PROCEDURE init_surface_arrays
-    END INTERFACE init_surface_arrays
-
-    INTERFACE surface_rrd_local
-       MODULE PROCEDURE surface_rrd_local_ftn
-       MODULE PROCEDURE surface_rrd_local_mpi
-    END INTERFACE surface_rrd_local
-
-    INTERFACE surface_wrd_local
-       MODULE PROCEDURE surface_wrd_local
-    END INTERFACE surface_wrd_local
-
-    INTERFACE surface_last_actions
-       MODULE PROCEDURE surface_last_actions
-    END INTERFACE surface_last_actions
-
-    INTERFACE surface_restore_elements
-       MODULE PROCEDURE surface_restore_elements_1d
-       MODULE PROCEDURE surface_restore_elements_2d
-    END INTERFACE surface_restore_elements
-
-#if defined( _OPENACC )
-    INTERFACE enter_surface_arrays
-       MODULE PROCEDURE enter_surface_arrays
-    END INTERFACE
-
-    INTERFACE exit_surface_arrays
-       MODULE PROCEDURE exit_surface_arrays
-    END INTERFACE
-#endif
-
-!
-!-- Public variables
-    PUBLIC bc_h,                                                                                   &
-           bc_v,                                                                                   &
-           ind_pav_green,                                                                          &
-           ind_veg_wall,                                                                           &
-           ind_wat_win,                                                                            &
-           ns_h_on_file,                                                                           &
-           ns_v_on_file,                                                                           &
-           surf_def_h,                                                                             &
-           surf_def_v,                                                                             &
-           surf_lsm_h,                                                                             &
-           surf_lsm_v,                                                                             &
-           surf_usm_h,                                                                             &
-           surf_usm_v,                                                                             &
-           surf_type,                                                                              &
-           vertical_surfaces_exist,                                                                &
-           surf_bulk_cloud_model,                                                                  &
-           surf_microphysics_morrison,                                                             &
-           surf_microphysics_seifert,                                                              &
-           surf_microphysics_ice_phase
-!
-!-- Public subroutines and functions
-    PUBLIC init_bc,                                                                                &
-           init_single_surface_properties,                                                         &
-           init_surfaces,                                                                          &
-           init_surface_arrays,                                                                    &
-           surface_last_actions,                                                                   &
-           surface_rrd_local,                                                                      &
-           surface_restore_elements,                                                               &
-           surface_wrd_local
-
-#if defined( _OPENACC )
-    PUBLIC enter_surface_arrays,                                                                   &
-           exit_surface_arrays
-#endif
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize data type for setting boundary conditions at horizontal and vertical surfaces.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_bc
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< loop index along x-direction
-    INTEGER(iwp) ::  j  !< loop index along y-direction
-    INTEGER(iwp) ::  k  !< loop index along y-direction
-    INTEGER(iwp) ::  l  !< running index for differently aligned surfaces
-
-    INTEGER(iwp), DIMENSION(0:1) ::  num_h          !< number of horizontal surfaces on subdomain
-    INTEGER(iwp), DIMENSION(0:1) ::  num_h_kji      !< number of horizontal surfaces at (j,i)-grid point
-    INTEGER(iwp), DIMENSION(0:1) ::  start_index_h  !< local start index of horizontal surface elements
-
-    INTEGER(iwp), DIMENSION(0:3) ::  num_v          !< number of vertical surfaces on subdomain
-    INTEGER(iwp), DIMENSION(0:3) ::  num_v_kji      !< number of vertical surfaces at (j,i)-grid point
-    INTEGER(iwp), DIMENSION(0:3) ::  start_index_v  !< local start index of vertical surface elements
-!
-!-- Set offset indices, i.e. index difference between surface element and surface-bounded grid point.
-!-- Horizontal surfaces - no horizontal offsets
-    bc_h(:)%ioff = 0
-    bc_h(:)%joff = 0
-!
-!-- Horizontal surfaces, upward facing (0) and downward facing (1)
-    bc_h(0)%koff = -1
-    bc_h(1)%koff = 1
-!
-!-- Vertical surfaces - no vertical offset
-    bc_v(0:3)%koff = 0
-!
-!-- North- and southward facing - no offset in x
-    bc_v(0:1)%ioff = 0
-!
-!-- Northward facing offset in y
-    bc_v(0)%joff = -1
-!
-!-- Southward facing offset in y
-    bc_v(1)%joff = 1
-!
-!-- East- and westward facing - no offset in y
-    bc_v(2:3)%joff = 0
-!
-!-- Eastward facing offset in x
-    bc_v(2)%ioff = -1
-!
-!-- Westward facing offset in y
-    bc_v(3)%ioff = 1
-!
-!-- Initialize data structure for horizontal surfaces, i.e. count the number of surface elements,
-!-- allocate and initialize the respective index arrays, and set the respective start and end
-!-- indices at each (j,i)-location. The index space is defined also over the ghost points, so that
-!-- e.g. boundary conditions for diagnostic quanitities can be set on ghost points so that no
-!-- exchange is required any more.
-    DO  l = 0, 1
-!
-!--    Count the number of upward- and downward-facing surfaces on subdomain
-       num_h(l) = 0
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-             DO  k = nzb+1, nzt
-!
-!--             Check if current gridpoint belongs to the atmosphere
-                IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )  THEN
-                   IF ( .NOT. BTEST( wall_flags_total_0(k+bc_h(l)%koff, j+bc_h(l)%joff,            &
-                                     i+bc_h(l)%ioff), 0 ) )  num_h(l) = num_h(l) + 1
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    Save the number of horizontal surface elements
-       bc_h(l)%ns = num_h(l)
-!
-!--    ALLOCATE arrays for horizontal surfaces
-       ALLOCATE( bc_h(l)%i(1:bc_h(l)%ns) )
-       ALLOCATE( bc_h(l)%j(1:bc_h(l)%ns) )
-       ALLOCATE( bc_h(l)%k(1:bc_h(l)%ns) )
-       ALLOCATE( bc_h(l)%start_index(nysg:nyng,nxlg:nxrg) )
-       ALLOCATE( bc_h(l)%end_index(nysg:nyng,nxlg:nxrg) )
-       bc_h(l)%start_index = 1
-       bc_h(l)%end_index   = 0
-
-       num_h(l)         = 1
-       start_index_h(l) = 1
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-
-             num_h_kji(l) = 0
-             DO  k = nzb+1, nzt
-!
-!--             Check if current gridpoint belongs to the atmosphere
-                IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )  THEN
-!
-!--                Upward-facing
-                   IF ( .NOT. BTEST( wall_flags_total_0(k+bc_h(l)%koff, j+bc_h(l)%joff,            &
-                                     i+bc_h(l)%ioff), 0 ) )  THEN
-                      bc_h(l)%i(num_h(l)) = i
-                      bc_h(l)%j(num_h(l)) = j
-                      bc_h(l)%k(num_h(l)) = k
-                      num_h_kji(l)        = num_h_kji(l) + 1
-                      num_h(l)            = num_h(l) + 1
-                   ENDIF
-                ENDIF
-             ENDDO
-             bc_h(l)%start_index(j,i) = start_index_h(l)
-             bc_h(l)%end_index(j,i)   = bc_h(l)%start_index(j,i) + num_h_kji(l) - 1
-             start_index_h(l)         = bc_h(l)%end_index(j,i) + 1
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Initialize data structure for vertical surfaces, i.e. count the number of surface elements,
-!-- allocate and initialize the respective index arrays, and set the respective start and end
-!-- indices at each (j,i)-location.
-    DO  l = 0, 3
-!
-!--    Count the number of upward- and downward-facing surfaces on subdomain
-       num_v(l) = 0
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-!
-!--             Check if current gridpoint belongs to the atmosphere
-                IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )  THEN
-                   IF ( .NOT. BTEST( wall_flags_total_0(k+bc_v(l)%koff, j+bc_v(l)%joff,            &
-                                     i+bc_v(l)%ioff), 0 ) )  num_v(l) = num_v(l) + 1
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    Save the number of horizontal surface elements
-       bc_v(l)%ns = num_v(l)
-!
-!--    ALLOCATE arrays for horizontal surfaces. In contrast to the horizontal surfaces, the index
-!--    space is not defined over the ghost points.
-       ALLOCATE( bc_v(l)%i(1:bc_v(l)%ns) )
-       ALLOCATE( bc_v(l)%j(1:bc_v(l)%ns) )
-       ALLOCATE( bc_v(l)%k(1:bc_v(l)%ns) )
-       ALLOCATE( bc_v(l)%start_index(nys:nyn,nxl:nxr) )
-       ALLOCATE( bc_v(l)%end_index(nys:nyn,nxl:nxr) )
-       bc_v(l)%start_index = 1
-       bc_v(l)%end_index   = 0
-
-       num_v(l)         = 1
-       start_index_v(l) = 1
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-
-             num_v_kji(l) = 0
-             DO  k = nzb+1, nzt
-!
-!--             Check if current gridpoint belongs to the atmosphere
-                IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )  THEN
-!
-!--                Upward-facing
-                   IF ( .NOT. BTEST( wall_flags_total_0(k+bc_v(l)%koff, j+bc_v(l)%joff,            &
-                                     i+bc_v(l)%ioff), 0 ) )  THEN
-                      bc_v(l)%i(num_v(l)) = i
-                      bc_v(l)%j(num_v(l)) = j
-                      bc_v(l)%k(num_v(l)) = k
-                      num_v_kji(l)        = num_v_kji(l) + 1
-                      num_v(l)            = num_v(l) + 1
-                   ENDIF
-                ENDIF
-             ENDDO
-             bc_v(l)%start_index(j,i) = start_index_v(l)
-             bc_v(l)%end_index(j,i)   = bc_v(l)%start_index(j,i) + num_v_kji(l) - 1
-             start_index_v(l)         = bc_v(l)%end_index(j,i) + 1
-          ENDDO
-       ENDDO
-    ENDDO
-
-
- END SUBROUTINE init_bc
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize horizontal and vertical surfaces. Counts the number of default-, natural and urban
-!> surfaces and allocates memory, respectively.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_surface_arrays
-
-
-    USE pegrid
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i         !< running index x-direction
-    INTEGER(iwp) ::  j         !< running index y-direction
-    INTEGER(iwp) ::  k         !< running index z-direction
-    INTEGER(iwp) ::  l         !< index variable for surface facing
-    INTEGER(iwp) ::  kk        !< auxiliary index z-direction
-    INTEGER(iwp) ::  kd        !< direction index
-
-    INTEGER(iwp), DIMENSION(0:2) ::  num_def_h !< number of horizontally-aligned default surfaces
-    INTEGER(iwp), DIMENSION(0:1) ::  num_lsm_h !< number of horizontally-aligned natural surfaces
-    INTEGER(iwp), DIMENSION(0:1) ::  num_usm_h !< number of horizontally-aligned urban surfaces
-    INTEGER(iwp), DIMENSION(0:3) ::  num_def_v !< number of vertically-aligned default surfaces
-    INTEGER(iwp), DIMENSION(0:3) ::  num_lsm_v !< number of vertically-aligned natural surfaces
-    INTEGER(iwp), DIMENSION(0:3) ::  num_usm_v !< number of vertically-aligned urban surfaces
-
-    INTEGER(iwp) ::  num_surf_v_l !< number of vertically-aligned local urban/land surfaces
-    INTEGER(iwp) ::  num_surf_v   !< number of vertically-aligned total urban/land surfaces
-
-    LOGICAL ::  building             !< flag indicating building grid point
-    LOGICAL ::  terrain              !< flag indicating natural terrain grid point
-    LOGICAL ::  unresolved_building  !< flag indicating a grid point where actually a building is
-                                     !< defined but not resolved by the vertical grid
-
-    num_def_h = 0
-    num_def_v = 0
-    num_lsm_h = 0
-    num_lsm_v = 0
-    num_usm_h = 0
-    num_usm_v = 0
-!
-!-- Surfaces are classified according to the input data read from static input file. If no input
-!-- file is present, all surfaces are classified either as natural, urban, or default, depending on
-!-- the setting of land_surface and urban_surface. To control this, use the control flag
-!-- topo_no_distinct
-!
-!-- Count number of horizontal surfaces on local domain
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-!
-!--          Check if current gridpoint belongs to the atmosphere
-             IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )  THEN
-!
-!--             Check if grid point adjoins to any upward- and downward-facing horizontal surface,
-!--             e.g. the Earth surface, plane roofs, or ceilings.
-                DO kk = k-1, k+1, 2
-!
-!--                Check for top-fluxes
-                   IF ( kk == nzt+1  .AND.  use_top_fluxes )  THEN
-                      num_def_h(2) = num_def_h(2) + 1
-                   ELSE
-!
-!--                   set direction index of the potential surface
-                      kd = MERGE( 0, 1, kk == k-1 )
-!
-!--                   test the adjacent grid cell
-                      IF ( .NOT. BTEST( wall_flags_total_0(kk,j,i), 0 ) )  THEN
-!
-!--                      Determine flags indicating a terrain surface, a building surface,
-                         terrain  = BTEST( wall_flags_total_0(kk,j,i), 5 )  .OR.  topo_no_distinct
-                         building = BTEST( wall_flags_total_0(kk,j,i), 6 )  .OR.  topo_no_distinct
-!
-!--                      Unresolved_building indicates a surface with equal height as terrain but with a
-!--                      non-grid resolved building on top. These surfaces will be flagged as urban
-!--                      surfaces.
-                         unresolved_building = BTEST( wall_flags_total_0(kk,j,i), 5 )  .AND.            &
-                                               BTEST( wall_flags_total_0(kk,j,i), 6 )
-!
-!--                      Land-surface type
-                         IF ( land_surface  .AND.  terrain  .AND.  .NOT. unresolved_building )  THEN
-                            num_lsm_h(kd)    = num_lsm_h(kd)    + 1
-!
-!--                      Urban surface tpye
-                         ELSEIF ( urban_surface  .AND.  building )  THEN
-                            num_usm_h(kd) = num_usm_h(kd) + 1
-!
-!--                      Default-surface type
-                         ELSEIF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-                            num_def_h(kd) = num_def_h(kd) + 1
-!
-!--                      Unclassifified surface-grid point. Give error message. Note, in previous
-!--                      versions the error message was generalized using a combination of TRIM
-!--                      and MERGE function. However, due to compile errors with the Cray compiler
-!--                      two seperate error messages are given now.
-                         ELSE
-                            IF ( kk==0 )  THEN
-                               WRITE( message_string, * ) 'Unclassified upward ',                  &
-                                        '-facing surface element at grid point (k,j,i) = ', k, j, i
-                               CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 )
-                            ELSE
-                               WRITE( message_string, * ) 'Unclassified downward ',                &
-                                        '-facing surface element at grid point (k,j,i) = ', k, j, i
-                               CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 )
-                            ENDIF
-                         ENDIF
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Count number of vertical surfaces on local domain
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )  THEN
-!
-!--             Northward-facing
-                IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 ) )  THEN
-!
-!--                Determine flags indicating terrain or building
-
-                   terrain  = BTEST( wall_flags_total_0(k,j-1,i), 5 )  .OR.  topo_no_distinct
-                   building = BTEST( wall_flags_total_0(k,j-1,i), 6 )  .OR.  topo_no_distinct
-
-                   unresolved_building = BTEST( wall_flags_total_0(k,j-1,i), 5 )  .AND.            &
-                                         BTEST( wall_flags_total_0(k,j-1,i), 6 )
-
-                   IF (  land_surface  .AND.  terrain  .AND.  .NOT. unresolved_building )  THEN
-                      num_lsm_v(0) = num_lsm_v(0) + 1
-                   ELSEIF ( urban_surface  .AND.  building )  THEN
-                      num_usm_v(0) = num_usm_v(0) + 1
-!
-!--                Default-surface type
-                   ELSEIF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-                      num_def_v(0) = num_def_v(0) + 1
-!
-!--                Unclassifified surface-grid point. Give error message.
-                   ELSE
-                      WRITE( message_string, * ) 'Unclassified northward-facing surface ' //       &
-                                                 'element at grid point (k,j,i) = ', k, j, i
-                      CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 )
-
-                   ENDIF
-                ENDIF
-!
-!--             Southward-facing
-                IF ( .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) )  THEN
-!
-!--                Determine flags indicating terrain or building
-                   terrain  = BTEST( wall_flags_total_0(k,j+1,i), 5 )  .OR.  topo_no_distinct
-                   building = BTEST( wall_flags_total_0(k,j+1,i), 6 )  .OR.  topo_no_distinct
-
-                   unresolved_building = BTEST( wall_flags_total_0(k,j+1,i), 5 )  .AND.            &
-                                         BTEST( wall_flags_total_0(k,j+1,i), 6 )
-
-                   IF (  land_surface  .AND.  terrain  .AND.  .NOT. unresolved_building )  THEN
-                      num_lsm_v(1) = num_lsm_v(1) + 1
-                   ELSEIF ( urban_surface  .AND.  building )  THEN
-                      num_usm_v(1) = num_usm_v(1) + 1
-!
-!--                Default-surface type
-                   ELSEIF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-                      num_def_v(1) = num_def_v(1) + 1
-!
-!--                Unclassifified surface-grid point. Give error message.
-                   ELSE
-                      WRITE( message_string, * ) 'Unclassified southward-facing surface ' //       &
-                                                 'element at grid point (k,j,i) = ', k, j, i
-                      CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 )
-
-                   ENDIF
-                ENDIF
-!
-!--             Eastward-facing
-                IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 ) )  THEN
-!
-!--                Determine flags indicating terrain or building
-                   terrain  = BTEST( wall_flags_total_0(k,j,i-1), 5 )  .OR.  topo_no_distinct
-                   building = BTEST( wall_flags_total_0(k,j,i-1), 6 )  .OR.  topo_no_distinct
-
-                   unresolved_building = BTEST( wall_flags_total_0(k,j,i-1), 5 )  .AND.            &
-                                         BTEST( wall_flags_total_0(k,j,i-1), 6 )
-
-                   IF ( land_surface  .AND.  terrain  .AND.  .NOT. unresolved_building )  THEN
-                      num_lsm_v(2) = num_lsm_v(2) + 1
-                   ELSEIF ( urban_surface  .AND.  building )  THEN
-                      num_usm_v(2) = num_usm_v(2) + 1
-!
-!--                Default-surface type
-                   ELSEIF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-                      num_def_v(2) = num_def_v(2) + 1
-!
-!--                Unclassifified surface-grid point. Give error message.
-                   ELSE
-                      WRITE( message_string, * ) 'Unclassified eastward-facing surface ' //        &
-                                                 'element at grid point (k,j,i) = ', k, j, i
-                      CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 )
-
-                   ENDIF
-                ENDIF
-!
-!--             Westward-facing
-                IF ( .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) )  THEN
-!
-!--                Determine flags indicating terrain or building
-                   terrain  = BTEST( wall_flags_total_0(k,j,i+1), 5 )  .OR.  topo_no_distinct
-                   building = BTEST( wall_flags_total_0(k,j,i+1), 6 )  .OR.  topo_no_distinct
-
-                   unresolved_building = BTEST( wall_flags_total_0(k,j,i+1), 5 )  .AND.            &
-                                         BTEST( wall_flags_total_0(k,j,i+1), 6 )
-
-                   IF ( land_surface  .AND.  terrain  .AND.  .NOT. unresolved_building )  THEN
-                      num_lsm_v(3) = num_lsm_v(3) + 1
-                   ELSEIF ( urban_surface  .AND.  building )  THEN
-                      num_usm_v(3) = num_usm_v(3) + 1
-!
-!--                Default-surface type
-                   ELSEIF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
-                      num_def_v(3) = num_def_v(3) + 1
-!
-!--                Unclassifified surface-grid point. Give error message.
-                   ELSE
-                      WRITE( message_string, * ) 'Unclassified westward-facing surface ' //        &
-                                                 'element at grid point (k,j,i) = ', k, j, i
-                      CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 )
-
-                   ENDIF
-                ENDIF
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Store number of surfaces per core.
-!-- Horizontal surface, default type, upward facing
-    surf_def_h(0)%ns = num_def_h(0)
-!
-!-- Horizontal surface, default type, downward facing
-    surf_def_h(1)%ns = num_def_h(1)
-!
-!-- Horizontal surface, default type, top downward facing
-    surf_def_h(2)%ns = num_def_h(2)
-!
-!-- Horizontal surface, natural type, upward facing
-    surf_lsm_h(0)%ns    = num_lsm_h(0)
-!
-!-- Horizontal surface, natural type, downward facing
-    surf_lsm_h(1)%ns    = num_lsm_h(1)
-!
-!-- Horizontal surface, urban type, upward facing
-    surf_usm_h(0)%ns    = num_usm_h(0)
-!
-!-- Horizontal surface, urban type, downward facing
-    surf_usm_h(1)%ns    = num_usm_h(1)
-!
-!-- Vertical surface, default type, northward facing
-    surf_def_v(0)%ns = num_def_v(0)
-!
-!-- Vertical surface, default type, southward facing
-    surf_def_v(1)%ns = num_def_v(1)
-!
-!-- Vertical surface, default type, eastward facing
-    surf_def_v(2)%ns = num_def_v(2)
-!
-!-- Vertical surface, default type, westward facing
-    surf_def_v(3)%ns = num_def_v(3)
-!
-!-- Vertical surface, natural type, northward facing
-    surf_lsm_v(0)%ns = num_lsm_v(0)
-!
-!-- Vertical surface, natural type, southward facing
-    surf_lsm_v(1)%ns = num_lsm_v(1)
-!
-!-- Vertical surface, natural type, eastward facing
-    surf_lsm_v(2)%ns = num_lsm_v(2)
-!
-!-- Vertical surface, natural type, westward facing
-    surf_lsm_v(3)%ns = num_lsm_v(3)
-!
-!-- Vertical surface, urban type, northward facing
-    surf_usm_v(0)%ns = num_usm_v(0)
-!
-!-- Vertical surface, urban type, southward facing
-    surf_usm_v(1)%ns = num_usm_v(1)
-!
-!-- Vertical surface, urban type, eastward facing
-    surf_usm_v(2)%ns = num_usm_v(2)
-!
-!-- Vertical surface, urban type, westward facing
-    surf_usm_v(3)%ns = num_usm_v(3)
-!
-!-- Allocate required attributes for horizontal surfaces - default type.
-!-- Upward-facing (l=0) and downward-facing (l=1).
-    DO  l = 0, 1
-       CALL allocate_surface_attributes_h ( surf_def_h(l), nys, nyn, nxl, nxr )
-    ENDDO
-!
-!-- Allocate required attributes for model top
-    CALL allocate_surface_attributes_h_top ( surf_def_h(2), nys, nyn, nxl, nxr )
-!
-!-- Allocate required attributes for horizontal surfaces - natural type.
-    DO  l = 0, 1
-       CALL allocate_surface_attributes_h ( surf_lsm_h(l), nys, nyn, nxl, nxr )
-    ENDDO
-!
-!-- Allocate required attributes for horizontal surfaces - urban type.
-    DO  l = 0, 1
-       CALL allocate_surface_attributes_h ( surf_usm_h(l), nys, nyn, nxl, nxr )
-    ENDDO
-
-!
-!-- Allocate required attributes for vertical surfaces.
-!-- Northward-facing (l=0), southward-facing (l=1), eastward-facing (l=2) and westward-facing (l=3).
-!-- Default type.
-    DO  l = 0, 3
-       CALL allocate_surface_attributes_v ( surf_def_v(l), nys, nyn, nxl, nxr )
-    ENDDO
-!
-!-- Natural type
-    DO  l = 0, 3
-       CALL allocate_surface_attributes_v ( surf_lsm_v(l), nys, nyn, nxl, nxr )
-    ENDDO
-!
-!-- Urban type
-    DO  l = 0, 3
-       CALL allocate_surface_attributes_v ( surf_usm_v(l), nys, nyn, nxl, nxr )
-    ENDDO
-!
-!-- Set the flag for the existence of vertical urban/land surfaces. Therefore, sum-up the number of
-!-- all natural and urban-type vertical surfaces and check.
-    num_surf_v_l = 0
-    DO  l = 0, 3
-       num_surf_v_l = num_surf_v_l + surf_usm_v(l)%ns + surf_lsm_v(l)%ns
-    ENDDO
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( num_surf_v_l, num_surf_v, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr)
-#else
-    num_surf_v = num_surf_v_l
-#endif
-    IF ( num_surf_v > 0 )  vertical_surfaces_exist = .TRUE.
-
-!
-!-- Calculate the total number of surfaces in the entire model domain of a type.
-!-- Horizontal walls.
-    DO  l = 0, 1
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( surf_def_h(l)%ns, surf_def_h(l)%ns_tot, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr)
-       CALL MPI_ALLREDUCE( surf_lsm_h(l)%ns, surf_lsm_h(l)%ns_tot, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr)
-       CALL MPI_ALLREDUCE( surf_usm_h(l)%ns, surf_usm_h(l)%ns_tot, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr)
-#else
-       surf_def_h(l)%ns_tot = surf_def_h(l)%ns
-       surf_lsm_h(l)%ns_tot = surf_lsm_h(l)%ns
-       surf_usm_h(l)%ns_tot = surf_usm_h(l)%ns
-#endif
-    ENDDO
-!
-!-- Vertical walls.
-    DO  l = 0, 3
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( surf_def_v(l)%ns, surf_def_v(l)%ns_tot, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr)
-       CALL MPI_ALLREDUCE( surf_lsm_v(l)%ns, surf_lsm_v(l)%ns_tot, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr)
-       CALL MPI_ALLREDUCE( surf_usm_v(l)%ns, surf_usm_v(l)%ns_tot, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr)
-#else
-       surf_def_v(l)%ns_tot = surf_def_v(l)%ns
-       surf_lsm_v(l)%ns_tot = surf_lsm_v(l)%ns
-       surf_usm_v(l)%ns_tot = surf_usm_v(l)%ns
-#endif
-    ENDDO
-
- END SUBROUTINE init_surface_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Enter horizontal and vertical surfaces.
-!--------------------------------------------------------------------------------------------------!
-#if defined( _OPENACC )
- SUBROUTINE enter_surface_arrays
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  l  !<
-
-    !$ACC ENTER DATA &
-    !$ACC COPYIN(surf_def_h(0:2)) &
-    !$ACC COPYIN(surf_def_v(0:3)) &
-    !$ACC COPYIN(surf_lsm_h(0:1)) &
-    !$ACC COPYIN(surf_lsm_v(0:3)) &
-    !$ACC COPYIN(surf_usm_h(0:1)) &
-    !$ACC COPYIN(surf_usm_v(0:3))
-!
-!-- Copy data in surf_def_h(0:2)
-    DO  l = 0, 1
-       CALL enter_surface_attributes_h( surf_def_h(l) )
-    ENDDO
-    CALL enter_surface_attributes_h_top( surf_def_h(2) )
-!
-!-- Copy data in surf_def_v(0:3)
-    DO  l = 0, 3
-       CALL enter_surface_attributes_v( surf_def_v(l) )
-    ENDDO
-!
-!-- Copy data in surf_lsm_h
-    DO  l = 0, 1
-       CALL enter_surface_attributes_h( surf_lsm_h(l) )
-    ENDDO
-!
-!-- Copy data in surf_lsm_v(0:3)
-    DO  l = 0, 3
-       CALL enter_surface_attributes_v( surf_lsm_v(l) )
-    ENDDO
-!
-!-- Copy data in surf_usm_h
-    DO  l = 0, 1
-       CALL enter_surface_attributes_h( surf_usm_h(l) )
-    ENDDO
-!
-!-- Copy data in surf_usm_v(0:3)
-    DO  l = 0, 3
-       CALL enter_surface_attributes_v( surf_usm_v(l) )
-    ENDDO
-
- END SUBROUTINE enter_surface_arrays
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exit horizontal and vertical surfaces.
-!--------------------------------------------------------------------------------------------------!
-#if defined( _OPENACC )
- SUBROUTINE exit_surface_arrays
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  l  !<
-!
-!-- Delete data in surf_def_h(0:2)
-    DO  l = 0, 1
-       CALL exit_surface_attributes_h( surf_def_h(l) )
-    ENDDO
-    CALL exit_surface_attributes_h( surf_def_h(2) )
-!
-!-- Delete data in surf_def_v(0:3)
-    DO  l = 0, 3
-       CALL exit_surface_attributes_v( surf_def_v(l) )
-    ENDDO
-!
-!-- Delete data in surf_lsm_h
-    DO  l = 0, 1
-       CALL exit_surface_attributes_h( surf_lsm_h(l) )
-    ENDDO
-!
-!-- Delete data in surf_lsm_v(0:3)
-    DO  l = 0, 3
-       CALL exit_surface_attributes_v( surf_lsm_v(l) )
-    ENDDO
-!
-!-- Delete data in surf_usm_h
-    DO  l = 0, 1
-       CALL exit_surface_attributes_h( surf_usm_h(l) )
-    ENDDO
-!
-!-- Delete data in surf_usm_v(0:3)
-    DO  l = 0, 3
-       CALL exit_surface_attributes_v( surf_usm_v(l) )
-    ENDDO
-
-    !$ACC EXIT DATA &
-    !$ACC DELETE(surf_def_h(0:2)) &
-    !$ACC DELETE(surf_def_v(0:3)) &
-    !$ACC DELETE(surf_lsm_h(0:1)) &
-    !$ACC DELETE(surf_lsm_v(0:3)) &
-    !$ACC DELETE(surf_usm_h(0:1)) &
-    !$ACC DELETE(surf_usm_v(0:3))
-
- END SUBROUTINE exit_surface_arrays
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Deallocating memory for upward and downward-facing horizontal surface types, except for top
-!> fluxes.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE deallocate_surface_attributes_h( surfaces )
-
-    IMPLICIT NONE
-
-
-    TYPE(surf_type) ::  surfaces  !< respective surface type
-
-
-    DEALLOCATE ( surfaces%start_index )
-    DEALLOCATE ( surfaces%end_index )
-!
-!-- Indices to locate surface element
-    DEALLOCATE ( surfaces%i )
-    DEALLOCATE ( surfaces%j )
-    DEALLOCATE ( surfaces%k )
-!
-!-- Surface-layer height
-    DEALLOCATE ( surfaces%z_mo )
-!
-!-- Surface orientation
-    DEALLOCATE ( surfaces%facing )
-!
-!-- Surface-parallel wind velocity
-    DEALLOCATE ( surfaces%uvw_abs )
-!
-!-- Pre-calculated ln(z/z0)
-    DEALLOCATE ( surfaces%ln_z_z0  )
-    DEALLOCATE ( surfaces%ln_z_z0h )
-    DEALLOCATE ( surfaces%ln_z_z0q )
-!
-!-- Roughness
-    DEALLOCATE ( surfaces%z0 )
-    DEALLOCATE ( surfaces%z0h )
-    DEALLOCATE ( surfaces%z0q )
-!
-!-- Friction velocity
-    DEALLOCATE ( surfaces%us )
-!
-!-- Stability parameter
-    DEALLOCATE ( surfaces%ol )
-!
-!-- Bulk Richardson number
-    DEALLOCATE ( surfaces%rib )
-!
-!-- Vertical momentum fluxes of u and v
-    DEALLOCATE ( surfaces%usws )
-    DEALLOCATE ( surfaces%vsws )
-!
-!-- Required in production_e
-    IF ( .NOT. constant_diffusion )  THEN
-       DEALLOCATE ( surfaces%u_0 )
-       DEALLOCATE ( surfaces%v_0 )
-    ENDIF
-!
-!-- Characteristic temperature and surface flux of sensible heat
-    DEALLOCATE ( surfaces%ts )
-    DEALLOCATE ( surfaces%shf )
-!
-!-- Surface temperature
-    DEALLOCATE ( surfaces%pt_surface )
-!
-!-- Characteristic humidity and surface flux of latent heat
-    IF ( humidity )  THEN
-       DEALLOCATE ( surfaces%qs )
-       DEALLOCATE ( surfaces%qsws )
-       DEALLOCATE ( surfaces%q_surface   )
-       DEALLOCATE ( surfaces%vpt_surface )
-    ENDIF
-!
-!-- Characteristic scalar and surface flux of scalar
-    IF ( passive_scalar )  THEN
-       DEALLOCATE ( surfaces%ss )
-       DEALLOCATE ( surfaces%ssws )
-    ENDIF
-!
-!-- Scaling parameter (cs*) and surface flux of chemical species
-    IF ( air_chemistry )  THEN
-       DEALLOCATE ( surfaces%css )
-       DEALLOCATE ( surfaces%cssws )
-    ENDIF
-!
-!-- Arrays for storing potential temperature and mixing ratio at first grid level
-    DEALLOCATE ( surfaces%pt1 )
-    DEALLOCATE ( surfaces%qv1 )
-    DEALLOCATE ( surfaces%vpt1 )
-
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison)  THEN
-       DEALLOCATE ( surfaces%qcs )
-       DEALLOCATE ( surfaces%ncs )
-       DEALLOCATE ( surfaces%qcsws )
-       DEALLOCATE ( surfaces%ncsws )
-    ENDIF
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert)  THEN
-       DEALLOCATE ( surfaces%qrs )
-       DEALLOCATE ( surfaces%nrs )
-       DEALLOCATE ( surfaces%qrsws )
-       DEALLOCATE ( surfaces%nrsws )
-    ENDIF
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase)  THEN
-       DEALLOCATE ( surfaces%qis )
-       DEALLOCATE ( surfaces%nis )
-       DEALLOCATE ( surfaces%qisws )
-       DEALLOCATE ( surfaces%nisws )
-    ENDIF
-!
-!-- Salinity surface flux
-    IF ( ocean_mode )  DEALLOCATE ( surfaces%sasws )
-
- END SUBROUTINE deallocate_surface_attributes_h
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocating memory for upward and downward-facing horizontal surface types, except for top fluxes.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE allocate_surface_attributes_h( surfaces, nys_l, nyn_l, nxl_l, nxr_l,                   &
-                                           no_allocate_index_arrays )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  nyn_l  !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-    INTEGER(iwp) ::  nys_l  !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-    INTEGER(iwp) ::  nxl_l  !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-    INTEGER(iwp) ::  nxr_l  !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-
-    LOGICAL ::  allocate_index_arrays
-    LOGICAL, INTENT(IN), OPTIONAL  :: no_allocate_index_arrays
-
-    TYPE(surf_type) ::  surfaces  !< respective surface type
-
-
-    IF ( PRESENT( no_allocate_index_arrays ) )  THEN
-       allocate_index_arrays = .NOT. no_allocate_index_arrays
-    ELSE
-       allocate_index_arrays = .TRUE.
-    ENDIF
-!
-!-- Allocate arrays for start and end index of horizontal surface type for each (j,i)-grid point.
-!-- This is required e.g. in diffusion_x, which is called for each (j,i). In order to find the
-!-- location where the respective flux is store within the surface-type, start- and end-index are
-!-- stored for each (j,i). For example, each (j,i) can have several entries where fluxes for
-!-- horizontal surfaces might be stored, e.g. for overhanging structures where several upward-facing
-!-- surfaces might exist for given (j,i). If no surface of respective type exist at current (j,i),
-!-- set indicies such that loop in diffusion routines will not be entered.
-    IF ( allocate_index_arrays )  THEN
-       ALLOCATE( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) )
-       ALLOCATE( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l)   )
-       surfaces%start_index = 0
-       surfaces%end_index   = -1
-    ENDIF
-!
-!-- Indices to locate surface element
-    ALLOCATE ( surfaces%i(1:surfaces%ns) )
-    ALLOCATE ( surfaces%j(1:surfaces%ns) )
-    ALLOCATE ( surfaces%k(1:surfaces%ns) )
-!
-!-- Surface-layer height
-    ALLOCATE ( surfaces%z_mo(1:surfaces%ns) )
-!
-!-- Surface orientation
-    ALLOCATE ( surfaces%facing(1:surfaces%ns) )
-!
-!-- Surface-parallel wind velocity
-    ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) )
-!
-!-- Precalculated ln(z/z0)
-    ALLOCATE( surfaces%ln_z_z0(1:surfaces%ns)  )
-    ALLOCATE( surfaces%ln_z_z0h(1:surfaces%ns) )
-    ALLOCATE( surfaces%ln_z_z0q(1:surfaces%ns) )
-!
-!-- Roughness
-    ALLOCATE ( surfaces%z0(1:surfaces%ns)  )
-    ALLOCATE ( surfaces%z0h(1:surfaces%ns) )
-    ALLOCATE ( surfaces%z0q(1:surfaces%ns) )
-!
-!-- Friction velocity
-    ALLOCATE ( surfaces%us(1:surfaces%ns) )
-!
-!-- Stability parameter
-    ALLOCATE ( surfaces%ol(1:surfaces%ns) )
-!
-!-- Bulk Richardson number
-    ALLOCATE ( surfaces%rib(1:surfaces%ns) )
-!
-!-- Vertical momentum fluxes of u and v
-    ALLOCATE ( surfaces%usws(1:surfaces%ns) )
-    ALLOCATE ( surfaces%vsws(1:surfaces%ns) )
-!
-!-- Required in production_e
-    IF ( .NOT. constant_diffusion )  THEN
-       ALLOCATE ( surfaces%u_0(1:surfaces%ns) )
-       ALLOCATE ( surfaces%v_0(1:surfaces%ns) )
-    ENDIF
-!
-!-- Characteristic temperature and surface flux of sensible heat
-    ALLOCATE ( surfaces%ts(1:surfaces%ns) )
-    ALLOCATE ( surfaces%shf(1:surfaces%ns) )
-!
-!-- Surface temperature
-    ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) )
-!
-!-- Characteristic humidity, surface flux of latent heat, and surface virtual potential temperature
-    IF ( humidity )  THEN
-       ALLOCATE ( surfaces%qs(1:surfaces%ns) )
-       ALLOCATE ( surfaces%qsws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%q_surface(1:surfaces%ns) )
-       ALLOCATE ( surfaces%vpt_surface(1:surfaces%ns) )
-    ENDIF
-
-!
-!-- Characteristic scalar and surface flux of scalar
-    IF ( passive_scalar )  THEN
-       ALLOCATE ( surfaces%ss(1:surfaces%ns) )
-       ALLOCATE ( surfaces%ssws(1:surfaces%ns) )
-    ENDIF
-!
-!-- Scaling parameter (cs*) and surface flux of chemical species
-    IF ( air_chemistry )  THEN
-       ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) )
-       ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) )
-    ENDIF
-!
-!-- Arrays for storing potential temperature and mixing ratio at first grid level
-    ALLOCATE ( surfaces%pt1(1:surfaces%ns) )
-    ALLOCATE ( surfaces%qv1(1:surfaces%ns) )
-    ALLOCATE ( surfaces%vpt1(1:surfaces%ns) )
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison)  THEN
-       ALLOCATE ( surfaces%qcs(1:surfaces%ns) )
-       ALLOCATE ( surfaces%ncs(1:surfaces%ns) )
-       ALLOCATE ( surfaces%qcsws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%ncsws(1:surfaces%ns) )
-    ENDIF
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert)  THEN
-       ALLOCATE ( surfaces%qrs(1:surfaces%ns) )
-       ALLOCATE ( surfaces%nrs(1:surfaces%ns) )
-       ALLOCATE ( surfaces%qrsws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%nrsws(1:surfaces%ns) )
-    ENDIF
-
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase)  THEN
-       ALLOCATE ( surfaces%qis(1:surfaces%ns) )
-       ALLOCATE ( surfaces%nis(1:surfaces%ns) )
-       ALLOCATE ( surfaces%qisws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%nisws(1:surfaces%ns) )
-    ENDIF
-
-!
-!-- Salinity surface flux
-    IF ( ocean_mode )  ALLOCATE ( surfaces%sasws(1:surfaces%ns) )
-
- END SUBROUTINE allocate_surface_attributes_h
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exit memory for upward and downward-facing horizontal surface types, except for top fluxes.
-!--------------------------------------------------------------------------------------------------!
-#if defined( _OPENACC )
- SUBROUTINE exit_surface_attributes_h( surfaces )
-
-    IMPLICIT NONE
-
-    TYPE(surf_type) ::  surfaces  !< respective surface type
-
-    !$ACC EXIT DATA &
-    !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) &
-    !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) &
-    !$ACC DELETE(surfaces%i(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%j(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%k(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%z_mo(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%ln_z_z0(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%ln_z_z0h(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%ln_z_z0q(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%z0(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%z0h(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%z0q(1:surfaces%ns)) &
-    !$ACC COPYOUT(surfaces%us(1:surfaces%ns)) &
-    !$ACC COPYOUT(surfaces%ol(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%rib(1:surfaces%ns)) &
-    !$ACC COPYOUT(surfaces%usws(1:surfaces%ns)) &
-    !$ACC COPYOUT(surfaces%vsws(1:surfaces%ns)) &
-    !$ACC COPYOUT(surfaces%ts(1:surfaces%ns)) &
-    !$ACC COPYOUT(surfaces%shf(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%pt_surface(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%pt1(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%qv1(1:surfaces%ns))
-
-    IF ( .NOT. constant_diffusion )  THEN
-       !$ACC EXIT DATA &
-       !$ACC DELETE(surfaces%u_0(1:surfaces%ns)) &
-       !$ACC DELETE(surfaces%v_0(1:surfaces%ns))
-    ENDIF
-
- END SUBROUTINE exit_surface_attributes_h
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Enter memory for upward and downward-facing horizontal surface types, except for top fluxes.
-!--------------------------------------------------------------------------------------------------!
-#if defined( _OPENACC )
- SUBROUTINE enter_surface_attributes_h( surfaces )
-
-    IMPLICIT NONE
-
-    TYPE(surf_type) ::  surfaces  !< respective surface type
-
-    !$ACC ENTER DATA &
-    !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) &
-    !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) &
-    !$ACC COPYIN(surfaces%i(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%j(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%k(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%z_mo(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%ln_z_z0(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%ln_z_z0h(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%ln_z_z0q(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%z0h(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%z0q(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%us(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%ol(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%rib(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%usws(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%vsws(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%ts(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%pt1(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%qv1(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%pt_surface(1:surfaces%ns))
-
-    IF ( .NOT. constant_diffusion )  THEN
-       !$ACC ENTER DATA &
-       !$ACC COPYIN(surfaces%u_0(1:surfaces%ns)) &
-       !$ACC COPYIN(surfaces%v_0(1:surfaces%ns))
-    ENDIF
-
- END SUBROUTINE enter_surface_attributes_h
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Deallocating memory for model-top fluxes
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE deallocate_surface_attributes_h_top( surfaces )
-
-    IMPLICIT NONE
-
-
-    TYPE(surf_type) ::  surfaces !< respective surface type
-
-    DEALLOCATE ( surfaces%start_index )
-    DEALLOCATE ( surfaces%end_index )
-!
-!-- Indices to locate surface (model-top) element
-    DEALLOCATE ( surfaces%i )
-    DEALLOCATE ( surfaces%j )
-    DEALLOCATE ( surfaces%k )
-
-    IF ( .NOT. constant_diffusion )  THEN
-       DEALLOCATE ( surfaces%u_0 )
-       DEALLOCATE ( surfaces%v_0 )
-    ENDIF
-!
-!-- Vertical momentum fluxes of u and v
-    DEALLOCATE ( surfaces%usws )
-    DEALLOCATE ( surfaces%vsws )
-!
-!-- Sensible heat flux
-    DEALLOCATE ( surfaces%shf )
-!
-!-- Latent heat flux
-    IF ( humidity .OR. coupling_mode == 'ocean_to_atmosphere')  THEN
-       DEALLOCATE ( surfaces%qsws )
-    ENDIF
-!
-!-- Scalar flux
-    IF ( passive_scalar )  THEN
-       DEALLOCATE ( surfaces%ssws )
-    ENDIF
-!
-!-- Chemical species flux
-    IF ( air_chemistry )  THEN
-       DEALLOCATE ( surfaces%cssws )
-    ENDIF
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison)  THEN
-       DEALLOCATE ( surfaces%qcsws )
-       DEALLOCATE ( surfaces%ncsws )
-    ENDIF
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert)  THEN
-       DEALLOCATE ( surfaces%qrsws )
-       DEALLOCATE ( surfaces%nrsws )
-    ENDIF
-
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase)  THEN
-       DEALLOCATE ( surfaces%qisws )
-       DEALLOCATE ( surfaces%nisws )
-    ENDIF
-!
-!-- Salinity flux
-    IF ( ocean_mode )  DEALLOCATE ( surfaces%sasws )
-
- END SUBROUTINE deallocate_surface_attributes_h_top
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocating memory for model-top fluxes
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE allocate_surface_attributes_h_top( surfaces, nys_l, nyn_l, nxl_l, nxr_l )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  nyn_l  !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-    INTEGER(iwp) ::  nys_l  !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-    INTEGER(iwp) ::  nxl_l  !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-    INTEGER(iwp) ::  nxr_l  !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-
-    TYPE(surf_type) ::  surfaces !< respective surface type
-
-    ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) )
-    ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) )
-    surfaces%start_index = 0
-    surfaces%end_index   = -1
-!
-!-- Indices to locate surface (model-top) element
-    ALLOCATE ( surfaces%i(1:surfaces%ns) )
-    ALLOCATE ( surfaces%j(1:surfaces%ns) )
-    ALLOCATE ( surfaces%k(1:surfaces%ns) )
-
-    IF ( .NOT. constant_diffusion )  THEN
-       ALLOCATE ( surfaces%u_0(1:surfaces%ns) )
-       ALLOCATE ( surfaces%v_0(1:surfaces%ns) )
-    ENDIF
-!
-!-- Vertical momentum fluxes of u and v
-    ALLOCATE ( surfaces%usws(1:surfaces%ns) )
-    ALLOCATE ( surfaces%vsws(1:surfaces%ns) )
-!
-!-- Sensible heat flux
-    ALLOCATE ( surfaces%shf(1:surfaces%ns) )
-!
-!-- Latent heat flux
-    IF ( humidity .OR. coupling_mode == 'ocean_to_atmosphere')  THEN
-       ALLOCATE ( surfaces%qsws(1:surfaces%ns) )
-    ENDIF
-!
-!-- Scalar flux
-    IF ( passive_scalar )  THEN
-       ALLOCATE ( surfaces%ssws(1:surfaces%ns) )
-    ENDIF
-!
-!-- Chemical species flux
-    IF ( air_chemistry )  THEN
-       ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) )
-    ENDIF
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison )  THEN
-       ALLOCATE ( surfaces%qcsws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%ncsws(1:surfaces%ns) )
-    ENDIF
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert )  THEN
-       ALLOCATE ( surfaces%qrsws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%nrsws(1:surfaces%ns) )
-    ENDIF
-
-!
-!--
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase )  THEN
-       ALLOCATE ( surfaces%qisws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%nisws(1:surfaces%ns) )
-    ENDIF
-!
-!-- Salinity flux
-    IF ( ocean_mode )  ALLOCATE ( surfaces%sasws(1:surfaces%ns) )
-
- END SUBROUTINE allocate_surface_attributes_h_top
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exit memory for model-top fluxes.
-!--------------------------------------------------------------------------------------------------!
-#if defined( _OPENACC )
- SUBROUTINE exit_surface_attributes_h_top( surfaces )
-
-    IMPLICIT NONE
-
-    TYPE(surf_type) ::  surfaces  !< respective surface type
-
-    !$ACC EXIT DATA &
-    !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) &
-    !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) &
-    !$ACC DELETE(surfaces%i(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%j(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%k(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%usws(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%vsws(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%shf(1:surfaces%ns))
-
-    IF ( .NOT. constant_diffusion )  THEN
-       !$ACC EXIT DATA &
-       !$ACC DELETE(surfaces%u_0(1:surfaces%ns)) &
-       !$ACC DELETE(surfaces%v_0(1:surfaces%ns))
-    ENDIF
-
- END SUBROUTINE exit_surface_attributes_h_top
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Enter memory for model-top fluxes.
-!--------------------------------------------------------------------------------------------------!
-#if defined( _OPENACC )
- SUBROUTINE enter_surface_attributes_h_top( surfaces )
-
-    IMPLICIT NONE
-
-    TYPE(surf_type) ::  surfaces  !< respective surface type
-
-    !$ACC ENTER DATA &
-    !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) &
-    !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) &
-    !$ACC COPYIN(surfaces%i(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%j(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%k(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%usws(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%vsws(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%shf(1:surfaces%ns))
-
-    IF ( .NOT. constant_diffusion )  THEN
-       !$ACC ENTER DATA &
-       !$ACC COPYIN(surfaces%u_0(1:surfaces%ns)) &
-       !$ACC COPYIN(surfaces%v_0(1:surfaces%ns))
-    ENDIF
-
- END SUBROUTINE enter_surface_attributes_h_top
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Deallocating memory for vertical surface types.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE deallocate_surface_attributes_v( surfaces )
-
-    IMPLICIT NONE
-
-
-    TYPE(surf_type) ::  surfaces !< respective surface type
-
-!
-!-- Allocate arrays for start and end index of vertical surface type for each (j,i)-grid point. This
-!-- is required in diffion_x, which is called for each (j,i). In order to find the location where
-!-- the respective flux is store within the surface-type, start- and end-index are stored for each
-!-- (j,i). For example, each (j,i) can have several entries where fluxes for vertical surfaces might
-!-- be stored. In the flat case, where no vertical walls exit, set indicies such that loop in
-!-- diffusion routines will not be entered.
-    DEALLOCATE ( surfaces%start_index )
-    DEALLOCATE ( surfaces%end_index )
-!
-!-- Indices to locate surface element.
-    DEALLOCATE ( surfaces%i )
-    DEALLOCATE ( surfaces%j )
-    DEALLOCATE ( surfaces%k )
-!
-!-- Surface-layer height
-    DEALLOCATE ( surfaces%z_mo )
-!
-!-- Surface orientation
-    DEALLOCATE ( surfaces%facing )
-!
-!-- Surface parallel wind velocity
-    DEALLOCATE ( surfaces%uvw_abs )
-!
-!-- Precalculated ln(z/z0)
-    DEALLOCATE ( surfaces%ln_z_z0  )
-    DEALLOCATE ( surfaces%ln_z_z0h )
-    DEALLOCATE ( surfaces%ln_z_z0q )
-!
-!-- Roughness
-    DEALLOCATE ( surfaces%z0 )
-    DEALLOCATE ( surfaces%z0h )
-    DEALLOCATE ( surfaces%z0q )
-!
-!-- Friction velocity
-    DEALLOCATE ( surfaces%us )
-!
-!-- Allocate Obukhov length and bulk Richardson number. Actually, at vertical surfaces these are
-!-- only required for natural surfaces.
-!-- For natural land surfaces
-    DEALLOCATE( surfaces%ol )
-    DEALLOCATE( surfaces%rib )
-!
-!-- Allocate arrays for surface momentum fluxes for u and v. For u at north- and south-facing
-!-- surfaces, for v at east- and west-facing surfaces.
-    DEALLOCATE ( surfaces%mom_flux_uv )
-!
-!-- Allocate array for surface momentum flux for w - wsus and wsvs
-    DEALLOCATE ( surfaces%mom_flux_w )
-!
-!-- Allocate array for surface momentum flux for subgrid-scale tke wsus and wsvs; first index usvs
-!-- or vsws, second index for wsus or wsvs, depending on surface.
-    DEALLOCATE ( surfaces%mom_flux_tke )
-!
-!-- Characteristic temperature and surface flux of sensible heat
-    DEALLOCATE ( surfaces%ts )
-    DEALLOCATE ( surfaces%shf )
-!
-!-- Surface temperature
-    DEALLOCATE ( surfaces%pt_surface )
-!
-!-- Characteristic humidity and surface flux of latent heat
-    IF ( humidity )  THEN
-       DEALLOCATE ( surfaces%qs )
-       DEALLOCATE ( surfaces%qsws )
-       DEALLOCATE ( surfaces%q_surface )
-       DEALLOCATE ( surfaces%vpt_surface )
-    ENDIF
-!
-!-- Characteristic scalar and surface flux of scalar
-    IF ( passive_scalar )  THEN
-       DEALLOCATE ( surfaces%ss )
-       DEALLOCATE ( surfaces%ssws )
-    ENDIF
-!
-!-- Scaling parameter (cs*) and surface flux of chemical species
-    IF ( air_chemistry )  THEN
-       DEALLOCATE ( surfaces%css )
-       DEALLOCATE ( surfaces%cssws )
-    ENDIF
-!
-!-- Arrays for storing potential temperature and mixing ratio at first grid level
-    DEALLOCATE ( surfaces%pt1 )
-    DEALLOCATE ( surfaces%qv1 )
-    DEALLOCATE ( surfaces%vpt1 )
-
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison)  THEN
-       DEALLOCATE ( surfaces%qcs )
-       DEALLOCATE ( surfaces%ncs )
-       DEALLOCATE ( surfaces%qcsws )
-       DEALLOCATE ( surfaces%ncsws )
-    ENDIF
-
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert)  THEN
-       DEALLOCATE ( surfaces%qrs )
-       DEALLOCATE ( surfaces%nrs )
-       DEALLOCATE ( surfaces%qrsws )
-       DEALLOCATE ( surfaces%nrsws )
-    ENDIF
-
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase)  THEN
-       DEALLOCATE ( surfaces%qis )
-       DEALLOCATE ( surfaces%nis )
-       DEALLOCATE ( surfaces%qisws )
-       DEALLOCATE ( surfaces%nisws )
-    ENDIF
-
-!
-!-- Salinity surface flux
-    IF ( ocean_mode )  DEALLOCATE ( surfaces%sasws )
-
- END SUBROUTINE deallocate_surface_attributes_v
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocating memory for vertical surface types.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE allocate_surface_attributes_v( surfaces, nys_l, nyn_l, nxl_l, nxr_l,                   &
-                                           no_allocate_index_arrays )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  nyn_l  !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-    INTEGER(iwp) ::  nys_l  !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-    INTEGER(iwp) ::  nxl_l  !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-    INTEGER(iwp) ::  nxr_l  !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array
-
-    LOGICAL ::  allocate_index_arrays
-    LOGICAL, INTENT(IN), OPTIONAL ::  no_allocate_index_arrays
-
-    TYPE(surf_type) ::  surfaces !< respective surface type
-
-
-    IF ( PRESENT( no_allocate_index_arrays ) )  THEN
-       allocate_index_arrays = .NOT. no_allocate_index_arrays
-    ELSE
-       allocate_index_arrays = .TRUE.
-    ENDIF
-
-!
-!-- Allocate arrays for start and end index of vertical surface type for each (j,i)-grid point. This
-!-- is required in diffusion_x, which is called for each (j,i). In order to find the location where
-!-- the respective flux is store within the surface-type, start- and end-index are stored for each
-!-- (j,i). For example, each (j,i) can have several entries where fluxes for vertical surfaces might
-!-- be stored. In the flat case, where no vertical walls exit, set indicies such that loop in
-!-- diffusion routines will not be entered.
-    IF ( allocate_index_arrays )  THEN
-       ALLOCATE( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) )
-       ALLOCATE( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l)   )
-       surfaces%start_index = 0
-       surfaces%end_index   = -1
-    ENDIF
-!
-!-- Indices to locate surface element.
-    ALLOCATE ( surfaces%i(1:surfaces%ns) )
-    ALLOCATE ( surfaces%j(1:surfaces%ns) )
-    ALLOCATE ( surfaces%k(1:surfaces%ns) )
-!
-!-- Surface-layer height
-    ALLOCATE ( surfaces%z_mo(1:surfaces%ns) )
-!
-!-- Surface orientation
-    ALLOCATE ( surfaces%facing(1:surfaces%ns) )
-!
-!-- Surface parallel wind velocity
-    ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) )
-!
-!-- Precalculated ln(z/z0)
-    ALLOCATE( surfaces%ln_z_z0(1:surfaces%ns) )
-    ALLOCATE( surfaces%ln_z_z0h(1:surfaces%ns) )
-    ALLOCATE( surfaces%ln_z_z0q(1:surfaces%ns) )
-!
-!-- Roughness
-    ALLOCATE ( surfaces%z0(1:surfaces%ns)  )
-    ALLOCATE ( surfaces%z0h(1:surfaces%ns) )
-    ALLOCATE ( surfaces%z0q(1:surfaces%ns) )
-
-!
-!-- Friction velocity
-    ALLOCATE ( surfaces%us(1:surfaces%ns) )
-!
-!-- Allocate Obukhov length and bulk Richardson number. Actually, at vertical surfaces these are
-!-- only required for natural surfaces.
-!-- For natural land surfaces
-    ALLOCATE( surfaces%ol(1:surfaces%ns) )
-    ALLOCATE( surfaces%rib(1:surfaces%ns) )
-!
-!-- Allocate arrays for surface momentum fluxes for u and v. For u at north- and south-facing
-!-- surfaces, for v at east- and west-facing surfaces.
-    ALLOCATE ( surfaces%mom_flux_uv(1:surfaces%ns) )
-!
-!-- Allocate array for surface momentum flux for w - wsus and wsvs
-    ALLOCATE ( surfaces%mom_flux_w(1:surfaces%ns) )
-!
-!-- Allocate array for surface momentum flux for subgrid-scale tke wsus and wsvs; first index usvs
-!-- or vsws, second index for wsus or wsvs, depending on surface.
-    ALLOCATE ( surfaces%mom_flux_tke(0:1,1:surfaces%ns) )
-!
-!-- Characteristic temperature and surface flux of sensible heat
-    ALLOCATE ( surfaces%ts(1:surfaces%ns) )
-    ALLOCATE ( surfaces%shf(1:surfaces%ns) )
-!
-!-- Surface temperature
-    ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) )
-!
-!-- Characteristic humidity and surface flux of latent heat
-    IF ( humidity )  THEN
-       ALLOCATE ( surfaces%qs(1:surfaces%ns) )
-       ALLOCATE ( surfaces%qsws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%q_surface(1:surfaces%ns) )
-       ALLOCATE ( surfaces%vpt_surface(1:surfaces%ns) )
-    ENDIF
-!
-!-- Characteristic scalar and surface flux of scalar
-    IF ( passive_scalar )  THEN
-       ALLOCATE ( surfaces%ss(1:surfaces%ns) )
-       ALLOCATE ( surfaces%ssws(1:surfaces%ns) )
-    ENDIF
-!
-!-- Scaling parameter (cs*) and surface flux of chemical species
-    IF ( air_chemistry )  THEN
-       ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) )
-       ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) )
-    ENDIF
-!
-!-- Arrays for storing potential temperature and mixing ratio at first grid level
-    ALLOCATE ( surfaces%pt1(1:surfaces%ns) )
-    ALLOCATE ( surfaces%qv1(1:surfaces%ns) )
-    ALLOCATE ( surfaces%vpt1(1:surfaces%ns) )
-
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison)  THEN
-       ALLOCATE ( surfaces%qcs(1:surfaces%ns) )
-       ALLOCATE ( surfaces%ncs(1:surfaces%ns) )
-       ALLOCATE ( surfaces%qcsws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%ncsws(1:surfaces%ns) )
-    ENDIF
-
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert)  THEN
-       ALLOCATE ( surfaces%qrs(1:surfaces%ns) )
-       ALLOCATE ( surfaces%nrs(1:surfaces%ns) )
-       ALLOCATE ( surfaces%qrsws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%nrsws(1:surfaces%ns) )
-    ENDIF
-
-    IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase)  THEN
-       ALLOCATE ( surfaces%qis(1:surfaces%ns) )
-       ALLOCATE ( surfaces%nis(1:surfaces%ns) )
-       ALLOCATE ( surfaces%qisws(1:surfaces%ns) )
-       ALLOCATE ( surfaces%nisws(1:surfaces%ns) )
-    ENDIF
-!
-!-- Salinity surface flux
-    IF ( ocean_mode )  ALLOCATE ( surfaces%sasws(1:surfaces%ns) )
-
- END SUBROUTINE allocate_surface_attributes_v
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exit memory for vertical surface types.
-!--------------------------------------------------------------------------------------------------!
-#if defined( _OPENACC )
- SUBROUTINE exit_surface_attributes_v( surfaces )
-
-    IMPLICIT NONE
-
-    TYPE(surf_type) ::  surfaces  !< respective surface type
-
-    !$ACC EXIT DATA &
-    !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) &
-    !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) &
-    !$ACC DELETE(surfaces%i(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%j(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%k(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%ln_z_z0(1:surfaces%ns) ) &
-    !$ACC DELETE(surfaces%ln_z_z0h(1:surfaces%ns) ) &
-    !$ACC DELETE(surfaces%ln_z_z0q(1:surfaces%ns) ) &
-    !$ACC DELETE(surfaces%z0(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%z0h(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%z0q(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%rib(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%mom_flux_uv(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%mom_flux_w(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%mom_flux_tke(0:1,1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%ts(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%shf(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%pt1(1:surfaces%ns)) &
-    !$ACC DELETE(surfaces%qv1(1:surfaces%ns))
-
- END SUBROUTINE exit_surface_attributes_v
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Enter memory for vertical surface types.
-!--------------------------------------------------------------------------------------------------!
-#if defined( _OPENACC )
- SUBROUTINE enter_surface_attributes_v( surfaces )
-
-    IMPLICIT NONE
-
-    TYPE(surf_type) ::  surfaces  !< respective surface type
-
-    !$ACC ENTER DATA &
-    !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) &
-    !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) &
-    !$ACC COPYIN(surfaces%i(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%j(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%k(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%ln_z_z0(1:surfaces%ns) ) &
-    !$ACC COPYIN(surfaces%ln_z_z0h(1:surfaces%ns) ) &
-    !$ACC COPYIN(surfaces%ln_z_z0q(1:surfaces%ns) ) &
-    !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%z0h(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%z0q(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%rib(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%mom_flux_uv(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%mom_flux_w(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%mom_flux_tke(0:1,1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%ts(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%pt1(1:surfaces%ns)) &
-    !$ACC COPYIN(surfaces%qv1(1:surfaces%ns))
-
- END SUBROUTINE enter_surface_attributes_v
-#endif
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize surface elements, i.e. set initial values for surface fluxes, friction velocity,
-!> calcuation of start/end indices, etc. Please note, further initialization concerning special
-!> surface characteristics, e.g. soil- and vegatation type, building type, etc.,
-!> is done in the land-surface and urban-surface module, respectively.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_surfaces
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< running index x-direction
-    INTEGER(iwp) ::  j  !< running index y-direction
-    INTEGER(iwp) ::  k  !< running index z-direction
-    INTEGER(iwp) ::  kk !< auxiliary index z-direction
-    INTEGER(iwp) ::  l  !< direction index
-
-
-    INTEGER(iwp), DIMENSION(0:1)  ::  start_index_lsm_h !< dummy to determing local start index in surface type for given (j,i), for horizontal
-                                                        !< natural surfaces
-    INTEGER(iwp), DIMENSION(0:1)  ::  start_index_usm_h !< dummy to determing local start index in surface type for given (j,i), for horizontal
-                                                        !< urban surfaces
-    INTEGER(iwp), DIMENSION(0:1)  ::  num_lsm_h         !< current number of horizontal surface element, natural type
-    INTEGER(iwp), DIMENSION(0:1)  ::  num_lsm_h_kji     !< dummy to determing local end index in surface type for given (j,i), for for horizonal
-                                                        !< natural surfaces
-    INTEGER(iwp), DIMENSION(0:1)  ::  num_usm_h         !< current number of horizontal surface element, urban type
-    INTEGER(iwp), DIMENSION(0:1)  ::  num_usm_h_kji     !< dummy to determing local end index in surface type for given (j,i), for for horizonal urban
-                                                        !< surfaces
-
-    INTEGER(iwp), DIMENSION(0:2) ::  num_def_h          !< current number of horizontal surface element, default type
-    INTEGER(iwp), DIMENSION(0:2) ::  num_def_h_kji      !< dummy to determing local end index in surface type for given (j,i),
-                                                        !< for horizonal default surfaces
-    INTEGER(iwp), DIMENSION(0:2) ::  start_index_def_h  !< dummy to determing local start index in surface type for given (j,i),
-                                                        !< for horizontal default surfaces
-
-    INTEGER(iwp), DIMENSION(0:3) ::  num_def_v          !< current number of vertical surface element, default type
-    INTEGER(iwp), DIMENSION(0:3) ::  num_def_v_kji      !< dummy to determing local end index in surface type for given (j,i),
-                                                        !< for vertical default surfaces
-    INTEGER(iwp), DIMENSION(0:3) ::  num_lsm_v          !< current number of vertical surface element, natural type
-    INTEGER(iwp), DIMENSION(0:3) ::  num_lsm_v_kji      !< dummy to determing local end index in surface type for given (j,i),
-                                                        !< for vertical natural surfaces
-    INTEGER(iwp), DIMENSION(0:3) ::  num_usm_v          !< current number of vertical surface element, urban type
-    INTEGER(iwp), DIMENSION(0:3) ::  num_usm_v_kji      !< dummy to determing local end index in surface type for given (j,i),
-                                                        !< for vertical urban surfaces
-
-    INTEGER(iwp), DIMENSION(0:3) ::  start_index_def_v  !< dummy to determing local start index in surface type for given (j,i),
-                                                        !< for vertical default surfaces
-    INTEGER(iwp), DIMENSION(0:3) ::  start_index_lsm_v  !< dummy to determing local start index in surface type for given (j,i),
-                                                        !< for vertical natural surfaces
-    INTEGER(iwp), DIMENSION(0:3) ::  start_index_usm_v  !< dummy to determing local start index in surface type for given (j,i),
-                                                        !< for vertical urban surfaces
-
-    LOGICAL ::  building                                !< flag indicating building grid point
-    LOGICAL ::  terrain                                 !< flag indicating natural terrain grid point
-    LOGICAL ::  unresolved_building                     !< flag indicating a grid point where actually a building is defined but not resolved by the
-                                                        !< vertical grid
-!
-!-- Set offset indices, i.e. index difference between surface element and surface-bounded grid point.
-!-- Upward facing - no horizontal offsets
-    surf_def_h(0:2)%ioff = 0
-    surf_def_h(0:2)%joff = 0
-
-    surf_lsm_h(0:1)%ioff = 0
-    surf_lsm_h(0:1)%joff = 0
-
-    surf_usm_h(0:1)%ioff = 0
-    surf_usm_h(0:1)%joff = 0
-!
-!-- Upward facing vertical offsets
-    surf_def_h(0)%koff = -1
-    surf_lsm_h(0)%koff = -1
-    surf_usm_h(0)%koff = -1
-!
-!-- Downward facing vertical offset
-    surf_def_h(1:2)%koff = 1
-    surf_lsm_h(1)%koff   = 1
-    surf_usm_h(1)%koff   = 1
-!
-!-- Vertical surfaces - no vertical offset
-    surf_def_v(0:3)%koff = 0
-    surf_lsm_v(0:3)%koff = 0
-    surf_usm_v(0:3)%koff = 0
-!
-!-- North- and southward facing - no offset in x
-    surf_def_v(0:1)%ioff = 0
-    surf_lsm_v(0:1)%ioff = 0
-    surf_usm_v(0:1)%ioff = 0
-!
-!-- Northward facing offset in y
-    surf_def_v(0)%joff = -1
-    surf_lsm_v(0)%joff = -1
-    surf_usm_v(0)%joff = -1
-!
-!-- Southward facing offset in y
-    surf_def_v(1)%joff = 1
-    surf_lsm_v(1)%joff = 1
-    surf_usm_v(1)%joff = 1
-
-!
-!-- East- and westward facing - no offset in y
-    surf_def_v(2:3)%joff = 0
-    surf_lsm_v(2:3)%joff = 0
-    surf_usm_v(2:3)%joff = 0
-!
-!-- Eastward facing offset in x
-    surf_def_v(2)%ioff = -1
-    surf_lsm_v(2)%ioff = -1
-    surf_usm_v(2)%ioff = -1
-!
-!-- Westward facing offset in y
-    surf_def_v(3)%ioff = 1
-    surf_lsm_v(3)%ioff = 1
-    surf_usm_v(3)%ioff = 1
-
-!
-!-- Initialize surface attributes, store indicies, surfaces orientation, etc.,
-    num_def_h(0:2) = 1
-    num_def_v(0:3) = 1
-
-    num_lsm_h(0:1) = 1
-    num_lsm_v(0:3) = 1
-
-    num_usm_h(0:1) = 1
-    num_usm_v(0:3) = 1
-
-    start_index_def_h(0:2) = 1
-    start_index_def_v(0:3) = 1
-
-    start_index_lsm_h(0:1) = 1
-    start_index_lsm_v(0:3) = 1
-
-    start_index_usm_h(0:1) = 1
-    start_index_usm_v(0:3) = 1
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          num_def_h_kji = 0
-          num_def_v_kji = 0
-          num_lsm_h_kji = 0
-          num_lsm_v_kji = 0
-          num_usm_h_kji = 0
-          num_usm_v_kji = 0
-
-          DO  k = nzb+1, nzt
-!
-!--          Check if current gridpoint belongs to the atmosphere
-             IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )  THEN
-!
-!--             Check if grid point adjoins to any upward- and downward-facing horizontal surface,
-!--             e.g. the Earth surface, plane roofs, or ceilings.
-                DO kk = k-1, k+1, 2
-!
-!--                Check for top-fluxes first
-                   IF ( kk == nzt+1  .AND.  use_top_fluxes )  THEN
-                      CALL initialize_top( k, j, i, surf_def_h(2), num_def_h(2), num_def_h_kji(2) )
-                   ELSE
-!
-!--                   set direction index of the potential surface
-                      l = MERGE( 0, 1, kk == k-1 )
-!
-!--                   Upward- or donward facing surface. Distinguish between differet surface types.
-!--                   To do, think about method to flag natural and non-natural surfaces.
-                      IF ( .NOT. BTEST( wall_flags_total_0(kk,j,i), 0 ) )  THEN
-!
-!--                      Determine flags indicating terrain or building
-                         terrain  = BTEST( wall_flags_total_0(kk,j,i), 5 )  .OR.  topo_no_distinct
-                         building = BTEST( wall_flags_total_0(kk,j,i), 6 )  .OR.  topo_no_distinct
-!
-!--                      Unresolved_building indicates a surface with equal height as terrain but with a
-!--                      non-grid resolved building on top. These surfaces will be flagged as urban
-!--                      surfaces.
-                         unresolved_building = BTEST( wall_flags_total_0(kk,j,i), 5 ) .AND.       &
-                                               BTEST( wall_flags_total_0(kk,j,i), 6 )
-!
-!--                      Natural surface type
-                         IF ( land_surface  .AND.  terrain  .AND.  .NOT. unresolved_building )  THEN
-                            CALL initialize_horizontal_surfaces( k, j, i, surf_lsm_h(l), num_lsm_h(l), &
-                                                                 num_lsm_h_kji(l), .TRUE., .FALSE. )
-!
-!--                      Urban surface tpye
-                         ELSEIF ( urban_surface  .AND.  building )  THEN
-                            CALL initialize_horizontal_surfaces( k, j, i, surf_usm_h(l), num_usm_h(l), &
-                                                                 num_usm_h_kji(l), .TRUE., .FALSE. )
-!
-!--                      Default surface type
-                         ELSE
-                            CALL initialize_horizontal_surfaces( k, j, i, surf_def_h(l), num_def_h(l), &
-                                                                 num_def_h_kji(l), .TRUE., .FALSE. )
-                         ENDIF
-                      ENDIF
-                   ENDIF
-                ENDDO
-!
-!--             Check for vertical walls and, if required, initialize it.
-!               Start with northward-facing surface.
-                IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 ) )  THEN
-!
-!--                Determine flags indicating terrain or building
-                   terrain  = BTEST( wall_flags_total_0(k,j-1,i), 5 )  .OR.  topo_no_distinct
-                   building = BTEST( wall_flags_total_0(k,j-1,i), 6 )  .OR.  topo_no_distinct
-
-                   unresolved_building = BTEST( wall_flags_total_0(k,j-1,i), 5 )  .AND.            &
-                                         BTEST( wall_flags_total_0(k,j-1,i), 6 )
-
-                   IF ( land_surface  .AND.  terrain  .AND.  .NOT. unresolved_building )  THEN
-                      CALL initialize_vertical_surfaces( k, j, i, surf_lsm_v(0), num_lsm_v(0),     &
-                                                         num_lsm_v_kji(0), .FALSE., .FALSE.,       &
-                                                         .FALSE., .TRUE. )
-
-                   ELSEIF ( urban_surface  .AND.  building )  THEN
-                      CALL initialize_vertical_surfaces( k, j, i, surf_usm_v(0), num_usm_v(0),     &
-                                                         num_usm_v_kji(0), .FALSE., .FALSE.,       &
-                                                         .FALSE., .TRUE. )
-                   ELSE
-                      CALL initialize_vertical_surfaces( k, j, i, surf_def_v(0), num_def_v(0),     &
-                                                         num_def_v_kji(0), .FALSE., .FALSE.,       &
-                                                         .FALSE., .TRUE. )
-                   ENDIF
-                ENDIF
-!
-!--             Southward-facing surface
-                IF ( .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) )  THEN
-!
-!--                Determine flags indicating terrain or building
-                   terrain  = BTEST( wall_flags_total_0(k,j+1,i), 5 )  .OR.  topo_no_distinct
-                   building = BTEST( wall_flags_total_0(k,j+1,i), 6 )  .OR.  topo_no_distinct
-
-                   unresolved_building = BTEST( wall_flags_total_0(k,j+1,i), 5 )  .AND.            &
-                                         BTEST( wall_flags_total_0(k,j+1,i), 6 )
-
-                   IF ( land_surface  .AND.  terrain  .AND.  .NOT. unresolved_building )  THEN
-                      CALL initialize_vertical_surfaces( k, j, i, surf_lsm_v(1), num_lsm_v(1),     &
-                                                         num_lsm_v_kji(1), .FALSE., .FALSE.,       &
-                                                         .TRUE., .FALSE. )
-
-                   ELSEIF ( urban_surface  .AND.  building )  THEN
-                      CALL initialize_vertical_surfaces( k, j, i, surf_usm_v(1), num_usm_v(1),     &
-                                                         num_usm_v_kji(1), .FALSE., .FALSE.,       &
-                                                         .TRUE., .FALSE. )
-                   ELSE
-                      CALL initialize_vertical_surfaces( k, j, i, surf_def_v(1), num_def_v(1),     &
-                                                         num_def_v_kji(1), .FALSE., .FALSE.,       &
-                                                         .TRUE., .FALSE. )
-                   ENDIF
-                ENDIF
-!
-!--             Eastward-facing surface
-                IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 ) )  THEN
-!
-!--                Determine flags indicating terrain or building
-                   terrain  = BTEST( wall_flags_total_0(k,j,i-1), 5 )  .OR.  topo_no_distinct
-                   building = BTEST( wall_flags_total_0(k,j,i-1), 6 )  .OR.  topo_no_distinct
-
-                   unresolved_building = BTEST( wall_flags_total_0(k,j,i-1), 5 )  .AND.            &
-                                         BTEST( wall_flags_total_0(k,j,i-1), 6 )
-
-                   IF ( land_surface  .AND.  terrain  .AND.  .NOT. unresolved_building )  THEN
-                      CALL initialize_vertical_surfaces( k, j, i, surf_lsm_v(2), num_lsm_v(2),     &
-                                                         num_lsm_v_kji(2), .TRUE., .FALSE.,        &
-                                                         .FALSE., .FALSE. )
-
-                   ELSEIF ( urban_surface  .AND.  building )  THEN
-                      CALL initialize_vertical_surfaces( k, j, i, surf_usm_v(2), num_usm_v(2),     &
-                                                         num_usm_v_kji(2), .TRUE., .FALSE.,        &
-                                                         .FALSE., .FALSE. )
-                   ELSE
-                      CALL initialize_vertical_surfaces( k, j, i, surf_def_v(2), num_def_v(2),     &
-                                                         num_def_v_kji(2), .TRUE., .FALSE.,        &
-                                                         .FALSE., .FALSE. )
-                   ENDIF
-                ENDIF
-!
-!--             Westward-facing surface
-                IF ( .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) )  THEN
-!
-!--                Determine flags indicating terrain or building
-                   terrain  = BTEST( wall_flags_total_0(k,j,i+1), 5 )  .OR.  topo_no_distinct
-                   building = BTEST( wall_flags_total_0(k,j,i+1), 6 )  .OR.  topo_no_distinct
-
-                   unresolved_building = BTEST( wall_flags_total_0(k,j,i+1), 5 )  .AND.            &
-                                         BTEST( wall_flags_total_0(k,j,i+1), 6 )
-
-                   IF ( land_surface  .AND.  terrain  .AND.  .NOT. unresolved_building )  THEN
-                      CALL initialize_vertical_surfaces( k, j, i, surf_lsm_v(3), num_lsm_v(3),     &
-                                                         num_lsm_v_kji(3), .FALSE., .TRUE.,        &
-                                                        .FALSE., .FALSE. )
-
-                   ELSEIF ( urban_surface  .AND.  building )  THEN
-                      CALL initialize_vertical_surfaces( k, j, i, surf_usm_v(3), num_usm_v(3),     &
-                                                         num_usm_v_kji(3), .FALSE., .TRUE.,        &
-                                                        .FALSE., .FALSE. )
-                   ELSE
-                      CALL initialize_vertical_surfaces( k, j, i, surf_def_v(3), num_def_v(3),     &
-                                                         num_def_v_kji(3), .FALSE., .TRUE.,        &
-                                                        .FALSE., .FALSE. )
-                   ENDIF
-                ENDIF
-             ENDIF
-
-
-          ENDDO
-!
-!--       Determine start- and end-index at grid point (j,i). Also, for horizontal surfaces more
-!--       than 1 horizontal surface element can exist at grid point (j,i) if overhanging structures
-!--       are present.
-!--       Upward-facing surfaces
-          surf_def_h(0)%start_index(j,i) = start_index_def_h(0)
-          surf_def_h(0)%end_index(j,i)   = surf_def_h(0)%start_index(j,i) + num_def_h_kji(0) - 1
-          start_index_def_h(0)           = surf_def_h(0)%end_index(j,i) + 1
-!
-!--       ATTENTION:
-!--       Workaround to prevent vectorization bug on NEC Aurora
-          IF ( start_index_def_h(0) < -99999 )  THEN
-             PRINT*, 'i=', i, ' j=',j, ' s=',surf_def_h(0)%start_index(j,i),                       &
-                    ' e=', surf_def_h(0)%end_index(j,i)
-          ENDIF
-!
-!--       Downward-facing surfaces, except model top
-          surf_def_h(1)%start_index(j,i) = start_index_def_h(1)
-          surf_def_h(1)%end_index(j,i)   = surf_def_h(1)%start_index(j,i) + num_def_h_kji(1) - 1
-          start_index_def_h(1)           = surf_def_h(1)%end_index(j,i) + 1
-!
-!--       Downward-facing surfaces -- model top fluxes
-          surf_def_h(2)%start_index(j,i) = start_index_def_h(2)
-          surf_def_h(2)%end_index(j,i)   = surf_def_h(2)%start_index(j,i) + num_def_h_kji(2) - 1
-          start_index_def_h(2)           = surf_def_h(2)%end_index(j,i) + 1
-!
-!--       Upward- and downward-facing horizontal land and urban surfaces
-          DO l = 0, 1
-!
-!--          Horizontal natural land surfaces
-             surf_lsm_h(l)%start_index(j,i) = start_index_lsm_h(l)
-             surf_lsm_h(l)%end_index(j,i)   = surf_lsm_h(l)%start_index(j,i) + num_lsm_h_kji(l) - 1
-             start_index_lsm_h(l)           = surf_lsm_h(l)%end_index(j,i) + 1
-!
-!--          Horizontal urban surfaces
-             surf_usm_h(l)%start_index(j,i) = start_index_usm_h(l)
-             surf_usm_h(l)%end_index(j,i)   = surf_usm_h(l)%start_index(j,i) + num_usm_h_kji(l) - 1
-             start_index_usm_h(l)           = surf_usm_h(l)%end_index(j,i) + 1
-          ENDDO
-
-!
-!--       Vertical surfaces - Default type
-          surf_def_v(0)%start_index(j,i) = start_index_def_v(0)
-          surf_def_v(1)%start_index(j,i) = start_index_def_v(1)
-          surf_def_v(2)%start_index(j,i) = start_index_def_v(2)
-          surf_def_v(3)%start_index(j,i) = start_index_def_v(3)
-          surf_def_v(0)%end_index(j,i)   = start_index_def_v(0) + num_def_v_kji(0) - 1
-          surf_def_v(1)%end_index(j,i)   = start_index_def_v(1) + num_def_v_kji(1) - 1
-          surf_def_v(2)%end_index(j,i)   = start_index_def_v(2) + num_def_v_kji(2) - 1
-          surf_def_v(3)%end_index(j,i)   = start_index_def_v(3) + num_def_v_kji(3) - 1
-          start_index_def_v(0)           = surf_def_v(0)%end_index(j,i) + 1
-          start_index_def_v(1)           = surf_def_v(1)%end_index(j,i) + 1
-          start_index_def_v(2)           = surf_def_v(2)%end_index(j,i) + 1
-          start_index_def_v(3)           = surf_def_v(3)%end_index(j,i) + 1
-!
-!--       Natural type
-          surf_lsm_v(0)%start_index(j,i) = start_index_lsm_v(0)
-          surf_lsm_v(1)%start_index(j,i) = start_index_lsm_v(1)
-          surf_lsm_v(2)%start_index(j,i) = start_index_lsm_v(2)
-          surf_lsm_v(3)%start_index(j,i) = start_index_lsm_v(3)
-          surf_lsm_v(0)%end_index(j,i)   = start_index_lsm_v(0) + num_lsm_v_kji(0) - 1
-          surf_lsm_v(1)%end_index(j,i)   = start_index_lsm_v(1) + num_lsm_v_kji(1) - 1
-          surf_lsm_v(2)%end_index(j,i)   = start_index_lsm_v(2) + num_lsm_v_kji(2) - 1
-          surf_lsm_v(3)%end_index(j,i)   = start_index_lsm_v(3) + num_lsm_v_kji(3) - 1
-          start_index_lsm_v(0)           = surf_lsm_v(0)%end_index(j,i) + 1
-          start_index_lsm_v(1)           = surf_lsm_v(1)%end_index(j,i) + 1
-          start_index_lsm_v(2)           = surf_lsm_v(2)%end_index(j,i) + 1
-          start_index_lsm_v(3)           = surf_lsm_v(3)%end_index(j,i) + 1
-!
-!--       Urban type
-          surf_usm_v(0)%start_index(j,i) = start_index_usm_v(0)
-          surf_usm_v(1)%start_index(j,i) = start_index_usm_v(1)
-          surf_usm_v(2)%start_index(j,i) = start_index_usm_v(2)
-          surf_usm_v(3)%start_index(j,i) = start_index_usm_v(3)
-          surf_usm_v(0)%end_index(j,i)   = start_index_usm_v(0) + num_usm_v_kji(0) - 1
-          surf_usm_v(1)%end_index(j,i)   = start_index_usm_v(1) + num_usm_v_kji(1) - 1
-          surf_usm_v(2)%end_index(j,i)   = start_index_usm_v(2) + num_usm_v_kji(2) - 1
-          surf_usm_v(3)%end_index(j,i)   = start_index_usm_v(3) + num_usm_v_kji(3) - 1
-          start_index_usm_v(0)           = surf_usm_v(0)%end_index(j,i) + 1
-          start_index_usm_v(1)           = surf_usm_v(1)%end_index(j,i) + 1
-          start_index_usm_v(2)           = surf_usm_v(2)%end_index(j,i) + 1
-          start_index_usm_v(3)           = surf_usm_v(3)%end_index(j,i) + 1
-
-
-       ENDDO
-    ENDDO
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize horizontal surface elements, upward- and downward-facing. Note, horizontal surface
-!> type also comprises model-top fluxes, which are, initialized in a different routine.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE initialize_horizontal_surfaces( k, j, i, surf, num_h, num_h_kji, upward_facing,        &
-                                            downward_facing )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)  ::  i          !< running index x-direction
-    INTEGER(iwp)  ::  j          !< running index y-direction
-    INTEGER(iwp)  ::  k          !< running index z-direction
-    INTEGER(iwp)  ::  num_h      !< current number of surface element
-    INTEGER(iwp)  ::  num_h_kji  !< dummy increment
-    INTEGER(iwp)  ::  lsp        !< running index chemical species
-    INTEGER(iwp)  ::  lsp_pr     !< running index chemical species??
-
-    LOGICAL       ::  upward_facing    !< flag indicating upward-facing surface
-    LOGICAL       ::  downward_facing  !< flag indicating downward-facing surface
-
-    TYPE(surf_type) ::  surf  !< respective surface type
-
-!
-!-- Store indices of respective surface element
-    surf%i(num_h) = i
-    surf%j(num_h) = j
-    surf%k(num_h) = k
-!
-!-- Surface orientation, bit 0 is set to 1 for upward-facing surfaces, bit 1 is for downward-facing
-!-- surfaces.
-    IF ( upward_facing   )  surf%facing(num_h) = IBSET( surf%facing(num_h), 0 )
-    IF ( downward_facing )  surf%facing(num_h) = IBSET( surf%facing(num_h), 1 )
-!
-!-- Initialize surface-layer height
-    IF ( upward_facing )  THEN
-       surf%z_mo(num_h) = zu(k) - zw(k-1)
-    ELSE
-       surf%z_mo(num_h) = zw(k) - zu(k)
-    ENDIF
-
-    surf%z0(num_h)  = roughness_length
-    surf%z0h(num_h) = z0h_factor * roughness_length
-    surf%z0q(num_h) = z0h_factor * roughness_length
-!
-!-- Initialization in case of 1D pre-cursor run
-    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
-       IF ( .NOT. constant_diffusion )  THEN
-          IF ( constant_flux_layer )  THEN
-             surf%ol(num_h)   = surf%z_mo(num_h) / ( ri1d(nzb+1) + 1.0E-20_wp )
-             surf%us(num_h)   = us1d
-             surf%usws(num_h) = usws1d
-             surf%vsws(num_h) = vsws1d
-          ELSE
-             surf%ol(num_h)   = surf%z_mo(num_h) / zeta_min
-             surf%us(num_h)   = 0.0_wp
-             surf%usws(num_h) = 0.0_wp
-             surf%vsws(num_h) = 0.0_wp
-          ENDIF
-       ELSE
-          surf%ol(num_h)   = surf%z_mo(num_h) / zeta_min
-          surf%us(num_h)   = 0.0_wp
-          surf%usws(num_h) = 0.0_wp
-          surf%vsws(num_h) = 0.0_wp
-       ENDIF
-!
-!-- Initialization in all other cases
-    ELSE
-
-       surf%ol(num_h) = surf%z_mo(num_h) / zeta_min
-!
-!--    Very small number is required for calculation of Obukhov length at first timestep
-       surf%us(num_h)   = 1E-30_wp
-       surf%usws(num_h) = 0.0_wp
-       surf%vsws(num_h) = 0.0_wp
-
-    ENDIF
-
-    surf%rib(num_h)     = 0.0_wp
-    surf%uvw_abs(num_h) = 0.0_wp
-!
-!-- Initialize ln(z/z0)
-    surf%ln_z_z0(num_h)  = LOG( surf%z_mo(num_h) / surf%z0(num_h) )
-    surf%ln_z_z0h(num_h) = LOG( surf%z_mo(num_h) / surf%z0h(num_h) )
-    surf%ln_z_z0q(num_h) = LOG( surf%z_mo(num_h) / surf%z0q(num_h) )
-
-    IF ( .NOT. constant_diffusion )  THEN
-       surf%u_0(num_h) = 0.0_wp
-       surf%v_0(num_h) = 0.0_wp
-    ENDIF
-
-    surf%ts(num_h) = 0.0_wp
-!
-!-- Set initial value for surface temperature
-    surf%pt_surface(num_h) = pt_surface
-
-    IF ( humidity )  THEN
-       surf%qs(num_h)   = 0.0_wp
-       IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison)  THEN
-          surf%qcs(num_h) = 0.0_wp
-          surf%ncs(num_h) = 0.0_wp
-
-          surf%qcsws(num_h) = 0.0_wp
-          surf%ncsws(num_h) = 0.0_wp
-
-       ENDIF
-       IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert)  THEN
-          surf%qrs(num_h) = 0.0_wp
-          surf%nrs(num_h) = 0.0_wp
-
-          surf%qrsws(num_h) = 0.0_wp
-          surf%nrsws(num_h) = 0.0_wp
-
-          surf%pt1(num_h)  = 0.0_wp
-          surf%qv1(num_h)  = 0.0_wp
-          surf%vpt1(num_h) = 0.0_wp
-
-       ENDIF
-
-       IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase)  THEN
-          surf%qis(num_h) = 0.0_wp
-          surf%nis(num_h) = 0.0_wp
-
-          surf%qisws(num_h) = 0.0_wp
-          surf%nisws(num_h) = 0.0_wp
-       ENDIF
-
-
-       surf%q_surface(num_h)   = q_surface
-       surf%vpt_surface(num_h) = surf%pt_surface(num_h) *                                          &
-                                ( 1.0_wp + 0.61_wp * surf%q_surface(num_h) )
-    ENDIF
-
-    IF ( passive_scalar )  surf%ss(num_h) = 0.0_wp
-
-    DO  lsp = 1, nvar
-       IF ( air_chemistry )  surf%css(lsp,num_h)   = 0.0_wp
-!
-!--    Ensure that fluxes of compounds which are not specified in namelist are all zero
-!--    --> kanani: revise
-       IF ( air_chemistry )  surf%cssws(lsp,num_h) = 0.0_wp
-    ENDDO
-!
-!-- Inititalize surface fluxes of sensible and latent heat, as well as passive scalar
-    IF ( use_surface_fluxes )  THEN
-
-       IF ( upward_facing )  THEN
-          IF ( constant_heatflux )  THEN
-!
-!--          Initialize surface heatflux. However, skip this for now if random_heatflux is set.
-!--          This case, shf is initialized later.
-             IF ( .NOT. random_heatflux )  THEN
-                surf%shf(num_h) = surface_heatflux * heatflux_input_conversion(k-1)
-!
-!--             Check if surface heat flux might be replaced by prescribed wall heatflux
-                IF ( k-1 /= 0 )  THEN
-                   surf%shf(num_h) = wall_heatflux(0) * heatflux_input_conversion(k-1)
-                ENDIF
-             ENDIF
-          ELSE
-             surf%shf(num_h) = 0.0_wp
-          ENDIF
-!
-!--    Set heat-flux at downward-facing surfaces
-       ELSE
-          surf%shf(num_h) = wall_heatflux(5) * heatflux_input_conversion(k)
-       ENDIF
-
-       IF ( humidity )  THEN
-          IF ( upward_facing )  THEN
-             IF ( constant_waterflux )  THEN
-                surf%qsws(num_h) = surface_waterflux * waterflux_input_conversion(k-1)
-                IF ( k-1 /= 0 )  THEN
-                   surf%qsws(num_h) = wall_humidityflux(0) * waterflux_input_conversion(k-1)
-                ENDIF
-             ELSE
-                surf%qsws(num_h) = 0.0_wp
-             ENDIF
-          ELSE
-             surf%qsws(num_h) = wall_humidityflux(5) * waterflux_input_conversion(k)
-          ENDIF
-       ENDIF
-
-       IF ( passive_scalar )  THEN
-          IF ( upward_facing )  THEN
-             IF ( constant_scalarflux )  THEN
-                surf%ssws(num_h) = surface_scalarflux  * rho_air_zw(k-1)
-
-                IF ( k-1 /= 0 )  surf%ssws(num_h) = wall_scalarflux(0) * rho_air_zw(k-1)
-             ELSE
-                surf%ssws(num_h) = 0.0_wp
-             ENDIF
-          ELSE
-             surf%ssws(num_h) = wall_scalarflux(5) * rho_air_zw(k)
-          ENDIF
-       ENDIF
-
-       IF ( air_chemistry )  THEN
-          lsp_pr = 1
-          DO  WHILE ( TRIM( surface_csflux_name( lsp_pr ) ) /= 'novalue' ) !<'novalue' is the default
-             DO  lsp = 1, nvar
-!
-!--             Assign surface flux for each variable species
-                IF ( TRIM( spc_names(lsp) ) == TRIM( surface_csflux_name(lsp_pr) ) )  THEN
-                   IF ( upward_facing )  THEN
-                      IF ( constant_csflux(lsp_pr) )  THEN
-                         surf%cssws(lsp,num_h) = surface_csflux(lsp_pr) * rho_air_zw(k-1)
-
-                         IF ( k-1 /= 0 )  surf%cssws(lsp,num_h) = wall_csflux(lsp,0) *             &
-                                                                  rho_air_zw(k-1)
-                      ELSE
-                         surf%cssws(lsp,num_h) = 0.0_wp
-                      ENDIF
-                   ELSE
-                      surf%cssws(lsp,num_h) = wall_csflux(lsp,5) * rho_air_zw(k)
-                   ENDIF
-                ENDIF
-             ENDDO
-             lsp_pr = lsp_pr + 1
-          ENDDO
-       ENDIF
-
-       IF ( ocean_mode )  THEN
-          IF ( upward_facing )  THEN
-             surf%sasws(num_h) = bottom_salinityflux * rho_air_zw(k-1)
-          ELSE
-             surf%sasws(num_h) = 0.0_wp
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- Increment surface indices
-    num_h     = num_h + 1
-    num_h_kji = num_h_kji + 1
-
-
- END SUBROUTINE initialize_horizontal_surfaces
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize model-top fluxes. Currently, only the heatflux and salinity flux can be prescribed,
-!> latent flux is zero in this case!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE initialize_top( k, j, i, surf, num_h, num_h_kji )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)  ::  i          !< running index x-direction
-    INTEGER(iwp)  ::  j          !< running index y-direction
-    INTEGER(iwp)  ::  k          !< running index z-direction
-    INTEGER(iwp)  ::  num_h      !< current number of surface element
-    INTEGER(iwp)  ::  num_h_kji  !< dummy increment
-
-    TYPE( surf_type ) ::  surf   !< respective surface type
-!
-!-- Store indices of respective surface element
-    surf%i(num_h) = i
-    surf%j(num_h) = j
-    surf%k(num_h) = k
-!
-!-- Initialize top heat flux
-    IF ( constant_top_heatflux )  surf%shf(num_h) = top_heatflux * heatflux_input_conversion(nzt+1)
-!
-!-- Initialization in case of a coupled model run
-    IF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
-       surf%shf(num_h) = 0.0_wp
-       surf%qsws(num_h) = 0.0_wp
-    ENDIF
-!
-!-- Prescribe latent heat flux at the top
-    IF ( humidity )  THEN
-       surf%qsws(num_h) = 0.0_wp
-       IF ( surf_bulk_cloud_model  .AND.  surf_microphysics_morrison )  THEN
-          surf%ncsws(num_h) = 0.0_wp
-          surf%qcsws(num_h) = 0.0_wp
-       ENDIF
-       IF ( surf_bulk_cloud_model  .AND.  surf_microphysics_seifert )  THEN
-          surf%nrsws(num_h) = 0.0_wp
-          surf%qrsws(num_h) = 0.0_wp
-       ENDIF
-       IF ( surf_bulk_cloud_model  .AND.  surf_microphysics_ice_phase )  THEN
-          surf%nisws(num_h) = 0.0_wp
-          surf%qisws(num_h) = 0.0_wp
-       ENDIF
-    ENDIF
-!
-!-- Prescribe top scalar flux
-    IF ( passive_scalar .AND. constant_top_scalarflux )  surf%ssws(num_h) = top_scalarflux *       &
-                                                                            rho_air_zw(nzt+1)
-!
-!-- Prescribe top salinity flux
-    IF ( ocean_mode .AND. constant_top_salinityflux)  surf%sasws(num_h) = top_salinityflux *       &
-                                                                          rho_air_zw(nzt+1)
-!
-!-- Top momentum fluxes
-    IF ( constant_top_momentumflux )  THEN
-       surf%usws(num_h) = top_momentumflux_u * momentumflux_input_conversion(nzt+1)
-       surf%vsws(num_h) = top_momentumflux_v * momentumflux_input_conversion(nzt+1)
-    ENDIF
-!
-!-- Increment surface indices
-    num_h     = num_h + 1
-    num_h_kji = num_h_kji + 1
-
-
- END SUBROUTINE initialize_top
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize vertical surface elements.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE initialize_vertical_surfaces( k, j, i, surf, num_v, num_v_kji, east_facing,            &
-                                          west_facing, south_facing, north_facing )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  component  !< index of wall_fluxes_ array for respective orientation
-    INTEGER(iwp) ::  i          !< running index x-direction
-    INTEGER(iwp) ::  j          !< running index x-direction
-    INTEGER(iwp) ::  k          !< running index x-direction
-    INTEGER(iwp) ::  num_v      !< current number of surface element
-    INTEGER(iwp) ::  num_v_kji  !< current number of surface element at (j,i)
-    INTEGER(iwp) ::  lsp        !< running index for chemical species
-
-
-    LOGICAL ::  east_facing   !< flag indicating east-facing surfaces
-    LOGICAL ::  north_facing  !< flag indicating north-facing surfaces
-    LOGICAL ::  south_facing  !< flag indicating south-facing surfaces
-    LOGICAL ::  west_facing   !< flag indicating west-facing surfaces
-
-    TYPE( surf_type ) ::  surf  !< respective surface type
-
-!
-!-- Store indices of respective wall element
-    surf%i(num_v) = i
-    surf%j(num_v) = j
-    surf%k(num_v) = k
-!
-!-- Initialize surface-layer height, or more precisely, distance to surface
-    IF ( north_facing  .OR.  south_facing )  THEN
-       surf%z_mo(num_v) = 0.5_wp * dy
-    ELSE
-       surf%z_mo(num_v) = 0.5_wp * dx
-    ENDIF
-
-    surf%facing(num_v) = 0
-!
-!-- Surface orientation. Moreover, set component id to map wall_heatflux, etc., on surface type
-!-- (further below)
-    IF ( north_facing )  THEN
-       surf%facing(num_v) = 5 !IBSET( surf%facing(num_v), 0 )
-       component          = 4
-    ENDIF
-
-    IF ( south_facing )  THEN
-       surf%facing(num_v) = 6 !IBSET( surf%facing(num_v), 1 )
-       component          = 3
-    ENDIF
-
-    IF ( east_facing )  THEN
-       surf%facing(num_v) = 7 !IBSET( surf%facing(num_v), 2 )
-       component          = 2
-    ENDIF
-
-    IF ( west_facing )  THEN
-       surf%facing(num_v) = 8 !IBSET( surf%facing(num_v), 3 )
-       component          = 1
-    ENDIF
-
-
-    surf%z0(num_v)  = roughness_length
-    surf%z0h(num_v) = z0h_factor * roughness_length
-    surf%z0q(num_v) = z0h_factor * roughness_length
-
-    surf%us(num_v)  = 0.0_wp
-!
-!-- Initialize ln(z/z0)
-    surf%ln_z_z0(num_v)  = LOG( surf%z_mo(num_v) / surf%z0(num_v)  )
-    surf%ln_z_z0h(num_v) = LOG( surf%z_mo(num_v) / surf%z0h(num_v) )
-    surf%ln_z_z0q(num_v) = LOG( surf%z_mo(num_v) / surf%z0q(num_v) )
-!
-!-- If required, initialize Obukhov length
-    IF ( ALLOCATED( surf%ol ) )  surf%ol(num_v) = surf%z_mo(num_v) / zeta_min
-
-    surf%uvw_abs(num_v) = 0.0_wp
-    surf%mom_flux_uv(num_v) = 0.0_wp
-    surf%mom_flux_w(num_v) = 0.0_wp
-    surf%mom_flux_tke(0:1,num_v) = 0.0_wp
-
-    surf%ts(num_v)  = 0.0_wp
-    surf%shf(num_v) = wall_heatflux(component)
-!
-!-- Set initial value for surface temperature
-    surf%pt_surface(num_v) = pt_surface
-
-    IF ( humidity )  THEN
-       surf%qs(num_v) = 0.0_wp
-       surf%qsws(num_v) = wall_humidityflux(component)
-!
-!--    Following wall fluxes are assumed to be zero
-       IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison)  THEN
-          surf%qcs(num_v) = 0.0_wp
-          surf%ncs(num_v) = 0.0_wp
-          surf%qcsws(num_v) = 0.0_wp
-          surf%ncsws(num_v) = 0.0_wp
-       ENDIF
-       IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert)  THEN
-          surf%qrs(num_v) = 0.0_wp
-          surf%nrs(num_v) = 0.0_wp
-          surf%qrsws(num_v) = 0.0_wp
-          surf%nrsws(num_v) = 0.0_wp
-       ENDIF
-       IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase)  THEN
-          surf%qis(num_v) = 0.0_wp
-          surf%nis(num_v) = 0.0_wp
-          surf%qisws(num_v) = 0.0_wp
-          surf%nisws(num_v) = 0.0_wp
-       ENDIF
-    ENDIF
-
-    IF ( passive_scalar )  THEN
-       surf%ss(num_v) = 0.0_wp
-       surf%ssws(num_v) = wall_scalarflux(component)
-    ENDIF
-
-    IF ( air_chemistry )  THEN
-       DO  lsp = 1, nvar
-          surf%css(lsp,num_v) = 0.0_wp
-          surf%cssws(lsp,num_v) = wall_csflux(lsp,component)
-       ENDDO
-    ENDIF
-
-!
-!-- So far, salinityflux at vertical surfaces is simply zero at the moment
-    IF ( ocean_mode )  surf%sasws(num_v) = wall_salinityflux(component)
-!
-!-- Increment wall indices
-    num_v     = num_v + 1
-    num_v_kji = num_v_kji + 1
-
- END SUBROUTINE initialize_vertical_surfaces
-
- END SUBROUTINE init_surfaces
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize single surface properties from 2D input arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE init_single_surface_properties( var_surf, var_2d, ns, fill_value, index_space_i,       &
-                                            index_space_j )
-
-    INTEGER(iwp) ::  m   !< running index over surface elements
-    INTEGER(iwp) ::  ns  !< number of surface elements in var_surf
-
-    INTEGER(iwp), DIMENSION(1:ns) ::  index_space_i  !< grid indices along x direction where surface properties should be defined
-    INTEGER(iwp), DIMENSION(1:ns) ::  index_space_j  !< grid indices along y direction where surface properties should be defined
-
-    REAL(wp) ::  fill_value !< fill value in var_2d
-
-    REAL(wp), DIMENSION(1:ns) ::  var_surf  !< 1D surface variable that should be initialized
-    REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  var_2d  !< input variable
-
-    DO  m = 1, ns
-       IF ( var_2d(index_space_j(m),index_space_i(m)) /= fill_value )  THEN
-          var_surf(m) = var_2d(index_space_j(m),index_space_i(m))
-       ENDIF
-    ENDDO
-
- END SUBROUTINE init_single_surface_properties
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Gathers all surface elements with the same facing (but possibly different type) onto a surface
-!> type, and writes binary data into restart files.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_wrd_local
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1)             ::  dum            !< dummy string to create output-variable name
-
-    INTEGER(iwp)                 ::  i              !< running index x-direction
-    INTEGER(iwp)                 ::  j              !< running index y-direction
-    INTEGER(iwp)                 ::  l              !< index surface type orientation
-    INTEGER(iwp)                 ::  lsp            !< running index chemical species
-    INTEGER(iwp)                 ::  m              !< running index for surface elements on individual surface array
-    INTEGER(iwp), DIMENSION(0:2) ::  start_index_h  !< start index for horizontal surface elements on gathered surface array
-    INTEGER(iwp), DIMENSION(0:3) ::  mm             !< running index for surface elements on gathered surface array
-    INTEGER(iwp), DIMENSION(0:3) ::  start_index_v  !< start index for vertical surface elements on gathered surface array
-
-    INTEGER(iwp),DIMENSION(nys:nyn,nxl:nxr) ::  global_end_index    !< end index for surface data (MPI-IO)
-    INTEGER(iwp),DIMENSION(nys:nyn,nxl:nxr) ::  global_start_index  !< start index for surface data (MPI-IO)
-
-    LOGICAL ::  surface_data_to_write  !< switch for MPI-I/O if PE has surface data to write
-
-    TYPE(surf_type), DIMENSION(0:2) ::  surf_h  !< gathered horizontal surfaces, contains all surface types
-    TYPE(surf_type), DIMENSION(0:3) ::  surf_v  !< gathered vertical surfaces, contains all surface types
-
-!
-!-- Determine total number of horizontal and vertical surface elements before writing var_list
-    CALL surface_last_actions
-!
-!-- Count number of grid points with same facing and allocate attributes respectively
-!-- Horizontal upward facing
-    surf_h(0)%ns = ns_h_on_file(0)
-    CALL allocate_surface_attributes_h( surf_h(0), nys, nyn, nxl, nxr )
-!
-!-- Horizontal downward facing
-    surf_h(1)%ns = ns_h_on_file(1)
-    CALL allocate_surface_attributes_h( surf_h(1), nys, nyn, nxl, nxr )
-!
-!-- Model top
-    surf_h(2)%ns = ns_h_on_file(2)
-    CALL allocate_surface_attributes_h_top( surf_h(2), nys, nyn, nxl, nxr )
-!
-!-- Vertical surfaces
-    DO  l = 0, 3
-       surf_v(l)%ns = ns_v_on_file(l)
-       CALL allocate_surface_attributes_v( surf_v(l), nys, nyn, nxl, nxr )
-    ENDDO
-!
-!-- In the following, gather data from surfaces elements with the same facing (but possibly differt
-!-- type) on 1 data-type array.
-    mm(0:2) = 1
-    DO  l = 0, 2
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  m = surf_def_h(l)%start_index(j,i), surf_def_h(l)%end_index(j,i)
-                IF ( ALLOCATED( surf_def_h(l)%us ) )  surf_h(l)%us(mm(l)) = surf_def_h(l)%us(m)
-                IF ( ALLOCATED( surf_def_h(l)%ts ) )  surf_h(l)%ts(mm(l)) = surf_def_h(l)%ts(m)
-                IF ( ALLOCATED( surf_def_h(l)%qs ) )  surf_h(l)%qs(mm(l)) = surf_def_h(l)%qs(m)
-                IF ( ALLOCATED( surf_def_h(l)%ss ) )  surf_h(l)%ss(mm(l)) = surf_def_h(l)%ss(m)
-                IF ( ALLOCATED( surf_def_h(l)%qcs ) )  surf_h(l)%qcs(mm(l)) = surf_def_h(l)%qcs(m)
-                IF ( ALLOCATED( surf_def_h(l)%ncs ) )  surf_h(l)%ncs(mm(l)) = surf_def_h(l)%ncs(m)
-                IF ( ALLOCATED( surf_def_h(l)%qis ) )  surf_h(l)%qis(mm(l)) = surf_def_h(l)%qis(m)
-                IF ( ALLOCATED( surf_def_h(l)%nis ) )  surf_h(l)%nis(mm(l)) = surf_def_h(l)%nis(m)
-                IF ( ALLOCATED( surf_def_h(l)%qrs ) )  surf_h(l)%qrs(mm(l)) = surf_def_h(l)%qrs(m)
-                IF ( ALLOCATED( surf_def_h(l)%nrs ) )  surf_h(l)%nrs(mm(l)) = surf_def_h(l)%nrs(m)
-                IF ( ALLOCATED( surf_def_h(l)%ol ) )  surf_h(l)%ol(mm(l)) = surf_def_h(l)%ol(m)
-                IF ( ALLOCATED( surf_def_h(l)%rib ) )  surf_h(l)%rib(mm(l)) = surf_def_h(l)%rib(m)
-                IF ( ALLOCATED( surf_def_h(l)%pt_surface ) )                                       &
-                   surf_h(l)%pt_surface(mm(l)) = surf_def_h(l)%pt_surface(m)
-                IF ( ALLOCATED( surf_def_h(l)%q_surface ) )                                        &
-                   surf_h(l)%q_surface(mm(l)) = surf_def_h(l)%q_surface(m)
-                IF ( ALLOCATED( surf_def_h(l)%vpt_surface ) )                                      &
-                   surf_h(l)%vpt_surface(mm(l)) = surf_def_h(l)%vpt_surface(m)
-                IF ( ALLOCATED( surf_def_h(l)%usws ) )  surf_h(l)%usws(mm(l)) = surf_def_h(l)%usws(m)
-                IF ( ALLOCATED( surf_def_h(l)%vsws ) )  surf_h(l)%vsws(mm(l)) = surf_def_h(l)%vsws(m)
-                IF ( ALLOCATED( surf_def_h(l)%shf ) )  surf_h(l)%shf(mm(l)) = surf_def_h(l)%shf(m)
-                IF ( ALLOCATED( surf_def_h(l)%qsws ) )  surf_h(l)%qsws(mm(l)) = surf_def_h(l)%qsws(m)
-                IF ( ALLOCATED( surf_def_h(l)%ssws ) )  surf_h(l)%ssws(mm(l)) = surf_def_h(l)%ssws(m)
-                IF ( ALLOCATED( surf_def_h(l)%css ) )  THEN
-                   DO  lsp = 1,nvar
-                      surf_h(l)%css(lsp,mm(l)) = surf_def_h(l)%css(lsp,m)
-                   ENDDO
-                ENDIF
-                IF ( ALLOCATED( surf_def_h(l)%cssws ) )  THEN
-                   DO  lsp = 1,nvar
-                      surf_h(l)%cssws(lsp,mm(l)) = surf_def_h(l)%cssws(lsp,m)
-                   ENDDO
-                ENDIF
-                IF ( ALLOCATED( surf_def_h(l)%qcsws ) )                                            &
-                   surf_h(l)%qcsws(mm(l)) = surf_def_h(l)%qcsws(m)
-                IF ( ALLOCATED( surf_def_h(l)%qrsws ) )                                            &
-                   surf_h(l)%qrsws(mm(l)) = surf_def_h(l)%qrsws(m)
-                IF ( ALLOCATED( surf_def_h(l)%qisws ) )                                            &
-                   surf_h(l)%qisws(mm(l)) = surf_def_h(l)%qisws(m)
-                IF ( ALLOCATED( surf_def_h(l)%ncsws ) )                                            &
-                   surf_h(l)%ncsws(mm(l)) = surf_def_h(l)%ncsws(m)
-                IF ( ALLOCATED( surf_def_h(l)%nisws ) )                                            &
-                   surf_h(l)%nisws(mm(l)) = surf_def_h(l)%nisws(m)
-                IF ( ALLOCATED( surf_def_h(l)%nrsws ) )                                            &
-                   surf_h(l)%nrsws(mm(l)) = surf_def_h(l)%nrsws(m)
-                IF ( ALLOCATED( surf_def_h(l)%sasws ) )                                            &
-                   surf_h(l)%sasws(mm(l)) = surf_def_h(l)%sasws(m)
-
-                mm(l) = mm(l) + 1
-             ENDDO
-
-             IF ( l < 2 )  THEN
-                DO  m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i)
-                   IF ( ALLOCATED( surf_lsm_h(l)%us ) )  surf_h(l)%us(mm(l)) = surf_lsm_h(l)%us(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%ts ) )  surf_h(l)%ts(mm(l)) = surf_lsm_h(l)%ts(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%qs ) )  surf_h(l)%qs(mm(l)) = surf_lsm_h(l)%qs(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%ss ) )  surf_h(l)%ss(mm(l)) = surf_lsm_h(l)%ss(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%qcs ) )  surf_h(l)%qcs(mm(l)) = surf_lsm_h(l)%qcs(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%ncs ) )  surf_h(l)%ncs(mm(l)) = surf_lsm_h(l)%ncs(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%qis ) )  surf_h(l)%qis(mm(l)) = surf_lsm_h(l)%qis(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%nis ) )  surf_h(l)%nis(mm(l)) = surf_lsm_h(l)%nis(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%qrs ) )  surf_h(l)%qrs(mm(l)) = surf_lsm_h(l)%qrs(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%nrs ) )  surf_h(l)%nrs(mm(l)) = surf_lsm_h(l)%nrs(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%ol ) )  surf_h(l)%ol(mm(l)) = surf_lsm_h(l)%ol(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%rib ) )  surf_h(l)%rib(mm(l)) = surf_lsm_h(l)%rib(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%pt_surface ) )                                       &
-                      surf_h(l)%pt_surface(mm(l)) = surf_lsm_h(l)%pt_surface(m)
-                   IF ( ALLOCATED( surf_def_h(l)%q_surface ) )                                        &
-                      surf_h(l)%q_surface(mm(l)) = surf_lsm_h(l)%q_surface(m)
-                   IF ( ALLOCATED( surf_def_h(l)%vpt_surface ) )                                      &
-                      surf_h(l)%vpt_surface(mm(l)) = surf_lsm_h(l)%vpt_surface(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%usws ) )  surf_h(l)%usws(mm(l)) = surf_lsm_h(l)%usws(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%vsws ) )  surf_h(l)%vsws(mm(l)) = surf_lsm_h(l)%vsws(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%shf ) )  surf_h(l)%shf(mm(l)) = surf_lsm_h(l)%shf(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%qsws ) )  surf_h(l)%qsws(mm(l)) = surf_lsm_h(l)%qsws(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%ssws ) )  surf_h(l)%ssws(mm(l)) = surf_lsm_h(l)%ssws(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%css ) )  THEN
-                      DO  lsp = 1, nvar
-                         surf_h(l)%css(lsp,mm(l)) = surf_lsm_h(l)%css(lsp,m)
-                      ENDDO
-                   ENDIF
-                   IF ( ALLOCATED( surf_lsm_h(l)%cssws ) )  THEN
-                      DO  lsp = 1, nvar
-                         surf_h(l)%cssws(lsp,mm(l)) = surf_lsm_h(l)%cssws(lsp,m)
-                      ENDDO
-                   ENDIF
-                   IF ( ALLOCATED( surf_lsm_h(l)%qcsws ) )                                            &
-                      surf_h(l)%qcsws(mm(l)) = surf_lsm_h(l)%qcsws(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%qisws ) )                                            &
-                      surf_h(l)%qisws(mm(l)) = surf_lsm_h(l)%qisws(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%qrsws ) )                                            &
-                      surf_h(l)%qrsws(mm(l)) = surf_lsm_h(l)%qrsws(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%ncsws ) )                                            &
-                      surf_h(l)%ncsws(mm(l)) = surf_lsm_h(l)%ncsws(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%nisws ) )                                            &
-                      surf_h(l)%nisws(mm(l)) = surf_lsm_h(l)%nisws(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%nrsws ) )                                            &
-                      surf_h(l)%nrsws(mm(l)) = surf_lsm_h(l)%nrsws(m)
-                   IF ( ALLOCATED( surf_lsm_h(l)%sasws ) )                                            &
-                     surf_h(l)%sasws(mm(l)) = surf_lsm_h(l)%sasws(m)
-
-                   mm(l) = mm(l) + 1
-
-                ENDDO
-
-                DO  m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i)
-                   IF ( ALLOCATED( surf_usm_h(l)%us ) )                                               &
-                      surf_h(l)%us(mm(l)) = surf_usm_h(l)%us(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%ts ) )                                               &
-                      surf_h(l)%ts(mm(l)) = surf_usm_h(l)%ts(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%qs ) )                                               &
-                      surf_h(l)%qs(mm(l)) = surf_usm_h(l)%qs(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%ss ) )                                               &
-                      surf_h(l)%ss(mm(l)) = surf_usm_h(l)%ss(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%qcs ) )                                              &
-                      surf_h(l)%qcs(mm(l)) = surf_usm_h(l)%qcs(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%ncs ) )                                              &
-                      surf_h(l)%ncs(mm(l)) = surf_usm_h(l)%ncs(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%qis ) )                                              &
-                      surf_h(l)%qis(mm(l)) = surf_usm_h(l)%qis(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%nis ) )                                              &
-                      surf_h(l)%nis(mm(l)) = surf_usm_h(l)%nis(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%qrs ) )                                              &
-                      surf_h(l)%qrs(mm(l)) = surf_usm_h(l)%qrs(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%nrs ) )                                              &
-                      surf_h(l)%nrs(mm(l)) = surf_usm_h(l)%nrs(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%ol ) )                                               &
-                      surf_h(l)%ol(mm(l)) = surf_usm_h(l)%ol(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%rib ) )                                              &
-                      surf_h(l)%rib(mm(l)) = surf_usm_h(l)%rib(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%pt_surface ) )                                       &
-                      surf_h(l)%pt_surface(mm(l)) = surf_usm_h(l)%pt_surface(m)
-                    IF ( ALLOCATED( surf_usm_h(l)%q_surface ) )                                       &
-                      surf_h(l)%q_surface(mm(l)) = surf_usm_h(l)%q_surface(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%vpt_surface ) )                                      &
-                      surf_h(l)%vpt_surface(mm(l)) = surf_usm_h(l)%vpt_surface(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%usws ) )                                             &
-                      surf_h(l)%usws(mm(l)) = surf_usm_h(l)%usws(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%vsws ) )                                             &
-                      surf_h(l)%vsws(mm(l)) = surf_usm_h(l)%vsws(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%shf ) )                                              &
-                      surf_h(l)%shf(mm(l)) = surf_usm_h(l)%shf(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%qsws ) )                                             &
-                      surf_h(l)%qsws(mm(l)) = surf_usm_h(l)%qsws(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%ssws ) )                                             &
-                      surf_h(l)%ssws(mm(l)) = surf_usm_h(l)%ssws(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%css ) )  THEN
-                      DO lsp = 1, nvar
-                         surf_h(l)%css(lsp,mm(l)) = surf_usm_h(l)%css(lsp,m)
-                      ENDDO
-                   ENDIF
-                   IF ( ALLOCATED( surf_usm_h(l)%cssws ) )  THEN
-                      DO lsp = 1, nvar
-                         surf_h(l)%cssws(lsp,mm(l)) = surf_usm_h(l)%cssws(lsp,m)
-                      ENDDO
-                   ENDIF
-                   IF ( ALLOCATED( surf_usm_h(l)%qcsws ) )                                            &
-                      surf_h(l)%qcsws(mm(l)) = surf_usm_h(l)%qcsws(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%qisws ) )                                            &
-                      surf_h(l)%qisws(mm(l)) = surf_usm_h(l)%qisws(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%qrsws ) )                                            &
-                      surf_h(l)%qrsws(mm(l)) = surf_usm_h(l)%qrsws(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%ncsws ) )                                            &
-                      surf_h(l)%ncsws(mm(l))   = surf_usm_h(l)%ncsws(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%nrsws ) )                                            &
-                      surf_h(l)%nrsws(mm(l)) = surf_usm_h(l)%nrsws(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%nisws ) )                                            &
-                      surf_h(l)%nisws(mm(l)) = surf_usm_h(l)%nisws(m)
-                   IF ( ALLOCATED( surf_usm_h(l)%sasws ) )                                            &
-                     surf_h(l)%sasws(mm(l)) = surf_usm_h(l)%sasws(m)
-
-                   mm(l) = mm(l) + 1
-
-                ENDDO
-
-
-             ENDIF
-
-          ENDDO
-
-       ENDDO
-!
-!--    Recalculate start- and end indices for gathered surface type.
-       start_index_h(l) = 1
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-
-             surf_h(l)%start_index(j,i) = start_index_h(l)
-             surf_h(l)%end_index(j,i) = surf_h(l)%start_index(j,i) - 1
-
-             DO  m = surf_def_h(l)%start_index(j,i), surf_def_h(l)%end_index(j,i)
-                surf_h(l)%end_index(j,i) = surf_h(l)%end_index(j,i) + 1
-             ENDDO
-             IF ( l < 2 )  THEN
-                DO  m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i)
-                   surf_h(l)%end_index(j,i) = surf_h(l)%end_index(j,i) + 1
-                ENDDO
-                DO  m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i)
-                   surf_h(l)%end_index(j,i) = surf_h(l)%end_index(j,i) + 1
-                ENDDO
-             ENDIF
-
-             start_index_h(l) = surf_h(l)%end_index(j,i) + 1
-
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Treat vertically orientated surface. Again, gather data from different surfaces types but
-!-- identical orientation (e.g. northward-facing) onto one surface type which is output afterwards.
-    mm(0:3) = 1
-    DO  l = 0, 3
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  m = surf_def_v(l)%start_index(j,i), surf_def_v(l)%end_index(j,i)
-                IF ( ALLOCATED( surf_def_v(l)%us ) )                                               &
-                   surf_v(l)%us(mm(l)) = surf_def_v(l)%us(m)
-                IF ( ALLOCATED( surf_def_v(l)%ts ) )                                               &
-                   surf_v(l)%ts(mm(l)) = surf_def_v(l)%ts(m)
-                IF ( ALLOCATED( surf_def_v(l)%qs ) )                                               &
-                   surf_v(l)%qs(mm(l)) = surf_def_v(l)%qs(m)
-                IF ( ALLOCATED( surf_def_v(l)%ss ) )                                               &
-                   surf_v(l)%ss(mm(l)) = surf_def_v(l)%ss(m)
-                IF ( ALLOCATED( surf_def_v(l)%qcs ) )                                              &
-                   surf_v(l)%qcs(mm(l)) = surf_def_v(l)%qcs(m)
-                IF ( ALLOCATED( surf_def_v(l)%ncs ) )                                              &
-                   surf_v(l)%ncs(mm(l)) = surf_def_v(l)%ncs(m)
-                IF ( ALLOCATED( surf_def_v(l)%qis ) )                                              &
-                   surf_v(l)%qis(mm(l)) = surf_def_v(l)%qis(m)
-                IF ( ALLOCATED( surf_def_v(l)%nis ) )                                              &
-                   surf_v(l)%nis(mm(l)) = surf_def_v(l)%nis(m)
-                IF ( ALLOCATED( surf_def_v(l)%qrs ) )                                              &
-                   surf_v(l)%qrs(mm(l)) = surf_def_v(l)%qrs(m)
-                IF ( ALLOCATED( surf_def_v(l)%nrs ) )                                              &
-                   surf_v(l)%nrs(mm(l)) = surf_def_v(l)%nrs(m)
-                IF ( ALLOCATED( surf_def_v(l)%ol ) )                                               &
-                   surf_v(l)%ol(mm(l)) = surf_def_v(l)%ol(m)
-                IF ( ALLOCATED( surf_def_v(l)%rib ) )                                              &
-                   surf_v(l)%rib(mm(l)) = surf_def_v(l)%rib(m)
-                IF ( ALLOCATED( surf_def_v(l)%pt_surface ) )                                       &
-                   surf_v(l)%pt_surface(mm(l)) = surf_def_v(l)%pt_surface(m)
-                IF ( ALLOCATED( surf_def_v(l)%q_surface ) )                                        &
-                   surf_v(l)%q_surface(mm(l)) = surf_def_v(l)%q_surface(m)
-                IF ( ALLOCATED( surf_def_v(l)%vpt_surface ) )                                      &
-                   surf_v(l)%vpt_surface(mm(l)) = surf_def_v(l)%vpt_surface(m)
-                IF ( ALLOCATED( surf_def_v(l)%shf ) )                                              &
-                   surf_v(l)%shf(mm(l)) = surf_def_v(l)%shf(m)
-                IF ( ALLOCATED( surf_def_v(l)%qsws ) )                                             &
-                   surf_v(l)%qsws(mm(l)) = surf_def_v(l)%qsws(m)
-                IF ( ALLOCATED( surf_def_v(l)%ssws ) )                                             &
-                   surf_v(l)%ssws(mm(l)) = surf_def_v(l)%ssws(m)
-                IF ( ALLOCATED( surf_def_v(l)%css ) )  THEN
-                   DO  lsp = 1, nvar
-                      surf_v(l)%css(lsp,mm(l)) = surf_def_v(l)%css(lsp,m)
-                   ENDDO
-                ENDIF
-                IF ( ALLOCATED( surf_def_v(l)%cssws ) )  THEN
-                   DO  lsp = 1, nvar
-                      surf_v(l)%cssws(lsp,mm(l)) = surf_def_v(l)%cssws(lsp,m)
-                   ENDDO
-                ENDIF
-                IF ( ALLOCATED( surf_def_v(l)%qcsws ) )                                            &
-                   surf_v(l)%qcsws(mm(l)) = surf_def_v(l)%qcsws(m)
-                IF ( ALLOCATED( surf_def_v(l)%qisws ) )                                            &
-                   surf_v(l)%qisws(mm(l)) = surf_def_v(l)%qisws(m)
-                IF ( ALLOCATED( surf_def_v(l)%qrsws ) )                                            &
-                   surf_v(l)%qrsws(mm(l)) = surf_def_v(l)%qrsws(m)
-                IF ( ALLOCATED( surf_def_v(l)%ncsws ) )                                            &
-                   surf_v(l)%ncsws(mm(l)) = surf_def_v(l)%ncsws(m)
-                IF ( ALLOCATED( surf_def_v(l)%nisws ) )                                            &
-                   surf_v(l)%nisws(mm(l)) = surf_def_v(l)%nisws(m)
-                IF ( ALLOCATED( surf_def_v(l)%nrsws ) )                                            &
-                   surf_v(l)%nrsws(mm(l)) = surf_def_v(l)%nrsws(m)
-                IF ( ALLOCATED( surf_def_v(l)%sasws ) )                                            &
-                   surf_v(l)%sasws(mm(l)) = surf_def_v(l)%sasws(m)
-                IF ( ALLOCATED( surf_def_v(l)%mom_flux_uv) )                                       &
-                   surf_v(l)%mom_flux_uv(mm(l)) = surf_def_v(l)%mom_flux_uv(m)
-                IF ( ALLOCATED( surf_def_v(l)%mom_flux_w) )                                        &
-                   surf_v(l)%mom_flux_w(mm(l)) = surf_def_v(l)%mom_flux_w(m)
-                IF ( ALLOCATED( surf_def_v(l)%mom_flux_tke) )                                      &
-                   surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_def_v(l)%mom_flux_tke(0:1,m)
-
-                mm(l) = mm(l) + 1
-             ENDDO
-
-             DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
-                IF ( ALLOCATED( surf_lsm_v(l)%us ) )                                               &
-                   surf_v(l)%us(mm(l)) = surf_lsm_v(l)%us(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%ts ) )                                               &
-                   surf_v(l)%ts(mm(l)) = surf_lsm_v(l)%ts(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%qs ) )                                               &
-                   surf_v(l)%qs(mm(l)) = surf_lsm_v(l)%qs(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%ss ) )                                               &
-                   surf_v(l)%ss(mm(l)) = surf_lsm_v(l)%ss(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%qcs ) )                                              &
-                   surf_v(l)%qcs(mm(l)) = surf_lsm_v(l)%qcs(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%ncs ) )                                              &
-                   surf_v(l)%ncs(mm(l)) = surf_lsm_v(l)%ncs(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%qis ) )                                              &
-                   surf_v(l)%qis(mm(l)) = surf_lsm_v(l)%qis(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%nis ) )                                              &
-                   surf_v(l)%nis(mm(l)) = surf_lsm_v(l)%nis(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%qrs ) )                                              &
-                   surf_v(l)%qrs(mm(l)) = surf_lsm_v(l)%qrs(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%nrs ) )                                              &
-                   surf_v(l)%nrs(mm(l)) = surf_lsm_v(l)%nrs(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%ol ) )                                               &
-                   surf_v(l)%ol(mm(l)) = surf_lsm_v(l)%ol(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%rib ) )                                              &
-                   surf_v(l)%rib(mm(l)) = surf_lsm_v(l)%rib(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%pt_surface ) )                                       &
-                   surf_v(l)%pt_surface(mm(l)) = surf_lsm_v(l)%pt_surface(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%q_surface ) )                                        &
-                   surf_v(l)%q_surface(mm(l)) = surf_lsm_v(l)%q_surface(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%vpt_surface ) )                                      &
-                   surf_v(l)%vpt_surface(mm(l)) = surf_lsm_v(l)%vpt_surface(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%usws ) )                                             &
-                   surf_v(l)%usws(mm(l)) = surf_lsm_v(l)%usws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%vsws ) )                                             &
-                   surf_v(l)%vsws(mm(l)) = surf_lsm_v(l)%vsws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%shf ) )                                              &
-                   surf_v(l)%shf(mm(l)) = surf_lsm_v(l)%shf(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%qsws ) )                                             &
-                   surf_v(l)%qsws(mm(l)) = surf_lsm_v(l)%qsws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%ssws ) )                                             &
-                   surf_v(l)%ssws(mm(l)) = surf_lsm_v(l)%ssws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%css ) )  THEN
-                   DO  lsp = 1, nvar
-                      surf_v(l)%css(lsp,mm(l)) = surf_lsm_v(l)%css(lsp,m)
-                   ENDDO
-                ENDIF
-                IF ( ALLOCATED( surf_lsm_v(l)%cssws ) )  THEN
-                   DO  lsp = 1, nvar
-                      surf_v(l)%cssws(lsp,mm(l)) = surf_lsm_v(l)%cssws(lsp,m)
-                   ENDDO
-                ENDIF
-                IF ( ALLOCATED( surf_lsm_v(l)%qcsws ) )                                            &
-                   surf_v(l)%qcsws(mm(l)) = surf_lsm_v(l)%qcsws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%qrsws ) )                                            &
-                   surf_v(l)%qrsws(mm(l)) = surf_lsm_v(l)%qrsws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%qisws ) )                                            &
-                   surf_v(l)%qisws(mm(l)) = surf_lsm_v(l)%qisws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%ncsws ) )                                            &
-                   surf_v(l)%ncsws(mm(l)) = surf_lsm_v(l)%ncsws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%nisws ) )                                            &
-                   surf_v(l)%nisws(mm(l)) = surf_lsm_v(l)%nisws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%nrsws ) )                                            &
-                   surf_v(l)%nrsws(mm(l)) = surf_lsm_v(l)%nrsws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%sasws ) )                                            &
-                   surf_v(l)%sasws(mm(l)) = surf_lsm_v(l)%sasws(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_uv) )                                       &
-                   surf_v(l)%mom_flux_uv(mm(l)) = surf_lsm_v(l)%mom_flux_uv(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_w) )                                        &
-                   surf_v(l)%mom_flux_w(mm(l)) = surf_lsm_v(l)%mom_flux_w(m)
-                IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_tke) )                                      &
-                   surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_lsm_v(l)%mom_flux_tke(0:1,m)
-
-                mm(l) = mm(l) + 1
-             ENDDO
-
-             DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
-                IF ( ALLOCATED( surf_usm_v(l)%us ) )                                               &
-                   surf_v(l)%us(mm(l)) = surf_usm_v(l)%us(m)
-                IF ( ALLOCATED( surf_usm_v(l)%ts ) )                                               &
-                   surf_v(l)%ts(mm(l)) = surf_usm_v(l)%ts(m)
-                IF ( ALLOCATED( surf_usm_v(l)%qs ) )                                               &
-                   surf_v(l)%qs(mm(l)) = surf_usm_v(l)%qs(m)
-                IF ( ALLOCATED( surf_usm_v(l)%ss ) )                                               &
-                   surf_v(l)%ss(mm(l)) = surf_usm_v(l)%ss(m)
-                IF ( ALLOCATED( surf_usm_v(l)%qcs ) )                                              &
-                   surf_v(l)%qcs(mm(l)) = surf_usm_v(l)%qcs(m)
-                IF ( ALLOCATED( surf_usm_v(l)%ncs ) )                                              &
-                   surf_v(l)%ncs(mm(l)) = surf_usm_v(l)%ncs(m)
-                IF ( ALLOCATED( surf_usm_v(l)%qis ) )                                              &
-                   surf_v(l)%qis(mm(l)) = surf_usm_v(l)%qis(m)
-                IF ( ALLOCATED( surf_usm_v(l)%nis ) )                                              &
-                   surf_v(l)%nis(mm(l)) = surf_usm_v(l)%nis(m)
-                IF ( ALLOCATED( surf_usm_v(l)%qrs ) )                                              &
-                   surf_v(l)%qrs(mm(l)) = surf_usm_v(l)%qrs(m)
-                IF ( ALLOCATED( surf_usm_v(l)%nrs ) )                                              &
-                   surf_v(l)%nrs(mm(l)) = surf_usm_v(l)%nrs(m)
-                IF ( ALLOCATED( surf_usm_v(l)%ol ) )                                               &
-                   surf_v(l)%ol(mm(l)) = surf_usm_v(l)%ol(m)
-                IF ( ALLOCATED( surf_usm_v(l)%rib ) )                                              &
-                   surf_v(l)%rib(mm(l)) = surf_usm_v(l)%rib(m)
-                IF ( ALLOCATED( surf_usm_v(l)%pt_surface ) )                                       &
-                   surf_v(l)%pt_surface(mm(l)) = surf_usm_v(l)%pt_surface(m)
-                IF ( ALLOCATED( surf_usm_v(l)%q_surface ) )                                        &
-                   surf_v(l)%q_surface(mm(l)) = surf_usm_v(l)%q_surface(m)
-                IF ( ALLOCATED( surf_usm_v(l)%vpt_surface ) )                                      &
-                   surf_v(l)%vpt_surface(mm(l)) = surf_usm_v(l)%vpt_surface(m)
-                IF ( ALLOCATED( surf_usm_v(l)%usws ) )                                             &
-                   surf_v(l)%usws(mm(l)) = surf_usm_v(l)%usws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%vsws ) )                                             &
-                   surf_v(l)%vsws(mm(l)) = surf_usm_v(l)%vsws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%shf ) )                                              &
-                   surf_v(l)%shf(mm(l)) = surf_usm_v(l)%shf(m)
-                IF ( ALLOCATED( surf_usm_v(l)%qsws ) )                                             &
-                   surf_v(l)%qsws(mm(l)) = surf_usm_v(l)%qsws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%ssws ) )                                             &
-                   surf_v(l)%ssws(mm(l)) = surf_usm_v(l)%ssws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%css ) )  THEN
-                   DO  lsp = 1, nvar
-                      surf_v(l)%css(lsp,mm(l)) = surf_usm_v(l)%css(lsp,m)
-                   ENDDO
-                ENDIF
-                IF ( ALLOCATED( surf_usm_v(l)%cssws ) )  THEN
-                   DO  lsp = 1, nvar
-                      surf_v(l)%cssws(lsp,mm(l)) = surf_usm_v(l)%cssws(lsp,m)
-                   ENDDO
-                ENDIF
-                IF ( ALLOCATED( surf_usm_v(l)%qcsws ) )                                            &
-                   surf_v(l)%qcsws(mm(l)) = surf_usm_v(l)%qcsws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%qrsws ) )                                            &
-                   surf_v(l)%qrsws(mm(l)) = surf_usm_v(l)%qrsws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%qisws ) )                                            &
-                   surf_v(l)%qisws(mm(l)) = surf_usm_v(l)%qisws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%ncsws ) )                                            &
-                   surf_v(l)%ncsws(mm(l)) = surf_usm_v(l)%ncsws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%nisws ) )                                            &
-                   surf_v(l)%nisws(mm(l)) = surf_usm_v(l)%nisws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%nrsws ) )                                            &
-                   surf_v(l)%nrsws(mm(l)) = surf_usm_v(l)%nrsws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%sasws ) )                                            &
-                   surf_v(l)%sasws(mm(l)) = surf_usm_v(l)%sasws(m)
-                IF ( ALLOCATED( surf_usm_v(l)%mom_flux_uv) )                                       &
-                   surf_v(l)%mom_flux_uv(mm(l)) = surf_usm_v(l)%mom_flux_uv(m)
-                IF ( ALLOCATED( surf_usm_v(l)%mom_flux_w) )                                        &
-                   surf_v(l)%mom_flux_w(mm(l)) = surf_usm_v(l)%mom_flux_w(m)
-                IF ( ALLOCATED( surf_usm_v(l)%mom_flux_tke) )                                      &
-                   surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_usm_v(l)%mom_flux_tke(0:1,m)
-
-                mm(l) = mm(l) + 1
-             ENDDO
-
-          ENDDO
-       ENDDO
-!
-!--    Recalculate start- and end-indices for gathered surface type
-       start_index_v(l) = 1
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-
-             surf_v(l)%start_index(j,i) = start_index_v(l)
-             surf_v(l)%end_index(j,i)   = surf_v(l)%start_index(j,i) -1
-
-             DO  m = surf_def_v(l)%start_index(j,i), surf_def_v(l)%end_index(j,i)
-                surf_v(l)%end_index(j,i) = surf_v(l)%end_index(j,i) + 1
-             ENDDO
-             DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
-                surf_v(l)%end_index(j,i) = surf_v(l)%end_index(j,i) + 1
-             ENDDO
-             DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
-                surf_v(l)%end_index(j,i) = surf_v(l)%end_index(j,i) + 1
-             ENDDO
-
-             start_index_v(l) = surf_v(l)%end_index(j,i) + 1
-          ENDDO
-       ENDDO
-
-    ENDDO
-
-!
-!-- Now start writing restart data to file
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-!
-!--    Output strings for the total number of upward / downward-facing surfaces on subdomain.
-       CALL wrd_write_string( 'ns_h_on_file' )
-       WRITE ( 14 ) ns_h_on_file
-!
-!--    Output strings for the total number of north/south/east/westward-facing surfaces on subdomain.
-       CALL wrd_write_string( 'ns_v_on_file' )
-       WRITE ( 14 ) ns_v_on_file
-
-!
-!--    Horizontal surfaces (upward-, downward-facing, and model top).
-!--    Always start with %start_index followed by %end_index
-       DO  l = 0, 2
-          WRITE( dum, '(I1)') l
-
-          CALL wrd_write_string( 'surf_h(' // dum // ')%start_index' )
-          WRITE ( 14 ) surf_h(l)%start_index
-
-          CALL wrd_write_string( 'surf_h(' // dum // ')%end_index' )
-          WRITE ( 14 ) surf_h(l)%end_index
-
-          IF ( ALLOCATED ( surf_h(l)%us ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%us' )
-             WRITE ( 14 ) surf_h(l)%us
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ts ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%ts' )
-             WRITE ( 14 ) surf_h(l)%ts
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qs ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%qs' )
-             WRITE ( 14 ) surf_h(l)%qs
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ss ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%ss' )
-             WRITE ( 14 ) surf_h(l)%ss
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qcs ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%qcs' )
-             WRITE ( 14 ) surf_h(l)%qcs
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ncs ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%ncs' )
-             WRITE ( 14 ) surf_h(l)%ncs
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qis ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%qis' )
-             WRITE ( 14 ) surf_h(l)%qis
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%nis ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%nis' )
-             WRITE ( 14 ) surf_h(l)%nis
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qrs ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%qrs' )
-             WRITE ( 14 ) surf_h(l)%qrs
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%nrs ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%nrs' )
-             WRITE ( 14 ) surf_h(l)%nrs
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ol ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%ol' )
-             WRITE ( 14 ) surf_h(l)%ol
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%rib ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%rib' )
-             WRITE ( 14 ) surf_h(l)%rib
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%pt_surface ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%pt_surface' )
-             WRITE ( 14 ) surf_h(l)%pt_surface
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%q_surface ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%q_surface' )
-             WRITE ( 14 ) surf_h(l)%q_surface
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%vpt_surface ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%vpt_surface' )
-             WRITE ( 14 ) surf_h(l)%vpt_surface
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%usws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%usws' )
-             WRITE ( 14 ) surf_h(l)%usws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%vsws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%vsws' )
-             WRITE ( 14 ) surf_h(l)%vsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%shf ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%shf' )
-             WRITE ( 14 ) surf_h(l)%shf
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qsws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%qsws' )
-             WRITE ( 14 ) surf_h(l)%qsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ssws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%ssws' )
-             WRITE ( 14 ) surf_h(l)%ssws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%css ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%css' )
-             WRITE ( 14 ) surf_h(l)%css
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%cssws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%cssws' )
-             WRITE ( 14 )  surf_h(l)%cssws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qcsws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%qcsws' )
-             WRITE ( 14 ) surf_h(l)%qcsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ncsws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%ncsws' )
-             WRITE ( 14 ) surf_h(l)%ncsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qisws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%qisws' )
-             WRITE ( 14 ) surf_h(l)%qisws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%nisws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%nisws' )
-             WRITE ( 14 ) surf_h(l)%nisws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qrsws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%qrsws' )
-             WRITE ( 14 ) surf_h(l)%qrsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%nrsws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%nrsws' )
-             WRITE ( 14 ) surf_h(l)%nrsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%sasws ) )  THEN
-             CALL wrd_write_string( 'surf_h(' // dum // ')%sasws' )
-             WRITE ( 14 ) surf_h(l)%sasws
-          ENDIF
-
-       ENDDO
-!
-!--    Write vertical surfaces.
-!--    Always start with %start_index followed by %end_index.
-       DO  l = 0, 3
-          WRITE( dum, '(I1)') l
-
-          CALL wrd_write_string( 'surf_v(' // dum // ')%start_index' )
-          WRITE ( 14 ) surf_v(l)%start_index
-
-          CALL wrd_write_string( 'surf_v(' // dum // ')%end_index' )
-          WRITE ( 14 ) surf_v(l)%end_index
-
-          IF ( ALLOCATED ( surf_v(l)%us ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%us' )
-             WRITE ( 14 ) surf_v(l)%us
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ts ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%ts' )
-             WRITE ( 14 ) surf_v(l)%ts
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qs ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%qs' )
-             WRITE ( 14 ) surf_v(l)%qs
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ss ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%ss' )
-             WRITE ( 14 ) surf_v(l)%ss
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qcs ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%qcs' )
-             WRITE ( 14 ) surf_v(l)%qcs
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ncs ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%ncs' )
-             WRITE ( 14 ) surf_v(l)%ncs
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qis ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%qis' )
-             WRITE ( 14 ) surf_v(l)%qis
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%nis ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%nis' )
-             WRITE ( 14 ) surf_v(l)%nis
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qrs ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%qrs' )
-             WRITE ( 14 ) surf_v(l)%qrs
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%nrs ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%nrs' )
-             WRITE ( 14 ) surf_v(l)%nrs
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ol ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%ol' )
-             WRITE ( 14 ) surf_v(l)%ol
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%rib ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%rib' )
-             WRITE ( 14 ) surf_v(l)%rib
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%pt_surface ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%pt_surface' )
-             WRITE ( 14 ) surf_v(l)%pt_surface
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%q_surface ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%q_surface' )
-             WRITE ( 14 ) surf_v(l)%q_surface
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%vpt_surface ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%vpt_surface' )
-             WRITE ( 14 ) surf_v(l)%vpt_surface
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%shf ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%shf' )
-             WRITE ( 14 ) surf_v(l)%shf
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qsws ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%qsws' )
-             WRITE ( 14 ) surf_v(l)%qsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ssws ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%ssws' )
-             WRITE ( 14 ) surf_v(l)%ssws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%css ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%css' )
-             WRITE ( 14 ) surf_v(l)%css
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%cssws ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%cssws' )
-             WRITE ( 14 ) surf_v(l)%cssws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qcsws ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%qcsws' )
-             WRITE ( 14 ) surf_v(l)%qcsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ncsws ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%ncsws' )
-             WRITE ( 14 ) surf_v(l)%ncsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qisws ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%qisws' )
-             WRITE ( 14 ) surf_v(l)%qisws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%nisws ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%nisws' )
-             WRITE ( 14 ) surf_v(l)%nisws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qrsws ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%qrsws' )
-             WRITE ( 14 ) surf_v(l)%qrsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%nrsws ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%nrsws' )
-             WRITE ( 14 ) surf_v(l)%nrsws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%sasws ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%sasws' )
-             WRITE ( 14 ) surf_v(l)%sasws
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%mom_flux_uv ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%mom_uv' )
-             WRITE ( 14 ) surf_v(l)%mom_flux_uv
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%mom_flux_w ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%mom_w' )
-             WRITE ( 14 ) surf_v(l)%mom_flux_w
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%mom_flux_tke ) )  THEN
-             CALL wrd_write_string( 'surf_v(' // dum // ')%mom_tke' )
-             WRITE ( 14 ) surf_v(l)%mom_flux_tke
-          ENDIF
-
-       ENDDO
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-!
-!--    Start with horizontal surfaces (upward-, downward-facing, and model top).
-!--    All data writen with rd_mpi_io_write_surface are globally indexed 1d-arrays.
-       ns_h_on_file = 0
-       ns_v_on_file = 0
-
-       DO  l = 0, 2
-
-          WRITE( dum, '(I1)') l
-
-          CALL rd_mpi_io_surface_filetypes( surf_h(l)%start_index, surf_h(l)%end_index,            &
-                                            surface_data_to_write, global_start_index,             &
-                                            global_end_index )
-          IF ( .NOT. surface_data_to_write )  CYCLE
-
-          ns_h_on_file(l) = total_number_of_surface_elements
-
-          CALL wrd_mpi_io( 'global_start_index_h_' // dum, global_start_index )
-          CALL wrd_mpi_io( 'global_end_index_h_' // dum, global_end_index )
-
-          IF ( ALLOCATED ( surf_h(l)%us ) )  THEN
-             CALL wrd_mpi_io_surface ( 'surf_h(' // dum // ')%us', surf_h(l)%us )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ts ) )  THEN
-             CALL wrd_mpi_io_surface ( 'surf_h(' // dum // ')%ts', surf_h(l)%ts )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qs ) )  THEN
-             CALL wrd_mpi_io_surface ( 'surf_h(' // dum // ')%qs', surf_h(l)%qs )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ss ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ss', surf_h(l)%ss )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qcs ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qcs', surf_h(l)%qcs )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ncs ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ncs', surf_h(l)%ncs )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qis ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qis', surf_h(l)%qis )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%nis ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nis', surf_h(l)%nis )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qrs ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qrs', surf_h(l)%qrs )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%nrs ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nrs', surf_h(l)%nrs )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ol ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ol', surf_h(l)%ol )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%rib ) )  THEN
-            CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%rib', surf_h(l)%rib )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%pt_surface ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%pt_surface', surf_h(l)%pt_surface )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%q_surface ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%q_surface', surf_h(l)%q_surface )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%vpt_surface ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%vpt_surface', surf_h(l)%vpt_surface )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%usws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%usws', surf_h(l)%usws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%vsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%vsws', surf_h(l)%vsws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%shf ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%shf', surf_h(l)%shf )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qsws', surf_h(l)%qsws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ssws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ssws', surf_h(l)%ssws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%css ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%css', surf_h(l)%css )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%cssws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%cssws', surf_h(l)%cssws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qcsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qcsws', surf_h(l)%qcsws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%ncsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ncsws', surf_h(l)%ncsws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qisws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qisws', surf_h(l)%qisws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%nisws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nisws', surf_h(l)%nisws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%qrsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qrsws', surf_h(l)%qrsws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%nrsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nrsws', surf_h(l)%nrsws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_h(l)%sasws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%sasws', surf_h(l)%sasws )
-          ENDIF
-
-       ENDDO
-!
-!--    Write vertical surfaces
-       DO  l = 0, 3
-
-          WRITE( dum, '(I1)') l
-
-          CALL rd_mpi_io_surface_filetypes( surf_v(l)%start_index, surf_v(l)%end_index,            &
-                                            surface_data_to_write, global_start_index,             &
-                                            global_end_index )
-
-          IF ( .NOT. surface_data_to_write )  CYCLE
-
-          ns_v_on_file(l) = total_number_of_surface_elements
-
-          CALL wrd_mpi_io( 'global_start_index_v_' // dum, global_start_index )
-          CALL wrd_mpi_io( 'global_end_index_v_' // dum, global_end_index )
-
-          IF ( .NOT. surface_data_to_write )  CYCLE
-
-          IF ( ALLOCATED ( surf_v(l)%us ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%us',  surf_v(l)%us )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ts ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ts', surf_v(l)%ts )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qs ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qs',  surf_v(l)%qs )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ss ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ss',  surf_v(l)%ss )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qcs ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qcs', surf_v(l)%qcs )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ncs ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ncs', surf_v(l)%ncs )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qis ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qis', surf_v(l)%qis )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%nis ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nis', surf_v(l)%nis )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qrs ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qrs', surf_v(l)%qrs )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%nrs ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nrs', surf_v(l)%nrs )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ol ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ol', surf_v(l)%ol )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%rib ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%rib', surf_v(l)%rib )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%pt_surface ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%pt_surface', surf_v(l)%pt_surface )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%q_surface ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%q_surface', surf_v(l)%q_surface )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%vpt_surface ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%vpt_surface', surf_v(l)%vpt_surface )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%shf ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%shf', surf_v(l)%shf )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qsws', surf_v(l)%qsws )
-           ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ssws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ssws', surf_v(l)%ssws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%css ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%css', surf_v(l)%css )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%cssws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%cssws', surf_v(l)%cssws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qcsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qcsws', surf_v(l)%qcsws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%ncsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ncsws', surf_v(l)%ncsws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qisws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qisws', surf_v(l)%qisws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%nisws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nisws', surf_v(l)%nisws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%qrsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qrsws', surf_v(l)%qrsws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%nrsws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nrsws', surf_v(l)%nrsws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%sasws ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%sasws', surf_v(l)%sasws )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%mom_flux_uv ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_uv', surf_v(l)%mom_flux_uv )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%mom_flux_w ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_w',  surf_v(l)%mom_flux_w )
-          ENDIF
-
-          IF ( ALLOCATED ( surf_v(l)%mom_flux_tke ) )  THEN
-             CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_tke', surf_v(l)%mom_flux_tke )
-          ENDIF
-
-       ENDDO
-
-       CALL wrd_mpi_io_global_array( 'ns_h_on_file', ns_h_on_file )
-       CALL wrd_mpi_io_global_array( 'ns_v_on_file', ns_v_on_file )
-
-    ENDIF
-
- END SUBROUTINE surface_wrd_local
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads surface-related restart data in Fortran binary format. Please note, restart data for a
-!> certain surface orientation (e.g. horizontal upward-facing) is stored in one array, even if
-!> surface elements may belong to different surface types natural or urban for example). Surface
-!> elements are redistributed into its respective surface types within this routine. This allows
-!> e.g. changing the surface type after reading the restart data, which might be required in case
-!> of cyclic_fill mode.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_rrd_local_ftn( kk, nxlf, nxlc, nxl_on_file, nxrf, nxr_on_file, nynf,           &
-                                   nyn_on_file, nysf, nysc, nys_on_file, found )
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i            !< running index along x-direction, refers to former domain size
-    INTEGER(iwp) ::  ic           !< running index along x-direction, refers to current domain size
-    INTEGER(iwp) ::  j            !< running index along y-direction, refers to former domain size
-    INTEGER(iwp) ::  jc           !< running index along y-direction, refers to former domain size
-    INTEGER(iwp) ::  m            !< running index for surface elements, refers to gathered array encompassing all surface types
-    INTEGER(iwp) ::  mm           !< running index for surface elements, refers to individual surface types
-    INTEGER(iwp) ::  kk           !< running index over previous input files covering current local domain
-    INTEGER(iwp) ::  nxlc         !< index of left boundary on current subdomain
-    INTEGER(iwp) ::  nxlf         !< index of left boundary on former subdomain
-    INTEGER(iwp) ::  nxl_on_file  !< index of left boundary on former local domain
-    INTEGER(iwp) ::  nxrf         !< index of right boundary on former subdomain
-    INTEGER(iwp) ::  nxr_on_file  !< index of right boundary on former local domain
-    INTEGER(iwp) ::  nynf         !< index of north boundary on former subdomain
-    INTEGER(iwp) ::  nyn_on_file  !< index of norht boundary on former local domain
-    INTEGER(iwp) ::  nysc         !< index of south boundary on current subdomain
-    INTEGER(iwp) ::  nysf         !< index of south boundary on former subdomain
-    INTEGER(iwp) ::  nys_on_file  !< index of south boundary on former local domain
-
-    INTEGER(iwp), SAVE ::  l            !< index variable for surface type
-
-    LOGICAL ::  surf_match_def  !< flag indicating that surface element is of default type
-    LOGICAL ::  surf_match_lsm  !< flag indicating that surface element is of natural type
-    LOGICAL ::  surf_match_usm  !< flag indicating that surface element is of urban type
-
-    LOGICAL, INTENT(OUT) ::  found  !<
-
-    LOGICAL, SAVE ::  horizontal_surface  !< flag indicating horizontal surfaces
-    LOGICAL, SAVE ::  vertical_surface    !< flag indicating vertical surfaces
-
-    TYPE(surf_type), DIMENSION(0:2), SAVE ::  surf_h  !< horizontal surface type on file
-    TYPE(surf_type), DIMENSION(0:3), SAVE ::  surf_v  !< vertical surface type on file
-
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-!
-!--    Read the number of horizontally orientated surface elements and  allocate arrays
-       CASE ( 'ns_h_on_file' )
-          IF ( kk == 1 )  THEN
-             READ ( 13 )  ns_h_on_file
-
-             IF ( ALLOCATED( surf_h(0)%start_index ) )                                             &
-                CALL deallocate_surface_attributes_h( surf_h(0) )
-             IF ( ALLOCATED( surf_h(1)%start_index ) )                                             &
-                CALL deallocate_surface_attributes_h( surf_h(1) )
-             IF ( ALLOCATED( surf_h(2)%start_index ) )                                             &
-                CALL deallocate_surface_attributes_h_top( surf_h(2) )
-!
-!--          Allocate memory for number of surface elements on file.
-!--          Please note, this number is not necessarily the same as the final number of surface
-!--          elements on local domain, which is the case if processor topology changes during
-!--          restart runs.
-!--          Horizontal upward facing
-             surf_h(0)%ns = ns_h_on_file(0)
-             CALL allocate_surface_attributes_h( surf_h(0), nys_on_file, nyn_on_file, nxl_on_file, &
-                                                 nxr_on_file )
-!
-!--          Horizontal downward facing
-             surf_h(1)%ns = ns_h_on_file(1)
-             CALL allocate_surface_attributes_h( surf_h(1), nys_on_file, nyn_on_file, nxl_on_file, &
-                                                 nxr_on_file )
-!
-!--          Model top
-             surf_h(2)%ns = ns_h_on_file(2)
-             CALL allocate_surface_attributes_h_top( surf_h(2), nys_on_file, nyn_on_file,          &
-                                                     nxl_on_file, nxr_on_file )
-
-!
-!--          Initial setting of flags for horizontal and vertical surfaces, will be set after start-
-!--          and end-indices are read.
-             horizontal_surface = .FALSE.
-             vertical_surface   = .FALSE.
-
-          ENDIF
-!
-!--    Read the number of vertically orientated surface elements and allocate arrays
-       CASE ( 'ns_v_on_file' )
-          IF ( kk == 1 ) THEN
-             READ ( 13 ) ns_v_on_file
-
-             DO  l = 0, 3
-                IF ( ALLOCATED( surf_v(l)%start_index ) )                                          &
-                   CALL deallocate_surface_attributes_v( surf_v(l) )
-             ENDDO
-
-             DO  l = 0, 3
-                surf_v(l)%ns = ns_v_on_file(l)
-                CALL allocate_surface_attributes_v( surf_v(l), nys_on_file, nyn_on_file,           &
-                                                    nxl_on_file, nxr_on_file )
-            ENDDO
-
-          ENDIF
-!
-!--    Read start and end indices of surface elements at each (ji)-gridpoint
-       CASE ( 'surf_h(0)%start_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_h(0)%start_index
-          l = 0
-       CASE ( 'surf_h(0)%end_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_h(0)%end_index
-          horizontal_surface = .TRUE.
-          vertical_surface   = .FALSE.
-!
-!--    Read specific attributes
-       CASE ( 'surf_h(0)%us' )
-          IF ( ALLOCATED( surf_h(0)%us )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(0)%us
-       CASE ( 'surf_h(0)%ts' )
-          IF ( ALLOCATED( surf_h(0)%ts )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(0)%ts
-       CASE ( 'surf_h(0)%qs' )
-          IF ( ALLOCATED( surf_h(0)%qs )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(0)%qs
-       CASE ( 'surf_h(0)%ss' )
-          IF ( ALLOCATED( surf_h(0)%ss )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(0)%ss
-       CASE ( 'surf_h(0)%qcs' )
-          IF ( ALLOCATED( surf_h(0)%qcs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(0)%qcs
-       CASE ( 'surf_h(0)%ncs' )
-          IF ( ALLOCATED( surf_h(0)%ncs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(0)%ncs
-       CASE ( 'surf_h(0)%qis' )
-          IF ( ALLOCATED( surf_h(0)%qis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(0)%qis
-       CASE ( 'surf_h(0)%nis' )
-          IF ( ALLOCATED( surf_h(0)%nis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(0)%nis
-       CASE ( 'surf_h(0)%qrs' )
-          IF ( ALLOCATED( surf_h(0)%qrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(0)%qrs
-       CASE ( 'surf_h(0)%nrs' )
-          IF ( ALLOCATED( surf_h(0)%nrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(0)%nrs
-       CASE ( 'surf_h(0)%ol' )
-          IF ( ALLOCATED( surf_h(0)%ol )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(0)%ol
-       CASE ( 'surf_h(0)%rib' )
-          IF ( ALLOCATED( surf_h(0)%rib )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(0)%rib
-       CASE ( 'surf_h(0)%pt_surface' )
-          IF ( ALLOCATED( surf_h(0)%pt_surface )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_h(0)%pt_surface
-       CASE ( 'surf_h(0)%q_surface' )
-          IF ( ALLOCATED( surf_h(0)%q_surface )  .AND.  kk == 1 )                                  &
-             READ ( 13 ) surf_h(0)%q_surface
-       CASE ( 'surf_h(0)%vpt_surface' )
-          IF ( ALLOCATED( surf_h(0)%vpt_surface )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_h(0)%vpt_surface
-       CASE ( 'surf_h(0)%usws' )
-          IF ( ALLOCATED( surf_h(0)%usws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(0)%usws
-       CASE ( 'surf_h(0)%vsws' )
-          IF ( ALLOCATED( surf_h(0)%vsws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(0)%vsws
-       CASE ( 'surf_h(0)%shf' )
-          IF ( ALLOCATED( surf_h(0)%shf )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(0)%shf
-       CASE ( 'surf_h(0)%qsws' )
-          IF ( ALLOCATED( surf_h(0)%qsws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(0)%qsws
-       CASE ( 'surf_h(0)%ssws' )
-          IF ( ALLOCATED( surf_h(0)%ssws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(0)%ssws
-       CASE ( 'surf_h(0)%css' )
-          IF ( ALLOCATED( surf_h(0)%css )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(0)%css
-       CASE ( 'surf_h(0)%cssws' )
-          IF ( ALLOCATED( surf_h(0)%cssws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(0)%cssws
-       CASE ( 'surf_h(0)%qcsws' )
-          IF ( ALLOCATED( surf_h(0)%qcsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(0)%qcsws
-       CASE ( 'surf_h(0)%ncsws' )
-          IF ( ALLOCATED( surf_h(0)%ncsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(0)%ncsws
-       CASE ( 'surf_h(0)%qisws' )
-          IF ( ALLOCATED( surf_h(0)%qisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(0)%qisws
-       CASE ( 'surf_h(0)%nisws' )
-          IF ( ALLOCATED( surf_h(0)%nisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(0)%nisws
-       CASE ( 'surf_h(0)%qrsws' )
-          IF ( ALLOCATED( surf_h(0)%qrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(0)%qrsws
-       CASE ( 'surf_h(0)%nrsws' )
-          IF ( ALLOCATED( surf_h(0)%nrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(0)%nrsws
-       CASE ( 'surf_h(0)%sasws' )
-          IF ( ALLOCATED( surf_h(0)%sasws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(0)%sasws
-       CASE ( 'surf_h(1)%start_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_h(1)%start_index
-          l = 1
-       CASE ( 'surf_h(1)%end_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_h(1)%end_index
-       CASE ( 'surf_h(1)%us' )
-          IF ( ALLOCATED( surf_h(1)%us )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(1)%us
-       CASE ( 'surf_h(1)%ts' )
-          IF ( ALLOCATED( surf_h(1)%ts )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(1)%ts
-       CASE ( 'surf_h(1)%qs' )
-          IF ( ALLOCATED( surf_h(1)%qs )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(1)%qs
-       CASE ( 'surf_h(1)%ss' )
-          IF ( ALLOCATED( surf_h(1)%ss )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(1)%ss
-       CASE ( 'surf_h(1)%qcs' )
-          IF ( ALLOCATED( surf_h(1)%qcs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(1)%qcs
-       CASE ( 'surf_h(1)%ncs' )
-          IF ( ALLOCATED( surf_h(1)%ncs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(1)%ncs
-       CASE ( 'surf_h(1)%qis' )
-          IF ( ALLOCATED( surf_h(1)%qis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(1)%qis
-       CASE ( 'surf_h(1)%nis' )
-          IF ( ALLOCATED( surf_h(1)%nis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(1)%nis
-       CASE ( 'surf_h(1)%qrs' )
-          IF ( ALLOCATED( surf_h(1)%qrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(1)%qrs
-       CASE ( 'surf_h(1)%nrs' )
-          IF ( ALLOCATED( surf_h(1)%nrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(1)%nrs
-       CASE ( 'surf_h(1)%ol' )
-          IF ( ALLOCATED( surf_h(1)%ol )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(1)%ol
-       CASE ( 'surf_h(1)%rib' )
-          IF ( ALLOCATED( surf_h(1)%rib )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(1)%rib
-       CASE ( 'surf_h(1)%pt_surface' )
-          IF ( ALLOCATED( surf_h(1)%pt_surface )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_h(1)%pt_surface
-       CASE ( 'surf_h(1)%q_surface' )
-          IF ( ALLOCATED( surf_h(1)%q_surface )  .AND.  kk == 1 )                                  &
-             READ ( 13 ) surf_h(1)%q_surface
-       CASE ( 'surf_h(1)%vpt_surface' )
-          IF ( ALLOCATED( surf_h(1)%vpt_surface )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_h(1)%vpt_surface
-       CASE ( 'surf_h(1)%usws' )
-          IF ( ALLOCATED( surf_h(1)%usws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(1)%usws
-       CASE ( 'surf_h(1)%vsws' )
-          IF ( ALLOCATED( surf_h(1)%vsws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(1)%vsws
-       CASE ( 'surf_h(1)%shf' )
-          IF ( ALLOCATED( surf_h(1)%shf )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(1)%shf
-       CASE ( 'surf_h(1)%qsws' )
-          IF ( ALLOCATED( surf_h(1)%qsws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(1)%qsws
-       CASE ( 'surf_h(1)%ssws' )
-          IF ( ALLOCATED( surf_h(1)%ssws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(1)%ssws
-       CASE ( 'surf_h(1)%css' )
-          IF ( ALLOCATED( surf_h(1)%css )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(1)%css
-       CASE ( 'surf_h(1)%cssws' )
-          IF ( ALLOCATED( surf_h(1)%cssws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(1)%cssws
-       CASE ( 'surf_h(1)%qcsws' )
-          IF ( ALLOCATED( surf_h(1)%qcsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(1)%qcsws
-       CASE ( 'surf_h(1)%ncsws' )
-          IF ( ALLOCATED( surf_h(1)%ncsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(1)%ncsws
-       CASE ( 'surf_h(1)%qisws' )
-          IF ( ALLOCATED( surf_h(1)%qisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(1)%qisws
-       CASE ( 'surf_h(1)%nisws' )
-          IF ( ALLOCATED( surf_h(1)%nisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(1)%nisws
-       CASE ( 'surf_h(1)%qrsws' )
-          IF ( ALLOCATED( surf_h(1)%qrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(1)%qrsws
-       CASE ( 'surf_h(1)%nrsws' )
-          IF ( ALLOCATED( surf_h(1)%nrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(1)%nrsws
-       CASE ( 'surf_h(1)%sasws' )
-          IF ( ALLOCATED( surf_h(1)%sasws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(1)%sasws
-       CASE ( 'surf_h(2)%start_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_h(2)%start_index
-          l = 2
-       CASE ( 'surf_h(2)%end_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_h(2)%end_index
-       CASE ( 'surf_h(2)%us' )
-          IF ( ALLOCATED( surf_h(2)%us )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(2)%us
-       CASE ( 'surf_h(2)%ts' )
-          IF ( ALLOCATED( surf_h(2)%ts )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(2)%ts
-       CASE ( 'surf_h(2)%qs' )
-          IF ( ALLOCATED( surf_h(2)%qs )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(2)%qs
-       CASE ( 'surf_h(2)%ss' )
-          IF ( ALLOCATED( surf_h(2)%ss )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(2)%ss
-       CASE ( 'surf_h(2)%qcs' )
-          IF ( ALLOCATED( surf_h(2)%qcs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(2)%qcs
-       CASE ( 'surf_h(2)%ncs' )
-          IF ( ALLOCATED( surf_h(2)%ncs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(2)%ncs
-       CASE ( 'surf_h(2)%qis' )
-          IF ( ALLOCATED( surf_h(2)%qis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(2)%qis
-       CASE ( 'surf_h(2)%nis' )
-          IF ( ALLOCATED( surf_h(2)%nis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(2)%nis
-       CASE ( 'surf_h(2)%qrs' )
-          IF ( ALLOCATED( surf_h(2)%qrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(2)%qrs
-       CASE ( 'surf_h(2)%nrs' )
-          IF ( ALLOCATED( surf_h(2)%nrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(2)%nrs
-       CASE ( 'surf_h(2)%ol' )
-          IF ( ALLOCATED( surf_h(2)%ol )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_h(2)%ol
-       CASE ( 'surf_h(2)%rib' )
-          IF ( ALLOCATED( surf_h(2)%rib )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(2)%rib
-       CASE ( 'surf_h(2)%pt_surface' )
-          IF ( ALLOCATED( surf_h(2)%pt_surface )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_h(2)%pt_surface
-       CASE ( 'surf_h(2)%q_surface' )
-          IF ( ALLOCATED( surf_h(2)%q_surface )  .AND.  kk == 1 )                                  &
-             READ ( 13 ) surf_h(2)%q_surface
-       CASE ( 'surf_h(2)%vpt_surface' )
-          IF ( ALLOCATED( surf_h(2)%vpt_surface )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_h(2)%vpt_surface
-       CASE ( 'surf_h(2)%usws' )
-          IF ( ALLOCATED( surf_h(2)%usws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(2)%usws
-       CASE ( 'surf_h(2)%vsws' )
-          IF ( ALLOCATED( surf_h(2)%vsws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(2)%vsws
-       CASE ( 'surf_h(2)%shf' )
-          IF ( ALLOCATED( surf_h(2)%shf )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(2)%shf
-       CASE ( 'surf_h(2)%qsws' )
-          IF ( ALLOCATED( surf_h(2)%qsws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(2)%qsws
-       CASE ( 'surf_h(2)%ssws' )
-          IF ( ALLOCATED( surf_h(2)%ssws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_h(2)%ssws
-       CASE ( 'surf_h(2)%css' )
-          IF ( ALLOCATED( surf_h(2)%css )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_h(2)%css
-       CASE ( 'surf_h(2)%cssws' )
-          IF ( ALLOCATED( surf_h(2)%cssws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(2)%cssws
-       CASE ( 'surf_h(2)%qcsws' )
-          IF ( ALLOCATED( surf_h(2)%qcsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(2)%qcsws
-       CASE ( 'surf_h(2)%ncsws' )
-          IF ( ALLOCATED( surf_h(2)%ncsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(2)%ncsws
-       CASE ( 'surf_h(2)%qisws' )
-          IF ( ALLOCATED( surf_h(2)%qisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(2)%qisws
-       CASE ( 'surf_h(2)%nisws' )
-          IF ( ALLOCATED( surf_h(2)%nisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(2)%nisws
-       CASE ( 'surf_h(2)%qrsws' )
-          IF ( ALLOCATED( surf_h(2)%qrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(2)%qrsws
-       CASE ( 'surf_h(2)%nrsws' )
-          IF ( ALLOCATED( surf_h(2)%nrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(2)%nrsws
-       CASE ( 'surf_h(2)%sasws' )
-          IF ( ALLOCATED( surf_h(2)%sasws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_h(2)%sasws
-
-       CASE ( 'surf_v(0)%start_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_v(0)%start_index
-          l = 0
-          horizontal_surface = .FALSE.
-          vertical_surface   = .TRUE.
-       CASE ( 'surf_v(0)%end_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_v(0)%end_index
-       CASE ( 'surf_v(0)%us' )
-          IF ( ALLOCATED( surf_v(0)%us )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(0)%us
-       CASE ( 'surf_v(0)%ts' )
-          IF ( ALLOCATED( surf_v(0)%ts )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(0)%ts
-       CASE ( 'surf_v(0)%qs' )
-          IF ( ALLOCATED( surf_v(0)%qs )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(0)%qs
-       CASE ( 'surf_v(0)%ss' )
-          IF ( ALLOCATED( surf_v(0)%ss )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(0)%ss
-       CASE ( 'surf_v(0)%qcs' )
-          IF ( ALLOCATED( surf_v(0)%qcs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(0)%qcs
-       CASE ( 'surf_v(0)%ncs' )
-          IF ( ALLOCATED( surf_v(0)%ncs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(0)%ncs
-       CASE ( 'surf_v(0)%qis' )
-          IF ( ALLOCATED( surf_v(0)%qis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(0)%qis
-       CASE ( 'surf_v(0)%nis' )
-          IF ( ALLOCATED( surf_v(0)%nis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(0)%nis
-       CASE ( 'surf_v(0)%qrs' )
-          IF ( ALLOCATED( surf_v(0)%qrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(0)%qrs
-       CASE ( 'surf_v(0)%nrs' )
-          IF ( ALLOCATED( surf_v(0)%nrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(0)%nrs
-       CASE ( 'surf_v(0)%ol' )
-          IF ( ALLOCATED( surf_v(0)%ol )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(0)%ol
-       CASE ( 'surf_v(0)%rib' )
-          IF ( ALLOCATED( surf_v(0)%rib )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(0)%rib
-       CASE ( 'surf_v(0)%pt_surface' )
-          IF ( ALLOCATED( surf_v(0)%pt_surface )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_v(0)%pt_surface
-       CASE ( 'surf_v(0)%q_surface' )
-          IF ( ALLOCATED( surf_v(0)%q_surface )  .AND.  kk == 1 )                                  &
-             READ ( 13 ) surf_v(0)%q_surface
-       CASE ( 'surf_v(0)%vpt_surface' )
-          IF ( ALLOCATED( surf_v(0)%vpt_surface )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_v(0)%vpt_surface
-       CASE ( 'surf_v(0)%shf' )
-          IF ( ALLOCATED( surf_v(0)%shf )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(0)%shf
-       CASE ( 'surf_v(0)%qsws' )
-          IF ( ALLOCATED( surf_v(0)%qsws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_v(0)%qsws
-       CASE ( 'surf_v(0)%ssws' )
-          IF ( ALLOCATED( surf_v(0)%ssws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_v(0)%ssws
-       CASE ( 'surf_v(0)%css' )
-          IF ( ALLOCATED( surf_v(0)%css )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(0)%css
-       CASE ( 'surf_v(0)%cssws' )
-          IF ( ALLOCATED( surf_v(0)%cssws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(0)%cssws
-       CASE ( 'surf_v(0)%qcsws' )
-          IF ( ALLOCATED( surf_v(0)%qcsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(0)%qcsws
-       CASE ( 'surf_v(0)%ncsws' )
-          IF ( ALLOCATED( surf_v(0)%ncsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(0)%ncsws
-       CASE ( 'surf_v(0)%qisws' )
-          IF ( ALLOCATED( surf_v(0)%qisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(0)%qisws
-       CASE ( 'surf_v(0)%nisws' )
-          IF ( ALLOCATED( surf_v(0)%nisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(0)%nisws
-       CASE ( 'surf_v(0)%qrsws' )
-          IF ( ALLOCATED( surf_v(0)%qrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(0)%qrsws
-       CASE ( 'surf_v(0)%nrsws' )
-          IF ( ALLOCATED( surf_v(0)%nrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(0)%nrsws
-       CASE ( 'surf_v(0)%sasws' )
-          IF ( ALLOCATED( surf_v(0)%sasws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(0)%sasws
-       CASE ( 'surf_v(0)%mom_uv' )
-          IF ( ALLOCATED( surf_v(0)%mom_flux_uv )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_v(0)%mom_flux_uv
-       CASE ( 'surf_v(0)%mom_w' )
-          IF ( ALLOCATED( surf_v(0)%mom_flux_w )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_v(0)%mom_flux_w
-       CASE ( 'surf_v(0)%mom_tke' )
-          IF ( ALLOCATED( surf_v(0)%mom_flux_tke )  .AND.  kk == 1 )                               &
-             READ ( 13 ) surf_v(0)%mom_flux_tke
-       CASE ( 'surf_v(1)%start_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_v(1)%start_index
-          l = 1
-       CASE ( 'surf_v(1)%end_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_v(1)%end_index
-       CASE ( 'surf_v(1)%us' )
-          IF ( ALLOCATED( surf_v(1)%us )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(1)%us
-       CASE ( 'surf_v(1)%ts' )
-          IF ( ALLOCATED( surf_v(1)%ts )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(1)%ts
-       CASE ( 'surf_v(1)%qs' )
-          IF ( ALLOCATED( surf_v(1)%qs )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(1)%qs
-       CASE ( 'surf_v(1)%ss' )
-          IF ( ALLOCATED( surf_v(1)%ss )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(1)%ss
-       CASE ( 'surf_v(1)%qcs' )
-          IF ( ALLOCATED( surf_v(1)%qcs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(1)%qcs
-       CASE ( 'surf_v(1)%ncs' )
-          IF ( ALLOCATED( surf_v(1)%ncs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(1)%ncs
-       CASE ( 'surf_v(1)%qis' )
-          IF ( ALLOCATED( surf_v(1)%qis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(1)%qis
-       CASE ( 'surf_v(1)%nis' )
-          IF ( ALLOCATED( surf_v(1)%nis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(1)%nis
-       CASE ( 'surf_v(1)%qrs' )
-          IF ( ALLOCATED( surf_v(1)%qrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(1)%qrs
-       CASE ( 'surf_v(1)%nrs' )
-          IF ( ALLOCATED( surf_v(1)%nrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(1)%nrs
-       CASE ( 'surf_v(1)%ol' )
-          IF ( ALLOCATED( surf_v(1)%ol )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(1)%ol
-       CASE ( 'surf_v(1)%rib' )
-          IF ( ALLOCATED( surf_v(1)%rib )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(1)%rib
-       CASE ( 'surf_v(1)%pt_surface' )
-          IF ( ALLOCATED( surf_v(1)%pt_surface )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_v(1)%pt_surface
-       CASE ( 'surf_v(1)%q_surface' )
-          IF ( ALLOCATED( surf_v(1)%q_surface )  .AND.  kk == 1 )                                  &
-             READ ( 13 ) surf_v(1)%q_surface
-       CASE ( 'surf_v(1)%vpt_surface' )
-          IF ( ALLOCATED( surf_v(1)%vpt_surface )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_v(1)%vpt_surface
-       CASE ( 'surf_v(1)%shf' )
-          IF ( ALLOCATED( surf_v(1)%shf )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(1)%shf
-       CASE ( 'surf_v(1)%qsws' )
-          IF ( ALLOCATED( surf_v(1)%qsws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_v(1)%qsws
-       CASE ( 'surf_v(1)%ssws' )
-          IF ( ALLOCATED( surf_v(1)%ssws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_v(1)%ssws
-       CASE ( 'surf_v(1)%css' )
-          IF ( ALLOCATED( surf_v(1)%css )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(1)%css
-       CASE ( 'surf_v(1)%cssws' )
-          IF ( ALLOCATED( surf_v(1)%cssws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(1)%cssws
-       CASE ( 'surf_v(1)%qcsws' )
-          IF ( ALLOCATED( surf_v(1)%qcsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(1)%qcsws
-       CASE ( 'surf_v(1)%ncsws' )
-          IF ( ALLOCATED( surf_v(1)%ncsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(1)%ncsws
-       CASE ( 'surf_v(1)%qisws' )
-          IF ( ALLOCATED( surf_v(1)%qisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(1)%qisws
-       CASE ( 'surf_v(1)%nisws' )
-          IF ( ALLOCATED( surf_v(1)%nisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(1)%nisws
-       CASE ( 'surf_v(1)%qrsws' )
-          IF ( ALLOCATED( surf_v(1)%qrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(1)%qrsws
-       CASE ( 'surf_v(1)%nrsws' )
-          IF ( ALLOCATED( surf_v(1)%nrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(1)%nrsws
-       CASE ( 'surf_v(1)%sasws' )
-          IF ( ALLOCATED( surf_v(1)%sasws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(1)%sasws
-       CASE ( 'surf_v(1)%mom_uv' )
-          IF ( ALLOCATED( surf_v(1)%mom_flux_uv )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_v(1)%mom_flux_uv
-       CASE ( 'surf_v(1)%mom_w' )
-          IF ( ALLOCATED( surf_v(1)%mom_flux_w )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_v(1)%mom_flux_w
-       CASE ( 'surf_v(1)%mom_tke' )
-          IF ( ALLOCATED( surf_v(1)%mom_flux_tke )  .AND.  kk == 1 )                               &
-             READ ( 13 ) surf_v(1)%mom_flux_tke
-       CASE ( 'surf_v(2)%start_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_v(2)%start_index
-          l = 2
-       CASE ( 'surf_v(2)%end_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_v(2)%end_index
-       CASE ( 'surf_v(2)%us' )
-          IF ( ALLOCATED( surf_v(2)%us )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(2)%us
-       CASE ( 'surf_v(2)%ts' )
-          IF ( ALLOCATED( surf_v(2)%ts )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(2)%ts
-       CASE ( 'surf_v(2)%qs' )
-          IF ( ALLOCATED( surf_v(2)%qs )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(2)%qs
-       CASE ( 'surf_v(2)%ss' )
-          IF ( ALLOCATED( surf_v(2)%ss )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(2)%ss
-       CASE ( 'surf_v(2)%qcs' )
-          IF ( ALLOCATED( surf_v(2)%qcs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(2)%qcs
-       CASE ( 'surf_v(2)%ncs' )
-          IF ( ALLOCATED( surf_v(2)%ncs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(2)%ncs
-       CASE ( 'surf_v(2)%qis' )
-          IF ( ALLOCATED( surf_v(2)%qis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(2)%qis
-       CASE ( 'surf_v(2)%nis' )
-          IF ( ALLOCATED( surf_v(2)%nis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(2)%nis
-       CASE ( 'surf_v(2)%qrs' )
-          IF ( ALLOCATED( surf_v(2)%qrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(2)%qrs
-       CASE ( 'surf_v(2)%nrs' )
-          IF ( ALLOCATED( surf_v(2)%nrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(2)%nrs
-       CASE ( 'surf_v(2)%ol' )
-          IF ( ALLOCATED( surf_v(2)%ol )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(2)%ol
-       CASE ( 'surf_v(2)%rib' )
-          IF ( ALLOCATED( surf_v(2)%rib )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(2)%rib
-       CASE ( 'surf_v(2)%pt_surface' )
-          IF ( ALLOCATED( surf_v(2)%pt_surface )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_v(2)%pt_surface
-       CASE ( 'surf_v(2)%q_surface' )
-          IF ( ALLOCATED( surf_v(2)%q_surface )  .AND.  kk == 1 )                                  &
-             READ ( 13 ) surf_v(2)%q_surface
-       CASE ( 'surf_v(2)%vpt_surface' )
-          IF ( ALLOCATED( surf_v(2)%vpt_surface )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_v(2)%vpt_surface
-       CASE ( 'surf_v(2)%shf' )
-          IF ( ALLOCATED( surf_v(2)%shf )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(2)%shf
-       CASE ( 'surf_v(2)%qsws' )
-          IF ( ALLOCATED( surf_v(2)%qsws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_v(2)%qsws
-       CASE ( 'surf_v(2)%ssws' )
-          IF ( ALLOCATED( surf_v(2)%ssws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_v(2)%ssws
-       CASE ( 'surf_v(2)%css' )
-          IF ( ALLOCATED( surf_v(2)%css )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(2)%css
-       CASE ( 'surf_v(2)%cssws' )
-          IF ( ALLOCATED( surf_v(2)%cssws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(2)%cssws
-       CASE ( 'surf_v(2)%qcsws' )
-          IF ( ALLOCATED( surf_v(2)%qcsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(2)%qcsws
-       CASE ( 'surf_v(2)%ncsws' )
-          IF ( ALLOCATED( surf_v(2)%ncsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(2)%ncsws
-       CASE ( 'surf_v(2)%qisws' )
-          IF ( ALLOCATED( surf_v(2)%qisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(2)%qisws
-       CASE ( 'surf_v(2)%nisws' )
-          IF ( ALLOCATED( surf_v(2)%nisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(2)%nisws
-       CASE ( 'surf_v(2)%qrsws' )
-          IF ( ALLOCATED( surf_v(2)%qrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(2)%qrsws
-       CASE ( 'surf_v(2)%nrsws' )
-          IF ( ALLOCATED( surf_v(2)%nrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(2)%nrsws
-       CASE ( 'surf_v(2)%sasws' )
-          IF ( ALLOCATED( surf_v(2)%sasws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(2)%sasws
-       CASE ( 'surf_v(2)%mom_uv' )
-          IF ( ALLOCATED( surf_v(2)%mom_flux_uv )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_v(2)%mom_flux_uv
-       CASE ( 'surf_v(2)%mom_w' )
-          IF ( ALLOCATED( surf_v(2)%mom_flux_w )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_v(2)%mom_flux_w
-       CASE ( 'surf_v(2)%mom_tke' )
-          IF ( ALLOCATED( surf_v(2)%mom_flux_tke )  .AND.  kk == 1 )                               &
-             READ ( 13 ) surf_v(2)%mom_flux_tke
-       CASE ( 'surf_v(3)%start_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_v(3)%start_index
-          l = 3
-       CASE ( 'surf_v(3)%end_index' )
-          IF ( kk == 1 )                                                                           &
-             READ ( 13 ) surf_v(3)%end_index
-       CASE ( 'surf_v(3)%us' )
-          IF ( ALLOCATED( surf_v(3)%us )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(3)%us
-       CASE ( 'surf_v(3)%ts' )
-          IF ( ALLOCATED( surf_v(3)%ts )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(3)%ts
-       CASE ( 'surf_v(3)%qs' )
-          IF ( ALLOCATED( surf_v(3)%qs )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(3)%qs
-       CASE ( 'surf_v(3)%ss' )
-          IF ( ALLOCATED( surf_v(3)%ss )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(3)%ss
-       CASE ( 'surf_v(3)%qcs' )
-          IF ( ALLOCATED( surf_v(3)%qcs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(3)%qcs
-       CASE ( 'surf_v(3)%ncs' )
-          IF ( ALLOCATED( surf_v(3)%ncs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(3)%ncs
-       CASE ( 'surf_v(3)%qis' )
-          IF ( ALLOCATED( surf_v(3)%qis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(3)%qis
-       CASE ( 'surf_v(3)%nis' )
-          IF ( ALLOCATED( surf_v(3)%nis )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(3)%nis
-       CASE ( 'surf_v(3)%qrs' )
-          IF ( ALLOCATED( surf_v(3)%qrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(3)%qrs
-       CASE ( 'surf_v(3)%nrs' )
-          IF ( ALLOCATED( surf_v(3)%nrs )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(3)%nrs
-       CASE ( 'surf_v(3)%ol' )
-          IF ( ALLOCATED( surf_v(3)%ol )  .AND.  kk == 1 )                                         &
-             READ ( 13 ) surf_v(3)%ol
-       CASE ( 'surf_v(3)%rib' )
-          IF ( ALLOCATED( surf_v(3)%rib )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(3)%rib
-       CASE ( 'surf_v(3)%pt_surface' )
-          IF ( ALLOCATED( surf_v(3)%pt_surface )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_v(3)%pt_surface
-       CASE ( 'surf_v(3)%q_surface' )
-          IF ( ALLOCATED( surf_v(3)%q_surface )  .AND.  kk == 1 )                                  &
-             READ ( 13 ) surf_v(3)%q_surface
-       CASE ( 'surf_v(3)%vpt_surface' )
-          IF ( ALLOCATED( surf_v(3)%vpt_surface )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_v(3)%vpt_surface
-       CASE ( 'surf_v(3)%shf' )
-          IF ( ALLOCATED( surf_v(3)%shf )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(3)%shf
-       CASE ( 'surf_v(3)%qsws' )
-          IF ( ALLOCATED( surf_v(3)%qsws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_v(3)%qsws
-       CASE ( 'surf_v(3)%ssws' )
-          IF ( ALLOCATED( surf_v(3)%ssws )  .AND.  kk == 1 )                                       &
-             READ ( 13 ) surf_v(3)%ssws
-       CASE ( 'surf_v(3)%css' )
-          IF ( ALLOCATED( surf_v(3)%css )  .AND.  kk == 1 )                                        &
-             READ ( 13 ) surf_v(3)%css
-       CASE ( 'surf_v(3)%cssws' )
-          IF ( ALLOCATED( surf_v(3)%cssws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(3)%cssws
-       CASE ( 'surf_v(3)%qcsws' )
-          IF ( ALLOCATED( surf_v(3)%qcsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(3)%qcsws
-       CASE ( 'surf_v(3)%ncsws' )
-          IF ( ALLOCATED( surf_v(3)%ncsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(3)%ncsws
-       CASE ( 'surf_v(3)%qisws' )
-          IF ( ALLOCATED( surf_v(3)%qisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(3)%qisws
-       CASE ( 'surf_v(3)%nisws' )
-          IF ( ALLOCATED( surf_v(3)%nisws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(3)%nisws
-       CASE ( 'surf_v(3)%qrsws' )
-          IF ( ALLOCATED( surf_v(3)%qrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(3)%qrsws
-       CASE ( 'surf_v(3)%nrsws' )
-          IF ( ALLOCATED( surf_v(3)%nrsws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(3)%nrsws
-       CASE ( 'surf_v(3)%sasws' )
-          IF ( ALLOCATED( surf_v(3)%sasws )  .AND.  kk == 1 )                                      &
-             READ ( 13 ) surf_v(3)%sasws
-       CASE ( 'surf_v(3)%mom_uv' )
-          IF ( ALLOCATED( surf_v(3)%mom_flux_uv )  .AND.  kk == 1 )                                &
-             READ ( 13 ) surf_v(3)%mom_flux_uv
-       CASE ( 'surf_v(3)%mom_w' )
-          IF ( ALLOCATED( surf_v(3)%mom_flux_w )  .AND.  kk == 1 )                                 &
-             READ ( 13 ) surf_v(3)%mom_flux_w
-       CASE ( 'surf_v(3)%mom_tke' )
-          IF ( ALLOCATED( surf_v(3)%mom_flux_tke )  .AND.  kk == 1 )                               &
-             READ ( 13 ) surf_v(3)%mom_flux_tke
-
-       CASE DEFAULT
-
-             found = .FALSE.
-
-    END SELECT
-!
-!-- Redistribute surface elements on its respective type. Start with horizontally orientated surfaces.
-    IF ( horizontal_surface  .AND.                                                                 &
-         .NOT. INDEX( restart_string(1:length), '%start_index' ) /= 0 )                            &
-    THEN
-
-       ic = nxlc
-       DO  i = nxlf, nxrf
-          jc = nysc
-          DO  j = nysf, nynf
-!
-!--          Determine type of surface element, i.e. default, natural, urban, at current grid point.
-             surf_match_def  = surf_def_h(l)%end_index(jc,ic) >= surf_def_h(l)%start_index(jc,ic)
-             IF ( l < 2 ) THEN
-                surf_match_lsm  = surf_lsm_h(l)%end_index(jc,ic) >= surf_lsm_h(l)%start_index(jc,ic)
-                surf_match_usm  = surf_usm_h(l)%end_index(jc,ic) >= surf_usm_h(l)%start_index(jc,ic)
-             ELSE
-                surf_match_lsm  = .FALSE.
-                surf_match_usm  = .FALSE.
-             ENDIF
-!
-!--          Write restart data onto default-type surfaces if required.
-             IF ( surf_match_def )  THEN
-!
-!--             Set the start index for the local surface element
-                mm = surf_def_h(l)%start_index(jc,ic)
-!
-!--             For index pair (j,i) on file loop from start to end index, and in case the local
-!--             surface element mm is smaller than the local end index, assign the respective
-!--             surface data to this element.
-                DO  m = surf_h(l)%start_index(j,i), surf_h(l)%end_index(j,i)
-                   IF ( surf_def_h(l)%end_index(jc,ic) >= mm )                                     &
-                      CALL restore_surface_elements( surf_def_h(l), mm, surf_h(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-!
-!--          Same for natural-type surfaces. Please note, it is implicitly assumed that natural
-!--          surface elements are below urban surface elements if there are several horizontal
-!--          surfaces at (j,i). An example would be bridges.
-             IF ( surf_match_lsm )  THEN
-                mm = surf_lsm_h(l)%start_index(jc,ic)
-                DO  m = surf_h(l)%start_index(j,i), surf_h(l)%end_index(j,i)
-                   IF ( surf_lsm_h(l)%end_index(jc,ic) >= mm )                                        &
-                      CALL restore_surface_elements( surf_lsm_h(l), mm, surf_h(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-!
-!--          Same for urban-type surfaces
-             IF ( surf_match_usm )  THEN
-                mm = surf_usm_h(l)%start_index(jc,ic)
-                DO  m = surf_h(l)%start_index(j,i), surf_h(l)%end_index(j,i)
-                   IF ( surf_usm_h(l)%end_index(jc,ic) >= mm )                                        &
-                      CALL restore_surface_elements( surf_usm_h(l), mm, surf_h(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-
-             jc = jc + 1
-          ENDDO
-          ic = ic + 1
-       ENDDO
-    ELSEIF ( vertical_surface  .AND.                                                               &
-             .NOT. INDEX( restart_string(1:length), '%start_index' ) /= 0 )  THEN
-       ic = nxlc
-       DO  i = nxlf, nxrf
-          jc = nysc
-          DO  j = nysf, nynf
-!
-!--          Determine type of surface element, i.e. default, natural, urban, at current grid point.
-             surf_match_def = surf_def_v(l)%end_index(jc,ic) >= surf_def_v(l)%start_index(jc,ic)
-             surf_match_lsm = surf_lsm_v(l)%end_index(jc,ic) >= surf_lsm_v(l)%start_index(jc,ic)
-             surf_match_usm = surf_usm_v(l)%end_index(jc,ic) >= surf_usm_v(l)%start_index(jc,ic)
-!
-!--          Write restart data onto default-type surfaces if required.
-             IF ( surf_match_def )  THEN
-!
-!--             Set the start index for the local surface element
-                mm = surf_def_v(l)%start_index(jc,ic)
-!
-!--             For index pair (j,i) on file loop from start to end index, and in case the local
-!--             surface element mm is smaller than the local end index, assign the respective
-!--             surface data to this element.
-                DO  m = surf_v(l)%start_index(j,i), surf_v(l)%end_index(j,i)
-                   IF ( surf_def_v(l)%end_index(jc,ic) >= mm )                                     &
-                      CALL restore_surface_elements( surf_def_v(l), mm, surf_v(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-!
-!--          Same for natural-type surfaces. Please note, it is implicitly assumed that natural
-!--          surface elements are below urban surface elements if there are several vertical
-!--          surfaces at (j,i). An example a terrain elevations with a building on top. So far,
-!--          initialization of urban surfaces below natural surfaces on the same (j,i) is not
-!--          possible, so that this case cannot occur.
-             IF ( surf_match_lsm )  THEN
-                mm = surf_lsm_v(l)%start_index(jc,ic)
-                DO  m = surf_v(l)%start_index(j,i), surf_v(l)%end_index(j,i)
-                   IF ( surf_lsm_v(l)%end_index(jc,ic) >= mm )                                     &
-                      CALL restore_surface_elements( surf_lsm_v(l), mm, surf_v(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-
-             IF ( surf_match_usm )  THEN
-                mm = surf_usm_v(l)%start_index(jc,ic)
-                DO  m = surf_v(l)%start_index(j,i), surf_v(l)%end_index(j,i)
-                   IF ( surf_usm_v(l)%end_index(jc,ic) >= mm )                                     &
-                      CALL restore_surface_elements( surf_usm_v(l), mm, surf_v(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-
-             jc = jc + 1
-          ENDDO
-          ic = ic + 1
-       ENDDO
-    ENDIF
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Restores surface elements back on its respective type.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE restore_surface_elements( surf_target, m_target, surf_file, m_file )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  m_file    !< respective surface-element index of current surface array
-    INTEGER(iwp) ::  m_target  !< respecitve surface-element index of surface array on file
-    INTEGER(iwp) ::  lsp       !< running index chemical species
-
-    TYPE(surf_type) ::  surf_target  !< target surface type
-    TYPE(surf_type) ::  surf_file    !< surface type on file
-
-
-    IF ( INDEX( restart_string(1:length), '%us' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%us )  .AND.  ALLOCATED( surf_file%us ) )                        &
-          surf_target%us(m_target) = surf_file%us(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%ol' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%ol )  .AND.  ALLOCATED( surf_file%ol ) )                        &
-          surf_target%ol(m_target) = surf_file%ol(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%pt_surface' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%pt_surface )  .AND.  ALLOCATED( surf_file%pt_surface ) )        &
-          surf_target%pt_surface(m_target) = surf_file%pt_surface(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%q_surface' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%q_surface )  .AND.  ALLOCATED( surf_file%q_surface ) )          &
-          surf_target%q_surface(m_target) = surf_file%q_surface(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%vpt_surface' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%vpt_surface )  .AND.  ALLOCATED( surf_file%vpt_surface ) )      &
-          surf_target%vpt_surface(m_target) = surf_file%vpt_surface(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%usws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%usws )  .AND.  ALLOCATED( surf_file%usws ) )                    &
-          surf_target%usws(m_target) = surf_file%usws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%vsws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%vsws )  .AND.  ALLOCATED( surf_file%vsws ) )                    &
-          surf_target%vsws(m_target) = surf_file%vsws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%ts' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%ts )  .AND.  ALLOCATED( surf_file%ts ) )                        &
-          surf_target%ts(m_target) = surf_file%ts(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%shf' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%shf )  .AND.  ALLOCATED( surf_file%shf ) )                      &
-          surf_target%shf(m_target) = surf_file%shf(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%qs' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%qs )  .AND.  ALLOCATED( surf_file%qs ) )                        &
-          surf_target%qs(m_target) = surf_file%qs(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%qsws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%qsws )  .AND.  ALLOCATED( surf_file%qsws ) )                    &
-          surf_target%qsws(m_target) = surf_file%qsws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%ss' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%ss )  .AND.  ALLOCATED( surf_file%ss ) )                        &
-          surf_target%ss(m_target) = surf_file%ss(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%ssws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%ssws )  .AND.  ALLOCATED( surf_file%ssws ) )                    &
-          surf_target%ssws(m_target) = surf_file%ssws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%css' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%css )  .AND.  ALLOCATED( surf_file%css ) )  THEN
-          DO  lsp = 1, nvar
-             surf_target%css(lsp,m_target) = surf_file%css(lsp,m_file)
-          ENDDO
-       ENDIF
-    ENDIF
-    IF ( INDEX( restart_string(1:length), '%cssws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%cssws )  .AND.  ALLOCATED( surf_file%cssws ) )  THEN
-          DO  lsp = 1, nvar
-             surf_target%cssws(lsp,m_target) = surf_file%cssws(lsp,m_file)
-          ENDDO
-       ENDIF
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%qcs' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%qcs )  .AND.  ALLOCATED( surf_file%qcs ) )                      &
-         surf_target%qcs(m_target) = surf_file%qcs(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%qcsws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%qcsws )  .AND.  ALLOCATED( surf_file%qcsws ) )                  &
-          surf_target%qcsws(m_target) = surf_file%qcsws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%ncs' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%ncs )  .AND.  ALLOCATED( surf_file%ncs ) )                      &
-          surf_target%ncs(m_target) = surf_file%ncs(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%ncsws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%ncsws )  .AND.  ALLOCATED( surf_file%ncsws ) )                  &
-          surf_target%ncsws(m_target) = surf_file%ncsws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%qis' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%qis )  .AND.  ALLOCATED( surf_file%qis ) )                      &
-         surf_target%qis(m_target) = surf_file%qis(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%qisws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%qisws )  .AND.  ALLOCATED( surf_file%qisws ) )                  &
-          surf_target%qisws(m_target) = surf_file%qisws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%nis' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%nis )  .AND.  ALLOCATED( surf_file%nis ) )                      &
-          surf_target%nis(m_target) = surf_file%nis(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%nisws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%nisws )  .AND.  ALLOCATED( surf_file%nisws ) )                  &
-          surf_target%nisws(m_target) = surf_file%nisws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%qrs' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%qrs )  .AND.  ALLOCATED( surf_file%qrs ) )                      &
-         surf_target%qrs(m_target) = surf_file%qrs(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%qrsws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%qrsws )  .AND.  ALLOCATED( surf_file%qrsws ) )                  &
-          surf_target%qrsws(m_target) = surf_file%qrsws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%nrs' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%nrs )  .AND.  ALLOCATED( surf_file%nrs ) )                      &
-          surf_target%nrs(m_target) = surf_file%nrs(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%nrsws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%nrsws )  .AND.  ALLOCATED( surf_file%nrsws ) )                  &
-          surf_target%nrsws(m_target) = surf_file%nrsws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%sasws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%sasws )  .AND.  ALLOCATED( surf_file%sasws ) )                  &
-          surf_target%sasws(m_target) = surf_file%sasws(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%mom_uv' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%mom_flux_uv )  .AND.  ALLOCATED( surf_file%mom_flux_uv ) )      &
-          surf_target%mom_flux_uv(m_target) = surf_file%mom_flux_uv(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%mom_w' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%mom_flux_w )  .AND.  ALLOCATED( surf_file%mom_flux_w ) )        &
-          surf_target%mom_flux_w(m_target) = surf_file%mom_flux_w(m_file)
-    ENDIF
-
-    IF ( INDEX( restart_string(1:length), '%mom_tke' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%mom_flux_tke )  .AND.                                           &
-            ALLOCATED( surf_file%mom_flux_tke ) )                                                  &
-          surf_target%mom_flux_tke(0:1,m_target) = surf_file%mom_flux_tke(0:1,m_file)
-    ENDIF
-
-
- END SUBROUTINE restore_surface_elements
-
- END SUBROUTINE surface_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads surface-related restart data in MPI-IO format. TO_DO: this routine needs to be adjusted for
-!> cyclic_fill mode
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_rrd_local_mpi
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1) ::  dum  !< dummy string to create input-variable name
-
-    INTEGER(iwp) ::  i  !< loop index, x-direction
-    INTEGER(iwp) ::  j  !< loop index, y-direction
-    INTEGER(iwp) ::  l  !< loop index for surface orientation
-    INTEGER(iwp) ::  m  !< loop index for surface types - target array
-    INTEGER(iwp) ::  mm !< loop index for surface types - file array
-
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_end_index    !< end index for surface data (MPI-IO)
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_start_index  !< start index for surface data (MPI-IO)
-
-    LOGICAL ::  data_to_read    !< cycle in l loop, if no values to read
-    LOGICAL ::  surf_match_def  !< flag indicating that surface element is of default type
-    LOGICAL ::  surf_match_lsm  !< flag indicating that surface element is of natural type
-    LOGICAL ::  surf_match_usm  !< flag indicating that surface element is of urban type
-
-    TYPE(surf_type), DIMENSION(0:2) ::  surf_h  !< gathered horizontal surfaces, contains all surface types
-    TYPE(surf_type), DIMENSION(0:3) ::  surf_v  !< gathered vertical surfaces, contains all surface types
-
-!
-!-- Get total number of surface points on the file
-    CALL rrd_mpi_io_global_array( 'ns_h_on_file', ns_h_on_file )
-    CALL rrd_mpi_io_global_array( 'ns_v_on_file', ns_v_on_file )
-
-
-    DO  l = 0, 2
-
-       IF ( ns_h_on_file(l) == 0 )  CYCLE  !< No data of this surface type on file
-
-       WRITE( dum, '(I1)')  l
-
-       IF ( ALLOCATED( surf_h(l)%start_index ) )  CALL deallocate_surface_attributes_h( surf_h(l) )
-
-       ALLOCATE( surf_h(l)%start_index(nys:nyn,nxl:nxr) )
-       ALLOCATE( surf_h(l)%end_index(nys:nyn,nxl:nxr) )
-       surf_h(l)%start_index = 0
-       surf_h(l)%end_index   = -1
-
-       CALL rrd_mpi_io( 'global_start_index_h_' // dum , global_start_index )
-       CALL rrd_mpi_io( 'global_end_index_h_' // dum , global_end_index )
-
-       CALL rd_mpi_io_surface_filetypes( surf_h(l)%start_index, surf_h(l)%end_index, data_to_read, &
-                                         global_start_index, global_end_index )
-
-       surf_h(l)%ns = MAX( 2, MAXVAL( surf_h(l)%end_index ) )
-
-       CALL allocate_surface_attributes_h( surf_h(l), nys, nyn, nxl, nxr,                          &
-                                           no_allocate_index_arrays = .TRUE. )
-       IF ( .NOT. data_to_read )  CYCLE
-
-       IF ( ALLOCATED ( surf_h(l)%us ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%us', surf_h(l)%us )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%ts ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%ts', surf_h(l)%ts )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%qs ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%qs', surf_h(l)%qs )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%ss ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%ss', surf_h(l)%ss )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%qcs ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%qcs', surf_h(l)%qcs )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%ncs ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%ncs', surf_h(l)%ncs )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%qis ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%qis', surf_h(l)%qis )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%nis ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%nis', surf_h(l)%nis )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%qrs ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%qrs', surf_h(l)%qrs )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%nrs ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%nrs', surf_h(l)%nrs )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%ol ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%ol', surf_h(l)%ol )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%rib ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%rib',  surf_h(l)%rib )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%pt_surface ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%pt_surface', surf_h(l)%pt_surface )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%q_surface ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%q_surface', surf_h(l)%q_surface )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%vpt_surface ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%vpt_surface', surf_h(l)%vpt_surface )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%usws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%usws', surf_h(l)%usws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%vsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%vsws', surf_h(l)%vsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%shf ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%shf', surf_h(l)%shf )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%qsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%qsws', surf_h(l)%qsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%ssws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%ssws', surf_h(l)%ssws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%css ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%css', surf_h(l)%css )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%cssws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%cssws', surf_h(l)%cssws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%qcsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%qcsws', surf_h(l)%qcsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%ncsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%ncsws', surf_h(l)%ncsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%qisws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%qisws', surf_h(l)%qisws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%nisws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%nisws', surf_h(l)%nisws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%qrsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%qrsws', surf_h(l)%qrsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%nrsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%nrsws', surf_h(l)%nrsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_h(l)%sasws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_h(' // dum // ')%sasws', surf_h(l)%sasws )
-       ENDIF
-
-    ENDDO
-
-!
-!-- Read vertical surfaces
-    DO  l = 0, 3
-
-       IF ( ns_v_on_file(l) == 0 )  CYCLE  !< No data of this surface type on file
-
-       IF ( ALLOCATED( surf_v(l)%start_index ) )  CALL deallocate_surface_attributes_v( surf_v(l) )
-
-       ALLOCATE( surf_v(l)%start_index(nys:nyn,nxl:nxr) )
-       ALLOCATE( surf_v(l)%end_index(nys:nyn,nxl:nxr) )
-       surf_v(l)%start_index = 0
-       surf_v(l)%end_index   = -1
-
-       WRITE( dum, '(I1)' )  l
-
-       CALL rrd_mpi_io( 'global_start_index_v_' // dum , global_start_index )
-       CALL rrd_mpi_io( 'global_end_index_v_' // dum , global_end_index )
-
-       CALL rd_mpi_io_surface_filetypes( surf_v(l)%start_index, surf_v(l)%end_index, data_to_read, &
-                                         global_start_index, global_end_index )
-       IF ( .NOT. data_to_read )  CYCLE
-
-       surf_v(l)%ns = MAX( 2, MAXVAL( surf_v(l)%end_index ) )
-       CALL allocate_surface_attributes_v( surf_v(l), nys, nyn, nxl, nxr,                          &
-                                           no_allocate_index_arrays = .TRUE.  )
-
-       IF ( ALLOCATED ( surf_v(l)%us ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%us',  surf_v(l)%us )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%ts ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%ts', surf_v(l)%ts )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%qs ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%qs',  surf_v(l)%qs )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%ss ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%ss',  surf_v(l)%ss )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%qcs ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%qcs', surf_v(l)%qcs )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%ncs ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%ncs', surf_v(l)%ncs )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%qis ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%qis', surf_v(l)%qis )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%nis ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%nis', surf_v(l)%nis )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%qrs ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%qrs', surf_v(l)%qrs )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%nrs ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%nrs', surf_v(l)%nrs )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%ol ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%ol', surf_v(l)%ol )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%rib ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%rib', surf_v(l)%rib )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%pt_surface ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%pt_surface', surf_v(l)%pt_surface )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%q_surface ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%q_surface', surf_v(l)%q_surface )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%vpt_surface ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%vpt_surface', surf_v(l)%vpt_surface )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%shf ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%shf', surf_v(l)%shf )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%qsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%qsws', surf_v(l)%qsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%ssws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%ssws', surf_v(l)%ssws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%css ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%css', surf_v(l)%css )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%cssws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%cssws', surf_v(l)%cssws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%qcsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%qcsws', surf_v(l)%qcsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%ncsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%ncsws', surf_v(l)%ncsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%qisws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%qisws', surf_v(l)%qisws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%nisws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%nisws', surf_v(l)%nisws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%qrsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%qrsws', surf_v(l)%qrsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%nrsws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%nrsws', surf_v(l)%nrsws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%sasws ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%sasws', surf_v(l)%sasws )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%mom_flux_uv ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_uv', surf_v(l)%mom_flux_uv )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%mom_flux_w ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_w',  surf_v(l)%mom_flux_w )
-       ENDIF
-
-       IF ( ALLOCATED ( surf_v(l)%mom_flux_tke ) )  THEN
-          CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_tke', surf_v(l)%mom_flux_tke )
-       ENDIF
-
-    ENDDO
-
-!
-!-- Redistribute surface elements on its respective type. Start with horizontal default surfaces.
-    DO  l = 0, 2
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             surf_match_def  = surf_def_h(l)%end_index(j,i) >= surf_def_h(l)%start_index(j,i)
-             IF ( l < 2 )  THEN
-                surf_match_lsm  = surf_lsm_h(l)%end_index(j,i) >= surf_lsm_h(l)%start_index(j,i)
-                surf_match_usm  = surf_usm_h(l)%end_index(j,i) >= surf_usm_h(l)%start_index(j,i)
-             ELSE
-                surf_match_lsm  = .FALSE.
-                surf_match_usm  = .FALSE.
-             ENDIF
-             IF ( surf_match_def )  THEN
-!
-!--             Set the start index for the local surface element
-                mm = surf_def_h(l)%start_index(j,i)
-!
-!--             For index pair (j,i) on file loop from start to end index, and in case the local
-!--             surface element mm is smaller than the local end index, assign the respective
-!--             surface data to this element.
-                DO  m = surf_h(l)%start_index(j,i), surf_h(l)%end_index(j,i)
-                   IF ( surf_def_h(l)%end_index(j,i) >= mm )                                       &
-                      CALL restore_surface_elements( surf_def_h(l), mm, surf_h(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-!--          Natural- and urban-like horizontal surfaces.
-             IF ( surf_match_lsm )  THEN
-                mm = surf_lsm_h(l)%start_index(j,i)
-                DO  m = surf_h(l)%start_index(j,i), surf_h(l)%end_index(j,i)
-                   IF ( surf_lsm_h(l)%end_index(j,i) >= mm )                                             &
-                      CALL restore_surface_elements( surf_lsm_h(l), mm, surf_h(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-             IF ( surf_match_usm )  THEN
-                mm = surf_usm_h(l)%start_index(j,i)
-                DO  m = surf_h(l)%start_index(j,i), surf_h(l)%end_index(j,i)
-                   IF ( surf_usm_h(l)%end_index(j,i) >= mm )                                             &
-                      CALL restore_surface_elements( surf_usm_h(l), mm, surf_h(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Same for vertical surfaces.
-    DO  l = 0, 3
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             surf_match_def  = surf_def_v(l)%end_index(j,i) >= surf_def_v(l)%start_index(j,i)
-             surf_match_lsm  = surf_lsm_v(l)%end_index(j,i) >= surf_lsm_v(l)%start_index(j,i)
-             surf_match_usm  = surf_usm_v(l)%end_index(j,i) >= surf_usm_v(l)%start_index(j,i)
-
-             IF ( surf_match_def )  THEN
-                mm = surf_def_v(l)%start_index(j,i)
-                DO  m = surf_v(l)%start_index(j,i), surf_v(l)%end_index(j,i)
-                   IF ( surf_def_v(l)%end_index(j,i) >= mm )                                       &
-                      CALL restore_surface_elements( surf_def_v(l), mm, surf_v(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-             IF ( surf_match_lsm )  THEN
-                mm = surf_lsm_v(l)%start_index(j,i)
-                DO  m = surf_v(l)%start_index(j,i), surf_v(l)%end_index(j,i)
-                   IF ( surf_lsm_v(l)%end_index(j,i) >= mm )                                       &
-                      CALL restore_surface_elements( surf_lsm_v(l), mm, surf_v(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-             IF ( surf_match_usm )  THEN
-                mm = surf_usm_v(l)%start_index(j,i)
-                DO  m = surf_v(l)%start_index(j,i), surf_v(l)%end_index(j,i)
-                   IF ( surf_usm_v(l)%end_index(j,i) >= mm )                                       &
-                      CALL restore_surface_elements( surf_usm_v(l), mm, surf_v(l), m )
-                   mm = mm + 1
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Restores surface elements back on its respective type.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE restore_surface_elements( surf_target, m_target, surf_file, m_file )
-
-    INTEGER(iwp) ::  m_file    !< respective surface-element index of current surface array
-    INTEGER(iwp) ::  m_target  !< respecitve surface-element index of surface array on file
-    INTEGER(iwp) ::  lsp       !< running index chemical species
-
-    TYPE(surf_type) ::  surf_target  !< target surface type
-    TYPE(surf_type) ::  surf_file    !< surface type on file
-
-    IF ( ALLOCATED( surf_target%us )  .AND.  ALLOCATED( surf_file%us ) )                           &
-       surf_target%us(m_target) = surf_file%us(m_file)
-
-    IF ( ALLOCATED( surf_target%ol )  .AND.  ALLOCATED( surf_file%ol ) )                           &
-       surf_target%ol(m_target) = surf_file%ol(m_file)
-
-    IF ( ALLOCATED( surf_target%rib )  .AND.  ALLOCATED( surf_file%rib ) )                         &
-       surf_target%rib(m_target) = surf_file%rib(m_file)
-
-    IF ( ALLOCATED( surf_target%ol )  .AND.  ALLOCATED( surf_file%ol ) )                           &
-       surf_target%ol(m_target) = surf_file%ol(m_file)
-
-    IF ( ALLOCATED( surf_target%pt_surface )  .AND.  ALLOCATED( surf_file%pt_surface ) )           &
-       surf_target%pt_surface(m_target) = surf_file%pt_surface(m_file)
-
-    IF ( ALLOCATED( surf_target%q_surface )  .AND.  ALLOCATED( surf_file%q_surface ) )             &
-       surf_target%q_surface(m_target) = surf_file%q_surface(m_file)
-
-    IF ( ALLOCATED( surf_target%vpt_surface )  .AND.  ALLOCATED( surf_file%vpt_surface ) )         &
-       surf_target%vpt_surface(m_target) = surf_file%vpt_surface(m_file)
-
-    IF ( ALLOCATED( surf_target%usws )  .AND.  ALLOCATED( surf_file%usws ) )                       &
-       surf_target%usws(m_target) = surf_file%usws(m_file)
-
-    IF ( ALLOCATED( surf_target%vsws )  .AND.  ALLOCATED( surf_file%vsws ) )                       &
-       surf_target%vsws(m_target) = surf_file%vsws(m_file)
-
-    IF ( ALLOCATED( surf_target%ts )  .AND.  ALLOCATED( surf_file%ts ) )                           &
-       surf_target%ts(m_target) = surf_file%ts(m_file)
-
-    IF ( ALLOCATED( surf_target%shf )  .AND.  ALLOCATED( surf_file%shf ) )                         &
-       surf_target%shf(m_target) = surf_file%shf(m_file)
-
-    IF ( ALLOCATED( surf_target%qs )  .AND.  ALLOCATED( surf_file%qs ) )                           &
-       surf_target%qs(m_target) = surf_file%qs(m_file)
-
-    IF ( ALLOCATED( surf_target%qsws )  .AND.  ALLOCATED( surf_file%qsws ) )                       &
-       surf_target%qsws(m_target) = surf_file%qsws(m_file)
-
-    IF ( ALLOCATED( surf_target%ss )  .AND.  ALLOCATED( surf_file%ss ) )                           &
-       surf_target%ss(m_target) = surf_file%ss(m_file)
-
-    IF ( ALLOCATED( surf_target%ssws )  .AND.  ALLOCATED( surf_file%ssws ) )                       &
-       surf_target%ssws(m_target) = surf_file%ssws(m_file)
-
-    IF ( ALLOCATED( surf_target%css )  .AND.  ALLOCATED( surf_file%css ) )  THEN
-       DO  lsp = 1, nvar
-          surf_target%css(lsp,m_target) = surf_file%css(lsp,m_file)
-       ENDDO
-    ENDIF
-
-    IF ( ALLOCATED( surf_target%cssws )  .AND.  ALLOCATED( surf_file%cssws ) )  THEN
-       DO  lsp = 1, nvar
-          surf_target%cssws(lsp,m_target) = surf_file%cssws(lsp,m_file)
-       ENDDO
-    ENDIF
-
-    IF ( ALLOCATED( surf_target%qcs )  .AND.  ALLOCATED( surf_file%qcs ) )                         &
-      surf_target%qcs(m_target) = surf_file%qcs(m_file)
-
-    IF ( ALLOCATED( surf_target%qcsws )  .AND.  ALLOCATED( surf_file%qcsws ) )                     &
-       surf_target%qcsws(m_target) = surf_file%qcsws(m_file)
-
-    IF ( ALLOCATED( surf_target%ncs )  .AND.  ALLOCATED( surf_file%ncs ) )                         &
-       surf_target%ncs(m_target) = surf_file%ncs(m_file)
-
-    IF ( ALLOCATED( surf_target%ncsws )  .AND.  ALLOCATED( surf_file%ncsws ) )                     &
-       surf_target%ncsws(m_target) = surf_file%ncsws(m_file)
-
-    IF ( ALLOCATED( surf_target%qis )  .AND.  ALLOCATED( surf_file%qis ) )                         &
-      surf_target%qis(m_target) = surf_file%qis(m_file)
-
-    IF ( ALLOCATED( surf_target%qisws )  .AND.  ALLOCATED( surf_file%qisws ) )                     &
-       surf_target%qisws(m_target) = surf_file%qisws(m_file)
-
-    IF ( ALLOCATED( surf_target%nis )  .AND.  ALLOCATED( surf_file%nis ) )                         &
-       surf_target%nis(m_target) = surf_file%nis(m_file)
-
-    IF ( ALLOCATED( surf_target%nisws )  .AND.  ALLOCATED( surf_file%nisws ) )                     &
-       surf_target%nisws(m_target) = surf_file%nisws(m_file)
-
-    IF ( ALLOCATED( surf_target%qrs )  .AND.  ALLOCATED( surf_file%qrs ) )                         &
-       surf_target%qrs(m_target) = surf_file%qrs(m_file)
-
-    IF ( ALLOCATED( surf_target%qrsws )  .AND.  ALLOCATED( surf_file%qrsws ) )                     &
-       surf_target%qrsws(m_target) = surf_file%qrsws(m_file)
-
-    IF ( ALLOCATED( surf_target%nrs )  .AND.  ALLOCATED( surf_file%nrs ) )                         &
-       surf_target%nrs(m_target) = surf_file%nrs(m_file)
-
-    IF ( ALLOCATED( surf_target%nrsws )  .AND.  ALLOCATED( surf_file%nrsws ) )                     &
-       surf_target%nrsws(m_target) = surf_file%nrsws(m_file)
-
-    IF ( ALLOCATED( surf_target%sasws )  .AND.  ALLOCATED( surf_file%sasws ) )                     &
-       surf_target%sasws(m_target) = surf_file%sasws(m_file)
-
-    IF ( ALLOCATED( surf_target%mom_flux_uv )  .AND.  ALLOCATED( surf_file%mom_flux_uv ) )         &
-       surf_target%mom_flux_uv(m_target) = surf_file%mom_flux_uv(m_file)
-
-    IF ( ALLOCATED( surf_target%mom_flux_w )  .AND.  ALLOCATED( surf_file%mom_flux_w ) )           &
-       surf_target%mom_flux_w(m_target) = surf_file%mom_flux_w(m_file)
-
-    IF ( ALLOCATED( surf_target%mom_flux_tke )  .AND.                                              &
-         ALLOCATED( surf_file%mom_flux_tke   ) )                                                   &
-       surf_target%mom_flux_tke(0:1,m_target) = surf_file%mom_flux_tke(0:1,m_file)
-
- END SUBROUTINE restore_surface_elements
-
- END SUBROUTINE surface_rrd_local_mpi
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Counts the number of surface elements with the same facing, required for reading and writing
-!> restart data.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_last_actions
-
-    IMPLICIT NONE
-!
-!-- Horizontal surfaces
-    ns_h_on_file(0) = surf_def_h(0)%ns + surf_lsm_h(0)%ns + surf_usm_h(0)%ns
-    ns_h_on_file(1) = surf_def_h(1)%ns + surf_lsm_h(1)%ns + surf_usm_h(1)%ns
-    ns_h_on_file(2) = surf_def_h(2)%ns
-!
-!-- Vertical surfaces
-    ns_v_on_file(0) = surf_def_v(0)%ns + surf_lsm_v(0)%ns + surf_usm_v(0)%ns
-    ns_v_on_file(1) = surf_def_v(1)%ns + surf_lsm_v(1)%ns + surf_usm_v(1)%ns
-    ns_v_on_file(2) = surf_def_v(2)%ns + surf_lsm_v(2)%ns + surf_usm_v(2)%ns
-    ns_v_on_file(3) = surf_def_v(3)%ns + surf_lsm_v(3)%ns + surf_usm_v(3)%ns
-
- END SUBROUTINE surface_last_actions
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Routine maps surface data read from file after restart - 1D arrays.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_restore_elements_1d( surf_target, surf_file, start_index_c,                    &
-                                         start_index_on_file, end_index_on_file, nxlc, nysc, nxlf, &
-                                         nxrf, nysf, nynf, nys_on_file, nyn_on_file, nxl_on_file,  &
-                                         nxr_on_file )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !< running index along x-direction, refers to former domain size
-    INTEGER(iwp) ::  ic    !< running index along x-direction, refers to current domain size
-    INTEGER(iwp) ::  j     !< running index along y-direction, refers to former domain size
-    INTEGER(iwp) ::  jc    !< running index along y-direction, refers to former domain size
-    INTEGER(iwp) ::  m     !< surface-element index on file
-    INTEGER(iwp) ::  mm    !< surface-element index on current subdomain
-    INTEGER(iwp) ::  nxlc  !< index of left boundary on current subdomain
-    INTEGER(iwp) ::  nxlf  !< index of left boundary on former subdomain
-    INTEGER(iwp) ::  nxrf  !< index of right boundary on former subdomain
-    INTEGER(iwp) ::  nysc  !< index of north boundary on current subdomain
-    INTEGER(iwp) ::  nynf  !< index of north boundary on former subdomain
-    INTEGER(iwp) ::  nysf  !< index of south boundary on former subdomain
-
-    INTEGER(iwp) ::  nxl_on_file  !< leftmost index on file
-    INTEGER(iwp) ::  nxr_on_file  !< rightmost index on file
-    INTEGER(iwp) ::  nyn_on_file  !< northmost index on file
-    INTEGER(iwp) ::  nys_on_file  !< southmost index on file
-
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  start_index_c  !<
-    INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) ::  start_index_on_file  !< start index of surface
-                                                                                                      !< elements on file
-    INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) ::  end_index_on_file    !< end index of surface
-                                                                                                      !< elements on file
-
-    REAL(wp), DIMENSION(:) ::  surf_target  !< target surface type
-    REAL(wp), DIMENSION(:) ::  surf_file    !< surface type on file
-
-    ic = nxlc
-    DO  i = nxlf, nxrf
-       jc = nysc
-       DO  j = nysf, nynf
-          mm = start_index_c(jc,ic)
-          DO  m = start_index_on_file(j,i), end_index_on_file(j,i)
-             surf_target(mm) = surf_file(m)
-             mm = mm + 1
-          ENDDO
-          jc = jc + 1
-       ENDDO
-       ic = ic + 1
-    ENDDO
-
-
- END SUBROUTINE surface_restore_elements_1d
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Routine maps surface data read from file after restart - 2D arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE surface_restore_elements_2d( surf_target, surf_file, start_index_c,                    &
-                                         start_index_on_file, end_index_on_file, nxlc, nysc, nxlf, &
-                                         nxrf, nysf, nynf, nys_on_file, nyn_on_file, nxl_on_file,  &
-                                         nxr_on_file )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !< running index along x-direction, refers to former domain size
-    INTEGER(iwp) ::  ic    !< running index along x-direction, refers to current domain size
-    INTEGER(iwp) ::  j     !< running index along y-direction, refers to former domain size
-    INTEGER(iwp) ::  jc    !< running index along y-direction, refers to former domain size
-    INTEGER(iwp) ::  m     !< surface-element index on file
-    INTEGER(iwp) ::  mm    !< surface-element index on current subdomain
-    INTEGER(iwp) ::  nxlc  !< index of left boundary on current subdomain
-    INTEGER(iwp) ::  nxlf  !< index of left boundary on former subdomain
-    INTEGER(iwp) ::  nxrf  !< index of right boundary on former subdomain
-    INTEGER(iwp) ::  nysc  !< index of north boundary on current subdomain
-    INTEGER(iwp) ::  nynf  !< index of north boundary on former subdomain
-    INTEGER(iwp) ::  nysf  !< index of south boundary on former subdomain
-
-    INTEGER(iwp) ::  nxl_on_file  !< leftmost index on file
-    INTEGER(iwp) ::  nxr_on_file  !< rightmost index on file
-    INTEGER(iwp) ::  nyn_on_file  !< northmost index on file
-    INTEGER(iwp) ::  nys_on_file  !< southmost index on file
-
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  start_index_c !< start index of surface type
-
-    INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) ::  start_index_on_file  !< start index of surface
-                                                                                                      !< elements on file
-    INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) ::  end_index_on_file    !< end index of surface
-                                                                                                      !< elements on file
-
-    REAL(wp), DIMENSION(:,:) ::  surf_target !< target surface type
-    REAL(wp), DIMENSION(:,:) ::  surf_file   !< surface type on file
-
-    ic = nxlc
-    DO  i = nxlf, nxrf
-       jc = nysc
-       DO  j = nysf, nynf
-          mm = start_index_c(jc,ic)
-          DO  m = start_index_on_file(j,i), end_index_on_file(j,i)
-             surf_target(:,mm) = surf_file(:,m)
-             mm = mm + 1
-          ENDDO
-          jc = jc + 1
-       ENDDO
-       ic = ic + 1
-    ENDDO
-
- END SUBROUTINE surface_restore_elements_2d
-
-
- END MODULE surface_mod
Index: palm/trunk/SOURCE/swap_timelevel.f90
===================================================================
--- palm/trunk/SOURCE/swap_timelevel.f90	(revision 1)
+++ palm/trunk/SOURCE/swap_timelevel.f90	(revision 1)
@@ -0,0 +1,195 @@
+ SUBROUTINE swap_timelevel
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: swap_timelevel.f90,v $
+! Revision 1.8  2004/01/28 15:28:18  raasch
+! Swaping for Runge-Kutta schemes implemented
+!
+! Revision 1.7  2002/05/02 18:58:36  raasch
+! Swaping of prognostic quantities re-changed to three timelevels
+!
+! Revision 1.6  2001/08/21  10:01:58  10:01:58  raasch (Siegfried Raasch)
+! Surface momentum fluxes are swapped also when they are prescribed
+! 
+! Revision 1.5  2001/03/30 07:54:39  raasch
+! Swaping of prognostic quantities changed over from three to two timelevels,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.4  2001/01/29 12:36:03  raasch
+! Passive scalar is considered
+!
+! Revision 1.3  2001/01/25 07:26:48  raasch
+! Sensible and latent heat fluxes are swaped, when use_surface_fluxes = .TRUE.,
+! module test_variables removed
+!
+! Revision 1.2  2000/04/13 13:59:26  schroeter
+! + swapping timelevels of moisture variables
+!
+! Revision 1.1  2000/01/10  10:08:58  10:08:58  raasch (Siegfried Raasch)
+! Initial revision
+! 
+!
+! Description:
+! ------------
+! Swap of timelevels of variables after each timestep
+!-------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE cpulog
+    USE interfaces
+    USE control_parameters
+
+    IMPLICIT NONE
+
+
+    CALL cpu_log( log_point(28), 'swap_timelevel', 'start' )
+
+!
+!-- Incrementing timestep counter
+    timestep_count = timestep_count + 1
+
+!
+!-- Swap of 3-level variables
+    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+
+       SELECT CASE ( MOD( timestep_count, 3 ) )
+
+          CASE ( 0 )
+
+             u_m  => u_1;   u  => u_2;  u_p  => u_3
+             v_m  => v_1;   v  => v_2;  v_p  => v_3
+             w_m  => w_1;   w  => w_2;  w_p  => w_3
+             pt_m => pt_1;  pt => pt_2; pt_p => pt_3
+             IF ( .NOT. constant_diffusion )  THEN
+                e_m => e_1;  e => e_2;  e_p => e_3
+             ENDIF
+             IF ( moisture  .OR.  passive_scalar )  THEN
+                q_m => q_1;  q => q_2;  q_p => q_3
+             ENDIF
+
+          CASE ( 1 )
+
+             u_m  => u_2;   u  => u_3;  u_p  => u_1
+             v_m  => v_2;   v  => v_3;  v_p  => v_1
+             w_m  => w_2;   w  => w_3;  w_p  => w_1
+             pt_m => pt_2;  pt => pt_3; pt_p => pt_1
+             IF ( .NOT. constant_diffusion )  THEN
+                e_m => e_2;  e => e_3;  e_p => e_1
+             ENDIF
+             IF ( moisture  .OR.  passive_scalar )  THEN
+                q_m => q_2;  q => q_3;  q_p => q_1
+             ENDIF
+
+          CASE ( 2 )
+
+             u_m  => u_3;   u  => u_1;  u_p  => u_2
+             v_m  => v_3;   v  => v_1;  v_p  => v_2
+             w_m  => w_3;   w  => w_1;  w_p  => w_2
+             pt_m => pt_3;  pt => pt_1; pt_p => pt_2
+             IF ( .NOT. constant_diffusion )  THEN
+                e_m => e_3;  e => e_1;  e_p => e_2
+             ENDIF
+             IF ( moisture  .OR.  passive_scalar )  THEN
+                q_m => q_3;  q => q_1;  q_p => q_2
+             ENDIF
+
+       END SELECT
+
+    ENDIF
+
+!
+!-- Swap of 2-level variables
+    SELECT CASE ( MOD( timestep_count, 2 ) )
+
+       CASE ( 0 )
+
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+
+             u  => u_1;   u_p  => u_2
+             v  => v_1;   v_p  => v_2
+             w  => w_1;   w_p  => w_2
+             pt => pt_1;  pt_p => pt_2
+             IF ( .NOT. constant_diffusion )  THEN
+                e => e_1;  e_p => e_2
+             ENDIF
+             IF ( moisture  .OR.  passive_scalar )  THEN
+                q => q_1;  q_p => q_2
+             ENDIF
+
+          ELSE
+!
+!--          Old timelevels are needed for explicit diffusion within leapfrog
+             IF ( .NOT. constant_diffusion )  THEN
+                kh_m => kh_1;  kh => kh_2
+                km_m => km_1;  km => km_2
+                IF ( use_surface_fluxes )  THEN
+                   usws_m => usws_1;  usws => usws_2
+                   vsws_m => vsws_1;  vsws => vsws_2
+                   shf_m  => shf_1;   shf  => shf_2
+                   IF ( moisture  .OR.  passive_scalar )  THEN
+                      qsws_m => qsws_1;  qsws => qsws_2
+                   ENDIF
+                ENDIF
+                IF ( prandtl_layer )  THEN
+                   rif_m  => rif_1;   rif  => rif_2
+                ENDIF
+             ENDIF
+
+             IF ( moisture )  THEN
+                vpt_m => vpt_1;  vpt => vpt_2
+             ENDIF
+
+          ENDIF
+
+       CASE ( 1 )
+
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+
+             u  => u_2;   u_p  => u_1
+             v  => v_2;   v_p  => v_1
+             w  => w_2;   w_p  => w_1
+             pt => pt_2;  pt_p => pt_1
+             IF ( .NOT. constant_diffusion )  THEN
+                e => e_2;  e_p => e_1
+             ENDIF
+             IF ( moisture  .OR.  passive_scalar )  THEN
+                q => q_2;  q_p => q_1
+             ENDIF
+
+          ELSE
+
+             IF ( .NOT. constant_diffusion )  THEN
+                kh_m => kh_2;  kh => kh_1
+                km_m => km_2;  km => km_1
+                IF ( use_surface_fluxes )  THEN
+                   usws_m => usws_2;  usws => usws_1
+                   vsws_m => vsws_2;  vsws => vsws_1
+                   shf_m  => shf_2;   shf  => shf_1
+                   IF ( moisture  .OR.  passive_scalar )  THEN
+                      qsws_m => qsws_2;  qsws => qsws_1
+                   ENDIF
+                ENDIF
+                IF ( prandtl_layer )  THEN
+                   rif_m  => rif_2;   rif  => rif_1
+                ENDIF
+             ENDIF
+
+             IF ( moisture )  THEN
+                vpt_m => vpt_2;  vpt => vpt_1
+             ENDIF
+
+          ENDIF
+
+    END SELECT
+
+    CALL cpu_log( log_point(28), 'swap_timelevel', 'stop' )
+
+ END SUBROUTINE swap_timelevel
+
+
Index: palm/trunk/SOURCE/synthetic_turbulence_generator_mod.f90
===================================================================
--- palm/trunk/SOURCE/synthetic_turbulence_generator_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2472 +1,0 @@
-!> @synthetic_turbulence_generator_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! formatting clean-up
-!
-! 4848 2021-01-21 15:51:51Z gronemeier
-! replaced use_syn_turb_gen by syn_turb_gen
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4647 2020-08-24 16:36:18Z suehring
-! Change default value of synthetic turbulence adjustment as well as compute_velocity_seeds_local
-! By default, the random-seed computation is now distributed among several cores. Especially for
-! large length scales this is significantly faster.
-!
-! 4640 2020-08-11 16:28:32Z suehring
-! - to avoid that the correction term in r11/r22 computation becomes unrealistically high, limit
-!   Obukhov length (term is not valid for near neutral conditions)
-! - to avoid unrealistically large perturbations, change computation of r21 so that this resembles
-!   the vertical transport of horizontal momentum
-!
-! 4629 2020-07-29 09:37:56Z raasch
-! support for MPI Fortran77 interface (mpif.h) removed
-!
-! 4603 2020-07-14 16:08:30Z suehring
-! Bugfix in initialization from ASCII file - x-length scales at the bottom boundary were not
-! initialized properly
-!
-! 4566 2020-06-16 10:11:51Z suehring
-! - revise parametrization for reynolds-stress components, turbulent length- and time scales
-! - revise computation of velocity disturbances to be consistent to Xie and Castro (2008)
-! - change default value of time interval to adjust turbulence parametrization
-! - bugfix in computation of amplitude-tensor (vertical flux of horizontal momentum)
-!
-! 4562 2020-06-12 08:38:47Z raasch
-! Parts of r4559 re-formatted
-!
-! 4559 2020-06-11 08:51:48Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! Bugfix for restart data format query
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! Restart data handling with MPI-IO added
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! Bugfix: cpp-directives for serial mode added, dummy statements to prevent compile errors added
-!
-! 4442 2020-03-04 19:21:13Z suehring
-! Set back turbulent length scale to 8 x grid spacing in the parametrized mode
-! (was accidantly changed).
-!
-! 4441 2020-03-04 19:20:35Z suehring
-! Correct misplaced preprocessor directive
-!
-! 4438 2020-03-03 20:49:28Z suehring
-! Performance optimizations in velocity-seed calculation:
-!  - Random number array is only defined and computed locally (except for normalization to zero mean
-!    and unit variance)
-!  - Parallel random number generator is applied independent on the 2D random numbers in other
-!    routines
-!  - Option to decide wheter velocity seeds are computed locally without any further communication
-!    or are computed by all processes along the communicator
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4335 2019-12-12 16:39:05Z suehring
-! Commentation of last commit
-!
-! 4332 2019-12-10 19:44:12Z suehring
-! Limit initial velocity seeds in restart runs, if not the seed calculation may become unstable.
-! Further, minor bugfix in initial velocity seed calculation.
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4309 2019-11-26 18:49:59Z suehring
-! Computation of velocity seeds optimized. This implies that random numbers are computed now using
-! the parallel random number generator. Random numbers are now only computed and normalized locally,
-! while distributed over all mpi ranks afterwards, instead of computing random numbers on a global
-! array.
-! Further, the number of calls for the time-consuming velocity-seed generation is reduced - now the
-! left and right, as well as the north and south boundary share the same velocity-seed matrices.
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4148 2019-08-08 11:26:00Z suehring
-! Remove unused variable
-!
-! 4144 2019-08-06 09:11:47Z raasch
-! Relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
-!
-! 4071 2019-07-03 20:02:00Z suehring
-! Bugfix, initialize mean_inflow_profiles in case turbulence and inflow information is not read from
-! file.
-!
-! 4022 2019-06-12 11:52:39Z suehring
-! Several bugfixes and improvements
-! - Revise bias correction of the imposed perturbations (correction via volume flow can create
-!   instabilities in case the mean volume flow is close to zero)
-! - Introduce lower limits in calculation of coefficient matrix, else the calculation may become
-!   numerically unstable
-! - Impose perturbations every timestep, even though no new set of perturbations is generated in
-!   case dt_stg_call /= dt_3d
-! - Implement a gradual decrease of Reynolds stress and length scales above ABL height (within 1
-!   length scale above ABL depth to 1/10) rather than a discontinuous decrease
-! - Bugfix in non-nested case: use ABL height for parametrized turbulence
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3938 2019-04-29 16:06:25Z suehring
-! Remove unused variables
-!
-! 3937 2019-04-29 15:09:07Z suehring
-! Minor bugfix in case of a very early restart where mc_factor is sill not present.
-! Some modification and fixing of potential bugs in the calculation of scaling parameters used for
-! synthetic turbulence parametrization.
-!
-! 3909 2019-04-17 09:13:25Z suehring
-! Minor bugfix for last commit
-!
-! 3900 2019-04-16 15:17:43Z suehring
-! Missing re-calculation of perturbation seeds in case of restarts
-!
-! 3891 2019-04-12 17:52:01Z suehring
-! Bugfix in initialization in case of restart runs.
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-!
-! Removed unused variables
-!
-! 3719 2019-02-06 13:10:18Z kanani
-! Removed log_point measurement from stg_init, since this part is counted to log_point(2)
-! 'initialization' already. Moved other log_points to calls of the subroutines in time_integration
-! for better overview.
-!
-! 2259 2017-06-08 09:09:11Z gronemeier
-! Initial revision
-!
-! Authors:
-! --------
-! @author Tobias Gronemeier, Matthias Suehring, Atsushi Inagaki, Micha Gryschka, Christoph Knigge
-!
-!
-! Description:
-! ------------
-!> The module generates turbulence at the inflow boundary based on a method by Xie and Castro (2008)
-!> utilizing a Lund rotation (Lund, 1998) and a mass-flux correction by Kim et al. (2013).
-!> The turbulence is correlated based on length scales in y- and z-direction and a time scale for
-!> each velocity component. The profiles of length and time scales, mean u, v, w, e and pt, and all
-!> components of the Reynolds stress tensor can be either read from file STG_PROFILES, or will be
-!> parametrized within the boundary layer.
-!>
-!> @todo Enable cyclic_fill
-!>       Implement turbulence generation for e and pt
-!> @note <Enter notes on the module>
-!> @bug  Height information from input file is not used. Profiles from input must match with current
-!>       PALM grid.
-!>       In case of restart, velocity seeds differ from precursor run if a11, a22, or a33 are zero.
-!--------------------------------------------------------------------------------------------------!
- MODULE synthetic_turbulence_generator_mod
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzw,                                                                                &
-               ddzw,                                                                               &
-               drho_air,                                                                           &
-               mean_inflow_profiles,                                                               &
-               pt,                                                                                 &
-               pt_init,                                                                            &
-               q,                                                                                  &
-               q_init,                                                                             &
-               u,                                                                                  &
-               u_init,                                                                             &
-               v,                                                                                  &
-               v_init,                                                                             &
-               w,                                                                                  &
-               zu,                                                                                 &
-               zw
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  g,                                                                                  &
-               kappa,                                                                              &
-               pi
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr,                                                                              &
-               bc_ns,                                                                              &
-               child_domain,                                                                       &
-               coupling_char,                                                                      &
-               debug_output_timestep,                                                              &
-               dt_3d,                                                                              &
-               e_init,                                                                             &
-               humidity,                                                                           &
-               initializing_actions,                                                               &
-               intermediate_timestep_count,                                                        &
-               intermediate_timestep_count_max,                                                    &
-               length,                                                                             &
-               message_string,                                                                     &
-               nesting_offline,                                                                    &
-               neutral,                                                                            &
-               num_mean_inflow_profiles,                                                           &
-               random_generator,                                                                   &
-               rans_mode,                                                                          &
-               restart_data_format_output,                                                         &
-               restart_string,                                                                     &
-               syn_turb_gen,                                                                       &
-               time_since_reference_point,                                                         &
-               turbulent_inflow
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx,                                                                                &
-               ddy,                                                                                &
-               dx,                                                                                 &
-               dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nz,                                                                                 &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxlu,                                                                               &
-               nxr,                                                                                &
-               ny,                                                                                 &
-               nys,                                                                                &
-               nysv,                                                                               &
-               nyn,                                                                                &
-               wall_flags_total_0
-
-    USE kinds
-
-#if defined( __parallel )
-    USE MPI
-#endif
-
-    USE nesting_offl_mod,                                                                          &
-        ONLY:  nesting_offl_calc_zi,                                                               &
-               zi_ribulk
-
-    USE pegrid,                                                                                    &
-        ONLY:  comm1dx,                                                                            &
-               comm1dy,                                                                            &
-               comm2d,                                                                             &
-               ierr,                                                                               &
-               myidx,                                                                              &
-               myidy,                                                                              &
-               pdims
-
-    USE pmc_interface,                                                                             &
-        ONLY : rans_mode_parent
-
-    USE random_generator_parallel,                                                                 &
-        ONLY:  init_parallel_random_generator,                                                     &
-               random_dummy,                                                                       &
-               random_number_parallel,                                                             &
-               random_seed_parallel
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rrd_mpi_io,                                                                         &
-               wrd_mpi_io
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nzb_x,                                                                              &
-               nzt_x
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_def_h,                                                                         &
-               surf_lsm_h,                                                                         &
-               surf_usm_h
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  id_stg_left        !< left lateral boundary core id in case of turbulence generator
-    INTEGER(iwp) ::  id_stg_north       !< north lateral boundary core id in case of turbulence generator
-    INTEGER(iwp) ::  id_stg_right       !< right lateral boundary core id in case of turbulence generator
-    INTEGER(iwp) ::  id_stg_south       !< south lateral boundary core id in case of turbulence generator
-    INTEGER(iwp) ::  k_zi               !< vertical index of boundary-layer top
-    INTEGER(iwp) ::  mergp_limit = 1000 !< maximum length scale (in gp)
-    INTEGER(iwp) ::  mergp_x            !< maximum length scale in x (in gp)
-    INTEGER(iwp) ::  mergp_xy           !< maximum horizontal length scale (in gp)
-    INTEGER(iwp) ::  mergp_y            !< maximum length scale in y (in gp)
-    INTEGER(iwp) ::  mergp_z            !< maximum length scale in z (in gp)
-    INTEGER(iwp) ::  nzb_x_stg          !< lower bound of z coordinate (required for transposing z on PEs along x)
-    INTEGER(iwp) ::  nzt_x_stg          !< upper bound of z coordinate (required for transposing z on PEs along x)
-    INTEGER(iwp) ::  nzb_y_stg          !< lower bound of z coordinate (required for transposing z on PEs along y)
-    INTEGER(iwp) ::  nzt_y_stg          !< upper bound of z coordinate (required for transposing z on PEs along y)
-#if defined( __parallel )
-    INTEGER(iwp) ::  stg_type_xz        !< MPI type for full z range
-    INTEGER(iwp) ::  stg_type_xz_small  !< MPI type for small z range
-    INTEGER(iwp) ::  stg_type_yz        !< MPI type for full z range
-    INTEGER(iwp) ::  stg_type_yz_small  !< MPI type for small z range
-#endif
-
-    INTEGER(iwp), DIMENSION(3) ::  nr_non_topo_xz = 0  !< number of non-topography grid points at xz cross-sections,
-                                                       !< required for bias correction of imposed perturbations
-    INTEGER(iwp), DIMENSION(3) ::  nr_non_topo_yz = 0  !< number of non-topography grid points at yz cross-sections,
-                                                       !< required for bias correction of imposed perturbations
-
-#if defined( __parallel )
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  displs_xz      !< displacement for MPI_GATHERV
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  recv_count_xz  !< receive count for MPI_GATHERV
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  displs_yz      !< displacement for MPI_GATHERV
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  recv_count_yz  !< receive count for MPI_GATHERV
-#endif
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nux            !< length scale of u in x direction (in gp)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nuy            !< length scale of u in y direction (in gp)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nuz            !< length scale of u in z direction (in gp)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nvx            !< length scale of v in x direction (in gp)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nvy            !< length scale of v in y direction (in gp)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nvz            !< length scale of v in z direction (in gp)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nwx            !< length scale of w in x direction (in gp)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nwy            !< length scale of w in y direction (in gp)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nwz            !< length scale of w in z direction (in gp)
-
-    INTEGER(isp), DIMENSION(:), ALLOCATABLE   ::  id_rand_xz   !< initial random IDs at xz inflow boundary
-    INTEGER(isp), DIMENSION(:), ALLOCATABLE   ::  id_rand_yz   !< initial random IDs at yz inflow boundary
-    INTEGER(isp), DIMENSION(:,:), ALLOCATABLE ::  seq_rand_xz  !< initial random seeds at xz inflow boundary
-    INTEGER(isp), DIMENSION(:,:), ALLOCATABLE ::  seq_rand_yz  !< initial random seeds at yz inflow boundary
-
-
-    LOGICAL ::  adjustment_step               = .FALSE.  !< control flag indicating that time and lenght scales have been updated and
-                                                         !< no time correlation to the timestep before should be considered
-    LOGICAL ::  compute_velocity_seeds_local  = .FALSE.   !< switch to decide whether velocity seeds are computed locally
-                                                         !< or if computation is distributed over several processes
-    LOGICAL ::  parametrize_inflow_turbulence = .FALSE.  !< flag indicating that inflow turbulence is either read from file
-                                                         !< (.FALSE.) or if it parametrized
-    LOGICAL ::  velocity_seed_initialized     = .FALSE.  !< true after first call of stg_main
-
-
-    REAL(wp) ::  blend                     !< value to create gradually and smooth blending of Reynolds stress and length
-                                           !< scales above the boundary layer
-    REAL(wp) ::  blend_coeff = -9.3_wp     !< coefficient used to ensure that blending functions decreases to 1/10 after
-                                           !< one length scale above ABL top
-    REAL(wp) ::  d_l                       !< blend_coeff/length_scale
-    REAL(wp) ::  d_nxy                     !< inverse of the total number of xy-grid points
-    REAL(wp) ::  dt_stg_adjust = 1800.0_wp !< time interval for adjusting turbulence statistics
-    REAL(wp) ::  dt_stg_call = 0.0_wp      !< time interval for calling synthetic turbulence generator
-    REAL(wp) ::  scale_l                   !< scaling parameter used for turbulence parametrization - Obukhov length
-    REAL(wp) ::  scale_us                  !< scaling parameter used for turbulence parametrization - friction velocity
-    REAL(wp) ::  scale_wm                  !< scaling parameter used for turbulence parametrization - momentum scale
-    REAL(wp) ::  time_stg_adjust = 0.0_wp  !< time counter for adjusting turbulence information
-    REAL(wp) ::  time_stg_call = 0.0_wp    !< time counter for calling generator
-
-    REAL(wp), DIMENSION(3) ::  mc_factor = 1.0_wp  !< correction factor for the u,v,w-components to maintain original mass flux
-
-
-    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r11  !< Reynolds parameter
-    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r21  !< Reynolds parameter
-    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r22  !< Reynolds parameter
-    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r31  !< Reynolds parameter
-    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r32  !< Reynolds parameter
-    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r33  !< Reynolds parameter
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a11  !< coefficient for Lund rotation
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a21  !< coefficient for Lund rotation
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a22  !< coefficient for Lund rotation
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a31  !< coefficient for Lund rotation
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a32  !< coefficient for Lund rotation
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a33  !< coefficient for Lund rotation
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  tu   !< Lagrangian time scale of u
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  tv   !< Lagrangian time scale of v
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  tw   !< Lagrangian time scale of w
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bux     !< filter function for u in x direction
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  buy     !< filter function for u in y direction
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  buz     !< filter function for u in z direction
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bvx     !< filter function for v in x direction
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bvy     !< filter function for v in y direction
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bvz     !< filter function for v in z direction
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bwx     !< filter function for w in y direction
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bwy     !< filter function for w in y direction
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bwz     !< filter function for w in z direction
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fu_xz   !< velocity seed for u at xz plane
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fuo_xz  !< velocity seed for u at xz plane with new random number
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fu_yz   !< velocity seed for u at yz plane
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fuo_yz  !< velocity seed for u at yz plane with new random number
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fv_xz   !< velocity seed for v at xz plane
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fvo_xz  !< velocity seed for v at xz plane with new random number
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fv_yz   !< velocity seed for v at yz plane
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fvo_yz  !< velocity seed for v at yz plane with new random number
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fw_xz   !< velocity seed for w at xz plane
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fwo_xz  !< velocity seed for w at xz plane with new random number
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fw_yz   !< velocity seed for w at yz plane
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fwo_yz  !< velocity seed for w at yz plane with new random number
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  dist_xz !< disturbances for parallel/crosswind/vertical component at north/south boundary
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  dist_yz !< disturbances for parallel/crosswind/vertical component  at north/south boundary
-
-!
-!-- PALM interfaces:
-!-- Adjust time and lenght scales, Reynolds stress, and filter functions
-    INTERFACE stg_adjust
-       MODULE PROCEDURE stg_adjust
-    END INTERFACE stg_adjust
-!
-!-- Input parameter checks to be done in check_parameters
-    INTERFACE stg_check_parameters
-       MODULE PROCEDURE stg_check_parameters
-    END INTERFACE stg_check_parameters
-
-!
-!-- Calculate filter functions
-    INTERFACE stg_filter_func
-       MODULE PROCEDURE stg_filter_func
-    END INTERFACE stg_filter_func
-
-!
-!-- Generate velocity seeds at south and north domain boundary
-    INTERFACE stg_generate_seed_xz
-       MODULE PROCEDURE stg_generate_seed_xz
-    END INTERFACE stg_generate_seed_xz
-!
-!-- Generate velocity seeds at left and/or right domain boundary
-    INTERFACE stg_generate_seed_yz
-       MODULE PROCEDURE stg_generate_seed_yz
-    END INTERFACE stg_generate_seed_yz
-
-!
-!-- Output of information to the header file
-    INTERFACE stg_header
-       MODULE PROCEDURE stg_header
-    END INTERFACE stg_header
-
-!
-!-- Initialization actions
-    INTERFACE stg_init
-       MODULE PROCEDURE stg_init
-    END INTERFACE stg_init
-
-!
-!-- Main procedure of synth. turb. gen.
-    INTERFACE stg_main
-       MODULE PROCEDURE stg_main
-    END INTERFACE stg_main
-
-!
-!-- Reading of NAMELIST parameters
-    INTERFACE stg_parin
-       MODULE PROCEDURE stg_parin
-    END INTERFACE stg_parin
-
-!
-!-- Reading of parameters for restart runs
-    INTERFACE stg_rrd_global
-       MODULE PROCEDURE stg_rrd_global_ftn
-       MODULE PROCEDURE stg_rrd_global_mpi
-    END INTERFACE stg_rrd_global
-
-!
-!-- Writing of binary output for restart runs
-    INTERFACE stg_wrd_global
-       MODULE PROCEDURE stg_wrd_global
-    END INTERFACE stg_wrd_global
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public interfaces
-    PUBLIC  stg_adjust,                                                                            &
-            stg_check_parameters,                                                                  &
-            stg_header,                                                                            &
-            stg_init,                                                                              &
-            stg_main,                                                                              &
-            stg_parin,                                                                             &
-            stg_rrd_global,                                                                        &
-            stg_wrd_global
-
-!
-!-- Public variables
-    PUBLIC  dt_stg_call,                                                                           &
-            dt_stg_adjust,                                                                         &
-            id_stg_left,                                                                           &
-            id_stg_north,                                                                          &
-            id_stg_right,                                                                          &
-            id_stg_south,                                                                          &
-            parametrize_inflow_turbulence,                                                         &
-            time_stg_adjust,                                                                       &
-            time_stg_call
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for synthetic turbulence generator
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_check_parameters
-
-    IF ( .NOT. syn_turb_gen  .AND.  .NOT. rans_mode  .AND.                                         &
-          nesting_offline )  THEN
-       message_string = 'Synthetic turbulence generator is required ' //                           &
-                        'if offline nesting is applied and PALM operates in LES mode.'
-       CALL message( 'stg_check_parameters', 'PA0520', 0, 0, 0, 6, 0 )
-    ENDIF
-
-    IF ( .NOT. syn_turb_gen  .AND.  child_domain                                                   &
-         .AND. rans_mode_parent  .AND.  .NOT. rans_mode )  THEN
-       message_string = 'Synthetic turbulence generator is required when nesting is applied ' //   &
-                        'and parent operates in RANS-mode but current child in LES mode.'
-       CALL message( 'stg_check_parameters', 'PA0524', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( syn_turb_gen )  THEN
-
-       IF ( child_domain  .AND.  .NOT. rans_mode  .AND.  .NOT. rans_mode_parent )  THEN
-          message_string = 'Using synthetic turbulence generator is not allowed in LES-LES nesting.'
-          CALL message( 'stg_check_parameters', 'PA0620', 1, 2, 0, 6, 0 )
-
-       ENDIF
-
-       IF ( child_domain  .AND.  rans_mode  .AND.  rans_mode_parent )  THEN
-          message_string = 'Using synthetic turbulence generator is not allowed in RANS-RANS nesting.'
-          CALL message( 'stg_check_parameters', 'PA0621', 1, 2, 0, 6, 0 )
-
-       ENDIF
-
-       IF ( .NOT. nesting_offline  .AND.  .NOT. child_domain )  THEN
-
-          IF ( INDEX( initializing_actions, 'set_constant_profiles' ) == 0                         &
-          .AND.  INDEX( initializing_actions, 'read_restart_data' ) == 0 )  THEN
-             message_string = 'Using synthetic turbulence generator requires ' //                  &
-                              '%initializing_actions = "set_constant_profiles" or ' //             &
-                              ' "read_restart_data", if not offline nesting is applied.'
-             CALL message( 'stg_check_parameters', 'PA0015', 1, 2, 0, 6, 0 )
-          ENDIF
-
-          IF ( bc_lr /= 'dirichlet/radiation' )  THEN
-             message_string = 'Using synthetic turbulence generator requires &bc_lr = ' //         &
-                              ' "dirichlet/radiation", if not offline nesting is applied.'
-             CALL message( 'stg_check_parameters', 'PA0035', 1, 2, 0, 6, 0 )
-          ENDIF
-          IF ( bc_ns /= 'cyclic' )  THEN
-             message_string = 'Using synthetic turbulence generator requires &bc_ns = ' //         &
-                              ' "cyclic", if not offline nesting is applied.'
-             CALL message( 'stg_check_parameters', 'PA0037', 1, 2, 0, 6, 0 )
-          ENDIF
-
-       ENDIF
-
-       IF ( turbulent_inflow )  THEN
-          message_string = 'Using synthetic turbulence generator in combination ' //               &
-                           '&with turbulent_inflow = .T. is not allowed'
-          CALL message( 'stg_check_parameters', 'PA0039', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Synthetic turbulence generator requires the parallel random generator
-       IF ( random_generator /= 'random-parallel' )  THEN
-          message_string = 'Using synthetic turbulence generator requires random_generator = ' //  &
-                           'random-parallel.'
-          CALL message( 'stg_check_parameters', 'PA0421', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE stg_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for synthetic turbulence generator
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_header ( io )
-
-    INTEGER(iwp), INTENT(IN) ::  io  !< Unit of the output file
-
-!
-!-- Write synthetic turbulence generator Header
-    IF ( syn_turb_gen )  THEN
-       WRITE( io, 1 )
-       IF ( parametrize_inflow_turbulence )  THEN
-          WRITE( io, 4 ) dt_stg_adjust
-       ELSE
-          WRITE( io, 5 )
-       ENDIF
-    ENDIF
-
-1   FORMAT (//' Synthetic turbulence generator information:'/                                      &
-              ' ------------------------------------------'/)
-4   FORMAT ('    imposed turbulence statistics are parametrized and ajdusted to boundary-layer development each ', F8.2, ' s' )
-5   FORMAT ('    imposed turbulence is read from file' )
-
- END SUBROUTINE stg_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the synthetic turbulence generator
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_init
-
-#if defined( __parallel )
-    INTEGER(KIND=MPI_ADDRESS_KIND) :: extent   !< extent of new MPI type
-    INTEGER(KIND=MPI_ADDRESS_KIND) :: tob = 0  !< dummy variable
-#endif
-
-    INTEGER(iwp) :: i         !> grid index in x-direction
-    INTEGER(iwp) :: j         !> loop index
-    INTEGER(iwp) :: k         !< index
-#if defined( __parallel )
-    INTEGER(iwp) :: newtype   !< dummy MPI type
-    INTEGER(iwp) :: realsize  !< size of REAL variables
-#endif
-
-    INTEGER(iwp), DIMENSION(3) ::  nr_non_topo_xz_l = 0 !< number of non-topography grid points at xz-cross-section on subdomain
-    INTEGER(iwp), DIMENSION(3) ::  nr_non_topo_yz_l = 0 !< number of non-topography grid points at yz-cross-section on subdomain
-
-
-    LOGICAL ::  file_stg_exist = .FALSE.  !< flag indicating whether parameter file for Reynolds stress and length scales exist
-
-!
-!-- Dummy variables used for reading profiles
-    REAL(wp) :: d1   !< u profile
-    REAL(wp) :: d2   !< v profile
-    REAL(wp) :: d3   !< w profile
-    REAL(wp) :: d5   !< e profile
-    REAL(wp) :: luy  !< length scale for u in y direction
-    REAL(wp) :: luz  !< length scale for u in z direction
-    REAL(wp) :: lvy  !< length scale for v in y direction
-    REAL(wp) :: lvz  !< length scale for v in z direction
-    REAL(wp) :: lwy  !< length scale for w in y direction
-    REAL(wp) :: lwz  !< length scale for w in z direction
-#if defined( __parallel )
-    REAL(wp) :: nnz  !< increment used to determine processor decomposition of z-axis along x and y direction
-#endif
-    REAL(wp) :: zz   !< height
-
-
-#if defined( __parallel )
-    CALL MPI_BARRIER( comm2d, ierr )
-#endif
-!
-!-- Create mpi-datatypes for exchange in case of non-local but distributed computation of the
-!-- velocity seeds. This option is useful in case large turbulent length scales are present, where
-!-- the computational effort becomes large and needs to be parallelized. For parameterized turbulence
-!-- the length scales are small and computing the velocity seeds locally is faster (no overhead by
-!-- communication).
-    IF ( .NOT. compute_velocity_seeds_local )  THEN
-#if defined( __parallel )
-!
-!--    Determine processor decomposition of z-axis along x- and y-direction
-       nnz = nz / pdims(1)
-       nzb_x_stg = 1 + myidx * INT( nnz )
-       nzt_x_stg = ( myidx + 1 ) * INT( nnz )
-
-       IF ( MOD( nz , pdims(1) ) /= 0  .AND.  myidx == id_stg_right )                              &
-          nzt_x_stg = nzt_x_stg + myidx * ( nnz - INT( nnz ) )
-
-       IF ( nesting_offline   .OR.  ( child_domain  .AND.  rans_mode_parent                        &
-                               .AND.  .NOT.  rans_mode ) )  THEN
-          nnz = nz / pdims(2)
-          nzb_y_stg = 1 + myidy * INT( nnz )
-          nzt_y_stg = ( myidy + 1 ) * INT( nnz )
-
-          IF ( MOD( nz , pdims(2) ) /= 0  .AND.  myidy == id_stg_north )                           &
-             nzt_y_stg = nzt_y_stg + myidy * ( nnz - INT( nnz ) )
-       ENDIF
-
-!
-!--    Define MPI type used in stg_generate_seed_yz to gather vertical splitted velocity seeds
-       CALL MPI_TYPE_SIZE( MPI_REAL, realsize, ierr )
-       extent = 1 * realsize
-!
-!--    Set-up MPI datatyp to involve all cores for turbulence generation at yz layer
-!--    stg_type_yz: yz-slice with vertical bounds nzb:nzt+1
-       CALL MPI_TYPE_CREATE_SUBARRAY( 2, [nzt-nzb+2,nyn-nys+1],                                    &
-               [1,nyn-nys+1], [0,0], MPI_ORDER_FORTRAN, MPI_REAL, newtype, ierr )
-       CALL MPI_TYPE_CREATE_RESIZED( newtype, tob, extent, stg_type_yz, ierr )
-       CALL MPI_TYPE_COMMIT( stg_type_yz, ierr )
-       CALL MPI_TYPE_FREE( newtype, ierr )
-
-       ! stg_type_yz_small: yz-slice with vertical bounds nzb_x_stg:nzt_x_stg+1
-       CALL MPI_TYPE_CREATE_SUBARRAY( 2, [nzt_x_stg-nzb_x_stg+2,nyn-nys+1],                        &
-               [1,nyn-nys+1], [0,0], MPI_ORDER_FORTRAN, MPI_REAL, newtype, ierr )
-       CALL MPI_TYPE_CREATE_RESIZED( newtype, tob, extent, stg_type_yz_small, ierr )
-       CALL MPI_TYPE_COMMIT( stg_type_yz_small, ierr )
-       CALL MPI_TYPE_FREE( newtype, ierr )
-
-       ! Receive count and displacement for MPI_GATHERV in stg_generate_seed_yz
-       ALLOCATE( recv_count_yz(pdims(1)), displs_yz(pdims(1)) )
-
-       recv_count_yz           = nzt_x_stg-nzb_x_stg + 1
-       recv_count_yz(pdims(1)) = recv_count_yz(pdims(1)) + 1
-
-       DO  j = 1, pdims(1)
-          displs_yz(j) = 0 + (nzt_x_stg-nzb_x_stg+1) * (j-1)
-       ENDDO
-!
-!--    Set-up MPI datatyp to involve all cores for turbulence generation at xz layer
-!--    stg_type_xz: xz-slice with vertical bounds nzb:nzt+1
-       IF ( nesting_offline  .OR.  ( child_domain .AND.  rans_mode_parent                          &
-                                     .AND.  .NOT.  rans_mode ) )  THEN
-          CALL MPI_TYPE_CREATE_SUBARRAY( 2, [nzt-nzb+2,nxr-nxl+1],                                 &
-                  [1,nxr-nxl+1], [0,0], MPI_ORDER_FORTRAN, MPI_REAL, newtype, ierr )
-          CALL MPI_TYPE_CREATE_RESIZED( newtype, tob, extent, stg_type_xz, ierr )
-          CALL MPI_TYPE_COMMIT( stg_type_xz, ierr )
-          CALL MPI_TYPE_FREE( newtype, ierr )
-
-          ! stg_type_yz_small: xz-slice with vertical bounds nzb_x_stg:nzt_x_stg+1
-          CALL MPI_TYPE_CREATE_SUBARRAY( 2, [nzt_y_stg-nzb_y_stg+2,nxr-nxl+1],                     &
-                  [1,nxr-nxl+1], [0,0], MPI_ORDER_FORTRAN, MPI_REAL, newtype, ierr )
-          CALL MPI_TYPE_CREATE_RESIZED( newtype, tob, extent, stg_type_xz_small, ierr )
-          CALL MPI_TYPE_COMMIT( stg_type_xz_small, ierr )
-          CALL MPI_TYPE_FREE( newtype, ierr )
-
-          ! Receive count and displacement for MPI_GATHERV in stg_generate_seed_yz
-          ALLOCATE( recv_count_xz(pdims(2)), displs_xz(pdims(2)) )
-
-          recv_count_xz           = nzt_y_stg-nzb_y_stg + 1
-          recv_count_xz(pdims(2)) = recv_count_xz(pdims(2)) + 1
-
-          DO  j = 1, pdims(2)
-             displs_xz(j) = 0 + (nzt_y_stg-nzb_y_stg+1) * (j-1)
-          ENDDO
-
-       ENDIF
-#endif
-    ENDIF
-!
-!-- Allocate required arrays.
-!-- In case no offline nesting or self nesting is used, the arrary mean_inflow profiles is required.
-!-- Check if it is already allocated, else allocate and initialize it appropriately. Note, in case
-!-- turbulence and inflow information is read from file, mean_inflow_profiles is already allocated
-!-- and initialized appropriately.
-    IF ( .NOT. nesting_offline  .AND.  .NOT.  child_domain )  THEN
-       IF ( .NOT. ALLOCATED( mean_inflow_profiles ) )  THEN
-          ALLOCATE( mean_inflow_profiles(nzb:nzt+1,1:num_mean_inflow_profiles) )
-          mean_inflow_profiles = 0.0_wp
-          mean_inflow_profiles(:,1) = u_init
-          mean_inflow_profiles(:,2) = v_init
-!
-!--       Even though potential temperature and humidity are not perturbed, they need to be
-!--       initialized appropriately.
-          IF ( .NOT. neutral )                                                                     &
-             mean_inflow_profiles(:,4) = pt_init
-          IF ( humidity )                                                                          &
-             mean_inflow_profiles(:,6) = q_init
-       ENDIF
-    ENDIF
-!
-!-- Assign initial profiles. Note, this is only required if turbulent inflow from the left is
-!-- desired, not in case of any of the nesting (offline or self nesting) approaches.
-    IF ( .NOT. nesting_offline  .AND.  .NOT.  child_domain )  THEN
-       u_init = mean_inflow_profiles(:,1)
-       v_init = mean_inflow_profiles(:,2)
-       e_init = MAXVAL( mean_inflow_profiles(:,5) )
-    ENDIF
-
-    ALLOCATE ( a11(nzb:nzt+1), a21(nzb:nzt+1), a22(nzb:nzt+1),                                     &
-               a31(nzb:nzt+1), a32(nzb:nzt+1), a33(nzb:nzt+1),                                     &
-               nux(nzb:nzt+1), nuy(nzb:nzt+1), nuz(nzb:nzt+1),                                     &
-               nvx(nzb:nzt+1), nvy(nzb:nzt+1), nvz(nzb:nzt+1),                                     &
-               nwx(nzb:nzt+1), nwy(nzb:nzt+1), nwz(nzb:nzt+1),                                     &
-               r11(nzb:nzt+1), r21(nzb:nzt+1), r22(nzb:nzt+1),                                     &
-               r31(nzb:nzt+1), r32(nzb:nzt+1), r33(nzb:nzt+1),                                     &
-               tu(nzb:nzt+1),  tv(nzb:nzt+1),  tw(nzb:nzt+1) )
-
-    r11 = 0.0_wp
-    r21 = 0.0_wp
-    r22 = 0.0_wp
-    r31 = 0.0_wp
-    r32 = 0.0_wp
-    r33 = 0.0_wp
-    tu  = 0.0_wp
-    tv  = 0.0_wp
-    tw  = 0.0_wp
-
-    ALLOCATE ( dist_xz(nzb:nzt+1,nxl:nxr,3) )
-    ALLOCATE ( dist_yz(nzb:nzt+1,nys:nyn,3) )
-    dist_xz = 0.0_wp
-    dist_yz = 0.0_wp
-!
-!-- Read inflow profile
-!-- Height levels of profiles in input profile is as follows:
-!-- zu: luy, luz, tu, lvy, lvz, tv, r11, r21, r22, d1, d2, d5 zw: lwy, lwz, tw, r31, r32, r33, d3
-!-- WARNING: zz is not used at the moment
-    INQUIRE( FILE = 'STG_PROFILES' // TRIM( coupling_char ), EXIST = file_stg_exist  )
-
-    IF ( file_stg_exist )  THEN
-
-       OPEN( 90, FILE = 'STG_PROFILES' // TRIM( coupling_char ), STATUS = 'OLD', FORM = 'FORMATTED' )
-!
-!--    Skip header
-       READ( 90, * )
-
-       DO  k = nzb, nzt
-          READ( 90, * ) zz, luy, luz, tu(k), lvy, lvz, tv(k), lwy, lwz, tw(k), r11(k), r21(k),     &
-                        r22(k), r31(k), r32(k), r33(k), d1, d2, d3, d5
-
-!
-!--       Convert length scales from meter to number of grid points.
-          IF ( k /= nzb )  THEN
-             nuz(k) = INT( luz * ddzw(k) )
-             nvz(k) = INT( lvz * ddzw(k) )
-             nwz(k) = INT( lwz * ddzw(k) )
-          ELSE
-             nuz(k) = INT( luz * ddzw(k+1) )
-             nvz(k) = INT( lvz * ddzw(k+1) )
-             nwz(k) = INT( lwz * ddzw(k+1) )
-          ENDIF
-
-          nuy(k) = INT( luy * ddy )
-          nvy(k) = INT( lvy * ddy )
-          nwy(k) = INT( lwy * ddy )
-!
-!--       Set length scales in x-direction. As a workaround assume isotropic turbulence in x- and
-!--       y-direction.
-          nwx(k) = nwy(k)
-          nvx(k) = nvy(k)
-          nux(k) = nuy(k)
-!
-!--       Save Mean inflow profiles
-          IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
-             mean_inflow_profiles(k,1) = d1
-             mean_inflow_profiles(k,2) = d2
-            !  mean_inflow_profiles(k,4) = d4
-             mean_inflow_profiles(k,5) = d5
-          ENDIF
-       ENDDO
-!
-!--    Set length scales at the surface and top boundary. At the surface the lengths scales are
-!--    simply overwritten.
-       nwx(nzb) = nwy(nzb+1)
-       nvx(nzb) = nvy(nzb+1)
-       nux(nzb) = nuy(nzb+1)
-       nuy(nzb) = nuy(nzb+1)
-       nuz(nzb) = nuz(nzb+1)
-       nvy(nzb) = nvy(nzb+1)
-       nvz(nzb) = nvz(nzb+1)
-       nwy(nzb) = nwy(nzb+1)
-       nwz(nzb) = nwz(nzb+1)
-
-       nwx(nzt+1) = nwy(nzt)
-       nvx(nzt+1) = nvy(nzt)
-       nux(nzt+1) = nuy(nzt)
-       nuy(nzt+1) = nuy(nzt)
-       nuz(nzt+1) = nuz(nzt)
-       nvy(nzt+1) = nvy(nzt)
-       nvz(nzt+1) = nvz(nzt)
-       nwy(nzt+1) = nwy(nzt)
-       nwz(nzt+1) = nwz(nzt)
-
-       CLOSE( 90 )
-!
-!--    Calculate coefficient matrix from Reynolds stress tensor (Lund rotation)
-       CALL calc_coeff_matrix
-!
-!-- No information about turbulence and its length scales are available. Instead, parametrize
-!-- turbulence which is imposed at the boundaries. Set flag which indicates that turbulence is
-!-- parametrized, which is done later when energy-balance models are already initialized. This is
-!-- because the STG needs information about surface properties such as roughness to build
-!-- 'realistic' turbulence profiles.
-    ELSE
-!
-!--    Precalulate the inversion number of xy-grid points - later used for mass conservation
-       d_nxy = 1.0_wp / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )
-!
-!--    Set flag indicating that turbulence is parametrized
-       parametrize_inflow_turbulence = .TRUE.
-!
-!--    In case of dirichlet inflow boundary conditions only at one lateral boundary, i.e. in the
-!--    case no offline or self nesting is applied but synthetic turbulence shall be parametrized
-!--    nevertheless, the boundary-layer depth needs to be determined first.
-       IF ( .NOT. nesting_offline  .AND.  .NOT.  child_domain )                                    &
-          CALL nesting_offl_calc_zi
-!
-!--    Determine boundary-layer depth, which is used to initialize lenght scales
-       CALL calc_scaling_variables
-!
-!--    Parametrize Reynolds-stress tensor, diagonal elements as well as r21 (v'u'), r31 (w'u'),
-!--    r32 (w'v'). Parametrization follows Rotach et al. (1996) and is based on boundary-layer depth,
-!--    friction velocity and velocity scale.
-       CALL parametrize_turbulence
-!
-!--    Calculate coefficient matrix from Reynolds stress tensor (Lund rotation)
-       CALL calc_coeff_matrix
-
-    ENDIF
-!
-!-- Initial filter functions
-    CALL stg_setup_filter_function
-!
-!-- Allocate velocity seeds for turbulence at xz-layer
-    ALLOCATE ( fu_xz(nzb:nzt+1,nxl:nxr), fuo_xz(nzb:nzt+1,nxl:nxr),                                &
-               fv_xz(nzb:nzt+1,nxl:nxr), fvo_xz(nzb:nzt+1,nxl:nxr),                                &
-               fw_xz(nzb:nzt+1,nxl:nxr), fwo_xz(nzb:nzt+1,nxl:nxr) )
-
-!
-!-- Allocate velocity seeds for turbulence at yz-layer
-    ALLOCATE ( fu_yz(nzb:nzt+1,nys:nyn), fuo_yz(nzb:nzt+1,nys:nyn),                                &
-               fv_yz(nzb:nzt+1,nys:nyn), fvo_yz(nzb:nzt+1,nys:nyn),                                &
-               fw_yz(nzb:nzt+1,nys:nyn), fwo_yz(nzb:nzt+1,nys:nyn) )
-
-    fu_xz  = 0.0_wp
-    fuo_xz = 0.0_wp
-    fv_xz  = 0.0_wp
-    fvo_xz = 0.0_wp
-    fw_xz  = 0.0_wp
-    fwo_xz = 0.0_wp
-
-    fu_yz  = 0.0_wp
-    fuo_yz = 0.0_wp
-    fv_yz  = 0.0_wp
-    fvo_yz = 0.0_wp
-    fw_yz  = 0.0_wp
-    fwo_yz = 0.0_wp
-
-#if defined( __parallel )
-    CALL MPI_BARRIER( comm2d, ierr )
-#endif
-
-!
-!-- In case of restart, calculate velocity seeds fu, fv, fw from former time step.
-!   Bug: fu, fv, fw are different in those heights where a11, a22, a33 are 0 compared to the prerun.
-!-- This is mostly for k=nzt+1.
-    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
-       IF ( myidx == id_stg_left  .OR.  myidx == id_stg_right )  THEN
-
-          IF ( myidx == id_stg_left  )  i = -1
-          IF ( myidx == id_stg_right )  i = nxr+1
-
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-                IF  ( a11(k) > 10E-8_wp )  THEN
-                   fu_yz(k,j) = ( u(k,j,i) - u_init(k) ) / a11(k)
-                ELSE
-                   fu_yz(k,j) = 10E-8_wp
-                ENDIF
-
-                IF  ( a22(k) > 10E-8_wp )  THEN
-                   fv_yz(k,j) = ( v(k,j,i) - a21(k) * fu_yz(k,j) - v_init(k) ) / a22(k)
-                ELSE
-                   fv_yz(k,j) = 10E-8_wp
-                ENDIF
-
-                IF  ( a33(k) > 10E-8_wp )  THEN
-                   fw_yz(k,j) = ( w(k,j,i) - a31(k) * fu_yz(k,j) - a32(k) * fv_yz(k,j) ) / a33(k)
-                ELSE
-                   fw_yz(k,j) = 10E-8_wp
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDIF
-
-       IF ( myidy == id_stg_south  .OR.  myidy == id_stg_north )  THEN
-
-          IF ( myidy == id_stg_south )  j = -1
-          IF ( myidy == id_stg_north )  j = nyn+1
-
-          DO  i = nxl, nxr
-             DO  k = nzb, nzt+1
-!
-!--             In case the correlation coefficients are very small, the velocity seeds may become
-!--             very large finally creating numerical instabilities in the synthetic turbulence
-!--             generator. Empirically, a value of 10E-8 seems to be sufficient.
-                IF  ( a11(k) > 10E-8_wp )  THEN
-                   fu_xz(k,i) = ( u(k,j,i) - u_init(k) ) / a11(k)
-                ELSE
-                   fu_xz(k,i) = 10E-8_wp
-                ENDIF
-
-                IF  ( a22(k) > 10E-8_wp )  THEN
-                   fv_xz(k,i) = ( v(k,j,i) - a21(k) * fu_xz(k,i) - v_init(k) ) / a22(k)
-                ELSE
-                   fv_xz(k,i) = 10E-8_wp
-                ENDIF
-
-                IF  ( a33(k) > 10E-8_wp )  THEN
-                   fw_xz(k,i) = ( w(k,j,i) - a31(k) * fu_xz(k,i) - a32(k) * fv_xz(k,i) ) / a33(k)
-                ELSE
-                   fw_xz(k,i) = 10E-8_wp
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-!
-!-- Count the number of non-topography grid points at the boundaries where perturbations are imposed.
-!-- This number is later used for bias corrections of the perturbations, i.e. to force their mean to
-!-- be zero. Please note, due to the asymetry of u and v along x and y direction, respectively,
-!-- different cases must be distinguished.
-    IF ( myidx == id_stg_left  .OR.  myidx == id_stg_right )  THEN
-!
-!--    Number of grid points where perturbations are imposed on u
-       IF ( myidx == id_stg_left  )  i = nxl
-       IF ( myidx == id_stg_right )  i = nxr+1
-
-       nr_non_topo_yz_l(1) = SUM( MERGE( 1, 0, BTEST( wall_flags_total_0(nzb:nzt,nys:nyn,i), 1 ) ) )
-!
-!--    Number of grid points where perturbations are imposed on v and w
-       IF ( myidx == id_stg_left  )  i = nxl-1
-       IF ( myidx == id_stg_right )  i = nxr+1
-
-       nr_non_topo_yz_l(2) = SUM( MERGE( 1, 0, BTEST( wall_flags_total_0(nzb:nzt,nysv:nyn,i), 2 ) ) )
-       nr_non_topo_yz_l(3) = SUM( MERGE( 1, 0, BTEST( wall_flags_total_0(nzb:nzt,nys:nyn,i), 3 ) ) )
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( nr_non_topo_yz_l, nr_non_topo_yz, 3, MPI_INTEGER, MPI_SUM, comm1dy, ierr )
-#else
-       nr_non_topo_yz = nr_non_topo_yz_l
-#endif
-    ENDIF
-
-    IF ( myidy == id_stg_south  .OR.  myidy == id_stg_north )  THEN
-!
-!--    Number of grid points where perturbations are imposed on v
-       IF ( myidy == id_stg_south )  j = nys
-       IF ( myidy == id_stg_north )  j = nyn+1
-
-       nr_non_topo_xz_l(2) = SUM( MERGE( 1, 0, BTEST( wall_flags_total_0(nzb:nzt,j,nxl:nxr), 2 ) ) )
-!
-!--    Number of grid points where perturbations are imposed on u and w
-       IF ( myidy == id_stg_south )  j = nys-1
-       IF ( myidy == id_stg_north )  j = nyn+1
-
-       nr_non_topo_xz_l(1) = SUM( MERGE( 1, 0, BTEST( wall_flags_total_0(nzb:nzt,j,nxlu:nxr), 1 ) ) )
-       nr_non_topo_xz_l(3) = SUM( MERGE( 1, 0, BTEST( wall_flags_total_0(nzb:nzt,j,nxl:nxr), 3 ) ) )
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( nr_non_topo_xz_l, nr_non_topo_xz, 3, MPI_INTEGER, MPI_SUM, comm1dx, ierr )
-#else
-       nr_non_topo_xz = nr_non_topo_xz_l
-#endif
-    ENDIF
-!
-!-- Initialize random number generator at xz- and yz-layers. Random numbers are initialized at each
-!-- core. In case there is only inflow from the left, it is sufficient to generate only random
-!-- numbers for the yz-layer, else random numbers for the xz-layer are also required.
-    ALLOCATE ( id_rand_yz(-mergp_limit+nys:nyn+mergp_limit) )
-    ALLOCATE ( seq_rand_yz(5,-mergp_limit+nys:nyn+mergp_limit) )
-    id_rand_yz  = 0
-    seq_rand_yz = 0
-
-    CALL init_parallel_random_generator( ny, -mergp_limit+nys, nyn+mergp_limit, id_rand_yz, seq_rand_yz )
-
-    IF ( nesting_offline  .OR.  ( child_domain .AND.  rans_mode_parent                             &
-         .AND.  .NOT.  rans_mode ) )  THEN
-       ALLOCATE ( id_rand_xz(-mergp_limit+nxl:nxr+mergp_limit) )
-       ALLOCATE ( seq_rand_xz(5,-mergp_limit+nxl:nxr+mergp_limit) )
-       id_rand_xz  = 0
-       seq_rand_xz = 0
-
-       CALL init_parallel_random_generator( nx, -mergp_limit+nxl, nxr+mergp_limit, id_rand_xz, seq_rand_xz )
-    ENDIF
-
- END SUBROUTINE stg_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate filter function bxx from length scale nxx following Eg.9 and 10 (Xie and Castro, 2008)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_filter_func( nxx, bxx, mergp )
-
-    INTEGER(iwp) ::  k     !< loop index
-    INTEGER(iwp) ::  mergp !< passed length scale in grid points
-    INTEGER(iwp) ::  n_k   !< length scale nXX in height k
-    INTEGER(iwp) ::  nf    !< index for length scales
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1) ::  nxx  !< length scale (in gp)
-
-    REAL(wp) :: bdenom        !< denominator for filter functions bXX
-    REAL(wp) :: qsi = 1.0_wp  !< minimization factor
-
-    REAL(wp), DIMENSION(-mergp:mergp,nzb:nzt+1) ::  bxx  !< filter function
-
-
-    bxx = 0.0_wp
-
-    DO  k = nzb, nzt+1
-       bdenom = 0.0_wp
-       n_k    = nxx(k)
-       IF ( n_k /= 0 )  THEN
-
-!
-!--       ( Eq.10 )^2
-          DO  nf = -n_k, n_k
-             bdenom = bdenom + EXP( -qsi * pi * ABS( nf ) / n_k )**2
-          ENDDO
-
-!
-!--       ( Eq.9 )
-          bdenom = SQRT( bdenom )
-          DO  nf = -n_k, n_k
-             bxx(nf,k) = EXP( -qsi * pi * ABS( nf ) / n_k ) / bdenom
-          ENDDO
-       ENDIF
-    ENDDO
-
- END SUBROUTINE stg_filter_func
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate filter function bxx from length scale nxx following Eg.9 and 10
-!> (Xie and Castro, 2008)
-!------------------------------------------------------------------------------!
- SUBROUTINE stg_setup_filter_function
-
-    INTEGER(iwp) :: j  !< dummy value to calculate maximum length scale index
-    INTEGER(iwp) :: k  !< loop index along vertical direction
-!
-!-- Define the size of the filter functions and allocate them.
-    mergp_x = 0
-    mergp_y = 0
-    mergp_z = 0
-
-    DO  k = nzb, nzt+1
-       j = MAX( ABS(nux(k)), ABS(nvx(k)), ABS(nwx(k)) )
-       IF ( j > mergp_x )  mergp_x = j
-    ENDDO
-    DO  k = nzb, nzt+1
-       j = MAX( ABS(nuy(k)), ABS(nvy(k)), ABS(nwy(k)) )
-       IF ( j > mergp_y )  mergp_y = j
-    ENDDO
-    DO  k = nzb, nzt+1
-       j = MAX( ABS(nuz(k)), ABS(nvz(k)), ABS(nwz(k)) )
-       IF ( j > mergp_z )  mergp_z = j
-    ENDDO
-
-    mergp_xy = MAX( mergp_x, mergp_y )
-
-    IF ( ALLOCATED( bux ) )  DEALLOCATE( bux )
-    IF ( ALLOCATED( bvx ) )  DEALLOCATE( bvx )
-    IF ( ALLOCATED( bwx ) )  DEALLOCATE( bwx )
-    IF ( ALLOCATED( buy ) )  DEALLOCATE( buy )
-    IF ( ALLOCATED( bvy ) )  DEALLOCATE( bvy )
-    IF ( ALLOCATED( bwy ) )  DEALLOCATE( bwy )
-    IF ( ALLOCATED( buz ) )  DEALLOCATE( buz )
-    IF ( ALLOCATED( bvz ) )  DEALLOCATE( bvz )
-    IF ( ALLOCATED( bwz ) )  DEALLOCATE( bwz )
-
-    ALLOCATE ( bux(-mergp_x:mergp_x,nzb:nzt+1),                                                    &
-               buy(-mergp_y:mergp_y,nzb:nzt+1),                                                    &
-               buz(-mergp_z:mergp_z,nzb:nzt+1),                                                    &
-               bvx(-mergp_x:mergp_x,nzb:nzt+1),                                                    &
-               bvy(-mergp_y:mergp_y,nzb:nzt+1),                                                    &
-               bvz(-mergp_z:mergp_z,nzb:nzt+1),                                                    &
-               bwx(-mergp_x:mergp_x,nzb:nzt+1),                                                    &
-               bwy(-mergp_y:mergp_y,nzb:nzt+1),                                                    &
-               bwz(-mergp_z:mergp_z,nzb:nzt+1) )
-!
-!-- Create filter functions
-    CALL stg_filter_func( nux, bux, mergp_x ) !filter ux
-    CALL stg_filter_func( nuy, buy, mergp_y ) !filter uy
-    CALL stg_filter_func( nuz, buz, mergp_z ) !filter uz
-    CALL stg_filter_func( nvx, bvx, mergp_x ) !filter vx
-    CALL stg_filter_func( nvy, bvy, mergp_y ) !filter vy
-    CALL stg_filter_func( nvz, bvz, mergp_z ) !filter vz
-    CALL stg_filter_func( nwx, bwx, mergp_x ) !filter wx
-    CALL stg_filter_func( nwy, bwy, mergp_y ) !filter wy
-    CALL stg_filter_func( nwz, bwz, mergp_z ) !filter wz
-
- END SUBROUTINE stg_setup_filter_function
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &stg_par for synthetic turbulence generator
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_parin
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter file
-
-    INTEGER(iwp) ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /stg_par/  compute_velocity_seeds_local,                                              &
-                        dt_stg_adjust,                                                             &
-                        dt_stg_call,                                                               &
-                        switch_off_module
-
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, stg_par, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    stg_par namelist was found and read correctly. Set flag that indicates that the synthetic
-!--    turbulence generator is switched on.
-       IF ( .NOT. switch_off_module )  syn_turb_gen = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    stg_par namelist was found but contained errors. Print an error message including the line
-!--    that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'stg_par', line )
-
-    ENDIF
-
- END SUBROUTINE stg_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_rrd_global_ftn( found )
-
-    LOGICAL, INTENT(OUT) ::  found !< flag indicating if variable was found
-
-    found = .TRUE.
-
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'time_stg_adjust' )
-          READ ( 13 )  time_stg_adjust
-
-       CASE ( 'time_stg_call' )
-          READ ( 13 )  time_stg_call
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE stg_rrd_global_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_rrd_global_mpi
-
-    CALL rrd_mpi_io( 'time_stg_adjust', time_stg_adjust )
-    CALL rrd_mpi_io( 'time_stg_call', time_stg_call )
-
- END SUBROUTINE stg_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_wrd_global
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-      CALL wrd_write_string( 'time_stg_adjust' )
-       WRITE ( 14 )  time_stg_adjust
-
-       CALL wrd_write_string( 'time_stg_call' )
-       WRITE ( 14 )  time_stg_call
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       CALL wrd_mpi_io( 'time_stg_adjust', time_stg_adjust )
-       CALL wrd_mpi_io( 'time_stg_call', time_stg_call )
-
-    ENDIF
-
- END SUBROUTINE stg_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Create turbulent inflow fields for u, v, w with prescribed length scales and Reynolds stress
-!> tensor after a method of Xie and Castro (2008), modified following suggestions of Kim et al.
-!> (2013), and using a Lund rotation (Lund, 1998).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_main
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    INTEGER(iwp) ::  i  !< grid index in x-direction
-    INTEGER(iwp) ::  j  !< loop index in y-direction
-    INTEGER(iwp) ::  k  !< loop index in z-direction
-
-    LOGICAL  ::  stg_call = .FALSE.  !< control flag indicating whether turbulence was updated or only restored from last call
-
-    REAL(wp) ::  dt_stg  !< time interval the STG is called
-
-    REAL(wp), DIMENSION(3) ::  mc_factor_l  !< local mass flux correction factor
-
-    IF ( debug_output_timestep )  CALL debug_message( 'stg_main', 'start' )
-!
-!-- Calculate time step which is needed for filter functions
-    dt_stg = MAX( dt_3d, dt_stg_call )
-!
-!-- Check if synthetic turbulence generator needs to be called and new perturbations need to be
-!-- created or if old disturbances can be imposed again.
-    IF ( time_stg_call >= dt_stg_call  .AND.                                                       &
-         intermediate_timestep_count == intermediate_timestep_count_max  )  THEN
-       stg_call = .TRUE.
-    ELSE
-       stg_call = .FALSE.
-    ENDIF
-!
-!-- Initial value of fu, fv, fw
-    IF ( time_since_reference_point == 0.0_wp .AND. .NOT. velocity_seed_initialized )  THEN
-!
-!--    Generate turbulence at the left and right boundary. Random numbers for the yz-planes at the
-!--    left/right boundary are generated by the left-sided mpi ranks only. After random numbers are
-!--    calculated, they are distributed to all other mpi ranks in the model, so that the velocity
-!--    seed matrices are available on all mpi ranks (i.e. also on the right-sided boundary mpi ranks).
-!--    In case of offline nesting, this implies, that the left- and the right-sided lateral boundary
-!--    have the same initial seeds.
-!--    Note, in case of inflow from the right only, only turbulence at the left boundary is required.
-       IF ( .NOT. ( nesting_offline  .OR.  ( child_domain .AND.  rans_mode_parent                  &
-            .AND.  .NOT.  rans_mode ) ) )  THEN
-          CALL stg_generate_seed_yz( nuy, nuz, buy, buz, fu_yz, id_stg_left )
-          CALL stg_generate_seed_yz( nvy, nvz, bvy, bvz, fv_yz, id_stg_left )
-          CALL stg_generate_seed_yz( nwy, nwz, bwy, bwz, fw_yz, id_stg_left )
-       ELSE
-          CALL stg_generate_seed_yz( nuy, nuz, buy, buz, fu_yz, id_stg_left, id_stg_right )
-          CALL stg_generate_seed_yz( nvy, nvz, bvy, bvz, fv_yz, id_stg_left, id_stg_right )
-          CALL stg_generate_seed_yz( nwy, nwz, bwy, bwz, fw_yz, id_stg_left, id_stg_right )
-!
-!--       Generate turbulence at the south and north boundary. Random numbers for the xz-planes at
-!--       the south/north boundary are generated by the south-sided mpi ranks only. Please see also
-!--       comment above.
-          CALL stg_generate_seed_xz( nux, nuz, bux, buz, fu_xz, id_stg_south, id_stg_north )
-          CALL stg_generate_seed_xz( nvx, nvz, bvx, bvz, fv_xz, id_stg_south, id_stg_north )
-          CALL stg_generate_seed_xz( nwx, nwz, bwx, bwz, fw_xz, id_stg_south, id_stg_north )
-       ENDIF
-       velocity_seed_initialized = .TRUE.
-    ENDIF
-!
-!-- New set of fu, fv, fw. Note, for inflow from the left side only, velocity seeds are only
-!-- required at the left boundary, while in case of offline nesting or RANS-LES nesting velocity
-!-- seeds are required also at the right, south and north boundaries.
-    IF ( stg_call )  THEN
-       IF ( .NOT. ( nesting_offline  .OR.                                                          &
-                  ( child_domain .AND.  rans_mode_parent                                           &
-                                 .AND.  .NOT.  rans_mode ) ) )  THEN
-          CALL stg_generate_seed_yz( nuy, nuz, buy, buz, fuo_yz, id_stg_left )
-          CALL stg_generate_seed_yz( nvy, nvz, bvy, bvz, fvo_yz, id_stg_left )
-          CALL stg_generate_seed_yz( nwy, nwz, bwy, bwz, fwo_yz, id_stg_left )
-
-       ELSE
-          CALL stg_generate_seed_yz( nuy, nuz, buy, buz, fuo_yz, id_stg_left, id_stg_right )
-          CALL stg_generate_seed_yz( nvy, nvz, bvy, bvz, fvo_yz, id_stg_left, id_stg_right )
-          CALL stg_generate_seed_yz( nwy, nwz, bwy, bwz, fwo_yz, id_stg_left, id_stg_right )
-
-          CALL stg_generate_seed_xz( nux, nuz, bux, buz, fuo_xz, id_stg_south, id_stg_north )
-          CALL stg_generate_seed_xz( nvx, nvz, bvx, bvz, fvo_xz, id_stg_south, id_stg_north )
-          CALL stg_generate_seed_xz( nwx, nwz, bwx, bwz, fwo_xz, id_stg_south, id_stg_north )
-       ENDIF
-    ENDIF
-
-!
-!-- Turbulence generation at left and/or right boundary
-    IF ( myidx == id_stg_left  .OR.  myidx == id_stg_right )  THEN
-!
-!--    Calculate new set of perturbations. Do this only at last RK3-substep and when dt_stg_call is
-!--    exceeded. Else the old set of perturbations is imposed
-       IF ( stg_call )  THEN
-
-          DO  j = nys, nyn
-             DO  k = nzb, nzt + 1
-!
-!--             Update fu, fv, fw following Eq. 14 of Xie and Castro (2008)
-                IF ( tu(k) == 0.0_wp  .OR.  adjustment_step )  THEN
-                   fu_yz(k,j) = fuo_yz(k,j)
-                ELSE
-                   fu_yz(k,j) = fu_yz(k,j) * EXP( -pi * dt_stg * 0.5_wp / tu(k) ) +                &
-                                fuo_yz(k,j) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tu(k) ) )
-                ENDIF
-
-                IF ( tv(k) == 0.0_wp  .OR.  adjustment_step )  THEN
-                   fv_yz(k,j) = fvo_yz(k,j)
-                ELSE
-                   fv_yz(k,j) = fv_yz(k,j) * EXP( -pi * dt_stg * 0.5_wp / tv(k) ) +                &
-                                fvo_yz(k,j) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tv(k) ) )
-                ENDIF
-
-                IF ( tw(k) == 0.0_wp  .OR.  adjustment_step )  THEN
-                   fw_yz(k,j) = fwo_yz(k,j)
-                ELSE
-                   fw_yz(k,j) = fw_yz(k,j) * EXP( -pi * dt_stg * 0.5_wp / tw(k) ) +                &
-                                fwo_yz(k,j) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tw(k) ) )
-                ENDIF
-             ENDDO
-          ENDDO
-
-          dist_yz(nzb,:,1) = 0.0_wp
-          dist_yz(nzb,:,2) = 0.0_wp
-          dist_yz(nzb,:,3) = 0.0_wp
-
-          IF ( myidx == id_stg_left  )  i = nxl
-          IF ( myidx == id_stg_right )  i = nxr+1
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt + 1
-!
-!--             Lund rotation following Eq. 17 in Xie and Castro (2008).
-                dist_yz(k,j,1) = a11(k) * fu_yz(k,j) *                                             &
-                                 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-
-             ENDDO
-          ENDDO
-
-          IF ( myidx == id_stg_left  )  i = nxl-1
-          IF ( myidx == id_stg_right )  i = nxr+1
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt + 1
-!
-!--             Lund rotation following Eq. 17 in Xie and Castro (2008).
-!--             Additional factors are added to improve the variance of v and w experimental test
-!--             of 1.2
-                dist_yz(k,j,2) = ( a21(k) * fu_yz(k,j) + a22(k) * fv_yz(k,j) ) *                   &
-                                 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-                dist_yz(k,j,3) = ( a31(k) * fu_yz(k,j) + a32(k) * fv_yz(k,j) +                     &
-                                   a33(k) * fw_yz(k,j) ) *                                         &
-                                 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-
-             ENDDO
-          ENDDO
-       ENDIF
-!
-!--    Mass flux correction following Kim et al. (2013)
-!--    This correction factor ensures that the mass flux is preserved at the inflow boundary. First,
-!--    calculate mean value of the imposed perturbations at yz boundary. Note, this needs to be done
-!--    only after the last RK3-substep, else the boundary values won't be accessed.
-       IF ( intermediate_timestep_count == intermediate_timestep_count_max )  THEN
-          mc_factor_l = 0.0_wp
-          mc_factor   = 0.0_wp
-!
-!--       Sum up the original volume flows (with and without perturbations).
-!--       Note, for non-normal components (here v and w) it is actually no volume flow.
-          IF ( myidx == id_stg_left  )  i = nxl
-          IF ( myidx == id_stg_right )  i = nxr+1
-
-          mc_factor_l(1) = SUM( dist_yz(nzb:nzt,nys:nyn,1) *                                       &
-                       MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt,nys:nyn,i), 1 ) ) )
-
-          IF ( myidx == id_stg_left  )  i = nxl-1
-          IF ( myidx == id_stg_right )  i = nxr+1
-
-          mc_factor_l(2) = SUM( dist_yz(nzb:nzt,nysv:nyn,2) *                                      &
-                       MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt,nysv:nyn,i), 2 ) ) )
-          mc_factor_l(3) = SUM( dist_yz(nzb:nzt,nys:nyn,3) *                                       &
-                       MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt,nys:nyn,i), 3 ) ) )
-
-#if defined( __parallel )
-          CALL MPI_ALLREDUCE( mc_factor_l, mc_factor, 3, MPI_REAL, MPI_SUM, comm1dy, ierr )
-#else
-          mc_factor   = mc_factor_l
-#endif
-!
-!--       Calculate correction factor and force zero mean perturbations.
-          mc_factor = mc_factor / REAL( nr_non_topo_yz, KIND = wp )
-
-          IF ( myidx == id_stg_left  )  i = nxl
-          IF ( myidx == id_stg_right )  i = nxr+1
-
-          dist_yz(:,nys:nyn,1) = ( dist_yz(:,nys:nyn,1) - mc_factor(1) ) *                         &
-                                MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,nys:nyn,i), 1 ) )
-
-
-          IF ( myidx == id_stg_left  )  i = nxl-1
-          IF ( myidx == id_stg_right )  i = nxr+1
-
-          dist_yz(:,nys:nyn,2) = ( dist_yz(:,nys:nyn,2) - mc_factor(2) ) *                         &
-                                MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,nys:nyn,i), 2 ) )
-
-          dist_yz(:,nys:nyn,3) = ( dist_yz(:,nys:nyn,3) - mc_factor(3) ) *                         &
-                                MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,nys:nyn,i), 3 ) )
-!
-!--       Add disturbances
-          IF ( myidx == id_stg_left  )  THEN
-!
-!--          For the left boundary distinguish between mesoscale offline / self nesting and
-!--          turbulent inflow at the left boundary only. In the latter case turbulence is imposed on
-!--          the mean inflow profiles.
-             IF ( .NOT. nesting_offline  .AND.  .NOT. child_domain )  THEN
-!
-!--             Add disturbance at the inflow
-                DO  j = nys, nyn
-                   DO  k = nzb, nzt+1
-                      u(k,j,-nbgp+1:0) = ( mean_inflow_profiles(k,1) + dist_yz(k,j,1) ) *          &
-                                     MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,0), 1 ) )
-                      v(k,j,-nbgp:-1)  = ( mean_inflow_profiles(k,2) + dist_yz(k,j,2) ) *          &
-                                     MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,-1), 2 ) )
-                      w(k,j,-nbgp:-1)  = dist_yz(k,j,3) *                                          &
-                                     MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,-1), 3 ) )
-                   ENDDO
-                ENDDO
-             ELSE
-
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      u(k,j,0)   = ( u(k,j,0)  + dist_yz(k,j,1) ) *                                &
-                                   MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,0), 1 ) )
-                      u(k,j,-1)  = u(k,j,0)
-                      v(k,j,-1)  = ( v(k,j,-1) + dist_yz(k,j,2) ) *                                &
-                                   MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,-1), 2 ) )
-                      w(k,j,-1)  = ( w(k,j,-1) + dist_yz(k,j,3) ) *                                &
-                                   MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,-1), 3 ) )
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-          IF ( myidx == id_stg_right  )  THEN
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   u(k,j,nxr+1) = ( u(k,j,nxr+1) + dist_yz(k,j,1) ) *                              &
-                                  MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 1 ) )
-                   v(k,j,nxr+1) = ( v(k,j,nxr+1) + dist_yz(k,j,2) ) *                              &
-                                  MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 2 ) )
-                   w(k,j,nxr+1) = ( w(k,j,nxr+1) + dist_yz(k,j,3) ) *                              &
-                                  MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 3 ) )
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- Turbulence generation at north and south boundary
-    IF ( myidy == id_stg_north  .OR.  myidy == id_stg_south )  THEN
-!
-!--    Calculate new set of perturbations. Do this only at last RK3-substep and when dt_stg_call is
-!--    exceeded. Else the old set of perturbations is imposed
-       IF ( stg_call )  THEN
-          DO  i = nxl, nxr
-             DO  k = nzb, nzt + 1
-!
-!--             Update fu, fv, fw following Eq. 14 of Xie and Castro (2008)
-                IF ( tu(k) == 0.0_wp  .OR.  adjustment_step )  THEN
-                   fu_xz(k,i) = fuo_xz(k,i)
-                ELSE
-                   fu_xz(k,i) = fu_xz(k,i) * EXP( -pi * dt_stg * 0.5_wp / tu(k) ) +                &
-                                fuo_xz(k,i) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tu(k) ) )
-                ENDIF
-
-                IF ( tv(k) == 0.0_wp  .OR.  adjustment_step )  THEN
-                   fv_xz(k,i) = fvo_xz(k,i)
-                ELSE
-                   fv_xz(k,i) = fv_xz(k,i) * EXP( -pi * dt_stg * 0.5_wp / tv(k) ) +                &
-                                fvo_xz(k,i) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tv(k) ) )
-                ENDIF
-
-                IF ( tw(k) == 0.0_wp  .OR.  adjustment_step )  THEN
-                   fw_xz(k,i) = fwo_xz(k,i)
-                ELSE
-                   fw_xz(k,i) = fw_xz(k,i) * EXP( -pi * dt_stg * 0.5_wp / tw(k) ) +                &
-                                fwo_xz(k,i) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tw(k) ) )
-                ENDIF
-             ENDDO
-          ENDDO
-
-
-          dist_xz(nzb,:,1) = 0.0_wp
-          dist_xz(nzb,:,2) = 0.0_wp
-          dist_xz(nzb,:,3) = 0.0_wp
-
-          IF ( myidy == id_stg_south  ) j = nys
-          IF ( myidy == id_stg_north )  j = nyn+1
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt + 1
-!
-!--             Lund rotation following Eq. 17 in Xie and Castro (2008).
-!--             Additional factors are added to improve the variance of v and w
-                !experimental test of 1.2
-                dist_xz(k,i,2) = ( a21(k) * fu_xz(k,i) + a22(k) * fv_xz(k,i) ) *                   &
-                                 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-             ENDDO
-          ENDDO
-
-          IF ( myidy == id_stg_south  ) j = nys-1
-          IF ( myidy == id_stg_north )  j = nyn+1
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt + 1
-!
-!--             Lund rotation following Eq. 17 in Xie and Castro (2008).
-!--             Additional factors are added to improve the variance of v and w
-                dist_xz(k,i,1) = a11(k) * fu_xz(k,i) *                                             &
-                                 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-
-                dist_xz(k,i,3) = ( a31(k) * fu_xz(k,i) + a32(k) * fv_xz(k,i) +                     &
-                                   a33(k) * fw_xz(k,i) ) *                                         &
-                                 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-             ENDDO
-          ENDDO
-       ENDIF
-
-!
-!--    Mass flux correction following Kim et al. (2013). This correction factor ensures that the
-!--    mass flux is preserved at the inflow boundary. First, calculate mean value of the imposed
-!--    perturbations at yz boundary. Note, this needs to be done only after the last RK3-substep,
-!--    else the boundary values won't be accessed.
-       IF ( intermediate_timestep_count == intermediate_timestep_count_max )  THEN
-          mc_factor_l = 0.0_wp
-          mc_factor   = 0.0_wp
-
-          IF ( myidy == id_stg_south  ) j = nys
-          IF ( myidy == id_stg_north )  j = nyn+1
-
-          mc_factor_l(2) = SUM( dist_xz(nzb:nzt,nxl:nxr,2) *                                       &
-                       MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt,j,nxl:nxr), 2 ) ) )
-
-          IF ( myidy == id_stg_south ) j = nys-1
-          IF ( myidy == id_stg_north ) j = nyn+1
-
-          mc_factor_l(1) = SUM( dist_xz(nzb:nzt,nxlu:nxr,1) *                                      &
-                       MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt,j,nxlu:nxr), 1 ) ) )
-          mc_factor_l(3) = SUM( dist_xz(nzb:nzt,nxl:nxr,3) *                                       &
-                       MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt,j,nxl:nxr), 3 ) ) )
-
-#if defined( __parallel )
-          CALL MPI_ALLREDUCE( mc_factor_l, mc_factor, 3, MPI_REAL, MPI_SUM, comm1dx, ierr )
-#else
-          mc_factor   = mc_factor_l
-#endif
-
-          mc_factor = mc_factor / REAL( nr_non_topo_xz, KIND = wp )
-
-          IF ( myidy == id_stg_south ) j = nys
-          IF ( myidy == id_stg_north ) j = nyn+1
-
-          dist_xz(:,nxl:nxr,2) = ( dist_xz(:,nxl:nxr,2) - mc_factor(2) ) *                         &
-                                MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,j,nxl:nxr), 2 ) )
-
-
-          IF ( myidy == id_stg_south ) j = nys-1
-          IF ( myidy == id_stg_north ) j = nyn+1
-
-          dist_xz(:,nxl:nxr,1) = ( dist_xz(:,nxl:nxr,1) - mc_factor(1) ) *                         &
-                                MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,j,nxl:nxr), 1 ) )
-
-          dist_xz(:,nxl:nxr,3) = ( dist_xz(:,nxl:nxr,3) - mc_factor(3) ) *                         &
-                                MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,j,nxl:nxr), 3 ) )
-!
-!--       Add disturbances
-          IF ( myidy == id_stg_south )  THEN
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   u(k,-1,i) = ( u(k,-1,i) + dist_xz(k,i,1) )                                      &
-                               * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,-1,i), 1 ) )
-                   v(k,0,i)  = ( v(k,0,i)  + dist_xz(k,i,2) )                                      &
-                               * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,0,i), 2 ) )
-                   v(k,-1,i) = v(k,0,i)
-                   w(k,-1,i) = ( w(k,-1,i) + dist_xz(k,i,3) )                                      &
-                               * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,-1,i), 3 ) )
-                ENDDO
-             ENDDO
-          ENDIF
-          IF ( myidy == id_stg_north  )  THEN
-
-             DO  i = nxl, nxr
-                DO  k = nzb+1, nzt
-                   u(k,nyn+1,i) = ( u(k,nyn+1,i) + dist_xz(k,i,1) ) *                              &
-                                  MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 1 ) )
-                   v(k,nyn+1,i) = ( v(k,nyn+1,i) + dist_xz(k,i,2) ) *                              &
-                                  MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 2 ) )
-                   w(k,nyn+1,i) = ( w(k,nyn+1,i) + dist_xz(k,i,3) ) *                              &
-                                  MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 3 ) )
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-    ENDIF
-!
-!-- Exchange ghost points.
-    CALL exchange_horiz( u, nbgp )
-    CALL exchange_horiz( v, nbgp )
-    CALL exchange_horiz( w, nbgp )
-!
-!-- Finally, set time counter for calling STG to zero
-    IF ( stg_call )  time_stg_call = 0.0_wp
-!
-!-- Set adjustment step to False to indicate that time correlation can be
-!-- switched-on again.
-    adjustment_step = .FALSE.
-
-    IF ( debug_output_timestep )  CALL debug_message( 'stg_main', 'end' )
-
- END SUBROUTINE stg_main
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Generate a set of random number rand_it wich is equal on each PE and calculate the velocity seed
-!> f_n. f_n is splitted in vertical direction by the number of PEs in x-direction and each PE
-!> calculates a vertical subsection of f_n. At the the end, all parts are collected to form the full
-!> array.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_generate_seed_yz( n_y, n_z, b_y, b_z, f_n, id_left, id_right )
-
-    INTEGER(iwp)           ::  id_left     !< core ids at respective boundaries
-    INTEGER(iwp), OPTIONAL ::  id_right    !< core ids at respective boundaries
-    INTEGER(iwp)           ::  j           !< loop index in y-direction
-    INTEGER(iwp)           ::  jj          !< loop index in y-direction
-    INTEGER(iwp)           ::  k           !< loop index in z-direction
-    INTEGER(iwp)           ::  kk          !< loop index in z-direction
-    INTEGER(iwp)           ::  send_count  !< send count for MPI_GATHERV
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1) ::  n_y  !< length scale in y-direction
-    INTEGER(iwp), DIMENSION(nzb:nzt+1) ::  n_z  !< length scale in z-direction
-
-    REAL(wp) ::  nyz_inv         !< inverse of number of grid points in yz-slice
-    REAL(wp) ::  rand_av         !< average of random number
-    REAL(wp) ::  rand_sigma_inv  !< inverse of stdev of random number
-
-    REAL(wp), DIMENSION(-mergp_y:mergp_y,nzb:nzt+1) :: b_y     !< filter function in y-direction
-    REAL(wp), DIMENSION(-mergp_z:mergp_z,nzb:nzt+1) :: b_z     !< filter function in z-direction
-
-    REAL(wp), DIMENSION(nzb_x_stg:nzt_x_stg+1,nys:nyn) ::  f_n_l  !<  local velocity seed
-    REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn)             ::  f_n    !<  velocity seed
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rand_it  !< global array of random numbers
-!
-!-- Generate random numbers using the parallel random generator. The set of random numbers are
-!-- modified to have an average of 0 and unit variance. Note, at the end the random number array
-!-- must be defined globally in order to compute the correlation matrices. However, the calculation
-!-- and normalization of random numbers is done locally, while the result is later distributed to
-!-- all processes. Further, please note, a set of random numbers is only calculated for the west
-!-- boundary, while the east boundary uses the same random numbers and thus also computes the same
-!-- correlation matrix.
-    ALLOCATE( rand_it(nzb-mergp_z:nzt+1+mergp_z,-mergp_y+nys:nyn+mergp_y) )
-    rand_it = 0.0_wp
-
-    rand_av        = 0.0_wp
-    rand_sigma_inv = 0.0_wp
-    nyz_inv        = 1.0_wp / REAL( ( nzt + 1 + mergp_z - ( nzb - mergp_z ) + 1 )                  &
-                     * ( ny + mergp_y - ( 0 - mergp_y ) + 1 ), KIND = wp )
-!
-!-- Compute and normalize random numbers.
-    DO  j = nys - mergp_y, nyn + mergp_y
-!
-!--    Put the random seeds at grid point j
-       CALL random_seed_parallel( put=seq_rand_yz(:,j) )
-       DO  k = nzb - mergp_z, nzt + 1 + mergp_z
-          CALL random_number_parallel( random_dummy )
-          rand_it(k,j) = random_dummy
-       ENDDO
-!
-!--    Get the new random seeds from last call at grid point j
-       CALL random_seed_parallel( get=seq_rand_yz(:,j) )
-    ENDDO
-!
-!-- For normalization to zero mean, sum-up the global random numers. To normalize the global set of
-!-- random numbers, the inner ghost layers mergp must not be summed-up, else the random numbers on
-!-- the ghost layers will be stronger weighted as they also occur on the inner subdomains.
-    DO  j = MERGE( nys, nys - mergp_y, nys /= 0 ), MERGE( nyn, nyn + mergp_y, nyn /= ny )
-       DO  k = nzb - mergp_z, nzt + 1 + mergp_z
-          rand_av = rand_av + rand_it(k,j)
-       ENDDO
-    ENDDO
-
-#if defined( __parallel )
-!
-!-- Sum-up the local averages of the random numbers
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, rand_av, 1, MPI_REAL, MPI_SUM, comm1dy, ierr )
-#endif
-    rand_av = rand_av * nyz_inv
-!
-!-- Obtain zero mean
-    rand_it= rand_it - rand_av
-!
-!-- Now, compute the variance
-    DO  j = MERGE( nys, nys - mergp_y, nys /= 0 ), MERGE( nyn, nyn + mergp_y, nyn /= ny )
-       DO  k = nzb - mergp_z, nzt + 1 + mergp_z
-          rand_sigma_inv = rand_sigma_inv + rand_it(k,j)**2
-       ENDDO
-    ENDDO
-
-#if defined( __parallel )
-!
-!-- Sum-up the local quadratic averages of the random numbers
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, rand_sigma_inv, 1, MPI_REAL, MPI_SUM, comm1dy, ierr )
-#endif
-!
-!-- Compute standard deviation
-    IF ( rand_sigma_inv /= 0.0_wp )  THEN
-       rand_sigma_inv = 1.0_wp / SQRT( rand_sigma_inv * nyz_inv )
-    ELSE
-       rand_sigma_inv = 1.0_wp
-    ENDIF
-!
-!-- Normalize with standard deviation to obtain unit variance
-    rand_it = rand_it * rand_sigma_inv
-
-    CALL cpu_log( log_point_s(31), 'STG f_n factors', 'start' )
-!
-!-- Generate velocity seed following Eq.6 of Xie and Castro (2008). There are two options. In the
-!-- first one, the computation of the seeds is distributed to all processes along the communicator
-!-- comm1dy and gathered on the leftmost and, if necessary, on the rightmost process. For huge
-!-- length scales the computational effort can become quite huge (it scales with the turbulent
-!-- length scales), so that gain by parallelization exceeds the costs by the subsequent
-!-- communication. In the second option, which performs better when the turbulent length scales
-!-- are parametrized and thus the loops are smaller, the seeds are computed locally and no
-!-- communication is necessary.
-    IF ( compute_velocity_seeds_local )  THEN
-
-       f_n  = 0.0_wp
-       DO  j = nys, nyn
-          DO  k = nzb, nzt+1
-             DO  jj = -n_y(k), n_y(k)
-                DO  kk = -n_z(k), n_z(k)
-                   f_n(k,j) = f_n(k,j) + b_y(jj,k) * b_z(kk,k) * rand_it(k+kk,j+jj)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ELSE
-
-       f_n_l  = 0.0_wp
-       DO  j = nys, nyn
-          DO  k = nzb_x_stg, nzt_x_stg+1
-             DO  jj = -n_y(k), n_y(k)
-                DO  kk = -n_z(k), n_z(k)
-                   f_n_l(k,j) = f_n_l(k,j) + b_y(jj,k) * b_z(kk,k) * rand_it(k+kk,j+jj)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    Gather velocity seeds of full subdomain
-       send_count = nzt_x_stg - nzb_x_stg + 1
-       IF ( nzt_x_stg == nzt )  send_count = send_count + 1
-
-#if defined( __parallel )
-!
-!--    Gather the velocity seed matrix on left boundary mpi ranks.
-       CALL MPI_GATHERV( f_n_l(nzb_x_stg,nys), send_count, stg_type_yz_small, f_n(nzb+1,nys),      &
-                         recv_count_yz, displs_yz, stg_type_yz, id_left, comm1dx, ierr )
-!
-!--    If required, gather the same velocity seed matrix on right boundary mpi ranks (in offline
-!--    nesting for example).
-       IF ( PRESENT( id_right ) )  THEN
-          CALL MPI_GATHERV( f_n_l(nzb_x_stg,nys), send_count, stg_type_yz_small, f_n(nzb+1,nys),   &
-                            recv_count_yz, displs_yz, stg_type_yz, id_right, comm1dx, ierr )
-       ENDIF
-#else
-       f_n(nzb+1:nzt+1,nys:nyn) = f_n_l(nzb_x_stg:nzt_x_stg+1,nys:nyn)
-!
-!--    Next line required to avoid compile errors because of unused dummy arguments
-       IF ( id_left == 0 )  id_right = 0
-#endif
-
-    ENDIF
-
-    DEALLOCATE( rand_it )
-
-    CALL cpu_log( log_point_s(31), 'STG f_n factors', 'stop' )
-
- END SUBROUTINE stg_generate_seed_yz
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Generate a set of random number rand_it wich is equal on each PE and calculate the velocity seed
-!> f_n.
-!> f_n is splitted in vertical direction by the number of PEs in y-direction and and each PE
-!> calculates a vertical subsection of f_n. At the the end, all parts are collected to form the
-!> full array.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_generate_seed_xz( n_x, n_z, b_x, b_z, f_n, id_south, id_north )
-
-    INTEGER(iwp) :: i           !< loop index in x-direction
-    INTEGER(iwp) :: id_north    !< core ids at respective boundaries
-    INTEGER(iwp) :: id_south    !< core ids at respective boundaries
-    INTEGER(iwp) :: ii          !< loop index in x-direction
-    INTEGER(iwp) :: k           !< loop index in z-direction
-    INTEGER(iwp) :: kk          !< loop index in z-direction
-    INTEGER(iwp) :: send_count  !< send count for MPI_GATHERV
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1) :: n_x    !< length scale in x-direction
-    INTEGER(iwp), DIMENSION(nzb:nzt+1) :: n_z    !< length scale in z-direction
-
-    REAL(wp) :: nxz_inv         !< inverse of number of grid points in xz-slice
-    REAL(wp) :: rand_av         !< average of random number
-    REAL(wp) :: rand_sigma_inv  !< inverse of stdev of random number
-
-    REAL(wp), DIMENSION(-mergp_x:mergp_x,nzb:nzt+1) :: b_x     !< filter function in x-direction
-    REAL(wp), DIMENSION(-mergp_z:mergp_z,nzb:nzt+1) :: b_z     !< filter function in z-direction
-
-    REAL(wp), DIMENSION(nzb_y_stg:nzt_y_stg+1,nxl:nxr) :: f_n_l   !<  local velocity seed
-    REAL(wp), DIMENSION(nzb:nzt+1,nxl:nxr)             :: f_n     !<  velocity seed
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rand_it   !< global array of random numbers
-
-!
-!-- Generate random numbers using the parallel random generator. The set of random numbers are
-!-- modified to have an average of 0 and unit variance. Note, at the end the random number array
-!-- must be defined globally in order to compute the correlation matrices. However, the calculation
-!-- and normalization of random numbers is done locally, while the result is later distributed to
-!-- all processes. Further, please note, a set of random numbers is only calculated for the south
-!-- boundary, while the north boundary uses the same random numbers and thus also computes the same
-!-- correlation matrix.
-    ALLOCATE( rand_it(nzb-mergp_z:nzt+1+mergp_z,-mergp_x+nxl:nxr+mergp_x) )
-    rand_it = 0.0_wp
-
-    rand_av        = 0.0_wp
-    rand_sigma_inv = 0.0_wp
-    nxz_inv        = 1.0_wp / REAL( ( nzt + 1 + mergp_z - ( nzb - mergp_z ) + 1 )                  &
-                     * ( nx + mergp_x - ( 0 - mergp_x ) +1 ), KIND = wp )
-!
-!-- Compute and normalize random numbers.
-    DO  i = nxl - mergp_x, nxr + mergp_x
-!
-!--    Put the random seeds at grid point ii
-       CALL random_seed_parallel( put=seq_rand_xz(:,i) )
-       DO  k = nzb - mergp_z, nzt + 1 + mergp_z
-          CALL random_number_parallel( random_dummy )
-          rand_it(k,i) = random_dummy
-       ENDDO
-!
-!--    Get the new random seeds from last call at grid point ii
-       CALL random_seed_parallel( get=seq_rand_xz(:,i) )
-    ENDDO
-!
-!-- For normalization to zero mean, sum-up the global random numers.
-!-- To normalize the global set of random numbers, the inner ghost layers mergp must not be
-!-- summed-up, else the random numbers on the ghost layers will be stronger weighted as they
-!-- also occur on the inner subdomains.
-    DO  i = MERGE( nxl, nxl - mergp_x, nxl /= 0 ), MERGE( nxr, nxr + mergp_x, nxr /= nx )
-       DO  k = nzb - mergp_z, nzt + 1 + mergp_z
-          rand_av = rand_av + rand_it(k,i)
-       ENDDO
-    ENDDO
-
-#if defined( __parallel )
-!
-!-- Sum-up the local averages of the random numbers
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, rand_av, 1, MPI_REAL, MPI_SUM, comm1dx, ierr )
-#endif
-    rand_av = rand_av * nxz_inv
-!
-!-- Obtain zero mean
-    rand_it= rand_it - rand_av
-!
-!-- Now, compute the variance
-    DO  i = MERGE( nxl, nxl - mergp_x, nxl /= 0 ), MERGE( nxr, nxr + mergp_x, nxr /= nx )
-       DO  k = nzb - mergp_z, nzt + 1 + mergp_z
-          rand_sigma_inv = rand_sigma_inv + rand_it(k,i)**2
-       ENDDO
-    ENDDO
-
-#if defined( __parallel )
-!
-!-- Sum-up the local quadratic averages of the random numbers
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, rand_sigma_inv, 1, MPI_REAL, MPI_SUM, comm1dx, ierr )
-#endif
-!
-!-- Compute standard deviation
-    IF ( rand_sigma_inv /= 0.0_wp )  THEN
-       rand_sigma_inv = 1.0_wp / SQRT( rand_sigma_inv * nxz_inv )
-    ELSE
-       rand_sigma_inv = 1.0_wp
-    ENDIF
-!
-!-- Normalize with standard deviation to obtain unit variance
-    rand_it = rand_it * rand_sigma_inv
-
-    CALL cpu_log( log_point_s(31), 'STG f_n factors', 'start' )
-!
-!-- Generate velocity seed following Eq.6 of Xie and Castro (2008). There are two options. In the
-!-- first one, the computation of the seeds is distributed to all processes along the communicator
-!-- comm1dx and gathered on the southmost and, if necessary, on the northmost process. For huge
-!-- length scales the computational effort can become quite huge (it scales with the turbulent
-!-- length scales), so that gain by parallelization exceeds the costs by the subsequent communication.
-!-- In the second option, which performs better when the turbulent length scales are parametrized
-!-- and thus the loops are smaller, the seeds are computed locally and no communication is necessary.
-    IF ( compute_velocity_seeds_local )  THEN
-
-       f_n  = 0.0_wp
-       DO  i = nxl, nxr
-          DO  k = nzb, nzt+1
-             DO  ii = -n_x(k), n_x(k)
-                DO  kk = -n_z(k), n_z(k)
-                   f_n(k,i) = f_n(k,i) + b_x(ii,k) * b_z(kk,k) * rand_it(k+kk,i+ii)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-
-    ELSE
-
-       f_n_l  = 0.0_wp
-       DO  i = nxl, nxr
-          DO  k = nzb_y_stg, nzt_y_stg+1
-             DO  ii = -n_x(k), n_x(k)
-                DO  kk = -n_z(k), n_z(k)
-                   f_n_l(k,i) = f_n_l(k,i) + b_x(ii,k) * b_z(kk,k) * rand_it(k+kk,i+ii)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    Gather velocity seeds of full subdomain
-       send_count = nzt_y_stg - nzb_y_stg + 1
-       IF ( nzt_y_stg == nzt )  send_count = send_count + 1
-
-#if defined( __parallel )
-!
-!--    Gather the processed velocity seed on south boundary mpi ranks.
-       CALL MPI_GATHERV( f_n_l(nzb_y_stg,nxl), send_count, stg_type_xz_small, f_n(nzb+1,nxl),      &
-                         recv_count_xz, displs_xz, stg_type_xz, id_south, comm1dy, ierr )
-!
-!--    Gather the processed velocity seed on north boundary mpi ranks.
-       CALL MPI_GATHERV( f_n_l(nzb_y_stg,nxl), send_count, stg_type_xz_small, f_n(nzb+1,nxl),      &
-                         recv_count_xz, displs_xz, stg_type_xz, id_north, comm1dy, ierr )
-#else
-       f_n(nzb+1:nzt+1,nxl:nxr) = f_n_l(nzb_y_stg:nzt_y_stg+1,nxl:nxr)
-!
-!--    Next line required to avoid compile errors because of unused dummy arguments
-       IF ( id_north == 0 )  id_south = 0
-#endif
-
-    ENDIF
-
-    DEALLOCATE( rand_it )
-
-    CALL cpu_log( log_point_s(31), 'STG f_n factors', 'stop' )
-
- END SUBROUTINE stg_generate_seed_xz
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parametrization of the Reynolds-stress componentes, turbulent length- and time scales. The
-!> parametrization follows Brost et al. (1982) with modifications described in Rotach et al. (1996),
-!> which is applied in state-of-the-art dispserion modelling.
-!--------------------------------------------------------------------------------------------------!
-  SUBROUTINE parametrize_turbulence
-
-    INTEGER(iwp) :: k                 !< loop index in z-direction
-
-    REAL(wp) ::  corr_term_uh         !< correction term in parametrization of horizontal variances for unstable stratification
-    REAL(wp) ::  d_zi                 !< inverse boundary-layer depth
-    REAL(wp) ::  length_scale_lon     !< length scale in flow direction
-    REAL(wp) ::  length_scale_lon_zi  !< length scale in flow direction at boundary-layer top
-    REAL(wp) ::  length_scale_lat     !< length scale in crosswind direction
-    REAL(wp) ::  length_scale_lat_zi  !< length scale in crosswind direction at boundary-layer top
-    REAL(wp) ::  length_scale_vert    !< length scale in vertical direction
-    REAL(wp) ::  length_scale_vert_zi !< length scale in vertical direction at boundary-layer top
-    REAL(wp) ::  time_scale_zi        !< time scale at boundary-layer top
-    REAL(wp) ::  r11_zi               !< longitudinal variance at boundary-layer top
-    REAL(wp) ::  r22_zi               !< crosswind variance at boundary-layer top
-    REAL(wp) ::  r33_zi               !< vertical variance at boundary-layer top
-    REAL(wp) ::  r31_zi               !< r31 at boundary-layer top
-    REAL(wp) ::  r32_zi               !< r32 at boundary-layer top
-    REAL(wp) ::  rlat1                !< first dummy argument for crosswind compoment of reynolds stress
-    REAL(wp) ::  rlat2                !< second dummy argument for crosswind compoment of reynolds stress
-    REAL(wp) ::  rlon1                !< first dummy argument for longitudinal compoment of reynolds stress
-    REAL(wp) ::  rlon2                !< second dummy argument for longitudinal compoment of reynolds stress
-    REAL(wp) ::  zzi                  !< ratio of z/zi
-
-    REAL(wp), DIMENSION(nzb+1:nzt+1) ::  cos_phi    !< cosine of angle between mean flow direction and x-axis
-    REAL(wp), DIMENSION(nzb+1:nzt+1) ::  phi        !< angle between mean flow direction and x-axis
-    REAL(wp), DIMENSION(nzb+1:nzt+1) ::  sin_phi    !< sine of angle between mean flow direction and x-axis
-
-!
-!-- Calculate the boundary-layer top index. Boundary-layer top is calculated by Richardson-bulk
-!-- criterion according to Heinze et al. (2017).
-    k_zi = MAX( 1, MINLOC( ABS( zu - zi_ribulk ), DIM = 1 ) )
-    IF ( zu(k_zi) > zi_ribulk )  k_zi = k_zi - 1
-    k_zi = MIN( k_zi, nzt )
-!
-!-- Calculate angle between flow direction and x-axis.
-    DO  k = nzb+1, nzt + 1
-       IF ( u_init(k) /= 0.0_wp )  THEN
-          phi(k) = ATAN( v_init(k) / u_init(k) )
-       ELSE
-          phi(k) = 0.5 * pi
-       ENDIF
-!
-!--    Pre-calculate sine and cosine.
-       cos_phi(k) = COS( phi(k) )
-       sin_phi(k) = SIN( phi(k) )
-    ENDDO
-!
-!-- Parametrize Reynolds-stress components. Please note, parametrization is formulated for the
-!-- stream- and spanwise components, while stream- and spanwise direction do not necessarily
-!-- coincide with the grid axis. Hence, components are rotated after computation.
-    d_zi = 1.0_wp / zi_ribulk
-    DO  k = nzb+1, k_zi
-
-       corr_term_uh = MERGE( 0.35_wp * ABS(                                                        &
-                        - zi_ribulk / ( kappa * scale_l - 10E-4_wp )                               &
-                                       )**( 2.0_wp / 3.0_wp ),                                     &
-                          0.0_wp,                                                                  &
-                          scale_l < -5.0_wp )
-!
-!--    Determine normalized height coordinate
-       zzi = zu(k) * d_zi
-!
-!--    Compute longitudinal and crosswind component of reynolds stress. Rotate these components by
-!--    the wind direction to map onto the u- and v-component. Note, since reynolds stress for
-!--    variances cannot become negative, take the absolute values.
-       rlon1 = scale_us**2 * ( corr_term_uh + 5.0_wp - 4.0_wp * zzi )
-       rlat1 = scale_us**2 * ( corr_term_uh + 2.0_wp - zzi )
-
-       r11(k) = ABS(   cos_phi(k) * rlon1 + sin_phi(k) * rlat1 )
-       r22(k) = ABS( - sin_phi(k) * rlon1 + cos_phi(k) * rlat1 )
-!
-!--    w'w'
-       r33(k) = scale_wm**2 * (                                                                    &
-                   1.5_wp * zzi**( 2.0_wp / 3.0_wp ) * EXP( -2.0_wp * zzi )                        &
-                 + ( 1.7_wp - zzi ) * ( scale_us / scale_wm )**2                                   &
-                              )
-!
-!--    u'w' and v'w'. After calculation of the longitudinal and crosswind component
-!--    these are projected along the x- and y-direction. Note, it is assumed that
-!--    the flux within the boundary points opposite to the vertical gradient.
-       rlon2 = scale_us**2 * ( zzi - 1.0_wp )
-       rlat2 = scale_us**2 * ( 0.4 * zzi * ( 1.0_wp - zzi ) )
-
-       r31(k) = SIGN( ABS(   cos_phi(k) * rlon2 + sin_phi(k) * rlat2 ),                            &
-                   - ( u_init(k+1) - u_init(k-1) ) )
-       r32(k) = SIGN( ABS( - sin_phi(k) * rlon2 + cos_phi(k) * rlat2 ),                            &
-                   - ( v_init(k+1) - v_init(k-1) ) )
-!
-!--    For u'v' no parametrization exist so far. For simplicity assume a similar profile as
-!--    for the vertical transport.
-       r21(k) = 0.5_wp * ( r31(k) + r32(k) )
-!
-!--    Compute turbulent time scales according to Brost et al. (1982). Note, time scales are
-!--    limited to the adjustment time scales.
-       tu(k)  = MIN( dt_stg_adjust,                                                                &
-                     3.33_wp * zzi * ( 1.0 - 0.67_wp * zzi ) / scale_wm * zi_ribulk )
-
-       tv(k)  = tu(k)
-       tw(k)  = tu(k)
-
-       length_scale_lon  = MIN( SQRT( r11(k) ) * tu(k), zi_ribulk )
-       length_scale_lat  = MIN( SQRT( r22(k) ) * tv(k), zi_ribulk )
-       length_scale_vert = MIN( SQRT( r33(k) ) * tw(k), zi_ribulk )
-!
-!--    Assume isotropic turbulence length scales
-       nux(k) = MAX( INT( length_scale_lon  * ddx     ), 1 )
-       nuy(k) = MAX( INT( length_scale_lat  * ddy     ), 1 )
-       nvx(k) = MAX( INT( length_scale_lon  * ddx     ), 1 )
-       nvy(k) = MAX( INT( length_scale_lat  * ddy     ), 1 )
-       nwx(k) = MAX( INT( length_scale_lon  * ddx     ), 1 )
-       nwy(k) = MAX( INT( length_scale_lat  * ddy     ), 1 )
-       nuz(k) = MAX( INT( length_scale_vert * ddzw(k) ), 1 )
-       nvz(k) = MAX( INT( length_scale_vert * ddzw(k) ), 1 )
-       nwz(k) = MAX( INT( length_scale_vert * ddzw(k) ), 1 )
-
-    ENDDO
-!
-!-- Above boundary-layer top length- and timescales as well as reynolds-stress components are
-!-- reduced to zero by a blending function.
-    length_scale_lon_zi  = SQRT( r11(k_zi) ) * tu(k_zi)
-    length_scale_lat_zi  = SQRT( r22(k_zi) ) * tv(k_zi)
-    length_scale_vert_zi = SQRT( r33(k_zi) ) * tu(k_zi)
-
-    time_scale_zi        = tu(k_zi)
-    r11_zi               = r11(k_zi)
-    r22_zi               = r22(k_zi)
-    r33_zi               = r33(k_zi)
-    r31_zi               = r31(k_zi)
-    r32_zi               = r32(k_zi)
-
-    d_l = blend_coeff / MAX( length_scale_vert_zi, dx, dy, MINVAL( dzw ) )
-
-    DO  k = k_zi+1, nzt+1
-!
-!--    Calculate function to gradually decrease Reynolds stress above ABL top.
-       blend = MIN( 1.0_wp, EXP( d_l * zu(k) - d_l * zi_ribulk ) )
-!
-!--    u'u' and v'v'. Assume isotropy. Note, add a small negative number to the denominator, else
-!--    the mergpe-function can crash if scale_l is zero.
-       r11(k) = r11_zi * blend
-       r22(k) = r22_zi * blend
-       r33(k) = r33_zi * blend
-       r31(k) = r31_zi * blend
-       r32(k) = r32_zi * blend
-       r21(k) = 0.5_wp * ( r31(k) + r32(k) )
-
-!
-!--    Compute turbulent time scales according to Brost et al. (1982).
-!--    Note, time scales are limited to the adjustment time scales.
-       tu(k)  = time_scale_zi * blend
-       tv(k)  = time_scale_zi * blend
-       tw(k)  = time_scale_zi * blend
-
-       length_scale_lon  = length_scale_lon_zi  * blend
-       length_scale_lat  = length_scale_lat_zi  * blend
-       length_scale_vert = length_scale_vert_zi * blend
-!
-!--    Assume isotropic turbulence length scales
-       nux(k) = MAX( INT( length_scale_lon  * ddx ),     1 )
-       nuy(k) = MAX( INT( length_scale_lat  * ddy ),     1 )
-       nvx(k) = MAX( INT( length_scale_lon  * ddx ),     1 )
-       nvy(k) = MAX( INT( length_scale_lat  * ddy ),     1 )
-       nwx(k) = MAX( INT( length_scale_lon  * ddx ),     1 )
-       nwy(k) = MAX( INT( length_scale_lat  * ddy ),     1 )
-       nuz(k) = MAX( INT( length_scale_vert * ddzw(k) ), 1 )
-       nvz(k) = MAX( INT( length_scale_vert * ddzw(k) ), 1 )
-       nwz(k) = MAX( INT( length_scale_vert * ddzw(k) ), 1 )
-    ENDDO
-!
-!-- Set bottom boundary condition for reynolds stresses
-    r11(nzb) = r11(nzb+1)
-    r22(nzb) = r22(nzb+1)
-    r33(nzb) = r33(nzb+1)
-
-    r21(nzb) = r11(nzb+1)
-    r31(nzb) = r31(nzb+1)
-    r32(nzb) = r32(nzb+1)
-
-!
-!-- Set bottom boundary condition for the length and time scales
-    nux(nzb) = nux(nzb+1)
-    nuy(nzb) = nuy(nzb+1)
-    nuz(nzb) = nuz(nzb+1)
-    nvx(nzb) = nvx(nzb+1)
-    nvy(nzb) = nvy(nzb+1)
-    nvz(nzb) = nvz(nzb+1)
-    nwx(nzb) = nwx(nzb+1)
-    nwy(nzb) = nwy(nzb+1)
-    nwz(nzb) = nwz(nzb+1)
-
-    tu(nzb)  = tu(nzb+1)
-    tv(nzb)  = tv(nzb+1)
-    tw(nzb)  = tw(nzb+1)
-
-    adjustment_step = .TRUE.
-
- END SUBROUTINE parametrize_turbulence
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the coefficient matrix from the Lund rotation.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_coeff_matrix
-
-    INTEGER(iwp) ::  k  !< loop index in z-direction
-
-!
-!-- Calculate coefficient matrix. Split loops to allow for loop vectorization.
-    DO  k = nzb+1, nzt+1
-       IF ( r11(k) > 10E-6_wp )  THEN
-          a11(k) = SQRT( r11(k) )
-          a21(k) = r21(k) / a11(k)
-          a31(k) = r31(k) / a11(k)
-       ELSE
-          a11(k) = 10E-8_wp
-          a21(k) = 10E-8_wp
-          a31(k) = 10E-8_wp
-       ENDIF
-    ENDDO
-    DO  k = nzb+1, nzt+1
-       a22(k) = r22(k) - a21(k)**2
-       IF ( a22(k) > 10E-6_wp )  THEN
-          a22(k) = SQRT( a22(k) )
-          a32(k) = ( r32(k) - a21(k) * a31(k) ) / a22(k)
-       ELSE
-          a22(k) = 10E-8_wp
-          a32(k) = 10E-8_wp
-       ENDIF
-    ENDDO
-    DO  k = nzb+1, nzt+1
-       a33(k) = r33(k) - a31(k)**2 - a32(k)**2
-       IF ( a33(k) > 10E-6_wp )  THEN
-          a33(k) =  SQRT( a33(k) )
-       ELSE
-          a33(k) = 10E-8_wp
-       ENDIF
-    ENDDO
-!
-!-- Set bottom boundary condition
-    a11(nzb) = a11(nzb+1)
-    a22(nzb) = a22(nzb+1)
-    a21(nzb) = a21(nzb+1)
-    a33(nzb) = a33(nzb+1)
-    a31(nzb) = a31(nzb+1)
-    a32(nzb) = a32(nzb+1)
-
- END SUBROUTINE calc_coeff_matrix
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine controls the re-adjustment of the turbulence statistics used for generating
-!> turbulence at the lateral boundaries.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE stg_adjust
-
-    IF ( debug_output_timestep )  CALL debug_message( 'stg_adjust', 'start' )
-!
-!-- In case of dirichlet inflow boundary conditions only at one lateral boundary, i.e. in the case
-!-- no offline or self nesting is applied but synthetic turbulence shall be parametrized
-!-- nevertheless, the boundary-layer depth need to determined first.
-    IF ( .NOT. nesting_offline  .AND.  .NOT.  child_domain )                                       &
-       CALL nesting_offl_calc_zi
-!
-!-- Compute scaling parameters (domain-averaged), such as friction velocity are calculated.
-    CALL calc_scaling_variables
-!
-!-- Parametrize Reynolds-stress tensor. Parametrization follows Brost et al. (1982) with
-!-- modifications described in Rotach et al. (1996) and is based on boundary-layer depth, friction
-!-- velocity and velocity scale.
-    CALL parametrize_turbulence
-!
-!-- Calculate coefficient matrix from Reynolds stress tensor
-!-- (Lund rotation)
-    CALL calc_coeff_matrix
-!
-!-- Setup filter functions according to updated length scales.
-    CALL stg_setup_filter_function
-!
-!-- Reset time counter for controlling next adjustment to zero
-    time_stg_adjust = 0.0_wp
-
-    IF ( debug_output_timestep )  CALL debug_message( 'stg_adjust', 'end' )
-
- END SUBROUTINE stg_adjust
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate scaling variables which are used for turbulence parametrization according to Rotach
-!> et al. (1996). Scaling variables are: friction velocity, boundary-layer depth, momentum velocity
-!> scale, and Obukhov length.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_scaling_variables
-
-    INTEGER(iwp) ::  i  !< loop index in x-direction
-    INTEGER(iwp) ::  j  !< loop index in y-direction
-    INTEGER(iwp) ::  k  !< loop index in z-direction
-    INTEGER(iwp) ::  m  !< surface element index
-
-    REAL(wp) ::  friction_vel_l  !< mean friction veloctiy on subdomain
-    REAL(wp) ::  pt_surf_mean    !< mean near surface temperature (at 1st grid point)
-    REAL(wp) ::  pt_surf_mean_l  !< mean near surface temperature (at 1st grid point) on subdomain
-    REAL(wp) ::  scale_l_l       !< mean Obukhov lenght on subdomain
-    REAL(wp) ::  shf_mean        !< mean surface sensible heat flux
-    REAL(wp) ::  shf_mean_l      !< mean surface sensible heat flux on subdomain
-    REAL(wp) ::  w_convective    !< convective velocity scale
-
-!
-!-- Calculate mean friction velocity, velocity scale, heat flux and near-surface temperature in the
-!-- model domain.
-    pt_surf_mean_l = 0.0_wp
-    shf_mean_l     = 0.0_wp
-    scale_l_l      = 0.0_wp
-    friction_vel_l = 0.0_wp
-    DO  m = 1, surf_def_h(0)%ns
-       i = surf_def_h(0)%i(m)
-       j = surf_def_h(0)%j(m)
-       k = surf_def_h(0)%k(m)
-       friction_vel_l = friction_vel_l  + surf_def_h(0)%us(m)
-       shf_mean_l     = shf_mean_l      + surf_def_h(0)%shf(m) * drho_air(k)
-       scale_l_l      = scale_l_l       + surf_def_h(0)%ol(m)
-       pt_surf_mean_l = pt_surf_mean_l  + pt(k,j,i)
-    ENDDO
-    DO  m = 1, surf_lsm_h(0)%ns
-       i = surf_lsm_h(0)%i(m)
-       j = surf_lsm_h(0)%j(m)
-       k = surf_lsm_h(0)%k(m)
-       friction_vel_l = friction_vel_l  + surf_lsm_h(0)%us(m)
-       shf_mean_l     = shf_mean_l      + surf_lsm_h(0)%shf(m) * drho_air(k)
-       scale_l_l      = scale_l_l       + surf_lsm_h(0)%ol(m)
-       pt_surf_mean_l = pt_surf_mean_l  + pt(k,j,i)
-    ENDDO
-    DO  m = 1, surf_usm_h(0)%ns
-       i = surf_usm_h(0)%i(m)
-       j = surf_usm_h(0)%j(m)
-       k = surf_usm_h(0)%k(m)
-       friction_vel_l = friction_vel_l  + surf_usm_h(0)%us(m)
-       shf_mean_l     = shf_mean_l      + surf_usm_h(0)%shf(m) * drho_air(k)
-       scale_l_l      = scale_l_l       + surf_usm_h(0)%ol(m)
-       pt_surf_mean_l = pt_surf_mean_l  + pt(k,j,i)
-    ENDDO
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( friction_vel_l, scale_us,     1, MPI_REAL, MPI_SUM, comm2d, ierr )
-    CALL MPI_ALLREDUCE( shf_mean_l, shf_mean,         1, MPI_REAL, MPI_SUM, comm2d, ierr )
-    CALL MPI_ALLREDUCE( scale_l_l, scale_l,           1, MPI_REAL, MPI_SUM, comm2d, ierr )
-    CALL MPI_ALLREDUCE( pt_surf_mean_l, pt_surf_mean, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    scale_us     = friction_vel_l
-    shf_mean     = shf_mean_l
-    scale_l      = scale_l_l
-    pt_surf_mean = pt_surf_mean_l
-#endif
-
-    scale_us     = scale_us     * d_nxy
-    shf_mean     = shf_mean     * d_nxy
-    scale_l      = scale_l      * d_nxy
-    pt_surf_mean = pt_surf_mean * d_nxy
-!
-!-- Compute mean convective velocity scale. Note, in case the mean heat flux is negative, set
-!-- convective velocity scale to zero.
-    IF ( shf_mean > 0.0_wp )  THEN
-       w_convective = ( g * shf_mean * zi_ribulk / pt_surf_mean )**( 1.0_wp / 3.0_wp )
-    ELSE
-       w_convective = 0.0_wp
-    ENDIF
-!
-!-- At the initial run the friction velocity is initialized close to zero, leading to almost zero
-!-- disturbances at the boundaries. In order to obtain disturbances nevertheless, set a minium
-!-- value of friction velocity for the reynolds-stress parametrization.
-    IF ( time_since_reference_point <= 0.0_wp )  scale_us = MAX( scale_us, 0.05_wp )
-!
-!-- Finally, in order to consider also neutral or stable stratification, compute momentum velocity
-!-- scale from u* and convective velocity scale, according to Rotach et al. (1996).
-    scale_wm = ( scale_us**3 + 0.6_wp * w_convective**3 )**( 1.0_wp / 3.0_wp )
-
- END SUBROUTINE calc_scaling_variables
-
- END MODULE synthetic_turbulence_generator_mod
Index: palm/trunk/SOURCE/temperton_fft.f90
===================================================================
--- palm/trunk/SOURCE/temperton_fft.f90	(revision 1)
+++ palm/trunk/SOURCE/temperton_fft.f90	(revision 1)
@@ -0,0 +1,1967 @@
+ MODULE temperton_fft
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: temperton_fft.f90,v $
+! Revision 1.2  2003/04/16 12:49:25  raasch
+! Abort in case of illegal factors
+!
+! Revision 1.1  2003/03/12 16:41:59  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Fast Fourier transformation developed by Clive Temperton, ECMWF.
+!------------------------------------------------------------------------------!
+
+    IMPLICIT NONE
+
+    PRIVATE
+
+    PUBLIC set99, fft991cy
+
+
+    INTEGER           ::  nfax(10)   !  array used by *fft991*.
+    REAL, ALLOCATABLE ::  trig(:)    !  array used by *fft991*.
+
+!
+!-- nfft: maximum length of calls to *fft.
+#if defined( __nec )
+    INTEGER, PARAMETER ::  nfft = 256
+#else
+    INTEGER, PARAMETER ::  nfft =  32
+#endif
+
+    INTEGER, PARAMETER ::  nout =   6  ! standard output stream
+
+CONTAINS
+
+  SUBROUTINE fft991cy(a,work,trigs,ifax,inc,jump,n,lot,isign)
+
+    ! Description:
+    !
+    ! Calls fortran-versions of fft's.
+    !
+    ! Method:
+    !
+    ! Subroutine 'fft991cy' - multiple fast real periodic transform
+    ! supersedes previous routine 'fft991cy'.
+    !
+    ! Real transform of length n performed by removing redundant
+    ! operations from complex transform of length n.
+    !
+    ! a       is the array containing input & output data.
+    ! work    is an area of size (n+1)*min(lot,nfft).
+    ! trigs   is a previously prepared list of trig function values.
+    ! ifax    is a previously prepared list of factors of n.
+    ! inc     is the increment within each data 'vector'
+    !         (e.g. inc=1 for consecutively stored data).
+    ! jump    is the increment between the start of each data vector.
+    ! n       is the length of the data vectors.
+    ! lot     is the number of data vectors.
+    ! isign = +1 for transform from spectral to gridpoint
+    !       = -1 for transform from gridpoint to spectral.
+    !
+    ! ordering of coefficients:
+    ! a(0),b(0),a(1),b(1),a(2),b(2),.,a(n/2),b(n/2)
+    ! where b(0)=b(n/2)=0; (n+2) locations required.
+    !
+    ! ordering of data:
+    ! x(0),x(1),x(2),.,x(n-1), 0 , 0 ; (n+2) locations required.
+    !
+    ! Vectorization is achieved on cray by doing the transforms
+    ! in parallel.
+    !
+    ! n must be composed of factors 2,3 & 5 but does not have to be even.
+    !
+    ! definition of transforms:
+    !
+    ! isign=+1: x(j)=sum(k=0,.,n-1)(c(k)*exp(2*i*j*k*pi/n))
+    ! where c(k)=a(k)+i*b(k) and c(n-k)=a(k)-i*b(k)
+
+    ! isign=-1: a(k)=(1/n)*sum(j=0,.,n-1)(x(j)*cos(2*j*k*pi/n))
+    ! b(k)=-(1/n)*sum(j=0,.,n-1)(x(j)*sin(2*j*k*pi/n))
+
+    ! calls fortran-versions of fft's  !!!
+    ! dimension a(n),work(n),trigs(n),ifax(1)
+
+
+    IMPLICIT NONE
+
+    !  Scalar arguments 
+    INTEGER :: inc, isign, jump, lot, n
+
+    !  Array arguments 
+    REAL :: a(*), trigs(*), work(*)
+    INTEGER :: ifax(*)
+
+    !  Local scalars: 
+    INTEGER :: i, ia, ibase, ierr, ifac, igo, ii, istart, ix, iz, j, jbase, jj, &
+         &      k, la, nb, nblox, nfax, nvex, nx
+
+    !  Intrinsic functions 
+    INTRINSIC MOD
+
+
+    !  Executable statements 
+
+    IF (ifax(10)/=n) CALL set99(trigs,ifax,n)
+    nfax = ifax(1)
+    nx = n + 1
+    IF (MOD(n,2)==1) nx = n
+    nblox = 1 + (lot-1)/nfft
+    nvex = lot - (nblox-1)*nfft
+    IF (isign==-1) GO TO 50
+
+    ! isign=+1, spectral to gridpoint transform
+
+    istart = 1
+    DO nb = 1, nblox
+       ia = istart
+       i = istart
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO j = 1, nvex
+          a(i+inc) = 0.5*a(i)
+          i = i + jump
+       END DO
+       IF (MOD(n,2)==1) GO TO 10
+       i = istart + n*inc
+       DO j = 1, nvex
+          a(i) = 0.5*a(i)
+          i = i + jump
+       END DO
+10     CONTINUE
+       ia = istart + inc
+       la = 1
+       igo = + 1
+
+       DO k = 1, nfax
+          ifac = ifax(k+1)
+          ierr = -1
+          IF (igo==-1) GO TO 20
+          CALL rpassm(a(ia),a(ia+la*inc),work(1),work(ifac*la+1),trigs,inc,1, &
+               &          jump,nx,nvex,n,ifac,la,ierr)
+          GO TO 30
+20        CONTINUE
+          CALL rpassm(work(1),work(la+1),a(ia),a(ia+ifac*la*inc),trigs,1,inc,nx, &
+               &          jump,nvex,n,ifac,la,ierr)
+30        CONTINUE
+          IF (ierr/=0) GO TO 100
+          la = ifac*la
+          igo = -igo
+          ia = istart
+       END DO
+
+       ! If necessary, copy results back to a
+
+       IF (MOD(nfax,2)==0) GO TO 40
+       ibase = 1
+       jbase = ia
+       DO jj = 1, nvex
+          i = ibase
+          j = jbase
+          DO ii = 1, n
+             a(j) = work(i)
+             i = i + 1
+             j = j + inc
+          END DO
+          ibase = ibase + nx
+          jbase = jbase + jump
+       END DO
+40     CONTINUE
+
+       ! Fill in zeros at end
+
+       ix = istart + n*inc
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO j = 1, nvex
+          a(ix) = 0.0
+          a(ix+inc) = 0.0
+          ix = ix + jump
+       END DO
+
+       istart = istart + nvex*jump
+       nvex = nfft
+    END DO
+    RETURN
+
+    ! isign=-1, gridpoint to spectral transform
+
+50  CONTINUE
+    istart = 1
+    DO nb = 1, nblox
+       ia = istart
+       la = n
+       igo = + 1
+
+       DO k = 1, nfax
+          ifac = ifax(nfax+2-k)
+          la = la/ifac
+          ierr = -1
+          IF (igo==-1) GO TO 60
+          CALL qpassm(a(ia),a(ia+ifac*la*inc),work(1),work(la+1),trigs,inc,1, &
+               &          jump,nx,nvex,n,ifac,la,ierr)
+          GO TO 70
+60        CONTINUE
+          CALL qpassm(work(1),work(ifac*la+1),a(ia),a(ia+la*inc),trigs,1,inc,nx, &
+               &          jump,nvex,n,ifac,la,ierr)
+70        CONTINUE
+          IF (ierr/=0) GO TO 100
+          igo = -igo
+          ia = istart + inc
+       END DO
+
+       ! If necessary, copy results back to a
+
+       IF (MOD(nfax,2)==0) GO TO 80
+       ibase = 1
+       jbase = ia
+       DO jj = 1, nvex
+          i = ibase
+          j = jbase
+          DO ii = 1, n
+             a(j) = work(i)
+             i = i + 1
+             j = j + inc
+          END DO
+          ibase = ibase + nx
+          jbase = jbase + jump
+       END DO
+80     CONTINUE
+
+       ! Shift a(0) & fill in zero imag parts
+
+       ix = istart
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO j = 1, nvex
+          a(ix) = a(ix+inc)
+          a(ix+inc) = 0.0
+          ix = ix + jump
+       END DO
+       IF (MOD(n,2)==1) GO TO 90
+       iz = istart + (n+1)*inc
+       DO j = 1, nvex
+          a(iz) = 0.0
+          iz = iz + jump
+       END DO
+90     CONTINUE
+
+       istart = istart + nvex*jump
+       nvex = nfft
+    END DO
+    RETURN
+
+    ! Error messages
+
+100 CONTINUE
+
+    SELECT CASE (ierr)
+    CASE (:-1)
+       WRITE (nout,'(A,I5,A)') ' Vector length =',nvex,', greater than nfft'
+    CASE (0)
+       WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', not catered for'
+    CASE (1:)
+       WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', only catered for if la*ifac=n'
+    END SELECT
+
+    RETURN
+  END SUBROUTINE fft991cy
+
+  SUBROUTINE qpassm(a,b,c,d,trigs,inc1,inc2,inc3,inc4,lot,n,ifac,la,ierr)
+
+    ! Description:
+    !
+    ! Performs one pass through data as part of 
+    ! multiple real fft (fourier analysis) routine.
+    !
+    ! Method:
+    !
+    ! a       is first real input vector
+    !         equivalence b(1) with a(ifac*la*inc1+1)
+    ! c       is first real output vector
+    !         equivalence d(1) with c(la*inc2+1)
+    ! trigs   is a precalculated list of sines & cosines
+    ! inc1    is the addressing increment for a
+    ! inc2    is the addressing increment for c
+    ! inc3    is the increment between input vectors a
+    ! inc4    is the increment between output vectors c
+    ! lot     is the number of vectors
+    ! n       is the length of the vectors
+    ! ifac    is the current factor of n
+    !         la = n/(product of factors used so far)
+    ! ierr    is an error indicator:
+    !         0 - pass completed without error
+    !         1 - lot greater than nfft
+    !         2 - ifac not catered for
+    !         3 - ifac only catered for if la=n/ifac
+    !
+
+    IMPLICIT NONE
+
+    !  Scalar arguments 
+    INTEGER :: ierr, ifac, inc1, inc2, inc3, inc4, la, lot, n
+
+    !  Array arguments 
+    ! REAL :: a(n),b(n),c(n),d(n),trigs(n)
+    REAL :: a(*), b(*), c(*), d(*), trigs(*)
+
+    !  Local scalars: 
+    REAL :: a0, a1, a10, a11, a2, a20, a21, a3, a4, a5, a6, b0, b1, b10, b11, &
+         &      b2, b20, b21, b3, b4, b5, b6, c1, c2, c3, c4, c5, qrt5, s1, s2, s3, s4, &
+         &      s5, sin36, sin45, sin60, sin72, z, zqrt5, zsin36, zsin45, zsin60, &
+         &      zsin72
+    INTEGER :: i, ia, ib, ibad, ibase, ic, id, ie, if, ig, igo, ih, iink, ijk, &
+         &      ijump, j, ja, jb, jbase, jc, jd, je, jf, jink, k, kb, kc, kd, ke, kf, &
+         &      kstop, l, m
+
+    !  Intrinsic functions 
+    INTRINSIC REAL, SQRT
+
+    !  Data statements 
+    DATA sin36/0.587785252292473/, sin72/0.951056516295154/, &
+         &      qrt5/0.559016994374947/, sin60/0.866025403784437/
+
+
+    !  Executable statements 
+
+    m = n/ifac
+    iink = la*inc1
+    jink = la*inc2
+    ijump = (ifac-1)*iink
+    kstop = (n-ifac)/(2*ifac)
+
+    ibad = 1
+    IF (lot>nfft) GO TO 180
+    ibase = 0
+    jbase = 0
+    igo = ifac - 1
+    IF (igo==7) igo = 6
+    ibad = 2
+    IF (igo<1 .OR. igo>6) GO TO 180
+    GO TO (10,40,70,100,130,160) igo
+
+    ! Coding for factor 2
+
+10  CONTINUE
+    ia = 1
+    ib = ia + iink
+    ja = 1
+    jb = ja + (2*m-la)*inc2
+
+    IF (la==m) GO TO 30
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i) + a(ib+i)
+          c(jb+j) = a(ia+i) - a(ib+i)
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    ja = ja + jink
+    jink = 2*jink
+    jb = jb - jink
+    ibase = ibase + ijump
+    ijump = 2*ijump + iink
+    IF (ja==jb) GO TO 20
+    DO k = la, kstop, la
+       kb = k + k
+       c1 = trigs(kb+1)
+       s1 = trigs(kb+2)
+       jbase = 0
+       DO l = 1, la
+          i = ibase
+          j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+          DO ijk = 1, lot
+             c(ja+j) = a(ia+i) + (c1*a(ib+i)+s1*b(ib+i))
+             c(jb+j) = a(ia+i) - (c1*a(ib+i)+s1*b(ib+i))
+             d(ja+j) = (c1*b(ib+i)-s1*a(ib+i)) + b(ia+i)
+             d(jb+j) = (c1*b(ib+i)-s1*a(ib+i)) - b(ia+i)
+             i = i + inc3
+             j = j + inc4
+          END DO
+          ibase = ibase + inc1
+          jbase = jbase + inc2
+       END DO
+       ibase = ibase + ijump
+       ja = ja + jink
+       jb = jb - jink
+    END DO
+    IF (ja>jb) GO TO 170
+20  CONTINUE
+    jbase = 0
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i)
+          d(ja+j) = -a(ib+i)
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    GO TO 170
+30  CONTINUE
+    z = 1.0/REAL(n)
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = z*(a(ia+i)+a(ib+i))
+          c(jb+j) = z*(a(ia+i)-a(ib+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    GO TO 170
+
+    ! Coding for factor 3
+
+40  CONTINUE
+    ia = 1
+    ib = ia + iink
+    ic = ib + iink
+    ja = 1
+    jb = ja + (2*m-la)*inc2
+    jc = jb
+
+    IF (la==m) GO TO 60
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i) + (a(ib+i)+a(ic+i))
+          c(jb+j) = a(ia+i) - 0.5*(a(ib+i)+a(ic+i))
+          d(jb+j) = sin60*(a(ic+i)-a(ib+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    ja = ja + jink
+    jink = 2*jink
+    jb = jb + jink
+    jc = jc - jink
+    ibase = ibase + ijump
+    ijump = 2*ijump + iink
+    IF (ja==jc) GO TO 50
+    DO k = la, kstop, la
+       kb = k + k
+       kc = kb + kb
+       c1 = trigs(kb+1)
+       s1 = trigs(kb+2)
+       c2 = trigs(kc+1)
+       s2 = trigs(kc+2)
+       jbase = 0
+       DO l = 1, la
+          i = ibase
+          j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+          DO ijk = 1, lot
+             a1 = (c1*a(ib+i)+s1*b(ib+i)) + (c2*a(ic+i)+s2*b(ic+i))
+             b1 = (c1*b(ib+i)-s1*a(ib+i)) + (c2*b(ic+i)-s2*a(ic+i))
+             a2 = a(ia+i) - 0.5*a1
+             b2 = b(ia+i) - 0.5*b1
+             a3 = sin60*((c1*a(ib+i)+s1*b(ib+i))-(c2*a(ic+i)+s2*b(ic+i)))
+             b3 = sin60*((c1*b(ib+i)-s1*a(ib+i))-(c2*b(ic+i)-s2*a(ic+i)))
+             c(ja+j) = a(ia+i) + a1
+             d(ja+j) = b(ia+i) + b1
+             c(jb+j) = a2 + b3
+             d(jb+j) = b2 - a3
+             c(jc+j) = a2 - b3
+             d(jc+j) = -(b2+a3)
+             i = i + inc3
+             j = j + inc4
+          END DO
+          ibase = ibase + inc1
+          jbase = jbase + inc2
+       END DO
+       ibase = ibase + ijump
+       ja = ja + jink
+       jb = jb + jink
+       jc = jc - jink
+    END DO
+    IF (ja>jc) GO TO 170
+50  CONTINUE
+    jbase = 0
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i) + 0.5*(a(ib+i)-a(ic+i))
+          d(ja+j) = -sin60*(a(ib+i)+a(ic+i))
+          c(jb+j) = a(ia+i) - (a(ib+i)-a(ic+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    GO TO 170
+60  CONTINUE
+    z = 1.0/REAL(n)
+    zsin60 = z*sin60
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = z*(a(ia+i)+(a(ib+i)+a(ic+i)))
+          c(jb+j) = z*(a(ia+i)-0.5*(a(ib+i)+a(ic+i)))
+          d(jb+j) = zsin60*(a(ic+i)-a(ib+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    GO TO 170
+
+    ! Coding for factor 4
+
+70  CONTINUE
+    ia = 1
+    ib = ia + iink
+    ic = ib + iink
+    id = ic + iink
+    ja = 1
+    jb = ja + (2*m-la)*inc2
+    jc = jb + 2*m*inc2
+    jd = jb
+
+    IF (la==m) GO TO 90
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = (a(ia+i)+a(ic+i)) + (a(ib+i)+a(id+i))
+          c(jc+j) = (a(ia+i)+a(ic+i)) - (a(ib+i)+a(id+i))
+          c(jb+j) = a(ia+i) - a(ic+i)
+          d(jb+j) = a(id+i) - a(ib+i)
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    ja = ja + jink
+    jink = 2*jink
+    jb = jb + jink
+    jc = jc - jink
+    jd = jd - jink
+    ibase = ibase + ijump
+    ijump = 2*ijump + iink
+    IF (jb==jc) GO TO 80
+    DO k = la, kstop, la
+       kb = k + k
+       kc = kb + kb
+       kd = kc + kb
+       c1 = trigs(kb+1)
+       s1 = trigs(kb+2)
+       c2 = trigs(kc+1)
+       s2 = trigs(kc+2)
+       c3 = trigs(kd+1)
+       s3 = trigs(kd+2)
+       jbase = 0
+       DO l = 1, la
+          i = ibase
+          j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+          DO ijk = 1, lot
+             a0 = a(ia+i) + (c2*a(ic+i)+s2*b(ic+i))
+             a2 = a(ia+i) - (c2*a(ic+i)+s2*b(ic+i))
+             a1 = (c1*a(ib+i)+s1*b(ib+i)) + (c3*a(id+i)+s3*b(id+i))
+             a3 = (c1*a(ib+i)+s1*b(ib+i)) - (c3*a(id+i)+s3*b(id+i))
+             b0 = b(ia+i) + (c2*b(ic+i)-s2*a(ic+i))
+             b2 = b(ia+i) - (c2*b(ic+i)-s2*a(ic+i))
+             b1 = (c1*b(ib+i)-s1*a(ib+i)) + (c3*b(id+i)-s3*a(id+i))
+             b3 = (c1*b(ib+i)-s1*a(ib+i)) - (c3*b(id+i)-s3*a(id+i))
+             c(ja+j) = a0 + a1
+             c(jc+j) = a0 - a1
+             d(ja+j) = b0 + b1
+             d(jc+j) = b1 - b0
+             c(jb+j) = a2 + b3
+             c(jd+j) = a2 - b3
+             d(jb+j) = b2 - a3
+             d(jd+j) = -(b2+a3)
+             i = i + inc3
+             j = j + inc4
+          END DO
+          ibase = ibase + inc1
+          jbase = jbase + inc2
+       END DO
+       ibase = ibase + ijump
+       ja = ja + jink
+       jb = jb + jink
+       jc = jc - jink
+       jd = jd - jink
+    END DO
+    IF (jb>jc) GO TO 170
+80  CONTINUE
+    sin45 = SQRT(0.5)
+    jbase = 0
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i) + sin45*(a(ib+i)-a(id+i))
+          c(jb+j) = a(ia+i) - sin45*(a(ib+i)-a(id+i))
+          d(ja+j) = -a(ic+i) - sin45*(a(ib+i)+a(id+i))
+          d(jb+j) = a(ic+i) - sin45*(a(ib+i)+a(id+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    GO TO 170
+90  CONTINUE
+    z = 1.0/REAL(n)
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = z*((a(ia+i)+a(ic+i))+(a(ib+i)+a(id+i)))
+          c(jc+j) = z*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i)))
+          c(jb+j) = z*(a(ia+i)-a(ic+i))
+          d(jb+j) = z*(a(id+i)-a(ib+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    GO TO 170
+
+    ! Coding for factor 5
+
+100 CONTINUE
+    ia = 1
+    ib = ia + iink
+    ic = ib + iink
+    id = ic + iink
+    ie = id + iink
+    ja = 1
+    jb = ja + (2*m-la)*inc2
+    jc = jb + 2*m*inc2
+    jd = jc
+    je = jb
+
+    IF (la==m) GO TO 120
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          a1 = a(ib+i) + a(ie+i)
+          a3 = a(ib+i) - a(ie+i)
+          a2 = a(ic+i) + a(id+i)
+          a4 = a(ic+i) - a(id+i)
+          a5 = a(ia+i) - 0.25*(a1+a2)
+          a6 = qrt5*(a1-a2)
+          c(ja+j) = a(ia+i) + (a1+a2)
+          c(jb+j) = a5 + a6
+          c(jc+j) = a5 - a6
+          d(jb+j) = -sin72*a3 - sin36*a4
+          d(jc+j) = -sin36*a3 + sin72*a4
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    ja = ja + jink
+    jink = 2*jink
+    jb = jb + jink
+    jc = jc + jink
+    jd = jd - jink
+    je = je - jink
+    ibase = ibase + ijump
+    ijump = 2*ijump + iink
+    IF (jb==jd) GO TO 110
+    DO k = la, kstop, la
+       kb = k + k
+       kc = kb + kb
+       kd = kc + kb
+       ke = kd + kb
+       c1 = trigs(kb+1)
+       s1 = trigs(kb+2)
+       c2 = trigs(kc+1)
+       s2 = trigs(kc+2)
+       c3 = trigs(kd+1)
+       s3 = trigs(kd+2)
+       c4 = trigs(ke+1)
+       s4 = trigs(ke+2)
+       jbase = 0
+       DO l = 1, la
+          i = ibase
+          j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+          DO ijk = 1, lot
+             a1 = (c1*a(ib+i)+s1*b(ib+i)) + (c4*a(ie+i)+s4*b(ie+i))
+             a3 = (c1*a(ib+i)+s1*b(ib+i)) - (c4*a(ie+i)+s4*b(ie+i))
+             a2 = (c2*a(ic+i)+s2*b(ic+i)) + (c3*a(id+i)+s3*b(id+i))
+             a4 = (c2*a(ic+i)+s2*b(ic+i)) - (c3*a(id+i)+s3*b(id+i))
+             b1 = (c1*b(ib+i)-s1*a(ib+i)) + (c4*b(ie+i)-s4*a(ie+i))
+             b3 = (c1*b(ib+i)-s1*a(ib+i)) - (c4*b(ie+i)-s4*a(ie+i))
+             b2 = (c2*b(ic+i)-s2*a(ic+i)) + (c3*b(id+i)-s3*a(id+i))
+             b4 = (c2*b(ic+i)-s2*a(ic+i)) - (c3*b(id+i)-s3*a(id+i))
+             a5 = a(ia+i) - 0.25*(a1+a2)
+             a6 = qrt5*(a1-a2)
+             b5 = b(ia+i) - 0.25*(b1+b2)
+             b6 = qrt5*(b1-b2)
+             a10 = a5 + a6
+             a20 = a5 - a6
+             b10 = b5 + b6
+             b20 = b5 - b6
+             a11 = sin72*b3 + sin36*b4
+             a21 = sin36*b3 - sin72*b4
+             b11 = sin72*a3 + sin36*a4
+             b21 = sin36*a3 - sin72*a4
+             c(ja+j) = a(ia+i) + (a1+a2)
+             c(jb+j) = a10 + a11
+             c(je+j) = a10 - a11
+             c(jc+j) = a20 + a21
+             c(jd+j) = a20 - a21
+             d(ja+j) = b(ia+i) + (b1+b2)
+             d(jb+j) = b10 - b11
+             d(je+j) = -(b10+b11)
+             d(jc+j) = b20 - b21
+             d(jd+j) = -(b20+b21)
+             i = i + inc3
+             j = j + inc4
+          END DO
+          ibase = ibase + inc1
+          jbase = jbase + inc2
+       END DO
+       ibase = ibase + ijump
+       ja = ja + jink
+       jb = jb + jink
+       jc = jc + jink
+       jd = jd - jink
+       je = je - jink
+    END DO
+    IF (jb>jd) GO TO 170
+110 CONTINUE
+    jbase = 0
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          a1 = a(ib+i) + a(ie+i)
+          a3 = a(ib+i) - a(ie+i)
+          a2 = a(ic+i) + a(id+i)
+          a4 = a(ic+i) - a(id+i)
+          a5 = a(ia+i) + 0.25*(a3-a4)
+          a6 = qrt5*(a3+a4)
+          c(ja+j) = a5 + a6
+          c(jb+j) = a5 - a6
+          c(jc+j) = a(ia+i) - (a3-a4)
+          d(ja+j) = -sin36*a1 - sin72*a2
+          d(jb+j) = -sin72*a1 + sin36*a2
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    GO TO 170
+120 CONTINUE
+    z = 1.0/REAL(n)
+    zqrt5 = z*qrt5
+    zsin36 = z*sin36
+    zsin72 = z*sin72
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          a1 = a(ib+i) + a(ie+i)
+          a3 = a(ib+i) - a(ie+i)
+          a2 = a(ic+i) + a(id+i)
+          a4 = a(ic+i) - a(id+i)
+          a5 = z*(a(ia+i)-0.25*(a1+a2))
+          a6 = zqrt5*(a1-a2)
+          c(ja+j) = z*(a(ia+i)+(a1+a2))
+          c(jb+j) = a5 + a6
+          c(jc+j) = a5 - a6
+          d(jb+j) = -zsin72*a3 - zsin36*a4
+          d(jc+j) = -zsin36*a3 + zsin72*a4
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    GO TO 170
+
+    ! Coding for factor 6
+
+130 CONTINUE
+    ia = 1
+    ib = ia + iink
+    ic = ib + iink
+    id = ic + iink
+    ie = id + iink
+    if = ie + iink
+    ja = 1
+    jb = ja + (2*m-la)*inc2
+    jc = jb + 2*m*inc2
+    jd = jc + 2*m*inc2
+    je = jc
+    jf = jb
+
+    IF (la==m) GO TO 150
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          a11 = (a(ic+i)+a(if+i)) + (a(ib+i)+a(ie+i))
+          c(ja+j) = (a(ia+i)+a(id+i)) + a11
+          c(jc+j) = (a(ia+i)+a(id+i)-0.5*a11)
+          d(jc+j) = sin60*((a(ic+i)+a(if+i))-(a(ib+i)+a(ie+i)))
+          a11 = (a(ic+i)-a(if+i)) + (a(ie+i)-a(ib+i))
+          c(jb+j) = (a(ia+i)-a(id+i)) - 0.5*a11
+          d(jb+j) = sin60*((a(ie+i)-a(ib+i))-(a(ic+i)-a(if+i)))
+          c(jd+j) = (a(ia+i)-a(id+i)) + a11
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    ja = ja + jink
+    jink = 2*jink
+    jb = jb + jink
+    jc = jc + jink
+    jd = jd - jink
+    je = je - jink
+    jf = jf - jink
+    ibase = ibase + ijump
+    ijump = 2*ijump + iink
+    IF (jc==jd) GO TO 140
+    DO k = la, kstop, la
+       kb = k + k
+       kc = kb + kb
+       kd = kc + kb
+       ke = kd + kb
+       kf = ke + kb
+       c1 = trigs(kb+1)
+       s1 = trigs(kb+2)
+       c2 = trigs(kc+1)
+       s2 = trigs(kc+2)
+       c3 = trigs(kd+1)
+       s3 = trigs(kd+2)
+       c4 = trigs(ke+1)
+       s4 = trigs(ke+2)
+       c5 = trigs(kf+1)
+       s5 = trigs(kf+2)
+       jbase = 0
+       DO l = 1, la
+          i = ibase
+          j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+          DO ijk = 1, lot
+             a1 = c1*a(ib+i) + s1*b(ib+i)
+             b1 = c1*b(ib+i) - s1*a(ib+i)
+             a2 = c2*a(ic+i) + s2*b(ic+i)
+             b2 = c2*b(ic+i) - s2*a(ic+i)
+             a3 = c3*a(id+i) + s3*b(id+i)
+             b3 = c3*b(id+i) - s3*a(id+i)
+             a4 = c4*a(ie+i) + s4*b(ie+i)
+             b4 = c4*b(ie+i) - s4*a(ie+i)
+             a5 = c5*a(if+i) + s5*b(if+i)
+             b5 = c5*b(if+i) - s5*a(if+i)
+             a11 = (a2+a5) + (a1+a4)
+             a20 = (a(ia+i)+a3) - 0.5*a11
+             a21 = sin60*((a2+a5)-(a1+a4))
+             b11 = (b2+b5) + (b1+b4)
+             b20 = (b(ia+i)+b3) - 0.5*b11
+             b21 = sin60*((b2+b5)-(b1+b4))
+             c(ja+j) = (a(ia+i)+a3) + a11
+             d(ja+j) = (b(ia+i)+b3) + b11
+             c(jc+j) = a20 - b21
+             d(jc+j) = a21 + b20
+             c(je+j) = a20 + b21
+             d(je+j) = a21 - b20
+             a11 = (a2-a5) + (a4-a1)
+             a20 = (a(ia+i)-a3) - 0.5*a11
+             a21 = sin60*((a4-a1)-(a2-a5))
+             b11 = (b5-b2) - (b4-b1)
+             b20 = (b3-b(ia+i)) - 0.5*b11
+             b21 = sin60*((b5-b2)+(b4-b1))
+             c(jb+j) = a20 - b21
+             d(jb+j) = a21 - b20
+             c(jd+j) = a11 + (a(ia+i)-a3)
+             d(jd+j) = b11 + (b3-b(ia+i))
+             c(jf+j) = a20 + b21
+             d(jf+j) = a21 + b20
+             i = i + inc3
+             j = j + inc4
+          END DO
+          ibase = ibase + inc1
+          jbase = jbase + inc2
+       END DO
+       ibase = ibase + ijump
+       ja = ja + jink
+       jb = jb + jink
+       jc = jc + jink
+       jd = jd - jink
+       je = je - jink
+       jf = jf - jink
+    END DO
+    IF (jc>jd) GO TO 170
+140 CONTINUE
+    jbase = 0
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = (a(ia+i)+0.5*(a(ic+i)-a(ie+i))) + sin60*(a(ib+i)-a(if+i))
+          d(ja+j) = -(a(id+i)+0.5*(a(ib+i)+a(if+i))) - sin60*(a(ic+i)+a(ie+i))
+          c(jb+j) = a(ia+i) - (a(ic+i)-a(ie+i))
+          d(jb+j) = a(id+i) - (a(ib+i)+a(if+i))
+          c(jc+j) = (a(ia+i)+0.5*(a(ic+i)-a(ie+i))) - sin60*(a(ib+i)-a(if+i))
+          d(jc+j) = -(a(id+i)+0.5*(a(ib+i)+a(if+i))) + sin60*(a(ic+i)+a(ie+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    GO TO 170
+150 CONTINUE
+    z = 1.0/REAL(n)
+    zsin60 = z*sin60
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          a11 = (a(ic+i)+a(if+i)) + (a(ib+i)+a(ie+i))
+          c(ja+j) = z*((a(ia+i)+a(id+i))+a11)
+          c(jc+j) = z*((a(ia+i)+a(id+i))-0.5*a11)
+          d(jc+j) = zsin60*((a(ic+i)+a(if+i))-(a(ib+i)+a(ie+i)))
+          a11 = (a(ic+i)-a(if+i)) + (a(ie+i)-a(ib+i))
+          c(jb+j) = z*((a(ia+i)-a(id+i))-0.5*a11)
+          d(jb+j) = zsin60*((a(ie+i)-a(ib+i))-(a(ic+i)-a(if+i)))
+          c(jd+j) = z*((a(ia+i)-a(id+i))+a11)
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    GO TO 170
+
+    ! Coding for factor 8
+
+160 CONTINUE
+    ibad = 3
+    IF (la/=m) GO TO 180
+    ia = 1
+    ib = ia + iink
+    ic = ib + iink
+    id = ic + iink
+    ie = id + iink
+    if = ie + iink
+    ig = if + iink
+    ih = ig + iink
+    ja = 1
+    jb = ja + la*inc2
+    jc = jb + 2*m*inc2
+    jd = jc + 2*m*inc2
+    je = jd + 2*m*inc2
+    z = 1.0/REAL(n)
+    zsin45 = z*SQRT(0.5)
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = z*(((a(ia+i)+a(ie+i))+(a(ic+i)+a(ig+i)))+((a(id+i)+ &
+               &          a(ih+i))+(a(ib+i)+a(if+i))))
+          c(je+j) = z*(((a(ia+i)+a(ie+i))+(a(ic+i)+a(ig+i)))-((a(id+i)+ &
+               &          a(ih+i))+(a(ib+i)+a(if+i))))
+          c(jc+j) = z*((a(ia+i)+a(ie+i))-(a(ic+i)+a(ig+i)))
+          d(jc+j) = z*((a(id+i)+a(ih+i))-(a(ib+i)+a(if+i)))
+          c(jb+j) = z*(a(ia+i)-a(ie+i)) + zsin45*((a(ih+i)-a(id+i))-(a(if+ &
+               &          i)-a(ib+i)))
+          c(jd+j) = z*(a(ia+i)-a(ie+i)) - zsin45*((a(ih+i)-a(id+i))-(a(if+ &
+               &          i)-a(ib+i)))
+          d(jb+j) = zsin45*((a(ih+i)-a(id+i))+(a(if+i)-a(ib+i))) + &
+               &          z*(a(ig+i)-a(ic+i))
+          d(jd+j) = zsin45*((a(ih+i)-a(id+i))+(a(if+i)-a(ib+i))) - &
+               &          z*(a(ig+i)-a(ic+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    ! Return
+
+170 CONTINUE
+    ibad = 0
+180 CONTINUE
+    ierr = ibad
+    RETURN
+  END SUBROUTINE qpassm
+
+  SUBROUTINE rpassm(a,b,c,d,trigs,inc1,inc2,inc3,inc4,lot,n,ifac,la,ierr)
+    ! Dimension a(n),b(n),c(n),d(n),trigs(n)
+
+    IMPLICIT NONE
+
+    !  Scalar arguments 
+    INTEGER :: ierr, ifac, inc1, inc2, inc3, inc4, la, lot, n
+
+    !  Array arguments 
+    REAL :: a(*), b(*), c(*), d(*), trigs(*)
+
+    !  Local scalars: 
+    REAL :: c1, c2, c3, c4, c5, qqrt5, qrt5, s1, s2, s3, s4, s5, sin36, sin45, &
+         &      sin60, sin72, ssin36, ssin45, ssin60, ssin72
+    INTEGER :: i, ia, ib, ibad, ibase, ic, id, ie, if, igo, iink, ijk, j, ja, &
+         &      jb, jbase, jc, jd, je, jf, jg, jh, jink, jump, k, kb, kc, kd, ke, kf, &
+         &      kstop, l, m
+
+    !  Local arrays: 
+    REAL :: a10(nfft), a11(nfft), a20(nfft), a21(nfft), b10(nfft), b11(nfft), b20(nfft), &
+         &      b21(nfft)
+
+    !  Intrinsic functions 
+    INTRINSIC SQRT
+
+    !  Data statements 
+    DATA sin36/0.587785252292473/, sin72/0.951056516295154/, &
+         &      qrt5/0.559016994374947/, sin60/0.866025403784437/
+
+
+    !  Executable statements 
+
+    m = n/ifac
+    iink = la*inc1
+    jink = la*inc2
+    jump = (ifac-1)*jink
+    kstop = (n-ifac)/(2*ifac)
+
+    ibad = 1
+    IF (lot>nfft) GO TO 180
+    ibase = 0
+    jbase = 0
+    igo = ifac - 1
+    IF (igo==7) igo = 6
+    ibad = 2
+    IF (igo<1 .OR. igo>6) GO TO 180
+    GO TO (10,40,70,100,130,160) igo
+
+    ! Coding for factor 2
+
+10  CONTINUE
+    ia = 1
+    ib = ia + (2*m-la)*inc1
+    ja = 1
+    jb = ja + jink
+
+    IF (la==m) GO TO 30
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i) + a(ib+i)
+          c(jb+j) = a(ia+i) - a(ib+i)
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    ia = ia + iink
+    iink = 2*iink
+    ib = ib - iink
+    ibase = 0
+    jbase = jbase + jump
+    jump = 2*jump + jink
+    IF (ia==ib) GO TO 20
+    DO k = la, kstop, la
+       kb = k + k
+       c1 = trigs(kb+1)
+       s1 = trigs(kb+2)
+       ibase = 0
+       DO l = 1, la
+          i = ibase
+          j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+          DO ijk = 1, lot
+             c(ja+j) = a(ia+i) + a(ib+i)
+             d(ja+j) = b(ia+i) - b(ib+i)
+             c(jb+j) = c1*(a(ia+i)-a(ib+i)) - s1*(b(ia+i)+b(ib+i))
+             d(jb+j) = s1*(a(ia+i)-a(ib+i)) + c1*(b(ia+i)+b(ib+i))
+             i = i + inc3
+             j = j + inc4
+          END DO
+          ibase = ibase + inc1
+          jbase = jbase + inc2
+       END DO
+       ia = ia + iink
+       ib = ib - iink
+       jbase = jbase + jump
+    END DO
+    IF (ia>ib) GO TO 170
+20  CONTINUE
+    ibase = 0
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i)
+          c(jb+j) = -b(ia+i)
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    GO TO 170
+30  CONTINUE
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = 2.0*(a(ia+i)+a(ib+i))
+          c(jb+j) = 2.0*(a(ia+i)-a(ib+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    GO TO 170
+
+    ! Coding for factor 3
+
+40  CONTINUE
+    ia = 1
+    ib = ia + (2*m-la)*inc1
+    ic = ib
+    ja = 1
+    jb = ja + jink
+    jc = jb + jink
+
+    IF (la==m) GO TO 60
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i) + a(ib+i)
+          c(jb+j) = (a(ia+i)-0.5*a(ib+i)) - (sin60*(b(ib+i)))
+          c(jc+j) = (a(ia+i)-0.5*a(ib+i)) + (sin60*(b(ib+i)))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    ia = ia + iink
+    iink = 2*iink
+    ib = ib + iink
+    ic = ic - iink
+    jbase = jbase + jump
+    jump = 2*jump + jink
+    IF (ia==ic) GO TO 50
+    DO k = la, kstop, la
+       kb = k + k
+       kc = kb + kb
+       c1 = trigs(kb+1)
+       s1 = trigs(kb+2)
+       c2 = trigs(kc+1)
+       s2 = trigs(kc+2)
+       ibase = 0
+       DO l = 1, la
+          i = ibase
+          j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+          DO ijk = 1, lot
+             c(ja+j) = a(ia+i) + (a(ib+i)+a(ic+i))
+             d(ja+j) = b(ia+i) + (b(ib+i)-b(ic+i))
+             c(jb+j) = c1*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)+ &
+                  &            b(ic+i)))) - s1*((b(ia+i)-0.5*(b(ib+i)-b(ic+i)))+(sin60*(a(ib+i)- &
+                  &            a(ic+i))))
+             d(jb+j) = s1*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)+ &
+                  &            b(ic+i)))) + c1*((b(ia+i)-0.5*(b(ib+i)-b(ic+i)))+(sin60*(a(ib+i)- &
+                  &            a(ic+i))))
+             c(jc+j) = c2*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)+ &
+                  &            b(ic+i)))) - s2*((b(ia+i)-0.5*(b(ib+i)-b(ic+i)))-(sin60*(a(ib+i)- &
+                  &            a(ic+i))))
+             d(jc+j) = s2*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)+ &
+                  &            b(ic+i)))) + c2*((b(ia+i)-0.5*(b(ib+i)-b(ic+i)))-(sin60*(a(ib+i)- &
+                  &            a(ic+i))))
+             i = i + inc3
+             j = j + inc4
+          END DO
+          ibase = ibase + inc1
+          jbase = jbase + inc2
+       END DO
+       ia = ia + iink
+       ib = ib + iink
+       ic = ic - iink
+       jbase = jbase + jump
+    END DO
+    IF (ia>ic) GO TO 170
+50  CONTINUE
+    ibase = 0
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i) + a(ib+i)
+          c(jb+j) = (0.5*a(ia+i)-a(ib+i)) - (sin60*b(ia+i))
+          c(jc+j) = -(0.5*a(ia+i)-a(ib+i)) - (sin60*b(ia+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    GO TO 170
+60  CONTINUE
+    ssin60 = 2.0*sin60
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = 2.0*(a(ia+i)+a(ib+i))
+          c(jb+j) = (2.0*a(ia+i)-a(ib+i)) - (ssin60*b(ib+i))
+          c(jc+j) = (2.0*a(ia+i)-a(ib+i)) + (ssin60*b(ib+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    GO TO 170
+
+    ! Coding for factor 4
+
+70  CONTINUE
+    ia = 1
+    ib = ia + (2*m-la)*inc1
+    ic = ib + 2*m*inc1
+    id = ib
+    ja = 1
+    jb = ja + jink
+    jc = jb + jink
+    jd = jc + jink
+
+    IF (la==m) GO TO 90
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = (a(ia+i)+a(ic+i)) + a(ib+i)
+          c(jb+j) = (a(ia+i)-a(ic+i)) - b(ib+i)
+          c(jc+j) = (a(ia+i)+a(ic+i)) - a(ib+i)
+          c(jd+j) = (a(ia+i)-a(ic+i)) + b(ib+i)
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    ia = ia + iink
+    iink = 2*iink
+    ib = ib + iink
+    ic = ic - iink
+    id = id - iink
+    jbase = jbase + jump
+    jump = 2*jump + jink
+    IF (ib==ic) GO TO 80
+    DO k = la, kstop, la
+       kb = k + k
+       kc = kb + kb
+       kd = kc + kb
+       c1 = trigs(kb+1)
+       s1 = trigs(kb+2)
+       c2 = trigs(kc+1)
+       s2 = trigs(kc+2)
+       c3 = trigs(kd+1)
+       s3 = trigs(kd+2)
+       ibase = 0
+       DO l = 1, la
+          i = ibase
+          j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+          DO ijk = 1, lot
+             c(ja+j) = (a(ia+i)+a(ic+i)) + (a(ib+i)+a(id+i))
+             d(ja+j) = (b(ia+i)-b(ic+i)) + (b(ib+i)-b(id+i))
+             c(jc+j) = c2*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i))) - s2*((b(ia+ &
+                  &            i)-b(ic+i))-(b(ib+i)-b(id+i)))
+             d(jc+j) = s2*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i))) + c2*((b(ia+ &
+                  &            i)-b(ic+i))-(b(ib+i)-b(id+i)))
+             c(jb+j) = c1*((a(ia+i)-a(ic+i))-(b(ib+i)+b(id+i))) - s1*((b(ia+ &
+                  &            i)+b(ic+i))+(a(ib+i)-a(id+i)))
+             d(jb+j) = s1*((a(ia+i)-a(ic+i))-(b(ib+i)+b(id+i))) + c1*((b(ia+ &
+                  &            i)+b(ic+i))+(a(ib+i)-a(id+i)))
+             c(jd+j) = c3*((a(ia+i)-a(ic+i))+(b(ib+i)+b(id+i))) - s3*((b(ia+ &
+                  &            i)+b(ic+i))-(a(ib+i)-a(id+i)))
+             d(jd+j) = s3*((a(ia+i)-a(ic+i))+(b(ib+i)+b(id+i))) + c3*((b(ia+ &
+                  &            i)+b(ic+i))-(a(ib+i)-a(id+i)))
+             i = i + inc3
+             j = j + inc4
+          END DO
+          ibase = ibase + inc1
+          jbase = jbase + inc2
+       END DO
+       ia = ia + iink
+       ib = ib + iink
+       ic = ic - iink
+       id = id - iink
+       jbase = jbase + jump
+    END DO
+    IF (ib>ic) GO TO 170
+80  CONTINUE
+    ibase = 0
+    sin45 = SQRT(0.5)
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i) + a(ib+i)
+          c(jb+j) = sin45*((a(ia+i)-a(ib+i))-(b(ia+i)+b(ib+i)))
+          c(jc+j) = b(ib+i) - b(ia+i)
+          c(jd+j) = -sin45*((a(ia+i)-a(ib+i))+(b(ia+i)+b(ib+i)))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    GO TO 170
+90  CONTINUE
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = 2.0*((a(ia+i)+a(ic+i))+a(ib+i))
+          c(jb+j) = 2.0*((a(ia+i)-a(ic+i))-b(ib+i))
+          c(jc+j) = 2.0*((a(ia+i)+a(ic+i))-a(ib+i))
+          c(jd+j) = 2.0*((a(ia+i)-a(ic+i))+b(ib+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    ! Coding for factor 5
+
+    GO TO 170
+100 CONTINUE
+    ia = 1
+    ib = ia + (2*m-la)*inc1
+    ic = ib + 2*m*inc1
+    id = ic
+    ie = ib
+    ja = 1
+    jb = ja + jink
+    jc = jb + jink
+    jd = jc + jink
+    je = jd + jink
+
+    IF (la==m) GO TO 120
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ia+i) + (a(ib+i)+a(ic+i))
+          c(jb+j) = ((a(ia+i)-0.25*(a(ib+i)+a(ic+i)))+qrt5*(a(ib+i)-a(ic+i))) - &
+               &          (sin72*b(ib+i)+sin36*b(ic+i))
+          c(jc+j) = ((a(ia+i)-0.25*(a(ib+i)+a(ic+i)))-qrt5*(a(ib+i)-a(ic+i))) - &
+               &          (sin36*b(ib+i)-sin72*b(ic+i))
+          c(jd+j) = ((a(ia+i)-0.25*(a(ib+i)+a(ic+i)))-qrt5*(a(ib+i)-a(ic+i))) + &
+               &          (sin36*b(ib+i)-sin72*b(ic+i))
+          c(je+j) = ((a(ia+i)-0.25*(a(ib+i)+a(ic+i)))+qrt5*(a(ib+i)-a(ic+i))) + &
+               &          (sin72*b(ib+i)+sin36*b(ic+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    ia = ia + iink
+    iink = 2*iink
+    ib = ib + iink
+    ic = ic + iink
+    id = id - iink
+    ie = ie - iink
+    jbase = jbase + jump
+    jump = 2*jump + jink
+    IF (ib==id) GO TO 110
+    DO k = la, kstop, la
+       kb = k + k
+       kc = kb + kb
+       kd = kc + kb
+       ke = kd + kb
+       c1 = trigs(kb+1)
+       s1 = trigs(kb+2)
+       c2 = trigs(kc+1)
+       s2 = trigs(kc+2)
+       c3 = trigs(kd+1)
+       s3 = trigs(kd+2)
+       c4 = trigs(ke+1)
+       s4 = trigs(ke+2)
+       ibase = 0
+       DO l = 1, la
+          i = ibase
+          j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+          DO ijk = 1, lot
+
+             a10(ijk) = (a(ia+i)-0.25*((a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)))) + &
+                  &            qrt5*((a(ib+i)+a(ie+i))-(a(ic+i)+a(id+i)))
+             a20(ijk) = (a(ia+i)-0.25*((a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)))) - &
+                  &            qrt5*((a(ib+i)+a(ie+i))-(a(ic+i)+a(id+i)))
+             b10(ijk) = (b(ia+i)-0.25*((b(ib+i)-b(ie+i))+(b(ic+i)-b(id+i)))) + &
+                  &            qrt5*((b(ib+i)-b(ie+i))-(b(ic+i)-b(id+i)))
+             b20(ijk) = (b(ia+i)-0.25*((b(ib+i)-b(ie+i))+(b(ic+i)-b(id+i)))) - &
+                  &            qrt5*((b(ib+i)-b(ie+i))-(b(ic+i)-b(id+i)))
+             a11(ijk) = sin72*(b(ib+i)+b(ie+i)) + sin36*(b(ic+i)+b(id+i))
+             a21(ijk) = sin36*(b(ib+i)+b(ie+i)) - sin72*(b(ic+i)+b(id+i))
+             b11(ijk) = sin72*(a(ib+i)-a(ie+i)) + sin36*(a(ic+i)-a(id+i))
+             b21(ijk) = sin36*(a(ib+i)-a(ie+i)) - sin72*(a(ic+i)-a(id+i))
+
+             c(ja+j) = a(ia+i) + ((a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)))
+             d(ja+j) = b(ia+i) + ((b(ib+i)-b(ie+i))+(b(ic+i)-b(id+i)))
+             c(jb+j) = c1*(a10(ijk)-a11(ijk)) - s1*(b10(ijk)+b11(ijk))
+             d(jb+j) = s1*(a10(ijk)-a11(ijk)) + c1*(b10(ijk)+b11(ijk))
+             c(je+j) = c4*(a10(ijk)+a11(ijk)) - s4*(b10(ijk)-b11(ijk))
+             d(je+j) = s4*(a10(ijk)+a11(ijk)) + c4*(b10(ijk)-b11(ijk))
+             c(jc+j) = c2*(a20(ijk)-a21(ijk)) - s2*(b20(ijk)+b21(ijk))
+             d(jc+j) = s2*(a20(ijk)-a21(ijk)) + c2*(b20(ijk)+b21(ijk))
+             c(jd+j) = c3*(a20(ijk)+a21(ijk)) - s3*(b20(ijk)-b21(ijk))
+             d(jd+j) = s3*(a20(ijk)+a21(ijk)) + c3*(b20(ijk)-b21(ijk))
+
+             i = i + inc3
+             j = j + inc4
+          END DO
+          ibase = ibase + inc1
+          jbase = jbase + inc2
+       END DO
+       ia = ia + iink
+       ib = ib + iink
+       ic = ic + iink
+       id = id - iink
+       ie = ie - iink
+       jbase = jbase + jump
+    END DO
+    IF (ib>id) GO TO 170
+110 CONTINUE
+    ibase = 0
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = (a(ia+i)+a(ib+i)) + a(ic+i)
+          c(jb+j) = (qrt5*(a(ia+i)-a(ib+i))+(0.25*(a(ia+i)+a(ib+i))-a(ic+i))) - &
+               &          (sin36*b(ia+i)+sin72*b(ib+i))
+          c(je+j) = -(qrt5*(a(ia+i)-a(ib+i))+(0.25*(a(ia+i)+a(ib+i))-a(ic+i))) - &
+               &          (sin36*b(ia+i)+sin72*b(ib+i))
+          c(jc+j) = (qrt5*(a(ia+i)-a(ib+i))-(0.25*(a(ia+i)+a(ib+i))-a(ic+i))) - &
+               &          (sin72*b(ia+i)-sin36*b(ib+i))
+          c(jd+j) = -(qrt5*(a(ia+i)-a(ib+i))-(0.25*(a(ia+i)+a(ib+i))-a(ic+i))) - &
+               &          (sin72*b(ia+i)-sin36*b(ib+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    GO TO 170
+120 CONTINUE
+    qqrt5 = 2.0*qrt5
+    ssin36 = 2.0*sin36
+    ssin72 = 2.0*sin72
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = 2.0*(a(ia+i)+(a(ib+i)+a(ic+i)))
+          c(jb+j) = (2.0*(a(ia+i)-0.25*(a(ib+i)+a(ic+i)))+qqrt5*(a(ib+i)-a(ic+ &
+               &          i))) - (ssin72*b(ib+i)+ssin36*b(ic+i))
+          c(jc+j) = (2.0*(a(ia+i)-0.25*(a(ib+i)+a(ic+i)))-qqrt5*(a(ib+i)-a(ic+ &
+               &          i))) - (ssin36*b(ib+i)-ssin72*b(ic+i))
+          c(jd+j) = (2.0*(a(ia+i)-0.25*(a(ib+i)+a(ic+i)))-qqrt5*(a(ib+i)-a(ic+ &
+               &          i))) + (ssin36*b(ib+i)-ssin72*b(ic+i))
+          c(je+j) = (2.0*(a(ia+i)-0.25*(a(ib+i)+a(ic+i)))+qqrt5*(a(ib+i)-a(ic+ &
+               &          i))) + (ssin72*b(ib+i)+ssin36*b(ic+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    GO TO 170
+
+    ! Coding for factor 6
+
+130 CONTINUE
+    ia = 1
+    ib = ia + (2*m-la)*inc1
+    ic = ib + 2*m*inc1
+    id = ic + 2*m*inc1
+    ie = ic
+    if = ib
+    ja = 1
+    jb = ja + jink
+    jc = jb + jink
+    jd = jc + jink
+    je = jd + jink
+    jf = je + jink
+
+    IF (la==m) GO TO 150
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = (a(ia+i)+a(id+i)) + (a(ib+i)+a(ic+i))
+          c(jd+j) = (a(ia+i)-a(id+i)) - (a(ib+i)-a(ic+i))
+          c(jb+j) = ((a(ia+i)-a(id+i))+0.5*(a(ib+i)-a(ic+i))) - (sin60*(b(ib+ &
+               &          i)+b(ic+i)))
+          c(jf+j) = ((a(ia+i)-a(id+i))+0.5*(a(ib+i)-a(ic+i))) + (sin60*(b(ib+ &
+               &          i)+b(ic+i)))
+          c(jc+j) = ((a(ia+i)+a(id+i))-0.5*(a(ib+i)+a(ic+i))) - (sin60*(b(ib+ &
+               &          i)-b(ic+i)))
+          c(je+j) = ((a(ia+i)+a(id+i))-0.5*(a(ib+i)+a(ic+i))) + (sin60*(b(ib+ &
+               &          i)-b(ic+i)))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    ia = ia + iink
+    iink = 2*iink
+    ib = ib + iink
+    ic = ic + iink
+    id = id - iink
+    ie = ie - iink
+    if = if - iink
+    jbase = jbase + jump
+    jump = 2*jump + jink
+    IF (ic==id) GO TO 140
+    DO k = la, kstop, la
+       kb = k + k
+       kc = kb + kb
+       kd = kc + kb
+       ke = kd + kb
+       kf = ke + kb
+       c1 = trigs(kb+1)
+       s1 = trigs(kb+2)
+       c2 = trigs(kc+1)
+       s2 = trigs(kc+2)
+       c3 = trigs(kd+1)
+       s3 = trigs(kd+2)
+       c4 = trigs(ke+1)
+       s4 = trigs(ke+2)
+       c5 = trigs(kf+1)
+       s5 = trigs(kf+2)
+       ibase = 0
+       DO l = 1, la
+          i = ibase
+          j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+          DO ijk = 1, lot
+
+             a11(ijk) = (a(ie+i)+a(ib+i)) + (a(ic+i)+a(if+i))
+             a20(ijk) = (a(ia+i)+a(id+i)) - 0.5*a11(ijk)
+             a21(ijk) = sin60*((a(ie+i)+a(ib+i))-(a(ic+i)+a(if+i)))
+             b11(ijk) = (b(ib+i)-b(ie+i)) + (b(ic+i)-b(if+i))
+             b20(ijk) = (b(ia+i)-b(id+i)) - 0.5*b11(ijk)
+             b21(ijk) = sin60*((b(ib+i)-b(ie+i))-(b(ic+i)-b(if+i)))
+
+             c(ja+j) = (a(ia+i)+a(id+i)) + a11(ijk)
+             d(ja+j) = (b(ia+i)-b(id+i)) + b11(ijk)
+             c(jc+j) = c2*(a20(ijk)-b21(ijk)) - s2*(b20(ijk)+a21(ijk))
+             d(jc+j) = s2*(a20(ijk)-b21(ijk)) + c2*(b20(ijk)+a21(ijk))
+             c(je+j) = c4*(a20(ijk)+b21(ijk)) - s4*(b20(ijk)-a21(ijk))
+             d(je+j) = s4*(a20(ijk)+b21(ijk)) + c4*(b20(ijk)-a21(ijk))
+
+             a11(ijk) = (a(ie+i)-a(ib+i)) + (a(ic+i)-a(if+i))
+             b11(ijk) = (b(ie+i)+b(ib+i)) - (b(ic+i)+b(if+i))
+             a20(ijk) = (a(ia+i)-a(id+i)) - 0.5*a11(ijk)
+             a21(ijk) = sin60*((a(ie+i)-a(ib+i))-(a(ic+i)-a(if+i)))
+             b20(ijk) = (b(ia+i)+b(id+i)) + 0.5*b11(ijk)
+             b21(ijk) = sin60*((b(ie+i)+b(ib+i))+(b(ic+i)+b(if+i)))
+
+             c(jd+j) = c3*((a(ia+i)-a(id+i))+a11(ijk)) - s3*((b(ia+i)+b(id+ &
+                  &            i))-b11(ijk))
+             d(jd+j) = s3*((a(ia+i)-a(id+i))+a11(ijk)) + c3*((b(ia+i)+b(id+ &
+                  &            i))-b11(ijk))
+             c(jb+j) = c1*(a20(ijk)-b21(ijk)) - s1*(b20(ijk)-a21(ijk))
+             d(jb+j) = s1*(a20(ijk)-b21(ijk)) + c1*(b20(ijk)-a21(ijk))
+             c(jf+j) = c5*(a20(ijk)+b21(ijk)) - s5*(b20(ijk)+a21(ijk))
+             d(jf+j) = s5*(a20(ijk)+b21(ijk)) + c5*(b20(ijk)+a21(ijk))
+
+             i = i + inc3
+             j = j + inc4
+          END DO
+          ibase = ibase + inc1
+          jbase = jbase + inc2
+       END DO
+       ia = ia + iink
+       ib = ib + iink
+       ic = ic + iink
+       id = id - iink
+       ie = ie - iink
+       if = if - iink
+       jbase = jbase + jump
+    END DO
+    IF (ic>id) GO TO 170
+140 CONTINUE
+    ibase = 0
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = a(ib+i) + (a(ia+i)+a(ic+i))
+          c(jd+j) = b(ib+i) - (b(ia+i)+b(ic+i))
+          c(jb+j) = (sin60*(a(ia+i)-a(ic+i))) - (0.5*(b(ia+i)+b(ic+i))+b(ib+i))
+          c(jf+j) = -(sin60*(a(ia+i)-a(ic+i))) - (0.5*(b(ia+i)+b(ic+i))+b(ib+i))
+          c(jc+j) = sin60*(b(ic+i)-b(ia+i)) + (0.5*(a(ia+i)+a(ic+i))-a(ib+i))
+          c(je+j) = sin60*(b(ic+i)-b(ia+i)) - (0.5*(a(ia+i)+a(ic+i))-a(ib+i))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    GO TO 170
+150 CONTINUE
+    ssin60 = 2.0*sin60
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = (2.0*(a(ia+i)+a(id+i))) + (2.0*(a(ib+i)+a(ic+i)))
+          c(jd+j) = (2.0*(a(ia+i)-a(id+i))) - (2.0*(a(ib+i)-a(ic+i)))
+          c(jb+j) = (2.0*(a(ia+i)-a(id+i))+(a(ib+i)-a(ic+i))) - (ssin60*(b(ib+ &
+               &          i)+b(ic+i)))
+          c(jf+j) = (2.0*(a(ia+i)-a(id+i))+(a(ib+i)-a(ic+i))) + (ssin60*(b(ib+ &
+               &          i)+b(ic+i)))
+          c(jc+j) = (2.0*(a(ia+i)+a(id+i))-(a(ib+i)+a(ic+i))) - (ssin60*(b(ib+ &
+               &          i)-b(ic+i)))
+          c(je+j) = (2.0*(a(ia+i)+a(id+i))-(a(ib+i)+a(ic+i))) + (ssin60*(b(ib+ &
+               &          i)-b(ic+i)))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+    GO TO 170
+
+    ! Coding for factor 8
+
+160 CONTINUE
+    ibad = 3
+    IF (la/=m) GO TO 180
+    ia = 1
+    ib = ia + la*inc1
+    ic = ib + 2*la*inc1
+    id = ic + 2*la*inc1
+    ie = id + 2*la*inc1
+    ja = 1
+    jb = ja + jink
+    jc = jb + jink
+    jd = jc + jink
+    je = jd + jink
+    jf = je + jink
+    jg = jf + jink
+    jh = jg + jink
+    ssin45 = SQRT(2.0)
+
+    DO l = 1, la
+       i = ibase
+       j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+       DO ijk = 1, lot
+          c(ja+j) = 2.0*(((a(ia+i)+a(ie+i))+a(ic+i))+(a(ib+i)+a(id+i)))
+          c(je+j) = 2.0*(((a(ia+i)+a(ie+i))+a(ic+i))-(a(ib+i)+a(id+i)))
+          c(jc+j) = 2.0*(((a(ia+i)+a(ie+i))-a(ic+i))-(b(ib+i)-b(id+i)))
+          c(jg+j) = 2.0*(((a(ia+i)+a(ie+i))-a(ic+i))+(b(ib+i)-b(id+i)))
+          c(jb+j) = 2.0*((a(ia+i)-a(ie+i))-b(ic+i)) + ssin45*((a(ib+i)-a(id+ &
+               &          i))-(b(ib+i)+b(id+i)))
+          c(jf+j) = 2.0*((a(ia+i)-a(ie+i))-b(ic+i)) - ssin45*((a(ib+i)-a(id+ &
+               &          i))-(b(ib+i)+b(id+i)))
+          c(jd+j) = 2.0*((a(ia+i)-a(ie+i))+b(ic+i)) - ssin45*((a(ib+i)-a(id+ &
+               &          i))+(b(ib+i)+b(id+i)))
+          c(jh+j) = 2.0*((a(ia+i)-a(ie+i))+b(ic+i)) + ssin45*((a(ib+i)-a(id+ &
+               &          i))+(b(ib+i)+b(id+i)))
+          i = i + inc3
+          j = j + inc4
+       END DO
+       ibase = ibase + inc1
+       jbase = jbase + inc2
+    END DO
+
+    ! Return
+
+170 CONTINUE
+    ibad = 0
+180 CONTINUE
+    ierr = ibad
+    RETURN
+  END SUBROUTINE rpassm
+
+  SUBROUTINE set99(trigs,ifax,n)
+
+    ! Description:
+    !
+    ! Computes factors of n & trigonometric functins required by fft99 & fft991cy
+    !
+    ! Method:
+    !
+    ! Dimension trigs(n),ifax(1),jfax(10),lfax(7)
+    !
+    ! subroutine 'set99' - computes factors of n & trigonometric
+    ! functins required by fft99 & fft991cy
+
+
+    USE pegrid
+
+    IMPLICIT NONE
+
+    !  Scalar arguments 
+    INTEGER :: n
+
+    !  Array arguments 
+    REAL :: trigs(*)
+    INTEGER :: ifax(*)
+
+    !  Local scalars: 
+    REAL :: angle, del
+    INTEGER :: i, ifac, ixxx, k, l, nfax, nhl, nil, nu
+
+    !  Local arrays: 
+    INTEGER :: jfax(10), lfax(7)
+
+    !  Intrinsic functions 
+    INTRINSIC ASIN, COS, MOD, REAL, SIN
+
+    !  Data statements 
+    DATA lfax/6, 8, 5, 4, 3, 2, 1/
+
+
+    !  Executable statements 
+    ixxx = 1
+
+    del = 4.0*ASIN(1.0)/REAL(n)
+    nil = 0
+    nhl = (n/2) - 1
+    DO k = nil, nhl
+       angle = REAL(k)*del
+       trigs(2*k+1) = COS(angle)
+       trigs(2*k+2) = SIN(angle)
+    END DO
+
+    ! Find factors of n (8,6,5,4,3,2; only one 8 allowed)
+    ! Look for sixes first, store factors in descending order
+    nu = n
+    ifac = 6
+    k = 0
+    l = 1
+10  CONTINUE
+    IF (MOD(nu,ifac)/=0) GO TO 30
+    k = k + 1
+    jfax(k) = ifac
+    IF (ifac/=8) GO TO 20
+    IF (k==1) GO TO 20
+    jfax(1) = 8
+    jfax(k) = 6
+20  CONTINUE
+    nu = nu/ifac
+    IF (nu==1) GO TO 40
+    IF (ifac/=8) GO TO 10
+30  CONTINUE
+    l = l + 1
+    ifac = lfax(l)
+    IF (ifac>1) GO TO 10
+
+!    WRITE (nout,'(A,I4,A)') ' n =',n,' - Contains illegal factors'
+    IF ( myid == 0 )  THEN
+       PRINT*, '+++ temperton_fft:'
+       PRINT*, '    number of gridpoints along x or/and y contain illegal ', &
+                    'factors'
+       PRINT*, '    only factors 8,6,5,4,3,2 are allowed'
+    ENDIF
+    CALL local_stop
+
+
+    RETURN
+
+    ! Now reverse order of factors
+40  CONTINUE
+    nfax = k
+    ifax(1) = nfax
+    DO i = 1, nfax
+       ifax(nfax+2-i) = jfax(i)
+    END DO
+    ifax(10) = n
+    RETURN
+  END SUBROUTINE set99
+
+ END MODULE temperton_fft
Index: palm/trunk/SOURCE/temperton_fft_mod.f90
===================================================================
--- palm/trunk/SOURCE/temperton_fft_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,4047 +1,0 @@
-!> @file temperton_fft_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
-!
-! 4370 2020-01-10 14:00:44Z raasch
-! unused variables removed
-!
-! 4366 2020-01-09 08:12:43Z raasch
-! vectorized routines added
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3725 2019-02-07 10:11:02Z raasch
-! GOTO statements replaced, file re-formatted corresponding to coding standards
-!
-! Revision 1.1  2003/03/12 16:41:59  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Fast Fourier transformation developed by Clive Temperton, ECMWF.
-!--------------------------------------------------------------------------------------------------!
- MODULE temperton_fft
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    PRIVATE
-
-!
-!-- No interfaces for the serial routines, because these are still writte in FORTRAN77
-    INTERFACE fft991cy_vec
-       MODULE PROCEDURE fft991cy_vec
-    END INTERFACE fft991cy_vec
-
-    INTERFACE qpassm_vec
-       MODULE PROCEDURE qpassm_vec
-    END INTERFACE qpassm_vec
-
-    INTERFACE rpassm_vec
-       MODULE PROCEDURE rpassm_vec
-    END INTERFACE rpassm_vec
-
-    PUBLIC set99, fft991cy, fft991cy_vec
-
-    INTEGER(iwp), PARAMETER ::  nfft =  32  !< maximum length of calls to *fft
-    INTEGER(iwp), PARAMETER ::  nout =   6  !< standard output stream
-
-CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calls Fortran-versions of fft's.
-!>
-!> Method:
-!>
-!> Subroutine 'fft991cy' - multiple fast real periodic transform supersedes previous routine
-!> 'fft991cy'.
-!>
-!> Real transform of length n performed by removing redundant operations from complex transform of
-!> length n.
-!>
-!> a       is the array containing input & output data.
-!> work    is an area of size (n+1)*min(lot,nfft).
-!> trigs   is a previously prepared list of trig function values.
-!> ifax    is a previously prepared list of factors of n.
-!> inc     is the increment within each data 'vector'
-!>         (e.g. inc=1 for consecutively stored data).
-!> jump    is the increment between the start of each data vector.
-!> n       is the length of the data vectors.
-!> lot     is the number of data vectors.
-!> isign = +1 for transform from spectral to gridpoint
-!>       = -1 for transform from gridpoint to spectral.
-!>
-!> ordering of coefficients:
-!> a(0),b(0),a(1),b(1),a(2),b(2),.,a(n/2),b(n/2)
-!> where b(0)=b(n/2)=0; (n+2) locations required.
-!>
-!> ordering of data:
-!> x(0),x(1),x(2),.,x(n-1), 0 , 0 ; (n+2) locations required.
-!>
-!> Vectorization is achieved on cray by doing the transforms in parallel.
-!>
-!> n must be composed of factors 2,3 & 5 but does not have to be even.
-!>
-!> definition of transforms:
-!>
-!> isign=+1: x(j)=sum(k=0,.,n-1)(c(k)*exp(2*i*j*k*pi/n))
-!> where c(k)=a(k)+i*b(k) and c(n-k)=a(k)-i*b(k)
-!>
-!> isign=-1: a(k)=(1/n)*sum(j=0,.,n-1)(x(j)*cos(2*j*k*pi/n))
-!> b(k)=-(1/n)*sum(j=0,.,n-1)(x(j)*sin(2*j*k*pi/n))
-!>
-!> calls fortran-versions of fft's  !!!
-!> dimension a(n),work(n),trigs(n),ifax(1)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE fft991cy( a, work, trigs, ifax, inc, jump, n, lot, isign )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  inc    !<
-    INTEGER(iwp) ::  isign  !<
-    INTEGER(iwp) ::  jump   !<
-    INTEGER(iwp) ::  lot    !<
-    INTEGER(iwp) ::  n      !<
-
-    INTEGER(iwp) ::  i        !<
-    INTEGER(iwp) ::  ia       !<
-    INTEGER(iwp) ::  ibase    !<
-    INTEGER(iwp) ::  ierr     !<
-    INTEGER(iwp) ::  ifac     !<
-    INTEGER(iwp) ::  igo      !<
-    INTEGER(iwp) ::  ii       !<
-    INTEGER(iwp) ::  ifax(*)  !<
-    INTEGER(iwp) ::  istart   !<
-    INTEGER(iwp) ::  ix       !<
-    INTEGER(iwp) ::  iz       !<
-    INTEGER(iwp) ::  j        !<
-    INTEGER(iwp) ::  jbase    !<
-    INTEGER(iwp) ::  jj       !<
-    INTEGER(iwp) ::  k        !<
-    INTEGER(iwp) ::  la       !<
-    INTEGER(iwp) ::  nb       !<
-    INTEGER(iwp) ::  nblox    !<
-    INTEGER(iwp) ::  nfax     !<
-    INTEGER(iwp) ::  nvex     !<
-    INTEGER(iwp) ::  nx       !<
-
-    REAL(wp)     ::  a(*)      !<
-    REAL(wp)     ::  trigs(*)  !<
-    REAL(wp)     ::  work(*)   !<
-
-
-    IF ( ifax(10) /= n )  CALL set99( trigs, ifax, n )
-    nfax = ifax(1)
-    nx   = n + 1
-    IF ( MOD( n, 2) == 1 )  nx = n
-    nblox = 1 + (lot-1) / nfft
-    nvex = lot - ( nblox - 1 ) * nfft
-
-
-    IF ( isign == 1 )  THEN
-!
-!--    Backward fft: spectral to gridpoint transform
-
-       istart = 1
-       DO  nb = 1, nblox
-
-          ia = istart
-          i  = istart
-          !DIR$ IVDEP
-          !CDIR NODEP
-          !OCL NOVREC
-          DO  j = 1, nvex
-             a(i+inc) = 0.5_wp * a(i)
-             i        = i + jump
-          ENDDO
-          IF ( MOD(n,2) /= 1 )  THEN
-             i = istart + n * inc
-             DO  j   = 1, nvex
-                a(i) = 0.5_wp * a(i)
-                i    = i + jump
-             ENDDO
-          ENDIF
-          ia = istart + inc
-          la = 1
-          igo = + 1
-
-          DO  k = 1, nfax
-
-             ifac = ifax(k+1)
-             ierr = -1
-             IF ( igo /= -1 )  THEN
-                CALL rpassm( a(ia), a(ia+la*inc), work(1), work(ifac*la+1), trigs, inc, 1, jump,   &
-                             nx, nvex, n, ifac, la, ierr )
-             ELSE
-                CALL rpassm( work(1), work(la+1), a(ia), a(ia+ifac*la*inc), trigs, 1, inc, nx,     &
-                             jump, nvex, n, ifac, la, ierr )
-             ENDIF
-!
-!--          Following messages shouldn't appear in PALM applications
-             IF ( ierr /= 0 )  THEN
-                SELECT CASE (ierr)
-                   CASE (:-1)
-                      WRITE (nout,'(A,I5,A)') ' Vector length =',nvex,', greater than nfft'
-                   CASE (0)
-                      WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', not catered for'
-                   CASE (1:)
-                      WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', only catered for if la*ifac=n'
-                END SELECT
-                RETURN
-             ENDIF
-
-             la  = ifac * la
-             igo = -igo
-             ia  = istart
-
-          ENDDO
-!
-!--       If necessary, copy results back to a
-          IF ( MOD( nfax, 2 ) /= 0 )  THEN
-             ibase = 1
-             jbase = ia
-             DO  jj = 1, nvex
-                i = ibase
-                j = jbase
-                DO  ii = 1, n
-                   a(j) = work(i)
-                   i    = i + 1
-                   j    = j + inc
-                ENDDO
-                ibase = ibase + nx
-                jbase = jbase + jump
-             ENDDO
-          ENDIF
-!
-!--       Fill in zeros at end
-          ix = istart + n * inc
-          !DIR$ IVDEP
-          !CDIR NODEP
-          !OCL NOVREC
-          DO  j = 1, nvex
-             a(ix)     = 0.0_wp
-             a(ix+inc) = 0.0_wp
-             ix        = ix + jump
-          ENDDO
-          istart = istart + nvex * jump
-          nvex = nfft
-
-       ENDDO
-
-    ELSEIF ( isign == -1 )  THEN
-!
-!--    Forward fft: gridpoint to spectral transform
-       istart = 1
-       DO  nb = 1, nblox
-          ia  = istart
-          la  = n
-          igo = + 1
-
-          DO  k = 1, nfax
-
-             ifac = ifax(nfax+2-k)
-             la   = la / ifac
-             ierr = -1
-             IF ( igo /= -1 )  THEN
-                CALL qpassm( a(ia), a(ia+ifac*la*inc), work(1), work(la+1), trigs, inc, 1, jump,   &
-                             nx, nvex, n, ifac, la, ierr )
-             ELSE
-                CALL qpassm( work(1), work(ifac*la+1), a(ia), a(ia+la*inc), trigs, 1, inc, nx,     &
-                             jump, nvex, n, ifac, la, ierr )
-             ENDIF
-!
-!--          Following messages shouldn't appear in PALM applications
-             IF ( ierr /= 0 )  THEN
-                SELECT CASE (ierr)
-                   CASE (:-1)
-                      WRITE (nout,'(A,I5,A)') ' Vector length =',nvex,', greater than nfft'
-                   CASE (0)
-                      WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', not catered for'
-                   CASE (1:)
-                      WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', only catered for if la*ifac=n'
-                END SELECT
-                RETURN
-             ENDIF
-
-             igo = -igo
-             ia = istart + inc
-
-          ENDDO
-!
-!--       If necessary, copy results back to a
-          IF ( MOD(nfax,2) /= 0 )  THEN
-             ibase = 1
-             jbase = ia
-             DO  jj = 1, nvex
-                i = ibase
-                j = jbase
-                DO  ii = 1, n
-                   a(j) = work(i)
-                   i    = i + 1
-                   j    = j + inc
-                ENDDO
-                ibase = ibase + nx
-                jbase = jbase + jump
-             ENDDO
-          ENDIF
-!
-!--       Shift a(0) and fill in zero imag parts
-          ix = istart
-          !DIR$ IVDEP
-          !CDIR NODEP
-          !OCL NOVREC
-          DO  j = 1, nvex
-             a(ix)     = a(ix+inc)
-             a(ix+inc) = 0.0_wp
-             ix        = ix + jump
-          ENDDO
-          IF ( MOD(n,2) /= 1 )  THEN
-             iz = istart + (n+1) * inc
-             DO  j = 1, nvex
-                a(iz) = 0.0_wp
-                iz    = iz + jump
-             ENDDO
-          ENDIF
-          istart = istart + nvex * jump
-          nvex = nfft
-
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE fft991cy
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Performs one pass through data as part of multiple real fft (fourier analysis) routine.
-!>
-!> Method:
-!>
-!> a       is first real input vector
-!>         equivalence b(1) with a(ifac*la*inc1+1)
-!> c       is first real output vector
-!>         equivalence d(1) with c(la*inc2+1)
-!> trigs   is a precalculated list of sines & cosines
-!> inc1    is the addressing increment for a
-!> inc2    is the addressing increment for c
-!> inc3    is the increment between input vectors a
-!> inc4    is the increment between output vectors c
-!> lot     is the number of vectors
-!> n       is the length of the vectors
-!> ifac    is the current factor of n
-!>         la = n/(product of factors used so far)
-!> ierr    is an error indicator:
-!>         0 - pass completed without error
-!>         1 - lot greater than nfft
-!>         2 - ifac not catered for
-!>         3 - ifac only catered for if la=n/ifac
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE qpassm( a, b, c, d, trigs, inc1, inc2, inc3, inc4, lot, n, ifac, la, ierr )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ierr  !<
-    INTEGER(iwp) ::  ifac  !<
-    INTEGER(iwp) ::  inc1  !<
-    INTEGER(iwp) ::  inc2  !<
-    INTEGER(iwp) ::  inc3  !<
-    INTEGER(iwp) ::  inc4  !<
-    INTEGER(iwp) ::  la    !<
-    INTEGER(iwp) ::  lot   !<
-    INTEGER(iwp) ::  n     !<
-
-    INTEGER(iwp) ::  i      !<
-    INTEGER(iwp) ::  ia     !<
-    INTEGER(iwp) ::  ib     !<
-    INTEGER(iwp) ::  ibase  !<
-    INTEGER(iwp) ::  ic     !<
-    INTEGER(iwp) ::  id     !<
-    INTEGER(iwp) ::  ie     !<
-    INTEGER(iwp) ::  if     !<
-    INTEGER(iwp) ::  ig     !<
-    INTEGER(iwp) ::  igo    !<
-    INTEGER(iwp) ::  ih     !<
-    INTEGER(iwp) ::  iink   !<
-    INTEGER(iwp) ::  ijk    !<
-    INTEGER(iwp) ::  ijump  !<
-    INTEGER(iwp) ::  j      !<
-    INTEGER(iwp) ::  ja     !<
-    INTEGER(iwp) ::  jb     !<
-    INTEGER(iwp) ::  jbase  !<
-    INTEGER(iwp) ::  jc     !<
-    INTEGER(iwp) ::  jd     !<
-    INTEGER(iwp) ::  je     !<
-    INTEGER(iwp) ::  jf     !<
-    INTEGER(iwp) ::  jink   !<
-    INTEGER(iwp) ::  k      !<
-    INTEGER(iwp) ::  kb     !<
-    INTEGER(iwp) ::  kc     !<
-    INTEGER(iwp) ::  kd     !<
-    INTEGER(iwp) ::  ke     !<
-    INTEGER(iwp) ::  kf     !<
-    INTEGER(iwp) ::  kstop  !<
-    INTEGER(iwp) ::  l      !<
-    INTEGER(iwp) ::  m      !<
-
-!
-!-- Arrays are dimensioned with n
-    REAL(wp) ::  a(*)      !<
-    REAL(wp) ::  b(*)      !<
-    REAL(wp) ::  c(*)      !<
-    REAL(wp) ::  d(*)      !<
-    REAL(wp) ::  trigs(*)  !<
-
-    REAL(wp) ::  a0      !<
-    REAL(wp) ::  a1      !<
-    REAL(wp) ::  a10     !<
-    REAL(wp) ::  a11     !<
-    REAL(wp) ::  a2      !<
-    REAL(wp) ::  a20     !<
-    REAL(wp) ::  a21     !<
-    REAL(wp) ::  a3      !<
-    REAL(wp) ::  a4      !<
-    REAL(wp) ::  a5      !<
-    REAL(wp) ::  a6      !<
-    REAL(wp) ::  b0      !<
-    REAL(wp) ::  b1      !<
-    REAL(wp) ::  b10     !<
-    REAL(wp) ::  b11     !<
-    REAL(wp) ::  b2      !<
-    REAL(wp) ::  b20     !<
-    REAL(wp) ::  b21     !<
-    REAL(wp) ::  b3      !<
-    REAL(wp) ::  b4      !<
-    REAL(wp) ::  b5      !<
-    REAL(wp) ::  b6      !<
-    REAL(wp) ::  c1      !<
-    REAL(wp) ::  c2      !<
-    REAL(wp) ::  c3      !<
-    REAL(wp) ::  c4      !<
-    REAL(wp) ::  c5      !<
-    REAL(wp) ::  qrt5    !<
-    REAL(wp) ::  s1      !<
-    REAL(wp) ::  s2      !<
-    REAL(wp) ::  s3      !<
-    REAL(wp) ::  s4      !<
-    REAL(wp) ::  s5      !<
-    REAL(wp) ::  sin36   !<
-    REAL(wp) ::  sin45   !<
-    REAL(wp) ::  sin60   !<
-    REAL(wp) ::  sin72   !<
-    REAL(wp) ::  z       !<
-    REAL(wp) ::  zqrt5   !<
-    REAL(wp) ::  zsin36  !<
-    REAL(wp) ::  zsin45  !<
-    REAL(wp) ::  zsin60  !<
-    REAL(wp) ::  zsin72  !<
-
-
-    DATA  sin36/0.587785252292473_wp/, sin72/0.951056516295154_wp/,                                &
-          qrt5/0.559016994374947_wp/,  sin60/0.866025403784437_wp/
-
-
-    ierr = 0
-
-    IF ( lot > nfft )  THEN
-       ierr = 1
-       RETURN
-    ENDIF
-
-    m = n / ifac
-    iink  = la * inc1
-    jink  = la * inc2
-    ijump = (ifac - 1) * iink
-    kstop = ( n - ifac ) / ( 2 * ifac )
-
-    ibase = 0
-    jbase = 0
-    igo = ifac - 1
-    IF ( igo == 7 )  igo = 6
-
-    IF (igo < 1 .OR. igo > 6 )  THEN
-       ierr = 2
-       RETURN
-    ENDIF
-
-
-    SELECT CASE ( igo )
-
-!
-!--    Coding for factor 2
-       CASE ( 1 )
-          ia = 1
-          ib = ia + iink
-          ja = 1
-          jb = ja + ( 2 * m - la ) * inc2
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i) + a(ib+i)
-                   c(jb+j) = a(ia+i) - a(ib+i)
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-             ja    = ja + jink
-             jink  = 2 * jink
-             jb    = jb - jink
-             ibase = ibase + ijump
-             ijump = 2 * ijump + iink
-
-             IF ( ja /= jb )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   jbase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      !DIR$ IVDEP
-                      !CDIR NODEP
-                      !OCL NOVREC
-                      DO  ijk = 1, lot
-                         c(ja+j) = a(ia+i) + ( c1 * a(ib+i) + s1 * b(ib+i) )
-                         c(jb+j) = a(ia+i) - ( c1 * a(ib+i) + s1 * b(ib+i) )
-                         d(ja+j) = ( c1 * b(ib+i) - s1 * a(ib+i) ) + b(ia+i)
-                         d(jb+j) = ( c1 * b(ib+i) - s1 * a(ib+i) ) - b(ia+i)
-                         i = i + inc3
-                         j = j + inc4
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-
-                   ibase = ibase + ijump
-                   ja = ja + jink
-                   jb = jb - jink
-                ENDDO
-
-                IF ( ja > jb )  RETURN
-
-             ENDIF
-
-             jbase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i)
-                   d(ja+j) = -a(ib+i)
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             z = 1.0_wp / REAL( n, KIND = wp )
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = z * ( a(ia+i) + a(ib+i) )
-                   c(jb+j) = z * ( a(ia+i) - a(ib+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 3
-       CASE ( 2 )
-
-          ia = 1
-          ib = ia + iink
-          ic = ib + iink
-          ja = 1
-          jb = ja + ( 2 * m - la) * inc2
-          jc = jb
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i) + ( a(ib+i) + a(ic+i) )
-                   c(jb+j) = a(ia+i) - 0.5_wp * ( a(ib+i) + a(ic+i) )
-                   d(jb+j) = sin60 * ( a(ic+i) - a(ib+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-             ja = ja + jink
-             jink = 2 * jink
-             jb = jb + jink
-             jc = jc - jink
-             ibase = ibase + ijump
-             ijump = 2 * ijump + iink
-
-             IF ( ja /= jc )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-
-                   jbase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      !DIR$ IVDEP
-                      !CDIR NODEP
-                      !OCL NOVREC
-                      DO  ijk = 1, lot
-                         a1 = ( c1 * a(ib+i) + s1 * b(ib+i) ) + ( c2 * a(ic+i) + s2 * b(ic+i) )
-                         b1 = ( c1 * b(ib+i) - s1 * a(ib+i) ) + ( c2 * b(ic+i) - s2 * a(ic+i) )
-                         a2 = a(ia+i) - 0.5_wp * a1
-                         b2 = b(ia+i) - 0.5_wp * b1
-                         a3 = sin60 * ( ( c1 * a(ib+i) + s1 * b(ib+i) ) - ( c2 * a(ic+i) + s2      &
-                              * b(ic+i) ) )
-                         b3 = sin60 * ( ( c1 * b(ib+i) - s1 * a(ib+i) ) - ( c2 * b(ic+i) - s2      &
-                              * a(ic+i) ) )
-                         c(ja+j) = a(ia+i) + a1
-                         d(ja+j) = b(ia+i) + b1
-                         c(jb+j) = a2 + b3
-                         d(jb+j) = b2 - a3
-                         c(jc+j) = a2 - b3
-                         d(jc+j) = - ( b2 + a3 )
-                         i = i + inc3
-                         j = j + inc4
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ibase = ibase + ijump
-                   ja = ja + jink
-                   jb = jb + jink
-                   jc = jc - jink
-                ENDDO
-
-                IF ( ja > jc )  RETURN
-
-             ENDIF
-
-             jbase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i) + 0.5_wp * ( a(ib+i) - a(ic+i) )
-                   d(ja+j) = -sin60 * ( a(ib+i) + a(ic+i) )
-                   c(jb+j) = a(ia+i) - ( a(ib+i) - a(ic+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             z = 1.0_wp / REAL( n, KIND = wp )
-             zsin60 = z * sin60
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = z * ( a(ia+i) + ( a (ib+i) + a(ic+i) ) )
-                   c(jb+j) = z * ( a(ia+i) - 0.5_wp * ( a(ib+i) + a(ic+i) ) )
-                   d(jb+j) = zsin60 * ( a(ic+i) -a(ib+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 4
-       CASE ( 3 )
-
-          ia = 1
-          ib = ia + iink
-          ic = ib + iink
-          id = ic + iink
-          ja = 1
-          jb = ja + ( 2 * m - la ) * inc2
-          jc = jb + 2 * m * inc2
-          jd = jb
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = ( a(ia+i) + a(ic+i) ) + ( a(ib+i) + a(id+i) )
-                   c(jc+j) = ( a(ia+i) + a(ic+i) ) - ( a(ib+i) + a(id+i) )
-                   c(jb+j) = a(ia+i) - a(ic+i)
-                   d(jb+j) = a(id+i) - a(ib+i)
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-             ja    = ja + jink
-             jink  = 2 * jink
-             jb    = jb + jink
-             jc    = jc - jink
-             jd    = jd - jink
-             ibase = ibase + ijump
-             ijump = 2 * ijump + iink
-
-             IF ( jb /= jc )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   jbase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      !DIR$ IVDEP
-                      !CDIR NODEP
-                      !OCL NOVREC
-                      DO  ijk = 1, lot
-                         a0 = a(ia+i) + ( c2 * a(ic+i) + s2 * b(ic+i) )
-                         a2 = a(ia+i) - ( c2 * a(ic+i) + s2 * b(ic+i) )
-                         a1 = ( c1 * a(ib+i) + s1 * b(ib+i) ) + ( c3 * a(id+i) + s3 * b(id+i) )
-                         a3 = ( c1 * a(ib+i) + s1 * b(ib+i) ) - ( c3 * a(id+i) + s3 * b(id+i) )
-                         b0 = b(ia+i) + ( c2 * b(ic+i) - s2 * a(ic+i) )
-                         b2 = b(ia+i) - ( c2 * b(ic+i) - s2 * a(ic+i) )
-                         b1 = ( c1 * b(ib+i) - s1 * a(ib+i) ) + ( c3 * b(id+i) - s3 * a(id+i) )
-                         b3 = ( c1 * b(ib+i) - s1 * a(ib+i) ) - ( c3 * b(id+i) - s3 * a(id+i) )
-                         c(ja+j) = a0 + a1
-                         c(jc+j) = a0 - a1
-                         d(ja+j) = b0 + b1
-                         d(jc+j) = b1 - b0
-                         c(jb+j) = a2 + b3
-                         c(jd+j) = a2 - b3
-                         d(jb+j) = b2 - a3
-                         d(jd+j) = - ( b2 + a3 )
-                         i = i + inc3
-                         j = j + inc4
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ibase = ibase + ijump
-                   ja = ja + jink
-                   jb = jb + jink
-                   jc = jc - jink
-                   jd = jd - jink
-                ENDDO
-
-                IF ( jb > jc )  RETURN
-
-             ENDIF
-
-             sin45 = SQRT( 0.5_wp )
-             jbase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i) + sin45 * ( a(ib+i) - a(id+i) )
-                   c(jb+j) = a(ia+i) - sin45 * ( a(ib+i) - a(id+i) )
-                   d(ja+j) = - a(ic+i) - sin45 * ( a(ib+i) + a(id+i) )
-                   d(jb+j) = a(ic+i) - sin45 * ( a(ib+i) + a(id+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             z = 1.0_wp / REAL( n, KIND = wp )
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = z * ( ( a(ia+i) + a(ic+i) ) + ( a(ib+i) + a(id+i) ) )
-                   c(jc+j) = z * ( ( a(ia+i) + a(ic+i) ) - (a (ib+i) + a(id+i) ) )
-                   c(jb+j) = z * ( a(ia+i) - a(ic+i) )
-                   d(jb+j) = z * ( a(id+i) - a(ib+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 5
-       CASE ( 4 )
-
-          ia = 1
-          ib = ia + iink
-          ic = ib + iink
-          id = ic + iink
-          ie = id + iink
-          ja = 1
-          jb = ja + ( 2 * m - la ) * inc2
-          jc = jb + 2 * m * inc2
-          jd = jc
-          je = jb
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   a1 = a(ib+i) + a(ie+i)
-                   a3 = a(ib+i) - a(ie+i)
-                   a2 = a(ic+i) + a(id+i)
-                   a4 = a(ic+i) - a(id+i)
-                   a5 = a(ia+i) - 0.25_wp * ( a1 + a2 )
-                   a6 = qrt5 * ( a1 - a2 )
-                   c(ja+j) = a(ia+i) + ( a1 + a2 )
-                   c(jb+j) = a5 + a6
-                   c(jc+j) = a5 - a6
-                   d(jb+j) = - sin72 * a3 - sin36 * a4
-                   d(jc+j) = - sin36 * a3 + sin72 * a4
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-             ja = ja + jink
-             jink = 2 * jink
-             jb = jb + jink
-             jc = jc + jink
-             jd = jd - jink
-             je = je - jink
-             ibase = ibase + ijump
-             ijump = 2 * ijump + iink
-
-             IF ( jb /= jd )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   ke = kd + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   c4 = trigs(ke+1)
-                   s4 = trigs(ke+2)
-                   jbase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      !DIR$ IVDEP
-                      !CDIR NODEP
-                      !OCL NOVREC
-                      DO  ijk = 1, lot
-                         a1  = (c1 * a(ib+i) + s1 * b(ib+i) ) + ( c4 * a(ie+i) + s4 * b(ie+i) )
-                         a3  = (c1 * a(ib+i) + s1 * b(ib+i) ) - ( c4 * a(ie+i) + s4 * b(ie+i) )
-                         a2  = (c2 * a(ic+i) + s2 * b(ic+i) ) + ( c3 * a(id+i) + s3 * b(id+i) )
-                         a4  = (c2 * a(ic+i) + s2 * b(ic+i) ) - ( c3 * a(id+i) + s3 * b(id+i) )
-                         b1  = (c1 * b(ib+i) - s1 * a(ib+i) ) + ( c4 * b(ie+i) - s4 * a(ie+i) )
-                         b3  = (c1 * b(ib+i) - s1 * a(ib+i) ) - ( c4 * b(ie+i) - s4 * a(ie+i) )
-                         b2  = (c2 * b(ic+i) - s2 * a(ic+i) ) + ( c3 * b(id+i) - s3 * a(id+i) )
-                         b4  = (c2 * b(ic+i) - s2 * a(ic+i) ) - ( c3 * b(id+i) - s3 * a(id+i) )
-                         a5  = a(ia+i) - 0.25_wp * ( a1 + a2 )
-                         a6  = qrt5 * ( a1 - a2 )
-                         b5  = b(ia+i) - 0.25_wp * ( b1 + b2 )
-                         b6  = qrt5 * ( b1 - b2 )
-                         a10 = a5 + a6
-                         a20 = a5 - a6
-                         b10 = b5 + b6
-                         b20 = b5 - b6
-                         a11 = sin72 * b3 + sin36 * b4
-                         a21 = sin36 * b3 - sin72 * b4
-                         b11 = sin72 * a3 + sin36 * a4
-                         b21 = sin36 * a3 - sin72 * a4
-                         c(ja+j) = a(ia+i) + ( a1 + a2 )
-                         c(jb+j) = a10 + a11
-                         c(je+j) = a10 - a11
-                         c(jc+j) = a20 + a21
-                         c(jd+j) = a20 - a21
-                         d(ja+j) = b(ia+i) + ( b1 + b2 )
-                         d(jb+j) = b10 - b11
-                         d(je+j) = - ( b10 + b11 )
-                         d(jc+j) = b20 - b21
-                         d(jd+j) = - ( b20 + b21 )
-                         i = i + inc3
-                         j = j + inc4
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ibase = ibase + ijump
-                   ja = ja + jink
-                   jb = jb + jink
-                   jc = jc + jink
-                   jd = jd - jink
-                   je = je - jink
-                ENDDO
-
-                IF ( jb > jd )  RETURN
-
-             ENDIF
-
-             jbase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   a1 = a(ib+i) + a(ie+i)
-                   a3 = a(ib+i) - a(ie+i)
-                   a2 = a(ic+i) + a(id+i)
-                   a4 = a(ic+i) - a(id+i)
-                   a5 = a(ia+i) + 0.25_wp * ( a3 - a4 )
-                   a6 = qrt5 * ( a3 + a4 )
-                   c(ja+j) = a5 + a6
-                   c(jb+j) = a5 - a6
-                   c(jc+j) = a(ia+i) - ( a3 - a4 )
-                   d(ja+j) = - sin36 * a1 - sin72 * a2
-                   d(jb+j) = - sin72 * a1 + sin36 * a2
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             z = 1.0_wp / REAL( n, KIND = wp )
-             zqrt5  = z * qrt5
-             zsin36 = z * sin36
-             zsin72 = z * sin72
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   a1 = a(ib+i) + a(ie+i)
-                   a3 = a(ib+i) - a(ie+i)
-                   a2 = a(ic+i) + a(id+i)
-                   a4 = a(ic+i) - a(id+i)
-                   a5 = z * ( a (ia+i) - 0.25_wp * ( a1 + a2 ) )
-                   a6 = zqrt5 * ( a1 - a2 )
-                   c(ja+j) = z * ( a(ia+i) + (a1+a2) )
-                   c(jb+j) = a5 + a6
-                   c(jc+j) = a5 - a6
-                   d(jb+j) = - zsin72 * a3 - zsin36 * a4
-                   d(jc+j) = - zsin36 * a3 + zsin72 * a4
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 6
-       CASE ( 5 )
-
-          ia = 1
-          ib = ia + iink
-          ic = ib + iink
-          id = ic + iink
-          ie = id + iink
-          if = ie + iink
-          ja = 1
-          jb = ja + ( 2 * m - la ) * inc2
-          jc = jb + 2 * m * inc2
-          jd = jc + 2 * m * inc2
-          je = jc
-          jf = jb
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   a11 = ( a (ic+i) + a(if+i) ) + ( a(ib+i) + a(ie+i) )
-                   c(ja+j) = ( a(ia+i) + a(id+i) ) + a11
-                   c(jc+j) = ( a(ia+i) + a(id+i) - 0.5_wp * a11 )
-                   d(jc+j) = sin60 * ( ( a(ic+i) + a(if+i) ) - ( a(ib+i) + a(ie+i) ) )
-                   a11 = ( a (ic+i) - a(if+i) ) + ( a(ie+i) - a(ib+i) )
-                   c(jb+j) = ( a(ia+i) - a(id+i) ) - 0.5_wp * a11
-                   d(jb+j) = sin60 * ( ( a(ie+i) - a(ib+i) ) - ( a(ic+i) - a(if+i) ) )
-                   c(jd+j) = ( a (ia+i) - a(id+i) ) + a11
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-             ja    = ja + jink
-             jink  = 2 * jink
-             jb    = jb + jink
-             jc    = jc + jink
-             jd    = jd - jink
-             je    = je - jink
-             jf    = jf - jink
-             ibase = ibase + ijump
-             ijump = 2 * ijump + iink
-
-             IF ( jc /= jd )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   ke = kd + kb
-                   kf = ke + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   c4 = trigs(ke+1)
-                   s4 = trigs(ke+2)
-                   c5 = trigs(kf+1)
-                   s5 = trigs(kf+2)
-                   jbase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      !DIR$ IVDEP
-                      !CDIR NODEP
-                      !OCL NOVREC
-                      DO  ijk = 1, lot
-                         a1  = c1 * a(ib+i) + s1 * b(ib+i)
-                         b1  = c1 * b(ib+i) - s1 * a(ib+i)
-                         a2  = c2 * a(ic+i) + s2 * b(ic+i)
-                         b2  = c2 * b(ic+i) - s2 * a(ic+i)
-                         a3  = c3 * a(id+i) + s3 * b(id+i)
-                         b3  = c3 * b(id+i) - s3 * a(id+i)
-                         a4  = c4 * a(ie+i) + s4 * b(ie+i)
-                         b4  = c4 * b(ie+i) - s4 * a(ie+i)
-                         a5  = c5 * a(if+i) + s5 * b(if+i)
-                         b5  = c5 * b(if+i) - s5 * a(if+i)
-                         a11 = ( a2 + a5 ) + ( a1 + a4 )
-                         a20 = ( a(ia+i) + a3 ) - 0.5_wp * a11
-                         a21 = sin60 * ( ( a2 + a5 ) - ( a1 + a4 ) )
-                         b11 = ( b2 + b5 ) + ( b1 + b4 )
-                         b20 = ( b(ia+i) + b3 ) - 0.5_wp * b11
-                         b21 = sin60 * ( ( b2 + b5 ) - ( b1 + b4 ) )
-                         c(ja+j) = ( a(ia+i) + a3 ) + a11
-                         d(ja+j) = ( b(ia+i) + b3 ) + b11
-                         c(jc+j) = a20 - b21
-                         d(jc+j) = a21 + b20
-                         c(je+j) = a20 + b21
-                         d(je+j) = a21 - b20
-                         a11 = ( a2 - a5 ) + ( a4 - a1 )
-                         a20 = ( a(ia+i) - a3 ) - 0.5_wp * a11
-                         a21 = sin60 * ( ( a4 - a1 ) - ( a2 - a5 ) )
-                         b11 = ( b5 - b2 ) - ( b4 - b1 )
-                         b20 = ( b3 - b(ia+i) ) - 0.5_wp * b11
-                         b21 = sin60 * ( ( b5 - b2 ) + ( b4 - b1 ) )
-                         c(jb+j) = a20 - b21
-                         d(jb+j) = a21 - b20
-                         c(jd+j) = a11 + ( a(ia+i) - a3 )
-                         d(jd+j) = b11 + ( b3 - b(ia+i) )
-                         c(jf+j) = a20 + b21
-                         d(jf+j) = a21 + b20
-                         i = i + inc3
-                         j = j + inc4
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ibase = ibase + ijump
-                   ja = ja + jink
-                   jb = jb + jink
-                   jc = jc + jink
-                   jd = jd - jink
-                   je = je - jink
-                   jf = jf - jink
-                ENDDO
-
-                IF ( jc > jd )  RETURN
-
-             ENDIF
-
-             jbase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = ( a (ia+i) + 0.5_wp * ( a(ic+i) - a(ie+i) ) ) + sin60 *               &
-                             ( a(ib+i) - a(if+i) )
-                   d(ja+j) = - ( a(id+i) + 0.5_wp * ( a(ib+i) + a(if+i) ) ) - sin60 * ( a(ic+i) +  &
-                             a(ie+i) )
-                   c(jb+j) = a(ia+i) - ( a(ic+i) - a(ie+i) )
-                   d(jb+j) = a(id+i) - ( a(ib+i) + a(if+i) )
-                   c(jc+j) = ( a(ia+i) + 0.5_wp * ( a(ic+i) - a(ie+i) ) ) - sin60 * ( a(ib+i) -    &
-                             a(if+i) )
-                   d(jc+j) = - ( a(id+i) + 0.5_wp * ( a(ib+i) + a(if+i) ) ) + sin60 * ( a(ic+i) +  &
-                             a(ie+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             z = 1.0_wp / REAL( n, KIND = wp )
-             zsin60 = z * sin60
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   a11 = ( a(ic+i) + a(if+i) ) + ( a(ib+i) + a(ie+i) )
-                   c(ja+j) = z * ( ( a(ia+i) + a(id+i) ) + a11 )
-                   c(jc+j) = z * ( ( a(ia+i) + a(id+i) ) - 0.5_wp * a11 )
-                   d(jc+j) = zsin60 * ( ( a(ic+i) + a(if+i) ) - ( a(ib+i) + a(ie+i) ) )
-                   a11 = ( a(ic+i) - a(if+i) ) + ( a(ie+i) - a(ib+i) )
-                   c(jb+j) = z * ( ( a(ia+i) - a(id+i) ) - 0.5_wp * a11 )
-                   d(jb+j) = zsin60 * ( ( a(ie+i) - a(ib+i) ) - ( a(ic+i) - a(if+i) ) )
-                   c(jd+j) = z * ( ( a(ia+i) - a(id+i) ) + a11 )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 8
-       CASE ( 6 )
-
-          IF ( la /= m )  THEN
-             ierr = 3
-             RETURN
-          ENDIF
-
-          ia = 1
-          ib = ia + iink
-          ic = ib + iink
-          id = ic + iink
-          ie = id + iink
-          if = ie + iink
-          ig = if + iink
-          ih = ig + iink
-          ja = 1
-          jb = ja + la * inc2
-          jc = jb + 2 * m * inc2
-          jd = jc + 2 * m * inc2
-          je = jd + 2 * m * inc2
-          z = 1.0_wp / REAL( n, KIND = wp )
-          zsin45 = z * SQRT( 0.5_wp )
-
-          DO  l = 1, la
-             i = ibase
-             j = jbase
-
-             !DIR$ IVDEP
-             !CDIR NODEP
-             !OCL NOVREC
-             DO  ijk = 1, lot
-                c(ja+j) = z * ( ( ( a(ia+i) + a(ie+i) ) + ( a(ic+i) + a(ig+i) ) ) + ( ( a(id+i)    &
-                          + a(ih+i) ) + ( a(ib+i) + a(if+i) ) ) )
-                c(je+j) = z * ( ( ( a(ia+i) + a(ie+i) ) + (a(ic+i) + a(ig+i) ) ) - ( ( a(id+i)     &
-                          + a(ih+i) ) + ( a(ib+i) + a(if+i) ) ) )
-                c(jc+j) = z * ( ( a(ia+i) + a(ie+i) ) - ( a(ic+i) + a(ig+i) ) )
-                d(jc+j) = z * ( ( a(id+i) + a(ih+i) ) - ( a(ib+i) + a(if+i) ) )
-                c(jb+j) = z * ( a(ia+i) - a(ie+i) ) + zsin45 * ( ( a(ih+i) - a(id+i) ) - ( a(if+i) &
-                          - a(ib+i) ) )
-                c(jd+j) = z * ( a(ia+i) - a(ie+i) ) - zsin45 * ( ( a(ih+i) - a(id+i) ) - ( a(if+i) &
-                          - a(ib+i) ) )
-                d(jb+j) = zsin45 * ( ( a(ih+i) - a(id+i) ) + ( a(if+i) - a(ib+i) ) ) + z *         &
-                          ( a(ig+i) - a(ic+i) )
-                d(jd+j) = zsin45 * ( ( a(ih+i) - a(id+i) ) + ( a(if+i) - a(ib+i) ) ) - z *         &
-                          ( a(ig+i) - a(ic+i) )
-                i = i + inc3
-                j = j + inc4
-             ENDDO
-             ibase = ibase + inc1
-             jbase = jbase + inc2
-          ENDDO
-
-    END SELECT
-
- END SUBROUTINE qpassm
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Same as qpassm, but for backward fft
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rpassm( a, b, c, d, trigs, inc1, inc2, inc3, inc4, lot, n, ifac, la, ierr )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ierr  !<
-    INTEGER(iwp) ::  ifac  !<
-    INTEGER(iwp) ::  inc1  !<
-    INTEGER(iwp) ::  inc2  !<
-    INTEGER(iwp) ::  inc3  !<
-    INTEGER(iwp) ::  inc4  !<
-    INTEGER(iwp) ::  la    !<
-    INTEGER(iwp) ::  lot   !<
-    INTEGER(iwp) ::  n     !<
-!
-!-- Arrays are dimensioned with n
-    INTEGER(iwp) ::  i      !<
-    INTEGER(iwp) ::  ia     !<
-    INTEGER(iwp) ::  ib     !<
-    INTEGER(iwp) ::  ibase  !<
-    INTEGER(iwp) ::  ic     !<
-    INTEGER(iwp) ::  id     !<
-    INTEGER(iwp) ::  ie     !<
-    INTEGER(iwp) ::  if     !<
-    INTEGER(iwp) ::  igo    !<
-    INTEGER(iwp) ::  iink   !<
-    INTEGER(iwp) ::  ijk    !<
-    INTEGER(iwp) ::  j      !<
-    INTEGER(iwp) ::  ja     !<
-    INTEGER(iwp) ::  jb     !<
-    INTEGER(iwp) ::  jbase  !<
-    INTEGER(iwp) ::  jc     !<
-    INTEGER(iwp) ::  jd     !<
-    INTEGER(iwp) ::  je     !<
-    INTEGER(iwp) ::  jf     !<
-    INTEGER(iwp) ::  jg     !<
-    INTEGER(iwp) ::  jh     !<
-    INTEGER(iwp) ::  jink   !<
-    INTEGER(iwp) ::  jump   !<
-    INTEGER(iwp) ::  k      !<
-    INTEGER(iwp) ::  kb     !<
-    INTEGER(iwp) ::  kc     !<
-    INTEGER(iwp) ::  kd     !<
-    INTEGER(iwp) ::  ke     !<
-    INTEGER(iwp) ::  kf     !<
-    INTEGER(iwp) ::  kstop  !<
-    INTEGER(iwp) ::  l      !<
-    INTEGER(iwp) ::  m      !<
-
-    REAL(wp) ::  a(*)      !<
-    REAL(wp) ::  b(*)      !<
-    REAL(wp) ::  c(*)      !<
-    REAL(wp) ::  d(*)      !<
-    REAL(wp) ::  trigs(*)  !<
-
-    REAL(wp) ::  c1      !<
-    REAL(wp) ::  c2      !<
-    REAL(wp) ::  c3      !<
-    REAL(wp) ::  c4      !<
-    REAL(wp) ::  c5      !<
-    REAL(wp) ::  qqrt5   !<
-    REAL(wp) ::  qrt5    !<
-    REAL(wp) ::  s1      !<
-    REAL(wp) ::  s2      !<
-    REAL(wp) ::  s3      !<
-    REAL(wp) ::  s4      !<
-    REAL(wp) ::  s5      !<
-    REAL(wp) ::  sin36   !<
-    REAL(wp) ::  sin45   !<
-    REAL(wp) ::  sin60   !<
-    REAL(wp) ::  sin72   !<
-    REAL(wp) ::  ssin36  !<
-    REAL(wp) ::  ssin45  !<
-    REAL(wp) ::  ssin60  !<
-    REAL(wp) ::  ssin72  !<
-
-    REAL(wp) ::  a10(nfft)  !<
-    REAL(wp) ::  a11(nfft)  !<
-    REAL(wp) ::  a20(nfft)  !<
-    REAL(wp) ::  a21(nfft)  !<
-    REAL(wp) ::  b10(nfft)  !<
-    REAL(wp) ::  b11(nfft)  !<
-    REAL(wp) ::  b20(nfft)  !<
-    REAL(wp) ::  b21(nfft)  !<
-
-
-    DATA  sin36/0.587785252292473_wp/, sin72/0.951056516295154_wp/,                                &
-          qrt5/0.559016994374947_wp/,  sin60/0.866025403784437_wp/
-
-
-    ierr = 0
-
-    m = n / ifac
-    iink = la * inc1
-    jink = la * inc2
-    jump = ( ifac - 1 ) * jink
-    kstop = ( n - ifac ) / ( 2 * ifac )
-
-    IF ( lot > nfft )  THEN
-       ierr = 1
-       RETURN
-    ENDIF
-    ibase = 0
-    jbase = 0
-    igo = ifac - 1
-    IF ( igo == 7 )  igo = 6
-    IF ( igo < 1  .OR.  igo > 6 )  THEN
-       ierr = 2
-       RETURN
-    ENDIF
-
-
-    SELECT CASE ( igo )
-!
-!--    Coding for factor 2
-       CASE ( 1 )
-
-          ia = 1
-          ib = ia + ( 2 * m - la ) * inc1
-          ja = 1
-          jb = ja + jink
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i) + a(ib+i)
-                   c(jb+j) = a(ia+i) - a(ib+i)
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-             ia = ia + iink
-             iink  = 2 * iink
-             ib = ib - iink
-             ibase = 0
-             jbase = jbase + jump
-             jump = 2 * jump + jink
-
-             IF ( ia /= ib )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   ibase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      !DIR$ IVDEP
-                      !CDIR NODEP
-                      !OCL NOVREC
-                      DO  ijk = 1, lot
-                         c(ja+j) = a(ia+i) + a(ib+i)
-                         d(ja+j) = b(ia+i) - b(ib+i)
-                         c(jb+j) = c1 * ( a(ia+i) - a(ib+i) ) - s1 * ( b(ia+i) + b(ib+i) )
-                         d(jb+j) = s1 * ( a(ia+i) - a(ib+i) ) + c1 * ( b(ia+i) + b(ib+i) )
-                         i = i + inc3
-                         j = j + inc4
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ia = ia + iink
-                   ib = ib - iink
-                   jbase = jbase + jump
-                ENDDO
-
-                IF ( ia > ib )  RETURN
-
-             ENDIF
-
-             ibase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i)
-                   c(jb+j) = - b(ia+i)
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = 2.0_wp * ( a(ia+i) + a(ib+i) )
-                   c(jb+j) = 2.0_wp * ( a(ia+i) - a(ib+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 3
-       CASE ( 2 )
-
-          ia = 1
-          ib = ia + ( 2 * m - la ) * inc1
-          ic = ib
-          ja = 1
-          jb = ja + jink
-          jc = jb + jink
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i) + a(ib+i)
-                   c(jb+j) = ( a(ia+i) - 0.5_wp * a(ib+i) ) - ( sin60 * ( b(ib+i) ) )
-                   c(jc+j) = ( a(ia+i) - 0.5_wp * a(ib+i) ) + ( sin60 * ( b(ib+i) ) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-             ia = ia + iink
-             iink = 2 * iink
-             ib = ib + iink
-             ic = ic - iink
-             jbase = jbase + jump
-             jump = 2 * jump + jink
-
-             IF ( ia /= ic )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   ibase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      !DIR$ IVDEP
-                      !CDIR NODEP
-                      !OCL NOVREC
-                      DO  ijk = 1, lot
-                         c(ja+j) = a(ia+i) + ( a(ib+i) + a(ic+i) )
-                         d(ja+j) = b(ia+i) + ( b(ib+i) - b(ic+i) )
-                         c(jb+j) = c1 * ( ( a(ia+i) - 0.5_wp * ( a(ib+i) + a(ic+i) ) ) - ( sin60   &
-                                   * ( b(ib+i) + b(ic+i) ) ) ) - s1 * ( ( b(ia+i) - 0.5_wp         &
-                                   * ( b(ib+i) - b(ic+i) ) ) + ( sin60 * ( a(ib+i) - a(ic+i) ) ) )
-                         d(jb+j) = s1 * ( ( a(ia+i) - 0.5_wp * ( a(ib+i) + a(ic+i) ) ) - ( sin60   &
-                                   * ( b(ib+i) + b(ic+i) ) ) ) + c1 * ( ( b(ia+i) - 0.5_wp         &
-                                   * ( b(ib+i) - b(ic+i) ) ) + ( sin60 * ( a(ib+i) - a(ic+i) ) ) )
-                         c(jc+j) = c2 * ( ( a(ia+i) - 0.5_wp * ( a(ib+i) + a(ic+i) ) ) + ( sin60   &
-                                   * ( b(ib+i) + b(ic+i) ) ) ) - s2 * ( ( b(ia+i) - 0.5_wp         &
-                                   * ( b(ib+i) - b(ic+i) ) ) - ( sin60 * ( a(ib+i) - a(ic+i) ) ) )
-                         d(jc+j) = s2 * ( ( a(ia+i) - 0.5_wp * ( a(ib+i) + a(ic+i) ) ) + ( sin60   &
-                                   * ( b(ib+i) + b(ic+i) ) ) ) + c2 * ( ( b(ia+i) - 0.5_wp         &
-                                   * ( b(ib+i) - b(ic+i) ) ) - ( sin60 * ( a(ib+i) - a(ic+i) ) ) )
-                         i = i + inc3
-                         j = j + inc4
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ia = ia + iink
-                   ib = ib + iink
-                   ic = ic - iink
-                   jbase = jbase + jump
-                ENDDO
-
-                IF ( ia > ic )  RETURN
-
-             ENDIF
-
-             ibase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i) + a(ib+i)
-                   c(jb+j) = ( 0.5_wp * a(ia+i) - a(ib+i) ) - ( sin60 * b(ia+i) )
-                   c(jc+j) = - ( 0.5_wp * a(ia+i) - a(ib+i) ) - ( sin60 * b(ia+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             ssin60 = 2.0_wp * sin60
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = 2.0_wp * ( a(ia+i) + a(ib+i) )
-                   c(jb+j) = ( 2.0_wp * a(ia+i) - a(ib+i) ) - ( ssin60 * b(ib+i) )
-                   c(jc+j) = ( 2.0_wp * a(ia+i) - a(ib+i) ) + ( ssin60 * b(ib+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 4
-       CASE ( 3 )
-
-          ia = 1
-          ib = ia + ( 2 * m - la ) * inc1
-          ic = ib + 2 * m * inc1
-          id = ib
-          ja = 1
-          jb = ja + jink
-          jc = jb + jink
-          jd = jc + jink
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = ( a(ia+i) + a(ic+i) ) + a(ib+i)
-                   c(jb+j) = ( a(ia+i) - a(ic+i) ) - b(ib+i)
-                   c(jc+j) = ( a(ia+i) + a(ic+i) ) - a(ib+i)
-                   c(jd+j) = ( a(ia+i) - a(ic+i) ) + b(ib+i)
-                   i = i + inc3
-                   j = j + inc4
-               ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-             ia    = ia + iink
-             iink  = 2 * iink
-             ib    = ib + iink
-             ic    = ic - iink
-             id    = id - iink
-             jbase = jbase + jump
-             jump  = 2 * jump + jink
-
-             IF ( ib /= ic )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   ibase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      !DIR$ IVDEP
-                      !CDIR NODEP
-                      !OCL NOVREC
-                      DO  ijk = 1, lot
-                         c(ja+j) = ( a(ia+i) + a(ic+i) ) + ( a(ib+i) + a(id+i) )
-                         d(ja+j) = ( b(ia+i) - b(ic+i) ) + ( b(ib+i) - b(id+i) )
-                         c(jc+j) = c2 * ( ( a(ia+i) + a(ic+i) ) - ( a(ib+i) + a(id+i) ) ) - s2     &
-                                   * ( ( b(ia+i) - b(ic+i) ) - ( b(ib+i) - b(id+i) ) )
-                         d(jc+j) = s2 * ( ( a(ia+i) + a(ic+i) ) - ( a(ib+i) + a(id+i) ) ) + c2     &
-                                   * ( ( b(ia+i) - b(ic+i) ) - ( b(ib+i) - b(id+i) ) )
-                         c(jb+j) = c1 * ( ( a(ia+i) - a(ic+i) ) - ( b(ib+i) + b(id+i) ) ) - s1     &
-                                   * ( ( b(ia+i) + b(ic+i) ) + ( a(ib+i) - a(id+i) ) )
-                         d(jb+j) = s1 * ( ( a(ia+i) - a(ic+i) ) - ( b (ib+i) + b(id+i) ) ) + c1    &
-                                   * ( ( b(ia+i) + b(ic+i) ) + ( a(ib+i) - a(id+i) ) )
-                         c(jd+j) = c3 * ( ( a(ia+i) - a(ic+i) ) + ( b(ib+i) + b(id+i) ) ) - s3     &
-                                   * ( ( b(ia+i) + b(ic+i) ) - ( a(ib+i) - a(id+i) ) )
-                         d(jd+j) = s3 * ( ( a(ia+i) - a(ic+i) ) + ( b(ib+i) + b(id+i) ) ) + c3     &
-                                   * ( ( b(ia+i) + b(ic+i) ) - ( a(ib+i) - a(id+i) ) )
-                         i = i + inc3
-                         j = j + inc4
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ia = ia + iink
-                   ib = ib + iink
-                   ic = ic - iink
-                   id = id - iink
-                   jbase = jbase + jump
-                ENDDO
-
-                IF ( ib > ic )  RETURN
-
-             ENDIF
-
-             ibase = 0
-             sin45 = SQRT( 0.5_wp )
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i) + a(ib+i)
-                   c(jb+j) = sin45 * ( ( a(ia+i) - a(ib+i) ) - ( b(ia+i) + b(ib+i) ) )
-                   c(jc+j) = b(ib+i) - b(ia+i)
-                   c(jd+j) = - sin45 * ( ( a(ia+i) - a(ib+i) ) + ( b(ia+i) + b(ib+i) ) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = 2.0_wp * ( ( a(ia+i) + a(ic+i) ) + a(ib+i) )
-                   c(jb+j) = 2.0_wp * ( ( a(ia+i) - a(ic+i) ) - b(ib+i) )
-                   c(jc+j) = 2.0_wp * ( ( a(ia+i) + a(ic+i) ) - a(ib+i) )
-                   c(jd+j) = 2.0_wp * ( ( a(ia+i) - a(ic+i) ) + b(ib+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 5
-       CASE ( 4 )
-
-          ia = 1
-          ib = ia + ( 2 * m - la ) * inc1
-          ic = ib + 2 * m * inc1
-          id = ic
-          ie = ib
-          ja = 1
-          jb = ja + jink
-          jc = jb + jink
-          jd = jc + jink
-          je = jd + jink
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ia+i) + ( a(ib+i) + a(ic+i) )
-                   c(jb+j) = ( ( a(ia+i) - 0.25_wp * ( a(ib+i) + a(ic+i) ) ) + qrt5 *              &
-                             ( a(ib+i) - a(ic+i) ) ) - ( sin72 * b(ib+i) + sin36 * b(ic+i) )
-                   c(jc+j) = ( ( a(ia+i) - 0.25_wp * ( a(ib+i) + a(ic+i) ) ) - qrt5 *              &
-                             ( a(ib+i) - a(ic+i) ) ) - ( sin36 * b(ib+i) - sin72 * b(ic+i) )
-                   c(jd+j) = ( ( a(ia+i) - 0.25_wp * ( a(ib+i) + a(ic+i) ) ) - qrt5 *              &
-                             ( a(ib+i) - a(ic+i) ) ) + ( sin36 * b(ib+i) - sin72 * b(ic+i) )
-                   c(je+j) = ( ( a(ia+i) - 0.25_wp * ( a(ib+i) + a(ic+i) ) ) + qrt5 *              &
-                             ( a(ib+i) - a(ic+i) ) ) + ( sin72 * b(ib+i) + sin36 * b(ic+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-             ia    = ia + iink
-             iink  = 2 * iink
-             ib    = ib + iink
-             ic    = ic + iink
-             id    = id - iink
-             ie    = ie - iink
-             jbase = jbase + jump
-             jump  = 2 * jump + jink
-
-             IF ( ib /= id )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   ke = kd + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   c4 = trigs(ke+1)
-                   s4 = trigs(ke+2)
-                   ibase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      !DIR$ IVDEP
-                      !CDIR NODEP
-                      !OCL NOVREC
-                      DO  ijk = 1, lot
-                         a10(ijk) = ( a(ia+i) - 0.25_wp * ( ( a(ib+i) + a(ie+i) ) + ( a(ic+i)      &
-                                    + a(id+i) ) ) ) + qrt5 * ( ( a(ib+i) + a(ie+i) ) - ( a(ic+i)   &
-                                    + a(id+i) ) )
-                         a20(ijk) = ( a(ia+i) - 0.25_wp * ( ( a(ib+i) + a(ie+i) ) + ( a(ic+i)      &
-                                    + a(id+i) ) ) ) - qrt5 * ( ( a(ib+i) + a(ie+i) ) - ( a(ic+i)   &
-                                    + a(id+i) ) )
-                         b10(ijk) = ( b(ia+i) - 0.25_wp * ( ( b(ib+i) - b(ie+i) ) + ( b(ic+i)      &
-                                    - b(id+i) ) ) ) + qrt5 * ( ( b(ib+i) - b(ie+i) ) - ( b(ic+i)   &
-                                    - b(id+i) ) )
-                         b20(ijk) = ( b(ia+i) - 0.25_wp * ( ( b(ib+i) - b(ie+i) ) + ( b(ic+i)      &
-                                    - b(id+i) ) ) ) - qrt5 * ( ( b(ib+i) - b(ie+i) ) - ( b(ic+i)   &
-                                    - b(id+i) ) )
-                         a11(ijk) = sin72 * ( b(ib+i) + b(ie+i) ) + sin36 * ( b(ic+i) + b(id+i) )
-                         a21(ijk) = sin36 * ( b(ib+i) + b(ie+i) ) - sin72 * ( b(ic+i) + b(id+i) )
-                         b11(ijk) = sin72 * ( a(ib+i) - a(ie+i) ) + sin36 * ( a(ic+i) - a(id+i) )
-                         b21(ijk) = sin36 * ( a(ib+i) - a(ie+i) ) - sin72 * ( a(ic+i) - a(id+i) )
-                         c(ja+j)  = a(ia+i) + ( ( a(ib+i) + a(ie+i) ) + ( a(ic+i) + a(id+i) ) )
-                         d(ja+j)  = b(ia+i) + ( ( b(ib+i) - b(ie+i) ) + ( b(ic+i) - b(id+i) ) )
-                         c(jb+j)  = c1 * ( a10(ijk) - a11(ijk) ) - s1 * ( b10(ijk) + b11(ijk) )
-                         d(jb+j)  = s1 * ( a10(ijk) - a11(ijk) ) + c1 * ( b10(ijk) + b11(ijk) )
-                         c(je+j)  = c4 * ( a10(ijk) + a11(ijk) ) - s4 * ( b10(ijk) - b11(ijk) )
-                         d(je+j)  = s4 * ( a10(ijk) + a11(ijk) ) + c4 * ( b10(ijk) - b11(ijk) )
-                         c(jc+j)  = c2 * ( a20(ijk) - a21(ijk) ) - s2 * ( b20(ijk) + b21(ijk) )
-                         d(jc+j)  = s2 * ( a20(ijk) - a21(ijk) ) + c2 * ( b20(ijk) + b21(ijk) )
-                         c(jd+j)  = c3 * ( a20(ijk) + a21(ijk) ) - s3 * ( b20(ijk) - b21(ijk) )
-                         d(jd+j)  = s3 * ( a20(ijk) + a21(ijk) ) + c3 * ( b20(ijk) - b21(ijk) )
-                         i = i + inc3
-                         j = j + inc4
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ia = ia + iink
-                   ib = ib + iink
-                   ic = ic + iink
-                   id = id - iink
-                   ie = ie - iink
-                   jbase = jbase + jump
-                ENDDO
-
-                IF ( ib > id )  RETURN
-
-             ENDIF
-
-             ibase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = ( a(ia+i) + a(ib+i) ) + a(ic+i)
-                   c(jb+j) = ( qrt5 * ( a(ia+i) - a(ib+i) ) + ( 0.25_wp * ( a(ia+i) + a(ib+i) )    &
-                             - a(ic+i) ) ) - ( sin36 * b(ia+i) + sin72 * b(ib+i) )
-                   c(je+j) = - ( qrt5 * ( a(ia+i) - a(ib+i) ) + ( 0.25_wp * ( a(ia+i) + a(ib+i) )  &
-                             - a(ic+i) ) ) - ( sin36 * b(ia+i) + sin72 * b(ib+i) )
-                   c(jc+j) = ( qrt5 * ( a(ia+i) - a(ib+i) ) - ( 0.25_wp * ( a(ia+i) + a(ib+i) )    &
-                             - a(ic+i) ) ) - ( sin72 * b(ia+i) - sin36 * b(ib+i) )
-                   c(jd+j) = - ( qrt5 * ( a(ia+i) - a(ib+i) ) - ( 0.25_wp * ( a(ia+i) + a(ib+i) )  &
-                             - a(ic+i) ) ) - ( sin72 * b(ia+i) - sin36 * b(ib+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             qqrt5  = 2.0_wp * qrt5
-             ssin36 = 2.0_wp * sin36
-             ssin72 = 2.0_wp * sin72
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = 2.0_wp * ( a(ia+i) + ( a(ib+i) + a(ic+i) ) )
-                   c(jb+j) = ( 2.0_wp * ( a(ia+i) - 0.25_wp * ( a(ib+i) + a(ic+i) ) ) + qqrt5      &
-                             * ( a(ib+i) - a(ic+i) ) ) - ( ssin72 * b(ib+i) + ssin36 * b(ic+i) )
-                   c(jc+j) = ( 2.0_wp * ( a(ia+i) - 0.25_wp * ( a(ib+i) + a(ic+i) ) ) - qqrt5      &
-                             * ( a(ib+i) - a(ic+i) ) ) - ( ssin36 * b(ib+i) - ssin72 * b(ic+i) )
-                   c(jd+j) = ( 2.0_wp * ( a(ia+i) - 0.25_wp * ( a(ib+i) + a(ic+i) ) ) - qqrt5      &
-                             * ( a(ib+i) - a(ic+i) ) ) + ( ssin36 * b(ib+i) - ssin72 * b(ic+i) )
-                   c(je+j) = ( 2.0_wp * ( a(ia+i) - 0.25_wp * ( a(ib+i) + a(ic+i) ) ) + qqrt5      &
-                             * ( a(ib+i) - a(ic+i) ) ) + (ssin72 * b(ib+i) + ssin36 * b(ic+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 6
-       CASE ( 5 )
-
-          ia = 1
-          ib = ia + ( 2 * m - la ) * inc1
-          ic = ib + 2 * m * inc1
-          id = ic + 2 * m * inc1
-          ie = ic
-          if = ib
-          ja = 1
-          jb = ja + jink
-          jc = jb + jink
-          jd = jc + jink
-          je = jd + jink
-          jf = je + jink
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = ( a (ia+i) + a(id+i) ) +  ( a(ib+i) + a(ic+i) )
-                   c(jd+j) = ( a (ia+i) - a(id+i) ) -  ( a(ib+i) - a(ic+i) )
-                   c(jb+j) = ( ( a(ia+i) - a(id+i) ) + 0.5_wp * ( a(ib+i) - a(ic+i) ) )            &
-                             - ( sin60 * ( b(ib+i) + b(ic+i) ) )
-                   c(jf+j) = ( ( a(ia+i) - a(id+i) ) + 0.5_wp * ( a(ib+i) - a(ic+i) ) )            &
-                             + ( sin60 * b(ib+i) + b(ic+i) )
-                   c(jc+j) = ( ( a(ia+i) + a(id+i) ) - 0.5_wp * ( a(ib+i) + a(ic+i) ) )            &
-                             - ( sin60 * b(ib+i) - b(ic+i) )
-                   c(je+j) = ( ( a(ia+i) + a(id+i) ) - 0.5_wp * ( a(ib+i) + a(ic+i) ) )            &
-                             + ( sin60 * b(ib+i) - b(ic+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-             ia    = ia + iink
-             iink  = 2 * iink
-             ib    = ib + iink
-             ic    = ic + iink
-             id    = id - iink
-             ie    = ie - iink
-             if    = if - iink
-             jbase = jbase + jump
-             jump  = 2 * jump + jink
-
-             IF ( ic /= id )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   ke = kd + kb
-                   kf = ke + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   c4 = trigs(ke+1)
-                   s4 = trigs(ke+2)
-                   c5 = trigs(kf+1)
-                   s5 = trigs(kf+2)
-                   ibase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      !DIR$ IVDEP
-                      !CDIR NODEP
-                      !OCL NOVREC
-                      DO  ijk = 1, lot
-                         a11(ijk) = ( a(ie+i) + a(ib+i) ) + ( a(ic+i) + a(if+i) )
-                         a20(ijk) = ( a(ia+i) + a(id+i) ) - 0.5_wp * a11(ijk)
-                         a21(ijk) = sin60 * ( ( a(ie+i) + a(ib+i) ) - ( a(ic+i) + a(if+i) ) )
-                         b11(ijk) = ( b(ib+i) - b(ie+i) ) + ( b(ic+i) - b(if+i) )
-                         b20(ijk) = ( b(ia+i) - b(id+i) ) - 0.5_wp * b11(ijk)
-                         b21(ijk) = sin60 * ( ( b(ib+i) - b(ie+i) ) - ( b(ic+i) - b(if+i) ) )
-
-                         c(ja+j) = ( a(ia+i) + a(id+i) ) + a11(ijk)
-                         d(ja+j) = ( b(ia+i) - b(id+i) ) + b11(ijk)
-                         c(jc+j) = c2 * ( a20(ijk) - b21(ijk) ) - s2 * ( b20(ijk) + a21(ijk) )
-                         d(jc+j) = s2 * ( a20(ijk) - b21(ijk) ) + c2 * ( b20(ijk) + a21(ijk) )
-                         c(je+j) = c4 * ( a20(ijk) + b21(ijk) ) - s4 * ( b20(ijk) - a21(ijk) )
-                         d(je+j) = s4 * ( a20(ijk) + b21(ijk) ) + c4 * ( b20(ijk) - a21(ijk) )
-
-                         a11(ijk) = ( a(ie+i) - a(ib+i) ) + ( a(ic+i) - a(if+i) )
-                         b11(ijk) = ( b(ie+i) + b(ib+i) ) - ( b(ic+i) + b(if+i) )
-                         a20(ijk) = ( a(ia+i) - a(id+i) ) - 0.5_wp * a11(ijk)
-                         a21(ijk) = sin60 * ( ( a(ie+i) - a(ib+i) ) - ( a(ic+i) - a(if+i) ) )
-                         b20(ijk) = ( b(ia+i) + b(id+i) ) + 0.5_wp * b11(ijk)
-                         b21(ijk) = sin60 * ( ( b(ie+i) + b(ib+i) ) + ( b(ic+i) + b(if+i) ) )
-
-                         c(jd+j) = c3 * ( (a(ia+i) - a(id+i) ) + a11(ijk) ) - s3                   &
-                                      * ( (b(ia+i) + b(id+i) ) - b11(ijk) )
-                         d(jd+j) = s3 * ( (a(ia+i) - a(id+i) ) + a11(ijk) ) + c3                   &
-                                      * ( (b(ia+i) + b(id+i) ) - b11(ijk) )
-                         c(jb+j) = c1 * ( a20(ijk) - b21(ijk) ) - s1 * ( b20(ijk) - a21(ijk) )
-                         d(jb+j) = s1 * ( a20(ijk) - b21(ijk) ) + c1 * ( b20(ijk) - a21(ijk) )
-                         c(jf+j) = c5 * ( a20(ijk) + b21(ijk) ) - s5 * ( b20(ijk) + a21(ijk) )
-                         d(jf+j) = s5 * ( a20(ijk) + b21(ijk) ) + c5 * ( b20(ijk) + a21(ijk) )
-
-                         i = i + inc3
-                         j = j + inc4
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ia = ia + iink
-                   ib = ib + iink
-                   ic = ic + iink
-                   id = id - iink
-                   ie = ie - iink
-                   if = if - iink
-                   jbase = jbase + jump
-                ENDDO
-
-                IF ( ic > id )  RETURN
-
-             ENDIF
-
-             ibase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = a(ib+i) + ( a(ia+i) + a(ic+i) )
-                   c(jd+j) = b(ib+i) - ( b(ia+i) + b(ic+i) )
-                   c(jb+j) = ( sin60 * ( a(ia+i) - a(ic+i) ) ) - ( 0.5_wp * ( b(ia+i) + b(ic+i) )  &
-                             + b(ib+i) )
-                   c(jf+j) = - ( sin60 * ( a(ia+i) - a(ic+i) ) ) - ( 0.5_wp * ( b(ia+i)            &
-                             + b(ic+i) ) + b(ib+i) )
-                   c(jc+j) = sin60 * ( b(ic+i) - b(ia+i) ) + ( 0.5_wp * ( a(ia+i) + a(ic+i) )      &
-                             - a(ib+i) )
-                   c(je+j) = sin60 * ( b(ic+i) - b(ia+i) ) - ( 0.5_wp * ( a(ia+i) + a(ic+i) )      &
-                             - a(ib+i) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             ssin60 = 2.0_wp * sin60
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                !DIR$ IVDEP
-                !CDIR NODEP
-                !OCL NOVREC
-                DO  ijk = 1, lot
-                   c(ja+j) = ( 2.0_wp * ( a(ia+i) + a(id+i) ) ) + ( 2.0_wp * ( a(ib+i) + a(ic+i) ) )
-                   c(jd+j) = ( 2.0_wp * ( a(ia+i) - a(id+i) ) ) - ( 2.0_wp * ( a(ib+i) - a(ic+i) ) )
-                   c(jb+j) = ( 2.0_wp * ( a(ia+i) - a(id+i) ) + ( a(ib+i) - a(ic+i) ) )            &
-                             - ( ssin60 * ( b(ib+i) + b(ic+i) ) )
-                   c(jf+j) = ( 2.0_wp * ( a(ia+i) - a(id+i) ) + ( a(ib+i) - a(ic+i) ) )            &
-                             + ( ssin60 * ( b(ib+i) + b(ic+i) ) )
-                   c(jc+j) = ( 2.0_wp * ( a(ia+i) + a(id+i) ) - ( a(ib+i) + a(ic+i) ) )            &
-                             - ( ssin60 * ( b(ib+i) - b(ic+i) ) )
-                   c(je+j) = ( 2.0_wp * ( a(ia+i) + a(id+i) ) - ( a(ib+i) + a(ic+i) ) )            &
-                             + ( ssin60 * ( b(ib+i) - b(ic+i) ) )
-                   i = i + inc3
-                   j = j + inc4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 8
-       CASE ( 6 )
-
-          IF ( la /= m )  THEN
-             ierr = 3
-             RETURN
-          ENDIF
-
-          ia = 1
-          ib = ia + la * inc1
-          ic = ib + 2 * la * inc1
-          id = ic + 2 * la * inc1
-          ie = id + 2 * la * inc1
-          ja = 1
-          jb = ja + jink
-          jc = jb + jink
-          jd = jc + jink
-          je = jd + jink
-          jf = je + jink
-          jg = jf + jink
-          jh = jg + jink
-          ssin45 = SQRT( 2.0_wp )
-
-          DO  l = 1, la
-             i = ibase
-             j = jbase
-             !DIR$ IVDEP
-             !CDIR NODEP
-             !OCL NOVREC
-             DO  ijk = 1, lot
-                c(ja+j) = 2.0_wp * ( ( ( a(ia+i) + a(ie+i) ) + a(ic+i) ) + ( a(ib+i) + a(id+i) ) )
-                c(je+j) = 2.0_wp * ( ( ( a(ia+i) + a(ie+i) ) + a(ic+i) ) - ( a(ib+i) + a(id+i) ) )
-                c(jc+j) = 2.0_wp * ( ( ( a(ia+i) + a(ie+i) ) - a(ic+i) ) - ( b(ib+i) - b(id+i) ) )
-                c(jg+j) = 2.0_wp * ( ( ( a(ia+i) + a(ie+i) ) - a(ic+i) ) + ( b(ib+i) - b(id+i) ) )
-                c(jb+j) = 2.0_wp * ( ( a(ia+i) - a(ie+i) ) - b(ic+i) ) + ssin45 * ( ( a(ib+i)      &
-                          - a(id+i) ) - ( b(ib+i) + b(id+i) ) )
-                c(jf+j) = 2.0_wp * ( ( a(ia+i) - a(ie+i) ) - b(ic+i) ) - ssin45 * ( ( a(ib+i)      &
-                          - a(id+i) ) - ( b(ib+i) + b(id+i) ) )
-                c(jd+j) = 2.0_wp * ( ( a(ia+i) - a(ie+i) ) + b(ic+i) ) - ssin45 * ( ( a(ib+i)      &
-                          - a(id+i) ) + ( b(ib+i) + b(id+i) ) )
-                c(jh+j) = 2.0_wp * ( ( a(ia+i) - a(ie+i) ) + b(ic+i) ) + ssin45 * ( ( a(ib+i)      &
-                          - a(id+i) ) + ( b(ib+i) + b(id+i) ) )
-                i = i + inc3
-                j = j + inc4
-             ENDDO
-             ibase = ibase + inc1
-             jbase = jbase + inc2
-          ENDDO
-
-    END SELECT
-
- END SUBROUTINE rpassm
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computes factors of n & trigonometric functins required by fft99 & fft991cy
-!> Method: Dimension trigs(n),ifax(1),jfax(10),lfax(7)
-!> Subroutine 'set99' - computes factors of n & trigonometric functins required by fft99 & fft991cy
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE set99( trigs, ifax, n )
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ifax(*)   !<
-
-    INTEGER(iwp) ::  i         !<
-    INTEGER(iwp) ::  ifac      !<
-    INTEGER(iwp) ::  ixxx      !<
-    INTEGER(iwp) ::  jfax(10)  !<
-    INTEGER(iwp) ::  k         !<
-    INTEGER(iwp) ::  l         !<
-    INTEGER(iwp) ::  lfax(7)   !<
-    INTEGER(iwp) ::  n         !<
-    INTEGER(iwp) ::  nfax      !<
-    INTEGER(iwp) ::  nhl       !<
-    INTEGER(iwp) ::  nil       !<
-    INTEGER(iwp) ::  nu        !<
-
-    REAL(wp) ::  angle         !<
-    REAL(wp) ::  del           !<
-
-    REAL(wp) ::  trigs(*)      !<
-
-    DATA  lfax / 6, 8, 5, 4, 3, 2, 1 /
-
-
-    ixxx = 1
-
-    del = 4.0_wp * ASIN( 1.0_wp ) / REAL( n, KIND = wp )
-    nil = 0
-    nhl = ( n / 2 ) - 1
-    DO  k = nil, nhl
-       angle = REAL( k, KIND = wp ) * del
-       trigs(2*k+1) = COS( angle )
-       trigs(2*k+2) = SIN( angle )
-    ENDDO
-
-!
-!-- Find factors of n (8,6,5,4,3,2; only one 8 allowed).
-!-- Look for sixes first, store factors in descending order.
-    nu   = n
-    ifac = 6
-    k    = 0
-    l    = 1
-
-    DO
-
-       IF ( MOD( nu, ifac ) == 0 )  THEN
-          k = k + 1
-          jfax(k) = ifac
-          IF ( ifac == 8  .AND.  k /= 1 )  THEN
-             jfax(1) = 8
-             jfax(k) = 6
-          ENDIF
-          nu = nu/ifac
-          IF ( nu == 1   )  EXIT
-          IF ( ifac /= 8 )  CYCLE
-       ENDIF
-
-       l = l + 1
-       ifac = lfax(l)
-       IF (ifac < 2 )  THEN
-          message_string = 'number of gridpoints along x or/and y contain illegal  factors' //     &
-                           '&only factors 2, 3, 5 are allowed'
-          CALL message( 'temperton_fft', 'PA0311', 1, 2, 0, 6, 0 )
-          RETURN
-       ENDIF
-
-    ENDDO
-!
-!-- Now reverse order of factors
-    nfax = k
-    ifax(1) = nfax
-    DO  i = 1, nfax
-       ifax(nfax+2-i) = jfax(i)
-    ENDDO
-    ifax(10) = n
-
- END SUBROUTINE set99
-
-
- SUBROUTINE fft991cy_vec( a, work, trigs, ifax, n, isign )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-
-    INTEGER(iwp) ::  i       !<
-    INTEGER(iwp) ::  ia      !<
-    INTEGER(iwp) ::  ibase   !<
-    INTEGER(iwp) ::  ierr    !<
-    INTEGER(iwp) ::  ifac    !<
-    INTEGER(iwp) ::  igo     !<
-    INTEGER(iwp) ::  ii      !<
-    INTEGER(iwp) ::  inc     !<
-    INTEGER(iwp) ::  isign   !<
-    INTEGER(iwp) ::  istart  !<
-    INTEGER(iwp) ::  ix      !<
-    INTEGER(iwp) ::  iz      !<
-    INTEGER(iwp) ::  j       !<
-    INTEGER(iwp) ::  jbase   !<
-    INTEGER(iwp) ::  jump    !<
-    INTEGER(iwp) ::  k       !<
-    INTEGER(iwp) ::  la      !<
-    INTEGER(iwp) ::  lot     !<
-    INTEGER(iwp) ::  n       !<
-    INTEGER(iwp) ::  nfax    !<
-    INTEGER(iwp) ::  nvex    !<
-    INTEGER(iwp) ::  nx      !<
-
-    INTEGER(iwp),DIMENSION(:),INTENT(IN) ::  ifax  !<
-
-    REAL(wp),DIMENSION(:,:) ::  a      !<
-    REAL(wp),DIMENSION(:)   ::  trigs  !<
-    REAL(wp),DIMENSION(:,:) ::  work   !<
-
-
-    inc  = 1
-    jump = n
-    lot  = 1
-
-    IF ( ifax(10) /= n )  CALL set99( trigs, ifax, n )
-    nfax = ifax(1)
-    nx   = n + 1
-    IF ( MOD( n, 2 ) == 1 )  nx = n
-    nvex = 1
-
-    IF ( isign == 1 )  THEN
-!
-!--    Backward fft: spectral to gridpoint transform
-
-       istart = 1
-       ia = istart
-       i = istart
-       a(:,i+inc) = 0.5_wp * a(:,i)
-       IF ( MOD( n, 2 ) /= 1 )  THEN
-          i = istart + n * inc
-          a(:,i) = 0.5_wp * a(:,i)
-       ENDIF
-       ia = istart + inc
-       la = 1
-       igo = + 1
-
-       DO  k = 1, nfax
-
-          ifac = ifax(k+1)
-          ierr = -1
-          IF ( igo /= -1 )  THEN
-             CALL rpassm_vec( a(:,ia:), a(:,ia+la*inc:), work, work(:,ifac*la+1:), trigs, inc, 1,  &
-                              n, ifac, la, ierr )
-          ELSE
-             CALL rpassm_vec( work, work(:,la+1:), a(:,ia:), a(:,ia+ifac*la*inc:), trigs, 1, inc,  &
-                              n, ifac, la, ierr )
-          ENDIF
-!
-!--       Following messages shouldn't appear in PALM applications
-          IF ( ierr /= 0 )  THEN
-             SELECT CASE (ierr)
-                CASE (:-1)
-                   WRITE (nout,'(A,I5,A)') ' Vector length =',nvex,', greater than nfft'
-                CASE (0)
-                   WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', not catered for'
-                CASE (1:)
-                   WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', only catered for if la*ifac=n'
-             END SELECT
-             RETURN
-          ENDIF
-
-          la  = ifac * la
-          igo = -igo
-          ia  = istart
-
-       ENDDO
-!
-!--    If necessary, copy results back to a
-       IF ( MOD( nfax, 2 ) /= 0 )  THEN
-          ibase = 1
-          jbase = ia
-          i = ibase
-          j = jbase
-          DO  ii = 1, n
-             a(:,j) = work(:,i)
-             i = i + 1
-             j = j + inc
-          ENDDO
-       ENDIF
-!
-!--    Fill in zeros at end
-       ix = istart + n * inc
-       a(:,ix) = 0.0_wp
-       a(:,ix+inc) = 0.0_wp
-
-    ELSEIF ( isign == -1 )  THEN
-!
-!--    Forward fft: gridpoint to spectral transform
-       istart = 1
-       ia  = istart
-       la  = n
-       igo = + 1
-
-       DO  k = 1, nfax
-
-          ifac = ifax(nfax+2-k)
-          la = la / ifac
-          ierr = -1
-
-          IF ( igo /= -1 )  THEN
-             CALL qpassm_vec( a(:,ia:), a(:,ia+ifac*la*inc:), work, work(:,la+1:), trigs, inc, 1,  &
-                              n, ifac, la, ierr )
-          ELSE
-             CALL qpassm_vec( work, work(:,ifac*la+1:), a(:,ia:), a(:,ia+la*inc:), trigs, 1, inc,  &
-                              n, ifac, la, ierr )
-          ENDIF
-
-!
-!--       Following messages shouldn't appear in PALM applications
-          IF ( ierr /= 0 )  THEN
-             SELECT CASE (ierr)
-                CASE (0)
-                   WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', not catered for'
-                CASE (1:)
-                   WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', only catered for if la*ifac=n'
-             END SELECT
-             RETURN
-          ENDIF
-
-          igo = -igo
-          ia = istart + inc
-
-       ENDDO
-!
-!--    If necessary, copy results back to a
-       IF ( MOD( nfax, 2 ) /= 0 )  THEN
-          ibase = 1
-          jbase = ia
-          i = ibase
-          j = jbase
-          DO  ii = 1, n
-             a(:,j) = work(:,i)
-             i = i + 1
-             j = j + inc
-          ENDDO
-       ENDIF
-!
-!--    Shift a(0) and fill in zero imag parts
-       ix = istart
-       a(:,ix) = a(:,ix+inc)
-       a(:,ix+inc) = 0.0_wp
-
-       IF ( MOD( n, 2 ) /= 1 )  THEN
-          iz = istart + ( n + 1 ) * inc
-          a(:,iz) = 0.0_wp
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE fft991cy_vec
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Performs one pass through data as part of multiple real fft (fourier analysis) routine.
-!>
-!> Method:
-!>
-!> a       is first real input vector
-!>         equivalence b(1) with a(ifac*la*inc1+1)
-!> c       is first real output vector
-!>         equivalence d(1) with c(la*inc2+1)
-!> trigs   is a precalculated list of sines & cosines
-!> inc1    is the addressing increment for a
-!> inc2    is the addressing increment for c
-!> inc3    is the increment between input vectors a
-!> inc4    is the increment between output vectors c
-!> lot     is the number of vectors
-!> n       is the length of the vectors
-!> ifac    is the current factor of n
-!>         la = n/(product of factors used so far)
-!> ierr    is an error indicator:
-!>         0 - pass completed without error
-!>         1 - lot greater than nfft
-!>         2 - ifac not catered for
-!>         3 - ifac only catered for if la=n/ifac
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE qpassm_vec( a, b, c, d, trigs, inc1, inc2, n, ifac, la, ierr )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp),INTENT(IN)  ::  ifac  !<
-    INTEGER(iwp),INTENT(IN)  ::  inc1  !<
-    INTEGER(iwp),INTENT(IN)  ::  inc2  !<
-    INTEGER(iwp),INTENT(IN)  ::  la    !<
-    INTEGER(iwp),INTENT(IN)  ::  n     !<
-
-    INTEGER(iwp),INTENT(OUT) ::  ierr  !<
-
-    INTEGER(iwp) ::  i      !<
-    INTEGER(iwp) ::  ia     !<
-    INTEGER(iwp) ::  ib     !<
-    INTEGER(iwp) ::  ibase  !<
-    INTEGER(iwp) ::  ic     !<
-    INTEGER(iwp) ::  id     !<
-    INTEGER(iwp) ::  ie     !<
-    INTEGER(iwp) ::  if     !<
-    INTEGER(iwp) ::  ig     !<
-    INTEGER(iwp) ::  igo    !<
-    INTEGER(iwp) ::  ih     !<
-    INTEGER(iwp) ::  iink   !<
-    INTEGER(iwp) ::  ijump  !<
-    INTEGER(iwp) ::  ipl    !<  loop index parallel loop
-    INTEGER(iwp) ::  j      !<
-    INTEGER(iwp) ::  ja     !<
-    INTEGER(iwp) ::  jb     !<
-    INTEGER(iwp) ::  jbase  !<
-    INTEGER(iwp) ::  jc     !<
-    INTEGER(iwp) ::  jd     !<
-    INTEGER(iwp) ::  je     !<
-    INTEGER(iwp) ::  jf     !<
-    INTEGER(iwp) ::  jink   !<
-    INTEGER(iwp) ::  k      !<
-    INTEGER(iwp) ::  kb     !<
-    INTEGER(iwp) ::  kc     !<
-    INTEGER(iwp) ::  kd     !<
-    INTEGER(iwp) ::  ke     !<
-    INTEGER(iwp) ::  kf     !<
-    INTEGER(iwp) ::  kstop  !<
-    INTEGER(iwp) ::  l      !<
-    INTEGER(iwp) ::  m      !<
-
-!
-!-- Arrays are dimensioned with n
-    REAL(wp),DIMENSION(:,:) ::  a  !<
-    REAL(wp),DIMENSION(:,:) ::  b  !<
-    REAL(wp),DIMENSION(:,:) ::  c  !<
-    REAL(wp),DIMENSION(:,:) ::  d  !<
-
-    REAL(wp),DIMENSION(:),INTENT(IN) ::  trigs  !<
-
-    REAL(wp) ::  a0      !<
-    REAL(wp) ::  a1      !<
-    REAL(wp) ::  a10     !<
-    REAL(wp) ::  a11     !<
-    REAL(wp) ::  a2      !<
-    REAL(wp) ::  a20     !<
-    REAL(wp) ::  a21     !<
-    REAL(wp) ::  a3      !<
-    REAL(wp) ::  a4      !<
-    REAL(wp) ::  a5      !<
-    REAL(wp) ::  a6      !<
-    REAL(wp) ::  b0      !<
-    REAL(wp) ::  b1      !<
-    REAL(wp) ::  b10     !<
-    REAL(wp) ::  b11     !<
-    REAL(wp) ::  b2      !<
-    REAL(wp) ::  b20     !<
-    REAL(wp) ::  b21     !<
-    REAL(wp) ::  b3      !<
-    REAL(wp) ::  b4      !<
-    REAL(wp) ::  b5      !<
-    REAL(wp) ::  b6      !<
-    REAL(wp) ::  c1      !<
-    REAL(wp) ::  c2      !<
-    REAL(wp) ::  c3      !<
-    REAL(wp) ::  c4      !<
-    REAL(wp) ::  c5      !<
-    REAL(wp) ::  qrt5    !<
-    REAL(wp) ::  s1      !<
-    REAL(wp) ::  s2      !<
-    REAL(wp) ::  s3      !<
-    REAL(wp) ::  s4      !<
-    REAL(wp) ::  s5      !<
-    REAL(wp) ::  sin36   !<
-    REAL(wp) ::  sin45   !<
-    REAL(wp) ::  sin60   !<
-    REAL(wp) ::  sin72   !<
-    REAL(wp) ::  z       !<
-    REAL(wp) ::  zqrt5   !<
-    REAL(wp) ::  zsin36  !<
-    REAL(wp) ::  zsin45  !<
-    REAL(wp) ::  zsin60  !<
-    REAL(wp) ::  zsin72  !<
-
-
-
-    DATA  sin36/0.587785252292473_wp/, sin72/0.951056516295154_wp/,                                &
-          qrt5/0.559016994374947_wp/,  sin60/0.866025403784437_wp/
-
-
-    ierr = 0
-
-    m = n / ifac
-    iink  = la * inc1
-    jink  = la * inc2
-    ijump = ( ifac - 1 ) * iink
-    kstop = ( n - ifac ) / ( 2 * ifac )
-
-    ibase = 0
-    jbase = 0
-    igo = ifac - 1
-    IF ( igo == 7 )  igo = 6
-
-    IF (igo < 1 .OR. igo > 6 )  THEN
-       ierr = 2
-       RETURN
-    ENDIF
-
-
-    SELECT CASE ( igo )
-
-!
-!--    Coding for factor 2
-       CASE ( 1 )
-          ia = 1
-          ib = ia + iink
-          ja = 1
-          jb = ja + ( 2 * m - la ) * inc2
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i         = ibase
-                j         = jbase
-                c(:,ja+j) = a(:,ia+i) + a(:,ib+i)
-                c(:,jb+j) = a(:,ia+i) - a(:,ib+i)
-                ibase     = ibase + inc1
-                jbase     = jbase + inc2
-             ENDDO
-
-             ja    = ja + jink
-             jink  = 2 * jink
-             jb    = jb - jink
-             ibase = ibase + ijump
-             ijump = 2 * ijump + iink
-
-             IF ( ja /= jb )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   jbase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      c(:,ja+j) = a(:,ia+i) + ( c1 * a(:,ib+i) + s1 * b(:,ib+i) )
-                      c(:,jb+j) = a(:,ia+i) - ( c1 * a(:,ib+i) + s1 * b(:,ib+i) )
-                      d(:,ja+j) = ( c1 * b(:,ib+i) - s1 * a(:,ib+i) ) + b(:,ia+i)
-                      d(:,jb+j) = ( c1 * b(:,ib+i) - s1 * a(:,ib+i) ) - b(:,ia+i)
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-
-                   ibase = ibase + ijump
-                   ja = ja + jink
-                   jb = jb - jink
-                ENDDO
-
-                IF ( ja > jb )  RETURN
-
-             ENDIF
-
-             jbase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = a(:,ia+i)
-                d(:,ja+j) = -a(:,ib+i)
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             z = 1.0_wp / REAL( n, KIND = wp )
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = z * ( a(:,ia+i) + a(:,ib+i) )
-                c(:,jb+j) = z * ( a(:,ia+i) - a(:,ib+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 3
-       CASE ( 2 )
-
-          ia = 1
-          ib = ia + iink
-          ic = ib + iink
-          ja = 1
-          jb = ja + ( 2 * m - la ) * inc2
-          jc = jb
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i         = ibase
-                j         = jbase
-                c(:,ja+j) = a(:,ia+i) + ( a(:,ib+i) + a(:,ic+i) )
-                c(:,jb+j) = a(:,ia+i) - 0.5_wp * ( a(:,ib+i) + a(:,ic+i) )
-                d(:,jb+j) = sin60 * ( a(:,ic+i) - a(:,ib+i) )
-                ibase     = ibase + inc1
-                jbase     = jbase + inc2
-             ENDDO
-
-             ja    = ja + jink
-             jink  = 2 * jink
-             jb    = jb + jink
-             jc    = jc - jink
-             ibase = ibase + ijump
-             ijump = 2 * ijump + iink
-
-             IF ( ja /= jc )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-
-                   jbase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      DO  ipl = 1, SIZE( a, 1 )
-                         a1 = ( c1 * a(ipl,ib+i) + s1 * b(ipl,ib+i) )                              &
-                            + ( c2 * a(ipl,ic+i) + s2 * b(ipl,ic+i) )
-                         b1 = ( c1 * b(ipl,ib+i) - s1 * a(ipl,ib+i) )                              &
-                            + ( c2 * b(ipl,ic+i) - s2 * a(ipl,ic+i) )
-                         a2 = a(ipl,ia+i) - 0.5_wp * a1
-                         b2 = b(ipl,ia+i) - 0.5_wp * b1
-                         a3 = sin60 * ( ( c1 * a(ipl,ib+i) + s1 * b(ipl,ib+i) )                    &
-                                      - ( c2 * a(ipl,ic+i) + s2 * b(ipl,ic+i) ) )
-                         b3 = sin60 * ( ( c1 * b(ipl,ib+i) - s1 * a(ipl,ib+i) )                    &
-                                      - ( c2 * b(ipl,ic+i) - s2 * a(ipl,ic+i) ) )
-                         c(ipl,ja+j) = a(ipl,ia+i) + a1
-                         d(ipl,ja+j) = b(ipl,ia+i) + b1
-                         c(ipl,jb+j) = a2 + b3
-                         d(ipl,jb+j) = b2 - a3
-                         c(ipl,jc+j) = a2 - b3
-                         d(ipl,jc+j) = - ( b2 + a3 )
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ibase = ibase + ijump
-                   ja    = ja + jink
-                   jb    = jb + jink
-                   jc    = jc - jink
-                ENDDO
-
-                IF ( ja > jc )  RETURN
-
-             ENDIF
-
-             jbase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = a(:,ia+i) + 0.5_wp * ( a(:,ib+i) - a(:,ic+i) )
-                d(:,ja+j) = - sin60 * ( a(:,ib+i) + a(:,ic+i) )
-                c(:,jb+j) = a(:,ia+i) - ( a(:,ib+i) - a(:,ic+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             z = 1.0_wp / REAL( n, KIND = wp )
-             zsin60 = z * sin60
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = z * ( a(:,ia+i) + ( a(:,ib+i) + a(:,ic+i) ) )
-                c(:,jb+j) = z * ( a(:,ia+i) - 0.5_wp * ( a(:,ib+i) + a(:,ic+i) ) )
-                d(:,jb+j) = zsin60 * ( a(:,ic+i) - a(:,ib+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 4
-       CASE ( 3 )
-
-          ia = 1
-          ib = ia + iink
-          ic = ib + iink
-          id = ic + iink
-          ja = 1
-          jb = ja + ( 2 * m - la ) * inc2
-          jc = jb + 2 * m * inc2
-          jd = jb
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = ( a(:,ia+i) + a(:,ic+i) ) + ( a(:,ib+i) + a(:,id+i) )
-                c(:,jc+j) = ( a(:,ia+i) + a(:,ic+i) ) - ( a(:,ib+i) + a(:,id+i) )
-                c(:,jb+j) = a(:,ia+i) - a(:,ic+i)
-                d(:,jb+j) = a(:,id+i) - a(:,ib+i)
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-             ja    = ja + jink
-             jink  = 2 * jink
-             jb    = jb + jink
-             jc    = jc - jink
-             jd    = jd - jink
-             ibase = ibase + ijump
-             ijump = 2 * ijump + iink
-
-             IF ( jb /= jc )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   jbase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      DO  ipl = 1, SIZE( a, 1 )
-                         a0 = a(ipl,ia+i) + ( c2 * a(ipl,ic+i) + s2 * b(ipl,ic+i) )
-                         a2 = a(ipl,ia+i) - ( c2 * a(ipl,ic+i) + s2 * b(ipl,ic+i) )
-                         a1 = ( c1 * a(ipl,ib+i) + s1 * b(ipl,ib+i) )                              &
-                            + ( c3 * a(ipl,id+i) + s3 * b(ipl,id+i) )
-                         a3 = ( c1 * a(ipl,ib+i) + s1 * b(ipl,ib+i) )                              &
-                            - ( c3 * a(ipl,id+i) + s3 * b(ipl,id+i) )
-                         b0 = b(ipl,ia+i) + ( c2 * b(ipl,ic+i) - s2 * a(ipl,ic+i) )
-                         b2 = b(ipl,ia+i) - ( c2 * b(ipl,ic+i) - s2 * a(ipl,ic+i) )
-                         b1 = ( c1 * b(ipl,ib+i) - s1 * a(ipl,ib+i) )                              &
-                            + ( c3 * b(ipl,id+i) - s3 * a(ipl,id+i) )
-                         b3 = ( c1 * b(ipl,ib+i) - s1 * a(ipl,ib+i) )                              &
-                            - ( c3 * b(ipl,id+i) - s3 * a(ipl,id+i) )
-                         c(ipl,ja+j) = a0 + a1
-                         c(ipl,jc+j) = a0 - a1
-                         d(ipl,ja+j) = b0 + b1
-                         d(ipl,jc+j) = b1 - b0
-                         c(ipl,jb+j) = a2 + b3
-                         c(ipl,jd+j) = a2 - b3
-                         d(ipl,jb+j) = b2 - a3
-                         d(ipl,jd+j) = - ( b2 + a3 )
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ibase = ibase + ijump
-                   ja = ja + jink
-                   jb = jb + jink
-                   jc = jc - jink
-                   jd = jd - jink
-                ENDDO
-
-                IF ( jb > jc )  RETURN
-
-             ENDIF
-
-             sin45 = SQRT( 0.5_wp )
-             jbase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) =   a(:,ia+i) + sin45 * ( a(:,ib+i) - a(:,id+i) )
-                c(:,jb+j) =   a(:,ia+i) - sin45 * ( a(:,ib+i) - a(:,id+i) )
-                d(:,ja+j) = - a(:,ic+i) - sin45 * ( a(:,ib+i) + a(:,id+i) )
-                d(:,jb+j) =   a(:,ic+i) - sin45 * ( a(:,ib+i) + a(:,id+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             z = 1.0_wp / REAL( n, KIND = wp )
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = z * ( ( a(:,ia+i) + a(:,ic+i) ) + ( a(:,ib+i) + a(:,id+i) ) )
-                c(:,jc+j) = z * ( ( a(:,ia+i) + a(:,ic+i) ) - ( a(:,ib+i) + a(:,id+i) ) )
-                c(:,jb+j) = z * ( a(:,ia+i) - a(:,ic+i) )
-                d(:,jb+j) = z * ( a(:,id+i) - a(:,ib+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 5
-       CASE ( 4 )
-
-          ia = 1
-          ib = ia + iink
-          ic = ib + iink
-          id = ic + iink
-          ie = id + iink
-          ja = 1
-          jb = ja + ( 2 * m - la ) * inc2
-          jc = jb + 2 * m * inc2
-          jd = jc
-          je = jb
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                DO  ipl = 1, SIZE( a, 1 )
-                   a1 = a(ipl,ib+i) + a(ipl,ie+i)
-                   a3 = a(ipl,ib+i) - a(ipl,ie+i)
-                   a2 = a(ipl,ic+i) + a(ipl,id+i)
-                   a4 = a(ipl,ic+i) - a(ipl,id+i)
-                   a5 = a(ipl,ia+i) - 0.25_wp * ( a1 + a2 )
-                   a6 = qrt5 * ( a1 - a2 )
-                   c(ipl,ja+j) = a(ipl,ia+i) + ( a1 + a2 )
-                   c(ipl,jb+j) = a5 + a6
-                   c(ipl,jc+j) = a5 - a6
-                   d(ipl,jb+j) = - sin72 * a3 - sin36 * a4
-                   d(ipl,jc+j) = - sin36 * a3 + sin72 * a4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-             ja    = ja + jink
-             jink  = 2 * jink
-             jb    = jb + jink
-             jc    = jc + jink
-             jd    = jd - jink
-             je    = je - jink
-             ibase = ibase + ijump
-             ijump = 2 * ijump + iink
-
-             IF ( jb /= jd )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   ke = kd + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   c4 = trigs(ke+1)
-                   s4 = trigs(ke+2)
-                   jbase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      DO  ipl = 1, SIZE(a,1)
-                         a1 = ( c1 * a(ipl,ib+i) + s1 * b(ipl,ib+i) ) + ( c4 * a(ipl,ie+i) + s4    &
-                              * b(ipl,ie+i) )
-                         a3 = ( c1 * a(ipl,ib+i) + s1 * b(ipl,ib+i) ) - ( c4 * a(ipl,ie+i) + s4    &
-                              * b(ipl,ie+i) )
-                         a2 = ( c2 * a(ipl,ic+i) + s2 * b(ipl,ic+i) ) + ( c3 * a(ipl,id+i) + s3    &
-                              * b(ipl,id+i) )
-                         a4 = ( c2 * a(ipl,ic+i) + s2 * b(ipl,ic+i) ) - ( c3 * a(ipl,id+i) + s3    &
-                              * b(ipl,id+i) )
-
-                         b1 = ( c1 * b(ipl,ib+i) - s1 * a(ipl,ib+i) ) + ( c4 * b(ipl,ie+i) - s4    &
-                              * a(ipl,ie+i) )
-                         b3 = ( c1 * b(ipl,ib+i) - s1 * a(ipl,ib+i) ) - ( c4 * b(ipl,ie+i) - s4    &
-                              * a(ipl,ie+i) )
-                         b2 = ( c2 * b(ipl,ic+i) - s2 * a(ipl,ic+i) ) + ( c3 * b(ipl,id+i) - s3    &
-                              * a(ipl,id+i) )
-                         b4 = ( c2 * b(ipl,ic+i) - s2 * a(ipl,ic+i) ) - ( c3 * b(ipl,id+i) - s3    &
-                              * a(ipl,id+i) )
-
-                         a5 = a(ipl,ia+i) - 0.25_wp * ( a1 + a2 )
-                         a6 = qrt5 * ( a1 - a2 )
-                         b5 = b(ipl,ia+i) - 0.25_wp * ( b1 + b2 )
-                         b6 = qrt5 * ( b1 - b2)
-
-                         a10 = a5 + a6
-                         a20 = a5 - a6
-                         b10 = b5 + b6
-                         b20 = b5 - b6
-                         a11 = sin72 * b3 + sin36 * b4
-                         a21 = sin36 * b3 - sin72 * b4
-
-                         b11 = sin72 * a3 + sin36 * a4
-                         b21 = sin36 * a3 - sin72 * a4
-
-                         c(ipl,ja+j) = a(ipl,ia+i) + ( a1 + a2 )
-                         c(ipl,jb+j) = a10 + a11
-                         c(ipl,je+j) = a10 - a11
-                         c(ipl,jc+j) = a20 + a21
-                         c(ipl,jd+j) = a20 - a21
-
-                         d(ipl,ja+j) = b(ipl,ia+i) + ( b1 + b2 )
-                         d(ipl,jb+j) = b10 - b11
-                         d(ipl,je+j) = - ( b10 + b11 )
-                         d(ipl,jc+j) = b20 - b21
-                         d(ipl,jd+j) = - ( b20 + b21 )
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ibase = ibase + ijump
-                   ja    = ja + jink
-                   jb    = jb + jink
-                   jc    = jc + jink
-                   jd    = jd - jink
-                   je    = je - jink
-                ENDDO
-
-                IF ( jb > jd )  RETURN
-
-             ENDIF
-
-             jbase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                DO  ipl = 1, SIZE( a, 1 )
-                   a1 = a(ipl,ib+i) + a(ipl,ie+i)
-                   a3 = a(ipl,ib+i) - a(ipl,ie+i)
-                   a2 = a(ipl,ic+i) + a(ipl,id+i)
-                   a4 = a(ipl,ic+i) - a(ipl,id+i)
-                   a5 = a(ipl,ia+i) + 0.25_wp * ( a3 - a4 )
-                   a6 = qrt5 * ( a3 + a4 )
-
-                   c(ipl,ja+j) = a5 + a6
-                   c(ipl,jb+j) = a5 - a6
-                   c(ipl,jc+j) = a(ipl,ia+i) - ( a3 - a4 )
-
-                   d(ipl,ja+j) = - sin36 * a1 - sin72 * a2
-                   d(ipl,jb+j) = - sin72 * a1 + sin36 * a2
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             z = 1.0_wp / REAL( n, KIND = wp )
-             zqrt5  = z * qrt5
-             zsin36 = z * sin36
-             zsin72 = z * sin72
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                DO  ipl = 1, SIZE( a, 1 )
-                   a1 = a(ipl,ib+i) + a(ipl,ie+i)
-                   a3 = a(ipl,ib+i) - a(ipl,ie+i)
-                   a2 = a(ipl,ic+i) + a(ipl,id+i)
-                   a4 = a(ipl,ic+i) - a(ipl,id+i)
-                   a5 = z * ( a(ipl,ia+i) - 0.25_wp * ( a1 + a2 ) )
-                   a6 = zqrt5 * ( a1 - a2 )
-
-                   c(ipl,ja+j) = z * ( a(ipl,ia+i) + ( a1 + a2 ) )
-                   c(ipl,jb+j) = a5 + a6
-                   c(ipl,jc+j) = a5 - a6
-
-                   d(ipl,jb+j) = - zsin72 * a3 - zsin36 * a4
-                   d(ipl,jc+j) = - zsin36 * a3 + zsin72 * a4
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 6
-       CASE ( 5 )
-
-          ia = 1
-          ib = ia + iink
-          ic = ib + iink
-          id = ic + iink
-          ie = id + iink
-          if = ie + iink
-          ja = 1
-          jb = ja + ( 2 * m - la ) * inc2
-          jc = jb + 2 * m * inc2
-          jd = jc + 2 * m * inc2
-          je = jc
-          jf = jb
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                DO  ipl = 1, SIZE( a, 1 )
-                   a11         = ( a(ipl,ic+i) + a(ipl,if+i) ) + ( a(ipl,ib+i) + a(ipl,ie+i) )
-                   c(ipl,ja+j) = ( a(ipl,ia+i) + a(ipl,id+i) ) + a11
-                   c(ipl,jc+j) = ( a(ipl,ia+i) + a(ipl,id+i) - 0.5_wp * a11 )
-                   d(ipl,jc+j) = sin60 * ( ( a(ipl,ic+i) + a(ipl,if+i) ) -                         &
-                                 ( a(ipl,ib+i) + a(ipl,ie+i) ) )
-                   a11         = ( a(ipl,ic+i) - a(ipl,if+i) ) + ( a(ipl,ie+i) - a(ipl,ib+i) )
-                   c(ipl,jb+j) = ( a(ipl,ia+i) - a(ipl,id+i) ) - 0.5_wp * a11
-                   d(ipl,jb+j) = sin60 * ( ( a(ipl,ie+i) - a(ipl,ib+i) ) -                         &
-                                 ( a(ipl,ic+i) - a(ipl,if+i) ) )
-                   c(ipl,jd+j) = ( a(ipl,ia+i) - a(ipl,id+i) ) + a11
-                END DO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-             ja = ja + jink
-             jink = 2 * jink
-             jb = jb + jink
-             jc = jc + jink
-             jd = jd - jink
-             je = je - jink
-             jf = jf - jink
-             ibase = ibase + ijump
-             ijump = 2 * ijump + iink
-
-             IF ( jc /= jd )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   ke = kd + kb
-                   kf = ke + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   c4 = trigs(ke+1)
-                   s4 = trigs(ke+2)
-                   c5 = trigs(kf+1)
-                   s5 = trigs(kf+2)
-                   jbase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      DO  ipl = 1, SIZE( a, 1 )
-                         a1 = c1 * a(ipl,ib+i) + s1 * b(ipl,ib+i)
-                         b1 = c1 * b(ipl,ib+i) - s1 * a(ipl,ib+i)
-                         a2 = c2 * a(ipl,ic+i) + s2 * b(ipl,ic+i)
-                         b2 = c2 * b(ipl,ic+i) - s2 * a(ipl,ic+i)
-                         a3 = c3 * a(ipl,id+i) + s3 * b(ipl,id+i)
-                         b3 = c3 * b(ipl,id+i) - s3 * a(ipl,id+i)
-                         a4 = c4 * a(ipl,ie+i) + s4 * b(ipl,ie+i)
-                         b4 = c4 * b(ipl,ie+i) - s4 * a(ipl,ie+i)
-                         a5 = c5 * a(ipl,if+i) + s5 * b(ipl,if+i)
-                         b5 = c5 * b(ipl,if+i) - s5 * a(ipl,if+i)
-                         a11 = ( a2 + a5 ) + ( a1 + a4 )
-                         a20 = ( a(ipl,ia+i) + a3 ) - 0.5_wp * a11
-                         a21 = sin60 * ( ( a2 + a5 ) - ( a1 + a4 ) )
-                         b11 = ( b2 + b5 ) + ( b1 + b4 )
-                         b20 = ( b(ipl,ia+i) + b3 ) - 0.5_wp * b11
-                         b21 = sin60 * ( ( b2 + b5 ) - ( b1 + b4 ) )
-                         c(ipl,ja+j) = ( a(ipl,ia+i) + a3 ) + a11
-                         d(ipl,ja+j) = ( b(ipl,ia+i) + b3 ) + b11
-                         c(ipl,jc+j) = a20 - b21
-                         d(ipl,jc+j) = a21 + b20
-                         c(ipl,je+j) = a20 + b21
-                         d(ipl,je+j) = a21 - b20
-                         a11 = ( a2 - a5 ) + ( a4 - a1 )
-                         a20 = ( a(ipl,ia+i) - a3 ) - 0.5_wp * a11
-                         a21 = sin60 * ( ( a4 - a1 ) - ( a2 - a5 ) )
-                         b11 = ( b5 - b2 ) - ( b4 - b1 )
-                         b20 = ( b3 - b(ipl,ia+i) ) - 0.5_wp * b11
-                         b21 = sin60 * ( ( b5 - b2 ) + ( b4 - b1 ) )
-                         c(ipl,jb+j) = a20 - b21
-                         d(ipl,jb+j) = a21 - b20
-                         c(ipl,jd+j) = a11 + ( a(ipl,ia+i) - a3 )
-                         d(ipl,jd+j) = b11 + ( b3 - b(ipl,ia+i) )
-                         c(ipl,jf+j) = a20 + b21
-                         d(ipl,jf+j) = a21 + b20
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ibase = ibase + ijump
-                   ja = ja + jink
-                   jb = jb + jink
-                   jc = jc + jink
-                   jd = jd - jink
-                   je = je - jink
-                   jf = jf - jink
-                ENDDO
-
-                IF ( jc > jd )  RETURN
-
-             ENDIF
-
-             jbase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = ( a(:,ia+i) + 0.5_wp * ( a(:,ic+i) - a(:,ie+i) ) ) + sin60             &
-                          * ( a(:,ib+i) - a(:,if+i) )
-                d(:,ja+j) = - ( a(:,id+i) + 0.5_wp * ( a(:,ib+i) + a(:,if+i) ) ) - sin60           &
-                            * ( a(:,ic+i) + a(:,ie+i) )
-                c(:,jb+j) = a(:,ia+i) - ( a(:,ic+i) - a(:,ie+i) )
-                d(:,jb+j) = a(:,id+i) - ( a(:,ib+i) + a(:,if+i) )
-                c(:,jc+j) = ( a(:,ia+i) + 0.5_wp * ( a(:,ic+i) - a(:,ie+i) ) ) - sin60             &
-                          * ( a(:,ib+i) - a(:,if+i) )
-                d(:,jc+j) = - ( a(:,id+i) + 0.5_wp * ( a(:,ib+i) + a(:,if+i) ) ) + sin60           &
-                            * ( a(:,ic+i) + a(:,ie+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             z = 1.0_wp / REAL( n, KIND = wp )
-             zsin60 = z * sin60
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                DO  ipl = 1, SIZE( a, 1 )
-                   a11 = ( a (ipl,ic+i) + a(ipl,if+i) ) + ( a(ipl,ib+i) + a(ipl,ie+i) )
-                   c(ipl,ja+j) = z * ( ( a(ipl,ia+i) + a(ipl,id+i) ) + a11 )
-                   c(ipl,jc+j) = z * ( ( a(ipl,ia+i) + a(ipl,id+i) ) - 0.5_wp * a11 )
-                   d(ipl,jc+j) = zsin60 * ( ( a(ipl,ic+i) + a(ipl,if+i) )                          &
-                                          - ( a(ipl,ib+i) + a(ipl,ie+i) ) )
-                   a11 = ( a(ipl,ic+i) - a(ipl,if+i) )  + ( a(ipl,ie+i) - a(ipl,ib+i) )
-                   c(ipl,jb+j) = z * ( ( a(ipl,ia+i) - a(ipl,id+i) ) - 0.5_wp * a11 )
-                   d(ipl,jb+j) = zsin60 * ( ( a(ipl,ie+i) - a(ipl,ib+i) )                          &
-                                          - ( a(ipl,ic+i) - a(ipl,if+i) ) )
-                   c(ipl,jd+j) = z * ( ( a(ipl,ia+i) - a(ipl,id+i) ) + a11 )
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 8
-       CASE ( 6 )
-
-          IF ( la /= m )  THEN
-             ierr = 3
-             RETURN
-          ENDIF
-
-          ia = 1
-          ib = ia + iink
-          ic = ib + iink
-          id = ic + iink
-          ie = id + iink
-          if = ie + iink
-          ig = if + iink
-          ih = ig + iink
-          ja = 1
-          jb = ja + la * inc2
-          jc = jb + 2 * m * inc2
-          jd = jc + 2 * m * inc2
-          je = jd + 2 * m * inc2
-          z = 1.0_wp / REAL( n, KIND = wp )
-          zsin45 = z * SQRT( 0.5_wp )
-
-          DO  l = 1, la
-             i = ibase
-             j = jbase
-             c(:,ja+j) = z * ( ( ( a(:,ia+i) + a(:,ie+i) ) + ( a(:,ic+i) + a(:,ig+i) ) )           &
-                         + ( ( a(:,id+i) + a(:,ih+i) ) + ( a(:,ib+i) + a(:,if+i) ) ) )
-             c(:,je+j) = z * ( ( ( a(:,ia+i) + a(:,ie+i) ) + ( a(:,ic+i) + a(:,ig+i) ) )           &
-                         - ( ( a(:,id+i) + a(:,ih+i) ) + ( a(:,ib+i) + a(:,if+i) ) ) )
-             c(:,jc+j) = z * ( ( a(:,ia+i) + a(:,ie+i) ) - ( a(:,ic+i) + a(:,ig+i) ) )
-             d(:,jc+j) = z * ( ( a(:,id+i) + a(:,ih+i) ) - ( a(:,ib+i) + a(:,if+i) ) )
-             c(:,jb+j) = z * ( a(:,ia+i) - a(:,ie+i) ) + zsin45 * ( ( a(:,ih+i) - a(:,id+i) )      &
-                         - ( a(:,if+i) - a(:,ib+i) ) )
-             c(:,jd+j) = z * ( a(:,ia+i) - a(:,ie+i) ) - zsin45 * ( ( a(:,ih+i) - a(:,id+i) )      &
-                         - ( a(:,if+i) - a(:,ib+i) ) )
-             d(:,jb+j) = zsin45 * ( ( a(:,ih+i) - a(:,id+i) ) + ( a(:,if+i) - a(:,ib+i) ) )        &
-                         + z * ( a(:,ig+i) - a(:,ic+i) )
-             d(:,jd+j) = zsin45 * ( ( a(:,ih+i) - a(:,id+i) ) + ( a(:,if+i) - a(:,ib+i) ) )        &
-                         - z * ( a(:,ig+i) - a(:,ic+i) )
-             ibase = ibase + inc1
-             jbase = jbase + inc2
-          ENDDO
-
-    END SELECT
-
- END SUBROUTINE qpassm_vec
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Same as qpassm, but for backward fft
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE rpassm_vec(a, b, c, d, trigs, inc1, inc2, n, ifac, la, ierr )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-
-    INTEGER(iwp) ::  i      !<
-    INTEGER(iwp) ::  ia     !<
-    INTEGER(iwp) ::  ib     !<
-    INTEGER(iwp) ::  ibase  !<
-    INTEGER(iwp) ::  ic     !<
-    INTEGER(iwp) ::  id     !<
-    INTEGER(iwp) ::  ie     !<
-    INTEGER(iwp) ::  ierr   !<
-    INTEGER(iwp) ::  ifac   !<
-    INTEGER(iwp) ::  if     !<
-    INTEGER(iwp) ::  igo    !<
-    INTEGER(iwp) ::  iink   !<
-    INTEGER(iwp) ::  inc1   !<
-    INTEGER(iwp) ::  inc2   !<
-    INTEGER(iwp) ::  ipl    !<  loop index parallel loop
-    INTEGER(iwp) ::  j      !<
-    INTEGER(iwp) ::  ja     !<
-    INTEGER(iwp) ::  jb     !<
-    INTEGER(iwp) ::  jbase  !<
-    INTEGER(iwp) ::  jc     !<
-    INTEGER(iwp) ::  jd     !<
-    INTEGER(iwp) ::  je     !<
-    INTEGER(iwp) ::  jf     !<
-    INTEGER(iwp) ::  jg     !<
-    INTEGER(iwp) ::  jh     !<
-    INTEGER(iwp) ::  jink   !<
-    INTEGER(iwp) ::  jump   !<
-    INTEGER(iwp) ::  k      !<
-    INTEGER(iwp) ::  kb     !<
-    INTEGER(iwp) ::  kc     !<
-    INTEGER(iwp) ::  kd     !<
-    INTEGER(iwp) ::  ke     !<
-    INTEGER(iwp) ::  kf     !<
-    INTEGER(iwp) ::  kstop  !<
-    INTEGER(iwp) ::  l      !<
-    INTEGER(iwp) ::  la     !<
-    INTEGER(iwp) ::  m      !<
-    INTEGER(iwp) ::  n      !<
-!
-!-- Arrays are dimensioned with n
-    REAL(wp),DIMENSION(:,:) ::  a  !<
-    REAL(wp),DIMENSION(:,:) ::  b  !<
-    REAL(wp),DIMENSION(:,:) ::  c  !<
-    REAL(wp),DIMENSION(:,:) ::  d  !<
-    REAL(wp),DIMENSION(:),INTENT(IN) ::  trigs  !<
-
-    REAL(wp) ::  a10     !<
-    REAL(wp) ::  a11     !<
-    REAL(wp) ::  a20     !<
-    REAL(wp) ::  a21     !<
-    REAL(wp) ::  b10     !<
-    REAL(wp) ::  b11     !<
-    REAL(wp) ::  b20     !<
-    REAL(wp) ::  b21     !<
-    REAL(wp) ::  c1      !<
-    REAL(wp) ::  c2      !<
-    REAL(wp) ::  c3      !<
-    REAL(wp) ::  c4      !<
-    REAL(wp) ::  c5      !<
-    REAL(wp) ::  qqrt5   !<
-    REAL(wp) ::  qrt5    !<
-    REAL(wp) ::  s1      !<
-    REAL(wp) ::  s2      !<
-    REAL(wp) ::  s3      !<
-    REAL(wp) ::  s4      !<
-    REAL(wp) ::  s5      !<
-    REAL(wp) ::  sin36   !<
-    REAL(wp) ::  sin45   !<
-    REAL(wp) ::  sin60   !<
-    REAL(wp) ::  sin72   !<
-    REAL(wp) ::  ssin36  !<
-    REAL(wp) ::  ssin45  !<
-    REAL(wp) ::  ssin60  !<
-    REAL(wp) ::  ssin72  !<
-
-
-
-    DATA  sin36/0.587785252292473_wp/, sin72/0.951056516295154_wp/,                                &
-          qrt5/0.559016994374947_wp/,  sin60/0.866025403784437_wp/
-
-
-    ierr = 0
-
-    m = n / ifac
-    iink = la * inc1
-    jink = la * inc2
-    jump = ( ifac - 1 ) * jink
-    kstop = ( n - ifac ) / ( 2 * ifac )
-
-    ibase = 0
-    jbase = 0
-    igo = ifac - 1
-    IF ( igo == 7 )  igo = 6
-    IF ( igo < 1  .OR.  igo > 6 )  THEN
-       ierr = 2
-       RETURN
-    ENDIF
-
-
-    SELECT CASE ( igo )
-!
-!--    Coding for factor 2
-       CASE ( 1 )
-
-          ia = 1
-          ib = ia + ( 2 * m - la ) * inc1
-          ja = 1
-          jb = ja + jink
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = a(:,ia+i) + a(:,ib+i)
-                c(:,jb+j) = a(:,ia+i) - a(:,ib+i)
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-             ia = ia + iink
-             iink = 2 * iink
-             ib = ib - iink
-             ibase = 0
-             jbase = jbase + jump
-             jump = 2 * jump + jink
-
-             IF ( ia /= ib )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   ibase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      c(:,ja+j) = a(:,ia+i) + a(:,ib+i)
-                      d(:,ja+j) = b(:,ia+i) - b(:,ib+i)
-                      c(:,jb+j) = c1 * ( a(:,ia+i) - a(:,ib+i) ) - s1 * ( b(:,ia+i) + b(:,ib+i) )
-                      d(:,jb+j) = s1 * ( a(:,ia+i) - a(:,ib+i) ) + c1 * ( b(:,ia+i) + b(:,ib+i) )
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ia = ia + iink
-                   ib = ib - iink
-                   jbase = jbase + jump
-                ENDDO
-
-                IF ( ia > ib )  RETURN
-
-             ENDIF
-
-             ibase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = a(:,ia+i)
-                c(:,jb+j) = - b(:,ia+i)
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = 2.0_wp * ( a(:,ia+i) + a(:,ib+i) )
-                c(:,jb+j) = 2.0_wp * ( a(:,ia+i) - a(:,ib+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 3
-       CASE ( 2 )
-
-          ia = 1
-          ib = ia + ( 2 * m - la ) * inc1
-          ic = ib
-          ja = 1
-          jb = ja + jink
-          jc = jb + jink
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = a(:,ia+i) + a(:,ib+i)
-                c(:,jb+j) = ( a(:,ia+i) - 0.5_wp * a(:,ib+i) ) - ( sin60 * ( b(:,ib+i) ) )
-                c(:,jc+j) = ( a(:,ia+i) - 0.5_wp * a(:,ib+i) ) + ( sin60 * ( b(:,ib+i) ) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-             ia = ia + iink
-             iink = 2 * iink
-             ib = ib + iink
-             ic = ic - iink
-             jbase = jbase + jump
-             jump = 2 * jump + jink
-
-             IF ( ia /= ic )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   ibase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      c(:,ja+j) = a(:,ia+i) + ( a(:,ib+i) + a(:,ic+i) )
-                      d(:,ja+j) = b(:,ia+i) + ( b(:,ib+i) - b(:,ic+i) )
-                      c(:,jb+j) = c1 * ( ( a(:,ia+i) - 0.5_wp * ( a(:,ib+i) + a(:,ic+i) ) )        &
-                                  - ( sin60 * ( b(:,ib+i) + b(:,ic+i) ) ) ) - s1 * ( ( b(:,ia+i)   &
-                                  - 0.5_wp * ( b(:,ib+i) - b(:,ic+i) ) ) + ( sin60 * ( a(:,ib+i)   &
-                                  - a(:,ic+i) ) ) )
-                      d(:,jb+j) = s1 * ( ( a(:,ia+i) - 0.5_wp * ( a(:,ib+i) + a(:,ic+i) ) )        &
-                                  - ( sin60 * ( b(:,ib+i) + b(:,ic+i) ) ) ) + c1 * ( ( b(:,ia+i)   &
-                                  - 0.5_wp * ( b(:,ib+i) - b(:,ic+i) ) ) + ( sin60 * ( a(:,ib+i)   &
-                                  - a(:,ic+i) ) ) )
-                      c(:,jc+j) = c2 * ( ( a(:,ia+i) - 0.5_wp * ( a(:,ib+i) + a(:,ic+i) ) )        &
-                                  + ( sin60 * ( b(:,ib+i) + b(:,ic+i) ) ) ) - s2 * ( ( b(:,ia+i)   &
-                                  - 0.5_wp * ( b(:,ib+i) - b(:,ic+i) ) ) - ( sin60 * ( a(:,ib+i)   &
-                                  - a(:,ic+i) ) ) )
-                      d(:,jc+j) = s2 * ( ( a(:,ia+i) - 0.5_wp * ( a(:,ib+i) + a(:,ic+i) ) )        &
-                                  + ( sin60 * ( b(:,ib+i) + b(:,ic+i) ) ) ) + c2 * ( ( b(:,ia+i)   &
-                                  - 0.5_wp * ( b(:,ib+i) - b(:,ic+i) ) ) - ( sin60 * ( a(:,ib+i)   &
-                                  - a(:,ic+i) ) ) )
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ia = ia + iink
-                   ib = ib + iink
-                   ic = ic - iink
-                   jbase = jbase + jump
-                ENDDO
-
-                IF ( ia > ic )  RETURN
-
-             ENDIF
-
-             ibase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = a(:,ia+i) + a(:,ib+i)
-                c(:,jb+j) = ( 0.5_wp * a(:,ia+i) - a(:,ib+i) ) - ( sin60 * b(:,ia+i) )
-                c(:,jc+j) = - ( 0.5_wp * a(:,ia+i) - a(:,ib+i) ) - ( sin60 * b(:,ia+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             ssin60 = 2.0_wp * sin60
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = 2.0_wp * ( a(:,ia+i) + a(:,ib+i) )
-                c(:,jb+j) = ( 2.0_wp * a(:,ia+i) - a(:,ib+i) ) - ( ssin60 * b(:,ib+i) )
-                c(:,jc+j) = ( 2.0_wp * a(:,ia+i) - a(:,ib+i) ) + ( ssin60 * b(:,ib+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 4
-       CASE ( 3 )
-
-          ia = 1
-          ib = ia + ( 2 * m - la ) * inc1
-          ic = ib + 2 * m * inc1
-          id = ib
-          ja = 1
-          jb = ja + jink
-          jc = jb + jink
-          jd = jc + jink
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = ( a(:,ia+i) + a(:,ic+i) ) + a(:,ib+i)
-                c(:,jb+j) = ( a(:,ia+i) - a(:,ic+i) ) - b(:,ib+i)
-                c(:,jc+j) = ( a(:,ia+i) + a(:,ic+i) ) - a(:,ib+i)
-                c(:,jd+j) = ( a(:,ia+i) - a(:,ic+i) ) + b(:,ib+i)
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-             ia = ia + iink
-             iink = 2 * iink
-             ib = ib + iink
-             ic = ic - iink
-             id = id - iink
-             jbase = jbase + jump
-             jump = 2 * jump + jink
-
-             IF ( ib /= ic )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   ibase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      c(:,ja+j) = ( a(:,ia+i) + a(:,ic+i) ) + ( a(:,ib+i) + a(:,id+i) )
-                      d(:,ja+j) = ( b(:,ia+i) - b(:,ic+i) ) + ( b(:,ib+i) - b(:,id+i) )
-                      c(:,jc+j) = c2 * ( ( a(:,ia+i) + a(:,ic+i) ) - ( a(:,ib+i) + a(:,id+i) ) )   &
-                                  - s2 * ( ( b(:,ia+i) - b(:,ic+i) ) - ( b(:,ib+i) - b(:,id+i) ) )
-                      d(:,jc+j) = s2 * ( ( a(:,ia+i) + a(:,ic+i) ) - ( a(:,ib+i) + a(:,id+i) ) )   &
-                                  + c2 * ( ( b(:,ia+i) - b(:,ic+i) ) - ( b(:,ib+i) - b(:,id+i) ) )
-                      c(:,jb+j) = c1 * ( ( a(:,ia+i) - a(:,ic+i) ) - ( b(:,ib+i) + b(:,id+i) ) )   &
-                                  - s1 * ( ( b(:,ia+i) + b(:,ic+i) ) + ( a(:,ib+i) - a(:,id+i) ) )
-                      d(:,jb+j) = s1 * ( ( a(:,ia+i) - a(:,ic+i) ) - ( b(:,ib+i) + b(:,id+i) ) )   &
-                                  + c1 * ( ( b(:,ia+i) + b(:,ic+i) ) + ( a(:,ib+i) - a(:,id+i) ) )
-                      c(:,jd+j) = c3 * ( ( a(:,ia+i) - a(:,ic+i) ) + ( b(:,ib+i) + b(:,id+i) ) )   &
-                                  - s3 * ( ( b(:,ia+i) + b(:,ic+i) ) - ( a(:,ib+i) - a(:,id+i) ) )
-                      d(:,jd+j) = s3 * ( ( a(:,ia+i) - a(:,ic+i) ) + ( b(:,ib+i) + b(:,id+i) ) )   &
-                                  + c3 * ( ( b(:,ia+i) + b(:,ic+i) ) - ( a(:,ib+i) - a(:,id+i) ) )
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ia = ia + iink
-                   ib = ib + iink
-                   ic = ic - iink
-                   id = id - iink
-                   jbase = jbase + jump
-                ENDDO
-
-                IF ( ib > ic )  RETURN
-
-             ENDIF
-
-             ibase = 0
-             sin45 = SQRT( 0.5_wp )
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = a(:,ia+i) + a(:,ib+i)
-                c(:,jb+j) = sin45 * ( ( a(:,ia+i) - a(:,ib+i) ) - ( b(:,ia+i) + b(:,ib+i) ) )
-                c(:,jc+j) = b(:,ib+i) - b(:,ia+i)
-                c(:,jd+j) = - sin45 * ( ( a(:,ia+i) - a(:,ib+i) ) + ( b(:,ia+i) + b(:,ib+i) ) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = 2.0_wp * ( ( a(:,ia+i) + a(:,ic+i) ) + a(:,ib+i) )
-                c(:,jb+j) = 2.0_wp * ( ( a(:,ia+i) - a(:,ic+i) ) - b(:,ib+i) )
-                c(:,jc+j) = 2.0_wp * ( ( a(:,ia+i) + a(:,ic+i) ) - a(:,ib+i) )
-                c(:,jd+j) = 2.0_wp * ( ( a(:,ia+i) - a(:,ic+i) ) + b(:,ib+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 5
-       CASE ( 4 )
-
-          ia = 1
-          ib = ia + ( 2 * m - la ) * inc1
-          ic = ib + 2 * m * inc1
-          id = ic
-          ie = ib
-          ja = 1
-          jb = ja + jink
-          jc = jb + jink
-          jd = jc + jink
-          je = jd + jink
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = a(:,ia+i) + ( a(:,ib+i) + a(:,ic+i) )
-                c(:,jb+j) = ( ( a(:,ia+i) - 0.25_wp * ( a(:,ib+i) + a(:,ic+i) ) ) + qrt5           &
-                          * ( a(:,ib+i) - a(:,ic+i) ) ) - ( sin72 * b(:,ib+i) + sin36 * b(:,ic+i) )
-                c(:,jc+j) = ( ( a(:,ia+i) - 0.25_wp * ( a(:,ib+i) + a(:,ic+i) ) ) - qrt5           &
-                          * ( a(:,ib+i) - a(:,ic+i) ) ) - ( sin36 * b(:,ib+i) - sin72 * b(:,ic+i) )
-                c(:,jd+j) = ( ( a(:,ia+i) - 0.25_wp * ( a(:,ib+i) + a(:,ic+i) ) ) - qrt5           &
-                          * ( a(:,ib+i) - a(:,ic+i) ) ) + ( sin36 * b(:,ib+i) - sin72 * b(:,ic+i) )
-                c(:,je+j) = ( ( a(:,ia+i) - 0.25_wp * ( a(:,ib+i) + a(:,ic+i) ) ) + qrt5           &
-                          * ( a(:,ib+i) - a(:,ic+i) ) ) + ( sin72 * b(:,ib+i) + sin36 * b(:,ic+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-             ia = ia + iink
-             iink = 2 * iink
-             ib = ib + iink
-             ic = ic + iink
-             id = id - iink
-             ie = ie - iink
-             jbase = jbase + jump
-             jump = 2 * jump + jink
-
-             IF ( ib /= id )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   ke = kd + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   c4 = trigs(ke+1)
-                   s4 = trigs(ke+2)
-                   ibase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-!DIR$ IVDEP
-                      DO  ipl = 1, SIZE( a, 1 )
-                         a10 = ( a (ipl,ia+i) - 0.25_wp * ( ( a(ipl,ib+i) + a(ipl,ie+i) )          &
-                             + ( a(ipl,ic+i) + a(ipl,id+i) ) ) ) + qrt5 * ( ( a(ipl,ib+i)          &
-                             + a(ipl,ie+i) ) - ( a(ipl,ic+i) + a(ipl,id+i) ) )
-                         a20 = ( a(ipl,ia+i) - 0.25_wp * ( ( a(ipl,ib+i) + a(ipl,ie+i) )           &
-                             + ( a(ipl,ic+i) + a(ipl,id+i) ) ) ) - qrt5 * ( ( a(ipl,ib+i)          &
-                             + a(ipl,ie+i) ) - ( a(ipl,ic+i) + a(ipl,id+i) ) )
-                         b10 = ( b(ipl,ia+i) - 0.25_wp * ( ( b(ipl,ib+i) - b(ipl,ie+i) )           &
-                             + ( b(ipl,ic+i) - b(ipl,id+i) ) ) ) + qrt5 * ( ( b(ipl,ib+i)          &
-                             - b(ipl,ie+i) ) - ( b(ipl,ic+i) - b(ipl,id+i) ) )
-                         b20 = ( b(ipl,ia+i) - 0.25_wp * ( ( b(ipl,ib+i) - b(ipl,ie+i) )           &
-                             + ( b(ipl,ic+i) - b(ipl,id+i) ) ) ) - qrt5 * ( ( b(ipl,ib+i)          &
-                             - b(ipl,ie+i) ) - ( b(ipl,ic+i) - b(ipl,id+i) ) )
-                         a11 = sin72 * ( b(ipl,ib+i) + b(ipl,ie+i) ) + sin36                       &
-                               * ( b(ipl,ic+i) + b(ipl,id+i) )
-                         a21 = sin36 * ( b(ipl,ib+i) + b(ipl,ie+i) ) - sin72                       &
-                               * ( b(ipl,ic+i) + b(ipl,id+i) )
-                         b11 = sin72 * ( a(ipl,ib+i) - a(ipl,ie+i) ) + sin36                       &
-                               * ( a(ipl,ic+i) - a(ipl,id+i) )
-                         b21 = sin36 * ( a(ipl,ib+i) - a(ipl,ie+i) ) - sin72                       &
-                               * ( a(ipl,ic+i) - a(ipl,id+i) )
-                         c(ipl,ja+j) = a(ipl,ia+i) + ( ( a(ipl,ib+i) + a(ipl,ie+i) )               &
-                                       + ( a(ipl,ic+i) + a(ipl,id+i) ) )
-                         d(ipl,ja+j) = b(ipl,ia+i) + ( ( b(ipl,ib+i) - b(ipl,ie+i) )               &
-                                       + ( b(ipl,ic+i) - b(ipl,id+i) ) )
-                         c(ipl,jb+j) = c1 * ( a10 - a11 ) - s1 * ( b10 + b11 )
-                         d(ipl,jb+j) = s1 * ( a10 - a11 ) + c1 * ( b10 + b11 )
-                         c(ipl,je+j) = c4 * ( a10 + a11 ) - s4 * ( b10 - b11 )
-                         d(ipl,je+j) = s4 * ( a10 + a11 ) + c4 * ( b10 - b11 )
-                         c(ipl,jc+j) = c2 * ( a20 - a21 ) - s2 * ( b20 + b21 )
-                         d(ipl,jc+j) = s2 * ( a20 - a21 ) + c2 * ( b20 + b21 )
-                         c(ipl,jd+j) = c3 * ( a20 + a21 ) - s3 * ( b20 - b21 )
-                         d(ipl,jd+j) = s3 * ( a20 + a21 ) + c3 * ( b20 - b21 )
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ia = ia + iink
-                   ib = ib + iink
-                   ic = ic + iink
-                   id = id - iink
-                   ie = ie - iink
-                   jbase = jbase + jump
-                ENDDO
-
-                IF ( ib > id )  RETURN
-
-             ENDIF
-
-             ibase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = ( a(:,ia+i) + a(:,ib+i) ) + a(:,ic+i)
-                c(:,jb+j) = ( qrt5 * ( a(:,ia+i) - a(:,ib+i) ) + ( 0.25_wp * ( a(:,ia+i)           &
-                            + a(:,ib+i) ) - a(:,ic+i) ) ) - ( sin36 * b(:,ia+i) + sin72 * b(:,ib+i) )
-                c(:,je+j) = - ( qrt5 * ( a(:,ia+i) - a(:,ib+i) ) + ( 0.25_wp * ( a(:,ia+i)         &
-                            + a(:,ib+i) ) - a(:,ic+i) ) ) - ( sin36 * b(:,ia+i) + sin72 * b(:,ib+i) )
-                c(:,jc+j) = ( qrt5 * ( a(:,ia+i) - a(:,ib+i) ) - ( 0.25_wp * ( a(:,ia+i)           &
-                            + a(:,ib+i) ) - a(:,ic+i) ) ) - ( sin72 * b(:,ia+i) - sin36 * b(:,ib+i) )
-                c(:,jd+j) = - ( qrt5 * ( a(:,ia+i) - a(:,ib+i) ) - ( 0.25_wp * ( a(:,ia+i)         &
-                            + a(:,ib+i) ) - a(:,ic+i) ) ) - ( sin72 * b(:,ia+i) - sin36 * b(:,ib+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             qqrt5  = 2.0_wp * qrt5
-             ssin36 = 2.0_wp * sin36
-             ssin72 = 2.0_wp * sin72
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = 2.0_wp * ( a(:,ia+i) + ( a(:,ib+i) + a(:,ic+i) ) )
-                c(:,jb+j) = ( 2.0_wp * ( a(:,ia+i) - 0.25_wp * ( a(:,ib+i) + a(:,ic+i) ) )         &
-                            + qqrt5 * ( a(:,ib+i) - a(:,ic+i) ) )  - ( ssin72 * b(:,ib+i)          &
-                            + ssin36 * b(:,ic+i) )
-                c(:,jc+j) = ( 2.0_wp * ( a(:,ia+i) - 0.25_wp * ( a(:,ib+i) + a(:,ic+i) ) )         &
-                            - qqrt5 * ( a(:,ib+i) - a(:,ic+i) ) ) - ( ssin36 * b(:,ib+i)           &
-                            - ssin72 * b(:,ic+i) )
-                c(:,jd+j) = ( 2.0_wp * ( a(:,ia+i) - 0.25_wp * ( a(:,ib+i) + a(:,ic+i) ) )         &
-                            - qqrt5 * ( a(:,ib+i) - a(:,ic+i) ) ) + ( ssin36 * b(:,ib+i)           &
-                            - ssin72 * b(:,ic+i) )
-                c(:,je+j) = ( 2.0_wp * ( a(:,ia+i) - 0.25_wp * ( a(:,ib+i) + a(:,ic+i) ) )         &
-                            + qqrt5 * ( a(:,ib+i) - a(:,ic+i) ) ) + ( ssin72 * b(:,ib+i)           &
-                            + ssin36 * b(:,ic+i) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 6
-       CASE ( 5 )
-
-          ia = 1
-          ib = ia + ( 2 * m - la ) * inc1
-          ic = ib + 2 * m * inc1
-          id = ic + 2 * m * inc1
-          ie = ic
-          if = ib
-          ja = 1
-          jb = ja + jink
-          jc = jb + jink
-          jd = jc + jink
-          je = jd + jink
-          jf = je + jink
-
-          IF ( la /= m )  THEN
-
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = ( a(:,ia+i) + a(:,id+i) ) +  ( a(:,ib+i) + a(:,ic+i) )
-                c(:,jd+j) = ( a(:,ia+i) - a(:,id+i) ) -  ( a(:,ib+i) - a(:,ic+i) )
-                c(:,jb+j) = ( ( a(:,ia+i) - a(:,id+i) ) + 0.5_wp * ( a(:,ib+i) - a(:,ic+i) ) )     &
-                          - ( sin60 * ( b(:,ib+i) + b(:,ic+i) ) )
-                c(:,jf+j) = ( ( a(:,ia+i) - a(:,id+i) ) + 0.5_wp * ( a(:,ib+i) - a(:,ic+i) ) )     &
-                          + ( sin60 * ( b(:,ib+i) + b(:,ic+i) ) )
-                c(:,jc+j) = ( ( a(:,ia+i) + a(:,id+i) ) - 0.5_wp * ( a(:,ib+i) + a(:,ic+i) ) )     &
-                          - ( sin60 * ( b(:,ib+i) - b(:,ic+i) ) )
-                c(:,je+j) = ( ( a(:,ia+i) + a(:,id+i) ) - 0.5_wp * ( a(:,ib+i) + a(:,ic+i) ) )     &
-                          + ( sin60 * ( b(:,ib+i) - b(:,ic+i) ) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-             ia = ia + iink
-             iink = 2 * iink
-             ib = ib + iink
-             ic = ic + iink
-             id = id - iink
-             ie = ie - iink
-             if = if - iink
-             jbase = jbase + jump
-             jump = 2 * jump + jink
-
-             IF ( ic /= id )  THEN
-
-                DO  k = la, kstop, la
-                   kb = k + k
-                   kc = kb + kb
-                   kd = kc + kb
-                   ke = kd + kb
-                   kf = ke + kb
-                   c1 = trigs(kb+1)
-                   s1 = trigs(kb+2)
-                   c2 = trigs(kc+1)
-                   s2 = trigs(kc+2)
-                   c3 = trigs(kd+1)
-                   s3 = trigs(kd+2)
-                   c4 = trigs(ke+1)
-                   s4 = trigs(ke+2)
-                   c5 = trigs(kf+1)
-                   s5 = trigs(kf+2)
-                   ibase = 0
-                   DO  l = 1, la
-                      i = ibase
-                      j = jbase
-                      DO  ipl = 1, SIZE( a, 1)
-                         a11 = ( a(ipl,ie+i) + a(ipl,ib+i) ) + ( a(ipl,ic+i) + a(ipl,if+i) )
-                         a20 = ( a(ipl,ia+i) + a(ipl,id+i) ) - 0.5_wp * a11
-                         a21 = sin60 * ( ( a(ipl,ie+i) + a(ipl,ib+i) )                             &
-                               - ( a(ipl,ic+i) + a(ipl,if+i) ) )
-                         b11 = ( b(ipl,ib+i) - b(ipl,ie+i) ) + ( b(ipl,ic+i) - b(ipl,if+i) )
-                         b20 = ( b(ipl,ia+i) - b(ipl,id+i) ) - 0.5_wp * b11
-                         b21 = sin60 * ( ( b(ipl,ib+i) - b(ipl,ie+i) )                             &
-                               - ( b(ipl,ic+i) - b(ipl,if+i) ) )
-
-                         c(ipl,ja+j) = ( a(ipl,ia+i) + a(ipl,id+i) ) + a11
-                         d(ipl,ja+j) = ( b(ipl,ia+i) - b(ipl,id+i) ) + b11
-                         c(ipl,jc+j) = c2 * ( a20 - b21 ) - s2 * ( b20 + a21 )
-                         d(ipl,jc+j) = s2 * ( a20 - b21 ) + c2 * ( b20 + a21 )
-                         c(ipl,je+j) = c4 * ( a20 + b21 ) - s4 * ( b20 - a21 )
-                         d(ipl,je+j) = s4 * ( a20 + b21 ) + c4 * ( b20 - a21 )
-
-                         a11 = ( a(ipl,ie+i) - a(ipl,ib+i) ) + ( a(ipl,ic+i) - a(ipl,if+i) )
-                         b11 = ( b(ipl,ie+i) + b(ipl,ib+i) ) - ( b(ipl,ic+i) + b(ipl,if+i) )
-                         a20 = ( a(ipl,ia+i) - a(ipl,id+i) ) - 0.5_wp * a11
-                         a21 = sin60 * ( ( a(ipl,ie+i) - a(ipl,ib+i) ) - ( a(ipl,ic+i)             &
-                               - a(ipl,if+i) ) )
-                         b20 = ( b(ipl,ia+i) + b(ipl,id+i) ) + 0.5_wp * b11
-                         b21 = sin60 * ( ( b(ipl,ie+i) + b(ipl,ib+i) ) + ( b(ipl,ic+i)             &
-                               + b(ipl,if+i) ) )
-
-                         c(ipl,jd+j) = c3 * ( ( a(ipl,ia+i) - a(ipl,id+i) ) + a11 )                &
-                                     - s3 * ( ( b(ipl,ia+i) + b(ipl,id+i) ) - b11 )
-                         d(ipl,jd+j) = s3 * ( ( a(ipl,ia+i) - a(ipl,id+i) ) + a11 )                &
-                                     + c3 * ( ( b(ipl,ia+i) + b(ipl,id+i) ) - b11 )
-                         c(ipl,jb+j) = c1 * ( a20 - b21 ) - s1 * ( b20 - a21 )
-                         d(ipl,jb+j) = s1 * ( a20 - b21 ) + c1 * ( b20 - a21 )
-                         c(ipl,jf+j) = c5 * ( a20 + b21 ) - s5 * ( b20 + a21 )
-                         d(ipl,jf+j) = s5 * ( a20 + b21 ) + c5 * ( b20 + a21 )
-
-                      ENDDO
-                      ibase = ibase + inc1
-                      jbase = jbase + inc2
-                   ENDDO
-                   ia = ia + iink
-                   ib = ib + iink
-                   ic = ic + iink
-                   id = id - iink
-                   ie = ie - iink
-                   if = if - iink
-                   jbase = jbase + jump
-                ENDDO
-
-                IF ( ic > id )  RETURN
-
-             ENDIF
-
-             ibase = 0
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                DO  ipl = 1, SIZE( a ,1 )
-                   c(ipl,ja+j) = a(ipl,ib+i) + ( a(ipl,ia+i) + a(ipl,ic+i) )
-                   c(ipl,jd+j) = b(ipl,ib+i) - ( b(ipl,ia+i) + b(ipl,ic+i) )
-                   c(ipl,jb+j) = ( sin60 * ( a(ipl,ia+i) - a(ipl,ic+i) ) )                         &
-                               - ( 0.5_wp * ( b(ipl,ia+i) + b(ipl,ic+i) ) + b(ipl,ib+i) )
-                   c(ipl,jf+j) = - ( sin60 * ( a(ipl,ia+i) - a(ipl,ic+i) ) )                       &
-                                 - ( 0.5_wp * ( b(ipl,ia+i) + b(ipl,ic+i) ) + b(ipl,ib+i) )
-                   c(ipl,jc+j) = sin60 * ( b(ipl,ic+i) - b(ipl,ia+i) )                              &
-                                 + ( 0.5_wp * ( a(ipl,ia+i) + a(ipl,ic+i) ) - a(ipl,ib+i) )
-                   c(ipl,je+j) = sin60 * ( b(ipl,ic+i) - b(ipl,ia+i) )                              &
-                                 - ( 0.5_wp * ( a(ipl,ia+i) + a(ipl,ic+i) ) - a(ipl,ib+i) )
-                ENDDO
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ELSE
-
-             ssin60 = 2.0_wp * sin60
-             DO  l = 1, la
-                i = ibase
-                j = jbase
-                c(:,ja+j) = ( 2.0_wp * ( a(:,ia+i) + a(:,id+i) ) )                                 &
-                          + ( 2.0_wp * ( a(:,ib+i) + a(:,ic+i) ) )
-                c(:,jd+j) = ( 2.0_wp * ( a(:,ia+i) - a(:,id+i) ) )                                 &
-                          - ( 2.0_wp * ( a(:,ib+i) - a(:,ic+i) ) )
-                c(:,jb+j) = ( 2.0_wp * ( a(:,ia+i) - a(:,id+i) ) + ( a(:,ib+i) - a(:,ic+i) ) )     &
-                          - ( ssin60 * ( b(:,ib+i) + b(:,ic+i) ) )
-                c(:,jf+j) = ( 2.0_wp * ( a(:,ia+i) - a(:,id+i) ) + ( a(:,ib+i) - a(:,ic+i) ) )     &
-                          + ( ssin60 * ( b(:,ib+i) + b(:,ic+i) ) )
-                c(:,jc+j) = ( 2.0_wp * ( a(:,ia+i) + a(:,id+i) ) - ( a(:,ib+i) + a(:,ic+i) ) )     &
-                          - ( ssin60 * ( b(:,ib+i) - b(:,ic+i) ) )
-                c(:,je+j) = ( 2.0_wp * ( a(:,ia+i) + a(:,id+i) ) - ( a(:,ib+i) + a(:,ic+i) ) )     &
-                          + ( ssin60 * ( b(:,ib+i) - b(:,ic+i) ) )
-                ibase = ibase + inc1
-                jbase = jbase + inc2
-             ENDDO
-
-          ENDIF
-
-!
-!--    Coding for factor 8
-       CASE ( 6 )
-
-          IF ( la /= m )  THEN
-             ierr = 3
-             RETURN
-          ENDIF
-
-          ia = 1
-          ib = ia + la * inc1
-          ic = ib + 2 * la * inc1
-          id = ic + 2 * la * inc1
-          ie = id + 2 * la * inc1
-          ja = 1
-          jb = ja + jink
-          jc = jb + jink
-          jd = jc + jink
-          je = jd + jink
-          jf = je + jink
-          jg = jf + jink
-          jh = jg + jink
-          ssin45 = SQRT( 2.0_wp )
-
-          DO  l = 1, la
-             i = ibase
-             j = jbase
-             c(:,ja+j) = 2.0_wp * ( ( ( a(:,ia+i) + a(:,ie+i) ) + a(:,ic+i) )                      &
-                                                  + ( a(:,ib+i) + a(:,id+i) ) )
-             c(:,je+j) = 2.0_wp * ( ( ( a(:,ia+i) + a(:,ie+i) ) + a(:,ic+i) )                      &
-                                                - ( a(:,ib+i) + a(:,id+i) ) )
-             c(:,jc+j) = 2.0_wp * ( ( ( a(:,ia+i) + a(:,ie+i) ) - a(:,ic+i) )                      &
-                                                  - ( b(:,ib+i) - b(:,id+i) ) )
-             c(:,jg+j) = 2.0_wp * ( ( ( a(:,ia+i) + a(:,ie+i) ) - a(:,ic+i) )                      &
-                                                  + ( b(:,ib+i) - b(:,id+i) ) )
-             c(:,jb+j) = 2.0_wp * ( ( a(:,ia+i) - a(:,ie+i) ) - b(:,ic+i) ) + ssin45               &
-                                * ( (a(:,ib+i) - a(:,id+i) ) - ( b(:,ib+i) + b(:,id+i) ) )
-             c(:,jf+j) = 2.0_wp * ( ( a(:,ia+i) - a(:,ie+i) ) - b(:,ic+i) ) - ssin45               &
-                                * ( (a(:,ib+i) - a(:,id+i) ) - ( b(:,ib+i) + b(:,id+i) ) )
-             c(:,jd+j) = 2.0_wp * ( ( a(:,ia+i) - a(:,ie+i) ) + b(:,ic+i) ) - ssin45               &
-                                * ( (a(:,ib+i) - a(:,id+i) ) + ( b(:,ib+i) + b(:,id+i) ) )
-             c(:,jh+j) = 2.0_wp * ( ( a(:,ia+i) - a(:,ie+i) ) + b(:,ic+i) ) + ssin45               &
-                                * ( (a(:,ib+i) - a(:,id+i) ) + ( b(:,ib+i) + b(:,id+i) ) )
-             ibase = ibase + inc1
-             jbase = jbase + inc2
-          ENDDO
-
-    END SELECT
-
- END SUBROUTINE rpassm_vec
-
- END MODULE temperton_fft
Index: palm/trunk/SOURCE/time_integration.f90
===================================================================
--- palm/trunk/SOURCE/time_integration.f90	(revision 4901)
+++ palm/trunk/SOURCE/time_integration.f90	(revision 1)
@@ -1,254 +1,112 @@
-!> @file time_integration.f90
+ SUBROUTINE time_integration
+
 !------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-!
+! Actual revisions:
+! -----------------
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! replaced use_syn_turb_gen by syn_turb_gen
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Remove leftover write statement from debugging
-!
-! 4802 2020-11-30 14:16:31Z suehring
-! Bugfix in time-control of indoor model at the very first time step
-!
-! 4732 2020-10-07 14:46:34Z schwenkel
-! Add use statements for OPENACC
-!
-! 4731 2020-10-07 13:25:11Z schwenkel
-! Move exchange_horiz from time_integration to modules
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4669 2020-09-09 13:43:47Z pavelkrc
-! - Fix missing call of radiation after spinup
-! - Fix calculation of force_radiation_call
-! - Fix calculation of radiation times
-!
-! 4668 2020-09-09 13:00:16Z pavelkrc
-! Improve debug messages during timestepping
-!
-! 4581 2020-06-29 08:49:58Z suehring
-! Omit explicit pressure forcing via geostrophic wind components in case of
-! mesoscale nesting.
-!
-! 4578 2020-06-25 15:43:32Z gronemeier
-! bugfix: removed unused variables
-!
-! 4573 2020-06-24 13:08:47Z oliver.maas
-! calculate pt(0) incrementally by using dt_3d instead of calculating it absolutely
-! by using time_since_reference_point, because time_since_reference_point is set
-! to zero for initializing_actions = 'cyclic_fill'
-!
-! 4565 2020-06-15 08:30:38Z oliver.maas
-! added new surface temperature forcing method for bc_pt_b = 'dirichlet':
-! surface temperature pt(0) can be linearly increased by pt_surface_heating_rate (in K/h)
-!
-! 4564 2020-06-12 14:03:36Z raasch
-! Vertical nesting method of Huq et al. (2019) removed
-!
-! 4521 2020-05-06 11:39:49Z schwenkel
-! Rename variable
-!
-! 4511 2020-04-30 12:20:40Z raasch
-! chemistry decycling replaced by explicit setting of lateral boundary conditions
-!
-! 4508 2020-04-24 13:32:20Z raasch
-! salsa decycling replaced by explicit setting of lateral boundary conditions
-!
-! 4502 2020-04-17 16:14:16Z schwenkel
-! Implementation of ice microphysics
-!
-! 4472 2020-03-24 12:21:00Z Giersch
-! OPENACC COPYIN directive for ddx and ddy added
-!
-! 4466 2020-03-20 16:14:41Z suehring
-! Add advection fluxes to ACC copyin
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-!
-! 4420 2020-02-24 14:13:56Z maronga
-! Added output control for wind turbine model
-!
-! 4403 2020-02-12 13:08:46Z banzhafs
-! Allowing both existing and on-demand emission read modes
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Bugfix, hour_call_emis uninitialized at first call of time_integration
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static
-! topography information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4281 2019-10-29 15:15:39Z schwenkel
-! Moved boundary conditions to module interface
-!
-! 4276 2019-10-28 16:03:29Z schwenkel
-! Further modularization of lpm code components
-!
-! 4275 2019-10-28 15:34:55Z schwenkel
-! Move call oft lpm to the end of intermediate timestep loop
-!
-! 4268 2019-10-17 11:29:38Z schwenkel
-! Removing module specific boundary conditions an put them into their modules
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod
-!
-! 4226 2019-09-10 17:03:24Z suehring
-! Changes in interface for the offline nesting
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4170 2019-08-19 17:12:31Z gronemeier
-! copy diss, diss_p, tdiss_m to GPU
-!
-! 4144 2019-08-06 09:11:47Z raasch
-! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
-!
-! 4126 2019-07-30 11:09:11Z gronemeier
-! renamed routine to calculate uv exposure
-!
-! 4111 2019-07-22 18:16:57Z suehring
-! advc_flags_1 / advc_flags_2 renamed to advc_flags_m / advc_flags_s
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to
-! avoid runtime error (Loop variable has been modified) in time_integration
-!
-! 4064 2019-07-01 05:33:33Z gronemeier
-! Moved call to radiation module out of intermediate time loop
-!
-! 4048 2019-06-21 21:00:21Z knoop
-! Moved production_e_init call into turbulence_closure_mod
-!
-! 4047 2019-06-21 18:58:09Z knoop
-! Added remainings of swap_timelevel upon its dissolution
-!
-! 4043 2019-06-18 16:59:00Z schwenkel
-! Further LPM modularization
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! Rename subroutines in module for diagnostic quantities
-!
-! 4029 2019-06-14 14:04:35Z raasch
-! exchange of ghost points and boundary conditions separated for chemical species and SALSA module,
-! bugfix: decycling of chemistry species after nesting data transfer
-!
-! 4022 2019-06-12 11:52:39Z suehring
-! Call synthetic turbulence generator at last RK3 substep right after boundary
-! conditions are updated in offline nesting in order to assure that
-! perturbations are always imposed
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! Mass (volume) flux correction included to ensure global mass conservation for child domains.
-!
-! 3994 2019-05-22 18:08:09Z suehring
-! output of turbulence intensity added
-!
-! 3988 2019-05-22 11:32:37Z kanani
-! Implement steerable output interval for virtual measurements
-!
-! 3968 2019-05-13 11:04:01Z suehring
-! replace nspec_out with n_matched_vars
-!
-! 3929 2019-04-24 12:52:08Z banzhafs
-! Reverse changes back from revision 3878: use chem_boundary_conds instead of
-! chem_boundary_conds_decycle
-!
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction
-! of additional debug messages
-!
-! 3879 2019-04-08 20:25:23Z knoop
-! Moved wtm_forces to module_interface_actions
-!
-! 3872 2019-04-08 15:03:06Z knoop
-! Modifications made for salsa:
-! - Call salsa_emission_update at each time step but do the checks within
-!   salsa_emission_update (i.e. skip_time_do_salsa >= time_since_reference_point
-!   and next_aero_emission_update <= time_since_reference_point ).
-! - Renamed nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and
-!   ngast --> ngases_salsa and loop indices b, c and sg to ib, ic and ig
-! - Apply nesting for salsa variables
-! - Removed cpu_log calls speciffic for salsa.
-!
-! 3833 2019-03-28 15:04:04Z forkel
-! added USE chem_gasphase_mod, replaced nspec by nspec since fixed compounds are not integrated
-!
-! 3820 2019-03-27 11:53:41Z forkel
-! renamed do_emiss to emissions_anthropogenic (ecc)
-!
-!
-! 3774 2019-03-04 10:52:49Z moh.hefny
-! rephrase if statement to avoid unallocated array in case of
-! nesting_offline is false (crashing during debug mode)
-!
-! 3761 2019-02-25 15:31:42Z raasch $
-! module section re-formatted and openacc required variables moved to separate section,
-! re-formatting to 100 char line width
-!
-! 3745 2019-02-15 18:57:56Z suehring
-! Call indoor model after first timestep
-!
-! 3744 2019-02-15 18:38:58Z suehring
-! - Moved call of bio_calculate_thermal_index_maps from biometeorology module to
-! time_integration to make sure averaged input is updated before calculating.
-!
-! 3739 2019-02-13 08:05:17Z dom_dwd_user
-! Removed everything related to "time_bio_results" as this is never used.
-!
-! 3724 2019-02-06 16:28:23Z kanani
-! Correct double-used log_point_s unit
-!
-! 3719 2019-02-06 13:10:18Z kanani
-! - removed wind_turbine cpu measurement, since same time is measured inside
-!   wtm_forces subroutine as special measures
-! - moved the numerous vnest cpulog to special measures
-! - extended radiation cpulog over entire radiation part,
-!   moved radiation_interactions cpulog to special measures
-! - moved some cpu_log calls to this routine for better overview
-!
-! 3705 2019-01-29 19:56:39Z suehring
-! Data output for virtual measurements added
-!
-! 3704 2019-01-29 19:51:41Z suehring
-! Rename subroutines for surface-data output
-!
-! 3647 2019-01-02 14:10:44Z kanani
-! Bugfix: add time_since_reference_point to IF clause for data_output calls
-! (otherwise skip_time_* values don't come into affect with dt_do* = 0.0).
-! Clean up indoor_model and biometeorology model call.
-!
+! $Log: time_integration.f90,v $
+! Revision 1.8  2006/08/22 14:16:05  raasch
+! Disturbances are imposed only for the last Runge-Kutta-substep
+!
+! Revision 1.7  2006/08/04 15:04:39  raasch
+! Output of particle timeseries
+!
+! Revision 1.6  2006/02/23 12:58:38  raasch
+! Data output (1d, 2d, 3d, sp) can be skipped for a given time interval from
+! simulation start, additional argument nzb_.._inner added to call of
+! disturb_field, nt_anz renamed current_timestep_number, pl.. renamed do..,
+! ..anz renamed ..n, dt_average renamed dt_averaging_interval_pr,
+! time_average_.. renamed time_do.._av, routines plot_.. renamed data_output_..,
+! additional call of user_actions (after_integration)
+!
+! Revision 1.5  2005/06/26 20:10:20  raasch
+! +call of interaction_droplets_ptq (+module of the same name)
+!
+! Revision 1.4  2005/04/23 09:39:01  raasch
+! Revised calculation of output time counters regarding a possible decrease of
+! the output time interval in case of restart runs
+!
+! Revision 1.3  2005/03/26 21:10:26  raasch
+! Pres is called by default only at the last Runge-Kutta-substep.
+! Determination of the timestep moved from end to the beginning of the
+! time loop in order to assure consistent output in run_control (first line
+! in restart runs must be equal to the last line in the corresponding
+! previous run). Exchange of ghost points for km and kh removed.
+! Changes regarding non-cyclic boundary conditions:
+! arguments are added to call of routines disturb_field, exchange_horiz,
+! and boundary_conds, which is now called for a second time after pres in
+! order to set the velocity boundary conditions at the outflow. Velocity
+! perturbations are imposed near the inflow throughout the whole run.
+!
+! Revision 1.2  2004/04/30 13:03:40  raasch
+! decalpha-specific warning removed, routine name changed to time_integration,
+! particle advection is carried out only once during the intermediate steps,
+! impulse_advec renamed momentum_advec
+!
+! Revision 1.1  2004/04/30 12:58:21  raasch
+! Initial revision
+!
+! Revision 1.44  2004/01/28 15:17:26  raasch
+! Additional intermediate timesteps for the Runge-Kutta schemes, setting
+! of the steering factors for prognostic equations within the new
+! routine timestep_scheme_steering at the beginning of each step (former
+! part of routine timestep called at the end of each step), routine
+! run_control is not called for the Runge-Kutta schemes automatically in case
+! of timestep changes.
+!
+! Revision 1.43  2003/03/16 09:40:12  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.42  2003/03/12 16:33:23  raasch
+! New routine prognostic_equations_vec is used on NEC machines
+!
+! Revision 1.41  2003/03/04 11:31:39  raasch
+! Module DVRP added in case that dvrp graphics package is switched on
+!
+! Revision 1.40  2002/12/19 15:45:13  raasch
+! Routine check_cpu_time renamed to check_for_restart
+!
+! Revision 1.39  2002/06/11 13:11:44  raasch
+! +USE user_actions_mod, prognostic_equations_mod,
+! temperature offset at cyclic boundaries in case of sloping surface moved
+! from prognostic_equations to this subroutine. Particle advection moved from
+! prognostic_equations to this routine. A fast version of prognostic_equations
+! is called in case that the Piascek-Williams advection scheme is used.
+!
+! Revision 1.38  2002/05/02 18:52:19  raasch
+! Application of time filter and exchange of ghost points moved from
+! prognostic_equations to this routine.
+! Error in calculating output time intervals for various quantities removed.
+!
+! Revision 1.37  2001/08/21  09:51:26  09:51:26  raasch (Siegfried Raasch)
+! Time measurements for user_actions moved to that subroutine
+! 
+! Revision 1.36  2001/03/30 07:34:24  raasch
+! Timelevel t+dt eliminated, Asselin filter now included in
+! prognostic_equations, arguments removed from pres,
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.35  2001/01/25 07:06:43  raasch
+! Time measurements with dvrp software included
+!
+! Revision 1.34  2001/01/05 15:12:50  raasch
+! Calculation and plot of spectra
+!
+! Revision 1.33  2000/04/27 06:40:49  raasch
+! Old revision remarks deleted, output of isosurfaces and particles now
+! combined into new routine data_output_dvrp (includes former routines
+! plot_particles and plot_isosurface)
+!
+! Revision 1.32  2000/04/13 13:39:30  schroeter
+! computation of prognostic equations moved to the new routine
+! prognostic_equation, new routines calc_liquid_water_content and
+! compute_vpt
+!
+! Revision 1.31  2000/01/25  16:25:24  16:25:24  letzel (Marcus Letzel)
+! All comments translated into English
+! 
 ! Revision 1.1  1997/08/11 06:19:04  raasch
 ! Initial revision
@@ -257,476 +115,62 @@
 ! Description:
 ! ------------
-!> Integration in time of the model equations, statistical analysis and graphic
-!> output
+! Integration in time of the model equations, statistical analysis and graphic
+! output
 !------------------------------------------------------------------------------!
- SUBROUTINE time_integration
-
-
-    USE advec_ws,                                                                                  &
-        ONLY:  ws_statistics
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzu, prho, pt, pt_init, q,                                                          &
-               q_init, ref_state, rho_ocean, tend, u, v, vpt
-
-    USE biometeorology_mod,                                                                        &
-        ONLY:  bio_calculate_thermal_index_maps, thermal_comfort, bio_calculate_uv_exposure,       &
-               uv_exposure
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY: bulk_cloud_model, calc_liquid_water_content
-
-    USE calc_mean_profile_mod,                                                                     &
-        ONLY:  calc_mean_profile
-
-    USE chem_emissions_mod,                                                                        &
-        ONLY:  chem_emissions_setup, chem_emissions_update_on_demand
-
-    USE chem_gasphase_mod,                                                                         &
-        ONLY:  nvar
-
-    USE chem_modules,                                                                              &
-        ONLY:  bc_cs_t_val, chem_species, emissions_anthropogenic,                                 &
-               emiss_read_legacy_mode, n_matched_vars
-
-    USE control_parameters,                                                                        &
-        ONLY:  advected_distance_x, advected_distance_y, air_chemistry, average_count_3d,          &
-               averaging_interval, averaging_interval_pr, bc_lr_cyc, bc_ns_cyc, bc_pt_t_val,       &
-               bc_q_t_val, biometeorology, call_psolver_at_all_substeps,  child_domain,            &
-               constant_flux_layer, constant_heatflux, create_disturbances,                        &
-               dopr_n, constant_diffusion, coupling_mode, coupling_start_time,                     &
-               current_timestep_number, debug_output_timestep, debug_string,                       &
-               disturbance_created, disturbance_energy_limit, dist_range,                          &
-               do_sum, dt_3d, dt_averaging_input, dt_averaging_input_pr, dt_coupling,              &
-               dt_data_output_av, dt_disturb, dt_do2d_xy, dt_do2d_xz, dt_do2d_yz, dt_do3d,         &
-               dt_domask,dt_dopts, dt_dopr, dt_dopr_listing, dt_dots, dt_run_control,              &
-               end_time, first_call_lpm, first_call_mas, galilei_transformation, humidity,         &
-               indoor_model, intermediate_timestep_count, intermediate_timestep_count_max,         &
-               land_surface, large_scale_forcing, loop_optimization, lsf_surf, lsf_vert, masks,    &
-               multi_agent_system_end, multi_agent_system_start, nesting_offline, neutral,         &
-               nr_timesteps_this_run, nudging, ocean_mode, pt_reference,                           &
-               pt_slope_offset, pt_surface_heating_rate,                                           &
-               random_heatflux, run_coupled, salsa,                                                &
-               simulated_time, simulated_time_chr, skip_time_do2d_xy, skip_time_do2d_xz,           &
-               skip_time_do2d_yz, skip_time_do3d, skip_time_domask, skip_time_dopr,                &
-               skip_time_data_output_av, sloping_surface, stop_dt, surface_output,                 &
-               syn_turb_gen,                                                                       &
-               terminate_coupled, terminate_run, timestep_scheme, time_coupling, time_do2d_xy,     &
-               time_do2d_xz, time_do2d_yz, time_do3d, time_domask, time_dopr, time_dopr_av,        &
-               time_dopr_listing, time_dopts, time_dosp, time_dosp_av, time_dots, time_do_av,      &
-               time_do_sla, time_disturb, time_run_control, time_since_reference_point,            &
-               timestep_count, turbulent_inflow, turbulent_outflow, urban_surface,                 &
-               use_initial_profile_as_reference, use_single_reference_value, u_gtrans, v_gtrans,   &
-               virtual_flight, virtual_measurement, ws_scheme_mom, ws_scheme_sca
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point, log_point_s
-
-    USE diagnostic_output_quantities_mod,                                                          &
-        ONLY:  doq_calculate,                                                                      &
-               timestep_number_at_prev_calc
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE flight_mod,                                                                                &
-        ONLY:  flight_measurement
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, ddy
-
-    USE indices,                                                                                   &
-        ONLY:  nx, nxl, nxlg, nxr, nxrg, nzb, nzt
-
-    USE indoor_model_mod,                                                                          &
-        ONLY:  dt_indoor, im_main_heatcool, time_indoor
-
+
+    USE arrays_3d
+    USE averaging
+    USE control_parameters
+    USE cpulog
+#if defined( __dvrp_graphics )
+    USE DVRP
+#endif
+    USE grid_variables
+    USE indices
+    USE interaction_droplets_ptq_mod
     USE interfaces
-
-    USE kinds
-
-    USE land_surface_model_mod,                                                                    &
-        ONLY:  lsm_boundary_condition, lsm_energy_balance, skip_time_do_lsm
-
-    USE lagrangian_particle_model_mod,                                                             &
-        ONLY:  lpm_data_output_ptseries
-
-    USE lsf_nudging_mod,                                                                           &
-        ONLY:  calc_tnudge, ls_forcing_surf, ls_forcing_vert, nudge_ref
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_actions, module_interface_swap_timelevel,                          &
-               module_interface_boundary_conditions, module_interface_exchange_horiz
-
-    USE multi_agent_system_mod,                                                                    &
-        ONLY:  agents_active, multi_agent_system
-
-    USE nesting_offl_mod,                                                                          &
-        ONLY:  nesting_offl_bc,                                                                    &
-               nesting_offl_input,                                                                 &
-               nesting_offl_interpolation_factor,                                                  &
-               nesting_offl_mass_conservation
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  chem_emis, chem_emis_att
-
-    USE ocean_mod,                                                                                 &
-        ONLY:  prho_reference
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  get_date_time
-
-    USE particle_attributes,                                                                       &
-        ONLY:  particle_advection, particle_advection_start
-
+    USE particle_attributes
     USE pegrid
-
-#if defined( __parallel )
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run, nesting_mode, pmci_boundary_conds, pmci_datatrans, pmci_synchronize,    &
-        pmci_ensure_nest_mass_conservation, pmci_ensure_nest_mass_conservation_vertical,           &
-        pmci_set_swaplevel
+    USE prognostic_equations_mod
+    USE statistics
+    USE user_actions_mod
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=9) ::  time_to_string
+    INTEGER ::  i, j, k
+
+!
+!-- At the beginning of a simulation determine the time step as well as
+!-- determine and print out the run control parameters
+    IF ( simulated_time == 0.0 )  CALL timestep
+    CALL run_control
+
+#if defined( __dvrp_graphics )
+!
+!-- Time measurement with dvrp software  
+    CALL DVRP_LOG_EVENT( 2, current_timestep_number )
 #endif
 
-    USE progress_bar,                                                                              &
-        ONLY:  finish_progress_bar, output_progress_bar
-
-    USE prognostic_equations_mod,                                                                  &
-        ONLY:  prognostic_equations_cache, prognostic_equations_vector
-
-    USE radiation_model_mod,                                                                       &
-        ONLY: dt_radiation, force_radiation_call, radiation, radiation_control,                    &
-              radiation_interaction, radiation_interactions, skip_time_do_radiation, time_radiation
-
-    USE salsa_mod,                                                                                 &
-        ONLY: aerosol_number, aerosol_mass, bc_am_t_val, bc_an_t_val, bc_gt_t_val,                 &
-              nbins_aerosol, ncomponents_mass, ngases_salsa,                                       &
-              salsa_boundary_conditions, salsa_emission_update, salsa_gas, salsa_gases_from_chem,  &
-              skip_time_do_salsa
-
-    USE spectra_mod,                                                                               &
-        ONLY: average_count_sp, averaging_interval_sp, calc_spectra, dt_dosp, skip_time_dosp
-
-    USE statistics,                                                                                &
-        ONLY:  flow_statistics_called, hom, pr_palm, sums_ls_l
-
-
-    USE surface_layer_fluxes_mod,                                                                  &
-        ONLY:  surface_layer_fluxes
-
-    USE surface_data_output_mod,                                                                   &
-        ONLY:  average_count_surf, averaging_interval_surf, dt_dosurf, dt_dosurf_av,               &
-               surface_data_output, surface_data_output_averaging, skip_time_dosurf,               &
-               skip_time_dosurf_av, time_dosurf, time_dosurf_av
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
-
-    USE synthetic_turbulence_generator_mod,                                                        &
-        ONLY:  dt_stg_call, dt_stg_adjust, parametrize_inflow_turbulence, stg_adjust, stg_main,    &
-               time_stg_adjust, time_stg_call
-
-    USE turbulence_closure_mod,                                                                    &
-        ONLY:  tcm_diffusivities
-
-    USE urban_surface_mod,                                                                         &
-        ONLY:  usm_boundary_condition,                                                             &
-               usm_energy_balance
-
-    USE virtual_measurement_mod,                                                                   &
-        ONLY:  dt_virtual_measurement,                                                             &
-               time_virtual_measurement,                                                           &
-               vm_data_output,                                                                     &
-               vm_sampling,                                                                        &
-               vm_time_start
-
-
-    USE wind_turbine_model_mod,                                                                    &
-        ONLY:  dt_data_output_wtm, time_wtm, wind_turbine, wtm_data_output
-
-#if defined( _OPENACC )
-    USE arrays_3d,                                                                                 &
-        ONLY:  d, dd2zu, ddzu, ddzw,                                                               &
-               diss,                                                                               &
-               diss_p,                                                                             &
-               diss_l_u,                                                                           &
-               diss_l_v,                                                                           &
-               diss_l_w,                                                                           &
-               diss_s_u,                                                                           &
-               diss_s_v,                                                                           &
-               diss_s_w,                                                                           &
-               drho_air, drho_air_zw, dzw, e,                                                      &
-               flux_l_u,                                                                           &
-               flux_l_v,                                                                           &
-               flux_l_w,                                                                           &
-               flux_s_u,                                                                           &
-               flux_s_v,                                                                           &
-               flux_s_w,                                                                           &
-               heatflux_output_conversion,                                                         &
-               e_p,                                                                                &
-               pt_p,                                                                               &
-               u_p,                                                                                &
-               v_p,                                                                                &
-               w_p,                                                                                &
-               kh, km, momentumflux_output_conversion, nc, ni, nr, p, ptdf_x, ptdf_y, qc, qi, qr, rdf,     &
-               rdf_sc, rho_air, rho_air_zw, s, tdiss_m, te_m, tpt_m, tu_m, tv_m, tw_m, ug, u_init, &
-               u_stokes_zu, vg, v_init, v_stokes_zu, w, zu
-
-    USE control_parameters,                                                                        &
-        ONLY:  tsc
-
-    USE indices,                                                                                   &
-        ONLY:  advc_flags_m, advc_flags_s, nyn, nyng, nys, nysg, nz, nzb_max, wall_flags_total_0
-
-    USE statistics,                                                                                &
-        ONLY:  rmask, statistic_regions, sums_l, sums_l_l, sums_us2_ws_l,                          &
-               sums_wsus_ws_l, sums_vs2_ws_l, sums_wsvs_ws_l, sums_ws2_ws_l, sums_wspts_ws_l,      &
-               sums_wsqs_ws_l, sums_wssas_ws_l, sums_wsqcs_ws_l, sums_wsqrs_ws_l, sums_wsncs_ws_l, &
-               sums_wsnrs_ws_l, sums_wsss_ws_l, weight_substep, sums_salsa_ws_l, sums_wsqis_ws_l,  &
-               sums_wsnis_ws_l
-
-    USE surface_mod,                                                                               &
-        ONLY:  bc_h, enter_surface_arrays, exit_surface_arrays
-#endif
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=9) ::  time_to_string   !<
-
-    INTEGER(iwp) ::  hour                !< hour of current time
-    INTEGER(iwp) ::  hour_call_emis = -1 !< last hour where emission was called
-    INTEGER(iwp) ::  ib                  !< index for aerosol size bins
-    INTEGER(iwp) ::  ic                  !< index for aerosol mass bins
-    INTEGER(iwp) ::  icc                 !< additional index for aerosol mass bins
-    INTEGER(iwp) ::  ig                  !< index for salsa gases
-    INTEGER(iwp) ::  mid                 !< masked output running index
-    INTEGER(iwp) ::  n                   !< loop counter for chemistry species
-
-    REAL(wp) ::  dt_3d_old  !< temporary storage of timestep to be used for
-                            !< steering of run control output interval
-    REAL(wp) ::  time_since_reference_point_save  !< original value of
-                                                  !< time_since_reference_point
-
-
-!
-!-- Copy data from arrays_3d
-!$ACC DATA &
-!$ACC COPY(d(nzb+1:nzt,nys:nyn,nxl:nxr)) &
-!$ACC COPY(diss(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(e(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(u(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(v(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(w(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(kh(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(km(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(pt(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
-
-!$ACC DATA &
-!$ACC COPYIN(diss_l_u(0:nz+1,nys:nyn,0), flux_l_u(0:nz+1,nys:nyn,0)) &
-!$ACC COPYIN(diss_l_v(0:nz+1,nys:nyn,0), flux_l_v(0:nz+1,nys:nyn,0)) &
-!$ACC COPYIN(diss_l_w(0:nz+1,nys:nyn,0), flux_l_w(0:nz+1,nys:nyn,0)) &
-!$ACC COPYIN(diss_s_u(0:nz+1,0), flux_s_u(0:nz+1,0)) &
-!$ACC COPYIN(diss_s_v(0:nz+1,0), flux_s_v(0:nz+1,0)) &
-!$ACC COPYIN(diss_s_w(0:nz+1,0), flux_s_w(0:nz+1,0)) &
-!$ACC COPY(diss_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(e_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(u_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(v_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(w_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(pt_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(tdiss_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(te_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(tu_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(tv_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(tw_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPY(tpt_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
-
-!$ACC DATA &
-!$ACC COPYIN(rho_air(nzb:nzt+1), drho_air(nzb:nzt+1)) &
-!$ACC COPYIN(rho_air_zw(nzb:nzt+1), drho_air_zw(nzb:nzt+1)) &
-!$ACC COPYIN(zu(nzb:nzt+1)) &
-!$ACC COPYIN(dzu(1:nzt+1), dzw(1:nzt+1)) &
-!$ACC COPYIN(ddzu(1:nzt+1), dd2zu(1:nzt)) &
-!$ACC COPYIN(ddzw(1:nzt+1)) &
-!$ACC COPYIN(heatflux_output_conversion(nzb:nzt+1)) &
-!$ACC COPYIN(momentumflux_output_conversion(nzb:nzt+1)) &
-!$ACC COPYIN(rdf(nzb+1:nzt), rdf_sc(nzb+1:nzt)) &
-!$ACC COPYIN(ptdf_x(nxlg:nxrg), ptdf_y(nysg:nyng)) &
-!$ACC COPYIN(ref_state(0:nz+1)) &
-!$ACC COPYIN(u_init(0:nz+1), v_init(0:nz+1)) &
-!$ACC COPYIN(u_stokes_zu(nzb:nzt+1), v_stokes_zu(nzb:nzt+1)) &
-!$ACC COPYIN(pt_init(0:nz+1)) &
-!$ACC COPYIN(ug(0:nz+1), vg(0:nz+1))
-
-!
-!-- Copy data from control_parameters
-!$ACC DATA &
-!$ACC COPYIN(tsc(1:5))
-
-!
-!-- Copy data from grid_variables
-!$ACC DATA &
-!$ACC COPYIN(ddx, ddy)
-
-!
-!-- Copy data from indices
-!$ACC DATA &
-!$ACC COPYIN(advc_flags_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPYIN(advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
-!$ACC COPYIN(wall_flags_total_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
-
-!
-!-- Copy data from surface_mod
-!$ACC DATA &
-!$ACC COPYIN(bc_h(0:1)) &
-!$ACC COPYIN(bc_h(0)%i(1:bc_h(0)%ns)) &
-!$ACC COPYIN(bc_h(0)%j(1:bc_h(0)%ns)) &
-!$ACC COPYIN(bc_h(0)%k(1:bc_h(0)%ns)) &
-!$ACC COPYIN(bc_h(1)%i(1:bc_h(1)%ns)) &
-!$ACC COPYIN(bc_h(1)%j(1:bc_h(1)%ns)) &
-!$ACC COPYIN(bc_h(1)%k(1:bc_h(1)%ns))
-
-!
-!-- Copy data from statistics
-!$ACC DATA &
-!$ACC COPYIN(hom(0:nz+1,1:2,1:4,0)) &
-!$ACC COPYIN(rmask(nysg:nyng,nxlg:nxrg,0:statistic_regions)) &
-!$ACC COPYIN(weight_substep(1:intermediate_timestep_count_max)) &
-!$ACC COPY(sums_l(nzb:nzt+1,1:pr_palm,0)) &
-!$ACC COPY(sums_l_l(nzb:nzt+1,0:statistic_regions,0)) &
-!$ACC COPY(sums_us2_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wsus_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_vs2_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wsvs_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_ws2_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wspts_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wssas_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wsqs_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wsqcs_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wsqis_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wsqrs_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wsncs_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wsnis_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wsnrs_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_wsss_ws_l(nzb:nzt+1,0)) &
-!$ACC COPY(sums_salsa_ws_l(nzb:nzt+1,0))
-
-!
-!-- Next statement is to avoid compiler warnings about unused variables. Please
-!-- remove in case that you are using them. ddx and ddy need to be defined in
-!-- time_integration because of ACC COPYIN directive.
-    ddx = ddx
-    ddy = ddy
-
-#if defined( _OPENACC )
-    CALL enter_surface_arrays
-#endif
-
-!
-!-- At beginning determine the first time step
-    CALL timestep
-
-#if defined( __parallel )
-!
-!-- Synchronize the timestep in case of nested run.
-    IF ( nested_run )  THEN
-!
-!--    Synchronization by unifying the time step.
-!--    Global minimum of all time-steps is used for all.
-       CALL pmci_synchronize
-    ENDIF
-#endif
-
-!
-!-- Determine and print out the run control quantities before the first time
-!-- step of this run. For the initial run, some statistics (e.g. divergence)
-!-- need to be determined first --> CALL flow_statistics at the beginning of
-!-- run_control
-    CALL run_control
-!
-!-- Data exchange between coupled models in case that a call has been omitted
-!-- at the end of the previous run of a job chain.
-    IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled )  THEN
-!
-!--    In case of model termination initiated by the local model the coupler
-!--    must not be called because this would again cause an MPI hang.
-       DO WHILE ( time_coupling >= dt_coupling  .AND.  terminate_coupled == 0 )
-          CALL surface_coupler
-          time_coupling = time_coupling - dt_coupling
-       ENDDO
-       IF (time_coupling == 0.0_wp  .AND.  time_since_reference_point < dt_coupling )  THEN
-          time_coupling = time_since_reference_point
-       ENDIF
-    ENDIF
-
-    CALL location_message( 'atmosphere (and/or ocean) time-stepping', 'start' )
 !
 !-- Start of the time loop
-    DO  WHILE ( simulated_time < end_time  .AND.  .NOT. stop_dt  .AND. .NOT. terminate_run )
+    DO  WHILE ( simulated_time < end_time  .AND.  .NOT. stop_dt  .AND. &
+                .NOT. terminate_run )
 
        CALL cpu_log( log_point_s(10), 'timesteps', 'start' )
 
-       IF ( debug_output_timestep )  THEN
-           WRITE( debug_string, * ) 'time_integration', simulated_time
-           CALL debug_message( debug_string, 'start' )
-       ENDIF
-
-!
-!--    Determine ug, vg and w_subs in dependence on data from external file
-!--    LSF_DATA
-       IF ( large_scale_forcing .AND. lsf_vert )  THEN
-           CALL ls_forcing_vert ( simulated_time )
-           sums_ls_l = 0.0_wp
-       ENDIF
-
-!
-!--    Set pt_init and q_init to the current profiles taken from
-!--    NUDGING_DATA
-       IF ( nudging )  THEN
-           CALL nudge_ref ( simulated_time )
-!
-!--        Store temperature gradient at the top boundary for possible Neumann
-!--        boundary condition
-           bc_pt_t_val = ( pt_init(nzt+1) - pt_init(nzt) ) / dzu(nzt+1)
-           bc_q_t_val  = ( q_init(nzt+1) - q_init(nzt) ) / dzu(nzt+1)
-           IF ( air_chemistry )  THEN
-              DO  n = 1, nvar
-                 bc_cs_t_val = (  chem_species(n)%conc_pr_init(nzt+1)                              &
-                                - chem_species(n)%conc_pr_init(nzt) )                              &
-                               / dzu(nzt+1)
-              ENDDO
-           ENDIF
-           IF ( salsa  .AND.  time_since_reference_point >= skip_time_do_salsa )  THEN
-              DO  ib = 1, nbins_aerosol
-                 bc_an_t_val = ( aerosol_number(ib)%init(nzt+1) - aerosol_number(ib)%init(nzt) ) / &
-                               dzu(nzt+1)
-                 DO  ic = 1, ncomponents_mass
-                    icc = ( ic - 1 ) * nbins_aerosol + ib
-                    bc_am_t_val = ( aerosol_mass(icc)%init(nzt+1) - aerosol_mass(icc)%init(nzt) ) /&
-                                  dzu(nzt+1)
-                 ENDDO
-              ENDDO
-              IF ( .NOT. salsa_gases_from_chem )  THEN
-                 DO  ig = 1, ngases_salsa
-                    bc_gt_t_val = ( salsa_gas(ig)%init(nzt+1) - salsa_gas(ig)%init(nzt) ) /        &
-                                  dzu(nzt+1)
-                 ENDDO
-              ENDIF
-           ENDIF
-       ENDIF
-!
-!--    Input of boundary data.
-       IF ( nesting_offline )  CALL nesting_offl_input
-!
-!--    Execute all other module actions routines
-       CALL module_interface_actions( 'before_timestep' )
+!
+!--    Determine size of next time step
+       IF ( simulated_time /= 0.0 )  CALL timestep
+
+!
+!--    Execute the user-defined actions
+       CALL user_actions( 'before_timestep' )
 
 !
 !--    Start of intermediate step loop
        intermediate_timestep_count = 0
-       DO  WHILE ( intermediate_timestep_count < intermediate_timestep_count_max )
+       DO  WHILE ( intermediate_timestep_count < &
+                   intermediate_timestep_count_max )
 
           intermediate_timestep_count = intermediate_timestep_count + 1
@@ -737,49 +181,4 @@
           CALL timestep_scheme_steering
 
-!
-!--       Calculate those variables needed in the tendency terms which need
-!--       global communication
-          IF ( .NOT. use_single_reference_value  .AND.  .NOT. use_initial_profile_as_reference )   &
-          THEN
-!
-!--          Horizontally averaged profiles to be used as reference state in
-!--          buoyancy terms (WARNING: only the respective last call of
-!--          calc_mean_profile defines the reference state!)
-             IF ( .NOT. neutral )  THEN
-                CALL calc_mean_profile( pt, 4 )
-                ref_state(:)  = hom(:,1,4,0) ! this is used in the buoyancy term
-             ENDIF
-             IF ( ocean_mode )  THEN
-                CALL calc_mean_profile( rho_ocean, 64 )
-                ref_state(:)  = hom(:,1,64,0)
-             ENDIF
-             IF ( humidity )  THEN
-                CALL calc_mean_profile( vpt, 44 )
-                ref_state(:)  = hom(:,1,44,0)
-             ENDIF
-!
-!--          Assure that ref_state does not become zero at any level
-!--          ( might be the case if a vertical level is completely occupied
-!--            with topography ).
-             ref_state = MERGE( MAXVAL(ref_state), ref_state, ref_state == 0.0_wp )
-          ENDIF
-
-          IF ( ( ws_scheme_mom .OR. ws_scheme_sca )  .AND.  intermediate_timestep_count == 1 )     &
-          THEN
-             CALL ws_statistics
-          ENDIF
-!
-!--       In case of nudging calculate current nudging time scale and horizontal
-!--       means of u, v, pt and q
-          IF ( nudging )  THEN
-             CALL calc_tnudge( simulated_time )
-             CALL calc_mean_profile( u, 1 )
-             CALL calc_mean_profile( v, 2 )
-             CALL calc_mean_profile( pt, 4 )
-             CALL calc_mean_profile( q, 41 )
-          ENDIF
-!
-!--       Execute all other module actions routines
-          CALL module_interface_actions( 'before_prognostic_equations' )
 !
 !--       Solve the prognostic equations. A fast cache optimized version with
@@ -788,18 +187,34 @@
 !--       in the other versions a good vectorization is prohibited due to
 !--       inlining problems.
-          IF ( loop_optimization == 'cache' )  THEN
-             CALL prognostic_equations_cache
-          ELSEIF ( loop_optimization == 'vector' )  THEN
-             CALL prognostic_equations_vector
-          ENDIF
-
-!
-!--       Movement of agents in multi agent system
-          IF ( agents_active  .AND.  time_since_reference_point >= multi_agent_system_start  .AND. &
-               time_since_reference_point <= multi_agent_system_end  .AND.                         &
-               intermediate_timestep_count == 1 )                                                  &
+          IF ( host(1:3) == 'nec' )  THEN
+             CALL prognostic_equations_vec
+          ELSE
+             IF ( momentum_advec == 'ups-scheme'  .OR.  &
+                  scalar_advec == 'ups-scheme'   .OR.  &
+                  scalar_advec == 'bc-scheme' )        &
+             THEN
+                CALL prognostic_equations
+             ELSE
+                CALL prognostic_equations_fast
+             ENDIF
+          ENDIF
+
+!
+!--       Particle advection (only once during intermediate steps, because
+!--       it uses an Euler-step)
+          IF ( simulated_time >= particle_advection_start  .AND. &
+               intermediate_timestep_count == 1 )  THEN
+             CALL advec_particles
+             first_call_advec_particles = .FALSE.
+          ENDIF
+
+!
+!--       Interaction of droplets with temperature and specific humidity.
+!--       Droplet condensation and evaporation is calculated within
+!--       advec_particles.
+          IF ( cloud_droplets  .AND.  &
+               intermediate_timestep_count == intermediate_timestep_count_max )&
           THEN
-             CALL multi_agent_system
-             first_call_mas = .FALSE.
+             CALL interaction_droplets_ptq
           ENDIF
 
@@ -807,64 +222,33 @@
 !--       Exchange of ghost points (lateral boundary conditions)
           CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'start' )
-
-          CALL module_interface_exchange_horiz( 'after_prognostic_equation' )
+          CALL exchange_horiz( u_p, uxrp,    0 )
+          CALL exchange_horiz( v_p,    0, vynp )
+          CALL exchange_horiz( w_p,    0,    0 )
+          CALL exchange_horiz( pt_p,   0,    0 )
+          IF ( .NOT. constant_diffusion       )  CALL exchange_horiz( e_p, 0, 0)
+          IF ( moisture  .OR.  passive_scalar )  CALL exchange_horiz( q_p, 0, 0)
+          IF ( cloud_droplets )  THEN
+             CALL exchange_horiz( ql,    0, 0 )
+             CALL exchange_horiz( ql_c,  0, 0 )
+             CALL exchange_horiz( ql_v,  0, 0 )
+             CALL exchange_horiz( ql_vp, 0, 0 )
+          ENDIF
 
           CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'stop' )
 
 !
+!--       Apply time filter in case of leap-frog timestep
+          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
+             CALL asselin_filter
+          ENDIF
+
+!
+!--       Swap the time levels in preparation for the next time step.
+          CALL swap_timelevel
+
+!
 !--       Boundary conditions for the prognostic quantities (except of the
-!--       velocities at the outflow in case of a non-cyclic lateral wall) and
-!--       boundary conditions for module-specific variables
-          CALL module_interface_boundary_conditions
-
-!
-!--       Incrementing timestep counter
-          timestep_count = timestep_count + 1
-
-          CALL cpu_log( log_point(28), 'swap_timelevel', 'start' )
-!
-!--       Set the swap level for all modules
-          CALL module_interface_swap_timelevel( MOD( timestep_count, 2) )
-
-#if defined( __parallel )
-!
-!--       Set the swap level for steering the pmc data transfer
-          IF ( nested_run )  CALL pmci_set_swaplevel( MOD( timestep_count, 2) + 1 )  !> @todo: why the +1 ?
-#endif
-
-          CALL cpu_log( log_point(28), 'swap_timelevel', 'stop' )
-
-#if defined( __parallel )
-          IF ( nested_run )  THEN
-
-             CALL cpu_log( log_point(60), 'nesting', 'start' )
-!
-!--          Domain nesting. The data transfer subroutines pmci_parent_datatrans
-!--          and pmci_child_datatrans are called inside the wrapper
-!--          subroutine pmci_datatrans according to the control parameters
-!--          nesting_mode and nesting_datatransfer_mode.
-!--          TO_DO: why is nesting_mode given as a parameter here?
-             CALL pmci_datatrans( nesting_mode )
-
-             IF ( TRIM( nesting_mode ) == 'two-way' .OR.  nesting_mode == 'vertical' )  THEN
-
-                CALL cpu_log( log_point_s(92), 'exchange-horiz-nest', 'start' )
-!
-!--             Exchange_horiz is needed for all parent-domains after the
-!--             anterpolation
-                CALL module_interface_exchange_horiz( 'after_anterpolation' )
-
-                CALL cpu_log( log_point_s(92), 'exchange-horiz-nest', 'stop' )
-
-             ENDIF
-
-!
-!--          Set boundary conditions again after interpolation and anterpolation.
-             CALL pmci_boundary_conds
-
-             CALL cpu_log( log_point(60), 'nesting', 'stop' )
-
-          ENDIF
-#endif
+!--       velocities at the outflow in case of a non-cyclic lateral wall)
+          CALL boundary_conds( 'main' )
 
 !
@@ -872,43 +256,25 @@
 !--       when a sloping surface is used
           IF ( sloping_surface )  THEN
-             IF ( nxl ==  0 )  pt(:,:,nxlg:nxl-1) = pt(:,:,nxlg:nxl-1) - pt_slope_offset
-             IF ( nxr == nx )  pt(:,:,nxr+1:nxrg) = pt(:,:,nxr+1:nxrg) + pt_slope_offset
-          ENDIF
-
-!
-!--       Increase temperature pt(0) according to pt_surface_heating_rate (convert from K/h to K/s)
-          IF ( pt_surface_heating_rate /= 0.0_wp .AND. intermediate_timestep_count == 1 ) THEN
-             pt(0,:,:) = pt(0,:,:) + dt_3d * pt_surface_heating_rate / 3600.0_wp
-          ENDIF
-
-!
-!--       Impose a turbulent inflow using the recycling method
-          IF ( turbulent_inflow )  CALL inflow_turbulence
-
-!
-!--       Set values at outflow boundary using the special outflow condition
-          IF ( turbulent_outflow )  CALL outflow_turbulence
+             IF ( nxl ==  0 )  pt(:,:,nxl-1) = pt(:,:,nxl-1) - pt_slope_offset
+             IF ( nxr == nx )  pt(:,:,nxr+1) = pt(:,:,nxr+1) + pt_slope_offset
+          ENDIF
 
 !
 !--       Impose a random perturbation on the horizontal velocity field
-          IF ( create_disturbances  .AND.  ( call_psolver_at_all_substeps  .AND.                   &
-               intermediate_timestep_count == intermediate_timestep_count_max )                    &
-               .OR. ( .NOT. call_psolver_at_all_substeps  .AND.  intermediate_timestep_count == 1 ) ) &
+          IF ( create_disturbances  .AND.  &
+               intermediate_timestep_count == intermediate_timestep_count_max )&
           THEN
              time_disturb = time_disturb + dt_3d
              IF ( time_disturb >= dt_disturb )  THEN
-                IF ( disturbance_energy_limit /= 0.0_wp  .AND.                                     &
-                     hom(nzb+5,1,pr_palm,0) < disturbance_energy_limit )  THEN
-                   CALL disturb_field( 'u', tend, u )
-                   CALL disturb_field( 'v', tend, v )
-                ELSEIF ( ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )                                &
-                         .AND. .NOT. child_domain  .AND.  .NOT.  nesting_offline )                 &
-                THEN
+                IF ( hom(nzb+5,1,var_hom,0) < disturbance_energy_limit )  THEN
+                   CALL disturb_field( nzb_u_inner, tend, u, uxrp, 0    )
+                   CALL disturb_field( nzb_v_inner, tend, v ,   0, vynp )
+                ELSEIF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
 !
 !--                Runs with a non-cyclic lateral wall need perturbations
 !--                near the inflow throughout the whole simulation
                    dist_range = 1
-                   CALL disturb_field( 'u', tend, u )
-                   CALL disturb_field( 'v', tend, v )
+                   CALL disturb_field( nzb_u_inner, tend, u, uxrp, 0    )
+                   CALL disturb_field( nzb_v_inner, tend, v ,   0, vynp )
                    dist_range = 0
                 ENDIF
@@ -918,68 +284,25 @@
 
 !
-!--       Map forcing data derived from larger scale model onto domain
-!--       boundaries. Further, update geostrophic wind components.
-          IF ( nesting_offline  .AND.  intermediate_timestep_count ==                              &
-                                       intermediate_timestep_count_max  )  THEN
-!--          Determine interpolation factor before boundary conditions and geostrophic wind
-!--          is updated.
-             CALL nesting_offl_interpolation_factor
-             CALL nesting_offl_bc
-!              CALL nesting_offl_geostrophic_wind
-          ENDIF
-!
-!--       Impose a turbulent inflow using synthetic generated turbulence.
-          IF ( syn_turb_gen  .AND.                                                                 &
-               intermediate_timestep_count == intermediate_timestep_count_max )  THEN
-             CALL cpu_log( log_point(57), 'synthetic_turbulence_gen', 'start' )
-             CALL stg_main
-             CALL cpu_log( log_point(57), 'synthetic_turbulence_gen', 'stop' )
-          ENDIF
-!
-!--       Ensure mass conservation. This need to be done after imposing
-!--       synthetic turbulence and top boundary condition for pressure is set to
-!--       Neumann conditions.
-!--       Is this also required in case of Dirichlet?
-          IF ( nesting_offline )  CALL nesting_offl_mass_conservation
-!
 !--       Reduce the velocity divergence via the equation for perturbation
 !--       pressure.
-          IF ( intermediate_timestep_count == 1  .OR.  call_psolver_at_all_substeps )  THEN
-
-#if defined( __parallel )
-!
-!--          Mass (volume) flux correction to ensure global mass conservation for child domains.
-             IF ( child_domain )  THEN
-                IF ( nesting_mode == 'vertical' )  THEN
-                   CALL pmci_ensure_nest_mass_conservation_vertical
-                ELSE
-                   CALL pmci_ensure_nest_mass_conservation
-                ENDIF
-             ENDIF
-#endif
+          IF ( intermediate_timestep_count == intermediate_timestep_count_max &
+               .OR.  call_psolver_at_all_substeps )  THEN
              CALL pres
-
-          ENDIF
-!
-!--       Particle transport/physics with the Lagrangian particle model
-!--       (only once during intermediate steps, because it uses an Euler-step)
-!--       ### particle model should be moved before prognostic_equations, in order
-!--       to regard droplet interactions directly
-
-          CALL module_interface_actions( 'after_pressure_solver' )
-!
-!--       Interaction of droplets with temperature and mixing ratio.
-!--       Droplet condensation and evaporation is calculated within
-!--       advec_particles.
+          ENDIF
+
+!
+!--       In case of a non-cyclic lateral wall, set the boundary conditions for
+!--       the velocities at the outflow
+          IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
+             CALL boundary_conds( 'outflow_uvw' )
+          ENDIF
+
+!
+!--       If required, compute virtuell potential temperature
+          IF ( moisture ) CALL compute_vpt
+
 !
 !--       If required, compute liquid water content
-          IF ( bulk_cloud_model )  THEN
-             CALL calc_liquid_water_content
-          ENDIF
-!
-!--       If required, compute virtual potential temperature
-          IF ( humidity )  THEN
-             CALL compute_vpt
-          ENDIF
+          IF ( cloud_physics ) CALL calc_liquid_water_content
 
 !
@@ -988,64 +311,18 @@
 
 !
-!--          Determine surface fluxes shf and qsws and surface values
-!--          pt_surface and q_surface in dependence on data from external
-!--          file LSF_DATA respectively
-             IF ( ( large_scale_forcing .AND. lsf_surf ) .AND.                                     &
-                 intermediate_timestep_count == intermediate_timestep_count_max )                  &
-             THEN
-                CALL ls_forcing_surf( simulated_time )
+!--          First the vertical fluxes in the Prandtl layer are being computed
+             IF ( prandtl_layer )  THEN
+                CALL cpu_log( log_point(19), 'prandtl_fluxes', 'start' )
+                CALL prandtl_fluxes
+                CALL cpu_log( log_point(19), 'prandtl_fluxes', 'stop' )
              ENDIF
 
-!
-!--          First the vertical (and horizontal) fluxes in the surface
-!--          (constant flux) layer are computed
-             IF ( constant_flux_layer )  THEN
-                CALL cpu_log( log_point(19), 'surface_layer_fluxes', 'start' )
-                CALL surface_layer_fluxes
-                CALL cpu_log( log_point(19), 'surface_layer_fluxes', 'stop' )
-             ENDIF
-!
-!--          If required, solve the energy balance for the surface and run soil
-!--          model. Call for horizontal as well as vertical surfaces
-             IF ( land_surface .AND. time_since_reference_point >= skip_time_do_lsm)  THEN
-
-                CALL cpu_log( log_point(54), 'land_surface', 'start' )
-                CALL lsm_energy_balance( .FALSE. )
-
-!
-!--             At the end, set boundary conditons for potential temperature
-!--             and humidity after running the land-surface model. This
-!--             might be important for the nesting, where arrays are transfered.
-                CALL lsm_boundary_condition
-
-
-                CALL cpu_log( log_point(54), 'land_surface', 'stop' )
-             ENDIF
-!
-!--          If required, solve the energy balance for urban surfaces and run
-!--          the material heat model
-             IF (urban_surface) THEN
-                CALL cpu_log( log_point(74), 'urban_surface', 'start' )
-                CALL usm_energy_balance( .FALSE. )
-
-!
-!--             At the end, set boundary conditons for potential temperature
-!--             and humidity after running the urban-surface model. This
-!--             might be important for the nesting, where arrays are transfered.
-                CALL usm_boundary_condition
-
-                CALL cpu_log( log_point(74), 'urban_surface', 'stop' )
-             ENDIF
 !
 !--          Compute the diffusion coefficients
              CALL cpu_log( log_point(17), 'diffusivities', 'start' )
-             IF ( .NOT. humidity ) THEN
-                IF ( ocean_mode )  THEN
-                   CALL tcm_diffusivities( prho, prho_reference )
-                ELSE
-                   CALL tcm_diffusivities( pt, pt_reference )
-                ENDIF
+             IF ( .NOT. moisture ) THEN
+                CALL diffusivities( pt )
              ELSE
-                CALL tcm_diffusivities( vpt, pt_reference )
+                CALL diffusivities( vpt )
              ENDIF
              CALL cpu_log( log_point(17), 'diffusivities', 'stop' )
@@ -1056,251 +333,40 @@
 
 !
-!--    Will be used at some point by flow_statistics.
-       !$ACC UPDATE &
-       !$ACC HOST(sums_l_l(nzb:nzt+1,0:statistic_regions,0)) &
-       !$ACC HOST(sums_us2_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wsus_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_vs2_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wsvs_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_ws2_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wspts_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wssas_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wsqs_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wsqcs_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wsqis_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wsqrs_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wsncs_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wsnis_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wsnrs_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_wsss_ws_l(nzb:nzt+1,0)) &
-       !$ACC HOST(sums_salsa_ws_l(nzb:nzt+1,0))
-
-!
-!--    If required, calculate radiative fluxes and heating rates
-       IF ( radiation  .AND.  time_since_reference_point >= skip_time_do_radiation )  THEN
-
-          time_radiation = time_radiation + dt_3d
-
-          IF ( time_radiation >= dt_radiation  .OR.  force_radiation_call )  THEN
-
-             CALL cpu_log( log_point(50), 'radiation', 'start' )
-
-             IF ( time_radiation >= dt_radiation )  THEN
-                time_radiation = time_radiation - dt_radiation
-             ENDIF
-
-!
-!--          Adjust the current time to the time step of the radiation model.
-!--          Needed since radiation is pre-calculated and stored only on apparent
-!--          solar positions
-             time_since_reference_point_save = time_since_reference_point
-             time_since_reference_point = time_since_reference_point -                            &
-                                          MODULO(time_since_reference_point, dt_radiation)
-
-             CALL radiation_control
-
-             IF ( ( urban_surface  .OR.  land_surface )  .AND.  radiation_interactions )  THEN
-                CALL cpu_log( log_point_s(46), 'radiation_interaction', 'start' )
-                CALL radiation_interaction
-                CALL cpu_log( log_point_s(46), 'radiation_interaction', 'stop' )
-             ENDIF
-
-!
-!--          Return the current time to its original value
-             time_since_reference_point = time_since_reference_point_save
-!
-!--          Reset forcing of radiation call
-             force_radiation_call = .FALSE.
-
-             CALL cpu_log( log_point(50), 'radiation', 'stop' )
-
-          ENDIF
-       ENDIF
-
-
-!
-!-- 20200203 (ECC)
-!-- allows for emission update mode in legacy mode as well as on-demand mode
-!-- note that under on-demand mode emission update is no longer restricted to
-!-- an hourly frequency, but whenever the simulation time corresponds to an
-!-- inrement in emission timestamp value
-
-!
-!-- If required, consider chemical emissions
-
-       IF  ( air_chemistry .AND. emissions_anthropogenic )  THEN
-
-          IF  ( emiss_read_legacy_mode )  THEN
-!
-!-- get hourly index and updates emission data when the hour is passed
-
-             CALL get_date_time( time_since_reference_point, hour=hour )
-
-             IF  ( hour_call_emis /= hour )   THEN
-
-                CALL chem_emissions_setup( chem_emis_att, chem_emis, n_matched_vars )
-                hour_call_emis = hour
-
-             ENDIF
-
-          ELSE
-
-             CALL chem_emissions_update_on_demand
-
-          ENDIF
-
-       ENDIF
-
-
-!
-!--    If required, consider aerosol emissions for the salsa model
-       IF ( salsa )  THEN
-!
-!--       Call emission routine to update emissions if needed
-          CALL salsa_emission_update
-
-       ENDIF
-!
-!--    If required, calculate indoor temperature, waste heat, heat flux
-!--    through wall, etc.
-!--    dt_indoor steers the frequency of the indoor model calculations.
-!--    Note, at first timestep indoor model is called, in order to provide
-!--    a waste heat flux.
-       IF ( indoor_model )  THEN
-
-          time_indoor = time_indoor + dt_3d
-
-          IF ( time_indoor >= dt_indoor  .OR.  current_timestep_number == 0 )  THEN
-
-             IF ( time_indoor >= dt_indoor )  time_indoor = time_indoor - dt_indoor
-
-             CALL cpu_log( log_point(76), 'indoor_model', 'start' )
-             CALL im_main_heatcool
-             CALL cpu_log( log_point(76), 'indoor_model', 'stop' )
-
-          ENDIF
-       ENDIF
+!--    Execute user-defined actions
+       CALL user_actions( 'after_integration' )
+
 !
 !--    Increase simulation time and output times
-       nr_timesteps_this_run      = nr_timesteps_this_run + 1
-       current_timestep_number    = current_timestep_number + 1
-       simulated_time             = simulated_time   + dt_3d
-       time_since_reference_point = simulated_time - coupling_start_time
-       simulated_time_chr         = time_to_string( time_since_reference_point )
-
-
-       IF ( time_since_reference_point >= skip_time_data_output_av )  THEN
+       current_timestep_number = current_timestep_number + 1
+       simulated_time     = simulated_time   + dt_3d
+       simulated_time_chr = time_to_string( simulated_time )
+       IF ( simulated_time >= skip_time_data_output_av )  THEN
           time_do_av         = time_do_av       + dt_3d
        ENDIF
-       IF ( time_since_reference_point >= skip_time_do2d_xy )  THEN
+       IF ( simulated_time >= skip_time_do2d_xy )  THEN
           time_do2d_xy       = time_do2d_xy     + dt_3d
        ENDIF
-       IF ( time_since_reference_point >= skip_time_do2d_xz )  THEN
+       IF ( simulated_time >= skip_time_do2d_xz )  THEN
           time_do2d_xz       = time_do2d_xz     + dt_3d
        ENDIF
-       IF ( time_since_reference_point >= skip_time_do2d_yz )  THEN
+       IF ( simulated_time >= skip_time_do2d_yz )  THEN
           time_do2d_yz       = time_do2d_yz     + dt_3d
        ENDIF
-       IF ( time_since_reference_point >= skip_time_do3d    )  THEN
+       IF ( simulated_time >= skip_time_do3d    )  THEN
           time_do3d          = time_do3d        + dt_3d
        ENDIF
-       DO  mid = 1, masks
-          IF ( time_since_reference_point >= skip_time_domask(mid) )  THEN
-             time_domask(mid)= time_domask(mid) + dt_3d
-          ENDIF
-       ENDDO
-       IF ( time_since_reference_point >= skip_time_dosp )  THEN
+       time_dvrp          = time_dvrp        + dt_3d
+       IF ( simulated_time >= skip_time_dosp )  THEN
           time_dosp       = time_dosp        + dt_3d
        ENDIF
        time_dots          = time_dots        + dt_3d
-       IF ( .NOT. first_call_lpm )  THEN
+       IF ( .NOT. first_call_advec_particles )  THEN
           time_dopts      = time_dopts       + dt_3d
        ENDIF
-       IF ( time_since_reference_point >= skip_time_dopr )  THEN
+       IF ( simulated_time >= skip_time_dopr )  THEN
           time_dopr       = time_dopr        + dt_3d
        ENDIF
-       time_dopr_listing  = time_dopr_listing + dt_3d
+       time_dopr_listing          = time_dopr_listing        + dt_3d
        time_run_control   = time_run_control + dt_3d
-!
-!--    Increment time-counter for surface output
-       IF ( surface_output )  THEN
-          IF ( time_since_reference_point >= skip_time_dosurf )  THEN
-             time_dosurf    = time_dosurf + dt_3d
-          ENDIF
-          IF ( time_since_reference_point >= skip_time_dosurf_av )  THEN
-             time_dosurf_av = time_dosurf_av + dt_3d
-          ENDIF
-       ENDIF
-!
-!--    Increment time-counter for virtual measurements
-       IF ( virtual_measurement  .AND.  vm_time_start <= time_since_reference_point )  THEN
-          time_virtual_measurement = time_virtual_measurement + dt_3d
-       ENDIF
-
-!
-!--    Increment time-counter for wind turbine data output
-       IF ( wind_turbine )  THEN
-          time_wtm = time_wtm + dt_3d
-       ENDIF
-
-!
-!--    In case of synthetic turbulence generation and parametrized turbulence
-!--    information, update the time counter and if required, adjust the
-!--    STG to new atmospheric conditions.
-       IF ( syn_turb_gen  )  THEN
-          IF ( parametrize_inflow_turbulence )  THEN
-             time_stg_adjust = time_stg_adjust + dt_3d
-             IF ( time_stg_adjust >= dt_stg_adjust )  THEN
-                CALL cpu_log( log_point(57), 'synthetic_turbulence_gen', 'start' )
-                CALL stg_adjust
-                CALL cpu_log( log_point(57), 'synthetic_turbulence_gen', 'stop' )
-             ENDIF
-          ENDIF
-          time_stg_call = time_stg_call + dt_3d
-       ENDIF
-
-!
-!--    Data exchange between coupled models
-       IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled )  THEN
-          time_coupling = time_coupling + dt_3d
-
-!
-!--       In case of model termination initiated by the local model
-!--       (terminate_coupled > 0), the coupler must be skipped because it would
-!--       cause an MPI intercomminucation hang.
-!--       If necessary, the coupler will be called at the beginning of the
-!--       next restart run.
-          DO WHILE ( time_coupling >= dt_coupling  .AND.  terminate_coupled == 0 )
-             CALL surface_coupler
-             time_coupling = time_coupling - dt_coupling
-          ENDDO
-       ENDIF
-
-!
-!--    Biometeorology calculation of stationary thermal indices
-!--    Todo (kanani): biometeorology needs own time_... treatment.
-!--                   It might be that time_do2d_xy differs from time_do3d,
-!--                   and then we might get trouble with the biomet output,
-!--                   because we can have 2d and/or 3d biomet output!!
-       IF ( biometeorology                                                                         &
-            .AND. ( ( time_do3d >= dt_do3d  .AND.  time_since_reference_point >= skip_time_do3d )  &
-                  .OR.                                                                             &
-            ( time_do2d_xy >= dt_do2d_xy  .AND.  time_since_reference_point >= skip_time_do2d_xy ) &
-                    ) )  THEN
-!
-!--       If required, do thermal comfort calculations
-          IF ( thermal_comfort )  THEN
-             CALL bio_calculate_thermal_index_maps ( .FALSE. )
-          ENDIF
-!
-!--       If required, do UV exposure calculations
-          IF ( uv_exposure )  THEN
-             CALL bio_calculate_uv_exposure
-          ENDIF
-       ENDIF
-
-!
-!--    Execute alle other module actions routunes
-       CALL module_interface_actions( 'after_integration' )
 
 !
@@ -1315,6 +381,5 @@
 !--    Check, if restart is necessary (because cpu-time is expiring or
 !--    because it is forced by user) and set stop flag
-!--    This call is skipped if the remote model has already initiated a restart.
-       IF ( .NOT. terminate_run )  CALL check_for_restart
+       CALL check_for_restart
 
 !
@@ -1331,11 +396,12 @@
 !
 !--    If required, call flow_statistics for averaging in time
-       IF ( averaging_interval_pr /= 0.0_wp  .AND.                                                 &
-            ( dt_dopr - time_dopr ) <= averaging_interval_pr  .AND.                                &
-            time_since_reference_point >= skip_time_dopr )  THEN
+       IF ( averaging_interval_pr /= 0.0  .AND.  &
+            ( dt_dopr - time_dopr ) <= averaging_interval_pr  .AND.  &
+            simulated_time >= skip_time_dopr )  THEN
           time_dopr_av = time_dopr_av + dt_3d
           IF ( time_dopr_av >= dt_averaging_input_pr )  THEN
              do_sum = .TRUE.
-             time_dopr_av = MOD( time_dopr_av, MAX( dt_averaging_input_pr, dt_3d ) )
+             time_dopr_av = MOD( time_dopr_av, &
+                                    MAX( dt_averaging_input_pr, dt_3d ) )
           ENDIF
        ENDIF
@@ -1343,14 +409,11 @@
 
 !
-!--    Sum-up 3d-arrays for later output of time-averaged 2d/3d/masked data
-       IF ( averaging_interval /= 0.0_wp  .AND.                                                    &
-            ( dt_data_output_av - time_do_av ) <= averaging_interval  .AND.                        &
-            time_since_reference_point >= skip_time_data_output_av )                               &
+!--    Sum-up 3d-arrays for later output of time-averaged data
+       IF ( averaging_interval /= 0.0  .AND.                                &
+            ( dt_data_output_av - time_do_av ) <= averaging_interval  .AND. &
+            simulated_time >= skip_time_data_output_av )                    &
        THEN
           time_do_sla = time_do_sla + dt_3d
           IF ( time_do_sla >= dt_averaging_input )  THEN
-             IF ( current_timestep_number > timestep_number_at_prev_calc )                         &
-                CALL doq_calculate
-
              CALL sum_up_3d_data
              average_count_3d = average_count_3d + 1
@@ -1358,49 +421,31 @@
           ENDIF
        ENDIF
-!
-!--    Average surface data
-       IF ( surface_output )  THEN
-          IF ( averaging_interval_surf /= 0.0_wp                                                   &
-                .AND.  ( dt_dosurf_av - time_dosurf_av ) <= averaging_interval_surf                &
-                .AND.  time_since_reference_point >= skip_time_dosurf_av )  THEN
-             IF ( time_dosurf_av >= dt_averaging_input )  THEN
-                CALL surface_data_output_averaging
-                average_count_surf = average_count_surf + 1
-             ENDIF
-          ENDIF
-       ENDIF
 
 !
 !--    Calculate spectra for time averaging
-       IF ( averaging_interval_sp /= 0.0_wp  .AND. ( dt_dosp - time_dosp ) <= averaging_interval_sp&
-            .AND.  time_since_reference_point >= skip_time_dosp )  THEN
+       IF ( averaging_interval_sp /= 0.0  .AND.  &
+            ( dt_dosp - time_dosp ) <= averaging_interval_sp  .AND.  &
+            simulated_time >= skip_time_dosp )  THEN
           time_dosp_av = time_dosp_av + dt_3d
           IF ( time_dosp_av >= dt_averaging_input_pr )  THEN
              CALL calc_spectra
-             time_dosp_av = MOD( time_dosp_av, MAX( dt_averaging_input_pr, dt_3d ) )
-          ENDIF
-       ENDIF
-
-!
-!--    Call flight module and output data
-       IF ( virtual_flight )  THEN
-          CALL flight_measurement
-          CALL data_output_flight
-       ENDIF
-!
-!--    Take virtual measurements
-       IF ( virtual_measurement  .AND.  time_virtual_measurement >= dt_virtual_measurement         &
-                                 .AND.  vm_time_start <= time_since_reference_point )  THEN
-          CALL vm_sampling
-          CALL vm_data_output
-          time_virtual_measurement = MOD(      time_virtual_measurement,                           &
-                                          MAX( dt_virtual_measurement, dt_3d ) )
-       ENDIF
-
-!
-!--    Output wind turbine data
-       IF ( wind_turbine  .AND.  time_wtm >= dt_data_output_wtm )  THEN
-          CALL wtm_data_output
-          time_wtm = MOD( time_wtm, MAX( dt_data_output_wtm, dt_3d ) )
+             time_dosp_av = MOD( time_dosp_av, &
+                                 MAX( dt_averaging_input_pr, dt_3d ) )
+          ENDIF
+       ENDIF
+
+!
+!--    Computation and output of run control parameters.
+!--    This is also done whenever the time step has changed or perturbations
+!--    have been imposed
+       IF ( time_run_control >= dt_run_control  .OR.                     &
+            ( dt_changed  .AND.  timestep_scheme(1:5) /= 'runge' )  .OR. &
+            disturbance_created )                                        &
+       THEN
+          CALL run_control
+          IF ( time_run_control >= dt_run_control )  THEN
+             time_run_control = MOD( time_run_control, &
+                                     MAX( dt_run_control, dt_3d ) )
+          ENDIF
        ENDIF
 
@@ -1409,13 +454,14 @@
        IF ( time_dopr_listing >= dt_dopr_listing )  THEN
           CALL print_1d
-          time_dopr_listing = MOD( time_dopr_listing, MAX( dt_dopr_listing, dt_3d ) )
+          time_dopr_listing = MOD( time_dopr_listing, MAX( dt_dopr_listing, &
+                                                           dt_3d ) )
        ENDIF
 
 !
 !--    Graphic output for PROFIL
-       IF ( time_dopr >= dt_dopr  .AND.  time_since_reference_point >= skip_time_dopr )  THEN
+       IF ( time_dopr >= dt_dopr )  THEN
           IF ( dopr_n /= 0 )  CALL data_output_profiles
           time_dopr = MOD( time_dopr, MAX( dt_dopr, dt_3d ) )
-          time_dopr_av = 0.0_wp    ! due to averaging (see above)
+          time_dopr_av = 0.0    ! due to averaging (see above)
        ENDIF
 
@@ -1423,5 +469,5 @@
 !--    Graphic output for time series
        IF ( time_dots >= dt_dots )  THEN
-          CALL data_output_tseries
+          IF ( dots_n /= 0 )  CALL data_output_tseries
           time_dots = MOD( time_dots, MAX( dt_dots, dt_3d ) )
        ENDIF
@@ -1430,5 +476,5 @@
 !--    Output of spectra (formatted for use with PROFIL), in case of no
 !--    time averaging, spectra has to be calculated before
-       IF ( time_dosp >= dt_dosp  .AND.  time_since_reference_point >= skip_time_dosp )  THEN
+       IF ( time_dosp >= dt_dosp )  THEN
           IF ( average_count_sp == 0 )  CALL calc_spectra
           CALL data_output_spectra
@@ -1438,22 +484,13 @@
 !
 !--    2d-data output (cross-sections)
-       IF ( time_do2d_xy >= dt_do2d_xy  .AND.  time_since_reference_point >= skip_time_do2d_xy )  THEN
-          IF ( current_timestep_number > timestep_number_at_prev_calc )                            &
-             CALL doq_calculate
-
+       IF ( time_do2d_xy >= dt_do2d_xy )  THEN
           CALL data_output_2d( 'xy', 0 )
           time_do2d_xy = MOD( time_do2d_xy, MAX( dt_do2d_xy, dt_3d ) )
        ENDIF
-       IF ( time_do2d_xz >= dt_do2d_xz  .AND.  time_since_reference_point >= skip_time_do2d_xz )  THEN
-          IF ( current_timestep_number > timestep_number_at_prev_calc )                            &
-
-             CALL doq_calculate
+       IF ( time_do2d_xz >= dt_do2d_xz )  THEN
           CALL data_output_2d( 'xz', 0 )
           time_do2d_xz = MOD( time_do2d_xz, MAX( dt_do2d_xz, dt_3d ) )
        ENDIF
-       IF ( time_do2d_yz >= dt_do2d_yz  .AND.  time_since_reference_point >= skip_time_do2d_yz )  THEN
-          IF ( current_timestep_number > timestep_number_at_prev_calc )                            &
-             CALL doq_calculate
-
+       IF ( time_do2d_yz >= dt_do2d_yz )  THEN
           CALL data_output_2d( 'yz', 0 )
           time_do2d_yz = MOD( time_do2d_yz, MAX( dt_do2d_yz, dt_3d ) )
@@ -1462,8 +499,5 @@
 !
 !--    3d-data output (volume data)
-       IF ( time_do3d >= dt_do3d  .AND.  time_since_reference_point >= skip_time_do3d )  THEN
-          IF ( current_timestep_number > timestep_number_at_prev_calc )                            &
-             CALL doq_calculate
-
+       IF ( time_do3d >= dt_do3d )  THEN
           CALL data_output_3d( 0 )
           time_do3d = MOD( time_do3d, MAX( dt_do3d, dt_3d ) )
@@ -1471,142 +505,51 @@
 
 !
-!--    Masked data output
-       DO  mid = 1, masks
-          IF ( time_domask(mid) >= dt_domask(mid)                                                  &
-               .AND.  time_since_reference_point >= skip_time_domask(mid) )  THEN
-             IF ( current_timestep_number > timestep_number_at_prev_calc )                         &
-                CALL doq_calculate
-
-             CALL data_output_mask( 0, mid )
-             time_domask(mid) = MOD( time_domask(mid), MAX( dt_domask(mid), dt_3d ) )
-          ENDIF
-       ENDDO
-
-!
-!--    Output of time-averaged 2d/3d/masked data
-       IF ( time_do_av >= dt_data_output_av                                                        &
-            .AND.  time_since_reference_point >= skip_time_data_output_av )  THEN
+!--    Output of time-averaged 2d/3d-data
+       IF ( time_do_av >= dt_data_output_av )  THEN
           CALL average_3d_data
-!
-!--       Udate thermal comfort indices based on updated averaged input
-          IF ( biometeorology  .AND.  thermal_comfort )  THEN
-             CALL bio_calculate_thermal_index_maps ( .TRUE. )
-          ENDIF
           CALL data_output_2d( 'xy', 1 )
           CALL data_output_2d( 'xz', 1 )
           CALL data_output_2d( 'yz', 1 )
           CALL data_output_3d( 1 )
-          DO  mid = 1, masks
-             CALL data_output_mask( 1, mid )
-          ENDDO
           time_do_av = MOD( time_do_av, MAX( dt_data_output_av, dt_3d ) )
        ENDIF
-!
-!--    Output of surface data, instantaneous and averaged data
-       IF ( surface_output )  THEN
-          IF ( time_dosurf >= dt_dosurf  .AND.  time_since_reference_point >= skip_time_dosurf )  THEN
-             CALL surface_data_output( 0 )
-             time_dosurf = MOD( time_dosurf, MAX( dt_dosurf, dt_3d ) )
-          ENDIF
-          IF ( time_dosurf_av >= dt_dosurf_av  .AND.  time_since_reference_point >= skip_time_dosurf_av )  THEN
-             CALL surface_data_output( 1 )
-             time_dosurf_av = MOD( time_dosurf_av, MAX( dt_dosurf_av, dt_3d ) )
-          ENDIF
-       ENDIF
 
 !
 !--    Output of particle time series
-       IF ( particle_advection )  THEN
-          IF ( time_dopts >= dt_dopts  .OR.                                                        &
-               ( time_since_reference_point >= particle_advection_start  .AND.                     &
-                 first_call_lpm ) )  THEN
-             CALL lpm_data_output_ptseries
-             time_dopts = MOD( time_dopts, MAX( dt_dopts, dt_3d ) )
-          ENDIF
-       ENDIF
-
-!
-!--    If required, set the heat flux for the next time step to a random value
-       IF ( constant_heatflux  .AND.  random_heatflux )  THEN
-          IF ( surf_def_h(0)%ns >= 1 )  THEN
-             CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
-             CALL disturb_heatflux( surf_def_h(0) )
-             CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
-          ENDIF
-          IF ( surf_lsm_h(0)%ns >= 1 )  THEN
-             CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
-             CALL disturb_heatflux( surf_lsm_h(0) )
-             CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
-          ENDIF
-          IF ( surf_usm_h(0)%ns >= 1 )  THEN
-             CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
-             CALL disturb_heatflux( surf_usm_h(0) )
-             CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
-          ENDIF
-       ENDIF
-
-!
-!--    Execute alle other module actions routunes
-       CALL module_interface_actions( 'after_timestep' )
-
-!
-!--    Determine size of next time step. Save timestep dt_3d because it is
-!--    newly calculated in routine timestep, but required further below for
-!--    steering the run control output interval
-       dt_3d_old = dt_3d
-       CALL timestep
-
-#if defined( __parallel )
-!
-!--    Synchronize the timestep in case of nested run.
-       IF ( nested_run )  THEN
-!
-!--       Synchronize by unifying the time step.
-!--       Global minimum of all time-steps is used for all.
-          CALL pmci_synchronize
-       ENDIF
+       IF ( time_dopts >= dt_dopts  .OR. &
+            ( simulated_time >= particle_advection_start  .AND. &
+              first_call_advec_particles ) )  THEN
+          CALL data_output_ptseries
+          time_dopts = MOD( time_dopts, MAX( dt_dopts, dt_3d ) )
+       ENDIF
+
+!
+!--    Output of dvrp-graphics (isosurface, particles, slicer)
+#if defined( __dvrp_graphics )
+       CALL DVRP_LOG_EVENT( -2, current_timestep_number-1 )
 #endif
-
-!
-!--    Computation and output of run control parameters.
-!--    This is also done whenever perturbations have been imposed
-       IF ( time_run_control >= dt_run_control  .OR.                                               &
-            timestep_scheme(1:5) /= 'runge'  .OR.  disturbance_created )                           &
-       THEN
-          CALL run_control
-          IF ( time_run_control >= dt_run_control )  THEN
-             time_run_control = MOD( time_run_control, MAX( dt_run_control, dt_3d_old ) )
-          ENDIF
-       ENDIF
-
-!
-!--    Output elapsed simulated time in form of a progress bar on stdout
-       IF ( myid == 0 )  CALL output_progress_bar
-
-       IF ( debug_output_timestep )  THEN
-           WRITE( debug_string, * ) 'time_integration', simulated_time
-           CALL debug_message( debug_string, 'end' )
-       ENDIF
+       IF ( time_dvrp >= dt_dvrp )  THEN
+          CALL data_output_dvrp
+          time_dvrp = MOD( time_dvrp, MAX( dt_dvrp, dt_3d ) )
+       ENDIF
+#if defined( __dvrp_graphics )
+       CALL DVRP_LOG_EVENT( 2, current_timestep_number )
+#endif
+
+!
+!--    If required, set the heat flux for the next time step at a random value
+       IF ( constant_heatflux  .AND.  random_heatflux )  CALL disturb_heatflux
+
+!
+!--    Execute user-defined actions
+       CALL user_actions( 'after_timestep' )
 
        CALL cpu_log( log_point_s(10), 'timesteps', 'stop' )
 
-
     ENDDO   ! time loop
 
-#if defined( _OPENACC )
-    CALL exit_surface_arrays
+#if defined( __dvrp_graphics )
+    CALL DVRP_LOG_EVENT( -2, current_timestep_number )
 #endif
-!$ACC END DATA
-!$ACC END DATA
-!$ACC END DATA
-!$ACC END DATA
-!$ACC END DATA
-!$ACC END DATA
-!$ACC END DATA
-!$ACC END DATA
-
-    IF ( myid == 0 )  CALL finish_progress_bar
-
-    CALL location_message( 'atmosphere (and/or ocean) time-stepping', 'finished' )
 
  END SUBROUTINE time_integration
Index: palm/trunk/SOURCE/time_integration_spinup.f90
===================================================================
--- palm/trunk/SOURCE/time_integration_spinup.f90	(revision 4901)
+++ 	(revision )
@@ -1,725 +1,0 @@
-!> @file time_integration_spinup.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Bugfix in time-control of indoor model at the very first time step
-!
-! 4750 2020-10-16 14:27:48Z suehring
-! - bugfix, call hourly-based indoor model only once per hour, not every timestep.
-! - optionally switch-off/on the indoor model during spinup
-!
-! 4687 2020-09-21 19:40:16Z maronga
-! Indoor model is now available during spinup
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4669 2020-09-09 13:43:47Z pavelkrc
-! - Fix missing call of radiation after spinup
-! - Fix calculation of force_radiation_call
-! - Fix calculation of radiation times
-!
-! 4668 2020-09-09 13:00:16Z pavelkrc
-! Improve debug messages during timestepping
-!
-! 4654 2020-08-28 13:47:23Z pavelkrc
-! Add possibility to output surface data during spinup (author: J. Resler)
-!
-! 4635 2020-08-05 16:44:15Z suehring
-! Bugfix in calling radiation_control, was called every dt_spinup rather than only dt_radiation
-!
-! 4631 2020-08-03 13:48:14Z suehring
-! Set pt1 attribute only element-wise
-! 
-! 4540 2020-05-18 15:23:29Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! Use statement for exchange horiz added
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! Bugfix: cpp-directives for serial mode added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Enable output of diagnostic quantities, e.g. 2-m temperature
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! Implement new palm_date_time_mod
-!
-! 4223 2019-09-10 09:20:47Z gronemeier
-! Corrected "Former revisions" section
-!
-! 4064 2019-07-01 05:33:33Z gronemeier
-! Moved call to radiation module out of intermediate time loop
-!
-! 4023 2019-06-12 13:20:01Z maronga
-! Time stamps are now negative in run control output
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! Unused variable removed
-!
-! 3719 2019-02-06 13:10:18Z kanani
-! Removed log_point(19,54,74,50,75), since they count together with same log points in
-! time_integration, impossible to separate the contributions. Instead, the entire spinup gets an
-! individual log_point in palm.f90
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Removed call to calculation of near air (10 cm) potential temperature (now in surface layer fluxes)
-!
-! 2296 2017-06-28 07:53:56Z maronga
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Integration in time of the non-atmospheric model components such as land surface model and urban
-!> surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE time_integration_spinup
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  pt,                                                                                 &
-               pt_p,                                                                               &
-               u,                                                                                  &
-               u_init,                                                                             &
-               v,                                                                                  &
-               v_init
-
-    USE control_parameters,                                                                        &
-        ONLY:  averaging_interval_pr,                                                              &
-               constant_diffusion,                                                                 &
-               constant_flux_layer,                                                                &
-               coupling_start_time,                                                                &
-               data_output_during_spinup,                                                          &
-               debug_output_timestep,                                                              &
-               debug_string,                                                                       &
-               dopr_n,                                                                             &
-               do_sum,                                                                             &
-               dt_averaging_input_pr,                                                              &
-               dt_dopr,                                                                            &
-               dt_dots,                                                                            &
-               dt_do2d_xy,                                                                         &
-               dt_do3d,                                                                            &
-               dt_spinup,                                                                          &
-               dt_3d,                                                                              &
-               humidity,                                                                           &
-               indoor_model,                                                                       &
-               intermediate_timestep_count,                                                        &
-               intermediate_timestep_count_max,                                                    &
-               land_surface,                                                                       &
-               simulated_time,                                                                     &
-               simulated_time_chr,                                                                 &
-               skip_time_dopr,                                                                     &
-               skip_time_do2d_xy,                                                                  &
-               skip_time_do3d,                                                                     &
-               spinup_pt_amplitude,                                                                &
-               spinup_pt_mean,                                                                     &
-               spinup_time,                                                                        &
-               surface_output,                                                                     &
-               timestep_count,                                                                     &
-               time_dopr,                                                                          &
-               time_dopr_av,                                                                       &
-               time_dots,                                                                          &
-               time_do2d_xy,                                                                       &
-               time_do3d,                                                                          &
-               time_run_control,                                                                   &
-               time_since_reference_point,                                                         &
-               urban_surface
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE diagnostic_output_quantities_mod,                                                          &
-        ONLY:  doq_calculate
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               nysg,                                                                               &
-               nyng,                                                                               &
-               nxlg,                                                                               &
-               nxrg
-
-    USE indoor_model_mod,                                                                          &
-        ONLY:  dt_indoor,                                                                          &
-               im_main_heatcool,                                                                   &
-               indoor_during_spinup,                                                               &
-               time_indoor
-
-    USE land_surface_model_mod,                                                                    &
-        ONLY:  lsm_energy_balance,                                                                 &
-               lsm_swap_timelevel
-
-    USE pegrid
-
-#if defined( __parallel )
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run
-#endif
-
-    USE kinds
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  get_date_time,                                                                      &
-               seconds_per_hour
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  dt_radiation,                                                                       &
-               force_radiation_call,                                                               &
-               radiation,                                                                          &
-               radiation_control,                                                                  &
-               radiation_interaction,                                                              &
-               radiation_interactions,                                                             &
-               time_radiation
-
-    USE statistics,                                                                                &
-        ONLY:  flow_statistics_called
-
-    USE surface_data_output_mod,                                                                   &
-        ONLY:  dt_dosurf,                                                                          &
-               skip_time_dosurf,                                                                   &
-               surface_data_output,                                                                &
-               time_dosurf
-
-    USE surface_layer_fluxes_mod,                                                                  &
-        ONLY:  surface_layer_fluxes
-
-    USE surface_mod,                                                                               &
-        ONLY :  surf_lsm_h,                                                                        &
-                surf_lsm_v, surf_usm_h,                                                            &
-                surf_usm_v
-
-    USE urban_surface_mod,                                                                         &
-        ONLY:  usm_energy_balance,                                                                 &
-               usm_swap_timelevel
-
-
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1) ::  sign_chr                        !< String containing '-' or ' '
-    CHARACTER(LEN=9) ::  time_since_reference_point_chr  !< time since reference point, i.e., negative during spinup
-    CHARACTER(LEN=9) ::  time_to_string                  !<
-
-
-    INTEGER(iwp) ::  current_timestep_number_spinup = 0  !< number if timestep during spinup
-    INTEGER(iwp) ::  day_of_year                         !< day of the year
-
-    INTEGER(iwp) ::  i  !< running index
-    INTEGER(iwp) ::  j  !< running index
-    INTEGER(iwp) ::  k  !< running index
-    INTEGER(iwp) ::  l  !< running index
-    INTEGER(iwp) ::  m  !< running index
-
-
-    LOGICAL ::  run_control_header_spinup = .FALSE.  !< flag parameter for steering whether the header information must be output
-
-
-    REAL(wp) ::  dt_save        !< temporary storage for time step
-    REAL(wp) ::  pt_spinup      !< temporary storage of temperature
-    REAL(wp) ::  second_of_day  !< second of the day
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_save  !< temporary storage of temperature
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_save   !< temporary storage of u wind component
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_save   !< temporary storage of v wind component
-
-
-!
-!-- Save 3D arrays because they are to be changed for spinup purpose
-    ALLOCATE( pt_save(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( u_save(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( v_save(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-    CALL exchange_horiz( pt, nbgp )
-    CALL exchange_horiz( u,  nbgp )
-    CALL exchange_horiz( v,  nbgp )
-
-    pt_save = pt
-    u_save  = u
-    v_save  = v
-
-!
-!-- Set the same wall-adjacent velocity to all grid points. The sign of the original velocity field
-!-- must be preserved because the surface schemes crash otherwise. The precise reason is still
-!-- unknown. A minimum velocity of 0.1 m/s is used to maintain turbulent transfer at the surface.
-    IF ( land_surface )  THEN
-       DO  l = 0, 1
-          DO  m = 1, surf_lsm_h(l)%ns
-             i   = surf_lsm_h(l)%i(m)
-             j   = surf_lsm_h(l)%j(m)
-             k   = surf_lsm_h(l)%k(m)
-             u(k,j,i) = SIGN( 1.0_wp, u_init(k) ) * MAX( ABS( u_init(k) ), 0.1_wp)
-             v(k,j,i) = SIGN( 1.0_wp, v_init(k) ) * MAX( ABS( v_init(k) ), 0.1_wp)
-          ENDDO
-       ENDDO
-
-       DO  l = 0, 3
-          DO  m = 1, surf_lsm_v(l)%ns
-             i   = surf_lsm_v(l)%i(m)
-             j   = surf_lsm_v(l)%j(m)
-             k   = surf_lsm_v(l)%k(m)
-             u(k,j,i) = SIGN( 1.0_wp, u_init(k) ) * MAX( ABS( u_init(k) ), 0.1_wp)
-             v(k,j,i) = SIGN( 1.0_wp, v_init(k) ) * MAX( ABS( v_init(k) ), 0.1_wp)
-          ENDDO
-       ENDDO
-    ENDIF
-
-    IF ( urban_surface )  THEN
-       DO  l = 0, 1
-          DO  m = 1, surf_usm_h(l)%ns
-             i   = surf_usm_h(l)%i(m)
-             j   = surf_usm_h(l)%j(m)
-             k   = surf_usm_h(l)%k(m)
-             u(k,j,i) = SIGN( 1.0_wp, u_init(k) ) * MAX( ABS( u_init(k) ), 0.1_wp)
-             v(k,j,i) = SIGN( 1.0_wp, v_init(k) ) * MAX( ABS( v_init(k) ), 0.1_wp)
-          ENDDO
-       ENDDO
-
-       DO  l = 0, 3
-          DO  m = 1, surf_usm_v(l)%ns
-             i   = surf_usm_v(l)%i(m)
-             j   = surf_usm_v(l)%j(m)
-             k   = surf_usm_v(l)%k(m)
-             u(k,j,i) = SIGN( 1.0_wp, u_init(k) ) * MAX( ABS( u_init(k) ), 0.1_wp)
-             v(k,j,i) = SIGN( 1.0_wp, v_init(k) ) * MAX( ABS( v_init(k) ), 0.1_wp)
-          ENDDO
-       ENDDO
-    ENDIF
-
-    CALL exchange_horiz( u, nbgp )
-    CALL exchange_horiz( v, nbgp )
-
-    dt_save = dt_3d
-    dt_3d   = dt_spinup
-
-    CALL location_message( 'wall/soil spinup time-stepping', 'start' )
-!
-!-- Start of the time loop
-    DO  WHILE ( simulated_time < spinup_time )
-
-       CALL cpu_log( log_point_s(15), 'timesteps spinup', 'start' )
-
-       IF ( debug_output_timestep )  THEN
-           WRITE( debug_string, * ) 'time_integration_spinup', simulated_time
-           CALL debug_message( debug_string, 'start' )
-       ENDIF
-
-!
-!--    Start of intermediate step loop
-       intermediate_timestep_count = 0
-       DO  WHILE ( intermediate_timestep_count < intermediate_timestep_count_max )
-
-          intermediate_timestep_count = intermediate_timestep_count + 1
-
-!
-!--       Set the steering factors for the prognostic equations which depend on the timestep scheme
-          CALL timestep_scheme_steering
-
-
-!
-!--       Estimate a near-surface air temperature based on the position of the sun and user input
-!--       about mean temperature and amplitude. The time is shifted by one hour to simulate a lag
-!--       between air temperature and incoming radiation.
-          CALL get_date_time( simulated_time - spinup_time - seconds_per_hour,                     &
-                              day_of_year = day_of_year, second_of_day = second_of_day )
-
-          pt_spinup = spinup_pt_mean + spinup_pt_amplitude *                                       &
-                      solar_angle( day_of_year, second_of_day )
-
-!
-!--       Map air temperature to all grid points in the vicinity of a surface element
-          IF ( land_surface )  THEN
-             DO  l = 0, 1
-                DO  m = 1, surf_lsm_h(l)%ns
-                   i   = surf_lsm_h(l)%i(m)
-                   j   = surf_lsm_h(l)%j(m)
-                   k   = surf_lsm_h(l)%k(m)
-                   pt(k,j,i) = pt_spinup
-                ENDDO
-             ENDDO
-
-             DO  l = 0, 3
-                DO  m = 1, surf_lsm_v(l)%ns
-                   i   = surf_lsm_v(l)%i(m)
-                   j   = surf_lsm_v(l)%j(m)
-                   k   = surf_lsm_v(l)%k(m)
-                   pt(k,j,i) = pt_spinup
-                ENDDO
-             ENDDO
-          ENDIF
-
-          IF ( urban_surface )  THEN
-             DO  l = 0, 1
-                DO  m = 1, surf_usm_h(l)%ns
-                   i   = surf_usm_h(l)%i(m)
-                   j   = surf_usm_h(l)%j(m)
-                   k   = surf_usm_h(l)%k(m)
-                   pt(k,j,i) = pt_spinup
-                   !!!!!!!!!!!!!!!!HACK!!!!!!!!!!!!!
-                   surf_usm_h(l)%pt1(m) = pt_spinup
-                   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-                ENDDO
-             ENDDO
-
-             DO  l = 0, 3
-                DO  m = 1, surf_usm_v(l)%ns
-                   i   = surf_usm_v(l)%i(m)
-                   j   = surf_usm_v(l)%j(m)
-                   k   = surf_usm_v(l)%k(m)
-                   pt(k,j,i) = pt_spinup
-                   !!!!!!!!!!!!!!!!HACK!!!!!!!!!!!!!
-                   surf_usm_v(l)%pt1(m) = pt_spinup
-                   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-                ENDDO
-             ENDDO
-          ENDIF
-
-          CALL exchange_horiz( pt, nbgp )
-
-
-!
-!--       Swap the time levels in preparation for the next time step.
-          timestep_count = timestep_count + 1
-
-          IF ( land_surface )  THEN
-              CALL lsm_swap_timelevel ( 0 )
-          ENDIF
-
-          IF ( urban_surface )  THEN
-             CALL usm_swap_timelevel ( 0 )
-          ENDIF
-
-          IF ( land_surface )  THEN
-             CALL lsm_swap_timelevel ( MOD( timestep_count, 2 ) )
-          ENDIF
-
-          IF ( urban_surface )  THEN
-             CALL usm_swap_timelevel ( MOD( timestep_count, 2 ) )
-          ENDIF
-
-!
-!--       If required, compute virtual potential temperature
-          IF ( humidity )  THEN
-             CALL compute_vpt
-          ENDIF
-
-!
-!--       Compute the diffusion quantities
-          IF ( .NOT. constant_diffusion )  THEN
-
-!
-!--          First the vertical (and horizontal) fluxes in the surface (constant flux) layer are
-!--          computed
-             IF ( constant_flux_layer )  THEN
-                CALL surface_layer_fluxes
-             ENDIF
-
-!
-!--          If required, solve the energy balance for the surface and run soil model. Call for
-!--          horizontal as well as vertical surfaces. The prognostic equation for soil moisure is
-!--          switched off
-             IF ( land_surface )  THEN
-
-                CALL lsm_energy_balance( .TRUE. )
-
-             ENDIF
-
-!
-!--          If required, solve the energy balance for urban surfaces and run the material heat model
-             IF (urban_surface) THEN
-
-                CALL usm_energy_balance( .TRUE. )
-
-             ENDIF
-
-          ENDIF
-
-       ENDDO   ! Intermediate step loop
-
-!
-!--    If required, calculate radiative fluxes and heating rates
-       IF ( radiation )  THEN
-
-          time_radiation = time_radiation + dt_3d
-
-          IF ( time_radiation >= dt_radiation .OR. force_radiation_call )  THEN
-
-             IF ( .NOT. force_radiation_call )  THEN
-                time_radiation = time_radiation - dt_radiation
-             ENDIF
-
-             CALL radiation_control
-
-             IF ( radiation_interactions )  THEN
-                CALL radiation_interaction
-             ENDIF
-!
-!--          Reset forcing of radiation call
-             force_radiation_call = .FALSE.
-
-          ENDIF
-       ENDIF
-
-!
-!--    If required, calculate indoor temperature, waste heat, heat flux
-!--    through wall, etc.
-!--    dt_indoor steers the frequency of the indoor model calculations.
-!--    Note, at first timestep indoor model is called, in order to provide
-!--    a waste heat flux.
-       IF ( indoor_model  .AND.  indoor_during_spinup )  THEN
-
-          time_indoor = time_indoor + dt_3d
-
-          IF ( time_indoor >= dt_indoor  .OR.  current_timestep_number_spinup == 0 )  THEN
-
-             IF ( time_indoor >= dt_indoor )  time_indoor = time_indoor - dt_indoor
-
-             CALL im_main_heatcool
-
-          ENDIF
-       ENDIF
-
-!
-!--    Increase simulation time and output times
-       current_timestep_number_spinup = current_timestep_number_spinup + 1
-       simulated_time                 = simulated_time   + dt_3d
-       simulated_time_chr             = time_to_string( simulated_time )
-       time_since_reference_point     = simulated_time - coupling_start_time
-       time_since_reference_point_chr = time_to_string( ABS( time_since_reference_point ) )
-
-       IF ( time_since_reference_point < 0.0_wp )  THEN
-          sign_chr = '-'
-       ELSE
-          sign_chr = ' '
-       ENDIF
-
-
-       IF ( data_output_during_spinup )  THEN
-          IF ( simulated_time >= skip_time_do2d_xy )  THEN
-             time_do2d_xy      = time_do2d_xy     + dt_3d
-          ENDIF
-          IF ( simulated_time >= skip_time_do3d    )  THEN
-             time_do3d         = time_do3d        + dt_3d
-          ENDIF
-          time_dots            = time_dots        + dt_3d
-          IF ( simulated_time >= skip_time_dopr )  THEN
-             time_dopr         = time_dopr        + dt_3d
-          ENDIF
-          IF ( surface_output )  THEN
-             IF ( simulated_time >= skip_time_dosurf )  THEN
-                time_dosurf    = time_dosurf + dt_3d
-             ENDIF
-          ENDIF
-          time_run_control     = time_run_control + dt_3d
-
-!
-!--       Carry out statistical analysis and output at the requested output times.
-!--       The MOD function is used for calculating the output time counters (like time_dopr) in
-!--       order to regard a possible decrease of the output time interval in case of restart runs.
-
-!
-!--       Set a flag indicating that so far no statistics have been created for this time step
-          flow_statistics_called = .FALSE.
-
-!
-!--       If required, call flow_statistics for averaging in time
-          IF ( averaging_interval_pr /= 0.0_wp  .AND.                                              &
-               ( dt_dopr - time_dopr ) <= averaging_interval_pr  .AND.                             &
-               simulated_time >= skip_time_dopr )                                                  &
-          THEN
-             time_dopr_av = time_dopr_av + dt_3d
-             IF ( time_dopr_av >= dt_averaging_input_pr )  THEN
-                do_sum = .TRUE.
-                time_dopr_av = MOD( time_dopr_av, MAX( dt_averaging_input_pr, dt_3d ) )
-             ENDIF
-          ENDIF
-          IF ( do_sum )  CALL flow_statistics
-
-!
-!--       Output of profiles
-          IF ( time_dopr >= dt_dopr )  THEN
-             IF ( dopr_n /= 0 )  CALL data_output_profiles
-             time_dopr = MOD( time_dopr, MAX( dt_dopr, dt_3d ) )
-             time_dopr_av = 0.0_wp    ! Due to averaging (see above)
-          ENDIF
-
-!
-!--       Output of time series
-          IF ( time_dots >= dt_dots )  THEN
-             CALL data_output_tseries
-             time_dots = MOD( time_dots, MAX( dt_dots, dt_3d ) )
-          ENDIF
-
-!
-!--       2d-data output (cross-sections)
-          IF ( time_do2d_xy >= dt_do2d_xy )  THEN
-             CALL doq_calculate
-             CALL data_output_2d( 'xy', 0 )
-             time_do2d_xy = MOD( time_do2d_xy, MAX( dt_do2d_xy, dt_3d ) )
-          ENDIF
-
-!
-!--       3d-data output (volume data)
-          IF ( time_do3d >= dt_do3d )  THEN
-             CALL doq_calculate
-             CALL data_output_3d( 0 )
-             time_do3d = MOD( time_do3d, MAX( dt_do3d, dt_3d ) )
-          ENDIF
-!
-!--       Output of surface data
-          IF ( surface_output )  THEN
-             IF ( time_dosurf >= dt_dosurf )  THEN
-                CALL surface_data_output( 0 )
-                time_dosurf = MOD( time_dosurf, MAX( dt_dosurf, dt_3d ) )
-             ENDIF
-          ENDIF
-
-       ENDIF
-
-!
-!--    Computation and output of run control parameters. This is also done whenever perturbations
-!--    have been imposed
-!        IF ( time_run_control >= dt_run_control  .OR.                                              &
-!             timestep_scheme(1:5) /= 'runge'  .OR.  disturbance_created )  THEN
-!           CALL run_control
-!           IF ( time_run_control >= dt_run_control )  THEN
-!              time_run_control = MOD( time_run_control, MAX( dt_run_control, dt_3d ) )
-!           ENDIF
-!        ENDIF
-
-       CALL cpu_log( log_point_s(15), 'timesteps spinup', 'stop' )
-
-
-!
-!--    Run control output
-       IF ( myid == 0 )  THEN
-!
-!--       If necessary, write header
-          IF ( .NOT. run_control_header_spinup )  THEN
-             CALL check_open( 15 )
-             WRITE ( 15, 100 )
-             run_control_header_spinup = .TRUE.
-          ENDIF
-!
-!--       Write some general information about the spinup in run control file
-          WRITE ( 15, 101 )  current_timestep_number_spinup, sign_chr,                             &
-                             time_since_reference_point_chr, dt_3d, pt_spinup
-!
-!--       Write buffer contents to disc immediately
-          FLUSH( 15 )
-       ENDIF
-
-       IF ( debug_output_timestep )  THEN
-           WRITE( debug_string, * ) 'time_integration_spinup', simulated_time
-           CALL debug_message( debug_string, 'end' )
-       ENDIF
-
-
-    ENDDO   ! Time loop
-
-!
-!-- Write back saved arrays to the 3D arrays
-    pt   = pt_save
-    pt_p = pt_save
-    u    = u_save
-    v    = v_save
-
-!
-!-- Reset time step
-    dt_3d = dt_save
-!-- Force radiation step in time zero
-!-- It is performed at the end of init_radiation in case of run without spinup
-    time_radiation = dt_radiation
-
-    DEALLOCATE(pt_save)
-    DEALLOCATE(u_save)
-    DEALLOCATE(v_save)
-
-#if defined( __parallel )
-    IF ( nested_run )  CALL MPI_BARRIER( MPI_COMM_WORLD, ierr )
-#endif
-
-    CALL location_message( 'wall/soil spinup time-stepping', 'finished' )
-
-
-!
-!-- Formats
-100 FORMAT (///'Spinup control output:---------------------------------'//                         &
-            'ITER.   HH:MM:SS    DT   PT(z_MO)---------------------------------')
-101 FORMAT (I5,2X,A1,A9,1X,F6.2,3X,F6.2,2X,F6.2)
-
- CONTAINS
-
-!
-!-- Returns the cosine of the solar zenith angle at a given time. This routine is similar to that
-!-- for calculation zenith (see radiation_model_mod.f90)
-    !> @todo Load function calc_zenith of radiation model instead of rewrite the function here.
-    FUNCTION solar_angle( day_of_year, second_of_day )
-
-       USE basic_constants_and_equations_mod,                                                      &
-           ONLY:  pi
-
-       USE kinds
-
-       USE radiation_model_mod,                                                                    &
-           ONLY:  decl_1,                                                                          &
-                  decl_2,                                                                          &
-                  decl_3,                                                                          &
-                  lat,                                                                             &
-                  lon
-
-       IMPLICIT NONE
-
-
-       INTEGER(iwp), INTENT(IN) ::  day_of_year  !< day of the year
-
-       REAL(wp)             ::  declination    !< solar declination angle
-       REAL(wp)             ::  hour_angle     !< solar hour angle
-       REAL(wp), INTENT(IN) ::  second_of_day  !< current time of the day in UTC
-       REAL(wp)             ::  solar_angle    !< cosine of the solar zenith angle
-!
-!--    Calculate solar declination and hour angle
-       declination = ASIN( decl_1 * SIN( decl_2 * REAL( day_of_year, KIND = wp) - decl_3 ) )
-       hour_angle  = 2.0_wp * pi * ( second_of_day / 86400.0_wp ) + lon - pi
-
-!
-!--    Calculate cosine of solar zenith angle
-       solar_angle = SIN( lat ) * SIN( declination ) + COS( lat ) * COS( declination ) *           &
-                     COS( hour_angle )
-
-    END FUNCTION solar_angle
-
-
- END SUBROUTINE time_integration_spinup
Index: palm/trunk/SOURCE/time_to_string.f90
===================================================================
--- palm/trunk/SOURCE/time_to_string.f90	(revision 4901)
+++ palm/trunk/SOURCE/time_to_string.f90	(revision 1)
@@ -1,36 +1,17 @@
-!> @file time_to_string.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ FUNCTION time_to_string( time )
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
+! $Log: time_to_string.f90,v $
+! Revision 1.3  2001/01/22 08:16:04  raasch
+! Comments translated into English
 !
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
+! Revision 1.2  1998/03/09 16:24:53  raasch
+! Dreistellige Stundenausgabe ermoeglicht
 !
 ! Revision 1.1  1997/08/11 06:26:08  raasch
@@ -40,27 +21,18 @@
 ! Description:
 ! ------------
-!> Transforming the time from real to character-string hh:mm:ss
-!--------------------------------------------------------------------------------------------------!
- FUNCTION time_to_string( time )
-
-
-    USE kinds
+! Transforming the time from real to character-string hh:mm:ss
+!-------------------------------------------------------------------------------!
 
     IMPLICIT NONE
 
-    CHARACTER(LEN=9) ::  time_to_string  !<
-
-    INTEGER(iwp)     ::  hours    !<
-    INTEGER(iwp)     ::  minutes  !<
-    INTEGER(iwp)     ::  seconds  !<
-
-    REAL(wp)         ::  rest_time  !<
-    REAL(wp)         ::  time       !<
+    CHARACTER (LEN=9) ::  time_to_string
+    INTEGER           ::  hours, minutes, seconds
+    REAL              ::  rest_time, time
 
 !
 !-- Calculate the number of hours, minutes, and seconds
-    hours     = INT( time / 3600.0_wp )
-    rest_time = time - hours * 3600_wp
-    minutes   = INT( rest_time / 60.0_wp )
+    hours     = INT( time / 3600.0 )
+    rest_time = time - hours * 3600
+    minutes   = INT( rest_time / 60.0 )
     seconds   = rest_time - minutes * 60
 
@@ -68,7 +40,9 @@
 !-- Build the string
     IF ( hours < 100 )  THEN
-       WRITE (time_to_string,'(I2.2,'':'',I2.2,'':'',I2.2)')  hours, minutes, seconds
+       WRITE (time_to_string,'(I2.2,'':'',I2.2,'':'',I2.2)')  hours, minutes, &
+                                                              seconds
     ELSE
-       WRITE (time_to_string,'(I3.3,'':'',I2.2,'':'',I2.2)')  hours, minutes, seconds
+       WRITE (time_to_string,'(I3.3,'':'',I2.2,'':'',I2.2)')  hours, minutes, &
+                                                              seconds
     ENDIF
 
Index: palm/trunk/SOURCE/timestep.f90
===================================================================
--- palm/trunk/SOURCE/timestep.f90	(revision 4901)
+++ palm/trunk/SOURCE/timestep.f90	(revision 1)
@@ -1,57 +1,81 @@
-!> @file timestep.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ SUBROUTINE timestep
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
-! directives (J. Resler)
-! 
-! 4564 2020-06-12 14:03:36Z raasch
-! Vertical nesting method of Huq et al. (2019) removed
-! 
-! 4540 2020-05-18 15:23:29Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4444 2020-03-05 15:59:50Z raasch
-! Bugfix: cpp-directives for serial mode added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Added missing OpenMP directives
-!
-! 4233 2019-09-20 09:55:54Z knoop
-! OpenACC data update host removed
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4101 2019-07-17 15:14:26Z gronemeier
-! - Consider 2*Km within diffusion criterion as Km is considered twice within the diffusion of e,
-! - in RANS mode, instead of considering each wind component individually use the wind speed of 3d
-!   wind vector in CFL criterion
-! - Do not limit the increase of dt based on its previous value in RANS mode
-!
-! 3658 2019-01-07 20:28:54Z knoop
-! OpenACC port for SPEC
+! $Log: timestep.f90,v $
+! Revision 1.21  2006/02/23 12:59:44  raasch
+! nt_anz renamed current_timestep_number
+!
+! Revision 1.20  2005/04/23 09:45:38  raasch
+! fcl_factor renamed cfl_factor
+!
+! Revision 1.19  2005/03/26 21:11:53  raasch
+! In case of non-cyclic lateral boundary conditions, the increased diffusivity
+! in the lateral damping layer is regarded in the minimum timestep calculation.
+!
+! Revision 1.18  2004/01/30 10:40:02  raasch
+! Timestep increment limitation in case of Runge-Kutta removed
+!
+! Revision 1.17  2004/01/28 15:34:03  raasch
+! Setting of steering factors for the prognostic equations moved to new
+! routine timestep_scheme_steering now called in routine leap_frog.
+!
+! Revision 1.16  2003/03/16 09:49:47  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.15  2002/12/19 16:19:54  raasch
+! Two mpi_allreduce calls for determining mean horizontal velocity reduced to
+! one call. Calculation of minimum timestep for diffusion optimized by
+! determining minimum grid spacing in a single k loop.
+!
+! Revision 1.14  2001/03/30 07:55:12  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.13  2001/01/30 22:10:11  letzel
+! All comments translated into English.
+!
+! Revision 1.12  2001/01/22 08:17:33  raasch
+! Module test_variables removed
+!
+! Revision 1.11  2000/01/10 10:10:30  raasch
+! Translationsgeschwindigkeit fuer Galilei-Transformation wird nur noch
+! bedingt berechnet
+!
+! Revision 1.10  1999/02/05 09:19:06  raasch
+! Zeitschrittsteuerung beruecksichtigt jetzt auch Wahl des reinen Euler-
+! Verfahrens
+!
+! Revision 1.9  1998/09/22 17:30:41  raasch
+! Ausfuehrlichere Informationen bei Abbruch durch Unterschreitung des
+! minimalen Zeitschritts
+!
+! Revision 1.8  1998/07/06 12:33:52  raasch
+! Korrektur der ermittelten horizontalen Geschwindigkeitsmaxima, falls diese
+! bei k=0 gefunden wurden (wegen Spiegelungsrandbedingung treten dort negative
+! Werte auf, die bei Galilei-Transformation den Zeitschritt erheblich
+! einschraenken). + USE test_variables
+!
+! Revision 1.7  1998/04/21 15:57:46  raasch
+! Implementierung der Galilei-Transformation
+!
+! Revision 1.6  1998/03/25 13:57:20  raasch
+! dt in dt_3d umbenannt
+!
+! Revision 1.5  1998/03/09 16:25:10  raasch
+! Schoenheitskorrekturen
+!
+! Revision 1.4  1998/03/03 08:02:15  raasch
+! Leap-Frog auch nach Zeitschrittaenderung erlaubt
+!
+! Revision 1.3  1997/09/12 06:30:27  raasch
+! Einbau des Diffusions-Kriteriums
+!
+! Revision 1.2  1997/08/26 06:34:55  raasch
+! Fehler bei w_max_ijk - Index
 !
 ! Revision 1.1  1997/08/11 06:26:19  raasch
@@ -61,117 +85,25 @@
 ! Description:
 ! ------------
-!> Compute the time step under consideration of the FCL and diffusion criterion.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE timestep
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzu,                                                                                &
-               dzw,                                                                                &
-               kh,                                                                                 &
-               km,                                                                                 &
-               u,                                                                                  &
-               u_stokes_zu,                                                                        &
-               v,                                                                                  &
-               v_stokes_zu,                                                                        &
-               w
-
-    USE control_parameters,                                                                        &
-        ONLY:  cfl_factor,                                                                         &
-               dt_3d,                                                                              &
-               dt_fixed,                                                                           &
-               dt_max,                                                                             &
-               galilei_transformation,                                                             &
-               message_string,                                                                     &
-               rans_mode,                                                                          &
-               stop_dt,                                                                            &
-               timestep_reason,                                                                    &
-               u_gtrans,                                                                           &
-               use_ug_for_galilei_tr,                                                              &
-               v_gtrans
-
-#if defined( __parallel )
-    USE control_parameters,                                                                        &
-        ONLY:  coupling_mode,                                                                      &
-               terminate_coupled,                                                                  &
-               terminate_coupled_remote
-#endif
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx,                                                                                 &
-               dx2,                                                                                &
-               dy,                                                                                 &
-               dy2
-
-    USE indices,                                                                                   &
-        ONLY:  nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nzb,                                                                                &
-               nzt
-
+! Compute the time step under consideration of the FCL and diffusion criterion.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE control_parameters
+    USE cpulog
+    USE grid_variables
+    USE indices
     USE interfaces
-
-    USE kinds
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  dt_precipitation
-
     USE pegrid
-
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run
-
-    USE statistics,                                                                                &
-        ONLY:  flow_statistics_called,                                                             &
-               hom,                                                                                &
-               u_max,                                                                              &
-               u_max_ijk,                                                                          &
-               v_max,                                                                              &
-               v_max_ijk,                                                                          &
-               w_max,                                                                              &
-               w_max_ijk
+    USE statistics
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-    INTEGER(iwp) ::  km_max_ijk(3) = -1  !< index values (i,j,k) of location where km_max occurs
-    INTEGER(iwp) ::  kh_max_ijk(3) = -1  !< index values (i,j,k) of location where kh_max occurs
-
-    LOGICAL ::  stop_dt_local  !< local switch for controlling the time stepping
-
-    REAL(wp) ::  div         !<
-    REAL(wp) ::  dt_diff     !<
-    REAL(wp) ::  dt_diff_l   !<
-    REAL(wp) ::  dt_u        !<
-    REAL(wp) ::  dt_u_l      !<
-    REAL(wp) ::  dt_v        !<
-    REAL(wp) ::  dt_v_l      !<
-    REAL(wp) ::  dt_w        !<
-    REAL(wp) ::  dt_w_l      !<
-    REAL(wp) ::  km_max      !< maximum of Km in entire domain
-    REAL(wp) ::  kh_max      !< maximum of Kh in entire domain
-    REAL(wp) ::  u_gtrans_l  !<
-    REAL(wp) ::  v_gtrans_l  !<
-
-    REAL(wp), DIMENSION(2)         ::  uv_gtrans_l  !<
-#if defined( __parallel )
-    REAL(wp), DIMENSION(2)         ::  uv_gtrans    !<
-    REAL(wp), DIMENSION(3)         ::  reduce       !<
-    REAL(wp), DIMENSION(3)         ::  reduce_l     !<
-#endif
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dxyz2_min    !<
-    !$ACC DECLARE CREATE(dxyz2_min)
+    INTEGER ::  i, j, k
+
+    REAL ::  div, dt_diff, dt_diff_l, dt_u, dt_v, dt_w, percent_change, &
+             u_gtrans_l, value, v_gtrans_l
+
+    REAL, DIMENSION(2)         ::  uv_gtrans, uv_gtrans_l
+    REAL, DIMENSION(nzb+1:nzt) ::  dxyz2_min
 
 
@@ -179,39 +111,66 @@
 
 !
-!-- In case of Galilei-transform not using the geostrophic wind as translation velocity, compute the
-!-- volume-averaged horizontal velocity components, which will then be subtracted from the
-!-- horizontal wind for the time step and horizontal advection routines.
+!-- Determine the maxima of the velocity components.
+    CALL global_min_max( nzb, nzt+1, nys-1, nyn+1, nxl-1, nxr+1, u, 'abs', &
+                         u_max, u_max_ijk )
+    CALL global_min_max( nzb, nzt+1, nys-1, nyn+1, nxl-1, nxr+1, v, 'abs', &
+                         v_max, v_max_ijk )
+    CALL global_min_max( nzb, nzt+1, nys-1, nyn+1, nxl-1, nxr+1, w, 'abs', &
+                         w_max, w_max_ijk )
+
+!
+!-- In case maxima of the horizontal velocity components have been found at the
+!-- bottom boundary (k=nzb), the corresponding maximum at level k=1 is chosen
+!-- if the Dirichlet-boundary condition ('mirror') has been set. This is 
+!-- necessary, because otherwise in case of Galilei-transform a far too large
+!-- velocity (having the respective opposite sign) would be used for the time
+!-- step determination (almost double the mean flow velocity).
+    IF ( ibc_uv_b == 0 )  THEN
+       IF ( u_max_ijk(1) == nzb )  THEN
+          u_max        = -u_max
+          u_max_ijk(1) = nzb + 1
+       ENDIF
+       IF ( v_max_ijk(1) == nzb )  THEN
+          v_max        = -v_max
+          v_max_ijk(1) = nzb + 1
+       ENDIF
+    ENDIF
+
+!
+!-- In case of Galilei-transform not using the geostrophic wind as translation
+!-- velocity, compute the volume-averaged horizontal velocity components, which
+!-- will then be subtracted from the horizontal wind for the time step and
+!-- horizontal advection routines.
     IF ( galilei_transformation  .AND. .NOT.  use_ug_for_galilei_tr )  THEN
        IF ( flow_statistics_called )  THEN
 !
-!--       Horizontal averages already existent, just need to average them vertically.
-          u_gtrans = 0.0_wp
-          v_gtrans = 0.0_wp
+!--       Horizontal averages already existent, just need to average them 
+!--       vertically.
+          u_gtrans = 0.0
+          v_gtrans = 0.0
           DO  k = nzb+1, nzt
              u_gtrans = u_gtrans + hom(k,1,1,0)
              v_gtrans = v_gtrans + hom(k,1,2,0)
           ENDDO
-          u_gtrans = u_gtrans / REAL( nzt - nzb, KIND = wp )
-          v_gtrans = v_gtrans / REAL( nzt - nzb, KIND = wp )
+          u_gtrans = u_gtrans / REAL( nzt - nzb )
+          v_gtrans = v_gtrans / REAL( nzt - nzb )
        ELSE
 !
 !--       Averaging over the entire model domain.
-          u_gtrans_l = 0.0_wp
-          v_gtrans_l = 0.0_wp
+          uv_gtrans_l = 0.0
           DO  i = nxl, nxr
              DO  j = nys, nyn
                 DO  k = nzb+1, nzt
-                   u_gtrans_l = u_gtrans_l + u(k,j,i)
-                   v_gtrans_l = v_gtrans_l + v(k,j,i)
+                   uv_gtrans_l(1) = uv_gtrans_l(1) + u(k,j,i)
+                   uv_gtrans_l(2) = uv_gtrans_l(2) + v(k,j,i)
                 ENDDO
              ENDDO
           ENDDO
-          uv_gtrans_l(1) = u_gtrans_l / REAL( (nxr-nxl+1) * (nyn-nys+1) * (nzt-nzb), KIND = wp )
-          uv_gtrans_l(2) = v_gtrans_l / REAL( (nxr-nxl+1) * (nyn-nys+1) * (nzt-nzb), KIND = wp )
+          uv_gtrans_l = uv_gtrans_l / REAL( (nxr-nxl+1)*(nyn-nys+1)*(nzt-nzb) )
 #if defined( __parallel )
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_ALLREDUCE( uv_gtrans_l, uv_gtrans, 2, MPI_REAL, MPI_SUM, comm2d, ierr )
-          u_gtrans = uv_gtrans(1) / REAL( numprocs, KIND = wp )
-          v_gtrans = uv_gtrans(2) / REAL( numprocs, KIND = wp )
+          CALL MPI_ALLREDUCE( uv_gtrans_l, uv_gtrans, 2, MPI_REAL, MPI_SUM, &
+                              comm2d, ierr )
+          u_gtrans = uv_gtrans(1) / REAL( numprocs )
+          v_gtrans = uv_gtrans(2) / REAL( numprocs )
 #else
           u_gtrans = uv_gtrans_l(1)
@@ -221,109 +180,41 @@
     ENDIF
 
-!
-!-- Determine the maxima of the velocity components, including their grid index positions.
-    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, u, 'abs', 0.0_wp, u_max, u_max_ijk )
-    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, v, 'abs', 0.0_wp, v_max, v_max_ijk )
-    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, w, 'abs', 0.0_wp, w_max, w_max_ijk )
-
     IF ( .NOT. dt_fixed )  THEN
 !
 !--    Variable time step:
-!--    Calculate the maximum time step according to the CFL-criterion
-       dt_u_l = 999999.9_wp
-       dt_v_l = 999999.9_wp
-       dt_w_l = 999999.9_wp
-
-       IF ( .NOT. rans_mode )  THEN
-!
-!--       Consider each velocity component individually
-
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-          !$ACC COPY(dt_u_l, dt_v_l, dt_w_l, u_stokes_zu, v_stokes_zu) &
-          !$ACC REDUCTION(MIN: dt_u_l, dt_v_l, dt_w_l) &
-          !$ACC PRESENT(u, v, w, dzu)
-          !$OMP PARALLEL DO PRIVATE(i,j,k) &
-          !$OMP REDUCTION(MIN: dt_u_l, dt_v_l, dt_w_l)
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   dt_u_l = MIN( dt_u_l, ( dx / ( ABS( u(k,j,i) - u_gtrans + u_stokes_zu(k) )      &
-                                                  + 1.0E-10_wp ) ) )
-                   dt_v_l = MIN( dt_v_l, ( dy / ( ABS( v(k,j,i) - v_gtrans + v_stokes_zu(k) )      &
-                                                  + 1.0E-10_wp ) ) )
-                   dt_w_l = MIN( dt_w_l, ( dzu(k) / ( ABS( w(k,j,i) ) + 1.0E-10_wp ) ) )
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ELSE
-!
-!--       Consider the wind speed at the scalar-grid point
-!--       !> @note Considering the wind speed instead of each individual wind component is only a
-!--       !>       workaround so far. This has to be changed in the future.
-
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-          !$ACC COPY(dt_u_l, u_stokes_zu, v_stokes_zu) &
-          !$ACC REDUCTION(MIN: dt_u_l) &
-          !$ACC PRESENT(u, v, w, dzu)
-          !$OMP PARALLEL DO PRIVATE(i,j,k) &
-          !$OMP REDUCTION(MIN: dt_u_l)
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   dt_u_l = MIN( dt_u_l, ( MIN( dx, dy, dzu(k) ) / ( SQRT(                         &
-                            ( 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans + u_stokes_zu(k) )**2     &
-                          + ( 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans + v_stokes_zu(k) )**2     &
-                          + ( 0.5 * ( w(k,j,i) + w(k-1,j,i) ) )**2 ) + 1.0E-10_wp ) ) )
-                ENDDO
-             ENDDO
-          ENDDO
-
-          dt_v_l = dt_u_l
-          dt_w_l = dt_u_l
-
-       ENDIF
-
-#if defined( __parallel )
-       reduce_l(1) = dt_u_l
-       reduce_l(2) = dt_v_l
-       reduce_l(3) = dt_w_l
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( reduce_l, reduce, 3, MPI_REAL, MPI_MIN, comm2d, ierr )
-       dt_u = reduce(1)
-       dt_v = reduce(2)
-       dt_w = reduce(3)
-#else
-       dt_u = dt_u_l
-       dt_v = dt_v_l
-       dt_w = dt_w_l
-#endif
+!
+!--    For each component, compute the maximum time step according to the 
+!--    FCL-criterion.
+       dt_u = dx / ( ABS( u_max - u_gtrans ) + 1.0E-10 )
+       dt_v = dy / ( ABS( v_max - v_gtrans ) + 1.0E-10 )
+       dt_w = dzu(MAX( 1, w_max_ijk(1) )) / ( ABS( w_max ) + 1.0E-10 )
 
 !
 !--    Compute time step according to the diffusion criterion.
-!--    First calculate minimum grid spacing which only depends on index k. When using the dynamic
-!--    subgrid model, negative km are possible.
-       dt_diff_l = 999999.0_wp
-
-       !$ACC PARALLEL LOOP PRESENT(dxyz2_min, dzw)
+!--    First calculate minimum grid spacing which only depends on index k
+!--    Note: also at k=nzb+1 a full grid length is being assumed, although
+!--          in the Prandtl-layer friction term only dz/2 is used.
+!--          Experience from the old model seems to justify this.
+       dt_diff_l = 999999.0
+
        DO  k = nzb+1, nzt
-           dxyz2_min(k) = MIN( dx2, dy2, dzw(k) * dzw(k) ) * 0.125_wp
+           dxyz2_min(k) = MIN( dx2, dy2, dzu(k)*dzu(k) ) * 0.125
        ENDDO
 
-       !$OMP PARALLEL DO private(i,j,k) reduction(MIN: dt_diff_l)
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-       !$ACC COPY(dt_diff_l) REDUCTION(MIN: dt_diff_l) &
-       !$ACC PRESENT(dxyz2_min, kh, km)
+!$OMP PARALLEL private(i,j,k,value) reduction(MIN: dt_diff_l)
+!$OMP DO
        DO  i = nxl, nxr
           DO  j = nys, nyn
              DO  k = nzb+1, nzt
-                dt_diff_l = MIN( dt_diff_l, dxyz2_min(k) / ( MAX( kh(k,j,i), 2.0_wp *              &
-                            ABS( km(k,j,i) ) ) + 1E-20_wp ) )
+                value = dxyz2_min(k) / ( MAX( kh(k,j,i), km(k,j,i) ) + 1E-20 )
+
+                dt_diff_l = MIN( value, dt_diff_l )
              ENDDO
           ENDDO
        ENDDO
+!$OMP END PARALLEL 
 #if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( dt_diff_l, dt_diff, 1, MPI_REAL, MPI_MIN, comm2d, ierr )
+       CALL MPI_ALLREDUCE( dt_diff_l, dt_diff, 1, MPI_REAL, MPI_MIN, comm2d, &
+                           ierr )
 #else
        dt_diff = dt_diff_l
@@ -331,13 +222,30 @@
 
 !
-!--    The time step is the minimum of the 3-4 components and the diffusion time step minus a
-!--    reduction (cfl_factor) to be on the safe side.
+!--    In case of non-cyclic lateral boundaries, the diffusion time step
+!--    may be further restricted by the lateral damping layer (damping only
+!--    along x and y)
+       IF ( bc_lr /= 'cyclic' )  THEN
+          dt_diff = MIN( dt_diff, 0.125 * dx2 / ( km_damp_max + 1E-20 ) )
+       ELSEIF ( bc_ns /= 'cyclic' )  THEN
+          dt_diff = MIN( dt_diff, 0.125 * dy2 / ( km_damp_max + 1E-20 ) )
+       ENDIF
+
+!
+!--    The time step is the minimum of the 3 components and the diffusion time 
+!--    step minus a reduction to be on the safe side. Factor 0.5 is necessary 
+!--    since the leap-frog scheme always progresses by 2 * delta t.
+!--    The user has to set the cfl_factor small enough to ensure that the 
+!--    divergences do not become too large.
 !--    The time step must not exceed the maximum allowed value.
-       dt_3d = cfl_factor * MIN( dt_diff, dt_u, dt_v, dt_w, dt_precipitation )
+       IF ( timestep_scheme(1:5) == 'runge' )  THEN
+          dt_3d = cfl_factor * MIN( dt_diff, dt_u, dt_v, dt_w )
+       ELSE
+          dt_3d = cfl_factor * 0.5 * MIN( dt_diff, dt_u, dt_v, dt_w )
+       ENDIF
        dt_3d = MIN( dt_3d, dt_max )
 
 !
 !--    Remember the restricting time step criterion for later output.
-       IF ( MIN( dt_u, dt_v, dt_w ) < dt_diff )  THEN
+       IF ( dt_diff > MIN( dt_u, dt_v, dt_w ) )  THEN
           timestep_reason = 'A'
        ELSE
@@ -347,65 +255,81 @@
 !
 !--    Set flag if the time step becomes too small.
-       IF ( dt_3d < ( 0.00001_wp * dt_max ) )  THEN
+       IF ( dt_3d < ( 0.00001 * dt_max ) )  THEN
           stop_dt = .TRUE.
-
-!
-!--       Determine the maxima of the diffusion coefficients, including their grid index positions.
-          CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, km, 'abs', 0.0_wp, km_max,      &
-                               km_max_ijk )
-          CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, kh, 'abs', 0.0_wp, kh_max,      &
-                               kh_max_ijk )
-
-          WRITE( message_string, * ) 'Time step has reached minimum limit.',                       &
-               '&dt              = ', dt_3d, ' s  Simulation is terminated.',                      &
-               '&dt_u            = ', dt_u, ' s',                                                  &
-               '&dt_v            = ', dt_v, ' s',                                                  &
-               '&dt_w            = ', dt_w, ' s',                                                  &
-               '&dt_diff         = ', dt_diff, ' s',                                               &
-               '&u_max           = ', u_max, ' m/s    k=', u_max_ijk(1),                           &
-               '  j=', u_max_ijk(2), '  i=', u_max_ijk(3),                                         &
-               '&v_max           = ', v_max, ' m/s    k=', v_max_ijk(1),                           &
-               '  j=', v_max_ijk(2), '  i=', v_max_ijk(3),                                         &
-               '&w_max           = ', w_max, ' m/s    k=', w_max_ijk(1),                           &
-               '  j=', w_max_ijk(2), '  i=', w_max_ijk(3),                                         &
-               '&km_max          = ', km_max, ' m2/s2  k=', km_max_ijk(1),                         &
-               '  j=', km_max_ijk(2), '  i=', km_max_ijk(3),                                       &
-               '&kh_max          = ', kh_max, ' m2/s2  k=', kh_max_ijk(1),                         &
-                '  j=', kh_max_ijk(2), '  i=', kh_max_ijk(3)
-          CALL message( 'timestep', 'PA0312', 0, 1, 0, 6, 0 )
-!
-!--       In case of coupled runs inform the remote model of the termination and its reason,
-!--       provided the remote model has not already been informed of another termination reason
-!--       (terminate_coupled > 0).
-#if defined( __parallel )
-          IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0 )  THEN
-             terminate_coupled = 2
-             IF ( myid == 0 )  THEN
-                CALL MPI_SENDRECV( terminate_coupled, 1, MPI_INTEGER, target_id, 0,                &
-                                   terminate_coupled_remote, 1, MPI_INTEGER, target_id,  0,        &
-                                   comm_inter, status, ierr )
+          IF ( myid == 0 )  THEN
+             PRINT*,'+++ time_step: Time step has reached minimum limit.'
+             PRINT*,'    dt      = ', dt_3d, ' s   Simulation is terminated.'
+             PRINT*,'    old_dt  = ', old_dt, ' s'
+             PRINT*,'    dt_u    = ', dt_u, ' s'
+             PRINT*,'    dt_v    = ', dt_v, ' s'
+             PRINT*,'    dt_w    = ', dt_w, ' s'
+             PRINT*,'    dt_diff = ', dt_diff, ' s'
+             PRINT*,'    u_max   = ', u_max, ' m/s   k=', u_max_ijk(1), &
+                    '  j=', u_max_ijk(2), '  i=', u_max_ijk(3)
+             PRINT*,'    v_max   = ', v_max, ' m/s   k=', v_max_ijk(1), &
+                    '  j=', v_max_ijk(2), '  i=', v_max_ijk(3)
+             PRINT*,'    w_max   = ', w_max, ' m/s   k=', w_max_ijk(1), &
+                    '  j=', w_max_ijk(2), '  i=', w_max_ijk(3)
+          ENDIF
+       ENDIF
+
+!
+!--    Ensure a smooth value (two significant digits) of the timestep. For
+!--    other schemes than Runge-Kutta, the following restrictions appear:
+!--    The current timestep is only then changed, if the change relative to
+!--    its previous value exceeds +5 % or -2 %. In case of a timestep
+!--    reduction, at least 30 iterations have to be performed before a timestep
+!--    enlargement is permitted again.
+       percent_change = dt_3d / old_dt - 1.0
+       IF ( percent_change > 0.05  .OR.  percent_change < -0.02  .OR. &
+            timestep_scheme(1:5) == 'runge' )  THEN
+
+!
+!--       Time step enlargement by no more than 2 %.
+          IF ( percent_change > 0.0  .AND.  simulated_time /= 0.0  .AND. &
+               timestep_scheme(1:5) /= 'runge' )  THEN
+             dt_3d = 1.02 * old_dt
+          ENDIF
+
+!
+!--       A relatively smooth value of the time step is ensured by taking
+!--       only the first two significant digits.
+          div = 1000.0
+          DO  WHILE ( dt_3d < div )
+             div = div / 10.0
+          ENDDO
+          dt_3d = NINT( dt_3d * 100.0 / div ) * div / 100.0
+
+!
+!--       Now the time step can be adjusted.
+          IF ( percent_change < 0.0  .OR.  timestep_scheme(1:5) == 'runge' ) &
+          THEN
+!
+!--          Time step reduction.
+             old_dt = dt_3d
+             dt_changed = .TRUE.
+          ELSE
+!
+!--          For other timestep schemes , the time step is only enlarged
+!--          after at least 30 iterations since the previous time step
+!--          change or, of course, after model initialization.
+             IF ( current_timestep_number >= last_dt_change + 30  .OR. &
+                  simulated_time == 0.0 )  THEN
+                old_dt = dt_3d
+                dt_changed = .TRUE.
+             ELSE
+                dt_3d = old_dt
+                dt_changed = .FALSE.
              ENDIF
-             CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, ierr)
+
           ENDIF
-#endif
-       ENDIF
-
-!
-!--    In case of nested runs all parent/child processes have to terminate if one process has set
-!--    the stop flag, i.e. they need to set the stop flag too.
-       IF ( nested_run )  THEN
-          stop_dt_local = stop_dt
-#if defined( __parallel )
-          CALL MPI_ALLREDUCE( stop_dt_local, stop_dt, 1, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr )
-#endif
-       ENDIF
-
-!
-!--    Ensure a smooth value (two significant digits) of the timestep.
-       div = 1000.0_wp
-       DO  WHILE ( dt_3d < div )
-          div = div / 10.0_wp
-       ENDDO
-       dt_3d = NINT( dt_3d * 100.0_wp / div ) * div / 100.0_wp
+       ELSE
+!
+!--       No time step change since the difference is too small.
+          dt_3d = old_dt
+          dt_changed = .FALSE.
+       ENDIF
+
+       IF ( dt_changed )  last_dt_change = current_timestep_number
 
     ENDIF
@@ -413,3 +337,4 @@
     CALL cpu_log( log_point(12), 'calculate_timestep', 'stop' )
 
+
  END SUBROUTINE timestep
Index: palm/trunk/SOURCE/timestep_scheme_steering.f90
===================================================================
--- palm/trunk/SOURCE/timestep_scheme_steering.f90	(revision 4901)
+++ palm/trunk/SOURCE/timestep_scheme_steering.f90	(revision 1)
@@ -1,36 +1,14 @@
-!> @file timestep_scheme_steering.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ SUBROUTINE timestep_scheme_steering
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! File re-formatted to follow the PALM coding standard
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! OpenACC port for SPEC
+! $Log: timestep_scheme_steering.f90,v $
+! Revision 1.2  2005/03/26 21:17:06  raasch
+! No pressure term for Runge-Kutta-schemes (tsc(4)=0.0)
 !
 ! Revision 1.1  2004/01/28 15:34:47  raasch
@@ -40,15 +18,9 @@
 ! Description:
 ! ------------
-!> Depending on the timestep scheme set the steering factors for the prognostic equations.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE timestep_scheme_steering
+! Depending on the timestep scheme set the steering factors for the prognostic
+! equations.
+!------------------------------------------------------------------------------!
 
-
-    USE control_parameters,                                                                        &
-        ONLY:  intermediate_timestep_count,                                                        &
-               timestep_scheme,                                                                    &
-               tsc
-
-    USE kinds
+    USE control_parameters
 
     IMPLICIT NONE
@@ -57,27 +29,68 @@
     IF ( timestep_scheme(1:5) == 'runge' )  THEN
 !
-!--    Runge-Kutta schemes (here the factors depend on the respective intermediate step)
+!--    Runge-Kutta schemes (here the factors depend on the respective
+!--    intermediate step)
        IF ( timestep_scheme == 'runge-kutta-2' )  THEN
           IF ( intermediate_timestep_count == 1 )  THEN
-             tsc(1:5) = (/ 1.0_wp, 1.0_wp,  0.0_wp, 0.0_wp, 0.0_wp /)
+             tsc(1:5) = (/ 1.0, 1.0,  0.0, 0.0, 0.0 /)
           ELSE
-             tsc(1:5) = (/ 1.0_wp, 0.5_wp, -0.5_wp, 0.0_wp, 1.0_wp /)
+             tsc(1:5) = (/ 1.0, 0.5, -0.5, 0.0, 1.0 /)
           ENDIF
        ELSE
           IF ( intermediate_timestep_count == 1 )  THEN
-             tsc(1:5) = (/ 1.0_wp,  1.0_wp /  3.0_wp,          0.0_wp, 0.0_wp, 0.0_wp /)
+             tsc(1:5) = (/ 1.0,   1.0/3.0,        0.0, 0.0, 0.0 /)
           ELSEIF ( intermediate_timestep_count == 2 )  THEN
-             tsc(1:5) = (/ 1.0_wp, 15.0_wp / 16.0_wp, -25.0_wp/48.0_wp, 0.0_wp, 0.0_wp /)
+             tsc(1:5) = (/ 1.0, 15.0/16.0, -25.0/48.0, 0.0, 0.0 /)
           ELSE
-             tsc(1:5) = (/ 1.0_wp,  8.0_wp / 15.0_wp,   1.0_wp/15.0_wp, 0.0_wp, 1.0_wp /)
-          ENDIF
+             tsc(1:5) = (/ 1.0,  8.0/15.0,   1.0/15.0, 0.0, 1.0 /)
+          ENDIF          
        ENDIF
 
-       !$ACC UPDATE DEVICE(tsc(1:5))
+    ELSE
 
-    ELSEIF ( timestep_scheme == 'euler' )  THEN
+       IF ( .NOT. dt_fixed )  THEN
 !
-!--    Euler scheme
-       tsc(1:5) = (/ 1.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, 1.0_wp /)
+!--       Leapfrog and Euler schemes
+!--       Determine whether after the time step adjustment the Euler- or the
+!--       leapfrog scheme will be applied. The very first time step must always
+!--       be an Euler step.
+          IF ( dt_changed )  THEN
+             IF ( timestep_scheme == 'leapfrog+euler'  .OR. &
+                  timestep_scheme == 'euler' .OR. simulated_time == 0.0 )  THEN
+                tsc(1:5) = (/ 1.0, 1.0, 0.0, 1.0, 1.0 /)
+             ELSE
+                tsc(1:5) = (/ 0.0, 2.0, 0.0, 1.0, 2.0 /)
+             ENDIF
+          ELSE
+!
+!--          No time step change, hence continue with the scheme set by the
+!--          user.
+             IF ( timestep_scheme == 'euler' )  THEN
+                tsc(1:5) = (/ 1.0, 1.0, 0.0, 1.0, 1.0 /)
+             ELSE
+                tsc(1:5) = (/ 0.0, 2.0, 0.0, 1.0, 2.0 /)
+             ENDIF
+          ENDIF
+
+       ELSE
+
+!
+!--       Fixed time step:
+!
+!--       In any case, the very first time step must always be an Euler step.
+          timestep_reason = 'F'
+          IF ( simulated_time == 0.0 )  THEN
+             dt_changed = .TRUE.
+             tsc(1:5) = (/ 1.0, 1.0, 0.0, 1.0, 1.0 /)
+          ELSE
+             dt_changed = .FALSE.
+             IF ( timestep_scheme == 'euler' )  THEN
+                tsc(1:5) = (/ 1.0, 1.0, 0.0, 1.0, 1.0 /)
+             ELSE
+                tsc(1:5) = (/ 0.0, 2.0, 0.0, 1.0, 2.0 /)
+             ENDIF
+          ENDIF
+
+       ENDIF
 
     ENDIF
Index: palm/trunk/SOURCE/transpose.f90
===================================================================
--- palm/trunk/SOURCE/transpose.f90	(revision 4901)
+++ palm/trunk/SOURCE/transpose.f90	(revision 1)
@@ -1,59 +1,39 @@
-!> @file transpose.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
+ SUBROUTINE transpose_xy( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
-!
+! 
 !
 ! Former revisions:
 ! -----------------
-! $Id$
-! Formatting of OpenMP directives (J. Resler)
-! 
-! 4540 2020-05-18 15:23:29Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4429 2020-02-27 15:24:30Z raasch
-! Bugfix: cpp-directives added for serial mode
-!
-! 4415 2020-02-20 10:30:33Z raasch
-! Bugfix for misplaced preprocessor directive
-!
-! 4370 2020-01-10 14:00:44Z raasch
-! Vector array renamed
-!
-! 4366 2020-01-09 08:12:43Z raasch
-! Modifications for NEC vectorization
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Added missing OpenMP directives
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4171 2019-08-19 17:44:09Z gronemeier
-! Loop reordering for performance optimization
-!
-! 3832 2019-03-28 13:16:58Z raasch
-! Loop reordering for performance optimization
-!
-! 3694 2019-01-23 17:01:49Z knoop
-! OpenACC port for SPEC
+! $Log: transpose.f90,v $
+! Revision 1.2  2004/04/30 13:12:17  raasch
+! Switched from mpi_alltoallv to the simpler mpi_alltoall,
+! all former transpose-routine files collected in this file, enlarged
+! transposition arrays introduced
+!
+! Revision 1.1  2004/04/30 13:08:16  raasch
+! Initial revision (collection of former routines transpose_xy, transpose_xz,
+!                   transpose_yx, transpose_yz, transpose_zx, transpose_zy)
+!
+! Revision 1.7  2003/03/16 09:49:53  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.6  2001/03/30 07:55:50  raasch
+! Array bound for work2 is explicitely calculated, all comments and identifiers
+! translated into English
+!
+! Revision 1.5  2001/01/22 08:19:14  raasch
+! Module test_variables removed
+!
+! Revision 1.4  1998/07/06 12:34:22  raasch
+! + USE test_variables
+!
+! Revision 1.3  1997/08/13 13:52:42  raasch
+! Zeitmessung von MPI_ALLTOALLV
+!
+! Revision 1.2  1997/08/11 06:27:31  raasch
+! Keine Aenderungen
 !
 ! Revision 1.1  1997/07/24 11:25:18  raasch
@@ -63,629 +43,287 @@
 ! Description:
 ! ------------
-!> Resorting data for the transposition from x to y. The transposition itself is carried out in
-!> transpose_xy.
-!--------------------------------------------------------------------------------------------------!
-
-#define __acc_fft_device ( defined( _OPENACC ) && ( defined ( __cuda_fft ) ) )
-
- SUBROUTINE resort_for_xy( f_in, f_inv )
-
-
-    USE indices,                                                                                   &
-        ONLY:  nx
-
-    USE kinds
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nyn_x,                                                                              &
-               nys_x,                                                                              &
-               nzb_x,                                                                              &
-               nzt_x
+! Transposition of input array (f_in) from x to y. For the input array, all
+! elements along x reside on the same PE, while after transposition, all
+! elements along y reside on the same PE.
+!------------------------------------------------------------------------------!
+
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE transpose_indices
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp) ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x)   !<
-    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)  !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send by MPI contiguous
-    !$OMP  PARALLEL PRIVATE ( i, j, k )
-    !$OMP  DO
-#if __acc_fft_device
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-    !$ACC PRESENT(f_inv, f_in)
+    INTEGER ::  i, j, k, l, m, ys
+    
+    REAL ::  f_in(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                     &
+             f_inv(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa),                    &
+             f_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                    &
+             work1(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- Rearrange indices of input array in order to make data to be send
+!-- by MPI contiguous
+    DO  k = nzb_x, nzt_xa
+       DO  j = nys_x, nyn_xa
+          DO  i = 0, nxa
+             work1(j,k,i) = f_in(i,j,k)
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Move data to different array, because memory location of work1 is
+!-- needed further below (work1 = work2)
+    DO  i = 0, nxa
+       DO  k = nzb_x, nzt_xa
+          DO  j = nys_x, nyn_xa
+             f_inv(j,k,i) = work1(j,k,i)
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Transpose array
+    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+    CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
+                       work2(1),             sendrecvcount_xy, MPI_REAL, &
+                       comm1dy, ierr )
+    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array
+    m = 0
+    DO  l = 0, pdims(2) - 1
+       ys = 0 + l * ( nyn_xa - nys_x + 1 )
+       DO  i = nxl_y, nxr_ya
+          DO  k = nzb_y, nzt_ya
+             DO  j = ys, ys + nyn_xa - nys_x
+                m = m + 1
+                f_out(j,i,k) = work2(m)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
 #endif
-    DO  k = nzb_x, nzt_x
-        DO  j = nys_x, nyn_x
-            DO  i = 0, nx
-               f_inv(j,k,i) = f_in(i,j,k)
-            ENDDO
-        ENDDO
-    ENDDO
-    !$OMP  END PARALLEL
-
- END SUBROUTINE resort_for_xy
-
-
-!--------------------------------------------------------------------------------------------------!
+
+ END SUBROUTINE transpose_xy
+
+
+ SUBROUTINE transpose_xz( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Transposition of input array (f_in) from x to y. For the input array, all elements along x reside
-!> on the same PE, while after transposition, all elements along y reside on the same PE.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE transpose_xy( f_inv, f_out )
-
+! Transposition of input array (f_in) from x to z. For the input array, all
+! elements along x reside on the same PE, while after transposition, all
+! elements along z reside on the same PE.
+!------------------------------------------------------------------------------!
+
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k, l, m, xs
+    
+    REAL ::  f_in(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),             &
+             f_inv(nxl:nxra,nys:nyna,1:nza),                    &
+             f_out(1:nza,nys:nyna,nxl:nxra),                    &
+             work1(1:nza,nys:nyna,nxl:nxra), work2(nnx*nny*nnz)
 
 #if defined( __parallel )
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               cpu_log_nowait,                                                                     &
-               log_point_s
+
+!
+!-- If the PE grid is one-dimensional along y, the array has only to be
+!-- reordered locally and therefore no transposition has to be done.
+    IF ( pdims(1) /= 1 )  THEN
+!
+!--    Reorder input array for transposition
+       m = 0
+       DO  l = 0, pdims(1) - 1
+          xs = 0 + l * nnx
+          DO  k = nzb_x, nzt_xa
+             DO  j = nys_x, nyn_xa
+                DO  i = xs, xs + nnx - 1
+                   m = m + 1
+                   work2(m) = f_in(i,j,k)
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDDO
+
+!
+!--    Transpose array
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+       CALL MPI_ALLTOALL( work2(1),         sendrecvcount_zx, MPI_REAL, &
+                          f_inv(nxl,nys,1), sendrecvcount_zx, MPI_REAL, &
+                          comm1dx, ierr )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!--    Reorder transposed array in a way that the z index is in first position
+       DO  i = nxl, nxra
+          DO  j = nys, nyna
+             DO  k = 1, nza
+                work1(k,j,i) = f_inv(i,j,k)
+             ENDDO
+          ENDDO
+       ENDDO
+    ELSE
+!
+!--    Reorder the array in a way that the z index is in first position
+       DO  i = nxl, nxra
+          DO  j = nys, nyna
+             DO  k = 1, nza
+                work1(k,j,i) = f_in(i,j,k)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Move data to output array
+    DO  i = nxl, nxra
+       DO  j = nys, nyna
+          DO  k = 1, nza
+             f_out(k,j,i) = work1(k,j,i)
+          ENDDO
+       ENDDO
+    ENDDO
+
 #endif
 
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               ny
-
-    USE kinds
-
-    USE pegrid
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_y,                                                                              &
-               nxr_y,                                                                              &
-               nyn_x,                                                                              &
-               nys_x,                                                                              &
-               nzb_x,                                                                              &
-               nzb_y,                                                                              &
-               nzt_x,                                                                              &
-               nzt_y
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  l   !<
-    INTEGER(iwp) ::  ys  !<
-#endif
-
-    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)  !<
-    REAL(wp) ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)  !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work  !<
-#if __acc_fft_device
-    !$ACC DECLARE CREATE(work)
-#endif
-#endif
-
-
-    IF ( numprocs /= 1 )  THEN
-
-#if defined( __parallel )
-!
-!--    Transpose array
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE HOST(f_inv)
-#else
-       !$ACC HOST_DATA USE_DEVICE(work, f_inv)
-#endif
-#endif
-
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0),  sendrecvcount_xy, MPI_REAL,                       &
-                          work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL, comm1dy, ierr )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE DEVICE(work)
-#else
-       !$ACC END HOST_DATA
-#endif
-#endif
-
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
-
-!
-!--    Reorder transposed array
-       !$OMP  PARALLEL PRIVATE ( i, j, k, l, ys )
-       DO  l = 0, pdims(2) - 1
-          ys = 0 + l * ( nyn_x - nys_x + 1 )
-#if __acc_fft_device
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-          !$ACC PRESENT(f_out, work)
-#endif
-          !$OMP DO
-          DO  i = nxl_y, nxr_y
-             DO  k = nzb_y, nzt_y
-                DO  j = ys, ys + nyn_x - nys_x
-                   f_out(j,i,k) = work(j-ys+1,k,i,l)
-                ENDDO
-             ENDDO
-          ENDDO
-          !$OMP END DO NOWAIT
-       ENDDO
-       !$OMP  END PARALLEL
-#endif
-
-    ELSE
-
-!
-!--    Reorder transposed array
-       !$OMP  PARALLEL PRIVATE ( i, j, k )
-       !$OMP  DO
-#if __acc_fft_device
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-       !$ACC PRESENT(f_out, f_inv)
-#endif
-       DO  k = nzb_y, nzt_y
-          DO  i = nxl_y, nxr_y
-             DO  j = 0, ny
-                f_out(j,i,k) = f_inv(j,k,i)
-             ENDDO
-          ENDDO
-       ENDDO
-       !$OMP  END PARALLEL
-
-    ENDIF
-
- END SUBROUTINE transpose_xy
-
-
-!--------------------------------------------------------------------------------------------------!
+ END SUBROUTINE transpose_xz
+
+
+ SUBROUTINE transpose_yx( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Resorting data after the transposition from x to z. The transposition itself is carried out in
-!> transpose_xz.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE resort_for_xz( f_inv, f_out )
-
-
-    USE indices,                                                                                   &
-        ONLY:  nxl,                                                                                &
-               nxr,                                                                                &
-               nyn,                                                                                &
-               nys,                                                                                &
-               nz
-
-    USE kinds
+! Transposition of input array (f_in) from y to x. For the input array, all
+! elements along y reside on the same PE, while after transposition, all
+! elements along x reside on the same PE.
+!------------------------------------------------------------------------------!
+
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE transpose_indices
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)  !<
-    REAL(wp) ::  f_out(1:nz,nys:nyn,nxl:nxr)  !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
-!-- In case of parallel fft/transposition, scattered store is faster in backward direction!!!
-    !$OMP  PARALLEL PRIVATE ( i, j, k )
-    !$OMP  DO
-#if __acc_fft_device
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-    !$ACC PRESENT(f_out, f_inv)
+    INTEGER ::  i, j, k, l, m, ys
+    
+    REAL ::  f_in(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                     &
+             f_inv(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa),                    &
+             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                    &
+             work1(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- Reorder input array for transposition
+    m = 0
+    DO  l = 0, pdims(2) - 1
+       ys = 0 + l * ( nyn_xa - nys_x + 1 )
+       DO  i = nxl_y, nxr_ya
+          DO  k = nzb_y, nzt_ya
+             DO  j = ys, ys + nyn_xa - nys_x
+                m = m + 1
+                work2(m) = f_in(j,i,k)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Transpose array
+    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+    CALL MPI_ALLTOALL( work2(1),             sendrecvcount_xy, MPI_REAL, &
+                       f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
+                       comm1dy, ierr )
+    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array in a way that the x index is in first position
+    DO  i = 0, nxa
+       DO  k = nzb_x, nzt_xa
+          DO  j = nys_x, nyn_xa
+             work1(i,j,k) = f_inv(j,k,i)
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Move data to output array
+    DO  k = nzb_x, nzt_xa
+       DO  j = nys_x, nyn_xa
+          DO  i = 0, nxa
+             f_out(i,j,k) = work1(i,j,k)
+          ENDDO
+       ENDDO
+    ENDDO
+
 #endif
-    DO  i = nxl, nxr
-        DO  j = nys, nyn
-            DO  k = 1, nz
-               f_out(k,j,i) = f_inv(j,i,k)
-            ENDDO
-        ENDDO
-    ENDDO
-    !$OMP  END PARALLEL
-
- END SUBROUTINE resort_for_xz
-
-
-!--------------------------------------------------------------------------------------------------!
+
+ END SUBROUTINE transpose_yx
+
+
+ SUBROUTINE transpose_yxd( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Transposition of input array (f_in) from x to z. For the input array, all elements along x reside
-!> on the same PE, while after transposition, all elements along z reside on the same PE.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE transpose_xz( f_in, f_inv )
+! Transposition of input array (f_in) from y to x. For the input array, all
+! elements along y reside on the same PE, while after transposition, all
+! elements along x reside on the same PE.
+! This is a direct transposition for arrays with indices in regular order
+! (k,j,i) (cf. transpose_yx).
+!------------------------------------------------------------------------------!
+
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k, l, m, recvcount_yx, sendcount_yx, xs
+
+    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nxl:nxra,1:nza,nys:nyna), &
+             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                        &
+             work1(nxl:nxra,1:nza,nys:nyna), work2(nnx*nny*nnz)
 
 #if defined( __parallel )
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               cpu_log_nowait,                                                                     &
-               log_point_s
-
-    USE fft_xy,                                                                                    &
-        ONLY:  f_vec_x,                                                                            &
-               temperton_fft_vec
-#endif
-
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               nxl,                                                                                &
-               nxr,                                                                                &
-               nyn,                                                                                &
-               nys,                                                                                &
-               nz
-
-#if defined( __parallel )
-    USE indices,                                                                                   &
-        ONLY:  nnx
-#endif
-
-    USE kinds
-
-    USE pegrid
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nyn_x,                                                                              &
-               nys_x,                                                                              &
-               nzb_x,                                                                              &
-               nzt_x
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  l   !<
-    INTEGER(iwp) ::  mm  !<
-    INTEGER(iwp) ::  xs  !<
-#endif
-
-    REAL(wp) ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !<
-    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)         !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work  !<
-#if __acc_fft_device
-    !$ACC DECLARE CREATE(work)
-#endif
-#endif
-
-    !
-    !-- If the PE grid is one-dimensional along y, the array has only to be reordered locally and
-    !-- therefore no transposition has to be done.
-    IF ( pdims(1) /= 1 )  THEN
-
-#if defined( __parallel )
-!
-!--    Reorder input array for transposition. Data from the vectorized Temperton-fft is stored in
-!--    different array format (f_vec_x).
-       IF ( temperton_fft_vec )  THEN
-
-          DO  l = 0, pdims(1) - 1
-             xs = 0 + l * nnx
-             DO  k = nzb_x, nzt_x
-                DO  i = xs, xs + nnx - 1
-                   DO  j = nys_x, nyn_x
-                      mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1)
-                      work(j,i-xs+1,k,l) = f_vec_x(mm,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ELSE
-
-          !$OMP  PARALLEL PRIVATE ( i, j, k, l, xs )
-          DO  l = 0, pdims(1) - 1
-             xs = 0 + l * nnx
-#if __acc_fft_device
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-             !$ACC PRESENT(work, f_in)
-#endif
-             !$OMP DO
-             DO  k = nzb_x, nzt_x
-                DO  i = xs, xs + nnx - 1
-                   DO  j = nys_x, nyn_x
-                      work(j,i-xs+1,k,l) = f_in(i,j,k)
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END DO NOWAIT
-          ENDDO
-          !$OMP  END PARALLEL
-
-       ENDIF
-
-!
-!--    Transpose array
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE HOST(work)
-#else
-       !$ACC HOST_DATA USE_DEVICE(work, f_inv)
-#endif
-#endif
-
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL,                       &
-                          f_inv(nys,nxl,1),      sendrecvcount_zx, MPI_REAL, comm1dx, ierr )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE DEVICE(f_inv)
-#else
-       !$ACC END HOST_DATA
-#endif
-#endif
-
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
-#endif
-
-    ELSE
-
-!
-!--    Reorder the array in a way that the z index is in first position
-       !$OMP PARALLEL PRIVATE ( i, j, k )
-       !$OMP DO
-#if __acc_fft_device
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-       !$ACC PRESENT(f_inv, f_in)
-#endif
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = 1, nz
-                f_inv(j,i,k) = f_in(i,j,k)
-             ENDDO
-          ENDDO
-       ENDDO
-       !$OMP END PARALLEL
-
-    ENDIF
-
- END SUBROUTINE transpose_xz
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resorting data after the transposition from y to x. The transposition itself is carried out in
-!> transpose_yx.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE resort_for_yx( f_inv, f_out )
-
-
-    USE indices,                                                                                   &
-        ONLY:  nx
-
-    USE kinds
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nyn_x,                                                                              &
-               nys_x,                                                                              &
-               nzb_x,                                                                              &
-               nzt_x
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)  !<
-    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
-   !$OMP PARALLEL PRIVATE ( i, j, k )
-   !$OMP DO
-#if __acc_fft_device
-   !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-   !$ACC PRESENT(f_out, f_inv)
-#endif
-    DO  k = nzb_x, nzt_x
-        DO  j = nys_x, nyn_x
-            DO  i = 0, nx
-               f_out(i,j,k) = f_inv(j,k,i)
-            ENDDO
-        ENDDO
-    ENDDO
-    !$OMP END PARALLEL
-
- END SUBROUTINE resort_for_yx
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Transposition of input array (f_in) from y to x. For the input array, all  elements along y
-!> reside on the same PE, while after transposition, all elements along x reside on the same PE.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE transpose_yx( f_in, f_inv )
-
-
-#if defined( __parallel )
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               cpu_log_nowait,                                                                     &
-               log_point_s
-#endif
-
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               ny
-
-    USE kinds
-
-    USE pegrid
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_y,                                                                              &
-               nxr_y,                                                                              &
-               nyn_x,                                                                              &
-               nys_x,                                                                              &
-               nzb_x,                                                                              &
-               nzb_y,                                                                              &
-               nzt_x,                                                                              &
-               nzt_y
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  l   !<
-    INTEGER(iwp) ::  ys  !<
-#endif
-
-    REAL(wp) ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)   !<
-    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)  !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work  !<
-#if __acc_fft_device
-    !$ACC DECLARE CREATE(work)
-#endif
-#endif
-
-
-    IF ( numprocs /= 1 )  THEN
-
-#if defined( __parallel )
-!
-!--    Reorder input array for transposition
-       !$OMP PARALLEL PRIVATE ( i, j, k, l, ys )
-       DO  l = 0, pdims(2) - 1
-          ys = 0 + l * ( nyn_x - nys_x + 1 )
-#if __acc_fft_device
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-          !$ACC PRESENT(work, f_in)
-#endif
-          !$OMP DO
-          DO  i = nxl_y, nxr_y
-             DO  k = nzb_y, nzt_y
-                DO  j = ys, ys + nyn_x - nys_x
-                   work(j-ys+1,k,i,l) = f_in(j,i,k)
-                ENDDO
-             ENDDO
-          ENDDO
-          !$OMP END DO NOWAIT
-       ENDDO
-       !$OMP END PARALLEL
-
-!
-!--    Transpose array
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE HOST(work)
-#else
-       !$ACC HOST_DATA USE_DEVICE(work, f_inv)
-#endif
-#endif
-
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL,                       &
-                          f_inv(nys_x,nzb_x,0),  sendrecvcount_xy, MPI_REAL, comm1dy, ierr )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE DEVICE(f_inv)
-#else
-       !$ACC END HOST_DATA
-#endif
-#endif
-
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
-#endif
-
-    ELSE
-
-!
-!--    Reorder array f_in the same way as ALLTOALL did it.
-       !$OMP PARALLEL PRIVATE ( i, j, k )
-       !$OMP DO
-#if __acc_fft_device
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-       !$ACC PRESENT(f_inv, f_in)
-#endif
-       DO  i = nxl_y, nxr_y
-          DO  k = nzb_y, nzt_y
-             DO  j = 0, ny
-                f_inv(j,k,i) = f_in(j,i,k)
-             ENDDO
-          ENDDO
-       ENDDO
-       !$OMP END PARALLEL
-
-    ENDIF
-
- END SUBROUTINE transpose_yx
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Transposition of input array (f_in) from y to x. For the input array, all elements along y reside
-!> on the same PE, while after transposition, all elements along x reside on the same PE. This is a
-!> direct transposition for arrays with indices in regular order (k,j,i) (cf. transpose_yx).
-!--------------------------------------------------------------------------------------------------!
-#if defined( __parallel )
- SUBROUTINE transpose_yxd( f_in, f_out )
-
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  nnx,                                                                                &
-               nny,                                                                                &
-               nnz,                                                                                &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxr,                                                                                &
-               nyn,                                                                                &
-               nys,                                                                                &
-               nz
-
-    USE kinds
-
-    USE pegrid
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nyn_x,                                                                              &
-               nys_x,                                                                              &
-               nzb_x,                                                                              &
-               nzt_x
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i   !<
-    INTEGER(iwp) ::  j   !<
-    INTEGER(iwp) ::  k   !<
-    INTEGER(iwp) ::  l   !<
-    INTEGER(iwp) ::  m   !<
-    INTEGER(iwp) ::  xs  !<
-
-    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)           !<
-    REAL(wp) ::  f_inv(nxl:nxr,1:nz,nys:nyn)          !<
-    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !<
-    REAL(wp) ::  work(nnx*nny*nnz)                    !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
-    DO  k = 1, nz
-       DO  j = nys, nyn
-          DO  i = nxl, nxr
-             f_inv(i,k,j) = f_in(k,j,i)
+
+!
+!-- Rearrange indices of input array in order to make data to be send
+!-- by MPI contiguous
+    DO  k = 1, nza
+       DO  j = nys, nyna
+          DO  i = nxl, nxra
+             work1(i,k,j) = f_in(k,j,i)
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Move data to different array, because memory location of work1 is
+!-- needed further below (work1 = work2)
+    DO  j = nys, nyna
+       DO  k = 1, nza
+          DO  i = nxl, nxra
+             f_inv(i,k,j) = work1(i,k,j)
           ENDDO
        ENDDO
@@ -695,7 +333,7 @@
 !-- Transpose array
     CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL,                               &
-                       work(1), sendrecvcount_xy, MPI_REAL, comm1dx, ierr )
+    CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL, &
+                       work2(1),         sendrecvcount_xy, MPI_REAL, &
+                       comm1dx, ierr )
     CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
 
@@ -705,663 +343,349 @@
     DO  l = 0, pdims(1) - 1
        xs = 0 + l * nnx
-       DO  j = nys_x, nyn_x
-          DO  k = 1, nz
+       DO  j = nys_x, nyn_xa
+          DO  k = 1, nza
              DO  i = xs, xs + nnx - 1
                 m = m + 1
-                f_out(i,j,k) = work(m)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
+                f_out(i,j,k) = work2(m)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+#endif
 
  END SUBROUTINE transpose_yxd
-#endif
-
-
-!--------------------------------------------------------------------------------------------------!
+
+
+ SUBROUTINE transpose_yz( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Resorting data for the transposition from y to z. The transposition itself is carried out in
-!> transpose_yz.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE resort_for_yz( f_in, f_inv )
-
-
-    USE indices,                                                                                   &
-        ONLY:  ny
-
-    USE kinds
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_y,                                                                              &
-               nxr_y,                                                                              &
-               nzb_y,                                                                              &
-               nzt_y
+! Transposition of input array (f_in) from y to z. For the input array, all
+! elements along y reside on the same PE, while after transposition, all
+! elements along z reside on the same PE.
+!------------------------------------------------------------------------------!
+
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE transpose_indices
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp) ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)   !<
-    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)  !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
-    !$OMP PARALLEL PRIVATE ( i, j, k )
-    !$OMP DO
-#if __acc_fft_device
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-    !$ACC PRESENT(f_inv, f_in)
+    INTEGER ::  i, j, k, l, m, zs
+    
+    REAL ::  f_in(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                     &
+             f_inv(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya),                    &
+             f_out(nxl_z:nxr_za,nys_z:nyn_za,1:nza),                    &
+             work1(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- Rearrange indices of input array in order to make data to be send
+!-- by MPI contiguous
+    DO  k = nzb_y, nzt_ya
+       DO  i = nxl_y, nxr_ya
+          DO  j = 0, nya
+             work1(i,k,j) = f_in(j,i,k)
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Move data to different array, because memory location of work1 is
+!-- needed further below (work1 = work2).
+!-- If the PE grid is one-dimensional along y, only local reordering
+!-- of the data is necessary and no transposition has to be done.
+    IF ( pdims(1) == 1 )  THEN
+       DO  j = 0, nya
+          DO  k = nzb_y, nzt_ya
+             DO  i = nxl_y, nxr_ya
+                f_out(i,j,k) = work1(i,k,j)
+             ENDDO
+          ENDDO
+       ENDDO
+       RETURN
+    ELSE
+       DO  j = 0, nya
+          DO  k = nzb_y, nzt_ya
+             DO  i = nxl_y, nxr_ya
+                f_inv(i,k,j) = work1(i,k,j)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Transpose array
+    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+    CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
+                       work2(1),             sendrecvcount_yz, MPI_REAL, &
+                       comm1dx, ierr )
+    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array
+    m = 0
+    DO  l = 0, pdims(1) - 1
+       zs = 1 + l * ( nzt_ya - nzb_y + 1 )
+       DO  j = nys_z, nyn_za
+          DO  k = zs, zs + nzt_ya - nzb_y
+             DO  i = nxl_z, nxr_za
+                m = m + 1
+                f_out(i,j,k) = work2(m)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
 #endif
-    DO  k = nzb_y, nzt_y
-        DO  i = nxl_y, nxr_y
-            DO  j = 0, ny
-               f_inv(i,k,j) = f_in(j,i,k)
-            ENDDO
-        ENDDO
-    ENDDO
-    !$OMP END PARALLEL
-
- END SUBROUTINE resort_for_yz
-
-
-!--------------------------------------------------------------------------------------------------!
+
+ END SUBROUTINE transpose_yz
+
+
+ SUBROUTINE transpose_zx( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Transposition of input array (f_in) from y to z. For the input array, all elements along y reside
-!> on the same PE, while after transposition, all elements along z reside on the same PE.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE transpose_yz( f_inv, f_out )
-
+! Transposition of input array (f_in) from z to x. For the input array, all
+! elements along z reside on the same PE, while after transposition, all
+! elements along x reside on the same PE.
+!------------------------------------------------------------------------------!
+
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k, l, m, xs
+    
+    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nxl:nxra,nys:nyna,1:nza), &
+             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                        &
+             work1(nxl:nxra,nys:nyna,1:nza), work2(nnx*nny*nnz)
 
 #if defined( __parallel )
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               cpu_log_nowait,                                                                     &
-               log_point_s
+
+!
+!-- Rearrange indices of input array in order to make data to be send
+!-- by MPI contiguous
+    DO  i = nxl, nxra
+       DO  j = nys, nyna
+          DO  k = 1,nza
+             work1(i,j,k) = f_in(k,j,i)
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Move data to different array, because memory location of work1 is
+!-- needed further below (work1 = work2).
+!-- If the PE grid is one-dimensional along y, only local reordering
+!-- of the data is necessary and no transposition has to be done.
+    IF ( pdims(1) == 1 )  THEN
+       DO  k = 1, nza
+          DO  j = nys, nyna
+             DO  i = nxl, nxra
+                f_out(i,j,k) = work1(i,j,k)
+             ENDDO
+          ENDDO
+       ENDDO
+       RETURN
+    ELSE
+       DO  k = 1, nza
+          DO  j = nys, nyna
+             DO  i = nxl, nxra
+                f_inv(i,j,k) = work1(i,j,k)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Transpose array
+    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+    CALL MPI_ALLTOALL( f_inv(nxl,nys,1), sendrecvcount_zx, MPI_REAL, &
+                       work2(1),         sendrecvcount_zx, MPI_REAL, &
+                       comm1dx, ierr )
+    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array
+    m = 0
+    DO  l = 0, pdims(1) - 1
+       xs = 0 + l * nnx
+       DO  k = nzb_x, nzt_xa
+          DO  j = nys_x, nyn_xa
+             DO  i = xs, xs + nnx - 1
+                m = m + 1
+                f_out(i,j,k) = work2(m)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
 #endif
 
-    USE indices,                                                                                   &
-        ONLY:  ny,                                                                                 &
-               nz
-
-    USE kinds
-
-    USE pegrid
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_y,                                                                              &
-               nxl_z,                                                                              &
-               nxr_y,                                                                              &
-               nxr_z,                                                                              &
-               nyn_z,                                                                              &
-               nys_z,                                                                              &
-               nzb_y,                                                                              &
-               nzt_y
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  l   !<
-    INTEGER(iwp) ::  zs  !<
-#endif
-
-    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)  !<
-    REAL(wp) ::  f_out(nxl_z:nxr_z,nys_z:nyn_z,1:nz)  !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work  !<
-#if __acc_fft_device
-    !$ACC DECLARE CREATE(work)
-#endif
-#endif
-
-
-!
-!-- If the PE grid is one-dimensional along y, only local reordering of the data is necessary and no
-!-- transposition has to be done.
-    IF ( pdims(1) == 1 )  THEN
-
-       !$OMP PARALLEL PRIVATE ( i, j, k )
-       !$OMP DO
-#if __acc_fft_device
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-       !$ACC PRESENT(f_out, f_inv)
-#endif
-       DO  j = 0, ny
-          DO  k = nzb_y, nzt_y
-             DO  i = nxl_y, nxr_y
-                f_out(i,j,k) = f_inv(i,k,j)
-             ENDDO
-          ENDDO
-       ENDDO
-       !$OMP END PARALLEL
-
-    ELSE
-
-#if defined( __parallel )
-!
-!--    Transpose array
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE HOST(f_inv)
-#else
-       !$ACC HOST_DATA USE_DEVICE(work, f_inv)
-#endif
-#endif
-
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0),  sendrecvcount_yz, MPI_REAL,                       &
-                          work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL, comm1dx, ierr )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE DEVICE(work)
-#else
-       !$ACC END HOST_DATA
-#endif
-#endif
-
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
-
-!
-!--    Reorder transposed array
-       !$OMP PARALLEL PRIVATE ( i, j, k, l, zs )
-       DO  l = 0, pdims(1) - 1
-          zs = 1 + l * ( nzt_y - nzb_y + 1 )
-#if __acc_fft_device
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-          !$ACC PRESENT(f_out, work)
-#endif
-          !$OMP DO
-          DO  j = nys_z, nyn_z
-             DO  k = zs, zs + nzt_y - nzb_y
-                DO  i = nxl_z, nxr_z
-                   f_out(i,j,k) = work(i,k-zs+1,j,l)
-                ENDDO
-             ENDDO
-          ENDDO
-          !$OMP END DO NOWAIT
-       ENDDO
-       !$OMP END PARALLEL
-#endif
-
-   ENDIF
-
- END SUBROUTINE transpose_yz
-
-
-!--------------------------------------------------------------------------------------------------!
+ END SUBROUTINE transpose_zx
+
+
+ SUBROUTINE transpose_zy( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Resorting data for the transposition from z to x. The transposition itself is carried out in
-!> transpose_zx.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE resort_for_zx( f_in, f_inv )
-
-
-    USE indices,                                                                                   &
-        ONLY:  nxl,                                                                                &
-               nxr,                                                                                &
-               nyn,                                                                                &
-               nys,                                                                                &
-               nz
-
-    USE kinds
+! Transposition of input array (f_in) from z to y. For the input array, all
+! elements along z reside on the same PE, while after transposition, all
+! elements along y reside on the same PE.
+!------------------------------------------------------------------------------!
+
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE transpose_indices
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)   !<
-    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)  !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
-    !$OMP PARALLEL PRIVATE ( i, j, k )
-    !$OMP DO
-#if __acc_fft_device
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-    !$ACC PRESENT(f_in, f_inv)
+    INTEGER ::  i, j, k, l, m, zs
+    
+    REAL ::  f_in(nxl_z:nxr_za,nys_z:nyn_za,1:nza),                     &
+             f_inv(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya),                    &
+             f_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                    &
+             work1(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- If the PE grid is one-dimensional along y, the array has only to be
+!-- reordered locally and therefore no transposition has to be done.
+    IF ( pdims(1) /= 1 )  THEN
+!
+!--    Reorder input array for transposition
+       m = 0
+       DO  l = 0, pdims(1) - 1
+          zs = 1 + l * ( nzt_ya - nzb_y + 1 )
+          DO  j = nys_z, nyn_za
+             DO  k = zs, zs + nzt_ya - nzb_y
+                DO  i = nxl_z, nxr_za
+                   m = m + 1
+                   work2(m) = f_in(i,j,k)
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDDO
+
+!
+!--    Transpose array
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+       CALL MPI_ALLTOALL( work2(1),             sendrecvcount_yz, MPI_REAL, &
+                          f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
+                          comm1dx, ierr )
+       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!--    Reorder transposed array in a way that the y index is in first position
+       DO  k = nzb_y, nzt_ya
+          DO  i = nxl_y, nxr_ya
+             DO  j = 0, nya
+                work1(j,i,k) = f_inv(i,k,j)
+             ENDDO
+          ENDDO
+       ENDDO
+    ELSE
+!
+!--    Reorder the array in a way that the y index is in first position
+       DO  k = nzb_y, nzt_ya
+          DO  i = nxl_y, nxr_ya
+             DO  j = 0, nya
+                work1(j,i,k) = f_in(i,j,k)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Move data to output array
+    DO  k = nzb_y, nzt_ya
+       DO  i = nxl_y, nxr_ya
+          DO  j = 0, nya
+             f_out(j,i,k) = work1(j,i,k)
+          ENDDO
+       ENDDO
+    ENDDO
+
 #endif
-    DO  i = nxl, nxr
-        DO  j = nys, nyn
-            DO  k = 1,nz
-               f_inv(j,i,k) = f_in(k,j,i)
-            ENDDO
-        ENDDO
-    ENDDO
-    !$OMP END PARALLEL
-
- END SUBROUTINE resort_for_zx
-
-
-!--------------------------------------------------------------------------------------------------!
+
+ END SUBROUTINE transpose_zy
+
+
+ SUBROUTINE transpose_zyd( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Transposition of input array (f_in) from z to x. For the input array, all elements along z reside
-!> on the same PE, while after transposition, all elements along x reside on the same PE.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE transpose_zx( f_inv, f_out )
-
+! Transposition of input array (f_in) from z to y. For the input array, all
+! elements along z reside on the same PE, while after transposition, all
+! elements along y reside on the same PE.
+! This is a direct transposition for arrays with indices in regular order
+! (k,j,i) (cf. transpose_zy).
+!------------------------------------------------------------------------------!
+
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE pegrid
+    USE transpose_indices
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, j, k, l, m, ys
+    
+    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &
+             f_out(0:nya,nxl_yd:nxr_yda,nzb_yd:nzt_yda),                    &
+             work1(nys:nyna,nxl:nxra,1:nza), work2(nnx*nny*nnz)
 
 #if defined( __parallel )
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               cpu_log_nowait,                                                                     &
-               log_point_s
-
-    USE fft_xy,                                                                                    &
-        ONLY:  f_vec_x,                                                                            &
-               temperton_fft_vec
-#endif
-
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               nxl,                                                                                &
-               nxr,                                                                                &
-               nyn,                                                                                &
-               nys,                                                                                &
-               nz
-
-#if defined( __parallel )
-    USE indices,                                                                                   &
-        ONLY:  nnx
-#endif
-
-    USE kinds
-
-    USE pegrid
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nyn_x,                                                                              &
-               nys_x,                                                                              &
-               nzb_x,                                                                              &
-               nzt_x
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  l   !<
-    INTEGER(iwp) ::  mm  !<
-    INTEGER(iwp) ::  xs  !<
-#endif
-
-    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)          !<
-    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work  !<
-#if __acc_fft_device
-    !$ACC DECLARE CREATE(work)
-#endif
-#endif
-
-
-!
-!-- If the PE grid is one-dimensional along y, only local reordering of the data is necessary and no
-!-- transposition has to be done.
-    IF ( pdims(1) == 1 )  THEN
-
-       !$OMP PARALLEL PRIVATE ( i, j, k )
-       !$OMP DO
-#if __acc_fft_device
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-       !$ACC PRESENT(f_out, f_inv)
-#endif
-       DO  k = 1, nz
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                f_out(i,j,k) = f_inv(j,i,k)
-             ENDDO
-          ENDDO
-       ENDDO
-       !$OMP END PARALLEL
-
+
+!
+!-- Rearrange indices of input array in order to make data to be send
+!-- by MPI contiguous
+    DO  i = nxl, nxra
+       DO  j = nys, nyna
+          DO  k = 1, nza
+             work1(j,i,k) = f_in(k,j,i)
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Move data to different array, because memory location of work1 is
+!-- needed further below (work1 = work2).
+!-- If the PE grid is one-dimensional along x, only local reordering
+!-- of the data is necessary and no transposition has to be done.
+    IF ( pdims(2) == 1 )  THEN
+       DO  k = 1, nza
+          DO  i = nxl, nxra
+             DO  j = nys, nyna
+                f_out(j,i,k) = work1(j,i,k)
+             ENDDO
+          ENDDO
+       ENDDO
+       RETURN
     ELSE
-
-#if defined( __parallel )
-!
-!--    Transpose array
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE HOST(f_inv)
-#else
-       !$ACC HOST_DATA USE_DEVICE(work, f_inv)
-#endif
-#endif
-
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( f_inv(nys,nxl,1),      sendrecvcount_zx, MPI_REAL,                       &
-                          work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL, comm1dx, ierr )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE DEVICE(work)
-#else
-       !$ACC END HOST_DATA
-#endif
-#endif
-
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
-
-!
-!--    Reorder transposed array.
-!--    Data for the vectorized Temperton-fft is stored in different array format (f_vec_x) which
-!--    saves additional data copy in fft_x.
-       IF ( temperton_fft_vec )  THEN
-
-          DO  l = 0, pdims(1) - 1
-             xs = 0 + l * nnx
-             DO  k = nzb_x, nzt_x
-                DO  i = xs, xs + nnx - 1
-                   DO  j = nys_x, nyn_x
-                      mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1)
-                      f_vec_x(mm,i) = work(j,i-xs+1,k,l)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ELSE
-
-          !$OMP PARALLEL PRIVATE ( i, j, k, l, xs )
-          DO  l = 0, pdims(1) - 1
-             xs = 0 + l * nnx
-#if __acc_fft_device
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-             !$ACC PRESENT(f_out, work)
-#endif
-             !$OMP DO
-             DO  k = nzb_x, nzt_x
-                DO  i = xs, xs + nnx - 1
-                   DO  j = nys_x, nyn_x
-                      f_out(i,j,k) = work(j,i-xs+1,k,l)
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$OMP END DO NOWAIT
-          ENDDO
-          !$OMP END PARALLEL
-
-       ENDIF
-
-#endif
-
-    ENDIF
-
- END SUBROUTINE transpose_zx
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resorting data after the transposition from z to y. The transposition itself is carried out in
-!> transpose_zy.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE resort_for_zy( f_inv, f_out )
-
-
-    USE indices,                                                                                   &
-        ONLY:  ny
-
-    USE kinds
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_y,                                                                              &
-               nxr_y,                                                                              &
-               nzb_y,                                                                              &
-               nzt_y
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)  !<
-    REAL(wp) ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)  !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
-    !$OMP PARALLEL PRIVATE ( i, j, k )
-    !$OMP DO
-#if __acc_fft_device
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-    !$ACC PRESENT(f_out, f_inv)
-#endif
-    DO  k = nzb_y, nzt_y
-        DO  i = nxl_y, nxr_y
-            DO  j = 0, ny
-               f_out(j,i,k) = f_inv(i,k,j)
-            ENDDO
-        ENDDO
-    ENDDO
-    !$OMP END PARALLEL
-
- END SUBROUTINE resort_for_zy
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:cpu_log_nowait
-! ------------
-!> Transposition of input array (f_in) from z to y. For the input array, all elements along z reside
-!> on the same PE, while after transposition, all elements along y reside on the same PE.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE transpose_zy( f_in, f_inv )
-
-
-#if defined( __parallel )
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               cpu_log_nowait,                                                                     &
-               log_point_s
-#endif
-
-    USE indices,                                                                                   &
-        ONLY:  ny,                                                                                 &
-               nz
-
-    USE kinds
-
-    USE pegrid
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_y,                                                                              &
-               nxl_z,                                                                              &
-               nxr_y,                                                                              &
-               nxr_z,                                                                              &
-               nyn_z,                                                                              &
-               nys_z,                                                                              &
-               nzb_y,                                                                              &
-               nzt_y
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-
-#if defined( __parallel )
-    INTEGER(iwp) ::  l   !<
-    INTEGER(iwp) ::  zs  !<
-#endif
-
-    REAL(wp) ::  f_in(nxl_z:nxr_z,nys_z:nyn_z,1:nz)   !<
-    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)  !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work  !<
-#if __acc_fft_device
-    !$ACC DECLARE CREATE(work)
-#endif
-#endif
-
-!
-!-- If the PE grid is one-dimensional along y, the array has only to be reordered locally and
-!-- therefore no transposition has to be done.
-    IF ( pdims(1) /= 1 )  THEN
-
-#if defined( __parallel )
-!
-!--    Reorder input array for transposition
-       !$OMP PARALLEL PRIVATE ( i, j, k, l, zs )
-       DO  l = 0, pdims(1) - 1
-          zs = 1 + l * ( nzt_y - nzb_y + 1 )
-#if __acc_fft_device
-          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-          !$ACC PRESENT(work, f_in)
-#endif
-          !$OMP DO
-          DO  j = nys_z, nyn_z
-             DO  k = zs, zs + nzt_y - nzb_y
-                DO  i = nxl_z, nxr_z
-                   work(i,k-zs+1,j,l) = f_in(i,j,k)
-                ENDDO
-             ENDDO
-          ENDDO
-          !$OMP END DO NOWAIT
-       ENDDO
-       !$OMP END PARALLEL
-
-!
-!--    Transpose array
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE HOST(work)
-#else
-       !$ACC HOST_DATA USE_DEVICE(work, f_inv)
-#endif
-#endif
-
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL,                       &
-                          f_inv(nxl_y,nzb_y,0),  sendrecvcount_yz, MPI_REAL, comm1dx, ierr )
-
-#if __acc_fft_device
-#ifndef __cuda_aware_mpi
-       !$ACC UPDATE DEVICE(f_inv)
-#else
-       !$ACC END HOST_DATA
-#endif
-#endif
-
-       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
-#endif
-
-    ELSE
-!
-!--    Reorder the array in the same way like ALLTOALL did it
-       !$OMP PARALLEL PRIVATE ( i, j, k )
-       !$OMP DO
-#if __acc_fft_device
-       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-       !$ACC PRESENT(f_inv, f_in)
-#endif
-       DO  k = nzb_y, nzt_y
-          DO  j = 0, ny
-             DO  i = nxl_y, nxr_y
-                f_inv(i,k,j) = f_in(i,j,k)
-             ENDDO
-          ENDDO
-       ENDDO
-       !$OMP END PARALLEL
-
-    ENDIF
-
- END SUBROUTINE transpose_zy
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Transposition of input array (f_in) from z to y. For the input array, all elements along z reside
-!> on the same PE, while after transposition, all elements along y reside on the same PE. This is a
-!> direct transposition for arrays with indices in regular order (k,j,i) (cf. transpose_zy).
-!--------------------------------------------------------------------------------------------------!
-#if defined( __parallel )
- SUBROUTINE transpose_zyd( f_in, f_out )
-
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  nnx,                                                                                &
-               nny,                                                                                &
-               nnz,                                                                                &
-               nxl,                                                                                &
-               nxr,                                                                                &
-               nyn,                                                                                &
-               nys,                                                                                &
-               ny,                                                                                 &
-               nz
-
-    USE kinds
-
-    USE pegrid
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_yd,                                                                             &
-               nxr_yd,                                                                             &
-               nzb_yd,                                                                             &
-               nzt_yd
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i   !<
-    INTEGER(iwp) ::  j   !<
-    INTEGER(iwp) ::  k   !<
-    INTEGER(iwp) ::  l   !<
-    INTEGER(iwp) ::  m   !<
-    INTEGER(iwp) ::  ys  !<
-
-    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)               !<
-    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)              !<
-    REAL(wp) ::  f_out(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd)  !<
-    REAL(wp) ::  work(nnx*nny*nnz)                        !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = 1, nz
-             f_inv(j,i,k) = f_in(k,j,i)
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Move data to different array, because memory location of work1 is needed further below
-!-- (work1 = work2). If the PE grid is one-dimensional along x, only local reordering of the data is
-!-- necessary and no transposition has to be done.
-    IF ( pdims(2) == 1 )  THEN
-       DO  k = 1, nz
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                f_out(j,i,k) = f_inv(j,i,k)
-             ENDDO
-          ENDDO
-       ENDDO
-       RETURN
+       DO  k = 1, nza
+          DO  i = nxl, nxra
+             DO  j = nys, nyna
+                f_inv(j,i,k) = work1(j,i,k)
+             ENDDO
+          ENDDO
+       ENDDO
     ENDIF
 
@@ -1369,7 +693,7 @@
 !-- Transpose array
     CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL,                              &
-                       work(1), sendrecvcount_zyd, MPI_REAL, comm1dy, ierr )
+    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL, &
+                       work2(1),         sendrecvcount_zyd, MPI_REAL, &
+                       comm1dy, ierr )
     CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
 
@@ -1379,14 +703,15 @@
     DO  l = 0, pdims(2) - 1
        ys = 0 + l * nny
-       DO  k = nzb_yd, nzt_yd
-          DO  i = nxl_yd, nxr_yd
+       DO  k = nzb_yd, nzt_yda
+          DO  i = nxl_yd, nxr_yda
              DO  j = ys, ys + nny - 1
                 m = m + 1
-                f_out(j,i,k) = work(m)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
+                f_out(j,i,k) = work2(m)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+#endif
 
  END SUBROUTINE transpose_zyd
-#endif
Index: palm/trunk/SOURCE/tridia_solver_mod.f90
===================================================================
--- palm/trunk/SOURCE/tridia_solver_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,663 +1,0 @@
-!> @file tridia_solver_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Added missing OpenMP directives
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3761 2019-02-25 15:31:42Z raasch
-! OpenACC modification to prevent compiler warning about unused variable
-!
-! 3690 2019-01-22 22:56:42Z knoop
-! OpenACC port for SPEC
-!
-! 1212 2013-08-15 08:46:27Z raasch
-! Initial revision.
-! Routines have been moved to seperate module from former file poisfft to here. The tridiagonal
-! matrix coefficients of array tri are calculated only once at the beginning, i.e. routine split is
-! called within tridia_init.
-!
-!
-! Description:
-! ------------
-!> Solves the linear system of equations:
-!>
-!> -(4 pi^2(i^2/(dx^2*nnx^2)+j^2/(dy^2*nny^2))+ 1/(dzu(k)*dzw(k))+1/(dzu(k-1)*dzw(k)))*p(i,j,k)+
-!> 1/(dzu(k)*dzw(k))*p(i,j,k+1)+1/(dzu(k-1)*dzw(k))*p(i,j,k-1)=d(i,j,k)
-!>
-!> by using the Thomas algorithm
-!--------------------------------------------------------------------------------------------------!
-
-#define __acc_fft_device ( defined( _OPENACC ) && ( defined ( __cuda_fft ) ) )
-
- MODULE tridia_solver
-
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  pi
-
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               ny,                                                                                 &
-               nz
-
-    USE kinds
-
-    USE transpose_indices,                                                                         &
-        ONLY:  nxl_z,                                                                              &
-               nyn_z,                                                                              &
-               nxr_z,                                                                              &
-               nys_z
-
-    IMPLICIT NONE
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddzuw  !<
-
-    PRIVATE
-
-    INTERFACE tridia_substi
-       MODULE PROCEDURE tridia_substi
-    END INTERFACE tridia_substi
-
-    INTERFACE tridia_substi_overlap
-       MODULE PROCEDURE tridia_substi_overlap
-    END INTERFACE tridia_substi_overlap
-
-    PUBLIC  tridia_substi, tridia_substi_overlap, tridia_init, tridia_1dd
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tridia_init
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu_pres,                                                                          &
-               ddzw,                                                                               &
-               rho_air_zw
-
-#if defined( _OPENACC )
-       USE arrays_3d,                                                                              &
-           ONLY:  tri
-#endif
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k  !<
-
-    ALLOCATE( ddzuw(0:nz-1,3) )
-
-    DO  k = 0, nz-1
-       ddzuw(k,1) = ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k)
-       ddzuw(k,2) = ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1)
-       ddzuw(k,3) = -1.0_wp * ( ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1) +                     &
-                                ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k) )
-    ENDDO
-!
-!-- Calculate constant coefficients of the tridiagonal matrix
-    CALL maketri
-    CALL split
-
-#if __acc_fft_device
-    !$ACC ENTER DATA &
-    !$ACC COPYIN(ddzuw(0:nz-1,1:3)) &
-    !$ACC COPYIN(tri(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1,1:2))
-#endif
-
- END SUBROUTINE tridia_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computes the i- and j-dependent component of the matrix.
-!> Provide the constant coefficients of the tridiagonal matrix for solution of the Poisson equation
-!> in Fourier space. The coefficients are computed following the method of Schmidt et al.
-!> (DFVLR-Mitteilung 84-15), which departs from Stephan Siano's original version by discretizing the
-!> Poisson equation, before it is Fourier-transformed.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE maketri
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  tric,                                                                               &
-               rho_air
-
-    USE control_parameters,                                                                        &
-        ONLY:  ibc_p_b,                                                                            &
-               ibc_p_t
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx,                                                                                 &
-               dy
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !<
-    INTEGER(iwp) ::  j     !<
-    INTEGER(iwp) ::  k     !<
-    INTEGER(iwp) ::  nnxh  !<
-    INTEGER(iwp) ::  nnyh  !<
-
-    REAL(wp)    ::  ll(nxl_z:nxr_z,nys_z:nyn_z)  !<
-
-
-    nnxh = ( nx + 1 ) / 2
-    nnyh = ( ny + 1 ) / 2
-
-    DO  j = nys_z, nyn_z
-       DO  i = nxl_z, nxr_z
-          IF ( j >= 0  .AND.  j <= nnyh )  THEN
-             IF ( i >= 0  .AND.  i <= nnxh )  THEN
-                ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) /                           &
-                                     REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) +                     &
-                          2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) /                           &
-                                     REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
-             ELSE
-                ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) /                  &
-                                     REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) +                     &
-                          2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) /                           &
-                                     REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
-             ENDIF
-          ELSE
-             IF ( i >= 0  .AND.  i <= nnxh )  THEN
-                ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) /                           &
-                                     REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) +                     &
-                          2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( ny+1-j ) ) /                  &
-                                     REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
-             ELSE
-                ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) /                  &
-                                     REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) +                     &
-                          2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( ny+1-j ) ) /                  &
-                                     REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
-             ENDIF
-          ENDIF
-       ENDDO
-    ENDDO
-
-    DO  k = 0, nz-1
-       DO  j = nys_z, nyn_z
-          DO  i = nxl_z, nxr_z
-             tric(i,j,k) = ddzuw(k,3) - ll(i,j) * rho_air(k+1)
-          ENDDO
-       ENDDO
-    ENDDO
-
-    IF ( ibc_p_b == 1 )  THEN
-       DO  j = nys_z, nyn_z
-          DO  i = nxl_z, nxr_z
-             tric(i,j,0) = tric(i,j,0) + ddzuw(0,1)
-          ENDDO
-       ENDDO
-    ENDIF
-    IF ( ibc_p_t == 1 )  THEN
-       DO  j = nys_z, nyn_z
-          DO  i = nxl_z, nxr_z
-             tric(i,j,nz-1) = tric(i,j,nz-1) + ddzuw(nz-1,2)
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE maketri
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Substitution (Forward and Backward) (Thomas algorithm).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tridia_substi( ar )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  tri
-
-    USE control_parameters,                                                                        &
-        ONLY:  ibc_p_b,                                                                            &
-               ibc_p_t
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i !<
-    INTEGER(iwp) ::  j !<
-    INTEGER(iwp) ::  k !<
-
-    REAL(wp)     ::  ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz)  !<
-
-    REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) ::  ar1  !<
-#if __acc_fft_device
-    !$ACC DECLARE CREATE(ar1)
-#endif
-
-    !$OMP PARALLEL PRIVATE(i,j,k)
-
-!
-!-- Forward substitution
-#if __acc_fft_device
-    !$ACC PARALLEL PRESENT(ar, ar1, tri) PRIVATE(i,j,k)
-#endif
-    DO  k = 0, nz - 1
-#if __acc_fft_device
-       !$ACC LOOP COLLAPSE(2)
-#endif
-       !$OMP DO
-       DO  j = nys_z, nyn_z
-          DO  i = nxl_z, nxr_z
-
-             IF ( k == 0 )  THEN
-                ar1(i,j,k) = ar(i,j,k+1)
-             ELSE
-                ar1(i,j,k) = ar(i,j,k+1) - tri(i,j,k,2) * ar1(i,j,k-1)
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-#if __acc_fft_device
-    !$ACC END PARALLEL
-#endif
-
-!
-!-- Backward substitution
-!-- Note, the 1.0E-20 in the denominator is due to avoid divisions by zero appearing if the
-!-- pressure bc is set to neumann at the top of the model domain.
-#if __acc_fft_device
-    !$ACC PARALLEL PRESENT(ar, ar1, ddzuw, tri) PRIVATE(i,j,k)
-#endif
-    DO  k = nz-1, 0, -1
-#if __acc_fft_device
-       !$ACC LOOP COLLAPSE(2)
-#endif
-       !$OMP DO
-       DO  j = nys_z, nyn_z
-          DO  i = nxl_z, nxr_z
-
-             IF ( k == nz-1 )  THEN
-                ar(i,j,k+1) = ar1(i,j,k) / ( tri(i,j,k,1) + 1.0E-20_wp )
-             ELSE
-                ar(i,j,k+1) = ( ar1(i,j,k) - ddzuw(k,2) * ar(i,j,k+2) ) / tri(i,j,k,1)
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-#if __acc_fft_device
-    !$ACC END PARALLEL
-#endif
-
-    !$OMP END PARALLEL
-
-!
-!-- Indices i=0, j=0 correspond to horizontally averaged pressure. The respective values of ar
-!-- should be zero at all k-levels if acceleration of horizontally averaged vertical velocity
-!-- is zero.
-    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
-       IF ( nys_z == 0  .AND.  nxl_z == 0 )  THEN
-#if __acc_fft_device
-             !$ACC PARALLEL LOOP PRESENT(ar)
-#endif
-          DO  k = 1, nz
-             ar(nxl_z,nys_z,k) = 0.0_wp
-          ENDDO
-       ENDIF
-    ENDIF
-
- END SUBROUTINE tridia_substi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Substitution (Forward and Backward) (Thomas algorithm).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tridia_substi_overlap( ar, jj )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  tri
-
-    USE control_parameters,                                                                        &
-        ONLY:  ibc_p_b,                                                                            &
-               ibc_p_t
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  jj !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp)     ::  ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz)  !<
-
-    REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) ::  ar1  !<
-
-!
-!-- Forward substitution
-    DO  k = 0, nz - 1
-       DO  j = nys_z, nyn_z
-          DO  i = nxl_z, nxr_z
-
-             IF ( k == 0 )  THEN
-                ar1(i,j,k) = ar(i,j,k+1)
-             ELSE
-                ar1(i,j,k) = ar(i,j,k+1) - tri(i,jj,k,2) * ar1(i,j,k-1)
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Backward substitution
-!-- Note, the 1.0E-20 in the denominator is due to avoid divisions by zero appearing if the
-!-- pressure bc is set to neumann at the top of the model domain.
-    DO  k = nz-1, 0, -1
-       DO  j = nys_z, nyn_z
-          DO  i = nxl_z, nxr_z
-
-             IF ( k == nz-1 )  THEN
-                ar(i,j,k+1) = ar1(i,j,k) / ( tri(i,jj,k,1) + 1.0E-20_wp )
-             ELSE
-                ar(i,j,k+1) = ( ar1(i,j,k) - ddzuw(k,2) * ar(i,j,k+2) ) / tri(i,jj,k,1)
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Indices i=0, j=0 correspond to horizontally averaged pressure. The respective values of ar
-!-- should be zero at all k-levels if acceleration of horizontally averaged vertical velocity
-!-- is zero.
-    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
-       IF ( nys_z == 0  .AND.  nxl_z == 0 )  THEN
-          DO  k = 1, nz
-             ar(nxl_z,nys_z,k) = 0.0_wp
-          ENDDO
-       ENDIF
-    ENDIF
-
- END SUBROUTINE tridia_substi_overlap
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Splitting of the tridiagonal matrix (Thomas algorithm).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE split
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  tri,                                                                                &
-               tric
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-!
-!   Splitting
-    DO  j = nys_z, nyn_z
-       DO  i = nxl_z, nxr_z
-          tri(i,j,0,1) = tric(i,j,0)
-       ENDDO
-    ENDDO
-
-    DO  k = 1, nz-1
-       DO  j = nys_z, nyn_z
-          DO  i = nxl_z, nxr_z
-             tri(i,j,k,2) = ddzuw(k,1) / tri(i,j,k-1,1)
-             tri(i,j,k,1) = tric(i,j,k) - ddzuw(k-1,2) * tri(i,j,k,2)
-          ENDDO
-       ENDDO
-    ENDDO
-
- END SUBROUTINE split
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Solves the linear system of equations for a 1d-decomposition along x (see tridia).
-!>
-!> @attention When using intel compilers older than 12.0, array tri must be passed as an argument to
-!>            the contained subroutines. Otherwise address faults will occur. This feature can be
-!>            activated with cpp-switch __intel11. On NEC, tri should not be passed
-!>            (except for routine substi_1dd) because this causes very bad performance.
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE tridia_1dd( ddx2, ddy2, nx, ny, j, ar, tri_for_1d )
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu_pres,                                                                          &
-               ddzw,                                                                               &
-               rho_air,                                                                            &
-               rho_air_zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  ibc_p_b,                                                                            &
-               ibc_p_t
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !<
-    INTEGER(iwp) ::  j     !<
-    INTEGER(iwp) ::  k     !<
-    INTEGER(iwp) ::  nnyh  !<
-    INTEGER(iwp) ::  nx    !<
-    INTEGER(iwp) ::  ny    !<
-
-    REAL(wp)     ::  ddx2  !<
-    REAL(wp)     ::  ddy2  !<
-
-    REAL(wp), DIMENSION(0:nx,1:nz)     ::  ar          !<
-    REAL(wp), DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d  !<
-
-
-    nnyh = ( ny + 1 ) / 2
-
-!
-!-- Define constant elements of the tridiagonal matrix. The compiler on SX6 does loop exchange.
-!-- If 0:nx is a high power of 2, the exchanged loops create bank conflicts. The following directive
-!-- prohibits loop exchange and the loops perform much better.
-!CDIR NOLOOPCHG
-    DO  k = 0, nz-1
-       DO  i = 0,nx
-          tri_for_1d(2,i,k) = ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k)
-          tri_for_1d(3,i,k) = ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1)
-       ENDDO
-    ENDDO
-
-    IF ( j <= nnyh )  THEN
-       CALL maketri_1dd( j )
-    ELSE
-       CALL maketri_1dd( ny+1-j )
-    ENDIF
-
-    CALL split_1dd
-    CALL substi_1dd( ar, tri_for_1d )
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computes the i- and j-dependent component of the matrix.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE maketri_1dd( j )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i    !<
-    INTEGER(iwp) ::  j    !<
-    INTEGER(iwp) ::  k    !<
-    INTEGER(iwp) ::  nnxh !<
-
-    REAL(wp)     ::  a !<
-    REAL(wp)     ::  c !<
-
-    REAL(wp), DIMENSION(0:nx) ::  l !<
-
-
-    nnxh = ( nx + 1 ) / 2
-!
-!-- Provide the tridiagonal matrix for solution of the Poisson equation in Fourier space.
-!-- The coefficients are computed following the method of Schmidt et al. (DFVLR-Mitteilung 84-15),
-!-- which departs from Stephan Siano's original version by discretizing the Poisson equation,
-!-- before it is Fourier-transformed.
-    DO  i = 0, nx
-       IF ( i >= 0 .AND. i <= nnxh ) THEN
-          l(i) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) /                                    &
-                            REAL( nx+1, KIND=wp ) ) ) * ddx2 +                                     &
-                 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) /                                    &
-                            REAL( ny+1, KIND=wp ) ) ) * ddy2
-       ELSE
-          l(i) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) /                           &
-                            REAL( nx+1, KIND=wp ) ) ) * ddx2 +                                     &
-                 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) /                                    &
-                            REAL( ny+1, KIND=wp ) ) ) * ddy2
-       ENDIF
-    ENDDO
-
-    DO  k = 0, nz-1
-       DO  i = 0, nx
-          a = -1.0_wp * ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1)
-          c = -1.0_wp * ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k)
-          tri_for_1d(1,i,k) = a + c - l(i) * rho_air(k+1)
-       ENDDO
-    ENDDO
-    IF ( ibc_p_b == 1 )  THEN
-       DO  i = 0, nx
-          tri_for_1d(1,i,0) = tri_for_1d(1,i,0) + tri_for_1d(2,i,0)
-       ENDDO
-    ENDIF
-    IF ( ibc_p_t == 1 )  THEN
-       DO  i = 0, nx
-          tri_for_1d(1,i,nz-1) = tri_for_1d(1,i,nz-1) + tri_for_1d(3,i,nz-1)
-       ENDDO
-    ENDIF
-
- END SUBROUTINE maketri_1dd
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Splitting of the tridiagonal matrix (Thomas algorithm).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE split_1dd
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  k  !<
-
-
-!
-!-- Splitting
-    DO  i = 0, nx
-       tri_for_1d(4,i,0) = tri_for_1d(1,i,0)
-    ENDDO
-    DO  k = 1, nz-1
-       DO  i = 0, nx
-          tri_for_1d(5,i,k) = tri_for_1d(2,i,k) / tri_for_1d(4,i,k-1)
-          tri_for_1d(4,i,k) = tri_for_1d(1,i,k) - tri_for_1d(3,i,k-1) * tri_for_1d(5,i,k)
-       ENDDO
-    ENDDO
-
- END SUBROUTINE split_1dd
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Substitution (Forward and Backward) (Thomas algorithm).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE substi_1dd( ar, tri_for_1d )
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  k  !<
-
-    REAL(wp), DIMENSION(0:nx,nz)       ::  ar          !<
-    REAL(wp), DIMENSION(0:nx,0:nz-1)   ::  ar1         !<
-    REAL(wp), DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d  !<
-
-!
-!-- Forward substitution
-    DO  i = 0, nx
-       ar1(i,0) = ar(i,1)
-    ENDDO
-    DO  k = 1, nz-1
-       DO  i = 0, nx
-          ar1(i,k) = ar(i,k+1) - tri_for_1d(5,i,k) * ar1(i,k-1)
-       ENDDO
-    ENDDO
-
-!
-!-- Backward substitution
-!-- Note, the add of 1.0E-20 in the denominator is due to avoid divisions by zero appearing if the
-!-- pressure bc is set to neumann at the top of the model domain.
-    DO  i = 0, nx
-       ar(i,nz) = ar1(i,nz-1) / ( tri_for_1d(4,i,nz-1) + 1.0E-20_wp )
-    ENDDO
-    DO  k = nz-2, 0, -1
-       DO  i = 0, nx
-          ar(i,k+1) = ( ar1(i,k) - tri_for_1d(3,i,k) * ar(i,k+2) ) / tri_for_1d(4,i,k)
-       ENDDO
-    ENDDO
-
-!
-!-- Indices i=0, j=0 correspond to horizontally averaged pressure. The respective values of ar
-!-- should be zero at all k-levels if acceleration of horizontally averaged vertical velocity is
-!-- zero.
-    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
-       IF ( j == 0 )  THEN
-          DO  k = 1, nz
-             ar(0,k) = 0.0_wp
-          ENDDO
-       ENDIF
-    ENDIF
-
- END SUBROUTINE substi_1dd
-
- END SUBROUTINE tridia_1dd
-
-
- END MODULE tridia_solver
Index: palm/trunk/SOURCE/turbulence_closure_mod.f90
===================================================================
--- palm/trunk/SOURCE/turbulence_closure_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,5540 +1,0 @@
-!> @file turbulence_closure_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! openmp bugfix (some private statements were missing)
-!
-! 4768 2020-11-02 19:11:23Z suehring
-! Enable 3D data output also with 64-bit precision
-!
-! 4717 2020-09-30 22:27:40Z pavelkrc
-! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
-! directives (J. Resler)
-!
-! 4674 2020-09-10 10:36:55Z pavelkrc
-! Update ACC directives for downward facing USM and LSM surfaces
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4625 2020-07-24 12:13:16Z oliver.maas
-! for turbulence_closure = '1.5-order-dai': copy value of distance_to_wall to
-! ghostpoints at dirichlet/radiation boundaries
-!
-! 4586 2020-07-01 16:16:43Z gronemeier
-! Renamed rif to richardson_number (Richardson Flux Number to Gradient Richardson Number)
-!
-! 4510 2020-04-29 14:19:18Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! workaround for Intel14 compiler added
-!
-! 4486 2020-04-02 20:45:12Z maronga
-! Bugfix: include topography in calculation of distance_to_wall (1.5-order-dai closure)
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! - added new LES closure after Dai et al. (2020), which provides much better grid convergence in
-!   stable boundary layer runs. The implementation is experimental at the moment and should be used
-!   with special care. The new SGS closure can be switched on via
-!   turbulence_closure = '1.5-order-dai'
-! - variable ml_wall_adjusted renamed to delta as it represents a grid size and not a mixing length
-!   (see Equations 14 and 18 in Maronga et al. 2015, GMD)
-! - nameing of turbulence closures revised:
-!        'Moeng_Wyngaard' to '1.5-order'
-!        'TKE-l' to 'tke-l'
-!        'TKE-e' to 'tke-e'
-! - LOGICAL steering variable renamed:
-!        les_mw to les_default
-!
-! 4473 2020-03-25 21:04:07Z gronemeier
-! - rename l-grid to gridsize-geometric-mean
-!          l-wall to ml-wall-adjusted
-!          l-stable to ml-stratification
-!          l-black to ml-blackadar
-!          l-v to ml-local-profile
-!          l-max to max-length-scale
-!          l to ml
-! - adjust some comments
-! - corrected definition of wall-adjusted mixing length to include gridsize-geometric-mean
-! - moved definition of wall_adjustment_factor to this module
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4433 2020-02-28 22:14:43Z gronemeier
-! remove warning for newly implemented RANS mode
-!
-! 4370 2020-01-10 14:00:44Z raasch
-! vector directives added to force vectorization on Intel19 compiler
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4177 2019-08-20 14:32:34Z gronemeier
-! add comment
-!
-! 4170 2019-08-19 17:12:31Z gronemeier
-! - add performance optimizations according to K. Ketelsen to diffusion_e and
-!   tcm_diffusivities_default
-! - bugfix in calculating l_wall for vertical walls
-! - bugfix in using l_wall in initialization (consider wall_adjustment_factor)
-! - always initialize diss and save the dissipation to that array
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4110 2019-07-22 17:05:21Z suehring
-! pass integer flag array as well as boundary flags to WS scalar advection routine
-!
-! 4109 2019-07-22 17:00:34Z suehring
-! - Modularize setting of boundary conditions for TKE and dissipation
-! - Neumann boundary condition for TKE at model top is set also in child domain
-! - Revise setting of Neumann boundary conditions at non-cyclic lateral boundaries
-! - Bugfix, set Neumann boundary condition for TKE at vertical wall instead of an implicit Dirichlet
-!   boundary condition which implied a sink of TKE at vertical walls
-!
-! 4048 2019-06-21 21:00:21Z knoop
-! write out preprocessor directives; remove tailing whitespaces
-!
-! 3775 2019-03-04 12:40:20Z gronemeier
-! removed unused variables
-!
-! 3724 2019-02-06 16:28:23Z kanani
-! Correct double-used log_point_s units
-!
-! 3719 2019-02-06 13:10:18Z kanani
-! Changed log_point to log_point_s, otherwise this overlaps with 'all progn.equations' cpu
-! measurement.
-!
-! 3684 2019-01-20 20:20:58Z knoop
-! Remove unused variable simulated_time
-!
-! 2696 2017-12-14 17:12:51Z kanani
-! Initial revision
-!
-!
-! Authors:
-! --------
-! @author Tobias Gronemeier
-! @author Hauke Wurps
-!
-! Description:
-! ------------
-!> This module contains the available turbulence closures for PALM.
-!>
-!> @todo test initialization for all possibilities
-!> @todo add OpenMP directives whereever possible
-!> @todo Check for random disturbances
-!> @note <Enter notes on the module>
-!--------------------------------------------------------------------------------------------------!
- MODULE turbulence_closure_mod
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  diss,                                                                               &
-               diss_1,                                                                             &
-               diss_2,                                                                             &
-               diss_3,                                                                             &
-               diss_p,                                                                             &
-               dzu,                                                                                &
-               e,                                                                                  &
-               e_1,                                                                                &
-               e_2,                                                                                &
-               e_3,                                                                                &
-               e_p,                                                                                &
-               kh,                                                                                 &
-               km,                                                                                 &
-               mean_inflow_profiles,                                                               &
-               prho,                                                                               &
-               pt,                                                                                 &
-               tdiss_m,                                                                            &
-               te_m,                                                                               &
-               tend,                                                                               &
-               u,                                                                                  &
-               v,                                                                                  &
-               vpt,                                                                                &
-               w
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  g,                                                                                  &
-               kappa,                                                                              &
-               lv_d_cp,                                                                            &
-               lv_d_rd,                                                                            &
-               rd_d_rv
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               child_domain,                                                                       &
-               constant_diffusion,                                                                 &
-               current_timestep_number,                                                            &
-               dt_3d,                                                                              &
-               e_init,                                                                             &
-               humidity,                                                                           &
-               initializing_actions,                                                               &
-               intermediate_timestep_count,                                                        &
-               intermediate_timestep_count_max,                                                    &
-               km_constant,                                                                        &
-               les_dai,                                                                            &
-               les_dynamic,                                                                        &
-               les_default,                                                                        &
-               ocean_mode,                                                                         &
-               plant_canopy,                                                                       &
-               prandtl_number,                                                                     &
-               pt_reference,                                                                       &
-               rans_mode,                                                                          &
-               rans_tke_e,                                                                         &
-               rans_tke_l,                                                                         &
-               timestep_scheme,                                                                    &
-               turbulence_closure,                                                                 &
-               turbulent_inflow,                                                                   &
-               use_upstream_for_tke,                                                               &
-               vpt_reference,                                                                      &
-               ws_scheme_sca
-
-
-    USE advec_ws,                                                                                  &
-        ONLY:  advec_s_ws
-
-    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 cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point_s
-
-    USE indices,                                                                                   &
-        ONLY:  advc_flags_s,                                                                       &
-               nbgp,                                                                               &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               topo_top_ind,                                                                       &
-               wall_flags_total_0
-
-    USE kinds
-
-    USE ocean_mod,                                                                                 &
-        ONLY:  prho_reference
-
-    USE pegrid
-
-    USE plant_canopy_model_mod,                                                                    &
-        ONLY:  pcm_tendency
-
-    USE statistics,                                                                                &
-        ONLY:  hom,                                                                                &
-               hom_sum,                                                                            &
-               statistic_regions
-
-    USE surface_mod,                                                                               &
-        ONLY:  bc_h,                                                                               &
-               bc_v,                                                                               &
-               surf_def_h,                                                                         &
-               surf_def_v,                                                                         &
-               surf_lsm_h,                                                                         &
-               surf_lsm_v,                                                                         &
-               surf_usm_h,                                                                         &
-               surf_usm_v,                                                                         &
-               surf_type
-
-    IMPLICIT NONE
-
-
-    REAL(wp) ::  c_0                 !< constant used for diffusion coefficient and dissipation (dependent on mode RANS/LES)
-    REAL(wp) ::  c_1                 !< model constant for RANS mode
-    REAL(wp) ::  c_2                 !< model constant for RANS mode
-    REAL(wp) ::  c_3                 !< model constant for RANS mode
-    REAL(wp) ::  c_4                 !< model constant for RANS mode
-    REAL(wp) ::  dsig_e = 1.0_wp     !< factor to calculate Ke from Km (1/sigma_e)
-    REAL(wp) ::  dsig_diss = 1.0_wp  !< factor to calculate K_diss from Km (1/sigma_diss)
-    REAL(wp) ::  length_scale_max    !< maximum length scale for Blackadar mixing length
-    REAL(wp) ::  wall_adjustment_factor = 1.8_wp  !< adjustment factor for mixing length
-
-    REAL(wp), DIMENSION(0:4) ::  rans_const_c = &        !< model constants for RANS mode (namelist param)
-       (/ 0.55_wp, 1.44_wp, 1.92_wp, 1.44_wp, 0.0_wp /)  !> default values fit for standard-tke-e closure
-
-    REAL(wp), DIMENSION(2) ::  rans_const_sigma = &      !< model constants for RANS mode, sigma values (namelist param)
-       (/ 1.0_wp, 1.30_wp /)                             !> (sigma_e, sigma_diss)
-
-    REAL(wp), ALLOCATABLE, DIMENSION(:)     ::  ml_blackadar      !< mixing length according to Blackadar
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  delta             !< grid size, possibly limited by wall adjustment factor
-    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  distance_to_wall  !< distance to the surface/wall
-
-!
-!-- Public variables
-    PUBLIC c_0,                                                                                    &
-           rans_const_c,                                                                           &
-           rans_const_sigma
-
-    SAVE
-
-    PRIVATE
-!
-!-- Public subroutines
-    PUBLIC  tcm_actions,                                                                           &
-            tcm_boundary_conds,                                                                    &
-            tcm_check_parameters,                                                                  &
-            tcm_check_data_output,                                                                 &
-            tcm_data_output_2d,                                                                    &
-            tcm_data_output_3d,                                                                    &
-            tcm_define_netcdf_grid,                                                                &
-            tcm_diffusivities,                                                                     &
-            tcm_init_arrays,                                                                       &
-            tcm_init,                                                                              &
-            tcm_prognostic_equations,                                                              &
-            tcm_swap_timelevel,                                                                    &
-            tcm_3d_data_averaging
-
-
-
-
-!
-!-- PALM interfaces:
-!-- Boundary conditions for subgrid TKE and dissipation
-    INTERFACE tcm_boundary_conds
-       MODULE PROCEDURE tcm_boundary_conds
-    END INTERFACE tcm_boundary_conds
-!
-!-- Input parameter checks to be done in check_parameters
-    INTERFACE tcm_check_parameters
-       MODULE PROCEDURE tcm_check_parameters
-    END INTERFACE tcm_check_parameters
-
-!
-!-- Data output checks for 2D/3D data to be done in check_parameters
-    INTERFACE tcm_check_data_output
-       MODULE PROCEDURE tcm_check_data_output
-    END INTERFACE tcm_check_data_output
-
-!
-!-- Definition of data output quantities
-    INTERFACE tcm_define_netcdf_grid
-       MODULE PROCEDURE tcm_define_netcdf_grid
-    END INTERFACE tcm_define_netcdf_grid
-
-!
-!-- Initialization of arrays
-    INTERFACE tcm_init_arrays
-       MODULE PROCEDURE tcm_init_arrays
-    END INTERFACE tcm_init_arrays
-
-!
-!-- Initialization actions
-    INTERFACE tcm_init
-       MODULE PROCEDURE tcm_init
-    END INTERFACE tcm_init
-
-!
-!-- Location specific actions
-    INTERFACE tcm_actions
-       MODULE PROCEDURE tcm_actions
-       MODULE PROCEDURE tcm_actions_ij
-    END INTERFACE tcm_actions
-
-!
-!-- Prognostic equations for TKE and TKE dissipation rate
-    INTERFACE tcm_prognostic_equations
-       MODULE PROCEDURE tcm_prognostic_equations
-       MODULE PROCEDURE tcm_prognostic_equations_ij
-    END INTERFACE tcm_prognostic_equations
-
-!
-!-- Swapping of time levels (required for prognostic variables)
-    INTERFACE tcm_swap_timelevel
-       MODULE PROCEDURE tcm_swap_timelevel
-    END INTERFACE tcm_swap_timelevel
-
-!
-!-- Averaging of 3D data for output
-    INTERFACE tcm_3d_data_averaging
-       MODULE PROCEDURE tcm_3d_data_averaging
-    END INTERFACE tcm_3d_data_averaging
-
-!
-!-- Data output of 2D quantities
-    INTERFACE tcm_data_output_2d
-       MODULE PROCEDURE tcm_data_output_2d
-    END INTERFACE tcm_data_output_2d
-
-!
-!-- Data output of 3D data
-    INTERFACE tcm_data_output_3d
-       MODULE PROCEDURE tcm_data_output_3d
-    END INTERFACE tcm_data_output_3d
-
-!
-!-- Call tcm_diffusivities_default and tcm_diffusivities_dynamic
-    INTERFACE tcm_diffusivities
-       MODULE PROCEDURE tcm_diffusivities
-    END INTERFACE tcm_diffusivities
-
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for turbulence closure module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_boundary_conds
-
-    USE pmc_interface,                                                                             &
-        ONLY : rans_mode_parent
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< grid index x direction
-    INTEGER(iwp) ::  j  !< grid index y direction
-    INTEGER(iwp) ::  k  !< grid index z direction
-    INTEGER(iwp) ::  l  !< running index boundary type, for up- and downward-facing walls
-    INTEGER(iwp) ::  m  !< running index surface elements
-!
-!-- Boundary conditions for TKE.
-    IF ( .NOT. constant_diffusion )  THEN
-!
-!--    In LES mode, Neumann conditions with de/x_i=0 are assumed at solid walls.
-!--    Note, only TKE is prognostic in this case and dissipation is only a diagnostic quantity.
-       IF ( .NOT. rans_mode )  THEN
-!
-!--       Horizontal walls, upward- and downward-facing
-          DO  l = 0, 1
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
-             !$ACC PRESENT(bc_h, e_p)
-             DO  m = 1, bc_h(l)%ns
-                i = bc_h(l)%i(m)
-                j = bc_h(l)%j(m)
-                k = bc_h(l)%k(m)
-                e_p(k+bc_h(l)%koff,j,i) = e_p(k,j,i)
-             ENDDO
-          ENDDO
-!
-!--       Vertical walls
-          DO  l = 0, 3
-!
-!--          Note concerning missing ACC directive for this loop: Even though the data structure
-!--          bc_v is present, it may not contain any allocated arrays in the flat but also in a
-!--          topography case, leading to a runtime error. Therefore, omit ACC directives for this
-!--          loop, in contrast to the bc_h loop.
-             !$OMP PARALLEL DO PRIVATE( i, j, k )
-             DO  m = 1, bc_v(l)%ns
-                i = bc_v(l)%i(m)
-                j = bc_v(l)%j(m)
-                k = bc_v(l)%k(m)
-                e_p(k,j+bc_v(l)%joff,i+bc_v(l)%ioff) = e_p(k,j,i)
-             ENDDO
-          ENDDO
-!
-!--    In RANS mode, wall function is used as boundary condition for TKE
-       ELSE
-!
-!--       Use wall function within constant-flux layer
-!--       Note, grid points listed in bc_h are not included in any calculations in RANS mode and are
-!--       therefore not set here.
-!
-!--       Upward-facing surfaces
-!--       Default surfaces
-          DO  m = 1, surf_def_h(0)%ns
-             i = surf_def_h(0)%i(m)
-             j = surf_def_h(0)%j(m)
-             k = surf_def_h(0)%k(m)
-             e_p(k,j,i) = ( surf_def_h(0)%us(m) / c_0 )**2
-          ENDDO
-!
-!--       Natural surfaces
-          DO  m = 1, surf_lsm_h(0)%ns
-             i = surf_lsm_h(0)%i(m)
-             j = surf_lsm_h(0)%j(m)
-             k = surf_lsm_h(0)%k(m)
-             e_p(k,j,i) = ( surf_lsm_h(0)%us(m) / c_0 )**2
-          ENDDO
-!
-!--       Urban surfaces
-          DO  m = 1, surf_usm_h(0)%ns
-             i = surf_usm_h(0)%i(m)
-             j = surf_usm_h(0)%j(m)
-             k = surf_usm_h(0)%k(m)
-             e_p(k,j,i) = ( surf_usm_h(0)%us(m) / c_0 )**2
-          ENDDO
-!
-!--       Vertical surfaces
-          DO  l = 0, 3
-!
-!--          Default surfaces
-             DO  m = 1, surf_def_v(l)%ns
-                i = surf_def_v(l)%i(m)
-                j = surf_def_v(l)%j(m)
-                k = surf_def_v(l)%k(m)
-                e_p(k,j,i) = ( surf_def_v(l)%us(m) / c_0 )**2
-             ENDDO
-!
-!--          Natural surfaces
-             DO  m = 1, surf_lsm_v(l)%ns
-                i = surf_lsm_v(l)%i(m)
-                j = surf_lsm_v(l)%j(m)
-                k = surf_lsm_v(l)%k(m)
-                e_p(k,j,i) = ( surf_lsm_v(l)%us(m) / c_0 )**2
-             ENDDO
-!
-!--          Urban surfaces
-             DO  m = 1, surf_usm_v(l)%ns
-                i = surf_usm_v(l)%i(m)
-                j = surf_usm_v(l)%j(m)
-                k = surf_usm_v(l)%k(m)
-                e_p(k,j,i) = ( surf_usm_v(l)%us(m) / c_0 )**2
-             ENDDO
-          ENDDO
-       ENDIF
-!
-!--    Set Neumann boundary condition for TKE at model top. Do this also in case of a nested run.
-       !$ACC KERNELS PRESENT(e_p)
-       e_p(nzt+1,:,:) = e_p(nzt,:,:)
-       !$ACC END KERNELS
-!
-!--    Nesting case: if parent operates in RANS mode and child in LES mode, no TKE is transfered.
-!--    This case, set Neumann conditions at lateral and top child boundaries.
-!--    If not ( both either in RANS or in LES mode ), TKE boundary condition is treated in the
-!--    nesting.
-       If ( child_domain )  THEN
-          IF ( rans_mode_parent  .AND.  .NOT. rans_mode )  THEN
-
-             e_p(nzt+1,:,:) = e_p(nzt,:,:)
-             IF ( bc_dirichlet_l )  e_p(:,:,nxl-1) = e_p(:,:,nxl)
-             IF ( bc_dirichlet_r )  e_p(:,:,nxr+1) = e_p(:,:,nxr)
-             IF ( bc_dirichlet_s )  e_p(:,nys-1,:) = e_p(:,nys,:)
-             IF ( bc_dirichlet_n )  e_p(:,nyn+1,:) = e_p(:,nyn,:)
-
-          ENDIF
-       ENDIF
-!
-!--    At in- and outflow boundaries also set Neumann boundary conditions for the SGS-TKE. An
-!--    exception is made for the child domain if both parent and child operate in RANS mode. This
-!--    case no lateral Neumann boundary conditions will be set but Dirichlet conditions will be set
-!--    in the nesting.
-       IF ( .NOT. child_domain  .AND.  .NOT. rans_mode_parent  .AND.  .NOT. rans_mode )  THEN
-          IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
-             e_p(:,nys-1,:) = e_p(:,nys,:)
-             IF ( rans_tke_e )  diss_p(:,nys-1,:) = diss_p(:,nys,:)
-          ENDIF
-          IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
-             e_p(:,nyn+1,:) = e_p(:,nyn,:)
-             IF ( rans_tke_e )  diss_p(:,nyn+1,:) = diss_p(:,nyn,:)
-          ENDIF
-          IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-             e_p(:,:,nxl-1) = e_p(:,:,nxl)
-             IF ( rans_tke_e )  diss_p(:,nyn+1,:) = diss_p(:,nyn,:)
-          ENDIF
-          IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
-             e_p(:,:,nxr+1) = e_p(:,:,nxr)
-             IF ( rans_tke_e )  diss_p(:,nyn+1,:) = diss_p(:,nyn,:)
-          ENDIF
-       ENDIF
-    ENDIF
-
-!
-!-- Boundary conditions for TKE dissipation rate in RANS mode.
-    IF ( rans_tke_e )  THEN
-!
-!--    Use wall function within constant-flux layer
-!--    Upward-facing surfaces
-!--    Default surfaces
-       DO  m = 1, surf_def_h(0)%ns
-          i = surf_def_h(0)%i(m)
-          j = surf_def_h(0)%j(m)
-          k = surf_def_h(0)%k(m)
-          diss_p(k,j,i) = surf_def_h(0)%us(m)**3 / ( kappa * surf_def_h(0)%z_mo(m) )
-       ENDDO
-!
-!--    Natural surfaces
-       DO  m = 1, surf_lsm_h(0)%ns
-          i = surf_lsm_h(0)%i(m)
-          j = surf_lsm_h(0)%j(m)
-          k = surf_lsm_h(0)%k(m)
-          diss_p(k,j,i) = surf_lsm_h(0)%us(m)**3 / ( kappa * surf_lsm_h(0)%z_mo(m) )
-       ENDDO
-!
-!--    Urban surfaces
-       DO  m = 1, surf_usm_h(0)%ns
-          i = surf_usm_h(0)%i(m)
-          j = surf_usm_h(0)%j(m)
-          k = surf_usm_h(0)%k(m)
-          diss_p(k,j,i) = surf_usm_h(0)%us(m)**3 / ( kappa * surf_usm_h(0)%z_mo(m) )
-       ENDDO
-!
-!--    Vertical surfaces
-       DO  l = 0, 3
-!
-!--       Default surfaces
-          DO  m = 1, surf_def_v(l)%ns
-             i = surf_def_v(l)%i(m)
-             j = surf_def_v(l)%j(m)
-             k = surf_def_v(l)%k(m)
-             diss_p(k,j,i) = surf_def_v(l)%us(m)**3 / ( kappa * surf_def_v(l)%z_mo(m) )
-          ENDDO
-!
-!--       Natural surfaces
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m)
-             j = surf_lsm_v(l)%j(m)
-             k = surf_lsm_v(l)%k(m)
-             diss_p(k,j,i) = surf_lsm_v(l)%us(m)**3 / ( kappa * surf_lsm_v(l)%z_mo(m) )
-          ENDDO
-!
-!--       Urban surfaces
-          DO  m = 1, surf_usm_v(l)%ns
-             i = surf_usm_v(l)%i(m)
-             j = surf_usm_v(l)%j(m)
-             k = surf_usm_v(l)%k(m)
-             diss_p(k,j,i) = surf_usm_v(l)%us(m)**3 / ( kappa * surf_usm_v(l)%z_mo(m) )
-          ENDDO
-       ENDDO
-!
-!--    Limit change of diss to be between -90% and +100%. Also, set an absolute minimum value
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-                diss_p(k,j,i) = MAX( MIN( diss_p(k,j,i), 2.0_wp * diss(k,j,i) ),                   &
-                                          0.1_wp * diss(k,j,i), 0.0001_wp )
-             ENDDO
-          ENDDO
-       ENDDO
-
-       diss_p(nzt+1,:,:) = diss_p(nzt,:,:)
-
-    ENDIF
-
- END SUBROUTINE tcm_boundary_conds
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for turbulence closure module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_check_parameters
-
-    USE control_parameters,                                                                        &
-        ONLY:  message_string,                                                                     &
-               turbulent_inflow,                                                                   &
-               turbulent_outflow
-
-    IMPLICIT NONE
-
-!
-!-- Define which turbulence closure is going to be used
-    SELECT CASE ( TRIM( turbulence_closure ) )
-
-       CASE ( '1.5-order' )
-          les_default = .TRUE.
-
-       CASE ( '1.5-order-dai' )
-          les_dai = .TRUE.
-
-       CASE ( 'dynamic' )
-          les_dynamic = .TRUE.
-
-       CASE ( 'tke-l' )
-          rans_tke_l = .TRUE.
-          rans_mode = .TRUE.
-
-       CASE ( 'tke-e' )
-          rans_tke_e = .TRUE.
-          rans_mode = .TRUE.
-
-       CASE DEFAULT
-          message_string = 'Unknown turbulence closure: ' // TRIM( turbulence_closure )
-          CALL message( 'tcm_check_parameters', 'PA0500', 1, 2, 0, 6, 0 )
-
-    END SELECT
-!
-!-- Set variables for RANS mode or LES mode
-    IF ( rans_mode )  THEN
-!
-!--    Assign values to constants for RANS mode
-       dsig_e    = 1.0_wp / rans_const_sigma(1)
-       dsig_diss = 1.0_wp / rans_const_sigma(2)
-
-       c_0 = rans_const_c(0)
-       c_1 = rans_const_c(1)
-       c_2 = rans_const_c(2)
-       c_3 = rans_const_c(3)   !> @todo Clarify how to switch between different models
-       c_4 = rans_const_c(4)
-
-       IF ( turbulent_inflow .OR. turbulent_outflow )  THEN
-          message_string = 'turbulent inflow/outflow is not yet '// 'implemented for RANS mode'
-          CALL message( 'tcm_check_parameters', 'PA0501', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ELSE
-!
-!--    LES mode
-       c_0 = 0.1_wp    !According to Lilly (1967) and Deardorff (1980)
-
-       dsig_e = 1.0_wp !Assure to use K_m to calculate TKE instead of K_e which is used in RANS mode
-
-    ENDIF
-
- END SUBROUTINE tcm_check_parameters
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check data output.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_check_data_output( var, unit )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  unit  !< unit of output variable
-    CHARACTER(LEN=*) ::  var   !< name of output variable
-
-
-    SELECT CASE ( TRIM( var ) )
-
-       CASE ( 'diss' )
-          unit = 'm2/s3'
-
-       CASE ( 'kh', 'km' )
-          unit = 'm2/s'
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
- END SUBROUTINE tcm_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define appropriate grid for netcdf variables. It is called out from subroutine netcdf.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_x  !< x grid of output variable
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_y  !< y grid of output variable
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_z  !< z grid of output variable
-    CHARACTER(LEN=*), INTENT(IN)  ::  var     !< name of output variable
-
-    LOGICAL, INTENT(OUT) ::  found   !< flag if output variable is found
-
-    found  = .TRUE.
-
-!
-!-- Check for the grid
-    SELECT CASE ( TRIM( var ) )
-
-       CASE ( 'diss', 'diss_xy', 'diss_xz', 'diss_yz' )
-          grid_x = 'x'
-          grid_y = 'y'
-          grid_z = 'zu'
-
-       CASE ( 'kh', 'kh_xy', 'kh_xz', 'kh_yz' )
-          grid_x = 'x'
-          grid_y = 'y'
-          grid_z = 'zu'
-
-       CASE ( 'km', 'km_xy', 'km_xz', 'km_yz' )
-          grid_x = 'x'
-          grid_y = 'y'
-          grid_z = 'zu'
-
-       CASE DEFAULT
-          found  = .FALSE.
-          grid_x = 'none'
-          grid_y = 'none'
-          grid_z = 'none'
-
-    END SELECT
-
- END SUBROUTINE tcm_define_netcdf_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Average 3D data.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_3d_data_averaging( mode, variable )
-
-
-    USE averaging,                                                                                 &
-        ONLY:  diss_av,                                                                            &
-               kh_av,                                                                              &
-               km_av
-
-    USE control_parameters,                                                                        &
-        ONLY:  average_count_3d
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  mode      !< flag defining mode 'allocate', 'sum' or 'average'
-    CHARACTER(LEN=*) ::  variable  !< name of variable
-
-    INTEGER(iwp) ::  i  !< loop index
-    INTEGER(iwp) ::  j  !< loop index
-    INTEGER(iwp) ::  k  !< loop index
-
-    IF ( mode == 'allocate' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'diss' )
-             IF ( .NOT. ALLOCATED( diss_av ) )  THEN
-                ALLOCATE( diss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             diss_av = 0.0_wp
-
-          CASE ( 'kh' )
-             IF ( .NOT. ALLOCATED( kh_av ) )  THEN
-                ALLOCATE( kh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             kh_av = 0.0_wp
-
-          CASE ( 'km' )
-             IF ( .NOT. ALLOCATED( km_av ) )  THEN
-                ALLOCATE( km_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-             ENDIF
-             km_av = 0.0_wp
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'sum' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'diss' )
-             IF ( ALLOCATED( diss_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         diss_av(k,j,i) = diss_av(k,j,i) + diss(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'kh' )
-             IF ( ALLOCATED( kh_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         kh_av(k,j,i) = kh_av(k,j,i) + kh(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'km' )
-             IF ( ALLOCATED( km_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         km_av(k,j,i) = km_av(k,j,i) + km(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'average' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-          CASE ( 'diss' )
-             IF ( ALLOCATED( diss_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         diss_av(k,j,i) = diss_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'kh' )
-             IF ( ALLOCATED( kh_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         kh_av(k,j,i) = kh_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          CASE ( 'km' )
-             IF ( ALLOCATED( km_av ) ) THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb, nzt+1
-                         km_av(k,j,i) = km_av(k,j,i) / REAL( average_count_3d, KIND = wp )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-       END SELECT
-
-    ENDIF
-
- END SUBROUTINE tcm_3d_data_averaging
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define 2D output variables.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_data_output_2d( av, variable, found, grid, mode, local_pf, nzb_do, nzt_do )
-
-    USE averaging,                                                                                 &
-        ONLY:  diss_av,                                                                            &
-               kh_av,                                                                              &
-               km_av
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  grid      !< name of vertical grid
-    CHARACTER(LEN=*) ::  mode      !< either 'xy', 'xz' or 'yz'
-    CHARACTER(LEN=*) ::  variable  !< name of variable
-
-    INTEGER(iwp) ::  av       !< flag for (non-)average output
-    INTEGER(iwp) ::  flag_nr  !< number of masking flag
-    INTEGER(iwp) ::  i        !< loop index
-    INTEGER(iwp) ::  j        !< loop index
-    INTEGER(iwp) ::  k        !< loop index
-    INTEGER(iwp) ::  nzb_do   !< vertical output index (bottom)
-    INTEGER(iwp) ::  nzt_do   !< vertical output index (top)
-
-    LOGICAL ::  found     !< flag if output variable is found
-    LOGICAL ::  resorted  !< flag if output is already resorted
-
-    REAL(wp) ::  fill_value = -9999.0_wp  !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< local
-     !< array to which output data is resorted to
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
-
-    found = .TRUE.
-    resorted = .FALSE.
-!
-!-- Set masking flag for topography for not resorted arrays
-    flag_nr = 0
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'diss_xy', 'diss_xz', 'diss_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => diss
-          ELSE
-             IF ( .NOT. ALLOCATED( diss_av ) )  THEN
-                ALLOCATE( diss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                diss_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => diss_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'kh_xy', 'kh_xz', 'kh_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => kh
-          ELSE
-             IF ( .NOT. ALLOCATED( kh_av ) )  THEN
-                ALLOCATE( kh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                kh_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => kh_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE ( 'km_xy', 'km_xz', 'km_yz' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => km
-          ELSE
-             IF ( .NOT. ALLOCATED( km_av ) )  THEN
-                ALLOCATE( km_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                km_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => km_av
-          ENDIF
-          IF ( mode == 'xy' ) grid = 'zu'
-
-       CASE DEFAULT
-          found = .FALSE.
-          grid  = 'none'
-
-    END SELECT
-
-    IF ( found  .AND.  .NOT.  resorted )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_do, nzt_do
-                local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, KIND = wp ),     &
-                                  BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
- END SUBROUTINE tcm_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define 3D output variables.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-
-
-    USE averaging,                                                                                 &
-        ONLY:  diss_av,                                                                            &
-               kh_av,                                                                              &
-               km_av
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  variable  !< name of variable
-
-    INTEGER(iwp) ::  av       !< flag for (non-)average output
-    INTEGER(iwp) ::  flag_nr  !< number of masking flag
-    INTEGER(iwp) ::  i        !< loop index
-    INTEGER(iwp) ::  j        !< loop index
-    INTEGER(iwp) ::  k        !< loop index
-    INTEGER(iwp) ::  nzb_do   !< lower limit of the data output (usually 0)
-    INTEGER(iwp) ::  nzt_do   !< vertical upper limit of the data output (usually nz_do3d)
-
-    LOGICAL ::  found     !< flag if output variable is found
-    LOGICAL ::  resorted  !< flag if output is already resorted
-
-    REAL(wp) ::  fill_value = -9999.0_wp  !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< local
-       !< array to which output data is resorted to
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
-
-    found = .TRUE.
-    resorted = .FALSE.
-!
-!-- Set masking flag for topography for not resorted arrays
-    flag_nr = 0
-
-    SELECT CASE ( TRIM( variable ) )
-
-       CASE ( 'diss' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => diss
-          ELSE
-             IF ( .NOT. ALLOCATED( diss_av ) )  THEN
-                ALLOCATE( diss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                diss_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => diss_av
-          ENDIF
-
-       CASE ( 'kh' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => kh
-          ELSE
-             IF ( .NOT. ALLOCATED( kh_av ) )  THEN
-                ALLOCATE( kh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                kh_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => kh_av
-          ENDIF
-
-       CASE ( 'km' )
-          IF ( av == 0 )  THEN
-             to_be_resorted => km
-          ELSE
-             IF ( .NOT. ALLOCATED( km_av ) )  THEN
-                ALLOCATE( km_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-                km_av = REAL( fill_value, KIND = wp )
-             ENDIF
-             to_be_resorted => km_av
-          ENDIF
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
-
-    IF ( found  .AND.  .NOT.  resorted )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_do, nzt_do
-                local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, KIND = wp ),     &
-                                  BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
-             ENDDO
-          ENDDO
-       ENDDO
-       resorted = .TRUE.
-    ENDIF
-
- END SUBROUTINE tcm_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate arrays and assign pointers.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_init_arrays
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  collision_turbulence
-
-    USE pmc_interface,                                                                             &
-        ONLY:  nested_run
-
-    IMPLICIT NONE
-
-    ALLOCATE( kh(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( km(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-    ALLOCATE( e_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( e_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( e_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-!
-!-- Allocate arrays required for dissipation.
-!-- Please note, if it is a nested run, arrays need to be allocated even if they do not necessarily
-!-- need to be transferred, which is attributed to the design of the model coupler which allocates
-!-- memory for each variable.
-    ALLOCATE( diss_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-    IF ( rans_tke_e  .OR.  nested_run )  THEN
-       ALLOCATE( diss_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-       ALLOCATE( diss_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ENDIF
-
-!
-!-- Initial assignment of pointers
-    e  => e_1;   e_p  => e_2;   te_m  => e_3
-
-    diss => diss_1
-    IF ( rans_tke_e  .OR.  nested_run )  THEN
-       diss_p => diss_2; tdiss_m => diss_3
-    ENDIF
-
- END SUBROUTINE tcm_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of turbulence closure module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_init
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               complex_terrain,                                                                    &
-               topography
-
-    USE model_1d_mod,                                                                              &
-        ONLY:  e1d,                                                                                &
-               kh1d,                                                                               &
-               km1d
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: i             !< loop index
-    INTEGER(iwp) :: j             !< loop index
-    INTEGER(iwp) :: k             !< loop index
-    INTEGER(iwp) :: nz_s_shift    !< lower shift index for scalars
-    INTEGER(iwp) :: nz_s_shift_l  !< local lower shift index in case of turbulent inflow
-
-!
-!-- Initialize mixing length
-    CALL tcm_init_mixing_length
-
-!
-!-- Actions for initial runs
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.                                &
-         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
-
-       IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
-
-          IF ( .NOT. rans_tke_e )  THEN
-!
-!--          Transfer initial profiles to the arrays of the 3D model
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   e(:,j,i)  = e1d
-                   kh(:,j,i) = kh1d
-                   km(:,j,i) = km1d
-                ENDDO
-             ENDDO
-
-             IF ( constant_diffusion )  THEN
-                e = 0.0_wp
-             ENDIF
-
-             diss = 0.0_wp
-
-          ELSE
-!
-!--          In case of TKE-e closure in RANS mode, do not use e, diss, and km profiles from 1D
-!--          model. Instead, initialize with constant profiles
-             IF ( constant_diffusion )  THEN
-                km = km_constant
-                kh = km / prandtl_number
-                e  = 0.0_wp
-             ELSEIF ( e_init > 0.0_wp )  THEN
-                DO  i = nxlg, nxrg
-                   DO  j = nysg, nyng
-                      DO  k = nzb+1, nzt
-                         km(k,j,i) = c_0 * SQRT( e_init ) * MIN( delta(k,j,i), ml_blackadar(k) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-                km(nzb,:,:)   = km(nzb+1,:,:)
-                km(nzt+1,:,:) = km(nzt,:,:)
-                kh = km / prandtl_number
-                e  = e_init
-             ELSE
-                IF ( .NOT. ocean_mode )  THEN
-                   kh   = 0.01_wp   ! There must exist an initial diffusion, because otherwise no
-                   km   = 0.01_wp   ! TKE would be produced by the production terms, as long as not
-                                    ! yet e = (u*/cm)**2 at k=nzb+1
-                ELSE
-                   kh   = 0.00001_wp
-                   km   = 0.00001_wp
-                ENDIF
-                e    = 0.0_wp
-             ENDIF
-
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      diss(k,j,i) = c_0**4 * e(k,j,i)**2 / km(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-             diss(nzb,:,:) = diss(nzb+1,:,:)
-             diss(nzt+1,:,:) = diss(nzt,:,:)
-
-          ENDIF
-
-       ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 .OR.                   &
-                INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
-
-          IF ( constant_diffusion )  THEN
-             km = km_constant
-             kh = km / prandtl_number
-             e  = 0.0_wp
-          ELSEIF ( e_init > 0.0_wp )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      km(k,j,i) = c_0 * SQRT( e_init ) * delta(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-             km(nzb,:,:)   = km(nzb+1,:,:)
-             km(nzt+1,:,:) = km(nzt,:,:)
-             kh = km / prandtl_number
-             e  = e_init
-          ELSE
-             IF ( .NOT. ocean_mode )  THEN
-                kh   = 0.01_wp   ! There must exist an initial diffusion, because otherwise no TKE
-                km   = 0.01_wp   ! would be produced by the production terms, as long as not yet
-                                 ! e = (u*/cm)**2 at k=nzb+1
-             ELSE
-                kh   = 0.00001_wp
-                km   = 0.00001_wp
-             ENDIF
-             e    = 0.0_wp
-          ENDIF
-
-          IF ( rans_tke_e )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO  k = nzb+1, nzt
-                      diss(k,j,i) = c_0**4 * e(k,j,i)**2 / km(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-             diss(nzb,:,:) = diss(nzb+1,:,:)
-             diss(nzt+1,:,:) = diss(nzt,:,:)
-          ELSE
-             diss = 0.0_wp
-          ENDIF
-
-       ENDIF
-!
-!--    Store initial profiles for output purposes etc.
-       hom(:,1,23,:) = SPREAD( km(:,nys,nxl), 2, statistic_regions+1 )
-       hom(:,1,24,:) = SPREAD( kh(:,nys,nxl), 2, statistic_regions+1 )
-!
-!--    Initialize old and new time levels.
-       te_m = 0.0_wp
-       e_p = e
-       IF ( rans_tke_e )  THEN
-          tdiss_m = 0.0_wp
-          diss_p = diss
-       ENDIF
-
-    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.                             &
-             TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
-
-!
-!--    In case of complex terrain and cyclic fill method as initialization, shift initial data in
-!--    the vertical direction for each point in the x-y-plane depending on local surface height
-       IF ( complex_terrain  .AND.  TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                nz_s_shift = topo_top_ind(j,i,0)
-
-                e(nz_s_shift:nzt+1,j,i)  =  e(0:nzt+1-nz_s_shift,j,i)
-                km(nz_s_shift:nzt+1,j,i) = km(0:nzt+1-nz_s_shift,j,i)
-                kh(nz_s_shift:nzt+1,j,i) = kh(0:nzt+1-nz_s_shift,j,i)
-             ENDDO
-          ENDDO
-          IF ( rans_tke_e )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   nz_s_shift = topo_top_ind(j,i,0)
-
-                   diss(nz_s_shift:nzt+1,j,i) = diss(0:nzt+1-nz_s_shift,j,i)
-                ENDDO
-             ENDDO
-          ELSE
-             diss = 0.0_wp
-          ENDIF
-       ENDIF
-
-!
-!--    Initialization of the turbulence recycling method
-       IF ( TRIM( initializing_actions ) == 'cyclic_fill'  .AND.  turbulent_inflow )  THEN
-          mean_inflow_profiles(:,5) = hom_sum(:,8,0)   ! e
-!
-!--       In case of complex terrain, determine vertical displacement at inflow boundary and adjust
-!--       mean inflow profiles
-          IF ( complex_terrain )  THEN
-             IF ( nxlg <= 0  .AND.  nxrg >= 0  .AND.  nysg <= 0  .AND.  nyng >= 0 )  THEN
-                nz_s_shift_l = topo_top_ind(0,0,0)
-             ELSE
-                nz_s_shift_l = 0
-             ENDIF
-#if defined( __parallel )
-             CALL MPI_ALLREDUCE(nz_s_shift_l, nz_s_shift, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr)
-#else
-             nz_s_shift = nz_s_shift_l
-#endif
-             mean_inflow_profiles(nz_s_shift:nzt+1,5) = hom_sum(0:nzt+1-nz_s_shift,8,0)  ! e
-          ENDIF
-!
-!--       Use these mean profiles at the inflow (provided that Dirichlet conditions are used)
-          IF ( bc_dirichlet_l )  THEN
-             DO  j = nysg, nyng
-                DO  k = nzb, nzt+1
-                   e(k,j,nxlg:-1)  = mean_inflow_profiles(k,5)
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Inside buildings set TKE back to zero
-       IF ( TRIM( initializing_actions ) == 'cyclic_fill' .AND. topography /= 'flat' )  THEN
-!
-!--       Inside buildings set TKE back to zero.
-!--       Other scalars (km, kh,...) are ignored at present, maybe revise later.
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                DO  k = nzb, nzt
-                   e(k,j,i) = MERGE( e(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                ENDDO
-             ENDDO
-          ENDDO
-
-          IF ( rans_tke_e )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO  k = nzb, nzt
-                      diss(k,j,i) = MERGE( diss(k,j,i), 0.0_wp,                                    &
-                                    BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-!
-!--    Initialize new time levels (only done in order to set boundary values including ghost points)
-       e_p = e
-!
-!--    Although tendency arrays are set in prognostic_equations, they have to be predefined here
-!--    because there they are used (but multiplied with 0) before they are set.
-       te_m = 0.0_wp
-
-       IF ( rans_tke_e )  THEN
-          diss_p = diss
-          tdiss_m = 0.0_wp
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE tcm_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Pre-computation of grid-dependent and near-wall mixing length.
-!> @todo consider walls in horizontal direction at a distance further than a single grid point
-!> (RANS mode)
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_init_mixing_length
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzw,                                                                                &
-               ug,                                                                                 &
-               vg,                                                                                 &
-               zu,                                                                                 &
-               zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  f,                                                                                  &
-               message_string,                                                                     &
-               wall_adjustment
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz,                                                                     &
-               exchange_horiz_int
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx,                                                                                 &
-               dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               ny,                                                                                 &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               wall_flags_total_0
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  dist_dx     !< found distance devided by dx
-    INTEGER(iwp) ::  i           !< index variable along x
-    INTEGER(iwp) ::  ii          !< index variable along x
-    INTEGER(iwp) ::  j           !< index variable along y
-    INTEGER(iwp) ::  k           !< index variable along z
-    INTEGER(iwp) ::  k_max_topo  !< index of maximum topography height
-    INTEGER(iwp) ::  kk          !< index variable along z
-    INTEGER(iwp) ::  rad_i       !< search radius in grid points along x
-    INTEGER(iwp) ::  rad_i_l     !< possible search radius to the left
-    INTEGER(iwp) ::  rad_i_r     !< possible search radius to the right
-    INTEGER(iwp) ::  rad_j       !< search radius in grid points along y
-    INTEGER(iwp) ::  rad_j_n     !< possible search radius to north
-    INTEGER(iwp) ::  rad_j_s     !< possible search radius to south
-    INTEGER(iwp) ::  rad_k       !< search radius in grid points along z
-    INTEGER(iwp) ::  rad_k_b     !< search radius in grid points along negative z
-    INTEGER(iwp) ::  rad_k_t     !< search radius in grid points along positive z
-
-    INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE ::  vic_yz  !< contains a quarter of a single yz-slice of vicinity
-
-    INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  vicinity  !< contains topography information of the vicinity of (i/j/k)
-
-    REAL(wp) ::  distance_up            !< distance of grid box center to its boundary in upper direction
-    REAL(wp) ::  distance_down          !< distance of grid box center to its boundary in lower direction
-    REAL(wp) ::  distance_ns            !< distance of grid box center to its boundary in y direction
-    REAL(wp) ::  distance_lr            !< distance of grid box center to its boundary in x direction
-    REAL(wp) ::  distance_edge_yz_down  !< distance of grid box center to its boundary along yz diagonal (down)
-    REAL(wp) ::  distance_edge_yz_up    !< distance of grid box center to its boundary along yz diagonal (up)
-    REAL(wp) ::  distance_edge_xz_down  !< distance of grid box center to its boundary along xz diagonal
-    REAL(wp) ::  distance_edge_xz_up    !< distance of grid box center to its boundary along xz diagonal (up)
-    REAL(wp) ::  distance_edge_xy       !< distance of grid box center to its boundary along xy diagonal
-    REAL(wp) ::  distance_corners_down  !< distance of grid box center to its upper corners
-    REAL(wp) ::  distance_corners_up    !< distance of grid box center to its lower corners
-    REAL(wp) ::  radius                 !< search radius in meter
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  gridsize_geometric_mean  !< geometric mean of grid sizes dx, dy, dz
-
-
-    ALLOCATE( delta(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-
-    IF ( les_dai )  THEN
-       ALLOCATE ( distance_to_wall(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ENDIF
-!
-!-- Initialize the mixing length in case of an LES-simulation
-    IF ( .NOT. rans_mode )  THEN
-!
-!--    Compute the geometric averaged grid size (used for limiting the mixing length)
-       DO  k = nzb+1, nzt
-          gridsize_geometric_mean(k)  = ( dx * dy * dzw(k) )**0.33333333333333_wp
-       ENDDO
-       gridsize_geometric_mean(nzb)   = gridsize_geometric_mean(1)
-       gridsize_geometric_mean(nzt+1) = gridsize_geometric_mean(nzt)
-
-       IF ( ANY( gridsize_geometric_mean > 1.5_wp * dx * wall_adjustment_factor )  .OR.            &
-            ANY( gridsize_geometric_mean > 1.5_wp * dy * wall_adjustment_factor ) )  THEN
-            WRITE( message_string, * ) 'grid anisotropy exceeds threshold',                        &
-                                       ' &starting from height level k = ', k, '.'
-           CALL message( 'init_grid', 'PA0202', 0, 1, 0, 6, 0 )
-       ENDIF
-
-!
-!--    Initialize the grid size variable (delta) and the distance to the wall, if needed
-       DO  k = nzb, nzt+1
-          delta(k,:,:) = gridsize_geometric_mean(k)
-       ENDDO
-
-!
-!--    If Dai et al. (2020) closure is used, the distance to the wall (distance to nearest upward
-!--    facing surface) must be stored
-       IF ( les_dai )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb, nzt+1
-                   distance_to_wall(k,j,i) = zu(k) - zw(topo_top_ind(j,i,0))
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-
-       IF ( wall_adjustment )  THEN
-!
-!--       In case of topography, adjust mixing length if there is any wall at the surrounding grid
-!--       boxes:
-          !> @todo check if this is correct also for the ocean case
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-!
-!--                Check if current gridpoint belongs to the atmosphere
-                   IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )  THEN
-!
-!--                   First, check if grid points directly next to current grid point are surface
-!--                   grid points
-!--                   Check along...
-!--                   ...vertical direction, down
-                      IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i), 0 ) )  THEN
-                         distance_down =  zu(k) - zw(k-1)
-                      ELSE
-                         distance_down = 9999999.9_wp
-                      ENDIF
-!
-!--                   ...vertical direction, up
-                      IF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i), 0 ) )  THEN
-                         distance_up = zw(k) - zu(k)
-                      ELSE
-                         distance_up = 9999999.9_wp
-                      ENDIF
-!
-!--                   ...y-direction (north/south)
-                      IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 )  .OR.                     &
-                           .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) )  THEN
-                         distance_ns = 0.5_wp * dy
-                      ELSE
-                         distance_ns = 9999999.9_wp
-                      ENDIF
-!
-!--                   ...x-direction (left/right)
-                      IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 )  .OR.                     &
-                           .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) )  THEN
-                         distance_lr = 0.5_wp * dx
-                      ELSE
-                         distance_lr = 9999999.9_wp
-                      ENDIF
-!
-!--                   Now, check the edges along...
-!--                   ...yz-direction (vertical edges, down)
-                      IF ( .NOT. BTEST( wall_flags_total_0(k-1,j-1,i), 0 )  .OR.                   &
-                           .NOT. BTEST( wall_flags_total_0(k-1,j+1,i), 0 )  )  THEN
-                         distance_edge_yz_down = SQRT( 0.25_wp * dy**2 + ( zu(k) - zw(k-1) )**2 )
-                      ELSE
-                         distance_edge_yz_down = 9999999.9_wp
-                      ENDIF
-!
-!--                   ...yz-direction (vertical edges, up)
-                      IF ( .NOT. BTEST( wall_flags_total_0(k+1,j-1,i), 0 )  .OR.                   &
-                           .NOT. BTEST( wall_flags_total_0(k+1,j+1,i), 0 )  )  THEN
-                         distance_edge_yz_up = SQRT( 0.25_wp * dy**2 + ( zw(k) - zu(k) )**2 )
-                      ELSE
-                         distance_edge_yz_up = 9999999.9_wp
-                      ENDIF
-!
-!--                   ...xz-direction (vertical edges, down)
-                      IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i-1), 0 )  .OR.                   &
-                           .NOT. BTEST( wall_flags_total_0(k-1,j,i+1), 0 )  )  THEN
-                         distance_edge_xz_down = SQRT( 0.25_wp * dx**2 + ( zu(k) - zw(k-1) )**2 )
-                      ELSE
-                         distance_edge_xz_down = 9999999.9_wp
-                      ENDIF
-!
-!--                   ...xz-direction (vertical edges, up)
-                      IF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i-1), 0 )  .OR.                   &
-                           .NOT. BTEST( wall_flags_total_0(k+1,j,i+1), 0 )  )  THEN
-                         distance_edge_xz_up = SQRT( 0.25_wp * dx**2 + ( zw(k) - zu(k) )**2 )
-                      ELSE
-                         distance_edge_xz_up = 9999999.9_wp
-                      ENDIF
-!
-!--                   ...xy-direction (horizontal edges)
-                      IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i-1), 0 )  .OR.                   &
-                           .NOT. BTEST( wall_flags_total_0(k,j+1,i-1), 0 )  .OR.                   &
-                           .NOT. BTEST( wall_flags_total_0(k,j-1,i+1), 0 )  .OR.                   &
-                           .NOT. BTEST( wall_flags_total_0(k,j+1,i+1), 0 ) )  THEN
-                         distance_edge_xy = SQRT( 0.25_wp * ( dx**2 + dy**2 ) )
-                      ELSE
-                         distance_edge_xy = 9999999.9_wp
-                      ENDIF
-!
-!--                   Now, check the corners...
-!--                   ...lower four corners
-                      IF ( .NOT. BTEST( wall_flags_total_0(k-1,j-1,i-1), 0 )  .OR.                 &
-                           .NOT. BTEST( wall_flags_total_0(k-1,j+1,i-1), 0 )  .OR.                 &
-                           .NOT. BTEST( wall_flags_total_0(k-1,j-1,i+1), 0 )  .OR.                 &
-                           .NOT. BTEST( wall_flags_total_0(k-1,j+1,i+1), 0 ) )  THEN
-                         distance_corners_down = SQRT( 0.25_wp * ( dx**2 + dy**2 )                 &
-                                                       + ( zu(k) - zw(k-1) )**2 )
-                      ELSE
-                         distance_corners_down = 9999999.9_wp
-                      ENDIF
-!
-!--                   ...upper four corners
-                      IF ( .NOT. BTEST( wall_flags_total_0(k+1,j-1,i-1), 0 )  .OR.                 &
-                           .NOT. BTEST( wall_flags_total_0(k+1,j+1,i-1), 0 )  .OR.                 &
-                           .NOT. BTEST( wall_flags_total_0(k+1,j-1,i+1), 0 )  .OR.                 &
-                           .NOT. BTEST( wall_flags_total_0(k+1,j+1,i+1), 0 ) )  THEN
-                         distance_corners_up = SQRT( 0.25_wp * ( dx**2 + dy**2 )                   &
-                                                     + ( zw(k) - zu(k) )**2 )
-                      ELSE
-                         distance_corners_up = 9999999.9_wp
-                      ENDIF
-
-!
-!--                   Calculate the minimum distance from the wall and store it temporarily in the
-!--                   array delta
-                      delta(k,j,i) = MIN( distance_up, distance_down, distance_ns, distance_lr,    &
-                                          distance_edge_yz_down, distance_edge_yz_up,              &
-                                          distance_edge_xz_down, distance_edge_xz_up,              &
-                                          distance_edge_xy, distance_corners_down,                 &
-                                          distance_corners_up )
-
-!
-!--                   If Dai et al. (2020) closure is used, the distance to the wall must be
-!--                   permanently stored
-                      IF ( les_dai  .AND.  delta(k,j,i) /= 9999999.9_wp )  THEN
-                         distance_to_wall(k,j,i) = delta(k,j,i)
-                      ENDIF
-
-!
-!--                   Close to the surface, the maximum mixing length is limited to 1.8 z
-                      delta(k,j,i) = wall_adjustment_factor * delta(k,j,i)
-
-                  ENDIF  ! If grid point belongs to atmosphere
-
-
-
-!
-!--               The grid size (delta) is defined as the the minimum of the distance to the nearest
-!--               wall * 1.8 and the geometric mean grid size.
-                  delta(k,j,i) = MIN( delta(k,j,i), gridsize_geometric_mean(k) )
-
-
-                ENDDO  !k loop
-             ENDDO  !j loop
-          ENDDO  !i loop
-
-       ENDIF  !if wall_adjustment
-
-    ELSE  !--> RANS mode
-!
-!--    Initialize the mixing length in case of a RANS simulation
-       ALLOCATE( ml_blackadar(nzb:nzt+1) )
-
-!
-!--    Calculate mixing length according to Blackadar (1962)
-       IF ( f /= 0.0_wp )  THEN
-          length_scale_max = 2.7E-4_wp * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) / ABS( f ) + 1.0E-10_wp
-       ELSE
-          length_scale_max = 30.0_wp
-       ENDIF
-
-       DO  k = nzb, nzt
-          ml_blackadar(k) = kappa * zu(k) / ( 1.0_wp + kappa * zu(k) / length_scale_max )
-       ENDDO
-
-       ml_blackadar(nzt+1) = ml_blackadar(nzt)
-
-!
-!--    Get height level of highest topography within local subdomain
-       k_max_topo = 0
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-             DO  k = nzb+1, nzt-1
-                IF ( .NOT. BTEST( wall_flags_total_0(k,j,i), 0 )  .AND.  k > k_max_topo )          &
-                   k_max_topo = k
-             ENDDO
-          ENDDO
-       ENDDO
-
-       delta(nzb,:,:) = ml_blackadar(nzb)
-       delta(nzt+1,:,:) = ml_blackadar(nzt+1)
-!
-!--    Limit mixing length to either nearest wall or Blackadar mixing length. For that, analyze each
-!--    grid point (i/j/k) ("analysed grid point") and search within its vicinity for the shortest
-!--    distance to a wall by calculating the distance between the analysed grid point and the
-!--    "viewed grid point" if it contains a wall (belongs to topography).
-       DO  k = nzb+1, nzt
-
-          radius = ml_blackadar(k)  ! radius within walls are searched
-!
-!--       Set delta to its default maximum value (ml_blackadar)
-          delta(k,:,:) = radius
-
-!
-!--       Compute search radius as number of grid points in all directions
-          rad_i = CEILING( radius / dx )
-          rad_j = CEILING( radius / dy )
-
-          DO  kk = 0, nzt-k
-             rad_k_t = kk
-!
-!--          Limit upward search radius to height of maximum topography
-             IF ( zu(k+kk)-zu(k) >= radius .OR. k+kk >= k_max_topo )  EXIT
-          ENDDO
-
-          DO  kk = 0, k
-             rad_k_b = kk
-             IF ( zu(k)-zu(k-kk) >= radius )  EXIT
-          ENDDO
-
-!
-!--       Get maximum vertical radius; necessary for defining arrays
-          rad_k = MAX( rad_k_b, rad_k_t )
-!
-!--       When analysed grid point lies above maximum topography, set search radius to 0 if the
-!--       distance between the analysed grid point and max topography height is larger than the
-!--       maximum search radius
-          IF ( zu(k-rad_k_b) > zu(k_max_topo) )  rad_k_b = 0
-!
-!--       Search within vicinity only if the vertical search radius is >0
-          IF ( rad_k_b /= 0 .OR. rad_k_t /= 0 )  THEN
-
-             !> @note shape of vicinity is larger in z direction
-             !>   Shape of vicinity is two grid points larger than actual search radius in vertical
-             !>   direction. The first and last grid point is always set to 1 to asure correct
-             !>   detection of topography. See function "shortest_distance" for details.
-             !>   2018-03-16, gronemeier
-             ALLOCATE( vicinity(-rad_k-1:rad_k+1,-rad_j:rad_j,-rad_i:rad_i) )
-             ALLOCATE( vic_yz(0:rad_k+1,0:rad_j) )
-
-             vicinity = 1
-
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-!
-!--                Start search only if (i/j/k) belongs to atmosphere
-                   IF ( BTEST( wall_flags_total_0(k,j,i), 0 )  )  THEN
-!
-!--                   Reset topography within vicinity
-                      vicinity(-rad_k:rad_k,:,:) = 0
-!
-!--                   Copy area surrounding analysed grid point into vicinity. First, limit size of
-!--                   data copied to vicinity by the domain border
-                      !> @note limit copied area to 1 grid point in hor. dir.
-                      !>   Ignore walls in horizontal direction which are further away than a single
-                      !>   grid point. This allows to only search within local subdomain without the
-                      !>   need of global topography information. The error made by this assumption
-                      !>   are acceptable at the moment.
-                      !>   2018-10-01, gronemeier
-                      rad_i_l = MIN( 1, rad_i, i )
-                      rad_i_r = MIN( 1, rad_i, nx-i )
-
-                      rad_j_s = MIN( 1, rad_j, j )
-                      rad_j_n = MIN( 1, rad_j, ny-j )
-
-                      CALL copy_into_vicinity( k, j, i, -rad_k_b, rad_k_t, -rad_j_s, rad_j_n,      &
-                                               -rad_i_l, rad_i_r  )
-                      !> @note in case of cyclic boundaries, those parts of the topography which
-                      !> lies beyond the domain borders but still within the search radius still
-                      !> needs to be copied into 'vicinity'. As the effective search radius is
-                      !> limited to 1 at the moment, no further copying is needed. Old
-                      !> implementation (prior to 2018-10-01) had this covered but used a global
-                      !> array.
-                      !> 2018-10-01, gronemeier
-
-!
-!--                   Search for walls only if there is any within vicinity
-                      IF ( MAXVAL( vicinity(-rad_k:rad_k,:,:) ) /= 0 )  THEN
-!
-!--                      Search within first half (positive x)
-                         dist_dx = rad_i
-                         DO  ii = 0, dist_dx
-!
-!--                         Search along vertical direction only if below maximum topography
-                            IF ( rad_k_t > 0 )  THEN
-!
-!--                            Search for walls within octant (+++)
-                               vic_yz = vicinity(0:rad_k+1,0:rad_j,ii)
-                               delta(k,j,i) = MIN( delta(k,j,i),                                   &
-                                                   shortest_distance( vic_yz, .TRUE., ii ) )
-!
-!--                            Search for walls within octant (+-+)
-!--                            Switch order of array so that the analysed grid point is always
-!--                            located at (0/0) (required by shortest_distance").
-                               vic_yz = vicinity(0:rad_k+1,0:-rad_j:-1,ii)
-                               delta(k,j,i) = MIN( delta(k,j,i),                                   &
-                                                   shortest_distance( vic_yz, .TRUE., ii ) )
-
-                            ENDIF
-!
-!--                         Search for walls within octant (+--)
-                            vic_yz = vicinity(0:-rad_k-1:-1,0:-rad_j:-1,ii)
-                            delta(k,j,i) = MIN( delta(k,j,i),                                      &
-                                                shortest_distance( vic_yz, .FALSE., ii ) )
-!
-!--                         Search for walls within octant (++-)
-                            vic_yz = vicinity(0:-rad_k-1:-1,0:rad_j,ii)
-                            delta(k,j,i) = MIN( delta(k,j,i),                                      &
-                                                shortest_distance( vic_yz, .FALSE., ii ) )
-!
-!--                         Reduce search along x by already found distance
-                            dist_dx = CEILING( delta(k,j,i) / dx )
-
-                         ENDDO
-!
-!-                       Search within second half (negative x)
-                         DO  ii = 0, -dist_dx, -1
-!
-!--                         Search along vertical direction only if below maximum topography
-                            IF ( rad_k_t > 0 )  THEN
-!
-!--                            Search for walls within octant (-++)
-                               vic_yz = vicinity(0:rad_k+1,0:rad_j,ii)
-                               delta(k,j,i) = MIN( delta(k,j,i),                                   &
-                                                   shortest_distance( vic_yz, .TRUE., -ii ) )
-!
-!--                            Search for walls within octant (--+)
-!--                            Switch order of array so that the analysed grid point is always
-!--                            located at (0/0) (required by shortest_distance").
-                               vic_yz = vicinity(0:rad_k+1,0:-rad_j:-1,ii)
-                               delta(k,j,i) = MIN( delta(k,j,i),                                   &
-                                                   shortest_distance( vic_yz, .TRUE., -ii ) )
-
-                            ENDIF
-!
-!--                         Search for walls within octant (---)
-                            vic_yz = vicinity(0:-rad_k-1:-1,0:-rad_j:-1,ii)
-                            delta(k,j,i) = MIN( delta(k,j,i),                                      &
-                                                shortest_distance( vic_yz, .FALSE., -ii ) )
-!
-!--                         Search for walls within octant (-+-)
-                            vic_yz = vicinity(0:-rad_k-1:-1,0:rad_j,ii)
-                            delta(k,j,i) = MIN( delta(k,j,i),                                      &
-                                                shortest_distance( vic_yz, .FALSE., -ii ) )
-!
-!--                         Reduce search along x by already found distance
-                            dist_dx = CEILING( delta(k,j,i) / dx )
-
-                         ENDDO
-
-                      ENDIF  !Check for any walls within vicinity
-
-                   ELSE  !Check if (i,j,k) belongs to atmosphere
-
-                      delta(k,j,i) = ml_blackadar(k)
-
-                   ENDIF
-
-                ENDDO  !j loop
-             ENDDO  !i loop
-
-             DEALLOCATE( vicinity )
-             DEALLOCATE( vic_yz )
-
-          ENDIF  !Check vertical size of vicinity
-
-       ENDDO  !k loop
-
-       !$ACC ENTER DATA COPYIN(ml_blackadar(nzb:nzt+1))
-
-    ENDIF  !LES or RANS mode
-
-!
-!-- Set lateral boundary conditions for delta
-    CALL exchange_horiz( delta, nbgp )
-    !$ACC ENTER DATA COPYIN(delta(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
-
-     IF ( les_dai )  THEN
-        CALL exchange_horiz( distance_to_wall, nbgp )
-        !$ACC ENTER DATA COPYIN(distance_to_wall(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
-
-!
-!--     Copy distance_to_wall to ghostpoints at inflow and outflow in case of
-!--     non-cyclic boundary conditions at inflow and outflow. This can not be done inside
-!--     exchange_horiz() because it is not compatible with prescribing mean inflow profiles.
-        IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
-           DO  i = nbgp, 1, -1
-             distance_to_wall(:,:,nxl-i) = distance_to_wall(:,:,nxl)
-           ENDDO
-        ENDIF
-        IF ( bc_dirichlet_r  .OR.  bc_radiation_r  )  THEN
-           DO  i = 1, nbgp
-              distance_to_wall(:,:,nxr+i) = distance_to_wall(:,:,nxr)
-           ENDDO
-        ENDIF
-        IF ( bc_dirichlet_s  .OR.  bc_radiation_s  )  THEN
-           DO  i = nbgp, 1, -1
-             distance_to_wall(:,nys-i,:) = distance_to_wall(:,nys,:)
-           ENDDO
-        ENDIF
-        IF ( bc_dirichlet_n  .OR.  bc_radiation_n  )  THEN
-           DO  i = 1, nbgp
-             distance_to_wall(:,nyn+i,:) = distance_to_wall(:,nyn,:)
-           ENDDO
-        ENDIF
-     ENDIF
-
-
-
-    CONTAINS
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the shortest distance between position (i/j/k)=(0/0/0) and (pos_i/jj/kk), where (jj/kk)
-!> is the position of the maximum of 'array' closest to the origin (0/0) of 'array'.
-!--------------------------------------------------------------------------------------------------!
-    REAL(wp) FUNCTION shortest_distance( array, orientation, pos_i )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp), INTENT(IN) ::  pos_i  !< x position of the yz-plane 'array'
-
-       INTEGER(iwp) ::  a   !< loop index
-       INTEGER(iwp) ::  b   !< loop index
-       INTEGER(iwp) ::  jj  !< loop index
-
-       INTEGER(KIND=1) ::  maximum  !< maximum of array along z dimension
-
-       INTEGER(iwp), DIMENSION(0:rad_j) ::  loc_k  !< location of closest wall along vertical dimension
-
-       INTEGER(KIND=1), DIMENSION(0:rad_k+1,0:rad_j), INTENT(IN) ::  array  !< array containing a yz-plane at position pos_i
-
-       LOGICAL, INTENT(IN) ::  orientation  !< flag if array represents an array oriented upwards (true) or downwards (false)
-
-!
-!--    Get coordinate of first maximum along vertical dimension at each y position of array
-!--    (similar to function maxloc but more stable).
-       DO  a = 0, rad_j
-          loc_k(a) = rad_k+1
-          maximum = MAXVAL( array(:,a) )
-          DO  b = 0, rad_k+1
-             IF ( array(b,a) == maximum )  THEN
-                loc_k(a) = b
-                EXIT
-             ENDIF
-          ENDDO
-       ENDDO
-!
-!--    Set distance to the default maximum value (=search radius)
-       shortest_distance = radius
-!
-!--    Calculate distance between position (0/0/0) and position (pos_i/jj/loc(jj)) and only save the
-!--    shortest distance.
-       IF ( orientation )  THEN  !if array is oriented upwards
-          DO  jj = 0, rad_j
-             shortest_distance =                                                                   &
-               MIN( shortest_distance,                                                             &
-                    SQRT( MAX( REAL( pos_i, KIND = wp ) * dx - 0.5_wp * dx, 0.0_wp)**2             &
-                        + MAX( REAL( jj, KIND = wp ) * dy - 0.5_wp * dy, 0.0_wp)**2                &
-                        + MAX( zw(loc_k(jj)+k-1) - zu(k), 0.0_wp)**2                               &
-                        )                                                                          &
-                  )
-          ENDDO
-       ELSE  !if array is oriented downwards
-          !> @note MAX within zw required to circumvent error at domain border
-          !>   At the domain border, if non-cyclic boundary is present, the index for zw could be
-          !>   -1, which will be errorneous (zw(-1) does not exist). The MAX function limits the
-          !>   index to be at least 0.
-          DO  jj = 0, rad_j
-             shortest_distance =                                                                   &
-                MIN( shortest_distance,                                                            &
-                     SQRT( MAX(REAL(pos_i, KIND=wp)*dx-0.5_wp*dx, 0.0_wp)**2                       &
-                         + MAX(REAL(jj, KIND=wp)*dy-0.5_wp*dy, 0.0_wp)**2                          &
-                         + MAX(zu(k)-zw(MAX(k-loc_k(jj),0_iwp)), 0.0_wp)**2                        &
-                         )                                                                         &
-                   )
-          ENDDO
-       ENDIF
-
-    END FUNCTION
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Copy a subarray of size (kb:kt,js:jn,il:ir) centered around grid point (kp,jp,ip) containing the
-!> first bit of wall_flags_total_0 into the array 'vicinity'. Only copy first bit as this indicates
-!> the presence of topography.
-!--------------------------------------------------------------------------------------------------!
-    SUBROUTINE copy_into_vicinity( kp, jp, ip, kb, kt, js, jn, il, ir )
-
-       IMPLICIT NONE
-
-       INTEGER(iwp), INTENT(IN) ::  il  !< left loop boundary
-       INTEGER(iwp), INTENT(IN) ::  ip  !< center position in x-direction
-       INTEGER(iwp), INTENT(IN) ::  ir  !< right loop boundary
-       INTEGER(iwp), INTENT(IN) ::  jn  !< northern loop boundary
-       INTEGER(iwp), INTENT(IN) ::  jp  !< center position in y-direction
-       INTEGER(iwp), INTENT(IN) ::  js  !< southern loop boundary
-       INTEGER(iwp), INTENT(IN) ::  kb  !< bottom loop boundary
-       INTEGER(iwp), INTENT(IN) ::  kp  !< center position in z-direction
-       INTEGER(iwp), INTENT(IN) ::  kt  !< top loop boundary
-
-       INTEGER(iwp) ::  i  !< loop index
-       INTEGER(iwp) ::  j  !< loop index
-       INTEGER(iwp) ::  k  !< loop index
-
-       DO  i = il, ir
-          DO  j = js, jn
-             DO  k = kb, kt
-                vicinity(k,j,i) = MERGE( 0, 1, BTEST( wall_flags_total_0(kp+k,jp+j,ip+i), 0 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE copy_into_vicinity
-
- END SUBROUTINE tcm_init_mixing_length
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize virtual velocities used later in production_e.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE production_e_init
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  drho_air_zw,                                                                        &
-               zu
-
-    USE control_parameters,                                                                        &
-        ONLY:  constant_flux_layer
-
-    USE surface_layer_fluxes_mod,                                                                  &
-        ONLY:  phi_m
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< grid index x-direction
-    INTEGER(iwp) ::  j  !< grid index y-direction
-    INTEGER(iwp) ::  k  !< grid index z-direction
-    INTEGER(iwp) ::  m  !< running index surface elements
-
-    REAL(wp) ::  km_sfc  !< diffusion coefficient, used to compute virtual velocities
-
-    IF ( constant_flux_layer )  THEN
-!
-!--    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).
-!--    Not available in case of non-cyclic boundary conditions.
-!--    Default surfaces, upward-facing
-       !$OMP PARALLEL DO PRIVATE(i, j, k, m, km_sfc)
-       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) &
-       !$ACC PRESENT(surf_def_h(0), u, v, drho_air_zw, zu)
-       DO  m = 1, surf_def_h(0)%ns
-
-          i = surf_def_h(0)%i(m)
-          j = surf_def_h(0)%j(m)
-          k = surf_def_h(0)%k(m)
-!
-!--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v and km are not on the same
-!--       grid. Actually, a further interpolation of km onto the u/v-grid is necessary. However, the
-!--       effect of this error is negligible.
-          km_sfc = kappa * surf_def_h(0)%us(m) * surf_def_h(0)%z_mo(m) /                           &
-                   phi_m( surf_def_h(0)%z_mo(m) / surf_def_h(0)%ol(m) )
-
-          surf_def_h(0)%u_0(m) = u(k+1,j,i) + surf_def_h(0)%usws(m) * drho_air_zw(k-1) *           &
-                                 ( zu(k+1) - zu(k-1) ) / ( km_sfc  + 1.0E-20_wp )
-          surf_def_h(0)%v_0(m) = v(k+1,j,i) + surf_def_h(0)%vsws(m) * drho_air_zw(k-1) *           &
-                                 ( zu(k+1) - zu(k-1) ) / ( km_sfc  + 1.0E-20_wp )
-
-          IF ( ABS( u(k+1,j,i) - surf_def_h(0)%u_0(m) ) > ABS( u(k+1,j,i) - u(k-1,j,i) ) )         &
-             surf_def_h(0)%u_0(m) = u(k-1,j,i)
-
-          IF ( ABS( v(k+1,j,i) - surf_def_h(0)%v_0(m) ) > ABS( v(k+1,j,i) - v(k-1,j,i) ) )         &
-             surf_def_h(0)%v_0(m) = v(k-1,j,i)
-
-       ENDDO
-!
-!--    Default surfaces, downward-facing surfaces
-       !$OMP PARALLEL DO PRIVATE(i, j, k, m)
-       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m) &
-       !$ACC PRESENT(surf_def_h(1), u, v, drho_air_zw, zu, km)
-       DO  m = 1, surf_def_h(1)%ns
-
-          i = surf_def_h(1)%i(m)
-          j = surf_def_h(1)%j(m)
-          k = surf_def_h(1)%k(m)
-!
-!--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v and km are not on the same
-!--       grid. Actually, a further interpolation of km onto the u/v-grid is necessary. However, the
-!--       effect of this error is negligible.
-          surf_def_h(1)%u_0(m) = u(k-1,j,i) - surf_def_h(1)%usws(m) * drho_air_zw(k-1) *           &
-                                     ( zu(k+1) - zu(k-1) ) / ( km(k,j,i) + 1.0E-20_wp )
-          surf_def_h(1)%v_0(m) = v(k-1,j,i) - surf_def_h(1)%vsws(m) * drho_air_zw(k-1) *           &
-                                     ( zu(k+1) - zu(k-1) ) / (km(k,j,i) + 1.0E-20_wp )
-
-          IF ( ABS( surf_def_h(1)%u_0(m) - u(k-1,j,i) ) > ABS( u(k+1,j,i) - u(k-1,j,i) ) )         &
-             surf_def_h(1)%u_0(m) = u(k+1,j,i)
-
-          IF ( ABS( surf_def_h(1)%v_0(m) - v(k-1,j,i) ) > ABS( v(k+1,j,i) - v(k-1,j,i) ) )         &
-             surf_def_h(1)%v_0(m) = v(k+1,j,i)
-
-       ENDDO
-!
-!--    Natural surfaces, upward- and downward facing
-       !$OMP PARALLEL DO PRIVATE(i, j, k, m, km_sfc)
-       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) &
-       !$ACC PRESENT(surf_lsm_h(0), u, v, drho_air_zw, zu)
-       DO  m = 1, surf_lsm_h(0)%ns
-
-          i = surf_lsm_h(0)%i(m)
-          j = surf_lsm_h(0)%j(m)
-          k = surf_lsm_h(0)%k(m)
-!
-!--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v and km are not on the same
-!--       grid. Actually, a further interpolation of km onto the u/v-grid is necessary. However, the
-!--       effect of this error is negligible.
-          km_sfc = kappa * surf_lsm_h(0)%us(m) * surf_lsm_h(0)%z_mo(m) /                                 &
-                   phi_m( surf_lsm_h(0)%z_mo(m) / surf_lsm_h(0)%ol(m) )
-
-          surf_lsm_h(0)%u_0(m) = u(k+1,j,i) + surf_lsm_h(0)%usws(m) * drho_air_zw(k-1) *                 &
-                              ( zu(k+1) - zu(k-1) ) / ( km_sfc  + 1.0E-20_wp )
-          surf_lsm_h(0)%v_0(m) = v(k+1,j,i) + surf_lsm_h(0)%vsws(m) * drho_air_zw(k-1) *                 &
-                                        ( zu(k+1) - zu(k-1)) / ( km_sfc  + 1.0E-20_wp )
-
-          IF ( ABS( u(k+1,j,i) - surf_lsm_h(0)%u_0(m) ) > ABS( u(k+1,j,i) - u(k-1,j,i) ) )            &
-             surf_lsm_h(0)%u_0(m) = u(k-1,j,i)
-
-          IF ( ABS( v(k+1,j,i) - surf_lsm_h(0)%v_0(m) ) > ABS( v(k+1,j,i) - v(k-1,j,i) ) )            &
-             surf_lsm_h(0)%v_0(m) = v(k-1,j,i)
-
-       ENDDO
-!
-!--    Natural surfaces, downward-facing surfaces
-       !$OMP PARALLEL DO PRIVATE(i, j, k, m)
-       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m) &
-       !$ACC PRESENT(surf_lsm_h(1), u, v, drho_air_zw, zu, km)
-       DO  m = 1, surf_lsm_h(1)%ns
-
-          i = surf_lsm_h(1)%i(m)
-          j = surf_lsm_h(1)%j(m)
-          k = surf_lsm_h(1)%k(m)
-!
-!--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v and km are not on the same
-!--       grid. Actually, a further interpolation of km onto the u/v-grid is necessary. However, the
-!--       effect of this error is negligible.
-          surf_lsm_h(1)%u_0(m) = u(k-1,j,i) - surf_lsm_h(1)%usws(m) * drho_air_zw(k-1) *           &
-                                     ( zu(k+1) - zu(k-1) ) / ( km(k,j,i) + 1.0E-20_wp )
-          surf_lsm_h(1)%v_0(m) = v(k-1,j,i) - surf_lsm_h(1)%vsws(m) * drho_air_zw(k-1) *           &
-                                     ( zu(k+1) - zu(k-1) ) / (km(k,j,i) + 1.0E-20_wp )
-
-          IF ( ABS( surf_lsm_h(1)%u_0(m) - u(k-1,j,i) ) > ABS( u(k+1,j,i) - u(k-1,j,i) ) )         &
-             surf_lsm_h(1)%u_0(m) = u(k+1,j,i)
-
-          IF ( ABS( surf_lsm_h(1)%v_0(m) - v(k-1,j,i) ) > ABS( v(k+1,j,i) - v(k-1,j,i) ) )         &
-             surf_lsm_h(1)%v_0(m) = v(k+1,j,i)
-
-       ENDDO
-!
-!--    Urban surfaces, upward-facing
-       !$OMP PARALLEL DO PRIVATE(i, j, k, m, km_sfc)
-       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) &
-       !$ACC PRESENT(surf_usm_h(0), u, v, drho_air_zw, zu)
-       DO  m = 1, surf_usm_h(0)%ns
-
-          i = surf_usm_h(0)%i(m)
-          j = surf_usm_h(0)%j(m)
-          k = surf_usm_h(0)%k(m)
-!
-!--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v and km are not on the same
-!--       grid. Actually, a further interpolation of km onto the u/v-grid is necessary. However, the
-!--       effect of this error is negligible.
-          km_sfc = kappa * surf_usm_h(0)%us(m) * surf_usm_h(0)%z_mo(m) /                                 &
-                   phi_m( surf_usm_h(0)%z_mo(m) / surf_usm_h(0)%ol(m) )
-
-          surf_usm_h(0)%u_0(m) = u(k+1,j,i) + surf_usm_h(0)%usws(m) * drho_air_zw(k-1) *                 &
-                                        ( zu(k+1) - zu(k-1) ) / ( km_sfc  + 1.0E-20_wp )
-          surf_usm_h(0)%v_0(m) = v(k+1,j,i) + surf_usm_h(0)%vsws(m) * drho_air_zw(k-1) *                 &
-                                        ( zu(k+1) - zu(k-1) ) / ( km_sfc  + 1.0E-20_wp )
-
-          IF ( ABS( u(k+1,j,i) - surf_usm_h(0)%u_0(m) ) > ABS( u(k+1,j,i) - u(k-1,j,i) ) )            &
-             surf_usm_h(0)%u_0(m) = u(k-1,j,i)
-
-          IF ( ABS( v(k+1,j,i) - surf_usm_h(0)%v_0(m) ) > ABS( v(k+1,j,i) - v(k-1,j,i) ) )            &
-             surf_usm_h(0)%v_0(m) = v(k-1,j,i)
-
-       ENDDO
-!
-!--    Urban surfaces, downward-facing surfaces
-       !$OMP PARALLEL DO PRIVATE(i, j, k, m)
-       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m) &
-       !$ACC PRESENT(surf_usm_h(1), u, v, drho_air_zw, zu, km)
-       DO  m = 1, surf_usm_h(1)%ns
-
-          i = surf_usm_h(1)%i(m)
-          j = surf_usm_h(1)%j(m)
-          k = surf_usm_h(1)%k(m)
-!
-!--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v and km are not on the same
-!--       grid. Actually, a further interpolation of km onto the u/v-grid is necessary. However, the
-!--       effect of this error is negligible.
-          surf_usm_h(1)%u_0(m) = u(k-1,j,i) - surf_usm_h(1)%usws(m) * drho_air_zw(k-1) *           &
-                                     ( zu(k+1) - zu(k-1) ) / ( km(k,j,i) + 1.0E-20_wp )
-          surf_usm_h(1)%v_0(m) = v(k-1,j,i) - surf_usm_h(1)%vsws(m) * drho_air_zw(k-1) *           &
-                                     ( zu(k+1) - zu(k-1) ) / (km(k,j,i) + 1.0E-20_wp )
-
-          IF ( ABS( surf_usm_h(1)%u_0(m) - u(k-1,j,i) ) > ABS( u(k+1,j,i) - u(k-1,j,i) ) )         &
-             surf_usm_h(1)%u_0(m) = u(k+1,j,i)
-
-          IF ( ABS( surf_usm_h(1)%v_0(m) - v(k-1,j,i) ) > ABS( v(k+1,j,i) - v(k-1,j,i) ) )         &
-             surf_usm_h(1)%v_0(m) = v(k+1,j,i)
-
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE production_e_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Execute module-specific actions for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_actions( location )
-
-
-    CHARACTER(LEN=*) ::  location !<
-
-!    INTEGER(iwp) ::  i !<
-!    INTEGER(iwp) ::  j !<
-!    INTEGER(iwp) ::  k !<
-
-!
-!-- Here the module-specific 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' )
-
-
-       CASE ( 'before_prognostic_equations' )
-
-          IF ( .NOT. constant_diffusion )  CALL production_e_init
-
-
-       CASE ( 'after_integration' )
-
-
-       CASE ( 'after_timestep' )
-
-
-       CASE ( 'u-tendency' )
-
-
-       CASE ( 'v-tendency' )
-
-
-       CASE ( 'w-tendency' )
-
-
-       CASE ( 'pt-tendency' )
-
-
-       CASE ( 'sa-tendency' )
-
-
-       CASE ( 'e-tendency' )
-
-
-       CASE ( 'q-tendency' )
-
-
-       CASE ( 's-tendency' )
-
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE tcm_actions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Execute module-specific actions for grid point i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_actions_ij( i, j, location )
-
-
-    CHARACTER(LEN=*) ::  location  !<
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-
-!
-!-- Here the module-specific actions follow
-    SELECT CASE ( location )
-
-       CASE ( 'u-tendency' )
-
-!--       Next line is to avoid compiler warning about unused variables. Please remove.
-          IF ( i +  j < 0 )  CONTINUE
-
-       CASE ( 'v-tendency' )
-
-
-       CASE ( 'w-tendency' )
-
-
-       CASE ( 'pt-tendency' )
-
-
-       CASE ( 'sa-tendency' )
-
-
-       CASE ( 'e-tendency' )
-
-
-       CASE ( 'q-tendency' )
-
-
-       CASE ( 's-tendency' )
-
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE tcm_actions_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prognostic equation for subgrid-scale TKE and TKE dissipation rate. Vector-optimized version
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_prognostic_equations
-
-    USE control_parameters,                                                                        &
-        ONLY:  scalar_advec,                                                                       &
-               tsc
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< loop index
-    INTEGER(iwp) ::  j  !< loop index
-    INTEGER(iwp) ::  k  !< loop index
-
-    REAL(wp)     ::  sbt  !< wheighting factor for sub-time step
-
-!
-!-- If required, compute prognostic equation for turbulent kinetic energy (TKE)
-    IF ( .NOT. constant_diffusion )  THEN
-
-       CALL cpu_log( log_point_s(67), '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
-             !$ACC KERNELS PRESENT(tend)
-             tend = 0.0_wp
-             !$ACC END KERNELS
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( advc_flags_s, e, 'e', bc_dirichlet_l  .OR.  bc_radiation_l,    &
-                                                          bc_dirichlet_n  .OR.  bc_radiation_n,    &
-                                                          bc_dirichlet_r  .OR.  bc_radiation_r,    &
-                                                          bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( e )
-                ENDIF
-             ELSE
-                CALL advec_s_up( e )
-             ENDIF
-          ENDIF
-       ENDIF
-
-       CALL production_e( .FALSE. )
-
-       IF ( .NOT. humidity )  THEN
-          IF ( ocean_mode )  THEN
-             CALL diffusion_e( prho, prho_reference )
-          ELSE
-             CALL diffusion_e( pt, pt_reference )
-          ENDIF
-       ELSE
-          CALL diffusion_e( vpt, pt_reference )
-       ENDIF
-
-!
-!--    Additional sink term for flows through plant canopies
-       IF ( plant_canopy )  CALL pcm_tendency( 6 )
-
-       !> @todo find general solution for circular dependency between modules
-       ! 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 PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-       !$ACC PRESENT(e, tend, te_m, wall_flags_total_0) &
-       !$ACC PRESENT(tsc(3:3)) &
-       !$ACC PRESENT(e_p)
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             !Following directive is required to vectorize on Intel19
-             !DIR$ IVDEP
-             DO  k = nzb+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) ) )   &
-                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                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
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-             !$ACC PRESENT(tend, te_m)
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      te_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-             !$ACC PRESENT(tend, te_m)
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb+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_s(67), 'tke-equation', 'stop' )
-
-    ENDIF   ! TKE equation
-
-!
-!-- If required, compute prognostic equation for TKE dissipation rate
-    IF ( rans_tke_e )  THEN
-
-       CALL cpu_log( log_point_s(64), 'diss-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( diss, 'diss' )
-
-          ENDIF
-       ENDIF
-
-!
-!--    Dissipation-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( diss )
-          ELSE
-             tend = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( advc_flags_s, diss, 'diss',                                    &
-                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
-                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
-                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
-                                    bc_dirichlet_s  .OR.  bc_radiation_s )
-                ELSE
-                   CALL advec_s_pw( diss )
-                ENDIF
-             ELSE
-                CALL advec_s_up( diss )
-             ENDIF
-          ENDIF
-       ENDIF
-!
-!--    Production of TKE dissipation rate
-       CALL production_e( .TRUE. )
-!
-!--    Diffusion term of TKE dissipation rate
-       CALL diffusion_diss
-!
-!--    Additional sink term for flows through plant canopies
-       ! IF ( plant_canopy )  CALL pcm_tendency( ? )     !> @todo not yet implemented
-
-       ! CALL user_actions( 'e-tendency' ) !> @todo find general solution for circular dependency between modules
-
-!
-!--    Prognostic equation for TKE dissipation.
-!--    Eliminate negative dissipation values, which can occur due to numerical reasons in the course
-!--    of the integration. In such cases the old dissipation value is reduced by 90%.
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                diss_p(k,j,i) = diss(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + tsc(3)               &
-                                                          * tdiss_m(k,j,i) ) )                     &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                IF ( diss_p(k,j,i) < 0.0_wp )  diss_p(k,j,i) = 0.1_wp * diss(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+1, nzt
-                      tdiss_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+1, nzt
-                      tdiss_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tdiss_m(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-
-       CALL cpu_log( log_point_s(64), 'diss-equation', 'stop' )
-
-    ENDIF
-
- END SUBROUTINE tcm_prognostic_equations
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Prognostic equation for subgrid-scale TKE and TKE dissipation rate. Cache-optimized version
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_prognostic_equations_ij( i, j, i_omp, tn )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  diss_l_diss,                                                                        &
-               diss_l_e,                                                                           &
-               diss_s_diss,                                                                        &
-               diss_s_e,                                                                           &
-               flux_l_diss,                                                                        &
-               flux_l_e,                                                                           &
-               flux_s_diss,                                                                        &
-               flux_s_e
-
-    USE control_parameters,                                                                        &
-        ONLY:  tsc
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i      !< loop index x direction
-    INTEGER(iwp) ::  i_omp  !< first loop index of i-loop in prognostic_equations
-    INTEGER(iwp) ::  j      !< loop index y direction
-    INTEGER(iwp) ::  k      !< loop index z direction
-    INTEGER(iwp) ::  tn     !< task number of openmp task
-
-!
-!-- 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( advc_flags_s, i, j, e, 'e', flux_s_e, diss_s_e, flux_l_e,          &
-                                diss_l_e , i_omp, tn,                                              &
-                                bc_dirichlet_l  .OR.  bc_radiation_l,                              &
-                                bc_dirichlet_n  .OR.  bc_radiation_n,                              &
-                                bc_dirichlet_r  .OR.  bc_radiation_r,                              &
-                                bc_dirichlet_s  .OR.  bc_radiation_s )
-           ELSE
-               CALL advec_s_pw( i, j, e )
-           ENDIF
-       ELSE
-          CALL advec_s_up( i, j, e )
-       ENDIF
-
-       CALL production_e_ij( i, j, .FALSE. )
-
-       IF ( .NOT. humidity )  THEN
-          IF ( ocean_mode )  THEN
-             CALL diffusion_e_ij( i, j, prho, prho_reference )
-          ELSE
-             CALL diffusion_e_ij( i, j, pt, pt_reference )
-          ENDIF
-       ELSE
-          CALL diffusion_e_ij( i, j, vpt, pt_reference )
-       ENDIF
-
-!
-!--    Additional sink term for flows through plant canopies
-       IF ( plant_canopy )  CALL pcm_tendency( i, j, 6 )
-
-       ! CALL user_actions( i, j, 'e-tendency' ) !> @todo: find general solution for circular dependency between modules
-
-!
-!--    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+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) ) )      &
-                       * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-          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+1, nzt
-                te_m(k,j,i) = tend(k,j,i)
-             ENDDO
-          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-             DO  k = nzb+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
-
-!
-!-- If required, compute prognostic equation for TKE dissipation rate
-    IF ( rans_tke_e )  THEN
-!
-!--    Tendency-terms for dissipation
-       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( advc_flags_s, i, j, diss, 'diss', flux_s_diss, diss_s_diss,        &
-                                flux_l_diss, diss_l_diss, i_omp, tn,                               &
-                                bc_dirichlet_l  .OR.  bc_radiation_l,                              &
-                                bc_dirichlet_n  .OR.  bc_radiation_n,                              &
-                                bc_dirichlet_r  .OR.  bc_radiation_r,                              &
-                                bc_dirichlet_s  .OR.  bc_radiation_s )
-           ELSE
-               CALL advec_s_pw( i, j, diss )
-           ENDIF
-       ELSE
-          CALL advec_s_up( i, j, diss )
-       ENDIF
-!
-!--    Production of TKE dissipation rate
-       CALL production_e_ij( i, j, .TRUE. )
-!
-!--    Diffusion term of TKE dissipation rate
-       CALL diffusion_diss_ij( i, j )
-!
-!--    Additional sink term for flows through plant canopies
-!        IF ( plant_canopy )  CALL pcm_tendency( i, j, ? )     !> @todo not yet implemented
-
-!       CALL user_actions( i, j, 'diss-tendency' ) !> @todo: find general solution for circular dependency between modules
-
-!
-!--    Prognostic equation for TKE dissipation
-!--    Eliminate negative dissipation values, which can occur due to numerical reasons in the course
-!--    of the integration. In such cases the old dissipation value is reduced by 90%.
-       DO  k = nzb+1, nzt
-          diss_p(k,j,i) = diss(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3)                  &
-                          * tdiss_m(k,j,i) ) )                                                     &
-                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-       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+1, nzt
-                tdiss_m(k,j,i) = tend(k,j,i)
-             ENDDO
-          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-             DO  k = nzb+1, nzt
-                tdiss_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tdiss_m(k,j,i)
-             ENDDO
-          ENDIF
-       ENDIF
-
-    ENDIF   ! Dissipation equation
-
- END SUBROUTINE tcm_prognostic_equations_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Production terms (shear + buoyancy) of the TKE.
-!> Vector-optimized version
-!> @warning The case with constant_flux_layer = F and use_surface_fluxes = T is not considered well!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE production_e( diss_production )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzw,                                                                               &
-               dd2zu,                                                                              &
-               d_exner,                                                                            &
-               drho_air_zw,                                                                        &
-               exner,                                                                              &
-               q,                                                                                  &
-               ql
-
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  cloud_droplets,                                                                     &
-               constant_flux_layer,                                                                &
-               neutral,                                                                            &
-               rho_reference,                                                                      &
-               use_single_reference_value,                                                         &
-               use_surface_fluxes,                                                                 &
-               use_top_fluxes
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx,                                                                                &
-               dx,                                                                                 &
-               ddy,                                                                                &
-               dy
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    IMPLICIT NONE
-
-    LOGICAL ::  diss_production  !<
-
-    INTEGER(iwp) ::  flag_nr  !< number of masking flag
-    INTEGER(iwp) ::  i        !< running index x-direction
-    INTEGER(iwp) ::  j        !< running index y-direction
-    INTEGER(iwp) ::  k        !< running index z-direction
-    INTEGER(iwp) ::  l        !< running index for different surface type orientation
-    INTEGER(iwp) ::  m        !< running index surface elements
-    INTEGER(iwp) ::  surf_e   !< end index of surface elements at given i-j position
-    INTEGER(iwp) ::  surf_s   !< start index of surface elements at given i-j position
-
-    REAL(wp)     ::  def         !< ( du_i/dx_j + du_j/dx_i ) * du_i/dx_j
-    REAL(wp)     ::  flag        !< flag to mask topography
-    REAL(wp)     ::  k1          !< temporary factor
-    REAL(wp)     ::  k2          !< temporary factor
-    REAL(wp)     ::  km_neutral  !< diffusion coefficient assuming neutral conditions - used to compute shear production at surfaces
-    REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation
-    REAL(wp)     ::  theta       !< virtual potential temperature
-    REAL(wp)     ::  temp        !< theta * Exner-function
-    REAL(wp)     ::  usvs        !< momentum flux u"v"
-    REAL(wp)     ::  vsus        !< momentum flux v"u"
-    REAL(wp)     ::  wsus        !< momentum flux w"u"
-    REAL(wp)     ::  wsvs        !< momentum flux w"v"
-
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudx      !< Gradient of u-component in x-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudy      !< Gradient of u-component in y-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudz      !< Gradient of u-component in z-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdx      !< Gradient of v-component in x-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdy      !< Gradient of v-component in y-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdz      !< Gradient of v-component in z-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdx      !< Gradient of w-component in x-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdy      !< Gradient of w-component in y-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdz      !< Gradient of w-component in z-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  tmp_flux  !< temporary flux-array in z-direction
-
-
-
-!
-!-- Calculate TKE production by shear. Calculate gradients at all grid points first, gradients at
-!-- surface-bounded grid points will be overwritten further below.
-    !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, l) &
-    !$ACC PRIVATE(surf_s, surf_e) &
-    !$ACC PRIVATE(dudx(:), dudy(:), dudz(:), dvdx(:), dvdy(:), dvdz(:), dwdx(:), dwdy(:), dwdz(:)) &
-    !$ACC PRESENT(e, u, v, w, diss, dd2zu, ddzw, km, wall_flags_total_0) &
-    !$ACC PRESENT(tend) &
-    !$ACC PRESENT(surf_def_h(0:1), surf_def_v(0:3)) &
-    !$ACC PRESENT(surf_lsm_h(0:1), surf_lsm_v(0:3)) &
-    !$ACC PRESENT(surf_usm_h(0:1), surf_usm_v(0:3))
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          !$ACC LOOP PRIVATE(k)
-          DO  k = nzb+1, nzt
-
-             dudx(k) =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-             dudy(k) = 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(k) = 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(k) = 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(k) =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-             dvdz(k) = 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(k) = 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(k) = 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(k) =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-          ENDDO
-
-
-          flag_nr = 29
-
-
-          IF ( constant_flux_layer )  THEN
-!
-
-             flag_nr = 0
-
-!--          Position beneath wall
-!--          (2) - Will allways be executed.
-!--          'bottom and wall: use u_0,v_0 and wall functions'
-!
-!--          Compute gradients at north- and south-facing surfaces. First, for default surfaces,
-!--          then for urban surfaces. Note, so far no natural vertical surfaces implemented
-             DO  l = 0, 1
-                surf_s = surf_def_v(l)%start_index(j,i)
-                surf_e = surf_def_v(l)%end_index(j,i)
-                !$ACC LOOP PRIVATE(m, k, usvs, wsvs, km_neutral, sign_dir)
-                DO  m = surf_s, surf_e
-                   k           = surf_def_v(l)%k(m)
-                   usvs        = surf_def_v(l)%mom_flux_tke(0,m)
-                   wsvs        = surf_def_v(l)%mom_flux_tke(1,m)
-
-                   km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
-!
-!--                -1.0 for right-facing wall, 1.0 for left-facing wall
-                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
-                   dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
-                   dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
-                ENDDO
-!
-!--             Natural surfaces
-                surf_s = surf_lsm_v(l)%start_index(j,i)
-                surf_e = surf_lsm_v(l)%end_index(j,i)
-                !$ACC LOOP PRIVATE(m, k, usvs, wsvs, km_neutral, sign_dir)
-                DO  m = surf_s, surf_e
-                   k           = surf_lsm_v(l)%k(m)
-                   usvs        = surf_lsm_v(l)%mom_flux_tke(0,m)
-                   wsvs        = surf_lsm_v(l)%mom_flux_tke(1,m)
-
-                   km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
-!
-!--                -1.0 for right-facing wall, 1.0 for left-facing wall
-                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
-                   dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
-                   dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
-                ENDDO
-!
-!--             Urban surfaces
-                surf_s = surf_usm_v(l)%start_index(j,i)
-                surf_e = surf_usm_v(l)%end_index(j,i)
-                !$ACC LOOP PRIVATE(m, k, usvs, wsvs, km_neutral, sign_dir)
-                DO  m = surf_s, surf_e
-                   k           = surf_usm_v(l)%k(m)
-                   usvs        = surf_usm_v(l)%mom_flux_tke(0,m)
-                   wsvs        = surf_usm_v(l)%mom_flux_tke(1,m)
-
-                   km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
-!
-!--                -1.0 for right-facing wall, 1.0 for left-facing wall
-                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
-                   dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
-                   dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
-                ENDDO
-             ENDDO
-!
-!--          Compute gradients at east- and west-facing walls
-             DO  l = 2, 3
-                surf_s = surf_def_v(l)%start_index(j,i)
-                surf_e = surf_def_v(l)%end_index(j,i)
-                !$ACC LOOP PRIVATE(m, k, vsus, wsus, km_neutral, sign_dir)
-                DO  m = surf_s, surf_e
-                   k     = surf_def_v(l)%k(m)
-                   vsus  = surf_def_v(l)%mom_flux_tke(0,m)
-                   wsus  = surf_def_v(l)%mom_flux_tke(1,m)
-
-                   km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
-!
-!--                -1.0 for right-facing wall, 1.0 for left-facing wall
-                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
-                   dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
-                   dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
-                ENDDO
-!
-!--             Natural surfaces
-                surf_s = surf_lsm_v(l)%start_index(j,i)
-                surf_e = surf_lsm_v(l)%end_index(j,i)
-                !$ACC LOOP PRIVATE(m, k, vsus, wsus, km_neutral, sign_dir)
-                DO  m = surf_s, surf_e
-                   k     = surf_lsm_v(l)%k(m)
-                   vsus  = surf_lsm_v(l)%mom_flux_tke(0,m)
-                   wsus  = surf_lsm_v(l)%mom_flux_tke(1,m)
-
-                   km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
-!
-!--                -1.0 for right-facing wall, 1.0 for left-facing wall
-                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
-                   dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
-                   dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
-                ENDDO
-!
-!--             Urban surfaces
-                surf_s = surf_usm_v(l)%start_index(j,i)
-                surf_e = surf_usm_v(l)%end_index(j,i)
-                !$ACC LOOP PRIVATE(m, k, vsus, wsus, km_neutral, sign_dir)
-                DO  m = surf_s, surf_e
-                   k     = surf_usm_v(l)%k(m)
-                   vsus  = surf_usm_v(l)%mom_flux_tke(0,m)
-                   wsus  = surf_usm_v(l)%mom_flux_tke(1,m)
-
-                   km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
-!
-!--                -1.0 for right-facing wall, 1.0 for left-facing wall
-                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
-                   dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
-                   dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
-                ENDDO
-             ENDDO
-!
-!--          Compute gradients at upward-facing surfaces
-             surf_s = surf_def_h(0)%start_index(j,i)
-             surf_e = surf_def_h(0)%end_index(j,i)
-             !$ACC LOOP PRIVATE(m, k)
-             DO  m = surf_s, surf_e
-                k = surf_def_h(0)%k(m)
-!
-!--             Please note, actually, an interpolation of u_0 and v_0 onto the grid center would be
-!--             required. However, this would require several data transfers between 2D-grid and
-!--             wall type. The effect of this missing interpolation is negligible.
-!--            (See also production_e_init).
-                dudz(k) = ( u(k+1,j,i) - surf_def_h(0)%u_0(m) ) * dd2zu(k)
-                dvdz(k) = ( v(k+1,j,i) - surf_def_h(0)%v_0(m) ) * dd2zu(k)
-
-             ENDDO
-!
-!--          Natural surfaces
-             surf_s = surf_lsm_h(0)%start_index(j,i)
-             surf_e = surf_lsm_h(0)%end_index(j,i)
-             !$ACC LOOP PRIVATE(m, k)
-             DO  m = surf_s, surf_e
-                k = surf_lsm_h(0)%k(m)
-
-                dudz(k) = ( u(k+1,j,i) - surf_lsm_h(0)%u_0(m) ) * dd2zu(k)
-                dvdz(k) = ( v(k+1,j,i) - surf_lsm_h(0)%v_0(m) ) * dd2zu(k)
-
-             ENDDO
-!
-!--          Urban surfaces
-             surf_s = surf_usm_h(0)%start_index(j,i)
-             surf_e = surf_usm_h(0)%end_index(j,i)
-             !$ACC LOOP PRIVATE(m, k)
-             DO  m = surf_s, surf_e
-                k = surf_usm_h(0)%k(m)
-
-                dudz(k) = ( u(k+1,j,i) - surf_usm_h(0)%u_0(m) ) * dd2zu(k)
-                dvdz(k) = ( v(k+1,j,i) - surf_usm_h(0)%v_0(m) ) * dd2zu(k)
-
-             ENDDO
-!
-!--          Compute gradients at downward-facing surfaces, default surfaces
-             surf_s = surf_def_h(1)%start_index(j,i)
-             surf_e = surf_def_h(1)%end_index(j,i)
-             !$ACC LOOP PRIVATE(m, k)
-             DO  m = surf_s, surf_e
-                k = surf_def_h(1)%k(m)
-
-                dudz(k) = ( surf_def_h(1)%u_0(m) - u(k-1,j,i) ) * dd2zu(k)
-                dvdz(k) = ( surf_def_h(1)%v_0(m) - v(k-1,j,i) ) * dd2zu(k)
-
-             ENDDO
-!
-!--          Compute gradients at downward-facing surfaces, natural surfaces
-             surf_s = surf_lsm_h(1)%start_index(j,i)
-             surf_e = surf_lsm_h(1)%end_index(j,i)
-             !$ACC LOOP PRIVATE(m, k)
-             DO  m = surf_s, surf_e
-                k = surf_lsm_h(1)%k(m)
-
-                dudz(k) = ( surf_lsm_h(1)%u_0(m) - u(k-1,j,i) ) * dd2zu(k)
-                dvdz(k) = ( surf_lsm_h(1)%v_0(m) - v(k-1,j,i) ) * dd2zu(k)
-
-             ENDDO
-!
-!--          Compute gradients at downward-facing surfaces, urban surfaces
-             surf_s = surf_usm_h(1)%start_index(j,i)
-             surf_e = surf_usm_h(1)%end_index(j,i)
-             !$ACC LOOP PRIVATE(m, k)
-             DO  m = surf_s, surf_e
-                k = surf_usm_h(1)%k(m)
-
-                dudz(k) = ( surf_usm_h(1)%u_0(m) - u(k-1,j,i) ) * dd2zu(k)
-                dvdz(k) = ( surf_usm_h(1)%v_0(m) - v(k-1,j,i) ) * dd2zu(k)
-
-             ENDDO
-
-
-          ENDIF
-
-
-          !$ACC LOOP PRIVATE(k, def, flag)
-          DO  k = nzb+1, nzt
-
-             def = 2.0_wp * ( dudx(k)**2 + dvdy(k)**2 + dwdz(k)**2 ) + dudy(k)**2 + dvdx(k)**2 +   &
-                   dwdx(k)**2 + dwdy(k)**2 + dudz(k)**2 + dvdz(k)**2 +                             &
-                   2.0_wp * ( dvdx(k)*dudy(k) + dwdx(k)*dudz(k) + dwdy(k)*dvdz(k) )
-
-             IF ( def < 0.0_wp )  def = 0.0_wp
-
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),flag_nr) )
-
-             IF ( .NOT. diss_production )  THEN
-
-!--             Compute tendency for TKE-production from shear
-                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
-
-             ELSE
-
-!--             RANS mode: Compute tendency for dissipation-rate-production from shear
-                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag * diss(k,j,i) /                 &
-                              ( e(k,j,i) + 1.0E-20_wp ) * c_1
-
-             ENDIF
-
-          ENDDO
-
-
-       ENDDO
-    ENDDO
-
-!
-!-- If required, calculate TKE production by buoyancy
-    IF ( .NOT. neutral )  THEN
-
-       IF ( .NOT. humidity )  THEN
-
-          IF ( ocean_mode )  THEN
-!
-!--          So far in the ocean no special treatment of density flux in the bottom and top surface
-!--          layer
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-
-                   DO  k = nzb+1, nzt
-                      tmp_flux(k) = kh(k,j,i) * ( prho(k+1,j,i) - prho(k-1,j,i) ) * dd2zu(k)
-                   ENDDO
-!
-!--                Treatment of near-surface grid points, at up- and down-ward facing surfaces
-                   IF ( use_surface_fluxes )  THEN
-                      DO  l = 0, 1
-                         surf_s = surf_def_h(l)%start_index(j,i)
-                         surf_e = surf_def_h(l)%end_index(j,i)
-                         DO  m = surf_s, surf_e
-                            k = surf_def_h(l)%k(m)
-                            tmp_flux(k) = drho_air_zw(k-1) * surf_def_h(l)%shf(m)
-                         ENDDO
-                      ENDDO
-                   ENDIF
-
-                   IF ( use_top_fluxes )  THEN
-                      surf_s = surf_def_h(2)%start_index(j,i)
-                      surf_e = surf_def_h(2)%end_index(j,i)
-                      DO  m = surf_s, surf_e
-                         k = surf_def_h(2)%k(m)
-                         tmp_flux(k) = drho_air_zw(k) * surf_def_h(2)%shf(m)
-                      ENDDO
-                   ENDIF
-
-                   IF ( .NOT. diss_production )  THEN
-
-!--                   Compute tendency for TKE-production from shear
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                         tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                    &
-                                       MERGE( rho_reference, prho(k,j,i),                          &
-                                              use_single_reference_value ) )
-                      ENDDO
-
-                   ELSE
-
-!--                   RANS mode: Compute tendency for dissipation-rate-production from shear
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                         tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                    &
-                                       MERGE( rho_reference, prho(k,j,i),                          &
-                                              use_single_reference_value ) ) *                     &
-                                       diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) *  c_3
-                      ENDDO
-
-                   ENDIF
-
-                ENDDO
-             ENDDO
-
-          ELSE ! or IF ( .NOT. ocean_mode )  THEN
-
-             !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
-             !$ACC PRIVATE(surf_s, surf_e) &
-             !$ACC PRIVATE(tmp_flux(nzb+1:nzt)) &
-             !$ACC PRESENT(e, diss, kh, pt, dd2zu, drho_air_zw, wall_flags_total_0) &
-             !$ACC PRESENT(tend) &
-             !$ACC PRESENT(surf_def_h(0:2)) &
-             !$ACC PRESENT(surf_lsm_h(0:1)) &
-             !$ACC PRESENT(surf_usm_h(0:1))
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-
-                   !$ACC LOOP PRIVATE(k)
-                   DO  k = nzb+1, nzt
-                      tmp_flux(k) = -1.0_wp * kh(k,j,i) * ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
-                   ENDDO
-
-                   IF ( use_surface_fluxes )  THEN
-!
-!--                   Default surfaces, up- and downward-facing
-                      DO  l = 0, 1
-                         surf_s = surf_def_h(l)%start_index(j,i)
-                         surf_e = surf_def_h(l)%end_index(j,i)
-                         !$ACC LOOP PRIVATE(m, k)
-                         DO  m = surf_s, surf_e
-                            k = surf_def_h(l)%k(m)
-                            tmp_flux(k) = drho_air_zw(k-1) * surf_def_h(l)%shf(m)
-                         ENDDO
-!
-!--                      Natural surfaces
-                         surf_s = surf_lsm_h(l)%start_index(j,i)
-                         surf_e = surf_lsm_h(l)%end_index(j,i)
-                         !$ACC LOOP PRIVATE(m, k)
-                         DO  m = surf_s, surf_e
-                            k = surf_lsm_h(l)%k(m)
-                            tmp_flux(k) = drho_air_zw(k-1) * surf_lsm_h(l)%shf(m)
-                         ENDDO
-!
-!--                      Urban surfaces
-                         surf_s = surf_usm_h(l)%start_index(j,i)
-                         surf_e = surf_usm_h(l)%end_index(j,i)
-                         !$ACC LOOP PRIVATE(m, k)
-                         DO  m = surf_s, surf_e
-                            k = surf_usm_h(l)%k(m)
-                            tmp_flux(k) = drho_air_zw(k-1) * surf_usm_h(l)%shf(m)
-                         ENDDO
-                      ENDDO
-                   ENDIF
-
-                   IF ( use_top_fluxes )  THEN
-                      surf_s = surf_def_h(2)%start_index(j,i)
-                      surf_e = surf_def_h(2)%end_index(j,i)
-                      !$ACC LOOP PRIVATE(m, k)
-                      DO  m = surf_s, surf_e
-                         k = surf_def_h(2)%k(m)
-                         tmp_flux(k) = drho_air_zw(k) * surf_def_h(2)%shf(m)
-                      ENDDO
-                   ENDIF
-
-                   IF ( .NOT. diss_production )  THEN
-
-!--                   Compute tendency for TKE-production from shear
-                     !$ACC LOOP PRIVATE(k, flag)
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                         tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                    &
-                                       MERGE( pt_reference, pt(k,j,i),                             &
-                                              use_single_reference_value ) )
-                      ENDDO
-
-                   ELSE
-
-!--                   RANS mode: Compute tendency for dissipation-rate-production from shear
-                      DO  k = nzb+1, nzt
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                         tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                    &
-                                       MERGE( pt_reference, pt(k,j,i),                             &
-                                              use_single_reference_value ) ) *                     &
-                                       diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_3
-                      ENDDO
-
-                   ENDIF
-
-                ENDDO
-             ENDDO
-
-          ENDIF ! From IF ( .NOT. ocean_mode )
-
-       ELSE ! Or IF ( humidity )  THEN
-
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-
-                DO  k = nzb+1, nzt
-
-                   IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets )  THEN
-                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                      k2 = 0.61_wp * pt(k,j,i)
-                      tmp_flux(k) = -1.0_wp * kh(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 ( bulk_cloud_model )  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) + d_exner(k) * lv_d_cp * ql(k,j,i)
-                         temp  = theta * exner(k)
-                         k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *           &
-                              ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                            &
-                              ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                             &
-                              ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                         k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
-                      ENDIF
-                      tmp_flux(k) = -1.0_wp * kh(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)
-                      tmp_flux(k) = -1.0_wp * kh(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
-!
-!--                Treat horizontal default surfaces
-                   DO  l = 0, 1
-                      surf_s = surf_def_h(l)%start_index(j,i)
-                      surf_e = surf_def_h(l)%end_index(j,i)
-                      DO  m = surf_s, surf_e
-                         k = surf_def_h(l)%k(m)
-
-                         IF (  .NOT.  bulk_cloud_model  .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 ( bulk_cloud_model )  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) + d_exner(k) * lv_d_cp * ql(k,j,i)
-                               temp  = theta * exner(k)
-                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *     &
-                                    ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                      &
-                                    ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                       &
-                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                               k2 = theta * ( lv_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
-
-                         tmp_flux(k) = ( k1 * surf_def_h(l)%shf(m) + k2 * surf_def_h(l)%qsws(m) )  &
-                                         * drho_air_zw(k-1)
-                      ENDDO
-                   ENDDO
-!
-!--                Treat horizontal natural surfaces
-                   DO  l = 0, 1
-                      surf_s = surf_lsm_h(l)%start_index(j,i)
-                      surf_e = surf_lsm_h(l)%end_index(j,i)
-                      DO  m = surf_s, surf_e
-                         k = surf_lsm_h(l)%k(m)
-
-                         IF (  .NOT.  bulk_cloud_model  .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 ( bulk_cloud_model )  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) + d_exner(k) * lv_d_cp * ql(k,j,i)
-                               temp  = theta * exner(k)
-                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *        &
-                                    ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                         &
-                                    ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                          &
-                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                               k2 = theta * ( lv_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
-
-                         tmp_flux(k) = ( k1 * surf_lsm_h(l)%shf(m) + k2 * surf_lsm_h(l)%qsws(m) )     &
-                                       * drho_air_zw(k-1)
-                      ENDDO
-                   ENDDO
-!
-!--                Treat horizontal urban surfaces
-                   DO  l = 0, 1
-                      surf_s = surf_usm_h(l)%start_index(j,i)
-                      surf_e = surf_usm_h(l)%end_index(j,i)
-                      DO  m = surf_s, surf_e
-                         k = surf_usm_h(l)%k(m)
-
-                         IF ( .NOT. bulk_cloud_model  .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 ( bulk_cloud_model )  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) + d_exner(k) * lv_d_cp * ql(k,j,i)
-                               temp  = theta * exner(k)
-                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *        &
-                                    ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                         &
-                                    ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                          &
-                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                               k2 = theta * ( lv_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
-
-                         tmp_flux(k) = ( k1 * surf_usm_h(l)%shf(m) + k2 * surf_usm_h(l)%qsws(m) )     &
-                                       * drho_air_zw(k-1)
-                      ENDDO
-                   ENDDO
-
-                ENDIF ! From IF ( use_surface_fluxes )  THEN
-
-                IF ( use_top_fluxes )  THEN
-
-                   surf_s = surf_def_h(2)%start_index(j,i)
-                   surf_e = surf_def_h(2)%end_index(j,i)
-                   DO  m = surf_s, surf_e
-                      k = surf_def_h(2)%k(m)
-
-                      IF ( .NOT. bulk_cloud_model  .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 ( bulk_cloud_model )  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) + d_exner(k) * lv_d_cp * ql(k,j,i)
-                            temp  = theta * exner(k)
-                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *        &
-                              ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                            &
-                              ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                             &
-                              ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                            k2 = theta * ( lv_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
-
-                      tmp_flux(k) = ( k1 * surf_def_h(2)%shf(m) + k2 * surf_def_h(2)%qsws(m) )     &
-                                    * drho_air_zw(k)
-
-                   ENDDO
-
-                ENDIF ! From IF ( use_top_fluxes )  THEN
-
-                IF ( .NOT. diss_production )  THEN
-
-!--                Compute tendency for TKE-production from shear
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                       &
-                                    MERGE( vpt_reference, vpt(k,j,i), use_single_reference_value ) )
-                   ENDDO
-
-                ELSE
-
-!--                RANS mode: Compute tendency for dissipation-rate-production from shear
-                   DO  k = nzb+1, nzt
-                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) *                             &
-                                    ( g / MERGE( vpt_reference, vpt(k,j,i),                        &
-                                                  use_single_reference_value ) )                   &
-                                   * diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_3
-                   ENDDO
-
-                ENDIF
-
-             ENDDO
-          ENDDO
-
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE production_e
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Production terms (shear + buoyancy) of the TKE.
-!> Cache-optimized version
-!> @warning The case with constant_flux_layer = F and use_surface_fluxes = T is not considered well!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE production_e_ij( i, j, diss_production )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzw,                                                                               &
-               dd2zu,                                                                              &
-               drho_air_zw,                                                                        &
-               d_exner,                                                                            &
-               exner,                                                                              &
-               q,                                                                                  &
-               ql
-
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  cloud_droplets,                                                                     &
-               constant_flux_layer,                                                                &
-               neutral,                                                                            &
-               rho_reference,                                                                      &
-               use_single_reference_value,                                                         &
-               use_surface_fluxes,                                                                 &
-               use_top_fluxes
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx,                                                                                &
-               dx,                                                                                 &
-               ddy,                                                                                &
-               dy
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    IMPLICIT NONE
-
-    LOGICAL ::  diss_production  !<
-
-    INTEGER(iwp) ::  flag_nr  !< number of masking flag
-    INTEGER(iwp) ::  i        !< running index x-direction
-    INTEGER(iwp) ::  j        !< running index y-direction
-    INTEGER(iwp) ::  k        !< running index z-direction
-    INTEGER(iwp) ::  l        !< running index for different surface type orientation
-    INTEGER(iwp) ::  m        !< running index surface elements
-    INTEGER(iwp) ::  surf_e   !< end index of surface elements at given i-j position
-    INTEGER(iwp) ::  surf_s   !< start index of surface elements at given i-j position
-
-    REAL(wp)     ::  def         !< ( du_i/dx_j + du_j/dx_i ) * du_i/dx_j
-    REAL(wp)     ::  flag        !< flag to mask topography
-    REAL(wp)     ::  k1          !< temporary factor
-    REAL(wp)     ::  k2          !< temporary factor
-    REAL(wp)     ::  km_neutral  !< diffusion coefficient assuming neutral conditions - used to compute shear production at surfaces
-    REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation
-    REAL(wp)     ::  theta       !< virtual potential temperature
-    REAL(wp)     ::  temp        !< theta * Exner-function
-    REAL(wp)     ::  usvs        !< momentum flux u"v"
-    REAL(wp)     ::  vsus        !< momentum flux v"u"
-    REAL(wp)     ::  wsus        !< momentum flux w"u"
-    REAL(wp)     ::  wsvs        !< momentum flux w"v"
-
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudx      !< Gradient of u-component in x-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudy      !< Gradient of u-component in y-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudz      !< Gradient of u-component in z-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdx      !< Gradient of v-component in x-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdy      !< Gradient of v-component in y-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdz      !< Gradient of v-component in z-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdx      !< Gradient of w-component in x-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdy      !< Gradient of w-component in y-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdz      !< Gradient of w-component in z-direction
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  tmp_flux  !< temporary flux-array in z-direction
-
-
-
-!
-!-- Calculate TKE production by shear. Calculate gradients at all grid points first, gradients at
-!-- surface-bounded grid points will be overwritten further below.
-    DO  k = nzb+1, nzt
-
-       dudx(k) =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-       dudy(k) = 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(k) = 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(k) = 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(k) =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-       dvdz(k) = 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(k) = 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(k) = 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(k) =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-    ENDDO
-
-    flag_nr = 29
-
-    IF ( constant_flux_layer )  THEN
-
-       flag_nr = 0
-
-!--    Position beneath wall
-!--    (2) - Will allways be executed.
-!--    'bottom and wall: use u_0,v_0 and wall functions'
-!
-!--    Compute gradients at north- and south-facing surfaces. First, for default surfaces, then for
-!--    urban surfaces. Note, so far no natural vertical surfaces implemented
-       DO  l = 0, 1
-          surf_s = surf_def_v(l)%start_index(j,i)
-          surf_e = surf_def_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_def_v(l)%k(m)
-             usvs        = surf_def_v(l)%mom_flux_tke(0,m)
-             wsvs        = surf_def_v(l)%mom_flux_tke(1,m)
-
-             km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
-!
-!--          -1.0 for right-facing wall, 1.0 for left-facing wall
-             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
-             dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
-             dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
-          ENDDO
-!
-!--       Natural surfaces
-          surf_s = surf_lsm_v(l)%start_index(j,i)
-          surf_e = surf_lsm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_lsm_v(l)%k(m)
-             usvs        = surf_lsm_v(l)%mom_flux_tke(0,m)
-             wsvs        = surf_lsm_v(l)%mom_flux_tke(1,m)
-
-             km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
-!
-!--          -1.0 for right-facing wall, 1.0 for left-facing wall
-             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
-             dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
-             dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
-          ENDDO
-!
-!--       Urban surfaces
-          surf_s = surf_usm_v(l)%start_index(j,i)
-          surf_e = surf_usm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k           = surf_usm_v(l)%k(m)
-             usvs        = surf_usm_v(l)%mom_flux_tke(0,m)
-             wsvs        = surf_usm_v(l)%mom_flux_tke(1,m)
-
-             km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
-!
-!--          -1.0 for right-facing wall, 1.0 for left-facing wall
-             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
-             dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
-             dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
-          ENDDO
-       ENDDO
-!
-!--    Compute gradients at east- and west-facing walls
-       DO  l = 2, 3
-          surf_s = surf_def_v(l)%start_index(j,i)
-          surf_e = surf_def_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k     = surf_def_v(l)%k(m)
-             vsus  = surf_def_v(l)%mom_flux_tke(0,m)
-             wsus  = surf_def_v(l)%mom_flux_tke(1,m)
-
-             km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
-!
-!--          -1.0 for right-facing wall, 1.0 for left-facing wall
-             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
-             dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
-             dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
-          ENDDO
-!
-!--       Natural surfaces
-          surf_s = surf_lsm_v(l)%start_index(j,i)
-          surf_e = surf_lsm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k     = surf_lsm_v(l)%k(m)
-             vsus  = surf_lsm_v(l)%mom_flux_tke(0,m)
-             wsus  = surf_lsm_v(l)%mom_flux_tke(1,m)
-
-             km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
-!
-!--          -1.0 for right-facing wall, 1.0 for left-facing wall
-             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
-             dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
-             dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
-          ENDDO
-!
-!--       Urban surfaces
-          surf_s = surf_usm_v(l)%start_index(j,i)
-          surf_e = surf_usm_v(l)%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k     = surf_usm_v(l)%k(m)
-             vsus  = surf_usm_v(l)%mom_flux_tke(0,m)
-             wsus  = surf_usm_v(l)%mom_flux_tke(1,m)
-
-             km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
-!
-!--          -1.0 for right-facing wall, 1.0 for left-facing wall
-             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
-             dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
-             dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
-          ENDDO
-       ENDDO
-!
-!--    Compute gradients at upward-facing surfaces
-       surf_s = surf_def_h(0)%start_index(j,i)
-       surf_e = surf_def_h(0)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k = surf_def_h(0)%k(m)
-!
-!--       Please note, actually, an interpolation of u_0 and v_0 onto the grid center would be
-!--       required. However, this would require several data transfers between 2D-grid and wall
-!--       type. The effect of this missing interpolation is negligible. (See also production_e_init).
-          dudz(k) = ( u(k+1,j,i) - surf_def_h(0)%u_0(m) ) * dd2zu(k)
-          dvdz(k) = ( v(k+1,j,i) - surf_def_h(0)%v_0(m) ) * dd2zu(k)
-
-       ENDDO
-!
-!--    Natural surfaces
-       surf_s = surf_lsm_h(0)%start_index(j,i)
-       surf_e = surf_lsm_h(0)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k = surf_lsm_h(0)%k(m)
-
-          dudz(k) = ( u(k+1,j,i) - surf_lsm_h(0)%u_0(m) ) * dd2zu(k)
-          dvdz(k) = ( v(k+1,j,i) - surf_lsm_h(0)%v_0(m) ) * dd2zu(k)
-
-       ENDDO
-!
-!--    Urban surfaces
-       surf_s = surf_usm_h(0)%start_index(j,i)
-       surf_e = surf_usm_h(0)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k = surf_usm_h(0)%k(m)
-
-          dudz(k) = ( u(k+1,j,i) - surf_usm_h(0)%u_0(m) ) * dd2zu(k)
-          dvdz(k) = ( v(k+1,j,i) - surf_usm_h(0)%v_0(m) ) * dd2zu(k)
-
-       ENDDO
-!
-!--    Compute gradients at downward-facing surfaces, default surfaces
-       surf_s = surf_def_h(1)%start_index(j,i)
-       surf_e = surf_def_h(1)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k = surf_def_h(1)%k(m)
-          dudz(k) = ( surf_def_h(1)%u_0(m) - u(k-1,j,i) ) * dd2zu(k)
-          dvdz(k) = ( surf_def_h(1)%v_0(m) - v(k-1,j,i) ) * dd2zu(k)
-       ENDDO
-!
-!--    Compute gradients at downward-facing surfaces, natural surfaces
-       surf_s = surf_lsm_h(1)%start_index(j,i)
-       surf_e = surf_lsm_h(1)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k = surf_lsm_h(1)%k(m)
-          dudz(k) = ( surf_lsm_h(1)%u_0(m) - u(k-1,j,i) ) * dd2zu(k)
-          dvdz(k) = ( surf_lsm_h(1)%v_0(m) - v(k-1,j,i) ) * dd2zu(k)
-       ENDDO
-!
-!--    Compute gradients at downward-facing surfaces, urban surfaces
-       surf_s = surf_usm_h(1)%start_index(j,i)
-       surf_e = surf_usm_h(1)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k = surf_usm_h(1)%k(m)
-          dudz(k) = ( surf_usm_h(1)%u_0(m) - u(k-1,j,i) ) * dd2zu(k)
-          dvdz(k) = ( surf_usm_h(1)%v_0(m) - v(k-1,j,i) ) * dd2zu(k)
-       ENDDO
-
-    ENDIF
-
-    DO  k = nzb+1, nzt
-
-       def = 2.0_wp * ( dudx(k)**2 + dvdy(k)**2 + dwdz(k)**2 ) +                                   &
-                        dudy(k)**2 + dvdx(k)**2 + dwdx(k)**2 +                                     &
-                        dwdy(k)**2 + dudz(k)**2 + dvdz(k)**2 +                                     &
-             2.0_wp * ( dvdx(k)*dudy(k) + dwdx(k)*dudz(k) + dwdy(k)*dvdz(k) )
-
-       IF ( def < 0.0_wp )  def = 0.0_wp
-
-       flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),flag_nr) )
-
-       IF ( .NOT. diss_production )  THEN
-
-!--       Compute tendency for TKE-production from shear
-          tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
-
-       ELSE
-
-!--       RANS mode: Compute tendency for dissipation-rate-production from shear
-          tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag *                                     &
-                        diss(k,j,i) / ( e(k,j,i) + 1.0E-20_wp ) * c_1
-
-       ENDIF
-
-    ENDDO
-
-!
-!-- If required, calculate TKE production by buoyancy
-    IF ( .NOT. neutral )  THEN
-
-       IF ( .NOT. humidity )  THEN
-
-          IF ( ocean_mode )  THEN
-!
-!--          So far in the ocean no special treatment of density flux in the bottom and top surface
-!--          layer
-             DO  k = nzb+1, nzt
-                tmp_flux(k) = kh(k,j,i) * ( prho(k+1,j,i) - prho(k-1,j,i) ) * dd2zu(k)
-             ENDDO
-!
-!--          Treatment of near-surface grid points, at up- and down- ward facing surfaces
-             IF ( use_surface_fluxes )  THEN
-                DO  l = 0, 1
-                   surf_s = surf_def_h(l)%start_index(j,i)
-                   surf_e = surf_def_h(l)%end_index(j,i)
-                   DO  m = surf_s, surf_e
-                      k = surf_def_h(l)%k(m)
-                      tmp_flux(k) = drho_air_zw(k-1) * surf_def_h(l)%shf(m)
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( use_top_fluxes )  THEN
-                surf_s = surf_def_h(2)%start_index(j,i)
-                surf_e = surf_def_h(2)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k = surf_def_h(2)%k(m)
-                   tmp_flux(k) = drho_air_zw(k) * surf_def_h(2)%shf(m)
-                ENDDO
-             ENDIF
-
-             IF ( .NOT. diss_production )  THEN
-
-!--             Compute tendency for TKE-production from shear
-                DO  k = nzb+1, nzt
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                          &
-                                 MERGE( rho_reference, prho(k,j,i), use_single_reference_value ) )
-                ENDDO
-
-             ELSE
-
-!--             RANS mode: Compute tendency for dissipation-rate-production from shear
-                DO  k = nzb+1, nzt
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                          &
-                                 MERGE( rho_reference, prho(k,j,i),                                &
-                                 use_single_reference_value ) ) *                                  &
-                                 diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_3
-                ENDDO
-
-             ENDIF
-
-
-          ELSE ! or IF ( .NOT. ocean_mode )  THEN
-
-             DO  k = nzb+1, nzt
-                tmp_flux(k) = -1.0_wp * kh(k,j,i) * ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
-             ENDDO
-
-             IF ( use_surface_fluxes )  THEN
-!
-!--             Default surfaces, up- and downward-facing
-                DO  l = 0, 1
-                   surf_s = surf_def_h(l)%start_index(j,i)
-                   surf_e = surf_def_h(l)%end_index(j,i)
-                   DO  m = surf_s, surf_e
-                      k = surf_def_h(l)%k(m)
-                      tmp_flux(k) = drho_air_zw(k-1) * surf_def_h(l)%shf(m)
-                   ENDDO
-!
-!--                Natural surfaces
-                   surf_s = surf_lsm_h(l)%start_index(j,i)
-                   surf_e = surf_lsm_h(l)%end_index(j,i)
-                   DO  m = surf_s, surf_e
-                      k = surf_lsm_h(l)%k(m)
-                      tmp_flux(k) = drho_air_zw(k-1) * surf_lsm_h(l)%shf(m)
-                   ENDDO
-!
-!--                Urban surfaces
-                   surf_s = surf_usm_h(l)%start_index(j,i)
-                   surf_e = surf_usm_h(l)%end_index(j,i)
-                   DO  m = surf_s, surf_e
-                      k = surf_usm_h(l)%k(m)
-                      tmp_flux(k) = drho_air_zw(k-1) * surf_usm_h(l)%shf(m)
-                   ENDDO
-                ENDDO
-             ENDIF
-
-             IF ( use_top_fluxes )  THEN
-                surf_s = surf_def_h(2)%start_index(j,i)
-                surf_e = surf_def_h(2)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k = surf_def_h(2)%k(m)
-                   tmp_flux(k) = drho_air_zw(k) * surf_def_h(2)%shf(m)
-                ENDDO
-             ENDIF
-
-             IF ( .NOT. diss_production )  THEN
-
-!--             Compute tendency for TKE-production from shear
-                DO  k = nzb+1, nzt
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                          &
-                                 MERGE( pt_reference, pt(k,j,i), use_single_reference_value ) )
-                ENDDO
-
-             ELSE
-
-!--             RANS mode: Compute tendency for dissipation-rate-production from shear
-                DO  k = nzb+1, nzt
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                   tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                          &
-                                 MERGE( pt_reference, pt(k,j,i),                                   &
-                                        use_single_reference_value ) ) *                           &
-                                 diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_3
-                ENDDO
-
-             ENDIF
-
-          ENDIF ! From IF ( .NOT. ocean_mode )
-
-       ELSE ! Or IF ( humidity )  THEN
-
-          DO  k = nzb+1, nzt
-
-             IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets )  THEN
-                k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                k2 = 0.61_wp * pt(k,j,i)
-                tmp_flux(k) = -1.0_wp * kh(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 ( bulk_cloud_model )  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) + d_exner(k) * lv_d_cp * ql(k,j,i)
-                   temp  = theta * exner(k)
-                   k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *                 &
-                        ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                                  &
-                        ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                                   &
-                        ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                   k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
-                ENDIF
-                tmp_flux(k) = -1.0_wp * kh(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)
-                tmp_flux(k) = -1.0_wp * kh(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
-!
-!--          Treat horizontal surfaces
-             DO  l = 0, 1
-!--             Default surfaces
-                surf_s = surf_def_h(l)%start_index(j,i)
-                surf_e = surf_def_h(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k = surf_def_h(l)%k(m)
-
-                   IF ( .NOT. bulk_cloud_model  .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 ( bulk_cloud_model )  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) + d_exner(k) * lv_d_cp * ql(k,j,i)
-                         temp  = theta * exner(k)
-                         k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *           &
-                              ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                            &
-                              ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                             &
-                              ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                         k2 = theta * ( lv_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
-
-                   tmp_flux(k) = ( k1 * surf_def_h(l)%shf(m) + k2 * surf_def_h(l)%qsws(m) ) *      &
-                                 drho_air_zw(k-1)
-                ENDDO
-!
-!--             natural surfaces
-                surf_s = surf_lsm_h(l)%start_index(j,i)
-                surf_e = surf_lsm_h(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k = surf_lsm_h(l)%k(m)
-
-                   IF ( .NOT. bulk_cloud_model  .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 ( bulk_cloud_model )  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) + d_exner(k) * lv_d_cp * ql(k,j,i)
-                         temp  = theta * exner(k)
-                         k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *              &
-                              ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                               &
-                              ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                                &
-                              ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                         k2 = theta * ( lv_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
-
-                   tmp_flux(k) = ( k1 * surf_lsm_h(l)%shf(m) + k2 * surf_lsm_h(l)%qsws(m) ) *         &
-                                 drho_air_zw(k-1)
-                ENDDO
-!
-!--             urban surfaces
-                surf_s = surf_usm_h(l)%start_index(j,i)
-                surf_e = surf_usm_h(l)%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k = surf_usm_h(l)%k(m)
-
-                   IF ( .NOT. bulk_cloud_model  .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 ( bulk_cloud_model )  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) + d_exner(k) * lv_d_cp * ql(k,j,i)
-                         temp  = theta * exner(k)
-                         k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *              &
-                              ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                               &
-                              ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                                &
-                              ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                         k2 = theta * ( lv_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
-
-                   tmp_flux(k) = ( k1 * surf_usm_h(l)%shf(m) + k2 * surf_usm_h(l)%qsws(m) ) *         &
-                                 drho_air_zw(k-1)
-                ENDDO
-             ENDDO
-
-          ENDIF ! From IF ( use_surface_fluxes )  THEN
-
-          IF ( use_top_fluxes )  THEN
-
-             surf_s = surf_def_h(2)%start_index(j,i)
-             surf_e = surf_def_h(2)%end_index(j,i)
-             DO  m = surf_s, surf_e
-                k = surf_def_h(2)%k(m)
-
-                IF ( .NOT. bulk_cloud_model  .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 ( bulk_cloud_model )  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) + d_exner(k) * lv_d_cp * ql(k,j,i)
-                      temp  = theta * exner(k)
-                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *              &
-                        ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                                  &
-                        ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                                   &
-                        ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                      k2 = theta * ( lv_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
-
-                tmp_flux(k) = ( k1 * surf_def_h(2)%shf(m) + k2 * surf_def_h(2)%qsws(m) ) *         &
-                              drho_air_zw(k)
-
-             ENDDO
-
-          ENDIF ! From IF ( use_top_fluxes )  THEN
-
-          IF ( .NOT. diss_production )  THEN
-
-!--          Compute tendency for TKE-production from shear
-             DO  k = nzb+1, nzt
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
-                tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                             &
-                              MERGE( vpt_reference, vpt(k,j,i), use_single_reference_value ) )
-             ENDDO
-
-          ELSE
-
-!--          RANS mode: Compute tendency for dissipation-rate-production from shear
-             DO  k = nzb+1, nzt
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
-                tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                             &
-                              MERGE( vpt_reference, vpt(k,j,i),                                    &
-                                     use_single_reference_value ) ) *                              &
-                              diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_3
-             ENDDO
-
-          ENDIF
-
-       ENDIF
-
-    ENDIF
-
- END SUBROUTINE production_e_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Diffusion and dissipation terms for the TKE.
-!> Vector-optimized version
-!> @todo Try to avoid the usage of the 3d-array 'diss' where possible (case les and rans_tke_l if
-!> not wang_kernel, use_sgs_for_particles, or collision_turbulence).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE diffusion_e( var, var_reference )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dd2zu,                                                                              &
-               ddzu,                                                                               &
-               ddzw,                                                                               &
-               drho_air,                                                                           &
-               rho_air_zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  atmos_ocean_sign,                                                                   &
-               use_single_reference_value
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2,                                                                               &
-               ddy2
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  collision_turbulence
-
-    USE particle_attributes,                                                                       &
-        ONLY:  use_sgs_for_particles,                                                              &
-               wang_kernel
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< running index x direction
-    INTEGER(iwp) ::  j  !< running index y direction
-    INTEGER(iwp) ::  k  !< running index z direction
-    INTEGER(iwp) ::  m  !< running index surface elements
-
-    REAL(wp)     ::  duv2_dz2       !< squared vertical gradient of wind vector
-    REAL(wp)     ::  dvar_dz        !< vertical gradient of var
-    REAL(wp)     ::  ml             !< mixing length
-    REAL(wp)     ::  var_reference  !< reference temperature
-
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  ml_stratification  !< mixing length according to stratification
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  richardson_number  !< gradient Richardson number
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  var  !< temperature
-
-!
-!-- Calculate the dissipation
-    IF( les_default  .OR.  les_dynamic )  THEN
-
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
-       !$ACC PRIVATE(ml, ml_stratification, dvar_dz) &
-       !$ACC PRESENT(diss, e, var, wall_flags_total_0) &
-       !$ACC PRESENT(dd2zu, delta)
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             !$ACC LOOP PRIVATE(k)
-             DO  k = nzb+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
-                     ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) ) /                           &
-                                            SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-                   ELSE
-                     ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) ) /                           &
-                                            SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-                   ENDIF
-                ELSE
-                   ml_stratification(k) = delta(k,j,i)
-                ENDIF
-
-             ENDDO
-
-!
-!--          ATTENTION: Don't merge the following loop with the previous one, because this would
-!--          prohibit proper vectorization by the Intel18 compiler. This behaviour might change for
-!--          future compiler versions.
-             !$ACC LOOP PRIVATE(k)
-             !DIR$ IVDEP
-             DO  k = nzb+1, nzt
-
-                ml = MIN( delta(k,j,i), ml_stratification(k) )
-
-                diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) ) * e(k,j,i)                 &
-                              * SQRT( e(k,j,i) ) / ml                                              &
-                              * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ELSEIF ( les_dai )  THEN
-
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
-       !$ACC PRIVATE(ml, ml_stratification, dvar_dz) &
-       !$ACC PRESENT(diss, e, var, wall_flags_total_0) &
-       !$ACC PRESENT(dd2zu, delta)
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             !$ACC LOOP PRIVATE(k)
-             DO  k = nzb+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
-!
-!--                The mixing length is calculated as 1/l = 1/(kappa*z) + 1/Lb, where Lb is the
-!--                stratification term. 1E-5 is added as l is zero at the beginning of the simulation.
-                   IF ( use_single_reference_value )  THEN
-                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
-                                             / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-                   ELSE
-                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
-                                             / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-                   ENDIF
-                   ml_stratification(k) = 1.0_wp / ( 1.0_wp / ( kappa * distance_to_wall(k,j,i) )  &
-                                                   + 1.0_wp / ml_stratification(k) )
-                ELSE
-                   ml_stratification(k) = delta(k,j,i)
-                ENDIF
-
-             ENDDO
-
-!
-!--          ATTENTION: Don't merge the following loop with the previous one, because this would
-!--          prohibit proper vectorization by the Intel18 compiler. This behaviour might change for
-!--          future compiler versions.
-             !$ACC LOOP PRIVATE(k)
-             !DIR$ IVDEP
-             DO  k = nzb+1, nzt
-
-                ml          = ml_stratification(k)
-                diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) )                            &
-                              * e(k,j,i) * SQRT( e(k,j,i) ) / ml                                   &
-                              * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-             ENDDO
-
-          ENDDO
-       ENDDO
-    ELSEIF ( rans_tke_l )  THEN
-
-      !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
-      !$ACC PRIVATE(ml_stratification, duv2_dz2, richardson_number, dvar_dz) &
-      !$ACC PRESENT(diss, e, u, v, var, wall_flags_total_0) &
-      !$ACC PRESENT(dd2zu, ml_blackadar, delta)
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-!
-!--          Calculate Richardson number
-             IF ( use_single_reference_value )  THEN
-
-                !$ACC LOOP PRIVATE(k)
-                DO  k = nzb+1, nzt
-
-                   dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-
-                   duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                        &
-                            + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
-
-                   richardson_number(k) = MIN( MAX( g / var_reference * dvar_dz / duv2_dz2,        &
-                                                    -5.0_wp ),                                     &
-                                               1.0_wp )
-                ENDDO
-             ELSE
-!
-!--             ATTENTION: Don't merge the following loops with the previous one, because this would
-!--             prohibit proper vectorization by the Intel18 compiler. This behaviour might change
-!--             for future compiler versions.
-                !$ACC LOOP PRIVATE(k)
-                DO  k = nzb+1, nzt
-
-                   dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-
-                   duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                        &
-                            + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
-
-                   richardson_number(k) = MIN( MAX( g / var(k,j,i) * dvar_dz / duv2_dz2,           &
-                                                    -5.0_wp ),                                     &
-                                               1.0_wp )
-                ENDDO
-             ENDIF
-!
-!--          Calculate diabatic mixing length using Dyer-profile functions
-             !$ACC LOOP PRIVATE(k)
-             DO  k = nzb+1, nzt
-                IF ( richardson_number(k) >= 0.0_wp )  THEN
-                   ml_stratification(k) = ml_blackadar(k)                                          &
-                                        / ( 1.0_wp + 5.0_wp * richardson_number(k) )
-                ELSE
-                   ml_stratification(k) = ml_blackadar(k)                                          &
-                                        * SQRT( 1.0_wp - 16.0_wp * richardson_number(k) )
-                ENDIF
-             ENDDO
-
-             !$ACC LOOP PRIVATE(k)
-             !DIR$ IVDEP
-             DO  k = nzb+1, nzt
-
-                diss(k,j,i) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) )                                 &
-                            / MIN( ml_stratification(k), delta(k,j,i) )                            &
-                            * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-!-- Note, in case of rans_tke_e, the dissipation is already calculated in prognostic_equations
-    ENDIF
-
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
-    !$ACC PRESENT(diss, e, km, tend, wall_flags_total_0) &
-    !$ACC PRESENT(ddzu, ddzw, rho_air_zw, drho_air)
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-
-             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) * rho_air_zw(k)                         &
-                                         - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) )     &
-                                             * ddzu(k) * rho_air_zw(k-1)                           &
-                                           ) * ddzw(k) * drho_air(k)                               &
-                                         ) * dsig_e * MERGE( 1.0_wp, 0.0_wp,                       &
-                                                      BTEST( wall_flags_total_0(k,j,i), 0 ) )      &
-                          - diss(k,j,i)
-
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Neumann boundary condition for dissipation diss(nzb,:,:) = diss(nzb+1,:,:).
-!-- Note, bc cannot be set in tcm_boundary conditions as the dissipation in LES mode is only a
-!-- diagnostic quantity.
-    IF ( .NOT. rans_tke_e  .AND.                                                                   &
-         ( use_sgs_for_particles  .OR.  wang_kernel  .OR.  collision_turbulence  ) )  THEN
-!
-!--    Upward facing surfaces
-       DO  m = 1, bc_h(0)%ns
-          i = bc_h(0)%i(m)
-          j = bc_h(0)%j(m)
-          k = bc_h(0)%k(m)
-          diss(k-1,j,i) = diss(k,j,i)
-       ENDDO
-!
-!--    Downward facing surfaces
-       DO  m = 1, bc_h(1)%ns
-          i = bc_h(1)%i(m)
-          j = bc_h(1)%j(m)
-          k = bc_h(1)%k(m)
-          diss(k+1,j,i) = diss(k,j,i)
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE diffusion_e
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Diffusion and dissipation terms for the TKE.
-!> Cache-optimized version
-!> @todo Try to avoid the usage of the 3d-array 'diss' where possible (case les and rans_tke_l if
-!>  not wang_kernel, use_sgs_for_particles, or collision_turbulence).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE diffusion_e_ij( i, j, var, var_reference )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dd2zu,                                                                              &
-               ddzu,                                                                               &
-               ddzw,                                                                               &
-               drho_air,                                                                           &
-               rho_air_zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  atmos_ocean_sign,                                                                   &
-               use_single_reference_value
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2,                                                                               &
-               ddy2
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  collision_turbulence
-
-    USE particle_attributes,                                                                       &
-        ONLY:  use_sgs_for_particles,                                                              &
-               wang_kernel
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i       !< running index x direction
-    INTEGER(iwp) ::  j       !< running index y direction
-    INTEGER(iwp) ::  k       !< running index z direction
-    INTEGER(iwp) ::  m       !< running index surface elements
-    INTEGER(iwp) ::  surf_e  !< End index of surface elements at (j,i)-gridpoint
-    INTEGER(iwp) ::  surf_s  !< Start index of surface elements at (j,i)-gridpoint
-
-    REAL(wp)     ::  duv2_dz2       !< squared vertical gradient of wind vector
-    REAL(wp)     ::  dvar_dz        !< vertical gradient of var
-    REAL(wp)     ::  ml             !< mixing length
-    REAL(wp)     ::  var_reference  !< reference temperature
-
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  ml_stratification  !< mixing length according to stratification
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  richardson_number  !< gradient Richardson number
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  var  !< temperature
-
-!
-!-- Calculate the mixing length and dissipation...
-!-- ...in case of LES
-    IF ( les_default  .OR.  les_dynamic )  THEN
-
-       DO  k = nzb+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
-                ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                                  &
-                                       / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-             ELSE
-                ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                                  &
-                                       / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-             ENDIF
-          ELSE
-             ml_stratification(k) = delta(k,j,i)
-          ENDIF
-       ENDDO
-
-       !DIR$ IVDEP
-       DO  k = nzb+1, nzt
-          ml  = MIN( delta(k,j,i), ml_stratification(k) )
-
-          diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) )                                  &
-                        * e(k,j,i) * SQRT( e(k,j,i) ) / ml                                         &
-                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-       ENDDO
-
-    ELSEIF ( les_dai )  THEN
-
-       DO  k = nzb+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
-!
-!--          The mixing length is calculated as 1/l = 1/(kappa*z) + 1/Lb, where Lb is the
-!--          stratification term. 1E-5 is added as l is zero at the beginning of the simulation.
-             IF ( use_single_reference_value )  THEN
-                ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                                  &
-                                       / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-             ELSE
-                ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                                  &
-                                       / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-             ENDIF
-
-             ml_stratification(k) = 1.0_wp / ( 1.0_wp / ( kappa * distance_to_wall(k,j,i) )        &
-                                             + 1.0_wp / ml_stratification(k) )
-
-          ELSE
-             ml_stratification(k) = delta(k,j,i)
-          ENDIF
-       ENDDO
-
-       !DIR$ IVDEP
-       DO  k = nzb+1, nzt
-          ml  = ml_stratification(k)
-
-          diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) )                                  &
-                        * e(k,j,i) * SQRT( e(k,j,i) ) / ml                                         &
-                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-       ENDDO
-
-
-
-
-!
-!-- ...in case of RANS
-    ELSEIF ( rans_tke_l )  THEN
-
-!
-!--    Calculate Richardson number
-       IF ( use_single_reference_value )  THEN
-          DO  k = nzb+1, nzt
-             dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-
-             duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                              &
-                      + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
-
-             richardson_number(k) = MIN( MAX( g / var_reference * dvar_dz / duv2_dz2, -5.0_wp ),   &
-                                         1.0_wp )
-          ENDDO
-       ELSE
-          DO  k = nzb+1, nzt
-             dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-
-             duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                              &
-                      + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
-
-             richardson_number(k) = MIN( MAX( g / var(k,j,i) * dvar_dz / duv2_dz2, -5.0_wp ),      &
-                                         1.0_wp )
-          ENDDO
-       ENDIF
-!
-!--    Calculate diabatic mixing length using Dyer-profile functions
-       DO  k = nzb+1, nzt
-          IF ( richardson_number(k) >= 0.0_wp )  THEN
-             ml_stratification(k) = ml_blackadar(k) / ( 1.0_wp + 5.0_wp * richardson_number(k) )
-          ELSE
-             ml_stratification(k) = ml_blackadar(k)                                                &
-                                  * SQRT( 1.0_wp - 16.0_wp * richardson_number(k) )
-          ENDIF
-
-       ENDDO
-
-       !DIR$ IVDEP
-       DO  k = nzb+1, nzt
-          diss(k,j,i) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) )                                       &
-                      / MIN( ml_stratification(k), delta(k,j,i) )                                  &
-                      * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-       ENDDO
-
-!-- Note, in case of rans_tke_e, the dissipation is already calculated in prognostic_equations
-    ENDIF
-
-!
-!-- Calculate the tendency term
-    !DIR$ IVDEP
-    DO  k = nzb+1, nzt
-
-       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) * rho_air_zw(k)                               &
-                                     - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) )         &
-                                         * ddzu(k) * rho_air_zw(k-1) ) * ddzw(k) * drho_air(k)     &
-                                   ) * dsig_e * MERGE( 1.0_wp, 0.0_wp,                             &
-                                                BTEST( wall_flags_total_0(k,j,i), 0 ) )            &
-                     - diss(k,j,i)
-
-    ENDDO
-
-!
-!-- Set boundary conditions of dissipation if needed for calculating the sgs particle velocities.
-!-- Neumann boundary condition for dissipation diss(nzb,:,:) = diss(nzb+1,:,:)
-!-- For each surface type determine start and end index (in case of elevated topography several
-!-- up/downward facing surfaces may exist.
-!-- Note, bc cannot be set in tcm_boundary conditions as the dissipation in LES mode is only a
-!-- diagnostic quantity.
-    IF ( .NOT. rans_tke_e  .AND.                                                                   &
-         ( use_sgs_for_particles  .OR.  wang_kernel  .OR.  collision_turbulence ) )  THEN
-       surf_s = bc_h(0)%start_index(j,i)
-       surf_e = bc_h(0)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k             = bc_h(0)%k(m)
-          diss(k-1,j,i) = diss(k,j,i)
-       ENDDO
-!
-!--    Downward facing surfaces
-       surf_s = bc_h(1)%start_index(j,i)
-       surf_e = bc_h(1)%end_index(j,i)
-       DO  m = surf_s, surf_e
-          k             = bc_h(1)%k(m)
-          diss(k+1,j,i) = diss(k,j,i)
-       ENDDO
-    ENDIF
-
- END SUBROUTINE diffusion_e_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Diffusion term for the TKE dissipation rate
-!> Vector-optimized version
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE diffusion_diss
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu,                                                                               &
-               ddzw,                                                                               &
-               drho_air,                                                                           &
-               rho_air_zw
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2,                                                                               &
-               ddy2
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< running index x direction
-    INTEGER(iwp) ::  j  !< running index y direction
-    INTEGER(iwp) ::  k  !< running index z direction
-
-    REAL(wp)     ::  flag  !< flag to mask topography
-
-!
-!-- Calculate the tendency terms
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-
-!
-!--          Predetermine flag to mask topography
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-             tend(k,j,i) = tend(k,j,i) +                                                           &
-                           ( ( ( km(k,j,i)+km(k,j,i+1) ) * ( diss(k,j,i+1)-diss(k,j,i) )           &
-                             - ( km(k,j,i)+km(k,j,i-1) ) * ( diss(k,j,i)-diss(k,j,i-1) ) ) * ddx2  &
-                           + ( ( km(k,j,i)+km(k,j+1,i) ) * ( diss(k,j+1,i)-diss(k,j,i) )           &
-                             - ( km(k,j,i)+km(k,j-1,i) ) * ( diss(k,j,i)-diss(k,j-1,i) ) ) * ddy2  &
-                           + ( ( km(k,j,i)+km(k+1,j,i) ) * ( diss(k+1,j,i)-diss(k,j,i) )           &
-                               * ddzu(k+1) * rho_air_zw(k)                                         &
-                             - ( km(k,j,i)+km(k-1,j,i) ) * ( diss(k,j,i)-diss(k-1,j,i) ) * ddzu(k) &
-                               * rho_air_zw(k-1) ) * ddzw(k) * drho_air(k)                         &
-                           )  * flag * dsig_diss - c_2 * diss(k,j,i)**2                            &
-                              / ( e(k,j,i) + 1.0E-20_wp ) * flag
-
-          ENDDO
-       ENDDO
-    ENDDO
-
- END SUBROUTINE diffusion_diss
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Diffusion term for the TKE dissipation rate
-!> Cache-optimized version
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE diffusion_diss_ij( i, j )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu,                                                                               &
-               ddzw,                                                                               &
-               drho_air,                                                                           &
-               rho_air_zw
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx2,                                                                               &
-               ddy2
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< running index x direction
-    INTEGER(iwp) ::  j  !< running index y direction
-    INTEGER(iwp) ::  k  !< running index z direction
-
-    REAL(wp)     ::  flag  !< flag to mask topography
-
-!
-!-- Calculate the mixing length (for dissipation)
-    DO  k = nzb+1, nzt
-
-!
-!--    Predetermine flag to mask topography
-       flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-!
-!--    Calculate the tendency term
-       tend(k,j,i) =  tend(k,j,i) +                                                                &
-                      ( ( ( km(k,j,i)+km(k,j,i+1) ) * ( diss(k,j,i+1)-diss(k,j,i) )                &
-                        - ( km(k,j,i)+km(k,j,i-1) ) * ( diss(k,j,i)-diss(k,j,i-1) ) ) * ddx2       &
-                      + ( ( km(k,j,i)+km(k,j+1,i) ) * ( diss(k,j+1,i)-diss(k,j,i) )                &
-                        - ( km(k,j,i)+km(k,j-1,i) ) * ( diss(k,j,i)-diss(k,j-1,i) ) ) * ddy2       &
-                      + ( ( km(k,j,i)+km(k+1,j,i) ) * ( diss(k+1,j,i)-diss(k,j,i) )                &
-                          * ddzu(k+1) * rho_air_zw(k)                                              &
-                        - ( km(k,j,i)+km(k-1,j,i) ) * ( diss(k,j,i)-diss(k-1,j,i) )                &
-                          * ddzu(k) * rho_air_zw(k-1) ) * ddzw(k) * drho_air(k)                    &
-                      )  * flag * dsig_diss - c_2 * diss(k,j,i)**2 / ( e(k,j,i) + 1.0E-20_wp )     &
-                         * flag
-
-    ENDDO
-
- END SUBROUTINE diffusion_diss_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computation of the turbulent diffusion coefficients for momentum and heat.
-!> @bug unstable stratification is not properly considered for kh in rans mode.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_diffusivities( var, var_reference )
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_radiation_l,                                                                     &
-               bc_radiation_n,                                                                     &
-               bc_radiation_r,                                                                     &
-               bc_radiation_s,                                                                     &
-               e_min
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    USE surface_layer_fluxes_mod,                                                                  &
-        ONLY:  phi_m
-
-    INTEGER(iwp) ::  i  !< loop index
-    INTEGER(iwp) ::  j  !< loop index
-    INTEGER(iwp) ::  k  !< loop index
-    INTEGER(iwp) ::  l  !< loop index
-    INTEGER(iwp) ::  m  !< loop index
-
-    REAL(wp) ::  var_reference  !< reference temperature
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  var  !< temperature
-
-
-!
-!-- Introduce an optional minimum tke
-    IF ( e_min > 0.0_wp )  THEN
-       !$OMP PARALLEL DO PRIVATE(i,j,k)
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-             DO  k = nzb+1, nzt
-                e(k,j,i) = MAX( e(k,j,i), e_min ) *                                                &
-                        MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
-!
-!-- Call default diffusivities routine. This is always used to calculate kh.
-    CALL tcm_diffusivities_default( var, var_reference )
-!
-!-- Call dynamic subgrid model to calculate km.
-    IF ( les_dynamic )  THEN
-       CALL tcm_diffusivities_dynamic
-    ENDIF
-
-!
-!-- In RANS mode, use MOST to calculate km and kh within the surface layer.
-    IF ( rans_tke_e )  THEN
-!
-!--    Upward facing surfaces
-!--    Default surfaces
-       DO l = 0, 1
-          !$OMP PARALLEL DO PRIVATE(i,j,k,m)
-          DO  m = 1, surf_def_h(l)%ns
-             i = surf_def_h(l)%i(m)
-             j = surf_def_h(l)%j(m)
-             k = surf_def_h(l)%k(m)
-             km(k,j,i) = kappa * surf_def_h(l)%us(m) * surf_def_h(l)%z_mo(m) /                        &
-                         phi_m( surf_def_h(l)%z_mo(m) / surf_def_h(l)%ol(m) )
-             kh(k,j,i) = 1.35_wp * km(k,j,i)
-          ENDDO
-!
-!--       Natural surfaces
-          !$OMP PARALLEL DO PRIVATE(i,j,k,m)
-          DO  m = 1, surf_lsm_h(l)%ns
-             i = surf_lsm_h(l)%i(m)
-             j = surf_lsm_h(l)%j(m)
-             k = surf_lsm_h(l)%k(m)
-             km(k,j,i) = kappa * surf_lsm_h(l)%us(m) * surf_lsm_h(l)%z_mo(m) /                              &
-                         phi_m( surf_lsm_h(l)%z_mo(m) / surf_lsm_h(l)%ol(m) )
-             kh(k,j,i) = 1.35_wp * km(k,j,i)
-          ENDDO
-!
-!--       Urban surfaces
-          !$OMP PARALLEL DO PRIVATE(i,j,k,m)
-          DO  m = 1, surf_usm_h(l)%ns
-             i = surf_usm_h(l)%i(m)
-             j = surf_usm_h(l)%j(m)
-             k = surf_usm_h(l)%k(m)
-             km(k,j,i) = kappa * surf_usm_h(l)%us(m) * surf_usm_h(l)%z_mo(m) /                              &
-                         phi_m( surf_usm_h(l)%z_mo(m) / surf_usm_h(l)%ol(m) )
-             kh(k,j,i) = 1.35_wp * km(k,j,i)
-          ENDDO
-       ENDDO
-!
-!--    North-, south-, west and eastward facing surfaces
-!--    Do not consider stratification at these surfaces.
-       DO  l = 0, 3
-!
-!--       Default surfaces
-          !$OMP PARALLEL DO PRIVATE(i,j,k,m)
-          DO  m = 1, surf_def_v(l)%ns
-             i = surf_def_v(l)%i(m)
-             j = surf_def_v(l)%j(m)
-             k = surf_def_v(l)%k(m)
-             km(k,j,i) = kappa * surf_def_v(l)%us(m) * surf_def_v(l)%z_mo(m)
-             kh(k,j,i) = 1.35_wp * km(k,j,i)
-          ENDDO
-!
-!--       Natural surfaces
-          !$OMP PARALLEL DO PRIVATE(i,j,k,m)
-          DO  m = 1, surf_lsm_v(l)%ns
-             i = surf_lsm_v(l)%i(m)
-             j = surf_lsm_v(l)%j(m)
-             k = surf_lsm_v(l)%k(m)
-             km(k,j,i) = kappa * surf_lsm_v(l)%us(m) * surf_lsm_v(l)%z_mo(m)
-             kh(k,j,i) = 1.35_wp * km(k,j,i)
-          ENDDO
-!
-!--       Urban surfaces
-          !$OMP PARALLEL DO PRIVATE(i,j,k,m)
-          DO  m = 1, surf_usm_v(l)%ns
-             i = surf_usm_v(l)%i(m)
-             j = surf_usm_v(l)%j(m)
-             k = surf_usm_v(l)%k(m)
-             km(k,j,i) = kappa * surf_usm_v(l)%us(m) * surf_usm_v(l)%z_mo(m)
-             kh(k,j,i) = 1.35_wp * km(k,j,i)
-          ENDDO
-       ENDDO
-
-       CALL exchange_horiz( km, nbgp )
-       CALL exchange_horiz( kh, nbgp )
-
-    ENDIF
-!
-!-- Set boundary values (Neumann conditions)
-!-- Downward facing surfaces
-    !$OMP PARALLEL DO PRIVATE(i,j,k)
-    !$ACC PARALLEL LOOP PRIVATE(i,j,k) &
-    !$ACC PRESENT(bc_h(1), kh, km)
-    DO  m = 1, bc_h(1)%ns
-       i = bc_h(1)%i(m)
-       j = bc_h(1)%j(m)
-       k = bc_h(1)%k(m)
-       km(k+1,j,i) = km(k,j,i)
-       kh(k+1,j,i) = kh(k,j,i)
-    ENDDO
-!
-!-- Downward facing surfaces
-    !$OMP PARALLEL DO PRIVATE(i,j,k)
-    !$ACC PARALLEL LOOP PRIVATE(i,j,k) &
-    !$ACC PRESENT(bc_h(0), kh, km)
-    DO  m = 1, bc_h(0)%ns
-       i = bc_h(0)%i(m)
-       j = bc_h(0)%j(m)
-       k = bc_h(0)%k(m)
-       km(k-1,j,i) = km(k,j,i)
-       kh(k-1,j,i) = kh(k,j,i)
-    ENDDO
-!
-!-- Model top
-    !$OMP PARALLEL DO
-    !$ACC PARALLEL LOOP COLLAPSE(2) &
-    !$ACC PRESENT(kh, km)
-    DO  i = nxlg, nxrg
-       DO  j = nysg, nyng
-          km(nzt+1,j,i) = km(nzt,j,i)
-          kh(nzt+1,j,i) = kh(nzt,j,i)
-       ENDDO
-    ENDDO
-
-!
-!-- Set Neumann boundary conditions at the outflow boundaries in case of non-cyclic lateral
-!-- boundaries
-    IF ( bc_radiation_l )  THEN
-       km(:,:,nxl-1) = km(:,:,nxl)
-       kh(:,:,nxl-1) = kh(:,:,nxl)
-    ENDIF
-    IF ( bc_radiation_r )  THEN
-       km(:,:,nxr+1) = km(:,:,nxr)
-       kh(:,:,nxr+1) = kh(:,:,nxr)
-    ENDIF
-    IF ( bc_radiation_s )  THEN
-       km(:,nys-1,:) = km(:,nys,:)
-       kh(:,nys-1,:) = kh(:,nys,:)
-    ENDIF
-    IF ( bc_radiation_n )  THEN
-       km(:,nyn+1,:) = km(:,nyn,:)
-       kh(:,nyn+1,:) = kh(:,nyn,:)
-    ENDIF
-
- END SUBROUTINE tcm_diffusivities
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Computation of the turbulent diffusion coefficients for momentum and heat according to
-!> Prandtl-Kolmogorov.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_diffusivities_default( var, var_reference )
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dd2zu
-
-    USE control_parameters,                                                                        &
-        ONLY:  atmos_ocean_sign,                                                                   &
-               use_single_reference_value
-
-    USE statistics,                                                                                &
-        ONLY :  rmask,                                                                             &
-                sums_l_l
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                   !< loop index
-    INTEGER(iwp) ::  j                   !< loop index
-    INTEGER(iwp) ::  k                   !< loop index
-!$  INTEGER(iwp) ::  omp_get_thread_num  !< opemmp function to get thread number
-    INTEGER(iwp) ::  sr                  !< statistic region
-    INTEGER(iwp) ::  tn                  !< thread number
-
-    REAL(wp)     ::  duv2_dz2            !< squared vertical gradient of wind vector
-    REAL(wp)     ::  dvar_dz             !< vertical gradient of var
-    REAL(wp)     ::  ml                  !< mixing length (single height)
-    REAL(wp)     ::  var_reference       !< reference temperature
-
-    !DIR$ ATTRIBUTES ALIGN:64:: ml_local_profile, ml_stratification, richardson_number
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  ml_local_profile   !< mixing length (all heights)
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  ml_stratification  !< mixing length according to stratification
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  richardson_number  !< gradient Richardson number
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  var  !< temperature
-
-!
-!-- Default thread number in case of one thread
-    tn = 0
-
-!
-!-- Initialization for calculation of the mixing length profile
-    !$ACC KERNELS PRESENT(sums_l_l)
-    sums_l_l = 0.0_wp
-    !$ACC END KERNELS
-
-!
-!-- Compute the turbulent diffusion coefficient for momentum
-    !$OMP PARALLEL PRIVATE (dvar_dz,duv2_dz2,i,j,k,ml,ml_local_profile,ml_stratification,          &
-    !$OMP                   richardson_number,sr,tn)
-!$  tn = omp_get_thread_num()
-
-    IF ( les_default  .OR.  les_dynamic )  THEN
-       !$OMP DO
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
-       !$ACC PRIVATE(dvar_dz, ml, ml_stratification, ml_local_profile) &
-       !$ACC PRESENT(wall_flags_total_0, var, dd2zu, e, delta) &
-       !$ACC PRESENT(kh, km, sums_l_l, rmask)
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-             !$ACC LOOP PRIVATE(k)
-             DO  k = nzb+1, nzt
-!
-!--             Determine the mixing length
-!--             @note The following code cannot be transferred to a subroutine due to errors when
-!--             using OpenACC directives. The execution crashes reliably if a subroutine is called
-!--             at this point (the reason for this behaviour is unknown, however).
-                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
-                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
-#if defined( __imuk_old )
-                                             / SQRT( g / var_reference *                           &
-                                             ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! required for intel14
-#else
-                                             / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-#endif
-                   ELSE
-                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
-#if defined( __imuk_old )
-                                             / SQRT( g / var(k,j,i) *                              &
-                                             ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! required for intel14
-#else
-                                             / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-#endif
-                   ENDIF
-                ELSE
-                   ml_stratification(k) = delta(k,j,i)
-                ENDIF
-
-             ENDDO
-
-             !$ACC LOOP PRIVATE(k)
-             !DIR$ IVDEP
-             DO  k = nzb+1, nzt
-
-                ml = MIN( delta(k,j,i), ml_stratification(k) )                                     &
-                   * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                ml_local_profile(k) = ml
-!
-!--             Compute diffusion coefficients for momentum and heat
-                km(k,j,i) = c_0 * ml * SQRT( e(k,j,i) )
-                kh(k,j,i) = ( 1.0_wp + 2.0_wp * ml / delta(k,j,i) ) * km(k,j,i)
-
-             ENDDO
-!
-!--          Summation for averaged profile (cf. flow_statistics)
-             !$ACC LOOP PRIVATE(sr, k)
-             DO  sr = 0, statistic_regions
-                DO  k = nzb+1, nzt
-                   sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + ml_local_profile(k) * rmask(j,i,sr)
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ELSEIF ( les_dai )  THEN
-       !$OMP DO
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
-       !$ACC PRIVATE(dvar_dz, ml, ml_stratification, ml_local_profile) &
-       !$ACC PRESENT(wall_flags_total_0, var, dd2zu, e, delta) &
-       !$ACC PRESENT(kh, km, sums_l_l, rmask)
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-             !$ACC LOOP PRIVATE(k)
-             DO  k = nzb+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
-!
-!--                The mixing length is calculated as 1/l = 1/(kappa*z) + 1/Lb, where Lb is the
-!--                stratification term. 1E-5 is added as l is zero at the beginning of the
-!--                simulation.
-                   IF ( use_single_reference_value )  THEN
-                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
-#if defined( __imuk_old )
-                                             / SQRT( g / var_reference *                           &
-                                             ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! Required for intel14
-#else
-                                             / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-#endif
-                   ELSE
-                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
-#if defined( __imuk_old )
-                                             / SQRT( g / var(k,j,i) *                              &
-                                             ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! Required for intel14
-#else
-                                             / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-#endif
-                   ENDIF
-
-                   ml_stratification(k) = 1.0_wp / ( 1.0_wp / ( kappa * distance_to_wall(k,j,i) )  &
-                                        + 1.0_wp / ml_stratification(k) )
-                ELSE
-                   ml_stratification(k) = delta(k,j,i)
-                ENDIF
-
-             ENDDO
-
-             !$ACC LOOP PRIVATE(k)
-             !DIR$ IVDEP
-             DO  k = nzb+1, nzt
-
-                ml_local_profile(k) = ml_stratification(k) *                                       &
-                                      MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                ml  = ml_local_profile(k)
-!
-!--             Compute diffusion coefficients for momentum and heat
-                km(k,j,i) = c_0 * ml * SQRT( e(k,j,i) )
-
-                dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-                IF ( dvar_dz > 0.0_wp )  THEN
-                   kh(k,j,i) = km(k,j,i)
-                ELSE
-                   kh(k,j,i) = 3.0_wp * km(k,j,i)
-                ENDIF
-
-             ENDDO
-!
-!--          Summation for averaged profile (cf. flow_statistics)
-             !$ACC LOOP PRIVATE(sr, k)
-             DO  sr = 0, statistic_regions
-                DO  k = nzb+1, nzt
-                   sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + ml_local_profile(k) * rmask(j,i,sr)
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ELSEIF ( rans_tke_l )  THEN
-
-       !$OMP DO
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
-       !$ACC PRIVATE(dvar_dz, duv2_dz2, ml_stratification, ml_local_profile, richardson_number) &
-       !$ACC PRESENT(wall_flags_total_0, var, dd2zu, e, u, v, delta, ml_blackadar) &
-       !$ACC PRESENT(kh, km, sums_l_l, rmask)
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-!
-!--          Calculate Richardson number
-             IF ( use_single_reference_value )  THEN
-                !$ACC LOOP PRIVATE(k)
-                !DIR$ IVDEP
-                DO  k = nzb+1, nzt
-                   dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-
-                   duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                        &
-                            + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
-
-                   richardson_number(k) = MIN( MAX( g / var_reference * dvar_dz / duv2_dz2,        &
-                                                    -5.0_wp ),                                     &
-                                               1.0_wp )
-                ENDDO
-             ELSE
-                !$ACC LOOP PRIVATE(k)
-                !DIR$ IVDEP
-                DO  k = nzb+1, nzt
-                   dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-
-                   duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                        &
-                            + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
-
-                   richardson_number(k) = MIN( MAX( g / var(k,j,i) * dvar_dz / duv2_dz2,           &
-                                                    -5.0_wp ),                                     &
-                                               1.0_wp )
-                ENDDO
-             ENDIF
-!
-!--          Calculate diabatic mixing length using Dyer-profile functions
-!--          In case of unstable stratification, use mixing length of neutral case
-             !$ACC LOOP PRIVATE(k)
-             DO  k = nzb+1, nzt
-                IF ( richardson_number(k) >= 0.0_wp )  THEN
-                   ml_stratification(k) = ml_blackadar(k)                                          &
-                                        / ( 1.0_wp + 5.0_wp * richardson_number(k) )
-                ELSE
-                   ml_stratification(k) = ml_blackadar(k)
-                ENDIF
-
-             ENDDO
-!
-!--          Compute diffusion coefficients for momentum and heat
-             !$ACC LOOP PRIVATE(k)
-             !DIR$ IVDEP
-             DO  k = nzb+1, nzt
-                ml_local_profile(k) = MIN( ml_stratification(k), delta(k,j,i) )                    &
-                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                km(k,j,i) = c_0 * ml_local_profile(k) * SQRT( e(k,j,i) )
-                kh(k,j,i) = km(k,j,i) / prandtl_number
-             ENDDO
-!
-!--          Summation for averaged profile (cf. flow_statistics)
-             !$ACC LOOP PRIVATE(sr, k)
-             DO  sr = 0, statistic_regions
-                DO  k = nzb+1, nzt
-                   sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + ml_local_profile(k) * rmask(j,i,sr)
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ELSEIF ( rans_tke_e )  THEN
-
-       !$OMP DO
-       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
-       !$ACC PRIVATE(ml_local_profile) &
-       !$ACC PRESENT(wall_flags_total_0, e, diss, rmask) &
-       !$ACC PRESENT(kh, km, sums_l_l)
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-!
-!--          Compute diffusion coefficients for momentum and heat
-             !$ACC LOOP PRIVATE(k)
-             !DIR$ IVDEP
-             DO  k = nzb+1, nzt
-
-                ml_local_profile(k) = c_0**3 * e(k,j,i) * SQRT(e(k,j,i))                           &
-                                    / ( diss(k,j,i) + 1.0E-30_wp )                                 &
-                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-                km(k,j,i) = c_0 * SQRT( e(k,j,i) ) * ml_local_profile(k)
-                kh(k,j,i) = km(k,j,i) / prandtl_number
-
-             ENDDO
-!
-!--          Summation for averaged profile of mixing length (cf. flow_statistics)
-             !$ACC LOOP PRIVATE(sr, k)
-             DO  sr = 0, statistic_regions
-                DO  k = nzb+1, nzt
-                   sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + ml_local_profile(k) * rmask(j,i,sr)
-                ENDDO
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-    !$ACC KERNELS PRESENT(sums_l_l)
-    sums_l_l(nzt+1,:,tn) = sums_l_l(nzt,:,tn)   ! Quasi boundary-condition for
-                                                ! Data output
-    !$ACC END KERNELS
-    !$OMP END PARALLEL
-
- END SUBROUTINE tcm_diffusivities_default
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates the eddy viscosity dynamically using the linear dynamic model according to
-!> Heinz, Stefan. "Realizability of dynamic subgrid-scale stress models via stochastic analysis."
-!> Monte Carlo Methods and Applications 14.4 (2008): 311-329.
-!>
-!> Furthermore dynamic bounds are used to limit the absolute value of c* as described in
-!> Mokhtarpoor, Reza, and Stefan Heinz. "Dynamic large eddy simulation: Stability via realizability."
-!> Physics of Fluids 29.10 (2017): 105104.
-!>
-!> @author Hauke Wurps
-!> @author BjÃ¶rn Maronga
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_diffusivities_dynamic
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzw,                                                                               &
-               dzw,                                                                                &
-               dd2zu,                                                                              &
-               ug,                                                                                 &
-               vg,                                                                                 &
-               w
-
-    USE grid_variables,                                                                            &
-        ONLY : ddx,                                                                                &
-               ddy,                                                                                &
-               dx,                                                                                 &
-               dy
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i     !< running index x-direction
-    INTEGER(iwp) ::  j     !< running index y-direction
-    INTEGER(iwp) ::  k     !< running index z-direction
-    INTEGER(iwp) ::  l     !< running index
-    INTEGER(iwp) ::  m     !< running index
-
-    REAL(wp)     ::  cst        !< c*
-    REAL(wp)     ::  cstnust_t  !< product c*nu*
-    REAL(wp)     ::  cst_max    !< bounds of c*
-    REAL(wp)     ::  delta_max  !< maximum of the grid spacings
-
-    REAL(wp)     ::  dudx  !< Gradient of u-component in x-direction
-    REAL(wp)     ::  dudy  !< Gradient of u-component in y-direction
-    REAL(wp)     ::  dudz  !< Gradient of u-component in z-direction
-    REAL(wp)     ::  dvdx  !< Gradient of v-component in x-direction
-    REAL(wp)     ::  dvdy  !< Gradient of v-component in y-direction
-    REAL(wp)     ::  dvdz  !< Gradient of v-component in z-direction
-    REAL(wp)     ::  dwdx  !< Gradient of w-component in x-direction
-    REAL(wp)     ::  dwdy  !< Gradient of w-component in y-direction
-    REAL(wp)     ::  dwdz  !< Gradient of w-component in z-direction
-
-    REAL(wp)     ::  flag  !< topography flag
-
-    REAL(wp)     ::  uc(-1:1,-1:1)  !< u on grid center
-    REAL(wp)     ::  vc(-1:1,-1:1)  !< v on grid center
-    REAL(wp)     ::  wc(-1:1,-1:1)  !< w on grid center
-
-    REAL(wp)     ::  ut(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !< test filtered u
-    REAL(wp)     ::  vt(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !< test filtered v
-    REAL(wp)     ::  wt(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !< test filtered w
-
-    REAL(wp)     ::  uct    !< test filtered u on grid center
-    REAL(wp)     ::  vct    !< test filtered v on grid center
-    REAL(wp)     ::  wct    !< test filtered w on grid center
-    REAL(wp)     ::  u2t    !< test filtered u**2 on grid center
-    REAL(wp)     ::  v2t    !< test filtered v**2 on grid center
-    REAL(wp)     ::  w2t    !< test filtered w**2 on grid center
-    REAL(wp)     ::  uvt    !< test filtered u*v on grid center
-    REAL(wp)     ::  uwt    !< test filtered u*w on grid center
-    REAL(wp)     ::  vwt    !< test filtered v*w on grid center
-
-    REAL(wp)     ::  sd11   !< deviatoric shear tensor
-    REAL(wp)     ::  sd22   !< deviatoric shear tensor
-    REAL(wp)     ::  sd33   !<f deviatoric shear tensor
-    REAL(wp)     ::  sd12   !< deviatoric shear tensor
-    REAL(wp)     ::  sd13   !< deviatoric shear tensor
-    REAL(wp)     ::  sd23   !< deviatoric shear tensor
-
-    REAL(wp)     ::  sd2    !< sum: sd_ij*sd_ij
-
-    REAL(wp)     ::  sdt11  !< filtered deviatoric shear tensor
-    REAL(wp)     ::  sdt22  !< filtered deviatoric shear tensor
-    REAL(wp)     ::  sdt33  !< filtered deviatoric shear tensor
-    REAL(wp)     ::  sdt12  !< filtered deviatoric shear tensor
-    REAL(wp)     ::  sdt13  !< filtered deviatoric shear tensor
-    REAL(wp)     ::  sdt23  !< filtered deviatoric shear tensor
-
-    REAL(wp)     ::  sdt2   !< sum: sdt_ij*sdt_ij
-
-    REAL(wp)     ::  ld11   !< deviatoric stress tensor
-    REAL(wp)     ::  ld22   !< deviatoric stress tensor
-    REAL(wp)     ::  ld33   !< deviatoric stress tensor
-    REAL(wp)     ::  ld12   !< deviatoric stress tensor
-    REAL(wp)     ::  ld13   !< deviatoric stress tensor
-    REAL(wp)     ::  ld23   !< deviatoric stress tensor
-
-    REAL(wp)     ::  lnn    !< sum ld_nn
-    REAL(wp)     ::  ldsd   !< sum: ld_ij*sd_ij
-
-
-    REAL(wp), PARAMETER :: fac_cmax = 23.0_wp / ( 24.0_wp * SQRT (3.0_wp) )  !< constant
-
-!
-!-- Velocities on grid centers:
-    CALL tcm_box_filter_2d_array( u, ut )
-    CALL tcm_box_filter_2d_array( v, vt )
-    CALL tcm_box_filter_2d_array( w, wt )
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
-
-!
-!--          Compute the deviatoric shear tensor s_ij on grid centers:
-!--          s_ij =  0.5 * ( du_i/dx_j + du_j/dx_i )
-             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)
-
-             sd11 = dudx
-             sd22 = dvdy
-             sd33 = dwdz
-             sd12 = 0.5_wp * ( dudy + dvdx )
-             sd13 = 0.5_wp * ( dudz + dwdx )
-             sd23 = 0.5_wp * ( dvdz + dwdy )
-!
-!--          sum: sd_ij*sd_ij
-             sd2 = sd11**2 + sd22**2 + sd33**2 + 2.0_wp * ( sd12**2 + sd13**2 + sd23**2 )
-!
-!--          The filtered velocities are needed to calculate the filtered shear tensor:
-!--          sdt_ij = 0.5 * ( dut_i/dx_j + dut_j/dx_i )
-             dudx  =           ( ut(k,j,i+1) - ut(k,j,i)      ) * ddx
-             dudy  = 0.25_wp * ( ut(k,j+1,i) + ut(k,j+1,i+1) - ut(k,j-1,i) - ut(k,j-1,i+1) ) * ddy
-             dudz  = 0.5_wp  * ( ut(k+1,j,i) + ut(k+1,j,i+1) -                                     &
-                                 ut(k-1,j,i) - ut(k-1,j,i+1)  ) * dd2zu(k)
-
-             dvdx  = 0.25_wp * ( vt(k,j,i+1) + vt(k,j+1,i+1) - vt(k,j,i-1) - vt(k,j+1,i-1) ) * ddx
-             dvdy  =           ( vt(k,j+1,i) - vt(k,j,i)     ) * ddy
-             dvdz  = 0.5_wp  * ( vt(k+1,j,i) + vt(k+1,j+1,i) -                                     &
-                                 vt(k-1,j,i) - vt(k-1,j+1,i) ) * dd2zu(k)
-
-             dwdx  = 0.25_wp * ( wt(k,j,i+1) + wt(k-1,j,i+1) - wt(k,j,i-1) - wt(k-1,j,i-1) ) * ddx
-             dwdy  = 0.25_wp * ( wt(k,j+1,i) + wt(k-1,j+1,i) - wt(k,j-1,i) - wt(k-1,j-1,i) ) * ddy
-             dwdz  =           ( wt(k,j,i)   - wt(k-1,j,i)  ) * ddzw(k)
-
-             sdt11 = dudx
-             sdt22 = dvdy
-             sdt33 = dwdz
-             sdt12 = 0.5_wp * ( dudy + dvdx )
-             sdt13 = 0.5_wp * ( dudz + dwdx )
-             sdt23 = 0.5_wp * ( dvdz + dwdy )
-!
-!--          sum: sd_ij*sd_ij
-             sdt2 = sdt11**2 + sdt22**2 + sdt33**2 + 2.0_wp * ( sdt12**2 + sdt13**2 + sdt23**2 )
-!
-!--          Need filtered velocities and filtered squared velocities on grid centers. Substraction
-!--          of geostrophic velocity helps to avoid numerical errors in the expression
-!--          <u**2> - <u>*<u>, which can be very small (<...> means filtered).
-             DO  l = -1, 1
-                DO  m = -1, 1
-                   uc(l,m) = 0.5_wp * ( u(k,j+l,i+m) + u(k,j+l,i+m+1) ) - ug(k)
-                   vc(l,m) = 0.5_wp * ( v(k,j+l,i+m) + v(k,j+l+1,i+m) ) - vg(k)
-                   wc(l,m) = 0.5_wp * ( w(k-1,j+l,i+m) + w(k,j+l,i+m) )
-                ENDDO
-             ENDDO
-
-             CALL tcm_box_filter_2d_single( uc, uct )
-             CALL tcm_box_filter_2d_single( vc, vct )
-             CALL tcm_box_filter_2d_single( wc, wct )
-             CALL tcm_box_filter_2d_single( uc**2, u2t )
-             CALL tcm_box_filter_2d_single( vc**2, v2t )
-             CALL tcm_box_filter_2d_single( wc**2, w2t )
-             CALL tcm_box_filter_2d_single( uc*vc, uvt )
-             CALL tcm_box_filter_2d_single( uc*wc, uwt )
-             CALL tcm_box_filter_2d_single( vc*wc, vwt )
-
-             ld11 = u2t - uct*uct
-             ld22 = v2t - vct*vct
-             ld33 = w2t - wct*wct
-             ld12 = uvt - uct*vct
-             ld13 = uwt - uct*wct
-             ld23 = vwt - vct*wct
-
-             lnn = ld11 + ld22 + ld33
-!
-!--          Substract trace to get deviatoric resolved stress
-             ld11 = ld11 - lnn / 3.0_wp
-             ld22 = ld22 - lnn / 3.0_wp
-             ld33 = ld33 - lnn / 3.0_wp
-
-             ldsd = ld11 * sdt11 + ld22 * sdt22 + ld33 * sdt33 + 2.0_wp *                          &
-                  ( ld12 * sdt12 + ld13 * sdt13 + ld23 * sdt23 )
-!
-!--          c* nu*^T is SGS viscosity on test filter level:
-             cstnust_t = -ldsd / ( sdt2 + 1.0E-20_wp )
-!
-!--          The model was only tested for an isotropic grid. The following expression was a
-!--          recommendation of Stefan Heinz.
-             delta_max = MAX( dx, dy, dzw(k) )
-
-             IF ( lnn <= 0.0_wp )  THEN
-                cst = 0.0_wp
-             ELSE
-                cst = cstnust_t / ( 4.0_wp * delta_max * SQRT( lnn / 2.0_wp ) + 1.0E-20_wp )
-             ENDIF
-
-!
-!--          Calculate border according to Mokhtarpoor and Heinz (2017)
-             cst_max = fac_cmax * SQRT( e(k,j,i) ) /                                               &
-                       ( delta_max * SQRT( 2.0_wp * sd2 ) + 1.0E-20_wp )
-
-             IF ( ABS( cst ) > cst_max )  THEN
-                cst = cst_max * cst / ABS( cst )
-             ENDIF
-
-             km(k,j,i) = cst * delta_max * SQRT( e(k,j,i) ) * flag
-
-          ENDDO
-       ENDDO
-    ENDDO
-
- END SUBROUTINE tcm_diffusivities_dynamic
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine acts as a box filter with filter width 2 * dx. Output is only one point.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_box_filter_2d_single( var, var_fil )
-
-    IMPLICIT NONE
-
-    REAL(wp)     ::  var(-1:1,-1:1)  !< variable to be filtered
-    REAL(wp)     ::  var_fil         !< filtered variable
-!
-!-- It is assumed that a box with a side length of 2 * dx and centered at the variable*s position
-!-- contains one half of the four closest neigbours and one forth of the diagonally closest
-!-- neighbours.
-    var_fil = 0.25_wp * ( var(0,0) + 0.5_wp * ( var(0,1) + var(1,0) + var(0,-1) + var(-1,0) ) +    &
-                          0.25_wp * ( var(1,1) + var(1,-1) + var(-1,1) + var(-1,-1) ) )
-
- END SUBROUTINE tcm_box_filter_2d_single
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine acts as a box filter with filter width 2 * dx. The filtered variable var_fil is
-!> on the same grid as var.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_box_filter_2d_array( var, var_fil )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< running index x-direction
-    INTEGER(iwp) ::  j  !< running index y-direction
-    INTEGER(iwp) ::  k  !< running index z-direction
-
-    REAL(wp)     ::  var(nzb:nzt+1,nysg:nyng,nxlg:nxrg)      !< variable to be filtered
-    REAL(wp)     ::  var_fil(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !< filtered variable
-!
-!-- It is assumed that a box with a side length of 2 * dx and centered at the variable's position
-!-- contains one half of the four closest neigbours and one forth of the diagonally closest
-!-- neighbours.
-    DO  i = nxlg+1, nxrg-1
-       DO  j = nysg+1, nyng-1
-          DO  k = nzb, nzt+1
-             var_fil(k,j,i) = 0.25_wp * ( var(k,j,i) + 0.5_wp * ( var(k,j,i+1) + var(k,j+1,i) +    &
-                                          var(k,j,i-1) + var(k,j-1,i) ) + 0.25_wp *                &
-                                        ( var(k,j+1,i+1) + var(k,j+1,i-1) +                        &
-                                          var(k,j-1,i+1) + var(k,j-1,i-1) ) )
-          END DO
-       END DO
-    END DO
-
- END SUBROUTINE tcm_box_filter_2d_array
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Swapping of timelevels.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE tcm_swap_timelevel ( mod_count )
-
-    IMPLICIT NONE
-
-
-    INTEGER, INTENT(IN) ::  mod_count  !< Flag defining where pointers point to
-
-
-    SELECT CASE ( mod_count )
-
-       CASE ( 0 )
-
-          IF ( .NOT. constant_diffusion )  THEN
-             e => e_1;    e_p => e_2
-          ENDIF
-
-          IF ( rans_tke_e )  THEN
-             diss => diss_1;    diss_p => diss_2
-          ENDIF
-
-       CASE ( 1 )
-
-          IF ( .NOT. constant_diffusion )  THEN
-             e => e_2;    e_p => e_1
-          ENDIF
-
-          IF ( rans_tke_e )  THEN
-             diss => diss_2;    diss_p => diss_1
-          ENDIF
-
-    END SELECT
-
- END SUBROUTINE tcm_swap_timelevel
-
-
- END MODULE turbulence_closure_mod
Index: palm/trunk/SOURCE/urban_surface_mod.f90
===================================================================
--- palm/trunk/SOURCE/urban_surface_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,8720 +1,0 @@
-!> @file urban_surface_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2015-2021 Czech Technical University in Prague
-! Copyright 2015-2021 Institute of Computer Science of the Czech Academy of Sciences, Prague
-! Copyright 1997-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! revised output of surface data via MPI-IO for better performance
-!
-! 4872 2021-02-12 15:49:02Z raasch
-! internal switch removed from namelist
-!
-! 4850 2021-01-21 17:59:25Z suehring
-! - Add restart data for previous indoor temperature
-! - Bugfix in mpi-io restart mechanism for waste-heat flux
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4831 2021-01-06 17:55:14Z suehring
-! Bugfix in checking output variables with suffix indicating the surface facing
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Deactivated A/C cooling capacity for office buildings built before year 2000.
-!
-! 4783 2020-11-13 13:58:45Z raasch
-! - Default building parameters updated and extended (responsible: S. Rissmann)
-! - First and second wall layer initialized with individual building properties rather than with
-!   with the same properties (heat capacity and conductivity)
-!
-! 4780 2020-11-10 11:17:10Z suehring
-! Enable 3D data output also with 64-bit precision
-!
-! 4750 2020-10-16 14:27:48Z suehring
-! - bugfix in openmp directive
-! - make t_green_h and t_green_v public (required in indoor model)
-!
-! 4747 2020-10-16 09:19:57Z pavelkrc
-! Fix window absorptivity calculation (correctly account for 2-sided reflection)
-!
-! 4738 2020-10-14 08:05:07Z maronga
-! Updating building data base (on behalf of Sascha Rissmann)
-!
-! 4733 2020-10-09 12:24:16Z maronga
-! Bugfix in calculation of absored radiation by windows (reflected radiation was not taken into
-! account)
-!
-! 4721 2020-10-02 10:21:52Z suehring
-! Remove unused variables from USE statement
-!
-! 4717 2020-09-30 22:27:40Z pavelkrc
-! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
-! directives (J. Resler)
-!
-! 4713 2020-09-29 12:02:05Z pavelkrc
-! - Do not change original fractions in USM energy balance
-! - Correct OpenMP parallelization
-! Author: J. Resler
-!
-! 4701 2020-09-27 11:02:15Z maronga
-! Corrected parameter 33 for building_type 2 (ground floor window emissivity
-!
-! 4698 2020-09-25 08:37:55Z maronga
-! Bugfix in calculation of iwghf_eb and iwghf_eb_window (introduced in previous revisions)
-!
-! 4694 2020-09-23 15:09:19Z pavelkrc
-! Fix writing and reading of surface data to/from MPI restart file
-!
-! 4693 2020-09-22 19:47:04Z maronga
-! Bugfix for last commit
-!
-! 4692 2020-09-22 17:17:52Z maronga
-! Bugfix for previous revision
-!
-! 4687 2020-09-21 19:40:16Z
-! Optimized code structure for treatment of inner wall and window heat flux
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Radiative transfer model RTM version 4.1
-! - Implementation of downward facing USM and LSM surfaces
-! - Restructuralization EB call
-! - Improved debug logging
-! - Removal of deprecated CSV inputs
-! - Bugfixes
-! Author: J. Resler (Institute of Computer Science, Prague)
-!
-! 4669 2020-09-09 13:43:47Z pavelkrc
-! Fix calculation of force_radiation_call
-!
-! 4668 2020-09-09 13:00:16Z pavelkrc
-! Limit vertical r_a similarly to horizontal
-!
-! 4660 2020-09-01 14:49:39Z pavelkrc
-! Fix of wrong limitation of calculation of ueff (avoid r_a=inf) (J. Resler)
-!
-! 4653 2020-08-27 08:54:43Z pavelkrc
-! Remove separate direction indices for urban and land faces (part of RTM v4.0)
-!
-! 4630 2020-07-30 14:54:34Z suehring
-! - Bugfix in resistance calculation - avoid potential divisions by zero
-! - Minor formatting adjustment
-!
-! 4602 2020-07-14 14:49:45Z suehring
-! Add missing initialization of albedo type with values given from static input file
-!
-! 4581 2020-06-29 08:49:58Z suehring
-! Missing initialization in case of cyclic_fill runs
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO for reading local arrays
-!
-! 4510 2020-04-29 14:19:18Z raasch
-! Further re-formatting to follow the PALM coding standard
-!
-! 4509 2020-04-26 15:57:55Z raasch
-! File re-formatted to follow the PALM coding standard
-!
-! 4500 2020-04-17 10:12:45Z suehring
-! Allocate array for wall heat flux, which is further used to aggregate tile
-! fractions in the surface output
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! Restart data handling with MPI-IO added
-!
-! 4493 2020-04-10 09:49:43Z pavelkrc
-! J.Resler, 2020/03/19
-! - Remove reading of deprecated input parameters c_surface and lambda_surf
-! - And calculate them from parameters of the outer wall/roof layer
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! Use statement for exchange horiz added
-!
-! 4442 2020-03-04 19:21:13Z suehring
-! Change order of dimension in surface arrays %frac, %emissivity and %albedo to allow for better
-! vectorization in the radiation interactions.
-!
-! 4441 2020-03-04 19:20:35Z suehring
-! Removed wall_flags_static_0 from USE statements as it's not used within the module
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4309 2019-11-26 18:49:59Z suehring
-! - Bugfix, include m_liq into restarts
-! - Remove unused arrays for liquid water and saturation moisture at vertical walls
-!
-! 4305 2019-11-25 11:15:40Z suehring
-! Revision of some indoor-model parameters
-!
-! 4259 2019-10-09 10:05:22Z suehring
-! Instead of terminate the job in case the relative wall fractions do not sum-up to one, give only
-! an informative message and normalize the fractions.
-!
-! 4258 2019-10-07 13:29:08Z suehring
-! - Add checks to ensure that relative fractions of walls, windowns and green surfaces sum-up to one.
-! - Revise message calls dealing with local checks.
-!
-! 4245 2019-09-30 08:40:37Z pavelkrc
-! Initialize explicit per-surface parameters from building_surface_pars
-!
-! 4238 2019-09-25 16:06:01Z suehring
-! Indoor-model parameters for some building types adjusted in order to avoid unrealistically high
-! indoor temperatures (S. Rissmann)
-!
-! 4230 2019-09-11 13:58:14Z suehring
-! Bugfix, initialize canopy resistance. Even if no green fraction is set, r_canopy must be
-! initialized for output purposes.
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! Implement new palm_date_time_mod
-!
-! 4214 2019-09-02 15:57:02Z suehring
-! Bugfix, missing initialization and clearing of soil-moisture tendency (J.Resler)
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected 'Former revisions' section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 4148 2019-08-08 11:26:00Z suehring
-! - Add anthropogenic heat output factors for heating and cooling to building data base
-! - Move definition of building_pars to usm_init_arrays since it is already required in the indoor
-!   model
-!
-! 4127 2019-07-30 14:47:10Z suehring
-! Do not add anthopogenic energy during wall/soil spin-up (merge from branch resler)
-!
-! 4077 2019-07-09 13:27:11Z gronemeier
-! Set roughness length z0 and z0h/q at ground-floor level to same value as those above ground-floor
-! level
-!
-! 4051 2019-06-24 13:58:30Z suehring
-! Remove work-around for green surface fraction on buildings (do not set it zero)
-!
-! 4050 2019-06-24 13:57:27Z suehring
-! In order to avoid confusion with global control parameter, rename the USM-internal flag spinup
-! into during_spinup.
-!
-! 3987 2019-05-22 09:52:13Z kanani
-! Introduce alternative switch for debug output during timestepping
-!
-! 3943 2019-05-02 09:50:41Z maronga
-! Removed qsws_eb. Bugfix in calculation of qsws.
-!
-! 3933 2019-04-25 12:33:20Z kanani
-! Remove allocation of pt_2m, this is done in surface_mod now (surfaces%pt_2m)
-!
-! 3921 2019-04-18 14:21:10Z suehring
-! Undo accidentally commented initialization
-!
-! 3918 2019-04-18 13:33:11Z suehring
-! Set green fraction to zero also at vertical surfaces
-!
-! 3914 2019-04-17 16:02:02Z suehring
-! In order to obtain correct surface temperature during spinup set window fraction to zero
-! (only during spinup) instead of just disabling time-integration of window-surface temperature.
-!
-! 3901 2019-04-16 16:17:02Z suehring
-! Workaround - set green fraction to zero ( green-heat model crashes ).
-!
-! 3896 2019-04-15 10:10:17Z suehring
-!
-!
-! 3896 2019-04-15 10:10:17Z suehring
-! Bugfix, wrong index used for accessing building_pars from PIDS
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3882 2019-04-10 11:08:06Z suehring
-! Avoid different type kinds
-! Move definition of building-surface properties from declaration block to an extra routine
-!
-! 3881 2019-04-10 09:31:22Z suehring
-! Revise determination of local ground-floor level height.
-! Make level 3 initalization conform with Palm-input-data standard
-! Move output of albedo and emissivity to radiation module
-!
-! 3832 2019-03-28 13:16:58Z raasch
-! Instrumented with openmp directives
-!
-! 3824 2019-03-27 15:56:16Z pavelkrc
-! Remove unused imports
-!
-!
-! 3814 2019-03-26 08:40:31Z pavelkrc
-! Unused subroutine commented out
-!
-! 3769 2019-02-28 10:16:49Z moh.hefny
-! Removed unused variables
-!
-! 3767 2019-02-27 08:18:02Z raasch
-! Unused variables removed from rrd-subroutines parameter list
-!
-! 3748 2019-02-18 10:38:31Z suehring
-! Revise conversion of waste-heat flux (do not divide by air density, will be done in diffusion_s)
-!
-! 3745 2019-02-15 18:57:56Z suehring
-! - Remove internal flag indoor_model (is a global control parameter)
-! - Add waste heat from buildings to the kinmatic heat flux
-! - Consider waste heat in restart data
-! - Remove unused USE statements
-!
-! 3744 2019-02-15 18:38:58Z suehring
-! Fixed surface heat capacity in the building parameters convert the file back to unix format
-!
-! 3730 2019-02-11 11:26:47Z moh.hefny
-! Formatting and clean-up (rvtils)
-!
-! 3710 2019-01-30 18:11:19Z suehring
-! Check if building type is set within a valid range.
-!
-! 3705 2019-01-29 19:56:39Z suehring
-! Make nzb_wall public, required for virtual-measurements
-!
-! 3704 2019-01-29 19:51:41Z suehring
-! Some interface calls moved to module_interface + cleanup
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Implementation of the PALM module interface
-!
-! 2007 2016-08-24 15:47:17Z kanani
-! Initial revision
-!
-!
-! Description:
-! ------------
-! 2016/6/9 - Initial version of the USM (Urban Surface Model)
-!            authors: Jaroslav Resler, Pavel Krc (Czech Technical University in Prague and Institute
-!            of Computer Science of the Czech Academy of Sciences, Prague)
-!            with contributions: Michal Belda, Nina Benesova, Ondrej Vlcek
-!            partly inspired by PALM LSM (B. Maronga)
-!            parameterizations of Ra checked with TUF3D (E. S. Krayenhoff)
-!> Module for Urban Surface Model (USM)
-!> The module includes:
-!>    1. Radiation model with direct/diffuse radiation, shading, reflections and integration with
-!>       plant canopy
-!>    2. Wall and wall surface model
-!>    3. Surface layer energy balance
-!>    4. Anthropogenic heat (only from transportation so far)
-!>    5. Necessary auxiliary subroutines (reading inputs, writing outputs, restart simulations, ...)
-!> It also makes use of standard radiation and integrates it into urban surface model.
-!>
-!> Further work:
-!> -------------
-!> @todo Revise initialization when building_pars / building_surface_pars are provided -
-!>       intialization is not consistent to building_pars
-!> @todo Revise flux conversion in energy-balance solver
-!> @todo Check divisions in wtend (etc.) calculations for possible division by zero, e.g. in case
-!>       fraq(0,m) + fraq(1,m) = 0?!
-!> @todo Use unit 90 for OPEN/CLOSE of input files (FK)
-!--------------------------------------------------------------------------------------------------!
- MODULE urban_surface_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  exner,                                                                              &
-               hyp,                                                                                &
-               hyrho,                                                                              &
-               p,                                                                                  &
-               prr,                                                                                &
-               pt,                                                                                 &
-               q,                                                                                  &
-               ql,                                                                                 &
-               tend,                                                                               &
-               u,                                                                                  &
-               v,                                                                                  &
-               vpt,                                                                                &
-               w,                                                                                  &
-               zu
-
-    USE calc_mean_profile_mod,                                                                     &
-        ONLY:  calc_mean_profile
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  c_p,                                                                                &
-               degc_to_k,                                                                          &
-               g,                                                                                  &
-               kappa,                                                                              &
-               l_v,                                                                                &
-               magnus_tl,                                                                       &
-               pi,                                                                                 &
-               r_d,                                                                                &
-               rho_l,                                                                              &
-               sigma_sb
-
-    USE control_parameters,                                                                        &
-        ONLY:  average_count_3d,                                                                   &
-               coupling_char,                                                                      &
-               coupling_start_time,                                                                &
-               debug_output,                                                                       &
-               debug_output_timestep,                                                              &
-               debug_string,                                                                       &
-               dt_do3d,                                                                            &
-               dt_3d,                                                                              &
-               dz,                                                                                 &
-               end_time,                                                                           &
-               humidity,                                                                           &
-               indoor_model,                                                                       &
-               initializing_actions,                                                               &
-               intermediate_timestep_count,                                                        &
-               intermediate_timestep_count_max,                                                    &
-               io_blocks,                                                                          &
-               io_group,                                                                           &
-               large_scale_forcing,                                                                &
-               lsf_surf,                                                                           &
-               message_string,                                                                     &
-               pt_surface,                                                                         &
-               restart_data_format_output,                                                         &
-               surface_pressure,                                                                   &
-               time_since_reference_point,                                                         &
-               timestep_scheme,                                                                    &
-               topography,                                                                         &
-               tsc,                                                                                &
-               urban_surface,                                                                      &
-               varnamelength
-
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model,                                                                   &
-               precipitation
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point,                                                                          &
-               log_point_s
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx,                                                                                &
-               ddx2,                                                                               &
-               ddy,                                                                                &
-               ddy2,                                                                               &
-               dx,                                                                                 &
-               dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nnx,                                                                                &
-               nny,                                                                                &
-               nnz,                                                                                &
-               nx,                                                                                 &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               ny,                                                                                 &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               topo_top_ind
-
-    USE, INTRINSIC :: iso_c_binding
-
-    USE kinds
-
-    USE palm_date_time_mod,                                                                        &
-        ONLY:  get_date_time,                                                                      &
-               seconds_per_hour
-
-    USE pegrid
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  albedo_type,                                                                        &
-               dirname,                                                                            &
-               diridx,                                                                             &
-               dirint,                                                                             &
-               force_radiation_call,                                                               &
-               id,                                                                                 &
-               idown,                                                                              &
-               ieast,                                                                              &
-               inorth,                                                                             &
-               isouth,                                                                             &
-               iup,                                                                                &
-               iwest,                                                                              &
-               nd,                                                                                 &
-               nz_urban_b,                                                                         &
-               nz_urban_t,                                                                         &
-               radiation_interaction,                                                              &
-               radiation,                                                                          &
-               rad_lw_in,                                                                          &
-               rad_lw_out,                                                                         &
-               rad_sw_in,                                                                          &
-               rad_sw_out,                                                                         &
-               unscheduled_radiation_calls
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_surface_filetypes,                                                        &
-               rrd_mpi_io,                                                                         &
-               rrd_mpi_io_surface,                                                                 &
-               wrd_mpi_io,                                                                         &
-               wrd_mpi_io_surface
-
-    USE statistics,                                                                                &
-        ONLY:  hom,                                                                                &
-               statistic_regions
-
-    USE surface_mod,                                                                               &
-        ONLY:  ind_pav_green,                                                                      &
-               ind_veg_wall,                                                                       &
-               ind_wat_win,                                                                        &
-               surf_type,                                                                          &
-               surf_usm_h,                                                                         &
-               surf_usm_v,                                                                         &
-               surface_restore_elements
-
-
-    IMPLICIT NONE
-
-!
-!-- USM model constants
-
-    REAL(wp), PARAMETER ::  b_ch               = 6.04_wp    !< Clapp & Hornberger exponent
-    REAL(wp), PARAMETER ::  lambda_h_green_dry = 0.19_wp    !< heat conductivity for dry soil
-    REAL(wp), PARAMETER ::  lambda_h_green_sm  = 3.44_wp    !< heat conductivity of the soil matrix
-    REAL(wp), PARAMETER ::  lambda_h_water     = 0.57_wp    !< heat conductivity of water
-    REAL(wp), PARAMETER ::  psi_sat            = -0.388_wp  !< soil matrix potential at saturation
-    REAL(wp), PARAMETER ::  rho_c_soil         = 2.19E6_wp  !< volumetric heat capacity of soil
-    REAL(wp), PARAMETER ::  rho_c_water        = 4.20E6_wp  !< volumetric heat capacity of water
-!    REAL(wp), PARAMETER ::  m_max_depth        = 0.0002_wp  !< Maximum capacity of the water reservoir (m)
-
-!
-!-- Soil parameters I           alpha_vg,      l_vg_green,    n_vg, gamma_w_green_sat
-    REAL(wp), DIMENSION(0:3,1:7), PARAMETER ::  soil_pars = RESHAPE( (/     &
-                                 3.83_wp,  1.250_wp, 1.38_wp,  6.94E-6_wp, &  !< soil 1
-                                 3.14_wp, -2.342_wp, 1.28_wp,  1.16E-6_wp, &  !< soil 2
-                                 0.83_wp, -0.588_wp, 1.25_wp,  0.26E-6_wp, &  !< soil 3
-                                 3.67_wp, -1.977_wp, 1.10_wp,  2.87E-6_wp, &  !< soil 4
-                                 2.65_wp,  2.500_wp, 1.10_wp,  1.74E-6_wp, &  !< soil 5
-                                 1.30_wp,  0.400_wp, 1.20_wp,  0.93E-6_wp, &  !< soil 6
-                                 0.00_wp,  0.00_wp,  0.00_wp,  0.57E-6_wp  &  !< soil 7
-                                 /), (/ 4, 7 /) )
-
-!
-!-- Soil parameters II              swc_sat,     fc,   wilt,    swc_res
-    REAL(wp), DIMENSION(0:3,1:7), PARAMETER ::  m_soil_pars = RESHAPE( (/ &
-                                 0.403_wp, 0.244_wp, 0.059_wp, 0.025_wp, &  !< soil 1
-                                 0.439_wp, 0.347_wp, 0.151_wp, 0.010_wp, &  !< soil 2
-                                 0.430_wp, 0.383_wp, 0.133_wp, 0.010_wp, &  !< soil 3
-                                 0.520_wp, 0.448_wp, 0.279_wp, 0.010_wp, &  !< soil 4
-                                 0.614_wp, 0.541_wp, 0.335_wp, 0.010_wp, &  !< soil 5
-                                 0.766_wp, 0.663_wp, 0.267_wp, 0.010_wp, &  !< soil 6
-                                 0.472_wp, 0.323_wp, 0.171_wp, 0.000_wp  &  !< soil 7
-                                 /), (/ 4, 7 /) )
-!
-!-- Value 9999999.9_wp -> Generic available or user-defined value must be set otherwise
-!-- -> No generic variable and user setting is optional
-    REAL(wp) ::  alpha_vangenuchten = 9999999.9_wp      !< NAMELIST alpha_vg
-    REAL(wp) ::  field_capacity = 9999999.9_wp          !< NAMELIST fc
-    REAL(wp) ::  hydraulic_conductivity = 9999999.9_wp  !< NAMELIST gamma_w_green_sat
-    REAL(wp) ::  l_vangenuchten = 9999999.9_wp          !< NAMELIST l_vg
-    REAL(wp) ::  n_vangenuchten = 9999999.9_wp          !< NAMELIST n_vg
-    REAL(wp) ::  residual_moisture = 9999999.9_wp       !< NAMELIST m_res
-    REAL(wp) ::  saturation_moisture = 9999999.9_wp     !< NAMELIST m_sat
-    REAL(wp) ::  wilting_point = 9999999.9_wp           !< NAMELIST m_wilt
-
-!
-!-- Configuration parameters (they can be setup in PALM config)
-    LOGICAL ::  force_radiation_call_l = .FALSE.   !< flag parameter for unscheduled radiation model calls
-    LOGICAL ::  usm_wall_mod = .FALSE.             !< reduces conductivity of the first 2 wall layers by factor 0.1
-
-
-    INTEGER(iwp) ::  building_type = 1               !< default building type (preleminary setting)
-    INTEGER(iwp) ::  roof_category = 2               !< default category for root surface
-    INTEGER(iwp) ::  wall_category = 2               !< default category for wall surface over pedestrian zone
-
-    REAL(wp)     ::  d_roughness_concrete            !< inverse roughness length of average concrete surface
-    REAL(wp)     ::  roughness_concrete = 0.001_wp   !< roughness length of average concrete surface
-
-!
-!-- Indices of input attributes in building_pars for (above) ground floor level
-    INTEGER(iwp) ::  ind_alb_wall_agfl     = 38   !< index in input list for albedo_type of wall above ground floor level
-    INTEGER(iwp) ::  ind_alb_wall_gfl      = 66   !< index in input list for albedo_type of wall ground floor level
-    INTEGER(iwp) ::  ind_alb_wall_r        = 101  !< index in input list for albedo_type of wall roof
-    INTEGER(iwp) ::  ind_alb_green_agfl    = 39   !< index in input list for albedo_type of green above ground floor level
-    INTEGER(iwp) ::  ind_alb_green_gfl     = 78   !< index in input list for albedo_type of green ground floor level
-    INTEGER(iwp) ::  ind_alb_green_r       = 117  !< index in input list for albedo_type of green roof
-    INTEGER(iwp) ::  ind_alb_win_agfl      = 40   !< index in input list for albedo_type of window fraction above ground floor
-                                                  !< level
-    INTEGER(iwp) ::  ind_alb_win_gfl       = 77   !< index in input list for albedo_type of window fraction ground floor level
-    INTEGER(iwp) ::  ind_alb_win_r         = 115  !< index in input list for albedo_type of window fraction roof
-    INTEGER(iwp) ::  ind_emis_wall_agfl    = 14   !< index in input list for wall emissivity, above ground floor level
-    INTEGER(iwp) ::  ind_emis_wall_gfl     = 32   !< index in input list for wall emissivity, ground floor level
-    INTEGER(iwp) ::  ind_emis_wall_r       = 100  !< index in input list for wall emissivity, roof
-    INTEGER(iwp) ::  ind_emis_green_agfl   = 15   !< index in input list for green emissivity, above ground floor level
-    INTEGER(iwp) ::  ind_emis_green_gfl    = 34   !< index in input list for green emissivity, ground floor level
-    INTEGER(iwp) ::  ind_emis_green_r      = 116  !< index in input list for green emissivity, roof
-    INTEGER(iwp) ::  ind_emis_win_agfl     = 16   !< index in input list for window emissivity, above ground floor level
-    INTEGER(iwp) ::  ind_emis_win_gfl      = 33   !< index in input list for window emissivity, ground floor level
-    INTEGER(iwp) ::  ind_emis_win_r        = 113  !< index in input list for window emissivity, roof
-    INTEGER(iwp) ::  ind_gflh              = 20   !< index in input list for ground floor level height
-    INTEGER(iwp) ::  ind_green_frac_w_agfl = 2    !< index in input list for green fraction on wall, above ground floor level
-    INTEGER(iwp) ::  ind_green_frac_w_gfl  = 23   !< index in input list for green fraction on wall, ground floor level
-    INTEGER(iwp) ::  ind_green_frac_r_agfl = 3    !< index in input list for green fraction on roof, above ground floor level
-    INTEGER(iwp) ::  ind_green_frac_r_gfl  = 24   !< index in input list for green fraction on roof, ground floor level
-    INTEGER(iwp) ::  ind_green_type_roof   = 118  !< index in input list for type of green roof
-    INTEGER(iwp) ::  ind_hc1_agfl          = 6    !< index in input list for heat capacity at first wall layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_hc1_gfl           = 26   !< index in input list for heat capacity at first wall layer, ground floor level
-    INTEGER(iwp) ::  ind_hc1_wall_r        = 94   !< index in input list for heat capacity at first wall layer, roof
-    INTEGER(iwp) ::  ind_hc1_win_agfl      = 83   !< index in input list for heat capacity at first window layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_hc1_win_gfl       = 71   !< index in input list for heat capacity at first window layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_hc1_win_r         = 107  !< index in input list for heat capacity at first window layer, roof
-    INTEGER(iwp) ::  ind_hc2_agfl          = 7    !< index in input list for heat capacity at second wall layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_hc2_gfl           = 27   !< index in input list for heat capacity at second wall layer, ground floor level
-    INTEGER(iwp) ::  ind_hc2_wall_r        = 95   !< index in input list for heat capacity at second wall layer, roof
-    INTEGER(iwp) ::  ind_hc2_win_agfl      = 84   !< index in input list for heat capacity at second window layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_hc2_win_gfl       = 72   !< index in input list for heat capacity at second window layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_hc2_win_r         = 108  !< index in input list for heat capacity at second window layer, roof
-    INTEGER(iwp) ::  ind_hc3_agfl          = 8    !< index in input list for heat capacity at third wall layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_hc3_gfl           = 28   !< index in input list for heat capacity at third wall layer, ground floor level
-    INTEGER(iwp) ::  ind_hc3_wall_r        = 96   !< index in input list for heat capacity at third wall layer, roof
-    INTEGER(iwp) ::  ind_hc3_win_agfl      = 85   !< index in input list for heat capacity at third window layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_hc3_win_gfl       = 73   !< index in input list for heat capacity at third window layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_hc3_win_r         = 109  !< index in input list for heat capacity at third window layer, roof
-    INTEGER(iwp) ::  ind_hc4_agfl          = 136  !< index in input list for heat capacity at fourth wall layer, above ground floor level
-    INTEGER(iwp) ::  ind_hc4_gfl           = 138  !< index in input list for heat capacity at fourth wall layer, ground floor level
-    INTEGER(iwp) ::  ind_hc4_wall_r        = 146  !< index in input list for heat capacity at fourth wall layer, roof
-    INTEGER(iwp) ::  ind_hc4_win_agfl      = 144  !< index in input list for heat capacity at fourth window layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_hc4_win_gfl       = 142  !< index in input list for heat capacity at fourth window layer, ground floor level
-    INTEGER(iwp) ::  ind_hc4_win_r         = 148  !< index in input list for heat capacity at fourth window layer, roof
-    INTEGER(iwp) ::  ind_indoor_target_temp_summer = 12  !<
-    INTEGER(iwp) ::  ind_indoor_target_temp_winter = 13  !<
-    INTEGER(iwp) ::  ind_lai_r_agfl        = 4    !< index in input list for LAI on roof, above ground floor level
-    INTEGER(iwp) ::  ind_lai_r_gfl         = 4    !< index in input list for LAI on roof, ground floor level
-    INTEGER(iwp) ::  ind_lai_w_agfl        = 5    !< index in input list for LAI on wall, above ground floor level
-    INTEGER(iwp) ::  ind_lai_w_gfl         = 25   !< index in input list for LAI on wall, ground floor level
-    INTEGER(iwp) ::  ind_tc1_agfl          = 9    !< index in input list for thermal conductivity at first wall layer, above ground floor level
-    INTEGER(iwp) ::  ind_tc1_gfl           = 29   !< index in input list for thermal conductivity at first wall layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_tc1_wall_r        = 97   !< index in input list for thermal conductivity at first wall layer, roof
-    INTEGER(iwp) ::  ind_tc1_win_agfl      = 86   !< index in input list for thermal conductivity at first window layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_tc1_win_gfl       = 74   !< index in input list for thermal conductivity at first window layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_tc1_win_r         = 110  !< index in input list for thermal conductivity at first window layer, roof
-    INTEGER(iwp) ::  ind_tc2_agfl          = 10   !< index in input list for thermal conductivity at second wall layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_tc2_gfl           = 30   !< index in input list for thermal conductivity at second wall layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_tc2_wall_r        = 98   !< index in input list for thermal conductivity at second wall layer, roof
-    INTEGER(iwp) ::  ind_tc2_win_agfl      = 87   !< index in input list for thermal conductivity at second window layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_tc2_win_gfl       = 75   !< index in input list for thermal conductivity at second window layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_tc2_win_r         = 111  !< index in input list for thermal conductivity at second window layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_tc3_agfl          = 11   !< index in input list for thermal conductivity at third wall layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_tc3_gfl           = 31   !< index in input list for thermal conductivity at third wall layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_tc3_wall_r        = 99   !< index in input list for thermal conductivity at third wall layer, roof
-    INTEGER(iwp) ::  ind_tc3_win_agfl      = 88   !< index in input list for thermal conductivity at third window layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_tc3_win_gfl       = 76   !< index in input list for thermal conductivity at third window layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_tc3_win_r         = 112  !< index in input list for thermal conductivity at third window layer, roof
-    INTEGER(iwp) ::  ind_tc4_agfl          = 137  !< index in input list for thermal conductivity at fourth wall layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_tc4_gfl           = 139  !< index in input list for thermal conductivity at fourth wall layer,
-                                                  !< ground floor level
-    INTEGER(iwp) ::  ind_tc4_wall_r        = 147  !< index in input list for thermal conductivity at fourth wall layer, roof
-    INTEGER(iwp) ::  ind_tc4_win_agfl      = 145  !< index in input list for thermal conductivity at fourth window layer,
-                                                  !< above ground floor level
-    INTEGER(iwp) ::  ind_tc4_win_gfl       = 143  !< index in input list for thermal conductivity at first window layer, ground floor level
-    INTEGER(iwp) ::  ind_tc4_win_r         = 149  !< index in input list for thermal conductivity at third window layer, roof
-    INTEGER(iwp) ::  ind_thick_1_agfl      = 41   !< index for wall layer thickness - 1st layer above ground floor level
-    INTEGER(iwp) ::  ind_thick_1_gfl       = 62   !< index for wall layer thickness - 1st layer ground floor level
-    INTEGER(iwp) ::  ind_thick_1_wall_r    = 90   !< index for wall layer thickness - 1st layer roof
-    INTEGER(iwp) ::  ind_thick_1_win_agfl  = 79   !< index for window layer thickness - 1st layer above ground floor level
-    INTEGER(iwp) ::  ind_thick_1_win_gfl   = 67   !< index for window layer thickness - 1st layer ground floor level
-    INTEGER(iwp) ::  ind_thick_1_win_r     = 103  !< index for window layer thickness - 1st layer roof
-    INTEGER(iwp) ::  ind_thick_2_agfl      = 42   !< index for wall layer thickness - 2nd layer above ground floor level
-    INTEGER(iwp) ::  ind_thick_2_gfl       = 63   !< index for wall layer thickness - 2nd layer ground floor level
-    INTEGER(iwp) ::  ind_thick_2_wall_r    = 91   !< index for wall layer thickness - 2nd layer roof
-    INTEGER(iwp) ::  ind_thick_2_win_agfl  = 80   !< index for window layer thickness - 2nd layer above ground floor level
-    INTEGER(iwp) ::  ind_thick_2_win_gfl   = 68   !< index for window layer thickness - 2nd layer ground floor level
-    INTEGER(iwp) ::  ind_thick_2_win_r     = 104  !< index for window layer thickness - 2nd layer roof
-    INTEGER(iwp) ::  ind_thick_3_agfl      = 43   !< index for wall layer thickness - 3rd layer above ground floor level
-    INTEGER(iwp) ::  ind_thick_3_gfl       = 64   !< index for wall layer thickness - 3rd layer ground floor level
-    INTEGER(iwp) ::  ind_thick_3_wall_r    = 92   !< index for wall layer thickness - 3rd layer roof
-    INTEGER(iwp) ::  ind_thick_3_win_agfl  = 81   !< index for window layer thickness - 3rd layer above ground floor level
-    INTEGER(iwp) ::  ind_thick_3_win_gfl   = 69   !< index for window layer thickness - 3rd layer ground floor level
-    INTEGER(iwp) ::  ind_thick_3_win_r     = 105  !< index for window layer thickness - 3rd layer roof
-    INTEGER(iwp) ::  ind_thick_4_agfl      = 44   !< index for wall layer thickness - 4th layer above ground floor level
-    INTEGER(iwp) ::  ind_thick_4_gfl       = 65   !< index for wall layer thickness - 4th layer ground floor level
-    INTEGER(iwp) ::  ind_thick_4_wall_r    = 93   !< index for wall layer thickness - 4st layer roof
-    INTEGER(iwp) ::  ind_thick_4_win_agfl  = 82   !< index for window layer thickness - 4th layer above ground floor level
-    INTEGER(iwp) ::  ind_thick_4_win_gfl   = 70   !< index for window layer thickness - 4th layer ground floor level
-    INTEGER(iwp) ::  ind_thick_4_win_r     = 106  !< index for window layer thickness - 4th layer roof
-    INTEGER(iwp) ::  ind_trans_agfl        = 17   !< index in input list for window transmissivity, above ground floor level
-    INTEGER(iwp) ::  ind_trans_gfl         = 35   !< index in input list for window transmissivity, ground floor level
-    INTEGER(iwp) ::  ind_trans_r           = 114  !< index in input list for window transmissivity, roof
-    INTEGER(iwp) ::  ind_wall_frac_agfl    = 0    !< index in input list for wall fraction, above ground floor level
-    INTEGER(iwp) ::  ind_wall_frac_gfl     = 21   !< index in input list for wall fraction, ground floor level
-    INTEGER(iwp) ::  ind_wall_frac_r       = 89   !< index in input list for wall fraction, roof
-    INTEGER(iwp) ::  ind_win_frac_agfl     = 1    !< index in input list for window fraction, above ground floor level
-    INTEGER(iwp) ::  ind_win_frac_gfl      = 22   !< index in input list for window fraction, ground floor level
-    INTEGER(iwp) ::  ind_win_frac_r        = 102  !< index in input list for window fraction, roof
-    INTEGER(iwp) ::  ind_z0_agfl           = 18   !< index in input list for z0, above ground floor level
-    INTEGER(iwp) ::  ind_z0_gfl            = 36   !< index in input list for z0, ground floor level
-    INTEGER(iwp) ::  ind_z0qh_agfl         = 19   !< index in input list for z0h / z0q, above ground floor level
-    INTEGER(iwp) ::  ind_z0qh_gfl          = 37   !< index in input list for z0h / z0q, ground floor level
-!
-!-- Indices of input attributes in building_surface_pars (except for radiation-related, which are in
-!-- radiation_model_mod)
-    CHARACTER(37), DIMENSION(0:7), PARAMETER ::  building_type_name = (/     &
-                                   'user-defined                         ', &  !< type 0
-                                   'residential - 1950                   ', &  !< type  1
-                                   'residential 1951 - 2000              ', &  !< type  2
-                                   'residential 2001 -                   ', &  !< type  3
-                                   'office - 1950                        ', &  !< type  4
-                                   'office 1951 - 2000                   ', &  !< type  5
-                                   'office 2001 -                        ', &  !< type  6
-                                   'bridges                              '  &  !< type  7
-                                                                     /)
-
-    INTEGER(iwp) ::  ind_s_emis_green                = 14  !< index for emissivity of green fraction (0-1)
-    INTEGER(iwp) ::  ind_s_emis_wall                 = 13  !< index for emissivity of wall fraction (0-1)
-    INTEGER(iwp) ::  ind_s_emis_win                  = 15  !< index for emissivity o f window fraction (0-1)
-    INTEGER(iwp) ::  ind_s_green_frac_r              = 3   !< index for green fraction on roof (0-1)
-    INTEGER(iwp) ::  ind_s_green_frac_w              = 2   !< index for green fraction on wall (0-1)
-    INTEGER(iwp) ::  ind_s_hc1                       = 5   !< index for heat capacity of wall layer 1
-    INTEGER(iwp) ::  ind_s_hc2                       = 6   !< index for heat capacity of wall layer 2
-    INTEGER(iwp) ::  ind_s_hc3                       = 7   !< index for heat capacity of wall layer 3
-    INTEGER(iwp) ::  ind_s_indoor_target_temp_summer = 11  !< index for indoor target summer temperature
-    INTEGER(iwp) ::  ind_s_indoor_target_temp_winter = 12  !< index for indoor target winter temperature
-    INTEGER(iwp) ::  ind_s_lai_r                     = 4   !< index for leaf area index of green fraction
-    INTEGER(iwp) ::  ind_s_tc1                       = 8   !< index for thermal conducivity of wall layer 1
-    INTEGER(iwp) ::  ind_s_tc2                       = 9   !< index for thermal conducivity of wall layer 2
-    INTEGER(iwp) ::  ind_s_tc3                       = 10  !< index for thermal conducivity of wall layer 3
-    INTEGER(iwp) ::  ind_s_trans                     = 16  !< index for transmissivity of window fraction (0-1)
-    INTEGER(iwp) ::  ind_s_wall_frac                 = 0   !< index for wall fraction (0-1)
-    INTEGER(iwp) ::  ind_s_win_frac                  = 1   !< index for window fraction (0-1)
-    INTEGER(iwp) ::  ind_s_z0                        = 17  !< index for roughness length for momentum (m)
-    INTEGER(iwp) ::  ind_s_z0qh                      = 18  !< index for roughness length for heat (m)
-
-    REAL(wp)  ::  ground_floor_level = 4.0_wp  !< default ground floor level
-
-!
-!-- Building facade/wall/green/window properties (partly according to PIDS).
-!-- Initialization of building_pars is outsourced to usm_init_pars. This is needed because of the
-!-- huge number of attributes given in building_pars (>700), while intel and gfortran compiler have
-!-- hard limit of continuation lines of 511.
-    REAL(wp), DIMENSION(0:149,1:7) ::  building_pars  !<
-!
-!-- Type for 1d surface variables as surface temperature and liquid water reservoir
-    TYPE surf_type_1d_usm
-       REAL(wp), DIMENSION(:), ALLOCATABLE         ::  val  !<
-    END TYPE surf_type_1d_usm
-!
-!-- Type for 2d surface variables as wall temperature
-    TYPE surf_type_2d_usm
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE       ::  val  !<
-    END TYPE surf_type_2d_usm
-!-- Wall surface model
-!-- Wall surface model constants
-    INTEGER(iwp), PARAMETER                        ::  nzb_wall = 0  !< inner side of the wall model (to be switched)
-    INTEGER(iwp), PARAMETER                        ::  nzt_wall = 3  !< outer side of the wall model (to be switched)
-    INTEGER(iwp), PARAMETER                        ::  nzw      = 4  !< number of wall layers (fixed for now)
-
-    INTEGER(iwp)                                   ::  soil_type     !<
-
-    REAL(wp)  ::  m_total                  = 0.0_wp    !< weighted total water content of the soil (m3/m3)
-    REAL(wp)  ::  roof_inner_temperature   = 295.0_wp  !< temperature of the inner roof
-                                                       !< surface (~22 degrees C) (K)
-    REAL(wp)  ::  soil_inner_temperature   = 288.0_wp  !< temperature of the deep soil
-                                                       !< (~15 degrees C) (K)
-    REAL(wp)  ::  wall_inner_temperature   = 295.0_wp  !< temperature of the inner wall
-                                                       !< surface (~22 degrees C) (K)
-    REAL(wp)  ::  window_inner_temperature = 295.0_wp  !< temperature of the inner window
-                                                       !< surface (~22 degrees C) (K)
-!
-!-- Surface and material model variables for walls, ground, roofs
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_green_h      !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_green_h_p    !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_wall_h       !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_wall_h_p     !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_window_h     !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_window_h_p   !<
-
-    TYPE(surf_type_1d_usm), DIMENSION(0:1), TARGET  ::  t_surf_green_h_1    !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:1), TARGET  ::  t_surf_green_h_2    !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:1), TARGET  ::  t_surf_wall_h_1     !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:1), TARGET  ::  t_surf_wall_h_2     !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:1), TARGET  ::  t_surf_window_h_1   !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:1), TARGET  ::  t_surf_window_h_2   !<
-
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_green_v      !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_green_v_p    !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_wall_v       !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_wall_v_p     !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_window_v     !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  t_surf_window_v_p   !<
-
-    TYPE(surf_type_1d_usm), DIMENSION(0:3), TARGET  ::  t_surf_green_v_1    !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:3), TARGET  ::  t_surf_green_v_2    !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:3), TARGET  ::  t_surf_wall_v_1     !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:3), TARGET  ::  t_surf_wall_v_2     !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:3), TARGET  ::  t_surf_window_v_1   !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:3), TARGET  ::  t_surf_window_v_2   !<
-
-!
-!-- Energy balance variables
-!-- Parameters of the land, roof and wall surfaces (only for horizontal upward surfaces)
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  fc_h          !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  rootfr_h      !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  swc_h         !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  swc_h_p       !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  swc_res_h     !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  swc_sat_h     !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_green_h     !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_green_h_p   !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_wall_h      !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_wall_h_p    !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  wilt_h        !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_window_h    !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_window_h_p  !<
-
-
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  fc_h_1        !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  rootfr_h_1    !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  swc_h_1       !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  swc_h_2       !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  swc_res_h_1   !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  swc_sat_h_1   !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  t_green_h_1   !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  t_green_h_2   !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  t_wall_h_1    !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  t_wall_h_2    !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  wilt_h_1      !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  t_window_h_1  !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:1), TARGET  ::  t_window_h_2  !<
-
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_green_v     !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_green_v_p   !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_wall_v      !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_wall_v_p    !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_window_v    !<
-    TYPE(surf_type_2d_usm), DIMENSION(:), POINTER   ::  t_window_v_p  !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:3), TARGET  ::  t_green_v_1   !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:3), TARGET  ::  t_green_v_2   !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:3), TARGET  ::  t_wall_v_1    !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:3), TARGET  ::  t_wall_v_2    !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:3), TARGET  ::  t_window_v_1  !<
-    TYPE(surf_type_2d_usm), DIMENSION(0:3), TARGET  ::  t_window_v_2  !<
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  m_liq_usm_h    !< liquid water reservoir (m), horizontal surface elements
-    TYPE(surf_type_1d_usm), DIMENSION(:), POINTER   ::  m_liq_usm_h_p  !< progn. liquid water reservoir (m), horizontal surface elements
-    TYPE(surf_type_1d_usm), DIMENSION(0:1), TARGET  ::  m_liq_usm_h_1  !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:1), TARGET  ::  m_liq_usm_h_2  !<
-    TYPE(surf_type_1d_usm), DIMENSION(0:1), TARGET  ::  tm_liq_usm_h_m  !< liquid water reservoir tendency (m), horizontal surface elements
-!-- Interfaces of subroutines accessed from outside of this module
-    INTERFACE usm_3d_data_averaging
-       MODULE PROCEDURE usm_3d_data_averaging
-    END INTERFACE usm_3d_data_averaging
-
-    INTERFACE usm_boundary_condition
-       MODULE PROCEDURE usm_boundary_condition
-    END INTERFACE usm_boundary_condition
-
-    INTERFACE usm_check_data_output
-       MODULE PROCEDURE usm_check_data_output
-    END INTERFACE usm_check_data_output
-
-    INTERFACE usm_check_parameters
-       MODULE PROCEDURE usm_check_parameters
-    END INTERFACE usm_check_parameters
-
-    INTERFACE usm_data_output_3d
-       MODULE PROCEDURE usm_data_output_3d
-    END INTERFACE usm_data_output_3d
-
-    INTERFACE usm_define_netcdf_grid
-       MODULE PROCEDURE usm_define_netcdf_grid
-    END INTERFACE usm_define_netcdf_grid
-
-    INTERFACE usm_init
-       MODULE PROCEDURE usm_init
-    END INTERFACE usm_init
-
-    INTERFACE usm_init_arrays
-       MODULE PROCEDURE usm_init_arrays
-    END INTERFACE usm_init_arrays
-
-    INTERFACE usm_parin
-       MODULE PROCEDURE usm_parin
-    END INTERFACE usm_parin
-
-    INTERFACE usm_rrd_local
-       MODULE PROCEDURE usm_rrd_local_ftn
-       MODULE PROCEDURE usm_rrd_local_mpi
-    END INTERFACE usm_rrd_local
-
-    INTERFACE usm_energy_balance
-       MODULE PROCEDURE usm_energy_balance
-    END INTERFACE usm_energy_balance
-
-    INTERFACE usm_swap_timelevel
-       MODULE PROCEDURE usm_swap_timelevel
-    END INTERFACE usm_swap_timelevel
-
-    INTERFACE usm_wrd_local
-       MODULE PROCEDURE usm_wrd_local
-    END INTERFACE usm_wrd_local
-
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public functions
-    PUBLIC usm_boundary_condition,                                                                 &
-           usm_check_data_output,                                                                  &
-           usm_check_parameters,                                                                   &
-           usm_data_output_3d,                                                                     &
-           usm_define_netcdf_grid,                                                                 &
-           usm_init,                                                                               &
-           usm_init_arrays,                                                                        &
-           usm_parin,                                                                              &
-           usm_rrd_local,                                                                          &
-           usm_energy_balance,                                                                     &
-           usm_swap_timelevel,                                                                     &
-           usm_wrd_local,                                                                          &
-           usm_3d_data_averaging
-
-!
-!-- Public parameters, constants and initial values
-    PUBLIC building_type,                                                                          &
-           building_pars,                                                                          &
-           nzb_wall,                                                                               &
-           nzt_wall,                                                                               &
-           t_green_h,                                                                              &
-           t_green_v,                                                                              &
-           t_wall_h,                                                                               &
-           t_wall_v,                                                                               &
-           t_window_h,                                                                             &
-           t_window_v,                                                                             &
-           usm_wall_mod
-
-
-
-
-
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine creates the necessary indices of the urban surfaces and plant canopy and it
-!> allocates the needed arrays for USM
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_init_arrays
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  l  !<
-
-    IF ( debug_output )  CALL debug_message( 'usm_init_arrays', 'start' )
-
-!
-!-- Allocate radiation arrays which are part of the new data type.
-!-- For horizontal surfaces.
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%surfhf(1:surf_usm_h(l)%ns)    )
-       ALLOCATE ( surf_usm_h(l)%rad_net_l(1:surf_usm_h(l)%ns) )
-    ENDDO
-!
-!-- For vertical surfaces
-    DO  l = 0, 3
-       ALLOCATE ( surf_usm_v(l)%surfhf(1:surf_usm_v(l)%ns)    )
-       ALLOCATE ( surf_usm_v(l)%rad_net_l(1:surf_usm_v(l)%ns) )
-    ENDDO
-
-!
-!-- Wall surface model
-!-- Allocate arrays for wall surface model and define pointers
-!-- Allocate array of wall types and wall parameters
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%surface_types(1:surf_usm_h(l)%ns)      )
-       ALLOCATE ( surf_usm_h(l)%building_type(1:surf_usm_h(l)%ns)      )
-       ALLOCATE ( surf_usm_h(l)%building_type_name(1:surf_usm_h(l)%ns) )
-       surf_usm_h(l)%building_type      = 0
-       surf_usm_h(l)%building_type_name = 'none'
-    ENDDO
-    DO  l = 0, 3
-       ALLOCATE ( surf_usm_v(l)%surface_types(1:surf_usm_v(l)%ns)      )
-       ALLOCATE ( surf_usm_v(l)%building_type(1:surf_usm_v(l)%ns)      )
-       ALLOCATE ( surf_usm_v(l)%building_type_name(1:surf_usm_v(l)%ns) )
-       surf_usm_v(l)%building_type      = 0
-       surf_usm_v(l)%building_type_name = 'none'
-    ENDDO
-!
-!-- Allocate albedo_type and albedo. Each surface element has 3 values, 0: wall fraction,
-!-- 1: green fraction, 2: window fraction.
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%albedo_type(1:surf_usm_h(l)%ns,0:2) )
-       ALLOCATE ( surf_usm_h(l)%albedo(1:surf_usm_h(l)%ns,0:2)      )
-       surf_usm_h(l)%albedo_type = albedo_type
-    ENDDO
-    DO  l = 0, 3
-       ALLOCATE ( surf_usm_v(l)%albedo_type(1:surf_usm_v(l)%ns,0:2) )
-       ALLOCATE ( surf_usm_v(l)%albedo(1:surf_usm_v(l)%ns,0:2)      )
-       surf_usm_v(l)%albedo_type = albedo_type
-    ENDDO
-
-!
-!-- Allocate indoor target temperature for summer and winter
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%target_temp_summer(1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%target_temp_winter(1:surf_usm_h(l)%ns) )
-    ENDDO
-    DO  l = 0, 3
-       ALLOCATE ( surf_usm_v(l)%target_temp_summer(1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%target_temp_winter(1:surf_usm_v(l)%ns) )
-    ENDDO
-!
-!-- In case the indoor model is applied, allocate memory for waste heat and indoor temperature.
-    IF ( indoor_model )  THEN
-       DO  l = 0, 1
-          ALLOCATE ( surf_usm_h(l)%t_prev(1:surf_usm_h(l)%ns)     )
-          ALLOCATE ( surf_usm_h(l)%waste_heat(1:surf_usm_h(l)%ns) )
-          surf_usm_h(l)%t_prev     = 0.0_wp
-          surf_usm_h(l)%waste_heat = 0.0_wp
-       ENDDO
-       DO  l = 0, 3
-          ALLOCATE ( surf_usm_v(l)%t_prev(1:surf_usm_v(l)%ns)     )
-          ALLOCATE ( surf_usm_v(l)%waste_heat(1:surf_usm_v(l)%ns) )
-          surf_usm_v(l)%t_prev     = 0.0_wp
-          surf_usm_v(l)%waste_heat = 0.0_wp
-       ENDDO
-    ENDIF
-!
-!-- Allocate flag indicating ground floor level surface elements
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%ground_level(1:surf_usm_h(l)%ns) )
-    ENDDO
-    DO  l = 0, 3
-       ALLOCATE ( surf_usm_v(l)%ground_level(1:surf_usm_v(l)%ns) )
-    ENDDO
-!
-!-- Allocate arrays for relative surface fraction.
-!-- 0 - wall fraction, 1 - green fraction, 2 - window fraction
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%frac(1:surf_usm_h(l)%ns,0:2) )
-       surf_usm_h(l)%frac = 0.0_wp
-    ENDDO
-    DO  l = 0, 3
-       ALLOCATE ( surf_usm_v(l)%frac(1:surf_usm_v(l)%ns,0:2) )
-       surf_usm_v(l)%frac = 0.0_wp
-    ENDDO
-
-!
-!-- Wall and roof surface parameters. First for horizontal surfaces
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%isroof_surf(1:surf_usm_h(l)%ns)        )
-       ALLOCATE ( surf_usm_h(l)%lambda_surf(1:surf_usm_h(l)%ns)        )
-       ALLOCATE ( surf_usm_h(l)%lambda_surf_window(1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%lambda_surf_green(1:surf_usm_h(l)%ns)  )
-       ALLOCATE ( surf_usm_h(l)%c_surface(1:surf_usm_h(l)%ns)          )
-       ALLOCATE ( surf_usm_h(l)%c_surface_window(1:surf_usm_h(l)%ns)   )
-       ALLOCATE ( surf_usm_h(l)%c_surface_green(1:surf_usm_h(l)%ns)    )
-       ALLOCATE ( surf_usm_h(l)%transmissivity(1:surf_usm_h(l)%ns)     )
-       ALLOCATE ( surf_usm_h(l)%lai(1:surf_usm_h(l)%ns)                )
-       ALLOCATE ( surf_usm_h(l)%emissivity(1:surf_usm_h(l)%ns,0:2)     )
-       ALLOCATE ( surf_usm_h(l)%r_a(1:surf_usm_h(l)%ns)                )
-       ALLOCATE ( surf_usm_h(l)%r_a_green(1:surf_usm_h(l)%ns)          )
-       ALLOCATE ( surf_usm_h(l)%r_a_window(1:surf_usm_h(l)%ns)         )
-       ALLOCATE ( surf_usm_h(l)%green_type_roof(1:surf_usm_h(l)%ns)    )
-       ALLOCATE ( surf_usm_h(l)%r_s(1:surf_usm_h(l)%ns)                )
-    ENDDO
-!
-!-- For vertical surfaces.
-    DO  l = 0, 3
-       ALLOCATE ( surf_usm_v(l)%lambda_surf(1:surf_usm_v(l)%ns)        )
-       ALLOCATE ( surf_usm_v(l)%c_surface(1:surf_usm_v(l)%ns)          )
-       ALLOCATE ( surf_usm_v(l)%lambda_surf_window(1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%c_surface_window(1:surf_usm_v(l)%ns)   )
-       ALLOCATE ( surf_usm_v(l)%lambda_surf_green(1:surf_usm_v(l)%ns)  )
-       ALLOCATE ( surf_usm_v(l)%c_surface_green(1:surf_usm_v(l)%ns)    )
-       ALLOCATE ( surf_usm_v(l)%transmissivity(1:surf_usm_v(l)%ns)     )
-       ALLOCATE ( surf_usm_v(l)%lai(1:surf_usm_v(l)%ns)                )
-       ALLOCATE ( surf_usm_v(l)%emissivity(1:surf_usm_v(l)%ns,0:2)     )
-       ALLOCATE ( surf_usm_v(l)%r_a(1:surf_usm_v(l)%ns)                )
-       ALLOCATE ( surf_usm_v(l)%r_a_green(1:surf_usm_v(l)%ns)          )
-       ALLOCATE ( surf_usm_v(l)%r_a_window(1:surf_usm_v(l)%ns)         )
-       ALLOCATE ( surf_usm_v(l)%r_s(1:surf_usm_v(l)%ns)                )
-    ENDDO
-
-!
-!-- Allocate wall and roof material parameters. First for horizontal surfaces
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%thickness_wall(1:surf_usm_h(l)%ns)                    )
-       ALLOCATE ( surf_usm_h(l)%thickness_window(1:surf_usm_h(l)%ns)                  )
-       ALLOCATE ( surf_usm_h(l)%thickness_green(1:surf_usm_h(l)%ns)                   )
-       ALLOCATE ( surf_usm_h(l)%lambda_h(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)        )
-       ALLOCATE ( surf_usm_h(l)%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)      )
-       ALLOCATE ( surf_usm_h(l)%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)    )
-       ALLOCATE ( surf_usm_h(l)%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)  )
-       ALLOCATE ( surf_usm_h(l)%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)     )
-
-       ALLOCATE ( surf_usm_h(l)%rho_c_total_green(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)    )
-       ALLOCATE ( surf_usm_h(l)%n_vg_green(1:surf_usm_h(l)%ns)                             )
-       ALLOCATE ( surf_usm_h(l)%alpha_vg_green(1:surf_usm_h(l)%ns)                         )
-       ALLOCATE ( surf_usm_h(l)%l_vg_green(1:surf_usm_h(l)%ns)                             )
-       ALLOCATE ( surf_usm_h(l)%gamma_w_green_sat(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns)  )
-       ALLOCATE ( surf_usm_h(l)%lambda_w_green(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)       )
-       ALLOCATE ( surf_usm_h(l)%gamma_w_green(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)        )
-       ALLOCATE ( surf_usm_h(l)%tswc_h_m(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)             )
-    ENDDO
-!
-!-- For vertical surfaces.
-    DO  l = 0, 3
-       ALLOCATE ( surf_usm_v(l)%thickness_wall(1:surf_usm_v(l)%ns)                    )
-       ALLOCATE ( surf_usm_v(l)%thickness_window(1:surf_usm_v(l)%ns)                  )
-       ALLOCATE ( surf_usm_v(l)%thickness_green(1:surf_usm_v(l)%ns)                   )
-       ALLOCATE ( surf_usm_v(l)%lambda_h(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)        )
-       ALLOCATE ( surf_usm_v(l)%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)      )
-       ALLOCATE ( surf_usm_v(l)%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)    )
-       ALLOCATE ( surf_usm_v(l)%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
-       ALLOCATE ( surf_usm_v(l)%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)     )
-    ENDDO
-
-!
-!-- Allocate green wall and roof vegetation and soil parameters. First horizontal surfaces
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%g_d(1:surf_usm_h(l)%ns)              )
-       ALLOCATE ( surf_usm_h(l)%c_liq(1:surf_usm_h(l)%ns)            )
-       ALLOCATE ( surf_usm_h(l)%qsws_liq(1:surf_usm_h(l)%ns)         )
-       ALLOCATE ( surf_usm_h(l)%qsws_veg(1:surf_usm_h(l)%ns)         )
-       ALLOCATE ( surf_usm_h(l)%r_canopy(1:surf_usm_h(l)%ns)         )
-       ALLOCATE ( surf_usm_h(l)%r_canopy_min(1:surf_usm_h(l)%ns)     )
-       ALLOCATE ( surf_usm_h(l)%pt_10cm(1:surf_usm_h(l)%ns)          )
-    ENDDO
-!
-!-- For vertical surfaces.
-    DO  l = 0, 3
-      ALLOCATE ( surf_usm_v(l)%g_d(1:surf_usm_v(l)%ns)              )
-      ALLOCATE ( surf_usm_v(l)%c_liq(1:surf_usm_v(l)%ns)            )
-      ALLOCATE ( surf_usm_v(l)%qsws_liq(1:surf_usm_v(l)%ns)         )
-      ALLOCATE ( surf_usm_v(l)%qsws_veg(1:surf_usm_v(l)%ns)         )
-      ALLOCATE ( surf_usm_v(l)%r_canopy(1:surf_usm_v(l)%ns)         )
-      ALLOCATE ( surf_usm_v(l)%r_canopy_min(1:surf_usm_v(l)%ns)     )
-      ALLOCATE ( surf_usm_v(l)%pt_10cm(1:surf_usm_v(l)%ns)          )
-    ENDDO
-
-!
-!-- Allocate wall and roof layers sizes. For horizontal surfaces.
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns)       )
-       ALLOCATE ( surf_usm_h(l)%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns)     )
-       ALLOCATE ( surf_usm_h(l)%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns)      )
-       ALLOCATE ( surf_usm_h(l)%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns)      )
-       ALLOCATE ( surf_usm_h(l)%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)    )
-       ALLOCATE ( surf_usm_h(l)%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)   )
-       ALLOCATE ( surf_usm_h(l)%zw(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)              )
-       ALLOCATE ( surf_usm_h(l)%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns)    )
-       ALLOCATE ( surf_usm_h(l)%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)  )
-       ALLOCATE ( surf_usm_h(l)%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%zw_window(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)       )
-       ALLOCATE ( surf_usm_h(l)%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns)     )
-       ALLOCATE ( surf_usm_h(l)%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)   )
-       ALLOCATE ( surf_usm_h(l)%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)  )
-       ALLOCATE ( surf_usm_h(l)%zw_green(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns)        )
-    ENDDO
-
-!
-!-- For vertical surfaces.
-    DO  l = 0, 3
-       ALLOCATE ( surf_usm_v(l)%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)       )
-       ALLOCATE ( surf_usm_v(l)%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
-       ALLOCATE ( surf_usm_v(l)%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)      )
-       ALLOCATE ( surf_usm_v(l)%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)      )
-       ALLOCATE ( surf_usm_v(l)%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)    )
-       ALLOCATE ( surf_usm_v(l)%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)   )
-       ALLOCATE ( surf_usm_v(l)%zw(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)              )
-       ALLOCATE ( surf_usm_v(l)%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)    )
-       ALLOCATE ( surf_usm_v(l)%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
-       ALLOCATE ( surf_usm_v(l)%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%zw_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)       )
-       ALLOCATE ( surf_usm_v(l)%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
-       ALLOCATE ( surf_usm_v(l)%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)   )
-       ALLOCATE ( surf_usm_v(l)%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
-       ALLOCATE ( surf_usm_v(l)%zw_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)        )
-    ENDDO
-
-!
-!-- Allocate wall and roof temperature arrays, for horizontal walls.
-!-- Allocate if required. Note, in case of restarts, some of these arrays might be already allocated.
-    DO l = 0, 1
-       IF ( .NOT. ALLOCATED( t_surf_wall_h_1(l)%val ) )                                                      &
-          ALLOCATE ( t_surf_wall_h_1(l)%val(1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_surf_wall_h_2(l)%val ) )                                                      &
-          ALLOCATE ( t_surf_wall_h_2(l)%val(1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_wall_h_1(l)%val ) )                                                           &
-          ALLOCATE ( t_wall_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_wall_h_2(l)%val ) )                                                           &
-          ALLOCATE ( t_wall_h_2(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_surf_window_h_1(l)%val ) )                                                    &
-          ALLOCATE ( t_surf_window_h_1(l)%val(1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_surf_window_h_2(l)%val ) )                                                    &
-          ALLOCATE ( t_surf_window_h_2(l)%val(1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_window_h_1(l)%val ) )                                                         &
-          ALLOCATE ( t_window_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_window_h_2(l)%val ) )                                                         &
-          ALLOCATE ( t_window_h_2(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_surf_green_h_1(l)%val ) )                                                     &
-          ALLOCATE ( t_surf_green_h_1(l)%val(1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_surf_green_h_2(l)%val ) )                                                     &
-          ALLOCATE ( t_surf_green_h_2(l)%val(1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_green_h_1(l)%val ) )                                                          &
-          ALLOCATE ( t_green_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_green_h_2(l)%val ) )                                                          &
-          ALLOCATE ( t_green_h_2(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( swc_h_1(l)%val ) )                                                              &
-          ALLOCATE ( swc_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( swc_sat_h_1(l)%val ) )                                                          &
-          ALLOCATE ( swc_sat_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( swc_res_h_1(l)%val ) )                                                          &
-          ALLOCATE ( swc_res_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( swc_h_2(l)%val ) )                                                              &
-          ALLOCATE ( swc_h_2(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( rootfr_h_1(l)%val ) )                                                           &
-          ALLOCATE ( rootfr_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( wilt_h_1(l)%val ) )                                                             &
-          ALLOCATE ( wilt_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( fc_h_1(l)%val ) )                                                               &
-          ALLOCATE ( fc_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-
-       IF ( .NOT. ALLOCATED( m_liq_usm_h_1(l)%val ) )                                             &
-          ALLOCATE ( m_liq_usm_h_1(l)%val(1:surf_usm_h(l)%ns) )
-       IF ( .NOT. ALLOCATED( m_liq_usm_h_2(l)%val ) )                                             &
-          ALLOCATE ( m_liq_usm_h_2(l)%val(1:surf_usm_h(l)%ns) )
-    ENDDO
-!
-!-- Initial assignment of the pointers
-    t_wall_h    => t_wall_h_1;   t_wall_h_p   => t_wall_h_2
-    t_window_h  => t_window_h_1; t_window_h_p => t_window_h_2
-    t_green_h   => t_green_h_1;  t_green_h_p  => t_green_h_2
-    t_surf_wall_h   => t_surf_wall_h_1;   t_surf_wall_h_p   => t_surf_wall_h_2
-    t_surf_window_h => t_surf_window_h_1; t_surf_window_h_p => t_surf_window_h_2
-    t_surf_green_h  => t_surf_green_h_1;  t_surf_green_h_p  => t_surf_green_h_2
-    m_liq_usm_h     => m_liq_usm_h_1;     m_liq_usm_h_p     => m_liq_usm_h_2
-    swc_h     => swc_h_1; swc_h_p => swc_h_2
-    swc_sat_h => swc_sat_h_1
-    swc_res_h => swc_res_h_1
-    rootfr_h  => rootfr_h_1
-    wilt_h    => wilt_h_1
-    fc_h      => fc_h_1
-
-!
-!-- Allocate wall and roof temperature arrays, for vertical walls if required.
-!-- Allocate if required. Note, in case of restarts, some of these arrays might be already allocated.
-    DO  l = 0, 3
-       IF ( .NOT. ALLOCATED( t_surf_wall_v_1(l)%val ) )                                              &
-          ALLOCATE ( t_surf_wall_v_1(l)%val(1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_surf_wall_v_2(l)%val ) )                                              &
-          ALLOCATE ( t_surf_wall_v_2(l)%val(1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_wall_v_1(l)%val ) )                                                   &
-          ALLOCATE ( t_wall_v_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_wall_v_2(l)%val ) )                                                   &
-          ALLOCATE ( t_wall_v_2(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_surf_window_v_1(l)%val ) )                                            &
-          ALLOCATE ( t_surf_window_v_1(l)%val(1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_surf_window_v_2(l)%val ) )                                            &
-          ALLOCATE ( t_surf_window_v_2(l)%val(1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_window_v_1(l)%val ) )                                                 &
-          ALLOCATE ( t_window_v_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_window_v_2(l)%val ) )                                                 &
-          ALLOCATE ( t_window_v_2(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_surf_green_v_1(l)%val ) )                                             &
-          ALLOCATE ( t_surf_green_v_1(l)%val(1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_surf_green_v_2(l)%val ) )                                             &
-          ALLOCATE ( t_surf_green_v_2(l)%val(1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_green_v_1(l)%val ) )                                                  &
-          ALLOCATE ( t_green_v_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       IF ( .NOT. ALLOCATED( t_green_v_2(l)%val ) )                                                  &
-          ALLOCATE ( t_green_v_2(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-    ENDDO
-!
-!-- Initial assignment of the pointers
-    t_wall_v        => t_wall_v_1;        t_wall_v_p        => t_wall_v_2
-    t_surf_wall_v   => t_surf_wall_v_1;   t_surf_wall_v_p   => t_surf_wall_v_2
-    t_window_v      => t_window_v_1;      t_window_v_p      => t_window_v_2
-    t_green_v       => t_green_v_1;       t_green_v_p       => t_green_v_2
-    t_surf_window_v => t_surf_window_v_1; t_surf_window_v_p => t_surf_window_v_2
-    t_surf_green_v  => t_surf_green_v_1;  t_surf_green_v_p  => t_surf_green_v_2
-
-!
-!-- Allocate intermediate timestep arrays. For horizontal surfaces.
-    DO  l = 0, 1
-       ALLOCATE ( surf_usm_h(l)%tt_surface_wall_m(1:surf_usm_h(l)%ns)               )
-       ALLOCATE ( surf_usm_h(l)%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns)   )
-       ALLOCATE ( surf_usm_h(l)%tt_surface_window_m(1:surf_usm_h(l)%ns)             )
-       ALLOCATE ( surf_usm_h(l)%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns)  )
-       ALLOCATE ( surf_usm_h(l)%tt_surface_green_m(1:surf_usm_h(l)%ns)              )
-!
-!--    Allocate intermediate timestep arrays
-!--    Horizontal surfaces
-       ALLOCATE ( tm_liq_usm_h_m(l)%val(1:surf_usm_h(l)%ns) )
-       tm_liq_usm_h_m(l)%val = 0.0_wp
-!
-!--    Set inital values for prognostic quantities
-       IF ( ALLOCATED( surf_usm_h(l)%tt_surface_wall_m )   )  surf_usm_h(l)%tt_surface_wall_m   = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%tt_wall_m )           )  surf_usm_h(l)%tt_wall_m           = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%tt_surface_window_m ) )  surf_usm_h(l)%tt_surface_window_m = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%tt_window_m    )      )  surf_usm_h(l)%tt_window_m         = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%tt_green_m    )       )  surf_usm_h(l)%tt_green_m          = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%tt_surface_green_m )  )  surf_usm_h(l)%tt_surface_green_m  = 0.0_wp
-    END DO
-!
-!-- Now, for vertical surfaces
-    DO  l = 0, 3
-       ALLOCATE ( surf_usm_v(l)%tt_surface_wall_m(1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       IF ( ALLOCATED( surf_usm_v(l)%tt_surface_wall_m ) )  surf_usm_v(l)%tt_surface_wall_m = 0.0_wp
-       IF ( ALLOCATED( surf_usm_v(l)%tt_wall_m ) )  surf_usm_v(l)%tt_wall_m  = 0.0_wp
-       ALLOCATE ( surf_usm_v(l)%tt_surface_window_m(1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       IF ( ALLOCATED( surf_usm_v(l)%tt_surface_window_m ) )  surf_usm_v(l)%tt_surface_window_m = 0.0_wp
-       IF ( ALLOCATED( surf_usm_v(l)%tt_window_m ) )  surf_usm_v(l)%tt_window_m = 0.0_wp
-       ALLOCATE ( surf_usm_v(l)%tt_surface_green_m(1:surf_usm_v(l)%ns) )
-       IF ( ALLOCATED( surf_usm_v(l)%tt_surface_green_m ) )  surf_usm_v(l)%tt_surface_green_m = 0.0_wp
-       ALLOCATE ( surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       IF ( ALLOCATED( surf_usm_v(l)%tt_green_m ) )  surf_usm_v(l)%tt_green_m = 0.0_wp
-    ENDDO
-!
-!-- Allocate wall heat flux output arrays and set initial values. For horizontal surfaces
-    DO  l = 0, 1
-!      ALLOCATE ( surf_usm_h(l)%wshf(1:surf_usm_h(l)%ns)    )  !can be removed
-       ALLOCATE ( surf_usm_h(l)%ghf(1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%wshf_eb(1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%wghf_eb(1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%wghf_eb_window(1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%wghf_eb_green(1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%iwghf_eb(1:surf_usm_h(l)%ns) )
-       ALLOCATE ( surf_usm_h(l)%iwghf_eb_window(1:surf_usm_h(l)%ns) )
-       IF ( ALLOCATED( surf_usm_h(l)%ghf     ) )  surf_usm_h(l)%ghf     = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%wshf    ) )  surf_usm_h(l)%wshf    = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%wshf_eb ) )  surf_usm_h(l)%wshf_eb = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%wghf_eb ) )  surf_usm_h(l)%wghf_eb = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%wghf_eb_window ) )   surf_usm_h(l)%wghf_eb_window  = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%wghf_eb_green ) )    surf_usm_h(l)%wghf_eb_green   = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%iwghf_eb ) )         surf_usm_h(l)%iwghf_eb        = 0.0_wp
-       IF ( ALLOCATED( surf_usm_h(l)%iwghf_eb_window ) )  surf_usm_h(l)%iwghf_eb_window = 0.0_wp
-    ENDDO
-!
-!-- Now, for vertical surfaces
-    DO  l = 0, 3
-!       ALLOCATE ( surf_usm_v(l)%wshf(1:surf_usm_v(l)%ns)    )    ! can be removed
-       ALLOCATE ( surf_usm_v(l)%ghf(1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%wshf_eb(1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%wghf_eb(1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%wghf_eb_window(1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%wghf_eb_green(1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%iwghf_eb(1:surf_usm_v(l)%ns) )
-       ALLOCATE ( surf_usm_v(l)%iwghf_eb_window(1:surf_usm_v(l)%ns) )
-       IF ( ALLOCATED( surf_usm_v(l)%ghf     ) )  surf_usm_v(l)%ghf     = 0.0_wp
-       IF ( ALLOCATED( surf_usm_v(l)%wshf    ) )  surf_usm_v(l)%wshf    = 0.0_wp
-       IF ( ALLOCATED( surf_usm_v(l)%wshf_eb ) )  surf_usm_v(l)%wshf_eb = 0.0_wp
-       IF ( ALLOCATED( surf_usm_v(l)%wghf_eb ) )  surf_usm_v(l)%wghf_eb = 0.0_wp
-       IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_window ) )   surf_usm_v(l)%wghf_eb_window  = 0.0_wp
-       IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_green ) )    surf_usm_v(l)%wghf_eb_green   = 0.0_wp
-       IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb ) )         surf_usm_v(l)%iwghf_eb        = 0.0_wp
-       IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb_window ) )  surf_usm_v(l)%iwghf_eb_window = 0.0_wp
-    ENDDO
-!
-!-- Initialize building-surface properties, which are also required by other modules, e.g. the
-!-- indoor model.
-    CALL usm_define_pars
-
-    IF ( debug_output )  CALL debug_message( 'usm_init_arrays', 'end' )
-
- END SUBROUTINE usm_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sum up and time-average urban surface output quantities as well as allocate the array necessary
-!> for storing the average.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_3d_data_averaging( mode, variable )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  variable  !<
-    CHARACTER(LEN=*), INTENT(IN) ::  mode      !<
-
-    INTEGER(iwp)                                       ::  i, j, k, l, m, ids, idsint, iwl, istat  !< runnin indices
-    CHARACTER(LEN=varnamelength)                       ::  var                                     !< trimmed variable
-    LOGICAL                                            ::  horizontal
-
-    IF ( .NOT. variable(1:4) == 'usm_' )  RETURN  ! Is such a check really required?
-
-!
-!-- Find the real name of the variable
-    ids = -1
-    l = -1
-    var = TRIM(variable)
-    DO  i = 0, nd-1
-       k = len( TRIM( var ) )
-       j = len( TRIM( dirname(i) ) )
-       IF ( TRIM( var(k-j+1:k) ) == TRIM( dirname(i) ) )  THEN
-           ids = i
-           idsint = dirint(ids)
-           l = diridx(ids)  !> index of direction for _h and _v arrays
-           var = var(:k-j)
-           EXIT
-       ENDIF
-    ENDDO
-    IF ( ids == -1 )  THEN
-        var = TRIM( variable )
-    ELSE
-!--    Horizontal direction flag
-       IF ( idsint == iup .OR. idsint == idown )  THEN
-          horizontal = .TRUE.
-       ELSE
-          horizontal = .FALSE.
-       ENDIF
-    ENDIF
-    IF ( var(1:11) == 'usm_t_wall_'  .AND.  len( TRIM( var ) ) >= 12 )  THEN
-!
-!--    Wall layers
-       READ( var(12:12), '(I1)', iostat=istat ) iwl
-       IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
-          var = var(1:10)
-       ELSE
-!
-!--       Wrong wall layer index
-          RETURN
-       ENDIF
-    ENDIF
-    IF ( var(1:13) == 'usm_t_window_'  .AND.  len( TRIM(var) ) >= 14 )  THEN
-!
-!--      Wall layers
-        READ( var(14:14), '(I1)', iostat=istat ) iwl
-        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
-            var = var(1:12)
-        ELSE
-!
-!--         Wrong window layer index
-            RETURN
-        ENDIF
-    ENDIF
-    IF ( var(1:12) == 'usm_t_green_'  .AND.  len( TRIM( var ) ) >= 13 )  THEN
-!
-!--      Wall layers
-        READ( var(13:13), '(I1)', iostat=istat ) iwl
-        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
-            var = var(1:11)
-        ELSE
-!
-!--         Wrong green layer index
-            RETURN
-        ENDIF
-    ENDIF
-    IF ( var(1:8) == 'usm_swc_'  .AND.  len( TRIM( var ) ) >= 9 )  THEN
-!
-!--      Swc layers
-        READ( var(9:9), '(I1)', iostat=istat ) iwl
-        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
-            var = var(1:7)
-        ELSE
-!
-!--         Wrong swc layer index
-            RETURN
-        ENDIF
-    ENDIF
-
-    IF ( mode == 'allocate' )  THEN
-
-       SELECT CASE ( TRIM( var ) )
-
-            CASE ( 'usm_wshf' )
-!
-!--             Array of sensible heat flux from surfaces
-!--             Land surfaces
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%wshf_eb_av ) )  THEN
-                      ALLOCATE ( surf_usm_h(l)%wshf_eb_av(1:surf_usm_h(l)%ns) )
-                      surf_usm_h(l)%wshf_eb_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%wshf_eb_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%wshf_eb_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%wshf_eb_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_qsws' )
-!
-!--             Array of latent heat flux from surfaces
-!--             Land surfaces
-                IF ( horizontal .AND. .NOT.  ALLOCATED( surf_usm_h(l)%qsws_av ) )  THEN
-                    ALLOCATE ( surf_usm_h(l)%qsws_av(1:surf_usm_h(l)%ns) )
-                    surf_usm_h(l)%qsws_av = 0.0_wp
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%qsws_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%qsws_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%qsws_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_qsws_veg' )
-!
-!--             Array of latent heat flux from vegetation surfaces
-!--             Land surfaces
-                IF ( horizontal .AND. .NOT.  ALLOCATED( surf_usm_h(l)%qsws_veg_av ) )  THEN
-                    ALLOCATE ( surf_usm_h(l)%qsws_veg_av(1:surf_usm_h(l)%ns) )
-                    surf_usm_h(l)%qsws_veg_av = 0.0_wp
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%qsws_veg_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%qsws_veg_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%qsws_veg_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_qsws_liq' )
-!
-!--             Array of latent heat flux from surfaces with liquid
-!--             Land surfaces
-                IF ( horizontal .AND. .NOT.  ALLOCATED( surf_usm_h(l)%qsws_liq_av ) )  THEN
-                    ALLOCATE ( surf_usm_h(l)%qsws_liq_av(1:surf_usm_h(l)%ns) )
-                    surf_usm_h(l)%qsws_liq_av = 0.0_wp
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%qsws_liq_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%qsws_liq_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%qsws_liq_av = 0.0_wp
-                   ENDIF
-                ENDIF
-!
-!--         Please note, the following output quantities belongs to the individual tile fractions -
-!--         ground heat flux at wall-, window-, and green fraction. Aggregated ground-heat flux is
-!--         treated accordingly in average_3d_data, sum_up_3d_data, etc..
-            CASE ( 'usm_wghf' )
-!
-!--             Array of heat flux from ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%wghf_eb_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%wghf_eb_av(1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%wghf_eb_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%wghf_eb_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%wghf_eb_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%wghf_eb_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_wghf_window' )
-!
-!--             Array of heat flux from window ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%wghf_eb_window_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%wghf_eb_window_av(1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%wghf_eb_window_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%wghf_eb_window_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%wghf_eb_window_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%wghf_eb_window_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_wghf_green' )
-!
-!--             Array of heat flux from green ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%wghf_eb_green_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%wghf_eb_green_av(1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%wghf_eb_green_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%wghf_eb_green_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%wghf_eb_green_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%wghf_eb_green_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_iwghf' )
-!
-!--             Array of heat flux from indoor ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%iwghf_eb_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%iwghf_eb_av(1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%iwghf_eb_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%iwghf_eb_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%iwghf_eb_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%iwghf_eb_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_iwghf_window' )
-!
-!--             Array of heat flux from indoor window ground (wall, roof, land)
-                IF ( horizontal ) THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%iwghf_eb_window_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%iwghf_eb_window_av(1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%iwghf_eb_window_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%iwghf_eb_window_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%iwghf_eb_window_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%iwghf_eb_window_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_t_surf_wall' )
-!
-!--             Surface temperature for surfaces
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%t_surf_wall_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%t_surf_wall_av(1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%t_surf_wall_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_surf_wall_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%t_surf_wall_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%t_surf_wall_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_t_surf_window' )
-!
-!--             Surface temperature for window surfaces
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%t_surf_window_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%t_surf_window_av(1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%t_surf_window_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_surf_window_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%t_surf_window_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%t_surf_window_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_t_surf_green' )
-!
-!--             Surface temperature for green surfaces
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%t_surf_green_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%t_surf_green_av(1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%t_surf_green_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_surf_green_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%t_surf_green_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%t_surf_green_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_theta_10cm' )
-!
-!--             Near surface (10cm) temperature for whole surfaces
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%pt_10cm_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%pt_10cm_av(1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%pt_10cm_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%pt_10cm_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%pt_10cm_av(1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%pt_10cm_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_t_wall' )
-!
-!--             Wall temperature for iwl layer of walls and land
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%t_wall_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%t_wall_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_wall_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%t_wall_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_t_window' )
-!
-!--             Window temperature for iwl layer of walls and land
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%t_window_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%t_window_av(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%t_window_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_window_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%t_window_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%t_window_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-            CASE ( 'usm_t_green' )
-!
-!--             Green temperature for iwl layer of walls and land
-                IF ( horizontal )  THEN
-                   IF ( .NOT.  ALLOCATED( surf_usm_h(l)%t_green_av ) )  THEN
-                       ALLOCATE ( surf_usm_h(l)%t_green_av(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns) )
-                       surf_usm_h(l)%t_green_av = 0.0_wp
-                   ENDIF
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_green_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%t_green_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%t_green_av = 0.0_wp
-                   ENDIF
-                ENDIF
-            CASE ( 'usm_swc' )
-!
-!--             Soil water content for iwl layer of walls and land
-                IF ( horizontal .AND. .NOT.  ALLOCATED( surf_usm_h(l)%swc_av ) )  THEN
-                    ALLOCATE ( surf_usm_h(l)%swc_av(nzb_wall:nzt_wall,1:surf_usm_h(l)%ns) )
-                    surf_usm_h(l)%swc_av = 0.0_wp
-                ELSE
-                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%swc_av ) )  THEN
-                       ALLOCATE ( surf_usm_v(l)%swc_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
-                       surf_usm_v(l)%swc_av = 0.0_wp
-                   ENDIF
-                ENDIF
-
-           CASE DEFAULT
-               CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'sum' )  THEN
-
-       SELECT CASE ( TRIM( var ) )
-
-            CASE ( 'usm_wshf' )
-!
-!--             Array of sensible heat flux from surfaces (land, roof, wall)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%wshf_eb_av(m) = surf_usm_h(l)%wshf_eb_av(m) + surf_usm_h(l)%wshf_eb(m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%wshf_eb_av(m) = surf_usm_v(l)%wshf_eb_av(m) +                  &
-                                                    surf_usm_v(l)%wshf_eb(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_qsws' )
-!
-!--             Array of latent heat flux from surfaces (land, roof, wall)
-                IF ( horizontal ) THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   surf_usm_h(l)%qsws_av(m) = surf_usm_h(l)%qsws_av(m) + surf_usm_h(l)%qsws(m) * l_v
-                ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%qsws_av(m) =  surf_usm_v(l)%qsws_av(m) +                       &
-                                                  surf_usm_v(l)%qsws(m) * l_v
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_qsws_veg' )
-!
-!--             Array of latent heat flux from vegetation surfaces (land, roof, wall)
-                IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   surf_usm_h(l)%qsws_veg_av(m) = surf_usm_h(l)%qsws_veg_av(m) + surf_usm_h(l)%qsws_veg(m)
-                ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%qsws_veg_av(m) = surf_usm_v(l)%qsws_veg_av(m) +                &
-                                                     surf_usm_v(l)%qsws_veg(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_qsws_liq' )
-!
-!--             Array of latent heat flux from surfaces with liquid (land, roof, wall)
-                IF ( horizontal ) THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   surf_usm_h(l)%qsws_liq_av(m) = surf_usm_h(l)%qsws_liq_av(m) +                         &
-                                               surf_usm_h(l)%qsws_liq(m)
-                ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%qsws_liq_av(m) = surf_usm_v(l)%qsws_liq_av(m) +                &
-                                                     surf_usm_v(l)%qsws_liq(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_wghf' )
-!
-!--             Array of heat flux from ground (wall, roof, land)
-                IF ( horizontal ) THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%wghf_eb_av(m) = surf_usm_h(l)%wghf_eb_av(m) +                        &
-                                                 surf_usm_h(l)%wghf_eb(m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%wghf_eb_av(m) = surf_usm_v(l)%wghf_eb_av(m) +                  &
-                                                    surf_usm_v(l)%wghf_eb(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_wghf_window' )
-!
-!--             Array of heat flux from window ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%wghf_eb_window_av(m) = surf_usm_h(l)%wghf_eb_window_av(m) +          &
-                                                        surf_usm_h(l)%wghf_eb_window(m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%wghf_eb_window_av(m) = surf_usm_v(l)%wghf_eb_window_av(m) +    &
-                                                           surf_usm_v(l)%wghf_eb_window(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_wghf_green' )
-!
-!--             Array of heat flux from green ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%wghf_eb_green_av(m) = surf_usm_h(l)%wghf_eb_green_av(m) +            &
-                                                       surf_usm_h(l)%wghf_eb_green(m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%wghf_eb_green_av(m) = surf_usm_v(l)%wghf_eb_green_av(m) +      &
-                                                          surf_usm_v(l)%wghf_eb_green(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_iwghf' )
-!
-!--             Array of heat flux from indoor ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%iwghf_eb_av(m) = surf_usm_h(l)%iwghf_eb_av(m) + surf_usm_h(l)%iwghf_eb(m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%iwghf_eb_av(m) = surf_usm_v(l)%iwghf_eb_av(m) +                &
-                                                     surf_usm_v(l)%iwghf_eb(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_iwghf_window' )
-!
-!--             Array of heat flux from indoor window ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%iwghf_eb_window_av(m) = surf_usm_h(l)%iwghf_eb_window_av(m) +        &
-                                                         surf_usm_h(l)%iwghf_eb_window(m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%iwghf_eb_window_av(m) = surf_usm_v(l)%iwghf_eb_window_av(m) +  &
-                                                            surf_usm_v(l)%iwghf_eb_window(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_surf_wall' )
-!
-!--             Surface temperature for surfaces
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                   surf_usm_h(l)%t_surf_wall_av(m) = surf_usm_h(l)%t_surf_wall_av(m) + t_surf_wall_h(l)%val(m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_surf_wall_av(m) = surf_usm_v(l)%t_surf_wall_av(m) +          &
-                                                        t_surf_wall_v(l)%val(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_surf_window' )
-!
-!--             Surface temperature for window surfaces
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%t_surf_window_av(m) = surf_usm_h(l)%t_surf_window_av(m) +            &
-                                                       t_surf_window_h(l)%val(m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_surf_window_av(m) = surf_usm_v(l)%t_surf_window_av(m) +      &
-                                                          t_surf_window_v(l)%val(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_surf_green' )
-!
-!--             Surface temperature for green surfaces
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%t_surf_green_av(m) = surf_usm_h(l)%t_surf_green_av(m) +              &
-                                                      t_surf_green_h(l)%val(m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_surf_green_av(m) = surf_usm_v(l)%t_surf_green_av(m) +        &
-                                                         t_surf_green_v(l)%val(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_theta_10cm' )
-!
-!--             Near surface temperature for whole surfaces
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%pt_10cm_av(m) = surf_usm_h(l)%pt_10cm_av(m) +                        &
-                                                 surf_usm_h(l)%pt_10cm(m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%pt_10cm_av(m) = surf_usm_v(l)%pt_10cm_av(m) +                  &
-                                                    surf_usm_v(l)%pt_10cm(m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_wall' )
-!
-!--             Wall temperature for  iwl layer of walls and land
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%t_wall_av(iwl,m) = surf_usm_h(l)%t_wall_av(iwl,m) +                  &
-                                                    t_wall_h(l)%val(iwl,m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_wall_av(iwl,m) = surf_usm_v(l)%t_wall_av(iwl,m) +            &
-                                                       t_wall_v(l)%val(iwl,m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_window' )
-!
-!--             Window temperature for  iwl layer of walls and land
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%t_window_av(iwl,m) = surf_usm_h(l)%t_window_av(iwl,m) +              &
-                                                         t_window_h(l)%val(iwl,m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_window_av(iwl,m) = surf_usm_v(l)%t_window_av(iwl,m) +        &
-                                                         t_window_v(l)%val(iwl,m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_green' )
-!
-!--             Green temperature for  iwl layer of walls and land
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%t_green_av(iwl,m) = surf_usm_h(l)%t_green_av(iwl,m) + t_green_h(l)%val(iwl,m)
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_green_av(iwl,m) = surf_usm_v(l)%t_green_av(iwl,m) +          &
-                                                        t_green_v(l)%val(iwl,m)
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_swc' )
-!
-!--             Soil water content for  iwl layer of walls and land
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%swc_av(iwl,m) = surf_usm_h(l)%swc_av(iwl,m) + swc_h(l)%val(iwl,m)
-                   ENDDO
-                ELSE
-                ENDIF
-
-            CASE DEFAULT
-                CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'average' )  THEN
-
-       SELECT CASE ( TRIM( var ) )
-
-            CASE ( 'usm_wshf' )
-!
-!--             Array of sensible heat flux from surfaces (land, roof, wall)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%wshf_eb_av(m) = surf_usm_h(l)%wshf_eb_av(m) /                        &
-                                                 REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%wshf_eb_av(m) = surf_usm_v(l)%wshf_eb_av(m) /                  &
-                                                    REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_qsws' )
-!
-!--             Array of latent heat flux from surfaces (land, roof, wall)
-                IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   surf_usm_h(l)%qsws_av(m) = surf_usm_h(l)%qsws_av(m) /                                 &
-                                           REAL( average_count_3d, kind=wp )
-                ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%qsws_av(m) = surf_usm_v(l)%qsws_av(m) /                        &
-                                                 REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_qsws_veg' )
-!
-!--             Array of latent heat flux from vegetation surfaces (land, roof, wall)
-                IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   surf_usm_h(l)%qsws_veg_av(m) = surf_usm_h(l)%qsws_veg_av(m) /                         &
-                                               REAL( average_count_3d, kind=wp )
-                ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%qsws_veg_av(m) = surf_usm_v(l)%qsws_veg_av(m) /                &
-                                                     REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_qsws_liq' )
-!
-!--             Array of latent heat flux from surfaces with liquid (land, roof, wall)
-                IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   surf_usm_h(l)%qsws_liq_av(m) = surf_usm_h(l)%qsws_liq_av(m) /                         &
-                                               REAL( average_count_3d, kind=wp )
-                ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%qsws_liq_av(m) = surf_usm_v(l)%qsws_liq_av(m) /                &
-                                                     REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_wghf' )
-!
-!--             Array of heat flux from ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%wghf_eb_av(m) = surf_usm_h(l)%wghf_eb_av(m) /                        &
-                                                 REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%wghf_eb_av(m) = surf_usm_v(l)%wghf_eb_av(m) /                  &
-                                                    REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_wghf_window' )
-!
-!--             Array of heat flux from window ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%wghf_eb_window_av(m) = surf_usm_h(l)%wghf_eb_window_av(m) /          &
-                                                        REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%wghf_eb_window_av(m) = surf_usm_v(l)%wghf_eb_window_av(m) /    &
-                                                           REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_wghf_green' )
-!
-!--             Array of heat flux from green ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%wghf_eb_green_av(m) = surf_usm_h(l)%wghf_eb_green_av(m) /            &
-                                                       REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%wghf_eb_green_av(m) = surf_usm_v(l)%wghf_eb_green_av(m) /      &
-                                                          REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_iwghf' )
-!
-!--             Array of heat flux from indoor ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%iwghf_eb_av(m) = surf_usm_h(l)%iwghf_eb_av(m) /                      &
-                                                  REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%iwghf_eb_av(m) = surf_usm_v(l)%iwghf_eb_av(m) /                &
-                                                     REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_iwghf_window' )
-!
-!--             Array of heat flux from indoor window ground (wall, roof, land)
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%iwghf_eb_window_av(m) = surf_usm_h(l)%iwghf_eb_window_av(m) /        &
-                                                         REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%iwghf_eb_window_av(m) = surf_usm_v(l)%iwghf_eb_window_av(m) /  &
-                                                            REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_surf_wall' )
-!
-!--             Surface temperature for surfaces
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                   surf_usm_h(l)%t_surf_wall_av(m) = surf_usm_h(l)%t_surf_wall_av(m) /                   &
-                                                  REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_surf_wall_av(m) = surf_usm_v(l)%t_surf_wall_av(m) /          &
-                                                        REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_surf_window' )
-!
-!--             Surface temperature for window surfaces
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%t_surf_window_av(m) = surf_usm_h(l)%t_surf_window_av(m) /            &
-                                                       REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_surf_window_av(m) = surf_usm_v(l)%t_surf_window_av(m) /      &
-                                                          REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_surf_green' )
-!
-!--             Surface temperature for green surfaces
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%t_surf_green_av(m) = surf_usm_h(l)%t_surf_green_av(m) /              &
-                                                      REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_surf_green_av(m) = surf_usm_v(l)%t_surf_green_av(m) /        &
-                                                         REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_theta_10cm' )
-!
-!--             Near surface temperature for whole surfaces
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%pt_10cm_av(m) = surf_usm_h(l)%pt_10cm_av(m) /                        &
-                                                 REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%pt_10cm_av(m) = surf_usm_v(l)%pt_10cm_av(m) /                  &
-                                                    REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-
-            CASE ( 'usm_t_wall' )
-!
-!--             Wall temperature for  iwl layer of walls and land
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%t_wall_av(iwl,m) = surf_usm_h(l)%t_wall_av(iwl,m) /                  &
-                                                    REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_wall_av(iwl,m) = surf_usm_v(l)%t_wall_av(iwl,m) /            &
-                                                       REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_window' )
-!
-!--             Window temperature for  iwl layer of walls and land
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%t_window_av(iwl,m) = surf_usm_h(l)%t_window_av(iwl,m) /              &
-                                                      REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_window_av(iwl,m) = surf_usm_v(l)%t_window_av(iwl,m) /        &
-                                                         REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_t_green' )
-!
-!--             Green temperature for  iwl layer of walls and land
-                IF ( horizontal )  THEN
-                   DO  m = 1, surf_usm_h(l)%ns
-                      surf_usm_h(l)%t_green_av(iwl,m) = surf_usm_h(l)%t_green_av(iwl,m) /                &
-                                                     REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%t_green_av(iwl,m) = surf_usm_v(l)%t_green_av(iwl,m) /          &
-                                                        REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-            CASE ( 'usm_swc' )
-!
-!--             Soil water content for  iwl layer of walls and land
-                IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   surf_usm_h(l)%swc_av(iwl,m) = surf_usm_h(l)%swc_av(iwl,m) /                           &
-                                              REAL( average_count_3d, kind=wp )
-                ENDDO
-                ELSE
-                   DO  m = 1, surf_usm_v(l)%ns
-                      surf_usm_v(l)%swc_av(iwl,m) = surf_usm_v(l)%swc_av(iwl,m) /                  &
-                                                    REAL( average_count_3d, kind=wp )
-                   ENDDO
-                ENDIF
-
-
-       END SELECT
-
-    ENDIF
-
- END SUBROUTINE usm_3d_data_averaging
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set internal Neumann boundary condition at outer soil grid points for temperature and humidity.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_boundary_condition
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i      !< grid index x-direction
-    INTEGER(iwp) ::  ioff   !< offset index x-direction indicating location of soil grid point
-    INTEGER(iwp) ::  j      !< grid index y-direction
-    INTEGER(iwp) ::  joff   !< offset index x-direction indicating location of soil grid point
-    INTEGER(iwp) ::  k      !< grid index z-direction
-    INTEGER(iwp) ::  koff   !< offset index x-direction indicating location of soil grid point
-    INTEGER(iwp) ::  l      !< running index surface-orientation
-    INTEGER(iwp) ::  m      !< running index surface elements
-
-    DO  l = 0, 1
-       koff = surf_usm_h(l)%koff
-       DO  m = 1, surf_usm_h(l)%ns
-          i = surf_usm_h(l)%i(m)
-          j = surf_usm_h(l)%j(m)
-          k = surf_usm_h(l)%k(m)
-          pt(k+koff,j,i) = pt(k,j,i)
-       ENDDO
-    ENDDO
-
-    DO  l = 0, 3
-       ioff = surf_usm_v(l)%ioff
-       joff = surf_usm_v(l)%joff
-       DO  m = 1, surf_usm_v(l)%ns
-          i = surf_usm_v(l)%i(m)
-          j = surf_usm_v(l)%j(m)
-          k = surf_usm_v(l)%k(m)
-          pt(k,j+joff,i+ioff) = pt(k,j,i)
-       ENDDO
-    ENDDO
-
- END SUBROUTINE usm_boundary_condition
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine checks variables and assigns units.
-!> It is called out from subroutine check_parameters.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_check_data_output( variable, unit )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*),INTENT(IN)    ::  variable   !<
-    CHARACTER(LEN=*),INTENT(OUT)   ::  unit       !<
-
-    CHARACTER(LEN=2)                              ::  ls            !<
-
-    CHARACTER(LEN=varnamelength)                  ::  var           !< TRIM(variable)
-
-    INTEGER(iwp)                                  ::  i,j,l         !< index
-
-    INTEGER(iwp), PARAMETER                       ::  nl1 = 15      !< number of directional usm variables
-    CHARACTER(LEN=varnamelength), DIMENSION(nl1)  ::  varlist1 = &  !< list of directional usm variables
-              (/'usm_wshf                      ', &
-                'usm_wghf                      ', &
-                'usm_wghf_window               ', &
-                'usm_wghf_green                ', &
-                'usm_iwghf                     ', &
-                'usm_iwghf_window              ', &
-                'usm_surfz                     ', &
-                'usm_surfwintrans              ', &
-                'usm_surfcat                   ', &
-                'usm_t_surf_wall               ', &
-                'usm_t_surf_window             ', &
-                'usm_t_surf_green              ', &
-                'usm_t_green                   ', &
-                'usm_qsws                      ', &
-                'usm_theta_10cm                '/)
-
-    INTEGER(iwp), PARAMETER                       ::  nl2 = 3       !< number of directional layer usm variables
-    CHARACTER(LEN=varnamelength), DIMENSION(nl2)  ::  varlist2 = &  !< list of directional layer usm variables
-              (/'usm_t_wall                    ', &
-                'usm_t_window                  ', &
-                'usm_t_green                   '/)
-
-    LOGICAL                                       ::  lfound     !< flag if the variable is found
-
-
-    lfound = .FALSE.
-
-    var = TRIM( variable )
-
-!
-!-- Check if variable exists
-!-- Directional variables
-    DO  i = 1, nl1
-       DO  j = 0, nd-1
-          IF ( TRIM( var ) == TRIM( varlist1(i)) // TRIM( dirname(j) ) )  THEN
-             lfound = .TRUE.
-             EXIT
-          ENDIF
-          IF ( lfound )  EXIT
-       ENDDO
-    ENDDO
-    IF ( lfound )  GOTO 10
-!
-!-- Directional layer variables
-    DO  i = 1, nl2
-       DO  j = 0, nd-1
-          DO  l = nzb_wall, nzt_wall
-             WRITE( ls,'(A1,I1)' ) '_', l
-             IF ( TRIM( var ) == TRIM( varlist2(i) ) // TRIM( ls ) // TRIM( dirname(j) ) )  THEN
-                lfound = .TRUE.
-                EXIT
-             ENDIF
-          ENDDO
-          IF ( lfound )  EXIT
-       ENDDO
-    ENDDO
-    IF ( .NOT.  lfound )  THEN
-       unit = 'illegal'
-       RETURN
-    ENDIF
-10  CONTINUE
-
-    IF ( var(1:9)  == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_' .OR.                              &
-         var(1:16) == 'usm_wghf_window_' .OR. var(1:15) == 'usm_wghf_green_' .OR.                  &
-         var(1:10) == 'usm_iwghf_' .OR. var(1:17) == 'usm_iwghf_window_'    .OR.                   &
-         var(1:17) == 'usm_surfwintrans_' .OR.                                                     &
-         var(1:9)  == 'usm_qsws_'  .OR.  var(1:13)  == 'usm_qsws_veg_'  .OR.                       &
-         var(1:13) == 'usm_qsws_liq_' )  THEN
-        unit = 'W/m2'
-    ELSE IF ( var(1:15) == 'usm_t_surf_wall'   .OR.  var(1:10) == 'usm_t_wall' .OR.                &
-              var(1:12) == 'usm_t_window' .OR. var(1:17) == 'usm_t_surf_window' .OR.               &
-              var(1:16) == 'usm_t_surf_green'  .OR.                                                &
-              var(1:11) == 'usm_t_green' .OR.  var(1:7) == 'usm_swc' .OR.                          &
-              var(1:14) == 'usm_theta_10cm' )  THEN
-        unit = 'K'
-    ELSE IF ( var(1:9) == 'usm_surfz'  .OR.  var(1:11) == 'usm_surfcat' )  THEN
-        unit = '1'
-    ELSE
-        unit = 'illegal'
-    ENDIF
-
- END SUBROUTINE usm_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters routine for urban surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_check_parameters
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_pt_b,                                                                            &
-               bc_q_b,                                                                             &
-               constant_flux_layer,                                                                &
-               large_scale_forcing,                                                                &
-               lsf_surf,                                                                           &
-               topography
-
-    USE netcdf_data_input_mod,                                                                     &
-         ONLY:  building_type_f
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< running index, x-dimension
-    INTEGER(iwp) ::  j  !< running index, y-dimension
-
-!
-!-- Dirichlet boundary conditions are required as the surface fluxes are calculated from the
-!-- temperature/humidity gradients in the urban surface model
-    IF ( bc_pt_b == 'neumann'   .OR.   bc_q_b == 'neumann' )  THEN
-       message_string = 'urban surface model requires setting of bc_pt_b = "dirichlet" and '//     &
-                        'bc_q_b  = "dirichlet"'
-       CALL message( 'usm_check_parameters', 'PA0590', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( .NOT.  constant_flux_layer )  THEN
-       message_string = 'urban surface model requires constant_flux_layer = .TRUE.'
-       CALL message( 'usm_check_parameters', 'PA0084', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF (  .NOT.  radiation )  THEN
-       message_string = 'urban surface model requires the radiation model to be switched on'
-       CALL message( 'usm_check_parameters', 'PA0084', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Surface forcing has to be disabled for LSF in case of enabled urban surface module
-    IF ( large_scale_forcing )  THEN
-       lsf_surf = .FALSE.
-    ENDIF
-!
-!-- Topography
-    IF ( topography == 'flat' )  THEN
-       message_string = 'topography /= "flat" is required when using the urban surface model'
-       CALL message( 'usm_check_parameters', 'PA0592', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Check if building types are set within a valid range.
-    IF ( building_type < LBOUND( building_pars, 2 )  .AND.                                         &
-         building_type > UBOUND( building_pars, 2 ) )  THEN
-       WRITE( message_string, * ) 'building_type = ', building_type, ' is out of the valid range'
-       CALL message( 'usm_check_parameters', 'PA0529', 2, 2, 0, 6, 0 )
-    ENDIF
-    IF ( building_type_f%from_file )  THEN
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             IF ( building_type_f%var(j,i) /= building_type_f%fill  .AND.                          &
-           ( building_type_f%var(j,i) < LBOUND( building_pars, 2 )  .OR.                           &
-             building_type_f%var(j,i) > UBOUND( building_pars, 2 ) ) )  THEN
-                WRITE( message_string, * ) 'building_type = is out of the valid range at (j,i) = ' &
-                                           , j, i
-                CALL message( 'usm_check_parameters', 'PA0529', 2, 2, myid, 6, 0 )
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDIF
- END SUBROUTINE usm_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Output of the 3D-arrays in netCDF and/or AVS format for variables of urban_surface model.
-!> It resorts the urban surface module output quantities from surf style indexing into temporary 3D
-!> array with indices (i,j,k). It is called from subroutine data_output_3d.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)   ::  variable  !< variable name
-
-    CHARACTER(LEN=varnamelength)   ::  var  !< trimmed variable name
-
-    INTEGER(iwp), INTENT(IN)       ::  av        !< flag if averaged
-    INTEGER(iwp), INTENT(IN)       ::  nzb_do    !< lower limit of the data output (usually 0)
-    INTEGER(iwp), INTENT(IN)       ::  nzt_do    !< vertical upper limit of the data output (usually nz_do3d)
-
-    INTEGER(iwp)  ::  ids, idsint, idsidx        !<
-    INTEGER(iwp)  ::  i, j, k, iwl, istat, l, m  !< running indices
-    LOGICAL       ::  horizontal                 !< horizontal upward or downeard facing surface
-
-    LOGICAL, INTENT(OUT)           ::  found     !<
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< sp - it has to correspond to module data_output_3d
-    REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr)     ::  temp_pf   !< temp array for urban surface output procedure
-
-    found = .TRUE.
-    temp_pf = -1._wp
-
-    ids = -1
-    var = TRIM( variable )
-    DO i = 0, nd-1
-        k = len( TRIM( var ) )
-        j = len( TRIM( dirname(i) ) )
-        IF ( TRIM( var(k-j+1:k) ) == TRIM( dirname(i) ) )  THEN
-            ids = i
-            idsint = dirint(ids)
-            idsidx = diridx(ids)
-            var = var(:k-j)
-            EXIT
-        ENDIF
-    ENDDO
-    horizontal = ( ( idsint == iup ) .OR. (idsint == idown ) )
-    l = idsidx !< shorter direction index name
-
-    IF ( ids == -1 )  THEN
-        var = TRIM( variable )
-    ENDIF
-    IF ( var(1:11) == 'usm_t_wall_'  .AND.  len( TRIM( var ) ) >= 12 )  THEN
-!
-!--     Wall layers
-        READ( var(12:12), '(I1)', iostat = istat ) iwl
-        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
-            var = var(1:10)
-        ENDIF
-    ENDIF
-    IF ( var(1:13) == 'usm_t_window_'  .AND.  len( TRIM( var ) ) >= 14 )  THEN
-!
-!--     Window layers
-        READ( var(14:14), '(I1)', iostat = istat ) iwl
-        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
-            var = var(1:12)
-        ENDIF
-    ENDIF
-    IF ( var(1:12) == 'usm_t_green_'  .AND.  len( TRIM( var ) ) >= 13 )  THEN
-!
-!--     Green layers
-        READ( var(13:13), '(I1)', iostat = istat ) iwl
-        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
-            var = var(1:11)
-        ENDIF
-    ENDIF
-    IF ( var(1:8) == 'usm_swc_'  .AND.  len( TRIM( var ) ) >= 9 )  THEN
-!
-!--     Green layers soil water content
-        READ( var(9:9), '(I1)', iostat = istat ) iwl
-        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
-            var = var(1:7)
-        ENDIF
-    ENDIF
-
-    SELECT CASE ( TRIM( var ) )
-
-      CASE ( 'usm_surfz' )
-!
-!--       Array of surface height (z)
-          IF ( horizontal )  THEN
-             DO  m = 1, surf_usm_h(l)%ns
-                i = surf_usm_h(l)%i(m)
-                j = surf_usm_h(l)%j(m)
-                k = surf_usm_h(l)%k(m)
-                temp_pf(0,j,i) = MAX( temp_pf(0,j,i), REAL( k, KIND = wp) )
-             ENDDO
-          ELSE
-             DO  m = 1, surf_usm_v(l)%ns
-                i = surf_usm_v(l)%i(m)
-                j = surf_usm_v(l)%j(m)
-                k = surf_usm_v(l)%k(m)
-                temp_pf(0,j,i) = MAX( temp_pf(0,j,i), REAL( k, KIND = wp) + 1.0_sp )
-             ENDDO
-          ENDIF
-
-      CASE ( 'usm_surfcat' )
-!
-!--       Surface category
-          IF ( horizontal )  THEN
-             DO  m = 1, surf_usm_h(l)%ns
-                i = surf_usm_h(l)%i(m)
-                j = surf_usm_h(l)%j(m)
-                k = surf_usm_h(l)%k(m)
-                temp_pf(k,j,i) = surf_usm_h(l)%surface_types(m)
-             ENDDO
-          ELSE
-             DO  m = 1, surf_usm_v(l)%ns
-                i = surf_usm_v(l)%i(m)
-                j = surf_usm_v(l)%j(m)
-                k = surf_usm_v(l)%k(m)
-                temp_pf(k,j,i) = surf_usm_v(l)%surface_types(m)
-             ENDDO
-          ENDIF
-
-      CASE ( 'usm_surfwintrans' )
-!
-!--       Transmissivity window tiles
-          IF ( horizontal )  THEN
-             DO  m = 1, surf_usm_h(l)%ns
-                i = surf_usm_h(l)%i(m)
-                j = surf_usm_h(l)%j(m)
-                k = surf_usm_h(l)%k(m)
-                temp_pf(k,j,i) = surf_usm_h(l)%transmissivity(m)
-             ENDDO
-          ELSE
-             DO  m = 1, surf_usm_v(l)%ns
-                i = surf_usm_v(l)%i(m)
-                j = surf_usm_v(l)%j(m)
-                k = surf_usm_v(l)%k(m)
-                temp_pf(k,j,i) = surf_usm_v(l)%transmissivity(m)
-             ENDDO
-          ENDIF
-
-      CASE ( 'usm_wshf' )
-!
-!--       Array of sensible heat flux from surfaces
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%wshf_eb(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%wshf_eb(m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%wshf_eb_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%wshf_eb_av(m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-
-      CASE ( 'usm_qsws' )
-!
-!--       Array of latent heat flux from surfaces
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%qsws(m) * l_v
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%qsws(m) * l_v
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%qsws_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%qsws_av(m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_qsws_veg' )
-!
-!--       Array of latent heat flux from vegetation surfaces
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%qsws_veg(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg(m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%qsws_veg_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg_av(m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_qsws_liq' )
-!
-!--       Array of latent heat flux from surfaces with liquid
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%qsws_liq(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq(m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%qsws_liq_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq_av(m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_wghf' )
-!
-!--       Array of heat flux from ground (land, wall, roof)
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%wghf_eb(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb(m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%wghf_eb_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_av(m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_wghf_window' )
-!
-!--       Array of heat flux from window ground (land, wall, roof)
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%wghf_eb_window(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window(m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%wghf_eb_window_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window_av(m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_wghf_green' )
-!
-!--       Array of heat flux from green ground (land, wall, roof)
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%wghf_eb_green(m)
-                ENDDO
-             ELSE
-                l = idsidx
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green(m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%wghf_eb_green_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green_av(m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_iwghf' )
-!
-!--       Array of heat flux from indoor ground (land, wall, roof)
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%iwghf_eb(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb(m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%iwghf_eb_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_av(m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_iwghf_window' )
-!
-!--       Array of heat flux from indoor window ground (land, wall, roof)
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%iwghf_eb_window(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window(m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%iwghf_eb_window_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window_av(m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_t_surf_wall' )
-!
-!--       Surface temperature for surfaces
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = t_surf_wall_h(l)%val(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = t_surf_wall_v(l)%val(m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%t_surf_wall_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%t_surf_wall_av(m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_t_surf_window' )
-!
-!--       Surface temperature for window surfaces
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = t_surf_window_h(l)%val(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = t_surf_window_v(l)%val(m)
-                ENDDO
-             ENDIF
-
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%t_surf_window_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%t_surf_window_av(m)
-                ENDDO
-
-             ENDIF
-
-          ENDIF
-
-      CASE ( 'usm_t_surf_green' )
-!
-!--       Surface temperature for green surfaces
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = t_surf_green_h(l)%val(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = t_surf_green_v(l)%val(m)
-                ENDDO
-             ENDIF
-
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%t_surf_green_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%t_surf_green_av(m)
-                ENDDO
-
-             ENDIF
-
-          ENDIF
-
-      CASE ( 'usm_theta_10cm' )
-!
-!--       Near surface temperature for whole surfaces
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%pt_10cm(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%pt_10cm(m)
-                ENDDO
-             ENDIF
-
-
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%pt_10cm_av(m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%pt_10cm_av(m)
-                ENDDO
-
-              ENDIF
-          ENDIF
-
-      CASE ( 'usm_t_wall' )
-!
-!--       Wall temperature for  iwl layer of walls and land
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = t_wall_h(l)%val(iwl,m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = t_wall_v(l)%val(iwl,m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%t_wall_av(iwl,m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%t_wall_av(iwl,m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_t_window' )
-!
-!--       Window temperature for iwl layer of walls and land
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = t_window_h(l)%val(iwl,m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = t_window_v(l)%val(iwl,m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%t_window_av(iwl,m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%t_window_av(iwl,m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-      CASE ( 'usm_t_green' )
-!
-!--       Green temperature for  iwl layer of walls and land
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = t_green_h(l)%val(iwl,m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = t_green_v(l)%val(iwl,m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%t_green_av(iwl,m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%t_green_av(iwl,m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-          CASE ( 'usm_swc' )
-!
-!--       Soil water content for  iwl layer of walls and land
-          IF ( av == 0 )  THEN
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = swc_h(l)%val(iwl,m)
-                ENDDO
-             ENDIF
-          ELSE
-             IF ( horizontal )  THEN
-                DO  m = 1, surf_usm_h(l)%ns
-                   i = surf_usm_h(l)%i(m)
-                   j = surf_usm_h(l)%j(m)
-                   k = surf_usm_h(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_h(l)%swc_av(iwl,m)
-                ENDDO
-             ELSE
-                DO  m = 1, surf_usm_v(l)%ns
-                   i = surf_usm_v(l)%i(m)
-                   j = surf_usm_v(l)%j(m)
-                   k = surf_usm_v(l)%k(m)
-                   temp_pf(k,j,i) = surf_usm_v(l)%swc_av(iwl,m)
-                ENDDO
-             ENDIF
-          ENDIF
-
-
-      CASE DEFAULT
-          found = .FALSE.
-          RETURN
-    END SELECT
-
-!
-!-- Rearrange dimensions for NetCDF output
-!-- FIXME: this may generate FPE overflow upon conversion from DP to SP
-    DO  j = nys, nyn
-        DO  i = nxl, nxr
-            DO  k = nzb_do, nzt_do
-                local_pf(i,j,k) = temp_pf(k,j,i)
-            ENDDO
-        ENDDO
-    ENDDO
-
- END SUBROUTINE usm_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Soubroutine defines appropriate grid for netcdf variables.
-!> It is called out from subroutine netcdf.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN)  ::  variable  !<
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_x    !<
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_y    !<
-    CHARACTER(LEN=*), INTENT(OUT) ::  grid_z    !<
-
-    CHARACTER(LEN=varnamelength)  ::  var  !<
-
-    LOGICAL, INTENT(OUT)  ::  found  !<
-
-    var = TRIM( variable )
-    IF ( var(1:9) == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_'  .OR.                              &
-         var(1:16) == 'usm_wghf_window_'  .OR. var(1:15) == 'usm_wghf_green_' .OR.                 &
-         var(1:10) == 'usm_iwghf_'  .OR. var(1:17) == 'usm_iwghf_window_' .OR.                     &
-         var(1:9) == 'usm_qsws_'  .OR.  var(1:13) == 'usm_qsws_veg_'  .OR.                         &
-         var(1:13) == 'usm_qsws_liq_' .OR.                                                         &
-         var(1:15) == 'usm_t_surf_wall'  .OR.  var(1:10) == 'usm_t_wall'  .OR.                     &
-         var(1:17) == 'usm_t_surf_window'  .OR.  var(1:12) == 'usm_t_window'  .OR.                 &
-         var(1:16) == 'usm_t_surf_green'  .OR. var(1:11) == 'usm_t_green' .OR.                     &
-         var(1:15) == 'usm_theta_10cm' .OR.                                                        &
-         var(1:9) == 'usm_surfz'  .OR.  var(1:11) == 'usm_surfcat'  .OR.                           &
-         var(1:16) == 'usm_surfwintrans'  .OR. var(1:7) == 'usm_swc' ) THEN
-
-        found = .TRUE.
-        grid_x = 'x'
-        grid_y = 'y'
-        grid_z = 'zu'
-    ELSE
-        found  = .FALSE.
-        grid_x = 'none'
-        grid_y = 'none'
-        grid_z = 'none'
-    ENDIF
-
- END SUBROUTINE usm_define_netcdf_grid
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the wall surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_init_wall_heat_model
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  k, l, m  !< running indices
-
-    IF ( debug_output )  CALL debug_message( 'usm_init_wall_heat_model', 'start' )
-
-!
-!-- Calculate wall and window grid spacings. Wall temperature is defined at the center of the
-!-- wall layers.
-!-- First for horizontal surfaces:
-    DO  l = 0, 1
-       DO  m = 1, surf_usm_h(l)%ns
-
-          surf_usm_h(l)%dz_wall(nzb_wall,m) = surf_usm_h(l)%zw(nzb_wall,m)
-          DO k = nzb_wall+1, nzt_wall
-             surf_usm_h(l)%dz_wall(k,m) = surf_usm_h(l)%zw(k,m) - surf_usm_h(l)%zw(k-1,m)
-          ENDDO
-          surf_usm_h(l)%dz_window(nzb_wall,m) = surf_usm_h(l)%zw_window(nzb_wall,m)
-          DO  k = nzb_wall+1, nzt_wall
-             surf_usm_h(l)%dz_window(k,m) = surf_usm_h(l)%zw_window(k,m) - surf_usm_h(l)%zw_window(k-1,m)
-          ENDDO
-
-          surf_usm_h(l)%dz_wall(nzt_wall+1,m) = surf_usm_h(l)%dz_wall(nzt_wall,m)
-
-          DO k = nzb_wall, nzt_wall-1
-            surf_usm_h(l)%dz_wall_stag(k,m) = 0.5 * ( surf_usm_h(l)%dz_wall(k+1,m) +                        &
-                                                     surf_usm_h(l)%dz_wall(k,m) )
-          ENDDO
-          surf_usm_h(l)%dz_wall_stag(nzt_wall,m) = surf_usm_h(l)%dz_wall(nzt_wall,m)
-
-          surf_usm_h(l)%dz_window(nzt_wall+1,m) = surf_usm_h(l)%dz_window(nzt_wall,m)
-
-          DO  k = nzb_wall, nzt_wall-1
-             surf_usm_h(l)%dz_window_stag(k,m) = 0.5 * ( surf_usm_h(l)%dz_window(k+1,m) +                   &
-                                                      surf_usm_h(l)%dz_window(k,m) )
-          ENDDO
-          surf_usm_h(l)%dz_window_stag(nzt_wall,m) = surf_usm_h(l)%dz_window(nzt_wall,m)
-
-          IF (surf_usm_h(l)%green_type_roof(m) == 2.0_wp )  THEN
-!
-!--          Extensive green roof
-!--          Set ratio of substrate layer thickness, soil-type and LAI
-             soil_type = 3
-             surf_usm_h(l)%lai(m) = 2.0_wp
-
-             surf_usm_h(l)%zw_green(nzb_wall,m)   = 0.05_wp
-             surf_usm_h(l)%zw_green(nzb_wall+1,m) = 0.10_wp
-             surf_usm_h(l)%zw_green(nzb_wall+2,m) = 0.15_wp
-             surf_usm_h(l)%zw_green(nzb_wall+3,m) = 0.20_wp
-          ELSE
-!
-!--          Intensiv green roof
-!--          Set ratio of substrate layer thickness, soil-type and LAI
-             soil_type = 6
-             surf_usm_h(l)%lai(m) = 4.0_wp
-
-             surf_usm_h(l)%zw_green(nzb_wall,m)   = 0.05_wp
-             surf_usm_h(l)%zw_green(nzb_wall+1,m) = 0.10_wp
-             surf_usm_h(l)%zw_green(nzb_wall+2,m) = 0.40_wp
-             surf_usm_h(l)%zw_green(nzb_wall+3,m) = 0.80_wp
-          ENDIF
-
-          surf_usm_h(l)%dz_green(nzb_wall,m) = surf_usm_h(l)%zw_green(nzb_wall,m)
-          DO k = nzb_wall+1, nzt_wall
-              surf_usm_h(l)%dz_green(k,m) = surf_usm_h(l)%zw_green(k,m) - surf_usm_h(l)%zw_green(k-1,m)
-          ENDDO
-          surf_usm_h(l)%dz_green(nzt_wall+1,m) = surf_usm_h(l)%dz_green(nzt_wall,m)
-
-          DO k = nzb_wall, nzt_wall-1
-              surf_usm_h(l)%dz_green_stag(k,m) = 0.5 * ( surf_usm_h(l)%dz_green(k+1,m) +                    &
-                                                      surf_usm_h(l)%dz_green(k,m) )
-          ENDDO
-          surf_usm_h(l)%dz_green_stag(nzt_wall,m) = surf_usm_h(l)%dz_green(nzt_wall,m)
-
-         IF ( alpha_vangenuchten == 9999999.9_wp )  THEN
-            alpha_vangenuchten = soil_pars(0,soil_type)
-         ENDIF
-
-         IF ( l_vangenuchten == 9999999.9_wp )  THEN
-            l_vangenuchten = soil_pars(1,soil_type)
-         ENDIF
-
-         IF ( n_vangenuchten == 9999999.9_wp )  THEN
-            n_vangenuchten = soil_pars(2,soil_type)
-         ENDIF
-
-         IF ( hydraulic_conductivity == 9999999.9_wp )  THEN
-            hydraulic_conductivity = soil_pars(3,soil_type)
-         ENDIF
-
-         IF ( saturation_moisture == 9999999.9_wp )  THEN
-            saturation_moisture = m_soil_pars(0,soil_type)
-         ENDIF
-
-         IF ( field_capacity == 9999999.9_wp )  THEN
-            field_capacity = m_soil_pars(1,soil_type)
-         ENDIF
-
-         IF ( wilting_point == 9999999.9_wp )  THEN
-            wilting_point = m_soil_pars(2,soil_type)
-         ENDIF
-
-         IF ( residual_moisture == 9999999.9_wp )  THEN
-            residual_moisture = m_soil_pars(3,soil_type)
-         ENDIF
-
-         DO  k = nzb_wall, nzt_wall+1
-            swc_h(l)%val(k,m) = field_capacity
-            rootfr_h(l)%val(k,m) = 0.5_wp
-            surf_usm_h(l)%alpha_vg_green(m)      = alpha_vangenuchten
-            surf_usm_h(l)%l_vg_green(m)          = l_vangenuchten
-            surf_usm_h(l)%n_vg_green(m)          = n_vangenuchten
-            surf_usm_h(l)%gamma_w_green_sat(k,m) = hydraulic_conductivity
-            swc_sat_h(l)%val(k,m)                = saturation_moisture
-            fc_h(l)%val(k,m)                     = field_capacity
-            wilt_h(l)%val(k,m)                   = wilting_point
-            swc_res_h(l)%val(k,m)                = residual_moisture
-         ENDDO
-
-       ENDDO
-
-       surf_usm_h(l)%ddz_wall        = 1.0_wp / surf_usm_h(l)%dz_wall
-       surf_usm_h(l)%ddz_wall_stag   = 1.0_wp / surf_usm_h(l)%dz_wall_stag
-       surf_usm_h(l)%ddz_window      = 1.0_wp / surf_usm_h(l)%dz_window
-       surf_usm_h(l)%ddz_window_stag = 1.0_wp / surf_usm_h(l)%dz_window_stag
-       surf_usm_h(l)%ddz_green       = 1.0_wp / surf_usm_h(l)%dz_green
-       surf_usm_h(l)%ddz_green_stag  = 1.0_wp / surf_usm_h(l)%dz_green_stag
-    ENDDO
-!
-!-- For vertical surfaces
-    DO  l = 0, 3
-       DO  m = 1, surf_usm_v(l)%ns
-          surf_usm_v(l)%dz_wall(nzb_wall,m) = surf_usm_v(l)%zw(nzb_wall,m)
-          DO  k = nzb_wall+1, nzt_wall
-             surf_usm_v(l)%dz_wall(k,m) = surf_usm_v(l)%zw(k,m) - surf_usm_v(l)%zw(k-1,m)
-          ENDDO
-          surf_usm_v(l)%dz_window(nzb_wall,m) = surf_usm_v(l)%zw_window(nzb_wall,m)
-          DO  k = nzb_wall+1, nzt_wall
-             surf_usm_v(l)%dz_window(k,m) = surf_usm_v(l)%zw_window(k,m) -                         &
-                                            surf_usm_v(l)%zw_window(k-1,m)
-          ENDDO
-          surf_usm_v(l)%dz_green(nzb_wall,m) = surf_usm_v(l)%zw_green(nzb_wall,m)
-          DO  k = nzb_wall+1, nzt_wall
-             surf_usm_v(l)%dz_green(k,m) = surf_usm_v(l)%zw_green(k,m) -                           &
-                                           surf_usm_v(l)%zw_green(k-1,m)
-          ENDDO
-
-          surf_usm_v(l)%dz_wall(nzt_wall+1,m) = surf_usm_v(l)%dz_wall(nzt_wall,m)
-
-          DO  k = nzb_wall, nzt_wall-1
-             surf_usm_v(l)%dz_wall_stag(k,m) = 0.5 * ( surf_usm_v(l)%dz_wall(k+1,m) +              &
-                                                       surf_usm_v(l)%dz_wall(k,m) )
-          ENDDO
-          surf_usm_v(l)%dz_wall_stag(nzt_wall,m) = surf_usm_v(l)%dz_wall(nzt_wall,m)
-          surf_usm_v(l)%dz_window(nzt_wall+1,m)  = surf_usm_v(l)%dz_window(nzt_wall,m)
-
-          DO  k = nzb_wall, nzt_wall-1
-             surf_usm_v(l)%dz_window_stag(k,m) = 0.5 * ( surf_usm_v(l)%dz_window(k+1,m) +          &
-                                                         surf_usm_v(l)%dz_window(k,m) )
-          ENDDO
-          surf_usm_v(l)%dz_window_stag(nzt_wall,m) = surf_usm_v(l)%dz_window(nzt_wall,m)
-          surf_usm_v(l)%dz_green(nzt_wall+1,m)     = surf_usm_v(l)%dz_green(nzt_wall,m)
-
-          DO  k = nzb_wall, nzt_wall-1
-             surf_usm_v(l)%dz_green_stag(k,m) = 0.5 * ( surf_usm_v(l)%dz_green(k+1,m) +            &
-                                                        surf_usm_v(l)%dz_green(k,m) )
-          ENDDO
-          surf_usm_v(l)%dz_green_stag(nzt_wall,m) = surf_usm_v(l)%dz_green(nzt_wall,m)
-       ENDDO
-       surf_usm_v(l)%ddz_wall        = 1.0_wp / surf_usm_v(l)%dz_wall
-       surf_usm_v(l)%ddz_wall_stag   = 1.0_wp / surf_usm_v(l)%dz_wall_stag
-       surf_usm_v(l)%ddz_window      = 1.0_wp / surf_usm_v(l)%dz_window
-       surf_usm_v(l)%ddz_window_stag = 1.0_wp / surf_usm_v(l)%dz_window_stag
-       surf_usm_v(l)%ddz_green       = 1.0_wp / surf_usm_v(l)%dz_green
-       surf_usm_v(l)%ddz_green_stag  = 1.0_wp / surf_usm_v(l)%dz_green_stag
-    ENDDO
-
-
-    IF ( debug_output )  CALL debug_message( 'usm_init_wall_heat_model', 'end' )
-
- END SUBROUTINE usm_init_wall_heat_model
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the urban surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_init
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zw
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  albedo_type_f,                                                                      &
-               building_pars_f,                                                                    &
-               building_surface_pars_f,                                                            &
-               building_type_f,                                                                    &
-               terrain_height_f
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                 !< loop index x-dirction
-    INTEGER(iwp) ::  ind_alb_green     !< index in input list for green albedo
-    INTEGER(iwp) ::  ind_alb_wall      !< index in input list for wall albedo
-    INTEGER(iwp) ::  ind_alb_win       !< index in input list for window albedo
-    INTEGER(iwp) ::  ind_emis_wall     !< index in input list for wall emissivity
-    INTEGER(iwp) ::  ind_emis_green    !< index in input list for green emissivity
-    INTEGER(iwp) ::  ind_emis_win      !< index in input list for window emissivity
-    INTEGER(iwp) ::  ind_green_frac_w  !< index in input list for green fraction on wall
-    INTEGER(iwp) ::  ind_green_frac_r  !< index in input list for green fraction on roof
-    INTEGER(iwp) ::  ind_hc1           !< index in input list for heat capacity at first wall layer
-    INTEGER(iwp) ::  ind_hc1_win       !< index in input list for heat capacity at first window layer
-    INTEGER(iwp) ::  ind_hc2           !< index in input list for heat capacity at second wall layer
-    INTEGER(iwp) ::  ind_hc2_win       !< index in input list for heat capacity at second window layer
-    INTEGER(iwp) ::  ind_hc3           !< index in input list for heat capacity at third wall layer
-    INTEGER(iwp) ::  ind_hc3_win       !< index in input list for heat capacity at third window layer
-    INTEGER(iwp) ::  ind_hc4           !< index in input list for heat capacity at fourth wall layer
-    INTEGER(iwp) ::  ind_hc4_win       !< index in input list for heat capacity at fourth window layer
-    INTEGER(iwp) ::  ind_lai_r         !< index in input list for LAI on roof
-    INTEGER(iwp) ::  ind_lai_w         !< index in input list for LAI on wall
-    INTEGER(iwp) ::  ind_tc1           !< index in input list for thermal conductivity at first wall layer
-    INTEGER(iwp) ::  ind_tc1_win       !< index in input list for thermal conductivity at first window layer
-    INTEGER(iwp) ::  ind_tc2           !< index in input list for thermal conductivity at second wall layer
-    INTEGER(iwp) ::  ind_tc2_win       !< index in input list for thermal conductivity at second window layer
-    INTEGER(iwp) ::  ind_tc3           !< index in input list for thermal conductivity at third wall layer
-    INTEGER(iwp) ::  ind_tc3_win       !< index in input list for thermal conductivity at third window layer
-    INTEGER(iwp) ::  ind_tc4           !< index in input list for thermal conductivity at fourth wall layer
-    INTEGER(iwp) ::  ind_tc4_win       !< index in input list for thermal conductivity at fourth window layer
-    INTEGER(iwp) ::  ind_thick_1       !< index in input list for thickness of first wall layer
-    INTEGER(iwp) ::  ind_thick_1_win   !< index in input list for thickness of first window layer
-    INTEGER(iwp) ::  ind_thick_2       !< index in input list for thickness of second wall layer
-    INTEGER(iwp) ::  ind_thick_2_win   !< index in input list for thickness of second window layer
-    INTEGER(iwp) ::  ind_thick_3       !< index in input list for thickness of third wall layer
-    INTEGER(iwp) ::  ind_thick_3_win   !< index in input list for thickness of third window layer
-    INTEGER(iwp) ::  ind_thick_4       !< index in input list for thickness of fourth wall layer
-    INTEGER(iwp) ::  ind_thick_4_win   !< index in input list for thickness of fourth window layer
-    INTEGER(iwp) ::  ind_trans         !< index in input list for window transmissivity
-    INTEGER(iwp) ::  ind_wall_frac     !< index in input list for wall fraction
-    INTEGER(iwp) ::  ind_win_frac      !< index in input list for window fraction
-    INTEGER(iwp) ::  ind_z0            !< index in input list for z0
-    INTEGER(iwp) ::  ind_z0qh          !< index in input list for z0h / z0q
-    INTEGER(iwp) ::  is                !< loop index input surface element
-    INTEGER(iwp) ::  j                 !< loop index y-dirction
-    INTEGER(iwp) ::  k                 !< loop index z-dirction
-    INTEGER(iwp) ::  l                 !< loop index surface orientation
-    INTEGER(iwp) ::  m                 !< loop index surface element
-    INTEGER(iwp) ::  st                !< dummy
-
-    LOGICAL      ::  relative_fractions_corrected  !< flag indicating if relative surface fractions require normalization
-
-    REAL(wp)     ::  c, tin, twin          !<
-    REAL(wp)     ::  ground_floor_level_l  !< local height of ground floor level
-    REAL(wp)     ::  sum_frac              !< sum of the relative material fractions at a surface element
-    REAL(wp)     ::  z_agl                 !< height of the surface element above terrain
-
-    IF ( debug_output )  CALL debug_message( 'usm_init', 'start' )
-
-    CALL cpu_log( log_point_s(78), 'usm_init', 'start' )
-!
-!-- Surface forcing has to be disabled for LSF in case of enabled urban surface module
-    IF ( large_scale_forcing )  THEN
-        lsf_surf = .FALSE.
-    ENDIF
-!
-!-- Calculate constant values
-    d_roughness_concrete = 1.0_wp / roughness_concrete
-!
-!-- Flag surface elements belonging to the ground floor level. Therefore, use terrain height array
-!-- from file, if available. This flag is later used to control initialization of surface attributes.
-!-- Todo: for the moment disable initialization of building roofs with ground-floor-level properties.
-    DO  l = 0, 1
-      surf_usm_h(l)%ground_level = .FALSE.
-    ENDDO
-
-    DO  l = 0, 3
-       surf_usm_v(l)%ground_level = .FALSE.
-       DO  m = 1, surf_usm_v(l)%ns
-          i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
-          j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
-          k = surf_usm_v(l)%k(m)
-!
-!--       Determine local ground level. Level 1 - default value, level 2 - initialization according
-!--       to building type, level 3 - initialization from value read from file.
-          ground_floor_level_l = ground_floor_level
-
-          IF ( building_type_f%from_file )  THEN
-              ground_floor_level_l = building_pars(ind_gflh,building_type_f%var(j,i))
-          ENDIF
-
-          IF ( building_pars_f%from_file )  THEN
-             IF ( building_pars_f%pars_xy(ind_gflh,j,i) /=  building_pars_f%fill )                 &
-                ground_floor_level_l = building_pars_f%pars_xy(ind_gflh,j,i)
-          ENDIF
-!
-!--       Determine height of surface element above ground level. Please note, the height of a
-!--       surface element is determined with respect to its height above ground of the reference
-!--       grid point in the atmosphere. Therefore, substract the offset values when assessing the
-!--       terrain height.
-          IF ( terrain_height_f%from_file )  THEN
-             z_agl = zw(k) - terrain_height_f%var(j-surf_usm_v(l)%joff, i-surf_usm_v(l)%ioff)
-          ELSE
-             z_agl = zw(k)
-          ENDIF
-!
-!--       Set flag for ground level
-          IF ( z_agl <= ground_floor_level_l ) surf_usm_v(l)%ground_level(m) = .TRUE.
-
-       ENDDO
-    ENDDO
-!
-!-- Initialization of resistances.
-    DO  l = 0, 1
-       DO  m = 1, surf_usm_h(l)%ns
-          surf_usm_h(l)%r_a(m)        = 50.0_wp
-          surf_usm_h(l)%r_a_green(m)  = 50.0_wp
-          surf_usm_h(l)%r_a_window(m) = 50.0_wp
-       ENDDO
-    ENDDO
-    DO  l = 0, 3
-       DO  m = 1, surf_usm_v(l)%ns
-          surf_usm_v(l)%r_a(m)        = 50.0_wp
-          surf_usm_v(l)%r_a_green(m)  = 50.0_wp
-          surf_usm_v(l)%r_a_window(m) = 50.0_wp
-       ENDDO
-    ENDDO
-
-!
-!-- Map values onto horizontal elemements
-    DO  l = 0, 1
-       DO  m = 1, surf_usm_h(l)%ns
-          surf_usm_h(l)%r_canopy(m)     = 200.0_wp !< canopy_resistance
-          surf_usm_h(l)%r_canopy_min(m) = 200.0_wp !< min_canopy_resistance
-          surf_usm_h(l)%g_d(m)          = 0.0_wp   !< canopy_resistance_coefficient
-       ENDDO
-    ENDDO
-!
-!-- Map values onto vertical elements, even though this does not make much sense.
-    DO  l = 0, 3
-       DO  m = 1, surf_usm_v(l)%ns
-          surf_usm_v(l)%r_canopy(m)     = 200.0_wp !< canopy_resistance
-          surf_usm_v(l)%r_canopy_min(m) = 200.0_wp !< min_canopy_resistance
-          surf_usm_v(l)%g_d(m)          = 0.0_wp   !< canopy_resistance_coefficient
-       ENDDO
-    ENDDO
-
-!
-!--  Initialize urban-type surface attribute. According to initialization in land-surface model,
-!--  follow a 3-level approach.
-!--  Level 1 - initialization via default attributes
-     DO  l = 0, 1
-        DO  m = 1, surf_usm_h(l)%ns
-!
-!--        Now, all horizontal surfaces are roof surfaces (?)
-           surf_usm_h(l)%isroof_surf(m)   = .TRUE.
-           surf_usm_h(l)%surface_types(m) = roof_category         !< default category for root surface
-!
-!--        In order to distinguish between ground floor level and above-ground-floor level surfaces,
-!--        set input indices.
-
-           ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl,                     &
-                                     surf_usm_h(l)%ground_level(m) )
-           ind_lai_r        = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, surf_usm_h(l)%ground_level(m) )
-           ind_z0           = MERGE( ind_z0_gfl, ind_z0_agfl, surf_usm_h(l)%ground_level(m) )
-           ind_z0qh         = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, surf_usm_h(l)%ground_level(m) )
-!
-!--        Store building type and its name on each surface element
-           surf_usm_h(l)%building_type(m)      = building_type
-           surf_usm_h(l)%building_type_name(m) = building_type_name(building_type)
-!
-!--        Initialize relatvie wall- (0), green- (1) and window (2) fractions
-           surf_usm_h(l)%frac(m,ind_veg_wall)  = building_pars(ind_wall_frac_r,building_type)
-           surf_usm_h(l)%frac(m,ind_pav_green) = building_pars(ind_green_frac_r,building_type)
-           surf_usm_h(l)%frac(m,ind_wat_win)   = building_pars(ind_win_frac_r,building_type)
-           surf_usm_h(l)%lai(m)                = building_pars(ind_lai_r,building_type)
-
-           surf_usm_h(l)%rho_c_wall(nzb_wall,m)        = building_pars(ind_hc1_wall_r,building_type)
-           surf_usm_h(l)%rho_c_wall(nzb_wall+1,m)      = building_pars(ind_hc2_wall_r,building_type)
-           surf_usm_h(l)%rho_c_wall(nzb_wall+2,m)      = building_pars(ind_hc3_wall_r,building_type)
-           surf_usm_h(l)%rho_c_wall(nzb_wall+3,m)      = building_pars(ind_hc4_wall_r,building_type)
-           surf_usm_h(l)%lambda_h(nzb_wall,m)          = building_pars(ind_tc1_wall_r,building_type)
-           surf_usm_h(l)%lambda_h(nzb_wall+1,m)        = building_pars(ind_tc2_wall_r,building_type)
-           surf_usm_h(l)%lambda_h(nzb_wall+2,m)        = building_pars(ind_tc3_wall_r,building_type)
-           surf_usm_h(l)%lambda_h(nzb_wall+3,m)        = building_pars(ind_tc4_wall_r,building_type)
-           surf_usm_h(l)%rho_c_green(nzb_wall,m)       = rho_c_soil !building_pars(ind_hc1_wall_r,building_type)
-           surf_usm_h(l)%rho_c_green(nzb_wall+1,m)     = rho_c_soil !building_pars(ind_hc1_wall_r,building_type)
-           surf_usm_h(l)%rho_c_green(nzb_wall+2,m)     = rho_c_soil !building_pars(ind_hc2_wall_r,building_type)
-           surf_usm_h(l)%rho_c_green(nzb_wall+3,m)     = rho_c_soil !building_pars(ind_hc3_wall_r,building_type)
-           surf_usm_h(l)%lambda_h_green(nzb_wall,m)    = lambda_h_green_sm !building_pars(ind_tc1_wall_r,building_type)
-           surf_usm_h(l)%lambda_h_green(nzb_wall+1,m)  = lambda_h_green_sm !building_pars(ind_tc1_wall_r,building_type)
-           surf_usm_h(l)%lambda_h_green(nzb_wall+2,m)  = lambda_h_green_sm !building_pars(ind_tc2_wall_r,building_type)
-           surf_usm_h(l)%lambda_h_green(nzb_wall+3,m)  = lambda_h_green_sm !building_pars(ind_tc3_wall_r,building_type)
-           surf_usm_h(l)%rho_c_window(nzb_wall,m)      = building_pars(ind_hc1_win_r,building_type)
-           surf_usm_h(l)%rho_c_window(nzb_wall+1,m)    = building_pars(ind_hc2_win_r,building_type)
-           surf_usm_h(l)%rho_c_window(nzb_wall+2,m)    = building_pars(ind_hc3_win_r,building_type)
-           surf_usm_h(l)%rho_c_window(nzb_wall+3,m)    = building_pars(ind_hc4_win_r,building_type)
-           surf_usm_h(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win_r,building_type)
-           surf_usm_h(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc2_win_r,building_type)
-           surf_usm_h(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc3_win_r,building_type)
-           surf_usm_h(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc4_win_r,building_type)
-
-           surf_usm_h(l)%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,building_type)
-           surf_usm_h(l)%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,building_type)
-!
-!--        Emissivity of wall-, green- and window fraction
-           surf_usm_h(l)%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall_r,building_type)
-           surf_usm_h(l)%emissivity(m,ind_pav_green) = building_pars(ind_emis_green_r,building_type)
-           surf_usm_h(l)%emissivity(m,ind_wat_win)   = building_pars(ind_emis_win_r,building_type)
-
-           surf_usm_h(l)%transmissivity(m)           = building_pars(ind_trans_r,building_type)
-
-           surf_usm_h(l)%z0(m)                       = building_pars(ind_z0,building_type)
-           surf_usm_h(l)%z0h(m)                      = building_pars(ind_z0qh,building_type)
-           surf_usm_h(l)%z0q(m)                      = building_pars(ind_z0qh,building_type)
-!
-!--        Albedo type for wall fraction, green fraction, window fraction
-           surf_usm_h(l)%albedo_type(m,ind_veg_wall)  = INT( building_pars(ind_alb_wall_r,building_type) )
-           surf_usm_h(l)%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green_r,building_type) )
-           surf_usm_h(l)%albedo_type(m,ind_wat_win)   = INT( building_pars(ind_alb_win_r,building_type) )
-
-           surf_usm_h(l)%zw(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,building_type)
-           surf_usm_h(l)%zw(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,building_type)
-           surf_usm_h(l)%zw(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,building_type)
-           surf_usm_h(l)%zw(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,building_type)
-
-           surf_usm_h(l)%zw_green(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,building_type)
-           surf_usm_h(l)%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,building_type)
-           surf_usm_h(l)%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,building_type)
-           surf_usm_h(l)%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,building_type)
-
-           surf_usm_h(l)%zw_window(nzb_wall,m)         = building_pars(ind_thick_1_win_r,building_type)
-           surf_usm_h(l)%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2_win_r,building_type)
-           surf_usm_h(l)%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3_win_r,building_type)
-           surf_usm_h(l)%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4_win_r,building_type)
-
-           surf_usm_h(l)%green_type_roof(m)     = building_pars(ind_green_type_roof,building_type)
-        ENDDO
-     ENDDO
-
-     DO  l = 0, 3
-        DO  m = 1, surf_usm_v(l)%ns
-
-           surf_usm_v(l)%surface_types(m) = wall_category     !< Default category for root surface
-!
-!--        In order to distinguish between ground floor level and above-ground-floor level surfaces,
-!--        set input indices.
-           ind_alb_green    = MERGE( ind_alb_green_gfl,    ind_alb_green_agfl,                     &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_alb_wall     = MERGE( ind_alb_wall_gfl,     ind_alb_wall_agfl,                      &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_alb_win      = MERGE( ind_alb_win_gfl,      ind_alb_win_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,                     &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,                      &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl,                  &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl,                  &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,                         &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,                         &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,                           &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_hc1_win      = MERGE( ind_hc1_win_gfl,      ind_hc1_win_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,                           &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_hc2_win      = MERGE( ind_hc2_win_gfl,      ind_hc2_win_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,                           &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_hc3_win      = MERGE( ind_hc3_win_gfl,      ind_hc3_win_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_hc4          = MERGE( ind_hc4_gfl,          ind_hc4_agfl,                           &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_hc4_win      = MERGE( ind_hc4_win_gfl,      ind_hc4_win_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,                           &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_tc1_win      = MERGE( ind_tc1_win_gfl,      ind_tc1_win_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,                           &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_tc2_win      = MERGE( ind_tc2_win_gfl,      ind_tc2_win_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,                           &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_tc3_win      = MERGE( ind_tc3_win_gfl,      ind_tc3_win_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_tc4          = MERGE( ind_tc4_gfl,          ind_tc4_agfl,                           &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_tc4_win      = MERGE( ind_tc4_win_gfl,      ind_tc4_win_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_thick_1      = MERGE( ind_thick_1_gfl,      ind_thick_1_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_thick_1_win  = MERGE( ind_thick_1_win_gfl,  ind_thick_1_win_agfl,                   &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_thick_2      = MERGE( ind_thick_2_gfl,      ind_thick_2_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_thick_2_win  = MERGE( ind_thick_2_win_gfl,  ind_thick_2_win_agfl,                   &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_thick_3      = MERGE( ind_thick_3_gfl,      ind_thick_3_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_thick_3_win  = MERGE( ind_thick_3_win_gfl,  ind_thick_3_win_agfl,                   &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_thick_4      = MERGE( ind_thick_4_gfl,      ind_thick_4_agfl,                       &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_thick_4_win  = MERGE( ind_thick_4_win_gfl,  ind_thick_4_win_agfl,                   &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,                     &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,                    &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,                      &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,                          &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,                            &
-                                     surf_usm_v(l)%ground_level(m) )
-           ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,                          &
-                                     surf_usm_v(l)%ground_level(m) )
-!
-!--        Store building type and its name on each surface element
-           surf_usm_v(l)%building_type(m)      = building_type
-           surf_usm_v(l)%building_type_name(m) = building_type_name(building_type)
-!
-!--        Initialize relatvie wall- (0), green- (1) and window (2) fractions
-           surf_usm_v(l)%frac(m,ind_veg_wall)   = building_pars(ind_wall_frac,building_type)
-           surf_usm_v(l)%frac(m,ind_pav_green)  = building_pars(ind_green_frac_w,building_type)
-           surf_usm_v(l)%frac(m,ind_wat_win)    = building_pars(ind_win_frac,building_type)
-           surf_usm_v(l)%lai(m)                 = building_pars(ind_lai_w,building_type)
-
-           surf_usm_v(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,building_type)
-           surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc2,building_type)
-           surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc3,building_type)
-           surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc4,building_type)
-
-           surf_usm_v(l)%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1,building_type)
-           surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1,building_type)
-           surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2,building_type)
-           surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3,building_type)
-
-           surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win,building_type)
-           surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc2_win,building_type)
-           surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc3_win,building_type)
-           surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc4_win,building_type)
-
-           surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,building_type)
-           surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc2,building_type)
-           surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc3,building_type)
-           surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc4,building_type)
-
-           surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1,building_type)
-           surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1,building_type)
-           surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2,building_type)
-           surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3,building_type)
-
-           surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win,building_type)
-           surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc2_win,building_type)
-           surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc3_win,building_type)
-           surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc4_win,building_type)
-
-           surf_usm_v(l)%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,building_type)
-           surf_usm_v(l)%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,building_type)
-!
-!--        Emissivity of wall-, green- and window fraction
-           surf_usm_v(l)%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall,building_type)
-           surf_usm_v(l)%emissivity(m,ind_pav_green) = building_pars(ind_emis_green,building_type)
-           surf_usm_v(l)%emissivity(m,ind_wat_win)   = building_pars(ind_emis_win,building_type)
-
-           surf_usm_v(l)%transmissivity(m)      = building_pars(ind_trans,building_type)
-
-           surf_usm_v(l)%z0(m)                  = building_pars(ind_z0,building_type)
-           surf_usm_v(l)%z0h(m)                 = building_pars(ind_z0qh,building_type)
-           surf_usm_v(l)%z0q(m)                 = building_pars(ind_z0qh,building_type)
-
-           surf_usm_v(l)%albedo_type(m,ind_veg_wall)  = INT( building_pars(ind_alb_wall,building_type) )
-           surf_usm_v(l)%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green,building_type) )
-           surf_usm_v(l)%albedo_type(m,ind_wat_win)   = INT( building_pars(ind_alb_win,building_type) )
-
-           surf_usm_v(l)%zw(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
-           surf_usm_v(l)%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
-           surf_usm_v(l)%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
-           surf_usm_v(l)%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
-
-           surf_usm_v(l)%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
-           surf_usm_v(l)%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
-           surf_usm_v(l)%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
-           surf_usm_v(l)%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
-
-           surf_usm_v(l)%zw_window(nzb_wall,m)        = building_pars(ind_thick_1_win,building_type)
-           surf_usm_v(l)%zw_window(nzb_wall+1,m)      = building_pars(ind_thick_2_win,building_type)
-           surf_usm_v(l)%zw_window(nzb_wall+2,m)      = building_pars(ind_thick_3_win,building_type)
-           surf_usm_v(l)%zw_window(nzb_wall+3,m)      = building_pars(ind_thick_4_win,building_type)
-
-        ENDDO
-     ENDDO
-!
-!--  Level 2 - initialization via building type read from file
-     IF ( building_type_f%from_file )  THEN
-        DO  l = 0, 1
-           DO  m = 1, surf_usm_h(l)%ns
-              i = surf_usm_h(l)%i(m)
-              j = surf_usm_h(l)%j(m)
-!
-!--           For the moment, limit building type to 6 (to overcome errors in input file).
-              st = building_type_f%var(j,i)
-              IF ( st /= building_type_f%fill )  THEN
-
-!
-!--              In order to distinguish between ground floor level and above-ground-floor level
-!--              surfaces, set input indices.
-
-                 ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl,               &
-                                           surf_usm_h(l)%ground_level(m) )
-                 ind_lai_r        = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, surf_usm_h(l)%ground_level(m) )
-                 ind_z0           = MERGE( ind_z0_gfl, ind_z0_agfl, surf_usm_h(l)%ground_level(m) )
-                 ind_z0qh         = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, surf_usm_h(l)%ground_level(m) )
-!
-!--              Store building type and its name on each surface element
-                 surf_usm_h(l)%building_type(m)      = st
-                 surf_usm_h(l)%building_type_name(m) = building_type_name(st)
-!
-!--              Initialize relatvie wall- (0), green- (1) and window (2) fractions
-                 surf_usm_h(l)%frac(m,ind_veg_wall)  = building_pars(ind_wall_frac_r,st)
-                 surf_usm_h(l)%frac(m,ind_pav_green) = building_pars(ind_green_frac_r,st)
-                 surf_usm_h(l)%frac(m,ind_wat_win)   = building_pars(ind_win_frac_r,st)
-                 surf_usm_h(l)%lai(m)                = building_pars(ind_lai_r,st)
-
-                 surf_usm_h(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1_wall_r,st)
-                 surf_usm_h(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc2_wall_r,st)
-                 surf_usm_h(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc3_wall_r,st)
-                 surf_usm_h(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc4_wall_r,st)
-                 surf_usm_h(l)%lambda_h(nzb_wall,m)     = building_pars(ind_tc1_wall_r,st)
-                 surf_usm_h(l)%lambda_h(nzb_wall+1,m)   = building_pars(ind_tc2_wall_r,st)
-                 surf_usm_h(l)%lambda_h(nzb_wall+2,m)   = building_pars(ind_tc3_wall_r,st)
-                 surf_usm_h(l)%lambda_h(nzb_wall+3,m)   = building_pars(ind_tc4_wall_r,st)
-
-                 surf_usm_h(l)%rho_c_green(nzb_wall,m)      = rho_c_soil !building_pars(ind_hc1_wall_r,st)
-                 surf_usm_h(l)%rho_c_green(nzb_wall+1,m)    = rho_c_soil !building_pars(ind_hc1_wall_r,st)
-                 surf_usm_h(l)%rho_c_green(nzb_wall+2,m)    = rho_c_soil !building_pars(ind_hc2_wall_r,st)
-                 surf_usm_h(l)%rho_c_green(nzb_wall+3,m)    = rho_c_soil !building_pars(ind_hc3_wall_r,st)
-                 surf_usm_h(l)%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1_wall_r,st)
-                 surf_usm_h(l)%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1_wall_r,st)
-                 surf_usm_h(l)%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2_wall_r,st)
-                 surf_usm_h(l)%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3_wall_r,st)
-
-                 surf_usm_h(l)%rho_c_window(nzb_wall,m)      = building_pars(ind_hc1_win_r,st)
-                 surf_usm_h(l)%rho_c_window(nzb_wall+1,m)    = building_pars(ind_hc2_win_r,st)
-                 surf_usm_h(l)%rho_c_window(nzb_wall+2,m)    = building_pars(ind_hc3_win_r,st)
-                 surf_usm_h(l)%rho_c_window(nzb_wall+3,m)    = building_pars(ind_hc4_win_r,st)
-                 surf_usm_h(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win_r,st)
-                 surf_usm_h(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc2_win_r,st)
-                 surf_usm_h(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc3_win_r,st)
-                 surf_usm_h(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc4_win_r,st)
-
-                 surf_usm_h(l)%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,st)
-                 surf_usm_h(l)%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,st)
-!
-!--              Emissivity of wall-, green- and window fraction
-                 surf_usm_h(l)%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall_r,st)
-                 surf_usm_h(l)%emissivity(m,ind_pav_green) = building_pars(ind_emis_green_r,st)
-                 surf_usm_h(l)%emissivity(m,ind_wat_win)   = building_pars(ind_emis_win_r,st)
-
-                 surf_usm_h(l)%transmissivity(m)      = building_pars(ind_trans_r,st)
-
-                 surf_usm_h(l)%z0(m)                  = building_pars(ind_z0,st)
-                 surf_usm_h(l)%z0h(m)                 = building_pars(ind_z0qh,st)
-                 surf_usm_h(l)%z0q(m)                 = building_pars(ind_z0qh,st)
-!
-!--              Albedo type for wall fraction, green fraction, window fraction
-                 surf_usm_h(l)%albedo_type(m,ind_veg_wall)  = INT( building_pars(ind_alb_wall_r,st) )
-                 surf_usm_h(l)%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green_r,st) )
-                 surf_usm_h(l)%albedo_type(m,ind_wat_win)   = INT( building_pars(ind_alb_win_r,st) )
-
-                 surf_usm_h(l)%zw(nzb_wall,m)   = building_pars(ind_thick_1_wall_r,st)
-                 surf_usm_h(l)%zw(nzb_wall+1,m) = building_pars(ind_thick_2_wall_r,st)
-                 surf_usm_h(l)%zw(nzb_wall+2,m) = building_pars(ind_thick_3_wall_r,st)
-                 surf_usm_h(l)%zw(nzb_wall+3,m) = building_pars(ind_thick_4_wall_r,st)
-
-                 surf_usm_h(l)%zw_green(nzb_wall,m)   = building_pars(ind_thick_1_wall_r,st)
-                 surf_usm_h(l)%zw_green(nzb_wall+1,m) = building_pars(ind_thick_2_wall_r,st)
-                 surf_usm_h(l)%zw_green(nzb_wall+2,m) = building_pars(ind_thick_3_wall_r,st)
-                 surf_usm_h(l)%zw_green(nzb_wall+3,m) = building_pars(ind_thick_4_wall_r,st)
-
-                 surf_usm_h(l)%zw_window(nzb_wall,m)   = building_pars(ind_thick_1_win_r,st)
-                 surf_usm_h(l)%zw_window(nzb_wall+1,m) = building_pars(ind_thick_2_win_r,st)
-                 surf_usm_h(l)%zw_window(nzb_wall+2,m) = building_pars(ind_thick_3_win_r,st)
-                 surf_usm_h(l)%zw_window(nzb_wall+3,m) = building_pars(ind_thick_4_win_r,st)
-
-                 surf_usm_h(l)%green_type_roof(m) = building_pars(ind_green_type_roof,st)
-
-              ENDIF
-           ENDDO
-        ENDDO
-
-        DO  l = 0, 3
-           DO  m = 1, surf_usm_v(l)%ns
-              i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
-              j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
-!
-!--           For the moment, limit building type to 6 (to overcome errors in input file).
-
-              st = building_type_f%var(j,i)
-              IF ( st /= building_type_f%fill )  THEN
-
-!
-!--              In order to distinguish between ground floor level and above-ground-floor level
-!--              surfaces, set input indices.
-                 ind_alb_green    = MERGE( ind_alb_green_gfl,    ind_alb_green_agfl,               &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_alb_wall     = MERGE( ind_alb_wall_gfl,     ind_alb_wall_agfl,                &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_alb_win      = MERGE( ind_alb_win_gfl,      ind_alb_win_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,               &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,                &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl,            &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl,            &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,                   &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,                   &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,                     &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_hc1_win      = MERGE( ind_hc1_win_gfl,      ind_hc1_win_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,                     &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_hc2_win      = MERGE( ind_hc2_win_gfl,      ind_hc2_win_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,                     &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_hc3_win      = MERGE( ind_hc3_win_gfl,      ind_hc3_win_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_hc4          = MERGE( ind_hc4_gfl,          ind_hc4_agfl,                     &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_hc4_win      = MERGE( ind_hc4_win_gfl,      ind_hc4_win_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,                     &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_tc1_win      = MERGE( ind_tc1_win_gfl,      ind_tc1_win_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,                     &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_tc2_win      = MERGE( ind_tc2_win_gfl,      ind_tc2_win_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,                     &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_tc3_win      = MERGE( ind_tc3_win_gfl,      ind_tc3_win_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_tc4          = MERGE( ind_tc4_gfl,          ind_tc4_agfl,                     &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_tc4_win      = MERGE( ind_tc4_win_gfl,      ind_tc4_win_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_thick_1      = MERGE( ind_thick_1_gfl,      ind_thick_1_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_thick_1_win  = MERGE( ind_thick_1_win_gfl,  ind_thick_1_win_agfl,             &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_thick_2      = MERGE( ind_thick_2_gfl,      ind_thick_2_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_thick_2_win  = MERGE( ind_thick_2_win_gfl,  ind_thick_2_win_agfl,             &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_thick_3      = MERGE( ind_thick_3_gfl,      ind_thick_3_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_thick_3_win  = MERGE( ind_thick_3_win_gfl,  ind_thick_3_win_agfl,             &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_thick_4      = MERGE( ind_thick_4_gfl,      ind_thick_4_agfl,                 &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_thick_4_win  = MERGE( ind_thick_4_win_gfl,  ind_thick_4_win_agfl,             &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,               &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,              &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,                &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,                    &
-                                         surf_usm_v(l)%ground_level(m) )
-                 ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,                      &
-                                           surf_usm_v(l)%ground_level(m) )
-                 ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,                    &
-                                           surf_usm_v(l)%ground_level(m) )
-!
-!--              Store building type and its name on each surface element
-                 surf_usm_v(l)%building_type(m)      = st
-                 surf_usm_v(l)%building_type_name(m) = building_type_name(st)
-!
-!--              Initialize relatvie wall- (0), green- (1) and window (2) fractions
-                 surf_usm_v(l)%frac(m,ind_veg_wall)  = building_pars(ind_wall_frac,st)
-                 surf_usm_v(l)%frac(m,ind_pav_green) = building_pars(ind_green_frac_w,st)
-                 surf_usm_v(l)%frac(m,ind_wat_win)   = building_pars(ind_win_frac,st)
-                 surf_usm_v(l)%lai(m)                = building_pars(ind_lai_w,st)
-
-                 surf_usm_v(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,st)
-                 surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc2,st)
-                 surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc3,st)
-                 surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc4,st)
-
-                 surf_usm_v(l)%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1,st)
-                 surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1,st)
-                 surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2,st)
-                 surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3,st)
-
-                 surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win,st)
-                 surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc2_win,st)
-                 surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc3_win,st)
-                 surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc4_win,st)
-
-                 surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,st)
-                 surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc2,st)
-                 surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc3,st)
-                 surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc4,st)
-
-                 surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1,st)
-                 surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1,st)
-                 surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2,st)
-                 surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3,st)
-
-                 surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win,st)
-                 surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc2_win,st)
-                 surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc3_win,st)
-                 surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc4_win,st)
-
-                 surf_usm_v(l)%target_temp_summer(m) = building_pars(ind_indoor_target_temp_summer,st)
-                 surf_usm_v(l)%target_temp_winter(m) = building_pars(ind_indoor_target_temp_winter,st)
-!
-!--              Emissivity of wall-, green- and window fraction
-                 surf_usm_v(l)%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall,st)
-                 surf_usm_v(l)%emissivity(m,ind_pav_green) = building_pars(ind_emis_green,st)
-                 surf_usm_v(l)%emissivity(m,ind_wat_win)   = building_pars(ind_emis_win,st)
-
-                 surf_usm_v(l)%transmissivity(m) = building_pars(ind_trans,st)
-
-                 surf_usm_v(l)%z0(m)  = building_pars(ind_z0,st)
-                 surf_usm_v(l)%z0h(m) = building_pars(ind_z0qh,st)
-                 surf_usm_v(l)%z0q(m) = building_pars(ind_z0qh,st)
-
-                 surf_usm_v(l)%albedo_type(m,ind_veg_wall)  = INT( building_pars(ind_alb_wall,st) )
-                 surf_usm_v(l)%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green,st) )
-                 surf_usm_v(l)%albedo_type(m,ind_wat_win)   = INT( building_pars(ind_alb_win,st) )
-
-                 surf_usm_v(l)%zw(nzb_wall,m)   = building_pars(ind_thick_1,st)
-                 surf_usm_v(l)%zw(nzb_wall+1,m) = building_pars(ind_thick_2,st)
-                 surf_usm_v(l)%zw(nzb_wall+2,m) = building_pars(ind_thick_3,st)
-                 surf_usm_v(l)%zw(nzb_wall+3,m) = building_pars(ind_thick_4,st)
-
-                 surf_usm_v(l)%zw_green(nzb_wall,m)   = building_pars(ind_thick_1,st)
-                 surf_usm_v(l)%zw_green(nzb_wall+1,m) = building_pars(ind_thick_2,st)
-                 surf_usm_v(l)%zw_green(nzb_wall+2,m) = building_pars(ind_thick_3,st)
-                 surf_usm_v(l)%zw_green(nzb_wall+3,m) = building_pars(ind_thick_4,st)
-
-                 surf_usm_v(l)%zw_window(nzb_wall,m)   = building_pars(ind_thick_1_win,st)
-                 surf_usm_v(l)%zw_window(nzb_wall+1,m) = building_pars(ind_thick_2_win,st)
-                 surf_usm_v(l)%zw_window(nzb_wall+2,m) = building_pars(ind_thick_3_win,st)
-                 surf_usm_v(l)%zw_window(nzb_wall+3,m) = building_pars(ind_thick_4_win,st)
-
-              ENDIF
-           ENDDO
-        ENDDO
-     ENDIF
-
-!
-!--  Level 3 - initialization via building_pars read from file. Note, only variables that are also
-!--  defined in the input-standard can be initialized via file. Other variables will be initialized
-!--  on level 1 or 2.
-     IF ( building_pars_f%from_file )  THEN
-        DO  l = 0, 1
-           DO  m = 1, surf_usm_h(l)%ns
-              i = surf_usm_h(l)%i(m)
-              j = surf_usm_h(l)%j(m)
-
-!
-!--           In order to distinguish between ground floor level and above-ground-floor level surfaces,
-!--           set input indices.
-              ind_wall_frac    = MERGE( ind_wall_frac_gfl, ind_wall_frac_agfl,                        &
-                                        surf_usm_h(l)%ground_level(m) )
-              ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl,                  &
-                                        surf_usm_h(l)%ground_level(m) )
-              ind_win_frac     = MERGE( ind_win_frac_gfl, ind_win_frac_agfl,                          &
-                                        surf_usm_h(l)%ground_level(m) )
-              ind_lai_r        = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_z0           = MERGE( ind_z0_gfl, ind_z0_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_z0qh         = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_hc1          = MERGE( ind_hc1_gfl, ind_hc1_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_hc2          = MERGE( ind_hc2_gfl, ind_hc2_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_hc3          = MERGE( ind_hc3_gfl, ind_hc3_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_hc4          = MERGE( ind_hc4_gfl, ind_hc4_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_tc1          = MERGE( ind_tc1_gfl, ind_tc1_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_tc2          = MERGE( ind_tc2_gfl, ind_tc2_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_tc3          = MERGE( ind_tc3_gfl, ind_tc3_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_tc4          = MERGE( ind_tc4_gfl, ind_tc4_agfl, surf_usm_h(l)%ground_level(m) )
-              ind_emis_wall    = MERGE( ind_emis_wall_gfl, ind_emis_wall_agfl,                        &
-                                        surf_usm_h(l)%ground_level(m) )
-              ind_emis_green   = MERGE( ind_emis_green_gfl, ind_emis_green_agfl,                      &
-                                        surf_usm_h(l)%ground_level(m) )
-              ind_emis_win     = MERGE( ind_emis_win_gfl, ind_emis_win_agfl,                          &
-                                        surf_usm_h(l)%ground_level(m) )
-              ind_trans        = MERGE( ind_trans_gfl, ind_trans_agfl, surf_usm_h(l)%ground_level(m) )
-
-!
-!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
-              IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /= building_pars_f%fill )               &
-                 surf_usm_h(l)%frac(m,ind_veg_wall) = building_pars_f%pars_xy(ind_wall_frac,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_green_frac_r,j,i) /= building_pars_f%fill )            &
-                 surf_usm_h(l)%frac(m,ind_pav_green) = building_pars_f%pars_xy(ind_green_frac_r,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /= building_pars_f%fill )                &
-                 surf_usm_h(l)%frac(m,ind_wat_win) = building_pars_f%pars_xy(ind_win_frac,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_lai_r,j,i) /= building_pars_f%fill )                   &
-                 surf_usm_h(l)%lai(m) = building_pars_f%pars_xy(ind_lai_r,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_wall(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_wall(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_wall(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc4,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_wall(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_green(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc4,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_window(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc4,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%rho_c_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc4,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h_green(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc4,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h_window(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc4,j,i) /= building_pars_f%fill )                     &
-                 surf_usm_h(l)%lambda_h_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i) /=                      &
-                   building_pars_f%fill )                                                             &
-                 surf_usm_h(l)%target_temp_summer(m) = building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i) /=                      &
-                   building_pars_f%fill )                                                             &
-                 surf_usm_h(l)%target_temp_winter(m) = building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= building_pars_f%fill )               &
-                 surf_usm_h(l)%emissivity(m,ind_veg_wall) = building_pars_f%pars_xy(ind_emis_wall,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /= building_pars_f%fill )              &
-                 surf_usm_h(l)%emissivity(m,ind_pav_green) = building_pars_f%pars_xy(ind_emis_green,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /= building_pars_f%fill )                &
-                 surf_usm_h(l)%emissivity(m,ind_wat_win) = building_pars_f%pars_xy(ind_emis_win,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_trans,j,i) /= building_pars_f%fill )                   &
-                 surf_usm_h(l)%transmissivity(m) = building_pars_f%pars_xy(ind_trans,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_z0,j,i) /= building_pars_f%fill )                      &
-                 surf_usm_h(l)%z0(m) = building_pars_f%pars_xy(ind_z0,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )                    &
-                 surf_usm_h(l)%z0h(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )                    &
-                 surf_usm_h(l)%z0q(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) /= building_pars_f%fill )           &
-                 surf_usm_h(l)%albedo_type(m,ind_veg_wall)  = building_pars_f%pars_xy(ind_alb_wall_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_alb_green_agfl,j,i) /= building_pars_f%fill )          &
-                 surf_usm_h(l)%albedo_type(m,ind_pav_green) = building_pars_f%pars_xy(ind_alb_green_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_alb_win_agfl,j,i) /= building_pars_f%fill )            &
-                 surf_usm_h(l)%albedo_type(m,ind_wat_win) = building_pars_f%pars_xy(ind_alb_win_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /= building_pars_f%fill )            &
-                 surf_usm_h(l)%zw(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /= building_pars_f%fill )            &
-                 surf_usm_h(l)%zw(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /= building_pars_f%fill )            &
-                 surf_usm_h(l)%zw(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /= building_pars_f%fill )            &
-                 surf_usm_h(l)%zw(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /= building_pars_f%fill )            &
-                 surf_usm_h(l)%zw_green(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /= building_pars_f%fill )            &
-                 surf_usm_h(l)%zw_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /= building_pars_f%fill )            &
-                 surf_usm_h(l)%zw_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /= building_pars_f%fill )            &
-                 surf_usm_h(l)%zw_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
-           ENDDO
-        ENDDO
-
-        DO  l = 0, 3
-           DO  m = 1, surf_usm_v(l)%ns
-              i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
-              j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
-
-!
-!--           In order to distinguish between ground floor level and above-ground-floor level
-!--           surfaces, set input indices.
-              ind_wall_frac    = MERGE( ind_wall_frac_gfl, ind_wall_frac_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_win_frac     = MERGE( ind_win_frac_gfl, ind_win_frac_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_lai_w        = MERGE( ind_lai_w_gfl, ind_lai_w_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_z0           = MERGE( ind_z0_gfl, ind_z0_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_z0qh         = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_hc1          = MERGE( ind_hc1_gfl, ind_hc1_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_hc2          = MERGE( ind_hc2_gfl, ind_hc2_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_hc3          = MERGE( ind_hc3_gfl, ind_hc3_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_hc4          = MERGE( ind_hc4_gfl, ind_hc4_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_tc1          = MERGE( ind_tc1_gfl, ind_tc1_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_tc2          = MERGE( ind_tc2_gfl, ind_tc2_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_tc3          = MERGE( ind_tc3_gfl, ind_tc3_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_tc4          = MERGE( ind_tc4_gfl, ind_tc4_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_emis_wall    = MERGE( ind_emis_wall_gfl, ind_emis_wall_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_emis_green   = MERGE( ind_emis_green_gfl, ind_emis_green_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_emis_win     = MERGE( ind_emis_win_gfl, ind_emis_win_agfl, surf_usm_v(l)%ground_level(m) )
-              ind_trans        = MERGE( ind_trans_gfl, ind_trans_agfl, surf_usm_v(l)%ground_level(m) )
-!
-!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
-              IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /= building_pars_f%fill )            &
-                 surf_usm_v(l)%frac(m,ind_veg_wall) = building_pars_f%pars_xy(ind_wall_frac,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_green_frac_w,j,i) /= building_pars_f%fill )         &
-                 surf_usm_v(l)%frac(m,ind_pav_green) = building_pars_f%pars_xy(ind_green_frac_w,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /= building_pars_f%fill )             &
-                 surf_usm_v(l)%frac(m,ind_wat_win) = building_pars_f%pars_xy(ind_win_frac,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_lai_w,j,i) /= building_pars_f%fill )                &
-                 surf_usm_v(l)%lai(m) = building_pars_f%pars_xy(ind_lai_w,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_wall(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc4,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_green(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc4,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_window(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_hc4,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc4,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h_green(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc4,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h_window(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc2,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc3,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_tc4,j,i) /= building_pars_f%fill )                  &
-                 surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc4,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i) /=                   &
-                   building_pars_f%fill )                                                          &
-                 surf_usm_v(l)%target_temp_summer(m) =                                             &
-                 building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i) /=                   &
-                   building_pars_f%fill )                                                          &
-                 surf_usm_v(l)%target_temp_winter(m) =                                             &
-                 building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= building_pars_f%fill )            &
-                 surf_usm_v(l)%emissivity(m,ind_veg_wall) =                                        &
-                 building_pars_f%pars_xy(ind_emis_wall,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /= building_pars_f%fill )           &
-                 surf_usm_v(l)%emissivity(m,ind_pav_green) =                                       &
-                 building_pars_f%pars_xy(ind_emis_green,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /= building_pars_f%fill )             &
-                 surf_usm_v(l)%emissivity(m,ind_wat_win)   =                                       &
-                 building_pars_f%pars_xy(ind_emis_win,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_trans,j,i) /= building_pars_f%fill )                &
-                 surf_usm_v(l)%transmissivity(m) =                                                 &
-                 building_pars_f%pars_xy(ind_trans,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_z0,j,i) /= building_pars_f%fill )                   &
-                 surf_usm_v(l)%z0(m) = building_pars_f%pars_xy(ind_z0,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )                 &
-                 surf_usm_v(l)%z0h(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )                 &
-                 surf_usm_v(l)%z0q(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) /= building_pars_f%fill )        &
-                 surf_usm_v(l)%albedo_type(m,ind_veg_wall)  =                                      &
-                 building_pars_f%pars_xy(ind_alb_wall_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_alb_green_agfl,j,i) /= building_pars_f%fill )       &
-                 surf_usm_v(l)%albedo_type(m,ind_pav_green) =                                      &
-                 building_pars_f%pars_xy(ind_alb_green_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_alb_win_agfl,j,i) /= building_pars_f%fill )         &
-                 surf_usm_v(l)%albedo_type(m,ind_wat_win)   =                                      &
-                 building_pars_f%pars_xy(ind_alb_win_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /= building_pars_f%fill )         &
-                 surf_usm_v(l)%zw(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /= building_pars_f%fill )         &
-                 surf_usm_v(l)%zw(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /= building_pars_f%fill )         &
-                 surf_usm_v(l)%zw(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /= building_pars_f%fill )         &
-                 surf_usm_v(l)%zw(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /= building_pars_f%fill )         &
-                 surf_usm_v(l)%zw_green(nzb_wall,m) =                                              &
-                 building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /= building_pars_f%fill )         &
-                 surf_usm_v(l)%zw_green(nzb_wall+1,m) =                                            &
-                 building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /= building_pars_f%fill )         &
-                 surf_usm_v(l)%zw_green(nzb_wall+2,m) =                                            &
-                 building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
-
-              IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /= building_pars_f%fill )         &
-                 surf_usm_v(l)%zw_green(nzb_wall+3,m) =                                            &
-                 building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
-
-           ENDDO
-        ENDDO
-     ENDIF
-!
-!--  Read building surface pars. If present, they override LOD1-LOD3 building pars where applicable
-     IF ( building_surface_pars_f%from_file )  THEN
-        DO  l = 0, 1
-           DO  m = 1, surf_usm_h(l)%ns
-              i = surf_usm_h(l)%i(m)
-              j = surf_usm_h(l)%j(m)
-              k = surf_usm_h(l)%k(m)
-!
-!--           Iterate over surfaces in column, check height and orientation
-              DO  is = building_surface_pars_f%index_ji(1,j,i), &
-                       building_surface_pars_f%index_ji(2,j,i)
-                 IF ( building_surface_pars_f%coords(4,is) == -surf_usm_h(l)%koff .AND.               &
-                      building_surface_pars_f%coords(1,is) == k )  THEN
-
-                    IF ( building_surface_pars_f%pars(ind_s_wall_frac,is) /=                          &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%frac(m,ind_veg_wall) =                                           &
-                       building_surface_pars_f%pars(ind_s_wall_frac,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_green_frac_w,is) /=                       &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%frac(m,ind_pav_green) =                                          &
-                       building_surface_pars_f%pars(ind_s_green_frac_w,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_green_frac_r,is) /=                       &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%frac(m,ind_pav_green) =                                          &
-                       building_surface_pars_f%pars(ind_s_green_frac_r,is)
-                       !TODO clarify: why should _w and _r be on the same surface?
-
-                    IF ( building_surface_pars_f%pars(ind_s_win_frac,is) /=                           &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%frac(m,ind_wat_win) = building_surface_pars_f%pars(ind_s_win_frac,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_lai_r,is) /=                              &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%lai(m) = building_surface_pars_f%pars(ind_s_lai_r,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_hc1,is) /=                                &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_h(l)%rho_c_wall(nzb_wall:nzb_wall+1,m) =                              &
-                       building_surface_pars_f%pars(ind_s_hc1,is)
-                       surf_usm_h(l)%rho_c_green(nzb_wall:nzb_wall+1,m) =                             &
-                       building_surface_pars_f%pars(ind_s_hc1,is)
-                       surf_usm_h(l)%rho_c_window(nzb_wall:nzb_wall+1,m) =                            &
-                       building_surface_pars_f%pars(ind_s_hc1,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_hc2,is) /=                                &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_h(l)%rho_c_wall(nzb_wall+2,m) =                                       &
-                       building_surface_pars_f%pars(ind_s_hc2,is)
-                       surf_usm_h(l)%rho_c_green(nzb_wall+2,m) =                                      &
-                       building_surface_pars_f%pars(ind_s_hc2,is)
-                       surf_usm_h(l)%rho_c_window(nzb_wall+2,m) =                                     &
-                       building_surface_pars_f%pars(ind_s_hc2,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_hc3,is) /=                                &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_h(l)%rho_c_wall(nzb_wall+3,m) =                                       &
-                       building_surface_pars_f%pars(ind_s_hc3,is)
-                       surf_usm_h(l)%rho_c_green(nzb_wall+3,m) =                                      &
-                       building_surface_pars_f%pars(ind_s_hc3,is)
-                       surf_usm_h(l)%rho_c_window(nzb_wall+3,m) =                                     &
-                       building_surface_pars_f%pars(ind_s_hc3,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_tc1,is) /=                                &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_h(l)%lambda_h(nzb_wall:nzb_wall+1,m) =                                &
-                       building_surface_pars_f%pars(ind_s_tc1,is)
-                       surf_usm_h(l)%lambda_h_green(nzb_wall:nzb_wall+1,m) =                          &
-                       building_surface_pars_f%pars(ind_s_tc1,is)
-                       surf_usm_h(l)%lambda_h_window(nzb_wall:nzb_wall+1,m) =                         &
-                       building_surface_pars_f%pars(ind_s_tc1,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_tc2,is) /=                                &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_h(l)%lambda_h(nzb_wall+2,m) =                                         &
-                       building_surface_pars_f%pars(ind_s_tc2,is)
-                       surf_usm_h(l)%lambda_h_green(nzb_wall+2,m) =                                   &
-                       building_surface_pars_f%pars(ind_s_tc2,is)
-                       surf_usm_h(l)%lambda_h_window(nzb_wall+2,m) =                                  &
-                       building_surface_pars_f%pars(ind_s_tc2,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_tc3,is) /=                                &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_h(l)%lambda_h(nzb_wall+3,m) =                                         &
-                       building_surface_pars_f%pars(ind_s_tc3,is)
-                       surf_usm_h(l)%lambda_h_green(nzb_wall+3,m) =                                   &
-                       building_surface_pars_f%pars(ind_s_tc3,is)
-                       surf_usm_h(l)%lambda_h_window(nzb_wall+3,m) =                                  &
-                       building_surface_pars_f%pars(ind_s_tc3,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_indoor_target_temp_summer,is) /=          &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%target_temp_summer(m) =                                          &
-                       building_surface_pars_f%pars(ind_s_indoor_target_temp_summer,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_indoor_target_temp_winter,is) /=          &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%target_temp_winter(m) =                                          &
-                       building_surface_pars_f%pars(ind_s_indoor_target_temp_winter,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_emis_wall,is) /=                          &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%emissivity(m,ind_veg_wall) =                                     &
-                       building_surface_pars_f%pars(ind_s_emis_wall,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_emis_green,is) /=                         &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%emissivity(m,ind_pav_green) =                                    &
-                       building_surface_pars_f%pars(ind_s_emis_green,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_emis_win,is) /=                           &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%emissivity(m,ind_wat_win) =                                      &
-                       building_surface_pars_f%pars(ind_s_emis_win,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_trans,is) /=                              &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%transmissivity(m) = building_surface_pars_f%pars(ind_s_trans,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_z0,is) /=                                 &
-                         building_surface_pars_f%fill )                                               &
-                       surf_usm_h(l)%z0(m) = building_surface_pars_f%pars(ind_s_z0,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_z0qh,is) /=                               &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_h(l)%z0q(m) = building_surface_pars_f%pars(ind_s_z0qh,is)
-                       surf_usm_h(l)%z0h(m) = building_surface_pars_f%pars(ind_s_z0qh,is)
-                    ENDIF
-
-                    EXIT ! Surface was found and processed
-                 ENDIF
-              ENDDO
-           ENDDO
-        ENDDO
-
-        DO  l = 0, 3
-           DO  m = 1, surf_usm_v(l)%ns
-              i = surf_usm_v(l)%i(m)
-              j = surf_usm_v(l)%j(m)
-              k = surf_usm_v(l)%k(m)
-!
-!--           Iterate over surfaces in column, check height and orientation
-              DO  is = building_surface_pars_f%index_ji(1,j,i),                                    &
-                       building_surface_pars_f%index_ji(2,j,i)
-                 IF ( building_surface_pars_f%coords(5,is) == -surf_usm_v(l)%joff .AND.            &
-                      building_surface_pars_f%coords(6,is) == -surf_usm_v(l)%ioff .AND.            &
-                      building_surface_pars_f%coords(1,is) == k )  THEN
-
-                    IF ( building_surface_pars_f%pars(ind_s_wall_frac,is) /=                       &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%frac(m,ind_veg_wall) =                                        &
-                       building_surface_pars_f%pars(ind_s_wall_frac,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_green_frac_w,is) /=                    &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%frac(m,ind_pav_green) =                                       &
-                       building_surface_pars_f%pars(ind_s_green_frac_w,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_green_frac_r,is) /=                    &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%frac(m,ind_pav_green) =                                       &
-                       building_surface_pars_f%pars(ind_s_green_frac_r,is)
-                       !TODO Clarify: why should _w and _r be on the same surface?
-
-                    IF ( building_surface_pars_f%pars(ind_s_win_frac,is) /=                        &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%frac(m,ind_wat_win) =                                         &
-                       building_surface_pars_f%pars(ind_s_win_frac,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_lai_r,is) /=                           &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%lai(m) = building_surface_pars_f%pars(ind_s_lai_r,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_hc1,is) /=                             &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_v(l)%rho_c_wall(nzb_wall:nzb_wall+1,m) =                           &
-                       building_surface_pars_f%pars(ind_s_hc1,is)
-                       surf_usm_v(l)%rho_c_green(nzb_wall:nzb_wall+1,m) =                          &
-                       building_surface_pars_f%pars(ind_s_hc1,is)
-                       surf_usm_v(l)%rho_c_window(nzb_wall:nzb_wall+1,m) =                         &
-                       building_surface_pars_f%pars(ind_s_hc1,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_hc2,is) /=                             &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) =                                    &
-                       building_surface_pars_f%pars(ind_s_hc2,is)
-                       surf_usm_v(l)%rho_c_green(nzb_wall+2,m) =                                   &
-                       building_surface_pars_f%pars(ind_s_hc2,is)
-                       surf_usm_v(l)%rho_c_window(nzb_wall+2,m) =                                  &
-                       building_surface_pars_f%pars(ind_s_hc2,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_hc3,is) /=                             &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) =                                    &
-                       building_surface_pars_f%pars(ind_s_hc3,is)
-                       surf_usm_v(l)%rho_c_green(nzb_wall+3,m) =                                   &
-                       building_surface_pars_f%pars(ind_s_hc3,is)
-                       surf_usm_v(l)%rho_c_window(nzb_wall+3,m) =                                  &
-                       building_surface_pars_f%pars(ind_s_hc3,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_tc1,is) /=                             &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_v(l)%lambda_h(nzb_wall:nzb_wall+1,m) =                             &
-                       building_surface_pars_f%pars(ind_s_tc1,is)
-                       surf_usm_v(l)%lambda_h_green(nzb_wall:nzb_wall+1,m) =                       &
-                       building_surface_pars_f%pars(ind_s_tc1,is)
-                       surf_usm_v(l)%lambda_h_window(nzb_wall:nzb_wall+1,m) =                      &
-                       building_surface_pars_f%pars(ind_s_tc1,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_tc2,is) /=                             &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_v(l)%lambda_h(nzb_wall+2,m) =                                      &
-                       building_surface_pars_f%pars(ind_s_tc2,is)
-                       surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) =                                &
-                       building_surface_pars_f%pars(ind_s_tc2,is)
-                       surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) =                               &
-                       building_surface_pars_f%pars(ind_s_tc2,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_tc3,is) /=                             &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_v(l)%lambda_h(nzb_wall+3,m) =                                      &
-                       building_surface_pars_f%pars(ind_s_tc3,is)
-                       surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) =                                &
-                       building_surface_pars_f%pars(ind_s_tc3,is)
-                       surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) =                               &
-                       building_surface_pars_f%pars(ind_s_tc3,is)
-                    ENDIF
-
-                    IF ( building_surface_pars_f%pars(ind_s_indoor_target_temp_summer,is) /=       &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%target_temp_summer(m) =                                       &
-                       building_surface_pars_f%pars(ind_s_indoor_target_temp_summer,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_indoor_target_temp_winter,is) /=       &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%target_temp_winter(m) =                                       &
-                       building_surface_pars_f%pars(ind_s_indoor_target_temp_winter,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_emis_wall,is) /=                       &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%emissivity(m,ind_veg_wall) =                                  &
-                       building_surface_pars_f%pars(ind_s_emis_wall,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_emis_green,is) /=                      &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%emissivity(m,ind_pav_green) =                                 &
-                       building_surface_pars_f%pars(ind_s_emis_green,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_emis_win,is) /=                        &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%emissivity(m,ind_wat_win) =                                   &
-                       building_surface_pars_f%pars(ind_s_emis_win,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_trans,is) /=                           &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%transmissivity(m) =                                           &
-                       building_surface_pars_f%pars(ind_s_trans,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_z0,is) /=                              &
-                         building_surface_pars_f%fill )                                            &
-                       surf_usm_v(l)%z0(m) = building_surface_pars_f%pars(ind_s_z0,is)
-
-                    IF ( building_surface_pars_f%pars(ind_s_z0qh,is) /=                            &
-                         building_surface_pars_f%fill )  THEN
-                       surf_usm_v(l)%z0q(m) = building_surface_pars_f%pars(ind_s_z0qh,is)
-                       surf_usm_v(l)%z0h(m) = building_surface_pars_f%pars(ind_s_z0qh,is)
-                    ENDIF
-
-                    EXIT ! Surface was found and processed
-                 ENDIF
-              ENDDO
-           ENDDO
-        ENDDO
-     ENDIF
-!
-!--  Initialize albedo type via given type from static input file. Please note, even though
-!--  the albedo type has been already given by the pars, albedo_type overwrites these values.
-     IF ( albedo_type_f%from_file )  THEN
-        DO  l = 0, 1
-           DO  m = 1, surf_usm_h(l)%ns
-              i = surf_usm_h(l)%i(m)
-              j = surf_usm_h(l)%j(m)
-              IF ( albedo_type_f%var(j,i) /= albedo_type_f%fill )                               &
-                 surf_usm_h(l)%albedo_type(m,:) = albedo_type_f%var(j,i)
-           ENDDO
-        ENDDO
-        DO  l = 0, 3
-           DO  m = 1, surf_usm_v(l)%ns
-              i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
-              j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
-             IF ( albedo_type_f%var(j,i) /= albedo_type_f%fill )                                &
-                 surf_usm_v(l)%albedo_type(m,:) = albedo_type_f%var(j,i)
-           ENDDO
-        ENDDO
-     ENDIF
-!
-!--  Run further checks to ensure that the respecitve material fractions are prescribed properly.
-!--  Start with horizontal surfaces (roofs).
-     relative_fractions_corrected = .FALSE.
-     DO  l = 0, 1
-        DO  m = 1, surf_usm_h(l)%ns
-           sum_frac = SUM( surf_usm_h(l)%frac(m,:) )
-           IF ( sum_frac /= 1.0_wp )  THEN
-              relative_fractions_corrected = .TRUE.
-!
-!--           Normalize relative fractions to 1. Deviations from 1 can arise, e.g. by rounding errors
-!--           but also by inconsistent driver creation.
-              IF ( sum_frac /= 0.0_wp )  THEN
-                 surf_usm_h(l)%frac(m,:) = surf_usm_h(l)%frac(m,:) / sum_frac
-!
-!--           In case all relative fractions are erroneously set to zero, set wall fraction to 1.
-              ELSE
-                 surf_usm_h(l)%frac(m,ind_veg_wall)  = 1.0_wp
-                 surf_usm_h(l)%frac(m,ind_wat_win)   = 0.0_wp
-                 surf_usm_h(l)%frac(m,ind_pav_green) = 0.0_wp
-              ENDIF
-           ENDIF
-        ENDDO
-     ENDDO
-!
-!--  If fractions were normalized, give an informative message.
-#if defined( __parallel )
-     CALL MPI_ALLREDUCE( MPI_IN_PLACE, relative_fractions_corrected, 1,                            &
-                         MPI_LOGICAL, MPI_LOR, comm2d, ierr )
-#endif
-     IF ( relative_fractions_corrected )  THEN
-        message_string = 'At some horizotal surfaces the relative material fractions do not ' //   &
-                         'sum-up to one . Hence, the respective fractions were normalized.'
-        CALL message( 'urban_surface_model_mod', 'PA0686', 0, 0, 0, 6, 0 )
-     ENDIF
-!
-!--  Check relative fractions at vertical surfaces.
-     relative_fractions_corrected = .FALSE.
-     DO  l = 0, 3
-        DO  m = 1, surf_usm_v(l)%ns
-           sum_frac = SUM( surf_usm_v(l)%frac(m,:) )
-           IF ( sum_frac /= 1.0_wp )  THEN
-              relative_fractions_corrected = .TRUE.
-!
-!--           Normalize relative fractions to 1.
-              IF ( sum_frac /= 0.0_wp )  THEN
-                 surf_usm_v(l)%frac(m,:) = surf_usm_v(l)%frac(m,:) / sum_frac
-!
-!--           In case all relative fractions are erroneously set to zero, set wall fraction to 1.
-              ELSE
-                 surf_usm_v(l)%frac(m,ind_veg_wall)  = 1.0_wp
-                 surf_usm_v(l)%frac(m,ind_wat_win)   = 0.0_wp
-                 surf_usm_v(l)%frac(m,ind_pav_green) = 0.0_wp
-              ENDIF
-           ENDIF
-        ENDDO
-     ENDDO
-!
-!--  Also here, if fractions were normalized, give an informative message.
-#if defined( __parallel )
-     CALL MPI_ALLREDUCE( MPI_IN_PLACE, relative_fractions_corrected, 1,                            &
-                         MPI_LOGICAL, MPI_LOR, comm2d, ierr )
-#endif
-     IF ( relative_fractions_corrected )  THEN
-        message_string = 'At some vertical surfaces the relative material fractions do not ' //    &
-                         'sum-up to one . Hence, the respective fractions were normalized.'
-        CALL message( 'urban_surface_model_mod', 'PA0686', 0, 0, 0, 6, 0 )
-     ENDIF
-!
-!--  Initialization of the wall/roof materials
-     CALL usm_init_wall_heat_model()
-
-!--  Init skin layer properties (can be done after initialization of wall layers)
-     DO  l = 0, 1
-        DO  m = 1, surf_usm_h(l)%ns
-           i = surf_usm_h(l)%i(m)
-           j = surf_usm_h(l)%j(m)
-
-            surf_usm_h(l)%c_surface(m)           = surf_usm_h(l)%rho_c_wall(nzb_wall,m) *          &
-                                                surf_usm_h(l)%dz_wall(nzb_wall,m) * 0.25_wp
-            surf_usm_h(l)%lambda_surf(m)         = surf_usm_h(l)%lambda_h(nzb_wall,m) *            &
-                                                surf_usm_h(l)%ddz_wall(nzb_wall,m) * 2.0_wp
-            surf_usm_h(l)%c_surface_green(m)     = surf_usm_h(l)%rho_c_wall(nzb_wall,m) *          &
-                                                surf_usm_h(l)%dz_wall(nzb_wall,m) * 0.25_wp
-            surf_usm_h(l)%lambda_surf_green(m)   = surf_usm_h(l)%lambda_h_green(nzb_wall,m) *      &
-                                                surf_usm_h(l)%ddz_green(nzb_wall,m) * 2.0_wp
-            surf_usm_h(l)%c_surface_window(m)    = surf_usm_h(l)%rho_c_window(nzb_wall,m) *        &
-                                                surf_usm_h(l)%dz_window(nzb_wall,m) * 0.25_wp
-            surf_usm_h(l)%lambda_surf_window(m)  = surf_usm_h(l)%lambda_h_window(nzb_wall,m) *     &
-                                                surf_usm_h(l)%ddz_window(nzb_wall,m) * 2.0_wp
-        ENDDO
-     ENDDO
-
-     DO  l = 0, 3
-         DO  m = 1, surf_usm_v(l)%ns
-            i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
-            j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
-
-             surf_usm_v(l)%c_surface(m) = surf_usm_v(l)%rho_c_wall(nzb_wall,m) *                   &
-                                          surf_usm_v(l)%dz_wall(nzb_wall,m) * 0.25_wp
-             surf_usm_v(l)%lambda_surf(m) = surf_usm_v(l)%lambda_h(nzb_wall,m) *                   &
-                                            surf_usm_v(l)%ddz_wall(nzb_wall,m) * 2.0_wp
-             surf_usm_v(l)%c_surface_green(m) = surf_usm_v(l)%rho_c_green(nzb_wall,m) *            &
-                                                surf_usm_v(l)%dz_green(nzb_wall,m) * 0.25_wp
-             surf_usm_v(l)%lambda_surf_green(m) = surf_usm_v(l)%lambda_h_green(nzb_wall,m) *       &
-                                                  surf_usm_v(l)%ddz_green(nzb_wall,m) * 2.0_wp
-             surf_usm_v(l)%c_surface_window(m) = surf_usm_v(l)%rho_c_window(nzb_wall,m) *          &
-                                                    surf_usm_v(l)%dz_window(nzb_wall,m) * 0.25_wp
-             surf_usm_v(l)%lambda_surf_window(m) = surf_usm_v(l)%lambda_h_window(nzb_wall,m) *     &
-                                                    surf_usm_v(l)%ddz_window(nzb_wall,m) * 2.0_wp
-         ENDDO
-     ENDDO
-
-!
-!-- Check for consistent initialization.
-!-- Check if roughness length for momentum, or heat, exceed surface-layer height and decrease local
-!-- roughness length where necessary.
-    DO  l = 0, 1
-       DO  m = 1, surf_usm_h(l)%ns
-          IF ( surf_usm_h(l)%z0(m) >= surf_usm_h(l)%z_mo(m) )  THEN
-
-             surf_usm_h(l)%z0(m) = 0.9_wp * surf_usm_h(l)%z_mo(m)
-
-             WRITE( message_string, * ) 'z0 exceeds surface-layer height at horizontal urban ' //     &
-                                        'surface and is decreased appropriately at grid point ' //    &
-                                        '(i,j) = ',  surf_usm_h(l)%i(m), surf_usm_h(l)%j(m)
-             CALL message( 'urban_surface_model_mod', 'PA0503', 0, 0, myid, 6, 0 )
-          ENDIF
-          IF ( surf_usm_h(l)%z0h(m) >= surf_usm_h(l)%z_mo(m) )  THEN
-
-             surf_usm_h(l)%z0h(m) = 0.9_wp * surf_usm_h(l)%z_mo(m)
-             surf_usm_h(l)%z0q(m) = 0.9_wp * surf_usm_h(l)%z_mo(m)
-
-             WRITE( message_string, * ) 'z0h exceeds surface-layer height at horizontal urban ' //    &
-                                        'surface and is decreased appropriately at grid point ' //    &
-                                        '(i,j) = ', surf_usm_h(l)%i(m), surf_usm_h(l)%j(m)
-             CALL message( 'urban_surface_model_mod', 'PA0507', 0, 0, myid, 6, 0 )
-          ENDIF
-       ENDDO
-    ENDDO
-
-    DO  l = 0, 3
-       DO  m = 1, surf_usm_v(l)%ns
-          IF ( surf_usm_v(l)%z0(m) >= surf_usm_v(l)%z_mo(m) )  THEN
-
-             surf_usm_v(l)%z0(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
-
-             WRITE( message_string, * ) 'z0 exceeds surface-layer height at vertical urban ' //    &
-                                        'surface and is decreased appropriately at grid point ' // &
-                                        '(i,j) = ', surf_usm_v(l)%i(m)+surf_usm_v(l)%ioff,         &
-                                         surf_usm_v(l)%j(m)+surf_usm_v(l)%joff
-             CALL message( 'urban_surface_model_mod', 'PA0503', 0, 0, myid, 6, 0 )
-          ENDIF
-          IF ( surf_usm_v(l)%z0h(m) >= surf_usm_v(l)%z_mo(m) )  THEN
-
-             surf_usm_v(l)%z0h(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
-             surf_usm_v(l)%z0q(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
-
-             WRITE( message_string, * ) 'z0h exceeds surface-layer height at vertical urban ' //   &
-                                        'surface and is decreased appropriately at grid point ' // &
-                                        '(i,j) = ', surf_usm_v(l)%i(m)+surf_usm_v(l)%ioff,         &
-                                        surf_usm_v(l)%j(m)+surf_usm_v(l)%joff
-             CALL message( 'urban_surface_model_mod', 'PA0507', 0, 0, myid, 6, 0 )
-          ENDIF
-       ENDDO
-    ENDDO
-!
-!--  Intitialization of the surface and wall/ground/roof temperature
-!
-!--  Initialization for restart runs
-     IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-
-!
-!--     At horizontal surfaces. Please note, t_surf_wall_h is defined on a different data type,
-!--     but with the same dimension.
-         DO  l = 0, 1
-            DO  m = 1, surf_usm_h(l)%ns
-               i = surf_usm_h(l)%i(m)
-               j = surf_usm_h(l)%j(m)
-               k = surf_usm_h(l)%k(m)
-
-               t_surf_wall_h(l)%val(m) = pt(k,j,i) * exner(k)
-               t_surf_window_h(l)%val(m) = pt(k,j,i) * exner(k)
-               t_surf_green_h(l)%val(m) = pt(k,j,i) * exner(k)
-               surf_usm_h(l)%pt_surface(m) = pt(k,j,i) * exner(k)
-            ENDDO
-         ENDDO
-!
-!--      At vertical surfaces.
-         DO  l = 0, 3
-            DO  m = 1, surf_usm_v(l)%ns
-               i = surf_usm_v(l)%i(m)
-               j = surf_usm_v(l)%j(m)
-               k = surf_usm_v(l)%k(m)
-
-               t_surf_wall_v(l)%val(m) = pt(k,j,i) * exner(k)
-               t_surf_window_v(l)%val(m) = pt(k,j,i) * exner(k)
-               t_surf_green_v(l)%val(m) = pt(k,j,i) * exner(k)
-               surf_usm_v(l)%pt_surface(m) = pt(k,j,i) * exner(k)
-            ENDDO
-         ENDDO
-
-!
-!--      For the sake of correct initialization, set also q_surface.
-!--      Note, at urban surfaces q_surface is initialized with 0.
-         IF ( humidity )  THEN
-            DO  l = 0, 1
-               DO  m = 1, surf_usm_h(l)%ns
-                  surf_usm_h(l)%q_surface(m) = 0.0_wp
-               ENDDO
-            ENDDO
-            DO  l = 0, 3
-               DO  m = 1, surf_usm_v(l)%ns
-                  surf_usm_v(l)%q_surface(m) = 0.0_wp
-               ENDDO
-            ENDDO
-         ENDIF
-!
-!--      Initial values for t_wall
-!--      Outer value is set to surface temperature, inner value is set to wall_inner_temperature
-!--      and profile is logaritmic (linear in nz).
-!--      Horizontal surfaces
-         DO  l = 0, 1
-            DO  m = 1, surf_usm_h(l)%ns
-!
-!--            Roof
-               IF ( surf_usm_h(l)%isroof_surf(m) )  THEN
-                   tin = roof_inner_temperature
-                   twin = window_inner_temperature
-!
-!--            Normal land surface
-               ELSE
-                   tin = soil_inner_temperature
-                   twin = window_inner_temperature
-               ENDIF
-
-               DO k = nzb_wall, nzt_wall+1
-                   c = REAL( k - nzb_wall, wp ) / REAL( nzt_wall + 1 - nzb_wall , wp )
-
-                   t_wall_h(l)%val(k,m) = ( 1.0_wp - c ) * t_surf_wall_h(l)%val(m) + c * tin
-                   t_window_h(l)%val(k,m) = ( 1.0_wp - c ) * t_surf_window_h(l)%val(m) + c * twin
-                   t_green_h(l)%val(k,m) = t_surf_wall_h(l)%val(m)
-                   swc_h(l)%val(k,m) = 0.5_wp
-                   swc_sat_h(l)%val(k,m) = 0.95_wp
-                   swc_res_h(l)%val(k,m) = 0.05_wp
-                   rootfr_h(l)%val(k,m) = 0.1_wp
-                   wilt_h(l)%val(k,m) = 0.1_wp
-                   fc_h(l)%val(k,m) = 0.9_wp
-               ENDDO
-            ENDDO
-         ENDDO
-!
-!--      Vertical surfaces
-         DO  l = 0, 3
-            DO  m = 1, surf_usm_v(l)%ns
-!
-!--            Inner wall
-               tin = wall_inner_temperature
-               twin = window_inner_temperature
-
-               DO k = nzb_wall, nzt_wall+1
-                  c = REAL( k - nzb_wall, wp ) / REAL( nzt_wall + 1 - nzb_wall , wp )
-                  t_wall_v(l)%val(k,m) = ( 1.0_wp - c ) * t_surf_wall_v(l)%val(m) + c * tin
-                  t_window_v(l)%val(k,m) = ( 1.0_wp - c ) * t_surf_window_v(l)%val(m) + c * twin
-                  t_green_v(l)%val(k,m) = t_surf_wall_v(l)%val(m)
-               ENDDO
-            ENDDO
-         ENDDO
-     ENDIF
-
-!--
-!--  Possibly DO user-defined actions (e.g. define heterogeneous wall surface)
-     CALL user_init_urban_surface
-
-!
-!--  Initialize prognostic values for the first timestep
-     t_surf_wall_h_p = t_surf_wall_h
-     t_surf_wall_v_p = t_surf_wall_v
-     t_surf_window_h_p = t_surf_window_h
-     t_surf_window_v_p = t_surf_window_v
-     t_surf_green_h_p = t_surf_green_h
-     t_surf_green_v_p = t_surf_green_v
-
-     t_wall_h_p = t_wall_h
-     t_wall_v_p = t_wall_v
-     t_window_h_p = t_window_h
-     t_window_v_p = t_window_v
-     t_green_h_p = t_green_h
-     t_green_v_p = t_green_v
-
-!
-!-- Set initial values for prognostic soil quantities
-    DO  l = 0, 1
-       IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-          m_liq_usm_h(l)%val  = 0.0_wp
-       ENDIF
-       m_liq_usm_h_p(l)%val = m_liq_usm_h(l)%val
-!
-!--    Set initial values for prognostic quantities
-!--    Horizontal surfaces
-       surf_usm_h(l)%c_liq     = 0.0_wp
-       surf_usm_h(l)%qsws_liq  = 0.0_wp
-       surf_usm_h(l)%qsws_veg  = 0.0_wp
-    ENDDO
-
-!
-!-- Do the same for vertical surfaces
-    DO  l = 0, 3
-       surf_usm_v(l)%c_liq     = 0.0_wp
-       surf_usm_v(l)%qsws_liq  = 0.0_wp
-       surf_usm_v(l)%qsws_veg  = 0.0_wp
-    ENDDO
-
-
-
-    CALL cpu_log( log_point_s(78), 'usm_init', 'stop' )
-
-    IF ( debug_output )  CALL debug_message( 'usm_init', 'end' )
-
- END SUBROUTINE usm_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> Wall model as part of the urban surface model. The model predicts vertical and horizontal
-!> wall / roof temperatures and window layer temperatures. No window layer temperature calculactions
-!> during spinup to increase possible timestep.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_wall_heat_model( horizontal, l, during_spinup )
-
-
-    IMPLICIT NONE
-
-    LOGICAL       ::  during_spinup  !< if true, no calculation of window temperatures
-    LOGICAL       ::  horizontal     !< Flag indicating horizontal or vertical surfaces
-
-    INTEGER(iwp)  ::  kw             !< grid index - wall depth
-    INTEGER(iwp)  ::  l              !< direction index
-    INTEGER(iwp)  ::  m              !< running index for surface elements
-
-    REAL(wp)  ::  win_absorp        !< absorption coefficient from transmissivity
-    REAL(wp)  ::  win_nonrefl_1side !< non-reflected fraction after outer glass boundary
-
-    REAL(wp), DIMENSION(nzb_wall:nzt_wall)  ::  wall_mod        !<
-    REAL(wp), DIMENSION(nzb_wall:nzt_wall)  ::  wtend, wintend  !< tendency
-
-    TYPE(surf_type),        POINTER         ::  surf            !< surface-date type variable
-    TYPE(surf_type_2d_usm), POINTER         ::  t_wall
-    TYPE(surf_type_2d_usm), POINTER         ::  t_wall_p
-    TYPE(surf_type_2d_usm), POINTER         ::  t_window
-    TYPE(surf_type_2d_usm), POINTER         ::  t_window_p
-    TYPE(surf_type_2d_usm), POINTER         ::  t_green
-
-    IF ( debug_output_timestep )  THEN
-       WRITE( debug_string, * ) 'usm_wall_heat_model: ', horizontal, l, during_spinup
-       CALL debug_message( debug_string, 'start' )
-    ENDIF
-
-    wall_mod=1.0_wp
-    IF ( usm_wall_mod  .AND.  during_spinup )  THEN
-       DO  kw=nzb_wall, nzb_wall+1
-          wall_mod(kw) = 0.1_wp
-       ENDDO
-    ENDIF
-
-    IF ( horizontal )  THEN
-       surf         => surf_usm_h(l)
-       t_wall       => t_wall_h(l)
-       t_wall_p     => t_wall_h_p(l)
-       t_window     => t_window_h(l)
-       t_window_p   => t_window_h_p(l)
-       t_green      => t_green_h(l)
-    ELSE
-       surf         => surf_usm_v(l)
-       t_wall       => t_wall_v(l)
-       t_wall_p     => t_wall_v_p(l)
-       t_window     => t_window_v(l)
-       t_window_p   => t_window_v_p(l)
-       t_green      => t_green_v(l)
-    ENDIF
-!
-!-- Cycle for all surfaces in given direction
-    !$OMP PARALLEL DO PRIVATE (m, kw, wtend, wintend, win_absorp) SCHEDULE (STATIC)
-    DO  m = 1, surf%ns
-!
-!--    Prognostic equation for ground/roof temperature t_wall
-       wtend(:) = 0.0_wp
-       wtend(nzb_wall) = ( 1.0_wp / surf%rho_c_wall(nzb_wall,m) )                                 &
-                          * ( surf%lambda_h(nzb_wall,m) * wall_mod(nzb_wall)                      &
-                              * ( t_wall%val(nzb_wall+1,m) - t_wall%val(nzb_wall,m) )             &
-                              * surf%ddz_wall(nzb_wall+1,m)                                       &
-                              + surf%frac(m,ind_veg_wall)                                         &
-                              / ( surf%frac(m,ind_veg_wall)                                       &
-                                  + surf%frac(m,ind_pav_green) )                                  &
-                              * surf%wghf_eb(m)                                                   &
-                              - surf%frac(m,ind_pav_green)                                        &
-                              / ( surf%frac(m,ind_veg_wall)                                       &
-                                  + surf%frac(m,ind_pav_green) )                                  &
-                              * ( surf%lambda_h_green(nzt_wall,m)                                 &
-                              * wall_mod(nzt_wall)                                                &
-                              * surf%ddz_green(nzt_wall,m)                                        &
-                              + surf%lambda_h(nzb_wall,m)                                         &
-                              * wall_mod(nzb_wall)                                                &
-                              * surf%ddz_wall(nzb_wall,m) )                                       &
-                              / ( surf%ddz_green(nzt_wall,m)                                      &
-                              + surf%ddz_wall(nzb_wall,m) )                                       &
-                              * ( t_wall%val(nzb_wall,m) - t_green%val(nzt_wall,m) )              &
-                            ) * surf%ddz_wall_stag(nzb_wall,m)
-
-!
-!--    If indoor model is used inner wall layer is calculated by using iwghf (indoor
-!--    wall ground heat flux)
-       IF ( .NOT. indoor_model ) THEN
-          surf%iwghf_eb(m) = surf%lambda_h(nzt_wall,m)  * wall_mod(nzt_wall)          &
-                             * ( t_wall%val(nzt_wall+1,m) - t_wall%val(nzt_wall,m) )  &
-                             * surf%ddz_wall(nzt_wall+1,m)
-       ENDIF
-
-       DO  kw = nzb_wall+1, nzt_wall-1
-          wtend(kw) = ( 1.0_wp / surf%rho_c_wall(kw,m) )                                          &
-                      * ( surf%lambda_h(kw,m) * wall_mod(kw)                                      &
-                      * ( t_wall%val(kw+1,m) - t_wall%val(kw,m) )                                 &
-                      * surf%ddz_wall(kw+1,m)                                                     &
-                      - surf%lambda_h(kw-1,m) * wall_mod(kw-1)                                    &
-                      * ( t_wall%val(kw,m) - t_wall%val(kw-1,m) )                                 &
-                      * surf%ddz_wall(kw,m)                                                       &
-                      ) * surf%ddz_wall_stag(kw,m)
-       ENDDO
-       wtend(nzt_wall) = ( 1.0_wp / surf%rho_c_wall(nzt_wall,m) )                                 &
-                         * ( -surf%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1)                  &
-                             * ( t_wall%val(nzt_wall,m) - t_wall%val(nzt_wall-1,m) )              &
-                              * surf%ddz_wall(nzt_wall,m) + surf%iwghf_eb(m)                      &
-                           ) * surf%ddz_wall_stag(nzt_wall,m)
-
-       t_wall_p%val(nzb_wall:nzt_wall,m) = t_wall%val(nzb_wall:nzt_wall,m) + dt_3d                &
-                                         * ( tsc(2) * wtend(nzb_wall:nzt_wall) + tsc(3)           &
-                                             * surf%tt_wall_m(nzb_wall:nzt_wall,m) )
-
-!
-!--    During spinup the tempeature inside window layers is not calculated to make larger timesteps possible
-       IF ( .NOT. during_spinup )  THEN
-!
-!--       Reflectivity in glass windows is considered as equal on frontal and rear side of the
-!--       glass, which together make total reflectivity (albedo for win fraction).
-          win_nonrefl_1side = 1.0 - ( surf%albedo(m,ind_wat_win) + surf%transmissivity(m)         &
-                                      + 1.0_wp                                                    &
-                                      - sqrt( ( surf%albedo(m,ind_wat_win)                        &
-                                                + surf%transmissivity(m) + 1.0_wp ) ** 2          &
-                                              - 4 * surf%albedo(m,ind_wat_win) ) ) / 2.0_wp
-!
-!--       Absorption coefficient is calculated using zw from internal tranmissivity, which only
-!--       considers absorption without the effects of reflection.
-          win_absorp = -log( ( surf%transmissivity(m) + surf%albedo(m,ind_wat_win) - 1.0_wp       &
-                               + win_nonrefl_1side ) / win_nonrefl_1side )                        &
-                       / surf%zw_window(nzt_wall,m)
-!
-!--       Prognostic equation for ground/roof window temperature t_window takes absorption
-!--       of shortwave radiation into account
-          wintend(:) = 0.0_wp
-          wintend(nzb_wall) = ( 1.0_wp / surf%rho_c_window(nzb_wall,m) )                          &
-                                * ( surf%lambda_h_window(nzb_wall,m)                              &
-                                * ( t_window%val(nzb_wall+1,m) - t_window%val(nzb_wall,m) )       &
-                                * surf%ddz_window(nzb_wall+1,m)                                   &
-                                + surf%wghf_eb_window(m)                                          &
-                                + surf%rad_sw_in(m) * win_nonrefl_1side                           &
-                                * ( 1.0_wp - exp( -win_absorp                                     &
-                                    * surf%zw_window(nzb_wall,m) ) )                              &
-                              ) * surf%ddz_window_stag(nzb_wall,m)
-
-
-          IF ( .NOT. indoor_model )  THEN
-             surf%iwghf_eb_window(m) = surf%lambda_h_window(nzt_wall,m)                    &
-                               * ( t_window%val(nzt_wall+1,m) - t_window%val(nzt_wall,m) ) &
-                               * surf%ddz_window(nzt_wall+1,m)
-          ENDIF
-
-
-          DO  kw = nzb_wall+1, nzt_wall-1
-             wintend(kw) = ( 1.0_wp / surf%rho_c_window(kw,m) )                                   &
-                           * ( surf%lambda_h_window(kw,m)                                         &
-                           * ( t_window%val(kw+1,m) - t_window%val(kw,m) )                        &
-                           * surf%ddz_window(kw+1,m)                                              &
-                           - surf%lambda_h_window(kw-1,m)                                         &
-                           * ( t_window%val(kw,m) - t_window%val(kw-1,m) )                        &
-                           * surf%ddz_window(kw,m)                                                &
-                           + surf%rad_sw_in(m) * win_nonrefl_1side                                &
-                           * ( exp( -win_absorp * surf%zw_window(kw-1,m) )                        &
-                             - exp( -win_absorp * surf%zw_window(kw,  m) ) )                      &
-                             ) * surf%ddz_window_stag(kw,m)
-
-          ENDDO
-
-          wintend(nzt_wall) = ( 1.0_wp / surf%rho_c_window(nzt_wall,m) )                          &
-                                 * ( -surf%lambda_h_window(nzt_wall-1,m)                          &
-                                 * ( t_window%val(nzt_wall,m) - t_window%val(nzt_wall-1,m) )      &
-                                 * surf%ddz_window(nzt_wall,m)                                    &
-                                 + surf%iwghf_eb_window(m)                                        &
-                                 + surf%rad_sw_in(m) * win_nonrefl_1side                          &
-                                 * ( exp( -win_absorp * surf%zw_window(nzt_wall-1,m) )            &
-                                   - exp( -win_absorp * surf%zw_window(nzt_wall,  m) ) )          &
-                                   ) * surf%ddz_window_stag(nzt_wall,m)
-
-          t_window_p%val(nzb_wall:nzt_wall,m) = t_window%val(nzb_wall:nzt_wall,m) + dt_3d         &
-                                              * ( tsc(2) * wintend(nzb_wall:nzt_wall) + tsc(3)    &
-                                              * surf%tt_window_m(nzb_wall:nzt_wall,m) )
-
-       ENDIF
-!
-!--    Calculate t_wall tendencies for the next Runge-Kutta step
-       IF ( timestep_scheme(1:5) == 'runge' )  THEN
-           IF ( intermediate_timestep_count == 1 )  THEN
-              DO  kw = nzb_wall, nzt_wall
-                 surf%tt_wall_m(kw,m) = wtend(kw)
-              ENDDO
-           ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-               DO  kw = nzb_wall, nzt_wall
-                  surf%tt_wall_m(kw,m) = -9.5625_wp * wtend(kw) +                                 &
-                                               5.3125_wp * surf%tt_wall_m(kw,m)
-               ENDDO
-           ENDIF
-       ENDIF
-
-       IF ( .NOT. during_spinup )  THEN
-!
-!--       Calculate t_window tendencies for the next Runge-Kutta step
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-              IF ( intermediate_timestep_count == 1 )  THEN
-                 DO  kw = nzb_wall, nzt_wall
-                    surf%tt_window_m(kw,m) = wintend(kw)
-                 ENDDO
-              ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                  DO  kw = nzb_wall, nzt_wall
-                     surf%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) +                          &
-                                                    5.3125_wp * surf%tt_window_m(kw,m)
-                  ENDDO
-              ENDIF
-          ENDIF
-       ENDIF
-    ENDDO
-
-    IF ( debug_output_timestep )  THEN
-       WRITE( debug_string, * ) 'usm_wall_heat_model: ', horizontal, l, during_spinup
-       CALL debug_message( debug_string, 'end' )
-    ENDIF
-
- END SUBROUTINE usm_wall_heat_model
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!
-!> Green and substrate model as part of the urban surface model. The model predicts ground
-!> temperatures.
-!>
-!> Important: green-heat model crashes due to unknown reason. Green fraction is thus set to zero
-!> (in favor of wall fraction).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_green_heat_model( horizontal, l )
-
-
-    IMPLICIT NONE
-
-    LOGICAL       ::  horizontal          !< Flag indicating horizontal or vertical surfaces
-    INTEGER(iwp)  ::  l                   !< direction index
-
-    INTEGER(iwp)  ::  i, j, k, kw, m      !< running indices
-
-    LOGICAL  ::  conserve_water_content = .TRUE.  !<
-
-    REAL(wp)  ::  drho_l_lv               !< frequently used parameter
-    REAL(wp)  ::  h_vg                    !< Van Genuchten coef. h
-    REAL(wp)  ::  ke, lambda_h_green_sat  !< heat conductivity for saturated soil
-
-    REAL(wp), DIMENSION(nzb_wall:nzt_wall)   ::  gtend,tend         !< tendency
-    REAL(wp), DIMENSION(nzb_wall:nzt_wall)   ::  root_extr_green    !<
-
-    REAL(wp), DIMENSION(nzb_wall:nzt_wall+1) ::  gamma_green_temp   !< temp. gamma
-    REAL(wp), DIMENSION(nzb_wall:nzt_wall+1) ::  lambda_green_temp  !< temp. lambda
-
-    TYPE(surf_type), POINTER                 ::  surf               !< surface-date type variable
-    TYPE(surf_type_2d_usm), POINTER          ::  t_wall
-    TYPE(surf_type_2d_usm), POINTER          ::  t_green
-
-    IF ( debug_output_timestep )  THEN
-       WRITE( debug_string, * ) 'usm_green_heat_model: ', horizontal, l
-       CALL debug_message( debug_string, 'start' )
-    ENDIF
-
-    drho_l_lv = 1.0_wp / (rho_l * l_v)
-
-!
-!-- For horizontal upward surfaces.
-    IF ( horizontal .AND. l==0 )  THEN
-       surf => surf_usm_h(l)
-       t_wall       => t_wall_h(l)
-       t_green      => t_green_h(l)
-
-!--    Set tendency array for soil moisture to zero
-       IF ( surf%ns > 0 )  THEN
-          IF ( intermediate_timestep_count == 1 )  surf%tswc_h_m = 0.0_wp
-       ENDIF
-
-       !$OMP PARALLEL DO PRIVATE (m, i, j, k, kw, lambda_h_green_sat, ke, lambda_green_temp,      &
-       !$OMP&  gtend, tend, h_vg, gamma_green_temp, m_total, root_extr_green) SCHEDULE (STATIC)
-       DO  m = 1, surf%ns
-          IF (surf%frac(m,ind_pav_green) > 0.0_wp)  THEN
-!
-!--         Obtain indices
-             i = surf%i(m)
-             j = surf%j(m)
-             k = surf%k(m)
-
-             DO  kw = nzb_wall, nzt_wall
-!
-!--             Calculate volumetric heat capacity of the soil, taking into account water content
-                surf%rho_c_total_green(kw,m) = (surf%rho_c_green(kw,m)                            &
-                                                     * (1.0_wp - swc_sat_h(l)%val(kw,m))          &
-                                                     + rho_c_water * swc_h(l)%val(kw,m))
-
-!
-!--             Calculate soil heat conductivity at the center of the soil layers
-                lambda_h_green_sat = lambda_h_green_sm ** ( 1.0_wp - swc_sat_h(l)%val(kw,m) )     &
-                                     * lambda_h_water ** swc_h(l)%val(kw,m)
-
-                ke = 1.0_wp + LOG10( MAX( 0.1_wp,swc_h(l)%val(kw,m) / swc_sat_h(l)%val(kw,m) ) )
-
-                lambda_green_temp(kw) = ke * (lambda_h_green_sat - lambda_h_green_dry)            &
-                                        + lambda_h_green_dry
-
-             ENDDO
-             lambda_green_temp(nzt_wall+1) = lambda_green_temp(nzt_wall)
-
-
-!
-!--          Calculate soil heat conductivity (lambda_h) at the _stag level using linear interpolation.
-!--          For pavement surface, the true pavement depth is considered
-             DO  kw = nzb_wall, nzt_wall
-                surf%lambda_h_green(kw,m) = ( lambda_green_temp(kw+1) + lambda_green_temp(kw) )   &
-                                                  * 0.5_wp
-             ENDDO
-
-             t_green_h(l)%val(nzt_wall+1,m) = t_wall_h(l)%val(nzb_wall,m)
-!
-!--          Prognostic equation for ground/roof temperature t_green_h
-             gtend(:) = 0.0_wp
-             gtend(nzb_wall) = ( 1.0_wp / surf%rho_c_total_green(nzb_wall,m) )                    &
-                               * ( surf%lambda_h_green(nzb_wall,m)                                &
-                                   * ( t_green_h(l)%val(nzb_wall+1,m)                             &
-                                   - t_green_h(l)%val(nzb_wall,m) )                               &
-                                   * surf%ddz_green(nzb_wall+1,m)                                 &
-                                   + surf%wghf_eb_green(m)                                        &
-                                 ) * surf%ddz_green_stag(nzb_wall,m)
-
-             DO  kw = nzb_wall+1, nzt_wall
-                gtend(kw) = ( 1.0_wp / surf%rho_c_total_green(kw,m) )                             &
-                            * ( surf%lambda_h_green(kw,m)                                         &
-                                * ( t_green_h(l)%val(kw+1,m) - t_green_h(l)%val(kw,m) )           &
-                                * surf%ddz_green(kw+1,m)                                          &
-                                - surf%lambda_h_green(kw-1,m)                                     &
-                                * ( t_green_h(l)%val(kw,m) - t_green_h(l)%val(kw-1,m) )           &
-                                * surf%ddz_green(kw,m)                                            &
-                              ) * surf%ddz_green_stag(kw,m)
-             ENDDO
-
-             t_green_h_p(l)%val(nzb_wall:nzt_wall,m) = t_green_h(l)%val(nzb_wall:nzt_wall,m)      &
-                            + dt_3d * ( tsc(2) * gtend(nzb_wall:nzt_wall) + tsc(3)                &
-                            * surf%tt_green_m(nzb_wall:nzt_wall,m) )
-
-
-!
-!--          Calculate t_green tendencies for the next Runge-Kutta step
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                 IF ( intermediate_timestep_count == 1 )  THEN
-                    DO  kw = nzb_wall, nzt_wall
-                       surf%tt_green_m(kw,m) = gtend(kw)
-                    ENDDO
-                 ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                     DO  kw = nzb_wall, nzt_wall
-                        surf%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) + 5.3125_wp                 &
-                                                      * surf%tt_green_m(kw,m)
-                     ENDDO
-                 ENDIF
-             ENDIF
-
-             DO  kw = nzb_wall, nzt_wall
-
-!
-!--             Calculate soil diffusivity at the center of the soil layers
-                lambda_green_temp(kw) = ( - b_ch * surf%gamma_w_green_sat(kw,m) * psi_sat          &
-                                          / swc_sat_h(l)%val(kw,m) )                               &
-                                        * ( MAX( swc_h(l)%val(kw,m), wilt_h(l)%val(kw,m) )         &
-                                          / swc_sat_h(l)%val(kw,m) )**( b_ch + 2.0_wp )
-
-!
-!--             Parametrization of Van Genuchten
-                IF ( soil_type /= 7 )  THEN
-!
-!--                Calculate the hydraulic conductivity after Van Genuchten (1980)
-                   h_vg = ( ( (swc_res_h(l)%val(kw,m) - swc_sat_h(l)%val(kw,m))                    &
-                              / ( swc_res_h(l)%val(kw,m) -                                         &
-                              MAX( swc_h(l)%val(kw,m), wilt_h(l)%val(kw,m) ) ) )**                 &
-                              ( surf%n_vg_green(m) / (surf%n_vg_green(m) - 1.0_wp ) )              &
-                              - 1.0_wp                                                             &
-                          )** ( 1.0_wp / surf%n_vg_green(m) ) / surf%alpha_vg_green(m)
-
-
-                   gamma_green_temp(kw) = surf%gamma_w_green_sat(kw,m)                             &
-                                          * ( ( ( 1.0_wp + ( surf%alpha_vg_green(m) * h_vg )**     &
-                                                surf%n_vg_green(m) )**                             &
-                                                ( 1.0_wp - 1.0_wp / surf%n_vg_green(m) )           &
-                                                - ( surf%alpha_vg_green(m) * h_vg )**              &
-                                                ( surf%n_vg_green(m) - 1.0_wp) )**2                &
-                                            ) / ( ( 1.0_wp + ( surf%alpha_vg_green(m) * h_vg )**   &
-                                                  surf%n_vg_green(m) )**                           &
-                                                  ( ( 1.0_wp  - 1.0_wp / surf%n_vg_green(m) )      &
-                                                    *( surf%l_vg_green(m) + 2.0_wp) )              &
-                                                )
-
-!
-!--             Parametrization of Clapp & Hornberger
-                ELSE
-                   gamma_green_temp(kw) = surf%gamma_w_green_sat(kw,m) * ( swc_h(l)%val(kw,m)      &
-                                          / swc_sat_h(l)%val(kw,m) )**( 2.0_wp * b_ch + 3.0_wp )
-                ENDIF
-
-             ENDDO
-
-!
-!--          Prognostic equation for soil moisture content. Only performed, when humidity is enabled in
-!--          the atmosphere
-             IF ( humidity )  THEN
-!
-!--             Calculate soil diffusivity (lambda_w) at the _stag level using linear interpolation.
-!--             To do: replace this with ECMWF-IFS Eq. 8.81
-                DO  kw = nzb_wall, nzt_wall-1
-
-                   surf%lambda_w_green(kw,m) = ( lambda_green_temp(kw+1)                          &
-                                                       + lambda_green_temp(kw) )                  &
-                                                     * 0.5_wp
-                   surf%gamma_w_green(kw,m)  = ( gamma_green_temp(kw+1)                           &
-                                                       + gamma_green_temp(kw) )                   &
-                                                     * 0.5_wp
-
-                ENDDO
-
-!
-!--             In case of a closed bottom (= water content is conserved), set hydraulic conductivity
-!--             to zero so that no water will be lost in the bottom layer.
-                IF ( conserve_water_content )  THEN
-                   surf%gamma_w_green(kw,m) = 0.0_wp
-                ELSE
-                   surf%gamma_w_green(kw,m) = gamma_green_temp(nzt_wall)
-                ENDIF
-
-!--             The root extraction (= root_extr * qsws_veg / (rho_l * l_v)) ensures the mass
-!--             conservation for water. The transpiration of plants equals the cumulative withdrawals
-!--             by the roots in the soil. The scheme takes into account the availability of water in
-!--             the soil layers as well as the root fraction in the respective layer. Layer with
-!--             moisture below wilting point will not contribute, which reflects the preference of
-!--             plants to take water from moister layers.
-
-!
-!--             Calculate the root extraction (ECMWF 7.69, the sum of root_extr = 1). The energy
-!--             balance solver guarantees a positive transpiration, so that there is no need for an
-!--             additional check.
-                m_total = 0.0_wp
-                DO  kw = nzb_wall, nzt_wall
-                    IF ( swc_h(l)%val(kw,m) > wilt_h(l)%val(kw,m) )  THEN
-                       m_total = m_total + rootfr_h(l)%val(kw,m) * swc_h(l)%val(kw,m)
-                    ENDIF
-                ENDDO
-
-                IF ( m_total > 0.0_wp )  THEN
-                   DO  kw = nzb_wall, nzt_wall
-                      IF ( swc_h(l)%val(kw,m) > wilt_h(l)%val(kw,m) )  THEN
-                         root_extr_green(kw) = rootfr_h(l)%val(kw,m) * swc_h(l)%val(kw,m) / m_total
-                      ELSE
-                         root_extr_green(kw) = 0.0_wp
-                      ENDIF
-                   ENDDO
-                ENDIF
-
-!
-!--             Prognostic equation for soil water content m_soil.
-                tend(:) = 0.0_wp
-
-                tend(nzb_wall) = ( surf_usm_h(l)%lambda_w_green(nzb_wall,m)                       &
-                                 * ( swc_h(l)%val(nzb_wall+1,m) - swc_h(l)%val(nzb_wall,m) )      &
-                                 * surf_usm_h(l)%ddz_green(nzb_wall+1,m)                          &
-                                 - surf_usm_h(l)%gamma_w_green(nzb_wall,m)                        &
-                                 - ( root_extr_green(nzb_wall) * surf_usm_h(l)%qsws_veg(m)        &
-!                                    + surf_usm_h(l)%qsws_soil_green(m)                           &
-                                   ) * drho_l_lv )                                                &
-                                 * surf_usm_h(l)%ddz_green_stag(nzb_wall,m)
-
-                DO  kw = nzb_wall+1, nzt_wall-1
-                   tend(kw) = ( surf_usm_h(l)%lambda_w_green(kw,m)                                &
-                                * ( swc_h(l)%val(kw+1,m) - swc_h(l)%val(kw,m) )                   &
-                                * surf_usm_h(l)%ddz_green(kw+1,m)                                 &
-                                - surf_usm_h(l)%gamma_w_green(kw,m)                               &
-                                - surf_usm_h(l)%lambda_w_green(kw-1,m)                            &
-                                * ( swc_h(l)%val(kw,m) - swc_h(l)%val(kw-1,m) )                   &
-                                * surf_usm_h(l)%ddz_green(kw,m)                                   &
-                                + surf_usm_h(l)%gamma_w_green(kw-1,m)                             &
-                                - (root_extr_green(kw)                                            &
-                                * surf_usm_h(l)%qsws_veg(m)                                       &
-                                * drho_l_lv)                                                      &
-                             ) * surf_usm_h(l)%ddz_green_stag(kw,m)
-
-                ENDDO
-                tend(nzt_wall) = ( - surf_usm_h(l)%gamma_w_green(nzt_wall,m)                      &
-                                   - surf_usm_h(l)%lambda_w_green(nzt_wall-1,m)                   &
-                                   * (swc_h(l)%val(nzt_wall,m)                                    &
-                                   - swc_h(l)%val(nzt_wall-1,m))                                  &
-                                   * surf_usm_h(l)%ddz_green(nzt_wall,m)                          &
-                                   + surf_usm_h(l)%gamma_w_green(nzt_wall-1,m)                    &
-                                   - ( root_extr_green(nzt_wall)                                  &
-                                   * surf_usm_h(l)%qsws_veg(m)                                    &
-                                   * drho_l_lv  )                                                 &
-                                 ) * surf_usm_h(l)%ddz_green_stag(nzt_wall,m)
-
-                swc_h_p(l)%val(nzb_wall:nzt_wall,m) = swc_h(l)%val(nzb_wall:nzt_wall,m) + dt_3d   &
-                                               * ( tsc(2) * tend(:) + tsc(3)                      &
-                                                   * surf_usm_h(l)%tswc_h_m(:,m)                  &
-                                                  )
-
-!
-!--             Account for dry soils (find a better solution here!)
-                DO  kw = nzb_wall, nzt_wall
-                   IF ( swc_h_p(l)%val(kw,m) < 0.0_wp )  swc_h_p(l)%val(kw,m) = 0.0_wp
-                ENDDO
-
-!
-!--             Calculate m_soil tendencies for the next Runge-Kutta step
-                IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                   IF ( intermediate_timestep_count == 1 )  THEN
-                      DO  kw = nzb_wall, nzt_wall
-                         surf_usm_h(l)%tswc_h_m(kw,m) = tend(kw)
-                      ENDDO
-                   ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                      DO  kw = nzb_wall, nzt_wall
-                         surf_usm_h(l)%tswc_h_m(kw,m) = -9.5625_wp * tend(kw) + 5.3125_wp         &
-                                                     * surf_usm_h(l)%tswc_h_m(kw,m)
-                      ENDDO
-                   ENDIF
-                ENDIF
-             ENDIF
-
-          ENDIF
-       ENDDO
-    ELSE
-       IF ( horizontal) THEN
-!--       For horizontal downward surfaces
-          surf         => surf_usm_h(l)
-          t_wall       => t_wall_h(l)
-          t_green      => t_green_h(l)
-       ELSE
-!--       For vertical surfaces
-          surf         => surf_usm_v(l)
-          t_wall       => t_wall_v(l)
-          t_green      => t_green_v(l)
-       ENDIF
-       !$OMP PARALLEL DO PRIVATE (m, i, j, k, kw) SCHEDULE (STATIC)
-       DO  m = 1, surf%ns
-          IF (surf%frac(m,ind_pav_green) > 0.0_wp)  THEN
-!
-!-- No substrate layer for green walls / only groundbase green walls (ivy i.e.) -> Green layers get
-!-- same temperature as first wall layer, therefore no temperature calculations for vertical green
-!-- substrate layers now
-
-!
-! !
-! !--          Obtain indices
-!              i = surf%i(m)
-!              j = surf%j(m)
-!              k = surf%k(m)
-!
-!              t_green%val(nzt_wall+1,m) = t_wall%val(nzb_wall,m)
-! !
-! !--          Prognostic equation for green temperature t_green_v
-!              gtend(:) = 0.0_wp
-!              gtend(nzb_wall) = (1.0_wp / surf%rho_c_green(nzb_wall,m)) *                        &
-!                                      ( surf%lambda_h_green(nzb_wall,m) *                        &
-!                                        ( t_green%val(nzb_wall+1,m)                              &
-!                                        - t_green%val(nzb_wall,m) ) *                            &
-!                                        surf%ddz_green(nzb_wall+1,m)                             &
-!                                      + surf%wghf_eb(m) ) *                                      &
-!                                        surf%ddz_green_stag(nzb_wall,m)
-!
-!              DO  kw = nzb_wall+1, nzt_wall
-!                 gtend(kw) = (1.0_wp / surf%rho_c_green(kw,m))                                   &
-!                           * (   surf%lambda_h_green(kw,m)                                       &
-!                             * ( t_green%val(kw+1,m) - t_green%val(kw,m) )                       &
-!                             * surf%ddz_green(kw+1,m)                                            &
-!                           - surf%lambda_h(kw-1,m)                                               &
-!                             * ( t_green%val(kw,m) - t_green%val(kw-1,m) )                       &
-!                             * surf%ddz_green(kw,m) )                                            &
-!                           * surf%ddz_green_stag(kw,m)
-!              ENDDO
-!
-!              t_green_v_p(l)%val(nzb_wall:nzt_wall,m) =                                          &
-!                                   t_green%val(nzb_wall:nzt_wall,m)                              &
-!                                 + dt_3d * ( tsc(2)                                              &
-!                                 * gtend(nzb_wall:nzt_wall) + tsc(3)                             &
-!                                 * surf%tt_green_m(nzb_wall:nzt_wall,m) )
-!
-! !
-! !--          Calculate t_green tendencies for the next Runge-Kutta step
-!              IF ( timestep_scheme(1:5) == 'runge' )  THEN
-!                  IF ( intermediate_timestep_count == 1 )  THEN
-!                     DO  kw = nzb_wall, nzt_wall
-!                        surf%tt_green_m(kw,m) = gtend(kw)
-!                     ENDDO
-!                  ELSEIF ( intermediate_timestep_count <                                         &
-!                           intermediate_timestep_count_max )  THEN
-!                      DO  kw = nzb_wall, nzt_wall
-!                         surf%tt_green_m(kw,m) =                                                 &
-!                                     - 9.5625_wp * gtend(kw) +                                   &
-!                                       5.3125_wp * surf%tt_green_m(kw,m)
-!                      ENDDO
-!                  ENDIF
-!              ENDIF
-             DO  kw = nzb_wall, nzt_wall+1
-                 t_green%val(kw,m) = t_wall%val(nzb_wall,m)
-             ENDDO
-          ENDIF
-       ENDDO
-    ENDIF
-
-    IF ( debug_output_timestep )  THEN
-       WRITE( debug_string, * ) 'usm_green_heat_model: ', horizontal, l
-       CALL debug_message( debug_string, 'end' )
-    ENDIF
-
- END SUBROUTINE usm_green_heat_model
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &usm_par for urban surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_parin
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100)  ::  line  !< string containing current line of file PARIN
-
-    INTEGER(iwp) ::  io_status    !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /urban_surface_parameters/                                                            &
-                        building_type,                                                             &
-                        roof_category,                                                             &
-                        roof_inner_temperature,                                                    &
-                        roughness_concrete,                                                        &
-                        soil_inner_temperature,                                                    &
-                        switch_off_module,                                                         &
-                        usm_wall_mod,                                                              &
-                        wall_category,                                                             &
-                        wall_inner_temperature,                                                    &
-                        window_inner_temperature
-
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, urban_surface_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    urban_surface_parameters namelist was found and read correctly. Set flag that indicates that
-!--    the urban surface model is switched on.
-       IF ( .NOT. switch_off_module )  urban_surface = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    urban_surface_parameters namelist was found but contained errors. Print an error message
-!--    including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'urban_surface_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE usm_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!> Soubroutine reads t_surf and t_wall.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxr_on_file, nynf, nyn_on_file,   &
-                               nysf, nysc, nys_on_file, found )
-
-
-    USE control_parameters,                                                                        &
-        ONLY: length,                                                                              &
-              restart_string
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)  ::  k                 !< running index over previous input files covering current local domain
-    INTEGER(iwp)  ::  l                 !< index variable for surface type
-    INTEGER(iwp)  ::  nxlc              !< index of left boundary on current subdomain
-    INTEGER(iwp)  ::  nxlf              !< index of left boundary on former subdomain
-    INTEGER(iwp)  ::  nxl_on_file       !< index of left boundary on former local domain
-    INTEGER(iwp)  ::  nxrf              !< index of right boundary on former subdomain
-    INTEGER(iwp)  ::  nxr_on_file       !< index of right boundary on former local domain
-    INTEGER(iwp)  ::  nynf              !< index of north boundary on former subdomain
-    INTEGER(iwp)  ::  nyn_on_file       !< index of north boundary on former local domain
-    INTEGER(iwp)  ::  nysc              !< index of south boundary on current subdomain
-    INTEGER(iwp)  ::  nysf              !< index of south boundary on former subdomain
-    INTEGER(iwp)  ::  nys_on_file       !< index of south boundary on former local domain
-    INTEGER(iwp)  ::  ns_h_on_file_usm(0:1)  !< number of horizontal surface elements (urban type) on file
-    INTEGER(iwp)  ::  ns_v_on_file_usm(0:3)  !< number of vertical surface elements (urban type) on file
-!
-!-- Note, the save attribute in the following array declaration is necessary, in order to keep the
-!-- number of urban surface elements on file during rrd_local calls.
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  end_index_on_file    !<
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  start_index_on_file  !<
-
-    LOGICAL, INTENT(OUT)  ::  found  !<
-
-! MS: Why are there individual temporary arrays that all have the same size?
-    TYPE( surf_type_1d_usm ), DIMENSION(0:1), SAVE ::  tmp_surf_green_h   !<
-    TYPE( surf_type_1d_usm ), DIMENSION(0:1), SAVE ::  tmp_surf_mliq_h    !<
-    TYPE( surf_type_1d_usm ), DIMENSION(0:3), SAVE ::  tmp_surf_t_prev_h  !<
-    TYPE( surf_type_1d_usm ), DIMENSION(0:1), SAVE ::  tmp_surf_wall_h    !<
-    TYPE( surf_type_1d_usm ), DIMENSION(0:1), SAVE ::  tmp_surf_waste_h   !<
-    TYPE( surf_type_1d_usm ), DIMENSION(0:1), SAVE ::  tmp_surf_window_h  !<
-
-    TYPE( surf_type_2d_usm ), DIMENSION(0:1), SAVE ::  tmp_green_h   !<
-    TYPE( surf_type_2d_usm ), DIMENSION(0:1), SAVE ::  tmp_wall_h    !<
-    TYPE( surf_type_2d_usm ), DIMENSION(0:1), SAVE ::  tmp_window_h  !<
-
-    TYPE( surf_type_1d_usm ), DIMENSION(0:3), SAVE ::  tmp_surf_green_v   !<
-    TYPE( surf_type_1d_usm ), DIMENSION(0:3), SAVE ::  tmp_surf_t_prev_v  !<
-    TYPE( surf_type_1d_usm ), DIMENSION(0:3), SAVE ::  tmp_surf_wall_v    !<
-    TYPE( surf_type_1d_usm ), DIMENSION(0:3), SAVE ::  tmp_surf_waste_v   !<
-    TYPE( surf_type_1d_usm ), DIMENSION(0:3), SAVE ::  tmp_surf_window_v  !<
-
-    TYPE( surf_type_2d_usm ), DIMENSION(0:3), SAVE ::  tmp_green_v   !<
-    TYPE( surf_type_2d_usm ), DIMENSION(0:3), SAVE ::  tmp_wall_v    !<
-    TYPE( surf_type_2d_usm ), DIMENSION(0:3), SAVE ::  tmp_window_v  !<
-
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'ns_h_on_file_usm')
-          IF ( k == 1 )  THEN
-             READ ( 13 ) ns_h_on_file_usm
-
-             DO  l = 0, 1
-                IF ( ALLOCATED( tmp_surf_wall_h(l)%val ) )    DEALLOCATE( tmp_surf_wall_h(l)%val )
-                IF ( ALLOCATED( tmp_wall_h(l)%val ) )         DEALLOCATE( tmp_wall_h(l)%val )
-                IF ( ALLOCATED( tmp_surf_window_h(l)%val ) )  DEALLOCATE( tmp_surf_window_h(l)%val )
-                IF ( ALLOCATED( tmp_window_h(l)%val) )        DEALLOCATE( tmp_window_h(l)%val )
-                IF ( ALLOCATED( tmp_surf_green_h(l)%val) )    DEALLOCATE( tmp_surf_green_h(l)%val )
-                IF ( ALLOCATED( tmp_green_h(l)%val) )         DEALLOCATE( tmp_green_h(l)%val )
-                IF ( ALLOCATED( tmp_surf_mliq_h(l)%val) )     DEALLOCATE( tmp_surf_mliq_h(l)%val )
-                IF ( ALLOCATED( tmp_surf_waste_h(l)%val) )    DEALLOCATE( tmp_surf_waste_h(l)%val )
-                IF ( ALLOCATED( tmp_surf_t_prev_h(l)%val) )   DEALLOCATE( tmp_surf_t_prev_h(l)%val )
-             ENDDO
-
-!
-!--          Allocate temporary arrays for reading data on file. Note, the size of allocated surface
-!--          elements do not necessarily need  to match the size of present surface elements on
-!--          current processor, as the number of processors between restarts can change.
-             DO  l = 0, 1
-                ALLOCATE( tmp_surf_wall_h(l)%val(1:ns_h_on_file_usm(l)) )
-                ALLOCATE( tmp_wall_h(l)%val(nzb_wall:nzt_wall+1, 1:ns_h_on_file_usm(l) ) )
-                ALLOCATE( tmp_surf_window_h(l)%val(1:ns_h_on_file_usm(l)) )
-                ALLOCATE( tmp_window_h(l)%val(nzb_wall:nzt_wall+1, 1:ns_h_on_file_usm(l) ) )
-                ALLOCATE( tmp_surf_green_h(l)%val(1:ns_h_on_file_usm(l)) )
-                ALLOCATE( tmp_green_h(l)%val(nzb_wall:nzt_wall+1, 1:ns_h_on_file_usm(l) ) )
-                ALLOCATE( tmp_surf_mliq_h(l)%val(1:ns_h_on_file_usm(l)) )
-                ALLOCATE( tmp_surf_waste_h(l)%val(1:ns_h_on_file_usm(l)) )
-                ALLOCATE( tmp_surf_t_prev_h(l)%val(1:ns_h_on_file_usm(l)) )
-             ENDDO
-
-          ENDIF
-
-       CASE ( 'ns_v_on_file_usm')
-          IF ( k == 1 )  THEN
-             READ ( 13 ) ns_v_on_file_usm
-
-             DO  l = 0, 3
-                IF ( ALLOCATED( tmp_surf_wall_v(l)%val ) )    DEALLOCATE( tmp_surf_wall_v(l)%val )
-                IF ( ALLOCATED( tmp_wall_v(l)%val ) )         DEALLOCATE( tmp_wall_v(l)%val )
-                IF ( ALLOCATED( tmp_surf_window_v(l)%val ) )  DEALLOCATE( tmp_surf_window_v(l)%val )
-                IF ( ALLOCATED( tmp_window_v(l)%val ) )       DEALLOCATE( tmp_window_v(l)%val )
-                IF ( ALLOCATED( tmp_surf_green_v(l)%val ) )   DEALLOCATE( tmp_surf_green_v(l)%val )
-                IF ( ALLOCATED( tmp_green_v(l)%val ) )        DEALLOCATE( tmp_green_v(l)%val )
-                IF ( ALLOCATED( tmp_surf_waste_v(l)%val ) )   DEALLOCATE( tmp_surf_waste_v(l)%val )
-                IF ( ALLOCATED( tmp_surf_t_prev_v(l)%val ) )  DEALLOCATE( tmp_surf_t_prev_v(l)%val )
-             ENDDO
-
-!
-!--          Allocate temporary arrays for reading data on file. Note, the size of allocated surface
-!--          elements do not necessarily need to match the size of present surface elements on
-!--          current processor, as the number of processors between restarts can change.
-             DO  l = 0, 3
-                ALLOCATE( tmp_surf_wall_v(l)%val(1:ns_v_on_file_usm(l)) )
-                ALLOCATE( tmp_wall_v(l)%val(nzb_wall:nzt_wall+1, 1:ns_v_on_file_usm(l) ) )
-                ALLOCATE( tmp_surf_window_v(l)%val(1:ns_v_on_file_usm(l)) )
-                ALLOCATE( tmp_window_v(l)%val(nzb_wall:nzt_wall+1, 1:ns_v_on_file_usm(l) ) )
-                ALLOCATE( tmp_surf_green_v(l)%val(1:ns_v_on_file_usm(l)) )
-                ALLOCATE( tmp_green_v(l)%val(nzb_wall:nzt_wall+1, 1:ns_v_on_file_usm(l) ) )
-                ALLOCATE( tmp_surf_waste_v(l)%val(1:ns_v_on_file_usm(l)) )
-                ALLOCATE( tmp_surf_t_prev_v(l)%val(1:ns_v_on_file_usm(l)) )
-             ENDDO
-
-          ENDIF
-
-       CASE ( 'usm_start_index_h', 'usm_start_index_v'  )
-          IF ( k == 1 )  THEN
-
-             IF ( ALLOCATED( start_index_on_file ) )  DEALLOCATE( start_index_on_file )
-
-             ALLOCATE ( start_index_on_file(nys_on_file:nyn_on_file, nxl_on_file:nxr_on_file) )
-
-             READ ( 13 )  start_index_on_file
-
-          ENDIF
-
-       CASE ( 'usm_end_index_h', 'usm_end_index_v' )
-          IF ( k == 1 )  THEN
-
-             IF ( ALLOCATED( end_index_on_file ) )  DEALLOCATE( end_index_on_file )
-
-             ALLOCATE ( end_index_on_file(nys_on_file:nyn_on_file, nxl_on_file:nxr_on_file) )
-
-             READ ( 13 )  end_index_on_file
-
-          ENDIF
-
-       CASE ( 't_surf_wall_h(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_wall_h_1(0)%val ) )                                     &
-                ALLOCATE( t_surf_wall_h_1(0)%val(1:surf_usm_h(0)%ns) )
-             READ ( 13 )  tmp_surf_wall_h(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_wall_h_1(0)%val, tmp_surf_wall_h(0)%val,           &
-                                         surf_usm_h(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_surf_wall_h(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_wall_h_1(1)%val ) )                                     &
-                ALLOCATE( t_surf_wall_h_1(1)%val(1:surf_usm_h(1)%ns) )
-             READ ( 13 )  tmp_surf_wall_h(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_wall_h_1(1)%val, tmp_surf_wall_h(1)%val,           &
-                                         surf_usm_h(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_surf_wall_v(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(0)%val ) )                                     &
-                ALLOCATE( t_surf_wall_v_1(0)%val(1:surf_usm_v(0)%ns) )
-             READ ( 13 )  tmp_surf_wall_v(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_wall_v_1(0)%val, tmp_surf_wall_v(0)%val,           &
-                                         surf_usm_v(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_surf_wall_v(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(1)%val ) )                                     &
-                ALLOCATE( t_surf_wall_v_1(1)%val(1:surf_usm_v(1)%ns) )
-             READ ( 13 )  tmp_surf_wall_v(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_wall_v_1(1)%val, tmp_surf_wall_v(1)%val,           &
-                                         surf_usm_v(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_surf_wall_v(2)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(2)%val ) )                                     &
-                ALLOCATE( t_surf_wall_v_1(2)%val(1:surf_usm_v(2)%ns) )
-             READ ( 13 )  tmp_surf_wall_v(2)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_wall_v_1(2)%val, tmp_surf_wall_v(2)%val,           &
-                                         surf_usm_v(2)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_surf_wall_v(3)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(3)%val ) )                                     &
-                ALLOCATE( t_surf_wall_v_1(3)%val(1:surf_usm_v(3)%ns) )
-             READ ( 13 )  tmp_surf_wall_v(3)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_wall_v_1(3)%val, tmp_surf_wall_v(3)%val,           &
-                                         surf_usm_v(3)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_surf_window_h(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_window_h_1(0)%val ) )                                   &
-                ALLOCATE( t_surf_window_h_1(0)%val(1:surf_usm_h(0)%ns) )
-             READ ( 13 )  tmp_surf_window_h(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_window_h_1(0)%val, tmp_surf_window_h(0)%val,       &
-                                         surf_usm_h(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surf_window_h(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_window_h_1(1)%val ) )                                   &
-                ALLOCATE( t_surf_window_h_1(1)%val(1:surf_usm_h(1)%ns) )
-             READ ( 13 )  tmp_surf_window_h(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_window_h_1(1)%val, tmp_surf_window_h(1)%val,       &
-                                         surf_usm_h(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surf_window_v(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_window_v_1(0)%val ) )                                   &
-                ALLOCATE( t_surf_window_v_1(0)%val(1:surf_usm_v(0)%ns) )
-             READ ( 13 )  tmp_surf_window_v(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_window_v_1(0)%val, tmp_surf_window_v(0)%val,       &
-                                         surf_usm_v(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surf_window_v(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_window_v_1(1)%val ) )                                   &
-                ALLOCATE( t_surf_window_v_1(1)%val(1:surf_usm_v(1)%ns) )
-             READ ( 13 )  tmp_surf_window_v(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_window_v_1(1)%val, tmp_surf_window_v(1)%val,       &
-                                         surf_usm_v(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surf_window_v(2)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_window_v_1(2)%val ) )                                   &
-                ALLOCATE( t_surf_window_v_1(2)%val(1:surf_usm_v(2)%ns) )
-             READ ( 13 )  tmp_surf_window_v(2)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_window_v_1(2)%val, tmp_surf_window_v(2)%val,       &
-                                         surf_usm_v(2)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surf_window_v(3)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_window_v_1(3)%val ) )                                   &
-                ALLOCATE( t_surf_window_v_1(3)%val(1:surf_usm_v(3)%ns) )
-             READ ( 13 )  tmp_surf_window_v(3)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_window_v_1(3)%val, tmp_surf_window_v(3)%val,       &
-                                         surf_usm_v(3)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surf_green_h(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_green_h_1(0)%val ) )                                    &
-                ALLOCATE( t_surf_green_h_1(0)%val(1:surf_usm_h(0)%ns) )
-             READ ( 13 )  tmp_surf_green_h(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_green_h_1(0)%val, tmp_surf_green_h(0)%val,         &
-                                         surf_usm_h(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_surf_green_h(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_green_h_1(1)%val ) )                                    &
-                ALLOCATE( t_surf_green_h_1(1)%val(1:surf_usm_h(1)%ns) )
-             READ ( 13 )  tmp_surf_green_h(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_green_h_1(1)%val, tmp_surf_green_h(1)%val,         &
-                                         surf_usm_h(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_surf_green_v(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_green_v_1(0)%val ) )                                    &
-                ALLOCATE( t_surf_green_v_1(0)%val(1:surf_usm_v(0)%ns) )
-             READ ( 13 )  tmp_surf_green_v(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_green_v_1(0)%val, tmp_surf_green_v(0)%val,         &
-                                         surf_usm_v(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_surf_green_v(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_green_v_1(1)%val ) )                                    &
-                ALLOCATE( t_surf_green_v_1(1)%val(1:surf_usm_v(1)%ns) )
-             READ ( 13 )  tmp_surf_green_v(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_green_v_1(1)%val, tmp_surf_green_v(1)%val,         &
-                                         surf_usm_v(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surf_green_v(2)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_green_v_1(2)%val ) )                                    &
-                ALLOCATE( t_surf_green_v_1(2)%val(1:surf_usm_v(2)%ns) )
-             READ ( 13 )  tmp_surf_green_v(2)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_green_v_1(2)%val, tmp_surf_green_v(2)%val,         &
-                                         surf_usm_v(2)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_surf_green_v(3)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_surf_green_v_1(3)%val ) )                                    &
-                ALLOCATE( t_surf_green_v_1(3)%val(1:surf_usm_v(3)%ns) )
-             READ ( 13 )  tmp_surf_green_v(3)%val
-          ENDIF
-          CALL surface_restore_elements( t_surf_green_v_1(3)%val, tmp_surf_green_v(3)%val,         &
-                                         surf_usm_v(3)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 'm_liq_usm_h(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_liq_usm_h(0)%val ) )                                         &
-                ALLOCATE( m_liq_usm_h(0)%val(1:surf_usm_h(0)%ns) )
-             READ ( 13 )  tmp_surf_mliq_h(0)%val
-          ENDIF
-          CALL surface_restore_elements( m_liq_usm_h(0)%val, tmp_surf_mliq_h(0)%val,               &
-                                         surf_usm_h(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 'm_liq_usm_h(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( m_liq_usm_h(1)%val ) )                                         &
-                ALLOCATE( m_liq_usm_h(1)%val(1:surf_usm_h(1)%ns) )
-             READ ( 13 )  tmp_surf_mliq_h(1)%val
-          ENDIF
-          CALL surface_restore_elements( m_liq_usm_h(1)%val, tmp_surf_mliq_h(1)%val,               &
-                                         surf_usm_h(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 'waste_heat_h(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_h(0)%waste_heat ) )                                   &
-                ALLOCATE( surf_usm_h(0)%waste_heat(1:surf_usm_h(0)%ns) )
-             READ ( 13 )  tmp_surf_waste_h(0)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_h(0)%waste_heat, tmp_surf_waste_h(0)%val,        &
-                                         surf_usm_h(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 'waste_heat_h(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_h(1)%waste_heat ) )                                   &
-                ALLOCATE( surf_usm_h(1)%waste_heat(1:surf_usm_h(1)%ns) )
-             READ ( 13 )  tmp_surf_waste_h(1)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_h(1)%waste_heat, tmp_surf_waste_h(1)%val,        &
-                                         surf_usm_h(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-
-       CASE ( 'waste_heat_v(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_v(0)%waste_heat ) )                                   &
-                ALLOCATE( surf_usm_v(0)%waste_heat(1:surf_usm_v(0)%ns) )
-             READ ( 13 )  tmp_surf_waste_v(0)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_v(0)%waste_heat, tmp_surf_waste_v(0)%val,        &
-                                         surf_usm_v(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 'waste_heat_v(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_v(1)%waste_heat ) )                                   &
-                ALLOCATE( surf_usm_v(1)%waste_heat(1:surf_usm_v(1)%ns) )
-             READ ( 13 )  tmp_surf_waste_v(1)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_v(1)%waste_heat, tmp_surf_waste_v(1)%val,        &
-                                         surf_usm_v(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 'waste_heat_v(2)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_v(2)%waste_heat ) )                                   &
-                ALLOCATE( surf_usm_v(2)%waste_heat(1:surf_usm_v(2)%ns) )
-             READ ( 13 )  tmp_surf_waste_v(2)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_v(2)%waste_heat, tmp_surf_waste_v(2)%val,        &
-                                         surf_usm_v(2)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 'waste_heat_v(3)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_v(3)%waste_heat ) )                                   &
-                ALLOCATE( surf_usm_v(3)%waste_heat(1:surf_usm_v(3)%ns) )
-             READ ( 13 )  tmp_surf_waste_v(3)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_v(3)%waste_heat, tmp_surf_waste_v(3)%val,        &
-                                         surf_usm_v(3)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_prev_h(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_h(0)%t_prev ) )                                       &
-                ALLOCATE( surf_usm_h(0)%t_prev(1:surf_usm_h(0)%ns) )
-             READ ( 13 )  tmp_surf_t_prev_h(0)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_h(0)%t_prev, tmp_surf_t_prev_h(0)%val,           &
-                                         surf_usm_h(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_prev_h(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_h(1)%t_prev ) )                                       &
-                ALLOCATE( surf_usm_h(1)%t_prev(1:surf_usm_h(1)%ns) )
-             READ ( 13 )  tmp_surf_t_prev_h(1)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_h(1)%t_prev, tmp_surf_t_prev_h(1)%val,           &
-                                         surf_usm_h(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-
-       CASE ( 't_prev_v(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_v(0)%t_prev ) )                                       &
-                ALLOCATE( surf_usm_v(0)%t_prev(1:surf_usm_v(0)%ns) )
-             READ ( 13 )  tmp_surf_t_prev_v(0)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_v(0)%t_prev, tmp_surf_t_prev_v(0)%val,           &
-                                         surf_usm_v(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_prev_v(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_v(1)%t_prev ) )                                       &
-                ALLOCATE( surf_usm_v(1)%t_prev(1:surf_usm_v(1)%ns) )
-             READ ( 13 )  tmp_surf_t_prev_v(1)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_v(1)%t_prev, tmp_surf_t_prev_v(1)%val,           &
-                                         surf_usm_v(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_prev_v(2)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_v(2)%t_prev ) )                                       &
-                ALLOCATE( surf_usm_v(2)%t_prev(1:surf_usm_v(2)%ns) )
-             READ ( 13 )  tmp_surf_t_prev_v(2)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_v(2)%t_prev, tmp_surf_t_prev_v(2)%val,           &
-                                         surf_usm_v(2)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_prev_v(3)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( surf_usm_v(3)%t_prev ) )                                       &
-                ALLOCATE( surf_usm_v(3)%t_prev(1:surf_usm_v(3)%ns) )
-             READ ( 13 )  tmp_surf_t_prev_v(3)%val
-          ENDIF
-          CALL surface_restore_elements( surf_usm_v(3)%t_prev, tmp_surf_t_prev_v(3)%val,           &
-                                         surf_usm_v(3)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_wall_h(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_wall_h_1(0)%val ) )                                          &
-                ALLOCATE( t_wall_h_1(0)%val(nzb_wall:nzt_wall+1, 1:surf_usm_h(0)%ns) )
-             READ ( 13 )  tmp_wall_h(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_wall_h_1(0)%val, tmp_wall_h(0)%val,                     &
-                                         surf_usm_h(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_wall_h(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_wall_h_1(1)%val ) )                                          &
-                ALLOCATE( t_wall_h_1(1)%val(nzb_wall:nzt_wall+1, 1:surf_usm_h(1)%ns) )
-             READ ( 13 )  tmp_wall_h(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_wall_h_1(1)%val, tmp_wall_h(1)%val,                     &
-                                         surf_usm_h(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_wall_v(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_wall_v_1(0)%val ) )                                          &
-                ALLOCATE( t_wall_v_1(0)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(0)%ns) )
-             READ ( 13 )  tmp_wall_v(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_wall_v_1(0)%val, tmp_wall_v(0)%val,                     &
-                                         surf_usm_v(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_wall_v(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_wall_v_1(1)%val ) )                                          &
-                ALLOCATE( t_wall_v_1(1)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(1)%ns) )
-             READ ( 13 )  tmp_wall_v(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_wall_v_1(1)%val, tmp_wall_v(1)%val,                     &
-                                         surf_usm_v(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_wall_v(2)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_wall_v_1(2)%val ) )                                          &
-                ALLOCATE( t_wall_v_1(2)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(2)%ns) )
-             READ ( 13 )  tmp_wall_v(2)%val
-          ENDIF
-          CALL surface_restore_elements( t_wall_v_1(2)%val, tmp_wall_v(2)%val,                     &
-                                         surf_usm_v(2)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_wall_v(3)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_wall_v_1(3)%val ) )                                          &
-                ALLOCATE( t_wall_v_1(3)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(3)%ns) )
-             READ ( 13 )  tmp_wall_v(3)%val
-          ENDIF
-          CALL surface_restore_elements( t_wall_v_1(3)%val, tmp_wall_v(3)%val,                     &
-                                         surf_usm_v(3)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_window_h(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_window_h_1(0)%val ) )                                        &
-                ALLOCATE( t_window_h_1(0)%val(nzb_wall:nzt_wall+1, 1:surf_usm_h(0)%ns) )
-             READ ( 13 )  tmp_window_h(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_window_h_1(0)%val, tmp_window_h(0)%val,                 &
-                                         surf_usm_h(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_window_h(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_window_h_1(1)%val ) )                                        &
-                ALLOCATE( t_window_h_1(1)%val(nzb_wall:nzt_wall+1, 1:surf_usm_h(1)%ns) )
-             READ ( 13 )  tmp_window_h(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_window_h_1(1)%val, tmp_window_h(1)%val,                 &
-                                         surf_usm_h(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file, nxr_on_file )
-
-       CASE ( 't_window_v(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_window_v_1(0)%val ) )                                          &
-                ALLOCATE( t_window_v_1(0)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(0)%ns) )
-             READ ( 13 )  tmp_window_v(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_window_v_1(0)%val, tmp_window_v(0)%val,                     &
-                                         surf_usm_v(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_window_v(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_window_v_1(1)%val ) )                                          &
-                ALLOCATE( t_window_v_1(1)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(1)%ns) )
-             READ ( 13 )  tmp_window_v(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_window_v_1(1)%val, tmp_window_v(1)%val,                     &
-                                         surf_usm_v(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_window_v(2)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_window_v_1(2)%val ) )                                          &
-                ALLOCATE( t_window_v_1(2)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(2)%ns) )
-             READ ( 13 )  tmp_window_v(2)%val
-          ENDIF
-          CALL surface_restore_elements( t_window_v_1(2)%val, tmp_window_v(2)%val,                     &
-                                         surf_usm_v(2)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_window_v(3)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_window_v_1(3)%val ) )                                          &
-                ALLOCATE( t_window_v_1(3)%val(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
-             READ ( 13 )  tmp_window_v(3)%val
-          ENDIF
-          CALL surface_restore_elements( t_window_v_1(3)%val, tmp_window_v(3)%val,                     &
-                                         surf_usm_v(3)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_green_h(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_green_h_1(0)%val ) )                                           &
-                ALLOCATE( t_green_h_1(0)%val(nzb_wall:nzt_wall+1, 1:surf_usm_h(0)%ns) )
-             READ ( 13 )  tmp_green_h(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_green_h_1(0)%val, tmp_green_h(0)%val,                       &
-                                         surf_usm_h(0)%start_index, start_index_on_file,              &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_green_h(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_green_h_1(1)%val ) )                                           &
-                ALLOCATE( t_green_h_1(1)%val(nzb_wall:nzt_wall+1, 1:surf_usm_h(1)%ns) )
-             READ ( 13 )  tmp_green_h(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_green_h_1(1)%val, tmp_green_h(1)%val,                       &
-                                         surf_usm_h(1)%start_index, start_index_on_file,              &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_green_v(0)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_green_v_1(0)%val ) )                                           &
-                ALLOCATE( t_green_v_1(0)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(0)%ns) )
-             READ ( 13 )  tmp_green_v(0)%val
-          ENDIF
-          CALL surface_restore_elements( t_green_v_1(0)%val, tmp_green_v(0)%val,                       &
-                                         surf_usm_v(0)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_green_v(1)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_green_v_1(1)%val ) )                                           &
-                ALLOCATE( t_green_v_1(1)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(1)%ns) )
-             READ ( 13 )  tmp_green_v(1)%val
-          ENDIF
-          CALL surface_restore_elements( t_green_v_1(1)%val, tmp_green_v(1)%val,                       &
-                                         surf_usm_v(1)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_green_v(2)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_green_v_1(2)%val ) )                                           &
-                ALLOCATE( t_green_v_1(2)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(2)%ns) )
-             READ ( 13 )  tmp_green_v(2)%val
-          ENDIF
-          CALL surface_restore_elements( t_green_v_1(2)%val, tmp_green_v(2)%val,                       &
-                                         surf_usm_v(2)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE ( 't_green_v(3)' )
-          IF ( k == 1 )  THEN
-             IF ( .NOT.  ALLOCATED( t_green_v_1(3)%val ) )                                           &
-                ALLOCATE( t_green_v_1(3)%val(nzb_wall:nzt_wall+1, 1:surf_usm_v(3)%ns) )
-             READ ( 13 )  tmp_green_v(3)%val
-          ENDIF
-          CALL surface_restore_elements( t_green_v_1(3)%val, tmp_green_v(3)%val,                       &
-                                         surf_usm_v(3)%start_index, start_index_on_file,           &
-                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
-                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE usm_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!> Soubroutine reads t_surf and t_wall.
-!>
-!> This read routine is a counterpart of usm_wrd_local.
-!> In usm_wrd_local, all array are unconditionally written, therefore all arrays are read here.
-!> This is a preliminary version of reading usm data. The final version has to be discussed with
-!> the developers.
-!>
-!> If it is possible to call usm_allocate_surface before reading the restart file, this reading
-!> routine would become much simpler, because no checking for allocation will be necessary any more.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_rrd_local_mpi
-
-    CHARACTER(LEN=1) ::  dum  !< dummy string to create input-variable name
-
-    INTEGER(iwp) ::  l  !< loop index for surface types
-
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_end_index
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_start_index
-
-    LOGICAL ::  data_to_read  !< dummy variable
-
-
-    DO  l = 0, 1
-
-       WRITE( dum, '(I1)' )  l
-
-       CALL rrd_mpi_io( 'usm_global_start_h_' //dum, global_start_index )
-       CALL rrd_mpi_io( 'usm_global_end_h_' //dum, global_end_index )
-
-       CALL rd_mpi_io_surface_filetypes( surf_usm_h(l)%start_index, surf_usm_h(l)%end_index,       &
-                                         data_to_read, global_start_index, global_end_index )
-       IF ( .NOT. data_to_read )  CYCLE
-
-       IF ( .NOT. ALLOCATED( t_surf_wall_h_1(l)%val ) )                                            &
-          ALLOCATE( t_surf_wall_h_1(l)%val(1:surf_usm_h(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_surf_wall_h(' // dum // ')', t_surf_wall_h_1(l)%val )
-
-       IF ( .NOT. ALLOCATED( t_surf_window_h_1(l)%val ) )                                          &
-          ALLOCATE( t_surf_window_h_1(l)%val(1:surf_usm_h(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_surf_window_h(' // dum // ')', t_surf_window_h_1(l)%val )
-
-       IF ( .NOT. ALLOCATED( t_surf_green_h_1(l)%val ) )                                           &
-          ALLOCATE( t_surf_green_h_1(l)%val(1:surf_usm_h(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_surf_green_h(' // dum // ')', t_surf_green_h_1(l)%val )
-
-       IF ( .NOT. ALLOCATED( m_liq_usm_h_1(l)%val ) )                                              &
-          ALLOCATE( m_liq_usm_h_1(l)%val(1:surf_usm_h(l)%ns) )
-       CALL rrd_mpi_io_surface( 'm_liq_usm_h(' // dum // ')', m_liq_usm_h_1(l)%val )
-
-       IF ( indoor_model )  THEN
-          IF ( .NOT. ALLOCATED( surf_usm_h(l)%waste_heat ) )                                       &
-             ALLOCATE( surf_usm_h(l)%waste_heat(1:surf_usm_h(l)%ns) )
-          CALL rrd_mpi_io_surface( 'waste_heat_h(' // dum // ')', surf_usm_h(l)%waste_heat )
-          IF ( .NOT. ALLOCATED( surf_usm_h(l)%t_prev ) )                                           &
-             ALLOCATE( surf_usm_h(l)%t_prev(1:surf_usm_h(l)%ns) )
-          CALL rrd_mpi_io_surface( 't_prev_h(' // dum // ')', surf_usm_h(l)%t_prev )
-       ENDIF
-
-    ENDDO
-    DO  l = 0, 3
-
-       WRITE( dum, '(I1)' )  l
-
-       CALL rrd_mpi_io( 'usm_global_start_v_' // dum, global_start_index )
-       CALL rrd_mpi_io( 'usm_global_end_v_' // dum, global_end_index )
-
-       CALL rd_mpi_io_surface_filetypes( surf_usm_v(l)%start_index, surf_usm_v(l)%end_index,       &
-                                         data_to_read, global_start_index, global_end_index )
-       IF ( .NOT. data_to_read )  CYCLE
-
-       IF ( .NOT. ALLOCATED( t_surf_wall_v_1(l)%val ) )                                            &
-          ALLOCATE( t_surf_wall_v_1(l)%val(1:surf_usm_v(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_surf_wall_v(' // dum // ')', t_surf_wall_v_1(l)%val )
-
-       IF ( .NOT. ALLOCATED( t_surf_window_v_1(l)%val ) )                                          &
-          ALLOCATE( t_surf_window_v_1(l)%val(1:surf_usm_v(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_surf_window_v(' // dum // ')', t_surf_window_v_1(l)%val )
-
-       IF ( .NOT. ALLOCATED( t_surf_green_v_1(l)%val ) )                                           &
-          ALLOCATE( t_surf_green_v_1(l)%val(1:surf_usm_v(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_surf_green_v(' // dum // ')', t_surf_green_v_1(l)%val)
-
-       IF ( indoor_model )  THEN
-          IF ( .NOT. ALLOCATED( surf_usm_v(l)%waste_heat ) )                                       &
-             ALLOCATE( surf_usm_v(l)%waste_heat(1:surf_usm_v(l)%ns) )
-          CALL rrd_mpi_io_surface( 'waste_heat_v(' // dum // ')', surf_usm_v(l)%waste_heat )
-          IF ( .NOT. ALLOCATED( surf_usm_v(l)%t_prev ) )                                           &
-             ALLOCATE( surf_usm_v(l)%t_prev(1:surf_usm_v(l)%ns) )
-          CALL rrd_mpi_io_surface( 't_prev_v(' // dum // ')', surf_usm_v(l)%t_prev )
-       ENDIF
-
-    ENDDO
-
-    DO  l = 0, 1
-
-       WRITE( dum, '(I1)' )  l
-
-       CALL rrd_mpi_io( 'usm_global_start_h_2_' //dum, global_start_index )
-       CALL rrd_mpi_io( 'usm_global_end_h_2_' //dum, global_end_index )
-
-       CALL rd_mpi_io_surface_filetypes( surf_usm_h(l)%start_index, surf_usm_h(l)%end_index,       &
-                                         data_to_read, global_start_index, global_end_index )
-       IF ( .NOT. data_to_read )  CYCLE
-
-       IF ( .NOT. ALLOCATED( t_wall_h_1(l)%val ) )                                                 &
-          ALLOCATE( t_wall_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_wall_h(' // dum // ')', t_wall_h_1(l)%val )
-
-       IF ( .NOT. ALLOCATED( t_window_h_1(l)%val ) )                                               &
-          ALLOCATE( t_window_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_window_h(' // dum // ')', t_window_h_1(l)%val )
-
-       IF ( .NOT. ALLOCATED( t_green_h_1(l)%val ) )                                                &
-          ALLOCATE( t_green_h_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_h(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_green_h(' // dum // ')', t_green_h_1(l)%val )
-
-    ENDDO
-
-    DO  l = 0, 3
-
-       WRITE( dum, '(I1)' )  l
-
-       CALL rrd_mpi_io( 'usm_global_start_v_2_' // dum, global_start_index )
-       CALL rrd_mpi_io( 'usm_global_end_v_2_' // dum, global_end_index )
-
-       CALL rd_mpi_io_surface_filetypes( surf_usm_v(l)%start_index, surf_usm_v(l)%end_index,       &
-                                         data_to_read, global_start_index, global_end_index )
-       IF ( .NOT. data_to_read )  CYCLE
-
-       IF ( .NOT. ALLOCATED( t_wall_v_1(l)%val ) )                                                 &
-          ALLOCATE ( t_wall_v_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_wall_v(' // dum // ')', t_wall_v_1(l)%val )
-
-       IF ( .NOT. ALLOCATED( t_window_v_1(l)%val ) )                                               &
-          ALLOCATE ( t_window_v_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_window_v(' // dum // ')', t_window_v_1(l)%val )
-
-       IF ( .NOT. ALLOCATED( t_green_v_1(l)%val ) )                                                &
-          ALLOCATE ( t_green_v_1(l)%val(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
-       CALL rrd_mpi_io_surface( 't_green_v(' // dum // ')', t_green_v_1(l)%val )
-
-    ENDDO
-
- END SUBROUTINE usm_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Solver for the energy balance at the ground/roof/wall surface. It follows the basic ideas and
-!> structure of lsm_energy_balance with many simplifications and adjustments.
-!> TODO better description
-!> No calculation of window surface temperatures during spinup to increase maximum possible timstep
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_energy_balance( during_spinup )
-
-    LOGICAL       ::  during_spinup  !< flag indicating soil/wall spinup phase
-    INTEGER(iwp)  ::  l              !< loop index for surface types
-!
-!-- Call for horizontal surfaces
-    DO l = 0, 1
-       CALL usm_surface_energy_balance( .TRUE., l, during_spinup )
-       CALL usm_green_heat_model( .TRUE., l )
-       CALL usm_wall_heat_model( .TRUE., l, during_spinup )
-    ENDDO
-!
-!--   Call for vertical surfaces
-    DO l = 0, 3
-       CALL usm_surface_energy_balance( .FALSE., l, during_spinup )
-       CALL usm_green_heat_model( .FALSE., l )
-       CALL usm_wall_heat_model( .FALSE., l, during_spinup )
-    ENDDO
-
- END SUBROUTINE usm_energy_balance
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Solver for the energy balance at the ground/roof/wall surface. It follows the basic ideas and
-!> structure of lsm_energy_balance with many simplifications and adjustments.
-!> TODO better description
-!> No calculation of window surface temperatures during spinup to increase maximum possible timstep
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_surface_energy_balance( horizontal, l, during_spinup )
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-
-    IMPLICIT NONE
-
-    LOGICAL       ::  horizontal     !< Flag indicating horizontal or vertical surfaces
-    INTEGER(iwp)  ::  l              !< direction index
-    LOGICAL       ::  during_spinup  !< flag indicating soil/wall spinup phase
-
-    INTEGER(iwp)  ::  i, j, k, m     !< running indices
-    INTEGER(iwp)  ::  i_off          !< offset to determine index of surface element, seen from atmospheric grid point, for x
-    INTEGER(iwp)  ::  j_off          !< offset to determine index of surface element, seen from atmospheric grid point, for y
-    INTEGER(iwp)  ::  k_off          !< offset to determine index of surface element, seen from atmospheric grid point, for z
-
-
-    REAL(wp)  ::  coef_1             !< first coeficient for prognostic equation
-    REAL(wp)  ::  coef_window_1      !< first coeficient for prognostic window equation
-    REAL(wp)  ::  coef_green_1       !< first coeficient for prognostic green wall equation
-    REAL(wp)  ::  coef_2             !< second  coeficient for prognostic equation
-    REAL(wp)  ::  coef_window_2      !< second  coeficient for prognostic window equation
-    REAL(wp)  ::  coef_green_2       !< second  coeficient for prognostic green wall equation
-    REAL(wp)  ::  frac_win           !< window fraction, used to restore original values during spinup
-    REAL(wp)  ::  frac_green         !< green fraction, used to restore original values during spinup
-    REAL(wp)  ::  frac_wall          !< wall fraction, used to restore original values during spinup
-    REAL(wp)  ::  f_shf              !< factor for shf_eb
-    REAL(wp)  ::  f_shf_window       !< factor for shf_eb window
-    REAL(wp)  ::  f_shf_green        !< factor for shf_eb green wall
-    REAL(wp)  ::  lambda_surface     !< current value of lambda_surface (heat conductivity
-                                     !<between air and wall)
-    REAL(wp)  ::  lambda_surface_window  !< current value of lambda_surface (heat conductivity
-                                         !< between air and window)
-    REAL(wp)  ::  lambda_surface_green   !< current value of lambda_surface (heat conductivity
-                                                                    !< between air and greeb wall)
-    REAL(wp)  ::  rho_cp             !< rho_wall_surface * c_p
-    REAL(wp)  ::  stend_wall         !< surface tendency
-    REAL(wp)  ::  stend_window       !< surface tendency
-    REAL(wp)  ::  stend_green        !< surface tendency
-
-
-    REAL(wp)  ::  dq_s_dt,                 &  !< derivate of q_s with respect to T
-                  drho_l_lv,               &  !< frequently used parameter for green layers
-                  e,                       &  !< water vapour pressure
-                  e_s,                     &  !< water vapour saturation pressure
-                  e_s_dt,                  &  !< derivate of e_s with respect to T
-                  f_qsws,                  &  !< factor for qsws
-                  f_qsws_veg,              &  !< factor for qsws_veg
-                  f_qsws_liq,              &  !< factor for qsws_liq
-                  f1,                      &  !< resistance correction term 1
-                  f2,                      &  !< resistance correction term 2
-                  f3,                      &  !< resistance correction term 3
-                  m_max_depth = 0.0002_wp, &  !< Maximum capacity of the water reservoir (m)
-                  m_liq_max,               &  !< maxmimum value of the liq. water reservoir
-                  qv1,                     &  !< specific humidity at first grid level
-                  q_s,                     &  !< saturation specific humidity
-                  rho_lv,                  &  !< frequently used parameter for green layers
-                  tend,                    &  !< tendency
-                  ueff                        !< limited near-surface wind speed - used for calculation of resistance
-
-    TYPE(surf_type),        POINTER ::  surf              !< surface-date type variable
-    TYPE(surf_type_1d_usm), POINTER ::  t_surf_green      !<
-    TYPE(surf_type_1d_usm), POINTER ::  t_surf_green_p    !<
-    TYPE(surf_type_1d_usm), POINTER ::  t_surf_wall       !<
-    TYPE(surf_type_1d_usm), POINTER ::  t_surf_wall_p     !<
-    TYPE(surf_type_1d_usm), POINTER ::  t_surf_window     !<
-    TYPE(surf_type_1d_usm), POINTER ::  t_surf_window_p   !<
-    TYPE(surf_type_2d_usm), POINTER ::  t_green           !<
-    TYPE(surf_type_2d_usm), POINTER ::  t_wall            !<
-    TYPE(surf_type_2d_usm), POINTER ::  t_window          !<
-
-    LOGICAL   ::  upward                      !< Flag indicating upward horizontal surfaces
-
-    IF ( debug_output_timestep )  THEN
-       WRITE( debug_string, * ) 'usm_surface_energy_balance:', horizontal, l, during_spinup
-       CALL debug_message( debug_string, 'start' )
-    ENDIF
-
-    upward = .FALSE.
-    IF ( horizontal )  THEN
-       surf              => surf_usm_h(l)
-       t_surf_wall       => t_surf_wall_h(l)
-       t_surf_wall_p     => t_surf_wall_h_p(l)
-       t_surf_window     => t_surf_window_h(l)
-       t_surf_window_p   => t_surf_window_h_p(l)
-       t_surf_green      => t_surf_green_h(l)
-       t_surf_green_p    => t_surf_green_h_p(l)
-       t_wall            => t_wall_h(l)
-       t_window          => t_window_h(l)
-       t_green           => t_green_h(l)
-       IF ( l == 0 ) upward = .TRUE.
-    ELSE
-       surf              => surf_usm_v(l)
-       t_surf_wall       => t_surf_wall_v(l)
-       t_surf_wall_p     => t_surf_wall_v_p(l)
-       t_surf_window     => t_surf_window_v(l)
-       t_surf_window_p   => t_surf_window_v_p(l)
-       t_surf_green      => t_surf_green_v(l)
-       t_surf_green_p    => t_surf_green_v_p(l)
-       t_wall            => t_wall_v(l)
-       t_window          => t_window_v(l)
-       t_green           => t_green_v(l)
-    ENDIF
-!
-!-- Index offset of surface element point with respect to adjoining atmospheric grid point
-    k_off = surf%koff
-    j_off = surf%joff
-    i_off = surf%ioff
-
-!
-!-- First, treat horizontal surface elements
-    !$OMP PARALLEL DO PRIVATE (m, i, j, k, frac_win, frac_wall, frac_green, lambda_surface,       &
-    !$OMP&             lambda_surface_window, lambda_surface_green, ueff, qv1, rho_cp, rho_lv,    &
-    !$OMP&             drho_l_lv, f_shf, f_shf_window, f_shf_green, m_total, f1, f2, e_s, e,      &
-    !$OMP&             f3, f_qsws_veg, q_s, f_qsws_liq, f_qsws, e_s_dt, dq_s_dt, coef_1,          &
-    !$OMP&             coef_window_1, coef_green_1, coef_2, coef_window_2, coef_green_2,          &
-    !$OMP&             stend_wall, stend_window, stend_green, tend, m_liq_max) SCHEDULE (STATIC)
-    DO  m = 1, surf%ns
-!
-!--    During spinup set green and window fraction to zero and restore at the end of the loop.
-!--    Note, this is a temporary fix and needs to be removed later.
-       IF ( during_spinup )  THEN
-          frac_win   = 0.0_wp
-          frac_wall  = 1.0_wp
-          frac_green = 0.0_wp
-       ELSE
-          frac_win   = surf%frac(m,ind_wat_win)
-          frac_wall  = surf%frac(m,ind_veg_wall)
-          frac_green = surf%frac(m,ind_pav_green)
-       ENDIF
-!
-!--    Get indices of respective grid point
-       i = surf%i(m)
-       j = surf%j(m)
-       k = surf%k(m)
-!
-!--    TODO - how to calculate lambda_surface for horizontal surfaces
-!--    (lambda_surface shoud be set according to stratification in land surface model)
-       lambda_surface        = surf%lambda_surf(m)
-       lambda_surface_window = surf%lambda_surf_window(m)
-       lambda_surface_green  = surf%lambda_surf_green(m)
-
-       IF ( humidity )  THEN
-          qv1 = q(k,j,i)
-       ELSE
-          qv1 = 0.0_wp
-       ENDIF
-!
-!--    Calculate rho * c_p coefficient at surface layer
-       rho_cp  = c_p * hyp(k) / ( r_d * surf%pt1(m) * exner(k) )
-
-       IF ( frac_green > 0.0_wp )  THEN
-!
-!--       Calculate frequently used parameters
-          rho_lv    = rho_cp / c_p * l_v
-          drho_l_lv = 1.0_wp / ( rho_l * l_v )
-       ENDIF
-
-!
-!--    Calculate aerodyamic resistance.
-       IF ( upward ) THEN
-!--       Calculation for horizontal upward facing surfaces follows LSM formulation
-!--       pt, us, ts are not available for the prognostic time step, data from the
-!--       last time step is used here.
-!--       Workaround: use single r_a as stability is only treated for the average temperature
-          surf%r_a(m)        = ( surf%pt1(m) - surf%pt_surface(m) ) /               &
-                                     ( surf%ts(m) * surf%us(m) + 1.0E-20_wp )
-       ELSE
-!--           Calculation of r_a for vertical and downward facing horizontal surfaces
-!--
-!--           Heat transfer coefficient for forced convection along vertical walls follows formulation
-!--           in TUF3d model (Krayenhoff & Voogt, 2006)
-!--
-!--           H = httc (Tsfc - Tair)
-!--           httc = rw * (11.8 + 4.2 * Ueff) - 4.0
-!--
-!--                rw: Wall patch roughness relative to 1.0 for concrete
-!--                Ueff: Effective wind speed
-!--                - 4.0 is a reduction of Rowley et al (1930) formulation based on
-!--                Cole and Sturrock (1977)
-!--
-!--                Ucan: Canyon wind speed
-!--                wstar: Convective velocity
-!--                Qs: Surface heat flux
-!--                zH: Height of the convective layer
-!--                wstar = (g/Tcan*Qs*zH)**(1./3.)
-!--           Effective velocity components must always be defined at scalar grid point. The wall
-!--           normal component is obtained by simple linear interpolation. (An alternative would be an
-!--           logarithmic interpolation.) Parameter roughness_concrete (default value = 0.001) is used
-!--           to calculation of roughness relative to concrete. Note, wind velocity is limited
-!--           to avoid division by zero. The nominator can become <= 0.0 for values z0 < 3*10E-4.
-              ueff        = MAX ( SQRT( ( ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp )**2 +               &
-                                        ( ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp )**2 +               &
-                                        ( ( w(k,j,i) + w(k-1,j,i) ) * 0.5_wp )**2 ),              &
-                                  ( ( 4.0_wp + 0.1_wp )                                           &
-                                    / ( surf%z0(m) * d_roughness_concrete )                       &
-                                   - 11.8_wp ) / 4.2_wp                                           &
-                                 )
-
-              surf%r_a(m) = rho_cp / ( surf%z0(m) * d_roughness_concrete                          &
-                                     * ( 11.8_wp + 4.2_wp * ueff )  - 4.0_wp  )
-       ENDIF
-
-!--    Make sure that the resistance does not drop to zero
-!--    end does not exceed a maxmium value in case of zero velocities
-       IF ( surf%r_a(m)        < 1.0_wp )  surf%r_a(m)        = 1.0_wp
-       IF ( surf%r_a(m)        > 300.0_wp )  surf%r_a(m)        = 300.0_wp
-!
-!--    Aeorodynamical resistance for the window and green fractions are set to the same value
-       surf%r_a_window(m) = surf%r_a(m)
-       surf%r_a_green(m)  = surf%r_a(m)
-!
-!--    Factor for shf_eb
-       f_shf         = rho_cp / surf%r_a(m)
-       f_shf_window  = rho_cp / surf%r_a_window(m)
-       f_shf_green   = rho_cp / surf%r_a_green(m)
-
-       IF ( frac_green > 0.0_wp )  THEN
-!
-!--       Adapted from LSM:
-!--       Second step: calculate canopy resistance r_canopy. f1-f3 here are defined as 1/f1-f3
-!--       as in ECMWF documentation
-
-!--       f1: Correction for incoming shortwave radiation (stomata close at night)
-          f1 = MIN( 1.0_wp, ( 0.004_wp * surf%rad_sw_in(m) + 0.05_wp ) /                          &
-                    (0.81_wp * ( 0.004_wp * surf%rad_sw_in(m) + 1.0_wp ) ) )
-!
-!--       f2: Correction for soil moisture availability to plants (the integrated soil moisture must
-!--       thus be considered here) f2 = 0 for very dry soils
-          IF ( upward ) THEN
-             m_total = 0.0_wp
-             DO  k = nzb_wall, nzt_wall+1
-                 m_total = m_total + rootfr_h(l)%val(nzb_wall,m) &
-                                     * MAX( swc_h(l)%val(nzb_wall,m),wilt_h(l)%val(nzb_wall,m) )
-             ENDDO
-
-             IF ( m_total > wilt_h(l)%val(nzb_wall,m)  .AND.  m_total < fc_h(l)%val(nzb_wall,m) )  THEN
-                f2 = ( m_total - wilt_h(l)%val(nzb_wall,m) ) / (fc_h(l)%val(nzb_wall,m) - wilt_h(l)%val(nzb_wall,m) )
-             ELSEIF ( m_total >= fc_h(l)%val(nzb_wall,m) )  THEN
-                f2 = 1.0_wp
-             ELSE
-                f2 = 1.0E-20_wp
-             ENDIF
-          ELSE
-             f2=1.0_wp
-          ENDIF
-!
-!--       Calculate water vapour pressure at saturation
-          e_s = 0.01_wp * magnus_tl( t_surf_green%val(m) )
-!
-!--       f3: Correction for vapour pressure deficit
-          IF ( surf%g_d(m) /= 0.0_wp )  THEN
-!--          Calculate vapour pressure
-             e  = qv1 * surface_pressure / ( qv1 + 0.622_wp )
-             f3 = EXP ( - surf%g_d(m) * (e_s - e) )
-          ELSE
-             f3 = 1.0_wp
-          ENDIF
-!
-!--       Calculate canopy resistance. In case that c_veg is 0 (bare soils), this calculation is
-!--       obsolete, as r_canopy is not used below.
-!--       To do: check for very dry soil -> r_canopy goes to infinity
-          surf%r_canopy(m) = surf%r_canopy_min(m) /                                               &
-                                  ( surf%lai(m) * f1 * f2 * f3 + 1.0E-20_wp )
-!
-!--       Calculate saturation specific humidity
-          q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
-!
-!--       In case of dewfall, set evapotranspiration to zero
-!--       All super-saturated water is then removed from the air
-          IF ( humidity  .AND.  q_s <= qv1 )  THEN
-             surf%r_canopy(m) = 0.0_wp
-          ENDIF
-
-          IF ( upward ) THEN
-!--          Calculate the maximum possible liquid water amount on plants and bare surface. For
-!--          vegetated surfaces, a maximum depth of 0.2 mm is assumed, while paved surfaces might hold
-!--          up 1 mm of water. The liquid water fraction for paved surfaces is calculated after
-!--          Noilhan & Planton (1989), while the ECMWF formulation is used for vegetated surfaces and
-!--          bare soils.
-             m_liq_max = m_max_depth * ( surf%lai(m) )
-             surf%c_liq(m) = MIN( 1.0_wp, ( m_liq_usm_h(l)%val(m) / m_liq_max )**0.67 )
-
-!
-!--          Calculate coefficients for the total evapotranspiration
-!--          In case of water surface, set vegetation and soil fluxes to zero.
-!--          For pavements, only evaporation of liquid water is possible.
-             f_qsws_veg  = rho_lv * ( 1.0_wp - surf%c_liq(m) ) /                                  &
-                           ( surf%r_a_green(m) + surf%r_canopy(m) )
-             f_qsws_liq  = rho_lv * surf%c_liq(m) / surf%r_a_green(m)
-             f_qsws = f_qsws_veg + f_qsws_liq
-          ELSE
-             f_qsws_veg  = rho_lv * ( 1.0_wp - 0.0_wp ) / & !surf%c_liq(m) ) /                    &
-                                ( surf%r_a_green(m) + surf%r_canopy(m) )
-             f_qsws_liq  = 0._wp ! rho_lv * surf%c_liq(m) / surf%r_a_green(m)
-             f_qsws = f_qsws_veg + f_qsws_liq
-          ENDIF
-!
-!--       Calculate derivative of q_s for Taylor series expansion
-          e_s_dt = e_s * ( 17.269_wp / ( t_surf_green%val(m) - 35.86_wp ) - 17.269_wp             &
-                   * ( t_surf_green%val(m) - degc_to_k )                                          &
-                   / ( t_surf_green%val(m) - 35.86_wp )**2 )
-          dq_s_dt = 0.622_wp * e_s_dt / ( surface_pressure - e_s_dt )
-       ENDIF
-!
-!--    Add LW up so that it can be removed in prognostic equation
-       surf%rad_net_l(m) = surf%rad_sw_in(m)  - surf%rad_sw_out(m) +                              &
-                           surf%rad_lw_in(m)  - surf%rad_lw_out(m)
-!
-!--    Numerator of the prognostic equation
-!--    Todo: Adjust to tile approach. So far, emissivity for wall (element 0) is used
-!--    Rem: Coef +1 corresponds to -lwout included in calculation of radnet_l
-       coef_1 = surf%rad_net_l(m) + ( 3.0_wp + 1.0_wp )                                           &
-               * surf%emissivity(m,ind_veg_wall) * sigma_sb * t_surf_wall%val(m)**4               &
-               + f_shf * surf%pt1(m) + lambda_surface * t_wall%val(nzb_wall,m)
-
-       IF ( ( .NOT. during_spinup ) .AND. (frac_win > 0.0_wp ) )  THEN
-          coef_window_1 = surf%rad_net_l(m) +  ( 3.0_wp + 1.0_wp )                                &
-                          * surf%emissivity(m,ind_wat_win) * sigma_sb                             &
-                          * t_surf_window%val(m)**4 + f_shf_window * surf%pt1(m)                  &
-                          + lambda_surface_window * t_window%val(nzb_wall,m)
-       ENDIF
-       IF ( ( humidity ) .AND. ( frac_green > 0.0_wp ) )  THEN
-          coef_green_1 = surf%rad_net_l(m) + ( 3.0_wp + 1.0_wp )                                  &
-                         * surf%emissivity(m,ind_pav_green) * sigma_sb                            &
-                         * t_surf_green%val(m)**4 + f_shf_green * surf%pt1(m)                     &
-                         + f_qsws * ( qv1 - q_s + dq_s_dt * t_surf_green%val(m) )                 &
-                         + lambda_surface_green * t_green%val(nzb_wall,m)
-       ELSE
-          coef_green_1 = surf%rad_net_l(m) + ( 3.0_wp + 1.0_wp )                                  &
-                         * surf%emissivity(m,ind_pav_green) * sigma_sb * t_surf_green%val(m)**4   &
-                         + f_shf_green * surf%pt1(m) + lambda_surface_green                       &
-                         * t_green%val(nzb_wall,m)
-       ENDIF
-!
-!--    Denominator of the prognostic equation
-       coef_2 = 4.0_wp * surf%emissivity(m,ind_veg_wall) * sigma_sb * t_surf_wall%val(m)**3       &
-                + lambda_surface + f_shf / exner(k)
-       IF ( ( .NOT. during_spinup ) .AND. ( frac_win > 0.0_wp ) )  THEN
-          coef_window_2 = 4.0_wp * surf%emissivity(m,ind_wat_win) * sigma_sb *                    &
-                          t_surf_window%val(m)**3 + lambda_surface_window + f_shf_window / exner(k)
-       ENDIF
-       IF ( ( humidity ) .AND. ( frac_green > 0.0_wp ) )  THEN
-          coef_green_2 = 4.0_wp * surf%emissivity(m,ind_pav_green) * sigma_sb *                   &
-                         t_surf_green%val(m)**3 + f_qsws * dq_s_dt + lambda_surface_green         &
-                         + f_shf_green / exner(k)
-       ELSE
-          coef_green_2 = 4.0_wp * surf%emissivity(m,ind_pav_green) * sigma_sb                     &
-                         * t_surf_green%val(m)**3 + lambda_surface_green + f_shf_green / exner(k)
-       ENDIF
-!
-!--    Implicit solution when the surface layer has no heat capacity, otherwise use RK3 scheme.
-       t_surf_wall_p%val(m) = ( coef_1 * dt_3d * tsc(2) + surf%c_surface(m)                       &
-                            * t_surf_wall%val(m) )                                                &
-                            / ( surf%c_surface(m) + coef_2 * dt_3d * tsc(2) )
-       IF ( ( .NOT. during_spinup ) .AND. (frac_win > 0.0_wp) )  THEN
-          t_surf_window_p%val(m) = ( coef_window_1 * dt_3d * tsc(2) +                             &
-                                   surf%c_surface_window(m) * t_surf_window%val(m) ) /            &
-                                ( surf%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) )
-       ENDIF
-       t_surf_green_p%val(m) = ( coef_green_1 * dt_3d * tsc(2) +                                  &
-                               surf%c_surface_green(m) * t_surf_green%val(m) )                    &
-                             / ( surf%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) )
-!
-!--    Add RK3 term
-       t_surf_wall_p%val(m) = t_surf_wall_p%val(m) + dt_3d * tsc(3) *                             &
-                            surf%tt_surface_wall_m(m)
-       t_surf_window_p%val(m) = t_surf_window_p%val(m) + dt_3d * tsc(3) *                         &
-                              surf%tt_surface_window_m(m)
-       t_surf_green_p%val(m) = t_surf_green_p%val(m) + dt_3d * tsc(3) *                           &
-                             surf%tt_surface_green_m(m)
-!
-!--    Store surface temperature on pt_surface. Further, in case humidity is used, store also
-!--    vpt_surface, which is, due to the lack of moisture on roofs, simply assumed to be the surface
-!--    temperature.
-       surf%pt_surface(m) = ( frac_wall * t_surf_wall_p%val(m)                                    &
-                                 + frac_win * t_surf_window_p%val(m)                              &
-                                 + frac_green * t_surf_green_p%val(m)                             &
-                             ) / exner(k)
-
-       IF ( humidity )  surf%vpt_surface(m) = surf%pt_surface(m)
-!
-!--    Calculate true tendency
-       stend_wall = ( t_surf_wall_p%val(m) - t_surf_wall%val(m) - dt_3d * tsc(3) *                &
-                      surf%tt_surface_wall_m(m) ) / ( dt_3d  * tsc(2) )
-       stend_window = ( t_surf_window_p%val(m) - t_surf_window%val(m) - dt_3d * tsc(3) *          &
-                        surf%tt_surface_window_m(m) ) / ( dt_3d  * tsc(2) )
-       stend_green = ( t_surf_green_p%val(m) - t_surf_green%val(m) - dt_3d * tsc(3) *             &
-                       surf%tt_surface_green_m(m) ) / ( dt_3d  * tsc(2) )
-!
-!--    Calculate t_surf tendencies for the next Runge-Kutta step
-       IF ( timestep_scheme(1:5) == 'runge' )  THEN
-          IF ( intermediate_timestep_count == 1 )  THEN
-             surf%tt_surface_wall_m(m)   = stend_wall
-             surf%tt_surface_window_m(m) = stend_window
-             surf%tt_surface_green_m(m)  = stend_green
-          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-             surf%tt_surface_wall_m(m) = -9.5625_wp * stend_wall +                                &
-                                               5.3125_wp * surf%tt_surface_wall_m(m)
-             surf%tt_surface_window_m(m) = -9.5625_wp * stend_window +                            &
-                                                 5.3125_wp * surf%tt_surface_window_m(m)
-             surf%tt_surface_green_m(m) = -9.5625_wp * stend_green +                              &
-                                                5.3125_wp * surf%tt_surface_green_m(m)
-          ENDIF
-       ENDIF
-!
-!--    In case of fast changes in the skin temperature, it is required to update the radiative
-!--    fluxes in order to keep the solution stable
-       IF ( ( ( ABS( t_surf_wall_p%val(m)   - t_surf_wall%val(m) )   > 1.0_wp )   .OR.            &
-            (   ABS( t_surf_green_p%val(m)  - t_surf_green%val(m) )  > 1.0_wp )   .OR.            &
-            (   ABS( t_surf_window_p%val(m) - t_surf_window%val(m) ) > 1.0_wp ) )                 &
-               .AND.  unscheduled_radiation_calls  )  THEN
-          force_radiation_call_l = .TRUE.
-       ENDIF
-!
-!--    Calculate new fluxes
-!--    Rad_net_l is never used!
-       surf%rad_net_l(m) = surf%rad_net_l(m) + frac_wall                                          &
-                                 * sigma_sb * surf%emissivity(m,ind_veg_wall)                     &
-                                 * ( t_surf_wall_p%val(m)**4 - t_surf_wall%val(m)**4 )            &
-                                 + frac_win * sigma_sb                                            &
-                                 * surf%emissivity(m,ind_wat_win)                                 &
-                                 * ( t_surf_window_p%val(m)**4 - t_surf_window%val(m)**4 )        &
-                                 + frac_green * sigma_sb                                          &
-                                 * surf%emissivity(m,ind_pav_green)                               &
-                                 * ( t_surf_green_p%val(m)**4 - t_surf_green%val(m)**4 )
-
-       surf%wghf_eb(m)   = lambda_surface * ( t_surf_wall_p%val(m) - t_wall%val(nzb_wall,m) )
-       surf%wghf_eb_green(m)  = lambda_surface_green                                              &
-                                      * ( t_surf_green_p%val(m) - t_green%val(nzb_wall,m) )
-       surf%wghf_eb_window(m) = lambda_surface_window                                             &
-                                      * ( t_surf_window_p%val(m) - t_window%val(nzb_wall,m) )
-
-!
-!--    Ground/wall/roof surface heat flux
-       surf%wshf_eb(m)   = - f_shf  * ( surf%pt1(m) - t_surf_wall_p%val(m) / exner(k) )           &
-                                 * frac_wall - f_shf_window                                       &
-                                 * ( surf%pt1(m) - t_surf_window_p%val(m) / exner(k) )            &
-                                 * frac_win - f_shf_green                                         &
-                                 * ( surf%pt1(m) - t_surf_green_p%val(m) / exner(k) )             &
-                                 * frac_green
-!
-!--    Store kinematic surface heat fluxes for utilization in other processes diffusion_s,
-!--    surface_layer_fluxes,...
-       surf%shf(m) = surf%wshf_eb(m) / c_p
-!
-!--    If the indoor model is applied, further add waste heat from buildings to the kinematic flux.
-       IF ( indoor_model )  THEN
-          surf%shf(m) = surf%shf(m) + surf%waste_heat(m) / c_p
-       ENDIF
-
-       IF ( humidity .AND.  frac_green > 0.0_wp )  THEN!
-!--       Calculate true surface resistance
-          IF ( upward ) THEN
-             surf%qsws(m)  = - f_qsws * ( qv1 - q_s + dq_s_dt * t_surf_green%val(m)               &
-                                                - dq_s_dt * t_surf_green_p%val(m) )
-             surf%qsws(m) = surf%qsws(m) / l_v
-             surf%qsws_veg(m)  = - f_qsws_veg  * ( qv1 - q_s + dq_s_dt * t_surf_green%val(m)      &
-                                                         - dq_s_dt * t_surf_green_p%val(m) )
-             surf%qsws_liq(m)  = - f_qsws_liq  * ( qv1 - q_s + dq_s_dt * t_surf_green%val(m)      &
-                                                         - dq_s_dt * t_surf_green_p%val(m) )
-             surf%r_s(m) = - rho_lv * ( qv1 - q_s + dq_s_dt * t_surf_green%val(m)                 &
-                                 - dq_s_dt * t_surf_green_p%val(m) ) /                            &
-                                 (surf%qsws(m) + 1.0E-20) - surf%r_a_green(m)
-             IF ( precipitation )  THEN
-!--             Calculate change in liquid water reservoir due to dew fall or evaporation of liquid water
-!--             If precipitation is activated, add rain water to qsws_liq and qsws_soil according the
-!--             the vegetation coverage. Precipitation_rate is given in mm.
-!--             Add precipitation to liquid water reservoir, if possible. Otherwise, add the water
-!--             to soil. In case of pavements, the exceeding water amount is implicitely removed as
-!--             runoff as qsws_soil is then not used in the soil model
-                IF ( m_liq_usm_h(l)%val(m) /= m_liq_max )  THEN
-                   surf%qsws_liq(m) = surf%qsws_liq(m)                                            &
-                                            + frac_green                                          &
-                                            * prr(k+k_off,j+j_off,i+i_off) * hyrho(k+k_off)       &
-                                            * 0.001_wp * rho_l * l_v
-                ENDIF
-             ENDIF
-!
-!--          If the air is saturated, check the reservoir water level
-             IF ( surf%qsws(m) < 0.0_wp )  THEN
-!
-!--                Check if reservoir is full (avoid values > m_liq_max) In that case, qsws_liq goes to
-!--                qsws_soil. In this case qsws_veg is zero anyway (because c_liq = 1), so that tend is
-!--                zero and no further check is needed
-                IF ( m_liq_usm_h(l)%val(m) == m_liq_max )  THEN
-                   surf%qsws_liq(m)  = 0.0_wp
-                ENDIF
-!--                In case qsws_veg becomes negative (unphysical behavior), let the water enter the
-!--                liquid water reservoir as dew on the plant
-                IF ( surf%qsws_veg(m) < 0.0_wp )  THEN
-                   surf%qsws_liq(m) = surf%qsws_liq(m) + surf%qsws_veg(m)
-                   surf%qsws_veg(m) = 0.0_wp
-                ENDIF
-             ENDIF
-
-             tend = - surf%qsws_liq(m) * drho_l_lv
-             m_liq_usm_h_p(l)%val(m) = m_liq_usm_h(l)%val(m) + dt_3d *                            &
-                                       ( tsc(2) * tend + tsc(3) * tm_liq_usm_h_m(l)%val(m) )
-!
-!--             Check if reservoir is overfull -> reduce to maximum
-!--             (conservation of water is violated here)
-             m_liq_usm_h_p(l)%val(m) = MIN( m_liq_usm_h_p(l)%val(m), m_liq_max )
-!
-!--             Check if reservoir is empty (avoid values < 0.0) (conservation of water is violated here)
-             m_liq_usm_h_p(l)%val(m) = MAX( m_liq_usm_h_p(l)%val(m), 0.0_wp )
-!
-!--             Calculate m_liq tendencies for the next Runge-Kutta step
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( intermediate_timestep_count == 1 )  THEN
-                   tm_liq_usm_h_m(l)%val(m) = tend
-                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
-                   tm_liq_usm_h_m(l)%val(m) = -9.5625_wp * tend +                                 &
-                                                  5.3125_wp * tm_liq_usm_h_m(l)%val(m)
-                ENDIF
-             ENDIF
-          ELSE
-!--          Downward and vertical surfaces
-             surf%qsws(m)  = - f_qsws * ( qv1 - q_s + dq_s_dt * t_surf_green%val(m)               &
-                                                   - dq_s_dt * t_surf_green_p%val(m) )
-             surf%qsws(m) = surf%qsws(m) / l_v
-             surf%qsws_veg(m)  = - f_qsws_veg  * ( qv1 - q_s + dq_s_dt * t_surf_green%val(m)      &
-                                                   - dq_s_dt * t_surf_green_p%val(m) )
-             surf%r_s(m) = - rho_lv * ( qv1 - q_s + dq_s_dt * t_surf_green%val(m)                 &
-                                                  - dq_s_dt * t_surf_green_p%val(m) ) /           &
-                                                   (surf%qsws(m) + 1.0E-20)  - surf%r_a_green(m)
-             surf%qsws_liq(m) = 0._wp  ! - f_qsws_liq  * ( qv1 - q_s + dq_s_dt * t_surf_green_h(m)&
-!                                                  - dq_s_dt * t_surf_green_h_p(m) )
-!--          If the air is saturated, check the reservoir water level
-             IF ( surf%qsws(m) < 0.0_wp )  THEN
-!--             In case qsws_veg becomes negative (unphysical behavior), let the water enter the
-!--             liquid water reservoir as dew on the plant
-                IF ( surf%qsws_veg(m) < 0.0_wp )  THEN
-                   surf%qsws_veg(m) = 0.0_wp
-                ENDIF
-             ENDIF
-          ENDIF
-       ELSE
-          surf%r_s(m) = 1.0E10_wp
-       ENDIF
-
-    ENDDO
-
-!
-!-- pt and shf are defined on nxlg:nxrg,nysg:nyng .Get the borders from neighbours.
-    CALL exchange_horiz( pt, nbgp )
-!
-!-- Calculation of force_radiation_call:
-!-- Make logical OR for all processes.
-!-- Force radiation call if at least one processor forces it.
-    IF ( intermediate_timestep_count == intermediate_timestep_count_max-1 )  THEN
-#if defined( __parallel )
-       IF ( .NOT. force_radiation_call ) THEN
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_ALLREDUCE( force_radiation_call_l, force_radiation_call,                       &
-                              1, MPI_LOGICAL, MPI_LOR, comm2d, ierr )
-       ENDIF
-#else
-       force_radiation_call = force_radiation_call .OR. force_radiation_call_l
-#endif
-       force_radiation_call_l = .FALSE.
-    ENDIF
-
-    IF ( debug_output_timestep )  THEN
-       WRITE( debug_string, * ) 'usm_surface_energy_balance: ', horizontal, l, during_spinup
-       CALL debug_message( debug_string, 'end' )
-    ENDIF
-
- END SUBROUTINE usm_surface_energy_balance
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Swapping of time levels for t_surf and t_wall called out from subroutine swap_timelevel
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_swap_timelevel( mod_count )
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN)  ::  mod_count  !<
-
-
-    SELECT CASE ( mod_count )
-
-       CASE ( 0 )
-!
-!--      Horizontal surfaces
-          t_surf_wall_h    => t_surf_wall_h_1;   t_surf_wall_h_p    => t_surf_wall_h_2
-          t_wall_h         => t_wall_h_1;        t_wall_h_p         => t_wall_h_2
-          t_surf_window_h  => t_surf_window_h_1; t_surf_window_h_p  => t_surf_window_h_2
-          t_window_h       => t_window_h_1;      t_window_h_p       => t_window_h_2
-          t_surf_green_h   => t_surf_green_h_1;  t_surf_green_h_p   => t_surf_green_h_2
-          t_green_h        => t_green_h_1;       t_green_h_p        => t_green_h_2
-!
-!--      Vertical surfaces
-          t_surf_wall_v    => t_surf_wall_v_1;   t_surf_wall_v_p    => t_surf_wall_v_2
-          t_wall_v         => t_wall_v_1;        t_wall_v_p         => t_wall_v_2
-          t_surf_window_v  => t_surf_window_v_1; t_surf_window_v_p  => t_surf_window_v_2
-          t_window_v       => t_window_v_1;      t_window_v_p       => t_window_v_2
-          t_surf_green_v   => t_surf_green_v_1;  t_surf_green_v_p   => t_surf_green_v_2
-          t_green_v        => t_green_v_1;       t_green_v_p        => t_green_v_2
-       CASE ( 1 )
-!
-!--      Horizontal surfaces
-          t_surf_wall_h    => t_surf_wall_h_2;   t_surf_wall_h_p    => t_surf_wall_h_1
-          t_wall_h         => t_wall_h_2;        t_wall_h_p         => t_wall_h_1
-          t_surf_window_h  => t_surf_window_h_2; t_surf_window_h_p  => t_surf_window_h_1
-          t_window_h       => t_window_h_2;      t_window_h_p       => t_window_h_1
-          t_surf_green_h   => t_surf_green_h_2;  t_surf_green_h_p   => t_surf_green_h_1
-          t_green_h        => t_green_h_2;       t_green_h_p        => t_green_h_1
-!
-!--      Vertical surfaces
-          t_surf_wall_v    => t_surf_wall_v_2;   t_surf_wall_v_p    => t_surf_wall_v_1
-          t_wall_v         => t_wall_v_2;        t_wall_v_p         => t_wall_v_1
-          t_surf_window_v  => t_surf_window_v_2; t_surf_window_v_p  => t_surf_window_v_1
-          t_window_v       => t_window_v_2;      t_window_v_p       => t_window_v_1
-          t_surf_green_v   => t_surf_green_v_2;  t_surf_green_v_p   => t_surf_green_v_1
-          t_green_v        => t_green_v_2;       t_green_v_p        => t_green_v_1
-    END SELECT
-
- END SUBROUTINE usm_swap_timelevel
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine writes t_surf and t_wall data into restart files
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_wrd_local
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=1)  ::  dum  !< dummy string to create output-variable name
-
-    INTEGER(iwp)  ::  l  !< index surface type orientation
-
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_end_index    !< end index for surface data (MPI-IO)
-    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_start_index  !< start index for surface data (MPI-IO)
-
-    LOGICAL  ::  surface_data_to_write  !< switch for MPI-I/O if PE has surface data to write
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL wrd_write_string( 'ns_h_on_file_usm' )
-       WRITE ( 14 )  surf_usm_h(0:1)%ns
-
-       CALL wrd_write_string( 'ns_v_on_file_usm' )
-       WRITE ( 14 )  surf_usm_v(0:3)%ns
-
-       DO  l = 0, 1
-
-          CALL wrd_write_string( 'usm_start_index_h' )
-          WRITE ( 14 )  surf_usm_h(l)%start_index
-
-          CALL wrd_write_string( 'usm_end_index_h' )
-          WRITE ( 14 )  surf_usm_h(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-
-          CALL wrd_write_string( 't_surf_wall_h(' // dum // ')' )
-          WRITE ( 14 )  t_surf_wall_h(l)%val
-
-          CALL wrd_write_string( 't_surf_window_h(' // dum // ')' )
-          WRITE ( 14 )  t_surf_window_h(l)%val
-
-          CALL wrd_write_string( 't_surf_green_h(' // dum // ')' )
-          WRITE ( 14 )  t_surf_green_h(l)%val
-
-          CALL wrd_write_string( 'm_liq_usm_h(' // dum // ')' )
-          WRITE ( 14 )  m_liq_usm_h(l)%val
-!
-!--       Write restart data which is especially needed for the urban-surface model. In order to do not
-!--       fill up the restart routines in surface_mod. Output of waste heat from indoor model. Restart
-!--       data is required in this special case, because the indoor model, where waste heat is
-!--       computed, is called each hour (current default), so that waste heat would have zero value
-!--       until next call of indoor model.
-          IF ( indoor_model )  THEN
-             CALL wrd_write_string( 'waste_heat_h(' // dum // ')' )
-             WRITE ( 14 )  surf_usm_h(l)%waste_heat
-             CALL wrd_write_string( 't_prev_h(' // dum // ')' )
-             WRITE ( 14 )  surf_usm_h(l)%t_prev
-          ENDIF
-       ENDDO
-
-       DO  l = 0, 3
-
-          CALL wrd_write_string( 'usm_start_index_v' )
-          WRITE ( 14 )  surf_usm_v(l)%start_index
-
-          CALL wrd_write_string( 'usm_end_index_v' )
-          WRITE ( 14 )  surf_usm_v(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-
-          CALL wrd_write_string( 't_surf_wall_v(' // dum // ')' )
-          WRITE ( 14 )  t_surf_wall_v(l)%val
-
-          CALL wrd_write_string( 't_surf_window_v(' // dum // ')' )
-          WRITE ( 14 ) t_surf_window_v(l)%val
-
-          CALL wrd_write_string( 't_surf_green_v(' // dum // ')' )
-          WRITE ( 14 ) t_surf_green_v(l)%val
-
-          IF ( indoor_model )  THEN
-             CALL wrd_write_string( 'waste_heat_v(' // dum // ')' )
-             WRITE ( 14 )  surf_usm_v(l)%waste_heat
-             CALL wrd_write_string( 't_prev_v(' // dum // ')' )
-             WRITE ( 14 )  surf_usm_v(l)%t_prev
-          ENDIF
-
-       ENDDO
-
-       DO  l = 0, 1
-
-          CALL wrd_write_string( 'usm_start_index_h' )
-          WRITE ( 14 )  surf_usm_h(l)%start_index
-
-          CALL wrd_write_string( 'usm_end_index_h' )
-          WRITE ( 14 )  surf_usm_h(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-
-          CALL wrd_write_string( 't_wall_h(' // dum // ')' )
-          WRITE ( 14 )  t_wall_h(l)%val
-
-          CALL wrd_write_string( 't_window_h(' // dum // ')' )
-          WRITE ( 14 )  t_window_h(l)%val
-
-          CALL wrd_write_string( 't_green_h(' // dum // ')' )
-          WRITE ( 14 )  t_green_h(l)%val
-
-       ENDDO
-
-       DO  l = 0, 3
-
-          CALL wrd_write_string( 'usm_start_index_v' )
-          WRITE ( 14 )  surf_usm_v(l)%start_index
-
-          CALL wrd_write_string( 'usm_end_index_v' )
-          WRITE ( 14 )  surf_usm_v(l)%end_index
-
-          WRITE( dum, '(I1)')  l
-
-          CALL wrd_write_string( 't_wall_v(' // dum // ')' )
-          WRITE ( 14 )  t_wall_v(l)%val
-
-          CALL wrd_write_string( 't_window_v(' // dum // ')' )
-          WRITE ( 14 )  t_window_v(l)%val
-
-          CALL wrd_write_string( 't_green_v(' // dum // ')' )
-          WRITE ( 14 )  t_green_v(l)%val
-
-       ENDDO
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-!
-!--    There is no information about the PE-grid necessary because the restart files consists of the
-!--    whole domain. Therefore, ns_h_on_file_usm and ns_v_on_file_usm are not used with MPI-IO.
-       DO  l = 0, 1
-
-          WRITE( dum, '(I1)')  l
-
-          CALL rd_mpi_io_surface_filetypes( surf_usm_h(l)%start_index, surf_usm_h(l)%end_index,    &
-                                            surface_data_to_write, global_start_index,             &
-                                            global_end_index )
-
-          CALL wrd_mpi_io( 'usm_global_start_h_' // dum, global_start_index )
-          CALL wrd_mpi_io( 'usm_global_end_h_' // dum, global_end_index )
-
-          IF ( .NOT. surface_data_to_write )  CYCLE
-
-          CALL wrd_mpi_io_surface( 't_surf_wall_h(' // dum // ')',  t_surf_wall_h(l)%val )
-          CALL wrd_mpi_io_surface( 't_surf_window_h(' // dum // ')', t_surf_window_h(l)%val )
-          CALL wrd_mpi_io_surface( 't_surf_green_h(' // dum // ')', t_surf_green_h(l)%val )
-
-          CALL wrd_mpi_io_surface( 'm_liq_usm_h(' // dum // ')', m_liq_usm_h(l)%val )
-          IF ( indoor_model )  THEN
-             CALL wrd_mpi_io_surface( 'waste_heat_h(' // dum // ')', surf_usm_h(l)%waste_heat )
-             CALL wrd_mpi_io_surface( 't_prev_h(' // dum // ')',     surf_usm_h(l)%t_prev     )
-          ENDIF
-
-       ENDDO
-
-       DO  l = 0, 3
-
-          WRITE( dum, '(I1)')  l
-
-          CALL rd_mpi_io_surface_filetypes( surf_usm_v(l)%start_index, surf_usm_v(l)%end_index,    &
-                                            surface_data_to_write, global_start_index,             &
-                                            global_end_index )
-
-          CALL wrd_mpi_io( 'usm_global_start_v_' // dum, global_start_index )
-          CALL wrd_mpi_io( 'usm_global_end_v_' // dum,   global_end_index )
-
-          IF ( .NOT. surface_data_to_write )  CYCLE
-
-          CALL wrd_mpi_io_surface( 't_surf_wall_v(' // dum // ')', t_surf_wall_v(l)%val )
-          CALL wrd_mpi_io_surface( 't_surf_window_v(' // dum // ')', t_surf_window_v(l)%val )
-          CALL wrd_mpi_io_surface( 't_surf_green_v(' // dum // ')', t_surf_green_v(l)%val )
-
-          IF ( indoor_model )  THEN
-             CALL wrd_mpi_io_surface( 'waste_heat_v(' // dum // ')', surf_usm_v(l)%waste_heat )
-             CALL wrd_mpi_io_surface( 't_prev_v(' // dum // ')',     surf_usm_v(l)%t_prev     )
-          ENDIF
-       ENDDO
-
-       DO  l = 0, 1
-
-          WRITE( dum, '(I1)')  l
-
-          CALL rd_mpi_io_surface_filetypes( surf_usm_h(l)%start_index, surf_usm_h(l)%end_index,    &
-                                            surface_data_to_write, global_start_index,             &
-                                            global_end_index )
-
-          CALL wrd_mpi_io( 'usm_global_start_h_2_' // dum, global_start_index )
-          CALL wrd_mpi_io( 'usm_global_end_h_2_' // dum, global_end_index )
-
-          IF ( .NOT. surface_data_to_write )  CYCLE
-
-          CALL wrd_mpi_io_surface( 't_wall_h(' // dum // ')', t_wall_h(l)%val )
-          CALL wrd_mpi_io_surface( 't_window_h(' // dum // ')', t_window_h(l)%val )
-          CALL wrd_mpi_io_surface( 't_green_h(' // dum // ')', t_green_h(l)%val )
-
-       ENDDO
-
-       DO  l = 0, 3
-
-          WRITE( dum, '(I1)')  l
-
-          CALL rd_mpi_io_surface_filetypes( surf_usm_v(l)%start_index, surf_usm_v(l)%end_index,    &
-                                            surface_data_to_write, global_start_index,             &
-                                            global_end_index )
-
-          CALL wrd_mpi_io( 'usm_global_start_v_2_' // dum, global_start_index )
-          CALL wrd_mpi_io( 'usm_global_end_v_2_' // dum, global_end_index )
-
-          IF ( .NOT. surface_data_to_write )  CYCLE
-
-          CALL wrd_mpi_io_surface( 't_wall_v(' // dum // ')', t_wall_v(l)%val )
-          CALL wrd_mpi_io_surface( 't_window_v(' // dum // ')', t_window_v(l)%val )
-          CALL wrd_mpi_io_surface( 't_green_v(' // dum // ')', t_green_v(l)%val )
-
-       ENDDO
-
-    ENDIF
-
- END SUBROUTINE usm_wrd_local
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Define building properties
-!> Parameters 12, 13, 119 - 135 exclusive used in indoor_model_mod.f90
-!> Parameters 0-11, 14-118, 136 - 149 exclusive used in urban_surface_mod.f90
-!> Parameters 31, 44 used in indoor_model_mod.f90 and urban_surface_mod.f90
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE usm_define_pars
-!
-!-- Define the building_pars
-    building_pars(:,1) = (/                                                                        &
-       0.82_wp,        &  !< parameter 0   - [-] wall fraction above ground floor level
-       0.18_wp,        &  !< parameter 1   - [-] window fraction above ground floor level
-       0.0_wp,         &  !< parameter 2   - [-] green fraction above ground floor level
-       0.0_wp,         &  !< parameter 3   - [-] green fraction roof above ground floor level
-       1.5_wp,         &  !< parameter 4   - [m2/m2] LAI (Leaf Area Index) roof
-       1.5_wp,         &  !< parameter 5   - [m2/m2] LAI (Leaf Area Index) on wall above ground floor level
-       1520000.0_wp,   &  !< parameter 6   - [J/(m3*K)] heat capacity 1st wall layer (outside) above ground floor level
-       1512000.0_wp,   &  !< parameter 7   - [J/(m3*K)] heat capacity 2nd wall layer above ground floor level
-       1512000.0_wp,   &  !< parameter 8   - [J/(m3*K)] heat capacity 3rd wall layer above ground floor level
-       0.93_wp,        &  !< parameter 9   - [W/(m*K)] thermal conductivity 1st wall layer (outside) above ground floor level
-       0.81_wp,        &  !< parameter 10  - [W/(m*K)] thermal conductivity 2nd wall layer above ground floor level
-       0.81_wp,        &  !< parameter 11  - [W/(m*K)] thermal conductivity 3rd wall layer above ground floor level
-       299.15_wp,      &  !< parameter 12  - [K] indoor target summer temperature
-       293.15_wp,      &  !< parameter 13  - [K] indoor target winter temperature
-       0.93_wp,        &  !< parameter 14  - [-] wall emissivity above ground floor level
-       0.86_wp,        &  !< parameter 15  - [-] green emissivity above ground floor level
-       0.91_wp,        &  !< parameter 16  - [-] window emissivity above ground floor level
-       0.7_wp,         &  !< parameter 17  - [-] window transmissivity (not visual transmissivity) above ground floor level
-       0.001_wp,       &  !< parameter 18  - [m] z0 roughness above ground floor level
-       0.0001_wp,      &  !< parameter 19  - [m] z0h/z0g roughness heat/humidity above ground floor level
-       2.9_wp,         &  !< parameter 20  - [m] ground floor level height
-       0.82_wp,        &  !< parameter 21  - [-] wall fraction ground floor level
-       0.18_wp,        &  !< parameter 22  - [-] window fraction ground floor level
-       0.0_wp,         &  !< parameter 23  - [-] green fraction ground floor level
-       0.0_wp,         &  !< parameter 24  - [-] green fraction roof ground floor level
-       1.5_wp,         &  !< parameter 25  - [m2/m2] LAI (Leaf Area Index) on wall ground floor level
-       1520000.0_wp,   &  !< parameter 26  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground floor level
-       1512000.0_wp,   &  !< parameter 27  - [J/(m3*K)] heat capacity 2nd wall layer ground floor level
-       1512000.0_wp,   &  !< parameter 28  - [J/(m3*K)] heat capacity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 29  - [W/(m*K)] thermal conductivity 1st wall layer (outside) ground floor level
-       0.81_wp,        &  !< parameter 30  - [W/(m*K)] thermal conductivity 2nd wall layer ground floor level
-       0.81_wp,        &  !< parameter 31  - [W/(m*K)] thermal conductivity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 32  - [-] wall emissivity ground floor level
-       0.91_wp,        &  !< parameter 33  - [-] window emissivity ground floor level
-       0.86_wp,        &  !< parameter 34  - [-] green emissivity ground floor level
-       0.7_wp,         &  !< parameter 35  - [-] window transmissivity (not visual transmissivity) ground floor level
-       0.001_wp,       &  !< parameter 36  - [m] z0 roughness ground floor level
-       0.0001_wp,      &  !< parameter 37  - [m] z0h/z0q roughness heat/humidity
-       36.0_wp,        &  !< parameter 38  - [-] wall albedo_type above ground floor level  (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 39  - [-] green albedo_type above ground floor level  (albedo_type specified in radiation model)
-       37.0_wp,        &  !< parameter 40  - [-] window albedo_type above ground floor level  (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 41  - [m] 1st wall layer thickness above ground floor level
-       0.2_wp,         &  !< parameter 42  - [m] 2nd wall layer thickness above ground floor level
-       0.38_wp,        &  !< parameter 43  - [m] 3rd wall layer thickness above ground floor level
-       0.4_wp,         &  !< parameter 44  - [m] 4th wall layer thickness above ground floor level
-       20000.0_wp,     &  !< parameter 45  - [J/(m2*K)] heat capacity wall surface (1 cm air)
-       23.0_wp,        &  !< parameter 46  - [W/(m2*K)] thermal conductivity of wall surface (1 cm air)
-       20000.0_wp,     &  !< parameter 47  - [J/(m2*K)] heat capacity of window surface (1 cm air)
-       20000.0_wp,     &  !< parameter 48  - [J/(m2*K)] heat capacity of green surface
-       23.0_wp,        &  !< parameter 49  - [W/(m2*K)] thermal conductivity of window surface (1 cm air)
-       10.0_wp,        &  !< parameter 50  - [W/(m2*K)] thermal conductivty of green surface
-       1.0_wp,         &  !< parameter 51  - [-] wall fraction ground plate
-       0.18_wp,        &  !< parameter 52  - [m] 1st wall layer thickness ground plate
-       0.36_wp,        &  !< parameter 53  - [m] 2nd wall layer thickness ground plate
-       0.42_wp,        &  !< parameter 54  - [m] 3rd wall layer thickness ground plate
-       0.45_wp,        &  !< parameter 55  - [m] 4th wall layer thickness ground plate
-       1512000.0_wp,   &  !< parameter 56  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground plate
-       1512000.0_wp,   &  !< parameter 57  - [J/(m3*K)] heat capacity 2nd wall layer ground plate
-       2112000.0_wp,   &  !< parameter 58  - [J/(m3*K)] heat capacity 3rd wall layer ground plate
-       0.52_wp,        &  !< parameter 59  - [W/(m*K)] thermal conductivity 1st wall layer (oustide) ground plate
-       0.52_wp,        &  !< parameter 60  - [W/(m*K)] thermal conductivity 2nd wall layer ground plate
-       2.1_wp,         &  !< parameter 61  - [W/(m*K)] thermal conductivity 3rd wall layer ground plate
-       0.02_wp,        &  !< parameter 62  - [m] 1st wall layer thickness ground floor level
-       0.2_wp,         &  !< parameter 63  - [m] 2nd wall layer thickness ground floor level
-       0.38_wp,        &  !< parameter 64  - [m] 3rd wall layer thickness ground floor level
-       0.4_wp,         &  !< parameter 65  - [m] 4th wall layer thickness ground floor level
-       36.0_wp,        &  !< parameter 66  - [-] wall albedo_type ground floor level (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 67  - [m] 1st window layer thickness ground floor level
-       0.04_wp,        &  !< parameter 68  - [m] 2nd window layer thickness ground floor level
-       0.06_wp,        &  !< parameter 69  - [m] 3rd window layer thickness ground floor level
-       0.08_wp,        &  !< parameter 70  - [m] 4th window layer thickness ground floor level
-       1736000.0_wp,   &  !< parameter 71  - [J/(m3*K)] heat capacity 1st window layer (outside) ground floor level
-       1736000.0_wp,   &  !< parameter 72  - [J/(m3*K)] heat capacity 2nd window layer ground floor level
-       1736000.0_wp,   &  !< parameter 73  - [J/(m3*K)] heat capacity 3rd window layer ground floor level
-       0.45_wp,        &  !< parameter 74  - [W/(m*K)] thermal conductivity 1st window layer (outside) ground floor level
-       0.45_wp,        &  !< parameter 75  - [W/(m*K)] thermal conductivity 2nd window layer ground floor level
-       0.45_wp,        &  !< parameter 76  - [W/(m*K)] thermal conductivity 3rd window layer ground floor level
-       37.0_wp,        &  !< parameter 77  - [-] window albedo_type ground floor level (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 78  - [-] green albedo_type ground floor level (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 79  - [m] 1st window layer thickness above ground floor level
-       0.04_wp,        &  !< parameter 80  - [m] 2nd thickness window layer above ground floor level
-       0.06_wp,        &  !< parameter 81  - [m] 3rd window layer thickness above ground floor level
-       0.08_wp,        &  !< parameter 82  - [m] 4th window layer thickness above ground floor level
-       1736000.0_wp,   &  !< parameter 83  - [J/(m3*K)] heat capacity 1st window layer (outside) above ground floor level
-       1736000.0_wp,   &  !< parameter 84  - [J/(m3*K)] heat capacity 2nd window layer above ground floor level
-       1736000.0_wp,   &  !< parameter 85  - [J/(m3*K)] heat capacity 3rd window layer above ground floor level
-       0.45_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 1st window layer (outside) above ground floor level
-       0.45_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 2nd window layer above ground floor level
-       0.45_wp,        &  !< parameter 87  - [W/(m*K)] thermal conductivity 3rd window layer above ground floor level
-       1.0_wp,         &  !< parameter 89  - [-] wall fraction roof
-       0.02_wp,        &  !< parameter 90  - [m] 1st wall layer thickness roof
-       0.06_wp,        &  !< parameter 91  - [m] 2nd wall layer thickness roof
-       0.08_wp,        &  !< parameter 92  - [m] 3rd wall layer thickness roof
-       0.1_wp,         &  !< parameter 93  - [m] 4th wall layer thickness roof
-       1512000.0_wp,   &  !< parameter 94  - [J/(m3*K)] heat capacity 1st wall layer (outside) roof
-       709650.0_wp,    &  !< parameter 95  - [J/(m3*K)] heat capacity 2nd wall layer roof
-       709650.0_wp,    &  !< parameter 96  - [J/(m3*K)] heat capacity 3rd wall layer roof
-       0.52_wp,        &  !< parameter 97  - [W/(m*K)] thermal conductivity 1st wall layer (outside) roof
-       0.12_wp,        &  !< parameter 98  - [W/(m*K)] thermal conductivity 2nd wall layer roof
-       0.12_wp,        &  !< parameter 99  - [W/(m*K)] thermal conductivity 3rd wall layer roof
-       0.90_wp,        &  !< parameter 100 - [-] wall emissivity roof
-       42.0_wp,        &  !< parameter 101 - [-] wall albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 102 - [-] window fraction roof
-       0.02_wp,        &  !< parameter 103 - [m] window 1st layer thickness roof
-       0.04_wp,        &  !< parameter 104 - [m] window 2nd layer thickness roof
-       0.06_wp,        &  !< parameter 105 - [m] window 3rd layer thickness roof
-       0.08_wp,        &  !< parameter 106 - [m] window 4th layer thickness roof
-       1736000.0_wp,   &  !< parameter 107 - [J/(m3*K)] heat capacity 1st window layer (outside) roof
-       1736000.0_wp,   &  !< parameter 108 - [J/(m3*K)] heat capacity 2nd window layer roof
-       1736000.0_wp,   &  !< parameter 109 - [J/(m3*K)] heat capacity 3rd window layer roof
-       0.45_wp,        &  !< parameter 110 - [W/(m*K)] thermal conductivity 1st window layer (outside) roof
-       0.45_wp,        &  !< parameter 111 - [W/(m*K)] thermal conductivity 2nd window layer roof
-       0.45_wp,        &  !< parameter 112 - [W/(m*K)] thermal conductivity 3rd window layer roof
-       0.91_wp,        &  !< parameter 113 - [-] window emissivity roof
-       0.7_wp,         &  !< parameter 114 - [-] window transmissivity (not visual transmissivity) roof
-       37.0_wp,        &  !< parameter 115 - [-] window albedo_type roof (albedo_type specified in radiation model)
-       0.86_wp,        &  !< parameter 116 - [-] green emissivity roof
-       5.0_wp,         &  !< parameter 117 - [-] green albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 118 - [-] green type roof
-       0.75_wp,        &  !< parameter 119 - [-] shading factor
-       0.8_wp,         &  !< parameter 120 - [-] g-value windows
-       2.9_wp,         &  !< parameter 121 - [W/(m2*K)] u-value windows
-       0.5_wp,         &  !< parameter 122 - [1/h] basic airflow without occupancy of the room for - summer 0.5_wp, winter 0.5
-       2.0_wp,         &  !< parameter 123 - [1/h] additional airflow dependent on occupancy of the room for - summer 1.5_wp, winter 0.0
-       0.0_wp,         &  !< parameter 124 - [-] heat recovery efficiency
-       3.0_wp,         &  !< parameter 125 - [m2/m2] dynamic parameter specific effective surface
-       260000.0_wp,    &  !< parameter 126 - [J/(m2*K)] dynamic parameter innner heat storage
-       4.5_wp,         &  !< parameter 127 - [m2/m2] ratio internal surface/floor area
-       100.0_wp,       &  !< parameter 128 - [W] maximal heating capacity
-       0.0_wp,         &  !< parameter 129 - [W] maximal cooling capacity
-       0.0_wp,         &  !< parameter 130 - [W/m2] additional internal heat gains dependent on occupancy of the room
-       4.2_wp,         &  !< parameter 131 - [W/m2] basic internal heat gains without occupancy of the room
-       2.9_wp,         &  !< parameter 132 - [m] storey height
-       0.2_wp,         &  !< parameter 133 - [m] ceiling construction height
-       0.1_wp,         &  !< parameter 134 - [-] anthropogenic heat output for heating
-       1.333_wp,       &  !< parameter 135 - [-] anthropogenic heat output for cooling
-       1526000.0_wp,   &  !< parameter 136 - [J/(m3*K)] heat capacity 4th wall layer (inside) above ground floor level
-       0.7_wp,         &  !< parameter 137 - [W/(m*K)] thermal conductivity 4th wall layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 138 - [J/(m3*K)] capacity 4th wall layer (inside) ground floor level
-       0.7_wp,         &  !< parameter 139 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground floor level
-       709650.0_wp,    &  !< parameter 140 - [J/(m3*K)] heat capacity 4th wall layer (inside) ground plate
-       0.12_wp,        &  !< parameter 141 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground plate
-       1736000.0_wp,   &  !< parameter 142 - [J/(m3*K)] heat capacity 4th window layer (inside) ground floor level
-       0.45_wp,        &  !< parameter 143 - [W/(m*K)] thermal conductivity 4th window layer (inside) ground floor level
-       1736000.0_wp,   &  !< parameter 144 - [J/(m3*K)] heat capacity 4th layer (inside) above ground floor level
-       0.45_wp,        &  !< parameter 145 - [W/(m*K)] thermal conductivity 4th window layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 146 - [J/(m3*K)] heat capacity 4th wall layer (inside) roof
-       0.7_wp,         &  !< parameter 147 - [W/(m*K)] thermal conductivity 4th wall layer (inside) roof
-       1736000.0_wp,   &  !< parameter 148 - [J/(m3*K)] heat capacity 4th window layer (inside) roof
-       0.45_wp         &  !< parameter 149 - [W/(m*K)] thermal conductivity 4th window layer (inside) roof
-                        /)
-
-    building_pars(:,2) = (/                                                                        &
-       0.75_wp,        &  !< parameter 0   - [-] wall fraction above ground floor level
-       0.25_wp,        &  !< parameter 1   - [-] window fraction above ground floor level
-       0.0_wp,         &  !< parameter 2   - [-] green fraction above ground floor level
-       0.0_wp,         &  !< parameter 3   - [-] green fraction roof above ground floor level
-       1.5_wp,         &  !< parameter 4   - [m2/m2] LAI (Leaf Area Index) roof
-       1.5_wp,         &  !< parameter 5   - [m2/m2] LAI (Leaf Area Index) on wall above ground floor level
-       1520000.0_wp,   &  !< parameter 6   - [J/(m3*K)] heat capacity 1st wall layer (outside) above ground floor level
-       79200.0_wp,     &  !< parameter 7   - [J/(m3*K)] heat capacity 2nd wall layer above ground floor level
-       2112000.0_wp,   &  !< parameter 8   - [J/(m3*K)] heat capacity 3rd wall layer above ground floor level
-       0.93_wp,        &  !< parameter 9   - [W/(m*K)] thermal conductivity 1st wall layer (outside) above ground floor level
-       0.046_wp,       &  !< parameter 10  - [W/(m*K)] thermal conductivity 2nd wall layer above ground floor level
-       2.1_wp,         &  !< parameter 11  - [W/(m*K)] thermal conductivity 3rd wall layer above ground floor level
-       299.15_wp,      &  !< parameter 12  - [K] indoor target summer temperature
-       293.15_wp,      &  !< parameter 13  - [K] indoor target winter temperature
-       0.93_wp,        &  !< parameter 14  - [-] wall emissivity above ground floor level
-       0.86_wp,        &  !< parameter 15  - [-] green emissivity above ground floor level
-       0.87_wp,        &  !< parameter 16  - [-] window emissivity above ground floor level
-       0.65_wp,        &  !< parameter 17  - [-] window transmissivity (not visual transmissivity) above ground floor level
-       0.001_wp,       &  !< parameter 18  - [m] z0 roughness above ground floor level
-       0.0001_wp,      &  !< parameter 19  - [m] z0h/z0g roughness heat/humidity above ground floor level
-       2.5_wp,         &  !< parameter 20  - [m] ground floor level height
-       0.75_wp,        &  !< parameter 21  - [-] wall fraction ground floor level
-       0.25_wp,        &  !< parameter 22  - [-] window fraction ground floor level
-       0.0_wp,         &  !< parameter 23  - [-] green fraction ground floor level
-       0.0_wp,         &  !< parameter 24  - [-] green fraction roof ground floor level
-       1.5_wp,         &  !< parameter 25  - [m2/m2] LAI (Leaf Area Index) on wall ground floor level
-       1520000.0_wp,   &  !< parameter 26  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground floor level
-       79200.0_wp,     &  !< parameter 27  - [J/(m3*K)] heat capacity 2nd wall layer ground floor level
-       2112000.0_wp,   &  !< parameter 28  - [J/(m3*K)] heat capacity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 29  - [W/(m*K)] thermal conductivity 1st wall layer (outside) ground floor level
-       0.046_wp,       &  !< parameter 30  - [W/(m*K)] thermal conductivity 2nd wall layer ground floor level
-       2.1_wp,         &  !< parameter 31  - [W/(m*K)] thermal conductivity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 32  - [-] wall emissivity ground floor level
-       0.87_wp,        &  !< parameter 33  - [-] window emissivity ground floor level
-       0.86_wp,        &  !< parameter 34  - [-] green emissivity ground floor level
-       0.65_wp,        &  !< parameter 35  - [-] window transmissivity (not visual transmissivity) ground floor level
-       0.001_wp,       &  !< parameter 36  - [m] z0 roughness ground floor level
-       0.0001_wp,      &  !< parameter 37  - [m] z0h/z0q roughness heat/humidity
-       36.0_wp,        &  !< parameter 38  - [-] wall albedo_type above ground floor level  (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 39  - [-] green albedo_type above ground floor level  (albedo_type specified in radiation model)
-       37.0_wp,        &  !< parameter 40  - [-] window albedo_type above ground floor level  (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 41  - [m] 1st wall layer thickness above ground floor level
-       0.08_wp,        &  !< parameter 42  - [m] 2nd wall layer thickness above ground floor level
-       0.32_wp,        &  !< parameter 43  - [m] 3rd wall layer thickness above ground floor level
-       0.34_wp,        &  !< parameter 44  - [m] 4th wall layer thickness above ground floor level
-       20000.0_wp,     &  !< parameter 45  - [J/(m2*K)] heat capacity wall surface (1 cm air)
-       23.0_wp,        &  !< parameter 46  - [W/(m2*K)] thermal conductivity of wall surface (1 cm air)
-       20000.0_wp,     &  !< parameter 47  - [J/(m2*K)] heat capacity of window surface (1 cm air)
-       20000.0_wp,     &  !< parameter 48  - [J/(m2*K)] heat capacity of green surface
-       23.0_wp,        &  !< parameter 49  - [W/(m2*K)] thermal conductivity of window surface (1 cm air)
-       10.0_wp,        &  !< parameter 50  - [W/(m2*K)] thermal conductivty of green surface
-       1.0_wp,         &  !< parameter 51  - [-] wall fraction ground plate
-       0.20_wp,        &  !< parameter 52  - [m] 1st wall layer thickness ground plate
-       0.26_wp,        &  !< parameter 53  - [m] 2nd wall layer thickness ground plate
-       0.32_wp,        &  !< parameter 54  - [m] 3rd wall layer thickness ground plate
-       0.34_wp,        &  !< parameter 55  - [m] 4th wall layer thickness ground plate
-       2112000.0_wp,   &  !< parameter 56  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground plate
-       79200.0_wp,     &  !< parameter 57  - [J/(m3*K)] heat capacity 2nd wall layer ground plate
-       2112000.0_wp,   &  !< parameter 58  - [J/(m3*K)] heat capacity 3rd wall layer ground plate
-       2.1_wp,         &  !< parameter 59  - [W/(m*K)] thermal conductivity 1st wall layer (oustide) ground plate
-       0.05_wp,        &  !< parameter 60  - [W/(m*K)] thermal conductivity 2nd wall layer ground plate
-       2.1_wp,         &  !< parameter 61  - [W/(m*K)] thermal conductivity 3rd wall layer ground plate
-       0.02_wp,        &  !< parameter 62  - [m] 1st wall layer thickness ground floor level
-       0.08_wp,        &  !< parameter 63  - [m] 2nd wall layer thickness ground floor level
-       0.32_wp,        &  !< parameter 64  - [m] 3rd wall layer thickness ground floor level
-       0.34_wp,        &  !< parameter 65  - [m] 4th wall layer thickness ground floor level
-       36.0_wp,        &  !< parameter 66  - [-] wall albedo_type ground floor level (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 67  - [m] 1st window layer thickness ground floor level
-       0.04_wp,        &  !< parameter 68  - [m] 2nd window layer thickness ground floor level
-       0.06_wp,        &  !< parameter 69  - [m] 3rd window layer thickness ground floor level
-       0.08_wp,        &  !< parameter 70  - [m] 4th window layer thickness ground floor level
-       1736000.0_wp,   &  !< parameter 71  - [J/(m3*K)] heat capacity 1st window layer (outside) ground floor level
-       1736000.0_wp,   &  !< parameter 72  - [J/(m3*K)] heat capacity 2nd window layer ground floor level
-       1736000.0_wp,   &  !< parameter 73  - [J/(m3*K)] heat capacity 3rd window layer ground floor level
-       0.19_wp,        &  !< parameter 74  - [W/(m*K)] thermal conductivity 1st window layer (outside) ground floor level
-       0.19_wp,        &  !< parameter 75  - [W/(m*K)] thermal conductivity 2nd window layer ground floor level
-       0.19_wp,        &  !< parameter 76  - [W/(m*K)] thermal conductivity 3rd window layer ground floor level
-       37.0_wp,        &  !< parameter 77  - [-] window albedo_type ground floor level (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 78  - [-] green albedo_type ground floor level (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 79  - [m] 1st window layer thickness above ground floor level
-       0.04_wp,        &  !< parameter 80  - [m] 2nd window layer thickness above ground floor level
-       0.06_wp,        &  !< parameter 81  - [m] 3rd window layer thickness above ground floor level
-       0.08_wp,        &  !< parameter 82  - [m] 4th window layer thickness above ground floor level
-       1736000.0_wp,   &  !< parameter 83  - [J/(m3*K)] heat capacity 1st window layer (outside) above ground floor level
-       1736000.0_wp,   &  !< parameter 84  - [J/(m3*K)] heat capacity 2nd window layer above ground floor level
-       1736000.0_wp,   &  !< parameter 85  - [J/(m3*K)] heat capacity 3rd window layer above ground floor level
-       0.19_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 1st window layer (outside) above ground floor level
-       0.19_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 2nd window layer above ground floor level
-       0.19_wp,        &  !< parameter 87  - [W/(m*K)] thermal conductivity 3rd window layer above ground floor level
-       1.0_wp,         &  !< parameter 89  - [-] wall fraction roof
-       0.02_wp,        &  !< parameter 90  - [m] 1st wall layer thickness roof
-       0.17_wp,        &  !< parameter 91  - [m] 2nd wall layer thickness roof
-       0.37_wp,        &  !< parameter 92  - [m] 3rd wall layer thickness roof
-       0.39_wp,        &  !< parameter 93  - [m] 4th wall layer thickness roof
-       1700000.0_wp,   &  !< parameter 94  - [J/(m3*K)] heat capacity 1st wall layer (outside) roof
-       79200.0_wp,     &  !< parameter 95  - [J/(m3*K)] heat capacity 2nd wall layer roof
-       2112000.0_wp,   &  !< parameter 96  - [J/(m3*K)] heat capacity 3rd wall layer roof
-       0.16_wp,        &  !< parameter 97  - [W/(m*K)] thermal conductivity 1st wall layer (outside) roof
-       0.046_wp,       &  !< parameter 98  - [W/(m*K)] thermal conductivity 2nd wall layer roof
-       2.1_wp,         &  !< parameter 99  - [W/(m*K)] thermal conductivity 3rd wall layer roof
-       0.93_wp,        &  !< parameter 100 - [-] wall emissivity roof
-       42.0_wp,        &  !< parameter 101 - [-] wall albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 102 - [-] window fraction roof
-       0.02_wp,        &  !< parameter 103 - [m] window 1st layer thickness roof
-       0.04_wp,        &  !< parameter 104 - [m] window 2nd layer thickness roof
-       0.06_wp,        &  !< parameter 105 - [m] window 3rd layer thickness roof
-       0.08_wp,        &  !< parameter 106 - [m] window 4th layer thickness roof
-       1736000.0_wp,   &  !< parameter 107 - [J/(m3*K)] heat capacity 1st window layer (outside) roof
-       1736000.0_wp,   &  !< parameter 108 - [J/(m3*K)] heat capacity 2nd window layer roof
-       1736000.0_wp,   &  !< parameter 109 - [J/(m3*K)] heat capacity 3rd window layer roof
-       0.19_wp,        &  !< parameter 110 - [W/(m*K)] thermal conductivity 1st window layer (outside) roof
-       0.19_wp,        &  !< parameter 111 - [W/(m*K)] thermal conductivity 2nd window layer roof
-       0.19_wp,        &  !< parameter 112 - [W/(m*K)] thermal conductivity 3rd window layer roof
-       0.87_wp,        &  !< parameter 113 - [-] window emissivity roof
-       0.65_wp,        &  !< parameter 114 - [-] window transmissivity (not visual transmissivity) roof
-       37.0_wp,        &  !< parameter 115 - [-] window albedo_type roof (albedo_type specified in radiation model)
-       0.86_wp,        &  !< parameter 116 - [-] green emissivity roof
-       5.0_wp,         &  !< parameter 117 - [-] green albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 118 - [-] green type roof
-       0.75_wp,        &  !< parameter 119 - [-] shading factor
-       0.7_wp,         &  !< parameter 120 - [-] g-value windows
-       1.7_wp,         &  !< parameter 121 - [W/(m2*K)] u-value windows
-       0.5_wp,         &  !< parameter 122 - [1/h] basic airflow without occupancy of the room for - summer 0.5_wp, winter 0.5
-       1.5_wp,         &  !< parameter 123 - [1/h] additional airflow dependent on occupancy of the room for - summer 1.5_wp, winter 0.0
-       0.0_wp,         &  !< parameter 124 - [-] heat recovery efficiency
-       3.5_wp,         &  !< parameter 125 - [m2/m2] dynamic parameter specific effective surface
-       370000.0_wp,    &  !< parameter 126 - [J/(m2*K)] dynamic parameter innner heat storage
-       4.5_wp,         &  !< parameter 127 - [m2/m2] ratio internal surface/floor area
-       80.0_wp,        &  !< parameter 128 - [W] maximal heating capacity
-       0.0_wp,         &  !< parameter 129 - [W] maximal cooling capacity
-       0.0_wp,         &  !< parameter 130 - [W/m2] additional internal heat gains dependent on occupancy of the room
-       4.2_wp,         &  !< parameter 131 - [W/m2] basic internal heat gains without occupancy of the room
-       2.5_wp,         &  !< parameter 132 - [m] storey height
-       0.2_wp,         &  !< parameter 133 - [m] ceiling construction height
-       0.0_wp,         &  !< parameter 134 - [-] anthropogenic heat output for heating
-       2.54_wp,        &  !< parameter 135 - [-] anthropogenic heat output for cooling
-       1526000.0_wp,   &  !< parameter 136 - [J/(m3*K)] heat capacity 4th wall layer (inside) above ground floor level
-       0.7_wp,         &  !< parameter 137 - [W/(m*K)] thermal conductivity 4th wall layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 138 - [J/(m3*K)] capacity 4th wall layer (inside) ground floor level
-       0.7_wp,         &  !< parameter 139 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground floor level
-       357200.0_wp,    &  !< parameter 140 - [J/(m3*K)] heat capacity 4th wall layer (inside) ground plate
-       0.04_wp,        &  !< parameter 141 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground plate
-       1736000.0_wp,   &  !< parameter 142 - [J/(m3*K)] heat capacity 4th window layer (inside) ground floor level
-       0.19_wp,        &  !< parameter 143 - [W/(m*K)] thermal conductivity 4th window layer (inside) ground floor level
-       1736000.0_wp,   &  !< parameter 144 - [J/(m3*K)] heat capacity 4th layer (inside) above ground floor level
-       0.19_wp,        &  !< parameter 145 - [W/(m*K)] thermal conductivity 4th window layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 146 - [J/(m3*K)] heat capacity 4th wall layer (inside) roof
-       0.7_wp,         &  !< parameter 147 - [W/(m*K)] thermal conductivity 4th wall layer (inside) roof
-       1736000.0_wp,   &  !< parameter 148 - [J/(m3*K)] heat capacity 4th window layer (inside) roof
-       0.19_wp         &  !< parameter 149 - [W/(m*K)] thermal conductivity 4th window layer (inside) roof
-                        /)
-
-    building_pars(:,3) = (/                                                                        &
-       0.71_wp,        &  !< parameter 0   - [-] wall fraction above ground floor level
-       0.29_wp,        &  !< parameter 1   - [-] window fraction above ground floor level
-       0.0_wp,         &  !< parameter 2   - [-] green fraction above ground floor level
-       0.0_wp,         &  !< parameter 3   - [-] green fraction roof above ground floor level
-       1.5_wp,         &  !< parameter 4   - [m2/m2] LAI (Leaf Area Index) roof
-       1.5_wp,         &  !< parameter 5   - [m2/m2] LAI (Leaf Area Index) on wall above ground floor level
-       1520000.0_wp,   &  !< parameter 6   - [J/(m3*K)] heat capacity 1st wall layer (outside) above ground floor level
-       79200.0_wp,     &  !< parameter 7   - [J/(m3*K)] heat capacity 2nd wall layer above ground floor level
-       1344000.0_wp,   &  !< parameter 8   - [J/(m3*K)] heat capacity 3rd wall layer above ground floor level
-       0.93_wp,        &  !< parameter 9   - [W/(m*K)] thermal conductivity 1st wall layer (outside) above ground floor level
-       0.035_wp,       &  !< parameter 10  - [W/(m*K)] thermal conductivity 2nd wall layer above ground floor level
-       0.68_wp,        &  !< parameter 11  - [W/(m*K)] thermal conductivity 3rd wall layer above ground floor level
-       299.15_wp,      &  !< parameter 12  - [K] indoor target summer temperature
-       293.15_wp,      &  !< parameter 13  - [K] indoor target winter temperature
-       0.93_wp,        &  !< parameter 14  - [-] wall emissivity above ground floor level
-       0.86_wp,        &  !< parameter 15  - [-] green emissivity above ground floor level
-       0.8_wp,         &  !< parameter 16  - [-] window emissivity above ground floor level
-       0.57_wp,        &  !< parameter 17  - [-] window transmissivity (not visual transmissivity) above ground floor level
-       0.001_wp,       &  !< parameter 18  - [m] z0 roughness above ground floor level
-       0.0001_wp,      &  !< parameter 19  - [m] z0h/z0g roughness heat/humidity above ground floor level
-       2.7_wp,         &  !< parameter 20  - [m] ground floor level height
-       0.71_wp,        &  !< parameter 21  - [-] wall fraction ground floor level
-       0.29_wp,        &  !< parameter 22  - [-] window fraction ground floor level
-       0.0_wp,         &  !< parameter 23  - [-] green fraction ground floor level
-       0.0_wp,         &  !< parameter 24  - [-] green fraction roof ground floor level
-       1.5_wp,         &  !< parameter 25  - [m2/m2] LAI (Leaf Area Index) on wall ground floor level
-       1520000.0_wp,   &  !< parameter 26  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground floor level
-       79200.0_wp,     &  !< parameter 27  - [J/(m3*K)] heat capacity 2nd wall layer ground floor level
-       1344000.0_wp,   &  !< parameter 28  - [J/(m3*K)] heat capacity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 29  - [W/(m*K)] thermal conductivity 1st wall layer (outside) ground floor level
-       0.035_wp,       &  !< parameter 30  - [W/(m*K)] thermal conductivity 2nd wall layer ground floor level
-       0.68_wp,        &  !< parameter 31  - [W/(m*K)] thermal conductivity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 32  - [-] wall emissivity ground floor level
-       0.8_wp,         &  !< parameter 33  - [-] window emissivity ground floor level
-       0.86_wp,        &  !< parameter 34  - [-] green emissivity ground floor level
-       0.57_wp,        &  !< parameter 35  - [-] window transmissivity (not visual transmissivity) ground floor level
-       0.001_wp,       &  !< parameter 36  - [m] z0 roughness ground floor level
-       0.0001_wp,      &  !< parameter 37  - [m] z0h/z0q roughness heat/humidity
-       36.0_wp,        &  !< parameter 38  - [-] wall albedo_type above ground floor level  (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 39  - [-] green albedo_type above ground floor level  (albedo_type specified in radiation model)
-       38.0_wp,        &  !< parameter 40  - [-] window albedo_type above ground floor level  (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 41  - [m] 1st wall layer thickness above ground floor level
-       0.22_wp,        &  !< parameter 42  - [m] 2nd wall layer thickness above ground floor level
-       0.58_wp,        &  !< parameter 43  - [m] 3rd wall layer thickness above ground floor level
-       0.6_wp,         &  !< parameter 44  - [m] 4th wall layer thickness above ground floor level
-       20000.0_wp,     &  !< parameter 45  - [J/(m2*K)] heat capacity wall surface (1 cm air)
-       23.0_wp,        &  !< parameter 46  - [W/(m2*K)] thermal conductivity of wall surface (1 cm air)
-       20000.0_wp,     &  !< parameter 47  - [J/(m2*K)] heat capacity of window surface (1 cm air)
-       20000.0_wp,     &  !< parameter 48  - [J/(m2*K)] heat capacity of green surface
-       23.0_wp,        &  !< parameter 49  - [W/(m2*K)] thermal conductivity of window surface (1 cm air)
-       10.0_wp,        &  !< parameter 50  - [W/(m2*K)] thermal conductivty of green surface
-       1.0_wp,         &  !< parameter 51  - [-] wall fraction ground plate
-       0.20_wp,        &  !< parameter 52  - [m] 1st wall layer thickness ground plate
-       0.32_wp,        &  !< parameter 53  - [m] 2nd wall layer thickness ground plate
-       0.38_wp,        &  !< parameter 54  - [m] 3rd wall layer thickness ground plate
-       0.41_wp,        &  !< parameter 55  - [m] 4th wall layer thickness ground plate
-       2112000.0_wp,   &  !< parameter 56  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground plate
-       79200.0_wp,     &  !< parameter 57  - [J/(m3*K)] heat capacity 2nd wall layer ground plate
-       2112000.0_wp,   &  !< parameter 58  - [J/(m3*K)] heat capacity 3rd wall layer ground plate
-       2.1_wp,         &  !< parameter 59  - [W/(m*K)] thermal conductivity 1st wall layer (oustide) ground plate
-       0.05_wp,        &  !< parameter 60  - [W/(m*K)] thermal conductivity 2nd wall layer ground plate
-       2.1_wp,         &  !< parameter 61  - [W/(m*K)] thermal conductivity 3rd wall layer ground plate
-       0.02_wp,        &  !< parameter 62  - [m] 1st wall layer thickness ground floor level
-       0.22_wp,        &  !< parameter 63  - [m] 2nd wall layer thickness ground floor level
-       0.58_wp,        &  !< parameter 64  - [m] 3rd wall layer thickness ground floor level
-       0.6_wp,         &  !< parameter 65  - [m] 4th wall layer thickness ground floor level
-       36.0_wp,        &  !< parameter 66  - [-] wall albedo_type ground floor level (albedo_type specified in radiation model)
-       0.03_wp,        &  !< parameter 67  - [m] 1st window layer thickness ground floor level
-       0.06_wp,        &  !< parameter 68  - [m] 2nd window layer thickness ground floor level
-       0.09_wp,        &  !< parameter 69  - [m] 3rd window layer thickness ground floor level
-       0.012_wp,       &  !< parameter 70  - [m] 4th window layer thickness ground floor level
-       1736000.0_wp,   &  !< parameter 71  - [J/(m3*K)] heat capacity 1st window layer (outside) ground floor level
-       1736000.0_wp,   &  !< parameter 72  - [J/(m3*K)] heat capacity 2nd window layer ground floor level
-       1736000.0_wp,   &  !< parameter 73  - [J/(m3*K)] heat capacity 3rd window layer ground floor level
-       0.11_wp,        &  !< parameter 74  - [W/(m*K)] thermal conductivity 1st window layer (outside) ground floor level
-       0.11_wp,        &  !< parameter 75  - [W/(m*K)] thermal conductivity 2nd window layer ground floor level
-       0.11_wp,        &  !< parameter 76  - [W/(m*K)] thermal conductivity 3rd window layer ground floor level
-       38.0_wp,        &  !< parameter 77  - [-] window albedo_type ground floor level (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 78  - [-] green albedo_type ground floor level (albedo_type specified in radiation model)
-       0.03_wp,        &  !< parameter 79  - [m] 1st window layer thickness above ground floor level
-       0.06_wp,        &  !< parameter 80  - [m] 2nd thickness window layer above ground floor level
-       0.09_wp,        &  !< parameter 81  - [m] 3rd window layer thickness above ground floor level
-       0.12_wp,        &  !< parameter 82  - [m] 4th window layer thickness above ground floor level
-       1736000.0_wp,   &  !< parameter 83  - [J/(m3*K)] heat capacity 1st window layer (outside) above ground floor level
-       1736000.0_wp,   &  !< parameter 84  - [J/(m3*K)] heat capacity 2nd window layer above ground floor level
-       1736000.0_wp,   &  !< parameter 85  - [J/(m3*K)] heat capacity 3rd window layer above ground floor level
-       0.11_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 1st window layer (outside) above ground floor level
-       0.11_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 2nd window layer above ground floor level
-       0.11_wp,        &  !< parameter 87  - [W/(m*K)] thermal conductivity 3rd window layer above ground floor level
-       1.0_wp,         &  !< parameter 89  - [-] wall fraction roof
-       0.02_wp,        &  !< parameter 90  - [m] 1st wall layer thickness roof
-       0.06_wp,        &  !< parameter 91  - [m] 2nd wall layer thickness roof
-       0.36_wp,        &  !< parameter 92  - [m] 3rd wall layer thickness roof
-       0.38_wp,        &  !< parameter 93  - [m] 4th wall layer thickness roof
-       3753600.0_wp,   &  !< parameter 94  - [J/(m3*K)] heat capacity 1st wall layer (outside) roof
-       709650.0_wp,    &  !< parameter 95  - [J/(m3*K)] heat capacity 2nd wall layer roof
-       79200.0_wp,     &  !< parameter 96  - [J/(m3*K)] heat capacity 3rd wall layer roof
-       0.52_wp,        &  !< parameter 97  - [W/(m*K)] thermal conductivity 1st wall layer (outside) roof
-       0.12_wp,        &  !< parameter 98  - [W/(m*K)] thermal conductivity 2nd wall layer roof
-       0.035_wp,       &  !< parameter 99  - [W/(m*K)] thermal conductivity 3rd wall layer roof
-       0.93_wp,        &  !< parameter 100 - [-] wall emissivity roof
-       42.0_wp,        &  !< parameter 101 - [-] wall albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 102 - [-] window fraction roof
-       0.03_wp,        &  !< parameter 103 - [m] window 1st layer thickness roof
-       0.06_wp,        &  !< parameter 104 - [m] window 2nd layer thickness roof
-       0.09_wp,        &  !< parameter 105 - [m] window 3rd layer thickness roof
-       0.12_wp,        &  !< parameter 106 - [m] window 4th layer thickness roof
-       1736000.0_wp,   &  !< parameter 107 - [J/(m3*K)] heat capacity 1st window layer (outside) roof
-       1736000.0_wp,   &  !< parameter 108 - [J/(m3*K)] heat capacity 2nd window layer roof
-       1736000.0_wp,   &  !< parameter 109 - [J/(m3*K)] heat capacity 3rd window layer roof
-       0.11_wp,        &  !< parameter 110 - [W/(m*K)] thermal conductivity 1st window layer (outside) roof
-       0.11_wp,        &  !< parameter 111 - [W/(m*K)] thermal conductivity 2nd window layer roof
-       0.11_wp,        &  !< parameter 112 - [W/(m*K)] thermal conductivity 3rd window layer roof
-       0.8_wp,         &  !< parameter 113 - [-] window emissivity roof
-       0.57_wp,        &  !< parameter 114 - [-] window transmissivity (not visual transmissivity) roof
-       38.0_wp,        &  !< parameter 115 - [-] window albedo_type roof (albedo_type specified in radiation model)
-       0.86_wp,        &  !< parameter 116 - [-] green emissivity roof
-       5.0_wp,         &  !< parameter 117 - [-] green albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 118 - [-] green type roof
-       0.15_wp,        &  !< parameter 119 - [-] shading factor
-       0.6_wp,         &  !< parameter 120 - [-] g-value windows
-       0.8_wp,         &  !< parameter 121 - [W/(m2*K)] u-value windows
-       0.5_wp,         &  !< parameter 122 - [1/h] basic airflow without occupancy of the room for - summer 0.5_wp, winter 0.5_wp
-       1.5_wp,         &  !< parameter 123 - [1/h] additional airflow dependent on occupancy of the room for - summer 1.5_wp, winter 0.0_wp
-       0.8_wp,         &  !< parameter 124 - [-] heat recovery efficiency
-       2.5_wp,         &  !< parameter 125 - [m2/m2] dynamic parameter specific effective surface
-       165000.0_wp,    &  !< parameter 126 - [J/(m2*K)] dynamic parameter innner heat storage
-       4.5_wp,         &  !< parameter 127 - [m2/m2] ratio internal surface/floor area
-       40.0_wp,        &  !< parameter 128 - [W] maximal heating capacity
-       0.0_wp,         &  !< parameter 129 - [W] maximal cooling capacity
-       0.0_wp,         &  !< parameter 130 - [W/m2] additional internal heat gains dependent on occupancy of the room
-       4.2_wp,         &  !< parameter 131 - [W/m2] basic internal heat gains without occupancy of the room
-       2.7_wp,         &  !< parameter 132 - [m] storey height
-       0.2_wp,         &  !< parameter 133 - [m] ceiling construction height
-       -2.0_wp,        &  !< parameter 134 - [-] anthropogenic heat output for heating
-       1.25_wp,        &  !< parameter 135 - [-] anthropogenic heat output for cooling
-       1526000.0_wp,   &  !< parameter 136 - [J/(m3*K)] heat capacity 4th wall layer (inside) above ground floor level
-       0.7_wp,         &  !< parameter 137 - [W/(m*K)] thermal conductivity 4th wall layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 138 - [J/(m3*K)] capacity 4th wall layer (inside) ground floor level
-       0.7_wp,         &  !< parameter 139 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground floor level
-       709650.0_wp,    &  !< parameter 140 - [J/(m3*K)] heat capacity 4th wall layer (inside) ground plate
-       0.12_wp,        &  !< parameter 141 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground plate
-       1736000.0_wp,   &  !< parameter 142 - [J/(m3*K)] heat capacity 4th window layer (inside) ground floor level
-       0.11_wp,        &  !< parameter 143 - [W/(m*K)] thermal conductivity 4th window layer (inside) ground floor level
-       1736000.0_wp,   &  !< parameter 144 - [J/(m3*K)] heat capacity 4th layer (inside) above ground floor level
-       0.11_wp,        &  !< parameter 145 - [W/(m*K)] thermal conductivity 4th window layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 146 - [J/(m3*K)] heat capacity 4th wall layer (inside) roof
-       0.7_wp,         &  !< parameter 147 - [W/(m*K)] thermal conductivity 4th wall layer (inside) roof
-       1736000.0_wp,   &  !< parameter 148 - [J/(m3*K)] heat capacity 4th window layer (inside) roof
-       0.11_wp         &  !< parameter 149 - [W/(m*K)] thermal conductivity 4th window layer (inside) roof
-                        /)
-
-   building_pars(:,4) = (/                                                                        &
-       0.82_wp,        &  !< parameter 0   - [-] wall fraction above ground floor level
-       0.18_wp,        &  !< parameter 1   - [-] window fraction above ground floor level
-       0.0_wp,         &  !< parameter 2   - [-] green fraction above ground floor level
-       0.0_wp,         &  !< parameter 3   - [-] green fraction roof above ground floor level
-       1.5_wp,         &  !< parameter 4   - [m2/m2] LAI (Leaf Area Index) roof
-       1.5_wp,         &  !< parameter 5   - [m2/m2] LAI (Leaf Area Index) on wall above ground floor level
-       1520000.0_wp,   &  !< parameter 6   - [J/(m3*K)] heat capacity 1st wall layer (outside) above ground floor level
-       1512000.0_wp,   &  !< parameter 7   - [J/(m3*K)] heat capacity 2nd wall layer above ground floor level
-       1512000.0_wp,   &  !< parameter 8   - [J/(m3*K)] heat capacity 3rd wall layer above ground floor level
-       0.93_wp,        &  !< parameter 9   - [W/(m*K)] thermal conductivity 1st wall layer (outside) above ground floor level
-       0.81_wp,        &  !< parameter 10  - [W/(m*K)] thermal conductivity 2nd wall layer above ground floor level
-       0.81_wp,        &  !< parameter 11  - [W/(m*K)] thermal conductivity 3rd wall layer above ground floor level
-       299.15_wp,      &  !< parameter 12  - [K] indoor target summer temperature
-       293.15_wp,      &  !< parameter 13  - [K] indoor target winter temperature
-       0.93_wp,        &  !< parameter 14  - [-] wall emissivity above ground floor level
-       0.86_wp,        &  !< parameter 15  - [-] green emissivity above ground floor level
-       0.91_wp,        &  !< parameter 16  - [-] window emissivity above ground floor level
-       0.7_wp,         &  !< parameter 17  - [-] window transmissivity (not visual transmissivity) above ground floor level
-       0.001_wp,       &  !< parameter 18  - [m] z0 roughness above ground floor level
-       0.0001_wp,      &  !< parameter 19  - [m] z0h/z0g roughness heat/humidity above ground floor level
-       2.9_wp,         &  !< parameter 20  - [m] ground floor level height
-       0.82_wp,        &  !< parameter 21  - [-] wall fraction ground floor level
-       0.18_wp,        &  !< parameter 22  - [-] window fraction ground floor level
-       0.0_wp,         &  !< parameter 23  - [-] green fraction ground floor level
-       0.0_wp,         &  !< parameter 24  - [-] green fraction roof ground floor level
-       1.5_wp,         &  !< parameter 25  - [m2/m2] LAI (Leaf Area Index) on wall ground floor level
-       1520000.0_wp,   &  !< parameter 26  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground floor level
-       1512000.0_wp,   &  !< parameter 27  - [J/(m3*K)] heat capacity 2nd wall layer ground floor level
-       1512000.0_wp,   &  !< parameter 28  - [J/(m3*K)] heat capacity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 29  - [W/(m*K)] thermal conductivity 1st wall layer (outside) ground floor level
-       0.81_wp,        &  !< parameter 30  - [W/(m*K)] thermal conductivity 2nd wall layer ground floor level
-       0.81_wp,        &  !< parameter 31  - [W/(m*K)] thermal conductivity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 32  - [-] wall emissivity ground floor level
-       0.91_wp,        &  !< parameter 33  - [-] window emissivity ground floor level
-       0.86_wp,        &  !< parameter 34  - [-] green emissivity ground floor level
-       0.7_wp,         &  !< parameter 35  - [-] window transmissivity (not visual transmissivity) ground floor level
-       0.001_wp,       &  !< parameter 36  - [m] z0 roughness ground floor level
-       0.0001_wp,      &  !< parameter 37  - [m] z0h/z0q roughness heat/humidity
-       36.0_wp,        &  !< parameter 38  - [-] wall albedo_type above ground floor level  (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 39  - [-] green albedo_type above ground floor level  (albedo_type specified in radiation model)
-       37.0_wp,        &  !< parameter 40  - [-] window albedo_type above ground floor level  (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 41  - [m] 1st wall layer thickness above ground floor level
-       0.2_wp,         &  !< parameter 42  - [m] 2nd wall layer thickness above ground floor level
-       0.38_wp,        &  !< parameter 43  - [m] 3rd wall layer thickness above ground floor level
-       0.4_wp,         &  !< parameter 44  - [m] 4th wall layer thickness above ground floor level
-       20000.0_wp,     &  !< parameter 45  - [J/(m2*K)] heat capacity wall surface (1 cm air)
-       23.0_wp,        &  !< parameter 46  - [W/(m2*K)] thermal conductivity of wall surface (1 cm air)
-       20000.0_wp,     &  !< parameter 47  - [J/(m2*K)] heat capacity of window surface (1 cm air)
-       20000.0_wp,     &  !< parameter 48  - [J/(m2*K)] heat capacity of green surface
-       23.0_wp,        &  !< parameter 49  - [W/(m2*K)] thermal conductivity of window surface (1 cm air)
-       10.0_wp,        &  !< parameter 50  - [W/(m2*K)] thermal conductivty of green surface
-       1.0_wp,         &  !< parameter 51  - [-] wall fraction ground plate
-       0.18_wp,        &  !< parameter 52  - [m] 1st wall layer thickness ground plate
-       0.36_wp,        &  !< parameter 53  - [m] 2nd wall layer thickness ground plate
-       0.42_wp,        &  !< parameter 54  - [m] 3rd wall layer thickness ground plate
-       0.45_wp,        &  !< parameter 55  - [m] 4th wall layer thickness ground plate
-       1512000.0_wp,   &  !< parameter 56  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground plate
-       1512000.0_wp,   &  !< parameter 57  - [J/(m3*K)] heat capacity 2nd wall layer ground plate
-       2112000.0_wp,   &  !< parameter 58  - [J/(m3*K)] heat capacity 3rd wall layer ground plate
-       0.52_wp,        &  !< parameter 59  - [W/(m*K)] thermal conductivity 1st wall layer (oustide) ground plate
-       0.52_wp,        &  !< parameter 60  - [W/(m*K)] thermal conductivity 2nd wall layer ground plate
-       2.1_wp,         &  !< parameter 61  - [W/(m*K)] thermal conductivity 3rd wall layer ground plate
-       0.02_wp,        &  !< parameter 62  - [m] 1st wall layer thickness ground floor level
-       0.2_wp,         &  !< parameter 63  - [m] 2nd wall layer thickness ground floor level
-       0.38_wp,        &  !< parameter 64  - [m] 3rd wall layer thickness ground floor level
-       0.4_wp,         &  !< parameter 65  - [m] 4th wall layer thickness ground floor level
-       36.0_wp,        &  !< parameter 66  - [-] wall albedo_type ground floor level (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 67  - [m] 1st window layer thickness ground floor level
-       0.04_wp,        &  !< parameter 68  - [m] 2nd window layer thickness ground floor level
-       0.06_wp,        &  !< parameter 69  - [m] 3rd window layer thickness ground floor level
-       0.08_wp,        &  !< parameter 70  - [m] 4th window layer thickness ground floor level
-       1736000.0_wp,   &  !< parameter 71  - [J/(m3*K)] heat capacity 1st window layer (outside) ground floor level
-       1736000.0_wp,   &  !< parameter 72  - [J/(m3*K)] heat capacity 2nd window layer ground floor level
-       1736000.0_wp,   &  !< parameter 73  - [J/(m3*K)] heat capacity 3rd window layer ground floor level
-       0.45_wp,        &  !< parameter 74  - [W/(m*K)] thermal conductivity 1st window layer (outside) ground floor level
-       0.45_wp,        &  !< parameter 75  - [W/(m*K)] thermal conductivity 2nd window layer ground floor level
-       0.45_wp,        &  !< parameter 76  - [W/(m*K)] thermal conductivity 3rd window layer ground floor level
-       37.0_wp,        &  !< parameter 77  - [-] window albedo_type ground floor level (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 78  - [-] green albedo_type ground floor level (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 79  - [m] 1st window layer thickness above ground floor level
-       0.04_wp,        &  !< parameter 80  - [m] 2nd thickness window layer above ground floor level
-       0.06_wp,        &  !< parameter 81  - [m] 3rd window layer thickness above ground floor level
-       0.08_wp,        &  !< parameter 82  - [m] 4th window layer thickness above ground floor level
-       1736000.0_wp,   &  !< parameter 83  - [J/(m3*K)] heat capacity 1st window layer (outside) above ground floor level
-       1736000.0_wp,   &  !< parameter 84  - [J/(m3*K)] heat capacity 2nd window layer above ground floor level
-       1736000.0_wp,   &  !< parameter 85  - [J/(m3*K)] heat capacity 3rd window layer above ground floor level
-       0.45_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 1st window layer (outside) above ground floor level
-       0.45_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 2nd window layer above ground floor level
-       0.45_wp,        &  !< parameter 87  - [W/(m*K)] thermal conductivity 3rd window layer above ground floor level
-       1.0_wp,         &  !< parameter 89  - [-] wall fraction roof
-       0.02_wp,        &  !< parameter 90  - [m] 1st wall layer thickness roof
-       0.06_wp,        &  !< parameter 91  - [m] 2nd wall layer thickness roof
-       0.08_wp,        &  !< parameter 92  - [m] 3rd wall layer thickness roof
-       0.1_wp,         &  !< parameter 93  - [m] 4th wall layer thickness roof
-       1512000.0_wp,   &  !< parameter 94  - [J/(m3*K)] heat capacity 1st wall layer (outside) roof
-       709650.0_wp,    &  !< parameter 95  - [J/(m3*K)] heat capacity 2nd wall layer roof
-       709650.0_wp,    &  !< parameter 96  - [J/(m3*K)] heat capacity 3rd wall layer roof
-       0.52_wp,        &  !< parameter 97  - [W/(m*K)] thermal conductivity 1st wall layer (outside) roof
-       0.12_wp,        &  !< parameter 98  - [W/(m*K)] thermal conductivity 2nd wall layer roof
-       0.12_wp,        &  !< parameter 99  - [W/(m*K)] thermal conductivity 3rd wall layer roof
-       0.90_wp,        &  !< parameter 100 - [-] wall emissivity roof
-       42.0_wp,        &  !< parameter 101 - [-] wall albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 102 - [-] window fraction roof
-       0.02_wp,        &  !< parameter 103 - [m] window 1st layer thickness roof
-       0.04_wp,        &  !< parameter 104 - [m] window 2nd layer thickness roof
-       0.06_wp,        &  !< parameter 105 - [m] window 3rd layer thickness roof
-       0.08_wp,        &  !< parameter 106 - [m] window 4th layer thickness roof
-       1736000.0_wp,   &  !< parameter 107 - [J/(m3*K)] heat capacity 1st window layer (outside) roof
-       1736000.0_wp,   &  !< parameter 108 - [J/(m3*K)] heat capacity 2nd window layer roof
-       1736000.0_wp,   &  !< parameter 109 - [J/(m3*K)] heat capacity 3rd window layer roof
-       0.45_wp,        &  !< parameter 110 - [W/(m*K)] thermal conductivity 1st window layer (outside) roof
-       0.45_wp,        &  !< parameter 111 - [W/(m*K)] thermal conductivity 2nd window layer roof
-       0.45_wp,        &  !< parameter 112 - [W/(m*K)] thermal conductivity 3rd window layer roof
-       0.91_wp,        &  !< parameter 113 - [-] window emissivity roof
-       0.7_wp,         &  !< parameter 114 - [-] window transmissivity (not visual transmissivity) roof
-       37.0_wp,        &  !< parameter 115 - [-] window albedo_type roof (albedo_type specified in radiation model)
-       0.86_wp,        &  !< parameter 116 - [-] green emissivity roof
-       5.0_wp,         &  !< parameter 117 - [-] green albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 118 - [-] green type roof
-       0.75_wp,        &  !< parameter 119 - [-] shading factor
-       0.8_wp,         &  !< parameter 120 - [-] g-value windows
-       2.9_wp,         &  !< parameter 121 - [W/(m2*K)] u-value windows
-       1.0_wp,         &  !< parameter 122 - [1/h] basic airflow without occupancy of the room for - summer 1.0_wp, winter 0.2
-       1.0_wp,         &  !< parameter 123 - [1/h] additional airflow dependent on occupancy of the room for - summer 1.0_wp, winter 0.8
-       0.0_wp,         &  !< parameter 124 - [-] heat recovery efficiency
-       3.0_wp,         &  !< parameter 125 - [m2/m2] dynamic parameter specific effective surface
-       260000.0_wp,    &  !< parameter 126 - [J/(m2*K)] dynamic parameter innner heat storage
-       4.5_wp,         &  !< parameter 127 - [m2/m2] ratio internal surface/floor area
-       100.0_wp,       &  !< parameter 128 - [W] maximal heating capacity
-       0.0_wp,         &  !< parameter 129 - [W] maximal cooling capacity
-       7.0_wp,         &  !< parameter 130 - [W/m2] additional internal heat gains dependent on occupancy of the room
-       3.0_wp,         &  !< parameter 131 - [W/m2] basic internal heat gains without occupancy of the room
-       2.9_wp,         &  !< parameter 132 - [m] storey height
-       0.2_wp,         &  !< parameter 133 - [m] ceiling construction height
-       0.1_wp,         &  !< parameter 134 - [-] anthropogenic heat output for heating
-       1.333_wp,       &  !< parameter 135 - [-] anthropogenic heat output for cooling
-       1526000.0_wp,   &  !< parameter 136 - [J/(m3*K)] heat capacity 4th wall layer (inside) above ground floor level
-       0.7_wp,         &  !< parameter 137 - [W/(m*K)] thermal conductivity 4th wall layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 138 - [J/(m3*K)] capacity 4th wall layer (inside) ground floor level
-       0.7_wp,         &  !< parameter 139 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground floor level
-       709650.0_wp,    &  !< parameter 140 - [J/(m3*K)] heat capacity 4th wall layer (inside) ground plate
-       0.12_wp,        &  !< parameter 141 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground plate
-       1736000.0_wp,   &  !< parameter 142 - [J/(m3*K)] heat capacity 4th window layer (inside) ground floor level
-       0.45_wp,        &  !< parameter 143 - [W/(m*K)] thermal conductivity 4th window layer (inside) ground floor level
-       1736000.0_wp,   &  !< parameter 144 - [J/(m3*K)] heat capacity 4th layer (inside) above ground floor level
-       0.45_wp,        &  !< parameter 145 - [W/(m*K)] thermal conductivity 4th window layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 146 - [J/(m3*K)] heat capacity 4th wall layer (inside) roof
-       0.7_wp,         &  !< parameter 147 - [W/(m*K)] thermal conductivity 4th wall layer (inside) roof
-       1736000.0_wp,   &  !< parameter 148 - [J/(m3*K)] heat capacity 4th window layer (inside) roof
-       0.45_wp         &  !< parameter 149 - [W/(m*K)] thermal conductivity 4th window layer (inside) roof
-                        /)
-
-    building_pars(:,5) = (/                                                                        &
-       0.75_wp,        &  !< parameter 0   - [-] wall fraction above ground floor level
-       0.25_wp,        &  !< parameter 1   - [-] window fraction above ground floor level
-       0.0_wp,         &  !< parameter 2   - [-] green fraction above ground floor level
-       0.0_wp,         &  !< parameter 3   - [-] green fraction roof above ground floor level
-       1.5_wp,         &  !< parameter 4   - [m2/m2] LAI (Leaf Area Index) roof
-       1.5_wp,         &  !< parameter 5   - [m2/m2] LAI (Leaf Area Index) on wall above ground floor level
-       1520000.0_wp,   &  !< parameter 6   - [J/(m3*K)] heat capacity 1st wall layer (outside) above ground floor level
-       79200.0_wp,     &  !< parameter 7   - [J/(m3*K)] heat capacity 2nd wall layer above ground floor level
-       2112000.0_wp,   &  !< parameter 8   - [J/(m3*K)] heat capacity 3rd wall layer above ground floor level
-       0.93_wp,        &  !< parameter 9   - [W/(m*K)] thermal conductivity 1st wall layer (outside) above ground floor level
-       2.1_wp,         &  !< parameter 10  - [W/(m*K)] thermal conductivity 2nd wall layer above ground floor level
-       0.046_wp,       &  !< parameter 11  - [W/(m*K)] thermal conductivity 3rd wall layer above ground floor level
-       299.15_wp,      &  !< parameter 12  - [K] indoor target summer temperature
-       293.15_wp,      &  !< parameter 13  - [K] indoor target winter temperature
-       0.93_wp,        &  !< parameter 14  - [-] wall emissivity above ground floor level
-       0.86_wp,        &  !< parameter 15  - [-] green emissivity above ground floor level
-       0.87_wp,        &  !< parameter 16  - [-] window emissivity above ground floor level
-       0.65_wp,        &  !< parameter 17  - [-] window transmissivity (not visual transmissivity) above ground floor level
-       0.001_wp,       &  !< parameter 18  - [m] z0 roughness above ground floor level
-       0.0001_wp,      &  !< parameter 19  - [m] z0h/z0g roughness heat/humidity above ground floor level
-       2.5_wp,         &  !< parameter 20  - [m] ground floor level height
-       0.75_wp,        &  !< parameter 21  - [-] wall fraction ground floor level
-       0.25_wp,        &  !< parameter 22  - [-] window fraction ground floor level
-       0.0_wp,         &  !< parameter 23  - [-] green fraction ground floor level
-       0.0_wp,         &  !< parameter 24  - [-] green fraction roof ground floor level
-       1.5_wp,         &  !< parameter 25  - [m2/m2] LAI (Leaf Area Index) on wall ground floor level
-       1520000.0_wp,   &  !< parameter 26  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground floor level
-       79200.0_wp,     &  !< parameter 27  - [J/(m3*K)] heat capacity 2nd wall layer ground floor level
-       2112000.0_wp,   &  !< parameter 28  - [J/(m3*K)] heat capacity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 29  - [W/(m*K)] thermal conductivity 1st wall layer (outside) ground floor level
-       0.046_wp,       &  !< parameter 30  - [W/(m*K)] thermal conductivity 2nd wall layer ground floor level
-       2.1_wp,         &  !< parameter 31  - [W/(m*K)] thermal conductivity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 32  - [-] wall emissivity ground floor level
-       0.87_wp,        &  !< parameter 33  - [-] window emissivity ground floor level
-       0.86_wp,        &  !< parameter 34  - [-] green emissivity ground floor level
-       0.65_wp,        &  !< parameter 35  - [-] window transmissivity (not visual transmissivity) ground floor level
-       0.001_wp,       &  !< parameter 36  - [m] z0 roughness ground floor level
-       0.0001_wp,      &  !< parameter 37  - [m] z0h/z0q roughness heat/humidity
-       36.0_wp,        &  !< parameter 38  - [-] wall albedo_type above ground floor level  (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 39  - [-] green albedo_type above ground floor level  (albedo_type specified in radiation model)
-       37.0_wp,        &  !< parameter 40  - [-] window albedo_type above ground floor level  (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 41  - [m] 1st wall layer thickness above ground floor level
-       0.08_wp,        &  !< parameter 42  - [m] 2nd wall layer thickness above ground floor level
-       0.32_wp,        &  !< parameter 43  - [m] 3rd wall layer thickness above ground floor level
-       0.34_wp,        &  !< parameter 44  - [m] 4th wall layer thickness above ground floor level
-       20000.0_wp,     &  !< parameter 45  - [J/(m2*K)] heat capacity wall surface (1 cm air)
-       23.0_wp,        &  !< parameter 46  - [W/(m2*K)] thermal conductivity of wall surface (1 cm air)
-       20000.0_wp,     &  !< parameter 47  - [J/(m2*K)] heat capacity of window surface (1 cm air)
-       20000.0_wp,     &  !< parameter 48  - [J/(m2*K)] heat capacity of green surface
-       23.0_wp,        &  !< parameter 49  - [W/(m2*K)] thermal conductivity of window surface (1 cm air)
-       10.0_wp,        &  !< parameter 50  - [W/(m2*K)] thermal conductivty of green surface
-       1.0_wp,         &  !< parameter 51  - [-] wall fraction ground plate
-       0.20_wp,        &  !< parameter 52  - [m] 1st wall layer thickness ground plate
-       0.26_wp,        &  !< parameter 53  - [m] 2nd wall layer thickness ground plate
-       0.32_wp,        &  !< parameter 54  - [m] 3rd wall layer thickness ground plate
-       0.34_wp,        &  !< parameter 55  - [m] 4th wall layer thickness ground plate
-       2112000.0_wp,   &  !< parameter 56  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground plate
-       79200.0_wp,     &  !< parameter 57  - [J/(m3*K)] heat capacity 2nd wall layer ground plate
-       2112000.0_wp,   &  !< parameter 58  - [J/(m3*K)] heat capacity 3rd wall layer ground plate
-       2.1_wp,         &  !< parameter 59  - [W/(m*K)] thermal conductivity 1st wall layer (oustide) ground plate
-       0.05_wp,        &  !< parameter 60  - [W/(m*K)] thermal conductivity 2nd wall layer ground plate
-       2.1_wp,         &  !< parameter 61  - [W/(m*K)] thermal conductivity 3rd wall layer ground plate
-       0.02_wp,        &  !< parameter 62  - [m] 1st wall layer thickness ground floor level
-       0.08_wp,        &  !< parameter 63  - [m] 2nd wall layer thickness ground floor level
-       0.32_wp,        &  !< parameter 64  - [m] 3rd wall layer thickness ground floor level
-       0.34_wp,        &  !< parameter 65  - [m] 4th wall layer thickness ground floor level
-       36.0_wp,        &  !< parameter 66  - [-] wall albedo_type ground floor level (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 67  - [m] 1st window layer thickness ground floor level
-       0.04_wp,        &  !< parameter 68  - [m] 2nd window layer thickness ground floor level
-       0.06_wp,        &  !< parameter 69  - [m] 3rd window layer thickness ground floor level
-       0.08_wp,        &  !< parameter 70  - [m] 4th window layer thickness ground floor level
-       1736000.0_wp,   &  !< parameter 71  - [J/(m3*K)] heat capacity 1st window layer (outside) ground floor level
-       1736000.0_wp,   &  !< parameter 72  - [J/(m3*K)] heat capacity 2nd window layer ground floor level
-       1736000.0_wp,   &  !< parameter 73  - [J/(m3*K)] heat capacity 3rd window layer ground floor level
-       0.19_wp,        &  !< parameter 74  - [W/(m*K)] thermal conductivity 1st window layer (outside) ground floor level
-       0.19_wp,        &  !< parameter 75  - [W/(m*K)] thermal conductivity 2nd window layer ground floor level
-       0.19_wp,        &  !< parameter 76  - [W/(m*K)] thermal conductivity 3rd window layer ground floor level
-       37.0_wp,        &  !< parameter 77  - [-] window albedo_type ground floor level (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 78  - [-] green albedo_type ground floor level (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 79  - [m] 1st window layer thickness above ground floor level
-       0.04_wp,        &  !< parameter 80  - [m] 2nd thickness window layer above ground floor level
-       0.06_wp,        &  !< parameter 81  - [m] 3rd window layer thickness above ground floor level
-       0.08_wp,        &  !< parameter 82  - [m] 4th window layer thickness above ground floor level
-       1736000.0_wp,   &  !< parameter 83  - [J/(m3*K)] heat capacity 1st window layer (outside) above ground floor level
-       1736000.0_wp,   &  !< parameter 84  - [J/(m3*K)] heat capacity 2nd window layer above ground floor level
-       1736000.0_wp,   &  !< parameter 85  - [J/(m3*K)] heat capacity 3rd window layer above ground floor level
-       0.19_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 1st window layer (outside) above ground floor level
-       0.19_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 2nd window layer above ground floor level
-       0.19_wp,        &  !< parameter 87  - [W/(m*K)] thermal conductivity 3rd window layer above ground floor level
-       1.0_wp,         &  !< parameter 89  - [-] wall fraction roof
-       0.02_wp,        &  !< parameter 90  - [m] 1st wall layer thickness roof
-       0.17_wp,        &  !< parameter 91  - [m] 2nd wall layer thickness roof
-       0.37_wp,        &  !< parameter 92  - [m] 3rd wall layer thickness roof
-       0.39_wp,        &  !< parameter 93  - [m] 4th wall layer thickness roof
-       1700000.0_wp,   &  !< parameter 94  - [J/(m3*K)] heat capacity 1st wall layer (outside) roof
-       79200.0_wp,     &  !< parameter 95  - [J/(m3*K)] heat capacity 2nd wall layer roof
-       2112000.0_wp,   &  !< parameter 96  - [J/(m3*K)] heat capacity 3rd wall layer roof
-       0.16_wp,        &  !< parameter 97  - [W/(m*K)] thermal conductivity 1st wall layer (outside) roof
-       0.046_wp,       &  !< parameter 98  - [W/(m*K)] thermal conductivity 2nd wall layer roof
-       2.1_wp,         &  !< parameter 99  - [W/(m*K)] thermal conductivity 3rd wall layer roof
-       0.93_wp,        &  !< parameter 100 - [-] wall emissivity roof
-       42.0_wp,        &  !< parameter 101 - [-] wall albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 102 - [-] window fraction roof
-       0.02_wp,        &  !< parameter 103 - [m] window 1st layer thickness roof
-       0.04_wp,        &  !< parameter 104 - [m] window 2nd layer thickness roof
-       0.06_wp,        &  !< parameter 105 - [m] window 3rd layer thickness roof
-       0.08_wp,        &  !< parameter 106 - [m] window 4th layer thickness roof
-       1736000.0_wp,   &  !< parameter 107 - [J/(m3*K)] heat capacity 1st window layer (outside) roof
-       1736000.0_wp,   &  !< parameter 108 - [J/(m3*K)] heat capacity 2nd window layer roof
-       1736000.0_wp,   &  !< parameter 109 - [J/(m3*K)] heat capacity 3rd window layer roof
-       0.19_wp,        &  !< parameter 110 - [W/(m*K)] thermal conductivity 1st window layer (outside) roof
-       0.19_wp,        &  !< parameter 111 - [W/(m*K)] thermal conductivity 2nd window layer roof
-       0.19_wp,        &  !< parameter 112 - [W/(m*K)] thermal conductivity 3rd window layer roof
-       0.87_wp,        &  !< parameter 113 - [-] window emissivity roof
-       0.65_wp,        &  !< parameter 114 - [-] window transmissivity (not visual transmissivity) roof
-       37.0_wp,        &  !< parameter 115 - [-] window albedo_type roof (albedo_type specified in radiation model)
-       0.86_wp,        &  !< parameter 116 - [-] green emissivity roof
-       5.0_wp,         &  !< parameter 117 - [-] green albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 118 - [-] green type roof
-       0.75_wp,        &  !< parameter 119 - [-] shading factor
-       0.7_wp,         &  !< parameter 120 - [-] g-value windows
-       1.7_wp,         &  !< parameter 121 - [W/(m2*K)] u-value windows
-       1.0_wp,         &  !< parameter 122 - [1/h] basic airflow without occupancy of the room for - summer 1.0_wp, winter 0.2
-       1.0_wp,         &  !< parameter 123 - [1/h] additional airflow dependent on occupancy of the room for - summer 1.0_wp, winter 0.8
-       0.0_wp,         &  !< parameter 124 - [-] heat recovery efficiency
-       3.5_wp,         &  !< parameter 125 - [m2/m2] dynamic parameter specific effective surface
-       370000.0_wp,    &  !< parameter 126 - [J/(m2*K)] dynamic parameter innner heat storage
-       4.5_wp,         &  !< parameter 127 - [m2/m2] ratio internal surface/floor area
-       80.0_wp,        &  !< parameter 128 - [W] maximal heating capacity
-       0.0_wp,         &  !< parameter 129 - [W] maximal cooling capacity
-       7.0_wp,         &  !< parameter 130 - [W/m2] additional internal heat gains dependent on occupancy of the room
-       3.0_wp,         &  !< parameter 131 - [W/m2] basic internal heat gains without occupancy of the room
-       2.5_wp,         &  !< parameter 132 - [m] storey height
-       0.2_wp,         &  !< parameter 133 - [m] ceiling construction height
-       0.0_wp,         &  !< parameter 134 - [-] anthropogenic heat output for heating
-       2.54_wp,        &  !< parameter 135 - [-] anthropogenic heat output for cooling
-       1526000.0_wp,   &  !< parameter 136 - [J/(m3*K)] heat capacity 4th wall layer (inside) above ground floor level
-       0.7_wp,         &  !< parameter 137 - [W/(m*K)] thermal conductivity 4th wall layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 138 - [J/(m3*K)] capacity 4th wall layer (inside) ground floor level
-       0.7_wp,         &  !< parameter 139 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground floor level
-       357200.0_wp,    &  !< parameter 140 - [J/(m3*K)] heat capacity 4th wall layer (inside) ground plate
-       0.04_wp,        &  !< parameter 141 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground plate
-       1736000.0_wp,   &  !< parameter 142 - [J/(m3*K)] heat capacity 4th window layer (inside) ground floor level
-       0.19_wp,        &  !< parameter 143 - [W/(m*K)] thermal conductivity 4th window layer (inside) ground floor level
-       1736000.0_wp,   &  !< parameter 144 - [J/(m3*K)] heat capacity 4th layer (inside) above ground floor level
-       0.19_wp,        &  !< parameter 145 - [W/(m*K)] thermal conductivity 4th window layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 146 - [J/(m3*K)] heat capacity 4th wall layer (inside) roof
-       0.7_wp,         &  !< parameter 147 - [W/(m*K)] thermal conductivity 4th wall layer (inside) roof
-       1736000.0_wp,   &  !< parameter 148 - [J/(m3*K)] heat capacity 4th window layer (inside) roof
-       0.19_wp         &  !< parameter 149 - [W/(m*K)] thermal conductivity 4th window layer (inside) roof
-                        /)
-
-    building_pars(:,6) = (/                                                                        &
-       0.71_wp,        &  !< parameter 0   - [-] wall fraction above ground floor level
-       0.29_wp,        &  !< parameter 1   - [-] window fraction above ground floor level
-       0.0_wp,         &  !< parameter 2   - [-] green fraction above ground floor level
-       0.0_wp,         &  !< parameter 3   - [-] green fraction roof above ground floor level
-       1.5_wp,         &  !< parameter 4   - [m2/m2] LAI (Leaf Area Index) roof
-       1.5_wp,         &  !< parameter 5   - [m2/m2] LAI (Leaf Area Index) on wall above ground floor level
-       1520000.0_wp,   &  !< parameter 6   - [J/(m3*K)] heat capacity 1st wall layer (outside) above ground floor level
-       79200.0_wp,     &  !< parameter 7   - [J/(m3*K)] heat capacity 2nd wall layer above ground floor level
-       1344000.0_wp,   &  !< parameter 8   - [J/(m3*K)] heat capacity 3rd wall layer above ground floor level
-       0.93_wp,        &  !< parameter 9   - [W/(m*K)] thermal conductivity 1st wall layer (outside) above ground floor level
-       0.035_wp,       &  !< parameter 10  - [W/(m*K)] thermal conductivity 2nd wall layer above ground floor level
-       0.68_wp,        &  !< parameter 11  - [W/(m*K)] thermal conductivity 3rd wall layer above ground floor level
-       299.15_wp,      &  !< parameter 12  - [K] indoor target summer temperature
-       293.15_wp,      &  !< parameter 13  - [K] indoor target winter temperature
-       0.93_wp,        &  !< parameter 14  - [-] wall emissivity above ground floor level
-       0.86_wp,        &  !< parameter 15  - [-] green emissivity above ground floor level
-       0.8_wp,         &  !< parameter 16  - [-] window emissivity above ground floor level
-       0.57_wp,        &  !< parameter 17  - [-] window transmissivity (not visual transmissivity) above ground floor level
-       0.001_wp,       &  !< parameter 18  - [m] z0 roughness above ground floor level
-       0.0001_wp,      &  !< parameter 19  - [m] z0h/z0g roughness heat/humidity above ground floor level
-       2.7_wp,         &  !< parameter 20  - [m] ground floor level height
-       0.71_wp,        &  !< parameter 21  - [-] wall fraction ground floor level
-       0.29_wp,        &  !< parameter 22  - [-] window fraction ground floor level
-       0.0_wp,         &  !< parameter 23  - [-] green fraction ground floor level
-       0.0_wp,         &  !< parameter 24  - [-] green fraction roof ground floor level
-       1.5_wp,         &  !< parameter 25  - [m2/m2] LAI (Leaf Area Index) on wall ground floor level
-       1520000.0_wp,   &  !< parameter 26  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground floor level
-       79200.0_wp,     &  !< parameter 27  - [J/(m3*K)] heat capacity 2nd wall layer ground floor level
-       1344000.0_wp,   &  !< parameter 28  - [J/(m3*K)] heat capacity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 29  - [W/(m*K)] thermal conductivity 1st wall layer (outside) ground floor level
-       0.035_wp,       &  !< parameter 30  - [W/(m*K)] thermal conductivity 2nd wall layer ground floor level
-       0.68_wp,        &  !< parameter 31  - [W/(m*K)] thermal conductivity 3rd wall layer ground floor level
-       0.93_wp,        &  !< parameter 32  - [-] wall emissivity ground floor level
-       0.8_wp,         &  !< parameter 33  - [-] window emissivity ground floor level
-       0.86_wp,        &  !< parameter 34  - [-] green emissivity ground floor level
-       0.57_wp,        &  !< parameter 35  - [-] window transmissivity (not visual transmissivity) ground floor level
-       0.001_wp,       &  !< parameter 36  - [m] z0 roughness ground floor level
-       0.0001_wp,      &  !< parameter 37  - [m] z0h/z0q roughness heat/humidity
-       36.0_wp,        &  !< parameter 38  - [-] wall albedo_type above ground floor level  (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 39  - [-] green albedo_type above ground floor level  (albedo_type specified in radiation model)
-       38.0_wp,        &  !< parameter 40  - [-] window albedo_type above ground floor level  (albedo_type specified in radiation model)
-       0.02_wp,        &  !< parameter 41  - [m] 1st wall layer thickness above ground floor level
-       0.22_wp,        &  !< parameter 42  - [m] 2nd wall layer thickness above ground floor level
-       0.58_wp,        &  !< parameter 43  - [m] 3rd wall layer thickness above ground floor level
-       0.6_wp,         &  !< parameter 44  - [m] 4th wall layer thickness above ground floor level
-       20000.0_wp,     &  !< parameter 45  - [J/(m2*K)] heat capacity wall surface (1 cm air)
-       23.0_wp,        &  !< parameter 46  - [W/(m2*K)] thermal conductivity of wall surface (1 cm air)
-       20000.0_wp,     &  !< parameter 47  - [J/(m2*K)] heat capacity of window surface (1 cm air)
-       20000.0_wp,     &  !< parameter 48  - [J/(m2*K)] heat capacity of green surface
-       23.0_wp,        &  !< parameter 49  - [W/(m2*K)] thermal conductivity of window surface (1 cm air)
-       10.0_wp,        &  !< parameter 50  - [W/(m2*K)] thermal conductivty of green surface
-       1.0_wp,         &  !< parameter 51  - [-] wall fraction ground plate
-       0.20_wp,        &  !< parameter 52  - [m] 1st wall layer thickness ground plate
-       0.32_wp,        &  !< parameter 53  - [m] 2nd wall layer thickness ground plate
-       0.38_wp,        &  !< parameter 54  - [m] 3rd wall layer thickness ground plate
-       0.41_wp,        &  !< parameter 55  - [m] 4th wall layer thickness ground plate
-       2112000.0_wp,   &  !< parameter 56  - [J/(m3*K)] heat capacity 1st wall layer (outside) ground plate
-       79200.0_wp,     &  !< parameter 57  - [J/(m3*K)] heat capacity 2nd wall layer ground plate
-       2112000.0_wp,   &  !< parameter 58  - [J/(m3*K)] heat capacity 3rd wall layer ground plate
-       2.1_wp,         &  !< parameter 59  - [W/(m*K)] thermal conductivity 1st wall layer (oustide) ground plate
-       0.05_wp,        &  !< parameter 60  - [W/(m*K)] thermal conductivity 2nd wall layer ground plate
-       2.1_wp,         &  !< parameter 61  - [W/(m*K)] thermal conductivity 3rd wall layer ground plate
-       0.02_wp,        &  !< parameter 62  - [m] 1st wall layer thickness ground floor level
-       0.22_wp,        &  !< parameter 63  - [m] 2nd wall layer thickness ground floor level
-       0.58_wp,        &  !< parameter 64  - [m] 3rd wall layer thickness ground floor level
-       0.6_wp,         &  !< parameter 65  - [m] 4th wall layer thickness ground floor level
-       36.0_wp,        &  !< parameter 66  - [-] wall albedo_type ground floor level (albedo_type specified in radiation model)
-       0.03_wp,        &  !< parameter 67  - [m] 1st window layer thickness ground floor level
-       0.06_wp,        &  !< parameter 68  - [m] 2nd window layer thickness ground floor level
-       0.09_wp,        &  !< parameter 69  - [m] 3rd window layer thickness ground floor level
-       0.012_wp,       &  !< parameter 70  - [m] 4th window layer thickness ground floor level
-       1736000.0_wp,   &  !< parameter 71  - [J/(m3*K)] heat capacity 1st window layer (outside) ground floor level
-       1736000.0_wp,   &  !< parameter 72  - [J/(m3*K)] heat capacity 2nd window layer ground floor level
-       1736000.0_wp,   &  !< parameter 73  - [J/(m3*K)] heat capacity 3rd window layer ground floor level
-       0.11_wp,        &  !< parameter 74  - [W/(m*K)] thermal conductivity 1st window layer (outside) ground floor level
-       0.11_wp,        &  !< parameter 75  - [W/(m*K)] thermal conductivity 2nd window layer ground floor level
-       0.11_wp,        &  !< parameter 76  - [W/(m*K)] thermal conductivity 3rd window layer ground floor level
-       38.0_wp,        &  !< parameter 77  - [-] window albedo_type ground floor level (albedo_type specified in radiation model)
-       5.0_wp,         &  !< parameter 78  - [-] green albedo_type ground floor level (albedo_type specified in radiation model)
-       0.03_wp,        &  !< parameter 79  - [m] 1st window layer thickness above ground floor level
-       0.06_wp,        &  !< parameter 80  - [m] 2nd thickness window layer above ground floor level
-       0.09_wp,        &  !< parameter 81  - [m] 3rd window layer thickness above ground floor level
-       0.12_wp,        &  !< parameter 82  - [m] 4th window layer thickness above ground floor level
-       1736000.0_wp,   &  !< parameter 83  - [J/(m3*K)] heat capacity 1st window layer (outside) above ground floor level
-       1736000.0_wp,   &  !< parameter 84  - [J/(m3*K)] heat capacity 2nd window layer above ground floor level
-       1736000.0_wp,   &  !< parameter 85  - [J/(m3*K)] heat capacity 3rd window layer above ground floor level
-       0.11_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 1st window layer (outside) above ground floor level
-       0.11_wp,        &  !< parameter 86  - [W/(m*K)] thermal conductivity 2nd window layer above ground floor level
-       0.11_wp,        &  !< parameter 87  - [W/(m*K)] thermal conductivity 3rd window layer above ground floor level
-       1.0_wp,         &  !< parameter 89  - [-] wall fraction roof
-       0.02_wp,        &  !< parameter 90  - [m] 1st wall layer thickness roof
-       0.06_wp,        &  !< parameter 91  - [m] 2nd wall layer thickness roof
-       0.36_wp,        &  !< parameter 92  - [m] 3rd wall layer thickness roof
-       0.38_wp,        &  !< parameter 93  - [m] 4th wall layer thickness roof
-       3753600.0_wp,   &  !< parameter 94  - [J/(m3*K)] heat capacity 1st wall layer (outside) roof
-       709650.0_wp,    &  !< parameter 95  - [J/(m3*K)] heat capacity 2nd wall layer roof
-       79200.0_wp,     &  !< parameter 96  - [J/(m3*K)] heat capacity 3rd wall layer roof
-       0.52_wp,        &  !< parameter 97  - [W/(m*K)] thermal conductivity 1st wall layer (outside) roof
-       0.12_wp,        &  !< parameter 98  - [W/(m*K)] thermal conductivity 2nd wall layer roof
-       0.035_wp,       &  !< parameter 99  - [W/(m*K)] thermal conductivity 3rd wall layer roof
-       0.93_wp,        &  !< parameter 100 - [-] wall emissivity roof
-       42.0_wp,        &  !< parameter 101 - [-] wall albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 102 - [-] window fraction roof
-       0.03_wp,        &  !< parameter 103 - [m] window 1st layer thickness roof
-       0.06_wp,        &  !< parameter 104 - [m] window 2nd layer thickness roof
-       0.09_wp,        &  !< parameter 105 - [m] window 3rd layer thickness roof
-       0.12_wp,        &  !< parameter 106 - [m] window 4th layer thickness roof
-       1736000.0_wp,   &  !< parameter 107 - [J/(m3*K)] heat capacity 1st window layer (outside) roof
-       1736000.0_wp,   &  !< parameter 108 - [J/(m3*K)] heat capacity 2nd window layer roof
-       1736000.0_wp,   &  !< parameter 109 - [J/(m3*K)] heat capacity 3rd window layer roof
-       0.11_wp,        &  !< parameter 110 - [W/(m*K)] thermal conductivity 1st window layer (outside) roof
-       0.11_wp,        &  !< parameter 111 - [W/(m*K)] thermal conductivity 2nd window layer roof
-       0.11_wp,        &  !< parameter 112 - [W/(m*K)] thermal conductivity 3rd window layer roof
-       0.8_wp,         &  !< parameter 113 - [-] window emissivity roof
-       0.57_wp,        &  !< parameter 114 - [-] window transmissivity (not visual transmissivity) roof
-       38.0_wp,        &  !< parameter 115 - [-] window albedo_type roof (albedo_type specified in radiation model)
-       0.86_wp,        &  !< parameter 116 - [-] green emissivity roof
-       5.0_wp,         &  !< parameter 117 - [-] green albedo_type roof (albedo_type specified in radiation model)
-       0.0_wp,         &  !< parameter 118 - [-] green type roof
-       0.15_wp,        &  !< parameter 119 - [-] shading factor
-       0.6_wp,         &  !< parameter 120 - [-] g-value windows
-       0.8_wp,         &  !< parameter 121 - [W/(m2*K)] u-value windows
-       1.0_wp,         &  !< parameter 122 - [1/h] basic airflow without occupancy of the room for - summer 1.0_wp, winter 0.2
-       1.0_wp,         &  !< parameter 123 - [1/h] additional airflow dependent on occupancy of the room for - summer 1.0_wp, winter 0.8
-       0.8_wp,         &  !< parameter 124 - [-] heat recovery efficiency
-       2.5_wp,         &  !< parameter 125 - [m2/m2] dynamic parameter specific effective surface
-       165000.0_wp,    &  !< parameter 126 - [J/(m2*K)] dynamic parameter innner heat storage
-       4.5_wp,         &  !< parameter 127 - [m2/m2] ratio internal surface/floor area
-       40.0_wp,        &  !< parameter 128 - [W] maximal heating capacity
-       -80.0_wp,       &  !< parameter 129 - [W] maximal cooling capacity
-       7.0_wp,         &  !< parameter 130 - [W/m2] additional internal heat gains dependent on occupancy of the room
-       3.0_wp,         &  !< parameter 131 - [W/m2] basic internal heat gains without occupancy of the room
-       2.7_wp,         &  !< parameter 132 - [m] storey height
-       0.2_wp,         &  !< parameter 133 - [m] ceiling construction height
-       -2.0_wp,        &  !< parameter 134 - [-] anthropogenic heat output for heating
-       1.25_wp,        &  !< parameter 135 - [-] anthropogenic heat output for cooling
-       1526000.0_wp,   &  !< parameter 136 - [J/(m3*K)] heat capacity 4th wall layer (inside) above ground floor level
-       0.7_wp,         &  !< parameter 137 - [W/(m*K)] thermal conductivity 4th wall layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 138 - [J/(m3*K)] capacity 4th wall layer (inside) ground floor level
-       0.7_wp,         &  !< parameter 139 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground floor level
-       709650.0_wp,    &  !< parameter 140 - [J/(m3*K)] heat capacity 4th wall layer (inside) ground plate
-       0.12_wp,        &  !< parameter 141 - [W/(m*K)] thermal conductivity 4th wall layer (inside) ground plate
-       1736000.0_wp,   &  !< parameter 142 - [J/(m3*K)] heat capacity 4th window layer (inside) ground floor level
-       0.11_wp,        &  !< parameter 143 - [W/(m*K)] thermal conductivity 4th window layer (inside) ground floor level
-       1736000.0_wp,   &  !< parameter 144 - [J/(m3*K)] heat capacity 4th layer (inside) above ground floor level
-       0.11_wp,        &  !< parameter 145 - [W/(m*K)] thermal conductivity 4th window layer (inside) above ground floor level
-       1526000.0_wp,   &  !< parameter 146 - [J/(m3*K)] heat capacity 4th wall layer (inside) roof
-       0.7_wp,         &  !< parameter 147 - [W/(m*K)] thermal conductivity 4th wall layer (inside) roof
-       1736000.0_wp,   &  !< parameter 148 - [J/(m3*K)] heat capacity 4th window layer (inside) roof
-       0.11_wp         &  !< parameter 149 - [W/(m*K)] thermal conductivity 4th window layer (inside) roof
-                        /)
-
-    building_pars(:,7) = (/                                                                        &
-      1.0_wp,          &  !< parameter 0   - [-] wall fraction above ground floor level
-      0.0_wp,          &  !< parameter 1   - [-] window fraction above ground floor level
-      0.0_wp,          &  !< parameter 2   - [-] green fraction above ground floor level
-      0.0_wp,          &  !< parameter 3   - [-] green fraction roof above ground floor level
-      1.5_wp,          &  !< parameter 4   - [m2/m2] LAI (Leaf Area Index) roof
-      1.5_wp,          &  !< parameter 5   - [m2/m2] LAI (Leaf Area Index) on wall above ground floor level
-      1950400.0_wp,    &  !< parameter 6   - [J/(m3*K)] heat capacity 1st wall layer (upside) above ground floor level
-      1848000.0_wp,    &  !< parameter 7   - [J/(m3*K)] heat capacity 2nd wall layer above ground floor level
-      1848000.0_wp,    &  !< parameter 8   - [J/(m3*K)] heat capacity 3rd wall layer above ground floor level
-      0.7_wp,          &  !< parameter 9   - [W/(m*K)] thermal conductivity 1st wall layer (upside) above ground floor level
-      1.0_wp,          &  !< parameter 10  - [W/(m*K)] thermal conductivity 2nd wall layer above ground floor level
-      1.0_wp,          &  !< parameter 11  - [W/(m*K)] thermal conductivity 3rd wall layer above ground floor level
-      372.15_wp,       &  !< parameter 12  - [K] indoor target summer temperature
-      293.15_wp,       &  !< parameter 13  - [K] indoor target winter temperature
-      0.93_wp,         &  !< parameter 14  - [-] wall emissivity above ground floor level
-      0.86_wp,         &  !< parameter 15  - [-] green emissivity above ground floor level
-      0.8_wp,          &  !< parameter 16  - [-] window emissivity above ground floor level
-      0.7_wp,          &  !< parameter 17  - [-] window transmissivity (not visual transmissivity) above ground floor level
-      0.001_wp,        &  !< parameter 18  - [m] z0 roughness above ground floor level
-      0.0001_wp,       &  !< parameter 19  - [m] z0h/z0g roughness heat/humidity above ground floor level
-      4.0_wp,          &  !< parameter 20  - [m] ground floor level height
-      1.0_wp,          &  !< parameter 21  - [-] wall fraction ground floor level
-      0.0_wp,          &  !< parameter 22  - [-] window fraction ground floor level
-      0.0_wp,          &  !< parameter 23  - [-] green fraction ground floor level
-      0.0_wp,          &  !< parameter 24  - [-] green fraction roof ground floor level
-      1.5_wp,          &  !< parameter 25  - [m2/m2] LAI (Leaf Area Index) on wall ground floor level
-      1950400.0_wp,    &  !< parameter 26  - [J/(m3*K)] heat capacity 1st wall layer (upside) ground floor level
-      1848000.0_wp,    &  !< parameter 27  - [J/(m3*K)] heat capacity 2nd wall layer ground floor level
-      1848000.0_wp,    &  !< parameter 28  - [J/(m3*K)] heat capacity 3rd wall layer ground floor level
-      0.7_wp,          &  !< parameter 29  - [W/(m*K)] thermal conductivity 1st wall layer (upside) ground floor level
-      1.0_wp,          &  !< parameter 30  - [W/(m*K)] thermal conductivity 2nd wall layer ground floor level
-      1.0_wp,          &  !< parameter 31  - [W/(m*K)] thermal conductivity 3rd wall layer ground floor level
-      0.93_wp,         &  !< parameter 32  - [-] wall emissivity ground floor level
-      0.8_wp,          &  !< parameter 33  - [-] window emissivity ground floor level
-      0.86_wp,         &  !< parameter 34  - [-] green emissivity ground floor level
-      0.7_wp,          &  !< parameter 35  - [-] window transmissivity (not visual transmissivity) ground floor level
-      0.001_wp,        &  !< parameter 36  - [m] z0 roughness ground floor level
-      0.0001_wp,       &  !< parameter 37  - [m] z0h/z0q roughness heat/humidity
-      20.0_wp,         &  !< parameter 38  - [-] wall albedo_type above ground floor level  (albedo_type specified in radiation model)
-      5.0_wp,          &  !< parameter 39  - [-] green albedo_type above ground floor level  (albedo_type specified in radiation model)
-      37.0_wp,         &  !< parameter 40  - [-] window albedo_type above ground floor level  (albedo_type specified in radiation model)
-      0.29_wp,         &  !< parameter 41  - [m] 1st wall layer thickness above ground floor level
-      0.4_wp,          &  !< parameter 42  - [m] 2nd wall layer thickness above ground floor level
-      0.695_wp,        &  !< parameter 43  - [m] 3rd wall layer thickness above ground floor level
-      0.985_wp,        &  !< parameter 44  - [m] 4th wall layer thickness above ground floor level
-      20000.0_wp,      &  !< parameter 45  - [J/(m2*K)] heat capacity wall surface (1 cm air)
-      23.0_wp,         &  !< parameter 46  - [W/(m2*K)] thermal conductivity of wall surface (1 cm air)
-      20000.0_wp,      &  !< parameter 47  - [J/(m2*K)] heat capacity of window surface (1 cm air)
-      20000.0_wp,      &  !< parameter 48  - [J/(m2*K)] heat capacity of green surface
-      23.0_wp,         &  !< parameter 49  - [W/(m2*K)] thermal conductivity of window surface (1 cm air)
-      10.0_wp,         &  !< parameter 50  - [W/(m2*K)] thermal conductivty of green surface
-      1.0_wp,          &  !< parameter 51  - [-] wall fraction ground plate
-      0.29_wp,         &  !< parameter 52  - [m] 1st wall layer thickness ground plate
-      0.4_wp,          &  !< parameter 53  - [m] 2nd wall layer thickness ground plate
-      0.695_wp,        &  !< parameter 54  - [m] 3rd wall layer thickness ground plate
-      0.985_wp,        &  !< parameter 55  - [m] 4th wall layer thickness ground plate
-      1950400.0_wp,    &  !< parameter 56  - [J/(m3*K)] heat capacity 1st wall layer (upside) ground plate
-      1848000.0_wp,    &  !< parameter 57  - [J/(m3*K)] heat capacity 2nd wall layer ground plate
-      1848000.0_wp,    &  !< parameter 58  - [J/(m3*K)] heat capacity 3rd wall layer ground plate
-      0.7_wp,          &  !< parameter 59  - [W/(m*K)] thermal conductivity 1st wall layer (upside) ground plate
-      1.0_wp,          &  !< parameter 60  - [W/(m*K)] thermal conductivity 2nd wall layer ground plate
-      1.0_wp,          &  !< parameter 61  - [W/(m*K)] thermal conductivity 3rd wall layer ground plate
-      0.29_wp,         &  !< parameter 62  - [m] 1st wall layer thickness ground floor level
-      0.4_wp,          &  !< parameter 63  - [m] 2nd wall layer thickness ground floor level
-      0.695_wp,        &  !< parameter 64  - [m] 3rd wall layer thickness ground floor level
-      0.985_wp,        &  !< parameter 65  - [m] 4th wall layer thickness ground floor level
-      20.0_wp,         &  !< parameter 66  - [-] wall albedo_type ground floor level (albedo_type specified in radiation model)
-      0.003_wp,        &  !< parameter 67  - [m] 1st window layer thickness ground floor level
-      0.006_wp,        &  !< parameter 68  - [m] 2nd window layer thickness ground floor level
-      0.012_wp,        &  !< parameter 69  - [m] 3rd window layer thickness ground floor level
-      0.018_wp,        &  !< parameter 70  - [m] 4th window layer thickness ground floor level
-      1736000.0_wp,    &  !< parameter 71  - [J/(m3*K)] heat capacity 1st window layer (outside) ground floor level
-      1736000.0_wp,    &  !< parameter 72  - [J/(m3*K)] heat capacity 2nd window layer ground floor level
-      1736000.0_wp,    &  !< parameter 73  - [J/(m3*K)] heat capacity 3rd window layer ground floor level
-      0.57_wp,         &  !< parameter 74  - [W/(m*K)] thermal conductivity 1st window layer (outside) ground floor level
-      0.57_wp,         &  !< parameter 75  - [W/(m*K)] thermal conductivity 2nd window layer ground floor level
-      0.57_wp,         &  !< parameter 76  - [W/(m*K)] thermal conductivity 3rd window layer ground floor level
-      37.0_wp,         &  !< parameter 77  - [-] window albedo_type ground floor level (albedo_type specified in radiation model)
-      5.0_wp,          &  !< parameter 78  - [-] green albedo_type ground floor level (albedo_type specified in radiation model)
-      0.003_wp,        &  !< parameter 79  - [m] 1st window layer thickness above ground floor level
-      0.006_wp,        &  !< parameter 80  - [m] 2nd thickness window layer above ground floor level
-      0.012_wp,        &  !< parameter 81  - [m] 3rd window layer thickness above ground floor level
-      0.018_wp,        &  !< parameter 82  - [m] 4th window layer thickness above ground floor level
-      1736000.0_wp,    &  !< parameter 83  - [J/(m3*K)] heat capacity 1st window layer (outside) above ground floor level
-      1736000.0_wp,    &  !< parameter 84  - [J/(m3*K)] heat capacity 2nd window layer above ground floor level
-      1736000.0_wp,    &  !< parameter 85  - [J/(m3*K)] heat capacity 3rd window layer above ground floor level
-      0.57_wp,         &  !< parameter 86  - [W/(m*K)] thermal conductivity 1st window layer (outside) above ground floor level
-      0.57_wp,         &  !< parameter 87  - [W/(m*K)] thermal conductivity 2nd window layer above ground floor level
-      0.57_wp,         &  !< parameter 88  - [W/(m*K)] thermal conductivity 3rd window layer above ground floor level
-      1.0_wp,          &  !< parameter 89  - [-] wall fraction roof
-      0.29_wp,         &  !< parameter 90  - [m] 1st wall layer thickness roof
-      0.4_wp,          &  !< parameter 91  - [m] 2nd wall layer thickness roof
-      0.695_wp,        &  !< parameter 92  - [m] 3rd wall layer thickness roof
-      0.985_wp,        &  !< parameter 93  - [m] 4th wall layer thickness roof
-      1950400.0_wp,    &  !< parameter 94  - [J/(m3*K)] heat capacity 1st wall layer (outside) roof
-      1848000.0_wp,    &  !< parameter 95  - [J/(m3*K)] heat capacity 2nd wall layer roof
-      1848000.0_wp,    &  !< parameter 96  - [J/(m3*K)] heat capacity 3rd wall layer roof
-      0.7_wp,          &  !< parameter 97  - [W/(m*K)] thermal conductivity 1st wall layer (upside) roof
-      1.0_wp,          &  !< parameter 98  - [W/(m*K)] thermal conductivity 2nd wall layer roof
-      1.0_wp,          &  !< parameter 99  - [W/(m*K)] thermal conductivity 3rd wall layer roof
-      0.93_wp,         &  !< parameter 100 - [-] wall emissivity roof
-      19.0_wp,         &  !< parameter 101 - [-] wall albedo_type roof (albedo_type specified in radiation model)
-      0.0_wp,          &  !< parameter 102 - [-] window fraction roof
-      0.003_wp,        &  !< parameter 103 - [m] window 1st layer thickness roof
-      0.006_wp,        &  !< parameter 104 - [m] window 2nd layer thickness roof
-      0.012_wp,        &  !< parameter 105 - [m] window 3rd layer thickness roof
-      0.018_wp,        &  !< parameter 106 - [m] window 4th layer thickness roof
-      1736000.0_wp,    &  !< parameter 107 - [J/(m3*K)] heat capacity 1st window layer (outside) roof
-      1736000.0_wp,    &  !< parameter 108 - [J/(m3*K)] heat capacity 2nd window layer roof
-      1736000.0_wp,    &  !< parameter 109 - [J/(m3*K)] heat capacity 3rd window layer roof
-      0.57_wp,         &  !< parameter 110 - [W/(m*K)] thermal conductivity 1st window layer (outside) roof
-      0.57_wp,         &  !< parameter 111 - [W/(m*K)] thermal conductivity 2nd window layer roof
-      0.57_wp,         &  !< parameter 112 - [W/(m*K)] thermal conductivity 3rd window layer roof
-      0.8_wp,          &  !< parameter 113 - [-] window emissivity roof
-      0.7_wp,          &  !< parameter 114 - [-] window transmissivity (not visual transmissivity) roof
-      37.0_wp,         &  !< parameter 115 - [-] window albedo_type roof (albedo_type specified in radiation model)
-      0.86_wp,         &  !< parameter 116 - [-] green emissivity roof
-      5.0_wp,          &  !< parameter 117 - [-] green albedo_type roof (albedo_type specified in radiation model)
-      0.0_wp,          &  !< parameter 118 - [-] green type roof
-      0.8_wp,          &  !< parameter 119 - [-] shading factor
-      100.0_wp,        &  !< parameter 120 - [-] g-value windows
-      100.0_wp,        &  !< parameter 121 - [W/(m2*K)] u-value windows
-      20.0_wp,         &  !< parameter 122 - [1/h] basic airflow without occupancy of the room
-      20.0_wp,         &  !< parameter 123 - [1/h] additional airflow dependent on occupancy of the room
-      0.0_wp,          &  !< parameter 124 - [-] heat recovery efficiency
-      1.0_wp,          &  !< parameter 125 - [m2/m2] dynamic parameter specific effective surface
-      1.0_wp,          &  !< parameter 126 - [J/(m2*K)] dynamic parameter innner heatstorage
-      4.5_wp,          &  !< parameter 127 - [m2/m2] ratio internal surface/floor area
-      100000.0_wp,     &  !< parameter 128 - [W] maximal heating capacity
-      0.0_wp,          &  !< parameter 129 - [W] maximal cooling capacity
-      0.0_wp,          &  !< parameter 130 - [W/m2] additional internal heat gains dependent on occupancy of the room
-      0.0_wp,          &  !< parameter 131 - [W/m2] basic internal heat gains without occupancy of the room
-      3.0_wp,          &  !< parameter 132 - [m] storey height
-      0.2_wp,          &  !< parameter 133 - [m] ceiling construction height
-      0.0_wp,          &  !< parameter 134 - [-] anthropogenic heat output for heating
-      0.0_wp,          &  !< parameter 135 - [-] anthropogenic heat output for cooling
-      1848000.0_wp,    &  !< parameter 136 - [J/(m3*K)] heat capacity 4th wall layer (downside) above ground floor level
-      1.0_wp,          &  !< parameter 137 - [W/(m*K)] thermal conductivity 4th wall layer (downside) above ground floor level
-      1848000.0_wp,    &  !< parameter 138 - [J/(m3*K)] heat capacity 4th wall layer (downside) ground floor level
-      1.0_wp,          &  !< parameter 139 - [W/(m*K)] thermal conductivity 4th wall layer (downside) ground floor level
-      1848000.0_wp,    &  !< parameter 140 - [J/(m3*K)] heat capacity 4th wall layer (downside) ground plate
-      1.0_wp,          &  !< parameter 141 - [W/(m*K)] thermal conductivity 4th wall layer (downside) ground plate
-      1736000.0_wp,    &  !< parameter 142 - [J/(m3*K)] heat capacity 4th window layer (inside) ground floor level
-      0.57_wp,         &  !< parameter 143 - [W/(m*K)] thermal conductivity 4th window layer (inside) ground floor level
-      1736000.0_wp,    &  !< parameter 144 - [J/(m3*K)] heat capacity 4th window layer (inside) above ground floor level
-      0.57_wp,         &  !< parameter 145 - [W/(m*K)] thermal conductivity 4th window layer (inside) above ground floor level
-      1848000.0_wp,    &  !< parameter 146 - [J/(m3*K)] heat capacity 4th wall layer (inside) roof
-      1.0_wp,          &  !< parameter 147 - [W/(m*K)] thermal conductivity 4th wall layer (downside) roof
-      1736000.0_wp,    &  !< parameter 148 - [J/(m3*K)] heat capacity 4th window layer (inside) roof
-      0.57_wp          &  !< parameter 149 - [W/(m*K)] thermal conductivity 4th window layer (inside) roof
-                        /)
-
- END SUBROUTINE usm_define_pars
-
-
- END MODULE urban_surface_mod
Index: palm/trunk/SOURCE/user_data_output_mask.f90
===================================================================
--- palm/trunk/SOURCE/user_data_output_mask.f90	(revision 4901)
+++ 	(revision )
@@ -1,161 +1,0 @@
-!> @file user_data_output_mask.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Remove dependency on surface_mod + example for terrain-following output
-! adjusted
-!
-! 4069 2019-07-01 14:05:51Z Giersch
-! Masked output running index mid has been introduced as a local variable to
-! avoid runtime error (Loop variable has been modified) in time_integration
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! variables commented + statement added to avoid compiler warnings about unused variables
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Add terrain-following output
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! Description:
-! ------------
-!> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with
-!> indices (i,j,k) for masked data output.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_data_output_mask( av, variable, found, local_pf, mid )
-
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-    USE user
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  variable  !<
-
-    INTEGER(iwp) ::  av              !<
-    INTEGER(iwp) ::  mid             !< masked output running index
-!    INTEGER(iwp) ::  i               !<
-!    INTEGER(iwp) ::  j               !<
-!    INTEGER(iwp) ::  k               !<
-!    INTEGER(iwp) ::  topo_top_index  !< k index of highest horizontal surface
-
-    LOGICAL ::  found  !<
-
-    REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  local_pf  !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( av == 0  .OR.                                                                             &
-         local_pf(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) == 0.0_wp )  CONTINUE
-
-
-    found = .TRUE.
-
-    SELECT CASE ( TRIM( variable ) )
-
-!--    Uncomment and extend the following lines, if necessary.
-!--    The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
-!--    and defined by the user!
-!--    Sample for user-defined output:
-!       CASE ( 'u2' )
-!          IF ( av == 0 )  THEN
-!             IF ( .NOT. mask_surface(mid) )  THEN
-!!
-!!--             Default masked output
-!                DO  i = 1, mask_size_l(mid,1)
-!                   DO  j = 1, mask_size_l(mid,2)
-!                      DO  k = 1, mask_size_l(mid,3)
-!                         local_pf(i,j,k) = u2(mask_k(mid,k),                                       &
-!                                              mask_j(mid,j),                                       &
-!                                              mask_i(mid,i))
-!                      ENDDO
-!                   ENDDO
-!                ENDDO
-!             ELSE
-!!
-!!--             Terrain-following masked output
-!                DO  i = 1, mask_size_l(mid,1)
-!                   DO  j = 1, mask_size_l(mid,2)
-!!
-!!--                   Get k index of highest horizontal surface
-!                      topo_top_index = topo_top_ind( mask_j(mid,j), mask_i(mid,i), 1 )
-!!
-!!--                   Save output array
-!                      DO  k = 1, mask_size_l(mid,3)
-!                         local_pf(i,j,k) = u2(MIN( topo_top_index + mask_k(mid,k), nzt+1 ),        &
-!                                              mask_j(mid,j), mask_i(mid,i) )
-!                      ENDDO
-!                   ENDDO
-!                ENDDO
-!             ENDIF
-!          ELSE
-!             IF ( .NOT. mask_surface(mid) )  THEN
-!!
-!!--             Default masked output
-!                DO  i = 1, mask_size_l(mid,1)
-!                   DO  j = 1, mask_size_l(mid,2)
-!                      DO  k = 1, mask_size_l(mid,3)
-!                          local_pf(i,j,k) = u2_av(mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
-!                       ENDDO
-!                    ENDDO
-!                 ENDDO
-!             ELSE
-!!
-!!--             Terrain-following masked output
-!                DO  i = 1, mask_size_l(mid,1)
-!                   DO  j = 1, mask_size_l(mid,2)
-!!
-!!--                   Get k index of highest horizontal surface
-!                      topo_top_index = topo_top_ind( mask_j(mid,j), mask_i(mid,i), 1 )
-!!
-!!--                   Save output array
-!                      DO  k = 1, mask_size_l(mid,3)
-!                         local_pf(i,j,k) = u2_av( MIN( topo_top_index+mask_k(mid,k), nzt+1 ),      &
-!                                                  mask_j(mid,j), mask_i(mid,i) )
-!                      ENDDO
-!                   ENDDO
-!                ENDDO
-!             ENDIF
-!          ENDIF
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE user_data_output_mask
Index: palm/trunk/SOURCE/user_flight.f90
===================================================================
--- palm/trunk/SOURCE/user_flight.f90	(revision 4901)
+++ 	(revision )
@@ -1,102 +1,0 @@
-!> @file user_flight.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! unused variables commented out + statement added to avoid compiler warnings
-!
-! 3684 2019-01-20 20:20:58Z knoop
-! Corrected "Former revisions" section
-!
-! 1957 2016-07-07 10:43:48Z suehring
-! Initial revision
-!
-! Description:
-! ------------
-!> Calculation of user-defined output quantity for flight measurements after each timestep.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_flight( var, id )
-
-    USE control_parameters
-
-    USE grid_variables
-
-    USE indices
-
-    USE kinds
-
-    USE user
-
-    USE arrays_3d
-
-    IMPLICIT NONE
-
-!    INTEGER(iwp) ::  i  !< index along x
-!    INTEGER(iwp) ::  j  !< index along y
-!    INTEGER(iwp) ::  k  !< index along z
-    INTEGER(iwp) ::  id  !< variable identifyer, according to the settings in user_init_flight
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< treated variable
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( id == 0  .OR.  var(nzb,nysg,nxlg) == 0.0_wp )  CONTINUE
-
-!
-!-- Here, the respective variable is calculated. There is no call of exchange_horiz necessary.
-!-- The variable identifyer (id) must be set according to the settings in user_init_flight.
-!-- Please note, so far, variable must be located at the center of a grid box.
-!     var = 0.0_wp
-
-!     SELECT CASE ( id )
-!
-!        CASE ( 1 )
-!           DO  i = nxl-1, nxr+1
-!              DO  j = nys-1, nyn+1
-!                 DO  k = nzb, nzt
-!                    var(k,j,i) = ABS( u(k,j,i )
-!                 ENDDO
-!              ENDDO
-!           ENDDO
-!
-!        CASE ( 2 )
-!           DO  i = nxl-1, nxr+1
-!              DO  j = nys-1, nyn+1
-!                 DO  k = nzb, nzt
-!                    var(k,j,i) = ABS( v(k,j,i) )
-!                 ENDDO
-!              ENDDO
-!           ENDDO
-!
-!     END SELECT
-
-
- END SUBROUTINE user_flight
Index: palm/trunk/SOURCE/user_init_3d_model.f90
===================================================================
--- palm/trunk/SOURCE/user_init_3d_model.f90	(revision 4901)
+++ 	(revision )
@@ -1,121 +1,0 @@
-!> @file user_init_3d_model.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! variables commented out to avoid compiler warnings about unused variables
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
-! 211 2008-11-11 04:46:24Z raasch
-! Former file user_interface.f90 split into one file per subroutine
-!
-! Description:
-! ------------
-!> Allows the complete initialization of the 3d model.
-!>
-!> @attention The user is responsible to set at least all those quantities which
-!>            are normally set within init_3d_model!
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_init_3d_model
-
-
-    USE arrays_3d
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-    USE surface_mod
-
-    USE user
-
-    IMPLICIT NONE
-
-!    INTEGER(iwp) ::  l  !< running index surface orientation
-!    INTEGER(iwp) ::  m  !< running index surface elements
-
-!
-!-- Initialization of surface-related quantities.
-!-- The following example shows required initialization of surface quantitites at default-type
-!-- upward-facing surfaces.
-!   DO  m = 1, surf_def_h(0)%ns
-!      surf_def_h(0)%ol(m)   = ...    ! Obukhov length
-!      surf_def_h(0)%us(m  ) = ...    ! friction velocity
-!      surf_def_h(0)%usws(m) = ...    ! vertical momentum flux, u-component
-!      surf_def_h(0)%vsws(m) = ...    ! vertical momentum flux, v-component
-!      surf_def_h(0)%z0(m)   = ...    ! roughness length for momentum
-!      IF ( .NOT. neutral )  THEN
-!         surf_def_h(0)%ts(m)   = ... ! scaling parameter
-!         surf_def_h(0)%shf(m)  = ... ! surface sensible heat flux
-!         surf_def_h(0)%z0h(m)  = ... ! roughness length for heat
-!      ENDIF
-!      IF ( humditiy )  THEN
-!         surf_def_h(0)%qs(m)   = ... ! scaling parameter
-!         surf_def_h(0)%qsws(m) = ... ! surface latent heat flux
-!         surf_def_h(0)%z0q(m)  = ... ! roughness length for moisture
-!      ENDIF
-!      IF ( passive_scalar )  THEN
-!         surf_def_h(0)%ss(m)   = ... ! scaling parameter
-!         surf_def_h(0)%ssws(m) = ... ! surface latent heat flux
-!      ENDIF
-!   ENDDO
-!
-!-- Same for natural and urban type surfaces
-!   DO  m = 1, surf_lsm_h%ns
-!      ...
-!   ENDDO
-!   DO  m = 1, surf_usm_h%ns
-!      ...
-!   ENDDO
-!
-!-- Also care for vertically aligned surfaces (default-, natural-, and
-!-- urban-type).
-!   DO  l = 0, 3
-!      DO  m = 1, surf_def_v(l)%ns
-!         ...
-!      ENDDO
-!      DO  m = 1, surf_lsm_v(l)%ns
-!         ...
-!      ENDDO
-!      DO  m = 1, surf_usm_v(l)%ns
-!         ...
-!      ENDDO
-!   ENDDO
-!
-!
-!-- In the following, initialize 3D quantities, e.g. u, v, w, pt, etc..
-
- END SUBROUTINE user_init_3d_model
-
Index: palm/trunk/SOURCE/user_init_flight_mod.f90
===================================================================
--- palm/trunk/SOURCE/user_init_flight_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,135 +1,0 @@
-!> @file user_init_flight_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! * Modularize user_init_flight in order to provide an explicit interface.
-! * routine renamed to user_init_flight_mod
-! 
-! 4498 2020-04-15 14:26:31Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! statements commented or added to avoid compiler warnings about unused variables
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
-! 1957 2016-07-07 10:43:48Z suehring
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Initialization of user-defined flight measurements.
-!>
-!> @todo Integrate into user_module when circular dependencies has been vanished.
-!--------------------------------------------------------------------------------------------------!
- MODULE user_init_flight_mod
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-!    USE netcdf_interface,                                                                          &
-!        ONLY: dofl_label,                                                                          &
-!              dofl_unit
-
-    USE user
-
-    IMPLICIT NONE
-
-    PUBLIC user_init_flight
-
-    INTERFACE user_init_flight
-       MODULE PROCEDURE user_init_flight
-    END INTERFACE user_init_flight
-
-    CONTAINS
-
-! Description:
-! ------------
-!> Execution of user-defined initialization for flight measurements.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_init_flight( init, k, id, label_leg )
-
-    CHARACTER(LEN=10), OPTIONAL ::  label_leg     !< label of the respective leg
-
-    INTEGER(iwp), OPTIONAL                ::  id  !< variable index
-    INTEGER(iwp), OPTIONAL, INTENT(INOUT) ::  k   !< index for respective variable and leg
-
-    LOGICAL ::  init  !< variable to recognize initial call
-
-!
-!-- Following statements are added to avoid compiler warnings about unused variables. Please remove.
-    IF ( PRESENT( id )        )  CONTINUE
-    IF ( PRESENT( k )         )  CONTINUE
-    IF ( PRESENT( label_leg ) )  CONTINUE
-
-!
-!-- Sample for user-defined flight-time series.
-!-- For each quantity you have to give a label and a unit, which will be used for the output into
-!-- NetCDF file. They must not contain more than twenty characters.
-
-
-    IF ( init )  THEN
-!
-!--    The number of user-defined quantity has to be increased appropriately.
-!--    In the following example, 2 user-defined quantities are added.
-!        num_var_fl_user = num_var_fl_user + 2
-
-       init = .FALSE.
-
-    ELSE
-
-!
-!--    Please add the respective number of new variables as following:
-
-!        SELECT CASE ( id )
-!
-!           CASE ( 1 )
-!              dofl_label(k)   = TRIM(label_leg) // '_' // 'abs_u'
-!              dofl_unit(k)    = 'm/s'
-!              k               = k + 1
-!
-!           CASE ( 2 )
-!
-!              dofl_label(k)   = TRIM(label_leg) // '_' // 'abs_v'
-!              dofl_unit(k)    = 'm/s'
-!              k               = k + 1
-!
-!        END SELECT
-
-    ENDIF
-
- END SUBROUTINE user_init_flight
- 
- END MODULE user_init_flight_mod
-
Index: palm/trunk/SOURCE/user_init_grid.f90
===================================================================
--- palm/trunk/SOURCE/user_init_grid.f90	(revision 4901)
+++ 	(revision )
@@ -1,114 +1,0 @@
-!> @file user_init_grid.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! variables commented + statement added to avoid compiler warnings about unused variables
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! dz was replaced by dz(1)
-!
-! 217 2008-12-09 18:00:48Z letzel
-! +topography_grid_convention
-! Former file user_interface.f90 split into one file per subroutine
-!
-! Description:
-! ------------
-!> Execution of user-defined grid initializing actions
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_init_grid( topo_3d )
-
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-    USE user
-
-    IMPLICIT NONE
-
-!    INTEGER(iwp)                                           ::  k_topo   !< topography top index
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo_3d  !< 3D topography field
-
-!    REAL(wp) ::  h_topo !< user-defined topography height
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( topo_3d(nzb,nysg,nxlg) == 0 )  CONTINUE
-
-
-!
-!-- Here the user-defined grid initializing actions follow:
-
-!
-!-- Set the index array nzb_local for non-flat topography.
-!-- Here consistency checks concerning domain size and periodicity are necessary
-    SELECT CASE ( TRIM( topography ) )
-
-       CASE ( 'flat', 'single_building', 'single_street_canyon', 'tunnel' )
-!
-!--       Not allowed here since these are the standard cases used in init_grid.
-
-       CASE ( 'user_defined_topography_1' )
-!
-!--       Here the user can define their own topography.
-!--       After definition, please remove the following three lines!
-          message_string = 'topography "' // topography // '" not available yet'
-          CALL message( 'user_init_grid', 'UI0005', 1, 2, 0, 6, 0 )
-!
-!--       The user is allowed to set surface-mounted as well as non-surface mounted topography
-!--       (e.g. overhanging structures). For both, use 3D array topo_3d and set bit 0. The
-!--       convention is: bit is zero inside topography, bit is 1 for atmospheric grid point.
-!--       The following example shows how to prescribe sine-like topography along x-direction with
-!--       amplitude of 10 * dz(1) and wavelength 10 * dy.
-!           DO  i = nxlg, nxrg
-!              h_topo = 10.0_wp * dz(1) * ( SIN( 3.14_wp * 0.5_wp) * i * dx / ( 5.0_wp * dy ) )**2
-!
-!              k_topo = MINLOC( ABS( zw - h_topo ), 1 ) - 1
-!
-!              topo_3d(k_topo+1:nzt+1,:,i) = IBSET( topo_3d(k_topo+1:nzt+1,:,i), 0 )
-!           ENDDO
-!
-!           CALL exchange_horiz_int( topo_3d, nys, nyn, nxl, nxr, nzt, nbgp )
-
-       CASE DEFAULT
-!
-!--       The DEFAULT case is reached if the parameter topography contains a wrong character string
-!--       that is neither recognized in init_grid nor here in user_init_grid.
-          message_string = 'unknown topography "' // topography // '"'
-          CALL message( 'user_init_grid', 'UI0006', 1, 2, 0, 6, 0 )
-
-    END SELECT
-
- END SUBROUTINE user_init_grid
-
Index: palm/trunk/SOURCE/user_init_land_surface.f90
===================================================================
--- palm/trunk/SOURCE/user_init_land_surface.f90	(revision 4901)
+++ 	(revision )
@@ -1,73 +1,0 @@
-!> @file user_init_land_surface.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! Current revisions:
-! -----------------
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! unused variables commented out
-!
-! 3700 2019-01-26 17:03:42Z knoop
-! Corrected "Former revisions" section
-!
-! 1496 2014-12-02 17:25:50Z maronga
-! Initial revision
-!
-! Description:
-! ------------
-!> Execution of user-defined actions to initiate the land surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_init_land_surface
-
-
-    USE kinds
-
-    USE land_surface_model_mod
-
-    USE surface_mod
-
-    IMPLICIT NONE
-
-!    INTEGER(iwp) ::  i  !< grid index
-!    INTEGER(iwp) ::  j  !< grid index
-!    INTEGER(iwp) ::  m  !< running index on 1D wall-type grid
-
-!
-!-- Here the user-defined land surface initialization actions follow.
-!-- Example: set roughness length at natural land-surface
-!     DO  m = 1, surf_lsm_h%ns
-!        surf_lsm_h%z0(m) = 0.1_wp
-!     ENDDO
-
-
- END SUBROUTINE user_init_land_surface
-
Index: palm/trunk/SOURCE/user_init_plant_canopy.f90
===================================================================
--- palm/trunk/SOURCE/user_init_plant_canopy.f90	(revision 4901)
+++ 	(revision )
@@ -1,116 +1,0 @@
-!> @file user_init_plant_canopy.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! Current revisions:
-! -----------------
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Renamed canopy_mode 'block' to 'homogeneous'
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! unused variables commented out to avoid compiler warnings
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
-! 211 2008-11-11 04:46:24Z raasch
-! Former file user_interface.f90 split into one file per subroutine
-!
-! Description:
-! ------------
-!> Initialisation of the leaf area density array (for scalar grid points) and the array of the
-!> canopy drag coefficient, if the user has not chosen any of the default cases
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_init_plant_canopy
-
-
-    USE arrays_3d
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-    USE plant_canopy_model_mod
-
-    USE user
-
-    IMPLICIT NONE
-
-!    INTEGER(iwp) :: i  !< running index
-!    INTEGER(iwp) :: j  !< running index
-
-!
-!-- Here the user-defined grid initializing actions follow:
-
-!
-!-- Set the 3D-array lad_s for user defined canopies
-    SELECT CASE ( TRIM( canopy_mode ) )
-
-       CASE ( 'homogeneous' )
-!
-!--       Not allowed here since this is the standard case used in init_3d_model.
-
-       CASE ( 'user_defined_canopy_1' )
-!
-!--       Here the user can define his own forest topography.
-!--       The following lines contain an example, where the plant canopy extends only over the
-!--       second half of the model domain along x. Attention: DO-loops have to include the ghost
-!--       points (nxlg-nxrg, nysg-nyng), because no exchange of ghost point information is intended,
-!--       in order to minimize communication between CPUs.
-!          DO  i = nxlg, nxrg
-!             IF ( i >= INT( ( nx+1 ) / 2 ) )  THEN
-!                DO  j = nysg, nyng
-!                   lad_s(:,j,i) = lad(:)
-!                ENDDO
-!             ELSE
-!                lad_s(:,:,i) = 0.0_wp
-!             ENDIF
-!          ENDDO
-!
-!--       After definition, please remove the following three lines!
-          message_string = 'canopy_mode "' // canopy_mode //  '" not available yet'
-          CALL message( 'user_init_plant_canopy', 'UI0007', 0, 1, 0, 6, 0 )
-
-       CASE DEFAULT
-!
-!--       The DEFAULT case is reached if the parameter canopy_mode contains a wrong character string
-!--       that is neither recognized in init_3d_model nor here in user_init_plant_canopy.
-          message_string = 'unknown canopy_mode "' // canopy_mode // '"'
-          CALL message( 'user_init_plant_canopy', 'UI0008', 1, 2, 0, 6, 0 )
-
-    END SELECT
-
-
- END SUBROUTINE user_init_plant_canopy
-
Index: palm/trunk/SOURCE/user_init_radiation.f90
===================================================================
--- palm/trunk/SOURCE/user_init_radiation.f90	(revision 4901)
+++ 	(revision )
@@ -1,72 +1,0 @@
-!> @file user_init_radiation.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! unused variables commented out to avoid compiler warnings
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
-! 1585 2015-04-30 07:05:52Z maronga
-! Initial revision
-!
-! Description:
-! ------------
-!> Execution of user-defined actions to initiate the radiation model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_init_radiation
-
-
-    USE arrays_3d
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-    USE radiation_model_mod
-
-    USE user
-
-    IMPLICIT NONE
-
-!    INTEGER(iwp) :: i  !< running index
-!    INTEGER(iwp) :: j  !< running index
-
-!
-!-- Here the user-defined radiation initialization actions follow:
-
-
-
- END SUBROUTINE user_init_radiation
-
Index: palm/trunk/SOURCE/user_init_urban_surface.f90
===================================================================
--- palm/trunk/SOURCE/user_init_urban_surface.f90	(revision 4901)
+++ 	(revision )
@@ -1,80 +1,0 @@
-!> @file user_init_urban_surface.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! Corrected "Former revisions" section
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! unused variables commented out to avoid compiler warnings
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
-! 2007 2016-08-24 15:47:17Z kanani
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Execution of user-defined actions to initiate the urban surface model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_init_urban_surface
-
-    USE arrays_3d
-
-!    USE control_parameters,                                                                        &
-!        ONLY:  urban_surface
-
-    USE indices
-
-    USE kinds
-
-    USE urban_surface_mod
-
-    USE surface_mod
-
-    USE user
-
-    IMPLICIT NONE
-
-!    INTEGER(iwp) ::  i  !< grid index
-!    INTEGER(iwp) ::  j  !< grid index
-!    INTEGER(iwp) ::  m  !< running index on 1D wall-type grid
-
-!
-!-- Here the user-defined urban surface initialization actions follow.
-!-- Example: set roughness length at urban surface
-!     DO  m = 1, surf_usm_h%ns
-!        surf_usm_h%z0(m) = 0.1_wp
-!     ENDDO
-
-
-
- END SUBROUTINE user_init_urban_surface
-
Index: palm/trunk/SOURCE/user_interface.f90
===================================================================
--- palm/trunk/SOURCE/user_interface.f90	(revision 1)
+++ palm/trunk/SOURCE/user_interface.f90	(revision 1)
@@ -0,0 +1,882 @@
+ MODULE user
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: user_interface.f90,v $
+! Revision 1.18  2006/06/02 15:25:00  raasch
+! +change of grid-defining arguments in routine user_define_netcdf_grid,
+! new argument "found" in user_data_output_2d and user_data_output_3d
+!
+! Revision 1.17  2006/04/11 14:59:28  raasch
+! Reading and writing user-defined quantities from/to the restart file improved
+!
+! Revision 1.16  2006/03/03 20:00:48  raasch
+! Error removed from last version
+!
+! Revision 1.15  2006/03/03 19:55:36  raasch
+! Call of user_init_grid now requires the formal parameter nzb_local
+!
+! Revision 1.14  2006/02/23 13:13:18  raasch
+! Additional interfaces for the calculation and output of user-defined 2d- and
+! 3d-data
+!
+! Revision 1.13  2003/03/12 16:44:56  raasch
+! Full code replaced in routine user_actions (in the call for all gridpoints)
+! instead of calling the _ij version (required by NEC, because otherwise no
+! vectorization)
+!
+! Revision 1.12  2002/12/19 16:22:04  raasch
+! SAVE added in module user, STOP statement replaced by call of subroutine
+! local_stop
+!
+! Revision 1.11  2002/06/11 13:22:09  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+! Log point for user_actions removed from the grid point version.
+!
+! Revision 1.10  2001/08/21 12:13:55  raasch
+! Wrong module in user_actions changed
+!
+! Revision 1.9  2001/08/21 10:04:30  raasch
+! User_actions can be called from every prognostic equation,
+! subroutine user_statistics, user_particle_attributes, user_dvrp_coltab added
+!
+! Revision 1.8  2001/07/12 12:45:07  raasch
+! Subroutine user_init_particles added
+!
+! Revision 1.7  2001/03/30 07:58:52  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.6  2000/08/07 12:43:16  raasch
+! All comments translated into English
+!
+! Revision 1.5  1998/04/06 14:42:21  raasch
+! +SUBROUTINE user_last_actions
+!
+! Revision 1.4  1998/03/30 11:38:37  raasch
+! Fehlerkorrekturen und Ausgabeaenderungen
+!
+! Revision 1.3  1998/03/25 20:11:17  raasch
+! +region in userpar
+!
+! Revision 1.2  1998/03/25 13:57:37  raasch
+! userpar beinhaltet jetzt keine vordefinierten Variablen mehr
+!
+! 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).
+!------------------------------------------------------------------------------!
+
+    INTEGER ::  user_idummy
+    LOGICAL ::  user_defined_namelist_found = .FALSE.
+    REAL    ::  user_dummy
+
+!
+!-- Sample for user-defined output
+!    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  u2, u2_av
+
+    SAVE
+
+ END MODULE user
+
+
+ SUBROUTINE user_parin
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Interface to read user-defined namelist-parameters.
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE statistics
+    USE user
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=80) ::  zeile
+
+
+    NAMELIST /userpar/  data_output_user, region
+
+!
+!-- Position the namelist-file at the beginning (it was already opened in
+!-- parin), search for user-defined namelist-group ("userpar", but any other
+!-- name can be choosed) and position the file at this line.
+    REWIND ( 11 )
+
+    zeile = ' '
+    DO   WHILE ( INDEX( zeile, '&userpar' ) == 0 )
+       READ ( 11, '(A)', END=100 )  zeile
+    ENDDO
+    BACKSPACE ( 11 )
+
+!
+!-- Read user-defined namelist
+    READ ( 11, userpar )
+    user_defined_namelist_found = .TRUE.
+
+100 RETURN
+
+ END SUBROUTINE user_parin
+
+
+
+ SUBROUTINE user_header( io )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Print a header with user-defined informations.
+!------------------------------------------------------------------------------!
+
+    USE statistics
+    USE user
+
+    IMPLICIT NONE
+
+    INTEGER ::  i, io
+
+!
+!-- If no user-defined variables are read from the namelist-file, no
+!-- informations will be printed.
+    IF ( .NOT. user_defined_namelist_found )  THEN
+       WRITE ( io, 100 )
+       RETURN
+    ENDIF
+
+!
+!-- Printing the informations.
+    WRITE ( io, 110 )
+
+    IF ( statistic_regions /= 0 )  THEN
+       WRITE ( io, 200 )
+       DO  i = 0, statistic_regions
+          WRITE ( io, 201 )  i, region(i)
+       ENDDO
+    ENDIF
+
+
+
+!
+!-- Format-descriptors
+100 FORMAT (//' *** no user-defined variables found'/)
+110 FORMAT (//1X,78('#')                                      &
+            //' User-defined variables and actions:'/  &
+              ' -----------------------------------'//)
+200 FORMAT (' Output of profiles and time series for following regions:' /)
+201 FORMAT (4X,'Region ',I1,':   ',A)
+
+
+ END SUBROUTINE user_header
+
+
+
+ SUBROUTINE user_init
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Execution of user-defined initializing actions
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE indices
+    USE pegrid
+    USE user
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=20) :: field_char
+!
+!-- Here the user-defined initializing actions follow:
+!-- Sample for user-defined output
+!    ALLOCATE( u2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+!
+!    IF ( initializing_actions == 'read_restart_data' )  THEN
+!       READ ( 13 )  field_chr
+!       DO  WHILE ( TRIM( field_chr ) /= '*** end user ***' )
+!
+!          SELECT CASE ( TRIM( field_chr ) )
+!
+!             CASE ( 'u2_av' )
+!                ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+!                READ ( 13 )  u2_av
+!
+!             CASE DEFAULT
+!                PRINT*, '+++ user_init: unknown variable named "', &
+!                        TRIM( field_chr ), '" found in'
+!                PRINT*, '               data from prior run on PE ', myid
+!                CALL local_stop
+!
+!          END SELECT
+!       ENDDO
+!    ENDIF
+
+ END SUBROUTINE user_init
+
+
+
+ SUBROUTINE user_init_grid( nzb_local )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Execution of user-defined grid initializing actions
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE indices
+    USE user
+
+    IMPLICIT NONE
+
+    INTEGER, DIMENSION(-1:ny+1,-1:nx+1) ::  nzb_local
+
+!
+!-- Here the user-defined grid initializing actions follow:
+
+!
+!-- Set the index array nzb_local for non-flat topography.
+!-- Here consistency checks concerning domain size and periodicity are necessary
+    SELECT CASE ( TRIM( topography ) )
+
+       CASE ( 'flat', 'single_building' )
+!
+!--       Not allowed here since these are the standard cases used in init_grid.
+
+       CASE ( 'user_defined_topography_1' )
+!
+!--       Here the user can define his own topography. After definition, please
+!--       remove the following three lines!
+          PRINT*, '+++ user_init_grid: topography "', &
+               topography, '" not available yet'
+          CALL local_stop
+
+       CASE DEFAULT
+!
+!--       The DEFAULT case is reached if the parameter topography contains a
+!--       wrong character string that is neither recognized in init_grid nor 
+!--       here in user_init_grid.
+          PRINT*, '+++ (user_)init_grid: unknown topography "', &
+               topography, '"'
+          CALL local_stop
+
+    END SELECT
+
+
+ END SUBROUTINE user_init_grid
+
+
+
+ MODULE user_actions_mod
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Execution of user-defined actions before or after single timesteps
+!------------------------------------------------------------------------------!
+
+    PRIVATE
+    PUBLIC user_actions
+
+    INTERFACE user_actions
+       MODULE PROCEDURE user_actions
+       MODULE PROCEDURE user_actions_ij
+    END INTERFACE user_actions
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE user_actions( location )
+
+       USE control_parameters
+       USE cpulog
+       USE indices
+       USE interfaces
+       USE pegrid
+       USE user
+       USE arrays_3d
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  location
+
+       INTEGER ::  i, j, 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 = nxl-1, nxr+1
+!                DO  j = nys-1, nyn+1
+!                   DO  k = nzb, nzt+1
+!                      u2(k,j,i) = u(k,j,i)**2
+!                   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 ( 'e-tendency' )
+
+
+          CASE ( 'q-tendency' )
+
+
+          CASE DEFAULT
+             IF ( myid == 0 )  PRINT*, '+++ user_actions: unknown location "', &
+                                       location, '"'
+             CALL local_stop
+
+       END SELECT
+
+       CALL cpu_log( log_point(24), 'user_actions', 'stop' )
+
+    END SUBROUTINE user_actions
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE user_actions_ij( i, j, location )
+
+       USE control_parameters
+       USE pegrid
+       USE user
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  location
+
+       INTEGER ::  i, idum, 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 ( 'e-tendency' )
+
+
+          CASE ( 'q-tendency' )
+
+
+          CASE ( 'before_timestep', 'after_integration', 'after_timestep' )
+             IF ( myid == 0 )  THEN
+                PRINT*, '+++ user_actions: location "', location, '" is not ', &
+                             'allowed to be called with parameters "i" and "j"'
+             ENDIF
+             CALL local_stop
+
+
+          CASE DEFAULT
+             IF ( myid == 0 )  PRINT*, '+++ user_actions: unknown location "', &
+                                       location, '"'
+             CALL local_stop
+
+
+       END SELECT
+
+    END SUBROUTINE user_actions_ij
+
+ END MODULE user_actions_mod
+
+
+
+ SUBROUTINE user_statistics
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Calculation of user-defined statistics
+!------------------------------------------------------------------------------!
+
+    USE statistics
+    USE user
+
+    IMPLICIT NONE
+
+
+ END SUBROUTINE user_statistics
+
+
+
+ SUBROUTINE user_last_actions
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Execution of user-defined actions at the end of a job.
+!------------------------------------------------------------------------------!
+
+    USE user
+
+    IMPLICIT NONE
+
+!
+!-- Here the user-defined actions at the end of a job follow.
+!-- Sample for user-defined output:
+!    IF ( ALLOCATED( u2_av ) )  THEN
+!       WRITE ( 14 )  'u2_av               ';  WRITE ( 14 )  u2_av
+!    ENDIF
+
+    WRITE ( 14 )  '*** end user ***    '
+
+ END SUBROUTINE user_last_actions
+
+
+
+ SUBROUTINE user_init_particles
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Modification of initial particles by the user.
+!------------------------------------------------------------------------------!
+
+    USE particle_attributes
+    USE user
+
+    IMPLICIT NONE
+
+    INTEGER ::  n
+
+!
+!-- Here the user-defined actions follow
+!    DO  n = 1, number_of_initial_particles
+!    ENDDO
+
+ END SUBROUTINE user_init_particles
+
+
+
+ SUBROUTINE user_particle_attributes
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Define the actual particle attributes (size, colour) by the user.
+!------------------------------------------------------------------------------!
+
+    USE particle_attributes
+    USE user
+
+    IMPLICIT NONE
+
+    INTEGER ::  n
+
+!
+!-- Here the user-defined actions follow
+!    DO  n = 1, number_of_initial_particles
+!    ENDDO
+
+ END SUBROUTINE user_particle_attributes
+
+
+
+ SUBROUTINE user_dvrp_coltab( mode, variable )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Definition of the colour table to be used by the dvrp software.
+!------------------------------------------------------------------------------!
+
+    USE dvrp_variables
+    USE pegrid
+    USE user
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  mode
+    CHARACTER (LEN=*) ::  variable
+
+
+!
+!-- Here the user-defined actions follow
+    SELECT CASE ( mode )
+
+       CASE ( 'particles' )
+
+       CASE ( 'slicer' )
+
+       CASE DEFAULT
+          IF ( myid == 0 )  PRINT*, '+++ user_dvrp_coltab: unknown mode "', &
+                                    mode, '"'
+          CALL local_stop
+
+    END SELECT
+
+ END SUBROUTINE user_dvrp_coltab
+
+
+
+ SUBROUTINE user_check_data_output( variable, unit )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Set the unit of user defined output quantities. For those variables
+! not recognized by the user, the parameter unit is set to "illegal", which
+! tells the calling routine that the output variable is not defined and leads
+! to a program abort.
+!------------------------------------------------------------------------------!
+
+    USE user
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  unit, variable
+
+
+    SELECT CASE ( TRIM( variable ) )
+
+!
+!--    Uncomment and extend the following lines, if necessary
+!       CASE ( 'u2' )
+!          unit = 'm2/s2'
+!
+       CASE DEFAULT
+          unit = 'illegal'
+
+    END SELECT
+
+
+ END SUBROUTINE user_check_data_output
+
+
+
+ SUBROUTINE user_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Set the grids on which user-defined output quantities are defined.
+! Allowed values for grid_x are "x" and "xu", for grid_y "y" and "yv", and
+! for grid_z "zu" and "zw".
+!------------------------------------------------------------------------------!
+
+    USE user
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  grid_x, grid_y, grid_z, variable
+
+    LOGICAL ::  found
+
+
+    SELECT CASE ( TRIM( variable ) )
+
+!
+!--    Uncomment and extend the following lines, if necessary
+!       CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' )
+!          grid_x = 'xu'
+!          grid_y = 'y'
+!          grid_z = 'zu'
+
+       CASE DEFAULT
+          found  = .FALSE.
+          grid_x = 'none'
+          grid_y = 'none'
+          grid_z = 'none'
+
+    END SELECT
+
+
+ END SUBROUTINE user_define_netcdf_grid
+
+
+
+ SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Resorts the user-defined output quantity with indices (k,j,i) to a
+! temporary array with indices (i,j,k) and sets the grid on which it is defined.
+! Allowed values for grid are "zu" and "zw".
+!------------------------------------------------------------------------------!
+
+    USE indices
+    USE user
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  grid, variable
+
+    INTEGER ::  av, i, j, k
+
+    LOGICAL ::  found
+
+    REAL, DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) ::  local_pf
+
+
+    found = .TRUE.
+
+    SELECT CASE ( TRIM( variable ) )
+
+!
+!--    Uncomment and extend the following lines, if necessary.
+!--    The arrays for storing the user defined quantities (here u2 and u2_av)
+!--    have to be declared and defined by the user!
+!--    Sample for user-defined output:
+!       CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
+!          IF ( av == 0 )  THEN
+!             DO  i = nxl-1, nxr+1
+!                DO  j = nys-1, nyn+1
+!                   DO  k = nzb, nzt+1
+!                      local_pf(i,j,k) = u2(k,j,i)
+!                   ENDDO
+!                ENDDO
+!             ENDDO
+!          ELSE
+!             DO  i = nxl-1, nxr+1
+!                DO  j = nys-1, nyn+1
+!                   DO  k = nzb, nzt+1
+!                      local_pf(i,j,k) = u2_av(k,j,i)
+!                   ENDDO
+!                ENDDO
+!             ENDDO
+!          ENDIF
+!
+!          grid = 'zu'
+
+       CASE DEFAULT
+          found = .FALSE.
+          grid  = 'none'
+
+    END SELECT
+
+
+ END SUBROUTINE user_data_output_2d
+
+
+
+ SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nz_do )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Resorts the user-defined output quantity with indices (k,j,i) to a
+! temporary array with indices (i,j,k) and sets the grid on which it is defined.
+! Allowed values for grid are "zu" and "zw".
+!------------------------------------------------------------------------------!
+
+    USE array_kind
+    USE indices
+    USE user
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  variable
+
+    INTEGER ::  av, i, j, k, nz_do
+
+    LOGICAL ::  found
+
+    REAL(spk), DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do) ::  local_pf
+
+
+    found = .TRUE.
+
+    SELECT CASE ( TRIM( variable ) )
+
+!
+!--    Uncomment and extend the following lines, if necessary.
+!--    The arrays for storing the user defined quantities (here u2 and u2_av)
+!--    have to be declared and defined by the user!
+!--    Sample for user-defined output:
+!       CASE ( 'u2' )
+!          IF ( av == 0 )  THEN
+!             DO  i = nxl-1, nxr+1
+!                DO  j = nys-1, nyn+1
+!                   DO  k = nzb, nz_do
+!                      local_pf(i,j,k) = u2(k,j,i)
+!                   ENDDO
+!                ENDDO
+!             ENDDO
+!          ELSE
+!             DO  i = nxl-1, nxr+1
+!                DO  j = nys-1, nyn+1
+!                   DO  k = nzb, nz_do
+!                      local_pf(i,j,k) = u2_av(k,j,i)
+!                   ENDDO
+!                ENDDO
+!             ENDDO
+!          ENDIF
+!
+!          grid = 'zu'
+
+       CASE DEFAULT
+          found = .FALSE.
+
+    END SELECT
+
+
+ END SUBROUTINE user_data_output_3d
+
+
+
+ SUBROUTINE user_3d_data_averaging( mode, variable )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Sum up and time-average user-defined output quantities as well as allocate
+! the array necessary for storing the average.
+!------------------------------------------------------------------------------!
+
+    USE control_parameters
+    USE indices
+    USE user
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  mode, variable
+
+    INTEGER ::  i, j, k
+
+
+    IF ( mode == 'allocate' )  THEN
+
+       SELECT CASE ( TRIM( variable ) )
+
+!
+!--       Uncomment and extend the following lines, if necessary.
+!--       The arrays for storing the user defined quantities (here u2_av) have
+!--       to be declared and defined by the user!
+!--       Sample for user-defined output:
+!          CASE ( 'u2' )
+!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
+!                ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+!             ENDIF
+!             u2_av = 0.0
+
+          CASE DEFAULT
+             CONTINUE
+
+       END SELECT
+
+    ELSEIF ( mode == 'sum' )  THEN
+
+       SELECT CASE ( TRIM( variable ) )
+
+!
+!--       Uncomment and extend the following lines, if necessary.
+!--       The arrays for storing the user defined quantities (here u2 and
+!--       u2_av) have to be declared and defined by the user!
+!--       Sample for user-defined output:
+!          CASE ( 'u2' )
+!             DO  i = nxl-1, nxr+1
+!                DO  j = nys-1, nyn+1
+!                   DO  k = nzb, nzt+1
+!                      u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
+!                   ENDDO
+!                ENDDO
+!             ENDDO
+
+          CASE DEFAULT
+             CONTINUE
+
+       END SELECT
+
+    ELSEIF ( mode == 'average' )  THEN
+
+       SELECT CASE ( TRIM( variable ) )
+
+!
+!--       Uncomment and extend the following lines, if necessary.
+!--       The arrays for storing the user defined quantities (here u2_av) have
+!--       to be declared and defined by the user!
+!--       Sample for user-defined output:
+!          CASE ( 'u2' )
+!             DO  i = nxl-1, nxr+1
+!                DO  j = nys-1, nyn+1
+!                   DO  k = nzb, nzt+1
+!                      u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d )
+!                   ENDDO
+!                ENDDO
+!             ENDDO
+
+       END SELECT
+
+    ENDIF
+
+
+ END SUBROUTINE user_3d_data_averaging
Index: palm/trunk/SOURCE/user_lpm_advec.f90
===================================================================
--- palm/trunk/SOURCE/user_lpm_advec.f90	(revision 4901)
+++ 	(revision )
@@ -1,87 +1,0 @@
-!> @file user_lpm_advec.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! variables commented + statement added to avoid compiler warnings about unused variables
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
-! 211 2008-11-11 04:46:24Z raasch
-! Former file user_interface.f90 split into one file per subroutine
-!
-! Description:
-! ------------
-!> Modification of initial particles by the user.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_lpm_advec( ip, jp, kp )
-
-
-    USE kinds
-
-    USE particle_attributes
-
-    USE user
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  ip  !< index of particle grid box, x-direction
-    INTEGER(iwp) ::  jp  !< index of particle grid box, y-direction
-    INTEGER(iwp) ::  kp  !< index of particle grid box, z-direction
-!    INTEGER(iwp) ::  n   !< particle index
-!    INTEGER(iwp) ::  nb  !< index of sub-box particles are sorted in
-
-!    INTEGER(iwp), DIMENSION(0:7)  ::  start_index !< start particle index for current sub-box
-!    INTEGER(iwp), DIMENSION(0:7)  ::  end_index   !< start particle index for current sub-box
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( ip == 0  .OR.  jp == 0  .OR.  kp == 0 )  CONTINUE
-
-!
-!-- Here the user-defined actions follow
-!   number_of_particles = prt_count(kp,jp,ip)
-!   particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-!
-!   start_index = grid_particles(kp,jp,ip)%start_index
-!   end_index   = grid_particles(kp,jp,ip)%end_index
-!
-!   IF ( number_of_particles <= 0 )  CYCLE
-!   DO  n = 1, number_of_particles
-!   DO  nb = 0, 7
-!      DO  n = start_index(nb), end_index(nb)
-!         particles(n)%xxx =
-!      ENDDO
-!   ENDDO
-
- END SUBROUTINE user_lpm_advec
-
Index: palm/trunk/SOURCE/user_lpm_init.f90
===================================================================
--- palm/trunk/SOURCE/user_lpm_init.f90	(revision 4901)
+++ 	(revision )
@@ -1,79 +1,0 @@
-!> @file user_lpm_init.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! unused variables commented out to avoid compiler warnings
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Corrected "Former revisions" section
-!
-! 211 2008-11-11 04:46:24Z raasch
-! Former file user_interface.f90 split into one file per subroutine
-!
-! Description:
-! ------------
-!> Modification of initial particles by the user.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_lpm_init
-
-    USE indices
-
-    USE kinds
-
-    USE particle_attributes
-
-    USE user
-
-    IMPLICIT NONE
-
-!    INTEGER(iwp) ::  ip  !<
-!    INTEGER(iwp) ::  jp  !<
-!    INTEGER(iwp) ::  kp  !<
-!    INTEGER(iwp) ::  n   !<
-
-!
-!-- Here the user-defined actions follow
-!     DO  ip = nxl, nxr
-!        DO  jp = nys, nyn
-!           DO  kp = nzb+1, nzt
-!              number_of_particles = prt_count(kp,jp,ip)
-!              particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-!              IF ( number_of_particles <= 0 )  CYCLE
-!              DO  n = 1, number_of_particles
-!
-!              ENDDO
-!           ENDDO
-!        ENDDO
-!     ENDDO
-
- END SUBROUTINE user_lpm_init
-
Index: palm/trunk/SOURCE/user_module.f90
===================================================================
--- palm/trunk/SOURCE/user_module.f90	(revision 4901)
+++ 	(revision )
@@ -1,1313 +1,0 @@
-!> @file user_module.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! array size for profiles increased once more
-!
-! 4853 2021-01-25 07:56:09Z raasch
-! array size for profiles increased
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Enable 3D data output also with 64-bit precision
-! 
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-! 
-! 4517 2020-05-03 14:29:30Z raasch
-! added restart with MPI-IO for reading local arrays
-!
-! 4504 2020-04-20 12:11:24Z raasch
-! hint for setting rmask arrays added
-! 
-! 4497 2020-04-15 10:20:51Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4287 2019-11-01 14:50:20Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more; this revision also removes a previous bug which
-! appeared when the namelist has been commented out in the namelist file
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3986 2019-05-20 14:08:14Z Giersch
-! Redundant integration of control parameters in user_rrd_global removed
-!
-! 3911 2019-04-17 12:26:19Z knoop
-! Bugfix: added before_prognostic_equations case in user_actions
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! variables commented + statements added to avoid compiler warnings about unused variables
-!
-! 3767 2019-02-27 08:18:02Z raasch
-! unused variable for file index removed from rrd-subroutines parameter list
-!
-! 3747 2019-02-16 15:15:23Z gronemeier
-! Add routine user_init_arrays
-!
-! 3703 2019-01-29 16:43:53Z knoop
-! An example for a user defined global variable has been added (Giersch)
-!
-! 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 arrays_3d
-
-    USE control_parameters
-
-    USE cpulog
-
-    USE indices
-
-    USE kinds
-
-    USE pegrid
-
-    USE statistics
-
-    USE surface_mod
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  dots_num_palm      !<
-    INTEGER(iwp) ::  dots_num_user = 0  !<
-    INTEGER(iwp) ::  user_idummy        !<
-
-    LOGICAL ::  user_module_enabled = .FALSE.  !<
-
-    REAL(wp) ::  user_rdummy  !<
-
-!
-!-- Sample for user-defined output
-!    REAL(wp) :: global_parameter  !< user defined global parameter
-!
-!    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
-
-    PRIVATE
-
-!
-!- Public functions
-    PUBLIC                                                                                         &
-       user_actions,                                                                               &
-       user_check_data_output,                                                                     &
-       user_check_data_output_pr,                                                                  &
-       user_check_data_output_ts,                                                                  &
-       user_check_parameters,                                                                      &
-       user_data_output_2d,                                                                        &
-       user_data_output_3d,                                                                        &
-       user_define_netcdf_grid,                                                                    &
-       user_header,                                                                                &
-       user_init,                                                                                  &
-       user_init_arrays,                                                                           &
-       user_last_actions,                                                                          &
-       user_parin,                                                                                 &
-       user_rrd_global,                                                                            &
-       user_rrd_local,                                                                             &
-       user_statistics,                                                                            &
-       user_3d_data_averaging,                                                                     &
-       user_wrd_global,                                                                            &
-       user_wrd_local
-
-
-!
-!- Public parameters, constants and initial values
-   PUBLIC                                                                                          &
-      user_module_enabled
-
-    INTERFACE user_parin
-       MODULE PROCEDURE user_parin
-    END INTERFACE user_parin
-
-    INTERFACE user_check_parameters
-       MODULE PROCEDURE user_check_parameters
-    END INTERFACE user_check_parameters
-
-    INTERFACE user_check_data_output_ts
-       MODULE PROCEDURE user_check_data_output_ts
-    END INTERFACE user_check_data_output_ts
-
-    INTERFACE user_check_data_output_pr
-       MODULE PROCEDURE user_check_data_output_pr
-    END INTERFACE user_check_data_output_pr
-
-    INTERFACE user_check_data_output
-       MODULE PROCEDURE user_check_data_output
-    END INTERFACE user_check_data_output
-
-    INTERFACE user_define_netcdf_grid
-       MODULE PROCEDURE user_define_netcdf_grid
-    END INTERFACE user_define_netcdf_grid
-
-    INTERFACE user_init
-       MODULE PROCEDURE user_init
-    END INTERFACE user_init
-
-    INTERFACE user_init_arrays
-       MODULE PROCEDURE user_init_arrays
-    END INTERFACE user_init_arrays
-
-    INTERFACE user_header
-       MODULE PROCEDURE user_header
-    END INTERFACE user_header
-
-    INTERFACE user_actions
-       MODULE PROCEDURE user_actions
-       MODULE PROCEDURE user_actions_ij
-    END INTERFACE user_actions
-
-    INTERFACE user_3d_data_averaging
-       MODULE PROCEDURE user_3d_data_averaging
-    END INTERFACE user_3d_data_averaging
-
-    INTERFACE user_data_output_2d
-       MODULE PROCEDURE user_data_output_2d
-    END INTERFACE user_data_output_2d
-
-    INTERFACE user_data_output_3d
-       MODULE PROCEDURE user_data_output_3d
-    END INTERFACE user_data_output_3d
-
-    INTERFACE user_statistics
-       MODULE PROCEDURE user_statistics
-    END INTERFACE user_statistics
-
-    INTERFACE user_rrd_global
-       MODULE PROCEDURE user_rrd_global_ftn
-       MODULE PROCEDURE user_rrd_global_mpi
-    END INTERFACE user_rrd_global
-
-    INTERFACE user_rrd_local
-       MODULE PROCEDURE user_rrd_local_ftn
-       MODULE PROCEDURE user_rrd_local_mpi
-    END INTERFACE user_rrd_local
-
-    INTERFACE user_wrd_global
-       MODULE PROCEDURE user_wrd_global
-    END INTERFACE user_wrd_global
-
-    INTERFACE user_wrd_local
-       MODULE PROCEDURE user_wrd_local
-    END INTERFACE user_wrd_local
-
-    INTERFACE user_last_actions
-       MODULE PROCEDURE user_last_actions
-    END INTERFACE user_last_actions
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &user_parameters for user module
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_parin
-
-    CHARACTER (LEN=80) ::  line  !< string containing the last line read from namelist file
-
-    INTEGER(iwp) ::  i          !<
-    INTEGER(iwp) ::  io_status  !< status after reading the namelist file
-    INTEGER(iwp) ::  j          !<
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /user_parameters/  data_output_masks_user,                                            &
-                                data_output_pr_user,                                               &
-                                data_output_user,                                                  &
-                                region,                                                            &
-                                switch_off_module
-
-!
-!-- Next statement is to avoid compiler warnings about unused variables. Please remove in case
-!-- that you are using them.
-    IF ( dots_num_palm == 0  .OR.  dots_num_user == 0  .OR.  user_idummy == 0  .OR.                &
-         user_rdummy == 0.0_wp )  CONTINUE
-
-!
-!-- Set revision number of this default interface version. It will be checked within the main
-!-- program (palm). Please change the revision number in case that the current revision does not
-!-- match with previous revisions (e.g. if routines have been added/deleted or if parameter lists
-!-- in subroutines have been changed).
-    user_interface_current_revision = 'r4495'
-
-!
-!-- Position the namelist-file at the beginning (it has already been opened in parin), and try to
-!-- read (find) a namelist named "user_parameters".
-    REWIND ( 11 )
-    READ( 11, user_parameters, IOSTAT=io_status )
-
-!
-!-- Actions depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    User namelist found and correctly read. Set default module switch to true. This activates
-!--    calls of the user-interface subroutines.
-       IF ( .NOT. switch_off_module )  user_module_enabled = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    User namelist was found, but contained errors. Print an error message containing the line
-!--    that caused the problem
-       BACKSPACE( 11 )
-       READ( 11 , '(A)') line
-       CALL parin_fail_message( 'user_parameters', line )
-
-    ENDIF
-
-!
-!-- Determine the number of user-defined profiles and append them to the standard data output
-!-- (data_output_pr)
-    IF ( user_module_enabled )  THEN
-       IF ( data_output_pr_user(1) /= ' ' )  THEN
-          i = 1
-          DO WHILE ( data_output_pr(i) /= ' '  .AND.  i <= 200 )
-             i = i + 1
-          ENDDO
-          j = 1
-          DO WHILE ( data_output_pr_user(j) /= ' '  .AND.  j <= 300 )
-             data_output_pr(i) = data_output_pr_user(j)
-             max_pr_user_tmp   = max_pr_user_tmp + 1
-             i = i + 1
-             j = j + 1
-          ENDDO
-       ENDIF
-    ENDIF
-
-
- END SUBROUTINE user_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check &userpar control parameters and deduce further quantities.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_check_parameters
-
-!
-!-- Here the user may add code to check the validity of further &userpar control parameters or
-!-- deduce further quantities.
-
-
- END SUBROUTINE user_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set module-specific timeseries units and labels
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
-
-    INTEGER(iwp),      INTENT(IN)     ::  dots_max  !<
-    INTEGER(iwp),      INTENT(INOUT)  ::  dots_num  !<
-
-    CHARACTER(LEN=*), DIMENSION(dots_max), INTENT(INOUT)  ::  dots_label  !<
-    CHARACTER(LEN=*), DIMENSION(dots_max), INTENT(INOUT)  ::  dots_unit   !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( dots_num == 0  .OR.  dots_label(1)(1:1) == ' '  .OR.  dots_unit(1)(1:1) == ' ' )  CONTINUE
-
-!
-!-- Sample for user-defined time series:
-!-- For each time series quantity you have to give a label and a unit, which will be used for the
-!-- NetCDF file. They must not contain more than seven characters. The value of dots_num has to be
-!-- increased by the number of new time series quantities. Its old value has to be stored in
-!-- dots_num_palm. See routine user_statistics on how to calculate and output these quantities.
-
-!    dots_num_palm = dots_num
-
-!    dots_num = dots_num + 1
-!    dots_num_user = dots_num_user + 1
-!    dots_label(dots_num) = 'abs_umx'
-!    dots_unit(dots_num)  = 'm/s'
-
-!    dots_num = dots_num + 1
-!    dots_num_user = dots_num_user + 1
-!    dots_label(dots_num) = 'abs_vmx'
-!    dots_unit(dots_num)  = 'm/s'
-
-
- END SUBROUTINE user_check_data_output_ts
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the unit of user defined profile output quantities. For those variables not recognized by the
-!> user, the parameter unit is set to "illegal", which tells the calling routine that the
-!> output variable is not defined and leads to a program abort.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-
-    USE profil_parameter
-
-
-    CHARACTER (LEN=*) ::  unit      !<
-    CHARACTER (LEN=*) ::  variable  !<
-    CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
-
-!    INTEGER(iwp) ::  user_pr_index  !<
-    INTEGER(iwp) ::  var_count      !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( unit(1:1) == ' '  .OR.  dopr_unit(1:1) == ' '  .OR.  var_count == 0 )  CONTINUE
-
-    SELECT CASE ( TRIM( variable ) )
-
-!
-!--    Uncomment and extend the following lines, if necessary.
-!--    Add additional CASE statements depending on the number of quantities for which profiles are
-!--    to be calculated. The respective calculations to be performed have to be added in routine
-!--    user_statistics. The quantities are (internally) identified by a user-profile-number
-!--    (see variable "user_pr_index" below). The first user-profile must be assigned the number
-!--    "pr_palm+1", the second one "pr_palm+2", etc. The respective user-profile-numbers have also
-!--    to be used in routine user_statistics!
-!       CASE ( 'u*v*' )                      ! quantity string as given in data_output_pr_user
-!          user_pr_index = pr_palm + 1
-!          dopr_index(var_count)  = user_pr_index    ! quantities' user-profile-number
-!          dopr_unit = 'm2/s2'  ! quantity unit
-!          unit = dopr_unit
-!          hom(:,2,user_pr_index,:) = SPREAD( zu, 2, statistic_regions+1 )
-!                                            ! grid on which the quantity is defined (use zu or zw)
-!
-
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE user_check_data_output_pr
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the unit of user defined output quantities. For those variables not recognized by the user,
-!> the parameter unit is set to "illegal", which tells the calling routine that the output variable
-!> is not defined and leads to a program abort.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_check_data_output( variable, unit )
-
-
-    CHARACTER (LEN=*) ::  unit      !<
-    CHARACTER (LEN=*) ::  variable  !<
-
-
-    SELECT CASE ( TRIM( variable ) )
-
-!
-!--    Uncomment and extend the following lines, if necessary
-!       CASE ( 'u2' )
-!          unit = 'm2/s2'
-!
-!       CASE ( 'u*v*' )
-!          unit = 'm2/s2'
-!
-       CASE DEFAULT
-          unit = 'illegal'
-
-    END SELECT
-
-
- END SUBROUTINE user_check_data_output
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize user-defined arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_init_arrays
-
-
-!    INTEGER(iwp) :: i       !< loop index
-!    INTEGER(iwp) :: j       !< loop index
-!    INTEGER(iwp) :: region  !< index for loop over statistic regions
-
-!
-!-- Allocate user-defined arrays and set flags for statistic regions.
-!-- Sample for user-defined output
-!    ALLOCATE( u2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!    ALLOCATE( ustvst(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-!
-!-- Example for defining a statistic region:
-!-- ATTENTION: rmask = 0 is required at the ghost boundaries to guarantee correct statistic
-!--            evaluations (otherwise ghost points would be counted twice). This setting has
-!--            already been cared for in routine init_3d_model. Please don't set the ghost points
-!--            /= 0. i.e. run the following loop only over nxl,nxr and nys,nyn.
-!     IF ( statistic_regions >= 1 )  THEN
-!        region = 1
-!
-!        rmask(:,:,region) = 0.0_wp
-!        DO  i = nxl, nxr
-!           IF ( i >= INT( 0.25 * nx ) .AND. i <= INT( 0.75 * nx ) )  THEN
-!              DO  j = nys, nyn
-!                 IF ( i >= INT( 0.25 * ny ) .AND. i <= INT( 0.75 * ny ) )  THEN
-!                    rmask(j,i,region) = 1.0_wp
-!                 ENDIF
-!              ENDDO
-!           ENDIF
-!        ENDDO
-!
-!     ENDIF
-
- END SUBROUTINE user_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Execution of user-defined initializing actions
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_init
-
-
-!    CHARACTER(LEN=20) :: field_char  !<
-!
-!-- Here the user-defined initializing actions follow:
-!-- Sample for user-defined output
-!    ustvst = 0.0_wp
-
-
- END SUBROUTINE user_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Set the grids on which user-defined output quantities are defined. Allowed values for grid_x are
-!> "x" and "xu", for grid_y "y" and "yv", and for grid_z "zu" and "zw".
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
-
-
-    CHARACTER (LEN=*) ::  grid_x     !<
-    CHARACTER (LEN=*) ::  grid_y     !<
-    CHARACTER (LEN=*) ::  grid_z     !<
-    CHARACTER (LEN=*) ::  variable   !<
-
-    LOGICAL ::  found   !<
-
-
-    SELECT CASE ( TRIM( variable ) )
-
-!
-!--    Uncomment and extend the following lines, if necessary
-!       CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' )
-!          found  = .TRUE.
-!          grid_x = 'xu'
-!          grid_y = 'y'
-!          grid_z = 'zu'
-
-!       CASE ( 'u*v*', 'u*v*_xy', 'u*v*_xz', 'u*v*_yz' )
-!          found  = .TRUE.
-!          grid_x = 'x'
-!          grid_y = 'y'
-!          grid_z = 'zu'
-
-       CASE DEFAULT
-          found  = .FALSE.
-          grid_x = 'none'
-          grid_y = 'none'
-          grid_z = 'none'
-
-    END SELECT
-
-
- END SUBROUTINE user_define_netcdf_grid
-
-
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Print a header with user-defined information.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_header( io )
-
-
-    INTEGER(iwp) ::  i   !<
-    INTEGER(iwp) ::  io  !<
-
-!
-!-- If no user-defined variables are read from the namelist-file, no information will be printed.
-    IF ( .NOT. user_module_enabled )  THEN
-       WRITE ( io, 100 )
-       RETURN
-    ENDIF
-
-!
-!-- Printing the information.
-    WRITE ( io, 110 )
-
-    IF ( statistic_regions /= 0 )  THEN
-       WRITE ( io, 200 )
-       DO  i = 0, statistic_regions
-          WRITE ( io, 201 )  i, region(i)
-       ENDDO
-    ENDIF
-
-!
-!-- Format-descriptors
-100 FORMAT (//' *** no user-defined variables found'/)
-110 FORMAT (//1X,78('#') // ' User-defined variables and actions:' /                               &
-            ' -----------------------------------'//)
-200 FORMAT (' Output of profiles and time series for following regions:' /)
-201 FORMAT (4X,'Region ',I1,':   ',A)
-
-
- END SUBROUTINE user_header
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_actions( location )
-
-
-    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 ( 'before_prognostic_equations' )
-!
-!--       Enter actions to be done before all prognostic equations 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 ( 's-tendency' )
-
-
-       CASE DEFAULT
-          CONTINUE
-
-    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 )
-
-
-    CHARACTER(LEN=*) ::  location  !<
-
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-
-!
-!-- Here the user-defined actions follow
-    SELECT CASE ( location )
-
-       CASE ( 'u-tendency' )
-
-!
-!--       Next line is to avoid compiler warning about unused variables. Please remove.
-          IF ( i == 0  .OR.  j == 0 )  CONTINUE
-
-!
-!--       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 ( 's-tendency' )
-
-
-       CASE DEFAULT
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE user_actions_ij
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sum up and time-average user-defined output quantities as well as allocate the array necessary
-!> for storing the average.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_3d_data_averaging( mode, variable )
-
-
-    CHARACTER(LEN=*) ::  mode      !<
-    CHARACTER(LEN=*) ::  variable  !<
-
-!    INTEGER(iwp) ::  i  !<
-!    INTEGER(iwp) ::  j  !<
-!    INTEGER(iwp) ::  k  !<
-
-    IF ( mode == 'allocate' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-!
-!--       Uncomment and extend the following lines, if necessary.
-!--       The arrays for storing the user defined quantities (here u2_av) have to be declared and
-!--       defined by the user!
-!--       Sample for user-defined output:
-!          CASE ( 'u2' )
-!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
-!                ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!             ENDIF
-!             u2_av = 0.0_wp
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'sum' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-!
-!--       Uncomment and extend the following lines, if necessary.
-!--       The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
-!--       and defined by the user!
-!--       Sample for user-defined output:
-!          CASE ( 'u2' )
-!             IF ( ALLOCATED( u2_av ) )  THEN
-!                DO  i = nxlg, nxrg
-!                   DO  j = nysg, nyng
-!                      DO  k = nzb, nzt+1
-!                         u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
-!                      ENDDO
-!                   ENDDO
-!                ENDDO
-!             ENDIF
-
-          CASE DEFAULT
-             CONTINUE
-
-       END SELECT
-
-    ELSEIF ( mode == 'average' )  THEN
-
-       SELECT CASE ( TRIM( variable ) )
-
-!
-!--       Uncomment and extend the following lines, if necessary.
-!--       The arrays for storing the user defined quantities (here u2_av) have to be declared and
-!--       defined by the user!
-!--       Sample for user-defined output:
-!          CASE ( 'u2' )
-!             IF ( ALLOCATED( u2_av ) )  THEN
-!                DO  i = nxlg, nxrg
-!                   DO  j = nysg, nyng
-!                      DO  k = nzb, nzt+1
-!                         u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-!                      ENDDO
-!                   ENDDO
-!                ENDDO
-!             ENDIF
-
-       END SELECT
-
-    ENDIF
-
-
- END SUBROUTINE user_3d_data_averaging
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with indices
-!> (i,j,k) and sets the grid on which it is defined. Allowed values for grid are "zu" and "zw".
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do )
-
-
-    CHARACTER(LEN=*) ::  grid      !<
-    CHARACTER(LEN=*) ::  variable  !<
-
-    INTEGER(iwp) ::  av      !< flag to control data output of instantaneous or time-averaged data
-!    INTEGER(iwp) ::  i       !< grid index along x-direction
-!    INTEGER(iwp) ::  j       !< grid index along y-direction
-!    INTEGER(iwp) ::  k       !< grid index along z-direction
-!    INTEGER(iwp) ::  m       !< running index surface elements
-    INTEGER(iwp) ::  nzb_do  !< lower limit of the domain (usually nzb)
-    INTEGER(iwp) ::  nzt_do  !< upper limit of the domain (usually nzt+1)
-
-    LOGICAL      ::  found  !<
-    LOGICAL      ::  two_d  !< flag parameter that indicates 2D variables (horizontal cross sections)
-
-!    REAL(wp) ::  fill_value = -999.0_wp    !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( av == 0  .OR.  local_pf(nxl,nys,nzb_do) == 0.0_wp  .OR.  two_d )  CONTINUE
-
-
-    found = .TRUE.
-
-    SELECT CASE ( TRIM( variable ) )
-
-!
-!--    Uncomment and extend the following lines, if necessary.
-!--    The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
-!--    and defined by the user!
-!--    Sample for user-defined output:
-!       CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
-!          IF ( av == 0 )  THEN
-!             DO  i = nxl, nxr
-!                DO  j = nys, nyn
-!                   DO  k = nzb_do, nzt_do
-!                      local_pf(i,j,k) = u2(k,j,i)
-!                   ENDDO
-!                ENDDO
-!             ENDDO
-!          ELSE
-!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
-!                ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!                u2_av = REAL( fill_value, KIND = wp )
-!             ENDIF
-!             DO  i = nxl, nxr
-!                DO  j = nys, nyn
-!                   DO  k = nzb_do, nzt_do
-!                      local_pf(i,j,k) = u2_av(k,j,i)
-!                   ENDDO
-!                ENDDO
-!             ENDDO
-!          ENDIF
-!
-!          grid = 'zu'
-!
-!--    In case two-dimensional surface variables are output, the user has to access related
-!--    surface-type. Uncomment and extend following lines appropriately (example output of vertical
-!--    surface momentum flux of u-component). Please note, surface elements can be distributed over
-!--    several data types, depending on their respective surface properties.
-!       CASE ( 'usws_xy' )
-!          IF ( av == 0 )  THEN
-!
-!--           Horizontal default-type surfaces
-!             DO  m = 1, surf_def_h(0)%ns
-!                i = surf_def_h(0)%i(m)
-!                j = surf_def_h(0)%j(m)
-!                local_pf(i,j,1) = surf_def_h(0)%usws(m)
-!             ENDDO
-!
-!--           Horizontal natural-type surfaces
-!             DO  m = 1, surf_lsm_h%ns
-!                i = surf_lsm_h%i(m)
-!                j = surf_lsm_h%j(m)
-!                local_pf(i,j,1) = surf_lsm_h%usws(m)
-!             ENDDO
-!
-!--           Horizontal urban-type surfaces
-!             DO  m = 1, surf_usm_h%ns
-!                i = surf_usm_h%i(m)
-!                j = surf_usm_h%j(m)
-!                local_pf(i,j,1) = surf_usm_h%usws(m)
-!             ENDDO
-!          ENDIF
-!
-!          grid = 'zu'
-!--
-
-
-       CASE DEFAULT
-          found = .FALSE.
-          grid  = 'none'
-
-    END SELECT
-
-
- END SUBROUTINE user_data_output_2d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with indices
-!> (i,j,k).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
-
-
-    CHARACTER(LEN=*) ::  variable  !<
-
-    INTEGER(iwp) ::  av     !<
-!    INTEGER(iwp) ::  i      !<
-!    INTEGER(iwp) ::  j      !<
-!    INTEGER(iwp) ::  k      !<
-    INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
-    INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
-
-    LOGICAL      ::  found  !<
-
-!    REAL(wp) ::  fill_value = -999.0_wp  !< value for the _FillValue attribute
-
-    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( av == 0  .OR.  local_pf(nxl,nys,nzb_do) == 0.0_wp )  CONTINUE
-
-
-    found = .TRUE.
-
-    SELECT CASE ( TRIM( variable ) )
-
-!
-!--    Uncomment and extend the following lines, if necessary.
-!--    The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
-!--    and defined by the user!
-!--    Sample for user-defined output:
-!       CASE ( 'u2' )
-!          IF ( av == 0 )  THEN
-!             DO  i = nxl, nxr
-!                DO  j = nys, nyn
-!                   DO  k = nzb_do, nzt_do
-!                      local_pf(i,j,k) = u2(k,j,i)
-!                   ENDDO
-!                ENDDO
-!             ENDDO
-!          ELSE
-!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
-!                ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!                u2_av = REAL( fill_value, KIND = wp )
-!             ENDIF
-!             DO  i = nxl, nxr
-!                DO  j = nys, nyn
-!                   DO  k = nzb_do, nzt_do
-!                      local_pf(i,j,k) = u2_av(k,j,i)
-!                   ENDDO
-!                ENDDO
-!             ENDDO
-!          ENDIF
-!
-
-       CASE DEFAULT
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE user_data_output_3d
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of user-defined statistics, i.e. horizontally averaged profiles and time series.
-!> This routine is called for every statistic region sr defined by the user, but at least for the
-!> region "total domain" (sr=0). See section 3.5.4 on how to define, calculate, and output user
-!> defined quantities.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_statistics( mode, sr, tn )
-
-
-    CHARACTER(LEN=*) ::  mode  !<
-!    INTEGER(iwp) ::  i   !<
-!    INTEGER(iwp) ::  j   !<
-!    INTEGER(iwp) ::  k   !<
-    INTEGER(iwp) ::  sr  !<
-    INTEGER(iwp) ::  tn  !<
-
-!    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ts_value_l  !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    IF ( sr == 0  .OR.  tn == 0 )  CONTINUE
-
-    IF ( mode == 'profiles' )  THEN
-
-!
-!--    Sample on how to calculate horizontally averaged profiles of user-defined quantities. Each
-!--    quantity is identified by the index "pr_palm+#" where "#" is an integer starting from 1.
-!--    These user-profile-numbers must also be assigned to the respective strings given by
-!--    data_output_pr_user in routine user_check_data_output_pr.
-!       !$OMP DO
-!       DO  i = nxl, nxr
-!          DO  j = nys, nyn
-!             DO  k = nzb+1, nzt
-!!
-!!--             Sample on how to calculate the profile of the resolved-scale horizontal momentum
-!!--             flux u*v*
-!                sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) +                                  &
-!                                         ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) *  &
-!                                         ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) *  &
-!                                         rmask(j,i,sr) * MERGE( 1.0_wp, 0.0_wp,                    &
-!                                         BTEST( wall_flags_total_0(k,j,i), 0 ) )
-!!
-!!--             Further profiles can be defined and calculated by increasing the second index of
-!!--             array sums_l (replace ... appropriately)
-!                sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ...   * rmask(j,i,sr)
-!             ENDDO
-!          ENDDO
-!       ENDDO
-
-    ELSEIF ( mode == 'time_series' )  THEN
-
-
-!       ALLOCATE ( ts_value_l(dots_num_user) )
-!
-!--    Sample on how to add values for the user-defined time series quantities.
-!--    These have to be defined before in routine user_init. This sample creates two time series for
-!--    the absolut values of the horizontal velocities u and v.
-!       ts_value_l = 0.0_wp
-!       ts_value_l(1) = ABS( u_max )
-!       ts_value_l(2) = ABS( v_max )
-!
-!--     Collect / send values to PE0, because only PE0 outputs the time series.
-!--     CAUTION: Collection is done by taking the sum over all processors. You may have to normalize
-!--              this sum, depending on the quantity that you like to calculate. For serial runs,
-!--              nothing has to be done.
-!--     HINT: If the time series value that you are calculating has the same value on all PEs, you
-!--           can omit the MPI_ALLREDUCE call and assign ts_value(dots_num_palm+1:,sr) = ts_value_l directly.
-!#if defined( __parallel )
-!       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-!       CALL MPI_ALLREDUCE( ts_value_l(1), ts_value(dots_num_palm+1,sr), dots_num_user, MPI_REAL,   &
-!                           MPI_MAX, comm2d, ierr )
-!#else
-!       ts_value(dots_num_palm+1:dots_num_palm+dots_num_user,sr) = ts_value_l
-!#endif
-
-    ENDIF
-
- END SUBROUTINE user_statistics
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_rrd_global_ftn( found )
-
-
-    LOGICAL, INTENT(OUT)  ::  found  !<
-
-
-    found = .TRUE.
-
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'global_paramter' )
-!          READ ( 13 )  global_parameter
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE user_rrd_global_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_rrd_global_mpi
-
-!    USE restart_data_mpi_io_mod,                                                                   &
-!        ONLY:  rrd_mpi_io
-
-!    CALL rrd_mpi_io( 'global_parameter', global_parameter )
-    CONTINUE
-
- END SUBROUTINE user_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (Fortran binary format).
-!> Subdomain
-!> index limits on file are given by nxl_on_file, etc. Indices nxlc, etc. indicate the range of
-!> gridpoints to be mapped from the subdomain on file (f) to the subdomain of the current PE (c).
-!> They have been calculated in routine rrd_local.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,   &
-                                nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
-
-
-    INTEGER(iwp) ::  idum            !<
-    INTEGER(iwp) ::  k               !<
-    INTEGER(iwp) ::  nxlc            !<
-    INTEGER(iwp) ::  nxlf            !<
-    INTEGER(iwp) ::  nxl_on_file     !<
-    INTEGER(iwp) ::  nxrc            !<
-    INTEGER(iwp) ::  nxrf            !<
-    INTEGER(iwp) ::  nxr_on_file     !<
-    INTEGER(iwp) ::  nync            !<
-    INTEGER(iwp) ::  nynf            !<
-    INTEGER(iwp) ::  nyn_on_file     !<
-    INTEGER(iwp) ::  nysc            !<
-    INTEGER(iwp) ::  nysf            !<
-    INTEGER(iwp) ::  nys_on_file     !<
-
-    LOGICAL, INTENT(OUT)  ::  found  !<
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d  !<
-
-!
-!-- Next line is to avoid compiler warning about unused variables. Please remove.
-    idum = k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf +                             &
-           INT( tmp_3d(nzb,nys_on_file,nxl_on_file) )
-
-!
-!-- Here the reading of user-defined restart data follows:
-!-- Sample for user-defined output
-
-    found = .TRUE.
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'u2_av' )
-!          IF ( .NOT. ALLOCATED( u2_av ) )  THEN
-!               ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!          ENDIF
-!          IF ( k == 1 )  READ ( 13 )  tmp_3d
-!             u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
-!             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-!
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
- END SUBROUTINE user_rrd_local_ftn
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific local restart data arrays (MPI-IO).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_rrd_local_mpi
-
-!    USE restart_data_mpi_io_mod,                                                                   &
-!        ONLY:  rd_mpi_io_check_array, rrd_mpi_io
-
-!    CALL rd_mpi_io_check_array( 'u2_av' , found = array_found )
-!    IF ( array_found )  THEN
-!       IF ( .NOT. ALLOCATED( u2_av ) )  ALLOCATE( u2_av(nysg:nyng,nxlg:nxrg) )
-!       CALL rrd_mpi_io( 'rad_u2_av', rad_u2_av )
-!    ENDIF
-
-    CONTINUE
-
- END SUBROUTINE user_rrd_local_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Writes global and user-defined restart data into binary file(s) for restart runs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_wrd_global
-
-!    USE restart_data_mpi_io_mod,                                                                   &
-!        ONLY:  wrd_mpi_io
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-!       CALL wrd_write_string( 'global_parameter' )
-!       WRITE ( 14 )  global_parameter
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-!    CALL rrd_mpi_io( 'global_parameter', global_parameter )
-
-    ENDIF
-
- END SUBROUTINE user_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Writes processor specific and user-defined restart data into binary file(s) for restart runs.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_wrd_local
-
-!    USE restart_data_mpi_io_mod,                                                                   &
-!        ONLY:  wrd_mpi_io
-
-!
-!-- Here the user-defined actions at the end of a job follow.
-!-- Sample for user-defined output:
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-!       IF ( ALLOCATED( u2_av ) )  THEN
-!          CALL wrd_write_string( 'u2_av' )
-!          WRITE ( 14 )  u2_av
-!       ENDIF
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-!       IF ( ALLOCATED( u2_av ) )  CALL wrd_mpi_io( 'u2_av', u2_av )
-
-    ENDIF
-
- END SUBROUTINE user_wrd_local
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Execution of user-defined actions at the end of a job.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_last_actions
-
-!
-!-- Here the user-defined actions at the end of a job might follow.
-
-
- END SUBROUTINE user_last_actions
-
- END MODULE user
Index: palm/trunk/SOURCE/user_spectra.f90
===================================================================
--- palm/trunk/SOURCE/user_spectra.f90	(revision 4901)
+++ 	(revision )
@@ -1,116 +1,0 @@
-!> @file user_spectra.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 3768 2019-02-27 14:35:58Z raasch
-! variables removed + statement added to avoid compiler warnings about unused variables
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Renamed output variables
-!
-! 211 2008-11-11 04:46:24Z raasch
-! Former file user_interface.f90 split into one file per subroutine
-!
-! Description:
-! ------------
-!> Calculation of user-defined spectra.
-!> See section 3.5.4 on how to define, calculate, and output user defined quantities.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE user_spectra( mode, m, pr )
-
-
-    USE arrays_3d
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-    USE spectra_mod
-
-    USE statistics
-
-    USE user
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*) ::  mode  !<
-
-    INTEGER(iwp) ::  m   !<
-    INTEGER(iwp) ::  pr  !<
-
-
-!
-!-- Next line is to avoid compiler warning about unused variable. Please remove.
-    IF ( pr == 0 )  CONTINUE
-
-!
-!-- Sample on how to calculate spectra of user-defined quantities. Each quantity is identified by
-!-- the corresponding user profile index "pr_palm+#" where "#" is an integer starting from 1. These
-!-- user-profile-numbers must also be assigned to the respective strings given by
-!-- data_output_pr_user in routine user_check_data_output_pr.
-    IF ( mode == 'preprocess' )  THEN
-
-       SELECT CASE ( TRIM( data_output_sp(m) ) )
-
-          CASE ( 'u', 'v', 'w', 'theta', 'q', 's' )
-!--          Not allowed here since these are the standard quantities used in preprocess_spectra.
-
-!          CASE ( 'u*v*' )
-!             pr = pr_palm+1
-!             d(nzb+1:nzt,nys:nyn,nxl:nxr) = ustvst(nzb+1:nzt,nys:nyn,nxl:nxr)
-
-          CASE DEFAULT
-             message_string = 'Spectra of ' // TRIM( data_output_sp(m) ) // ' can not be calculated'
-             CALL message( 'user_spectra', 'UI0010', 0, 1, 0, 6, 0 )
-
-       END SELECT
-
-    ELSEIF ( mode == 'data_output' )  THEN
-
-       SELECT CASE ( TRIM( data_output_sp(m) ) )
-
-          CASE ( 'u', 'v', 'w', 'theta', 'q', 's' )
-!--          Not allowed here since these are the standard quantities used in data_output_spectra.
-
-!          CASE ( 'u*v*' )
-!             pr = 6
-
-          CASE DEFAULT
-             message_string = 'Spectra of ' // TRIM( data_output_sp(m) ) // ' are not defined'
-             CALL message( 'user_spectra', 'UI0011', 0, 0, 0, 6, 0 )
-
-          END SELECT
-
-    ENDIF
-
- END SUBROUTINE user_spectra
-
Index: palm/trunk/SOURCE/vdi_internal_controls.f90
===================================================================
--- palm/trunk/SOURCE/vdi_internal_controls.f90	(revision 4901)
+++ 	(revision )
@@ -1,1053 +1,0 @@
-!> @file vdi_internal_controls.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! bugfix: mpi double precision replaced by mpi real
-! 
-! 4497 2020-04-15 10:20:51Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! missing preprocessor directive added
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! added "Authors" section
-!
-! 4175 2019-08-20 13:19:16Z gronemeier
-! bugfix: removed unused variables
-!
-! 4173 2019-08-20 12:04:06Z weniger
-! Initial version
-!
-! Authors:
-! --------
-! @author Viola Weniger
-!
-!
-! Description:
-! ------------
-!> According to VDI Guideline 3783 Part 9, internal assessment has to be carried out within the
-!> program for the model to be considered as evaluated.
-!--------------------------------------------------------------------------------------------------!
- MODULE vdi_internal_controls
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzw,                                                                                &
-               pt,                                                                                 &
-               q,                                                                                  &
-               u,                                                                                  &
-               u_p,                                                                                &
-               v,                                                                                  &
-               w
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_dirichlet_l,                                                                     &
-               bc_dirichlet_n,                                                                     &
-               bc_dirichlet_r,                                                                     &
-               bc_dirichlet_s,                                                                     &
-               bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               end_time,                                                                           &
-               humidity,                                                                           &
-               message_string,                                                                     &
-               neutral,                                                                            &
-               time_since_reference_point
-
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               ny,                                                                                 &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               wall_flags_total_0
-
-    USE kinds
-
-#if defined( __parallel )
-    USE pegrid,                                                                                    &
-        ONLY:  collective_wait,                                                                    &
-               comm2d,                                                                             &
-               ierr,                                                                               &
-               MPI_REAL,                                                                           &
-               MPI_INTEGER,                                                                        &
-               MPI_MAX,                                                                            &
-               MPI_SUM,                                                                            &
-               myid
-#else
-    USE pegrid,                                                                                    &
-        ONLY:  myid
-#endif
-
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx,                                                                                 &
-               dy
-
-    USE pmc_interface,                                                                             &
-        ONLY: nested_run
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  internal_count = 0  !< counts calls to this module
-
-    INTERFACE vdi_2_deltat_wave
-       MODULE PROCEDURE vdi_2_deltat_wave
-    END INTERFACE vdi_2_deltat_wave
-
-    INTERFACE vdi_standard_differences
-       MODULE PROCEDURE vdi_standard_differences
-    END INTERFACE vdi_standard_differences
-
-    INTERFACE vdi_domain_averages
-       MODULE PROCEDURE vdi_domain_averages
-    END INTERFACE vdi_domain_averages
-
-    INTERFACE vdi_plausible_values
-       MODULE PROCEDURE vdi_plausible_values
-    END INTERFACE vdi_plausible_values
-
-    INTERFACE vdi_actions
-       MODULE PROCEDURE vdi_actions
-    END INTERFACE vdi_actions
-
-    INTERFACE vdi_conservation_of_mass
-       MODULE PROCEDURE vdi_conservation_of_mass
-    END INTERFACE vdi_conservation_of_mass
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public functions
-    PUBLIC                                                                                         &
-       vdi_actions
-
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!> @todo Add proper description
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vdi_actions( location )
-
-    CHARACTER(LEN=*), INTENT(IN) ::  location  !< call location string
-
-
-    SELECT CASE ( location )
-
-       CASE ( 'after_integration' )
-
-          internal_count = internal_count + 1
-
-          CALL vdi_2_deltat_wave
-
-          CALL vdi_standard_differences
-
-          CALL vdi_domain_averages
-
-          CALL vdi_conservation_of_mass
-
-          CALL vdi_plausible_values
-
-       CASE DEFAULT
-
-          CONTINUE
-
-    END SELECT
-
- END SUBROUTINE vdi_actions
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> At a control grid point in the interior of the model domain, 2 * delta t waves are not to be
-!> generated with increasing simulation time.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vdi_2_deltat_wave
-
-    INTEGER(iwp) ::  count_wave = 0  !< counts the number of consecutive waves
-    INTEGER(iwp) ::  count_time = 0  !< counter, so that the waves follow one another without gaps
-    INTEGER(iwp) ::  cgp_i      = 0  !< x coordinate of the control grid point for testing 2 delta t waves
-    INTEGER(iwp) ::  cgp_j      = 0  !< y coordinate of the control grid point for testing 2 delta t waves
-    INTEGER(iwp) ::  cgp_k      = 0  !< z coordinate of the control grid point for testing 2 delta t waves
-
-    INTEGER(iwp), DIMENSION(4) ::  sig_arr = (/ 0, 0, 0, 0 /)  !< indicates an increase(1) or a decrease (0)
-                                                               !< of u in the last four time steps
-
-    REAL(wp) ::  random  !< random number
-
-!
-!-- Defining the control grid point
-    IF ( internal_count == 1 )  THEN
-       cgp_i = INT( nxl + ( nxr - nxl ) / 2 )
-       cgp_j = INT( nys + ( nyn - nys ) / 2 )
-       cgp_k = INT( nzt / 2 )
-!
-!--    If the grid point lies in a building, a new point is defined
-       DO WHILE ( .NOT. BTEST( wall_flags_total_0(cgp_k,cgp_j,cgp_i), 1 ) )
-          CALL RANDOM_NUMBER( random )
-          cgp_k = cgp_k + FLOOR( ( nzt - cgp_k ) * random )   !< Random number upon cgp_k
-!
-!--       If there is topography in the entire grid column, a new x coordinate is chosen
-          IF ( cgp_k >= nzt -1 )  THEN
-             CALL RANDOM_NUMBER( random )
-             cgp_i = nxl + FLOOR( ( nxr + 1 - nxl ) * random )
-             cgp_k = INT( nzt / 2 )
-          ENDIF
-       ENDDO
-    ENDIF
-
-    CALL testing_2_deltat_wave( u_p(cgp_k,cgp_j,cgp_i), u(cgp_k,cgp_j,cgp_i),                      &
-                                sig_arr, count_wave, count_time )
-
- END SUBROUTINE vdi_2_deltat_wave
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> In this subroutine the quantity quant is tested for 2 delta t waves. For this, the size must have
-!> a wave-shaped course over 4*4 time steps and the amplitude of the wave has to be greater than the
-!> change of quant with increasing time.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE testing_2_deltat_wave( quant_p_r, quant_r, sig_arr, count_wave, count_time )
-
-    INTEGER(iwp), INTENT(INOUT) ::  count_wave        !< counts the number of consecutive waves
-    INTEGER(iwp), INTENT(INOUT) ::  count_time        !< counter, so that the waves follow one another without gaps
-    INTEGER(iwp), PARAMETER     ::  number_wave = 10  !< number of consecutive waves that are not allowed
-
-    INTEGER(iwp), DIMENSION(4), INTENT(INOUT) ::  sig_arr  !< indicates an increase (1) or a decrease (0) of
-                                                           !> quantity quant in the last four time steps
-
-    REAL(wp), INTENT(IN) ::  quant_p_r           !< quantity from the previous time step as a real
-    REAL(wp), INTENT(IN) ::  quant_r             !< quantity as a real
-    REAL(wp)             ::  quant_rel = 0.0_wp  !< rel. change of the quantity to the previous time step
-
-
-
-
-    IF ( quant_p_r - quant_r > 0.0 )  THEN
-       sig_arr(4) = 0
-    ELSE
-       sig_arr(4) = 1
-    ENDIF
-
-    quant_rel = ABS( ( quant_p_r - quant_r ) / quant_p_r )
-
-!
-!-- With this criterion 2 delta t waves are detected if the amplitude of the wave is greater than
-!-- the change of quant with increasing time
-    IF ( ALL( sig_arr(1:4) == (/ 1, 0, 1, 0 /) )  .AND.  quant_rel > 0.01 )  THEN
-
-       count_wave = count_wave + 1
-
-       IF ( count_wave == number_wave  .AND.  count_time == 4 )  THEN
-          message_string = '2 deltat waves are generated '
-          CALL message( 'vdi_2_deltat_wave', 'PA0669', 2, 2, myid, 6, 0 )
-       ENDIF
-
-       count_time = 0
-
-    ELSE
-
-       IF ( count_time >= 4 )  THEN
-          count_wave = 0
-       ENDIF
-
-    ENDIF
-
-    sig_arr(1) = sig_arr(2)
-    sig_arr(2) = sig_arr(3)
-    sig_arr(3) = sig_arr(4)
-
-    count_time = count_time + 1
-
- END SUBROUTINE testing_2_deltat_wave
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> In this internal assessment the maxima of standard differences of the meteorological variables,
-!> computed layer by layer will be checked. The maxima should not remain at the open edges of the
-!> model or travel from there into the interior of the domain with increasing simulation time.
-!> @todo try to reduce repeating code.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vdi_standard_differences
-
-    INTEGER(iwp) ::  position_pt_deviation    = 0  !< position of the maximum of the standard deviation of pt
-    INTEGER(iwp) ::  position_pt_deviation_p  = 0  !< position of the maximum of the standard deviation of pt
-                                                   !< to the previous time step
-    INTEGER(iwp) ::  position_pt_deviation_pp = 0  !< position of the maximum of the standard deviation of pt two time steps ago
-    INTEGER(iwp) ::  position_q_deviation     = 0  !< position of the maximum of the standard deviation of q
-    INTEGER(iwp) ::  position_q_deviation_p   = 0  !< position of the maximum of the standard deviation of q to
-                                                   !< the previous time step
-    INTEGER(iwp) ::  position_q_deviation_pp  = 0  !< position of the maximum of the standard deviation of q two time steps ago
-    INTEGER(iwp) ::  position_u_deviation     = 0  !< position of the maximum of the standard deviation of u
-    INTEGER(iwp) ::  position_u_deviation_p   = 0  !< position of the maximum of the standard deviation of u to
-                                                   !< the previous time step
-    INTEGER(iwp) ::  position_u_deviation_pp  = 0  !< position of the maximum of the standard deviation of u two time steps ago
-    INTEGER(iwp) ::  position_v_deviation     = 0  !< position of the maximum of the standard deviation of v
-    INTEGER(iwp) ::  position_v_deviation_p   = 0  !< position of the maximum of the standard deviation of v
-                                                   !< to the previous time step
-    INTEGER(iwp) ::  position_v_deviation_pp  = 0  !< position of the maximum of the standard deviation of v two time steps ago
-    INTEGER(iwp) ::  position_w_deviation     = 0  !< position of the maximum of the standard deviation of w
-    INTEGER(iwp) ::  position_w_deviation_p   = 0  !< position of the maximum of the standard deviation of w
-                                                   !< to the previous time step
-    INTEGER(iwp) ::  position_w_deviation_pp  = 0  !< position of the maximum of the standard deviation of w two time steps ago
-
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  pt_deviation  !< standard deviation of pt depending on k
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  q_deviation   !< standard deviation of q depending on k
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  u_deviation   !< standard deviation of u depending on k
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  v_deviation   !< standard deviation of v depending on k
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  w_deviation   !< standard deviation of w depending on k
-
-!
-!-- Calculation of the standard deviation of u
-    CALL calc_standard_deviation( u, u_deviation, 1 )
-
-!
-!-- Determination of the position of the maximum
-    position_u_deviation = MAXLOC( u_deviation, DIM = 1 )
-
-!
-!-- Check the position of the maximum of the standard deviation of u
-    IF ( internal_count > 2 )  THEN
-       CALL check_position( position_u_deviation, position_u_deviation_p, position_u_deviation_pp )
-    ENDIF
-
-    position_u_deviation_pp = position_u_deviation_p
-    position_u_deviation_p = position_u_deviation
-
-!
-!-- Calculation of the standard deviation of v
-    CALL calc_standard_deviation( v, v_deviation, 2 )
-
-!
-!-- Determination of the position of the maximum
-    position_v_deviation = MAXLOC( v_deviation, DIM = 1 )
-
-!
-!-- Check the position of the maximum of the standard deviation of v
-    IF ( internal_count > 2 )  THEN
-       CALL check_position( position_v_deviation, position_v_deviation_p, position_v_deviation_pp )
-    ENDIF
-
-   position_v_deviation_pp = position_v_deviation_p
-   position_v_deviation_p = position_v_deviation
-
-!
-!-- Calculation of the standard deviation of w
-    CALL calc_standard_deviation( w, w_deviation, 3 )
-
-!
-!-- Determination of the position of the maximum
-    position_w_deviation = MAXLOC( w_deviation, DIM = 1 )
-
-!
-!-- Check the position of the maximum of the standard deviation of w
-    IF ( internal_count > 2 )  THEN
-       CALL check_position( position_w_deviation, position_w_deviation_p, position_w_deviation_pp )
-    ENDIF
-
-    position_w_deviation_pp = position_w_deviation_p
-    position_w_deviation_p = position_w_deviation
-
-
-!
-!-- Calculation of the standard deviation of pt
-    IF ( .NOT. neutral )  THEN
-       CALL calc_standard_deviation( pt, pt_deviation, 0 )
-!
-!--    Determination of the position of the maximum
-       position_pt_deviation = MAXLOC( pt_deviation, DIM = 1 )
-
-!
-!--    Check the position of the maximum of the standard deviation of pt
-       IF ( internal_count > 2 )  THEN
-          CALL check_position( position_pt_deviation,                                              &
-                               position_pt_deviation_p,                                            &
-                               position_pt_deviation_pp )
-       ENDIF
-
-       position_pt_deviation_pp = position_pt_deviation_p
-       position_pt_deviation_p = position_pt_deviation
-
-    ENDIF
-
-!
-!-- Calculation of the standard deviation of q
-    IF ( humidity )  THEN
-       CALL calc_standard_deviation( q, q_deviation, 0 )
-
-!
-!--    Determination of the position of the maximum
-       position_q_deviation = MAXLOC( q_deviation, DIM = 1 )
-
-!
-!--    Check the position of the maximum of the standard deviation of q
-       IF ( internal_count > 2 )  THEN
-          CALL check_position( position_q_deviation,                                               &
-                               position_q_deviation_p,                                             &
-                               position_q_deviation_pp )
-       ENDIF
-
-       position_q_deviation_pp = position_q_deviation_p
-       position_q_deviation_p = position_q_deviation
-
-    ENDIF
-
- END SUBROUTINE vdi_standard_differences
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of the standard deviation
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_standard_deviation( quant, std_deviation, quant_type )
-
-    INTEGER(iwp)             ::  i           !< loop index
-    INTEGER(iwp)             ::  j           !< loop index
-    INTEGER(iwp)             ::  k           !< loop index
-    INTEGER(iwp), INTENT(IN) ::  quant_type  !< bit position (1 for u, 2 for v, 3 for w and 0 for scalar)
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1) ::  count_2d_l  !< counter for averaging (local)
-    INTEGER(iwp), DIMENSION(nzb:nzt+1) ::  count_2d    !< counter for averaging
-
-    REAL(wp) ::  flag  !< flag indicating atmosphere (1) or wall (0) grid point
-
-    REAL(wp), DIMENSION(nzb:nzt+1)              ::  quant_av_k_l     !< Mean of the quantity quant depending on k (local)
-    REAL(wp), DIMENSION(nzb:nzt+1)              ::  quant_av_k       !< Mean of the quantity quant depending on k
-    REAL(wp), DIMENSION(nzb:nzt+1), INTENT(OUT) ::  std_deviation    !< standard deviation of quant
-    REAL(wp), DIMENSION(nzb:nzt+1)              ::  std_deviation_l  !< standard deviation of quant (local)
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  quant !< Quantity
-
-!
-!-- Calculation of the standard deviation
-    quant_av_k_l    = 0.0_wp
-    quant_av_k      = 0.0_wp
-    std_deviation   = 0.0_wp
-    std_deviation_l = 0.0_wp
-!
-!-- Average
-    count_2d_l = 0
-    count_2d   = 0
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt+1
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), quant_type ) )
-             quant_av_k_l(k) = quant_av_k_l(k) + quant(k,j,i) * flag
-             count_2d_l(k)   = count_2d_l(k) + INT( flag, KIND = iwp )
-          ENDDO
-       ENDDO
-    ENDDO
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( quant_av_k_l, quant_av_k, nzt+1 - nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
-
-    CALL MPI_ALLREDUCE( count_2d_l, count_2d, nzt+1 - nzb+1, MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-    quant_av_k = quant_av_k_l
-    count_2d   = count_2d_l
-#endif
-
-    DO  k = nzb+1, nzt+1
-       quant_av_k(k) = quant_av_k(k) / REAL( count_2d(k), KIND = wp )
-    ENDDO
-
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt+1
-             std_deviation_l(k) = std_deviation_l(k)                                               &
-                                + ( quant(k,j,i) - quant_av_k(k) )**2                              &
-                                * MERGE( 1.0_wp, 0.0_wp,                                           &
-                                  BTEST( wall_flags_total_0(k,j,i), quant_type ) )
-          ENDDO
-       ENDDO
-    ENDDO
-
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( std_deviation_l, std_deviation, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    std_deviation = std_deviation_l
-#endif
-
-    DO  k = nzb+1, nzt+1
-       std_deviation(k) = SQRT( std_deviation(k) / REAL( count_2d(k), KIND = wp ) )
-    ENDDO
-
- END SUBROUTINE calc_standard_deviation
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Tests for the position of the maxima of the standard deviation. If the maxima remain at the open
-!> edges of the model or travel from the open edges into the interior of the domain with increasing
-!> simulation time, the simulation should be aborted.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE check_position( position_std_deviation, position_std_deviation_p, &
-                            position_std_deviation_pp )
-
-    INTEGER(iwp), INTENT(IN) ::  position_std_deviation     !< position of the maximum of the std
-    INTEGER(iwp), INTENT(IN) ::  position_std_deviation_p   !< previous position of std-max
-    INTEGER(iwp), INTENT(IN) ::  position_std_deviation_pp  !< prev. prev. position of std-max
-
-
-    IF ( position_std_deviation == nzt    .AND.                                                    &
-         position_std_deviation_p == nzt  .AND.                                                    &
-         position_std_deviation_pp == nzt       )  THEN
-       message_string = 'The maxima of the standard deviation' //                                  &
-                        'remain at the open edges of the model.'
-       CALL message( 'vdi_standard_differences', 'PA0663', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( position_std_deviation == nzt-2    .AND.                                                  &
-         position_std_deviation_p == nzt-1  .AND.                                                  &
-         position_std_deviation_pp == nzt         )  THEN
-       message_string = 'The maxima of the standard deviation travel ' //                          &
-                        'from the open edges into the interior ' //                                &
-                        'of the domain with increasing simulation time.'
-       CALL message( 'vdi_standard_differences', 'PA0664', 1, 2, 0, 6, 0 )
-    ENDIF
-
- END SUBROUTINE check_position
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> In this control it will be checked, if the means of the meteorological variables over the model
-!> grid are not to exhibit 2 delta t waves or monotonic increase or decrease with increasing
-!> simulation time.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vdi_domain_averages
-
-    INTEGER(iwp) ::  count_time_u  = 0  !< counter, so that the waves of u follow each other without gaps
-    INTEGER(iwp) ::  count_time_v  = 0  !< counter, so that the waves of v follow each other without gaps
-    INTEGER(iwp) ::  count_time_w  = 0  !< counter, so that the waves of w follow each other without gaps
-    INTEGER(iwp) ::  count_time_q  = 0  !< counter, so that the waves of q follow each other without gaps
-    INTEGER(iwp) ::  count_time_pt = 0  !< counter, so that the waves of pt follow each other without gaps
-    INTEGER(iwp) ::  count_wave_u  = 0  !< counts the number of consecutive waves of u
-    INTEGER(iwp) ::  count_wave_v  = 0  !< counts the number of consecutive waves of v
-    INTEGER(iwp) ::  count_wave_w  = 0  !< counts the number of consecutive waves of w
-    INTEGER(iwp) ::  count_wave_q  = 0  !< counts the number of consecutive waves of q
-    INTEGER(iwp) ::  count_wave_pt = 0  !< counts the number of consecutive waves of pt
-    INTEGER(iwp) ::  mono_count_u  = 0  !< counter for monotonic decrease or increase of u
-    INTEGER(iwp) ::  mono_count_v  = 0  !< counter for monotonic decrease or increase of v
-    INTEGER(iwp) ::  mono_count_w  = 0  !< counter for monotonic decrease or increase of w
-    INTEGER(iwp) ::  mono_count_q  = 0  !< counter for monotonic decrease or increase of q
-    INTEGER(iwp) ::  mono_count_pt = 0  !< counter for monotonic decrease or increase of pt
-
-    INTEGER(iwp), DIMENSION(4) ::  sig_u_arr = (/ 0, 0, 0, 0/)   !< indicates an increase(1) or a decrease (0)
-                                                                 !< of u in the last four time steps
-    INTEGER(iwp), DIMENSION(4) ::  sig_v_arr = (/ 0, 0, 0, 0/)   !< indicates an increase(1) or a decrease (0)
-                                                                 !< of v in the last four time steps
-    INTEGER(iwp), DIMENSION(4) ::  sig_w_arr = (/ 0, 0, 0, 0/)   !< indicates an increase(1) or a decrease (0)
-                                                                 !< of w in the last four time steps
-    INTEGER(iwp), DIMENSION(4) ::  sig_q_arr = (/ 0, 0, 0, 0/)   !< indicates an increase(1) or a decrease (0)
-                                                                 !< of q in the last four time steps
-    INTEGER(iwp), DIMENSION(4) ::  sig_pt_arr = (/ 0, 0, 0, 0/)  !< indicates an increase(1) or a decrease (0)
-                                                                 !< of pt in the last four time steps
-
-    REAL(wp) ::  pt_av = 0.0_wp    !< Mean of pt
-    REAL(wp) ::  pt_av_p = 0.0_wp  !< Mean of pt at the previous time step
-    REAL(wp) ::  q_av = 0.0_wp     !< Mean of q
-    REAL(wp) ::  q_av_p = 0.0_wp   !< Mean of q at the previous time step
-    REAL(wp) ::  u_av = 0.0_wp     !< Mean of u
-    REAL(wp) ::  u_av_p = 0.0_wp   !< Mean of u at the previous time step
-    REAL(wp) ::  v_av = 0.0_wp     !< Mean of v
-    REAL(wp) ::  v_av_p = 0.0_wp   !< Mean of v at the previous time step
-    REAL(wp) ::  w_av = 0.0_wp     !< Mean of w
-    REAL(wp) ::  w_av_p = 0.0_wp   !< Mean of w at the previous time step
-
-!
-!-- Averaging the meteorological variables over the model grid
-    CALL calc_average( u, u_av, 1 )
-    CALL calc_average( v, v_av, 2 )
-    CALL calc_average( w, w_av, 3 )
-    IF ( .NOT. neutral )  THEN
-       CALL calc_average( pt, pt_av, 0 )
-    ENDIF
-    IF ( humidity )  THEN
-       CALL calc_average( q, q_av, 0 )
-    ENDIF
-
-!
-!-- Testing the meteorological variables for 2 delta t waves
-    IF ( internal_count > 1 )  THEN
-       CALL testing_2_deltat_wave( u_av_p, u_av, sig_u_arr, count_wave_u, count_time_u )
-       CALL testing_2_deltat_wave( v_av_p, v_av, sig_v_arr, count_wave_v, count_time_v )
-       CALL testing_2_deltat_wave( w_av_p, w_av, sig_w_arr, count_wave_w, count_time_w )
-       IF ( .NOT. neutral )  THEN
-          CALL testing_2_deltat_wave( pt_av_p, pt_av, sig_pt_arr, count_wave_pt, count_time_pt )
-       ENDIF
-       IF ( humidity )  THEN
-          CALL testing_2_deltat_wave( q_av_p, q_av, sig_q_arr, count_wave_q, count_time_q )
-       ENDIF
-    ENDIF
-
-!
-!-- Testing if there is a monotonic increase or decrease with increasing simulation time
-    IF ( sig_u_arr(2) /= sig_u_arr(3) )  THEN
-       mono_count_u = 0
-    ELSE
-       mono_count_u = mono_count_u + 1
-    ENDIF
-
-    IF ( time_since_reference_point >= end_time  .AND.                                             &
-         mono_count_u > 0.9_wp * internal_count )  THEN
-
-       message_string = 'Monotonic decrease or increase with increasing simulation time for u'
-       CALL message( 'vdi_domain_averages', 'PA0665', 0, 1, 0, 6, 0 )
-    ENDIF
-
-    IF ( sig_v_arr(2) /= sig_v_arr(3) )  THEN
-       mono_count_v = 0
-    ELSE
-       mono_count_v = mono_count_v + 1
-    ENDIF
-
-    IF ( time_since_reference_point >= end_time  .AND.                                             &
-         mono_count_v > 0.9_wp * internal_count )  THEN
-       message_string = 'Monotonic decrease or increase with increasing simulation time for v'
-       CALL message( 'vdi_domain_averages', 'PA0665', 0, 1, 0, 6, 0 )
-    ENDIF
-
-    IF ( sig_w_arr(2) /= sig_w_arr(3) )  THEN
-       mono_count_w = 0
-    ELSE
-       mono_count_w = mono_count_w + 1
-    ENDIF
-
-    IF ( time_since_reference_point >= end_time  .AND.                                             &
-         mono_count_w > 0.9_wp * internal_count )  THEN
-       message_string = 'Monotonic decrease or increase with increasing simulation time for w'
-       CALL message( 'vdi_domain_averages', 'PA0665', 0, 1, 0, 6, 0 )
-    ENDIF
-
-    IF ( .NOT. neutral )  THEN
-       IF ( sig_pt_arr(2) /= sig_pt_arr(3) )  THEN
-          mono_count_pt = 0
-       ELSE
-          mono_count_pt = mono_count_pt + 1
-       ENDIF
-
-       IF ( time_since_reference_point >= end_time  .AND.                                          &
-            mono_count_pt > 0.9_wp * internal_count )  THEN
-          message_string = 'Monotonic decrease or increase with increasing simulation time for pt'
-          CALL message( 'vdi_domain_averages', 'PA0665', 0, 1, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-    IF ( humidity )  THEN
-       IF ( sig_q_arr(2) /= sig_q_arr(3) )  THEN
-          mono_count_q = 0
-       ELSE
-          mono_count_q = mono_count_q + 1
-       ENDIF
-
-       IF ( time_since_reference_point >= end_time  .AND.                                          &
-            mono_count_q > 0.9_wp * internal_count )  THEN
-          message_string = 'Monotonic decrease or increase with increasing simulation time for q'
-          CALL message( 'vdi_domain_averages', 'PA0665', 0, 1, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
-!
-!-- Save the values from the previous time step
-    u_av_p = u_av
-    v_av_p = v_av
-    w_av_p = w_av
-
-    IF ( .NOT. neutral )  THEN
-       pt_av_p = pt_av
-    ENDIF
-
-    IF ( humidity )  THEN
-       q_av_p = q_av
-    ENDIF
-
- END SUBROUTINE vdi_domain_averages
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculate the average of a quantity 'quant'.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE calc_average( quant, quant_av, quant_type )
-
-    INTEGER(iwp) ::  average_count   = 0  !< counter for averaging
-    INTEGER(iwp) ::  average_count_l = 0  !< counter for averaging (local)
-    INTEGER      ::  i                    !< loop index
-    INTEGER      ::  j                    !< loop index
-    INTEGER      ::  k                    !< loop index
-    INTEGER(iwp) ::  quant_type           !< bit position (1 for u, 2 for v, 3 for w and 0 for scalar)
-
-    REAL(wp) ::  flag                 !< flag indicating atmosphere (1) or wall (0) grid point
-    REAL(wp) ::  quant_av             !< average of the quantity quant
-    REAL(wp) ::  quant_av_l = 0.0_wp  !< average of the quantity quant (local)
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  quant  !<
-
-!
-!-- Averaging the quantity over the model grid
-   average_count_l = 0
-   quant_av_l = 0.0_wp
-   DO  i = nxl, nxr
-      DO  j = nys, nyn
-         DO  k = nzb, nzt+1
-            flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), quant_type ) )
-            quant_av_l = quant_av_l + quant(k,j,i) * flag
-            average_count_l = average_count_l + INT( flag, KIND = iwp )
-         ENDDO
-      ENDDO
-   ENDDO
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( quant_av_l, quant_av, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
-    CALL MPI_ALLREDUCE( average_count_l, average_count, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-    quant_av = quant_av_l
-    average_count = average_count_l
-#endif
-
-    quant_av = quant_av / REAL( average_count, KIND(wp) )
-
- END SUBROUTINE calc_average
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Testing for conservation of mass.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vdi_conservation_of_mass
-
-    INTEGER(iwp) ::  i  !< loop index
-    INTEGER(iwp) ::  j  !< loop index
-    INTEGER(iwp) ::  k  !< loop index
-
-    REAL(wp)     ::  sum_mass_flux  !< sum of the mass flow
-
-    REAL(wp), DIMENSION(1:3) ::  volume_flow    !< volume flow
-    REAL(wp), DIMENSION(1:3) ::  volume_flow_l  !< volume flow (local)
-
-
-    volume_flow   = 0.0_wp
-    volume_flow_l = 0.0_wp
-
-!
-!-- Left/right:
-!-- Sum up the volume flow through the left boundary
-    IF ( nxl == 0 )  THEN
-       i = 0
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k) * dy                          &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Sum up the volume flow through the right boundary
-    IF ( nxr == nx )  THEN
-       i = nx+1
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzt
-             volume_flow_l(1) = volume_flow_l(1) - u(k,j,i) * dzw(k) * dy                          &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- South/north:
-!-- Sum up the volume flow through the south boundary
-    IF ( nys == 0 )  THEN
-       j = 0
-       DO  i = nxl, nxr
-          DO  k = nzb+1, nzt
-             volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k) * dx                          &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Sum up the volume flow through the north boundary
-    IF ( nyn == ny )  THEN
-       j = ny+1
-       DO  i = nxl, nxr
-          DO  k = nzb+1, nzt
-             volume_flow_l(2) = volume_flow_l(2) - v(k,j,i) * dzw(k) * dx                          &
-                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-          ENDDO
-       ENDDO
-    ENDIF
-!
-!-- Top boundary
-    k = nzt
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          volume_flow_l(3) = volume_flow_l(3) - w(k,j,i) * dx * dy
-       ENDDO
-    ENDDO
-
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flow_l, volume_flow, 3, MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-    volume_flow = volume_flow_l
-#endif
-
-    sum_mass_flux = SUM( volume_flow ) / ( ( nx + 1 ) * dx * ( ny + 1 ) * dy )
-
-   IF ( ABS( sum_mass_flux ) > 0.001 )  THEN
-      message_string = 'The mass is not conserved. '
-      CALL message( 'vdi_conservation_of_mass', 'PA0666', 1, 2, 0, 6, 0 )
-   ENDIF
-
- END SUBROUTINE vdi_conservation_of_mass
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> The results will be checked for exceedance of the specified limits. The controls are performed at
-!> every time step and at every grid point. No wind component is allowed to have a magnitude greater
-!> than ten times the maximum wind velocity at the approach flow profile (Vdi 3783 part 9).
-!> Note, that the supersaturation can not be higher than 10%. Therefore, no test is required.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vdi_plausible_values
-
-    INTEGER(iwp) ::  i  !< loop index
-    INTEGER(iwp) ::  j  !< loop index
-    INTEGER(iwp) ::  k  !< loop index
-
-    REAL(wp)     :: max_uv      !< maximum speed of all edges
-    REAL(wp)     :: max_uv_l_l  !< maximum speed at the left edge (local)
-    REAL(wp)     :: max_uv_l    !< maximum speed at the left edge
-    REAL(wp)     :: max_uv_n_l  !< maximum speed at the north edge (local)
-    REAL(wp)     :: max_uv_n    !< maximum speed at the north edge
-    REAL(wp)     :: max_uv_r_l  !< maximum speed at the right edge (local)
-    REAL(wp)     :: max_uv_r    !< maximum speed at the right edge
-    REAL(wp)     :: max_uv_s_l  !< maximum speed at the south edge (local)
-    REAL(wp)     :: max_uv_s    !< maximum speed at the south edge
-
-    REAL(wp), DIMENSION(4)                 ::  max_arr  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE    ::  uv       !< wind velocity at the approach flow
-    REAL(wp), DIMENSION(:), ALLOCATABLE    ::  uv_l     !< wind velocity at the approach flow (local)
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn) ::  uv_l_nest  !< wind profile at the left edge (nesting)
-    REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn) ::  uv_r_nest  !< wind profile at the right edge (nesting)
-    REAL(wp), DIMENSION(nzb:nzt+1,nxl:nxr) ::  uv_s_nest  !< wind profile at the south edge (nesting)
-    REAL(wp), DIMENSION(nzb:nzt+1,nxl:nxr) ::  uv_n_nest  !< wind profile at the north edge (nesting)
-
-
-    IF ( .NOT. ALLOCATED( uv ) )  THEN
-      ALLOCATE( uv(nzb:nzt+1)   )
-      ALLOCATE( uv_l(nzb:nzt+1) )
-
-      uv   = 0.0_wp
-      uv_l = 0.0_wp
-    ENDIF
-
-!
-!-- Determination of the approach flow profile
-    IF ( nested_run )  THEN
-
-       uv_l_nest = 0.0_wp
-       uv_r_nest = 0.0_wp
-       uv_s_nest = 0.0_wp
-       uv_n_nest = 0.0_wp
-!
-!--    Left boundary
-       IF ( nxl == 0 )  THEN
-          i = nxl
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-                uv_l_nest(k,j) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2                   &
-                                     + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 )
-             ENDDO
-          ENDDO
-          max_uv_l_l = MAXVAL(uv_l_nest)
-       ENDIF
-!
-!--    Right boundary
-       IF ( nxr == nx )  THEN
-          i = nxr
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-                uv_r_nest(k,j) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2                   &
-                                     + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 )
-
-             ENDDO
-          ENDDO
-          max_uv_r_l = MAXVAL(uv_r_nest)
-       ENDIF
-!
-!--    South boundary
-       IF ( nys == 0 )  THEN
-          j = nys
-          DO  i = nxl, nxr
-             DO  k = nzb, nzt+1
-                uv_s_nest(k,i) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2                   &
-                                     + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 )
-             ENDDO
-          ENDDO
-          max_uv_s_l = MAXVAL(uv_s_nest)
-       ENDIF
-!
-!--    North boundary
-       IF ( nyn == ny )  THEN
-          j = nyn
-          DO  i = nxl, nxr
-             DO  k = nzb, nzt+1
-                uv_n_nest(k,i) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2                   &
-                                     + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 )
-
-             ENDDO
-          ENDDO
-          max_uv_n_l = MAXVAL(uv_n_nest)
-       ENDIF
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( max_uv_l_l, max_uv_l, 1, MPI_REAL, MPI_MAX, comm2d, ierr )
-       CALL MPI_ALLREDUCE( max_uv_r_l, max_uv_r, 1, MPI_REAL, MPI_MAX, comm2d, ierr )
-       CALL MPI_ALLREDUCE( max_uv_s_l, max_uv_s, 1, MPI_REAL, MPI_MAX, comm2d, ierr )
-       CALL MPI_ALLREDUCE( max_uv_n_l, max_uv_n, 1, MPI_REAL, MPI_MAX, comm2d, ierr )
-#else
-       max_uv_l = max_uv_l_l
-       max_uv_r = max_uv_r_l
-       max_uv_s = max_uv_s_l
-       max_uv_n = max_uv_n_l
-#endif
-
-       max_arr = (/ max_uv_r, max_uv_l, max_uv_s, max_uv_n /)
-       max_uv = MAXVAl( max_arr )
-
-    ELSE  ! non-nested run
-
-       IF ( bc_lr_cyc  .AND.  bc_ns_cyc )  THEN
-          IF ( nxl == 0  .AND.  nys == 0 )  THEN
-             DO  k = nzb, nzt+1
-                uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,-1) + u(k,0,0) ) )**2                           &
-                              + ( 0.5_wp * ( v(k,-1,0) + v(k,0,0) ) )**2 )
-             ENDDO
-          ENDIF
-       ENDIF
-
-
-       IF ( bc_dirichlet_l )  THEN
-          IF ( nxl == 0 .AND. nys == 0 )  THEN
-             DO  k = nzb, nzt+1
-                uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,-1) + u(k,0,0) ) )**2                           &
-                              + ( 0.5_wp * ( v(k,-1,0) + v(k,0,0) ) )**2 )
-             ENDDO
-          ENDIF
-
-       ELSEIF (bc_dirichlet_r )  THEN
-          IF ( nxr == nx .AND. nys == 0 )  THEN
-             DO  k = nzb, nzt+1
-                uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,nxr) + u(k,0,nxr+1) ) )**2                      &
-                              + ( 0.5_wp * ( v(k,-1,nxr) + v(k,0,nxr) ) )**2 )
-             ENDDO
-          ENDIF
-       ENDIF
-
-       IF ( bc_dirichlet_n )  THEN
-          IF ( nxl == 0 .AND. nyn == ny )  THEN
-             DO  k = nzb, nzt+1
-                uv_l(k) = SQRT( ( 0.5_wp * ( u(k,nyn,-1) + u(k,nyn,0) ) )**2                       &
-                              + ( 0.5_wp * ( v(k,nyn+1,0) + v(k,nyn,0) ) )**2 )
-             ENDDO
-          ENDIF
-
-       ELSEIF ( bc_dirichlet_s )  THEN
-          IF ( nxl == 0 .AND. nys == 0 )  THEN
-             DO  k = nzb, nzt+1
-                uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,-1) + u(k,0,0) ) )**2                           &
-                              + ( 0.5_wp * ( v(k,-1,0) + v(k,0,0) ) )**2 )
-             ENDDO
-          ENDIF
-       ENDIF
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( uv_l, uv, nzt+1-nzb+1, MPI_REAL, MPI_MAX, comm2d, ierr )
-#else
-       uv = uv_l
-#endif
-
-       max_uv = MAXVAL( uv )
-
-   ENDIF
-
-!
-!-- Test for exceedance of the specified limits
-    message_string = 'A wind component have a magnitude greater than ten times the maximum' //     &
-                     'wind velocity at the approach flow profile.'
-
-    IF ( MAXVAL( ABS( u ) ) > 10.0_wp * max_uv )  THEN
-       CALL message( 'vdi_plausible_values', 'PA0667', 2, 2, myid, 6, 0 )
-    ENDIF
-
-    IF ( MAXVAL( ABS( v ) ) > 10.0_wp * max_uv )  THEN
-       CALL message( 'vdi_plausible_values', 'PA0667', 2, 2, myid, 6, 0 )
-    ENDIF
-
-    IF ( MAXVAL( ABS( w ) ) > 10.0_wp * max_uv )  THEN
-       CALL message( 'vdi_plausible_values', 'PA0667', 2, 2, myid, 6, 0 )
-    ENDIF
-
-!
-!-- Test if the potential temperature lies between 220 K and 330 K
-    IF ( MAXVAL( pt ) > 330.0_wp .OR. MAXVAL( pt ) < 220.0_wp )  THEN
-       message_string = 'The potential temperature does not lie between 220 K and 330 K.'
-       CALL message( 'vdi_plausible_values', 'PA0668', 2, 2, myid, 6, 0 )
-    ENDIF
-
- END SUBROUTINE vdi_plausible_values
-
- END MODULE vdi_internal_controls
Index: palm/trunk/SOURCE/virtual_flight_mod.f90
===================================================================
--- palm/trunk/SOURCE/virtual_flight_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,1108 +1,0 @@
-!> @file virtual_flights_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4842 2021-01-14 10:42:28Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! Bugfix, use time_since_reference_point instead of simulated_time
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4522 2020-05-06 14:17:05Z suehring
-! Modularize user_init_flight in order to provide an explicit interface.
-!
-! 4497 2020-04-15 10:20:51Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Corrected "Former revisions" section
-!
-! 4004 2019-05-24 11:32:38Z suehring
-! Allow variable start- and end locations also in return mode
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional
-! debug messages
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! variables documented
-!
-! 1957 2016-07-07 10:43:48Z suehring
-! Initial revision
-!
-! Description:
-! ------------
-!> Module for virtual flight measurements.
-!> @todo Err msg PA0438: flight can be inside topography -> extra check?
-!--------------------------------------------------------------------------------------------------!
- MODULE flight_mod
-
-    USE control_parameters,                                                                        &
-        ONLY:  debug_output,                                                                       &
-               fl_max, num_leg,                                                                    &
-               num_var_fl,                                                                         &
-               num_var_fl_user,                                                                    &
-               restart_data_format_output,                                                         &
-               virtual_flight
-
-    USE kinds
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rd_mpi_io_check_array, rrd_mpi_io_global_array, wrd_mpi_io_global_array
-
-    USE  user_init_flight_mod,                                                                     &
-        ONLY:  user_init_flight
-
-
-    CHARACTER(LEN=6), DIMENSION(fl_max) ::  leg_mode = 'cyclic'  !< flight mode through the model domain, either 'cyclic' or
-                                                                 !<'return'
-
-    INTEGER(iwp) ::  l           !< index for flight leg
-    INTEGER(iwp) ::  var_index   !< index for measured variable
-
-    LOGICAL, DIMENSION(:), ALLOCATABLE  ::  cyclic_leg  !< flag to identify fly mode
-
-    REAL(wp) ::  flight_end = 9999999.9_wp  !< end time of virtual flight
-    REAL(wp) ::  flight_begin = 0.0_wp      !< end time of virtual flight
-
-    REAL(wp), DIMENSION(fl_max) ::  flight_angle = 45.0_wp    !< angle determining the horizontal flight direction
-    REAL(wp), DIMENSION(fl_max) ::  flight_level = 100.0_wp   !< flight level
-    REAL(wp), DIMENSION(fl_max) ::  max_elev_change = 0.0_wp  !< maximum elevation change for the respective flight leg
-    REAL(wp), DIMENSION(fl_max) ::  rate_of_climb = 0.0_wp    !< rate of climb or descent
-    REAL(wp), DIMENSION(fl_max) ::  speed_agl = 25.0_wp       !< absolute horizontal flight speed above ground level (agl)
-    REAL(wp), DIMENSION(fl_max) ::  x_start = 999999999.0_wp  !< start x position
-    REAL(wp), DIMENSION(fl_max) ::  x_end   = 999999999.0_wp  !< end x position
-    REAL(wp), DIMENSION(fl_max) ::  y_start = 999999999.0_wp  !< start y position
-    REAL(wp), DIMENSION(fl_max) ::  y_end   = 999999999.0_wp  !< end y position
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  u_agl  !< u-component of flight speed
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  v_agl  !< v-component of flight speed
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  w_agl  !< w-component of flight speed
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  x_pos  !< aircraft x-position
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  y_pos  !< aircraft y-position
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  z_pos  !< aircraft z-position
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sensor_l  !< measured data on local PE
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sensor    !< measured data
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  var_u  !< dummy array for possibly user-defined quantities
-
-    SAVE
-
-    PRIVATE
-
-    INTERFACE flight_header
-       MODULE PROCEDURE flight_header
-    END INTERFACE flight_header
-
-    INTERFACE flight_init
-       MODULE PROCEDURE flight_init
-    END INTERFACE flight_init
-
-    INTERFACE flight_init_output
-       MODULE PROCEDURE flight_init_output
-    END INTERFACE flight_init_output
-
-    INTERFACE flight_check_parameters
-       MODULE PROCEDURE flight_check_parameters
-    END INTERFACE flight_check_parameters
-
-    INTERFACE flight_parin
-       MODULE PROCEDURE flight_parin
-    END INTERFACE flight_parin
-
-    INTERFACE interpolate_xyz
-       MODULE PROCEDURE interpolate_xyz
-    END INTERFACE interpolate_xyz
-
-    INTERFACE flight_measurement
-       MODULE PROCEDURE flight_measurement
-    END INTERFACE flight_measurement
-
-    INTERFACE flight_rrd_global
-       MODULE PROCEDURE flight_rrd_global_ftn
-       MODULE PROCEDURE flight_rrd_global_mpi
-    END INTERFACE flight_rrd_global
-
-    INTERFACE flight_wrd_global
-       MODULE PROCEDURE flight_wrd_global
-    END INTERFACE flight_wrd_global
-
-!
-!-- Private interfaces
-    PRIVATE flight_check_parameters,                                                               &
-            flight_init_output,                                                                    &
-            interpolate_xyz
-!
-!-- Public interfaces
-    PUBLIC flight_init,                                                                            &
-           flight_header,                                                                          &
-           flight_parin,                                                                           &
-           flight_measurement,                                                                     &
-           flight_wrd_global,                                                                      &
-           flight_rrd_global
-!
-!-- Public variables
-    PUBLIC fl_max,                                                                                 &
-           sensor,                                                                                 &
-           x_pos,                                                                                  &
-           y_pos,                                                                                  &
-           z_pos
-
- CONTAINS
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Header output for flight module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE flight_header ( io )
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN) ::  io  !< Unit of the output file
-
-    WRITE ( io, 1  )
-    WRITE ( io, 2  )
-    WRITE ( io, 3  ) num_leg
-    WRITE ( io, 4  ) flight_begin
-    WRITE ( io, 5  ) flight_end
-
-    DO  l=1, num_leg
-       WRITE ( io, 6   ) l
-       WRITE ( io, 7   ) speed_agl(l)
-       WRITE ( io, 8   ) flight_level(l)
-       WRITE ( io, 9   ) max_elev_change(l)
-       WRITE ( io, 10  ) rate_of_climb(l)
-       WRITE ( io, 11  ) leg_mode(l)
-    ENDDO
-
-
- 1   FORMAT (' Virtual flights: ----------------' )
- 2   FORMAT ('       Output every timestep' )
- 3   FORMAT ('       Number of flight legs:',    I3 )
- 4   FORMAT ('       Begin of measurements:',    F10.1    , ' s' )
- 5   FORMAT ('       End of measurements:',      F10.1    , ' s' )
- 6   FORMAT ('       Leg', I3/, '       ------' )
- 7   FORMAT ('          Flight speed            : ', F5.1, ' m/s' )
- 8   FORMAT ('          Flight level            : ', F5.1, ' m' )
- 9   FORMAT ('          Maximum elevation change: ', F5.1, ' m/s' )
- 10  FORMAT ('          Rate of climb / descent : ', F5.1, ' m/s' )
- 11  FORMAT ('          Leg mode                : ', A/ )
-
- END SUBROUTINE flight_header
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads the namelist flight_par.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE flight_parin
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter file
-
-    INTEGER(iwp) ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /virtual_flight_parameters/  flight_angle,                                            &
-                                          flight_begin,                                            &
-                                          flight_end,                                              &
-                                          flight_level,                                            &
-                                          leg_mode,                                                &
-                                          max_elev_change,                                         &
-                                          rate_of_climb,                                           &
-                                          speed_agl,                                               &
-                                          switch_off_module,                                       &
-                                          x_end,                                                   &
-                                          x_start,                                                 &
-                                          y_end,                                                   &
-                                          y_start
-
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, virtual_flight_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    virtual_flight_parameters namelist was found and read correctly. Set switch that virtual
-!--    flights are carried out.
-       IF ( .NOT. switch_off_module )  virtual_flight = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    virtual_flight_parameters namelist was found, but contained errors. Print an error message
-!--    including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'virtual_flight_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE flight_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Inititalization of required arrays, number of legs and flags. Moreover, initialize flight speed
-!> and -direction, as well as start positions.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE flight_init
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  pi
-
-    USE control_parameters,                                                                        &
-        ONLY:  initializing_actions
-
-    USE indices,                                                                                   &
-        ONLY:  nxlg,                                                                               &
-               nxrg,                                                                               &
-               nysg,                                                                               &
-               nyng,                                                                               &
-               nzb,                                                                                &
-               nzt
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  distance  !< distance between start and end position of a flight leg
-
-
-    IF ( debug_output )  CALL debug_message( 'flight_init', 'start' )
-!
-!-- Determine the number of flight legs
-    l = 1
-    DO  WHILE ( x_start(l) /= 999999999.0_wp  .AND.  l <= SIZE(x_start) )
-       l       = l + 1
-    ENDDO
-    num_leg = l-1
-!
-!-- Check for proper parameter settings
-    CALL flight_check_parameters
-!
-!-- Allocate and initialize logical array for flight pattern
-    ALLOCATE( cyclic_leg(1:num_leg) )
-!
-!-- Initialize flags for cyclic/return legs
-    DO  l = 1, num_leg
-       cyclic_leg(l) = MERGE( .TRUE., .FALSE., TRIM( leg_mode(l) ) == 'cyclic' )
-    ENDDO
-!
-!-- Allocate and initialize arraxs for flight position and speed. In case of restart runs these data
-!-- are read by the routine read_flight_restart_data instead.
-    IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-
-       ALLOCATE( x_pos(1:num_leg), y_pos(1:num_leg ), z_pos(1:num_leg) )
-!
-!--    Inititalize x-, y-, and z-positions with initial start position
-       x_pos(1:num_leg) = x_start(1:num_leg)
-       y_pos(1:num_leg) = y_start(1:num_leg)
-       z_pos(1:num_leg) = flight_level(1:num_leg)
-!
-!--    Allocate arrays for flight-speed components
-       ALLOCATE( u_agl(1:num_leg),                                                                 &
-                 v_agl(1:num_leg),                                                                 &
-                 w_agl(1:num_leg) )
-!
-!--    Inititalize u-, v- and w-component.
-       DO  l = 1, num_leg
-!
-!--       In case of return-legs, the flight direction, i.e. the horizontal flight-speed components,
-!--       are derived from the given start/end positions.
-          IF (  .NOT.  cyclic_leg(l) )  THEN
-             distance = SQRT( ( x_end(l) - x_start(l) )**2 + ( y_end(l) - y_start(l) )**2 )
-             u_agl(l) = speed_agl(l) * ( x_end(l) - x_start(l) ) / distance
-             v_agl(l) = speed_agl(l) * ( y_end(l) - y_start(l) ) / distance
-             w_agl(l) = rate_of_climb(l)
-!
-!--       In case of cyclic-legs, flight direction is directly derived from the given flight angle.
-          ELSE
-             u_agl(l) = speed_agl(l) * COS( flight_angle(l) * pi / 180.0_wp )
-             v_agl(l) = speed_agl(l) * SIN( flight_angle(l) * pi / 180.0_wp )
-             w_agl(l) = rate_of_climb(l)
-          ENDIF
-
-       ENDDO
-
-    ENDIF
-!
-!-- Initialized data output
-    CALL flight_init_output
-!
-!-- Allocate array required for user-defined quantities if necessary.
-    IF ( num_var_fl_user  > 0 )  ALLOCATE( var_u(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!
-!-- Allocate and initialize arrays containing the measured data
-    ALLOCATE( sensor_l(1:num_var_fl,1:num_leg) )
-    ALLOCATE( sensor(1:num_var_fl,1:num_leg)   )
-    sensor_l = 0.0_wp
-    sensor   = 0.0_wp
-
-    IF ( debug_output )  CALL debug_message( 'flight_init', 'end' )
-
- END SUBROUTINE flight_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of output-variable names and units.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE flight_init_output
-
-    USE control_parameters,                                                                        &
-       ONLY:  cloud_droplets,                                                                      &
-              humidity,                                                                            &
-              neutral,                                                                             &
-              passive_scalar
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    USE netcdf_interface
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=10) ::  label_leg  !< dummy argument to convert integer to string
-
-    INTEGER(iwp) ::  i         !< loop variable
-    INTEGER(iwp) ::  id_pt     !< identifyer for labeling
-    INTEGER(iwp) ::  id_q      !< identifyer for labeling
-    INTEGER(iwp) ::  id_ql     !< identifyer for labeling
-    INTEGER(iwp) ::  id_s      !< identifyer for labeling
-    INTEGER(iwp) ::  id_u = 1  !< identifyer for labeling
-    INTEGER(iwp) ::  id_v = 2  !< identifyer for labeling
-    INTEGER(iwp) ::  id_w = 3  !< identifyer for labeling
-    INTEGER(iwp) ::  k         !< index variable
-
-    LOGICAL      ::  init = .TRUE.  !< flag to distiquish calls of user_init_flight
-!
-!-- Define output quanities, at least three variables are measured (u,v,w)
-    num_var_fl = 3
-    IF ( .NOT. neutral                     )  THEN
-       num_var_fl = num_var_fl + 1
-       id_pt      = num_var_fl
-    ENDIF
-    IF ( humidity                          )  THEN
-       num_var_fl = num_var_fl + 1
-       id_q       = num_var_fl
-    ENDIF
-    IF ( bulk_cloud_model .OR. cloud_droplets )  THEN
-       num_var_fl = num_var_fl + 1
-       id_ql      = num_var_fl
-    ENDIF
-    IF ( passive_scalar                    )  THEN
-       num_var_fl = num_var_fl + 1
-       id_s       = num_var_fl
-    ENDIF
-!
-!-- Write output strings for dimensions x, y, z
-    DO  l=1, num_leg
-
-       IF ( l < 10                    )  WRITE( label_leg, '(I1)' )  l
-       IF ( l >= 10   .AND.  l < 100  )  WRITE( label_leg, '(I2)' )  l
-       IF ( l >= 100  .AND.  l < 1000 )  WRITE( label_leg, '(I3)' )  l
-
-       dofl_dim_label_x(l)  = 'x_' // TRIM( label_leg )
-       dofl_dim_label_y(l)  = 'y_' // TRIM( label_leg )
-       dofl_dim_label_z(l)  = 'z_' // TRIM( label_leg )
-
-    ENDDO
-
-!
-!-- Call user routine to initialize further variables
-    CALL user_init_flight( init )
-!
-!-- Write output labels and units for the quanities
-    k = 1
-    DO  l=1, num_leg
-
-       IF ( l < 10                    )  WRITE( label_leg, '(I1)' )  l
-       IF ( l >= 10   .AND.  l < 100  )  WRITE( label_leg, '(I2)' )  l
-       IF ( l >= 100  .AND.  l < 1000 )  WRITE( label_leg, '(I3)' )  l
-
-       label_leg = 'leg_' // TRIM(label_leg)
-       DO  i=1, num_var_fl
-
-          IF ( i == id_u      )  THEN
-             dofl_label(k) = TRIM( label_leg ) // '_u'
-             dofl_unit(k)  = 'm/s'
-             k             = k + 1
-          ELSEIF ( i == id_v  )  THEN
-             dofl_label(k) = TRIM( label_leg ) // '_v'
-             dofl_unit(k)  = 'm/s'
-             k             = k + 1
-          ELSEIF ( i == id_w  )  THEN
-             dofl_label(k) = TRIM( label_leg ) // '_w'
-             dofl_unit(k)  = 'm/s'
-             k             = k + 1
-          ELSEIF ( i == id_pt )  THEN
-             dofl_label(k) = TRIM( label_leg ) // '_theta'
-             dofl_unit(k)  = 'K'
-             k             = k + 1
-          ELSEIF ( i == id_q  )  THEN
-             dofl_label(k) = TRIM( label_leg ) // '_q'
-             dofl_unit(k)  = 'kg/kg'
-             k             = k + 1
-          ELSEIF ( i == id_ql )  THEN
-             dofl_label(k) = TRIM( label_leg ) // '_ql'
-             dofl_unit(k)  = 'kg/kg'
-             k             = k + 1
-          ELSEIF ( i == id_s  )  THEN
-             dofl_label(k) = TRIM( label_leg ) // '_s'
-             dofl_unit(k)  = 'kg/kg'
-             k             = k + 1
-          ENDIF
-       ENDDO
-
-       DO i=1, num_var_fl_user
-          CALL user_init_flight( init, k, i, label_leg )
-       ENDDO
-
-    ENDDO
-!
-!-- Finally, set the total number of flight-output quantities.
-    num_var_fl = num_var_fl + num_var_fl_user
-
- END SUBROUTINE flight_init_output
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine calculates the current flight positions and calls the respective interpolation
-!> routine to measure the data at the current flight position.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE flight_measurement
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  ddzu,                                                                               &
-               ddzw,                                                                               &
-               pt,                                                                                 &
-               q,                                                                                  &
-               ql,                                                                                 &
-               s,                                                                                  &
-               u,                                                                                  &
-               v,                                                                                  &
-               w,                                                                                  &
-               zu,                                                                                 &
-               zw
-
-    USE control_parameters,                                                                        &
-        ONLY:  cloud_droplets,                                                                     &
-               dt_3d,                                                                              &
-               humidity,                                                                           &
-               neutral,                                                                            &
-               passive_scalar,                                                                     &
-               time_since_reference_point
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx,                                                                                &
-               ddy,                                                                                &
-               dx,                                                                                 &
-               dy
-
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               nxl,                                                                                &
-               nxr,                                                                                &
-               ny,                                                                                 &
-               nys,                                                                                &
-               nyn
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i  !< index of current grid box along x
-    INTEGER(iwp) ::  j  !< index of current grid box along y
-    INTEGER(iwp) ::  n  !< loop variable for number of user-defined output quantities
-
-    LOGICAL  ::  on_pe  !< flag to check if current flight position is on current PE
-
-    REAL(wp) ::  x  !< distance between left edge of current grid box and flight position
-    REAL(wp) ::  y  !< distance between south edge of current grid box and flight position
-
-    CALL cpu_log( log_point(65), 'flight_measurement', 'start' )
-!
-!-- Perform flight measurement if start time is reached.
-    IF ( time_since_reference_point >= flight_begin  .AND.  time_since_reference_point <= flight_end )  THEN
-
-       sensor_l = 0.0_wp
-       sensor   = 0.0_wp
-!
-!--    Loop over all flight legs
-       DO  l = 1, num_leg
-!
-!--       Update location for each leg
-          x_pos(l) = x_pos(l) + u_agl(l) * dt_3d
-          y_pos(l) = y_pos(l) + v_agl(l) * dt_3d
-          z_pos(l) = z_pos(l) + w_agl(l) * dt_3d
-!
-!--       Check if location must be modified for return legs.
-!--       Carry out horizontal reflection if required.
-          IF ( .NOT. cyclic_leg(l) )  THEN
-
-             IF ( x_start(l) <= x_end(l) )  THEN
-!
-!--             Outward flight, i.e. from start to end
-                IF ( u_agl(l) >= 0.0_wp  .AND.  x_pos(l) > x_end(l)      )  THEN
-                   x_pos(l) = 2.0_wp * x_end(l)   - x_pos(l)
-                   u_agl(l) = - u_agl(l)
-!
-!--             Return flight, i.e. from end to start
-                ELSEIF ( u_agl(l) < 0.0_wp  .AND.  x_pos(l) < x_start(l) )  THEN
-                   x_pos(l) = 2.0_wp * x_start(l) - x_pos(l)
-                   u_agl(l) = - u_agl(l)
-                ENDIF
-             ELSE
-!
-!--             Outward flight, i.e. from start to end
-                IF ( u_agl(l) < 0.0_wp  .AND.  x_pos(l) < x_end(l)      )  THEN
-                   x_pos(l) = 2.0_wp * x_end(l)   - x_pos(l)
-                   u_agl(l) = - u_agl(l)
-!
-!--             Return flight, i.e. from end to start
-                ELSEIF ( u_agl(l) >= 0.0_wp  .AND.  x_pos(l) > x_start(l) )  THEN
-                   x_pos(l) = 2.0_wp * x_start(l) - x_pos(l)
-                   u_agl(l) = - u_agl(l)
-                ENDIF
-             ENDIF
-
-             IF ( y_start(l) <= y_end(l) )  THEN
-!
-!--             Outward flight, i.e. from start to end
-                IF ( v_agl(l) >= 0.0_wp  .AND.  y_pos(l) > y_end(l)      )  THEN
-                   y_pos(l) = 2.0_wp * y_end(l)   - y_pos(l)
-                   v_agl(l) = - v_agl(l)
-!
-!--             Return flight, i.e. from end to start
-                ELSEIF ( v_agl(l) < 0.0_wp  .AND.  y_pos(l) < y_start(l) )  THEN
-                   y_pos(l) = 2.0_wp * y_start(l) - y_pos(l)
-                   v_agl(l) = - v_agl(l)
-                ENDIF
-             ELSE
-!
-!--             Outward flight, i.e. from start to end
-                IF ( v_agl(l) < 0.0_wp  .AND.  y_pos(l) < y_end(l)      )  THEN
-                   y_pos(l) = 2.0_wp * y_end(l)   - y_pos(l)
-                   v_agl(l) = - v_agl(l)
-!
-!--             Return flight, i.e. from end to start
-                ELSEIF ( v_agl(l) >= 0.0_wp  .AND.  y_pos(l) > y_start(l) )  THEN
-                   y_pos(l) = 2.0_wp * y_start(l) - y_pos(l)
-                   v_agl(l) = - v_agl(l)
-                ENDIF
-             ENDIF
-!
-!--       Check if flight position is outside the model domain and apply cyclic conditions if required
-          ELSEIF ( cyclic_leg(l) )  THEN
-!
-!--          Check if aircraft leaves the model domain at the right boundary
-             IF ( ( flight_angle(l) >= 0.0_wp     .AND.                                            &
-                    flight_angle(l) <= 90.0_wp )  .OR.                                             &
-                  ( flight_angle(l) >= 270.0_wp   .AND.                                            &
-                    flight_angle(l) <= 360.0_wp ) )  THEN
-                IF ( x_pos(l) >= ( nx + 0.5_wp ) * dx )                                            &
-                     x_pos(l) = x_pos(l) - ( nx + 1 ) * dx
-!
-!--          Check if aircraft leaves the model domain at the left boundary
-             ELSEIF ( flight_angle(l) > 90.0_wp  .AND.  flight_angle(l) < 270.0_wp )  THEN
-                IF ( x_pos(l) < -0.5_wp * dx )                                                     &
-                     x_pos(l) = ( nx + 1 ) * dx + x_pos(l)
-             ENDIF
-!
-!--          Check if aircraft leaves the model domain at the north boundary
-             IF ( flight_angle(l) >= 0.0_wp  .AND.  flight_angle(l) <= 180.0_wp )  THEN
-                IF ( y_pos(l) >= ( ny + 0.5_wp ) * dy )                                            &
-                     y_pos(l) = y_pos(l) - ( ny + 1 ) * dy
-!
-!--          Check if aircraft leaves the model domain at the south boundary
-             ELSEIF ( flight_angle(l) > 180.0_wp  .AND.  flight_angle(l) < 360.0_wp )  THEN
-                IF ( y_pos(l) < -0.5_wp * dy )                                                     &
-                     y_pos(l) = ( ny + 1 ) * dy + y_pos(l)
-             ENDIF
-
-          ENDIF
-!
-!--       Check if maximum elevation change is already reached. If required reflect vertically.
-          IF ( rate_of_climb(l) /= 0.0_wp )  THEN
-!
-!--          First check if aircraft is too high
-             IF (  w_agl(l) > 0.0_wp  .AND.  z_pos(l) - flight_level(l) > max_elev_change(l) )  THEN
-                z_pos(l) = 2.0_wp * ( flight_level(l) + max_elev_change(l) ) - z_pos(l)
-                w_agl(l) = - w_agl(l)
-!
-!--          Check if aircraft is too low
-             ELSEIF (  w_agl(l) < 0.0_wp  .AND.  z_pos(l) < flight_level(l) )  THEN
-                z_pos(l) = 2.0_wp * flight_level(l) - z_pos(l)
-                w_agl(l) = - w_agl(l)
-             ENDIF
-
-          ENDIF
-!
-!--       Determine grid indices for flight position along x- and y-direction. Please note, there is
-!--       a special treatment for the index along z-direction, which is due to vertical grid stretching.
-          i = ( x_pos(l) + 0.5_wp * dx ) * ddx
-          j = ( y_pos(l) + 0.5_wp * dy ) * ddy
-!
-!--       Check if indices are on current PE
-          on_pe = ( i >= nxl  .AND.  i <= nxr  .AND.  j >= nys  .AND.  j <= nyn )
-
-          IF ( on_pe )  THEN
-
-             var_index = 1
-!
-!--          Recalculate indices, as u is shifted by -0.5*dx.
-             i =   x_pos(l) * ddx
-             j = ( y_pos(l) + 0.5_wp * dy ) * ddy
-!
-!--          Calculate distance from left and south grid-box edges.
-             x  = x_pos(l) - ( 0.5_wp - i ) * dx
-             y  = y_pos(l) - j * dy
-!
-!--          Interpolate u-component onto current flight position.
-             CALL interpolate_xyz( u, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
-             var_index = var_index + 1
-!
-!--          Recalculate indices, as v is shifted by -0.5*dy.
-             i = ( x_pos(l) + 0.5_wp * dx ) * ddx
-             j =   y_pos(l) * ddy
-
-             x  = x_pos(l) - i * dx
-             y  = y_pos(l) - ( 0.5_wp - j ) * dy
-             CALL interpolate_xyz( v, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
-             var_index = var_index + 1
-!
-!--          Interpolate w and scalar quantities. Recalculate indices.
-             i  = ( x_pos(l) + 0.5_wp * dx ) * ddx
-             j  = ( y_pos(l) + 0.5_wp * dy ) * ddy
-             x  = x_pos(l) - i * dx
-             y  = y_pos(l) - j * dy
-!
-!--          Interpolate w-velocity component.
-             CALL interpolate_xyz( w, zw, ddzw, 0.0_wp, x, y, var_index, j, i )
-             var_index = var_index + 1
-!
-!--          Potential temerature
-             IF ( .NOT. neutral )  THEN
-                CALL interpolate_xyz( pt, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
-                var_index = var_index + 1
-             ENDIF
-!
-!--          Humidity
-             IF ( humidity )  THEN
-                CALL interpolate_xyz( q, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
-                var_index = var_index + 1
-             ENDIF
-!
-!--          Liquid water content
-             IF ( bulk_cloud_model .OR. cloud_droplets )  THEN
-                CALL interpolate_xyz( ql, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
-                var_index = var_index + 1
-             ENDIF
-!
-!--          Passive scalar
-             IF ( passive_scalar )  THEN
-                CALL interpolate_xyz( s, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
-                var_index = var_index + 1
-             ENDIF
-!
-!--          Treat user-defined variables if required
-             DO  n = 1, num_var_fl_user
-                CALL user_flight( var_u, n )
-                CALL interpolate_xyz( var_u, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
-                var_index = var_index + 1
-             ENDDO
-          ENDIF
-
-       ENDDO
-!
-!--    Write local data on global array.
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( sensor_l(1,1), sensor(1,1), num_var_fl * num_leg, MPI_REAL, MPI_SUM,    &
-                           comm2d, ierr )
-#else
-       sensor     = sensor_l
-#endif
-    ENDIF
-
-    CALL cpu_log( log_point(65), 'flight_measurement', 'stop' )
-
- END SUBROUTINE flight_measurement
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This subroutine bi-linearly interpolates the respective data onto the current flight position.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE interpolate_xyz( var, z_uw, ddz_uw, fac, x, y, var_ind, j, i )
-
-    USE control_parameters,                                                                        &
-        ONLY:  dz,                                                                                 &
-               dz_stretch_level_start
-
-    USE grid_variables,                                                                            &
-       ONLY:  dx,                                                                                  &
-              dy
-
-    USE indices,                                                                                   &
-        ONLY:  nzb,                                                                                &
-               nzt,                                                                                &
-               nxlg,                                                                               &
-               nxrg,                                                                               &
-               nysg,                                                                               &
-               nyng
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i        !< index along x
-    INTEGER(iwp) ::  j        !< index along y
-    INTEGER(iwp) ::  k        !< index along z
-    INTEGER(iwp) ::  k1       !< dummy variable
-    INTEGER(iwp) ::  var_ind  !< index variable for output quantity
-
-    REAL(wp) ::  aa         !< dummy argument for horizontal interpolation
-    REAL(wp) ::  bb         !< dummy argument for horizontal interpolation
-    REAL(wp) ::  cc         !< dummy argument for horizontal interpolation
-    REAL(wp) ::  dd         !< dummy argument for horizontal interpolation
-    REAL(wp) ::  gg         !< dummy argument for horizontal interpolation
-    REAL(wp) ::  fac        !< flag to indentify if quantity is on zu or zw level
-    REAL(wp) ::  var_int    !< horizontal interpolated variable at current position
-    REAL(wp) ::  var_int_l  !< horizontal interpolated variable at k-level
-    REAL(wp) ::  var_int_u  !< horizontal interpolated variable at (k+1)-level
-    REAL(wp) ::  x          !< distance between left edge of current grid box and flight position
-    REAL(wp) ::  y          !< distance between south edge of current grid box and flight position
-
-    REAL(wp), DIMENSION(1:nzt+1)   ::  ddz_uw  !< inverse vertical grid spacing
-    REAL(wp), DIMENSION(nzb:nzt+1) ::  z_uw    !< height level
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< treated quantity
-!
-!-- Calculate interpolation coefficients
-    aa = x**2          + y**2
-    bb = ( dx - x )**2 + y**2
-    cc = x**2          + ( dy - y )**2
-    dd = ( dx - x )**2 + ( dy - y )**2
-    gg = aa + bb + cc + dd
-!
-!-- Obtain vertical index. Special treatment for grid index along z-direction if flight position is
-!-- above the vertical grid-stretching level. fac=1 if variable is on scalar grid level, fac=0 for
-!-- w-component.
-    IF ( z_pos(l) < dz_stretch_level_start(1) )  THEN
-       k = ( z_pos(l) + fac * 0.5_wp * dz(1) ) / dz(1)
-    ELSE
-!
-!--    Search for k-index
-       DO  k1 = nzb, nzt
-          IF ( z_pos(l) >= z_uw(k1) .AND. z_pos(l) < z_uw(k1+1) )  THEN
-             k = k1
-             EXIT
-          ENDIF
-       ENDDO
-    ENDIF
-!
-!-- (x,y)-interpolation at k-level
-    var_int_l = ( ( gg - aa ) * var(k,j,i)       +                                                 &
-                  ( gg - bb ) * var(k,j,i+1)     +                                                 &
-                  ( gg - cc ) * var(k,j+1,i)     +                                                 &
-                  ( gg - dd ) * var(k,j+1,i+1)                                                     &
-                ) / ( 3.0_wp * gg )
-!
-!-- (x,y)-interpolation on (k+1)-level
-    var_int_u = ( ( gg - aa ) * var(k+1,j,i)     +                                                 &
-                  ( gg - bb ) * var(k+1,j,i+1)   +                                                 &
-                  ( gg - cc ) * var(k+1,j+1,i)   +                                                 &
-                  ( gg - dd ) * var(k+1,j+1,i+1)                                                   &
-                ) / ( 3.0_wp * gg )
-!
-!-- z-interpolation onto current flight postion
-    var_int = var_int_l + ( z_pos(l) - z_uw(k) ) * ddz_uw(k+1) * (var_int_u - var_int_l )
-!
-!-- Store on local data array
-    sensor_l(var_ind,l) = var_int
-
- END SUBROUTINE interpolate_xyz
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Perform parameter checks.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE flight_check_parameters
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  zu
-
-    USE control_parameters,                                                                        &
-        ONLY:  bc_lr_cyc,                                                                          &
-               bc_ns_cyc,                                                                          &
-               message_string
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx,                                                                                 &
-               dy
-
-    USE indices,                                                                                   &
-        ONLY:  nx,                                                                                 &
-               ny,                                                                                 &
-               nz
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  netcdf_data_format
-
-    IMPLICIT NONE
-
-!
-!-- Check if start positions are properly set.
-    DO  l = 1, num_leg
-       IF ( x_start(l) < 0.0_wp  .OR.  x_start(l) > ( nx + 1 ) * dx )  THEN
-          message_string = 'Start x position is outside the model domain'
-          CALL message( 'flight_check_parameters', 'PA0431', 1, 2, 0, 6, 0 )
-       ENDIF
-       IF ( y_start(l) < 0.0_wp  .OR.  y_start(l) > ( ny + 1 ) * dy )  THEN
-          message_string = 'Start y position is outside the model domain'
-          CALL message( 'flight_check_parameters', 'PA0432', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDDO
-!
-!-- Check for leg mode
-    DO  l = 1, num_leg
-!
-!--    Check if leg mode matches the overall lateral model boundary conditions.
-       IF ( TRIM( leg_mode(l) ) == 'cyclic' )  THEN
-          IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
-             message_string = 'Cyclic flight leg does not match lateral boundary condition'
-             CALL message( 'flight_check_parameters', 'PA0433', 1, 2, 0, 6, 0 )
-          ENDIF
-!
-!--    Check if end-positions are inside the model domain in case of return-legs.
-       ELSEIF ( TRIM( leg_mode(l) ) == 'return' )  THEN
-          IF ( x_end(l) > ( nx + 1 ) * dx  .OR.  y_end(l) > ( ny + 1 ) * dx )  THEN
-             message_string = 'Flight leg or parts of it are outside the model domain'
-             CALL message( 'flight_check_parameters', 'PA0434', 1, 2, 0, 6, 0 )
-          ENDIF
-       ELSE
-          message_string = 'Unknown flight mode'
-          CALL message( 'flight_check_parameters', 'PA0435', 1, 2, 0, 6, 0 )
-       ENDIF
-
-    ENDDO
-!
-!-- Check if given flight object remains inside model domain if a rate of climb / descent is
-!-- prescribed.
-    DO  l = 1, num_leg
-       IF ( flight_level(l) + max_elev_change(l) > zu(nz) .OR.                                     &
-            flight_level(l) + max_elev_change(l) <= 0.0_wp )  THEN
-          message_string = 'Flight level is outside the model domain '
-          CALL message( 'flight_check_parameters', 'PA0438', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDDO
-!
-!-- Check for appropriate NetCDF format. Definition of more than one unlimited dimension is
-!-- unfortunately only possible with NetCDF4/HDF5.
-    IF (  netcdf_data_format <= 2 )  THEN
-       message_string = 'netcdf_data_format must be > 2'
-       CALL message( 'flight_check_parameters', 'PA0439', 1, 2, 0, 6, 0 )
-    ENDIF
-
-
- END SUBROUTINE flight_check_parameters
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE flight_rrd_global_ftn( found )
-
-
-    USE control_parameters,                                                                        &
-        ONLY: length,                                                                              &
-              restart_string
-
-
-    IMPLICIT NONE
-
-    LOGICAL, INTENT(OUT)  ::  found  !< flag indicating if a variable string is found
-
-
-    found = .TRUE.
-
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'u_agl' )
-          IF ( .NOT. ALLOCATED( u_agl ) )  ALLOCATE( u_agl(1:num_leg) )
-          READ ( 13 )  u_agl
-       CASE ( 'v_agl' )
-          IF ( .NOT. ALLOCATED( v_agl ) )  ALLOCATE( v_agl(1:num_leg) )
-          READ ( 13 )  v_agl
-       CASE ( 'w_agl' )
-          IF ( .NOT. ALLOCATED( w_agl ) )  ALLOCATE( w_agl(1:num_leg) )
-          READ ( 13 )  w_agl
-       CASE ( 'x_pos' )
-          IF ( .NOT. ALLOCATED( x_pos ) )  ALLOCATE( x_pos(1:num_leg) )
-          READ ( 13 )  x_pos
-       CASE ( 'y_pos' )
-          IF ( .NOT. ALLOCATED( y_pos ) )  ALLOCATE( y_pos(1:num_leg) )
-          READ ( 13 )  y_pos
-       CASE ( 'z_pos' )
-          IF ( .NOT. ALLOCATED( z_pos ) )  ALLOCATE( z_pos(1:num_leg) )
-          READ ( 13 )  z_pos
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE flight_rrd_global_ftn
-
-
- 
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!------------------------------------------------------------------------------!
- SUBROUTINE flight_rrd_global_mpi
-
-
-    IMPLICIT NONE
-
-    LOGICAL  ::  array_found  !< flag indicating if respective array is found in restart file
-
-
-    CALL rd_mpi_io_check_array( 'u_agl', found = array_found )
-    IF ( array_found)  THEN
-       IF ( .NOT. ALLOCATED( u_agl ) )  ALLOCATE( u_agl(1:num_leg) )
-       CALL rrd_mpi_io_global_array( 'u_agl', u_agl )
-    ENDIF
-    CALL rd_mpi_io_check_array( 'v_agl', found = array_found )
-    IF ( array_found)  THEN
-       IF ( .NOT. ALLOCATED( v_agl ) )  ALLOCATE( v_agl(1:num_leg) )
-       CALL rrd_mpi_io_global_array( 'v_agl', v_agl )
-    ENDIF
-    CALL rd_mpi_io_check_array( 'w_agl', found = array_found )
-    IF ( array_found)  THEN
-       IF ( .NOT. ALLOCATED( w_agl ) )  ALLOCATE( w_agl(1:num_leg) )
-       CALL rrd_mpi_io_global_array( 'w_agl', w_agl )
-    ENDIF
-    CALL rd_mpi_io_check_array( 'x_pos', found = array_found )
-    IF ( array_found)  THEN
-       IF ( .NOT. ALLOCATED( x_pos ) )  ALLOCATE( x_pos(1:num_leg) )
-       CALL rrd_mpi_io_global_array( 'x_pos', x_pos )
-    ENDIF
-    CALL rd_mpi_io_check_array( 'y_pos', found = array_found )
-    IF ( array_found)  THEN
-       IF ( .NOT. ALLOCATED( y_pos ) )  ALLOCATE( y_pos(1:num_leg) )
-       CALL rrd_mpi_io_global_array( 'y_pos', y_pos )
-    ENDIF
-    CALL rd_mpi_io_check_array( 'z_pos', found = array_found )
-    IF ( array_found)  THEN
-       IF ( .NOT. ALLOCATED( z_pos ) )  ALLOCATE( z_pos(1:num_leg) )
-       CALL rrd_mpi_io_global_array( 'z_pos', z_pos )
-    ENDIF
-
- END SUBROUTINE flight_rrd_global_mpi
-
-    
-    !--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE flight_wrd_global
-
-
-    IMPLICIT NONE
-
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL wrd_write_string( 'u_agl' )
-       WRITE ( 14 )  u_agl
-
-       CALL wrd_write_string( 'v_agl' )
-       WRITE ( 14 )  v_agl
-
-       CALL wrd_write_string( 'w_agl' )
-       WRITE ( 14 )  w_agl
-
-       CALL wrd_write_string( 'x_pos' )
-       WRITE ( 14 )  x_pos
-
-       CALL wrd_write_string( 'y_pos' )
-       WRITE ( 14 )  y_pos
-
-       CALL wrd_write_string( 'z_pos' )
-       WRITE ( 14 )  z_pos
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       CALL wrd_mpi_io_global_array( 'u_agl', u_agl )
-       CALL wrd_mpi_io_global_array( 'v_agl', v_agl )
-       CALL wrd_mpi_io_global_array( 'w_agl', w_agl )
-       CALL wrd_mpi_io_global_array( 'x_pos', x_pos )
-       CALL wrd_mpi_io_global_array( 'y_pos', y_pos )
-       CALL wrd_mpi_io_global_array( 'z_pos', z_pos )
-
-    ENDIF
-
- END SUBROUTINE flight_wrd_global
-
-
- END MODULE flight_mod
Index: palm/trunk/SOURCE/virtual_measurement_mod.f90
===================================================================
--- palm/trunk/SOURCE/virtual_measurement_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,2965 +1,0 @@
-!> @virtual_measurement_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! Reduce number of additional grid point output in z for timeseries data to a reasonable number
-!
-! 4843 2021-01-15 15:22:11Z raasch
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more,
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! - Add control flags
-!
-! 4764 2020-10-30 12:50:36Z suehring
-! Missing variable declaration and directives for netcdf4 added
-!
-! 4763 2020-10-30 12:06:47Z suehring
-! - Simplified input of coordinates. All coordinate and height arrays are now 1D, independent on
-!   featuretype. This allows easier usage also for other campaign data sets independent of UC2.
-! - Avoid type conversion from 64 to 32 bit when output the data
-! - Increase dimension size of sample-variable string (sometimes more than 100 variables are listed
-!   for heavy measured locations)
-! - Remove quantities that cannot be sampled
-!
-! 4752 2020-10-21 13:54:51Z suehring
-! Remove unnecessary output and merge output for quantities that are represented by the same
-! variable in PALM, e.g. surface temperature and brightness temperature
-!
-! 4707 2020-09-28 14:25:28Z suehring
-! Bugfix for previous commit + minor formatting adjustments
-!
-! 4706 2020-09-28 13:15:23Z suehring
-! Revise setting of measurement height above ground for trajectory measurements
-!
-! 4695 2020-09-24 11:30:03Z suehring
-! Introduce additional namelist parameters to further customize sampling in the horizontal and
-! vertical surroundings of the original observation coordinates
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4645 2020-08-24 13:55:58Z suehring
-! Bugfix in output of E_UTM_soil coordinate
-!
-! 4642 2020-08-13 15:47:33Z suehring
-! Do not set attribute bounds for time variable, as it refers to time_bounds which is not defined
-! for non-aggregated quantities (according to data standard)
-!
-! 4641 2020-08-13 09:57:07Z suehring
-! - To be in agreement with (UC)2 data standard do not list the measured variables in attribute
-!   data_content but simply set 'airmeteo'
-! - Bugfix in setting long_name attribute for variable t_va and for global attribute creation_time
-! 
-! 4536 2020-05-17 17:24:13Z raasch
-! bugfix: preprocessor directive adjusted
-!
-! 4504 2020-04-20 12:11:24Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4481 2020-03-31 18:55:54Z maronga
-! bugfix: cpp-directives for serial mode added
-!
-! 4438 2020-03-03 20:49:28Z suehring
-! Add cpu-log points
-!
-! 4422 2020-02-24 22:45:13Z suehring
-! Missing trim()
-!
-! 4408 2020-02-14 10:04:39Z gronemeier
-! - Output of character string station_name after DOM has been enabled to
-!   output character variables
-! - Bugfix, missing coupling_char statement when opening the input file
-!
-! 4408 2020-02-14 10:04:39Z gronemeier
-! write fill_value attribute
-!
-! 4406 2020-02-13 20:06:29Z knoop
-! Bugix: removed oro_rel wrong loop bounds and removed unnecessary restart method
-!
-! 4400 2020-02-10 20:32:41Z suehring
-! Revision of the module:
-! - revised input from NetCDF setup file
-! - parallel NetCDF output via data-output module ( Tobias Gronemeier )
-! - variable attributes added
-! - further variables defined
-!
-! 4346 2019-12-18 11:55:56Z motisi
-! Introduction of wall_flags_total_0, which currently sets bits based on static
-! topography information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4226 2019-09-10 17:03:24Z suehring
-! Netcdf input routine for dimension length renamed
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4168 2019-08-16 13:50:17Z suehring
-! Replace function get_topography_top_index by topo_top_ind
-!
-! 3988 2019-05-22 11:32:37Z kanani
-! Add variables to enable steering of output interval for virtual measurements
-!
-! 3913 2019-04-17 15:12:28Z gronemeier
-! Bugfix: rotate positions of measurements before writing them into file
-!
-! 3910 2019-04-17 11:46:56Z suehring
-! Bugfix in rotation of UTM coordinates
-!
-! 3904 2019-04-16 18:22:51Z gronemeier
-! Rotate coordinates of stations by given rotation_angle
-!
-! 3876 2019-04-08 18:41:49Z knoop
-! Remove print statement
-!
-! 3854 2019-04-02 16:59:33Z suehring
-! renamed nvar to nmeas, replaced USE chem_modules by USE chem_gasphase_mod and
-! nspec by nvar
-!
-! 3766 2019-02-26 16:23:41Z raasch
-! unused variables removed
-!
-! 3718 2019-02-06 11:08:28Z suehring
-! Adjust variable name connections between UC2 and chemistry variables
-!
-! 3717 2019-02-05 17:21:16Z suehring
-! Additional check + error numbers adjusted
-!
-! 3706 2019-01-29 20:02:26Z suehring
-! unused variables removed
-!
-! 3705 2019-01-29 19:56:39Z suehring
-! - initialization revised
-! - binary data output
-! - list of allowed variables extended
-!
-! 3704 2019-01-29 19:51:41Z suehring
-! Sampling of variables
-!
-! 3473 2018-10-30 20:50:15Z suehring
-! Initial revision
-!
-! Authors:
-! --------
-! @author Matthias Suehring
-! @author Tobias Gronemeier
-!
-! Description:
-! ------------
-!> The module acts as an interface between 'real-world' observations and model simulations.
-!> Virtual measurements will be taken in the model at the coordinates representative for the
-!> 'real-world' observation coordinates. More precisely, coordinates and measured quanties will be
-!> read from a NetCDF file which contains all required information. In the model, the same
-!> quantities (as long as all the required PALM-modules are switched-on) will be sampled at the
-!> respective positions and output into an extra file, which allows for straight-forward comparison
-!> of model results with observations.
-!--------------------------------------------------------------------------------------------------!
- MODULE virtual_measurement_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  dzw,                                                                                &
-               exner,                                                                              &
-               hyp,                                                                                &
-               q,                                                                                  &
-               ql,                                                                                 &
-               pt,                                                                                 &
-               rho_air,                                                                            &
-               u,                                                                                  &
-               v,                                                                                  &
-               w,                                                                                  &
-               zu,                                                                                 &
-               zw
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  convert_utm_to_geographic,                                                          &
-               degc_to_k,                                                                          &
-               magnus,                                                                             &
-               pi,                                                                                 &
-               rd_d_rv
-
-    USE chem_gasphase_mod,                                                                         &
-        ONLY:  nvar
-
-    USE chem_modules,                                                                              &
-        ONLY:  chem_species
-
-    USE control_parameters,                                                                        &
-        ONLY:  air_chemistry,                                                                      &
-               coupling_char,                                                                      &
-               debug_output,                                                                       &
-               dz,                                                                                 &
-               end_time,                                                                           &
-               humidity,                                                                           &
-               land_surface,                                                                       &
-               message_string,                                                                     &
-               neutral,                                                                            &
-               origin_date_time,                                                                   &
-               rho_surface,                                                                        &
-               surface_pressure,                                                                   &
-               time_since_reference_point,                                                         &
-               virtual_measurement
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log,                                                                            &
-               log_point_s
-
-    USE data_output_module
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx,                                                                                &
-               ddy,                                                                                &
-               dx,                                                                                 &
-               dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp,                                                                               &
-               nzb,                                                                                &
-               nzt,                                                                                &
-               nxl,                                                                                &
-               nxlg,                                                                               &
-               nxr,                                                                                &
-               nxrg,                                                                               &
-               nys,                                                                                &
-               nysg,                                                                               &
-               nyn,                                                                                &
-               nyng,                                                                               &
-               topo_top_ind,                                                                       &
-               wall_flags_total_0
-
-    USE kinds
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  close_input_file,                                                                   &
-               coord_ref_sys,                                                                      &
-               crs_list,                                                                           &
-               get_attribute,                                                                      &
-               get_dimension_length,                                                               &
-               get_variable,                                                                       &
-               init_model,                                                                         &
-               input_file_atts,                                                                    &
-               input_file_vm,                                                                      &
-               input_pids_static,                                                                  &
-               input_pids_vm,                                                                      &
-               inquire_fill_value,                                                                 &
-               open_read_file,                                                                     &
-               pids_id
-
-    USE pegrid
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_lsm_h,                                                                         &
-               surf_usm_h
-
-    USE land_surface_model_mod,                                                                    &
-        ONLY:  m_soil_h,                                                                           &
-               nzb_soil,                                                                           &
-               nzt_soil,                                                                           &
-               t_soil_h,                                                                           &
-               zs
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  rad_lw_in,                                                                          &
-               rad_lw_out,                                                                         &
-               rad_sw_in,                                                                          &
-               rad_sw_in_diff,                                                                     &
-               rad_sw_out,                                                                         &
-               radiation_scheme
-
-    USE urban_surface_mod,                                                                         &
-        ONLY:  nzb_wall,                                                                           &
-               nzt_wall,                                                                           &
-               t_wall_h
-
-
-    IMPLICIT NONE
-
-    TYPE virt_general
-       INTEGER(iwp) ::  nvm = 0  !< number of virtual measurements
-    END TYPE virt_general
-
-    TYPE virt_var_atts
-       CHARACTER(LEN=100) ::  coordinates           !< defined longname of the variable
-       CHARACTER(LEN=100) ::  grid_mapping          !< defined longname of the variable
-       CHARACTER(LEN=100) ::  long_name             !< defined longname of the variable
-       CHARACTER(LEN=100) ::  name                  !< variable name
-       CHARACTER(LEN=100) ::  standard_name         !< defined standard name of the variable
-       CHARACTER(LEN=100) ::  units                 !< unit of the output variable
-
-       REAL(wp)           ::  fill_value = -9999.0  !< _FillValue attribute
-    END TYPE virt_var_atts
-
-    TYPE virt_mea
-       CHARACTER(LEN=100)  ::  feature_type                      !< type of the real-world measurement
-       CHARACTER(LEN=100)  ::  feature_type_out = 'timeSeries'   !< type of the virtual measurement
-                                                                 !< (all will be timeSeries, even trajectories)
-       CHARACTER(LEN=100)  ::  nc_filename                       !< name of the NetCDF output file for the station
-       CHARACTER(LEN=100)  ::  site                              !< name of the measurement site
-
-       CHARACTER(LEN=1000) ::  data_content = REPEAT(' ', 1000)  !< string of measured variables (data output only)
-
-       INTEGER(iwp) ::  end_coord_a     = 0  !< end coordinate in NetCDF file for local atmosphere observations
-       INTEGER(iwp) ::  end_coord_s     = 0  !< end coordinate in NetCDF file for local soil observations
-       INTEGER(iwp) ::  file_time_index = 0  !< time index in NetCDF output file
-       INTEGER(iwp) ::  ns              = 0  !< number of observation coordinates on subdomain, for atmospheric measurements
-       INTEGER(iwp) ::  ns_tot          = 0  !< total number of observation coordinates, for atmospheric measurements
-       INTEGER(iwp) ::  nst                  !< number of coordinate points given for a measurement
-       INTEGER(iwp) ::  nmeas                !< number of measured variables (atmosphere + soil)
-       INTEGER(iwp) ::  ns_soil         = 0  !< number of observation coordinates on subdomain, for soil measurements
-       INTEGER(iwp) ::  ns_soil_tot     = 0  !< total number of observation coordinates, for soil measurements
-       INTEGER(iwp) ::  start_coord_a   = 0  !< start coordinate in NetCDF file for local atmosphere observations
-       INTEGER(iwp) ::  start_coord_s   = 0  !< start coordinate in NetCDF file for local soil observations
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  dim_t  !< number observations individual for each trajectory
-                                                          !< or station that are no _FillValues
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  i       !< grid index for measurement position in x-direction
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j       !< grid index for measurement position in y-direction
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k       !< grid index for measurement position in k-direction
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  i_soil  !< grid index for measurement position in x-direction
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j_soil  !< grid index for measurement position in y-direction
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k_soil  !< grid index for measurement position in k-direction
-
-       LOGICAL ::  soil_sampling      = .FALSE.  !< flag indicating that soil state variables were sampled
-       LOGICAL ::  trajectory         = .FALSE.  !< flag indicating that the observation is a mobile observation
-       LOGICAL ::  timseries          = .FALSE.  !< flag indicating that the observation is a stationary point measurement
-       LOGICAL ::  timseries_profile  = .FALSE.  !< flag indicating that the observation is a stationary profile measurement
-
-       REAL(wp) ::  fill_eutm          !< fill value for UTM coordinates in case of missing values
-       REAL(wp) ::  fill_nutm          !< fill value for UTM coordinates in case of missing values
-       REAL(wp) ::  fill_zar           !< fill value for heigth coordinates in case of missing values
-       REAL(wp) ::  fillout = -9999.0  !< fill value for output in case an observation is taken e.g. from inside a building
-       REAL(wp) ::  origin_x_obs       !< origin of the observation in UTM coordiates in x-direction
-       REAL(wp) ::  origin_y_obs       !< origin of the observation in UTM coordiates in y-direction
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  depth  !< measurement depth in soil
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  zar    !< measurement height above ground level
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  measured_vars       !< measured variables
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  measured_vars_soil  !< measured variables
-
-       TYPE( virt_var_atts ), DIMENSION(:), ALLOCATABLE ::  var_atts !< variable attributes
-    END TYPE virt_mea
-
-    CHARACTER(LEN=5)  ::  char_eutm = 'E_UTM'            !< dimension name for UTM coordinate easting
-    CHARACTER(LEN=11) ::  char_feature = 'featureType'   !< attribute name for feature type
-
-    ! This need to be generalized
-    CHARACTER(LEN=10) ::  char_fill = '_FillValue'                 !< attribute name for fill value
-    CHARACTER(LEN=6)  ::  char_height = 'height'                   !< attribute name indicating height above surface (for trajectories only)
-    CHARACTER(LEN=9)  ::  char_long = 'long_name'                  !< attribute name for long_name
-    CHARACTER(LEN=18) ::  char_mv = 'measured_variables'           !< variable name for the array with the measured variable names
-    CHARACTER(LEN=5)  ::  char_nutm = 'N_UTM'                      !< dimension name for UTM coordinate northing
-    CHARACTER(LEN=18) ::  char_numstations = 'number_of_stations'  !< attribute name for number of stations
-    CHARACTER(LEN=8)  ::  char_origx = 'origin_x'                  !< attribute name for station coordinate in x
-    CHARACTER(LEN=8)  ::  char_origy = 'origin_y'                  !< attribute name for station coordinate in y
-    CHARACTER(LEN=4)  ::  char_site = 'site'                       !< attribute name for site name
-    CHARACTER(LEN=11) ::  char_soil = 'soil_sample'                !< attribute name for soil sampling indication
-    CHARACTER(LEN=13) ::  char_standard = 'standard_name'          !< attribute name for standard_name
-    CHARACTER(LEN=9)  ::  char_station_h = 'station_h'             !< variable name indicating height of the site
-    CHARACTER(LEN=5)  ::  char_unit = 'units'                      !< attribute name for standard_name
-    CHARACTER(LEN=1)  ::  char_zar = 'z'                           !< attribute name indicating height above reference level
-    CHARACTER(LEN=10) ::  type_ts   = 'timeSeries'                 !< name of stationary point measurements
-    CHARACTER(LEN=10) ::  type_traj = 'trajectory'                 !< name of line measurements
-    CHARACTER(LEN=17) ::  type_tspr = 'timeSeriesProfile'          !< name of stationary profile measurements
-
-    CHARACTER(LEN=6), DIMENSION(1:5) ::  soil_vars = (/ 't_soil', & !< list of soil variables
-                                                        'm_soil',                                  &
-                                                        'lwc   ',                                  &
-                                                        'lwcs  ',                                  &
-                                                        'smp   ' /)
-
-    CHARACTER(LEN=10), DIMENSION(0:1,1:9) ::  chem_vars = RESHAPE( (/ 'mcpm1     ', 'PM1       ',  &
-                                                                      'mcpm2p5   ', 'PM2.5     ',  &
-                                                                      'mcpm10    ', 'PM10      ',  &
-                                                                      'mfno2     ', 'NO2       ',  &
-                                                                      'mfno      ', 'NO        ',  &
-                                                                      'mcno2     ', 'NO2       ',  &
-                                                                      'mcno      ', 'NO        ',  &
-                                                                      'tro3      ', 'O3        ',  &
-                                                                      'ncaa      ', 'PM10      '   & !simply assume ncaa to be PM10
-                                                                    /), (/ 2, 9 /) )
-
-    INTEGER(iwp) ::  maximum_name_length = 32  !< maximum name length of station names
-    INTEGER(iwp) ::  ntimesteps                !< number of timesteps defined in NetCDF output file
-    INTEGER(iwp) ::  off_pr              = 1   !< number of neighboring grid points (in horizontal direction) where virtual profile
-                                               !< measurements shall be taken, in addition to the given coordinates in the driver
-    INTEGER(iwp) ::  off_pr_z            = 0   !< number of additional grid points (in each upwardd and downward direction) where 
-                                               !< virtual profile measurements shall be taken, in addition to the given z coordinates in the driver
-    INTEGER(iwp) ::  off_ts              = 1   !< number of neighboring grid points (in horizontal direction) where virtual profile
-                                               !< measurements shall be taken, in addition to the given coordinates in the driver
-    INTEGER(iwp) ::  off_ts_z            = 1   !< number of additional grid points (in each upwardd and downward direction) where
-                                               !< virtual profile measurements shall be taken, in addition to the given z coordinates in the driver
-    INTEGER(iwp) ::  off_tr              = 1   !< number of neighboring grid points (in horizontal direction) where virtual profile
-                                               !< measurements shall be taken, in addition to the given coordinates in the driver
-    INTEGER(iwp) ::  off_tr_z            = 1   !< number of additional grid points (in each upwardd and downward direction) where 
-                                               !< virtual profile measurements shall be taken, in addition to the given z coordinates in the driver
-    LOGICAL ::  global_attribute          = .TRUE.   !< flag indicating a global attribute
-    LOGICAL ::  initial_write_coordinates = .FALSE.  !< flag indicating a global attribute
-
-    REAL(wp) ::  dt_virtual_measurement   = 0.0_wp  !< sampling interval
-    REAL(wp) ::  time_virtual_measurement = 0.0_wp  !< time since last sampling
-    REAL(wp) ::  vm_time_start            = 0.0     !< time after which sampling shall start
-
-    TYPE( virt_general )                        ::  vmea_general  !< data structure which encompasses global variables
-    TYPE( virt_mea ), DIMENSION(:), ALLOCATABLE ::  vmea          !< data structure containing station-specific variables
-
-    INTERFACE vm_check_parameters
-       MODULE PROCEDURE vm_check_parameters
-    END INTERFACE vm_check_parameters
-
-    INTERFACE vm_data_output
-       MODULE PROCEDURE vm_data_output
-    END INTERFACE vm_data_output
-
-    INTERFACE vm_init
-       MODULE PROCEDURE vm_init
-    END INTERFACE vm_init
-
-    INTERFACE vm_init_output
-       MODULE PROCEDURE vm_init_output
-    END INTERFACE vm_init_output
-
-    INTERFACE vm_parin
-       MODULE PROCEDURE vm_parin
-    END INTERFACE vm_parin
-
-    INTERFACE vm_sampling
-       MODULE PROCEDURE vm_sampling
-    END INTERFACE vm_sampling
-
-    SAVE
-
-    PRIVATE
-
-!
-!-- Public interfaces
-    PUBLIC  vm_check_parameters,                                                                   &
-            vm_data_output,                                                                        &
-            vm_init,                                                                               &
-            vm_init_output,                                                                        &
-            vm_parin,                                                                              &
-            vm_sampling
-
-!
-!-- Public variables
-    PUBLIC  dt_virtual_measurement,                                                                &
-            time_virtual_measurement,                                                              &
-            vmea,                                                                                  &
-            vmea_general,                                                                          &
-            vm_time_start
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check parameters for virtual measurement module
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vm_check_parameters
-
-    IF ( .NOT. virtual_measurement )  RETURN
-!
-!-- Virtual measurements require a setup file.
-    IF ( .NOT. input_pids_vm )  THEN
-       message_string = 'If virtual measurements are taken, a setup input ' //                     &
-                        'file for the site locations is mandatory.'
-       CALL message( 'vm_check_parameters', 'PA0533', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- In case virtual measurements are taken, a static input file is required.
-!-- This is because UTM coordinates for the PALM domain origin are required for correct mapping of
-!-- the measurements.
-!-- ToDo: Revise this later and remove this requirement.
-    IF ( .NOT. input_pids_static )  THEN
-       message_string = 'If virtual measurements are taken, a static input file is mandatory.'
-       CALL message( 'vm_check_parameters', 'PA0534', 1, 2, 0, 6, 0 )
-    ENDIF
-
-#if !defined( __netcdf4_parallel )
-!
-!-- In case of non-parallel NetCDF the virtual measurement output is not
-!-- working. This is only designed for parallel NetCDF.
-    message_string = 'If virtual measurements are taken, parallel NetCDF is required.'
-    CALL message( 'vm_check_parameters', 'PA0708', 1, 2, 0, 6, 0 )
-#endif
-!
-!-- Check if the given number of neighboring grid points do not exceed the number
-!-- of ghost points.
-    IF ( off_pr > nbgp - 1  .OR.  off_ts > nbgp - 1  .OR.  off_tr > nbgp - 1 )  THEN
-       WRITE(message_string,*)                                                                     &
-                        'If virtual measurements are taken, the number ' //                        &
-                        'of surrounding grid points must not be larger ' //                        &
-                        'than the number of ghost points - 1, which is: ', nbgp - 1
-       CALL message( 'vm_check_parameters', 'PA0705', 1, 2, 0, 6, 0 )
-    ENDIF
-
-    IF ( dt_virtual_measurement <= 0.0 )  THEN
-       message_string = 'dt_virtual_measurement must be > 0.0'
-       CALL message( 'check_parameters', 'PA0706', 1, 2, 0, 6, 0 )
-    ENDIF
-
- END SUBROUTINE vm_check_parameters
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Subroutine defines variable attributes according to UC2 standard. Note, later  this list can be
-!> moved to the data-output module where it can be re-used also for other output.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vm_set_attributes( output_variable )
-
-    TYPE( virt_var_atts ), INTENT(INOUT) ::  output_variable !< data structure with attributes that need to be set
-
-    output_variable%long_name     = 'none'
-    output_variable%standard_name = 'none'
-    output_variable%units         = 'none'
-    output_variable%coordinates   = 'lon lat E_UTM N_UTM x y z time station_name'
-    output_variable%grid_mapping  = 'crs'
-
-    SELECT CASE ( TRIM( output_variable%name ) )
-
-       CASE ( 'u' )
-          output_variable%long_name     = 'u wind component'
-          output_variable%units         = 'm s-1'
-
-       CASE ( 'ua' )
-          output_variable%long_name     = 'eastward wind'
-          output_variable%standard_name = 'eastward_wind'
-          output_variable%units         = 'm s-1'
-
-       CASE ( 'v' )
-          output_variable%long_name     = 'v wind component'
-          output_variable%units         = 'm s-1'
-
-       CASE ( 'va' )
-          output_variable%long_name     = 'northward wind'
-          output_variable%standard_name = 'northward_wind'
-          output_variable%units         = 'm s-1'
-
-       CASE ( 'w' )
-          output_variable%long_name     = 'w wind component'
-          output_variable%standard_name = 'upward_air_velocity'
-          output_variable%units         = 'm s-1'
-
-       CASE ( 'wspeed' )
-          output_variable%long_name     = 'wind speed'
-          output_variable%standard_name = 'wind_speed'
-          output_variable%units         = 'm s-1'
-
-       CASE ( 'wdir' )
-          output_variable%long_name     = 'wind from direction'
-          output_variable%standard_name = 'wind_from_direction'
-          output_variable%units         = 'degrees'
-
-       CASE ( 'theta' )
-          output_variable%long_name     = 'air potential temperature'
-          output_variable%standard_name = 'air_potential_temperature'
-          output_variable%units         = 'K'
-
-       CASE ( 'utheta' )
-          output_variable%long_name     = 'eastward kinematic sensible heat flux in air'
-          output_variable%units         = 'K m s-1'
-
-       CASE ( 'vtheta' )
-          output_variable%long_name     = 'northward kinematic sensible heat flux in air'
-          output_variable%units         = 'K m s-1'
-
-       CASE ( 'wtheta' )
-          output_variable%long_name     = 'upward kinematic sensible heat flux in air'
-          output_variable%units         = 'K m s-1'
-
-       CASE ( 'ta' )
-          output_variable%long_name     = 'air temperature'
-          output_variable%standard_name = 'air_temperature'
-          output_variable%units         = 'degree_C'
-
-       CASE ( 't_va' )
-          output_variable%long_name     = 'virtual acoustic temperature'
-          output_variable%units         = 'K'
-
-       CASE ( 'haa' )
-          output_variable%long_name     = 'absolute atmospheric humidity'
-          output_variable%units         = 'kg m-3'
-
-       CASE ( 'hus' )
-          output_variable%long_name     = 'specific humidity'
-          output_variable%standard_name = 'specific_humidity'
-          output_variable%units         = 'kg kg-1'
-
-       CASE ( 'hur' )
-          output_variable%long_name     = 'relative humidity'
-          output_variable%standard_name = 'relative_humidity'
-          output_variable%units         = '1'
-
-       CASE ( 'rlu' )
-          output_variable%long_name     = 'upwelling longwave flux in air'
-          output_variable%standard_name = 'upwelling_longwave_flux_in_air'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'rlus' )
-          output_variable%long_name     = 'surface upwelling longwave flux in air'
-          output_variable%standard_name = 'surface_upwelling_longwave_flux_in_air'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'rld' )
-          output_variable%long_name     = 'downwelling longwave flux in air'
-          output_variable%standard_name = 'downwelling_longwave_flux_in_air'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'rsddif' )
-          output_variable%long_name     = 'diffuse downwelling shortwave flux in air'
-          output_variable%standard_name = 'diffuse_downwelling_shortwave_flux_in_air'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'rsd' )
-          output_variable%long_name     = 'downwelling shortwave flux in air'
-          output_variable%standard_name = 'downwelling_shortwave_flux_in_air'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'rnds' )
-          output_variable%long_name     = 'surface net downward radiative flux'
-          output_variable%standard_name = 'surface_net_downward_radiative_flux'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'rsu' )
-          output_variable%long_name     = 'upwelling shortwave flux in air'
-          output_variable%standard_name = 'upwelling_shortwave_flux_in_air'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'rsus' )
-          output_variable%long_name     = 'surface upwelling shortwave flux in air'
-          output_variable%standard_name = 'surface_upwelling_shortwave_flux_in_air'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'rsds' )
-          output_variable%long_name     = 'surface downwelling shortwave flux in air'
-          output_variable%standard_name = 'surface_downwelling_shortwave_flux_in_air'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'hfss' )
-          output_variable%long_name     = 'surface upward sensible heat flux'
-          output_variable%standard_name = 'surface_upward_sensible_heat_flux'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'hfls' )
-          output_variable%long_name     = 'surface upward latent heat flux'
-          output_variable%standard_name = 'surface_upward_latent_heat_flux'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'ts' )
-          output_variable%long_name     = 'surface temperature'
-          output_variable%standard_name = 'surface_temperature'
-          output_variable%units         = 'K'
-
-       CASE ( 'thetas' )
-          output_variable%long_name     = 'surface layer temperature scale'
-          output_variable%units         = 'K'
-
-       CASE ( 'us' )
-          output_variable%long_name     = 'friction velocity'
-          output_variable%units         = 'm s-1'
-
-       CASE ( 'uw' )
-          output_variable%long_name     = 'upward eastward kinematic momentum flux in air'
-          output_variable%units         = 'm2 s-2'
-
-       CASE ( 'vw' )
-          output_variable%long_name     = 'upward northward kinematic momentum flux in air'
-          output_variable%units         = 'm2 s-2'
-
-       CASE ( 'uv' )
-          output_variable%long_name     = 'eastward northward kinematic momentum flux in air'
-          output_variable%units         = 'm2 s-2'
-
-       CASE ( 'm_soil' )
-          output_variable%long_name     = 'soil moisture volumetric'
-          output_variable%units         = 'm3 m-3'
-
-       CASE ( 't_soil' )
-          output_variable%long_name     = 'soil temperature'
-          output_variable%standard_name = 'soil_temperature'
-          output_variable%units         = 'degree_C'
-
-       CASE ( 'hfdg' )
-          output_variable%long_name     = 'downward heat flux at ground level in soil'
-          output_variable%standard_name = 'downward_heat_flux_at_ground_level_in_soil'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'hfds' )
-          output_variable%long_name     = 'downward heat flux in soil'
-          output_variable%standard_name = 'downward_heat_flux_in_soil'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'hfla' )
-          output_variable%long_name     = 'upward latent heat flux in air'
-          output_variable%standard_name = 'upward_latent_heat_flux_in_air'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'hfsa' )
-          output_variable%long_name     = 'upward latent heat flux in air'
-          output_variable%standard_name = 'upward_sensible_heat_flux_in_air'
-          output_variable%units         = 'W m-2'
-
-       CASE ( 'jno2' )
-          output_variable%long_name     = 'photolysis rate of nitrogen dioxide'
-          output_variable%standard_name = 'photolysis_rate_of_nitrogen_dioxide'
-          output_variable%units         = 's-1'
-
-       CASE ( 'lwcs' )
-          output_variable%long_name     = 'liquid water content of soil layer'
-          output_variable%standard_name = 'liquid_water_content_of_soil_layer'
-          output_variable%units         = 'kg m-2'
-
-       CASE ( 'lwp' )
-          output_variable%long_name     = 'liquid water path'
-          output_variable%standard_name = 'atmosphere_mass_content_of_cloud_liquid_water'
-          output_variable%units         = 'kg m-2'
-
-       CASE ( 'ps' )
-          output_variable%long_name     = 'surface air pressure'
-          output_variable%standard_name = 'surface_air_pressure'
-          output_variable%units         = 'hPa'
-
-       CASE ( 'pwv' )
-          output_variable%long_name     = 'water vapor partial pressure in air'
-          output_variable%standard_name = 'water_vapor_partial_pressure_in_air'
-          output_variable%units         = 'hPa'
-
-       CASE ( 't_lw' )
-          output_variable%long_name     = 'land water temperature'
-          output_variable%units         = 'degree_C'
-
-       CASE ( 'tb' )
-          output_variable%long_name     = 'brightness temperature'
-          output_variable%standard_name = 'brightness_temperature'
-          output_variable%units         = 'K'
-
-       CASE ( 'uqv' )
-          output_variable%long_name     = 'eastward kinematic latent heat flux in air'
-          output_variable%units         = 'g kg-1 m s-1'
-
-       CASE ( 'vqv' )
-          output_variable%long_name     = 'northward kinematic latent heat flux in air'
-          output_variable%units         = 'g kg-1 m s-1'
-
-       CASE ( 'wqv' )
-          output_variable%long_name     = 'upward kinematic latent heat flux in air'
-          output_variable%units         = 'g kg-1 m s-1'
-
-       CASE ( 'mcpm1' )
-          output_variable%long_name     = 'mass concentration of pm1 ambient aerosol particles in air'
-          output_variable%standard_name = 'mass_concentration_of_pm1_ambient_aerosol_particles_in_air'
-          output_variable%units         = 'kg m-3'
-
-       CASE ( 'mcpm10' )
-          output_variable%long_name     = 'mass concentration of pm10 ambient aerosol particles in air'
-          output_variable%standard_name = 'mass_concentration_of_pm10_ambient_aerosol_particles_in_air'
-          output_variable%units         = 'kg m-3'
-
-       CASE ( 'mcpm2p5' )
-          output_variable%long_name     = 'mass concentration of pm2p5 ambient aerosol particles in air'
-          output_variable%standard_name = 'mass_concentration_of_pm2p5_ambient_aerosol_particles_in_air'
-          output_variable%units         = 'kg m-3'
-
-       CASE ( 'mfno', 'mcno'  )
-          output_variable%long_name     = 'mole fraction of nitrogen monoxide in air'
-          output_variable%standard_name = 'mole_fraction_of_nitrogen_monoxide_in_air'
-          output_variable%units         = 'ppm' !'mol mol-1'
-
-       CASE ( 'mfno2', 'mcno2'  )
-          output_variable%long_name     = 'mole fraction of nitrogen dioxide in air'
-          output_variable%standard_name = 'mole_fraction_of_nitrogen_dioxide_in_air'
-          output_variable%units         = 'ppm' !'mol mol-1'
-
-       CASE ( 'ncaa' )
-          output_variable%long_name     = 'number concentration of ambient aerosol particles in air'
-          output_variable%standard_name = 'number_concentration_of_ambient_aerosol_particles_in_air'
-          output_variable%units         = 'm-3' !'mol mol-1'
-
-       CASE ( 'tro3'  )
-          output_variable%long_name     = 'mole fraction of ozone in air'
-          output_variable%standard_name = 'mole_fraction_of_ozone_in_air'
-          output_variable%units         = 'ppm' !'mol mol-1'
-
-       CASE DEFAULT
-
-    END SELECT
-
- END SUBROUTINE vm_set_attributes
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read namelist for the virtual measurement module
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vm_parin
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter file
-
-    INTEGER(iwp) ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /virtual_measurement_parameters/  dt_virtual_measurement,                             &
-                                               off_pr,                                             &
-                                               off_pr_z,                                           &
-                                               off_tr,                                             &
-                                               off_tr_z,                                           &
-                                               off_ts,                                             &
-                                               off_ts_z,                                           &
-                                               switch_off_module,                                  &
-                                               vm_time_start
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, virtual_measurement_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    virtual_measurements_parameters namelist was found and read correctly. Enable the
-!--    virtual measurements.
-       IF ( .NOT. switch_off_module )  virtual_measurement = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    virtual_measurement_parameters namelist was found but contained errors. Print an error
-!--    message including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'virtual_measurement_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE vm_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize virtual measurements: read coordiante arrays and measured variables, set indicies
-!> indicating the measurement points, read further attributes, etc..
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vm_init
-
-    CHARACTER(LEN=5)                  ::  dum                           !< dummy string indicating station id
-    CHARACTER(LEN=100), DIMENSION(200) ::  measured_variables_file = ''  !< array with all measured variables read from NetCDF
-    CHARACTER(LEN=100), DIMENSION(200) ::  measured_variables      = ''  !< dummy array with all measured variables that are allowed
-
-    INTEGER(iwp) ::  i          !< grid index of virtual observation point in x-direction
-    INTEGER(iwp) ::  is         !< grid index of real observation point of the respective station in x-direction
-    INTEGER(iwp) ::  j          !< grid index of observation point in x-direction
-    INTEGER(iwp) ::  js         !< grid index of real observation point of the respective station in y-direction
-    INTEGER(iwp) ::  k          !< grid index of observation point in x-direction
-    INTEGER(iwp) ::  kl         !< lower vertical index of surrounding grid points of an observation coordinate
-    INTEGER(iwp) ::  ks         !< grid index of real observation point of the respective station in z-direction
-    INTEGER(iwp) ::  ksurf      !< topography top index
-    INTEGER(iwp) ::  ku         !< upper vertical index of surrounding grid points of an observation coordinate
-    INTEGER(iwp) ::  l          !< running index over all stations
-    INTEGER(iwp) ::  len_char   !< character length of single measured variables without Null character
-    INTEGER(iwp) ::  ll         !< running index over all measured variables in file
-    INTEGER(iwp) ::  m          !< running index for surface elements
-#if defined( __netcdf4_parallel )
-    INTEGER(iwp) ::  n          !< running index over all cores
-#endif
-    INTEGER(iwp) ::  nofill     !< dummy for nofill return value (not used)
-    INTEGER(iwp) ::  ns         !< counter variable for number of observation points on subdomain
-    INTEGER(iwp) ::  off        !< number of horizontally surrounding grid points to be sampled
-    INTEGER(iwp) ::  off_z      !< number of vertically surrounding grid points to be sampled
-    INTEGER(iwp) ::  t          !< running index over number of trajectories
-
-    INTEGER(KIND=1)                             ::  soil_dum  !< dummy variable to input a soil flag
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE     ::  ns_all  !< dummy array used to sum-up the number of observation coordinates
-
-#if defined( __netcdf4_parallel )
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   ::  ns_atmos  !< number of observation points for each station on each mpi rank
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   ::  ns_soil   !< number of observation points for each station on each mpi rank
-#endif
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  meas_flag  !< mask array indicating measurement positions
-
-    LOGICAL  ::  on_pe  !< flag indicating that the respective measurement coordinate is on subdomain
-
-    REAL(wp) ::  fill_height !< _FillValue for height coordinate (for trajectories)
-    REAL(wp) ::  fill_eutm   !< _FillValue for coordinate array E_UTM
-    REAL(wp) ::  fill_nutm   !< _FillValue for coordinate array N_UTM
-    REAL(wp) ::  fill_zar    !< _FillValue for zar coordinate
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  e_utm      !< easting UTM coordinate, temporary variable
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  e_utm_tmp  !< EUTM coordinate before rotation
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  height     !< observation height above ground (for trajectories)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  n_utm      !< northing UTM coordinate, temporary variable
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  n_utm_tmp  !< NUTM coordinate before rotation
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  station_h  !< station height above reference
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  zar        !< observation height above reference
-
-    IF ( debug_output )  CALL debug_message( 'vm_init', 'start' )
-#if defined( __netcdf )
-!
-!-- Open the input file.
-    CALL open_read_file( TRIM( input_file_vm ) // TRIM( coupling_char ), pids_id )
-!
-!-- Obtain number of sites.
-    CALL get_attribute( pids_id, char_numstations, vmea_general%nvm, global_attribute )
-!
-!-- Allocate data structure which encompasses all required information, such as  grid points indicies,
-!-- absolute UTM coordinates, the measured quantities, etc. .
-    ALLOCATE( vmea(1:vmea_general%nvm) )
-!
-!-- Allocate flag array. This dummy array is used to identify grid points where virtual measurements
-!-- should be taken. Please note, in order to include also the surrounding grid points of the
-!-- original coordinate, ghost points are required.
-    ALLOCATE( meas_flag(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    meas_flag = 0
-!
-!-- Loop over all sites in the setup file.
-    DO  l = 1, vmea_general%nvm
-!
-!--    Determine suffix which contains the ID, ordered according to the number of measurements.
-       IF( l < 10 )  THEN
-          WRITE( dum, '(I1)')  l
-       ELSEIF( l < 100 )  THEN
-          WRITE( dum, '(I2)')  l
-       ELSEIF( l < 1000 )  THEN
-          WRITE( dum, '(I3)')  l
-       ELSEIF( l < 10000 )  THEN
-          WRITE( dum, '(I4)')  l
-       ELSEIF( l < 100000 )  THEN
-          WRITE( dum, '(I5)')  l
-       ENDIF
-!
-!--    Read the origin site coordinates (UTM).
-       CALL get_attribute( pids_id, char_origx // TRIM( dum ), vmea(l)%origin_x_obs, global_attribute )
-       CALL get_attribute( pids_id, char_origy // TRIM( dum ), vmea(l)%origin_y_obs, global_attribute )
-!
-!--    Read site name.
-       CALL get_attribute( pids_id, char_site // TRIM( dum ), vmea(l)%site, global_attribute )
-!
-!--    Read a flag which indicates that also soil quantities are take at the respective site
-!--    (is part of the virtual measurement driver).
-       CALL get_attribute( pids_id, char_soil // TRIM( dum ), soil_dum, global_attribute )
-!
-!--    Set flag indicating soil-sampling.
-       IF ( soil_dum == 1 )  vmea(l)%soil_sampling = .TRUE.
-!
-!--    Read type of the measurement (trajectory, profile, timeseries).
-       CALL get_attribute( pids_id, char_feature // TRIM( dum ), vmea(l)%feature_type, global_attribute )
-!
-!---   Set logicals depending on the type of the measurement
-       IF ( INDEX( vmea(l)%feature_type, type_tspr     ) /= 0 )  THEN
-          vmea(l)%timseries_profile = .TRUE.
-       ELSEIF ( INDEX( vmea(l)%feature_type, type_ts   ) /= 0 )  THEN
-          vmea(l)%timseries         = .TRUE.
-       ELSEIF ( INDEX( vmea(l)%feature_type, type_traj ) /= 0 )  THEN
-          vmea(l)%trajectory        = .TRUE.
-!
-!--    Give error message in case the type matches non of the pre-defined types.
-       ELSE
-          message_string = 'Attribue featureType = ' // TRIM( vmea(l)%feature_type ) // ' is not allowed.'
-          CALL message( 'vm_init', 'PA0535', 1, 2, 0, 6, 0 )
-       ENDIF
-!
-!--    Read string with all measured variables at this site.
-       measured_variables_file = ''
-       CALL get_variable( pids_id, char_mv // TRIM( dum ), measured_variables_file )
-!
-!--    Count the number of measured variables.
-!--    Please note, for some NetCDF interal reasons, characters end with a NULL, i.e. also empty
-!--    characters contain a NULL. Therefore, check the strings for a NULL to get the correct
-!--    character length in order to compare them with the list of allowed variables.
-       vmea(l)%nmeas  = 1
-       DO  ll = 1, SIZE( measured_variables_file )
-          IF ( measured_variables_file(ll)(1:1) /= CHAR(0)  .AND.                                  &
-               measured_variables_file(ll)(1:1) /= ' ')  THEN
-!
-!--          Obtain character length of the character
-             len_char = 1
-             DO  WHILE ( measured_variables_file(ll)(len_char:len_char) /= CHAR(0)  .AND.          &
-                 measured_variables_file(ll)(len_char:len_char) /= ' ' )
-                len_char = len_char + 1
-             ENDDO
-             len_char = len_char - 1
-
-             measured_variables(vmea(l)%nmeas) = measured_variables_file(ll)(1:len_char)
-             vmea(l)%nmeas = vmea(l)%nmeas + 1
-
-          ENDIF
-       ENDDO
-       vmea(l)%nmeas = vmea(l)%nmeas - 1
-!
-!--    Allocate data-type array for the measured variables names and attributes at the respective
-!--    site.
-       ALLOCATE( vmea(l)%var_atts(1:vmea(l)%nmeas) )
-!
-!--    Store the variable names in a data structure, which assigns further attributes to this name.
-!--    Further, for data output reasons, create a string of output variables, which will be written
-!--    into the attribute data_content.
-       DO  ll = 1, vmea(l)%nmeas
-          vmea(l)%var_atts(ll)%name = TRIM( measured_variables(ll) )
-
-!           vmea(l)%data_content = TRIM( vmea(l)%data_content ) // " " //                            &
-!                                  TRIM( vmea(l)%var_atts(ll)%name )
-       ENDDO
-!
-!--    Read all the UTM coordinates for the site. Based on the coordinates, define the grid-index
-!--    space on each subdomain where virtual measurements should be taken. Note, the entire
-!--    coordinate array (on the entire model domain) won't be stored as this would exceed memory
-!--    requirements, particularly for trajectories.
-       IF ( vmea(l)%nmeas > 0 )  THEN
-!
-!--       For stationary and mobile measurements UTM coordinates are just one value and its dimension
-!--       is "station".
-          CALL get_dimension_length( pids_id, vmea(l)%nst, "station" // TRIM( dum ) )
-!
-!--       Allocate temporary arrays for UTM and height coordinates. Note, on file UTM coordinates
-!--       might be 1D or 2D variables
-          ALLOCATE( e_utm(1:vmea(l)%nst)       )
-          ALLOCATE( n_utm(1:vmea(l)%nst)       )
-          ALLOCATE( station_h(1:vmea(l)%nst)   )
-          ALLOCATE( zar(1:vmea(l)%nst)         )
-          IF ( vmea(l)%trajectory )  ALLOCATE( height(1:vmea(l)%nst) )
-          e_utm     = 0.0_wp
-          n_utm     = 0.0_wp
-          station_h = 0.0_wp
-          zar       = 0.0_wp
-          IF ( vmea(l)%trajectory )  height = 0.0_wp
-
-          ALLOCATE( e_utm_tmp(1:vmea(l)%nst) )
-          ALLOCATE( n_utm_tmp(1:vmea(l)%nst) )
-!
-!--       Read UTM and height coordinates for all trajectories and times. Note, in case
-!--       these obtain any missing values, replace them with default _FillValues.
-          CALL inquire_fill_value( pids_id, char_eutm   // TRIM( dum ), nofill, fill_eutm    )
-          CALL inquire_fill_value( pids_id, char_nutm   // TRIM( dum ), nofill, fill_nutm    )
-          CALL inquire_fill_value( pids_id, char_zar    // TRIM( dum ), nofill, fill_zar     )
-          IF ( vmea(l)%trajectory )                                                                &
-             CALL inquire_fill_value( pids_id, char_height // TRIM( dum ), nofill, fill_height  )
-!
-!--       Further line is just to avoid compiler warnings. nofill might be used in future.
-          IF ( nofill == 0  .OR.  nofill /= 0 )  CONTINUE
-!
-!--       Read observation coordinates. Please note, for trajectories the observation height is
-!--       stored directly in z, while for timeSeries it is stored in z - station_h, according to
-!--       UC2-standard.
-          IF ( vmea(l)%trajectory )  THEN
-             CALL get_variable( pids_id, char_eutm      // TRIM( dum ), e_utm(:)     )
-             CALL get_variable( pids_id, char_nutm      // TRIM( dum ), n_utm(:)     )
-             CALL get_variable( pids_id, char_height    // TRIM( dum ), height(:)    )
-          ELSE
-             CALL get_variable( pids_id, char_eutm      // TRIM( dum ), e_utm(:)     )
-             CALL get_variable( pids_id, char_nutm      // TRIM( dum ), n_utm(:)     )
-             CALL get_variable( pids_id, char_station_h // TRIM( dum ), station_h(:) )
-             CALL get_variable( pids_id, char_zar       // TRIM( dum ), zar(:)       )
-          ENDIF
-
-          e_utm = MERGE( e_utm, vmea(l)%fillout, e_utm /= fill_eutm )
-          n_utm = MERGE( n_utm, vmea(l)%fillout, n_utm /= fill_nutm )
-          zar   = MERGE( zar,   vmea(l)%fillout, zar   /= fill_zar  )
-          IF ( vmea(l)%trajectory )                                                                &
-             height = MERGE( height, vmea(l)%fillout, height /= fill_height )
-!
-!--       Compute observation height above ground. Note, for trajectory measurements the height
-!--       above the surface is actually stored in 'height'.
-          IF ( vmea(l)%trajectory )  THEN
-             zar      = height
-             fill_zar = fill_height
-          ELSE
-             zar = zar - station_h
-          ENDIF
-!
-!--       Based on UTM coordinates, check if the measurement station or parts of the trajectory are
-!--       on subdomain. This case, setup grid index space sample these quantities.
-          meas_flag = 0
-          DO  t = 1, vmea(l)%nst
-!
-!--          First, compute relative x- and y-coordinates with respect to the lower-left origin of
-!--          the model domain, which is the difference between UTM coordinates. Note, if the origin
-!--          is not correct, the virtual sites will be misplaced. Further, in case of an rotated
-!--          model domain, the UTM coordinates must also be rotated.
-             e_utm_tmp(t) = e_utm(t) - init_model%origin_x
-             n_utm_tmp(t) = n_utm(t) - init_model%origin_y
-             e_utm(t) = COS( init_model%rotation_angle * pi / 180.0_wp )                           &
-                                    * e_utm_tmp(t)                                                 &
-                                  - SIN( init_model%rotation_angle * pi / 180.0_wp )               &
-                                    * n_utm_tmp(t)
-             n_utm(t) = SIN( init_model%rotation_angle * pi / 180.0_wp )                           &
-                                    * e_utm_tmp(t)                                                 &
-                                  + COS( init_model%rotation_angle * pi / 180.0_wp )               &
-                                    * n_utm_tmp(t)
-!
-!--          Compute grid indices relative to origin and check if these are on the subdomain. Note,
-!--          virtual measurements will be taken also at grid points surrounding the station, hence,
-!--          check also for these grid points. The number of surrounding grid points is set
-!--          according to the featureType.
-             IF ( vmea(l)%timseries_profile )  THEN
-                off   = off_pr
-                off_z = off_pr_z
-             ELSEIF ( vmea(l)%timseries     )  THEN
-                off   = off_ts
-                off_z = off_ts_z
-             ELSEIF ( vmea(l)%trajectory    )  THEN
-                off   = off_tr
-                off_z = off_tr_z
-             ENDIF
-
-             is = INT( ( e_utm(t) + 0.5_wp * dx ) * ddx, KIND = iwp )
-             js = INT( ( n_utm(t) + 0.5_wp * dy ) * ddy, KIND = iwp )
-!
-!--          Is the observation point on subdomain?
-             on_pe = ( is >= nxl  .AND.  is <= nxr  .AND.  js >= nys  .AND.  js <= nyn )
-!
-!--          Check if observation coordinate is on subdomain.
-             IF ( on_pe )  THEN
-!
-!--             Determine vertical index which corresponds to the observation height.
-                ksurf = topo_top_ind(js,is,0)
-                ks = MINLOC( ABS( zu - zw(ksurf) - zar(t) ), DIM = 1 ) - 1
-!
-!--             Set mask array at the observation coordinates. Also, flag the surrounding
-!--             coordinate points, but first check whether the surrounding coordinate points are
-!--             on the subdomain.
-                kl = MERGE( ks-off_z, ksurf, ks-off_z >= nzb  .AND. ks-off_z >= ksurf )
-                ku = MERGE( ks+off_z, nzt,   ks+off_z < nzt+1 )
-
-                DO  i = is-off, is+off
-                   DO  j = js-off, js+off
-                      DO  k = kl, ku
-                         meas_flag(k,j,i) = MERGE( IBSET( meas_flag(k,j,i), 0 ), 0,                &
-                                                          BTEST( wall_flags_total_0(k,j,i), 0 ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDDO
-!
-!--       Based on the flag array, count the number of sampling coordinates. Please note, sampling
-!--       coordinates in atmosphere and soil may be different, as within the soil all levels will be
-!--       measured. Hence, count individually. Start with atmoshere.
-          ns = 0
-          DO  i = nxl-off, nxr+off
-             DO  j = nys-off, nyn+off
-                DO  k = nzb, nzt+1
-                   ns = ns + MERGE( 1, 0, BTEST( meas_flag(k,j,i), 0 ) )
-                ENDDO
-             ENDDO
-          ENDDO
-
-!
-!--       Store number of observation points on subdomain and allocate index arrays as well as array
-!--       containing height information.
-          vmea(l)%ns = ns
-
-          ALLOCATE( vmea(l)%i(1:vmea(l)%ns) )
-          ALLOCATE( vmea(l)%j(1:vmea(l)%ns) )
-          ALLOCATE( vmea(l)%k(1:vmea(l)%ns) )
-          ALLOCATE( vmea(l)%zar(1:vmea(l)%ns) )
-!
-!--       Based on the flag array store the grid indices which correspond to the observation
-!--       coordinates.
-          ns = 0
-          DO  i = nxl-off, nxr+off
-             DO  j = nys-off, nyn+off
-                DO  k = nzb, nzt+1
-                   IF ( BTEST( meas_flag(k,j,i), 0 ) )  THEN
-                      ns = ns + 1
-                      vmea(l)%i(ns) = i
-                      vmea(l)%j(ns) = j
-                      vmea(l)%k(ns) = k
-                      vmea(l)%zar(ns)  = zu(k) - zw(topo_top_ind(j,i,0))
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-!
-!--       Same for the soil. Based on the flag array, count the number of sampling coordinates in
-!--       soil. Sample at all soil levels in this case. Please note, soil variables can only be
-!--       sampled on subdomains, not on ghost layers.
-          IF ( vmea(l)%soil_sampling )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   IF ( ANY( BTEST( meas_flag(:,j,i), 0 ) ) )  THEN
-                      IF ( surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i) )  THEN
-                         vmea(l)%ns_soil = vmea(l)%ns_soil + nzt_soil - nzb_soil + 1
-                      ENDIF
-                      IF ( surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i) )  THEN
-                         vmea(l)%ns_soil = vmea(l)%ns_soil + nzt_wall - nzb_wall + 1
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDIF
-!
-!--       Allocate index arrays as well as array containing height information for soil.
-          IF ( vmea(l)%soil_sampling )  THEN
-             ALLOCATE( vmea(l)%i_soil(1:vmea(l)%ns_soil) )
-             ALLOCATE( vmea(l)%j_soil(1:vmea(l)%ns_soil) )
-             ALLOCATE( vmea(l)%k_soil(1:vmea(l)%ns_soil) )
-             ALLOCATE( vmea(l)%depth(1:vmea(l)%ns_soil)  )
-          ENDIF
-!
-!--       For soil, store the grid indices.
-          ns = 0
-          IF ( vmea(l)%soil_sampling )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   IF ( ANY( BTEST( meas_flag(:,j,i), 0 ) ) )  THEN
-                      IF ( surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i) )  THEN
-                         m = surf_lsm_h(0)%start_index(j,i)
-                         DO  k = nzb_soil, nzt_soil
-                            ns = ns + 1
-                            vmea(l)%i_soil(ns) = i
-                            vmea(l)%j_soil(ns) = j
-                            vmea(l)%k_soil(ns) = k
-                            vmea(l)%depth(ns)  = - zs(k)
-                         ENDDO
-                      ENDIF
-
-                      IF ( surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i) )  THEN
-                         m = surf_usm_h(0)%start_index(j,i)
-                         DO  k = nzb_wall, nzt_wall
-                            ns = ns + 1
-                            vmea(l)%i_soil(ns) = i
-                            vmea(l)%j_soil(ns) = j
-                            vmea(l)%k_soil(ns) = k
-                            vmea(l)%depth(ns)  = - surf_usm_h(0)%zw(k,m)
-                         ENDDO
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDIF
-!
-!--       Allocate array to save the sampled values.
-          ALLOCATE( vmea(l)%measured_vars(1:vmea(l)%ns,1:vmea(l)%nmeas) )
-
-          IF ( vmea(l)%soil_sampling )                                                             &
-             ALLOCATE( vmea(l)%measured_vars_soil(1:vmea(l)%ns_soil, 1:vmea(l)%nmeas) )
-!
-!--       Initialize with _FillValues
-          vmea(l)%measured_vars(1:vmea(l)%ns,1:vmea(l)%nmeas) = vmea(l)%fillout
-          IF ( vmea(l)%soil_sampling )                                                             &
-             vmea(l)%measured_vars_soil(1:vmea(l)%ns_soil,1:vmea(l)%nmeas) = vmea(l)%fillout
-!
-!--       Deallocate temporary coordinate arrays
-          IF ( ALLOCATED( e_utm )     )  DEALLOCATE( e_utm )
-          IF ( ALLOCATED( n_utm )     )  DEALLOCATE( n_utm )
-          IF ( ALLOCATED( e_utm_tmp ) )  DEALLOCATE( e_utm_tmp )
-          IF ( ALLOCATED( n_utm_tmp ) )  DEALLOCATE( n_utm_tmp )
-          IF ( ALLOCATED( n_utm )     )  DEALLOCATE( n_utm )
-          IF ( ALLOCATED( zar  )      )  DEALLOCATE( zar  )
-          IF ( ALLOCATED( height )    )  DEALLOCATE( height )
-          IF ( ALLOCATED( station_h ) )  DEALLOCATE( station_h )
-
-       ENDIF
-    ENDDO
-!
-!-- Dellocate flag array
-    DEALLOCATE( meas_flag )
-!
-!-- Close input file for virtual measurements.
-    CALL close_input_file( pids_id )
-!
-!-- Sum-up the number of observation coordiates, for atmosphere first.
-!-- This is actually only required for data output.
-    ALLOCATE( ns_all(1:vmea_general%nvm) )
-    ns_all = 0
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( vmea(:)%ns, ns_all(:), vmea_general%nvm, MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-    ns_all(:) = vmea(:)%ns
-#endif
-    vmea(:)%ns_tot = ns_all(:)
-!
-!-- Now for soil
-    ns_all = 0
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( vmea(:)%ns_soil, ns_all(:), vmea_general%nvm, MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-    ns_all(:) = vmea(:)%ns_soil
-#endif
-    vmea(:)%ns_soil_tot = ns_all(:)
-
-    DEALLOCATE( ns_all )
-!
-!-- In case of parallel NetCDF the start coordinate for each mpi rank needs to be defined, so that
-!-- each processor knows where to write the data.
-#if defined( __netcdf4_parallel )
-    ALLOCATE( ns_atmos(0:numprocs-1,1:vmea_general%nvm) )
-    ALLOCATE( ns_soil(0:numprocs-1,1:vmea_general%nvm)  )
-    ns_atmos = 0
-    ns_soil  = 0
-
-    DO  l = 1, vmea_general%nvm
-       ns_atmos(myid,l) = vmea(l)%ns
-       ns_soil(myid,l)  = vmea(l)%ns_soil
-    ENDDO
-
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, ns_atmos, numprocs * vmea_general%nvm,                       &
-                        MPI_INTEGER, MPI_SUM, comm2d, ierr )
-    CALL MPI_ALLREDUCE( MPI_IN_PLACE, ns_soil, numprocs * vmea_general%nvm,                        &
-                        MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-    ns_atmos(0,:) = vmea(:)%ns
-    ns_soil(0,:)  = vmea(:)%ns_soil
-#endif
-
-!
-!-- Determine the start coordinate in NetCDF file for the local arrays. Note, start coordinates are
-!-- initialized with zero for sake of simplicity in summation. However, in NetCDF the start
-!-- coordinates must be >= 1, so that a one needs to be added at the end.
-    DO  l = 1, vmea_general%nvm
-       DO  n  = 0, myid - 1
-          vmea(l)%start_coord_a = vmea(l)%start_coord_a + ns_atmos(n,l)
-          vmea(l)%start_coord_s = vmea(l)%start_coord_s + ns_soil(n,l)
-       ENDDO
-!
-!--    Start coordinate in NetCDF starts always at one not at 0.
-       vmea(l)%start_coord_a = vmea(l)%start_coord_a + 1
-       vmea(l)%start_coord_s = vmea(l)%start_coord_s + 1
-!
-!--    Determine the local end coordinate
-       vmea(l)%end_coord_a = vmea(l)%start_coord_a + vmea(l)%ns - 1
-       vmea(l)%end_coord_s = vmea(l)%start_coord_s + vmea(l)%ns_soil - 1
-    ENDDO
-
-    DEALLOCATE( ns_atmos )
-    DEALLOCATE( ns_soil  )
-
-#endif
-
-#endif
-    IF ( debug_output )  CALL debug_message( 'vm_init', 'end' )
- END SUBROUTINE vm_init
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize output using data-output module
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vm_init_output
-
-    CHARACTER(LEN=100) ::  variable_name  !< name of output variable
-
-    INTEGER(iwp) ::  l             !< loop index
-    INTEGER(iwp) ::  n             !< loop index
-    INTEGER      ::  return_value  !< returned status value of called function
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ndim !< dummy to write dimension
-
-    REAL(wp) ::  dum_lat  !< transformed geographical coordinate (latitude)
-    REAL(wp) ::  dum_lon  !< transformed geographical coordinate (longitude)
-
-!
-!-- Determine the number of output timesteps.
-    ntimesteps = CEILING( ( end_time - MAX( vm_time_start, time_since_reference_point )            &
-                          ) / dt_virtual_measurement )
-!
-!-- Create directory where output files will be stored.
-    CALL local_system( 'mkdir -p VM_OUTPUT' // TRIM( coupling_char ) )
-!
-!-- Loop over all sites.
-    DO  l = 1, vmea_general%nvm
-!
-!--    Skip if no observations will be taken for this site.
-       IF ( vmea(l)%ns_tot == 0  .AND.  vmea(l)%ns_soil_tot == 0 )  CYCLE
-!
-!--    Define output file.
-       WRITE( vmea(l)%nc_filename, '(A,I4.4)' ) 'VM_OUTPUT' // TRIM( coupling_char ) // '/' //     &
-              'site', l
-
-       return_value = dom_def_file( vmea(l)%nc_filename, 'netcdf4-parallel' )
-!
-!--    Define global attributes.
-!--    Before, transform UTM into geographical coordinates.
-       CALL convert_utm_to_geographic( crs_list, vmea(l)%origin_x_obs, vmea(l)%origin_y_obs,       &
-                                       dum_lon, dum_lat )
-
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'site',                   &
-                                   value = TRIM( vmea(l)%site ) )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'title',                  &
-                                   value = 'Virtual measurement output')
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'source',                 &
-                                   value = 'PALM-4U')
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'institution',            &
-                                   value = input_file_atts%institution )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'acronym',                &
-                                   value = input_file_atts%acronym )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'author',                 &
-                                   value = input_file_atts%author )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'contact_person',         &
-                                   value = input_file_atts%author )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'iop',                    &
-                                   value = input_file_atts%campaign )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'campaign',               &
-                                   value = 'PALM-4U' )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'origin_time ',           &
-                                   value = origin_date_time)
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'location',               &
-                                   value = input_file_atts%location )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'origin_x',               &
-                                   value = vmea(l)%origin_x_obs )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'origin_y',               &
-                                   value = vmea(l)%origin_y_obs )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'origin_lon',             &
-                                   value = dum_lon )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'origin_lat',             &
-                                   value = dum_lat )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'origin_z', value = 0.0 )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'rotation_angle',         &
-                                   value = input_file_atts%rotation_angle )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'featureType',            &
-                                   value = TRIM( vmea(l)%feature_type_out ) )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'data_content',           &
-                                   value = TRIM( vmea(l)%data_content ) )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'creation_time',          &
-                                   value = input_file_atts%creation_time )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'version', value = 1 ) !input_file_atts%version
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'Conventions',            &
-                                   value = input_file_atts%conventions )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'dependencies',           &
-                                   value = input_file_atts%dependencies )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'history',                &
-                                   value = input_file_atts%history )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'references',             &
-                                   value = input_file_atts%references )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'comment',                &
-                                   value = input_file_atts%comment )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'keywords',               &
-                                   value = input_file_atts%keywords )
-       return_value = dom_def_att( vmea(l)%nc_filename, attribute_name = 'licence',                &
-                                   value = '[UC]2 Open Licence; see [UC]2 ' //                     &
-                                           'data policy available at ' //                          &
-                                           'www.uc2-program.org/uc2_data_policy.pdf' )
-!
-!--    Define dimensions.
-!--    station
-       ALLOCATE( ndim(1:vmea(l)%ns_tot) )
-       DO  n = 1, vmea(l)%ns_tot
-          ndim(n) = n
-       ENDDO
-       return_value = dom_def_dim( vmea(l)%nc_filename, dimension_name = 'station',                &
-                                   output_type = 'int32', bounds = (/1_iwp, vmea(l)%ns_tot/),      &
-                                   values_int32 = ndim )
-       DEALLOCATE( ndim )
-!
-!--    ntime
-       ALLOCATE( ndim(1:ntimesteps) )
-       DO  n = 1, ntimesteps
-          ndim(n) = n
-       ENDDO
-
-       return_value = dom_def_dim( vmea(l)%nc_filename, dimension_name = 'ntime',                  &
-                                   output_type = 'int32', bounds = (/1_iwp, ntimesteps/),          &
-                                   values_int32 = ndim )
-       DEALLOCATE( ndim )
-!
-!--    nv
-       ALLOCATE( ndim(1:2) )
-       DO  n = 1, 2
-          ndim(n) = n
-       ENDDO
-
-       return_value = dom_def_dim( vmea(l)%nc_filename, dimension_name = 'nv',                     &
-                                   output_type = 'int32', bounds = (/1_iwp, 2_iwp/),               &
-                                   values_int32 = ndim )
-       DEALLOCATE( ndim )
-!
-!--    maximum name length
-       ALLOCATE( ndim(1:maximum_name_length) )
-       DO  n = 1, maximum_name_length
-          ndim(n) = n
-       ENDDO
-
-       return_value = dom_def_dim( vmea(l)%nc_filename, dimension_name = 'max_name_len',           &
-                                   output_type = 'int32',                                          &
-                                   bounds = (/1_iwp, maximum_name_length /), values_int32 = ndim )
-       DEALLOCATE( ndim )
-!
-!--    Define coordinate variables.
-!--    time
-       variable_name = 'time'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/ 'station  ', 'ntime    '/),                &
-                                   output_type = 'real32' )
-!
-!--    station_name
-       variable_name = 'station_name'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/ 'max_name_len', 'station     ' /),         &
-                                   output_type = 'char' )
-!
-!--    vrs (vertical reference system)
-       variable_name = 'vrs'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/ 'station' /), output_type = 'int8' )
-!
-!--    crs (coordinate reference system)
-       variable_name = 'crs'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/ 'station' /), output_type = 'int8' )
-!
-!--    z
-       variable_name = 'z'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/'station'/), output_type = 'real32' )
-!
-!--    station_h
-       variable_name = 'station_h'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/'station'/), output_type = 'real32' )
-!
-!--    x
-       variable_name = 'x'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/'station'/), output_type = 'real32' )
-!
-!--    y
-       variable_name = 'y'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/'station'/), output_type = 'real32' )
-!
-!--    E-UTM
-       variable_name = 'E_UTM'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/'station'/), output_type = 'real32' )
-!
-!--    N-UTM
-       variable_name = 'N_UTM'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/'station'/), output_type = 'real32' )
-!
-!--    latitude
-       variable_name = 'lat'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/'station'/), output_type = 'real32' )
-!
-!--    longitude
-       variable_name = 'lon'
-       return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,             &
-                                   dimension_names = (/'station'/), output_type = 'real32' )
-!
-!--    Set attributes for the coordinate variables. Note, not all coordinates have the same number
-!--    of attributes.
-!--    Units
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time',                    &
-                                   attribute_name = char_unit, value = 'seconds since ' //         &
-                                   origin_date_time )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'z',                       &
-                                   attribute_name = char_unit, value = 'm' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_h',               &
-                                   attribute_name = char_unit, value = 'm' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'x',                       &
-                                   attribute_name = char_unit, value = 'm' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'y',                       &
-                                   attribute_name = char_unit, value = 'm' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'E_UTM',                   &
-                                   attribute_name = char_unit, value = 'm' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'N_UTM',                   &
-                                   attribute_name = char_unit, value = 'm' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lat',                     &
-                                   attribute_name = char_unit, value = 'degrees_north' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lon',                     &
-                                   attribute_name = char_unit, value = 'degrees_east' )
-!
-!--    Long name
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_name',            &
-                                   attribute_name = char_long, value = 'station name')
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time',                    &
-                                   attribute_name = char_long, value = 'time')
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'z',                       &
-                                   attribute_name = char_long, value = 'height above origin' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_h',               &
-                                   attribute_name = char_long, value = 'surface altitude' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'x',                       &
-                                   attribute_name = char_long,                                     &
-                                   value = 'distance to origin in x-direction')
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'y',                       &
-                                   attribute_name = char_long,                                     &
-                                   value = 'distance to origin in y-direction')
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'E_UTM',                   &
-                                   attribute_name = char_long, value = 'easting' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'N_UTM',                   &
-                                   attribute_name = char_long, value = 'northing' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lat',                     &
-                                   attribute_name = char_long, value = 'latitude' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lon',                     &
-                                   attribute_name = char_long, value = 'longitude' )
-!
-!--    Standard name
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_name',            &
-                                   attribute_name = char_standard, value = 'platform_name')
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time',                    &
-                                   attribute_name = char_standard, value = 'time')
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'z',                       &
-                                   attribute_name = char_standard,                                 &
-                                   value = 'height_above_mean_sea_level' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_h',               &
-                                   attribute_name = char_standard, value = 'surface_altitude' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'E_UTM',                   &
-                                   attribute_name = char_standard,                                 &
-                                   value = 'projection_x_coordinate' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'N_UTM',                   &
-                                   attribute_name = char_standard,                                 &
-                                   value = 'projection_y_coordinate' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lat',                     &
-                                   attribute_name = char_standard, value = 'latitude' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lon',                     &
-                                   attribute_name = char_standard, value = 'longitude' )
-!
-!--    Axis
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time',                    &
-                                   attribute_name = 'axis', value = 'T')
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'z',                       &
-                                   attribute_name = 'axis', value = 'Z' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'x',                       &
-                                   attribute_name = 'axis', value = 'X' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'y',                       &
-                                   attribute_name = 'axis', value = 'Y' )
-!
-!--    Set further individual attributes for the coordinate variables.
-!--    For station name
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_name',            &
-                                   attribute_name = 'cf_role', value = 'timeseries_id' )
-!
-!--    For time
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time',                    &
-                                   attribute_name = 'calendar', value = 'proleptic_gregorian' )
-!        return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time',                    &
-!                                    attribute_name = 'bounds', value = 'time_bounds' )
-!
-!--    For vertical reference system
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'vrs',                     &
-                                   attribute_name = char_long, value = 'vertical reference system' )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'vrs',                     &
-                                   attribute_name = 'system_name', value = 'DHHN2016' )
-!
-!--    For z
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'z',                       &
-                                   attribute_name = 'positive', value = 'up' )
-!
-!--    For coordinate reference system
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = 'epsg_code', value = coord_ref_sys%epsg_code )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = 'false_easting',                               &
-                                   value = coord_ref_sys%false_easting )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = 'false_northing',                              &
-                                   value = coord_ref_sys%false_northing )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = 'grid_mapping_name',                           &
-                                   value = coord_ref_sys%grid_mapping_name )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = 'inverse_flattening',                          &
-                                   value = coord_ref_sys%inverse_flattening )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = 'latitude_of_projection_origin',&
-                                   value = coord_ref_sys%latitude_of_projection_origin )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = char_long, value = coord_ref_sys%long_name )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = 'longitude_of_central_meridian',               &
-                                   value = coord_ref_sys%longitude_of_central_meridian )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = 'longitude_of_prime_meridian',                 &
-                                   value = coord_ref_sys%longitude_of_prime_meridian )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = 'scale_factor_at_central_meridian',            &
-                                   value = coord_ref_sys%scale_factor_at_central_meridian )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = 'semi_major_axis',                             &
-                                   value = coord_ref_sys%semi_major_axis )
-       return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'crs',                     &
-                                   attribute_name = char_unit, value = coord_ref_sys%units )
-!
-!--    In case of sampled soil quantities, define further dimensions and coordinates.
-       IF ( vmea(l)%soil_sampling )  THEN
-!
-!--       station for soil
-          ALLOCATE( ndim(1:vmea(l)%ns_soil_tot) )
-          DO  n = 1, vmea(l)%ns_soil_tot
-             ndim(n) = n
-          ENDDO
-
-          return_value = dom_def_dim( vmea(l)%nc_filename, dimension_name = 'station_soil',        &
-                                      output_type = 'int32',                                       &
-                                      bounds = (/1_iwp,vmea(l)%ns_soil_tot/), values_int32 = ndim )
-          DEALLOCATE( ndim )
-!
-!--       ntime for soil
-          ALLOCATE( ndim(1:ntimesteps) )
-          DO  n = 1, ntimesteps
-             ndim(n) = n
-          ENDDO
-
-          return_value = dom_def_dim( vmea(l)%nc_filename, dimension_name = 'ntime_soil',          &
-                                      output_type = 'int32', bounds = (/1_iwp,ntimesteps/),        &
-                                      values_int32 = ndim )
-          DEALLOCATE( ndim )
-!
-!--       time for soil
-          variable_name = 'time_soil'
-          return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      dimension_names = (/'station_soil', 'ntime_soil  '/),        &
-                                      output_type = 'real32' )
-!
-!--       station_name for soil
-          variable_name = 'station_name_soil'
-          return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      dimension_names = (/ 'max_name_len', 'station_soil' /),      &
-                                      output_type = 'char' )
-!
-!--       z
-          variable_name = 'z_soil'
-          return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      dimension_names = (/'station_soil'/), output_type = 'real32' )
-!
-!--       station_h for soil
-          variable_name = 'station_h_soil'
-          return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      dimension_names = (/'station_soil'/), output_type = 'real32' )
-!
-!--       x soil
-          variable_name = 'x_soil'
-          return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      dimension_names = (/'station_soil'/), output_type = 'real32' )
-!
-!-        y soil
-          variable_name = 'y_soil'
-          return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      dimension_names = (/'station_soil'/), output_type = 'real32' )
-!
-!--       E-UTM soil
-          variable_name = 'E_UTM_soil'
-          return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      dimension_names = (/'station_soil'/), output_type = 'real32' )
-!
-!--       N-UTM soil
-          variable_name = 'N_UTM_soil'
-          return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      dimension_names = (/'station_soil'/), output_type = 'real32' )
-!
-!--       latitude soil
-          variable_name = 'lat_soil'
-          return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      dimension_names = (/'station_soil'/), output_type = 'real32' )
-!
-!--       longitude soil
-          variable_name = 'lon_soil'
-          return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      dimension_names = (/'station_soil'/), output_type = 'real32' )
-!
-!--       Set attributes for the coordinate variables. Note, not all coordinates have the same
-!--       number of attributes.
-!--       Units
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time_soil',            &
-                                      attribute_name = char_unit, value = 'seconds since ' //      &
-                                      origin_date_time )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'z_soil',               &
-                                      attribute_name = char_unit, value = 'm' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_h_soil',       &
-                                      attribute_name = char_unit, value = 'm' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'x_soil',               &
-                                      attribute_name = char_unit, value = 'm' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'y_soil',               &
-                                      attribute_name = char_unit, value = 'm' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'E_UTM_soil',           &
-                                      attribute_name = char_unit, value = 'm' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'N_UTM_soil',           &
-                                      attribute_name = char_unit, value = 'm' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lat_soil',             &
-                                      attribute_name = char_unit, value = 'degrees_north' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lon_soil',             &
-                                      attribute_name = char_unit, value = 'degrees_east' )
-!
-!--       Long name
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_name_soil',    &
-                                      attribute_name = char_long, value = 'station name')
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time_soil',            &
-                                      attribute_name = char_long, value = 'time')
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'z_soil',               &
-                                      attribute_name = char_long, value = 'height above origin' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_h_soil',       &
-                                      attribute_name = char_long, value = 'surface altitude' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'x_soil',               &
-                                      attribute_name = char_long,                                  &
-                                      value = 'distance to origin in x-direction' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'y_soil',               &
-                                      attribute_name = char_long,                                  &
-                                      value = 'distance to origin in y-direction' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'E_UTM_soil',           &
-                                      attribute_name = char_long, value = 'easting' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'N_UTM_soil',           &
-                                      attribute_name = char_long, value = 'northing' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lat_soil',             &
-                                      attribute_name = char_long, value = 'latitude' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lon_soil',             &
-                                      attribute_name = char_long, value = 'longitude' )
-!
-!--       Standard name
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_name_soil',    &
-                                      attribute_name = char_standard, value = 'platform_name')
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time_soil',            &
-                                      attribute_name = char_standard, value = 'time')
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'z_soil',               &
-                                      attribute_name = char_standard,                              &
-                                      value = 'height_above_mean_sea_level' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_h_soil',       &
-                                      attribute_name = char_standard, value = 'surface_altitude' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'E_UTM_soil',           &
-                                      attribute_name = char_standard,                              &
-                                      value = 'projection_x_coordinate' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'N_UTM_soil',           &
-                                      attribute_name = char_standard,                              &
-                                      value = 'projection_y_coordinate' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lat_soil',             &
-                                      attribute_name = char_standard, value = 'latitude' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'lon_soil',             &
-                                      attribute_name = char_standard, value = 'longitude' )
-!
-!--       Axis
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time_soil',            &
-                                      attribute_name = 'axis', value = 'T')
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'z_soil',               &
-                                      attribute_name = 'axis', value = 'Z' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'x_soil',               &
-                                      attribute_name = 'axis', value = 'X' )
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'y_soil',               &
-                                      attribute_name = 'axis', value = 'Y' )
-!
-!--       Set further individual attributes for the coordinate variables.
-!--       For station name soil
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'station_name_soil',    &
-                                      attribute_name = 'cf_role', value = 'timeseries_id' )
-!
-!--       For time soil
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time_soil',            &
-                                      attribute_name = 'calendar', value = 'proleptic_gregorian' )
-!           return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'time_soil',            &
-!                                       attribute_name = 'bounds', value = 'time_bounds' )
-!
-!--       For z soil
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = 'z_soil',               &
-                                      attribute_name = 'positive', value = 'up' )
-       ENDIF
-!
-!--    Define variables that shall be sampled.
-       DO  n = 1, vmea(l)%nmeas
-          variable_name = TRIM( vmea(l)%var_atts(n)%name )
-!
-!--       In order to link the correct dimension names, atmosphere and soil variables need to be
-!--       distinguished.
-          IF ( vmea(l)%soil_sampling  .AND.                                                        &
-               ANY( TRIM( vmea(l)%var_atts(n)%name) == soil_vars ) )  THEN
-
-             return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,       &
-                                         dimension_names = (/'station_soil', 'ntime_soil  '/),     &
-                                         output_type = 'real32' )
-          ELSE
-
-             return_value = dom_def_var( vmea(l)%nc_filename, variable_name = variable_name,       &
-                                         dimension_names = (/'station', 'ntime  '/),               &
-                                         output_type = 'real32' )
-          ENDIF
-!
-!--       Set variable attributes. Please note, for some variables not all attributes are defined,
-!--       e.g. standard_name for the horizontal wind components.
-          CALL vm_set_attributes( vmea(l)%var_atts(n) )
-
-          IF ( vmea(l)%var_atts(n)%long_name /= 'none' )  THEN
-             return_value = dom_def_att( vmea(l)%nc_filename,  variable_name = variable_name,      &
-                                         attribute_name = char_long,                               &
-                                         value = TRIM( vmea(l)%var_atts(n)%long_name ) )
-          ENDIF
-          IF ( vmea(l)%var_atts(n)%standard_name /= 'none' )  THEN
-             return_value = dom_def_att( vmea(l)%nc_filename, variable_name = variable_name,       &
-                                         attribute_name = char_standard,                           &
-                                         value = TRIM( vmea(l)%var_atts(n)%standard_name ) )
-          ENDIF
-          IF ( vmea(l)%var_atts(n)%units /= 'none' )  THEN
-             return_value = dom_def_att( vmea(l)%nc_filename, variable_name = variable_name,       &
-                                         attribute_name = char_unit,                               &
-                                         value = TRIM( vmea(l)%var_atts(n)%units ) )
-          ENDIF
-
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      attribute_name = 'grid_mapping',                             &
-                                      value = TRIM( vmea(l)%var_atts(n)%grid_mapping ) )
-
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      attribute_name = 'coordinates',                              &
-                                      value = TRIM( vmea(l)%var_atts(n)%coordinates ) )
-
-          return_value = dom_def_att( vmea(l)%nc_filename, variable_name = variable_name,          &
-                                      attribute_name = char_fill,                                  &
-                                      value = REAL( vmea(l)%var_atts(n)%fill_value, KIND=4 ) )
-
-       ENDDO  ! loop over variables per site
-
-    ENDDO  ! loop over sites
-
-
- END SUBROUTINE vm_init_output
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parallel NetCDF output via data-output module.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vm_data_output
-
-    CHARACTER(LEN=100) ::  variable_name  !< name of output variable
-    CHARACTER(LEN=maximum_name_length), DIMENSION(:), ALLOCATABLE :: station_name  !< string for station name, consecutively ordered
-
-    CHARACTER(LEN=1), DIMENSION(:,:), ALLOCATABLE, TARGET ::  output_values_2d_char_target  !< target for output name arrays
-    CHARACTER(LEN=1), DIMENSION(:,:), POINTER             ::  output_values_2d_char_pointer !< pointer for output name arrays
-
-    INTEGER(iwp)       ::  l             !< loop index for the number of sites
-    INTEGER(iwp)       ::  n             !< loop index for observation points
-    INTEGER(iwp)       ::  nn            !< loop index for number of characters in a name
-    INTEGER            ::  return_value  !< returned status value of called function
-    INTEGER(iwp)       ::  t_ind         !< time index
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE           ::  dum_lat                   !< transformed geographical coordinate (latitude)
-    REAL(wp), DIMENSION(:), ALLOCATABLE           ::  dum_lon                   !< transformed geographical coordinate (longitude)
-    REAL(wp), DIMENSION(:), ALLOCATABLE           ::  oro_rel                   !< relative altitude of model surface
-    REAL(sp), DIMENSION(:), POINTER               ::  output_values_1d_pointer  !< pointer for 1d output array
-    REAL(sp), DIMENSION(:), ALLOCATABLE, TARGET   ::  output_values_1d_target   !< target for 1d output array
-    REAL(sp), DIMENSION(:,:), POINTER             ::  output_values_2d_pointer  !< pointer for 2d output array
-    REAL(sp), DIMENSION(:,:), ALLOCATABLE, TARGET ::  output_values_2d_target   !< target for 2d output array
-
-    CALL cpu_log( log_point_s(26), 'VM output', 'start' )
-!
-!-- At the first call of this routine write the spatial coordinates.
-    IF ( .NOT. initial_write_coordinates )  THEN
-!
-!--    Write spatial coordinates.
-       DO  l = 1, vmea_general%nvm
-!
-!--       Skip if no observations were taken.
-          IF ( vmea(l)%ns_tot == 0  .AND.  vmea(l)%ns_soil_tot == 0 )  CYCLE
-
-          ALLOCATE( output_values_1d_target(vmea(l)%start_coord_a:vmea(l)%end_coord_a) )
-!
-!--       Output of Easting coordinate. Before output, recalculate EUTM.
-          output_values_1d_target = init_model%origin_x                                            &
-                    + REAL( vmea(l)%i(1:vmea(l)%ns) + 0.5_wp, KIND = wp ) * dx                     &
-                    * COS( init_model%rotation_angle * pi / 180.0_wp )                             &
-                    + REAL( vmea(l)%j(1:vmea(l)%ns) + 0.5_wp, KIND = wp ) * dy                     &
-                    * SIN( init_model%rotation_angle * pi / 180.0_wp )
-
-          output_values_1d_pointer => output_values_1d_target
-
-          return_value = dom_write_var( vmea(l)%nc_filename, 'E_UTM',                              &
-                                        values_real32_1d = output_values_1d_pointer,               &
-                                        bounds_start = (/vmea(l)%start_coord_a/),                  &
-                                        bounds_end   = (/vmea(l)%end_coord_a  /) )
-!
-!--       Output of Northing coordinate. Before output, recalculate NUTM.
-          output_values_1d_target = init_model%origin_y                                            &
-                    - REAL( vmea(l)%i(1:vmea(l)%ns) + 0.5_wp, KIND = wp ) * dx                     &
-                    * SIN( init_model%rotation_angle * pi / 180.0_wp )                             &
-                    + REAL( vmea(l)%j(1:vmea(l)%ns) + 0.5_wp, KIND = wp ) * dy                     &
-                    * COS( init_model%rotation_angle * pi / 180.0_wp )
-
-          output_values_1d_pointer => output_values_1d_target
-          return_value = dom_write_var( vmea(l)%nc_filename, 'N_UTM',                              &
-                                        values_real32_1d = output_values_1d_pointer,               &
-                                        bounds_start = (/vmea(l)%start_coord_a/),                  &
-                                        bounds_end   = (/vmea(l)%end_coord_a  /) )
-!
-!--       Output of longitude and latitude coordinate. Before output, convert it.
-          ALLOCATE( dum_lat(1:vmea(l)%ns) )
-          ALLOCATE( dum_lon(1:vmea(l)%ns) )
-
-          DO  n = 1, vmea(l)%ns
-             CALL convert_utm_to_geographic( crs_list,                                             &
-                                             init_model%origin_x                                   &
-                                           + REAL( vmea(l)%i(n) + 0.5_wp, KIND = wp ) * dx         &
-                                           * COS( init_model%rotation_angle * pi / 180.0_wp )      &
-                                           + REAL( vmea(l)%j(n) + 0.5_wp, KIND = wp ) * dy         &
-                                           * SIN( init_model%rotation_angle * pi / 180.0_wp ),     &
-                                             init_model%origin_y                                   &
-                                           - REAL( vmea(l)%i(n) + 0.5_wp, KIND = wp ) * dx         &
-                                           * SIN( init_model%rotation_angle * pi / 180.0_wp )      &
-                                           + REAL( vmea(l)%j(n) + 0.5_wp, KIND = wp ) * dy         &
-                                           * COS( init_model%rotation_angle * pi / 180.0_wp ),     &
-                                             dum_lon(n), dum_lat(n) )
-          ENDDO
-
-          output_values_1d_target = dum_lat
-          output_values_1d_pointer => output_values_1d_target
-          return_value = dom_write_var( vmea(l)%nc_filename, 'lat',                                &
-                                        values_real32_1d = output_values_1d_pointer,               &
-                                        bounds_start = (/vmea(l)%start_coord_a/),                  &
-                                        bounds_end   = (/vmea(l)%end_coord_a  /) )
-
-          output_values_1d_target = dum_lon
-          output_values_1d_pointer => output_values_1d_target
-          return_value = dom_write_var( vmea(l)%nc_filename, 'lon',                                &
-                                        values_real32_1d = output_values_1d_pointer,               &
-                                        bounds_start = (/vmea(l)%start_coord_a/),                  &
-                                        bounds_end   = (/vmea(l)%end_coord_a  /) )
-          DEALLOCATE( dum_lat )
-          DEALLOCATE( dum_lon )
-!
-!--       Output of relative height coordinate.
-!--       Before this is output, first define the relative orographie height and add this to z.
-          ALLOCATE( oro_rel(1:vmea(l)%ns) )
-          DO  n = 1, vmea(l)%ns
-             oro_rel(n) = zw(topo_top_ind(vmea(l)%j(n),vmea(l)%i(n),3))
-          ENDDO
-
-          output_values_1d_target = vmea(l)%zar(1:vmea(l)%ns) + oro_rel(:)
-          output_values_1d_pointer => output_values_1d_target
-          return_value = dom_write_var( vmea(l)%nc_filename, 'z',                                  &
-                                        values_real32_1d = output_values_1d_pointer,               &
-                                        bounds_start = (/vmea(l)%start_coord_a/),                  &
-                                        bounds_end   = (/vmea(l)%end_coord_a  /) )
-!
-!--       Write surface altitude for the station. Note, since z is already a relative observation
-!--       height, station_h must be zero, in order to obtain the observation level.
-          output_values_1d_target = oro_rel(:)
-          output_values_1d_pointer => output_values_1d_target
-          return_value = dom_write_var( vmea(l)%nc_filename, 'station_h',                          &
-                                        values_real32_1d = output_values_1d_pointer,               &
-                                        bounds_start = (/vmea(l)%start_coord_a/),                  &
-                                        bounds_end   = (/vmea(l)%end_coord_a  /) )
-
-          DEALLOCATE( oro_rel )
-          DEALLOCATE( output_values_1d_target )
-!
-!--       Write station name
-          ALLOCATE ( station_name(vmea(l)%start_coord_a:vmea(l)%end_coord_a) )
-          ALLOCATE ( output_values_2d_char_target(vmea(l)%start_coord_a:vmea(l)%end_coord_a, &
-                                                  1:maximum_name_length) )
-
-          DO  n = vmea(l)%start_coord_a, vmea(l)%end_coord_a
-             station_name(n) = REPEAT( ' ', maximum_name_length )
-             WRITE( station_name(n), '(A,I10.10)') "station", n
-             DO  nn = 1, maximum_name_length
-                output_values_2d_char_target(n,nn) = station_name(n)(nn:nn)
-             ENDDO
-          ENDDO
-
-          output_values_2d_char_pointer => output_values_2d_char_target
-
-          return_value = dom_write_var( vmea(l)%nc_filename, 'station_name',                       &
-                                        values_char_2d = output_values_2d_char_pointer,            &
-                                        bounds_start = (/ 1, vmea(l)%start_coord_a /),             &
-                                        bounds_end   = (/ maximum_name_length,                     &
-                                        vmea(l)%end_coord_a /) )
-
-          DEALLOCATE( station_name )
-          DEALLOCATE( output_values_2d_char_target )
-!
-!--       In case of sampled soil quantities, output also the respective coordinate arrays.
-          IF ( vmea(l)%soil_sampling )  THEN
-             ALLOCATE( output_values_1d_target(vmea(l)%start_coord_s:vmea(l)%end_coord_s) )
-!
-!--          Output of Easting coordinate. Before output, recalculate EUTM.
-             output_values_1d_target = init_model%origin_x                                         &
-               + REAL( vmea(l)%i_soil(1:vmea(l)%ns_soil) + 0.5_wp, KIND = wp ) * dx                &
-               * COS( init_model%rotation_angle * pi / 180.0_wp )                                  &
-               + REAL( vmea(l)%j_soil(1:vmea(l)%ns_soil) + 0.5_wp, KIND = wp ) * dy                &
-               * SIN( init_model%rotation_angle * pi / 180.0_wp )
-             output_values_1d_pointer => output_values_1d_target
-             return_value = dom_write_var( vmea(l)%nc_filename, 'E_UTM_soil',                      &
-                                           values_real32_1d = output_values_1d_pointer,            &
-                                           bounds_start = (/vmea(l)%start_coord_s/),               &
-                                           bounds_end   = (/vmea(l)%end_coord_s  /) )
-!
-!--          Output of Northing coordinate. Before output, recalculate NUTM.
-             output_values_1d_target = init_model%origin_y                                         &
-               - REAL( vmea(l)%i_soil(1:vmea(l)%ns_soil) + 0.5_wp, KIND = wp ) * dx                &
-               * SIN( init_model%rotation_angle * pi / 180.0_wp )                                  &
-               + REAL( vmea(l)%j_soil(1:vmea(l)%ns_soil) + 0.5_wp, KIND = wp ) * dy                &
-               * COS( init_model%rotation_angle * pi / 180.0_wp )
-
-             output_values_1d_pointer => output_values_1d_target
-             return_value = dom_write_var( vmea(l)%nc_filename, 'N_UTM_soil',                      &
-                                           values_real32_1d = output_values_1d_pointer,            &
-                                           bounds_start = (/vmea(l)%start_coord_s/),               &
-                                           bounds_end   = (/vmea(l)%end_coord_s  /) )
-!
-!--          Output of longitude and latitude coordinate. Before output, convert it.
-             ALLOCATE( dum_lat(1:vmea(l)%ns_soil) )
-             ALLOCATE( dum_lon(1:vmea(l)%ns_soil) )
-
-             DO  n = 1, vmea(l)%ns_soil
-                CALL convert_utm_to_geographic( crs_list,                                          &
-                                                init_model%origin_x                                &
-                                              + REAL( vmea(l)%i_soil(n) + 0.5_wp, KIND = wp ) * dx &
-                                              * COS( init_model%rotation_angle * pi / 180.0_wp )   &
-                                              + REAL( vmea(l)%j_soil(n) + 0.5_wp, KIND = wp ) * dy &
-                                              * SIN( init_model%rotation_angle * pi / 180.0_wp ),  &
-                                                init_model%origin_y                                &
-                                              - REAL( vmea(l)%i_soil(n) + 0.5_wp, KIND = wp ) * dx &
-                                              * SIN( init_model%rotation_angle * pi / 180.0_wp )   &
-                                              + REAL( vmea(l)%j_soil(n) + 0.5_wp, KIND = wp ) * dy &
-                                              * COS( init_model%rotation_angle * pi / 180.0_wp ),  &
-                                                dum_lon(n), dum_lat(n) )
-             ENDDO
-
-             output_values_1d_target = dum_lat
-             output_values_1d_pointer => output_values_1d_target
-             return_value = dom_write_var( vmea(l)%nc_filename, 'lat_soil',                        &
-                                           values_real32_1d = output_values_1d_pointer,            &
-                                           bounds_start = (/vmea(l)%start_coord_s/),               &
-                                           bounds_end   = (/vmea(l)%end_coord_s  /) )
-
-             output_values_1d_target = dum_lon
-             output_values_1d_pointer => output_values_1d_target
-             return_value = dom_write_var( vmea(l)%nc_filename, 'lon_soil',                        &
-                                           values_real32_1d = output_values_1d_pointer,            &
-                                           bounds_start = (/vmea(l)%start_coord_s/),               &
-                                           bounds_end   = (/vmea(l)%end_coord_s  /) )
-             DEALLOCATE( dum_lat )
-             DEALLOCATE( dum_lon )
-!
-!--          Output of relative height coordinate.
-!--          Before this is output, first define the relative orographie height and add this to z.
-             ALLOCATE( oro_rel(1:vmea(l)%ns_soil) )
-             DO  n = 1, vmea(l)%ns_soil
-                oro_rel(n) = zw(topo_top_ind(vmea(l)%j_soil(n),vmea(l)%i_soil(n),3))
-             ENDDO
-
-             output_values_1d_target = vmea(l)%depth(1:vmea(l)%ns_soil) + oro_rel(:)
-             output_values_1d_pointer => output_values_1d_target
-             return_value = dom_write_var( vmea(l)%nc_filename, 'z_soil',                          &
-                                           values_real32_1d = output_values_1d_pointer,            &
-                                           bounds_start = (/vmea(l)%start_coord_s/),               &
-                                           bounds_end   = (/vmea(l)%end_coord_s  /) )
-!
-!--          Write surface altitude for the station. Note, since z is already a relative observation
-!--          height, station_h must be zero, in order to obtain the observation level.
-             output_values_1d_target = oro_rel(:)
-             output_values_1d_pointer => output_values_1d_target
-             return_value = dom_write_var( vmea(l)%nc_filename, 'station_h_soil',                  &
-                                           values_real32_1d = output_values_1d_pointer,            &
-                                           bounds_start = (/vmea(l)%start_coord_s/),               &
-                                           bounds_end   = (/vmea(l)%end_coord_s  /) )
-
-             DEALLOCATE( oro_rel )
-             DEALLOCATE( output_values_1d_target )
-!
-!--          Write station name
-             ALLOCATE ( station_name(vmea(l)%start_coord_s:vmea(l)%end_coord_s) )
-             ALLOCATE ( output_values_2d_char_target(vmea(l)%start_coord_s:vmea(l)%end_coord_s,    &
-                                                     1:maximum_name_length) )
-
-             DO  n = vmea(l)%start_coord_s, vmea(l)%end_coord_s
-                station_name(n) = REPEAT( ' ', maximum_name_length )
-                WRITE( station_name(n), '(A,I10.10)') "station", n
-                DO  nn = 1, maximum_name_length
-                   output_values_2d_char_target(n,nn) = station_name(n)(nn:nn)
-                ENDDO
-             ENDDO
-             output_values_2d_char_pointer => output_values_2d_char_target
-
-             return_value = dom_write_var( vmea(l)%nc_filename, 'station_name_soil',               &
-                                           values_char_2d = output_values_2d_char_pointer,         &
-                                           bounds_start = (/ 1, vmea(l)%start_coord_s /),          &
-                                           bounds_end   = (/ maximum_name_length,                  &
-                                           vmea(l)%end_coord_s   /) )
-
-             DEALLOCATE( station_name )
-             DEALLOCATE( output_values_2d_char_target )
-
-          ENDIF
-
-       ENDDO  ! loop over sites
-
-       initial_write_coordinates = .TRUE.
-    ENDIF
-!
-!-- Loop over all sites.
-    DO  l = 1, vmea_general%nvm
-!
-!--    Skip if no observations were taken.
-       IF ( vmea(l)%ns_tot == 0  .AND.  vmea(l)%ns_soil_tot == 0 )  CYCLE
-!
-!--    Determine time index in file.
-       t_ind = vmea(l)%file_time_index + 1
-!
-!--    Write output variables. Distinguish between atmosphere and soil variables.
-       DO  n = 1, vmea(l)%nmeas
-          IF ( vmea(l)%soil_sampling  .AND.                                                        &
-            ANY( TRIM( vmea(l)%var_atts(n)%name) == soil_vars ) )  THEN
-!
-!--          Write time coordinate to file
-             variable_name = 'time_soil'
-             ALLOCATE( output_values_2d_target(t_ind:t_ind,vmea(l)%start_coord_s:vmea(l)%end_coord_s) )
-             output_values_2d_target(t_ind,:) = time_since_reference_point
-             output_values_2d_pointer => output_values_2d_target
-
-             return_value = dom_write_var( vmea(l)%nc_filename, variable_name,                     &
-                                           values_real32_2d = output_values_2d_pointer,            &
-                                           bounds_start = (/vmea(l)%start_coord_s, t_ind/),        &
-                                           bounds_end   = (/vmea(l)%end_coord_s, t_ind /) )
-
-             variable_name = TRIM( vmea(l)%var_atts(n)%name )
-             output_values_2d_target(t_ind,:) = vmea(l)%measured_vars_soil(:,n)
-             output_values_2d_pointer => output_values_2d_target
-             return_value = dom_write_var( vmea(l)%nc_filename, variable_name,                     &
-                                           values_real32_2d = output_values_2d_pointer,            &
-                                           bounds_start = (/vmea(l)%start_coord_s, t_ind/),        &
-                                           bounds_end   = (/vmea(l)%end_coord_s, t_ind  /) )
-             DEALLOCATE( output_values_2d_target )
-          ELSE
-!
-!--          Write time coordinate to file
-             variable_name = 'time'
-             ALLOCATE( output_values_2d_target(t_ind:t_ind,vmea(l)%start_coord_a:vmea(l)%end_coord_a) )
-             output_values_2d_target(t_ind,:) = time_since_reference_point
-             output_values_2d_pointer => output_values_2d_target
-
-             return_value = dom_write_var( vmea(l)%nc_filename, variable_name,                     &
-                                           values_real32_2d = output_values_2d_pointer,            &
-                                           bounds_start = (/vmea(l)%start_coord_a, t_ind/),        &
-                                           bounds_end   = (/vmea(l)%end_coord_a, t_ind/) )
-
-             variable_name = TRIM( vmea(l)%var_atts(n)%name )
-
-             output_values_2d_target(t_ind,:) = vmea(l)%measured_vars(:,n)
-             output_values_2d_pointer => output_values_2d_target
-             return_value = dom_write_var( vmea(l)%nc_filename, variable_name,                     &
-                                           values_real32_2d = output_values_2d_pointer,            &
-                                           bounds_start = (/ vmea(l)%start_coord_a, t_ind /),      &
-                                           bounds_end   = (/ vmea(l)%end_coord_a, t_ind /) )
-
-             DEALLOCATE( output_values_2d_target )
-          ENDIF
-       ENDDO
-!
-!--    Update number of written time indices
-       vmea(l)%file_time_index = t_ind
-
-    ENDDO  ! loop over sites
-
-    CALL cpu_log( log_point_s(26), 'VM output', 'stop' )
-
-
- END SUBROUTINE vm_data_output
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Sampling of the actual quantities along the observation coordinates
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE vm_sampling
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  radiation
-
-    USE surface_mod,                                                                               &
-        ONLY:  surf_def_h,                                                                         &
-               surf_lsm_h,                                                                         &
-               surf_usm_h
-
-     INTEGER(iwp) ::  i         !< grid index in x-direction
-     INTEGER(iwp) ::  j         !< grid index in y-direction
-     INTEGER(iwp) ::  k         !< grid index in z-direction
-     INTEGER(iwp) ::  ind_chem  !< dummy index to identify chemistry variable and translate it from (UC)2 standard to interal naming
-     INTEGER(iwp) ::  l         !< running index over the number of stations
-     INTEGER(iwp) ::  m         !< running index over all virtual observation coordinates
-     INTEGER(iwp) ::  mm        !< index of surface element which corresponds to the virtual observation coordinate
-     INTEGER(iwp) ::  n         !< running index over all measured variables at a station
-     INTEGER(iwp) ::  nn        !< running index over the number of chemcal species
-
-     LOGICAL ::  match_lsm  !< flag indicating natural-type surface
-     LOGICAL ::  match_usm  !< flag indicating urban-type surface
-
-     REAL(wp) ::  e_s   !< saturation water vapor pressure
-     REAL(wp) ::  q_s   !< saturation mixing ratio
-     REAL(wp) ::  q_wv  !< mixing ratio
-
-     CALL cpu_log( log_point_s(27), 'VM sampling', 'start' )
-!
-!--  Loop over all sites.
-     DO  l = 1, vmea_general%nvm
-!
-!--     At the beginning, set _FillValues
-        IF ( ALLOCATED( vmea(l)%measured_vars ) ) vmea(l)%measured_vars = vmea(l)%fillout
-        IF ( ALLOCATED( vmea(l)%measured_vars_soil ) ) vmea(l)%measured_vars_soil = vmea(l)%fillout
-!
-!--     Loop over all variables measured at this site.
-        DO  n = 1, vmea(l)%nmeas
-
-           SELECT CASE ( TRIM( vmea(l)%var_atts(n)%name ) )
-
-              CASE ( 'theta' ) ! potential temperature
-                 IF ( .NOT. neutral )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = vmea(l)%k(m)
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-                       vmea(l)%measured_vars(m,n) = pt(k,j,i)
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'ta' ) ! absolute temperature
-                 IF ( .NOT. neutral )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = vmea(l)%k(m)
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-                       vmea(l)%measured_vars(m,n) = pt(k,j,i) * exner( k ) - degc_to_k
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'hus' ) ! mixing ratio
-                 IF ( humidity )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = vmea(l)%k(m)
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-                       vmea(l)%measured_vars(m,n) = q(k,j,i)
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'haa' ) ! absolute humidity
-                 IF ( humidity )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = vmea(l)%k(m)
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-                       vmea(l)%measured_vars(m,n) = ( q(k,j,i) / ( 1.0_wp - q(k,j,i) ) ) * rho_air(k)
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'pwv' ) ! water vapor partial pressure
-                 IF ( humidity )  THEN
-!                     DO  m = 1, vmea(l)%ns
-!                        k = vmea(l)%k(m)
-!                        j = vmea(l)%j(m)
-!                        i = vmea(l)%i(m)
-!                        vmea(l)%measured_vars(m,n) = ( q(k,j,i) / ( 1.0_wp - q(k,j,i) ) )          &
-!                                                     * rho_air(k)
-!                     ENDDO
-                 ENDIF
-
-              CASE ( 'hur' ) ! relative humidity
-                 IF ( humidity )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = vmea(l)%k(m)
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-!
-!--                    Calculate actual temperature, water vapor saturation pressure and, based on
-!--                    this, the saturation mixing ratio.
-                       e_s  = magnus( exner(k) * pt(k,j,i) )
-                       q_s  = rd_d_rv * e_s / ( hyp(k) - e_s )
-                       q_wv = ( q(k,j,i) / ( 1.0_wp - q(k,j,i) ) ) * rho_air(k)
-
-                       vmea(l)%measured_vars(m,n) = q_wv / ( q_s + 1E-10_wp )
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'u', 'ua' ) ! u-component
-                 DO  m = 1, vmea(l)%ns
-                    k = vmea(l)%k(m)
-                    j = vmea(l)%j(m)
-                    i = vmea(l)%i(m)
-                    vmea(l)%measured_vars(m,n) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
-                 ENDDO
-
-              CASE ( 'v', 'va' ) ! v-component
-                 DO  m = 1, vmea(l)%ns
-                    k = vmea(l)%k(m)
-                    j = vmea(l)%j(m)
-                    i = vmea(l)%i(m)
-                    vmea(l)%measured_vars(m,n) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
-                 ENDDO
-
-              CASE ( 'w' ) ! w-component
-                 DO  m = 1, vmea(l)%ns
-                    k = MAX ( 1, vmea(l)%k(m) )
-                    j = vmea(l)%j(m)
-                    i = vmea(l)%i(m)
-                    vmea(l)%measured_vars(m,n) = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
-                 ENDDO
-
-              CASE ( 'wspeed' ) ! horizontal wind speed
-                 DO  m = 1, vmea(l)%ns
-                    k = vmea(l)%k(m)
-                    j = vmea(l)%j(m)
-                    i = vmea(l)%i(m)
-                    vmea(l)%measured_vars(m,n) = SQRT(   ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) )**2 &
-                                                       + ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) )**2 &
-                                                     )
-                 ENDDO
-
-              CASE ( 'wdir' ) ! wind direction
-                 DO  m = 1, vmea(l)%ns
-                    k = vmea(l)%k(m)
-                    j = vmea(l)%j(m)
-                    i = vmea(l)%i(m)
-
-                    vmea(l)%measured_vars(m,n) = 180.0_wp + 180.0_wp / pi * ATAN2(                 &
-                                                               0.5_wp * ( v(k,j,i) + v(k,j+1,i) ), &
-                                                               0.5_wp * ( u(k,j,i) + u(k,j,i+1) )  &
-                                                                                 )
-                 ENDDO
-
-              CASE ( 'utheta' )
-                 IF ( .NOT. neutral )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = vmea(l)%k(m)
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-                       vmea(l)%measured_vars(m,n) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) * pt(k,j,i)
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'vtheta' )
-                 IF ( .NOT. neutral )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = vmea(l)%k(m)
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-                       vmea(l)%measured_vars(m,n) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) * pt(k,j,i)
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'wtheta' )
-                 IF ( .NOT. neutral )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = MAX ( 1, vmea(l)%k(m) )
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-                       vmea(l)%measured_vars(m,n) = 0.5_wp * ( w(k-1,j,i) + w(k,j,i) ) * pt(k,j,i)
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'uqv' )
-                 IF ( humidity )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = vmea(l)%k(m)
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-                       vmea(l)%measured_vars(m,n) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) * q(k,j,i)
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'vqv' )
-                 IF ( humidity )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = vmea(l)%k(m)
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-                       vmea(l)%measured_vars(m,n) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) * q(k,j,i)
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'wqv' )
-                 IF ( humidity )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       k = MAX ( 1, vmea(l)%k(m) )
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-                       vmea(l)%measured_vars(m,n) = 0.5_wp * ( w(k-1,j,i) + w(k,j,i) ) * q(k,j,i)
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'uw' )
-                 DO  m = 1, vmea(l)%ns
-                    k = MAX ( 1, vmea(l)%k(m) )
-                    j = vmea(l)%j(m)
-                    i = vmea(l)%i(m)
-                    vmea(l)%measured_vars(m,n) = 0.25_wp * ( w(k-1,j,i) + w(k,j,i) ) *             &
-                                                           ( u(k,j,i)   + u(k,j,i+1) )
-                 ENDDO
-
-              CASE ( 'vw' )
-                 DO  m = 1, vmea(l)%ns
-                    k = MAX ( 1, vmea(l)%k(m) )
-                    j = vmea(l)%j(m)
-                    i = vmea(l)%i(m)
-                    vmea(l)%measured_vars(m,n) = 0.25_wp * ( w(k-1,j,i) + w(k,j,i) ) *             &
-                                                           ( v(k,j,i)   + v(k,j+1,i) )
-                 ENDDO
-
-              CASE ( 'uv' )
-                 DO  m = 1, vmea(l)%ns
-                    k = vmea(l)%k(m)
-                    j = vmea(l)%j(m)
-                    i = vmea(l)%i(m)
-                    vmea(l)%measured_vars(m,n) = 0.25_wp * ( u(k,j,i)   + u(k,j,i+1) ) *           &
-                                                           ( v(k,j,i)   + v(k,j+1,i) )
-                 ENDDO
-!
-!--           Chemistry variables. List of variables that may need extension. Note, gas species in
-!--           PALM are in ppm and no distinction is made between mole-fraction and concentration
-!--           quantities (all are output in ppm so far).
-              CASE ( 'mcpm1', 'mcpm2p5', 'mcpm10', 'mfno', 'mfno2', 'mcno', 'mcno2', 'tro3', 'ncaa' )
-                 IF ( air_chemistry )  THEN
-!
-!--                 First, search for the measured variable in the chem_vars
-!--                 list, in order to get the internal name of the variable.
-                    DO  nn = 1, UBOUND( chem_vars, 2 )
-                       IF ( TRIM( vmea(l)%var_atts(n)%name ) ==                                    &
-                            TRIM( chem_vars(0,nn) ) )  ind_chem = nn
-                    ENDDO
-!
-!--                 Run loop over all chemical species, if the measured variable matches the interal
-!--                 name, sample the variable. Note, nvar as a chemistry-module variable.
-                    DO  nn = 1, nvar
-                       IF ( TRIM( chem_vars(1,ind_chem) ) == TRIM( chem_species(nn)%name ) )  THEN
-                          DO  m = 1, vmea(l)%ns
-                             k = vmea(l)%k(m)
-                             j = vmea(l)%j(m)
-                             i = vmea(l)%i(m)
-                             vmea(l)%measured_vars(m,n) = chem_species(nn)%conc(k,j,i)
-                          ENDDO
-                       ENDIF
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'us' ) ! friction velocity
-                 DO  m = 1, vmea(l)%ns
-!
-!--                 Surface data is only available on inner subdomains, not on ghost points. Hence,
-!--                 limit the indices.
-                    j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                    j = MERGE( j           , nyn, j            < nyn )
-                    i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                    i = MERGE( i           , nxr, i            < nxr )
-
-                    DO  mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i)
-                       vmea(l)%measured_vars(m,n) = surf_def_h(0)%us(mm)
-                    ENDDO
-                    DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                       vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%us(mm)
-                    ENDDO
-                    DO  mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                       vmea(l)%measured_vars(m,n) = surf_usm_h(0)%us(mm)
-                    ENDDO
-                 ENDDO
-
-              CASE ( 'thetas' ) ! scaling parameter temperature
-                 IF ( .NOT. neutral )  THEN
-                    DO  m = 1, vmea(l)%ns
-!
-!--                    Surface data is only available on inner subdomains, not on ghost points. Hence,
-!-                     limit the indices.
-                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                       j = MERGE( j           , nyn, j            < nyn )
-                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                       i = MERGE( i           , nxr, i            < nxr )
-
-                       DO  mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_def_h(0)%ts(mm)
-                       ENDDO
-                       DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%ts(mm)
-                       ENDDO
-                       DO  mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_usm_h(0)%ts(mm)
-                       ENDDO
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'hfls' ) ! surface latent heat flux
-                 IF ( humidity )  THEN
-                    DO  m = 1, vmea(l)%ns
-!
-!--                    Surface data is only available on inner subdomains, not on ghost points. Hence,
-!--                    limit the indices.
-                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                       j = MERGE( j           , nyn, j            < nyn )
-                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                       i = MERGE( i           , nxr, i            < nxr )
-
-                       DO  mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_def_h(0)%qsws(mm)
-                       ENDDO
-                       DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%qsws(mm)
-                       ENDDO
-                       DO  mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_usm_h(0)%qsws(mm)
-                       ENDDO
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'hfss' ) ! surface sensible heat flux
-                 IF ( .NOT. neutral )  THEN
-                    DO  m = 1, vmea(l)%ns
-!
-!--                    Surface data is only available on inner subdomains, not on ghost points. Hence,
-!--                    limit the indices.
-                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                       j = MERGE( j           , nyn, j            < nyn )
-                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                       i = MERGE( i           , nxr, i            < nxr )
-
-                       DO  mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_def_h(0)%shf(mm)
-                       ENDDO
-                       DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%shf(mm)
-                       ENDDO
-                       DO  mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_usm_h(0)%shf(mm)
-                       ENDDO
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'hfdg' ) ! ground heat flux
-                 IF ( land_surface )  THEN
-                    DO  m = 1, vmea(l)%ns
-!
-!--                    Surface data is only available on inner subdomains, not on ghost points. Hence,
-!--                    limit the indices.
-                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                       j = MERGE( j           , nyn, j            < nyn )
-                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                       i = MERGE( i           , nxr, i            < nxr )
-
-                       DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%ghf(mm)
-                       ENDDO
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'rnds' ) ! surface net radiation
-                 IF ( radiation )  THEN
-                    DO  m = 1, vmea(l)%ns
-!
-!--                    Surface data is only available on inner subdomains, not on ghost points.
-!--                    Hence, limit the indices.
-                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                       j = MERGE( j           , nyn, j            < nyn )
-                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                       i = MERGE( i           , nxr, i            < nxr )
-
-                       DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%rad_net(mm)
-                       ENDDO
-                       DO  mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_usm_h(0)%rad_net(mm)
-                       ENDDO
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'rsus' ) ! surface shortwave out
-                 IF ( radiation )  THEN
-                    DO  m = 1, vmea(l)%ns
-!
-!--                    Surface data is only available on inner subdomains, not on ghost points.
-!--                    Hence, limit the indices.
-                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                       j = MERGE( j           , nyn, j            < nyn )
-                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                       i = MERGE( i           , nxr, i            < nxr )
-
-                       DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%rad_sw_out(mm)
-                       ENDDO
-                       DO  mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_usm_h(0)%rad_sw_out(mm)
-                       ENDDO
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'rsds' ) ! surface shortwave in
-                 IF ( radiation )  THEN
-                    DO  m = 1, vmea(l)%ns
-!
-!--                    Surface data is only available on inner subdomains, not on ghost points.
-!--                    Hence, limit the indices.
-                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                       j = MERGE( j           , nyn, j            < nyn )
-                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                       i = MERGE( i           , nxr, i            < nxr )
-
-                       DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%rad_sw_in(mm)
-                       ENDDO
-                       DO  mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_usm_h(0)%rad_sw_in(mm)
-                       ENDDO
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'rlus' ) ! surface longwave out
-                 IF ( radiation )  THEN
-                    DO  m = 1, vmea(l)%ns
-!
-!--                    Surface data is only available on inner subdomains, not on ghost points.
-!--                    Hence, limit the indices.
-                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                       j = MERGE( j           , nyn, j            < nyn )
-                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                       i = MERGE( i           , nxr, i            < nxr )
-
-                       DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%rad_lw_out(mm)
-                       ENDDO
-                       DO  mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_usm_h(0)%rad_lw_out(mm)
-                       ENDDO
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'rlds' ) ! surface longwave in
-                 IF ( radiation )  THEN
-                    DO  m = 1, vmea(l)%ns
-!
-!--                    Surface data is only available on inner subdomains, not on ghost points.
-!--                    Hence, limit the indices.
-                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                       j = MERGE( j           , nyn, j            < nyn )
-                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                       i = MERGE( i           , nxr, i            < nxr )
-
-                       DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%rad_lw_in(mm)
-                       ENDDO
-                       DO  mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                          vmea(l)%measured_vars(m,n) = surf_usm_h(0)%rad_lw_in(mm)
-                       ENDDO
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'rsd' ) ! shortwave in
-                 IF ( radiation )  THEN
-                    IF ( radiation_scheme /= 'rrtmg' )  THEN
-                       DO  m = 1, vmea(l)%ns
-                          k = 0
-                          j = vmea(l)%j(m)
-                          i = vmea(l)%i(m)
-                          vmea(l)%measured_vars(m,n) = rad_sw_in(k,j,i)
-                       ENDDO
-                    ELSE
-                       DO  m = 1, vmea(l)%ns
-                          k = vmea(l)%k(m)
-                          j = vmea(l)%j(m)
-                          i = vmea(l)%i(m)
-                          vmea(l)%measured_vars(m,n) = rad_sw_in(k,j,i)
-                       ENDDO
-                    ENDIF
-                 ENDIF
-
-              CASE ( 'rsu' ) ! shortwave out
-                 IF ( radiation )  THEN
-                    IF ( radiation_scheme /= 'rrtmg' )  THEN
-                       DO  m = 1, vmea(l)%ns
-                          k = 0
-                          j = vmea(l)%j(m)
-                          i = vmea(l)%i(m)
-                          vmea(l)%measured_vars(m,n) = rad_sw_out(k,j,i)
-                       ENDDO
-                    ELSE
-                       DO  m = 1, vmea(l)%ns
-                          k = vmea(l)%k(m)
-                          j = vmea(l)%j(m)
-                          i = vmea(l)%i(m)
-                          vmea(l)%measured_vars(m,n) = rad_sw_out(k,j,i)
-                       ENDDO
-                    ENDIF
-                 ENDIF
-
-              CASE ( 'rlu' ) ! longwave out
-                 IF ( radiation )  THEN
-                    IF ( radiation_scheme /= 'rrtmg' )  THEN
-                       DO  m = 1, vmea(l)%ns
-                          k = 0
-                          j = vmea(l)%j(m)
-                          i = vmea(l)%i(m)
-                          vmea(l)%measured_vars(m,n) = rad_lw_out(k,j,i)
-                       ENDDO
-                    ELSE
-                       DO  m = 1, vmea(l)%ns
-                          k = vmea(l)%k(m)
-                          j = vmea(l)%j(m)
-                          i = vmea(l)%i(m)
-                          vmea(l)%measured_vars(m,n) = rad_lw_out(k,j,i)
-                       ENDDO
-                    ENDIF
-                 ENDIF
-
-              CASE ( 'rld' ) ! longwave in
-                 IF ( radiation )  THEN
-                    IF ( radiation_scheme /= 'rrtmg' )  THEN
-                       DO  m = 1, vmea(l)%ns
-                          k = 0
-!
-!--                       Surface data is only available on inner subdomains, not on ghost points.
-!--                       Hence, limit the indices.
-                          j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                          j = MERGE( j           , nyn, j            < nyn )
-                          i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                          i = MERGE( i           , nxr, i            < nxr )
-
-                          vmea(l)%measured_vars(m,n) = rad_lw_in(k,j,i)
-                       ENDDO
-                    ELSE
-                       DO  m = 1, vmea(l)%ns
-                          k = vmea(l)%k(m)
-                          j = vmea(l)%j(m)
-                          i = vmea(l)%i(m)
-                          vmea(l)%measured_vars(m,n) = rad_lw_in(k,j,i)
-                       ENDDO
-                    ENDIF
-                 ENDIF
-
-              CASE ( 'rsddif' ) ! shortwave in, diffuse part
-                 IF ( radiation )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-
-                       vmea(l)%measured_vars(m,n) = rad_sw_in_diff(j,i)
-                    ENDDO
-                 ENDIF
-
-              CASE ( 't_soil' ) ! soil and wall temperature
-                 DO  m = 1, vmea(l)%ns_soil
-                    j = MERGE( vmea(l)%j_soil(m), nys, vmea(l)%j_soil(m) > nys )
-                    j = MERGE( j                , nyn, j                 < nyn )
-                    i = MERGE( vmea(l)%i_soil(m), nxl, vmea(l)%i_soil(m) > nxl )
-                    i = MERGE( i                , nxr, i                 < nxr )
-                    k = vmea(l)%k_soil(m)
-
-                    match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-                    match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
-
-                    IF ( match_lsm )  THEN
-                       mm = surf_lsm_h(0)%start_index(j,i)
-                       vmea(l)%measured_vars_soil(m,n) = t_soil_h(0)%var_2d(k,mm)
-                    ENDIF
-
-                    IF ( match_usm )  THEN
-                       mm = surf_usm_h(0)%start_index(j,i)
-                       vmea(l)%measured_vars_soil(m,n) = t_wall_h(0)%val(k,mm)
-                    ENDIF
-                 ENDDO
-
-              CASE ( 'm_soil', 'lwcs' ) ! soil moisture
-                 IF ( land_surface )  THEN
-                    DO  m = 1, vmea(l)%ns_soil
-                       j = MERGE( vmea(l)%j_soil(m), nys, vmea(l)%j_soil(m) > nys )
-                       j = MERGE( j                , nyn, j                 < nyn )
-                       i = MERGE( vmea(l)%i_soil(m), nxl, vmea(l)%i_soil(m) > nxl )
-                       i = MERGE( i                , nxr, i                 < nxr )
-                       k = vmea(l)%k_soil(m)
-
-                       match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
-
-                       IF ( match_lsm )  THEN
-                          mm = surf_lsm_h(0)%start_index(j,i)
-                          vmea(l)%measured_vars_soil(m,n) = m_soil_h(0)%var_2d(k,mm)
-                       ENDIF
-
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'ts', 'tb' ) ! surface temperature and brighness temperature
-                 DO  m = 1, vmea(l)%ns
-!
-!--                 Surface data is only available on inner subdomains, not on ghost points. Hence,
-!--                 limit the indices.
-                    j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                    j = MERGE( j           , nyn, j            < nyn )
-                    i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                    i = MERGE( i           , nxr, i            < nxr )
-
-                    DO  mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i)
-                       vmea(l)%measured_vars(m,n) = surf_def_h(0)%pt_surface(mm)
-                    ENDDO
-                    DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                       vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%pt_surface(mm)
-                    ENDDO
-                    DO  mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i)
-                       vmea(l)%measured_vars(m,n) = surf_usm_h(0)%pt_surface(mm)
-                    ENDDO
-                 ENDDO
-
-              CASE ( 'lwp' ) ! liquid water path
-                 IF ( ASSOCIATED( ql ) )  THEN
-                    DO  m = 1, vmea(l)%ns
-                       j = vmea(l)%j(m)
-                       i = vmea(l)%i(m)
-
-                       vmea(l)%measured_vars(m,n) = SUM( ql(nzb:nzt,j,i) * dzw(1:nzt+1) )          &
-                                                    * rho_surface
-                    ENDDO
-                 ENDIF
-
-              CASE ( 'ps' ) ! surface pressure
-                 vmea(l)%measured_vars(:,n) = surface_pressure
-
-              CASE ( 't_lw' ) ! water temperature
-                 IF ( land_surface )  THEN
-                    DO  m = 1, vmea(l)%ns
-!
-!--                    Surface data is only available on inner subdomains, not
-!--                    on ghost points. Hence, limit the indices.
-                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys )
-                       j = MERGE( j           , nyn, j            < nyn )
-                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
-                       i = MERGE( i           , nxr, i            < nxr )
-
-                       DO  mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i)
-                          IF ( surf_lsm_h(0)%water_surface(m) )                                          &
-                               vmea(l)%measured_vars(m,n) = t_soil_h(0)%var_2d(nzt,m)
-                       ENDDO
-
-                    ENDDO
-                 ENDIF
-!
-!--           No match found - just set a fill value
-              CASE DEFAULT
-                 vmea(l)%measured_vars(:,n) = vmea(l)%fillout
-           END SELECT
-
-        ENDDO
-
-     ENDDO
-
-     CALL cpu_log( log_point_s(27), 'VM sampling', 'stop' )
-
- END SUBROUTINE vm_sampling
-
-
- END MODULE virtual_measurement_mod
Index: palm/trunk/SOURCE/wind_turbine_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/wind_turbine_model_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,3289 +1,0 @@
-!> @file wind_turbine_model_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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 2009-2021 Carl von Ossietzky Universitaet Oldenburg
-! Copyright 1997-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! reading of namelist file and actions in case of namelist errors revised so that statement labels
-! and goto statements are not required any more,
-! local namelist parameter added to switch off the module although the respective module namelist
-! appears in the namelist file
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! reset n_turbines_max to 1E4 (10 000), because it was set to 1 000 in r4497 by mistake
-! 
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-! 
-! 4528 2020-05-11 14:14:09Z oliver.maas
-! added namelist parameter smearing_kernel_size
-! 
-! 4497 2020-04-15 10:20:51Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-! 
-! 4481 2020-03-31 18:55:54Z maronga
-! ASCII output cleanup
-!
-! 4465 2020-03-20 11:35:48Z maronga
-! Removed old ASCII outputm, some syntax layout adjustments, added output for rotor and tower
-! diameters. Added warning message in case of NetCDF 3 (no WTM output file will be produced).
-!
-! 4460 2020-03-12 16:47:30Z oliver.maas
-! allow for simulating up to 10 000 wind turbines
-!
-! 4459 2020-03-12 09:35:23Z oliver.maas
-! avoid division by zero in tip loss correction factor calculation
-!
-! 4457 2020-03-11 14:20:43Z raasch
-! use statement for exchange horiz added
-!
-! 4447 2020-03-06 11:05:30Z oliver.maas
-! renamed wind_turbine_parameters namelist variables
-!
-! 4438 2020-03-03 20:49:28Z suehring
-! Bugfix: shifted netcdf preprocessor directive to correct position
-!
-! 4436 2020-03-03 12:47:02Z oliver.maas
-! added optional netcdf data input for wtm array input parameters
-!
-! 4426 2020-02-27 10:02:19Z oliver.maas
-! define time as unlimited dimension so that no maximum number of time steps has to be given for
-! wtm_data_output
-!
-! 4423 2020-02-25 07:17:11Z maronga
-! Switched to serial output as data is aggerated before anyway.
-!
-! 4420 2020-02-24 14:13:56Z maronga
-! Added output control for wind turbine model
-!
-! 4412 2020-02-19 14:53:13Z maronga
-! Bugfix: corrected character length in dimension_names
-!
-! 4411 2020-02-18 14:28:02Z maronga
-! Added output in NetCDF format using DOM (only netcdf4-parallel is supported).
-! Old ASCII output is still available at the moment.
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4343 2019-12-17 12:26:12Z oliver.maas
-! replaced <= by < in line 1464 to ensure that ialpha will not be greater than dlen
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4326 2019-12-06 14:16:14Z oliver.maas
-! changed format of turbine control output to allow for higher torque and power values
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 4144 2019-08-06 09:11:47Z raasch
-! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
-!
-! 4056 2019-06-27 13:53:16Z Giersch
-! CASE DEFAULT action in wtm_actions needs to be CONTINUE. Otherwise an abort will happen for
-! location values that are not implemented as CASE statements but are already realized in the code
-! (e.g. pt-tendency)
-!
-! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction of additional debug
-! messages
-!
-! 3875 2019-04-08 17:35:12Z knoop
-! Addaped wtm_tendency to fit the module actions interface
-!
-! 3832 2019-03-28 13:16:58Z raasch
-! instrumented with openmp directives
-!
-! 3725 2019-02-07 10:11:02Z raasch
-! unused variables removed
-!
-! 3685 2019-01-21 01:02:11Z knoop
-! Some interface calls moved to module_interface + cleanup
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! Replace degree symbol by 'degrees'
-!
-! 1914 2016-05-26 14:44:07Z witha
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> This module calculates the effect of wind turbines on the flow fields. The initial version
-!> contains only the advanced actuator disk with rotation method (ADM-R).
-!> The wind turbines include the tower effect, can be yawed and tilted.
-!> The wind turbine model includes controllers for rotational speed, pitch and yaw.
-!> Currently some specifications of the NREL 5 MW reference turbine are hardcoded whereas most input
-!> data comes from separate files (currently external, planned to be included as namelist which will
-!> be read in automatically).
-!>
-!> @todo Replace dz(1) appropriatly to account for grid stretching
-!> @todo Revise code according to PALM Coding Standard
-!> @todo Implement ADM and ALM turbine models
-!> @todo Generate header information
-!> @todo Implement further parameter checks and error messages
-!> @todo Revise and add code documentation
-!> @todo Output turbine parameters as timeseries
-!> @todo Include additional output variables
-!> @todo Revise smearing the forces for turbines in yaw
-!> @todo Revise nacelle and tower parameterization
-!> @todo Allow different turbine types in one simulation
-!
-!--------------------------------------------------------------------------------------------------!
- MODULE wind_turbine_model_mod
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  tend, u, v, w, zu, zw
-
-    USE basic_constants_and_equations_mod,                                                         &
-        ONLY:  pi
-
-    USE control_parameters,                                                                        &
-        ONLY:  coupling_char,                                                                      &
-               debug_output,                                                                       &
-               dt_3d, dz, end_time, initializing_actions, message_string,                          &
-               origin_date_time, restart_data_format_output, time_since_reference_point,           &
-               wind_turbine
-
-    USE cpulog,                                                                                    &
-        ONLY:  cpu_log, log_point_s
-
-    USE data_output_module
-
-    USE grid_variables,                                                                            &
-        ONLY:  ddx, dx, ddy, dy
-
-    USE indices,                                                                                   &
-        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz,                       &
-               nzb, nzt, wall_flags_total_0
-
-    USE kinds
-
-    USE netcdf_data_input_mod,                                                                     &
-        ONLY:  check_existence,                                                                    &
-               close_input_file,                                                                   &
-               get_variable,                                                                       &
-               input_pids_wtm,                                                                     &
-               inquire_num_variables,                                                              &
-               inquire_variable_names,                                                             &
-               input_file_wtm,                                                                     &
-               num_var_pids,                                                                       &
-               open_read_file,                                                                     &
-               pids_id,                                                                            &
-               vars_pids
-
-    USE pegrid
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  rrd_mpi_io_global_array, wrd_mpi_io_global_array
-
-        
-    IMPLICIT NONE
-
-    PRIVATE
-
-    CHARACTER(LEN=100) ::  variable_name  !< name of output variable
-    CHARACTER(LEN=30)  ::  nc_filename    !<
-
-
-    INTEGER(iwp), PARAMETER ::  n_turbines_max = 1E4  !< maximum number of turbines (for array allocation)
-
-
-!
-!-- Variables specified in the namelist wind_turbine_par
-    INTEGER(iwp) ::  n_airfoils = 8  !< number of airfoils of the used turbine model (for ADM-R and ALM)
-    INTEGER(iwp) ::  n_turbines = 1  !< number of turbines
-
-    LOGICAL ::  pitch_control       = .FALSE.  !< switch for use of pitch controller
-    LOGICAL ::  speed_control       = .FALSE.  !< switch for use of speed controller
-    LOGICAL ::  tip_loss_correction = .FALSE.  !< switch for use of tip loss correct.
-    LOGICAL ::  yaw_control         = .FALSE.  !< switch for use of yaw controller
-
-
-    LOGICAL ::  initial_write_coordinates = .FALSE.  !<
-
-
-    REAL(wp), DIMENSION(:), POINTER   ::  output_values_1d_pointer  !< pointer for 2d output array
-    REAL(wp), POINTER                 ::  output_values_0d_pointer  !< pointer for 2d output array
-    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET ::  output_values_1d_target  !< pointer for 2d output array
-    REAL(wp), TARGET                  ::  output_values_0d_target   !< pointer for 2d output array
-
-
-    REAL(wp) ::  dt_data_output_wtm = 0.0_wp  !< data output interval
-    REAL(wp) ::  time_wtm           = 0.0_wp  !< time since last data output
-
-
-    REAL(wp) ::  segment_length_tangential  = 1.0_wp  !< length of the segments, the rotor area is divided into
-                                                      !< (in tangential direction, as factor of MIN(dx,dy,dz))
-    REAL(wp) ::  segment_width_radial       = 0.5_wp  !< width of the segments, the rotor area is divided into
-                                                      !< (in radial direction, as factor of MIN(dx,dy,dz))
-    
-    REAL(wp) ::  smearing_kernel_size       = 2.0_wp  !< size of the smearing kernel as multiples of dx
-
-    REAL(wp) ::  time_turbine_on            = 0.0_wp  !< time at which turbines are started
-    REAL(wp) ::  tilt_angle                 = 0.0_wp  !< vertical tilt_angle of the rotor [degree] ( positive = backwards )
-
-                                                                                 !< ( clockwise, 0 = facing west )
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  hub_x               = 9999999.9_wp !< position of hub in x-direction
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  hub_y               = 9999999.9_wp !< position of hub in y-direction
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  hub_z               = 9999999.9_wp !< position of hub in z-direction
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  nacelle_radius      = 0.0_wp       !< nacelle diameter [m]
-!    REAL(wp), DIMENSION(1:n_turbines_max) ::  nacelle_cd          = 0.85_wp      !< drag coefficient for nacelle
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  tower_cd            = 1.2_wp       !< drag coefficient for tower
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  pitch_angle         = 0.0_wp       !< constant pitch angle
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  rotor_radius        = 63.0_wp      !< rotor radius [m]
-    REAL(wp), DIMENSION(1:n_turbines_max), TARGET ::  rotor_speed = 0.9_wp       !< inital or constant rotor speed [rad/s]
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  tower_diameter      = 0.0_wp       !< tower diameter [m]
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  yaw_angle           = 0.0_wp       !< yaw angle [degree]
-
-
-!
-!-- Variables specified in the namelist for speed controller
-!-- Default values are from the NREL 5MW research turbine (Jonkman, 2008)
-    REAL(wp) ::  air_density               = 1.225_wp       !< Air density to convert to W [kg/m3]
-    REAL(wp) ::  gear_efficiency           = 1.0_wp         !< Loss between rotor and generator
-    REAL(wp) ::  gear_ratio                = 97.0_wp        !< Gear ratio from rotor to generator
-    REAL(wp) ::  generator_power_rated     = 5296610.0_wp   !< rated turbine power [W]
-    REAL(wp) ::  generator_inertia         = 534.116_wp     !< Inertia of the generator [kg*m2]
-    REAL(wp) ::  generator_efficiency      = 0.944_wp       !< Electric efficiency of the generator
-    REAL(wp) ::  generator_speed_rated     = 121.6805_wp    !< Rated generator speed [rad/s]
-    REAL(wp) ::  generator_torque_max      = 47402.91_wp    !< Maximum of the generator torque [Nm]
-    REAL(wp) ::  generator_torque_rate_max = 15000.0_wp     !< Max generator torque increase [Nm/s]
-    REAL(wp) ::  pitch_rate                = 8.0_wp         !< Max pitch rate [degree/s]
-    REAL(wp) ::  region_2_slope            = 2.332287_wp    !< Slope constant for region 2
-    REAL(wp) ::  region_2_min              = 91.21091_wp    !< Lower generator speed boundary of region 2 [rad/s]
-    REAL(wp) ::  region_15_min             = 70.16224_wp    !< Lower generator speed boundary of region 1.5 [rad/s]
-    REAL(wp) ::  rotor_inertia             = 34784179.0_wp  !< Inertia of the rotor [kg*m2]
-
-
-
-!
-!-- Variables specified in the namelist for yaw control:
-    REAL(wp) ::  yaw_misalignment_max = 0.08726_wp   !< maximum tolerated yaw missalignment [rad]
-    REAL(wp) ::  yaw_misalignment_min = 0.008726_wp  !< minimum yaw missalignment for which the actuator stops [rad]
-    REAL(wp) ::  yaw_speed            = 0.005236_wp  !< speed of the yaw actuator [rad/s]
-
-!
-!-- Variables for initialization of the turbine model:
-    INTEGER(iwp) ::  inot        !< turbine loop index (turbine id)
-    INTEGER(iwp) ::  nsegs_max   !< maximum number of segments (all turbines, required for allocation of arrays)
-    INTEGER(iwp) ::  nrings_max  !< maximum number of rings (all turbines, required for allocation of arrays)
-    INTEGER(iwp) ::  ring        !< ring loop index (ring number)
-    INTEGER(iwp) ::  upper_end   !<
-
-    INTEGER(iwp), DIMENSION(1) ::  lct  !<
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  i_hub    !< index belonging to x-position of the turbine
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  i_smear  !< index defining the area for the smearing of the forces (x-direction)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j_hub    !< index belonging to y-position of the turbine
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j_smear  !< index defining the area for the smearing of the forces (y-direction)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k_hub    !< index belonging to hub height
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k_smear  !< index defining the area for the smearing of the forces (z-direction)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nrings   !< number of rings per turbine
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nsegs_total  !< total number of segments per turbine
-
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nsegs  !< number of segments per ring and turbine
-
-!
-!-  Parameters for the smearing from the rotor to the cartesian grid:
-    REAL(wp) ::  delta_t_factor  !<
-    REAL(wp) ::  eps_factor      !<
-    REAL(wp) ::  eps_min         !<
-    REAL(wp) ::  eps_min2        !<
-    REAL(wp) ::  pol_a           !< parameter for the polynomial smearing fct
-    REAL(wp) ::  pol_b           !< parameter for the polynomial smearing fct
-!
-!-- Variables for the calculation of lift and drag coefficients:
-    REAL(wp), DIMENSION(:), ALLOCATABLE  ::  ard      !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE  ::  crd      !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE  ::  delta_r  !< radial segment length
-    REAL(wp), DIMENSION(:), ALLOCATABLE  ::  lrd      !<
-
-    REAL(wp) ::  accu_cl_cd_tab = 0.1_wp  !< Accuracy of the interpolation of the lift and drag coeff [deg]
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: turb_cd_tab  !< table of the blade drag coefficient
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: turb_cl_tab  !< table of the blade lift coefficient
-
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  nac_cd_surf  !< 3d field of the tower drag coefficient
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  tow_cd_surf  !< 3d field of the nacelle drag coefficient
-
-!
-!-- Variables for the calculation of the forces:
-    REAL(wp) ::  cur_r       !<
-    REAL(wp) ::  phi_rotor   !<
-    REAL(wp) ::  pre_factor  !<
-    REAL(wp) ::  torque_seg  !<
-    REAL(wp) ::  u_int_l     !<
-    REAL(wp) ::  u_int_u     !<
-    REAL(wp) ::  u_rot       !<
-    REAL(wp) ::  v_int_l     !<
-    REAL(wp) ::  v_int_u     !<
-    REAL(wp) ::  w_int_l     !<
-    REAL(wp) ::  w_int_u     !<
-    !$OMP THREADPRIVATE (cur_r, phi_rotor, pre_factor, torque_seg, u_int_l, u_int_u, u_rot, &
-    !$OMP&               v_int_l, v_int_u, w_int_l, w_int_u)
-!
-!-  Tendencies from the nacelle and tower thrust:
-    REAL(wp) ::  tend_nac_x = 0.0_wp  !<
-    REAL(wp) ::  tend_nac_y = 0.0_wp  !<
-    REAL(wp) ::  tend_tow_x = 0.0_wp  !<
-    REAL(wp) ::  tend_tow_y = 0.0_wp  !<
-    !$OMP THREADPRIVATE (tend_nac_x, tend_tow_x, tend_nac_y, tend_tow_y)
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  alpha_attack  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  chord         !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  phi_rel       !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  torque_total  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  thrust_rotor  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  turb_cd       !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  turb_cl       !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  vrel          !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  vtheta        !<
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rbx, rby, rbz     !< coordinates of the blade elements
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rotx, roty, rotz  !< normal vectors to the rotor coordinates
-
-!
-!-  Fields for the interpolation of velocities on the rotor grid:
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_int      !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_int_1_l  !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_int      !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_int_1_l  !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_int      !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_int_1_l  !<
-
-!
-!-  Rotor tendencies on the segments:
-    REAL(wp), DIMENSION(:), ALLOCATABLE :: thrust_seg    !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE :: torque_seg_y  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE :: torque_seg_z  !<
-
-!
-!-  Rotor tendencies on the rings:
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  thrust_ring    !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  torque_ring_y  !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  torque_ring_z  !<
-
-!
-!-  Rotor tendencies on rotor grids for all turbines:
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  thrust     !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  torque_y   !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  torque_z   !<
-
-!
-!-  Rotor tendencies on coordinate grid:
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  rot_tend_x  !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  rot_tend_y  !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  rot_tend_z  !<
-
-!
-!-  Variables for the rotation of the rotor coordinates:
-    REAL(wp), DIMENSION(1:n_turbines_max,1:3,1:3) ::  rot_coord_trans  !< matrix for rotation of rotor coordinates
-
-    REAL(wp), DIMENSION(1:3) ::  rot_eigen_rad  !<
-    REAL(wp), DIMENSION(1:3) ::  rot_eigen_azi  !<
-    REAL(wp), DIMENSION(1:3) ::  rot_eigen_nor  !<
-    REAL(wp), DIMENSION(1:3) ::  re             !<
-    REAL(wp), DIMENSION(1:3) ::  rea            !<
-    REAL(wp), DIMENSION(1:3) ::  ren            !<
-    REAL(wp), DIMENSION(1:3) ::  rote           !<
-    REAL(wp), DIMENSION(1:3) ::  rota           !<
-    REAL(wp), DIMENSION(1:3) ::  rotn           !<
-
-!
-!-- Fixed variables for the speed controller:
-    LOGICAL  ::  start_up = .TRUE.  !<
-
-    REAL(wp) ::  fcorner           !< corner freq for the controller low pass filter
-    REAL(wp) ::  om_rate            !< rotor speed change
-    REAL(wp) ::  region_25_min      !< min region 2.5
-    REAL(wp) ::  region_25_slope    !< slope in region 2.5
-    REAL(wp) ::  slope15            !< slope in region 1.5
-    REAL(wp) ::  trq_rate           !< torque change
-    REAL(wp) ::  vs_sysp            !<
-    REAL(wp) ::  lp_coeff           !< coeff for the controller low pass filter
-
-    REAL(wp), DIMENSION(n_turbines_max) :: rotor_speed_l = 0.0_wp  !< local rot speed [rad/s]
-
-!
-!-- Fixed variables for the yaw controller:
-    INTEGER(iwp)                          ::  wdlon           !<
-    INTEGER(iwp)                          ::  wdsho            !<
-
-    LOGICAL,  DIMENSION(1:n_turbines_max) ::  doyaw = .FALSE.  !<
-
-    REAL(wp), DIMENSION(:)  , ALLOCATABLE ::  u_inflow         !< wind speed at hub
-    REAL(wp), DIMENSION(:)  , ALLOCATABLE ::  u_inflow_l       !<
-    REAL(wp), DIMENSION(:)  , ALLOCATABLE ::  wdir             !< wind direction at hub
-    REAL(wp), DIMENSION(:)  , ALLOCATABLE ::  wdir_l           !<
-    REAL(wp), DIMENSION(:)  , ALLOCATABLE ::  wd2_l            !< local (cpu) short running avg of the wd
-    REAL(wp), DIMENSION(:)  , ALLOCATABLE ::  wd30_l           !< local (cpu) long running avg of the wd
-    REAL(wp), DIMENSION(:)  , ALLOCATABLE ::  yawdir           !< direction to yaw
-    REAL(wp), DIMENSION(:)  , ALLOCATABLE ::  yaw_angle_l      !< local (cpu) yaw angle
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wd2              !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wd30             !<
-
-
-!
-!-- Variables that have to be saved in the binary file for restarts:
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  pitch_angle_old         = 0.0_wp  !< old constant pitch angle
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  generator_speed         = 0.0_wp  !< curr. generator speed
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  generator_speed_f       = 0.0_wp  !< filtered generator speed
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  generator_speed_old     = 0.0_wp  !< last generator speed
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  generator_speed_f_old   = 0.0_wp  !< last filtered generator speed
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  torque_gen              = 0.0_wp  !< generator torque
-    REAL(wp), DIMENSION(1:n_turbines_max) ::  torque_gen_old          = 0.0_wp  !< last generator torque
-
-
-    SAVE
-
-
-    INTERFACE wtm_parin
-       MODULE PROCEDURE wtm_parin
-    END INTERFACE wtm_parin
-
-    INTERFACE wtm_check_parameters
-       MODULE PROCEDURE wtm_check_parameters
-    END INTERFACE wtm_check_parameters
-
-    INTERFACE wtm_data_output
-       MODULE PROCEDURE wtm_data_output
-    END INTERFACE wtm_data_output
-
-    INTERFACE wtm_init_arrays
-       MODULE PROCEDURE wtm_init_arrays
-    END INTERFACE wtm_init_arrays
-
-    INTERFACE wtm_init
-       MODULE PROCEDURE wtm_init
-    END INTERFACE wtm_init
-
-    INTERFACE wtm_init_output
-       MODULE PROCEDURE wtm_init_output
-    END INTERFACE wtm_init_output
-
-    INTERFACE wtm_actions
-       MODULE PROCEDURE wtm_actions
-       MODULE PROCEDURE wtm_actions_ij
-    END INTERFACE wtm_actions
-
-    INTERFACE wtm_rrd_global
-       MODULE PROCEDURE wtm_rrd_global_ftn
-       MODULE PROCEDURE wtm_rrd_global_mpi
-    END INTERFACE wtm_rrd_global
-
-    INTERFACE wtm_wrd_global
-       MODULE PROCEDURE wtm_wrd_global
-    END INTERFACE wtm_wrd_global
-
-
-    PUBLIC                                                                                         &
-           dt_data_output_wtm,                                                                     &
-           time_wtm,                                                                               &
-           wind_turbine
-
-    PUBLIC                                                                                         &
-           wtm_parin,                                                                              &
-           wtm_check_parameters,                                                                   &
-           wtm_data_output,                                                                        &
-           wtm_init_arrays,                                                                        &
-           wtm_init_output,                                                                        &
-           wtm_init,                                                                               &
-           wtm_actions,                                                                            &
-           wtm_rrd_global,                                                                         &
-           wtm_wrd_global
-
-
- CONTAINS
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parin for &wind_turbine_par for wind turbine model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_parin
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter file
-
-    INTEGER(iwp) ::  io_status   !< status after reading the namelist file
-
-    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
-                                             !< although the respective module namelist appears in
-                                             !< the namelist file
-
-    NAMELIST /wind_turbine_parameters/  air_density,                                               &
-                                        dt_data_output_wtm,                                        &
-                                        gear_efficiency,                                           &
-                                        gear_ratio,                                                &
-                                        generator_efficiency,                                      &
-                                        generator_inertia,                                         &
-                                        generator_power_rated,                                     &
-                                        generator_speed_rated,                                     &
-                                        generator_torque_max,                                      &
-                                        generator_torque_rate_max,                                 &
-                                        hub_x,                                                     &
-                                        hub_y,                                                     &
-                                        hub_z,                                                     &
-                                        nacelle_radius,                                            &
-                                        n_airfoils,                                                &
-                                        n_turbines,                                                &
-                                        pitch_angle,                                               &
-                                        pitch_control,                                             &
-                                        pitch_rate,                                                &
-                                        region_15_min,                                             &
-                                        region_2_min,                                              &
-                                        region_2_slope,                                            &
-                                        rotor_inertia,                                             &
-                                        rotor_radius,                                              &
-                                        rotor_speed,                                               &
-                                        segment_length_tangential,                                 &
-                                        segment_width_radial,                                      &
-                                        smearing_kernel_size,                                      &
-                                        speed_control,                                             &
-                                        switch_off_module,                                         &
-                                        tilt_angle,                                                &
-                                        time_turbine_on,                                           &
-                                        tip_loss_correction,                                       &
-                                        tower_cd,                                                  &
-                                        tower_diameter,                                            &
-                                        yaw_angle,                                                 &
-                                        yaw_control,                                               &
-                                        yaw_misalignment_max,                                      &
-                                        yaw_misalignment_min,                                      &
-                                        yaw_speed
-
-!
-!-- Move to the beginning of the namelist file and try to find and read the namelist.
-    REWIND( 11 )
-    READ( 11, wind_turbine_parameters, IOSTAT=io_status )
-
-!
-!-- Action depending on the READ status
-    IF ( io_status == 0 )  THEN
-!
-!--    wind_turbine_parameters namelist was found and read correctly. Enable the
-!--    wind turbine module.
-       IF ( .NOT. switch_off_module )  wind_turbine = .TRUE.
-
-    ELSEIF ( io_status > 0 )  THEN
-!
-!--    wind_turbine_parameters namelist was found but contained errors. Print an error message
-!--    including the line that caused the problem.
-       BACKSPACE( 11 )
-       READ( 11 , '(A)' ) line
-       CALL parin_fail_message( 'wind_turbine_parameters', line )
-
-    ENDIF
-
- END SUBROUTINE wtm_parin
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> This routine writes the respective restart data.
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_wrd_global
-
-
-    IMPLICIT NONE
-
-
-   IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-
-       CALL wrd_write_string( 'generator_speed' )
-       WRITE ( 14 )  generator_speed
-
-       CALL wrd_write_string( 'generator_speed_f' )
-       WRITE ( 14 )  generator_speed_f
-
-       CALL wrd_write_string( 'generator_speed_f_old' )
-       WRITE ( 14 )  generator_speed_f_old
-
-       CALL wrd_write_string( 'generator_speed_old' )
-       WRITE ( 14 )  generator_speed_old
-
-       CALL wrd_write_string( 'rotor_speed' )
-       WRITE ( 14 )  rotor_speed
-
-       CALL wrd_write_string( 'yaw_angle' )
-       WRITE ( 14 )  yaw_angle
-
-       CALL wrd_write_string( 'pitch_angle' )
-       WRITE ( 14 )  pitch_angle
-
-       CALL wrd_write_string( 'pitch_angle_old' )
-       WRITE ( 14 )  pitch_angle_old
-
-       CALL wrd_write_string( 'torque_gen' )
-       WRITE ( 14 )  torque_gen
-
-       CALL wrd_write_string( 'torque_gen_old' )
-       WRITE ( 14 )  torque_gen_old
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-
-       CALL wrd_mpi_io_global_array( 'generator_speed', generator_speed )
-       CALL wrd_mpi_io_global_array( 'generator_speed_f', generator_speed_f )
-       CALL wrd_mpi_io_global_array( 'generator_speed_f_old', generator_speed_f_old )
-       CALL wrd_mpi_io_global_array( 'generator_speed_old', generator_speed_old )
-       CALL wrd_mpi_io_global_array( 'rotor_speed', rotor_speed )
-       CALL wrd_mpi_io_global_array( 'yaw_angle', yaw_angle )
-       CALL wrd_mpi_io_global_array( 'pitch_angle', pitch_angle )
-       CALL wrd_mpi_io_global_array( 'pitch_angle_old', pitch_angle_old )
-       CALL wrd_mpi_io_global_array( 'torque_gen', torque_gen )
-       CALL wrd_mpi_io_global_array( 'torque_gen_old', torque_gen_old )
-
-    ENDIF
-
- END SUBROUTINE wtm_wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (Fortran binary format).
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_rrd_global_ftn( found )
-
-
-    USE control_parameters,                                                                        &
-        ONLY: length, restart_string
-
-
-    IMPLICIT NONE
-
-    LOGICAL, INTENT(OUT) ::  found
-
-
-    found = .TRUE.
-
-
-    SELECT CASE ( restart_string(1:length) )
-
-       CASE ( 'generator_speed' )
-          READ ( 13 )  generator_speed
-       CASE ( 'generator_speed_f' )
-          READ ( 13 )  generator_speed_f
-       CASE ( 'generator_speed_f_old' )
-          READ ( 13 )  generator_speed_f_old
-       CASE ( 'generator_speed_old' )
-          READ ( 13 )  generator_speed_old
-       CASE ( 'rotor_speed' )
-          READ ( 13 )  rotor_speed
-       CASE ( 'yaw_angle' )
-          READ ( 13 )  yaw_angle
-       CASE ( 'pitch_angle' )
-          READ ( 13 )  pitch_angle
-       CASE ( 'pitch_angle_old' )
-          READ ( 13 )  pitch_angle_old
-       CASE ( 'torque_gen' )
-          READ ( 13 )  torque_gen
-       CASE ( 'torque_gen_old' )
-          READ ( 13 )  torque_gen_old
-
-       CASE DEFAULT
-
-          found = .FALSE.
-
-    END SELECT
-
-
- END SUBROUTINE wtm_rrd_global_ftn
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read module-specific global restart data (MPI-IO).
-!------------------------------------------------------------------------------!
- SUBROUTINE wtm_rrd_global_mpi
-
-    CALL rrd_mpi_io_global_array( 'generator_speed', generator_speed )
-    CALL rrd_mpi_io_global_array( 'generator_speed_f', generator_speed_f )
-    CALL rrd_mpi_io_global_array( 'generator_speed_f_old', generator_speed_f_old )
-    CALL rrd_mpi_io_global_array( 'generator_speed_old', generator_speed_old )
-    CALL rrd_mpi_io_global_array( 'rotor_speed', rotor_speed )
-    CALL rrd_mpi_io_global_array( 'yaw_angle', yaw_angle )
-    CALL rrd_mpi_io_global_array( 'pitch_angle', pitch_angle )
-    CALL rrd_mpi_io_global_array( 'pitch_angle_old', pitch_angle_old )
-    CALL rrd_mpi_io_global_array( 'torque_gen', torque_gen )
-    CALL rrd_mpi_io_global_array( 'torque_gen_old', torque_gen_old )
-
- END SUBROUTINE wtm_rrd_global_mpi
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Check namelist parameter
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_check_parameters
-
-    IMPLICIT NONE
-
-    IF ( .NOT. input_pids_wtm )  THEN
-       IF ( ( .NOT.speed_control ) .AND. pitch_control )  THEN
-          message_string = 'pitch_control = .TRUE. requires speed_control = .TRUE.'
-          CALL message( 'wtm_check_parameters', 'PA0461', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( ANY( rotor_speed(1:n_turbines) < 0.0 ) )  THEN
-          message_string = 'rotor_speed < 0.0, Please set rotor_speed to ' //                      &
-                           'a value equal or larger than zero'
-          CALL message( 'wtm_check_parameters', 'PA0462', 1, 2, 0, 6, 0 )
-       ENDIF
-
-       IF ( ANY( hub_x(1:n_turbines) == 9999999.9_wp ) .OR.                                        &
-            ANY( hub_y(1:n_turbines) == 9999999.9_wp ) .OR.                                        &
-            ANY( hub_z(1:n_turbines) == 9999999.9_wp ) )  THEN
-
-          message_string = 'hub_x, hub_y, hub_z have to be given for each turbine.'
-          CALL message( 'wtm_check_parameters', 'PA0463', 1, 2, 0, 6, 0 )
-       ENDIF
-    ENDIF
-
- END SUBROUTINE wtm_check_parameters
-!
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Allocate wind turbine model arrays
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_init_arrays
-
-    IMPLICIT NONE
-
-    REAL(wp) ::  delta_r_factor  !<
-    REAL(wp) ::  delta_r_init    !<
-
-#if defined( __netcdf )
-!
-! Read wtm input file (netcdf) if it exists:
-    IF ( input_pids_wtm )  THEN
-
-!
-!--    Open the wtm  input file:
-       CALL open_read_file( TRIM( input_file_wtm ) //                                              &
-                            TRIM( coupling_char ), pids_id )
-
-       CALL inquire_num_variables( pids_id, num_var_pids )
-
-!
-!--    Allocate memory to store variable names and read them:
-       ALLOCATE( vars_pids(1:num_var_pids) )
-       CALL inquire_variable_names( pids_id, vars_pids )
-
-!
-!--    Input of all wtm parameters:
-       IF ( check_existence( vars_pids, 'tower_diameter' ) )  THEN
-          CALL get_variable( pids_id, 'tower_diameter', tower_diameter(1:n_turbines) )
-       ENDIF
-
-       IF ( check_existence( vars_pids, 'rotor_speed' ) )  THEN
-          CALL get_variable( pids_id, 'rotor_speed', rotor_speed(1:n_turbines) )
-       ENDIF
-
-       IF ( check_existence( vars_pids, 'pitch_angle' ) )  THEN
-          CALL get_variable( pids_id, 'pitch_angle', pitch_angle(1:n_turbines) )
-       ENDIF
-
-       IF ( check_existence( vars_pids, 'yaw_angle' ) )  THEN
-          CALL get_variable( pids_id, 'yaw_angle', yaw_angle(1:n_turbines) )
-       ENDIF
-
-       IF ( check_existence( vars_pids, 'hub_x' ) )  THEN
-          CALL get_variable( pids_id, 'hub_x', hub_x(1:n_turbines) )
-       ENDIF
-
-       IF ( check_existence( vars_pids, 'hub_y' ) )  THEN
-          CALL get_variable( pids_id, 'hub_y', hub_y(1:n_turbines) )
-       ENDIF
-
-       IF ( check_existence( vars_pids, 'hub_z' ) )  THEN
-          CALL get_variable( pids_id, 'hub_z', hub_z(1:n_turbines) )
-       ENDIF
-
-       IF ( check_existence( vars_pids, 'nacelle_radius' ) )  THEN
-          CALL get_variable( pids_id, 'nacelle_radius', nacelle_radius(1:n_turbines) )
-       ENDIF
-
-       IF ( check_existence( vars_pids, 'rotor_radius' ) )  THEN
-          CALL get_variable( pids_id, 'rotor_radius', rotor_radius(1:n_turbines) )
-       ENDIF
-!
-!        IF ( check_existence( vars_pids, 'nacelle_cd' ) )  THEN
-!           CALL get_variable( pids_id, 'nacelle_cd', nacelle_cd(1:n_turbines) )
-!        ENDIF
-
-       IF ( check_existence( vars_pids, 'tower_cd' ) )  THEN
-          CALL get_variable( pids_id, 'tower_cd', tower_cd(1:n_turbines) )
-       ENDIF
-!
-!--    Close wtm input file:
-       CALL close_input_file( pids_id )
-
-    ENDIF
-#endif
-
-!
-!-- To be able to allocate arrays with dimension of rotor rings and segments,
-!-- the maximum possible numbers of rings and segments have to be calculated:
-    ALLOCATE( nrings(1:n_turbines) )
-    ALLOCATE( delta_r(1:n_turbines) )
-
-    nrings(:)  = 0
-    delta_r(:) = 0.0_wp
-
-!
-!-- Thickness (radial) of each ring and length (tangential) of each segment:
-    delta_r_factor = segment_width_radial
-    delta_t_factor = segment_length_tangential
-    delta_r_init   = delta_r_factor * MIN( dx, dy, dz(1) )
-
-    DO  inot = 1, n_turbines
-!
-!--    Determine number of rings:
-       nrings(inot) = NINT( rotor_radius(inot) / delta_r_init )
-
-       delta_r(inot) = rotor_radius(inot) / nrings(inot)
-
-    ENDDO
-
-    nrings_max = MAXVAL( nrings )
-
-    ALLOCATE( nsegs(1:nrings_max,1:n_turbines) )
-    ALLOCATE( nsegs_total(1:n_turbines) )
-
-    nsegs(:,:)     = 0
-    nsegs_total(:) = 0
-
-
-    DO  inot = 1, n_turbines
-       DO  ring = 1, nrings(inot)
-!
-!--       Determine number of segments for each ring:
-          nsegs(ring,inot) = MAX( 8, CEILING( delta_r_factor * pi * ( 2.0_wp * ring - 1.0_wp ) /   &
-                                              delta_t_factor ) )
-       ENDDO
-!
-!--    Total sum of all rotor segments:
-       nsegs_total(inot) = SUM( nsegs(:,inot) )
-    ENDDO
-
-!
-!-- Maximum number of segments per ring:
-    nsegs_max = MAXVAL( nsegs )
-
-!!
-!!-- TODO: Folgendes im Header ausgeben!
-!    IF ( myid == 0 )  THEN
-!       PRINT*, 'nrings(1) = ', nrings(1)
-!       PRINT*, '----------------------------------------------------------------------------------'
-!       PRINT*, 'nsegs(:,1) = ', nsegs(:,1)
-!       PRINT*, '----------------------------------------------------------------------------------'
-!       PRINT*, 'nrings_max = ', nrings_max
-!       PRINT*, 'nsegs_max = ', nsegs_max
-!       PRINT*, 'nsegs_total(1) = ', nsegs_total(1)
-!    ENDIF
-
-
-!
-!-- Allocate 1D arrays (dimension = number of turbines):
-    ALLOCATE( i_hub(1:n_turbines) )
-    ALLOCATE( i_smear(1:n_turbines) )
-    ALLOCATE( j_hub(1:n_turbines) )
-    ALLOCATE( j_smear(1:n_turbines) )
-    ALLOCATE( k_hub(1:n_turbines) )
-    ALLOCATE( k_smear(1:n_turbines) )
-    ALLOCATE( torque_total(1:n_turbines) )
-    ALLOCATE( thrust_rotor(1:n_turbines) )
-
-!
-!-- Allocation of the 1D arrays for yaw control:
-    ALLOCATE( yawdir(1:n_turbines) )
-    ALLOCATE( u_inflow(1:n_turbines) )
-    ALLOCATE( wdir(1:n_turbines) )
-    ALLOCATE( u_inflow_l(1:n_turbines) )
-    ALLOCATE( wdir_l(1:n_turbines) )
-    ALLOCATE( yaw_angle_l(1:n_turbines) )
-
-!
-!-- Allocate 1D arrays (dimension = number of rotor segments):
-    ALLOCATE( alpha_attack(1:nsegs_max) )
-    ALLOCATE( chord(1:nsegs_max) )
-    ALLOCATE( phi_rel(1:nsegs_max) )
-    ALLOCATE( thrust_seg(1:nsegs_max) )
-    ALLOCATE( torque_seg_y(1:nsegs_max) )
-    ALLOCATE( torque_seg_z(1:nsegs_max) )
-    ALLOCATE( turb_cd(1:nsegs_max) )
-    ALLOCATE( turb_cl(1:nsegs_max) )
-    ALLOCATE( vrel(1:nsegs_max) )
-    ALLOCATE( vtheta(1:nsegs_max) )
-
-!
-!-- Allocate 2D arrays (dimension = number of rotor rings and segments):
-    ALLOCATE( rbx(1:nrings_max,1:nsegs_max) )
-    ALLOCATE( rby(1:nrings_max,1:nsegs_max) )
-    ALLOCATE( rbz(1:nrings_max,1:nsegs_max) )
-    ALLOCATE( thrust_ring(1:nrings_max,1:nsegs_max) )
-    ALLOCATE( torque_ring_y(1:nrings_max,1:nsegs_max) )
-    ALLOCATE( torque_ring_z(1:nrings_max,1:nsegs_max) )
-
-!
-!-- Allocate additional 2D arrays:
-    ALLOCATE( rotx(1:n_turbines,1:3) )
-    ALLOCATE( roty(1:n_turbines,1:3) )
-    ALLOCATE( rotz(1:n_turbines,1:3) )
-
-!
-!-- Allocate 3D arrays (dimension = number of grid points):
-    ALLOCATE( nac_cd_surf(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( rot_tend_x(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( rot_tend_y(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( rot_tend_z(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( thrust(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( torque_y(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( torque_z(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ALLOCATE( tow_cd_surf(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-!
-!-- Allocate additional 3D arrays:
-    ALLOCATE( u_int(1:n_turbines,1:nrings_max,1:nsegs_max) )
-    ALLOCATE( u_int_1_l(1:n_turbines,1:nrings_max,1:nsegs_max) )
-    ALLOCATE( v_int(1:n_turbines,1:nrings_max,1:nsegs_max) )
-    ALLOCATE( v_int_1_l(1:n_turbines,1:nrings_max,1:nsegs_max) )
-    ALLOCATE( w_int(1:n_turbines,1:nrings_max,1:nsegs_max) )
-    ALLOCATE( w_int_1_l(1:n_turbines,1:nrings_max,1:nsegs_max) )
-
-!
-!-- All of the arrays are initialized with a value of zero:
-    i_hub(:)                 = 0
-    i_smear(:)               = 0
-    j_hub(:)                 = 0
-    j_smear(:)               = 0
-    k_hub(:)                 = 0
-    k_smear(:)               = 0
-
-    torque_total(:)          = 0.0_wp
-    thrust_rotor(:)          = 0.0_wp
-
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-       generator_speed(:)             = 0.0_wp
-       generator_speed_old(:)         = 0.0_wp
-       generator_speed_f(:)           = 0.0_wp
-       generator_speed_f_old(:)       = 0.0_wp
-       pitch_angle_old(:)             = 0.0_wp
-       torque_gen(:)                  = 0.0_wp
-       torque_gen_old(:)              = 0.0_wp
-    ENDIF
-
-    yawdir(:)                = 0.0_wp
-    wdir_l(:)                = 0.0_wp
-    wdir(:)                  = 0.0_wp
-    u_inflow(:)              = 0.0_wp
-    u_inflow_l(:)            = 0.0_wp
-    yaw_angle_l(:)           = 0.0_wp
-
-!
-!-- Allocate 1D arrays (dimension = number of rotor segments):
-    alpha_attack(:)          = 0.0_wp
-    chord(:)                 = 0.0_wp
-    phi_rel(:)               = 0.0_wp
-    thrust_seg(:)            = 0.0_wp
-    torque_seg_y(:)          = 0.0_wp
-    torque_seg_z(:)          = 0.0_wp
-    turb_cd(:)               = 0.0_wp
-    turb_cl(:)               = 0.0_wp
-    vrel(:)                  = 0.0_wp
-    vtheta(:)                = 0.0_wp
-
-    rbx(:,:)                 = 0.0_wp
-    rby(:,:)                 = 0.0_wp
-    rbz(:,:)                 = 0.0_wp
-    thrust_ring(:,:)         = 0.0_wp
-    torque_ring_y(:,:)       = 0.0_wp
-    torque_ring_z(:,:)       = 0.0_wp
-
-    rotx(:,:)                = 0.0_wp
-    roty(:,:)                = 0.0_wp
-    rotz(:,:)                = 0.0_wp
-
-    nac_cd_surf(:,:,:)       = 0.0_wp
-    rot_tend_x(:,:,:)        = 0.0_wp
-    rot_tend_y(:,:,:)        = 0.0_wp
-    rot_tend_z(:,:,:)        = 0.0_wp
-    thrust(:,:,:)            = 0.0_wp
-    torque_y(:,:,:)          = 0.0_wp
-    torque_z(:,:,:)          = 0.0_wp
-    tow_cd_surf(:,:,:)       = 0.0_wp
-
-    u_int(:,:,:)             = 0.0_wp
-    u_int_1_l(:,:,:)         = 0.0_wp
-    v_int(:,:,:)             = 0.0_wp
-    v_int_1_l(:,:,:)         = 0.0_wp
-    w_int(:,:,:)             = 0.0_wp
-    w_int_1_l(:,:,:)         = 0.0_wp
-
-
- END SUBROUTINE wtm_init_arrays
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the wind turbine model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_init
-
-
-    USE control_parameters,                                                                        &
-        ONLY:  dz_stretch_level_start
-
-    USE exchange_horiz_mod,                                                                        &
-        ONLY:  exchange_horiz
-
-    IMPLICIT NONE
-
-
-
-    INTEGER(iwp) ::  i  !< running index
-    INTEGER(iwp) ::  j  !< running index
-    INTEGER(iwp) ::  k  !< running index
-
-
-!
-!-- Help variables for the smearing function:
-    REAL(wp) ::  eps_kernel  !<
-
-!
-!-- Help variables for calculation of the tower drag:
-    INTEGER(iwp) ::  tower_n  !<
-    INTEGER(iwp) ::  tower_s  !<
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: index_nacb  !<
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: index_nacl  !<
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: index_nacr  !<
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: index_nact  !<
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: circle_points  !<
-
-
-    IF ( debug_output )  CALL debug_message( 'wtm_init', 'start' )
-
-    ALLOCATE( index_nacb(1:n_turbines) )
-    ALLOCATE( index_nacl(1:n_turbines) )
-    ALLOCATE( index_nacr(1:n_turbines) )
-    ALLOCATE( index_nact(1:n_turbines) )
-
-!
-!--------------------------------------------------------------------------------------------------!
-!-- Calculation of parameters for the regularization kernel (smearing of the forces)
-!--------------------------------------------------------------------------------------------------!
-!
-!-- In the following, some of the required parameters for the smearing will be calculated:
-
-!-- The kernel is set equal to twice the grid spacing which has turned out to be a reasonable
-!-- value (see e.g. Troldborg et al. (2013), Wind Energy, DOI: 10.1002/we.1608):
-    eps_kernel = smearing_kernel_size * dx
-!
-!-- The zero point (eps_min) of the polynomial function must be the following if the integral of
-!-- the polynomial function (for values < eps_min) shall be equal to the integral of the Gaussian
-!-- function used before:
-    eps_min = ( 105.0_wp / 32.0_wp )**( 1.0_wp / 3.0_wp ) *                                        &
-              pi**( 1.0_wp / 6.0_wp ) * eps_kernel
-!
-!-- Stretching (non-uniform grid spacing) is not considered in the wind turbine model.
-!-- Therefore, vertical stretching has to be applied above the area where the wtm is active.
-!-- ABS (...) is required because the default value of dz_stretch_level_start is -9999999.9_wp
-!-- (negative):
-    IF ( ABS( dz_stretch_level_start(1) ) <= MAXVAL( hub_z(1:n_turbines) ) +                       &
-                                             MAXVAL( rotor_radius(1:n_turbines) ) +                &
-                                             eps_min)  THEN
-       WRITE( message_string, * ) 'The lowest level where vertical stretching is applied has ' //  &
-                                  'to  be greater than ',MAXVAL( hub_z(1:n_turbines) )             &
-                                   + MAXVAL( rotor_radius(1:n_turbines) ) + eps_min
-       CALL message( 'wtm_init', 'PA0484', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Square of eps_min:
-    eps_min2 = eps_min**2
-!
-!-- Parameters in the polynomial function:
-    pol_a = 1.0_wp / eps_min**4
-    pol_b = 2.0_wp / eps_min**2
-!
-!-- Normalization factor which is the inverse of the integral of the smearing function:
-    eps_factor = 105.0_wp / ( 32.0_wp * pi * eps_min**3 )
-
-!-- Change tilt angle to rad:
-    tilt_angle = tilt_angle * pi / 180.0_wp
-
-!
-!-- Change yaw angle to rad:
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-       yaw_angle(:) = yaw_angle(:) * pi / 180.0_wp
-    ENDIF
-
-
-    DO  inot = 1, n_turbines
-!
-!--    Rotate the rotor coordinates in case yaw and tilt are defined:
-       CALL wtm_rotate_rotor( inot )
-
-!
-!--    Determine the indices of the hub height:
-       i_hub(inot) = INT(   hub_x(inot)                    / dx )
-       j_hub(inot) = INT( ( hub_y(inot) + 0.5_wp * dy )    / dy )
-       k_hub(inot) = INT( ( hub_z(inot) + 0.5_wp * dz(1) ) / dz(1) )
-
-!
-!--    Determining the area to which the smearing of the forces is applied.
-!--    As smearing now is effectively applied only for distances smaller than eps_min, the
-!--    smearing area can be further limited and regarded as a function of eps_min:
-       i_smear(inot) = CEILING( ( rotor_radius(inot) + eps_min ) / dx )
-       j_smear(inot) = CEILING( ( rotor_radius(inot) + eps_min ) / dy )
-       k_smear(inot) = CEILING( ( rotor_radius(inot) + eps_min ) / dz(1) )
-
-    ENDDO
-
-!
-!-- Call the wtm_init_speed_control subroutine and calculate the local rotor_speed for the
-!-- respective processor:
-    IF ( speed_control)  THEN
-
-       CALL wtm_init_speed_control
-
-       IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
-
-          DO  inot = 1, n_turbines
-
-             IF ( nxl > i_hub(inot) )  THEN
-                torque_gen(inot)        = 0.0_wp
-                generator_speed_f(inot) = 0.0_wp
-                rotor_speed_l(inot)     = 0.0_wp
-             ENDIF
-
-             IF ( nxr < i_hub(inot) )  THEN
-                torque_gen(inot)        = 0.0_wp
-                generator_speed_f(inot) = 0.0_wp
-                rotor_speed_l(inot)     = 0.0_wp
-             ENDIF
-
-             IF ( nys > j_hub(inot) )  THEN
-                torque_gen(inot)        = 0.0_wp
-                generator_speed_f(inot) = 0.0_wp
-                rotor_speed_l(inot)     = 0.0_wp
-             ENDIF
-
-             IF ( nyn < j_hub(inot) )  THEN
-                torque_gen(inot)        = 0.0_wp
-                generator_speed_f(inot) = 0.0_wp
-                rotor_speed_l(inot)     = 0.0_wp
-             ENDIF
-
-             IF ( ( nxl <= i_hub(inot) ) .AND. ( nxr >= i_hub(inot) ) )  THEN
-                IF ( ( nys <= j_hub(inot) ) .AND. ( nyn >= j_hub(inot) ) )  THEN
-
-                   rotor_speed_l(inot) = generator_speed(inot) / gear_ratio
-
-                ENDIF
-             ENDIF
-
-          END DO
-
-       ENDIF
-
-    ENDIF
-
-!
-!--------------------------------------------------------------------------------------------------!
-!-- Determine the area within each grid cell that overlaps with the area of the nacelle and the
-!-- tower (needed for calculation of the forces)
-!--------------------------------------------------------------------------------------------------!
-!
-!-- Note: so far this is only a 2D version, in that the mean flow is perpendicular to the rotor
-!-- area.
-
-!
-!-- Allocation of the array containing information on the intersection points between rotor disk
-!-- and the numerical grid:
-    upper_end = ( ny + 1 ) * 10000
-
-    ALLOCATE( circle_points(1:2,1:upper_end) )
-
-    circle_points(:,:) = 0.0_wp
-
-
-    DO  inot = 1, n_turbines  ! loop over number of turbines
-!
-!--    Determine the grid index (u-grid) that corresponds to the location of the rotor center
-!--    (reduces the amount of calculations in the case that the mean flow is perpendicular to the
-!--    rotor area):
-       i = i_hub(inot)
-
-!
-!--    Determine the left and the right edge of the nacelle (corresponding grid point indices):
-       index_nacl(inot) = INT( ( hub_y(inot) - nacelle_radius(inot) + 0.5_wp * dy ) / dy )
-       index_nacr(inot) = INT( ( hub_y(inot) + nacelle_radius(inot) + 0.5_wp * dy ) / dy )
-!
-!--    Determine the bottom and the top edge of the nacelle (corresponding grid point indices).
-!--    The grid point index has to be increased by 1, as the first level for the u-component
-!--    (index 0) is situated below the surface. All points between z=0 and z=dz/s would already
-!--    be contained in grid box 1:
-       index_nacb(inot) = INT( ( hub_z(inot) - nacelle_radius(inot) ) / dz(1) ) + 1
-       index_nact(inot) = INT( ( hub_z(inot) + nacelle_radius(inot) ) / dz(1) ) + 1
-
-!
-!--    Determine the indices of the grid boxes containing the left and the right boundaries of
-!--    the tower:
-       tower_n = ( hub_y(inot) + 0.5_wp * tower_diameter(inot) - 0.5_wp * dy ) / dy
-       tower_s = ( hub_y(inot) - 0.5_wp * tower_diameter(inot) - 0.5_wp * dy ) / dy
-
-!
-!--    Determine the fraction of the grid box area overlapping with the tower area and multiply
-!--    it with the drag of the tower:
-       IF ( ( nxlg <= i )  .AND.  ( nxrg >= i ) )  THEN
-
-          DO  j = nys, nyn
-!
-!--          Loop from south to north boundary of tower:
-             IF ( ( j >= tower_s )  .AND.  ( j <= tower_n ) )  THEN
-
-                DO  k = nzb, nzt
-
-                   IF ( k == k_hub(inot) )  THEN
-                      IF ( tower_n - tower_s >= 1 )  THEN
-!
-!--                   Leftmost and rightmost grid box:
-                         IF ( j == tower_s )  THEN
-                            tow_cd_surf(k,j,i) = ( hub_z(inot) -                                   &
-                                 ( k_hub(inot) * dz(1) - 0.5_wp * dz(1) ) ) * & ! extension in z-direction
-                                 ( ( tower_s + 1.0_wp + 0.5_wp ) * dy    -                         &
-                                 ( hub_y(inot) - 0.5_wp * tower_diameter(inot) ) ) * & ! extension in y-direction
-                               tower_cd(inot)
-
-                         ELSEIF ( j == tower_n )  THEN
-                            tow_cd_surf(k,j,i) = ( hub_z(inot)            -                        &
-                                 ( k_hub(inot) * dz(1) - 0.5_wp * dz(1) ) ) * & ! extension in z-direction
-                               ( ( hub_y(inot) + 0.5_wp * tower_diameter(inot) )   -               &
-                                 ( tower_n + 0.5_wp ) * dy ) * & ! extension in y-direction
-                               tower_cd(inot)
-!
-!--                      Grid boxes inbetween (where tow_cd_surf = grid box area):
-                         ELSE
-                            tow_cd_surf(k,j,i) = ( hub_z(inot) -                                   &
-                                                 ( k_hub(inot) * dz(1) - 0.5_wp * dz(1) ) ) * dy * &
-                                                 tower_cd(inot)
-                         ENDIF
-!
-!--                   Tower lies completely within one grid box:
-                      ELSE
-                         tow_cd_surf(k,j,i) = ( hub_z(inot) - ( k_hub(inot) *                      &
-                                              dz(1) - 0.5_wp * dz(1) ) ) *                         &
-                                              tower_diameter(inot) * tower_cd(inot)
-                      ENDIF
-!
-!--               In case that k is smaller than k_hub the following actions are carried out:
-                   ELSEIF ( k < k_hub(inot) )  THEN
-
-                      IF ( ( tower_n - tower_s ) >= 1 )  THEN
-!
-!--                      Leftmost and rightmost grid box:
-                         IF ( j == tower_s )  THEN
-                            tow_cd_surf(k,j,i) = dz(1) * ( ( tower_s + 1 + 0.5_wp ) * dy -         &
-                                                ( hub_y(inot) - 0.5_wp * tower_diameter(inot) ) )  &
-                                                * tower_cd(inot)
-
-                         ELSEIF ( j == tower_n )  THEN
-                            tow_cd_surf(k,j,i) = dz(1) * ( ( hub_y(inot) + 0.5_wp *                &
-                                                 tower_diameter(inot) ) - ( tower_n + 0.5_wp )     &
-                                                 * dy ) * tower_cd(inot)
-!
-!--                      Grid boxes inbetween (where tow_cd_surf = grid box area):
-                         ELSE
-                            tow_cd_surf(k,j,i) = dz(1) * dy * tower_cd(inot)
-                         ENDIF
-!
-!--                      Tower lies completely within one grid box:
-                      ELSE
-                         tow_cd_surf(k,j,i) = dz(1) * tower_diameter(inot) * tower_cd(inot)
-                      ENDIF ! end if larger than grid box
-
-                   ENDIF    ! end if k == k_hub
-
-                ENDDO       ! end loop over k
-
-             ENDIF          ! end if inside north and south boundary of tower
-
-          ENDDO             ! end loop over j
-
-       ENDIF                ! end if hub inside domain + ghostpoints
-
-
-       CALL exchange_horiz( tow_cd_surf, nbgp )
-
-!
-!--    Calculation of the nacelle area
-!--    CAUTION: Currently disabled due to segmentation faults on the FLOW HPC cluster (Oldenburg)
-!!
-!!--    Tabulate the points on the circle that are required in the following for the calculation
-!!--    of the Riemann integral (node points; they are called circle_points in the following):
-!
-!       dy_int = dy / 10000.0_wp
-!
-!       DO  i_ip = 1, upper_end
-!          yvalue   = dy_int * ( i_ip - 0.5_wp ) + 0.5_wp * dy  !<--- segmentation fault
-!          sqrt_arg = nacelle_radius(inot)**2 - ( yvalue - hub_y(inot) )**2  !<--- segmentation fault
-!          IF ( sqrt_arg >= 0.0_wp )  THEN
-!!
-!!--          bottom intersection point
-!             circle_points(1,i_ip) = hub_z(inot) - SQRT( sqrt_arg )
-!!
-!!--          top intersection point
-!             circle_points(2,i_ip) = hub_z(inot) + SQRT( sqrt_arg )  !<--- segmentation fault
-!          ELSE
-!             circle_points(:,i_ip) = -111111  !<--- segmentation fault
-!          ENDIF
-!       ENDDO
-!
-!
-!       DO  j = nys, nyn
-!!
-!!--       In case that the grid box is located completely outside the nacelle (y) it can
-!!--       automatically be stated that there is no overlap between the grid box and the nacelle
-!!--       and consequently we can set nac_cd_surf(:,j,i) = 0.0:
-!          IF ( ( j >= index_nacl(inot) )  .AND.  ( j <= index_nacr(inot) ) )  THEN
-!             DO  k = nzb+1, nzt
-!!
-!!--             In case that the grid box is located completely outside the nacelle (z) it can
-!!--             automatically be stated that there is no overlap between the grid box and the
-!!--             nacelle and consequently we can set nac_cd_surf(k,j,i) = 0.0:
-!                IF ( ( k >= index_nacb(inot) )  .OR.                           &
-!                     ( k <= index_nact(inot) ) )  THEN
-!!
-!!--                For all other cases Riemann integrals are calculated. Here, the points on the
-!!--                circle that have been determined above are used in order to calculate the
-!!--                overlap between the gridbox and the nacelle area (area approached by 10000
-!!--                rectangulars dz_int * dy_int):
-!                   DO  i_ipg = 1, 10000
-!                      dz_int = dz
-!                      i_ip = j * 10000 + i_ipg
-!!
-!!--                   Determine the vertical extension dz_int of the circle within the current
-!!--                   grid box:
-!                      IF ( ( circle_points(2,i_ip) < zw(k) ) .AND.          &  !<--- segmentation fault
-!                           ( circle_points(2,i_ip) >= zw(k-1) ) ) THEN
-!                         dz_int = dz_int -                                  &  !<--- segmentation fault
-!                                  ( zw(k) - circle_points(2,i_ip) )
-!                      ENDIF
-!                      IF ( ( circle_points(1,i_ip) <= zw(k) ) .AND.         &  !<--- segmentation fault
-!                           ( circle_points(1,i_ip) > zw(k-1) ) ) THEN
-!                         dz_int = dz_int -                                  &
-!                                  ( circle_points(1,i_ip) - zw(k-1) )
-!                      ENDIF
-!                      IF ( zw(k-1) > circle_points(2,i_ip) ) THEN
-!                         dz_int = 0.0_wp
-!                      ENDIF
-!                      IF ( zw(k) < circle_points(1,i_ip) ) THEN
-!                         dz_int = 0.0_wp
-!                      ENDIF
-!                      IF ( ( nxlg <= i ) .AND. ( nxrg >= i ) ) THEN
-!                         nac_cd_surf(k,j,i) = nac_cd_surf(k,j,i) +        &  !<--- segmentation fault
-!                                               dy_int * dz_int * nacelle_cd(inot)
-!                      ENDIF
-!                   ENDDO
-!                ENDIF
-!             ENDDO
-!          ENDIF
-!
-!       ENDDO
-!
-!       CALL exchange_horiz( nac_cd_surf, nbgp )  !<---  segmentation fault
-
-    ENDDO  ! end of loop over turbines
-
-    tow_cd_surf   = tow_cd_surf   / ( dx * dy * dz(1) )  ! Normalize tower drag
-    nac_cd_surf = nac_cd_surf / ( dx * dy * dz(1) )      ! Normalize nacelle drag
-
-    CALL wtm_read_blade_tables
-
-    IF ( debug_output )  CALL debug_message( 'wtm_init', 'end' )
-
- END SUBROUTINE wtm_init
-
-
-
-SUBROUTINE wtm_init_output
-
-
-!    INTEGER(iwp) ::  ntimesteps              !< number of timesteps defined in NetCDF output file
-!    INTEGER(iwp) ::  ntimesteps_max = 80000  !< number of maximum timesteps defined in NetCDF output file
-    INTEGER(iwp) ::  return_value            !< returned status value of called function
-
-    INTEGER(iwp) ::  n  !< running index
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ndim !< dummy to write dimension
-
-
-!
-!-- Create NetCDF output file:
-#if defined( __netcdf4 )
-    nc_filename = 'DATA_1D_TS_WTM_NETCDF' // TRIM( coupling_char )
-    return_value = dom_def_file( nc_filename, 'netcdf4-serial' )
-#else
-    message_string = 'Wind turbine model output requires NetCDF version 4. ' //                    &
-                     'No output file will be created.'
-                   CALL message( 'wtm_init_output', 'PA0672', 0, 1, 0, 6, 0 )
-#endif
-    IF ( myid == 0 )  THEN
-!
-!--    Define dimensions in output file:
-       ALLOCATE( ndim(1:n_turbines) )
-       DO  n = 1, n_turbines
-          ndim(n) = n
-       ENDDO
-       return_value = dom_def_dim( nc_filename,                                                    &
-                                   dimension_name = 'turbine',                                     &
-                                   output_type = 'int32',                                          &
-                                   bounds = (/1_iwp, n_turbines/),                                 &
-                                   values_int32 = ndim )
-       DEALLOCATE( ndim )
-
-       return_value = dom_def_dim( nc_filename,                                                    &
-                                   dimension_name = 'time',                                        &
-                                   output_type = 'real32',                                         &
-                                   bounds = (/1_iwp/),                                             &
-                                   values_realwp = (/0.0_wp/) )
-
-       variable_name = 'x'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/'turbine'/),                                &
-                                   output_type = 'real32' )
-
-       variable_name = 'y'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/'turbine'/),                                &
-                                   output_type = 'real32' )
-
-       variable_name = 'z'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/'turbine'/),                                &
-                                   output_type = 'real32' )
-
-
-       variable_name = 'rotor_diameter'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/'turbine'/),                                &
-                                   output_type = 'real32' )
-
-       variable_name = 'tower_diameter'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/'turbine'/),                                &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'time',                                         &
-                                   attribute_name = 'units',                                       &
-                                   value = 'seconds since ' // origin_date_time )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'x',                                            &
-                                   attribute_name = 'units',                                       &
-                                   value = 'm' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'y',                                            &
-                                   attribute_name = 'units',                                       &
-                                   value = 'm' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'z',                                            &
-                                   attribute_name = 'units',                                       &
-                                   value = 'm' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'rotor_diameter',                               &
-                                   attribute_name = 'units',                                       &
-                                   value = 'm' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'tower_diameter',                               &
-                                   attribute_name = 'units',                                       &
-                                   value = 'm' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'x',                                            &
-                                   attribute_name = 'long_name',                                   &
-                                   value = 'x location of rotor center' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'y',                                            &
-                                   attribute_name = 'long_name',                                   &
-                                   value = 'y location of rotor center' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'z',                                            &
-                                   attribute_name = 'long_name',                                   &
-                                   value = 'z location of rotor center' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'turbine_name',                                 &
-                                   attribute_name = 'long_name',                                   &
-                                   value = 'turbine name')
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'rotor_diameter',                               &
-                                   attribute_name = 'long_name',                                   &
-                                   value = 'rotor diameter')
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'tower_diameter',                               &
-                                   attribute_name = 'long_name',                                   &
-                                   value = 'tower diameter')
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'time',                                         &
-                                   attribute_name = 'standard_name',                               &
-                                   value = 'time')
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'time',                                         &
-                                   attribute_name = 'axis',                                        &
-                                   value = 'T')
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'x',                                            &
-                                   attribute_name = 'axis',                                        &
-                                   value = 'X' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = 'y',                                            &
-                                   attribute_name = 'axis',                                        &
-                                   value = 'Y' )
-
-
-       variable_name = 'generator_power'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/ 'turbine', 'time   ' /),                   &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   attribute_name = 'units',                                       &
-                                   value = 'W' )
-
-       variable_name = 'generator_speed'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/ 'turbine', 'time   ' /),                   &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   attribute_name = 'units',                                       &
-                                   value = 'rad/s' )
-
-       variable_name = 'generator_torque'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/ 'turbine', 'time   ' /),                   &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   attribute_name = 'units',                                       &
-                                   value = 'Nm' )
-
-       variable_name = 'pitch_angle'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/ 'turbine', 'time   ' /),                   &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   attribute_name = 'units',                                       &
-                                   value = 'degrees' )
-
-       variable_name = 'rotor_power'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/ 'turbine', 'time   ' /),                   &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   attribute_name = 'units',                                       &
-                                   value = 'W' )
-
-       variable_name = 'rotor_speed'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/ 'turbine', 'time   ' /),                   &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   attribute_name = 'units',                                       &
-                                   value = 'rad/s' )
-
-       variable_name = 'rotor_thrust'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/ 'turbine', 'time   ' /),                   &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   attribute_name = 'units',                                       &
-                                   value = 'N' )
-
-       variable_name = 'rotor_torque'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/ 'turbine', 'time   ' /),                   &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   attribute_name = 'units',                                       &
-                                   value = 'Nm' )
-
-       variable_name = 'wind_direction'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/ 'turbine', 'time   ' /),                   &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   attribute_name = 'units',                                       &
-                                   value = 'degrees' )
-
-       variable_name = 'yaw_angle'
-       return_value = dom_def_var( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   dimension_names = (/ 'turbine', 'time   ' /),                   &
-                                   output_type = 'real32' )
-
-       return_value = dom_def_att( nc_filename,                                                    &
-                                   variable_name = variable_name,                                  &
-                                   attribute_name = 'units',                                       &
-                                   value = 'degrees' )
-
-   ENDIF
-END SUBROUTINE
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Read in layout of the rotor blade , the lift and drag tables and the distribution of lift and
-!> drag tables along the blade
-!--------------------------------------------------------------------------------------------------!
-!
- SUBROUTINE wtm_read_blade_tables
-
-
-    IMPLICIT NONE
-
-    CHARACTER(200) :: chmess  !< Read in string
-
-    INTEGER(iwp) ::  ii  !< running index
-    INTEGER(iwp) ::  jj  !< running index
-
-    INTEGER(iwp) ::  ierrn  !<
-
-    INTEGER(iwp) ::  dlen        !< no. rows of local table
-    INTEGER(iwp) ::  dlenbl      !< no. rows of cd, cl table
-    INTEGER(iwp) ::  dlenbl_int  !< no. rows of interpolated cd, cl tables
-    INTEGER(iwp) ::  ialpha      !< table position of current alpha value
-    INTEGER(iwp) ::  iialpha     !<
-    INTEGER(iwp) ::  iir         !<
-    INTEGER(iwp) ::  radres      !< radial resolution
-    INTEGER(iwp) ::  t1          !< no. of airfoil
-    INTEGER(iwp) ::  t2          !< no. of airfoil
-    INTEGER(iwp) ::  trow        !<
-
-
-    REAL(wp) :: alpha_attack_i  !<
-    REAL(wp) :: weight_a        !<
-    REAL(wp) :: weight_b        !<
-
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ttoint1  !<
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ttoint2  !<
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE :: turb_cd_sel1  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE :: turb_cd_sel2  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE :: turb_cl_sel1  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE :: turb_cl_sel2  !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE :: read_cl_cd    !< read in var array
-
-    REAL(wp), DIMENSION(:),   ALLOCATABLE :: alpha_attack_tab  !<
-    REAL(wp), DIMENSION(:),   ALLOCATABLE :: trad1             !<
-    REAL(wp), DIMENSION(:),   ALLOCATABLE :: trad2             !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: turb_cd_table     !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: turb_cl_table     !<
-
-    ALLOCATE ( read_cl_cd(1:2 * n_airfoils + 1) )
-
-!
-!-- Read in the distribution of lift and drag tables along the blade, the layout of the rotor
-!-- blade and the lift and drag tables:
-    OPEN ( 90, FILE='WTM_DATA', STATUS='OLD', FORM='FORMATTED', IOSTAT=ierrn )
-
-    IF ( ierrn /= 0 )  THEN
-       message_string = 'file WTM_DATA does not exist'
-       CALL message( 'wtm_init', 'PA0464', 1, 2, 0, 6, 0 )
-    ENDIF
-!
-!-- Read distribution table:
-    dlen = 0
-
-    READ ( 90, '(3/)' )
-
-    rloop3: DO
-       READ ( 90, *, IOSTAT=ierrn ) chmess
-       IF ( ierrn < 0  .OR.  chmess == '#'  .OR.  chmess == '')  EXIT rloop3
-       dlen = dlen + 1
-    ENDDO rloop3
-
-    ALLOCATE( trad1(1:dlen), trad2(1:dlen), ttoint1(1:dlen), ttoint2(1:dlen) )
-
-    DO  jj = 1, dlen+1
-       BACKSPACE ( 90, IOSTAT=ierrn )
-    ENDDO
-
-    DO  jj = 1, dlen
-       READ ( 90, * ) trad1(jj), trad2(jj), ttoint1(jj), ttoint2(jj)
-    ENDDO
-
-!
-!-- Read layout table:
-    dlen = 0
-
-    READ ( 90, '(3/)')
-
-    rloop1: DO
-       READ ( 90, *, IOSTAT=ierrn ) chmess
-       IF ( ierrn < 0  .OR.  chmess == '#'  .OR.  chmess == '')  EXIT rloop1
-       dlen = dlen + 1
-    ENDDO rloop1
-
-    ALLOCATE( lrd(1:dlen), ard(1:dlen), crd(1:dlen) )
-    DO  jj = 1, dlen + 1
-       BACKSPACE ( 90, IOSTAT=ierrn )
-    ENDDO
-    DO  jj = 1, dlen
-       READ ( 90, * ) lrd(jj), ard(jj), crd(jj)
-    ENDDO
-
-!
-!-- Read tables (turb_cl(alpha),turb_cd(alpha) for the different profiles:
-    dlen = 0
-
-    READ ( 90, '(3/)' )
-
-    rloop2: DO
-       READ ( 90, *, IOSTAT=ierrn ) chmess
-       IF ( ierrn < 0  .OR.  chmess == '#'  .OR.  chmess == '')  EXIT rloop2
-       dlen = dlen + 1
-    ENDDO rloop2
-
-    ALLOCATE( alpha_attack_tab(1:dlen), turb_cl_table(1:dlen,1:n_airfoils), &
-              turb_cd_table(1:dlen,1:n_airfoils) )
-
-    DO  jj = 1, dlen + 1
-       BACKSPACE ( 90, IOSTAT=ierrn )
-    ENDDO
-
-    DO  jj = 1, dlen
-       READ ( 90, * ) read_cl_cd
-       alpha_attack_tab(jj) = read_cl_cd(1)
-       DO  ii = 1, n_airfoils
-          turb_cl_table(jj,ii) = read_cl_cd(ii * 2)
-          turb_cd_table(jj,ii) = read_cl_cd(ii * 2 + 1)
-       ENDDO
-
-    ENDDO
-
-    dlenbl = dlen
-
-    CLOSE ( 90 )
-
-!
-!-- For each possible radial position (resolution: 0.1 m --> 631 values if rotor_radius(1)=63m)
-!-- and each possible angle of attack (resolution: 0.1 degrees --> 3601 values!) determine the
-!-- lift and drag coefficient by interpolating between the tabulated values of each table
-!-- (interpolate to current angle of attack) and between the tables (interpolate to current
-!-- radial position):
-    ALLOCATE( turb_cl_sel1(1:dlenbl) )
-    ALLOCATE( turb_cl_sel2(1:dlenbl) )
-    ALLOCATE( turb_cd_sel1(1:dlenbl) )
-    ALLOCATE( turb_cd_sel2(1:dlenbl) )
-
-    radres     = INT( rotor_radius(1) * 10.0_wp ) + 1_iwp
-    dlenbl_int = INT( 360.0_wp / accu_cl_cd_tab ) + 1_iwp
-
-    ALLOCATE( turb_cl_tab(1:dlenbl_int,1:radres) )
-    ALLOCATE( turb_cd_tab(1:dlenbl_int,1:radres) )
-
-    DO  iir = 1, radres ! loop over radius
-
-       cur_r = ( iir - 1_iwp ) * 0.1_wp
-!
-!--    Find position in table 1:
-       lct = MINLOC( ABS( trad1 - cur_r ) )
-!          lct(1) = lct(1)
-
-       IF ( ( trad1(lct(1)) - cur_r ) > 0.0 )  THEN
-          lct(1) = lct(1) - 1
-       ENDIF
-
-       trow = lct(1)
-!
-!--    Calculate weights for radius interpolation:
-       weight_a = ( trad2(trow) - cur_r ) / ( trad2(trow) - trad1(trow) )
-       weight_b = ( cur_r - trad1(trow) ) / ( trad2(trow) - trad1(trow) )
-       t1 = ttoint1(trow)
-       t2 = ttoint2(trow)
-
-       IF ( t1 == t2 )  THEN  ! if both are the same, the weights are NaN
-          weight_a = 0.5_wp   ! then do interpolate in between same twice
-          weight_b = 0.5_wp   ! using 0.5 as weight
-       ENDIF
-
-       IF ( t1 == 0 .AND. t2 == 0 )  THEN
-          turb_cd_sel1 = 0.0_wp
-          turb_cd_sel2 = 0.0_wp
-          turb_cl_sel1 = 0.0_wp
-          turb_cl_sel2 = 0.0_wp
-
-          turb_cd_tab(1,iir) = 0.0_wp  ! For -180 degrees (iialpha=1) the values
-          turb_cl_tab(1,iir) = 0.0_wp  ! for each radius has to be set
-                                       ! explicitly
-       ELSE
-          turb_cd_sel1 = turb_cd_table(:,t1)
-          turb_cd_sel2 = turb_cd_table(:,t2)
-          turb_cl_sel1 = turb_cl_table(:,t1)
-          turb_cl_sel2 = turb_cl_table(:,t2)
-!
-!--       For -180 degrees (iialpha=1) the values for each radius has to be set explicitly:
-          turb_cd_tab(1,iir) = ( weight_a * turb_cd_table(1,t1) + weight_b * turb_cd_table(1,t2) )
-          turb_cl_tab(1,iir) = ( weight_a * turb_cl_table(1,t1) + weight_b * turb_cl_table(1,t2) )
-       ENDIF
-
-       DO  iialpha = 2, dlenbl_int  ! loop over angles
-
-          alpha_attack_i = -180.0_wp + REAL( iialpha-1 ) * accu_cl_cd_tab
-          ialpha = 1
-
-          DO WHILE  ( ( alpha_attack_i > alpha_attack_tab(ialpha) ) .AND. ( ialpha < dlen ) )
-             ialpha = ialpha + 1
-          ENDDO
-
-!
-!--       Interpolation of lift and drag coefficiencts on fine grid of radius segments and angles
-!--       of attack:
-          turb_cl_tab(iialpha,iir) = ( alpha_attack_tab(ialpha) - alpha_attack_i ) /               &
-                                     ( alpha_attack_tab(ialpha) - alpha_attack_tab(ialpha-1) ) *   &
-                                     ( weight_a * turb_cl_sel1(ialpha-1) +                         &
-                                       weight_b * turb_cl_sel2(ialpha-1) ) +                       &
-                                     ( alpha_attack_i - alpha_attack_tab(ialpha-1) ) /             &
-                                     ( alpha_attack_tab(ialpha) - alpha_attack_tab(ialpha-1) ) *   &
-                                     ( weight_a * turb_cl_sel1(ialpha) +                           &
-                                       weight_b * turb_cl_sel2(ialpha) )
-          turb_cd_tab(iialpha,iir) = ( alpha_attack_tab(ialpha) - alpha_attack_i ) /               &
-                                     ( alpha_attack_tab(ialpha) - alpha_attack_tab(ialpha-1) ) *   &
-                                     ( weight_a * turb_cd_sel1(ialpha-1) +                         &
-                                       weight_b * turb_cd_sel2(ialpha-1) ) +                       &
-                                     ( alpha_attack_i - alpha_attack_tab(ialpha-1) ) /             &
-                                     ( alpha_attack_tab(ialpha) - alpha_attack_tab(ialpha-1) ) *   &
-                                     ( weight_a * turb_cd_sel1(ialpha) +                           &
-                                       weight_b * turb_cd_sel2(ialpha) )
-
-       ENDDO   ! end loop over angles of attack
-
-    ENDDO   ! end loop over radius
-
-
- END SUBROUTINE wtm_read_blade_tables
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> The projection matrix for the coordinate system of therotor disc in respect to the yaw and tilt
-!> angle of the rotor is calculated
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_rotate_rotor( inot )
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) :: inot
-!
-!-- Calculation of the rotation matrix for the application of the tilt to the rotors:
-    rot_eigen_rad(1) = SIN( yaw_angle(inot) )   ! x-component of the radial eigenvector
-    rot_eigen_rad(2) = COS( yaw_angle(inot) )   ! y-component of the radial eigenvector
-    rot_eigen_rad(3) = 0.0_wp                   ! z-component of the radial eigenvector
-
-    rot_eigen_azi(1) = 0.0_wp                   ! x-component of the azimuth eigenvector
-    rot_eigen_azi(2) = 0.0_wp                   ! y-component of the azimuth eigenvector
-    rot_eigen_azi(3) = 1.0_wp                   ! z-component of the azimuth eigenvector
-
-    rot_eigen_nor(1) =  COS( yaw_angle(inot) )  ! x-component of the normal eigenvector
-    rot_eigen_nor(2) = -SIN( yaw_angle(inot) )  ! y-component of the normal eigenvector
-    rot_eigen_nor(3) = 0.0_wp                   ! z-component of the normal eigenvector
-
-!
-!-- Calculation of the coordinate transformation matrix to apply a tilt to the rotor.
-!-- If tilt = 0, rot_coord_trans is a unit matrix.
-    rot_coord_trans(inot,1,1) = rot_eigen_rad(1)**2                   *                            &
-                                ( 1.0_wp - COS( tilt_angle ) ) + COS( tilt_angle )
-    rot_coord_trans(inot,1,2) = rot_eigen_rad(1) * rot_eigen_rad(2)   *                            &
-                                ( 1.0_wp - COS( tilt_angle ) )              -                      &
-                                rot_eigen_rad(3) * SIN( tilt_angle )
-    rot_coord_trans(inot,1,3) = rot_eigen_rad(1) * rot_eigen_rad(3)   *                            &
-                                ( 1.0_wp - COS( tilt_angle ) )              +                      &
-                                rot_eigen_rad(2) * SIN( tilt_angle )
-    rot_coord_trans(inot,2,1) = rot_eigen_rad(2) * rot_eigen_rad(1)   *                            &
-                                ( 1.0_wp - COS( tilt_angle ) )              +                      &
-                                rot_eigen_rad(3) * SIN( tilt_angle )
-    rot_coord_trans(inot,2,2) = rot_eigen_rad(2)**2                   *                            &
-                                ( 1.0_wp - COS( tilt_angle ) ) + COS( tilt_angle )
-    rot_coord_trans(inot,2,3) = rot_eigen_rad(2) * rot_eigen_rad(3)   *                            &
-                                ( 1.0_wp - COS( tilt_angle ) )              -                      &
-                                rot_eigen_rad(1) * SIN( tilt_angle )
-    rot_coord_trans(inot,3,1) = rot_eigen_rad(3) * rot_eigen_rad(1)   *                            &
-                                ( 1.0_wp - COS( tilt_angle ) )              -                      &
-                                rot_eigen_rad(2) * SIN( tilt_angle )
-    rot_coord_trans(inot,3,2) = rot_eigen_rad(3) * rot_eigen_rad(2)   *                            &
-                                ( 1.0_wp - COS( tilt_angle ) )              +                      &
-                                rot_eigen_rad(1) * SIN( tilt_angle )
-    rot_coord_trans(inot,3,3) = rot_eigen_rad(3)**2                   *                            &
-                                ( 1.0_wp - COS( tilt_angle ) ) + COS( tilt_angle )
-
-!
-!-- Vectors for the Transformation of forces from the rotor's spheric coordinate system to the
-!-- cartesian coordinate system:
-    rotx(inot,:) = MATMUL( rot_coord_trans(inot,:,:), rot_eigen_nor )
-    roty(inot,:) = MATMUL( rot_coord_trans(inot,:,:), rot_eigen_rad )
-    rotz(inot,:) = MATMUL( rot_coord_trans(inot,:,:), rot_eigen_azi )
-
- END SUBROUTINE wtm_rotate_rotor
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of the forces generated by the wind turbine
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_forces
-
-
-    IMPLICIT NONE
-
-
-    INTEGER(iwp) ::  i, j, k       !< loop indices
-    INTEGER(iwp) ::  ii, jj, kk    !<
-    INTEGER(iwp) ::  inot          !< turbine loop index (turbine id)
-    INTEGER(iwp) ::  iialpha, iir  !<
-    INTEGER(iwp) ::  rseg          !<
-    INTEGER(iwp) ::  ring          !<
-
-    REAL(wp)     ::  flag              !< flag to mask topography grid points
-    REAL(wp)     ::  sin_rot, cos_rot  !<
-    REAL(wp)     ::  sin_yaw, cos_yaw  !<
-
-    REAL(wp) ::  aa, bb, cc, dd  !< interpolation distances
-    REAL(wp) ::  gg              !< interpolation volume var
-
-    REAL(wp) ::  dist_u_3d, dist_v_3d, dist_w_3d  !< smearing distances
-
-
-!
-!-- Variables for pitch control:
-    INTEGER(iwp), DIMENSION(1) ::  lct = 0
-
-    LOGICAL ::  pitch_sw = .FALSE.
-
-    REAL(wp), DIMENSION(1)     ::  rad_d = 0.0_wp
-
-    REAL(wp) :: tl_factor  !< factor for tip loss correction
-
-
-    CALL cpu_log( log_point_s(61), 'wtm_forces', 'start' )
-
-
-    IF ( time_since_reference_point >= time_turbine_on )   THEN
-
-!
-!--    Set forces to zero for each new time step:
-       thrust(:,:,:)         = 0.0_wp
-       torque_y(:,:,:)       = 0.0_wp
-       torque_z(:,:,:)       = 0.0_wp
-       torque_total(:)       = 0.0_wp
-       rot_tend_x(:,:,:)     = 0.0_wp
-       rot_tend_y(:,:,:)     = 0.0_wp
-       rot_tend_z(:,:,:)     = 0.0_wp
-       thrust_rotor(:)       = 0.0_wp
-!
-!--    Loop over number of turbines:
-       DO  inot = 1, n_turbines
-
-          cos_yaw = COS(yaw_angle(inot))
-          sin_yaw = SIN(yaw_angle(inot))
-!
-!--       Loop over rings of each turbine:
-          !$OMP PARALLEL PRIVATE (ring, rseg, thrust_seg, torque_seg_y, torque_seg_z, sin_rot,  &
-          !$OMP&                  cos_rot, re, rbx, rby, rbz, ii, jj, kk, aa, bb, cc, dd, gg)
-          !$OMP DO
-          DO  ring = 1, nrings(inot)
-
-             thrust_seg(:)   = 0.0_wp
-             torque_seg_y(:) = 0.0_wp
-             torque_seg_z(:) = 0.0_wp
-!
-!--          Determine distance between each ring (center) and the hub:
-             cur_r = (ring - 0.5_wp) * delta_r(inot)
-
-!
-!--          Loop over segments of each ring of each turbine:
-             DO  rseg = 1, nsegs(ring,inot)
-!
-!--             !----------------------------------------------------------------------------------!
-!--             !-- Determine coordinates of the ring segments                                   --!
-!--             !----------------------------------------------------------------------------------!
-!
-!--             Determine angle of ring segment towards zero degree angle of rotor system
-!--             (at zero degree rotor direction vectors aligned with y-axis):
-                phi_rotor = rseg * 2.0_wp * pi / nsegs(ring,inot)
-                cos_rot   = COS( phi_rotor )
-                sin_rot   = SIN( phi_rotor )
-
-!--             Now the direction vectors can be determined with respect to the yaw and tilt angle:
-                re(1) = cos_rot * sin_yaw
-                re(2) = cos_rot * cos_yaw
-                re(3) = sin_rot
-
-                rote = MATMUL( rot_coord_trans(inot,:,:), re )
-!
-!--             Coordinates of the single segments (center points):
-                rbx(ring,rseg) = hub_x(inot) + cur_r * rote(1)
-                rby(ring,rseg) = hub_y(inot) + cur_r * rote(2)
-                rbz(ring,rseg) = hub_z(inot) + cur_r * rote(3)
-
-!--             !----------------------------------------------------------------------------------!
-!--             !-- Interpolation of the velocity components from the cartesian grid point to    --!
-!--             !-- the coordinates of each ring segment (follows a method used in the           --!
-!--             !-- particle model)                                                              --!
-!--             !----------------------------------------------------------------------------------!
-
-                u_int(inot,ring,rseg)     = 0.0_wp
-                u_int_1_l(inot,ring,rseg) = 0.0_wp
-
-                v_int(inot,ring,rseg)     = 0.0_wp
-                v_int_1_l(inot,ring,rseg) = 0.0_wp
-
-                w_int(inot,ring,rseg)     = 0.0_wp
-                w_int_1_l(inot,ring,rseg) = 0.0_wp
-
-!
-!--             Interpolation of the u-component:
-                ii =   rbx(ring,rseg) * ddx
-                jj = ( rby(ring,rseg) - 0.5_wp * dy ) * ddy
-                kk = ( rbz(ring,rseg) + 0.5_wp * dz(1) ) / dz(1)
-!
-!--             Interpolate only if all required information is available on the current PE:
-                IF ( ( ii >= nxl )  .AND.  ( ii <= nxr ) )  THEN
-                   IF ( ( jj >= nys )  .AND.  ( jj <= nyn ) )  THEN
-
-                      aa = ( ( ii + 1          ) * dx - rbx(ring,rseg) ) *                         &
-                           ( ( jj + 1 + 0.5_wp ) * dy - rby(ring,rseg) )
-                      bb = ( rbx(ring,rseg) - ii * dx )                  *                         &
-                           ( ( jj + 1 + 0.5_wp ) * dy - rby(ring,rseg) )
-                      cc = ( ( ii+1            ) * dx - rbx(ring,rseg) ) *                         &
-                           ( rby(ring,rseg) - ( jj + 0.5_wp ) * dy )
-                      dd = ( rbx(ring,rseg) -              ii * dx )     *                         &
-                           ( rby(ring,rseg) - ( jj + 0.5_wp ) * dy )
-                      gg = dx * dy
-
-                      u_int_l = ( aa * u(kk,jj,ii) + bb * u(kk,jj,ii+1)   + cc * u(kk,jj+1,ii)     &
-                                +  dd * u(kk,jj+1,ii+1) ) / gg
-
-                      u_int_u = ( aa * u(kk+1,jj,ii) + bb * u(kk+1,jj,ii+1) + cc * u(kk+1,jj+1,ii) &
-                                + dd * u(kk+1,jj+1,ii+1) ) / gg
-
-                      u_int_1_l(inot,ring,rseg) = u_int_l + ( rbz(ring,rseg) - zu(kk) ) / dz(1) *  &
-                                                ( u_int_u - u_int_l )
-
-                   ELSE
-                      u_int_1_l(inot,ring,rseg) = 0.0_wp
-                   ENDIF
-
-                ELSE
-                   u_int_1_l(inot,ring,rseg) = 0.0_wp
-                ENDIF
-
-
-!
-!--             Interpolation of the v-component:
-                ii = ( rbx(ring,rseg) - 0.5_wp * dx ) * ddx
-                jj =   rby(ring,rseg)                 * ddy
-                kk = ( rbz(ring,rseg) + 0.5_wp * dz(1) ) / dz(1)
-!
-!--             Interpolate only if all required information is available on the current PE:
-                IF ( ( ii >= nxl )  .AND.  ( ii <= nxr ) )  THEN
-                   IF ( ( jj >= nys )  .AND.  ( jj <= nyn ) )  THEN
-
-                      aa = ( ( ii + 1 + 0.5_wp ) * dx - rbx(ring,rseg) ) *                         &
-                           ( ( jj + 1 )          * dy - rby(ring,rseg) )
-                      bb = ( rbx(ring,rseg)     - ( ii + 0.5_wp ) * dx ) *                         &
-                           ( ( jj + 1 ) * dy          - rby(ring,rseg) )
-                      cc = ( ( ii + 1 + 0.5_wp ) * dx - rbx(ring,rseg) ) *                         &
-                           ( rby(ring,rseg)           -        jj * dy )
-                      dd = ( rbx(ring,rseg)     - ( ii + 0.5_wp ) * dx ) *                         &
-                           ( rby(ring,rseg)           -        jj * dy )
-                      gg = dx * dy
-
-                      v_int_l = ( aa * v(kk,jj,ii) + bb * v(kk,jj,ii+1) + cc * v(kk,jj+1,ii)       &
-                                + dd * v(kk,jj+1,ii+1) ) / gg
-
-                      v_int_u = ( aa * v(kk+1,jj,ii) + bb * v(kk+1,jj,ii+1) + cc * v(kk+1,jj+1,ii) &
-                                + dd * v(kk+1,jj+1,ii+1) ) / gg
-
-                      v_int_1_l(inot,ring,rseg) = v_int_l + ( rbz(ring,rseg) - zu(kk) ) / dz(1) *  &
-                                                ( v_int_u - v_int_l )
-
-                   ELSE
-                      v_int_1_l(inot,ring,rseg) = 0.0_wp
-                   ENDIF
-
-                ELSE
-                   v_int_1_l(inot,ring,rseg) = 0.0_wp
-                ENDIF
-
-
-!
-!--             Interpolation of the w-component:
-                ii = ( rbx(ring,rseg) - 0.5_wp * dx ) * ddx
-                jj = ( rby(ring,rseg) - 0.5_wp * dy ) * ddy
-                kk =   rbz(ring,rseg)                 / dz(1)
-!
-!--             Interpolate only if all required information is available on the current PE:
-                IF ( ( ii >= nxl )  .AND.  ( ii <= nxr ) )  THEN
-                   IF ( ( jj >= nys )  .AND.  ( jj <= nyn ) )  THEN
-
-                      aa = ( ( ii + 1 + 0.5_wp ) * dx - rbx(ring,rseg) ) *                         &
-                           ( ( jj + 1 + 0.5_wp ) * dy - rby(ring,rseg) )
-                      bb = ( rbx(ring,rseg)     - ( ii + 0.5_wp ) * dx ) *                         &
-                           ( ( jj + 1 + 0.5_wp ) * dy - rby(ring,rseg) )
-                      cc = ( ( ii + 1 + 0.5_wp ) * dx - rbx(ring,rseg) ) *                         &
-                           ( rby(ring,rseg)     - ( jj + 0.5_wp ) * dy )
-                      dd = ( rbx(ring,rseg)     - ( ii + 0.5_wp ) * dx ) *                         &
-                           ( rby(ring,rseg)     - ( jj + 0.5_wp ) * dy )
-                      gg = dx * dy
-
-                      w_int_l = ( aa * w(kk,jj,ii) + bb * w(kk,jj,ii+1) + cc * w(kk,jj+1,ii)       &
-                                + dd * w(kk,jj+1,ii+1) ) / gg
-
-                      w_int_u = ( aa * w(kk+1,jj,ii) + bb * w(kk+1,jj,ii+1) + cc * w(kk+1,jj+1,ii) &
-                                + dd * w(kk+1,jj+1,ii+1) ) / gg
-
-                      w_int_1_l(inot,ring,rseg) = w_int_l + ( rbz(ring,rseg) - zw(kk) ) / dz(1) *  &
-                                                ( w_int_u - w_int_l )
-                   ELSE
-                      w_int_1_l(inot,ring,rseg) = 0.0_wp
-                   ENDIF
-
-                ELSE
-                   w_int_1_l(inot,ring,rseg) = 0.0_wp
-                ENDIF
-
-             ENDDO
-
-          ENDDO
-          !$OMP END PARALLEL
-
-       ENDDO
-
-!
-!--    Exchange between PEs (information required on each PE):
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( u_int_1_l, u_int, n_turbines * MAXVAL(nrings) *                         &
-                           MAXVAL(nsegs), MPI_REAL, MPI_SUM, comm2d, ierr )
-       CALL MPI_ALLREDUCE( v_int_1_l, v_int, n_turbines * MAXVAL(nrings) *                         &
-                           MAXVAL(nsegs), MPI_REAL, MPI_SUM, comm2d, ierr )
-       CALL MPI_ALLREDUCE( w_int_1_l, w_int, n_turbines * MAXVAL(nrings) *                         &
-                           MAXVAL(nsegs), MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-       u_int = u_int_1_l
-       v_int = v_int_1_l
-       w_int = w_int_1_l
-#endif
-
-
-!
-!--    Loop over number of turbines:
-       DO  inot = 1, n_turbines
-pit_loop: DO
-
-          IF ( pitch_sw )  THEN
-             torque_total(inot) = 0.0_wp
-             thrust_rotor(inot) = 0.0_wp
-             pitch_angle(inot)    = pitch_angle(inot) + 0.25_wp
-!              IF ( myid == 0 ) PRINT*, 'Pitch', inot, pitch_angle(inot)
-          ELSE
-             cos_yaw = COS( yaw_angle(inot) )
-             sin_yaw = SIN( yaw_angle(inot) )
-             IF ( pitch_control )  THEN
-                pitch_angle(inot) = MAX( pitch_angle_old(inot) - pitch_rate * dt_3d , 0.0_wp )
-             ENDIF
-          ENDIF
-
-!
-!--       Loop over rings of each turbine:
-          !$OMP PARALLEL PRIVATE (ring, rseg, sin_rot, cos_rot, re, rea, ren, rote, rota, rotn, &
-          !$OMP&                  vtheta, phi_rel, lct, rad_d, alpha_attack, vrel,              &
-          !$OMP&                  chord, iialpha, iir, turb_cl, tl_factor, thrust_seg,          &
-          !$OMP&                  torque_seg_y, turb_cd, torque_seg_z, thrust_ring,             &
-          !$OMP&                  torque_ring_y, torque_ring_z)
-          !$OMP DO
-          DO  ring = 1, nrings(inot)
-!
-!--          Determine distance between each ring (center) and the hub:
-             cur_r = ( ring - 0.5_wp ) * delta_r(inot)
-!
-!--          Loop over segments of each ring of each turbine:
-             DO  rseg = 1, nsegs(ring,inot)
-!
-!--             Determine angle of ring segment towards zero degree angle of rotor system
-!--             (at zero degree rotor direction vectors aligned with y-axis):
-                phi_rotor = rseg * 2.0_wp * pi / nsegs(ring,inot)
-                cos_rot   = COS( phi_rotor )
-                sin_rot   = SIN( phi_rotor )
-!
-!--             Now the direction vectors can be determined with respect to the yaw and tilt angle:
-                re(1) = cos_rot * sin_yaw
-                re(2) = cos_rot * cos_yaw
-                re(3) = sin_rot
-
-!               The current unit vector in azimuthal direction:
-                rea(1) = - sin_rot * sin_yaw
-                rea(2) = - sin_rot * cos_yaw
-                rea(3) =   cos_rot
-
-!
-!--             To respect the yawing angle for the calculations of velocities and forces the
-!--             unit vectors perpendicular to the rotor area in direction of the positive yaw
-!--             angle are defined:
-                ren(1) =   cos_yaw
-                ren(2) = - sin_yaw
-                ren(3) = 0.0_wp
-!
-!--             Multiplication with the coordinate transformation matrix gives the final unit
-!--             vector with consideration of the rotor tilt:
-                rote = MATMUL( rot_coord_trans(inot,:,:), re )
-                rota = MATMUL( rot_coord_trans(inot,:,:), rea )
-                rotn = MATMUL( rot_coord_trans(inot,:,:), ren )
-!
-!--             Coordinates of the single segments (center points):
-                rbx(ring,rseg) = hub_x(inot) + cur_r * rote(1)
-
-                rby(ring,rseg) = hub_y(inot) + cur_r * rote(2)
-
-                rbz(ring,rseg) = hub_z(inot) + cur_r * rote(3)
-
-!
-!--             !----------------------------------------------------------------------------------!
-!--             !-- Calculation of various angles and relative velocities                        --!
-!--             !----------------------------------------------------------------------------------!
-!
-!--             In the following the 3D-velocity field is projected its components perpendicular
-!--             and parallel to the rotor area.
-!--             The calculation of forces will be done in the rotor-coordinates y' and z.
-!--             The yaw angle will be reintroduced when the force is applied on the hydrodynamic
-!--             equations.
-!
-!--             Projection of the xy-velocities relative to the rotor area:
-!
-!--             Velocity perpendicular to the rotor area:
-                u_rot = u_int(inot,ring,rseg) * rotn(1) + v_int(inot,ring,rseg)*rotn(2) +          &
-                        w_int(inot,ring,rseg)*rotn(3)
-!
-
-!--             Projection of the 3D-velocity vector in the azimuthal direction:
-                vtheta(rseg) = rota(1) * u_int(inot,ring,rseg) + rota(2) * v_int(inot,ring,rseg) + &
-                               rota(3) * w_int(inot,ring,rseg)
-!
-
-!--             Determination of the angle phi_rel between the rotor plane and the direction of the
-!--             flow relative to the rotor:
-                phi_rel(rseg) = ATAN2( u_rot , ( rotor_speed(inot) * cur_r - vtheta(rseg) ) )
-
-!
-!--             Interpolation of the local pitch angle from tabulated values to the current
-!--             radial position:
-                lct = minloc( ABS( cur_r-lrd ) )
-                rad_d = cur_r-lrd(lct)
-
-                IF ( cur_r == 0.0_wp )  THEN
-                   alpha_attack(rseg) = 0.0_wp
-
-                ELSE IF ( cur_r >= lrd(size(ard)) )  THEN
-                   alpha_attack(rseg) = ( ard(size(ard) ) + ard(size(ard) -1 ) ) / 2.0_wp
-
-                ELSE
-                   alpha_attack(rseg) = ( ard( lct(1) ) * ( ( lrd( lct(1) + 1 ) - cur_r ) /        &
-                                        ( lrd( lct(1) + 1 ) - lrd( lct(1) ) ) ) ) +                &
-                                        ( ard( lct(1) + 1 ) * ( ( cur_r - lrd( lct(1) ) ) /        &
-                                        ( lrd( lct(1) + 1 ) - lrd( lct(1) ) ) ) )
-                ENDIF
-
-!
-!--             In Fortran radian instead of degree is used as unit for all angles.
-!--             Therefore, a transformation from angles given in degree to angles given in radian
-!--             is necessary here:
-                alpha_attack(rseg) = alpha_attack(rseg) * ( ( 2.0_wp * pi ) / 360.0_wp )
-!
-!--             Substraction of the local pitch angle to obtain the local angle of attack:
-                alpha_attack(rseg) = phi_rel(rseg) - alpha_attack(rseg)
-!
-!--             Preliminary transformation back from angles given in radian to angles given in
-!--             degree:
-                alpha_attack(rseg) = alpha_attack(rseg) * ( 360.0_wp / ( 2.0_wp * pi ) )
-!
-!--             Correct with collective pitch angle:
-                alpha_attack(rseg) = alpha_attack(rseg) - pitch_angle(inot)
-
-!
-!--             Determination of the magnitude of the flow velocity relative to the rotor:
-                vrel(rseg) = SQRT( u_rot**2 + ( rotor_speed(inot) * cur_r - vtheta(rseg) )**2 )
-
-!
-!--             !----------------------------------------------------------------------------------!
-!--             !-- Interpolation of chord as well as lift and drag                              --!
-!--             !-- coefficients from tabulated values                                           --!
-!--             !----------------------------------------------------------------------------------!
-
-!
-!--             Interpolation of the chord_length from tabulated values to the current radial
-!--             position:
-                IF ( cur_r == 0.0_wp )  THEN
-                   chord(rseg) = 0.0_wp
-
-                ELSE IF ( cur_r >= lrd( size(crd) ) )  THEN
-                   chord(rseg) = ( crd( size(crd) ) + ard( size(crd) - 1 ) ) / 2.0_wp
-
-                ELSE
-                   chord(rseg) = ( crd( lct(1) ) * ( ( lrd( lct(1) + 1 ) - cur_r ) /               &
-                                 ( lrd( lct(1) + 1 ) - lrd( lct(1) ) ) ) ) + ( crd( lct(1) + 1 )   &
-                                 * ( ( cur_r - lrd( lct(1) ) ) / ( lrd( lct(1) + 1 ) -             &
-                                 lrd( lct(1) ) ) ) )
-                ENDIF
-
-!
-!--             Determine index of current angle of attack, needed for finding the appropriate
-!--             interpolated values of the lift and drag coefficients
-!--             (-180.0 degrees = 1, +180.0 degrees = 3601, so one index every 0.1 degrees):
-                iialpha = CEILING( ( alpha_attack(rseg) + 180.0_wp )                               &
-                        * ( 1.0_wp / accu_cl_cd_tab ) ) + 1.0_wp
-!
-!--             Determine index of current radial position, needed for finding the appropriate
-!--             interpolated values of the lift and drag coefficients (one index every 0.1 m):
-                iir = CEILING( cur_r * 10.0_wp )
-!
-!--             Read in interpolated values of the lift and drag coefficients for the current
-!--             radial position and angle of attack:
-                turb_cl(rseg) = turb_cl_tab(iialpha,iir)
-                turb_cd(rseg) = turb_cd_tab(iialpha,iir)
-
-!
-!--             Final transformation back from angles given in degree to angles given in radian:
-                alpha_attack(rseg) = alpha_attack(rseg) * ( ( 2.0_wp * pi ) / 360.0_wp )
-
-                IF ( tip_loss_correction )  THEN
-!
-!--               Tip loss correction following Schito.
-!--               Schito applies the tip loss correction only to the lift force.
-!--               Therefore, the tip loss correction is only applied to the lift coefficient and
-!--               not to the drag coefficient in our case.
-                  IF ( phi_rel(rseg) == 0.0_wp )  THEN
-                     tl_factor = 1.0_wp
-
-                  ELSE
-                     tl_factor = ( 2.0 / pi ) *                                                    &
-                          ACOS( EXP( -1.0 * ( 3.0 * ( rotor_radius(inot) - cur_r ) /               &
-                          ( 2.0 * cur_r * ABS( SIN( phi_rel(rseg) ) ) ) ) ) )
-                  ENDIF
-
-                  turb_cl(rseg)  = tl_factor * turb_cl(rseg)
-
-                ENDIF
-!
-!--             !----------------------------------------------------------------------------------!
-!--             !-- Calculation of the forces                                                    --!
-!--             !----------------------------------------------------------------------------------!
-
-!
-!--             Calculate the pre_factor for the thrust and torque forces:
-                pre_factor = 0.5_wp * ( vrel(rseg)**2 ) * 3.0_wp * chord(rseg) * delta_r(inot)     &
-                           / nsegs(ring,inot)
-
-!
-!--             Calculate the thrust force (x-component of the total force) for each ring segment:
-                thrust_seg(rseg) = pre_factor * ( turb_cl(rseg) * COS (phi_rel(rseg) ) +           &
-                                   turb_cd(rseg) * SIN( phi_rel(rseg) ) )
-
-!
-!--             Determination of the second of the additional forces acting on the flow in the
-!--             azimuthal direction: force vector as basis for torque (torque itself would be the
-!--             vector product of the radius vector and the force vector):
-                torque_seg = pre_factor * ( turb_cl(rseg) * SIN (phi_rel(rseg) ) -                 &
-                             turb_cd(rseg) * COS( phi_rel(rseg) ) )
-!
-!--             Decomposition of the force vector into two parts: One acting along the
-!--             y-direction and one acting along the z-direction of the rotor coordinate system:
-                torque_seg_y(rseg) = -torque_seg * sin_rot
-                torque_seg_z(rseg) =  torque_seg * cos_rot
-
-!
-!--             Add the segment thrust to the thrust of the whole rotor:
-                !$OMP CRITICAL
-                thrust_rotor(inot) = thrust_rotor(inot) + thrust_seg(rseg)
-
-
-                torque_total(inot) = torque_total(inot) + (torque_seg * cur_r)
-                !$OMP END CRITICAL
-
-             ENDDO   !-- end of loop over ring segments
-
-!
-!--          Restore the forces into arrays containing all the segments of each ring:
-             thrust_ring(ring,:)   = thrust_seg(:)
-             torque_ring_y(ring,:) = torque_seg_y(:)
-             torque_ring_z(ring,:) = torque_seg_z(:)
-
-
-          ENDDO   !-- end of loop over rings
-          !$OMP END PARALLEL
-
-
-          CALL cpu_log( log_point_s(62), 'wtm_controller', 'start' )
-
-
-          IF ( speed_control )  THEN
-!
-!--          Calculation of the current generator speed for rotor speed control:
-
-!
-!--          The acceleration of the rotor speed is calculated from the force balance of the
-!--          accelerating torque and the torque of the rotating rotor and generator:
-             om_rate = ( torque_total(inot) * air_density * gear_efficiency -                      &
-                         gear_ratio * torque_gen_old(inot) ) / ( rotor_inertia +                   &
-                         gear_ratio * gear_ratio * generator_inertia ) * dt_3d
-
-!
-!--          The generator speed is given by the product of gear gear_ratio and rotor speed:
-             generator_speed(inot) = gear_ratio * ( rotor_speed(inot) + om_rate )
-
-          ENDIF
-
-          IF ( pitch_control )  THEN
-
-!
-!--          If the current generator speed is above rated, the pitch is not saturated and the
-!--          change from the last time step is within the maximum pitch rate, then the pitch loop
-!--          is repeated with a pitch gain:
-             IF ( ( generator_speed(inot)  > generator_speed_rated )  .AND.                        &
-                  ( pitch_angle(inot) < 25.0_wp )  .AND.                                           &
-                  ( pitch_angle(inot) < pitch_angle_old(inot) + pitch_rate * dt_3d ) )  THEN
-                pitch_sw = .TRUE.
-!
-!--             Go back to beginning of pit_loop:
-                CYCLE pit_loop
-             ENDIF
-
-!
-!--          The current pitch is saved for the next time step:
-             pitch_angle_old(inot) = pitch_angle(inot)
-             pitch_sw = .FALSE.
-          ENDIF
-          EXIT pit_loop
-       ENDDO pit_loop ! Recursive pitch control loop
-
-
-!
-!--       Call the rotor speed controller:
-          IF ( speed_control )  THEN
-!
-!--          Find processor at i_hub, j_hub:
-             IF ( ( nxl <= i_hub(inot) )  .AND.  ( nxr >= i_hub(inot) ) )  THEN
-                IF ( ( nys <= j_hub(inot) )  .AND.  ( nyn >= j_hub(inot) ) )  THEN
-                   CALL wtm_speed_control( inot )
-                ENDIF
-             ENDIF
-
-          ENDIF
-
-
-          CALL cpu_log( log_point_s(62), 'wtm_controller', 'stop' )
-
-          CALL cpu_log( log_point_s(63), 'wtm_smearing', 'start' )
-
-
-!--       !----------------------------------------------------------------------------------------!
-!--       !--                  Regularization kernel                                             --!
-!--       !-- Smearing of the forces and interpolation to cartesian grid                         --!
-!--       !----------------------------------------------------------------------------------------!
-!
-!--       The aerodynamic blade forces need to be distributed smoothly on several mesh points in
-!--       order to avoid singular behaviour.
-!
-!--       Summation over sum of weighted forces. The weighting factor (calculated in user_init)
-!--       includes information on the distance between the center of the grid cell and the rotor
-!--       segment under consideration.
-!
-!--       To save computing time, apply smearing only for the relevant part of the model domain:
-!
-!--
-!--       Calculation of the boundaries:
-          i_smear(inot) = CEILING( ( rotor_radius(inot) * ABS( roty(inot,1) ) + eps_min ) / dx )
-          j_smear(inot) = CEILING( ( rotor_radius(inot) * ABS( roty(inot,2) ) + eps_min ) / dy )
-
-          !$OMP PARALLEL PRIVATE (i, j, k, ring, rseg, flag, dist_u_3d, dist_v_3d, dist_w_3d)
-          !$OMP DO
-          DO  i = MAX( nxl, i_hub(inot) - i_smear(inot) ), MIN( nxr, i_hub(inot) + i_smear(inot) )
-             DO  j = MAX( nys, j_hub(inot) - j_smear(inot) ), MIN( nyn, j_hub(inot) + j_smear(inot) )
-!                 DO  k = MAX( nzb_u_inner(j,i)+1, k_hub(inot) - k_smear(inot) ),                   &
-!                              k_hub(inot) + k_smear(inot)
-                DO  k = nzb + 1, k_hub(inot) + k_smear(inot)
-                   DO  ring = 1, nrings(inot)
-                      DO  rseg = 1, nsegs(ring,inot)
-!
-!--                      Predetermine flag to mask topography:
-                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-
-!
-!--                      Determine the square of the distance between the current grid point and
-!--                      each rotor area segment:
-                         dist_u_3d = ( i * dx               - rbx(ring,rseg) )**2 +                &
-                                     ( j * dy + 0.5_wp * dy - rby(ring,rseg) )**2 +                &
-                                     ( k * dz(1) - 0.5_wp * dz(1) - rbz(ring,rseg) )**2
-
-                         dist_v_3d = ( i * dx + 0.5_wp * dx - rbx(ring,rseg) )**2 +                &
-                                     ( j * dy               - rby(ring,rseg) )**2 +                &
-                                     ( k * dz(1) - 0.5_wp * dz(1) - rbz(ring,rseg) )**2
-
-                         dist_w_3d = ( i * dx + 0.5_wp * dx - rbx(ring,rseg) )**2 +                &
-                                     ( j * dy + 0.5_wp * dy - rby(ring,rseg) )**2 +                &
-                                     ( k * dz(1)               - rbz(ring,rseg) )**2
-
-!
-!--                      3D-smearing of the forces with a polynomial function (much faster than
-!--                      the old Gaussian function), using some parameters that have been
-!--                      calculated in user_init. The function is only similar to Gaussian
-!--                      function for squared distances <= eps_min2:
-                         IF ( dist_u_3d <= eps_min2 )  THEN
-                            thrust(k,j,i) = thrust(k,j,i) + thrust_ring(ring,rseg) *               &
-                                            ( ( pol_a * dist_u_3d - pol_b ) *                      &
-                                             dist_u_3d + 1.0_wp ) * eps_factor * flag
-                         ENDIF
-
-                         IF ( dist_v_3d <= eps_min2 )  THEN
-                            torque_y(k,j,i) = torque_y(k,j,i) + torque_ring_y(ring,rseg) *         &
-                                              ( ( pol_a * dist_v_3d - pol_b ) *                    &
-                                               dist_v_3d + 1.0_wp ) * eps_factor * flag
-                         ENDIF
-
-                         IF ( dist_w_3d <= eps_min2 )  THEN
-                            torque_z(k,j,i) = torque_z(k,j,i) + torque_ring_z(ring,rseg) *         &
-                                              ( ( pol_a * dist_w_3d - pol_b ) *                    &
-                                               dist_w_3d + 1.0_wp ) * eps_factor * flag
-                         ENDIF
-
-                      ENDDO  ! End of loop over rseg
-                   ENDDO     ! End of loop over ring
-
-!
-!--                Rotation of force components:
-                   rot_tend_x(k,j,i) = rot_tend_x(k,j,i) + ( thrust(k,j,i) * rotx(inot,1) +        &
-                                       torque_y(k,j,i) * roty(inot,1) + torque_z(k,j,i) *          &
-                                       rotz(inot,1) ) * flag
-
-                   rot_tend_y(k,j,i) = rot_tend_y(k,j,i) + ( thrust(k,j,i) * rotx(inot,2) +        &
-                                       torque_y(k,j,i) * roty(inot,2) + torque_z(k,j,i) *          &
-                                       rotz(inot,2) ) * flag
-
-                   rot_tend_z(k,j,i) = rot_tend_z(k,j,i) + ( thrust(k,j,i) * rotx(inot,3) +        &
-                                       torque_y(k,j,i) * roty(inot,3) +  torque_z(k,j,i) *         &
-                                       rotz(inot,3) ) * flag
-
-                ENDDO  ! End of loop over k
-             ENDDO     ! End of loop over j
-          ENDDO        ! End of loop over i
-          !$OMP END PARALLEL
-
-          CALL cpu_log( log_point_s(63), 'wtm_smearing', 'stop' )
-
-       ENDDO                  !-- end of loop over turbines
-
-
-       IF ( yaw_control )  THEN
-!
-!--       Allocate arrays for yaw control at first call. Can't be allocated before dt_3d is set.
-          IF ( start_up )  THEN
-             wdlon= MAX( 1 , NINT( 30.0_wp / dt_3d ) )  ! 30s running mean array
-             ALLOCATE( wd30(1:n_turbines,1:WDLON) )
-             wd30 = 999.0_wp                             ! Set to dummy value
-             ALLOCATE( wd30_l(1:WDLON) )
-
-             wdsho = MAX( 1 , NINT( 2.0_wp / dt_3d ) )   ! 2s running mean array
-             ALLOCATE( wd2(1:n_turbines,1:wdsho) )
-             wd2 = 999.0_wp                              ! Set to dummy value
-             ALLOCATE( wd2_l(1:wdsho) )
-             start_up = .FALSE.
-          ENDIF
-
-!
-!--       Calculate the inflow wind speed:
-!--
-!--       Loop over number of turbines:
-          DO  inot = 1, n_turbines
-!
-!--          Find processor at i_hub, j_hub:
-             IF ( ( nxl <= i_hub(inot) )  .AND.  ( nxr >= i_hub(inot) ) )  THEN
-                IF ( ( nys <= j_hub(inot) )  .AND.  ( nyn >= j_hub(inot) ) )  THEN
-                   u_inflow_l(inot) = u(k_hub(inot),j_hub(inot),i_hub(inot))
-                   wdir_l(inot)     = -1.0_wp * ATAN2( 0.5_wp *                                    &
-                                    ( v(k_hub(inot), j_hub(inot), i_hub(inot) + 1) +               &
-                                      v(k_hub(inot), j_hub(inot), i_hub(inot)) ) , 0.5_wp *        &
-                                    ( u(k_hub(inot), j_hub(inot) + 1, i_hub(inot)) +               &
-                                      u(k_hub(inot), j_hub(inot), i_hub(inot)) ) )
-
-                   CALL wtm_yawcontrol( inot )
-
-                   yaw_angle_l(inot) = yaw_angle(inot)
-
-                ENDIF
-             ENDIF
-
-          ENDDO  ! end of loop over turbines
-
-!
-!--       Transfer of information to the other cpus:
-#if defined( __parallel )
-          CALL MPI_ALLREDUCE( u_inflow_l, u_inflow, n_turbines, MPI_REAL,                          &
-                              MPI_SUM, comm2d, ierr )
-          CALL MPI_ALLREDUCE( wdir_l, wdir, n_turbines, MPI_REAL, MPI_SUM,                         &
-                              comm2d, ierr )
-          CALL MPI_ALLREDUCE( yaw_angle_l, yaw_angle, n_turbines, MPI_REAL,                        &
-                              MPI_SUM, comm2d, ierr )
-#else
-          u_inflow   = u_inflow_l
-          wdir       = wdir_l
-          yaw_angle  = yaw_angle_l
-
-#endif
-          DO  inot = 1, n_turbines
-!
-!--          Update rotor orientation:
-             CALL wtm_rotate_rotor( inot )
-
-          ENDDO ! End of loop over turbines
-
-       ENDIF  ! end of yaw control
-
-       IF ( speed_control )  THEN
-!
-!--       Transfer of information to the other cpus:
-!           CALL MPI_ALLREDUCE( generator_speed, generator_speed_old, n_turbines,                   &
-!                               MPI_REAL,MPI_SUM, comm2d, ierr )
-#if defined( __parallel )
-          CALL MPI_ALLREDUCE( torque_gen, torque_gen_old, n_turbines,                              &
-                              MPI_REAL, MPI_SUM, comm2d, ierr )
-          CALL MPI_ALLREDUCE( rotor_speed_l, rotor_speed, n_turbines,                              &
-                              MPI_REAL, MPI_SUM, comm2d, ierr )
-          CALL MPI_ALLREDUCE( generator_speed_f, generator_speed_f_old, n_turbines,                &
-                              MPI_REAL, MPI_SUM, comm2d, ierr )
-#else
-          torque_gen_old        = torque_gen
-          rotor_speed           = rotor_speed_l
-          generator_speed_f_old = generator_speed_f
-#endif
-
-       ENDIF
-
-    ENDIF
-
-    CALL cpu_log( log_point_s(61), 'wtm_forces', 'stop' )
-
-
- END SUBROUTINE wtm_forces
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Yaw controller for the wind turbine model
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_yawcontrol( inot )
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)             :: inot
-    INTEGER(iwp)             :: i_wd_30
-
-    REAL(wp)                 :: missal
-
-    i_wd_30 = 0_iwp
-
-!
-!-- The yaw controller computes a 30s running mean of the wind direction. If the difference
-!-- between turbine alignment and wind direction exceeds 5 degrees, the turbine is yawed. The
-!-- mechanism stops as soon as the 2s-running mean of the missalignment is smaller than 0.5
-!-- degrees. Attention: If the timestep during the simulation changes significantly the lengths
-!-- of the running means change and it does not correspond to 30s/2s anymore.
-!-- ! Needs to be modified for these situations !
-!-- For wind from the east, the averaging of the wind direction could cause problems and the yaw
-!-- controller is probably flawed. -> Routine for averaging needs to be improved!
-!
-!-- Check if turbine is not yawing:
-    IF ( .NOT. doyaw(inot) )  THEN
-!
-!--    Write current wind direction into array:
-       wd30_l    = wd30(inot,:)
-       wd30_l    = CSHIFT( wd30_l, SHIFT = -1 )
-       wd30_l(1) = wdir(inot)
-!
-!--    Check if array is full ( no more dummies ):
-       IF ( .NOT. ANY( wd30_l == 999.) )  THEN
-
-          missal = SUM( wd30_l ) / SIZE( wd30_l ) - yaw_angle(inot)
-!
-!--       Check if turbine is missaligned by more than yaw_misalignment_max:
-          IF ( ABS( missal ) > yaw_misalignment_max )  THEN
-!
-!--          Check in which direction to yaw:
-             yawdir(inot) = SIGN( 1.0_wp, missal )
-!
-!--          Start yawing of turbine:
-             yaw_angle(inot) = yaw_angle(inot) + yawdir(inot) * yaw_speed * dt_3d
-             doyaw(inot)     = .TRUE.
-             wd30_l          = 999.  ! fill with dummies again
-          ENDIF
-       ENDIF
-
-       wd30(inot,:) = wd30_l
-
-!
-!-- If turbine is already yawing:
-!-- Initialize 2 s running mean and yaw until the missalignment is smaller than
-!-- yaw_misalignment_min
-
-    ELSE
-!
-!--    Initialize 2 s running mean:
-
-       wd2_l = wd2(inot,:)
-       wd2_l = CSHIFT( wd2_l, SHIFT = -1 )
-       wd2_l(1) = wdir(inot)
-!
-!--    Check if array is full ( no more dummies ):
-       IF ( .NOT. ANY( wd2_l == 999.0_wp ) ) THEN
-!
-!--       Calculate missalignment of turbine:
-          missal = SUM( wd2_l - yaw_angle(inot) ) / SIZE( wd2_l )
-!
-!--       Check if missalignment is still larger than 0.5 degree and if the yaw direction is
-!--       still right:
-          IF ( ( ABS( missal ) > yaw_misalignment_min )  .AND.                                     &
-               ( yawdir(inot) == SIGN( 1.0_wp, missal ) ) )  THEN
-!
-!--          Continue yawing:
-             yaw_angle(inot) = yaw_angle(inot) + yawdir(inot) * yaw_speed * dt_3d
-
-          ELSE
-!
-!--          Stop yawing:
-             doyaw(inot) = .FALSE.
-             wd2_l       = 999.0_wp  ! fill with dummies again
-          ENDIF
-       ELSE
-!
-!--       Continue yawing:
-          yaw_angle(inot) = yaw_angle(inot) + yawdir(inot) * yaw_speed * dt_3d
-       ENDIF
-
-       wd2(inot,:) = wd2_l
-
-    ENDIF
-
- END SUBROUTINE wtm_yawcontrol
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the speed control
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_init_speed_control
-
-
-    IMPLICIT NONE
-
-!
-!-- If speed control is set, remaining variables and control_parameters for the control algorithm
-!-- are calculated:
-!
-!-- Calculate slope constant for region 15:
-    slope15         = ( region_2_slope * region_2_min * region_2_min ) /                           &
-                      ( region_2_min - region_15_min )
-!
-!-- Calculate upper limit of slipage region:
-    vs_sysp         = generator_speed_rated / 1.1_wp
-!
-!-- Calculate slope of slipage region:
-    region_25_slope = ( generator_power_rated / generator_speed_rated ) /                          &
-                    ( generator_speed_rated - vs_sysp )
-!
-!-- Calculate lower limit of slipage region:
-    region_25_min   = ( region_25_slope - SQRT( region_25_slope *                                  &
-                      ( region_25_slope - 4.0_wp * region_2_slope * vs_sysp ) ) ) /                &
-                      ( 2.0_wp * region_2_slope )
-!
-!-- Frequency for the simple low pass filter:
-    fcorner      = 0.25_wp
-!
-!-- At the first timestep the torque is set to its maximum to prevent an overspeeding of the rotor:
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
-       torque_gen_old(:) = generator_torque_max
-    ENDIF
-
- END SUBROUTINE wtm_init_speed_control
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Simple controller for the regulation of the rotor speed
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_speed_control( inot )
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)::  inot
-
-
-!
-!-- The controller is based on the fortran script from Jonkman et al. 2009 "Definition of a 5 MW
-!-- Reference Wind Turbine for offshore system developement"
-
-!
-!-- The generator speed is filtered by a low pass filter  for the control of the generator torque:
-    lp_coeff = EXP( -2.0_wp * 3.14_wp * dt_3d * fcorner)
-    generator_speed_f(inot) = ( 1.0_wp - lp_coeff ) * generator_speed(inot) + lp_coeff *           &
-                               generator_speed_f_old(inot)
-
-    IF ( generator_speed_f(inot) <= region_15_min )  THEN
-!
-!--    Region 1: Generator torque is set to zero to accelerate the rotor:
-       torque_gen(inot) = 0
-
-    ELSEIF ( generator_speed_f(inot) <= region_2_min )  THEN
-!
-!--    Region 1.5: Generator torque is increasing linearly with rotor speed:
-       torque_gen(inot) = slope15 * ( generator_speed_f(inot) - region_15_min )
-
-    ELSEIF ( generator_speed_f(inot) <= region_25_min )  THEN
-!
-!--    Region 2: Generator torque is increased by the square of the generator speed to keep the
-!--              TSR optimal:
-       torque_gen(inot) = region_2_slope * generator_speed_f(inot) * generator_speed_f(inot)
-
-    ELSEIF ( generator_speed_f(inot) < generator_speed_rated )  THEN
-!
-!--    Region 2.5: Slipage region between 2 and 3:
-       torque_gen(inot) = region_25_slope * ( generator_speed_f(inot) - vs_sysp )
-
-    ELSE
-!
-!--    Region 3: Generator torque is antiproportional to the rotor speed to keep the power
-!--              constant:
-       torque_gen(inot) = generator_power_rated / generator_speed_f(inot)
-
-    ENDIF
-!
-!-- Calculate torque rate and confine with a max:
-    trq_rate = ( torque_gen(inot) - torque_gen_old(inot) ) / dt_3d
-    trq_rate = MIN( MAX( trq_rate, -1.0_wp * generator_torque_rate_max ), generator_torque_rate_max )
-!
-!-- Calculate new gen torque and confine with max torque:
-    torque_gen(inot) = torque_gen_old(inot) + trq_rate * dt_3d
-    torque_gen(inot) = MIN( torque_gen(inot), generator_torque_max )
-!
-!-- Overwrite values for next timestep:
-    rotor_speed_l(inot) = generator_speed(inot) / gear_ratio
-
-
- END SUBROUTINE wtm_speed_control
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Application of the additional forces generated by the wind turbine on the flow components
-!> (tendency terms)
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_actions( location )
-
-
-    CHARACTER(LEN=*) ::  location  !<
-
-    INTEGER(iwp) ::  i  !< running index
-    INTEGER(iwp) ::  j  !< running index
-    INTEGER(iwp) ::  k  !< running index
-
-
-    SELECT CASE ( location )
-
-    CASE ( 'before_timestep' )
-
-       CALL wtm_forces
-
-    CASE ( 'u-tendency' )
-!
-
-!--    Apply the x-component of the force to the u-component of the flow:
-       IF ( time_since_reference_point >= time_turbine_on )  THEN
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                DO  k = nzb + 1, MAXVAL( k_hub ) + MAXVAL( k_smear )
-!
-!--                Calculate the thrust generated by the nacelle and the tower:
-                   tend_nac_x  = 0.5_wp * nac_cd_surf(k,j,i) * SIGN( u(k,j,i)**2 , u(k,j,i) )
-                   tend_tow_x  = 0.5_wp * tow_cd_surf(k,j,i) * SIGN( u(k,j,i)**2 , u(k,j,i) )
-                   tend(k,j,i) = tend(k,j,i) + ( - rot_tend_x(k,j,i) - tend_nac_x - tend_tow_x ) * &
-                                 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-
-    CASE ( 'v-tendency' )
-!
-!--    Apply the y-component of the force to the v-component of the flow:
-       IF ( time_since_reference_point >= time_turbine_on )  THEN
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                DO  k = nzb+1, MAXVAL(k_hub) + MAXVAL(k_smear)
-                   tend_nac_y  = 0.5_wp * nac_cd_surf(k,j,i) * SIGN( v(k,j,i)**2 , v(k,j,i) )
-                   tend_tow_y  = 0.5_wp * tow_cd_surf(k,j,i) * SIGN( v(k,j,i)**2 , v(k,j,i) )
-                   tend(k,j,i) = tend(k,j,i) + ( - rot_tend_y(k,j,i) - tend_nac_y - tend_tow_y ) * &
-                                 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-
-    CASE ( 'w-tendency' )
-!
-!--    Apply the z-component of the force to the w-component of the flow:
-       IF ( time_since_reference_point >= time_turbine_on )  THEN
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                DO  k = nzb+1,  MAXVAL(k_hub) + MAXVAL(k_smear)
-                   tend(k,j,i) = tend(k,j,i) - rot_tend_z(k,j,i) *                                 &
-                                 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-
-
-    CASE DEFAULT
-       CONTINUE
-
-    END SELECT
-
-
- END SUBROUTINE wtm_actions
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Application of the additional forces generated by the wind turbine on the flow components
-!> (tendency terms)
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
- SUBROUTINE wtm_actions_ij( i, j, location )
-
-
-    CHARACTER (LEN=*) ::  location  !<
-
-    INTEGER(iwp) ::  i  !< running index
-    INTEGER(iwp) ::  j  !< running index
-    INTEGER(iwp) ::  k  !< running index
-
-    SELECT CASE ( location )
-
-    CASE ( 'before_timestep' )
-
-       CALL wtm_forces
-
-    CASE ( 'u-tendency' )
-!
-!--    Apply the x-component of the force to the u-component of the flow:
-       IF ( time_since_reference_point >= time_turbine_on )  THEN
-          DO  k = nzb+1,  MAXVAL(k_hub) + MAXVAL(k_smear)
-!
-!--          Calculate the thrust generated by the nacelle and the tower:
-             tend_nac_x  = 0.5_wp * nac_cd_surf(k,j,i) * SIGN( u(k,j,i)**2 , u(k,j,i) )
-             tend_tow_x  = 0.5_wp * tow_cd_surf(k,j,i) * SIGN( u(k,j,i)**2 , u(k,j,i) )
-             tend(k,j,i) = tend(k,j,i) + ( - rot_tend_x(k,j,i) - tend_nac_x - tend_tow_x ) *       &
-                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-          ENDDO
-       ENDIF
-
-    CASE ( 'v-tendency' )
-!
-!--    Apply the y-component of the force to the v-component of the flow:
-       IF ( time_since_reference_point >= time_turbine_on )  THEN
-          DO  k = nzb+1,  MAXVAL(k_hub) + MAXVAL(k_smear)
-             tend_nac_y  = 0.5_wp * nac_cd_surf(k,j,i) * SIGN( v(k,j,i)**2 , v(k,j,i) )
-             tend_tow_y  = 0.5_wp * tow_cd_surf(k,j,i) * SIGN( v(k,j,i)**2 , v(k,j,i) )
-             tend(k,j,i) = tend(k,j,i) + ( - rot_tend_y(k,j,i) - tend_nac_y - tend_tow_y )  *      &
-                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-             ENDDO
-       ENDIF
-
-    CASE ( 'w-tendency' )
-!
-!--    Apply the z-component of the force to the w-component of the flow:
-       IF ( time_since_reference_point >= time_turbine_on )  THEN
-          DO  k = nzb+1,  MAXVAL(k_hub) + MAXVAL(k_smear)
-             tend(k,j,i) = tend(k,j,i) - rot_tend_z(k,j,i) *                                       &
-                           MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-          ENDDO
-       ENDIF
-
-
-    CASE DEFAULT
-       CONTINUE
-
-    END SELECT
-
-
- END SUBROUTINE wtm_actions_ij
-
-
- SUBROUTINE wtm_data_output
-
-
-    INTEGER(iwp) ::  return_value  !< returned status value of called function
-    INTEGER(iwp) ::  t_ind = 0     !< time index
-
-    IF ( myid == 0 )  THEN
-
-!
-!--    At the first call of this routine write the spatial coordinates:
-       IF ( .NOT. initial_write_coordinates )  THEN
-          ALLOCATE ( output_values_1d_target(1:n_turbines) )
-          output_values_1d_target = hub_x(1:n_turbines)
-          output_values_1d_pointer => output_values_1d_target
-          return_value = dom_write_var( nc_filename,                                               &
-                                     'x',                                                          &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1/),                                     &
-                                     bounds_end       = (/n_turbines/) )
-
-          output_values_1d_target = hub_y(1:n_turbines)
-          output_values_1d_pointer => output_values_1d_target
-          return_value = dom_write_var( nc_filename,                                               &
-                                     'y',                                                          &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1/),                                     &
-                                     bounds_end       = (/n_turbines/) )
-
-          output_values_1d_target = hub_z(1:n_turbines)
-          output_values_1d_pointer => output_values_1d_target
-          return_value = dom_write_var( nc_filename,                                               &
-                                     'z',                                                          &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1/),                                     &
-                                     bounds_end       = (/n_turbines/) )
-
-          output_values_1d_target = rotor_radius(1:n_turbines) * 2.0_wp
-          output_values_1d_pointer => output_values_1d_target
-          return_value = dom_write_var( nc_filename,                                               &
-                                     'rotor_diameter',                                             &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1/),                                     &
-                                     bounds_end       = (/n_turbines/) )
-
-          output_values_1d_target = tower_diameter(1:n_turbines)
-          output_values_1d_pointer => output_values_1d_target
-          return_value = dom_write_var( nc_filename,                                               &
-                                     'tower_diameter',                                             &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1/),                                     &
-                                     bounds_end       = (/n_turbines/) )
-
-          initial_write_coordinates = .TRUE.
-          DEALLOCATE ( output_values_1d_target )
-       ENDIF
-
-       t_ind = t_ind + 1
-
-       ALLOCATE ( output_values_1d_target(1:n_turbines) )
-       output_values_1d_target = rotor_speed(:)
-       output_values_1d_pointer => output_values_1d_target
-
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'rotor_speed',                                                &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1, t_ind/),                              &
-                                     bounds_end       = (/n_turbines, t_ind /) )
-
-       output_values_1d_target = generator_speed(:)
-       output_values_1d_pointer => output_values_1d_target
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'generator_speed',                                            &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1, t_ind/),                              &
-                                     bounds_end       = (/n_turbines, t_ind /) )
-
-       output_values_1d_target = torque_gen_old(:)
-       output_values_1d_pointer => output_values_1d_target
-
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'generator_torque',                                           &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1, t_ind/),                              &
-                                     bounds_end       = (/n_turbines, t_ind /) )
-
-       output_values_1d_target = torque_total(:)
-       output_values_1d_pointer => output_values_1d_target
-
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'rotor_torque',                                               &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1, t_ind/),                              &
-                                     bounds_end       = (/n_turbines, t_ind /) )
-
-       output_values_1d_target = pitch_angle(:)
-       output_values_1d_pointer => output_values_1d_target
-
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'pitch_angle',                                                &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1, t_ind/),                              &
-                                     bounds_end       = (/n_turbines, t_ind /) )
-
-       output_values_1d_target = torque_gen_old(:) * generator_speed(:) * generator_efficiency
-       output_values_1d_pointer => output_values_1d_target
-
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'generator_power',                                            &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1, t_ind/),                              &
-                                     bounds_end       = (/n_turbines, t_ind /) )
-
-       DO  inot = 1, n_turbines
-          output_values_1d_target(inot) = torque_total(inot) * rotor_speed(inot) * air_density
-       ENDDO
-       output_values_1d_pointer => output_values_1d_target
-
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'rotor_power',                                                &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1, t_ind/),                              &
-                                     bounds_end       = (/n_turbines, t_ind /) )
-
-       output_values_1d_target = thrust_rotor(:)
-       output_values_1d_pointer => output_values_1d_target
-
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'rotor_thrust',                                               &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1, t_ind/),                              &
-                                     bounds_end       = (/n_turbines, t_ind /) )
-
-       output_values_1d_target = wdir(:)*180.0_wp/pi
-       output_values_1d_pointer => output_values_1d_target
-
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'wind_direction',                                             &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1, t_ind/),                              &
-                                     bounds_end       = (/n_turbines, t_ind /) )
-
-       output_values_1d_target = (yaw_angle(:)) * 180.0_wp / pi
-       output_values_1d_pointer => output_values_1d_target
-
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'yaw_angle',                                                  &
-                                     values_realwp_1d = output_values_1d_pointer,                  &
-                                     bounds_start     = (/1, t_ind/),                              &
-                                     bounds_end       = (/n_turbines, t_ind /) )
-
-       output_values_0d_target = time_since_reference_point
-       output_values_0d_pointer => output_values_0d_target
-
-       return_value = dom_write_var( nc_filename,                                                  &
-                                     'time',                                                       &
-                                     values_realwp_0d = output_values_0d_pointer,                  &
-                                     bounds_start     = (/t_ind/),                                 &
-                                     bounds_end       = (/t_ind/) )
-
-       DEALLOCATE ( output_values_1d_target )
-
-    ENDIF
-
- END SUBROUTINE wtm_data_output
-
- END MODULE wind_turbine_model_mod
Index: palm/trunk/SOURCE/wrd_write_string.f90
===================================================================
--- palm/trunk/SOURCE/wrd_write_string.f90	(revision 4901)
+++ 	(revision )
@@ -1,58 +1,0 @@
-!> @file wrd_write_string.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Calculates length of string and write the respective value together with the string into binary
-!  file(s) for restart runs
-!--------------------------------------------------------------------------------------------------!
-
- SUBROUTINE wrd_write_string( string )
-
-
-    USE kinds
-
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*), INTENT(IN) ::  string  !< for storing strings in case of writing/reading
-                                             !< restart data
-    INTEGER(iwp) ::  length  !< integer that specifies the length of a string in case of
-                             !< writing/reading restart data
-
-
-    length = LEN_TRIM( string )
-
-    WRITE ( 14 )  length
-    WRITE ( 14 )  string(1:length)
-
-
- END SUBROUTINE wrd_write_string
Index: palm/trunk/SOURCE/write_3d_binary.f90
===================================================================
--- palm/trunk/SOURCE/write_3d_binary.f90	(revision 1)
+++ palm/trunk/SOURCE/write_3d_binary.f90	(revision 1)
@@ -0,0 +1,286 @@
+ SUBROUTINE write_3d_binary
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: write_3d_binary.f90,v $
+! Revision 1.21  2006/08/04 15:05:11  raasch
+! +iran, iran_part
+!
+! Revision 1.20  2006/02/23 13:14:34  raasch
+! +volume_flow_area, volume_flow_initial, -hom_sum_pr,
+! output of arrays used for time-averaging
+!
+! Revision 1.19  2005/05/18 15:55:45  raasch
+! pl1d_callcount renamed dopr_time_count
+!
+! Revision 1.18  2004/04/30 13:13:40  raasch
+! Arrays of timelevel t-dt (_m) are written only in case of the leapfrog scheme
+!
+! Revision 1.17  2003/10/29 09:14:11  raasch
+! Output of random seed (random_iv, random_iy), module random_function_mod
+! is used, new binary version 2.2
+!
+! Revision 1.16  2002/12/19 16:23:08  raasch
+! Writing of array hom moved to write_var_list
+!
+! Revision 1.15  2001/03/30 07:59:18  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.),
+! closing of unit 14 moved to the main program in order to allow user-defined
+! writing to this unit
+!
+! Revision 1.14  2001/03/11 11:27:18  letzel
+! All comments translated into English.
+!
+! Revision 1.13  2001/01/29 12:36:56  raasch
+! Passive scalar is considered
+!
+! Revision 1.12  2001/01/22 08:26:59  raasch
+! Module test_variables removed
+!
+! Revision 1.11  2001/01/05 15:16:39  raasch
+! +spectrum_x, spectrum_y, new binary version 2.1
+!
+! Revision 1.10  2001/01/02 17:34:45  raasch
+! Unit 14 closed at the end of the subroutine
+!
+! Revision 1.9  2000/04/13 14:12:37  schroeter
+! Output of water and humidity variables
+!
+! Revision 1.8  99/03/03  09:27:43  09:27:43  raasch (Siegfried Raasch)
+! Speziellen I/O-Messpunkt entfernt
+! 
+! Revision 1.7  1999/02/05 09:19:39  raasch
+! program_version in binary_version umbenannt
+!
+! Revision 1.6  1998/12/15 07:34:40  raasch
+! Zusaetzliche Ermittelung der tatsaechlichen Ausgabezeiten auf T3E
+! mit messpunkt_e(15) unter Verwendung von TIMEF (s. cpu_zeitmessung)
+!
+! Revision 1.5  1998/07/06 12:36:26  raasch
+! + USE test_variables
+!
+! Revision 1.4  1998/04/15 11:24:30  raasch
+! Steuerparameter-Ausgaben gehen jetzt auch auf Einheit 14 und werden von
+! jedem PE ausgegeben
+!
+! Revision 1.3  1998/04/06 14:34:21  raasch
+! Ausgabe von weiteren Plotvariablen
+!
+! Revision 1.2  1998/03/30 11:39:00  raasch
+! Statistik- und Plotvariablen werden zusaetzlich ausgegeben
+!
+! Revision 1.1  1998/03/18 20:20:21  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Binary output of variables and arrays for restarts.
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE averaging
+    USE control_parameters
+    USE cpulog
+    USE indices
+    USE interfaces
+    USE particle_attributes
+    USE pegrid
+    USE profil_parameter
+    USE random_function_mod
+    USE statistics
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=10) ::  binary_version
+
+
+    CALL cpu_log( log_point(22), 'write_3d_binary', 'start' )
+
+    CALL check_open( 14 )
+    
+!
+!-- Write control parameters and other variables for restart.
+    CALL write_var_list
+
+!
+!-- Write arrays.
+    binary_version = '3.0'
+
+    WRITE ( 14 )  binary_version
+
+    WRITE ( 14 )  numprocs, myid, nxl, nxr, nys, nyn, nzb, nzt
+
+!
+!-- Attention: After changes to the following output commands the version number
+!-- ---------  of the variable binary_version must be changed!
+!--            Also, the list of arrays to be read in read_3d_binary must be
+!--            adjusted accordingly.
+
+    WRITE ( 14 )  'e                   ';  WRITE ( 14 )  e
+    IF ( ALLOCATED( e_av ) )  THEN
+       WRITE ( 14 )  'e_av                ';  WRITE ( 14 )  e_av
+    ENDIF
+    WRITE ( 14 )  'e_m                 ';  WRITE ( 14 )  e_m
+    WRITE ( 14 )  'iran                ';  WRITE ( 14 )  iran, iran_part
+    WRITE ( 14 )  'kh                  ';  WRITE ( 14 )  kh
+    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+       WRITE ( 14 )  'kh_m                ';  WRITE ( 14 )  kh_m
+    ENDIF
+    WRITE ( 14 )  'km                  ';  WRITE ( 14 )  km
+    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+       WRITE ( 14 )  'km_m                ';  WRITE ( 14 )  km_m
+    ENDIF
+    IF ( ALLOCATED( lwp_av ) )  THEN
+       WRITE ( 14 )  'lwp_av              ';  WRITE ( 14 )  lwp_av
+    ENDIF
+    WRITE ( 14 )  'p                   ';  WRITE ( 14 )  p
+    IF ( ALLOCATED( p_av ) )  THEN
+       WRITE ( 14 )  'p_av                ';  WRITE ( 14 )  p_av
+    ENDIF
+    IF ( ALLOCATED( pc_av ) )  THEN
+       WRITE ( 14 )  'pc_av               ';  WRITE ( 14 )  pc_av
+    ENDIF
+    IF ( ALLOCATED( pr_av ) )  THEN
+       WRITE ( 14 )  'pr_av               ';  WRITE ( 14 )  pr_av
+    ENDIF
+    WRITE ( 14 )  'pt                  ';  WRITE ( 14 )  pt
+    IF ( ALLOCATED( pt_av ) )  THEN
+       WRITE ( 14 )  'pt_av               ';  WRITE ( 14 )  pt_av
+    ENDIF
+    WRITE ( 14 )  'pt_m                ';  WRITE ( 14 )  pt_m
+    IF ( moisture  .OR. passive_scalar )  THEN
+       WRITE ( 14 )  'q                   ';  WRITE ( 14 )  q 
+       IF ( ALLOCATED( q_av ) )  THEN
+          WRITE ( 14 )  'q_av                ';  WRITE ( 14 )  q_av
+       ENDIF
+       WRITE ( 14 )  'q_m                 ';  WRITE ( 14 ) q_m
+       IF ( cloud_physics ) THEN
+          WRITE ( 14 )  'ql                  ';  WRITE ( 14 ) ql
+          IF ( ALLOCATED( ql_av ) )  THEN
+             WRITE ( 14 )  'ql_av               ';  WRITE ( 14 )  ql_av
+          ENDIF
+       ENDIF
+       WRITE ( 14 )  'qs                  ';  WRITE ( 14 ) qs
+       WRITE ( 14 )  'qsws                ';  WRITE ( 14 ) qsws
+       IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+          WRITE ( 14 )  'qsws_m              ';  WRITE ( 14 ) qsws_m
+       ENDIF
+    ENDIF
+    IF ( ALLOCATED( ql_c_av ) )  THEN
+       WRITE ( 14 )  'ql_c_av             ';  WRITE ( 14 )  ql_c_av
+    ENDIF
+    IF ( ALLOCATED( ql_v_av ) )  THEN
+       WRITE ( 14 )  'ql_v_av             ';  WRITE ( 14 )  ql_v_av
+    ENDIF
+    IF ( ALLOCATED( ql_vp_av ) )  THEN
+       WRITE ( 14 )  'ql_vp_av            ';  WRITE ( 14 )  ql_vp_av
+    ENDIF
+    IF ( ALLOCATED( qv_av ) )  THEN
+       WRITE ( 14 )  'qv_av               ';  WRITE ( 14 )  qv_av
+    ENDIF
+    WRITE ( 14 )  'random_iv           ';  WRITE ( 14 )  random_iv
+                                           WRITE ( 14 )  random_iy
+    WRITE ( 14 )  'rif                 ';  WRITE ( 14 )  rif
+    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+       WRITE ( 14 )  'rif_m               ';  WRITE ( 14 )  rif_m
+    ENDIF
+    IF ( ALLOCATED( s_av ) )  THEN
+       WRITE ( 14 )  's_av                ';  WRITE ( 14 )  s_av
+    ENDIF
+    WRITE ( 14 )  'shf                 ';  WRITE ( 14 )  shf
+    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+       WRITE ( 14 )  'shf_m               ';  WRITE ( 14 )  shf_m
+    ENDIF
+    WRITE ( 14 )  'ts                  ';  WRITE ( 14 )  ts
+    IF ( ALLOCATED( ts_av ) )  THEN
+       WRITE ( 14 )  'ts_av               ';  WRITE ( 14 )  ts_av
+    ENDIF
+    WRITE ( 14 )  'u                   ';  WRITE ( 14 )  u
+    IF ( ALLOCATED( u_av ) )  THEN
+       WRITE ( 14 )  'u_av                ';  WRITE ( 14 )  u_av
+    ENDIF
+    WRITE ( 14 )  'u_m                 ';  WRITE ( 14 )  u_m
+    WRITE ( 14 )  'us                  ';  WRITE ( 14 )  us
+    WRITE ( 14 )  'usws                ';  WRITE ( 14 )  usws
+    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+       WRITE ( 14 )  'usws_m              ';  WRITE ( 14 )  usws_m
+    ENDIF
+    IF ( ALLOCATED( us_av ) )  THEN
+       WRITE ( 14 )  'us_av               ';  WRITE ( 14 )  us_av
+    ENDIF
+    WRITE ( 14 )  'v                   ';  WRITE ( 14 )  v
+    WRITE ( 14 )  'volume_flow_area    ';  WRITE ( 14 )  volume_flow_area
+    WRITE ( 14 )  'volume_flow_initial ';  WRITE ( 14 )  volume_flow_initial
+    IF ( ALLOCATED( v_av ) )  THEN
+       WRITE ( 14 )  'v_av                ';  WRITE ( 14 )  v_av
+    ENDIF
+    WRITE ( 14 )  'v_m                 ';  WRITE ( 14 )  v_m
+    IF ( moisture )  THEN
+       WRITE ( 14 )  'vpt                 ';  WRITE ( 14 )  vpt
+       IF ( ALLOCATED( vpt_av ) )  THEN
+          WRITE ( 14 )  'vpt_av              ';  WRITE ( 14 )  vpt_av
+       ENDIF
+       IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+          WRITE ( 14 )  'vpt_m               ';  WRITE ( 14 )  vpt_m
+       ENDIF
+    ENDIF
+    WRITE ( 14 )  'vsws                ';  WRITE ( 14 )  vsws
+    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+       WRITE ( 14 )  'vsws_m              ';  WRITE ( 14 )  vsws_m
+    ENDIF
+    WRITE ( 14 )  'w                   ';  WRITE ( 14 )  w
+    IF ( ALLOCATED( w_av ) )  THEN
+       WRITE ( 14 )  'w_av                ';  WRITE ( 14 )  w_av
+    ENDIF
+    WRITE ( 14 )  'w_m                 ';  WRITE ( 14 )  w_m
+    WRITE ( 14 )  'z0                  ';  WRITE ( 14 )  z0
+
+    WRITE ( 14 )  'cross_linecolors    ';  WRITE ( 14 )  cross_linecolors
+    WRITE ( 14 )  'cross_linestyles    ';  WRITE ( 14 )  cross_linestyles
+    WRITE ( 14 )  'cross_normalized_x  ';  WRITE ( 14 )  cross_normalized_x
+    WRITE ( 14 )  'cross_normalized_y  ';  WRITE ( 14 )  cross_normalized_y
+    WRITE ( 14 )  'cross_normx_factor  ';  WRITE ( 14 )  cross_normx_factor
+    WRITE ( 14 )  'cross_normy_factor  ';  WRITE ( 14 )  cross_normy_factor
+    WRITE ( 14 )  'cross_profiles      ';  WRITE ( 14 )  cross_profiles
+    WRITE ( 14 )  'cross_profile_n_coun'
+                  WRITE ( 14 )  cross_profile_number_count
+    WRITE ( 14 )  'cross_profile_number';  WRITE ( 14 )  cross_profile_numbers
+    WRITE ( 14 )  'cross_uxmax         ';  WRITE ( 14 )  cross_uxmax
+    WRITE ( 14 )  'cross_uxmax_computed';  WRITE ( 14 )  cross_uxmax_computed
+    WRITE ( 14 )  'cross_uxmax_normaliz';  WRITE ( 14 )  cross_uxmax_normalized
+    WRITE ( 14 )  'cross_uxmax_norm_com'
+                  WRITE ( 14 )  cross_uxmax_normalized_computed
+    WRITE ( 14 )  'cross_uxmin         ';  WRITE ( 14 )  cross_uxmin
+    WRITE ( 14 )  'cross_uxmin_computed';  WRITE ( 14 )  cross_uxmin_computed
+    WRITE ( 14 )  'cross_uxmin_normaliz';  WRITE ( 14 )  cross_uxmin_normalized
+    WRITE ( 14 )  'cross_uxmin_norm_com'
+                  WRITE ( 14 )  cross_uxmin_normalized_computed
+    WRITE ( 14 )  'cross_uymax         ';  WRITE ( 14 )  cross_uymax
+    WRITE ( 14 )  'cross_uymin         ';  WRITE ( 14 )  cross_uymin
+    WRITE ( 14 )  'cross_xtext         ';  WRITE ( 14 )  cross_xtext
+    WRITE ( 14 )  'dopr_crossindex     ';  WRITE ( 14 )  dopr_crossindex
+    WRITE ( 14 )  'dopr_time_count     ';  WRITE ( 14 )  dopr_time_count
+    WRITE ( 14 )  'hom_sum             ';  WRITE ( 14 )  hom_sum
+    WRITE ( 14 )  'profile_columns     ';  WRITE ( 14 )  profile_columns
+    WRITE ( 14 )  'profile_number      ';  WRITE ( 14 )  profile_number
+    WRITE ( 14 )  'profile_rows        ';  WRITE ( 14 )  profile_rows
+    IF ( ALLOCATED( spectrum_x ) )  THEN
+       WRITE ( 14 )  'spectrum_x          ';  WRITE ( 14 )  spectrum_x
+       WRITE ( 14 )  'spectrum_y          ';  WRITE ( 14 )  spectrum_y
+    ENDIF
+
+!
+!-- Write end label. Unit 14 is closed in the main program.
+    WRITE ( 14 )  '*** end ***         '
+
+
+    CALL cpu_log( log_point(22), 'write_3d_binary', 'stop' )
+
+
+ END SUBROUTINE write_3d_binary
Index: palm/trunk/SOURCE/write_compressed.f90
===================================================================
--- palm/trunk/SOURCE/write_compressed.f90	(revision 1)
+++ palm/trunk/SOURCE/write_compressed.f90	(revision 1)
@@ -0,0 +1,215 @@
+ SUBROUTINE write_compressed( field, fid_avs, fid_fld, my_id, nxl, nxr, nyn, &
+                              nys, nzb, nz_do3d, prec )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! ---------------------
+! $Log: write_compressed.f90,v $
+! Revision 1.4  2006/02/23 13:15:09  raasch
+! nz_plot3d renamed nz_do3d
+!
+! Revision 1.3  2003/03/16 09:51:07  raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.2  2001/03/30 07:59:48  raasch
+! All comments translated into English
+!
+! Revision 1.1  1999/03/02 09:25:21  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! In this routine, 3D-data (to be plotted) are scaled and compressed by
+! the method of bit shifting. It is designed for the use outside of PALM
+! also, which is the reason why most of the data is passed by subroutine
+! arguments. Nevertheless, the module pegrid is needed by MPI calls.
+!
+! Arguments:
+! field         = data array to be compressed
+! fid_avs       = file-ID of AVS-data-file
+! fid_fld       = file-ID of AVS-header-file
+! my_id         = ID of the calling PE
+! nxl, nxr      = index bounds of the subdomain along x
+! nyn, nys      = index bounds of the subdomain along y
+! nzb,nz_do3d   = index bounds of the domain along z (can be smaller than
+!                 the total domain)
+! prec          = precision of packed data (number of digits after decimal
+!                 point)
+!------------------------------------------------------------------------------!
+
+    USE pegrid         !  needed for MPI_ALLREDUCE
+
+    IMPLICIT NONE
+
+    INTEGER, PARAMETER   :: ip4 = SELECTED_INT_KIND ( 9 )
+    INTEGER, PARAMETER   :: spk = SELECTED_REAL_KIND( 6 )
+
+    INTEGER ::  ampl, dummy1, dummy2, factor, i, ifieldmax, ifieldmax_l, &
+                ifieldmin, ifieldmin_l, ii, j, k, length, nfree, npack, nsize, &
+                nx, ny, nz, pos, startpos
+    INTEGER(ip4) ::  imask (32)
+    INTEGER(ip4), DIMENSION(:), ALLOCATABLE ::  ifield, packed_ifield
+
+    INTEGER, INTENT(IN) ::  fid_avs, fid_fld, my_id, nxl, nxr, nyn, nys, nzb, &
+                            nz_do3d, prec
+
+    REAL(spk), INTENT(IN) :: field(1:((nxr-nxl+3)*(nyn-nys+3)*(nz_do3d-nzb+1)))
+
+!
+!-- Initialise local variables
+    ampl      = 0
+    ifieldmax = 0
+    ifieldmin = 0
+    npack = 0
+    nsize = 0
+    DO  i = 1,32
+       imask(i) = (2**i) - 1
+    ENDDO
+
+    nx     = nxr - nxl + 2
+    ny     = nyn - nys + 2
+    nz     = nz_do3d - nzb
+    length = (nx+1) * (ny+1) * (nz+1)
+
+!
+!-- Allocate memory for integer array
+    ALLOCATE ( ifield(1:length) )
+
+!
+!-- Store data on integer (in desired precision)
+    factor = 10**prec
+    DO  i = 1, length
+       ifield(i) = NINT( field(i) * factor )
+    ENDDO
+
+!
+!-- Find minimum and maximum
+    ifieldmax_l = MAXVAL( ifield )
+    ifieldmin_l = MINVAL( ifield )
+
+#if defined( __parallel )
+    CALL MPI_ALLREDUCE( ifieldmax_l, ifieldmax, 1, MPI_INTEGER, MPI_MAX, &
+                        comm2d, ierr )
+    CALL MPI_ALLREDUCE( ifieldmin_l, ifieldmin, 1, MPI_INTEGER, MPI_MIN, &
+                        comm2d, ierr )
+#else
+    ifieldmax = ifieldmax_l
+    ifieldmin = ifieldmin_l
+#endif
+
+!
+!-- Minimum scaling
+    ifield = ifield - ifieldmin
+
+!
+!-- Calculate the number of bits needed for each value
+    ampl  = ifieldmax - ifieldmin
+    nsize = 1
+
+    DO WHILE ( imask(nsize) < ampl )
+       nsize = nsize + 1
+    ENDDO
+
+! 
+!-- Calculate size of the packed array
+    npack = length * nsize
+    IF ( MOD( npack, 32 ) /= 0 )  npack = npack + 32
+    npack = npack / 32
+
+!
+!-- Start packing the data
+    ALLOCATE ( packed_ifield(1:npack) )
+    packed_ifield = 0
+
+!
+!-- Starting position of a word
+    startpos = 0
+
+!
+!-- Starting position of the word to which data are actually written
+    ii = 1
+
+!
+!-- Compress all data
+    DO  i = 1, length
+
+!
+!--    Cut the significant bits from the actual grid point value (GPV)
+       dummy1 = IAND( ifield(i), imask(nsize) )
+
+!
+!--    Calculate number of free bits of the actual word after packing the GPV
+       nfree = 32 - startpos - nsize
+
+       IF ( nfree > 0 )  THEN 
+!
+!--       GPV fits to the actual word (ii), additional bits are still free.
+!--       Shift GPV to the new position
+          dummy2 = ISHFT( dummy1 ,nfree )
+
+!
+!--       Append bits to the already packed data
+          packed_ifield(ii) = packed_ifield(ii) + dummy2
+
+!
+!--       Calculate new starting position
+          startpos = startpos + nsize
+
+       ELSEIF ( nfree .EQ. 0 )  THEN 
+!
+!--       GPV fills the actual word (ii) exactly
+          packed_ifield(ii) = packed_ifield(ii) + dummy1
+
+!
+!--       Activate next (new) word
+          ii = ii + 1
+
+!
+!--       Reset starting position of the new word
+          startpos = 0
+
+       ELSE 
+!
+!--       GPV must be split up to the actual (ii) and the following (ii+1)
+!--       word. Shift first part of GPV to its position.
+          dummy2 = ISHFT( dummy1, nfree )
+
+!
+!--       Append bits
+          packed_ifield(ii) = packed_ifield(ii) + dummy2 
+
+!
+!--       Store rest of GPV on the next word
+          ii = ii + 1
+          packed_ifield(ii) = ISHFT( dummy1, 32+nfree )
+!
+!--       Calculate starting position of the next GPV
+          startpos = -nfree
+
+       ENDIF
+
+    ENDDO
+
+!
+!-- Write the compressed 3D array
+    WRITE ( fid_avs )  packed_ifield
+
+!
+!-- Write additional informations on  FLD-file
+    IF ( my_id == 0 )  WRITE ( fid_fld, 100 )  prec, ifieldmin, nsize, length
+
+    DEALLOCATE( ifield, packed_ifield )
+
+!
+!-- Formats
+100 FORMAT ('# precision = ',I4/ &
+            '# feldmin   = ',I8/ &
+            '# nbits     = ',I2/ &
+            '# nskip     = ',I8)
+
+END SUBROUTINE write_compressed
Index: palm/trunk/SOURCE/write_restart_data_mod.f90
===================================================================
--- palm/trunk/SOURCE/write_restart_data_mod.f90	(revision 4901)
+++ 	(revision )
@@ -1,1544 +1,0 @@
-!> @file write_restart_data_mod.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! 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-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-!
-! Former revisions:
-! -----------------
-! $Id$
-! version number update because of revised output of surface data via MPI-IO for better performance
-!
-! 4848 2021-01-21 15:51:51Z gronemeier
-! bugfix: removed syn_turb_gen from restart files
-!
-! 4845 2021-01-18 11:15:37Z raasch
-! arrays removed that were required for radiation boundary conditions
-!
-! 4828 2021-01-05 11:21:41Z Giersch
-! include time_indoor into restart mechanism
-!
-! 4777 2020-11-06 14:50:49Z raasch
-! bugfix for writing spectra data with MPI-I/O (they are global arrays!)
-!
-! 4671 2020-09-09 20:27:58Z pavelkrc
-! Implementation of downward facing USM and LSM surfaces
-!
-! 4564 2020-06-12 14:03:36Z raasch
-! Vertical nesting method of Huq et al. (2019) removed
-!
-! 4536 2020-05-17 17:24:13Z raasch
-! binary version incremented
-!
-! 4535 2020-05-15 12:07:23Z raasch
-! bugfix for restart data format query
-!
-! 4514 2020-04-30 16:29:59Z suehring
-! qsurf and ssurf added
-!
-! 4495 2020-04-13 20:11:20Z raasch
-! restart data handling with MPI-IO added
-!
-! 4489 2020-04-04 10:54:08Z raasch
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! - Move 2-m potential temperature to diagnostic_output_quantities.
-!
-! 4301 2019-11-22 12:09:09Z oliver.maas
-! removed recycling_yshift
-!
-! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod and increased binary version
-!
-! 4146 2019-08-07 07:47:36Z gronemeier
-! Corrected "Former revisions" section
-!
-! 4101 2019-07-17 15:14:26Z gronemeier
-! remove old_dt
-!
-! 4039 2019-06-18 10:32:41Z suehring
-! Modularize diagnostic output
-!
-! 4017 2019-06-06 12:16:46Z schwenkel
-! output of turbulence intensity added
-!
-! 3988 2019-05-22 11:32:37Z kanani
-! + time_virtual_measurement (to enable steering of output interval)
-!
-! 3936 2019-04-26 15:38:02Z kanani
-! Enable time-averaged output of theta_2m* with restarts
-!
-! 3668 2019-01-14 12:49:24Z maronga
-! Implementation of the PALM module interface
-!
-! 2894 2018-03-15 09:17:58Z Giersch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Writes restart data into binary file(s) for restart runs.
-!--------------------------------------------------------------------------------------------------!
- MODULE write_restart_data_mod
-
-
-    USE arrays_3d,                                                                                 &
-        ONLY:  e, inflow_damping_factor, kh, km, mean_inflow_profiles, p, pt, pt_init, q, q_init,  &
-               ql, ref_state, s, s_init, u, u_init, ug, v, v_init, vg, vpt, w
-
-    USE averaging
-
-    USE bulk_cloud_model_mod,                                                                      &
-        ONLY:  bulk_cloud_model
-
-    USE control_parameters
-
-    USE grid_variables,                                                                            &
-        ONLY:  dx, dy
-
-    USE gust_mod,                                                                                  &
-        ONLY:  gust_module_enabled
-
-    USE indices,                                                                                   &
-        ONLY:  nx, nxl, nxr, ny, nys, nyn, nz, nzb, nzt
-
-    USE indoor_model_mod,                                                                          &
-        ONLY:  time_indoor
-
-    USE kinds
-
-    USE model_1d_mod,                                                                              &
-        ONLY:  damp_level_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
-
-    USE module_interface,                                                                          &
-        ONLY:  module_interface_wrd_global,                                                        &
-               module_interface_wrd_local
-
-    USE netcdf_interface,                                                                          &
-        ONLY:  netcdf_precision, output_for_t0
-
-    USE particle_attributes,                                                                       &
-        ONLY:  particle_advection
-
-    USE pegrid,                                                                                    &
-        ONLY:  collective_wait, hor_index_bounds, myid, numprocs
-
-    USE radiation_model_mod,                                                                       &
-        ONLY:  time_radiation
-
-    USE random_function_mod,                                                                       &
-        ONLY:  random_iv, random_iy
-
-    USE random_generator_parallel,                                                                 &
-        ONLY:  id_random_array, seq_random_array
-
-    USE restart_data_mpi_io_mod,                                                                   &
-        ONLY:  wrd_mpi_io, wrd_mpi_io_global_array
-
-    USE spectra_mod,                                                                               &
-        ONLY:  average_count_sp, spectrum_x, spectrum_y
-
-    USE statistics,                                                                                &
-        ONLY:  hom, hom_sum, statistic_regions, u_max, u_max_ijk, v_max, v_max_ijk, w_max,         &
-        w_max_ijk, z_i
-
-    USE surface_mod,                                                                               &
-        ONLY:  surface_wrd_local
-
-    USE user,                                                                                      &
-        ONLY:  user_module_enabled
-
-    USE virtual_measurement_mod,                                                                   &
-        ONLY:  time_virtual_measurement
-
-
-    IMPLICIT NONE
-
-
-    INTERFACE wrd_global
-       MODULE PROCEDURE wrd_global
-    END INTERFACE wrd_global
-
-    INTERFACE wrd_local
-       MODULE PROCEDURE wrd_local
-    END INTERFACE wrd_local
-
-
-    PUBLIC wrd_local, wrd_global
-
-
- CONTAINS
-
-
-! Description:
-! ------------
-!> Global data of control variables and arrays is written out for restarts.
-!> In case of output in Fortran binary format, this information is only written to the file
-!> opened by PE0.
-!--------------------------------------------------------------------------------------------------!
-
-
- SUBROUTINE wrd_global
-
-
-    CHARACTER(LEN=10) ::  binary_version_global  !<
-    CHARACTER(LEN=20) ::  tmp_name               !< temporary variable
-
-    INTEGER ::  i                                !< loop index
-
-    binary_version_global = '5.3'
-
-    IF ( restart_data_format_output == 'fortran_binary' )  THEN
-!
-!--    Output in Fortran binary format
-       CALL wrd_write_string( 'binary_version_global' )
-       WRITE ( 14 )  binary_version_global
-
-       CALL wrd_write_string( 'numprocs' )
-       WRITE ( 14 )  numprocs
-
-       CALL wrd_write_string( 'hor_index_bounds' )
-       WRITE ( 14 )  hor_index_bounds
-
-       CALL wrd_write_string( 'nz' )
-       WRITE ( 14 )  nz
-
-       CALL wrd_write_string( 'max_pr_user' )
-       WRITE ( 14 )  max_pr_user
-
-       CALL wrd_write_string( 'statistic_regions' )
-       WRITE ( 14 )  statistic_regions
-
-!
-!--    Caution: After changes in the following parameter-list, the version number stored in the
-!--    -------- variable binary_version_global has to be increased. The same changes must also be
-!--             done in the parameter-list in rrd_global.
-       CALL wrd_write_string( 'advected_distance_x' )
-       WRITE ( 14 )  advected_distance_x
-
-       CALL wrd_write_string( 'advected_distance_y' )
-       WRITE ( 14 )  advected_distance_y
-
-       CALL wrd_write_string( 'alpha_surface' )
-       WRITE ( 14 )  alpha_surface
-
-       CALL wrd_write_string( 'average_count_pr' )
-       WRITE ( 14 )  average_count_pr
-
-       CALL wrd_write_string( 'average_count_sp' )
-       WRITE ( 14 )  average_count_sp
-
-       CALL wrd_write_string( 'average_count_3d' )
-       WRITE ( 14 )  average_count_3d
-
-       CALL wrd_write_string( 'bc_e_b' )
-       WRITE ( 14 )  bc_e_b
-
-       CALL wrd_write_string( 'bc_lr' )
-       WRITE ( 14 )  bc_lr
-
-       CALL wrd_write_string( 'bc_ns' )
-       WRITE ( 14 )  bc_ns
-
-       CALL wrd_write_string( 'bc_p_b' )
-       WRITE ( 14 )  bc_p_b
-
-       CALL wrd_write_string( 'bc_p_t' )
-       WRITE ( 14 )  bc_p_t
-
-       CALL wrd_write_string( 'bc_pt_b' )
-       WRITE ( 14 )  bc_pt_b
-
-       CALL wrd_write_string( 'bc_pt_t' )
-       WRITE ( 14 )  bc_pt_t
-
-       CALL wrd_write_string( 'bc_pt_t_val' )
-       WRITE ( 14 )  bc_pt_t_val
-
-       CALL wrd_write_string( 'bc_q_b' )
-       WRITE ( 14 )  bc_q_b
-
-       CALL wrd_write_string( 'bc_q_t' )
-       WRITE ( 14 )  bc_q_t
-
-       CALL wrd_write_string( 'bc_q_t_val' )
-       WRITE ( 14 )  bc_q_t_val
-
-       CALL wrd_write_string( 'bc_s_b' )
-       WRITE ( 14 )  bc_s_b
-
-       CALL wrd_write_string( 'bc_s_t' )
-       WRITE ( 14 )  bc_s_t
-
-       CALL wrd_write_string( 'bc_uv_b' )
-       WRITE ( 14 )  bc_uv_b
-
-       CALL wrd_write_string( 'bc_uv_t' )
-       WRITE ( 14 )  bc_uv_t
-
-       CALL wrd_write_string( 'building_height' )
-       WRITE ( 14 )  building_height
-
-       CALL wrd_write_string( 'building_length_x' )
-       WRITE ( 14 )  building_length_x
-
-       CALL wrd_write_string( 'building_length_y' )
-       WRITE ( 14 )  building_length_y
-
-       CALL wrd_write_string( 'building_wall_left' )
-       WRITE ( 14 )  building_wall_left
-
-       CALL wrd_write_string( 'building_wall_south' )
-       WRITE ( 14 )  building_wall_south
-
-       CALL wrd_write_string( 'call_psolver_at_all_substeps' )
-       WRITE ( 14 )  call_psolver_at_all_substeps
-
-       CALL wrd_write_string( 'canyon_height' )
-       WRITE ( 14 )  canyon_height
-
-       CALL wrd_write_string( 'canyon_wall_left' )
-       WRITE ( 14 )  canyon_wall_left
-
-       CALL wrd_write_string( 'canyon_wall_south' )
-       WRITE ( 14 )  canyon_wall_south
-
-       CALL wrd_write_string( 'canyon_width_x' )
-       WRITE ( 14 )  canyon_width_x
-
-       CALL wrd_write_string( 'canyon_width_y' )
-       WRITE ( 14 )  canyon_width_y
-
-       CALL wrd_write_string( 'cfl_factor' )
-       WRITE ( 14 )  cfl_factor
-
-       CALL wrd_write_string( 'cloud_droplets' )
-       WRITE ( 14 )  cloud_droplets
-
-       CALL wrd_write_string( 'collective_wait' )
-       WRITE ( 14 )  collective_wait
-
-       CALL wrd_write_string( 'conserve_volume_flow' )
-       WRITE ( 14 )  conserve_volume_flow
-
-       CALL wrd_write_string( 'conserve_volume_flow_mode' )
-       WRITE ( 14 )  conserve_volume_flow_mode
-
-       CALL wrd_write_string( 'constant_flux_layer' )
-       WRITE ( 14 )  constant_flux_layer
-
-       CALL wrd_write_string( 'coupling_start_time' )
-       WRITE ( 14 )  coupling_start_time
-
-       CALL wrd_write_string( 'current_timestep_number' )
-       WRITE ( 14 )  current_timestep_number
-
-       CALL wrd_write_string( 'cycle_mg' )
-       WRITE ( 14 )  cycle_mg
-
-       CALL wrd_write_string( 'damp_level_1d' )
-       WRITE ( 14 )  damp_level_1d
-
-       CALL wrd_write_string( 'origin_date_time' )
-       WRITE ( 14 )  origin_date_time
-
-       CALL wrd_write_string( 'dissipation_1d' )
-       WRITE ( 14 )  dissipation_1d
-
-       CALL wrd_write_string( 'do2d_xy_time_count' )
-       WRITE ( 14 )  do2d_xy_time_count
-
-       CALL wrd_write_string( 'do2d_xz_time_count' )
-       WRITE ( 14 )  do2d_xz_time_count
-
-       CALL wrd_write_string( 'do2d_yz_time_count' )
-       WRITE ( 14 )  do2d_yz_time_count
-
-       CALL wrd_write_string( 'do3d_time_count' )
-       WRITE ( 14 )  do3d_time_count
-
-       CALL wrd_write_string( 'dp_external' )
-       WRITE ( 14 )  dp_external
-
-       CALL wrd_write_string( 'dp_level_b' )
-       WRITE ( 14 )  dp_level_b
-
-       CALL wrd_write_string( 'dp_smooth' )
-       WRITE ( 14 )  dp_smooth
-
-       CALL wrd_write_string( 'dpdxy' )
-       WRITE ( 14 )  dpdxy
-
-       CALL wrd_write_string( 'dt_3d' )
-       WRITE ( 14 )  dt_3d
-
-    CALL wrd_write_string( 'dt_pr_1d' )
-    WRITE ( 14 )  dt_pr_1d
-
-       CALL wrd_write_string( 'dt_run_control_1d' )
-       WRITE ( 14 )  dt_run_control_1d
-
-       CALL wrd_write_string( 'dx' )
-       WRITE ( 14 )  dx
-
-       CALL wrd_write_string( 'dy' )
-       WRITE ( 14 )  dy
-
-       CALL wrd_write_string( 'dz' )
-       WRITE ( 14 )  dz
-
-       CALL wrd_write_string( 'dz_max' )
-       WRITE ( 14 )  dz_max
-
-       CALL wrd_write_string( 'dz_stretch_factor' )
-       WRITE ( 14 )  dz_stretch_factor
-
-       CALL wrd_write_string( 'dz_stretch_factor_array' )
-       WRITE ( 14 )  dz_stretch_factor_array
-
-       CALL wrd_write_string( 'dz_stretch_level' )
-       WRITE ( 14 )  dz_stretch_level
-
-       CALL wrd_write_string( 'dz_stretch_level_end' )
-       WRITE ( 14 )  dz_stretch_level_end
-
-       CALL wrd_write_string( 'dz_stretch_level_start' )
-       WRITE ( 14 )  dz_stretch_level_start
-
-       CALL wrd_write_string( 'e_min' )
-       WRITE ( 14 )  e_min
-
-       CALL wrd_write_string( 'end_time_1d' )
-       WRITE ( 14 )  end_time_1d
-
-       CALL wrd_write_string( 'fft_method' )
-       WRITE ( 14 )  fft_method
-
-       CALL wrd_write_string( 'first_call_lpm' )
-       WRITE ( 14 )  first_call_lpm
-
-       CALL wrd_write_string( 'galilei_transformation' )
-       WRITE ( 14 )  galilei_transformation
-
-       CALL wrd_write_string( 'hom' )
-       WRITE ( 14 )  hom
-
-       CALL wrd_write_string( 'hom_sum' )
-       WRITE ( 14 )  hom_sum
-
-       CALL wrd_write_string( 'humidity' )
-       WRITE ( 14 )  humidity
-
-       IF ( ALLOCATED( inflow_damping_factor ) )  THEN
-          CALL wrd_write_string( 'inflow_damping_factor' )
-          WRITE ( 14 )  inflow_damping_factor
-       ENDIF
-
-       CALL wrd_write_string( 'inflow_damping_height' )
-       WRITE ( 14 )  inflow_damping_height
-
-       CALL wrd_write_string( 'inflow_damping_width' )
-       WRITE ( 14 )  inflow_damping_width
-
-       CALL wrd_write_string( 'inflow_disturbance_begin' )
-       WRITE ( 14 )  inflow_disturbance_begin
-
-       CALL wrd_write_string( 'inflow_disturbance_end' )
-       WRITE ( 14 )  inflow_disturbance_end
-
-       CALL wrd_write_string( 'km_constant' )
-       WRITE ( 14 )  km_constant
-
-       CALL wrd_write_string( 'large_scale_forcing' )
-       WRITE ( 14 )  large_scale_forcing
-
-       CALL wrd_write_string( 'large_scale_subsidence' )
-       WRITE ( 14 )  large_scale_subsidence
-
-       CALL wrd_write_string( 'latitude' )
-       WRITE ( 14 )  latitude
-
-       CALL wrd_write_string( 'longitude' )
-       WRITE ( 14 )  longitude
-
-       CALL wrd_write_string( 'loop_optimization' )
-       WRITE ( 14 )  loop_optimization
-
-       CALL wrd_write_string( 'masking_method' )
-       WRITE ( 14 )  masking_method
-
-       IF ( ALLOCATED( mean_inflow_profiles ) )  THEN
-          CALL wrd_write_string( 'mean_inflow_profiles' )
-          WRITE ( 14 )  mean_inflow_profiles
-       ENDIF
-
-       CALL wrd_write_string( 'mg_cycles' )
-       WRITE ( 14 )  mg_cycles
-
-       CALL wrd_write_string( 'mg_switch_to_pe0_level' )
-       WRITE ( 14 )  mg_switch_to_pe0_level
-
-       CALL wrd_write_string( 'mixing_length_1d' )
-       WRITE ( 14 )  mixing_length_1d
-
-       CALL wrd_write_string( 'momentum_advec' )
-       WRITE ( 14 )  momentum_advec
-
-       CALL wrd_write_string( 'netcdf_precision' )
-       WRITE ( 14 )  netcdf_precision
-
-       CALL wrd_write_string( 'neutral' )
-       WRITE ( 14 )  neutral
-
-       CALL wrd_write_string( 'ngsrb' )
-       WRITE ( 14 )  ngsrb
-
-       CALL wrd_write_string( 'nsor' )
-       WRITE ( 14 )  nsor
-
-       CALL wrd_write_string( 'nsor_ini' )
-       WRITE ( 14 )  nsor_ini
-
-       CALL wrd_write_string( 'nudging' )
-       WRITE ( 14 )  nudging
-
-       CALL wrd_write_string( 'num_leg' )
-       WRITE ( 14 )  num_leg
-
-       CALL wrd_write_string( 'nx' )
-       WRITE ( 14 )  nx
-
-       CALL wrd_write_string( 'ny' )
-       WRITE ( 14 )  ny
-
-       CALL wrd_write_string( 'ocean_mode' )
-       WRITE ( 14 )  ocean_mode
-
-       CALL wrd_write_string( 'omega' )
-       WRITE ( 14 )  omega
-
-       CALL wrd_write_string( 'omega_sor' )
-       WRITE ( 14 )  omega_sor
-
-       CALL wrd_write_string( 'output_for_t0' )
-       WRITE ( 14 )  output_for_t0
-
-       CALL wrd_write_string( 'passive_scalar' )
-       WRITE ( 14 )  passive_scalar
-
-       CALL wrd_write_string( 'prandtl_number' )
-       WRITE ( 14 )  prandtl_number
-
-       CALL wrd_write_string( 'psolver' )
-       WRITE ( 14 )  psolver
-
-       CALL wrd_write_string( 'pt_damping_factor' )
-       WRITE ( 14 )  pt_damping_factor
-
-       CALL wrd_write_string( 'pt_damping_width' )
-       WRITE ( 14 )  pt_damping_width
-
-       CALL wrd_write_string( 'pt_init' )
-       WRITE ( 14 )  pt_init
-
-       CALL wrd_write_string( 'pt_reference' )
-       WRITE ( 14 )  pt_reference
-
-       CALL wrd_write_string( 'pt_surface' )
-       WRITE ( 14 )  pt_surface
-
-       CALL wrd_write_string( 'pt_surface_initial_change' )
-       WRITE ( 14 )  pt_surface_initial_change
-
-       CALL wrd_write_string( 'pt_vertical_gradient' )
-       WRITE ( 14 )  pt_vertical_gradient
-
-       CALL wrd_write_string( 'pt_vertical_gradient_level' )
-       WRITE ( 14 )  pt_vertical_gradient_level
-
-       CALL wrd_write_string( 'pt_vertical_gradient_level_ind' )
-       WRITE ( 14 )  pt_vertical_gradient_level_ind
-
-       CALL wrd_write_string( 'q_init' )
-       WRITE ( 14 )  q_init
-
-       CALL wrd_write_string( 'q_surface' )
-       WRITE ( 14 )  q_surface
-
-       CALL wrd_write_string( 'q_surface_initial_change' )
-       WRITE ( 14 )  q_surface_initial_change
-
-       CALL wrd_write_string( 'q_vertical_gradient' )
-       WRITE ( 14 )  q_vertical_gradient
-
-       CALL wrd_write_string( 'q_vertical_gradient_level' )
-       WRITE ( 14 )  q_vertical_gradient_level
-
-       CALL wrd_write_string( 'q_vertical_gradient_level_ind' )
-       WRITE ( 14 )  q_vertical_gradient_level_ind
-
-       CALL wrd_write_string( 'random_generator' )
-       WRITE ( 14 )  random_generator
-
-       CALL wrd_write_string( 'random_heatflux' )
-       WRITE ( 14 )  random_heatflux
-
-       CALL wrd_write_string( 'rans_mode' )
-       WRITE ( 14 )  rans_mode
-
-       CALL wrd_write_string( 'rayleigh_damping_factor' )
-       WRITE ( 14 )  rayleigh_damping_factor
-
-       CALL wrd_write_string( 'rayleigh_damping_height' )
-       WRITE ( 14 )  rayleigh_damping_height
-
-       CALL wrd_write_string( 'recycling_width' )
-       WRITE ( 14 )  recycling_width
-
-       CALL wrd_write_string( 'ref_state' )
-       WRITE ( 14 )  ref_state
-
-       CALL wrd_write_string( 'reference_state' )
-       WRITE ( 14 )  reference_state
-
-       CALL wrd_write_string( 'residual_limit' )
-       WRITE ( 14 )  residual_limit
-
-       CALL wrd_write_string( 'roughness_length' )
-       WRITE ( 14 )  roughness_length
-
-       CALL wrd_write_string( 'run_coupled' )
-       WRITE ( 14 )  run_coupled
-
-       CALL wrd_write_string( 'runnr' )
-       WRITE ( 14 )  runnr
-
-       CALL wrd_write_string( 's_init' )
-       WRITE ( 14 )  s_init
-
-       CALL wrd_write_string( 's_surface' )
-       WRITE ( 14 )  s_surface
-
-       CALL wrd_write_string( 's_surface_initial_change' )
-       WRITE ( 14 )  s_surface_initial_change
-
-       CALL wrd_write_string( 's_vertical_gradient' )
-       WRITE ( 14 )  s_vertical_gradient
-
-       CALL wrd_write_string( 's_vertical_gradient_level' )
-       WRITE ( 14 )  s_vertical_gradient_level
-
-       CALL wrd_write_string( 's_vertical_gradient_level_ind' )
-       WRITE ( 14 )  s_vertical_gradient_level_ind
-
-       CALL wrd_write_string( 'scalar_advec' )
-       WRITE ( 14 )  scalar_advec
-
-       CALL wrd_write_string( 'simulated_time' )
-       WRITE ( 14 )  simulated_time
-
-       IF ( ALLOCATED( spectrum_x ) )  THEN
-          CALL wrd_write_string( 'spectrum_x' )
-          WRITE ( 14 )  spectrum_x
-          CALL wrd_write_string( 'spectrum_y' )
-          WRITE ( 14 )  spectrum_y
-       ENDIF
-
-       CALL wrd_write_string( 'spinup_time ' )
-       WRITE ( 14 )  spinup_time
-
-       CALL wrd_write_string( 'subs_vertical_gradient' )
-       WRITE ( 14 )  subs_vertical_gradient
-
-       CALL wrd_write_string( 'subs_vertical_gradient_level' )
-       WRITE ( 14 )  subs_vertical_gradient_level
-
-       CALL wrd_write_string( 'subs_vertical_gradient_level_i' )
-       WRITE ( 14 )  subs_vertical_gradient_level_i
-
-       CALL wrd_write_string( 'surface_heatflux' )
-       WRITE ( 14 )  surface_heatflux
-
-       CALL wrd_write_string( 'surface_pressure' )
-       WRITE ( 14 )  surface_pressure
-
-       CALL wrd_write_string( 'surface_scalarflux' )
-       WRITE ( 14 )  surface_scalarflux
-
-       CALL wrd_write_string( 'surface_waterflux' )
-       WRITE ( 14 )  surface_waterflux
-
-       CALL wrd_write_string( 'time_coupling' )
-       WRITE ( 14 )  time_coupling
-
-       CALL wrd_write_string( 'time_disturb' )
-       WRITE ( 14 )  time_disturb
-
-       CALL wrd_write_string( 'time_do2d_xy' )
-       WRITE ( 14 )  time_do2d_xy
-
-       CALL wrd_write_string( 'time_do2d_xz' )
-       WRITE ( 14 )  time_do2d_xz
-
-       CALL wrd_write_string( 'time_do2d_yz' )
-       WRITE ( 14 )  time_do2d_yz
-
-       CALL wrd_write_string( 'time_do3d' )
-       WRITE ( 14 )  time_do3d
-
-       CALL wrd_write_string( 'time_do_av' )
-       WRITE ( 14 )  time_do_av
-
-       CALL wrd_write_string( 'time_do_sla' )
-       WRITE ( 14 )  time_do_sla
-
-       CALL wrd_write_string( 'time_domask' )
-       WRITE ( 14 )  time_domask
-
-       CALL wrd_write_string( 'time_dopr' )
-       WRITE ( 14 )  time_dopr
-
-       CALL wrd_write_string( 'time_dopr_av' )
-       WRITE ( 14 )  time_dopr_av
-
-       CALL wrd_write_string( 'time_dopr_listing' )
-       WRITE ( 14 )  time_dopr_listing
-
-       CALL wrd_write_string( 'time_dopts' )
-       WRITE ( 14 )  time_dopts
-
-       CALL wrd_write_string( 'time_dosp' )
-       WRITE ( 14 )  time_dosp
-
-       CALL wrd_write_string( 'time_dots' )
-       WRITE ( 14 )  time_dots
-
-       CALL wrd_write_string( 'time_indoor' )
-       WRITE ( 14 )  time_indoor
-
-       CALL wrd_write_string( 'time_radiation' )
-       WRITE ( 14 )  time_radiation
-
-       CALL wrd_write_string( 'time_restart' )
-       WRITE ( 14 )  time_restart
-
-       CALL wrd_write_string( 'time_run_control' )
-       WRITE ( 14 )  time_run_control
-
-       CALL wrd_write_string( 'time_since_reference_point' )
-       WRITE ( 14 )  time_since_reference_point
-
-       CALL wrd_write_string( 'time_virtual_measurement' )
-       WRITE ( 14 )  time_virtual_measurement
-
-       CALL wrd_write_string( 'timestep_scheme' )
-       WRITE ( 14 )  timestep_scheme
-
-       CALL wrd_write_string( 'top_heatflux' )
-       WRITE ( 14 )  top_heatflux
-
-       CALL wrd_write_string( 'top_momentumflux_u' )
-       WRITE ( 14 )  top_momentumflux_u
-
-       CALL wrd_write_string( 'top_momentumflux_v' )
-       WRITE ( 14 )  top_momentumflux_v
-
-       CALL wrd_write_string( 'top_scalarflux' )
-       WRITE ( 14 )  top_scalarflux
-
-       CALL wrd_write_string( 'topography' )
-       WRITE ( 14 )  topography
-
-       CALL wrd_write_string( 'topography_grid_convention' )
-       WRITE ( 14 )  topography_grid_convention
-
-       CALL wrd_write_string( 'tsc' )
-       WRITE ( 14 )  tsc
-
-       CALL wrd_write_string( 'tunnel_height' )
-       WRITE ( 14 )  tunnel_height
-
-       CALL wrd_write_string( 'tunnel_length' )
-       WRITE ( 14 )  tunnel_length
-
-       CALL wrd_write_string( 'tunnel_wall_depth' )
-       WRITE ( 14 )  tunnel_wall_depth
-
-       CALL wrd_write_string( 'tunnel_width_x' )
-       WRITE ( 14 )  tunnel_width_x
-
-       CALL wrd_write_string( 'tunnel_width_y' )
-       WRITE ( 14 )  tunnel_width_y
-
-       CALL wrd_write_string( 'turbulence_closure' )
-       WRITE ( 14 )  turbulence_closure
-
-       CALL wrd_write_string( 'turbulent_inflow' )
-       WRITE ( 14 )  turbulent_inflow
-
-       CALL wrd_write_string( 'u_bulk' )
-       WRITE ( 14 )  u_bulk
-
-       CALL wrd_write_string( 'u_init' )
-       WRITE ( 14 )  u_init
-
-       CALL wrd_write_string( 'u_max' )
-       WRITE ( 14 )  u_max
-
-       CALL wrd_write_string( 'u_max_ijk' )
-       WRITE ( 14 )  u_max_ijk
-
-       CALL wrd_write_string( 'ug' )
-       WRITE ( 14 )  ug
-
-       CALL wrd_write_string( 'ug_surface' )
-       WRITE ( 14 )  ug_surface
-
-       CALL wrd_write_string( 'ug_vertical_gradient' )
-       WRITE ( 14 )  ug_vertical_gradient
-
-       CALL wrd_write_string( 'ug_vertical_gradient_level' )
-       WRITE ( 14 )  ug_vertical_gradient_level
-
-       CALL wrd_write_string( 'ug_vertical_gradient_level_ind' )
-       WRITE ( 14 )  ug_vertical_gradient_level_ind
-
-       CALL wrd_write_string( 'use_surface_fluxes' )
-       WRITE ( 14 )  use_surface_fluxes
-
-       CALL wrd_write_string( 'use_top_fluxes' )
-       WRITE ( 14 )  use_top_fluxes
-
-       CALL wrd_write_string( 'use_ug_for_galilei_tr' )
-       WRITE ( 14 )  use_ug_for_galilei_tr
-
-       CALL wrd_write_string( 'use_upstream_for_tke' )
-       WRITE ( 14 )  use_upstream_for_tke
-
-       CALL wrd_write_string( 'v_bulk' )
-       WRITE ( 14 )  v_bulk
-
-       CALL wrd_write_string( 'v_init' )
-       WRITE ( 14 )  v_init
-
-       CALL wrd_write_string( 'v_max' )
-       WRITE ( 14 )  v_max
-
-       CALL wrd_write_string( 'v_max_ijk' )
-       WRITE ( 14 )  v_max_ijk
-
-       CALL wrd_write_string( 'vg' )
-       WRITE ( 14 )  vg
-
-       CALL wrd_write_string( 'vg_surface' )
-       WRITE ( 14 )  vg_surface
-
-       CALL wrd_write_string( 'vg_vertical_gradient' )
-       WRITE ( 14 ) vg_vertical_gradient
-
-       CALL wrd_write_string( 'vg_vertical_gradient_level' )
-       WRITE ( 14 )  vg_vertical_gradient_level
-
-       CALL wrd_write_string( 'vg_vertical_gradient_level_ind' )
-       WRITE ( 14 )  vg_vertical_gradient_level_ind
-
-       CALL wrd_write_string( 'virtual_flight' )
-       WRITE ( 14 )  virtual_flight
-
-       CALL wrd_write_string( 'volume_flow_area' )
-       WRITE ( 14 )  volume_flow_area
-
-       CALL wrd_write_string( 'volume_flow_initial' )
-       WRITE ( 14 )  volume_flow_initial
-
-       CALL wrd_write_string( 'w_max' )
-       WRITE ( 14 )  w_max
-
-       CALL wrd_write_string( 'w_max_ijk' )
-       WRITE ( 14 )  w_max_ijk
-
-       CALL wrd_write_string( 'wall_adjustment' )
-       WRITE ( 14 )  wall_adjustment
-
-       CALL wrd_write_string( 'wall_heatflux' )
-       WRITE ( 14 )  wall_heatflux
-
-       CALL wrd_write_string( 'wall_humidityflux' )
-       WRITE ( 14 )  wall_humidityflux
-
-       CALL wrd_write_string( 'wall_scalarflux' )
-       WRITE ( 14 )  wall_scalarflux
-
-       CALL wrd_write_string( 'y_shift' )
-       WRITE ( 14 )  y_shift
-
-       CALL wrd_write_string( 'z0h_factor' )
-       WRITE ( 14 )  z0h_factor
-
-       CALL wrd_write_string( 'zeta_max' )
-       WRITE ( 14 )  zeta_max
-
-       CALL wrd_write_string( 'zeta_min' )
-       WRITE ( 14 )  zeta_min
-
-       CALL wrd_write_string( 'z_i' )
-       WRITE ( 14 )  z_i
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-!
-!--    Write global restart data using MPI-IO
-!--    ATTENTION: Arrays need to be written with routine wrd_mpi_io_global_array!
-       CALL wrd_mpi_io( 'binary_version_global',  binary_version_global )
-       CALL wrd_mpi_io( 'numprocs',  numprocs )
-       CALL wrd_mpi_io( 'nz' , nz )
-       CALL wrd_mpi_io( 'max_pr_user',  max_pr_user )
-       CALL wrd_mpi_io( 'statistic_regions', statistic_regions )
-
-!
-!--    Caution: After changes in the following parameter-list, the version number stored in the
-!--    -------- variable binary_version_global has to be increased. The same changes must also be
-!--             done in the parameter-list in rrd_global.
-       CALL wrd_mpi_io( 'advected_distance_x',  advected_distance_x )
-       CALL wrd_mpi_io( 'advected_distance_y', advected_distance_y )
-       CALL wrd_mpi_io( 'alpha_surface', alpha_surface )
-       CALL wrd_mpi_io( 'average_count_pr', average_count_pr )
-       CALL wrd_mpi_io( 'average_count_sp', average_count_sp )
-       CALL wrd_mpi_io( 'average_count_3d', average_count_3d )
-       CALL wrd_mpi_io( 'bc_e_b', bc_e_b )
-       CALL wrd_mpi_io( 'bc_lr', bc_lr )
-       CALL wrd_mpi_io( 'bc_ns', bc_ns )
-       CALL wrd_mpi_io( 'bc_p_b', bc_p_b )
-       CALL wrd_mpi_io( 'bc_p_t', bc_p_t )
-       CALL wrd_mpi_io( 'bc_pt_b', bc_pt_b )
-       CALL wrd_mpi_io( 'bc_pt_t', bc_pt_t )
-       CALL wrd_mpi_io( 'bc_pt_t_val', bc_pt_t_val )
-       CALL wrd_mpi_io( 'bc_q_b', bc_q_b )
-       CALL wrd_mpi_io( 'bc_q_t', bc_q_t )
-       CALL wrd_mpi_io( 'bc_q_t_val', bc_q_t_val )
-       CALL wrd_mpi_io( 'bc_s_b', bc_s_b )
-       CALL wrd_mpi_io( 'bc_s_t', bc_s_t )
-       CALL wrd_mpi_io( 'bc_uv_b', bc_uv_b )
-       CALL wrd_mpi_io( 'bc_uv_t', bc_uv_t )
-       CALL wrd_mpi_io( 'biometeorology', biometeorology )
-       CALL wrd_mpi_io( 'building_height', building_height )
-       CALL wrd_mpi_io( 'building_length_x', building_length_x )
-       CALL wrd_mpi_io( 'building_length_y', building_length_y )
-       CALL wrd_mpi_io( 'building_wall_left', building_wall_left )
-       CALL wrd_mpi_io( 'building_wall_south', building_wall_south )
-       CALL wrd_mpi_io( 'bulk_cloud_model', bulk_cloud_model )
-       CALL wrd_mpi_io( 'call_psolver_at_all_substeps', call_psolver_at_all_substeps )
-       CALL wrd_mpi_io( 'canyon_height', canyon_height )
-       CALL wrd_mpi_io( 'canyon_wall_left', canyon_wall_left )
-       CALL wrd_mpi_io( 'canyon_wall_south', canyon_wall_south )
-       CALL wrd_mpi_io( 'canyon_width_x',  canyon_width_x )
-       CALL wrd_mpi_io( 'canyon_width_y', canyon_width_y )
-       CALL wrd_mpi_io( 'cfl_factor', cfl_factor )
-       CALL wrd_mpi_io( 'cloud_droplets',  cloud_droplets )
-       CALL wrd_mpi_io( 'collective_wait', collective_wait )
-       CALL wrd_mpi_io( 'conserve_volume_flow', conserve_volume_flow )
-       CALL wrd_mpi_io( 'conserve_volume_flow_mode', conserve_volume_flow_mode )
-       CALL wrd_mpi_io( 'constant_flux_layer', constant_flux_layer )
-       CALL wrd_mpi_io( 'coupling_start_time', coupling_start_time )
-       CALL wrd_mpi_io( 'current_timestep_number', current_timestep_number )
-       CALL wrd_mpi_io( 'cycle_mg', cycle_mg )
-       CALL wrd_mpi_io( 'damp_level_1d', damp_level_1d )
-       CALL wrd_mpi_io( 'dissipation_1d', dissipation_1d )
-       CALL wrd_mpi_io_global_array( 'do2d_xy_time_count', do2d_xy_time_count )
-       CALL wrd_mpi_io_global_array( 'do2d_xz_time_count', do2d_xz_time_count )
-       CALL wrd_mpi_io_global_array( 'do2d_yz_time_count', do2d_yz_time_count )
-       CALL wrd_mpi_io_global_array( 'do3d_time_count', do3d_time_count )
-       CALL wrd_mpi_io( 'dp_external', dp_external )
-       CALL wrd_mpi_io( 'dp_level_b', dp_level_b )
-       CALL wrd_mpi_io( 'dp_smooth', dp_smooth )
-       CALL wrd_mpi_io_global_array( 'dpdxy', dpdxy )
-       CALL wrd_mpi_io( 'dt_3d', dt_3d )
-       CALL wrd_mpi_io( 'dt_pr_1d', dt_pr_1d )
-       CALL wrd_mpi_io( 'dt_run_control_1d', dt_run_control_1d )
-       CALL wrd_mpi_io( 'dx', dx )
-       CALL wrd_mpi_io( 'dy', dy )
-       CALL wrd_mpi_io_global_array( 'dz', dz )
-       CALL wrd_mpi_io( 'dz_max', dz_max )
-       CALL wrd_mpi_io( 'dz_stretch_factor', dz_stretch_factor )
-       CALL wrd_mpi_io_global_array( 'dz_stretch_factor_array', dz_stretch_factor_array )
-       CALL wrd_mpi_io( 'dz_stretch_level', dz_stretch_level )
-       CALL wrd_mpi_io_global_array( 'dz_stretch_level_end', dz_stretch_level_end )
-       CALL wrd_mpi_io_global_array( 'dz_stretch_level_start', dz_stretch_level_start )
-       CALL wrd_mpi_io( 'e_min', e_min )
-       CALL wrd_mpi_io( 'end_time_1d', end_time_1d )
-       CALL wrd_mpi_io( 'fft_method', fft_method )
-       CALL wrd_mpi_io( 'first_call_lpm', first_call_lpm )
-       CALL wrd_mpi_io( 'galilei_transformation', galilei_transformation )
-       CALL wrd_mpi_io( 'gust_module_enabled', gust_module_enabled )
-       CALL wrd_mpi_io_global_array( 'hom', hom )
-       CALL wrd_mpi_io_global_array( 'hom_sum', hom_sum )
-       CALL wrd_mpi_io( 'humidity', humidity )
-       IF ( ALLOCATED( inflow_damping_factor ) )  THEN
-          CALL wrd_mpi_io_global_array( 'inflow_damping_factor', inflow_damping_factor )
-       ENDIF
-       CALL wrd_mpi_io( 'inflow_damping_height', inflow_damping_height )
-       CALL wrd_mpi_io( 'inflow_damping_width', inflow_damping_width )
-       CALL wrd_mpi_io( 'inflow_disturbance_begin', inflow_disturbance_begin )
-       CALL wrd_mpi_io( 'inflow_disturbance_end', inflow_disturbance_end )
-       CALL wrd_mpi_io( 'km_constant', km_constant )
-       CALL wrd_mpi_io( 'large_scale_forcing', large_scale_forcing )
-       CALL wrd_mpi_io( 'large_scale_subsidence', large_scale_subsidence )
-       CALL wrd_mpi_io( 'latitude', latitude )
-       CALL wrd_mpi_io( 'longitude', longitude )
-       CALL wrd_mpi_io( 'loop_optimization', loop_optimization )
-       CALL wrd_mpi_io( 'masking_method', masking_method )
-       IF ( ALLOCATED( mean_inflow_profiles ) )  THEN
-          CALL wrd_mpi_io_global_array( 'mean_inflow_profiles', mean_inflow_profiles )
-       ENDIF
-       CALL wrd_mpi_io( 'mg_cycles', mg_cycles )
-       CALL wrd_mpi_io( 'mg_switch_to_pe0_level', mg_switch_to_pe0_level )
-       CALL wrd_mpi_io( 'mixing_length_1d', mixing_length_1d )
-       CALL wrd_mpi_io( 'momentum_advec', momentum_advec )
-!
-!--    There is no module procedure for CHARACTER arrays
-       DO  i = 1, SIZE( netcdf_precision, 1 )
-          WRITE ( tmp_name, '(A,I2.2)' )  'netcdf_precision_', i
-          CALL wrd_mpi_io( TRIM( tmp_name ), netcdf_precision(i) )
-       ENDDO
-       CALL wrd_mpi_io( 'neutral', neutral )
-       CALL wrd_mpi_io( 'ngsrb', ngsrb )
-       CALL wrd_mpi_io( 'nsor', nsor )
-       CALL wrd_mpi_io( 'nsor_ini', nsor_ini )
-       CALL wrd_mpi_io( 'nudging', nudging )
-       CALL wrd_mpi_io( 'num_leg', num_leg )
-       CALL wrd_mpi_io( 'nx', nx )
-       CALL wrd_mpi_io( 'ny', ny )
-       CALL wrd_mpi_io( 'ocean_mode', ocean_mode )
-       CALL wrd_mpi_io( 'omega', omega )
-       CALL wrd_mpi_io( 'omega_sor', omega_sor )
-       CALL wrd_mpi_io( 'origin_date_time', origin_date_time )
-       CALL wrd_mpi_io( 'output_for_t0', output_for_t0 )
-       CALL wrd_mpi_io( 'particle_advection', particle_advection )
-       CALL wrd_mpi_io( 'passive_scalar', passive_scalar )
-       CALL wrd_mpi_io( 'prandtl_number', prandtl_number )
-       CALL wrd_mpi_io( 'psolver', psolver )
-       CALL wrd_mpi_io( 'pt_damping_factor', pt_damping_factor )
-       CALL wrd_mpi_io( 'pt_damping_width', pt_damping_width )
-       CALL wrd_mpi_io_global_array( 'pt_init', pt_init )
-       CALL wrd_mpi_io( 'pt_reference', pt_reference )
-       CALL wrd_mpi_io( 'pt_surface', pt_surface )
-       CALL wrd_mpi_io( 'pt_surface_initial_change', pt_surface_initial_change )
-       CALL wrd_mpi_io_global_array( 'pt_vertical_gradient', pt_vertical_gradient )
-       CALL wrd_mpi_io_global_array( 'pt_vertical_gradient_level', pt_vertical_gradient_level )
-       CALL wrd_mpi_io_global_array( 'pt_vertical_gradient_level_ind', pt_vertical_gradient_level_ind )
-       CALL wrd_mpi_io_global_array( 'q_init', q_init )
-       CALL wrd_mpi_io( 'q_surface', q_surface )
-       CALL wrd_mpi_io( 'q_surface_initial_change', q_surface_initial_change )
-       CALL wrd_mpi_io_global_array( 'q_vertical_gradient', q_vertical_gradient )
-       CALL wrd_mpi_io_global_array( 'q_vertical_gradient_level', q_vertical_gradient_level )
-       CALL wrd_mpi_io_global_array( 'q_vertical_gradient_level_ind', q_vertical_gradient_level_ind )
-       CALL wrd_mpi_io( 'random_generator', random_generator )
-       CALL wrd_mpi_io( 'random_heatflux', random_heatflux )
-       CALL wrd_mpi_io( 'rans_mode', rans_mode )
-       CALL wrd_mpi_io( 'rayleigh_damping_factor', rayleigh_damping_factor )
-       CALL wrd_mpi_io( 'rayleigh_damping_height', rayleigh_damping_height )
-       CALL wrd_mpi_io( 'recycling_width', recycling_width )
-       CALL wrd_mpi_io_global_array( 'ref_state', ref_state )
-       CALL wrd_mpi_io( 'reference_state', reference_state )
-       CALL wrd_mpi_io( 'residual_limit', residual_limit )
-       CALL wrd_mpi_io( 'roughness_length', roughness_length )
-       CALL wrd_mpi_io( 'run_coupled', run_coupled )
-       CALL wrd_mpi_io( 'runnr', runnr )
-       CALL wrd_mpi_io_global_array( 's_init', s_init )
-       CALL wrd_mpi_io( 's_surface', s_surface )
-       CALL wrd_mpi_io( 's_surface_initial_change', s_surface_initial_change )
-       CALL wrd_mpi_io_global_array( 's_vertical_gradient', s_vertical_gradient )
-       CALL wrd_mpi_io_global_array( 's_vertical_gradient_level', s_vertical_gradient_level )
-       CALL wrd_mpi_io_global_array( 's_vertical_gradient_level_ind', s_vertical_gradient_level_ind )
-       CALL wrd_mpi_io( 'scalar_advec', scalar_advec )
-       CALL wrd_mpi_io( 'simulated_time', simulated_time )
-       IF ( ALLOCATED( spectrum_x ) )  THEN
-          CALL wrd_mpi_io_global_array( 'spectrum_x', spectrum_x )
-          CALL wrd_mpi_io_global_array( 'spectrum_y', spectrum_y )
-       ENDIF
-       CALL wrd_mpi_io( 'spinup_time ', spinup_time )
-       CALL wrd_mpi_io_global_array( 'subs_vertical_gradient', subs_vertical_gradient )
-       CALL wrd_mpi_io_global_array( 'subs_vertical_gradient_level', subs_vertical_gradient_level )
-       CALL wrd_mpi_io_global_array( 'subs_vertical_gradient_level_i', subs_vertical_gradient_level_i )
-       CALL wrd_mpi_io( 'surface_heatflux', surface_heatflux )
-       CALL wrd_mpi_io( 'surface_output', surface_output )
-       CALL wrd_mpi_io( 'surface_pressure', surface_pressure )
-       CALL wrd_mpi_io( 'surface_scalarflux', surface_scalarflux )
-       CALL wrd_mpi_io( 'surface_waterflux', surface_waterflux )
-       CALL wrd_mpi_io( 'time_coupling', time_coupling )
-       CALL wrd_mpi_io( 'time_disturb', time_disturb )
-       CALL wrd_mpi_io( 'time_do2d_xy', time_do2d_xy )
-       CALL wrd_mpi_io( 'time_do2d_xz', time_do2d_xz )
-       CALL wrd_mpi_io( 'time_do2d_yz', time_do2d_yz )
-       CALL wrd_mpi_io( 'time_do3d', time_do3d )
-       CALL wrd_mpi_io( 'time_do_av', time_do_av )
-       CALL wrd_mpi_io( 'time_do_sla', time_do_sla )
-       CALL wrd_mpi_io_global_array( 'time_domask', time_domask )
-       CALL wrd_mpi_io( 'time_dopr', time_dopr )
-       CALL wrd_mpi_io( 'time_dopr_av', time_dopr_av )
-       CALL wrd_mpi_io( 'time_dopr_listing', time_dopr_listing )
-       CALL wrd_mpi_io( 'time_dopts', time_dopts )
-       CALL wrd_mpi_io( 'time_dosp', time_dosp )
-       CALL wrd_mpi_io( 'time_dots', time_dots )
-       CALL wrd_mpi_io( 'time_indoor', time_indoor )
-       CALL wrd_mpi_io( 'time_radiation', time_radiation )
-       CALL wrd_mpi_io( 'time_restart', time_restart )
-       CALL wrd_mpi_io( 'time_run_control', time_run_control )
-       CALL wrd_mpi_io( 'time_since_reference_point', time_since_reference_point )
-       CALL wrd_mpi_io( 'time_virtual_measurement', time_virtual_measurement )
-       CALL wrd_mpi_io( 'timestep_scheme', timestep_scheme )
-       CALL wrd_mpi_io( 'top_heatflux', top_heatflux )
-       CALL wrd_mpi_io( 'top_momentumflux_u', top_momentumflux_u )
-       CALL wrd_mpi_io( 'top_momentumflux_v', top_momentumflux_v )
-       CALL wrd_mpi_io( 'top_scalarflux', top_scalarflux )
-       CALL wrd_mpi_io( 'topography', topography )
-       CALL wrd_mpi_io( 'topography_grid_convention', topography_grid_convention )
-       CALL wrd_mpi_io_global_array( 'tsc', tsc )
-       CALL wrd_mpi_io( 'tunnel_height', tunnel_height )
-       CALL wrd_mpi_io( 'tunnel_length', tunnel_length )
-       CALL wrd_mpi_io( 'tunnel_wall_depth', tunnel_wall_depth )
-       CALL wrd_mpi_io( 'tunnel_width_x', tunnel_width_x )
-       CALL wrd_mpi_io( 'tunnel_width_y', tunnel_width_y )
-       CALL wrd_mpi_io( 'turbulence_closure', turbulence_closure )
-       CALL wrd_mpi_io( 'turbulent_inflow', turbulent_inflow )
-       CALL wrd_mpi_io( 'u_bulk', u_bulk )
-       CALL wrd_mpi_io_global_array( 'u_init', u_init )
-       CALL wrd_mpi_io( 'u_max', u_max )
-       CALL wrd_mpi_io_global_array( 'u_max_ijk', u_max_ijk )
-       CALL wrd_mpi_io_global_array( 'ug', ug )
-       CALL wrd_mpi_io( 'ug_surface', ug_surface )
-       CALL wrd_mpi_io_global_array( 'ug_vertical_gradient', ug_vertical_gradient )
-       CALL wrd_mpi_io_global_array( 'ug_vertical_gradient_level', ug_vertical_gradient_level )
-       CALL wrd_mpi_io_global_array( 'ug_vertical_gradient_level_ind', ug_vertical_gradient_level_ind )
-       CALL wrd_mpi_io( 'use_surface_fluxes', use_surface_fluxes )
-       CALL wrd_mpi_io( 'use_top_fluxes', use_top_fluxes )
-       CALL wrd_mpi_io( 'use_ug_for_galilei_tr', use_ug_for_galilei_tr )
-       CALL wrd_mpi_io( 'use_upstream_for_tke', use_upstream_for_tke )
-       CALL wrd_mpi_io( 'user_module_enabled', user_module_enabled )
-       CALL wrd_mpi_io( 'v_bulk', v_bulk )
-       CALL wrd_mpi_io_global_array( 'v_init', v_init )
-       CALL wrd_mpi_io( 'v_max', v_max )
-       CALL wrd_mpi_io_global_array( 'v_max_ijk', v_max_ijk )
-       CALL wrd_mpi_io_global_array( 'vg', vg )
-       CALL wrd_mpi_io( 'vg_surface', vg_surface )
-       CALL wrd_mpi_io_global_array( 'vg_vertical_gradient', vg_vertical_gradient )
-       CALL wrd_mpi_io_global_array( 'vg_vertical_gradient_level', vg_vertical_gradient_level )
-       CALL wrd_mpi_io_global_array( 'vg_vertical_gradient_level_ind', vg_vertical_gradient_level_ind )
-       CALL wrd_mpi_io( 'virtual_flight', virtual_flight )
-       CALL wrd_mpi_io_global_array( 'volume_flow_area', volume_flow_area )
-       CALL wrd_mpi_io_global_array( 'volume_flow_initial', volume_flow_initial )
-       CALL wrd_mpi_io( 'w_max', w_max )
-       CALL wrd_mpi_io_global_array( 'w_max_ijk', w_max_ijk )
-       CALL wrd_mpi_io( 'wall_adjustment', wall_adjustment )
-       CALL wrd_mpi_io_global_array( 'wall_heatflux', wall_heatflux )
-       CALL wrd_mpi_io_global_array( 'wall_humidityflux', wall_humidityflux )
-       CALL wrd_mpi_io_global_array( 'wall_scalarflux', wall_scalarflux )
-       CALL wrd_mpi_io( 'y_shift', y_shift )
-       CALL wrd_mpi_io( 'z0h_factor', z0h_factor )
-       CALL wrd_mpi_io( 'zeta_max', zeta_max )
-       CALL wrd_mpi_io( 'zeta_min', zeta_min )
-       CALL wrd_mpi_io_global_array( 'z_i', z_i )
-
-    ENDIF
-
-!
-!-- Write restart data of the other modules
-    CALL module_interface_wrd_global
-
-
- END SUBROUTINE wrd_global
-
-
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Processor specific data of variables and arrays is written out for restarts (binary format).
-!> This information is written to the file opened by each PE.
-!--------------------------------------------------------------------------------------------------!
-
-
- SUBROUTINE wrd_local
-
-
-    CHARACTER(LEN=10) ::  binary_version_local  !<
-    CHARACTER(LEN=20) ::  tmp_name              !<  temporary variable
-
-    INTEGER ::  i                               !<  loop index
-
-!
-!-- Write arrays.
-    binary_version_local = '5.1'
-
-    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
-!
-!--    Output in Fortran binary format
-
-       CALL wrd_write_string( 'binary_version_local' )
-       WRITE ( 14 )  binary_version_local
-
-       WRITE ( 14 )  numprocs, myid, nxl, nxr, nys, nyn, nzb, nzt
-
-!
-!--    Attention: After changes to the following output commands the version number of the variable
-!--    ---------- binary_version_local must be changed!
-!--               Also, the list of arrays to be read in rrd_local must be adjusted accordingly.
-       CALL wrd_write_string( 'e' )
-       WRITE ( 14 )  e
-
-       IF ( ALLOCATED( e_av ) )  THEN
-          CALL wrd_write_string( 'e_av' )
-          WRITE ( 14 )  e_av
-       ENDIF
-
-       CALL wrd_write_string( 'kh' )
-       WRITE ( 14 )  kh
-
-
-       IF ( ALLOCATED( kh_av ) )  THEN
-          CALL wrd_write_string( 'kh_av' )
-          WRITE ( 14 )  kh_av
-       ENDIF
-
-       CALL wrd_write_string( 'km' )
-       WRITE ( 14 )  km
-
-       IF ( ALLOCATED( km_av ) )  THEN
-          CALL wrd_write_string( 'km_av' )
-          WRITE ( 14 )  km_av
-       ENDIF
-
-       IF ( ALLOCATED( lpt_av ) )  THEN
-          CALL wrd_write_string( 'lpt_av' )
-          WRITE ( 14 )  lpt_av
-       ENDIF
-
-       IF ( ALLOCATED( lwp_av ) )  THEN
-          CALL wrd_write_string( 'lwp_av' )
-          WRITE ( 14 )  lwp_av
-       ENDIF
-
-       CALL wrd_write_string( 'p' )
-       WRITE ( 14 )  p
-
-       IF ( ALLOCATED( p_av ) )  THEN
-          CALL wrd_write_string( 'p_av' )
-          WRITE ( 14 )  p_av
-       ENDIF
-
-       IF ( ALLOCATED( pc_av ) )  THEN
-          CALL wrd_write_string( 'pc_av' )
-          WRITE ( 14 )  pc_av
-       ENDIF
-
-       IF ( ALLOCATED( pr_av ) )  THEN
-          CALL wrd_write_string( 'pr_av' )
-          WRITE ( 14 )  pr_av
-       ENDIF
-
-       CALL wrd_write_string( 'pt' )
-       WRITE ( 14 )  pt
-
-       IF ( ALLOCATED( pt_av ) )  THEN
-          CALL wrd_write_string( 'pt_av' )
-          WRITE ( 14 )  pt_av
-       ENDIF
-
-       IF ( humidity )  THEN
-
-          CALL wrd_write_string( 'q' )
-          WRITE ( 14 )  q
-
-          IF ( ALLOCATED( q_av ) )  THEN
-             CALL wrd_write_string( 'q_av' )
-             WRITE ( 14 )  q_av
-          ENDIF
-
-          IF ( cloud_droplets )  THEN
-
-             CALL wrd_write_string( 'ql' )
-             WRITE ( 14 )  ql
-
-             IF ( ALLOCATED( ql_av ) )  THEN
-                CALL wrd_write_string( 'ql_av' )
-                WRITE ( 14 )  ql_av
-             ENDIF
-
-          ENDIF
-
-          IF ( ALLOCATED( qsurf_av ) )  THEN
-             CALL wrd_write_string( 'qsurf_av' )
-             WRITE ( 14 )  qsurf_av
-          ENDIF
-
-          IF ( ALLOCATED( qsws_av ) )  THEN
-             CALL wrd_write_string( 'qsws_av' )
-             WRITE ( 14 )  qsws_av
-          ENDIF
-
-       ENDIF
-
-       IF ( passive_scalar )  THEN
-
-          CALL wrd_write_string( 's' )
-          WRITE ( 14 )  s
-
-          IF ( ALLOCATED( s_av ) )  THEN
-             CALL wrd_write_string( 's_av' )
-             WRITE ( 14 )  s_av
-          ENDIF
-
-          IF ( ALLOCATED( ssurf_av ) )  THEN
-             CALL wrd_write_string( 'ssurf_av' )
-             WRITE ( 14 )  ssurf_av
-          ENDIF
-
-          IF ( ALLOCATED( ssws_av ) )  THEN
-             CALL wrd_write_string( 'ssws_av' )
-             WRITE ( 14 )  ssws_av
-          ENDIF
-
-       ENDIF
-
-       IF ( ALLOCATED( ql_c_av ) )  THEN
-          CALL wrd_write_string( 'ql_c_av' )
-          WRITE ( 14 )  ql_c_av
-       ENDIF
-
-       IF ( ALLOCATED( ql_v_av ) )  THEN
-          CALL wrd_write_string( 'ql_v_av' )
-          WRITE ( 14 )  ql_v_av
-       ENDIF
-
-       IF ( ALLOCATED( ql_vp_av ) )  THEN
-          CALL wrd_write_string( 'ql_vp_av' )
-          WRITE ( 14 )  ql_vp_av
-       ENDIF
-
-       IF ( ALLOCATED( qv_av ) )  THEN
-          CALL wrd_write_string( 'qv_av' )
-          WRITE ( 14 )  qv_av
-       ENDIF
-
-       CALL wrd_write_string( 'random_iv' )
-       WRITE ( 14 )  random_iv
-       WRITE ( 14 )  random_iy
-
-       IF ( ALLOCATED( seq_random_array ) )  THEN
-          CALL wrd_write_string( 'seq_random_array' )
-          WRITE ( 14 )  id_random_array
-          WRITE ( 14 )  seq_random_array
-       ENDIF
-
-       IF ( ALLOCATED( s_av ) )  THEN
-          CALL wrd_write_string( 's_av' )
-          WRITE ( 14 )  s_av
-       ENDIF
-
-       IF ( ALLOCATED( shf_av ) )  THEN
-          CALL wrd_write_string( 'shf_av' )
-          WRITE ( 14 )  shf_av
-       ENDIF
-
-       IF ( ALLOCATED( ts_av ) )  THEN
-          CALL wrd_write_string( 'ts_av' )
-          WRITE ( 14 ) ts_av
-       ENDIF
-
-       CALL wrd_write_string( 'u' )
-       WRITE ( 14 )  u
-
-       IF ( ALLOCATED( u_av ) )  THEN
-          CALL wrd_write_string( 'u_av' )
-          WRITE ( 14 )  u_av
-       ENDIF
-
-       IF ( ALLOCATED( us_av ) )  THEN
-          CALL wrd_write_string( 'us_av' )
-          WRITE ( 14 )  us_av
-       ENDIF
-
-       CALL wrd_write_string( 'v' )
-       WRITE ( 14 )  v
-
-       IF ( ALLOCATED( v_av ) )  THEN
-          CALL wrd_write_string( 'v_av' )
-          WRITE ( 14 )  v_av
-       ENDIF
-
-       IF ( humidity )  THEN
-
-          CALL wrd_write_string( 'vpt' )
-          WRITE ( 14 )  vpt
-
-          IF ( ALLOCATED( vpt_av ) )  THEN
-             CALL wrd_write_string( 'vpt_av' )
-             WRITE ( 14 ) vpt_av
-          ENDIF
-
-       ENDIF
-
-       CALL wrd_write_string( 'w' )
-       WRITE ( 14 )  w
-
-       IF ( ALLOCATED( w_av ) )  THEN
-          CALL wrd_write_string( 'w_av' )
-          WRITE ( 14 )  w_av
-       ENDIF
-
-       IF ( ALLOCATED( z0_av ) )  THEN
-          CALL wrd_write_string( 'z0_av' )
-          WRITE ( 14 )  z0_av
-       ENDIF
-
-      IF ( ALLOCATED( z0h_av ) )  THEN
-          CALL wrd_write_string( 'z0h_av' )
-          WRITE ( 14 )  z0h_av
-       ENDIF
-
-       IF ( ALLOCATED( z0q_av ) )  THEN
-          CALL wrd_write_string( 'z0q_av' )
-          WRITE ( 14 )  z0q_av
-       ENDIF
-
-       IF ( land_surface .OR. urban_surface )  THEN
-
-          IF ( ALLOCATED( ghf_av ) )  THEN
-             CALL wrd_write_string( 'ghf_av' )
-             WRITE ( 14 )  ghf_av
-          ENDIF
-
-          IF ( ALLOCATED( r_a_av ) )  THEN
-             CALL wrd_write_string( 'r_a_av' )
-             WRITE ( 14 )  r_a_av
-          ENDIF
-
-       ENDIF
-
-       IF ( ALLOCATED( tsurf_av ) )  THEN
-          CALL wrd_write_string( 'tsurf_av' )
-          WRITE ( 14 )  tsurf_av
-       ENDIF
-
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
-!
-!--    Write local restart data using MPI-IO
-!--    Attention: After changes to the following output commands the version number
-!--    ---------  of the variable binary_version must be changed!
-!--               Also, the list of arrays to be read in rrd_local must be adjusted accordingly.
-       CALL wrd_mpi_io( 'e',  e)
-       IF ( ALLOCATED( e_av ) )  CALL wrd_mpi_io( 'e_av',  e_av)
-       CALL wrd_mpi_io( 'kh', kh )
-       IF ( ALLOCATED( kh_av ) )  CALL wrd_mpi_io( 'kh_av', kh_av )
-       CALL wrd_mpi_io( 'km' , km )
-       IF ( ALLOCATED( km_av ) )  CALL wrd_mpi_io( 'km_av', km_av )
-       IF ( ALLOCATED( lpt_av ) )  CALL wrd_mpi_io( 'lpt_av', lpt_av )
-       IF ( ALLOCATED( lwp_av ) )  CALL wrd_mpi_io( 'lwp_av', lwp_av )
-       CALL wrd_mpi_io( 'p', p )
-       IF ( ALLOCATED( p_av ) )  CALL wrd_mpi_io( 'p_av', p_av )
-       IF ( ALLOCATED( pc_av ) )  CALL wrd_mpi_io( 'pc_av', pc_av )
-       IF ( ALLOCATED( pr_av ) )  CALL wrd_mpi_io( 'pr_av', pr_av )
-       CALL wrd_mpi_io( 'pt', pt )
-       IF ( ALLOCATED( pt_av ) )  CALL wrd_mpi_io( 'pt_av', pt_av )
-
-       IF ( humidity )  THEN
-
-          CALL wrd_mpi_io( 'q', q )
-          IF ( ALLOCATED( q_av ) )  CALL wrd_mpi_io( 'q_av', q_av )
-
-          IF ( cloud_droplets )  THEN
-
-             CALL wrd_mpi_io( 'ql', ql )
-             IF ( ALLOCATED( ql_av ) )  CALL wrd_mpi_io( 'ql_av', ql_av )
-
-          ENDIF
-
-          IF ( ALLOCATED( qsurf_av ) )  CALL wrd_mpi_io( 'qsurf_av', qsurf_av )
-          IF ( ALLOCATED( qsws_av ) )  CALL wrd_mpi_io( 'qsws_av', qsws_av )
-
-       ENDIF
-
-       IF ( passive_scalar )  THEN
-
-          CALL wrd_mpi_io( 's', s )
-          IF ( ALLOCATED( s_av ) )  CALL wrd_mpi_io( 's_av',  s_av )
-          IF ( ALLOCATED( ssurf_av ) )  CALL wrd_mpi_io( 'ssurf_av', ssurf_av )
-          IF ( ALLOCATED( ssws_av ) )  CALL wrd_mpi_io( 'ssws_av', ssws_av )
-
-       ENDIF
-
-       IF ( ALLOCATED( ql_c_av ) )  CALL wrd_mpi_io( 'ql_c_av', ql_c_av )
-       IF ( ALLOCATED( ql_v_av ) )  CALL wrd_mpi_io( 'ql_v_av', ql_v_av )
-       IF ( ALLOCATED( ql_vp_av ) )  CALL wrd_mpi_io( 'ql_vp_av', ql_vp_av )
-       IF ( ALLOCATED( qv_av ) )  CALL wrd_mpi_io( 'qv_av', qv_av )
-!
-!--    Only PE0 writes random_iv and random_iy to restart file.
-!--    ATTENTION: If one value for every PE is required, the general approach of PE indendent
-!--    restart will be lost. That means that in general the parallel random number generator
-!--    in random_generatot_parallel_mod should be used!
-       CALL wrd_mpi_io_global_array( 'random_iv', random_iv )
-       CALL wrd_mpi_io( 'random_iy', random_iy )
-
-       IF ( ALLOCATED( seq_random_array ) )  THEN
-          CALL wrd_mpi_io( 'id_random_array', id_random_array )
-          DO  i = 1, SIZE( seq_random_array, 1 )
-             WRITE( tmp_name, '(A,I2.2)' )  'seq_random_array', i
-             CALL wrd_mpi_io( TRIM( tmp_name ), seq_random_array(i,:,:) )
-          ENDDO
-       ENDIF
-       IF ( ALLOCATED( s_av ) )  CALL wrd_mpi_io( 's_av', s_av )
-       IF ( ALLOCATED( shf_av ) )  CALL wrd_mpi_io( 'shf_av', shf_av )
-       IF ( ALLOCATED( ts_av ) )  CALL wrd_mpi_io( 'ts_av', ts_av )
-       CALL wrd_mpi_io( 'u', u)
-       IF ( ALLOCATED( u_av ) )  CALL wrd_mpi_io( 'u_av', u_av )
-       IF ( ALLOCATED( us_av ) )  CALL wrd_mpi_io( 'us_av', us_av )
-       CALL wrd_mpi_io( 'v', v )
-       IF ( ALLOCATED( v_av ) )  CALL wrd_mpi_io( 'v_av', v_av )
-       IF ( humidity )  THEN
-          CALL wrd_mpi_io( 'vpt',  vpt )
-          IF ( ALLOCATED( vpt_av ) )  CALL wrd_mpi_io( 'vpt_av', vpt_av )
-       ENDIF
-       CALL wrd_mpi_io( 'w', w)
-       IF ( ALLOCATED( w_av ) )  CALL wrd_mpi_io( 'w_av', w_av )
-       IF ( ALLOCATED( z0_av ) )  CALL wrd_mpi_io( 'z0_av', z0_av )
-       IF ( ALLOCATED( z0h_av ) )  CALL wrd_mpi_io( 'z0h_av', z0h_av )
-       IF ( ALLOCATED( z0q_av ) )  CALL wrd_mpi_io( 'z0q_av', z0q_av )
-       IF ( land_surface  .OR.  urban_surface )  THEN
-          IF ( ALLOCATED( ghf_av ) )  CALL wrd_mpi_io( 'ghf_av', ghf_av )
-          IF ( ALLOCATED( r_a_av ) )  CALL wrd_mpi_io( 'r_a_av', r_a_av )
-       ENDIF
-       IF ( ALLOCATED( tsurf_av ) )  CALL wrd_mpi_io( 'tsurf_av', tsurf_av )
-
-    ENDIF
-
-    CALL surface_wrd_local
-
-!
-!-- Write restart data of other modules
-    CALL module_interface_wrd_local
-
-!
-!-- Write end label
-    IF (  restart_data_format_output == 'fortran_binary' )  THEN
-       CALL wrd_write_string( '*** end ***' )
-    ENDIF
-
- END SUBROUTINE wrd_local
-
-
- END MODULE write_restart_data_mod
Index: palm/trunk/SOURCE/write_var_list.f90
===================================================================
--- palm/trunk/SOURCE/write_var_list.f90	(revision 1)
+++ palm/trunk/SOURCE/write_var_list.f90	(revision 1)
@@ -0,0 +1,446 @@
+ SUBROUTINE write_var_list
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Log: write_var_list.f90,v $
+! Revision 1.34  2006/08/22 14:30:52  raasch
+! +dz_max
+!
+! Revision 1.33  2006/08/04 15:05:52  raasch
+! +first_call_advec_particles, time_dopts, use_upstream_for_tke
+!
+! Revision 1.32  2006/02/23 13:16:02  raasch
+! +building parameters, conserve_volume_flow, dissipation_1d, e_min,
+! mixing_length_1d, topography,
+! -average_count_pl, time_average_pr, time_average_pl renamed time_dopr_av,
+! nt_anz renamed current_timestep_number, ..pl.. renamed ..do..
+!
+! Revision 1.31  2005/06/28 14:18:02  steinfeld
+! +ug_surface, ug_vertical_gradient, ug_vertical_gradient_level,
+! ug_vertical_gradient_level_ind, vg_surface, vg_vertical_gradient,
+! vg_vertical_gradient_level, vg_vertical_gradient_level_ind
+!
+! Revision 1.30  2005/06/26 20:10:54  raasch
+! +cloud_droplets
+!
+! Revision 1.29  2005/05/18 15:56:20  raasch
+! +netcdf_precision
+!
+! Revision 1.28  2005/03/26 21:18:39  raasch
+! +bc_lr, bc_ns, inflow_disturbance_begin, inflow_disturbance_end, km_damp_max,
+! outflow_damping_width
+!
+! Revision 1.27  2004/04/30 13:14:31  raasch
+! +grid_matching, impulse_advec renamed momentum_advec
+!
+! Revision 1.26  2004/01/28 15:38:55  raasch
+! at and bt replaced by array tsc
+!
+! Revision 1.25  2003/10/29 09:15:12  raasch
+! +last_dt_change
+!
+! Revision 1.24  2003/03/14 13:47:55  raasch
+! +random_generator
+!
+! Revision 1.23  2002/12/19 16:24:09  raasch
+! Writing of array hom moved from write_3d_binary to this routine,
+! binary version incremented to 2.2, +time_restart
+!
+! Revision 1.22  2002/04/16 08:22:02  raasch
+! +bc_s_b, bc_s_t, surface_scalarflux, s_surface, s_surface_initial_change,
+! s_vertical_gradient, s_vertical_gradient_level
+!
+! Revision 1.21  2001/08/21 10:05:05  raasch
+! +wall_adjustment
+!
+! Revision 1.20  2001/03/30 08:00:07  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.),
+! runtime and package parameters are not written on unit 14 any more
+!
+! Revision 1.19  2001/01/29 12:38:42  raasch
+! Error writing use_surface_fluxes-string corrected, +passive_scalar
+!
+! Revision 1.18  2001/01/25 07:27:48  raasch
+! +fft_method, use_surface_fluxes
+!
+! Revision 1.17  2001/01/05 15:16:59  raasch
+! +average_count_sp, time_dosp
+!
+! Revision 1.16  2000/12/28 13:39:21  raasch
+! Module dvrp_variables removed, -particle_transport
+!
+! Revision 1.15  2000/04/27 06:58:19  raasch
+! +dt_dvrp, dvrp_filecount, npex, npey, threshold, time_dvrp
+! -dt_plisos, dt_plpart, time_plisos, time_plpart
+! +module pegrid,
+! all comments translated into English, old revision remarks deleted
+!
+! Revision 1.14  2000/04/13 14:10:58  schroeter
+! Upgrade for calculations with cloud physics
+!
+! Revision 1.13  2000/01/10  10:11:06  10:11:06  raasch (Siegfried Raasch)
+! +use_ug_for_galilei_tr
+!
+! Revision 1.1  1998/03/18 20:20:38  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Writing values of control variables to restart-file (binary format)
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    USE averaging
+    USE grid_variables
+    USE indices
+    USE model_1d
+    USE pegrid
+    USE profil_parameter
+    USE statistics
+    USE control_parameters
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=10) ::  binary_version
+
+
+
+    binary_version = '3.0'
+
+    WRITE ( 14 )  binary_version    ! opened in write_3d_binary
+
+    WRITE ( 14 )  'nz                            '
+    WRITE ( 14 )  nz
+    WRITE ( 14 )  'statistic_regions             '
+    WRITE ( 14 )  statistic_regions
+
+!
+!-- Caution: After changes in the following parameter-list, the
+!-- -------  version number stored in the variable binary_version has to be
+!--          increased. The same changes must also be done in the parameter-
+!--          list in read_var_list.
+
+    WRITE ( 14 )  'adjust_mixing_length          '
+    WRITE ( 14 )  adjust_mixing_length
+    WRITE ( 14 )  'advected_distance_x           '
+    WRITE ( 14 )  advected_distance_x
+    WRITE ( 14 )  'advected_distance_y           '
+    WRITE ( 14 )  advected_distance_y
+    WRITE ( 14 )  'alpha_surface                 '
+    WRITE ( 14 )  alpha_surface
+    WRITE ( 14 )  'average_count_pr              '
+    WRITE ( 14 )  average_count_pr
+    WRITE ( 14 )  'average_count_sp              '
+    WRITE ( 14 )  average_count_sp
+    WRITE ( 14 )  'average_count_3d              '
+    WRITE ( 14 )  average_count_3d
+    WRITE ( 14 )  'bc_e_b                        '
+    WRITE ( 14 )  bc_e_b
+    WRITE ( 14 )  'bc_lr                         '
+    WRITE ( 14 )  bc_lr
+    WRITE ( 14 )  'bc_ns                         '
+    WRITE ( 14 )  bc_ns
+    WRITE ( 14 )  'bc_p_b                        '
+    WRITE ( 14 )  bc_p_b
+    WRITE ( 14 )  'bc_p_t                        '
+    WRITE ( 14 )  bc_p_t
+    WRITE ( 14 )  'bc_pt_b                       '
+    WRITE ( 14 )  bc_pt_b
+    WRITE ( 14 )  'bc_pt_t                       '
+    WRITE ( 14 )  bc_pt_t
+    WRITE ( 14 )  'bc_pt_t_val                   '
+    WRITE ( 14 )  bc_pt_t_val
+    WRITE ( 14 )  'bc_q_b                        '
+    WRITE ( 14 )  bc_q_b
+    WRITE ( 14 )  'bc_q_t                        '
+    WRITE ( 14 )  bc_q_t
+    WRITE ( 14 )  'bc_q_t_val                    '
+    WRITE ( 14 )  bc_q_t_val
+    WRITE ( 14 )  'bc_s_b                        '
+    WRITE ( 14 )  bc_s_b
+    WRITE ( 14 )  'bc_s_t                        '
+    WRITE ( 14 )  bc_s_t
+    WRITE ( 14 )  'bc_uv_b                       '
+    WRITE ( 14 )  bc_uv_b
+    WRITE ( 14 )  'bc_uv_t                       '
+    WRITE ( 14 )  bc_uv_t
+    WRITE ( 14 )  'building_height               '
+    WRITE ( 14 )  building_height
+    WRITE ( 14 )  'building_length_x             '
+    WRITE ( 14 )  building_length_x
+    WRITE ( 14 )  'building_length_y             '
+    WRITE ( 14 )  building_length_y
+    WRITE ( 14 )  'building_wall_left            '
+    WRITE ( 14 )  building_wall_left
+    WRITE ( 14 )  'building_wall_south           '
+    WRITE ( 14 )  building_wall_south
+    WRITE ( 14 )  'cloud_droplets                '
+    WRITE ( 14 )  cloud_droplets
+    WRITE ( 14 )  'cloud_physics                 '
+    WRITE ( 14 )  cloud_physics
+    WRITE ( 14 )  'conserve_volume_flow          '
+    WRITE ( 14 )  conserve_volume_flow
+    WRITE ( 14 )  'current_timestep_number       '
+    WRITE ( 14 )  current_timestep_number
+    WRITE ( 14 )  'cut_spline_overshoot          '
+    WRITE ( 14 )  cut_spline_overshoot
+    WRITE ( 14 )  'damp_level_1d                 '
+    WRITE ( 14 )  damp_level_1d
+    WRITE ( 14 )  'dissipation_1d                '
+    WRITE ( 14 )  dissipation_1d
+    WRITE ( 14 )  'dt_fixed                      '
+    WRITE ( 14 )  dt_fixed
+    WRITE ( 14 )  'dt_pr_1d                      '
+    WRITE ( 14 )  dt_pr_1d
+    WRITE ( 14 )  'dt_run_control_1d             '
+    WRITE ( 14 )  dt_run_control_1d
+    WRITE ( 14 )  'dt_3d                         '
+    WRITE ( 14 )  dt_3d
+    WRITE ( 14 )  'dvrp_filecount                '
+    WRITE ( 14 )  dvrp_filecount
+    WRITE ( 14 )  'dx                            '
+    WRITE ( 14 )  dx
+    WRITE ( 14 )  'dy                            '
+    WRITE ( 14 )  dy
+    WRITE ( 14 )  'dz                            '
+    WRITE ( 14 )  dz
+    WRITE ( 14 )  'dz_max                        '
+    WRITE ( 14 )  dz_max
+    WRITE ( 14 )  'dz_stretch_factor             '
+    WRITE ( 14 )  dz_stretch_factor
+    WRITE ( 14 )  'dz_stretch_level              '
+    WRITE ( 14 )  dz_stretch_level
+    WRITE ( 14 )  'e_min                         '
+    WRITE ( 14 )  e_min
+    WRITE ( 14 )  'end_time_1d                   '
+    WRITE ( 14 )  end_time_1d
+    WRITE ( 14 )  'fft_method                    '
+    WRITE ( 14 )  fft_method
+    WRITE ( 14 )  'first_call_advec_particles    '
+    WRITE ( 14 )  first_call_advec_particles
+    WRITE ( 14 )  'galilei_transformation        '
+    WRITE ( 14 )  galilei_transformation
+    WRITE ( 14 )  'grid_matching                 '
+    WRITE ( 14 )  grid_matching
+    WRITE ( 14 )  'hom                           '
+    WRITE ( 14 )  hom
+    WRITE ( 14 )  'inflow_disturbance_begin      '
+    WRITE ( 14 )  inflow_disturbance_begin
+    WRITE ( 14 )  'inflow_disturbance_end        '
+    WRITE ( 14 )  inflow_disturbance_end
+    WRITE ( 14 )  'km_constant                   '
+    WRITE ( 14 )  km_constant
+    WRITE ( 14 )  'km_damp_max                   '
+    WRITE ( 14 )  km_damp_max
+    WRITE ( 14 )  'last_dt_change                '
+    WRITE ( 14 )  last_dt_change
+    WRITE ( 14 )  'long_filter_factor            '
+    WRITE ( 14 )  long_filter_factor
+    WRITE ( 14 )  'mixing_length_1d              '
+    WRITE ( 14 )  mixing_length_1d
+    WRITE ( 14 )  'moisture                      '
+    WRITE ( 14 )  moisture
+    WRITE ( 14 )  'momentum_advec                '
+    WRITE ( 14 )  momentum_advec
+    WRITE ( 14 )  'netcdf_precision              '
+    WRITE ( 14 )  netcdf_precision
+    WRITE ( 14 )  'npex                          '
+    WRITE ( 14 )  npex
+    WRITE ( 14 )  'npey                          '
+    WRITE ( 14 )  npey
+    WRITE ( 14 )  'nsor_ini                      '
+    WRITE ( 14 )  nsor_ini
+    WRITE ( 14 )  'nx                            '
+    WRITE ( 14 )  nx
+    WRITE ( 14 )  'ny                            '
+    WRITE ( 14 )  ny
+    WRITE ( 14 )  'old_dt                        '
+    WRITE ( 14 )  old_dt
+    WRITE ( 14 )  'omega                         '
+    WRITE ( 14 )  omega
+    WRITE ( 14 )  'outflow_damping_width         '
+    WRITE ( 14 )  outflow_damping_width
+    WRITE ( 14 )  'overshoot_limit_e             '
+    WRITE ( 14 )  overshoot_limit_e
+    WRITE ( 14 )  'overshoot_limit_pt            '
+    WRITE ( 14 )  overshoot_limit_pt
+    WRITE ( 14 )  'overshoot_limit_u             '
+    WRITE ( 14 )  overshoot_limit_u
+    WRITE ( 14 )  'overshoot_limit_v             '
+    WRITE ( 14 )  overshoot_limit_v
+    WRITE ( 14 )  'overshoot_limit_w             '
+    WRITE ( 14 )  overshoot_limit_w
+    WRITE ( 14 )  'passive_scalar                '
+    WRITE ( 14 )  passive_scalar
+    WRITE ( 14 )  'phi                           '
+    WRITE ( 14 )  phi
+    WRITE ( 14 )  'prandtl_layer                 '
+    WRITE ( 14 )  prandtl_layer
+    WRITE ( 14 )  'precipitation                 '
+    WRITE ( 14 )  precipitation
+    WRITE ( 14 )  'pt_init                       '
+    WRITE ( 14 )  pt_init
+    WRITE ( 14 )  'pt_surface                    '
+    WRITE ( 14 )  pt_surface
+    WRITE ( 14 )  'pt_surface_initial_change     '
+    WRITE ( 14 )  pt_surface_initial_change
+    WRITE ( 14 )  'pt_vertical_gradient          '
+    WRITE ( 14 )  pt_vertical_gradient
+    WRITE ( 14 )  'pt_vertical_gradient_level    '
+    WRITE ( 14 )  pt_vertical_gradient_level
+    WRITE ( 14 )  'pt_vertical_gradient_level_ind'
+    WRITE ( 14 )  pt_vertical_gradient_level_ind
+    WRITE ( 14 )  'q_init                        '
+    WRITE ( 14 )  q_init
+    WRITE ( 14 )  'q_surface                     '
+    WRITE ( 14 )  q_surface
+    WRITE ( 14 )  'q_surface_initial_change      '
+    WRITE ( 14 )  q_surface_initial_change
+    WRITE ( 14 )  'q_vertical_gradient           '
+    WRITE ( 14 )  q_vertical_gradient
+    WRITE ( 14 )  'q_vertical_gradient_level     '
+    WRITE ( 14 )  q_vertical_gradient_level
+    WRITE ( 14 )  'q_vertical_gradient_level_ind '
+    WRITE ( 14 )  q_vertical_gradient_level_ind
+    WRITE ( 14 )  'radiation                     '
+    WRITE ( 14 )  radiation
+    WRITE ( 14 )  'random_generator              '
+    WRITE ( 14 )  random_generator
+    WRITE ( 14 )  'random_heatflux               '
+    WRITE ( 14 )  random_heatflux
+    WRITE ( 14 )  'rif_max                       '
+    WRITE ( 14 )  rif_max
+    WRITE ( 14 )  'rif_min                       '
+    WRITE ( 14 )  rif_min
+    WRITE ( 14 )  'roughness_length              '
+    WRITE ( 14 )  roughness_length
+    WRITE ( 14 )  'runnr                         '
+    WRITE ( 14 )  runnr
+    WRITE ( 14 )  'scalar_advec                  '
+    WRITE ( 14 )  scalar_advec
+    WRITE ( 14 )  'simulated_time                '
+    WRITE ( 14 )  simulated_time
+    WRITE ( 14 )  'surface_heatflux              '
+    WRITE ( 14 )  surface_heatflux
+    WRITE ( 14 )  'surface_pressure              '
+    WRITE ( 14 )  surface_pressure
+    WRITE ( 14 )  'surface_scalarflux            '
+    WRITE ( 14 )  surface_scalarflux    
+    WRITE ( 14 )  'surface_waterflux             '
+    WRITE ( 14 )  surface_waterflux    
+    WRITE ( 14 )  's_surface                     '
+    WRITE ( 14 )  s_surface
+    WRITE ( 14 )  's_surface_initial_change      '
+    WRITE ( 14 )  s_surface_initial_change
+    WRITE ( 14 )  's_vertical_gradient           '
+    WRITE ( 14 )  s_vertical_gradient
+    WRITE ( 14 )  's_vertical_gradient_level     '
+    WRITE ( 14 )  s_vertical_gradient_level
+    WRITE ( 14 )  'time_disturb                  '
+    WRITE ( 14 )  time_disturb
+    WRITE ( 14 )  'time_dopr                     '
+    WRITE ( 14 )  time_dopr
+    WRITE ( 14 )  'time_dopr_av                  '
+    WRITE ( 14 )  time_dopr_av
+    WRITE ( 14 )  'time_dopr_listing             '
+    WRITE ( 14 )  time_dopr_listing
+    WRITE ( 14 )  'time_dopts                    '
+    WRITE ( 14 )  time_dopts
+    WRITE ( 14 )  'time_dosp                     '
+    WRITE ( 14 )  time_dosp
+    WRITE ( 14 )  'time_dots                     '
+    WRITE ( 14 )  time_dots
+    WRITE ( 14 )  'time_do2d_xy                  '
+    WRITE ( 14 )  time_do2d_xy
+    WRITE ( 14 )  'time_do2d_xz                  '
+    WRITE ( 14 )  time_do2d_xz
+    WRITE ( 14 )  'time_do2d_yz                  '
+    WRITE ( 14 )  time_do2d_yz
+    WRITE ( 14 )  'time_do3d                     '
+    WRITE ( 14 )  time_do3d
+    WRITE ( 14 )  'time_do_av                    '
+    WRITE ( 14 )  time_do_av
+    WRITE ( 14 )  'time_do_sla                   '
+    WRITE ( 14 )  time_do_sla
+    WRITE ( 14 )  'time_dvrp                     '
+    WRITE ( 14 )  time_dvrp
+    WRITE ( 14 )  'time_restart                  '
+    WRITE ( 14 )  time_restart
+    WRITE ( 14 )  'time_run_control              '
+    WRITE ( 14 )  time_run_control
+    WRITE ( 14 )  'timestep_scheme               '
+    WRITE ( 14 )  timestep_scheme
+    WRITE ( 14 )  'topography                    '
+    WRITE ( 14 )  topography
+    WRITE ( 14 )  'tsc                           '
+    WRITE ( 14 )  tsc
+    WRITE ( 14 )  'u_init                        '
+    WRITE ( 14 )  u_init
+    WRITE ( 14 )  'u_max                         '
+    WRITE ( 14 )  u_max
+    WRITE ( 14 )  'u_max_ijk                     '
+    WRITE ( 14 )  u_max_ijk
+    WRITE ( 14 )  'ug                            '
+    WRITE ( 14 )  ug
+    WRITE ( 14 )  'ug_surface                    '
+    WRITE ( 14 )  ug_surface
+    WRITE ( 14 )  'ug_vertical_gradient          '
+    WRITE ( 14 )  ug_vertical_gradient
+    WRITE ( 14 )  'ug_vertical_gradient_level    '
+    WRITE ( 14 )  ug_vertical_gradient_level
+    WRITE ( 14 )  'ug_vertical_gradient_level_ind'
+    WRITE ( 14 )  ug_vertical_gradient_level_ind
+    WRITE ( 14 )  'ups_limit_e                   '
+    WRITE ( 14 )  ups_limit_e
+    WRITE ( 14 )  'ups_limit_pt                  '
+    WRITE ( 14 )  ups_limit_pt
+    WRITE ( 14 )  'ups_limit_u                   '
+    WRITE ( 14 )  ups_limit_u
+    WRITE ( 14 )  'ups_limit_v                   '
+    WRITE ( 14 )  ups_limit_v
+    WRITE ( 14 )  'ups_limit_w                   '
+    WRITE ( 14 )  ups_limit_w
+    WRITE ( 14 )  'use_surface_fluxes            '
+    WRITE ( 14 )  use_surface_fluxes
+    WRITE ( 14 )  'use_ug_for_galilei_tr         '
+    WRITE ( 14 )  use_ug_for_galilei_tr
+    WRITE ( 14 )  'use_upstream_for_tke          '
+    WRITE ( 14 )  use_upstream_for_tke
+    WRITE ( 14 )  'v_init                        '
+    WRITE ( 14 )  v_init
+    WRITE ( 14 )  'v_max                         '
+    WRITE ( 14 )  v_max
+    WRITE ( 14 )  'v_max_ijk                     '
+    WRITE ( 14 )  v_max_ijk
+    WRITE ( 14 )  'vg                            '
+    WRITE ( 14 )  vg
+    WRITE ( 14 )  'vg_surface                    '
+    WRITE ( 14 )  vg_surface
+    WRITE ( 14 )  'vg_vertical_gradient          '
+    WRITE ( 14 )  vg_vertical_gradient
+    WRITE ( 14 )  'vg_vertical_gradient_level    '
+    WRITE ( 14 )  vg_vertical_gradient_level
+    WRITE ( 14 )  'vg_vertical_gradient_level_ind'
+    WRITE ( 14 )  vg_vertical_gradient_level_ind
+    WRITE ( 14 )  'wall_adjustment               '
+    WRITE ( 14 )  wall_adjustment
+    WRITE ( 14 )  'w_max                         '
+    WRITE ( 14 )  w_max
+    WRITE ( 14 )  'w_max_ijk                     '
+    WRITE ( 14 )  w_max_ijk
+    WRITE ( 14 )  'time-series-quantities        '
+    WRITE ( 14 )  cross_ts_uymax, cross_ts_uymax_computed, cross_ts_uymin, &
+                  cross_ts_uymin_computed
+
+!
+!-- Set the end-of-file mark
+    WRITE ( 14 )  '*** end ***                   '
+
+
+ END SUBROUTINE write_var_list
